diff --git a/.gitignore b/.gitignore
index 30433afe7adc8ea2067b6584b132bcd522fe24b6..8e8ebeac6a537d5490a53c241ac15cb3f01a6b3c 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,6 +1,48 @@
+bin_tools/cdf2cdf
+bin_tools/cdf2lfi
+bin_tools/lfi2cdf
+conf/profile_mesonh
conf/profile_mesonh-*
+exe/*
+MY_RUN/KTEST/*/*/*.des
+MY_RUN/KTEST/*/*/*.lfi
+MY_RUN/KTEST/*/*/*.nc
+MY_RUN/KTEST/*/*/dir.??????:??:??
+MY_RUN/KTEST/*/*/dir_save
+MY_RUN/KTEST/*/*/dirconv
+MY_RUN/KTEST/*/*/dirextract
+MY_RUN/KTEST/*/*/ecmwf.OD.????????.??
+MY_RUN/KTEST/*/*/file_for_xtransfer
+MY_RUN/KTEST/*/*/gmeta
+MY_RUN/KTEST/*/*/gtopo30.*
+MY_RUN/KTEST/*/*/CLAY_HWSD_MOY.*
+MY_RUN/KTEST/*/*/DATA?1
+MY_RUN/KTEST/*/*/ECOCLIMAP_v2.0.*
+MY_RUN/KTEST/*/*/FICJD
+MY_RUN/KTEST/*/*/LISTING_DIA
+MY_RUN/KTEST/*/*/OUT_DIA
+MY_RUN/KTEST/*/*/OUTPUT_LISTING*
+MY_RUN/KTEST/*/*/PRESSURE
+MY_RUN/KTEST/*/*/REMAP*FFT*
+MY_RUN/KTEST/*/*/SAND_HWSD_MOY.*
+MY_RUN/KTEST/*/*/output_save*
+MY_RUN/KTEST/*/*/pipe_name
+MY_RUN/KTEST/*/*/gshhs(?).rim
+MY_RUN/KTEST/*/*/gshhs(?).zip
+MY_RUN/KTEST/*/*/rangs(?).cat
+MY_RUN/KTEST/*/*/rangs(?).cel
+MY_RUN/KTEST/*/*/rangs(?).zip
+MY_RUN/KTEST/*/*/visu*.png
+MY_RUN/KTEST/*/*/zsection*.png
+MY_RUN/KTEST/007_16janvier/012_spectre/spectra_16JAN.1.12B18.001_*
+MY_RUN/KTEST/009_ICARTT/001_pgd1/*.asc
+MY_RUN/KTEST/009_ICARTT/002_arp2lfi/ecmwf.OD.20040810.18-V2
+MY_RUN/KTEST/009_ICARTT/002_arp2lfi/mocage.GLOB22.20040810.18
+MY_RUN/KTEST/9??_*
+pub/ncl-?.?.?
pub/ncl_ncarg*/
src/dir_obj-*
src/LIB/grib_api*
src/LIB/hdf5*
+src/LIB/libaec*
src/LIB/netcdf*
diff --git a/MY_RUN/KTEST/003_KW78/006_diag/DIAG1.nam b/MY_RUN/KTEST/003_KW78/006_diag/DIAG1.nam
new file mode 100644
index 0000000000000000000000000000000000000000..7ffdfcd844fb88088cc47592dc83db278e78054c
--- /dev/null
+++ b/MY_RUN/KTEST/003_KW78/006_diag/DIAG1.nam
@@ -0,0 +1,12 @@
+&NAM_CONFIO LCDF4=T, LLFIOUT=F, LLFIREAD=F /
+&NAM_CONFZ
+ ! NZ_VERB=5 , NZ_PROC=0 , NB_PROCIO_R=8 , NB_PROCIO_W=1
+/
+&NAM_DIAG
+ LCLSTR=T,
+ LBOTUP=T,
+ CFIELD='W',
+ XTHRES=10. /
+&NAM_DIAG_FILE YINIFILE(1) = "KWRAI.1.SEG01.004" ,
+ YSUFFIX='dia' /
+
diff --git a/MY_RUN/KTEST/003_KW78/006_diag/clean_diag_xyz b/MY_RUN/KTEST/003_KW78/006_diag/clean_diag_xyz
new file mode 100755
index 0000000000000000000000000000000000000000..6daf8d6753c4b000775465519d27c06ad7490999
--- /dev/null
+++ b/MY_RUN/KTEST/003_KW78/006_diag/clean_diag_xyz
@@ -0,0 +1,4 @@
+set -x
+rm -f KWRAI* OUTPUT_LISTING* OUTPUT_TRANSFER pipe* *.tex
+rm -f file_for_xtransfer
+
diff --git a/MY_RUN/KTEST/003_KW78/006_diag/diag.nam b/MY_RUN/KTEST/003_KW78/006_diag/diag.nam
new file mode 100644
index 0000000000000000000000000000000000000000..a1252a72b1b6ef1bf8d6ad58ebe2ffd962e53fc6
--- /dev/null
+++ b/MY_RUN/KTEST/003_KW78/006_diag/diag.nam
@@ -0,0 +1,12 @@
+
+exemple 1, identification des ascendances > 10 m/s
+
+&NAM_DIAG LCLSTR = T, LBOTUP = T, CFIELD = "W", XTHRES = 10. /
+
+
+
+exemple 2, identification des overshoots
+
+&NAM_DIAG LCLSTR = T, LBOTUP = F, CFIELD = "CLOUD", XTHRES = 0.00001 /
+
+NB: par défaut CLOUD prend en compte Rc+Ri+Rs+Rg i.e. cloud water and ice, graupel and snow
diff --git a/MY_RUN/KTEST/003_KW78/006_diag/run_diag_xyz b/MY_RUN/KTEST/003_KW78/006_diag/run_diag_xyz
new file mode 100755
index 0000000000000000000000000000000000000000..99484f4931114142f9f407d058a8a2e1cdd34c14
--- /dev/null
+++ b/MY_RUN/KTEST/003_KW78/006_diag/run_diag_xyz
@@ -0,0 +1,15 @@
+#!/bin/sh
+#MNH_LIC Copyright 1994-2014 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.
+set -x
+set -e
+rm -f KWRAI* OUT*
+#
+#
+ln -sf ../002_mesonh/KWRAI.1.SEG01.004.des .
+ln -sf ../002_mesonh/KWRAI.1.SEG01.004.nc .
+
+time ${MPIRUN} DIAG${XYZ}
+
diff --git a/MY_RUN/KTEST/003_KW78/007_ncl_diag/clean_diag_xyz b/MY_RUN/KTEST/003_KW78/007_ncl_diag/clean_diag_xyz
new file mode 100755
index 0000000000000000000000000000000000000000..6daf8d6753c4b000775465519d27c06ad7490999
--- /dev/null
+++ b/MY_RUN/KTEST/003_KW78/007_ncl_diag/clean_diag_xyz
@@ -0,0 +1,4 @@
+set -x
+rm -f KWRAI* OUTPUT_LISTING* OUTPUT_TRANSFER pipe* *.tex
+rm -f file_for_xtransfer
+
diff --git a/MY_RUN/KTEST/003_KW78/007_ncl_diag/clean_ncl b/MY_RUN/KTEST/003_KW78/007_ncl_diag/clean_ncl
new file mode 100755
index 0000000000000000000000000000000000000000..9c04c2a804db6e7421b6de10a9e937f55d859447
--- /dev/null
+++ b/MY_RUN/KTEST/003_KW78/007_ncl_diag/clean_ncl
@@ -0,0 +1,2 @@
+set -x
+rm -f KWRAI.1.SEG01.004* visu_KW78_diag.png
\ No newline at end of file
diff --git a/MY_RUN/KTEST/003_KW78/007_ncl_diag/plot_KW78_diag.ncl b/MY_RUN/KTEST/003_KW78/007_ncl_diag/plot_KW78_diag.ncl
new file mode 100755
index 0000000000000000000000000000000000000000..731f3e8d5d16b0b465770aa0c9fabab24169993b
--- /dev/null
+++ b/MY_RUN/KTEST/003_KW78/007_ncl_diag/plot_KW78_diag.ncl
@@ -0,0 +1,127 @@
+;================================================;
+ load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl"
+ load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl"
+ load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl"
+ load "$NCARG_ROOT/lib/ncarg/nclscripts/wrf/WRFUserARW.ncl"
+; ================================================;
+;================================================;
+ begin
+;=================================================;
+; open file and read in data
+;=================================================;
+ fichier1 = addfile("KWRAI.1.SEG01.004.nc", "r")
+ fichier2 = addfile("KWRAI.1.SEG01.004dia.nc", "r")
+;==================================================;
+; Open the workstation
+;==================================================;
+ type = "png"
+ wks = gsn_open_wks(type,"visu_KW78_diag")
+;=================================================;
+; Get informations on variable sizes
+; dims are dims-2 to remove non-physical values
+;=================================================;
+ jphext = fichier2->JPHEXT
+ mdims = getfilevardimsizes(fichier2,"CLUSTERID")
+ nd = dimsizes(mdims)
+ imax=mdims(nd-1)-2*jphext
+ jmax=mdims(nd-2)-2*jphext
+ kmax=mdims(nd-3)-2
+
+
+;=================================================;
+; lecture des différents champs
+;=================================================;
+ zs = fichier1->ZS(jphext:jmax+jphext-1,jphext:imax+jphext-1) ; ZS
+ zhat = fichier1->ZHAT(1:kmax+1) ; ZHAT
+ yhat = fichier1->YHAT(1:jmax+jphext-1+1) ; YHAT
+ xhat = fichier1->XHAT(1:imax+jphext-1+1) ; XHAT
+
+ wt= fichier1->WT(1:kmax+1,jphext:jmax+jphext-1,jphext:imax+jphext-1) ; WT
+ vt= fichier1->VT(1:kmax,jphext:jmax+jphext-1+1,jphext:imax+jphext-1) ; VT
+ ut= fichier1->UT(1:kmax,jphext:jmax+jphext-1,jphext:imax+jphext-1+1) ; UT
+
+ idt1= fichier2->CLUSTERID(1:kmax,jphext:jmax+jphext-1,jphext:imax+jphext-1) ; CLUSTERID
+ idt1@long_name="Cluster Identity Number"
+ idt1@units=""
+
+ YYYYDDMM1= fichier1->DTCUR__TDATE
+ SS1=fichier1->DTCUR__TIME
+
+;=================================================;
+; Récupération de la date
+;=================================================;
+ year1=YYYYDDMM1(0)
+ day1=YYYYDDMM1(1)
+ min1=YYYYDDMM1(2)
+ time1=SS1
+;=================================================;
+; On mets toutes les variables sur la grille 1
+;=================================================;
+
+ ut1 = wrf_user_unstagger(ut,"X")
+ ut1@long_name="Zonal wind"
+ ut1@units="m/s"
+ vt1 = wrf_user_unstagger(vt,"Y")
+ vt1@long_name="Meridian wind"
+ vt1@units="m/s"
+ wt1 = wrf_user_unstagger(wt,"Z")
+ wt1@long_name="Vertical wind"
+ wt1@units="m/s"
+
+;=================================================;
+; Set some other basic resources
+;=================================================;
+ resmap = True
+ resmap@gsnFrame = False
+ resmap@gsnDraw = False
+ resmap@gsnMaximize = True
+ resmap@gsnPaperOrientation = "portrait"
+ resmap@gsnSpreadColors= True
+ resmap@tiYAxisString =" "
+ resmap@cnFillOn= True
+ resmap@cnLinesOn= False
+ resmap@lbLabelStride = 12. ; to reduce the number of labels on labelbar
+;=================================================;
+; Altitude des niveaux modèles
+;=================================================;
+; Unstagger zhat (from grid 4 to 1)
+ nzh=new(kmax,double)
+ do k=0,kmax-1
+ nzh(k)=(zhat(k)+zhat(k+1))/2.
+ end do
+
+; Create alt (altitude des niveaux modèle)
+ alt=new(dimsizes(ut1),double)
+ zcoef=new((/jmax,imax/),double)
+ zcoef=1.-zs/nzh(kmax-1)
+ do i=0,imax-1
+ do j=0,jmax-1
+ alt(:,j,i) = nzh*zcoef(j,i)+zs(j,i)
+ end do
+ end do
+
+
+;=======================================
+; coupe verticale clustering
+;=======================================
+
+ gsn_define_colormap(wks,"BlRe")
+
+ opt_cv=resmap
+ opt_cv@gsnScalarContour=True
+ opt_cv@vcMinDistanceF = 0.03 ; espacement des fleches
+ opt_cv@vcRefLengthF=0.1 ; taille des flèches
+ opt_cv@cnLevelSpacingF = 0.0005
+ opt_cv@cnMinLevelValF = 0
+ opt_cv@cnLevelSelectionMode = "ExplicitLevels"
+ opt_cv@cnLevels = (/1/)
+ opt_cv@cnFillColors = (/0,84/)
+ opt_cv@tiMainString = "Identified Updraft as cluster where w > 10 m/s"
+
+ plot_idt=gsn_csm_vector_scalar(wks,ut1(:,13,:),wt1(:,13,:),idt1(:,13,:),opt_cv)
+
+ draw(plot_idt)
+ frame(wks)
+
+
+end
diff --git a/MY_RUN/KTEST/003_KW78/007_ncl_diag/run_ncl b/MY_RUN/KTEST/003_KW78/007_ncl_diag/run_ncl
new file mode 100755
index 0000000000000000000000000000000000000000..4f9f88b34d84b74809865c5cfef064550a4ecef1
--- /dev/null
+++ b/MY_RUN/KTEST/003_KW78/007_ncl_diag/run_ncl
@@ -0,0 +1,13 @@
+#MNH_LIC Copyright 1994-2014 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.
+set -x
+
+ln -sf ../002_mesonh/KWRAI.1.SEG01.004.nc .
+ln -sf ../006_diag/KWRAI.1.SEG01.004dia.nc .
+
+ncl plot_KW78_diag.ncl
+display visu_KW78_diag.png
+
+exit 0
diff --git a/MY_RUN/KTEST/003_KW78/007_ncl_diag/visu_KW78_diag.png b/MY_RUN/KTEST/003_KW78/007_ncl_diag/visu_KW78_diag.png
new file mode 100644
index 0000000000000000000000000000000000000000..52376e3401b394d812df4f65ff6341216c741e5e
Binary files /dev/null and b/MY_RUN/KTEST/003_KW78/007_ncl_diag/visu_KW78_diag.png differ
diff --git a/MY_RUN/KTEST/003_KW78/Makefile b/MY_RUN/KTEST/003_KW78/Makefile
index e50e3b333d17d9505c803b9ba51ca34fcdcaafea..43f486a681a58240ba48a5fa53a950b27e684939 100755
--- a/MY_RUN/KTEST/003_KW78/Makefile
+++ b/MY_RUN/KTEST/003_KW78/Makefile
@@ -4,6 +4,8 @@ all:
cd 003_convdia && run_conv2dia
cd 004_diaprog && run_diaprog
cd 005_ncl && run_ncl
+ cd 006_diag && run_diag_xyz
+ cd 007_ncl_diag && run_ncl
clean:
cd 001_prep_ideal_case && clean_prep_ideal_case_xyz
@@ -11,3 +13,5 @@ clean:
cd 003_convdia && clean_conv2dia
cd 004_diaprog && clean_diaprog
cd 005_ncl && clean_ncl
+ cd 006_diag && clean_diag_xyz
+ cd 007_ncl_diag && clean_ncl
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src
index 7a2af571c81c4b67f181b85d2dd7e5d1d8374f62..b0cc61975233671b4a7600b0487d39ed8efad8d5 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src
@@ -11,7 +11,7 @@
&NAM_ADVn CUVW_ADV_SCHEME="CEN4TH",CMET_ADV_SCHEME = "PPM_01", CSV_ADV_SCHEME = "PPM_01" CTEMP_SCHEME="LEFR"/
&NAM_PARAMn CCLOUD = "KESS", CTURB = "TKEL", CRAD = "ECMW",
CDCONV = "KAFR",CSCONV="KAFR" /
-&NAM_PARAM_RADn XDTRAD = 300., XDTRAD_CLONLY = 300., NRAD_COLNBR = 400 NRAD_DIAG=5 /
+&NAM_PARAM_RADn XDTRAD = 3600., XDTRAD_CLONLY = 3600., NRAD_COLNBR = 400 /
&NAM_PARAM_KAFRn XDTCONV = 300., NICE = 1 LREFRESH_ALL = T,LDOWN = T /
&NAM_LBCn CLBCX = 2*"OPEN", CLBCY = 2*"OPEN" /
&NAM_TURBn CTURBLEN = "BL89", CTURBDIM = "1DIM", LSUBG_COND = F /
@@ -26,7 +26,8 @@
&NAM_NESTING NDAD(2) = 1, NDTRATIO(2) = 4, XWAY(2) = 2. /
&NAM_BACKUP XBAK_TIME(1,1) = 300. /
&NAM_DIAG_SURFn /
-&NAM_ISBAn CSCOND="NP89", CALBEDO="DRY",CROUGH='NONE',
+&NAM_ISBA CALBEDO="DRY" /
+&NAM_ISBAn CSCOND="NP89",
CC1DRY='DEF', CSOILFRZ='DEF', CDIFSFCOND='DEF', CSNOWRES='DEF' /
&NAM_SSOn CROUGH='Z01D' /
&NAM_DIAG_ISBAn /
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_CEN4TH b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_CEN4TH
index 72ebbc3a2d90ee30027f41dd1d00870293379472..32ba240a9ce78e73f3d472332d3db39a6bffe055 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_CEN4TH
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_CEN4TH
@@ -27,7 +27,8 @@
&NAM_NESTING NDAD(2) = 1, NDTRATIO(2) = 4, XWAY(2) = 2. /
&NAM_BACKUP XBAK_TIME(1,1) = 300. /
&NAM_DIAG_SURFn /
-&NAM_ISBAn CSCOND="NP89", CALBEDO="DRY",CROUGH='NONE',
+&NAM_ISBA CALBEDO="DRY"/
+&NAM_ISBAn CSCOND="NP89",
CC1DRY='DEF', CSOILFRZ='DEF', CDIFSFCOND='DEF', CSNOWRES='DEF' /
&NAM_SSOn CROUGH='Z01D' /
&NAM_DIAG_ISBAn /
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_WENO b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_WENO
index 485184ee3d14883e51fad08d84fd5612c88a9299..2b0b71df0a7e9d2597db598d5851b5924f75b2bf 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_WENO
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_WENO
@@ -28,7 +28,8 @@
&NAM_NESTING NDAD(2) = 1, NDTRATIO(2) = 3, XWAY(2) = 2. /
&NAM_BACKUP XBAK_TIME(1,1) = 300. /
&NAM_DIAG_SURFn /
-&NAM_ISBAn CSCOND="NP89", CALBEDO="DRY",CROUGH='NONE',
+&NAM_ISBA CALBEDO="DRY" /
+&NAM_ISBAn CSCOND="NP89",
CC1DRY='DEF', CSOILFRZ='DEF', CDIFSFCOND='DEF', CSNOWRES='DEF' /
&NAM_SSOn CROUGH='Z01D' /
&NAM_DIAG_ISBAn /
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src
index 3039ec4e9f133b9769b9a9fe97750fcc27d23f03..9588726762cf86482c3cb54750d16a6f7111dd1e 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src
@@ -5,8 +5,8 @@
NRIMX = 0, NRIMY = 0, LVE_RELAX = T, XT4DIFU = 1500. /
&NAM_ADVn CUVW_ADV_SCHEME="CEN4TH",CMET_ADV_SCHEME = "PPM_01", CSV_ADV_SCHEME = "PPM_01" CTEMP_SCHEME="LEFR"/
&NAM_PARAMn CCLOUD = "KESS", CTURB = "TKEL", CRAD = "ECMW", CDCONV = "KAFR" /
-&NAM_PARAM_RADn XDTRAD = 300., XDTRAD_CLONLY = 300., LCLEAR_SKY = F,
- NRAD_COLNBR = 400 NRAD_DIAG=5 /
+&NAM_PARAM_RADn XDTRAD = 1800., XDTRAD_CLONLY = 1800., LCLEAR_SKY = F,
+ NRAD_COLNBR = 400 /
&NAM_PARAM_KAFRn XDTCONV = 300., NICE = 1, LREFRESH_ALL = T,
LDOWN = T /
&NAM_LBCn CLBCX = 2*"OPEN", CLBCY = 2*"OPEN", XCPHASE = 20. /
@@ -15,8 +15,9 @@
&NAM_CH_MNHCn LUSECHEM = F /
&NAM_DIAG_SURFn /
&NAM_SSOn CROUGH='Z01D' /
-&NAM_ISBAn CSCOND = "NP89", CALBEDO = "DRY",CROUGH='NONE',
- CC1DRY = 'DEF', CSOILFRZ = 'DEF', CDIFSFCOND = 'DEF', CSNOWRES = 'DEF' /
+&NAM_ISBA CALBEDO = "DRY" /
+&NAM_ISBAn CSCOND = "NP89",
+ CC1DRY = 'DEF', CSOILFRZ = 'DEF', CDIFSFCOND = 'DEF', CSNOWRES = 'DEF' /
&NAM_DIAG_ISBAn /
&NAM_SEAFLUXn CSEA_ALB="UNIF" /
&NAM_BLANK /
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_CEN4TH b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_CEN4TH
index a1ef65ab960140be8e0341b4dab354c8ebf2e5fd..46d89895e125636a926cef831095aaa8c728039e 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_CEN4TH
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_CEN4TH
@@ -15,7 +15,8 @@
&NAM_CH_MNHCn LUSECHEM = F /
&NAM_DIAG_SURFn /
&NAM_SSOn CROUGH='Z01D' /
-&NAM_ISBAn CSCOND = "NP89", CALBEDO = "DRY",CROUGH='NONE',
+&NAM_ISBA CALBEDO = "DRY" /
+&NAM_ISBAn CSCOND = "NP89",
CC1DRY = 'DEF', CSOILFRZ = 'DEF', CDIFSFCOND = 'DEF', CSNOWRES = 'DEF' /
&NAM_DIAG_ISBAn /
&NAM_SEAFLUXn CSEA_ALB="UNIF" /
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_WENO b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_WENO
index aa3d2c502ecb37fdd6fa0f9a2592a3bb316d36ca..4dea95d5aa9b2d3397c0bd34b0d0b9a13f29d424 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_WENO
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_WENO
@@ -16,7 +16,8 @@
&NAM_CH_MNHCn LUSECHEM = F /
&NAM_DIAG_SURFn /
&NAM_SSOn CROUGH='Z01D' /
-&NAM_ISBAn CSCOND = "NP89", CALBEDO = "DRY",CROUGH='NONE',
+&NAM_ISBA CALBEDO = "DRY"/
+&NAM_ISBAn CSCOND = "NP89",
CC1DRY = 'DEF', CSOILFRZ = 'DEF', CDIFSFCOND = 'DEF', CSNOWRES = 'DEF' /
&NAM_DIAG_ISBAn /
&NAM_SEAFLUXn CSEA_ALB="UNIF" /
diff --git a/MY_RUN/KTEST/012_dust/006_diaprog/dirdust b/MY_RUN/KTEST/012_dust/006_diaprog/dirdust
index 08ee5bd77b50a9abb9617be16336788c3ba53f22..355cf5afcceb252104c582b52c0706d9f3fbb770 100644
--- a/MY_RUN/KTEST/012_dust/006_diaprog/dirdust
+++ b/MY_RUN/KTEST/012_dust/006_diaprog/dirdust
@@ -28,7 +28,7 @@ DSTM02T_K_2
DSTM32T_K_2
DSTM01T_K_2
DSTM31T_K_2
-FLX_DST001
-FLX_DST002
-FLX_DST003
+F_DST001P1
+F_DST002P1
+F_DST003P1
quit
diff --git a/MY_RUN/KTEST/012_dust/007_ncl/plot_dust.ncl b/MY_RUN/KTEST/012_dust/007_ncl/plot_dust.ncl
index fbbdbfecb22aaf566f8a375332e3b96ebc1a7c48..c3553f1ddca1ba123ae2514124ae2d66716430e4 100644
--- a/MY_RUN/KTEST/012_dust/007_ncl/plot_dust.ncl
+++ b/MY_RUN/KTEST/012_dust/007_ncl/plot_dust.ncl
@@ -159,21 +159,21 @@ dstm31t@units="ppp"
dstm31t@lat2d = lat2d
dstm31t@lon2d = lon2d
-flx_dst001= fichier1->FLX_DST001(jphext:jmax+jphext-1,jphext:imax+jphext-1)
-flx_dst001@long_name="FLX_DST001"
+flx_dst001= fichier1->F_DST001P1(jphext:jmax+jphext-1,jphext:imax+jphext-1)
+flx_dst001@long_name="F_DST001P1"
flx_dst001@units="kg/m2/s"
flx_dst001@lat2d = lat2d
flx_dst001@lon2d = lon2d
-flx_dst002= fichier1->FLX_DST002(jphext:jmax+jphext-1,jphext:imax+jphext-1)
-flx_dst002@long_name="FLX_DST002"
+flx_dst002= fichier1->F_DST002P1(jphext:jmax+jphext-1,jphext:imax+jphext-1)
+flx_dst002@long_name="F_DST002P1"
flx_dst002@units="kg/m2/s"
flx_dst002@lat2d = lat2d
flx_dst002@lon2d = lon2d
-flx_dst003= fichier1->FLX_DST003(jphext:jmax+jphext-1,jphext:imax+jphext-1)
-flx_dst003@long_name="FLX_DST003"
+flx_dst003= fichier1->F_DST003P1(jphext:jmax+jphext-1,jphext:imax+jphext-1)
+flx_dst003@long_name="F_DST003P1"
flx_dst003@units="kg/m2/s"
flx_dst003@lat2d = lat2d
flx_dst003@lon2d = lon2d
diff --git a/MY_RUN/KTEST/013_Iroise_ideal_case_coupling/1_INPUT_MNH/EXSEG1.nam_OCEAN b/MY_RUN/KTEST/013_Iroise_ideal_case_coupling/1_INPUT_MNH/EXSEG1.nam_OCEAN
index cc75f186c2c44aeb66658e5eb8949ab059413130..4fbe480384d07ae55d09e73165d95fcd55f3b39d 100755
--- a/MY_RUN/KTEST/013_Iroise_ideal_case_coupling/1_INPUT_MNH/EXSEG1.nam_OCEAN
+++ b/MY_RUN/KTEST/013_Iroise_ideal_case_coupling/1_INPUT_MNH/EXSEG1.nam_OCEAN
@@ -112,9 +112,8 @@
&NAM_DIAG_SURF_ATMn LFRAC=.TRUE.,
LDIAG_GRID=.TRUE. /
+&NAM_ISBA CALBEDO="DRY"/
&NAM_ISBAn CSCOND="NP89",
- CALBEDO="DRY",
- CROUGH='NONE',
CC1DRY='DEF',
CSOILFRZ='DEF',
CDIFSFCOND='DEF',
diff --git a/MY_RUN/KTEST/013_Iroise_ideal_case_coupling/1_INPUT_MNH/EXSEG1.nam_WAVE b/MY_RUN/KTEST/013_Iroise_ideal_case_coupling/1_INPUT_MNH/EXSEG1.nam_WAVE
index 5129e954aa15a4e75e0d4f9c8c4c127c8aeafde8..1f01860c280727976f5badeffdc3cface37cb44c 100755
--- a/MY_RUN/KTEST/013_Iroise_ideal_case_coupling/1_INPUT_MNH/EXSEG1.nam_WAVE
+++ b/MY_RUN/KTEST/013_Iroise_ideal_case_coupling/1_INPUT_MNH/EXSEG1.nam_WAVE
@@ -112,9 +112,8 @@
&NAM_DIAG_SURF_ATMn LFRAC=.TRUE.,
LDIAG_GRID=.TRUE. /
+&NAM_ISBA CALBEDO="DRY" /
&NAM_ISBAn CSCOND="NP89",
- CALBEDO="DRY",
- CROUGH='NONE',
CC1DRY='DEF',
CSOILFRZ='DEF',
CDIFSFCOND='DEF',
diff --git a/src/ARCH_SRC/CPL_WAVE/MNH/ground_paramn.f90 b/src/ARCH_SRC/CPL_WAVE/MNH/ground_paramn.f90
index a4ec50b760e41a66b3ca7b616196c80735288855..0735f4cca3354c4b6c72ba157ebfa6fe77bcab9e 100644
--- a/src/ARCH_SRC/CPL_WAVE/MNH/ground_paramn.f90
+++ b/src/ARCH_SRC/CPL_WAVE/MNH/ground_paramn.f90
@@ -567,9 +567,7 @@ END IF
#endif
!
IF (CPROGRAM=='DIAG ' .OR. LDIAG_IN_RUN) THEN
- CALL DIAG_SURF_ATM_n(YSURF_CUR%IM%DGEI, YSURF_CUR%FM%DGF, YSURF_CUR%DGL, YSURF_CUR%IM%DGI, &
- YSURF_CUR%SM%DGS, YSURF_CUR%DGU, YSURF_CUR%TM%DGT, YSURF_CUR%WM%DGW, &
- YSURF_CUR%U, YSURF_CUR%USS,'MESONH')
+ CALL DIAG_SURF_ATM_n(YSURF_CUR,'MESONH')
CALL MNHGET_SURF_PARAM_n(PRN=ZP_RN,PH=ZP_H,PLE=ZP_LE,PGFLUX=ZP_GFLUX, &
PT2M=ZP_T2M,PQ2M=ZP_Q2M,PHU2M=ZP_HU2M, &
PZON10M=ZP_ZON10M,PMER10M=ZP_MER10M )
diff --git a/src/ARCH_SRC/CPL_WAVE/MNH/mnh_oasis_define.F90 b/src/ARCH_SRC/CPL_WAVE/MNH/mnh_oasis_define.F90
index 7fca9653cd91f61f3f5243897717c6e225f51a7c..2c85b65a74be21e1a3e5c5c14a34e65e712d0b40 100755
--- a/src/ARCH_SRC/CPL_WAVE/MNH/mnh_oasis_define.F90
+++ b/src/ARCH_SRC/CPL_WAVE/MNH/mnh_oasis_define.F90
@@ -148,7 +148,7 @@ DEALLOCATE(ISEG_OFFSET)
!* 2. Put definitions for exchange of coupling fields :
! -------------------------------------------------
!
-CALL SFX_OASIS_DEFINE(YSURF_CUR%IM%I, YSURF_CUR%U, &
+CALL SFX_OASIS_DEFINE(YSURF_CUR%IM%O, YSURF_CUR%U, &
HPROGRAM,INPTS, IPARAL )
!
DEALLOCATE(IPARAL)
diff --git a/src/ARCH_SRC/CPL_WAVE/MNH/mnh_oasis_recv.F90 b/src/ARCH_SRC/CPL_WAVE/MNH/mnh_oasis_recv.F90
index 0f70e127eb9dd55af4bc0f4bf0eb0320236f8dd4..7050f2d5f83c8629468812b117fd1945e97afce6 100755
--- a/src/ARCH_SRC/CPL_WAVE/MNH/mnh_oasis_recv.F90
+++ b/src/ARCH_SRC/CPL_WAVE/MNH/mnh_oasis_recv.F90
@@ -87,7 +87,6 @@ USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_MNH_SURFEX_n
!
USE MODI_GET_LUOUT
-USE MODI_GOTO_SURFEX
USE MODI_SFX_OASIS_RECV
USE MODI_PUT_SFX_LAND
USE MODI_PUT_SFX_SEA
@@ -204,7 +203,8 @@ CALL SFX_OASIS_RECV(HPROGRAM,KI,KSW,ZTIME_CPL, &
!-------------------------------------------------------------------------------
!
IF(GRECV_LAND)THEN
- CALL PUT_SFX_LAND(YSURF_CUR%IM%I, YSURF_CUR%U, &
+ CALL PUT_SFX_LAND(YSURF_CUR%IM%O, YSURF_CUR%IM%S, YSURF_CUR%IM%K, &
+ YSURF_CUR%IM%NK, YSURF_CUR%IM%NP, YSURF_CUR%U, &
ILUOUT,LCPL_GW,LCPL_FLOOD, &
ZLAND_WTD (:),ZLAND_FWTD (:), &
ZLAND_FFLOOD(:),ZLAND_PIFLOOD(:) )
@@ -239,7 +239,7 @@ ENDIF
GRECV_FLOOD=(GRECV_LAND.AND.LCPL_FLOOD)
!
IF(GRECV_SEA.OR.GRECV_FLOOD)THEN
- CALL UPDATE_ESM_SURF_ATM_n(YSURF_CUR%FM%F, YSURF_CUR%IM%I, YSURF_CUR%SM%S, &
+ CALL UPDATE_ESM_SURF_ATM_n(YSURF_CUR%FM%F, YSURF_CUR%IM, YSURF_CUR%SM%S, &
YSURF_CUR%U, YSURF_CUR%WM%W, &
HPROGRAM, KI, KSW, PZENITH(:), PSW_BANDS, &
PTSRAD(:), PDIR_ALB(:,:), &
diff --git a/src/ARCH_SRC/CPL_WAVE/MNH/mnh_oasis_send.F90 b/src/ARCH_SRC/CPL_WAVE/MNH/mnh_oasis_send.F90
index 7483ea0107c5f778c1717133b3be7248aab8f35e..3768a118559987bc33ea8b0e1d31bcf6581f626b 100755
--- a/src/ARCH_SRC/CPL_WAVE/MNH/mnh_oasis_send.F90
+++ b/src/ARCH_SRC/CPL_WAVE/MNH/mnh_oasis_send.F90
@@ -73,7 +73,6 @@ USE MODD_SFX_OASIS, ONLY : LCPL_LAND,LCPL_GW, &
!
USE MODD_MNH_SURFEX_n
!
-USE MODI_GOTO_SURFEX
USE MODI_GET_SFX_LAND
USE MODI_GET_SFX_LAKE
USE MODI_GET_SFX_SEA
@@ -99,7 +98,6 @@ REAL, DIMENSION(KI) :: ZLAND_RUNOFF ! Cumulated Surface runoff
REAL, DIMENSION(KI) :: ZLAND_DRAIN ! Cumulated Deep drainage (kg/m2)
REAL, DIMENSION(KI) :: ZLAND_CALVING ! Cumulated Calving flux (kg/m2)
REAL, DIMENSION(KI) :: ZLAND_RECHARGE ! Cumulated Recharge to groundwater (kg/m2)
-REAL, DIMENSION(KI) :: ZLAND_WATFLD ! Cumulated net freshwater rate (kg/m2)
!
REAL, DIMENSION(KI) :: ZLAKE_EVAP ! Cumulated Evaporation (kg/m2)
REAL, DIMENSION(KI) :: ZLAKE_RAIN ! Cumulated Rainfall rate (kg/m2)
@@ -158,7 +156,6 @@ IF(GSEND_LAND)THEN
ZLAND_DRAIN (:) = XUNDEF
ZLAND_CALVING (:) = XUNDEF
ZLAND_RECHARGE(:) = XUNDEF
- ZLAND_WATFLD (:) = XUNDEF
ENDIF
!
IF(GSEND_LAKE)THEN
@@ -201,11 +198,10 @@ IF(GSEND_LAND)THEN
!
! * Get river output fields
!
- CALL GET_SFX_LAND(YSURF_CUR%IM%I,YSURF_CUR%U, &
+ CALL GET_SFX_LAND(YSURF_CUR%IM%O, YSURF_CUR%IM%S, YSURF_CUR%U, &
LCPL_GW,LCPL_FLOOD,LCPL_CALVING, &
ZLAND_RUNOFF (:),ZLAND_DRAIN (:), &
- ZLAND_CALVING(:),ZLAND_RECHARGE(:), &
- ZLAND_WATFLD (:) )
+ ZLAND_CALVING(:),ZLAND_RECHARGE(:) )
!
ENDIF
!
@@ -237,7 +233,7 @@ IF(GSEND_WAVE)THEN
!
! * Get wave output fields
!
- CALL GET_SFX_WAVE(YSURF_CUR%U, YSURF_CUR%SM%DGS, &
+ CALL GET_SFX_WAVE(YSURF_CUR%U, YSURF_CUR%SM%SD%D, &
ZWAVE_U10(:), ZWAVE_V10(:) )
!
ENDIF
@@ -250,7 +246,6 @@ ENDIF
!
CALL SFX_OASIS_SEND(ILUOUT,KI,IDATE,GSEND_LAND,GSEND_LAKE,GSEND_SEA,GSEND_WAVE, &
ZLAND_RUNOFF,ZLAND_DRAIN,ZLAND_CALVING,ZLAND_RECHARGE, &
- ZLAND_WATFLD, &
ZLAKE_EVAP,ZLAKE_RAIN,ZLAKE_SNOW,ZLAKE_WATF, &
ZSEA_FWSU,ZSEA_FWSV,ZSEA_HEAT,ZSEA_SNET,ZSEA_WIND, &
ZSEA_FWSM,ZSEA_EVAP,ZSEA_RAIN,ZSEA_SNOW, &
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/coare30_flux.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/coare30_flux.F90
index e1cdf085020a7e18097e273c9b301d74cb2d73b3..ac88af8c3f88e436e24aff26cbc1d5ecfbc7971b 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/coare30_flux.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/coare30_flux.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE COARE30_FLUX (S, &
- PZ0SEA,PTA,PEXNA,PRHOA,PSST,PEXNS,PQA, &
+ SUBROUTINE COARE30_FLUX (S,PZ0SEA,PTA,PEXNA,PRHOA,PSST,PEXNS,PQA, &
PVMOD,PZREF,PUREF,PPS,PQSAT,PSFTH,PSFTQ,PUSTAR,PCD,PCDN,PCH,PCE,PRI,&
PRESA,PRAIN,PZ0HSEA,PHS,PTP)
! #######################################################################
@@ -71,6 +70,7 @@ USE MODD_CSTS, ONLY : XKARMAN, XG, XSTEFAN, XRD, XRV, XPI, &
USE MODD_SURF_ATM, ONLY : XVZ0CM
!
USE MODD_SFX_OASIS, ONLY : LCPL_WAVE
+!
USE MODD_SURF_PAR, ONLY : XUNDEF, XSURF_EPSILON
USE MODD_WATER_PAR
!
@@ -530,6 +530,8 @@ PRESA(:) = 1. / MAX(ZAC(:),XSURF_EPSILON)
!
! 5.3 Z0 and Z0H over sea
!
+PZ0SEA(:) = ZCHARN(:) * ZUSTAR2(:) / XG + XVZ0CM * PCD(:) / PCDN(:)
+!
PZ0SEA(:) = MAX(MIN(ZO(:),0.05),10E-6)
!
PZ0HSEA(:) = PZ0SEA(:)
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/coare30_seaflux.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/coare30_seaflux.F90
index 2241194321f710371ea128caafa038fa06dceae8..4dd0ea977cc39925c4ef584851cf5637f9f376aa 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/coare30_seaflux.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/coare30_seaflux.F90
@@ -3,12 +3,11 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE COARE30_SEAFLUX (S, &
- PMASK,KSIZE_WATER,KSIZE_ICE, &
- PTA,PEXNA,PRHOA,PSST,PEXNS,PQA, &
- PRAIN,PSNOW,PVMOD,PZREF,PUREF,PPS, &
- PQSAT,PSFTH,PSFTQ,PUSTAR, &
- PCD,PCDN,PCH,PCE,PRI,PRESA,PZ0HSEA,PHS,PTP)
+ SUBROUTINE COARE30_SEAFLUX (S, PMASK,KSIZE_WATER,KSIZE_ICE, &
+ PTA,PEXNA,PRHOA,PSST,PEXNS,PQA, &
+ PRAIN,PSNOW,PVMOD,PZREF,PUREF,PPS, &
+ PQSAT,PSFTH,PSFTQ,PUSTAR, &
+ PCD,PCDN,PCH,PCE,PRI,PRESA,PZ0HSEA )
! ##################################################################
!
!
@@ -84,8 +83,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PVMOD ! module of wind at atm. wind level (
REAL, DIMENSION(:), INTENT(IN) :: PZREF ! atm. level for temp. and humidity (m)
REAL, DIMENSION(:), INTENT(IN) :: PUREF ! atm. level for wind (m)
REAL, DIMENSION(:), INTENT(IN) :: PSST ! Sea Surface Temperature (K)
-REAL, DIMENSION(:), INTENT(IN) :: PHS ! wave significant height
-REAL, DIMENSION(:), INTENT(IN) :: PTP ! Wave peak period
REAL, DIMENSION(:), INTENT(IN) :: PEXNS ! Exner function at sea surface
REAL, DIMENSION(:), INTENT(IN) :: PPS ! air pressure at sea surface (Pa)
REAL, DIMENSION(:), INTENT(IN) :: PRAIN ! precipitation rate (kg/s/m2)
@@ -213,8 +210,8 @@ DO JJ=1, SIZE(KMASK)
ZW_ZREF(JJ) = PZREF(KMASK(JJ))
ZW_UREF(JJ) = PUREF(KMASK(JJ))
ZW_SST(JJ) = PSST(KMASK(JJ))
- ZW_TP(JJ) = PTP(KMASK(JJ))
- ZW_HS(JJ) = PHS(KMASK(JJ))
+ ZW_TP(JJ) = S%XTP(KMASK(JJ))
+ ZW_HS(JJ) = S%XHS(KMASK(JJ))
ZW_EXNS(JJ) = PEXNS(KMASK(JJ))
ZW_PS(JJ) = PPS(KMASK(JJ))
ZW_RAIN(JJ) = PRAIN(KMASK(JJ))
@@ -236,8 +233,7 @@ ZW_Z0HSEA(:) = XUNDEF
!
IF (YTYPE=='W') THEN
!
- CALL COARE30_FLUX(S, &
- ZW_Z0SEA,ZW_TA,ZW_EXNA,ZW_RHOA,ZW_SST,ZW_EXNS,&
+ CALL COARE30_FLUX(S, ZW_Z0SEA,ZW_TA,ZW_EXNA,ZW_RHOA,ZW_SST,ZW_EXNS,&
ZW_QA,ZW_VMOD,ZW_ZREF,ZW_UREF,ZW_PS,ZW_QSAT,ZW_SFTH,ZW_SFTQ,ZW_USTAR,&
ZW_CD,ZW_CDN,ZW_CH,ZW_CE,ZW_RI,ZW_RESA,ZW_RAIN,ZW_Z0HSEA,ZW_HS,ZW_TP)
!
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/coupling_seafluxn.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/coupling_seafluxn.F90
index 40fc1d1905ff83fcc55ed7d9059127a6f2c7bfea..5ea7b516c971576bf25a3d80fa24f72ba2f7690c 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/coupling_seafluxn.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/coupling_seafluxn.F90
@@ -3,16 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################################
-SUBROUTINE COUPLING_SEAFLUX_n (SM, DST, SLT, &
- HPROGRAM, HCOUPLING, PTIMEC, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, &
- PAZIM, PZREF, PUREF, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+SUBROUTINE COUPLING_SEAFLUX_n (CHS, DTS, DGS, O, OR, G, S, DST, SLT, &
+ HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
+ KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, &
+ PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, &
+ PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, &
+ PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, &
+ PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, &
+ PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST )
! ###############################################################################
!
!!**** *COUPLING_SEAFLUX_n * - Driver of the WATER_FLUX scheme for sea
@@ -55,8 +53,13 @@ SUBROUTINE COUPLING_SEAFLUX_n (SM, DST, SLT, &
!!---------------------------------------------------------------------
!
!
-!
-USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t
+USE MODD_CH_SEAFLUX_n, ONLY : CH_SEAFLUX_t
+USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_t
+USE MODD_SURFEX_n, ONLY : SEAFLUX_DIAG_t
+USE MODD_OCEAN_n, ONLY : OCEAN_t
+USE MODD_OCEAN_REL_n, ONLY : OCEAN_REL_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
!
USE MODD_DST_n, ONLY : DST_t
USE MODD_SLT_n, ONLY : SLT_t
@@ -106,14 +109,20 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM
+TYPE(CH_SEAFLUX_t), INTENT(INOUT) :: CHS
+TYPE(DATA_SEAFLUX_t), INTENT(INOUT) :: DTS
+TYPE(SEAFLUX_DIAG_t), INTENT(INOUT) :: DGS
+TYPE(OCEAN_t), INTENT(INOUT) :: O
+TYPE(OCEAN_REL_t), INTENT(INOUT) :: OR
+TYPE(GRID_t), INTENT(INOUT) :: G
+TYPE(SEAFLUX_t), INTENT(INOUT) :: S
TYPE(DST_t), INTENT(INOUT) :: DST
TYPE(SLT_t), INTENT(INOUT) :: SLT
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
- CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling
- ! 'E' : explicit
- ! 'I' : implicit
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling
+ ! 'E' : explicit
+ ! 'I' : implicit
REAL, INTENT(IN) :: PTIMEC ! current duration since start of the run (s)
INTEGER, INTENT(IN) :: KYEAR ! current year (UTC)
INTEGER, INTENT(IN) :: KMONTH ! current month (UTC)
@@ -133,7 +142,7 @@ REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density
REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables
! ! chemistry: first char. in HSV: '#' (molecule/m3)
! !
- CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables
+CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables
REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s)
REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s)
REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.)
@@ -175,7 +184,7 @@ REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF
- CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
+CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
!
!* 0.2 declarations of local variables
!
@@ -238,6 +247,8 @@ INTEGER :: ISWB ! number of shortwave spectral ba
INTEGER :: JSWB ! loop counter on shortwave spectral bands
INTEGER :: ISLT ! number of sea salt variable
!
+INTEGER :: IBEG, IEND
+!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
! Preliminaries:
@@ -292,8 +303,8 @@ ZEXNA(:) = (PPA(:)/XP00)**(XRD/XCPD)
!
IF(LCPL_SEA .OR. LCPL_WAVE)THEN
!Sea currents are taken into account
- ZU(:)=PU(:)-SM%S%XUMER(:)
- ZV(:)=PV(:)-SM%S%XVMER(:)
+ ZU(:)=PU(:)-S%XUMER(:)
+ ZV(:)=PV(:)-S%XVMER(:)
ELSE
ZU(:)=PU(:)
ZV(:)=PV(:)
@@ -311,71 +322,59 @@ ZQA(:) = PQA(:) / PRHOA(:)
! Time evolution
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-SM%S%TTIME%TIME = SM%S%TTIME%TIME + PTSTEP
- CALL ADD_FORECAST_TO_DATE_SURF(SM%S%TTIME%TDATE%YEAR,SM%S%TTIME%TDATE%MONTH,SM%S%TTIME%TDATE%DAY,SM%S%TTIME%TIME)
+S%TTIME%TIME = S%TTIME%TIME + PTSTEP
+ CALL ADD_FORECAST_TO_DATE_SURF(S%TTIME%TDATE%YEAR,S%TTIME%TDATE%MONTH,S%TTIME%TDATE%DAY,S%TTIME%TIME)
!
!--------------------------------------------------------------------------------------
! Fluxes over water according to Charnock formulae
!--------------------------------------------------------------------------------------
!
-IF (SM%S%LHANDLE_SIC) THEN
- ! Flux for sea are computed everywhere
- ISIZE_WATER = SIZE(ZMASK)
- ! Ensure freezing SST values where XSST actually has very low (sea-ice) values (old habits)
- ZSST(:)=MAX(SM%S%XSST(:), XTTSI)
- ! Flux over sea-ice will not be computed by next calls, but by coupling_iceflux. Hence :
- ISIZE_ICE = 0
- ! Flux over sea-ice will be computed by coupling_iceflux anywhere sea-ice could form in one
- ! time-step (incl. under forcing). ZMASK value is set to 1. on these points
- ZMASK(:)=0.
- WHERE ( SM%S%XSIC(:) > 0. ) ZMASK(:)=1.
- ! To be large, assume that seaice may form where SST is < 10C
- WHERE ( SM%S%XSST(:) - XTTS <= 10. ) ZMASK(:)=1.
- IF (SM%S%LINTERPOL_SIC) WHERE (SM%S%XFSIC(:) > 0. ) ZMASK(:)=1.
- IF (SM%S%LINTERPOL_SIT) WHERE (SM%S%XFSIT(:) > 0. ) ZMASK(:)=1.
+IF (S%LHANDLE_SIC) THEN
+ ! Flux for sea are computed everywhere
+ ISIZE_WATER = SIZE(ZMASK)
+ ! Ensure freezing SST values where XSST actually has very low (sea-ice) values (old habits)
+ ZSST(:)=MAX(S%XSST(:), XTTSI)
+ ! Flux over sea-ice will not be computed by next calls, but by coupling_iceflux. Hence :
+ ISIZE_ICE = 0
+ ! Flux over sea-ice will be computed by coupling_iceflux anywhere sea-ice could form in one
+ ! time-step (incl. under forcing). ZMASK value is set to 1. on these points
+ ZMASK(:)=0.
+ WHERE ( S%XSIC(:) > 0. ) ZMASK(:)=1.
+ ! To be large, assume that seaice may form where SST is < 10C
+ WHERE ( S%XSST(:) - XTTS <= 10. ) ZMASK(:)=1.
+ IF (S%LINTERPOL_SIC) WHERE (S%XFSIC(:) > 0. ) ZMASK(:)=1.
+ IF (S%LINTERPOL_SIT) WHERE (S%XFSIT(:) > 0. ) ZMASK(:)=1.
ELSE
- ZSST (:) = SM%S%XSST(:)
- ZMASK(:) = SM%S%XSST(:) - XTTS
- ISIZE_WATER = COUNT(ZMASK(:)>=0.)
- ISIZE_ICE = SIZE(SM%S%XSST) - ISIZE_WATER
+ ZSST (:) = S%XSST(:)
+ ZMASK(:) = S%XSST(:) - XTTS
+ ISIZE_WATER = COUNT(ZMASK(:)>=0.)
+ ISIZE_ICE = SIZE(S%XSST) - ISIZE_WATER
ENDIF
!
-SELECT CASE (SM%S%CSEA_FLUX)
- CASE ('DIRECT')
- CALL WATER_FLUX(SM%S%XZ0, &
- PTA, ZEXNA, PRHOA, ZSST, ZEXNS, ZQA, PRAIN, &
- PSNOW, XTTS, &
- ZWIND, PZREF, PUREF, &
- PPS, SM%S%LHANDLE_SIC, ZQSAT, &
- ZSFTH, ZSFTQ, ZUSTAR, &
- ZCD, ZCDN, ZCH, ZRI, ZRESA_SEA, ZZ0H )
- CASE ('ITERAT')
- CALL MR98 (SM%S%XZ0, &
- PTA, ZEXNA, PRHOA, SM%S%XSST, ZEXNS, ZQA, &
- XTTS, &
- ZWIND, PZREF, PUREF, &
- PPS, ZQSAT, &
- ZSFTH, ZSFTQ, ZUSTAR, &
- ZCD, ZCDN, ZCH, ZRI, ZRESA_SEA, ZZ0H )
- CASE ('ECUME ','ECUME6')
- CALL ECUME_SEAFLUX(SM%S%XZ0, ZMASK, ISIZE_WATER, ISIZE_ICE, &
- PTA, ZEXNA ,PRHOA, ZSST, SM%S%XSSS, ZEXNS, ZQA, &
- PRAIN, PSNOW, &
- ZWIND, PZREF, PUREF, PPS, PPA, &
- SM%S%XICHCE, SM%S%LPRECIP, SM%S%LPWEBB, SM%S%LPWG, SM%S%NZ0, &
- SM%S%LHANDLE_SIC, ZQSAT, ZSFTH, ZSFTQ, ZUSTAR, &
- ZCD, ZCDN, ZCH, ZCE, ZRI, ZRESA_SEA, ZZ0H, &
- SM%S%LPERTFLUX, SM%S%XPERTFLUX, SM%S%CSEA_FLUX )
- CASE ('COARE3')
- CALL COARE30_SEAFLUX(SM%S, &
- ZMASK, ISIZE_WATER, ISIZE_ICE, &
- PTA, ZEXNA ,PRHOA, ZSST, ZEXNS, ZQA, PRAIN, &
- PSNOW, &
- ZWIND, PZREF, PUREF, &
- PPS, ZQSAT, &
- ZSFTH, ZSFTQ, ZUSTAR, &
- ZCD, ZCDN, ZCH, ZCE, ZRI, ZRESA_SEA, ZZ0H, &
- SM%S%XHS, SM%S%XTP )
+SELECT CASE (S%CSEA_FLUX)
+CASE ('DIRECT')
+CALL WATER_FLUX(S%XZ0, PTA, ZEXNA, PRHOA, ZSST, ZEXNS, ZQA, &
+ PRAIN, PSNOW, XTTS, ZWIND, PZREF, PUREF, &
+ PPS, S%LHANDLE_SIC, ZQSAT, ZSFTH, ZSFTQ, &
+ ZUSTAR, ZCD, ZCDN, ZCH, ZRI, ZRESA_SEA, ZZ0H )
+CASE ('ITERAT')
+CALL MR98 (S%XZ0, PTA, ZEXNA, PRHOA, S%XSST, ZEXNS, ZQA, &
+ XTTS, ZWIND, PZREF, PUREF, PPS, ZQSAT, &
+ ZSFTH, ZSFTQ, ZUSTAR, &
+ ZCD, ZCDN, ZCH, ZRI, ZRESA_SEA, ZZ0H )
+
+CASE ('ECUME ','ECUME6')
+CALL ECUME_SEAFLUX(S, ZMASK, ISIZE_WATER, ISIZE_ICE, &
+ PTA, ZEXNA ,PRHOA, ZSST, ZEXNS, ZQA, &
+ PRAIN, PSNOW, ZWIND, PZREF, PUREF, PPS, PPA, &
+ ZQSAT, ZSFTH, ZSFTQ, ZUSTAR, &
+ ZCD, ZCDN, ZCH, ZCE, ZRI, ZRESA_SEA, ZZ0H )
+CASE ('COARE3')
+CALL COARE30_SEAFLUX(S, ZMASK, ISIZE_WATER, ISIZE_ICE, &
+ PTA, ZEXNA ,PRHOA, ZSST, ZEXNS, ZQA, PRAIN, &
+ PSNOW, ZWIND, PZREF, PUREF, PPS, ZQSAT, &
+ ZSFTH, ZSFTQ, ZUSTAR, &
+ ZCD, ZCDN, ZCH, ZCE, ZRI, ZRESA_SEA, ZZ0H )
END SELECT
!
!-------------------------------------------------------------------------------------
@@ -385,18 +384,17 @@ END SELECT
ISWB = SIZE(PSW_BANDS)
!
DO JSWB=1,ISWB
- ZDIR_ALB(:,JSWB) = SM%S%XDIR_ALB(:)
- ZSCA_ALB(:,JSWB) = SM%S%XSCA_ALB(:)
+ZDIR_ALB(:,JSWB) = S%XDIR_ALB(:)
+ZSCA_ALB(:,JSWB) = S%XSCA_ALB(:)
END DO
!
-IF (SM%S%LHANDLE_SIC) THEN
- ZEMIS(:) = (1 - SM%S%XSIC(:)) * XEMISWAT + SM%S%XSIC(:) * XEMISWATICE
- ZTRAD(:) = (((1 - SM%S%XSIC(:)) * XEMISWAT * SM%S%XSST (:)**4 + &
- SM%S%XSIC(:) * XEMISWATICE * SM%S%XTICE(:)**4)/ &
- ZEMIS(:)) ** 0.25
+IF (S%LHANDLE_SIC) THEN
+ZEMIS(:) = (1 - S%XSIC(:)) * XEMISWAT + S%XSIC(:) * XEMISWATICE
+ZTRAD(:) = (((1 - S%XSIC(:)) * XEMISWAT * S%XSST (:)**4 + &
+ S%XSIC(:) * XEMISWATICE * S%XTICE(:)**4)/ ZEMIS(:)) ** 0.25
ELSE
- ZTRAD(:) = SM%S%XSST (:)
- ZEMIS(:) = SM%S%XEMIS(:)
+ZTRAD(:) = S%XSST (:)
+ZEMIS(:) = S%XEMIS(:)
END IF
!
!-------------------------------------------------------------------------------------
@@ -404,26 +402,26 @@ END IF
!seaice scheme)
!-------------------------------------------------------------------------------------
!
-IF(LCPL_SEAICE.OR.SM%S%LHANDLE_SIC)THEN
- CALL COUPLING_ICEFLUX_n(KI, PTA, ZEXNA, PRHOA, SM%S%XTICE, ZEXNS, &
- ZQA, PRAIN, PSNOW, ZWIND, PZREF, PUREF, &
- PPS, SM%S%XSST, XTTS, ZSFTH_ICE, ZSFTQ_ICE, &
- SM%S%LHANDLE_SIC, ZMASK, ZQSAT_ICE, ZZ0_ICE, &
- ZUSTAR_ICE, ZCD_ICE, ZCDN_ICE, ZCH_ICE, &
- ZRI_ICE, ZRESA_SEA_ICE, ZZ0H_ICE )
+IF(LCPL_SEAICE.OR.S%LHANDLE_SIC)THEN
+CALL COUPLING_ICEFLUX_n(KI, PTA, ZEXNA, PRHOA, S%XTICE, ZEXNS, &
+ ZQA, PRAIN, PSNOW, ZWIND, PZREF, PUREF, &
+ PPS, S%XSST, XTTS, ZSFTH_ICE, ZSFTQ_ICE, &
+ S%LHANDLE_SIC, ZMASK, ZQSAT_ICE, ZZ0_ICE, &
+ ZUSTAR_ICE, ZCD_ICE, ZCDN_ICE, ZCH_ICE, &
+ ZRI_ICE, ZRESA_SEA_ICE, ZZ0H_ICE )
ENDIF
!
-IF (SM%S%LHANDLE_SIC) CALL COMPLEMENT_EACH_OTHER_FLUX
+IF (S%LHANDLE_SIC) CALL COMPLEMENT_EACH_OTHER_FLUX
!
!-------------------------------------------------------------------------------------
-! Momentum fluxes over sea or sea-ice
+! Momentum fluxes over sea or se-ice
!-------------------------------------------------------------------------------------
!
- CALL SEA_MOMENTUM_FLUXES(ZCD, ZSFU, ZSFV)
+CALL SEA_MOMENTUM_FLUXES(ZCD, ZSFU, ZSFV)
!
! Momentum fluxes over sea-ice if embedded seaice scheme is used
!
-IF (SM%S%LHANDLE_SIC) CALL SEA_MOMENTUM_FLUXES(ZCD_ICE, ZSFU_ICE, ZSFV_ICE)
+IF (S%LHANDLE_SIC) CALL SEA_MOMENTUM_FLUXES(ZCD_ICE, ZSFU_ICE, ZSFV_ICE)
!
! CO2 flux
!
@@ -444,105 +442,122 @@ PSFCO2(:) = - ZWIND(:)**2 * 1.13E-3 * 8.7 * 44.E-3 / ( 365*24*3600 )
! Scalar fluxes:
!-------------------------------------------------------------------------------------
!
-IF (SM%CHS%SVS%NBEQ>0) THEN
- IF (SM%CHS%CCH_DRY_DEP == "WES89") THEN
-
- CALL CH_DEP_WATER (ZRESA_SEA, ZUSTAR, PTA, ZTRAD, &
- PSV(:,SM%CHS%SVS%NSV_CHSBEG:SM%CHS%SVS%NSV_CHSEND), &
- SM%CHS%SVS%CSV(SM%CHS%SVS%NSV_CHSBEG:SM%CHS%SVS%NSV_CHSEND), &
- SM%CHS%XDEP(:,1:SM%CHS%SVS%NBEQ) )
-
- PSFTS(:,SM%CHS%SVS%NSV_CHSBEG:SM%CHS%SVS%NSV_CHSEND) = - PSV(:,SM%CHS%SVS%NSV_CHSBEG:SM%CHS%SVS%NSV_CHSEND) &
- * SM%CHS%XDEP(:,1:SM%CHS%SVS%NBEQ)
- IF (SM%CHS%SVS%NAEREQ > 0 ) THEN
- CALL CH_AER_DEP(PSV(:,SM%CHS%SVS%NSV_AERBEG:SM%CHS%SVS%NSV_AEREND),&
- PSFTS(:,SM%CHS%SVS%NSV_AERBEG:SM%CHS%SVS%NSV_AEREND),&
- ZUSTAR,ZRESA_SEA,PTA,PRHOA)
- END IF
-
+IF (CHS%SVS%NBEQ>0) THEN
+ !
+ IF (CHS%CCH_DRY_DEP == "WES89") THEN
+ !
+ IBEG = CHS%SVS%NSV_CHSBEG
+ IEND = CHS%SVS%NSV_CHSEND
+ !
+ CALL CH_DEP_WATER (ZRESA_SEA, ZUSTAR, PTA, ZTRAD,PSV(:,IBEG:IEND), &
+ CHS%SVS%CSV(IBEG:IEND), CHS%XDEP(:,1:CHS%SVS%NBEQ) )
+ !
+ PSFTS(:,IBEG:IEND) = - PSV(:,IBEG:IEND) * CHS%XDEP(:,1:CHS%SVS%NBEQ)
+ !
+ IF (CHS%SVS%NAEREQ > 0 ) THEN
+ !
+ IBEG = CHS%SVS%NSV_AERBEG
+ IEND = CHS%SVS%NSV_AEREND
+ !
+ CALL CH_AER_DEP(PSV(:,IBEG:IEND),PSFTS(:,IBEG:IEND),ZUSTAR,ZRESA_SEA,PTA,PRHOA)
+ !
+ END IF
+ !
ELSE
- PSFTS(:,SM%CHS%SVS%NSV_CHSBEG:SM%CHS%SVS%NSV_CHSEND) =0.
- IF (SM%CHS%SVS%NSV_AEREND.GT.SM%CHS%SVS%NSV_AERBEG) PSFTS(:,SM%CHS%SVS%NSV_AERBEG:SM%CHS%SVS%NSV_AEREND) =0.
+ !
+ IBEG = CHS%SVS%NSV_AERBEG
+ IEND = CHS%SVS%NSV_AEREND
+ !
+ PSFTS(:,IBEG:IEND) =0.
+ IF (IEND.GT.IBEG) PSFTS(:,IBEG:IEND) =0.
+ !
ENDIF
+ !
ENDIF
!
-IF (SM%CHS%SVS%NSLTEQ>0) THEN
- ISLT = SM%CHS%SVS%NSV_SLTEND - SM%CHS%SVS%NSV_SLTBEG + 1
-
- CALL COUPLING_SLT_n(SLT, &
- SIZE(ZUSTAR,1), & !I [nbr] number of sea point
- ISLT, & !I [nbr] number of sea salt variables
- ZWIND, & !I [m/s] wind velocity
- PSFTS(:,SM%CHS%SVS%NSV_SLTBEG:SM%CHS%SVS%NSV_SLTEND) )
-ENDIF
-!
-IF (SM%CHS%SVS%NDSTEQ>0) THEN
- CALL DSLT_DEP(PSV(:,SM%CHS%SVS%NSV_DSTBEG:SM%CHS%SVS%NSV_DSTEND), PSFTS(:,SM%CHS%SVS%NSV_DSTBEG:SM%CHS%SVS%NSV_DSTEND), &
- ZUSTAR, ZRESA_SEA, PTA, PRHOA, DST%XEMISSIG_DST, DST%XEMISRADIUS_DST, &
- JPMODE_DST, XDENSITY_DST, XMOLARWEIGHT_DST, ZCONVERTFACM0_DST, &
- ZCONVERTFACM6_DST, ZCONVERTFACM3_DST, LVARSIG_DST, LRGFIX_DST, &
- CVERMOD )
-
+IF (CHS%SVS%NDSTEQ>0) THEN
+ !
+ IBEG = CHS%SVS%NSV_DSTBEG
+ IEND = CHS%SVS%NSV_DSTEND
+ !
+ CALL DSLT_DEP(PSV(:,IBEG:IEND), PSFTS(:,IBEG:IEND), ZUSTAR, ZRESA_SEA, PTA, &
+ PRHOA, DST%XEMISSIG_DST, DST%XEMISRADIUS_DST, JPMODE_DST, &
+ XDENSITY_DST, XMOLARWEIGHT_DST, ZCONVERTFACM0_DST, ZCONVERTFACM6_DST, &
+ ZCONVERTFACM3_DST, LVARSIG_DST, LRGFIX_DST, CVERMOD )
+ !
CALL MASSFLUX2MOMENTFLUX( &
- PSFTS(:,SM%CHS%SVS%NSV_DSTBEG:SM%CHS%SVS%NSV_DSTEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
- PRHOA, & !I [kg/m3] air density
- DST%XEMISRADIUS_DST, &!I [um] emitted radius for the modes (max 3)
- DST%XEMISSIG_DST, &!I [-] emitted sigma for the different modes (max 3)
- NDSTMDE, &
- ZCONVERTFACM0_DST, &
- ZCONVERTFACM6_DST, &
- ZCONVERTFACM3_DST, &
- LVARSIG_DST, LRGFIX_DST )
+ PSFTS(:,IBEG:IEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
+ PRHOA, & !I [kg/m3] air density
+ DST%XEMISRADIUS_DST, &!I [um] emitted radius for the modes (max 3)
+ DST%XEMISSIG_DST, &!I [-] emitted sigma for the different modes (max 3)
+ NDSTMDE, &
+ ZCONVERTFACM0_DST, &
+ ZCONVERTFACM6_DST, &
+ ZCONVERTFACM3_DST, &
+ LVARSIG_DST, LRGFIX_DST )
+ !
ENDIF
-
-IF (SM%CHS%SVS%NSLTEQ>0) THEN
- CALL DSLT_DEP(PSV(:,SM%CHS%SVS%NSV_SLTBEG:SM%CHS%SVS%NSV_SLTEND), PSFTS(:,SM%CHS%SVS%NSV_SLTBEG:SM%CHS%SVS%NSV_SLTEND), &
- ZUSTAR, ZRESA_SEA, PTA, PRHOA, SLT%XEMISSIG_SLT, SLT%XEMISRADIUS_SLT, &
- JPMODE_SLT, XDENSITY_SLT, XMOLARWEIGHT_SLT, ZCONVERTFACM0_SLT, &
- ZCONVERTFACM6_SLT, ZCONVERTFACM3_SLT, LVARSIG_SLT, LRGFIX_SLT, &
- CVERMOD )
-
+!
+IF (CHS%SVS%NSLTEQ>0) THEN
+ !
+ IBEG = CHS%SVS%NSV_SLTBEG
+ IEND = CHS%SVS%NSV_SLTEND
+ !
+ ISLT = IEND - IBEG + 1
+ !
+ CALL COUPLING_SLT_n(SLT, &
+ SIZE(ZUSTAR,1), & !I [nbr] number of sea point
+ ISLT, & !I [nbr] number of sea salt variables
+ ZWIND, & !I [m/s] wind velocity
+ PSFTS(:,IBEG:IEND) )
+ !
+ CALL DSLT_DEP(PSV(:,IBEG:IEND), PSFTS(:,IBEG:IEND), ZUSTAR, ZRESA_SEA, PTA, &
+ PRHOA, SLT%XEMISSIG_SLT, SLT%XEMISRADIUS_SLT, JPMODE_SLT, &
+ XDENSITY_SLT, XMOLARWEIGHT_SLT, ZCONVERTFACM0_SLT, ZCONVERTFACM6_SLT, &
+ ZCONVERTFACM3_SLT, LVARSIG_SLT, LRGFIX_SLT, CVERMOD )
+ !
CALL MASSFLUX2MOMENTFLUX( &
- PSFTS(:,SM%CHS%SVS%NSV_SLTBEG:SM%CHS%SVS%NSV_SLTEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
- PRHOA, & !I [kg/m3] air density
- SLT%XEMISRADIUS_SLT, &!I [um] emitted radius for the modes (max 3)
- SLT%XEMISSIG_SLT, &!I [-] emitted sigma for the different modes (max 3)
- NSLTMDE, &
- ZCONVERTFACM0_SLT, &
- ZCONVERTFACM6_SLT, &
- ZCONVERTFACM3_SLT, &
- LVARSIG_SLT, LRGFIX_SLT )
+ PSFTS(:,IBEG:IEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
+ PRHOA, & !I [kg/m3] air density
+ SLT%XEMISRADIUS_SLT, &!I [um] emitted radius for the modes (max 3)
+ SLT%XEMISSIG_SLT, &!I [-] emitted sigma for the different modes (max 3)
+ NSLTMDE, &
+ ZCONVERTFACM0_SLT, &
+ ZCONVERTFACM6_SLT, &
+ ZCONVERTFACM3_SLT, &
+ LVARSIG_SLT, LRGFIX_SLT )
+ !
ENDIF
!
!-------------------------------------------------------------------------------
! Inline diagnostics at time t for SST and TRAD
!-------------------------------------------------------------------------------
!
- CALL DIAG_INLINE_SEAFLUX_n(SM%DGS, SM%DGSI, SM%S, &
- PTSTEP, PTA, ZQA, PPA, PPS, PRHOA, PU, &
- PV, PZREF, PUREF, ZCD, ZCDN, ZCH, ZCE, ZRI, ZHU, &
- ZZ0H, ZQSAT, ZSFTH, ZSFTQ, ZSFU, ZSFV, &
- PDIR_SW, PSCA_SW, PLW, ZDIR_ALB, ZSCA_ALB, &
- ZEMIS, ZTRAD, PRAIN, PSNOW, &
- ZCD_ICE, ZCDN_ICE, ZCH_ICE, ZCE_ICE, ZRI_ICE, &
- ZZ0_ICE, ZZ0H_ICE, ZQSAT_ICE, ZSFTH_ICE, ZSFTQ_ICE, &
- ZSFU_ICE, ZSFV_ICE)
+CALL DIAG_INLINE_SEAFLUX_n(DGS%O, DGS%D, DGS%DC, DGS%DI, DGS%DIC, DGS%DMI, &
+ S, PTSTEP, PTA, ZQA, PPA, PPS, PRHOA, PU, &
+ PV, PZREF, PUREF, ZCD, ZCDN, ZCH, ZCE, ZRI, ZHU,&
+ ZZ0H, ZQSAT, ZSFTH, ZSFTQ, ZSFU, ZSFV, &
+ PDIR_SW, PSCA_SW, PLW, ZDIR_ALB, ZSCA_ALB, &
+ ZEMIS, ZTRAD, PRAIN, PSNOW, &
+ ZCD_ICE, ZCDN_ICE, ZCH_ICE, ZCE_ICE, ZRI_ICE, &
+ ZZ0_ICE, ZZ0H_ICE, ZQSAT_ICE, ZSFTH_ICE, &
+ ZSFTQ_ICE, ZSFU_ICE, ZSFV_ICE)
!
!-------------------------------------------------------------------------------
! A kind of "average_flux"
!-------------------------------------------------------------------------------
!
-IF (SM%S%LHANDLE_SIC) THEN
- PSFTH (:) = ZSFTH (:) * ( 1 - SM%S%XSIC (:)) + ZSFTH_ICE(:) * SM%S%XSIC(:)
- PSFTQ (:) = ZSFTQ (:) * ( 1 - SM%S%XSIC (:)) + ZSFTQ_ICE(:) * SM%S%XSIC(:)
- PSFU (:) = ZSFU (:) * ( 1 - SM%S%XSIC (:)) + ZSFU_ICE(:) * SM%S%XSIC(:)
- PSFV (:) = ZSFV (:) * ( 1 - SM%S%XSIC (:)) + ZSFV_ICE(:) * SM%S%XSIC(:)
+IF (S%LHANDLE_SIC) THEN
+ PSFTH (:) = ZSFTH (:) * ( 1 - S%XSIC (:)) + ZSFTH_ICE(:) * S%XSIC(:)
+ PSFTQ (:) = ZSFTQ (:) * ( 1 - S%XSIC (:)) + ZSFTQ_ICE(:) * S%XSIC(:)
+ PSFU (:) = ZSFU (:) * ( 1 - S%XSIC (:)) + ZSFU_ICE(:) * S%XSIC(:)
+ PSFV (:) = ZSFV (:) * ( 1 - S%XSIC (:)) + ZSFV_ICE(:) * S%XSIC(:)
ELSE
- PSFTH (:) = ZSFTH (:)
- PSFTQ (:) = ZSFTQ (:)
- PSFU (:) = ZSFU (:)
- PSFV (:) = ZSFV (:)
+ PSFTH (:) = ZSFTH (:)
+ PSFTQ (:) = ZSFTQ (:)
+ PSFU (:) = ZSFU (:)
+ PSFV (:) = ZSFV (:)
ENDIF
!
!-------------------------------------------------------------------------------
@@ -551,81 +566,76 @@ ENDIF
!
! Daily update Sea surface salinity from monthly data
!
-IF (SM%S%LINTERPOL_SSS .AND. MOD(SM%S%TTIME%TIME,XDAY) == 0.) THEN
- CALL INTERPOL_SST_MTH(SM%S, &
- SM%S%TTIME%TDATE%YEAR,SM%S%TTIME%TDATE%MONTH,SM%S%TTIME%TDATE%DAY,'S',SM%S%XSSS)
- IF (ANY(SM%S%XSSS(:)<0.0)) THEN
- CALL ABOR1_SFX('COUPLING_SEAFLUX_N: XSSS should be >=0')
- ENDIF
+IF (S%LINTERPOL_SSS .AND. MOD(S%TTIME%TIME,XDAY) == 0.) THEN
+ CALL INTERPOL_SST_MTH(S,'S')
+ IF (ANY(S%XSSS(:)<0.0)) THEN
+ CALL ABOR1_SFX('COUPLING_SEAFLUX_N: XSSS should be >=0')
+ ENDIF
ENDIF
!
!-------------------------------------------------------------------------------
! SEA-ICE coupling at time t+1
!-------------------------------------------------------------------------------
!
-IF (SM%S%LHANDLE_SIC) THEN
- IF (SM%S%LINTERPOL_SIC) THEN
- IF ((MOD(SM%S%TTIME%TIME,XDAY) == 0.) .OR. (PTIMEC <= PTSTEP )) THEN
+IF (S%LHANDLE_SIC) THEN
+ !
+ IF (S%LINTERPOL_SIC) THEN
+ IF ((MOD(S%TTIME%TIME,XDAY) == 0.) .OR. (PTIMEC <= PTSTEP )) THEN
! Daily update Sea Ice Cover constraint from monthly data
- CALL INTERPOL_SST_MTH(SM%S, &
- SM%S%TTIME%TDATE%YEAR,SM%S%TTIME%TDATE%MONTH,SM%S%TTIME%TDATE%DAY,'C',SM%S%XFSIC)
- IF (ANY(SM%S%XFSIC(:)>1.0).OR.ANY(SM%S%XFSIC(:)<0.0)) THEN
- CALL ABOR1_SFX('COUPLING_SEAFLUX_N: FSIC should be >=0 and <=1')
- ENDIF
- ENDIF
- ENDIF
- IF (SM%S%LINTERPOL_SIT) THEN
- IF ((MOD(SM%S%TTIME%TIME,XDAY) == 0.) .OR. (PTIMEC <= PTSTEP )) THEN
+ CALL INTERPOL_SST_MTH(S,'C')
+ IF (ANY(S%XFSIC(:)>1.0).OR.ANY(S%XFSIC(:)<0.0)) THEN
+ CALL ABOR1_SFX('COUPLING_SEAFLUX_N: FSIC should be >=0 and <=1')
+ ENDIF
+ ENDIF
+ ENDIF
+ !
+ IF (S%LINTERPOL_SIT) THEN
+ IF ((MOD(S%TTIME%TIME,XDAY) == 0.) .OR. (PTIMEC <= PTSTEP )) THEN
! Daily update Sea Ice Thickness constraint from monthly data
- CALL INTERPOL_SST_MTH(SM%S, &
- SM%S%TTIME%TDATE%YEAR,SM%S%TTIME%TDATE%MONTH,SM%S%TTIME%TDATE%DAY,'H',SM%S%XFSIT)
- IF (ANY(SM%S%XFSIT(:)<0.0)) THEN
- CALL ABOR1_SFX('COUPLING_SEAFLUX_N: XFSIT should be >=0')
- ENDIF
- ENDIF
- ENDIF
- IF (SM%S%CSEAICE_SCHEME=='GELATO') THEN
- CALL SEAICE_GELATO1D_n(SM%S, &
- HPROGRAM,PTIMEC, PTSTEP, SM%S%TGLT, SM%S%XSST, SM%S%XSSS, &
- SM%S%XFSIC, SM%S%XFSIT, SM%S%XSIC, SM%S%XTICE, SM%S%XICE_ALB)
- ENDIF
- ! Update of cell-averaged albedo, emissivity and radiative
- ! temperature is done later
+ CALL INTERPOL_SST_MTH(S,'H')
+ IF (ANY(S%XFSIT(:)<0.0)) THEN
+ CALL ABOR1_SFX('COUPLING_SEAFLUX_N: XFSIT should be >=0')
+ ENDIF
+ ENDIF
+ ENDIF
+ !
+ IF (S%CSEAICE_SCHEME=='GELATO') THEN
+ CALL SEAICE_GELATO1D_n(S, HPROGRAM,PTIMEC, PTSTEP)
+ ENDIF
+ ! Update of cell-averaged albedo, emissivity and radiative
+ ! temperature is done later
ENDIF
!
!-------------------------------------------------------------------------------
! OCEANIC COUPLING, IMPOSED SST OR INTERPOLATED SST AT TIME t+1
!-------------------------------------------------------------------------------
!
-IF (SM%O%LMERCATOR) THEN
- !
- ! Update SST reference profile for relaxation purpose
- IF (SM%DTS%LSST_DATA) THEN
- CALL SST_UPDATE(SM%DTS, SM%S, &
- SM%OR%XSEAT_REL(:,NOCKMIN+1), SM%S%TTIME)
- !
- ! Convert to degree C for ocean model
- SM%OR%XSEAT_REL(:,NOCKMIN+1) = SM%OR%XSEAT_REL(:,NOCKMIN+1) - XTT
- ENDIF
- !
- CALL MOD1D_n(SM%DGO, SM%O, SM%OR, SM%SG, SM%S, &
- HPROGRAM,PTIME,ZEMIS(:),ZDIR_ALB(:,1:KSW),ZSCA_ALB(:,1:KSW),&
- PLW(:),PSCA_SW(:,1:KSW),PDIR_SW(:,1:KSW),PSFTH(:), &
- PSFTQ(:),PSFU(:),PSFV(:),PRAIN(:),SM%S%XSST(:))
- !
-ELSEIF(SM%DTS%LSST_DATA)THEN
- !
- ! Imposed SST
- !
- CALL SST_UPDATE(SM%DTS, SM%S, &
- SM%S%XSST, SM%S%TTIME)
- !
-ELSEIF (SM%S%LINTERPOL_SST.AND.MOD(SM%S%TTIME%TIME,XDAY) == 0.) THEN
+IF (O%LMERCATOR) THEN
+ !
+ ! Update SST reference profile for relaxation purpose
+ IF (DTS%LSST_DATA) THEN
+ CALL SST_UPDATE(DTS, S, OR%XSEAT_REL(:,NOCKMIN+1))
+ !
+ ! Convert to degree C for ocean model
+ OR%XSEAT_REL(:,NOCKMIN+1) = OR%XSEAT_REL(:,NOCKMIN+1) - XTT
+ ENDIF
+ !
+ CALL MOD1D_n(DGS%GO, O, OR, G%XLAT, S, &
+ HPROGRAM,PTIME,ZEMIS(:),ZDIR_ALB(:,1:KSW),ZSCA_ALB(:,1:KSW),&
+ PLW(:),PSCA_SW(:,1:KSW),PDIR_SW(:,1:KSW),PSFTH(:), &
+ PSFTQ(:),PSFU(:),PSFV(:),PRAIN(:))
+ !
+ELSEIF(DTS%LSST_DATA) THEN
+ !
+ ! Imposed SST
+ !
+ CALL SST_UPDATE(DTS, S, S%XSST)
+ !
+ELSEIF (S%LINTERPOL_SST.AND.MOD(S%TTIME%TIME,XDAY) == 0.) THEN
!
! Imposed monthly SST
!
- CALL INTERPOL_SST_MTH(SM%S, &
- SM%S%TTIME%TDATE%YEAR,SM%S%TTIME%TDATE%MONTH,SM%S%TTIME%TDATE%DAY,'T',SM%S%XSST)
+ CALL INTERPOL_SST_MTH(S,'T')
!
ENDIF
!
@@ -635,25 +645,25 @@ ENDIF
!difficult to do. Maybe it will be done later. However, Ts is at time t+1
!-------------------------------------------------------------------------------
!
-IF (SM%S%LHANDLE_SIC) THEN
- IF (SM%S%CSEAICE_SCHEME/='GELATO') THEN
- SM%S%XTICE=SM%S%XSST
- SM%S%XSIC=SM%S%XFSIC
- SM%S%XICE_ALB=XALBSEAICE
- ENDIF
- PTSURF (:) = SM%S%XSST (:) * ( 1 - SM%S%XSIC (:)) + SM%S%XTICE(:) * SM%S%XSIC(:)
- PQSURF (:) = ZQSAT (:) * ( 1 - SM%S%XSIC (:)) + ZQSAT_ICE(:) * SM%S%XSIC(:)
- ZZ0W (:) = ( 1 - SM%S%XSIC(:) ) * 1.0/(LOG(PUREF(:)/ZZ0(:)) **2) + &
- SM%S%XSIC(:) * 1.0/(LOG(PUREF(:)/ZZ0_ICE(:))**2)
- PZ0 (:) = PUREF (:) * EXP ( - SQRT ( 1./ ZZ0W(:) ))
- ZZ0W (:) = ( 1 - SM%S%XSIC(:) ) * 1.0/(LOG(PZREF(:)/ZZ0H(:)) **2) + &
- SM%S%XSIC(:) * 1.0/(LOG(PZREF(:)/ZZ0H_ICE(:))**2)
- PZ0H (:) = PZREF (:) * EXP ( - SQRT ( 1./ ZZ0W(:) ))
+IF (S%LHANDLE_SIC) THEN
+ IF (S%CSEAICE_SCHEME/='GELATO') THEN
+ S%XTICE = S%XSST
+ S%XSIC = S%XFSIC
+ S%XICE_ALB = XALBSEAICE
+ ENDIF
+ PTSURF (:) = S%XSST(:) * ( 1 - S%XSIC (:)) + S%XTICE(:) * S%XSIC(:)
+ PQSURF (:) = ZQSAT (:) * ( 1 - S%XSIC (:)) + ZQSAT_ICE(:) * S%XSIC(:)
+ ZZ0W (:) = ( 1 - S%XSIC(:) ) * 1.0/(LOG(PUREF(:)/ZZ0(:)) **2) + &
+ S%XSIC(:) * 1.0/(LOG(PUREF(:)/ZZ0_ICE(:))**2)
+ PZ0 (:) = PUREF (:) * EXP ( - SQRT ( 1./ ZZ0W(:) ))
+ ZZ0W (:) = ( 1 - S%XSIC(:) ) * 1.0/(LOG(PZREF(:)/ZZ0H(:)) **2) + &
+ S%XSIC(:) * 1.0/(LOG(PZREF(:)/ZZ0H_ICE(:))**2)
+ PZ0H (:) = PZREF (:) * EXP ( - SQRT ( 1./ ZZ0W(:) ))
ELSE
- PTSURF (:) = SM%S%XSST (:)
- PQSURF (:) = ZQSAT (:)
- PZ0 (:) = SM%S%XZ0 (:)
- PZ0H (:) = ZZ0H (:)
+ PTSURF (:) = S%XSST(:)
+ PQSURF (:) = ZQSAT (:)
+ PZ0 (:) = S%XZ0 (:)
+ PZ0H (:) = ZZ0H (:)
ENDIF
!
!-------------------------------------------------------------------------------
@@ -661,10 +671,7 @@ ENDIF
!the energy budget between surfex and the atmosphere
!-------------------------------------------------------------------------------
!
- CALL UPDATE_RAD_SEA(SM%S%CSEA_ALB,SM%S%XSST,PZENITH2,XTTS,SM%S%XEMIS, &
- SM%S%XDIR_ALB,SM%S%XSCA_ALB,PDIR_ALB,PSCA_ALB,&
- PEMIS,PTRAD,SM%S%LHANDLE_SIC,SM%S%XTICE,SM%S%XSIC, &
- SM%S%XICE_ALB,PU,PV)
+ CALL UPDATE_RAD_SEA(S,PZENITH2,XTTS,PDIR_ALB,PSCA_ALB,PEMIS,PTRAD,PU,PV)
!
!=======================================================================================
!
@@ -672,7 +679,7 @@ IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_N',1,ZHOOK_HANDLE)
!
!=======================================================================================
!
- CONTAINS
+CONTAINS
!
SUBROUTINE SEA_MOMENTUM_FLUXES(PCD, PSFU, PSFV)
!
@@ -712,11 +719,11 @@ ELSE
ZUSTAR2(:) = (PCD(:)*ZWIND(:)*(2.*ZPEW_B_COEF(:)-ZWIND(:))) /&
(1.0-2.0*PRHOA(:)*PCD(:)*ZWIND(:)*ZPEW_A_COEF(:))
!
- ZWORK(:) = PRHOA(:)*ZPEW_A_COEF(:)*ZUSTAR2(:) + ZPEW_B_COEF(:)
+ ZWORK(:) = PRHOA(:)*PPEW_A_COEF(:)*ZUSTAR2(:) + ZPEW_B_COEF(:)
ZWORK(:) = MAX(ZWORK(:),0.)
!
WHERE(ZPEW_A_COEF(:)/= 0.)
- ZUSTAR2(:) = MAX( ( ZWORK(:) - ZPEW_B_COEF(:) ) / (PRHOA(:)*ZPEW_A_COEF(:)), 0.)
+ ZUSTAR2(:) = MAX( ( ZWORK(:) - PPEW_B_COEF(:) ) / (PRHOA(:)*ZPEW_A_COEF(:)), 0.)
ENDWHERE
!
ENDIF
@@ -746,7 +753,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_N: COMPLEMENT_EACH_OTHER_FLUX',0,ZHOOK_HANDLE)
!
- WHERE (SM%S%XSIC(:) == 1.)
+ WHERE (S%XSIC(:) == 1.)
ZSFTH=ZSFTH_ICE
ZSFTQ=ZSFTQ_ICE
ZSFU=ZSFU_ICE
@@ -759,7 +766,7 @@ IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_N: COMPLEMENT_EACH_OTHER_FLUX',0,ZHOOK
ZRI=ZRI_ICE
ZZ0H=ZZ0H_ICE
END WHERE
- WHERE (SM%S%XSIC(:) == 0.)
+ WHERE (S%XSIC(:) == 0.)
ZSFTH_ICE=ZSFTH
ZSFTQ_ICE=ZSFTQ
ZSFU_ICE=ZSFU
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/dealloc_seafluxn.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/dealloc_seafluxn.F90
index 609ecc7a89fb7d3787f68e5397f3abc8bc0c1c8d..568fc710d984ecb13226e6ffe6c8dd4df2770460 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/dealloc_seafluxn.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/dealloc_seafluxn.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #################################################################################
-SUBROUTINE DEALLOC_SEAFLUX_n (CHS, SG, S)
+SUBROUTINE DEALLOC_SEAFLUX_n (SM)
! #################################################################################
!
!!**** *DEALLOC_SEAFLUX_n * - Deallocate all arrays
@@ -27,15 +27,22 @@ SUBROUTINE DEALLOC_SEAFLUX_n (CHS, SG, S)
!! Original 01/2004
!! S. Belamari 03/2014 other _SEA_ variables
!! S. Senesi 09/2013 introduce sea-ice-cover ans sea-surface salinity
-!! Modified 11/2014 : J. Pianezze : deallocation of wave parameters
-!!-------------------------------------------------------------------------
+!!------------------------------------------------------------------
!
+USE MODD_DIAG_n, ONLY : DIAG_INIT, DIAG_OPTIONS_INIT
+USE MODD_DIAG_OCEAN_n, ONLY : DIAG_OCEAN_INIT
+USE MODD_DIAG_MISC_SEAICE_n, ONLY : DIAG_MISC_SEAICE_INIT
!
+USE MODD_CH_SEAFLUX_n, ONLY : CH_SEAFLUX_INIT
+USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_INIT
+USE MODD_SEAFLUX_n, ONLY : SEAFLUX_INIT
+USE MODD_OCEAN_n, ONLY : OCEAN_INIT
+USE MODD_OCEAN_REL_n, ONLY : OCEAN_REL_INIT
!
+USE MODD_SFX_GRID_n, ONLY : GRID_INIT
+USE MODD_CANOPY_n, ONLY : CANOPY_INIT
!
-USE MODD_CH_SEAFLUX_n, ONLY : CH_SEAFLUX_t
-USE MODD_SEAFLUX_GRID_n, ONLY : SEAFLUX_GRID_t
-USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
+USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t
!
USE MODI_GLTOOLS_DEALLOC
!
@@ -50,9 +57,7 @@ IMPLICIT NONE
!* 0.2 declarations of local variables
!
!
-TYPE(CH_SEAFLUX_t), INTENT(INOUT) :: CHS
-TYPE(SEAFLUX_GRID_t), INTENT(INOUT) :: SG
-TYPE(SEAFLUX_t), INTENT(INOUT) :: S
+TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -60,51 +65,26 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('DEALLOC_SEAFLUX_N',0,ZHOOK_HANDLE)
!
-IF (ASSOCIATED(S%LCOVER )) DEALLOCATE(S%LCOVER )
-IF (ASSOCIATED(S%XCOVER )) DEALLOCATE(S%XCOVER )
-IF (ASSOCIATED(S%XZS )) DEALLOCATE(S%XZS )
-IF (ASSOCIATED(S%XSST )) DEALLOCATE(S%XSST )
-IF (ASSOCIATED(S%XSSS )) DEALLOCATE(S%XSSS )
-IF (ASSOCIATED(S%XSIC )) DEALLOCATE(S%XSIC )
-IF (ASSOCIATED(S%XFSIC )) DEALLOCATE(S%XFSIC )
-IF (ASSOCIATED(S%XFSIT )) DEALLOCATE(S%XFSIT )
-IF (ASSOCIATED(S%XTP )) DEALLOCATE(S%XTP )
-IF (ASSOCIATED(S%XHS )) DEALLOCATE(S%XHS )
-IF (ASSOCIATED(S%XZ0 )) DEALLOCATE(S%XZ0 )
-IF (ASSOCIATED(S%XZ0H )) DEALLOCATE(S%XZ0H )
-IF (ASSOCIATED(S%XSEABATHY)) DEALLOCATE(S%XSEABATHY)
-IF (ASSOCIATED(S%XEMIS )) DEALLOCATE(S%XEMIS )
-IF (ASSOCIATED(S%XDIR_ALB)) DEALLOCATE(S%XDIR_ALB)
-IF (ASSOCIATED(S%XSCA_ALB)) DEALLOCATE(S%XSCA_ALB)
+CALL DIAG_OPTIONS_INIT(SM%SD%O)
+CALL DIAG_INIT(SM%SD%D)
+CALL DIAG_INIT(SM%SD%DC)
+CALL DIAG_INIT(SM%SD%DI)
+CALL DIAG_INIT(SM%SD%DIC)
+CALL DIAG_OCEAN_INIT(SM%SD%GO)
+CALL DIAG_MISC_SEAICE_INIT(SM%SD%DMI)
+ !
+CALL DATA_SEAFLUX_INIT(SM%DTS)
+CALL GRID_INIT(SM%G)
+CALL CANOPY_INIT(SM%SB)
+CALL CH_SEAFLUX_INIT(SM%CHS)
+CALL SEAFLUX_INIT(SM%S)
+CALL SEAFLUX_INIT(SM%S)
+CALL OCEAN_INIT(SM%O)
+CALL OCEAN_REL_INIT(SM%OR)
!
!-------------------------------------------------------------------------------------
!
-IF (ASSOCIATED(SG%XGRID_PAR )) DEALLOCATE(SG%XGRID_PAR )
-IF (ASSOCIATED(SG%XLAT )) DEALLOCATE(SG%XLAT )
-IF (ASSOCIATED(SG%XLON )) DEALLOCATE(SG%XLON )
-IF (ASSOCIATED(SG%XMESH_SIZE)) DEALLOCATE(SG%XMESH_SIZE)
-!
-!-------------------------------------------------------------------------------------
-!
-IF(ASSOCIATED(CHS%XDEP)) DEALLOCATE(CHS%XDEP)
-IF(ASSOCIATED(CHS%CCH_NAMES)) DEALLOCATE(CHS%CCH_NAMES)
-IF(ASSOCIATED(CHS%SVS%CSV)) DEALLOCATE(CHS%SVS%CSV)
-!
-!-------------------------------------------------------------------------------------
-!
-IF(ASSOCIATED(S%XCPL_SEA_WIND)) DEALLOCATE(S%XCPL_SEA_WIND)
-IF(ASSOCIATED(S%XCPL_SEA_FWSU)) DEALLOCATE(S%XCPL_SEA_FWSU)
-IF(ASSOCIATED(S%XCPL_SEA_FWSV)) DEALLOCATE(S%XCPL_SEA_FWSV)
-IF(ASSOCIATED(S%XCPL_SEA_SNET)) DEALLOCATE(S%XCPL_SEA_SNET)
-IF(ASSOCIATED(S%XCPL_SEA_HEAT)) DEALLOCATE(S%XCPL_SEA_HEAT)
-IF(ASSOCIATED(S%XCPL_SEA_EVAP)) DEALLOCATE(S%XCPL_SEA_EVAP)
-IF(ASSOCIATED(S%XCPL_SEA_RAIN)) DEALLOCATE(S%XCPL_SEA_RAIN)
-IF(ASSOCIATED(S%XCPL_SEA_SNOW)) DEALLOCATE(S%XCPL_SEA_SNOW)
-IF(ASSOCIATED(S%XCPL_SEA_EVPR)) DEALLOCATE(S%XCPL_SEA_EVPR)
-!
-!-------------------------------------------------------------------------------------
-!
-IF (ASSOCIATED(S%TGLT%bat) .AND. S%CSEAICE_SCHEME=='GELATO' ) CALL GLTOOLS_DEALLOC(S%TGLT)
+IF (ASSOCIATED(SM%S%TGLT%bat) .AND. SM%S%CSEAICE_SCHEME=='GELATO' ) CALL GLTOOLS_DEALLOC(SM%S%TGLT)
!
IF (LHOOK) CALL DR_HOOK('DEALLOC_SEAFLUX_N',1,ZHOOK_HANDLE)
!
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/default_seaflux.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/default_seaflux.F90
index b951b0d33bbccb161fc975516f6d103c1be56780..1141c6aa797b8f8fa2867fa6045455562718ceb1 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/default_seaflux.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/default_seaflux.F90
@@ -66,7 +66,7 @@ LOGICAL, INTENT(OUT) :: OPRECIP ! precipitation correction
LOGICAL, INTENT(OUT) :: OPWEBB ! Webb correction
INTEGER, INTENT(OUT) :: KZ0 ! PZ0SEA formulation
INTEGER, INTENT(OUT) :: KGRVWAVES ! Wave gravity in roughness length
-LOGICAL, INTENT(OUT) :: OPROGSST !two-way
+LOGICAL, INTENT(OUT) :: OPROGSST !two-way coupling
INTEGER, INTENT(OUT) :: KTIME_COUPLING!coupling frequency
REAL, INTENT(OUT) :: PICHCE !CE coef calculation for ECUME
REAL, INTENT(OUT) :: POCEAN_TSTEP !ocean 1D model time-step
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/diag_cpl_esm_sea.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/diag_cpl_esm_sea.F90
index 1a86c2f31c401a4b7974884acb645ce4f0bfaafd..835d46a87c0d55f9a1b5203e6ce09fab0fa754f0 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/diag_cpl_esm_sea.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/diag_cpl_esm_sea.F90
@@ -3,12 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_CPL_ESM_SEA (S, &
- PTSTEP,PZON10M,PMER10M,PSFU,PSFV, &
- PSWD,PSWU,PGFLUX,PSFTQ,PRAIN,PSNOW, &
- PLW,PPS,PTICE,PSFTH_ICE,PSFTQ_ICE, &
- PDIR_SW,PSCA_SW,PSWU_ICE,PLWU_ICE, &
- OSIC )
+ SUBROUTINE DIAG_CPL_ESM_SEA (S, D, DI, PTSTEP, PSFTQ, PRAIN, PSNOW, &
+ PLW, PPS, PSFTH_ICE, PSFTQ_ICE, PDIR_SW, PSCA_SW, OSIC)
! ###################################################################
!
!!**** *DIAG_CPL_ESM_SEA * - Computes diagnostics over sea for
@@ -37,7 +33,7 @@
!! Modified 11/2014 : J. Pianezze : Add surface pressure coupling parameter
!!------------------------------------------------------------------
!
-!
+USE MODD_DIAG_n, ONLY : DIAG_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
!
USE MODD_CSTS, ONLY : XSTEFAN, XLSTT
@@ -54,15 +50,10 @@ IMPLICIT NONE
!
!
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DI
!
REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step
-REAL, DIMENSION(:), INTENT(IN) :: PZON10M ! zonal wind
-REAL, DIMENSION(:), INTENT(IN) :: PMER10M ! meridian wind
-REAL, DIMENSION(:), INTENT(IN) :: PSFU ! zonal wind stress
-REAL, DIMENSION(:), INTENT(IN) :: PSFV ! meridian wind stress
-REAL, DIMENSION(:), INTENT(IN) :: PSWD ! total incoming short wave radiation
-REAL, DIMENSION(:), INTENT(IN) :: PSWU ! total upward short wave radiation
-REAL, DIMENSION(:), INTENT(IN) :: PGFLUX ! storage flux
REAL, DIMENSION(:), INTENT(IN) :: PSFTQ ! water flux
REAL, DIMENSION(:), INTENT(IN) :: PRAIN ! Rainfall
REAL, DIMENSION(:), INTENT(IN) :: PSNOW ! Snowfall
@@ -70,11 +61,8 @@ REAL, DIMENSION(:), INTENT(IN) :: PLW ! longwave radiation (on horizontal
REAL, DIMENSION(:), INTENT(IN) :: PPS ! Surface pressure
REAL, DIMENSION(:), INTENT(IN) :: PSFTH_ICE ! heat flux (W/m2)
REAL, DIMENSION(:), INTENT(IN) :: PSFTQ_ICE ! water flux (kg/m2/s)
-REAL, DIMENSION(:), INTENT(IN) :: PTICE ! Ice Surface Temperature
REAL, DIMENSION(:,:),INTENT(IN):: PDIR_SW ! direct solar radiation (on horizontal surf.)
REAL, DIMENSION(:,:),INTENT(IN):: PSCA_SW ! diffuse solar radiation (on horizontal surf.)
-REAL, DIMENSION(:), INTENT(IN) :: PSWU_ICE ! upward short wave radiation on seaice
-REAL, DIMENSION(:), INTENT(IN) :: PLWU_ICE ! upward long wave radiation on seaice
LOGICAL, INTENT(IN) :: OSIC
!
!* 0.2 declarations of local variables
@@ -96,21 +84,21 @@ IF (LHOOK) CALL DR_HOOK('DIAG_CPL_ESM_SEA',0,ZHOOK_HANDLE)
!
!* 10m wind speed (m)
!
-S%XCPL_SEA_WIND(:) = S%XCPL_SEA_WIND(:) + PTSTEP * SQRT(PZON10M(:)**2+PMER10M(:)**2)
+S%XCPL_SEA_WIND(:) = S%XCPL_SEA_WIND(:) + PTSTEP * SQRT(D%XZON10M(:)**2+D%XMER10M(:)**2)
!
!* wind stress (Pa.s)
!
-S%XCPL_SEA_FWSU(:) = S%XCPL_SEA_FWSU(:) + PTSTEP * PSFU(:)
-S%XCPL_SEA_FWSV(:) = S%XCPL_SEA_FWSV(:) + PTSTEP * PSFV(:)
-S%XCPL_SEA_FWSM(:) = S%XCPL_SEA_FWSM(:) + PTSTEP * SQRT(PSFU(:)**2+PSFV(:)**2)
+S%XCPL_SEA_FWSU(:) = S%XCPL_SEA_FWSU(:) + PTSTEP * D%XFMU(:)
+S%XCPL_SEA_FWSV(:) = S%XCPL_SEA_FWSV(:) + PTSTEP * D%XFMV(:)
+S%XCPL_SEA_FWSM(:) = S%XCPL_SEA_FWSM(:) + PTSTEP * SQRT(D%XFMU(:)**2+D%XFMV(:)**2)
!
!* Solar net heat flux (J/m2)
!
-S%XCPL_SEA_SNET(:) = S%XCPL_SEA_SNET(:) + PTSTEP * (PSWD(:) - PSWU(:))
+S%XCPL_SEA_SNET(:) = S%XCPL_SEA_SNET(:) + PTSTEP * (D%XSWD(:) - D%XSWU(:))
!
!* Non solar heat flux (J/m2)
!
-S%XCPL_SEA_HEAT(:) = S%XCPL_SEA_HEAT(:) + PTSTEP * (PGFLUX(:) + PSWU(:) - PSWD(:))
+S%XCPL_SEA_HEAT(:) = S%XCPL_SEA_HEAT(:) + PTSTEP * (D%XGFLUX(:) + D%XSWU(:) - D%XSWD(:))
!
!* Evaporation (kg/m2)
!
@@ -140,7 +128,7 @@ IF (LCPL_SEAICE.OR.OSIC) THEN
!* Solar net heat flux (J/m2)
!
IF (OSIC) THEN
- ZSWU(:)=PSWU_ICE(:)
+ ZSWU(:)=DI%XSWU(:)
ELSE
ZSWU(:)=0.0
DO JSWB=1,ISWB
@@ -150,15 +138,15 @@ IF (LCPL_SEAICE.OR.OSIC) THEN
ENDDO
ENDIF
!
- S%XCPL_SEAICE_SNET(:) = S%XCPL_SEAICE_SNET(:) + PTSTEP * (PSWD(:) - ZSWU(:))
+ S%XCPL_SEAICE_SNET(:) = S%XCPL_SEAICE_SNET(:) + PTSTEP * (D%XSWD(:) - ZSWU(:))
!
!* Non solar heat flux (J/m2)
!
IF (OSIC) THEN
S%XCPL_SEAICE_HEAT(:) = S%XCPL_SEAICE_HEAT(:) + PTSTEP * &
- ( PLW(:) - PLWU_ICE(:) - PSFTH_ICE(:) - XLSTT*PSFTQ_ICE(:) )
+ ( PLW(:) - DI%XLWU(:) - PSFTH_ICE(:) - XLSTT*PSFTQ_ICE(:) )
ELSE
- ZTICE4(:)=PTICE(:)**4
+ ZTICE4(:)=S%XTICE(:)**4
S%XCPL_SEAICE_HEAT(:) = S%XCPL_SEAICE_HEAT(:) + PTSTEP * ( XEMISWATICE*(PLW(:)-XSTEFAN*ZTICE4(:)) &
- PSFTH_ICE(:) - XLSTT*PSFTQ_ICE(:) )
ENDIF
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/diag_inline_seafluxn.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/diag_inline_seafluxn.F90
index fb5cc3c34b54a0fd62e3bb0bb47bb9cd47d3b190..30b0c96dcaf61300ab9196a2c248dacda0e81f08 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/diag_inline_seafluxn.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/diag_inline_seafluxn.F90
@@ -3,16 +3,15 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE DIAG_INLINE_SEAFLUX_n (DGS, DGSI, S, &
- PTSTEP, PTA, PQA, &
- PPA, PPS, PRHOA, PZONA, &
- PMERA, PHT, PHW, PCD, PCDN, PCH, PCE, PRI, PHU, &
- PZ0H, PQSAT, PSFTH, PSFTQ, PSFZON, PSFMER, &
- PDIR_SW, PSCA_SW, PLW, PDIR_ALB, PSCA_ALB, &
- PEMIS, PTRAD, PRAIN, PSNOW, &
- PCD_ICE, PCDN_ICE, PCH_ICE, PCE_ICE, PRI_ICE, &
- PZ0_ICE, PZ0H_ICE, PQSAT_ICE, PSFTH_ICE, PSFTQ_ICE, &
- PSFZON_ICE, PSFMER_ICE )
+SUBROUTINE DIAG_INLINE_SEAFLUX_n (DGO, D, DC, DI, DIC, DGMSI, S, &
+ PTSTEP, PTA, PQA, PPA, PPS, PRHOA, PZONA, &
+ PMERA, PHT, PHW, PCD, PCDN, PCH, PCE, PRI, PHU, &
+ PZ0H, PQSAT, PSFTH, PSFTQ, PSFZON, PSFMER, &
+ PDIR_SW, PSCA_SW, PLW, PDIR_ALB, PSCA_ALB, &
+ PEMIS, PTRAD, PRAIN, PSNOW, &
+ PCD_ICE, PCDN_ICE, PCH_ICE, PCE_ICE, PRI_ICE, &
+ PZ0_ICE, PZ0H_ICE, PQSAT_ICE, PSFTH_ICE, PSFTQ_ICE, &
+ PSFZON_ICE, PSFMER_ICE )
! #####################################################################################
!
@@ -44,12 +43,8 @@ SUBROUTINE DIAG_INLINE_SEAFLUX_n (DGS, DGSI, S, &
!! J. Pianezze 08/2016 : Add surface pressure coupling parameter
!!------------------------------------------------------------------
!
-
-!
-!
-!
-USE MODD_DIAG_SEAFLUX_n, ONLY : DIAG_SEAFLUX_t
-USE MODD_DIAG_SEAICE_n, ONLY : DIAG_SEAICE_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
+USE MODD_DIAG_MISC_SEAICE_n, ONLY : DIAG_MISC_SEAICE_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
!
USE MODD_CSTS, ONLY : XTTS
@@ -59,11 +54,10 @@ USE MODD_SFX_OASIS, ONLY : LCPL_SEA
USE MODD_TYPES_GLT, ONLY : T_GLT
USE MODD_GLT_PARAM , ONLY : GELATO_DIM=>NX
USE MODE_GLT_STATS , ONLY : GLT_AVHICEM, GLT_AVHSNWM
-USE MODI_PARAM_CLS
USE MODI_CLS_TQ
USE MODI_CLS_WIND
USE MODI_DIAG_SURF_BUDGET_SEA
-USE MODI_DIAG_SURF_BUDGETC_SEA
+USE MODI_DIAG_SURF_BUDGETC
USE MODI_DIAG_CPL_ESM_SEA
!
USE MODI_SEAFLUX_ALBEDO
@@ -76,8 +70,12 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(DIAG_SEAFLUX_t), INTENT(INOUT) :: DGS
-TYPE(DIAG_SEAICE_t), INTENT(INOUT) :: DGSI
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
+TYPE(DIAG_t), INTENT(INOUT) :: DI
+TYPE(DIAG_t), INTENT(INOUT) :: DIC
+TYPE(DIAG_MISC_SEAICE_t), INTENT(INOUT) :: DGMSI
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
!
REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s)
@@ -142,174 +140,152 @@ IF (LHOOK) CALL DR_HOOK('DIAG_INLINE_SEAFLUX_N',0,ZHOOK_HANDLE)
! * Mean surface temperature need to couple with AGCM
!
IF (S%LHANDLE_SIC) THEN
- DGS%XTS (:) = (1 - S%XSIC(:)) * S%XSST(:) + S%XSIC(:) * S%XTICE(:)
- DGS%XTSRAD(:) = PTRAD(:)
+ D%XTS (:) = (1 - S%XSIC(:)) * S%XSST(:) + S%XSIC(:) * S%XTICE(:)
+ D%XTSRAD(:) = PTRAD(:)
ELSE
- DGS%XTS (:) = S%XSST (:)
- DGS%XTSRAD(:) = PTRAD(:)
+ D%XTS (:) = S%XSST (:)
+ D%XTSRAD(:) = PTRAD(:)
ENDIF
!
IF (.NOT. S%LSBL) THEN
!
- IF (DGS%N2M==1) THEN
- CALL PARAM_CLS(PTA, S%XSST, PQA, PPA, PRHOA, PZONA, PMERA, PHT, PHW, &
- PSFTH, PSFTQ, PSFZON, PSFMER, &
- DGS%XT2M, DGS%XQ2M, DGS%XHU2M, DGS%XZON10M, DGS%XMER10M )
- IF (S%LHANDLE_SIC) THEN
- CALL PARAM_CLS(PTA, S%XTICE, PQA, PPA, PRHOA, PZONA, PMERA, PHT, PHW, &
- PSFTH_ICE, PSFTQ_ICE, PSFZON_ICE, PSFMER_ICE, &
- DGS%XT2M_ICE, DGS%XQ2M_ICE, DGS%XHU2M_ICE, DGS%XZON10M_ICE, DGS%XMER10M_ICE )
- ENDIF
- ELSE IF (DGS%N2M==2) THEN
+ IF (DGO%N2M==2) THEN
ZH(:)=2.
- CALL CLS_TQ(PTA, PQA, PPA, PPS, PHT, &
- PCD, PCH, PRI, &
- S%XSST, PHU, PZ0H, ZH, &
- DGS%XT2M, DGS%XQ2M, DGS%XHU2M)
+ CALL CLS_TQ(PTA, PQA, PPA, PPS, PHT, PCD, PCH, PRI, &
+ S%XSST, PHU, PZ0H, ZH,D%XT2M, D%XQ2M, D%XHU2M)
ZH(:)=10.
- CALL CLS_WIND(PZONA, PMERA, PHW, &
- PCD, PCDN, PRI, ZH, &
- DGS%XZON10M, DGS%XMER10M)
+ CALL CLS_WIND(PZONA, PMERA, PHW,PCD, PCDN, PRI, ZH, &
+ D%XZON10M, D%XMER10M)
IF (S%LHANDLE_SIC) THEN
ZH(:)=2.
- CALL CLS_TQ(PTA, PQA, PPA, PPS, PHT, &
- PCD_ICE, PCH_ICE, PRI_ICE, &
- S%XTICE, PHU, PZ0H_ICE, ZH, &
- DGS%XT2M_ICE, DGS%XQ2M_ICE, DGS%XHU2M_ICE)
+ CALL CLS_TQ(PTA, PQA, PPA, PPS, PHT, PCD_ICE, PCH_ICE, PRI_ICE, &
+ S%XTICE, PHU, PZ0H_ICE, ZH, DI%XT2M, DI%XQ2M, DI%XHU2M)
ZH(:)=10.
- CALL CLS_WIND(PZONA, PMERA, PHW, &
- PCD_ICE, PCDN_ICE, PRI_ICE, ZH, &
- DGS%XZON10M_ICE, DGS%XMER10M_ICE )
+ CALL CLS_WIND(PZONA, PMERA, PHW, PCD_ICE, PCDN_ICE, PRI_ICE, ZH, &
+ DI%XZON10M, DI%XMER10M )
ENDIF
END IF
!
- IF (DGS%N2M>=1) THEN
+ IF (DGO%N2M>=1) THEN
IF (S%LHANDLE_SIC) THEN
!
- DGS%XT2M = DGS%XT2M * (1 - S%XSIC) + DGS%XT2M_ICE * S%XSIC
- DGS%XQ2M = DGS%XQ2M * (1 - S%XSIC) + DGS%XQ2M_ICE * S%XSIC
- DGS%XHU2M = DGS%XHU2M * (1 - S%XSIC) + DGS%XHU2M_ICE * S%XSIC
+ D%XT2M = D%XT2M * (1 - S%XSIC) + DI%XT2M * S%XSIC
+ D%XQ2M = D%XQ2M * (1 - S%XSIC) + DI%XQ2M * S%XSIC
+ D%XHU2M = D%XHU2M * (1 - S%XSIC) + DI%XHU2M * S%XSIC
!
- DGS%XZON10M(:) = DGS%XZON10M(:) * (1 - S%XSIC(:)) + DGS%XZON10M_ICE(:) * S%XSIC(:)
- DGS%XMER10M(:) = DGS%XMER10M(:) * (1 - S%XSIC(:)) + DGS%XMER10M_ICE(:) * S%XSIC(:)
- DGS%XWIND10M_ICE(:) = SQRT(DGS%XZON10M_ICE(:)**2+DGS%XMER10M_ICE(:)**2)
+ D%XZON10M(:) = D%XZON10M(:) * (1 - S%XSIC(:)) + DI%XZON10M(:) * S%XSIC(:)
+ D%XMER10M(:) = D%XMER10M(:) * (1 - S%XSIC(:)) + DI%XMER10M(:) * S%XSIC(:)
+ DI%XWIND10M(:) = SQRT(DI%XZON10M(:)**2+DI%XMER10M(:)**2)
!
- DGS%XRI = PRI * (1 - S%XSIC) + PRI_ICE * S%XSIC
- DGS%XRI_ICE=PRI_ICE
+ D%XRI = PRI * (1 - S%XSIC) + PRI_ICE * S%XSIC
+ DI%XRI =PRI_ICE
ELSE
- DGS%XRI =PRI
+ D%XRI =PRI
ENDIF
!
- DGS%XT2M_MIN(:) = MIN(DGS%XT2M_MIN(:),DGS%XT2M(:))
- DGS%XT2M_MAX(:) = MAX(DGS%XT2M_MAX(:),DGS%XT2M(:))
+ D%XT2M_MIN(:) = MIN(D%XT2M_MIN(:),D%XT2M(:))
+ D%XT2M_MAX(:) = MAX(D%XT2M_MAX(:),D%XT2M(:))
!
- DGS%XHU2M_MIN(:) = MIN(DGS%XHU2M_MIN(:),DGS%XHU2M(:))
- DGS%XHU2M_MAX(:) = MAX(DGS%XHU2M_MAX(:),DGS%XHU2M(:))
+ D%XHU2M_MIN(:) = MIN(D%XHU2M_MIN(:),D%XHU2M(:))
+ D%XHU2M_MAX(:) = MAX(D%XHU2M_MAX(:),D%XHU2M(:))
!
- DGS%XWIND10M(:) = SQRT(DGS%XZON10M(:)**2+DGS%XMER10M(:)**2)
- DGS%XWIND10M_MAX(:) = MAX(DGS%XWIND10M_MAX(:),DGS%XWIND10M(:))
+ D%XWIND10M(:) = SQRT(D%XZON10M(:)**2+D%XMER10M(:)**2)
+ D%XWIND10M_MAX(:) = MAX(D%XWIND10M_MAX(:),D%XWIND10M(:))
!
ENDIF
!
ELSE
- IF (DGS%N2M>=1) THEN
- DGS%XT2M = XUNDEF
- DGS%XQ2M = XUNDEF
- DGS%XHU2M = XUNDEF
- DGS%XZON10M = XUNDEF
- DGS%XMER10M = XUNDEF
- DGS%XRI = PRI
+ IF (DGO%N2M>=1) THEN
+ D%XT2M = XUNDEF
+ D%XQ2M = XUNDEF
+ D%XHU2M = XUNDEF
+ D%XZON10M = XUNDEF
+ D%XMER10M = XUNDEF
+ D%XRI = PRI
ENDIF
ENDIF
!
-IF (DGS%LSURF_BUDGET.OR.DGS%LSURF_BUDGETC) THEN
+IF (DGO%LSURF_BUDGET.OR.DGO%LSURF_BUDGETC) THEN
!
- CALL SEAFLUX_ALBEDO(PDIR_SW,PSCA_SW,PDIR_ALB,PSCA_ALB,DGS%XALBT)
+ CALL SEAFLUX_ALBEDO(PDIR_SW,PSCA_SW,PDIR_ALB,PSCA_ALB,D%XALBT)
!
- CALL DIAG_SURF_BUDGET_SEA (XTTS, S%XSST, PRHOA, PSFTH, PSFTH_ICE, &
- PSFTQ, PSFTQ_ICE, &
- PDIR_SW, PSCA_SW, PLW, PDIR_ALB, &
- PSCA_ALB,S%XICE_ALB, PEMIS, PTRAD, &
- PSFZON, PSFZON_ICE, PSFMER, &
- PSFMER_ICE, S%LHANDLE_SIC, S%XSIC, S%XTICE, &
- DGS%XRN, DGS%XH, DGS%XLE, DGS%XLE_ICE, DGS%XGFLUX, &
- DGS%XSWD, DGS%XSWU, DGS%XSWBD, DGS%XSWBU, DGS%XLWD, DGS%XLWU, &
- DGS%XFMU, DGS%XFMV, DGS%XEVAP, DGS%XSUBL, &
- DGS%XRN_ICE, DGS%XH_ICE, DGS%XGFLUX_ICE, &
- DGS%XSWU_ICE, DGS%XSWBU_ICE, DGS%XLWU_ICE, &
- DGS%XFMU_ICE, DGS%XFMV_ICE )
+ CALL DIAG_SURF_BUDGET_SEA (D, DI, S, XTTS, PRHOA, PSFTH, PSFTH_ICE, &
+ PSFTQ, PSFTQ_ICE, PDIR_SW, PSCA_SW, PLW, &
+ PDIR_ALB, PSCA_ALB, PEMIS, PTRAD, &
+ PSFZON, PSFZON_ICE, PSFMER, PSFMER_ICE )
+ IF (S%LHANDLE_SIC) DI%XLE = D%XLEI
!
END IF
!
-IF(DGS%LSURF_BUDGETC)THEN
- CALL DIAG_SURF_BUDGETC_SEA(DGS, &
- PTSTEP, DGS%XRN, DGS%XH, DGS%XLE, DGS%XLE_ICE, DGS%XGFLUX, &
- DGS%XSWD, DGS%XSWU, DGS%XLWD, DGS%XLWU, DGS%XFMU, DGS%XFMV, &
- DGS%XEVAP, DGS%XSUBL, S%LHANDLE_SIC, &
- DGS%XRN_ICE, DGS%XH_ICE, DGS%XGFLUX_ICE, &
- DGS%XSWU_ICE, DGS%XLWU_ICE, DGS%XFMU_ICE, DGS%XFMV_ICE)
+IF(DGO%LSURF_BUDGETC)THEN
+ !
+ CALL DIAG_SURF_BUDGETC(D, DC, PTSTEP, .TRUE.)
+ !
+ IF (S%LHANDLE_SIC) THEN
+ CALL DIAG_SURF_BUDGETC(DI, DIC, PTSTEP, .FALSE.)
+ DIC%XLE = DC%XLEI
+ ENDIF
+ !
ENDIF
!
-IF (DGS%LCOEF) THEN
+IF (DGO%LCOEF) THEN
IF (S%LHANDLE_SIC) THEN
!
!* Transfer coefficients
!
- DGS%XCD = (1 - S%XSIC) * PCD + S%XSIC * PCD_ICE
- DGS%XCH = (1 - S%XSIC) * PCH + S%XSIC * PCH_ICE
- DGS%XCE = (1 - S%XSIC) * PCE + S%XSIC * PCE_ICE
+ D%XCD = (1 - S%XSIC) * PCD + S%XSIC * PCD_ICE
+ D%XCH = (1 - S%XSIC) * PCH + S%XSIC * PCH_ICE
+ D%XCE = (1 - S%XSIC) * PCE + S%XSIC * PCE_ICE
!
!* Roughness lengths
!
- ZZ0W = ( 1 - S%XSIC ) * 1.0/(LOG(PHW/S%XZ0) **2) + &
- S%XSIC * 1.0/(LOG(PHW/PZ0_ICE)**2)
- DGS%XZ0 = PHW * EXP ( - SQRT ( 1./ ZZ0W ))
- ZZ0W = ( 1 - S%XSIC ) * 1.0/(LOG(PHW/PZ0H) **2) + &
- S%XSIC * 1.0/(LOG(PHW/PZ0H_ICE)**2)
- DGS%XZ0H = PHW * EXP ( - SQRT ( 1./ ZZ0W ))
+ ZZ0W = ( 1 - S%XSIC ) * 1.0/(LOG(PHW/S%XZ0) **2) + S%XSIC * 1.0/(LOG(PHW/PZ0_ICE)**2)
+ D%XZ0 = PHW * EXP ( - SQRT ( 1./ ZZ0W ))
+ ZZ0W = ( 1 - S%XSIC ) * 1.0/(LOG(PHW/PZ0H) **2) + S%XSIC * 1.0/(LOG(PHW/PZ0H_ICE)**2)
+ D%XZ0H = PHW * EXP ( - SQRT ( 1./ ZZ0W ))
- DGS%XCD_ICE = PCD_ICE
- DGS%XCH_ICE = PCH_ICE
- DGS%XZ0_ICE = PZ0_ICE
- DGS%XZ0H_ICE = PZ0H_ICE
+ DI%XCD = PCD_ICE
+ DI%XCH = PCH_ICE
+ DI%XZ0 = PZ0_ICE
+ DI%XZ0H = PZ0H_ICE
!
ELSE
!
!* Transfer coefficients
!
- DGS%XCD = PCD
- DGS%XCH = PCH
- DGS%XCE = PCE
+ D%XCD = PCD
+ D%XCH = PCH
+ D%XCE = PCE
!
!* Roughness lengths
!
- DGS%XZ0 = S%XZ0
- DGS%XZ0H = PZ0H
+ D%XZ0 = S%XZ0
+ D%XZ0H = PZ0H
ENDIF
!
ENDIF
!
-IF (DGS%LSURF_VARS) THEN
+IF (DGO%LSURF_VARS) THEN
!
!* Humidity at saturation
!
IF (S%LHANDLE_SIC) THEN
- DGS%XQS = (1 - S%XSIC) * PQSAT + S%XSIC * PQSAT_ICE
- DGS%XQS_ICE = PQSAT_ICE
+ D%XQS = (1 - S%XSIC) * PQSAT + S%XSIC * PQSAT_ICE
+ DI%XQS = PQSAT_ICE
ELSE
- DGS%XQS = PQSAT
+ D%XQS = PQSAT
ENDIF
ENDIF
!
! Diags from embedded Seaice model
! CALL DIAG_INLINE_SEAICE() : simply :
!
-IF (DGSI%LDIAG_SEAICE) THEN
+IF (DGMSI%LDIAG_MISC_SEAICE) THEN
IF (TRIM(S%CSEAICE_SCHEME) == 'GELATO') THEN
GELATO_DIM=SIZE(PTA)
- DGSI%XSIT = RESHAPE(glt_avhicem(S%TGLT%dom,S%TGLT%sit),(/GELATO_DIM/))
- DGSI%XSND = RESHAPE(glt_avhsnwm(S%TGLT%dom,S%TGLT%sit),(/GELATO_DIM/))
- DGSI%XMLT = S%TGLT%oce_all(:,1)%tml
+ DGMSI%XSIT = RESHAPE(glt_avhicem(S%TGLT%dom,S%TGLT%sit),(/GELATO_DIM/))
+ DGMSI%XSND = RESHAPE(glt_avhsnwm(S%TGLT%dom,S%TGLT%sit),(/GELATO_DIM/))
+ DGMSI%XMLT = S%TGLT%oce_all(:,1)%tml
ELSE
! Placeholder for an alternate seaice scheme
ENDIF
@@ -322,12 +298,8 @@ GSIC=(S%LHANDLE_SIC.AND.(S%CSEAICE_SCHEME /= 'NONE '))
!
IF (LCPL_SEA.OR.GSIC) THEN
!
- CALL DIAG_CPL_ESM_SEA(S, &
- PTSTEP,DGS%XZON10M,DGS%XMER10M,DGS%XFMU,DGS%XFMV, &
- DGS%XSWD,DGS%XSWU,DGS%XGFLUX,PSFTQ,PRAIN, &
- PSNOW,PLW,PPS,S%XTICE,PSFTH_ICE, &
- PSFTQ_ICE,PDIR_SW,PSCA_SW, &
- DGS%XSWU_ICE,DGS%XLWU_ICE,GSIC )
+ CALL DIAG_CPL_ESM_SEA(S, D, DI, PTSTEP, PSFTQ, PRAIN, PSNOW, &
+ PLW, PPS, PSFTH_ICE, PSFTQ_ICE, PDIR_SW, PSCA_SW, GSIC )
!
ENDIF
IF (LHOOK) CALL DR_HOOK('DIAG_INLINE_SEAFLUX_N',1,ZHOOK_HANDLE)
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/diag_seaflux_initn.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/diag_seaflux_initn.F90
index 7d9588ed48bb63f0b9f880259728a4181a6ab97c..daa9db0c1ddcb7119a3b38d65e43fbb8a397d5a4 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/diag_seaflux_initn.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/diag_seaflux_initn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_SEAFLUX_INIT_n (&
- DGO, DGS, DGSI, DGU, S, &
+ SUBROUTINE DIAG_SEAFLUX_INIT_n (DOC, DGO, D, DC, OREAD_BUDGETC, S, &
HPROGRAM,KLU,KSW)
! #####################
!
@@ -44,29 +43,20 @@
!* 0. DECLARATIONS
! ------------
!
-!
+USE MODE_DIAG
!
USE MODD_DIAG_OCEAN_n, ONLY : DIAG_OCEAN_t
-USE MODD_DIAG_SEAFLUX_n, ONLY : DIAG_SEAFLUX_t
-USE MODD_DIAG_SEAICE_n, ONLY : DIAG_SEAICE_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
!
-!
-!
#ifdef SFX_OL
USE MODN_IO_OFFLINE, ONLY : LRESTART
#endif
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_SFX_OASIS, ONLY : LCPL_SEA,LCPL_SEAICE
-
-!
-!
-!
-!
+!
USE MODI_READ_SURF
!
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -75,13 +65,11 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-!
-!
-TYPE(DIAG_OCEAN_t), INTENT(INOUT) :: DGO
-TYPE(DIAG_SEAFLUX_t), INTENT(INOUT) :: DGS
-TYPE(DIAG_SEAICE_t), INTENT(INOUT) :: DGSI
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_OCEAN_t), INTENT(INOUT) :: DOC
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
+LOGICAL, INTENT(IN) :: OREAD_BUDGETC
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
!
INTEGER, INTENT(IN) :: KLU ! size of arrays
@@ -93,396 +81,115 @@ INTEGER, INTENT(IN) :: KSW ! number of SW spectral bands
!
INTEGER :: IVERSION
INTEGER :: IRESP ! IRESP : return-code if a problem appears
- CHARACTER(LEN=LEN_HREC) :: YREC ! Name of the article to be read
+CHARACTER(LEN=LEN_HREC) :: YREC ! Name of the article to be read
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('DIAG_SEAFLUX_INIT_N',0,ZHOOK_HANDLE)
!
!* surface energy budget
!
-IF (LHOOK) CALL DR_HOOK('DIAG_SEAFLUX_INIT_N',0,ZHOOK_HANDLE)
-ALLOCATE(DGS%XTS (KLU))
-ALLOCATE(DGS%XTSRAD(KLU))
-DGS%XTS = XUNDEF
-DGS%XTSRAD = XUNDEF
+ CALL ALLOC_BUD(DGO,D,KLU,KSW)
!
-IF (DGS%LSURF_BUDGET.OR.DGS%LSURF_BUDGETC) THEN
- ALLOCATE(DGS%XRN (KLU))
- ALLOCATE(DGS%XRN_ICE (KLU))
- ALLOCATE(DGS%XH (KLU))
- ALLOCATE(DGS%XH_ICE (KLU))
- ALLOCATE(DGS%XLE (KLU))
- ALLOCATE(DGS%XLE_ICE (KLU))
- ALLOCATE(DGS%XGFLUX (KLU))
- ALLOCATE(DGS%XGFLUX_ICE(KLU))
- ALLOCATE(DGS%XEVAP (KLU))
- ALLOCATE(DGS%XSUBL (KLU))
- ALLOCATE(DGS%XSWD (KLU))
- ALLOCATE(DGS%XSWU (KLU))
- ALLOCATE(DGS%XSWU_ICE(KLU))
- ALLOCATE(DGS%XLWD (KLU))
- ALLOCATE(DGS%XLWU (KLU))
- ALLOCATE(DGS%XLWU_ICE(KLU))
- ALLOCATE(DGS%XSWBD (KLU,KSW))
- ALLOCATE(DGS%XSWBU (KLU,KSW))
- ALLOCATE(DGS%XSWBU_ICE(KLU,KSW))
- ALLOCATE(DGS%XFMU (KLU))
- ALLOCATE(DGS%XFMU_ICE(KLU))
- ALLOCATE(DGS%XFMV (KLU))
- ALLOCATE(DGS%XFMV_ICE(KLU))
- ALLOCATE(DGS%XALBT (KLU))
+IF (DGO%LSURF_BUDGET.OR.DGO%LSURF_BUDGETC) THEN
+ !
+ ALLOCATE(D%XEVAP (KLU))
+ ALLOCATE(D%XSUBL (KLU))
+ ALLOCATE(D%XALBT (KLU))
!
- DGS%XRN = XUNDEF
- DGS%XRN_ICE = XUNDEF
- DGS%XH = XUNDEF
- DGS%XH_ICE = XUNDEF
- DGS%XLE = XUNDEF
- DGS%XLE_ICE = XUNDEF
- DGS%XGFLUX = XUNDEF
- DGS%XGFLUX_ICE=XUNDEF
- DGS%XEVAP = XUNDEF
- DGS%XSUBL = XUNDEF
- DGS%XSWD = XUNDEF
- DGS%XSWU = XUNDEF
- DGS%XSWU_ICE = XUNDEF
- DGS%XLWD = XUNDEF
- DGS%XLWU = XUNDEF
- DGS%XLWU_ICE = XUNDEF
- DGS%XSWBD = XUNDEF
- DGS%XSWBU = XUNDEF
- DGS%XSWBU_ICE= XUNDEF
- DGS%XFMU = XUNDEF
- DGS%XFMU_ICE = XUNDEF
- DGS%XFMV = XUNDEF
- DGS%XFMV_ICE = XUNDEF
- DGS%XALBT = XUNDEF
+ D%XEVAP = XUNDEF
+ D%XSUBL = XUNDEF
+ D%XALBT = XUNDEF
!
ELSE
- ALLOCATE(DGS%XRN (0))
- ALLOCATE(DGS%XRN_ICE (0))
- ALLOCATE(DGS%XH (0))
- ALLOCATE(DGS%XH_ICE (0))
- ALLOCATE(DGS%XLE (0))
- ALLOCATE(DGS%XLE_ICE (0))
- ALLOCATE(DGS%XGFLUX (0))
- ALLOCATE(DGS%XGFLUX_ICE(0))
- ALLOCATE(DGS%XEVAP (0))
- ALLOCATE(DGS%XSUBL (0))
- ALLOCATE(DGS%XSWD (0))
- ALLOCATE(DGS%XSWU (0))
- ALLOCATE(DGS%XSWU_ICE(0))
- ALLOCATE(DGS%XLWD (0))
- ALLOCATE(DGS%XLWU (0))
- ALLOCATE(DGS%XLWU_ICE(0))
- ALLOCATE(DGS%XSWBD (0,0))
- ALLOCATE(DGS%XSWBU (0,0))
- ALLOCATE(DGS%XSWBU_ICE(0,0))
- ALLOCATE(DGS%XFMU (0))
- ALLOCATE(DGS%XFMU_ICE(0))
- ALLOCATE(DGS%XFMV (0))
- ALLOCATE(DGS%XFMV_ICE(0))
- ALLOCATE(DGS%XALBT (0))
+ !
+ ALLOCATE(D%XEVAP (0))
+ ALLOCATE(D%XSUBL (0))
+ ALLOCATE(D%XALBT (0))
+ !
ENDIF
!
+ALLOCATE(D%XTSRAD(KLU))
+D%XTSRAD = XUNDEF
+!
!* cumulative surface energy budget
!
#ifdef SFX_OL
-IF (DGS%LSURF_BUDGETC .OR. (LRESTART .AND. .NOT.DGS%LRESET_BUDGETC)) THEN
+IF (DGO%LSURF_BUDGETC .OR. (LRESTART .AND. .NOT.DGO%LRESET_BUDGETC)) THEN
#else
-IF (DGS%LSURF_BUDGETC .OR. .NOT.DGS%LRESET_BUDGETC) THEN
+IF (DGO%LSURF_BUDGETC .OR. .NOT.DGO%LRESET_BUDGETC) THEN
#endif
-!
- ALLOCATE(DGS%XRNC (KLU))
- ALLOCATE(DGS%XRNC_ICE(KLU))
- ALLOCATE(DGS%XHC (KLU))
- ALLOCATE(DGS%XHC_ICE (KLU))
- ALLOCATE(DGS%XLEC (KLU))
- ALLOCATE(DGS%XLEC_ICE(KLU))
- ALLOCATE(DGS%XGFLUXC (KLU))
- ALLOCATE(DGS%XGFLUXC_ICE(KLU))
- ALLOCATE(DGS%XEVAPC (KLU))
- ALLOCATE(DGS%XSUBLC (KLU))
- ALLOCATE(DGS%XSWDC (KLU))
- ALLOCATE(DGS%XSWUC (KLU))
- ALLOCATE(DGS%XSWUC_ICE(KLU))
- ALLOCATE(DGS%XLWDC (KLU))
- ALLOCATE(DGS%XLWUC (KLU))
- ALLOCATE(DGS%XLWUC_ICE(KLU))
- ALLOCATE(DGS%XFMUC (KLU))
- ALLOCATE(DGS%XFMUC_ICE(KLU))
- ALLOCATE(DGS%XFMVC (KLU))
- ALLOCATE(DGS%XFMVC_ICE(KLU))
-!
- IF (.NOT. DGU%LREAD_BUDGETC) THEN
- DGS%XRNC = 0.0
- DGS%XRNC_ICE =0.0
- DGS%XHC = 0.0
- DGS%XHC_ICE =0.0
- DGS%XLEC = 0.0
- DGS%XLEC_ICE= 0.0
- DGS%XGFLUXC = 0.0
- DGS%XGFLUXC_ICE=0.0
- DGS%XEVAPC = 0.0
- DGS%XSUBLC = 0.0
- DGS%XSWDC = 0.0
- DGS%XSWUC = 0.0
- DGS%XSWUC_ICE=0.0
- DGS%XLWDC = 0.0
- DGS%XLWUC = 0.0
- DGS%XLWUC_ICE=0.0
- DGS%XFMUC = 0.0
- DGS%XFMUC_ICE=0.0
- DGS%XFMVC = 0.0
- DGS%XFMVC_ICE=0.0
- ELSEIF (DGU%LREAD_BUDGETC.AND.DGS%LRESET_BUDGETC) THEN
- DGS%XRNC = 0.0
- DGS%XRNC_ICE= 0.0
- DGS%XHC = 0.0
- DGS%XHC_ICE = 0.0
- DGS%XLEC = 0.0
- DGS%XLEC_ICE= 0.0
- DGS%XGFLUXC = 0.0
- DGS%XGFLUXC_ICE=0.0
- DGS%XEVAPC = 0.0
- DGS%XSUBLC = 0.0
- DGS%XSWDC = 0.0
- DGS%XSWUC = 0.0
- DGS%XSWUC_ICE=0.0
- DGS%XLWDC = 0.0
- DGS%XLWUC = 0.0
- DGS%XLWUC_ICE=0.0
- DGS%XFMUC = 0.0
- DGS%XFMUC_ICE=0.0
- DGS%XFMVC = 0.0
- DGS%XFMVC_ICE=0.0
+ !
+ CALL ALLOC_SURF_BUD(DC,KLU,KLU,KSW)
+ ALLOCATE(DC%XEVAP (KLU))
+ ALLOCATE(DC%XSUBL (KLU))
+ !
+ IF (.NOT.OREAD_BUDGETC .OR. OREAD_BUDGETC.AND.DGO%LRESET_BUDGETC) THEN
+ CALL INIT_SURF_BUD(DC,0.)
+ DC%XEVAP = 0.0
+ DC%XSUBL = 0.0
ELSE
- CALL READ_SURF(&
- HPROGRAM,'VERSION',IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
YREC='RNC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XRNC,IRESP)
+ CALL READ_SURF(HPROGRAM,YREC,DC%XRN,IRESP)
YREC='HC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XHC ,IRESP)
+ CALL READ_SURF(HPROGRAM,YREC,DC%XH,IRESP)
YREC='LEC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XLEC,IRESP)
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLE,IRESP)
YREC='LEIC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XLEC_ICE,IRESP)
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLEI,IRESP)
YREC='GFLUXC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XGFLUXC ,IRESP)
+ CALL READ_SURF(HPROGRAM,YREC,DC%XGFLUX,IRESP)
YREC='SWDC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XSWDC,IRESP)
+ CALL READ_SURF(HPROGRAM,YREC,DC%XSWD,IRESP)
YREC='SWUC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XSWUC,IRESP)
+ CALL READ_SURF(HPROGRAM,YREC,DC%XSWU,IRESP)
YREC='LWDC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XLWDC,IRESP)
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLWD,IRESP)
YREC='LWUC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XLWUC,IRESP)
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLWU,IRESP)
YREC='FMUC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XFMUC,IRESP)
+ CALL READ_SURF(HPROGRAM,YREC,DC%XFMU,IRESP)
YREC='FMVC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XFMVC,IRESP)
+ CALL READ_SURF(HPROGRAM,YREC,DC%XFMV,IRESP)
IF (IVERSION<8)THEN
- DGS%XEVAPC = 0.0
- DGS%XSUBLC = 0.0
+ DC%XEVAP = 0.0
+ DC%XSUBL = 0.0
ELSE
- !
- YREC='EVAPC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XEVAPC,IRESP)
- YREC='SUBLC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XSUBLC,IRESP)
+ !
+ YREC='EVAPC_SEA'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XEVAP,IRESP)
+ YREC='SUBLC_SEA'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XSUBL,IRESP)
ENDIF
- DGS%XRNC_ICE = 0.0
- DGS%XHC_ICE = 0.0
- DGS%XGFLUXC_ICE = 0.0
- DGS%XSWUC_ICE = 0.0
- DGS%XLWUC_ICE = 0.0
- DGS%XFMUC_ICE = 0.0
- DGS%XFMVC_ICE = 0.0
ENDIF
ELSE
- ALLOCATE(DGS%XRNC (0))
- ALLOCATE(DGS%XRNC_ICE(0))
- ALLOCATE(DGS%XHC (0))
- ALLOCATE(DGS%XHC_ICE (0))
- ALLOCATE(DGS%XLEC (0))
- ALLOCATE(DGS%XLEC_ICE(0))
- ALLOCATE(DGS%XGFLUXC (0))
- ALLOCATE(DGS%XGFLUXC_ICE(0))
- ALLOCATE(DGS%XEVAPC (0))
- ALLOCATE(DGS%XSUBLC (0))
- ALLOCATE(DGS%XSWDC (0))
- ALLOCATE(DGS%XSWUC (0))
- ALLOCATE(DGS%XSWUC_ICE(0))
- ALLOCATE(DGS%XLWDC (0))
- ALLOCATE(DGS%XLWUC (0))
- ALLOCATE(DGS%XLWUC_ICE(0))
- ALLOCATE(DGS%XFMUC (0))
- ALLOCATE(DGS%XFMUC_ICE(0))
- ALLOCATE(DGS%XFMVC (0))
- ALLOCATE(DGS%XFMVC_ICE(0))
+ CALL ALLOC_SURF_BUD(DC,0,0,0)
ENDIF
!
-!* parameters at 2m
-!
-IF (DGS%N2M>=1) THEN
- ALLOCATE(DGS%XRI (KLU))
- ALLOCATE(DGS%XRI_ICE (KLU))
- ALLOCATE(DGS%XT2M (KLU))
- ALLOCATE(DGS%XT2M_ICE (KLU))
- ALLOCATE(DGS%XT2M_MIN (KLU))
- ALLOCATE(DGS%XT2M_MAX (KLU))
- ALLOCATE(DGS%XQ2M (KLU))
- ALLOCATE(DGS%XQ2M_ICE (KLU))
- ALLOCATE(DGS%XHU2M (KLU))
- ALLOCATE(DGS%XHU2M_ICE(KLU))
- ALLOCATE(DGS%XHU2M_MIN(KLU))
- ALLOCATE(DGS%XHU2M_MAX(KLU))
- ALLOCATE(DGS%XZON10M (KLU))
- ALLOCATE(DGS%XZON10M_ICE(KLU))
- ALLOCATE(DGS%XMER10M (KLU))
- ALLOCATE(DGS%XMER10M_ICE(KLU))
- ALLOCATE(DGS%XWIND10M (KLU))
- ALLOCATE(DGS%XWIND10M_ICE(KLU))
- ALLOCATE(DGS%XWIND10M_MAX(KLU))
- !
- DGS%XRI = XUNDEF
- DGS%XRI_ICE = XUNDEF
- DGS%XT2M = XUNDEF
- DGS%XT2M_ICE = XUNDEF
- DGS%XT2M_MIN = XUNDEF
- DGS%XT2M_MAX = 0.0
- DGS%XQ2M = XUNDEF
- DGS%XQ2M_ICE = XUNDEF
- DGS%XHU2M = XUNDEF
- DGS%XHU2M_ICE= XUNDEF
- DGS%XHU2M_MIN= XUNDEF
- DGS%XHU2M_MAX=-XUNDEF
- DGS%XZON10M = XUNDEF
- DGS%XZON10M_ICE=XUNDEF
- DGS%XMER10M = XUNDEF
- DGS%XMER10M_ICE=XUNDEF
- DGS%XWIND10M = XUNDEF
- DGS%XWIND10M_ICE=XUNDEF
- DGS%XWIND10M_MAX = 0.0
-ELSE
- ALLOCATE(DGS%XRI (0))
- ALLOCATE(DGS%XRI_ICE (0))
- ALLOCATE(DGS%XT2M (0))
- ALLOCATE(DGS%XT2M_ICE (0))
- ALLOCATE(DGS%XT2M_MIN (0))
- ALLOCATE(DGS%XT2M_MAX (0))
- ALLOCATE(DGS%XQ2M (0))
- ALLOCATE(DGS%XQ2M_ICE (0))
- ALLOCATE(DGS%XHU2M (0))
- ALLOCATE(DGS%XHU2M_ICE(0))
- ALLOCATE(DGS%XHU2M_MIN(0))
- ALLOCATE(DGS%XHU2M_MAX(0))
- ALLOCATE(DGS%XZON10M (0))
- ALLOCATE(DGS%XZON10M_ICE(0))
- ALLOCATE(DGS%XMER10M (0))
- ALLOCATE(DGS%XMER10M_ICE(0))
- ALLOCATE(DGS%XWIND10M (0))
- ALLOCATE(DGS%XWIND10M_ICE(0))
- ALLOCATE(DGS%XWIND10M_MAX(0))
-END IF
-!
-!* transfer coefficients
-!
-IF (DGS%LCOEF) THEN
- ALLOCATE(DGS%XCD (KLU))
- ALLOCATE(DGS%XCD_ICE (KLU))
- ALLOCATE(DGS%XCH (KLU))
- ALLOCATE(DGS%XCH_ICE (KLU))
- ALLOCATE(DGS%XCE (KLU))
- ALLOCATE(DGS%XZ0 (KLU))
- ALLOCATE(DGS%XZ0_ICE (KLU))
- ALLOCATE(DGS%XZ0H (KLU))
- ALLOCATE(DGS%XZ0H_ICE(KLU))
- !
- DGS%XCD = XUNDEF
- DGS%XCD_ICE = XUNDEF
- DGS%XCH = XUNDEF
- DGS%XCH_ICE = XUNDEF
- DGS%XCE = XUNDEF
- DGS%XZ0 = XUNDEF
- DGS%XZ0_ICE = XUNDEF
- DGS%XZ0H = XUNDEF
- DGS%XZ0H_ICE = XUNDEF
-ELSE
- ALLOCATE(DGS%XCD (0))
- ALLOCATE(DGS%XCD_ICE (0))
- ALLOCATE(DGS%XCH (0))
- ALLOCATE(DGS%XCH_ICE (0))
- ALLOCATE(DGS%XCE (0))
- ALLOCATE(DGS%XZ0 (0))
- ALLOCATE(DGS%XZ0_ICE (0))
- ALLOCATE(DGS%XZ0H (0))
- ALLOCATE(DGS%XZ0H_ICE(0))
-END IF
-!
-!
-!* surface humidity
-!
-IF (DGS%LSURF_VARS) THEN
- ALLOCATE(DGS%XQS (KLU))
- ALLOCATE(DGS%XQS_ICE (KLU))
- !
- DGS%XQS = XUNDEF
- DGS%XQS_ICE = XUNDEF
-ELSE
- ALLOCATE(DGS%XQS (0))
- ALLOCATE(DGS%XQS_ICE (0))
-END IF
-!
!* ocean diag
!
-IF (DGO%LDIAG_OCEAN) THEN
- ALLOCATE(DGO%XTOCMOY (KLU))
- ALLOCATE(DGO%XSOCMOY (KLU))
- ALLOCATE(DGO%XUOCMOY (KLU))
- ALLOCATE(DGO%XVOCMOY (KLU))
- ALLOCATE(DGO%XDOCMOY (KLU))
+IF (DOC%LDIAG_OCEAN) THEN
+ ALLOCATE(DOC%XTOCMOY (KLU))
+ ALLOCATE(DOC%XSOCMOY (KLU))
+ ALLOCATE(DOC%XUOCMOY (KLU))
+ ALLOCATE(DOC%XVOCMOY (KLU))
+ ALLOCATE(DOC%XDOCMOY (KLU))
!
- DGO%XTOCMOY(:)=XUNDEF
- DGO%XSOCMOY(:)=XUNDEF
- DGO%XUOCMOY(:)=XUNDEF
- DGO%XVOCMOY(:)=XUNDEF
- DGO%XDOCMOY(:)=XUNDEF
+ DOC%XTOCMOY(:)=XUNDEF
+ DOC%XSOCMOY(:)=XUNDEF
+ DOC%XUOCMOY(:)=XUNDEF
+ DOC%XVOCMOY(:)=XUNDEF
+ DOC%XDOCMOY(:)=XUNDEF
ELSE
- ALLOCATE(DGO%XTOCMOY (0))
- ALLOCATE(DGO%XSOCMOY (0))
- ALLOCATE(DGO%XUOCMOY (0))
- ALLOCATE(DGO%XVOCMOY (0))
- ALLOCATE(DGO%XDOCMOY (0))
+ ALLOCATE(DOC%XTOCMOY (0))
+ ALLOCATE(DOC%XSOCMOY (0))
+ ALLOCATE(DOC%XUOCMOY (0))
+ ALLOCATE(DOC%XVOCMOY (0))
+ ALLOCATE(DOC%XDOCMOY (0))
ENDIF
!
-!* Seaice model diagnostics init
-!
-IF (DGSI%LDIAG_SEAICE) THEN
- ALLOCATE(DGSI%XSIT(KLU))
- DGSI%XSIT=XUNDEF
- ALLOCATE(DGSI%XSND(KLU))
- DGSI%XSND=XUNDEF
- ALLOCATE(DGSI%XMLT(KLU))
- DGSI%XMLT=XUNDEF
-ELSE
- ALLOCATE(DGSI%XSIT (0))
- ALLOCATE(DGSI%XSND (0))
- ALLOCATE(DGSI%XMLT (0))
-ENDIF
!
!* Earth system model coupling variables
!
@@ -498,7 +205,7 @@ IF(LCPL_SEA.OR.S%LHANDLE_SIC)THEN
ALLOCATE(S%XCPL_SEA_SNOW(KLU))
ALLOCATE(S%XCPL_SEA_EVPR(KLU))
ALLOCATE(S%XCPL_SEA_FWSM(KLU))
- ALLOCATE(S%XCPL_SEA_PRES(KLU))
+ ALLOCATE(S%XCPL_SEA_PRES(KLU))
S%XCPL_SEA_WIND(:) = 0.0
S%XCPL_SEA_FWSU(:) = 0.0
S%XCPL_SEA_FWSV(:) = 0.0
@@ -506,10 +213,10 @@ IF(LCPL_SEA.OR.S%LHANDLE_SIC)THEN
S%XCPL_SEA_HEAT(:) = 0.0
S%XCPL_SEA_EVAP(:) = 0.0
S%XCPL_SEA_RAIN(:) = 0.0
+ S%XCPL_SEA_EVPR(:) = 0.0
S%XCPL_SEA_SNOW(:) = 0.0
- S%XCPL_SEA_EVPR(:) = 0.0
S%XCPL_SEA_FWSM(:) = 0.0
- S%XCPL_SEA_PRES(:) = 0.0
+ S%XCPL_SEA_PRES(:) = 0.0
!
ELSE
ALLOCATE(S%XCPL_SEA_WIND(0))
@@ -520,22 +227,9 @@ ELSE
ALLOCATE(S%XCPL_SEA_EVAP(0))
ALLOCATE(S%XCPL_SEA_RAIN(0))
ALLOCATE(S%XCPL_SEA_SNOW(0))
- ALLOCATE(S%XCPL_SEA_EVPR(0))
+ ALLOCATE(S%XCPL_SEA_EVPR(0))
ALLOCATE(S%XCPL_SEA_FWSM(0))
- ALLOCATE(S%XCPL_SEA_PRES(0))
-ENDIF
-!
-IF(LCPL_SEAICE.OR.S%LHANDLE_SIC)THEN
- ALLOCATE(S%XCPL_SEAICE_SNET(KLU))
- ALLOCATE(S%XCPL_SEAICE_HEAT(KLU))
- ALLOCATE(S%XCPL_SEAICE_EVAP(KLU))
- S%XCPL_SEAICE_SNET(:) = 0.0
- S%XCPL_SEAICE_HEAT(:) = 0.0
- S%XCPL_SEAICE_EVAP(:) = 0.0
-ELSE
- ALLOCATE(S%XCPL_SEAICE_SNET(0))
- ALLOCATE(S%XCPL_SEAICE_HEAT(0))
- ALLOCATE(S%XCPL_SEAICE_EVAP(0))
+ ALLOCATE(S%XCPL_SEA_PRES(0))
ENDIF
!
IF (LHOOK) CALL DR_HOOK('DIAG_SEAFLUX_INIT_N',1,ZHOOK_HANDLE)
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/get_sfx_sea.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/get_sfx_sea.F90
index 5c653346b9527c0c71410722908778377eaa4c48..4778ff7315112242d8b0d8dec0d63c944b318b79 100755
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/get_sfx_sea.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/get_sfx_sea.F90
@@ -99,9 +99,7 @@ REAL, DIMENSION(SIZE(PSEA_HEAT)) :: ZHEAT
REAL, DIMENSION(SIZE(PSEA_HEAT)) :: ZEVAP
REAL, DIMENSION(SIZE(PSEA_HEAT)) :: ZRAIN
REAL, DIMENSION(SIZE(PSEA_HEAT)) :: ZSNOW
-REAL, DIMENSION(SIZE(PSEA_HEAT)) :: ZEVPR
REAL, DIMENSION(SIZE(PSEA_HEAT)) :: ZFWSM
-REAL, DIMENSION(SIZE(PSEA_HEAT)) :: ZPRES
!
REAL, DIMENSION(SIZE(PSEA_HEAT)) :: ZSNET_ICE
REAL, DIMENSION(SIZE(PSEA_HEAT)) :: ZHEAT_ICE
@@ -125,9 +123,7 @@ PSEA_FWSM (:) = XUNDEF
PSEA_EVAP (:) = XUNDEF
PSEA_RAIN (:) = XUNDEF
PSEA_SNOW (:) = XUNDEF
-PSEA_EVPR (:) = XUNDEF
PSEA_WATF (:) = XUNDEF
-PSEA_PRES (:) = XUNDEF
!
PSEAICE_HEAT (:) = XUNDEF
PSEAICE_SNET (:) = XUNDEF
@@ -142,7 +138,6 @@ ZFWSM (:) = XUNDEF
ZEVAP (:) = XUNDEF
ZRAIN (:) = XUNDEF
ZSNOW (:) = XUNDEF
-ZEVPR (:) = XUNDEF
!
ZHEAT_ICE (:) = XUNDEF
ZSNET_ICE (:) = XUNDEF
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/get_sfx_wave.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/get_sfx_wave.F90
index 17a47d0069608495b6ea753955c0780598420638..968df021c6387b5a732c8c8732b70ce6a7da97a7 100755
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/get_sfx_wave.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/get_sfx_wave.F90
@@ -39,7 +39,7 @@
! ------------
!
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_DIAG_SEAFLUX_n, ONLY : DIAG_SEAFLUX_t
+USE MODD_DIAG_n, ONLY : DIAG_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
@@ -55,7 +55,7 @@ IMPLICIT NONE
! -------------------------
!
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(DIAG_SEAFLUX_t), INTENT(INOUT) :: DGS
+TYPE(DIAG_t), INTENT(INOUT) :: DGS
!
REAL, DIMENSION(:), INTENT(OUT) :: PWAVE_U10 ! 10 meter u-wind (m/s)
REAL, DIMENSION(:), INTENT(OUT) :: PWAVE_V10 ! 10 meter v-wind (m/s)
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/get_sfxcpln.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/get_sfxcpln.F90
index e0df0a92ed94d2f62d2a59dd5aa4d3c90db97ff9..32a566ddac320824863c626b40a043db84141752 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/get_sfxcpln.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/get_sfxcpln.F90
@@ -3,10 +3,10 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GET_SFXCPL_n (I, S, U, W, &
+ SUBROUTINE GET_SFXCPL_n (IM, S, U, W, &
HPROGRAM,KI,PRUI,PWIND,PFWSU,PFWSV,PSNET, &
- PHEAT,PEVAP,PRAIN,PSNOW,PEVPR,PICEFLUX, &
- PFWSM,PPS,PHEAT_ICE,PEVAP_ICE,PSNET_ICE)
+ PHEAT,PEVAP,PRAIN,PSNOW,PEVPR,PICEFLUX, &
+ PFWSM,PPS,PHEAT_ICE,PEVAP_ICE,PSNET_ICE)
! ###################################################################
!
!!**** *GETSFXCPL_n* - routine to get some variables from surfex into
@@ -41,8 +41,9 @@
!! MODIFICATIONS
!! -------------
!! Original 08/2009
+!! 10/2016 B. Decharme : bug surface/groundwater coupling
!! Modified 11/2014 : J. Pianezze - Add surface pressure coupling parameter
-!----------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
@@ -50,7 +51,7 @@
!
!
!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_WATFLUX_n, ONLY : WATFLUX_t
@@ -78,7 +79,7 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(WATFLUX_t), INTENT(INOUT) :: W
@@ -109,7 +110,6 @@ REAL, DIMENSION(KI), INTENT(OUT) :: PSNET_ICE
REAL, DIMENSION(KI) :: ZRUNOFF ! Cumulated Surface runoff (kg/m2)
REAL, DIMENSION(KI) :: ZDRAIN ! Cumulated Deep drainage (kg/m2)
REAL, DIMENSION(KI) :: ZCALVING ! Cumulated Calving flux (kg/m2)
-REAL, DIMENSION(KI) :: ZRECHARGE ! Cumulated Recharge to groundwater (kg/m2)
REAL, DIMENSION(KI) :: ZSRCFLOOD ! Cumulated flood freshwater flux (kg/m2)
!
REAL, DIMENSION(KI) :: ZSEA_FWSU ! Cumulated zonal wind stress (Pa.s)
@@ -157,15 +157,13 @@ IF(LCPL_LAND)THEN
ZRUNOFF (:) = XUNDEF
ZDRAIN (:) = XUNDEF
ZCALVING (:) = XUNDEF
- ZRECHARGE(:) = XUNDEF
ZSRCFLOOD(:) = XUNDEF
!
! * Get land output fields
!
- CALL GET_SFX_LAND(I, U, &
+ CALL GET_SFX_LAND(IM%O, IM%S, U, &
LCPL_GW,LCPL_FLOOD,LCPL_CALVING, &
- ZRUNOFF,ZDRAIN,ZCALVING,ZRECHARGE, &
- ZSRCFLOOD )
+ ZRUNOFF,ZDRAIN,ZCALVING,ZSRCFLOOD )
!
! * Assign land output fields
!
@@ -203,7 +201,7 @@ IF(LCPL_SEA)THEN
LCPL_SEAICE,LWATER, &
ZSEA_FWSU,ZSEA_FWSV,ZSEA_HEAT,ZSEA_SNET, &
ZSEA_WIND,ZSEA_FWSM,ZSEA_EVAP,ZSEA_RAIN, &
- ZSEA_SNOW,ZSEA_EVPR,ZSEA_WATF,ZSEA_PRES, &
+ ZSEA_SNOW,ZSEA_EVPR,ZSEA_WATF,ZSEA_PRES, &
ZSEAICE_HEAT,ZSEAICE_SNET,ZSEAICE_EVAP )
!
! * Assign sea output fields
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/init_seafluxn.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/init_seafluxn.F90
index a00b0930af3d5e22c26570598ff2211bbf71a45f..e22e2a731ef36b420a7d203fd326d5a8b1bf8fb2 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/init_seafluxn.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/init_seafluxn.F90
@@ -3,15 +3,12 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #############################################################
- SUBROUTINE INIT_SEAFLUX_n (DTCO, DGU, UG, U, SM,GCP, &
- HPROGRAM,HINIT, &
- KI,KSV,KSW, &
- HSV,PCO2,PRHOA, &
- PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD,PTSURF, &
- KYEAR, KMONTH,KDAY, PTIME, &
- HATMFILE,HATMFILETYPE, &
- HTEST )
+ SUBROUTINE INIT_SEAFLUX_n (DTCO, OREAD_BUDGETC, UG, U, GCP, SM, &
+ HPROGRAM,HINIT,KI,KSV,KSW, &
+ HSV,PCO2,PRHOA,PZENITH,PAZIM,PSW_BANDS, &
+ PDIR_ALB,PSCA_ALB, PEMIS,PTSRAD,PTSURF, &
+ KYEAR, KMONTH,KDAY,PTIME, &
+ HATMFILE,HATMFILETYPE,HTEST )
! #############################################################
!
!!**** *INIT_SEAFLUX_n* - routine to initialize SEAFLUX
@@ -56,16 +53,14 @@
!* 0. DECLARATIONS
! ------------
!
-!
USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
-USE MODD_SFX_OASIS, ONLY : LCPL_WAVE,LCPL_SEA,LCPL_SEAICE
+USE MODD_SFX_OASIS, ONLY : LCPL_WAVE, LCPL_SEA, LCPL_SEAICE
!
USE MODD_READ_NAMELIST, ONLY : LNAM_READ
USE MODD_CSTS, ONLY : XTTS
@@ -91,6 +86,7 @@ USE MODI_READ_SEAICE_n
!
USE MODI_READ_PGD_SEAFLUX_n
USE MODI_DIAG_SEAFLUX_INIT_n
+USE MODI_DIAG_SEAICE_INIT_n
USE MODI_END_IO_SURF_n
USE MODI_GET_LUOUT
USE MODI_READ_SURF
@@ -99,7 +95,7 @@ USE MODI_READ_NAM_PREP_SEAFLUX_n
USE MODI_INIT_CHEMICAL_n
USE MODI_PREP_CTRL_SEAFLUX
USE MODI_UPDATE_RAD_SEA
-USE MODI_READ_SEAFLUX_SBL_n
+USE MODI_READ_SBL_n
USE MODI_ABOR1_SFX
!
USE MODI_SET_SURFEX_FILEIN
@@ -115,18 +111,19 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
- CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize
+LOGICAL, INTENT(IN) :: OREAD_BUDGETC
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize
INTEGER, INTENT(IN) :: KI ! number of points
INTEGER, INTENT(IN) :: KSV ! number of scalars
INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands
- CHARACTER(LEN=6), DIMENSION(KSV), INTENT(IN) :: HSV ! name of all scalar variables
+CHARACTER(LEN=6), DIMENSION(KSV), INTENT(IN) :: HSV ! name of all scalar variables
REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration (kg/m3)
REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density
REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! solar zenithal angle
@@ -143,9 +140,9 @@ INTEGER, INTENT(IN) :: KDAY ! current day (UTC)
REAL, INTENT(IN) :: PTIME ! current time since
! midnight (UTC, s)
!
- CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! atmospheric file name
- CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! atmospheric file type
- CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
+CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! atmospheric file name
+CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! atmospheric file type
+CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
!
!
!* 0.2 Declarations of local variables
@@ -161,6 +158,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! Initialisation for IO
!
IF (LHOOK) CALL DR_HOOK('INIT_SEAFLUX_N',0,ZHOOK_HANDLE)
+!
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
IF (HTEST/='OK') THEN
@@ -187,42 +185,41 @@ IF (LNAM_READ) THEN
! 0.1. Hard defaults
!
- CALL DEFAULT_SEAFLUX(SM%S%XTSTEP,SM%S%XOUT_TSTEP,SM%S%CSEA_ALB,SM%S%CSEA_FLUX,SM%S%LPWG, &
- SM%S%LPRECIP,SM%S%LPWEBB,SM%S%NZ0,SM%S%NGRVWAVES,SM%O%LPROGSST, &
+ CALL DEFAULT_SEAFLUX(SM%S%XTSTEP,SM%S%XOUT_TSTEP,SM%S%CSEA_ALB,SM%S%CSEA_FLUX,SM%S%LPWG, &
+ SM%S%LPRECIP,SM%S%LPWEBB,SM%S%NZ0,SM%S%NGRVWAVES,SM%O%LPROGSST, &
SM%O%NTIME_COUPLING,SM%O%XOCEAN_TSTEP,SM%S%XICHCE,SM%S%CINTERPOL_SST,&
SM%S%CINTERPOL_SSS,SM%S%LWAVEWIND )
- CALL DEFAULT_SEAICE(HPROGRAM, &
+ CALL DEFAULT_SEAICE(HPROGRAM, &
SM%S%CINTERPOL_SIC,SM%S%CINTERPOL_SIT, SM%S%XFREEZING_SST, &
- SM%S%XSEAICE_TSTEP, SM%S%XSIC_EFOLDING_TIME, &
+ SM%S%XSEAICE_TSTEP, SM%S%XSIC_EFOLDING_TIME, &
SM%S%XSIT_EFOLDING_TIME, SM%S%XCD_ICE_CST, SM%S%XSI_FLX_DRV)
!
CALL DEFAULT_CH_DEP(SM%CHS%CCH_DRY_DEP)
!
- CALL DEFAULT_DIAG_SEAFLUX(SM%DGS%N2M,SM%DGS%LSURF_BUDGET,SM%DGS%L2M_MIN_ZS,&
- SM%DGS%LRAD_BUDGET,SM%DGS%LCOEF,SM%DGS%LSURF_VARS,&
- SM%DGO%LDIAG_OCEAN,SM%DGSI%LDIAG_SEAICE,SM%DGS%LSURF_BUDGETC,&
- SM%DGS%LRESET_BUDGETC,SM%DGS%XDIAG_TSTEP )
+ CALL DEFAULT_DIAG_SEAFLUX(SM%SD%O%N2M,SM%SD%O%LSURF_BUDGET,SM%SD%O%L2M_MIN_ZS,&
+ SM%SD%O%LRAD_BUDGET,SM%SD%O%LCOEF,SM%SD%O%LSURF_VARS,&
+ SM%SD%GO%LDIAG_OCEAN,SM%SD%DMI%LDIAG_MISC_SEAICE,&
+ SM%SD%O%LSURF_BUDGETC,SM%SD%O%LRESET_BUDGETC,SM%SD%O%XDIAG_TSTEP )
ENDIF
!
!
! 0.2. Defaults from file header
!
- CALL READ_DEFAULT_SEAFLUX_n(SM%CHS, SM%DGO, SM%DGS, SM%DGSI, SM%O, SM%S, &
- HPROGRAM)
+ CALL READ_DEFAULT_SEAFLUX_n(SM%CHS, SM%SD%GO, SM%SD%O, SM%SD%DMI, SM%O, SM%S, HPROGRAM)
!
!* 1.1 Reading of configuration:
! -------------------------
!
- CALL READ_SEAFLUX_CONF_n(SM%CHS, SM%DGO, SM%DGS, SM%DGSI, SM%O, SM%S, &
- HPROGRAM)
+ CALL READ_SEAFLUX_CONF_n(SM%CHS, SM%SD%GO, SM%SD%O, SM%SD%DMI, SM%O, SM%S, HPROGRAM)
!
SM%S%LINTERPOL_SST=.FALSE.
SM%S%LINTERPOL_SSS=.FALSE.
SM%S%LINTERPOL_SIC=.FALSE.
SM%S%LINTERPOL_SIT=.FALSE.
+!
IF(LCPL_SEA)THEN
- IF(SM%DGS%N2M<1)THEN
+ IF(SM%SD%O%N2M<1)THEN
CALL ABOR1_SFX('INIT_SEAFLUX_n: N2M must be set >0 in case of LCPL_SEA')
ENDIF
! No STT / SSS interpolation in Earth System Model
@@ -260,19 +257,15 @@ SELECT CASE (HINIT)
!
CASE ('PRE')
!
- CALL PREP_CTRL_SEAFLUX(SM%DGS%N2M,SM%DGS%LSURF_BUDGET,SM%DGS%L2M_MIN_ZS,&
- SM%DGS%LRAD_BUDGET,SM%DGS%LCOEF,SM%DGS%LSURF_VARS,&
- SM%DGO%LDIAG_OCEAN,SM%DGSI%LDIAG_SEAICE,ILUOUT,SM%DGS%LSURF_BUDGETC )
+ CALL PREP_CTRL_SEAFLUX(SM%SD%O,SM%SD%GO%LDIAG_OCEAN,SM%SD%DMI%LDIAG_MISC_SEAICE,ILUOUT )
IF (LNAM_READ) CALL READ_NAM_PREP_SEAFLUX_n(HPROGRAM)
- CALL READ_SEAFLUX_DATE(SM%O, &
- HPROGRAM,HINIT,ILUOUT,HATMFILE,HATMFILETYPE,KYEAR,KMONTH,KDAY,PTIME,SM%S%TTIME)
+ CALL READ_SEAFLUX_DATE(SM%O%LMERCATOR,HPROGRAM,HINIT,ILUOUT,HATMFILE,HATMFILETYPE,&
+ KYEAR,KMONTH,KDAY,PTIME,SM%S%TTIME)
!
CASE DEFAULT
!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'SEA ','SEAFLX','READ ')
- CALL READ_SURF(&
- HPROGRAM,'DTCUR',SM%S%TTIME,IRESP)
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'FULL ','SURF ','READ ')
+ CALL READ_SURF(HPROGRAM,'DTCUR',SM%S%TTIME,IRESP)
CALL END_IO_SURF_n(HPROGRAM)
!
END SELECT
@@ -284,15 +277,15 @@ END SELECT
! Initialisation for IO
!
CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ') ! change input file name to pgd name
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'SEA ','SEAFLX','READ ')
+!
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'SEA ','SEAFLX','READ ')
!
! Reading of the fields
!
- CALL READ_PGD_SEAFLUX_n(DTCO, SM%DTS, SM%SG, SM%S, U,GCP, &
- HPROGRAM)
+ CALL READ_PGD_SEAFLUX_n(DTCO, SM%DTS, SM%G, SM%S, U, UG, GCP, HPROGRAM)
!
CALL END_IO_SURF_n(HPROGRAM)
+!
CALL SET_SURFEX_FILEIN(HPROGRAM,'PREP') ! restore input file name
!-------------------------------------------------------------------------------
!
@@ -307,8 +300,7 @@ END IF
!
! Initialisation for IO
!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'SEA ','SEAFLX','READ ')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'SEA ','SEAFLX','READ ')
!
!* 2. Prognostic fields:
! ----------------
@@ -321,8 +313,7 @@ IF(SM%S%LINTERPOL_SST.OR.SM%S%LINTERPOL_SSS.OR.SM%S%LINTERPOL_SIC.OR.SM%S%LINTER
SM%S%TZTIME%TIME = SM%S%TTIME%TIME
ENDIF
!
- CALL READ_SEAFLUX_n(DTCO, SM%SG, SM%S, U, &
- HPROGRAM,ILUOUT)
+ CALL READ_SEAFLUX_n(DTCO, SM%G, SM%S, U, HPROGRAM,ILUOUT)
!
IF (HINIT/='ALL') THEN
CALL END_IO_SURF_n(HPROGRAM)
@@ -334,8 +325,7 @@ END IF
!* 2.1 Ocean fields:
! -------------
!
- CALL READ_OCEAN_n(DTCO, SM%O, SM%OR, U, &
- HPROGRAM)
+ CALL READ_OCEAN_n(DTCO, SM%O, SM%OR, U, HPROGRAM)
!
!-------------------------------------------------------------------------------
!
@@ -357,15 +347,19 @@ ENDWHERE
! (Sea current and Sea-ice temperature)
! -----------------------------------------------------------------
!
-IF(LCPL_SEA .OR. SM%S%LHANDLE_SIC .OR. LCPL_WAVE)THEN
+IF(LCPL_SEA.OR.SM%S%LHANDLE_SIC.OR.LCPL_WAVE)THEN
+!
ALLOCATE(SM%S%XUMER (ILU))
ALLOCATE(SM%S%XVMER (ILU))
- SM%S%XUMER (:)=0
- SM%S%XVMER (:)=0
+!
+ SM%S%XUMER (:)=0.
+ SM%S%XVMER (:)=0.
!
ELSE
+!
ALLOCATE(SM%S%XUMER (0))
ALLOCATE(SM%S%XVMER (0))
+!
ENDIF
!
IF(LCPL_WAVE) THEN
@@ -389,9 +383,7 @@ ENDIF
!
!* 4. Seaice prognostic variables and forcings :
!
- CALL READ_SEAICE_n(&
- SM%SG, SM%S, &
- HPROGRAM,ILU,ILUOUT)
+CALL READ_SEAICE_n(SM%G, SM%S, HPROGRAM,ILU,ILUOUT)
!
!-------------------------------------------------------------------------------
!
@@ -401,9 +393,7 @@ ENDIF
ALLOCATE(SM%S%XEMIS (ILU))
SM%S%XEMIS = 0.0
!
- CALL UPDATE_RAD_SEA(SM%S%CSEA_ALB,SM%S%XSST,PZENITH,XTTS,SM%S%XEMIS,SM%S%XDIR_ALB,&
- SM%S%XSCA_ALB,PDIR_ALB,PSCA_ALB,PEMIS,PTSRAD, &
- SM%S%LHANDLE_SIC,SM%S%XTICE,SM%S%XSIC,SM%S%XICE_ALB )
+CALL UPDATE_RAD_SEA(SM%S,PZENITH,XTTS,PDIR_ALB,PSCA_ALB,PEMIS,PTSRAD )
!
IF (SM%S%LHANDLE_SIC) THEN
PTSURF(:) = SM%S%XSST(:) * ( 1 - SM%S%XSIC(:)) + SM%S%XTICE(:) * SM%S%XSIC(:)
@@ -416,15 +406,14 @@ ENDIF
!* 6. SBL air fields:
! --------------
!
- CALL READ_SEAFLUX_SBL_n(DTCO, SM%S, SM%SSB, U, &
- HPROGRAM)
+ CALL READ_SBL_n(DTCO, U, SM%SB, SM%S%LSBL, HPROGRAM, "SEA ")
!
!-------------------------------------------------------------------------------
!
!* 7. Chemistry /dust
! ---------
!
- CALL INIT_CHEMICAL_n(ILUOUT, KSV, HSV, SM%CHS%SVS, &
+ CALL INIT_CHEMICAL_n(ILUOUT, KSV, HSV, SM%CHS%SVS, &
SM%CHS%CCH_NAMES, SM%CHS%CAER_NAMES, &
HDSTNAMES=SM%CHS%CDSTNAMES, HSLTNAMES=SM%CHS%CSLTNAMES )
!
@@ -442,12 +431,15 @@ END IF
! --------------------------
!
IF(.NOT.(SM%S%LHANDLE_SIC.OR.LCPL_SEAICE))THEN
- SM%DGSI%LDIAG_SEAICE=.FALSE.
+ SM%SD%DMI%LDIAG_MISC_SEAICE=.FALSE.
ENDIF
!
- CALL DIAG_SEAFLUX_INIT_n(&
- SM%DGO, SM%DGS, SM%DGSI, DGU, SM%S, &
- HPROGRAM,ILU,KSW)
+ CALL DIAG_SEAFLUX_INIT_n(SM%SD%GO, SM%SD%O, SM%SD%D, SM%SD%DC, OREAD_BUDGETC, SM%S, &
+ HPROGRAM,ILU,KSW)
+IF (SM%S%LHANDLE_SIC.OR.LCPL_SEAICE) &
+ CALL DIAG_SEAICE_INIT_n(SM%SD%O, SM%SD%DI, SM%SD%DIC, SM%SD%DMI, &
+ OREAD_BUDGETC, SM%S, HPROGRAM,ILU,KSW)
+
!
!-------------------------------------------------------------------------------
!
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/modd_seafluxn.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/modd_seafluxn.F90
index e91b7404cb4fc1ab4b4ae115ecf1607e8533d261..360b12c622831e0780e6b0d7dffcdb069cc85c9f 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/modd_seafluxn.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/modd_seafluxn.F90
@@ -190,7 +190,6 @@ IF (LHOOK) CALL DR_HOOK("MODD_SEAFLUX_N:SEAFLUX_INIT",0,ZHOOK_HANDLE)
NULLIFY(YSEAFLUX%XICE_ALB)
NULLIFY(YSEAFLUX%XUMER)
NULLIFY(YSEAFLUX%XVMER)
- NULLIFY(YSEAFLUX%XCHARN)
NULLIFY(YSEAFLUX%XSST_MTH)
NULLIFY(YSEAFLUX%XSSS_MTH)
NULLIFY(YSEAFLUX%XSIC_MTH)
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/modd_sfx_oasis.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/modd_sfx_oasis.F90
index 71fc9d50c9a9953da06a7adefe4da31b16a4a9b8..3d8bc24bda17e3f2885c2136b9f7bba838c2fa31 100755
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/modd_sfx_oasis.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/modd_sfx_oasis.F90
@@ -27,6 +27,8 @@ MODULE MODD_SFX_OASIS
!! -------------
!! Original 10/13
!! Modified 11/2014 : J. Pianezze - add wave coupling and creation of OASIS grids
+!! S.Senesi 08/2015 : add CMODEL_NAME
+!! 10/2016 B. Decharme : bug surface/groundwater coupling
!
!* 0. DECLARATIONS
! ------------
@@ -40,7 +42,12 @@ IMPLICIT NONE
!-------------------------------------------------------------------------------
!
LOGICAL :: LOASIS = .FALSE. ! To use oasis coupler or not
+!
LOGICAL :: LOASIS_GRID = .FALSE. ! To define oasis grids, areas and masks during simulation
+!
+CHARACTER(LEN=6) :: CMODEL_NAME ! component model name (i.e. name under which
+! ! Surfex is declared to Oasis)
+!
REAL :: XRUNTIME = 0.0 ! Total simulated time in oasis namcouple (s)
!
!-------------------------------------------------------------------------------
@@ -59,7 +66,6 @@ LOGICAL :: LCPL_FLOOD = .FALSE. ! Fields to/from surfex land area
INTEGER :: NRUNOFF_ID ! Surface runoff id
INTEGER :: NDRAIN_ID ! Drainage id
INTEGER :: NCALVING_ID ! Calving flux id
-INTEGER :: NRECHARGE_ID ! Groundwater recharge id
INTEGER :: NSRCFLOOD_ID ! Floodplains freshwater flux id
!
! Input variables
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/mode_read_netcdf_mercator.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/mode_read_netcdf_mercator.F90
index 5fb4c686ff587c7e29476013c8a9175d74e8f250..b8384b97f8c801aa24159fafa41fb698c84b8659 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/mode_read_netcdf_mercator.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/mode_read_netcdf_mercator.F90
@@ -24,15 +24,16 @@ CONTAINS
! ####################
SUBROUTINE HANDLE_ERR_MER(status,line)
! ####################
+USE NETCDF
+!
IMPLICIT NONE
INTEGER, INTENT(IN) :: status
CHARACTER(LEN=80), INTENT(IN) :: line
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:HANDLE_ERR_MER',0,ZHOOK_HANDLE)
-IF (status /= NF_NOERR) THEN
+IF (status /= NF90_NOERR) THEN
CALL ABOR1_SFX('MODE_READ_NETCDF_MERCATOR: HANDLE_ERR_MER')
END IF
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:HANDLE_ERR_MER',1,ZHOOK_HANDLE)
@@ -43,6 +44,8 @@ END SUBROUTINE HANDLE_ERR_MER
SUBROUTINE GET1DCDF(KCDF_ID,IDVAR,PMISSVALUE,PVALU1D)
! ####################
!
+USE NETCDF
+!
IMPLICIT NONE
!
INTEGER,INTENT(IN) :: KCDF_ID !netcdf file identifiant
@@ -58,11 +61,11 @@ integer,DIMENSION(:),ALLOCATABLE :: NVARDIMID,NVARDIMLEN
character(len=80),DIMENSION(:),ALLOCATABLE :: NVARDIMNAM
integer :: JLOOP
integer :: NGATTS
+integer, dimension(1) :: NDIMID
character(len=80),DIMENSION(:),ALLOCATABLE :: HNAME
REAL,DIMENSION(:),ALLOCATABLE :: ZVALU1D !value array
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:GET1DCDF',0,ZHOOK_HANDLE)
PMISSVALUE=-9999.9
@@ -74,24 +77,22 @@ NVARDIMLEN(:)=0
NVARDIMNAM(:)=' '
!
HACTION='get variable type'
-status=nf_inq_vartype(KCDF_ID,IDVAR,KVARTYPE)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
-!write(0,*) 'variable type = ',KVARTYPE
+status=nf90_inquire_variable(KCDF_ID,IDVAR,XTYPE=KVARTYPE)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!
+status=nf90_inquire_variable(KCDF_ID,IDVAR,DIMIDS=NDIMID)
HACTION='get variable dimensions name'
-status=nf_inq_dimname(KCDF_ID,IDVAR,NVARDIMNAM(NDIMS))
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_inquire_dimension(KCDF_ID,NDIMID(NDIMS),NAME=NVARDIMNAM(NDIMS))
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!
HACTION='get variable dimensions length'
-status=nf_inq_dimlen(KCDF_ID,IDVAR,NVARDIMLEN(NDIMS))
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
-!write(0,*) 'variable dimension ',NDIMS,' named ',NVARDIMNAM(NDIMS),&
+status=nf90_inquire_dimension(KCDF_ID,NDIMID(NDIMS),LEN=NVARDIMLEN(NDIMS))
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
! &'has a length of',NVARDIMLEN(NDIMS)
!!
HACTION='get attributs'
-status=nf_inq_varnatts(KCDF_ID,IDVAR,NGATTS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
-!write(0,*) 'number of attributes = ',NGATTS
+status=nf90_inquire_variable(KCDF_ID,IDVAR,NATTS=NGATTS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
allocate(hname(1:NGATTS))
!
ALLOCATE(ZVALU1D(1:NVARDIMLEN(NDIMS)))
@@ -99,8 +100,8 @@ ZVALU1D=0.
!
IF (KVARTYPE>=5) then
HACTION='get variable values (1D)'
- status=nf_get_var_double(KCDF_ID,IDVAR,ZVALU1D(:))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_get_var(KCDF_ID,IDVAR,ZVALU1D(:))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
ENDIF
!
PVALU1D(:)=ZVALU1D(:)
@@ -117,6 +118,8 @@ END SUBROUTINE GET1DCDF
! ####################
USE MODD_SURF_PAR, ONLY : XUNDEF
!
+USE NETCDF
+!
IMPLICIT NONE
!
INTEGER,INTENT(IN) :: KCDF_ID !netcdf file identifiant
@@ -141,7 +144,6 @@ REAL,DIMENSION(:,:),ALLOCATABLE :: ZVALU2D !value array
INTEGER,DIMENSION(:,:),ALLOCATABLE :: IVALU2D
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:GET2DCDF',0,ZHOOK_HANDLE)
PMISSVALUE=-9999.9
@@ -153,81 +155,68 @@ NVARDIMLEN(:)=0
NVARDIMNAM(:)=' '
!
HACTION='get variable type'
-status=nf_inq_vartype(KCDF_ID,IDVAR,KVARTYPE)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
-!write(0,*) 'variable type = ',KVARTYPE
+status=nf90_inquire_variable(KCDF_ID,IDVAR,XTYPE=KVARTYPE)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!
HACTION='get variable dimensions identifiant'
-status=nf_inq_vardimid(KCDF_ID,IDVAR,NVARDIMID)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_inquire_variable(KCDF_ID,IDVAR,DIMIDS=NVARDIMID)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!
HACTION='get attributs'
-status=nf_inq_varnatts(KCDF_ID,IDVAR,NGATTS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
-!write(0,*) 'number of attributes = ',NGATTS
+status=nf90_inquire_variable(KCDF_ID,IDVAR,NATTS=NGATTS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
allocate(hname(1:NGATTS))
!
ZSCFA=1.
ZOFFS=0.
DO JLOOP=1,NGATTS
- status=nf_inq_attname(KCDF_ID,IDVAR,JLOOP,hname(JLOOP))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
- !write(0,*) 'attributes names = ', hname(JLOOP)
+ status=nf90_inq_attname(KCDF_ID,IDVAR,JLOOP,hname(JLOOP))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
if (TRIM(hname(JLOOP))=='missing_value') then
- !write(0,*) 'missing value search '
HACTION='get missing value'
- status=nf_get_att_double(KCDF_ID,IDVAR,"missing_value",PMISSVALUE)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
- !write(0,*) 'missing value = ',PMISSVALUE
+ status=nf90_get_att(KCDF_ID,IDVAR,"missing_value",PMISSVALUE)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
else
if (TRIM(hname(JLOOP))=='_FillValue') then
- !write(0,*) 'missing value found '
HACTION='get _FillValue'
- status=nf_get_att_double(KCDF_ID,IDVAR,"_FillValue",PMISSVALUE)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
- !write(0,*) 'missing value = ',PMISSVALUE
+ status=nf90_get_att(KCDF_ID,IDVAR,"_FillValue",PMISSVALUE)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
endif
endif
if (TRIM(hname(JLOOP))=='scale_factor') then
- !write(0,*) 'missing value found '
HACTION='get scale factor'
- status=nf_get_att_double(KCDF_ID,IDVAR,"scale_factor",ZSCFA)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
- !write(0,*) 'missing value = ',PMISSVALUE
+ status=nf90_get_att(KCDF_ID,IDVAR,"scale_factor",ZSCFA)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
endif
if (TRIM(hname(JLOOP))=='add_offset') then
- !write(0,*) 'missing value found '
HACTION='get offset'
- status=nf_get_att_double(KCDF_ID,IDVAR,"add_offset",ZOFFS)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
- !write(0,*) 'missing value = ',PMISSVALUE
+ status=nf90_get_att(KCDF_ID,IDVAR,"add_offset",ZOFFS)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
endif
ENDDO
!
!
DO JLOOP2=1,NDIMS
HACTION='get variable dimensions name'
- status=nf_inq_dimname(KCDF_ID,NVARDIMID(JLOOP2),NVARDIMNAM(JLOOP2))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_inquire_dimension(KCDF_ID,NVARDIMID(JLOOP2),NAME=NVARDIMNAM(JLOOP2))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(KCDF_ID,NVARDIMID(JLOOP2),NVARDIMLEN(JLOOP2))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
- !write(0,*) 'variable dimension ',JLOOP2,' named ',NVARDIMNAM(JLOOP2),&
- ! &'has a length of',NVARDIMLEN(JLOOP2)
+ status=nf90_inquire_dimension(KCDF_ID,NVARDIMID(JLOOP2),LEN=NVARDIMLEN(JLOOP2))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
ENDDO
!
IF (KVARTYPE>=5) then
ALLOCATE(ZVALU2D(1:NVARDIMLEN(1),1:NVARDIMLEN(2)))
ZVALU2D=0.
HACTION='get variable values (2D)'
- status=nf_get_var_double(KCDF_ID,IDVAR,ZVALU2D(:,:))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_get_var(KCDF_ID,IDVAR,ZVALU2D(:,:))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
ELSE
ALLOCATE(IVALU2D(1:NVARDIMLEN(1),1:NVARDIMLEN(2)))
IVALU2D=0.
HACTION='get variable values (2D)'
- status=nf_get_var_int(KCDF_ID,IDVAR,IVALU2D(:,:))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_get_var(KCDF_ID,IDVAR,IVALU2D(:,:))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
ENDIF
PVALU2D(:,:)=XUNDEF
DO J1=1,NVARDIMLEN(1)
@@ -256,6 +245,8 @@ END SUBROUTINE GET2DCDF
! ####################
USE MODD_SURF_PAR, ONLY : XUNDEF
!
+USE NETCDF
+!
IMPLICIT NONE
!
INTEGER,INTENT(IN) :: KCDF_ID !netcdf file identifiant
@@ -281,7 +272,6 @@ REAL,DIMENSION(:,:,:),ALLOCATABLE :: ZVALU3D !value array
INTEGER,DIMENSION(:,:,:),ALLOCATABLE :: IVALU3D
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:GET3DCDF',0,ZHOOK_HANDLE)
PMISSVALUE=-9999.9
@@ -293,82 +283,68 @@ NVARDIMLEN(:)=0
NVARDIMNAM(:)=' '
!
HACTION='get variable type'
-status=nf_inq_vartype(KCDF_ID,IDVAR,KVARTYPE)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
-!write(0,*) 'variable type = ',KVARTYPE
+status=nf90_inquire_variable(KCDF_ID,IDVAR,XTYPE=KVARTYPE)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!
HACTION='get variable dimensions identifiant'
-status=nf_inq_vardimid(KCDF_ID,IDVAR,NVARDIMID)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
-!write(0,*) 'variable dimension identifiant ',NVARDIMID
+status=nf90_inquire_variable(KCDF_ID,IDVAR,DIMIDS=NVARDIMID)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!
HACTION='get attributs'
-status=nf_inq_varnatts(KCDF_ID,IDVAR,NGATTS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
-!write(0,*) 'number of attributes = ',NGATTS
+status=nf90_inquire_variable(KCDF_ID,IDVAR,NATTS=NGATTS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
allocate(hname(1:NGATTS))
!
ZSCFA=1.
ZOFFS=0.
DO JLOOP=1,NGATTS
- status=nf_inq_attname(KCDF_ID,IDVAR,JLOOP,hname(JLOOP))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
- !write(0,*) 'attributes names = ', hname(JLOOP)
+ status=nf90_inq_attname(KCDF_ID,IDVAR,JLOOP,hname(JLOOP))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
if (TRIM(hname(JLOOP))=='missing_value') then
- !write(0,*) 'missing value found '
HACTION='get missing value'
- status=nf_get_att_double(KCDF_ID,IDVAR,"missing_value",PMISSVALUE)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
- !write(0,*) 'missing value = ',PMISSVALUE
+ status=nf90_get_att(KCDF_ID,IDVAR,"missing_value",PMISSVALUE)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
else
if (TRIM(hname(JLOOP))=='_FillValue') then
- !write(0,*) 'missing value found '
HACTION='get _FillValue'
- status=nf_get_att_double(KCDF_ID,IDVAR,"_FillValue",PMISSVALUE)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
- !write(0,*) 'missing value = ',PMISSVALUE
+ status=nf90_get_att(KCDF_ID,IDVAR,"_FillValue",PMISSVALUE)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
endif
endif
if (TRIM(hname(JLOOP))=='scale_factor') then
- !write(0,*) 'missing value found '
HACTION='get scale factor'
- status=nf_get_att_double(KCDF_ID,IDVAR,"scale_factor",ZSCFA)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
- !write(0,*) 'missing value = ',PMISSVALUE
+ status=nf90_get_att(KCDF_ID,IDVAR,"scale_factor",ZSCFA)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
endif
if (TRIM(hname(JLOOP))=='add_offset') then
- !write(0,*) 'missing value found '
HACTION='get offset'
- status=nf_get_att_double(KCDF_ID,IDVAR,"add_offset",ZOFFS)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
- !write(0,*) 'missing value = ',PMISSVALUE
+ status=nf90_get_att(KCDF_ID,IDVAR,"add_offset",ZOFFS)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
endif
ENDDO
!
!
DO JLOOP2=1,NDIMS
HACTION='get variable dimensions name'
- status=nf_inq_dimname(KCDF_ID,NVARDIMID(JLOOP2),NVARDIMNAM(JLOOP2))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_inquire_dimension(KCDF_ID,NVARDIMID(JLOOP2),NAME=NVARDIMNAM(JLOOP2))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(KCDF_ID,NVARDIMID(JLOOP2),NVARDIMLEN(JLOOP2))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
- !write(0,*) 'variable dimension ',JLOOP2,' named ',NVARDIMNAM(JLOOP2),&
- ! &'has a length of',NVARDIMLEN(JLOOP2)
+ status=nf90_inquire_dimension(KCDF_ID,NVARDIMID(JLOOP2),LEN=NVARDIMLEN(JLOOP2))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
ENDDO
!
IF (KVARTYPE>=5) then
ALLOCATE(ZVALU3D(1:NVARDIMLEN(1),1:NVARDIMLEN(2),1:NVARDIMLEN(3)))
ZVALU3D=0.
HACTION='get variable values (3D)'
- status=nf_get_var_double(KCDF_ID,IDVAR,ZVALU3D(:,:,:))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_get_var(KCDF_ID,IDVAR,ZVALU3D(:,:,:))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
ELSE
ALLOCATE(IVALU3D(1:NVARDIMLEN(1),1:NVARDIMLEN(2),1:NVARDIMLEN(3)))
IVALU3D=0.
HACTION='get variable values (3D)'
- status=nf_get_var_int(KCDF_ID,IDVAR,IVALU3D(:,:,:))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_get_var(KCDF_ID,IDVAR,IVALU3D(:,:,:))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
ENDIF
!
PVALU3D(:,:,:)=XUNDEF
@@ -402,6 +378,8 @@ END SUBROUTINE GET3DCDF
SUBROUTINE READ_DIM_CDF(HFILENAME,HNCVARNAME,KDIM)
! ####################
!
+USE NETCDF
+!
IMPLICIT NONE
!
CHARACTER(LEN=28), INTENT(IN) :: HFILENAME ! Name of the field file.
@@ -412,24 +390,22 @@ integer :: status
integer :: kcdf_id
integer :: NBVARS
character(len=80) :: HACTION
-character(len=80),DIMENSION(:),ALLOCATABLE :: VARNAME
+character(len=80),DIMENSION(:),ALLOCATABLE :: YVARNAME
integer ::JLOOP1,JLOOP
integer ::ID_VARTOGET,ID_VARTOGET1,ID_VARTOGET2
integer ::NVARDIMS
-integer,DIMENSION(2) ::NLEN2D
+INTEGER, DIMENSION(1) :: NDIMID
+integer,DIMENSION(2) ::NLEN2D, NDIMID2D
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
!* 1. Open the netcdf file
! --------------------
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:READ_DIM_CDF',0,ZHOOK_HANDLE)
HACTION='open netcdf'
-status=NF_OPEN(HFILENAME,nf_nowrite,kcdf_id)
-if (status/=NF_NOERR) then
+status=NF90_OPEN(HFILENAME,nf90_nowrite,kcdf_id)
+if (status/=NF90_NOERR) then
CALL HANDLE_ERR_MER(status,HACTION)
-!else
-! write(0,*) 'netcdf file opened: ',HFILENAME
endif
!
!-----------
@@ -437,10 +413,9 @@ endif
!* 2. get the number of variables in netcdf file
! ------------------------------------------
HACTION='get number of variables'
-status=NF_INQ_NVARS(kcdf_id,NBVARS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
-!write(0,*) 'nb vars', NBVARS
-ALLOCATE(VARNAME(NBVARS))
+status=NF90_INQUIRE(kcdf_id,NVARIABLES=NBVARS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ALLOCATE(YVARNAME(NBVARS))
!
!-----------
!
@@ -450,18 +425,14 @@ ID_VARTOGET1=0
ID_VARTOGET2=0
DO JLOOP1=1,NBVARS
HACTION='get variables names'
- status=NF_INQ_VARNAME(kcdf_id,JLOOP1,VARNAME(JLOOP1))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
- !write(0,*) 'var',JLOOP1,' name: ',VARNAME(JLOOP1)
- if (VARNAME(JLOOP1)==HNCVARNAME) then
- !write(0,*) 'var',JLOOP1,' corresponding to variable required'
+ status=NF90_INQUIRE_VARIABLE(kcdf_id,JLOOP1,NAME=YVARNAME(JLOOP1))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ if (YVARNAME(JLOOP1)==HNCVARNAME) then
ID_VARTOGET1=JLOOP1
endif
- if (VARNAME(JLOOP1)/=HNCVARNAME) then
- if((LGT(TRIM(VARNAME(JLOOP1)),TRIM(HNCVARNAME))).AND.&
- (SCAN(TRIM(VARNAME(JLOOP1)),TRIM(HNCVARNAME))==1)) then
- !write(0,*) 'var',JLOOP1,VARNAME(JLOOP1),' could correspond to variable required ?'
- !write(0,*) HNCVARNAME,' is variable required; only ',VARNAME(JLOOP1),' found'
+ if (YVARNAME(JLOOP1)/=HNCVARNAME) then
+ if((LGT(TRIM(YVARNAME(JLOOP1)),TRIM(HNCVARNAME))).AND.&
+ (SCAN(TRIM(YVARNAME(JLOOP1)),TRIM(HNCVARNAME))==1)) then
ID_VARTOGET2=JLOOP1
endif
endif
@@ -473,8 +444,8 @@ else
endif
if (ID_VARTOGET==0) then
HACTION='close netcdf'
- status=nf_close(kcdf_id)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_close(kcdf_id)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
CALL ABOR1_SFX('MODE_READ_NETCDF_MERCATOR: READ_DIM_CDF')
endif
!-----------
@@ -486,9 +457,8 @@ endif
! -----------------------------------
!
HACTION='get variable dimensions number'
-status=nf_inq_varndims(kcdf_id,ID_VARTOGET,NVARDIMS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
-!write(0,*) 'variable dimensions number = ',NVARDIMS
+status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,NDIMS=NVARDIMS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!
! 4.2 get the variable dimensions length
! ----------------------------------
@@ -496,16 +466,18 @@ SELECT CASE (NVARDIMS)
!CAS 1D
CASE (1)
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(kcdf_id,ID_VARTOGET,KDIM)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,DIMIDS=NDIMID)
+ status=nf90_inquire_dimension(kcdf_id,NDIMID(1),LEN=KDIM)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!
!CAS 2D
CASE (2)
KDIM=1
+ status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,DIMIDS=NDIMID2D)
DO JLOOP=1,NVARDIMS
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(kcdf_id,ID_VARTOGET,NLEN2D(JLOOP))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_inquire_dimension(kcdf_id,NDIMID2D(JLOOP),LEN=NLEN2D(JLOOP))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
KDIM=KDIM*NLEN2D(JLOOP)
ENDDO
END SELECT
@@ -513,14 +485,13 @@ END SELECT
!* 10. Close the netcdf file
! ---------------------
HACTION='close netcdf'
-status=nf_close(kcdf_id)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
-!write(0,*) 'OK: netcdf file closed: ',HFILENAME
+status=nf90_close(kcdf_id)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!
!-----------
!* 11. Deallocate
! ----------
-IF (ALLOCATED(VARNAME )) DEALLOCATE(VARNAME)
+IF (ALLOCATED(YVARNAME )) DEALLOCATE(YVARNAME)
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:READ_DIM_CDF',1,ZHOOK_HANDLE)
!
END SUBROUTINE READ_DIM_CDF
@@ -530,31 +501,46 @@ END SUBROUTINE READ_DIM_CDF
SUBROUTINE PREP_NETCDF_GRID(HFILENAME,HNCVARNAME)
! ####################
!
+USE MODD_SURFEX_MPI, ONLY : WLOG_MPI, NRANK, NPIO, NPROC, NCOMM
+USE MODD_HORIBL, ONLY : LGLOBLON, LGLOBS, LGLOBN, XILO1H, XILO2H, NINLOH, &
+ XLA, XOLA, XOLO, NP, XLOPH, NO
+USE MODD_PREP, ONLY : XLAT_OUT, XLON_OUT, LINTERP, XX_OUT, XY_OUT
+!
USE MODD_GRID_LATLONREGUL
USE MODD_SURF_PAR
!
+USE MODI_HORIBL_SURF_INIT
+USE MODI_HORIBL_SURF_COEF
+!
+USE NETCDF
+!
IMPLICIT NONE
+!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
!
CHARACTER(LEN=28), INTENT(IN) :: HFILENAME ! Name of the field file.
CHARACTER(LEN=28), INTENT(IN) :: HNCVARNAME ! Name of variable to read in netcdf file
!
integer :: status
integer :: kcdf_id
-integer :: NBVARS
+integer :: INBVARS
character(len=80) :: HACTION
-character(len=80),DIMENSION(:),ALLOCATABLE :: VARNAME
+character(len=80),DIMENSION(:),ALLOCATABLE :: YVARNAME
integer,DIMENSION(:),ALLOCATABLE :: NVARDIMID
integer ::JLOOP1,JLOOP
integer ::ID_VARTOGET,ID_VARTOGET1,ID_VARTOGET2
-integer ::NVARDIMS
-integer,DIMENSION(3) ::NDIMLEN
+integer ::INVARDIMS
+integer,DIMENSION(3) ::INDIMLEN
character(LEN=80),DIMENSION(3) :: NDIMNAM
integer :: IDIM
integer :: INLON
+INTEGER :: IINLA, INO
real :: ZZLAMISS,ZZLOMISS
+INTEGER :: INFOMPI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:PREP_NETCDF_GRID',0,ZHOOK_HANDLE)
NINLAT =-NUNDEF
@@ -567,119 +553,159 @@ XILAT2=XUNDEF
XILON2=XUNDEF
!* 1. Open the netcdf file
! --------------------
-HACTION='open netcdf'
-status=NF_OPEN(HFILENAME,nf_nowrite,kcdf_id)
-if (status/=NF_NOERR) then
- CALL HANDLE_ERR_MER(status,HACTION)
-!else
-! write(0,*) 'netcdf file opened: ',HFILENAME
-endif
-!
-!-----------
-!
-!* 2. get the number of variables in netcdf file
-! ------------------------------------------
-HACTION='get number of variables'
-status=NF_INQ_NVARS(kcdf_id,NBVARS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
-!write(0,*) 'nb vars', NBVARS
-ALLOCATE(VARNAME(NBVARS))
-!
-!-----------
-!
-!* 3. get the variables names in netcdf file
-! --------------------------------------
-ID_VARTOGET1=0
-ID_VARTOGET2=0
-DO JLOOP1=1,NBVARS
- HACTION='get variables names'
- status=NF_INQ_VARNAME(kcdf_id,JLOOP1,VARNAME(JLOOP1))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
- if (VARNAME(JLOOP1)==HNCVARNAME) then
- ID_VARTOGET1=JLOOP1
+IF (NRANK==NPIO) THEN
+
+ HACTION='open netcdf'
+ status=NF90_OPEN(HFILENAME,nf90_nowrite,kcdf_id)
+ !write(0,*) 'identifiant de ',HFILENAME,'=',kcdf_id
+ if (status/=NF90_NOERR) then
+ CALL HANDLE_ERR_MER(status,HACTION)
+ !else
+ ! write(0,*) 'netcdf file opened: ',HFILENAME
endif
- if (VARNAME(JLOOP1)/=HNCVARNAME) then
- if((LGT(TRIM(VARNAME(JLOOP1)),TRIM(HNCVARNAME))).AND.&
- (SCAN(TRIM(VARNAME(JLOOP1)),TRIM(HNCVARNAME))==1)) then
- !write(0,*) 'var',JLOOP1,VARNAME(JLOOP1),' could correspond to variable required ?'
- !write(0,*) HNCVARNAME,' is variable required; only ',VARNAME(JLOOP1),' found'
- ID_VARTOGET2=JLOOP1
+ !
+ !-----------
+ !
+ !* 2. get the number of variables in netcdf file
+ ! ------------------------------------------
+ HACTION='get number of variables'
+ status=NF90_INQUIRE(kcdf_id,NVARIABLES=INBVARS)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ !write(0,*) 'nb vars', INBVARS
+ ALLOCATE(YVARNAME(INBVARS))
+ !
+ !-----------
+ !
+ !* 3. get the variables names in netcdf file
+ ! --------------------------------------
+ ID_VARTOGET1=0
+ ID_VARTOGET2=0
+ DO JLOOP1=1,INBVARS
+ HACTION='get variables names'
+ status=NF90_INQUIRE_VARIABLE(kcdf_id,JLOOP1,NAME=YVARNAME(JLOOP1))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ !write(0,*) 'var',JLOOP1,' name: ',YVARNAME(JLOOP1)
+ if (YVARNAME(JLOOP1)==HNCVARNAME) then
+ !write(0,*) 'var',JLOOP1,' corresponding to variable required'
+ ID_VARTOGET1=JLOOP1
+ endif
+ if (YVARNAME(JLOOP1)/=HNCVARNAME) then
+ if((LGT(TRIM(YVARNAME(JLOOP1)),TRIM(HNCVARNAME))).AND.&
+ (SCAN(TRIM(YVARNAME(JLOOP1)),TRIM(HNCVARNAME))==1)) then
+ !write(0,*) 'var',JLOOP1,YVARNAME(JLOOP1),' could correspond to variable required ?'
+ !write(0,*) HNCVARNAME,' is variable required; only ',YVARNAME(JLOOP1),' found'
+ ID_VARTOGET2=JLOOP1
+ endif
endif
+ ENDDO
+ DEALLOCATE(YVARNAME)
+ if (ID_VARTOGET1/=0) then
+ ID_VARTOGET=ID_VARTOGET1
+ else
+ ID_VARTOGET=ID_VARTOGET2
endif
-ENDDO
-if (ID_VARTOGET1/=0) then
- ID_VARTOGET=ID_VARTOGET1
-else
- ID_VARTOGET=ID_VARTOGET2
-endif
+ !
+ if (ID_VARTOGET==0) then
+ HACTION='close netcdf'
+ status=nf90_close(kcdf_id)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ endif
+ !
+ENDIF
+!
+IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(ID_VARTOGET,KIND(ID_VARTOGET)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ENDIF
+!
if (ID_VARTOGET==0) then
- HACTION='close netcdf'
- status=nf_close(kcdf_id)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:PREP_NETCDF_GRID',1,ZHOOK_HANDLE)
RETURN
endif
-NILENGTH=0
-!-----------
-!
-!* 4. get the total dimension of HNCVARNAME
-! -------------------------------------
-!
-! 4.1 get the variable dimensions number
-! -----------------------------------
-!
-HACTION='get variable dimensions number'
-status=nf_inq_varndims(kcdf_id,ID_VARTOGET,NVARDIMS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
-!write(0,*) 'variable dimensions number = ',NVARDIMS
-ALLOCATE(NVARDIMID(NVARDIMS))
-HACTION='get variable dimensions identifiant'
-status=nf_inq_vardimid(kcdf_id,ID_VARTOGET,NVARDIMID)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!
-! 4.2 get the variable dimensions length
-! ----------------------------------
-SELECT CASE (NVARDIMS)
-!CAS 1D
- CASE (1)
- HACTION='get variable dimensions length'
- status=nf_inq_dimlen(kcdf_id,ID_VARTOGET,IDIM)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+NILENGTH=0
!
-!CAS 2D,3D
- CASE (2,3)
- DO JLOOP=1,NVARDIMS
+IF (NRANK==NPIO) THEN
+ !
+ !-----------
+ !
+ !* 4. get the total dimension of HNCVARNAME
+ ! -------------------------------------
+ !
+ ! 4.1 get the variable dimensions number
+ ! -----------------------------------
+ !
+ HACTION='get variable dimensions number'
+ status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,NDIMS=INVARDIMS)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ !write(0,*) 'variable dimensions number = ',INVARDIMS
+ ALLOCATE(NVARDIMID(INVARDIMS))
+ HACTION='get variable dimensions identifiant'
+ status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,DIMIDS=NVARDIMID)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ !
+ ! 4.2 get the variable dimensions length
+ ! ----------------------------------
+ SELECT CASE (INVARDIMS)
+ !CAS 1D
+ CASE (1)
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(kcdf_id,NVARDIMID(JLOOP),NDIMLEN(JLOOP))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
- HACTION='get variable dimensions names'
- status=nf_inq_dimname(kcdf_id,NVARDIMID(JLOOP),NDIMNAM(JLOOP))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
- if ((NDIMNAM(JLOOP)=='lat').OR.(NDIMNAM(JLOOP)=='latitude')) then
- NINLAT=NDIMLEN(JLOOP)
- if (.not.allocated(XILATARRAY)) allocate(XILATARRAY(NDIMLEN(JLOOP)))
- if (.not.allocated(NINLON)) allocate(NINLON(NINLAT))
- CALL GET1DCDF(kcdf_id,NVARDIMID(JLOOP),ZZLAMISS,XILATARRAY(:))
- endif
- if ((NDIMNAM(JLOOP)=='lon').OR.(NDIMNAM(JLOOP)=='longitude')) then
- INLON=NDIMLEN(JLOOP)
- if (.not.allocated(XILONARRAY)) allocate(XILONARRAY(NDIMLEN(JLOOP)))
- CALL GET1DCDF(kcdf_id,NVARDIMID(JLOOP),ZZLOMISS,XILONARRAY(:))
- endif
- if (NDIMNAM(JLOOP)=='depth') NINDEPTH=NDIMLEN(JLOOP)
- ENDDO
- NINLON(:)=INLON
-END SELECT
-!-----------
-!* 10. Close the netcdf file
-! ---------------------
-HACTION='close netcdf'
-status=nf_close(kcdf_id)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
-!write(0,*) 'OK: netcdf file closed: ',HFILENAME
+ status=nf90_inquire_dimension(kcdf_id,NVARDIMID(1),LEN=IDIM)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ !
+ !CAS 2D,3D
+ CASE (2,3)
+ DO JLOOP=1,INVARDIMS
+ HACTION='get variable dimensions length'
+ status=nf90_inquire_dimension(kcdf_id,NVARDIMID(JLOOP),LEN=INDIMLEN(JLOOP))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ HACTION='get variable dimensions names'
+ status=nf90_inquire_dimension(kcdf_id,NVARDIMID(JLOOP),NAME=NDIMNAM(JLOOP))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ if ((NDIMNAM(JLOOP)=='lat').OR.(NDIMNAM(JLOOP)=='latitude')) then
+ NINLAT=INDIMLEN(JLOOP)
+ if (.not.allocated(XILATARRAY)) allocate(XILATARRAY(INDIMLEN(JLOOP)))
+ if (.not.allocated(NINLON)) allocate(NINLON(NINLAT))
+ CALL GET1DCDF(kcdf_id,NVARDIMID(JLOOP),ZZLAMISS,XILATARRAY(:))
+ endif
+ if ((NDIMNAM(JLOOP)=='lon').OR.(NDIMNAM(JLOOP)=='longitude')) then
+ INLON=INDIMLEN(JLOOP)
+ if (.not.allocated(XILONARRAY)) allocate(XILONARRAY(INDIMLEN(JLOOP)))
+ CALL GET1DCDF(kcdf_id,NVARDIMID(JLOOP),ZZLOMISS,XILONARRAY(:))
+ endif
+ if (NDIMNAM(JLOOP)=='depth') NINDEPTH=INDIMLEN(JLOOP)
+ ENDDO
+ NINLON(:)=INLON
+ END SELECT
+ !-----------
+ !* 10. Close the netcdf file
+ ! ---------------------
+ HACTION='close netcdf'
+ status=nf90_close(kcdf_id)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ !write(0,*) 'OK: netcdf file closed: ',HFILENAME
+ !
+ENDIF
+!
+IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(NINLAT,KIND(NINLAT)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(INLON,KIND(INLON)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ IF (NRANK/=NPIO) THEN
+ ALLOCATE(NINLON(NINLAT))
+ ALLOCATE(XILATARRAY(NINLAT))
+ ALLOCATE(XILONARRAY(INLON))
+ ENDIF
+ CALL MPI_BCAST(NINLON,SIZE(NINLON)*KIND(NINLON)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XILATARRAY,SIZE(XILATARRAY)*KIND(XILATARRAY)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XILONARRAY,SIZE(XILONARRAY)*KIND(XILONARRAY)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+#endif
+ENDIF
!
!-----------
!GRID PARAM FOR HORIBL_SURF
+NILENGTH=0
DO JLOOP1=1,NINLAT
NILENGTH = NILENGTH + NINLON(JLOOP1)
ENDDO
@@ -690,7 +716,40 @@ XILON2=XILONARRAY(SIZE(XILONARRAY))
!
!* 11. Deallocate
! ----------
-IF (ALLOCATED(VARNAME )) DEALLOCATE(VARNAME)
+!
+IF (ALLOCATED(XLAT_OUT)) THEN
+ !
+ INO = SIZE(XLAT_OUT)
+ !
+ IF (ALLOCATED(NO)) DEALLOCATE(NO)
+ IF (ALLOCATED(XLA)) DEALLOCATE(XLA)
+ IF (ALLOCATED(XOLA)) DEALLOCATE(XOLA)
+ IF (ALLOCATED(XOLO)) DEALLOCATE(XOLO)
+ IF (ALLOCATED(NINLOH)) DEALLOCATE(NINLOH)
+
+ ALLOCATE(NO(INO,4))
+ ALLOCATE(XOLA(INO),XOLO(INO))
+ ALLOCATE(XLA(INO,4))
+ !
+ IINLA = NINLAT
+ ALLOCATE(NINLOH(IINLA+4))
+ CALL HORIBL_SURF_INIT(XILAT1,XILON1,XILAT2,XILON2,NINLAT,NINLON, &
+ INO,XLON_OUT,XLAT_OUT,LINTERP,LGLOBLON,&
+ LGLOBN,LGLOBS,NO,NINLOH,XOLA,XOLO,XILO1H,&
+ XILO2H,XLA,XILATARRAY)
+ !
+ IF (ALLOCATED(NP)) DEALLOCATE(NP)
+ IF (ALLOCATED(XLOPH)) DEALLOCATE(XLOPH)
+ ALLOCATE(NP(INO,12))
+ ALLOCATE(XLOPH(INO,12))
+
+ IF (LGLOBS) IINLA = IINLA + 2
+ IF (LGLOBN) IINLA = IINLA + 2
+ CALL HORIBL_SURF_COEF(INO,LINTERP,LGLOBLON,XILO1H,XILO2H,XOLO,&
+ NO,NINLOH(1:IINLA),NP,XLOPH)
+ !
+ENDIF
+!
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:PREP_NETCDF_GRID',1,ZHOOK_HANDLE)
!
END SUBROUTINE PREP_NETCDF_GRID
@@ -700,6 +759,8 @@ END SUBROUTINE PREP_NETCDF_GRID
SUBROUTINE READ_Z1D_CDF(HFILENAME,HNCVARNAME,PVAL)
! ####################
!
+USE NETCDF
+!
IMPLICIT NONE
!
CHARACTER(LEN=28), INTENT(IN) :: HFILENAME ! Name of the field file.
@@ -714,12 +775,12 @@ character(len=80),DIMENSION(:),ALLOCATABLE :: VARNAME
integer ::JLOOP1
integer ::ID_VARTOGET,ID_VARTOGET1,ID_VARTOGET2
integer ::NVARDIMS
+INTEGER, DIMENSION(1) :: NDIMID
integer ::NLEN
real,DIMENSION(:),ALLOCATABLE :: ZVALU
real :: ZMISS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
!* 1. Open the netcdf file
! --------------------
@@ -727,16 +788,16 @@ IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:READ_Z1D_CDF',0,ZHOOK_HANDLE)
status=-9999
kcdf_id=-9999
HACTION='open netcdf'
-status=NF_OPEN(HFILENAME,nf_nowrite,kcdf_id)
-if (status/=NF_NOERR) then
+status=NF90_OPEN(HFILENAME,nf90_nowrite,kcdf_id)
+if (status/=NF90_NOERR) then
CALL HANDLE_ERR_MER(status,HACTION)
endif
!-----------
!* 2. get the number of variables in netcdf file
! ------------------------------------------
HACTION='get number of variables'
-status=NF_INQ_NVARS(kcdf_id,NBVARS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=NF90_INQUIRE(kcdf_id,NVARIABLES=NBVARS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'nb vars', NBVARS
ALLOCATE(VARNAME(NBVARS))
!-----------
@@ -746,8 +807,8 @@ ID_VARTOGET1=0
ID_VARTOGET2=0
DO JLOOP1=1,NBVARS
HACTION='get variables names'
- status=NF_INQ_VARNAME(kcdf_id,JLOOP1,VARNAME(JLOOP1))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=NF90_INQUIRE_VARIABLE(kcdf_id,JLOOP1,NAME=VARNAME(JLOOP1))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
if (VARNAME(JLOOP1)==HNCVARNAME) then
ID_VARTOGET1=JLOOP1
endif
@@ -765,8 +826,8 @@ else
endif
if (ID_VARTOGET==0) then
HACTION='close netcdf'
- status=nf_close(kcdf_id)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_close(kcdf_id)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
CALL ABOR1_SFX('MODE_READ_NETCDF_MERCATOR: READ_Z1D_CDF')
endif
!-----------
@@ -775,8 +836,8 @@ endif
! 4.1 get the variable dimensions number
! -----------------------------------
HACTION='get variable dimensions number'
-status=nf_inq_varndims(kcdf_id,ID_VARTOGET,NVARDIMS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,NDIMS=NVARDIMS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!
! 4.2 get the variable dimensions length and values
! ----------------------------------------------
@@ -784,8 +845,9 @@ SELECT CASE (NVARDIMS)
!CAS 1D
CASE (1)
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(kcdf_id,ID_VARTOGET,NLEN)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,DIMIDS=NDIMID)
+ status=nf90_inquire_dimension(kcdf_id,NDIMID(1),LEN=NLEN)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
ALLOCATE(ZVALU(NLEN))
!write(0,*) 'call GET1DCDF'
CALL GET1DCDF(kcdf_id,ID_VARTOGET,ZMISS,ZVALU)
@@ -799,8 +861,8 @@ END SELECT
!* 5. Close the netcdf file
! ---------------------
HACTION='close netcdf'
-status=nf_close(kcdf_id)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_close(kcdf_id)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!-----------
!* 6. Deallocate
! ----------
@@ -815,6 +877,8 @@ END SUBROUTINE READ_Z1D_CDF
SUBROUTINE READ_LATLONVAL_CDF(HFILENAME,HNCVARNAME,PLON,PLAT,PVAL)
! ####################
!
+USE NETCDF
+!
IMPLICIT NONE
!
CHARACTER(LEN=28), INTENT(IN) :: HFILENAME ! Name of the field file.
@@ -831,7 +895,8 @@ integer ::JLOOP1,JDIM1,JDIM2,JLOOP
integer ::ID_VARTOGET,ID_VARTOGET1,ID_VARTOGET2
integer ::NVARDIMS
integer ::NLEN
-integer,DIMENSION(2) ::NLEN2D
+integer, dimension(1) :: NDIMID
+integer,DIMENSION(2) ::NLEN2D, NDIMID2D
integer,DIMENSION(:),ALLOCATABLE :: NVARDIMID,NVARDIMLEN
character(len=80),DIMENSION(:),ALLOCATABLE :: NVARDIMNAM
real,DIMENSION(:),ALLOCATABLE :: ZVALU
@@ -843,7 +908,6 @@ character(len=80) :: YDIM1NAME,YDIM2NAME
integer :: ILONFOUND,ILATFOUND, IARG
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
!
!
@@ -853,8 +917,10 @@ IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:READ_LATLONVAL_CDF',0,ZHOOK_H
status=-9999
kcdf_id=-9999
HACTION='open netcdf'
-status=NF_OPEN(HFILENAME,nf_nowrite,kcdf_id)
-if (status/=NF_NOERR) then
+status=NF90_OPEN(HFILENAME,nf90_nowrite,kcdf_id)
+!write(0,*) 'status=',status
+!write(0,*) 'identifiant de ',HFILENAME,'=',kcdf_id
+if (status/=NF90_NOERR) then
CALL HANDLE_ERR_MER(status,HACTION)
!else
! write(0,*) 'netcdf file opened: ',HFILENAME
@@ -865,8 +931,8 @@ endif
!* 2. get the number of variables in netcdf file
! ------------------------------------------
HACTION='get number of variables'
-status=NF_INQ_NVARS(kcdf_id,NBVARS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=NF90_INQUIRE(kcdf_id,NVARIABLES=NBVARS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'nb vars', NBVARS
ALLOCATE(VARNAME(NBVARS))
!
@@ -878,10 +944,11 @@ ID_VARTOGET1=0
ID_VARTOGET2=0
DO JLOOP1=1,NBVARS
HACTION='get variables names'
- status=NF_INQ_VARNAME(kcdf_id,JLOOP1,VARNAME(JLOOP1))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=NF90_INQUIRE_VARIABLE(kcdf_id,JLOOP1,NAME=VARNAME(JLOOP1))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'var',JLOOP1,' name: ',VARNAME(JLOOP1)
if (VARNAME(JLOOP1)==HNCVARNAME) then
+ !write(0,*) 'var',JLOOP1,' corresponding to variable required'
ID_VARTOGET1=JLOOP1
endif
if (VARNAME(JLOOP1)/=HNCVARNAME) then
@@ -900,8 +967,8 @@ else
endif
if (ID_VARTOGET==0) then
HACTION='close netcdf'
- status=nf_close(kcdf_id)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_close(kcdf_id)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
CALL ABOR1_SFX('MODE_READ_NETCDF_MERCATOR: READ_LATLONVAL_CDF')
endif
!-----------
@@ -913,8 +980,8 @@ endif
! -----------------------------------
!
HACTION='get variable dimensions number'
-status=nf_inq_varndims(kcdf_id,ID_VARTOGET,NVARDIMS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,NDIMS=NVARDIMS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'variable dimensions number = ',NVARDIMS
!
! 4.2 get the variable dimensions length and values
@@ -923,21 +990,25 @@ SELECT CASE (NVARDIMS)
!CAS 1D
CASE (1)
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(kcdf_id,ID_VARTOGET,NLEN)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,DIMIDS=NDIMID)
+ status=nf90_inquire_dimension(kcdf_id,NDIMID(1),LEN=NLEN)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
ALLOCATE(ZVALU(NLEN))
+ !write(0,*) 'call GET1DCDF'
CALL GET1DCDF(kcdf_id,ID_VARTOGET,ZMISS,ZVALU)
PVAL(:)=ZVALU(:)
!CAS 2D
CASE (2)
+ status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,DIMIDS=NDIMID2D)
DO JLOOP=1,NVARDIMS
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(kcdf_id,ID_VARTOGET,NLEN2D(JLOOP))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_inquire_dimension(kcdf_id,NDIMID2D(JLOOP),LEN=NLEN2D(JLOOP))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
ENDDO
ALLOCATE(ZVALU2D(NLEN2D(1),NLEN2D(2)))
ALLOCATE(ZDIM1(NLEN2D(1)))
ALLOCATE(ZDIM2(NLEN2D(2)))
+ !write(0,*) 'call GET2DCDF'
CALL GET2DCDF(kcdf_id,ID_VARTOGET,ZDIM1,YDIM1NAME,ZDIM2,YDIM2NAME,&
ZMISS,ZVALU2D)
!write(0,*) 'YDIM1NAME: ',YDIM1NAME
@@ -981,8 +1052,8 @@ END SELECT
!* 10. Close the netcdf file
! ---------------------
HACTION='close netcdf'
-status=nf_close(kcdf_id)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_close(kcdf_id)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'OK: netcdf file closed: ',HFILENAME
!
!-----------
@@ -1006,6 +1077,8 @@ END SUBROUTINE READ_LATLONVAL_CDF
SUBROUTINE READ_LATLONDEPVAL_CDF(HFILENAME,HNCVARNAME,PLON,PLAT,PDEP,PVAL)
! ####################
!
+USE NETCDF
+!
IMPLICIT NONE
!
CHARACTER(LEN=28), INTENT(IN) :: HFILENAME ! Name of the field file.
@@ -1036,7 +1109,6 @@ integer :: ILONFOUND,ILATFOUND,IDEPFOUND
integer :: IARG
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
!
!
@@ -1044,8 +1116,8 @@ include 'netcdf.inc'
! --------------------
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:READ_LATLONDEPVAL_CDF',0,ZHOOK_HANDLE)
HACTION='open netcdf'
-status=NF_OPEN(HFILENAME,nf_nowrite,kcdf_id)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=NF90_OPEN(HFILENAME,nf90_nowrite,kcdf_id)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'netcdf file opened: ',HFILENAME
!
!-----------
@@ -1053,8 +1125,8 @@ if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!* 2. get the number of variables in netcdf file
! ------------------------------------------
HACTION='get number of variables'
-status=NF_INQ_NVARS(kcdf_id,NBVARS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=NF90_INQUIRE(kcdf_id,NVARIABLES=NBVARS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'nb vars', NBVARS
ALLOCATE(VARNAME(NBVARS))
!
@@ -1066,8 +1138,8 @@ ID_VARTOGET1=0
ID_VARTOGET2=0
DO JLOOP1=1,NBVARS
HACTION='get variables names'
- status=NF_INQ_VARNAME(kcdf_id,JLOOP1,VARNAME(JLOOP1))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=NF90_INQUIRE_VARIABLE(kcdf_id,JLOOP1,NAME=VARNAME(JLOOP1))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'var',JLOOP1,' name: ',VARNAME(JLOOP1)
if (VARNAME(JLOOP1)==HNCVARNAME) then
!write(0,*) 'var',JLOOP1,' corresponding to variable required'
@@ -1089,8 +1161,8 @@ else
endif
if (ID_VARTOGET==0) then
HACTION='close netcdf'
- status=nf_close(kcdf_id)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_close(kcdf_id)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
CALL ABOR1_SFX('MODE_READ_NETCDF_MERCATOR: READ_LATLONDEPVAL_CDF')
endif
!-----------
@@ -1102,13 +1174,13 @@ endif
! -----------------------------------
!
HACTION='get variable dimensions number'
-status=nf_inq_varndims(kcdf_id,ID_VARTOGET,NVARDIMS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,NDIMS=NVARDIMS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'variable dimensions number = ',NVARDIMS
ALLOCATE(NVARDIMID(NVARDIMS))
HACTION='get variable dimensions identifiant'
-status=nf_inq_vardimid(kcdf_id,ID_VARTOGET,NVARDIMID)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,DIMIDS=NVARDIMID)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!
!
! 4.2 get the variable dimensions length and values
@@ -1124,8 +1196,8 @@ SELECT CASE (NVARDIMS)
CASE (3)
DO JLOOP=1,NVARDIMS
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(kcdf_id,NVARDIMID(JLOOP),NLEN3D(JLOOP))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_inquire_dimension(kcdf_id,NVARDIMID(JLOOP),LEN=NLEN3D(JLOOP))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
ENDDO
ALLOCATE(ZVALU3D(NLEN3D(1),NLEN3D(2),NLEN3D(3)))
ALLOCATE(ZDIM1(NLEN3D(1)))
@@ -1243,8 +1315,8 @@ END SELECT
! ---------------------
HACTION='close netcdf'
!write(0,*) HACTION
-status=nf_close(kcdf_id)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_close(kcdf_id)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'OK: netcdf file closed: ',HFILENAME
!
!-----------
@@ -1274,6 +1346,8 @@ USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_CSTS, ONLY : XTT
USE MODD_PREP, ONLY : CINTERP_TYPE
!
+USE NETCDF
+!
IMPLICIT NONE
!
CHARACTER(LEN=28), INTENT(IN) :: HFILENAME ! Name of the field file.
@@ -1291,7 +1365,6 @@ REAL :: ZUNDEF=999.
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
-include 'netcdf.inc'
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:READ_NETCDF_SST',0,ZHOOK_HANDLE)
IF (NILENGTH<0) then
@@ -1350,6 +1423,8 @@ END SUBROUTINE READ_NETCDF_SST
USE MODD_GRID_LATLONREGUL, ONLY : NINLAT,NINLON,NINDEPTH,NILENGTH
USE MODD_PREP, ONLY : CINTERP_TYPE
!
+USE NETCDF
+!
IMPLICIT NONE
!
CHARACTER(LEN=28), INTENT(IN) :: HFILENAME ! Name of the field file.
@@ -1363,7 +1438,6 @@ integer :: jloop
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
-include 'netcdf.inc'
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:READ_NETCDF_ZS_SEA',0,ZHOOK_HANDLE)
if(NINDEPTH>0) then
@@ -1449,7 +1523,6 @@ IF (ALLOCATED(ZLATI )) DEALLOCATE(ZLATI )
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:READ_NETCDF_WAVE',1,ZHOOK_HANDLE)
!
END SUBROUTINE READ_NETCDF_WAVE
-!
!------------------------------------------------------------------------------
!==============================================================================
END MODULE MODE_READ_NETCDF_MERCATOR
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/modn_prep_seaflux.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/modn_prep_seaflux.F90
index 558eb3b5e24ddb903c3baa3e8a0321ad77ada205..7aaec327cf6b86f2c02c9b8e1fd4a1a166c4e7a0 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/modn_prep_seaflux.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/modn_prep_seaflux.F90
@@ -39,8 +39,7 @@
! ------------
!
USE MODD_PREP_SEAFLUX, ONLY : CFILE_SEAFLX, CTYPE_SEAFLX, CFILEPGD_SEAFLX, CTYPEPGD, &
- XSST_UNIF, XSSS_UNIF, XSIC_UNIF, &
- CFILEWAVE_SEAFLX, CTYPEWAVE
+ XSST_UNIF, XSSS_UNIF, XSIC_UNIF, CFILEWAVE_SEAFLX, CTYPEWAVE
!
IMPLICIT NONE
!
@@ -63,7 +62,7 @@ REAL :: XCORFLX ! correction coefficient ( W.m-2.K-1)
LOGICAL :: LDIAPYC ! If T, fluxes correction is made
!
NAMELIST/NAM_PREP_SEAFLUX/CFILE_SEAFLX, CTYPE_SEAFLX, CFILEPGD_SEAFLX, CTYPEPGD, XSST_UNIF, &
- CFILEWAVE_SEAFLX, CTYPEWAVE, &
+ CFILEWAVE_SEAFLX, CTYPEWAVE, &
XSSS_UNIF, XSIC_UNIF, NYEAR, NMONTH, NDAY, XTIME, LSEA_SBL, &
CSEAICE_SCHEME, LOCEAN_MERCATOR, LOCEAN_CURRENT, &
XTIME_REL,LCUR_REL,LTS_REL, &
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/modn_seafluxn.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/modn_seafluxn.F90
index a51c4509422b7af11f6afe026c7cca8b9f754cde..cd647ff24fa6e8ebbe9ff8ef328c063e21d43049 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/modn_seafluxn.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/modn_seafluxn.F90
@@ -64,19 +64,19 @@ LOGICAL :: LPRECIP
LOGICAL :: LPWEBB
LOGICAL :: LDIAG_OCEAN
LOGICAL :: LWAVEWIND
-LOGICAL :: LDIAG_SEAICE
+LOGICAL :: LDIAG_MISC_SEAICE
INTEGER :: NZ0
INTEGER :: NGRVWAVES
REAL :: XICHCE
- CHARACTER(LEN=6) :: CCH_DRY_DEP
+CHARACTER(LEN=6) :: CCH_DRY_DEP
LOGICAL :: LPROGSST
LOGICAL :: LPERTFLUX ! True = stochastic flux perturbation (default:False)
INTEGER :: NTIME_COUPLING
REAL :: XOCEAN_TSTEP
- CHARACTER(LEN=6) :: CINTERPOL_SST
- CHARACTER(LEN=6) :: CINTERPOL_SSS
- CHARACTER(LEN=6) :: CINTERPOL_SIC
- CHARACTER(LEN=6) :: CINTERPOL_SIT
+CHARACTER(LEN=6) :: CINTERPOL_SST
+CHARACTER(LEN=6) :: CINTERPOL_SSS
+CHARACTER(LEN=6) :: CINTERPOL_SIC
+CHARACTER(LEN=6) :: CINTERPOL_SIT
REAL :: XFREEZING_SST
REAL :: XSIC_EFOLDING_TIME
REAL :: XSIT_EFOLDING_TIME
@@ -86,13 +86,12 @@ REAL :: XSI_FLX_DRV
!
NAMELIST/NAM_SEAFLUXn/CSEA_FLUX,CSEA_ALB, LPWG, LPRECIP, LPWEBB, NGRVWAVES, &
NZ0, LPROGSST, NTIME_COUPLING, XOCEAN_TSTEP, XICHCE, &
- CINTERPOL_SST, CINTERPOL_SSS, LPERTFLUX, &
- LWAVEWIND
+ CINTERPOL_SST, CINTERPOL_SSS, LPERTFLUX, LWAVEWIND
NAMELIST/NAM_DIAG_SURFn/N2M,L2M_MIN_ZS,LSURF_BUDGET,LRAD_BUDGET, &
LSURF_BUDGETC,LRESET_BUDGETC,LCOEF,LSURF_VARS
NAMELIST/NAM_CH_SEAFLUXn/CCH_DRY_DEP
NAMELIST/NAM_DIAG_OCEANn/LDIAG_OCEAN
-NAMELIST/NAM_SEAICEn/LDIAG_SEAICE, CINTERPOL_SIC, CINTERPOL_SIT, &
+NAMELIST/NAM_SEAICEn/LDIAG_MISC_SEAICE, CINTERPOL_SIC, CINTERPOL_SIT, &
XFREEZING_SST, XSIC_EFOLDING_TIME, XSIT_EFOLDING_TIME,&
XSEAICE_TSTEP, XCD_ICE_CST, XSI_FLX_DRV
!
@@ -155,7 +154,7 @@ SUBROUTINE UPDATE_NAM_SEAFLUXn (O, S)
S%LPWEBB = LPWEBB
S%NZ0 = NZ0
S%NGRVWAVES = NGRVWAVES
- S%LWAVEWIND = LWAVEWIND
+ S%LWAVEWIND = LWAVEWIND
O%LPROGSST = LPROGSST
O%NTIME_COUPLING = NTIME_COUPLING
O%XOCEAN_TSTEP = XOCEAN_TSTEP
@@ -164,49 +163,49 @@ SUBROUTINE UPDATE_NAM_SEAFLUXn (O, S)
IF (LHOOK) CALL DR_HOOK('MODN_SEAFLUX_N:UPDATE_NAM_SEAFLUXN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_SEAFLUXn
!
-SUBROUTINE INIT_NAM_DIAG_SURFn (DGS)
+SUBROUTINE INIT_NAM_DIAG_SURFn (DGO)
!
- USE MODD_DIAG_SEAFLUX_n, ONLY : DIAG_SEAFLUX_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(DIAG_SEAFLUX_t), INTENT(INOUT) :: DGS
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_SEAFLUX_N:INIT_NAM_DIAG_SURFN',0,ZHOOK_HANDLE)
- XDIAG_TSTEP = DGS%XDIAG_TSTEP
- N2M = DGS%N2M
- L2M_MIN_ZS = DGS%L2M_MIN_ZS
- LSURF_BUDGET = DGS%LSURF_BUDGET
- LRAD_BUDGET = DGS%LRAD_BUDGET
- LSURF_BUDGETC = DGS%LSURF_BUDGETC
- LRESET_BUDGETC = DGS%LRESET_BUDGETC
- LCOEF = DGS%LCOEF
- LSURF_VARS = DGS%LSURF_VARS
+ XDIAG_TSTEP = DGO%XDIAG_TSTEP
+ N2M = DGO%N2M
+ L2M_MIN_ZS = DGO%L2M_MIN_ZS
+ LSURF_BUDGET = DGO%LSURF_BUDGET
+ LRAD_BUDGET = DGO%LRAD_BUDGET
+ LSURF_BUDGETC = DGO%LSURF_BUDGETC
+ LRESET_BUDGETC = DGO%LRESET_BUDGETC
+ LCOEF = DGO%LCOEF
+ LSURF_VARS = DGO%LSURF_VARS
IF (LHOOK) CALL DR_HOOK('MODN_SEAFLUX_N:INIT_NAM_DIAG_SURFN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_DIAG_SURFn
-SUBROUTINE UPDATE_NAM_DIAG_SURFn (DGS)
+SUBROUTINE UPDATE_NAM_DIAG_SURFn (DGO)
!
- USE MODD_DIAG_SEAFLUX_n, ONLY : DIAG_SEAFLUX_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(DIAG_SEAFLUX_t), INTENT(INOUT) :: DGS
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_SEAFLUX_N:UPDATE_NAM_DIAG_SURFN',0,ZHOOK_HANDLE)
- DGS%XDIAG_TSTEP = XDIAG_TSTEP
- DGS%N2M = N2M
- DGS%L2M_MIN_ZS = L2M_MIN_ZS
- DGS%LSURF_BUDGET = LSURF_BUDGET
- DGS%LRAD_BUDGET = LRAD_BUDGET
- DGS%LSURF_BUDGETC = LSURF_BUDGETC
- DGS%LRESET_BUDGETC = LRESET_BUDGETC
- DGS%LCOEF = LCOEF
- DGS%LSURF_VARS = LSURF_VARS
+ DGO%XDIAG_TSTEP = XDIAG_TSTEP
+ DGO%N2M = N2M
+ DGO%L2M_MIN_ZS = L2M_MIN_ZS
+ DGO%LSURF_BUDGET = LSURF_BUDGET
+ DGO%LRAD_BUDGET = LRAD_BUDGET
+ DGO%LSURF_BUDGETC = LSURF_BUDGETC
+ DGO%LRESET_BUDGETC = LRESET_BUDGETC
+ DGO%LCOEF = LCOEF
+ DGO%LSURF_VARS = LSURF_VARS
IF (LHOOK) CALL DR_HOOK('MODN_SEAFLUX_N:UPDATE_NAM_DIAG_SURFN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_DIAG_SURFn
!
@@ -270,20 +269,20 @@ SUBROUTINE UPDATE_NAM_DIAG_OCEANn (DGO)
IF (LHOOK) CALL DR_HOOK('MODN_SEAFLUX_N:UPDATE_NAM_DIAG_OCEANN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_DIAG_OCEANn
-SUBROUTINE INIT_NAM_SEAICEn (DGSI, S)
+SUBROUTINE INIT_NAM_SEAICEn (DGMSI, S)
!
- USE MODD_DIAG_SEAICE_n, ONLY : DIAG_SEAICE_t
+ USE MODD_DIAG_MISC_SEAICE_n, ONLY : DIAG_MISC_SEAICE_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
!
IMPLICIT NONE
!
- TYPE(DIAG_SEAICE_t), INTENT(INOUT) :: DGSI
+ TYPE(DIAG_MISC_SEAICE_t), INTENT(INOUT) :: DGMSI
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_SEAFLUX_N:INIT_NAM_SEAICEN',0,ZHOOK_HANDLE)
- LDIAG_SEAICE = DGSI%LDIAG_SEAICE
+ LDIAG_MISC_SEAICE = DGMSI%LDIAG_MISC_SEAICE
CINTERPOL_SIC = S%CINTERPOL_SIC
CINTERPOL_SIT = S%CINTERPOL_SIT
XSIC_EFOLDING_TIME=S%XSIC_EFOLDING_TIME
@@ -295,20 +294,19 @@ SUBROUTINE INIT_NAM_SEAICEn (DGSI, S)
IF (LHOOK) CALL DR_HOOK('MODN_SEAFLUX_N:INIT_NAM_SEAICEN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_SEAICEn
-SUBROUTINE UPDATE_NAM_SEAICEn (DGSI, S)
+SUBROUTINE UPDATE_NAM_SEAICEn (DGMSI, S)
!
- USE MODD_DIAG_SEAICE_n, ONLY : DIAG_SEAICE_t
+ USE MODD_DIAG_MISC_SEAICE_n, ONLY : DIAG_MISC_SEAICE_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
!
IMPLICIT NONE
-
!
- TYPE(DIAG_SEAICE_t), INTENT(INOUT) :: DGSI
+ TYPE(DIAG_MISC_SEAICE_t), INTENT(INOUT) :: DGMSI
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_SEAFLUX_N:UPDATE_NAM_SEAICEN',0,ZHOOK_HANDLE)
- DGSI%LDIAG_SEAICE = LDIAG_SEAICE
+ DGMSI%LDIAG_MISC_SEAICE = LDIAG_MISC_SEAICE
S%CINTERPOL_SIC = CINTERPOL_SIC
S%CINTERPOL_SIT = CINTERPOL_SIT
S%XSIC_EFOLDING_TIME = XSIC_EFOLDING_TIME
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/modn_sfx_oasis.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/modn_sfx_oasis.F90
index f01bcecd9c25a3717f0eafaac6da059a3528bd82..5572ee6ceb36cff8da4fa04e31285e88fd91cc8c 100755
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/modn_sfx_oasis.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/modn_sfx_oasis.F90
@@ -26,6 +26,7 @@ MODULE MODN_SFX_OASIS
!! MODIFICATIONS
!! -------------
!! Original 10/13
+!! 10/2016 B. Decharme : bug surface/groundwater coupling
!! Modified 11/2014 : J. Pianezze - add wave coupling parameters
!! and surface pressure parameter for ocean coupling
!
@@ -48,18 +49,19 @@ REAL :: XTSTEP_CPL_WAVE = -1.0 ! Coupling time step for wave
!
! Output variables
!
- CHARACTER(LEN=8) :: CRUNOFF = ' ' ! Surface runoff
- CHARACTER(LEN=8) :: CDRAIN = ' ' ! Deep drainage
- CHARACTER(LEN=8) :: CCALVING = ' ' ! Calving flux
- CHARACTER(LEN=8) :: CRECHARGE = ' ' ! groundwater recharge
- CHARACTER(LEN=8) :: CSRCFLOOD = ' ' ! Floodplains freshwater flux
+CHARACTER(LEN=8) :: CRUNOFF = ' ' ! Surface runoff
+CHARACTER(LEN=8) :: CDRAIN = ' ' ! Deep drainage
+CHARACTER(LEN=8) :: CCALVING = ' ' ! Calving flux
+CHARACTER(LEN=8) :: CSRCFLOOD = ' ' ! Floodplains freshwater flux
!
! Input variables
!
- CHARACTER(LEN=8) :: CWTD = ' ' ! water table depth
- CHARACTER(LEN=8) :: CFWTD = ' ' ! grid-cell fraction of water table rise
- CHARACTER(LEN=8) :: CFFLOOD = ' ' ! Floodplains fraction
- CHARACTER(LEN=8) :: CPIFLOOD = ' ' ! Flood potential infiltartion
+CHARACTER(LEN=8) :: CWTD = ' ' ! water table depth
+CHARACTER(LEN=8) :: CFWTD = ' ' ! grid-cell fraction of water table rise
+CHARACTER(LEN=8) :: CFFLOOD = ' ' ! Floodplains fraction
+CHARACTER(LEN=8) :: CPIFLOOD = ' ' ! Flood potential infiltartion
+!
+REAL :: XFLOOD_LIM = 0.01
!
!-------------------------------------------------------------------------------
!
@@ -69,10 +71,10 @@ REAL :: XTSTEP_CPL_WAVE = -1.0 ! Coupling time step for wave
!
! Input variables
!
- CHARACTER(LEN=8) :: CLAKE_EVAP = ' ' ! Evaporation over lake area
- CHARACTER(LEN=8) :: CLAKE_RAIN = ' ' ! Rainfall over lake area
- CHARACTER(LEN=8) :: CLAKE_SNOW = ' ' ! Snowfall over lake area
- CHARACTER(LEN=8) :: CLAKE_WATF = ' ' ! Net freshwater flux
+CHARACTER(LEN=8) :: CLAKE_EVAP = ' ' ! Evaporation over lake area
+CHARACTER(LEN=8) :: CLAKE_RAIN = ' ' ! Rainfall over lake area
+CHARACTER(LEN=8) :: CLAKE_SNOW = ' ' ! Snowfall over lake area
+CHARACTER(LEN=8) :: CLAKE_WATF = ' ' ! Net freshwater flux
!
!-------------------------------------------------------------------------------
!
@@ -82,36 +84,36 @@ REAL :: XTSTEP_CPL_WAVE = -1.0 ! Coupling time step for wave
!
! Sea Output variables
!
- CHARACTER(LEN=8) :: CSEA_FWSU = ' ' ! zonal wind stress
- CHARACTER(LEN=8) :: CSEA_FWSV = ' ' ! meridian wind stress
- CHARACTER(LEN=8) :: CSEA_HEAT = ' ' ! Non solar net heat flux
- CHARACTER(LEN=8) :: CSEA_SNET = ' ' ! Solar net heat flux
- CHARACTER(LEN=8) :: CSEA_WIND = ' ' ! module of 10m wind speed
- CHARACTER(LEN=8) :: CSEA_FWSM = ' ' ! module of wind stress
- CHARACTER(LEN=8) :: CSEA_EVAP = ' ' ! Evaporation
- CHARACTER(LEN=8) :: CSEA_RAIN = ' ' ! Rainfall
- CHARACTER(LEN=8) :: CSEA_SNOW = ' ' ! Snowfall
- CHARACTER(LEN=8) :: CSEA_EVPR = ' ' ! Evaporation - Preci.
- CHARACTER(LEN=8) :: CSEA_WATF = ' ' ! Net freshwater flux
- CHARACTER(LEN=8) :: CSEA_PRES = ' ' ! Surface pressure
+CHARACTER(LEN=8) :: CSEA_FWSU = ' ' ! zonal wind stress
+CHARACTER(LEN=8) :: CSEA_FWSV = ' ' ! meridian wind stress
+CHARACTER(LEN=8) :: CSEA_HEAT = ' ' ! Non solar net heat flux
+CHARACTER(LEN=8) :: CSEA_SNET = ' ' ! Solar net heat flux
+CHARACTER(LEN=8) :: CSEA_WIND = ' ' ! module of 10m wind speed
+CHARACTER(LEN=8) :: CSEA_FWSM = ' ' ! module of wind stress
+CHARACTER(LEN=8) :: CSEA_EVAP = ' ' ! Evaporation
+CHARACTER(LEN=8) :: CSEA_RAIN = ' ' ! Rainfall
+CHARACTER(LEN=8) :: CSEA_SNOW = ' ' ! Snowfall
+CHARACTER(LEN=8) :: CSEA_EVPR = ' ' ! Evaporation - Preci.
+CHARACTER(LEN=8) :: CSEA_WATF = ' ' ! Net freshwater flux
+CHARACTER(LEN=8) :: CSEA_PRES = ' ' ! Surface pressure
!
! Sea-ice Output variables
!
- CHARACTER(LEN=8) :: CSEAICE_HEAT = ' ' ! Sea-ice non solar net heat flux
- CHARACTER(LEN=8) :: CSEAICE_SNET = ' ' ! Sea-ice solar net heat flux
- CHARACTER(LEN=8) :: CSEAICE_EVAP = ' ' ! Sea-ice sublimation
+CHARACTER(LEN=8) :: CSEAICE_HEAT = ' ' ! Sea-ice non solar net heat flux
+CHARACTER(LEN=8) :: CSEAICE_SNET = ' ' ! Sea-ice solar net heat flux
+CHARACTER(LEN=8) :: CSEAICE_EVAP = ' ' ! Sea-ice sublimation
!
! Sea Input variables
!
- CHARACTER(LEN=8) :: CSEA_SST = ' ' ! Sea surface temperature
- CHARACTER(LEN=8) :: CSEA_UCU = ' ' ! Sea u-current stress
- CHARACTER(LEN=8) :: CSEA_VCU = ' ' ! Sea v-current stress
+CHARACTER(LEN=8) :: CSEA_SST = ' ' ! Sea surface temperature
+CHARACTER(LEN=8) :: CSEA_UCU = ' ' ! Sea u-current stress
+CHARACTER(LEN=8) :: CSEA_VCU = ' ' ! Sea v-current stress
!
! Sea-ice Input variables
!
- CHARACTER(LEN=8) :: CSEAICE_SIT = ' ' ! Sea-ice temperature
- CHARACTER(LEN=8) :: CSEAICE_CVR = ' ' ! Sea-ice cover
- CHARACTER(LEN=8) :: CSEAICE_ALB = ' ' ! Sea-ice albedo
+CHARACTER(LEN=8) :: CSEAICE_SIT = ' ' ! Sea-ice temperature
+CHARACTER(LEN=8) :: CSEAICE_CVR = ' ' ! Sea-ice cover
+CHARACTER(LEN=8) :: CSEAICE_ALB = ' ' ! Sea-ice albedo
!
!-------------------------------------------------------------------------------
!
@@ -140,8 +142,8 @@ LOGICAL :: LWATER = .FALSE.
!* 1. NAMELISTS FOR LAND SURFACE FIELD
! ------------------------------------------------
!
-NAMELIST/NAM_SFX_LAND_CPL/XTSTEP_CPL_LAND, &
- CRUNOFF,CDRAIN,CCALVING,CRECHARGE,CWTD,CFWTD, &
+NAMELIST/NAM_SFX_LAND_CPL/XTSTEP_CPL_LAND, XFLOOD_LIM, &
+ CRUNOFF,CDRAIN,CCALVING,CWTD,CFWTD, &
CFFLOOD,CPIFLOOD,CSRCFLOOD
!
!
@@ -162,14 +164,12 @@ NAMELIST/NAM_SFX_SEA_CPL/XTSTEP_CPL_SEA, LWATER, &
CSEAICE_EVAP,CSEA_SST,CSEA_UCU,CSEA_VCU, &
CSEAICE_SIT,CSEAICE_CVR,CSEAICE_ALB
!
-!
!* 4. NAMELISTS FOR WAVE FIELD
! ---------------------------------------------------------------
!
NAMELIST/NAM_SFX_WAVE_CPL/XTSTEP_CPL_WAVE, &
CWAVE_U10, CWAVE_V10, &
CWAVE_CHA, CWAVE_UCU, CWAVE_VCU, CWAVE_HS, CWAVE_TP
-
!
!-------------------------------------------------------------------------------
!
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/prep_hor_seaflux_field.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/prep_hor_seaflux_field.F90
index 8fe516aa5257c8063283cdd85c623776e86b7e5b..9864abbd4b251c4a27c051b4807e95466b75818e 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/prep_hor_seaflux_field.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/prep_hor_seaflux_field.F90
@@ -3,9 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_HOR_SEAFLUX_FIELD (DTCO, UG, U, &
- DTS, O, OR, SG, S,GCP, &
- HPROGRAM,HSURF,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+SUBROUTINE PREP_HOR_SEAFLUX_FIELD (DTCO, UG, U, GCP, DTS, O, OR, KLAT, S, &
+ HPROGRAM,HSURF,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
! #################################################################################
!
!!**** *PREP_HOR_SEAFLUX_FIELD* - reads, interpolates and prepares a sea field
@@ -30,33 +29,31 @@ SUBROUTINE PREP_HOR_SEAFLUX_FIELD (DTCO, UG, U, &
!! P. Le Moigne 10/2005, Phasage Arome
!! P. Le Moigne 09/2007, sst from clim
!! S. Senesi 09/2013, extends to fields of SSS and SIC
+!! P. Marguinaud10/2014, Support for a 2-part PREP
!! Modified 03/2014 : M.N. Bouin ! possibility of wave parameters
!! ! from external source
!!------------------------------------------------------------------
!
-
-!
-!
-!
-!
-!
-!
-!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_t
USE MODD_OCEAN_n, ONLY : OCEAN_t
USE MODD_OCEAN_REL_n, ONLY : OCEAN_REL_t
-USE MODD_SEAFLUX_GRID_n, ONLY : SEAFLUX_GRID_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
!
+USE MODD_TYPE_DATE_SURF, ONLY : DATE_TIME
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC
USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE, XZS_LS, XLAT_OUT, XLON_OUT, &
XX_OUT, XY_OUT, CMASK
!
+USE MODD_GRID_GRIB, ONLY : CINMODEL
+!
+USE MODE_PREP_CTL, ONLY : PREP_CTL, PREP_CTL_INT_PART2, PREP_CTL_INT_PART4
+!
+USE MODI_PREP_GRIB_GRID
USE MODI_READ_PREP_SEAFLUX_CONF
USE MODI_PREP_SEAFLUX_GRIB
USE MODI_PREP_SEAFLUX_UNIF
@@ -73,22 +70,26 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
USE MODI_ABOR1_SFX
-IMPLICIT NONE
!
-!* 0.1 declarations of arguments
+IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
!
+!* 0.1 declarations of arguments
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
TYPE(DATA_SEAFLUX_t), INTENT(INOUT) :: DTS
TYPE(OCEAN_t), INTENT(INOUT) :: O
TYPE(OCEAN_REL_t), INTENT(INOUT) :: OR
-TYPE(SEAFLUX_GRID_t), INTENT(INOUT) :: SG
+INTEGER, INTENT(IN) :: KLAT
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
-TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+TYPE (PREP_CTL), INTENT(INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
@@ -104,10 +105,16 @@ TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
CHARACTER(LEN=6) :: YFILEPGDTYPE ! type of input file
CHARACTER(LEN=28) :: YFILEPGD ! name of file
REAL, POINTER, DIMENSION(:,:) :: ZFIELDIN ! field to interpolate horizontally
-REAL, ALLOCATABLE, DIMENSION(:,:) :: ZFIELDOUT ! field interpolated horizontally
-INTEGER :: ILUOUT ! output listing logical unit
+REAL, POINTER, DIMENSION(:,:) :: ZFIELDOUT ! field interpolated horizontally
+TYPE (DATE_TIME) :: TZTIME_GRIB ! current date and time
+INTEGER :: ILUOUT ! output listing logical unit
+INTEGER :: INFOMPI, INL
!
LOGICAL :: GUNIF ! flag for prescribed uniform field
+ CHARACTER (LEN=28) :: CLFILE
+INTEGER :: IRESP
+ CHARACTER (LEN=100) :: CLCOMMENT
+ CHARACTER (LEN=6) :: CLSCHEME
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
!
@@ -117,78 +124,106 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('PREP_HOR_SEAFLUX_FIELD',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
- CALL READ_PREP_SEAFLUX_CONF(O, &
+ CALL READ_PREP_SEAFLUX_CONF(O%LMERCATOR, &
HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,&
HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,ILUOUT,GUNIF)
!
-CMASK = 'SEA'
+ CMASK = 'SEA'
+!
+NULLIFY (ZFIELDIN, ZFIELDOUT)
+!
+IF (YDCTL%LPART1) THEN
+!
!--------------------------------------------------------------------- ----------------
!
!* 2. Reading of input configuration (Grid and interpolation type)
!
-IF (GUNIF) THEN
- CALL PREP_SEAFLUX_UNIF(ILUOUT,HSURF,ZFIELDIN)
-ELSE IF (YFILETYPE=='GRIB ') THEN
- CALL PREP_SEAFLUX_GRIB(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
-ELSE IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='ASCII ' .OR. YFILETYPE=='LFI '.OR. YFILETYPE=='FA ') THEN
- CALL PREP_SEAFLUX_EXTERN(GCP,&
- HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,ILUOUT,ZFIELDIN)
-ELSE IF (YFILETYPE=='BUFFER') THEN
- CALL PREP_SEAFLUX_BUFFER(HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
-ELSE IF (YFILETYPE=='NETCDF') THEN
- CALL PREP_SEAFLUX_NETCDF(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
-ELSE
- CALL ABOR1_SFX('PREP_HOR_SEAFLUX_FIELD: data file type not supported : '//YFILETYPE)
-END IF
+ IF (GUNIF) THEN
+ CALL PREP_SEAFLUX_UNIF(ILUOUT,HSURF,ZFIELDIN)
+ ELSE IF (YFILETYPE=='GRIB ') THEN
+ CALL PREP_GRIB_GRID(YFILE,ILUOUT,CINMODEL,CINGRID_TYPE,CINTERP_TYPE,TZTIME_GRIB)
+ IF (NRANK==NPIO) CALL PREP_SEAFLUX_GRIB(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
+ ELSE IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='ASCII ' .OR. YFILETYPE=='LFI '&
+ .OR. YFILETYPE=='FA '.OR. YFILETYPE=='AROME '.OR.YFILETYPE=='NC ') THEN
+ CALL PREP_SEAFLUX_EXTERN(GCP,HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,ILUOUT,ZFIELDIN)
+ ELSE IF (YFILETYPE=='BUFFER') THEN
+ CALL PREP_SEAFLUX_BUFFER(HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
+ ELSE IF (YFILETYPE=='NETCDF') THEN
+ CALL PREP_SEAFLUX_NETCDF(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
+ ELSE
+ CALL ABOR1_SFX('PREP_HOR_SEAFLUX_FIELD: data file type not supported : '//YFILETYPE)
+ END IF
+!
+ENDIF
!
!
!* 4. Horizontal interpolation
!
-ALLOCATE(ZFIELDOUT(SIZE(SG%XLAT),SIZE(ZFIELDIN,2)))
+ CALL PREP_CTL_INT_PART2 (YDCTL, HSURF, 'SEA', CMASK, ZFIELDIN)
!
- CALL HOR_INTERPOL(DTCO, U,GCP, &
- ILUOUT,ZFIELDIN,ZFIELDOUT)
+IF (YDCTL%LPART3) THEN
!
-!* 5. Return to historical variable
+ IF (NRANK==NPIO) THEN
+ INL = SIZE(ZFIELDIN,2)
+ ELSEIF (.NOT.ASSOCIATED(ZFIELDIN)) THEN
+ ALLOCATE(ZFIELDIN(0,0))
+ ENDIF
!
-SELECT CASE (HSURF)
- CASE('ZS ')
- ALLOCATE(XZS_LS(SIZE(ZFIELDOUT,1)))
- XZS_LS(:) = ZFIELDOUT(:,1)
- CASE('SST ')
- ALLOCATE(S%XSST(SIZE(ZFIELDOUT,1)))
- S%XSST(:) = ZFIELDOUT(:,1)
- IF (DTS%LSST_DATA) THEN
- ! XSST is derived from array XDATA_SST from MODD_DATA_SEAFLUX, with time interpolation
- CALL PREP_SST_INIT(DTS, S, &
- S%XSST)
- END IF
- IF (O%LMERCATOR) THEN
- ! Preparing input for ocean 1D model
- CALL PREP_HOR_OCEAN_FIELDS(DTCO, UG, U, &
- O, OR, SG, S,GCP, &
- HPROGRAM,HSURF,YFILE,YFILETYPE,ILUOUT,GUNIF)
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(INL,KIND(INL)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
ENDIF
- CASE('SSS ')
- ALLOCATE(S%XSSS(SIZE(ZFIELDOUT,1)))
- S%XSSS(:) = ZFIELDOUT(:,1)
- CASE('SIC ')
- ALLOCATE(S%XSIC(SIZE(ZFIELDOUT,1)))
- S%XSIC(:) = ZFIELDOUT(:,1)
- CASE('HS ')
- ALLOCATE(S%XHS(SIZE(ZFIELDOUT,1)))
- S%XHS(:) = ZFIELDOUT(:,1)
- CASE('TP ')
- ALLOCATE(S%XTP(SIZE(ZFIELDOUT,1)))
- S%XTP(:) = ZFIELDOUT(:,1)
-END SELECT
+ ALLOCATE(ZFIELDOUT(KLAT,INL))
+!
+ CALL HOR_INTERPOL(DTCO, U, GCP, ILUOUT,ZFIELDIN,ZFIELDOUT)
+!
+ENDIF
+!
+ CALL PREP_CTL_INT_PART4 (YDCTL, HSURF, 'SEA', CMASK, ZFIELDIN, ZFIELDOUT)
+!
+IF (YDCTL%LPART5) THEN
+!
+!* 5. Return to historical variable
+!
+ SELECT CASE (HSURF)
+ CASE('ZS ')
+ ALLOCATE(XZS_LS(SIZE(ZFIELDOUT,1)))
+ XZS_LS(:) = ZFIELDOUT(:,1)
+ CASE('SST ')
+ ALLOCATE(S%XSST(SIZE(ZFIELDOUT,1)))
+ S%XSST(:) = ZFIELDOUT(:,1)
+ IF (DTS%LSST_DATA) THEN
+ ! XSST is derived from array XDATA_SST from MODD_DATA_SEAFLUX, with time interpolation
+ CALL PREP_SST_INIT(DTS, S%TTIME, S%JSX, S%XSST)
+ END IF
+ IF (O%LMERCATOR) THEN
+ ! Preparing input for ocean 1D model
+ CALL PREP_HOR_OCEAN_FIELDS(DTCO, UG, U, GCP, O, OR, KLAT, S%XSEABATHY, &
+ HPROGRAM,HSURF,YFILE,YFILETYPE,ILUOUT,GUNIF)
+ ENDIF
+ CASE('SSS ')
+ ALLOCATE(S%XSSS(SIZE(ZFIELDOUT,1)))
+ S%XSSS(:) = ZFIELDOUT(:,1)
+ CASE('SIC ')
+ ALLOCATE(S%XSIC(SIZE(ZFIELDOUT,1)))
+ S%XSIC(:) = ZFIELDOUT(:,1)
+ CASE('HS ')
+ ALLOCATE(S%XHS(SIZE(ZFIELDOUT,1)))
+ S%XHS(:) = ZFIELDOUT(:,1)
+ CASE('TP ')
+ ALLOCATE(S%XTP(SIZE(ZFIELDOUT,1)))
+ S%XTP(:) = ZFIELDOUT(:,1)
+ END SELECT
+!
+ENDIF
!
!-------------------------------------------------------------------------------------
!
!* 6. Deallocations
!
-DEALLOCATE(ZFIELDIN )
-DEALLOCATE(ZFIELDOUT)
+IF (ASSOCIATED (ZFIELDIN)) DEALLOCATE(ZFIELDIN )
+IF (ASSOCIATED (ZFIELDOUT)) DEALLOCATE(ZFIELDOUT)
IF (LHOOK) CALL DR_HOOK('PREP_HOR_SEAFLUX_FIELD',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/prep_seaflux.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/prep_seaflux.F90
index 38663733c7478d7353b44603583c874ea97fe48b..b136269e817f93727f825c7b254f755780055438 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/prep_seaflux.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/prep_seaflux.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_SEAFLUX (DTCO, UG, U, SM,GCP, &
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+SUBROUTINE PREP_SEAFLUX (DTCO, UG, U, GCP, SG, SB, S, DTS, O, OR, &
+ HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
! #################################################################################
!
!!**** *PREP_SEAFLUX* - prepares variables for SEAFLUX scheme
@@ -30,23 +30,27 @@ SUBROUTINE PREP_SEAFLUX (DTCO, UG, U, SM,GCP, &
!! Modified 07/2012, P. Le Moigne : CMO1D phasing
!! Modified 01/2014, S. Senesi : introduce sea-ice model
!! Modified 01/2015, R. Séférian : introduce ocean surface albedo
+!! P. Marguinaud10/2014, Support for a 2-part PREP
!! Modified 03/2014 : M.N. Bouin ! possibility of wave parameters
!! ! from external source
!!------------------------------------------------------------------
!
-!
-USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t
-!
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_CANOPY_n, ONLY : CANOPY_t
+USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
+USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_t
+USE MODD_OCEAN_n, ONLY : OCEAN_t
+USE MODD_OCEAN_REL_n, ONLY : OCEAN_REL_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
USE MODI_PREP_HOR_SEAFLUX_FIELD
USE MODI_PREP_VER_SEAFLUX
USE MODI_PREP_OUTPUT_GRID
-USE MODI_PREP_SEAFLUX_SBL
+USE MODI_PREP_SBL
USE MODI_PREP_SEAICE
USE MODI_GET_LUOUT
!
@@ -55,6 +59,7 @@ USE MODD_READ_NAMELIST, ONLY : LNAM_READ
USE MODD_PREP, ONLY : XZS_LS
USE MODD_SURF_ATM, ONLY : LVERTSHIFT
!
+USE MODE_PREP_CTL, ONLY : PREP_CTL
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -65,12 +70,18 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
+TYPE(GRID_t), INTENT(INOUT) :: SG
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
+TYPE(SEAFLUX_t), INTENT(INOUT) :: S
+TYPE(DATA_SEAFLUX_t), INTENT(INOUT) :: DTS
+TYPE(OCEAN_t), INTENT(INOUT) :: O
+TYPE(OCEAN_REL_t), INTENT(INOUT) :: OR
+TYPE (PREP_CTL), INTENT(INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! name of the Atmospheric file
@@ -94,25 +105,26 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('PREP_SEAFLUX',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
- CALL PREP_OUTPUT_GRID(UG, U, &
- ILUOUT,SM%SG%CGRID,SM%SG%XGRID_PAR,SM%SG%XLAT,SM%SG%XLON)
+ CALL PREP_OUTPUT_GRID(UG%G, SG, U%NSIZE_FULL, ILUOUT)
!
!-------------------------------------------------------------------------------------
!
!* 1. Read namelist
!
-SM%S%LSBL = LSEA_SBL
-SM%O%LMERCATOR = LOCEAN_MERCATOR
-SM%O%LCURRENT = LOCEAN_CURRENT
+S%LSBL = LSEA_SBL
+!
+O%LMERCATOR = LOCEAN_MERCATOR
+O%LCURRENT = LOCEAN_CURRENT
+!
! Relaxation-forcing parameters
-SM%OR%XTAU_REL = XTIME_REL
-SM%OR%XQCORR = XCORFLX
+OR%XTAU_REL = XTIME_REL
+OR%XQCORR = XCORFLX
!
-SM%OR%LREL_CUR = LCUR_REL
-SM%OR%LREL_TS = LTS_REL
-SM%OR%LFLUX_NULL = LZERO_FLUX
-SM%OR%LFLX_CORR = LCORR_FLUX
-SM%OR%LDIAPYCNAL = LDIAPYC
+OR%LREL_CUR = LCUR_REL
+OR%LREL_TS = LTS_REL
+OR%LFLUX_NULL = LZERO_FLUX
+OR%LFLX_CORR = LCORR_FLUX
+OR%LDIAPYCNAL = LDIAPYC
!
!-------------------------------------------------------------------------------------
!
@@ -121,116 +133,115 @@ SM%OR%LDIAPYCNAL = LDIAPYC
!
!* 2.0 Large scale orography
!
- CALL PREP_HOR_SEAFLUX_FIELD(DTCO, UG, U, &
- SM%DTS, SM%O, SM%OR, SM%SG, SM%S, GCP,&
- HPROGRAM,'ZS ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+CALL PREP_HOR_SEAFLUX_FIELD(DTCO, UG, U, GCP, DTS, O, OR, SIZE(SG%XLAT), S, &
+ HPROGRAM,'ZS ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
!
!* 2.1.1 Temperature
!
- CALL PREP_HOR_SEAFLUX_FIELD(DTCO, UG, U, &
- SM%DTS, SM%O, SM%OR, SM%SG, SM%S,GCP, &
- HPROGRAM,'SST ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+CALL PREP_HOR_SEAFLUX_FIELD(DTCO, UG, U, GCP, DTS, O, OR, SIZE(SG%XLAT), S, &
+ HPROGRAM,'SST ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
!
!* 2.1.2 Salinity
!
- CALL PREP_HOR_SEAFLUX_FIELD(DTCO, UG, U, &
- SM%DTS, SM%O, SM%OR, SM%SG, SM%S,GCP, &
- HPROGRAM,'SSS ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+CALL PREP_HOR_SEAFLUX_FIELD(DTCO, UG, U, GCP, DTS, O, OR, SIZE(SG%XLAT), S, &
+ HPROGRAM,'SSS ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
!
!* 2.1.3 Sea-ice
!
IF (CSEAICE_SCHEME /= 'NONE ') THEN
- CALL PREP_SEAICE(UG, &
- DTCO, SM%DTS, SM%O, SM%OR, SM%SG, SM%S, U,GCP, &
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+ CALL PREP_SEAICE(UG, DTCO, DTS, O, OR, SIZE(SG%XLAT), S, U, GCP, &
+ HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
ENDIF
!
+!
!* 2.2 Significant height and peak period
!
- CALL PREP_HOR_SEAFLUX_FIELD(DTCO, UG, U, &
- SM%DTS, SM%O, SM%OR, SM%SG, SM%S,GCP, &
- HPROGRAM,'HS ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
- CALL PREP_HOR_SEAFLUX_FIELD(DTCO, UG, U, &
- SM%DTS, SM%O, SM%OR, SM%SG, SM%S,GCP, &
- HPROGRAM,'TP ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+ CALL PREP_HOR_SEAFLUX_FIELD(DTCO, UG, U, GCP, DTS, O, OR, SIZE(SG%XLAT), S, &
+ HPROGRAM,'HS ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
+!
+ CALL PREP_HOR_SEAFLUX_FIELD(DTCO, UG, U, GCP, DTS, O, OR, SIZE(SG%XLAT), S, &
+ HPROGRAM,'TP ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
+!
!
+ CALL CLEAN_PREP_OUTPUT_GRID
+
+IF (YDCTL%LPART6) THEN
!
!* 2.2 Roughness
!
-ALLOCATE(SM%S%XZ0(SIZE(SM%S%XSST)))
-SM%S%XZ0 = 0.001
+ ALLOCATE(S%XZ0(SIZE(S%XSST)))
+ S%XZ0 = 0.001
!
-ALLOCATE(SM%S%XZ0H(SIZE(SM%S%XSST)))
-SM%S%XZ0H = SM%S%XZ0
+ ALLOCATE(S%XZ0H(SIZE(S%XSST)))
+ S%XZ0H = S%XZ0
!
!* 2.3 Ocean Surface Albedo
!
-IF(SM%S%CSEA_ALB=='RS14')THEN
- ALLOCATE(SM%S%XDIR_ALB(SIZE(SM%S%XSST)))
- ALLOCATE(SM%S%XSCA_ALB(SIZE(SM%S%XSST)))
- SM%S%XDIR_ALB = 0.065
- SM%S%XSCA_ALB = 0.065
-ENDIF
+ IF(S%CSEA_ALB=='RS14')THEN
+ ALLOCATE(S%XDIR_ALB(SIZE(S%XSST)))
+ ALLOCATE(S%XSCA_ALB(SIZE(S%XSST)))
+ S%XDIR_ALB = 0.065
+ S%XSCA_ALB = 0.065
+ ENDIF
!
-!-------------------------------------------------------------------------------------
- CALL CLEAN_PREP_OUTPUT_GRID
!-------------------------------------------------------------------------------------
!
!* 3. Vertical interpolations of all variables
!
-IF(LVERTSHIFT)THEN
- CALL PREP_VER_SEAFLUX(SM%S)
-ENDIF
+ IF(LVERTSHIFT)THEN
+ CALL PREP_VER_SEAFLUX(S)
+ ENDIF
!
-DEALLOCATE(XZS_LS)
+ DEALLOCATE(XZS_LS)
!
!-------------------------------------------------------------------------------------
!
!* 4. Preparation of optional interpolation of monthly sst
!
-SM%S%LINTERPOL_SST=.FALSE.
-IF(TRIM(SM%S%CINTERPOL_SST)/='NONE')THEN
+ S%LINTERPOL_SST=.FALSE.
+ IF(TRIM(S%CINTERPOL_SST)/='NONE')THEN
!
- SM%S%LINTERPOL_SST=.TRUE.
+ S%LINTERPOL_SST=.TRUE.
!
! Precedent, Current, Next, and Second-next Monthly SST
- INMTH=4
+ INMTH=4
!
- ALLOCATE(SM%S%XSST_MTH(SIZE(SM%S%XSST),INMTH))
- DO JMTH=1,INMTH
- SM%S%XSST_MTH(:,JMTH)=SM%S%XSST(:)
- ENDDO
+ ALLOCATE(S%XSST_MTH(SIZE(S%XSST),INMTH))
+ DO JMTH=1,INMTH
+ S%XSST_MTH(:,JMTH)=S%XSST(:)
+ ENDDO
!
-ENDIF
+ ENDIF
!
!-------------------------------------------------------------------------------------
!
!
!* 5. Optional preparation of interpolation of monthly Sea Surface salinity
!
-SM%S%LINTERPOL_SSS=.FALSE.
-IF(TRIM(SM%S%CINTERPOL_SSS)/='NONE')THEN
+ S%LINTERPOL_SSS=.FALSE.
+ IF(TRIM(S%CINTERPOL_SSS)/='NONE')THEN
!
- SM%S%LINTERPOL_SSS=.TRUE.
+ S%LINTERPOL_SSS=.TRUE.
!
! Precedent, Current, Next, and Second-next Monthly SSS
- INMTH=4
+ INMTH=4
!
- ALLOCATE(SM%S%XSSS_MTH(SIZE(SM%S%XSSS),INMTH))
- DO JMTH=1,INMTH
- SM%S%XSSS_MTH(:,JMTH)=SM%S%XSSS(:)
- ENDDO
+ ALLOCATE(S%XSSS_MTH(SIZE(S%XSSS),INMTH))
+ DO JMTH=1,INMTH
+ S%XSSS_MTH(:,JMTH)=S%XSSS(:)
+ ENDDO
!
-ENDIF
+ ENDIF
!
!-------------------------------------------------------------------------------------
!
!* 6. Preparation of SBL air variables
!
!
-IF (SM%S%LSBL) CALL PREP_SEAFLUX_SBL(SM%SG, SM%SSB)
+ IF (S%LSBL) CALL PREP_SBL(SG%NDIM, SB)
!
+ENDIF
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PREP_SEAFLUX',1,ZHOOK_HANDLE)
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/prep_seaflux_netcdf.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/prep_seaflux_netcdf.F90
index 347693749b4e67aa7a5120703d070af723993338..3fdd63de806130a474dbdd6e46c3e8a3bbb4f6a8 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/prep_seaflux_netcdf.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/prep_seaflux_netcdf.F90
@@ -25,7 +25,7 @@ SUBROUTINE PREP_SEAFLUX_NETCDF(HPROGRAM,HSURF,HFILE,KLUOUT,PFIELD)
!! MODIFICATIONS
!! -------------
!! Original 01/2008
-!! Modified 09/2013 : S. Senesi : extends to SSS and SIC fields
+!! Modified 09/2013 : S. Senesi : extends to SSS and SIC fields
!! Modified 03/2014 : M.N. Bouin ! possibility of wave parameters
!! ! from external source
!!------------------------------------------------------------------
@@ -34,8 +34,9 @@ USE MODE_READ_NETCDF_MERCATOR
!
!USE MODD_TYPE_DATE_SURF
!
-USE MODD_PREP, ONLY : CINGRID_TYPE
-USE MODD_GRID_LATLONREGUL, ONLY : NILENGTH
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC
+USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
+USE MODD_GRID_LATLONREGUL, ONLY : NILENGTH,NINDEPTH
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -43,6 +44,10 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1 declarations of arguments
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
@@ -57,6 +62,7 @@ REAL,DIMENSION(:,:), POINTER :: PFIELD ! field to interpolate horizontally
!CHARACTER(LEN=6) :: YINMODEL ! model from which GRIB file originates
REAL, DIMENSION(:), POINTER :: ZFIELD ! field read
CHARACTER(LEN=28) :: YNCVAR
+INTEGER :: INFOMPI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
@@ -78,10 +84,14 @@ SELECT CASE(HSURF)
CASE('ZS ')
YNCVAR='topo'
CALL PREP_NETCDF_GRID(HFILE,YNCVAR)
- CALL READ_NETCDF_ZS_SEA(HFILE,YNCVAR,ZFIELD)
- ALLOCATE(PFIELD(MAX(1,NILENGTH),1))
- PFIELD(:,1) = ZFIELD(:)
- DEALLOCATE(ZFIELD)
+ IF (NRANK==NPIO) THEN
+ CALL READ_NETCDF_ZS_SEA(HFILE,YNCVAR,ZFIELD)
+ ALLOCATE(PFIELD(MAX(1,NILENGTH),1))
+ PFIELD(:,1) = ZFIELD(:)
+ DEALLOCATE(ZFIELD)
+ ELSE
+ ALLOCATE(PFIELD(0,0))
+ ENDIF
!
!
!* 2.2 Temperature profiles
@@ -96,10 +106,12 @@ SELECT CASE(HSURF)
YNCVAR='sic'
END IF
CALL PREP_NETCDF_GRID(HFILE,YNCVAR)
- CALL READ_NETCDF_SST(HFILE,YNCVAR,ZFIELD)
- ALLOCATE(PFIELD(MAX(1,NILENGTH),1))
- PFIELD(:,1) = ZFIELD(:)
- DEALLOCATE(ZFIELD)
+ IF (NRANK==NPIO) THEN
+ CALL READ_NETCDF_SST(HFILE,YNCVAR,ZFIELD)
+ ALLOCATE(PFIELD(MAX(1,NILENGTH),1))
+ PFIELD(:,1) = ZFIELD(:)
+ DEALLOCATE(ZFIELD)
+ ENDIF
!
!
!* 2.3 Wave parameters
@@ -122,6 +134,21 @@ SELECT CASE(HSURF)
DEALLOCATE(ZFIELD)
!
END SELECT
+!
+IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(CINTERP_TYPE,LEN(CINTERP_TYPE),MPI_CHARACTER,NPIO,NCOMM,INFOMPI)
+#endif
+ IF (TRIM(CINTERP_TYPE)=="UNIF") THEN
+ IF (NRANK/=NPIO) ALLOCATE(PFIELD(1,1))
+#ifdef SFX_MPI
+ CALL MPI_BCAST(PFIELD(1:1,1:1),KIND(PFIELD)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+#endif
+ ELSEIF (NRANK/=NPIO) THEN
+ ALLOCATE(PFIELD(0,0))
+ ENDIF
+ENDIF
+!
IF (LHOOK) CALL DR_HOOK('PREP_SEAFLUX_NETCDF',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------------
END SUBROUTINE PREP_SEAFLUX_NETCDF
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/put_sfx_sea.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/put_sfx_sea.F90
index 779c8076a1572b62ae115ef86e0a7a856d096bbe..36d61886a43c716e769258054f2f94cdbbce90e3 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/put_sfx_sea.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/put_sfx_sea.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PUT_SFX_SEA (S, U, W, &
- KLUOUT,OCPL_SEAICE,OWATER,PSEA_SST,PSEA_UCU, &
+ SUBROUTINE PUT_SFX_SEA (S, U, W, KLUOUT,OCPL_SEAICE,OWATER,PSEA_SST,PSEA_UCU, &
PSEA_VCU,PSEAICE_SIT,PSEAICE_CVR,PSEAICE_ALB )
! ####################################################
!
@@ -44,8 +43,8 @@ USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_WATFLUX_n, ONLY : WATFLUX_t
!
-USE MODD_SURF_PAR, ONLY : NUNDEF, XUNDEF
USE MODD_SFX_OASIS
+USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
USE MODD_CSTS, ONLY : XTT, XTTS, XICEC
!
!
@@ -80,7 +79,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PSEAICE_ALB
! -------------------------------
!
!
- CHARACTER(LEN=50) :: YCOMMENT
+CHARACTER(LEN=50) :: YCOMMENT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -113,7 +112,7 @@ ENDIF
IF (LHOOK) CALL DR_HOOK('PUT_SFX_SEA',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
!
SUBROUTINE TREAT_SEA(KLU)
@@ -128,7 +127,7 @@ REAL, DIMENSION(KLU) :: ZSST ! sea surface temperature
REAL, DIMENSION(KLU) :: ZICE_FRAC! ice fraction
REAL :: ZTMIN ! Minimum temperature over this proc
REAL :: ZTMAX ! Maximum temperature over this proc
- CHARACTER(LEN=50) :: YCOMMENT
+CHARACTER(LEN=50) :: YCOMMENT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -139,10 +138,10 @@ IF(NSEA_SST_ID/=NUNDEF)THEN
CALL PACK_SAME_RANK(U%NR_SEA(:),PSEA_SST(:),ZSST(:))
WHERE (ZSST(:)/=0.0) S%XSST(:)=ZSST(:)
CALL CHECK_SEA(YCOMMENT,S%XSST(:))
-!
+ !
ZTMIN=MINVAL(S%XSST(:))
ZTMAX=MAXVAL(S%XSST(:))
-!
+ !
IF(ZTMIN<=0.0.OR.ZTMAX>500.)THEN
WRITE(KLUOUT,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
WRITE(KLUOUT,*)'SST from ocean model not define or not physic'
@@ -211,15 +210,15 @@ INTEGER, INTENT(IN) :: KLU
REAL, DIMENSION(KLU) :: ZICE_FRAC! ice fraction
REAL :: ZTMIN ! Minimum temperature over this proc
REAL :: ZTMAX ! Maximum temperature over this proc
- CHARACTER(LEN=50) :: YCOMMENT
+CHARACTER(LEN=50) :: YCOMMENT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PUT_SFX_SEA:TREAT_WATER',0,ZHOOK_HANDLE)
!
YCOMMENT='Water surface temperature'
- CALL PACK_SAME_RANK(U%NR_WATER(:),PSEA_SST(:),W%XTS(:))
- CALL CHECK_SEA(YCOMMENT,W%XTS(:))
+CALL PACK_SAME_RANK(U%NR_WATER(:),PSEA_SST(:),W%XTS(:))
+CALL CHECK_SEA(YCOMMENT,W%XTS(:))
!
ZTMIN=MINVAL(W%XTS(:))
ZTMAX=MAXVAL(W%XTS(:))
@@ -235,12 +234,12 @@ IF(ZTMIN<=0.0.OR.ZTMAX>500.)THEN
ENDIF
!
YCOMMENT='Water-ice Temperature'
- CALL PACK_SAME_RANK(U%NR_WATER(:),PSEAICE_SIT(:),W%XTICE(:))
- CALL CHECK_SEA(YCOMMENT,W%XTICE(:))
+CALL PACK_SAME_RANK(U%NR_WATER(:),PSEAICE_SIT(:),W%XTICE(:))
+CALL CHECK_SEA(YCOMMENT,W%XTICE(:))
!
YCOMMENT='Water-ice cover'
- CALL PACK_SAME_RANK(U%NR_WATER(:),PSEAICE_CVR(:),ZICE_FRAC(:))
- CALL CHECK_SEA(YCOMMENT,ZICE_FRAC(:))
+CALL PACK_SAME_RANK(U%NR_WATER(:),PSEAICE_CVR(:),ZICE_FRAC(:))
+CALL CHECK_SEA(YCOMMENT,ZICE_FRAC(:))
!
WHERE(ZICE_FRAC(:)>=XICEC)
W%XTS(:) = MIN(W%XTS(:),XTT-0.01)
@@ -249,8 +248,8 @@ ELSEWHERE
ENDWHERE
!
YCOMMENT='Water-ice albedo'
- CALL PACK_SAME_RANK(U%NR_WATER(:),PSEAICE_ALB(:),W%XICE_ALB(:))
- CALL CHECK_SEA(YCOMMENT,W%XICE_ALB(:))
+CALL PACK_SAME_RANK(U%NR_WATER(:),PSEAICE_ALB(:),W%XICE_ALB(:))
+CALL CHECK_SEA(YCOMMENT,W%XICE_ALB(:))
!
! Fill the table with sea ice albedo where temperature is lower than the freezing
! point
@@ -269,7 +268,7 @@ SUBROUTINE CHECK_SEA(HCOMMENT,PFIELD)
!
IMPLICIT NONE
!
- CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT
+CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT
REAL, DIMENSION(:), INTENT(IN) :: PFIELD
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/put_sfxcpln.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/put_sfxcpln.F90
index 32a3cabc22a39dd12711ca9e6afb66b523cf682e..99066282d4ac41d11fe03c71e90ec7747611f926 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/put_sfxcpln.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/put_sfxcpln.F90
@@ -3,15 +3,15 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PUT_SFXCPL_n (F, I, S, U, W, &
+SUBROUTINE PUT_SFXCPL_n (F, IM, S, U, W, &
HPROGRAM,KI,KSW,PSW_BANDS,PZENITH, &
- PLAND_WTD,PLAND_FWTD,PLAND_FFLOOD, &
- PLAND_PIFLOOD,PSEA_SST,PSEA_UCU, &
- PSEA_VCU,PSEAICE_SIT,PSEAICE_CVR, &
- PSEAICE_ALB,PTSRAD, &
- PDIR_ALB,PSCA_ALB,PEMIS,PTSURF, &
- PWAVE_CHA,PWAVE_UCU,PWAVE_VCU, &
- PWAVE_HS,PWAVE_TP )
+ PLAND_WTD,PLAND_FWTD,PLAND_FFLOOD, &
+ PLAND_PIFLOOD,PSEA_SST,PSEA_UCU, &
+ PSEA_VCU,PSEAICE_SIT,PSEAICE_CVR, &
+ PSEAICE_ALB,PTSRAD, &
+ PDIR_ALB,PSCA_ALB,PEMIS,PTSURF, &
+ PWAVE_CHA,PWAVE_UCU,PWAVE_VCU, &
+ PWAVE_HS,PWAVE_TP )
! #################################################################################################
!
!!**** *PUT_SFXCPL_n* - routine to modify some variables in surfex from information coming
@@ -48,14 +48,8 @@ SUBROUTINE PUT_SFXCPL_n (F, I, S, U, W, &
!* 0. DECLARATIONS
! ------------
!
-!
-!
-!
-!
-!
-!
USE MODD_FLAKE_n, ONLY : FLAKE_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_WATFLUX_n, ONLY : WATFLUX_t
@@ -85,12 +79,12 @@ IMPLICIT NONE
!
!
TYPE(FLAKE_t), INTENT(INOUT) :: F
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(WATFLUX_t), INTENT(INOUT) :: W
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
INTEGER, INTENT(IN) :: KI ! number of points
INTEGER, INTENT(IN) :: KSW ! number of bands
!
@@ -149,9 +143,8 @@ ENDIF
!-------------------------------------------------------------------------------
!
IF(LCPL_LAND)THEN
- CALL PUT_SFX_LAND(I, U, &
- ILUOUT,LCPL_GW,LCPL_FLOOD,PLAND_WTD(:), &
- PLAND_FWTD(:),PLAND_FFLOOD(:),PLAND_PIFLOOD(:))
+ CALL PUT_SFX_LAND(IM%O, IM%S, IM%K, IM%NK, IM%NP, U, ILUOUT, LCPL_GW, LCPL_FLOOD, &
+ PLAND_WTD(:), PLAND_FWTD(:),PLAND_FFLOOD(:),PLAND_PIFLOOD(:))
ENDIF
!
!-------------------------------------------------------------------------------
@@ -160,8 +153,7 @@ ENDIF
!
IF(LCPL_SEA)THEN
!
- CALL PUT_SFX_SEA(S, U, W, &
- ILUOUT,LCPL_SEAICE,LWATER,PSEA_SST(:),PSEA_UCU(:), &
+ CALL PUT_SFX_SEA(S, U, W, ILUOUT,LCPL_SEAICE,LWATER,PSEA_SST(:),PSEA_UCU(:), &
PSEA_VCU(:),PSEAICE_SIT(:),PSEAICE_CVR(:),PSEAICE_ALB(:) )
!
ENDIF
@@ -182,8 +174,7 @@ ENDIF
!-------------------------------------------------------------------------------
!
IF(LCPL_SEA.OR.LCPL_FLOOD)THEN
- CALL UPDATE_ESM_SURF_ATM_n(F, I, S, U, W, &
- HPROGRAM, KI, KSW, PZENITH, PSW_BANDS, &
+ CALL UPDATE_ESM_SURF_ATM_n(F, IM, S, U, W, HPROGRAM, KI, KSW, PZENITH, PSW_BANDS, &
PTSRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF )
ENDIF
!
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/read_lcover.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/read_lcover.F90
index 2a3c869bd5106ab892b95cb32036fb3aa09fffff..0d60f0e6191727e652f2534e92e4a24d9c8c9b40 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/read_lcover.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/read_lcover.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_LCOVER (&
- HPROGRAM,OCOVER)
+ SUBROUTINE READ_LCOVER (HPROGRAM,OCOVER)
! ################################
!
!!**** *READ_LCOVER* - routine to read a file for
@@ -37,7 +36,7 @@
!! MODIFICATIONS
!! -------------
!! Original 10/2008
-!! M. Moge 02/2015 parallelization
+!! M. Moge 02/2015 parallelization for mésonh
!! J. Pianezze 08/2016 replacement of MPI_COMM_WOLRD by NMNH_COMM_WORLD
!-------------------------------------------------------------------------------
!
@@ -57,9 +56,12 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
+!
+#ifdef MNH_PARALLEL
#ifndef NOMPI
INCLUDE "mpif.h"
#endif
+#endif
!
!* 0.1 Declarations of arguments
! -------------------------
@@ -72,39 +74,43 @@ LOGICAL, DIMENSION(JPCOVER) :: OCOVER ! list of covers
!* 0.2 Declarations of local variables
! -------------------------------
!
-INTEGER :: IRESP ! Error code after redding
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
-INTEGER :: IVERSION ! version of surfex file being read
LOGICAL, DIMENSION(:), ALLOCATABLE :: GCOVER ! cover list in the file
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+ CHARACTER(LEN=LEN_HREC) :: YRECFMOLD ! Name of the article to be read
+INTEGER :: IVERSION ! version of surfex file being read
+INTEGER :: IRESP ! Error code after redding
+#ifdef MNH_PARALLEL
INTEGER :: IINFO
+#endif
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
!
!* ascendant compatibility
IF (LHOOK) CALL DR_HOOK('READ_LCOVER',0,ZHOOK_HANDLE)
YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
IF (IVERSION<=3) THEN
ALLOCATE(GCOVER(255))
ELSE
ALLOCATE(GCOVER(JPCOVER))
END IF
- CALL OLD_NAME(&
- HPROGRAM,'COVER_LIST ',YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,GCOVER(:),IRESP,HDIR='-')
+ YRECFMOLD='COVER_LIST'
+ CALL OLD_NAME(HPROGRAM,YRECFMOLD,YRECFM)
+ CALL READ_SURF(HPROGRAM,YRECFM,GCOVER(:),IRESP,HDIR='-')
!
OCOVER=.FALSE.
OCOVER(:SIZE(GCOVER))=GCOVER(:)
-#ifndef NOMPI
+!
#ifdef MNH_PARALLEL
+#ifndef NOMPI
CALL MPI_ALLREDUCE(GCOVER, OCOVER, SIZE(GCOVER),MPI_LOGICAL, MPI_LOR, NMNH_COMM_WORLD, IINFO)
#else
CALL MPI_ALLREDUCE(GCOVER, OCOVER, SIZE(GCOVER),MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, IINFO)
#endif
#endif
+!
DEALLOCATE(GCOVER)
IF (LHOOK) CALL DR_HOOK('READ_LCOVER',1,ZHOOK_HANDLE)
!
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/read_nam_prep_seafluxn.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/read_nam_prep_seafluxn.F90
index 0249c23c120db5085f6577b16e11209405fa0ba6..0f294e65ae5e02d0d067b233e59126acaf51d4d4 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/read_nam_prep_seafluxn.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/read_nam_prep_seafluxn.F90
@@ -42,19 +42,19 @@ NMONTH=NUNDEF
NDAY=NUNDEF
XTIME=XUNDEF
!
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
+CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
- CALL DEFAULT_PREP_SEAFLUX
+CALL DEFAULT_PREP_SEAFLUX
!
- CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
- CALL POSNAM(ILUNAM,'NAM_PREP_SEAFLUX',GFOUND,ILUOUT)
+CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
+CALL POSNAM(ILUNAM,'NAM_PREP_SEAFLUX',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_PREP_SEAFLUX)
- CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
+CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
!
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CTYPE_SEAFLX', CTYPE_SEAFLX, ' ','GRIB ','MESONH',&
+CALL TEST_NAM_VAR_SURF(ILUOUT,'CTYPE_SEAFLX', CTYPE_SEAFLX, ' ','GRIB ','MESONH',&
'ASCII ','NETCDF','LFI ','FA ')
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CTYPEPGD', CTYPEPGD, ' ','GRIB ','MESONH','ASCII ','LFI ','FA ')
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CSEAICE_SCHEME',CSEAICE_SCHEME,'GELATO','NONE ')
+CALL TEST_NAM_VAR_SURF(ILUOUT,'CTYPEPGD', CTYPEPGD, ' ','GRIB ','MESONH','ASCII ','LFI ','FA ')
+CALL TEST_NAM_VAR_SURF(ILUOUT,'CSEAICE_SCHEME',CSEAICE_SCHEME,'GELATO','NONE ')
CALL TEST_NAM_VAR_SURF(ILUOUT,'CTYPEWAVE', CTYPEWAVE, ' ','GRIB ','MESONH','ASCII ',&
'NETCDF','LFI ')
!
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/read_namelists_seafluxn.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/read_namelists_seafluxn.F90
index b781df3afd5d510f2b9dd41cd0faf8c1a3e0bcb5..0630335e0ac98cc26586c5fc0fcd30b57c5c5435 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/read_namelists_seafluxn.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/read_namelists_seafluxn.F90
@@ -43,23 +43,23 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('READ_NAMELISTS_SEAFLUX_N',0,ZHOOK_HANDLE)
!
- CALL DEFAULT_SEAFLUX(XTSTEP,XOUT_TSTEP,CSEA_ALB,CSEA_FLUX,LPWG, &
+CALL DEFAULT_SEAFLUX(XTSTEP,XOUT_TSTEP,CSEA_ALB,CSEA_FLUX,LPWG, &
LPRECIP,LPWEBB,NZ0,NGRVWAVES,LPROGSST, &
NTIME_COUPLING,XOCEAN_TSTEP,XICHCE,CINTERPOL_SST,&
CINTERPOL_SSS,LWAVEWIND)
- CALL DEFAULT_SEAICE(HPROGRAM, CINTERPOL_SIC, CINTERPOL_SIT, &
+CALL DEFAULT_SEAICE(HPROGRAM, CINTERPOL_SIC, CINTERPOL_SIT, &
XFREEZING_SST,XSEAICE_TSTEP, XSIC_EFOLDING_TIME, &
XSIT_EFOLDING_TIME, XCD_ICE_CST, XSI_FLX_DRV )
!
- CALL DEFAULT_CH_DEP(CCH_DRY_DEP)
+CALL DEFAULT_CH_DEP(CCH_DRY_DEP)
!
- CALL DEFAULT_DIAG_SEAFLUX(N2M,LSURF_BUDGET,L2M_MIN_ZS,LRAD_BUDGET,LCOEF,LSURF_VARS,&
- LDIAG_OCEAN,LDIAG_SEAICE,LSURF_BUDGETC,LRESET_BUDGETC,XDIAG_TSTEP)
+CALL DEFAULT_DIAG_SEAFLUX(N2M,LSURF_BUDGET,L2M_MIN_ZS,LRAD_BUDGET,LCOEF,LSURF_VARS,&
+ LDIAG_OCEAN,LDIAG_MISC_SEAICE,LSURF_BUDGETC,LRESET_BUDGETC,XDIAG_TSTEP)
!
- CALL READ_DEFAULT_SEAFLUX_n(SM%CHS, SM%DGO, SM%DGS, SM%DGSI, SM%O, SM%S, &
+CALL READ_DEFAULT_SEAFLUX_n(SM%CHS, SM%SD%GO, SM%SD%O, SM%SD%DMI, SM%O, SM%S, &
HPROGRAM)
!
- CALL READ_SEAFLUX_CONF_n(SM%CHS, SM%DGO, SM%DGS, SM%DGSI, SM%O, SM%S, &
+CALL READ_SEAFLUX_CONF_n(SM%CHS, SM%SD%GO, SM%SD%O, SM%SD%DMI, SM%O, SM%S, &
HPROGRAM)
!
IF (HINIT=='PRE') CALL READ_NAM_PREP_SEAFLUX_n(HPROGRAM)
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/read_prep_seaflux_conf.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/read_prep_seaflux_conf.F90
index ec33a3379a8c859b38c08f5c3fe81bae284b83ed..d0d819072847eb84bb5e25dbfe9123652640b6ea 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/read_prep_seaflux_conf.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/read_prep_seaflux_conf.F90
@@ -3,9 +3,9 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_PREP_SEAFLUX_CONF (O, &
- HPROGRAM,HVAR,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE, &
- HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KLUOUT,OUNIF)
+ SUBROUTINE READ_PREP_SEAFLUX_CONF (OMERCATOR, HPROGRAM,HVAR,HFILE,HFILETYPE,&
+ HFILEPGD,HFILEPGDTYPE, HATMFILE,HATMFILETYPE,&
+ HPGDFILE,HPGDFILETYPE,KLUOUT,OUNIF)
! #######################################################
!
!!**** *READ_PREP_SEAFLUX_CONF* - routine to read the configuration for
@@ -54,8 +54,7 @@ USE MODI_READ_PREP_SURF_ATM_CONF
USE MODI_PREP_OCEAN_MERCATORVERGRID
!
USE MODD_PREP_SEAFLUX, ONLY : CFILE_SEAFLX, CTYPE_SEAFLX, CFILEPGD_SEAFLX, CTYPEPGD, &
- CFILEWAVE_SEAFLX, CTYPEWAVE, &
- XSST_UNIF, XSSS_UNIF, XSIC_UNIF
+ CFILEWAVE_SEAFLX, CTYPEWAVE, XSST_UNIF, XSSS_UNIF, XSIC_UNIF
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
@@ -70,19 +69,18 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-TYPE(OCEAN_t), INTENT(INOUT) :: O
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling ISBA
- CHARACTER(LEN=7), INTENT(IN) :: HVAR ! variable treated
- CHARACTER(LEN=28), INTENT(OUT) :: HFILE ! file name
- CHARACTER(LEN=6), INTENT(OUT) :: HFILETYPE! file type
- CHARACTER(LEN=28), INTENT(OUT) :: HFILEPGD ! file name
- CHARACTER(LEN=6), INTENT(OUT) :: HFILEPGDTYPE! file type
- CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! atmospheric file name
- CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! atmospheric file type
- CHARACTER(LEN=28), INTENT(IN) :: HPGDFILE ! atmospheric file name
- CHARACTER(LEN=6), INTENT(IN) :: HPGDFILETYPE! atmospheric file type
+LOGICAL, INTENT(IN) :: OMERCATOR
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling ISBA
+CHARACTER(LEN=7), INTENT(IN) :: HVAR ! variable treated
+CHARACTER(LEN=28), INTENT(OUT) :: HFILE ! file name
+CHARACTER(LEN=6), INTENT(OUT) :: HFILETYPE! file type
+CHARACTER(LEN=28), INTENT(OUT) :: HFILEPGD ! file name
+CHARACTER(LEN=6), INTENT(OUT) :: HFILEPGDTYPE! file type
+CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! atmospheric file name
+CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! atmospheric file type
+CHARACTER(LEN=28), INTENT(IN) :: HPGDFILE ! atmospheric file name
+CHARACTER(LEN=6), INTENT(IN) :: HPGDFILETYPE! atmospheric file type
INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
LOGICAL, INTENT(OUT) :: OUNIF ! flag for prescribed uniform field
@@ -171,15 +169,18 @@ IF (HVAR=='DATE ' .OR. HVAR=='ZS ') THEN
IF (LHOOK) CALL DR_HOOK('READ_PREP_SEAFLUX_CONF',1,ZHOOK_HANDLE)
RETURN
END IF
+!
!-------------------------------------------------------------------------------
!
!* If no file and var == wave: uniform field
! ---------------------------------------------
+!
IF (HVAR=='HS ' .OR. HVAR=='TP ') THEN
OUNIF = (HFILETYPE/='NETCDF')
IF (LHOOK) CALL DR_HOOK('READ_PREP_SEAFLUX_CONF',1,ZHOOK_HANDLE)
RETURN
END IF
+!
!-------------------------------------------------------------------------------
!
IF (LEN_TRIM(HFILETYPE)==0 .AND. .NOT. OUNIF) THEN
@@ -191,7 +192,7 @@ END IF
!* If 1D coupling: ocean variables initializing
! --------------------------------------------
!
-IF (O%LMERCATOR) THEN
+IF (OMERCATOR) THEN
WRITE(KLUOUT,*) 'LMERCATOR=T : initializing oceanic vertical grid'
CALL PREP_OCEAN_MERCATORVERGRID(HPROGRAM,OUNIF)
END IF
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/read_seafluxn.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/read_seafluxn.F90
index d77db880c76c9f47c76053f259d1448b0b92b176..bf2ea39c6ee8cde0bdc1455dc27807b4bf0576b1 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/read_seafluxn.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/read_seafluxn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_SEAFLUX_n (DTCO, SG, S, U, &
- HPROGRAM,KLUOUT)
+ SUBROUTINE READ_SEAFLUX_n (DTCO, G, S, U, HPROGRAM,KLUOUT)
! #########################################
!
!!**** *READ_SEAFLUX_n* - read SEAFLUX varaibles
@@ -36,7 +35,7 @@
!! Original 01/2003
!! Modified 02/2008 Add oceanic variables initialisation
!! S. Belamari 04/2014 Suppress LMERCATOR
-!! R. Séférian 01/2015 introduce new ocean surface albedo
+!! R. Séférian 01/2015 introduce new ocean surface albedo
!! Modified 03/2014 : M.N. Bouin ! possibility of wave parameters
!! ! from external source
!-------------------------------------------------------------------------------
@@ -48,7 +47,7 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_SEAFLUX_GRID_n, ONLY : SEAFLUX_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
@@ -70,24 +69,24 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(SEAFLUX_GRID_t), INTENT(INOUT) :: SG
+TYPE(GRID_t), INTENT(INOUT) :: G
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
INTEGER, INTENT(IN) :: KLUOUT
!
!* 0.2 Declarations of local variables
! -------------------------------
!
INTEGER :: JMTH, INMTH
- CHARACTER(LEN=2 ) :: YMTH
+CHARACTER(LEN=2 ) :: YMTH
!
INTEGER :: ILU ! 1D physical dimension
!
INTEGER :: IRESP ! Error code after redding
!
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
!
INTEGER :: IVERSION ! surface version
!
@@ -100,8 +99,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('READ_SEAFLUX_N',0,ZHOOK_HANDLE)
!
YRECFM='SIZE_SEA'
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'SEA ',ILU)
+CALL GET_TYPE_DIM_n(DTCO, U, 'SEA ',ILU)
!
!* 2. Prognostic fields:
! -----------------
@@ -119,20 +117,17 @@ IF(S%LINTERPOL_SST)THEN
DO JMTH=1,INMTH
WRITE(YMTH,'(I2)') (JMTH-1)
YRECFM='SST_MTH'//ADJUSTL(YMTH(:LEN_TRIM(YMTH)))
- CALL READ_SURF(&
- HPROGRAM,YRECFM,S%XSST_MTH(:,JMTH),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XSST_MTH(:,JMTH),IRESP)
ENDDO
!
- CALL INTERPOL_SST_MTH(S, &
- S%TTIME%TDATE%YEAR,S%TTIME%TDATE%MONTH,S%TTIME%TDATE%DAY,'T',S%XSST)
+ CALL INTERPOL_SST_MTH(S,'T')
!
ELSE
!
ALLOCATE(S%XSST_MTH(0,0))
!
YRECFM='SST'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,S%XSST(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XSST(:),IRESP)
!
ENDIF
!
@@ -140,8 +135,7 @@ ENDIF
!
ALLOCATE(S%XPERTFLUX(ILU))
IF( S%LPERTFLUX ) THEN
- CALL READ_SURF(&
- HPROGRAM,'PERTSEAFLUX',S%XPERTFLUX(:),IRESP)
+ CALL READ_SURF(HPROGRAM,'PERTSEAFLUX',S%XPERTFLUX(:),IRESP)
ELSE
S%XPERTFLUX(:) = 0.
ENDIF
@@ -156,18 +150,15 @@ ENDIF
ALLOCATE(S%XZ0(ILU))
YRECFM='Z0SEA'
S%XZ0(:) = 0.001
- CALL READ_SURF(&
- HPROGRAM,YRECFM,S%XZ0(:),IRESP)
+CALL READ_SURF(HPROGRAM,YRECFM,S%XZ0(:),IRESP)
!
!* flag to use or not the SeaIce model
!
- CALL READ_SURF(&
- HPROGRAM,'VERSION',IVERSION,IRESP)
+CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
IF (IVERSION <8) THEN
S%LHANDLE_SIC=.FALSE.
ELSE
- CALL READ_SURF(&
- HPROGRAM,'HANDLE_SIC',S%LHANDLE_SIC,IRESP)
+ CALL READ_SURF(HPROGRAM,'HANDLE_SIC',S%LHANDLE_SIC,IRESP)
ENDIF
!
!
@@ -187,21 +178,18 @@ IF(S%LINTERPOL_SSS)THEN
DO JMTH=1,INMTH
WRITE(YMTH,'(I2)') (JMTH-1)
YRECFM='SSS_MTH'//ADJUSTL(YMTH(:LEN_TRIM(YMTH)))
- CALL READ_SURF(&
- HPROGRAM,YRECFM,S%XSSS_MTH(:,JMTH),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XSSS_MTH(:,JMTH),IRESP)
CALL CHECK_SEA(YRECFM,S%XSSS_MTH(:,JMTH))
ENDDO
!
- CALL INTERPOL_SST_MTH(S, &
- S%TTIME%TDATE%YEAR,S%TTIME%TDATE%MONTH,S%TTIME%TDATE%DAY,'S',S%XSSS)
+ CALL INTERPOL_SST_MTH(S,'S')
!
ELSEIF (IVERSION>=8) THEN
!
ALLOCATE(S%XSSS_MTH(0,0))
!
YRECFM='SSS'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,S%XSSS,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XSSS,IRESP)
IF(S%LHANDLE_SIC)THEN
CALL CHECK_SEA(YRECFM,S%XSSS(:))
ENDIF
@@ -216,12 +204,10 @@ ALLOCATE(S%XSCA_ALB (ILU))
IF(S%CSEA_ALB=='RS14')THEN
!
YRECFM='OSA_DIR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,S%XDIR_ALB(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XDIR_ALB(:),IRESP)
!
YRECFM='OSA_SCA'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,S%XSCA_ALB(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XSCA_ALB(:),IRESP)
!
ELSE
!
@@ -248,7 +234,7 @@ END IF
IF (LHOOK) CALL DR_HOOK('READ_SEAFLUX_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
!
SUBROUTINE CHECK_SEA(HFIELD,PFIELD)
@@ -256,7 +242,7 @@ SUBROUTINE CHECK_SEA(HFIELD,PFIELD)
!
IMPLICIT NONE
!
- CHARACTER(LEN=LEN_HREC), INTENT(IN) :: HFIELD
+CHARACTER(LEN=LEN_HREC), INTENT(IN) :: HFIELD
REAL, DIMENSION(:), INTENT(IN) :: PFIELD
!
REAL :: ZMAX,ZMIN
@@ -275,7 +261,7 @@ DO JI=1,ILU
IF(PFIELD(JI)>ZMAX.OR.PFIELD(JI)<ZMIN)THEN
IERRC=IERRC+1
WRITE(KLUOUT,*)'PROBLEM FIELD '//TRIM(HFIELD)//' =',PFIELD(JI),&
- 'NOT REALISTIC AT LOCATION (LAT/LON)',SG%XLAT(JI),SG%XLON(JI)
+ 'NOT REALISTIC AT LOCATION (LAT/LON)',G%XLAT(JI),G%XLON(JI)
ENDIF
ENDDO
!
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/sfx_oasis_define.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/sfx_oasis_define.F90
index dc983ee547fd0ec26cb6c47ceff58d95cc78516e..d7de437d282ce119a311e37d98f4fd63bd3bb952 100755
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/sfx_oasis_define.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/sfx_oasis_define.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#########
-SUBROUTINE SFX_OASIS_DEFINE (I, U, &
- HPROGRAM,KNPTS,KPARAL)
+SUBROUTINE SFX_OASIS_DEFINE (IO, U, HPROGRAM,KNPTS,KPARAL)
!###################################################
!
!!**** *SFX_OASIS_DEFINE* - Definitions for exchange of coupling fields
@@ -33,6 +32,7 @@ SUBROUTINE SFX_OASIS_DEFINE (I, U, &
!! MODIFICATIONS
!! -------------
!! Original 10/2013
+!! 10/2016 B. Decharme : bug surface/groundwater coupling
!! Modified 11/2014 : J. Pianezze - add wave coupling parameters
!! and surface pressure for ocean coupling
!-------------------------------------------------------------------------------
@@ -42,7 +42,7 @@ SUBROUTINE SFX_OASIS_DEFINE (I, U, &
!
!
!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODD_SURF_PAR, ONLY : NUNDEF
@@ -67,10 +67,10 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
INTEGER, INTENT(IN) :: KNPTS ! Number of grid point on this proc
INTEGER, DIMENSION(:), INTENT(IN) :: KPARAL
!
@@ -107,8 +107,7 @@ IF (LHOOK) CALL DR_HOOK('SFX_OASIS_DEFINE',0,ZHOOK_HANDLE)
!
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
-CALL SFX_OASIS_CHECK(I, U, &
- ILUOUT)
+CALL SFX_OASIS_CHECK(IO, U, ILUOUT)
!
!-------------------------------------------------------------------------------
!
@@ -358,10 +357,6 @@ IF(LCPL_LAND)THEN
!
IF(LCPL_GW)THEN
!
-! Output groundwater recharge
- CALL OASIS_DEF_VAR(NRECHARGE_ID,CRECHARGE,IPART_ID,IVAR_NODIMS,OASIS_OUT,IVAR_SHAPE,OASIS_DOUBLE,IERR)
- IF(IERR/=OASIS_OK) CALL ABOR1_SFX('SFX_OASIS_DEFINE: OASIS def var problem for land groundwater recharge')
-!
! Input Water table depth
CALL OASIS_DEF_VAR(NWTD_ID,CWTD,IPART_ID,IVAR_NODIMS,OASIS_IN,IVAR_SHAPE,OASIS_DOUBLE,IERR)
IF(IERR/=OASIS_OK) CALL ABOR1_SFX('SFX_OASIS_DEFINE: OASIS def var problem for land Water table depth')
@@ -456,7 +451,7 @@ ENDIF
!
!-------------------------------------------------------------------------------
!
-!* 7. End of declaration phase:
+!* 6. End of declaration phase:
! --------------
!
CALL OASIS_ENDDEF(IERR)
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/sfx_oasis_init.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/sfx_oasis_init.F90
index 28c4a8444b12adf33bbfde880941b24cadb62250..2a0e3486056e1db803b8ace56e2b5cfbb2be0bb1 100755
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/sfx_oasis_init.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/sfx_oasis_init.F90
@@ -2,22 +2,25 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
-!#########
SUBROUTINE SFX_OASIS_INIT(HNAMELIST,KLOCAL_COMM,HINIT)
!!
!!
!! PURPOSE
!! --------
!!
-!! Initialize coupled mode communication
+!! Initialize coupled mode communication and XIOS I/O scheme
!!
!!
!! METHOD
!! ------
!!
-!! OASIS-MCT usage is controlled by environment variables
-!! OASIS-MCT interface must be initialized before any DR_HOOK call
+!! Depending on namelist flags for Oasis and XIOS, either call :
+!! - XIOS_INITIALIZE alone (when LXIOS and not LOASIS) , or
+!! - OASIS_INIT_COMP (when LOASIS) and then, depending on LXIOS,
+!! * either XIOS_INITALIZE
+!! * or OASIS_GET_LOCAL_COMM
!!
+!! Note : OASIS-MCT interface must be initialized before any DR_HOOK call
!!
!! EXTERNAL
!! --------
@@ -30,6 +33,9 @@ SUBROUTINE SFX_OASIS_INIT(HNAMELIST,KLOCAL_COMM,HINIT)
!! CERFACS, Toulouse, France, 50 pp.
!! https://verc.enes.org/oasis/oasis-dedicated-user-support-1/documentation/oasis3-mct-user-guide
!!
+!! XIOS Reference guide - Yann Meurdesoif - 10/10/2014 -
+!! svn co -r 515 http://forge.ipsl.jussieu.fr/ioserver/svn/XIOS/branchs/xios-1.0 <dir> ; cd <dir>/doc ; ....
+!!
!!
!! AUTHOR
!! ------
@@ -40,15 +46,23 @@ SUBROUTINE SFX_OASIS_INIT(HNAMELIST,KLOCAL_COMM,HINIT)
!! --------------
!!
!! Original 10/2013
+!! S.Sénési 08/2015 - handle XIOS
+!! B.Decharme 09/2016 - no CALL ABORT if no namelist in Arpege
!! Modified 11/2014 : J. Pianezze - add LOASIS_GRID flag
!!
-!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_SFX_OASIS, ONLY : LOASIS, LOASIS_GRID, XRUNTIME
+USE MODD_SFX_OASIS, ONLY : LOASIS, LOASIS_GRID, CMODEL_NAME, XRUNTIME
+USE MODI_ABOR1_SFX
+!
+USE MODD_XIOS , ONLY : LXIOS ! Should we call XIOS_INITIALIZE instead of OASIS_GET_LOCAL_COMM
+!
+#ifdef WXIOS
+USE XIOS, ONLY : XIOS_INITIALIZE
+#endif
!
#ifdef CPLOASIS
USE MOD_OASIS
@@ -63,27 +77,25 @@ INCLUDE 'mpif.h'
!* 0.1 Declarations of arguments
! -------------------------
!
-CHARACTER(LEN=28), INTENT(IN ) :: HNAMELIST
+ CHARACTER(LEN=28), INTENT(IN ) :: HNAMELIST
INTEGER, INTENT(OUT) :: KLOCAL_COMM ! value of local communicator
-CHARACTER(LEN=3), INTENT(IN ), OPTIONAL :: HINIT ! choice of fields to initialize
+ CHARACTER(LEN=3), INTENT(IN ), OPTIONAL :: HINIT ! choice of fields to initialize
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-CHARACTER(LEN=9) :: YWORD, YTIMERUN
-CHARACTER(LEN=1000):: YLINE, YFOUND
+ CHARACTER(LEN=9) :: YWORD, YTIMERUN
+ CHARACTER(LEN=1000):: YLINE, YFOUND
INTEGER :: IERR, IWORK, IRANK
INTEGER :: ICOMP_ID
INTEGER :: ITIMERUN
LOGICAL :: GFOUND
-CHARACTER(LEN=3) :: YINIT
+ CHARACTER(LEN=3) :: YINIT
!
!
!* 0.3 Declarations of namelist variables
! ----------------------------------
!
-CHARACTER(LEN=6) :: CMODEL_NAME ! component model name
-!
NAMELIST/NAM_OASIS/LOASIS,LOASIS_GRID,CMODEL_NAME
!
!-------------------------------------------------------------------------------
@@ -95,7 +107,7 @@ NAMELIST/NAM_OASIS/LOASIS,LOASIS_GRID,CMODEL_NAME
!
LOASIS = .FALSE.
LOASIS_GRID = .FALSE.
-CMODEL_NAME = 'surfex'
+ CMODEL_NAME = 'surfex'
XRUNTIME = 0.0
!
YINIT = 'ALL'
@@ -111,138 +123,168 @@ IF(LEN_TRIM(HNAMELIST)/=0)THEN
OPEN(UNIT=11,FILE=HNAMELIST,ACTION='READ',FORM="FORMATTED",POSITION="REWIND",STATUS='OLD',IOSTAT=IERR)
!
IF (IERR /= 0) THEN
- WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- WRITE(*,'(2A)')'SFX_OASIS_INIT: SFX NAMELIST NOT FOUND: ',TRIM(HNAMELIST)
- WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- CALL ABORT
- STOP
+ WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ WRITE(*,'(A)' )' WARNING WARNING WARNING WARNING WARNING '
+ WRITE(*,'(A)' )' --------------------------------------- '
+ WRITE(*,'(2A)')'SFX_OASIS_INIT: SFX NAMELIST FILE NOT FOUND: ',TRIM(HNAMELIST)
+ WRITE(*,'(A)' )'------------------------------------------- '
+ WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+#ifndef SFX_ARO
+ CALL ABORT
+ STOP
+#endif
+ ELSE
+ READ (UNIT=11,NML=NAM_OASIS,IOSTAT=IERR)
+ CLOSE(UNIT=11)
ENDIF
+ !
+ENDIF
!
- READ (UNIT=11,NML=NAM_OASIS,IOSTAT=IERR)
+!-------------------------------------------------------------------------------
!
- CLOSE(UNIT=11)
+!* 2. Setup OASIS (possibly via XIOS) and XIOS
+! ----------------------------------------
!
-ENDIF
+IF (LXIOS) THEN
!
-!-------------------------------------------------------------------------------
!
-!* 2. Setup OASIS
-! -----------
+#ifdef WXIOS
+ ! NOTE : XIOS_INITIALIZE will call OASIS_INIT_COMP and
+ ! OASIS_GET_LOCALCOMM if its own config file calls for Oasis
+!$OMP SINGLE
+ CALL XIOS_INITIALIZE(CMODEL_NAME, return_comm=KLOCAL_COMM)
+!$OMP END SINGLE
!
-IF(LOASIS)THEN
+#else
+!
+ WRITE(*,*) 'SFX_OASIS_INIT : BINARY WAS NOT COMPILED WITH XIOS SUPPORT '
+ CALL ABOR1_SFX('SFX_OASIS_INIT : BINARY WAS NOT COMPILED WITH XIOS SUPPORT')
!
-#ifdef CPLOASIS
- CALL OASIS_INIT_COMP(ICOMP_ID,CMODEL_NAME,IERR)
- IF (IERR/=OASIS_OK) THEN
- WRITE(*,'(A)' )'SFX : Error initializing OASIS'
- WRITE(*,'(A,I4)')'SFX : Return code from oasis_init_comp : ',IERR
- CALL OASIS_ABORT(ICOMP_ID,CMODEL_NAME,'SFX_OASIS_INIT: Error initializing OASIS')
- CALL ABORT
- STOP
- ENDIF
- CALL MPI_COMM_RANK(MPI_COMM_WORLD,IRANK,IWORK)
#endif
!
- IF(IRANK==0)THEN
- WRITE(*,'(A)')'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- WRITE(*,'(A)')'OASIS used for model : ',TRIM(CMODEL_NAME)
- WRITE(*,'(A)')'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- ENDIF
!
-ELSE
+ELSE ! (i.e. .NOT. LXIOS)
!
+#ifdef CPLOASIS
+
+ IF (LOASIS ) THEN
+ IRANK=0
+ CALL OASIS_INIT_COMP(ICOMP_ID,CMODEL_NAME,IERR)
+ IF (IERR/=OASIS_OK) THEN
+ WRITE(*,'(A)' )'SFX : Error initializing OASIS'
+ WRITE(*,'(A,I4)')'SFX : Return code from oasis_init_comp : ',IERR
+ CALL OASIS_ABORT(ICOMP_ID,CMODEL_NAME,'SFX_OASIS_INIT: Error initializing OASIS')
+ CALL ABORT
+ STOP
+ ENDIF
+ CALL OASIS_GET_LOCALCOMM(KLOCAL_COMM,IERR)
+ IF (IERR/=OASIS_OK) THEN
+ IF(IRANK==0)THEN
+ WRITE(*,'(A)' )'SFX : Error getting local communicator from OASIS'
+ WRITE(*,'(A,I4)')'SFX : Return code from oasis_get_local_comm : ',IERR
+ ENDIF
+ CALL OASIS_ABORT(ICOMP_ID,CMODEL_NAME,'SFX_OASIS_INIT: Error getting local communicator')
+ CALL ABORT
+ STOP
+ ENDIF
+!
+ ELSE
+ KLOCAL_COMM=0
+ RETURN
+ ENDIF
+
+#else
+
KLOCAL_COMM=0
RETURN
+
+#endif
!
ENDIF
-!-------------------------------------------------------------------------------
!
-!* 4. Get local communicator
-! ----------------------
+#ifdef SFX_MPI
+CALL MPI_COMM_RANK(KLOCAL_COMM,IRANK,IWORK)
+#endif
+IF(IRANK==0)THEN
+ WRITE(*,'(A)')'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ IF (LOASIS) WRITE(*,'(A)')'OASIS used for model : '//TRIM(CMODEL_NAME)
+ IF (LXIOS) WRITE(*,'(A)')'XIOS used for model : '//TRIM(CMODEL_NAME)
+ WRITE(*,'(A)')'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ENDIF
!
-#ifdef CPLOASIS
-CALL OASIS_GET_LOCALCOMM(KLOCAL_COMM,IERR)
-IF (IERR/=OASIS_OK) THEN
- IF(IRANK==0)THEN
- WRITE(*,'(A)' )'SFX : Error getting local communicator from OASIS'
- WRITE(*,'(A,I4)')'SFX : Return code from oasis_get_local_comm : ',IERR
- ENDIF
- CALL OASIS_ABORT(ICOMP_ID,CMODEL_NAME,'SFX_OASIS_INIT: Error getting local communicator')
- CALL ABORT
- STOP
+IF(YINIT=='PRE')THEN
+ RETURN
ENDIF
-#endif
+
+#ifdef CPLOASIS
+IF (LOASIS) THEN
!
!-------------------------------------------------------------------------------
!
-!
-IF(YINIT=='PRE')THEN
- RETURN
-ENDIF
-!
!* 5. Read total simulated time in namcouple
! --------------------------------------
!
-OPEN (UNIT=11,FILE ='namcouple',STATUS='OLD',FORM ='FORMATTED',POSITION="REWIND",IOSTAT=IERR)
-IF (IERR /= 0) THEN
- IF(IRANK==0)THEN
- WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- WRITE(*,'(A)' )'SFX : OASIS namcouple not found'
- WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- ENDIF
- CALL ABORT
- STOP
-ENDIF
-!
-YTIMERUN=' $RUNTIME'
-ITIMERUN=-1
-!
-DO WHILE (ITIMERUN==-1)
- READ (UNIT = 11,FMT = '(A9)',IOSTAT=IERR) YWORD
- IF(IERR/=0)THEN
- IF(IRANK==0)THEN
- WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- WRITE(*,'(A)' )'SFX : Problem $RUNTIME empty in namcouple'
- WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- ENDIF
- CALL ABORT
- STOP
- ENDIF
- IF (YWORD==YTIMERUN)THEN
- READ (UNIT = 11,FMT = '(A1000)',IOSTAT=IERR) YLINE
- IF(IERR/=0)THEN
- IF(IRANK==0)THEN
- WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- WRITE(*,'(A)' )'SFX : Problem looking for $RUNTIME in namcouple'
- WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- ENDIF
- CALL ABORT
- STOP
- ENDIF
- CALL FOUND_TIMERUN (YLINE, YFOUND, 1000, GFOUND)
- IF (GFOUND) THEN
+ OPEN (UNIT=11,FILE ='namcouple',STATUS='OLD',FORM ='FORMATTED',POSITION="REWIND",IOSTAT=IERR)
+ IF (IERR /= 0) THEN
+ IF(IRANK==0)THEN
+ WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ WRITE(*,'(A)' )'SFX : OASIS namcouple not found'
+ WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ ENDIF
+ CALL ABORT
+ STOP
+ ENDIF
+!
+ YTIMERUN=' $RUNTIME'
+ ITIMERUN=-1
+!
+ DO WHILE (ITIMERUN==-1)
+ READ (UNIT = 11,FMT = '(A9)',IOSTAT=IERR) YWORD
+ IF(IERR/=0)THEN
+ IF(IRANK==0)THEN
+ WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ WRITE(*,'(A)' )'SFX : Problem $RUNTIME empty in namcouple'
+ WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ ENDIF
+ CALL ABORT
+ STOP
+ ENDIF
+ IF (YWORD==YTIMERUN)THEN
+ READ (UNIT = 11,FMT = '(A1000)',IOSTAT=IERR) YLINE
+ IF(IERR/=0)THEN
+ IF(IRANK==0)THEN
+ WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ WRITE(*,'(A)' )'SFX : Problem looking for $RUNTIME in namcouple'
+ WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ ENDIF
+ CALL ABORT
+ STOP
+ ENDIF
+ CALL FOUND_TIMERUN (YLINE, YFOUND, 1000, GFOUND)
+ IF (GFOUND) THEN
READ (YFOUND,FMT = '(I100)',IOSTAT=IERR) ITIMERUN
IF(IERR/=0)THEN
- IF(IRANK==0)THEN
- WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- WRITE(*,'(A)' )'SFX : Problem reading $RUNTIME in namcouple'
- WRITE(*,'(2A)' )'$RUNTIME = ', TRIM(YFOUND)
- WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- ENDIF
- CALL ABORT
- STOP
+ IF(IRANK==0)THEN
+ WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ WRITE(*,'(A)' )'SFX : Problem reading $RUNTIME in namcouple'
+ WRITE(*,'(2A)' )'$RUNTIME = ', TRIM(YFOUND)
+ WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ ENDIF
+ CALL ABORT
+ STOP
ENDIF
- ENDIF
- ENDIF
-ENDDO
-CLOSE(11)
+ ENDIF
+ ENDIF
+ ENDDO
+ CLOSE(11)
!
-XRUNTIME = REAL(ITIMERUN)
+ XRUNTIME = REAL(ITIMERUN)
!
-WRITE(*,'(A)' )'-----------------------------'
+ENDIF
+#endif
!
!-------------------------------------------------------------------------------
-CONTAINS
+ CONTAINS
!-------------------------------------------------------------------------------
!
SUBROUTINE FOUND_TIMERUN(HIN, HOUT, KLEN, OFOUND)
@@ -250,17 +292,17 @@ SUBROUTINE FOUND_TIMERUN(HIN, HOUT, KLEN, OFOUND)
IMPLICIT NONE
!
INTEGER , INTENT (IN ) :: KLEN
-CHARACTER (LEN=*), INTENT (INOUT) :: HIN
-CHARACTER (LEN=*), INTENT (INOUT) :: HOUT
+ CHARACTER (LEN=*), INTENT (INOUT) :: HIN
+ CHARACTER (LEN=*), INTENT (INOUT) :: HOUT
LOGICAL, INTENT (OUT ) :: OFOUND
!
!* ---------------------------- Local declarations -------------------
!
-CHARACTER(LEN=1), PARAMETER :: YBLANK = ' '
-CHARACTER(LEN=1), PARAMETER :: YNADA = '#'
+ CHARACTER(LEN=1), PARAMETER :: YBLANK = ' '
+ CHARACTER(LEN=1), PARAMETER :: YNADA = '#'
-CHARACTER(LEN=KLEN) :: YLINE
-CHARACTER(LEN=KLEN) :: YWORK
+ CHARACTER(LEN=KLEN) :: YLINE
+ CHARACTER(LEN=KLEN) :: YWORK
!
INTEGER :: ILEN
INTEGER :: IERR
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/sfx_oasis_read_nam.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/sfx_oasis_read_nam.F90
index 67d95fc476e67e23f85ccee5f102798a5977d7b8..c1b5b596df7dba6138354948c8b3ac1e16a82ec8 100755
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/sfx_oasis_read_nam.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/sfx_oasis_read_nam.F90
@@ -32,6 +32,7 @@ SUBROUTINE SFX_OASIS_READ_NAM(HPROGRAM,PTSTEP_SURF,HINIT)
!! MODIFICATIONS
!! -------------
!! Original 05/2008
+!! 10/2016 B. Decharme : bug surface/groundwater coupling
!! Modified 11/2014 : J. Pianezze - add wave coupling parameters
!! and surface pressure for ocean coupling
!-------------------------------------------------------------------------------
@@ -44,8 +45,7 @@ USE MODN_SFX_OASIS
USE MODD_SFX_OASIS, ONLY : LOASIS, XRUNTIME, &
LCPL_LAND, LCPL_GW, LCPL_FLOOD, &
LCPL_CALVING, LCPL_LAKE, &
- LCPL_SEA, LCPL_SEAICE, &
- LCPL_WAVE
+ LCPL_SEA, LCPL_SEAICE, LCPL_WAVE
!
USE MODE_POS_SURF
!
@@ -65,7 +65,7 @@ IMPLICIT NONE
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
REAL, INTENT(IN) :: PTSTEP_SURF ! Surfex time step
-CHARACTER(LEN=3), INTENT(IN), OPTIONAL :: HINIT ! choice of fields to initialize
+CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HINIT ! choice of fields to initialize
!
!* 0.2 Declarations of local parameter
! -------------------------------
@@ -145,7 +145,7 @@ ELSE
WRITE(ILUOUT,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
ENDIF
!
- CALL POSNAM(ILUNAM,'NAM_SFX_LAKE_CPL',GFOUND,ILUOUT)
+CALL POSNAM(ILUNAM,'NAM_SFX_LAKE_CPL',GFOUND,ILUOUT)
!
IF (GFOUND) THEN
READ(UNIT=ILUNAM,NML=NAM_SFX_LAKE_CPL)
@@ -234,18 +234,12 @@ IF(LCPL_LAND)THEN
!
! Particular case due to water table depth / surface coupling
!
- IF(LEN_TRIM(CWTD)>0.OR.LEN_TRIM(CFWTD)>0.OR.LEN_TRIM(CRECHARGE)>0)THEN
+ IF(LEN_TRIM(CWTD)>0.OR.LEN_TRIM(CFWTD)>0)THEN
LCPL_GW = .TRUE.
ENDIF
!
IF(LCPL_GW)THEN
!
-! Output variable
-!
- YKEY ='CRECHARGE'
- YCOMMENT='Groundwater recharge'
- CALL CHECK_FIELD(CRECHARGE,YKEY,YCOMMENT,YLAND,KOUT)
-!
! Input variable
!
YKEY ='CWTD'
@@ -537,7 +531,7 @@ IF(LEN_TRIM(HFIELD)==0)THEN
CASE(YSEA)
YNAMELIST='NAM_SFX_SEA_CPL'
CASE(YLAKE)
- YNAMELIST='NAM_SFX_LAKE_CPL'
+ YNAMELIST='NAM_SFX_LAKE_CPL'
CASE(YWAVE)
YNAMELIST='NAM_SFX_WAVE_CPL'
CASE DEFAULT
@@ -550,8 +544,8 @@ IF(LEN_TRIM(HFIELD)==0)THEN
WRITE(ILUOUT,*)TRIM(YCOMMENT1)
WRITE(ILUOUT,*)TRIM(YCOMMENT2)
!
-! For oceanic and wave coupling do not stop the model if a field from surfex to ocean/wave is
-! not done because many particular case can be used
+! For oceanic coupling do not stop the model if a field from surfex to ocean is
+! not done because many particular case can be used
!
IF((KID==0.OR.KID==1).AND.HTYP/=YLAND)THEN
LSTOP=.FALSE.
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/sfx_oasis_recv.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/sfx_oasis_recv.F90
index bb174e0319ec7dcd5e7c3dcd1bcb747da40f19e3..8aa18215e9c2c9215bcdc6835e5392087c62bf91 100755
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/sfx_oasis_recv.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/sfx_oasis_recv.F90
@@ -40,7 +40,7 @@ SUBROUTINE SFX_OASIS_RECV(HPROGRAM,KI,KSW,PTIMEC, &
!! -------------
!! Original 10/2013
!! Modified 11/2014 : J. Pianezze - add wave coupling parameters
-!!
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -50,8 +50,6 @@ USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
!
USE MODD_SFX_OASIS
!
-USE MODD_SGH_PAR, ONLY :
-!
USE MODI_GET_LUOUT
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -232,7 +230,6 @@ IF(ORECV_SEA)THEN
ENDIF
!
ENDIF
-!
!-------------------------------------------------------------------------------
!
!* 4. Get Wave variables :
@@ -305,7 +302,7 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KLUOUT
INTEGER, INTENT(IN) :: KERR
- CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT
+CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/sfx_oasis_send.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/sfx_oasis_send.F90
index 013350350f299943eea681e66d60b3df22b1989b..6d20b477c2be3f3a1710c43b12bb6a02930ee04e 100755
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/sfx_oasis_send.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/sfx_oasis_send.F90
@@ -4,13 +4,13 @@
!SFX_LIC for details. version 1.
!#########
SUBROUTINE SFX_OASIS_SEND(KLUOUT,KI,KDATE,OSEND_LAND,OSEND_LAKE,OSEND_SEA,OSEND_WAVE, &
- PLAND_RUNOFF,PLAND_DRAIN,PLAND_CALVING,PLAND_RECHARGE,&
+ PLAND_RUNOFF,PLAND_DRAIN,PLAND_CALVING, &
PLAND_SRCFLOOD, &
PLAKE_EVAP,PLAKE_RAIN,PLAKE_SNOW,PLAKE_WATF, &
PSEA_FWSU,PSEA_FWSV,PSEA_HEAT,PSEA_SNET,PSEA_WIND, &
PSEA_FWSM,PSEA_EVAP,PSEA_RAIN,PSEA_SNOW,PSEA_EVPR, &
PSEA_WATF,PSEA_PRES,PSEAICE_HEAT,PSEAICE_SNET, &
- PSEAICE_EVAP,PWAVE_U10,PWAVE_V10 )
+ PSEAICE_EVAP,PWAVE_U10,PWAVE_V10 )
!###########################################
!
!!**** *SFX_OASIS_SEND* - Send coupling fields
@@ -45,6 +45,7 @@ SUBROUTINE SFX_OASIS_SEND(KLUOUT,KI,KDATE,OSEND_LAND,OSEND_LAKE,OSEND_SEA,OSEND_
!! Original 10/2013
!! Modified 11/2014 : J. Pianezze - add wave coupling parameters
!! and surface pressure for ocean coupling
+!! 10/2016 B. Decharme : bug surface/groundwater coupling
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -82,7 +83,6 @@ LOGICAL, INTENT(IN) :: OSEND_WAVE
REAL, DIMENSION(KI), INTENT(IN) :: PLAND_RUNOFF ! Cumulated Surface runoff (kg/m2)
REAL, DIMENSION(KI), INTENT(IN) :: PLAND_DRAIN ! Cumulated Deep drainage (kg/m2)
REAL, DIMENSION(KI), INTENT(IN) :: PLAND_CALVING ! Cumulated Calving flux (kg/m2)
-REAL, DIMENSION(KI), INTENT(IN) :: PLAND_RECHARGE ! Cumulated Recharge to groundwater (kg/m2)
REAL, DIMENSION(KI), INTENT(IN) :: PLAND_SRCFLOOD ! Cumulated flood freshwater flux (kg/m2)
!
REAL, DIMENSION(KI), INTENT(IN) :: PLAKE_EVAP ! Cumulated Evaporation (kg/m2)
@@ -156,13 +156,6 @@ IF(OSEND_LAND)THEN
CALL OASIS_PUT(NCALVING_ID,KDATE,ZWRITE(:,:),IERR)
CALL CHECK_SFX_SEND(KLUOUT,IERR,YCOMMENT,ZWRITE(:,1))
ENDIF
-!
- IF(LCPL_GW)THEN
- YCOMMENT='groundwater recharge over land'
- CALL OUTVAR(PLAND_RECHARGE,XTSTEP_CPL_LAND,ZWRITE(:,1))
- CALL OASIS_PUT(NRECHARGE_ID,KDATE,ZWRITE(:,:),IERR)
- CALL CHECK_SFX_SEND(KLUOUT,IERR,YCOMMENT,ZWRITE(:,1))
- ENDIF
!
IF(LCPL_FLOOD)THEN
YCOMMENT='flood freshwater flux over land (P-E-I)'
@@ -372,7 +365,7 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KLUOUT
INTEGER, INTENT(IN) :: KERR
- CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT
+CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT
!
REAL, DIMENSION(:), INTENT(OUT):: PWRITE
!
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/write_lcover.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/write_lcover.F90
index 33061c51bec2ef79eaed351a654a7a3fa18f27f4..32a1be568e9eb8aac8db7094671173300b7423fa 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/write_lcover.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/write_lcover.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_LCOVER(DGU,U,HPROGRAM,OCOVER)
+ SUBROUTINE WRITE_LCOVER(HSELECT,HPROGRAM,OCOVER)
! ################################
!
!!**** *READ_LCOVER* - routine to write a file for
@@ -47,8 +47,6 @@ USE MODD_VAR_ll, ONLY : NMNH_COMM_WORLD
#endif
!
USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODI_WRITE_SURF
!
@@ -57,21 +55,22 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+#ifdef MNH_PARALLEL
#ifndef NOMPI
INCLUDE "mpif.h"
#endif
+#endif
!
!* 0.1 Declarations of arguments
! -------------------------
!
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
LOGICAL, DIMENSION(JPCOVER) :: OCOVER ! list of covers
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
INTEGER :: IRESP ! Error code after reading
CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
CHARACTER(LEN=100):: YCOMMENT ! Comment string
@@ -83,17 +82,15 @@ INTEGER :: IINFO
!
!* ascendant compatibility
IF (LHOOK) CALL DR_HOOK('WRITE_LCOVER',0,ZHOOK_HANDLE)
-#ifndef NOMPI
#ifdef MNH_PARALLEL
+#ifndef NOMPI
CALL MPI_ALLREDUCE(OCOVER, GCOVER, SIZE(OCOVER),MPI_LOGICAL, MPI_LOR, NMNH_COMM_WORLD, IINFO)
-#else
-CALL MPI_ALLREDUCE(OCOVER, GCOVER, SIZE(OCOVER),MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, IINFO)
+OCOVER(:)=GCOVER(:)
#endif
#endif
-OCOVER(:)=GCOVER(:)
YRECFM='COVER_LIST'
YCOMMENT='(LOGICAL LIST)'
-CALL WRITE_SURF(DGU,U,HPROGRAM,YRECFM,OCOVER(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,OCOVER(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
!
IF (LHOOK) CALL DR_HOOK('WRITE_LCOVER',1,ZHOOK_HANDLE)
!
diff --git a/src/ARCH_SRC/CPL_WAVE/SURFEX/writesurf_seafluxn.F90 b/src/ARCH_SRC/CPL_WAVE/SURFEX/writesurf_seafluxn.F90
index eb75fefa46c5c281ea90503518f3fb488c74dd0f..69bb0a844d4362d66800fafdd4cbce380cf3f649 100644
--- a/src/ARCH_SRC/CPL_WAVE/SURFEX/writesurf_seafluxn.F90
+++ b/src/ARCH_SRC/CPL_WAVE/SURFEX/writesurf_seafluxn.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITESURF_SEAFLUX_n (DGU, U, &
- O, OR, S, &
- HPROGRAM)
+ SUBROUTINE WRITESURF_SEAFLUX_n (HSELECT, O, OR, S, HPROGRAM)
! ########################################
!
!!**** *WRITE_SEAFLUX_n* - writes SEAFLUX fields
@@ -37,6 +35,7 @@
!! Modified 01/2014 : S. Senesi : handle seaice scheme
!! S. Belamari 03/2014 Include sea surface salinity XSSS
!! R. Séférian 01/2015 : introduce interactive ocean surface albedo
+!! S. Senesi 08/2015 : fix units in some HCOMMENTs
!! Modified 03/2014 : M.N. Bouin ! possibility of wave parameters
!! ! from external source
!! Modified 11/2014 : J. Pianezze ! add currents and charnock coefficient
@@ -46,11 +45,6 @@
! ------------
!
!
-!
-!
-!
-!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODD_OCEAN_n, ONLY : OCEAN_t
@@ -61,7 +55,7 @@ USE MODD_SFX_OASIS, ONLY : LCPL_WAVE, LCPL_SEA
!
USE MODI_WRITE_SURF
USE MODI_WRITESURF_OCEAN_n
-USE MODI_WRITESURF_SEAICE_N
+USE MODI_WRITESURF_SEAICE_n
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -71,10 +65,7 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
TYPE(OCEAN_t), INTENT(INOUT) :: O
TYPE(OCEAN_REL_t), INTENT(INOUT) :: OR
@@ -99,9 +90,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('WRITESURF_SEAFLUX_N',0,ZHOOK_HANDLE)
!
- CALL WRITESURF_OCEAN_n(DGU, U, &
- O, OR, &
- HPROGRAM)
+ CALL WRITESURF_OCEAN_n(HSELECT, O, OR, HPROGRAM)
!
!* 2. Sea-ice prognostic fields:
! --------------------------
@@ -109,12 +98,9 @@ IF (LHOOK) CALL DR_HOOK('WRITESURF_SEAFLUX_N',0,ZHOOK_HANDLE)
!* flag to tell if Sea Ice model is used
!
YCOMMENT='flag to handle sea ice cover'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'HANDLE_SIC',S%LHANDLE_SIC,IRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,'HANDLE_SIC',S%LHANDLE_SIC,IRESP,YCOMMENT)
!
-IF (S%LHANDLE_SIC) CALL WRITESURF_SEAICE_n(DGU, U, &
- S, &
- HPROGRAM)
+IF (S%LHANDLE_SIC) CALL WRITESURF_SEAICE_n(HSELECT, S, HPROGRAM)
!
!
!* 3. Prognostic fields:
@@ -129,17 +115,15 @@ IF(S%LINTERPOL_SST)THEN
DO JMTH=1,INMTH
WRITE(YMTH,'(I2)') (JMTH-1)
YRECFM='SST_MTH'//ADJUSTL(YMTH(:LEN_TRIM(YMTH)))
- YCOMMENT='SST at month t'//ADJUSTL(YMTH(:LEN_TRIM(YMTH)))
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,S%XSST_MTH(:,JMTH),IRESP,HCOMMENT=YCOMMENT)
+ YCOMMENT='SST at month t'//ADJUSTL(YMTH(:LEN_TRIM(YMTH)))//' (K)'
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,S%XSST_MTH(:,JMTH),IRESP,HCOMMENT=YCOMMENT)
ENDDO
!
ENDIF
!
YRECFM='SST'
-YCOMMENT='SST'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,S%XSST(:),IRESP,HCOMMENT=YCOMMENT)
+YCOMMENT='SST (K)'
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,S%XSST(:),IRESP,HCOMMENT=YCOMMENT)
!
!-------------------------------------------------------------------------------
!
@@ -150,22 +134,19 @@ YCOMMENT='SST'
!
YRECFM='Z0SEA'
YCOMMENT='Z0SEA (m)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,S%XZ0(:),IRESP,HCOMMENT=YCOMMENT)
-!
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,S%XZ0(:),IRESP,HCOMMENT=YCOMMENT)
+ !
!* significant height
!
YRECFM='HS'
YCOMMENT='HS (m)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,S%XHS(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,S%XHS(:),IRESP,HCOMMENT=YCOMMENT)
!
!* peak period
!
YRECFM='TP'
YCOMMENT='TP (s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,S%XTP(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,S%XTP(:),IRESP,HCOMMENT=YCOMMENT)
!
!
IF (LCPL_WAVE) THEN
@@ -174,26 +155,23 @@ IF (LCPL_WAVE) THEN
!
YRECFM='CHARN'
YCOMMENT='CHARN (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,S%XCHARN(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,S%XCHARN(:),IRESP,HCOMMENT=YCOMMENT)
!
END IF
-
+!
IF (LCPL_WAVE .OR. LCPL_SEA) THEN
!
!* u-current velocity
!
YRECFM='UMER'
YCOMMENT='UMER (m/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,S%XUMER(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,S%XUMER(:),IRESP,HCOMMENT=YCOMMENT)
!
!* v-current velocity
!
YRECFM='VMER'
YCOMMENT='VMER (m/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,S%XVMER(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,S%XVMER(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
@@ -206,17 +184,15 @@ IF(S%LINTERPOL_SSS)THEN
DO JMTH=1,INMTH
WRITE(YMTH,'(I2)') (JMTH-1)
YRECFM='SSS_MTH'//ADJUSTL(YMTH(:LEN_TRIM(YMTH)))
- YCOMMENT='Sea Surface Salinity at month t'//ADJUSTL(YMTH(:LEN_TRIM(YMTH)))
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,S%XSSS_MTH(:,JMTH),IRESP,HCOMMENT=YCOMMENT)
+ YCOMMENT='Sea Surface Salinity at month t'//ADJUSTL(YMTH(:LEN_TRIM(YMTH)))//' (psu)'
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,S%XSSS_MTH(:,JMTH),IRESP,HCOMMENT=YCOMMENT)
ENDDO
!
ENDIF
!
YRECFM='SSS'
-YCOMMENT='Sea Surface Salinity'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,S%XSSS(:),IRESP,HCOMMENT=YCOMMENT)
+YCOMMENT='Sea Surface Salinity (psu)'
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,S%XSSS(:),IRESP,HCOMMENT=YCOMMENT)
!
!
!* ocean surface albedo (direct and diffuse fraction)
@@ -225,13 +201,11 @@ IF(S%CSEA_ALB=='RS14')THEN
!
YRECFM='OSA_DIR'
YCOMMENT='direct ocean surface albedo (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,S%XDIR_ALB(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,S%XDIR_ALB(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='OSA_SCA'
YCOMMENT='diffuse ocean surface albedo (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,S%XSCA_ALB(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,S%XSCA_ALB(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
@@ -242,8 +216,8 @@ ENDIF
!
YRECFM='DTCUR'
YCOMMENT='s'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,S%TTIME,IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,S%TTIME,IRESP,HCOMMENT=YCOMMENT)
+!
IF (LHOOK) CALL DR_HOOK('WRITESURF_SEAFLUX_N',1,ZHOOK_HANDLE)
!
!
diff --git a/src/ARCH_SRC/surfex/dummy_topd.F90 b/src/ARCH_SRC/surfex/dummy_topd.F90
index 2cc918df64fd871d2d73073367cae022624c60f7..2f35ab71a5b0ea22bf2066595c087cfe6f84f4c6 100644
--- a/src/ARCH_SRC/surfex/dummy_topd.F90
+++ b/src/ARCH_SRC/surfex/dummy_topd.F90
@@ -107,17 +107,26 @@ END MODULE MODD_TOPODYN
! ######################
! ######################
! ######################
-SUBROUTINE INIT_SURF_TOPD(DGEI, I, UG, U,HPROGRAM,KI)
+SUBROUTINE INIT_SURF_TOPD(DEC, IO, S, K, NP, NPE, UG, U, HPROGRAM, KI)
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_NP_t, ISBA_NPE_t
+!
USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
-USE MODD_ISBA_n, ONLY : ISBA_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DGEI
-TYPE(ISBA_t), INTENT(INOUT) :: I
+!
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEC
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-CHARACTER(LEN=*), INTENT(IN) :: HPROGRAM !
-INTEGER, INTENT(IN) :: KI ! grid dimension
+!
+ CHARACTER(LEN=*), INTENT(IN) :: HPROGRAM !
+INTEGER, INTENT(IN) :: KI
+!
END SUBROUTINE INIT_SURF_TOPD
SUBROUTINE ISBA_TO_TOPD(PVARI,PVART)
@@ -127,37 +136,48 @@ END SUBROUTINE ISBA_TO_TOPD
! ######################
! ######################
! ######################
-SUBROUTINE COUPLING_SURF_TOPD (DGEI, DGMI, IG, I, UG, U,HPROGRAM,KI)
+SUBROUTINE COUPLING_SURF_TOPD (DE, DEC, DC, DMI, G, IO, S, K, NK, NP, NPE, UG, U,HPROGRAM,KI)
+USE MODD_DIAG_n, ONLY : DIAG_t
USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_NK_t, ISBA_NP_t, ISBA_NPE_t
+!
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DGEI
-TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DGMI
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
+!
+TYPE(DIAG_t), INTENT(INOUT) :: DC
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DE
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEC
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMI
+TYPE(GRID_t), INTENT(INOUT) :: G
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_NK_t), INTENT(INOUT) :: NK
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENt(INOUT) :: NPE
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
INTEGER, INTENT(IN) :: KI ! Surfex grid dimension
END SUBROUTINE COUPLING_SURF_TOPD
! ######################
! ######################
! ######################
-SUBROUTINE PGD_TOPD(I, UG, U, USS,HPROGRAM)
-
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-CHARACTER(LEN=*), INTENT(IN) :: HPROGRAM
+SUBROUTINE PGD_TOPD(HISBA, HGRID, PGRID_PAR, KDIM_FULL, PSSO_SLOPE, HPROGRAM)
+!
+ CHARACTER(LEN=*), INTENT(IN) :: HISBA
+ CHARACTER(LEN=*), INTENT(IN) :: HGRID
+REAL, DIMENSION(:), INTENT(IN) :: PGRID_PAR
+ INTEGER, INTENT(IN) :: KDIM_FULL
+ REAL, DIMENSION(:), INTENT(INOUT) :: PSSO_SLOPE
+!
+CHARACTER(LEN=*), INTENT(IN) :: HPROGRAM !
+
END SUBROUTINE PGD_TOPD
! ######################
! ######################
diff --git a/src/LIB/SURCOUCHE/src/mode_field.f90 b/src/LIB/SURCOUCHE/src/mode_field.f90
index f1efda9ef784a66032bd661bcec70df26d245f7e..2ba86e49f8df640c8209b0bb1c0456d2d16171aa 100644
--- a/src/LIB/SURCOUCHE/src/mode_field.f90
+++ b/src/LIB/SURCOUCHE/src/mode_field.f90
@@ -4,12 +4,12 @@
!MNH_LIC for details. version 1.
MODULE MODE_FIELD
!
-USE MODD_CONF, ONLY : CPROGRAM
-USE MODD_IO_ll, ONLY : NVERB_DEBUG,NVERB_INFO,NVERB_WARNING,NVERB_ERROR,NVERB_FATAL
+USE MODD_CONF, ONLY : CPROGRAM
+USE MODD_IO_ll, ONLY : NVERB_DEBUG,NVERB_INFO,NVERB_WARNING,NVERB_ERROR,NVERB_FATAL
USE MODD_PARAMETERS
-USE MODD_TYPE_DATE
+USE MODD_TYPE_DATE, ONLY : DATE_TIME
#if defined(MNH_IOCDF4)
-USE NETCDF, ONLY : NF90_FILL_INT, NF90_FILL_REAL
+USE NETCDF, ONLY : NF90_FILL_INT, NF90_FILL_REAL
#endif
!
USE MODE_MSG
diff --git a/src/LIB/SURCOUCHE/src/mode_io.f90 b/src/LIB/SURCOUCHE/src/mode_io.f90
index 44511781bf3f6ed8c6e221bbd904dd4263e9bf6b..362b5c49cfe7fc5857dd8a05725eb81195cff742 100644
--- a/src/LIB/SURCOUCHE/src/mode_io.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io.f90
@@ -403,7 +403,15 @@ CONTAINS
#else
#if defined(MNH_SX5) || defined(MNH_SP4) || defined(NAGf95) || defined(MNH_LINUX)
!JUAN : 31/03/2000 modif pour acces direct
- IF (YACCESS=='DIRECT') THEN
+ IF (YACCESS=='STREAM') THEN
+ OPEN(UNIT=TPFILE%NLU, &
+ FILE=TRIM(TPFILE%CNAME),&
+ STATUS=YSTATUS, &
+ ACCESS=YACCESS, &
+ IOSTAT=IOS, &
+ FORM=YFORM, &
+ ACTION=YACTION)
+ ELSEIF (YACCESS=='DIRECT') THEN
OPEN(UNIT=TPFILE%NLU, &
FILE=TRIM(TPFILE%CNAME),&
STATUS=YSTATUS, &
diff --git a/src/LIB/SURCOUCHE/src/mode_netcdf.f90 b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
index f1daa1739699703530d002b2197d0f4d68627454..29cd0f9b2e023142693c5757fe98c83aa4259fc0 100644
--- a/src/LIB/SURCOUCHE/src/mode_netcdf.f90
+++ b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
@@ -4,7 +4,8 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! Modifications:
-! P. Wautelet : may 2016: use NetCDF Fortran module
+! P. Wautelet : may 2016 : use NetCDF Fortran module
+! J.Escobar : 14/12/2017 : Correction for MNH_INT=8
!-----------------------------------------------------------------
!-----------------------------------------------------------------
#if defined(MNH_IOCDF4)
@@ -1440,7 +1441,7 @@ CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
IF (STATUS /= NF90_NOERR) THEN
! Define the scalar variable
-#ifndef MNH_INT8
+#if ( MNH_INT == 4 )
STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT, IVARID)
#else
STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT64, IVARID)
@@ -1522,7 +1523,7 @@ IF (STATUS /= NF90_NOERR) THEN
CALL FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(KFIELD),KIND=IDCDF_KIND), IVDIMS)
! Define the variable
-#ifndef MNH_INT8
+#if ( MNH_INT == 4 )
STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT, IVDIMS, IVARID)
#else
STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT64, IVDIMS, IVARID)
@@ -1582,7 +1583,7 @@ IF (STATUS /= NF90_NOERR) THEN
CALL FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(KFIELD),KIND=IDCDF_KIND), IVDIMS)
! Define the variable
-#ifndef MNH_INT8
+#if ( MNH_INT == 4 )
STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT, IVDIMS, IVARID)
#else
STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT64, IVDIMS, IVARID)
@@ -1646,7 +1647,7 @@ IF (STATUS /= NF90_NOERR) THEN
CALL FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(KFIELD),KIND=IDCDF_KIND), IVDIMS)
! Define the variable
-#ifndef MNH_INT8
+#if ( MNH_INT == 4 )
STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT, IVDIMS, IVARID)
#else
STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT64, IVDIMS, IVARID)
@@ -2748,7 +2749,7 @@ END IF
STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS)
IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_N0[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-#ifndef MNH_INT8
+#if ( MNH_INT == 4 )
IF (IDIMS == 0 .AND. (ITYPE == NF90_INT) ) THEN
#else
!Can read either 4 or 8 byte integers
@@ -2808,7 +2809,7 @@ STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=I
IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_N1[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
!NF90_INT1 is for the case a boolean was written
-#ifndef MNH_INT8
+#if ( MNH_INT == 4 )
IF (IDIMS == 1 .AND. (ITYPE == NF90_INT .OR. ITYPE == NF90_INT1) ) THEN
#else
IF (IDIMS == 1 .AND. (ITYPE == NF90_INT64 .OR. ITYPE == NF90_INT1) ) THEN
@@ -2890,7 +2891,7 @@ IF (IDIMS==3) THEN
END IF
!NF90_INT1 is for the case a boolean was written
-#ifndef MNH_INT8
+#if ( MNH_INT == 4 )
IF (IDIMS == SIZE(SHAPE(KFIELD)) .AND. (ITYPE == NF90_INT .OR. ITYPE == NF90_INT1) ) THEN
#else
IF (IDIMS == SIZE(SHAPE(KFIELD)) .AND. (ITYPE == NF90_INT64 .OR. ITYPE == NF90_INT1) ) THEN
diff --git a/src/MNH/clustering.f90 b/src/MNH/clustering.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a42562bbb7640e36ba3f9d2f2cf0702691bbba1d
--- /dev/null
+++ b/src/MNH/clustering.f90
@@ -0,0 +1,730 @@
+! ################
+ MODULE MODI_CLUSTERING
+! ################
+!
+INTERFACE
+!
+ SUBROUTINE CLUSTERING(OBOTTOMUP,OCLOUD,PFIELD,KCLUSTERIDT,KCLUSTERLVL,PCLUSTERSEC)
+!
+LOGICAL, INTENT(IN) :: OBOTTOMUP
+LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: OCLOUD
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELD
+INTEGER, DIMENSION(:,:,:), INTENT(OUT) :: KCLUSTERIDT
+INTEGER, DIMENSION(:,:,:), INTENT(OUT) :: KCLUSTERLVL
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLUSTERSEC
+!
+END SUBROUTINE CLUSTERING
+!
+END INTERFACE
+!
+END MODULE MODI_CLUSTERING
+!
+! #######################
+ SUBROUTINE CLUSTERING(OBOTTOMUP,OCLOUD,PFIELD,KCLUSTERIDT,KCLUSTERLVL,PCLUSTERSEC)
+! #######################
+ !
+!! PURPOSE
+!! -------
+!!
+!! Identify structures as 3D objects made of connected points.
+!!
+!!** METHOD
+!! ------
+!!
+!! Uses a 3D mask as input. Outputs 3D fields containing:
+!! IDT the identitdy number of each structure
+!! LVL the level from which each structure is identified
+!! SEC the section of each structure at current level
+!!
+!! Both IDT and LVL are necessary to identify unequivocally the structures.
+!!
+!! The identification is first led level by level.
+!! The connection between the levels is done after.
+!!
+!!
+!! AUTHOR
+!! ------
+!! T. Dauhut * LA *
+!! J.-P. Chaboureau * LA *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/06/13
+!! Modified 05/08/14 T. Dauhut v75
+!! Modified 10/10/14 T. Dauhut toward 3D version
+!! Modified 13/11/14 T. Dauhut adding property field analyse
+!! Modified 13/06/17 T. Dauhut to start volume scan from top
+!! Modified 04/10/17 T. Dauhut to be added to next MNH versions
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+ USE MODD_MPIF , ONLY : MPI_INTEGER
+USE MODE_ll
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODD_VAR_ll, ONLY : MPI_PRECISION, NPROC, IP, NMNH_COMM_WORLD
+USE MODD_DYN_n, ONLY : XDXHATM, XDYHATM
+!USE&
+! MPI
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+LOGICAL, INTENT(IN) :: OBOTTOMUP
+LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: OCLOUD
+REAL , DIMENSION(:,:,:), INTENT(IN) :: PFIELD
+INTEGER, DIMENSION(:,:,:), INTENT(OUT) :: KCLUSTERIDT
+INTEGER, DIMENSION(:,:,:), INTENT(OUT) :: KCLUSTERLVL
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLUSTERSEC
+!
+!* 0.2 declarations of local variables
+!
+INTEGER, PARAMETER :: JPUNDEF = 999999 ! NaN value outside clusters
+INTEGER :: IKBEG,IKEND,IKINC ! for the loop on the levels
+INTEGER :: JI,JJ,JC,JK,JH,JDI,JDJ ! loop counters
+INTEGER :: IMINI, IMIX, IMUX ! local cluster index
+INTEGER :: IIB,IJB,IIE,IJE,IKE,IXOR,IYOR ! physical bounds of local domain
+INTEGER :: IIU, IJU ! dimensions of local domain+halo
+INTEGER :: NIMAX_ll, NJMAX_ll ! dimensions of global domain
+INTEGER :: ICLUSMAX ! maximum nbr of clusters in local domain
+INTEGER :: ICPT, ICHANGES, ICPR ! local counter
+INTEGER :: ITEMPIDT,ITEMPLVL,ITEMPAFL ! temporary cluster ID, baselevel, affluent section
+REAL :: ZMESHAREA
+INTEGER, ALLOCATABLE, DIMENSION(:) :: ICLUSIND ! 1D table for local indices
+INTEGER, ALLOCATABLE, DIMENSION(:) :: ICLUSIZE ! 1D table for local cluster size in pixels
+INTEGER, ALLOCATABLE, DIMENSION(:,:) :: IMAPIND ! local 2D field pointing toward local indices
+INTEGER, ALLOCATABLE, DIMENSION(:) :: ICLUSTERIDT ! 1D table for cluster ID (need LVL to be unequivocal)
+INTEGER, ALLOCATABLE, DIMENSION(:) :: ICLUSTERLVL ! 1D table for cluster base level
+INTEGER, ALLOCATABLE, DIMENSION(:) :: IAFFLUSECTN ! 1D table for cluster affluent section
+INTEGER, DIMENSION(SIZE(KCLUSTERIDT,1),SIZE(KCLUSTERIDT,2)) :: IMAPIDT_ll,IMAPLVL_ll,IMAPAFL_ll
+REAL, DIMENSION(SIZE(KCLUSTERIDT,1),SIZE(KCLUSTERIDT,2)) :: ZMAPIDT_ll,ZMAPLVL_ll,ZMAPAFL_ll
+REAL, ALLOCATABLE, DIMENSION(:) :: ZCLUSSUMFLD ! 1D table for cluster local sum of field values
+!
+!* 0.3 declarations of variables for MPI exchanges
+!
+INTEGER :: ITOTNBR ! counter to create final tables (.GLBLIST..)
+INTEGER :: IRANK, IROOT, INFO ! for MPI subroutines
+INTEGER :: IINFO_ll ! (MNH-MPI) return code of parallel routine
+TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! (MNH-MPI) list of fields to exchange
+INTEGER, ALLOCATABLE, DIMENSION(:) :: ICLUSNBR ! 1D table for nbr of clusters in local domains
+INTEGER, ALLOCATABLE, DIMENSION(:) :: IPROCDPL ! 1D table for procs starting indices in global tables
+INTEGER, ALLOCATABLE, DIMENSION(:) :: ILOCIND ! old indices point toward new ones after optimization
+INTEGER, ALLOCATABLE, DIMENSION(:) :: ILOCLISTIDT,ILOCLISTIDT2 ! non-redundant list of local cluster IDs
+INTEGER, ALLOCATABLE, DIMENSION(:) :: ILOCLISTLVL,ILOCLISTLVL2 ! their corresponding base level
+INTEGER, ALLOCATABLE, DIMENSION(:) :: ILOCLISTSEC,ILOCLISTSEC2 ! their corresponding sections
+REAL , ALLOCATABLE, DIMENSION(:) :: ZLOCLISTFLD,ZLOCLISTFLD2 ! their corresponding field average
+INTEGER, ALLOCATABLE, DIMENSION(:) :: IGLBLISTIDT ! concatenation of local domain cluster ID lists
+INTEGER, ALLOCATABLE, DIMENSION(:) :: IGLBLISTLVL ! their corresponding base level
+INTEGER, ALLOCATABLE, DIMENSION(:) :: IGLBLISTSEC ! their corresponding sections
+REAL , ALLOCATABLE, DIMENSION(:) :: ZGLBLISTFLD ! their corresponding field average
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. INITIALISATION
+! --------------
+!
+INFO = -1
+IROOT = 0
+CALL MPI_COMM_RANK(NMNH_COMM_WORLD, IRANK, INFO) ! get the rank of the current processor
+!
+IKE = SIZE(OCLOUD,3)
+!
+IF (OBOTTOMUP) THEN
+ IKBEG=1 ! scans the volume from the surface
+ IKEND=IKE ! up to the top
+ IKINC=1 ! increment to next level
+ELSE
+ IKBEG=IKE ! scans the volume from the top
+ IKEND=1 ! down to the surface
+ IKINC=-1 ! increment to next level
+END IF
+!
+DO JK=IKBEG,IKEND,IKINC
+!PRINT *,IRANK,'initialisation, level =',JK
+!
+NULLIFY(TZFIELDS_ll)
+!
+CALL GET_GLOBALDIMS_ll (NIMAX_ll,NJMAX_ll)
+CALL GET_DIM_EXT_ll ('B',IIU,IJU)
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+CALL GET_OR_ll('B',IXOR,IYOR)
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. IDENTIFY CLUSTER PIXELS THANKS TO OCLOUD MASK
+! ---------------------------------------------
+!PRINT *,IRANK,'identification'
+!
+!*--------------------------------------------------------------------*C
+!* 2.1 identify clusters by uninterrupted zonal segments
+!* 1st label in IMAPIND -- & -- 1st measure of size in ICLUSIZE
+!*--------------------------------------------------------------------*C
+!
+ALLOCATE(IMAPIND(IIU,IJU))
+IMAPIND(:,:) = JPUNDEF ! The pixels first point toward no local indices.
+!
+ICLUSMAX=IIU*IJU
+ALLOCATE(ICLUSIZE(ICLUSMAX))
+ICLUSIZE(:) = 0 ! The local cluster size is initiated to 0.
+!
+ICPT = 0
+!
+DO JJ=IJB,IJE
+ IF (OCLOUD(IIB,JJ,JK)) THEN
+ ICPT = ICPT + 1 ! at begining of a row, pixel points toward a new local index
+ IMAPIND(IIB,JJ) = ICPT
+ ICLUSIZE(ICPT) = ICLUSIZE(ICPT) + 1
+ END IF
+ DO JI=IIB+1,IIE
+ IF (OCLOUD(JI,JJ,JK)) THEN
+ IF (.NOT.OCLOUD(JI-1,JJ,JK)) THEN
+ ICPT = ICPT + 1 ! keep previous local index only if previous pixel mask was also true
+ END IF
+ IMAPIND(JI,JJ) = ICPT
+ ICLUSIZE(ICPT) = ICLUSIZE(ICPT) + 1
+ END IF
+ END DO
+END DO
+!PRINT *,'IP=',IP,' ICPT=',ICPT,' COUNT(OCLOUD)=',COUNT(OCLOUD)
+!IF (ICPT.GT.ICLUSMAX) PRINT *,"ICLUSMAX=",ICLUSMAX," LT ICPT=",ICPT
+!
+! IMAPIND(JI,JJ) = JC means that (JI,JJ) pixel points toward JC as local index
+! IMAPIND is JPUNDEF where OCLOUD is FALSE, it is in [1,ICLUSMAX] elsewhere
+! IMAPIND have the same value along uninterrupted zonal rows
+! IMAPIND will not change before step 4.
+!
+! ICLUSIZE(JC) is equal to the number of pixels pointing toward JC as local index
+! ICLUSIZE will not change before step 3.
+! sum(ICLUSIZE) is a constant and it is equal to num(OCLOUD) in the local domain
+!
+!*--------------------------------------------------------------------*C
+!* 2.2 GATHER CONNECTED CLUSTERS
+!* create ICLUSIND table which will contain Local Cluster Indices
+!* those Indices will further point toward Global Cluster ID in ICLUSTER...
+!*--------------------------------------------------------------------*C
+!
+ALLOCATE(ICLUSIND(ICLUSMAX))
+ICLUSIND = (/ (JC, JC=1,ICLUSMAX) /)
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+! DO JI=IIB,IIE-1
+ IF (OCLOUD(JI,JJ,JK)) THEN
+!*--------------------------------------------------------------------*C
+!* MINIMUM OF THE REGIONS THAT BORDER THIS ONE
+ IMINI = IMAPIND(JI,JJ)
+ IMINI = MIN(IMINI,MIN(IMAPIND(JI-1,JJ ),IMAPIND(JI ,JJ-1)))
+! IMINI = MIN(IMINI,MIN(IMAPIND(JI-1,JJ-1),IMAPIND(JI+1,JJ-1)))
+!*--------------------------------------------------------------------*C
+!* SEE WHETHER THERE ARE TWO CHAINS
+!*--------------------------------------------------------------------*C
+ IF (IMINI.GT.ICLUSIND(IMAPIND(JI,JJ))) THEN
+!*--------------------------------------------------------------------*C
+!* LOOK FOR THE MINIMUM OF THE CHAIN STARTING WITH KCLUSTER(I,J)
+!*--------------------------------------------------------------------*C
+ IMIX = ICLUSIND(IMAPIND(JI,JJ))
+ DO
+ IF ( ICLUSIND(IMIX) .NE. IMIX ) THEN
+ IMIX = ICLUSIND(IMIX)
+ ELSE
+ EXIT
+ END IF
+ END DO
+!*--------------------------------------------------------------------*C
+!* LOOK FOR THE MINIMUM OF THE CHAIN STARTING WITH MINI
+!*--------------------------------------------------------------------*C
+ IMUX = ICLUSIND(IMINI)
+ DO
+ IF ( ICLUSIND(IMUX) .NE. IMUX ) THEN
+ IMUX = ICLUSIND(IMUX)
+ ELSE
+ EXIT
+ END IF
+ END DO
+!*--------------------------------------------------------------------*C
+!* USE THE ABSOLUTE MINIMUM OF THE TWO CHAINS TO CONNECT THEM
+!*--------------------------------------------------------------------*C
+ IF (IMUX.GT.IMIX) THEN
+ ICLUSIND(IMUX) = IMIX
+ ELSEIF (IMIX.GT.IMUX) THEN
+ ICLUSIND(IMIX) = IMUX
+ END IF
+!*--------------------------------------------------------------------*C
+!* SINGLE CHAIN
+!*--------------------------------------------------------------------*C
+ ELSE
+ ICLUSIND(IMAPIND(JI,JJ)) = IMINI
+ END IF
+ END IF
+ END DO
+END DO
+!
+! since now, each Local Index JC that belongs to a pixel in the mask
+! points (via ICLUSIND) toward itself -OR- toward a lower Local Index
+! that belongs to a connected pixel in the mask
+!
+!
+!---------------------------------------------------------------------------------
+!
+!* 3. OPTIMISE ICLUSIND TABLE -&- GATHER LOCAL CLUSTER SIZES IN ICLUSIZE
+! ------------------------------------------------------------------
+!PRINT *,IRANK,'optimisation'
+!
+DO JC=1,ICLUSMAX
+ ICLUSIND(JC) = ICLUSIND(ICLUSIND(JC))
+ IF (ICLUSIND(JC).LT.JC) THEN
+ ICLUSIZE(ICLUSIND(JC)) = ICLUSIZE(ICLUSIND(JC)) + ICLUSIZE(JC)
+ ICLUSIZE(JC) = 0
+ END IF
+END DO
+!
+! since now, each Local Index JC that belong to a pixel in the mask
+! points (via ICLUSIND) toward the LOWEST Local Index
+! that belongs to a *connected* pixel in the mask
+!
+! ICLUSIZE(JC) gives now the number of pixels
+! that point (via IMAPIND and ICLUSIND) toward JC as Local Index
+! sum(ICLUSIZE) is still equal to num(OCLOUD) in the local domain
+!
+!----------------------------------------------------------------------------------
+!
+!* 4. GIVE TO CLUSTER PIXEL LOWEST LOCAL INDEX AND THEN GLOBAL CLUSTER ID
+! -------------------------------------------------------------------
+!PRINT *,IRANK,'naming'
+!
+!*--------------------------------------------------------------------*C
+!* 2nd label in IMAPIND -- & -- 1st label in in ICLUSTER... and IMAP..._ll
+!*--------------------------------------------------------------------*C
+!
+ALLOCATE(ICLUSTERIDT(ICLUSMAX))
+ALLOCATE(ICLUSTERLVL(ICLUSMAX))
+ALLOCATE(IAFFLUSECTN(ICLUSMAX))
+ALLOCATE(ZCLUSSUMFLD(ICLUSMAX))
+ICLUSTERIDT(:) = 0 ! local indices first indicate no global cluster ID
+ICLUSTERLVL(:) = IKE+1 ! and cluster base level is setup above highest level
+IAFFLUSECTN(:) = 0 ! no affluent from under so affluent section = 0
+ZCLUSSUMFLD(:) = 0. ! sum of field values inside the clusters is set up to 0.
+!
+! 4.1 CHOOSING CLUSTER FUTURE NAMES & WRITING IT AND PROPERTIES IN ICLUSTER...
+! (UPDATE 1D TABLES)
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IF (OCLOUD(JI,JJ,JK)) THEN
+ ! using optimised ICLUSIND to connect pixel to lowest local index pixel
+ ! belonging to the same cluster in this horizontal level
+ IMAPIND(JI,JJ) = ICLUSIND(IMAPIND(JI,JJ)) ! lowest local index
+ ! adding field value of current pixel to its cluster sum
+ ZCLUSSUMFLD(IMAPIND(JI,JJ)) = ZCLUSSUMFLD(IMAPIND(JI,JJ))+PFIELD(JI,JJ,JK)
+ ! in case that pixel belongs to an already named cluster:
+ ITEMPIDT = ICLUSTERIDT(IMAPIND(JI,JJ)) ! potential IDnumber
+ ITEMPLVL = ICLUSTERLVL(IMAPIND(JI,JJ)) ! potential baselvl
+ ITEMPAFL = IAFFLUSECTN(IMAPIND(JI,JJ)) ! potential affluent section
+ ! checking whether there is an identified cluster at same position in previous level, an "affluent"
+ ! (previous level is JK-IKINC)
+ ! in this case, we settup future name in consequence
+ IF (JK.NE.IKBEG) THEN
+ !
+ DO JDI=-1,1 ! cross-shape sieve of conseidered underlying pixels
+ DO JDJ=-1,1 ! JI +/- 1 and JJ +/- 1 and (JI,JJ)
+ IF ((ABS(JDI)+ABS(JDJ)).LT.2) THEN
+ !
+ IF (OCLOUD(JI+JDI,JJ+JDJ,JK-IKINC)) THEN
+ ! 1st priority given to biggest affluent in section
+ IF (PCLUSTERSEC(JI+JDI,JJ+JDJ,JK-IKINC).GT.ITEMPAFL) THEN
+ ITEMPIDT = KCLUSTERIDT(JI+JDI,JJ+JDJ,JK-IKINC)
+ ITEMPLVL = KCLUSTERLVL(JI+JDI,JJ+JDJ,JK-IKINC)
+ ITEMPAFL = PCLUSTERSEC(JI+JDI,JJ+JDJ,JK-IKINC)
+ ELSEIF (PCLUSTERSEC(JI+JDI,JJ+JDJ,JK-IKINC).EQ.ITEMPAFL) THEN
+ ! 2nd priority given to affluent with lowest base
+ IF (KCLUSTERLVL(JI+JDI,JJ+JDJ,JK-IKINC).LT.ITEMPLVL) THEN
+ ITEMPIDT = KCLUSTERIDT(JI+JDI,JJ+JDJ,JK-IKINC)
+ ITEMPLVL = KCLUSTERLVL(JI+JDI,JJ+JDJ,JK-IKINC)
+ ELSEIF (KCLUSTERLVL(JI+JDI,JJ+JDJ,JK-IKINC).EQ.ITEMPLVL) THEN
+ ! 3rd priority given to affluent with lowest IDnumber
+ IF (ITEMPIDT.EQ.0) THEN
+ ITEMPIDT = KCLUSTERIDT(JI+JDI,JJ+JDJ,JK-IKINC)
+ ELSE
+ ITEMPIDT = MIN(KCLUSTERIDT(JI+JDI,JJ+JDJ,JK-IKINC),ITEMPIDT)
+ END IF
+ END IF
+ END IF
+ END IF
+ !
+ END IF
+ END DO
+ END DO
+ !
+ END IF
+ !
+ IF (ITEMPIDT.EQ.0) THEN
+ ICLUSTERIDT(IMAPIND(JI,JJ)) = NIMAX_ll*(IYOR+JJ-1) + (IXOR+JI)
+ ICLUSTERLVL(IMAPIND(JI,JJ)) = JK
+ IAFFLUSECTN(IMAPIND(JI,JJ)) = 0
+ ELSE
+ ICLUSTERIDT(IMAPIND(JI,JJ)) = ITEMPIDT
+ ICLUSTERLVL(IMAPIND(JI,JJ)) = ITEMPLVL
+ IAFFLUSECTN(IMAPIND(JI,JJ)) = ITEMPAFL
+ END IF
+ !
+ END IF ! OCLOUD(JI,JJ) is TRUE
+ END DO
+END DO
+!
+DEALLOCATE(ICLUSIND)
+!
+! now, ICLUSTER... has a name for each cluster in the current level
+! the same as the cluster under if there is one, a new name otherwise
+! in case of several possibilities, we linked current level cluster prioritarly with:
+! 1. cluster under with the bigest section
+! 2. cluster under with the lowest base level
+! 3. cluster under with the lowest ID number
+!
+!* 4.2 GIVING ID, BASE LEVEL and AFFLUENT SECTION in IMAP..._ll
+! (COLORATION OF 2D TABLES)
+!
+IMAPIDT_ll(:,:) = 0 ! pixels fist have no global cluster ID
+IMAPLVL_ll(:,:) = IKE+1 ! and cluster base level is setup above highest level
+IMAPAFL_ll(:,:) = 0 ! no affluent from under so affluent section = 0
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IF (OCLOUD(JI,JJ,JK)) THEN
+ IMAPIDT_ll(JI,JJ) = ICLUSTERIDT(IMAPIND(JI,JJ)) ! global cluster ID
+ IMAPLVL_ll(JI,JJ) = ICLUSTERLVL(IMAPIND(JI,JJ)) ! cluster baselevel
+ IMAPAFL_ll(JI,JJ) = IAFFLUSECTN(IMAPIND(JI,JJ)) ! affluent section
+ END IF
+ END DO
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. UPDATE HALO AND UNIFY ADJACENT CLUSTERS GIVING COMMON ID*
+! --------------------------------------------------------
+! *ID is defined unequivocally by (IDT number, base LVL)
+!
+! (MPI COMMUNICATIONS FOR 2D FIELDS:
+! IDT, LVL, AFL useful for clustering)
+!
+!PRINT *,IRANK,'halo-update'
+!
+DO JH=1,9999 ! update halo until there is no more changes anywhere
+!PRINT *,'compteur premiere boucle infinie =',JH
+!
+ZMAPIDT_ll=IMAPIDT_ll
+ZMAPLVL_ll=IMAPLVL_ll
+ZMAPAFL_ll=IMAPAFL_ll
+CALL ADD2DFIELD_ll(TZFIELDS_ll,ZMAPIDT_ll)
+CALL ADD2DFIELD_ll(TZFIELDS_ll,ZMAPLVL_ll)
+CALL ADD2DFIELD_ll(TZFIELDS_ll,ZMAPAFL_ll)
+CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+IMAPIDT_ll=NINT(ZMAPIDT_ll)
+IMAPLVL_ll=NINT(ZMAPLVL_ll)
+IMAPAFL_ll=NINT(ZMAPAFL_ll)
+ICHANGES = 0 ! counter of changes
+!
+DO JJ=IJB,IJE ! check Western and Eastern borders of local domain
+!
+IF ( (IMAPIDT_ll(IIB,JJ).NE.0).AND.(IMAPIDT_ll(1,JJ).NE.0) ) THEN
+ IF ( IMAPAFL_ll(1,JJ).GT.IAFFLUSECTN(IMAPIND(IIB,JJ)) ) THEN
+ ! if halo pixel has a bigger affluent than current pixel
+ ICLUSTERIDT(IMAPIND(IIB,JJ)) = IMAPIDT_ll(1,JJ)
+ ICLUSTERLVL(IMAPIND(IIB,JJ)) = IMAPLVL_ll(1,JJ)
+ IAFFLUSECTN(IMAPIND(IIB,JJ)) = IMAPAFL_ll(1,JJ)
+ ICHANGES = ICHANGES + 1
+ ELSEIF (IMAPAFL_ll(1,JJ).EQ.IAFFLUSECTN(IMAPIND(IIB,JJ))) THEN
+ IF (IMAPLVL_ll(1,JJ).LT.ICLUSTERLVL(IMAPIND(IIB,JJ))) THEN
+ ! if halo pixel belongs to a cluster with a lower base
+ ICLUSTERIDT(IMAPIND(IIB,JJ)) = IMAPIDT_ll(1,JJ)
+ ICLUSTERLVL(IMAPIND(IIB,JJ)) = IMAPLVL_ll(1,JJ)
+ ICHANGES = ICHANGES + 1
+ ELSEIF (IMAPLVL_ll(1,JJ).EQ.ICLUSTERLVL(IMAPIND(IIB,JJ))) THEN
+ IF (IMAPIDT_ll(1,JJ).LT.ICLUSTERIDT(IMAPIND(IIB,JJ))) THEN
+ ! if halo pixel belongs to a cluster with a lower ID number
+ ICLUSTERIDT(IMAPIND(IIB,JJ)) = IMAPIDT_ll(1,JJ)
+ ICHANGES = ICHANGES + 1
+ END IF
+ END IF
+ END IF
+END IF
+!
+IF ( (IMAPIDT_ll(IIE,JJ).NE.0).AND.(IMAPIDT_ll(IIU,JJ).NE.0) ) THEN
+ IF ( IMAPAFL_ll(IIU,JJ).GT.IAFFLUSECTN(IMAPIND(IIE,JJ)) ) THEN
+ ! if halo pixel has a bigger affluent than current pixel
+ ICLUSTERIDT(IMAPIND(IIE,JJ)) = IMAPIDT_ll(IIU,JJ)
+ ICLUSTERLVL(IMAPIND(IIE,JJ)) = IMAPLVL_ll(IIU,JJ)
+ IAFFLUSECTN(IMAPIND(IIE,JJ)) = IMAPAFL_ll(IIU,JJ)
+ ICHANGES = ICHANGES + 1
+ ELSEIF (IMAPAFL_ll(IIU,JJ).EQ.IAFFLUSECTN(IMAPIND(IIE,JJ))) THEN
+ IF (IMAPLVL_ll(IIU,JJ).LT.ICLUSTERLVL(IMAPIND(IIE,JJ))) THEN
+ ! if halo pixel belongs to a cluster with a lower base
+ ICLUSTERIDT(IMAPIND(IIE,JJ)) = IMAPIDT_ll(IIU,JJ)
+ ICLUSTERLVL(IMAPIND(IIE,JJ)) = IMAPLVL_ll(IIU,JJ)
+ ICHANGES = ICHANGES + 1
+ ELSEIF (IMAPLVL_ll(IIU,JJ).EQ.ICLUSTERLVL(IMAPIND(IIE,JJ))) THEN
+ IF (IMAPIDT_ll(IIU,JJ).LT.ICLUSTERIDT(IMAPIND(IIE,JJ))) THEN
+ ! if halo pixel belongs to a cluster with a lower ID number
+ ICLUSTERIDT(IMAPIND(IIE,JJ)) = IMAPIDT_ll(IIU,JJ)
+ ICHANGES = ICHANGES + 1
+ END IF
+ END IF
+ END IF
+END IF
+!
+END DO ! two borders checked
+!
+DO JI=IIB,IIE ! check Southern and Northern borders of local domain
+!
+IF ( (IMAPIDT_ll(JI,IJB).NE.0).AND.(IMAPIDT_ll(JI,1).NE.0) ) THEN
+ IF ( IMAPAFL_ll(JI,1).GT.IAFFLUSECTN(IMAPIND(JI,IJB)) ) THEN
+ ! if halo pixel has a bigger affluent than current pixel
+ ICLUSTERIDT(IMAPIND(JI,IJB)) = IMAPIDT_ll(JI,1)
+ ICLUSTERLVL(IMAPIND(JI,IJB)) = IMAPLVL_ll(JI,1)
+ IAFFLUSECTN(IMAPIND(JI,IJB)) = IMAPAFL_ll(JI,1)
+ ICHANGES = ICHANGES + 1
+ ELSEIF (IMAPAFL_ll(JI,1).EQ.IAFFLUSECTN(IMAPIND(JI,IJB))) THEN
+ IF (IMAPLVL_ll(JI,1).LT.ICLUSTERLVL(IMAPIND(JI,IJB))) THEN
+ ! if halo pixel belongs to a cluster with a lower base
+ ICLUSTERIDT(IMAPIND(JI,IJB)) = IMAPIDT_ll(JI,1)
+ ICLUSTERLVL(IMAPIND(JI,IJB)) = IMAPLVL_ll(JI,1)
+ ICHANGES = ICHANGES + 1
+ ELSEIF (IMAPLVL_ll(JI,1).EQ.ICLUSTERLVL(IMAPIND(JI,IJB))) THEN
+ IF (IMAPIDT_ll(JI,1).LT.ICLUSTERIDT(IMAPIND(JI,IJB))) THEN
+ ! if halo pixel belongs to a cluster with a lower ID number
+ ICLUSTERIDT(IMAPIND(JI,IJB)) = IMAPIDT_ll(JI,1)
+ ICHANGES = ICHANGES + 1
+ END IF
+ END IF
+ END IF
+END IF
+!
+IF ( (IMAPIDT_ll(JI,IJE).NE.0).AND.(IMAPIDT_ll(JI,IJU).NE.0) ) THEN
+ IF ( IMAPAFL_ll(JI,IJU).GT.IAFFLUSECTN(IMAPIND(JI,IJE)) ) THEN
+ ! if halo pixel has a bigger affluent than current pixel
+ ICLUSTERIDT(IMAPIND(JI,IJE)) = IMAPIDT_ll(JI,IJU)
+ ICLUSTERLVL(IMAPIND(JI,IJE)) = IMAPLVL_ll(JI,IJU)
+ IAFFLUSECTN(IMAPIND(JI,IJE)) = IMAPAFL_ll(JI,IJU)
+ ICHANGES = ICHANGES + 1
+ ELSEIF (IMAPAFL_ll(JI,IJU).EQ.IAFFLUSECTN(IMAPIND(JI,IJE))) THEN
+ IF (IMAPLVL_ll(JI,IJU).LT.ICLUSTERLVL(IMAPIND(JI,IJE))) THEN
+ ! if halo pixel belongs to a cluster with a lower base
+ ICLUSTERIDT(IMAPIND(JI,IJE)) = IMAPIDT_ll(JI,IJU)
+ ICLUSTERLVL(IMAPIND(JI,IJE)) = IMAPLVL_ll(JI,IJU)
+ ICHANGES = ICHANGES + 1
+ ELSEIF (IMAPLVL_ll(JI,IJU).EQ.ICLUSTERLVL(IMAPIND(JI,IJE))) THEN
+ IF (IMAPIDT_ll(JI,IJU).LT.ICLUSTERIDT(IMAPIND(JI,IJE))) THEN
+ ! if halo pixel belongs to a cluster with a lower ID number
+ ICLUSTERIDT(IMAPIND(JI,IJE)) = IMAPIDT_ll(JI,IJU)
+ ICHANGES = ICHANGES + 1
+ END IF
+ END IF
+ END IF
+END IF
+!
+END DO ! all 4 borders checked
+!
+IF (ICHANGES.GT.0) THEN ! in case of changes due to halo, rename clusters
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IF (OCLOUD(JI,JJ,JK)) THEN
+ IMAPIDT_ll(JI,JJ) = ICLUSTERIDT(IMAPIND(JI,JJ))
+ IMAPLVL_ll(JI,JJ) = ICLUSTERLVL(IMAPIND(JI,JJ))
+ IMAPAFL_ll(JI,JJ) = IAFFLUSECTN(IMAPIND(JI,JJ))
+ ELSE
+ IMAPIDT_ll(JI,JJ) = 0
+ IMAPLVL_ll(JI,JJ) = IKE+1
+ IMAPAFL_ll(JI,JJ) = 0
+ END IF
+ END DO
+ END DO
+END IF
+!
+CALL REDUCESUM_ll(ICHANGES,IINFO_ll)
+IF (ICHANGES.EQ.0) EXIT
+!
+END DO ! infinite loop until there is no more changes anywhere
+!
+KCLUSTERIDT(:,:,JK) = IMAPIDT_ll
+KCLUSTERLVL(:,:,JK) = IMAPLVL_ll
+!
+!
+CALL CLEANLIST_ll(TZFIELDS_ll)
+DEALLOCATE(IAFFLUSECTN)
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. COMPUTE GLOBAL CLUSTER SECTIONS AND FIELD AVERAGES
+! --------------------------------------------------
+!
+! (MPI COMMUNICATIONS FOR 1D TABLES
+! useful for computing properties distributions
+! within cluster population)
+!
+!PRINT *,IRANK,'measuring'
+!
+!* 6.1 SUM UP LOCAL CLUSTER INFO IN 1D TABLES
+!PRINT *,IRANK,'build non-redundant 1D table'
+!
+ICPR = COUNT(ICLUSTERIDT.NE.0) ! number of cluster parts in the local domain, may be redundant
+!
+ALLOCATE(ILOCLISTIDT(ICPR)) ! list of cluster IDs in local domain
+ALLOCATE(ILOCLISTLVL(ICPR)) ! list of cluster baselevel in local domain
+ALLOCATE(ILOCLISTSEC(ICPR)) ! list of cluster sections in local domain
+ALLOCATE(ZLOCLISTFLD(ICPR)) ! list of cluster field sum in local domain
+ALLOCATE(ILOCIND(ICLUSMAX)) ! pointer from old indices (1..iclusmax) toward new non-redundant tables
+ILOCLISTIDT = 0
+ILOCLISTLVL = 0
+ILOCLISTSEC = 0
+ZLOCLISTFLD = 0.
+ILOCIND = 0
+!
+! create ILOCLIST... and ILOCLISTSEC from ICLUSTER... and ICLUSIZE to get rid of all 0 elements
+! and to sum the sizes of clusters appearing in different parts inside the local domain
+! the sum of field values inside each cluster is continuously updated
+!
+ICPT=0 ! counter to know last index of ILOCLIST... that has been filled
+IF (ICPR.GT.0) THEN
+DO JC=1,ICLUSMAX
+ IF (ICLUSTERIDT(JC).NE.0) THEN
+ JJ=1 ! to check whether ILOCLIST... already contains ICLUSTER...(JC)
+ DO
+ IF (ILOCLISTIDT(JJ).EQ.ICLUSTERIDT(JC)) THEN
+ IF (ILOCLISTLVL(JJ).EQ.ICLUSTERLVL(JC)) THEN
+ ZLOCLISTFLD(JJ) = ZLOCLISTFLD(JJ) + ZCLUSSUMFLD(JC)
+ ILOCLISTSEC(JJ) = ILOCLISTSEC(JJ) + ICLUSIZE(JC)
+ ILOCIND(JC) = JJ
+ EXIT
+ END IF
+ END IF
+ IF (JJ.EQ.ICPT+1) THEN
+ ILOCLISTIDT(JJ) = ICLUSTERIDT(JC)
+ ILOCLISTLVL(JJ) = ICLUSTERLVL(JC)
+ ZLOCLISTFLD(JJ) = ZCLUSSUMFLD(JC)
+ ILOCLISTSEC(JJ) = ICLUSIZE(JC)
+ ILOCIND(JC) = JJ
+ ICPT = ICPT+1
+ EXIT
+ END IF
+ JJ = JJ+1
+ END DO
+ END IF
+END DO
+END IF
+!
+DEALLOCATE(ZCLUSSUMFLD)
+DEALLOCATE(ICLUSIZE)
+DEALLOCATE(ICLUSTERIDT)
+DEALLOCATE(ICLUSTERLVL)
+!
+! normally, ICPT = COUNT(ILOCLISTID.NE.0)
+! number of cluster IDs in local domain, *non-redundant*
+!
+ALLOCATE(ILOCLISTIDT2(ICPT))
+ALLOCATE(ILOCLISTLVL2(ICPT))
+ALLOCATE(ILOCLISTSEC2(ICPT))
+ALLOCATE(ZLOCLISTFLD2(ICPT))
+ILOCLISTIDT2 = ILOCLISTIDT(1:ICPT) ! JUST TO REMOVE ALL 0 AT THE END
+ILOCLISTLVL2 = ILOCLISTLVL(1:ICPT)
+ILOCLISTSEC2 = ILOCLISTSEC(1:ICPT)
+ZLOCLISTFLD2 = ZLOCLISTFLD(1:ICPT) ! /ILOCLISTSEC(1:ICPT) ! from sum compute average
+DEALLOCATE(ILOCLISTIDT)
+DEALLOCATE(ILOCLISTLVL)
+DEALLOCATE(ILOCLISTSEC)
+DEALLOCATE(ZLOCLISTFLD)
+!
+!* 6.2 CONCATENATE ALL LOCAL INFORMATION
+!PRINT *,IRANK,'concatenate non-redundant 1D table'
+!
+ALLOCATE(ICLUSNBR(NPROC)) ! number of clusters in each proc's local domain
+CALL MPI_ALLGATHER(ICPT, 1, MPI_INTEGER, ICLUSNBR, 1, MPI_INTEGER, NMNH_COMM_WORLD, INFO)
+! each processor knows now how many clusters appear in all other processor domains
+!
+!PRINT *,IRANK,'build IPROCDPL'
+ALLOCATE(IPROCDPL(NPROC))
+IPROCDPL(1)=0
+IF (NPROC.GT.1) THEN
+DO JC=2,NPROC
+ IPROCDPL(JC)=IPROCDPL(JC-1)+ICLUSNBR(JC-1)
+END DO
+END IF
+! IPROCDPL(JC) = nbr of clusters contained by processors whose rank < JC (i.e. cumulative)
+!
+ITOTNBR = SUM(ICLUSNBR) ! number of clusters ! with redundance from one local domain to the other !
+!
+!
+ALLOCATE(IGLBLISTIDT(ITOTNBR)) ! concatenated list of cluster IDs of all local domains
+ALLOCATE(IGLBLISTLVL(ITOTNBR)) ! concatenated list of cluster baselevels of all local domains
+ALLOCATE(IGLBLISTSEC(ITOTNBR)) ! their corresponding LOCAL sections !!
+ALLOCATE(ZGLBLISTFLD(ITOTNBR)) ! their corresponding LOCAL field sum
+IGLBLISTIDT=0
+IGLBLISTLVL=0
+IGLBLISTSEC=0
+ZGLBLISTFLD=0.
+!
+!PRINT *,IRANK,'call all-gatherv'
+CALL MPI_ALLGATHERV(ILOCLISTIDT2, ICPT, MPI_INTEGER, IGLBLISTIDT, ICLUSNBR, IPROCDPL, MPI_INTEGER, &
+ NMNH_COMM_WORLD, INFO)
+CALL MPI_ALLGATHERV(ILOCLISTLVL2, ICPT, MPI_INTEGER, IGLBLISTLVL, ICLUSNBR, IPROCDPL, MPI_INTEGER, &
+ NMNH_COMM_WORLD, INFO)
+CALL MPI_ALLGATHERV(ILOCLISTSEC2, ICPT, MPI_INTEGER, IGLBLISTSEC, ICLUSNBR, IPROCDPL, MPI_INTEGER, &
+ NMNH_COMM_WORLD, INFO)
+CALL MPI_ALLGATHERV(ZLOCLISTFLD2, ICPT, MPI_PRECISION, ZGLBLISTFLD, ICLUSNBR, IPROCDPL, MPI_PRECISION, &
+ NMNH_COMM_WORLD, INFO)
+!
+!* 6.3 EACH PROC COMPUTES GLOBAL SECTIONS AND FIELD AVERAGE OF ITS CLUSTERS
+!PRINT *,IRANK,'global sizes of its own clusters'
+!
+! update cluster sections in ILOCLISTSEC2 in order to have GLOBAL sections
+DO JC=1,ICPT
+ DO JJ=1,ITOTNBR
+ ! TO BE SURE NOT TO SUM ITS OWN SIZE TO THE OTHER DOMAIN PART SIZES
+ IF ( (JJ.LE.IPROCDPL(IRANK+1)) .OR. (JJ.GT.(IPROCDPL(IRANK+1)+ICLUSNBR(IRANK+1))) ) THEN
+ IF ( (IGLBLISTIDT(JJ).EQ.ILOCLISTIDT2(JC)) .AND. (IGLBLISTLVL(JJ).EQ.ILOCLISTLVL2(JC)) ) THEN
+ ! if IGLBLIST...(JJ) correspond to ILOCLIST...2(JC) then sum sections and field avg
+ ILOCLISTSEC2(JC)=ILOCLISTSEC2(JC)+IGLBLISTSEC(JJ)
+ ZLOCLISTFLD2(JC)=ZLOCLISTFLD2(JC)+ZGLBLISTFLD(JJ)
+ END IF
+ END IF
+ END DO
+END DO
+!
+DO JC=1,ICPT
+ ZLOCLISTFLD2(JC)=ZLOCLISTFLD2(JC)/ILOCLISTSEC2(JC) ! from sum toward average
+END DO
+!
+!PRINT *,'ILOCLISTID2 = ',ILOCLISTID2
+!PRINT *,'ILOCLISTSZ2 = ',ILOCLISTSZ2
+!
+! since now, ILOCLISTSEC2 contains global sizes of local clusters
+! and, ZLOCLISTFLD2 contains global field avg of local clusters
+!
+!* 6.4 FILL PCLUSTERSEC TABLE WITH GLOBAL SIZES
+!PRINT *,IRANK,'filling PCLUSTERSEC'
+ !
+ PCLUSTERSEC(:,:,JK) = 0. ! pixels first belong to no clusters, so clustersize is zero
+ ZMESHAREA = XDXHATM*XDYHATM/10**6 ! in km2
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IF (OCLOUD(JI,JJ,JK)) THEN
+ PCLUSTERSEC(JI,JJ,JK) = ILOCLISTSEC2(ILOCIND(IMAPIND(JI,JJ)))*ZMESHAREA
+ END IF
+ END DO
+ END DO
+!
+!* DEALLOCATIONS
+!
+DEALLOCATE(ILOCLISTIDT2)
+DEALLOCATE(ILOCLISTLVL2)
+DEALLOCATE(ILOCLISTSEC2)
+DEALLOCATE(ZLOCLISTFLD2)
+!
+DEALLOCATE(ILOCIND,IMAPIND)
+DEALLOCATE(ICLUSNBR,IPROCDPL)
+DEALLOCATE(IGLBLISTIDT,IGLBLISTLVL,IGLBLISTSEC,ZGLBLISTFLD)
+!
+END DO ! JK
+!
+!
+END SUBROUTINE CLUSTERING
diff --git a/src/MNH/diag.f90 b/src/MNH/diag.f90
index cf7926b0917e8a030335113b2d381e7859df3bd3..6b3793448337ea7fa33efe37b045823012e9f551 100644
--- a/src/MNH/diag.f90
+++ b/src/MNH/diag.f90
@@ -80,6 +80,10 @@
!! 10/2016 (C.LAC) add LVISI
!! 10/2016 (F Brosse) Add prod/loss terms computation for chemistry
!! 10/2017 (G.Delautier) New boundary layer height : replace LBLTOP by CBLTOP
+!! 10/2017 (T Dauhut) Add parallel 3D clustering
+!! 01/2018 (J.-P. Chaboureau) Add altitude interpolation
+!! 01/2018 (J.-P. Chaboureau) Add coarse graining
+!! 01/2018 (G.Delautier) SURFEX 8.1
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -216,7 +220,9 @@ NAMELIST/NAM_DIAG/ CISO, LVAR_RS, LVAR_LS, &
XGRID,NBELEV,XELEV,NBRAD,LQUAD,LFALL,LWBSCS,LWREFL,&
XREFLMIN,XREFLVDOPMIN,LSNRT,XSNRMIN,&
LLIDAR,CVIEW_LIDAR,XALT_LIDAR,XWVL_LIDAR,&
- LISOPR,XISOPR,LISOTH,XISOTH, LHU_FLX,LVISI, LLIMA_DIAG
+ LISOPR,XISOPR,LISOTH,XISOTH,LISOAL,XISOAL,LCOARSE,NDXCOARSE, &
+ LHU_FLX,LVISI,LLIMA_DIAG,&
+ LCLSTR,LBOTUP,CFIELD,XTHRES
!
NAMELIST/NAM_DIAG_FILE/ YINIFILE,YINIFILEPGD, YSUFFIX
NAMELIST/NAM_STO_FILE/ CFILES, NSTART_SUPP
@@ -303,6 +309,11 @@ XLAT_GPS(:)=XUNDEF
XLON_GPS(:)=XUNDEF
XZS_GPS(:)=-999.0
XDIFFORO=150.0
+!
+LCLSTR=.FALSE.
+LBOTUP=.TRUE.
+CFIELD='CLOUD'
+XTHRES=0.00001
!! initialization of radar parameters
NVERSION_RAD=1
@@ -359,6 +370,11 @@ LISOPR=.FALSE.
XISOPR(:)=0.
LISOTH=.FALSE.
XISOTH(:)=0.
+LISOAL=.FALSE.
+XISOAL(:)=-1.
+!
+LCOARSE=.FALSE.
+NDXCOARSE=1
!
!-------------------------------------------------------------------------------
!
@@ -690,9 +706,7 @@ IF (CSURF=='EXTE') THEN
CALL GOTO_SURFEX(1)
TFILE_SURFEX => TOUTDATAFILE
CALL WRITE_SURF_ATM_n(YSURF_CUR,'MESONH','ALL',.FALSE.)
- CALL DIAG_SURF_ATM_n(YSURF_CUR%IM%DGEI, YSURF_CUR%FM%DGF, YSURF_CUR%DGL, YSURF_CUR%IM%DGI, &
- YSURF_CUR%SM%DGS, YSURF_CUR%DGU, YSURF_CUR%TM%DGT, YSURF_CUR%WM%DGW, &
- YSURF_CUR%U, YSURF_CUR%USS,'MESONH')
+ CALL DIAG_SURF_ATM_n(YSURF_CUR,'MESONH')
CALL WRITE_DIAG_SURF_ATM_n(YSURF_CUR,'MESONH','ALL')
NULLIFY(TFILE_SURFEX)
WRITE(ILUOUT0,*) ' '
diff --git a/src/MNH/gps_zenith.f90 b/src/MNH/gps_zenith.f90
index 7e2654538da42d5b050eb2ca0eac83e5a7210613..bf5b4ec39fc0bb0fd688d968e21da92fc1077933 100644
--- a/src/MNH/gps_zenith.f90
+++ b/src/MNH/gps_zenith.f90
@@ -209,7 +209,7 @@ ZRDSRV=XRD/XRV
ZXHATM(1:IIU-1) = 0.5*(XXHAT(1:IIU-1)+XXHAT(2:IIU))
ZXHATM(IIU) = 2.*XXHAT(IIU)-ZXHATM(IIU-1)
ZYHATM(1:IJU-1) = 0.5*(XYHAT(1:IJU-1)+XYHAT(2:IJU))
-ZYHATM(IJU) = 2.*XXHAT(IJU)-ZXHATM(IJU-1)
+ZYHATM(IJU) = 2.*XYHAT(IJU)-ZYHATM(IJU-1)
ZZHATM(:,:,1:IKU-1)=0.5*(XZZ(:,:,1:IKU-1)+XZZ(:,:,2:IKU))
ZZHATM(:,:,IKU) = 2.*XZZ(:,:,IKU) -ZZHATM(:,:,IKU-1)
!
diff --git a/src/MNH/gps_zenith_grid.f90 b/src/MNH/gps_zenith_grid.f90
index b954e9acaa678406663945c4ffaa46746f3c75be..4d8ed9c581b2a413128fbe9cf73b35bcfb4d0881 100644
--- a/src/MNH/gps_zenith_grid.f90
+++ b/src/MNH/gps_zenith_grid.f90
@@ -178,7 +178,7 @@ ZRDSRV=XRD/XRV
ZXHATM(1:IIU-1) = 0.5*(XXHAT(1:IIU-1)+XXHAT(2:IIU))
ZXHATM(IIU) = 2.*XXHAT(IIU)-ZXHATM(IIU-1)
ZYHATM(1:IJU-1) = 0.5*(XYHAT(1:IJU-1)+XYHAT(2:IJU))
-ZYHATM(IJU) = 2.*XXHAT(IJU)-ZXHATM(IJU-1)
+ZYHATM(IJU) = 2.*XYHAT(IJU)-ZYHATM(IJU-1)
ZZHATM(:,:,1:IKU-1)=0.5*(XZZ(:,:,1:IKU-1)+XZZ(:,:,2:IKU))
ZZHATM(:,:,IKU) = 2.*XZZ(:,:,IKU) -ZZHATM(:,:,IKU-1)
!
diff --git a/src/MNH/ground_paramn.f90 b/src/MNH/ground_paramn.f90
index 6ef8cbf4ecaaa7b2a119ab7583398f61a9964e0c..ead62f435e4ad26ede5e75d8531e753e5818fe4e 100644
--- a/src/MNH/ground_paramn.f90
+++ b/src/MNH/ground_paramn.f90
@@ -108,6 +108,7 @@ END MODULE MODI_GROUND_PARAM_n
!! (B.Vie) 2016 LIMA
!! (M.Leriche) 24/03/16 remove flag for chemical surface fluxes
!! (M.Leriche) 01/07/2017 Add DIAG chimical surface fluxes
+!! 01/2018 (G.Delautier) SURFEX 8.1
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -530,9 +531,7 @@ CALL COUPLING_SURF_ATM_n(YSURF_CUR,'MESONH', 'E',ZTIMEC,
!
IF (CPROGRAM=='DIAG ' .OR. LDIAG_IN_RUN) THEN
- CALL DIAG_SURF_ATM_n(YSURF_CUR%IM%DGEI, YSURF_CUR%FM%DGF, YSURF_CUR%DGL, YSURF_CUR%IM%DGI, &
- YSURF_CUR%SM%DGS, YSURF_CUR%DGU, YSURF_CUR%TM%DGT, YSURF_CUR%WM%DGW, &
- YSURF_CUR%U, YSURF_CUR%USS,'MESONH')
+ CALL DIAG_SURF_ATM_n(YSURF_CUR,'MESONH')
CALL MNHGET_SURF_PARAM_n(PRN=ZP_RN,PH=ZP_H,PLE=ZP_LE,PGFLUX=ZP_GFLUX, &
PT2M=ZP_T2M,PQ2M=ZP_Q2M,PHU2M=ZP_HU2M, &
PZON10M=ZP_ZON10M,PMER10M=ZP_MER10M )
diff --git a/src/MNH/ini_seriesn.f90 b/src/MNH/ini_seriesn.f90
index 56d0b75eabd6526db66011b3be3874791a340606..f39f6086e23c1ec274557c75fb70cc4aa51c797c 100644
--- a/src/MNH/ini_seriesn.f90
+++ b/src/MNH/ini_seriesn.f90
@@ -43,6 +43,7 @@
!! Original 4/03/2002
!! Oct. 2011 : (P.Le Moigne) Surface series
!! June 2016: P. Wautelet: corrected writes
+!! Nov. 2017: J.-P. Chaboureau: fix a bug in dimension check
!!
!-------------------------------------------------------------------------------
!
@@ -122,7 +123,7 @@ IF ( ( NFREQSERIES*XTSTEP < XSEGLEN ) .AND. &
( NJBOXL < IJB_ll ) .OR. &
( NJBOXL > NJBOXH ) .OR. &
( NJBOXH > IJE_ll ) .OR. &
- ( NBJSLICE >= IJE_ll ) .OR. &
+ ( NBJSLICE > IJE_ll ) .OR. &
( NBJSLICE > SIZE(NJSLICEL(:),1) ) .OR. &
( NJSLICEL(1) < IJB_ll ) .OR. &
( NJSLICEL(1) > IJE_ll ) .OR. &
diff --git a/src/MNH/init_ground_paramn.f90 b/src/MNH/init_ground_paramn.f90
index 13390f721b6b71bf7df3b4fc77a71ca3107441e1..d695873478c1be00d86328f401457cfd16beceb6 100644
--- a/src/MNH/init_ground_paramn.f90
+++ b/src/MNH/init_ground_paramn.f90
@@ -68,6 +68,7 @@ END MODULE MODI_INIT_GROUND_PARAM_n
!! 01/12/03 (D.Gazen) change emissions handling for surf. externalization
!! Nov. 2010 (J.Escobar) PGI BUG , add SIZE(CSV) to interface
!! 06/2016 (G.Delautier) phasage surfex 8
+!! 01/2018 (G.Delautier) SURFEX 8.1
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -77,17 +78,22 @@ USE MODE_ll
USE MODE_IO_ll
USE MODE_FIELD
!
+USE MODD_DYN_n, ONLY : NSTOP, XTSTEP
USE MODD_REF_n, ONLY : XRHODREF
USE MODD_CH_M9_n, ONLY : CNAMES
USE MODD_NSV
USE MODD_DUST, ONLY : CDUSTNAMES
USE MODD_SALT, ONLY : CSALTNAMES
USE MODD_CH_AEROSOL, ONLY : CAERONAMES
-USE MODD_TYPE_DATE
+USE MODD_TYPE_DATE, ONLY : DATE_TIME
+!
+USE MODD_TYPE_DATE_SURF, ONLY : DATE
!
USE MODD_PARAMETERS, ONLY : XUNDEF, JPVEXT
!
+USE MODI_ADD_FORECAST_TO_DATE_SURF
USE MODI_INIT_SURF_ATM_N
+!
USE MODD_MNH_SURFEX_n
!
IMPLICIT NONE
@@ -121,6 +127,10 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZEMIS ! emissivity
REAL, DIMENSION(:), ALLOCATABLE :: ZTSRAD ! radiative temperature
REAL, DIMENSION(:), ALLOCATABLE :: ZTSURF
!
+TYPE(DATE) :: TDATE_END
+!
+REAL :: ZDURATION
+!
INTEGER :: ISWB ! number of SW bands
INTEGER :: IIU ! 1st array size
INTEGER :: IJU ! 2nd array size
@@ -172,17 +182,24 @@ DO JLAYER=NSV_AERBEG,NSV_AEREND
HSV(JLAYER) = '@'//TRIM(CAERONAMES(JLAYER-NSV_AERBEG+1))
END DO
!
-ISV = SIZE(HSV)
CALL FIND_FIELD_ID_FROM_MNHNAME('DTCUR',IID,IRESP)
TZTCUR=>TFIELDLIST(IID)%TFIELD_T0D(1)%DATA
-CALL INIT_SURF_ATM_n(YSURF_CUR,'MESONH',HINIT,.FALSE., &
- ILU,ISV,SIZE(PSW_BANDS), &
- HSV,ZCO2,ZRHODREF, &
- ZZENITH,ZAZIM,PSW_BANDS,ZDIR_ALB,ZSCA_ALB, &
- ZEMIS,ZTSRAD,ZTSURF, &
- TZTCUR%TDATE%YEAR, TZTCUR%TDATE%MONTH, &
- TZTCUR%TDATE%DAY, TZTCUR%TIME, &
- ' ',' ', &
+!
+TDATE_END%YEAR = TZTCUR%TDATE%YEAR
+TDATE_END%MONTH = TZTCUR%TDATE%MONTH
+TDATE_END%DAY = TZTCUR%TDATE%DAY
+ZDURATION = NSTOP * XTSTEP + TZTCUR%TIME
+ CALL ADD_FORECAST_TO_DATE_SURF(TDATE_END%YEAR, TDATE_END%MONTH, TDATE_END%DAY, ZDURATION)
+!
+ISV = SIZE(HSV)
+CALL INIT_SURF_ATM_n(YSURF_CUR,'MESONH',HINIT,.FALSE., &
+ ILU,ISV,SIZE(PSW_BANDS), &
+ HSV,ZCO2,ZRHODREF, &
+ ZZENITH,ZAZIM,PSW_BANDS,ZDIR_ALB,ZSCA_ALB, &
+ ZEMIS,ZTSRAD,ZTSURF, &
+ TZTCUR%TDATE%YEAR, TZTCUR%TDATE%MONTH, &
+ TZTCUR%TDATE%DAY, TZTCUR%TIME, &
+ TDATE_END,' ',' ', &
'OK' )
!
PDIR_ALB = XUNDEF
diff --git a/src/MNH/mnhget_surf_paramn.f90 b/src/MNH/mnhget_surf_paramn.f90
index f6d5bd927c1e0041bd4115ab3820511aa95ffd08..238c9d4ae495de607bf0ea77ffb853acefb7952b 100644
--- a/src/MNH/mnhget_surf_paramn.f90
+++ b/src/MNH/mnhget_surf_paramn.f90
@@ -78,6 +78,7 @@ END MODULE MODI_MNHGET_SURF_PARAM_n
!! & correction of index linearisation for NHALO<>1
!! S. Donier 06/2015 : bug surface aerosols
!! 06/2016 (G.Delautier) phasage surfex 8
+!! 01/2018 (G.Delautier) SURFEX 8.1
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -189,11 +190,10 @@ END IF
!
IF (PRESENT(PBARE)) THEN
ALLOCATE(ZBARE ( ILU ))
- CALL GET_SURF_VAR_n(YSURF_CUR%FM%DGF,YSURF_CUR%IM%I,YSURF_CUR%IM%DGI,&
- YSURF_CUR%IM%DGMI,YSURF_CUR%SM%DGS,YSURF_CUR%DGU,&
- YSURF_CUR%TM%DGT,YSURF_CUR%WM%DGW,YSURF_CUR%FM%F,&
- YSURF_CUR%UG, YSURF_CUR%U, YSURF_CUR%USS,&
- 'MESONH', ILU, 1, PNATURE=ZNATURE, PBARE=ZBARE)
+ CALL GET_SURF_VAR_n(YSURF_CUR%FM,YSURF_CUR%IM,YSURF_CUR%SM,YSURF_CUR%TM, &
+ YSURF_CUR%WM,YSURF_CUR%DUO,YSURF_CUR%DU,YSURF_CUR%UG,&
+ YSURF_CUR%U,YSURF_CUR%USS,&
+ 'MESONH', ILU, 1, PNATURE=ZNATURE, PBARE=ZBARE)
CALL REMOVE_HALO(ZBARE,PBARE)
DEALLOCATE(ZBARE)
END IF
@@ -210,7 +210,8 @@ IF (PRESENT(PRN) .OR.PRESENT(PH) .OR.PRESENT(PLE) .OR.PRESENT(PGFLUX).OR. &
ALLOCATE(ZZON10M(ILU), ZMER10M(ILU))
ALLOCATE(ZNETLW (ILU), ZNETSW (ILU))
ALLOCATE(ZCD(ILU), ZEVAP(ILU), ZSUBL(ILU))
- CALL GET_FLUX_n(YSURF_CUR%DGU,'MESONH', ILU,ZRN,ZH,ZLE,ZLEI,ZGFLUX,ZT2M,ZQ2M,ZHU2M,ZZON10M,ZMER10M,&
+ CALL GET_FLUX_n(YSURF_CUR%DUO, YSURF_CUR%DU,'MESONH', &
+ ILU,ZRN,ZH,ZLE,ZLEI,ZGFLUX,ZT2M,ZQ2M,ZHU2M,ZZON10M,ZMER10M,&
ZNETLW,ZNETSW,ZCD,ZEVAP,ZSUBL)
IF(PRESENT(PRN)) PRN=ZRN
IF(PRESENT(PH)) PH=ZH
@@ -240,11 +241,10 @@ IF (PRESENT(PH_TREE) .OR.PRESENT(PLAI_TREE)) THEN
PLAI_TREE(:,:) = XUNDEF
ALLOCATE(ZVH ( ILU ))
ALLOCATE(ZLAI ( ILU ))
- CALL GET_SURF_VAR_n(YSURF_CUR%FM%DGF,YSURF_CUR%IM%I,YSURF_CUR%IM%DGI,&
- YSURF_CUR%IM%DGMI,YSURF_CUR%SM%DGS,YSURF_CUR%DGU,&
- YSURF_CUR%TM%DGT,YSURF_CUR%WM%DGW,YSURF_CUR%FM%F,&
- YSURF_CUR%UG, YSURF_CUR%U, YSURF_CUR%USS,&
- 'MESONH',ILU,1,PNATURE=ZNATURE,PLAI_TREE=ZLAI,PH_TREE=ZVH)
+ CALL GET_SURF_VAR_n(YSURF_CUR%FM,YSURF_CUR%IM,YSURF_CUR%SM,YSURF_CUR%TM, &
+ YSURF_CUR%WM,YSURF_CUR%DUO,YSURF_CUR%DU,YSURF_CUR%UG,&
+ YSURF_CUR%U,YSURF_CUR%USS,&
+ 'MESONH',ILU,1,PNATURE=ZNATURE,PLAI_TREE=ZLAI,PH_TREE=ZVH)
CALL REMOVE_HALO(ZLAI,PLAI_TREE)
CALL REMOVE_HALO(ZVH,PH_TREE)
DEALLOCATE(ZVH)
diff --git a/src/MNH/mnhput_zsn.f90 b/src/MNH/mnhput_zsn.f90
index ee64bfec3cf7b58f19d7f954335f1e712067c808..952f8646ff21d83dd6e6eaac5161024ed20bb9fa 100644
--- a/src/MNH/mnhput_zsn.f90
+++ b/src/MNH/mnhput_zsn.f90
@@ -52,6 +52,7 @@ END MODULE MODI_MNHPUT_ZS_n
!! -------------
!! Original 01/2004
!! 06/2016 (G.Delautier) phasage surfex 8
+!! 01/2018 (G.Delautier) SURFEX 8.1
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -103,7 +104,7 @@ IL = (IIE-IIB+1)*(IJE-IJB+1)
ALLOCATE(ZZS(IL))
ZZS(:) = RESHAPE (XZS(IIB:IIE,IJB:IJE), (/ IL /) )
!
-CALL PUT_ZS_n(YSURF_CUR%FM%F,YSURF_CUR%IM%I,YSURF_CUR%SM%S,&
+CALL PUT_ZS_n(YSURF_CUR%FM%F,YSURF_CUR%IM%S,YSURF_CUR%SM%S,&
YSURF_CUR%U,YSURF_CUR%TM%TOP,YSURF_CUR%WM%W,'MESONH',IL,ZZS(:))
!
CALL MPPDB_CHECK_SURFEX2D(ZZS,"mnhput_zs_n:ZZS",PRECISION,ILUOUT)
diff --git a/src/MNH/modd_diag_flag.f90 b/src/MNH/modd_diag_flag.f90
index fda235d7a4d8fdeb005dde66660cd6a9c66ce8ff..f5ac8fbcf552809f68b528fab0fc8ff86ef78b6c 100644
--- a/src/MNH/modd_diag_flag.f90
+++ b/src/MNH/modd_diag_flag.f90
@@ -40,6 +40,9 @@
!! C.Lac 10/2016 Add visibility diagnostic
!! 10/2016 (F Brosse) Add prod/loss terms computation for chemistry
!! 10/2017 (G.Delautier) New boundary layer height : replace LBLTOP by CBLTOP
+!! T. Dauhut 10/2017 add parallel 3D clustering
+!! J.-P. Chaboureau 01/2018 add altitude interpolation
+!! J.-P. Chaboureau 01/2018 add coarse graining
!!
!-------------------------------------------------------------------------------
!
@@ -133,5 +136,15 @@ LOGICAL :: LISOPR ! flag to write on isobaric level
REAL,DIMENSION(10):: XISOPR ! list of level for isobaric interpolation
LOGICAL :: LISOTH ! flag to write on isentropic level
REAL,DIMENSION(10):: XISOTH ! list of level for isentropic interpolation
+LOGICAL :: LISOAL ! flag to write on altitude level
+REAL,DIMENSION(99):: XISOAL ! list of level for altitude interpolation
+!
+LOGICAL :: LCOARSE ! flag for coarse graining
+INTEGER :: NDXCOARSE ! gridpoint number for coarse graining
+!
+LOGICAL :: LCLSTR ! flag for 3D clustering
+LOGICAL :: LBOTUP ! to propagate clustering from bottom to top, otherwise top to bottom
+CHARACTER(LEN=8) :: CFIELD ! field on which clustering is applied, could be 'W' or 'CLOUD'
+REAL :: XTHRES ! threshold value to detect the 3D structures
END MODULE MODD_DIAG_FLAG
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index 1da755cf0963df85e8899dcada2baf8f799389d8..bba05aba176e58a97380f63ca610d090e35ff19d 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -248,6 +248,7 @@ END MODULE MODI_MODEL_n
!! 09/2017 Q.Rodier add LTEND_UV_FRC
!! 10/2017 (C.Lac) Necessity to have chemistry processes as
!! the las process modifying XRSVS
+!! 01/2018 (G.Delautier) SURFEX 8.1
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -1331,9 +1332,7 @@ IF (IBAK>0 .AND. IBAK <= NBAK_NUMB ) THEN
IF (KTCOUNT == TBACKUPN(IBAK)%NSTEP) THEN
IF (CSURF=='EXTE') THEN
CALL GOTO_SURFEX(IMI)
- CALL DIAG_SURF_ATM_n(YSURF_CUR%IM%DGEI, YSURF_CUR%FM%DGF, YSURF_CUR%DGL, YSURF_CUR%IM%DGI, &
- YSURF_CUR%SM%DGS, YSURF_CUR%DGU, YSURF_CUR%TM%DGT, YSURF_CUR%WM%DGW, &
- YSURF_CUR%U, YSURF_CUR%USS,'MESONH')
+ CALL DIAG_SURF_ATM_n(YSURF_CUR,'MESONH')
TFILE_SURFEX => TZBAKFILE
CALL WRITE_DIAG_SURF_ATM_n(YSURF_CUR,'MESONH','ALL')
NULLIFY(TFILE_SURFEX)
diff --git a/src/MNH/nband_model.fx90 b/src/MNH/nband_model.fx90
index 9a31f7d1343133c66dd66fdabded2999dd905fac..53afd5948ba507103dc76601f246710c187b3b11 100644
--- a/src/MNH/nband_model.fx90
+++ b/src/MNH/nband_model.fx90
@@ -16,6 +16,7 @@
* and changed name of variables concerned
* indicated by "*MNH"
* named nband_model.f90 and compiled with -Fixed
+* J.Escobar (1/12/2017) bug => intialized all ZV=0.0 in spectr
SUBROUTINE NBMVEC
I ( KIDIA ,KFDIA ,KLON,KLEV,KGL,KCABS,KNG1,KUABS
I , KH2O ,KCO2 ,KO3,KCNT,KN2O,KCH4,KCO,KC11,KC12,KCFC
@@ -526,11 +527,12 @@ C
221 CONTINUE
DO 223 JABS=1,KUABS
DO 222 JL=KIDIA,KFDIA
- ZV(JL,JABS,JKSL)=0.
+C ZV(JL,JABS,JKSL)=0.
222 CONTINUE
223 CONTINUE
224 CONTINUE
C
+ ZV = 0.0
C
LLCNT=.FALSE.
*MNH IF (WNU(1).LT.CLIM(1) .OR. WNU(1).GE.CLIM(2)) ICNT=0
diff --git a/src/MNH/neighboravg.f90 b/src/MNH/neighboravg.f90
new file mode 100644
index 0000000000000000000000000000000000000000..903d0ad280a81063f41477bc28e959b2a46f91d4
--- /dev/null
+++ b/src/MNH/neighboravg.f90
@@ -0,0 +1,253 @@
+!MNH_LIC Copyright 1994-2014 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.
+!######################
+MODULE MODE_NEIGHBORAVG
+!######################
+!
+CONTAINS
+!
+SUBROUTINE BLOCKAVG(PMATIN,KDX,KDY,PMATOUT)
+! #####################################################################
+!
+!! PURPOSE
+!! -------
+!! AVERAGE PMATIN FIELDS BY BLOCK OF DX TIMES DY
+!!
+!! AUTHOR
+!! ------
+!! J. Escobar *L.A.*
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY : JPHEXT
+USE MODD_LBC_N , ONLY : CLBCX, CLBCY
+USE MODE_ll , ONLY : GET_INDICE_ll, GET_OR_ll
+USE MODE_ll , ONLY : LNORTH_ll, LSOUTH_ll, LEAST_ll, LWEST_ll
+USE MODI_GET_HALO , ONLY : GET_HALO
+
+IMPLICIT NONE
+!
+REAL, INTENT(IN),DIMENSION(:,:,:) :: PMATIN
+INTEGER, INTENT(IN) :: KDX,KDY
+REAL, INTENT(INOUT),DIMENSION(:,:,:) :: PMATOUT
+!
+!* 0.1 declarations of local variables
+!
+REAL, DIMENSION(SIZE(PMATIN,1),SIZE(PMATIN,2),SIZE(PMATIN,3)) :: ZSUM, ZTMP
+
+INTEGER :: IIB, IIE, IJB, IJE
+INTEGER :: IIBDX, IJBDY, IDX, IDY
+INTEGER :: IDIM1, IDIM2, IDIM3
+INTEGER :: II, IJ, IXOR_ll, IYOR_ll
+!-------------------------------------------------------------------------------
+!
+!* 1. INITIALIZATION
+! --------------
+!
+! Init the local grid info
+
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+CALL GET_OR_ll('B', IXOR_ll, IYOR_ll)
+
+! shift of the first local pts to DX/DY grid pts
+
+IDX = MOD(IIB+IXOR_ll-1-JPHEXT-1,KDX)
+IDY = MOD(IJB+IYOR_ll-1-JPHEXT-1,KDY)
+
+IF ( IDX .NE. 0 ) IDX = KDX - IDX
+IF ( IDY .NE. 0 ) IDY = KDY - IDY
+
+IIBDX = IIB + IDX
+IJBDY = IJB + IDY
+
+! Init Sum
+
+CALL GET_HALO(PMATIN)
+ZSUM = 0.0
+ZTMP = PMATIN
+
+ZSUM(IIBDX:IIE:KDX,:,:) = PMATIN(IIBDX:IIE:KDX,:,:)
+
+! Do the sum on mod(X,KDX) column
+
+DO II = 1, KDX-1
+ IF (LEAST_ll() .AND. CLBCX(2)/='CYCL') ZTMP(IIE+1,:,:) = 0.0
+ CALL GET_HALO(ZTMP)
+ ZTMP(IIB:IIE,:,:) = ZTMP(IIB+1:IIE+1,:,:)
+ ZSUM(IIBDX:IIE:KDX,:,:) = ZSUM(IIBDX:IIE:KDX,:,:) + ZTMP(IIBDX:IIE:KDX,:,:)
+END DO
+
+ZTMP = ZSUM
+
+! DO the sum on mod(Y,KDY) raw
+
+DO IJ = 1, KDY-1
+ IF (LNORTH_ll() .AND. CLBCY(2)/='CYCL') ZTMP(:,IJE+1,:) = 0.0
+ CALL GET_HALO(ZTMP)
+ ZTMP(IIB:IIE,IJB:IJE,:) = ZTMP(IIB:IIE,IJB+1:IJE+1,:)
+ ZSUM(IIBDX:IIE:KDX,IJBDY:IJE:KDY,:) = ZSUM(IIBDX:IIE:KDX,IJBDY:IJE:KDY,:) &
+ + ZTMP(IIBDX:IIE:KDX,IJBDY:IJE:KDY,:)
+END DO
+
+ZTMP = 0.0
+
+! Dispatch sum on mod(Y,KDY) raw
+
+ZTMP(IIBDX:IIE:KDX,IJBDY:IJE:KDY,:) = ZSUM(IIBDX:IIE:KDX,IJBDY:IJE:KDY,:)
+
+DO IJ = 1, KDY-1
+ IF (LSOUTH_ll() .AND. CLBCY(1)/='CYCL') ZTMP(:,IJB-1,:) = 0.0
+ CALL GET_HALO(ZTMP)
+ ZTMP(IIB:IIE,IJB:IJE,:) = ZTMP(IIB:IIE,IJB-1:IJE-1,:)
+ ZTMP(IIBDX:IIE:KDX,IJBDY:IJE:KDY,:) = ZSUM(IIBDX:IIE:KDX,IJBDY:IJE:KDY,:)
+END DO
+
+
+! Dispatch sum on mod(X,KDX) column
+
+ZSUM(IIBDX:IIE:KDX,:,:) = ZTMP(IIBDX:IIE:KDX,:,:)
+
+DO II = 1, KDX-1
+ IF (LWEST_ll() .AND. CLBCX(1)/='CYCL') ZTMP(IIB-1,:,:) = 0.0
+ CALL GET_HALO(ZTMP)
+ ZTMP(IIB:IIE,:,:) = ZTMP(IIB-1:IIE-1,:,:)
+ ZTMP(IIBDX:IIE:KDX,:,:) = ZSUM(IIBDX:IIE:KDX,:,:)
+END DO
+
+CALL GET_HALO(ZTMP)
+PMATOUT(:,:,:) = ZTMP(:,:,:) / float(KDX*KDY)
+
+END SUBROUTINE BLOCKAVG
+
+SUBROUTINE MOVINGAVG(PMATIN,KDX,KDY,PMATOUT)
+! #####################################################################
+!
+!! PURPOSE
+!! -------
+!! MOVING AVERAGE PMATIN FIELDS OVER OF DX TIMES DY
+!!
+!! AUTHOR
+!! ------
+!! J. Escobar *L.A.*
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+USE MODD_PARAMETERS, ONLY : JPHEXT
+USE MODD_LBC_N , ONLY : CLBCX,CLBCY
+USE MODE_ll , ONLY : GET_INDICE_ll , GET_OR_ll
+USE MODE_ll , ONLY : LNORTH_ll , LSOUTH_ll, LEAST_ll , LWEST_ll
+USE MODI_GET_HALO , ONLY : GET_HALO
+
+IMPLICIT NONE
+!
+REAL, INTENT(IN),DIMENSION(:,:,:) :: PMATIN
+INTEGER, INTENT(IN) :: KDX,KDY
+REAL, INTENT(INOUT),DIMENSION(:,:,:) :: PMATOUT
+!local var
+
+REAL, DIMENSION(SIZE(PMATIN,1),SIZE(PMATIN,2),SIZE(PMATIN,3)) :: ZSUMP1 , ZSUMM1 , ZTMP , ZTMP2
+
+INTEGER :: IIB,IIE,IJB,IJE
+
+INTEGER :: II, IJ, IXOR_ll, IYOR_ll , ISX
+
+ ! Init the local grid info
+
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+
+ ! Init Sum
+
+ZTMP = PMATIN
+
+ ! shift input tab to -KDX , -KDY
+
+CALL SHIFTXY(ZTMP,-KDX,-KDY)
+
+ZSUMP1 = 0.0
+
+ISX = +1
+DO IJ = 1 , 2*KDY +1
+! Do the sum on X+/-1
+ DO II = 1 , 2*KDX +1
+ ZSUMP1 = ZSUMP1 + ZTMP
+ IF ( II .NE. 2*KDY +1 ) THEN
+ CALL SHIFTXY(ZTMP,ISX,0)
+ END IF
+ END DO
+! Do the sum on Y+1
+ CALL SHIFTXY(ZTMP,0,1)
+ ISX = - ISX
+END DO
+
+PMATOUT(:,:,:) = ZSUMP1(:,:,:) / FLOAT((1+2*KDX)*(1+2*KDY))
+
+END SUBROUTINE MOVINGAVG
+
+SUBROUTINE SHIFTXY(PTAB,KDX,KDY)
+
+USE MODE_ll , ONLY : GET_INDICE_ll , GET_OR_ll
+USE MODE_ll , ONLY : LNORTH_ll , LSOUTH_ll, LEAST_ll , LWEST_ll
+USE MODI_GET_HALO , ONLY : GET_HALO
+
+USE MODD_LBC_N , ONLY : CLBCX,CLBCY
+
+IMPLICIT NONE
+
+!----- Argument
+
+REAL ,DIMENSION(:,:,:) :: PTAB
+INTEGER, INTENT(IN) :: KDX,KDY
+
+!----- Local var
+
+INTEGER :: IIB,IIE,IJB,IJE
+INTEGER :: ISDX,ISDY,IADX,IADY
+INTEGER :: II, IJ
+
+!------ init
+
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+
+ISDX = SIGN(1,KDX)
+ISDY = SIGN(1,KDY)
+IADX = ABS(KDX)
+IADY = ABS(KDY)
+
+!---------- shift in X
+DO II = 1 , IADX
+ IF (LEAST_ll() .AND. CLBCX(2)/='CYCL' ) PTAB(IIE+1,:,:) = 0.0
+ IF (LWEST_ll() .AND. CLBCX(1)/='CYCL' ) PTAB(IIB-1,:,:) = 0.0
+ CALL GET_HALO(PTAB)
+ PTAB(IIB:IIE,:,:) = PTAB(IIB+ISDX:IIE+ISDX,:,:)
+END DO
+
+!---------- shitf in Y
+
+DO IJ = 1 , IADY
+ IF (LNORTH_ll() .AND. CLBCY(2)/='CYCL') PTAB(:,IJE+1,:) = 0.0
+ IF (LSOUTH_ll() .AND. CLBCY(1)/='CYCL') PTAB(:,IJE+1,:) = 0.0
+ CALL GET_HALO(PTAB)
+ PTAB(IIB:IIE,IJB:IJE,:) = PTAB(IIB:IIE,IJB+ISDY:IJE+ISDY,:)
+END DO
+
+CALL GET_HALO(PTAB)
+
+END SUBROUTINE SHIFTXY
+
+END MODULE MODE_NEIGHBORAVG
+
diff --git a/src/MNH/num_diff.f90 b/src/MNH/num_diff.f90
index 7dc3b66c4a68ebe300e9771569a9223191f33d87..af0265cb623c78bda525b7a84e8929a46a0650cd 100644
--- a/src/MNH/num_diff.f90
+++ b/src/MNH/num_diff.f90
@@ -214,6 +214,7 @@ END MODULE MODI_NUM_DIFF
!! 05/07 (C.Lac) Separation between variables
!! 07/09 (C.Lac) Correction on budget calls
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! J.Escobar : 05/12/2017 : Pb SegFault , correct IF(ONUMDIFTH/OZDIFFU) nesting
!!
!-------------------------------------------------------------------------------
!
@@ -347,20 +348,20 @@ IF (ONUMDIFTH) THEN
CALL NUM_DIFF_ALGO_Z(PRTHS, PTHM, IGRID, PRHODJ, &
PDK2TH, PDK4TH, PLSTHM, &
TZHALO2LIST%HALO2, TZHALO2LSLIST%HALO2)
-!!$ ELSE
-!!$ CALL NUM_DIFF_ALGO(PRTHS, PTHM, IGRID, PRHODJ, &
-!!$ PDK2TH, PDK4TH, PLSTHM, &
-!!$ TZHALO2LIST%HALO2, TZHALO2LSLIST%HALO2)
-!!$ ENDIF
- ELSE
- IF (OZDIFFU) THEN ! call z-diffusion for potential temperature
- CALL NUM_DIFF_ALGO_Z(PRTHS, PTHM, IGRID, PRHODJ, &
- PDK2TH, PDK4TH, PLSTHM )
ELSE
- CALL NUM_DIFF_ALGO(PRTHS, PTHM, IGRID, PRHODJ, &
- PDK2TH, PDK4TH, PLSTHM )
+ CALL NUM_DIFF_ALGO(PRTHS, PTHM, IGRID, PRHODJ, &
+ PDK2TH, PDK4TH, PLSTHM, &
+ TZHALO2LIST%HALO2, TZHALO2LSLIST%HALO2)
ENDIF
- ENDIF
+!!$ ELSE
+!!$ IF (OZDIFFU) THEN ! call z-diffusion for potential temperature
+!!$ CALL NUM_DIFF_ALGO_Z(PRTHS, PTHM, IGRID, PRHODJ, &
+!!$ PDK2TH, PDK4TH, PLSTHM )
+!!$ ELSE
+!!$ CALL NUM_DIFF_ALGO(PRTHS, PTHM, IGRID, PRHODJ, &
+!!$ PDK2TH, PDK4TH, PLSTHM )
+!!$ ENDIF
+!!$ ENDIF
!
IF ( GTKEALLOC ) THEN
!!$ IF(NHALO == 1) THEN
@@ -383,20 +384,20 @@ IF (ONUMDIFTH) THEN
CALL NUM_DIFF_ALGO_Z(PRRS(:,:,:,1), PRM(:,:,:,1), IGRID, PRHODJ, &
PDK2TH, PDK4TH, &
PLSRVM, TZHALO2LIST%HALO2, TZHALO2LSLIST%HALO2)
-!!$ ELSE
-!!$ CALL NUM_DIFF_ALGO(PRRS(:,:,:,1), PRM(:,:,:,1), IGRID, PRHODJ, &
-!!$ PDK2TH, PDK4TH, PLSRVM, &
-!!$ TZHALO2LIST%HALO2, TZHALO2LSLIST%HALO2)
-!!$ ENDIF
- ELSE
- IF (OZDIFFU) THEN ! call z-diffusion for wv mixing ratio
- CALL NUM_DIFF_ALGO_Z(PRRS(:,:,:,1), PRM(:,:,:,1), IGRID, PRHODJ, &
- PDK2TH, PDK4TH, PLSRVM)
ELSE
- CALL NUM_DIFF_ALGO(PRRS(:,:,:,1), PRM(:,:,:,1), IGRID, PRHODJ, &
- PDK2TH, PDK4TH, PLSRVM)
+ CALL NUM_DIFF_ALGO(PRRS(:,:,:,1), PRM(:,:,:,1), IGRID, PRHODJ, &
+ PDK2TH, PDK4TH, PLSRVM, &
+ TZHALO2LIST%HALO2, TZHALO2LSLIST%HALO2)
ENDIF
- ENDIF
+!!$ ELSE
+!!$ IF (OZDIFFU) THEN ! call z-diffusion for wv mixing ratio
+!!$ CALL NUM_DIFF_ALGO_Z(PRRS(:,:,:,1), PRM(:,:,:,1), IGRID, PRHODJ, &
+!!$ PDK2TH, PDK4TH, PLSRVM)
+!!$ ELSE
+!!$ CALL NUM_DIFF_ALGO(PRRS(:,:,:,1), PRM(:,:,:,1), IGRID, PRHODJ, &
+!!$ PDK2TH, PDK4TH, PLSRVM)
+!!$ ENDIF
+!!$ ENDIF
ENDIF
!
! In some situations, it makes sense to use the z-diffusion also for cloud water, but it is
diff --git a/src/MNH/pgd_grid_io_init_mnh.f90 b/src/MNH/pgd_grid_io_init_mnh.f90
index bf3dce484aa41fcac9e5cc1e11c551e28b5d9382..0e975b441b83921bdb79155b4109b59cf17d2e51 100644
--- a/src/MNH/pgd_grid_io_init_mnh.f90
+++ b/src/MNH/pgd_grid_io_init_mnh.f90
@@ -15,9 +15,9 @@ MODULE MODI_PGD_GRID_IO_INIT_MNH
INTERFACE
! ###############################
#ifdef MNH_PARALLEL
- SUBROUTINE PGD_GRID_IO_INIT_MNH(KGRID_PAR,PGRID_PAR,HGRID,ORECT,KIMAX,KJMAX,KDXRATIO,KDYRATIO)
+ SUBROUTINE PGD_GRID_IO_INIT_MNH(UG,KGRID_PAR,PGRID_PAR,HGRID,ORECT,KIMAX,KJMAX,KDXRATIO,KDYRATIO)
#else
- SUBROUTINE PGD_GRID_IO_INIT_MNH
+ SUBROUTINE PGD_GRID_IO_INIT_MNH(UG)
#endif
! ###############################
!!
@@ -61,6 +61,8 @@ MODULE MODI_PGD_GRID_IO_INIT_MNH
!* 0. DECLARATION
! -----------
!
+ USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+ !
USE MODE_ll
USE MODE_FM
USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT, JPMODELMAX
@@ -80,6 +82,7 @@ MODULE MODI_PGD_GRID_IO_INIT_MNH
! ------------------------------
!
#ifdef MNH_PARALLEL
+ TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
REAL, DIMENSION(KGRID_PAR), INTENT(IN) :: PGRID_PAR ! grid parameters
CHARACTER(LEN=10), INTENT(IN), OPTIONAL :: HGRID
@@ -97,9 +100,9 @@ MODULE MODI_PGD_GRID_IO_INIT_MNH
END MODULE MODI_PGD_GRID_IO_INIT_MNH
! ###############################
#ifdef MNH_PARALLEL
- SUBROUTINE PGD_GRID_IO_INIT_MNH(KGRID_PAR,PGRID_PAR,HGRID,ORECT,KIMAX,KJMAX,KDXRATIO,KDYRATIO)
+ SUBROUTINE PGD_GRID_IO_INIT_MNH(UG,KGRID_PAR,PGRID_PAR,HGRID,ORECT,KIMAX,KJMAX,KDXRATIO,KDYRATIO)
#else
- SUBROUTINE PGD_GRID_IO_INIT_MNH
+ SUBROUTINE PGD_GRID_IO_INIT_MNH(UG)
#endif
! ###############################
!!
@@ -134,11 +137,14 @@ END MODULE MODI_PGD_GRID_IO_INIT_MNH
!! 10/10/2011 J.Escobar call INI_PARAZ_ll
!! 2014 M.Faivre
!! 06/2016 (G.Delautier) phasage surfex 8
+!! 01/2018 (G.Delautier) SURFEX 8.1
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
! -----------
!
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+!
USE MODE_ll
USE MODE_FM
USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT, JPMODELMAX
@@ -159,6 +165,7 @@ IMPLICIT NONE
!* 0.1 Declaration of dummy arguments
! ------------------------------
!
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
#ifdef MNH_PARALLEL
INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
REAL, DIMENSION(KGRID_PAR), INTENT(IN) :: PGRID_PAR ! grid parameters
@@ -201,12 +208,12 @@ IF ( PRESENT(KIMAX) .AND. PRESENT(KJMAX) .AND. PRESENT(HGRID) .AND. PRESENT(OREC
IDXRATIO = KDXRATIO
IDYRATIO = KDYRATIO
ELSE
- CALL GET_SURF_GRID_DIM_n(YSURF_CUR%UG,YGRID,GRECT,IIMAX,IJMAX,KGRID_PAR,PGRID_PAR)
+ CALL GET_SURF_GRID_DIM_n(UG,YGRID,GRECT,IIMAX,IJMAX,KGRID_PAR,PGRID_PAR)
IDXRATIO = 1
IDYRATIO = 1
ENDIF
#else
- CALL GET_SURF_GRID_DIM_n(YSURF_CUR%UG,YGRID,GRECT,IIMAX,IJMAX)
+ CALL GET_SURF_GRID_DIM_n(UG,YGRID,GRECT,IIMAX,IJMAX)
IDXRATIO = 1
IDYRATIO = 1
#endif
diff --git a/src/MNH/prep_ideal_case.f90 b/src/MNH/prep_ideal_case.f90
index 831891e54ea373eff3983a08d8ddfbd647e308ce..af371c97c2aa6933b454da6afbffe05b62d25ad1 100644
--- a/src/MNH/prep_ideal_case.f90
+++ b/src/MNH/prep_ideal_case.f90
@@ -313,6 +313,7 @@
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! 06/2016 (G.Delautier) phasage surfex 8
!! P.Wautelet : 08/07/2016 : removed MNH_NCWRIT define
+!! 01/2018 (G.Delautier) SURFEX 8.1
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -1776,7 +1777,7 @@ IF (CSURF =='EXTE') THEN
! computed ...
IF (LEN_TRIM(CPGD_FILE)==0 .OR. .NOT. LREAD_GROUND_PARAM) THEN
TPGDFILE => TINIFILE
- CALL PGD_GRID_SURF_ATM(YSURF_CUR%UG, YSURF_CUR%U,YSURF_CUR%GCP,'MESONH',TINIFILE%CNAME,'MESONH',.TRUE.)
+ CALL PGD_GRID_SURF_ATM(YSURF_CUR%UG, YSURF_CUR%U,YSURF_CUR%GCP,'MESONH',TINIFILE%CNAME,'MESONH',.TRUE.,HDIR='-')
CALL PGD_SURF_ATM (YSURF_CUR,'MESONH',TINIFILE%CNAME,'MESONH',.TRUE.)
TPGDFILE => TINIFILEPGD
ELSE
@@ -1811,6 +1812,7 @@ IF (CSURF =='EXTE') THEN
TOUTDATAFILE => TZINIFILEPGD
!
TFILE_SURFEX => TZINIFILEPGD
+ ALLOCATE(YSURF_CUR%DUO%CSELECT(0))
CALL WRITE_PGD_SURF_ATM_n(YSURF_CUR,'MESONH')
NULLIFY(TFILE_SURFEX)
CSTORAGE_TYPE='TT'
diff --git a/src/MNH/prep_pgd.f90 b/src/MNH/prep_pgd.f90
index 23e5dae77545e103ce01329992d63ebed316c856..f8bf8dc78fc478b75cbf399ae6f7ec85d5f25cfe 100644
--- a/src/MNH/prep_pgd.f90
+++ b/src/MNH/prep_pgd.f90
@@ -70,6 +70,7 @@
!! 06/2016 (G.Delautier) phasage surfex 8
!! P.Wautelet : 08/07/2016 : removed MNH_NCWRIT define
!! 10/2016 (S.Faroux S.Bielli) correction for NHALO=0
+!! 01/2018 (G.Delautier) SURFEX 8.1
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
@@ -225,10 +226,10 @@ CALL INI_CST
! --------------------
!
CALL PGD_GRID_SURF_ATM(YSURF_CUR%UG, YSURF_CUR%U,YSURF_CUR%GCP,'MESONH',&
- ' ',' ',.FALSE.)
+ ' ',' ',.FALSE.,HDIR='-')
!
CALL EXTEND_GRID_ON_HALO('MESONH',YSURF_CUR%UG, YSURF_CUR%U,&
- YSURF_CUR%UG%NGRID_PAR, YSURF_CUR%UG%XGRID_PAR)
+ YSURF_CUR%UG%G%NGRID_PAR, YSURF_CUR%UG%G%XGRID_PAR)
!
!
!* Initializes all physiographic fields
@@ -271,6 +272,7 @@ CALL IO_WRITE_FIELD(TZFILE,'YOR', NYOR)
CALL IO_WRITE_FIELD(TZFILE,'JPHEXT', JPHEXT)
!
TFILE_SURFEX => TZFILE
+ALLOCATE(YSURF_CUR%DUO%CSELECT(0))
CALL WRITE_PGD_SURF_ATM_n(YSURF_CUR,'MESONH')
NULLIFY(TFILE_SURFEX) !Probably not necessary
!
@@ -284,7 +286,7 @@ IF (.NOT.LCARTESIAN) THEN
ALLOCATE(ZWORK(IIMAX+NHALO*2,IJMAX+NHALO*2))
ALLOCATE(ZWORK_LAT(IIMAX+2*JPHEXT,IJMAX+2*JPHEXT))
ALLOCATE(ZWORK_LON(IIMAX+2*JPHEXT,IJMAX+2*JPHEXT))
- ZWORK=RESHAPE(YSURF_CUR%UG%XLAT, (/ (IIMAX+NHALO*2),(IJMAX+NHALO*2) /) )
+ ZWORK=RESHAPE(YSURF_CUR%UG%G%XLAT, (/ (IIMAX+NHALO*2),(IJMAX+NHALO*2) /) )
IF (NHALO/=0) THEN
ZWORK_LAT=ZWORK(NHALO:(IIMAX+NHALO+1),NHALO:(IJMAX+NHALO+1))
ELSE
@@ -294,7 +296,7 @@ IF (.NOT.LCARTESIAN) THEN
ZWORK_LAT(:,1) = ZWORK_LAT(:,2)
ZWORK_LAT(:,IJMAX+2) = ZWORK_LAT(:,IJMAX+1)
ENDIF
- ZWORK=RESHAPE(YSURF_CUR%UG%XLON, (/ IIMAX+NHALO*2,IJMAX+NHALO*2 /) )
+ ZWORK=RESHAPE(YSURF_CUR%UG%G%XLON, (/ IIMAX+NHALO*2,IJMAX+NHALO*2 /) )
IF (NHALO/=0) THEN
ZWORK_LON=ZWORK(NHALO:(IIMAX+NHALO+1),NHALO:(IJMAX+NHALO+1))
ELSE
diff --git a/src/MNH/prep_surf_mnh.f90 b/src/MNH/prep_surf_mnh.f90
index a67b41f79e2488a9e087d96fbd215985da9007f6..41b2517e82ab245e22b95ee51f74844aac4402aa 100644
--- a/src/MNH/prep_surf_mnh.f90
+++ b/src/MNH/prep_surf_mnh.f90
@@ -47,6 +47,7 @@ END MODULE MODI_PREP_SURF_MNH
!! Original 01/2004
!! 06/2016 (G.Delautier) phasage surfex 8
!! P.Wautelet : 08/07/2016 : removed MNH_NCWRIT define
+!! 01/2018 (G.Delautier) SURFEX 8.1
!------------------------------------------------------------------
!
USE MODD_IO_SURF_MNH, ONLY : COUTFILE
@@ -55,6 +56,8 @@ USE MODD_LUNIT_n, ONLY : CINIFILE, TINIFILE
USE MODD_MNH_SURFEX_n
USE MODD_TIME_n, ONLY : TDTCUR
!
+USE MODE_PREP_CTL, ONLY : PREP_CTL
+!
USE MODI_INIT_PGD_SURF_ATM
USE MODI_PREP_SURF_ATM
USE MODI_WRITE_DIAG_SURF_ATM_N
@@ -71,6 +74,8 @@ CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! type of the Atmospheric file
!* 0.2 Declarations of local variables
! -------------------------------
!
+TYPE (PREP_CTL) :: YLCTL
+!
CHARACTER(LEN=28) :: YPGDFILE =' ' ! name of the pgd file
CHARACTER(LEN=6) :: YPGDFILETYPE =' ' ! type of the pgd file
INTEGER :: ILUOUT0 ! logical unit for listing file
@@ -93,7 +98,7 @@ IF (LEN_TRIM(HATMFILE)==0) YATMFILETYPE=' '
CALL INIT_PGD_SURF_ATM(YSURF_CUR,'MESONH','PRE',HATMFILE,YATMFILETYPE, &
TDTCUR%TDATE%YEAR, TDTCUR%TDATE%MONTH, &
TDTCUR%TDATE%DAY, TDTCUR%TIME )
-CALL PREP_SURF_ATM(YSURF_CUR,'MESONH',HATMFILE,YATMFILETYPE,HATMFILE,YATMFILETYPE)
+CALL PREP_SURF_ATM(YSURF_CUR,'MESONH',HATMFILE,YATMFILETYPE,HATMFILE,YATMFILETYPE,YLCTL)
CALL WRITE_SURF_ATM_n(YSURF_CUR,'MESONH','PRE',.FALSE.)
CALL WRITE_DIAG_SURF_ATM_n(YSURF_CUR,'MESONH','PRE')
!
diff --git a/src/MNH/read_surf_mnh.f90 b/src/MNH/read_surf_mnh.f90
index 1f41d499012acee3c3f56a29175b7f44a3dbf272..bb98c5aa84bd6f78de6875e97cbac5eb900804d0 100644
--- a/src/MNH/read_surf_mnh.f90
+++ b/src/MNH/read_surf_mnh.f90
@@ -114,6 +114,7 @@ END MODULE MODE_READ_SURF_MNH_TOOLS
!!
!! original 01/08/03
!! 10/10/2011 J.Escobar & G.Tanguy change BUGFIX/MNH to BUG/SURFEX version control
+!! 01/2018 (G.Delautier) SURFEX 8.1
!----------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -332,7 +333,7 @@ CALL PRINT_MSG(NVERB_DEBUG,'IO','READ_SURFX1_MNH',TRIM(TPINFILE%CNAME)//': readi
KRESP = 0
ILUOUT = TOUT%NLU
!
-IF (HDIR=='A') THEN
+IF (HDIR=='A'.OR.HDIR=='E') THEN
IIU = NIU_ALL
IJU = NJU_ALL
IIB = NIB_ALL
@@ -376,7 +377,7 @@ ELSE IF (HREC=='XX') THEN
ZWORK(:,:) = 0.
CALL FIND_FIELD_ID_FROM_MNHNAME('XHAT',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
- IF (HDIR/='A') THEN
+ IF (HDIR/='A'.AND.HDIR/='E') THEN
TZFIELD%CDIR = 'XX'
ELSE
TZFIELD%CDIR = '--'
@@ -395,7 +396,7 @@ ELSE IF (HREC=='DX') THEN
ZWORK(:,:) = 0.
CALL FIND_FIELD_ID_FROM_MNHNAME('XHAT',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
- IF (HDIR/='A') THEN
+ IF (HDIR/='A'.AND.HDIR/='E') THEN
TZFIELD%CDIR = 'XX'
ELSE
TZFIELD%CDIR = '--'
@@ -414,7 +415,7 @@ ELSE IF (HREC=='YY') THEN
ZWORK(:,:) = 0.
CALL FIND_FIELD_ID_FROM_MNHNAME('YHAT',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
- IF (HDIR/='A') THEN
+ IF (HDIR/='A'.AND.HDIR/='E') THEN
TZFIELD%CDIR = 'YY'
ELSE
TZFIELD%CDIR = '--'
@@ -433,7 +434,7 @@ ELSE IF (HREC=='DY') THEN
ZWORK(:,:) = 0.
CALL FIND_FIELD_ID_FROM_MNHNAME('YHAT',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
- IF (HDIR/='A') THEN
+ IF (HDIR/='A'.AND.HDIR/='E') THEN
TZFIELD%CDIR = 'YY'
ELSE
TZFIELD%CDIR = '--'
@@ -482,7 +483,7 @@ ELSE
IF (HDIR=='H') THEN
CALL PREPARE_METADATA_READ_SURF(YREC,'XY',4,TYPEREAL,2,'READ_SURFX1_MNH',TZFIELD)
CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK,KRESP)
- ELSEIF (HDIR=='A') THEN
+ ELSEIF (HDIR=='A'.OR.HDIR=='E') THEN
CALL PREPARE_METADATA_READ_SURF(YREC,'--',4,TYPEREAL,2,'READ_SURFX1_MNH',TZFIELD)
CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK,KRESP)
ELSE
@@ -496,7 +497,7 @@ ELSE
WRITE(ILUOUT,*) 'error when reading article ', HREC,'KRESP=',KRESP
WRITE(ILUOUT,*) 'default value may be used, who knows???'
WRITE(ILUOUT,*) ' '
- ELSE IF (HDIR=='H' .OR. HDIR=='A') THEN
+ ELSE IF (HDIR=='H' .OR. HDIR=='A' .OR. HDIR=='E') THEN
CALL PACK_2D_1D(IMASK,ZWORK(IIB:IIE,IJB:IJE),PFIELD)
CALL GET_SURF_UNDEF(ZUNDEF)
!================================================
@@ -619,7 +620,7 @@ IF (HDIR=='H') THEN
ALLOCATE(ZWORK(NIU,NJU,SIZE(PFIELD,2)))
CALL PREPARE_METADATA_READ_SURF(HREC,'XY',4,TYPEREAL,3,'READ_SURFX2_MNH',TZFIELD)
CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK,KRESP)
-ELSEIF (HDIR=='A') THEN
+ELSEIF (HDIR=='A'.OR.HDIR=='E') THEN
ALLOCATE(ZWORK(NIU_ALL,NJU_ALL,SIZE(PFIELD,2)))
CALL PREPARE_METADATA_READ_SURF(HREC,'--',4,TYPEREAL,3,'READ_SURFX2_MNH',TZFIELD)
CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK,KRESP)
@@ -640,7 +641,7 @@ IF (KRESP /=0) THEN
CALL PACK_2D_1D(NMASK,ZWORK(NIB:NIE,NJB:NJE,JP),PFIELD(:,JP))
END DO
DEALLOCATE(ZWORK)
- ELSE IF (HDIR=='A') THEN
+ ELSE IF (HDIR=='A'.OR.HDIR=='E') THEN
DO JP=1,SIZE(PFIELD,2)
CALL PACK_2D_1D(NMASK_ALL,ZWORK(NIB_ALL:NIE_ALL,NJB_ALL:NJE_ALL,JP),PFIELD(:,JP))
END DO
@@ -758,7 +759,7 @@ KRESP = 0
IRESP = 0
ILUOUT = TOUT%NLU
!
-IF (HDIR=='A') THEN
+IF (HDIR=='A'.OR.HDIR=='E') THEN
YDIR="--"
IIU = NIU_ALL
IJU = NJU_ALL
@@ -834,7 +835,7 @@ IF (KRESP /=0) THEN
WRITE(ILUOUT,*) '-------'
WRITE(ILUOUT,*) 'error when reading article ', HREC,'KRESP=',KRESP
WRITE(ILUOUT,*) ' '
-ELSE IF (HDIR=='H' .OR. HDIR=='A') THEN
+ELSE IF (HDIR=='H' .OR. HDIR=='A' .OR. HDIR=='E') THEN
ICOVER=0
DO JL2=1,NCOVER
CALL PACK_2D_1D(IMASK,ZWORK3D(IIB:IIE,IJB:IJE,JL2),PFIELD(:,JL2))
@@ -952,7 +953,7 @@ ILUOUT = TOUT%NLU
!IF (PRESENT(HDIR)) YDIR1 = HDIR
YDIR1 = HDIR
!
-IF (YDIR1=='A') THEN
+IF (YDIR1=='A'.OR.YDIR1=='E') THEN
YDIR="--"
IIU = NIU_ALL
IJU = NJU_ALL
@@ -1023,7 +1024,7 @@ IF (KRESP /=0) THEN
WRITE(ILUOUT,*) '-------'
WRITE(ILUOUT,*) 'error when reading article ', HREC,'KRESP=',KRESP
WRITE(ILUOUT,*) ' '
-ELSE IF (YDIR1=='H' .OR. YDIR1=='A') THEN
+ELSE IF (YDIR1=='H' .OR. YDIR1=='A' .OR. YDIR1=='E') THEN
CALL PACK_2D_1D(IMASK,ZWORK2D(IIB:IIE,IJB:IJE),PFIELD(:))
END IF
!
diff --git a/src/MNH/seriesn.f90 b/src/MNH/seriesn.f90
index a8ea76a4609991e0917d0f97910174dfbbbad432..8a672ef38424b4d3092bc3d48e5056c7073b5ad8 100644
--- a/src/MNH/seriesn.f90
+++ b/src/MNH/seriesn.f90
@@ -42,6 +42,7 @@
!! Original 4/03/2002
!! Oct. 2011 : (P.Le Moigne) Surface series
!! 06/2016 (G.Delautier) phasage surfex 8
+!! 01/2018 (G.Delautier) SURFEX 8.1
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -132,10 +133,9 @@ END IF
IF (LSURF) THEN
KI=(IIE-IIB+1)*(IJE-IJB+1)
ALLOCATE(ZSERIES(KI,5))
- CALL GET_SURF_VAR_n(YSURF_CUR%FM%DGF,YSURF_CUR%IM%I,YSURF_CUR%IM%DGI,&
- YSURF_CUR%IM%DGMI,YSURF_CUR%SM%DGS,YSURF_CUR%DGU,&
- YSURF_CUR%TM%DGT,YSURF_CUR%WM%DGW,YSURF_CUR%FM%F,&
- YSURF_CUR%UG, YSURF_CUR%U, YSURF_CUR%USS,&
+ CALL GET_SURF_VAR_n(YSURF_CUR%FM,YSURF_CUR%IM,YSURF_CUR%SM,YSURF_CUR%TM, &
+ YSURF_CUR%WM,YSURF_CUR%DUO,YSURF_CUR%DU,YSURF_CUR%UG,&
+ YSURF_CUR%U, YSURF_CUR%USS,&
'MESONH',KI,5,PSERIES=ZSERIES)
ZTS(:,:)=0.
ZTMNW(:,:)=0.
diff --git a/src/MNH/set_frc.f90 b/src/MNH/set_frc.f90
index 6461cdbc7831751e9c1ddf053ca93d3684d2501a..ce0ddf00d21862d2de0fbd49f54de9aeb0900622 100644
--- a/src/MNH/set_frc.f90
+++ b/src/MNH/set_frc.f90
@@ -98,6 +98,7 @@ END MODULE MODI_SET_FRC
!! 06/12 (Masson) Removes extrapolations below or above forcing
!! data. Reproduces the same data instead.
!! 09/2017 Q.Rodier add LTEND_UV_FRC
+!! 27/11/17 (Chaboureau) fix bug in allocation relative to LTEND_UV_FRC
!!
!-------------------------------------------------------------------------------
!
@@ -295,6 +296,8 @@ DO JKT = 1,NFRC
DEALLOCATE(ZRVF)
DEALLOCATE(ZGXRF)
DEALLOCATE(ZGYRF)
+ DEALLOCATE(ZTUF)
+ DEALLOCATE(ZTVF)
END IF
ALLOCATE(ZPRESSUF(ILEVELF))
ALLOCATE(ZTHVUF(ILEVELF))
@@ -306,11 +309,14 @@ DO JKT = 1,NFRC
ALLOCATE(ZRVF(ILEVELF))
ALLOCATE(ZGXRF(ILEVELF))
ALLOCATE(ZGYRF(ILEVELF))
+ ALLOCATE(ZTUF(ILEVELF))
+ ALLOCATE(ZTVF(ILEVELF))
!
DO JKU =1,ILEVELF
READ(ILUPRE,*) ZPRESSUF(JKU) &
,ZUF(JKU),ZVF(JKU),ZTHF(JKU),ZRVF(JKU) &
- ,ZWF(JKU),ZGXRF(JKU),ZGYRF(JKU)
+ ,ZWF(JKU),ZGXRF(JKU),ZGYRF(JKU),ZTUF(JKU)&
+ ,ZTVF(JKU)
END DO
!
! read sounding
diff --git a/src/MNH/spawn_surf.f90 b/src/MNH/spawn_surf.f90
index cc27f9cde713d4ac5ff929edc4eb775eb7789db8..95ef4b497cb2c0415298828dc14183b77b9d8840 100644
--- a/src/MNH/spawn_surf.f90
+++ b/src/MNH/spawn_surf.f90
@@ -71,6 +71,7 @@ END MODULE MODI_SPAWN_SURF
!! Original 01/2004
!! 06/2016 (G.Delautier) phasage surfex 8
!! P.Wautelet 08/07/2016 : removed MNH_NCWRIT define
+!! 01/2018 (G.Delautier) SURFEX 8.1
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -90,6 +91,7 @@ USE MODE_ll
USE MODE_FMWRIT
USE MODE_IO_ll
USE MODE_MODELN_HANDLER
+USE MODE_PREP_CTL, ONLY : PREP_CTL
!
USE MODI_INIT_PGD_SURF_ATM
USE MODI_MNHPUT_ZS_n
@@ -113,7 +115,8 @@ LOGICAL, INTENT(IN) :: OSPAWN_SURF ! flag to spawn surface field
!
!* 0.1.3 Declarations of local variables :
!
-INTEGER :: IINFO_ll
+INTEGER :: IINFO_ll
+TYPE (PREP_CTL) :: YLCTL
!
!-------------------------------------------------------------------------------
!
@@ -133,12 +136,13 @@ IF (CSURF=='EXTE') THEN
CALL ZOOM_PGD_SURF_ATM(YSURF_CUR,'MESONH',HINIFILEPGD,'MESONH',TPGDFILE%CNAME,'MESONH')
CALL MNHPUT_ZS_n
!* writing of physiographic fields in the file
+ ALLOCATE(YSURF_CUR%DUO%CSELECT(0))
CALL WRITE_PGD_SURF_ATM_n(YSURF_CUR,'MESONH')
!* rereading of physiographic fields and definition of prognostic fields
CALL INIT_PGD_SURF_ATM(YSURF_CUR,'MESONH','PRE',HINIFILE,'MESONH', &
TDTCUR%TDATE%YEAR, TDTCUR%TDATE%MONTH, &
TDTCUR%TDATE%DAY, TDTCUR%TIME )
- CALL PREP_SURF_ATM(YSURF_CUR,'MESONH',HINIFILE,'MESONH',HINIFILEPGD,'MESONH')
+ CALL PREP_SURF_ATM(YSURF_CUR,'MESONH',HINIFILE,'MESONH',HINIFILEPGD,'MESONH',YLCTL)
!* writing of all surface fields
CALL WRITE_SURF_ATM_n(YSURF_CUR,'MESONH','ALL',.FALSE.)
CALL WRITE_DIAG_SURF_ATM_n(YSURF_CUR,'MESONH','ALL')
diff --git a/src/MNH/write_lfifm1_for_diag.f90 b/src/MNH/write_lfifm1_for_diag.f90
index 992649a0e9e9348ba82dc3e383215ab4da550936..12431d0d3a9c14c41b7be08c277d3ae413b2e733 100644
--- a/src/MNH/write_lfifm1_for_diag.f90
+++ b/src/MNH/write_lfifm1_for_diag.f90
@@ -143,6 +143,7 @@ END MODULE MODI_WRITE_LFIFM1_FOR_DIAG
!! Modification 01/2016 (JP Pinty) Add LIMA
!! C.Lac 04/2016 : add visibility and droplet deposition
!! 10/2017 (G.Delautier) New boundary layer height : replace LBLTOP by CBLTOP
+!! T.Dauhut 10/2017 : add parallel 3D clustering
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -239,6 +240,7 @@ USE MODE_IO_MANAGE_STRUCT,ONLY: IO_FILE_ADD2LIST
USE MODE_THERMO
USE MODE_MODELN_HANDLER
USE MODI_LIDAR
+USE MODI_CLUSTERING
!
USE MODD_MPIF
USE MODD_VAR_ll
@@ -296,6 +298,12 @@ REAL,DIMENSION(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),NMODE_SLT*2):: ZSSLTDEP
REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZSIG_DST, ZRG_DST, ZN0_DST
REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZSIG_SLT, ZRG_SLT, ZN0_SLT
REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZRHOT, ZTMP ! work array
+!
+! GBOTUP = True does clustering from bottom up to top, False top down to surface
+LOGICAL :: GBOTUP ! clustering propagation
+LOGICAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: GCLOUD ! mask
+INTEGER,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ICLUSTERID, ICLUSTERLV
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZCLUSTERID, ZCLUSTERLV, ZCLDSIZE
!ECRITURE DANS UN FICHIER ASCII DE RESULTATS
!INITIALISATION DU NOM DE FICHIER CREE EN PARALLELE AVEC CELUI LFI
@@ -310,6 +318,7 @@ CHARACTER(LEN=3) :: YGRID_SIZE
INTEGER :: IEL,IIELV
CHARACTER(LEN=5) :: YVIEW ! Upward or Downward integration
INTEGER :: IACCMODE
+!
!-------------------------------------------------------------------------------
INTEGER :: IAUX ! work variable
REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZWORK35,ZWORK36
@@ -2546,6 +2555,60 @@ ENDIF
!
!-------------------------------------------------------------------------------
!
+!* Clustering
+!
+IF (LCLSTR) THEN
+ GCLOUD(:,:,:)=.FALSE.
+ GBOTUP=LBOTUP
+ IF (CFIELD=='W') THEN
+ WHERE(XWT(:,:,:).GT.XTHRES) GCLOUD(:,:,:)=.TRUE.
+ END IF
+ IF (CFIELD=='CLOUD') THEN
+ WHERE((XRT(:,:,:,2)+XRT(:,:,:,4)+XRT(:,:,:,5)+XRT(:,:,:,6)).GT.XTHRES) GCLOUD(:,:,:)=.TRUE.
+ END IF
+ PRINT *,'CALL CLUSTERING COUNT(GCLOUD)=',COUNT(GCLOUD)
+ CALL CLUSTERING(GBOTUP,GCLOUD,XWT,ICLUSTERID,ICLUSTERLV,ZCLDSIZE)
+ PRINT *,'GOT OUT OF CLUSTERING'
+ !
+ ZCLUSTERID=ICLUSTERID
+ ZCLUSTERLV=ICLUSTERLV
+ !
+ TZFIELD%CMNHNAME = 'CLUSTERID'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'CLUSTERID'
+ TZFIELD%CUNITS = ''
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_CLUSTER (ID NUMBER)'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZCLUSTERID)
+ !
+ TZFIELD%CMNHNAME = 'CLUSTERLV'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'CLUSTERLV'
+ TZFIELD%CUNITS = ''
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_CLUSTER (BASE OR TOP LEVEL)'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZCLUSTERLV)
+ !
+ TZFIELD%CMNHNAME = 'CLDSIZE'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'CLDSIZE'
+ TZFIELD%CUNITS = ''
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_CLDSIZE (HOR. SECTION)'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZCLDSIZE)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
!* Geostrophic and Ageostrophic wind (m/s)
!
IF (LGEO .OR. LAGEO) THEN
diff --git a/src/MNH/write_lfifm1_for_diag_supp.f90 b/src/MNH/write_lfifm1_for_diag_supp.f90
index 2e2ba73465dfc247842f89ef7550a19beaa9f562..989dcbefb4c1ce904e7bbbce16135be6f02bd459 100644
--- a/src/MNH/write_lfifm1_for_diag_supp.f90
+++ b/src/MNH/write_lfifm1_for_diag_supp.f90
@@ -89,6 +89,8 @@ END MODULE MODI_WRITE_LFIFM1_FOR_DIAG_SUPP
!! J.-P. Chaboureau 31/10/2016 add the call to RTTOV11
!! F. Brosse 10/2016 add chemical production destruction terms outputs
!! M.Leriche 01/07/2017 Add DIAG chimical surface fluxes
+!! J.-P. Chaboureau 01/2018 add altitude interpolation
+!! J.-P. Chaboureau 01/2018 add coarse graining
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -145,6 +147,7 @@ USE MODI_GRADIENT_V
USE MODI_GRADIENT_UV
!
USE MODI_SHUMAN
+USE MODE_NEIGHBORAVG
#ifdef MNH_RTTOV_8
USE MODI_CALL_RTTOV8
#endif
@@ -203,6 +206,18 @@ REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZVOX,ZVOY,ZVOZ
REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZCORIOZ
TYPE(TFIELDDATA) :: TZFIELD
TYPE(TFIELDDATA),DIMENSION(2) :: TZFIELD2
+!
+! variables needed for altitude interpolation
+INTEGER :: IAL
+REAL :: ZFILLVAL
+REAL, DIMENSION(:), ALLOCATABLE :: ZAL
+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
+CHARACTER(LEN=3) :: YDX
!-------------------------------------------------------------------------------
!
!* 0. ARRAYS BOUNDS INITIALIZATION
@@ -1167,10 +1182,255 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
!
DEALLOCATE(ZWTH,ZTH,ZWORK32,ZWORK33,ZWORK34)
END IF
+!-------------------------------------------------------------------------------
+!
+!* 6. DIAGNOSTIC ON ALTITUDE LEVELS
+! -----------------------------
+!
+IF (LISOAL .AND.XISOAL(1)/=0.) THEN
+!
+!
+ ZFILLVAL = -99999.
+ ALLOCATE(ZWORK32(IIU,IJU,IKU))
+ ALLOCATE(ZWORK33(IIU,IJU,IKU))
+!
+! *************************************************
+! Determine the altitude level where to interpolate
+! *************************************************
+ IAL=0
+ DO JI=1,SIZE(XISOAL)
+ IF (XISOAL(JI)<0.) EXIT
+ IAL=IAL+1
+ END DO
+ ALLOCATE(ZWAL(IIU,IJU,IAL))
+ ZWAL(:,:,:)=XUNDEF
+ ALLOCATE(ZAL(IAL))
+ ZAL(:) = XISOAL(1:IAL)
+ PRINT *,'ALTITUDE LEVELS WHERE TO INTERPOLATE=',ZAL(:)
+! *********************
+! Altitude
+! *********************
+ TZFIELD%CMNHNAME = 'ALT_ALT'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'ALT_ALT'
+ TZFIELD%CUNITS = 'm'
+ TZFIELD%CDIR = '--'
+ TZFIELD%CCOMMENT = 'Z_alt ALT'
+ TZFIELD%NGRID = 0
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 1
+ CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZAL)
+!
+!* Standard Variables
+!
+! *********************
+! Cloud
+! *********************
+ IF (SIZE(XRT,4) >= 5) THEN
+ ZWORK31(:,:,:) = (XRT(:,:,:,2)+XRT(:,:,:,4)+XRT(:,:,:,5))*1.E3
+ CALL ZINTER(ZWORK31, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
+ WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
+ TZFIELD%CMNHNAME = 'ALT_CLOUD'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'ALT_CLOUD'
+ TZFIELD%CUNITS = 'g kg-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_cloud ALT'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWAL)
+ END IF
+! *********************
+! Precipitation
+! *********************
+ IF (SIZE(XRT,4) >= 6) THEN
+ ZWORK31(:,:,:) = (XRT(:,:,:,2)+XRT(:,:,:,6))*1.E3
+ CALL ZINTER(ZWORK31, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
+ WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
+ TZFIELD%CMNHNAME = 'ALT_PRECIP'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'ALT_PRECIP'
+ TZFIELD%CUNITS = 'g kg-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_precipitation ALT'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWAL)
+ END IF
+! *********************
+! Pressure
+! *********************
+ CALL ZINTER(XPABST, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
+ WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
+ TZFIELD%CMNHNAME = 'ALT_PRESSURE'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'ALT_PRESSURE'
+ TZFIELD%CUNITS = 'Pa'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_pressure ALT'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWAL)
+! *********************
+! Potential Vorticity
+! *********************
+ ZCORIOZ(:,:,:)=SPREAD( XCORIOZ(:,:),DIM=3,NCOPIES=IKU )
+ ZVOX(:,:,:)=GY_W_VW(1,IKU,1,XWT,XDYY,XDZZ,XDZY)-GZ_V_VW(1,IKU,1,XVT,XDZZ)
+ ZVOX(:,:,2)=ZVOX(:,:,3)
+ ZVOY(:,:,:)=GZ_U_UW(1,IKU,1,XUT,XDZZ)-GX_W_UW(1,IKU,1,XWT,XDXX,XDZZ,XDZX)
+ ZVOY(:,:,2)=ZVOY(:,:,3)
+ ZVOZ(:,:,:)=GX_V_UV(1,IKU,1,XVT,XDXX,XDZZ,XDZX)-GY_U_UV(1,IKU,1,XUT,XDYY,XDZZ,XDZY)
+ ZVOZ(:,:,2)=ZVOZ(:,:,3)
+ ZVOZ(:,:,1)=ZVOZ(:,:,3)
+ ZWORK31(:,:,:)=GX_M_M(1,IKU,1,XTHT,XDXX,XDZZ,XDZX)
+ ZWORK32(:,:,:)=GY_M_M(1,IKU,1,XTHT,XDYY,XDZZ,XDZY)
+ ZWORK33(:,:,:)=GZ_M_M(1,IKU,1,XTHT,XDZZ)
+ ZPOVO(:,:,:)= ZWORK31(:,:,:)*MZF(1,IKU,1,MYF(ZVOX(:,:,:))) &
+ + ZWORK32(:,:,:)*MZF(1,IKU,1,MXF(ZVOY(:,:,:))) &
+ + ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:))
+ ZPOVO(:,:,:)= ZPOVO(:,:,:)*1E6/XRHODREF(:,:,:)
+ ZPOVO(:,:,1) =-1.E+11
+ ZPOVO(:,:,IKU)=-1.E+11
+ CALL ZINTER(ZPOVO, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
+ WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
+ TZFIELD%CMNHNAME = 'ALT_PV'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'ALT_PV'
+ TZFIELD%CUNITS = 'PVU'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Potential Vorticity ALT'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWAL)
+! *********************
+! Wind
+! *********************
+ ZWORK31(:,:,:) = MXF(XUT(:,:,:))
+ CALL ZINTER(ZWORK31, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
+ WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
+ TZFIELD%CMNHNAME = 'ALT_U'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'ALT_U'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_U component of wind ALT'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWAL)
+ !
+ ZWORK31(:,:,:) = MYF(XVT(:,:,:))
+ CALL ZINTER(ZWORK31, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
+ WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
+ TZFIELD%CMNHNAME = 'ALT_V'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'ALT_V'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_V component of wind ALT'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWAL)
+! *********************
+! Dust extinction (optical depth per km)
+! *********************
+ IF (NRAD_3D >= 1.AND.LDUST) THEN
+ DO JK=IKB,IKE
+ IKRAD = JK - JPVEXT
+ ZWORK31(:,:,JK)= XAER(:,:,IKRAD,3)/(XZZ(:,:,JK+1)-XZZ(:,:,JK))*1.D3
+ ENDDO
+ CALL ZINTER(ZWORK31, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
+ WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
+ TZFIELD%CMNHNAME = 'ALT_DSTEXT'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'ALT_DSTEXT'
+ TZFIELD%CUNITS = 'km-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_DuST EXTinction ALT'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWAL)
+ END IF
+!
+! *********************
+ DEALLOCATE(ZWAL,ZAL,ZWORK32,ZWORK33)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. COARSE GRAINING DIAGNOSTIC
+! --------------------------
+!
+IF (LCOARSE) THEN
+ IDX = NDXCOARSE
+!-------------------------------
+! AVERAGE OF TKE BY BLOCK OF IDX POINTS
+ CALL BLOCKAVG(XUT,IDX,IDX,ZWORK31)
+ ZUT_PRM=XUT-ZWORK31
+ CALL BLOCKAVG(XVT,IDX,IDX,ZWORK31)
+ ZVT_PRM=XVT-ZWORK31
+ CALL BLOCKAVG(XWT,IDX,IDX,ZWORK31)
+ ZWT_PRM=XWT-ZWORK31
+!
+ ZWORK31=MXF(ZUT_PRM*ZUT_PRM)
+ CALL BLOCKAVG(ZWORK31,IDX,IDX,ZUU_AVG)
+ ZWORK31=MYF(ZVT_PRM*ZVT_PRM)
+ CALL BLOCKAVG(ZWORK31,IDX,IDX,ZVV_AVG)
+ ZWORK31=MZF(1,IKU,1,ZWT_PRM*ZWT_PRM)
+ CALL BLOCKAVG(ZWORK31,IDX,IDX,ZWW_AVG)
+ CALL BLOCKAVG(XTKET,IDX,IDX,ZWORK31)
+ ZWORK31=0.5*( ZUU_AVG+ZVV_AVG+ZWW_AVG ) + ZWORK31
+ WRITE (YDX,FMT='(I3.3)') IDX
+ TZFIELD%CMNHNAME = 'TKEBAVG'//YDX
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'TKEBAVG'//YDX
+ TZFIELD%CUNITS = 'm2 s-2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'TKE_BLOCKAVG'//YDX
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+!---------------------------------
+! MOVING AVERAGE OF TKE OVER IDX+1 POINTS
+ IDX = IDX/2
+ CALL MOVINGAVG(XUT,IDX,IDX,ZWORK31)
+ ZUT_PRM=XUT-ZWORK31
+ CALL MOVINGAVG(XVT,IDX,IDX,ZWORK31)
+ ZVT_PRM=XVT-ZWORK31
+ CALL MOVINGAVG(XWT,IDX,IDX,ZWORK31)
+ ZWT_PRM=XWT-ZWORK31
+!
+ ZWORK31=MXF(ZUT_PRM*ZUT_PRM)
+ CALL MOVINGAVG(ZWORK31,IDX,IDX,ZUU_AVG)
+ ZWORK31=MYF(ZVT_PRM*ZVT_PRM)
+ CALL MOVINGAVG(ZWORK31,IDX,IDX,ZVV_AVG)
+ ZWORK31=MZF(1,IKU,1,ZWT_PRM*ZWT_PRM)
+ CALL MOVINGAVG(ZWORK31,IDX,IDX,ZWW_AVG)
+ CALL MOVINGAVG(XTKET,IDX,IDX,ZWORK31)
+ ZWORK31=0.5*( ZUU_AVG+ZVV_AVG+ZWW_AVG ) + ZWORK31
+ WRITE (YDX,FMT='(I3.3)') 2*IDX+1
+ TZFIELD%CMNHNAME = 'TKEMAVG'//YDX
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'TKEMAVG'//YDX
+ TZFIELD%CUNITS = 'm2 s-2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'TKE_MOVINGAVG'//YDX
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+END IF
!
!-------------------------------------------------------------------------------
!
-!* 6. DIAGNOSTIC RELATED TO CHEMISTRY
+!* 8. DIAGNOSTIC RELATED TO CHEMISTRY
! -------------------------------
!
IF (NEQ_BUDGET>0) THEN
diff --git a/src/MNH/write_lfin.f90 b/src/MNH/write_lfin.f90
index 8c66ddb220fbe56af4fe26053d1082068d432cef..715c0486b5f672ef558fbcd593dff5417cc4c0fd 100644
--- a/src/MNH/write_lfin.f90
+++ b/src/MNH/write_lfin.f90
@@ -169,6 +169,7 @@ END MODULE MODI_WRITE_LFIFM_n
!! Modification 01/2016 (JP Pinty) Add LIMA
!! M.Mazoyer 04/16 : Add supersaturation fields
!! P.Wautelet 11/07/2016 removed MNH_NCWRIT define
+!! JP Chaboureau 27/11/2017 add wind tendency forcing
!!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/write_surf_mnh.f90 b/src/MNH/write_surf_mnh.f90
index 74ef2feb05c1ace64b1e0dc79400e276330fc4da..5514104b5adf745d5ac7a57f90da84480b65364e 100644
--- a/src/MNH/write_surf_mnh.f90
+++ b/src/MNH/write_surf_mnh.f90
@@ -488,6 +488,7 @@ END SUBROUTINE WRITE_SURFX1_MNH
!!
!! original 01/08/03
!! 06/2016 (G.Delautier) phasage surfex 8
+!! 01/2018 (G.Delautier) SURFEX 8.1
!----------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -518,7 +519,7 @@ IMPLICIT NONE
CHARACTER(LEN=LEN_HREC), INTENT(IN) :: HREC ! name of the article to write
INTEGER, INTENT(IN) :: KL1,KL2 ! number of points
REAL, DIMENSION(KL1,KL2), INTENT(IN) :: PFIELD ! array containing the data field
-LOGICAL,DIMENSION(JPCOVER),INTENT(IN) :: OFLAG ! mask for array filling
+LOGICAL,DIMENSION(:), INTENT(IN) :: OFLAG ! mask for array filling
INTEGER, INTENT(OUT) :: KRESP ! return-code if a problem appears
CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field :
diff --git a/src/Makefile.MESONH.mk b/src/Makefile.MESONH.mk
index 08f0a5f11fb5d6ce14085a8495df8a5eadcef567..7f6f3cdb26e930d3877609aba9098e2af10e57b5 100644
--- a/src/Makefile.MESONH.mk
+++ b/src/Makefile.MESONH.mk
@@ -49,9 +49,11 @@ DIR_MASTER += $(DIR_MNH)
CPPFLAGS += $(CPPFLAGS_MNH)
INC += $(INC_MNH)
-ifeq "$(MNH_INT)" "8"
-CPPFLAGS += -DMNH_INT=8
-endif
+#
+# MNH integer 4/8
+#
+CPPFLAGS += -DMNH_INT=$(MNH_INT)
+#
#
# Len of HREC characters
diff --git a/src/Rules.LXgfortran.mk b/src/Rules.LXgfortran.mk
index b5b3fb6b7b00aa1b1b88a97e81275a20316989d7..4f994bbf6d98da3c8a0bdc3d9be669fd8af086ef 100644
--- a/src/Rules.LXgfortran.mk
+++ b/src/Rules.LXgfortran.mk
@@ -100,9 +100,10 @@ HDF_CONF= CFLAGS=-std=c99
## LIBTOOLS flags
#
#if MNH_TOOLS exists => compile the tools if gfortran >= 5.X
-#ifeq ($(shell test $$( gfortran -dumpversion | cut -b1 ) -ge 5 ; echo $$?),0)
+ifeq "$(MNH_INT)" "4"
ifeq ($(shell test $(GFV) -ge 500 ; echo $$?),0)
- MNH_TOOLS = yes
+MNH_TOOLS=yes
+endif
endif
#
#
diff --git a/src/Rules.LXifort.mk b/src/Rules.LXifort.mk
index 92f8e8b526af6363777f8fe57d1e7683d0daa87b..92c9a496070fd5998c0e357b4599f7f09634e226 100644
--- a/src/Rules.LXifort.mk
+++ b/src/Rules.LXifort.mk
@@ -13,7 +13,7 @@ OPT_BASE = -g -w -assume nosource_include -assume byterecl -fpe0 -ftz -fpic -
OPT_PERF0 = -O0
OPT_PERF2 = -O2
OPT_PERF3 = -O3 -xHost
-OPT_CHECK = -CB -ftrapuv
+OPT_CHECK = -CB -ftrapuv -debug-parameters all
OPT_I8 = -i8
OPT_R8 = -r8
#
@@ -130,7 +130,9 @@ CNAME_GRIBEX=ifort
# LIBTOOLS flags
#
#if MNH_TOOLS exists => compile the tools
-MNH_TOOLS = yes
+ifeq "$(MNH_INT)" "4"
+MNH_TOOLS=yes
+endif
#
##########################################################
# #
diff --git a/src/SURFEX/adapt_horibl_surf.F90 b/src/SURFEX/adapt_horibl_surf.F90
deleted file mode 100644
index 010dfbc945ff328bba8c5e28991b7f71aba1793a..0000000000000000000000000000000000000000
--- a/src/SURFEX/adapt_horibl_surf.F90
+++ /dev/null
@@ -1,792 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE ADAPT_HORIBL_SURF(PILATARRAY,PILA1,PILO1,PILA2,PILO2,KINLA,KINLO,&
- KILEN,PARIN,KOLEN,PXOUT,PYOUT,PAROUT,ODVECT, &
- KLUOUT,OINTERP,KLSMIN,KLSMOUT )
-! ###########################################################################
-!
-!!**** *HORIBL_SURF* - horitontal bilinear interpolation
-!!
-!! PURPOSE
-!! -------
-!!
-!! Interpolates a field, supports masks.
-!!
-!! METHOD
-!! ------
-!!
-!! This routine performs a bilinear interpolation based on the 12 surrounding
-!! points. It begins with an interpolation along the latitudes (with third order
-!! polynoms interpolation with 4 points and linear interpolation for 2 points)
-!! and then a second along the longitude (third order polynoms interpolation).
-!! Two interpolations are performed : first along the parallels then between the
-!! four resulting points.
-!!
-!! The disposition of the points is the following :
-!!
-!!
-!! N 1 2
-!!
-!! ^ 3 4 5 6
-!! | x
-!! | 7 8 9 10
-!! |
-!! 11 12
-!! S
-!! W ---------------> E
-!!
-!! Note : the name 'south', 'north', may not be exact if the last data point is
-!! to the south of first (delta latitude < 0). This does not affect computations.
-!!
-!! The formula used to compute the weight is :
-!! (Lon - Lon.i) . (Lon - Lon.i) . (Lon - Lon.i)
-!! Wi = ---------------------------------------------------
-!! (Lon.i - Lon.j) . (Lon.i - Lon.k) . (Lon.i - Lon.l)
-!! Where j,k,l are the other points of the line.
-!!
-!! When masks are used, points with different types than the output points are
-!! not taken in account (in the formula, the corresponding coefficient is set
-!! to 1). If no points of the same nature are available, the interpolation is
-!! performed anyway with the 12 points. It is the task of the calling program
-!! to react to this situation.
-!!
-!! When the inputs parameters define a circular map (or global), the inputs data
-!! are extended. The value of the parameter ODVECT is used to know if the datas
-!! are vectorial or scalar (this affects the sign of extended values).
-!!
-!! EXTERNAL
-!! --------
-!!
-!! subroutine FMLOOK_ll : to retrieve the logical unit number of the listing file
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! This routine is based on the one used by the software FULL-POS from Meteo France.
-!! More informations may be found in 'Book 1'
-!!
-!! AUTHOR
-!! ------
-!!
-!! J.Pettre & V.Bousquet
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!! Original 07/01/1999
-!! 21/04/1999 (V. Masson) set correct prefixes and bug in
-!! a logical definition
-!! 21/04/1999 (V. Masson) bug in north and south poles
-!! extension for input map land-sea mask
-!! 27/05/1999 (V. Masson) bug in 'grib south pole'
-!! extrapolation (number of point per parallel)
-!! 27/05/1999 (V. Masson) bug in 'grib pole' extrapolation
-!! extra latitudes are now computed symetrically
-!! to the poles.
-!!
-!------------------------------------------------------------------------------
-!
-!
-!* 0. DECLARATIONS
-! ---------------
-!
-USE MODI_HOR_EXTRAPOL_SURF
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODI_ABOR1_SFX
-!
-IMPLICIT NONE
-!
-!* 0.1. Declaration of arguments
-!
-REAL, INTENT(IN) :: PILA1 ! Lat. (y) of first input point
-REAL, INTENT(IN) :: PILO1 ! Lon. (x) of first input point
-REAL, INTENT(IN) :: PILA2 ! Lat. (y) of last input point
-REAL, INTENT(IN) :: PILO2 ! Lon. (x) of last input point
-INTEGER, INTENT(IN) :: KINLA ! Number of parallels
-INTEGER, DIMENSION(KINLA), INTENT(IN) :: KINLO ! Number of point along a parallel
-INTEGER, INTENT(IN) :: KILEN ! size of input arrays
-REAL, DIMENSION(KINLA), INTENT(IN) :: PILATARRAY! latitudes array
-REAL, DIMENSION(KILEN), INTENT(IN) :: PARIN ! input array
-INTEGER, INTENT(IN) :: KOLEN ! size of output array
-REAL, DIMENSION(KOLEN), INTENT(IN) :: PXOUT ! X (lon.) of output points
-REAL, DIMENSION(KOLEN), INTENT(IN) :: PYOUT ! Y (lat.) of output points
-REAL, DIMENSION(KOLEN), INTENT(OUT) :: PAROUT ! output array
-LOGICAL, DIMENSION(KOLEN), INTENT(IN) :: OINTERP ! .true. where physical value is needed
-LOGICAL, INTENT(IN) :: ODVECT ! data is vectorial (True/False)
-INTEGER, INTENT(IN) :: KLUOUT ! output listing logical unit
-INTEGER, DIMENSION(KILEN), INTENT(IN), OPTIONAL :: KLSMIN ! input land/sea mask
-INTEGER, DIMENSION(KOLEN), INTENT(IN), OPTIONAL :: KLSMOUT ! output land/sea mask
-!
-!* 0.2. Declaration of local variables
-!
- ! Variables used to perform the interpolation
-REAL :: ZOLA ! Latitude of the output point
-REAL :: ZOLO ! Longitude of the output point
-REAL :: ZIDLA ! Delta latitude
-REAL, DIMENSION(KINLA+1) :: ZIDLAT ! Deltai latitude
-REAL :: ZIDLO ! Delta longitude
-INTEGER, DIMENSION(:), ALLOCATABLE :: IOFS ! Offset of each parallel in the array
- ! Number of the surrounding latitudes
-INTEGER :: IOSS,IOS,ION,IONN
- ! Posiiton in the array of the twelwe surrounding points
-INTEGER :: IP1,IP2,IP3,IP4,IP5,IP6,IP7,IP8,IP9,IP10, &
- IP11,IP12
- ! Latitudes and longitudes of the surrounding points
-REAL :: ZLANN,ZLAN,ZLAS,ZLASS
-REAL :: ZLOP1,ZLOP2,ZLOP3,ZLOP4 ,ZLOP5 ,ZLOP6, &
- ZLOP7,ZLOP8,ZLOP9,ZLOP10,ZLOP11,ZLOP12
- ! Weights of the latitudes and of the points
-REAL :: ZWNN,ZWN,ZWS,ZWSS
-REAL :: ZW1,ZW2,ZW3,ZW4,ZW5,ZW6,ZW7,ZW8,ZW9,ZW10, &
- ZW11,ZW12
- ! Land/sea mask coefficient for each point : 0 -> point not taken in account,
- ! 1 -> point taken in account
-REAL :: ZLSM1,ZLSM2 ,ZLSM3 ,ZLSM4 ,ZLSM5 ,ZLSM6,ZLSM7,ZLSM8, &
- ZLSM9,ZLSM10,ZLSM11,ZLSM12,ZLSMNN,ZLSMN,ZLSMS,ZLSMSS,&
- ZLSMTOT
- ! Variables implied in the extension procedure
-REAL :: ZILO1 ! Longitude of the first data point
-REAL :: ZILO2 ! Longitude of the last data point
-LOGICAL :: GGLOBLON ! True if the map is circular
-LOGICAL :: GGLOBN ! True if the map has the north pole
-LOGICAL :: GGLOBS ! True if the map has the south pole
-INTEGER :: IBIGSIZE ! Size of the extended map
-INTEGER :: IMIDDLE ! Used for extensions around the poles
-INTEGER :: IOFFSET1 ! Offset in map
-INTEGER :: IOFFSET2 ! Offset in map
-REAL :: ZSOUTHPOLE! south pole latitude (-90 or 90)
-REAL :: ZNORTHPOLE! north pole latitude ( 90 or -90)
-REAL, DIMENSION(:), ALLOCATABLE :: ZLA ! input "latitude" coordinate
-REAL, DIMENSION(:), ALLOCATABLE :: ZLO ! input "longitude" coordinate
-REAL, DIMENSION(:), ALLOCATABLE :: ZARIN ! Extended input datas
-INTEGER, DIMENSION(:), ALLOCATABLE :: ILSMIN ! Extended land/sea mask
-INTEGER, DIMENSION(:), ALLOCATABLE :: IINLO ! Extended KINLO
-INTEGER :: IINLA ! Number of parallel
-REAL :: ZVECT ! -1 if input is vectorial
-LOGICAL :: LDLSM ! Specify if land/sea mask is present or not
- ! Loop counters
-INTEGER :: JOPOS ! Output position
-INTEGER :: JIPOS ! Input position
-INTEGER :: JLOOP1 ! Dummy counter
-!
-!
-!------------------------------------------------------------------------------
-REAL :: ZMAX ! Max of 12 surrounding values
-REAL :: ZMIN ! Min of 12 surrounding values
-INTEGER :: JLOOP2 ! Dummy counter
-INTEGER, DIMENSION(12) :: IP ! Array for IPn
-INTEGER :: JLAT ! latitude loop counter
-INTEGER :: JLON ! longitude loop counter
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!------------------------------------------------------------------------------
-!
-!* 1. DETERMINATION of the latitude of the poles (depending of the latitude
-! ------------- of the first data point)
-!
-IF (LHOOK) CALL DR_HOOK('ADAPT_HORIBL_SURF',0,ZHOOK_HANDLE)
-IF (PILA1>0.) THEN
- ZSOUTHPOLE= 90.
- ZNORTHPOLE=-90.
-ELSE
- ZSOUTHPOLE=-90.
- ZNORTHPOLE= 90.
-END IF
-!
-!------------------------------------------------------------------------------
-!
-!* 2. EXTEND DATA GRID
-! ----------------
- ! Land / Sea mask
-LDLSM = .FALSE.
-IF (PRESENT(KLSMIN) .AND. PRESENT(KLSMOUT)) LDLSM = .TRUE.
-!
-!* 2.1 Alias input data
-!
-ZILO1 = PILO1
-ZILO2 = PILO2
-ZVECT = 1.
-IF (ODVECT) ZVECT=-1.
-!
-!* 2.2 Center input domain in order to have Lo1 < Lo 2
-!
-IF (ZILO2 < 0.) ZILO2 = ZILO2 + 360.
-IF (ZILO1 < 0.) ZILO1 = ZILO1 + 360.
-IF (ZILO2 < ZILO1) ZILO1 = ZILO1 - 360.
-!
-!* 2.3 Extend one point (needed for reduced grids)
-!
-! Longitude coordinate of points are found by :
-! i
-! Lon(i) = Lon1 + ------------- . (Lon2 - Lon1)
-! Npts(Lat)-1
-! Where i goes from 0 to Npts(Lat)-1. The result of this is that the last point of
-! each parallel is located at Lon2. This is not the case for reduced grid where the
-! position of the last point depends upon the number of points of the parallel. For
-! reduced grid, the right formula to use is the following :
-! i
-! Lon(i) = Lon1 + ----------- . (Lon2' - Lon1)
-! Npts(Lat)
-! Where Lon2' = Lon1 + 2.PI.
-!
-! Lon2 - Lon1
-! This can be generalized with Lon2' = Lon2 + -------------
-! Nptsmax - 1
-!
-JOPOS = MAXVAL(KINLO(1:KINLA))
-ZILO2 = ZILO1 + (ZILO2 - ZILO1) * JOPOS / (JOPOS - 1.)
-!
-!
-!* 2.4 Test if the input is global or partially global
-!
-! Note that we must have a global map to make extension around the poles
-GGLOBN = .FALSE.
-GGLOBS = .FALSE.
-GGLOBLON = .FALSE.
-IF (ZILO2-360.>ZILO1-1.E-3) GGLOBLON = .TRUE.
-ZIDLA = (PILA2 - PILA1) / (KINLA - 1)
-ZIDLAT(KINLA+1)=0.
-DO JLAT=2,KINLA
- ZIDLAT(JLAT)=PILATARRAY(JLAT)-PILATARRAY(JLAT-1)
-END DO
-ZIDLAT(1)=ZIDLAT(2)
-IF ((PILA1-ZIDLA>= 90.) .OR. (PILA1-ZIDLA<=-90.)) GGLOBS=GGLOBLON
-IF ((PILA2+ZIDLA>= 90.) .OR. (PILA2+ZIDLA<=-90.)) GGLOBN=GGLOBLON
-! Aladin case (input PILA2, PILO2 are in meters) no extension
-IF ( PILA2 > 100. ) THEN
- GGLOBN = .FALSE.
- GGLOBS = .FALSE.
- GGLOBLON = .FALSE.
-END IF
-!
-!* 2.5 Compute the size of the resulting map
-!
-IBIGSIZE = KILEN
-IF (GGLOBS ) IBIGSIZE=IBIGSIZE+(4+KINLO( 1))+(4+KINLO( 2))
-IF (GGLOBN ) IBIGSIZE=IBIGSIZE+(4+KINLO(KINLA))+(4+KINLO(KINLA-1))
-IF (GGLOBLON) IBIGSIZE=IBIGSIZE+ 4*KINLA
-!
-!* 2.6 Compute the resulting map
-!
-ALLOCATE (ZARIN(IBIGSIZE))
-ALLOCATE (ILSMIN(IBIGSIZE))
-!
-! 2.6.1 Compute the longitude extension
-!
-! This is a basic copy of the data. If extension is possible, the first and last
-! two lines are copied twice this way :
-!
-! /---------------\
-! | |
-! [.] [.] [.... ...] [.] [.]
-! | |
-! \------------/
-!
-! A point represent a data.
-!
-JIPOS = 1
-JOPOS = 1
-IF (GGLOBS) JOPOS=JOPOS+(4+KINLO(1))+(4+KINLO(2))
-IF (GGLOBLON) THEN
- DO JLOOP1 = 1, KINLA
- ZARIN(JOPOS ) = PARIN(JIPOS+KINLO(JLOOP1)-2)
- ZARIN(JOPOS+1) = PARIN(JIPOS+KINLO(JLOOP1)-1)
- ZARIN(JOPOS+2:JOPOS+2+KINLO(JLOOP1)-1) = PARIN(JIPOS:JIPOS+KINLO(JLOOP1)-1)
- ZARIN(JOPOS+2+KINLO(JLOOP1) ) = PARIN(JIPOS )
- ZARIN(JOPOS+2+KINLO(JLOOP1)+1) = PARIN(JIPOS+1)
- IF (LDLSM) THEN
- ILSMIN(JOPOS ) = KLSMIN(JIPOS+KINLO(JLOOP1)-2)
- ILSMIN(JOPOS+1) = KLSMIN(JIPOS+KINLO(JLOOP1)-1)
- ILSMIN(JOPOS+2:JOPOS+2+KINLO(JLOOP1)-1) = KLSMIN(JIPOS:JIPOS+KINLO(JLOOP1)-1)
- ILSMIN(JOPOS+2+KINLO(JLOOP1) ) = KLSMIN(JIPOS )
- ILSMIN(JOPOS+2+KINLO(JLOOP1)+1) = KLSMIN(JIPOS+1)
- END IF
- JIPOS = JIPOS + KINLO(JLOOP1)
- JOPOS = JOPOS + KINLO(JLOOP1) + 4
- END DO
-ELSE
- ZARIN(JOPOS:JOPOS+KILEN-1) = PARIN(JIPOS:JIPOS+KILEN-1)
- IF (LDLSM) THEN
- ILSMIN(JOPOS:JOPOS+KILEN-1) = KLSMIN(JIPOS:JIPOS+KILEN-1)
- END IF
-END IF
-!
-! 2.6.2 Compute the south pole extension
-!
-! Pole extension is performed by copying the first half datas to the last half
-! datas of the extension parallel :
-!
-! [.] [.] [....] [....] [.] [.]
-! ||||
-! /-------/
-! ||||
-! [.] [.] [....] [....] [.] [.]
-!
-IF (GGLOBS) THEN ! South pole (south meaning begining of the grib)
- IOFFSET1 = 4 + KINLO(2)
- IOFFSET2 = IOFFSET1 + 4 + KINLO(1)
- IMIDDLE = (KINLO(1)+4) / 2
- ZARIN(IOFFSET1+1:IOFFSET1+IMIDDLE) = &
- ZVECT*ZARIN(IOFFSET2+1+IMIDDLE-2:IOFFSET2+2*IMIDDLE-2)
- ZARIN(IOFFSET1+IMIDDLE+1:IOFFSET1+KINLO(1)+4) = &
- ZVECT*ZARIN(IOFFSET2+1+2:IOFFSET2+KINLO(1)+4-IMIDDLE+2)
- IF (LDLSM) THEN
- ILSMIN(IOFFSET1+1:IOFFSET1+IMIDDLE) = &
- ILSMIN(IOFFSET2+1+IMIDDLE-2:IOFFSET2+2*IMIDDLE-2)
- ILSMIN(IOFFSET1+IMIDDLE+1:IOFFSET1+KINLO(1)+4) = &
- ILSMIN(IOFFSET2+1+2:IOFFSET2+KINLO(1)+4-IMIDDLE+2)
- END IF
- IOFFSET2 = IOFFSET2 + 4 + KINLO(1)
- IMIDDLE = (KINLO(2)+4) / 2
- ZARIN(1:IMIDDLE) = ZVECT*ZARIN(IOFFSET2+1+IMIDDLE-2:IOFFSET2+2*IMIDDLE-2)
- ZARIN(IMIDDLE+1:KINLO(2)+4) = &
- ZVECT*ZARIN(IOFFSET2+1+2:IOFFSET2+KINLO(2)+4-IMIDDLE+2)
- IF (LDLSM) THEN
- ILSMIN(1:IMIDDLE) = ILSMIN(IOFFSET2+1+IMIDDLE:IOFFSET2+2*IMIDDLE)
- ILSMIN(IMIDDLE+1:KINLO(2)+4) = ILSMIN(IOFFSET2+1+2:IOFFSET2+KINLO(2)+4-IMIDDLE+2)
- END IF
-END IF
-!
-! 2.6.3 Compute the north pole extension
-!
-IF (GGLOBN) THEN ! North pole (north meaning end of the grib)
- IOFFSET1 = IBIGSIZE - (4+KINLO(KINLA-1)) - (4+KINLO(KINLA))
- IOFFSET2 = IOFFSET1 - (4+KINLO(KINLA))
- IMIDDLE = (KINLO(KINLA)+4) / 2
- ZARIN(IOFFSET1+1:IOFFSET1+IMIDDLE) = &
- ZVECT*ZARIN(IOFFSET2+1+IMIDDLE-2:IOFFSET2+2*IMIDDLE-2)
- ZARIN(IOFFSET1+IMIDDLE+1:IOFFSET1+KINLO(1)+4) = &
- ZVECT*ZARIN(IOFFSET2+1+2:IOFFSET2+KINLO(1)+4-IMIDDLE+2)
- IF (LDLSM) THEN
- ILSMIN(IOFFSET1+1:IOFFSET1+IMIDDLE) = &
- ILSMIN(IOFFSET2+1+IMIDDLE-2:IOFFSET2+2*IMIDDLE-2)
- ILSMIN(IOFFSET1+IMIDDLE+1:IOFFSET1+KINLO(1)+4) = &
- ILSMIN(IOFFSET2+1+2:IOFFSET2+KINLO(1)+4-IMIDDLE+2)
- END IF
- IOFFSET1 = IOFFSET1 + (4+KINLO(KINLA))
- IOFFSET2 = IOFFSET2 - (4+KINLO(KINLA-1))
- IMIDDLE = (KINLO(KINLA-1)+4) / 2
- ZARIN(IOFFSET1+1:IOFFSET1+IMIDDLE) = &
- ZVECT*ZARIN(IOFFSET2+1+IMIDDLE-2:IOFFSET2+2*IMIDDLE-2)
- ZARIN(IOFFSET1+IMIDDLE+1:IOFFSET1+KINLO(1)+4) = &
- ZVECT*ZARIN(IOFFSET2+1+2:IOFFSET2+KINLO(1)+4-IMIDDLE+2)
- IF (LDLSM) THEN
- ILSMIN(IOFFSET1+1:IOFFSET1+IMIDDLE) = &
- ILSMIN(IOFFSET2+1+IMIDDLE-2:IOFFSET2+2*IMIDDLE-2)
- ILSMIN(IOFFSET1+IMIDDLE+1:IOFFSET1+KINLO(1)+4) = &
- ILSMIN(IOFFSET2+1+2:IOFFSET2+KINLO(1)+4-IMIDDLE+2)
- END IF
-END IF
-!
-!* 2.7 Compute the resulting parameters of the map
-!
-IINLA = KINLA
-IF (GGLOBS) IINLA = IINLA + 2
-IF (GGLOBN) IINLA = IINLA + 2
-!
-ALLOCATE (IINLO(IINLA))
-IOFFSET1 = 0
-IF (GGLOBS) THEN
- IINLO(IOFFSET1+1) = KINLO(2)
- IINLO(IOFFSET1+2) = KINLO(1)
- IOFFSET1 = IOFFSET1 + 2
-END IF
-IINLO(IOFFSET1+1:IOFFSET1+KINLA) = KINLO(1:KINLA)
-IOFFSET1 = IOFFSET1 + KINLA
-IF (GGLOBN) THEN
- IINLO(IOFFSET1+1) = KINLO(KINLA)
- IINLO(IOFFSET1+2) = KINLO(KINLA-1)
- IOFFSET1 = IOFFSET1 + 2
-END IF
-!
-!* 2.8 Compute Offset array used to acces the lines
-!
-ALLOCATE (IOFS(IINLA))
-IOFS(1) = 1
-IF (GGLOBLON) IOFS(1)=IOFS(1)+2
-DO JLOOP1=2, IINLA
- IOFS(JLOOP1) = IOFS(JLOOP1-1) + IINLO(JLOOP1-1)
- IF (GGLOBLON) IOFS(JLOOP1) = IOFS(JLOOP1) + 4
-END DO
-!
-!------------------------------------------------------------------------------
-!
-!* 3. LOOP OVER ALL THE POINTS OF THE OUTPUT GRID
-! -------------------------------------------
-!
-PAROUT(:) = XUNDEF
-!
-JOPOS = 0
-DO JLOOP1 = 1, KOLEN
- JOPOS = JOPOS + 1
- IF (.NOT. OINTERP(JOPOS)) CYCLE
- ZOLA = PYOUT(JOPOS)
- ZOLO = PXOUT(JOPOS)
- IF (ZOLO < ZILO1) ZOLO = ZOLO + 360.
- IF (ZOLO > ZILO2) ZOLO = ZOLO - 360.
-!
-!* 3.1 Locate the 12 input points around the interpolated output point
-!*
-!* N 1 2
-!*
-!* ^ 3 4 5 6
-!* | x
-!* | 7 8 9 10
-!* |
-!* 11 12
-!* S
-!* W ---------------> E
-!*
-!* Note : the name 'south', 'north', may not be exact if the point 2 is
-!* to the south of point 1 (IDLA < 0). This does not affect computation.
-!
- ! 3.1.1. find positions of latitudes
- DO JLAT=1,KINLA
- IF((ZOLA>=(PILATARRAY(JLAT)-ZIDLAT(JLAT )/2.)).AND.(ZOLA<(PILATARRAY(JLAT)&
- +ZIDLAT(JLAT+1)/2.))) IOS = JLAT
- ENDDO
- ZLAS = PILATARRAY(IOS)
- IF (GGLOBS) IOS = IOS + 2
- IOSS = IOS - 1
- ION = IOS + 1
- IONN = ION + 1
- IF (IOSS==0) THEN
- ZLASS=PILATARRAY(1)-ZIDLAT(1)/2.
- ELSE
- ZLASS = PILATARRAY(IOS-1)
- ENDIF
- ZLAN = PILATARRAY(IOS+1)
- ZLANN = PILATARRAY(ION+1)
- !
- ! extra latitudes are computed symetrically compared to the poles
- !
- IF (GGLOBS .AND. IOS==2) THEN
- ZLASS = 2. * ZSOUTHPOLE - ZLANN
- ZLAS = 2. * ZSOUTHPOLE - ZLAN
- END IF
- IF (GGLOBS .AND. IOS==3) THEN
- ZLASS = 2. * ZSOUTHPOLE - ZLAS
- END IF
- IF (GGLOBN .AND. IOS==IINLA-2) THEN
- ZLANN = 2. * ZNORTHPOLE - ZLASS
- ZLAN = 2. * ZNORTHPOLE - ZLAS
- END IF
- IF (GGLOBN .AND. IOS==IINLA-3) THEN
- ZLANN = 2. * ZNORTHPOLE - ZLAN
- END IF
-!
- IF ((IOSS<1).OR.(IONN>IINLA).OR. &
- (IOSS<1).OR.(IONN>IINLA)) THEN
- WRITE (KLUOUT,'(A)') &
- ' -> [HORIBL_SURF.F90] Input domain is smaller than output one - latitude. Abort'
- CALL ABOR1_SFX('ADAPT_HORIBLE_SURF: INPUT DOMAIN TOO SMALL - LATITUDE')
- END IF
-!
- ! 3.1.2. northern
- ZIDLO = (ZILO2 - ZILO1) / (IINLO(IONN))
- IP1 = INT((ZOLO - ZILO1) / ZIDLO)
- IP2 = IP1 + 1
- ZLOP1 = ZILO1 + IP1 * ZIDLO
- ZLOP2 = ZLOP1 + ZIDLO
-!
- ! 3.1.3. north
- ZIDLO = (ZILO2 - ZILO1) / (IINLO(ION ))
- IP4 = INT((ZOLO - ZILO1) / ZIDLO)
- IP3 = IP4 - 1
- IP5 = IP4 + 1
- IP6 = IP5 + 1
- ZLOP4 = ZILO1 + IP4 * ZIDLO
- ZLOP3 = ZLOP4 - ZIDLO
- ZLOP5 = ZLOP4 + ZIDLO
- ZLOP6 = ZLOP5 + ZIDLO
-!
- ! 3.1.4. south
- ZIDLO = (ZILO2 - ZILO1) / (IINLO(IOS ))
- IP8 = INT((ZOLO - ZILO1) / ZIDLO)
- IP7 = IP8 - 1
- IP9 = IP8 + 1
- IP10 = IP9 + 1
- ZLOP8 = ZILO1 + IP8 * ZIDLO
- ZLOP7 = ZLOP8 - ZIDLO
- ZLOP9 = ZLOP8 + ZIDLO
- ZLOP10= ZLOP9 + ZIDLO
-!
- ! 3.1.5. southern
- ZIDLO = (ZILO2 - ZILO1) / (IINLO(IOSS))
- IP11 = INT((ZOLO - ZILO1) / ZIDLO)
- IP12 = IP11 + 1
- ZLOP11= ZILO1 + IP11* ZIDLO
- ZLOP12= ZLOP11+ ZIDLO
-!
- ! 3.1.6. check position of points
- IF (GGLOBLON) THEN
- IF ((IP1 <-2) .OR. (IP2 >IINLO(IONN)+1) .OR. &
- (IP3 <-2) .OR. (IP6 >IINLO(ION )+1) .OR. &
- (IP7 <-2) .OR. (IP10>IINLO(IOS )+1) .OR. &
- (IP11<-2) .OR. (IP12>IINLO(IOSS)+1)) THEN
- WRITE (KLUOUT,'(A,A)') &
- ' -> [HORIBL_SURF.F90] Input domain is smaller than output one ', &
- '- longitude global, abort'
- CALL ABOR1_SFX('ADAPT_HORIBLE_SURF: INPUT DOMAIN TOO SMALL - LONGITUDE GLOBAL')
- END IF
- ELSE
- IF ((IP1 <0) .OR. (IP2 >IINLO(IONN)-1) .OR. &
- (IP3 <0) .OR. (IP6 >IINLO(ION )-1) .OR. &
- (IP7 <0) .OR. (IP10>IINLO(IOS )-1) .OR. &
- (IP11<0) .OR. (IP12>IINLO(IOSS)-1)) THEN
- WRITE (KLUOUT,'(A,A)') &
- ' -> [HORIBL_SURF.F90] Input domain is smaller than output one ', &
- '- longitude local, abort'
- CALL ABOR1_SFX('ADAPT_HORIBLE_SURF: INPUT DOMAIN TOO SMALL - LONGITUDE LOCAL')
- END IF
- END IF
-!
- ! 3.1.7. add parallel offset
- IP1 =IP1 + IOFS(IONN)
- IP2 =IP2 + IOFS(IONN)
- IP3 =IP3 + IOFS(ION )
- IP4 =IP4 + IOFS(ION )
- IP5 =IP5 + IOFS(ION )
- IP6 =IP6 + IOFS(ION )
- IP7 =IP7 + IOFS(IOS )
- IP8 =IP8 + IOFS(IOS )
- IP9 =IP9 + IOFS(IOS )
- IP10=IP10+ IOFS(IOS )
- IP11=IP11+ IOFS(IOSS)
- IP12=IP12+ IOFS(IOSS)
-!
-!* 3.2 Land / Sea mask
-!
- ZLSM1 = 1.
- ZLSM2 = 1.
- ZLSM3 = 1.
- ZLSM4 = 1.
- ZLSM5 = 1.
- ZLSM6 = 1.
- ZLSM7 = 1.
- ZLSM8 = 1.
- ZLSM9 = 1.
- ZLSM10 = 1.
- ZLSM11 = 1.
- ZLSM12 = 1.
- ZLSMNN = 1.
- ZLSMN = 1.
- ZLSMS = 1.
- ZLSMSS = 1.
- IF (LDLSM) THEN
- IF (ILSMIN(IP1 ).NE.KLSMOUT(JOPOS)) ZLSM1 = 0.
- IF (ILSMIN(IP2 ).NE.KLSMOUT(JOPOS)) ZLSM2 = 0.
- IF (ILSMIN(IP3 ).NE.KLSMOUT(JOPOS)) ZLSM3 = 0.
- IF (ILSMIN(IP4 ).NE.KLSMOUT(JOPOS)) ZLSM4 = 0.
- IF (ILSMIN(IP5 ).NE.KLSMOUT(JOPOS)) ZLSM5 = 0.
- IF (ILSMIN(IP6 ).NE.KLSMOUT(JOPOS)) ZLSM6 = 0.
- IF (ILSMIN(IP7 ).NE.KLSMOUT(JOPOS)) ZLSM7 = 0.
- IF (ILSMIN(IP8 ).NE.KLSMOUT(JOPOS)) ZLSM8 = 0.
- IF (ILSMIN(IP9 ).NE.KLSMOUT(JOPOS)) ZLSM9 = 0.
- IF (ILSMIN(IP10).NE.KLSMOUT(JOPOS)) ZLSM10 = 0.
- IF (ILSMIN(IP11).NE.KLSMOUT(JOPOS)) ZLSM11 = 0.
- IF (ILSMIN(IP12).NE.KLSMOUT(JOPOS)) ZLSM12 = 0.
- ZLSMNN = MIN(ZLSM1 +ZLSM2,1.)
- ZLSMN = MIN(ZLSM3 +ZLSM4 +ZLSM5 +ZLSM6,1.)
- ZLSMS = MIN(ZLSM7 +ZLSM8 +ZLSM9 +ZLSM10,1.)
- ZLSMSS = MIN(ZLSM11+ZLSM12,1.)
- ZLSMTOT = MIN(ZLSMNN+ZLSMN+ZLSMS+ZLSMSS,1.)
- IF (ZLSMNN < 1.E-3) THEN
- ZLSM1 = 1.
- ZLSM2 = 1.
- END IF
- IF (ZLSMN < 1.E-3) THEN
- ZLSM3 = 1.
- ZLSM4 = 1.
- ZLSM5 = 1.
- ZLSM6 = 1.
- END IF
- IF (ZLSMS < 1.E-3) THEN
- ZLSM7 = 1.
- ZLSM8 = 1.
- ZLSM9 = 1.
- ZLSM10= 1.
- END IF
- IF (ZLSMSS < 1.E-3) THEN
- ZLSM11= 1.
- ZLSM12= 1.
- END IF
- IF (ZLSMTOT < 1.E-3) THEN
- ZLSMNN = 1.
- ZLSMN = 1.
- ZLSMS = 1.
- ZLSMSS = 1.
- END IF
- ENDIF
-!
-!* 3.3 Weight of points
-!
- ! 3.3.1 northern
- ZW1 = ZLSM1 * (1.+ZLSM2 *(ZOLO -ZLOP1 )/(ZLOP1 -ZLOP2 ))
- ZW2 = 1. - ZW1
- ZWNN = ZLSMNN* (1.+ZLSMN *(ZOLA -ZLANN)/(ZLANN-ZLAN )) &
- * (1.+ZLSMS *(ZOLA -ZLANN)/(ZLANN-ZLAS )) &
- * (1.+ZLSMSS*(ZOLA -ZLANN)/(ZLANN-ZLASS))
-!
- ! 3.3.2. north
- ZW3 = ZLSM3 * (1.+ZLSM4 *(ZOLO -ZLOP3 )/(ZLOP3 -ZLOP4 )) &
- * (1.+ZLSM5 *(ZOLO -ZLOP3 )/(ZLOP3 -ZLOP5 )) &
- * (1.+ZLSM6 *(ZOLO -ZLOP3 )/(ZLOP3 -ZLOP6 ))
- ZW4 = ZLSM4 * (1.+ZLSM3 *(ZOLO -ZLOP4 )/(ZLOP4 -ZLOP3 )) &
- * (1.+ZLSM5 *(ZOLO -ZLOP4 )/(ZLOP4 -ZLOP5 )) &
- * (1.+ZLSM6 *(ZOLO -ZLOP4 )/(ZLOP4 -ZLOP6 ))
- ZW5 = ZLSM5 * (1.+ZLSM3 *(ZOLO -ZLOP5 )/(ZLOP5 -ZLOP3 )) &
- * (1.+ZLSM4 *(ZOLO -ZLOP5 )/(ZLOP5 -ZLOP4 )) &
- * (1.+ZLSM6 *(ZOLO -ZLOP5 )/(ZLOP5 -ZLOP6 ))
- ZW6 = 1. - ZW3 - ZW4 - ZW5
- ZWN = ZLSMN * (1.+ZLSMNN*(ZOLA -ZLAN )/(ZLAN -ZLANN)) &
- * (1.+ZLSMS *(ZOLA -ZLAN )/(ZLAN -ZLAS )) &
- * (1.+ZLSMSS*(ZOLA -ZLAN )/(ZLAN -ZLASS))
-!
- ! 3.3.3. south
- ZW7 = ZLSM7 * (1.+ZLSM8 *(ZOLO -ZLOP7 )/(ZLOP7 -ZLOP8 )) &
- * (1.+ZLSM9 *(ZOLO -ZLOP7 )/(ZLOP7 -ZLOP9 )) &
- * (1.+ZLSM10*(ZOLO -ZLOP7 )/(ZLOP7 -ZLOP10))
- ZW8 = ZLSM8 * (1.+ZLSM7 *(ZOLO -ZLOP8 )/(ZLOP8 -ZLOP7 )) &
- * (1.+ZLSM9 *(ZOLO -ZLOP8 )/(ZLOP8 -ZLOP9 )) &
- * (1.+ZLSM10*(ZOLO -ZLOP8 )/(ZLOP8 -ZLOP10))
- ZW9 = ZLSM9 * (1.+ZLSM7 *(ZOLO -ZLOP9 )/(ZLOP9 -ZLOP7 )) &
- * (1.+ZLSM8 *(ZOLO -ZLOP9 )/(ZLOP9 -ZLOP8 )) &
- * (1.+ZLSM10*(ZOLO -ZLOP9 )/(ZLOP9 -ZLOP10))
- ZW10 = 1. - ZW7 - ZW8 - ZW9
- ZWS = ZLSMS * (1.+ZLSMNN*(ZOLA -ZLAS )/(ZLAS -ZLANN)) &
- * (1.+ZLSMN *(ZOLA -ZLAS )/(ZLAS -ZLAN )) &
- * (1.+ZLSMSS*(ZOLA -ZLAS )/(ZLAS -ZLASS))
-!
- ! 3.3.4. southern
- ZW11 = ZLSM11* (1.+ZLSM12*(ZOLO -ZLOP11)/(ZLOP11-ZLOP12))
- ZW12 = 1. - ZW11
- ZWSS = 1. - ZWNN - ZWN - ZWS
-!
- ! 3.3.5. longitude weight x latitude weight
- ZW1 = ZW1 * ZWNN
- ZW2 = ZW2 * ZWNN
- ZW3 = ZW3 * ZWN
- ZW4 = ZW4 * ZWN
- ZW5 = ZW5 * ZWN
- ZW6 = ZW6 * ZWN
- ZW7 = ZW7 * ZWS
- ZW8 = ZW8 * ZWS
- ZW9 = ZW9 * ZWS
- ZW10 = ZW10 * ZWS
- ZW11 = ZW11 * ZWSS
- ZW12 = ZW12 * ZWSS
-!
- PAROUT (JOPOS) = ZW1 * ZARIN(IP1 ) + &
- ZW2 * ZARIN(IP2 ) + &
- ZW3 * ZARIN(IP3 ) + &
- ZW4 * ZARIN(IP4 ) + &
- ZW5 * ZARIN(IP5 ) + &
- ZW6 * ZARIN(IP6 ) + &
- ZW7 * ZARIN(IP7 ) + &
- ZW8 * ZARIN(IP8 ) + &
- ZW9 * ZARIN(IP9 ) + &
- ZW10 * ZARIN(IP10) + &
- ZW11 * ZARIN(IP11) + &
- ZW12 * ZARIN(IP12)
-!
-! For surface fields, the interpoalted value is bounded
-! by the min max values of the initial field
-
- IF (PRESENT(KLSMIN)) THEN
-
- IP(1)=IP1
- IP(2)=IP2
- IP(3)=IP3
- IP(4)=IP4
- IP(5)=IP5
- IP(6)=IP6
- IP(7)=IP7
- IP(8)=IP8
- IP(9)=IP9
- IP(10)=IP10
- IP(11)=IP11
- IP(12)=IP12
-
- ZMIN=XUNDEF
- ZMAX=XUNDEF
-
- DO JLOOP2=1,12
- IF (ZARIN(IP(JLOOP2))==XUNDEF) CYCLE
-
- IF ((ZMAX==XUNDEF)) THEN
- ZMAX=ZARIN(IP(JLOOP2))
- ZMIN=ZARIN(IP(JLOOP2))
- ELSE
- ZMAX=MAX(ZMAX,ZARIN(IP(JLOOP2)))
- ZMIN=MIN(ZMIN,ZARIN(IP(JLOOP2)))
- ENDIF
-
- END DO
-
- PAROUT(JOPOS) = MAX(MIN(PAROUT(JOPOS),ZMAX),ZMIN)
-
- ENDIF
-
-END DO
-!
-DEALLOCATE (IINLO)
-DEALLOCATE (ZARIN)
-DEALLOCATE (ILSMIN)
-DEALLOCATE (IOFS)
-!
-WHERE(ABS(PAROUT-XUNDEF)<1.E-6) PAROUT=XUNDEF
-!
-!------------------------------------------------------------------------------
-!
-!* 4. EXTRAPOLATIONS IF SOME POINTS WERE NOT INTERPOLATED
-! ---------------------------------------------------
-!
-!* no missing point
-IF (COUNT(PAROUT(:)==XUNDEF .AND. OINTERP(:))==0 .AND. LHOOK) CALL DR_HOOK('ADAPT_HORIBL_SURF',1,ZHOOK_HANDLE)
-IF (COUNT(PAROUT(:)==XUNDEF .AND. OINTERP(:))==0) RETURN
-!
-!* no data point
-IF (COUNT(PARIN(:)/=XUNDEF)==0 .AND. LHOOK) CALL DR_HOOK('ADAPT_HORIBL_SURF',1,ZHOOK_HANDLE)
-IF (COUNT(PARIN(:)/=XUNDEF)==0) RETURN
-!
-WRITE(KLUOUT,*) ' Remaining horizontal extrapolations'
-WRITE(KLUOUT,*) ' Total number of input data : ',COUNT(PARIN(:)/=XUNDEF)
-WRITE(KLUOUT,*) ' Number of points to interpolate: ',COUNT(PAROUT(:)==XUNDEF .AND. OINTERP(:))
-!
-!* input grid coordinates
-!
-ALLOCATE(ZLA(KILEN))
-ALLOCATE(ZLO(KILEN))
-!
-JIPOS = 0
-DO JLAT=1,KINLA
- ZIDLO = (ZILO2-ZILO1) / KINLO(JLAT)
- DO JLON=1,KINLO(JLAT)
- JIPOS = JIPOS + 1
- ZLA(JIPOS) = PILATARRAY(JLAT)
- ZLO(JIPOS) = ZILO1 + (JLON-1) * ZIDLO
- END DO
-END DO
-!
- CALL HOR_EXTRAPOL_SURF(KLUOUT,'LALO',ZLA,ZLO,PARIN,PYOUT,PXOUT,PAROUT,OINTERP)
-!
-DEALLOCATE(ZLA)
-DEALLOCATE(ZLO)
-IF (LHOOK) CALL DR_HOOK('ADAPT_HORIBL_SURF',1,ZHOOK_HANDLE)
-!
-!------------------------------------------------------------------------------
-!
-!
-END SUBROUTINE ADAPT_HORIBL_SURF
diff --git a/src/SURFEX/albedo.F90 b/src/SURFEX/albedo.F90
index 056aaa5066e8766b38dd74faa34c7860e1d0219c..35926e871a0d3fd9e84746103f1b70cbe5ae8b55 100644
--- a/src/SURFEX/albedo.F90
+++ b/src/SURFEX/albedo.F90
@@ -2,207 +2,8 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
-! ###########
-MODULE MODI_ALBEDO
-! ###########
-!
-INTERFACE ALBEDO
-!
-!
- SUBROUTINE ALBEDO_1D(HALBEDO, &
- PALBVIS_VEG,PALBNIR_VEG,PALBUV_VEG,PVEG, &
- PALBVIS_SOIL,PALBNIR_SOIL,PALBUV_SOIL, &
- PALBVIS_ECO ,PALBNIR_ECO, PALBUV_ECO, &
- PSNOW, OMASK )
-!
-!
-!* 0.1 declarations of arguments
-! -------------------------
-!
- CHARACTER(LEN=*), INTENT(IN) :: HALBEDO
-! Albedo dependance wxith surface soil water content
-! "EVOL" = albedo evolves with soil wetness
-! "DRY " = constant albedo value for dry soil
-! "WET " = constant albedo value for wet soil
-! "MEAN" = constant albedo value for medium soil wetness
-!
-REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_VEG ! visible, near infra-red and UV
-REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_VEG ! albedo of the vegetation
-REAL, DIMENSION(:), INTENT(IN) :: PALBUV_VEG !
-REAL, DIMENSION(:), INTENT(IN) :: PVEG ! fraction of vegetation
-REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_SOIL! visible, near infra-red and UV
-REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_SOIL! soil albedo
-REAL, DIMENSION(:), INTENT(IN) :: PALBUV_SOIL !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PALBVIS_ECO ! visible, near infra-red and UV
-REAL, DIMENSION(:), INTENT(INOUT) :: PALBNIR_ECO ! averaged albedo
-REAL, DIMENSION(:), INTENT(INOUT) :: PALBUV_ECO !
-REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: PSNOW ! fraction of permanent snow and ice
-LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL :: OMASK ! mask where computations are done
-!
-END SUBROUTINE ALBEDO_1D
-!
-!
- SUBROUTINE ALBEDO_1D_PATCH(HALBEDO, &
- PALBVIS_VEG,PALBNIR_VEG,PALBUV_VEG,PVEG, &
- PALBVIS_SOIL,PALBNIR_SOIL,PALBUV_SOIL, &
- PALBVIS_ECO ,PALBNIR_ECO, PALBUV_ECO, &
- PVEGTYPE, OMASK )
-!
-!
-!* 0.1 declarations of arguments
-! -------------------------
-!
-!
- CHARACTER(LEN=*), INTENT(IN) :: HALBEDO
-! Albedo dependance wxith surface soil water content
-! "EVOL" = albedo evolves with soil wetness
-! "DRY " = constant albedo value for dry soil
-! "WET " = constant albedo value for wet soil
-! "MEAN" = constant albedo value for medium soil wetness
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PALBVIS_VEG ! visible, near infra-red and UV
-REAL, DIMENSION(:,:), INTENT(IN) :: PALBNIR_VEG ! albedo of the vegetation
-REAL, DIMENSION(:,:), INTENT(IN) :: PALBUV_VEG !
-REAL, DIMENSION(:,:), INTENT(IN) :: PVEG ! fraction of vegetation
-REAL, DIMENSION(:,:), INTENT(IN) :: PALBVIS_SOIL! visible, near infra-red and UV
-REAL, DIMENSION(:,:), INTENT(IN) :: PALBNIR_SOIL! soil albedo
-REAL, DIMENSION(:,:), INTENT(IN) :: PALBUV_SOIL !
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBVIS_ECO ! visible, near infra-red and UV
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBNIR_ECO ! averaged albedo
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBUV_ECO !
-REAL, DIMENSION(:,:), INTENT(IN), OPTIONAL :: PVEGTYPE ! vegetation type
-LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL :: OMASK ! mask where computations are done
-!
-END SUBROUTINE ALBEDO_1D_PATCH
-!
-END INTERFACE
-!
-END MODULE MODI_ALBEDO
-!
-! ####################################################################
- SUBROUTINE ALBEDO_1D(HALBEDO, &
- PALBVIS_VEG,PALBNIR_VEG,PALBUV_VEG,PVEG, &
- PALBVIS_SOIL,PALBNIR_SOIL,PALBUV_SOIL, &
- PALBVIS_ECO ,PALBNIR_ECO, PALBUV_ECO, &
- PSNOW, OMASK )
-! ####################################################################
-!
-!!**** *ALBEDO*
-!!
-!! PURPOSE
-!! -------
-! computes the albedo of the natural continental parts, from
-! vegetation albedo and soil albedo.
-! Soil albedo is estimated from sand fraction.
-! A correction due to the soil humidity is used.
-!
-!
-!!** METHOD
-!! ------
-!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 17/12/99
-!! 01/2004 Externalization (V. Masson)
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_SNOW_PAR, ONLY : XANSMAX
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-! -------------------------
-!
- CHARACTER(LEN=*), INTENT(IN) :: HALBEDO
-! Albedo dependance wxith surface soil water content
-! "EVOL" = albedo evolves with soil wetness
-! "DRY " = constant albedo value for dry soil
-! "WET " = constant albedo value for wet soil
-! "MEAN" = constant albedo value for medium soil wetness
-!
-REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_VEG ! visible, near infra-red and UV
-REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_VEG ! albedo of the vegetation
-REAL, DIMENSION(:), INTENT(IN) :: PALBUV_VEG !
-REAL, DIMENSION(:), INTENT(IN) :: PVEG ! fraction of vegetation
-REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_SOIL! visible, near infra-red and UV
-REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_SOIL! soil albedo
-REAL, DIMENSION(:), INTENT(IN) :: PALBUV_SOIL !
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PALBVIS_ECO ! visible, near infra-red and UV
-REAL, DIMENSION(:), INTENT(INOUT) :: PALBNIR_ECO ! averaged albedo
-REAL, DIMENSION(:), INTENT(INOUT) :: PALBUV_ECO !
-REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: PSNOW ! fraction of permanent snow and ice
-LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL :: OMASK ! mask where computations are done
-!
-!* 0.2 declarations of local variables
-! -------------------------------
-!
-REAL, DIMENSION(SIZE(PVEG)) :: ZSNOW
-LOGICAL, DIMENSION(SIZE(PVEG)) :: GMASK
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('MODI_ALBEDO:ALBEDO_1D',0,ZHOOK_HANDLE)
-IF (HALBEDO=='USER' .AND. LHOOK) CALL DR_HOOK('MODI_ALBEDO:ALBEDO_1D',1,ZHOOK_HANDLE)
-IF (HALBEDO=='USER') RETURN
-!
-GMASK=.TRUE.
-IF (PRESENT(OMASK)) GMASK=OMASK
-!
-ZSNOW(:) = 0.
-IF (PRESENT(PSNOW)) ZSNOW(:) = PSNOW(:)
-!
-WHERE (GMASK(:))
- PALBVIS_ECO (:) = ( (1.-PVEG(:)) * PALBVIS_SOIL(:) &
- + PVEG(:) * PALBVIS_VEG (:))&
- * (1-ZSNOW(:)) &
- + XANSMAX * ZSNOW(:)
-!
- PALBNIR_ECO (:) = ( (1.-PVEG(:)) * PALBNIR_SOIL(:) &
- + PVEG(:) * PALBNIR_VEG (:))&
- * (1-ZSNOW(:)) &
- + XANSMAX * ZSNOW(:)
-!
- PALBUV_ECO (:) = ( (1.-PVEG(:)) * PALBUV_SOIL(:) &
- + PVEG(:) * PALBUV_VEG (:)) &
- * (1-ZSNOW(:)) &
- + XANSMAX * ZSNOW(:)
-END WHERE
-IF (LHOOK) CALL DR_HOOK('MODI_ALBEDO:ALBEDO_1D',1,ZHOOK_HANDLE)
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE ALBEDO_1D
-!
! ####################################################################
- SUBROUTINE ALBEDO_1D_PATCH(HALBEDO, &
- PALBVIS_VEG,PALBNIR_VEG,PALBUV_VEG,PVEG, &
- PALBVIS_SOIL,PALBNIR_SOIL,PALBUV_SOIL, &
- PALBVIS_ECO ,PALBNIR_ECO, PALBUV_ECO, &
- PVEGTYPE, OMASK )
+ SUBROUTINE ALBEDO(HALBEDO, PEK, PSNOW, OMASK )
! ####################################################################
!
!!**** *ALBEDO*
@@ -243,13 +44,12 @@ END SUBROUTINE ALBEDO_1D
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_n, ONLY : ISBA_PE_t
+!
USE MODD_DATA_COVER_PAR, ONLY : NVT_SNOW
USE MODD_SNOW_PAR, ONLY : XANSMAX
USE MODD_SURF_PAR, ONLY : XUNDEF
!
-USE MODI_VEGTYPE_TO_PATCH
-USE MODI_SURF_PATCH
-!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -266,85 +66,50 @@ IMPLICIT NONE
! "WET " = constant albedo value for wet soil
! "MEAN" = constant albedo value for medium soil wetness
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PALBVIS_VEG ! visible, near infra-red and UV
-REAL, DIMENSION(:,:), INTENT(IN) :: PALBNIR_VEG ! albedo of the vegetation
-REAL, DIMENSION(:,:), INTENT(IN) :: PALBUV_VEG !
-REAL, DIMENSION(:,:), INTENT(IN) :: PVEG ! fraction of vegetation
-REAL, DIMENSION(:,:), INTENT(IN) :: PALBVIS_SOIL! visible, near infra-red and UV
-REAL, DIMENSION(:,:), INTENT(IN) :: PALBNIR_SOIL! soil albedo
-REAL, DIMENSION(:,:), INTENT(IN) :: PALBUV_SOIL !
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBVIS_ECO ! visible, near infra-red and UV
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBNIR_ECO ! averaged albedo
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBUV_ECO !
-REAL, DIMENSION(:,:), INTENT(IN), OPTIONAL :: PVEGTYPE ! vegetation type
+REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: PSNOW ! fraction of permanent snow and ice
LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL :: OMASK ! mask where computations are done
!
-!
!* 0.2 declarations of local variables
! -------------------------------
!
-LOGICAL, DIMENSION(SIZE(PVEG,1)) :: GMASK
+LOGICAL, DIMENSION(SIZE(PEK%XVEG)) :: GMASK
!
-REAL, DIMENSION(SIZE(PVEG,1),SIZE(PVEG,2)) ::ZPATCH, ZSNOWPATCH
-INTEGER :: ISNOWPATCH !patch index for snow
-INTEGER :: IPATCH ! number of patches
-INTEGER :: JPATCH !loop index for patches
+REAL, DIMENSION(SIZE(PEK%XVEG)) :: ZSNOW
+INTEGER :: JP !loop index for patches
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
-IF (LHOOK) CALL DR_HOOK('MODI_ALBEDO:ALBEDO_1D_PATCH',0,ZHOOK_HANDLE)
-IF (HALBEDO=='USER' .AND. LHOOK) CALL DR_HOOK('MODI_ALBEDO:ALBEDO_1D_PATCH',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('ALBEDO',0,ZHOOK_HANDLE)
+IF (HALBEDO=='USER' .AND. LHOOK) CALL DR_HOOK('ALBEDO',1,ZHOOK_HANDLE)
IF (HALBEDO=='USER') RETURN
!
GMASK(:) = .TRUE.
IF (PRESENT(OMASK)) GMASK(:) = OMASK(:)
!
-IPATCH = SIZE(PVEG,2)
-
-DO JPATCH=1,IPATCH
- WHERE (GMASK(:))
- PALBVIS_ECO (:,JPATCH) = XUNDEF
- PALBNIR_ECO (:,JPATCH) = XUNDEF
- PALBUV_ECO (:,JPATCH) = XUNDEF
- END WHERE
-END DO
-!
-!
-!
-ZSNOWPATCH (:,:) =0.
+WHERE (GMASK(:))
+ PEK%XALBVIS (:) = XUNDEF
+ PEK%XALBNIR (:) = XUNDEF
+ PEK%XALBUV (:) = XUNDEF
+END WHERE
!
-IF (PRESENT(PVEGTYPE)) THEN
- ! calculation of patch surfaces (weights for average)
- CALL SURF_PATCH(IPATCH,PVEGTYPE,ZPATCH)
- ! permanent snow fraction in the corresponding patch
- ISNOWPATCH= VEGTYPE_TO_PATCH (NVT_SNOW,IPATCH)
- WHERE(GMASK(:) .AND. ZPATCH(:,ISNOWPATCH)>0.)
- ZSNOWPATCH (:,ISNOWPATCH)=PVEGTYPE(:,NVT_SNOW)/ZPATCH(:,ISNOWPATCH)
- END WHERE
-END IF
+ZSNOW(:) = 0.
+IF (PRESENT(PSNOW)) ZSNOW(:) = PSNOW(:)
!
+WHERE (GMASK(:) .AND. PEK%XVEG(:)/=XUNDEF)
-DO JPATCH=1,IPATCH
- WHERE (GMASK(:) .AND. PVEG(:,JPATCH)/=XUNDEF)
-
- PALBVIS_ECO (:,JPATCH) =( (1.-PVEG(:,JPATCH)) * PALBVIS_SOIL(:,JPATCH) &
- + PVEG(:,JPATCH) * PALBVIS_VEG (:,JPATCH)) &
- * (1-ZSNOWPATCH(:,JPATCH)) &
- + XANSMAX * ZSNOWPATCH(:,JPATCH)
- !
- PALBNIR_ECO (:,JPATCH) =( (1.-PVEG(:,JPATCH)) * PALBNIR_SOIL(:,JPATCH) &
- + PVEG(:,JPATCH) * PALBNIR_VEG (:,JPATCH)) &
- * (1-ZSNOWPATCH(:,JPATCH)) &
- + XANSMAX * ZSNOWPATCH(:,JPATCH)
- !
- PALBUV_ECO (:,JPATCH) =( (1.-PVEG(:,JPATCH)) * PALBUV_SOIL (:,JPATCH) &
- + PVEG(:,JPATCH) * PALBUV_VEG (:,JPATCH)) &
- * (1-ZSNOWPATCH(:,JPATCH)) &
- + XANSMAX * ZSNOWPATCH(:,JPATCH)
- END WHERE
-END DO
-IF (LHOOK) CALL DR_HOOK('MODI_ALBEDO:ALBEDO_1D_PATCH',1,ZHOOK_HANDLE)
+ PEK%XALBVIS(:) = ( (1.-PEK%XVEG(:)) * PEK%XALBVIS_SOIL(:) + PEK%XVEG(:) * PEK%XALBVIS_VEG (:)) &
+ * (1-ZSNOW(:)) + XANSMAX * ZSNOW(:)
+ !
+ PEK%XALBNIR(:) = ( (1.-PEK%XVEG(:)) * PEK%XALBNIR_SOIL(:) + PEK%XVEG(:) * PEK%XALBNIR_VEG (:)) &
+ * (1-ZSNOW(:)) + XANSMAX * ZSNOW(:)
+ !
+ PEK%XALBUV (:) = ( (1.-PEK%XVEG(:)) * PEK%XALBUV_SOIL (:) + PEK%XVEG(:) * PEK%XALBUV_VEG (:)) &
+ * (1-ZSNOW(:)) + XANSMAX * ZSNOW(:)
+END WHERE
+!
+IF (LHOOK) CALL DR_HOOK('ALBEDO',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
-END SUBROUTINE ALBEDO_1D_PATCH
+END SUBROUTINE ALBEDO
diff --git a/src/SURFEX/albedo_ta96.F90 b/src/SURFEX/albedo_ta96.F90
index 1967904a534c8d09d052366efd1d1ef0e7500471..2e6e03ce635c73fba09ad444d266fed846099d99 100644
--- a/src/SURFEX/albedo_ta96.F90
+++ b/src/SURFEX/albedo_ta96.F90
@@ -34,6 +34,7 @@
!! MODIFICATIONS
!! -------------
!! Original 19/09/03
+!! 20/08/14 R. Séférian correction of the zenith solar angle
!
!-------------------------------------------------------------------------------
!
@@ -42,7 +43,6 @@
!
USE MODD_WATER_PAR, ONLY : XALBCOEF_TA96
!
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
diff --git a/src/SURFEX/albedo_veg_update.F90 b/src/SURFEX/albedo_veg_update.F90
deleted file mode 100644
index 380526cd3c88c942aa5ca28708375b87f2864b64..0000000000000000000000000000000000000000
--- a/src/SURFEX/albedo_veg_update.F90
+++ /dev/null
@@ -1,151 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE ALBEDO_VEG_UPDATE (DTCO, DTI, IG, I, &
- PTSTEP,TTIME,PCOVER,OCOVER, &
- HISBA,OECOCLIMAP,HPHOTO,OAGRIP,OTR_ML,HSFTYPE, &
- PVEG,PALBNIR,PALBVIS,PALBUV, &
- HALBEDO, PALBNIR_VEG, PALBVIS_VEG, PALBUV_VEG, &
- PALBNIR_SOIL, PALBVIS_SOIL, PALBUV_SOIL )
-! ###############################################################
-!!**** *ALBEDO_VEG_UPDATE*
-!!
-!! PURPOSE
-!! -------
-!
-! performs the time evolution of albedo for vegetation and soil
-! at UTC midnight, with effective change each ten days
-!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!! none
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! none
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!!
-!! B. Decharme * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 02/02/13
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!
-!
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-!
-USE MODD_TYPE_DATE_SURF
-!
-USE MODI_INIT_ISBA_MIXPAR
-USE MODI_CONVERT_PATCH_ISBA
-USE MODI_ALBEDO
-USE MODI_UPDATE_DATA_COVER
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
-!
-REAL, INTENT(IN) :: PTSTEP ! time step
-TYPE(DATE_TIME), INTENT(IN) :: TTIME ! UTC time
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOVER ! cover types
-LOGICAL, DIMENSION(:), INTENT(IN) :: OCOVER
- CHARACTER(LEN=*), INTENT(IN) :: HISBA ! type of soil (Force-Restore OR Diffusion)
- CHARACTER(LEN=*), INTENT(IN) :: HPHOTO ! type of photosynthesis
-LOGICAL, INTENT(IN) :: OAGRIP
-LOGICAL, INTENT(IN) :: OTR_ML
- CHARACTER(LEN=*), INTENT(IN) :: HSFTYPE ! nature / garden
-LOGICAL, INTENT(IN) :: OECOCLIMAP ! T if ecoclimap is used
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PVEG ! vegetation fraction
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBNIR ! snow-free near-infra-red albedo
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBVIS ! snow-free visible albedo
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBUV ! snow-free UV albedo
-!
- CHARACTER(LEN=4), INTENT(IN) :: HALBEDO ! albedo type
-! ! 'CM13'
-! ! 'DRY '
-! ! 'EVOL'
-! ! 'WET '
-! ! 'USER'
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBVIS_VEG ! visible, near infra-red and UV
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBNIR_VEG ! albedo of the vegetation
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBUV_VEG !
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBVIS_SOIL! visible, near infra-red and UV
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBNIR_SOIL! soil albedo
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBUV_SOIL !
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: IDECADE, IDECADE2 ! decade of simulation
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-----------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('ALBEDO_VEG_UPDATE',0,ZHOOK_HANDLE)
-!
-IDECADE = 3 * ( TTIME%TDATE%MONTH - 1 ) + MIN(TTIME%TDATE%DAY-1,29) / 10 + 1
-IDECADE2 = IDECADE
-!
-IF ( MOD(MIN(TTIME%TDATE%DAY,30),10)==1 .AND. TTIME%TIME - PTSTEP < 0.) THEN
- CALL UPDATE_DATA_COVER(DTCO, DTI, IG, I, &
- TTIME%TDATE%YEAR)
- CALL INIT_ISBA_MIXPAR(DTCO, DTI, IG, I, &
- HISBA,IDECADE,IDECADE2,PCOVER,OCOVER,HPHOTO,HSFTYPE)
- CALL CONVERT_PATCH_ISBA(DTCO, DTI, I, &
- HISBA,IDECADE,IDECADE2,PCOVER,OCOVER,&
- HPHOTO,OAGRIP,.FALSE.,OTR_ML,HSFTYPE, &
- PALBNIR_VEG=PALBNIR_VEG, &
- PALBVIS_VEG=PALBVIS_VEG, &
- PALBUV_VEG=PALBUV_VEG )
- IF ( HALBEDO=='CM13') THEN
- CALL CONVERT_PATCH_ISBA(DTCO, DTI, I, &
- HISBA,IDECADE,IDECADE2,PCOVER,OCOVER,&
- HPHOTO,OAGRIP,.FALSE.,OTR_ML,HSFTYPE, &
- PALBNIR_SOIL=PALBNIR_SOIL, &
- PALBVIS_SOIL=PALBVIS_SOIL, &
- PALBUV_SOIL=PALBUV_SOIL )
- ENDIF
- CALL ALBEDO(HALBEDO, &
- PALBVIS_VEG,PALBNIR_VEG,PALBUV_VEG,PVEG, &
- PALBVIS_SOIL,PALBNIR_SOIL,PALBUV_SOIL, &
- PALBVIS ,PALBNIR, PALBUV )
-
-END IF
-!
-IF (LHOOK) CALL DR_HOOK('ALBEDO_VEG_UPDATE',1,ZHOOK_HANDLE)
-!
-!-----------------------------------------------------------------
-!
-END SUBROUTINE ALBEDO_VEG_UPDATE
diff --git a/src/SURFEX/alloc_diag_surf_atmn.F90 b/src/SURFEX/alloc_diag_surf_atmn.F90
index c90e4c49ad2a9abcf5558dc9909bcd37eba4abc6..c843778b97386129339cf01727fcf4abc88b46e2 100644
--- a/src/SURFEX/alloc_diag_surf_atmn.F90
+++ b/src/SURFEX/alloc_diag_surf_atmn.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #############################################################
- SUBROUTINE ALLOC_DIAG_SURF_ATM_n (DGU, U, &
- HPROGRAM,KSW)
+ SUBROUTINE ALLOC_DIAG_SURF_ATM_n (DGO, D, DC, ND, NDC, &
+ KSIZE_FULL, TPTIME, HPROGRAM,KSW)
! #############################################################
!
!! AUTHOR
@@ -23,13 +23,12 @@
!* 0. DECLARATIONS
! ------------
!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_NP_t, DIAG_OPTIONS_t
!
USE MODD_DATA_COVER_PAR, ONLY : NTILESFC
USE MODD_SURF_PAR, ONLY : XUNDEF
-
-
+!
+USE MODD_TYPE_DATE_SURF, ONLY : DATE_TIME
!
USE MODI_READ_SURF
!
@@ -41,9 +40,14 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
+TYPE(DIAG_NP_t), INTENT(INOUT) :: ND
+TYPE(DIAG_NP_t), INTENT(INOUT) :: NDC
!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+INTEGER, INTENT(IN) :: KSIZE_FULL
+TYPE(DATE_TIME), INTENT(IN) :: TPTIME
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands
@@ -51,339 +55,261 @@ INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral
!* 0.2 Declarations of local variables
! -------------------------------
!
+INTEGER :: JTILE
INTEGER :: IVERSION
INTEGER :: IRESP ! IRESP : return-code if a problem appears
-CHARACTER(LEN=LEN_HREC) :: YREC ! Name of the article to be read
+ CHARACTER(LEN=LEN_HREC) :: YREC ! Name of the article to be read
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('ALLOC_DIAG_SURF_ATM_N',0,ZHOOK_HANDLE)
!
! Initialization: Outputs to atmosphere over each tile:
!
-IF (LHOOK) CALL DR_HOOK('ALLOC_DIAG_SURF_ATM_N',0,ZHOOK_HANDLE)
-ALLOCATE(DGU%XRI_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XCD_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XCH_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XCE_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XRN_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XH_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XLE_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XLEI_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XGFLUX_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XEVAP_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XSUBL_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XT2M_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XTS_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XT2M_MIN_TILE(U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XT2M_MAX_TILE(U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XQ2M_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XHU2M_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XHU2M_MIN_TILE(U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XHU2M_MAX_TILE(U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XZON10M_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XMER10M_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XQS_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XZ0_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XZ0H_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XSWD_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XSWU_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XLWD_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XLWU_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XSWBD_TILE (U%NSIZE_FULL,NTILESFC,KSW))
-ALLOCATE(DGU%XSWBU_TILE (U%NSIZE_FULL,NTILESFC,KSW))
-ALLOCATE(DGU%XFMU_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XFMV_TILE (U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XWIND10M_TILE(U%NSIZE_FULL,NTILESFC))
-ALLOCATE(DGU%XWIND10M_MAX_TILE(U%NSIZE_FULL,NTILESFC))
-!
-DGU%XRI_TILE = XUNDEF
-DGU%XCD_TILE = XUNDEF
-DGU%XCH_TILE = XUNDEF
-DGU%XCE_TILE = XUNDEF
-DGU%XRN_TILE = XUNDEF
-DGU%XH_TILE = XUNDEF
-DGU%XLE_TILE = XUNDEF
-DGU%XLEI_TILE = XUNDEF
-DGU%XGFLUX_TILE = XUNDEF
-DGU%XEVAP_TILE = XUNDEF
-DGU%XSUBL_TILE = XUNDEF
-DGU%XT2M_TILE = XUNDEF
-DGU%XTS_TILE = XUNDEF
-DGU%XT2M_MIN_TILE = XUNDEF
-DGU%XT2M_MAX_TILE = XUNDEF
-DGU%XQ2M_TILE = XUNDEF
-DGU%XHU2M_TILE = XUNDEF
-DGU%XHU2M_MIN_TILE= XUNDEF
-DGU%XHU2M_MAX_TILE= XUNDEF
-DGU%XZON10M_TILE = XUNDEF
-DGU%XMER10M_TILE = XUNDEF
-DGU%XQS_TILE = XUNDEF
-DGU%XZ0_TILE = XUNDEF
-DGU%XZ0H_TILE = XUNDEF
-DGU%XSWD_TILE = XUNDEF
-DGU%XSWU_TILE = XUNDEF
-DGU%XLWD_TILE = XUNDEF
-DGU%XLWU_TILE = XUNDEF
-DGU%XSWBD_TILE = XUNDEF
-DGU%XSWBU_TILE = XUNDEF
-DGU%XFMU_TILE = XUNDEF
-DGU%XFMV_TILE = XUNDEF
-DGU%XWIND10M_TILE = XUNDEF
-DGU%XWIND10M_MAX_TILE = XUNDEF
+DO JTILE = 1,NTILESFC
+ !
+ CALL ALLOC_DIAG(ND%AL(JTILE),.FALSE.,KSIZE_FULL,KSW)
+ CALL INIT_DIAG(ND%AL(JTILE),.FALSE.,XUNDEF)
+ !
+ENDDO
!
! Initialization: aggregated fields
!
-ALLOCATE(DGU%XAVG_RI (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_CD (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_CH (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_CE (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_RN (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_H (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_LE (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_LEI (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_GFLUX (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_EVAP (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_SUBL (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_T2M (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_TS (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_T2M_MIN(U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_T2M_MAX(U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_Q2M (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_HU2M (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_HU2M_MIN(U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_HU2M_MAX(U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_ZON10M (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_MER10M (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_SFCO2 (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_T2M_MIN_ZS (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_Q2M_MIN_ZS (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_HU2M_MIN_ZS (U%NSIZE_FULL))
-ALLOCATE(DGU%XPS (U%NSIZE_FULL))
-ALLOCATE(DGU%XRHOA (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_QS (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_Z0 (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_Z0H (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_SWD (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_SWU (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_LWD (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_LWU (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_SWBD (U%NSIZE_FULL,KSW))
-ALLOCATE(DGU%XAVG_SWBU (U%NSIZE_FULL,KSW))
-ALLOCATE(DGU%XAVG_FMU (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_FMV (U%NSIZE_FULL))
-ALLOCATE(DGU%XSSO_FMU (U%NSIZE_FULL))
-ALLOCATE(DGU%XSSO_FMV (U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_WIND10M(U%NSIZE_FULL))
-ALLOCATE(DGU%XAVG_WIND10M_MAX(U%NSIZE_FULL))
-!
-ALLOCATE(DGU%XDIAG_UREF (U%NSIZE_FULL))
-ALLOCATE(DGU%XDIAG_ZREF (U%NSIZE_FULL))
-ALLOCATE(DGU%XDIAG_TRAD (U%NSIZE_FULL))
-ALLOCATE(DGU%XDIAG_EMIS (U%NSIZE_FULL))
-!
-DGU%XAVG_RI = XUNDEF
-DGU%XAVG_CD = XUNDEF
-DGU%XAVG_CH = XUNDEF
-DGU%XAVG_CE = XUNDEF
-DGU%XAVG_RN = XUNDEF
-DGU%XAVG_H = XUNDEF
-DGU%XAVG_LE = XUNDEF
-DGU%XAVG_LEI = XUNDEF
-DGU%XAVG_GFLUX = XUNDEF
-DGU%XAVG_EVAP = XUNDEF
-DGU%XAVG_SUBL = XUNDEF
-DGU%XAVG_T2M = XUNDEF
-DGU%XAVG_TS = XUNDEF
-DGU%XAVG_T2M_MIN = XUNDEF
-DGU%XAVG_T2M_MAX = XUNDEF
-DGU%XAVG_Q2M = XUNDEF
-DGU%XAVG_HU2M = XUNDEF
-DGU%XAVG_HU2M_MIN= XUNDEF
-DGU%XAVG_HU2M_MAX= XUNDEF
-DGU%XAVG_ZON10M = XUNDEF
-DGU%XAVG_MER10M = XUNDEF
-DGU%XAVG_SFCO2 = XUNDEF
-DGU%XAVG_T2M_MIN_ZS = XUNDEF
-DGU%XAVG_Q2M_MIN_ZS = XUNDEF
-DGU%XAVG_HU2M_MIN_ZS = XUNDEF
-DGU%XPS = XUNDEF
-DGU%XRHOA = XUNDEF
-DGU%XAVG_QS = XUNDEF
-DGU%XAVG_Z0 = XUNDEF
-DGU%XAVG_Z0H = XUNDEF
-DGU%XAVG_SWD = XUNDEF
-DGU%XAVG_SWU = XUNDEF
-DGU%XAVG_LWD = XUNDEF
-DGU%XAVG_LWU = XUNDEF
-DGU%XAVG_SWBD = XUNDEF
-DGU%XAVG_SWBU = XUNDEF
-DGU%XAVG_FMU = XUNDEF
-DGU%XAVG_FMV = XUNDEF
-DGU%XSSO_FMU = XUNDEF
-DGU%XSSO_FMV = XUNDEF
-DGU%XAVG_WIND10M = XUNDEF
-DGU%XAVG_WIND10M_MAX = XUNDEF
-!
-DGU%XDIAG_UREF = XUNDEF
-DGU%XDIAG_ZREF = XUNDEF
-DGU%XDIAG_TRAD = XUNDEF
-DGU%XDIAG_EMIS = XUNDEF
-!
-IF (DGU%LSURF_BUDGETC) THEN
-!
- ALLOCATE(DGU%XRNC_TILE (U%NSIZE_FULL,NTILESFC))
- ALLOCATE(DGU%XHC_TILE (U%NSIZE_FULL,NTILESFC))
- ALLOCATE(DGU%XLEC_TILE (U%NSIZE_FULL,NTILESFC))
- ALLOCATE(DGU%XLEIC_TILE (U%NSIZE_FULL,NTILESFC))
- ALLOCATE(DGU%XGFLUXC_TILE (U%NSIZE_FULL,NTILESFC))
- ALLOCATE(DGU%XEVAPC_TILE (U%NSIZE_FULL,NTILESFC))
- ALLOCATE(DGU%XSUBLC_TILE (U%NSIZE_FULL,NTILESFC))
- ALLOCATE(DGU%XSWDC_TILE (U%NSIZE_FULL,NTILESFC))
- ALLOCATE(DGU%XSWUC_TILE (U%NSIZE_FULL,NTILESFC))
- ALLOCATE(DGU%XLWDC_TILE (U%NSIZE_FULL,NTILESFC))
- ALLOCATE(DGU%XLWUC_TILE (U%NSIZE_FULL,NTILESFC))
- ALLOCATE(DGU%XFMUC_TILE (U%NSIZE_FULL,NTILESFC))
- ALLOCATE(DGU%XFMVC_TILE (U%NSIZE_FULL,NTILESFC))
-!
- DGU%XRNC_TILE = XUNDEF
- DGU%XHC_TILE = XUNDEF
- DGU%XLEC_TILE = XUNDEF
- DGU%XLEIC_TILE = XUNDEF
- DGU%XGFLUXC_TILE = XUNDEF
- DGU%XEVAPC_TILE = XUNDEF
- DGU%XSUBLC_TILE = XUNDEF
- DGU%XSWDC_TILE = XUNDEF
- DGU%XSWUC_TILE = XUNDEF
- DGU%XLWDC_TILE = XUNDEF
- DGU%XLWUC_TILE = XUNDEF
- DGU%XFMUC_TILE = XUNDEF
- DGU%XFMVC_TILE = XUNDEF
-!
- ALLOCATE(DGU%XAVG_RNC (U%NSIZE_FULL))
- ALLOCATE(DGU%XAVG_HC (U%NSIZE_FULL))
- ALLOCATE(DGU%XAVG_LEC (U%NSIZE_FULL))
- ALLOCATE(DGU%XAVG_LEIC (U%NSIZE_FULL))
- ALLOCATE(DGU%XAVG_GFLUXC (U%NSIZE_FULL))
- ALLOCATE(DGU%XAVG_EVAPC (U%NSIZE_FULL))
- ALLOCATE(DGU%XAVG_SUBLC (U%NSIZE_FULL))
- ALLOCATE(DGU%XAVG_SWDC (U%NSIZE_FULL))
- ALLOCATE(DGU%XAVG_SWUC (U%NSIZE_FULL))
- ALLOCATE(DGU%XAVG_LWDC (U%NSIZE_FULL))
- ALLOCATE(DGU%XAVG_LWUC (U%NSIZE_FULL))
- ALLOCATE(DGU%XAVG_FMUC (U%NSIZE_FULL))
- ALLOCATE(DGU%XAVG_FMVC (U%NSIZE_FULL))
+CALL ALLOC_DIAG(D,.FALSE.,KSIZE_FULL,KSW)
+CALL INIT_DIAG(D,.FALSE.,XUNDEF)
+!
+ALLOCATE(D%XSFCO2 (KSIZE_FULL))
+!
+ALLOCATE(D%XT2M_MIN_ZS (KSIZE_FULL))
+ALLOCATE(D%XQ2M_MIN_ZS (KSIZE_FULL))
+ALLOCATE(D%XHU2M_MIN_ZS (KSIZE_FULL))
+!
+ALLOCATE(D%XPS (KSIZE_FULL))
+ALLOCATE(D%XRHOA (KSIZE_FULL))
+!
+ALLOCATE(D%XSSO_FMU (KSIZE_FULL))
+ALLOCATE(D%XSSO_FMV (KSIZE_FULL))
+!
+ALLOCATE(D%XUREF (KSIZE_FULL))
+ALLOCATE(D%XZREF (KSIZE_FULL))
+ALLOCATE(D%XTRAD (KSIZE_FULL))
+ALLOCATE(D%XEMIS (KSIZE_FULL))
+!
+D%XSFCO2 = XUNDEF
!
+D%XT2M_MIN_ZS = XUNDEF
+D%XQ2M_MIN_ZS = XUNDEF
+D%XHU2M_MIN_ZS = XUNDEF
+!
+D%XPS = XUNDEF
+D%XRHOA = XUNDEF
+!
+D%XSSO_FMU = XUNDEF
+D%XSSO_FMV = XUNDEF
+!
+D%XUREF = XUNDEF
+D%XZREF = XUNDEF
+D%XTRAD = XUNDEF
+D%XEMIS = XUNDEF
+!
+IF (DGO%LSURF_BUDGETC) THEN
+ !
+ DO JTILE = 1,NTILESFC
+ !
+ CALL ALLOC_DIAG(NDC%AL(JTILE),.TRUE.,KSIZE_FULL,0)
+ CALL INIT_DIAG(NDC%AL(JTILE),.TRUE.,XUNDEF)
+ !
+ ENDDO
+ !
+ CALL ALLOC_DIAG(DC,.TRUE.,KSIZE_FULL,0)
+ !
YREC='BUDC'
- CALL READ_SURF(HPROGRAM,YREC,DGU%LREAD_BUDGETC,IRESP)
-!
- IF (.NOT. DGU%LREAD_BUDGETC) THEN
- DGU%TIME_BUDGETC = U%TTIME
- DGU%XAVG_RNC = 0.0
- DGU%XAVG_HC = 0.0
- DGU%XAVG_LEC = 0.0
- DGU%XAVG_LEIC = 0.0
- DGU%XAVG_GFLUXC = 0.0
- DGU%XAVG_EVAPC = 0.0
- DGU%XAVG_SUBLC = 0.0
- DGU%XAVG_SWDC = 0.0
- DGU%XAVG_SWUC = 0.0
- DGU%XAVG_LWDC = 0.0
- DGU%XAVG_LWUC = 0.0
- DGU%XAVG_FMUC = 0.0
- DGU%XAVG_FMVC = 0.0
- ELSEIF (DGU%LREAD_BUDGETC.AND.DGU%LRESET_BUDGETC) THEN
- DGU%TIME_BUDGETC = U%TTIME
- DGU%XAVG_RNC = 0.0
- DGU%XAVG_HC = 0.0
- DGU%XAVG_LEC = 0.0
- DGU%XAVG_LEIC = 0.0
- DGU%XAVG_GFLUXC = 0.0
- DGU%XAVG_EVAPC = 0.0
- DGU%XAVG_SUBLC = 0.0
- DGU%XAVG_SWDC = 0.0
- DGU%XAVG_SWUC = 0.0
- DGU%XAVG_LWDC = 0.0
- DGU%XAVG_LWUC = 0.0
- DGU%XAVG_FMUC = 0.0
- DGU%XAVG_FMVC = 0.0
+ CALL READ_SURF(HPROGRAM,YREC,DGO%LREAD_BUDGETC,IRESP)
+ !
+ IF (.NOT. DGO%LREAD_BUDGETC .OR. (DGO%LREAD_BUDGETC.AND.DGO%LRESET_BUDGETC)) THEN
+ !
+ DGO%TIME_BUDGETC = TPTIME
+ CALL INIT_DIAG(DC,.TRUE.,0.0)
+ !
ELSE
- YREC='TBUDC'
- CALL READ_SURF(HPROGRAM,YREC,DGU%TIME_BUDGETC,IRESP)
- YREC='RNC'
- CALL READ_SURF(HPROGRAM,YREC,DGU%XAVG_RNC,IRESP)
- YREC='HC'
- CALL READ_SURF(HPROGRAM,YREC,DGU%XAVG_HC ,IRESP)
- YREC='LEC'
- CALL READ_SURF(HPROGRAM,YREC,DGU%XAVG_LEC,IRESP)
- YREC='LEIC'
- CALL READ_SURF(HPROGRAM,YREC,DGU%XAVG_LEIC,IRESP)
- YREC='GFLUXC'
- CALL READ_SURF(HPROGRAM,YREC,DGU%XAVG_GFLUXC ,IRESP)
- YREC='SWDC'
- CALL READ_SURF(HPROGRAM,YREC,DGU%XAVG_SWDC,IRESP)
- YREC='SWUC'
- CALL READ_SURF(HPROGRAM,YREC,DGU%XAVG_SWUC,IRESP)
- YREC='LWDC'
- CALL READ_SURF(HPROGRAM,YREC,DGU%XAVG_LWDC,IRESP)
- YREC='LWUC'
- CALL READ_SURF( &
- HPROGRAM,YREC,DGU%XAVG_LWUC,IRESP)
- YREC='FMUC'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGU%XAVG_FMUC,IRESP)
- YREC='FMVC'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGU%XAVG_FMVC,IRESP)
-!
- CALL READ_SURF(&
- HPROGRAM,'VERSION',IVERSION,IRESP)
- IF (IVERSION<8)THEN
- DGU%XAVG_EVAPC = 0.0
- DGU%XAVG_SUBLC = 0.0
- ELSE
- YREC='EVAPC'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGU%XAVG_EVAPC,IRESP)
- YREC='SUBLC'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGU%XAVG_SUBLC,IRESP)
- ENDIF
-!
+ !
+ YREC='TBUDC'
+ CALL READ_SURF(HPROGRAM,YREC,DGO%TIME_BUDGETC,IRESP)
+ !
+ YREC='RNC'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XRN,IRESP)
+ YREC='HC'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XH ,IRESP)
+ YREC='LEC'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLE,IRESP)
+ YREC='LEIC'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLEI,IRESP)
+ YREC='GFLUXC'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XGFLUX ,IRESP)
+ !
+ YREC='SWDC'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XSWD,IRESP)
+ YREC='SWUC'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XSWU,IRESP)
+ YREC='LWDC'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLWD,IRESP)
+ YREC='LWUC'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLWU,IRESP)
+ !
+ YREC='FMUC'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XFMU,IRESP)
+ YREC='FMVC'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XFMV,IRESP)
+ !
+ CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
+ IF (IVERSION<8)THEN
+ DC%XEVAP = 0.0
+ DC%XSUBL = 0.0
+ ELSE
+ YREC='EVAPC'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XEVAP,IRESP)
+ YREC='SUBLC'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XSUBL,IRESP)
+ ENDIF
+ !
ENDIF
+ !
+ELSE
+ !
+ DO JTILE=1,NTILESFC
+ CALL ALLOC_DIAG(NDC%AL(JTILE),.TRUE.,0,0)
+ ENDDO
+ !
+ CALL ALLOC_DIAG(DC,.TRUE.,0,0)
+ !
+ENDIF
+IF (LHOOK) CALL DR_HOOK('ALLOC_DIAG_SURF_ATM_N',1,ZHOOK_HANDLE)
+!
+CONTAINS
!
+SUBROUTINE ALLOC_DIAG(DA,OCUM,KSIZE1,KSIZE2)
+!
+TYPE(DIAG_t), INTENT(INOUT) :: DA
+LOGICAL, INTENT(IN) :: OCUM
+INTEGER, INTENT(IN) :: KSIZE1
+INTEGER, INTENT(IN) :: KSIZE2
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('ALLOC_DIAG_SURF_ATM_N:ALLOC_DIAG',0,ZHOOK_HANDLE)
+!
+IF (.NOT.OCUM) THEN
+ !
+ ALLOCATE(DA%XRI (KSIZE1))
+ ALLOCATE(DA%XCD (KSIZE1))
+ ALLOCATE(DA%XCH (KSIZE1))
+ ALLOCATE(DA%XCE (KSIZE1))
+ !
+ ALLOCATE(DA%XT2M (KSIZE1))
+ ALLOCATE(DA%XTS (KSIZE1))
+ ALLOCATE(DA%XT2M_MIN(KSIZE1))
+ ALLOCATE(DA%XT2M_MAX(KSIZE1))
+ ALLOCATE(DA%XQ2M (KSIZE1))
+ ALLOCATE(DA%XHU2M (KSIZE1))
+ ALLOCATE(DA%XHU2M_MIN(KSIZE1))
+ ALLOCATE(DA%XHU2M_MAX(KSIZE1))
+ ALLOCATE(DA%XZON10M (KSIZE1))
+ ALLOCATE(DA%XMER10M (KSIZE1))
+ !
+ ALLOCATE(DA%XSWBD (KSIZE1,KSIZE2))
+ ALLOCATE(DA%XSWBU (KSIZE1,KSIZE2))
+ !
+ ALLOCATE(DA%XQS (KSIZE1))
+ ALLOCATE(DA%XZ0 (KSIZE1))
+ ALLOCATE(DA%XZ0H (KSIZE1))
+ !
+ ALLOCATE(DA%XWIND10M(KSIZE1))
+ ALLOCATE(DA%XWIND10M_MAX(KSIZE1))
+ !
ELSE
+ !
+ ALLOCATE(DA%XSWBD (0,0))
+ ALLOCATE(DA%XSWBU (0,0))
+ !
+ENDIF
+!
+ALLOCATE(DA%XRN (KSIZE1))
+ALLOCATE(DA%XH (KSIZE1))
+ALLOCATE(DA%XLE (KSIZE1))
+ALLOCATE(DA%XLEI (KSIZE1))
+ALLOCATE(DA%XGFLUX (KSIZE1))
+ALLOCATE(DA%XEVAP (KSIZE1))
+ALLOCATE(DA%XSUBL (KSIZE1))
+!
+ALLOCATE(DA%XSWD (KSIZE1))
+ALLOCATE(DA%XSWU (KSIZE1))
+!
+ALLOCATE(DA%XLWD (KSIZE1))
+ALLOCATE(DA%XLWU (KSIZE1))
+ALLOCATE(DA%XFMU (KSIZE1))
+ALLOCATE(DA%XFMV (KSIZE1))
+!
+IF (LHOOK) CALL DR_HOOK('ALLOC_DIAG_SURF_ATM_N:ALLOC_DIAG',1,ZHOOK_HANDLE)
!
- ALLOCATE(DGU%XRNC_TILE (0,0))
- ALLOCATE(DGU%XHC_TILE (0,0))
- ALLOCATE(DGU%XLEC_TILE (0,0))
- ALLOCATE(DGU%XLEIC_TILE (0,0))
- ALLOCATE(DGU%XGFLUXC_TILE (0,0))
- ALLOCATE(DGU%XEVAPC_TILE (0,0))
- ALLOCATE(DGU%XSUBLC_TILE (0,0))
- ALLOCATE(DGU%XSWDC_TILE (0,0))
- ALLOCATE(DGU%XSWUC_TILE (0,0))
- ALLOCATE(DGU%XLWDC_TILE (0,0))
- ALLOCATE(DGU%XLWUC_TILE (0,0))
- ALLOCATE(DGU%XFMUC_TILE (0,0))
- ALLOCATE(DGU%XFMVC_TILE (0,0))
-!
- ALLOCATE(DGU%XAVG_RNC (0))
- ALLOCATE(DGU%XAVG_HC (0))
- ALLOCATE(DGU%XAVG_LEC (0))
- ALLOCATE(DGU%XAVG_LEIC (0))
- ALLOCATE(DGU%XAVG_GFLUXC (0))
- ALLOCATE(DGU%XAVG_EVAPC (0))
- ALLOCATE(DGU%XAVG_SUBLC (0))
- ALLOCATE(DGU%XAVG_SWDC (0))
- ALLOCATE(DGU%XAVG_SWUC (0))
- ALLOCATE(DGU%XAVG_LWDC (0))
- ALLOCATE(DGU%XAVG_LWUC (0))
- ALLOCATE(DGU%XAVG_FMUC (0))
- ALLOCATE(DGU%XAVG_FMVC (0))
+END SUBROUTINE ALLOC_DIAG
!
+SUBROUTINE INIT_DIAG(DA,OCUM,PVAL)
+!
+TYPE(DIAG_t), INTENT(INOUT) :: DA
+LOGICAL, INTENT(IN) :: OCUM
+REAL, INTENT(IN) :: PVAL
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('ALLOC_DIAG_SURF_ATM_N:INIT_DIAG',0,ZHOOK_HANDLE)
+!
+IF (.NOT.OCUM) THEN
+ !
+ DA%XRI = PVAL
+ DA%XCD = PVAL
+ DA%XCH = PVAL
+ DA%XCE = PVAL
+ !
+ DA%XT2M = PVAL
+ DA%XTS = PVAL
+ DA%XT2M_MIN = PVAL
+ DA%XT2M_MAX = PVAL
+ DA%XQ2M = PVAL
+ DA%XHU2M = PVAL
+ DA%XHU2M_MIN= PVAL
+ DA%XHU2M_MAX= PVAL
+ DA%XZON10M = PVAL
+ DA%XMER10M = PVAL
+ !
+ DA%XSWBD = PVAL
+ DA%XSWBU = PVAL
+ !
+ DA%XQS = PVAL
+ DA%XZ0 = PVAL
+ DA%XZ0H = PVAL
+ !
+ DA%XWIND10M = PVAL
+ DA%XWIND10M_MAX = PVAL
+ !
ENDIF
-IF (LHOOK) CALL DR_HOOK('ALLOC_DIAG_SURF_ATM_N',1,ZHOOK_HANDLE)
+!
+DA%XRN = PVAL
+DA%XH = PVAL
+DA%XLE = PVAL
+DA%XLEI = PVAL
+DA%XGFLUX = PVAL
+DA%XEVAP = PVAL
+DA%XSUBL = PVAL
+!
+DA%XSWD = PVAL
+DA%XSWU = PVAL
+DA%XLWD = PVAL
+DA%XLWU = PVAL
+DA%XFMU = PVAL
+DA%XFMV = PVAL
+!
+IF (LHOOK) CALL DR_HOOK('ALLOC_DIAG_SURF_ATM_N:INIT_DIAG',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE INIT_DIAG
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/alloc_diag_teb_greenroof.F90 b/src/SURFEX/alloc_diag_teb_greenroof.F90
deleted file mode 100644
index 3fe52ba4ef7b8a43ff699a4bdfb9064c83100039..0000000000000000000000000000000000000000
--- a/src/SURFEX/alloc_diag_teb_greenroof.F90
+++ /dev/null
@@ -1,83 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE ALLOC_DIAG_TEB_GREENROOF (DGGR, TGR, &
- KLU,KLAYER_GR,KSW)
-! ##########################################################################
-!
-!
-!
-!
-USE MODD_DIAG_TEB_GREENROOF_n, ONLY : DIAG_TEB_GREENROOF_t
-USE MODD_TEB_GREENROOF_n, ONLY : TEB_GREENROOF_t
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!
-TYPE(DIAG_TEB_GREENROOF_t), INTENT(INOUT) :: DGGR
-TYPE(TEB_GREENROOF_t), INTENT(INOUT) :: TGR
-!
-INTEGER, INTENT(IN) :: KLU
-INTEGER, INTENT(IN) :: KLAYER_GR
-INTEGER, INTENT(IN) :: KSW
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-! Diagnostic variables:
-!
-IF (LHOOK) CALL DR_HOOK('ALLOC_DIAG_TEB_GREENROOF',0,ZHOOK_HANDLE)
-ALLOCATE(DGGR%XRI (KLU ))
-ALLOCATE(DGGR%XCD (KLU ))
-ALLOCATE(DGGR%XCH (KLU ))
-ALLOCATE(DGGR%XRN (KLU ))
-ALLOCATE(DGGR%XH (KLU ))
-ALLOCATE(DGGR%XGFLUX (KLU ))
-ALLOCATE(DGGR%XQS (KLU ))
-!
-ALLOCATE(DGGR%XLEI (KLU ))
-ALLOCATE(DGGR%XLEG (KLU ))
-ALLOCATE(DGGR%XLEGI (KLU ))
-ALLOCATE(DGGR%XLEV (KLU ))
-ALLOCATE(DGGR%XLES (KLU ))
-ALLOCATE(DGGR%XLER (KLU ))
-ALLOCATE(DGGR%XLETR (KLU ))
-ALLOCATE(DGGR%XEVAP (KLU ))
-ALLOCATE(DGGR%XDRAIN (KLU ))
-ALLOCATE(DGGR%XRUNOFF (KLU ))
-ALLOCATE(DGGR%XHORT (KLU ))
-ALLOCATE(DGGR%XDRIP (KLU ))
-ALLOCATE(DGGR%XRRVEG (KLU ))
-ALLOCATE(DGGR%XMELT (KLU ))
-!
-ALLOCATE(DGGR%XCG (KLU ))
-ALLOCATE(DGGR%XC1 (KLU ))
-ALLOCATE(DGGR%XC2 (KLU ))
-ALLOCATE(DGGR%XWGEQ (KLU ))
-ALLOCATE(DGGR%XCT (KLU ))
-ALLOCATE(DGGR%XRS (KLU ))
-ALLOCATE(DGGR%XCDN (KLU ))
-ALLOCATE(DGGR%XHU (KLU ))
-ALLOCATE(DGGR%XHUG (KLU ))
-ALLOCATE(DGGR%XRESTORE (KLU ))
-ALLOCATE(DGGR%XUSTAR (KLU ))
-ALLOCATE(DGGR%XIACAN (KLU,3 ))
-!
-ALLOCATE(DGGR%XSNOWTEMP (KLU,TGR%CUR%TSNOW%NLAYER ))
-ALLOCATE(DGGR%XSNOWLIQ (KLU,TGR%CUR%TSNOW%NLAYER ))
-ALLOCATE(DGGR%XSNOWDZ (KLU,TGR%CUR%TSNOW%NLAYER ))
-ALLOCATE(DGGR%XSNOWHMASS (KLU ))
-ALLOCATE(DGGR%XMELTADV (KLU ))
-!
-ALLOCATE(DGGR%XHV (KLU ))
-ALLOCATE(DGGR%XALBT (KLU ))
-ALLOCATE(DGGR%XEMIST (KLU ))
-IF (LHOOK) CALL DR_HOOK('ALLOC_DIAG_TEB_GREENROOF',1,ZHOOK_HANDLE)
-!
-!
-END SUBROUTINE ALLOC_DIAG_TEB_GREENROOF
diff --git a/src/SURFEX/alloc_surfex.F90 b/src/SURFEX/alloc_surfex.F90
deleted file mode 100644
index 523a58b834c707b1ec39c48f7e3b37e6d57addee..0000000000000000000000000000000000000000
--- a/src/SURFEX/alloc_surfex.F90
+++ /dev/null
@@ -1,26 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #############################################################
- SUBROUTINE ALLOC_SURFEX(KMODEL)
-! #############################################################
-!
-!! AUTHOR
-!! ------
-!! R. El Khatib *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 04/2010
-!! Modified 04/2013, P. Le Moigne: FLake chemistry
-!! Modified 04/2014, S. Senesi : Gelato
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE ALLOC_SURFEX
diff --git a/src/SURFEX/allocate_gr_snow.F90 b/src/SURFEX/allocate_gr_snow.F90
index 253f03503e6354c49a2815f54e247bbfb561c9b5..01264faef056d7a96e47ee3215bef9047cb1452d 100644
--- a/src/SURFEX/allocate_gr_snow.F90
+++ b/src/SURFEX/allocate_gr_snow.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE ALLOCATE_GR_SNOW(TPSNOW,KLU,KPATCH)
+ SUBROUTINE ALLOCATE_GR_SNOW(TPSNOW,KLU)
! ##############################################
!
!!**** *ALLOCATE_GR_SNOW* -
@@ -61,7 +61,6 @@ IMPLICIT NONE
!
TYPE(SURF_SNOW), INTENT(INOUT) :: TPSNOW
INTEGER, INTENT(IN) :: KLU
-INTEGER, INTENT(IN) :: KPATCH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.2 Declaration of local variables
@@ -74,12 +73,12 @@ IF (LHOOK) CALL DR_HOOK('ALLOCATE_GR_SNOW',0,ZHOOK_HANDLE)
IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO' .OR. TPSNOW%SCHEME=='1-L' .OR. &
TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA') THEN
!
- ALLOCATE(TPSNOW%WSNOW (KLU,TPSNOW%NLAYER,KPATCH))
- ALLOCATE(TPSNOW%RHO (KLU,TPSNOW%NLAYER,KPATCH))
- ALLOCATE(TPSNOW%ALB (KLU,KPATCH))
- ALLOCATE(TPSNOW%ALBVIS (KLU,KPATCH))
- ALLOCATE(TPSNOW%ALBNIR (KLU,KPATCH))
- ALLOCATE(TPSNOW%ALBFIR (KLU,KPATCH))
+ ALLOCATE(TPSNOW%WSNOW (KLU,TPSNOW%NLAYER))
+ ALLOCATE(TPSNOW%RHO (KLU,TPSNOW%NLAYER))
+ ALLOCATE(TPSNOW%ALB (KLU))
+ ALLOCATE(TPSNOW%ALBVIS (KLU))
+ ALLOCATE(TPSNOW%ALBNIR (KLU))
+ ALLOCATE(TPSNOW%ALBFIR (KLU))
TPSNOW%WSNOW = 0.
TPSNOW%RHO = XUNDEF
TPSNOW%ALB = XUNDEF
@@ -89,25 +88,25 @@ IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO' .OR. TPSNOW%SCHEME=='1-L' .OR
!
IF (TPSNOW%SCHEME/='D95' .AND. TPSNOW%SCHEME/='EBA') THEN
!
- ALLOCATE(TPSNOW%EMIS(KLU,KPATCH))
- ALLOCATE(TPSNOW%TS (KLU,KPATCH))
+ ALLOCATE(TPSNOW%EMIS(KLU))
+ ALLOCATE(TPSNOW%TS (KLU))
TPSNOW%EMIS = XUNDEF
TPSNOW%TS = XUNDEF
!
IF (TPSNOW%SCHEME/='1-L') THEN
!
- ALLOCATE(TPSNOW%TEMP(KLU,TPSNOW%NLAYER,KPATCH))
- ALLOCATE(TPSNOW%HEAT(KLU,TPSNOW%NLAYER,KPATCH))
- ALLOCATE(TPSNOW%AGE (KLU,TPSNOW%NLAYER,KPATCH))
+ ALLOCATE(TPSNOW%TEMP(KLU,TPSNOW%NLAYER))
+ ALLOCATE(TPSNOW%HEAT(KLU,TPSNOW%NLAYER))
+ ALLOCATE(TPSNOW%AGE (KLU,TPSNOW%NLAYER))
TPSNOW%TEMP = XUNDEF
TPSNOW%HEAT = XUNDEF
TPSNOW%AGE = XUNDEF
!
IF(TPSNOW%SCHEME=='CRO') THEN
!
- ALLOCATE(TPSNOW%GRAN1(KLU,TPSNOW%NLAYER,KPATCH))
- ALLOCATE(TPSNOW%GRAN2(KLU,TPSNOW%NLAYER,KPATCH))
- ALLOCATE(TPSNOW%HIST (KLU,TPSNOW%NLAYER,KPATCH))
+ ALLOCATE(TPSNOW%GRAN1(KLU,TPSNOW%NLAYER))
+ ALLOCATE(TPSNOW%GRAN2(KLU,TPSNOW%NLAYER))
+ ALLOCATE(TPSNOW%HIST (KLU,TPSNOW%NLAYER))
TPSNOW%GRAN1 = XUNDEF
TPSNOW%GRAN2 = XUNDEF
TPSNOW%HIST = XUNDEF
@@ -116,7 +115,7 @@ IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO' .OR. TPSNOW%SCHEME=='1-L' .OR
!
ELSE
!
- ALLOCATE(TPSNOW%T(KLU,TPSNOW%NLAYER,KPATCH))
+ ALLOCATE(TPSNOW%T(KLU,TPSNOW%NLAYER))
TPSNOW%T = XUNDEF
!
END IF
@@ -126,29 +125,29 @@ ENDIF
!
IF (TPSNOW%SCHEME/='CRO') THEN
!
- ALLOCATE(TPSNOW%GRAN1(0,0,0))
- ALLOCATE(TPSNOW%GRAN2(0,0,0))
- ALLOCATE(TPSNOW%HIST (0,0,0))
+ ALLOCATE(TPSNOW%GRAN1(0,0))
+ ALLOCATE(TPSNOW%GRAN2(0,0))
+ ALLOCATE(TPSNOW%HIST (0,0))
!
IF (TPSNOW%SCHEME/='3-L') THEN
!
- ALLOCATE(TPSNOW%TEMP(0,0,0))
- ALLOCATE(TPSNOW%HEAT(0,0,0))
- ALLOCATE(TPSNOW%AGE (0,0,0))
+ ALLOCATE(TPSNOW%TEMP(0,0))
+ ALLOCATE(TPSNOW%HEAT(0,0))
+ ALLOCATE(TPSNOW%AGE (0,0))
!
IF (TPSNOW%SCHEME/='1-L') THEN
!
- ALLOCATE(TPSNOW%EMIS (0,0))
- ALLOCATE(TPSNOW%TS (0,0))
+ ALLOCATE(TPSNOW%EMIS (0))
+ ALLOCATE(TPSNOW%TS (0))
!
IF (TPSNOW%SCHEME/='D95' .AND. TPSNOW%SCHEME/='EBA') THEN
!
- ALLOCATE(TPSNOW%WSNOW (0,0,0))
- ALLOCATE(TPSNOW%RHO (0,0,0))
- ALLOCATE(TPSNOW%ALB (0,0))
- ALLOCATE(TPSNOW%ALBVIS (0,0))
- ALLOCATE(TPSNOW%ALBNIR (0,0))
- ALLOCATE(TPSNOW%ALBFIR (0,0))
+ ALLOCATE(TPSNOW%WSNOW (0,0))
+ ALLOCATE(TPSNOW%RHO (0,0))
+ ALLOCATE(TPSNOW%ALB (0))
+ ALLOCATE(TPSNOW%ALBVIS (0))
+ ALLOCATE(TPSNOW%ALBNIR (0))
+ ALLOCATE(TPSNOW%ALBFIR (0))
!
ENDIF
!
@@ -160,7 +159,7 @@ END IF
!
IF (TPSNOW%SCHEME/='1-L') THEN
!
- ALLOCATE(TPSNOW%T(0,0,0))
+ ALLOCATE(TPSNOW%T(0,0))
!
ENDIF
!
diff --git a/src/SURFEX/allocate_physio.F90 b/src/SURFEX/allocate_physio.F90
index 1782a2e67d35608882626966498f99762ee1f1f3..1028fa2498a5949727561ed5e83c6b1bc3f45250 100644
--- a/src/SURFEX/allocate_physio.F90
+++ b/src/SURFEX/allocate_physio.F90
@@ -3,18 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE ALLOCATE_PHYSIO (I, &
- HPHOTO, HISBA, KLU, KVEGTYPE, KGROUND_LAYER, KPATCH, &
- PVEGTYPE, PLAI, PVEG, PZ0, PEMIS, PDG, PD_ICE, &
- PRSMIN, PGAMMA, PWRMAX_CF, PRGL, PCV, &
- PZ0_O_Z0H, PALBNIR_VEG, PALBVIS_VEG, PALBUV_VEG, &
- PH_TREE, PRE25, PLAIMIN, PBSLAI, PSEFOLD, &
- PGMES, PGC, PF2I, PDMAX, OSTRESS, &
- PCE_NITRO, PCF_NITRO, PCNA_NITRO, &
- PTSEED, PTREAP, PWATSUP, PIRRIG, &
- PROOTFRAC, KWG_LAYER, PDROOT, PDG2, &
- PGNDLITTER,PRGLGV,PGAMMAGV,PRSMINGV, &
- PROOTFRACGV,PWRMAX_CFGV,PLAIGV,PZ0LITTER,PH_VEG )
+ SUBROUTINE ALLOCATE_PHYSIO (IO, KK, PK, PEK, KVEGTYPE )
! ##########################################################################
!
!!**** *ALLOCATE_PHYSIO* -
@@ -46,10 +35,13 @@
!! Modified 10/2014 P. Samuelsson MEB
!
!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
!
USE MODD_TYPE_DATE_SURF
!
+USE MODD_AGRI, ONLY : LAGRIP
+!
USE MODD_TREEDRAG, ONLY : LTREEDRAG
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -58,71 +50,16 @@ USE PARKIND1 ,ONLY : JPRB
IMPLICIT NONE
!
!
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
!
-INTEGER :: ISIZE_LMEB_PATCH ! Number of patches with MEB=true
+INTEGER, INTENT(IN) :: KVEGTYPE
!
- CHARACTER(LEN=3),INTENT(IN) :: HPHOTO
- CHARACTER(LEN=3),INTENT(IN) :: HISBA
+INTEGER :: ISIZE
+INTEGER :: ISIZE_LMEB_PATCH ! Number of patches with MEB=true
!
-INTEGER, INTENT(IN) :: KLU
-INTEGER, INTENT(IN) :: KVEGTYPE
-INTEGER, INTENT(IN) :: KGROUND_LAYER
-INTEGER, INTENT(IN) :: KPATCH
-!
-REAL, DIMENSION(:,:), POINTER :: PVEGTYPE
-!
-REAL, DIMENSION(:,:), POINTER :: PLAI
-REAL, DIMENSION(:,:), POINTER :: PVEG
-REAL, DIMENSION(:,:), POINTER :: PZ0
-REAL, DIMENSION(:,:), POINTER :: PEMIS
-!
-REAL, DIMENSION(:,:,:), POINTER :: PDG
-REAL, DIMENSION(:,:) , POINTER :: PD_ICE
-!
-REAL, DIMENSION(:,:), POINTER :: PRSMIN
-REAL, DIMENSION(:,:), POINTER :: PGAMMA
-REAL, DIMENSION(:,:), POINTER :: PWRMAX_CF
-REAL, DIMENSION(:,:), POINTER :: PRGL
-REAL, DIMENSION(:,:), POINTER :: PCV
-REAL, DIMENSION(:,:), POINTER :: PZ0_O_Z0H
-REAL, DIMENSION(:,:), POINTER :: PALBNIR_VEG
-REAL, DIMENSION(:,:), POINTER :: PALBVIS_VEG
-REAL, DIMENSION(:,:), POINTER :: PALBUV_VEG
-!
-REAL, DIMENSION(:,:), POINTER :: PH_TREE
-REAL, DIMENSION(:,:), POINTER :: PRE25
-REAL, DIMENSION(:,:), POINTER :: PLAIMIN
-REAL, DIMENSION(:,:), POINTER :: PBSLAI
-REAL, DIMENSION(:,:), POINTER :: PSEFOLD
-REAL, DIMENSION(:,:), POINTER :: PGMES
-REAL, DIMENSION(:,:), POINTER :: PGC
-REAL, DIMENSION(:,:), POINTER :: PF2I
-REAL, DIMENSION(:,:), POINTER :: PDMAX
-LOGICAL, DIMENSION(:,:), POINTER :: OSTRESS
-REAL, DIMENSION(:,:), POINTER :: PCE_NITRO
-REAL, DIMENSION(:,:), POINTER :: PCF_NITRO
-REAL, DIMENSION(:,:), POINTER :: PCNA_NITRO
-!
-TYPE(DATE_TIME), DIMENSION(:,:), POINTER :: PTSEED
-TYPE(DATE_TIME), DIMENSION(:,:), POINTER :: PTREAP
-REAL, DIMENSION(:,:), POINTER :: PWATSUP
-REAL, DIMENSION(:,:), POINTER :: PIRRIG
-!
-REAL, DIMENSION(:,:,:), POINTER :: PROOTFRAC
-INTEGER, DIMENSION(:,:), POINTER :: KWG_LAYER
-REAL, DIMENSION(:,:), POINTER :: PDROOT
-REAL, DIMENSION(:,:), POINTER :: PDG2
-!
-REAL, DIMENSION(:,:), POINTER :: PGNDLITTER
-REAL, DIMENSION(:,:), POINTER :: PRGLGV
-REAL, DIMENSION(:,:), POINTER :: PGAMMAGV
-REAL, DIMENSION(:,:), POINTER :: PRSMINGV
-REAL, DIMENSION(:,:,:), POINTER :: PROOTFRACGV
-REAL, DIMENSION(:,:), POINTER :: PWRMAX_CFGV
-REAL, DIMENSION(:,:), POINTER :: PLAIGV
-REAL, DIMENSION(:,:), POINTER :: PZ0LITTER
-REAL, DIMENSION(:,:), POINTER :: PH_VEG
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -132,119 +69,105 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('ALLOCATE_PHYSIO',0,ZHOOK_HANDLE)
!
-ISIZE_LMEB_PATCH=COUNT(I%LMEB_PATCH(:))
+ISIZE = PK%NSIZE_P
+!
+ISIZE_LMEB_PATCH=COUNT(IO%LMEB_PATCH(:))
!
-ALLOCATE(PVEGTYPE (KLU,KVEGTYPE ))
+ALLOCATE(PK%XDG (ISIZE,IO%NGROUND_LAYER))
+ALLOCATE(PK%XD_ICE (ISIZE ))
!
-ALLOCATE(PLAI (KLU,KPATCH ))
-ALLOCATE(PVEG (KLU,KPATCH ))
-ALLOCATE(PZ0 (KLU,KPATCH ))
-ALLOCATE(PEMIS (KLU,KPATCH ))
+ALLOCATE(PEK%XLAI (ISIZE ))
+ALLOCATE(PEK%XVEG (ISIZE ))
+ALLOCATE(PEK%XZ0 (ISIZE ))
+ALLOCATE(PEK%XEMIS (ISIZE ))
!
-ALLOCATE(PDG (KLU,KGROUND_LAYER,KPATCH))
-ALLOCATE(PD_ICE (KLU,KPATCH ))
+ALLOCATE(PEK%XRSMIN (ISIZE ))
+ALLOCATE(PEK%XGAMMA (ISIZE ))
+ALLOCATE(PEK%XWRMAX_CF (ISIZE ))
+ALLOCATE(PEK%XRGL (ISIZE ))
+ALLOCATE(PEK%XCV (ISIZE ))
+ALLOCATE(PEK%XALBNIR_VEG (ISIZE ))
+ALLOCATE(PEK%XALBVIS_VEG (ISIZE ))
+ALLOCATE(PEK%XALBUV_VEG (ISIZE ))
!
-ALLOCATE(PRSMIN (KLU,KPATCH ))
-ALLOCATE(PGAMMA (KLU,KPATCH ))
-ALLOCATE(PWRMAX_CF (KLU,KPATCH ))
-ALLOCATE(PRGL (KLU,KPATCH ))
-ALLOCATE(PCV (KLU,KPATCH ))
-ALLOCATE(PZ0_O_Z0H (KLU,KPATCH ))
-ALLOCATE(PALBNIR_VEG (KLU,KPATCH ))
-ALLOCATE(PALBVIS_VEG (KLU,KPATCH ))
-ALLOCATE(PALBUV_VEG (KLU,KPATCH ))
+ALLOCATE(PK%XZ0_O_Z0H (ISIZE ))
!
-IF (ISIZE_LMEB_PATCH>0 .OR. HPHOTO/='NON') THEN
- ALLOCATE(PBSLAI (KLU,KPATCH ))
+IF (ISIZE_LMEB_PATCH>0 .OR. IO%CPHOTO/='NON') THEN
+ ALLOCATE(PEK%XBSLAI (ISIZE ))
ELSE
- ALLOCATE(PBSLAI (0,0))
+ ALLOCATE(PEK%XBSLAI (0))
ENDIF
! - vegetation: Ags parameters ('AGS', 'LAI', 'AST', 'LST', 'NIT' options)
!
-IF (HPHOTO/='NON'.OR.LTREEDRAG) THEN
- ALLOCATE(PH_TREE (KLU,KPATCH ))
+IF (IO%CPHOTO/='NON'.OR.LTREEDRAG) THEN
+ ALLOCATE(PK%XH_TREE (ISIZE ))
ELSE
- ALLOCATE(PH_TREE (0,0 ))
+ ALLOCATE(PK%XH_TREE (0 ))
ENDIF
!
-IF (HPHOTO/='NON') THEN
- ALLOCATE(PRE25 (KLU,KPATCH ))
- ALLOCATE(PLAIMIN (KLU,KPATCH ))
- ALLOCATE(PSEFOLD (KLU,KPATCH ))
- ALLOCATE(PGMES (KLU,KPATCH ))
- ALLOCATE(PGC (KLU,KPATCH ))
- ALLOCATE(PDMAX (KLU,KPATCH ))
- IF (HPHOTO/='AGS' .AND. HPHOTO/='LAI') THEN
- ALLOCATE(PF2I (KLU,KPATCH ))
- ALLOCATE(OSTRESS (KLU,KPATCH ))
- IF (HPHOTO=='NIT' .OR. HPHOTO=='NCB') THEN
- ALLOCATE(PCE_NITRO (KLU,KPATCH ))
- ALLOCATE(PCF_NITRO (KLU,KPATCH ))
- ALLOCATE(PCNA_NITRO (KLU,KPATCH ))
- ELSE
- ALLOCATE(PCE_NITRO (0,0))
- ALLOCATE(PCF_NITRO (0,0))
- ALLOCATE(PCNA_NITRO (0,0))
-
- ENDIF
+IF (IO%CPHOTO/='NON') THEN
+ ALLOCATE(PK%XRE25 (ISIZE ))
+ ALLOCATE(PK%XDMAX (ISIZE ))
+ ALLOCATE(PEK%XLAIMIN (ISIZE ))
+ ALLOCATE(PEK%XSEFOLD (ISIZE ))
+ ALLOCATE(PEK%XGMES (ISIZE ))
+ ALLOCATE(PEK%XGC (ISIZE ))
+ ALLOCATE(PEK%XF2I (ISIZE ))
+ ALLOCATE(PEK%LSTRESS (ISIZE ))
+ IF (IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') THEN
+ ALLOCATE(PEK%XCE_NITRO (ISIZE ))
+ ALLOCATE(PEK%XCF_NITRO (ISIZE ))
+ ALLOCATE(PEK%XCNA_NITRO (ISIZE ))
ELSE
- ALLOCATE(PF2I (0,0))
- ALLOCATE(OSTRESS(0,0))
- ALLOCATE(PCE_NITRO (0,0))
- ALLOCATE(PCF_NITRO (0,0))
- ALLOCATE(PCNA_NITRO (0,0))
+ ALLOCATE(PEK%XCE_NITRO (0))
+ ALLOCATE(PEK%XCF_NITRO (0))
+ ALLOCATE(PEK%XCNA_NITRO (0))
ENDIF
ELSE
- ALLOCATE(PRE25 (0,0))
- ALLOCATE(PLAIMIN (0,0))
- ALLOCATE(PSEFOLD (0,0))
- ALLOCATE(PGMES (0,0))
- ALLOCATE(PGC (0,0))
- ALLOCATE(PF2I (0,0))
- ALLOCATE(PDMAX (0,0))
- ALLOCATE(OSTRESS(0,0))
- ALLOCATE(PCE_NITRO (0,0))
- ALLOCATE(PCF_NITRO (0,0))
- ALLOCATE(PCNA_NITRO (0,0))
+ ALLOCATE(PK%XRE25 (0))
+ ALLOCATE(PK%XDMAX (0))
+ ALLOCATE(PEK%XLAIMIN (0))
+ ALLOCATE(PEK%XSEFOLD (0))
+ ALLOCATE(PEK%XGMES (0))
+ ALLOCATE(PEK%XGC (0))
+ ALLOCATE(PEK%XF2I (0))
+ ALLOCATE(PEK%LSTRESS (0))
+ ALLOCATE(PEK%XCE_NITRO (0))
+ ALLOCATE(PEK%XCF_NITRO (0))
+ ALLOCATE(PEK%XCNA_NITRO(0))
ENDIF
!
! - Irrigation, seeding and reaping
!
-IF (HPHOTO == 'LAI' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT' .OR. HPHOTO == 'NCB') THEN
- ALLOCATE(PTSEED (KLU,KPATCH ))
- ALLOCATE(PTREAP (KLU,KPATCH ))
- ALLOCATE(PWATSUP (KLU,KPATCH ))
- ALLOCATE(PIRRIG (KLU,KPATCH ))
+IF (LAGRIP .AND. (IO%CPHOTO == 'NIT' .OR. IO%CPHOTO == 'NCB')) THEN
+ ALLOCATE(PEK%TSEED (ISIZE ))
+ ALLOCATE(PEK%TREAP (ISIZE ))
+ ALLOCATE(PEK%XWATSUP (ISIZE ))
+ ALLOCATE(PEK%XIRRIG (ISIZE ))
ELSE
- ALLOCATE(PTSEED (0,0))
- ALLOCATE(PTREAP (0,0))
- ALLOCATE(PWATSUP (0,0))
- ALLOCATE(PIRRIG (0,0))
+ ALLOCATE(PEK%TSEED (0))
+ ALLOCATE(PEK%TREAP (0))
+ ALLOCATE(PEK%XWATSUP (0))
+ ALLOCATE(PEK%XIRRIG (0))
ENDIF
!
! - ISBA-DF scheme
!
-IF(HISBA=='DIF')THEN
- ALLOCATE(PROOTFRAC (KLU,KGROUND_LAYER,KPATCH))
- ALLOCATE(KWG_LAYER (KLU,KPATCH))
- ALLOCATE(PDROOT (KLU,KPATCH))
- ALLOCATE(PDG2 (KLU,KPATCH))
+IF(IO%CISBA=='DIF')THEN
+ ALLOCATE(PK%XROOTFRAC (ISIZE,IO%NGROUND_LAYER))
+ ALLOCATE(PK%NWG_LAYER (ISIZE))
+ ALLOCATE(PK%XDROOT (ISIZE))
+ ALLOCATE(PK%XDG2 (ISIZE))
ELSE
- ALLOCATE(PROOTFRAC (0,0,0))
- ALLOCATE(KWG_LAYER (0,0) )
- ALLOCATE(PDROOT (0,0) )
- ALLOCATE(PDG2 (0,0) )
+ ALLOCATE(PK%XROOTFRAC (0,0))
+ ALLOCATE(PK%NWG_LAYER (0) )
+ ALLOCATE(PK%XDROOT (0) )
+ ALLOCATE(PK%XDG2 (0) )
ENDIF
!
-ALLOCATE(PGNDLITTER (KLU,KPATCH))
-ALLOCATE(PRGLGV (KLU,KPATCH))
-ALLOCATE(PGAMMAGV (KLU,KPATCH))
-ALLOCATE(PRSMINGV (KLU,KPATCH))
-ALLOCATE(PROOTFRACGV(KLU,KGROUND_LAYER,KPATCH))
-ALLOCATE(PWRMAX_CFGV(KLU,KPATCH))
-ALLOCATE(PLAIGV (KLU,KPATCH))
-ALLOCATE(PZ0LITTER (KLU,KPATCH))
-ALLOCATE(PH_VEG (KLU,KPATCH))
+ALLOCATE(PEK%XGNDLITTER (ISIZE))
+ALLOCATE(PEK%XZ0LITTER (ISIZE))
+ALLOCATE(PEK%XH_VEG (ISIZE))
!
IF (LHOOK) CALL DR_HOOK('ALLOCATE_PHYSIO',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/allocate_teb_garden.F90 b/src/SURFEX/allocate_teb_garden.F90
deleted file mode 100644
index dfdbc4e1396a036c8949980aa5127f25a7c9c9b9..0000000000000000000000000000000000000000
--- a/src/SURFEX/allocate_teb_garden.F90
+++ /dev/null
@@ -1,70 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE ALLOCATE_TEB_GARDEN (TGD, TVG, &
- KLU,KGROUND_LAYER)
-! ##########################################################################
-!
-!
-!
-!
-USE MODD_TEB_GARDEN_n, ONLY : TEB_GARDEN_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!
-TYPE(TEB_GARDEN_t), INTENT(INOUT) :: TGD
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
-!
-INTEGER, INTENT(IN) :: KLU
-INTEGER, INTENT(IN) :: KGROUND_LAYER
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-! Mask and number of grid elements containing patches/tiles:
-!
-IF (LHOOK) CALL DR_HOOK('ALLOCATE_TEB_GARDEN',0,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-! Averaged Surface radiative parameters:
-!
-ALLOCATE(TGD%CUR%XSNOWFREE_ALB (KLU))
-ALLOCATE(TGD%CUR%XSNOWFREE_ALB_VEG (KLU))
-ALLOCATE(TGD%CUR%XSNOWFREE_ALB_SOIL (KLU))
-!
-!-------------------------------------------------------------------------------
-!
-! Prognostic variables:
-!
-!
-! - Soil and vegetation heat and water:
-!
-ALLOCATE(TGD%CUR%XWR (KLU ))
-ALLOCATE(TGD%CUR%XTG (KLU,KGROUND_LAYER ))
-ALLOCATE(TGD%CUR%XWG (KLU,KGROUND_LAYER ))
-ALLOCATE(TGD%CUR%XWGI (KLU,KGROUND_LAYER ))
-ALLOCATE(TGD%CUR%XRESA (KLU ))
-!
-! - Vegetation: Ags Prognostic (YPHOTO = 'LAI', 'LST', 'AGS' or 'LST')
-!
-ALLOCATE(TGD%CUR%XAN (KLU ))
-ALLOCATE(TGD%CUR%XANDAY (KLU ))
-ALLOCATE(TGD%CUR%XANFM (KLU ))
-ALLOCATE(TGD%CUR%XLE (KLU ))
-!
-! - Vegetation (Ags 'NIT' 'NCB' option):
-!
-ALLOCATE(TGD%CUR%XBIOMASS (KLU,TVG%NNBIOMASS ))
-ALLOCATE(TGD%CUR%XRESP_BIOMASS (KLU,TVG%NNBIOMASS ))
-!
-IF (LHOOK) CALL DR_HOOK('ALLOCATE_TEB_GARDEN',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE ALLOCATE_TEB_GARDEN
diff --git a/src/SURFEX/allocate_teb_garden_pgd.F90 b/src/SURFEX/allocate_teb_garden_pgd.F90
deleted file mode 100644
index 3b908024ce3e50092df1921b4947c12463282fdf..0000000000000000000000000000000000000000
--- a/src/SURFEX/allocate_teb_garden_pgd.F90
+++ /dev/null
@@ -1,135 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE ALLOCATE_TEB_GARDEN_PGD (TGDPE, TGDP, &
- OALLOC,KLU,KVEGTYPE,KGROUND_LAYER, KDIMTAB)
-! ##########################################################################
-!
-!
-!
-!
-USE MODD_TEB_GARDEN_PGD_EVOL_n, ONLY : TEB_GARDEN_PGD_EVOL_t
-USE MODD_TEB_GARDEN_PGD_n, ONLY : TEB_GARDEN_PGD_t
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!
-TYPE(TEB_GARDEN_PGD_EVOL_t), INTENT(INOUT) :: TGDPE
-TYPE(TEB_GARDEN_PGD_t), INTENT(INOUT) :: TGDP
-!
-LOGICAL, INTENT(IN) :: OALLOC ! True if constant PGD fields must be allocated
-INTEGER, INTENT(IN) :: KLU
-INTEGER, INTENT(IN) :: KVEGTYPE
-INTEGER, INTENT(IN) :: KGROUND_LAYER
-INTEGER, INTENT(IN) :: KDIMTAB
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-!
-IF (LHOOK) CALL DR_HOOK('ALLOCATE_TEB_GARDEN_PGD',0,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-! - Physiographic field that can evolve prognostically
-!
-ALLOCATE(TGDPE%CUR%XLAI (KLU ))
-ALLOCATE(TGDPE%CUR%XVEG (KLU ))
-ALLOCATE(TGDPE%CUR%XEMIS (KLU ))
-ALLOCATE(TGDPE%CUR%XZ0 (KLU ))
-!
-! - vegetation:
-!
-ALLOCATE(TGDP%XALBNIR_VEG (KLU ))
-ALLOCATE(TGDP%XALBVIS_VEG (KLU ))
-ALLOCATE(TGDP%XALBUV_VEG (KLU ))
-!
-IF (.NOT. OALLOC) THEN
- IF (LHOOK) CALL DR_HOOK('ALLOCATE_TEB_GARDEN_PGD',1,ZHOOK_HANDLE)
- RETURN
-END IF
-!-------------------------------------------------------------------------------
-!
-! Mask and number of grid elements containing tiles:
-ALLOCATE(TGDP%XVEGTYPE (KLU,KVEGTYPE ))
-!
-!-------------------------------------------------------------------------------
-!
-! Input Parameters:
-!
-! - vegetation + bare soil:
-!
-ALLOCATE(TGDP%XZ0_O_Z0H (KLU ))
-
-!
-! - vegetation: default option (Jarvis) and general parameters:
-!
-ALLOCATE(TGDP%XWRMAX_CF (KLU ))
-ALLOCATE(TGDP%XGAMMA (KLU ))
-ALLOCATE(TGDP%XCV (KLU ))
-ALLOCATE(TGDP%XRGL (KLU ))
-ALLOCATE(TGDP%XRSMIN (KLU ))
-ALLOCATE(TGDP%XROOTFRAC (KLU,KGROUND_LAYER ))
-ALLOCATE(TGDP%NWG_LAYER (KLU ))
-ALLOCATE(TGDP%XDROOT (KLU ))
-ALLOCATE(TGDP%XDG2 (KLU ))
-!
-!-------------------------------------------------------------------------------
-!
-! - vegetation: Ags parameters ('AGS', 'LAI', 'AST', 'LST', 'NIT' options)
-!
-ALLOCATE(TGDP%XBSLAI (KLU ))
-ALLOCATE(TGDP%XLAIMIN (KLU ))
-ALLOCATE(TGDP%XSEFOLD (KLU ))
-ALLOCATE(TGDP%XH_TREE (KLU ))
-ALLOCATE(TGDP%XANF (KLU ))
-ALLOCATE(TGDP%XGMES (KLU ))
-ALLOCATE(TGDP%XRE25 (KLU ))
-!
-!-------------------------------------------------------------------------------
-!
-! - vegetation: Ags Stress parameters ('AST', 'LST', 'NIT' options)
-!
-ALLOCATE(TGDP%LSTRESS (KLU ))
-ALLOCATE(TGDP%XF2I (KLU ))
-ALLOCATE(TGDP%XGC (KLU ))
-ALLOCATE(TGDP%XAH (KLU ))
-ALLOCATE(TGDP%XBH (KLU ))
-ALLOCATE(TGDP%XDMAX (KLU ))
-!
-!-------------------------------------------------------------------------------
-!
-! - vegetation: Ags Nitrogen-model parameters ('NIT' option)
-!
-ALLOCATE(TGDP%XCE_NITRO (KLU ))
-ALLOCATE(TGDP%XCF_NITRO (KLU ))
-ALLOCATE(TGDP%XCNA_NITRO (KLU ))
-!
-!-------------------------------------------------------------------------------
-!
-! - soil: primary parameters
-!
-ALLOCATE(TGDP%XSAND (KLU,KGROUND_LAYER ))
-ALLOCATE(TGDP%XCLAY (KLU,KGROUND_LAYER ))
-ALLOCATE(TGDP%XRUNOFFB (KLU ))
-ALLOCATE(TGDP%XWDRAIN (KLU ))
-ALLOCATE(TGDP%XGAMMAT (KLU ))
-ALLOCATE(TGDP%XDG (KLU,KGROUND_LAYER ))
-ALLOCATE(TGDP%XRUNOFFD (KLU ))
-!
-!-------------------------------------------------------------------------------
-!
-! - SGH scheme
-!
-ALLOCATE(TGDP%XD_ICE (KLU ))
-!
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('ALLOCATE_TEB_GARDEN_PGD',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE ALLOCATE_TEB_GARDEN_PGD
diff --git a/src/SURFEX/allocate_teb_greenroof.F90 b/src/SURFEX/allocate_teb_greenroof.F90
deleted file mode 100644
index a850112ecb28067ca97325db6ec70fada0561002..0000000000000000000000000000000000000000
--- a/src/SURFEX/allocate_teb_greenroof.F90
+++ /dev/null
@@ -1,69 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE ALLOCATE_TEB_GREENROOF (TGR, TVG, &
- KLU,KLAYER_GR)
-! ##########################################################################
-!
-!
-!
-!
-USE MODD_TEB_GREENROOF_n, ONLY : TEB_GREENROOF_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!
-TYPE(TEB_GREENROOF_t), INTENT(INOUT) :: TGR
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
-!
-INTEGER, INTENT(IN) :: KLU
-INTEGER, INTENT(IN) :: KLAYER_GR
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-! Mask and number of grid elements containing patches/tiles:
-!
-IF (LHOOK) CALL DR_HOOK('ALLOCATE_TEB_GREENROOF',0,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-! Averaged Surface radiative parameters:
-!
-ALLOCATE(TGR%CUR%XSNOWFREE_ALB (KLU))
-ALLOCATE(TGR%CUR%XSNOWFREE_ALB_VEG (KLU))
-ALLOCATE(TGR%CUR%XSNOWFREE_ALB_SOIL (KLU))
-!
-!-------------------------------------------------------------------------------
-!
-! Prognostic variables:
-!
-! - Soil and vegetation heat and water:
-!
-ALLOCATE(TGR%CUR%XWR (KLU ))
-ALLOCATE(TGR%CUR%XTG (KLU,KLAYER_GR ))
-ALLOCATE(TGR%CUR%XWG (KLU,KLAYER_GR ))
-ALLOCATE(TGR%CUR%XWGI (KLU,KLAYER_GR ))
-ALLOCATE(TGR%CUR%XRESA (KLU ))
-!
-! - Vegetation: Ags Prognostic (YPHOTO = 'LAI', 'LST', 'AGS' or 'LST')
-!
-ALLOCATE(TGR%CUR%XAN (KLU ))
-ALLOCATE(TGR%CUR%XANDAY (KLU ))
-ALLOCATE(TGR%CUR%XANFM (KLU ))
-ALLOCATE(TGR%CUR%XLE (KLU ))
-!
-! - Vegetation (Ags 'NIT' 'NCB' option):
-!
-ALLOCATE(TGR%CUR%XBIOMASS (KLU,TVG%NNBIOMASS ))
-ALLOCATE(TGR%CUR%XRESP_BIOMASS (KLU,TVG%NNBIOMASS ))
-!
-IF (LHOOK) CALL DR_HOOK('ALLOCATE_TEB_GREENROOF',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE ALLOCATE_TEB_GREENROOF
diff --git a/src/SURFEX/allocate_teb_greenroof_pgd.F90 b/src/SURFEX/allocate_teb_greenroof_pgd.F90
deleted file mode 100644
index 2ca42f26bf2d306721f802834ddb98a6ccc147e7..0000000000000000000000000000000000000000
--- a/src/SURFEX/allocate_teb_greenroof_pgd.F90
+++ /dev/null
@@ -1,132 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE ALLOCATE_TEB_GREENROOF_PGD (TGRPE, TGRP, &
- OALLOC,KLU,KVEGTYPE,KLAYER_GR, KDIMTAB)
-! ##########################################################################
-!
-!
-!
-!
-USE MODD_TEB_GREENROOF_PGD_EVOL_n, ONLY : TEB_GREENROOF_PGD_EVOL_t
-USE MODD_TEB_GREENROOF_PGD_n, ONLY : TEB_GREENROOF_PGD_t
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!
-TYPE(TEB_GREENROOF_PGD_EVOL_t), INTENT(INOUT) :: TGRPE
-TYPE(TEB_GREENROOF_PGD_t), INTENT(INOUT) :: TGRP
-!
-LOGICAL, INTENT(IN) :: OALLOC ! True if constant PGD fields must be allocated
-INTEGER, INTENT(IN) :: KLU
-INTEGER, INTENT(IN) :: KVEGTYPE
-INTEGER, INTENT(IN) :: KLAYER_GR
-INTEGER, INTENT(IN) :: KDIMTAB
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('ALLOCATE_TEB_GREENROOF_PGD',0,ZHOOK_HANDLE)
-!-------------------------------------------------------------------------------
-!
-! - Physiographic field that can evolve prognostically
-!
-ALLOCATE(TGRPE%CUR%XLAI (KLU ))
-ALLOCATE(TGRPE%CUR%XVEG (KLU ))
-ALLOCATE(TGRPE%CUR%XEMIS (KLU ))
-ALLOCATE(TGRPE%CUR%XZ0 (KLU ))
-!
-! - vegetation:
-!
-ALLOCATE(TGRP%XALBNIR_VEG (KLU ))
-ALLOCATE(TGRP%XALBVIS_VEG (KLU ))
-ALLOCATE(TGRP%XALBUV_VEG (KLU ))
-!
-IF (.NOT. OALLOC) THEN
- IF (LHOOK) CALL DR_HOOK('ALLOCATE_TEB_GARDEN_PGD',1,ZHOOK_HANDLE)
- RETURN
-END IF
-!-------------------------------------------------------------------------------
-! Mask and number of grid elements containing tiles:
-!
-ALLOCATE(TGRP%XVEGTYPE (KLU,KVEGTYPE ))
-!
-!-------------------------------------------------------------------------------
-!
-! Input Parameters:
-!
-! - vegetation + bare soil:
-!
-ALLOCATE(TGRP%XZ0_O_Z0H (KLU ))
-!
-! - vegetation: default option (Jarvis) and general parameters:
-!
-ALLOCATE(TGRP%XWRMAX_CF (KLU ))
-ALLOCATE(TGRP%XGAMMA (KLU ))
-ALLOCATE(TGRP%XCV (KLU ))
-ALLOCATE(TGRP%XRGL (KLU ))
-ALLOCATE(TGRP%XRSMIN (KLU ))
-ALLOCATE(TGRP%XROOTFRAC (KLU,KLAYER_GR ))
-ALLOCATE(TGRP%NWG_LAYER (KLU ))
-ALLOCATE(TGRP%XDROOT (KLU ))
-ALLOCATE(TGRP%XDG2 (KLU ))
-!
-!-------------------------------------------------------------------------------
-!
-! - vegetation: Ags parameters ('AGS', 'LAI', 'AST', 'LST', 'NIT' options)
-!
-ALLOCATE(TGRP%XBSLAI (KLU ))
-ALLOCATE(TGRP%XLAIMIN (KLU ))
-ALLOCATE(TGRP%XSEFOLD (KLU ))
-ALLOCATE(TGRP%XH_TREE (KLU ))
-ALLOCATE(TGRP%XANF (KLU ))
-ALLOCATE(TGRP%XGMES (KLU ))
-ALLOCATE(TGRP%XRE25 (KLU ))
-!
-!-------------------------------------------------------------------------------
-!
-! - vegetation: Ags Stress parameters ('AST', 'LST', 'NIT' options)
-!
-ALLOCATE(TGRP%LSTRESS (KLU ))
-ALLOCATE(TGRP%XF2I (KLU ))
-ALLOCATE(TGRP%XGC (KLU ))
-ALLOCATE(TGRP%XAH (KLU ))
-ALLOCATE(TGRP%XBH (KLU ))
-ALLOCATE(TGRP%XDMAX (KLU ))
-!
-!-------------------------------------------------------------------------------
-!
-! - vegetation: Ags Nitrogen-model parameters ('NIT' option)
-!
-ALLOCATE(TGRP%XCE_NITRO (KLU ))
-ALLOCATE(TGRP%XCF_NITRO (KLU ))
-ALLOCATE(TGRP%XCNA_NITRO (KLU ))
-!
-!-------------------------------------------------------------------------------
-!
-! - soil: primary parameters
-!
-ALLOCATE(TGRP%XOM_GR (KLU,KLAYER_GR ))
-ALLOCATE(TGRP%XSAND_GR (KLU,KLAYER_GR ))
-ALLOCATE(TGRP%XCLAY_GR (KLU,KLAYER_GR ))
-ALLOCATE(TGRP%XTAUICE (KLU ))
-ALLOCATE(TGRP%XGAMMAT (KLU ))
-ALLOCATE(TGRP%XDG (KLU,KLAYER_GR ))
-ALLOCATE(TGRP%XRUNOFFD (KLU ))
-!
-!-------------------------------------------------------------------------------
-!
-! - SGH scheme
-!
-ALLOCATE(TGRP%XD_ICE (KLU ))
-!
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('ALLOCATE_TEB_GREENROOF_PGD',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE ALLOCATE_TEB_GREENROOF_PGD
diff --git a/src/SURFEX/allocate_teb_veg.F90 b/src/SURFEX/allocate_teb_veg.F90
new file mode 100644
index 0000000000000000000000000000000000000000..c2c70557500d6df9a4566ee211066a10fee418a5
--- /dev/null
+++ b/src/SURFEX/allocate_teb_veg.F90
@@ -0,0 +1,66 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE ALLOCATE_TEB_VEG (PEK, KLU,KGROUND_LAYER,KNBIOMASS)
+! ##########################################################################
+!
+!
+USE MODD_ISBA_n, ONLY : ISBA_PE_t
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
+INTEGER, INTENT(IN) :: KLU
+INTEGER, INTENT(IN) :: KGROUND_LAYER
+INTEGER, INTENT(IN) :: KNBIOMASS
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+!
+! Mask and number of grid elements containing patches/tiles:
+!
+IF (LHOOK) CALL DR_HOOK('ALLOCATE_TEB_VEG',0,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+! Averaged Surface radiative parameters:
+!
+ALLOCATE(PEK%XSNOWFREE_ALB (KLU))
+ALLOCATE(PEK%XSNOWFREE_ALB_VEG (KLU))
+ALLOCATE(PEK%XSNOWFREE_ALB_SOIL (KLU))
+!
+!-------------------------------------------------------------------------------
+!
+! Prognostic variables:
+!
+!
+! - Soil and vegetation heat and water:
+!
+ALLOCATE(PEK%XWR (KLU ))
+ALLOCATE(PEK%XTG (KLU,KGROUND_LAYER ))
+ALLOCATE(PEK%XWG (KLU,KGROUND_LAYER ))
+ALLOCATE(PEK%XWGI (KLU,KGROUND_LAYER ))
+ALLOCATE(PEK%XRESA (KLU ))
+!
+! - Vegetation: Ags Prognostic
+!
+ALLOCATE(PEK%XAN (KLU ))
+ALLOCATE(PEK%XANDAY (KLU ))
+ALLOCATE(PEK%XANFM (KLU ))
+ALLOCATE(PEK%XLE (KLU ))
+!
+! - Vegetation (Ags 'NIT' 'NCB' option):
+!
+ALLOCATE(PEK%XBIOMASS (KLU,KNBIOMASS ))
+ALLOCATE(PEK%XRESP_BIOMASS (KLU,KNBIOMASS ))
+!
+IF (LHOOK) CALL DR_HOOK('ALLOCATE_TEB_VEG',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE ALLOCATE_TEB_VEG
diff --git a/src/SURFEX/allocate_teb_veg_pgd.F90 b/src/SURFEX/allocate_teb_veg_pgd.F90
new file mode 100644
index 0000000000000000000000000000000000000000..8c56e3e0c10c8fe02a48fc8bedc05f257089969b
--- /dev/null
+++ b/src/SURFEX/allocate_teb_veg_pgd.F90
@@ -0,0 +1,138 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE ALLOCATE_TEB_VEG_PGD (PEK, S, K, P, OALLOC, KLU, KVEGTYPE, KGROUND_LAYER)
+! ##########################################################################
+!
+!
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_PE_t, ISBA_P_t, ISBA_K_t
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_P_t), INTENT(INOUT) :: P
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+!
+LOGICAL, INTENT(IN) :: OALLOC ! True if constant PGD fields must be allocated
+INTEGER, INTENT(IN) :: KLU
+INTEGER, INTENT(IN) :: KVEGTYPE
+INTEGER, INTENT(IN) :: KGROUND_LAYER
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('ALLOCATE_TEB_VEG_PGD',0,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+! - Physiographic field that can evolve prognostically
+!
+ALLOCATE(PEK%XLAI (KLU))
+ALLOCATE(PEK%XVEG (KLU))
+ALLOCATE(PEK%XEMIS (KLU))
+ALLOCATE(PEK%XZ0 (KLU))
+!
+! - vegetation: default option (Jarvis) and general parameters:
+!
+ALLOCATE(PEK%XRSMIN (KLU))
+ALLOCATE(PEK%XGAMMA (KLU))
+ALLOCATE(PEK%XWRMAX_CF (KLU))
+ALLOCATE(PEK%XRGL (KLU))
+ALLOCATE(PEK%XCV (KLU))
+!
+ALLOCATE(PEK%XLAIMIN (KLU))
+ALLOCATE(PEK%XSEFOLD (KLU))
+ALLOCATE(PEK%XGMES (KLU))
+ALLOCATE(PEK%XGC (KLU))
+ALLOCATE(PEK%XF2I (KLU))
+ALLOCATE(PEK%XBSLAI (KLU))
+!
+! - vegetation:
+!
+ALLOCATE(PEK%XALBNIR_VEG (KLU))
+ALLOCATE(PEK%XALBVIS_VEG (KLU))
+ALLOCATE(PEK%XALBUV_VEG (KLU))
+!
+ALLOCATE(PEK%LSTRESS (KLU))
+!
+!-------------------------------------------------------------------------------
+!
+! - vegetation: Ags Nitrogen-model parameters ('NIT' option)
+!
+ALLOCATE(PEK%XCE_NITRO (KLU))
+ALLOCATE(PEK%XCF_NITRO (KLU))
+ALLOCATE(PEK%XCNA_NITRO (KLU))
+!
+IF (.NOT. OALLOC) THEN
+ IF (LHOOK) CALL DR_HOOK('ALLOCATE_TEB_VEG_PGD',1,ZHOOK_HANDLE)
+ RETURN
+END IF
+!-------------------------------------------------------------------------------
+!
+! Input Parameters:
+!
+! - vegetation + bare soil:
+!
+ALLOCATE(P%XZ0_O_Z0H (KLU))
+!
+ALLOCATE(P%XROOTFRAC (KLU,KGROUND_LAYER ))
+ALLOCATE(P%NWG_LAYER (KLU))
+ALLOCATE(P%XDROOT (KLU))
+ALLOCATE(P%XDG2 (KLU))
+!
+!-------------------------------------------------------------------------------
+!
+! - vegetation: Ags parameters ('AGS', 'LAI', 'AST', 'LST', 'NIT' options)
+!
+!
+ALLOCATE(P%XH_TREE (KLU))
+!
+!
+ALLOCATE(P%XRE25 (KLU))
+!
+!-------------------------------------------------------------------------------
+!
+! - vegetation: Ags Stress parameters ('AST', 'LST', 'NIT' options)
+!
+!
+ALLOCATE(P%XAH (KLU))
+ALLOCATE(P%XBH (KLU))
+!
+ALLOCATE(P%XDMAX (KLU))
+!
+!-------------------------------------------------------------------------------
+!
+! - soil: primary parameters
+!
+ALLOCATE(S%XSOC (KLU,KGROUND_LAYER ))
+!
+ALLOCATE(K%XSAND (KLU,KGROUND_LAYER ))
+ALLOCATE(K%XCLAY (KLU,KGROUND_LAYER ))
+ALLOCATE(K%XRUNOFFB (KLU ))
+ALLOCATE(K%XWDRAIN (KLU ))
+!
+ALLOCATE(P%XTAUICE (KLU ))
+!
+ALLOCATE(P%XDG (KLU,KGROUND_LAYER))
+!
+ALLOCATE(P%XRUNOFFD (KLU))
+!
+!-------------------------------------------------------------------------------
+!
+! - SGH scheme
+!
+ALLOCATE(P%XD_ICE (KLU))
+!
+ALLOCATE(K%XGAMMAT (KLU ))
+!
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('ALLOCATE_TEB_VEG_PGD',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE ALLOCATE_TEB_VEG_PGD
diff --git a/src/SURFEX/hor_interpol_gauss_1cov.F90 b/src/SURFEX/arpege_stretch_a.F90
similarity index 67%
rename from src/SURFEX/hor_interpol_gauss_1cov.F90
rename to src/SURFEX/arpege_stretch_a.F90
index a29c2a450867d9b3f9b568ab2c4b287bc4d62796..31235a9258614326f0d66871291b2db7883ca9e6 100644
--- a/src/SURFEX/hor_interpol_gauss_1cov.F90
+++ b/src/SURFEX/arpege_stretch_a.F90
@@ -2,113 +2,6 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE HOR_INTERPOL_GAUSS_1COV(KLUOUT,PFIELDIN,PFIELDOUT)
-! #################################################################################
-!
-!!**** *HOR_INTERPOL_GAUSS_1COV* - Interpolation from a gaussian grid on 1 vertical level only
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! M.Moge (adapted from HOR_INTERPOL_GAUSS)
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 06/2015
-!!------------------------------------------------------------------
-!
-!
-!
-USE MODD_PREP, ONLY : XLAT_OUT, XLON_OUT, LINTERP
-USE MODD_GRID_GAUSS, ONLY : XILA1, XILO1, XILA2, XILO2, NINLA, NINLO, NILEN, LROTPOLE, &
- XLAP, XLOP, XCOEF
-USE MODD_GRID_GRIB, ONLY : NNI
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE MODI_HORIBL_SURF
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
-REAL, DIMENSION(:), INTENT(IN) :: PFIELDIN ! field to interpolate horizontally
-REAL, DIMENSION(:), INTENT(OUT) :: PFIELDOUT ! interpolated field
-!
-!* 0.2 declarations of local variables
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZLAT ! latitudes
-REAL, DIMENSION(:), ALLOCATABLE :: ZLON ! longitudes
-INTEGER, DIMENSION(:), ALLOCATABLE :: IMASKIN ! input mask
-INTEGER, DIMENSION(:), ALLOCATABLE :: IMASKOUT ! output mask
-INTEGER :: INO ! output number of points
-INTEGER :: JL ! loop counter
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------------
-!
-!* 1. Allocations
-!
-IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_GAUSS_1COV',0,ZHOOK_HANDLE)
-INO = SIZE(XLAT_OUT)
-!
-IF (NNI==0) NNI=NILEN
-ALLOCATE(IMASKIN (NNI))
-!
-ALLOCATE(ZLAT (INO))
-ALLOCATE(ZLON (INO))
-ALLOCATE(IMASKOUT(INO))
-IMASKOUT = 1
-!
-!* 2. Is pole rotated?
-!
-IF (LROTPOLE) THEN
-!* transformation of output latitudes, longitudes into rotated coordinates
- CALL ARPEGE_STRETCH_A(INO,XLAP,XLOP,XCOEF,XLAT_OUT,XLON_OUT,ZLAT,ZLON)
-ELSE
- ZLAT = XLAT_OUT
- ZLON = XLON_OUT
-END IF
-!
-!* 3. Input mask
-!
-!
-IMASKIN(:) = 1.
-WHERE(PFIELDIN(:)==XUNDEF) IMASKIN = 0.
-!
-!
-!* 4. Interpolation with horibl
-!
-CALL HORIBL_SURF(XILA1,XILO1,XILA2,XILO2,NINLA,NINLO,NNI,PFIELDIN(:),INO,ZLON,ZLAT,PFIELDOUT(:), &
- .FALSE.,KLUOUT,LINTERP,IMASKIN,IMASKOUT)
-!
-!
-!* 5. Deallocations
-!
-DEALLOCATE(ZLAT)
-DEALLOCATE(ZLON)
-DEALLOCATE(IMASKIN )
-DEALLOCATE(IMASKOUT)
-!
-!-------------------------------------------------------------------------------
-!-------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_GAUSS_1COV',1,ZHOOK_HANDLE)
-CONTAINS
-!
! ##########################################################################
SUBROUTINE ARPEGE_STRETCH_A(KN,PLAP,PLOP,PCOEF,PLAR,PLOR,PLAC,PLOC)
! ##########################################################################
@@ -163,6 +56,9 @@ SUBROUTINE ARPEGE_STRETCH_A(KN,PLAP,PLOP,PCOEF,PLAR,PLOR,PLAC,PLOC)
! ---------------
!
USE MODD_CSTS,ONLY : XPI
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
@@ -252,4 +148,3 @@ SUBROUTINE ARPEGE_STRETCH_A(KN,PLAP,PLOP,PCOEF,PLAR,PLOR,PLAC,PLOC)
IF (LHOOK) CALL DR_HOOK('ARPEGE_STRETCH_A',1,ZHOOK_HANDLE)
END SUBROUTINE ARPEGE_STRETCH_A
!-------------------------------------------------------------------------------
-END SUBROUTINE HOR_INTERPOL_GAUSS_1COV
diff --git a/src/SURFEX/arrange_cover.F90 b/src/SURFEX/arrange_cover.F90
index 20115873c371caf6a442ec7b1babf443f3b17e40..e5b329bcd9f05ef6b582402c6e89423b3c889134 100644
--- a/src/SURFEX/arrange_cover.F90
+++ b/src/SURFEX/arrange_cover.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########################
- SUBROUTINE ARRANGE_COVER (DTCO, U, &
+ SUBROUTINE ARRANGE_COVER (DTCO, OWATER_TO_NATURE, OTOWN_TO_ROCK, &
PDATA_NATURE,PDATA_TOWN,PDATA_SEA,PDATA_WATER,PDATA_VEGTYPE, &
PDATA_GARDEN, OGARDEN, PDATA_BLD, PDATA_WALL_O_HOR )
! #########################
@@ -46,7 +46,6 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
@@ -69,8 +68,9 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
+LOGICAL, INTENT(IN) :: OWATER_TO_NATURE
+LOGICAL, INTENT(IN) :: OTOWN_TO_ROCK
REAL, DIMENSION(:), INTENT(IN) :: PDATA_NATURE
REAL, DIMENSION(:), INTENT(IN) :: PDATA_TOWN
REAL, DIMENSION(:), INTENT(IN) :: PDATA_SEA
@@ -133,7 +133,7 @@ DTCO%XDATA_WALL_O_HOR = PDATA_WALL_O_HOR
! Change water (not lake) to nature
!-------------------------------------------------------------------------------
!
-IF(U%LWATER_TO_NATURE)THEN
+IF(OWATER_TO_NATURE)THEN
DO JCOVER=1,JPCOVER
IF(DTCO%XDATA_WATER(JCOVER)>0.0.AND.DTCO%XDATA_WATER(JCOVER)<1.0)THEN
DTCO%XDATA_NATURE(JCOVER)=DTCO%XDATA_NATURE(JCOVER)+DTCO%XDATA_WATER(JCOVER)
@@ -146,7 +146,7 @@ ENDIF
! Change town to rock but keep other natural fraction
!-------------------------------------------------------------------------------
!
-IF(U%LTOWN_TO_ROCK)THEN
+IF(OTOWN_TO_ROCK)THEN
!
DO JCOVER=1,JPCOVER
IF(DTCO%XDATA_TOWN(JCOVER)>0.0.OR.DTCO%XDATA_GARDEN(JCOVER)>0.0)THEN
@@ -190,9 +190,9 @@ ELSE
IF (.NOT. OGARDEN) THEN
DTCO%XDATA_NATURE = DTCO%XDATA_NATURE + DTCO%XDATA_GARDEN * DTCO%XDATA_TOWN
DTCO%XDATA_TOWN = DTCO%XDATA_TOWN * ( 1. - DTCO%XDATA_GARDEN)
- DTCO%XDATA_GARDEN = 0.
DTCO%XDATA_BLD = DTCO%XDATA_BLD / (1. - DTCO%XDATA_GARDEN)
DTCO%XDATA_WALL_O_HOR = DTCO%XDATA_WALL_O_HOR / (1. - DTCO%XDATA_GARDEN)
+ DTCO%XDATA_GARDEN = 0.
END IF
!
ENDIF
diff --git a/src/SURFEX/assim_inland_watern.F90 b/src/SURFEX/assim_inland_watern.F90
deleted file mode 100644
index f83a3883fbe50369301aba713ac6a8a613887ebf..0000000000000000000000000000000000000000
--- a/src/SURFEX/assim_inland_watern.F90
+++ /dev/null
@@ -1,202 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ###############################################################################
-SUBROUTINE ASSIM_INLAND_WATER_n (I, U, W, &
- HPROGRAM,KI,PTS_IN,PITM,HTEST, &
- OLKEEPEXTZONE,OD_MASKEXT,PLON_IN,PLAT_IN)
-
-! ###############################################################################
-!
-!!**** *ASSIM_INLAND_WATER_n * - Chooses the surface assimilation schemes for INLAND_WATER parts
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! T. Aspelien
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 04/2012
-!! Trygve Aspelien, Separating IO 06/2013
-!! J.Escobar 30/03/2017 : Management of compilation of ECMWF_RAD in REAL*8 with MNH_REAL=R4
-!!--------------------------------------------------------------------
-!
-!
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_WATFLUX_n, ONLY : WATFLUX_t
-!
-USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_ASSIM, ONLY : NPRINTLEV,LEXTRAP_WATER,LWATERTG2
-!
-USE YOMHOOK, ONLY : LHOOK,DR_HOOK
-USE PARKIND1, ONLY : JPRB
-!
-USE MODI_ABOR1_SFX
-USE MODI_OI_HOR_EXTRAPOL_SURF
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(WATFLUX_t), INTENT(INOUT) :: W
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-INTEGER, INTENT(IN) :: KI
-REAL,DIMENSION(KI), INTENT(IN) :: PTS_IN
-REAL,DIMENSION(KI), INTENT(IN) :: PITM
- CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
-LOGICAL, INTENT(IN) :: OLKEEPEXTZONE
-LOGICAL, DIMENSION(KI), INTENT(IN) :: OD_MASKEXT
-REAL , DIMENSION (:), INTENT(IN) :: PLON_IN
-REAL , DIMENSION (:), INTENT(IN) :: PLAT_IN
-!
-!* 0.2 declarations of local variables
-!
-!-------------------------------------------------------------------------------------
-!
-REAL, DIMENSION(KI) :: ZLST
-REAL, DIMENSION(KI) :: ZLST0
-REAL, DIMENSION(KI) :: ZLSTINC
-REAL, DIMENSION(:), ALLOCATABLE :: ZLST01, ZLST1, ZLON1, ZLAT1, ZALT1
-!
-LOGICAL,DIMENSION(KI) :: GINTERP_LST
-LOGICAL, DIMENSION(:), ALLOCATABLE :: GINTERP_LST1
-INTEGER :: IRESP,JI,JJ,IS1,J1
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
-IF (LHOOK) CALL DR_HOOK('ASSIM_INLAND_WATER_N',0,ZHOOK_HANDLE)
-
-IF (HTEST/='OK') THEN
- CALL ABOR1_SFX('ASSIM_INLAND_WATER_n: FATAL ERROR DURING ARGUMENT TRANSFER')
-END IF
-
-IF (NRANK==NPIO) WRITE(*,*) 'UPDATING LST FOR INLAND_WATER: ',TRIM(U%CWATER)
-IF (U%CWATER=="NONE") THEN
- IF (LHOOK) CALL DR_HOOK('ASSIM_INLAND_WATER_N',1,ZHOOK_HANDLE)
- RETURN
-ENDIF
-!
-!* ZLST updated!
-!
-ZLST(:) = XUNDEF
-IF (.NOT.LWATERTG2 ) THEN
- !* ZLST updated from from CANARI analysis
- DO JI=1,KI
- IF ( PITM(JI)<0.5 ) ZLST(JI) = PTS_IN(JI)
- ENDDO
- !
-ELSE
- ! Set TG2 from global array
- DO JI=1,KI
- IF ( PITM(JI)>0.5 ) THEN
- !* ZLST updated from LAND values of climatological TS
- DO JJ=1,U%NSIZE_NATURE
- IF ( U%NR_WATER(JI)==U%NR_NATURE(JJ) ) THEN
- ZLST(JI) = I%XTG(JJ,2,1)
- EXIT
- ENDIF
- ENDDO
- ENDIF
- ENDDO
- !
-ENDIF
-!
-! Set local array from global
-GINTERP_LST(:) = .FALSE.
-DO JI=1,KI
- IF ( ZLST(JI)/=XUNDEF ) THEN
- ZLST0(JI) = ZLST(JI)
- ELSEIF ( LEXTRAP_WATER ) THEN
- ! Keep ZLST or do extrapolation from neighbour points
- ZLST0(JI) = XUNDEF
- GINTERP_LST(JI) = .TRUE.
- ELSE
- ZLST0(JI) = W%XTS(JI)
- ENDIF
-ENDDO
-!
-IF ( LEXTRAP_WATER ) THEN
- !
- IF (OLKEEPEXTZONE) THEN
- !
- ZLST(:) = ZLST0(:)
- WHERE ( OD_MASKEXT(:) ) ZLST0(:) = XUNDEF
- CALL OI_HOR_EXTRAPOL_SURF(KI,PLAT_IN,PLON_IN,ZLST0,PLAT_IN,PLON_IN,ZLST,GINTERP_LST,W%XZS)
- !
- ELSE
- !
- IS1 = COUNT (.NOT.OD_MASKEXT)
- ALLOCATE (ZLST1(IS1), ZLST01(IS1), ZLAT1(IS1), ZLON1(IS1), ZALT1(IS1), GINTERP_LST1(IS1))
- !
- ! remove extension zone
- JJ = 1
- DO J1 = 1, KI
- IF ( .NOT.OD_MASKEXT(J1) ) THEN
- ZLST01(JJ) = ZLST0(J1)
- ZLAT1 (JJ) = PLAT_IN (J1)
- ZLON1 (JJ) = PLON_IN (J1)
- ZALT1 (JJ) = W%XZS (J1)
- GINTERP_LST1(JJ) = GINTERP_LST(J1)
- JJ = JJ + 1
- ENDIF
- ENDDO
-
- ZLST1(:) = ZLST01(:)
- CALL OI_HOR_EXTRAPOL_SURF(IS1,ZLAT1,ZLON1,ZLST01,ZLAT1,ZLON1,ZLST1,GINTERP_LST1,ZALT1)
- !
- ! copy back
- JJ = 1
- DO J1 = 1, KI
- IF ( .NOT.OD_MASKEXT(J1) ) THEN
- ZLST(J1) = ZLST1(JJ)
- JJ = JJ + 1
- ENDIF
- ENDDO
- !
- DEALLOCATE (ZLST01, ZLST1, ZLAT1, ZLON1, ZALT1, GINTERP_LST1)
- !
- ENDIF
- !
-ENDIF
-!
-!* Print values produced by OI_HO_EXTRAPOL_SURF
-IF ( NPRINTLEV > 2 ) THEN
- DO JI=1,KI
- IF (GINTERP_LST(JI)) THEN
- PRINT *,'Lake surface temperature set to ',ZLST(JI),'from nearest neighbour at I=',U%NR_WATER(JI)
- ENDIF
- ENDDO
-ENDIF
-!
-! Sum the increments
-IF (ALL(ZLST(:)/=XUNDEF)) THEN
- ZLSTINC(:) = ZLST(:) - W%XTS(:)
- ! Setting modified variables
- W%XTS(:) = ZLST(:)
-ELSE
- ZLSTINC(:) = 0.
-ENDIF
-!
-WRITE(*,*) 'Mean LST increments over inland water ',SUM(ZLSTINC)/KI
-!
-IF (LHOOK) CALL DR_HOOK('ASSIM_INLAND_WATER_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE ASSIM_INLAND_WATER_n
diff --git a/src/SURFEX/assim_isba_update_snow.F90 b/src/SURFEX/assim_isba_update_snow.F90
deleted file mode 100644
index 5b035b5a51039c7a7a7383070effff442a995104..0000000000000000000000000000000000000000
--- a/src/SURFEX/assim_isba_update_snow.F90
+++ /dev/null
@@ -1,116 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE ASSIM_ISBA_UPDATE_SNOW (I, &
- HPROGRAM, KI, PSWE, PSWE_ORIG, OINITSNOW, OINC, HTEST )
-
-! ------------------------------------------------------------------------------------------
-! *****************************************************************************************
-!
-! Routine to update snow field for ISBA
-! Trygve Aspelien, Separating IO 06/2013
-!
-!
-! ******************************************************************************************
-! ------------------------------------------------------------------------------------------
-!
-USE MODD_ISBA_n, ONLY : ISBA_t
-!
-USE MODD_CSTS, ONLY : XTT
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_SNOW_PAR, ONLY : XANSMIN, XANSMAX, XRHOSMIN, XRHOSMAX
-!
-!
-USE MODI_ABOR1_SFX
-!
-USE YOMHOOK, ONLY : LHOOK,DR_HOOK
-USE PARKIND1, ONLY : JPRB
-!
-IMPLICIT NONE
-!
-TYPE(ISBA_t), INTENT(INOUT) :: I
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-INTEGER, INTENT(IN) :: KI
-REAL, DIMENSION(KI), INTENT(IN) :: PSWE
-REAL, DIMENSION(KI), INTENT(INOUT) :: PSWE_ORIG
-LOGICAL, INTENT(IN) :: OINITSNOW
-LOGICAL, INTENT(IN) :: OINC
- CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
-!
-! Declarations of local variables
-!
-REAL, DIMENSION(KI) :: ZSWE ! Snow before update
-REAL, DIMENSION(KI) :: ZSWEINC
-REAL, DIMENSION(KI) :: ZTS
-! Addtional snow fields with D95 snow scheme
-REAL, DIMENSION(KI) :: ZSNR ! Snow density
-REAL, DIMENSION(KI) :: ZSNA ! Snow albedo
-INTEGER :: JL,JP
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-! ----------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('ASSIM_ISBA_UPDATE_SNOW',0,ZHOOK_HANDLE)
-!
-IF (HTEST/='OK') THEN
- CALL ABOR1_SFX('ASSIM_ISBA_n: FATAL ERROR DURING ARGUMENT TRANSFER')
-END IF
-!
-IF ( I%TSNOW%SCHEME=='D95' ) THEN
- JL = 1
- JP = 1
- IF ( I%NPATCH > 1 ) CALL ABOR1_SFX("Update of snow is only implemented for D95 and one patch")
-ELSE
- CALL ABOR1_SFX("Update of snow is only implemented for D95")
-ENDIF
-!
-IF ( OINITSNOW ) THEN
- !
- PSWE_ORIG(:) = I%TSNOW%WSNOW(:,JL,JP)
- !
- ZTS(:) = I%XTG(:,1,JP)
- !
- ZSWE(:) = PSWE(:)
- ! Set snow=0 where 1. guess = 0 and Ts>0, to avoid that the snow analysis introduce snow where it is no snow.
- WHERE ( PSWE(:)/=XUNDEF .AND. PSWE(:)<1.0E-10 .AND. ZTS(:)>XTT )
- ZSWE(:) = 0.0
- END WHERE
- !
- I%TSNOW%WSNOW(:,JL,JP) = ZSWE(:)
- !
-ENDIF
-
-
-! Update snow
-IF ( OINC ) THEN
-
- ZSWE(:) = I%TSNOW%WSNOW(:,JL,JP)
- ZSNA(:) = I%TSNOW%ALB (:,JP)
- ZSNR(:) = I%TSNOW%RHO (:,JL,JP)
-
- ! If we only do second step, we must set working SWE as input SWE
- IF ( .NOT. OINITSNOW ) ZSWE(:) = PSWE(:)
-
- ! Calculate increments
- ZSWEINC(:) = ZSWE(:) - PSWE_ORIG(:)
- WRITE(*,'(" SURFRESERV.NEIGE - min, mean, max: ",3E13.4)') MINVAL(ZSWE),MAXVAL(ZSWE),SUM(ZSWE)/KI
- WRITE(*,*) 'Mean SN increments over NATURE ',SUM(ZSWEINC)/KI
-
- ! Snow albedo and density are given initial values in points
- ! which get initial snow in the snow analysis
- WHERE ( PSWE_ORIG(:) < 1.0E-10 .AND. ZSWE(:)>= 1.0E-10 )
- ZSNA(:) = 0.5 * ( XANSMIN + XANSMAX )
- ZSNR(:) = 0.5 * ( XRHOSMIN + XRHOSMAX )
- END WHERE
- !
- I%TSNOW%WSNOW(:,JL,JP) = ZSWE(:)
- I%TSNOW%ALB (:,JP) = ZSNA(:)
- I%TSNOW%RHO (:,JL,JP) = ZSNR(:)
- !
-ENDIF
-!
-! -------------------------------------------------------------------------------------
- IF (LHOOK) CALL DR_HOOK('ASSIM_ISBA_UPDATE_SNOW',1,ZHOOK_HANDLE)
- END SUBROUTINE ASSIM_ISBA_UPDATE_SNOW
diff --git a/src/SURFEX/assim_isban.F90 b/src/SURFEX/assim_isban.F90
deleted file mode 100644
index c197c62295cb620540ac11d12a5d820de7267d08..0000000000000000000000000000000000000000
--- a/src/SURFEX/assim_isban.F90
+++ /dev/null
@@ -1,296 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ###############################################################################
-SUBROUTINE ASSIM_ISBA_n (DGMI, IG, I, U, &
- HPROGRAM,KI, &
- PCON_RAIN, PSTRAT_RAIN, PCON_SNOW, PSTRAT_SNOW,&
- PCLOUDS, PLSM, PEVAPTR, PEVAP, &
- PSWEC, PTSC, PUCLS, PVCLS, &
- PTS, PT2M, PHU2M, PSWE, &
- HTEST, OD_MASKEXT, PLON_IN, PLAT_IN )
-
-! ###############################################################################
-!
-!!**** *ASSIM_ISBA_n * - Chooses the surface assimilation schemes for ISBA
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! T. Aspelien
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 04/2012
-!! Trygve Aspelien, Separating IO 06/2013
-!! J.Escobar 30/03/2017 : Management of compilation of ECMWF_RAD in REAL*8 with MNH_REAL=R4
-!!--------------------------------------------------------------------
-!
-!
-!
-USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
-USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_ASSIM, ONLY : CASSIM_ISBA,LAESNM,LEXTRAP_NATURE,NPRINTLEV
-!
-!
-USE YOMHOOK, ONLY : LHOOK, DR_HOOK
-USE PARKIND1, ONLY : JPRB
-!
-USE MODI_ABOR1_SFX
-USE MODI_OI_HOR_EXTRAPOL_SURF
-USE MODI_ASSIM_ISBA_UPDATE_SNOW
-USE MODI_ASSIM_NATURE_ISBA_EKF
-USE MODI_ASSIM_NATURE_ISBA_ENKF
-USE MODI_ASSIM_NATURE_ISBA_OI
-USE MODI_AVERAGE_DIAG_MISC_ISBA_n
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DGMI
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-INTEGER, INTENT(IN) :: KI
-REAL, DIMENSION(KI), INTENT(IN) :: PCON_RAIN
-REAL, DIMENSION(KI), INTENT(IN) :: PSTRAT_RAIN
-REAL, DIMENSION(KI), INTENT(IN) :: PCON_SNOW
-REAL, DIMENSION(KI), INTENT(IN) :: PSTRAT_SNOW
-REAL, DIMENSION(KI), INTENT(IN) :: PCLOUDS
-REAL, DIMENSION(KI), INTENT(IN) :: PLSM
-REAL, DIMENSION(KI), INTENT(IN) :: PEVAPTR
-REAL, DIMENSION(KI), INTENT(IN) :: PEVAP
-REAL, DIMENSION(KI), INTENT(IN) :: PSWEC
-REAL, DIMENSION(KI), INTENT(IN) :: PTSC
-REAL, DIMENSION(KI), INTENT(IN) :: PUCLS
-REAL, DIMENSION(KI), INTENT(IN) :: PVCLS
-REAL, DIMENSION(KI), INTENT(IN) :: PTS
-REAL, DIMENSION(KI), INTENT(IN) :: PT2M
-REAL, DIMENSION(KI), INTENT(IN) :: PHU2M
-REAL, DIMENSION(KI), INTENT(IN) :: PSWE
- CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
-LOGICAL, DIMENSION (KI), INTENT(IN) :: OD_MASKEXT
-REAL , DIMENSION (:), INTENT(IN) :: PLON_IN
-REAL , DIMENSION (:), INTENT(IN) :: PLAT_IN
-!
-!* 0.2 declarations of local variables
-!
-!-------------------------------------------------------------------------------------
-!
-LOGICAL, DIMENSION(:), ALLOCATABLE :: GINTERP_NATURE
-LOGICAL, DIMENSION(:), ALLOCATABLE :: GINTERP_SN
-REAL, DIMENSION(:), ALLOCATABLE :: ZTS_EP,ZTS_EP0
-REAL, DIMENSION(:), ALLOCATABLE :: ZTP_EP,ZTP_EP0
-REAL, DIMENSION(:), ALLOCATABLE :: ZWS_EP,ZWS_EP0
-REAL, DIMENSION(:), ALLOCATABLE :: ZWP_EP,ZWP_EP0
-REAL, DIMENSION(:), ALLOCATABLE :: ZTL_EP,ZTL_EP0
-REAL, DIMENSION(:), ALLOCATABLE :: ZSWE_EP,ZSWE_EP0
-REAL, DIMENSION(:), ALLOCATABLE :: ZSNR_EP,ZSNR_EP0
-REAL, DIMENSION(:), ALLOCATABLE :: ZSNA_EP,ZSNA_EP0
-REAL, DIMENSION(KI) :: ZSWE
-REAL, DIMENSION(KI) :: ZSWE_ORIG
-INTEGER :: JI,JL,JP
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-IF (LHOOK) CALL DR_HOOK('ASSIM_ISBA_N',0,ZHOOK_HANDLE)
-!
-IF (HTEST/='OK') THEN
- CALL ABOR1_SFX('ASSIM_ISBA_n: FATAL ERROR DURING ARGUMENT TRANSFER')
-END IF
-!
-! Set snow layers and patches
-JP = 1
-JL = 1
-!
-ZSWE = PSWE
-!
-! General snow update
-IF ( CASSIM_ISBA /= 'OI ' ) THEN
- !
- ! Snow analysis/update
- IF (LAESNM) THEN
- IF (NRANK==NPIO) WRITE(*,*) 'UPDATE SNOW FROM ANALYSED VALUES'
- CALL ASSIM_ISBA_UPDATE_SNOW(I, &
- HPROGRAM,KI,ZSWE,ZSWE_ORIG,.TRUE.,.TRUE.,HTEST)
- ELSE
- IF (NRANK==NPIO) WRITE(*,*) 'SNOW IS NOT UPDATED FROM ANALYSED VALUES'
- ENDIF
-ENDIF
-!
-! Soil assimilation
-IF ( CASSIM_ISBA == 'EKF ' ) THEN
- !
- ! Run EKF for soil
- CALL ASSIM_NATURE_ISBA_EKF(I, &
- HPROGRAM, KI, PT2M, PHU2M, HTEST)
- !
-ELSEIF ( CASSIM_ISBA == 'ENKF ') THEN
- !
- CALL ASSIM_NATURE_ISBA_ENKF(I, HPROGRAM, KI, PT2M, PHU2M, HTEST)
- !
-ELSEIF ( CASSIM_ISBA == 'OI ' ) THEN
- !
- ! Snow analysis/update. Store the original field in the surfex file
- IF (LAESNM) THEN
- IF (NRANK==NPIO) WRITE(*,*) 'UPDATE SNOW FROM ANALYSED VALUES'
- CALL ASSIM_ISBA_UPDATE_SNOW(I, &
- HPROGRAM,KI,ZSWE,ZSWE_ORIG,.TRUE.,.FALSE.,HTEST)
- ELSE
- IF (NRANK==NPIO) WRITE(*,*) 'SNOW IS NOT UPDATED FROM ANALYSED VALUES'
- ENDIF
- !
- ! Run OI for soil
- CALL ASSIM_NATURE_ISBA_OI(I, &
- HPROGRAM, KI, &
- PCON_RAIN, PSTRAT_RAIN, PCON_SNOW, PSTRAT_SNOW,&
- PCLOUDS, PLSM, PEVAPTR, PEVAP, &
- PSWEC, PTSC, PUCLS, PVCLS, &
- PTS, PT2M, PHU2M, ZSWE, &
- HTEST, OD_MASKEXT, PLON_IN, PLAT_IN )
- !
- ! Snow analysis/update (changed in oi_cacsts). Get the full increment
- IF (LAESNM) THEN
- IF (NRANK==NPIO) WRITE(*,*) 'UPDATE SNOW FROM ANALYSED OI_CACSTS VALUES'
- CALL ASSIM_ISBA_UPDATE_SNOW(I, &
- HPROGRAM,KI,ZSWE,ZSWE_ORIG,.FALSE.,.TRUE.,HTEST)
- ELSE
- IF (NRANK==NPIO) WRITE(*,*) 'SNOW IS NOT UPDATED FROM ANALYSED OI_CACSTS VALUES'
- ENDIF
- !
-ELSE
- CALL ABOR1_SFX(CASSIM_ISBA//' is not a defined scheme for ASSIM_ISBA_N')
-ENDIF
-
-! Extrapolation if requested
-IF ( LEXTRAP_NATURE ) THEN
- !
- ALLOCATE(ZWS_EP(KI),ZWP_EP(KI),ZTS_EP(KI),ZTP_EP(KI),&
- ZTL_EP(KI),ZSWE_EP(KI),ZSNR_EP(KI),ZSNA_EP(KI))
- !
- ZWS_EP = I%XWG(:,1,JP)
- ZWP_EP = I%XWG(:,2,JP)
- ZTS_EP = I%XTG(:,1,JP)
- ZTP_EP = I%XTG(:,2,JP)
- ZTL_EP = I%XWGI(:,2,JP)
- ZSWE_EP = I%TSNOW%WSNOW(:,JL,JP)
- ZSNR_EP = I%TSNOW%RHO (:,JL,JP)
- ZSNA_EP = I%TSNOW%ALB (:, JP)
- !
- ALLOCATE(GINTERP_NATURE(KI),GINTERP_SN(KI))
- !
- ! Search for the nearest grid point values for land surface fields
- ! at locations where the CANARI land fraction is less than 50%
- ! and therefore useless values MIGTH be given
- GINTERP_NATURE = .FALSE.
- GINTERP_SN = .FALSE.
- !
- ! Snow albedo and density are also extrapolated in points
- ! which get initial snow in the snow analysis
- WHERE ( ZSWE_EP(:) < 1.0E-10 .AND. PSWE(:)>= 1.0E-10 )
- GINTERP_SN(:) = .TRUE.
- ZSNA_EP(:) = XUNDEF
- ZSNR_EP(:) = XUNDEF
- END WHERE
- ZSWE_EP(:) = PSWE(:)
- !
- WHERE ( PLSM(:) < 0.5 )
- GINTERP_NATURE(:) = .TRUE.
- GINTERP_SN(:) = .TRUE.
- ZTS_EP(:) = XUNDEF
- ZTP_EP(:) = XUNDEF
- ZWS_EP(:) = XUNDEF
- ZWP_EP(:) = XUNDEF
- ZTL_EP(:) = XUNDEF
- ZSWE_EP(:) = XUNDEF
- ZSNA_EP(:) = XUNDEF
- ZSNR_EP(:) = XUNDEF
- END WHERE
- !
- ALLOCATE(ZWS_EP0(KI),ZWP_EP0(KI),ZTS_EP0(KI),ZTP_EP0(KI),&
- ZTL_EP0(KI),ZSWE_EP0(KI),ZSNR_EP0(KI),ZSNA_EP0(KI))
- !
- ZWS_EP0(:) = ZWS_EP(:)
- CALL OI_HOR_EXTRAPOL_SURF(KI,IG%XLAT,IG%XLON,ZWS_EP0,IG%XLAT,IG%XLON,ZWS_EP,GINTERP_NATURE)
- ZWP_EP0(:) = ZWP_EP(:)
- CALL OI_HOR_EXTRAPOL_SURF(KI,IG%XLAT,IG%XLON,ZWP_EP0,IG%XLAT,IG%XLON,ZWP_EP,GINTERP_NATURE)
- ZTS_EP0(:) = ZTS_EP(:)
- CALL OI_HOR_EXTRAPOL_SURF(KI,IG%XLAT,IG%XLON,ZTS_EP0,IG%XLAT,IG%XLON,ZTS_EP,GINTERP_NATURE,I%XZS)
- ZTP_EP0(:) = ZTP_EP(:)
- CALL OI_HOR_EXTRAPOL_SURF(KI,IG%XLAT,IG%XLON,ZTP_EP0,IG%XLAT,IG%XLON,ZTP_EP,GINTERP_NATURE,I%XZS)
- ZTL_EP0(:) = ZTL_EP(:)
- CALL OI_HOR_EXTRAPOL_SURF(KI,IG%XLAT,IG%XLON,ZTL_EP0,IG%XLAT,IG%XLON,ZTL_EP,GINTERP_NATURE)
- ZSWE_EP0(:) = ZSWE_EP(:)
- CALL OI_HOR_EXTRAPOL_SURF(KI,IG%XLAT,IG%XLON,ZSWE_EP0,IG%XLAT,IG%XLON,ZSWE_EP,GINTERP_SN)
- ZSNR_EP0(:) = ZSNR_EP(:)
- CALL OI_HOR_EXTRAPOL_SURF(KI,IG%XLAT,IG%XLON,ZSNR_EP0,IG%XLAT,IG%XLON,ZSNR_EP,GINTERP_SN)
- ZSNA_EP0(:) = ZSNA_EP(:)
- CALL OI_HOR_EXTRAPOL_SURF(KI,IG%XLAT,IG%XLON,ZSNA_EP0,IG%XLAT,IG%XLON,ZSNA_EP,GINTERP_SN)
- !
- DEALLOCATE(ZWS_EP0,ZWP_EP0,ZTS_EP0,ZTP_EP0,ZTL_EP0,ZSWE_EP0,ZSNR_EP0,ZSNA_EP0)
- !
- ! PRINT values produced by OI_HO_EXTRAPOL_SURF for TS
- IF ( NPRINTLEV > 2 ) THEN
- DO JI=1,KI
- IF (GINTERP_NATURE(JI)) THEN
- PRINT *,'Surface temperature set to ',ZTS_EP(JI),'from nearest neighbour at I=',U%NR_NATURE(JI)
- ENDIF
- ENDDO
- ENDIF
- !
- DEALLOCATE(GINTERP_NATURE,GINTERP_SN)
- !
- ! Set extrpolated fields to global
- I%XWG (:,1,JP) = ZWS_EP(:)
- I%XWG (:,2,JP) = ZWP_EP(:)
- I%XTG (:,1,JP) = ZTS_EP(:)
- I%XTG (:,2,JP) = ZTP_EP(:)
- I%XWGI(:,2,JP) = ZTL_EP(:)
- I%TSNOW%WSNOW(:,JL,JP) = ZSWE_EP(:)
- I%TSNOW%RHO (:,JL,JP) = ZSNR_EP(:)
- I%TSNOW%ALB (:, JP) = ZSNA_EP(:)
- !
- DEALLOCATE(ZWS_EP,ZWP_EP,ZTS_EP,ZTP_EP,ZTL_EP,ZSWE_EP,ZSNR_EP,ZSNA_EP)
- !
-ENDIF
-
-! Snow analysis/update security
-IF (LAESNM) THEN
-
- ! removes very small values due to computation precision
- WHERE( I%TSNOW%WSNOW(:,JL,JP) < 1.0E-10 ) I%TSNOW%WSNOW(:,JL,JP) = 0.0
-
- ! No SNOW
- WHERE ( I%TSNOW%WSNOW(:,JL,JP) == 0.0 )
- I%TSNOW%RHO(:,JL,JP) = XUNDEF
- I%TSNOW%ALB(:,JP) = XUNDEF
- END WHERE
- !
-ENDIF
-!
-!to be improved later - needed for surfex course
- CALL AVERAGE_DIAG_MISC_ISBA_n(DGMI, I)
- !
-IF (LHOOK) CALL DR_HOOK('ASSIM_ISBA_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE ASSIM_ISBA_n
diff --git a/src/SURFEX/assim_nature_isba_ekf.F90 b/src/SURFEX/assim_nature_isba_ekf.F90
deleted file mode 100644
index 1cec01aa17455c8265b551b05c882d9daa12d55e..0000000000000000000000000000000000000000
--- a/src/SURFEX/assim_nature_isba_ekf.F90
+++ /dev/null
@@ -1,697 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE ASSIM_NATURE_ISBA_EKF (I, &
- HPROGRAM, KI, PT2M, PHU2M, HTEST)
-
-! -----------------------------------------------------------------------------
-!
-! Land Data Assimilation System based on an Extended Kalman Filter
-!
-! Revised version : JFM (15 September 2008)
-!
-! The control vector can be any element of (TG1,TG2,WG1,WG2) - Choice in namelist
-!
-! The observations can be any element of (T2M,HU2M,WG1) - Choice in namelist
-!
-! Possibility to evolve the B matrix in the cycling - otherwise SEKF
-!
-! First version including patches (15 October 2008)
-! Trygve Aspelien, Separating IO 06/2013
-! Alina Barbu: bug correction of B matrix, otherwise understimation of the gain matrix (11/2013)
-! Alina Barbu: equivalent analysis of B matrix to ensure its symetric and positiv definiteness properties (11/2013)
-
-! -----------------------------------------------------------------------------
-!
-!
-USE MODD_ISBA_n, ONLY : ISBA_t
-!
-USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
-!
-USE MODD_ASSIM, ONLY : LBEV, LBFIXED, NOBSTYPE, XERROBS, XQCOBS, NNCO, NVAR, NNCV, &
- XSCALE_Q, NPRINTLEV, CVAR, XSIGMA, CBIO, XI, &
- XF_PATCH, XF, COBS, XSCALE_QLAI,CFILE_FORMAT_OBS, &
- XALPH,NECHGU, NBOUTPUT, XTPRT, XLAI_PASS, XBIO_PASS,&
- NOBS, XYO
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-!
-#ifdef SFX_ARO
-USE YOMMP0, ONLY : MYPROC
-#endif
-!
-USE YOMHOOK, ONLY : LHOOK,DR_HOOK
-USE PARKIND1, ONLY : JPRB
-!
-USE MODI_ABOR1_SFX
-USE MODI_ADD_FORECAST_TO_DATE_SURF
-!
-USE MODE_EKF
-!
-! -----------------------------------------------------------
-!
-IMPLICIT NONE
-!
-!
-TYPE(ISBA_t), INTENT(INOUT) :: I
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-INTEGER, INTENT(IN) :: KI
-REAL, DIMENSION(:), INTENT(IN) :: PT2M
-REAL, DIMENSION(:), INTENT(IN) :: PHU2M
- CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
-!
-! Declarations of local variables
-!
- CHARACTER(LEN=30) :: YBGFILE
- CHARACTER(LEN=19) :: YLFNAME
- CHARACTER(LEN=9) :: YFNAME
- CHARACTER(LEN=7) :: YMYPROC
- CHARACTER(LEN=1) :: YCHAR
-!
-! Local Matrix for Analysis calculation
-!
-! Allocation
-! Perturbed simulations
-!
-! Initial values (to be analysed)
-! Observations
-!
-! Temporary vectors used by the EKF approach
-REAL,DIMENSION(KI) :: ZCOFSWI ! dynamic range (Wfc - Wwilt)
-!REAL,DIMENSION(KI) :: ZSMSAT ! saturation
-!REAL,DIMENSION(KI) :: ZWILT
-!
-REAL,DIMENSION(KI,I%NPATCH,NVAR) :: ZCOEF
-REAL,DIMENSION(KI,I%NPATCH,NVAR) :: ZEPS ! The perturbation amplitude
-!
-REAL,DIMENSION(NVAR+1,NOBSTYPE) :: ZYF ! Vector of model observations (averaged)
-!
-REAL,DIMENSION(KI*I%NPATCH*NVAR*I%NPATCH*NVAR) :: ZBLONG
-REAL,DIMENSION(KI,I%NPATCH*NVAR,I%NPATCH*NVAR) :: ZB ! background error covariance matrix
-!
-REAL,DIMENSION(I%NPATCH*NVAR,I%NPATCH*NVAR) :: ZLTM ! linear tangent matrix for the f'ward model
-REAL,DIMENSION(I%NPATCH*NVAR,I%NPATCH*NVAR) :: ZQ ! model error matrix
-!
-REAL,DIMENSION(NOBSTYPE*NBOUTPUT,I%NPATCH*NVAR) :: ZHO, ZHOWR ! Jacobian of observation operator
-REAL,DIMENSION(I%NPATCH*NVAR,NOBSTYPE*NBOUTPUT) :: ZHOT ! Transpose of HO
-REAL,DIMENSION(I%NPATCH*NVAR,NOBSTYPE*NBOUTPUT) :: ZGAIN ! Kalman gain (used explicitly for Ba)
-!
-REAL,DIMENSION(NOBSTYPE*NBOUTPUT,NOBSTYPE*NBOUTPUT) :: ZR ! covariance matrix of observation errors
-REAL,DIMENSION(NOBSTYPE*NBOUTPUT,NOBSTYPE*NBOUTPUT) :: ZK1
-REAL,DIMENSION(NOBSTYPE*NBOUTPUT) :: ZX,ZB2,ZP
-!
-REAL,DIMENSION(I%NPATCH*NVAR,I%NPATCH*NVAR) :: ZKRK
-REAL,DIMENSION(I%NPATCH*NVAR,I%NPATCH*NVAR) :: ZIDKH
-REAL,DIMENSION(I%NPATCH*NVAR,I%NPATCH*NVAR) :: ZIDENT ! identitiy matrix, used for Ba
-!
-REAL,DIMENSION(I%NPATCH) :: ZVLAIMIN
-!
-REAL :: ZTIME ! current time since start of the run (s)
-
-INTEGER :: IOBSCOUNT
-INTEGER :: IYEAR ! current year (UTC)
-INTEGER :: IMONTH ! current month (UTC)
-INTEGER :: IDAY ! current day (UTC)
-INTEGER :: IHOUR
-INTEGER :: IRESP ! return code
-INTEGER :: ISTEP !
-INTEGER :: IMYPROC
-INTEGER :: IOBS
-INTEGER :: ISTAT, ICPT, IUNIT
-!
-INTEGER :: JI,JJ,JK,JJJ,JL,K1,L1
-!
-LOGICAL :: GBEXISTS
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!
-IF (LHOOK) CALL DR_HOOK('ASSIM_NATURE_ISBA_EKF',0,ZHOOK_HANDLE)
-
-#ifdef USE_SODA
-
-!
-!############################# BEGINNING ###############################
-!
-IF (HTEST/='OK') THEN
- CALL ABOR1_SFX('ASSIM_NATURE_ISBA_EKF: FATAL ERROR DURING ARGUMENT TRANSFER')
-END IF
-!
-IF ( NPRINTLEV>0 .AND. NRANK==NPIO ) THEN
- WRITE(*,*)
- WRITE(*,*) ' --------------------------'
- WRITE(*,*) ' | ENTERING VARASSIM |'
- WRITE(*,*) ' --------------------------'
- WRITE(*,*)
-ENDIF
-!
-#ifdef SFX_ARO
-IF ( MYPROC > 0 ) THEN
- IMYPROC = MYPROC
-ELSE
- IMYPROC = 1
-ENDIF
-#else
-IMYPROC = NRANK+1
-#endif
-!
-WRITE(YMYPROC(1:7),'(I7.7)') IMYPROC
-!
-IF ( NPRINTLEV > 0 .AND. NRANK==NPIO ) WRITE(*,*) 'number of patches =',I%NPATCH
-!
-!############################# INITIALISATIONS ###############################
-!
-! Read CLAY fraction to compute the SWI range (Wfc - Wwilt)
-! (XSIGMA is defined in terms of SWI), need to convert to equivalent v/v
-! using same clay fraction in both layers
-! Read SAND fraction to compute the saturation for conversion of ERS SWI
-!
- CALL COFSWI(I%XCLAY(:,1),ZCOFSWI)
- !
-!DO JI=1,KI
- !ZSMSAT (I) = 0.001 * (-1.08*100.*XSAND(I,1) + 494.305)
- !ZWILT (I) = 0.001 * 37.1342 * ((100.*XCLAY(I,1))**0.5)
-!ENDDO
-!
-! Set control variables
-ZIDENT(:,:) = 0. ! identity matrix
-DO JL = 1,NVAR
- !
- DO JJ = 1,I%NPATCH
- ZIDENT(JJ+I%NPATCH*(JL-1),JJ+I%NPATCH*(JL-1)) = 1.0
- ENDDO
- !
- WHERE ( XI(:,:,JL)/=XUNDEF )
- ZEPS(:,:,JL) = XTPRT(JL) * XI(:,:,JL)
- ELSEWHERE
- ZEPS(:,:,JL) = 1.
- ENDWHERE
- !
- IF ( TRIM(CVAR(JL))=='WG2' .OR. TRIM(CVAR(JL))=='WG1' ) THEN
- !
- DO JI = 1,KI
- ZCOEF(JI,:,JL) = ZCOFSWI(JI)*ZCOFSWI(JI)
- ENDDO
- !
- ELSEIF ( TRIM(CVAR(JL))=='LAI' .AND. LBFIXED ) THEN
- !
- DO JI = 1,KI
- DO JJ = 1,I%NPATCH
- IF ( XLAI_PASS(JI,JJ)/=XUNDEF .AND. XLAI_PASS(JI,JJ)>=2. ) THEN
- ZCOEF(JI,JJ,JL) = XLAI_PASS(JI,JJ)*XLAI_PASS(JI,JJ)
- ELSE
- ZCOEF(JI,JJ,JL) = 0.4*0.4/(XSIGMA(JL)*XSIGMA(JL))
- ENDIF
- ENDDO
- ENDDO
- !
- ELSE
- !
- ZCOEF(:,:,JL) = 1.
- !
- ENDIF
- !
-ENDDO
-!
-!############################# B CALCULATION ###############################
-!
-! ----------------------
-! VARASSIM OPTION : LBEV
-! ----------------------
-! Calculate the LTM, and evolve B.
-!
-! Set the B input file depending of an existing B was found or not
-YBGFILE = "BGROUNDin."//TRIM(YMYPROC)
-INQUIRE (FILE=TRIM(YBGFILE),EXIST=GBEXISTS)
-!
-IF ( LBEV .AND. GBEXISTS ) THEN
- !
- ZB(:,:,:) = 0.
- CALL B_BIG_LOOP(I, &
- "READ",YBGFILE,ZB)
- IF ( NPRINTLEV > 0 ) WRITE(*,*) 'read previous B matrix ==>',ZB(1,1,1),NVAR
- !
-ELSEIF ( LBEV .OR. LBFIXED ) THEN
- !
- ! Initialization of B
- ZB(:,:,:) = 0.
- DO JI = 1,KI
- DO JL = 1,NVAR
- DO JJ = 1,I%NPATCH
- !
- L1 = JJ + I%NPATCH *(JL-1)
- ZB(JI,L1,L1) = XSIGMA(JL)*XSIGMA(JL) * ZCOEF(JI,JJ,JL)
- !
- ENDDO
- ENDDO
- !
- ENDDO
- !
- IF ( LBEV ) THEN
- !
- ZBLONG(:) = 0.
- ICPT = 0
- !
- DO JI = 1,KI
- DO JJ = 1,I%NPATCH
- DO JJJ = 1,I%NPATCH
- DO JL = 1,NVAR
- DO JK = 1,NVAR
- !
- L1 = JJ + I%NPATCH * (JL-1)
- !
- ICPT = ICPT + 1
- ZBLONG(ICPT) = ZB(JI,L1,L1)
- !
- ENDDO
- ENDDO
- ENDDO
- ENDDO
- ENDDO
- !
- ZB(:,:,:) = 0.
- CALL B_BIG_LOOP(I, &
- "BUIL","",ZB,ZBLONG)
- IF ( NPRINTLEV > 0 ) WRITE(*,*) 'Initialized B'
- !
- ENDIF
- !
-ELSE
- !
- CALL ABOR1_SFX("LBEV or LBFIXED should be .TRUE.!")
- !
-ENDIF
-!
-IF ( LBEV ) THEN
- !
-!//////////////////////TO WRITE LTM/////////////////////////////////////
- IF (NPRINTLEV>0) THEN
- IUNIT = 120
- DO JL=1,NVAR
- DO JK=1,NVAR
- IUNIT = IUNIT + 1
- WRITE(YCHAR,'(I1)') JK
- YLFNAME='LTM_del'//TRIM(CVAR(JK))//'_del'//TRIM(CVAR(JL))//"."//TRIM(YMYPROC)
- OPEN(UNIT=IUNIT,FILE=YLFNAME,FORM='FORMATTED',STATUS='UNKNOWN',POSITION='APPEND')
- ENDDO
- ENDDO
- ENDIF
-!/////////////////////TO WRITE LTM////////////////////////////////////////
- DO JI = 1,KI
- !
- ! calculate LTM
- ZLTM(:,:) = 0.0
- IUNIT = 120
- DO JL = 1,NVAR ! control variable (x at previous time step)
- DO JK = 1,NVAR
- IUNIT = IUNIT + 1
- DO JJ = 1,I%NPATCH
- !
- L1 = JJ + I%NPATCH*(JL-1)
- K1 = JJ + I%NPATCH*(JK-1)
- !
- IF ( I%XPATCH(JI,JJ)>0.0 .AND. XF(JI,JJ,JL+1,JK).NE.XUNDEF .AND. XF(JI,JJ,1,JK).NE.XUNDEF ) THEN
- !
- ! Jacobian of fwd model
- ZLTM(L1,K1) = ( XF(JI,JJ,JL+1,JK) - XF(JI,JJ,1,JK) ) / ZEPS(JI,JJ,JL)
- ! impose upper/lower limits
- ZLTM(L1,K1) = MAX(-0.1, ZLTM(L1,K1))
- ZLTM(L1,K1) = MIN( 1.0, ZLTM(L1,K1))
- !
- ENDIF
- !
- IF (NPRINTLEV>0) WRITE (IUNIT,*) ZLTM(L1,K1)
- !
- ENDDO
- ENDDO
- ENDDO
- !
-!//////////////////////TO WRITE LTM/////////////////////////////////////
- IF (NPRINTLEV>0) THEN
- IUNIT = 120
- DO JL=1,NVAR
- DO JK=1,NVAR
- IUNIT = IUNIT + 1
- CLOSE(IUNIT)
- ENDDO
- ENDDO
- !//////////////////////TO WRITE LTM/////////////////////////////////////
- WRITE(*,*) 'LTM d(wg2)/d(wg2)', ZLTM(1,1)
- ENDIF
- !
- ! evolve B
- ZB(JI,:,:) = MATMUL(ZLTM(:,:),MATMUL(ZB(JI,:,:),TRANSPOSE(ZLTM(:,:))))
- !
- !
- ! Adding model error to background error matrix
- ZQ(:,:) = 0.0
- DO JL=1,NVAR
- DO JJ=1,I%NPATCH
- !
- L1 = JJ+I%NPATCH*(JL-1)
- !
- ZQ(L1,L1) = XSIGMA(JL)*XSIGMA(JL)
- !
- IF (TRIM(CVAR(JL)) == 'LAI') THEN
- ZQ(L1,L1) = XSCALE_QLAI*XSCALE_QLAI * ZQ(L1,L1)
- ELSE
- ZQ(L1,L1) = XSCALE_Q*XSCALE_Q * ZQ(L1,L1) * ZCOEF(JI,JJ,JL)
- ENDIF
- !
- ENDDO
- ENDDO
- !
- ! B is the forecast matrix - need to add Q
- IF ( NPRINTLEV > 0 ) THEN
- WRITE(*,*) 'B before wg2 wg2 ==> ',ZB(JI,1,1)/ZCOFSWI(JI),ZB(JI,1,1)
- WRITE(*,*) 'Q value wg2 wg2 ==> ',ZQ(1,1)/ZCOFSWI(JI),ZQ(1,1)
- ENDIF
- !
- ZB(JI,:,:) = ZB(JI,:,:) + ZQ(:,:)
- !
- IF ( NPRINTLEV > 0 ) WRITE(*,*) 'B after wg2 wg2 ==>',ZB(JI,1,1)/ZCOFSWI(1),ZB(JI,1,1)
- !
- ENDDO
- !
- ! write out the LTM for the forward model
- ! Write out current B
- IF (NPRINTLEV>0) THEN
- YBGFILE="BGROUNDout_LBEV."//TRIM(YMYPROC)
- CALL B_BIG_LOOP(I, &
- "WRIT",YBGFILE,ZB)
- WRITE(*,*) 'store B matrix after TL evolution ==>',ZB(1,1,1)
- WRITE(*,*) 'writing out B'
- ENDIF
- !
-ENDIF
-!
-! ====================================================================
-!
-! Analysis
-!
-! ====================================================================
-!
-! Time reinitialization
-IYEAR = I%TTIME%TDATE%YEAR
-IMONTH = I%TTIME%TDATE%MONTH
-IDAY = I%TTIME%TDATE%DAY
-!
-IHOUR = 0
-ZTIME = FLOAT(NECHGU) * 3600.
-!
-!############################# READS OBSERVATIONS ###############################
-!
-! Map the variables in case we read them from CANARI inline/offline FA files
-! At the moment only T2M and HU2M can be used. If other variables should be used
-! they must be added to the interface or be read from file.
-IF ( TRIM(CFILE_FORMAT_OBS) == "FA" ) THEN
- !
- DO IOBS = 1,NOBSTYPE
- SELECT CASE (TRIM(COBS(IOBS)))
- CASE("T2M")
- XYO(:,IOBS) = PT2M(:)
- CASE("HU2M")
- XYO(:,IOBS) = PHU2M(:)
- CASE("WG1","LAI")
- CALL ABOR1_SFX("Mapping of "//COBS(IOBS)//" is not defined in ASSIM_NATURE_ISBA_EKF!")
- END SELECT
- ENDDO
- !
-ENDIF
-!
-!
-!//////////////////////TO WRITE OBS/////////////////////////////////////
-IF ( NPRINTLEV > 0 ) OPEN (UNIT=111,FILE='OBSout.'//TRIM(YMYPROC),STATUS='unknown',IOSTAT=ISTAT)
-DO JI = 1,KI
- IF ( MINVAL(I%XWGI(JI,1,:))>0. ) THEN
- XYO (JI,:) = XUNDEF
- IF ( NPRINTLEV > 0 ) WRITE(*,*) 'OBSERVATION FOR POINT ',JI,' REMOVED'
- ENDIF
- IF ( NPRINTLEV > 0 ) WRITE (111,*) XYO(JI,:)
-ENDDO
-IF ( NPRINTLEV > 0 ) CLOSE(111)
-!//////////////////////TO WRITE OBS/////////////////////////////////////
-!
-!############################# ANALYSIS ###############################
-!
-IF ( NPRINTLEV > 0 ) THEN
- IF (NRANK==NPIO) THEN
- WRITE(*,*) 'calculating jacobians',NOBS
- WRITE(*,*) ' and then PERFORMING ANALYSIS'
- ENDIF
- !
- !//////////////////////TO WRITE ANALYSIS ARRAYS/////////////////////////////////////
- ! WRITE OUT OBS AND YERROR FOR DIAGNOSTIC PURPOSES
- OPEN (UNIT=111,FILE='OBSERRORout.'//TRIM(YMYPROC),STATUS='unknown',IOSTAT=ISTAT)
- ! *** Write innovations in ASCII file ***
- OPEN (unit=112,file='INNOV.'//TRIM(YMYPROC),status='unknown',IOSTAT=ISTAT)
- ! Write analysis results and increments in ASCII file
- OPEN (unit=113,file='ANAL_INCR.'//TRIM(YMYPROC),status='unknown',IOSTAT=ISTAT)
- ! **** Write out the observation operator + Gain matrix ****
- IUNIT = 150
- DO JL = 1,NVAR
- DO JK=1,NOBSTYPE
- IUNIT = IUNIT + 1
- WRITE(YCHAR,'(I1)') JK
- YFNAME='HO_'//TRIM(CVAR(JL))//'_v'//YCHAR
- OPEN(UNIT=IUNIT,FILE=YFNAME,FORM='FORMATTED',STATUS='UNKNOWN',IOSTAT=ISTAT)
- ENDDO
- ENDDO
-ENDIF
-!//////////////////////TO WRITE ANALYSIS ARRAYS/////////////////////////////////////
-!
-IF (I%NPATCH==12) THEN
- ZVLAIMIN = (/0.3,0.3,0.3,0.3,1.0,1.0,0.3,0.3,0.3,0.3,0.3,0.3/)
-ELSE
- ZVLAIMIN = (/0.3/)
-ENDIF
-!
-ALLOCATE(I%XINCR(KI,I%NPATCH*NVAR))
-I%XINCR(:,:) = 0.
-!
-IOBSCOUNT = 0
-DO JI=1,KI
- !
-!---------------- MEAN SIMULATED OBS AVERAGED OVER TILES-----------------------
- ZYF(:,:) = 0.
- DO JJ=1,I%NPATCH
- IF (I%XPATCH(JI,JJ) > 0.0) THEN
- WHERE ( XF_PATCH(JI,JJ,:,:)/=XUNDEF )
- ZYF(:,:) = ZYF(:,:) + I%XPATCH(JI,JJ)*XF_PATCH(JI,JJ,:,:)
- ENDWHERE
- ENDIF
- ENDDO
- IF ( NPRINTLEV > 0 ) WRITE(*,*) 'read in sim obs yf', ZYF(:,1)
- !
- !
- ZR (:,:) = 0. ! Observation error matrix
- !
- ZHO (:,:) = XUNDEF ! Linearized observation matrix
- ZHOWR (:,:) = XUNDEF
- ZB2 (:) = XUNDEF ! Innovation vector
-
- DO ISTEP=1,NBOUTPUT
- !
- DO JK = 1,NOBSTYPE
- !
- K1 = (ISTEP-1)*NOBSTYPE + JK
- !
-!--------------------- SET OBSERVATION ERROR ------------------
- ZR(K1,K1) = XERROBS(JK)*XERROBS(JK)
- IF ( COBS(JK) .EQ. "LAI" ) THEN
- ZR(K1,K1) = ZR(K1,K1) * XYO(JI,K1)*XYO(JI,K1)
- ELSEIF (COBS(JK) .EQ. "WG1") THEN
- ! convert R for wg1 from SWI to abs value
- ZR(K1,K1) = ZR(K1,K1) * ZCOFSWI(JI)*ZCOFSWI(JI)
- ENDIF
- !
- ! Apply quality control
- IF ( ( ABS( XYO(JI,K1)-ZYF(1,JK) ) > XQCOBS(JK) ) .OR. (ZR(K1,K1) .LT. 0 ) ) THEN
- XYO(JI,K1) = 999.0
- ENDIF
- !
-!--------------------- CALCULATE JACOBIANS ------------------
- DO JL=1,NVAR
- DO JJ=1,I%NPATCH
- !
- L1 = JJ + I%NPATCH*(JL-1)
- !
- IF ( I%XPATCH(JI,JJ)>0.0 .AND. XF_PATCH(JI,JJ,JL+1,JK).NE.XUNDEF .AND. XF_PATCH(JI,JJ,1,JK).NE.XUNDEF ) THEN
- ZHOWR(K1,L1) = I%XPATCH(JI,JJ)*(XF_PATCH(JI,JJ,JL+1,JK) - XF_PATCH(JI,JJ,1,JK))/ZEPS(JI,JJ,JL)
- ENDIF
- !
- IF( (XYO(JI,K1).NE.XUNDEF) .AND. (XYO(JI,K1).NE.999.0) ) THEN !if obs available
- ! Jacobian of obs operator
- ZHO(K1,L1) = I%XPATCH(JI,JJ)*(XF_PATCH(JI,JJ,JL+1,JK) - XF_PATCH(JI,JJ,1,JK))/ZEPS(JI,JJ,JL)
- ! impose limits
- ZHO(K1,L1) = MAX(-0.1, ZHO(K1,L1))
- ZHO(K1,L1) = MIN( 1.0, ZHO(K1,L1))
- ! innovation vector
- ZB2(K1) = XYO(JI,K1) - ZYF(1,JK)
- IOBSCOUNT = IOBSCOUNT + 1
- ELSE !if no obs available
- ! set obs operator and innovation to zero if no obs available
- ZHO(K1,L1) = 0.0
- ZB2(K1) = 0.0
- ENDIF
- !
- ENDDO
- ENDDO
- !
- ENDDO
- !
- ENDDO
- !
- IF ( NPRINTLEV > 0 ) THEN
- WRITE(111,*) ZR(:,:)
- WRITE(112,*) ZB2(:)
- ENDIF
-
-!---------------****** SOIL ANALYSIS *******--------------------------
- ZHOT(:,:) = 0.
- ZK1(:,:) = 0.
- ZP(:) = 0.
- ZX(:) = 0.
- !
- ZHOT(:,:) = TRANSPOSE(ZHO(:,:))
- ZK1 (:,:) = MATMUL(ZHO(:,:),MATMUL(ZB(JI,:,:),ZHOT(:,:))) + ZR(:,:)
- CALL CHOLDC(NOBSTYPE,ZK1(:,:),ZP(:)) ! Cholesky decomposition (1)
- CALL CHOLSL(NOBSTYPE,ZK1(:,:),ZP(:),ZB2(:),ZX(:)) ! Cholesky decomposition (2)
- I%XINCR(JI,:) = MATMUL(ZB(JI,:,:),MATMUL(ZHOT(:,:),ZX(:)))
- DO JL=1,NVAR
- DO JJ=1,I%NPATCH
- !
- L1 = JJ+I%NPATCH*(JL-1)
- !
- ! Update the modified values
- IF ( TRIM(CVAR(JL))=="LAI" ) THEN
- I%XINCR(JI,L1) = MAX( I%XINCR(JI,L1), ZVLAIMIN(JJ)-XF(JI,JJ,1,JL) )
- XBIO_PASS(JI,JJ) = XBIO_PASS(JI,JJ) + I%XINCR(JI,L1)*XALPH(JJ)
- ELSEIF ( XF(JI,JJ,1,JL)+I%XINCR(JI,L1)<0. ) THEN
- I%XINCR(JI,L1) = 0.
- ENDIF
- !
- XF(JI,JJ,1,JL) = XF(JI,JJ,1,JL) + I%XINCR(JI,L1)
- !
- ! For no only warn if we have negative values.
- IF ( NPRINTLEV > 0 ) THEN
- IF ( XF(JI,JJ,1,JL) < 0. ) WRITE(*,*) "WARNING X<0. for ",JI,JJ," for variable ",TRIM(CVAR(JL))
- ENDIF
- !
- ENDDO
- ENDDO
- !
- IF ( NPRINTLEV > 0 ) THEN
- DO JJ=1,I%NPATCH
- WRITE(113,*) (XF(JI,JJ,1,JL),JL=1,NVAR), (I%XINCR(JI,JJ+I%NPATCH*(JL-1)),JL=1,NVAR)
- ENDDO
- ENDIF
-
-!--------------------ANALYSIS OF B (FOR USE IN NEXT CYCLE)-------------------
- ! Ba = (I-KH)Bf(I-KH)t+KRKt
- ! K = BfHt{K1}**-1
- ! K1 needs PATCH dim added
-
- ZGAIN(:,:) = 0.
- ZIDKH(:,:) = 0.
- ZKRK(:,:) = 0.
- !
- ! K1 = (R+H.B.HT) (calculate inverse -> output goes to K1)
- CALL INVERSE_MATRIX(NOBS,ZK1(:,:),ZP(:))
- ZGAIN(:,:) = MATMUL(ZB(JI,:,:),MATMUL(ZHOT(:,:),ZK1(:,:)))
- ZIDKH(:,:) = ZIDENT(:,:) - MATMUL(ZGAIN(:,:),ZHO(:,:))
- ZKRK (:,:) = MATMUL(ZGAIN(:,:),MATMUL(ZR(:,:),TRANSPOSE(ZGAIN(:,:))))
- IF (.NOT.LBFIXED) ZB(JI,:,:) = MATMUL(ZIDKH(:,:),MATMUL(ZB(JI,:,:),TRANSPOSE(ZIDKH(:,:)))) + ZKRK(:,:)
-
- IF ( NPRINTLEV > 0 ) THEN
- IUNIT = 150
- DO JL = 1,NVAR
- DO JK = 1,NOBSTYPE
- IUNIT = IUNIT + 1
- DO JJ=1,I%NPATCH
- WRITE(IUNIT,*) ZHOWR(JK,JJ+I%NPATCH*(JL-1)),ZGAIN(JJ+I%NPATCH*(JL-1),JK)
- ENDDO
- ENDDO
- ENDDO
- ENDIF
- !
-ENDDO
-!
-!
-!//////////////////////TO WRITE ANALYSIS ARRAYS/////////////////////////////////////
-IF ( NPRINTLEV > 0 ) THEN
- CLOSE(111)
- CLOSE(112)
- CLOSE(113)
- IUNIT = 150
- DO JL = 1,NVAR
- DO JK = 1,NOBSTYPE
- IUNIT = IUNIT + 1
- CLOSE(IUNIT)
- ENDDO
- ENDDO
-ENDIF
-!//////////////////////TO WRITE ANALYSIS ARRAYS/////////////////////////////////////
-!
-IF (LBEV .OR. NPRINTLEV>0) THEN
- ! Write out analysed B (for use in next cycle)
- YBGFILE = "BGROUNDout_ASSIM."//TRIM(YMYPROC)
- CALL B_BIG_LOOP(I, &
- "WRIT",YBGFILE,ZB)
-ENDIF
-!
-IF ( NPRINTLEV > 0 ) THEN
- IOBSCOUNT = IOBSCOUNT / I%NPATCH / NVAR
- IF (NRANK==NPIO) THEN
- WRITE(*,*)
- WRITE(*,*) ' ---------------------------------------'
- WRITE(*,*) ' | EXITING VARASSIM AFTER ANALYSIS |'
- WRITE(*,*) ' ---------------------------------------'
- WRITE(*,*)
- ENDIF
- WRITE(*,*) 'Number of assimilated observations =',IOBSCOUNT
- WRITE(*,*)
-ENDIF
-!
-!############################# GET VARIABLES FOR OUTPUT WRITING ###############################
-DO JL=1,NVAR
- !
- ! Update the modified values
- SELECT CASE (TRIM(CVAR(JL)))
- CASE("TG1")
- I%XTG(:,1,:) = XF(:,:,1,JL)
- CASE("TG2")
- I%XTG(:,2,:) = XF(:,:,1,JL)
- CASE("WG1")
- I%XWG(:,1,:) = XF(:,:,1,JL)
- CASE("WG2")
- I%XWG(:,2,:) = XF(:,:,1,JL)
- CASE("LAI")
- I%XLAI(:,:) = XF(:,:,1,JL)
- SELECT CASE (TRIM(CBIO))
- CASE("BIOMA1","BIOMASS1")
- I%XBIOMASS(:,1,:) = XBIO_PASS(:,:)
- CASE("BIOMA2","BIOMASS2")
- I%XBIOMASS(:,2,:) = XBIO_PASS(:,:)
- CASE("RESPI1","RESP_BIOM1")
- I%XRESP_BIOMASS(:,1,:) = XBIO_PASS(:,:)
- CASE("RESPI2","RESP_BIOM2")
- I%XRESP_BIOMASS(:,2,:) = XBIO_PASS(:,:)
- CASE("LAI")
- I%XLAI(:,:) = XBIO_PASS(:,:)
- CASE DEFAULT
- CALL ABOR1_SFX("Mapping of "//CBIO//" is not defined in EKF!")
- END SELECT
- CASE DEFAULT
- CALL ABOR1_SFX("Mapping of "//TRIM(CVAR(JL))//" is not defined in EKF!")
- END SELECT
-ENDDO
-!
-#endif
-!
-IF (LHOOK) CALL DR_HOOK('ASSIM_NATURE_ISBA_EKF',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE ASSIM_NATURE_ISBA_EKF
diff --git a/src/SURFEX/assim_nature_isba_enkf.F90 b/src/SURFEX/assim_nature_isba_enkf.F90
deleted file mode 100644
index 320ad084a4f9e9cbea80dc5b5d12bbe64bfdd982..0000000000000000000000000000000000000000
--- a/src/SURFEX/assim_nature_isba_enkf.F90
+++ /dev/null
@@ -1,467 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE ASSIM_NATURE_ISBA_ENKF(I, HPROGRAM, KI, PT2M, PHU2M, HTEST)
-
-! -----------------------------------------------------------------------------
-!
-! Land Data Assimilation System based on an Extended Kalman Filter
-!
-! Revised version : JFM (15 September 2008)
-!
-! The control vector can be any element of (TG1,TG2,WG1,WG2) - Choice in namelist
-!
-! The observations can be any element of (T2M,HU2M,WG1) - Choice in namelist
-!
-! Possibility to evolve the B matrix in the cycling - otherwise SEKF
-!
-! First version including patches (15 October 2008)
-! Trygve Aspelien, Separating IO 06/2013
-! Alina Barbu: bug correction of B matrix, otherwise understimation of the gain matrix (11/2013)
-! Alina Barbu: equivalent analysis of B matrix to ensure its symetric and positiv definiteness properties (11/2013)
-
-! -----------------------------------------------------------------------------
-!
-USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
-USE MODD_ASSIM, ONLY : NOBSTYPE, XERROBS, NVAR, NPRINTLEV, CVAR, &
- XF_PATCH, XF,COBS,CFILE_FORMAT_OBS,NENS, &
- NECHGU, NBOUTPUT, NOBS, XYO, LENKF, LDENKF, &
- LPB_CORRELATIONS, LPERTURBATION_RUN, &
- LBIAS_CORRECTION, XINFL
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE MODD_ISBA_n, ONLY : ISBA_t
-!
-#ifdef SFX_ARO
-USE YOMMP0, ONLY : MYPROC
-#endif
-!
-USE YOMHOOK, ONLY : LHOOK,DR_HOOK
-USE PARKIND1, ONLY : JPRB
-!
-USE MODI_ABOR1_SFX
-USE MODI_ADD_FORECAST_TO_DATE_SURF
-!
-USE MODI_OUTER_PRODUCT
-USE MODE_EKF
-USE MODE_RANDOM
-!
-! -----------------------------------------------------------
-!
-IMPLICIT NONE
-!
-TYPE(ISBA_t), INTENT(INOUT) :: I
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-INTEGER, INTENT(IN) :: KI
-REAL, DIMENSION(:), INTENT(IN) :: PT2M
-REAL, DIMENSION(:), INTENT(IN) :: PHU2M
- CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
-!
-! Declarations of local variables
-!
- CHARACTER(LEN=30) :: YBGFILE
- CHARACTER(LEN=17) :: YLFNAME
- CHARACTER(LEN=9) :: YFNAME
- CHARACTER(LEN=7) :: YMYPROC
- CHARACTER(LEN=1) :: YCHAR
-!
-! Local Matrix for Analysis calculation
-!
-! Allocation
-! Perturbed simulations
-!
-! Initial values (to be analysed)
-! Observations
-!
-! Temporary vectors used by the EKF approach
-REAL,DIMENSION(KI) :: ZCOFSWI ! dynamic range (Wfc - Wwilt)
-!
-REAL,DIMENSION(NENS+1,NOBSTYPE*NBOUTPUT) :: ZYF ! Vector of model observations (averaged)
-!
-REAL,DIMENSION(NOBSTYPE*NBOUTPUT,NENS) :: ZINNOV
-!
-REAL,DIMENSION(NVAR,NOBSTYPE*NBOUTPUT) :: ZBHT
-REAL,DIMENSION(NOBSTYPE*NBOUTPUT,NOBSTYPE*NBOUTPUT) :: ZR ! covariance matrix of observation errors
-REAL,DIMENSION(NOBSTYPE*NBOUTPUT,NOBSTYPE*NBOUTPUT) :: ZK1, ZK2, ZHBHT
-REAL,DIMENSION(NOBSTYPE*NBOUTPUT) :: ZP, ZX
-!
-REAL, DIMENSION(I%NPATCH,NVAR,NENS) :: ZXINCR
-REAL, DIMENSION(I%NPATCH,NVAR,NENS) :: ZA, ZF
-REAL, DIMENSION(I%NPATCH,NOBSTYPE*NBOUTPUT,NENS) :: ZF_PATCH
-REAL, DIMENSION(I%NPATCH,NVAR) :: ZF_MEAN, ZA_MEAN
-REAL, DIMENSION(NVAR) :: ZF_AGG, ZA_AGG
-!
-REAL,DIMENSION(:,:,:),ALLOCATABLE :: ZF_MEAN0, ZF_PATCH_MEAN
-!
-REAL :: ZTIME, ZALPHA ! current time since start of the run (s)
-
-INTEGER :: IOBSCOUNT
-INTEGER :: IYEAR ! current year (UTC)
-INTEGER :: IMONTH ! current month (UTC)
-INTEGER :: IDAY ! current day (UTC)
-INTEGER :: IHOUR
-INTEGER :: IRESP ! return code
-INTEGER :: ISTEP !
-INTEGER :: IMYPROC
-INTEGER :: IOBS, IENS
-INTEGER :: ISTAT, ICPT, IUNIT
-!
-INTEGER :: II,J,K,JJ,L,K1,L1
-!
-LOGICAL :: GBEXISTS
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!
-IF (LHOOK) CALL DR_HOOK('ASSIM_NATURE_ISBA_ENKF',0,ZHOOK_HANDLE)
-
-#ifdef USE_SODA
-
-!
-!############################# BEGINNING ###############################
-!
-IF (HTEST/='OK') THEN
- CALL ABOR1_SFX('ASSIM_NATURE_ISBA_ENKF: FATAL ERROR DURING ARGUMENT TRANSFER')
-END IF
-!
-IF ( NPRINTLEV>0 .AND. NRANK==NPIO) THEN
- WRITE(*,*)
- WRITE(*,*) ' --------------------------'
- WRITE(*,*) ' | ENTERING VARASSIM |'
- WRITE(*,*) ' --------------------------'
- WRITE(*,*)
-ENDIF
-!
-#ifdef SFX_ARO
-IF ( MYPROC > 0 ) THEN
- IMYPROC = MYPROC
-ELSE
- IMYPROC = 1
-ENDIF
-#else
-IMYPROC = NRANK+1
-#endif
-!
-WRITE(YMYPROC(1:7),'(I7.7)') IMYPROC
-!
-IF ( NPRINTLEV > 0 .AND. NRANK==NPIO ) WRITE(*,*) 'number of patches =',I%NPATCH
-!
-!############################# INITIALISATIONS ###############################
-!
-! Read CLAY fraction to compute the SWI range (Wfc - Wwilt)
-! (XSIGMA is defined in terms of SWI), need to convert to equivalent v/v
-! using same clay fraction in both layers
-! Read SAND fraction to compute the saturation for conversion of ERS SWI
-!
- CALL COFSWI(I%XCLAY(:,1),ZCOFSWI)
-!DO I=1,KI
- !ZSMSAT (I) = 0.001 * (-1.08*100.*XSAND(I,1) + 494.305)
- !ZWILT (I) = 0.001 * 37.1342 * ((100.*XCLAY(I,1))**0.5)
-!ENDDO
-!
-! ====================================================================
-!
-! Analysis
-!
-! ====================================================================
-!
-! Time reinitialization
-IYEAR = I%TTIME%TDATE%YEAR
-IMONTH = I%TTIME%TDATE%MONTH
-IDAY = I%TTIME%TDATE%DAY
-!
-IHOUR = 0
-ZTIME = FLOAT(NECHGU) * 3600.
-!
-!############################# READS OBSERVATIONS ###############################
-!
-! Map the variables in case we read them from CANARI inline/offline FA files
-! At the moment only T2M and HU2M can be used. If other variables should be used
-! they must be added to the interface or be read from file.
-IF ( TRIM(CFILE_FORMAT_OBS) == "FA" ) THEN
- !
- DO IOBS = 1,NOBSTYPE
- SELECT CASE (TRIM(COBS(IOBS)))
- CASE("T2M")
- XYO(:,IOBS) = PT2M(:)
- CASE("HU2M")
- XYO(:,IOBS) = PHU2M(:)
- CASE("WG1","LAI")
- CALL ABOR1_SFX("Mapping of "//COBS(IOBS)//" is not defined in ASSIM_NATURE_ISBA_EKF!")
- END SELECT
- ENDDO
- !
-ENDIF
-!
-!//////////////////////TO WRITE OBS/////////////////////////////////////
-IF ( NPRINTLEV > 0 ) OPEN (UNIT=111,FILE='OBSout.'//YMYPROC,STATUS='unknown',IOSTAT=ISTAT)
-DO II = 1,KI
- IF ( MINVAL(I%XWGI(II,1,:))>0. ) THEN
- XYO (II,:) = XUNDEF
- IF ( NPRINTLEV > 1 ) WRITE(*,*) 'OBSERVATION FOR POINT ',II,' REMOVED'
- ENDIF
- IF ( NPRINTLEV > 0 ) WRITE (111,*) XYO(II,:)
-ENDDO
-IF ( NPRINTLEV > 0 ) CLOSE(111)
-!//////////////////////TO WRITE OBS/////////////////////////////////////
-!
-! Recentering THE FORECAST ENSEMBLE MEMBERS
-IF ( LBIAS_CORRECTION ) THEN
- !
- ALLOCATE(ZF_MEAN0(KI,I%NPATCH,NVAR))
- ALLOCATE(ZF_PATCH_MEAN(KI,I%NPATCH,NOBS))
- !
- DO II = 1,KI
- DO J=1,I%NPATCH
- DO L = 1,NVAR
- ZF_MEAN0(II,J,L) = SUM(XF(II,J,1:NENS,L))/REAL(NENS)
- ENDDO
- DO K = 1,NOBS
- ZF_PATCH_MEAN(II,J,K) = SUM(XF_PATCH(II,J,1:NENS,K))/REAL(NENS)
- ENDDO
- ENDDO
- ENDDO
- !
- DO II = 1,KI
- DO J = 1,I%NPATCH
- DO IENS = 1,NENS
- !
- DO L = 1,NVAR
- IF ( XF(II,J,IENS,L) - ZF_MEAN0(II,J,L) + XF(II,J,NENS+1,L)>0.0 ) THEN
- XF(II,J,IENS,L) = XF(II,J,IENS,L) - ZF_MEAN0(II,J,L) + XF(II,J,NENS+1,L)
- ENDIF
- ENDDO
- !
- DO K = 1,NOBS
- IF ( XF_PATCH(II,J,IENS,K) - ZF_PATCH_MEAN(II,J,K) + XF_PATCH(II,J,NENS+1,K)>0.0 ) THEN
- XF_PATCH(II,J,IENS,K) = XF_PATCH(II,J,IENS,K) - ZF_PATCH_MEAN(II,J,K) + XF_PATCH(II,J,NENS+1,K)
- ENDIF
- ENDDO
- !
- ENDDO
- ENDDO
- ENDDO
- !
- DEALLOCATE(ZF_MEAN0,ZF_PATCH_MEAN)
- !
-ENDIF
-!
-!############################# ANALYSIS ###############################
-!
-IF ( NPRINTLEV > 0 ) THEN
- IF (NRANK==NPIO) THEN
- WRITE(*,*) 'calculating jacobians',NOBS
- WRITE(*,*) ' and then PERFORMING ANALYSIS'
- ENDIF
- !
- !//////////////////////TO WRITE ANALYSIS ARRAYS/////////////////////////////////////
- ! WRITE OUT OBS AND YERROR FOR DIAGNOSTIC PURPOSES
- OPEN (UNIT=111,FILE='OBSERRORout.'//YMYPROC,STATUS='unknown',IOSTAT=ISTAT)
- ! *** Write innovations in ASCII file ***
- OPEN (unit=112,file='INNOV.'//YMYPROC,status='unknown',IOSTAT=ISTAT)
- ! Write analysis results and increments in ASCII file
- OPEN (unit=113,file='ANAL_INCR.'//YMYPROC,status='unknown',IOSTAT=ISTAT)
- ! **** Write out the observation operator + Gain matrix ****
- OPEN (unit=114,file='K1.'//YMYPROC,status='unknown',IOSTAT=ISTAT)
- OPEN (unit=115,file='F_AGG.'//YMYPROC,status='unknown',IOSTAT=ISTAT)
- OPEN (unit=116,file='A_AGG.'//YMYPROC,status='unknown',IOSTAT=ISTAT)
-ENDIF
-!//////////////////////TO WRITE ANALYSIS ARRAYS/////////////////////////////////////
-!
-IOBSCOUNT = 0
-!
- CALL INIT_RANDOM_SEED()
-!
-DO II=1,KI
- !
- !---------------- MEAN SIMULATED OBS AVERAGED OVER TILES-----------------------
- ZYF(:,:) = 0.
- DO J=1,I%NPATCH
- IF (I%XPATCH(II,J) > 0.0) THEN
- WHERE ( XF_PATCH(II,J,:,:)/=XUNDEF )
- ZYF(:,:) = ZYF(:,:) + I%XPATCH(II,J)*XF_PATCH(II,J,:,:)
- ENDWHERE
- ENDIF
- ENDDO
- IF ( NPRINTLEV > 1 ) WRITE(*,*) 'read in sim obs yf', ZYF(:,1)
- !
- !
- ZR (:,:) = 0. ! Observation error matrix
- ZINNOV (:,:) = 0.
- !
- ZXINCR(:,:,:) = 0.0
- ZK1(:,:) = 0.0
- ZK2(:,:) = 0.0
- ZP(:) = 0.0
- ZX(:) = 0.0
- ZBHT(:,:) = 0.0
- ZHBHT(:,:) = 0.0
-
- DO ISTEP=1,NBOUTPUT
- !
- DO K = 1,NOBSTYPE
- !
- K1 = (ISTEP-1)*NOBSTYPE + K
- !
-!--------------------- SET OBSERVATION ERROR ------------------
- ZR(K1,K1) = XERROBS(K)*XERROBS(K)
- IF ( COBS(K) .EQ. "LAI" ) THEN
- ZR(K1,K1) = ZR(K1,K1) * XYO(II,K1)*XYO(II,K1)
- ELSEIF (COBS(K) .EQ. "WG1") THEN
- ! convert R for wg1 from SWI to abs value
- ZR(K1,K1) = ZR(K1,K1) * ZCOFSWI(II)*ZCOFSWI(II)
- ENDIF
- !
- ! Apply quality control
- IF ( ABS(XYO(II,K1)-ZYF(NENS+1,K1)) > 0.5 .OR. ZR(K1,K1) < 0. ) XYO(II,K1) = XUNDEF
- !
- IF( XYO(II,K1).NE.XUNDEF .AND. XYO(II,K1).NE.999.0 ) THEN !if obs available
- !
- DO IENS = 1,NENS
- !
- ZINNOV(K1,IENS) = XYO(II,K1) - ZYF(IENS,K1)
- IF (LENKF) THEN
- ZINNOV(K1,IENS) = ZINNOV(K1,IENS) + RANDOM_NORMAL() * (XERROBS(K)*ZCOFSWI(II))
- ENDIF
- !
- ENDDO
- !
- IOBSCOUNT = IOBSCOUNT + 1
- !
- ENDIF
- !
- ENDDO
- !
- IF ( NPRINTLEV > 0 ) THEN
- WRITE(111,*) ZR(:,:)
- DO K = 1,NOBS
- WRITE(112,*) (SUM(ZINNOV(K,:))/(NENS*1.0)), XYO(II,K)
- ENDDO
- ENDIF
- !
- ENDDO
- !
- IF (NPRINTLEV > 0) WRITE(*,*) 'PERFORMING ANALYSIS'
- !
- !---------------****** SOIL ANALYSIS *******--------------------------
- !
- DO IENS = 1,NENS
- ZF(:,:,IENS) = XF(II,:,IENS,:)
- ZF_PATCH(:,:,IENS) = XF_PATCH(II,:,IENS,:)
- ENDDO
-
- !
- ZF_MEAN(:,:) = SUM(ZF(:,:,:),DIM=3)/REAL(NENS)
- !
- IF (.NOT.LPERTURBATION_RUN) THEN
- !
- DO J = 1,I%NPATCH
- !
- CALL OUTER_PRODUCT(NENS,NVAR,NOBS,ZF(J,:,:),I%XPATCH(II,J)*ZF_PATCH(J,:,:),&
- ZBHT(:,:),ZHBHT(:,:),LPB_CORRELATIONS,CVAR,COBS)
- !
- ZK1(:,:) = ZHBHT(:,:) + ZR(:,:)
- ZK2(:,:) = ZK2(:,:) + ZHBHT(:,:)
- CALL CHOLDC(NOBS,ZK1(:,:),ZP(:))
- !
- DO IENS = 1,NENS ! Cholesky decomposition (1)
- !
- CALL CHOLSL(NOBS,ZK1(:,:),ZP(:),ZINNOV(:,IENS),ZX(:)) ! Cholesky decomposition (2)
- ZXINCR(J,:,IENS) = MATMUL(ZBHT(:,:),ZX(:))
- !
- DO L = 1,NVAR
- ZA(J,L,IENS) = ZF(J,L,IENS)
- IF (CVAR(L)/="WG3" .AND. CVAR(L)/="TG3") THEN
- ZA(J,L,IENS) = ZA(J,L,IENS) + ZXINCR(J,L,IENS)
- ENDIF
- ENDDO
- !
- ENDDO
- !
- ENDDO
- !
- ZA_MEAN(:,:) = SUM(ZA(:,:,:),DIM=3)/REAL(NENS)
- !
- IF (NPRINTLEV>1) WRITE(114,*) (ZK2(:,:) + ZR(:,:))
- !
- DO IENS = 1,NENS
- !
- DO L = 1,NVAR
- !
- DO J = 1,I%NPATCH
- !
- IF ( LDENKF .AND. CVAR(L)/="WG3" .AND. CVAR(L)/="TG3" ) THEN
- !
- DO K = 1,NOBS
- ZALPHA = 1.0 / ( 1.0 + SQRT( ZR(K,K)/(ZK2(K,K) + ZR(K,K)) ) )
- ZA(J,L,IENS) = ZA_MEAN(J,L) + (1.0-ZALPHA) * ( ZF(J,L,IENS)-ZF_MEAN(J,L) ) &
- + ZALPHA * ( ZA(J,L,IENS)-ZA_MEAN(J,L))
- ENDDO
- !
- ENDIF
- !apply inflation factor to the ensemble spread
- ZA(J,L,IENS) = ZA_MEAN(J,L) + XINFL(L) * (ZA(J,L,IENS) - ZA_MEAN(J,L))
- !
- ENDDO
- !
- ENDDO
- !
- ENDDO
- !
- WHERE (ZA(:,:,:)<0.0)
- ZA(:,:,:) = ZF(:,:,:)
- END WHERE
- !
- !
- ELSE
- !
- ZA(:,:,:) = ZF(:,:,:)
- !
- ENDIF
- !
- ZA_MEAN(:,:) = SUM(ZA(:,:,:),DIM=3)/REAL(NENS)
- !
- ZF_AGG(:) = 0.
- ZA_AGG(:) = 0.
- DO L = 1,NVAR
- DO J = 1,I%NPATCH
- IF (ZA_MEAN(J,L)/=XUNDEF .AND. ZF_MEAN(J,L)/=XUNDEF) THEN
- ZF_AGG(L) = ZF_AGG(L) + I%XPATCH(II,J) * ZF_MEAN(J,L)
- ZA_AGG(L) = ZA_AGG(L) + I%XPATCH(II,J) * ZA_MEAN(J,L)
- ENDIF
- ENDDO
- ENDDO
- !
- IF (NPRINTLEV>1) THEN
- WRITE(115,*) (ZF_AGG(L), L=1,NVAR)
- WRITE(116,*) (ZA_AGG(L), L=1,NVAR)
- ENDIF
- !
- !############################# GET VARIABLES FOR OUTPUT WRITING ###############################
- !
- DO IENS = 1,NENS
- XF(II,:,IENS,:) = ZA(:,:,IENS)
- ENDDO
- !
- IF (LBIAS_CORRECTION) XF(II,:,NENS+1,:) = ZA_MEAN(:,:)
- !
-ENDDO
-!
-IF ( NPRINTLEV > 0 ) THEN
- CLOSE(111)
- CLOSE(112)
- CLOSE(113)
- CLOSE(114)
- CLOSE(115)
- CLOSE(116)
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('ASSIM_NATURE_ISBA_ENKF',1,ZHOOK_HANDLE)
-
-#endif
-
-!
-END SUBROUTINE ASSIM_NATURE_ISBA_ENKF
diff --git a/src/SURFEX/assim_nature_isba_oi.F90 b/src/SURFEX/assim_nature_isba_oi.F90
deleted file mode 100644
index 3e64c444c5690364e84a2dcca787ff3aa2d7026c..0000000000000000000000000000000000000000
--- a/src/SURFEX/assim_nature_isba_oi.F90
+++ /dev/null
@@ -1,362 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE ASSIM_NATURE_ISBA_OI (I, &
- HPROGRAM, KI, &
- PRRCL, PRRSL, PRRCN, PRRSN, &
- PATMNEB, PITM, PEVAPTR, PEVAP, &
- PSNC, PTSC, PUCLS, PVCLS, &
- PTS_O, PT2M_O, PHU2M_O, PSWE, &
- HTEST, OD_MASKEXT, &
- PLON_IN, PLAT_IN )
-
-! ------------------------------------------------------------------------------------------
-! *****************************************************************************************
-!
-! Routine to perform OI within SURFEX
-! a soil analysis for water content and temperature
-! using the Meteo-France optimum interpolation technique of Giard and Bazile (2000)
-!
-! Derived from CANARI subroutines externalized by Lora Taseva (Dec. 2007)
-!
-! Author : Jean-Francois Mahfouf (01/2008)
-!
-! Modifications :
-! (05/2008) : The I/O of this version follow the newly available LFI format in SURFEX
-! (01/2009) : Read directly atmospheric FA files using XRD library instead of using "edf"
-! (06/2009) : Modifications to allow the assimilation of ASCAT superficial soil moisture
-! (09/2010) : More parameters to goto_surfex
-! (03/2011) : Initialization of ZEVAPTR (F.Bouyssel)
-! (07/2011) : Read pgd+prep (B. Decharme)
-! (04/2012) : Made as a subroutine (T. Aspelien)
-! (06/2013) : Separating IO (T. Aspelien)
-! J.Escobar 30/03/2017 : Management of compilation of ECMWF_RAD in REAL*8 with MNH_REAL=R4
-! ******************************************************************************************
-! ------------------------------------------------------------------------------------------
-!
-USE MODD_ISBA_n, ONLY : ISBA_t
-!
-USE MODD_CSTS, ONLY : XDAY, XPI, XRHOLW, XLVTT, NDAYSEC
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE MODD_ASSIM, ONLY : LOBSWG, NITRAD, NPRINTLEV, NECHGU, XRD1, XRSCALDW, &
- XRTHR_QC, XSIGWGB, XSIGWGO, XSIGWGO_MAX, XAT2M_ISBA, &
- XAHU2M_ISBA, XAZON10M_ISBA, XAMER10M_ISBA
-!
-
-USE YOMHOOK, ONLY : LHOOK, DR_HOOK
-USE PARKIND1, ONLY : JPRB
-!
-USE MODI_ABOR1_SFX
-USE MODI_OI_BC_SOIL_MOISTURE
-USE MODI_OI_CACSTS
-!
-IMPLICIT NONE
-!
-TYPE(ISBA_t), INTENT(INOUT) :: I
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-INTEGER, INTENT(IN) :: KI
-REAL, DIMENSION(KI), INTENT(IN) :: PRRCL
-REAL, DIMENSION(KI), INTENT(IN) :: PRRSL
-REAL, DIMENSION(KI), INTENT(IN) :: PRRCN
-REAL, DIMENSION(KI), INTENT(IN) :: PRRSN
-REAL, DIMENSION(KI), INTENT(IN) :: PATMNEB
-REAL, DIMENSION(KI), INTENT(IN) :: PITM
-REAL, DIMENSION(KI), INTENT(IN) :: PEVAPTR
-REAL, DIMENSION(KI), INTENT(IN) :: PEVAP
-REAL, DIMENSION(KI), INTENT(IN) :: PSNC
-REAL, DIMENSION(KI), INTENT(IN) :: PTSC
-REAL, DIMENSION(KI), INTENT(IN) :: PUCLS
-REAL, DIMENSION(KI), INTENT(IN) :: PVCLS
-REAL, DIMENSION(KI), INTENT(IN) :: PTS_O
-REAL, DIMENSION(KI), INTENT(IN) :: PT2M_O
-REAL, DIMENSION(KI), INTENT(IN) :: PHU2M_O
-REAL, DIMENSION(KI), INTENT(OUT):: PSWE
- CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
-LOGICAL, DIMENSION (KI) :: OD_MASKEXT
-REAL , DIMENSION (:), INTENT(IN) :: PLON_IN
-REAL , DIMENSION (:), INTENT(IN) :: PLAT_IN
-
-! Declarations of local variables
-!
-! Arrays for soil OI analysis
-!
-REAL, DIMENSION (KI) :: ZSAB, ZARG, ZWS, ZWP, ZTL, ZWS0, ZWP0, ZTL0, &
- ZTS, ZTP, ZSNS, ZTCLS, ZHCLS, ZD2, ZUCLS, ZVCLS, &
- ZRSMIN, ZLAI, ZVEG, ZSNS0, ZTS0, ZTP0, &
- ZIVEG, ZSM_O, ZSIG_SMO, ZLSM_O, ZWS_O, ZLON, ZLAT, &
- ZT2INC, ZH2INC, ZWGINC, ZWPINC1, ZWPINC2, ZWPINC3, &
- ZT2MBIAS, ZH2MBIAS, ZALBF, ZEMISF, ZZ0F, ZZ0H, &
- ZWSC, ZWPC, ZTPC, ZEVAP, ZEVAPTR, ZSSTC, &
- ZGELAT, ZGELAM, ZGEMU, ZWSINC, ZWPINC, ZTLINC, &
- ZSNINC, ZTSINC, ZTPINC
-!
-REAL :: ZTHRES
-INTEGER :: IDAT
-INTEGER :: IYEAR ! current year (UTC)
-INTEGER :: IMONTH ! current month (UTC)
-INTEGER :: IDAY ! current day (UTC)
-INTEGER :: ISSSSS ! current time since start of the run (s)
-INTEGER :: JI, JJ, JP, JL
-INTEGER :: INOBS ! number of observations
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-! ----------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('ASSIM_NATURE_ISBA_OI',0,ZHOOK_HANDLE)
-
-IF (HTEST/='OK') THEN
- CALL ABOR1_SFX('ASSIM_NATURE_ISBA_OI: FATAL ERROR DURING ARGUMENT TRANSFER')
-END IF
-
-IF ( NPRINTLEV > 0 ) THEN
- WRITE(*,*) '--------------------------------------------------------------------------'
- WRITE(*,*) '| |'
- WRITE(*,*) '| ENTER OI_ASSIM |'
- WRITE(*,*) '| |'
- WRITE(*,*) '--------------------------------------------------------------------------'
-ENDIF
-!
-! Update some constants dependant from NACVEG
-!
-! scaling of soil moisture increments when assimilation window is different
-! from 6 hours
-XRSCALDW = REAL(NECHGU)/6.0
-! half assimilation window in sec
-NITRAD = NECHGU*1800
-!
-! Time initializations
-!
-IYEAR = I%TTIME%TDATE%YEAR
-IMONTH = I%TTIME%TDATE%MONTH
-IDAY = I%TTIME%TDATE%DAY
-ISSSSS = I%TTIME%TIME
-IF ( ISSSSS>NDAYSEC ) ISSSSS = ISSSSS - NDAYSEC
-IDAT = IYEAR*10000. + IMONTH*100. + IDAY
-!
-!
-DO JI=1,KI
- ZGELAM(JI) = PLON_IN(JI)
- ZGELAT(JI) = PLAT_IN(JI)
-ENDDO
-!
-DO JI=1,KI
- ZGEMU (JI) = SIN(ZGELAT(JI)*XPI/180.)
-ENDDO
-!
-!
-JP = 1
-JL = 1
-!
-!
-ZSAB (:) = I%XSAND(:,JP)*100.
-ZARG (:) = I%XCLAY(:,JP)*100.
-!
-ZTS0 (:) = I%XTG (:,1,JP)
-ZTP0 (:) = I%XTG (:,2,JP)
-!
-ZWS0 (:) = I%XWG (:,1,JP)
-ZWP0 (:) = I%XWG (:,2,JP)
-ZTL0 (:) = I%XWGI (:,2,JP)
-!
-ZSNS0(:) = I%TSNOW%WSNOW(:,JL,JP)
-ZSNS (:) = ZSNS0(:)
-!
-ZTCLS (:) = XAT2M_ISBA (:,JP)
-ZHCLS (:) = XAHU2M_ISBA (:,JP)
-!
-ZD2 (:) = I%XDG (:,2,JP)
-ZRSMIN(:) = I%XRSMIN(:,JP)
-ZLAI (:) = I%XLAI (:,JP)
-ZVEG (:) = I%XVEG (:,JP)
-!
-ZUCLS(:) = PUCLS(:)
-ZVCLS(:) = PVCLS(:)
-!
-ZWPINC1 (:) = XUNDEF
-ZWPINC2 (:) = XUNDEF
-ZWPINC3 (:) = XUNDEF
-ZT2MBIAS(:) = XUNDEF
-ZH2MBIAS(:) = XUNDEF
-!
-! Sea-ice surface properties
-ZALBF (:) = XUNDEF
-ZEMISF(:) = XUNDEF
-ZZ0F (:) = XUNDEF
-ZZ0H (:) = XUNDEF
-!
-! Climatological arrays set to missing values
-ZWSC(:) = XUNDEF
-ZWPC(:) = XUNDEF
-ZTPC(:) = XUNDEF
-!
-! PRINT
-!
-IF ( NPRINTLEV > 1 ) THEN
- WRITE(*,*) 'value in PREP file => WG1 ',SUM(ZWS0)/KI
- WRITE(*,*) 'value in PREP file => WG2 ',SUM(ZWP0)/KI
- WRITE(*,*) 'value in PREP file => TG1 ',SUM(ZTS0)/KI
- WRITE(*,*) 'value in PREP file => TG2 ',SUM(ZTP0)/KI
- WRITE(*,*) 'value in PREP file => WGI2 ',SUM(ZTL0)/KI
- WRITE(*,*) 'value in PREP file => WSNOW_VEG1',SUM(ZSNS)/KI
- WRITE(*,*) 'value in PREP file => LAI ',SUM(ZLAI)/KI
- WRITE(*,*) 'value in PREP file => VEG ',SUM(ZVEG)/KI
- WRITE(*,*) 'value in PREP file => RSMIN ',SUM(ZRSMIN)/KI
- WRITE(*,*) 'value in PREP file => DATA_DG2 ',SUM(ZD2)/KI
- WRITE(*,*) 'value in PREP file => SAND ',SUM(ZSAB)/KI
- WRITE(*,*) 'value in PREP file => CLAY ',SUM(ZARG)/KI
-ENDIF
-!
-! SST not used in cacsts
-ZSSTC(:) = 0.
-!
-WHERE ( ZWS0(:)/=XUNDEF )
- ZWS(:) = ZWS0(:) * XRD1 * XRHOLW ! conversion of m3/m3 -> mm
- ZWP(:) = ZWP0(:) * ZD2(:) * XRHOLW ! conversion of m3/m3 -> mm
- ZTL(:) = ZTL0(:) * ZD2(:) * XRHOLW ! conversion of m3/m3 -> mm
-ENDWHERE
-!
-ZEVAP (:) = (PEVAP(:)/XLVTT*XDAY)/(NECHGU*3600.) ! conversion W/m2 -> mm/day
-ZEVAPTR(:) = PEVAPTR(:)*XDAY
-!
-! Set PIVEG (SURFIND.VEG.DOMI) since it is not available
-ZIVEG(:) = 0.0
-!
-!
-! Read ASCAT SM observations (in percent)
-!
-INOBS = 0
-IF ( LOBSWG ) THEN
- OPEN(UNIT=111,FILE='ASCAT_SM.DAT')
- DO JI=1,KI
- READ(111,*) ZSM_O(JI),ZSIG_SMO(JI),ZLSM_O(JI)
- ! data rejection if not on land
- ! data rejection of error too large
- IF ( ZLSM_O(JI)<1.0 .OR. ZSIG_SMO(JI)>XSIGWGO_MAX ) ZSM_O(JI) = 999.0
- IF ( ZSM_O(JI)/=999.0 ) INOBS = INOBS + 1
- ENDDO
- CLOSE(UNIT=111)
- IF ( NPRINTLEV > 0 ) WRITE(*,*) 'READ ASCAT SM OK'
-ELSE
- ZSM_O (:) = 999.0
- ZSIG_SMO(:) = 999.0
- ZLSM_O (:) = 0.0
-ENDIF
-IF ( NPRINTLEV > 0 ) WRITE(*,*) ' NUMBER OF ASCAT OBSERVATIONS AFTER INITIAL CHECKS :: ',INOBS
-!
-! Perform bias correction of SM observations
- CALL OI_BC_SOIL_MOISTURE(KI,ZSM_O,ZSAB,ZWS_O)
-!
-!
-! Screen-level innovations
-ZT2INC=0.
-WHERE ( PT2M_O(:) /= 999.0 )
- ZT2INC(:) = PT2M_O (:) - ZTCLS(:)
-END WHERE
-ZH2INC=0.
-WHERE ( PHU2M_O(:) /= 999.0 )
- ZH2INC(:) = PHU2M_O(:) - ZHCLS(:)
-END WHERE
-!
-! Avoid division by zero in next WHERE statement;
-! this may occur in the extension zone
-WHERE (OD_MASKEXT(1:KI))
- ZD2 (:) = 1.0
- ZT2INC(:) = 0.0
- ZH2INC(:) = 0.0
-END WHERE
-!
-! Threshold for background check
-ZTHRES = XRTHR_QC*SQRT(XSIGWGO**2 + XSIGWGB**2)
-! Superficial soil moisture innovations in (m3/m3)
-INOBS = 0
-DO JI=1,KI
- IF ( ZWS_O(JI)/=999.0 ) THEN
- ZWGINC(JI) = ZWS_O(JI) - ZWS(JI)
- IF ( ABS(ZWGINC(JI))>ZTHRES ) THEN
- ZWGINC(JI) = 0.0 ! background check
- ELSE
- INOBS = INOBS + 1
- ENDIF
- ELSE
- ZWGINC(JI) = 0.0
- ENDIF
-ENDDO
-IF ( NPRINTLEV > 0 ) THEN
- WRITE(*,*) ' NUMBER OF ASCAT OBSERVATIONS AFTER BACKGROUND CHECK :: ',INOBS
- WRITE(*,*) 'Mean T2m increments ',SUM(ZT2INC)/KI
- WRITE(*,*) 'Mean HU2m increments ',SUM(ZH2INC)/KI
-ENDIF
-!
-ZTS(:) = ZTS0(:)
-ZTP(:) = ZTP0(:)
-write(*,*) 'PERFORMING OI SOIL ANALYSIS'
- CALL OI_CACSTS(KI, ZT2INC, ZH2INC, ZWGINC, ZWS_O, &
- IDAT, ISSSSS, &
- ZTP, ZWP, ZTL, ZSNS, ZTS, ZWS, &
- ZTCLS, ZHCLS, ZUCLS, ZVCLS, ZSSTC, &
- ZWPINC1, ZWPINC2, ZWPINC3, ZT2MBIAS, ZH2MBIAS, &
- PRRCL, PRRSL, PRRCN, PRRSN, PATMNEB, ZEVAP, ZEVAPTR, &
- PITM, ZVEG, ZALBF, ZEMISF, ZZ0F, &
- ZIVEG, ZARG, ZD2, ZSAB, ZLAI, ZRSMIN, ZZ0H, &
- PTSC, ZTPC, ZWSC, ZWPC, PSNC, ZGELAT, ZGELAM, ZGEMU )
-!
-! Perform soil moiture analyses
-PSWE(:) = ZSNS(:)
-!
-ZWSINC(:) = 0.0
-ZWPINC(:) = 0.0
-ZTLINC(:) = 0.0
-ZSNINC(:) = 0.0
-WHERE ( ZWS(:)/=XUNDEF )
- ZWSINC(:) = ZWS(:) - ZWS0(:) * XRD1 * XRHOLW
- ZWPINC(:) = ZWP(:) - ZWP0(:) * ZD2(:) * XRHOLW
- ZTLINC(:) = ZTL(:) - ZTL0(:) * ZD2(:) * XRHOLW
- ZSNINC(:) = ZSNS(:) - ZSNS0(:)
-END WHERE
-
-! Avoid division by zero in next WHERE statement;
-! this may occur in the extension zone
-WHERE (OD_MASKEXT(1:KI)) ZD2(:) = 1.0
-!
-WHERE (ZWS0(:)/=XUNDEF)
- ZWS0(:) = ZWS(:)/ (XRD1*XRHOLW)
- ZWP0(:) = ZWP(:)/ (ZD2(:)*XRHOLW)
- ZTL0(:) = ZTL(:)/ (ZD2(:)*XRHOLW)
- ZSNS0(:) = ZSNS(:)
-ENDWHERE
-! Perform temperature analyses
-!
-ZTSINC(:) = 0.0
-ZTPINC(:) = 0.0
-WHERE (ZTS(:)/=XUNDEF)
- ZTSINC(:) = ZTS(:) - ZTS0(:)
- ZTPINC(:) = ZTP(:) - ZTP0(:)
- ZTS0(:) = ZTS(:)
- ZTP0(:) = ZTP(:)
-END WHERE
-
-
-! PRINT statistics of the soil analysis
-
-WRITE(*,*) '---------------------------------------------------------------'
-WRITE(*,*) 'Mean WS increments over NATURE ',SUM(ZWSINC)/KI
-WRITE(*,*) 'Mean WP increments over NATURE ',SUM(ZWPINC)/KI
-WRITE(*,*) 'Mean TS increments over NATURE ',SUM(ZTSINC)/KI
-WRITE(*,*) 'Mean TP increments over NATURE ',SUM(ZTPINC)/KI
-WRITE(*,*) 'Mean TL increments over NATURE ',SUM(ZTLINC)/KI
-WRITE(*,*) '---------------------------------------------------------------'
-
-! Update modified variables
-I%XWG (:,1,JP) = ZWS0(:)
-I%XWG (:,2,JP) = ZWP0(:)
-I%XTG (:,1,JP) = ZTS0(:)
-I%XTG (:,2,JP) = ZTP0(:)
-I%XWGI(:,2,JP) = ZTL0(:)
-
-!
-! -------------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('ASSIM_NATURE_ISBA_OI',1,ZHOOK_HANDLE)
-END SUBROUTINE ASSIM_NATURE_ISBA_OI
diff --git a/src/SURFEX/assim_naturen.F90 b/src/SURFEX/assim_naturen.F90
deleted file mode 100644
index 793792aca3b3df95f2e30b646e6ebc8fc82402e6..0000000000000000000000000000000000000000
--- a/src/SURFEX/assim_naturen.F90
+++ /dev/null
@@ -1,113 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ###############################################################################
-SUBROUTINE ASSIM_NATURE_n (DGMI, IG, I, U, &
- HPROGRAM,KI, &
- PCON_RAIN, PSTRAT_RAIN, PCON_SNOW, PSTRAT_SNOW, &
- PCLOUDS, PLSM, PEVAPTR, PEVAP, &
- PSWEC, PTSC, PUCLS, PVCLS, &
- PTS, PT2M, PHU2M, PSWE, &
- HTEST, OD_MASKEXT, PLON, PLAT)
-
-! ###############################################################################
-!
-!!**** *ASSIM_NATURE_n * - Chooses the surface assimilation schemes for natural continental parts
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! T. Aspelien
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 04/2012
-!! J.Escobar 30/03/2017 : Management of compilation of ECMWF_RAD in REAL*8 with MNH_REAL=R4
-!!--------------------------------------------------------------------
-!
-!
-!
-USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
-USE YOMHOOK, ONLY : LHOOK, DR_HOOK
-USE PARKIND1, ONLY : JPRB
-!
-USE MODI_ABOR1_SFX
-USE MODI_ASSIM_ISBA_n
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DGMI
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-INTEGER, INTENT(IN) :: KI
-REAL, DIMENSION(KI), INTENT(IN) :: PCON_RAIN
-REAL, DIMENSION(KI), INTENT(IN) :: PSTRAT_RAIN
-REAL, DIMENSION(KI), INTENT(IN) :: PCON_SNOW
-REAL, DIMENSION(KI), INTENT(IN) :: PSTRAT_SNOW
-REAL, DIMENSION(KI), INTENT(IN) :: PCLOUDS
-REAL, DIMENSION(KI), INTENT(IN) :: PLSM
-REAL, DIMENSION(KI), INTENT(IN) :: PEVAPTR
-REAL, DIMENSION(KI), INTENT(IN) :: PEVAP
-REAL, DIMENSION(KI), INTENT(IN) :: PSWEC
-REAL, DIMENSION(KI), INTENT(IN) :: PTSC
-REAL, DIMENSION(KI), INTENT(IN) :: PUCLS
-REAL, DIMENSION(KI), INTENT(IN) :: PVCLS
-REAL, DIMENSION(KI), INTENT(IN) :: PTS
-REAL, DIMENSION(KI), INTENT(IN) :: PT2M
-REAL, DIMENSION(KI), INTENT(IN) :: PHU2M
-REAL, DIMENSION(KI), INTENT(IN) :: PSWE
- CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
-LOGICAL, DIMENSION (KI), INTENT(IN) :: OD_MASKEXT
-REAL , DIMENSION (:), INTENT(IN) :: PLON
-REAL , DIMENSION (:), INTENT(IN) :: PLAT
-!
-!* 0.2 declarations of local variables
-!
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('ASSIM_NATURE_N',0,ZHOOK_HANDLE)
-!
-IF (HTEST/='OK') THEN
- CALL ABOR1_SFX('ASSIM_NATURE_n: FATAL ERROR DURING ARGUMENT TRANSFER')
-END IF
-!
-IF (U%CNATURE=='ISBA ') THEN
- !
- CALL ASSIM_ISBA_n(DGMI, IG, I, U, &
- HPROGRAM,KI, &
- PCON_RAIN, PSTRAT_RAIN, PCON_SNOW, PSTRAT_SNOW, &
- PCLOUDS, PLSM, PEVAPTR, PEVAP, &
- PSWEC, PTSC, PUCLS, PVCLS, &
- PTS, PT2M, PHU2M, PSWE, &
- HTEST, OD_MASKEXT, PLON, PLAT )
-ELSE
- WRITE(*,*) 'No assimilation done for scheme: ',TRIM(U%CNATURE)
-END IF
-!
-IF (LHOOK) CALL DR_HOOK('ASSIM_NATURE_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE ASSIM_NATURE_n
diff --git a/src/SURFEX/assim_sean.F90 b/src/SURFEX/assim_sean.F90
deleted file mode 100644
index 49b695b877e016796db7791c1298e46400228480..0000000000000000000000000000000000000000
--- a/src/SURFEX/assim_sean.F90
+++ /dev/null
@@ -1,201 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ###############################################################################
-SUBROUTINE ASSIM_SEA_n (S, U, &
- HPROGRAM,KI,PTS_IN,PSST_IN,PSIC_IN,PITM,HTEST, &
- OLKEEPEXTZONE,OD_MASKEXT,PLON_IN,PLAT_IN)
-
-! ###############################################################################
-!
-!!**** *ASSIM_SEA_n * - Chooses the surface assimilation schemes for SEA tile
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! T. Aspelien
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 04/2012
-!! Trygve Aspelien, Separating IO 06/2013
-!! J.Escobar 30/03/2017 : Management of compilation of ECMWF_RAD in REAL*8 with MNH_REAL=R4
-!!--------------------------------------------------------------------
-!
-!
-USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
-USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_ASSIM, ONLY : NPRINTLEV,LAESST,LEXTRAP_SEA
-!
-!
-USE YOMHOOK, ONLY : LHOOK,DR_HOOK
-USE PARKIND1, ONLY : JPRB
-!
-USE MODI_ABOR1_SFX
-USE MODI_PACK_SAME_RANK
-USE MODI_OI_HOR_EXTRAPOL_SURF
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(SEAFLUX_t), INTENT(INOUT) :: S
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-INTEGER, INTENT(IN) :: KI
-REAL,DIMENSION(KI), INTENT(IN) :: PTS_IN
-REAL,DIMENSION(KI), INTENT(IN) :: PSST_IN
-REAL,DIMENSION(KI), INTENT(IN) :: PSIC_IN
-REAL,DIMENSION(KI), INTENT(IN) :: PITM
- CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
-LOGICAL, INTENT(IN) :: OLKEEPEXTZONE
-LOGICAL, DIMENSION(KI), INTENT(IN) :: OD_MASKEXT
-REAL , DIMENSION (:), INTENT(IN) :: PLON_IN
-REAL , DIMENSION (:), INTENT(IN) :: PLAT_IN
-!
-!* 0.2 declarations of local variables
-!
-!-------------------------------------------------------------------------------------
-!
-REAL, DIMENSION(KI) :: ZALT
-REAL, DIMENSION(KI) :: ZSST
-REAL, DIMENSION(KI) :: ZSST0
-REAL, DIMENSION(KI) :: ZSSTINC
-REAL, DIMENSION(:), ALLOCATABLE :: ZSST01, ZSST1, ZLON1, ZLAT1, ZALT1
-REAL :: ZFMAX, ZFMIN, ZFMEAN
-LOGICAL, DIMENSION(KI) :: GINTERP_SST
-LOGICAL, DIMENSION(:), ALLOCATABLE :: GINTERP_SST1
-INTEGER :: IRESP, I, J, J1, IS1
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
-IF (LHOOK) CALL DR_HOOK('ASSIM_SEA_N',0,ZHOOK_HANDLE)
-!
-IF (HTEST/='OK') THEN
- CALL ABOR1_SFX('ASSIM_SEA_n: FATAL ERROR DURING ARGUMENT TRANSFER')
-END IF
-!
-IF (NRANK==NPIO) WRITE(*,*) 'UPDATING SST FOR SCHEME: ',TRIM(U%CSEA)
-IF (U%CSEA=="NONE") THEN
- IF (LHOOK) CALL DR_HOOK('ASSIM_SEA_N',1,ZHOOK_HANDLE)
- RETURN
-ENDIF
-!
- CALL PACK_SAME_RANK(U%NR_SEA,U%XZS,ZALT)
-!
-! Read SST from file or set it to input SST
-IF ( .NOT.LAESST ) THEN
- ! Set SST to input
- ZSST(:) = PSST_IN(:)
- !
-ELSE
- ! SST analysed in CANARI
- ZSST(:) = XUNDEF
- DO I=1,KI
- IF (PITM(I)<0.5 .AND. U%XSEA(U%NR_SEA(I))/=0. ) THEN
- ZSST(I) = PTS_IN(I) ! set SST analysis from CANARI
- ENDIF
- END DO
- !
- ZFMIN = MINVAL(ZSST)
- ZFMAX = MAXVAL(ZSST)
- ZFMEAN = SUM(ZSST)/FLOAT(KI)
- WRITE(*,*) ' SST analysis from CANARI '
- WRITE(*,'(" ZSST - min, mean, max: ",3E13.4)') ZFMIN, ZFMEAN, ZFMAX
-ENDIF
-!* PSST updated at all sea points with ZSST where ZSST is available
-GINTERP_SST(:) = .FALSE.
-! Set SST from watfluxn
-DO I=1,KI
- !
- IF ( ZSST(I)/=XUNDEF ) THEN
- ZSST0(I) = ZSST(I)
- ELSEIF ( LEXTRAP_SEA ) THEN
- ZSST0(I) = XUNDEF
- GINTERP_SST(I) = .TRUE.
- ELSE
- ZSST0(I) = S%XSST(I)
- ENDIF
- !
-ENDDO
-!
-IF ( LEXTRAP_SEA ) THEN
- !
- IF (OLKEEPEXTZONE) THEN
- !
- ZSST(:) = ZSST0(:)
- WHERE ( OD_MASKEXT(:) ) ZSST0(:) = XUNDEF
- CALL OI_HOR_EXTRAPOL_SURF(KI,PLAT_IN,PLON_IN,ZSST0,PLAT_IN,PLON_IN,ZSST,GINTERP_SST,ZALT)
- !
- ELSE
- !
- IS1 = COUNT (.NOT. OD_MASKEXT)
- ALLOCATE (ZSST1(IS1), ZSST01(IS1), ZLAT1(IS1), ZLON1(IS1), ZALT1(IS1), GINTERP_SST1(IS1))
- !
- ! remove extension zone
- J = 1
- DO J1 = 1, KI
- IF (.NOT. OD_MASKEXT (J1)) THEN
- ZSST01(J) = ZSST0(J1)
- ZLAT1 (J) = PLAT_IN (J1)
- ZLON1 (J) = PLON_IN (J1)
- ZALT1 (J) = U%XZS (J1)
- GINTERP_SST1(J) = GINTERP_SST(J1)
- J = J + 1
- ENDIF
- ENDDO
-
- ZSST1(:) = ZSST01(:)
- CALL OI_HOR_EXTRAPOL_SURF(IS1,ZLAT1,ZLON1,ZSST01,ZLAT1,ZLON1,ZSST1,GINTERP_SST1,ZALT1)
-
- ! copy back
- J = 1
- DO J1 = 1, KI
- IF (.NOT. OD_MASKEXT(J1)) THEN
- ZSST(J1) = ZSST1(J)
- J = J + 1
- ENDIF
- ENDDO
- !
- DEALLOCATE (ZSST01, ZSST1, ZLAT1, ZLON1, ZALT1, GINTERP_SST1)
- !
- ENDIF
- !
-ENDIF
-!
-!* Print values produced by OI_HO_EXTRAPOL_SURF
-IF ( NPRINTLEV > 2 ) THEN
- DO I=1,KI
- IF (GINTERP_SST(I)) THEN
- PRINT *,'Sea surface temperature set to ',ZSST(I),'from nearest neighbour at I=',U%NR_SEA(I)
- ENDIF
- ENDDO
-ENDIF
-!
-! Sum the increments
-ZSSTINC(:) = ZSST(:) - S%XSST(:)
-IF (KI>0) WRITE(*,*) 'Mean SST increments over SEA ',SUM(ZSSTINC)/KI
-!
-! Setting modified variables
-S%XSST(:) = ZSST(:)
-!
-IF (LHOOK) CALL DR_HOOK('ASSIM_SEA_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE ASSIM_SEA_n
diff --git a/src/SURFEX/assim_set_sst.F90 b/src/SURFEX/assim_set_sst.F90
deleted file mode 100644
index 46467570c07df15bde5ba4af951bd51fddd0519e..0000000000000000000000000000000000000000
--- a/src/SURFEX/assim_set_sst.F90
+++ /dev/null
@@ -1,250 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ###############################################################################
-SUBROUTINE ASSIM_SET_SST (DTCO, DGU, S, U, &
- KI,PITM,PSST,PSIC,HTEST)
-
-! ###############################################################################
-!
-!!**** *ASSIM_SET_SST * - Reads SST from file
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! T. Aspelien
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 04/2012
-!!--------------------------------------------------------------------
-!
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
-USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NPROC
-!
-USE MODD_ASSIM, ONLY : LECSST, LREAD_SST_FROM_FILE, CFILE_FORMAT_SST, NPRINTLEV
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-#ifdef SFX_FA
-USE MODD_IO_SURF_FA, ONLY : CFILEIN_FA, CDNOMC
-#endif
-!
-USE MODI_ABOR1_SFX
-USE MODI_INIT_IO_SURF_n
-USE MODI_READ_SURF
-USE MODI_READ_AND_SEND_MPI
-USE MODI_GATHER_AND_WRITE_MPI
-USE MODI_END_IO_SURF_n
-USE MODI_IO_BUFF_CLEAN
-USE MODI_UNPACK_SAME_RANK
-!
-USE YOMHOOK, ONLY : LHOOK,DR_HOOK
-USE PARKIND1, ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(SEAFLUX_t), INTENT(INOUT) :: S
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-!
-INTEGER, INTENT(IN) :: KI
-REAL,DIMENSION(KI), INTENT(IN) :: PITM
-REAL,DIMENSION(KI), INTENT(OUT) :: PSST
-REAL,DIMENSION(KI), INTENT(OUT) :: PSIC ! Not used at the moment
- CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
-!
-!* 0.2 declarations of local variables
-!
-!-------------------------------------------------------------------------------------
-!
-REAL,ALLOCATABLE, DIMENSION(:,:) :: ZWORK,ZWORK2
-REAL,ALLOCATABLE, DIMENSION(:) :: ZSEA
- CHARACTER(LEN=200) :: YMFILE ! Name of the SST file
- CHARACTER(LEN=6) :: YPROGRAM2 = 'FA '
-REAL, DIMENSION(SIZE(PSST)) :: ZSST
-REAL :: ZFMAX, ZFMIN, ZFMEAN
-INTEGER :: IRESP,ISTAT
-INTEGER :: JI,JJ,ICPT
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
-IF (LHOOK) CALL DR_HOOK('ASSIM_SET_SST',0,ZHOOK_HANDLE)
-
-IF (HTEST/='OK') THEN
- CALL ABOR1_SFX('ASSIM_SET_SST: FATAL ERROR DURING ARGUMENT TRANSFER')
-END IF
-!
-IF (U%CSEA=="NONE" .OR. U%NDIM_SEA == 0) THEN
- IF (LHOOK) CALL DR_HOOK('ASSIM_SET_SST_N',1,ZHOOK_HANDLE)
- RETURN
-ENDIF
-!
-PSIC(:) = 0.
-!
-IF ( LREAD_SST_FROM_FILE ) THEN
- !
- IF ( TRIM(CFILE_FORMAT_SST) == "ASCII" ) THEN
- !
- ALLOCATE(ZSEA(U%NDIM_FULL))
- ALLOCATE(ZWORK(U%NDIM_FULL,2))
- ALLOCATE(ZWORK2(U%NSIZE_FULL,2))
- !
- IF (NPROC>1) CALL GATHER_AND_WRITE_MPI(U%XSEA,ZSEA)
- !
- IF (NRANK==NPIO) THEN
- YMFILE = 'SST_SIC'
- IF (NPRINTLEV > 0 .AND. NRANK==NPIO ) &
- WRITE(*,*) "READING SST/SIC from file "//TRIM(YMFILE)//".DAT for ",&
- U%NDIM_SEA," sea points",U%NDIM_FULL
- ISTAT = 0
- OPEN(UNIT=55,FILE=TRIM(YMFILE)//".DAT",FORM='FORMATTED',STATUS='OLD',IOSTAT=ISTAT)
- IF ( ISTAT /= 0 ) CALL ABOR1_SFX("Can not open "//TRIM(YMFILE))
-
- ZWORK(:,:) = XUNDEF
- ! Read SST/SIC values
- DO JI = 1,U%NDIM_FULL
- IF ( ZSEA(JI) > 0. ) THEN
- READ (55,*,IOSTAT=ISTAT) (ZWORK(JI,JJ),JJ=1,2)
- IF ( ISTAT /= 0 ) CALL ABOR1_SFX("Error reading file "//TRIM(YMFILE))
- ENDIF
- ENDDO
- CLOSE(55)
- ENDIF
-
- ! Distribute ZWORK to all processors
- IF (NPROC>1) THEN
- CALL READ_AND_SEND_MPI(ZWORK(:,1),ZWORK2(:,1))
- CALL READ_AND_SEND_MPI(ZWORK(:,2),ZWORK2(:,2))
- ELSE
- ZWORK2=ZWORK
- ENDIF
-
- ! Set SST/SIC variables
- DO JI = 1,U%NSIZE_FULL
- PSST(JI)=ZWORK2(JI,1)
- PSIC(JI)=ZWORK2(JI,2)
- ENDDO
-
- DEALLOCATE(ZWORK)
- DEALLOCATE(ZWORK2)
- DEALLOCATE(ZSEA)
-
- ELSEIF ( TRIM(CFILE_FORMAT_SST) == "FA" ) THEN
- !
- ! Read SST from boundaries when SST analysis NOT is performed in CANARI
- !
- ! Define FA file name for SST analysis interpolated from boundary file
- !
-#ifdef SFX_FA
- CFILEIN_FA = 'SST_SIC' ! input SST and SIC analysis
- CDNOMC = 'CADRE SST' ! new frame name
- IF (NRANK==NPIO .AND. NPRINTLEV>0) WRITE(*,*) 'READING SST FROM ',TRIM(CFILEIN_FA)
-#endif
- !
- ! Open FA file
- !
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- YPROGRAM2,'EXTZON','SURF ','READ ')
- !
- ! Read SST_SIC
- !
- IF ( LECSST ) THEN
- ! SST field interpolated from ECMWF SST ANALYSIS to model domain
- CALL READ_SURF(&
- YPROGRAM2,'SURFSEA.TEMPERA',PSST,IRESP)
- ELSE
- ! Surface temperature from boundary in SST_SIC
- CALL READ_SURF(&
- YPROGRAM2,'SURFTEMPERATURE',PSST,IRESP)
- ENDIF
- !
- ! Close SST_SIC file
- !
- CALL END_IO_SURF_n(YPROGRAM2)
- CALL IO_BUFF_CLEAN
- IF (NRANK==NPIO) WRITE(*,*) 'READ SST_SIC OK'
-
- ZFMIN = MINVAL(PSST)
- ZFMAX = MAXVAL(PSST)
- IF ( KI > 0 ) THEN
- ZFMEAN = SUM(PSST)/FLOAT(KI)
- ELSE
- ZFMEAN=XUNDEF
- ENDIF
-
- IF ( LECSST ) THEN
-
- IF (NRANK==NPIO .AND. NPRINTLEV>0) THEN
- WRITE(*,*) ' ECMWF_SST_SIC'
- WRITE(*,'(" SURFSEA.TEMPERA - min, mean, max: ",3E13.4)') ZFMIN, ZFMEAN, ZFMAX
- ENDIF
-
- ! Replace -9999. with UNDEF
- WHERE ( PSST(:)< 0. )
- PSST(:) = XUNDEF
- ENDWHERE
-
- ELSE
-
- IF (NRANK==NPIO .AND. NPRINTLEV>0) THEN
- WRITE(*,*) ' Boundary file'
- WRITE(*,'(" SURFTEMPERATURE - min, mean, max: ",3E13.4)') ZFMIN, ZFMEAN, ZFMAX
- ENDIF
- ! To avoid surface temperatures influenced by land, NATURE points are replaced with UNDEF
- WHERE ( PITM(:)>0.5 )
- PSST(:) = XUNDEF
- ENDWHERE
-
- ENDIF
-
- ZFMIN = MINVAL(PSST)
- ZFMAX = MAXVAL(PSST)
- IF ( KI > 0 ) THEN
- ZFMEAN = SUM(PSST)/FLOAT(KI)
- ELSE
- ZFMEAN=XUNDEF
- ENDIF
-
- IF (NRANK==NPIO .AND. NPRINTLEV>0) THEN
- WRITE(*,*) ' Replaced land by UNDEF '
- WRITE(*,'(" SST - min, mean, max: ",3E13.4)') ZFMIN, ZFMEAN, ZFMAX
- ENDIF
-
- ELSE
- CALL ABOR1_SFX("CFILE_FORMAT_SST="//TRIM(CFILE_FORMAT_SST)//" not implemented!")
- ENDIF
-
-ELSE
- !
- IF ( U%NSIZE_SEA>0 .AND. U%CSEA/="NONE") THEN
- CALL UNPACK_SAME_RANK(U%NR_SEA,S%XSST,ZSST)
- PSST(:) = ZSST(:)
- ELSE
- PSST(:) = XUNDEF
- ENDIF
- !
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('ASSIM_SET_SST',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE ASSIM_SET_SST
diff --git a/src/SURFEX/assim_surf_atmn.F90 b/src/SURFEX/assim_surf_atmn.F90
deleted file mode 100644
index b1f1f8e225d68c07e221a49193fe2f2b7f43d472..0000000000000000000000000000000000000000
--- a/src/SURFEX/assim_surf_atmn.F90
+++ /dev/null
@@ -1,316 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #################################################################################
-SUBROUTINE ASSIM_SURF_ATM_n (DGMI, IG, I, S, U, T, TOP, W, &
- HPROGRAM, KI, &
- PCON_RAIN, PSTRAT_RAIN, PCON_SNOW, PSTRAT_SNOW, &
- PCLOUDS, PLSM, PEVAPTR, PEVAP, &
- PSWEC, PTSC, &
- PTS, PT2M, PHU2M, PSWE, &
- PSST, PSIC, PUCLS, PVCLS, &
- HTEST , OD_MASKEXT, PLON, PLAT, OLKEEPEXTZONE )
-! #################################################################################
-!
-!
-!!**** *ASSIM_SURF_ATM_n * - Driver to call the schemes for the
-!! four surface types (SEA, WATER, NATURE, TOWN)
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! T. Aspelien
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 04/2012
-!!-------------------------------------------------------------
-!
-!
-!
-!
-!
-USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_TEB_n, ONLY : TEB_t
-USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-USE MODD_WATFLUX_n, ONLY : WATFLUX_t
-!
-USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
-!
-USE MODD_SURF_CONF, ONLY : CPROGNAME
-!
-USE MODD_ASSIM, ONLY : XAT2M_ISBA, XAHU2M_ISBA, XAZON10M_ISBA, XAMER10M_ISBA, XAT2M_TEB, LAROME
-!
-!RJ: unneeded?
-!
-USE MODI_ABOR1_SFX
-USE MODI_ASSIM_SEA_n
-USE MODI_ASSIM_INLAND_WATER_n
-USE MODI_ASSIM_NATURE_n
-USE MODI_ASSIM_TOWN_n
-!
-USE YOMHOOK, ONLY : LHOOK, DR_HOOK
-USE PARKIND1, ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DGMI
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(SEAFLUX_t), INTENT(INOUT) :: S
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(TEB_t), INTENT(INOUT) :: T
-TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
-TYPE(WATFLUX_t), INTENT(INOUT) :: W
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-INTEGER, INTENT(IN) :: KI
-REAL, DIMENSION(KI), INTENT(IN) :: PCON_RAIN
-REAL, DIMENSION(KI), INTENT(IN) :: PSTRAT_RAIN
-REAL, DIMENSION(KI), INTENT(IN) :: PCON_SNOW
-REAL, DIMENSION(KI), INTENT(IN) :: PSTRAT_SNOW
-REAL, DIMENSION(KI), INTENT(IN) :: PCLOUDS
-REAL, DIMENSION(KI), INTENT(IN) :: PLSM
-REAL, DIMENSION(KI), INTENT(IN) :: PEVAPTR
-REAL, DIMENSION(KI), INTENT(IN) :: PEVAP
-REAL, DIMENSION(KI), INTENT(IN) :: PSWEC
-REAL, DIMENSION(KI), INTENT(IN) :: PTSC
-REAL, DIMENSION(KI), INTENT(IN) :: PTS
-REAL, DIMENSION(KI), INTENT(IN) :: PT2M
-REAL, DIMENSION(KI), INTENT(IN) :: PHU2M
-REAL, DIMENSION(KI), INTENT(IN) :: PSWE
-REAL, DIMENSION(KI), INTENT(IN) :: PSST
-REAL, DIMENSION(KI), INTENT(IN) :: PSIC
-REAL, DIMENSION(KI), INTENT(IN) :: PUCLS
-REAL, DIMENSION(KI), INTENT(IN) :: PVCLS
- CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
-LOGICAL, DIMENSION (KI), INTENT(IN) :: OD_MASKEXT
-REAL(KIND=JPRB), DIMENSION (:), INTENT(IN) :: PLON
-REAL(KIND=JPRB), DIMENSION (:), INTENT(IN) :: PLAT
-LOGICAL, INTENT(IN) :: OLKEEPEXTZONE
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: JTILE ! loop on type of surface
-LOGICAL :: GNATURE, GTOWN, GWATER, GSEA ! .T. if the corresponding surface is represented
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('ASSIM_SURF_ATM_N',0,ZHOOK_HANDLE)
-!
- CPROGNAME = HPROGRAM
-!
-IF (HTEST/='OK') THEN
- CALL ABOR1_SFX('ASSIM_SURF_ATMN: FATAL ERROR DURING ARGUMENT TRANSFER')
-END IF
-!
-!-------------------------------------------------------------------------------------
-! Preliminaries: Tile related operations
-!-------------------------------------------------------------------------------------
-
-! FLAGS for the various surfaces:
-!
-GSEA = U%NDIM_SEA >0
-GWATER = U%NDIM_WATER >0
-GTOWN = U%NDIM_TOWN >0
-GNATURE = U%NDIM_NATURE >0
-!
-! Tile counter:
-!
-JTILE = 0
-!
-!--------------------------------------------------------------------------------------
-! Call interfaces for sea, water, nature and town here...
-!--------------------------------------------------------------------------------------
-!
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! SEA Tile calculations:
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-!
-JTILE = JTILE + 1
-!
-IF(GSEA)THEN
-!
- CALL ASSIM_TREAT_SURF(JTILE,U%NSIZE_SEA,U%NR_SEA)
-!
-ENDIF
-!
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! INLAND WATER Tile calculations:
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-!
-JTILE = JTILE + 1
-!
-IF(GWATER)THEN
-!
- CALL ASSIM_TREAT_SURF(JTILE,U%NSIZE_WATER,U%NR_WATER)
-!
-ENDIF
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! NATURAL SURFACE Tile calculations:
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-!
-JTILE = JTILE + 1
-!
-IF(GNATURE)THEN
-!
- CALL ASSIM_TREAT_SURF(JTILE,U%NSIZE_NATURE,U%NR_NATURE)
-
- IF ( ALLOCATED(XAT2M_ISBA)) DEALLOCATE(XAT2M_ISBA)
- IF ( ALLOCATED(XAHU2M_ISBA)) DEALLOCATE(XAHU2M_ISBA)
- IF ( ALLOCATED(XAZON10M_ISBA)) DEALLOCATE(XAZON10M_ISBA)
- IF ( ALLOCATED(XAMER10M_ISBA)) DEALLOCATE(XAMER10M_ISBA)
-!
-ENDIF
-!
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! URBAN Tile calculations:
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-!
-JTILE = JTILE + 1
-!
-IF(GTOWN)THEN
-!
- CALL ASSIM_TREAT_SURF(JTILE,U%NSIZE_TOWN,U%NR_TOWN)
-
- IF ( ALLOCATED(XAT2M_TEB)) DEALLOCATE(XAT2M_TEB)
-!
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('ASSIM_SURF_ATM_N',1,ZHOOK_HANDLE)
-!
-!=======================================================================================
- CONTAINS
-!
-!=======================================================================================
-SUBROUTINE ASSIM_TREAT_SURF(KTILE,KSIZE,KMASK)
-!
-IMPLICIT NONE
-!
-INTEGER, INTENT(IN) :: KTILE
-INTEGER, INTENT(IN) :: KSIZE
-INTEGER, INTENT(IN), DIMENSION(KSIZE) :: KMASK
-!
-REAL,DIMENSION(KSIZE) :: ZP_PCON_RAIN
-REAL,DIMENSION(KSIZE) :: ZP_PSTRAT_RAIN
-REAL,DIMENSION(KSIZE) :: ZP_PCON_SNOW
-REAL,DIMENSION(KSIZE) :: ZP_PSTRAT_SNOW
-REAL,DIMENSION(KSIZE) :: ZP_PCLOUDS
-REAL,DIMENSION(KSIZE) :: ZP_PLSM
-REAL,DIMENSION(KSIZE) :: ZP_PEVAPTR
-REAL,DIMENSION(KSIZE) :: ZP_PEVAP
-REAL,DIMENSION(KSIZE) :: ZP_PSWEC
-REAL,DIMENSION(KSIZE) :: ZP_PTSC
-REAL,DIMENSION(KSIZE) :: ZP_PTS
-REAL,DIMENSION(KSIZE) :: ZP_PT2M
-REAL,DIMENSION(KSIZE) :: ZP_PHU2M
-REAL,DIMENSION(KSIZE) :: ZP_PSWE
-REAL,DIMENSION(KSIZE) :: ZP_PSST
-REAL,DIMENSION(KSIZE) :: ZP_PSIC
-REAL,DIMENSION(KSIZE) :: ZP_UCLS
-REAL,DIMENSION(KSIZE) :: ZP_VCLS
-REAL,DIMENSION(KSIZE) :: ZP_LON
-REAL,DIMENSION(KSIZE) :: ZP_LAT
-LOGICAL,DIMENSION(KSIZE) :: GD_MASKEXT
-INTEGER :: JJ,JI
-!
-DO JJ=1,KSIZE
- JI=KMASK(JJ)
- ZP_PLSM(JJ) = PLSM(JI)
- ZP_PCON_RAIN(JJ) = PCON_RAIN(JI)
- ZP_PSTRAT_RAIN(JJ) = PSTRAT_RAIN(JI)
- ZP_PCON_SNOW(JJ) = PCON_SNOW(JI)
- ZP_PSTRAT_SNOW(JJ) = PSTRAT_SNOW(JI)
- ZP_PCLOUDS(JJ) = PCLOUDS(JI)
- ZP_PEVAPTR(JJ) = PEVAPTR(JI)
- ZP_PEVAP(JJ) = PEVAP(JI)
- ZP_PSWE(JJ) = PSWE(JI)
- ZP_PSWEC(JJ) = PSWEC(JI)
- ZP_PTSC(JJ) = PTSC(JI)
- ZP_PTS(JJ) = PTS(JI)
- ZP_PT2M(JJ) = PT2M(JI)
- ZP_PHU2M(JJ) = PHU2M(JI)
- ZP_PSST(JJ) = PSST(JI)
- ZP_PSIC(JJ) = PSIC(JI)
- ZP_UCLS(JJ) = PUCLS(JI)
- ZP_VCLS(JJ) = PVCLS(JI)
- ZP_LON(JJ) = PLON(JI)
- ZP_LAT(JJ) = PLAT(JI)
- GD_MASKEXT(JJ) = OD_MASKEXT(JI)
-ENDDO
-
-IF (KTILE==1) THEN
-
- IF (NRANK==NPIO) THEN
- WRITE(*,*) '*********************************************'
- WRITE(*,*) '* ASSIMILATIONS FOR SEA POINTS *'
- WRITE(*,*) '*********************************************'
- ENDIF
-
- CALL ASSIM_SEA_n(S, U, &
- HPROGRAM,KSIZE,ZP_PTS,ZP_PSST,ZP_PSIC,ZP_PLSM,HTEST,&
- OLKEEPEXTZONE,GD_MASKEXT,ZP_LON,ZP_LAT)
-
-ELSEIF (KTILE==2) THEN
-
- IF (NRANK==NPIO) THEN
- WRITE(*,*) '*********************************************'
- WRITE(*,*) '* ASSIMILATIONS FOR WATER POINTS *'
- WRITE(*,*) '*********************************************'
- ENDIF
-
- CALL ASSIM_INLAND_WATER_n(I, U, W, &
- HPROGRAM,KSIZE,ZP_PTS,ZP_PLSM,HTEST,&
- OLKEEPEXTZONE,GD_MASKEXT,ZP_LON,ZP_LAT)
-
-ELSEIF (KTILE==3) THEN
-
- IF (NRANK==NPIO) THEN
- WRITE(*,*) '*********************************************'
- WRITE(*,*) '* ASSIMILATIONS FOR NATURE POINTS *'
- WRITE(*,*) '*********************************************'
- ENDIF
-
- CALL ASSIM_NATURE_n(DGMI, IG, I, U, &
- HPROGRAM,KSIZE, &
- ZP_PCON_RAIN, ZP_PSTRAT_RAIN, ZP_PCON_SNOW, ZP_PSTRAT_SNOW, &
- ZP_PCLOUDS, ZP_PLSM, ZP_PEVAPTR, ZP_PEVAP, &
- ZP_PSWEC, ZP_PTSC, ZP_UCLS, ZP_VCLS, &
- ZP_PTS, ZP_PT2M, ZP_PHU2M, ZP_PSWE, &
- HTEST, GD_MASKEXT, ZP_LON, ZP_LAT )
-
-ELSEIF (KTILE==4) THEN
-
- IF (NRANK==NPIO) THEN
- WRITE(*,*) '*********************************************'
- WRITE(*,*) '* ASSIMILATIONS FOR URBAN POINTS *'
- WRITE(*,*) '*********************************************'
- ENDIF
-
- CALL ASSIM_TOWN_n(U, T, TOP, &
- HPROGRAM,KSIZE,ZP_PT2M,HTEST)
-
-ENDIF
-
-END SUBROUTINE ASSIM_TREAT_SURF
-!=======================================================================================
-END SUBROUTINE ASSIM_SURF_ATM_n
-!=======================================================================================
-
diff --git a/src/SURFEX/assim_tebn.F90 b/src/SURFEX/assim_tebn.F90
deleted file mode 100644
index d45b9ecb83cd45a8d90a44ece0736bc75f4cd364..0000000000000000000000000000000000000000
--- a/src/SURFEX/assim_tebn.F90
+++ /dev/null
@@ -1,109 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ###############################################################################
-SUBROUTINE ASSIM_TEB_n (U, T, TOP, &
- HPROGRAM,KI,PT2M_O,HTEST)
-
-! ###############################################################################
-!
-!!**** *ASSIM_TOWN_n * - Chooses the surface schemes for TOWN parts
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! T. Aspelien
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 04/2012
-!! Trygve Aspelien, Separating IO 06/2013
-!!--------------------------------------------------------------------
-!
-!
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_TEB_n, ONLY : TEB_t
-USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-!
-USE MODD_CSTS, ONLY : XPI
-USE MODD_ASSIM, ONLY : NPRINTLEV,XAT2M_TEB
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE YOMHOOK, ONLY : LHOOK, DR_HOOK
-USE PARKIND1, ONLY : JPRB
-
-USE MODI_ABOR1_SFX
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(TEB_t), INTENT(INOUT) :: T
-TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-INTEGER, INTENT(IN) :: KI
-REAL,DIMENSION(KI), INTENT(IN) :: PT2M_O
- CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
-!
-!* 0.2 declarations of local variables
-!
-!-------------------------------------------------------------------------------------
-!
-REAL, DIMENSION (KI) :: ZTRD3
-REAL, DIMENSION (KI) :: ZT2INC
-REAL, DIMENSION (KI) :: ZTCLS
-INTEGER :: I
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-IF (LHOOK) CALL DR_HOOK('ASSIM_TEB_N',0,ZHOOK_HANDLE)
-
-IF (HTEST/='OK') THEN
- CALL ABOR1_SFX('ASSIM_TEB_n: FATAL ERROR DURING ARGUMENT TRANSFER')
-END IF
-
-WRITE(*,*) 'UPDATING TOWN FOR SCHEME: ',TRIM(U%CTOWN)
-
-IF ( TOP%NROAD_LAYER < 3 ) CALL ABOR1_SFX('ASSIM_TEB_n: Only imlemented with 3 or more layers')
-
-ZTRD3(:) = T%CUR%XT_ROAD(:,3) ! T_ROAD3
-ZTCLS(:) = XAT2M_TEB(:) ! T2M (TEB)
-
-! Screen-level innovations
-
-ZT2INC=0.
-WHERE ( PT2M_O(:) /= 999. )
- ZT2INC(:) = PT2M_O(:) - ZTCLS(:)
-END WHERE
-
-IF ( NPRINTLEV > 0 .AND. KI>0) WRITE(*,*) 'Mean T2m increments over TOWN ',SUM(ZT2INC)/KI
-
-
-! Temperature analysis of TOWN points
-
-WHERE (ZTRD3(:)/=XUNDEF)
- ZTRD3(:) = ZTRD3(:) + ZT2INC(:)/(2.0*XPI)
-END WHERE
-!
-
-IF (KI>0) WRITE(*,*) 'Mean T_ROAD3 increments over TOWN ',SUM(ZT2INC)/KI
-
-! Update modified variables
-T%CUR%XT_ROAD(:,3) = ZTRD3 ! T_ROAD3
-
-IF (LHOOK) CALL DR_HOOK('ASSIM_TEB_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE ASSIM_TEB_n
diff --git a/src/SURFEX/assim_townn.F90 b/src/SURFEX/assim_townn.F90
deleted file mode 100644
index 25b718e2bf1b029eabeb3a4375c7bcb00ed72195..0000000000000000000000000000000000000000
--- a/src/SURFEX/assim_townn.F90
+++ /dev/null
@@ -1,87 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ###############################################################################
-SUBROUTINE ASSIM_TOWN_n (U, T, TOP, &
- HPROGRAM,KI,PT2M_O,HTEST)
-
-! ###############################################################################
-!
-!!**** *ASSIM_TOWN_n * - Chooses the surface schemes for TOWN parts
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! T. Aspelien
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 04/2012
-!!--------------------------------------------------------------------
-!
-!
-!
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_TEB_n, ONLY : TEB_t
-USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-!
-USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
-!
-USE MODD_CSTS, ONLY : XPI
-USE MODN_IO_OFFLINE, ONLY : CSURF_FILETYPE
-!
-!
-USE YOMHOOK, ONLY : LHOOK, DR_HOOK
-USE PARKIND1, ONLY : JPRB
-!
-USE MODI_ABOR1_SFX
-USE MODI_ASSIM_TEB_n
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(TEB_t), INTENT(INOUT) :: T
-TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-INTEGER, INTENT(IN) :: KI
-REAL,DIMENSION(kI), INTENT(IN) :: PT2M_O
- CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
-!
-!* 0.2 declarations of local variables
-!
-!-------------------------------------------------------------------------------------
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
-IF (LHOOK) CALL DR_HOOK('ASSIM_TOWN_N',0,ZHOOK_HANDLE)
-
-IF (HTEST/='OK') THEN
- CALL ABOR1_SFX('ASSIM_TOWN_n: FATAL ERROR DURING ARGUMENT TRANSFER')
-END IF
-
-IF (U%CTOWN=='TEB ') THEN
- CALL ASSIM_TEB_n(U, T, TOP, &
- HPROGRAM,KI,PT2M_O,HTEST)
-ELSE
- IF (NRANK==NPIO) WRITE(*,*) 'No assimilation done for scheme: ',TRIM(U%CTOWN)
-END IF
-
-IF (LHOOK) CALL DR_HOOK('ASSIM_TOWN_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE ASSIM_TOWN_n
diff --git a/src/SURFEX/autogen_modintfb.h b/src/SURFEX/autogen_modintfb.h
deleted file mode 100644
index 53a66efadc5e9ae22508e3f78d657c1ac0e263fc..0000000000000000000000000000000000000000
--- a/src/SURFEX/autogen_modintfb.h
+++ /dev/null
@@ -1,13 +0,0 @@
-! DO NOT REMOVE THIS FILE PLEASE !!
-! It is here to signal that subroutine interfaces are generated automatically
-! (see make_intfbl_f90.pl in the main directory)
-! Though never included, it is named like a header in order to make sure that
-! a cleaning of the directory would not remove it.
-! It may be helpful later to give some precision about the method how to generate
-! the interfaces modules.
-! Ryad El Khatib 23-June-2011
-
-! The next line will tell the build system that interfaces should be auto-generated:
-!#include "dummy.intfb.h"
-
-
diff --git a/src/SURFEX/av_pgd.F90 b/src/SURFEX/av_pgd.F90
index 430022c2b6c2996927a6b4f98213e9d040ef9536..0c2345988c45b2247df585744e18b03f3af9fb1e 100644
--- a/src/SURFEX/av_pgd.F90
+++ b/src/SURFEX/av_pgd.F90
@@ -103,7 +103,6 @@ END SUBROUTINE MAJOR_PATCH_PGD_1D
END INTERFACE
END MODULE MODI_AV_PGD
!
-!
! ################################################################
SUBROUTINE AV_PGD_1D (DTCO, &
PFIELD,PCOVER,PDATA,HSFTYPE,HATYPE,OCOVER,PDZ,KDECADE)
@@ -162,12 +161,16 @@ END MODULE MODI_AV_PGD
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
!
+USE MODD_SURFEX_OMP, ONLY : NBLOCKTOT
+USE MODD_SURFEX_MPI, ONLY : NRANK
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_DATA_COVER, ONLY : XDATA_BLD_HEIGHT
USE MODD_DATA_COVER_PAR, ONLY : NVT_TEBD, NVT_BONE, NVT_TRBE, XCDREF, NVT_TRBD, &
NVT_TEBE, NVT_TENE, NVT_BOBD, NVT_BOND, NVT_SHRB
!
!
+USE MODE_AV_PGD
+!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -194,24 +197,24 @@ INTEGER, INTENT(IN), OPTIONAL :: KDECADE ! current month
!* 0.2 Declaration of local variables
! ------------------------------
!
-INTEGER :: JJ
+INTEGER :: JJ, JI, ID0
INTEGER :: ICOVER ! number of cover classes
INTEGER :: JCOVER ! loop on cover classes
!
-REAL, DIMENSION(SIZE(PCOVER,1)) :: ZWORK, ZDZ
-REAL :: ZWEIGHT
-REAL, DIMENSION(SIZE(PCOVER,1)) :: ZCOVER_WEIGHT
-REAL :: ZDATA
+INTEGER :: ISIZE_OMP
+INTEGER, DIMENSION(SIZE(PCOVER,2)) :: IMASK
+REAL, DIMENSION(SIZE(PCOVER,1)) :: ZWORK, ZDZ, ZVAL
+REAL, DIMENSION(SIZE(PCOVER,2)) :: ZWEIGHT
+REAL :: ZCOVER_WEIGHT
REAL, DIMENSION(SIZE(PCOVER,1)) :: ZSUM_COVER_WEIGHT
-REAL, DIMENSION(SIZE(PCOVER,1)) :: ZWEIGHT_MAX
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!-------------------------------------------------------------------------------
!
!* 1.1 field does not exist
! --------------------
!
-IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PGD_1D',0,ZHOOK_HANDLE)
-IF (SIZE(PFIELD)==0 .AND. LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PGD_1D',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PGD_1D_1',0,ZHOOK_HANDLE)
+IF (SIZE(PFIELD)==0 .AND. LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PGD_1D_1',1,ZHOOK_HANDLE)
IF (SIZE(PFIELD)==0) RETURN
!
!-------------------------------------------------------------------------------
@@ -219,7 +222,7 @@ IF (SIZE(PFIELD)==0) RETURN
!* 1.2 Initializations
! ---------------
!
-ICOVER=SIZE(OCOVER)
+ICOVER=SIZE(PCOVER,2)
!
IF (PRESENT(PDZ)) THEN
ZDZ(:)=PDZ(:)
@@ -228,80 +231,20 @@ ELSE
END IF
!
PFIELD(:)=XUNDEF
+IF (HSFTYPE=='TRE' .OR. HSFTYPE=='GRT') PFIELD(:) = 0.
!
ZWORK(:)=0.
-ZWEIGHT_MAX(:)=0.
ZSUM_COVER_WEIGHT(:)=0.
-!-------------------------------------------------------------------------------
+!
JCOVER = 0
-DO JJ=1,ICOVER
- !
- IF (.NOT.OCOVER(JJ)) CYCLE
- !
- JCOVER = JCOVER + 1
- !
-!-------------------------------------------------------------------------------
+DO JJ = 1,SIZE(OCOVER)
+ IF (OCOVER(JJ)) THEN
+ JCOVER=JCOVER+1
+ IMASK(JCOVER) = JJ
+ ENDIF
+ENDDO
!
-!* 2. Selection of the weighting function
-! -----------------------------------
-!
- SELECT CASE (HSFTYPE)
- CASE('ALL')
- ZWEIGHT=1.
-
- CASE('NAT')
- ZWEIGHT=DTCO%XDATA_NATURE(JJ)
-
- CASE('GRD')
- ZWEIGHT=DTCO%XDATA_TOWN (JJ) * DTCO%XDATA_GARDEN(JJ)
-
- CASE('TWN')
- ZWEIGHT=DTCO%XDATA_TOWN (JJ)
-
- CASE('WAT')
- ZWEIGHT=DTCO%XDATA_WATER (JJ)
-
- CASE('SEA')
- ZWEIGHT=DTCO%XDATA_SEA (JJ)
-
- CASE('BLD')
- ZWEIGHT=DTCO%XDATA_TOWN (JJ) * DTCO%XDATA_BLD(JJ)
-
- CASE('BLV') !* building Volume
- ZWEIGHT=DTCO%XDATA_TOWN (JJ) * DTCO%XDATA_BLD(JJ) &
- * XDATA_BLD_HEIGHT(JJ)
-
- CASE('STR')
- ZWEIGHT=DTCO%XDATA_TOWN (JJ) * ( 1. - DTCO%XDATA_BLD(JJ) )
-
- CASE('TRE')
- PFIELD(:)=0.
- ZWEIGHT=DTCO%XDATA_NATURE(JJ) * ( DTCO%XDATA_VEGTYPE(JJ,NVT_TEBD) &
- + DTCO%XDATA_VEGTYPE(JJ,NVT_TRBE) &
- + DTCO%XDATA_VEGTYPE(JJ,NVT_TRBD) &
- + DTCO%XDATA_VEGTYPE(JJ,NVT_TEBE) &
- + DTCO%XDATA_VEGTYPE(JJ,NVT_TENE) &
- + DTCO%XDATA_VEGTYPE(JJ,NVT_BOBD) &
- + DTCO%XDATA_VEGTYPE(JJ,NVT_BOND) &
- + DTCO%XDATA_VEGTYPE(JJ,NVT_SHRB) &
- + DTCO%XDATA_VEGTYPE(JJ,NVT_BONE) )
-
- CASE('GRT')
- PFIELD(:)=0.
- ZWEIGHT=DTCO%XDATA_TOWN(JJ) * DTCO%XDATA_GARDEN(JJ) &
- * ( DTCO%XDATA_VEGTYPE(JJ,NVT_TEBD) &
- + DTCO%XDATA_VEGTYPE(JJ,NVT_TRBE) &
- + DTCO%XDATA_VEGTYPE(JJ,NVT_TRBD) &
- + DTCO%XDATA_VEGTYPE(JJ,NVT_TEBE) &
- + DTCO%XDATA_VEGTYPE(JJ,NVT_TENE) &
- + DTCO%XDATA_VEGTYPE(JJ,NVT_BOBD) &
- + DTCO%XDATA_VEGTYPE(JJ,NVT_BOND) &
- + DTCO%XDATA_VEGTYPE(JJ,NVT_SHRB) &
- + DTCO%XDATA_VEGTYPE(JJ,NVT_BONE) )
-
- CASE DEFAULT
- CALL ABOR1_SFX('AV_PGD_1D: WEIGHTING FUNCTION NOT ALLOWED '//HSFTYPE)
- END SELECT
+ CALL GET_WEIGHT(DTCO,ICOVER,IMASK,HSFTYPE,ZWEIGHT)
!
!-------------------------------------------------------------------------------
!
@@ -311,66 +254,60 @@ DO JJ=1,ICOVER
!* 3.1 Work arrays
! -----------
!
- ZCOVER_WEIGHT(:) = PCOVER(:,JCOVER) * ZWEIGHT
-!
- ZSUM_COVER_WEIGHT(:) = ZSUM_COVER_WEIGHT(:) + ZCOVER_WEIGHT(:)
-!
- ZDATA = PDATA(JJ)
-!
-!* 3.2 Selection of averaging type
-! ---------------------------
-!
- SELECT CASE (HATYPE)
-!
-!-------------------------------------------------------------------------------
-!
-!* 3.4 Arithmetic averaging
-! --------------------
-!
- CASE ('ARI')
-!
- ZWORK(:) = ZWORK(:) + ZDATA * ZCOVER_WEIGHT(:)
-!
-!-------------------------------------------------------------------------------
-!
-!* 3.5 Inverse averaging
-! -----------------
-!
- CASE('INV' )
-!
- ZWORK (:)= ZWORK(:) + 1./ZDATA * ZCOVER_WEIGHT(:)
-!
-!-------------------------------------------------------------------------------!
-!
-!* 3.6 Roughness length averaging
-! --------------------------
-
-!
- CASE('CDN')
-!
- ZWORK (:)= ZWORK(:) + 1./(LOG(ZDZ(:)/ZDATA))**2 * ZCOVER_WEIGHT(:)
-!
-!-------------------------------------------------------------------------------
-!
-!* 3.7 Majoritary averaging
-! --------------------
-!
- CASE('MAJ' )
-!
- WHERE(ZCOVER_WEIGHT(:)>ZWEIGHT_MAX(:))
- ZWEIGHT_MAX(:) = ZCOVER_WEIGHT(:)
- ZWORK (:) = ZDATA
- END WHERE
+CALL DR_HOOK('MODI_AV_PGD:AV_PGD_1D_1',1,ZHOOK_HANDLE)
!
-!-------------------------------------------------------------------------------
-!
- CASE DEFAULT
- CALL ABOR1_SFX('AV_PGD_1D: (1) AVERAGING TYPE NOT ALLOWED : "'//HATYPE//'"')
-!
- END SELECT
-!
-END DO
+IF (HATYPE=='ARI' .OR. HATYPE=='INV' .OR. HATYPE=='CDN') THEN
+ !
+ ISIZE_OMP = MAX(1,ICOVER/NBLOCKTOT)
+!!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+ CALL DR_HOOK('MODI_AV_PGD:AV_PGD_1D_2',0,ZHOOK_HANDLE_OMP)
+!!$OMP DO SCHEDULE(STATIC,ISIZE_OMP) PRIVATE(JCOVER,JJ,ZVAL,JI,ZCOVER_WEIGHT) &
+!!$OMP & REDUCTION(+:ZSUM_COVER_WEIGHT,ZWORK)
+ DO JCOVER=1,ICOVER
+ IF (ZWEIGHT(JCOVER)/=0.) THEN
+ !
+ JJ = IMASK(JCOVER)
+ !
+ IF (HATYPE=='ARI') THEN
+ ZVAL(:) = PDATA(JJ)
+ ELSEIF (HATYPE=='INV') THEN
+ ZVAL(:) = 1./PDATA(JJ)
+ ELSEIF (HATYPE=='CDN') THEN
+ ZVAL(:) = 1./(LOG(ZDZ(:)/PDATA(JJ)))**2
+ ENDIF
+ !
+ DO JI = 1,SIZE(PCOVER,1)
+ IF (PCOVER(JI,JCOVER)/=0.) THEN
+ ZCOVER_WEIGHT = PCOVER(JI,JCOVER) * ZWEIGHT(JCOVER)
+ ZSUM_COVER_WEIGHT(JI) = ZSUM_COVER_WEIGHT(JI) + ZCOVER_WEIGHT
+ ZWORK(JI) = ZWORK(JI) + ZVAL(JI) * ZCOVER_WEIGHT
+ ENDIF
+ ENDDO
+ !
+ ENDIF
+ ENDDO
+!!$OMP END DO
+ CALL DR_HOOK('MODI_AV_PGD:AV_PGD_1D_2',1,ZHOOK_HANDLE_OMP)
+!!$OMP END PARALLEL
+ELSEIF (HATYPE=='MAJ') THEN
+ !
+!!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PGD_1D_3',0,ZHOOK_HANDLE_OMP)
+!!$OMP DO SCHEDULE(DYNAMIC,1) PRIVATE(JI,ID0)
+ DO JI = 1,SIZE(PCOVER,1)
+ ID0 = MAXVAL(MAXLOC(PCOVER(JI,:)*ZWEIGHT(:)))
+ ZWORK(JI) = PDATA(IMASK(ID0))
+ ZSUM_COVER_WEIGHT(JI) = ZSUM_COVER_WEIGHT(JI) + SUM(PCOVER(JI,:)*ZWEIGHT(:))
+ ENDDO
+!!$OMP END DO
+IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PGD_1D_3',1,ZHOOK_HANDLE_OMP)
+!!$OMP END PARALLEL
+ !
+ELSE
+ CALL ABOR1_SFX('AV_PGD_1D: (1) AVERAGING TYPE NOT ALLOWED : "'//HATYPE//'"')
+ENDIF
!
+IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PGD_1D_4',0,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
!* 4. End of Averaging
@@ -432,15 +369,13 @@ END DO
CALL ABOR1_SFX('AV_PGD_1D: (2) AVERAGING TYPE NOT ALLOWED')
!
END SELECT
-IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PGD_1D',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PGD_1D_4',1,ZHOOK_HANDLE)
!
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE AV_PGD_1D
!
-!
-!
! ################################################################
SUBROUTINE AV_PATCH_PGD_1D (DTCO, &
PFIELD,PCOVER,PDATA,HSFTYPE,HATYPE,OCOVER,PDZ,KDECADE)
@@ -505,7 +440,7 @@ USE MODD_DATA_COVER_PAR, ONLY : NVT_TEBD, NVT_BONE, NVT_TRBE, NVEGTYPE, XCDREF,
NVT_TEBE, NVT_TENE, NVT_BOBD, NVT_BOND, NVT_SHRB
!
USE MODI_VEGTYPE_TO_PATCH
-!
+USE MODE_AV_PGD
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -546,6 +481,7 @@ INTEGER :: JJ, JI, JK
!
REAL :: ZCOVER_WEIGHT
!
+INTEGER, DIMENSION(SIZE(PCOVER,2)) :: IMASK0
REAL, DIMENSION(SIZE(PCOVER,1)) :: ZVAL
!
REAL, DIMENSION(SIZE(PCOVER,2),NVEGTYPE) :: ZWEIGHT
@@ -558,16 +494,15 @@ REAL, DIMENSION(SIZE(PCOVER,1),SIZE(PFIELD,2)) :: ZDZ
INTEGER, DIMENSION(SIZE(PCOVER,1),SIZE(PFIELD,2)) :: IMASK
INTEGER, DIMENSION(SIZE(PFIELD,2)) :: JCOUNT
INTEGER :: PATCH_LIST(NVEGTYPE)
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!-------------------------------------------------------------------------------
!
!* 1.1 field does not exist
! --------------------
!
-!IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PATCH_PGD_1D',0,ZHOOK_HANDLE)
IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PATCH_PGD_1D_1',0,ZHOOK_HANDLE)
-IF (SIZE(PFIELD)==0 .AND. LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PATCH_PGD_1D',1,ZHOOK_HANDLE)
+IF (SIZE(PFIELD)==0 .AND. LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PATCH_PGD_1D_1',1,ZHOOK_HANDLE)
IF (SIZE(PFIELD)==0) RETURN
!
!-------------------------------------------------------------------------------
@@ -575,7 +510,7 @@ IF (SIZE(PFIELD)==0) RETURN
!* 1.2 Initializations
! ---------------
!
-ICOVER=SIZE(OCOVER)
+ICOVER=SIZE(PCOVER,2)
IPATCH=SIZE(PFIELD,2)
!
IF (PRESENT(PDZ)) THEN
@@ -596,125 +531,19 @@ DO JVEGTYPE=1,NVEGTYPE
PATCH_LIST(JVEGTYPE) = VEGTYPE_TO_PATCH (JVEGTYPE, IPATCH)
ENDDO
!
+JCOVER = 0
+DO JJ = 1,SIZE(OCOVER)
+ IF (OCOVER(JJ)) THEN
+ JCOVER=JCOVER+1
+ IMASK0(JCOVER) = JJ
+ ENDIF
+ENDDO
+!
IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PATCH_PGD_1D_1',1,ZHOOK_HANDLE)
IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PATCH_PGD_1D_2',0,ZHOOK_HANDLE)
!
-IF (.NOT.ASSOCIATED(DTCO%XDATA_WEIGHT)) THEN
- !
- ALLOCATE(DTCO%XDATA_WEIGHT(SIZE(PCOVER,2),NVEGTYPE,12))
- DTCO%XDATA_WEIGHT(:,:,:) = 0.
- !
- JCOVER=0
- DO JJ=1,ICOVER
- !
- IF (.NOT.OCOVER(JJ)) CYCLE
- !
- JCOVER = JCOVER+1
- !
- DO JVEGTYPE=1,NVEGTYPE
- ! CASE('NAT')
- IF (DTCO%XDATA_VEGTYPE(JJ,JVEGTYPE)==0.) CYCLE
- !
- DTCO%XDATA_WEIGHT(JCOVER,JVEGTYPE,1)= DTCO%XDATA_NATURE(JJ) * DTCO%XDATA_VEGTYPE(JJ,JVEGTYPE)
- !CASE('GRD')
- DTCO%XDATA_WEIGHT(JCOVER,JVEGTYPE,2)= DTCO%XDATA_TOWN(JJ)*DTCO%XDATA_GARDEN(JJ) * DTCO%XDATA_VEGTYPE(JJ,JVEGTYPE)
- !CASE('VEG')
- DTCO%XDATA_WEIGHT(JCOVER,JVEGTYPE,3)= DTCO%XDATA_WEIGHT(JCOVER,JVEGTYPE,1) * XDATA_VEG(JJ,KDECADE,JVEGTYPE)
- !CASE('BAR')
- DTCO%XDATA_WEIGHT(JCOVER,JVEGTYPE,4)= DTCO%XDATA_WEIGHT(JCOVER,JVEGTYPE,1) * (1.-XDATA_VEG(JJ,KDECADE,JVEGTYPE))
- !CASE('GRV')
- DTCO%XDATA_WEIGHT(JCOVER,JVEGTYPE,5)= DTCO%XDATA_WEIGHT(JCOVER,JVEGTYPE,2) * XDATA_VEG(JJ,KDECADE,JVEGTYPE)
- !CASE('GRB')
- DTCO%XDATA_WEIGHT(JCOVER,JVEGTYPE,6)= DTCO%XDATA_WEIGHT(JCOVER,JVEGTYPE,2) * (1.-XDATA_VEG(JJ,KDECADE,JVEGTYPE))
- IF ( SUM(XDATA_LAI(JJ,:,JVEGTYPE)) .GT. 0.0) THEN
- !CASE('DVG') ! for diffusion scheme only
- DTCO%XDATA_WEIGHT(JCOVER,JVEGTYPE,7)= DTCO%XDATA_WEIGHT(JCOVER,JVEGTYPE,1)
- !CASE('GDV') ! for diffusion scheme only
- DTCO%XDATA_WEIGHT(JCOVER,JVEGTYPE,8)= DTCO%XDATA_WEIGHT(JCOVER,JVEGTYPE,2)
- ENDIF
- !CASE('LAI')
- DTCO%XDATA_WEIGHT(JCOVER,JVEGTYPE,9)= DTCO%XDATA_WEIGHT(JCOVER,JVEGTYPE,1) * XDATA_LAI(JJ,KDECADE,JVEGTYPE)
- !CASE('GRL')
- DTCO%XDATA_WEIGHT(JCOVER,JVEGTYPE,10)= DTCO%XDATA_WEIGHT(JCOVER,JVEGTYPE,2) * XDATA_LAI(JJ,KDECADE,JVEGTYPE)
- !
- !Tree vegtype
- !
- !CASE('TRE')
- !CASE('GRT')
- IF (JVEGTYPE==NVT_TEBD) THEN
- DTCO%XDATA_WEIGHT(JCOVER,NVT_TEBD,11)= DTCO%XDATA_WEIGHT(JCOVER,NVT_TEBD,1)
- DTCO%XDATA_WEIGHT(JCOVER,NVT_TEBD,12)= DTCO%XDATA_WEIGHT(JCOVER,NVT_TEBD,2)
- ENDIF
- IF (JVEGTYPE==NVT_BONE) THEN
- DTCO%XDATA_WEIGHT(JCOVER,NVT_BONE,11)= DTCO%XDATA_WEIGHT(JCOVER,NVT_BONE,1)
- DTCO%XDATA_WEIGHT(JCOVER,NVT_BONE,12)= DTCO%XDATA_WEIGHT(JCOVER,NVT_BONE,2)
- ENDIF
- IF (JVEGTYPE==NVT_TRBE) THEN
- DTCO%XDATA_WEIGHT(JCOVER,NVT_TRBE,11)= DTCO%XDATA_WEIGHT(JCOVER,NVT_TRBE,1)
- DTCO%XDATA_WEIGHT(JCOVER,NVT_TRBE,12)= DTCO%XDATA_WEIGHT(JCOVER,NVT_TRBE,2)
- ENDIF
- IF (JVEGTYPE==NVT_TRBD) THEN
- DTCO%XDATA_WEIGHT(JCOVER,NVT_TRBD,11)= DTCO%XDATA_WEIGHT(JCOVER,NVT_TRBD,1)
- DTCO%XDATA_WEIGHT(JCOVER,NVT_TRBD,12)= DTCO%XDATA_WEIGHT(JCOVER,NVT_TRBD,2)
- ENDIF
- IF (JVEGTYPE==NVT_TEBE) THEN
- DTCO%XDATA_WEIGHT(JCOVER,NVT_TEBE,11)= DTCO%XDATA_WEIGHT(JCOVER,NVT_TEBE,1)
- DTCO%XDATA_WEIGHT(JCOVER,NVT_TEBE,12)= DTCO%XDATA_WEIGHT(JCOVER,NVT_TEBE,2)
- ENDIF
- IF (JVEGTYPE==NVT_TENE) THEN
- DTCO%XDATA_WEIGHT(JCOVER,NVT_TENE,11)= DTCO%XDATA_WEIGHT(JCOVER,NVT_TENE,1)
- DTCO%XDATA_WEIGHT(JCOVER,NVT_TENE,12)= DTCO%XDATA_WEIGHT(JCOVER,NVT_TENE,2)
- ENDIF
- IF (JVEGTYPE==NVT_BOBD) THEN
- DTCO%XDATA_WEIGHT(JCOVER,NVT_BOBD,11)= DTCO%XDATA_WEIGHT(JCOVER,NVT_BOBD,1)
- DTCO%XDATA_WEIGHT(JCOVER,NVT_BOBD,12)= DTCO%XDATA_WEIGHT(JCOVER,NVT_BOBD,2)
- ENDIF
- IF (JVEGTYPE==NVT_BOND) THEN
- DTCO%XDATA_WEIGHT(JCOVER,NVT_BOND,11)= DTCO%XDATA_WEIGHT(JCOVER,NVT_BOND,1)
- DTCO%XDATA_WEIGHT(JCOVER,NVT_BOND,12)= DTCO%XDATA_WEIGHT(JCOVER,NVT_BOND,2)
- ENDIF
- IF (JVEGTYPE==NVT_SHRB) THEN
- DTCO%XDATA_WEIGHT(JCOVER,NVT_SHRB,11)= DTCO%XDATA_WEIGHT(JCOVER,NVT_SHRB,1)
- DTCO%XDATA_WEIGHT(JCOVER,NVT_SHRB,12)= DTCO%XDATA_WEIGHT(JCOVER,NVT_SHRB,2)
- ENDIF
- !
- ENDDO
- !
- ENDDO
- !
-ENDIF
-!
-SELECT CASE (HSFTYPE)
- CASE('NAT')
- ZWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,1)
- CASE('GRD')
- ZWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,2)
- CASE('VEG')
- ZWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,3)
- CASE('BAR')
- ZWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,4)
- CASE('GRV')
- ZWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,5)
- CASE('GRB')
- ZWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,6)
- CASE('DVG')
- ZWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,7)
- CASE('GDV')
- ZWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,8)
- CASE('LAI')
- ZWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,9)
- CASE('GRL')
- ZWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,10)
- CASE('TRE')
- ZWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,11)
- CASE('GRT')
- ZWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,12)
- CASE DEFAULT
- CALL ABOR1_SFX('AV_PATCH_PGD_1D: WEIGHTING FUNCTION FOR VEGTYPE NOT ALLOWED')
-END SELECT
-!
-IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PATCH_PGD_1D_2',1,ZHOOK_HANDLE)
-IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PATCH_PGD_1D_3',0,ZHOOK_HANDLE)
+ CALL GET_WEIGHT_PATCH(DTCO,ICOVER,IMASK0,KDECADE,HSFTYPE,ZWEIGHT)
+ !
!
!-------------------------------------------------------------------------------
!
@@ -722,51 +551,51 @@ IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PATCH_PGD_1D_3',0,ZHOOK_HANDLE)
!* 2. Selection of the weighting function for vegtype
! -----------------------------------
!
-JCOVER=0
+IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PATCH_PGD_1D_2',1,ZHOOK_HANDLE)
!
-DO JJ=1,ICOVER
+!!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP) REDUCTION(+:ZSUM_COVER_WEIGHT_PATCH,ZWORK)
+IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PATCH_PGD_1D_3',0,ZHOOK_HANDLE_OMP)
+!!$OMP DO SCHEDULE(DYNAMIC,1) PRIVATE(JCOVER,JJ,JVEGTYPE,JPATCH, &
+!!$OMP ZVAL,JI,ZCOVER_WEIGHT)
+DO JCOVER=1,ICOVER
!
- IF (OCOVER(JJ)) THEN
+ JJ = IMASK0(JCOVER)
+ !
+ DO JVEGTYPE=1,NVEGTYPE
!
- JCOVER = JCOVER+1
+ JPATCH= PATCH_LIST(JVEGTYPE)
!
- DO JVEGTYPE=1,NVEGTYPE
- !
- JPATCH= PATCH_LIST(JVEGTYPE)
+ IF (ZWEIGHT(JCOVER,JVEGTYPE)/=0.) THEN
!
- IF (ZWEIGHT(JCOVER,JVEGTYPE)/=0.) THEN
- !
- IF (HATYPE=='ARI') THEN
- ZVAL(:) = PDATA(JJ,JVEGTYPE)
- ELSEIF (HATYPE=='INV') THEN
- ZVAL(:) = 1. / PDATA(JJ,JVEGTYPE)
- ELSEIF (HATYPE=='CDN') THEN
- DO JI=1,SIZE(PCOVER,1)
- ZVAL(JI) = 1./(LOG(ZDZ(JI,JPATCH)/PDATA(JJ,JVEGTYPE)))**2
- ENDDO
- ELSE
- CALL ABOR1_SFX('AV_PATCH_PGD_1D: (1) AVERAGING TYPE NOT ALLOWED')
- ENDIF
- !
-!$OMP PARALLEL DO PRIVATE(JI,ZCOVER_WEIGHT)
+ IF (HATYPE=='ARI') THEN
+ ZVAL(:) = PDATA(JJ,JVEGTYPE)
+ ELSEIF (HATYPE=='INV') THEN
+ ZVAL(:) = 1. / PDATA(JJ,JVEGTYPE)
+ ELSEIF (HATYPE=='CDN') THEN
DO JI=1,SIZE(PCOVER,1)
- IF (PCOVER(JI,JCOVER)/=0.) THEN
- ZCOVER_WEIGHT = PCOVER(JI,JCOVER) * ZWEIGHT(JCOVER,JVEGTYPE)
- ZSUM_COVER_WEIGHT_PATCH(JI,JPATCH) = ZSUM_COVER_WEIGHT_PATCH(JI,JPATCH) + ZCOVER_WEIGHT
- ZWORK(JI,JPATCH) = ZWORK(JI,JPATCH) + ZVAL(JI) * ZCOVER_WEIGHT
- ENDIF
+ ZVAL(JI) = 1./(LOG(ZDZ(JI,JPATCH)/PDATA(JJ,JVEGTYPE)))**2
ENDDO
-!$OMP END PARALLEL DO
- !
+ ELSE
+ CALL ABOR1_SFX('AV_PATCH_PGD_1D: (1) AVERAGING TYPE NOT ALLOWED')
ENDIF
- !
- ENDDO
+ !
+ DO JI=1,SIZE(PCOVER,1)
+ IF (PCOVER(JI,JCOVER)/=0.) THEN
+ ZCOVER_WEIGHT = PCOVER(JI,JCOVER) * ZWEIGHT(JCOVER,JVEGTYPE)
+ ZSUM_COVER_WEIGHT_PATCH(JI,JPATCH) = ZSUM_COVER_WEIGHT_PATCH(JI,JPATCH) + ZCOVER_WEIGHT
+ ZWORK(JI,JPATCH) = ZWORK(JI,JPATCH) + ZVAL(JI) * ZCOVER_WEIGHT
+ ENDIF
+ ENDDO
+ !
+ ENDIF
!
- ENDIF
+ ENDDO
!
ENDDO
+!!$OMP END DO
+IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PATCH_PGD_1D_3',1,ZHOOK_HANDLE_OMP)
+!!$OMP END PARALLEL
!
-IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PATCH_PGD_1D_3',1,ZHOOK_HANDLE)
IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PATCH_PGD_1D_4',0,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
@@ -1574,6 +1403,7 @@ IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:AV_PATCH_PGD',1,ZHOOK_HANDLE)
!
END SUBROUTINE AV_PATCH_PGD
!
+!
! ################################################################
SUBROUTINE MAJOR_PATCH_PGD_1D(TFIELD,PCOVER,TDATA,HSFTYPE,HATYPE,OCOVER,KDECADE)
! ################################################################
@@ -1616,6 +1446,8 @@ USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
!
USE MODI_VEGTYPE_TO_PATCH
!
+USE MODE_AV_PGD
+!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -1671,7 +1503,7 @@ TFIELD(:,:)%TIME = XUNDEF
!
IDOY(:) = 0
!
- CALL DATE2DOY(TDATA,IDATA_DOY)
+ CALL DATE2DOY(TDATA,OCOVER,IDATA_DOY)
!-------------------------------------------------------------------------------
DO JP = 1,SIZE(PCOVER,1)
!
@@ -1713,66 +1545,7 @@ END DO
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:MAJOR_PATCH_PGD_1D',1,ZHOOK_HANDLE)
- CONTAINS
-
-SUBROUTINE DATE2DOY(TPDATA, KDOY)
-TYPE (DATE_TIME), DIMENSION(:,:), INTENT(IN) :: TPDATA
-INTEGER, DIMENSION(:,:), INTENT(OUT) :: KDOY
-INTEGER, DIMENSION(SIZE(OCOVER),NVEGTYPE) :: IMONTH, IDAY
-INTEGER, PARAMETER, DIMENSION(12) :: TAB=(/1,32,60,91,121,152,182,213,244,274,305,335/)
-INTEGER :: JCOVER, JJ
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
-IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:DATE2DOY',0,ZHOOK_HANDLE)
-!
-IMONTH(:,:) = TPDATA(:,:)%TDATE%MONTH
-IDAY(:,:) = TPDATA(:,:)%TDATE%DAY
!
-KDOY(:,:) = NUNDEF
-!
-JCOVER = 0
-DO JJ = 1, SIZE(OCOVER)
- IF (.NOT.OCOVER(JJ)) CYCLE
- JCOVER = JCOVER + 1
- DO JVEGTYPE = 1, NVEGTYPE
- IF (IMONTH(JJ,JVEGTYPE)/=NUNDEF .AND. IDAY(JJ,JVEGTYPE) /= NUNDEF) THEN
- KDOY(JCOVER,JVEGTYPE) = TAB(IMONTH(JJ,JVEGTYPE)) + IDAY(JJ,JVEGTYPE) - 1
- ENDIF
- END DO
-END DO
-IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:DATE2DOY',1,ZHOOK_HANDLE)
-
-END SUBROUTINE DATE2DOY
-
-SUBROUTINE DOY2DATE(KDOY,KMONTH,KDAY)
-INTEGER, INTENT(IN) :: KDOY
-INTEGER, INTENT(OUT) :: KMONTH, KDAY
-REAL :: ZWORK(12)
-INTEGER, PARAMETER, DIMENSION(12) :: ZTAB=(/31.,59.,90.,120.,151.,181.,212.,243.,273.,304.,334.,365./)
-INTEGER :: J
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
-IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:DOY2DATE',0,ZHOOK_HANDLE)
-!
-KMONTH = NUNDEF
-KDAY = NUNDEF
-!
-ZWORK(1) = REAL(KDOY) / ZTAB(1)
-IF ( INT(ZWORK(1))==0 .AND. ZWORK(1)/=0.) THEN
- KMONTH = 1
- KDAY = KDOY
-ENDIF
-!
-DO J = 2, 12
- ZWORK(J) = REAL(KDOY) / ZTAB(J)
- IF ( INT(ZWORK(J))==0 .AND. INT(ZWORK(J-1))==1 ) THEN
- KMONTH = J
- KDAY = KDOY - INT(ZTAB(J-1))
- ENDIF
-END DO
-IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD:DOY2DATE',1,ZHOOK_HANDLE)
-
-END SUBROUTINE DOY2DATE
+END SUBROUTINE MAJOR_PATCH_PGD_1D
!-------------------------------------------------------------------------------
!
-END SUBROUTINE MAJOR_PATCH_PGD_1D
diff --git a/src/SURFEX/av_pgd_1p.F90 b/src/SURFEX/av_pgd_1p.F90
new file mode 100644
index 0000000000000000000000000000000000000000..ae18ab5b13e5435f7c2f645283aaba91b4823c3b
--- /dev/null
+++ b/src/SURFEX/av_pgd_1p.F90
@@ -0,0 +1,759 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! ##################
+ MODULE MODI_AV_PGD_1P
+! ##################
+INTERFACE AV_PGD_1P
+!
+ SUBROUTINE AV_PGD_1D_1P (DTCO, &
+ PFIELD,PCOVER,PDATA,HSFTYPE,HATYPE,OCOVER,KMASK,KPATCH,KNPATCH,PDZ,KDECADE)
+!
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PFIELD ! secondary field to construct
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOVER ! fraction of each cover class
+REAL, DIMENSION(:), INTENT(IN) :: PDATA ! secondary field value for each class
+ CHARACTER(LEN=3), INTENT(IN) :: HSFTYPE ! Type of surface where the field
+ ! is defined
+ CHARACTER(LEN=3), INTENT(IN) :: HATYPE ! Type of averaging
+LOGICAL, DIMENSION(:), INTENT(IN) :: OCOVER
+INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
+INTEGER, INTENT(IN) :: KNPATCH
+INTEGER, INTENT(IN) :: KPATCH
+REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: PDZ ! first model half level
+INTEGER, INTENT(IN), OPTIONAL :: KDECADE ! current month
+!
+END SUBROUTINE AV_PGD_1D_1P
+! ################################################################
+ SUBROUTINE AV_PATCH_PGD_1D_1P (DTCO, &
+ PFIELD,PCOVER,PDATA,HSFTYPE,HATYPE,OCOVER,KMASK,KNPATCH,KPATCH,PDZ,KDECADE)
+! ################################################################
+!
+!
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PFIELD ! secondary field to construct
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOVER ! fraction of each cover class
+REAL, DIMENSION(:,:), INTENT(IN) :: PDATA ! secondary field value for each class
+ CHARACTER(LEN=3), INTENT(IN) :: HSFTYPE ! Type of surface where the field
+ ! is defined
+ CHARACTER(LEN=3), INTENT(IN) :: HATYPE ! Type of averaging
+LOGICAL, DIMENSION(:), INTENT(IN) :: OCOVER
+INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
+INTEGER, INTENT(IN) :: KNPATCH
+INTEGER, INTENT(IN) :: KPATCH
+REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: PDZ ! first model half level
+INTEGER, INTENT(IN), OPTIONAL :: KDECADE ! current month
+!
+END SUBROUTINE AV_PATCH_PGD_1D_1P
+!
+! ################################################################
+ SUBROUTINE MAJOR_PATCH_PGD_1D_1P(TFIELD,PCOVER,TDATA,HSFTYPE,HATYPE,&
+ OCOVER,KMASK,KNPATCH,KPATCH,KDECADE)
+! ################################################################
+!
+!* 0. DECLARATION
+! -----------
+!
+USE MODD_TYPE_DATE_SURF
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TFIELD ! secondary field to construct
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOVER ! fraction of each cover class
+TYPE (DATE_TIME), DIMENSION(:,:), INTENT(IN) :: TDATA ! secondary field value for each class
+ CHARACTER(LEN=3), INTENT(IN) :: HSFTYPE ! Type of surface where the field
+ ! is defined
+ CHARACTER(LEN=3), INTENT(IN) :: HATYPE ! Type of averaging
+LOGICAL, DIMENSION(:), INTENT(IN) :: OCOVER
+INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
+INTEGER, INTENT(IN) :: KNPATCH
+INTEGER, INTENT(IN) :: KPATCH
+INTEGER, INTENT(IN), OPTIONAL :: KDECADE ! current month
+!
+END SUBROUTINE MAJOR_PATCH_PGD_1D_1P
+!
+END INTERFACE
+END MODULE MODI_AV_PGD_1P
+!
+! ################################################################
+ SUBROUTINE AV_PGD_1D_1P (DTCO, PFIELD,PCOVER,PDATA,HSFTYPE,HATYPE,OCOVER,&
+ KMASK, KPATCH, KNPATCH, PDZ, KDECADE)
+! ################################################################
+!
+!!**** *AV_PGD* average a secondary physiographic variable from the
+!! fractions of coverage class.
+!!
+!! PURPOSE
+!! -------
+!!
+!! METHOD
+!! ------
+!!
+!! The averaging is performed with one way into three:
+!!
+!! - arithmetic averaging (HATYPE='ARI')
+!!
+!! - inverse averaging (HATYPE='INV')
+!!
+!! - inverse of square logarithm averaging (HATYPE='CDN') :
+!!
+!! 1 / ( ln (dz/data) )**2
+!!
+!! This latest uses (if available) the height of the first model mass
+!! level. In the other case, 20m is chosen. It works for roughness lengths.
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! V. Masson Meteo-France
+!!
+!! MODIFICATION
+!! ------------
+!
+! F.Solmon patch modif: remove the case 'veg' as veg is defined for patches
+!
+!! Original 15/12/97
+!! V. Masson 01/2004 Externalization
+!! R. Alkama 05/2012 Add 6 tree vegtypes (9 rather than 3)
+!!
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATION
+! -----------
+!
+USE MODD_DATA_COVER_PAR, ONLY : XCDREF
+!
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE MODE_AV_PGD
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODI_ABOR1_SFX
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PFIELD ! secondary field to construct
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOVER ! fraction of each cover class
+REAL, DIMENSION(:), INTENT(IN) :: PDATA ! secondary field value for each class
+ CHARACTER(LEN=3), INTENT(IN) :: HSFTYPE ! Type of surface where the field
+ ! is defined
+ CHARACTER(LEN=3), INTENT(IN) :: HATYPE ! Type of averaging
+LOGICAL, DIMENSION(:), INTENT(IN) :: OCOVER
+INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
+INTEGER, INTENT(IN) :: KNPATCH
+INTEGER, INTENT(IN) :: KPATCH
+REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: PDZ ! first model half level
+INTEGER, INTENT(IN), OPTIONAL :: KDECADE ! current month
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+INTEGER :: JJ, JI, ID0, IMASK0
+INTEGER :: ICOVER ! number of cover classes
+INTEGER :: JCOVER ! loop on cover classes
+!
+INTEGER, DIMENSION(SIZE(PCOVER,2)) :: IMASK
+REAL, DIMENSION(SIZE(PFIELD)) :: ZWORK, ZDZ, ZVAL
+REAL, DIMENSION(SIZE(PCOVER,2)) :: ZWEIGHT
+REAL :: ZCOVER_WEIGHT
+REAL, DIMENSION(SIZE(PFIELD)) :: ZSUM_COVER_WEIGHT
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
+!-------------------------------------------------------------------------------
+!
+!* 1.1 field does not exist
+! --------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD_1P:AV_PGD_1D_1P',0,ZHOOK_HANDLE)
+IF (SIZE(PFIELD)==0 .AND. LHOOK) CALL DR_HOOK('MODI_AV_PGD_1P:AV_PGD_1D_1P',1,ZHOOK_HANDLE)
+IF (SIZE(PFIELD)==0) RETURN
+!
+!-------------------------------------------------------------------------------
+!
+!* 1.2 Initializations
+! ---------------
+!
+ICOVER=SIZE(PCOVER,2)
+!
+IF (PRESENT(PDZ)) THEN
+ ZDZ(:)=PDZ(:)
+ELSE
+ ZDZ(:)=XCDREF
+END IF
+!
+PFIELD(:)=XUNDEF
+IF (HSFTYPE=='TRE' .OR. HSFTYPE=='GRT') PFIELD(:) = 0.
+!
+ZWORK(:)=0.
+ZSUM_COVER_WEIGHT(:)=0.
+!
+JCOVER = 0
+DO JJ = 1,SIZE(OCOVER)
+ IF (OCOVER(JJ)) THEN
+ JCOVER=JCOVER+1
+ IMASK(JCOVER) = JJ
+ ENDIF
+ENDDO
+!
+ CALL GET_WEIGHT(DTCO,ICOVER,IMASK,HSFTYPE,ZWEIGHT)
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. Averaging
+! ---------
+!
+!* 3.1 Work arrays
+! -----------
+!
+IF (HATYPE=='ARI' .OR. HATYPE=='INV' .OR. HATYPE=='CDN') THEN
+ !
+ DO JCOVER=1,ICOVER
+ IF (ZWEIGHT(JCOVER)/=0.) THEN
+ !
+ JJ = IMASK(JCOVER)
+ !
+ IF (HATYPE=='ARI') THEN
+ ZVAL(:) = PDATA(JJ)
+ ELSEIF (HATYPE=='INV') THEN
+ ZVAL(:) = 1./PDATA(JJ)
+ ELSEIF (HATYPE=='CDN') THEN
+ ZVAL(:) = 1./(LOG(ZDZ(:)/PDATA(JJ)))**2
+ ENDIF
+ !
+ DO JI = 1,SIZE(KMASK)
+ !
+ IMASK0 = KMASK(JI)
+ !
+ IF (PCOVER(IMASK0,JCOVER)/=0.) THEN
+ ZCOVER_WEIGHT = PCOVER(IMASK0,JCOVER) * ZWEIGHT(JCOVER)
+ ZSUM_COVER_WEIGHT(JI) = ZSUM_COVER_WEIGHT(JI) + ZCOVER_WEIGHT
+ ZWORK(JI) = ZWORK(JI) + ZVAL(JI) * ZCOVER_WEIGHT
+ ENDIF
+ !
+ ENDDO
+ !
+ ENDIF
+ ENDDO
+ELSEIF (HATYPE=='MAJ') THEN
+ !
+ DO JI = 1,SIZE(KMASK)
+ !
+ IMASK0 = KMASK(JI)
+ !
+ ID0 = MAXVAL(MAXLOC(PCOVER(IMASK0,:)*ZWEIGHT(:)))
+ ZWORK(JI) = PDATA(IMASK(ID0))
+ ZSUM_COVER_WEIGHT(JI) = ZSUM_COVER_WEIGHT(JI) + SUM(PCOVER(IMASK0,:)*ZWEIGHT(:))
+ !
+ ENDDO
+ !
+ELSE
+ CALL ABOR1_SFX('AV_PGD_1D_1P: (1) AVERAGING TYPE NOT ALLOWED : "'//HATYPE//'"')
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD_1P:AV_PGD_1D_1P',0,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------
+!
+!* 4. End of Averaging
+! ----------------
+!
+!* 4.1 Selection of averaging type
+! ---------------------------
+!
+ SELECT CASE (HATYPE)
+!
+!-------------------------------------------------------------------------------
+!
+!* 4.2 Arithmetic averaging
+! --------------------
+!
+ CASE ('ARI')
+!
+ WHERE ( ZSUM_COVER_WEIGHT(:) >0. )
+ PFIELD(:) = ZWORK(:) / ZSUM_COVER_WEIGHT(:)
+ END WHERE
+!
+!-------------------------------------------------------------------------------
+!
+!* 4.3 Inverse averaging
+! -----------------
+!
+ CASE('INV' )
+!
+ WHERE ( ZSUM_COVER_WEIGHT(:) >0. )
+ PFIELD(:) = ZSUM_COVER_WEIGHT(:) / ZWORK(:)
+ END WHERE
+!
+!-------------------------------------------------------------------------------!
+!
+!* 4.4 Roughness length averaging
+! --------------------------
+
+!
+ CASE('CDN')
+!
+ WHERE ( ZSUM_COVER_WEIGHT(:) >0. )
+ PFIELD(:) = ZDZ(:) * EXP( - SQRT(ZSUM_COVER_WEIGHT(:)/ZWORK(:)) )
+ END WHERE
+!
+!-------------------------------------------------------------------------------
+!
+!* 4.4 Majoritary averaging
+! --------------------
+!
+ CASE('MAJ' )
+!
+ WHERE ( ZSUM_COVER_WEIGHT(:) >0. )
+ PFIELD(:) = ZWORK(:)
+ END WHERE
+!
+!-------------------------------------------------------------------------------
+!
+ CASE DEFAULT
+ CALL ABOR1_SFX('AV_PGD_1D_1P: (2) AVERAGING TYPE NOT ALLOWED')
+!
+END SELECT
+IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD_1P:AV_PGD_1D_1P_4',1,ZHOOK_HANDLE)
+!
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE AV_PGD_1D_1P
+!
+! ################################################################
+ SUBROUTINE AV_PATCH_PGD_1D_1P (DTCO, PFIELD,PCOVER,PDATA,HSFTYPE,HATYPE,OCOVER,KMASK,&
+ KNPATCH,KPATCH,PDZ,KDECADE)
+! ################################################################
+!
+!!**** *AV_PATCH_PGD* average for each surface patch a secondary physiographic
+!! variable from the
+!! fractions of coverage class.
+!!
+!! PURPOSE
+!! -------
+!!
+!! METHOD
+!! ------
+!!
+!! The averaging is performed with one way into three:
+!!
+!! - arithmetic averaging (HATYPE='ARI')
+!!
+!! - inverse averaging (HATYPE='INV')
+!!
+!! - inverse of square logarithm averaging (HATYPE='CDN') :
+!!
+!! 1 / ( ln (dz/data) )**2
+!!
+!! This latest uses (if available) the height of the first model mass
+!! level. In the other case, 20m is chosen. It works for roughness lengths.
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! F.Solmon /V. Masson
+!!
+!! MODIFICATION
+!! ------------
+
+!!
+!! Original 15/12/97
+!! V. Masson 01/2004 Externalization
+!! R. Alkama 05/2012 Add 6 tree vegtypes (9 rather than 3)
+!!
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATION
+! -----------
+!
+!
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+!
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, XCDREF
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE MODE_AV_PGD
+!
+USE MODI_VEGTYPE_TO_PATCH
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODI_ABOR1_SFX
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PFIELD ! secondary field to construct
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOVER ! fraction of each cover class
+REAL, DIMENSION(:,:), INTENT(IN) :: PDATA ! secondary field value for each class
+ CHARACTER(LEN=3), INTENT(IN) :: HSFTYPE ! Type of surface where the field
+ ! is defined
+ CHARACTER(LEN=3), INTENT(IN) :: HATYPE ! Type of averaging
+LOGICAL, DIMENSION(:), INTENT(IN) :: OCOVER
+INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
+INTEGER, INTENT(IN) :: KNPATCH
+INTEGER, INTENT(IN) :: KPATCH
+REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: PDZ ! first model half level
+INTEGER, INTENT(IN), OPTIONAL :: KDECADE ! current month
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+INTEGER :: ICOVER ! number of cover classes
+INTEGER :: JCOVER ! loop on cover classes
+!
+! nbe of vegtype
+! nbre of patches
+INTEGER :: JVEG! loop on vegtype
+INTEGER :: JJ, JI, JK
+!
+REAL :: ZCOVER_WEIGHT
+!
+REAL, DIMENSION(SIZE(PFIELD)) :: ZVAL
+!
+REAL, DIMENSION(SIZE(PCOVER,2),NVEGTYPE) :: ZWEIGHT
+!
+REAL, DIMENSION(SIZE(PFIELD)) :: ZSUM_COVER_WEIGHT_PATCH
+!
+REAL, DIMENSION(SIZE(PFIELD)) :: ZWORK
+REAL, DIMENSION(SIZE(PFIELD)) :: ZDZ
+!
+INTEGER :: IMASK, JP
+INTEGER, DIMENSION(SIZE(PCOVER,2)) :: IMASK0
+INTEGER :: PATCH_LIST(NVEGTYPE)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
+
+!-------------------------------------------------------------------------------
+!
+!* 1.1 field does not exist
+! --------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD_1P:AV_PATCH_PGD_1D_1P',0,ZHOOK_HANDLE)
+IF (SIZE(PFIELD)==0 .AND. LHOOK) CALL DR_HOOK('MODI_AV_PGD_1P:AV_PATCH_PGD_1D_1P',1,ZHOOK_HANDLE)
+IF (SIZE(PFIELD)==0) RETURN
+!
+!-------------------------------------------------------------------------------
+!
+!* 1.2 Initializations
+! ---------------
+!
+ICOVER=SIZE(PCOVER,2)
+!
+IF (PRESENT(PDZ)) THEN
+ ZDZ(:)=PDZ(:)
+ELSE
+ ZDZ(:)=XCDREF
+END IF
+!
+PFIELD(:)=XUNDEF
+!
+ZWORK(:) = 0.
+ZWEIGHT(:,:) = 0.0
+ZSUM_COVER_WEIGHT_PATCH(:) = 0.
+!
+DO JVEG=1,NVEGTYPE
+ PATCH_LIST(JVEG) = VEGTYPE_TO_PATCH (JVEG, KNPATCH)
+ENDDO
+!
+JCOVER = 0
+DO JJ = 1,SIZE(OCOVER)
+ IF (OCOVER(JJ)) THEN
+ JCOVER=JCOVER+1
+ IMASK0(JCOVER) = JJ
+ ENDIF
+ENDDO
+!
+ CALL GET_WEIGHT_PATCH(DTCO,ICOVER,IMASK0,KDECADE,HSFTYPE,ZWEIGHT)
+!
+!-------------------------------------------------------------------------------
+ !
+ !
+ !* 2. Selection of the weighting function for vegtype
+ ! -----------------------------------
+ !
+JCOVER=0
+!
+DO JCOVER=1,ICOVER
+ !
+ JJ = IMASK0(JCOVER)
+ !
+ DO JVEG=1,NVEGTYPE
+ !
+ JP= PATCH_LIST(JVEG)
+ IF (JP/=KPATCH) CYCLE
+ !
+ IF (ZWEIGHT(JCOVER,JVEG)/=0.) THEN
+ !
+ IF (HATYPE=='ARI') THEN
+ ZVAL(:) = PDATA(JJ,JVEG)
+ ELSEIF (HATYPE=='INV') THEN
+ ZVAL(:) = 1. / PDATA(JJ,JVEG)
+ ELSEIF (HATYPE=='CDN') THEN
+ DO JI=1,SIZE(ZVAL)
+ ZVAL(JI) = 1./(LOG(ZDZ(JI)/PDATA(JJ,JVEG)))**2
+ ENDDO
+ ELSE
+ CALL ABOR1_SFX('AV_1PATCH_PGD_1D: (1) AVERAGING TYPE NOT ALLOWED')
+ ENDIF
+ !
+ DO JI=1,SIZE(PFIELD)
+
+ IMASK = KMASK(JI)
+
+ IF (PCOVER(IMASK,JCOVER)/=0.) THEN
+ ZCOVER_WEIGHT = PCOVER(IMASK,JCOVER) * ZWEIGHT(JCOVER,JVEG)
+ ZSUM_COVER_WEIGHT_PATCH(JI) = ZSUM_COVER_WEIGHT_PATCH(JI) + ZCOVER_WEIGHT
+ ZWORK(JI) = ZWORK(JI) + ZVAL(JI) * ZCOVER_WEIGHT
+ ENDIF
+ ENDDO
+ !
+ ENDIF
+ !
+ ENDDO
+ !
+ENDDO
+!
+!-------------------------------------------------------------------------------
+
+!
+!* 4.1 Selection of averaging type
+! ---------------------------
+!
+ SELECT CASE (HATYPE)
+!
+!-------------------------------------------------------------------------------
+!
+!* 4.2 Arithmetic averaging
+! --------------------
+!
+ CASE ('ARI')
+!
+ DO JI=1,SIZE(PFIELD)
+ IF (ZSUM_COVER_WEIGHT_PATCH(JI)>0.) PFIELD(JI) = ZWORK(JI) / ZSUM_COVER_WEIGHT_PATCH(JI)
+ ENDDO
+!
+!-------------------------------------------------------------------------------
+!
+!* 4.3 Inverse averaging
+! -----------------
+!
+ CASE('INV' )
+!
+ DO JI=1,SIZE(PFIELD)
+ IF (ZSUM_COVER_WEIGHT_PATCH(JI)>0.) PFIELD(JI) = ZSUM_COVER_WEIGHT_PATCH(JI) / ZWORK(JI)
+ ENDDO
+!-------------------------------------------------------------------------------!
+!
+!* 4.4 Roughness length averaging
+! --------------------------
+
+!
+ CASE('CDN')
+!
+ DO JI=1,SIZE(PFIELD)
+ IF (ZSUM_COVER_WEIGHT_PATCH(JI)>0.) PFIELD(JI) = ZDZ(JI) * EXP( - SQRT(ZSUM_COVER_WEIGHT_PATCH(JI)/ZWORK(JI)) )
+ ENDDO
+!
+!-------------------------------------------------------------------------------
+!
+ CASE DEFAULT
+ CALL ABOR1_SFX('AV_1PATCH_PGD_1D_1P: (2) AVERAGING TYPE NOT ALLOWED')
+!
+END SELECT
+!
+IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD_1P:AV_1PATCH_PGD_1D_1P',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE AV_PATCH_PGD_1D_1P
+!
+! ################################################################
+ SUBROUTINE MAJOR_PATCH_PGD_1D_1P(TFIELD,PCOVER,TDATA,HSFTYPE,HATYPE,&
+ OCOVER,KMASK,KNPATCH,KPATCH,KDECADE)
+! ################################################################
+!
+!!**** *MAJOR_PATCH_PGD* find the dominant date for each vegetation type
+!!
+!! PURPOSE
+!! -------
+!!
+!! METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! P. LE MOIGNE
+!!
+!! MODIFICATION
+!! ------------
+!!
+!! Original 06/2006
+!!
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATION
+! -----------
+!
+USE MODD_TYPE_DATE_SURF
+USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
+!
+USE MODI_VEGTYPE_TO_PATCH
+USE MODE_AV_PGD
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TFIELD ! secondary field to construct
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOVER ! fraction of each cover class
+TYPE (DATE_TIME), DIMENSION(:,:), INTENT(IN) :: TDATA ! secondary field value for each class
+ CHARACTER(LEN=3), INTENT(IN) :: HSFTYPE ! Type of surface where the field
+ ! is defined
+ CHARACTER(LEN=3), INTENT(IN) :: HATYPE ! Type of averaging
+LOGICAL, DIMENSION(:), INTENT(IN) :: OCOVER
+INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
+INTEGER, INTENT(IN) :: KNPATCH
+INTEGER, INTENT(IN) :: KPATCH
+INTEGER, INTENT(IN), OPTIONAL :: KDECADE ! current month
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+INTEGER :: JJ, IMASK
+INTEGER :: ICOVER ! number of cover classes
+INTEGER :: JCOVER ! loop on cover classes
+!
+INTEGER :: JVEG! loop on vegtype
+!
+INTEGER, DIMENSION(SIZE(PCOVER,2),NVEGTYPE) :: IDATA_DOY
+INTEGER, DIMENSION(SIZE(PCOVER,1)) :: IDOY
+REAL, DIMENSION(365) :: ZCOUNT
+INTEGER :: JP, IMONTH, IDAY
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+!
+!* 1.1 field does not exist
+! --------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD_1P:MAJOR_PATCH_PGD_1D_1P',0,ZHOOK_HANDLE)
+IF (SIZE(TFIELD)==0 .AND. LHOOK) CALL DR_HOOK('MODI_AV_PGD_1P:MAJOR_PATCH_PGD_1D_1P',1,ZHOOK_HANDLE)
+IF (SIZE(TFIELD)==0) RETURN
+!
+!-------------------------------------------------------------------------------
+!
+!* 1.2 Initializations
+! ---------------
+!
+TFIELD(:)%TDATE%YEAR = NUNDEF
+TFIELD(:)%TDATE%MONTH = NUNDEF
+TFIELD(:)%TDATE%DAY = NUNDEF
+TFIELD(:)%TIME = XUNDEF
+!
+IDOY(:) = 0
+!
+ CALL DATE2DOY(TDATA,OCOVER,IDATA_DOY)
+!-------------------------------------------------------------------------------
+DO JP = 1,SIZE(TFIELD)
+ !
+ IMASK = KMASK(JP)
+ !
+ ZCOUNT(:) = 0.
+ !
+ DO JVEG=1,NVEGTYPE
+ !
+ IF(KPATCH==VEGTYPE_TO_PATCH(JVEG,KNPATCH)) THEN
+ !
+ DO JCOVER = 1,SIZE(PCOVER,2)
+ !
+ IF (IDATA_DOY(JCOVER,JVEG) /= NUNDEF .AND. PCOVER(IMASK,JCOVER)/=0.) THEN
+ !
+ ZCOUNT(IDATA_DOY(JCOVER,JVEG)) = ZCOUNT(IDATA_DOY(JCOVER,JVEG)) + PCOVER(IMASK,JCOVER)
+ !
+ END IF
+ !
+ END DO
+ !
+ ENDIF
+ !
+ ENDDO
+ !
+ IDOY(JP) = 0
+ IF (ANY(ZCOUNT(:)/=0.)) IDOY(JP) = MAXLOC(ZCOUNT,1)
+ !
+ CALL DOY2DATE(IDOY(JP),IMONTH,IDAY)
+ !
+ TFIELD(JP)%TDATE%MONTH = IMONTH
+ TFIELD(JP)%TDATE%DAY = IDAY
+ IF (IMONTH/=NUNDEF) TFIELD(JP)%TIME = 0.
+ !
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODI_AV_PGD_1P:MAJOR_PATCH_PGD_1D_1P',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE MAJOR_PATCH_PGD_1D_1P
+!
+!-------------------------------------------------------------------------------
+!
diff --git a/src/SURFEX/av_pgd_param.F90 b/src/SURFEX/av_pgd_param.F90
index 004d27f5a02702d0a912c8968dd27ba48fc954fb..6e7e253844610c73d9da3a439fadcd7511c7de4e 100644
--- a/src/SURFEX/av_pgd_param.F90
+++ b/src/SURFEX/av_pgd_param.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ################################################################
- SUBROUTINE AV_PGD_PARAM (DTI, &
- PFIELD,PVEGTYPE,PDATA,HSFTYPE,HATYPE,PDZ,KDECADE)
+ SUBROUTINE AV_PGD_PARAM (PLAI_IN, PVEG_IN, &
+ PFIELD,PVEGTYPE,PDATA,HSFTYPE,HATYPE,KMASK,KNPATCH,KPATCH,PDZ,KDECADE)
! ################################################################
!
!!**** *AV_PATCH_PGD* average for each surface patch a secondary physiographic
@@ -56,19 +56,13 @@
!* 0. DECLARATION
! -----------
!
-!
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
USE MODD_DATA_COVER_PAR, ONLY : NVT_TEBD, NVT_BONE, NVT_TRBE, NVT_TRBD, NVT_TEBE, &
NVT_TENE, NVT_BOBD, NVT_BOND, NVT_SHRB, NVEGTYPE, &
XCDREF
-
!
USE MODI_VEGTYPE_TO_PATCH
!
-!
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -80,14 +74,18 @@ IMPLICIT NONE
! ------------------------
!
!
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLAI_IN
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PVEG_IN
!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELD ! secondary field to construct
+REAL, DIMENSION(:), INTENT(OUT) :: PFIELD ! secondary field to construct
REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE ! fraction of each cover class
REAL, DIMENSION(:,:), INTENT(IN) :: PDATA ! secondary field value for each class
CHARACTER(LEN=3), INTENT(IN) :: HSFTYPE ! Type of surface where the field
! is defined
- CHARACTER(LEN=3), INTENT(IN) :: HATYPE ! Type of averaging
+ CHARACTER(LEN=3), INTENT(IN) :: HATYPE ! Type of averaging
+INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
+INTEGER, INTENT(IN) :: KNPATCH
+INTEGER, INTENT(IN) :: KPATCH
REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: PDZ ! first model half level
INTEGER, INTENT(IN), OPTIONAL :: KDECADE ! current month
!
@@ -100,20 +98,18 @@ INTEGER :: JCOVER ! loop on cover classes
!
! nbe of vegtype
! nbre of patches
-INTEGER :: JVEGTYPE! loop on vegtype
-INTEGER :: IPATCH ! number of patches
-INTEGER :: JPATCH ! PATCH index
-INTEGER :: JJ, JI
+INTEGER :: JV! loop on vegtype
+INTEGER :: JJ, JI, JP, IMASK
!
REAL, DIMENSION(SIZE(PFIELD,1),NVEGTYPE) :: ZWEIGHT
!
-REAL, DIMENSION(SIZE(PFIELD,1),SIZE(PFIELD,2)) :: ZSUM_WEIGHT_PATCH
+REAL, DIMENSION(SIZE(PFIELD,1)) :: ZSUM_WEIGHT_PATCH
!
-REAL, DIMENSION(SIZE(PFIELD,1),SIZE(PFIELD,2)) :: ZWORK
-REAL, DIMENSION(SIZE(PFIELD,1),SIZE(PFIELD,2)) :: ZDZ
+REAL, DIMENSION(SIZE(PFIELD,1)) :: ZWORK
+REAL, DIMENSION(SIZE(PFIELD,1)) :: ZDZ
!
-INTEGER, DIMENSION(SIZE(PFIELD,1),SIZE(PFIELD,2)) :: NMASK
-INTEGER, DIMENSION(SIZE(PFIELD,2)) :: JCOUNT
+REAL, DIMENSION(31) :: ZCOUNT
+INTEGER, DIMENSION(SIZE(PFIELD,1)) :: NMASK
INTEGER :: PATCH_LIST(NVEGTYPE)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -131,25 +127,21 @@ IF (SIZE(PFIELD)==0) RETURN
!* 1.2 Initializations
! ---------------
!
-IPATCH=SIZE(PFIELD,2)
-!
!
IF (PRESENT(PDZ)) THEN
- DO JPATCH=1,IPATCH
- ZDZ(:,JPATCH)=PDZ(:)
- END DO
+ ZDZ(:)=PDZ(:)
ELSE
- ZDZ(:,:)=XCDREF
+ ZDZ(:)=XCDREF
END IF
!
-PFIELD(:,:)=XUNDEF
+PFIELD(:)=XUNDEF
!
-ZWORK(:,:)=0.
+ZWORK(:)=0.
ZWEIGHT(:,:)=0.
-ZSUM_WEIGHT_PATCH(:,:)=0.
+ZSUM_WEIGHT_PATCH(:)=0.
!
-DO JVEGTYPE=1,NVEGTYPE
- PATCH_LIST(JVEGTYPE) = VEGTYPE_TO_PATCH (JVEGTYPE, IPATCH)
+DO JV=1,NVEGTYPE
+ PATCH_LIST(JV) = VEGTYPE_TO_PATCH (JV, KNPATCH)
ENDDO
!-------------------------------------------------------------------------------
@@ -158,68 +150,32 @@ ENDDO
!* 2. Selection of the weighting function for vegtype
! -----------------------------------
!
-SELECT CASE (HSFTYPE)
-
- CASE('NAT','GRD')
- DO JVEGTYPE=1,NVEGTYPE
- ZWEIGHT(:,JVEGTYPE)=PVEGTYPE(:,JVEGTYPE)
- END DO
-
- CASE('VEG','GRV')
- DO JVEGTYPE=1,NVEGTYPE
- ZWEIGHT(:,JVEGTYPE)=PVEGTYPE(:,JVEGTYPE)*DTI%XPAR_VEG(:,KDECADE,JVEGTYPE)
- END DO
-
- CASE('BAR','GRB')
- DO JVEGTYPE=1,NVEGTYPE
- ZWEIGHT(:,JVEGTYPE)=PVEGTYPE(:,JVEGTYPE)*(1.-DTI%XPAR_VEG(:,KDECADE,JVEGTYPE))
- END DO
-
- CASE('DVG','GDV') ! for diffusion scheme only, average only on vegetated area
- DO JVEGTYPE=1,NVEGTYPE
- WHERE ( SUM(DTI%XPAR_LAI(:,:,JVEGTYPE),2) .GT. 0.0) &
- ZWEIGHT(:,JVEGTYPE)=PVEGTYPE(:,JVEGTYPE)
- END DO
-
- CASE('LAI','GRL')
- DO JVEGTYPE=4,NVEGTYPE
- ZWEIGHT(:,JVEGTYPE)=PVEGTYPE(:,JVEGTYPE)*DTI%XPAR_LAI(:,KDECADE,JVEGTYPE)
- END DO
-
- CASE('TRE','GRT')
- ZWEIGHT(:,:)=0.
- WHERE (PVEGTYPE(:,NVT_TEBD)>0.)
- ZWEIGHT(:,NVT_TEBD)=PVEGTYPE(:,NVT_TEBD)
- ENDWHERE
- WHERE (PVEGTYPE(:,NVT_BONE)>0.)
- ZWEIGHT(:,NVT_BONE)=PVEGTYPE(:,NVT_BONE)
- ENDWHERE
- WHERE (PVEGTYPE(:,NVT_TRBE)>0.)
- ZWEIGHT(:,NVT_TRBE)=PVEGTYPE(:,NVT_TRBE)
- ENDWHERE
-
- WHERE (PVEGTYPE(:,NVT_TRBD)>0.)
- ZWEIGHT(:,NVT_TRBD)=PVEGTYPE(:,NVT_TRBD)
- ENDWHERE
- WHERE (PVEGTYPE(:,NVT_TEBE)>0.)
- ZWEIGHT(:,NVT_TEBE)=PVEGTYPE(:,NVT_TEBE)
- ENDWHERE
- WHERE (PVEGTYPE(:,NVT_TENE)>0.)
- ZWEIGHT(:,NVT_TENE)=PVEGTYPE(:,NVT_TENE)
- ENDWHERE
- WHERE (PVEGTYPE(:,NVT_BOBD)>0.)
- ZWEIGHT(:,NVT_BOBD)=PVEGTYPE(:,NVT_BOBD)
- ENDWHERE
- WHERE (PVEGTYPE(:,NVT_BOND)>0.)
- ZWEIGHT(:,NVT_BOND)=PVEGTYPE(:,NVT_BOND)
- ENDWHERE
- WHERE (PVEGTYPE(:,NVT_SHRB)>0.)
- ZWEIGHT(:,NVT_SHRB)=PVEGTYPE(:,NVT_SHRB)
- ENDWHERE
+DO JV=1,NVEGTYPE
+ JP= PATCH_LIST(JV)
+ IF (JP/=KPATCH) CYCLE
+ DO JI=1,SIZE(PFIELD)
+ IMASK = KMASK(JI)
+
+ IF (HSFTYPE=='NAT'.OR.HSFTYPE=='GRD') THEN
+ ZWEIGHT(JI,JV) = PVEGTYPE(IMASK,JV)
+ ELSEIF (HSFTYPE=='VEG'.OR.HSFTYPE=='GRV') THEN
+ ZWEIGHT(JI,JV) = PVEGTYPE(IMASK,JV)*PVEG_IN(IMASK,KDECADE,JV)
+ ELSEIF (HSFTYPE=='BAR'.OR.HSFTYPE=='GRB') THEN
+ ZWEIGHT(JI,JV)=PVEGTYPE(IMASK,JV)*(1.-PVEG_IN(IMASK,KDECADE,JV))
+ ELSEIF (HSFTYPE=='DVG'.OR.HSFTYPE=='GDV') THEN
+ IF (SUM(PLAI_IN(JI,:,JV)).GT.0.) ZWEIGHT(JI,JV) = PVEGTYPE(IMASK,JV)
+ ELSEIF (HSFTYPE=='LAI'.OR.HSFTYPE=='GRL') THEN
+ IF (JV>=4) ZWEIGHT(JI,JV)=PVEGTYPE(IMASK,JV)*PLAI_IN(IMASK,KDECADE,JV)
+ ELSEIF (HSFTYPE=='TRE'.OR.HSFTYPE=='GRT') THEN
+ IF (JV==NVT_TEBD.OR.JV==NVT_BONE.OR.JV==NVT_TRBE.OR.JV==NVT_TRBD.OR.&
+ JV==NVT_TEBE.OR.JV==NVT_TENE.OR.JV==NVT_BOBD.OR.JV==NVT_BOND.OR.&
+ JV==NVT_SHRB) ZWEIGHT(JI,JV) = PVEGTYPE(JI,JV)
+ ELSE
+ CALL ABOR1_SFX('AV_PGD_PARAM_1D: WEIGHTING FUNCTION FOR VEGTYPE NOT ALLOWED')
+ ENDIF
- CASE DEFAULT
- CALL ABOR1_SFX('AV_PGD_PARAM: WEIGHTING FUNCTION FOR VEGTYPE NOT ALLOWED')
-END SELECT
+ ENDDO
+ENDDO
!
!-------------------------------------------------------------------------------
!
@@ -241,11 +197,13 @@ SELECT CASE (HATYPE)
!
CASE ('ARI')
!
- DO JVEGTYPE=1,NVEGTYPE
- JPATCH= PATCH_LIST(JVEGTYPE)
- DO JJ=1,SIZE(PDATA,1)
- ZSUM_WEIGHT_PATCH(JJ,JPATCH) = ZSUM_WEIGHT_PATCH(JJ,JPATCH) + ZWEIGHT(JJ,JVEGTYPE)
- ZWORK(JJ,JPATCH) = ZWORK(JJ,JPATCH) + PDATA(JJ,JVEGTYPE) * ZWEIGHT(JJ,JVEGTYPE)
+ DO JV=1,NVEGTYPE
+ JP= PATCH_LIST(JV)
+ IF (JP/=KPATCH) CYCLE
+ DO JJ=1,SIZE(PFIELD)
+ IMASK = KMASK(JJ)
+ ZSUM_WEIGHT_PATCH(JJ) = ZSUM_WEIGHT_PATCH(JJ) + ZWEIGHT(JJ,JV)
+ ZWORK(JJ) = ZWORK(JJ) + PDATA(IMASK,JV) * ZWEIGHT(JJ,JV)
ENDDO
END DO
!
@@ -256,12 +214,14 @@ SELECT CASE (HATYPE)
!
CASE('INV' )
!
- DO JVEGTYPE=1,NVEGTYPE
- JPATCH=PATCH_LIST(JVEGTYPE)
- DO JJ=1,SIZE(PDATA,1)
- ZSUM_WEIGHT_PATCH(JJ,JPATCH) = ZSUM_WEIGHT_PATCH(JJ,JPATCH)+ZWEIGHT(JJ,JVEGTYPE)
- IF (PDATA(JJ,JVEGTYPE).NE.0.) THEN
- ZWORK(JJ,JPATCH)= ZWORK(JJ,JPATCH) + 1./ PDATA(JJ,JVEGTYPE) * ZWEIGHT(JJ,JVEGTYPE)
+ DO JV=1,NVEGTYPE
+ JP=PATCH_LIST(JV)
+ IF (JP/=KPATCH) CYCLE
+ DO JJ=1,SIZE(PFIELD)
+ IMASK = KMASK(JJ)
+ ZSUM_WEIGHT_PATCH(JJ) = ZSUM_WEIGHT_PATCH(JJ)+ZWEIGHT(JJ,JV)
+ IF (PDATA(IMASK,JV).NE.0.) THEN
+ ZWORK(JJ)= ZWORK(JJ) + 1./ PDATA(IMASK,JV) * ZWEIGHT(JJ,JV)
ENDIF
ENDDO
END DO
@@ -274,40 +234,45 @@ SELECT CASE (HATYPE)
!
CASE('CDN')
!
- DO JVEGTYPE=1,NVEGTYPE
- JPATCH=PATCH_LIST(JVEGTYPE)
- DO JJ=1,SIZE(PDATA,1)
- ZSUM_WEIGHT_PATCH(JJ,JPATCH) = ZSUM_WEIGHT_PATCH(JJ,JPATCH)+ ZWEIGHT(JJ,JVEGTYPE)
- IF (PDATA(JJ,JVEGTYPE).NE.0.) THEN
- ZWORK(JJ,JPATCH)= ZWORK(JJ,JPATCH) + 1./(LOG(ZDZ(JJ,JPATCH)/ PDATA(JJ,JVEGTYPE)))**2 &
- * ZWEIGHT(JJ,JVEGTYPE)
+ DO JV=1,NVEGTYPE
+ JP=PATCH_LIST(JV)
+ IF (JP/=KPATCH) CYCLE
+ DO JJ=1,SIZE(PFIELD)
+ IMASK = KMASK(JJ)
+ ZSUM_WEIGHT_PATCH(JJ) = ZSUM_WEIGHT_PATCH(JJ)+ ZWEIGHT(JJ,JV)
+ IF (PDATA(JJ,JV).NE.0.) THEN
+ ZWORK(JJ)= ZWORK(JJ) + 1./(LOG(ZDZ(JJ)/ PDATA(IMASK,JV)))**2 &
+ * ZWEIGHT(JJ,JV)
ENDIF
ENDDO
END DO
+!
+ CASE ('MAJ')
+!
+ ZWORK(:) = 0.
+ DO JJ=1,SIZE(PFIELD)
+ ZCOUNT(:) = 0.
+ DO JV=1,NVEGTYPE
+ JP= PATCH_LIST(JV)
+ IF (JP/=KPATCH) CYCLE
+ IMASK = KMASK(JJ)
+ IF (NINT(PDATA(IMASK,JV))/=NUNDEF) &
+ ZCOUNT(NINT(PDATA(IMASK,JV))) = ZCOUNT(NINT(PDATA(IMASK,JV))) + ZWEIGHT(JJ,JV)
+ ENDDO
+ IF (ALL(ZCOUNT(:)==0.)) THEN
+ ZWORK(JJ) = NUNDEF
+ ELSE
+ ZWORK(JJ) = FLOAT(MAXLOC(ZCOUNT,1))
+ ENDIF
+ END DO
!
!-------------------------------------------------------------------------------
!
CASE DEFAULT
- CALL ABOR1_SFX('AV_PGD_PARAM: (1) AVERAGING TYPE NOT ALLOWED')
+ CALL ABOR1_SFX('AV_PGD_PARAM_1D: (1) AVERAGING TYPE NOT ALLOWED')
!
END SELECT
!
-!-------------------------------------------------------------------------------
-!
-!* 4. End of Averaging
-! ----------------
-!
-NMASK(:,:)=0
-JCOUNT(:)=0
-DO JPATCH=1,IPATCH
- DO JJ=1,SIZE(ZWORK,1)
- IF ( ZSUM_WEIGHT_PATCH(JJ,JPATCH) >0.) THEN
- JCOUNT(JPATCH)=JCOUNT(JPATCH)+1
- NMASK(JCOUNT(JPATCH),JPATCH)=JJ
- ENDIF
- ENDDO
-ENDDO
-
!* 4.1 Selection of averaging type
! ---------------------------
!
@@ -320,12 +285,8 @@ SELECT CASE (HATYPE)
!
CASE ('ARI')
!
- DO JPATCH=1,IPATCH
-!cdir nodep
- DO JJ=1,JCOUNT(JPATCH)
- JI = NMASK(JJ,JPATCH)
- PFIELD(JI,JPATCH) = ZWORK(JI,JPATCH) / ZSUM_WEIGHT_PATCH(JI,JPATCH)
- ENDDO
+ DO JI=1,SIZE(PFIELD)
+ IF (ZSUM_WEIGHT_PATCH(JI)>0.) PFIELD(JI) = ZWORK(JI) / ZSUM_WEIGHT_PATCH(JI)
ENDDO
!
!-------------------------------------------------------------------------------
@@ -335,12 +296,8 @@ SELECT CASE (HATYPE)
!
CASE('INV' )
!
- DO JPATCH=1,IPATCH
-!cdir nodep
- DO JJ=1,JCOUNT(JPATCH)
- JI = NMASK(JJ,JPATCH)
- PFIELD(JI,JPATCH) = ZSUM_WEIGHT_PATCH(JI,JPATCH) / ZWORK(JI,JPATCH)
- ENDDO
+ DO JI=1,SIZE(PFIELD)
+ IF (ZSUM_WEIGHT_PATCH(JI)>0.) PFIELD(JI) = ZSUM_WEIGHT_PATCH(JI) / ZWORK(JI)
ENDDO
!-------------------------------------------------------------------------------!
!
@@ -350,14 +307,17 @@ SELECT CASE (HATYPE)
!
CASE('CDN')
!
- DO JPATCH=1,IPATCH
-!cdir nodep
- DO JJ=1,JCOUNT(JPATCH)
- JI=NMASK(JJ,JPATCH)
- PFIELD(JI,JPATCH) = ZDZ(JI,JPATCH) * EXP( - SQRT(ZSUM_WEIGHT_PATCH(JI,JPATCH)/ZWORK(JI,JPATCH)) )
- ENDDO
+ DO JI=1,SIZE(PFIELD)
+ IF (ZSUM_WEIGHT_PATCH(JI)>0.) THEN
+ PFIELD(JI) = ZDZ(JI) * EXP( - SQRT(ZSUM_WEIGHT_PATCH(JI)/ZWORK(JI)) )
+ ENDIF
ENDDO
!
+ CASE ('MAJ')
+!
+ DO JI=1,SIZE(PFIELD)
+ PFIELD(JI) = ZWORK(JI)
+ ENDDO
!-------------------------------------------------------------------------------
!
CASE DEFAULT
diff --git a/src/SURFEX/average1_cover.F90 b/src/SURFEX/average1_cover.F90
index e79ebf172d71d6ee8a172f6c6a6535d8c2c8c839..299a9985c9ace1d7b7330b8c8f5c86f3881538e1 100644
--- a/src/SURFEX/average1_cover.F90
+++ b/src/SURFEX/average1_cover.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE AVERAGE1_COVER(KLUOUT,KNBLINES,PLAT,PLON,PVALUE,PNODATA)
+ SUBROUTINE AVERAGE1_COVER(UG,U,KLUOUT,KNBLINES,PLAT,PLON,PVALUE,PNODATA)
! #######################################################
!
!!**** *AVERAGE1_COVER* computes the sum of values of a cover fractions
@@ -41,7 +41,12 @@
!* 0. DECLARATION
! -----------
!
-USE MODD_PGDWORK, ONLY : XSUMCOVER, NSIZE
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+!
+USE MODD_SURFEX_MPI, ONLY : NRANK
+USE MODD_PGDWORK, ONLY : XALL, NSIZE_ALL
+USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
!
USE MODI_GET_MESH_INDEX
USE MODD_POINT_OVERLAY
@@ -55,6 +60,9 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+!
INTEGER, INTENT(IN) :: KLUOUT
INTEGER, INTENT(IN) :: KNBLINES
REAL, DIMENSION(:), INTENT(IN) :: PLAT ! latitude of the point to add
@@ -68,9 +76,10 @@ REAL, OPTIONAL, INTENT(IN) :: PNODATA
INTEGER, DIMENSION(NOVMX,SIZE(PLAT)) :: IINDEX ! mesh index of all input points
! 0 indicates the point is out of the domain
!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZALL
REAL, DIMENSION(SIZE(PLAT)) :: ZVALUE
REAL :: ZNODATA
-INTEGER :: JLOOP, JOVER ! loop index on input arrays
+INTEGER :: JL, JOV, JCOV, IFOUND, ICOV, IND ! loop index on input arrays
INTEGER :: ICOVERCLASS ! class of cover type
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
@@ -81,46 +90,82 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('AVERAGE1_COVER',0,ZHOOK_HANDLE)
!
+ICOV = SIZE(XALL,2)
+!
IF (PRESENT(PNODATA)) THEN
ZVALUE(:) = PVALUE(:)
ZNODATA = PNODATA
- CALL GET_MESH_INDEX(KLUOUT,KNBLINES,PLAT,PLON,IINDEX,ZVALUE,ZNODATA)
+ CALL GET_MESH_INDEX(UG,KLUOUT,KNBLINES,PLAT,PLON,IINDEX,ZVALUE,ZNODATA)
ELSE
ZVALUE(:) = 1.
ZNODATA = 0.
- CALL GET_MESH_INDEX(KLUOUT,KNBLINES,PLAT,PLON,IINDEX)
+ CALL GET_MESH_INDEX(UG,KLUOUT,KNBLINES,PLAT,PLON,IINDEX)
ENDIF
!
!* 2. Loop on all input data points
! -----------------------------
!
bloop: &
-DO JLOOP = 1 , SIZE(PLAT)
+DO JL = 1 , SIZE(PLAT)
!
!* 3. Tests on position
! -----------------
!
- DO JOVER = 1, NOVMX
+ DO JOV = 1, NOVMX
- IF (IINDEX(JOVER,JLOOP)==0) CYCLE bloop
+ IF (IINDEX(JOV,JL)==0) CYCLE bloop
!
!* 4. Test on value meaning
! ---------------------
!
- ICOVERCLASS = NINT(PVALUE(JLOOP))
+ ICOVERCLASS = NINT(PVALUE(JL))
!
- IF (ICOVERCLASS<1 .OR. ICOVERCLASS > SIZE(XSUMCOVER,2) ) CYCLE
+ U%LCOVER(ICOVERCLASS) = .TRUE.
+!
+ IF (ICOVERCLASS<1 .OR. ICOVERCLASS > JPCOVER ) CYCLE
!
!* 5. Summation
! ---------
!
- NSIZE(IINDEX(JOVER,JLOOP))=NSIZE(IINDEX(JOVER,JLOOP))+1
+ NSIZE_ALL(IINDEX(JOV,JL),1)=NSIZE_ALL(IINDEX(JOV,JL),1)+1
!
!* 6. Fraction of cover type
! ----------------------
!
- XSUMCOVER(IINDEX(JOVER,JLOOP),ICOVERCLASS)=XSUMCOVER(IINDEX(JOVER,JLOOP),ICOVERCLASS)+1.
-!
+ IFOUND = 0
+ !ICOV: number of covers already found in the domain
+ DO JCOV=1,ICOV
+ !if the cover read is already in the array
+ IF (XALL(IINDEX(JOV,JL),JCOV,1)==ICOVERCLASS*1.) THEN
+ !the number of points found is increased of 1
+ XALL(IINDEX(JOV,JL),JCOV,2) = XALL(IINDEX(JOV,JL),JCOV,2) + 1.
+ IFOUND=1
+ EXIT
+ ENDIF
+ ENDDO
+ !if the cover is not in the array
+ IF (IFOUND==0) THEN
+ !if we already have some covers for this point
+ IF (XALL(IINDEX(JOV,JL),ICOV,2)/=0.) THEN
+ !to save the current array
+ ALLOCATE(ZALL(SIZE(XALL,1),ICOV,SIZE(XALL,3)))
+ ZALL(:,:,:) = XALL(:,:,:)
+ DEALLOCATE(XALL)
+ !we add one cover to the size of the array
+ ALLOCATE(XALL(SIZE(ZALL,1),ICOV+1,SIZE(ZALL,3)))
+ XALL(:,1:ICOV,:) = ZALL(:,:,:)
+ DEALLOCATE(ZALL)
+ XALL(:,ICOV+1,:) = 0.
+ !the number of covers already found increases
+ ICOV = ICOV + 1
+ ENDIF
+ !first index for this point where no cover is defined
+ IND = MINLOC(XALL(IINDEX(JOV,JL),:,2),1,XALL(IINDEX(JOV,JL),:,2)==0.)
+ !the new cover is registered
+ XALL(IINDEX(JOV,JL),IND,1) = ICOVERCLASS*1.
+ XALL(IINDEX(JOV,JL),IND,2) = 1.
+ ENDIF
+ !
ENDDO
!
END DO bloop
diff --git a/src/SURFEX/average1_cti.F90 b/src/SURFEX/average1_cti.F90
index a0625134037ba53b936f03432b02aa09cb5ab418..d529cfe85f6ab3e80713cdac589a8b8b9a05f98c 100644
--- a/src/SURFEX/average1_cti.F90
+++ b/src/SURFEX/average1_cti.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE AVERAGE1_CTI(KLUOUT,KNBLINES,PLAT,PLON,PVALUE,PNODATA)
+ SUBROUTINE AVERAGE1_CTI(UG,KLUOUT,KNBLINES,PLAT,PLON,PVALUE,PNODATA)
! ################################################
!
!!**** *AVERAGE1_CTI* computes the sum of cti, squared cti
@@ -40,8 +40,9 @@
!* 0. DECLARATION
! -----------
!
-USE MODD_PGDWORK, ONLY : XSUMVAL, XSUMVAL2, XSUMVAL3, NSIZE, &
- XMAX_WORK, XMIN_WORK
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+!
+USE MODD_PGDWORK, ONLY : XALL, NSIZE_ALL, XEXT_ALL
!
USE MODI_GET_MESH_INDEX
USE MODD_POINT_OVERLAY
@@ -55,6 +56,8 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+!
INTEGER, INTENT(IN) :: KLUOUT
INTEGER, INTENT(IN) :: KNBLINES
REAL, DIMENSION(:), INTENT(IN) :: PLAT ! latitude of the point to add
@@ -71,7 +74,7 @@ INTEGER, DIMENSION(NOVMX,SIZE(PLAT)) :: IINDEX ! mesh index of all input points
REAL, DIMENSION(SIZE(PLAT)) :: ZVALUE
REAL :: ZNODATA
!
-INTEGER :: JLOOP, JOVER ! loop index on input arrays
+INTEGER :: JL, JOV ! loop index on input arrays
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
!
@@ -84,58 +87,58 @@ IF (LHOOK) CALL DR_HOOK('AVERAGE1_CTI',0,ZHOOK_HANDLE)
IF (PRESENT(PNODATA)) THEN
ZVALUE(:) = PVALUE(:)
ZNODATA = PNODATA
- CALL GET_MESH_INDEX(KLUOUT,KNBLINES,PLAT,PLON,IINDEX,ZVALUE,ZNODATA)
+ CALL GET_MESH_INDEX(UG,KLUOUT,KNBLINES,PLAT,PLON,IINDEX,ZVALUE,ZNODATA)
ELSE
ZVALUE(:) = 1.
ZNODATA = 0.
- CALL GET_MESH_INDEX(KLUOUT,KNBLINES,PLAT,PLON,IINDEX)
+ CALL GET_MESH_INDEX(UG,KLUOUT,KNBLINES,PLAT,PLON,IINDEX)
ENDIF
!
!* 2. Loop on all input data points
! -----------------------------
!
bloop: &
-DO JLOOP = 1 , SIZE(PLAT)
+DO JL = 1 , SIZE(PLAT)
!
- DO JOVER = 1, NOVMX
+ DO JOV = 1, NOVMX
!
!* 3. Tests on position
! -----------------
!
- IF (IINDEX(JOVER,JLOOP)==0) CYCLE bloop
+ IF (IINDEX(JOV,JL)==0) CYCLE bloop
!
!* 4. Summation
! ---------
!
- NSIZE(IINDEX(JOVER,JLOOP))=NSIZE(IINDEX(JOVER,JLOOP))+1
+ NSIZE_ALL(IINDEX(JOV,JL),1)=NSIZE_ALL(IINDEX(JOV,JL),1)+1
!
!* 5. CTI
! ---
!
- XSUMVAL(IINDEX(JOVER,JLOOP))=XSUMVAL(IINDEX(JOVER,JLOOP))+PVALUE(JLOOP)
+ XALL(IINDEX(JOV,JL),1,1) = XALL(IINDEX(JOV,JL),1,1)+PVALUE(JL)
!
!* 6. Square of CTI
! -------------
!
- XSUMVAL2(IINDEX(JOVER,JLOOP))=XSUMVAL2(IINDEX(JOVER,JLOOP))+PVALUE(JLOOP)**2
+ XALL(IINDEX(JOV,JL),2,1) = XALL(IINDEX(JOV,JL),2,1)+PVALUE(JL)**2
!
!
!* 7. Cube of CTI
! -------------
!
- XSUMVAL3(IINDEX(JOVER,JLOOP))=XSUMVAL3(IINDEX(JOVER,JLOOP))+PVALUE(JLOOP)**3
+ XALL(IINDEX(JOV,JL),3,1) = XALL(IINDEX(JOV,JL),3,1)+PVALUE(JL)**3
!
!
!* 8. Maximum CTI in the mesh
! -----------------------
!
- XMAX_WORK(IINDEX(JOVER,JLOOP))=MAX(XMAX_WORK(IINDEX(JOVER,JLOOP)),PVALUE(JLOOP))
+ XEXT_ALL(IINDEX(JOV,JL),1) = MAX(XEXT_ALL(IINDEX(JOV,JL),1),PVALUE(JL))
!
!
!* 9. Minimum CTI in the mesh
! -----------------------
!
- XMIN_WORK(IINDEX(JOVER,JLOOP))=MIN(XMIN_WORK(IINDEX(JOVER,JLOOP)),PVALUE(JLOOP))
+ XEXT_ALL(IINDEX(JOV,JL),2) = MIN(XEXT_ALL(IINDEX(JOV,JL),2),PVALUE(JL))
!
!
ENDDO
diff --git a/src/SURFEX/average1_ldb.F90 b/src/SURFEX/average1_ldb.F90
index 85fab10b218aae986f8b8cfc0774b4207d239474..e7c3e0f4ec26e2179cbbcae09c224555a7c8d3d6 100644
--- a/src/SURFEX/average1_ldb.F90
+++ b/src/SURFEX/average1_ldb.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE AVERAGE1_LDB(KLUOUT,KNBLINES,PLAT,PLON,PVALUE,HTYPE,PNODATA)
+ SUBROUTINE AVERAGE1_LDB(UG,KLUOUT,KNBLINES,PLAT,PLON,PVALUE,HTYPE,PNODATA)
! #######################################################
!
!!**** *AVERAGE1_LDB*
@@ -39,7 +39,9 @@
!* 0. DECLARATION
! -----------
!
-USE MODD_PGDWORK, ONLY : XTNG, NSIZE
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+!
+USE MODD_PGDWORK, ONLY : XALL, NSIZE_ALL
USE MODD_DATA_LAKE, ONLY : XBOUNDGRADDEPTH_LDB, XBOUNDGRADSTATUS_LDB
!
USE MODD_POINT_OVERLAY
@@ -55,6 +57,8 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+!
INTEGER, INTENT(IN) :: KLUOUT
INTEGER, INTENT(IN) :: KNBLINES
REAL, DIMENSION(:), INTENT(IN) :: PLAT ! latitude of the point to add
@@ -75,7 +79,7 @@ REAL, DIMENSION(SIZE(PLAT)) :: ZVALUE
REAL :: ZNODATA
!
REAL :: ZCUT
-INTEGER :: JLOOP, JGRAD, JOVER ! loop index on input arrays
+INTEGER :: JL, JGR, JOV ! loop index on input arrays
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
!
@@ -103,34 +107,34 @@ END SELECT
IF (PRESENT(PNODATA)) THEN
ZVALUE(:) = PVALUE(:)
ZNODATA = PNODATA
- CALL GET_MESH_INDEX(KLUOUT,KNBLINES,PLAT,PLON,IINDEX,ZVALUE,ZNODATA)
+ CALL GET_MESH_INDEX(UG,KLUOUT,KNBLINES,PLAT,PLON,IINDEX,ZVALUE,ZNODATA)
ELSE
ZVALUE(:) = 1.
ZNODATA = 0.
- CALL GET_MESH_INDEX(KLUOUT,KNBLINES,PLAT,PLON,IINDEX)
+ CALL GET_MESH_INDEX(UG,KLUOUT,KNBLINES,PLAT,PLON,IINDEX)
ENDIF
!
!* 2. Loop on all input data points
! -----------------------------
!
bloop: &
-DO JLOOP = 1 , SIZE(PLAT)
+DO JL = 1 , SIZE(PLAT)
!
- DO JOVER = 1, NOVMX
+ DO JOV = 1, NOVMX
!
!* 3. Tests on position
! -----------------
!
- IF (IINDEX(JOVER,JLOOP)==0) CYCLE bloop
+ IF (IINDEX(JOV,JL)==0) CYCLE bloop
!
!* 4. Test on value meaning
! ---------------------
!
- ZCUT = PVALUE(JLOOP)
+ ZCUT = PVALUE(JL)
!
- DO JGRAD = 1, SIZE(ZBOUND)-1
- IF (ZCUT.GT.ZBOUND(JGRAD) .AND. ZCUT.LE.ZBOUND(JGRAD+1)) THEN
- XTNG(IINDEX(1,JLOOP),JGRAD) = XTNG(IINDEX(1,JLOOP),JGRAD) + 1
+ DO JGR = 1, SIZE(ZBOUND)-1
+ IF (ZCUT.GT.ZBOUND(JGR) .AND. ZCUT.LE.ZBOUND(JGR+1)) THEN
+ XALL(IINDEX(1,JL),JGR,1) = XALL(IINDEX(1,JL),JGR,1) + 1
EXIT
ENDIF
ENDDO
@@ -138,7 +142,7 @@ DO JLOOP = 1 , SIZE(PLAT)
!* 5. Summation
! ---------
!
- NSIZE(IINDEX(1,JLOOP))=NSIZE(IINDEX(1,JLOOP))+1
+ NSIZE_ALL(IINDEX(1,JL),1)=NSIZE_ALL(IINDEX(1,JL),1)+1
!
END DO
!
diff --git a/src/SURFEX/average1_mesh.F90 b/src/SURFEX/average1_mesh.F90
index 94732efe0e31f4da808f84938dd149ff715403c7..5d614f5da9717e9c1db8c1593307c639aaf3e7b4 100644
--- a/src/SURFEX/average1_mesh.F90
+++ b/src/SURFEX/average1_mesh.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE AVERAGE1_MESH(KLUOUT,KNBLINES,PLAT,PLON,PVALUE,PNODATA)
+ SUBROUTINE AVERAGE1_MESH(UG,KLUOUT,KNBLINES,PLAT,PLON,PVALUE,OMULTITYPE,KFACT,PNODATA)
! #######################################################
!
!!**** *AVERAGE1_MESH* computes the sum of orography, squared orography
@@ -40,7 +40,9 @@
!* 0. DECLARATION
! -----------
!
-USE MODD_PGDWORK, ONLY : XSUMVAL, NSIZE, CATYPE, &
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+!
+USE MODD_PGDWORK, ONLY : XALL, NSIZE_ALL, CATYPE, &
NVALNBR, NVALCOUNT, XVALLIST, JPVALMAX
USE MODD_DATA_COVER_PAR,ONLY : XCDREF
!
@@ -48,8 +50,6 @@ USE MODI_GET_MESH_INDEX
USE MODD_POINT_OVERLAY
USE MODI_ABOR1_SFX
!
-!
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -58,11 +58,15 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+!
INTEGER, INTENT(IN) :: KLUOUT
INTEGER, INTENT(IN) :: KNBLINES
REAL, DIMENSION(:), INTENT(IN) :: PLAT ! latitude of the point to add
REAL, DIMENSION(:), INTENT(IN) :: PLON ! longitude of the point to add
REAL, DIMENSION(:), INTENT(IN) :: PVALUE ! value of the point to add
+LOGICAL, INTENT(IN) :: OMULTITYPE
+INTEGER, INTENT(IN) :: KFACT
REAL, OPTIONAL, INTENT(IN) :: PNODATA
!
!* 0.2 Declaration of other local variables
@@ -70,11 +74,12 @@ REAL, OPTIONAL, INTENT(IN) :: PNODATA
!
INTEGER, DIMENSION(NOVMX,SIZE(PLAT)) :: IINDEX ! mesh index of all input points
! 0 indicates the point is out of the domain
-INTEGER :: JVAL ! loop counter on encoutered values
-INTEGER :: JLOOP, JOVER ! loop index on input arrays
+INTEGER :: JVAL, JTY, IDX ! loop counter on encoutered values
+INTEGER :: JL, JOV ! loop index on input arrays
REAL :: ZEPS=1.E-10 ! a small value
LOGICAL :: GFOUND ! T : Value already found in this grid point
!
+LOGICAL, DIMENSION(SIZE(PLAT)) :: GFLAG
REAL, DIMENSION(SIZE(PLAT)) :: ZVALUE
REAL :: ZNODATA
!
@@ -86,65 +91,91 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('AVERAGE1_MESH',0,ZHOOK_HANDLE)
!
+! to calculate the mesh indexes only where pvalue /= pnodata
IF (PRESENT(PNODATA)) THEN
- ZVALUE(:) = PVALUE(:)
ZNODATA = PNODATA
- CALL GET_MESH_INDEX(KLUOUT,KNBLINES,PLAT,PLON,IINDEX,ZVALUE,ZNODATA)
+ ZVALUE(:) = PVALUE(:)
ELSE
- ZVALUE(:) = 1.
ZNODATA = 0.
- CALL GET_MESH_INDEX(KLUOUT,KNBLINES,PLAT,PLON,IINDEX)
+ ZVALUE(:) = 1.
ENDIF
!
-!* 2. Loop on all input data points
-! -----------------------------
-!
-bloop: &
-DO JLOOP = 1 , SIZE(PLAT)
+CALL GET_MESH_INDEX(UG,KLUOUT,KNBLINES,PLAT,PLON,IINDEX,ZVALUE,ZNODATA)
!
- DO JOVER = 1, NOVMX
+IF (.NOT.PRESENT(PNODATA)) ZVALUE(:) = PVALUE(:)
!
+!* 2. Loop on all input data points
+! -----------------------------
+!
+DO JOV = 1, NOVMX
+ !
+ bloop: &
+ DO JL = 1 , SIZE(PLAT)
+ !
!* 3. Tests on position
! -----------------
-!
- IF (IINDEX(JOVER,JLOOP)==0) CYCLE bloop
+!
+ IDX = IINDEX(JOV,JL)
+
+ IF (IDX==0) CYCLE bloop
!
!* 4. Summation
! ---------
!
- NSIZE(IINDEX(JOVER,JLOOP))=NSIZE(IINDEX(JOVER,JLOOP))+1
+ IF (PRESENT(PNODATA)) THEN
+ IF (ZVALUE(JL)==ZNODATA) CYCLE
+ ENDIF
+!
+! the type of the point and the true value
+ IF (OMULTITYPE) THEN
+ JTY = FLOOR(ZVALUE(JL)/100.)
+ ZVALUE(JL) = (ZVALUE(JL) - JTY*100.) / FLOAT(KFACT)
+ ELSE
+ JTY = 1
+ ENDIF
+
+ NSIZE_ALL(IDX,JTY) = NSIZE_ALL(IDX,JTY)+1
!
!* 5. Choice of type of summation
! ---------------------------
!
SELECT CASE (CATYPE)
+
CASE ('ARI')
- XSUMVAL(IINDEX(JOVER,JLOOP))=XSUMVAL(IINDEX(JOVER,JLOOP))+ PVALUE(JLOOP)
+ XALL(IDX,JTY,1) = XALL(IDX,JTY,1) + ZVALUE(JL)
+
CASE ('INV')
- XSUMVAL(IINDEX(JOVER,JLOOP))=XSUMVAL(IINDEX(JOVER,JLOOP))+1./PVALUE(JLOOP)
+ XALL(IDX,JTY,1) = XALL(IDX,JTY,1) + 1./ZVALUE(JL)
+
CASE ('CDN')
- XSUMVAL(IINDEX(JOVER,JLOOP))=XSUMVAL(IINDEX(JOVER,JLOOP))+1./(LOG(XCDREF/PVALUE(JLOOP)))**2
+ XALL(IDX,JTY,1) = XALL(IDX,JTY,1) + 1./(LOG(XCDREF/ZVALUE(JL)))**2
+
CASE ('MAJ')
+
GFOUND=.FALSE.
- DO JVAL=1,NVALNBR(IINDEX(JOVER,JLOOP))
- IF (ABS( XVALLIST(IINDEX(JOVER,JLOOP),JVAL) - PVALUE(JLOOP)) < ZEPS) THEN
- NVALCOUNT(IINDEX(JOVER,JLOOP),JVAL) = NVALCOUNT(IINDEX(JOVER,JLOOP),JVAL) + 1
+ DO JVAL=1,NVALNBR(IDX,JTY)
+ IF (ABS( XVALLIST(IDX,JVAL,JTY) - ZVALUE(JL)) < ZEPS) THEN
+ NVALCOUNT(IDX,JVAL,JTY) = NVALCOUNT(IDX,JVAL,JTY) + 1
GFOUND=.TRUE.
EXIT
END IF
END DO
+
IF (.NOT. GFOUND) THEN
- IF (NVALNBR(IINDEX(JOVER,JLOOP))==JPVALMAX) &
+ IF (NVALNBR(IDX,JTY)==JPVALMAX) &
CALL ABOR1_SFX('TOO MANY DIFFERENT VALUES TO AGGREGATE WITH THE MAJORITY RULE')
- NVALNBR(IINDEX(JOVER,JLOOP)) = NVALNBR(IINDEX(JOVER,JLOOP)) +1
- JVAL = NVALNBR(IINDEX(JOVER,JLOOP))
- NVALCOUNT(IINDEX(JOVER,JLOOP),JVAL) = 1
- XVALLIST (IINDEX(JOVER,JLOOP),JVAL) = PVALUE(JLOOP)
+ NVALNBR(IDX,JTY) = NVALNBR(IDX,JTY) +1
+ JVAL = NVALNBR(IDX,JTY)
+ NVALCOUNT(IDX,JVAL,JTY) = 1
+ XVALLIST (IDX,JVAL,JTY) = ZVALUE(JL)
END IF
+
END SELECT
+ !
+ ENDDO bloop
+ !
+ENDDO
!
- ENDDO
-END DO bloop
IF (LHOOK) CALL DR_HOOK('AVERAGE1_MESH',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/average1_orography.F90 b/src/SURFEX/average1_orography.F90
index d35af26aa3b9bc13aaf36cc75850e0a84a72d2db..d14af796e300bef667f80361614ea6030903b4d9 100644
--- a/src/SURFEX/average1_orography.F90
+++ b/src/SURFEX/average1_orography.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE AVERAGE1_OROGRAPHY (USS, &
+ SUBROUTINE AVERAGE1_OROGRAPHY (UG,USS, &
KLUOUT,KNBLINES,PLAT,PLON,PVALUE,PNODATA)
! #######################################################
!
@@ -42,9 +42,10 @@
! -----------
!
!
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SSO_n, ONLY : SSO_t
!
-USE MODD_PGDWORK, ONLY : XSUMVAL, XSUMVAL2, NSIZE, XSSQO, LSSQO, NSSO
+USE MODD_PGDWORK, ONLY : XALL, XEXT_ALL, NSIZE_ALL, XSSO_ALL, NSSO_ALL, NSSO
!
USE MODI_GET_MESH_INDEX
USE MODD_POINT_OVERLAY, ONLY : NOVMX
@@ -59,7 +60,8 @@ IMPLICIT NONE
! ------------------------
!
!
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
INTEGER, INTENT(IN) :: KLUOUT
INTEGER, INTENT(IN) :: KNBLINES
@@ -76,7 +78,7 @@ INTEGER, DIMENSION(NOVMX,SIZE(PLAT)) :: IINDEX ! mesh index of all input points
INTEGER, DIMENSION(NOVMX,SIZE(PLAT)) :: ISSOX ! X submesh index in their mesh of all input points
INTEGER, DIMENSION(NOVMX,SIZE(PLAT)) :: ISSOY ! Y submesh index in their mesh of all input points
!
-INTEGER :: JLOOP, JOVER ! loop index on input arrays
+INTEGER :: JL, JOV ! loop index on input arrays
REAL, DIMENSION(SIZE(PLAT)) :: ZVALUE
REAL :: ZNODATA
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -91,59 +93,59 @@ IF (LHOOK) CALL DR_HOOK('AVERAGE1_OROGRAPHY',0,ZHOOK_HANDLE)
IF (PRESENT(PNODATA)) THEN
ZVALUE(:) = PVALUE(:)
ZNODATA = PNODATA
- CALL GET_MESH_INDEX(KLUOUT,KNBLINES,PLAT,PLON,IINDEX,ZVALUE,ZNODATA,NSSO,ISSOX,ISSOY)
+ CALL GET_MESH_INDEX(UG,KLUOUT,KNBLINES,PLAT,PLON,IINDEX,ZVALUE,ZNODATA,NSSO,ISSOX,ISSOY)
ELSE
ZVALUE(:) = 1.
ZNODATA = 0.
- CALL GET_MESH_INDEX(KLUOUT,KNBLINES,PLAT,PLON,IINDEX,KSSO=NSSO,KISSOX=ISSOX,KISSOY=ISSOY)
+ CALL GET_MESH_INDEX(UG,KLUOUT,KNBLINES,PLAT,PLON,IINDEX,KSSO=NSSO,KISSOX=ISSOX,KISSOY=ISSOY)
ENDIF
!
!* 2. Loop on all input data points
! -----------------------------
!
bloop: &
-DO JLOOP = 1 , SIZE(PLAT)
+DO JL = 1 , SIZE(PLAT)
!
- DO JOVER = 1, NOVMX
+ DO JOV = 1, NOVMX
!
!* 3. Tests on position
! -----------------
!
- IF (IINDEX(JOVER,JLOOP)==0) CYCLE bloop
+ IF (IINDEX(JOV,JL)==0) CYCLE bloop
!
!* 4. Summation
! ---------
!
- NSIZE(IINDEX(JOVER,JLOOP))=NSIZE(IINDEX(JOVER,JLOOP))+1
+ NSIZE_ALL(IINDEX(JOV,JL),1) = NSIZE_ALL(IINDEX(JOV,JL),1)+1
!
!* 5. Orography
! ---------
!
- XSUMVAL(IINDEX(JOVER,JLOOP))=XSUMVAL(IINDEX(JOVER,JLOOP))+PVALUE(JLOOP)
+ XALL(IINDEX(JOV,JL),1,1) = XALL(IINDEX(JOV,JL),1,1)+PVALUE(JL)
!
!* 6. Square of Orography
! -------------------
!
- XSUMVAL2(IINDEX(JOVER,JLOOP))=XSUMVAL2(IINDEX(JOVER,JLOOP))+PVALUE(JLOOP)**2
+ XALL(IINDEX(JOV,JL),2,1) = XALL(IINDEX(JOV,JL),2,1)+PVALUE(JL)**2
!
!* 7. Maximum orography in a subgrid square
! -------------------------------------
!
- LSSQO(ISSOX(JOVER,JLOOP),ISSOY(JOVER,JLOOP),IINDEX(JOVER,JLOOP)) = .TRUE.
- XSSQO(ISSOX(JOVER,JLOOP),ISSOY(JOVER,JLOOP),IINDEX(JOVER,JLOOP)) = &
- MAX ( XSSQO(ISSOX(JOVER,JLOOP),ISSOY(JOVER,JLOOP),IINDEX(JOVER,JLOOP)) , PVALUE(JLOOP) )
+ NSSO_ALL(IINDEX(JOV,JL),ISSOX(JOV,JL),ISSOY(JOV,JL)) = 1
+ XSSO_ALL(IINDEX(JOV,JL),ISSOX(JOV,JL),ISSOY(JOV,JL)) = &
+ MAX ( XSSO_ALL(IINDEX(JOV,JL),ISSOX(JOV,JL),ISSOY(JOV,JL)) , PVALUE(JL) )
!
!
!* 8. Maximum orography in the mesh
! -----------------------------
!
- USS%XMAX_ZS(IINDEX(JOVER,JLOOP))=MAX(USS%XMAX_ZS(IINDEX(JOVER,JLOOP)),PVALUE(JLOOP))
+ XEXT_ALL(IINDEX(JOV,JL),1) = MAX(XEXT_ALL(IINDEX(JOV,JL),1),PVALUE(JL))
!
!
!* 9. Minimum orography in the mesh
! -----------------------------
!
- USS%XMIN_ZS(IINDEX(JOVER,JLOOP))=MIN(USS%XMIN_ZS(IINDEX(JOVER,JLOOP)),PVALUE(JLOOP))
+ XEXT_ALL(IINDEX(JOV,JL),2) = MIN(XEXT_ALL(IINDEX(JOV,JL),2),PVALUE(JL))
!
!
END DO
diff --git a/src/SURFEX/average2_cover.F90 b/src/SURFEX/average2_cover.F90
index f3a05988d5a7757b9d48bb408fa4af3c1a3dd85f..4470bf54835f03144544a8ca0330269e49d96a70 100644
--- a/src/SURFEX/average2_cover.F90
+++ b/src/SURFEX/average2_cover.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########################
- SUBROUTINE AVERAGE2_COVER (U, &
- HPROGRAM)
+ SUBROUTINE AVERAGE2_COVER (U, HPROGRAM)
! #########################
!
!!**** *AVERAGE2_COVER* computes the cover fractions
@@ -40,9 +39,10 @@
! -----------
!
!
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SURFEX_MPI, ONLY : NRANK
+USE MODD_PGDWORK, ONLY : NSIZE, XSUMVAL, XPREC
!
-USE MODD_PGDWORK, ONLY : NSIZE, XSUMCOVER
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODD_PGD_GRID, ONLY : CGRID
!
@@ -66,7 +66,9 @@ TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
REAL, DIMENSION(:), ALLOCATABLE :: ZUNITY
!
-INTEGER :: JCOVER, ICPT ! loop counter on cover classes
+REAL :: ZINT
+INTEGER :: JI, JJ
+INTEGER :: JCOV ! loop counter on cover classes
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
!
@@ -77,30 +79,34 @@ IF (LHOOK) CALL DR_HOOK('AVERAGE2_COVER',0,ZHOOK_HANDLE)
ALLOCATE(ZUNITY(SIZE(NSIZE)))
ZUNITY (:) = 0.
!
-DO JCOVER=1,SIZE(XSUMCOVER,2)
- ICPT = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,XSUMCOVER(:,JCOVER)/=0., 'HAL')
- IF (ICPT>0) U%LCOVER(JCOVER) = .TRUE.
-ENDDO
+ALLOCATE(U%XCOVER(SIZE(NSIZE,1),SIZE(XSUMVAL,2)))
!
-ALLOCATE(U%XCOVER(SIZE(NSIZE),COUNT(U%LCOVER)))
-!
-ICPT = 0
-DO JCOVER=1,SIZE(XSUMCOVER,2)
- IF (U%LCOVER(JCOVER)) THEN
- ICPT = ICPT+1
- WHERE (NSIZE(:)/=0)
- U%XCOVER(:,ICPT)=XSUMCOVER(:,JCOVER) /NSIZE(:)
- ZUNITY(:)=ZUNITY(:) + U%XCOVER(:,ICPT)
- ENDWHERE
- ENDIF
+DO JCOV=1,SIZE(XSUMVAL,2)
+ WHERE (NSIZE(:,1)/=0)
+ U%XCOVER(:,JCOV) = XSUMVAL(:,JCOV) /NSIZE(:,1)
+ ZUNITY(:)=ZUNITY(:) + U%XCOVER(:,JCOV)
+ ELSEWHERE
+ U%XCOVER(:,JCOV) = 0.
+ END WHERE
END DO
!
-DO JCOVER=1,SIZE(U%XCOVER,2)
- WHERE (NSIZE(:) /=0 )
- U%XCOVER(:,JCOVER)=U%XCOVER(:,JCOVER) / ZUNITY(:)
+DO JCOV=1,SIZE(U%XCOVER,2)
+ WHERE (NSIZE(:,1) /=0 )
+ U%XCOVER(:,JCOV)=U%XCOVER(:,JCOV) / ZUNITY(:)
END WHERE
END DO
!
+DO JJ=1,SIZE(U%XCOVER,2)
+ DO JI = 1,SIZE(U%XCOVER,1)
+
+ ZINT = AINT(U%XCOVER(JI,JJ))
+ IF (U%XCOVER(JI,JJ)/=ZINT) THEN
+ U%XCOVER(JI,JJ) = ZINT + ANINT((U%XCOVER(JI,JJ)-ZINT)*XPREC)/XPREC
+ ENDIF
+
+ ENDDO
+ENDDO
+!
!-------------------------------------------------------------------------------
DEALLOCATE(ZUNITY)
IF (LHOOK) CALL DR_HOOK('AVERAGE2_COVER',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/average2_cti.F90 b/src/SURFEX/average2_cti.F90
index f2f56405fd8927414cd1acd655ab82247f5f6fdc..0099ea88d96dfcf6c2329cce43fb5828eea87029 100644
--- a/src/SURFEX/average2_cti.F90
+++ b/src/SURFEX/average2_cti.F90
@@ -38,9 +38,10 @@
!* 0. DECLARATION
! -----------
!
-USE MODD_PGDWORK, ONLY : NSIZE, XSUMVAL, XSUMVAL2, XSUMVAL3, &
- XMEAN_WORK, XSTD_WORK, XSKEW_WORK, &
- XMIN_WORK, XMAX_WORK
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_PGDWORK, ONLY : NSIZE, XSUMVAL, XPREC, &
+ XMEAN_WORK, XSTD_WORK, XSKEW_WORK, &
+ XMIN_WORK, XMAX_WORK
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -54,23 +55,24 @@ IMPLICIT NONE
!* 0.2 Declaration of other local variables
! ------------------------------------
!
-REAL, DIMENSION(SIZE(NSIZE)) :: ZSIZE
+REAL, DIMENSION(SIZE(NSIZE,1)) :: ZSIZE
!
-integer :: I
+REAL :: ZINT
+INTEGER :: JI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('AVERAGE2_CTI',0,ZHOOK_HANDLE)
-ZSIZE(:)=REAL(NSIZE(:))
+ZSIZE(:)=REAL(NSIZE(:,1))
!
-WHERE (NSIZE(:)>=36)
+WHERE (NSIZE(:,1)>=36)
!
!----------------------------------------------------------------------------
!
!* 1. Mean CTI
! --------------
!
- XMEAN_WORK(:)=XSUMVAL(:)/ZSIZE(:)
+ XMEAN_WORK(:) = XSUMVAL(:,1)/ZSIZE(:)
!
!-------------------------------------------------------------------------------
!
@@ -78,9 +80,9 @@ WHERE (NSIZE(:)>=36)
! ------------------
!
WHERE (XMAX_WORK(:)-XMIN_WORK(:)>=1.0)
- XSTD_WORK(:)=SQRT( MAX(0.,XSUMVAL2(:)/NSIZE(:) - XMEAN_WORK(:)*XMEAN_WORK(:)) )
+ XSTD_WORK(:) = SQRT( MAX(0.,XSUMVAL(:,2)/NSIZE(:,1) - XMEAN_WORK(:)*XMEAN_WORK(:)) )
ELSEWHERE
- XSTD_WORK(:)=0.0
+ XSTD_WORK(:) = 0.0
END WHERE
!
!-------------------------------------------------------------------------------
@@ -90,16 +92,43 @@ WHERE (NSIZE(:)>=36)
!
WHERE(XSTD_WORK(:)>0.0)
!
- XSKEW_WORK(:)=XSUMVAL3(:)-ZSIZE(:)*XMEAN_WORK(:)*XMEAN_WORK(:)*XMEAN_WORK(:) &
+ XSKEW_WORK(:) = XSUMVAL(:,3)-ZSIZE(:)*XMEAN_WORK(:)*XMEAN_WORK(:)*XMEAN_WORK(:) &
-3.0*ZSIZE(:)*XMEAN_WORK(:)*XSTD_WORK(:)*XSTD_WORK(:)
!
- XSKEW_WORK(:)=XSKEW_WORK(:)/(ZSIZE(:)*XSTD_WORK(:)*XSTD_WORK(:)*XSTD_WORK(:))
+ XSKEW_WORK(:) = XSKEW_WORK(:)/(ZSIZE(:)*XSTD_WORK(:)*XSTD_WORK(:)*XSTD_WORK(:))
!
END WHERE
!
+END WHERE
!----------------------------------------------------------------------------
!
-END WHERE
+DO JI = 1,SIZE(XMEAN_WORK,1)
+
+ IF (XMEAN_WORK(JI)/=XUNDEF) THEN
+
+ ZINT = AINT(XMEAN_WORK(JI))
+ IF (XMEAN_WORK(JI)/=ZINT) &
+ XMEAN_WORK(JI) = ZINT + ANINT((XMEAN_WORK(JI)-ZINT)*XPREC)/XPREC
+
+ ZINT = AINT(XMIN_WORK(JI))
+ IF (XMIN_WORK(JI)/=ZINT) &
+ XMIN_WORK(JI) = ZINT + ANINT((XMIN_WORK(JI)-ZINT)*XPREC)/XPREC
+
+ ZINT = AINT(XMAX_WORK(JI))
+ IF (XMAX_WORK(JI)/=ZINT) &
+ XMAX_WORK(JI) = ZINT + ANINT((XMAX_WORK(JI)-ZINT)*XPREC)/XPREC
+
+ ZINT = AINT(XSTD_WORK(JI))
+ IF (XSTD_WORK(JI)/=ZINT) &
+ XSTD_WORK(JI) = ZINT + ANINT((XSTD_WORK(JI)-ZINT)*XPREC)/XPREC
+
+ ZINT = AINT(XSKEW_WORK(JI))
+ IF (XSKEW_WORK(JI)/=ZINT) &
+ XSKEW_WORK(JI) = ZINT + ANINT((XSKEW_WORK(JI)-ZINT)*XPREC)/XPREC
+!
+ ENDIF
+ENDDO
+!
IF (LHOOK) CALL DR_HOOK('AVERAGE2_CTI',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/average2_ldb.F90 b/src/SURFEX/average2_ldb.F90
index 9797fc9b668b776e3dea83d1e88d74284e2b3a87..25d28b695a7045bdcca934a49884cd4824a873bb 100644
--- a/src/SURFEX/average2_ldb.F90
+++ b/src/SURFEX/average2_ldb.F90
@@ -38,7 +38,8 @@
!* 0. DECLARATION
! -----------
!
-USE MODD_PGDWORK, ONLY : NSIZE, XTNG
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_PGDWORK, ONLY : NSIZE, XSUMVAL, XPREC
USE MODD_DATA_LAKE, ONLY : XBOUNDGRADDEPTH_LDB, XBOUNDGRADSTATUS_LDB, &
XCENTRGRADDEPTH_LDB, NCENTRGRADSTATUS_LDB, &
XSMALL_DUMMY
@@ -63,8 +64,9 @@ INTEGER, INTENT(IN) :: KSTAT
REAL, DIMENSION(:), ALLOCATABLE :: ZBOUND, ZCENTR
REAL :: ZFRAC, ZMAX, ZPDF, ZAVE
!
+REAL :: ZINT
INTEGER :: IGRAD_MODE
-INTEGER :: JGRAD, JI
+INTEGER :: JGR, JI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
!
@@ -93,25 +95,25 @@ SELECT CASE (HTYPE)
END SELECT
!
!
-DO JI = 1,SIZE(XTNG,1)
+DO JI = 1,SIZE(XSUMVAL,1)
!
- DO JGRAD = 1,SIZE(XTNG,2)
- IF (NSIZE(JI).NE.0) XTNG(JI,JGRAD) = XTNG(JI,JGRAD)/NSIZE(JI)
+ DO JGR = 1,SIZE(XSUMVAL,2)
+ IF (NSIZE(JI,1).NE.0) XSUMVAL(JI,JGR) = XSUMVAL(JI,JGR)/NSIZE(JI,1)
ENDDO
!
!2 because first centre is for values lower than 0
- ZFRAC = SUM(XTNG(JI,2:SIZE(XTNG,2)))
+ ZFRAC = SUM(XSUMVAL(JI,2:SIZE(XSUMVAL,2)))
!
ZMAX = XSMALL_DUMMY
IGRAD_MODE = 2
!
IF (KSTAT.EQ.1) THEN
!
- DO JGRAD = 2, SIZE(XTNG,2)
- ZPDF = XTNG(JI,JGRAD) / (ZBOUND(JGRAD)-ZBOUND(JGRAD-1))
+ DO JGR = 2, SIZE(XSUMVAL,2)
+ ZPDF = XSUMVAL(JI,JGR) / (ZBOUND(JGR)-ZBOUND(JGR-1))
IF (ZPDF.GT.ZMAX) THEN
ZMAX = ZPDF
- IGRAD_MODE = JGRAD
+ IGRAD_MODE = JGR
ENDIF
ENDDO
!
@@ -124,8 +126,8 @@ DO JI = 1,SIZE(XTNG,1)
ELSEIF (KSTAT.EQ.2) THEN
!
ZAVE = 0.
- DO JGRAD = 2, SIZE(XTNG,2)
- ZAVE = ZAVE + ZCENTR(JGRAD) * XTNG(JI,JGRAD)
+ DO JGR = 2, SIZE(XSUMVAL,2)
+ ZAVE = ZAVE + ZCENTR(JGR) * XSUMVAL(JI,JGR)
ENDDO
!
IF (ZFRAC.LT.0.00001) THEN
@@ -141,6 +143,18 @@ ENDDO
DEALLOCATE(ZBOUND)
DEALLOCATE(ZCENTR)
!
+!
+DO JI = 1,SIZE(PPGDARRAY)
+
+ IF (PPGDARRAY(JI)/=XUNDEF) THEN
+ ZINT = AINT(PPGDARRAY(JI))
+ IF (PPGDARRAY(JI)/=ZINT) THEN
+ PPGDARRAY(JI) = ZINT + ANINT((PPGDARRAY(JI)-ZINT)*XPREC)/XPREC
+ ENDIF
+ ENDIF
+
+ENDDO
+!
IF (LHOOK) CALL DR_HOOK('AVERAGE2_LDB',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/average2_mesh.F90 b/src/SURFEX/average2_mesh.F90
index b13f13abd8f0f5b9ae9069bae4ef90b198f1e684..00e03fc295502faf7fe8ba78b876e5c61a6b213e 100644
--- a/src/SURFEX/average2_mesh.F90
+++ b/src/SURFEX/average2_mesh.F90
@@ -28,8 +28,9 @@
!* 0. DECLARATION
! -----------
!
-USE MODD_PGDWORK, ONLY : NSIZE, XSUMVAL, CATYPE, &
- NVALNBR, NVALCOUNT, XVALLIST
+USE MODD_SURFEX_MPI, ONLY : NRANK
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_PGDWORK, ONLY : NSIZE, XSUMVAL, CATYPE, XPREC
USE MODD_DATA_COVER_PAR, ONLY : XCDREF
!
!
@@ -41,53 +42,55 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
-REAL, DIMENSION(:), INTENT(INOUT) :: PPGDARRAY ! Mesonh field
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PPGDARRAY ! Mesonh field
!
!* 0.2 Declaration of other local variables
! ------------------------------------
!
-INTEGER :: JLOOP ! loop counter on grid points
-INTEGER :: JVAL ! loop counter on values encountered in grid mesh
-INTEGER :: IMAX ! Maximum of times a value has been encountered in the grid mesh
-INTEGER :: IVAL ! Index of this value
+REAL :: ZINT
+INTEGER :: JI, JJ
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('AVERAGE2_MESH',0,ZHOOK_HANDLE)
SELECT CASE (CATYPE)
CASE ('ARI')
- WHERE (NSIZE(:)/=0)
- PPGDARRAY(:)=XSUMVAL(:)/NSIZE(:)
+ WHERE (NSIZE(:,:)/=0)
+ PPGDARRAY(:,:) = XSUMVAL(:,:)/NSIZE(:,:)
ENDWHERE
CASE ('INV')
- WHERE (NSIZE(:)/=0)
- PPGDARRAY(:)=NSIZE(:)/XSUMVAL(:)
+ WHERE (NSIZE(:,:)/=0)
+ PPGDARRAY(:,:) = NSIZE(:,:)/XSUMVAL(:,:)
ENDWHERE
CASE ('CDN')
- WHERE (NSIZE(:)/=0)
- PPGDARRAY(:)=XCDREF/EXP(SQRT(NSIZE(:)/XSUMVAL(:)))
+ WHERE (NSIZE(:,:)/=0)
+ PPGDARRAY(:,:) = XCDREF/EXP(SQRT(NSIZE(:,:)/XSUMVAL(:,:)))
ENDWHERE
CASE ('MAJ')
- DO JLOOP=1,SIZE(NSIZE)
- IF(NSIZE(JLOOP)==0) CYCLE
- !* determines the index of the value which has been the most encountered
- ! in the grid mesh
- IMAX=0
- DO JVAL=1,NVALNBR(JLOOP)
- IF (NVALCOUNT(JLOOP,JVAL)>IMAX) THEN
- IMAX=NVALCOUNT(JLOOP,JVAL)
- IVAL = JVAL
- END IF
- END DO
- !* sets this value to the PGD field
- PPGDARRAY(JLOOP)=XVALLIST(JLOOP,IVAL)
- END DO
-
+ WHERE (NSIZE(:,:)/=0)
+ PPGDARRAY(:,:) = XSUMVAL(:,:)
+ ENDWHERE
+
END SELECT
+!
+!
+DO JJ=1,SIZE(PPGDARRAY,2)
+ DO JI = 1,SIZE(PPGDARRAY,1)
+
+ IF (PPGDARRAY(JI,JJ)/=XUNDEF) THEN
+ ZINT = AINT(PPGDARRAY(JI,JJ),8)
+ IF (PPGDARRAY(JI,JJ)/=ZINT) THEN
+ PPGDARRAY(JI,JJ) = ZINT + ANINT((PPGDARRAY(JI,JJ)-ZINT)*XPREC)/XPREC
+ ENDIF
+ ENDIF
+
+ ENDDO
+ENDDO
+!
IF (LHOOK) CALL DR_HOOK('AVERAGE2_MESH',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/average2_orography.F90 b/src/SURFEX/average2_orography.F90
index 37b724543a63d2212c19cb4fd51dba4d29c671db..a98d7dc0dae4c27b5587728d0c7167d20b7f02cd 100644
--- a/src/SURFEX/average2_orography.F90
+++ b/src/SURFEX/average2_orography.F90
@@ -39,9 +39,11 @@
! -----------
!
!
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
-USE MODD_PGDWORK, ONLY : NSIZE, XSUMVAL, XSUMVAL2, LSSQO, XSSQO, NSSO
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_SURFEX_MPI, ONLY : NRANK
+USE MODD_PGDWORK, ONLY : NSIZE, XSUMVAL, LSSQO, XSSQO, NSSO, XPREC
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -57,9 +59,10 @@ IMPLICIT NONE
! ------------------------------------
!
!
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
-INTEGER :: JL
+REAL :: ZINT
+INTEGER :: JL, JI
REAL, DIMENSION(NSSO) :: ZMAXX
REAL, DIMENSION(NSSO) :: ZMAXY
LOGICAL, DIMENSION(NSSO) :: GSEGX
@@ -72,8 +75,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! --------------
!
IF (LHOOK) CALL DR_HOOK('AVERAGE2_OROGRAPHY',0,ZHOOK_HANDLE)
-WHERE (NSIZE(:)/=0)
- USS%XAVG_ZS(:)=XSUMVAL(:)/NSIZE(:)
+WHERE (NSIZE(:,1)/=0)
+ USS%XAVG_ZS(:) = XSUMVAL(:,1)/NSIZE(:,1)
END WHERE
!
!-------------------------------------------------------------------------------
@@ -81,8 +84,8 @@ END WHERE
!* 2. Standard deviation
! ------------------
!
-WHERE (NSIZE(:)/=0)
- USS%XSSO_STDEV(:)=SQRT( MAX(0.,XSUMVAL2(:)/NSIZE(:) - USS%XAVG_ZS(:)*USS%XAVG_ZS(:)) )
+WHERE (NSIZE(:,1)/=0)
+ USS%XSSO_STDEV(:) = SQRT( MAX(0.,XSUMVAL(:,2)/NSIZE(:,1) - USS%XAVG_ZS(:)*USS%XAVG_ZS(:)) )
END WHERE
!
!-------------------------------------------------------------------------------
@@ -91,15 +94,37 @@ END WHERE
! --------------------
!
DO JL=1,SIZE(USS%XSIL_ZS)
- IF (NSIZE(JL)==0) CYCLE
- ZMAXX(:) = MAXVAL(XSSQO(:,:,JL),DIM=2)
- GSEGX(:) = ANY (LSSQO(:,:,JL),DIM=2)
- ZMAXY(:) = MAXVAL(XSSQO(:,:,JL),DIM=1)
- GSEGY(:) = ANY (LSSQO(:,:,JL),DIM=1)
+ IF (NSIZE(JL,1)==0) CYCLE
+ ZMAXX(:) = MAXVAL(XSSQO(JL,:,:),DIM=2)
+ GSEGX(:) = ANY (LSSQO(JL,:,:),DIM=2)
+ ZMAXY(:) = MAXVAL(XSSQO(JL,:,:),DIM=1)
+ GSEGY(:) = ANY (LSSQO(JL,:,:),DIM=1)
USS%XSIL_ZS(JL) =0.5*( SUM(ZMAXX(:),MASK=GSEGX(:)) / COUNT(GSEGX(:)) &
- + SUM(ZMAXY(:),MASK=GSEGY(:)) / COUNT(GSEGY(:)) )
+ + SUM(ZMAXY(:),MASK=GSEGY(:)) / COUNT(GSEGY(:)) )
END DO
+!
+!
+DO JI = 1,SIZE(USS%XAVG_ZS)
+
+ IF (USS%XAVG_ZS(JI)/=XUNDEF) THEN
+
+ ZINT = AINT(USS%XAVG_ZS(JI))
+ IF (USS%XAVG_ZS(JI)/=ZINT) &
+ USS%XAVG_ZS(JI) = ZINT + ANINT((USS%XAVG_ZS(JI)-ZINT)*XPREC)/XPREC
+
+ ZINT = AINT(USS%XSSO_STDEV(JI))
+ IF (USS%XSSO_STDEV(JI)/=ZINT) &
+ USS%XSSO_STDEV(JI) = ZINT + ANINT((USS%XSSO_STDEV(JI)-ZINT)*XPREC)/XPREC
+
+ ZINT = AINT(USS%XSIL_ZS(JI))
+ IF (USS%XSIL_ZS(JI)/=ZINT) &
+ USS%XSIL_ZS(JI) = ZINT + ANINT((USS%XSIL_ZS(JI)-ZINT)*XPREC)/XPREC
+
+ ENDIF
+
+ENDDO
+!
IF (LHOOK) CALL DR_HOOK('AVERAGE2_OROGRAPHY',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/average_diag.F90 b/src/SURFEX/average_diag.F90
index e2dc52af0058e7e1903d6610803cbbfcb6a211e0..14364414e2a727b0a4b755b47730504e59c2ca61 100644
--- a/src/SURFEX/average_diag.F90
+++ b/src/SURFEX/average_diag.F90
@@ -3,30 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE AVERAGE_DIAG(K2M, OT2MMW, OSURF_BUDGET, OSURF_BUDGETC, OCOEF, &
- OSURF_VARS, PFRAC_TILE, &
- PRN_TILE, PH_TILE, PLE_TILE, PLEI_TILE , &
- PGFLUX_TILE, PRI_TILE, PCD_TILE, PCH_TILE, &
- PCE_TILE, PT2M_TILE, PTS_TILE, PQ2M_TILE, &
- PHU2M_TILE, PZON10M_TILE, PMER10M_TILE, &
- PQS_TILE, PZ0_TILE, PZ0H_TILE, &
- PSWD_TILE, PSWU_TILE, PSWBD_TILE, PSWBU_TILE, &
- PLWD_TILE, PLWU_TILE, PFMU_TILE, PFMV_TILE, &
- PRNC_TILE, PHC_TILE, PLEC_TILE, PGFLUXC_TILE, &
- PSWDC_TILE, PSWUC_TILE, PLWDC_TILE, PLWUC_TILE, &
- PFMUC_TILE, PFMVC_TILE, PT2M_MIN_TILE, &
- PT2M_MAX_TILE, PLEIC_TILE, &
- PRN, PH, PLE, PLEI, PGFLUX, PRI, PCD, PCH, PCE, &
- PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M, &
- PQS, PZ0, PZ0H, PUREF, PZREF, &
- PSWD, PSWU, PSWBD, PSWBU,PLWD, PLWU, PFMU, PFMV, &
- PRNC, PHC, PLEC, PGFLUXC, PSWDC, PSWUC, PLWDC, &
- PLWUC, PFMUC, PFMVC, PT2M_MIN, PT2M_MAX, PLEIC, &
- PHU2M_MIN_TILE, PHU2M_MAX_TILE, PHU2M_MIN, &
- PHU2M_MAX, PWIND10M_TILE, PWIND10M_MAX_TILE, &
- PWIND10M, PWIND10M_MAX, &
- PEVAP_TILE, PEVAPC_TILE, PEVAP, PEVAPC, &
- PSUBL_TILE, PSUBLC_TILE, PSUBL, PSUBLC )
+ SUBROUTINE AVERAGE_DIAG(PFRAC_TILE, DGO, D, ND, DC, NDC )
! ######################################################################
!
!
@@ -65,6 +42,10 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_DATA_COVER_PAR, ONLY : NTILESFC
+!
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_NP_t, DIAG_OPTIONS_t
+!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -72,118 +53,18 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-INTEGER, INTENT(IN) :: K2M ! Flag for 2m and 10m diagnostics
-LOGICAL, INTENT(IN) :: OT2MMW ! Flag to perform modified weighting of 2m temperature
-LOGICAL, INTENT(IN) :: OSURF_BUDGET ! Flag for surface energy budget
-LOGICAL, INTENT(IN) :: OSURF_BUDGETC! Flag for surface cumulated energy budget
-LOGICAL, INTENT(IN) :: OCOEF ! Flag for transfer coefficients
-LOGICAL, INTENT(IN) :: OSURF_VARS
REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_TILE ! Fraction in a mesh-area of
-! ! a given surface
-!* fields for each tile
-REAL, DIMENSION(:,:), INTENT(IN) :: PRN_TILE ! Net radiation (W/m2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PH_TILE ! Sensible heat flux (W/m2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PLE_TILE ! Total latent heat flux (W/m2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PLEI_TILE ! Sublimation latent heat flux (W/m2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PGFLUX_TILE ! Storage flux (W/m2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PEVAP_TILE ! Total evapotranspiration (kg/m2/s)
-REAL, DIMENSION(:,:), INTENT(IN) :: PSUBL_TILE ! Sublimation (kg/m2/s)
-REAL, DIMENSION(:,:), INTENT(IN) :: PRI_TILE ! Richardson number (-)
-REAL, DIMENSION(:,:), INTENT(IN) :: PCD_TILE ! drag coefficient for wind (W/s2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PCH_TILE ! drag coefficient for heat (W/s)
-REAL, DIMENSION(:,:), INTENT(IN) :: PCE_TILE ! drag coefficient for evaporation (W/s/K)
-REAL, DIMENSION(:,:), INTENT(IN) :: PT2M_TILE ! temperature at 2m (K)
-REAL, DIMENSION(:,:), INTENT(IN) :: PTS_TILE ! surface temperature (K)
-REAL, DIMENSION(:,:), INTENT(IN) :: PT2M_MIN_TILE ! minimum temperature at 2m (K)
-REAL, DIMENSION(:,:), INTENT(IN) :: PT2M_MAX_TILE ! maximum temperature at 2m (K)
-REAL, DIMENSION(:,:), INTENT(IN) :: PQ2M_TILE ! humidity at 2m (kg/kg)
-REAL, DIMENSION(:,:), INTENT(IN) :: PHU2M_TILE ! relative humidity at 2m (-)
-REAL, DIMENSION(:,:), INTENT(IN) :: PHU2M_MAX_TILE! maximum relative humidity at 2m (-)
-REAL, DIMENSION(:,:), INTENT(IN) :: PHU2M_MIN_TILE! minimum relative humidity at 2m (-)
-REAL, DIMENSION(:,:), INTENT(IN) :: PZON10M_TILE ! zonal wind at 10m (m/s)
-REAL, DIMENSION(:,:), INTENT(IN) :: PMER10M_TILE ! meridian wind at 10m(m/s)
-REAL, DIMENSION(:,:), INTENT(IN) :: PWIND10M_TILE ! wind at 10m (m/s)
-REAL, DIMENSION(:,:), INTENT(IN) :: PWIND10M_MAX_TILE ! maximum wind at 10m(m/s)
-REAL, DIMENSION(:,:), INTENT(IN) :: PQS_TILE
-REAL, DIMENSION(:,:), INTENT(IN) :: PZ0_TILE ! roughness lenght for momentum (m)
-REAL, DIMENSION(:,:), INTENT(IN) :: PZ0H_TILE ! roughness lenght for heat (m)
-REAL, DIMENSION(:,:), INTENT(IN) :: PSWD_TILE ! short wave incoming radiation (W/m2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PSWU_TILE ! short wave outgoing radiation (W/m2)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSWBD_TILE ! short wave incoming radiation for each spectral band (W/m2)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSWBU_TILE ! short wave outgoing radiation for each spectral band (W/m2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PLWD_TILE ! long wave incoming radiation (W/m2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PLWU_TILE ! long wave outgoing radiation (W/m2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PFMU_TILE ! zonal friction
-REAL, DIMENSION(:,:), INTENT(IN) :: PFMV_TILE ! meridian friction
-REAL, DIMENSION(:,:), INTENT(IN) :: PRNC_TILE ! Net radiation (J/m2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PHC_TILE ! Sensible heat flux (J/m2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PLEC_TILE ! Total latent heat flux (J/m2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PLEIC_TILE ! Sublimation latent heat flux (J/m2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PGFLUXC_TILE ! Storage flux (J/m2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PEVAPC_TILE ! Total evapotranspiration (kg/m2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PSUBLC_TILE ! Sublimation (kg/m2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PSWDC_TILE ! short wave incoming radiation (J/m2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PSWUC_TILE ! short wave outgoing radiation (J/m2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PLWDC_TILE ! long wave incoming radiation (J/m2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PLWUC_TILE ! long wave outgoing radiation (J/m2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PFMUC_TILE ! zonal friction
-REAL, DIMENSION(:,:), INTENT(IN) :: PFMVC_TILE ! meridian friction
-!
-REAL, DIMENSION(:), INTENT(IN) :: PUREF ! reference height for wind (m)
-REAL, DIMENSION(:), INTENT(IN) :: PZREF ! reference height for T,q (m)
-!
-!* aggregated fields
-REAL, DIMENSION(:), INTENT(OUT) :: PRN ! Net radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PH ! Sensible heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLE ! Total latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEI ! Sublimation latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX ! Storage flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAP ! Total evapotranspiration (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSUBL ! Sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PRI ! Richardson number (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PCD ! drag coefficient for wind (W/s2)
-REAL, DIMENSION(:), INTENT(OUT) :: PCH ! drag coefficient for heat (W/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PCE ! drag coefficient for evaporation (W/s/K)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M ! temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PTS ! surface temperature (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PQ2M ! humidity at 2m (kg/kg)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M ! relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PZON10M ! zonal wind at 10m (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PMER10M ! meridian wind at 10m(m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PQS
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0 ! roughness lenght for momentum (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0H ! roughness lenght for heat (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWD ! short wave incoming radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWU ! short wave outgoing radiation (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBD ! short wave incoming radiation for each spectral band (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBU ! short wave outgoing radiation for each spectral band (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWD ! long wave incoming radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWU ! long wave outgoing radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMU ! zonal friction
-REAL, DIMENSION(:), INTENT(OUT) :: PFMV ! meridian friction
-REAL, DIMENSION(:), INTENT(OUT) :: PRNC ! Net radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PHC ! Sensible heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEC ! Total latent heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEIC ! Sublimation latent heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUXC ! Storage flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAPC ! Total evapotranspiration (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSUBLC ! Sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWDC ! incoming short wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWUC ! outgoing short wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWDC ! incoming long wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWUC ! outgoing long wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMUC ! zonal friction
-REAL, DIMENSION(:), INTENT(OUT) :: PFMVC ! meridian friction
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MIN! Minimum relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MAX! Maximum relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MIN ! Minimum temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MAX ! Maximum temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M ! wind at 10m(m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M_MAX ! Maximum wind at 10m(m/s)
+!
+TYPE(DIAG_OPTIONS_t), INTENt(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_NP_t), INTENT(INOUT) :: ND
+TYPE(DIAG_t), INTENT(INOUT) :: DC
+TYPE(DIAG_NP_t), INTENT(INOUT) :: NDC
!
!* 0.2 declarations of local variables
!
+REAL, DIMENSION(SIZE(PFRAC_TILE,1)) :: ZLAND, ZSEA, ZFRL
+INTEGER :: JT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
@@ -192,124 +73,132 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG',0,ZHOOK_HANDLE)
!
-IF (OSURF_BUDGET) THEN
+IF (DGO%LSURF_BUDGET) THEN
!
-! Net radiation
-!
- CALL MAKE_AVERAGE(PFRAC_TILE,PRN_TILE,PRN)
+ DO JT = 1,NTILESFC
+ !
+ ! Net radiation
+ !
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XRN,D%XRN,JT)
!
! Sensible heat flux
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PH_TILE,PH)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XH,D%XH,JT)
!
! Total latent heat flux
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PLE_TILE,PLE)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XLE,D%XLE,JT)
!
! Sublimation latent heat flux
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PLEI_TILE,PLEI)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XLEI,D%XLEI,JT)
!
! Total evapotranspiration
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PEVAP_TILE,PEVAP)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XEVAP,D%XEVAP,JT)
!
! Sublimation
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PSUBL_TILE,PSUBL)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XSUBL,D%XSUBL,JT)
!
! Storage flux
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PGFLUX_TILE,PGFLUX)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XGFLUX,D%XGFLUX,JT)
!
! Downwards short wave radiation
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PSWD_TILE,PSWD)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XSWD,D%XSWD,JT)
!
! Upwards short wave radiation
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PSWU_TILE,PSWU)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XSWU,D%XSWU,JT)
!
! Downwards long wave radiation
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PLWD_TILE,PLWD)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XLWD,D%XLWD,JT)
!
! Upwards long wave radiation
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PLWU_TILE,PLWU)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XLWU,D%XLWU,JT)
!
! Zonal wind stress
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PFMU_TILE,PFMU)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XFMU,D%XFMU,JT)
!
! Meridian wind stress
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PFMV_TILE,PFMV)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XFMV,D%XFMV,JT)
!
! Downwards short wave radiation for each spectral band
!
- CALL MAKE_AVERAGE_2D(PFRAC_TILE,PSWBD_TILE,PSWBD)
+ CALL MAKE_AVERAGE_2D(PFRAC_TILE(:,JT),ND%AL(JT)%XSWBD,D%XSWBD,JT)
!
! Upwards short wave radiation for each spectral band
!
- CALL MAKE_AVERAGE_2D(PFRAC_TILE,PSWBU_TILE,PSWBU)
+ CALL MAKE_AVERAGE_2D(PFRAC_TILE(:,JT),ND%AL(JT)%XSWBU,D%XSWBU,JT)
!
+ ENDDO
+ !
END IF
!
-IF (OSURF_BUDGETC) THEN
+IF (DGO%LSURF_BUDGETC) THEN
!
+ DO JT = 1,NTILESFC
+ !
! Net radiation
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PRNC_TILE,PRNC)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),NDC%AL(JT)%XRN,DC%XRN,JT)
!
! Sensible heat flux
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PHC_TILE,PHC)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),NDC%AL(JT)%XH,DC%XH,JT)
!
! Total latent heat flux
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PLEC_TILE,PLEC)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),NDC%AL(JT)%XLE,DC%XLE,JT)
!
! Sublimation latent heat flux
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PLEIC_TILE,PLEIC)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),NDC%AL(JT)%XLEI,DC%XLEI,JT)
!
! Storage flux
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PGFLUXC_TILE,PGFLUXC)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),NDC%AL(JT)%XGFLUX,DC%XGFLUX,JT)
!
! Total evapotranspiration
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PEVAPC_TILE,PEVAPC)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),NDC%AL(JT)%XEVAP,DC%XEVAP,JT)
!
! Sublimation
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PSUBLC_TILE,PSUBLC)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),NDC%AL(JT)%XSUBL,DC%XSUBL,JT)
!
! Downwards short wave radiation
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PSWDC_TILE,PSWDC)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),NDC%AL(JT)%XSWD,DC%XSWD,JT)
!
! Upwards short wave radiation
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PSWUC_TILE,PSWUC)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),NDC%AL(JT)%XSWU,DC%XSWU,JT)
!
! Downwards long wave radiation
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PLWDC_TILE,PLWDC)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),NDC%AL(JT)%XLWD,DC%XLWD,JT)
!
! Upwards long wave radiation
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PLWUC_TILE,PLWUC)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),NDC%AL(JT)%XLWU,DC%XLWU,JT)
!
! Zonal wind stress
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PFMUC_TILE,PFMUC)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),NDC%AL(JT)%XFMU,DC%XFMU,JT)
!
! Meridian wind stress
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PFMVC_TILE,PFMVC)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),NDC%AL(JT)%XFMV,DC%XFMV,JT)
!
+ ENDDO
+ !
END IF
!
!-------------------------------------------------------------------------------
@@ -317,9 +206,13 @@ END IF
! 2. Richardson number
! -----------------
!
-IF (K2M>=1) THEN
+IF (DGO%N2M>=1) THEN
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PRI_TILE,PRI)
+ DO JT = 1,NTILESFC
+ !
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XRI,D%XRI,JT)
+ !
+ ENDDO
!
ENDIF
!
@@ -329,221 +222,241 @@ ENDIF
! --------------------------------------------------
!
!
-IF (K2M>=1.OR.OSURF_BUDGET.OR.OSURF_BUDGETC) THEN
+IF (DGO%N2M>=1.OR.DGO%LSURF_BUDGET.OR.DGO%LSURF_BUDGETC) THEN
!
+ DO JT = 1,NTILESFC
+ !
! Surface temperature
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PTS_TILE,PTS)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XTS,D%XTS,JT)
!
+ ENDDO
+ !
ENDIF
!
-IF (K2M>=1) THEN
+IF (DGO%N2M>=1) THEN
!
! Temperature at 2 meters
!
- IF (OT2MMW) THEN
+ IF (DGO%LT2MMW) THEN
+ DO JT=1,NTILESFC
! Modified weighting giving increased weight to LAND temperature
- CALL MAKE_AVERAGE_MW(PFRAC_TILE,PT2M_TILE,PT2M)
- CALL MAKE_AVERAGE_MW(PFRAC_TILE,PT2M_MIN_TILE,PT2M_MIN)
- CALL MAKE_AVERAGE_MW(PFRAC_TILE,PT2M_MAX_TILE,PT2M_MAX)
+ CALL MAKE_AVERAGE_MW(PFRAC_TILE(:,JT),ND%AL(JT)%XT2M,D%XT2M,JT,ZLAND,ZSEA,ZFRL)
+ ENDDO
+ DO JT=1,NTILESFC
+ CALL MAKE_AVERAGE_MW(PFRAC_TILE(:,JT),ND%AL(JT)%XT2M_MIN,D%XT2M_MIN,JT,ZLAND,ZSEA,ZFRL)
+ ENDDO
+ DO JT=1,NTILESFC
+ CALL MAKE_AVERAGE_MW(PFRAC_TILE(:,JT),ND%AL(JT)%XT2M_MAX,D%XT2M_MAX,JT,ZLAND,ZSEA,ZFRL)
+ ENDDO
ELSE
- CALL MAKE_AVERAGE(PFRAC_TILE,PT2M_TILE,PT2M)
- CALL MAKE_AVERAGE(PFRAC_TILE,PT2M_MIN_TILE,PT2M_MIN)
- CALL MAKE_AVERAGE(PFRAC_TILE,PT2M_MAX_TILE,PT2M_MAX)
+ DO JT=1,NTILESFC
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XT2M,D%XT2M,JT)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XT2M_MIN,D%XT2M_MIN,JT)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XT2M_MAX,D%XT2M_MAX,JT)
+ ENDDO
ENDIF
!
+ DO JT=1,NTILESFC
! Relative humidity at 2 meters
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PHU2M_TILE,PHU2M)
- CALL MAKE_AVERAGE(PFRAC_TILE,PHU2M_MIN_TILE,PHU2M_MIN)
- CALL MAKE_AVERAGE(PFRAC_TILE,PHU2M_MAX_TILE,PHU2M_MAX)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XHU2M,D%XHU2M,JT)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XHU2M_MIN,D%XHU2M_MIN,JT)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XHU2M_MAX,D%XHU2M_MAX,JT)
!
! Specific humidity at 2 meters
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PQ2M_TILE,PQ2M)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XQ2M,D%XQ2M,JT)
!
! Wind at 10 meters
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PZON10M_TILE,PZON10M)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XZON10M,D%XZON10M,JT)
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PMER10M_TILE,PMER10M)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XMER10M,D%XMER10M,JT)
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PWIND10M_TILE,PWIND10M)
- CALL MAKE_AVERAGE(PFRAC_TILE,PWIND10M_MAX_TILE,PWIND10M_MAX)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XWIND10M,D%XWIND10M,JT)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XWIND10M_MAX,D%XWIND10M_MAX,JT)
!
+ ENDDO
+ !
END IF
!-------------------------------------------------------------------------------
!
! 4. Transfer coeffients and roughness lengths
! -----------------------------------------
!
-IF (OCOEF) THEN
+IF (DGO%LCOEF) THEN
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PCD_TILE,PCD)
+ DO JT=1,NTILESFC
+ !
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XCD,D%XCD,JT)
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PCH_TILE,PCH)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XCH,D%XCH,JT)
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PCE_TILE,PCE)
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XCE,D%XCE,JT)
!
- CALL MAKE_AVERAGE_Z0(PFRAC_TILE,PUREF,PZ0_TILE,PZ0)
+ CALL MAKE_AVERAGE_Z0(PFRAC_TILE(:,JT),D%XUREF,ND%AL(JT)%XZ0,D%XZ0,JT)
!
- CALL MAKE_AVERAGE_Z0(PFRAC_TILE,PZREF,PZ0H_TILE,PZ0H)
+ CALL MAKE_AVERAGE_Z0(PFRAC_TILE(:,JT),D%XZREF,ND%AL(JT)%XZ0H,D%XZ0H,JT)
!
+ ENDDO
+ !
ENDIF
!
-IF (OSURF_VARS) THEN
+IF (DGO%LSURF_VARS) THEN
!
- CALL MAKE_AVERAGE(PFRAC_TILE,PQS_TILE,PQS)
+ DO JT=1,NTILESFC
+ CALL MAKE_AVERAGE(PFRAC_TILE(:,JT),ND%AL(JT)%XQS,D%XQS,JT)
+ ENDDO
!
ENDIF
!
IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG',1,ZHOOK_HANDLE)
!
- CONTAINS
+CONTAINS
!
-SUBROUTINE MAKE_AVERAGE(PFRAC,PFIELD_IN,PFIELD_OUT)
+SUBROUTINE MAKE_AVERAGE(PFRAC,PFIELD_IN,PFIELD_OUT,KTILE)
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
IMPLICIT NONE
!
-REAL, DIMENSION(:,:),INTENT(IN) :: PFRAC
-REAL, DIMENSION(:,:),INTENT(IN) :: PFIELD_IN
+REAL, DIMENSION(:),INTENT(IN) :: PFRAC
+REAL, DIMENSION(:),INTENT(IN) :: PFIELD_IN
REAL, DIMENSION(:), INTENT(OUT) :: PFIELD_OUT
-LOGICAL, DIMENSION(SIZE(PFIELD_IN,1)) :: GMASK
+INTEGER, INTENT(IN) :: KTILE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER :: JT
!
IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG:MAKE_AVERAGE',0,ZHOOK_HANDLE)
!
-GMASK(:) = .TRUE.
-DO JT=1,SIZE(PFIELD_IN,2)
- WHERE (PFIELD_IN(:,JT)==XUNDEF .AND. PFRAC(:,JT)/=0.) GMASK(:) = .FALSE.
-END DO
+IF (KTILE==1) PFIELD_OUT(:) = 0.
!
-PFIELD_OUT(:) = 0.
-DO JT=1,SIZE(PFIELD_IN,2)
- PFIELD_OUT(:) = PFIELD_OUT(:) + PFRAC(:,JT) * PFIELD_IN(:,JT)
-END DO
-WHERE(.NOT. GMASK(:)) PFIELD_OUT(:) = XUNDEF
+WHERE (PFIELD_IN(:)==XUNDEF .AND. PFRAC(:)/=0.) PFIELD_OUT(:) = XUNDEF
+!
+WHERE (PFIELD_OUT(:)/=XUNDEF)
+ PFIELD_OUT(:) = PFIELD_OUT(:) + PFRAC(:) * PFIELD_IN(:)
+END WHERE
!
IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG:MAKE_AVERAGE',1,ZHOOK_HANDLE)
!
END SUBROUTINE MAKE_AVERAGE
!
-SUBROUTINE MAKE_AVERAGE_2D(PFRAC,PFIELD_IN,PFIELD_OUT)
+SUBROUTINE MAKE_AVERAGE_2D(PFRAC,PFIELD_IN,PFIELD_OUT,KTILE)
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
IMPLICIT NONE
!
-REAL, DIMENSION(:,:),INTENT(IN) :: PFRAC
-REAL, DIMENSION(:,:,:),INTENT(IN) :: PFIELD_IN
+REAL, DIMENSION(:),INTENT(IN) :: PFRAC
+REAL, DIMENSION(:,:),INTENT(IN) :: PFIELD_IN
REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELD_OUT
-LOGICAL, DIMENSION(SIZE(PFIELD_IN,1)) :: GMASK
+INTEGER, INTENT(IN) :: KTILE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER :: JT, JL
!
IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG:MAKE_AVERAGE_2D',0,ZHOOK_HANDLE)
!
-DO JL=1,SIZE(PFIELD_IN,3)
- PFIELD_OUT(:,JL) = 0.
- GMASK(:) = .TRUE.
- DO JT=1,SIZE(PFIELD_IN,2)
- WHERE (PFIELD_IN(:,JT,JL)==XUNDEF .AND. PFRAC(:,JT)/=0.) GMASK(:) = .FALSE.
- PFIELD_OUT(:,JL) = PFIELD_OUT(:,JL) + PFRAC(:,JT) * PFIELD_IN(:,JT,JL)
- END DO
- WHERE(.NOT. GMASK(:)) PFIELD_OUT(:,JL) = XUNDEF
+IF (KTILE==1) PFIELD_OUT(:,:) = 0.
+!
+DO JL=1,SIZE(PFIELD_IN,2)
+ WHERE (PFIELD_IN(:,JL)==XUNDEF .AND. PFRAC(:)/=0.) PFIELD_OUT(:,JL) = XUNDEF
+ WHERE(PFIELD_OUT(:,JL)/=XUNDEF)
+ PFIELD_OUT(:,JL) = PFIELD_OUT(:,JL) + PFRAC(:) * PFIELD_IN(:,JL)
+ END WHERE
END DO
!
IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG:MAKE_AVERAGE_2D',1,ZHOOK_HANDLE)
!
END SUBROUTINE MAKE_AVERAGE_2D
!
-SUBROUTINE MAKE_AVERAGE_Z0(PFRAC,PREF,PFIELD_IN,PFIELD_OUT)
+SUBROUTINE MAKE_AVERAGE_Z0(PFRAC,PREF,PFIELD_IN,PFIELD_OUT,KTILE)
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
IMPLICIT NONE
!
-REAL, DIMENSION(:,:),INTENT(IN) :: PFRAC
-REAL, DIMENSION(:,:),INTENT(IN) :: PFIELD_IN
+REAL, DIMENSION(:),INTENT(IN) :: PFRAC
+REAL, DIMENSION(:),INTENT(IN) :: PFIELD_IN
REAL, DIMENSION(:),INTENT(IN) :: PREF
REAL, DIMENSION(:), INTENT(OUT) :: PFIELD_OUT
-LOGICAL, DIMENSION(SIZE(PFIELD_IN,1)) :: GMASK
+INTEGER, INTENT(IN) :: KTILE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
-INTEGER :: JT, JL,JI
!
IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG:MAKE_AVERAGE_Z0',0,ZHOOK_HANDLE)
!
-GMASK(:) = .TRUE.
-DO JT=1,SIZE(PFIELD_IN,2)
- DO JI=1,SIZE(PFIELD_IN,1)
- IF (PFIELD_IN(JI,JT)==XUNDEF .AND. PFRAC(JI,JT)/=0.) THEN
- GMASK(:) = .FALSE.
- END IF
- END DO
-END DO
+IF (KTILE==1) PFIELD_OUT(:) = 0.
!
-PFIELD_OUT(:) = 0.
-DO JT=1,SIZE(PFIELD_IN,2)
- PFIELD_OUT(:) = PFIELD_OUT(:) + PFRAC(:,JT) * 1./(LOG(PREF(:)/PFIELD_IN(:,JT)))**2
-END DO
-WHERE (PFIELD_OUT(:) == 0.)
- PFIELD_OUT(:) = XUNDEF
-ELSEWHERE
- PFIELD_OUT(:) = PREF(:) * EXP( - SQRT(1./PFIELD_OUT(:)) )
-ENDWHERE
-WHERE(.NOT. GMASK(:)) PFIELD_OUT(:) = XUNDEF
+WHERE (PFIELD_IN(:)==XUNDEF .AND. PFRAC(:)/=0.) PFIELD_OUT(:) = XUNDEF
+!
+WHERE (PFIELD_OUT(:)/=XUNDEF)
+ PFIELD_OUT(:) = PFIELD_OUT(:) + PFRAC(:) * 1./(LOG(PREF(:)/PFIELD_IN(:)))**2
+END WHERE
+!
+IF (KTILE==NTILESFC) THEN
+ WHERE (PFIELD_OUT(:) == 0.)
+ PFIELD_OUT(:) = XUNDEF
+ ELSEWHERE (PFIELD_OUT(:)/=XUNDEF)
+ PFIELD_OUT(:) = PREF(:) * EXP( - SQRT(1./PFIELD_OUT(:)) )
+ ENDWHERE
+ENDIF
!
IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG:MAKE_AVERAGE_Z0',1,ZHOOK_HANDLE)
!
END SUBROUTINE MAKE_AVERAGE_Z0
!
-SUBROUTINE MAKE_AVERAGE_MW(PFRAC,PFIELD_IN,PFIELD_OUT)
+SUBROUTINE MAKE_AVERAGE_MW(PFRAC,PFIELD_IN,PFIELD_OUT,KTILE,PLAND,PSEA,PFRL)
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
IMPLICIT NONE
!
-REAL, DIMENSION(:,:),INTENT(IN) :: PFRAC
-REAL, DIMENSION(:,:),INTENT(IN) :: PFIELD_IN
+REAL, DIMENSION(:),INTENT(IN) :: PFRAC
+REAL, DIMENSION(:),INTENT(IN) :: PFIELD_IN
REAL, DIMENSION(:), INTENT(OUT) :: PFIELD_OUT
-LOGICAL, DIMENSION(SIZE(PFIELD_IN,1)) :: GMASK
+INTEGER, INTENT(IN) :: KTILE
+REAL, DIMENSION(:), INTENT(INOUT) :: PLAND
+REAL, DIMENSION(:), INTENT(INOUT) :: PSEA
+REAL, DIMENSION(:), INTENT(INOUT) :: PFRL
REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER :: JT
-REAL, DIMENSION(SIZE(PFIELD_IN,1)) :: ZT2M_LAND, ZT2M_SEA, ZFRL, ZALFA
+REAL, DIMENSION(SIZE(PFIELD_IN)) :: ZALFA
!
IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG:MAKE_AVERAGE_MW',0,ZHOOK_HANDLE)
!
-GMASK(:) = .TRUE.
-DO JT=1,SIZE(PFIELD_IN,2)
- WHERE (PFIELD_IN(:,JT)==XUNDEF .AND. PFRAC(:,JT)/=0.) GMASK(:) = .FALSE.
-END DO
+IF (KTILE==1) THEN
+ PFIELD_OUT(:) = 0.
+ PSEA (:)= 0.
+ PLAND (:)= 0.
+ PFRL (:)= 0.
+ENDIF
!
-ZT2M_SEA (:)= 0.
-ZT2M_LAND (:)= 0.
-ZFRL (:)= 0.
-DO JT=1,2
- ZT2M_SEA (:) = ZT2M_SEA(:) + PFRAC(:,JT) * PFIELD_IN(:,JT)
-END DO
+WHERE (PFIELD_IN(:)==XUNDEF .AND. PFRAC(:)/=0.) PFIELD_OUT(:) = XUNDEF
!
-DO JT=3,4
- ZT2M_LAND (:) = ZT2M_LAND(:) + PFRAC(:,JT) * PFIELD_IN(:,JT)
- ZFRL (:) = ZFRL (:) + PFRAC(:,JT)
-END DO
+IF (KTILE==1.OR.KTILE==2) THEN
+ PSEA (:) = PSEA(:) + PFRAC(:) * PFIELD_IN(:)
+ENDIF
+!
+IF (KTILE==3.OR.KTILE==4) THEN
+ PLAND (:) = PLAND(:) + PFRAC(:) * PFIELD_IN(:)
+ PFRL (:) = PFRL (:) + PFRAC(:)
+ENDIF
!
-WHERE(ZFRL(:)>0.)
- ZT2M_LAND (:) = ZT2M_LAND(:)/ZFRL(:)
-ENDWHERE
-WHERE(ZFRL(:)<1.)
- ZT2M_SEA (:) = ZT2M_SEA (:)/(1.-ZFRL(:))
-ENDWHERE
-!
-ZALFA (:) = 1. - EXP(-10.*ZFRL(:))
-PFIELD_OUT(:) = ZALFA(:) * ZT2M_LAND(:) + (1. - ZALFA(:)) * ZT2M_SEA(:)
-
-WHERE(.NOT. GMASK(:)) PFIELD_OUT(:) = XUNDEF
+IF (KTILE==4) THEN
+ WHERE(ZFRL(:)>0.)
+ ZLAND (:) = ZLAND(:)/ZFRL(:)
+ ENDWHERE
+ WHERE(ZFRL(:)<1.)
+ ZSEA (:) = ZSEA (:)/(1.-ZFRL(:))
+ ENDWHERE
+ !
+ ZALFA (:) = 1. - EXP(-10.*ZFRL(:))
+ !
+ WHERE (PFIELD_OUT(:)/=XUNDEF)
+ PFIELD_OUT(:) = ZALFA(:) * ZLAND(:) + (1. - ZALFA(:)) * ZSEA(:)
+ END WHERE
+ !
+ENDIF
!
IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG:MAKE_AVERAGE_MW',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/average_diag_evap_isban.F90 b/src/SURFEX/average_diag_evap_isban.F90
index 40ffd13d23981793013a870f923cc19277e02f70..4fbb2233d6bfd39fc0050514417c670ecdba730a 100644
--- a/src/SURFEX/average_diag_evap_isban.F90
+++ b/src/SURFEX/average_diag_evap_isban.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#############################
-SUBROUTINE AVERAGE_DIAG_EVAP_ISBA_n (DGEI, I, &
- PTSTEP,PRAIN,PSNOW)
+SUBROUTINE AVERAGE_DIAG_EVAP_ISBA_n (OSURF_BUDGETC, DE, DEC, NDE, NDEC, NP, KNPATCH, &
+ OGLACIER, OMEB_PATCH, PTSTEP, PRAIN, PSNOW)
!#############################
!
!
@@ -46,10 +46,10 @@ SUBROUTINE AVERAGE_DIAG_EVAP_ISBA_n (DGEI, I, &
!* 0. DECLARATIONS
! ------------
!
+USE MODE_DIAG
!
-!
-USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t, DIAG_EVAP_ISBA_NP_t
+USE MODD_ISBA_n, ONLY : ISBA_NP_t
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -59,8 +59,16 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DGEI
-TYPE(ISBA_t), INTENT(INOUT) :: I
+LOGICAL, INTENT(IN) :: OSURF_BUDGETC
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DE
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEC
+TYPE(DIAG_EVAP_ISBA_NP_t), INTENT(INOUT) :: NDE
+TYPE(DIAG_EVAP_ISBA_NP_t), INTENT(INOUT) :: NDEC
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+INTEGER, INTENT(IN) :: KNPATCH
+!
+LOGICAL, INTENT(IN) :: OGLACIER
+LOGICAL, DIMENSION(:), INTENT(IN) :: OMEB_PATCH
!
REAL, INTENT(IN) :: PTSTEP ! time step (s)
REAL, DIMENSION(:), INTENT(IN) :: PRAIN ! rainfall rate
@@ -69,10 +77,9 @@ REAL, DIMENSION(:), INTENT(IN) :: PSNOW ! snowfall rate
!
!* 0.2 declarations of local variables
!
-INTEGER :: JPATCH ! tile loop counter
-INTEGER :: JJ
+INTEGER :: JP ! tile loop counter
+INTEGER :: JI, IMASK
INTEGER :: ISIZE_LMEB_PATCH ! Number of patches where multi-energy balance should be applied
-REAL, DIMENSION(SIZE(I%XPATCH,1)) :: ZSUMPATCH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
@@ -82,514 +89,231 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG_EVAP_ISBA_N',0,ZHOOK_HANDLE)
!
-ISIZE_LMEB_PATCH=COUNT(I%LMEB_PATCH(:))
-!
-ZSUMPATCH(:) = 0.
-DO JPATCH=1,SIZE(I%XPATCH,2)
- DO JJ=1,SIZE(I%XPATCH,1)
- ZSUMPATCH(JJ) = ZSUMPATCH(JJ) + I%XPATCH(JJ,JPATCH)
- ENDDO
-ENDDO
+ISIZE_LMEB_PATCH=COUNT(OMEB_PATCH(:))
!
! 1. Surface Energy fluxes
! -----------------------
!
-IF (DGEI%LSURF_EVAP_BUDGET) THEN
-!
- DGEI%XAVG_LEG (:) = 0.
- DGEI%XAVG_LEGI (:) = 0.
- DGEI%XAVG_LEV (:) = 0.
- DGEI%XAVG_LES (:) = 0.
- DGEI%XAVG_LESL (:) = 0.
- DGEI%XAVG_LER (:) = 0.
- DGEI%XAVG_LETR (:) = 0.
- DGEI%XAVG_EVAP (:) = 0.
- DGEI%XAVG_SUBL (:) = 0.
- DGEI%XAVG_SNDRIFT (:) = 0.
- DGEI%XAVG_DRAIN (:) = 0.
- DGEI%XAVG_QSB (:) = 0.
- DGEI%XAVG_RUNOFF (:) = 0.
- DGEI%XAVG_HORT (:) = 0.
- DGEI%XAVG_DRIP (:) = 0.
- DGEI%XAVG_RRVEG (:) = 0.
- DGEI%XAVG_MELT (:) = 0.
- DGEI%XAVG_IFLOOD (:) = 0.
- DGEI%XAVG_PFLOOD (:) = 0.
- DGEI%XAVG_LE_FLOOD (:) = 0.
- DGEI%XAVG_LEI_FLOOD (:) = 0.
- DGEI%XAVG_IRRIG_FLUX (:) = 0.
- DGEI%XAVG_GPP (:) = 0.
- DGEI%XAVG_RESP_AUTO (:) = 0.
- DGEI%XAVG_RESP_ECO (:) = 0.
-!
- IF (ISIZE_LMEB_PATCH>0) THEN
- DGEI%XAVG_LEVCV (:) = 0.
- DGEI%XAVG_LESC (:) = 0.
- DGEI%XAVG_LETRGV (:) = 0.
- DGEI%XAVG_LETRCV (:) = 0.
- DGEI%XAVG_LERGV (:) = 0.
- DGEI%XAVG_LELITTER (:) = 0.
- DGEI%XAVG_LELITTERI (:) = 0.
- DGEI%XAVG_DRIPLIT (:) = 0.
- DGEI%XAVG_RRLIT (:) = 0.
- DGEI%XAVG_LERCV (:) = 0.
- DGEI%XAVG_LE_C_A (:) = 0.
- DGEI%XAVG_LE_V_C (:) = 0.
- DGEI%XAVG_LE_G_C (:) = 0.
- DGEI%XAVG_LE_N_C (:) = 0.
- !
- DGEI%XAVG_SWNET_V (:) = 0.
- DGEI%XAVG_SWNET_G (:) = 0.
- DGEI%XAVG_SWNET_N (:) = 0.
- DGEI%XAVG_SWNET_NS (:) = 0.
- DGEI%XAVG_LWNET_V (:) = 0.
- DGEI%XAVG_LWNET_G (:) = 0.
- DGEI%XAVG_LWNET_N (:) = 0.
- DGEI%XAVG_SWDOWN_GN (:) = 0.
- DGEI%XAVG_LWDOWN_GN (:) = 0.
- DGEI%XAVG_H_V_C (:) = 0.
- DGEI%XAVG_H_G_C (:) = 0.
- DGEI%XAVG_H_C_A (:) = 0.
- DGEI%XAVG_H_N_C (:) = 0.
- DGEI%XAVG_SR_GN (:) = 0.
- DGEI%XAVG_MELTCV (:) = 0.
- DGEI%XAVG_FRZCV (:) = 0.
- ENDIF
-!
- DO JPATCH=1,SIZE(I%XPATCH,2)
-!cdir nodep
- DO JJ=1,SIZE(ZSUMPATCH)
- IF (ZSUMPATCH(JJ) > 0.) THEN
-!
-! Latent heat of evaporation over the ground
-!
- DGEI%XAVG_LEG(JJ) = DGEI%XAVG_LEG(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLEG(JJ,JPATCH)
-!
-! Surface soil ice sublimation
-!
- DGEI%XAVG_LEGI(JJ) = DGEI%XAVG_LEGI(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLEGI(JJ,JPATCH)
-!
-! Latent heat of evaporation over vegetation
-!
- DGEI%XAVG_LEV(JJ) = DGEI%XAVG_LEV(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLEV(JJ,JPATCH)
-!
-! Latent heat of sublimation over snow
-!
- DGEI%XAVG_LES(JJ) = DGEI%XAVG_LES(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLES(JJ,JPATCH)
-!
-! Latent heat of evaporation of liquid water over snow
-!
- DGEI%XAVG_LESL(JJ) = DGEI%XAVG_LESL(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLESL(JJ,JPATCH)
-!
-! Evaporation from canopy water interception
-!
- DGEI%XAVG_LER(JJ) = DGEI%XAVG_LER(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLER(JJ,JPATCH)
-!
-! Evapotranspiration of the vegetation
-!
- DGEI%XAVG_LETR(JJ) = DGEI%XAVG_LETR(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLETR(JJ,JPATCH)
-!
-! Evapotranspiration
-!
- DGEI%XAVG_EVAP(JJ) = DGEI%XAVG_EVAP(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XEVAP(JJ,JPATCH)
-!
-! Sublimation
-!
- DGEI%XAVG_SUBL(JJ) = DGEI%XAVG_SUBL(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XSUBL(JJ,JPATCH)
-!
-! Blowing snow sublimation (ES or Crocus)
-!
- DGEI%XAVG_SNDRIFT(JJ) = DGEI%XAVG_SNDRIFT(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XSNDRIFT(JJ,JPATCH)
-!
-! Soil drainage flux
-!
- DGEI%XAVG_DRAIN(JJ) = DGEI%XAVG_DRAIN(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XDRAIN(JJ,JPATCH)
-!
-! Soil lateral subsurface flux
-!
- DGEI%XAVG_QSB(JJ) = DGEI%XAVG_QSB(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XQSB(JJ,JPATCH)
-!
-! Supersaturation runoff
-!
- DGEI%XAVG_RUNOFF(JJ) = DGEI%XAVG_RUNOFF(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XRUNOFF(JJ,JPATCH)
-!
-! Horton runoff
-!
- DGEI%XAVG_HORT(JJ) = DGEI%XAVG_HORT(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XHORT(JJ,JPATCH)
-!
-! Vegetation dripping
-!
- DGEI%XAVG_DRIP(JJ) = DGEI%XAVG_DRIP(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XDRIP(JJ,JPATCH)
-!
-! Precipitation intercepted by the vegetation
-!
- DGEI%XAVG_RRVEG(JJ) = DGEI%XAVG_RRVEG(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XRRVEG(JJ,JPATCH)
-!
-! Snow melt
-!
- DGEI%XAVG_MELT(JJ) = DGEI%XAVG_MELT(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XMELT(JJ,JPATCH)
-!
-! Flood infiltartion
-!
- DGEI%XAVG_IFLOOD(JJ) = DGEI%XAVG_IFLOOD(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XIFLOOD(JJ,JPATCH)
-!
-! Precipitation intercepted by the floodplains
-!
- DGEI%XAVG_PFLOOD(JJ) = DGEI%XAVG_PFLOOD(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XPFLOOD(JJ,JPATCH)
-!
-! Floodplains evaporation
-!
- DGEI%XAVG_LE_FLOOD (JJ) = DGEI%XAVG_LE_FLOOD (JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLE_FLOOD (JJ,JPATCH)
- DGEI%XAVG_LEI_FLOOD(JJ) = DGEI%XAVG_LEI_FLOOD(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLEI_FLOOD(JJ,JPATCH)
-!
-! irrigation rate (as soil input)
-!
- DGEI%XAVG_IRRIG_FLUX(JJ) = DGEI%XAVG_IRRIG_FLUX(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XIRRIG_FLUX(JJ,JPATCH)
-!
-! Gross primary production
-!
- DGEI%XAVG_GPP(JJ) = DGEI%XAVG_GPP(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XGPP(JJ,JPATCH)
-!
-! Autotrophic respiration
-!
- DGEI%XAVG_RESP_AUTO(JJ) = DGEI%XAVG_RESP_AUTO(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XRESP_AUTO(JJ,JPATCH)
-!
-! Ecosystem respiration
-!
- DGEI%XAVG_RESP_ECO(JJ) = DGEI%XAVG_RESP_ECO(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XRESP_ECO(JJ,JPATCH)
-!
- IF (ISIZE_LMEB_PATCH>0) THEN
- DGEI%XAVG_LEVCV(JJ) = DGEI%XAVG_LEVCV(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLEVCV(JJ,JPATCH)
- DGEI%XAVG_LESC(JJ) = DGEI%XAVG_LESC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLESC(JJ,JPATCH)
- DGEI%XAVG_LETRCV(JJ) = DGEI%XAVG_LETRCV(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLETRCV(JJ,JPATCH)
- DGEI%XAVG_LELITTER(JJ) = DGEI%XAVG_LELITTER(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLELITTER(JJ,JPATCH)
- DGEI%XAVG_LELITTERI(JJ) = DGEI%XAVG_LELITTERI(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLELITTERI(JJ,JPATCH)
- DGEI%XAVG_DRIPLIT(JJ) = DGEI%XAVG_DRIPLIT(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XDRIPLIT(JJ,JPATCH)
- DGEI%XAVG_RRLIT(JJ) = DGEI%XAVG_RRLIT(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XRRLIT(JJ,JPATCH)
- DGEI%XAVG_LERCV(JJ) = DGEI%XAVG_LERCV(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLERCV(JJ,JPATCH)
- DGEI%XAVG_LE_C_A(JJ) = DGEI%XAVG_LE_C_A(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLE_C_A(JJ,JPATCH)
- DGEI%XAVG_LE_V_C(JJ) = DGEI%XAVG_LE_V_C(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLE_V_C(JJ,JPATCH)
- DGEI%XAVG_LE_G_C(JJ) = DGEI%XAVG_LE_G_C(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLE_G_C(JJ,JPATCH)
- DGEI%XAVG_LE_N_C(JJ) = DGEI%XAVG_LE_N_C(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLE_N_C(JJ,JPATCH)
- DGEI%XAVG_SWNET_V(JJ) = DGEI%XAVG_SWNET_V(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XSWNET_V(JJ,JPATCH)
- DGEI%XAVG_SWNET_G(JJ) = DGEI%XAVG_SWNET_G(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XSWNET_G(JJ,JPATCH)
- DGEI%XAVG_SWNET_N(JJ) = DGEI%XAVG_SWNET_N(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XSWNET_N(JJ,JPATCH)
- DGEI%XAVG_SWNET_NS(JJ) = DGEI%XAVG_SWNET_NS(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XSWNET_NS(JJ,JPATCH)
- DGEI%XAVG_LWNET_V(JJ) = DGEI%XAVG_LWNET_V(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLWNET_V(JJ,JPATCH)
- DGEI%XAVG_LWNET_G(JJ) = DGEI%XAVG_LWNET_G(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLWNET_G(JJ,JPATCH)
- DGEI%XAVG_LWNET_N(JJ) = DGEI%XAVG_LWNET_N(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLWNET_N(JJ,JPATCH)
- DGEI%XAVG_SWDOWN_GN(JJ) = DGEI%XAVG_SWDOWN_GN(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XSWDOWN_GN(JJ,JPATCH)
- DGEI%XAVG_LWDOWN_GN(JJ) = DGEI%XAVG_LWDOWN_GN(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLWDOWN_GN(JJ,JPATCH)
- DGEI%XAVG_H_V_C(JJ) = DGEI%XAVG_H_V_C(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XH_V_C(JJ,JPATCH)
- DGEI%XAVG_H_G_C(JJ) = DGEI%XAVG_H_G_C(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XH_G_C(JJ,JPATCH)
- DGEI%XAVG_H_C_A(JJ) = DGEI%XAVG_H_C_A(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XH_C_A(JJ,JPATCH)
- DGEI%XAVG_H_N_C(JJ) = DGEI%XAVG_H_N_C(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XH_N_C(JJ,JPATCH)
- DGEI%XAVG_SR_GN(JJ) = DGEI%XAVG_SR_GN(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XSR_GN(JJ,JPATCH)
- DGEI%XAVG_MELTCV(JJ) = DGEI%XAVG_MELTCV(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XMELTCV(JJ,JPATCH)
- DGEI%XAVG_FRZCV(JJ) = DGEI%XAVG_FRZCV(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XFRZCV(JJ,JPATCH)
- ENDIF
- !
- ENDIF
- END DO
- ENDDO
-!
-! Isba water budget and reservoir time tendencies
-!
- IF(DGEI%LWATER_BUDGET)THEN
-!
- DGEI%XRAINFALL (:) = PRAIN(:) * PTSTEP
- DGEI%XSNOWFALL (:) = PSNOW(:) * PTSTEP
- DGEI%XAVG_DWG (:) = 0.0
- DGEI%XAVG_DWGI (:) = 0.0
- DGEI%XAVG_DWR (:) = 0.0
- DGEI%XAVG_DSWE (:) = 0.0
- DGEI%XAVG_WATBUD(:) = 0.0
-!
- DO JPATCH=1,SIZE(I%XPATCH,2)
-! cdir nodep
- DO JJ=1,SIZE(ZSUMPATCH)
- IF (ZSUMPATCH(JJ) > 0.) THEN
-!
- DGEI%XAVG_DWG (JJ) = DGEI%XAVG_DWG (JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XDWG (JJ,JPATCH)
- DGEI%XAVG_DWGI (JJ) = DGEI%XAVG_DWGI (JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XDWGI (JJ,JPATCH)
- DGEI%XAVG_DWR (JJ) = DGEI%XAVG_DWR (JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XDWR (JJ,JPATCH)
- DGEI%XAVG_DSWE (JJ) = DGEI%XAVG_DSWE (JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XDSWE (JJ,JPATCH)
- DGEI%XAVG_WATBUD(JJ) = DGEI%XAVG_WATBUD(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XWATBUD(JJ,JPATCH)
-!
- ENDIF
- ENDDO
- ENDDO
-!
+IF (DE%LSURF_EVAP_BUDGET) THEN
+ !
+ CALL INIT_EVAP_BUD(DE)
+ IF (ISIZE_LMEB_PATCH>0) CALL INIT_MEB_BUD(DE)
+ !
+ IF(DE%LWATER_BUDGET)THEN
+ !
+ CALL INIT_WATER_BUD(DE)
+ !
+ DE%XRAINFALL (:) = PRAIN(:) * PTSTEP
+ DE%XSNOWFALL (:) = PSNOW(:) * PTSTEP
+ !
ENDIF
-!
-END IF
-!
+ !
+ CALL MAKE_AVERAGE_EVAP(DE,NDE)
+ !
+ ! Ice calving flux
+ !
+ IF(OGLACIER)THEN
+
+ DE%XICEFLUX(:)= 0.
+ DO JP=1,KNPATCH
+ DO JI=1,NP%AL(JP)%NSIZE_P
+ IMASK = NP%AL(JP)%NR_P(JI)
+ DE%XICEFLUX(IMASK) = DE%XICEFLUX(IMASK) + NP%AL(JP)%XPATCH(JI) * NDE%AL(JP)%XICEFLUX(JI)
+ END DO
+ END DO
+
+ END IF
+ !
+ENDIF
!
! 2. Surface Cumulated Energy fluxes
! -------------------------------
!
-IF (DGEI%LSURF_BUDGETC) THEN
- DGEI%XAVG_RNC (:) = 0.
- DGEI%XAVG_HC (:) = 0.
- DGEI%XAVG_LEC (:) = 0.
- DGEI%XAVG_GFLUXC (:) = 0.
- DGEI%XAVG_LEIC (:) = 0.
- DGEI%XAVG_LEGC (:) = 0.
- DGEI%XAVG_LEGIC (:) = 0.
- DGEI%XAVG_LEVC (:) = 0.
- DGEI%XAVG_LESAC (:) = 0.
- DGEI%XAVG_LESLC (:) = 0.
- DGEI%XAVG_LERC (:) = 0.
- DGEI%XAVG_LETRC (:) = 0.
- DGEI%XAVG_EVAPC (:) = 0.
- DGEI%XAVG_SUBLC (:) = 0.
- DGEI%XAVG_SNDRIFTC (:) = 0.
- DGEI%XAVG_DRAINC (:) = 0.
- DGEI%XAVG_QSBC (:) = 0.
- DGEI%XAVG_RUNOFFC (:) = 0.
- DGEI%XAVG_HORTC (:) = 0.
- DGEI%XAVG_DRIPC (:) = 0.
- DGEI%XAVG_RRVEGC (:) = 0.
- DGEI%XAVG_MELTC (:) = 0.
- DGEI%XAVG_IFLOODC (:) = 0.
- DGEI%XAVG_PFLOODC (:) = 0.
- DGEI%XAVG_LE_FLOODC (:) = 0.
- DGEI%XAVG_LEI_FLOODC (:) = 0.
- DGEI%XAVG_IRRIG_FLUXC(:) = 0.
- DGEI%XAVG_GPPC (:) = 0.
- DGEI%XAVG_RESPC_AUTO (:) = 0.
- DGEI%XAVG_RESPC_ECO (:) = 0.
-!
- IF (ISIZE_LMEB_PATCH>0) THEN
- DGEI%XAVG_LEVCVC (:) = 0.
- DGEI%XAVG_LESCC (:) = 0.
- DGEI%XAVG_LETRGVC (:) = 0.
- DGEI%XAVG_LETRCVC (:) = 0.
- DGEI%XAVG_LERGVC (:) = 0.
- DGEI%XAVG_LERCVC (:) = 0.
- DGEI%XAVG_LE_C_AC (:) = 0.
- DGEI%XAVG_LE_V_CC (:) = 0.
- DGEI%XAVG_LE_G_CC (:) = 0.
- DGEI%XAVG_LE_N_CC (:) = 0.
- DGEI%XAVG_SWNET_VC (:) = 0.
- DGEI%XAVG_SWNET_GC (:) = 0.
- DGEI%XAVG_SWNET_NC (:) = 0.
- DGEI%XAVG_SWNET_NSC (:) = 0.
- DGEI%XAVG_LWNET_VC (:) = 0.
- DGEI%XAVG_LWNET_GC (:) = 0.
- DGEI%XAVG_LWNET_NC (:) = 0.
- DGEI%XAVG_SWDOWN_GNC (:) = 0.
- DGEI%XAVG_LWDOWN_GNC (:) = 0.
- DGEI%XAVG_H_V_CC (:) = 0.
- DGEI%XAVG_H_G_CC (:) = 0.
- DGEI%XAVG_H_C_AC (:) = 0.
- DGEI%XAVG_H_N_CC (:) = 0.
- DGEI%XAVG_SR_GNC (:) = 0.
- DGEI%XAVG_MELTCVC (:) = 0.
- DGEI%XAVG_FRZCVC (:) = 0.
- ENDIF
-!
- DO JPATCH=1,SIZE(I%XPATCH,2)
-!cdir nodep
- DO JJ=1,SIZE(ZSUMPATCH)
- IF (ZSUMPATCH(JJ) > 0.) THEN
-!
-! Net radiation
-!
- DGEI%XAVG_RNC(JJ) = DGEI%XAVG_RNC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XRNC(JJ,JPATCH)
-!
-! Sensible heat flux
-!
- DGEI%XAVG_HC(JJ) = DGEI%XAVG_HC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XHC(JJ,JPATCH)
-!
-! Total latent heat flux
-!
- DGEI%XAVG_LEC(JJ) = DGEI%XAVG_LEC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLEC(JJ,JPATCH)
-!
-! Storage flux
-!
- DGEI%XAVG_GFLUXC(JJ) = DGEI%XAVG_GFLUXC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XGFLUXC(JJ,JPATCH)
-!
-! Total surface sublimation
-!
- DGEI%XAVG_LEIC(JJ) = DGEI%XAVG_LEIC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLEIC(JJ,JPATCH)
-!
-! Latent heat of evaporation over the ground
-!
- DGEI%XAVG_LEGC(JJ) = DGEI%XAVG_LEGC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLEGC(JJ,JPATCH)
-!
-! Surface soil ice sublimation
-!
- DGEI%XAVG_LEGIC(JJ) = DGEI%XAVG_LEGIC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLEGIC(JJ,JPATCH)
-!
-! Latent heat of evaporation over vegetation
-!
- DGEI%XAVG_LEVC(JJ) = DGEI%XAVG_LEVC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLEVC(JJ,JPATCH)
-!
-! Latent heat of sublimation over snow
-!
- DGEI%XAVG_LESAC(JJ) = DGEI%XAVG_LESAC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLESAC(JJ,JPATCH)
-!
-! Latent heat of evaporation of liquid water over snow
-!
- DGEI%XAVG_LESLC(JJ) = DGEI%XAVG_LESLC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLESLC(JJ,JPATCH)
-!
-! Evaporation from canopy water interception
-!
- DGEI%XAVG_LERC(JJ) = DGEI%XAVG_LERC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLERC(JJ,JPATCH)
-!
-! Evapotranspiration of the vegetation
-!
- DGEI%XAVG_LETRC(JJ) = DGEI%XAVG_LETRC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLETRC(JJ,JPATCH)
-!
-! Evapotranspiration
-!
- DGEI%XAVG_EVAPC(JJ) = DGEI%XAVG_EVAPC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XEVAPC(JJ,JPATCH)
-!
-! Sublimation
-!
- DGEI%XAVG_SUBLC(JJ) = DGEI%XAVG_SUBLC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XSUBLC(JJ,JPATCH)
-!
-! Blowing snow sublimation (ES or Crocus)
-!
- DGEI%XAVG_SNDRIFTC(JJ) = DGEI%XAVG_SNDRIFTC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XSNDRIFTC(JJ,JPATCH)
-!
-! Soil drainage flux
-!
- DGEI%XAVG_DRAINC(JJ) = DGEI%XAVG_DRAINC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XDRAINC(JJ,JPATCH)
-!
-! Soil lateral subsurface flux
-!
- DGEI%XAVG_QSBC(JJ) = DGEI%XAVG_QSBC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XQSBC(JJ,JPATCH)
-!
-! Supersaturation runoff
-!
- DGEI%XAVG_RUNOFFC(JJ) = DGEI%XAVG_RUNOFFC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XRUNOFFC(JJ,JPATCH)
-!
-! Horton runoff
-!
- DGEI%XAVG_HORTC(JJ) = DGEI%XAVG_HORTC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XHORTC(JJ,JPATCH)
-!
-! Vegetation dripping
+IF (OSURF_BUDGETC) THEN
+ !
+ !
+ CALL INIT_EVAP_BUD(DEC)
+ !
+ IF (ISIZE_LMEB_PATCH>0) THEN
+ CALL INIT_MEB_BUD(DEC)
+ ENDIF
+ !
+ ! Isba water budget and reservoir time tendencies
+ !
+ IF(DE%LWATER_BUDGET)THEN
+ !
+ CALL INIT_WATER_BUD(DEC)
+ !
+ DEC%XRAINFALL (:) = DEC%XRAINFALL (:) + PRAIN(:) * PTSTEP
+ DEC%XSNOWFALL (:) = DEC%XSNOWFALL (:) + PSNOW(:) * PTSTEP
+ !
+ ENDIF
+ !
+ CALL MAKE_AVERAGE_EVAP(DEC,NDEC)
+ !
+ ! Ice calving flux
+ !
+ IF(OGLACIER)THEN
+
+ DEC%XICEFLUX(:)= 0.
+ DO JP=1,KNPATCH
+ DO JI=1,NP%AL(JP)%NSIZE_P
+ IMASK = NP%AL(JP)%NR_P(JI)
+ DEC%XICEFLUX(IMASK) = DEC%XICEFLUX(IMASK) + NP%AL(JP)%XPATCH(JI) * NDEC%AL(JP)%XICEFLUX(JI)
+ END DO
+ END DO
+
+ END IF
+!
+END IF
!
- DGEI%XAVG_DRIPC(JJ) = DGEI%XAVG_DRIPC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XDRIPC(JJ,JPATCH)
+IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG_EVAP_ISBA_N',1,ZHOOK_HANDLE)
!
-! precipitation intercepted by the vegetation
+CONTAINS
!
- DGEI%XAVG_RRVEGC(JJ) = DGEI%XAVG_RRVEGC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XRRVEGC(JJ,JPATCH)
-!
-! Snow melt
+SUBROUTINE MAKE_AVERAGE_EVAP(DEA,NDEA)
!
- DGEI%XAVG_MELTC(JJ) = DGEI%XAVG_MELTC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XMELTC(JJ,JPATCH)
-!
-! Flood infiltartion
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEA
+TYPE(DIAG_EVAP_ISBA_NP_t), INTENT(INOUT) :: NDEA
!
- DGEI%XAVG_IFLOODC(JJ) = DGEI%XAVG_IFLOODC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XIFLOODC(JJ,JPATCH)
-!
-! Precipitation intercepted by the floodplains
-!
- DGEI%XAVG_PFLOODC(JJ) = DGEI%XAVG_PFLOODC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XPFLOODC(JJ,JPATCH)
-!
-! Floodplains evaporation
-!
- DGEI%XAVG_LE_FLOODC (JJ) = DGEI%XAVG_LE_FLOODC (JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLE_FLOODC (JJ,JPATCH)
- DGEI%XAVG_LEI_FLOODC(JJ) = DGEI%XAVG_LEI_FLOODC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLEI_FLOODC(JJ,JPATCH)
-!
-! irrigation rate (as soil input)
-!
- DGEI%XAVG_IRRIG_FLUXC(JJ) = DGEI%XAVG_IRRIG_FLUXC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XIRRIG_FLUXC(JJ,JPATCH)
-!
-! Gross primary production
-!
- DGEI%XAVG_GPPC(JJ) = DGEI%XAVG_GPPC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XGPPC(JJ,JPATCH)
-!
-! Autotrophic respiration
-!
- DGEI%XAVG_RESPC_AUTO(JJ) = DGEI%XAVG_RESPC_AUTO(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XRESPC_AUTO(JJ,JPATCH)
-!
-! Ecosystem respiration
-!
- DGEI%XAVG_RESPC_ECO(JJ) = DGEI%XAVG_RESPC_ECO(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XRESPC_ECO(JJ,JPATCH)
-!
- IF (ISIZE_LMEB_PATCH>0) THEN
- DGEI%XAVG_LEVCVC(JJ) = DGEI%XAVG_LEVCVC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLEVCVC(JJ,JPATCH)
- DGEI%XAVG_LESCC(JJ) = DGEI%XAVG_LESCC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLESCC(JJ,JPATCH)
-! DGEI%XAVG_LETRGVC(JJ) = DGEI%XAVG_LETRGVC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLETRGVC(JJ,JPATCH)
- DGEI%XAVG_LETRCVC(JJ) = DGEI%XAVG_LETRCVC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLETRCVC(JJ,JPATCH)
-! DGEI%XAVG_LERGVC(JJ) = DGEI%XAVG_LERGVC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLERGVC(JJ,JPATCH)
- DGEI%XAVG_LERCVC(JJ) = DGEI%XAVG_LERCVC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLERCVC(JJ,JPATCH)
- DGEI%XAVG_LE_C_AC(JJ) = DGEI%XAVG_LE_C_AC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLE_C_AC(JJ,JPATCH)
- DGEI%XAVG_LE_V_CC(JJ) = DGEI%XAVG_LE_V_CC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLE_V_CC(JJ,JPATCH)
- DGEI%XAVG_LE_G_CC(JJ) = DGEI%XAVG_LE_G_CC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLE_G_CC(JJ,JPATCH)
- DGEI%XAVG_LE_N_CC(JJ) = DGEI%XAVG_LE_N_CC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLE_N_CC(JJ,JPATCH)
- DGEI%XAVG_SWNET_VC(JJ) = DGEI%XAVG_SWNET_VC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XSWNET_VC(JJ,JPATCH)
- DGEI%XAVG_SWNET_GC(JJ) = DGEI%XAVG_SWNET_GC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XSWNET_GC(JJ,JPATCH)
- DGEI%XAVG_SWNET_NC(JJ) = DGEI%XAVG_SWNET_NC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XSWNET_NC(JJ,JPATCH)
- DGEI%XAVG_SWNET_NSC(JJ) = DGEI%XAVG_SWNET_NSC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XSWNET_NSC(JJ,JPATCH)
- DGEI%XAVG_LWNET_VC(JJ) = DGEI%XAVG_LWNET_VC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLWNET_VC(JJ,JPATCH)
- DGEI%XAVG_LWNET_GC(JJ) = DGEI%XAVG_LWNET_GC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLWNET_GC(JJ,JPATCH)
- DGEI%XAVG_LWNET_NC(JJ) = DGEI%XAVG_LWNET_NC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLWNET_NC(JJ,JPATCH)
- DGEI%XAVG_SWDOWN_GNC(JJ) = DGEI%XAVG_SWDOWN_GNC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XSWDOWN_GNC(JJ,JPATCH)
- DGEI%XAVG_LWDOWN_GNC(JJ) = DGEI%XAVG_LWDOWN_GNC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XLWDOWN_GNC(JJ,JPATCH)
- DGEI%XAVG_H_V_CC(JJ) = DGEI%XAVG_H_V_CC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XH_V_CC(JJ,JPATCH)
- DGEI%XAVG_H_G_CC(JJ) = DGEI%XAVG_H_G_CC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XH_G_CC(JJ,JPATCH)
- DGEI%XAVG_H_C_AC(JJ) = DGEI%XAVG_H_C_AC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XH_C_AC(JJ,JPATCH)
- DGEI%XAVG_H_N_CC(JJ) = DGEI%XAVG_H_N_CC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XH_N_CC(JJ,JPATCH)
- DGEI%XAVG_SR_GNC(JJ) = DGEI%XAVG_SR_GNC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XSR_GNC(JJ,JPATCH)
- DGEI%XAVG_MELTCVC(JJ) = DGEI%XAVG_MELTCVC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XMELTCVC(JJ,JPATCH)
- DGEI%XAVG_FRZCVC(JJ) = DGEI%XAVG_FRZCVC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XFRZCVC(JJ,JPATCH)
- ENDIF
- !
- ENDIF
- ENDDO
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG_EVAP_ISBA_N:MAKE_AVERAGE_EVAP',0,ZHOOK_HANDLE)
+!
+DO JP=1,KNPATCH
+ DO JI=1,NP%AL(JP)%NSIZE_P
+ IMASK = NP%AL(JP)%NR_P(JI)
+ !
+ ! Latent heat of evaporation over the ground
+ DEA%XLEG (IMASK) = DEA%XLEG (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLEG(JI)
+ !
+ ! Surface soil ice sublimation
+ DEA%XLEGI(IMASK) = DEA%XLEGI(IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLEGI(JI)
+ !
+ ! Latent heat of evaporation over vegetation
+ DEA%XLEV (IMASK) = DEA%XLEV (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLEV(JI)
+ !
+ ! Latent heat of sublimation over snow
+ DEA%XLES (IMASK) = DEA%XLES (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLES(JI)
+ !
+ ! Latent heat of evaporation of liquid water over snow
+ DEA%XLESL(IMASK) = DEA%XLESL(IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLESL(JI)
+ !
+ ! Evaporation from canopy water interception
+ DEA%XLER (IMASK) = DEA%XLER (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLER(JI)
+ !
+ ! Evapotranspiration of the vegetation
+ DEA%XLETR(IMASK) = DEA%XLETR(IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLETR(JI)
+ !
+ ! Blowing snow sublimation (ES or Crocus)
+ DEA%XSNDRIFT(IMASK) = DEA%XSNDRIFT(IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XSNDRIFT(JI)
+ !
+ ! Soil drainage flux
+ DEA%XDRAIN (IMASK) = DEA%XDRAIN (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XDRAIN(JI)
+ !
+ ! Soil lateral subsurface flux
+ DEA%XQSB (IMASK) = DEA%XQSB (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XQSB(JI)
+ !
+ ! Supersaturation runoff
+ DEA%XRUNOFF(IMASK) = DEA%XRUNOFF(IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XRUNOFF(JI)
+ !
+ ! Horton runoff
+ DEA%XHORT (IMASK) = DEA%XHORT (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XHORT(JI)
+ !
+ ! Vegetation dripping
+ DEA%XDRIP (IMASK) = DEA%XDRIP (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XDRIP(JI)
+ !
+ ! Precipitation intercepted by the vegetation
+ DEA%XRRVEG (IMASK) = DEA%XRRVEG (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XRRVEG(JI)
+ !
+ ! Snow melt
+ DEA%XMELT (IMASK) = DEA%XMELT (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XMELT(JI)
+ !
+ ! Flood infiltartion
+ DEA%XIFLOOD(IMASK) = DEA%XIFLOOD(IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XIFLOOD(JI)
+ !
+ ! Precipitation intercepted by the floodplains
+ DEA%XPFLOOD(IMASK) = DEA%XPFLOOD(IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XPFLOOD(JI)
+ !
+ ! Floodplains evaporation
+ DEA%XLE_FLOOD (IMASK) = DEA%XLE_FLOOD (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLE_FLOOD (JI)
+ DEA%XLEI_FLOOD(IMASK) = DEA%XLEI_FLOOD(IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLEI_FLOOD(JI)
+ !
+ ! irrigation rate (as soil input)
+ DEA%XIRRIG_FLUX(IMASK) = DEA%XIRRIG_FLUX(IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XIRRIG_FLUX(JI)
+ !
+ ! Gross primary production
+ DEA%XGPP (IMASK) = DEA%XGPP (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XGPP(JI)
+ !
+ ! Autotrophic respiration
+ DEA%XRESP_AUTO(IMASK) = DEA%XRESP_AUTO(IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XRESP_AUTO(JI)
+ !
+ ! Ecosystem respiration
+ DEA%XRESP_ECO (IMASK) = DEA%XRESP_ECO (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XRESP_ECO(JI)
+ !
+ IF (ISIZE_LMEB_PATCH>0) THEN
+ DEA%XLELITTER (IMASK) = DEA%XLELITTER (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLELITTER (JI)
+ DEA%XLELITTERI(IMASK) = DEA%XLELITTERI(IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLELITTERI(JI)
+ DEA%XDRIPLIT (IMASK) = DEA%XDRIPLIT (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XDRIPLIT (JI)
+ DEA%XRRLIT (IMASK) = DEA%XRRLIT (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XRRLIT (JI)
+
+ DEA%XLEV_CV (IMASK) = DEA%XLEV_CV (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLEV_CV (JI)
+ DEA%XLES_CV (IMASK) = DEA%XLES_CV (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLES_CV (JI)
+ DEA%XLETR_CV (IMASK) = DEA%XLETR_CV (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLETR_CV (JI)
+ DEA%XLER_CV (IMASK) = DEA%XLER_CV (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLER_CV (JI)
+ DEA%XLE_CV (IMASK) = DEA%XLE_CV (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLE_CV (JI)
+ DEA%XH_CV (IMASK) = DEA%XH_CV (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XH_CV (JI)
+ DEA%XMELT_CV (IMASK) = DEA%XMELT_CV (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XMELT_CV (JI)
+ DEA%XFRZ_CV (IMASK) = DEA%XFRZ_CV (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XFRZ_CV (JI)
+
+ DEA%XLETR_GV (IMASK) = DEA%XLETR_GV (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLETR_GV (JI)
+ DEA%XLER_GV (IMASK) = DEA%XLER_GV (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLER_GV (JI)
+ DEA%XLE_GV (IMASK) = DEA%XLE_GV (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLE_GV (JI)
+ DEA%XH_GV (IMASK) = DEA%XH_GV (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XH_GV (JI)
+
+ DEA%XLE_GN (IMASK) = DEA%XLE_GN (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLE_GN (JI)
+ DEA%XEVAP_GN (IMASK) = DEA%XEVAP_GN (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XEVAP_GN (JI)
+ DEA%XH_GN (IMASK) = DEA%XH_GN (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XH_GN (JI)
+ DEA%XSR_GN (IMASK) = DEA%XSR_GN (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XSR_GN (JI)
+ DEA%XSWDOWN_GN(IMASK) = DEA%XSWDOWN_GN(IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XSWDOWN_GN(JI)
+ DEA%XLWDOWN_GN(IMASK) = DEA%XLWDOWN_GN(IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLWDOWN_GN(JI)
+
+ DEA%XEVAP_G (IMASK) = DEA%XEVAP_G (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XEVAP_G (JI)
+ DEA%XLE_CA (IMASK) = DEA%XLE_CA (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLE_CA (JI)
+ DEA%XH_CA (IMASK) = DEA%XH_CA (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XH_CA (JI)
+
+ DEA%XSWNET_V (IMASK) = DEA%XSWNET_V (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XSWNET_V(JI)
+ DEA%XSWNET_G (IMASK) = DEA%XSWNET_G (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XSWNET_G(JI)
+ DEA%XSWNET_N (IMASK) = DEA%XSWNET_N (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XSWNET_N(JI)
+ DEA%XSWNET_NS (IMASK) = DEA%XSWNET_NS (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XSWNET_NS(JI)
+ DEA%XLWNET_V (IMASK) = DEA%XLWNET_V (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLWNET_V(JI)
+ DEA%XLWNET_G (IMASK) = DEA%XLWNET_G (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLWNET_G(JI)
+ DEA%XLWNET_N (IMASK) = DEA%XLWNET_N (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XLWNET_N(JI)
+ ENDIF
END DO
+ENDDO
!
! Isba water budget and reservoir time tendencies
!
- IF(DGEI%LWATER_BUDGET)THEN
-!
- DGEI%XRAINFALLC (:) = DGEI%XRAINFALLC (:) + PRAIN(:) * PTSTEP
- DGEI%XSNOWFALLC (:) = DGEI%XSNOWFALLC (:) + PSNOW(:) * PTSTEP
- DGEI%XAVG_DWGC (:) = 0.0
- DGEI%XAVG_DWGIC (:) = 0.0
- DGEI%XAVG_DWRC (:) = 0.0
- DGEI%XAVG_DSWEC (:) = 0.0
- DGEI%XAVG_WATBUDC(:) = 0.0
-!
- DO JPATCH=1,SIZE(I%XPATCH,2)
-! cdir nodep
- DO JJ=1,SIZE(ZSUMPATCH)
- IF (ZSUMPATCH(JJ) > 0.) THEN
-!
- DGEI%XAVG_DWGC (JJ) = DGEI%XAVG_DWGC (JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XDWGC (JJ,JPATCH)
- DGEI%XAVG_DWGIC (JJ) = DGEI%XAVG_DWGIC (JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XDWGIC (JJ,JPATCH)
- DGEI%XAVG_DWRC (JJ) = DGEI%XAVG_DWRC (JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XDWRC (JJ,JPATCH)
- DGEI%XAVG_DSWEC (JJ) = DGEI%XAVG_DSWEC (JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XDSWEC (JJ,JPATCH)
- DGEI%XAVG_WATBUDC(JJ) = DGEI%XAVG_WATBUDC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XWATBUDC(JJ,JPATCH)
-!
- ENDIF
- ENDDO
+IF(DE%LWATER_BUDGET)THEN
+ !
+ DO JP=1,KNPATCH
+ DO JI=1,NP%AL(JP)%NSIZE_P
+ IMASK = NP%AL(JP)%NR_P(JI)
+ !
+ DEA%XDWG (IMASK) = DEA%XDWG (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XDWG (JI)
+ DEA%XDWGI (IMASK) = DEA%XDWGI (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XDWGI (JI)
+ DEA%XDWR (IMASK) = DEA%XDWR (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XDWR (JI)
+ DEA%XDSWE (IMASK) = DEA%XDSWE (IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XDSWE (JI)
+ DEA%XWATBUD(IMASK) = DEA%XWATBUD(IMASK) + NP%AL(JP)%XPATCH(JI) * NDEA%AL(JP)%XWATBUD(JI)
+
ENDDO
+ ENDDO
!
- ENDIF
+ENDIF
!
-! Ice calving flux
-!
- IF(I%LGLACIER)THEN
- DGEI%XAVG_ICEFLUXC(:)= 0.
- DO JPATCH=1,SIZE(I%XPATCH,2)
-! cdir nodep
- DO JJ=1,SIZE(ZSUMPATCH)
- IF(ZSUMPATCH(JJ) > 0.)THEN
- DGEI%XAVG_ICEFLUXC(JJ) = DGEI%XAVG_ICEFLUXC(JJ) + I%XPATCH(JJ,JPATCH) * DGEI%XICEFLUXC(JJ,JPATCH)
- ENDIF
- END DO
- END DO
- END IF
-!
-END IF
+IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG_EVAP_ISBA_N:MAKE_AVERAGE_EVAP',1,ZHOOK_HANDLE)
!
-IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG_EVAP_ISBA_N',1,ZHOOK_HANDLE)
+END SUBROUTINE MAKE_AVERAGE_EVAP
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/average_diag_isban.F90 b/src/SURFEX/average_diag_isban.F90
index 11f3f27d86b1487b45930ca92ffe1639feed0cba..f5622a290d6873c0b1165f4615b276fc662260ec 100644
--- a/src/SURFEX/average_diag_isban.F90
+++ b/src/SURFEX/average_diag_isban.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE AVERAGE_DIAG_ISBA_n (DGEI, DGI, I, &
- PHW,PHT,PSFCO2,PTRAD)
+ SUBROUTINE AVERAGE_DIAG_ISBA_n (DGO, D, DC, ND, NDC, NP, KNPATCH, OSURF_BUDGETC, &
+ OCANOPY, PHW, PHT ,PSFCO2, PTRAD)
! #######################################
!
!
@@ -49,11 +49,8 @@
!* 0. DECLARATIONS
! ------------
!
-!
-!
-USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
-USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_NP_t, DIAG_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_NP_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
@@ -65,10 +62,16 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
+TYPE(DIAG_NP_t), INTENT(INOUT) :: ND
+TYPE(DIAG_NP_t), INTENT(INOUT) :: NDC
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+INTEGER, INTENT(IN) :: KNPATCH
!
-TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DGEI
-TYPE(DIAG_ISBA_t), INTENT(INOUT) :: DGI
-TYPE(ISBA_t), INTENT(INOUT) :: I
+LOGICAL, INTENT(IN) :: OSURF_BUDGETC
+LOGICAL, INTENT(IN) :: OCANOPY
!
REAL, DIMENSION(:), INTENT(IN) :: PHW ! atmospheric level height for wind (m)
REAL, DIMENSION(:), INTENT(IN) :: PHT ! atmospheric level height (m)
@@ -77,9 +80,8 @@ REAL, DIMENSION(:), INTENT(IN) :: PTRAD ! Radiative temperature (K)
!
!* 0.2 declarations of local variables
!
-INTEGER :: JPATCH ! tile loop counter
+INTEGER :: JP, JI, IMASK ! tile loop counter
INTEGER :: JSWB ! band loop counter
-REAL, DIMENSION(SIZE(I%XPATCH,1)) :: ZSUMPATCH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
@@ -88,267 +90,256 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! --------------
!
IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG_ISBA_N',0,ZHOOK_HANDLE)
-ZSUMPATCH(:) = 0.
-DO JPATCH=1,SIZE(I%XPATCH,2)
- ZSUMPATCH(:) = ZSUMPATCH(:) + I%XPATCH(:,JPATCH)
-END DO
!
! 1. Energy fluxes
! -------------
!
-IF (DGI%LSURF_BUDGET) THEN
- DGI%XAVG_RN(:) = 0.
- DGI%XAVG_H (:) = 0.
- DGI%XAVG_LE(:) = 0.
- DGI%XAVG_LEI(:) = 0.
- DGI%XAVG_GFLUX(:) = 0.
- DGI%XAVG_SWD(:) = 0.
- DGI%XAVG_SWU(:) = 0.
- DGI%XAVG_LWD(:) = 0.
- DGI%XAVG_LWU(:) = 0.
- DGI%XAVG_FMU(:) = 0.
- DGI%XAVG_FMV(:) = 0.
- DGI%XAVG_SWBD(:,:) = 0.
- DGI%XAVG_SWBU(:,:) = 0.
+IF (DGO%LSURF_BUDGET) THEN
!
- DO JPATCH=1,SIZE(I%XPATCH,2)
- WHERE (ZSUMPATCH(:) > 0.)
-!
-! Net radiation
-!
- DGI%XAVG_RN(:) = DGI%XAVG_RN(:) +I%XPATCH(:,JPATCH) * DGI%XRN(:,JPATCH)
-!
-! Sensible heat flux
-!
- DGI%XAVG_H (:) = DGI%XAVG_H (:) +I%XPATCH(:,JPATCH) * DGI%XH (:,JPATCH)
-!
-! Total latent heat flux
-!
- DGI%XAVG_LE(:) = DGI%XAVG_LE(:) +I%XPATCH(:,JPATCH) * I%XLE(:,JPATCH)
-!
-! Sublimation latent heat flux
-!
- DGI%XAVG_LEI(:) = DGI%XAVG_LEI(:) +I%XPATCH(:,JPATCH) * DGI%XLEI(:,JPATCH)
-!
-! Storage flux
-!
- DGI%XAVG_GFLUX(:) = DGI%XAVG_GFLUX(:) +I%XPATCH(:,JPATCH) * DGI%XGFLUX(:,JPATCH)
-!
-! Downwards SW radiation
-!
- DGI%XAVG_SWD(:) = DGI%XAVG_SWD(:) +I%XPATCH(:,JPATCH) * DGI%XSWD(:,JPATCH)
-!
-! Upwards SW radiation
-!
- DGI%XAVG_SWU(:) = DGI%XAVG_SWU(:) +I%XPATCH(:,JPATCH) * DGI%XSWU(:,JPATCH)
-!
-! Downwards LW radiation
-!
- DGI%XAVG_LWD(:) = DGI%XAVG_LWD(:) +I%XPATCH(:,JPATCH) * DGI%XLWD(:,JPATCH)
-!
-! Upwards LW radiation
-!
- DGI%XAVG_LWU(:) = DGI%XAVG_LWU(:) +I%XPATCH(:,JPATCH) * DGI%XLWU(:,JPATCH)
-!
-! Zonal wind stress
-!
- DGI%XAVG_FMU(:) = DGI%XAVG_FMU(:) +I%XPATCH(:,JPATCH) * DGI%XFMU(:,JPATCH)
-!
-! Meridian wind stress
-!
- DGI%XAVG_FMV(:) = DGI%XAVG_FMV(:) +I%XPATCH(:,JPATCH) * DGI%XFMV(:,JPATCH)
-!
- END WHERE
- END DO
-!
- DO JPATCH=1,SIZE(I%XPATCH,2)
- DO JSWB=1,SIZE(DGI%XSWBD,2)
- WHERE (ZSUMPATCH(:) > 0.)
-!
-! Downwards SW radiation for each spectral band
-!
- DGI%XAVG_SWBD(:,JSWB) = DGI%XAVG_SWBD(:,JSWB) +I%XPATCH(:,JPATCH) * DGI%XSWBD(:,JSWB,JPATCH)
-!
-! Upwards SW radiation for each spectral band
-!
- DGI%XAVG_SWBU(:,JSWB) = DGI%XAVG_SWBU(:,JSWB) +I%XPATCH(:,JPATCH) * DGI%XSWBU(:,JSWB,JPATCH)
-!
- END WHERE
- END DO
+ CALL MAKE_AVERAGE(D,ND)
+ !
+ D%XSWBD(:,:) = 0.
+ D%XSWBU(:,:) = 0.
+ !
+ DO JP=1,KNPATCH
+ DO JI = 1,NP%AL(JP)%NSIZE_P
+ IMASK = NP%AL(JP)%NR_P(JI)
+
+ DO JSWB =1,SIZE(D%XSWBD,2)
+ !
+ ! Downwards SW radiation for each spectral band
+ D%XSWBD(IMASK,JSWB) = D%XSWBD(IMASK,JSWB) + NP%AL(JP)%XPATCH(JI) * ND%AL(JP)%XSWBD(JI,JSWB)
+ !
+ ! Upwards SW radiation for each spectral band
+ D%XSWBU(IMASK,JSWB) = D%XSWBU(IMASK,JSWB) + NP%AL(JP)%XPATCH(JI) * ND%AL(JP)%XSWBU(JI,JSWB)
+ !
+ END DO
+
+ ENDDO
END DO
+ !
END IF
!
-IF (DGEI%LSURF_BUDGETC) THEN
- DGI%XAVG_SWDC(:) = 0.
- DGI%XAVG_SWUC(:) = 0.
- DGI%XAVG_LWDC(:) = 0.
- DGI%XAVG_LWUC(:) = 0.
- DGI%XAVG_FMUC(:) = 0.
- DGI%XAVG_FMVC(:) = 0.
- DO JPATCH=1,SIZE(I%XPATCH,2)
- WHERE (ZSUMPATCH(:) > 0.)
-!
-! Downwards SW radiation
-!
- DGI%XAVG_SWDC(:) = DGI%XAVG_SWDC(:) + I%XPATCH(:,JPATCH) * DGI%XSWDC(:,JPATCH)
-!
-! Upwards SW radiation
-!
- DGI%XAVG_SWUC(:) = DGI%XAVG_SWUC(:) + I%XPATCH(:,JPATCH) * DGI%XSWUC(:,JPATCH)
-!
-! Downwards LW radiation
-!
- DGI%XAVG_LWDC(:) = DGI%XAVG_LWDC(:) + I%XPATCH(:,JPATCH) * DGI%XLWDC(:,JPATCH)
-!
-! Upwards LW radiation
-!
- DGI%XAVG_LWUC(:) = DGI%XAVG_LWUC(:) + I%XPATCH(:,JPATCH) * DGI%XLWUC(:,JPATCH)
-!
-! Zonal wind stress
-!
- DGI%XAVG_FMUC(:) = DGI%XAVG_FMUC(:) + I%XPATCH(:,JPATCH) * DGI%XFMUC(:,JPATCH)
-!
-! Meridian wind stress
-!
- DGI%XAVG_FMVC(:) = DGI%XAVG_FMVC(:) + I%XPATCH(:,JPATCH) * DGI%XFMVC(:,JPATCH)
-!
- END WHERE
- END DO
+IF (OSURF_BUDGETC) THEN
+ !
+ CALL MAKE_AVERAGE(DC,NDC)
+ !
ENDIF
!
-!
! 2. surface temperature and 2 meters parameters
! -------------------------------------------
!
-DGI%XAVG_TS(:) = 0.0
-DO JPATCH=1,SIZE(I%XPATCH,2)
- WHERE (ZSUMPATCH(:) > 0.)
- DGI%XAVG_TS(:) = DGI%XAVG_TS(:) + I%XPATCH(:,JPATCH) * DGI%XTS(:,JPATCH)
- END WHERE
+D%XTS (:) = 0.0
+D%XALBT(:) = 0.0
+DO JP=1,KNPATCH
+ DO JI = 1,NP%AL(JP)%NSIZE_P
+ IMASK = NP%AL(JP)%NR_P(JI)
+
+ D%XTS(IMASK) = D%XTS(IMASK) + NP%AL(JP)%XPATCH(JI) * ND%AL(JP)%XTS(JI)
+ ! Total albedo
+ D%XALBT(IMASK) = D%XALBT(IMASK) + NP%AL(JP)%XPATCH(JI) * ND%AL(JP)%XALBT(JI)
+
+ ENDDO
END DO
!
-IF (.NOT. I%LCANOPY .AND. DGI%N2M>=1) THEN
+IF (.NOT. OCANOPY .AND. DGO%N2M>=1) THEN
- DGI%XAVG_T2M(:) = 0.
- DGI%XAVG_Q2M(:) = 0.
- DGI%XAVG_HU2M(:) = 0.
+ D%XT2M(:) = 0.
+ D%XQ2M(:) = 0.
+ D%XHU2M(:) = 0.
!
- DO JPATCH=1,SIZE(I%XPATCH,2)
- WHERE (ZSUMPATCH(:) > 0.)
-!
-! 2 meters temperature
-!
- DGI%XAVG_T2M(:) = DGI%XAVG_T2M(:) + I%XPATCH(:,JPATCH) * DGI%XT2M(:,JPATCH)
-!
-! 2 meters humidity
-!
- DGI%XAVG_Q2M(:) = DGI%XAVG_Q2M(:) + I%XPATCH(:,JPATCH) * DGI%XQ2M(:,JPATCH)
-!
-! 2 meters relative humidity
-!
- DGI%XAVG_HU2M(:) = DGI%XAVG_HU2M(:) + I%XPATCH(:,JPATCH) * DGI%XHU2M(:,JPATCH)
-!
- END WHERE
+ DO JP=1,KNPATCH
+ DO JI = 1,NP%AL(JP)%NSIZE_P
+ IMASK = NP%AL(JP)%NR_P(JI)
+ !
+ ! 2 meters temperature
+ D%XT2M(IMASK) = D%XT2M(IMASK) + NP%AL(JP)%XPATCH(JI) * ND%AL(JP)%XT2M(JI)
+ !
+ ! 2 meters humidity
+ D%XQ2M(IMASK) = D%XQ2M(IMASK) + NP%AL(JP)%XPATCH(JI) * ND%AL(JP)%XQ2M(JI)
+ !
+ ! 2 meters relative humidity
+ D%XHU2M(IMASK) = D%XHU2M(IMASK) + NP%AL(JP)%XPATCH(JI) * ND%AL(JP)%XHU2M(JI)
+ !
+ ENDDO
END DO
-!
-! 10 meters wind
-!
- DGI%XAVG_ZON10M (:) = 0.
- DGI%XAVG_MER10M (:) = 0.
- DGI%XAVG_WIND10M(:) = 0.
- DO JPATCH=1,SIZE(I%XPATCH,2)
- WHERE (ZSUMPATCH(:) > 0.)
- DGI%XAVG_ZON10M(:) = DGI%XAVG_ZON10M (:) + I%XPATCH(:,JPATCH) * DGI%XZON10M (:,JPATCH)
- DGI%XAVG_MER10M(:) = DGI%XAVG_MER10M (:) + I%XPATCH(:,JPATCH) * DGI%XMER10M (:,JPATCH)
- DGI%XAVG_WIND10M(:) = DGI%XAVG_WIND10M(:) + I%XPATCH(:,JPATCH) * DGI%XWIND10M(:,JPATCH)
- END WHERE
+ !
+ ! 10 meters wind
+ !
+ D%XZON10M (:) = 0.
+ D%XMER10M (:) = 0.
+ D%XWIND10M(:) = 0.
+ DO JP=1,KNPATCH
+ DO JI = 1,NP%AL(JP)%NSIZE_P
+ IMASK = NP%AL(JP)%NR_P(JI)
+
+ D%XZON10M(IMASK) = D%XZON10M (IMASK) + NP%AL(JP)%XPATCH(JI) * ND%AL(JP)%XZON10M (JI)
+ D%XMER10M(IMASK) = D%XMER10M (IMASK) + NP%AL(JP)%XPATCH(JI) * ND%AL(JP)%XMER10M (JI)
+ D%XWIND10M(IMASK) = D%XWIND10M(IMASK) + NP%AL(JP)%XPATCH(JI) * ND%AL(JP)%XWIND10M(JI)
+ ENDDO
ENDDO
-!
- DGI%XAVG_T2M_MIN(:) = MIN(DGI%XAVG_T2M_MIN(:),DGI%XAVG_T2M(:))
- DGI%XAVG_T2M_MAX(:) = MAX(DGI%XAVG_T2M_MAX(:),DGI%XAVG_T2M(:))
-!
- DGI%XAVG_HU2M_MIN(:) = MIN(DGI%XAVG_HU2M_MIN(:),DGI%XAVG_HU2M(:))
- DGI%XAVG_HU2M_MAX(:) = MAX(DGI%XAVG_HU2M_MAX(:),DGI%XAVG_HU2M(:))
-!
- DGI%XAVG_WIND10M_MAX(:) = MAX(DGI%XAVG_WIND10M_MAX(:),DGI%XAVG_WIND10M(:))
-!
+ !
+ ! min and max of XT2M
+ !
+ DO JP=1,KNPATCH
+ ND%AL(JP)%XT2M_MIN(:) = MIN(ND%AL(JP)%XT2M_MIN(:),ND%AL(JP)%XT2M(:))
+ ND%AL(JP)%XT2M_MAX(:) = MAX(ND%AL(JP)%XT2M_MAX(:),ND%AL(JP)%XT2M(:))
+ ENDDO
+ !
+ D%XT2M_MIN(:) = MIN(D%XT2M_MIN(:),D%XT2M(:))
+ D%XT2M_MAX(:) = MAX(D%XT2M_MAX(:),D%XT2M(:))
+ !
+ D%XHU2M_MIN(:) = MIN(D%XHU2M_MIN(:),D%XHU2M(:))
+ D%XHU2M_MAX(:) = MAX(D%XHU2M_MAX(:),D%XHU2M(:))
+ !
+ D%XWIND10M_MAX(:) = MAX(D%XWIND10M_MAX(:),D%XWIND10M(:))
+ !
END IF
!
! Richardson number
!
-IF (DGI%N2M>=1) THEN
+IF (DGO%N2M>=1) THEN
- DGI%XAVG_RI(:) = 0.
- !
- DGI%XAVG_SFCO2(:) = PSFCO2(:)
- !
- DO JPATCH=1,SIZE(I%XPATCH,2)
- WHERE (ZSUMPATCH(:) > 0.)
- DGI%XAVG_RI(:) = DGI%XAVG_RI(:) + I%XPATCH(:,JPATCH) * DGI%XRI(:,JPATCH)
- END WHERE
+ D%XRI(:) = 0.
+ D%XSFCO2(:) = PSFCO2(:)
+ DO JP=1,KNPATCH
+ DO JI = 1,NP%AL(JP)%NSIZE_P
+ IMASK = NP%AL(JP)%NR_P(JI)
+ D%XRI(IMASK) = D%XRI(IMASK) + NP%AL(JP)%XPATCH(JI) * ND%AL(JP)%XRI(JI)
+ ENDDO
END DO
-!
-! min and max of XT2M
-!
- DGI%XT2M_MIN(:,:) = MIN(DGI%XT2M_MIN(:,:),DGI%XT2M(:,:))
- DGI%XT2M_MAX(:,:) = MAX(DGI%XT2M_MAX(:,:),DGI%XT2M(:,:))
-!
+ !
END IF
!
! 3. Transfer coefficients
! ---------------------
!
-IF (DGI%LCOEF) THEN
+IF (DGO%LCOEF) THEN
!
- DGI%XAVG_CD (:) = 0.
- DGI%XAVG_CH (:) = 0.
- DGI%XAVG_CE (:) = 0.
- DGI%XAVG_Z0 (:) = 0.
- DGI%XAVG_Z0H (:) = 0.
- DGI%XAVG_Z0EFF(:) = 0.
+ D%XCD (:) = 0.
+ D%XCH (:) = 0.
+ D%XCE (:) = 0.
+ D%XZ0 (:) = 0.
+ D%XZ0H (:) = 0.
+ D%XZ0EFF(:) = 0.
!
- DO JPATCH=1,SIZE(I%XPATCH,2)
- WHERE (ZSUMPATCH(:) > 0.)
+ DO JP=1,KNPATCH
+ DO JI = 1,NP%AL(JP)%NSIZE_P
+ IMASK = NP%AL(JP)%NR_P(JI)
!
- DGI%XAVG_CD(:) = DGI%XAVG_CD(:) + I%XPATCH(:,JPATCH) * DGI%XCD(:,JPATCH)
- !
- DGI%XAVG_CH(:) = DGI%XAVG_CH(:) + I%XPATCH(:,JPATCH) * DGI%XCH(:,JPATCH)
- !
- DGI%XAVG_CE(:) = DGI%XAVG_CE(:) + I%XPATCH(:,JPATCH) * DGI%XCE(:,JPATCH)
- !
- !
- DGI%XAVG_Z0(:) = DGI%XAVG_Z0(:) + I%XPATCH(:,JPATCH) * 1./(LOG(PHW(:)/DGI%XZ0_WITH_SNOW (:,JPATCH)))**2
+ D%XCD(IMASK) = D%XCD(IMASK) + NP%AL(JP)%XPATCH(JI) * ND%AL(JP)%XCD(JI)
+ D%XCH(IMASK) = D%XCH(IMASK) + NP%AL(JP)%XPATCH(JI) * ND%AL(JP)%XCH(JI)
+ D%XCE(IMASK) = D%XCE(IMASK) + NP%AL(JP)%XPATCH(JI) * ND%AL(JP)%XCE(JI)
+ !
+ D%XZ0(IMASK) = D%XZ0(IMASK) + NP%AL(JP)%XPATCH(JI) * &
+ 1./(LOG(PHW(IMASK)/ND%AL(JP)%XZ0 (JI)))**2
+ D%XZ0H(IMASK) = D%XZ0H(IMASK) + NP%AL(JP)%XPATCH(JI) * &
+ 1./(LOG(PHT(IMASK)/ND%AL(JP)%XZ0H(JI)))**2
+ D%XZ0EFF(IMASK) = D%XZ0EFF(IMASK) + NP%AL(JP)%XPATCH(JI) * &
+ 1./(LOG(PHW(IMASK)/ND%AL(JP)%XZ0EFF(JI)))**2
!
- DGI%XAVG_Z0H(:) = DGI%XAVG_Z0H(:) + I%XPATCH(:,JPATCH) * 1./(LOG(PHT(:)/DGI%XZ0H_WITH_SNOW(:,JPATCH)))**2
- !
- DGI%XAVG_Z0EFF(:) = DGI%XAVG_Z0EFF(:) + I%XPATCH(:,JPATCH) * 1./(LOG(PHW(:)/DGI%XZ0EFF (:,JPATCH)))**2
- !
- END WHERE
+ ENDDO
END DO
!
- DGI%XAVG_Z0(:) = PHW(:) * EXP( - SQRT(1./DGI%XAVG_Z0(:)) )
+ D%XZ0(:) = PHW(:) * EXP( - SQRT(1./D%XZ0(:)) )
!
- DGI%XAVG_Z0H(:) = PHT(:) * EXP( - SQRT(1./DGI%XAVG_Z0H(:)) )
+ D%XZ0H(:) = PHT(:) * EXP( - SQRT(1./D%XZ0H(:)) )
!
- DGI%XAVG_Z0EFF(:) = PHW(:) * EXP( - SQRT(1./DGI%XAVG_Z0EFF(:)) )
+ D%XZ0EFF(:) = PHW(:) * EXP( - SQRT(1./D%XZ0EFF(:)) )
!
END IF
!
-IF (DGI%LSURF_VARS) THEN
- DGI%XAVG_QS(:) = 0.
+IF (DGO%LSURF_VARS) THEN
+ D%XQS(:) = 0.
!
- DO JPATCH=1,SIZE(I%XPATCH,2)
- WHERE (ZSUMPATCH(:) > 0.)
-!
-! specific humidity at surface
-!
- DGI%XAVG_QS(:) = DGI%XAVG_QS(:) + I%XPATCH(:,JPATCH) * DGI%XQS(:,JPATCH)
-!
- END WHERE
+ DO JP=1,KNPATCH
+ DO JI = 1,NP%AL(JP)%NSIZE_P
+ IMASK = NP%AL(JP)%NR_P(JI)
+ !
+ ! specific humidity at surface
+ D%XQS(IMASK) = D%XQS(IMASK) + NP%AL(JP)%XPATCH(JI) * ND%AL(JP)%XQS(JI)
+ !
+ ENDDO
END DO
END IF
!
IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG_ISBA_N',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
+CONTAINS
+!
+SUBROUTINE MAKE_AVERAGE(DA,NDA)
+!
+TYPE(DIAG_t), INTENT(INOUT) :: DA
+TYPE(DIAG_NP_t), INTENT(INOUT) :: NDA
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG_ISBA_N:MAKE_AVERAGE',0,ZHOOK_HANDLE)
+!
+DA%XRN (:) = 0.
+DA%XH (:) = 0.
+DA%XLE (:) = 0.
+DA%XLEI (:) = 0.
+DA%XGFLUX(:) = 0.
+!
+DA%XSWD(:) = 0.
+DA%XSWU(:) = 0.
+DA%XLWD(:) = 0.
+DA%XLWU(:) = 0.
+DA%XFMU(:) = 0.
+DA%XFMV(:) = 0.
+!
+DA%XEVAP (:) = 0.
+DA%XSUBL (:) = 0.
+!
+DO JP=1,KNPATCH
+ DO JI = 1,NP%AL(JP)%NSIZE_P
+ IMASK = NP%AL(JP)%NR_P(JI)
+ !
+ ! Net radiation
+ DA%XRN (IMASK) = DA%XRN (IMASK) + NP%AL(JP)%XPATCH(JI) * NDA%AL(JP)%XRN(JI)
+ !
+ ! Sensible heat flux
+ DA%XH (IMASK) = DA%XH (IMASK) + NP%AL(JP)%XPATCH(JI) * NDA%AL(JP)%XH(JI)
+ !
+ ! Total latent heat flux
+ DA%XLE (IMASK) = DA%XLE (IMASK) + NP%AL(JP)%XPATCH(JI) * NDA%AL(JP)%XLE(JI)
+ !
+ ! Storage flux
+ DA%XGFLUX(IMASK) = DA%XGFLUX(IMASK) + NP%AL(JP)%XPATCH(JI) * NDA%AL(JP)%XGFLUX(JI)
+ !
+ ! Total surface sublimation
+ DA%XLEI (IMASK) = DA%XLEI (IMASK) + NP%AL(JP)%XPATCH(JI) * NDA%AL(JP)%XLEI(JI)
+ !
+ ! Evapotranspiration
+ DA%XEVAP (IMASK) = DA%XEVAP (IMASK) + NP%AL(JP)%XPATCH(JI) * NDA%AL(JP)%XEVAP(JI)
+ !
+ ! Sublimation
+ DA%XSUBL (IMASK) = DA%XSUBL (IMASK) + NP%AL(JP)%XPATCH(JI) * NDA%AL(JP)%XSUBL(JI)
+ !
+ ! Downwards SW radiation
+ DA%XSWD (IMASK) = DA%XSWD (IMASK) + NP%AL(JP)%XPATCH(JI) * NDA%AL(JP)%XSWD(JI)
+ !
+ ! Upwards SW radiation
+ DA%XSWU (IMASK) = DA%XSWU (IMASK) + NP%AL(JP)%XPATCH(JI) * NDA%AL(JP)%XSWU(JI)
+ !
+ ! Downwards LW radiation
+ DA%XLWD (IMASK) = DA%XLWD (IMASK) + NP%AL(JP)%XPATCH(JI) * NDA%AL(JP)%XLWD(JI)
+ !
+ ! Upwards LW radiation
+ DA%XLWU (IMASK) = DA%XLWU (IMASK) + NP%AL(JP)%XPATCH(JI) * NDA%AL(JP)%XLWU(JI)
+ !
+ ! Zonal wind stress
+ DA%XFMU (IMASK) = DA%XFMU (IMASK) + NP%AL(JP)%XPATCH(JI) * NDA%AL(JP)%XFMU(JI)
+ !
+ ! Meridian wind stress
+ DA%XFMV (IMASK) = DA%XFMV (IMASK) + NP%AL(JP)%XPATCH(JI) * NDA%AL(JP)%XFMV(JI)
+ !
+ ENDDO
+END DO
+!
+IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG_ISBA_N:MAKE_AVERAGE',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE MAKE_AVERAGE
+!
!
END SUBROUTINE AVERAGE_DIAG_ISBA_n
diff --git a/src/SURFEX/average_diag_misc_isban.F90 b/src/SURFEX/average_diag_misc_isban.F90
index 2b33fa410218bd114a144e12e15d216910534e4e..813e99ab5d7a7c9be4facc999b16860afbcb40a1 100644
--- a/src/SURFEX/average_diag_misc_isban.F90
+++ b/src/SURFEX/average_diag_misc_isban.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #############################
- SUBROUTINE AVERAGE_DIAG_MISC_ISBA_n (DGMI, I)
+ SUBROUTINE AVERAGE_DIAG_MISC_ISBA_n (DM, NDM, IO, NP, NPE)
! #############################
!
!
@@ -48,15 +48,14 @@
! ------------
!
!
-USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t, DIAG_MISC_ISBA_NP_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_P_t, ISBA_PE_t, ISBA_NP_t, ISBA_NPE_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
!
USE MODD_CSTS, ONLY : XRHOLW
!
-!
-!
USE MODI_COMPUT_COLD_LAYERS_THICK
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -65,19 +64,23 @@ USE PARKIND1 ,ONLY : JPRB
IMPLICIT NONE
!
!
-TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DGMI
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DM
+TYPE(DIAG_MISC_ISBA_NP_t), INTENT(INOUT) :: NDM
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
!
-INTEGER :: JJ ! grid-cell loop counter
-INTEGER :: JPATCH ! tile loop counter
-INTEGER :: JLAYER ! layer loop counter
-REAL, DIMENSION(SIZE(I%XPATCH,1)) :: ZSUMPATCH
-REAL, DIMENSION(SIZE(I%XPATCH,1)) :: ZSUMDG, ZSNOW, ZSUMFRD2, ZSUMFRD3, ZPONDF2
-REAL, DIMENSION(SIZE(I%XPATCH,1),SIZE(I%XPATCH,2)) :: ZLAI
+TYPE(DIAG_MISC_ISBA_t), POINTER :: DMK
+TYPE(ISBA_P_t), POINTER :: PK
+TYPE(ISBA_PE_t), POINTER :: PEK
+INTEGER :: JI ! grid-cell loop counter
+INTEGER :: JP ! tile loop counter
+INTEGER :: JL ! layer loop counter
+REAL, DIMENSION(SIZE(DM%XHV)) :: ZSUMDG, ZSNOW, ZSUMFRD2, ZSUMFRD3
REAL :: ZWORK
-INTEGER :: INI,INP,IDEPTH,IWORK
+INTEGER :: INI,IDEPTH,IWORK,IMASK
!
-REAL, DIMENSION(SIZE(I%XDG,1),SIZE(I%XDG,2)) :: ZPOND, ZTG, ZDG
+REAL, DIMENSION(SIZE(DM%XHV),IO%NGROUND_LAYER) :: ZPOND, ZTG, ZDG
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -88,122 +91,102 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG_MISC_ISBA_N',0,ZHOOK_HANDLE)
!
-IF (.NOT.DGMI%LSURF_MISC_BUDGET) THEN
+IF (.NOT.DM%LSURF_MISC_BUDGET) THEN
IF (LHOOK) CALL DR_HOOK('AVERAGE_DIAG_MISC_ISBA_N',1,ZHOOK_HANDLE)
RETURN
ENDIF
!
-INI=SIZE(I%XPATCH,1)
-INP=SIZE(I%XPATCH,2)
-!
-ZSUMPATCH(:) = 0.0
-DO JPATCH=1,INP
- DO JJ=1,INI
- ZSUMPATCH(JJ) = ZSUMPATCH(JJ) + I%XPATCH(JJ,JPATCH)
- END DO
-END DO
-!
-ZSUMFRD2(:)=0.0
-ZSUMFRD3(:)=0.0
-ZSUMDG (:)=0.0
-ZSNOW (:)=0.0
-ZPONDF2 (:)=0.0
-!
-WHERE(I%XLAI(:,:)/=XUNDEF)
- ZLAI(:,:)=I%XLAI(:,:)
-ELSEWHERE
- ZLAI(:,:)=0.0
-ENDWHERE
+INI=SIZE(DM%XHV)
!
!-------------------------------------------------------------------------------
!
! 1. Surface Miscellaneous terms
! ---------------------------
!
-DGMI%XAVG_HV (:) = 0.
-DGMI%XAVG_PSNG(:) = 0.
-DGMI%XAVG_PSNV(:) = 0.
-DGMI%XAVG_PSN (:) = 0.
-DGMI%XAVG_ALBT(:) = 0.
-DGMI%XAVG_SWI (:,:) = 0.
-DGMI%XAVG_TSWI(:,:) = 0.
-DGMI%XAVG_FSAT(:) = 0.
-DGMI%XAVG_FFG (:) = 0.
-DGMI%XAVG_FFV (:) = 0.
-DGMI%XAVG_FF (:) = 0.
-DGMI%XAVG_TWSNOW(:) = 0.
-DGMI%XAVG_TDSNOW(:) = 0.
-DGMI%XAVG_TTSNOW(:) = 0.
-DGMI%XAVG_LAI (:) = 0.
-!
-DGMI%XSOIL_SWI (:) = 0.
-DGMI%XSOIL_TSWI (:) = 0.
-DGMI%XSOIL_TWG (:) = 0.
-DGMI%XSOIL_TWGI (:) = 0.
-DGMI%XSOIL_WG (:) = 0.
-DGMI%XSOIL_WGI (:) = 0.
-!
-IF(I%CISBA=='DIF')THEN
-!
- DGMI%XAVG_ALT (:) = 0.
- DGMI%XAVG_FLT (:) = 0.
-!
-ENDIF
-
-IF(I%CISBA=='DIF'.AND.DGMI%LSURF_MISC_DIF)THEN
-!
- DGMI%XFRD2_TSWI (:) = 0.
- DGMI%XFRD2_TWG (:) = 0.
- DGMI%XFRD2_TWGI (:) = 0.
-!
- DGMI%XFRD3_TSWI (:) = 0.
- DGMI%XFRD3_TWG (:) = 0.
- DGMI%XFRD3_TWGI (:) = 0.
-!
+DM%XHV (:) = 0.
+DM%XPSNG(:) = 0.
+DM%XPSNV(:) = 0.
+DM%XPSN (:) = 0.
+DM%XFSAT(:) = 0.
+DM%XFFG (:) = 0.
+DM%XFFV (:) = 0.
+DM%XFF (:) = 0.
+DM%XLAI (:) = 0.
+DM%XTWSNOW(:) = 0.
+DM%XTDSNOW(:) = 0.
+DM%XTTSNOW(:) = 0.
+IF (DM%LPROSNOW .AND. NPE%AL(1)%TSNOW%SCHEME=="CRO") THEN
+ DM%XSNDPT_1DY(:) = 0.
+ DM%XSNDPT_3DY(:) = 0.
+ DM%XSNDPT_5DY(:) = 0.
+ DM%XSNDPT_7DY(:) = 0.
+ DM%XSNSWE_1DY(:) = 0.
+ DM%XSNSWE_3DY(:) = 0.
+ DM%XSNSWE_5DY(:) = 0.
+ DM%XSNSWE_7DY(:) = 0.
+ DM%XSNRAM_SONDE(:) = 0.
+ DM%XSN_WETTHCKN(:) = 0.
+ DM%XSN_REFRZNTHCKN(:) = 0.
ENDIF
!
-DO JPATCH=1,INP
-!
-!cdir nodep
- DO JJ=1,INI
-!
- IF (ZSUMPATCH(JJ) > 0.) THEN
-!
-! Halstead coefficient
- DGMI%XAVG_HV(JJ) = DGMI%XAVG_HV(JJ) + I%XPATCH(JJ,JPATCH) * DGMI%XHV(JJ,JPATCH)
-!
-! Snow fractions
- DGMI%XAVG_PSNG(JJ) = DGMI%XAVG_PSNG(JJ) + I%XPATCH(JJ,JPATCH) * DGMI%XDPSNG(JJ,JPATCH)
- DGMI%XAVG_PSNV(JJ) = DGMI%XAVG_PSNV(JJ) + I%XPATCH(JJ,JPATCH) * DGMI%XDPSNV(JJ,JPATCH)
- DGMI%XAVG_PSN (JJ) = DGMI%XAVG_PSN (JJ) + I%XPATCH(JJ,JPATCH) * DGMI%XDPSN (JJ,JPATCH)
-!
-! Saturated fraction
- DGMI%XAVG_FSAT (JJ) = DGMI%XAVG_FSAT (JJ) + I%XPATCH(JJ,JPATCH) * DGMI%XDFSAT (JJ,JPATCH)
-!
-! Flood fractions
- DGMI%XAVG_FFG(JJ) = DGMI%XAVG_FFG(JJ) + I%XPATCH(JJ,JPATCH) * DGMI%XDFFG(JJ,JPATCH)
- DGMI%XAVG_FFV(JJ) = DGMI%XAVG_FFV(JJ) + I%XPATCH(JJ,JPATCH) * DGMI%XDFFV(JJ,JPATCH)
- DGMI%XAVG_FF (JJ) = DGMI%XAVG_FF (JJ) + I%XPATCH(JJ,JPATCH) * DGMI%XDFF (JJ,JPATCH)
-!
-! Total albedo
- DGMI%XAVG_ALBT(JJ) = DGMI%XAVG_ALBT(JJ) + I%XPATCH(JJ,JPATCH) * DGMI%XALBT (JJ,JPATCH)
+ZSNOW (:)=0.0
!
-! Total LAI
- DGMI%XAVG_LAI (JJ) = DGMI%XAVG_LAI(JJ) + I%XPATCH(JJ,JPATCH) * ZLAI (JJ,JPATCH)
-!
-! Snow total outputs
- DGMI%XAVG_TWSNOW(JJ) = DGMI%XAVG_TWSNOW(JJ) + I%XPATCH(JJ,JPATCH) * DGMI%XTWSNOW(JJ,JPATCH)
- DGMI%XAVG_TDSNOW(JJ) = DGMI%XAVG_TDSNOW(JJ) + I%XPATCH(JJ,JPATCH) * DGMI%XTDSNOW(JJ,JPATCH)
-!
- IF (DGMI%XTWSNOW(JJ,JPATCH)>0.0) THEN
- DGMI%XAVG_TTSNOW(JJ) = DGMI%XAVG_TTSNOW(JJ) + I%XPATCH(JJ,JPATCH) * DGMI%XTTSNOW(JJ,JPATCH)
- ZSNOW (JJ) = ZSNOW (JJ) + I%XPATCH(JJ,JPATCH)
+DO JP=1,IO%NPATCH
+ PK => NP%AL(JP)
+ DMK => NDM%AL(JP)
+ PEK => NPE%AL(JP)
+
+ DO JI=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+
+ ! Halstead coefficient
+ DM%XHV (IMASK) = DM%XHV (IMASK) + PK%XPATCH(JI) * DMK%XHV(JI)
+ !
+ ! Snow fractions
+ DM%XPSNG(IMASK) = DM%XPSNG (IMASK) + PK%XPATCH(JI) * DMK%XPSNG(JI)
+ DM%XPSNV(IMASK) = DM%XPSNV (IMASK) + PK%XPATCH(JI) * DMK%XPSNV(JI)
+ DM%XPSN (IMASK) = DM%XPSN (IMASK) + PK%XPATCH(JI) * DMK%XPSN (JI)
+ !
+ ! Saturated fraction
+ DM%XFSAT (IMASK) = DM%XFSAT(IMASK) + PK%XPATCH(JI) * DMK%XFSAT(JI)
+ !
+ ! Flood fractions
+ DM%XFFG (IMASK) = DM%XFFG (IMASK) + PK%XPATCH(JI) * DMK%XFFG(JI)
+ DM%XFFV (IMASK) = DM%XFFV (IMASK) + PK%XPATCH(JI) * DMK%XFFV(JI)
+ DM%XFF (IMASK) = DM%XFF (IMASK) + PK%XPATCH(JI) * DMK%XFF (JI)
+ !
+ ! Total LAI
+ IF (PEK%XLAI(JI)/=XUNDEF) DM%XLAI(IMASK) = DM%XLAI(IMASK) + PK%XPATCH(JI) * PEK%XLAI(JI)
+ !
+ ! Snow total outputs
+ DM%XTWSNOW(IMASK) = DM%XTWSNOW(IMASK) + PK%XPATCH(JI) * DMK%XTWSNOW(JI)
+ DM%XTDSNOW(IMASK) = DM%XTDSNOW(IMASK) + PK%XPATCH(JI) * DMK%XTDSNOW(JI)
+ !
+ IF (DMK%XTWSNOW(JI)>0.0) THEN
+ !
+ DM%XTTSNOW(IMASK) = DM%XTTSNOW(IMASK) + PK%XPATCH(JI) * DMK%XTTSNOW(JI)
+ ZSNOW (IMASK) = ZSNOW (IMASK) + PK%XPATCH(JI)
+ !
+ IF (DM%LPROSNOW .AND. NPE%AL(1)%TSNOW%SCHEME=="CRO") THEN
+ !
+ DM%XSNDPT_1DY(IMASK) = DM%XSNDPT_1DY(IMASK) + PK%XPATCH(JI) * DMK%XSNDPT_1DY(JI)
+ DM%XSNDPT_3DY(IMASK) = DM%XSNDPT_3DY(IMASK) + PK%XPATCH(JI) * DMK%XSNDPT_3DY(JI)
+ DM%XSNDPT_5DY(IMASK) = DM%XSNDPT_5DY(IMASK) + PK%XPATCH(JI) * DMK%XSNDPT_5DY(JI)
+ DM%XSNDPT_7DY(IMASK) = DM%XSNDPT_7DY(IMASK) + PK%XPATCH(JI) * DMK%XSNDPT_7DY(JI)
+ DM%XSNSWE_1DY(IMASK) = DM%XSNSWE_1DY(IMASK) + PK%XPATCH(JI) * DMK%XSNSWE_1DY(JI)
+ DM%XSNSWE_3DY(IMASK) = DM%XSNSWE_3DY(IMASK) + PK%XPATCH(JI) * DMK%XSNSWE_3DY(JI)
+ DM%XSNSWE_5DY(IMASK) = DM%XSNSWE_5DY(IMASK) + PK%XPATCH(JI) * DMK%XSNSWE_5DY(JI)
+ DM%XSNSWE_7DY(IMASK) = DM%XSNSWE_7DY(IMASK) + PK%XPATCH(JI) * DMK%XSNSWE_7DY(JI)
+ DM%XSNRAM_SONDE(IMASK) = DM%XSNRAM_SONDE(IMASK) + PK%XPATCH(JI) * DMK%XSNRAM_SONDE(JI)
+ DM%XSN_WETTHCKN(IMASK) = DM%XSN_WETTHCKN(IMASK) + PK%XPATCH(JI) * DMK%XSN_WETTHCKN(JI)
+ DM%XSN_REFRZNTHCKN(IMASK) = DM%XSN_REFRZNTHCKN(IMASK) + PK%XPATCH(JI) * DMK%XSN_REFRZNTHCKN(JI)
+ !
ENDIF
-!
+ !
ENDIF
-!
+ !
ENDDO
-!
+ !
ENDDO
!
!-------------------------------------------------------------------------------
@@ -214,84 +197,126 @@ ENDDO
! Soil Wetness Index profile, Total Soil Wetness Index and
! Total Soil Water Content (Liquid+Solid) and Total Frozen Content
!
+DM%XSWI (:,:) = 0.
+DM%XTSWI(:,:) = 0.
+!
+DM%XSOIL_SWI (:) = 0.
+DM%XSOIL_TSWI (:) = 0.
+DM%XSOIL_TWG (:) = 0.
+DM%XSOIL_TWGI (:) = 0.
+DM%XSOIL_WG (:) = 0.
+DM%XSOIL_WGI (:) = 0.
+!
+ZSUMDG (:)=0.0
+!
!---------------------------------------------
-IF(I%CISBA=='DIF')THEN ! DIF case
+IF(IO%CISBA=='DIF')THEN ! DIF case
!---------------------------------------------
-!
+!
+ DM%XALT (:) = 0.
+ DM%XFLT (:) = 0.
+
! Active and Frozen layers thickness
ZTG(:,:)=0.0
ZDG(:,:)=0.0
- DO JPATCH=1,INP
- DO JLAYER=1,I%NGROUND_LAYER
- DO JJ=1,INI
- ZTG(JJ,JLAYER) = ZTG(JJ,JLAYER) + I%XPATCH(JJ,JPATCH) * I%XTG(JJ,JLAYER,JPATCH)
- ZDG(JJ,JLAYER) = ZDG(JJ,JLAYER) + I%XPATCH(JJ,JPATCH) * I%XDG(JJ,JLAYER,JPATCH)
- ENDDO
- ENDDO
+ DO JP=1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+
+ DO JL=1,IO%NGROUND_LAYER
+ DO JI=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ ZTG(IMASK,JL) = ZTG(IMASK,JL) + PK%XPATCH(JI) * PEK%XTG(JI,JL)
+ ZDG(IMASK,JL) = ZDG(IMASK,JL) + PK%XPATCH(JI) * PK%XDG (JI,JL)
+ ENDDO
+ ENDDO
+
ENDDO
- CALL COMPUT_COLD_LAYERS_THICK(ZDG,ZTG,DGMI%XAVG_ALT,DGMI%XAVG_FLT)
+ CALL COMPUT_COLD_LAYERS_THICK(ZDG,ZTG,DM%XALT,DM%XFLT)
!
ZPOND(:,:)=0.0
- DO JPATCH=1,INP
- IF(I%NSIZE_NATURE_P(JPATCH) > 0 )THEN
- DO JLAYER = 1,I%NGROUND_LAYER
-! cdir nodep
- DO JJ=1,INI
- IDEPTH=I%NWG_LAYER(JJ,JPATCH)
- IF(JLAYER<=IDEPTH.AND.IDEPTH/=NUNDEF)THEN
- ZWORK=I%XDZG(JJ,JLAYER,JPATCH)
- !Soil Wetness Index profile
- DGMI%XAVG_SWI (JJ,JLAYER) = DGMI%XAVG_SWI (JJ,JLAYER)+ZWORK*I%XPATCH(JJ,JPATCH)*DGMI%XSWI (JJ,JLAYER,JPATCH)
- DGMI%XAVG_TSWI(JJ,JLAYER) = DGMI%XAVG_TSWI(JJ,JLAYER)+ZWORK*I%XPATCH(JJ,JPATCH)*DGMI%XTSWI(JJ,JLAYER,JPATCH)
- ZPOND (JJ,JLAYER) = ZPOND (JJ,JLAYER)+ZWORK*I%XPATCH(JJ,JPATCH)
- !Total soil wetness index, total water and ice contents
- DGMI%XSOIL_SWI (JJ) = DGMI%XSOIL_SWI (JJ) + ZWORK * I%XPATCH(JJ,JPATCH) * DGMI%XSWI (JJ,JLAYER,JPATCH)
- DGMI%XSOIL_TSWI(JJ) = DGMI%XSOIL_TSWI(JJ) + ZWORK * I%XPATCH(JJ,JPATCH) * DGMI%XTSWI(JJ,JLAYER,JPATCH)
- ZSUMDG (JJ) = ZSUMDG (JJ) + ZWORK * I%XPATCH(JJ,JPATCH)
- DGMI%XSOIL_TWG (JJ) = DGMI%XSOIL_TWG (JJ) + ZWORK * I%XPATCH(JJ,JPATCH) * (I%XWG(JJ,JLAYER,JPATCH) &
- + I%XWGI(JJ,JLAYER,JPATCH))
- DGMI%XSOIL_TWGI(JJ) = DGMI%XSOIL_TWGI(JJ) + ZWORK * I%XPATCH(JJ,JPATCH) * I%XWGI(JJ,JLAYER,JPATCH)
- ENDIF
- ENDDO
- ENDDO
- ENDIF
+ DO JP=1,IO%NPATCH
+ DMK => NDM%AL(JP)
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+
+ DO JL = 1,IO%NGROUND_LAYER
+
+ DO JI=1,PK%NSIZE_P
+ IDEPTH = PK%NWG_LAYER(JI)
+ IF(JL<=IDEPTH.AND.IDEPTH/=NUNDEF)THEN
+
+ IMASK = PK%NR_P(JI)
+
+ ZWORK = PK%XDZG(JI,JL)
+ !Soil Wetness Index profile
+ DM%XSWI (IMASK,JL) = DM%XSWI (IMASK,JL) + ZWORK*PK%XPATCH(JI) * DMK%XSWI (JI,JL)
+ DM%XTSWI(IMASK,JL) = DM%XTSWI(IMASK,JL) + ZWORK*PK%XPATCH(JI) * DMK%XTSWI(JI,JL)
+ ZPOND (IMASK,JL) = ZPOND (IMASK,JL) + ZWORK*PK%XPATCH(JI)
+ !Total soil wetness index, total water and ice contents
+ DM%XSOIL_SWI (IMASK) = DM%XSOIL_SWI (IMASK) + ZWORK * PK%XPATCH(JI) * DMK%XSWI (JI,JL)
+ DM%XSOIL_TSWI(IMASK) = DM%XSOIL_TSWI(IMASK) + ZWORK * PK%XPATCH(JI) * DMK%XTSWI(JI,JL)
+ ZSUMDG (IMASK) = ZSUMDG (IMASK) + ZWORK * PK%XPATCH(JI)
+ DM%XSOIL_TWG (IMASK) = DM%XSOIL_TWG (IMASK) + ZWORK * PK%XPATCH(JI) * (PEK%XWG(JI,JL) + PEK%XWGI(JI,JL))
+ DM%XSOIL_TWGI(IMASK) = DM%XSOIL_TWGI(IMASK) + ZWORK * PK%XPATCH(JI) * PEK%XWGI(JI,JL)
+
+ ENDIF
+
+ ENDDO
+
+ ENDDO
+ !
ENDDO
-!
+ !
WHERE(ZPOND(:,:)> 0.)
- DGMI%XAVG_SWI (:,:) = DGMI%XAVG_SWI (:,:) / ZPOND(:,:)
- DGMI%XAVG_TSWI(:,:) = DGMI%XAVG_TSWI(:,:) / ZPOND(:,:)
+ DM%XSWI (:,:) = DM%XSWI (:,:) / ZPOND(:,:)
+ DM%XTSWI(:,:) = DM%XTSWI(:,:) / ZPOND(:,:)
ELSEWHERE
- DGMI%XAVG_SWI (:,:) = XUNDEF
- DGMI%XAVG_TSWI(:,:) = XUNDEF
+ DM%XSWI (:,:) = XUNDEF
+ DM%XTSWI(:,:) = XUNDEF
ENDWHERE
!
! ---------------------------------------------
- IF(DGMI%LSURF_MISC_DIF)THEN ! LSURF_MISC_DIF case
+ IF(DM%LSURF_MISC_DIF)THEN ! LSURF_MISC_DIF case
! ---------------------------------------------
-!
- DO JPATCH=1,INP
-!
- IF (I%NSIZE_NATURE_P(JPATCH) == 0 ) CYCLE
!
- DO JLAYER = 1,I%NGROUND_LAYER
-! cdir nodep
- DO JJ=1,INI
- IDEPTH=I%NWG_LAYER(JJ,JPATCH)
- IF(JLAYER<=IDEPTH.AND.IDEPTH/=NUNDEF)THEN
+ ZSUMFRD2(:)=0.0
+ ZSUMFRD3(:)=0.0
+!
+ DM%XFRD2_TSWI (:) = 0.
+ DM%XFRD2_TWG (:) = 0.
+ DM%XFRD2_TWGI (:) = 0.
+!
+ DM%XFRD3_TSWI (:) = 0.
+ DM%XFRD3_TWG (:) = 0.
+ DM%XFRD3_TWGI (:) = 0.
+
+ DO JP=1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+ DMK => NDM%AL(JP)
+
+ DO JI=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+
+ DO JL = 1,IO%NGROUND_LAYER
+ IDEPTH= PK%NWG_LAYER(JI)
+
+ IF(JL<=IDEPTH.AND.IDEPTH/=NUNDEF)THEN
!
! ISBA-FR-DG2 comparable soil wetness index, liquid water and ice contents
- ZWORK=MIN(I%XDZG(JJ,JLAYER,JPATCH),MAX(0.0,I%XDG2(JJ,JPATCH)-I%XDG(JJ,JLAYER,JPATCH)+I%XDZG(JJ,JLAYER,JPATCH)))
- DGMI%XFRD2_TSWI (JJ) = DGMI%XFRD2_TSWI (JJ) + ZWORK * I%XPATCH(JJ,JPATCH) * DGMI%XTSWI(JJ,JLAYER,JPATCH)
- DGMI%XFRD2_TWG (JJ) = DGMI%XFRD2_TWG (JJ) + ZWORK * I%XPATCH(JJ,JPATCH) * I%XWG (JJ,JLAYER,JPATCH)
- DGMI%XFRD2_TWGI (JJ) = DGMI%XFRD2_TWGI (JJ) + ZWORK * I%XPATCH(JJ,JPATCH) * I%XWGI (JJ,JLAYER,JPATCH)
- ZSUMFRD2 (JJ) = ZSUMFRD2 (JJ) + ZWORK * I%XPATCH(JJ,JPATCH)
+ ZWORK = MIN(PK%XDZG(JI,JL),MAX(0.0,PK%XDG2(JI)-PK%XDG(JI,JL)+PK%XDZG(JI,JL)))
+ DM%XFRD2_TSWI (IMASK) = DM%XFRD2_TSWI (IMASK) + ZWORK * PK%XPATCH(JI) * DMK%XTSWI(JI,JL)
+ DM%XFRD2_TWG (IMASK) = DM%XFRD2_TWG (IMASK) + ZWORK * PK%XPATCH(JI) * PEK%XWG (JI,JL)
+ DM%XFRD2_TWGI (IMASK) = DM%XFRD2_TWGI (IMASK) + ZWORK * PK%XPATCH(JI) * PEK%XWGI (JI,JL)
+ ZSUMFRD2 (IMASK) = ZSUMFRD2 (IMASK) + ZWORK * PK%XPATCH(JI)
!
! ISBA-FR-DG3 comparable soil wetness index, liquid water and ice contents
- ZWORK=MIN(I%XDZG(JJ,JLAYER,JPATCH),MAX(0.0,I%XDG(JJ,JLAYER,JPATCH)-I%XDG2(JJ,JPATCH)))
- DGMI%XFRD3_TSWI (JJ) = DGMI%XFRD3_TSWI (JJ) + ZWORK * I%XPATCH(JJ,JPATCH) * DGMI%XTSWI(JJ,JLAYER,JPATCH)
- DGMI%XFRD3_TWG (JJ) = DGMI%XFRD3_TWG (JJ) + ZWORK * I%XPATCH(JJ,JPATCH) * I%XWG (JJ,JLAYER,JPATCH)
- DGMI%XFRD3_TWGI (JJ) = DGMI%XFRD3_TWGI (JJ) + ZWORK * I%XPATCH(JJ,JPATCH) * I%XWGI (JJ,JLAYER,JPATCH)
- ZSUMFRD3 (JJ) = ZSUMFRD3 (JJ) + ZWORK * I%XPATCH(JJ,JPATCH)
+ ZWORK =MIN(PK%XDZG(JI,JL),MAX(0.0,PK%XDG(JI,JL)-PK%XDG2(JI)))
+ DM%XFRD3_TSWI (IMASK) = DM%XFRD3_TSWI (IMASK) + ZWORK * PK%XPATCH(JI) * DMK%XTSWI(JI,JL)
+ DM%XFRD3_TWG (IMASK) = DM%XFRD3_TWG (IMASK) + ZWORK * PK%XPATCH(JI) * PEK%XWG (JI,JL)
+ DM%XFRD3_TWGI (IMASK) = DM%XFRD3_TWGI (IMASK) + ZWORK * PK%XPATCH(JI) * PEK%XWGI (JI,JL)
+ ZSUMFRD3 (IMASK) = ZSUMFRD3 (IMASK) + ZWORK * PK%XPATCH(JI)
!
ENDIF
ENDDO
@@ -300,19 +325,19 @@ IF(I%CISBA=='DIF')THEN ! DIF case
ENDDO
!
WHERE(ZSUMFRD2(:)>0.0)
- DGMI%XFRD2_TSWI (:) = DGMI%XFRD2_TSWI (:) / ZSUMFRD2(:)
- DGMI%XFRD2_TWG (:) = DGMI%XFRD2_TWG (:) / ZSUMFRD2(:)
- DGMI%XFRD2_TWGI (:) = DGMI%XFRD2_TWGI (:) / ZSUMFRD2(:)
+ DM%XFRD2_TSWI (:) = DM%XFRD2_TSWI (:) / ZSUMFRD2(:)
+ DM%XFRD2_TWG (:) = DM%XFRD2_TWG (:) / ZSUMFRD2(:)
+ DM%XFRD2_TWGI (:) = DM%XFRD2_TWGI (:) / ZSUMFRD2(:)
ELSEWHERE
- DGMI%XFRD2_TSWI (:) = XUNDEF
+ DM%XFRD2_TSWI (:) = XUNDEF
ENDWHERE
!
WHERE(ZSUMFRD3(:)>0.0)
- DGMI%XFRD3_TSWI (:) = DGMI%XFRD3_TSWI (:) / ZSUMFRD3(:)
- DGMI%XFRD3_TWG (:) = DGMI%XFRD3_TWG (:) / ZSUMFRD3(:)
- DGMI%XFRD3_TWGI (:) = DGMI%XFRD3_TWGI (:) / ZSUMFRD3(:)
+ DM%XFRD3_TSWI (:) = DM%XFRD3_TSWI (:) / ZSUMFRD3(:)
+ DM%XFRD3_TWG (:) = DM%XFRD3_TWG (:) / ZSUMFRD3(:)
+ DM%XFRD3_TWGI (:) = DM%XFRD3_TWGI (:) / ZSUMFRD3(:)
ELSEWHERE
- DGMI%XFRD3_TSWI (:) = XUNDEF
+ DM%XFRD3_TSWI (:) = XUNDEF
ENDWHERE
!
! ---------------------------------------------
@@ -323,61 +348,67 @@ IF(I%CISBA=='DIF')THEN ! DIF case
ELSE ! Force-restore case
!---------------------------------------------
!
- DO JPATCH=1,INP
- DO JJ=1,INI
- IF(ZSUMPATCH(JJ) > 0.)THEN
-!
- DGMI%XAVG_SWI (JJ,1) = DGMI%XAVG_SWI (JJ,1) + I%XPATCH(JJ,JPATCH) * DGMI%XSWI (JJ,1,JPATCH)
- DGMI%XAVG_SWI (JJ,2) = DGMI%XAVG_SWI (JJ,2) + I%XPATCH(JJ,JPATCH) * DGMI%XSWI (JJ,2,JPATCH)
- DGMI%XAVG_TSWI(JJ,1) = DGMI%XAVG_TSWI(JJ,1) + I%XPATCH(JJ,JPATCH) * DGMI%XTSWI(JJ,1,JPATCH)
- DGMI%XAVG_TSWI(JJ,2) = DGMI%XAVG_TSWI(JJ,2) + I%XPATCH(JJ,JPATCH) * DGMI%XTSWI(JJ,2,JPATCH)
-!
- DGMI%XSOIL_SWI (JJ) = DGMI%XSOIL_SWI (JJ) + I%XPATCH(JJ,JPATCH) * I%XDG (JJ,2,JPATCH) * DGMI%XSWI (JJ,2,JPATCH)
- DGMI%XSOIL_TSWI(JJ) = DGMI%XSOIL_TSWI(JJ) + I%XPATCH(JJ,JPATCH) * I%XDG (JJ,2,JPATCH) * DGMI%XTSWI(JJ,2,JPATCH)
- DGMI%XSOIL_TWG (JJ) = DGMI%XSOIL_TWG (JJ) + I%XPATCH(JJ,JPATCH) * I%XDG (JJ,2,JPATCH) * (I%XWG(JJ,2,JPATCH) &
- + I%XWGI(JJ,2,JPATCH))
- DGMI%XSOIL_TWGI(JJ) = DGMI%XSOIL_TWGI(JJ) + I%XPATCH(JJ,JPATCH) * I%XDG (JJ,2,JPATCH) * I%XWGI(JJ,2,JPATCH)
-!
- ZSUMDG (JJ) = ZSUMDG (JJ) + I%XPATCH(JJ,JPATCH) * I%XDG(JJ,I%NGROUND_LAYER,JPATCH)
+ DO JP=1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+ DMK => NDM%AL(JP)
+
+ DO JI=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+!
+ DM%XSWI (IMASK,1) = DM%XSWI (IMASK,1) + PK%XPATCH(JI) * DMK%XSWI (JI,1)
+ DM%XSWI (IMASK,2) = DM%XSWI (IMASK,2) + PK%XPATCH(JI) * DMK%XSWI (JI,2)
+ DM%XTSWI(IMASK,1) = DM%XTSWI(IMASK,1) + PK%XPATCH(JI) * DMK%XTSWI(JI,1)
+ DM%XTSWI(IMASK,2) = DM%XTSWI(IMASK,2) + PK%XPATCH(JI) * DMK%XTSWI(JI,2)
+!
+ DM%XSOIL_SWI (IMASK) = DM%XSOIL_SWI (IMASK) + PK%XPATCH(JI) * PK%XDG (JI,2) * DMK%XSWI (JI,2)
+ DM%XSOIL_TSWI(IMASK) = DM%XSOIL_TSWI(IMASK) + PK%XPATCH(JI) * PK%XDG (JI,2) * DMK%XTSWI(JI,2)
+ DM%XSOIL_TWG (IMASK) = DM%XSOIL_TWG (IMASK) + PK%XPATCH(JI) * PK%XDG (JI,2) * (PEK%XWG(JI,2) + PEK%XWGI(JI,2))
+ DM%XSOIL_TWGI(IMASK) = DM%XSOIL_TWGI(IMASK) + PK%XPATCH(JI) * PK%XDG (JI,2) * PEK%XWGI(JI,2)
+!
+ ZSUMDG (IMASK) = ZSUMDG(IMASK) + PK%XPATCH(JI) * PK%XDG(JI,IO%NGROUND_LAYER)
!
- ENDIF
- ENDDO
+ ENDDO
ENDDO
!
- IF(I%CISBA=='3-L')THEN
+ IF(IO%CISBA=='3-L')THEN
!
ZPOND(:,:)=0.0
- DO JPATCH=1,INP
- DO JJ=1,SIZE(I%XPATCH,1)
- IF(ZSUMPATCH(JJ) > 0.)THEN
-!
- ZWORK=MAX(0.0,I%XDG(JJ,3,JPATCH)-I%XDG(JJ,2,JPATCH))
+ DO JP=1,IO%NPATCH
+ DMK => NDM%AL(JP)
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+
+ DO JI=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+!
+ ZWORK=MAX(0.0,PK%XDG(JI,3)-PK%XDG(JI,2))
+!
+! Remenber: no ice in the third layer of 3-L
+ ZPOND (IMASK,3) = ZPOND (IMASK,3) + PK%XPATCH(JI) * ZWORK
+ DM%XSWI (IMASK,3) = DM%XSWI (IMASK,3) + PK%XPATCH(JI) * ZWORK * DMK%XSWI (JI,3)
+ DM%XSOIL_SWI (IMASK ) = DM%XSOIL_SWI (IMASK ) + PK%XPATCH(JI) * ZWORK * DMK%XSWI (JI,3)
+ DM%XTSWI (IMASK,3) = DM%XTSWI (IMASK,3) + PK%XPATCH(JI) * ZWORK * DMK%XTSWI(JI,3)
+ DM%XSOIL_TSWI (IMASK ) = DM%XSOIL_TSWI(IMASK ) + PK%XPATCH(JI) * ZWORK * DMK%XTSWI(JI,3)
+ DM%XSOIL_TWG (IMASK ) = DM%XSOIL_TWG (IMASK ) + PK%XPATCH(JI) * ZWORK * PEK%XWG (JI,3)
!
-! Remenber: no ice in the third layer of 3-L
- ZPOND (JJ,3) = ZPOND (JJ,3) + I%XPATCH(JJ,JPATCH) * ZWORK
- DGMI%XAVG_SWI (JJ,3) = DGMI%XAVG_SWI (JJ,3) + I%XPATCH(JJ,JPATCH) * ZWORK * DGMI%XSWI (JJ,3,JPATCH)
- DGMI%XSOIL_SWI (JJ ) = DGMI%XSOIL_SWI (JJ ) + I%XPATCH(JJ,JPATCH) * ZWORK * DGMI%XSWI (JJ,3,JPATCH)
- DGMI%XAVG_TSWI (JJ,3) = DGMI%XAVG_TSWI (JJ,3) + I%XPATCH(JJ,JPATCH) * ZWORK * DGMI%XTSWI(JJ,3,JPATCH)
- DGMI%XSOIL_TSWI(JJ ) = DGMI%XSOIL_TSWI(JJ ) + I%XPATCH(JJ,JPATCH) * ZWORK * DGMI%XTSWI(JJ,3,JPATCH)
- DGMI%XSOIL_TWG (JJ ) = DGMI%XSOIL_TWG (JJ ) + I%XPATCH(JJ,JPATCH) * ZWORK * I%XWG (JJ,3,JPATCH)
-!
- ENDIF
- ENDDO
+ ENDDO
ENDDO
!
WHERE(ZPOND(:,3)>0.0)
- DGMI%XAVG_SWI (:,3) = DGMI%XAVG_SWI (:,3) / ZPOND(:,3)
- DGMI%XAVG_TSWI(:,3) = DGMI%XAVG_TSWI(:,3) / ZPOND(:,3)
+ DM%XSWI (:,3) = DM%XSWI (:,3) / ZPOND(:,3)
+ DM%XTSWI(:,3) = DM%XTSWI(:,3) / ZPOND(:,3)
ELSEWHERE
- DGMI%XAVG_SWI (:,3) = XUNDEF
- DGMI%XAVG_TSWI(:,3) = XUNDEF
+ DM%XSWI (:,3) = XUNDEF
+ DM%XTSWI(:,3) = XUNDEF
ENDWHERE
!
ENDIF
!
!---------------------------------------------
-ENDIF ! End ISBA soil scheme case
+ENDIF ! End ISBA soil scheme case !
+!
!---------------------------------------------
!
! 3. Final computation for grid-cell diag
@@ -385,21 +416,21 @@ ENDIF ! End ISBA soil scheme case
!
!Total Soil Wetness Index and Soil Water Content (m3.m-3)
WHERE(ZSUMDG(:)>0.0)
- DGMI%XSOIL_SWI (:) = DGMI%XSOIL_SWI (:)/ZSUMDG(:)
- DGMI%XSOIL_TSWI(:) = DGMI%XSOIL_TSWI(:)/ZSUMDG(:)
- DGMI%XSOIL_WG (:) = DGMI%XSOIL_TWG (:)/ZSUMDG(:)
- DGMI%XSOIL_WGI (:) = DGMI%XSOIL_TWGI(:)/ZSUMDG(:)
+ DM%XSOIL_SWI (:) = DM%XSOIL_SWI (:)/ZSUMDG(:)
+ DM%XSOIL_TSWI(:) = DM%XSOIL_TSWI(:)/ZSUMDG(:)
+ DM%XSOIL_WG (:) = DM%XSOIL_TWG (:)/ZSUMDG(:)
+ DM%XSOIL_WGI (:) = DM%XSOIL_TWGI(:)/ZSUMDG(:)
ENDWHERE
!
!Total Soil Water Content (Liquid+Solid) and Total Frozen Content (kg/m2)
-DGMI%XSOIL_TWG (:)= DGMI%XSOIL_TWG (:) * XRHOLW
-DGMI%XSOIL_TWGI(:)= DGMI%XSOIL_TWGI(:) * XRHOLW
+DM%XSOIL_TWG (:)= DM%XSOIL_TWG (:) * XRHOLW
+DM%XSOIL_TWGI(:)= DM%XSOIL_TWGI(:) * XRHOLW
!
! Snow temperature
WHERE(ZSNOW(:)>0.0)
- DGMI%XAVG_TTSNOW(:) = DGMI%XAVG_TTSNOW(:)/ZSNOW(:)
+ DM%XTTSNOW(:) = DM%XTTSNOW(:)/ZSNOW(:)
ELSEWHERE
- DGMI%XAVG_TTSNOW(:) = XUNDEF
+ DM%XTTSNOW(:) = XUNDEF
ENDWHERE
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/averaged_albedo_emis_isba.F90 b/src/SURFEX/averaged_albedo_emis_isba.F90
index 41b4a084ffbab75b0f65ba31e27f619632332f8e..40a86b152c3c98c5e805bcb7465df480bd8c91d0 100644
--- a/src/SURFEX/averaged_albedo_emis_isba.F90
+++ b/src/SURFEX/averaged_albedo_emis_isba.F90
@@ -3,25 +3,9 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE AVERAGED_ALBEDO_EMIS_ISBA (I, &
- OFLOOD, HALBEDO, &
- PZENITH,PVEG,PZ0,PLAI, &
- OMEB_PATCH,PGNDLITTER, &
- PZ0LITTER,PLAIGV, &
- PH_VEG, PTV, &
- PTG1,PPATCH, &
- PSW_BANDS, &
- PALBNIR_VEG,PALBVIS_VEG, &
- PALBUV_VEG, &
- PALBNIR_SOIL,PALBVIS_SOIL, &
- PALBUV_SOIL, &
- PEMIS_ECO, &
- TPSNOW, &
- PALBNIR_ECO,PALBVIS_ECO, &
- PALBUV_ECO, &
- PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD,PTSURF, &
- PDIR_SW, PSCA_SW )
+ SUBROUTINE AVERAGED_ALBEDO_EMIS_ISBA (IO, S, NK, NP, NPE, &
+ PZENITH, PTG1, PSW_BANDS, PDIR_ALB, PSCA_ALB, &
+ PEMIS, PTSRAD, PTSURF, PDIR_SW, PSCA_SW )
! ###################################################
!
!!**** ** computes radiative fields used in ISBA
@@ -61,7 +45,9 @@
! -----------
!
!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY: ISBA_S_t, ISBA_NK_t, ISBA_NP_t, ISBA_NPE_t, ISBA_K_t, &
+ ISBA_P_t, ISBA_PE_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
@@ -74,7 +60,7 @@ USE MODI_ALBEDO
USE MODI_AVERAGE_RAD
USE MODI_UPDATE_RAD_ISBA_n
USE MODI_ISBA_LWNET_MEB
-!
+USE MODI_UNPACK_SAME_RANK
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -85,42 +71,15 @@ IMPLICIT NONE
! ------------------------
!
!
-TYPE(ISBA_t), INTENT(INOUT) :: I
-!
-LOGICAL, INTENT(IN) :: OFLOOD
- CHARACTER(LEN=4), INTENT(IN) :: HALBEDO ! albedo type
-! Albedo dependance with surface soil water content
-! "EVOL" = albedo evolves with soil wetness
-! "DRY " = constant albedo value for dry soil
-! "WET " = constant albedo value for wet soil
-! "MEAN" = constant albedo value for medium soil wetness
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PVEG ! vegetation fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PZ0 ! roughness length
-REAL, DIMENSION(:,:), INTENT(IN) :: PLAI ! leaf area index
-LOGICAL, DIMENSION(:), INTENT(IN) :: OMEB_PATCH ! multi-energy balance logical vector
-REAL, DIMENSION(:,:), INTENT(IN) :: PGNDLITTER ! Ground litter fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PLAIGV ! Understory leaf area index
-REAL, DIMENSION(:,:), INTENT(IN) :: PZ0LITTER ! Ground litter roughness length
-REAL, DIMENSION(:,:), INTENT(IN) :: PH_VEG ! Height of vegetation
-REAL, DIMENSION(:,:), INTENT(IN) :: PTV ! canopy vegetation temperature
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_NK_t), INTENT(INOUT) :: NK
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
+!
REAL, DIMENSION(:,:), INTENT(IN) :: PTG1 ! soil surface temperature
-REAL, DIMENSION(:,:), INTENT(IN) :: PPATCH ! tile fraction
-REAL, DIMENSION(:), INTENT(IN) :: PSW_BANDS ! middle wavelength of each band
REAL, DIMENSION(:), INTENT(IN) :: PZENITH
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PALBNIR_VEG ! near-infra-red albedo of vegetation
-REAL, DIMENSION(:,:), INTENT(IN) :: PALBVIS_VEG ! visible albedo of vegetation
-REAL, DIMENSION(:,:), INTENT(IN) :: PALBUV_VEG ! UV albedo of vegetation
-REAL, DIMENSION(:,:), INTENT(IN) :: PALBNIR_SOIL! near-infra-red albedo of soil
-REAL, DIMENSION(:,:), INTENT(IN) :: PALBVIS_SOIL! visible albedo of soil
-REAL, DIMENSION(:,:), INTENT(IN) :: PALBUV_SOIL ! UV albedo of soil
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMIS_ECO ! emissivity (soil+vegetation)
-TYPE(SURF_SNOW), INTENT(IN) :: TPSNOW ! prognostic snow cover
-!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PALBNIR_ECO ! near-infra-red albedo (soil+vegetation)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PALBVIS_ECO ! visible albedo (soil+vegetation)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PALBUV_ECO ! UV albedo (soil+vegetation)
+REAL, DIMENSION(:), INTENT(IN) :: PSW_BANDS ! middle wavelength of each band
!
REAL, DIMENSION(:,:), INTENT(OUT) :: PDIR_ALB ! averaged direct albedo (per wavelength)
REAL, DIMENSION(:,:), INTENT(OUT) :: PSCA_ALB ! averaged diffuse albedo (per wavelength)
@@ -136,31 +95,34 @@ REAL, DIMENSION(:,:), INTENT(IN), OPTIONAL :: PSCA_SW ! Downwelling diffuse
! ------------------------------
!
!
-REAL, DIMENSION(SIZE(PALBNIR_VEG,1),SIZE(PSW_BANDS),SIZE(PALBVIS_VEG,2)) :: ZDIR_ALB_PATCH
+TYPE(ISBA_K_t), POINTER :: KK
+TYPE(ISBA_P_t), POINTER :: PK
+TYPE(ISBA_PE_t), POINTER :: PEK
+!
+REAL, DIMENSION(SIZE(PZENITH),SIZE(PSW_BANDS),IO%NPATCH) :: ZDIR_ALB_PATCH
! ! direct albedo
-REAL, DIMENSION(SIZE(PALBNIR_VEG,1),SIZE(PSW_BANDS),SIZE(PALBVIS_VEG,2)) :: ZSCA_ALB_PATCH
+REAL, DIMENSION(SIZE(PZENITH),SIZE(PSW_BANDS),IO%NPATCH) :: ZSCA_ALB_PATCH
! ! diffuse albedo
-REAL, DIMENSION(SIZE(PEMIS_ECO, 1),SIZE(PALBVIS_VEG,2)) :: ZEMIS_PATCH ! emissivity with snow-flood
-REAL, DIMENSION(SIZE(PEMIS_ECO, 1),SIZE(PALBVIS_VEG,2)) :: ZTSRAD_PATCH ! Tsrad
-REAL, DIMENSION(SIZE(PEMIS_ECO, 1),SIZE(PALBVIS_VEG,2)) :: ZTSURF_PATCH ! Tsurf
-REAL, DIMENSION(SIZE(PEMIS_ECO, 1)) :: ZEMIS ! emissivity with flood
-!
-REAL, DIMENSION(SIZE(PEMIS_ECO, 1)) :: ZSNOWDEPTH ! Total snow depth
-REAL, DIMENSION(SIZE(PEMIS_ECO, 1)) :: ZPALPHAN ! Snow/canopy ratio factor
-REAL, DIMENSION(SIZE(PEMIS_ECO, 1)) :: ZLW_RAD ! Fake downwelling LW rad
-REAL, DIMENSION(SIZE(PEMIS_ECO, 1)) :: ZLW_UP ! Upwelling LW rad
-REAL, DIMENSION(SIZE(PEMIS_ECO, 1)) :: ZLWNET_N ! LW net for snow surface
-REAL, DIMENSION(SIZE(PEMIS_ECO, 1)) :: ZLWNET_V ! LW net for canopy veg
-REAL, DIMENSION(SIZE(PEMIS_ECO, 1)) :: ZLWNET_G ! LW net for ground
-REAL, DIMENSION(SIZE(PEMIS_ECO, 1)) :: ZDUMMY
-REAL, DIMENSION(SIZE(PEMIS_ECO, 1)) :: ZEMISF
-REAL, DIMENSION(SIZE(PEMIS_ECO, 1)) :: ZFF
+REAL, DIMENSION(SIZE(PZENITH),IO%NPATCH) :: ZEMIS_PATCH ! emissivity with snow-flood
+REAL, DIMENSION(SIZE(PZENITH),IO%NPATCH) :: ZTSRAD_PATCH ! Tsrad
+REAL, DIMENSION(SIZE(PZENITH),IO%NPATCH) :: ZTSURF_PATCH ! Tsurf
+REAL, DIMENSION(SIZE(PTG1,1)) :: ZEMIS ! emissivity with flood
+!
+REAL, DIMENSION(SIZE(PTG1,1)) :: ZSNOWDEPTH ! Total snow depth
+REAL, DIMENSION(SIZE(PTG1,1)) :: ZPALPHAN ! Snow/canopy ratio factor
+REAL, DIMENSION(SIZE(PTG1,1)) :: ZLW_RAD ! Fake downwelling LW rad
+REAL, DIMENSION(SIZE(PTG1,1)) :: ZLW_UP ! Upwelling LW rad
+REAL, DIMENSION(SIZE(PTG1,1)) :: ZLWNET_N ! LW net for snow surface
+REAL, DIMENSION(SIZE(PTG1,1)) :: ZLWNET_V ! LW net for canopy veg
+REAL, DIMENSION(SIZE(PTG1,1)) :: ZLWNET_G ! LW net for ground
+REAL, DIMENSION(SIZE(PTG1,1)) :: ZDUMMY
+REAL, DIMENSION(SIZE(PTG1,1)) :: ZEMISF
+REAL, DIMENSION(SIZE(PTG1,1)) :: ZFF
!
LOGICAL :: LEXPLICIT_SNOW ! snow scheme key
!
-INTEGER :: INP, INI
-INTEGER :: JP, JI ! loop on patches
-INTEGER :: JPATCH ! loop on patches
+INTEGER :: JP, JI,ISIZE ! loop on patches
+INTEGER :: IMASK ! loop on patches
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
@@ -170,9 +132,6 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('AVERAGED_ALBEDO_EMIS_ISBA',0,ZHOOK_HANDLE)
!
-INI=SIZE(PPATCH,1)
-INP=SIZE(PPATCH,2)
-!
PDIR_ALB(:,:)=0.
PSCA_ALB(:,:)=0.
PEMIS (:) =0.
@@ -183,20 +142,25 @@ ZDIR_ALB_PATCH(:,:,:)=0.
ZSCA_ALB_PATCH(:,:,:)=0.
ZEMIS_PATCH (:,: )=0.
!
-LEXPLICIT_SNOW = (TPSNOW%SCHEME=='3-L'.OR.TPSNOW%SCHEME=='CRO')
+LEXPLICIT_SNOW = (NPE%AL(1)%TSNOW%SCHEME=='3-L'.OR.NPE%AL(1)%TSNOW%SCHEME=='CRO')
!
-ZTSRAD_PATCH (:,:) = PTG1(:,:)
-ZTSURF_PATCH (:,:) = PTG1(:,:)
+ZTSRAD_PATCH(:,:) = 0.
+ZTSURF_PATCH(:,:) = 0.
+DO JP = 1,IO%NPATCH
+ DO JI = 1,NP%AL(JP)%NSIZE_P
+ IMASK = NP%AL(JP)%NR_P(JI)
+ ZTSRAD_PATCH (IMASK,JP) = PTG1(JI,JP)
+ ZTSURF_PATCH (IMASK,JP) = PTG1(JI,JP)
+ ENDDO
+ENDDO
!
!
!* 1. averaged albedo on natural continental surfaces (except prognostic snow)
! -----------------------------------------------
!
- CALL ALBEDO(HALBEDO, &
- PALBVIS_VEG,PALBNIR_VEG,PALBUV_VEG,PVEG, &
- PALBVIS_SOIL,PALBNIR_SOIL,PALBUV_SOIL, &
- PALBVIS_ECO,PALBNIR_ECO,PALBUV_ECO )
-
+DO JP = 1,IO%NPATCH
+ CALL ALBEDO(IO%CALBEDO, NPE%AL(JP) )
+ENDDO
!
!* 2. averaged albedo and emis. on natural continental surfaces (with prognostic snow)
! ---------------------------------------------------------
@@ -207,107 +171,124 @@ ZLW_RAD(:) = 300.0
!
!* Initialization of albedo for each wavelength, emissivity and snow/flood fractions
!
-IF(PRESENT(PDIR_SW))THEN
-!
-! For the case when MEB patch albedo is requested downweeling SW is needed
-!
- CALL UPDATE_RAD_ISBA_n(I, &
- OFLOOD, TPSNOW%SCHEME,PZENITH,PSW_BANDS,PVEG,PLAI,PZ0, &
- OMEB_PATCH,PLAIGV,PGNDLITTER,PZ0LITTER, PH_VEG, &
- PALBNIR_ECO,PALBVIS_ECO,PALBUV_ECO,PEMIS_ECO, &
- ZDIR_ALB_PATCH,ZSCA_ALB_PATCH,ZEMIS_PATCH, &
- PDIR_SW, PSCA_SW, &
- PALBNIR_VEG, PALBNIR_SOIL, &
- PALBVIS_VEG, PALBVIS_SOIL )
-ELSE
-!
-! For cases when MEB patch albedo is not requested no downweeling SW is needed
-!
- CALL UPDATE_RAD_ISBA_n(I, &
- OFLOOD, TPSNOW%SCHEME,PZENITH,PSW_BANDS,PVEG,PLAI,PZ0, &
- OMEB_PATCH,PLAIGV,PGNDLITTER,PZ0LITTER, PH_VEG, &
- PALBNIR_ECO,PALBVIS_ECO,PALBUV_ECO,PEMIS_ECO, &
- ZDIR_ALB_PATCH,ZSCA_ALB_PATCH,ZEMIS_PATCH )
-ENDIF
+DO JP = 1,IO%NPATCH
+ !
+ IF(PRESENT(PDIR_SW))THEN
+ !
+ ! For the case when MEB patch albedo is requested downweeling SW is needed
+ !
+ CALL UPDATE_RAD_ISBA_n(IO, S, NK%AL(JP), NP%AL(JP), NPE%AL(JP), JP, PZENITH, PSW_BANDS, &
+ ZDIR_ALB_PATCH(:,:,JP), ZSCA_ALB_PATCH(:,:,JP), ZEMIS_PATCH(:,JP), &
+ PDIR_SW, PSCA_SW )
+ ELSE
+ !
+ ! For cases when MEB patch albedo is not requested no downweeling SW is needed
+ !
+ CALL UPDATE_RAD_ISBA_n(IO, S, NK%AL(JP), NP%AL(JP), NPE%AL(JP), JP, PZENITH, PSW_BANDS, &
+ ZDIR_ALB_PATCH(:,:,JP), ZSCA_ALB_PATCH(:,:,JP), ZEMIS_PATCH(:,JP))
+ !
+ ENDIF
+ !
+ENDDO
!
!
!* radiative surface temperature
!
-DO JPATCH=1,SIZE(PALBVIS_VEG,2)
-!
- IF(OMEB_PATCH(JPATCH))THEN ! MEB patches
-!
-! ZPALPHAN is needed as input to ISBA_LWNET_MEB
-!
- ZSNOWDEPTH(:) = SUM(TPSNOW%WSNOW(:,:,JPATCH)/TPSNOW%RHO(:,:,JPATCH),2)
- ZPALPHAN(:) = MEBPALPHAN(ZSNOWDEPTH,PH_VEG(:,JPATCH))
-!
-! ZLWNET_N,ZLWNET_V,ZLWNET_G are needed for ZLW_UP and ZTSRAD_PATCH
-!
- IF(OFLOOD)THEN
- ZEMISF(:) = I%XEMISF(:,JPATCH)
- ZFF (:) = I%XFF (:,JPATCH)
+DO JP = 1,IO%NPATCH
+ !
+ PEK => NPE%AL(JP)
+ PK => NP%AL(JP)
+ KK => NK%AL(JP)
+ !
+ ISIZE = PK%NSIZE_P
+ !
+ IF(IO%LMEB_PATCH(JP))THEN ! MEB patches
+ !
+ ! ZPALPHAN is needed as input to ISBA_LWNET_MEB
+ !
+ ZSNOWDEPTH(1:ISIZE) = SUM(PEK%TSNOW%WSNOW(:,:)/PEK%TSNOW%RHO(:,:),2)
+ ZPALPHAN (1:ISIZE) = MEBPALPHAN(ZSNOWDEPTH(1:ISIZE),PEK%XH_VEG(:))
+ !
+ ! ZLWNET_N,ZLWNET_V,ZLWNET_G are needed for ZLW_UP and ZTSRAD_PATCH
+ !
+ IF(IO%LFLOOD)THEN
+ ZEMISF(1:ISIZE) = KK%XEMISF(:)
+ ZFF (1:ISIZE) = KK%XFF (:)
ELSE
- ZEMISF(:) = XUNDEF
- ZFF (:) = 0.0
+ ZEMISF(1:ISIZE) = XUNDEF
+ ZFF (1:ISIZE) = 0.0
ENDIF
-!
- CALL ISBA_LWNET_MEB(PLAI(:,JPATCH),I%XPSN(:,JPATCH),ZPALPHAN, &
- TPSNOW%EMIS(:,JPATCH),ZEMISF(:),ZFF(:), &
- PTV(:,JPATCH),PTG1(:,JPATCH),TPSNOW%TS(:,JPATCH), &
- ZLW_RAD,ZLWNET_N,ZLWNET_V,ZLWNET_G, &
- ZDUMMY,ZDUMMY,ZDUMMY, &
- ZDUMMY,ZDUMMY,ZDUMMY, &
- ZDUMMY,ZDUMMY,ZDUMMY, &
- ZDUMMY,ZDUMMY,ZDUMMY )
-!
- ZLW_UP(:) = ZLW_RAD(:) - (ZLWNET_V(:) + ZLWNET_G(:) + ZLWNET_N(:))
-!
-! MEB patch radiative temperature
-!
- WHERE (ZEMIS_PATCH(:,JPATCH)/=0.)
- ZTSRAD_PATCH(:,JPATCH) = ((ZLW_UP(:) - ZLW_RAD(:)*(1.0-ZEMIS_PATCH(:,JPATCH)))/ &
- (XSTEFAN*ZEMIS_PATCH(:,JPATCH)))**0.25
- END WHERE
-!
+ !
+ CALL ISBA_LWNET_MEB(PEK%XLAI, PEK%XPSN, ZPALPHAN(1:ISIZE), PEK%TSNOW%EMIS, &
+ ZEMISF(1:ISIZE), ZFF(1:ISIZE), &
+ PEK%XTV, PTG1(1:ISIZE,JP), PEK%TSNOW%TS, &
+ ZLW_RAD(1:ISIZE), ZLWNET_N(1:ISIZE), ZLWNET_V(1:ISIZE), ZLWNET_G(1:ISIZE), &
+ ZDUMMY(1:ISIZE), ZDUMMY(1:ISIZE), ZDUMMY(1:ISIZE), ZDUMMY(1:ISIZE), &
+ ZDUMMY(1:ISIZE), ZDUMMY(1:ISIZE), ZDUMMY(1:ISIZE), ZDUMMY(1:ISIZE), &
+ ZDUMMY(1:ISIZE), ZDUMMY(1:ISIZE), ZDUMMY(1:ISIZE), ZDUMMY(1:ISIZE) )
+ !
+ ZLW_UP(1:ISIZE) = ZLW_RAD(1:ISIZE) - (ZLWNET_V(1:ISIZE) + ZLWNET_G(1:ISIZE) + ZLWNET_N(1:ISIZE))
+ !
+ ! MEB patch radiative temperature
+ !
+ DO JI = 1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ IF (ZEMIS_PATCH(IMASK,JP)/=0.) THEN
+ ZTSRAD_PATCH(IMASK,JP) = ((ZLW_UP(JI) - ZLW_RAD(JI)*(1.0-ZEMIS_PATCH(IMASK,JP)))/ &
+ (XSTEFAN*ZEMIS_PATCH(IMASK,JP)))**0.25
+ ENDIF
+ END DO
+ !
ELSE ! Non-MEB patches
-
- ZEMIS(:) = PEMIS_ECO(:,JPATCH)
-!
- IF(OFLOOD.AND.LEXPLICIT_SNOW)THEN
- WHERE(I%XPSN(:,JPATCH)<1.0.AND.PEMIS_ECO(:,JPATCH)/=XUNDEF)
- ZEMIS(:) = ((1.-I%XFF(:,JPATCH)-I%XPSN(:,JPATCH))*PEMIS_ECO(:,JPATCH) + I%XFF(:,JPATCH)*I%XEMISF(:,JPATCH)) &
- /(1.-I%XPSN(:,JPATCH))
+ !
+ ZEMIS(1:ISIZE) = PEK%XEMIS(:)
+ !
+ IF(IO%LFLOOD.AND.LEXPLICIT_SNOW)THEN
+ WHERE(PEK%XPSN(:)<1.0.AND.PEK%XEMIS(:)/=XUNDEF)
+ ZEMIS(1:ISIZE) = ((1.-KK%XFF(:)-PEK%XPSN(:))*PEK%XEMIS(:) + KK%XFF(:)*KK%XEMISF(:)) /(1.-PEK%XPSN(:))
ENDWHERE
ENDIF
-!
+ !
IF (.NOT.LEXPLICIT_SNOW) THEN
- ZTSRAD_PATCH(:,JPATCH) = PTG1(:,JPATCH)
+ CALL UNPACK_SAME_RANK(PK%NR_P,PTG1(1:PK%NSIZE_P,JP),ZTSRAD_PATCH(:,JP),0.)
ELSE IF (LEXPLICIT_SNOW) THEN
- WHERE (PEMIS_ECO(:,JPATCH)/=XUNDEF .AND. ZEMIS_PATCH(:,JPATCH)/=0.)
- ZTSRAD_PATCH(:,JPATCH) =( ( (1.-I%XPSN(:,JPATCH))*ZEMIS (:) *PTG1 (:,JPATCH)**4 &
- + I%XPSN(:,JPATCH) *TPSNOW%EMIS(:,JPATCH)*TPSNOW%TS(:,JPATCH)**4 ) )**0.25 &
- / ZEMIS_PATCH(:,JPATCH)**0.25
- END WHERE
+ DO JI = 1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ IF (PEK%XEMIS(JI)/=XUNDEF .AND. ZEMIS_PATCH(IMASK,JP)/=0.) THEN
+ ZTSRAD_PATCH(IMASK,JP) =( ( (1.-PEK%XPSN(JI)) * ZEMIS(JI)*PTG1(JI,JP)**4 &
+ + PEK%XPSN(JI) *PEK%TSNOW%EMIS(JI)*PEK%TSNOW%TS(JI)**4 ) )**0.25 &
+ / ZEMIS_PATCH(IMASK,JP)**0.25
+ END IF
+ ENDDO
END IF
+
ENDIF
+!
END DO
!
!* averaged radiative fields
!
- CALL AVERAGE_RAD(PPATCH, &
- ZDIR_ALB_PATCH, ZSCA_ALB_PATCH, ZEMIS_PATCH, ZTSRAD_PATCH, &
- PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD )
+ CALL AVERAGE_RAD(S%XPATCH, &
+ ZDIR_ALB_PATCH, ZSCA_ALB_PATCH, ZEMIS_PATCH, ZTSRAD_PATCH, &
+ PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD )
!
!* averaged effective temperature
!
IF(LEXPLICIT_SNOW)THEN
- ZTSURF_PATCH(:,:) = PTG1(:,:)*(1.-I%XPSN(:,:)) + TPSNOW%TS(:,:)*I%XPSN(:,:)
+ DO JP = 1,IO%NPATCH
+ PEK => NPE%AL(JP)
+ PK => NP%AL(JP)
+ DO JI = 1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ ZTSURF_PATCH(IMASK,JP) = PTG1(JI,JP)*(1.-PEK%XPSN(JI)) + PEK%TSNOW%TS(JI)*PEK%XPSN(JI)
+ ENDDO
+ ENDDO
ENDIF
!
-DO JP=1,INP
- DO JI=1,INI
- PTSURF(JI) = PTSURF(JI) + PPATCH(JI,JP) * ZTSURF_PATCH(JI,JP)
+DO JP=1,IO%NPATCH
+ DO JI=1,NP%AL(JP)%NSIZE_P
+ IMASK = NP%AL(JP)%NR_P(JI)
+ PTSURF(IMASK) = PTSURF(IMASK) + NP%AL(JP)%XPATCH(JI) * ZTSURF_PATCH(IMASK,JP)
ENDDO
ENDDO
!
diff --git a/src/SURFEX/averaged_albedo_teb.F90 b/src/SURFEX/averaged_albedo_teb.F90
index 290a8a517f00968456545c739d2d9145834164c9..f3c95d9d94309be083f6d46e107d2422f75e91b3 100644
--- a/src/SURFEX/averaged_albedo_teb.F90
+++ b/src/SURFEX/averaged_albedo_teb.F90
@@ -3,20 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE AVERAGED_ALBEDO_TEB(HBEM, HROAD_DIR, HWALL_OPT, &
- PZENITH, PAZIM, &
- PBLD, PGARDEN, PROAD_DIR, PROAD, PFRAC_GR, &
- PFRAC_PANEL, PALB_PANEL, &
- PWALL_O_HOR, PCAN_HW_RATIO, &
- PALB_ROOF, &
- PALB_ROAD, PSVF_ROAD, &
- PALB_WALL, PSVF_WALL, &
- PALB_GARDEN, PSVF_GARDEN, &
- PALB_GREENROOF, &
- TSNOW_ROOF, TSNOW_ROAD, &
- PGR, PSHGC, PSHGC_SH, PABS_WIN, PALB_WIN, &
- OSHAD_DAY, &
- PDIR_ALB_TOWN, PSCA_ALB_TOWN, PTRAN_WIN )
+ SUBROUTINE AVERAGED_ALBEDO_TEB(TOP, T, TPN, B, PZENITH, PAZIM, &
+ PALB_GARDEN, PALB_GREENROOF, PDIR_ALB_TOWN, PSCA_ALB_TOWN)
! ###################################################
!
!!**** *AVERAGED_ALBEDO_TEB* computes averaged albedo for TEB scheme
@@ -46,12 +34,18 @@
!!
!! Original 01/2004
! C. de Munck & A. Lemonsu 09/2011 Greenroofs
-!! G. Pigeon 09/2012 PTRAN_WIN as arguments
+!! G. Pigeon 09/2012 B%XTRAN_WIN as arguments
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
! -----------
!
+USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
+USE MODD_TEB_n, ONLY : TEB_t
+USE MODD_BEM_n, ONLY : BEM_t
+USE MODD_TEB_PANEL_n, ONLY : TEB_PANEL_t
+USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_t
+!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_TYPE_SNOW
!
@@ -67,92 +61,51 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
- CHARACTER(LEN=3), INTENT(IN) :: HBEM ! Building Energy model 'DEF' or 'BEM'
- CHARACTER(LEN=4), INTENT(IN) :: HROAD_DIR ! road direction options
- ! 'UNIF' : classical TEB version, all roads uniformely present
- ! 'ORIE' : specified road ORIEntation
- ! (in fact many roads direction
- ! possible because there can be many TEB patches)
- CHARACTER(LEN=4), INTENT(IN) :: HWALL_OPT ! wall options
- ! 'UNIF' : classical TEB version, all walls are uniform
- ! 'TWO ' : the two opposite walls receive different solar energy
+TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+TYPE(TEB_t), INTENT(INOUT) :: T
+TYPE(BEM_t), INTENT(INOUT) :: B
+TYPE(TEB_PANEL_t), INTENT(INOUT) :: TPN
+!
REAL, DIMENSION(:), INTENT(IN) :: PZENITH ! zenithal solar angle
REAL, DIMENSION(:), INTENT(IN) :: PAZIM ! solar azimuthal angle
! ! (radian from N, clockwise)
!
-REAL, DIMENSION(:), INTENT(IN) :: PBLD ! building fraction
-REAL, DIMENSION(:), INTENT(IN) :: PGARDEN ! green area fraction
-REAL, DIMENSION(:), INTENT(IN) :: PROAD_DIR ! Road direction
- ! (deg from N, clockwise)
-REAL, DIMENSION(:), INTENT(IN) :: PROAD ! road fraction
-REAL, DIMENSION(:), INTENT(IN) :: PFRAC_GR ! fraction of greenroof
-REAL, DIMENSION(:), INTENT(IN) :: PFRAC_PANEL ! fraction of solar panels
-REAL, DIMENSION(:), INTENT(IN) :: PALB_PANEL ! albedo of solar panels
-REAL, DIMENSION(:), INTENT(IN) :: PWALL_O_HOR ! vertical surf. / horizontal surf.
-REAL, DIMENSION(:), INTENT(IN) :: PSVF_ROAD ! sky-view-factor from roads
-REAL, DIMENSION(:), INTENT(IN) :: PSVF_WALL ! sky-view-factor from walls
-REAL, DIMENSION(:), INTENT(IN) :: PSVF_GARDEN ! sky-view-factor from green areas
-REAL, DIMENSION(:), INTENT(IN) :: PCAN_HW_RATIO ! canyon height/width ratio
-!
-REAL, DIMENSION(:), INTENT(IN) :: PALB_ROOF ! roof albedo
-REAL, DIMENSION(:), INTENT(IN) :: PALB_ROAD ! road albedo
-REAL, DIMENSION(:), INTENT(IN) :: PALB_WALL ! wall albedo
REAL, DIMENSION(:), INTENT(IN) :: PALB_GARDEN ! green areas albedo
REAL, DIMENSION(:), INTENT(IN) :: PALB_GREENROOF! green roof albedo
-TYPE(SURF_SNOW), INTENT(IN) :: TSNOW_ROOF ! snow on roofs
-TYPE(SURF_SNOW), INTENT(IN) :: TSNOW_ROAD ! snow on roads
-!
-REAL, DIMENSION(:), INTENT(IN) :: PGR ! Glazing ratio
-REAL, DIMENSION(:), INTENT(IN) :: PSHGC ! Window solar transmittance
-REAL, DIMENSION(:), INTENT(IN) :: PSHGC_SH ! Window + shading solar heat gain coef.
-!
-REAL, DIMENSION(:), INTENT(IN) :: PABS_WIN ! Window solar absortance
-REAL, DIMENSION(:), INTENT(OUT):: PALB_WIN ! Window solar reflectance
-LOGICAL, DIMENSION(:),INTENT(IN) :: OSHAD_DAY ! has shading been necessary this day ?
-!
REAL, DIMENSION(:), INTENT(OUT):: PDIR_ALB_TOWN ! direct albedo
REAL, DIMENSION(:), INTENT(OUT):: PSCA_ALB_TOWN ! diffuse albedo
-REAL, DIMENSION(:), INTENT(IN) :: PTRAN_WIN ! window transmittance
-!
!
!* 0.2 Declaration of local variables
! ------------------------------
!
-REAL, DIMENSION(SIZE(PBLD)) :: ZDN_ROOF ! snow fraction
-REAL, DIMENSION(SIZE(PBLD)) :: ZDN_ROAD ! on the surface
-REAL, DIMENSION(SIZE(PBLD)) :: ZDF_ROOF ! free-snow fraction
-REAL, DIMENSION(SIZE(PBLD)) :: ZDF_ROAD ! on the surface
-LOGICAL, DIMENSION(SIZE(PBLD)) :: GMASK ! .false. (= no snow precip.)
-!
-!
-REAL, DIMENSION(SIZE(PBLD)) :: ZDIR_SW ! direct and diffuse shortwave radiation
-REAL, DIMENSION(SIZE(PBLD)) :: ZSCA_SW ! to mimic radiation behaviour of town
-!
-REAL, DIMENSION(SIZE(PBLD)) :: ZABS_SW_WALL_A ! shortwave absorbed by walls
-REAL, DIMENSION(SIZE(PBLD)) :: ZABS_SW_WALL_B ! shortwave absorbed by walls
-REAL, DIMENSION(SIZE(PBLD)) :: ZABS_SW_ROAD ! shortwave absorbed by roads
-REAL, DIMENSION(SIZE(PBLD)) :: ZABS_SW_ROOF ! shortwave absorbed by roofs
-REAL, DIMENSION(SIZE(PBLD)) :: ZABS_SW_GARDEN ! shortwave absorbed by green areas
-REAL, DIMENSION(SIZE(PBLD)) :: ZABS_SW_GREENROOF ! shortwave absorbed by green roofs
-REAL, DIMENSION(SIZE(PBLD)) :: ZABS_SW_SNOW_ROAD ! shortwave absorbed by snow
-REAL, DIMENSION(SIZE(PBLD)) :: ZABS_SW_SNOW_ROOF ! on roads, roofs,
-REAL, DIMENSION(SIZE(PBLD)) :: ZABS_SW_PANEL ! shortwave absorbed by solar panels
-!
-REAL, DIMENSION(SIZE(PBLD)) :: ZREC_SW_ROAD ! shortwave received by roads
-REAL, DIMENSION(SIZE(PBLD)) :: ZREC_SW_WALL_A ! shortwave received by walls
-REAL, DIMENSION(SIZE(PBLD)) :: ZREC_SW_WALL_B ! shortwave received by walls
-REAL, DIMENSION(SIZE(PBLD)) :: ZREC_SW_GARDEN ! shortwave received by green areas
-REAL, DIMENSION(SIZE(PBLD)) :: ZREC_SW_SNOW_ROAD ! shortwave received by snow on roads
-REAL, DIMENSION(SIZE(PBLD)) :: ZREC_SW_ROOF ! shortwave received by roofs
-!
-REAL, DIMENSION(SIZE(PBLD)) :: ZSW_RAD_GARDEN ! total solar radiation reaching green areas
-REAL, DIMENSION(SIZE(PBLD)) :: ZABS_SW_WIN ! shortwave absorbed by walls
-REAL, DIMENSION(SIZE(PBLD)) :: ZREC_SW_WIN ! shortwave received by walls
-REAL, DIMENSION(SIZE(PBLD)) :: ZREF_SW_GRND !
-REAL, DIMENSION(SIZE(PBLD)) :: ZREF_SW_FAC !
-REAL, DIMENSION(SIZE(PBLD)) :: ZTR_SW_WIN !
-REAL, DIMENSION(SIZE(PBLD)) :: ZE_SHADING !
-LOGICAL, DIMENSION(SIZE(PBLD)) :: GSHAD_DAY
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZDN_ROOF ! snow fraction
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZDN_ROAD ! on the surface
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZDF_ROOF ! free-snow fraction
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZDF_ROAD ! on the surface
+LOGICAL, DIMENSION(SIZE(T%XBLD)) :: GMASK ! .false. (= no snow precip.)
+!
+!
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZDIR_SW ! direct and diffuse shortwave radiation
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZSCA_SW ! to mimic radiation behaviour of town
+!
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZABS_SW_PANEL ! shortwave absorbed by solar panels
+!
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZREC_SW_ROAD ! shortwave received by roads
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZREC_SW_WALL_A ! shortwave received by walls
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZREC_SW_WALL_B ! shortwave received by walls
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZREC_SW_GARDEN ! shortwave received by green areas
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZREC_SW_SNOW_ROAD ! shortwave received by snow on roads
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZREC_SW_ROOF ! shortwave received by roofs
+!
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZSW_RAD_GARDEN ! total solar radiation reaching green areas
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZREC_SW_WIN ! shortwave received by walls
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZREF_SW_GRND !
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZREF_SW_FAC !
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZE_SHADING !
+LOGICAL, DIMENSION(SIZE(T%XBLD)) :: GSHAD_DAY
+!
+TYPE(DIAG_MISC_TEB_t) :: YDMT
+!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
@@ -161,8 +114,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('AVERAGED_ALBEDO_TEB',0,ZHOOK_HANDLE)
GMASK(:) = .FALSE.
- CALL SNOW_FRAC_ROAD(TSNOW_ROAD%WSNOW(:,1,1),GMASK,ZDN_ROAD,ZDF_ROAD)
- CALL SNOW_FRAC_ROOF(TSNOW_ROOF%WSNOW(:,1,1),GMASK,ZDN_ROOF,ZDF_ROOF)
+ CALL SNOW_FRAC_ROAD(T%TSNOW_ROAD%WSNOW(:,1),GMASK,ZDN_ROAD,ZDF_ROAD)
+ CALL SNOW_FRAC_ROOF(T%TSNOW_ROOF%WSNOW(:,1),GMASK,ZDN_ROOF,ZDF_ROOF)
!
!
!* town direct and diffuse albedo
@@ -171,33 +124,18 @@ GMASK(:) = .FALSE.
ZDIR_SW=1.
ZSCA_SW=1.
GSHAD_DAY=.FALSE.
-IF (SIZE(OSHAD_DAY)>0) GSHAD_DAY=OSHAD_DAY
-!
- CALL URBAN_SOLAR_ABS(HBEM, HROAD_DIR, HWALL_OPT, &
- ZDIR_SW, ZSCA_SW, PZENITH, PAZIM, &
- PBLD, PGARDEN, PROAD_DIR, PROAD, PFRAC_GR, &
- PWALL_O_HOR, PCAN_HW_RATIO, &
- PALB_ROOF, &
- PALB_ROAD, PSVF_ROAD, PALB_WALL, PSVF_WALL, &
- PFRAC_PANEL, PALB_PANEL, &
- PALB_GARDEN, PSVF_GARDEN, &
- PALB_GREENROOF, &
- TSNOW_ROOF%ALB(:,1), TSNOW_ROAD%ALB(:,1), &
- ZDN_ROOF, ZDF_ROOF, ZDN_ROAD, ZDF_ROAD, &
- PGR, PABS_WIN, PSHGC, PSHGC_SH, PALB_WIN, &
- ZABS_SW_ROOF, ZABS_SW_ROAD, &
- ZABS_SW_WALL_A, ZABS_SW_WALL_B, &
- ZABS_SW_GARDEN, ZABS_SW_GREENROOF, &
- ZABS_SW_SNOW_ROOF, ZABS_SW_SNOW_ROAD, &
- ZABS_SW_PANEL, &
- ZREC_SW_ROAD, ZREC_SW_SNOW_ROAD, &
- ZREC_SW_WALL_A, ZREC_SW_WALL_B, &
- ZREC_SW_GARDEN, ZREC_SW_ROOF, &
- PDIR_ALB_TOWN, PSCA_ALB_TOWN, &
- ZSW_RAD_GARDEN, ZABS_SW_WIN, ZREC_SW_WIN, &
- PTRAN_WIN, &
- ZREF_SW_GRND, ZREF_SW_FAC, ZTR_SW_WIN, &
- ZE_SHADING, GSHAD_DAY, GMASK )
+IF (SIZE(B%LSHAD_DAY)>0) GSHAD_DAY=B%LSHAD_DAY
+!
+ CALL URBAN_SOLAR_ABS(TOP, T, B, YDMT, ZDIR_SW, ZSCA_SW, PZENITH, PAZIM, &
+ TPN%XFRAC_PANEL, TPN%XALB_PANEL, PALB_GARDEN, &
+ T%XSVF_GARDEN, PALB_GREENROOF, ZDN_ROOF, ZDF_ROOF, &
+ ZDN_ROAD, ZDF_ROAD, ZREC_SW_ROAD, ZREC_SW_SNOW_ROAD,&
+ ZREC_SW_WALL_A, ZREC_SW_WALL_B, ZREC_SW_GARDEN, &
+ ZREC_SW_ROOF, PDIR_ALB_TOWN, PSCA_ALB_TOWN, &
+ ZSW_RAD_GARDEN, ZREC_SW_WIN, ZREF_SW_GRND, &
+ ZREF_SW_FAC, ZE_SHADING, GSHAD_DAY, GMASK, &
+ OALB_ONLY=.TRUE. )
+!
IF (LHOOK) CALL DR_HOOK('AVERAGED_ALBEDO_TEB',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/averaged_tsrad_teb.F90 b/src/SURFEX/averaged_tsrad_teb.F90
index fb3b0125be69003d9d50d078455145b029634b60..2204a16d6f69b33306e7bb7461fd4f6e9cc29e23 100644
--- a/src/SURFEX/averaged_tsrad_teb.F90
+++ b/src/SURFEX/averaged_tsrad_teb.F90
@@ -3,18 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE AVERAGED_TSRAD_TEB(PEMIS_ROOF, PTS_ROOF, &
- PEMIS_ROAD, PTS_ROAD, &
- PEMIS_WALL, PTS_WALL_A, &
- PTS_WALL_B, &
- PEMIS_GARDEN, PTS_GARDEN, &
- PEMIS_GREENROOF, PTS_GREENROOF, &
- TSNOW_ROOF, TSNOW_ROAD, &
- PROAD, PFRAC_GR, PGARDEN, PBLD, &
- PWALL_O_HOR, PSVF_ROAD, &
- PSVF_WALL, PSVF_GARDEN, &
- PEMIS, PTSRAD, PT_WIN1, &
- PGR )
+ SUBROUTINE AVERAGED_TSRAD_TEB(T, B, PEMIS_GARDEN, PTS_GARDEN, PEMIS_GREENROOF, &
+ PTS_GREENROOF, PEMIS, PTSRAD )
! ###################################################
!
!!**** *AVERAGED_TSRAD_TEB* computes averaged emissivity and radiative surface
@@ -23,7 +13,7 @@
!! PURPOSE
!! -------
!!
-!! METHOD
+!! METHODi
!! ------
!!
!! EXTERNAL
@@ -50,6 +40,9 @@
!* 0. DECLARATION
! -----------
!
+USE MODD_TEB_n, ONLY : TEB_t
+USE MODD_BEM_n, ONLY : BEM_t
+!
USE MODD_TYPE_SNOW
!
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -68,84 +61,67 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_ROOF ! roof emissivity
-REAL, DIMENSION(:), INTENT(IN) :: PTS_ROOF ! roof surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_ROAD ! road emissivity
-REAL, DIMENSION(:), INTENT(IN) :: PTS_ROAD ! road surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_WALL ! wall emissivity
-REAL, DIMENSION(:), INTENT(IN) :: PTS_WALL_A ! wall surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS_WALL_B ! wall surface temperature
+TYPE(TEB_t), INTENT(INOUT) :: T
+TYPE(BEM_t), INTENT(INOUT) :: B
+!
REAL, DIMENSION(:), INTENT(IN) :: PEMIS_GARDEN ! green area emissivity (snowfree)
-REAL, DIMENSION(:), INTENT(IN) :: PTS_GREENROOF ! green roof surf. temp.
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_GREENROOF! green roof emissivity (snowfree)
REAL, DIMENSION(:), INTENT(IN) :: PTS_GARDEN ! green area surf. temp.
-TYPE(SURF_SNOW), INTENT(IN) :: TSNOW_ROOF ! snow on roofs
-TYPE(SURF_SNOW), INTENT(IN) :: TSNOW_ROAD ! snow on roads
-REAL, DIMENSION(:), INTENT(IN) :: PROAD ! road fraction
-REAL, DIMENSION(:), INTENT(IN) :: PFRAC_GR ! green roof fraction
-REAL, DIMENSION(:), INTENT(IN) :: PGARDEN ! green area fraction
-REAL, DIMENSION(:), INTENT(IN) :: PBLD ! building fraction
-REAL, DIMENSION(:), INTENT(IN) :: PWALL_O_HOR ! vertical surf. / horizontal surf.
-REAL, DIMENSION(:), INTENT(IN) :: PSVF_ROAD ! sky-view-factor from roads
-REAL, DIMENSION(:), INTENT(IN) :: PSVF_WALL ! sky-view-factor from walls
-REAL, DIMENSION(:), INTENT(IN) :: PSVF_GARDEN ! sky-view-factor from green areas
+REAL, DIMENSION(:), INTENT(IN) :: PEMIS_GREENROOF! green roof emissivity (snowfree)
+REAL, DIMENSION(:), INTENT(IN) :: PTS_GREENROOF ! green roof surf. temp.
REAL, DIMENSION(:), INTENT(OUT):: PEMIS ! averaged emissivity (all tiles)
REAL, DIMENSION(:), INTENT(OUT):: PTSRAD ! averaged radiaitve temp. (all tiles)
-REAL, DIMENSION(:), INTENT(IN) :: PT_WIN1 !
-REAL, DIMENSION(:), INTENT(IN) :: PGR !
-!
!
!* 0.2 Declaration of local variables
! ------------------------------
!
-REAL, DIMENSION(SIZE(PEMIS_ROOF)) :: ZDN_ROOF ! snow fraction
-REAL, DIMENSION(SIZE(PEMIS_ROOF)) :: ZDN_ROAD ! on the surface
-REAL, DIMENSION(SIZE(PBLD)) :: ZDF_ROOF ! free-snow fraction
-REAL, DIMENSION(SIZE(PBLD)) :: ZDF_ROAD ! on the surface
-LOGICAL, DIMENSION(SIZE(PBLD)) :: GMASK ! .false. (= no snow precip.)
-!
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_WA_TO_WB ! longwave exchange coefficients
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_WA_TO_R
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_WB_TO_R
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_WA_TO_NR
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_WB_TO_NR
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_WA_TO_G
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_WB_TO_G
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_WA_TO_WIN
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_WB_TO_WIN
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_R_TO_WA
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_R_TO_WB
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_R_TO_WIN
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_G_TO_WA
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_G_TO_WB
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_G_TO_WIN
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_S_TO_WA
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_S_TO_WB
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_S_TO_R
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_S_TO_NR
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_S_TO_G
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_S_TO_WIN
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_WIN_TO_WA
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_WIN_TO_WB
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_WIN_TO_R
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_WIN_TO_NR
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_WIN_TO_G
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_NR_TO_WA
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_NR_TO_WB
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_NR_TO_WIN
-!
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_RAD ! incoming LW to mimic
+REAL, DIMENSION(SIZE(T%XEMIS_ROOF)) :: ZDN_ROOF ! snow fraction
+REAL, DIMENSION(SIZE(T%XEMIS_ROOF)) :: ZDN_ROAD ! on the surface
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZDF_ROOF ! free-snow fraction
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZDF_ROAD ! on the surface
+LOGICAL, DIMENSION(SIZE(T%XBLD)) :: GMASK ! .false. (= no snow precip.)
+!
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WA_TO_WB ! longwave exchange coefficients
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WA_TO_R
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WB_TO_R
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WA_TO_NR
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WB_TO_NR
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WA_TO_G
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WB_TO_G
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WA_TO_WIN
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WB_TO_WIN
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_R_TO_WA
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_R_TO_WB
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_R_TO_WIN
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_G_TO_WA
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_G_TO_WB
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_G_TO_WIN
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_S_TO_WA
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_S_TO_WB
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_S_TO_R
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_S_TO_NR
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_S_TO_G
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_S_TO_WIN
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WIN_TO_WA
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WIN_TO_WB
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WIN_TO_R
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WIN_TO_NR
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WIN_TO_G
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_NR_TO_WA
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_NR_TO_WB
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_NR_TO_WIN
+!
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_RAD ! incoming LW to mimic
! ! radiation behaviour of town
-REAL, DIMENSION(SIZE(PBLD)) :: ZABS_LW_WALL ! longwave absorbed by walls
-REAL, DIMENSION(SIZE(PBLD)) :: ZABS_LW_ROAD ! longwave absorbed by roads
-REAL, DIMENSION(SIZE(PBLD)) :: ZABS_LW_ROOF ! longwave absorbed by roofs
-REAL, DIMENSION(SIZE(PBLD)) :: ZABS_LW_SNOW_ROAD! longwave absorbed by snow
-REAL, DIMENSION(SIZE(PBLD)) :: ZABS_LW_SNOW_ROOF! on roads and roofs
-REAL, DIMENSION(SIZE(PBLD)) :: ZABS_LW_GARDEN ! longwave absorbed by gardens
-REAL, DIMENSION(SIZE(PBLD)) :: ZABS_LW_GREENROOF! longwave absorbed by green roofs
-REAL, DIMENSION(SIZE(PBLD)) :: ZLW_UP ! outgoing longwave
-!
-REAL, DIMENSION(SIZE(PBLD)) :: ZT_SKY
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZABS_LW_WALL ! longwave absorbed by walls
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZABS_LW_ROAD ! longwave absorbed by roads
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZABS_LW_ROOF ! longwave absorbed by roofs
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZABS_LW_SNOW_ROAD! longwave absorbed by snow
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZABS_LW_SNOW_ROOF! on roads and roofs
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZABS_LW_GARDEN ! longwave absorbed by gardens
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZABS_LW_GREENROOF! longwave absorbed by green roofs
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_UP ! outgoing longwave
+!
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZT_SKY
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
@@ -155,22 +131,22 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('AVERAGED_TSRAD_TEB',0,ZHOOK_HANDLE)
GMASK(:) = .FALSE.
- CALL SNOW_FRAC_ROAD(TSNOW_ROAD%WSNOW(:,1,1),GMASK,ZDN_ROAD,ZDF_ROAD)
- CALL SNOW_FRAC_ROOF(TSNOW_ROOF%WSNOW(:,1,1),GMASK,ZDN_ROOF,ZDF_ROOF)
+ CALL SNOW_FRAC_ROAD(T%TSNOW_ROAD%WSNOW(:,1),GMASK,ZDN_ROAD,ZDF_ROAD)
+ CALL SNOW_FRAC_ROOF(T%TSNOW_ROOF%WSNOW(:,1),GMASK,ZDN_ROOF,ZDF_ROOF)
!
! fixed incoming LW (W/m2)
-ZLW_RAD(:)= XSTEFAN * (PTS_ROAD(:) ** 4)
+ZLW_RAD(:)= XSTEFAN * (T%XT_ROAD(:,1) ** 4)
!
! LW absorbed by roofs
-ZABS_LW_ROOF(:) = PEMIS_ROOF(:) * (ZLW_RAD(:) - XSTEFAN * PTS_ROOF(:)**4)
+ZABS_LW_ROOF(:) = T%XEMIS_ROOF(:) * (ZLW_RAD(:) - XSTEFAN * T%XT_ROOF(:,1)**4)
!
!* LW absorbed by snow on roof
-ZABS_LW_SNOW_ROOF(:) = TSNOW_ROOF%EMIS(:,1) * (ZLW_RAD(:) - XSTEFAN * TSNOW_ROOF%TS(:,1)**4)
+ZABS_LW_SNOW_ROOF(:) = T%TSNOW_ROOF%EMIS(:) * (ZLW_RAD(:) - XSTEFAN * T%TSNOW_ROOF%TS(:)**4)
!
!* town averaged emissivity
-PEMIS(:) = PBLD(:) * (1.-PFRAC_GR(:)) * (ZDF_ROOF(:)*PEMIS_ROOF (:) &
- + ZDN_ROOF(:)*TSNOW_ROOF%EMIS(:,1)) &
- + PBLD(:) * PFRAC_GR(:) * PEMIS_GREENROOF(:)
+PEMIS(:) = T%XBLD(:) * (1.-T%XGREENROOF(:)) * (ZDF_ROOF(:)*T%XEMIS_ROOF (:) &
+ + ZDN_ROOF(:)*T%TSNOW_ROOF%EMIS(:)) &
+ + T%XBLD(:) * T%XGREENROOF(:) * PEMIS_GREENROOF(:)
!
!* long-wave trapping coefficients
@@ -178,65 +154,61 @@ PEMIS(:) = PBLD(:) * (1.-PFRAC_GR(:)) * (ZDF_ROOF(:)*PEMIS_ROOF (:) &
!
ZT_SKY(:) = (ZLW_RAD(:)/XSTEFAN)**0.25
!
- CALL URBAN_LW_COEF(PGR, PBLD, ZLW_RAD, &
- PEMIS_ROAD, PSVF_ROAD, PEMIS_WALL, PSVF_WALL, &
- PEMIS_GARDEN, PROAD, PGARDEN, &
- TSNOW_ROAD%EMIS(:,1), &
- PTS_ROAD, PTS_WALL_A, PTS_WALL_B, &
- PTS_ROAD, PTS_GARDEN, PT_WIN1, &
- ZLW_WA_TO_WB, ZLW_WA_TO_R, ZLW_WB_TO_R, &
- ZLW_WA_TO_NR,ZLW_WB_TO_NR, &
- ZLW_WA_TO_G, ZLW_WB_TO_G, &
- ZLW_WA_TO_WIN, ZLW_WB_TO_WIN, &
- ZLW_R_TO_WA, ZLW_R_TO_WB, ZLW_R_TO_WIN, &
- ZLW_G_TO_WA, ZLW_G_TO_WB, ZLW_G_TO_WIN, &
- ZLW_S_TO_WA, ZLW_S_TO_WB, ZLW_S_TO_R, &
- ZLW_S_TO_NR, ZLW_S_TO_G, ZLW_S_TO_WIN, &
- ZLW_WIN_TO_WA, ZLW_WIN_TO_WB, ZLW_WIN_TO_R, &
- ZLW_WIN_TO_NR, ZLW_WIN_TO_G, &
- ZLW_NR_TO_WA, ZLW_NR_TO_WB, ZLW_NR_TO_WIN )
+ CALL URBAN_LW_COEF(B, T, ZLW_RAD, PEMIS_GARDEN, &
+ T%XT_ROAD(:,1), PTS_GARDEN, &
+ ZLW_WA_TO_WB, ZLW_WA_TO_R, ZLW_WB_TO_R, &
+ ZLW_WA_TO_NR,ZLW_WB_TO_NR, &
+ ZLW_WA_TO_G, ZLW_WB_TO_G, &
+ ZLW_WA_TO_WIN, ZLW_WB_TO_WIN, &
+ ZLW_R_TO_WA, ZLW_R_TO_WB, ZLW_R_TO_WIN, &
+ ZLW_G_TO_WA, ZLW_G_TO_WB, ZLW_G_TO_WIN, &
+ ZLW_S_TO_WA, ZLW_S_TO_WB, ZLW_S_TO_R, &
+ ZLW_S_TO_NR, ZLW_S_TO_G, ZLW_S_TO_WIN, &
+ ZLW_WIN_TO_WA, ZLW_WIN_TO_WB, ZLW_WIN_TO_R, &
+ ZLW_WIN_TO_NR, ZLW_WIN_TO_G, &
+ ZLW_NR_TO_WA, ZLW_NR_TO_WB, ZLW_NR_TO_WIN )
!
!
!* town averaged emissivity
! ------------------------
!
- PEMIS(:) = PEMIS(:) &
- + PROAD(:)*PSVF_ROAD(:)* (ZDF_ROAD(:)* PEMIS_ROAD(:) &
- + ZDN_ROAD(:)* TSNOW_ROAD%EMIS(:,1)) &
- + PWALL_O_HOR(:) * PSVF_WALL(:) * PEMIS_WALL(:) &
- + PGARDEN(:) * PSVF_GARDEN(:) * PEMIS_GARDEN(:)
+ PEMIS(:) = PEMIS(:) &
+ + T%XROAD(:)*T%XSVF_ROAD(:)* (ZDF_ROAD(:)* T%XEMIS_ROAD(:) &
+ + ZDN_ROAD(:)* T%TSNOW_ROAD%EMIS(:)) &
+ + T%XWALL_O_HOR(:) * T%XSVF_WALL(:) * T%XEMIS_WALL(:) &
+ + T%XGARDEN(:) * T%XSVF_GARDEN(:) * PEMIS_GARDEN(:)
!
! LW absorbed by roads
- ZABS_LW_ROAD(:) = ZLW_S_TO_R (:) * (ZT_SKY (:) - PTS_ROAD(:)) &
- + ZLW_WA_TO_R (:) * (PTS_WALL_A(:) - PTS_ROAD(:)) &
- + ZLW_WB_TO_R (:) * (PTS_WALL_B(:) - PTS_ROAD(:)) &
- + ZLW_WIN_TO_R(:) * (PT_WIN1 (:) - PTS_ROAD(:))
+ ZABS_LW_ROAD(:) = ZLW_S_TO_R (:) * (ZT_SKY (:) - T%XT_ROAD(:,1)) &
+ + ZLW_WA_TO_R (:) * (T%XT_WALL_A(:,1) - T%XT_ROAD(:,1)) &
+ + ZLW_WB_TO_R (:) * (T%XT_WALL_B(:,1) - T%XT_ROAD(:,1)) &
+ + ZLW_WIN_TO_R(:) * (B%XT_WIN1 (:) - T%XT_ROAD(:,1))
!
! LW absorbed by walls
- ZABS_LW_WALL(:) =( ZLW_S_TO_WA(:) * (ZT_SKY(:) - PTS_WALL_A(:)) &
- + ZLW_R_TO_WA(:) * (PTS_ROAD(:) - PTS_WALL_A(:)) &
- + ZLW_G_TO_WA(:) * (PTS_GARDEN(:)- PTS_WALL_A(:)) &
- + ZLW_WIN_TO_WA(:)* (PT_WIN1(:) - PTS_WALL_A(:)) &
- + ZLW_S_TO_WB(:) * (ZT_SKY(:) - PTS_WALL_B(:)) &
- + ZLW_R_TO_WB(:) * (PTS_ROAD(:) - PTS_WALL_B(:)) &
- + ZLW_G_TO_WB(:) * (PTS_GARDEN(:)- PTS_WALL_B(:)) &
- + ZLW_WIN_TO_WB(:)* (PT_WIN1(:) - PTS_WALL_B(:)))&
+ ZABS_LW_WALL(:) =( ZLW_S_TO_WA(:) * (ZT_SKY(:) - T%XT_WALL_A(:,1)) &
+ + ZLW_R_TO_WA(:) * (T%XT_ROAD(:,1) - T%XT_WALL_A(:,1)) &
+ + ZLW_G_TO_WA(:) * (PTS_GARDEN(:) - T%XT_WALL_A(:,1)) &
+ + ZLW_WIN_TO_WA(:)* (B%XT_WIN1(:) - T%XT_WALL_A(:,1)) &
+ + ZLW_S_TO_WB(:) * (ZT_SKY(:) - T%XT_WALL_B(:,1)) &
+ + ZLW_R_TO_WB(:) * (T%XT_ROAD(:,1) - T%XT_WALL_B(:,1)) &
+ + ZLW_G_TO_WB(:) * (PTS_GARDEN(:) - T%XT_WALL_B(:,1)) &
+ + ZLW_WIN_TO_WB(:)* (B%XT_WIN1(:) - T%XT_WALL_B(:,1)))&
* 0.5
!
!* LW absorbed by snow on road
- ZABS_LW_SNOW_ROAD(:) = ZLW_S_TO_R (:) * (ZT_SKY(:) - TSNOW_ROAD%TS(:,1)) &
- + ZLW_WA_TO_NR (:) * (PTS_WALL_A(:) - TSNOW_ROAD%TS(:,1)) &
- + ZLW_WB_TO_NR (:) * (PTS_WALL_B(:) - TSNOW_ROAD%TS(:,1)) &
- + ZLW_WIN_TO_NR(:) * (PT_WIN1(:) - TSNOW_ROAD%TS(:,1))
+ ZABS_LW_SNOW_ROAD(:) = ZLW_S_TO_R (:) * (ZT_SKY(:) - T%TSNOW_ROAD%TS(:)) &
+ + ZLW_WA_TO_NR (:) * (T%XT_WALL_A(:,1) - T%TSNOW_ROAD%TS(:)) &
+ + ZLW_WB_TO_NR (:) * (T%XT_WALL_B(:,1) - T%TSNOW_ROAD%TS(:)) &
+ + ZLW_WIN_TO_NR(:) * (B%XT_WIN1(:) - T%TSNOW_ROAD%TS(:))
!
!* LW absorbed by gardens
- ZABS_LW_GARDEN(:) = ZLW_S_TO_G (:)*(ZT_SKY (:)-PTS_GARDEN(:)) &
- + ZLW_WA_TO_G (:)*(PTS_WALL_A(:)-PTS_GARDEN(:)) &
- + ZLW_WB_TO_G (:)*(PTS_WALL_B(:)-PTS_GARDEN(:)) &
- + ZLW_WIN_TO_G(:)*(PT_WIN1 (:)-PTS_GARDEN(:))
+ ZABS_LW_GARDEN(:) = ZLW_S_TO_G (:)*(ZT_SKY (:)-PTS_GARDEN(:)) &
+ + ZLW_WA_TO_G (:)*(T%XT_WALL_A(:,1)-PTS_GARDEN(:)) &
+ + ZLW_WB_TO_G (:)*(T%XT_WALL_B(:,1)-PTS_GARDEN(:)) &
+ + ZLW_WIN_TO_G(:)*(B%XT_WIN1 (:)-PTS_GARDEN(:))
!
!* LW absorbed by green roofs
ZABS_LW_GREENROOF(:) = PEMIS_GREENROOF(:) * (ZLW_RAD(:) - XSTEFAN * PTS_GREENROOF(:)** 4)
@@ -244,13 +216,13 @@ ZABS_LW_GREENROOF(:) = PEMIS_GREENROOF(:) * (ZLW_RAD(:) - XSTEFAN * PTS_GREENROO
!
!* outgoing longwave radiation
ZLW_UP(:) = ZLW_RAD(:) &
- - ( PBLD(:) *(1.-PFRAC_GR(:))*ZDF_ROOF(:)*ZABS_LW_ROOF (:) &
- +PBLD(:) *(1.-PFRAC_GR(:))*ZDN_ROOF(:)*ZABS_LW_SNOW_ROOF(:) &
- +PBLD(:) * PFRAC_GR(:) *ZABS_LW_GREENROOF(:) &
- +PROAD(:) *ZDF_ROAD(:)*ZABS_LW_ROAD (:) &
- +PROAD(:) *ZDN_ROAD(:)*ZABS_LW_SNOW_ROAD(:) &
- +PWALL_O_HOR(:) *ZABS_LW_WALL (:) &
- +PGARDEN(:) *ZABS_LW_GARDEN (:))
+ - ( T%XBLD(:) *(1.-T%XGREENROOF(:))*ZDF_ROOF(:)*ZABS_LW_ROOF (:) &
+ +T%XBLD(:) *(1.-T%XGREENROOF(:))*ZDN_ROOF(:)*ZABS_LW_SNOW_ROOF(:) &
+ +T%XBLD(:) * T%XGREENROOF(:) *ZABS_LW_GREENROOF(:) &
+ +T%XROAD(:) *ZDF_ROAD(:)*ZABS_LW_ROAD (:) &
+ +T%XROAD(:) *ZDN_ROAD(:)*ZABS_LW_SNOW_ROAD(:) &
+ +T%XWALL_O_HOR(:) *ZABS_LW_WALL (:) &
+ +T%XGARDEN(:) *ZABS_LW_GARDEN (:))
!
!* town radiative surface temperature
PTSRAD(:) = ((ZLW_UP(:) - ZLW_RAD(:)*(1.-PEMIS(:))) /PEMIS(:)/XSTEFAN)**0.25
diff --git a/src/SURFEX/avg_albedo_emis_garden.F90 b/src/SURFEX/avg_albedo_emis_garden.F90
deleted file mode 100644
index 7e84b94e52464b7d1a42a072bd7ac8fb70e924a2..0000000000000000000000000000000000000000
--- a/src/SURFEX/avg_albedo_emis_garden.F90
+++ /dev/null
@@ -1,199 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE AVG_ALBEDO_EMIS_GARDEN (TGD, &
- HALBEDO, &
- PVEG,PZ0,PLAI,PTG1, &
- PSW_BANDS, &
- PALBNIR_VEG,PALBVIS_VEG, &
- PALBUV_VEG, &
- PALBNIR_SOIL,PALBVIS_SOIL, &
- PALBUV_SOIL, &
- PEMIS_ECO, &
- TPSNOW, &
- PALBNIR_ECO,PALBVIS_ECO, &
- PALBUV_ECO, &
- PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD )
-! ###################################################
-!
-!!**** ** computes radiative fields used in GARDEN
-!!
-!! PURPOSE
-!! -------
-!!
-!! METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! V. Masson Meteo-France
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 01/2004
-!! A. Bogatchev 09/2005 EBA snow option
-!! B. Decharme 2008 The fraction of vegetation covered by snow must be
-! <= to XPSNG
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
-!
-!
-USE MODD_TEB_GARDEN_n, ONLY : TEB_GARDEN_t
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE MODD_TYPE_SNOW
-!
-USE MODD_SNOW_PAR, ONLY : XEMISSN
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-!
-USE MODI_ALBEDO
-USE MODI_ALBEDO_FROM_NIR_VIS
-USE MODI_ISBA_SNOW_FRAC
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-!
-!
-TYPE(TEB_GARDEN_t), INTENT(INOUT) :: TGD
-!
- CHARACTER(LEN=4), INTENT(IN) :: HALBEDO ! albedo type
-! Albedo dependance with surface soil water content
-! "EVOL" = albedo evolves with soil wetness
-! "DRY " = constant albedo value for dry soil
-! "WET " = constant albedo value for wet soil
-! "MEAN" = constant albedo value for medium soil wetness
-!
-REAL, DIMENSION(:), INTENT(IN) :: PVEG ! vegetation fraction
-REAL, DIMENSION(:), INTENT(IN) :: PZ0 ! roughness length
-REAL, DIMENSION(:), INTENT(IN) :: PLAI ! leaf area index
-REAL, DIMENSION(:), INTENT(IN) :: PTG1 ! soil surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PSW_BANDS ! middle wavelength of each band
-
-REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_VEG ! near-infra-red albedo of vegetation
-REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_VEG ! visible albedo of vegetation
-REAL, DIMENSION(:), INTENT(IN) :: PALBUV_VEG ! UV albedo of vegetation
-REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_SOIL! near-infra-red albedo of soil
-REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_SOIL! visible albedo of soil
-REAL, DIMENSION(:), INTENT(IN) :: PALBUV_SOIL ! UV albedo of soil
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_ECO ! emissivity (soil+vegetation)
-TYPE(SURF_SNOW), INTENT(IN) :: TPSNOW ! prognostic snow cover
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PALBNIR_ECO ! near-infra-red albedo (soil+vegetation)
-REAL, DIMENSION(:), INTENT(OUT) :: PALBVIS_ECO ! visible albedo (soil+vegetation)
-REAL, DIMENSION(:), INTENT(OUT) :: PALBUV_ECO ! UV albedo (soil+vegetation)
-!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PDIR_ALB ! averaged direct albedo (per wavelength)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSCA_ALB ! averaged diffuse albedo (per wavelength)
-REAL, DIMENSION(:), INTENT(OUT) :: PEMIS ! averaged emissivity
-REAL, DIMENSION(:), INTENT(OUT) :: PTSRAD ! averaged radiaitve temp.
-!
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-!
-REAL, DIMENSION(SIZE(PALBNIR_VEG)) :: ZALBNIR ! near-infra-red albedo with snow
-REAL, DIMENSION(SIZE(PALBVIS_VEG)) :: ZALBVIS ! visible albedo with snow
-REAL, DIMENSION(SIZE(PALBUV_VEG )) :: ZALBUV ! UV albedo with snow
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. averaged albedo on natural continental surfaces (except prognostic snow)
-! -----------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('AVG_ALBEDO_EMIS_GARDEN',0,ZHOOK_HANDLE)
- CALL ALBEDO(HALBEDO, &
- PALBVIS_VEG,PALBNIR_VEG,PALBUV_VEG,PVEG, &
- PALBVIS_SOIL,PALBNIR_SOIL,PALBUV_SOIL, &
- PALBVIS_ECO,PALBNIR_ECO,PALBUV_ECO )
-
-!
-!* 2. averaged albedo and emis. on natural continental surfaces (with prognostic snow)
-! ---------------------------------------------------------
-!
-ZALBNIR(:)=0.
-ZALBVIS(:)=0.
-ZALBUV (:)=0.
-!
-PDIR_ALB(:,:)=0.
-PSCA_ALB(:,:)=0.
-PEMIS (:) =0.
-PTSRAD (:) =0.
-!
-!
- CALL ISBA_SNOW_FRAC(TGD%CUR%TSNOW%SCHEME, &
- TGD%CUR%TSNOW%WSNOW(:,:,1), TGD%CUR%TSNOW%RHO(:,:,1),&
- TGD%CUR%TSNOW%ALB (:,1), &
- PVEG(:), PLAI(:), PZ0(:), &
- TGD%CUR%XPSN(:), TGD%CUR%XPSNV_A(:), &
- TGD%CUR%XPSNG(:), TGD%CUR%XPSNV(:) )
-!
- WHERE (PVEG(:)/=XUNDEF)
-!
-! albedo on this tile
-!
- ZALBNIR(:) = (1.-TGD%CUR%XPSN(:))*PALBNIR_ECO(:) &
- + TGD%CUR%XPSN(:) *TPSNOW%ALB (:,1)
-
- ZALBVIS(:) = (1.-TGD%CUR%XPSN(:))*PALBVIS_ECO(:) &
- + TGD%CUR%XPSN(:) *TPSNOW%ALB (:,1)
-
- ZALBUV(:) = (1.-TGD%CUR%XPSN(:))*PALBUV_ECO (:) &
- + TGD%CUR%XPSN(:) *TPSNOW%ALB (:,1)
- END WHERE
-!
-!* albedo for each wavelength
-!
- CALL ALBEDO_FROM_NIR_VIS(PSW_BANDS,ZALBNIR, ZALBVIS, ZALBUV, &
- PDIR_ALB(:,:), PSCA_ALB(:,:) )
-!
-! emissivity
-!
- WHERE (PEMIS_ECO(:)/=XUNDEF)
- PEMIS(:) = (1.-TGD%CUR%XPSN(:))*PEMIS_ECO (:) &
- + TGD%CUR%XPSN(:) *XEMISSN
- END WHERE
-!
-!* radiative surface temperature
-!
- IF (TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA') THEN
- PTSRAD(:) = PTG1(:)
- ELSE IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
- WHERE (PEMIS_ECO(:)/=XUNDEF)
- PTSRAD(:) =( ( (1.-TGD%CUR%XPSN(:))*PEMIS (:) *PTG1 (:)**4 &
- + TGD%CUR%XPSN(:) *TPSNOW%EMIS(:,1)*TPSNOW%TS(:,1)**4 ) )**0.25 &
- / PEMIS(:)**0.25
- END WHERE
- END IF
-!
-IF (LHOOK) CALL DR_HOOK('AVG_ALBEDO_EMIS_GARDEN',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE AVG_ALBEDO_EMIS_GARDEN
diff --git a/src/SURFEX/avg_albedo_emis_greenroof.F90 b/src/SURFEX/avg_albedo_emis_greenroof.F90
deleted file mode 100644
index fd64df69ed23b8933afda9898aa4d6417a2df6e9..0000000000000000000000000000000000000000
--- a/src/SURFEX/avg_albedo_emis_greenroof.F90
+++ /dev/null
@@ -1,197 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE AVG_ALBEDO_EMIS_GREENROOF (TGR, &
- HALBEDO, &
- PVEG,PZ0,PLAI,PTG1, &
- PSW_BANDS, &
- PALBNIR_VEG,PALBVIS_VEG, &
- PALBUV_VEG, &
- PALBNIR_SOIL,PALBVIS_SOIL, &
- PALBUV_SOIL, &
- PEMIS_ECO, &
- TPSNOW, &
- PALBNIR_ECO,PALBVIS_ECO, &
- PALBUV_ECO, &
- PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD )
-! ###################################################
-!
-!!**** ** computes radiative fields used in GREENROOF
-!!
-!! PURPOSE
-!! -------
-!!
-!! METHOD
-!! ------
-!! Based on avg_albedo_emis_garden
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! V. Masson Meteo-France
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 01/2004
-!! A. Bogatchev 09/2005 EBA snow option
-!! B. Decharme 2008 The fraction of vegetation covered by snow must be
-!! <= to XPSNG
-! C. de Munck & A. Lemonsu 09/2011 Greenroofs
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
-!
-!
-USE MODD_TEB_GREENROOF_n, ONLY : TEB_GREENROOF_t
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE MODD_TYPE_SNOW
-!
-USE MODD_SNOW_PAR, ONLY : XEMISSN
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-!
-USE MODI_ALBEDO
-USE MODI_ALBEDO_FROM_NIR_VIS
-USE MODI_ISBA_SNOW_FRAC
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-!
-!
-TYPE(TEB_GREENROOF_t), INTENT(INOUT) :: TGR
-!
- CHARACTER(LEN=4), INTENT(IN) :: HALBEDO ! albedo type
-! Albedo dependance with surface soil water content
-! "EVOL" = albedo evolves with soil wetness
-! "DRY " = constant albedo value for dry soil
-! "WET " = constant albedo value for wet soil
-! "MEAN" = constant albedo value for medium soil wetness
-!
-REAL, DIMENSION(:), INTENT(IN) :: PVEG ! vegetation fraction
-REAL, DIMENSION(:), INTENT(IN) :: PZ0 ! roughness length
-REAL, DIMENSION(:), INTENT(IN) :: PLAI ! leaf area index
-REAL, DIMENSION(:), INTENT(IN) :: PTG1 ! soil surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PSW_BANDS ! middle wavelength of each band
-
-REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_VEG ! near-infra-red albedo of vegetation
-REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_VEG ! visible albedo of vegetation
-REAL, DIMENSION(:), INTENT(IN) :: PALBUV_VEG ! UV albedo of vegetation
-REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_SOIL! near-infra-red albedo of soil
-REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_SOIL! visible albedo of soil
-REAL, DIMENSION(:), INTENT(IN) :: PALBUV_SOIL ! UV albedo of soil
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_ECO ! emissivity (soil+vegetation)
-TYPE(SURF_SNOW), INTENT(IN) :: TPSNOW ! prognostic snow cover
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PALBNIR_ECO ! near-infra-red albedo (soil+vegetation)
-REAL, DIMENSION(:), INTENT(OUT) :: PALBVIS_ECO ! visible albedo (soil+vegetation)
-REAL, DIMENSION(:), INTENT(OUT) :: PALBUV_ECO ! UV albedo (soil+vegetation)
-!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PDIR_ALB ! averaged direct albedo (per wavelength)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSCA_ALB ! averaged diffuse albedo (per wavelength)
-REAL, DIMENSION(:), INTENT(OUT) :: PEMIS ! averaged emissivity
-REAL, DIMENSION(:), INTENT(OUT) :: PTSRAD ! averaged radiaitve temp.
-!
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-!
-REAL, DIMENSION(SIZE(PALBNIR_VEG)) :: ZALBNIR ! near-infra-red albedo with snow
-REAL, DIMENSION(SIZE(PALBVIS_VEG)) :: ZALBVIS ! visible albedo with snow
-REAL, DIMENSION(SIZE(PALBUV_VEG )) :: ZALBUV ! UV albedo with snow
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. averaged albedo on natural continental surfaces (except prognostic snow)
-! -----------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('AVG_ALBEDO_EMIS_GREENROOF',0,ZHOOK_HANDLE)
- CALL ALBEDO(HALBEDO, &
- PALBVIS_VEG,PALBNIR_VEG,PALBUV_VEG,PVEG, &
- PALBVIS_SOIL,PALBNIR_SOIL,PALBUV_SOIL, &
- PALBVIS_ECO,PALBNIR_ECO,PALBUV_ECO )
-
-!
-!* 2. averaged albedo and emis. on natural continental surfaces (with prognostic snow)
-! ---------------------------------------------------------
-!
-ZALBNIR(:) = 0.
-ZALBVIS(:) = 0.
-ZALBUV (:) = 0.
-!
-PDIR_ALB(:,:) = 0.
-PSCA_ALB(:,:) = 0.
-PEMIS (:) = 0.
-PTSRAD (:) = 0.
-!
-!
- CALL ISBA_SNOW_FRAC(TGR%CUR%TSNOW%SCHEME, &
- TGR%CUR%TSNOW%WSNOW(:,:,1), TGR%CUR%TSNOW%RHO(:,:,1), &
- TGR%CUR%TSNOW%ALB (:,1), &
- PVEG(:), PLAI(:), PZ0(:), &
- TGR%CUR%XPSN(:), TGR%CUR%XPSNV_A(:), &
- TGR%CUR%XPSNG(:), TGR%CUR%XPSNV(:) )
-!
- WHERE (PVEG(:)/=XUNDEF)
-!
-! albedo on this tile
-!
- ZALBNIR(:) = (1.-TGR%CUR%XPSN(:))*PALBNIR_ECO(:) + TGR%CUR%XPSN(:) *TPSNOW%ALB(:,1)
-
- ZALBVIS(:) = (1.-TGR%CUR%XPSN(:))*PALBVIS_ECO(:) + TGR%CUR%XPSN(:) *TPSNOW%ALB(:,1)
-
- ZALBUV(:) = (1.-TGR%CUR%XPSN(:))*PALBUV_ECO (:) + TGR%CUR%XPSN(:) *TPSNOW%ALB(:,1)
- END WHERE
-!
-!* albedo for each wavelength
-!
- CALL ALBEDO_FROM_NIR_VIS(PSW_BANDS,ZALBNIR, ZALBVIS, ZALBUV, &
- PDIR_ALB(:,:), PSCA_ALB(:,:) )
-!
-! emissivity
-!
- WHERE (PEMIS_ECO(:)/=XUNDEF)
- PEMIS(:) = (1.-TGR%CUR%XPSN(:))*PEMIS_ECO(:) + TGR%CUR%XPSN(:) * XEMISSN
- END WHERE
-!
-!* radiative surface temperature
-!
- IF (TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA') THEN
- PTSRAD(:) = PTG1(:)
- ELSE IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
- WHERE (PEMIS_ECO(:)/=XUNDEF)
- PTSRAD(:) = ( ( (1.-TGR%CUR%XPSN(:))*PEMIS(:)*PTG1(:)**4 &
- + TGR%CUR%XPSN(:) *TPSNOW%EMIS(:,1)*TPSNOW%TS(:,1)**4 ) )**0.25 &
- / PEMIS(:)**0.25
- END WHERE
- END IF
-!
-IF (LHOOK) CALL DR_HOOK('AVG_ALBEDO_EMIS_GREENROOF',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE AVG_ALBEDO_EMIS_GREENROOF
diff --git a/src/SURFEX/avg_albedo_emis_teb_veg.F90 b/src/SURFEX/avg_albedo_emis_teb_veg.F90
new file mode 100644
index 0000000000000000000000000000000000000000..23349dbd90d5681b8d288f35f6c6e449527f3c7c
--- /dev/null
+++ b/src/SURFEX/avg_albedo_emis_teb_veg.F90
@@ -0,0 +1,159 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE AVG_ALBEDO_EMIS_TEB_VEG (PEK, HALBEDO, PTG1, PSW_BANDS, PDIR_ALB,PSCA_ALB, PEMIS, PTSRAD )
+! ###################################################
+!
+!!**** ** computes radiative fields used in TEB_VEG
+!!
+!! PURPOSE
+!! -------
+!!
+!! METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! V. Masson Meteo-France
+!!
+!! MODIFICATION
+!! ------------
+!!
+!! Original 01/2004
+!! A. Bogatchev 09/2005 EBA snow option
+!! B. Decharme 2008 The fraction of vegetation covered by snow must be
+! <= to XPSNG
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATION
+! -----------
+!
+!
+USE MODD_ISBA_n, ONLY : ISBA_PE_t
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE MODD_TYPE_SNOW
+!
+USE MODD_SNOW_PAR, ONLY : XEMISSN
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+!
+USE MODI_ALBEDO
+USE MODI_ALBEDO_FROM_NIR_VIS
+USE MODI_ISBA_SNOW_FRAC
+!
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+!
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
+ CHARACTER(LEN=4), INTENT(IN) :: HALBEDO ! albedo type
+! Albedo dependance with surface soil water content
+! "EVOL" = albedo evolves with soil wetness
+! "DRY " = constant albedo value for dry soil
+! "WET " = constant albedo value for wet soil
+! "MEAN" = constant albedo value for medium soil wetness
+!
+REAL, DIMENSION(:), INTENT(IN) :: PTG1 ! soil surface temperature
+REAL, DIMENSION(:), INTENT(IN) :: PSW_BANDS ! middle wavelength of each band
+!
+REAL, DIMENSION(:,:), INTENT(OUT) :: PDIR_ALB ! averaged direct albedo (per wavelength)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSCA_ALB ! averaged diffuse albedo (per wavelength)
+REAL, DIMENSION(:), INTENT(OUT) :: PEMIS ! averaged emissivity
+REAL, DIMENSION(:), INTENT(OUT) :: PTSRAD ! averaged radiaitve temp.
+!
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+!
+REAL, DIMENSION(SIZE(PEK%XALBNIR_VEG(:))) :: ZALBNIR ! near-infra-red albedo with snow
+REAL, DIMENSION(SIZE(PEK%XALBVIS_VEG(:))) :: ZALBVIS ! visible albedo with snow
+REAL, DIMENSION(SIZE(PEK%XALBUV_VEG(:) )) :: ZALBUV ! UV albedo with snow
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. averaged albedo on natural continental surfaces (except prognostic snow)
+! -----------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('AVG_ALBEDO_EMIS_TEB_VEG',0,ZHOOK_HANDLE)
+!
+ CALL ALBEDO(HALBEDO, PEK )
+
+!
+!* 2. averaged albedo and emis. on natural continental surfaces (with prognostic snow)
+! ---------------------------------------------------------
+!
+ZALBNIR(:)=0.
+ZALBVIS(:)=0.
+ZALBUV (:)=0.
+!
+PDIR_ALB(:,:)=0.
+PSCA_ALB(:,:)=0.
+PEMIS (:) =0.
+PTSRAD (:) =0.
+!
+!
+ CALL ISBA_SNOW_FRAC(PEK%TSNOW%SCHEME, PEK%TSNOW%WSNOW, PEK%TSNOW%RHO, PEK%TSNOW%ALB, &
+ PEK%XVEG, PEK%XLAI, PEK%XZ0,PEK%XPSN, PEK%XPSNV_A, PEK%XPSNG, PEK%XPSNV )
+!
+WHERE (PEK%XVEG/=XUNDEF)
+ !
+ ! albedo on this tile
+ !
+ ZALBNIR(:) = (1.-PEK%XPSN)*PEK%XALBNIR + PEK%XPSN * PEK%TSNOW%ALB
+
+ ZALBVIS(:) = (1.-PEK%XPSN)*PEK%XALBVIS + PEK%XPSN * PEK%TSNOW%ALB
+
+ ZALBUV(:) = (1.-PEK%XPSN)*PEK%XALBUV + PEK%XPSN * PEK%TSNOW%ALB
+END WHERE
+!
+!* albedo for each wavelength
+!
+ CALL ALBEDO_FROM_NIR_VIS(PSW_BANDS,ZALBNIR, ZALBVIS, ZALBUV, PDIR_ALB, PSCA_ALB)
+!
+! emissivity
+!
+WHERE (PEK%XEMIS/=XUNDEF)
+ PEMIS(:) = (1.-PEK%XPSN)*PEK%XEMIS + PEK%XPSN *XEMISSN
+END WHERE
+!
+!* radiative surface temperature
+!
+IF (PEK%TSNOW%SCHEME=='D95' .OR. PEK%TSNOW%SCHEME=='EBA') THEN
+ PTSRAD(:) = PTG1(:)
+ELSE IF (PEK%TSNOW%SCHEME=='3-L' .OR. PEK%TSNOW%SCHEME=='CRO') THEN
+ WHERE (PEK%XEMIS/=XUNDEF)
+ PTSRAD(:) =( ( (1.-PEK%XPSN)*PEMIS(:) *PTG1(:) **4 &
+ + PEK%XPSN *PEK%TSNOW%EMIS * PEK%TSNOW%TS**4 ) )**0.25 &
+ / PEMIS(:)**0.25
+ END WHERE
+END IF
+!
+IF (LHOOK) CALL DR_HOOK('AVG_ALBEDO_EMIS_TEB_VEG',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE AVG_ALBEDO_EMIS_TEB_VEG
diff --git a/src/SURFEX/avg_urban_fluxes.F90 b/src/SURFEX/avg_urban_fluxes.F90
index d2dcd9060e417801ff5d5dae62a434b3cf136e44..c940d5bf494738a2555dbc7ed5f200656cbb319c 100644
--- a/src/SURFEX/avg_urban_fluxes.F90
+++ b/src/SURFEX/avg_urban_fluxes.F90
@@ -3,50 +3,22 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE AVG_URBAN_FLUXES( &
- PTS_TOWN, PEMIS_TOWN, &
- PT_CANYON, PQ_CANYON, &
- PT_LOWCAN, PQ_LOWCAN, &
- PTS_ROOF,PTS_ROAD,PTS_WALL_A,PTS_WALL_B,PTS_GARDEN, &
- PTA, PQA, PRHOA, PPS, &
- PH_TRAFFIC, PLE_TRAFFIC, PH_INDUSTRY, PLE_INDUSTRY, &
- PBLD, PROAD, PGARDEN, PWALL_O_HOR, PWALL_O_GRND, &
- PFRAC_GR, &
- PEMIS_ROOF, PESNOW_ROOF, PEMIS_GREENROOF, &
- PLW_RAD, &
- PABS_LW_ROOF, PABS_LW_WALL_A, PABS_LW_WALL_B, &
- PABS_LW_ROAD, PABS_LW_GARDEN, PABS_LW_GREENROOF, &
- PABS_LW_SNOW_ROOF, PABS_LW_SNOW_ROAD, &
- PAC_ROOF, PAC_ROOF_WAT, &
- PAC_WALL, PAC_ROAD, PAC_ROAD_WAT, PAC_TOP, &
- PAC_GARDEN, &
- PQSAT_GARDEN, PAC_AGG_GARDEN, PHU_AGG_GARDEN, &
- PQSAT_ROOF, PQSAT_ROAD, &
- PDELT_ROOF, PDELT_ROAD, &
- PROOF_FRAC, PWALL_FRAC, PROAD_FRAC, PGARDEN_FRAC, &
- PTOTS_O_HORS, &
- PDF_ROOF, PDN_ROOF, PDF_ROAD, PDN_ROAD, &
- PRN_ROOF, PH_ROOF, PLE_ROOF, PGFLUX_ROOF, &
- PRN_ROAD, PH_ROAD, PLE_ROAD, PGFLUX_ROAD, &
- PRN_GARDEN, PH_GARDEN, PLE_GARDEN, PGFLUX_GARDEN, &
- PRN_WALL_A, PH_WALL_A, PLE_WALL_A, PGFLUX_WALL_A, &
- PRN_WALL_B, PH_WALL_B, PLE_WALL_B, PGFLUX_WALL_B, &
- PLEW_ROOF, PLESNOW_ROOF, &
- PLEW_ROAD, PLESNOW_ROAD, PHSNOW_ROAD, &
- PEVAP_GARDEN, PEVAP_GREENROOF, &
- PRN_GRND, PH_GRND, PLE_GRND, PGFLUX_GRND, &
- PRN_TOWN, PH_TOWN, PLE_TOWN, PGFLUX_TOWN, PEVAP_TOWN, &
- PRUNOFF_GARDEN,PRUNOFF_ROAD,PRUNOFF_STRLROOF, &
- PRUNOFF_GREENROOF, PDRAIN_GREENROOF, PRUNOFF_TOWN, &
- PABS_LW_PANEL, PEMIS_PANEL, PFRAC_PANEL, PRN_PANEL, &
- PH_PANEL, &
- PH_WASTE, PLE_WASTE, PF_WASTE_CAN, &
- PABS_LW_WIN, PT_WIN1, PGR, PEMIT_LW_ROAD, &
- PEMIT_LW_GARDEN, PEMIT_LW_GRND, HBEM, &
- PSVF_ROAD, PSVF_GARDEN, PSVF_WALL, PGARDEN_O_GRND, &
- PROAD_O_GRND, &
- PEMIS_ROAD, PESNOW_ROAD, PEMIS_WALL, PEMIS_GARDEN, &
- OCANOPY )
+ SUBROUTINE AVG_URBAN_FLUXES(TOP, T, B, TPN, DMT, &
+ PTS_TWN, PEMIS_TWN, PT_CAN, &
+ PQ_CAN, PT_LOWCAN, PQ_LOWCAN, PTA, PQA, PRHOA, PPS,&
+ PH_TRAFFIC, PLE_TRAFFIC, PWL_O_GRND, PESN_RF, &
+ PEMIS_GR, PLW_RAD, PAC_RF, PAC_RF_WAT, PAC_WL, &
+ PAC_RD, PAC_RD_WAT, PAC_TOP, PAC_GD, PQSAT_GD, &
+ PAC_AGG_GD, PHU_AGG_GD, PQSAT_RF, PQSAT_RD, &
+ PDELT_RF, PDELT_RD, PRF_FRAC, PWL_FRAC, PRD_FRAC, &
+ PGD_FRAC, PTOTS_O_HORS, PDF_RF, PDN_RF, PDF_RD, &
+ PDN_RD, PLE_WL_A, PLE_WL_B, PLEW_RF, PLESN_RF, &
+ PLEW_RD, PLESN_RD, PHSN_RD, &
+ PTSRAD_GD, PRN_GD, PH_GD, PLE_GD, PGFLUX_GD, PEVAP_GD,&
+ PRUNOFF_GD, PEVAP_GR, PRUNOFF_GR, PDRAIN_GR, &
+ PRN_GRND, PH_GRND, PLE_GRND, PGFLX_GRND, &
+ PRN_TWN, PH_TWN, PLE_TWN, PGFLX_TWN, PEVAP_TWN, &
+ PEMIT_LW_RD, PEMIT_LW_GD, PEMIT_LW_GRND, PEMIS_GD )
! ##########################################################################
!
!!**** *AVG_URBAN_FLUXES* computes fluxes on urbanized surfaces
@@ -96,6 +68,12 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
+USE MODD_TEB_n, ONLY : TEB_t
+USE MODD_BEM_n, ONLY : BEM_t
+USE MODD_TEB_PANEL_n, ONLY : TEB_PANEL_t
+USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_t
+!
USE MODD_CSTS,ONLY : XCPD, XLVTT, XLSTT, XSTEFAN
!
USE MODE_THERMOS
@@ -108,19 +86,19 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+TYPE(TEB_t), INTENT(INOUT) :: T
+TYPE(BEM_t), INTENT(INOUT) :: B
+TYPE(TEB_PANEL_t), INTENT(INOUT) :: TPN
+TYPE(DIAG_MISC_TEB_t), INTENT(INOUT) :: DMT
!
-REAL, DIMENSION(:), INTENT(OUT) :: PTS_TOWN ! town surface temperature
-REAL, DIMENSION(:), INTENT(OUT) :: PEMIS_TOWN ! town equivalent emissivity
-REAL, DIMENSION(:), INTENT(INOUT) :: PT_CANYON ! canyon air temperature
-REAL, DIMENSION(:), INTENT(INOUT) :: PQ_CANYON ! canyon air specific humidity
+REAL, DIMENSION(:), INTENT(OUT) :: PTS_TWN ! town surface temperature
+REAL, DIMENSION(:), INTENT(OUT) :: PEMIS_TWN ! town equivalent emissivity
+REAL, DIMENSION(:), INTENT(INOUT) :: PT_CAN ! canyon air temperature
+REAL, DIMENSION(:), INTENT(INOUT) :: PQ_CAN ! canyon air specific humidity
REAL, DIMENSION(:), INTENT(IN) :: PT_LOWCAN ! low canyon air temperature
REAL, DIMENSION(:), INTENT(IN) :: PQ_LOWCAN ! low canyon air specific humidity
-REAL, DIMENSION(:), INTENT(IN) :: PTS_ROOF ! roof surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS_ROAD ! road surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS_WALL_A ! wall surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS_WALL_B ! wall surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS_GARDEN ! green area surface temperature
-
+!
REAL, DIMENSION(:), INTENT(IN) :: PTA ! temperature at roof level
REAL, DIMENSION(:), INTENT(IN) :: PQA ! specific humidity
! at roof level
@@ -131,227 +109,169 @@ REAL, DIMENSION(:), INTENT(IN) :: PH_TRAFFIC ! anthropogenic sensible
! ! heat fluxes due to traffic
REAL, DIMENSION(:), INTENT(IN) :: PLE_TRAFFIC ! anthropogenic latent
! ! heat fluxes due to traffic
-REAL, DIMENSION(:), INTENT(IN) :: PH_INDUSTRY ! anthropogenic sensible
-! ! heat fluxes due to factories
-REAL, DIMENSION(:), INTENT(IN) :: PLE_INDUSTRY ! anthropogenic latent
-! ! heat fluxes due to factories
-REAL, DIMENSION(:), INTENT(IN) :: PBLD ! fraction of buildings
-REAL, DIMENSION(:), INTENT(IN) :: PROAD ! fraction of roads
-REAL, DIMENSION(:), INTENT(IN) :: PGARDEN ! fraction of green areas
-REAL, DIMENSION(:), INTENT(IN) :: PWALL_O_HOR ! wall Surf. / (bld+road+green) Surf.
-REAL, DIMENSION(:), INTENT(IN) :: PWALL_O_GRND ! wall Surf. / ground (road+green) Surf.
-REAL, DIMENSION(:), INTENT(IN) :: PFRAC_GR ! fraction of green roofs
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_ROOF ! roof emissivity
-!
-REAL, DIMENSION(:), INTENT(IN) :: PESNOW_ROOF ! snow roof emissivity
-!
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_GREENROOF ! green roof emissivity
+REAL, DIMENSION(:), INTENT(IN) :: PWL_O_GRND ! wall Surf. / ground (road+green) Surf.
+!
+REAL, DIMENSION(:), INTENT(IN) :: PESN_RF ! snow roof emissivity
!
-REAL, DIMENSION(:), INTENT(IN) :: PLW_RAD ! incoming longwave rad.
+REAL, DIMENSION(:), INTENT(IN) :: PEMIS_GR ! green roof emissivity
!
-REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_ROOF ! absorbed LW rad. by roof
-REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_WALL_A ! absorbed LW rad. by wall
-REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_WALL_B ! absorbed LW rad. by wall
-REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_ROAD ! absorbed LW rad. by road
-REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_GARDEN ! absorbed LW rad. by green areas
-REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_GREENROOF ! absorbed LW rad. by green roofs
-REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_SNOW_ROOF ! abs. LW rad. by snow
-REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_SNOW_ROAD ! abs. LW rad. by snow
+REAL, DIMENSION(:), INTENT(IN) :: PLW_RAD ! incoming longwave rad.
!
-REAL, DIMENSION(:), INTENT(IN) :: PAC_ROOF ! surface conductance
+REAL, DIMENSION(:), INTENT(IN) :: PAC_RF ! surface conductance
! ! for heat transfers
! ! above roofs
-REAL, DIMENSION(:), INTENT(IN) :: PAC_ROOF_WAT ! surface conductance
+REAL, DIMENSION(:), INTENT(IN) :: PAC_RF_WAT ! surface conductance
! ! for heat transfers
! ! above roofs (for water)
-REAL, DIMENSION(:), INTENT(IN) :: PAC_WALL ! surface conductance
+REAL, DIMENSION(:), INTENT(IN) :: PAC_WL ! surface conductance
! ! for heat transfer
! ! between wall and canyon
-REAL, DIMENSION(:), INTENT(IN) :: PAC_ROAD ! surface conductance
+REAL, DIMENSION(:), INTENT(IN) :: PAC_RD ! surface conductance
! ! for heat transfers
! ! between road and canyon
-REAL, DIMENSION(:), INTENT(IN) :: PAC_ROAD_WAT ! surface conductance
+REAL, DIMENSION(:), INTENT(IN) :: PAC_RD_WAT ! surface conductance
! ! for heat transfers
! ! inside canyon (for water)
REAL, DIMENSION(:), INTENT(IN) :: PAC_TOP ! aerodynamical conductance
! ! between atmosphere and
! ! canyon top
-REAL, DIMENSION(:), INTENT(IN) :: PAC_GARDEN ! aerodynamical conductance
+REAL, DIMENSION(:), INTENT(IN) :: PAC_GD ! aerodynamical conductance
! ! between atmosphere and
! ! green areas
-REAL, DIMENSION(:), INTENT(IN) :: PQSAT_GARDEN ! q_sat(Ts)
-REAL, DIMENSION(:), INTENT(IN) :: PAC_AGG_GARDEN ! aggregated aerodyn resistance for green areas
-REAL, DIMENSION(:), INTENT(IN) :: PHU_AGG_GARDEN ! aggregated relative humidity for green areas
-!
-REAL, DIMENSION(:), INTENT(IN) :: PQSAT_ROOF ! q_sat(Ts)
-REAL, DIMENSION(:), INTENT(IN) :: PQSAT_ROAD ! q_sat(Ts)
-REAL, DIMENSION(:), INTENT(IN) :: PDELT_ROOF ! water fraction on snow-free
-REAL, DIMENSION(:), INTENT(IN) :: PDELT_ROAD ! roof and roads
-REAL, DIMENSION(:), INTENT(IN) :: PROOF_FRAC ! roof, wall,
-REAL, DIMENSION(:), INTENT(IN) :: PWALL_FRAC ! road, and green area
-REAL, DIMENSION(:), INTENT(IN) :: PROAD_FRAC ! fractions
-REAL, DIMENSION(:), INTENT(IN) :: PGARDEN_FRAC ! of exchange surf.
-REAL, DIMENSION(:), INTENT(IN) :: PTOTS_O_HORS ! total canyon+roof surface
-! ! over horizontal surface
-REAL, DIMENSION(:), INTENT(IN) :: PDF_ROOF ! snow-free roof fraction
-REAL, DIMENSION(:), INTENT(IN) :: PDN_ROOF ! snow-covered roof fraction
-REAL, DIMENSION(:), INTENT(IN) :: PDF_ROAD ! snow-free road fraction
-REAL, DIMENSION(:), INTENT(IN) :: PDN_ROAD ! snow-covered road fraction
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRN_ROOF ! net radiation over roof
-REAL, DIMENSION(:), INTENT(IN) :: PH_ROOF ! sensible heat flux over roof
-REAL, DIMENSION(:), INTENT(IN) :: PLE_ROOF ! latent heat flux over roof
-REAL, DIMENSION(:), INTENT(IN) :: PGFLUX_ROOF ! flux through the roof
-REAL, DIMENSION(:), INTENT(IN) :: PRN_ROAD ! net radiation over road
-REAL, DIMENSION(:), INTENT(IN) :: PH_ROAD ! sensible heat flux over road
-REAL, DIMENSION(:), INTENT(IN) :: PLE_ROAD ! latent heat flux over road
-REAL, DIMENSION(:), INTENT(IN) :: PGFLUX_ROAD ! flux through the road
-REAL, DIMENSION(:), INTENT(IN) :: PRN_GARDEN ! net radiation over green areas
-REAL, DIMENSION(:), INTENT(IN) :: PH_GARDEN ! sensible heat flux over green areas
-REAL, DIMENSION(:), INTENT(IN) :: PLE_GARDEN ! latent heat flux over green areas
-REAL, DIMENSION(:), INTENT(IN) :: PGFLUX_GARDEN ! flux through the green areas
-REAL, DIMENSION(:), INTENT(IN) :: PRN_WALL_A ! net radiation over wall
-REAL, DIMENSION(:), INTENT(IN) :: PH_WALL_A ! sensible heat flux over wall
-REAL, DIMENSION(:), INTENT(IN) :: PLE_WALL_A ! latent heat flux over wall
-REAL, DIMENSION(:), INTENT(IN) :: PGFLUX_WALL_A ! flux through the wall
-REAL, DIMENSION(:), INTENT(IN) :: PRN_WALL_B ! net radiation over wall
-REAL, DIMENSION(:), INTENT(IN) :: PH_WALL_B ! sensible heat flux over wall
-REAL, DIMENSION(:), INTENT(IN) :: PLE_WALL_B ! latent heat flux over wall
-REAL, DIMENSION(:), INTENT(IN) :: PGFLUX_WALL_B ! flux through the wall
-!
-REAL, DIMENSION(:), INTENT(IN) :: PLEW_ROOF ! latent heat flux of snowfree roof
-REAL, DIMENSION(:), INTENT(IN) :: PLESNOW_ROOF ! latent heat flux over snow
-REAL, DIMENSION(:), INTENT(IN) :: PLEW_ROAD ! latent heat flux of snowfree road
-REAL, DIMENSION(:), INTENT(IN) :: PLESNOW_ROAD ! latent heat flux over snow
-REAL, DIMENSION(:), INTENT(IN) :: PHSNOW_ROAD ! sensible heat flux over snow
-REAL, DIMENSION(:), INTENT(IN) :: PEVAP_GARDEN ! evaporation over gardens
-REAL, DIMENSION(:), INTENT(IN) :: PEVAP_GREENROOF ! evaporation over green roofs
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRUNOFF_GARDEN ! surface runoff over green areas (kg/m2/s)
-REAL, DIMENSION(:), INTENT(IN) :: PRUNOFF_ROAD ! surface runoff over roads (kg/m2/s)
-REAL, DIMENSION(:), INTENT(IN) :: PRUNOFF_STRLROOF ! surface runoff over structural roofs (kg/m2/s)
-REAL, DIMENSION(:), INTENT(IN) :: PRUNOFF_GREENROOF ! surface runoff over green roofs (kg/m2/s)
-REAL, DIMENSION(:), INTENT(IN) :: PDRAIN_GREENROOF ! outlet drainage at green roof base (kg/m2/s)
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PRN_GRND ! net radiation over ground
-REAL, DIMENSION(:), INTENT(OUT) :: PH_GRND ! sensible heat flux over ground
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_GRND ! latent heat flux over ground
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX_GRND ! flux through the ground
-REAL, DIMENSION(:), INTENT(OUT) :: PRN_TOWN ! net radiation over town
-REAL, DIMENSION(:), INTENT(OUT) :: PH_TOWN ! sensible heat flux over town
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_TOWN ! latent heat flux over town
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX_TOWN ! flux through the ground for town
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAP_TOWN ! evaporation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PRUNOFF_TOWN ! aggregated runoff for town (kg/m2/s)
+REAL, DIMENSION(:), INTENT(IN) :: PQSAT_GD ! q_sat(Ts)
+REAL, DIMENSION(:), INTENT(IN) :: PAC_AGG_GD ! aggregated aerodyn resistance for green areas
+REAL, DIMENSION(:), INTENT(IN) :: PHU_AGG_GD ! aggregated relative humidity for green areas
+!
+REAL, DIMENSION(:), INTENT(IN) :: PQSAT_RF ! q_sat(Ts)
+REAL, DIMENSION(:), INTENT(IN) :: PQSAT_RD ! q_sat(Ts)
+REAL, DIMENSION(:), INTENT(IN) :: PDELT_RF ! water fraction on snow-free
+REAL, DIMENSION(:), INTENT(IN) :: PDELT_RD ! roof and roads
+REAL, DIMENSION(:), INTENT(IN) :: PRF_FRAC ! roof, wall,
+REAL, DIMENSION(:), INTENT(IN) :: PWL_FRAC ! road, and green area
+REAL, DIMENSION(:), INTENT(IN) :: PRD_FRAC ! fractions
+REAL, DIMENSION(:), INTENT(IN) :: PGD_FRAC ! of exchange surf.
+REAL, DIMENSION(:), INTENT(IN) :: PTOTS_O_HORS ! total canyon+roof surface
+! ! over horizontal surface
+REAL, DIMENSION(:), INTENT(IN) :: PDF_RF ! snow-free roof fraction
+REAL, DIMENSION(:), INTENT(IN) :: PDN_RF ! snow-covered roof fraction
+REAL, DIMENSION(:), INTENT(IN) :: PDF_RD ! snow-free road fraction
+REAL, DIMENSION(:), INTENT(IN) :: PDN_RD ! snow-covered road fraction
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLE_WL_A ! latent heat flux over wall
+REAL, DIMENSION(:), INTENT(IN) :: PLE_WL_B ! latent heat flux over wall
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLEW_RF ! latent heat flux of snowfree roof
+REAL, DIMENSION(:), INTENT(IN) :: PLESN_RF ! latent heat flux over snow
+REAL, DIMENSION(:), INTENT(IN) :: PLEW_RD ! latent heat flux of snowfree road
+REAL, DIMENSION(:), INTENT(IN) :: PLESN_RD ! latent heat flux over snow
+REAL, DIMENSION(:), INTENT(IN) :: PHSN_RD ! sensible heat flux over snow
-REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_PANEL ! absorbed LW radiation by solar panels
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_PANEL ! emissivity of solar panels
-REAL, DIMENSION(:), INTENT(IN) :: PFRAC_PANEL ! fraction of solar panels on roofs
-REAL, DIMENSION(:), INTENT(IN) :: PRN_PANEL ! net radiation of solar panels
-REAL, DIMENSION(:), INTENT(IN) :: PH_PANEL ! sensible heat flux of solar panels
-!
-REAL, DIMENSION(:), INTENT(IN) :: PH_WASTE ! sensible waste heat released by HVAC systems
-REAL, DIMENSION(:), INTENT(IN) :: PLE_WASTE ! latent waste heat released by HVAC systems
-REAL, DIMENSION(:), INTENT(IN) :: PF_WASTE_CAN ! fraction of waste heat released into the canyon
-REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_WIN ! absorbed LW radiation by windows
-REAL, DIMENSION(:), INTENT(IN) :: PT_WIN1 ! window outdoor temperature
-REAL, DIMENSION(:), INTENT(IN) :: PGR ! glazing ratio
-!
-REAL, DIMENSION(:), INTENT(IN) :: PEMIT_LW_ROAD ! LW emitted by the road (W/m2 road)
-REAL, DIMENSION(:), INTENT(IN) :: PEMIT_LW_GARDEN ! LW emitted by the garden (W/m2 garden)
+REAL, DIMENSION(:), INTENT(IN) :: PTSRAD_GD ! green area surface temperature
+REAL, DIMENSION(:), INTENT(IN) :: PRN_GD ! net radiation over green areas
+REAL, DIMENSION(:), INTENT(IN) :: PH_GD ! sensible heat flux over green areas
+REAL, DIMENSION(:), INTENT(IN) :: PLE_GD ! latent heat flux over green areas
+REAL, DIMENSION(:), INTENT(IN) :: PGFLUX_GD ! flux through the green areas
+REAL, DIMENSION(:), INTENT(IN) :: PEVAP_GD ! evaporation over gardens
+REAL, DIMENSION(:), INTENT(IN) :: PRUNOFF_GD ! surface runoff over green areas (kg/m2/s)
+REAL, DIMENSION(:), INTENT(IN) :: PEVAP_GR ! evaporation over green roofs
+REAL, DIMENSION(:), INTENT(IN) :: PRUNOFF_GR ! surface runoff over green roofs (kg/m2/s)
+REAL, DIMENSION(:), INTENT(IN) :: PDRAIN_GR ! outlet drainage at green roof base (kg/m2/s)
+!
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PRN_GRND ! net radiation over ground
+REAL, DIMENSION(:), INTENT(OUT) :: PH_GRND ! sensible heat flux over ground
+REAL, DIMENSION(:), INTENT(OUT) :: PLE_GRND ! latent heat flux over ground
+REAL, DIMENSION(:), INTENT(OUT) :: PGFLX_GRND ! flux through the ground
+REAL, DIMENSION(:), INTENT(OUT) :: PRN_TWN ! net radiation over town
+REAL, DIMENSION(:), INTENT(OUT) :: PH_TWN ! sensible heat flux over town
+REAL, DIMENSION(:), INTENT(OUT) :: PLE_TWN ! latent heat flux over town
+REAL, DIMENSION(:), INTENT(OUT) :: PGFLX_TWN ! flux through the ground for town
+REAL, DIMENSION(:), INTENT(OUT) :: PEVAP_TWN ! evaporation (kg/m2/s)
+!
+REAL, DIMENSION(:), INTENT(IN) :: PEMIT_LW_RD ! LW emitted by the road (W/m2 road)
+REAL, DIMENSION(:), INTENT(IN) :: PEMIT_LW_GD ! LW emitted by the garden (W/m2 garden)
REAL, DIMENSION(:), INTENT(OUT) :: PEMIT_LW_GRND ! LW emitted by the ground (road+garden) (W/m2 ground)
- CHARACTER(LEN=3), INTENT(IN) :: HBEM ! Building Energy model 'DEF' or 'BEM'
-REAL, DIMENSION(:), INTENT(IN) :: PGARDEN_O_GRND! garden surf. / (road+garden surf.)
-REAL, DIMENSION(:), INTENT(IN) :: PROAD_O_GRND ! road surf. / (road+garden surf.)
-
-REAL, DIMENSION(:), INTENT(IN) :: PSVF_ROAD ! road sky view factor
-REAL, DIMENSION(:), INTENT(IN) :: PSVF_GARDEN ! garden sky view factor
-REAL, DIMENSION(:), INTENT(IN) :: PSVF_WALL ! wall sky view factor
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_ROAD ! snow free road emissivity
-REAL, DIMENSION(:), INTENT(IN) :: PESNOW_ROAD ! snow (road) emissivity
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_WALL ! wall emissivity
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_GARDEN ! garden emissivity
-LOGICAL, INTENT(IN) :: OCANOPY ! is canopy active ?
+!
+REAL, DIMENSION(:), INTENT(IN) :: PEMIS_GD ! garden emissivity
!
!* 0.2 declarations of local variables
!
REAL, DIMENSION(SIZE(PLW_RAD)) :: ZLW_UP ! upwards radiations
-REAL, DIMENSION(SIZE(PROAD)) :: ZQSAT_CANYON
-REAL, DIMENSION(SIZE(PROAD)) :: ZROAD, ZGARDEN
+REAL, DIMENSION(SIZE(T%XROAD)) :: ZQSAT_CAN
+REAL, DIMENSION(SIZE(T%XROAD)) :: ZRD, ZGD
!
+REAL :: ZINTER
INTEGER :: JJ
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('AVG_URBAN_FLUXES',0,ZHOOK_HANDLE)
!
-ZROAD(:)=0.
-ZGARDEN(:)=0.
+ZRD(:)=0.
+ZGD(:)=0.
!
-DO JJ=1,SIZE(PROAD)
+DO JJ=1,SIZE(T%XROAD)
!
- IF (PROAD(JJ)+PGARDEN(JJ).NE.0.) THEN
- ZROAD(JJ) = PROAD(JJ) / (PROAD(JJ)+PGARDEN(JJ))
- ZGARDEN(JJ) = PGARDEN(JJ) / (PROAD(JJ)+PGARDEN(JJ))
+ IF (T%XROAD(JJ)+T%XGARDEN(JJ).NE.0.) THEN
+ ZRD(JJ) = T%XROAD(JJ) / (T%XROAD(JJ)+T%XGARDEN(JJ))
+ ZGD(JJ) = T%XGARDEN(JJ) / (T%XROAD(JJ)+T%XGARDEN(JJ))
ELSE
- ZROAD(JJ)=0.
- ZGARDEN(JJ)=0.
+ ZRD(JJ)=0.
+ ZGD(JJ)=0.
ENDIF
!
!* 1. Averaged fluxes for ground (green areas + road)
! -----------------------------------------------
!
- PRN_GRND(JJ) = ZROAD (JJ) * PRN_ROAD (JJ) + ZGARDEN(JJ) * PRN_GARDEN(JJ)
+ PRN_GRND(JJ) = ZRD(JJ) * DMT%XRN_ROAD (JJ) + ZGD(JJ) * PRN_GD(JJ)
!
- PH_GRND (JJ) = ZROAD (JJ) * PH_ROAD (JJ) + ZGARDEN(JJ) * PH_GARDEN (JJ) &
- + PH_TRAFFIC(JJ) / (1.-PBLD (JJ))
+ PH_GRND (JJ) = ZRD(JJ) * DMT%XH_ROAD (JJ) + ZGD(JJ) * PH_GD (JJ) + PH_TRAFFIC (JJ) / (1.-T%XBLD (JJ))
!
- PLE_GRND(JJ) = ZROAD (JJ) * PLE_ROAD (JJ) + ZGARDEN(JJ) * PLE_GARDEN(JJ) &
- + PLE_TRAFFIC(JJ) / (1.-PBLD (JJ))
+ PLE_GRND(JJ) = ZRD(JJ) * DMT%XLE_ROAD (JJ) + ZGD(JJ) * PLE_GD(JJ) + PLE_TRAFFIC(JJ) / (1.-T%XBLD (JJ))
!
- PGFLUX_GRND(JJ) = ZROAD (JJ) * PGFLUX_ROAD (JJ) + ZGARDEN(JJ) * PGFLUX_GARDEN(JJ)
+ PGFLX_GRND(JJ) = ZRD(JJ) * DMT%XGFLUX_ROAD(JJ) + ZGD(JJ) * PGFLUX_GD(JJ)
!
!
- PEMIT_LW_GRND(JJ) = PROAD_O_GRND(JJ) * PEMIT_LW_ROAD(JJ) + PGARDEN_O_GRND(JJ) * PEMIT_LW_GARDEN(JJ)
+ PEMIT_LW_GRND(JJ) = T%XROAD_O_GRND(JJ) * PEMIT_LW_RD(JJ) + T%XGARDEN_O_GRND(JJ) * PEMIT_LW_GD(JJ)
!-------------------------------------------------------------------------------
!
!* 2. Averaged fluxes JJ built + green areas
! -------------------------------------
!
- PRN_TOWN(JJ) = PTOTS_O_HORS(JJ) * ( &
- PROOF_FRAC (JJ) * PRN_PANEL (JJ) * PFRAC_PANEL(JJ)&
- + PROOF_FRAC (JJ) * PRN_ROOF (JJ) &
- + PROAD_FRAC (JJ) * PRN_ROAD (JJ) &
- + PGARDEN_FRAC(JJ) * PRN_GARDEN (JJ) &
- + PWALL_FRAC (JJ) * PRN_WALL_A (JJ) * 0.5 &
- + PWALL_FRAC (JJ) * PRN_WALL_B (JJ) * 0.5 )
-!
- PH_TOWN (JJ) = PTOTS_O_HORS(JJ) * ( &
- PROOF_FRAC (JJ) * PH_PANEL (JJ) * PFRAC_PANEL(JJ) &
- + PROOF_FRAC (JJ) * PH_ROOF (JJ) &
- + PROAD_FRAC (JJ) * PH_ROAD (JJ) &
- + PGARDEN_FRAC(JJ) * PH_GARDEN (JJ) &
- + PWALL_FRAC (JJ) * PH_WALL_A (JJ) * 0.5 &
- + PWALL_FRAC (JJ) * PH_WALL_B (JJ) * 0.5 ) &
- + PH_TRAFFIC(JJ) &
- + PH_INDUSTRY(JJ)
-!
- PLE_TOWN(JJ) = PTOTS_O_HORS(JJ) * ( &
- PROOF_FRAC (JJ) * PLE_ROOF (JJ) &
- + PROAD_FRAC (JJ) * PLE_ROAD (JJ) &
- + PGARDEN_FRAC(JJ) * PLE_GARDEN(JJ) &
- + PWALL_FRAC (JJ) * PLE_WALL_A(JJ) * 0.5 &
- + PWALL_FRAC (JJ) * PLE_WALL_B(JJ) * 0.5 ) &
- + PLE_TRAFFIC (JJ) &
- + PLE_INDUSTRY(JJ)
-!
- PGFLUX_TOWN(JJ)= PTOTS_O_HORS(JJ) * ( &
- PROOF_FRAC (JJ) * PGFLUX_ROOF (JJ) &
- + PROAD_FRAC (JJ) * PGFLUX_ROAD (JJ) &
- + PGARDEN_FRAC(JJ) * PGFLUX_GARDEN(JJ) &
- + PWALL_FRAC (JJ) * PGFLUX_WALL_A(JJ) * 0.5 &
- + PWALL_FRAC (JJ) * PGFLUX_WALL_B(JJ) * 0.5 )
-!
+ PRN_TWN(JJ) = PTOTS_O_HORS(JJ) * ( &
+ + PRF_FRAC(JJ) * DMT%XRN_ROOF (JJ) &
+ + PRD_FRAC(JJ) * DMT%XRN_ROAD (JJ) &
+ + PGD_FRAC(JJ) * PRN_GD (JJ) &
+ + PWL_FRAC(JJ) * DMT%XRN_WALL_A (JJ) * 0.5 &
+ + PWL_FRAC(JJ) * DMT%XRN_WALL_B (JJ) * 0.5 )
+!
+ PH_TWN (JJ) = PTOTS_O_HORS(JJ) * ( &
+ + PRF_FRAC(JJ) * DMT%XH_ROOF (JJ) &
+ + PRD_FRAC(JJ) * DMT%XH_ROAD (JJ) &
+ + PGD_FRAC(JJ) * PH_GD (JJ) &
+ + PWL_FRAC(JJ) * DMT%XH_WALL_A (JJ) * 0.5 &
+ + PWL_FRAC(JJ) * DMT%XH_WALL_B (JJ) * 0.5 ) &
+ + PH_TRAFFIC(JJ) + T%XH_INDUSTRY(JJ)
+!
+ PLE_TWN(JJ) = PTOTS_O_HORS(JJ) * ( &
+ PRF_FRAC(JJ) * DMT%XLE_ROOF (JJ) &
+ + PRD_FRAC(JJ) * DMT%XLE_ROAD (JJ) &
+ + PGD_FRAC(JJ) * PLE_GD (JJ) &
+ + PWL_FRAC(JJ) * PLE_WL_A(JJ) * 0.5 &
+ + PWL_FRAC(JJ) * PLE_WL_B(JJ) * 0.5 ) &
+ + PLE_TRAFFIC (JJ) + T%XLE_INDUSTRY(JJ)
+!
+ PGFLX_TWN(JJ)= PTOTS_O_HORS(JJ) * ( &
+ PRF_FRAC(JJ) * DMT%XGFLUX_ROOF (JJ) &
+ + PRD_FRAC(JJ) * DMT%XGFLUX_ROAD (JJ) &
+ + PGD_FRAC(JJ) * PGFLUX_GD (JJ) &
+ + PWL_FRAC(JJ) * DMT%XGFLUX_WALL_A(JJ) * 0.5 &
+ + PWL_FRAC(JJ) * DMT%XGFLUX_WALL_B(JJ) * 0.5 )
+!
+ IF (TOP%LSOLAR_PANEL) THEN
+ PRN_TWN(JJ) = PRN_TWN(JJ) + PTOTS_O_HORS(JJ) * (PRF_FRAC(JJ) * DMT%XRN_PANEL(JJ) * TPN%XFRAC_PANEL(JJ))
+ PH_TWN (JJ) = PH_TWN (JJ) + PTOTS_O_HORS(JJ) * (PRF_FRAC(JJ) * DMT%XH_PANEL (JJ) * TPN%XFRAC_PANEL(JJ))
+ ENDIF
!-------------------------------------------------------------------------------
!
!* 3. Infra-red Radiative properties
@@ -360,105 +280,114 @@ DO JJ=1,SIZE(PROAD)
!* 3.1 Upward IR radiation for town
! ----------------------------
!
- ZLW_UP(JJ) = PLW_RAD (JJ) &
- - ( PROOF_FRAC (JJ)*(1.-PFRAC_GR(JJ))*PDF_ROOF (JJ)*PABS_LW_ROOF (JJ) &
- +PROOF_FRAC (JJ)*(1.-PFRAC_GR(JJ))*PDN_ROOF (JJ)*PABS_LW_SNOW_ROOF (JJ) &
- +PROOF_FRAC (JJ)* PFRAC_GR(JJ) *PABS_LW_GREENROOF (JJ) &
- +PROOF_FRAC (JJ)* PFRAC_PANEL(JJ) *PABS_LW_PANEL (JJ) &
- +PROAD_FRAC (JJ) *PDF_ROAD (JJ)*PABS_LW_ROAD (JJ) &
- +PROAD_FRAC (JJ) *PDN_ROAD (JJ)*PABS_LW_SNOW_ROAD (JJ) &
- +PGARDEN_FRAC(JJ) *PABS_LW_GARDEN (JJ) &
- +PWALL_FRAC (JJ)* 0.5 *PABS_LW_WALL_A (JJ) &
- +PWALL_FRAC (JJ)* 0.5 *PABS_LW_WALL_B (JJ) &
- )*PTOTS_O_HORS(JJ)
+ ZLW_UP(JJ) = PLW_RAD (JJ) &
+ - ( PRF_FRAC(JJ) * (1.-T%XGREENROOF(JJ)) * PDF_RF(JJ) * DMT%XABS_LW_ROOF (JJ) &
+ +PRF_FRAC(JJ) * (1.-T%XGREENROOF(JJ)) * PDN_RF(JJ) * DMT%XABS_LW_SNOW_ROOF(JJ) &
+ +PRF_FRAC(JJ) * T%XGREENROOF(JJ) * DMT%XABS_LW_GREENROOF(JJ) &
+ +PRD_FRAC(JJ) * PDF_RD(JJ) * DMT%XABS_LW_ROAD (JJ) &
+ +PRD_FRAC(JJ) * PDN_RD(JJ) * DMT%XABS_LW_SNOW_ROAD(JJ) &
+ +PGD_FRAC(JJ) * DMT%XABS_LW_GARDEN (JJ) &
+ +PWL_FRAC(JJ)* 0.5 * DMT%XABS_LW_WALL_A (JJ) &
+ +PWL_FRAC(JJ)* 0.5 * DMT%XABS_LW_WALL_B (JJ) &
+ ) * PTOTS_O_HORS(JJ)
+!
+ IF (TOP%LSOLAR_PANEL) THEN
+ ZLW_UP(JJ) = ZLW_UP(JJ) - PTOTS_O_HORS(JJ) * (PRF_FRAC(JJ) * DMT%XABS_LW_PANEL(JJ) * TPN%XFRAC_PANEL(JJ))
+ ENDIF
!
!* 3.2 Town emissivity
! ---------------
!
- PEMIS_TOWN(JJ) = PBLD (JJ)*(1.-PFRAC_GR (JJ))*PDF_ROOF(JJ)*PEMIS_ROOF (JJ)* (1.-PFRAC_PANEL(JJ)) &
- + PBLD (JJ)*(1.-PFRAC_GR (JJ))*PDN_ROOF(JJ)*PESNOW_ROOF (JJ)* (1.-PFRAC_PANEL(JJ)) &
- + PBLD (JJ)* PFRAC_GR (JJ) *PEMIS_GREENROOF(JJ)* (1.-PFRAC_PANEL(JJ)) &
- + PBLD (JJ) *PEMIS_PANEL (JJ)* PFRAC_PANEL(JJ) &
- + PROAD (JJ)*( PSVF_ROAD (JJ) *PDF_ROAD(JJ)*PEMIS_ROAD (JJ) &
- + PSVF_ROAD (JJ) *PDN_ROAD(JJ)*PESNOW_ROAD (JJ)) &
- + PGARDEN (JJ)* PSVF_GARDEN(JJ) *PEMIS_GARDEN (JJ) &
- + PWALL_O_HOR(JJ)* PSVF_WALL (JJ) *PEMIS_WALL (JJ)
+ PEMIS_TWN(JJ) = T%XBLD (JJ) * (1.-T%XGREENROOF(JJ)) * PDF_RF(JJ) * T%XEMIS_ROOF(JJ) * (1.-TPN%XFRAC_PANEL(JJ)) &
+ + T%XBLD (JJ) * (1.-T%XGREENROOF(JJ)) * PDN_RF(JJ) * PESN_RF (JJ) * (1.-TPN%XFRAC_PANEL(JJ)) &
+ + T%XBLD (JJ) * T%XGREENROOF(JJ) * PEMIS_GR (JJ) * (1.-TPN%XFRAC_PANEL(JJ)) &
+ + T%XBLD (JJ) * TPN%XEMIS_PANEL(JJ) * TPN%XFRAC_PANEL(JJ) &
+ + T%XROAD (JJ) * ( T%XSVF_ROAD(JJ) * PDF_RD(JJ) * T%XEMIS_ROAD(JJ) &
+ + T%XSVF_ROAD(JJ) * PDN_RD(JJ) * T%TSNOW_ROAD%EMIS(JJ)) &
+ + T%XGARDEN (JJ) * T%XSVF_GARDEN(JJ) * PEMIS_GD (JJ) &
+ + T%XWALL_O_HOR(JJ) * T%XSVF_WALL (JJ) * T%XEMIS_WALL(JJ)
+!
!* 3.3 Town radiative surface temperature
! ----------------------------------
!
- PTS_TOWN(JJ) = ((ZLW_UP(JJ) - PLW_RAD(JJ)*(1.-PEMIS_TOWN(JJ))) /PEMIS_TOWN(JJ)/XSTEFAN)**0.25
+ PTS_TWN(JJ) = ((ZLW_UP(JJ) - PLW_RAD(JJ)*(1.-PEMIS_TWN(JJ))) /PEMIS_TWN(JJ)/XSTEFAN)**0.25
!
!-------------------------------------------------------------------------------
!
!* 4. Averaged evaporative flux (kg/m2/s)
! -----------------------------------
!
- PEVAP_TOWN(JJ) = PTOTS_O_HORS(JJ)*( &
- PROOF_FRAC (JJ)*PDF_ROOF(JJ)*(1.-PFRAC_GR(JJ))*PLEW_ROOF (JJ) /XLVTT &
- + PROOF_FRAC (JJ)*PDN_ROOF(JJ)*(1.-PFRAC_GR(JJ))*PLESNOW_ROOF (JJ) /XLSTT &
- + PROOF_FRAC (JJ) * PFRAC_GR(JJ) *PEVAP_GREENROOF (JJ) &
- + PROAD_FRAC (JJ)*PDF_ROAD(JJ) *PLEW_ROAD (JJ) /XLVTT &
- + PROAD_FRAC (JJ)*PDN_ROAD(JJ) *PLESNOW_ROAD (JJ) /XLSTT &
- + PGARDEN_FRAC(JJ) *PEVAP_GARDEN (JJ) &
- + PWALL_FRAC (JJ)*0.5 * (PLE_WALL_A(JJ)+PLE_WALL_B (JJ))/XLVTT) &
- + PROOF_FRAC (JJ) *(1.-PF_WASTE_CAN(JJ))*PLE_WASTE (JJ) /XLVTT &
- + PLE_TRAFFIC (JJ) /XLVTT &
- + PLE_INDUSTRY(JJ) /XLVTT
-!
+ PEVAP_TWN(JJ) = PTOTS_O_HORS(JJ)*( &
+ PRF_FRAC (JJ) * PDF_RF(JJ) * (1.-T%XGREENROOF(JJ)) * PLEW_RF (JJ) / XLVTT &
+ + PRF_FRAC (JJ) * PDN_RF(JJ) * (1.-T%XGREENROOF(JJ)) * PLESN_RF (JJ) / XLSTT &
+ + PRF_FRAC (JJ) * T%XGREENROOF(JJ) * PEVAP_GR (JJ) &
+ + PRD_FRAC (JJ) * PDF_RD(JJ) * PLEW_RD (JJ) / XLVTT &
+ + PRD_FRAC (JJ) * PDN_RD(JJ) * PLESN_RD (JJ) / XLSTT &
+ + PGD_FRAC (JJ) * PEVAP_GD (JJ) &
+ + PWL_FRAC (JJ) * 0.5 * (PLE_WL_A(JJ) + PLE_WL_B(JJ)) / XLVTT )&
+ + PLE_TRAFFIC (JJ) / XLVTT &
+ + T%XLE_INDUSTRY(JJ) / XLVTT
+!
+ IF (TOP%CBEM=="BEM") THEN
+ PEVAP_TWN(JJ) = PEVAP_TWN(JJ) + PRF_FRAC (JJ) * (1.-B%XF_WASTE_CAN(JJ)) * DMT%XLE_WASTE(JJ) / XLVTT
+ ENDIF
!-------------------------------------------------------------------------------
!
!* 5. Averaged runoff flux (kg/m2/s)
! -----------------------------------
- PRUNOFF_TOWN(JJ) = ((1.-PFRAC_GR(JJ))* PRUNOFF_STRLROOF (JJ) &
- + PFRAC_GR(JJ) *(PRUNOFF_GREENROOF(JJ)+PDRAIN_GREENROOF(JJ))) * PBLD(JJ) &
- + PROAD (JJ) * PRUNOFF_ROAD (JJ) &
- + PGARDEN (JJ) * PRUNOFF_GARDEN (JJ)
+!
+ DMT%XRUNOFF_TOWN(JJ) = ((1.-T%XGREENROOF(JJ))* DMT%XRUNOFF_STRLROOF (JJ) &
+ + T%XGREENROOF(JJ) *(PRUNOFF_GR(JJ) + PDRAIN_GR(JJ))) * T%XBLD(JJ) &
+ + T%XROAD (JJ) * DMT%XRUNOFF_ROAD(JJ) &
+ + T%XGARDEN (JJ) * PRUNOFF_GD(JJ)
!-------------------------------------------------------------------------------
!
!* 6. Air canyon temperature at time t+dt
! -----------------------------------
!
- IF (.NOT. OCANOPY) THEN
- PT_CANYON(JJ) = &
- ( PTS_ROAD (JJ) * PAC_ROAD (JJ) * PDF_ROAD (JJ) * ZROAD (JJ) &
- + PTS_GARDEN (JJ) * PAC_GARDEN(JJ) * ZGARDEN(JJ) &
- + PTS_WALL_A (JJ) * PAC_WALL (JJ) * (1.-PGR(JJ)) * PWALL_O_GRND(JJ) * 0.5 &
- + PTS_WALL_B (JJ) * PAC_WALL (JJ) * (1.-PGR(JJ)) * PWALL_O_GRND(JJ) * 0.5 &
- + PT_WIN1 (JJ) * PAC_WALL (JJ) * PGR(JJ) * PWALL_O_GRND(JJ) &
- + PTA (JJ) * PAC_TOP (JJ) &
- + PH_TRAFFIC (JJ) / (1.-PBLD (JJ)) / PRHOA(JJ) / XCPD &
- + PHSNOW_ROAD (JJ) * PDN_ROAD (JJ) / PRHOA(JJ) / XCPD &
- + PH_WASTE(JJ) * PF_WASTE_CAN(JJ)/(1-PBLD(JJ))/ PRHOA(JJ) / XCPD ) &
- / ( PAC_ROAD (JJ) * PDF_ROAD (JJ) * ZROAD (JJ) &
- + PAC_GARDEN(JJ) * ZGARDEN(JJ) &
- + PAC_WALL (JJ) * PWALL_O_GRND(JJ) &
- + PAC_TOP (JJ) )
-!
+ IF (.NOT. TOP%LCANOPY) THEN
+ ZINTER = PAC_RD(JJ) * PDF_RD(JJ) * ZRD (JJ) + PAC_GD(JJ) * ZGD(JJ) + PAC_WL(JJ) * PWL_O_GRND(JJ) + PAC_TOP(JJ)
+ PT_CAN(JJ) = ( T%XT_ROAD (JJ,1) * PAC_RD (JJ) * PDF_RD (JJ) * ZRD(JJ) &
+ + T%XT_WALL_A(JJ,1) * PAC_WL (JJ) * (1.-B%XGR(JJ)) * PWL_O_GRND(JJ) * 0.5 &
+ + T%XT_WALL_B(JJ,1) * PAC_WL (JJ) * (1.-B%XGR(JJ)) * PWL_O_GRND(JJ) * 0.5 &
+ + B%XT_WIN1 (JJ) * PAC_WL (JJ) * B%XGR(JJ) * PWL_O_GRND(JJ) &
+ + PTA (JJ) * PAC_TOP(JJ) &
+ + PH_TRAFFIC (JJ) / (1.-T%XBLD (JJ)) / PRHOA(JJ) / XCPD &
+ + PHSN_RD(JJ) * PDN_RD(JJ) / PRHOA(JJ) / XCPD ) &
+ / ZINTER
+!
+ PT_CAN(JJ) = PT_CAN(JJ) + ( PTSRAD_GD(JJ) * PAC_GD(JJ) * ZGD(JJ) ) / ZINTER
+ !
+ IF (TOP%CBEM=="BEM") THEN
+ PT_CAN(JJ) = PT_CAN(JJ) + (DMT%XH_WASTE(JJ) * B%XF_WASTE_CAN(JJ) / (1-T%XBLD(JJ)) / PRHOA(JJ) / XCPD) / ZINTER
+ ENDIF
!-------------------------------------------------------------------------------
!
!* 7. Air canyon specific humidity
! ----------------------------
!
- PQ_CANYON(JJ) = &
- ( PQSAT_ROAD (JJ) * PAC_ROAD_WAT (JJ) * PDF_ROAD(JJ) * ZROAD (JJ) * PDELT_ROAD(JJ) &
- + PQSAT_GARDEN (JJ) * PAC_AGG_GARDEN(JJ) * PHU_AGG_GARDEN(JJ) * ZGARDEN(JJ) &
- + PQA (JJ) * PAC_TOP(JJ) &
- + PLE_TRAFFIC (JJ) / (1.-PBLD(JJ)) / PRHOA(JJ) / XLVTT &
- + PLESNOW_ROAD (JJ) * PDN_ROAD(JJ) / PRHOA(JJ) / XLVTT * ZROAD (JJ) &
- + PLE_WASTE(JJ) * PF_WASTE_CAN(JJ) / (1-PBLD(JJ)) / PRHOA(JJ) / XLVTT ) &
- / ( PAC_ROAD_WAT (JJ) * PDF_ROAD(JJ) * PDELT_ROAD(JJ) * ZROAD (JJ) &
- + PAC_AGG_GARDEN(JJ) * PHU_AGG_GARDEN(JJ) * ZGARDEN(JJ) &
- + PAC_TOP(JJ) )
+ ZINTER = PAC_RD_WAT(JJ) * PDF_RD(JJ) * PDELT_RD(JJ) * ZRD(JJ) + PAC_AGG_GD(JJ) * PHU_AGG_GD(JJ) * ZGD(JJ) + PAC_TOP(JJ)
+ PQ_CAN(JJ) = ( PQSAT_RD (JJ) * PAC_RD_WAT(JJ) * PDF_RD (JJ) * ZRD(JJ) * PDELT_RD(JJ) &
+ + PQSAT_GD (JJ) * PAC_AGG_GD(JJ) * PHU_AGG_GD(JJ) * ZGD(JJ) &
+ + PQA (JJ) * PAC_TOP(JJ) &
+ + PLE_TRAFFIC(JJ) / (1.-T%XBLD(JJ)) / PRHOA(JJ) / XLVTT &
+ + PLESN_RD (JJ) * PDN_RD(JJ) / PRHOA(JJ) / XLVTT * ZRD(JJ) ) / ZINTER
+
+ IF (TOP%CBEM=="BEM") THEN
+ PQ_CAN(JJ) = PQ_CAN(JJ) + (DMT%XLE_WASTE(JJ) * B%XF_WASTE_CAN(JJ) / (1-T%XBLD(JJ)) / PRHOA(JJ) / XLVTT) / ZINTER
+ ENDIF
+
ENDIF
!
ENDDO
!
!*check that canyon specif. humidity lower than saturation
!
-ZQSAT_CANYON(:) = QSAT (PT_CANYON(:), PPS(:))
-WHERE (PQ_CANYON(:) > ZQSAT_CANYON(:))
- PQ_CANYON(:) = ZQSAT_CANYON(:)
+ZQSAT_CAN(:) = QSAT (PT_CAN(:), PPS(:))
+WHERE (PQ_CAN(:) > ZQSAT_CAN(:))
+ PQ_CAN(:) = ZQSAT_CAN(:)
END WHERE
+!
IF (LHOOK) CALL DR_HOOK('AVG_URBAN_FLUXES',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/bem.F90 b/src/SURFEX/bem.F90
index 49bd51234f924fa71f93b6c65a7b62d45bfee125..21990463cf2977420ded0c6f0814564cda40d338 100644
--- a/src/SURFEX/bem.F90
+++ b/src/SURFEX/bem.F90
@@ -3,27 +3,11 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ##########################################################################
- SUBROUTINE BEM(PTSTEP, PSUNTIME, HCOOL_COIL, HHEAT_COIL, &
- OAUTOSIZE, KDAY, HNATVENT, &
- PPS, PRHOA, PT_CANYON, PQ_CANYON, PU_CANYON, &
- PT_ROOF, PT_WALL_A, PT_WALL_B, PBLD, PBLD_HEIGHT, PWALL_O_HOR,&
- PHC_FLOOR, PTC_FLOOR, PD_FLOOR, &
- PT_WIN2, PGR, PQIN, PQIN_FRAD, PQIN_FLAT, &
- PEFF_HEAT, PINF, PTCOOL_TARGET, PTHEAT_TARGET, PHR_TARGET, &
- PF_WATER_COND, PV_VENT, PCAP_SYS_HEAT, PT_ADP, PCOP_RAT, &
- PAUX_MAX, PT_FLOOR, PT_MASS, PTI_BLD, PQI_BLD, &
- PCAP_SYS_RAT, PM_SYS_RAT, ONATVENT_NIGHT, &
- PH_BLD_COOL, PH_BLD_HEAT, PLE_BLD_COOL, PLE_BLD_HEAT, &
- PT_BLD_COOL, PHVAC_COOL, PT_SYS, PQ_SYS, PH_WASTE, PLE_WASTE, &
- PFAN_POWER, PHVAC_HEAT, PM_SYS, PCOP, PCAP_SYS, PHU_BLD, &
- PTR_SW_WIN, PT_RAD_IND, PFLX_BLD_FLOOR, PFLX_BLD_MASS, &
- PF_FLOOR_MASS, PF_FLOOR_WALL, PF_FLOOR_WIN, &
- PRADHT_IN, PN_FLOOR, PWALL_O_BLD, PGLAZ_O_BLD, PMASS_O_BLD, &
- PFLOOR_HW_RATIO, PF_FLOOR_ROOF, PF_MASS_FLOOR, PF_MASS_WALL, &
- PF_MASS_WIN, PRAD_ROOF_MASS, PRAD_ROOF_FLOOR, PRAD_WALL_MASS, &
- PRAD_WALL_FLOOR, PRAD_WIN_MASS, PRAD_WIN_FLOOR, &
- PCONV_ROOF_BLD, PCONV_WALL_BLD, PCONV_WIN_BLD, &
- PLOAD_IN_FLOOR, PLOAD_IN_MASS )
+ SUBROUTINE BEM(BOP, T, B, DMT, PTSTEP, PSUNTIME, KDAY, PPS, PRHOA, PT_CAN, &
+ PQ_CAN, PU_CAN, PHU_BLD, PT_RAD_IND, PFLX_BLD_FL, PFLX_BLD_MA,&
+ PRADHT_IN, PRAD_RF_MA, PRAD_RF_FL, PRAD_WL_MA, PRAD_WL_FL,&
+ PRAD_WIN_MA, PRAD_WIN_FL, PCONV_RF_BLD, PCONV_WL_BLD, &
+ PCONV_WIN_BLD, PLOAD_IN_FL, PLOAD_IN_MA )
! ##########################################################################
!
!!**** *BEM*
@@ -154,9 +138,9 @@
!! add automatic/manual ventilation
!! conserve exchanges with the different surfaces inside 1 time step
!! G. Pigeon sept. 2012: use of TARP/DOE coef for indoor convection
-!! use of both PT_WALL_A and PT_WALL_B for calculations
+!! use of both T%XT_WALL_A and T%XT_WALL_B for calculations
!! the internal mass depth is 1/2 of the floor depth
-!! add the option of no atmospheric heat releases by HVAC system (PF_WATER_COND < 0)
+!! add the option of no atmospheric heat releases by HVAC system (B%XF_WATER_COND < 0)
!! G. Pigeon oct. 2012: use indoor air density + new solar heat gain distribution
!! V. Masson May 2013 implicitation of internal building temperature evolution
!-------------------------------------------------------------------------------
@@ -164,6 +148,11 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_BEM_OPTION_n, ONLY : BEM_OPTIONS_t
+USE MODD_TEB_n, ONLY : TEB_t
+USE MODD_BEM_n, ONLY : BEM_t
+USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_t
+!
USE MODD_CSTS,ONLY : XCPD,XSTEFAN,XLVTT,XG, XRV, XRD
USE MODE_THERMOS
@@ -180,184 +169,98 @@ IMPLICIT NONE
!
!* 0.1 Declarations of arguments
!
+TYPE(BEM_OPTIONS_t), INTENT(INOUT) :: BOP
+TYPE(TEB_t), INTENT(INOUT) :: T
+TYPE(BEM_t), INTENT(INOUT) :: B
+TYPE(DIAG_MISC_TEB_t), INTENT(INOUT) :: DMT
!
REAL, INTENT(IN) :: PTSTEP ! Time step
REAL, DIMENSION(:), INTENT(IN) :: PSUNTIME ! current solar time since midnight (solar time, s)
- CHARACTER(LEN=6), INTENT(IN) :: HCOOL_COIL ! type of cooling system IDEAL/DX_COOL
- CHARACTER(LEN=6), INTENT(IN) :: HHEAT_COIL ! type of heating system IDEAL/FIN_CAP
-LOGICAL, INTENT(IN) :: OAUTOSIZE ! Flag to activate autosize calculations
INTEGER, INTENT(IN) :: KDAY ! Simulation day
-!
- CHARACTER(LEN=4), DIMENSION(:), INTENT(IN) :: HNATVENT
!
REAL, DIMENSION(:), INTENT(IN) :: PPS ! Canyon air pressure [Pa]
REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! Air density at the lowest level [kg m-3]
-REAL, DIMENSION(:), INTENT(IN) :: PT_CANYON ! Canyon air temperature [K]
-REAL, DIMENSION(:), INTENT(IN) :: PQ_CANYON ! Canyon air specific humidity [kg kg-1]
-REAL, DIMENSION(:), INTENT(IN) :: PU_CANYON ! Canyon wind speed (m s-1)
-REAL, DIMENSION(:,:), INTENT(IN) :: PT_ROOF ! Roof layers temperatures [K]
-REAL, DIMENSION(:,:), INTENT(IN) :: PT_WALL_A ! Wall A layers temperatures [K]
-REAL, DIMENSION(:,:), INTENT(IN) :: PT_WALL_B ! Wall B layers temperatures [K]
-!
-REAL, DIMENSION(:), INTENT(IN) :: PBLD ! Urban horizontal building density
-REAL, DIMENSION(:), INTENT(IN) :: PBLD_HEIGHT ! Average building height [m]
-REAL, DIMENSION(:), INTENT(IN) :: PWALL_O_HOR ! Wall to horizontal surface ratio
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PHC_FLOOR ! heat capacity for road layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PTC_FLOOR ! thermal conductivity for
- ! road layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_FLOOR ! depth of road layers
-!
-REAL, DIMENSION(:), INTENT(IN) :: PT_WIN2 ! Indoor window temperature [K]
-REAL, DIMENSION(:), INTENT(IN) :: PGR ! Glazing ratio
-REAL, DIMENSION(:), INTENT(IN) :: PQIN ! Internal heat gains [W m-2(floor)]
-REAL, DIMENSION(:), INTENT(IN) :: PQIN_FRAD ! Radiant fraction of internal heat gains
-REAL, DIMENSION(:), INTENT(IN) :: PQIN_FLAT ! Latent franction of internal heat gains
-REAL, DIMENSION(:), INTENT(IN) :: PEFF_HEAT ! Efficiency of the heating system
-REAL, DIMENSION(:), INTENT(IN) :: PINF ! Infiltration flow rate [AC/H]
-REAL, DIMENSION(:), INTENT(IN) :: PTCOOL_TARGET ! Cooling setpoint of HVAC system [K]
-REAL, DIMENSION(:), INTENT(IN) :: PTHEAT_TARGET ! Heating setpoint of HVAC system [K]
-REAL, DIMENSION(:), INTENT(IN) :: PHR_TARGET ! Relative humidity setpoint
-REAL,DIMENSION(:), INTENT(IN) :: PF_WATER_COND !fraction of evaporation for the condensers
-REAL, DIMENSION(:), INTENT(IN) :: PV_VENT ! Ventilation flow rate [AC/H]
-REAL, DIMENSION(:), INTENT(IN) :: PCAP_SYS_HEAT ! Capacity of the heating system
- ! [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(IN) :: PT_ADP ! Apparatus dewpoint temperature of the
- ! cooling coil [K]
-REAL, DIMENSION(:), INTENT(IN) :: PCOP_RAT ! Rated COP of the cooling system
-!
-REAL, DIMENSION(:), INTENT(INOUT):: PAUX_MAX ! Auxiliar variable for autosize calcs
-REAL, DIMENSION(:,:), INTENT(INOUT):: PT_FLOOR ! Floor layers temperatures [K]
-REAL, DIMENSION(:,:), INTENT(INOUT):: PT_MASS ! Internal mass layers temperatures [K]
-REAL, DIMENSION(:), INTENT(INOUT):: PTI_BLD ! Indoor air temperature [K]
-REAL, DIMENSION(:), INTENT(INOUT):: PQI_BLD ! Indoor air specific humidity [kg kg-1]
-
-REAL, DIMENSION(:), INTENT(INOUT):: PCAP_SYS_RAT ! Rated capacity of the cooling system
- ! [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(INOUT):: PM_SYS_RAT ! Rated HVAC mass flow rate
- ! [kg s-1 m-2(bld)]
-LOGICAL, DIMENSION(:),INTENT(INOUT):: ONATVENT_NIGHT ! has natural ventilation
- ! been necessary/possible during the night
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PH_BLD_COOL ! Sensible cooling energy demand
- ! of the building [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PH_BLD_HEAT ! Heating energy demand
- ! of the building [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_BLD_COOL ! Latent cooling energy demand
- ! of the building [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_BLD_HEAT ! Latent heating energy demand
- ! of the building [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PT_BLD_COOL ! Total cooling energy demand
- ! of the building [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PHVAC_COOL ! Energy consumption of the cooling system
- ! [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PT_SYS ! Supply air temperature [K]
-REAL, DIMENSION(:), INTENT(OUT) :: PQ_SYS ! Supply air specific humidity [kg kg-1]
-REAL, DIMENSION(:), INTENT(OUT) :: PH_WASTE ! Sensible waste heat from HVAC system
- ! [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_WASTE ! Latent waste heat from HVAC system
- ! [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PFAN_POWER ! HVAC fan power
-REAL, DIMENSION(:), INTENT(OUT) :: PHVAC_HEAT ! Energy consumption of the heating system
- ! [W m-2(bld)]
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PM_SYS ! Actual HVAC mass flow rate
- ! [kg s-1 m-2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PCOP ! COP of the cooling system
-REAL, DIMENSION(:), INTENT(OUT) :: PCAP_SYS ! Actual capacity of the cooling system
- ! [W m-2(bld)]
+REAL, DIMENSION(:), INTENT(IN) :: PT_CAN ! Canyon air temperature [K]
+REAL, DIMENSION(:), INTENT(IN) :: PQ_CAN ! Canyon air specific humidity [kg kg-1]
+REAL, DIMENSION(:), INTENT(IN) :: PU_CAN ! Canyon wind speed (m s-1)
!
REAL, DIMENSION(:), INTENT(OUT) :: PHU_BLD ! Indoor relative humidity 0 < (-) < 1
-REAL, DIMENSION(:), INTENT(IN) :: PTR_SW_WIN ! Solar radiation transmitted throught
- ! windows [W m-2(bld)]
REAL, DIMENSION(:), INTENT(IN) :: PT_RAD_IND ! Indoor mean radiant temperature [K]
!
-REAL, DIMENSION(:), INTENT(OUT) :: PFLX_BLD_FLOOR! Heat flux from indoor air to floor
+REAL, DIMENSION(:), INTENT(OUT) :: PFLX_BLD_FL! Heat flux from indoor air to floor
! [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PFLX_BLD_MASS ! Heat flux from indoor air to mass
+REAL, DIMENSION(:), INTENT(OUT) :: PFLX_BLD_MA ! Heat flux from indoor air to mass
! [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(IN) :: PF_FLOOR_MASS ! View factor floor-mass
-REAL, DIMENSION(:), INTENT(IN) :: PF_FLOOR_WALL ! View factor floor-wall
-REAL, DIMENSION(:), INTENT(IN) :: PF_FLOOR_WIN ! View factor floor-window
REAL, DIMENSION(:), INTENT(IN) :: PRADHT_IN ! Indoor radiant heat transfer coefficient
! [W K-1 m-2]
-REAL, DIMENSION(:) , INTENT(IN) :: PN_FLOOR ! Number of floors
-REAL, DIMENSION(:) , INTENT(IN) :: PWALL_O_BLD ! Wall area [m2_wall/m2_bld]
-REAL, DIMENSION(:) , INTENT(IN) :: PGLAZ_O_BLD ! Window area [m2_win/m2_bld]
-REAL, DIMENSION(:) , INTENT(IN) :: PMASS_O_BLD ! Mass area [m2_mass/m2_bld]
-REAL, DIMENSION(:) , INTENT(IN) :: PFLOOR_HW_RATIO ! H/W ratio of 1 floor level
-REAL, DIMENSION(:) , INTENT(IN) :: PF_FLOOR_ROOF ! View factor floor-roof
-REAL, DIMENSION(:) , INTENT(IN) :: PF_MASS_FLOOR ! View factor mass-floor
-REAL, DIMENSION(:) , INTENT(IN) :: PF_MASS_WALL ! View factor mass-wall
-REAL, DIMENSION(:) , INTENT(IN) :: PF_MASS_WIN ! View factor mass-window
-REAL, DIMENSION(:) , INTENT(IN) :: PRAD_ROOF_MASS ! Rad. fluxes between roof and mass
-REAL, DIMENSION(:) , INTENT(IN) :: PRAD_ROOF_FLOOR ! Rad. fluxes between roof and floor
-REAL, DIMENSION(:) , INTENT(IN) :: PRAD_WALL_MASS ! Rad. fluxes between wall and mass
-REAL, DIMENSION(:) , INTENT(IN) :: PRAD_WALL_FLOOR ! Rad. fluxes between wall and floor
-REAL, DIMENSION(:) , INTENT(IN) :: PRAD_WIN_MASS ! Rad. fluxes between wind. and mass
-REAL, DIMENSION(:) , INTENT(IN) :: PRAD_WIN_FLOOR ! Rad. fluxes between wind. and floor
-REAL, DIMENSION(:) , INTENT(IN) :: PCONV_ROOF_BLD ! Conv. fluxes between roof and indoor air
-REAL, DIMENSION(:) , INTENT(IN) :: PCONV_WALL_BLD ! Conv. fluxes between wall and indoor air
+REAL, DIMENSION(:) , INTENT(IN) :: PRAD_RF_MA ! Rad. fluxes between roof and mass
+REAL, DIMENSION(:) , INTENT(IN) :: PRAD_RF_FL ! Rad. fluxes between roof and floor
+REAL, DIMENSION(:) , INTENT(IN) :: PRAD_WL_MA ! Rad. fluxes between wall and mass
+REAL, DIMENSION(:) , INTENT(IN) :: PRAD_WL_FL ! Rad. fluxes between wall and floor
+REAL, DIMENSION(:) , INTENT(IN) :: PRAD_WIN_MA ! Rad. fluxes between wind. and mass
+REAL, DIMENSION(:) , INTENT(IN) :: PRAD_WIN_FL ! Rad. fluxes between wind. and floor
+REAL, DIMENSION(:) , INTENT(IN) :: PCONV_RF_BLD ! Conv. fluxes between roof and indoor air
+REAL, DIMENSION(:) , INTENT(IN) :: PCONV_WL_BLD ! Conv. fluxes between wall and indoor air
REAL, DIMENSION(:) , INTENT(IN) :: PCONV_WIN_BLD ! Conv. fluxes between wind. and indoor air
-REAL, DIMENSION(:) , INTENT(IN) :: PLOAD_IN_FLOOR ! solar + int heat gain on floor W/m2 [floor]
-REAL, DIMENSION(:) , INTENT(IN) :: PLOAD_IN_MASS ! solar + int heat gain on floor W/m2 [mass]
+REAL, DIMENSION(:) , INTENT(IN) :: PLOAD_IN_FL ! solar + int heat gain on floor W/m2 [floor]
+REAL, DIMENSION(:) , INTENT(IN) :: PLOAD_IN_MA ! solar + int heat gain on floor W/m2 [mass]
!
!* 0.2 Declarations of local variables
!
-INTEGER :: IROOF ! Number of roof layers
-INTEGER :: IWALL ! Number of wall layers
+INTEGER :: IRF ! Number of roof layers
+INTEGER :: IWL ! Number of wall layers
!REAL :: ZTCOMF_MAX ! Maximum comfort temperature for nat.vent [K]
!
-REAL, DIMENSION(SIZE(PTI_BLD)) :: ZFAN_AP ! Fan design pressure increase [Pa]
-REAL, DIMENSION(SIZE(PTI_BLD)) :: ZFAN_EFF ! Fan total efficiency
+REAL, DIMENSION(SIZE(B%XTI_BLD)) :: ZFAN_AP ! Fan design pressure increase [Pa]
+REAL, DIMENSION(SIZE(B%XTI_BLD)) :: ZFAN_EFF ! Fan total efficiency
!
-LOGICAL, DIMENSION(SIZE(PTI_BLD)):: GSCHED ! Day-night schedule flag
+LOGICAL, DIMENSION(SIZE(B%XTI_BLD)):: GSCHED ! Day-night schedule flag
! *to be transported to inputs*
!
-REAL, DIMENSION(SIZE(PTI_BLD)) :: ZF_NIGHT ! Reduction factor of int.gains at night
-REAL, DIMENSION(SIZE(PTI_BLD)) :: ZF_DAY ! Amplification factor of int.gains at daytime
+REAL, DIMENSION(SIZE(B%XTI_BLD)) :: ZF_NIGHT ! Reduction factor of int.gains at night
+REAL, DIMENSION(SIZE(B%XTI_BLD)) :: ZF_DAY ! Amplification factor of int.gains at daytime
!
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZAC_IN_MASS_COOL, ZAC_IN_FLOOR_COOL, &
- ZAC_IN_ROOF_COOL, ZAC_IN_WALL_A_COOL, &
- ZAC_IN_WALL_B_COOL, ZAC_IN_WIN_COOL
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZAC_IN_MASS_HEAT, ZAC_IN_FLOOR_HEAT, &
- ZAC_IN_ROOF_HEAT, ZAC_IN_WALL_A_HEAT, &
- ZAC_IN_WALL_B_HEAT, ZAC_IN_WIN_HEAT
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZAC_IN_MA_COOL, ZAC_IN_FL_COOL, &
+ ZAC_IN_RF_COOL, ZAC_IN_WL_A_COOL, &
+ ZAC_IN_WL_B_COOL, ZAC_IN_WIN_COOL
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZAC_IN_MA_HEAT, ZAC_IN_FL_HEAT, &
+ ZAC_IN_RF_HEAT, ZAC_IN_WL_A_HEAT, &
+ ZAC_IN_WL_B_HEAT, ZAC_IN_WIN_HEAT
!
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZQIN ! Internal heat gains [W m-2(bld)]
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZQIN ! Internal heat gains [W m-2(bld)]
!
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZV_VENT ! Ventilation flow rate [m3 s-1 m-2(bld)]
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZINF ! Infiltration flow rate [m3 s-1 m-2(bld)]
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZV_VENT ! Ventilation flow rate [m3 s-1 m-2(bld)]
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZINF ! Infiltration flow rate [m3 s-1 m-2(bld)]
!
-LOGICAL, DIMENSION(SIZE(PTI_BLD)):: GNAT_VENT ! Is Natural ventilation active ?
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZNAT_VENT ! Nat.vent airflow rate [m3 s-1 m-2(bld)]
-REAL,DIMENSION(SIZE(PTI_BLD)) :: ZTI_BLD ! Indoor air temperature at time step t + dt [K]
-REAL,DIMENSION(SIZE(PTI_BLD)) :: ZTI_BLD_OPEN ! Indoor air temperature if windows opened
-REAL,DIMENSION(SIZE(PTI_BLD)) :: ZTI_BLD_CLOSED! Indoor air temperature if windows closed
+LOGICAL, DIMENSION(SIZE(B%XTI_BLD)):: GNAT_VENT ! Is Natural ventilation active ?
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZNAT_VENT ! Nat.vent airflow rate [m3 s-1 m-2(bld)]
+REAL,DIMENSION(SIZE(B%XTI_BLD)) :: ZTI_BLD ! Indoor air temperature at time step t + dt [K]
+REAL,DIMENSION(SIZE(B%XTI_BLD)) :: ZTI_BLD_OPEN ! Indoor air temperature if windows opened
+REAL,DIMENSION(SIZE(B%XTI_BLD)) :: ZTI_BLD_CLOSED! Indoor air temperature if windows closed
!
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZQCOOL_TARGET ! Specific humidity cooling setpoing [kg kg-1]
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZQHEAT_TARGET ! Specific humidity heating setpoing [kg kg-1]
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZQCOOL_TRGT ! Specific humidity cooling setpoing [kg kg-1]
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZQHEAT_TRGT ! Specific humidity heating setpoing [kg kg-1]
!
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZSHR ! Rated sensible heat rate
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZM_SYS_RAT ! Auxiliar mass flow rate [kg s-1 m-2(bld)]
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZSHR ! Rated sensible heat rate
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZM_SYS_RAT ! Auxiliar mass flow rate [kg s-1 m-2(bld)]
!
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZXMIX ! Outdoor mixing fraction
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZT_MIX ! Mixing air temperature [K]
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZQ_MIX ! Mixing air specific humidity [kg kg-1]
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZXMIX ! Outdoor mixing fraction
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZT_MIX ! Mixing air temperature [K]
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZQ_MIX ! Mixing air specific humidity [kg kg-1]
!
-REAL,DIMENSION(SIZE(PTI_BLD)) :: ZQI_BLD ! Indoor air humidity at time step t + dt [K}
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZWASTE
+REAL,DIMENSION(SIZE(B%XTI_BLD)) :: ZQI_BLD ! Indoor air humidity at time step t + dt [K}
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZWASTE
!
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZDQS_FLOOR
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZIMB_FLOOR
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZDQS_MASS
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZIMB_MASS
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZLOAD_FLOOR ! sum of solar and internal loads on floor
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZLOAD_MASS ! sum of solar and internal loads on mass
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZRAD_FLOOR_MASS ! Rad. fluxes from floor to mass
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZCONV_FLOOR_BLD ! Conv. fluxes from floor to indoor air
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZCONV_MASS_BLD ! Conv. fluxes from mass to indoor air
-REAL, DIMENSION(SIZE(PTI_BLD)):: ZRHOI ! indoor air density
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZDQS_FL
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZIMB_FL
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZDQS_MA
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZIMB_MA
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZLOAD_FL ! sum of solar and internal loads on floor
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZLOAD_MA ! sum of solar and internal loads on mass
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZRAD_FL_MA ! Rad. fluxes from floor to mass
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZCONV_FL_BLD ! Conv. fluxes from floor to indoor air
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZCONV_MA_BLD ! Conv. fluxes from mass to indoor air
+REAL, DIMENSION(SIZE(B%XTI_BLD)):: ZRHOI ! indoor air density
!
INTEGER :: JJ ! Loop counter
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -371,7 +274,7 @@ IF (LHOOK) CALL DR_HOOK('BEM',0,ZHOOK_HANDLE)
!* 1. Initializations
! ---------------
!
-ZRHOI(:) = PPS(:) / (XRD * PTI_BLD(:) * ( 1.+((XRV/XRD)-1.)*PQI_BLD(:) ) )
+ZRHOI(:) = PPS(:) / (XRD * B%XTI_BLD(:) * ( 1.+((XRV/XRD)-1.)*B%XQI_BLD(:) ) )
! *Temperal definitions for nat.vent*
!ZTCOMF_MAX = 26. + 273.16
!
@@ -380,12 +283,12 @@ ZFAN_AP (:) = 600.0
ZFAN_EFF(:) = 0.7
!
! *Other calcs
-IROOF = SIZE(PT_ROOF,2)
-IWALL = SIZE(PT_WALL_A,2)
+IRF = SIZE(T%XT_ROOF,2)
+IWL = SIZE(T%XT_WALL_A,2)
!
!
! initial condition of QI_BLD equivalent to 50% RH
-IF (ANY(PQI_BLD(:) <= 1E-6)) PQI_BLD = 0.5 * QSAT(PTI_BLD, PPS)
+IF (ANY(B%XQI_BLD(:) <= 1E-6)) B%XQI_BLD = 0.5 * QSAT(B%XTI_BLD, PPS)
!
! *Temperal definitions for shedule*
GSCHED(:) = .FALSE.
@@ -399,7 +302,7 @@ END WHERE
!
! *Int.gains schedule
!
-ZQIN = PQIN * PN_FLOOR
+ZQIN = DMT%XQIN * B%XN_FLOOR
WHERE (PSUNTIME(:) > 0. .AND. PSUNTIME(:) < 25200.) ! night between 0000 and 0700
ZQIN(:) = ZQIN(:) * ZF_NIGHT(:)
ELSEWHERE
@@ -407,86 +310,73 @@ ELSEWHERE
END WHERE
! *Change of units AC/H -> [m3 s-1 m-2(bld)]
-ZV_VENT(:) = PV_VENT(:) * PBLD_HEIGHT(:) / 3600.
-ZINF (:) = PINF (:) * PBLD_HEIGHT(:) / 3600.
+ZV_VENT(:) = B%XV_VENT(:) * T%XBLD_HEIGHT(:) / 3600.
+ZINF (:) = B%XINF (:) * T%XBLD_HEIGHT(:) / 3600.
!
!* 2. heat balance for building floor and mass
! ----------------------------------------
!
!* 2.1 total load on the internal mass or floor
-ZLOAD_FLOOR(:) = (ZQIN(:) * PQIN_FRAD(:) * (1.-PQIN_FLAT(:)) + PTR_SW_WIN(:)) / (PMASS_O_BLD(:)+1.)
-WHERE (PN_FLOOR(:) > 1.)
- ZLOAD_MASS(:) = ZLOAD_FLOOR(:)
+ZLOAD_FL(:) = (ZQIN(:) * B%XQIN_FRAD(:) * (1.-B%XQIN_FLAT(:)) + DMT%XTR_SW_WIN(:)) / (B%XMASS_O_BLD(:)+1.)
+WHERE (B%XN_FLOOR(:) > 1.)
+ ZLOAD_MA(:) = ZLOAD_FL(:)
ELSEWHERE
- ZLOAD_MASS(:) = 0.
+ ZLOAD_MA(:) = 0.
ENDWHERE
!
!* 2.2 FLOOR HEAT BALANCE
!
- CALL FLOOR_LAYER_E_BUDGET(PT_FLOOR, PTSTEP, &
- PHC_FLOOR, PTC_FLOOR, PD_FLOOR, &
- PFLX_BLD_FLOOR, ZDQS_FLOOR, ZIMB_FLOOR,&
- PF_FLOOR_MASS, PF_FLOOR_WALL, PF_FLOOR_WIN,&
- PF_FLOOR_ROOF, PRADHT_IN, &
- PT_MASS(:,1), PRAD_WALL_FLOOR, PRAD_ROOF_FLOOR, &
- PRAD_WIN_FLOOR, PLOAD_IN_FLOOR, PTI_BLD, ZRAD_FLOOR_MASS, ZCONV_FLOOR_BLD)
+ CALL FLOOR_LAYER_E_BUDGET(B, PTSTEP, PFLX_BLD_FL, ZDQS_FL, ZIMB_FL, PRADHT_IN, &
+ PRAD_WL_FL, PRAD_RF_FL, PRAD_WIN_FL, PLOAD_IN_FL, &
+ ZRAD_FL_MA, ZCONV_FL_BLD)
!
!* 2.3 MASS HEAT BALANCE
!
- CALL MASS_LAYER_E_BUDGET(PT_MASS, PTSTEP, &
- PHC_FLOOR, PTC_FLOOR, PD_FLOOR/2., &
- PFLX_BLD_MASS, ZDQS_MASS, ZIMB_MASS,&
- PF_MASS_WALL, PF_MASS_WIN,&
- PF_MASS_FLOOR, PRADHT_IN, &
- PRAD_WALL_MASS, PRAD_ROOF_MASS, &
- PRAD_WIN_MASS, PLOAD_IN_MASS, PTI_BLD, &
- ZRAD_FLOOR_MASS, ZCONV_MASS_BLD )
-!
-!
-ZAC_IN_WALL_A_COOL = CHTC_VERT_DOE(PT_WALL_A(:,IWALL), PTCOOL_TARGET)
-ZAC_IN_WALL_B_COOL = CHTC_VERT_DOE(PT_WALL_B(:,IWALL), PTCOOL_TARGET)
-ZAC_IN_WIN_COOL = CHTC_VERT_DOE(PT_WIN2, PTCOOL_TARGET)
-ZAC_IN_MASS_COOL = CHTC_VERT_DOE(PT_MASS(:,1), PTCOOL_TARGET)
-ZAC_IN_ROOF_COOL = CHTC_DOWN_DOE(PT_ROOF(:,IROOF),PTCOOL_TARGET)
-ZAC_IN_FLOOR_COOL = CHTC_UP_DOE(PT_FLOOR(:,1),PTCOOL_TARGET)
+ CALL MASS_LAYER_E_BUDGET(B, PTSTEP, PFLX_BLD_MA, ZDQS_MA, ZIMB_MA, PRADHT_IN, &
+ PRAD_WL_MA, PRAD_RF_MA, PRAD_WIN_MA, PLOAD_IN_MA, &
+ ZRAD_FL_MA, ZCONV_MA_BLD )
+!
+!
+ZAC_IN_WL_A_COOL = CHTC_VERT_DOE(T%XT_WALL_A(:,IWL), DMT%XTCOOL_TARGET)
+ZAC_IN_WL_B_COOL = CHTC_VERT_DOE(T%XT_WALL_B(:,IWL), DMT%XTCOOL_TARGET)
+ZAC_IN_WIN_COOL = CHTC_VERT_DOE(B%XT_WIN2 , DMT%XTCOOL_TARGET)
+ZAC_IN_MA_COOL = CHTC_VERT_DOE(B%XT_MASS(:,1) , DMT%XTCOOL_TARGET)
+ZAC_IN_RF_COOL = CHTC_DOWN_DOE(T%XT_ROOF(:,IRF) , DMT%XTCOOL_TARGET)
+ZAC_IN_FL_COOL = CHTC_UP_DOE (B%XT_FLOOR(:,1) , DMT%XTCOOL_TARGET)
-ZAC_IN_WALL_A_HEAT = CHTC_VERT_DOE(PT_WALL_A(:,IWALL), PTHEAT_TARGET)
-ZAC_IN_WALL_B_HEAT = CHTC_VERT_DOE(PT_WALL_B(:,IWALL), PTHEAT_TARGET)
-ZAC_IN_WIN_HEAT = CHTC_VERT_DOE(PT_WIN2, PTHEAT_TARGET)
-ZAC_IN_MASS_HEAT = CHTC_VERT_DOE(PT_MASS(:,1), PTHEAT_TARGET)
-ZAC_IN_ROOF_HEAT = CHTC_DOWN_DOE(PT_ROOF(:,IROOF),PTHEAT_TARGET)
-ZAC_IN_FLOOR_HEAT = CHTC_UP_DOE(PT_FLOOR(:,1),PTHEAT_TARGET)
+ZAC_IN_WL_A_HEAT = CHTC_VERT_DOE(T%XT_WALL_A(:,IWL), DMT%XTHEAT_TARGET)
+ZAC_IN_WL_B_HEAT = CHTC_VERT_DOE(T%XT_WALL_B(:,IWL), DMT%XTHEAT_TARGET)
+ZAC_IN_WIN_HEAT = CHTC_VERT_DOE(B%XT_WIN2 , DMT%XTHEAT_TARGET)
+ZAC_IN_MA_HEAT = CHTC_VERT_DOE(B%XT_MASS(:,1) , DMT%XTHEAT_TARGET)
+ZAC_IN_RF_HEAT = CHTC_DOWN_DOE(T%XT_ROOF(:,IRF) , DMT%XTHEAT_TARGET)
+ZAC_IN_FL_HEAT = CHTC_UP_DOE (B%XT_FLOOR(:,1) , DMT%XTHEAT_TARGET)
DO JJ=1,SIZE(ZAC_IN_WIN_COOL)
- ZAC_IN_WALL_A_COOL(JJ) = MAX(1.,ZAC_IN_WALL_A_COOL(JJ))
- ZAC_IN_WALL_B_COOL(JJ) = MAX(1., ZAC_IN_WALL_B_COOL(JJ))
- ZAC_IN_WIN_COOL(JJ) = MAX(1., ZAC_IN_WIN_COOL(JJ))
- ZAC_IN_MASS_COOL(JJ) = MAX(1., ZAC_IN_MASS_COOL(JJ))
- ZAC_IN_ROOF_COOL(JJ) = MAX(1., ZAC_IN_ROOF_COOL(JJ))
- ZAC_IN_FLOOR_COOL(JJ) = MAX(1., ZAC_IN_FLOOR_COOL(JJ))
+ ZAC_IN_WL_A_COOL(JJ) = MAX(1., ZAC_IN_WL_A_COOL(JJ))
+ ZAC_IN_WL_B_COOL(JJ) = MAX(1., ZAC_IN_WL_B_COOL(JJ))
+ ZAC_IN_WIN_COOL (JJ) = MAX(1., ZAC_IN_WIN_COOL(JJ))
+ ZAC_IN_MA_COOL (JJ) = MAX(1., ZAC_IN_MA_COOL (JJ))
+ ZAC_IN_RF_COOL (JJ) = MAX(1., ZAC_IN_RF_COOL (JJ))
+ ZAC_IN_FL_COOL (JJ) = MAX(1., ZAC_IN_FL_COOL (JJ))
- ZAC_IN_WALL_A_HEAT(JJ) = MAX(1.,ZAC_IN_WALL_A_HEAT(JJ))
- ZAC_IN_WALL_B_HEAT(JJ) = MAX(1., ZAC_IN_WALL_B_HEAT(JJ))
- ZAC_IN_WIN_HEAT(JJ) = MAX(1., ZAC_IN_WIN_HEAT(JJ))
- ZAC_IN_MASS_HEAT(JJ) = MAX(1., ZAC_IN_MASS_HEAT(JJ))
- ZAC_IN_ROOF_HEAT(JJ) = MAX(1., ZAC_IN_ROOF_HEAT(JJ))
- ZAC_IN_FLOOR_HEAT(JJ) = MAX(1., ZAC_IN_FLOOR_HEAT(JJ))
+ ZAC_IN_WL_A_HEAT(JJ) = MAX(1., ZAC_IN_WL_A_HEAT(JJ))
+ ZAC_IN_WL_B_HEAT(JJ) = MAX(1., ZAC_IN_WL_B_HEAT(JJ))
+ ZAC_IN_WIN_HEAT (JJ) = MAX(1., ZAC_IN_WIN_HEAT(JJ))
+ ZAC_IN_MA_HEAT (JJ) = MAX(1., ZAC_IN_MA_HEAT (JJ))
+ ZAC_IN_RF_HEAT (JJ) = MAX(1., ZAC_IN_RF_HEAT (JJ))
+ ZAC_IN_FL_HEAT (JJ) = MAX(1., ZAC_IN_FL_HEAT (JJ))
ENDDO
!* 4. Indoor energy balance calculation
! ---------------------------------
!
-DO JJ=1,SIZE(PT_CANYON)
+DO JJ=1,SIZE(PT_CAN)
! *first guess of indoor temperature
- ZTI_BLD(JJ) = PTI_BLD(JJ) &
- + PTSTEP/(ZRHOI(JJ) * XCPD * PBLD_HEIGHT(JJ)) &
- * ( PWALL_O_BLD(JJ) * PCONV_WALL_BLD(JJ) &
- + PGLAZ_O_BLD (JJ) * PCONV_WIN_BLD(JJ) &
- + PMASS_O_BLD(JJ) * ZCONV_MASS_BLD(JJ) &
- + PCONV_ROOF_BLD(JJ) &
- + ZCONV_FLOOR_BLD(JJ) &
- + ZQIN(JJ) * (1 - PQIN_FRAD(JJ)) * (1 - PQIN_FLAT(JJ)) )
+ ZTI_BLD(JJ) = B%XTI_BLD(JJ) + PTSTEP/(ZRHOI(JJ) * XCPD * T%XBLD_HEIGHT(JJ)) &
+ * ( T%XWALL_O_BLD(JJ) * PCONV_WL_BLD(JJ) + B%XGLAZ_O_BLD (JJ) * PCONV_WIN_BLD(JJ) &
+ + B%XMASS_O_BLD(JJ) * ZCONV_MA_BLD(JJ) + PCONV_RF_BLD(JJ) + ZCONV_FL_BLD(JJ) &
+ + ZQIN(JJ) * (1 - B%XQIN_FRAD(JJ)) * (1 - B%XQIN_FLAT(JJ)) )
!
!################################################################################
! *is natural surventilation active at the current time step ?
@@ -494,54 +384,54 @@ DO JJ=1,SIZE(PT_CANYON)
!
! *no surventilation possible
- IF (HNATVENT(JJ)=='NONE') THEN
+ IF (B%CNATVENT(JJ)=='NONE') THEN
!
GNAT_VENT(JJ) = .FALSE.
!
! *automatic management of surventilation
- ELSEIF (HNATVENT(JJ)=='AUTO' .OR. HNATVENT(JJ)=='MECH') THEN
+ ELSEIF (B%CNATVENT(JJ)=='AUTO' .OR. B%CNATVENT(JJ)=='MECH') THEN
!
IF (MOD(PSUNTIME(JJ), 3600.) .LT. PTSTEP) THEN
!
- IF ( PTI_BLD(JJ).GT. PT_CANYON(JJ) + 1 ) THEN ! condition to enable the
- IF (HNATVENT(JJ)=='AUTO') THEN
+ IF ( B%XTI_BLD(JJ).GT. PT_CAN(JJ) + 1 ) THEN ! condition to enable the
+ IF (B%CNATVENT(JJ)=='AUTO') THEN
! natural surventilation rate calculation (window opening)
- CALL GET_NAT_VENT(PTI_BLD(JJ), PT_CANYON(JJ), PU_CANYON(JJ), PGR(JJ), &
- PFLOOR_HW_RATIO(JJ), PBLD_HEIGHT(JJ), ZNAT_VENT(JJ))
- ELSE IF (HNATVENT(JJ)=='MECH') THEN
+ CALL GET_NAT_VENT(B%XTI_BLD(JJ), PT_CAN(JJ), PU_CAN(JJ), B%XGR(JJ), &
+ B%XFLOOR_HW_RATIO(JJ), T%XBLD_HEIGHT(JJ), ZNAT_VENT(JJ))
+ ELSE IF (B%CNATVENT(JJ)=='MECH') THEN
! mechanical surventilation rate calculation : 5 volumes/hour
- ZNAT_VENT(JJ) = 5.0*PBLD_HEIGHT(JJ)/3600.
+ ZNAT_VENT(JJ) = 5.0*T%XBLD_HEIGHT(JJ)/3600.
END IF
!
ZTI_BLD_OPEN (JJ) = ZTI_BLD(JJ) &
- + ZNAT_VENT(JJ) * PTSTEP/PBLD_HEIGHT(JJ) * (PT_CANYON(JJ) - PTI_BLD(JJ))
+ + ZNAT_VENT(JJ) * PTSTEP/T%XBLD_HEIGHT(JJ) * (PT_CAN(JJ) - B%XTI_BLD(JJ))
ZTI_BLD_CLOSED(JJ) = ZTI_BLD(JJ) &
- + (ZINF(JJ) + ZV_VENT(JJ)) * PTSTEP/PBLD_HEIGHT(JJ) * (PT_CANYON(JJ) - PTI_BLD(JJ))
+ + (ZINF(JJ) + ZV_VENT(JJ)) * PTSTEP/T%XBLD_HEIGHT(JJ) * (PT_CAN(JJ) - B%XTI_BLD(JJ))
!
- GNAT_VENT(JJ) = (ZTI_BLD_OPEN(JJ) <= PTCOOL_TARGET (JJ) .AND. &
+ GNAT_VENT(JJ) = (ZTI_BLD_OPEN(JJ) <= DMT%XTCOOL_TARGET (JJ) .AND. &
ZTI_BLD_OPEN(JJ) < ZTI_BLD_CLOSED(JJ) .AND. &
- ZTI_BLD_OPEN(JJ) > PTHEAT_TARGET (JJ) + 4.)
+ ZTI_BLD_OPEN(JJ) > DMT%XTHEAT_TARGET (JJ) + 4.)
!
ELSE
GNAT_VENT(JJ) = .FALSE.
ENDIF
- ONATVENT_NIGHT(JJ) = GNAT_VENT(JJ)
+ B%LNATVENT_NIGHT(JJ) = GNAT_VENT(JJ)
ELSE
- GNAT_VENT(JJ) = ONATVENT_NIGHT(JJ)
+ GNAT_VENT(JJ) = B%LNATVENT_NIGHT(JJ)
ENDIF
!
! *manual management of surventilation
- ELSEIF (HNATVENT(JJ)=='MANU') THEN
+ ELSEIF (B%CNATVENT(JJ)=='MANU') THEN
!
- ONATVENT_NIGHT(JJ) = ONATVENT_NIGHT(JJ) .AND. &
+ B%LNATVENT_NIGHT(JJ) = B%LNATVENT_NIGHT(JJ) .AND. &
.NOT. ( PSUNTIME(JJ) > 5.*3600 .AND. PSUNTIME(JJ) < 18.*3600 )
!
GNAT_VENT(JJ) = ( PSUNTIME(JJ) > 18.*3600. .AND. PSUNTIME(JJ) < 21.*3600. &
- .AND. PT_CANYON(JJ) < PTI_BLD(JJ)+2. &
- .AND. PT_CANYON(JJ) > PTHEAT_TARGET(JJ) &
- .AND. ( PTI_BLD(JJ) > PTHEAT_TARGET(JJ)+5. &
- .OR. PTI_BLD(JJ) == PTCOOL_TARGET(JJ) ) )
- GNAT_VENT(JJ) = GNAT_VENT(JJ) .OR. ONATVENT_NIGHT(JJ)
+ .AND. PT_CAN(JJ) < B%XTI_BLD(JJ)+2. &
+ .AND. PT_CAN(JJ) > DMT%XTHEAT_TARGET(JJ) &
+ .AND. ( B%XTI_BLD(JJ) > DMT%XTHEAT_TARGET(JJ)+5. &
+ .OR. B%XTI_BLD(JJ) == DMT%XTCOOL_TARGET(JJ) ) )
+ GNAT_VENT(JJ) = GNAT_VENT(JJ) .OR. B%LNATVENT_NIGHT(JJ)
!
ENDIF
!
@@ -556,192 +446,190 @@ DO JJ=1,SIZE(PT_CANYON)
! *If natural surventilation ACTIVE
IF (GNAT_VENT(JJ)) THEN
!
- CALL GET_NAT_VENT(PTI_BLD(JJ), PT_CANYON(JJ), PU_CANYON(JJ), PGR(JJ), &
- PFLOOR_HW_RATIO(JJ), PBLD_HEIGHT(JJ), ZNAT_VENT(JJ) )
+ CALL GET_NAT_VENT(B%XTI_BLD(JJ), PT_CAN(JJ), PU_CAN(JJ), B%XGR(JJ), &
+ B%XFLOOR_HW_RATIO(JJ), T%XBLD_HEIGHT(JJ), ZNAT_VENT(JJ) )
!
ZV_VENT (JJ) = 0.
ZINF (JJ) = 0.
!
- PH_BLD_COOL (JJ) = 0.0 ! No HVAC consumption
- PH_BLD_HEAT (JJ) = 0.0
- PLE_BLD_COOL(JJ) = 0.0 ! No HVAC consumption
- PLE_BLD_HEAT(JJ) = 0.0
+ DMT%XH_BLD_COOL (JJ) = 0.0 ! No HVAC consumption
+ DMT%XH_BLD_HEAT (JJ) = 0.0
+ DMT%XLE_BLD_COOL(JJ) = 0.0 ! No HVAC consumption
+ DMT%XLE_BLD_HEAT(JJ) = 0.0
!
- PT_BLD_COOL (JJ) = 0.0 ! No HVAC consumption
- PHVAC_COOL (JJ) = 0.0
- PT_SYS (JJ) = PTI_BLD(JJ) ! No mechanical ventilation
- PQ_SYS (JJ) = PQI_BLD(JJ) !
- PH_WASTE (JJ) = 0.0
- PLE_WASTE (JJ) = 0.0
- PFAN_POWER (JJ) = 0.0
- PHVAC_HEAT (JJ) = 0.0
+ DMT%XT_BLD_COOL (JJ) = 0.0 ! No HVAC consumption
+ DMT%XHVAC_COOL (JJ) = 0.0
+ DMT%XT_SYS (JJ) = B%XTI_BLD(JJ) ! No mechanical ventilation
+ DMT%XQ_SYS (JJ) = B%XQI_BLD(JJ) !
+ DMT%XH_WASTE (JJ) = 0.0
+ DMT%XLE_WASTE (JJ) = 0.0
+ DMT%XFAN_POWER (JJ) = 0.0
+ DMT%XHVAC_HEAT (JJ) = 0.0
!
- PM_SYS (JJ) = 0.0
- PCOP (JJ) = 0.0
- PCAP_SYS(JJ) = 0.0
+ DMT%XM_SYS (JJ) = 0.0
+ DMT%XCOP (JJ) = 0.0
+ DMT%XCAP_SYS(JJ) = 0.0
!
! *If natural surventilation INACTIVE
ELSE
- !
- ZNAT_VENT(JJ) = 0.
- !
- ! ------------------------------------------------
- ! * Building energy demand for heating and cooling
- ! ------------------------------------------------
- !
- PH_BLD_COOL(JJ) = PWALL_O_BLD(JJ)/2. * (ZAC_IN_WALL_A_COOL(JJ) * (PT_WALL_A(JJ,IWALL) - PTCOOL_TARGET(JJ)) &
- + ZAC_IN_WALL_B_COOL(JJ) * (PT_WALL_B(JJ,IWALL) - PTCOOL_TARGET(JJ))) &
- + PGLAZ_O_BLD(JJ) * ZAC_IN_WIN_COOL(JJ) * (PT_WIN2(JJ) - PTCOOL_TARGET(JJ)) &
- + ZAC_IN_MASS_COOL (JJ)* PMASS_O_BLD(JJ) * (PT_MASS(JJ,1) - PTCOOL_TARGET(JJ)) &
- + ZAC_IN_ROOF_COOL (JJ) * (PT_ROOF(JJ,IROOF) - PTCOOL_TARGET(JJ)) &
- + ZAC_IN_FLOOR_COOL(JJ) * (PT_FLOOR(JJ,1) - PTCOOL_TARGET(JJ)) &
- + ZQIN(JJ) * (1 - PQIN_FRAD(JJ)) * (1 - PQIN_FLAT(JJ)) &
- + (ZINF(JJ) + ZV_VENT(JJ)) * ZRHOI(JJ) * XCPD * (PT_CANYON(JJ) - PTCOOL_TARGET(JJ))
- !
- PH_BLD_HEAT(JJ) = - ( PWALL_O_BLD(JJ)/2. * (ZAC_IN_WALL_A_HEAT(JJ) * (PT_WALL_A(JJ,IWALL) - PTHEAT_TARGET(JJ)) &
- +ZAC_IN_WALL_B_HEAT(JJ) * (PT_WALL_B(JJ,IWALL) - PTHEAT_TARGET(JJ))) &
- + PGLAZ_O_BLD(JJ) * ZAC_IN_WIN_HEAT(JJ) * (PT_WIN2(JJ) - PTHEAT_TARGET(JJ)) &
- + ZAC_IN_MASS_HEAT(JJ)* PMASS_O_BLD(JJ) * (PT_MASS(JJ,1) - PTHEAT_TARGET(JJ)) &
- + ZAC_IN_ROOF_HEAT(JJ) * (PT_ROOF(JJ,IROOF) - PTHEAT_TARGET(JJ)) &
- + ZAC_IN_FLOOR_HEAT(JJ) * (PT_FLOOR(JJ,1) - PTHEAT_TARGET(JJ)) &
- + ZQIN(JJ) * (1 - PQIN_FRAD(JJ))* (1 - PQIN_FLAT(JJ)) &
- + (ZINF(JJ) + ZV_VENT(JJ)) * ZRHOI(JJ) * XCPD * (PT_CANYON(JJ) - PTHEAT_TARGET(JJ)))
- !
-
- ZQCOOL_TARGET(JJ) = 0.62198 * PHR_TARGET(JJ) * PSAT(PTCOOL_TARGET(JJ)) / &
- (PPS(JJ)- PHR_TARGET(JJ) * PSAT(PTCOOL_TARGET(JJ)))
- !
- PLE_BLD_COOL(JJ) = ZQIN(JJ) * PQIN_FLAT(JJ) &
- + (ZINF(JJ) + ZV_VENT(JJ)) * ZRHOI(JJ) * XLVTT * (PQ_CANYON(JJ) - ZQCOOL_TARGET(JJ))
- !
-
- ZQHEAT_TARGET(JJ) = 0.62198 * PHR_TARGET(JJ) * PSAT(PTHEAT_TARGET(JJ)) / &
- (PPS(JJ)- PHR_TARGET(JJ) * PSAT(PTHEAT_TARGET(JJ)))
- !
- PLE_BLD_HEAT(JJ) = ZQIN(JJ) * PQIN_FLAT(JJ) &
- + (ZINF(JJ) + ZV_VENT(JJ)) * ZRHOI(JJ) * XLVTT * (PQ_CANYON(JJ) - ZQHEAT_TARGET(JJ))
- !
- ! * Autosize calculations
- !
- IF (OAUTOSIZE .AND. KDAY==15) THEN
+ !
+ ZNAT_VENT(JJ) = 0.
+ !
+ ! ------------------------------------------------
+ ! * Building energy demand for heating and cooling
+ ! ------------------------------------------------
+ !
+ DMT%XH_BLD_COOL(JJ) = T%XWALL_O_BLD(JJ)/2. * (ZAC_IN_WL_A_COOL(JJ) * (T%XT_WALL_A(JJ,IWL) - DMT%XTCOOL_TARGET(JJ)) &
+ + ZAC_IN_WL_B_COOL(JJ) * (T%XT_WALL_B(JJ,IWL) - DMT%XTCOOL_TARGET(JJ))) &
+ + B%XGLAZ_O_BLD(JJ) * ZAC_IN_WIN_COOL(JJ) * (B%XT_WIN2(JJ) - DMT%XTCOOL_TARGET(JJ)) &
+ + ZAC_IN_MA_COOL (JJ)* B%XMASS_O_BLD(JJ) * (B%XT_MASS(JJ,1) - DMT%XTCOOL_TARGET(JJ)) &
+ + ZAC_IN_RF_COOL(JJ) * (T%XT_ROOF(JJ,IRF) - DMT%XTCOOL_TARGET(JJ)) &
+ + ZAC_IN_FL_COOL(JJ) * (B%XT_FLOOR(JJ,1) - DMT%XTCOOL_TARGET(JJ)) &
+ + ZQIN(JJ) * (1 - B%XQIN_FRAD(JJ)) * (1 - B%XQIN_FLAT(JJ)) &
+ + (ZINF(JJ) + ZV_VENT(JJ)) * ZRHOI(JJ) * XCPD * (PT_CAN(JJ) - DMT%XTCOOL_TARGET(JJ))
+ !
+ DMT%XH_BLD_HEAT(JJ) = - ( T%XWALL_O_BLD(JJ)/2. * (ZAC_IN_WL_A_HEAT(JJ) * (T%XT_WALL_A(JJ,IWL) - DMT%XTHEAT_TARGET(JJ)) &
+ + ZAC_IN_WL_B_HEAT(JJ) * (T%XT_WALL_B(JJ,IWL) - DMT%XTHEAT_TARGET(JJ))) &
+ + B%XGLAZ_O_BLD(JJ) * ZAC_IN_WIN_HEAT(JJ) * (B%XT_WIN2(JJ) - DMT%XTHEAT_TARGET(JJ)) &
+ + ZAC_IN_MA_HEAT(JJ)* B%XMASS_O_BLD(JJ) * (B%XT_MASS(JJ,1) - DMT%XTHEAT_TARGET(JJ)) &
+ + ZAC_IN_RF_HEAT(JJ) * (T%XT_ROOF(JJ,IRF) - DMT%XTHEAT_TARGET(JJ)) &
+ + ZAC_IN_FL_HEAT(JJ) * (B%XT_FLOOR(JJ,1) - DMT%XTHEAT_TARGET(JJ)) &
+ + ZQIN(JJ) * (1 - B%XQIN_FRAD(JJ))* (1 - B%XQIN_FLAT(JJ)) &
+ + (ZINF(JJ) + ZV_VENT(JJ)) * ZRHOI(JJ) * XCPD * (PT_CAN(JJ) - DMT%XTHEAT_TARGET(JJ)))
+ !
+ ZQCOOL_TRGT(JJ) = 0.62198 * B%XHR_TARGET(JJ) * PSAT(DMT%XTCOOL_TARGET(JJ)) / &
+ (PPS(JJ)- B%XHR_TARGET(JJ) * PSAT(DMT%XTCOOL_TARGET(JJ)))
+ !
+ DMT%XLE_BLD_COOL(JJ) = ZQIN(JJ) * B%XQIN_FLAT(JJ) &
+ + (ZINF(JJ) + ZV_VENT(JJ)) * ZRHOI(JJ) * XLVTT * (PQ_CAN(JJ) - ZQCOOL_TRGT(JJ))
+ !
+ ZQHEAT_TRGT(JJ) = 0.62198 * B%XHR_TARGET(JJ) * PSAT(DMT%XTHEAT_TARGET(JJ)) / &
+ (PPS(JJ)- B%XHR_TARGET(JJ) * PSAT(DMT%XTHEAT_TARGET(JJ)))
+ !
+ DMT%XLE_BLD_HEAT(JJ) = ZQIN(JJ) * B%XQIN_FLAT(JJ) &
+ + (ZINF(JJ) + ZV_VENT(JJ)) * ZRHOI(JJ) * XLVTT * (PQ_CAN(JJ) - ZQHEAT_TRGT(JJ))
+ !
+ ! * Autosize calculations
+ !
+ IF (BOP%LAUTOSIZE .AND. KDAY==15) THEN
+ !
+ IF (DMT%XH_BLD_COOL(JJ) > B%XAUX_MAX(JJ)) THEN
+ !
+ B%XAUX_MAX (JJ) = DMT%XH_BLD_COOL(JJ)
!
- IF (PH_BLD_COOL(JJ) > PAUX_MAX(JJ)) THEN
- !
- PAUX_MAX (JJ) = PH_BLD_COOL(JJ)
- !
- ! Cooling coil sensible heat rate
- ZSHR (JJ) = MIN(XCPD * (PTCOOL_TARGET(JJ) - PT_ADP(JJ)) / &
- (ENTH_FN_T_Q(PTCOOL_TARGET(JJ),ZQCOOL_TARGET(JJ)) - &
- ENTH_FN_T_Q(PT_ADP(JJ),QSAT(PT_ADP(JJ),PPS(JJ)))), 1.)
- ! Cooling Coil Capacity [W m-2(bld)]
- PCAP_SYS_RAT(JJ) = PH_BLD_COOL(JJ) / ZSHR(JJ)
- !
- ! Cooling rated air flow rate [kg s-1 m-2(bld)]
- ZM_SYS_RAT (JJ) = PH_BLD_COOL(JJ) / XCPD / (PTCOOL_TARGET(JJ)-(14.0+273.16))
- IF (ZM_SYS_RAT(JJ) > PM_SYS_RAT(JJ)) PM_SYS_RAT(JJ) = ZM_SYS_RAT(JJ)
- !
- ! Impose condition
- IF (PM_SYS_RAT(JJ)/ZRHOI(JJ)/PCAP_SYS_RAT(JJ) < 0.00004027) THEN
- PCAP_SYS_RAT(JJ) = PM_SYS_RAT(JJ)/ZRHOI(JJ)/0.00004027
- ELSE IF (PM_SYS_RAT(JJ)/ZRHOI(JJ)/PCAP_SYS_RAT(JJ) > 0.00006041) THEN
- PCAP_SYS_RAT(JJ) = PM_SYS_RAT(JJ)/ZRHOI(JJ)/0.00006041
- END IF
- !
+ ! Cooling coil sensible heat rate
+ ZSHR (JJ) = MIN(XCPD * (DMT%XTCOOL_TARGET(JJ) - B%XT_ADP(JJ)) / &
+ (ENTH_FN_T_Q(DMT%XTCOOL_TARGET(JJ),ZQCOOL_TRGT(JJ)) - &
+ ENTH_FN_T_Q(B%XT_ADP(JJ),QSAT(B%XT_ADP(JJ),PPS(JJ)))), 1.)
+ ! Cooling Coil Capacity [W m-2(bld)]
+ B%XCAP_SYS_RAT(JJ) = DMT%XH_BLD_COOL(JJ) / ZSHR(JJ)
+ !
+ ! Cooling rated air flow rate [kg s-1 m-2(bld)]
+ ZM_SYS_RAT (JJ) = DMT%XH_BLD_COOL(JJ) / XCPD / (DMT%XTCOOL_TARGET(JJ)-(14.0+273.16))
+ IF (ZM_SYS_RAT(JJ) > B%XM_SYS_RAT(JJ)) B%XM_SYS_RAT(JJ) = ZM_SYS_RAT(JJ)
+ !
+ ! Impose condition
+ IF (B%XM_SYS_RAT(JJ)/ZRHOI(JJ)/B%XCAP_SYS_RAT(JJ) < 0.00004027) THEN
+ B%XCAP_SYS_RAT(JJ) = B%XM_SYS_RAT(JJ)/ZRHOI(JJ)/0.00004027
+ ELSE IF (B%XM_SYS_RAT(JJ)/ZRHOI(JJ)/B%XCAP_SYS_RAT(JJ) > 0.00006041) THEN
+ B%XCAP_SYS_RAT(JJ) = B%XM_SYS_RAT(JJ)/ZRHOI(JJ)/0.00006041
END IF
!
- END IF
- !
- ! * END Autosize calculations
- !
- ! * system efficiency
- ! ...................
- !
- PM_SYS (JJ) = PM_SYS_RAT (JJ)
- PCOP (JJ) = PCOP_RAT (JJ)
- PCAP_SYS(JJ) = PCAP_SYS_RAT(JJ)
- !
- ! * Mixing conditions
- ! .................
- !
- ZXMIX (JJ) = ZV_VENT(JJ) * ZRHOI(JJ) / PM_SYS(JJ)
- ZT_MIX(JJ) = ZXMIX(JJ) * PT_CANYON(JJ) + (1.-ZXMIX(JJ)) * PTI_BLD(JJ)
- ZQ_MIX(JJ) = ZXMIX(JJ) * PQ_CANYON(JJ) + (1.-ZXMIX(JJ)) * PQI_BLD(JJ)
- !
- ! ---------------------------------------------
- ! * COOLING system : Performance and Waste heat
- ! ---------------------------------------------
- !
- IF (PH_BLD_COOL(JJ) >= 0.0) THEN
+ END IF
+ !
+ END IF
+ !
+ ! * END Autosize calculations
+ !
+ ! * system efficiency
+ ! ...................
+ !
+ DMT%XM_SYS (JJ) = B%XM_SYS_RAT (JJ)
+ DMT%XCOP (JJ) = B%XCOP_RAT (JJ)
+ DMT%XCAP_SYS(JJ) = B%XCAP_SYS_RAT(JJ)
+ !
+ ! * Mixing conditions
+ ! .................
+ !
+ ZXMIX (JJ) = ZV_VENT(JJ) * ZRHOI(JJ) / DMT%XM_SYS(JJ)
+ ZT_MIX(JJ) = ZXMIX(JJ) * PT_CAN(JJ) + (1.-ZXMIX(JJ)) * B%XTI_BLD(JJ)
+ ZQ_MIX(JJ) = ZXMIX(JJ) * PQ_CAN(JJ) + (1.-ZXMIX(JJ)) * B%XQI_BLD(JJ)
+ !
+ ! ---------------------------------------------
+ ! * COOLING system : Performance and Waste heat
+ ! ---------------------------------------------
+ !
+ IF (DMT%XH_BLD_COOL(JJ) >= 0.0) THEN
+ !
+ ! *ideal system
+ IF (BOP%CCOOL_COIL=='IDEAL') THEN
!
- ! *ideal system
- IF (HCOOL_COIL=='IDEAL') THEN
- !
- PT_BLD_COOL(JJ) = PH_BLD_COOL(JJ) + PLE_BLD_COOL(JJ)
- !desactivation of LE_BLD_COOL impact on HVAC_COOL calculation
- !following too much impact in VURCA simulation (23/01/2012)
- !this would be the case for a vaporization system !
- !PHVAC_COOL (JJ) = PT_BLD_COOL(JJ) / PCOP_RAT(JJ)
- PHVAC_COOL (JJ) = PH_BLD_COOL(JJ) / PCOP_RAT(JJ)
- IF (PHVAC_COOL(JJ) < 0.0) PHVAC_COOL(JJ) = 0.0
- !
- PT_SYS(JJ) = ZT_MIX(JJ) - PH_BLD_COOL (JJ) /PM_SYS(JJ) / XCPD
- !PQ_SYS(JJ) = ZQ_MIX(JJ) - PLE_BLD_COOL(JJ) / PM_SYS(JJ)/ XLVTT
- !desactivation following too much impact in VURCA simulation
- !(23/01/2012)
- PQ_SYS(JJ) = ZQ_MIX(JJ)
- !
- PH_WASTE(JJ) = PHVAC_COOL(JJ) * (1.+PCOP_RAT(JJ)) * (1. - PF_WATER_COND(JJ))
- PLE_WASTE(JJ) = PHVAC_COOL(JJ) * (1.+PCOP_RAT(JJ)) * PF_WATER_COND(JJ)
- !
+ DMT%XT_BLD_COOL(JJ) = DMT%XH_BLD_COOL(JJ) + DMT%XLE_BLD_COOL(JJ)
+ !desactivation of LE_BLD_COOL impact on HVAC_COOL calculation
+ !following too much impact in VURCA simulation (23/01/2012)
+ !this would be the case for a vaporization system !
+ !DMT%XHVAC_COOL (JJ) = DMT%XT_BLD_COOL(JJ) / B%XCOP_RAT(JJ)
+ DMT%XHVAC_COOL (JJ) = DMT%XH_BLD_COOL(JJ) / B%XCOP_RAT(JJ)
+ IF (DMT%XHVAC_COOL(JJ) < 0.0) DMT%XHVAC_COOL(JJ) = 0.0
+ !
+ DMT%XT_SYS(JJ) = ZT_MIX(JJ) - DMT%XH_BLD_COOL (JJ) /DMT%XM_SYS(JJ) / XCPD
+ !DMT%XQ_SYS(JJ) = ZQ_MIX(JJ) - DMT%XLE_BLD_COOL(JJ) / DMT%XM_SYS(JJ)/ XLVTT
+ !desactivation following too much impact in VURCA simulation
+ !(23/01/2012)
+ DMT%XQ_SYS(JJ) = ZQ_MIX(JJ)
+ !
+ DMT%XH_WASTE(JJ) = DMT%XHVAC_COOL(JJ) * (1.+B%XCOP_RAT(JJ)) * (1. - B%XF_WATER_COND(JJ))
+ DMT%XLE_WASTE(JJ) = DMT%XHVAC_COOL(JJ) * (1.+B%XCOP_RAT(JJ)) * B%XF_WATER_COND(JJ)
+ !
! *real system
- ELSEIF (HCOOL_COIL=='DXCOIL') THEN
- !
- CALL DX_AIR_COOLING_COIL_CV(PT_CANYON(JJ), PQ_CANYON(JJ), PPS(JJ), &
- ZRHOI(JJ), ZT_MIX(JJ), ZQ_MIX(JJ), PCOP_RAT(JJ), &
- PCAP_SYS_RAT(JJ), PT_ADP(JJ), PF_WATER_COND(JJ), &
- PM_SYS(JJ), PH_BLD_COOL(JJ), PH_WASTE(JJ), PLE_WASTE(JJ), &
- PCOP(JJ), PCAP_SYS(JJ), PT_SYS(JJ), PQ_SYS(JJ), &
- PHVAC_COOL(JJ), PT_BLD_COOL(JJ) )
- !
+ ELSEIF (BOP%CCOOL_COIL=='DXCOIL') THEN
+ !
+ CALL DX_AIR_COOLING_COIL_CV(PT_CAN(JJ), PQ_CAN(JJ), PPS(JJ), ZRHOI(JJ), ZT_MIX(JJ), &
+ ZQ_MIX(JJ), B%XCOP_RAT(JJ), B%XCAP_SYS_RAT(JJ), &
+ B%XT_ADP(JJ), B%XF_WATER_COND(JJ), DMT%XM_SYS(JJ), &
+ DMT%XH_BLD_COOL(JJ), DMT%XH_WASTE(JJ), DMT%XLE_WASTE(JJ), &
+ DMT%XCOP(JJ), DMT%XCAP_SYS(JJ), DMT%XT_SYS(JJ), &
+ DMT%XQ_SYS(JJ), DMT%XHVAC_COOL(JJ), DMT%XT_BLD_COOL(JJ) )
+ !
ENDIF !end type of cooling system
!!! case of system without atmospheric releases. I-e releases in soil/water F_WATER_COND < 0
- IF (PF_WATER_COND(JJ) < 0) THEN
- PH_WASTE(JJ) = 0.
- PLE_WASTE(JJ) = 0.
+ IF (B%XF_WATER_COND(JJ) < 0) THEN
+ DMT%XH_WASTE(JJ) = 0.
+ DMT%XLE_WASTE(JJ) = 0.
ENDIF
!!!!
!
! From EP Engineering Reference (p. 647)
- PFAN_POWER(JJ) = PM_SYS(JJ) * ZFAN_AP(JJ) * ZFAN_EFF(JJ) * ZRHOI(JJ)
+ DMT%XFAN_POWER(JJ) = DMT%XM_SYS(JJ) * ZFAN_AP(JJ) * ZFAN_EFF(JJ) * ZRHOI(JJ)
!
- PH_BLD_HEAT (JJ) = 0.0
- PLE_BLD_HEAT(JJ) = 0.0
- PHVAC_HEAT (JJ) = 0.0
- !
- ! ---------------------------------------------
- ! * HEATING system : Performance and Waste heat
- ! ---------------------------------------------
- !
- ELSE IF (PH_BLD_HEAT(JJ) > 0.0) THEN
+ DMT%XH_BLD_HEAT (JJ) = 0.0
+ DMT%XLE_BLD_HEAT(JJ) = 0.0
+ DMT%XHVAC_HEAT (JJ) = 0.0
+ !
+ ! ---------------------------------------------
+ ! * HEATING system : Performance and Waste heat
+ ! ---------------------------------------------
+ !
+ ELSE IF (DMT%XH_BLD_HEAT(JJ) > 0.0) THEN
!
! *specific computation for real heating system
- IF (HHEAT_COIL .EQ. 'FINCAP') THEN
- IF (PH_BLD_HEAT(JJ) > PCAP_SYS_HEAT(JJ)) PH_BLD_HEAT(JJ) = PCAP_SYS_HEAT(JJ)
+ IF (BOP%CHEAT_COIL .EQ. 'FINCAP') THEN
+ IF (DMT%XH_BLD_HEAT(JJ) > B%XCAP_SYS_HEAT(JJ)) DMT%XH_BLD_HEAT(JJ) = B%XCAP_SYS_HEAT(JJ)
END IF
!
- PT_SYS(JJ) = ZT_MIX(JJ) + PH_BLD_HEAT(JJ) / PM_SYS(JJ) / XCPD
- PQ_SYS(JJ) = ZQ_MIX(JJ)
+ DMT%XT_SYS(JJ) = ZT_MIX(JJ) + DMT%XH_BLD_HEAT(JJ) / DMT%XM_SYS(JJ) / XCPD
+ DMT%XQ_SYS(JJ) = ZQ_MIX(JJ)
!
- PHVAC_HEAT (JJ) = PH_BLD_HEAT(JJ) / PEFF_HEAT(JJ)
- PH_WASTE (JJ) = PHVAC_HEAT(JJ) - PH_BLD_HEAT(JJ)
- PLE_WASTE (JJ) = 0.0
- PH_BLD_COOL (JJ) = 0.0
- PLE_BLD_COOL(JJ) = 0.0
- PT_BLD_COOL (JJ) = 0.0
- PHVAC_COOL (JJ) = 0.0
+ DMT%XHVAC_HEAT (JJ) = DMT%XH_BLD_HEAT(JJ) / B%XEFF_HEAT(JJ)
+ DMT%XH_WASTE (JJ) = DMT%XHVAC_HEAT(JJ) - DMT%XH_BLD_HEAT(JJ)
+ DMT%XLE_WASTE (JJ) = 0.0
+ DMT%XH_BLD_COOL (JJ) = 0.0
+ DMT%XLE_BLD_COOL(JJ) = 0.0
+ DMT%XT_BLD_COOL (JJ) = 0.0
+ DMT%XHVAC_COOL (JJ) = 0.0
! From EP Engineering Reference (p. 647)
- PFAN_POWER(JJ) = PM_SYS(JJ)*ZFAN_AP(JJ)*(ZFAN_EFF(JJ)*ZRHOI(JJ))
+ DMT%XFAN_POWER(JJ) = DMT%XM_SYS(JJ)*ZFAN_AP(JJ)*(ZFAN_EFF(JJ)*ZRHOI(JJ))
!
! ------------------------------
! * NEITHEIR COOLING NOR HEATING
@@ -749,19 +637,19 @@ DO JJ=1,SIZE(PT_CANYON)
!
ELSE
!
- PH_BLD_COOL (JJ) = 0.0
- PH_BLD_HEAT (JJ) = 0.0
- PLE_BLD_COOL(JJ) = 0.0
- PLE_BLD_HEAT(JJ) = 0.0
+ DMT%XH_BLD_COOL (JJ) = 0.0
+ DMT%XH_BLD_HEAT (JJ) = 0.0
+ DMT%XLE_BLD_COOL(JJ) = 0.0
+ DMT%XLE_BLD_HEAT(JJ) = 0.0
!
- PT_BLD_COOL (JJ) = 0.0
- PHVAC_COOL (JJ) = 0.0
- PT_SYS (JJ) = ZT_MIX(JJ)
- PQ_SYS (JJ) = ZQ_MIX(JJ)
- PH_WASTE (JJ) = 0.0
- PLE_WASTE (JJ) = 0.0
- PFAN_POWER (JJ) = 0.0
- PHVAC_HEAT (JJ) = 0.0
+ DMT%XT_BLD_COOL (JJ) = 0.0
+ DMT%XHVAC_COOL (JJ) = 0.0
+ DMT%XT_SYS (JJ) = ZT_MIX(JJ)
+ DMT%XQ_SYS (JJ) = ZQ_MIX(JJ)
+ DMT%XH_WASTE (JJ) = 0.0
+ DMT%XLE_WASTE (JJ) = 0.0
+ DMT%XFAN_POWER (JJ) = 0.0
+ DMT%XHVAC_HEAT (JJ) = 0.0
!
END IF !end for heating/cooling sytem
!
@@ -776,44 +664,36 @@ ENDDO
! EVOLUTION OF THE INTERNAL TEMPERATURE AND HUMIDITY
!###################################################
!
-ZTI_BLD(:) = ( ZTI_BLD(:) + PTSTEP/PBLD_HEIGHT(:) * &
- ((ZINF(:) + ZNAT_VENT(:)) * (PT_CANYON(:) ) &
- + PM_SYS(:) / ZRHOI(:) * (PT_SYS (:) ) ))&
- / (1. + PTSTEP/PBLD_HEIGHT(:)* &
- (ZINF(:) + ZNAT_VENT(:) + PM_SYS(:) / ZRHOI(:)) )
-ZQI_BLD(:) = ( PQI_BLD(:) + PTSTEP/PBLD_HEIGHT(:) * &
- ( ZQIN(:) * PQIN_FLAT(:) / ( ZRHOI(:) * XLVTT) &
- + (ZINF(:) + ZNAT_VENT(:)) * (PQ_CANYON(:) ) &
- + PM_SYS(:) / ZRHOI(:) * (PQ_SYS (:) ) ))&
- / (1. + PTSTEP/PBLD_HEIGHT(:)* &
- (ZINF(:) + ZNAT_VENT(:) + PM_SYS(:) / ZRHOI(:)) )
-!
+ZTI_BLD(:) = ( ZTI_BLD(:) + PTSTEP/T%XBLD_HEIGHT(:) * &
+ ((ZINF(:) + ZNAT_VENT(:)) * PT_CAN(:) + DMT%XM_SYS(:) / ZRHOI(:) * (DMT%XT_SYS(:) ) )) &
+ / (1. + PTSTEP/T%XBLD_HEIGHT(:)*(ZINF(:) + ZNAT_VENT(:) + DMT%XM_SYS(:) / ZRHOI(:)) )
+ZQI_BLD(:) = ( B%XQI_BLD(:) + PTSTEP/T%XBLD_HEIGHT(:) * &
+ (ZQIN(:) * B%XQIN_FLAT(:) / (ZRHOI(:) * XLVTT) + (ZINF(:) + ZNAT_VENT(:)) * (PQ_CAN(:)) &
+ + DMT%XM_SYS(:) / ZRHOI(:) * (DMT%XQ_SYS(:) ) ))&
+ / (1. + PTSTEP/T%XBLD_HEIGHT(:)* (ZINF(:) + ZNAT_VENT(:) + DMT%XM_SYS(:) / ZRHOI(:)) )
!
! Update variables
-PTI_BLD(:) = ZTI_BLD(:)
-PQI_BLD(:) = ZQI_BLD(:)
-
-
+B%XTI_BLD(:) = ZTI_BLD(:)
+B%XQI_BLD(:) = ZQI_BLD(:)
!
! Waste heat due to infiltration/ventilation
ZWASTE (:) = (ZINF(:)+ZV_VENT(:)+ZNAT_VENT(:)) * ZRHOI(:)
-PH_WASTE (:) = PH_WASTE (:) + ZWASTE(:) * XCPD * (PTI_BLD(:) - PT_CANYON(:))
-PLE_WASTE(:) = PLE_WASTE(:) + ZWASTE(:) * XLVTT * (PQI_BLD(:) - PQ_CANYON(:))
+DMT%XH_WASTE (:) = DMT%XH_WASTE (:) + ZWASTE(:) * XCPD * (B%XTI_BLD(:) - PT_CAN(:))
+DMT%XLE_WASTE(:) = DMT%XLE_WASTE(:) + ZWASTE(:) * XLVTT * (B%XQI_BLD(:) - PQ_CAN(:))
!
!
IF (LHOOK) CALL DR_HOOK('BEM',1,ZHOOK_HANDLE)
!
- CONTAINS
+CONTAINS
!
-SUBROUTINE GET_NAT_VENT(PPTI_BLD, PPT_CANYON, PPU_CANYON, PPGR, &
- PF_AUX, PPBLD_HEIGHT, PNAT_VENT)
+SUBROUTINE GET_NAT_VENT(PTI_BLD, PPT_CAN, PPU_CAN, PGR, PF_AUX, PPBLD_HEIGHT, PNAT_VENT)
!
IMPLICIT NONE
!
-REAL, INTENT(IN) :: PPTI_BLD
-REAL, INTENT(IN) :: PPT_CANYON
-REAL, INTENT(IN) :: PPU_CANYON
-REAL, INTENT(IN) :: PPGR
+REAL, INTENT(IN) :: PTI_BLD
+REAL, INTENT(IN) :: PPT_CAN
+REAL, INTENT(IN) :: PPU_CAN
+REAL, INTENT(IN) :: PGR
REAL, INTENT(IN) :: PF_AUX
REAL, INTENT(IN) :: PPBLD_HEIGHT
REAL, INTENT(OUT) :: PNAT_VENT
@@ -821,13 +701,13 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('BEM:GET_NAT_VENT',0,ZHOOK_HANDLE)
!
-PNAT_VENT = XG * (PPTI_BLD - PPT_CANYON)
+PNAT_VENT = XG * (PTI_BLD - PPT_CAN)
IF (PNAT_VENT .LT. 0.) THEN ! exceptional case with MANU ventilation system
PNAT_VENT= PPBLD_HEIGHT/3600. !minimum value
ELSE
- PNAT_VENT = 1./3. * (PNAT_VENT/PPT_CANYON)**(1./2.) &
- * (1.5 + PPTI_BLD/PNAT_VENT * 1./2. * PPU_CANYON**2*0.1)**(3./2.) &
- * PPGR * PF_AUX / 1.5 / 2.
+ PNAT_VENT = 1./3. * (PNAT_VENT/PPT_CAN)**(1./2.) &
+ * (1.5 + PTI_BLD/PNAT_VENT * 1./2. * PPU_CAN**2*0.1)**(3./2.) &
+ * PGR * PF_AUX / 1.5 / 2.
PNAT_VENT = MIN(PNAT_VENT, 5.0*PPBLD_HEIGHT/3600.)
ENDIF
!
diff --git a/src/SURFEX/bem_morpho.F90 b/src/SURFEX/bem_morpho.F90
index 308d7cc291395f76fed29d4c9d451490a9ac6db6..79c460a6daa4f68741290bcaa017ea78e69a6c66 100644
--- a/src/SURFEX/bem_morpho.F90
+++ b/src/SURFEX/bem_morpho.F90
@@ -3,14 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#####################################################################
-SUBROUTINE BEM_MORPHO(PBLD, PWALL_O_HOR, PBLD_HEIGHT, PFLOOR_HEIGHT, &
- PGR, PN_FLOOR, PWALL_O_BLD, PGLAZ_O_BLD, PMASS_O_BLD, &
- PFLOOR_HW_RATIO, &
- PF_FLOOR_MASS, PF_FLOOR_WALL, PF_FLOOR_WIN, &
- PF_FLOOR_ROOF, PF_WALL_FLOOR, PF_WALL_MASS, &
- PF_WALL_WIN, PF_WIN_FLOOR, PF_WIN_MASS, PF_WIN_WALL, &
- PF_MASS_FLOOR, PF_MASS_WALL, PF_MASS_WIN, PF_WASTE_CAN, &
- PF_WIN_WIN)
+SUBROUTINE BEM_MORPHO(PBLD, PWALL_O_HOR, PBLD_HEIGHT, PWALL_O_BLD, B)
!#####################################################################
!
!!**** *BEM_MORPHO
@@ -45,6 +38,8 @@ SUBROUTINE BEM_MORPHO(PBLD, PWALL_O_HOR, PBLD_HEIGHT, PFLOOR_HEIGHT,
!* 0. DECLARATIONS
! ------------
!
+USE MODD_BEM_n, ONLY : BEM_t
+!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -53,28 +48,8 @@ IMPLICIT NONE
REAL, DIMENSION(:), INTENT(IN) :: PBLD ! Urban horizontal building density
REAL, DIMENSION(:), INTENT(IN) :: PWALL_O_HOR ! Wall to horizontal surface ratio
REAL, DIMENSION(:), INTENT(IN) :: PBLD_HEIGHT ! Average building height [m]
-REAL, DIMENSION(:), INTENT(INOUT)::PFLOOR_HEIGHT ! Building floor height [m]
-REAL, DIMENSION(:), INTENT(IN) :: PGR ! Glazing ratio
-REAL, DIMENSION(:), INTENT(OUT) :: PN_FLOOR ! number of floor levels
REAL, DIMENSION(:), INTENT(OUT) :: PWALL_O_BLD ! wall surface per ground building surface [m2(wall)/m2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PGLAZ_O_BLD ! glazing surface per ground building surface [m2(glazing)/m2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PMASS_O_BLD ! thermal mass surface per ground building surface [m2(mass)/m2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PFLOOR_HW_RATIO !Height to width ratio of the floor levels
-REAL, DIMENSION(:), INTENT(OUT) :: PF_FLOOR_MASS !view factor from floor to mass (how much floor seen by mass)
-REAL, DIMENSION(:), INTENT(OUT) :: PF_FLOOR_WALL
-REAL, DIMENSION(:), INTENT(OUT) :: PF_FLOOR_WIN
-REAL, DIMENSION(:), INTENT(OUT) :: PF_FLOOR_ROOF
-REAL, DIMENSION(:), INTENT(OUT) :: PF_WALL_FLOOR
-REAL, DIMENSION(:), INTENT(OUT) :: PF_WALL_MASS
-REAL, DIMENSION(:), INTENT(OUT) :: PF_WALL_WIN
-REAL, DIMENSION(:), INTENT(OUT) :: PF_WIN_FLOOR
-REAL, DIMENSION(:), INTENT(OUT) :: PF_WIN_MASS
-REAL, DIMENSION(:), INTENT(OUT) :: PF_WIN_WALL
-REAL, DIMENSION(:), INTENT(OUT) :: PF_WIN_WIN
-REAL, DIMENSION(:), INTENT(OUT) :: PF_MASS_FLOOR
-REAL, DIMENSION(:), INTENT(OUT) :: PF_MASS_WALL
-REAL, DIMENSION(:), INTENT(OUT) :: PF_MASS_WIN
-REAL, DIMENSION(:), INTENT(INOUT)::PF_WASTE_CAN !fraction of waste heat released into the canyon
+TYPE(BEM_t), INTENT(INOUT) :: B
!
!* 0.2 Declarations of local variables
!
@@ -89,34 +64,34 @@ INTEGER :: JJ
! -------------------
!
DO JJ=1,SIZE(PBLD)
- IF (PFLOOR_HEIGHT(JJ) < 2.5) THEN
-! WRITE(ILUOUT,*) 'WARNING: PFLOOR_HEIGHT low ',PFLOOR_HEIGHT(JJ),' grid mesh number ',JJ
- PFLOOR_HEIGHT(JJ) = 2.5
+ IF (B%XFLOOR_HEIGHT(JJ) < 2.5) THEN
+! WRITE(ILUOUT,*) 'WARNING: B%XFLOOR_HEIGHT low ',B%XFLOOR_HEIGHT(JJ),' grid mesh number ',JJ
+ B%XFLOOR_HEIGHT(JJ) = 2.5
ENDIF
- IF (PFLOOR_HEIGHT(JJ) > PBLD_HEIGHT(JJ)) THEN
-! WRITE(ILUOUT,*) 'WARNING: PFLOOR_HEIGHT higher than PBLD_HEIGHT ',PFLOOR_HEIGHT(JJ),' grid mesh number ',JJ, &
+ IF (B%XFLOOR_HEIGHT(JJ) > PBLD_HEIGHT(JJ)) THEN
+! WRITE(ILUOUT,*) 'WARNING: B%XFLOOR_HEIGHT higher than PBLD_HEIGHT ',B%XFLOOR_HEIGHT(JJ),' grid mesh number ',JJ, &
! 'set to PBLD_HEIGHT'
- PFLOOR_HEIGHT(JJ) = PBLD_HEIGHT(JJ)
+ B%XFLOOR_HEIGHT(JJ) = PBLD_HEIGHT(JJ)
ENDIF
!
!* 1. Verify location of HVAC release for very extended buildings
! -----------------------------------------------------------
!
- IF (PBLD(JJ) > 0.9999 .AND. PF_WASTE_CAN(JJ) > 0.) THEN
-! WRITE(ILUOUT,*) 'WARNING: PF_WASTE_CAN cannot be higher than 0. while PBLD is 0.9999',PF_WASTE_CAN(JJ), &
+ IF (PBLD(JJ) > 0.9999 .AND. B%XF_WASTE_CAN(JJ) > 0.) THEN
+! WRITE(ILUOUT,*) 'WARNING: B%XF_WASTE_CAN cannot be higher than 0. while PBLD is 0.9999',B%XF_WASTE_CAN(JJ), &
! ' grid mesh number ',JJ,' set to 0.'
- PF_WASTE_CAN(JJ) = 0.
+ B%XF_WASTE_CAN(JJ) = 0.
ENDIF
END DO
!
!* 1. floor number, relative surf. and view factors caculation
! --------------------------------------------------------
!
-PN_FLOOR(:) = FLOAT(NINT(PBLD_HEIGHT(:) / PFLOOR_HEIGHT(:) ))
-PWALL_O_BLD(:) = PWALL_O_HOR(:) * (1. - PGR(:)) / PBLD(:) ! [m2(wall)/m2(bld)]
-PGLAZ_O_BLD(:) = PWALL_O_HOR(:) * PGR(:) / PBLD(:) ! [m2(win)/m2(bld)]
+B%XN_FLOOR(:) = FLOAT(NINT(PBLD_HEIGHT(:) / B%XFLOOR_HEIGHT(:) ))
+PWALL_O_BLD(:) = PWALL_O_HOR(:) * (1. - B%XGR(:)) / PBLD(:) ! [m2(wall)/m2(bld)]
+B%XGLAZ_O_BLD(:) = PWALL_O_HOR(:) * B%XGR(:) / PBLD(:) ! [m2(win)/m2(bld)]
-WHERE(PN_FLOOR > 1.5)
+WHERE(B%XN_FLOOR > 1.5)
!* more than 1 floor level -> the floor and the roof don't see each other
!
! ROOF
@@ -132,28 +107,28 @@ WHERE(PN_FLOOR > 1.5)
! | FLOOR |
! |---------------------|
!
- PMASS_O_BLD(:) = 2 * (PN_FLOOR(:) - 1.) ! [m2(mass)/m2(bld)]
- PFLOOR_HW_RATIO(:) = PWALL_O_HOR(:) / PN_FLOOR(:) / PBLD(:) / 2.
+ B%XMASS_O_BLD(:) = 2 * (B%XN_FLOOR(:) - 1.) ! [m2(mass)/m2(bld)]
+ B%XFLOOR_HW_RATIO(:) = PWALL_O_HOR(:) / B%XN_FLOOR(:) / PBLD(:) / 2.
!
- PF_FLOOR_MASS(:) = (PFLOOR_HW_RATIO(:)**2 + 1.)**0.5 - PFLOOR_HW_RATIO(:)
- PF_FLOOR_WALL(:) = (1. - PF_FLOOR_MASS(:)) * (1. - PGR(:))
- PF_FLOOR_WIN (:) = (1. - PF_FLOOR_MASS(:)) * PGR(:)
- PF_FLOOR_ROOF(:) = 0. ! no rad interaction between floor and roof
+ B%XF_FLOOR_MASS(:) = (B%XFLOOR_HW_RATIO(:)**2 + 1.)**0.5 - B%XFLOOR_HW_RATIO(:)
+ B%XF_FLOOR_WALL(:) = (1. - B%XF_FLOOR_MASS(:)) * (1. - B%XGR(:))
+ B%XF_FLOOR_WIN (:) = (1. - B%XF_FLOOR_MASS(:)) * B%XGR(:)
+ B%XF_FLOOR_ROOF(:) = 0. ! no rad interaction between floor and roof
!
- ZF_AUX2 (:) = (1. - PF_FLOOR_MASS(:)) / PFLOOR_HW_RATIO(:)
+ ZF_AUX2 (:) = (1. - B%XF_FLOOR_MASS(:)) / B%XFLOOR_HW_RATIO(:)
!
- PF_WALL_FLOOR(:) = ZF_AUX2(:) / ( 2.*PN_FLOOR(:) )
- PF_WALL_MASS (:) = PF_WALL_FLOOR(:) * (2.*PN_FLOOR(:)-2.)
- PF_WALL_WIN (:) = (1. - ZF_AUX2(:)) * PGR(:)
+ B%XF_WALL_FLOOR(:) = ZF_AUX2(:) / ( 2.*B%XN_FLOOR(:) )
+ B%XF_WALL_MASS (:) = B%XF_WALL_FLOOR(:) * (2.*B%XN_FLOOR(:)-2.)
+ B%XF_WALL_WIN (:) = (1. - ZF_AUX2(:)) * B%XGR(:)
!
- PF_WIN_FLOOR(:) = PF_WALL_FLOOR(:)
- PF_WIN_MASS (:) = PF_WALL_MASS (:)
- PF_WIN_WALL (:) = (1. - PF_WIN_FLOOR(:) * 2. - PF_WIN_MASS(:) ) * (1. - PGR(:))
- PF_WIN_WIN (:) = (1. - PF_WIN_FLOOR(:) * 2. - PF_WIN_MASS(:) ) * PGR(:)
+ B%XF_WIN_FLOOR(:) = B%XF_WALL_FLOOR(:)
+ B%XF_WIN_MASS (:) = B%XF_WALL_MASS (:)
+ B%XF_WIN_WALL (:) = (1. - B%XF_WIN_FLOOR(:) * 2. - B%XF_WIN_MASS(:) ) * (1. - B%XGR(:))
+ B%XF_WIN_WIN (:) = (1. - B%XF_WIN_FLOOR(:) * 2. - B%XF_WIN_MASS(:) ) * B%XGR(:)
!
- PF_MASS_FLOOR(:) = PF_FLOOR_MASS(:) / PMASS_O_BLD(:)
- PF_MASS_WALL (:) = PWALL_O_BLD(:) * PF_WALL_MASS(:) / PMASS_O_BLD(:)
- PF_MASS_WIN (:) = PGLAZ_O_BLD (:) * PF_WIN_MASS(:) / PMASS_O_BLD(:)
+ B%XF_MASS_FLOOR(:) = B%XF_FLOOR_MASS(:) / B%XMASS_O_BLD(:)
+ B%XF_MASS_WALL (:) = PWALL_O_BLD(:) * B%XF_WALL_MASS(:) / B%XMASS_O_BLD(:)
+ B%XF_MASS_WIN (:) = B%XGLAZ_O_BLD (:) * B%XF_WIN_MASS(:) / B%XMASS_O_BLD(:)
ELSE WHERE
!* 1 floor level -> no mass view factors ; roof and floor see each other
!
@@ -164,28 +139,28 @@ ELSE WHERE
! | FLOOR |
! |---------------------|
!
- PMASS_O_BLD(:) = 0.
- PFLOOR_HW_RATIO(:) = PWALL_O_HOR(:) / PBLD(:) / 2.
+ B%XMASS_O_BLD(:) = 0.
+ B%XFLOOR_HW_RATIO(:) = PWALL_O_HOR(:) / PBLD(:) / 2.
!
- PF_FLOOR_ROOF(:) = (PFLOOR_HW_RATIO(:)**2 + 1.)**0.5 - PFLOOR_HW_RATIO(:)
- PF_FLOOR_MASS(:) = 0.
- PF_FLOOR_WALL(:) = (1. - PF_FLOOR_ROOF(:)) * (1. - PGR(:))
- PF_FLOOR_WIN (:) = (1. - PF_FLOOR_ROOF(:)) * PGR(:)
+ B%XF_FLOOR_ROOF(:) = (B%XFLOOR_HW_RATIO(:)**2 + 1.)**0.5 - B%XFLOOR_HW_RATIO(:)
+ B%XF_FLOOR_MASS(:) = 0.
+ B%XF_FLOOR_WALL(:) = (1. - B%XF_FLOOR_ROOF(:)) * (1. - B%XGR(:))
+ B%XF_FLOOR_WIN (:) = (1. - B%XF_FLOOR_ROOF(:)) * B%XGR(:)
!
- ZF_AUX2 (:) = (1. - PF_FLOOR_ROOF(:)) / PFLOOR_HW_RATIO(:)
+ ZF_AUX2 (:) = (1. - B%XF_FLOOR_ROOF(:)) / B%XFLOOR_HW_RATIO(:)
!
- PF_WALL_FLOOR(:) = ZF_AUX2(:) / 2.
- PF_WALL_MASS (:) = 0.
- PF_WALL_WIN (:) = (1. - ZF_AUX2(:)) * PGR(:)
+ B%XF_WALL_FLOOR(:) = ZF_AUX2(:) / 2.
+ B%XF_WALL_MASS (:) = 0.
+ B%XF_WALL_WIN (:) = (1. - ZF_AUX2(:)) * B%XGR(:)
!
- PF_WIN_FLOOR(:) = PF_WALL_FLOOR(:)
- PF_WIN_MASS (:) = 0.
- PF_WIN_WALL (:) = (1. - PF_WIN_FLOOR(:) * 2. - PF_WIN_MASS(:) ) * (1. - PGR(:))
- PF_WIN_WIN (:) = (1. - PF_WIN_FLOOR(:) * 2. - PF_WIN_MASS(:) ) * PGR(:)
+ B%XF_WIN_FLOOR(:) = B%XF_WALL_FLOOR(:)
+ B%XF_WIN_MASS (:) = 0.
+ B%XF_WIN_WALL (:) = (1. - B%XF_WIN_FLOOR(:) * 2. - B%XF_WIN_MASS(:) ) * (1. - B%XGR(:))
+ B%XF_WIN_WIN (:) = (1. - B%XF_WIN_FLOOR(:) * 2. - B%XF_WIN_MASS(:) ) * B%XGR(:)
!
- PF_MASS_FLOOR(:) = 0.
- PF_MASS_WALL (:) = 0.
- PF_MASS_WIN (:) = 0.
+ B%XF_MASS_FLOOR(:) = 0.
+ B%XF_MASS_WALL (:) = 0.
+ B%XF_MASS_WIN (:) = 0.
END WHERE
!
END SUBROUTINE BEM_MORPHO
diff --git a/src/SURFEX/bilin.F90 b/src/SURFEX/bilin.F90
deleted file mode 100644
index f45391730a67bcd3156be3e5f3dcf1fb6aa4f6b3..0000000000000000000000000000000000000000
--- a/src/SURFEX/bilin.F90
+++ /dev/null
@@ -1,431 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE BILIN (KLUOUT,PX1,PY1,PFIELD1,PX2,PY2,PFIELD2,OINTERP)
-! #########################################################################
-!
-!!**** *BILINEAR * - subroutine to interpolate surface FIELD
-!!
-!! PURPOSE
-!! -------
-!!
-!!
-!!** METHOD
-!! ------
-!!
-!! Interpolation is bilinear, and uses 9 grid points, located in the
-!! center of model 1 grid mesh, and at the boundaries of this grid
-!! mesh (2 X limits, 2 Y limits and 4 corners).
-!! This implies that the grid mesh values located around the model 1
-!! grid mesh are not used directly. The values at the boundaries of the
-!! grid mesh are defined by the average between the middle point
-!! (this grid mesh value), and the one in the considered direction.
-!! So the eight grid meshes around the considered grid mesh are used
-!! equally.
-!! This is important to note that these average values are erased
-!! and replaced by zero if they are at the limit of any grid
-!! mesh with the zero value. This allows to insure zero value in model 2
-!! grid meshes where there was not the considered class in corresponding
-!! model 1 grid mesh, and to insure continuity of the FIELD type
-!! at such boundaries.
-!!
-!!
-!! The arrays and array index are defined on the following (model1) grid:
-!!
-!!
-!! XFIELD XFIELD XFIELD
-!! * * *
-!! i-1,j+1 i,j+1 i+1,j+1
-!!
-!!
-!!
-!! ZFIELD_XY ZFIELD_Y ZFIELD_XY
-!! * * *
-!! i,j+1 i,j+1 i+1,j+1
-!!
-!!
-!!
-!! XFIELD ZFIELD_X XFIELD ZFIELD_X XFIELD
-!! * * * * *
-!! i-1,j i,j i,j i+1,j i+1,j
-!!
-!!
-!!
-!! ZFIELD_XY ZFIELD_Y ZFIELD_XY
-!! * * *
-!! i,j i,j i+1,j
-!!
-!!
-!!
-!! XFIELD XFIELD XFIELD
-!! * * *
-!! i-1,j-1 i,j-1 i+1,j-1
-!!
-!!
-!!
-!!
-!!
-!! AUTHOR
-!! ------
-!!
-!! V. Masson * METEO-FRANCE *
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!! Original 01/2004
-! TD&DD: added OpenMP directives
-
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODI_HOR_EXTRAPOL_SURF_CHEAP
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KLUOUT ! output listing logical unit
-REAL, DIMENSION(:), INTENT(IN) :: PX1 ! X coordinate of the regular input grid
-REAL, DIMENSION(:), INTENT(IN) :: PY1 ! Y coordinate of the regular input grid
-REAL, DIMENSION(:,:), INTENT(IN) :: PFIELD1 ! FIELD on regular input grid
-REAL, DIMENSION(:), INTENT(IN) :: PX2 ! X coordinate of all points of output grid
-REAL, DIMENSION(:), INTENT(IN) :: PY2 ! Y coordinate of all points of output grid
-REAL, DIMENSION(:), INTENT(OUT) :: PFIELD2 ! FIELD on model 2
-LOGICAL, DIMENSION(:),INTENT(IN) :: OINTERP ! .true. where physical value is needed
-!
-!
-!* 0.2 Declarations of local variables for print on FM file
-!
-!
-REAL, DIMENSION (:,:), ALLOCATABLE :: ZW ! weight. 1 if defined,
- ! 0 if FIELD=XUNDEF
-REAL, DIMENSION (:,:), ALLOCATABLE :: ZW_FIELD ! weight. * FIELD
-REAL, DIMENSION (:,:), ALLOCATABLE :: ZFIELD_X ! FIELD at mesh interface
-REAL, DIMENSION (:,:), ALLOCATABLE :: ZFIELD_Y ! FIELD at mesh interface
-REAL, DIMENSION (:,:), ALLOCATABLE :: ZFIELD_XY! FIELD at mesh corner
-REAL, DIMENSION (SIZE(PX1)+1) :: ZX ! X coordinate of left limit of input meshes
-REAL, DIMENSION (SIZE(PY1)+1) :: ZY ! Y coordinate of bottom limit of input meshes
-!
-INTEGER, DIMENSION(SIZE(PFIELD2)) :: ICI, ICJ
-REAL :: ZC1_X ! coefficient for left points
-REAL :: ZC2_X ! coefficient for middle points
-REAL :: ZC3_X ! coefficient for right points
-REAL :: ZC1_Y ! coefficient for bottom points
-REAL :: ZC2_Y ! coefficient for middle points
-REAL :: ZC3_Y ! coefficient for top points
-!
-INTEGER :: IIU ! model 1 X size
-INTEGER :: IJU ! model 1 Y size
-!
-INTEGER :: JI ! grid 1 x index
-INTEGER :: JJ ! grid 1 y index
-INTEGER :: IIN ! loop counter on all input points
-!
-INTEGER :: JL ! grid 2 index
-!
-REAL :: ZEPS=1.E-3
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('BILIN_1',0,ZHOOK_HANDLE)
-
-IIU=SIZE(PFIELD1,1)
-IJU=SIZE(PFIELD1,2)
-!
-!* weighting factor
-!
-ALLOCATE(ZW(IIU,IJU))
-WHERE (PFIELD1/=XUNDEF)
- ZW=1.
-ELSEWHERE
- ZW=0.
-END WHERE
-!
-!* weighted FIELD
-!
-ALLOCATE(ZW_FIELD(IIU,IJU))
-ZW_FIELD=ZW*PFIELD1
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. FIELD type at grid mesh interfaces (in X directions)
-! ----------------------------------
-!
-ALLOCATE(ZFIELD_X(IIU+1,IJU))
-!
-!* 1.1 Standard case
-! -------------
-!
-IF (IIU>1) &
-ZFIELD_X(2:IIU ,:) = (ZW_FIELD(1:IIU-1,:)+ZW_FIELD(2:IIU,:)) &
- / MAX(ZW (1:IIU-1,:)+ZW (2:IIU,:),ZEPS)
-ZFIELD_X(1 ,:) = ZW_FIELD(1 ,:)
-ZFIELD_X( IIU+1,:) = ZW_FIELD(IIU,:)
-!
-!
-!* 1.2 FIELD type value is 0 in the grid mesh
-! --------------------------------------
-!
-WHERE ( PFIELD1(1:IIU,:)==0.)
- ZFIELD_X(1:IIU,:) = 0.
-END WHERE
-!
-WHERE ( PFIELD1(1:IIU,:)==0.)
- ZFIELD_X(2:IIU+1,:) = 0.
-END WHERE
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. FIELD type at grid mesh interfaces (in X directions)
-! ----------------------------------
-!
-ALLOCATE(ZFIELD_Y(IIU,IJU+1))
-!
-!* 2.1 Standard case
-! -------------
-!
-IF (IJU>1) &
-ZFIELD_Y(:,2:IJU ) = (ZW_FIELD(:,1:IJU-1)+ZW_FIELD(:,2:IJU)) &
- / MAX(ZW (:,1:IJU-1)+ZW (:,2:IJU),ZEPS)
-ZFIELD_Y(:,1 ) = ZW_FIELD(:,1 )
-ZFIELD_Y(:, IJU+1) = ZW_FIELD(:, IJU )
-!
-!
-!* 2.3 FIELD type value is 0 in the grid mesh
-! --------------------------------------
-!
-WHERE ( PFIELD1(:,1:IJU)==0.)
- ZFIELD_Y(:,1:IJU) = 0.
-END WHERE
-!
-WHERE ( PFIELD1(:,1:IJU)==0.)
- ZFIELD_Y(:,2:IJU+1) = 0.
-END WHERE
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. FIELD type at grid mesh corners
-! -------------------------------
-!
-ALLOCATE(ZFIELD_XY(IIU+1,IJU+1))
-!
-!* 3.1 Standard case
-! -------------
-!
-
-IF (IIU>1 .AND. IJU>1) &
-ZFIELD_XY(2:IIU ,2:IJU ) = ( ZW_FIELD(1:IIU-1,1:IJU-1) &
- + ZW_FIELD(1:IIU-1,2:IJU ) &
- + ZW_FIELD(2:IIU ,1:IJU-1) &
- + ZW_FIELD(2:IIU ,2:IJU ) ) &
- / MAX( ZW (1:IIU-1,1:IJU-1) &
- + ZW (1:IIU-1,2:IJU ) &
- + ZW (2:IIU ,1:IJU-1) &
- + ZW (2:IIU ,2:IJU ) , ZEPS)
-!
-IF (IJU>1) &
-ZFIELD_XY(1 ,2:IJU ) = ( ZW_FIELD(1 ,1:IJU-1) &
- + ZW_FIELD(1 ,2:IJU ) ) &
- / MAX( ZW (1 ,1:IJU-1) &
- + ZW (1 ,2:IJU ) , ZEPS)
-!
-IF (IJU>1) &
-ZFIELD_XY( IIU+1,2:IJU ) = ( ZW_FIELD(IIU ,1:IJU-1) &
- + ZW_FIELD(IIU ,2:IJU ) ) &
- / MAX( ZW (IIU ,1:IJU-1) &
- + ZW (IIU ,2:IJU ) , ZEPS)
-!
-IF (IIU>1) &
-ZFIELD_XY(2:IIU ,1 ) = ( ZW_FIELD(1:IIU-1,1 ) &
- + ZW_FIELD(2:IIU ,1 ) ) &
- / MAX( ZW (1:IIU-1,1 ) &
- + ZW (2:IIU ,1 ) , ZEPS)
-!
-IF (IIU>1) &
-ZFIELD_XY(2:IIU ,IJU+1 ) = ( ZW_FIELD(1:IIU-1,IJU ) &
- + ZW_FIELD(2:IIU ,IJU ) ) &
- / MAX( ZW (1:IIU-1,IJU ) &
- + ZW (2:IIU ,IJU ) , ZEPS)
-!
-ZFIELD_XY(1 ,1 ) = ( PFIELD1(1 ,1 ) )
-ZFIELD_XY(IIU+1 ,1 ) = ( PFIELD1(IIU ,1 ) )
-ZFIELD_XY(1 ,IJU+1 ) = ( PFIELD1(1 ,IJU ) )
-ZFIELD_XY(IIU+1 ,IJU+1 ) = ( PFIELD1(IIU ,IJU ) )
-!
-!* 3.2 FIELD type value is 0 in one grid mesh
-! --------------------------------------
-!
-WHERE ( PFIELD1(1:IIU,1:IJU)==0.)
- ZFIELD_XY(1:IIU,1:IJU) = 0.
-END WHERE
-!
-WHERE ( PFIELD1(1:IIU,1:IJU)==0.)
- ZFIELD_XY(1:IIU,2:IJU+1) = 0.
-END WHERE
-!
-WHERE ( PFIELD1(1:IIU,1:IJU)==0.)
- ZFIELD_XY(2:IIU+1,1:IJU) = 0.
-END WHERE
-!
-WHERE ( PFIELD1(1:IIU,1:IJU)==0.)
- ZFIELD_XY(2:IIU+1,2:IJU+1) = 0.
-END WHERE
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. Coordinates of points between input grid points
-! -----------------------------------------------
-!
-IF (IIU>1) THEN
- ZX(IIU+1) = 1.5*PX1(IIU) -0.5*PX1(IIU-1)
- ZX(2:IIU) = 0.5*PX1(1:IIU-1)+0.5*PX1(2:IIU)
- ZX(1) = 1.5*PX1(1) -0.5*PX1(2)
-ELSE
- ZX(1) = PX1(1) - 1.E6 ! uniform field in X direction if only 1 point is
- ZX(2) = PX1(1) + 1.E6 ! available. Arbitrary mesh length of 2000km assumed
-END IF
-!
-IF (IJU>1) THEN
- ZY(IJU+1) = 1.5*PY1(IJU) -0.5*PY1(IJU-1)
- ZY(2:IJU) = 0.5*PY1(1:IJU-1)+0.5*PY1(2:IJU)
- ZY(1) = 1.5*PY1(1) -0.5*PY1(2)
-ELSE
- ZY(1) = PY1(1) - 1.E6 ! uniform field in Y direction if only 1 point is
- ZY(2) = PY1(1) + 1.E6 ! available. Arbitrary mesh length of 2000km assumed
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. Interpolation
-! -------------
-!
-PFIELD2(:) = XUNDEF
-!
-!* loop on all output grid points
-!
-IF (LHOOK) CALL DR_HOOK('BILIN_1',1,ZHOOK_HANDLE)
-IF (LHOOK) CALL DR_HOOK('BILIN_2',0,ZHOOK_HANDLE)
-!
-ICI(:) = 1
-ICJ(:) = 1
-!$OMP PARALLEL DO PRIVATE(JL,JJ)
-DO JL=1,SIZE(PFIELD2)
- DO JJ=SIZE(ZX),1,-1
- IF (ZX(JJ)<=PX2(JL)) THEN
- ICI(JL) = JJ
- EXIT
- ENDIF
- ENDDO
- DO JJ=SIZE(ZY),1,-1
- IF (ZY(JJ)<=PY2(JL)) THEN
- ICJ(JL) = JJ
- EXIT
- ENDIF
- ENDDO
-ENDDO
-!$OMP END PARALLEL DO
-
-IF (LHOOK) CALL DR_HOOK('BILIN_2',1,ZHOOK_HANDLE)
-IF (LHOOK) CALL DR_HOOK('BILIN_3',0,ZHOOK_HANDLE)
-
-DO JL=1,SIZE(PFIELD2,1)
-!
-!* interpolation weights in X direction
-!
- JI=ICI(JL)
- JI=MAX(MIN(JI,IIU),0)
- IF (PX1(JI)<=PX2(JL)) THEN
- ZC2_X = (PX2(JL)-ZX(JI+1))/(PX1(JI)-ZX(JI+1))
- ZC2_X = MAX(MIN(ZC2_X,1.),0.)
- ZC3_X = 1. - ZC2_X
- ZC1_X = 0.
- ELSE
- ZC2_X = (PX2(JL)-ZX(JI))/(PX1(JI)-ZX(JI))
- ZC2_X = MAX(MIN(ZC2_X,1.),0.)
- ZC1_X = 1. - ZC2_X
- ZC3_X = 0.
- END IF
-!
-! interpolation weights in Y direction
-!
- JJ=ICJ(JL)
- JJ=MAX(MIN(JJ,IJU),0)
- IF (PY1(JJ)<=PY2(JL)) THEN
- ZC2_Y = (PY2(JL)-ZY(JJ+1))/(PY1(JJ)-ZY(JJ+1))
- ZC2_Y = MAX(MIN(ZC2_Y,1.),0.)
- ZC3_Y = 1. - ZC2_Y
- ZC1_Y = 0.
- ELSE
- ZC2_Y = (PY2(JL)-ZY(JJ))/(PY1(JJ)-ZY(JJ))
- ZC2_Y = MAX(MIN(ZC2_Y,1.),0.)
- ZC1_Y = 1. - ZC2_Y
- ZC3_Y = 0.
- END IF
-!
-!* interpolation
-!
- IF(PFIELD1(JI,JJ) /= XUNDEF) &
- PFIELD2(JL) = &
- ZC1_Y * ( ZC1_X * ZFIELD_XY(JI ,JJ ) &
- + ZC2_X * ZFIELD_Y (JI ,JJ ) &
- + ZC3_X * ZFIELD_XY(JI+1,JJ ) ) &
- + ZC2_Y * ( ZC1_X * ZFIELD_X (JI ,JJ ) &
- + ZC2_X * PFIELD1 (JI ,JJ ) &
- + ZC3_X * ZFIELD_X (JI+1,JJ ) ) &
- + ZC3_Y * ( ZC1_X * ZFIELD_XY(JI ,JJ+1) &
- + ZC2_X * ZFIELD_Y (JI ,JJ+1) &
- + ZC3_X * ZFIELD_XY(JI+1,JJ+1) )
-
-END DO
-!
-IF (LHOOK) CALL DR_HOOK('BILIN_3',1,ZHOOK_HANDLE)
-IF (LHOOK) CALL DR_HOOK('BILIN_4',0,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-DEALLOCATE(ZW)
-DEALLOCATE(ZW_FIELD)
-DEALLOCATE(ZFIELD_X )
-DEALLOCATE(ZFIELD_Y )
-DEALLOCATE(ZFIELD_XY)
-!
-!-------------------------------------------------------------------------------
-!
-WHERE(ABS(PFIELD2-XUNDEF)<1.E-6) PFIELD2=XUNDEF
-!
-!------------------------------------------------------------------------------
-!
-!* 6. EXTRAPOLATIONS IF SOME POINTS WERE NOT INTERPOLATED
-! ---------------------------------------------------
-!
-!* no missing point
-IF (COUNT(PFIELD2(:)==XUNDEF .AND. OINTERP(:))==0 .AND. LHOOK) CALL DR_HOOK('BILIN',1,ZHOOK_HANDLE)
-IF (COUNT(PFIELD2(:)==XUNDEF .AND. OINTERP(:))==0) RETURN
-!
-!* no data point
-IF (COUNT(PFIELD1(:,:)/=XUNDEF)==0 .AND. LHOOK) CALL DR_HOOK('BILIN',1,ZHOOK_HANDLE)
-IF (COUNT(PFIELD1(:,:)/=XUNDEF)==0) RETURN
-!
-WRITE(KLUOUT,*) ' Remaining horizontal extrapolations'
-WRITE(KLUOUT,*) ' Total number of input data : ',COUNT(PFIELD1(:,:)/=XUNDEF)
-WRITE(KLUOUT,*) ' Number of points to interpolate: ',COUNT(PFIELD2(:)==XUNDEF .AND. OINTERP(:))
-!
-!* input grid coordinates
-!
- CALL HOR_EXTRAPOL_SURF_CHEAP(KLUOUT,'XY ',PY1,PX1,PFIELD1,PY2,PX2,PFIELD2,OINTERP)
-!
-IF (LHOOK) CALL DR_HOOK('BILIN_4',1,ZHOOK_HANDLE)
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE BILIN
diff --git a/src/SURFEX/bilin_coef.F90 b/src/SURFEX/bilin_coef.F90
new file mode 100644
index 0000000000000000000000000000000000000000..e247d0c9e655ebf32ac5f0017e92ebab3ca13af0
--- /dev/null
+++ b/src/SURFEX/bilin_coef.F90
@@ -0,0 +1,230 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE BILIN_COEF (KLUOUT,PX1,PY1,PX2,PY2,PCX,PCY,KCI,KCJ)
+! #########################################################################
+!
+!!**** *BILIN_COEFEAR * - subroutine to interpolate surface FIELD
+!!
+!! PURPOSE
+!! -------
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!! Interpolation is bilinear, and uses 9 grid points, located in the
+!! center of model 1 grid mesh, and at the boundaries of this grid
+!! mesh (2 X limits, 2 Y limits and 4 corners).
+!! This implies that the grid mesh values located around the model 1
+!! grid mesh are not used directly. The values at the boundaries of the
+!! grid mesh are defined by the average between the middle point
+!! (this grid mesh value), and the one in the considered direction.
+!! So the eight grid meshes around the considered grid mesh are used
+!! equally.
+!! This is important to note that these average values are erased
+!! and replaced by zero if they are at the limit of any grid
+!! mesh with the zero value. This allows to insure zero value in model 2
+!! grid meshes where there was not the considered class in corresponding
+!! model 1 grid mesh, and to insure continuity of the FIELD type
+!! at such boundaries.
+!!
+!!
+!! The arrays and array index are defined on the following (model1) grid:
+!!
+!!
+!! XFIELD XFIELD XFIELD
+!! * * *
+!! i-1,j+1 i,j+1 i+1,j+1
+!!
+!!
+!!
+!! ZFIELD_XY ZFIELD_Y ZFIELD_XY
+!! * * *
+!! i,j+1 i,j+1 i+1,j+1
+!!
+!!
+!!
+!! XFIELD ZFIELD_X XFIELD ZFIELD_X XFIELD
+!! * * * * *
+!! i-1,j i,j i,j i+1,j i+1,j
+!!
+!!
+!!
+!! ZFIELD_XY ZFIELD_Y ZFIELD_XY
+!! * * *
+!! i,j i,j i+1,j
+!!
+!!
+!!
+!! XFIELD XFIELD XFIELD
+!! * * *
+!! i-1,j-1 i,j-1 i+1,j-1
+!!
+!!
+!!
+!!
+!!
+!! AUTHOR
+!! ------
+!!
+!! V. Masson * METEO-FRANCE *
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! Original 01/2004
+! TD&DD: added OpenMP directives
+
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_SURFEX_MPI, ONLY : NRANK
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KLUOUT ! output listing logical unit
+REAL, DIMENSION(:), INTENT(IN) :: PX1 ! X coordinate of the regular input grid
+REAL, DIMENSION(:), INTENT(IN) :: PY1 ! Y coordinate of the regular input grid
+REAL, DIMENSION(:), INTENT(IN) :: PX2 ! X coordinate of all points of output grid
+REAL, DIMENSION(:), INTENT(IN) :: PY2 ! Y coordinate of all points of output grid
+REAL, DIMENSION(:,:), INTENT(OUT) :: PCX, PCY
+INTEGER, DIMENSION(:), INTENT(OUT):: KCI, KCJ
+
+!
+!* 0.2 Declarations of local variables for print on FM file
+!
+!
+REAL, DIMENSION (SIZE(PX1)+1) :: ZX ! X coordinate of left limit of input meshes
+REAL, DIMENSION (SIZE(PY1)+1) :: ZY ! Y coordinate of bottom limit of input meshes
+!
+!
+INTEGER :: IIU ! model 1 X size
+INTEGER :: IJU ! model 1 Y size
+!
+INTEGER :: IDMIN, IDMAX
+INTEGER :: JI ! grid 1 x index
+INTEGER :: JJ ! grid 1 y index
+INTEGER :: IIN ! loop counter on all input points
+!
+INTEGER :: JL ! grid 2 index
+!
+REAL :: ZEPS=1.E-3
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('BILIN_COEF_1',0,ZHOOK_HANDLE)
+
+IIU=SIZE(PX1)
+IJU=SIZE(PY1)
+!
+!* 4. Coordinates of points between input grid points
+! -----------------------------------------------
+!
+IF (IIU>1) THEN
+ ZX(1) = 1.5*PX1(1) -0.5*PX1(2)
+ ZX(IIU+1) = 1.5*PX1(IIU)-0.5*PX1(IIU-1)
+ DO JJ = 2,IIU
+ ZX(JJ) = 0.5*(PX1(JJ-1)+PX1(JJ))
+ ENDDO
+ELSE
+ ZX(1) = PX1(1) - 1.E6 ! uniform field in X direction if only 1 point is
+ ZX(2) = PX1(1) + 1.E6 ! available. Arbitrary mesh length of 2000km assumed
+END IF
+!
+IF (IJU>1) THEN
+ ZY(1) = 1.5*PY1(1) -0.5*PY1(2)
+ ZY(IJU+1) = 1.5*PY1(IJU)-0.5*PY1(IJU-1)
+ DO JJ = 2,IJU
+ ZY(JJ) = 0.5*(PY1(JJ-1)+PY1(JJ))
+ ENDDO
+ELSE
+ ZY(1) = PY1(1) - 1.E6 ! uniform field in Y direction if only 1 point is
+ ZY(2) = PY1(1) + 1.E6 ! available. Arbitrary mesh length of 2000km assumed
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. Interpolation
+! -------------
+!
+!* loop on all output grid points
+!
+KCI(:) = 1
+KCJ(:) = 1
+!
+IF (LHOOK) CALL DR_HOOK('BILIN_COEF_1',1,ZHOOK_HANDLE)
+!
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('BILIN_COEF_2',0,ZHOOK_HANDLE_OMP)
+!$OMP DO PRIVATE(JL,JJ)
+DO JL=1,SIZE(PX2)
+ DO JJ=SIZE(ZX),1,-1
+ IF (ZX(JJ)<=PX2(JL)) THEN
+ KCI(JL) = JJ
+ EXIT
+ ENDIF
+ ENDDO
+ DO JJ=SIZE(ZY),1,-1
+ IF (ZY(JJ)<=PY2(JL)) THEN
+ KCJ(JL) = JJ
+ EXIT
+ ENDIF
+ ENDDO
+ENDDO
+!$OMP END DO
+IF (LHOOK) CALL DR_HOOK('BILIN_COEF_2',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
+!
+IF (LHOOK) CALL DR_HOOK('BILIN_COEF_3',0,ZHOOK_HANDLE)
+
+DO JL=1,SIZE(PX2)
+!
+!* interpolation weights in X direction
+!
+ JI=KCI(JL)
+ JI=MAX(MIN(JI,IIU),0)
+ IF (PX1(JI)<=PX2(JL)) THEN
+ PCX(JL,2) = (PX2(JL)-ZX(JI+1))/(PX1(JI)-ZX(JI+1))
+ PCX(JL,2) = MAX(MIN(PCX(JL,2),1.),0.)
+ PCX(JL,3) = 1. - PCX(JL,2)
+ PCX(JL,1) = 0.
+ ELSE
+ PCX(JL,2) = (PX2(JL)-ZX(JI))/(PX1(JI)-ZX(JI))
+ PCX(JL,2) = MAX(MIN(PCX(JL,2),1.),0.)
+ PCX(JL,1) = 1. - PCX(JL,2)
+ PCX(JL,3) = 0.
+ END IF
+!
+! interpolation weights in Y direction
+!
+ JJ=KCJ(JL)
+ JJ=MAX(MIN(JJ,IJU),0)
+ IF (PY1(JJ)<=PY2(JL)) THEN
+ PCY(JL,2) = (PY2(JL)-ZY(JJ+1))/(PY1(JJ)-ZY(JJ+1))
+ PCY(JL,2) = MAX(MIN(PCY(JL,2),1.),0.)
+ PCY(JL,3) = 1. - PCY(JL,2)
+ PCY(JL,1) = 0.
+ ELSE
+ PCY(JL,2) = (PY2(JL)-ZY(JJ))/(PY1(JJ)-ZY(JJ))
+ PCY(JL,2) = MAX(MIN(PCY(JL,2),1.),0.)
+ PCY(JL,1) = 1. - PCY(JL,2)
+ PCY(JL,3) = 0.
+ END IF
+!
+END DO
+!
+IF (LHOOK) CALL DR_HOOK('BILIN_COEF_3',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE BILIN_COEF
diff --git a/src/SURFEX/bilin_extrap.F90 b/src/SURFEX/bilin_extrap.F90
new file mode 100644
index 0000000000000000000000000000000000000000..64a7b4f28de82c807508f092b9b905f6e0b93a91
--- /dev/null
+++ b/src/SURFEX/bilin_extrap.F90
@@ -0,0 +1,164 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE BILIN_EXTRAP (KLUOUT,KX,KY,KCIJ,PX1,PY1,PFIELD1,PX2,PY2,PFIELD2,OINTERP)
+! #########################################################################
+!
+!!**** *BILIN_EXTRAPEAR * - subroutine to interpolate surface FIELD
+!!
+!! PURPOSE
+!! -------
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!! Interpolation is bilinear, and uses 9 grid points, located in the
+!! center of model 1 grid mesh, and at the boundaries of this grid
+!! mesh (2 X limits, 2 Y limits and 4 corners).
+!! This implies that the grid mesh values located around the model 1
+!! grid mesh are not used directly. The values at the boundaries of the
+!! grid mesh are defined by the average between the middle point
+!! (this grid mesh value), and the one in the considered direction.
+!! So the eight grid meshes around the considered grid mesh are used
+!! equally.
+!! This is important to note that these average values are erased
+!! and replaced by zero if they are at the limit of any grid
+!! mesh with the zero value. This allows to insure zero value in model 2
+!! grid meshes where there was not the considered class in corresponding
+!! model 1 grid mesh, and to insure continuity of the FIELD type
+!! at such boundaries.
+!!
+!!
+!! The arrays and array index are defined on the following (model1) grid:
+!!
+!!
+!! XFIELD XFIELD XFIELD
+!! * * *
+!! i-1,j+1 i,j+1 i+1,j+1
+!!
+!!
+!!
+!! ZFIELD_XY ZFIELD_Y ZFIELD_XY
+!! * * *
+!! i,j+1 i,j+1 i+1,j+1
+!!
+!!
+!!
+!! XFIELD ZFIELD_X XFIELD ZFIELD_X XFIELD
+!! * * * * *
+!! i-1,j i,j i,j i+1,j i+1,j
+!!
+!!
+!!
+!! ZFIELD_XY ZFIELD_Y ZFIELD_XY
+!! * * *
+!! i,j i,j i+1,j
+!!
+!!
+!!
+!! XFIELD XFIELD XFIELD
+!! * * *
+!! i-1,j-1 i,j-1 i+1,j-1
+!!
+!!
+!!
+!!
+!!
+!! AUTHOR
+!! ------
+!!
+!! V. Masson * METEO-FRANCE *
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! Original 01/2004
+! TD&DD: added OpenMP directives
+
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_SURFEX_MPI, ONLY : NCOMM,NPIO,NRANK,NPROC
+USE MODI_HOR_EXTRAPOL_SURF
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KLUOUT ! output listing logical unit
+INTEGER, INTENT(IN) :: KX, KY
+INTEGER, DIMENSION(:,:), INTENT(IN) :: KCIJ
+REAL, DIMENSION(:), INTENT(IN) :: PX1 ! X coordinate of the regular input grid
+REAL, DIMENSION(:), INTENT(IN) :: PY1 ! Y coordinate of the regular input grid
+REAL, DIMENSION(:,:), INTENT(IN) :: PFIELD1 ! FIELD on regular input grid
+REAL, DIMENSION(:), INTENT(IN) :: PX2 ! X coordinate of all points of output grid
+REAL, DIMENSION(:), INTENT(IN) :: PY2 ! Y coordinate of all points of output grid
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PFIELD2 ! FIELD on model 2
+LOGICAL, DIMENSION(:),INTENT(IN) :: OINTERP ! .true. where physical value is needed
+!
+!
+!* 0.2 Declarations of local variables for print on FM file
+!
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: IP
+INTEGER, DIMENSION(KY) :: IX
+! Variables implied in the extension procedure
+INTEGER :: ICOUNT
+ ! Loop counters
+INTEGER :: INFOMPI, JL, JI, INL, INO
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('BILIN_EXTRAP',0,ZHOOK_HANDLE)
+!
+INO = SIZE(PFIELD2,1)
+INL = SIZE(PFIELD2,2)
+!
+!* 6. EXTRAPOLATIONS IF SOME POINTS WERE NOT INTERPOLATED
+! ---------------------------------------------------
+!
+!* no data point
+IF (NRANK==NPIO) ICOUNT = COUNT(PFIELD1(:,:)/=XUNDEF)
+IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(ICOUNT,KIND(ICOUNT)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ENDIF
+IF (ICOUNT==0 .AND. LHOOK) CALL DR_HOOK('BILIN_EXTRAP',1,ZHOOK_HANDLE)
+IF (ICOUNT==0) RETURN
+!
+DO JL=1,INL
+ WRITE(KLUOUT,*) ' Remaining horizontal extrapolations'
+ WRITE(KLUOUT,*) ' Total number of input data : ',ICOUNT,' / ',SIZE(PFIELD2(:,JL))
+ WRITE(KLUOUT,*) ' Number of points to interpolate: ',COUNT(PFIELD2(:,JL)==XUNDEF .AND. OINTERP(:))
+ENDDO
+!
+ALLOCATE(IP(INO,1))
+DO JI=1,INO
+ IP(JI,1) = KX*(KCIJ(JI,2)-1)+KCIJ(JI,1)
+ENDDO
+!* input grid coordinates
+!
+IX(:) = KX
+ CALL HOR_EXTRAPOL_SURF(KLUOUT,'XY ',KX*KY,PY1(1),PY1(KY),PX1(1),PX1(KX),KY,IX,&
+ IP,PFIELD1,PY2,PX2,PFIELD2,OINTERP)
+!
+DEALLOCATE(IP)
+!
+IF (LHOOK) CALL DR_HOOK('BILIN_EXTRAP',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE BILIN_EXTRAP
diff --git a/src/SURFEX/bilin_gridin.F90 b/src/SURFEX/bilin_gridin.F90
new file mode 100644
index 0000000000000000000000000000000000000000..cf31afcfe3fabb58a0e9f5e8a623cd9f501e5129
--- /dev/null
+++ b/src/SURFEX/bilin_gridin.F90
@@ -0,0 +1,250 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE BILIN_GRIDIN (PFIELD1,PFIELD_X,PFIELD_Y,PFIELD_XY)
+! #########################################################################
+!
+!!**** *BILIN_GRIDINEAR * - subroutine to interpolate surface FIELD
+!!
+!! PURPOSE
+!! -------
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!! Interpolation is bilinear, and uses 9 grid points, located in the
+!! center of model 1 grid mesh, and at the boundaries of this grid
+!! mesh (2 X limits, 2 Y limits and 4 corners).
+!! This implies that the grid mesh values located around the model 1
+!! grid mesh are not used directly. The values at the boundaries of the
+!! grid mesh are defined by the average between the middle point
+!! (this grid mesh value), and the one in the considered direction.
+!! So the eight grid meshes around the considered grid mesh are used
+!! equally.
+!! This is important to note that these average values are erased
+!! and replaced by zero if they are at the limit of any grid
+!! mesh with the zero value. This allows to insure zero value in model 2
+!! grid meshes where there was not the considered class in corresponding
+!! model 1 grid mesh, and to insure continuity of the FIELD type
+!! at such boundaries.
+!!
+!!
+!! The arrays and array index are defined on the following (model1) grid:
+!!
+!!
+!! XFIELD XFIELD XFIELD
+!! * * *
+!! i-1,j+1 i,j+1 i+1,j+1
+!!
+!!
+!!
+!! PFIELD_XY PFIELD_Y PFIELD_XY
+!! * * *
+!! i,j+1 i,j+1 i+1,j+1
+!!
+!!
+!!
+!! XFIELD PFIELD_X XFIELD PFIELD_X XFIELD
+!! * * * * *
+!! i-1,j i,j i,j i+1,j i+1,j
+!!
+!!
+!!
+!! PFIELD_XY PFIELD_Y PFIELD_XY
+!! * * *
+!! i,j i,j i+1,j
+!!
+!!
+!!
+!! XFIELD XFIELD XFIELD
+!! * * *
+!! i-1,j-1 i,j-1 i+1,j-1
+!!
+!!
+!!
+!!
+!!
+!! AUTHOR
+!! ------
+!!
+!! V. Masson * METEO-FRANCE *
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! Original 01/2004
+! TD&DD: added OpenMP directives
+
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_SURFEX_MPI, ONLY : NRANK
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PFIELD1 ! FIELD on regular input grid
+!
+!* 0.2 Declarations of local variables for print on FM file
+!
+REAL, DIMENSION (:,:), INTENT(OUT) :: PFIELD_X ! FIELD at mesh interface
+REAL, DIMENSION (:,:), INTENT(OUT) :: PFIELD_Y ! FIELD at mesh interface
+REAL, DIMENSION (:,:), INTENT(OUT) :: PFIELD_XY! FIELD at mesh corner
+!
+REAL, DIMENSION(:,:),ALLOCATABLE :: ZW
+INTEGER :: IIU ! model 1 X size
+INTEGER :: IJU ! model 1 Y size
+!
+INTEGER :: JI ! grid 1 x index
+!
+INTEGER :: JL ! grid 2 index
+!
+REAL :: ZEPS=1.E-3
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('BILIN_GRIDIN_1',0,ZHOOK_HANDLE)
+
+IIU=SIZE(PFIELD1,1)
+IJU=SIZE(PFIELD1,2)
+!
+ALLOCATE(ZW(IIU,IJU))
+WHERE (PFIELD1/=XUNDEF)
+ ZW=1.
+ELSEWHERE
+ ZW=0.
+END WHERE
+!
+IF (LHOOK) CALL DR_HOOK('BILIN_GRIDIN_1',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------
+!
+!* 1. FIELD type at grid mesh interfaces (in X directions)
+! ----------------------------------
+!
+PFIELD_X(:,:) = 0.
+!
+PFIELD_X(1,:) = ZW(1,:) * PFIELD1(1,:)
+PFIELD_X(IIU+1,:) = ZW(IIU,:) * PFIELD1(IIU,:)
+!
+IF (IIU>1) THEN
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+ IF (LHOOK) CALL DR_HOOK('BILIN_GRIDIN_2',0,ZHOOK_HANDLE_OMP)
+!$OMP DO SCHEDULE(DYNAMIC,1) PRIVATE(JI,JL)
+ DO JL = 1,IJU
+ DO JI = 2,IIU
+ IF (PFIELD1(JI-1,JL)/=0. .AND. PFIELD1(JI,JL)/=0.) THEN
+ PFIELD_X(JI,JL) = (ZW(JI-1,JL)*PFIELD1(JI-1,JL) + ZW(JI,JL)*PFIELD1(JI,JL)) / &
+ MAX(1.,(ZW(JI-1,JL) + ZW(JI,JL)) )
+ ENDIF
+ ENDDO
+ ENDDO
+!$OMP END DO
+ IF (LHOOK) CALL DR_HOOK('BILIN_GRIDIN_2',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. FIELD type at grid mesh interfaces (in X directions)
+! ----------------------------------
+!
+PFIELD_Y(:,:) = 0.
+!
+PFIELD_Y(:,1) = ZW(:,1) * PFIELD1(:,1)
+PFIELD_Y(:,IJU+1) = ZW(:,IJU) * PFIELD1(:,IJU)
+!
+IF (IJU>1) THEN
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+ IF (LHOOK) CALL DR_HOOK('BILIN_GRIDIN_3',0,ZHOOK_HANDLE_OMP)
+!$OMP DO SCHEDULE(DYNAMIC,1) PRIVATE(JI,JL)
+ DO JL = 2,IJU
+ DO JI = 1,IIU
+ IF (PFIELD1(JI,JL-1)/=0. .AND. PFIELD1(JI,JL)/=0.) THEN
+ PFIELD_Y(JI,JL) = (ZW(JI,JL-1)*PFIELD1(JI,JL-1) + ZW(JI,JL)*PFIELD1(JI,JL)) / &
+ MAX(1.,(ZW(JI,JL-1) + ZW(JI,JL)) )
+ ENDIF
+ ENDDO
+ ENDDO
+!$OMP END DO
+ IF (LHOOK) CALL DR_HOOK('BILIN_GRIDIN_3',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. FIELD type at grid mesh corners
+! -------------------------------
+!
+PFIELD_XY(:,:) = 0.
+!
+IF (IIU>1 .AND. IJU>1) THEN
+ !
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+ IF (LHOOK) CALL DR_HOOK('BILIN_GRIDIN_4',0,ZHOOK_HANDLE_OMP)
+!$OMP DO SCHEDULE(DYNAMIC,1) PRIVATE(JI,JL)
+ DO JL = 2,IJU
+ DO JI = 2,IIU
+ IF (PFIELD1(JI-1,JL-1)/=0. .AND. PFIELD1(JI-1,JL)/=0. .AND. &
+ PFIELD1(JI ,JL-1)/=0. .AND. PFIELD1(JI ,JL)/=0. ) THEN
+ PFIELD_XY(JI,JL) = (ZW(JI-1,JL-1)*PFIELD1(JI-1,JL-1) + ZW(JI-1,JL)*PFIELD1(JI-1,JL) + &
+ ZW(JI, JL-1)*PFIELD1(JI, JL-1) + ZW(JI, JL)*PFIELD1(JI, JL))/&
+ MAX(1.,ZW(JI-1,JL-1) + ZW(JI-1,JL) + ZW(JI,JL-1) + ZW(JI,JL))
+ ENDIF
+ ENDDO
+ ENDDO
+!$OMP END DO
+ IF (LHOOK) CALL DR_HOOK('BILIN_GRIDIN_4',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
+ !
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('BILIN_GRIDIN_5',0,ZHOOK_HANDLE)
+!
+IF (IJU>1) THEN
+ DO JL = 2,IJU
+ IF (PFIELD1(1, JL-1)/=0. .AND. PFIELD1(1, JL)/=0.) THEN
+ PFIELD_XY(1 ,JL) = (ZW(1,JL-1)*PFIELD1(1,JL-1) + ZW(1,JL)*PFIELD1(1,JL)) / &
+ MAX(1.,ZW(1,JL-1) + ZW(1,JL))
+ ENDIF
+ IF (PFIELD1(IIU,JL-1)/=0. .AND. PFIELD1(IIU,JL)/=0.) THEN
+ PFIELD_XY(IIU+1,JL) = (ZW(IIU,JL-1)*PFIELD1(IIU,JL-1) + ZW(IIU,JL)*PFIELD1(IIU,JL)) / &
+ MAX(1.,ZW(IIU,JL-1) + ZW(IIU,JL))
+ ENDIF
+ ENDDO
+ENDIF
+!
+IF (IIU>1) THEN
+ DO JI = 2,IIU
+ IF (PFIELD1(JI-1,1 )/=0. .AND. PFIELD1(JI,1 )/=0.) THEN
+ PFIELD_XY(JI,1 ) = (ZW(JI-1,1)*PFIELD1(JI-1,1) + ZW(JI,1)*PFIELD1(JI,1)) / &
+ MAX(1.,ZW(JI-1,1) + ZW(JI,1))
+ ENDIF
+ IF (PFIELD1(JI-1,IJU)/=0. .AND. PFIELD1(JI,IJU)/=0.) THEN
+ PFIELD_XY(JI,IJU+1) = (ZW(JI-1,IJU)*PFIELD1(JI-1,IJU) + ZW(JI,IJU)*PFIELD1(JI,IJU)) / &
+ MAX(1.,ZW(JI-1,IJU) + ZW(JI,IJU))
+ ENDIF
+ ENDDO
+ENDIF
+!
+PFIELD_XY(1 ,1 ) = PFIELD1(1 ,1 )
+PFIELD_XY(IIU+1,1 ) = PFIELD1(IIU,1 )
+PFIELD_XY(1 ,IJU+1) = PFIELD1(1 ,IJU)
+PFIELD_XY(IIU+1,IJU+1) = PFIELD1(IIU,IJU)
+!
+IF (LHOOK) CALL DR_HOOK('BILIN_GRIDIN_5',1,ZHOOK_HANDLE)
+!
+DEALLOCATE(ZW)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE BILIN_GRIDIN
diff --git a/src/SURFEX/bilin_value.F90 b/src/SURFEX/bilin_value.F90
new file mode 100644
index 0000000000000000000000000000000000000000..f4aac84c2e69c97f7092bddfdd7178fec9c166fc
--- /dev/null
+++ b/src/SURFEX/bilin_value.F90
@@ -0,0 +1,272 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE BILIN_VALUE (KLUOUT,KX,KY,PFIELD1,PCX,PCY,KCI,KCJ,PFIELD2)
+! #########################################################################
+!
+!!**** *BILIN_VALUEEAR * - subroutine to interpolate surface FIELD
+!!
+!! PURPOSE
+!! -------
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!! Interpolation is bilinear, and uses 9 grid points, located in the
+!! center of model 1 grid mesh, and at the boundaries of this grid
+!! mesh (2 X limits, 2 Y limits and 4 corners).
+!! This implies that the grid mesh values located around the model 1
+!! grid mesh are not used directly. The values at the boundaries of the
+!! grid mesh are defined by the average between the middle point
+!! (this grid mesh value), and the one in the considered direction.
+!! So the eight grid meshes around the considered grid mesh are used
+!! equally.
+!! This is important to note that these average values are erased
+!! and replaced by zero if they are at the limit of any grid
+!! mesh with the zero value. This allows to insure zero value in model 2
+!! grid meshes where there was not the considered class in corresponding
+!! model 1 grid mesh, and to insure continuity of the FIELD type
+!! at such boundaries.
+!!
+!!
+!! The arrays and array index are defined on the following (model1) grid:
+!!
+!!
+!! XFIELD XFIELD XFIELD
+!! * * *
+!! i-1,j+1 i,j+1 i+1,j+1
+!!
+!!
+!!
+!! ZFIELD_XY ZFIELD_Y ZFIELD_XY
+!! * * *
+!! i,j+1 i,j+1 i+1,j+1
+!!
+!!
+!!
+!! XFIELD ZFIELD_X XFIELD ZFIELD_X XFIELD
+!! * * * * *
+!! i-1,j i,j i,j i+1,j i+1,j
+!!
+!!
+!!
+!! ZFIELD_XY ZFIELD_Y ZFIELD_XY
+!! * * *
+!! i,j i,j i+1,j
+!!
+!!
+!!
+!! XFIELD XFIELD XFIELD
+!! * * *
+!! i-1,j-1 i,j-1 i+1,j-1
+!!
+!!
+!!
+!!
+!!
+!! AUTHOR
+!! ------
+!!
+!! V. Masson * METEO-FRANCE *
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! Original 01/2004
+! TD&DD: added OpenMP directives
+
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC, IDX_I
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE MODI_BILIN_GRIDIN
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KLUOUT ! output listing logical unit
+INTEGER, INTENT(IN) :: KX, KY
+REAL, DIMENSION(:,:), INTENT(IN) :: PFIELD1 ! FIELD on regular input grid
+REAL, DIMENSION(:,:), INTENT(IN) :: PCX, PCY
+INTEGER, DIMENSION(:), INTENT(IN):: KCI, KCJ
+REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELD2 ! FIELD on model 2
+!
+!* 0.2 Declarations of local variables for print on FM file
+!
+#ifdef SFX_MPI
+INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+#endif
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFIELD1,ZFIELDS
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFIELD_X, ZFIELD_Y, ZFIELD_XY
+INTEGER, DIMENSION(2) :: IB
+INTEGER, DIMENSION(2,2) :: IJEXT
+INTEGER, DIMENSION(2,2,0:NPROC-1) :: IBOR
+INTEGER :: INFOMPI, ISIZE, IS1, IS2, J, IT1, IT2
+INTEGER :: JL, JK, JI, JJ, INL ! grid 2 index
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('BILIN_VALUE_1',0,ZHOOK_HANDLE)
+!
+INL = SIZE(PFIELD2,2)
+!
+IF (SIZE(KCI)>0) THEN
+ IJEXT(1,1) = MAX(1,MINVAL(KCI)-1)
+ IJEXT(1,2) = MIN(MAXVAL(KCI)+1,KX)
+ IJEXT(2,1) = MAX(1,MINVAL(KCJ)-1)
+ IJEXT(2,2) = MIN(MAXVAL(KCJ)+1,KY)
+ELSE
+ IJEXT(:,:) = 0
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('BILIN_VALUE_1',1,ZHOOK_HANDLE)
+
+IF (LHOOK) CALL DR_HOOK('BILIN_VALUE_2',0,ZHOOK_HANDLE)
+!
+IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_GATHER(IJEXT,4*KIND(IJEXT)/4,MPI_INTEGER,&
+ IBOR,4*KIND(IBOR)/4,MPI_INTEGER,&
+ NPIO,NCOMM,INFOMPI)
+#endif
+ELSE
+ IBOR(:,:,0) = IJEXT(:,:)
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('BILIN_VALUE_2',1,ZHOOK_HANDLE)
+!
+IF (NRANK/=NPIO) THEN
+ !
+ IF (LHOOK) CALL DR_HOOK('BILIN_VALUE_3',0,ZHOOK_HANDLE)
+ !
+ IDX_I = IDX_I + 1
+ IS1 = IJEXT(1,2)-IJEXT(1,1)+1
+ IS2 = IJEXT(2,2)-IJEXT(2,1)+1
+ ISIZE = IS1*IS2
+ ALLOCATE(ZFIELD1(IS1,IS2,INL))
+#ifdef SFX_MPI
+ IF (SUM(IJEXT)/=0) &
+ CALL MPI_RECV(ZFIELD1,ISIZE*INL*KIND(ZFIELD1)/4,MPI_REAL,NPIO,IDX_I,NCOMM,ISTATUS,INFOMPI)
+#endif
+ !
+ IF (LHOOK) CALL DR_HOOK('BILIN_VALUE_3',1,ZHOOK_HANDLE)
+ !
+ELSE
+ !
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+!$OMP DO SCHEDULE(DYNAMIC,1) PRIVATE(J,IT1,IT2,ISIZE,ZFIELDS)
+ DO J=0,NPROC-1
+ !
+ IF (J/=NPIO) THEN
+ !
+ IF (LHOOK) CALL DR_HOOK('BILIN_VALUE_31',0,ZHOOK_HANDLE_OMP)
+ !
+ IT1 = IBOR(1,2,J)-IBOR(1,1,J)+1
+ IT2 = IBOR(2,2,J)-IBOR(2,1,J)+1
+ ISIZE = IT1*IT2
+ IF (SUM(IBOR(:,:,J))/=0) THEN
+ ALLOCATE(ZFIELDS(IT1,IT2,INL))
+ DO JL=IBOR(2,1,J),IBOR(2,2,J)
+ ZFIELDS(:,JL-IBOR(2,1,J)+1,:) = PFIELD1(KX*(JL-1)+IBOR(1,1,J):KX*(JL-1)+IBOR(1,2,J),:)
+ ENDDO
+#ifdef SFX_MPI
+ CALL MPI_SEND(ZFIELDS,SIZE(ZFIELDS)*KIND(ZFIELDS)/4,MPI_REAL,J,IDX_I+1,NCOMM,INFOMPI)
+#endif
+ DEALLOCATE(ZFIELDS)
+ ENDIF
+ IF (LHOOK) CALL DR_HOOK('BILIN_VALUE_31',1,ZHOOK_HANDLE_OMP)
+ !
+ ELSE
+ !
+ IF (LHOOK) CALL DR_HOOK('BILIN_VALUE_32',0,ZHOOK_HANDLE_OMP)
+ !
+ IS1 = IBOR(1,2,0)-IBOR(1,1,0)+1
+ IS2 = IBOR(2,2,0)-IBOR(2,1,0)+1
+ ISIZE = IS1*IS2
+ ALLOCATE(ZFIELD1(IS1,IS2,INL))
+ IF (SUM(IBOR(:,:,0))/=0) THEN
+ DO JL=IBOR(2,1,0),IBOR(2,2,0)
+ ZFIELD1(:,JL-IBOR(2,1,0)+1,:) = PFIELD1(KX*(JL-1)+IBOR(1,1,0):KX*(JL-1)+IBOR(1,2,0),:)
+ ENDDO
+ ENDIF
+ !
+ IF (LHOOK) CALL DR_HOOK('BILIN_VALUE_32',1,ZHOOK_HANDLE_OMP)
+ !
+ ENDIF
+ !
+ ENDDO
+!$OMP END DO
+!$OMP END PARALLEL
+ !
+ IDX_I = IDX_I + 1
+ !
+ENDIF
+!
+ALLOCATE(ZFIELD_X(IS1+1,IS2),ZFIELD_Y(IS1,IS2+1),ZFIELD_XY(IS1+1,IS2+1))
+!
+DO JK=1,INL
+ !
+ IF (LHOOK) CALL DR_HOOK('BILIN_VALUE_4',0,ZHOOK_HANDLE)
+ CALL BILIN_GRIDIN(ZFIELD1(:,:,JK),ZFIELD_X,ZFIELD_Y,ZFIELD_XY)
+ !
+ IF (LHOOK) CALL DR_HOOK('BILIN_VALUE_4',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('BILIN_VALUE_5',0,ZHOOK_HANDLE)
+ PFIELD2(:,JK) = XUNDEF
+ !
+ DO JL=1,SIZE(PFIELD2,1)
+ !
+ JI = KCI(JL) - IJEXT(1,1) + 1
+ JJ = KCJ(JL) - IJEXT(2,1) + 1
+ JI = MAX(MIN(JI,SIZE(ZFIELD1,1)),0)
+ JJ = MAX(MIN(JJ,SIZE(ZFIELD1,2)),0)
+ !
+ !* interpolation weights in X direction
+ !
+ !
+ !* interpolation
+ !
+ IF(ZFIELD1(JI,JJ,JK) /= XUNDEF) THEN
+
+ PFIELD2(JL,JK) = PCY(JL,1) * &
+ ( PCX(JL,1) * ZFIELD_XY(JI,JJ) + PCX(JL,2) * ZFIELD_Y(JI,JJ) + PCX(JL,3) * ZFIELD_XY(JI+1,JJ) ) &
+ + PCY(JL,2) * &
+ ( PCX(JL,1) * ZFIELD_X (JI,JJ) + PCX(JL,2) * ZFIELD1 (JI,JJ,JK) + PCX(JL,3) * ZFIELD_X (JI+1,JJ) ) &
+ + PCY(JL,3) * &
+ ( PCX(JL,1) * ZFIELD_XY(JI,JJ+1) + PCX(JL,2) * ZFIELD_Y(JI,JJ+1) + PCX(JL,3) * ZFIELD_XY(JI+1,JJ+1) )
+
+ ENDIF
+
+ END DO
+ !
+ IF (LHOOK) CALL DR_HOOK('BILIN_VALUE_5',1,ZHOOK_HANDLE)
+ !
+ENDDO
+!
+IF (LHOOK) CALL DR_HOOK('BILIN_VALUE_6',0,ZHOOK_HANDLE)
+!
+DEALLOCATE(ZFIELD1,ZFIELD_X,ZFIELD_Y,ZFIELD_XY)
+!
+!-------------------------------------------------------------------------------
+!
+WHERE(ABS(PFIELD2-XUNDEF)<1.E-6) PFIELD2=XUNDEF
+!
+IF (LHOOK) CALL DR_HOOK('BILIN_VALUE_6',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE BILIN_VALUE
diff --git a/src/SURFEX/bld_occ_calendar.F90 b/src/SURFEX/bld_occ_calendar.F90
index f56de734ec64b93fd7364ce20077392804470e7b..5451ba2b1c642f4425b27161ecfb477359fd7975 100644
--- a/src/SURFEX/bld_occ_calendar.F90
+++ b/src/SURFEX/bld_occ_calendar.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#####################################################################################
-SUBROUTINE BLD_OCC_CALENDAR(KYEAR, KMONTH, KDAY, PTSUN, PRESIDENTIAL, PTCOOL_TARGET_IN, PTHEAT_TARGET_IN, &
- PQIN_IN, PDT_RES, PDT_OFF, PQIN_FRAC, PTCOOL_TARGET, PTHEAT_TARGET, PQIN)
+SUBROUTINE BLD_OCC_CALENDAR(TPTIME, PTSUN, T, B, PQIN_FRAC, PTCOOL_TARGET, PTHEAT_TARGET, PQIN)
!#####################################################################################
!! **** BLD_OCC_CALENDAR *
!!
@@ -21,6 +20,11 @@ SUBROUTINE BLD_OCC_CALENDAR(KYEAR, KMONTH, KDAY, PTSUN, PRESIDENTIAL, PTCOOL_TAR
!! -------------
!! Original 02/2013
!
+USE MODD_TEB_n, ONLY : TEB_t
+USE MODD_BEM_n, ONLY : BEM_t
+!
+USE MODD_TYPE_DATE_SURF, ONLY : DATE_TIME
+!
USE MODD_CSTS, ONLY : XTT
!
USE MODI_DAY_OF_WEEK
@@ -32,17 +36,12 @@ IMPLICIT NONE
!
!! 1. declaration of arguments
!
-INTEGER,INTENT(IN) :: KYEAR ! current year (UTC)
-INTEGER,INTENT(IN) :: KMONTH ! current month (UTC)
-INTEGER,INTENT(IN) :: KDAY ! current day (UTC)
+TYPE(DATE_TIME), INTENT(INOUT) :: TPTIME
REAL, DIMENSION(:) , INTENT(IN) :: PTSUN ! current solar time (s, UTC)
!
-REAL, DIMENSION(:) , INTENT(IN) :: PRESIDENTIAL ! Residential use fraction
-REAL, DIMENSION(:) , INTENT(IN) :: PTCOOL_TARGET_IN ! Cooling setpoint of HVAC system [K] input
-REAL, DIMENSION(:) , INTENT(IN) :: PTHEAT_TARGET_IN ! Heating setpoint of HVAC system [K] input
-REAL, DIMENSION(:) , INTENT(IN) :: PQIN_IN ! Internal heat gains [W m-2(floor)] input
-REAL, INTENT(IN) :: PDT_RES ! Target temperature change when unoccupied (K) (residential buildings)
-REAL, INTENT(IN) :: PDT_OFF ! Target temperature change when unoccupied (K) (offices and commercial buildings)
+TYPE(TEB_t), INTENT(INOUT) :: T
+TYPE(BEM_t), INTENT(INOUT) :: B
+!
REAL, INTENT(IN) :: PQIN_FRAC ! Fraction of internal gains when unoccupied (-)
!
REAL, DIMENSION(:) , INTENT(OUT) :: PTCOOL_TARGET ! Cooling setpoint of HVAC system [K]
@@ -51,7 +50,7 @@ REAL, DIMENSION(:) , INTENT(OUT) :: PQIN ! Internal heat gains [W m-2(
!
!! 2. declaration of local variables
!
- CHARACTER(LEN = 6) :: CTIME ! Local time scheme (winter or summer time)
+CHARACTER(LEN = 6) :: CTIME ! Local time scheme (winter or summer time)
INTEGER :: JDOW ! day of week
INTEGER :: JJ
!
@@ -67,10 +66,10 @@ IF (LHOOK) CALL DR_HOOK('BLD_OCC_CALENDAR',0,ZTODOOK_HANDLE)
! 3. determine the day of the week and the local time scheme in France
!--------------------------------------------------------------------------------------
!
- CALL DAY_OF_WEEK(KYEAR, KMONTH, KDAY, JDOW)
+CALL DAY_OF_WEEK(TPTIME%TDATE%YEAR, TPTIME%TDATE%MONTH, TPTIME%TDATE%DAY, JDOW)
!
- CTIME = 'WINTER'
-IF (KMONTH >= 4 .AND. KMONTH <= 10) CTIME = 'SUMMER'
+CTIME = 'WINTER'
+IF (TPTIME%TDATE%MONTH >= 4 .AND. TPTIME%TDATE%MONTH <= 10) CTIME = 'SUMMER'
!
!--------------------------------------------------------------------------------------
! 4. initialisation of parameters
@@ -78,11 +77,11 @@ IF (KMONTH >= 4 .AND. KMONTH <= 10) CTIME = 'SUMMER'
!
! Parameters assigned to the occupied values - read in namelist via BATI.csv :
!
-PTHEAT_TARGET(:) = PTHEAT_TARGET_IN(:)
+PTHEAT_TARGET(:) = B%XTHEAT_TARGET(:)
!
-PTCOOL_TARGET(:) = PTCOOL_TARGET_IN(:)
+PTCOOL_TARGET(:) = B%XTCOOL_TARGET(:)
!
-PQIN(:) = PQIN_IN(:)
+PQIN(:) = B%XQIN(:)
!
ZTOD_BEG(:) = 0.
ZTOD_END(:) = 0.
@@ -93,13 +92,13 @@ ZTOD_END(:) = 0.
!
DO JJ =1,SIZE(PTSUN)
!
- IF (PRESIDENTIAL(JJ) > 0.5) THEN ! RESIDENTIAL
+ IF (T%XRESIDENTIAL(JJ) > 0.5) THEN ! RESIDENTIAL
!
IF (JDOW >= 2 .AND. JDOW <=6) THEN ! week days
ZTOD_BEG(JJ) = 9. * 3600. ! 9 UTC - WINTER time
ZTOD_END(JJ) = 17. * 3600. ! 17 UTC - WINTER time
END IF
- ZDT(JJ) = PDT_RES
+ ZDT(JJ) = T%XDT_RES
!
ELSE
!
@@ -110,7 +109,7 @@ DO JJ =1,SIZE(PTSUN)
ZTOD_BEG(JJ) = 0. * 3600. ! 0 UTC
ZTOD_END(JJ) = 24. * 3600. ! 24 UTC
END IF
- ZDT(JJ) = PDT_OFF
+ ZDT(JJ) = T%XDT_OFF
!
END IF
! adjustment of unoccupied TOD based on time scheme
@@ -132,8 +131,8 @@ DO JJ =1,SIZE(PTSUN)
( (ZTOD_BEG(JJ) > ZTOD_END(JJ)) .AND. ((PTSUN(JJ) > 0 .AND. PTSUN(JJ) < ZTOD_END(JJ)) .OR. &
(PTSUN(JJ) > ZTOD_BEG(JJ) .AND. PTSUN(JJ) < 24 * 3600.)))) THEN
!
- PTHEAT_TARGET(JJ) = PTHEAT_TARGET_IN(JJ) - ZDT(JJ)
- PTCOOL_TARGET(JJ) = PTCOOL_TARGET_IN(JJ) + ZDT(JJ)
+ PTHEAT_TARGET(JJ) = B%XTHEAT_TARGET(JJ) - ZDT(JJ)
+ PTCOOL_TARGET(JJ) = B%XTCOOL_TARGET(JJ) + ZDT(JJ)
PQIN (JJ) = PQIN_FRAC * PQIN(JJ)
ENDIF
!
diff --git a/src/SURFEX/build_emisstabn.F90 b/src/SURFEX/build_emisstabn.F90
index e964a7cf77884a30c44a2c3189226e6efcac88db..48b4dc5b2e46c4bb736f171a7542a52e3c517c6a 100644
--- a/src/SURFEX/build_emisstabn.F90
+++ b/src/SURFEX/build_emisstabn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE BUILD_EMISSTAB_n (CHU, &
- HPROGRAM,KCH,HEMIS_GR_NAME, KNBTIMES,&
+ SUBROUTINE BUILD_EMISSTAB_n (PCONVERSION, HPROGRAM,KCH,HEMIS_GR_NAME, KNBTIMES,&
KEMIS_GR_TIME,KOFFNDX,TPEMISS,KSIZE,KLUOUT, KVERB,PRHODREF)
!! #####################################################################
!!
@@ -34,10 +33,6 @@
!! EXTERNAL
!! --------
!
-!
-!
-USE MODD_CH_SURF_n, ONLY : CH_SURF_t
-!
USE MODI_CH_OPEN_INPUTB
USE MODI_READ_SURF_FIELD2D
!!
@@ -61,7 +56,7 @@ IMPLICIT NONE
!
!
!
-TYPE(CH_SURF_t), INTENT(INOUT) :: CHU
+REAL, DIMENSION(:), POINTER :: PCONVERSION
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Program name
INTEGER, INTENT(IN) :: KCH
@@ -85,7 +80,7 @@ INTEGER :: IIND1, IIND2
INTEGER :: JSPEC ! loop index
INTEGER :: ITIME ! loop index
INTEGER :: IWS_DEFAULT ! Default Memory window size for emission reading
-CHARACTER (LEN=LEN_HREC):: YRECFM ! LFI article name
+ CHARACTER (LEN=LEN_HREC):: YRECFM ! LFI article name
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -103,31 +98,29 @@ END IF
!* 1. READ DATA
! --------------
!
-!$OMP SINGLE
CALL CH_OPEN_INPUTB("EMISUNIT", KCH, KLUOUT)
!
! read unit identifier
READ(KCH,'(A3)') YUNIT
-!$OMP END SINGLE COPYPRIVATE(YUNIT)
!
!* 2. MAP DATA ONTO PROGNOSTIC VARIABLES
! ---------------------------------------
!
-ALLOCATE (CHU%XCONVERSION(SIZE(PRHODREF,1)))
+ALLOCATE (PCONVERSION(SIZE(PRHODREF,1)))
! determine the conversion factor
- CHU%XCONVERSION(:) = 1.
+ PCONVERSION(:) = 1.
SELECT CASE (YUNIT)
- CASE ('MIX') ! flux given ppp*m/s, conversion to molec/m2/s
+CASE ('MIX') ! flux given ppp*m/s, conversion to molec/m2/s
! where 1 molecule/cm2/s = (224.14/6.022136E23) ppp*m/s
- CHU%XCONVERSION(:) = XAVOGADRO * PRHODREF(:) / XMD
- CASE ('CON') ! flux given in molecules/cm2/s, conversion to molec/m2/s
- CHU%XCONVERSION(:) = 1E4
- CASE ('MOL') ! flux given in microMol/m2/day, conversion to molec/m2/s
+ PCONVERSION(:) = XAVOGADRO * PRHODREF(:) / XMD
+CASE ('CON') ! flux given in molecules/cm2/s, conversion to molec/m2/s
+ PCONVERSION(:) = 1E4
+CASE ('MOL') ! flux given in microMol/m2/day, conversion to molec/m2/s
! where 1 microMol/m2/day = (22.414/86.400)*1E-12 ppp*m/s
!XCONVERSION(:) = (22.414/86.400)*1E-12 * XAVOGADRO * PRHODREF(:) / XMD
- CHU%XCONVERSION(:) = 1E-6 * XAVOGADRO / 86400.
+ PCONVERSION(:) = 1E-6 * XAVOGADRO / 86400.
- CASE DEFAULT
+CASE DEFAULT
CALL ABOR1_SFX('CH_BUILDEMISSN: UNKNOWN CONVERSION FACTOR')
END SELECT
!
@@ -172,7 +165,7 @@ DO JSPEC=1,SIZE(TPEMISS) ! loop on offline emission species
END WHERE
DO ITIME=1,INBTS
! XCONVERSION HAS BEEN ALREADY APPLY IN CH_EMISSION_FLUXN ONLY FOR LREAD = T
- TPEMISS(JSPEC)%XEMISDATA(:,ITIME) = TPEMISS(JSPEC)%XEMISDATA(:,ITIME) * CHU%XCONVERSION(:)
+ TPEMISS(JSPEC)%XEMISDATA(:,ITIME) = TPEMISS(JSPEC)%XEMISDATA(:,ITIME) * PCONVERSION(:)
!TPEMISS(JSPEC)%XEMISDATA(:,ITIME) = TPEMISS(JSPEC)%XEMISDATA(:,ITIME)
END DO
ELSE
diff --git a/src/SURFEX/build_pronoslistn.F90 b/src/SURFEX/build_pronoslistn.F90
index ab72d61128fe7cc32e42b64cee95e4f1673b13b9..1a6ea89b708ca06906eea280609de00752a4c7ab 100644
--- a/src/SURFEX/build_pronoslistn.F90
+++ b/src/SURFEX/build_pronoslistn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE BUILD_PRONOSLIST_n (SV, &
- KEMIS_NBR,HEMIS_NAME,TPPRONOS,KCH,KLUOUT,KVERB)
+ SUBROUTINE BUILD_PRONOSLIST_n (HSV, KEMIS_NBR,HEMIS_NAME,TPPRONOS,KCH,KLUOUT,KVERB)
!! #######################################################################
!!
!!*** *BUILD_PRONOSLIST*
@@ -32,8 +31,6 @@
!! EXTERNAL
!! --------
!
-USE MODD_SV_n, ONLY : SV_t
-!
USE MODI_CH_OPEN_INPUTB
!!
!! IMPLICIT ARGUMENTS
@@ -55,7 +52,7 @@ IMPLICIT NONE
!* 0.1 declaration of arguments
!
!
-TYPE(SV_t), INTENT(INOUT) :: SV
+ CHARACTER(LEN=*), DIMENSION(:), POINTER :: HSV
!
INTEGER, INTENT(IN) :: KEMIS_NBR ! number of emitted species
CHARACTER(LEN=LEN_HREC), DIMENSION(KEMIS_NBR), INTENT(IN) :: HEMIS_NAME ! name of emitted species
@@ -87,14 +84,12 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('BUILD_PRONOSLIST_N',0,ZHOOK_HANDLE)
!
! CNAMES points on chemical variables name
- CNAMES => SV%CSV
-IEQ = SIZE(SV%CSV)
+CNAMES => HSV
+IEQ = SIZE(HSV)
!
! Namelist is opened and the agregation eq. are reached
!
-!$OMP SINGLE
CALL CH_OPEN_INPUTB("AGREGATION", KCH , KLUOUT)
-!$OMP END SINGLE
!
! Parse each eq. line and build the TPPRONOS list
!
@@ -104,9 +99,7 @@ DO
!
! Read a line and convert 'tab' to 'space' characters
! until the keyword 'END_AGREGATION' is reached
-!$OMP SINGLE
READ(KCH,'(A)',IOSTAT=IERR) YINPLINE
-!$OMP END SINGLE COPYPRIVATE(YINPLINE,IERR)
IF (IERR /= 0) EXIT
YINPLINE = TRIM(ADJUSTL(YINPLINE))
IF (LEN_TRIM(YINPLINE) == 0) CYCLE ! skip blank line
@@ -211,7 +204,7 @@ END IF
!
IF (LHOOK) CALL DR_HOOK('BUILD_PRONOSLIST_N',1,ZHOOK_HANDLE)
!
- CONTAINS
+CONTAINS
!!
!! ###########################
SUBROUTINE TAB2SPACE(HTEXT)
diff --git a/src/SURFEX/canopy.F90 b/src/SURFEX/canopy.F90
index 3858528636ba3b5d6c129f4fed4cd512575fd7d2..ea1bfee4414246f0af4408345fc41e0d1f7e9f20 100644
--- a/src/SURFEX/canopy.F90
+++ b/src/SURFEX/canopy.F90
@@ -3,13 +3,13 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE CANOPY(KI, KLVL, PZF, PDZ, PHEIGHT, PDENSITY, PCDRAG, PU, PAIRVOL, &
- PSV, PFORC, PFORC_U, PDFORC_UDU, PFORC_E, PDFORC_EDE )
+SUBROUTINE CANOPY(KI, SB, PHEIGHT, PDENSITY, PCDRAG, PAIRVOL, PSV, &
+ PFORC, PFORC_U, PDFORC_UDU, PFORC_E, PDFORC_EDE )
! ###############################################################################
!
!!**** *ISBA_CANOPY_n * - prepares forcing for canopy air model
!!
-!! PURPOSE
+!! SB%XURPOSE
!! -------
!
!!** METHOD
@@ -28,6 +28,7 @@ SUBROUTINE CANOPY(KI, KLVL, PZF, PDZ, PHEIGHT, PDENSITY, PCDRAG, PU, PAIRVOL, &
!! Original 07/2006
!!---------------------------------------------------------------
!
+USE MODD_CANOPY_n, ONLY : CANOPY_t
!
USE MODD_CSTS, ONLY : XRD, XCPD, XP00, XG
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -41,26 +42,22 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
INTEGER, INTENT(IN) :: KI ! number of points
-INTEGER, INTENT(IN) :: KLVL ! number of levels in canopy
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PZF ! heights of bottom of canopy levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDZ ! depth of canopy levels (m)
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
REAL, DIMENSION(KI), INTENT(IN) :: PHEIGHT ! canopy height (m)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDENSITY ! canopy density (-)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PCDRAG
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PDENSITY ! canopy density (-)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PCDRAG
!
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PU ! wind for each canopy layer (m/s)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PAIRVOL ! Fraction of air for each canopy level total volume
!
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PAIRVOL ! Fraction of air for each canopy level total volume
-!
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PSV ! vertical surface of building
+REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PSV ! vertical surface of building
! (walls) for each canopy level
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PFORC !
+REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PFORC !
!
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PFORC_U ! tendency of wind due to canopy drag (m/s2)
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PDFORC_UDU! formal derivative of the tendency of
+REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PFORC_U ! tendency of wind due to canopy drag (m/s2)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PDFORC_UDU! formal derivative of the tendency of
! ! wind due to canopy drag (1/s)
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PFORC_E ! tendency of TKE due to canopy drag (m2/s3)
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PDFORC_EDE! formal derivative of the tendency of
+REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PFORC_E ! tendency of TKE due to canopy drag (m2/s3)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PDFORC_EDE! formal derivative of the tendency of
! ! TKE due to canopy drag (1/s)
!
!* 0.2 declarations of local variables
@@ -79,20 +76,20 @@ IF (LHOOK) CALL DR_HOOK('CANOPY',0,ZHOOK_HANDLE)
!* 1.2 Discretization on each canopy level
!
PSV(:,:) = 0.
-DO JLAYER = 1,KLVL-1
+DO JLAYER = 1,SB%NLVL-1
!
- WHERE ( PZF(:,JLAYER) < PHEIGHT(:) )
+ WHERE ( SB%XZF(:,JLAYER) < PHEIGHT(:) )
PSV(:,JLAYER) = PDENSITY(:,JLAYER) / PHEIGHT(:)
- WHERE ( PZF(:,JLAYER+1) > PHEIGHT(:) )
- PSV(:,JLAYER) = PSV(:,JLAYER) * ( PHEIGHT(:) - PZF(:,JLAYER) )
+ WHERE ( SB%XZF(:,JLAYER+1) > PHEIGHT(:) )
+ PSV(:,JLAYER) = PSV(:,JLAYER) * ( PHEIGHT(:) - SB%XZF(:,JLAYER) )
ELSEWHERE
- PSV(:,JLAYER) = PSV(:,JLAYER) * PDZ(:,JLAYER)
+ PSV(:,JLAYER) = PSV(:,JLAYER) * SB%XDZ(:,JLAYER)
END WHERE
END WHERE
!
END DO
!
-PFORC(:,:) = PCDRAG(:,:) * PU(:,:) * PSV(:,:)/PAIRVOL(:,:)/PDZ(:,:)
+PFORC(:,:) = PCDRAG(:,:) * SB%XU(:,:) * PSV(:,:)/PAIRVOL(:,:)/SB%XDZ(:,:)
!
!-------------------------------------------------------------------------------------
!
@@ -111,7 +108,7 @@ PDFORC_UDU = 0.
!
!* drag force by vertical surfaces
!
-PFORC_U (:,:) = PFORC_U - PFORC(:,:) * PU(:,:)
+PFORC_U (:,:) = PFORC_U - PFORC(:,:) * SB%XU(:,:)
PDFORC_UDU(:,:) = PDFORC_UDU - 2. * PFORC(:,:)
!
!-------------------------------------------------------------------------------------
@@ -134,7 +131,7 @@ PDFORC_EDE(:,:) = 0.
! with Vair = Vair/Vtot * Vtot = (Vair/Vtot) * Stot * Dz
! and Sv/Vair = (Sv/Stot) * Stot/Vair = (Sv/Stot) / (Vair/Vtot) / Dz
!
-PFORC_E = PFORC_E + PFORC(:,:) * PU(:,:)**2
+PFORC_E = PFORC_E + PFORC(:,:) * SB%XU(:,:)**2
PDFORC_EDE = PDFORC_EDE + 0.
!
!
diff --git a/src/SURFEX/canopy_evol.F90 b/src/SURFEX/canopy_evol.F90
index 51791e6cfa63231fa6c8dd4a971f1d3cdb0354b2..4e611bdda833828334c3db4244b8db32d1353f61 100644
--- a/src/SURFEX/canopy_evol.F90
+++ b/src/SURFEX/canopy_evol.F90
@@ -3,13 +3,12 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########################################
- SUBROUTINE CANOPY_EVOL(KI,KLVL,PTSTEP, KIMPL, &
- PZZ,PWIND,PTA,PQA,PPA,PRHOA, &
- PSFLUX_U,PSFLUX_T,PSFLUX_Q, &
- PFORC_U,PDFORC_UDU,PFORC_E,PDFORC_EDE,PFORC_T,PDFORC_TDT, &
- PFORC_Q,PDFORC_QDQ, &
- PZ,PZF,PDZ,PDZF,PU,PTKE,PT,PQ,PLMO,PLM,PLEPS,PP,PUSTAR, &
- PALFAU,PBETAU,PALFATH,PBETATH,PALFAQ,PBETAQ, ONEUTRAL )
+ SUBROUTINE CANOPY_EVOL(SB, KI, PTSTEP, KIMPL, PZZ, PWIND, PTA, PQA, PPA, PRHOA, &
+ PSFLUX_U, PSFLUX_T, PSFLUX_Q, PFORC_U, PDFORC_UDU, &
+ PFORC_E, PDFORC_EDE, PFORC_T, PDFORC_TDT, &
+ PFORC_Q, PDFORC_QDQ, PLM, PLEPS, PUSTAR, &
+ PALFAU, PBETAU, PALFATH, PBETATH, PALFAQ, PBETAQ, &
+ ONEUTRAL )
! #########################################
!
!!**** *CANOPY_EVOL* - evolution of canopy
@@ -44,6 +43,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_CANOPY_n, ONLY : CANOPY_t
+!
USE MODD_CSTS, ONLY : XG, XRD, XCPD, XP00
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_CANOPY_TURB, ONLY : XCMFS, XCSHF
@@ -63,15 +64,16 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
+!
INTEGER, INTENT(IN) :: KI ! number of horizontal points
-INTEGER, INTENT(IN) :: KLVL ! number of levels in canopy
REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s)
INTEGER, INTENT(IN) :: KIMPL ! implicitation code:
! ! 1 : computes only alfa and beta coupling
! ! coefficients for all variables
! ! 2 : computes temporal evolution of the
! ! variables
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PZZ ! Mixing length generic profile at mid levels (-)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PZZ ! Mixing length generic profile at mid levels (-)
REAL, DIMENSION(KI), INTENT(IN) :: PWIND ! wind speed (m/s)
REAL, DIMENSION(KI), INTENT(IN) :: PTA ! Air temperature (K)
REAL, DIMENSION(KI), INTENT(IN) :: PQA ! Air humidity (kg/m3)
@@ -80,31 +82,21 @@ REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! Air density at forcing le
REAL, DIMENSION(KI), INTENT(IN) :: PSFLUX_U ! surface flux u'w' (m2/s2)
REAL, DIMENSION(KI), INTENT(IN) :: PSFLUX_T ! surface flux w'T' (Km/s)
REAL, DIMENSION(KI), INTENT(IN) :: PSFLUX_Q ! surface flux w'q' (kg/m2/s)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PFORC_U ! tendency of wind due to canopy drag (m/s2)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDFORC_UDU! formal derivative of the tendency of
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PFORC_U ! tendency of wind due to canopy drag (m/s2)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PDFORC_UDU! formal derivative of the tendency of
! ! wind due to canopy drag (1/s)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PFORC_E ! tendency of TKE due to canopy drag (m2/s3)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDFORC_EDE! formal derivative of the tendency of
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PFORC_E ! tendency of TKE due to canopy drag (m2/s3)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PDFORC_EDE! formal derivative of the tendency of
! ! TKE due to canopy drag (1/s)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PFORC_T ! tendency of Temp due to canopy drag (T/s)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDFORC_TDT! formal derivative of the tendency of
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PFORC_T ! tendency of Temp due to canopy drag (T/s)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PDFORC_TDT! formal derivative of the tendency of
! ! Temp due to canopy drag (1/s)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PFORC_Q ! tendency of Hum. due to canopy drag (kg/m3/s)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDFORC_QDQ! formal derivative of the tendency of
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PFORC_Q ! tendency of Hum. due to canopy drag (kg/m3/s)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PDFORC_QDQ! formal derivative of the tendency of
! ! Hum. due to canopy drag (1/s)
!
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PZ ! heights of canopy levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PZF ! heights of bottom of canopy levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDZ ! depth of canopy levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDZF ! depth between canopy levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PU ! wind speed at canopy levels (m/s)
-REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PTKE ! TKE at canopy levels (m2/s2)
-REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PT ! Temperature at canopy levels (K)
-REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PQ ! Humidity at canopy levels (kg/m3)
-REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PLMO ! Monin-Obhukov length (m)
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PLM ! mixing length (m)
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PLEPS ! dissipative length (m)
-REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PP ! Pressure at canopy levels (Pa)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PLM ! mixing length (m)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PLEPS ! dissipative length (m)
REAL, DIMENSION(KI), INTENT(OUT) :: PUSTAR ! friction velocity at forcing level (m/s)
!
REAL, DIMENSION(KI), INTENT(OUT) :: PALFAU ! V+(1) = alfa u'w'(1) + beta
@@ -124,22 +116,22 @@ LOGICAL :: GNEUTRAL
INTEGER :: JLAYER ! loop counter on layers
INTEGER :: JI ! loop counter
!
-REAL, DIMENSION(KI,KLVL) :: ZK ! mixing coefficient
-REAL, DIMENSION(KI,KLVL) :: ZDKDDVDZ ! formal derivative of mixing coefficient according to variable vertical gradient
-REAL, DIMENSION(KI,KLVL) :: ZTH ! potential temperature at full levels
-REAL, DIMENSION(KI) :: ZTHA ! potential temperature at forcing level
-REAL, DIMENSION(KI,KLVL) :: ZEXN ! Exner function at full levels
-REAL, DIMENSION(KI,KLVL) :: ZUW ! friction at mid levels
-REAL, DIMENSION(KI) :: ZSFLUX_TH ! Surface flux w'Th' (mK/s)
-REAL, DIMENSION(KI,KLVL) :: ZFORC_TH ! tendency of Temp due to canopy drag (T/s)
-REAL, DIMENSION(KI,KLVL) :: ZDFORC_THDTH ! formal derivative of the tendency of
+REAL, DIMENSION(KI,SB%NLVL) :: ZK ! mixing coefficient
+REAL, DIMENSION(KI,SB%NLVL) :: ZDKDDVDZ ! formal derivative of mixing coefficient according to variable vertical gradient
+REAL, DIMENSION(KI,SB%NLVL) :: ZTH ! potential temperature at full levels
+REAL, DIMENSION(KI) :: ZTHA ! potential temperature at forcing level
+REAL, DIMENSION(KI,SB%NLVL) :: ZEXN ! Exner function at full levels
+REAL, DIMENSION(KI,SB%NLVL) :: ZUW ! friction at mid levels
+REAL, DIMENSION(KI) :: ZSFLUX_TH ! Surface flux w'Th' (mK/s)
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_TH ! tendency of Temp due to canopy drag (T/s)
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_THDTH ! formal derivative of the tendency of
! ! Temp due to canopy drag (1/s)
-REAL, DIMENSION(KI,KLVL) :: ZWTH ! w'Th' at mid levels
-REAL, DIMENSION(KI,KLVL) :: ZWQ ! w'q' at mid levels
-REAL, DIMENSION(KI,KLVL) :: ZSFTH ! heat flux at atmospheric forcing level
-REAL, DIMENSION(KI,KLVL) :: ZSFRV ! vapor flux at atmospheric forcing level
-REAL :: ZZ0 ! a value of z0 just for first time-step init.
-REAL, DIMENSION(KI,KLVL) :: ZRHOA ! air density profile
+REAL, DIMENSION(KI,SB%NLVL) :: ZWTH ! w'Th' at mid levels
+REAL, DIMENSION(KI,SB%NLVL) :: ZWQ ! w'q' at mid levels
+REAL, DIMENSION(KI,SB%NLVL) :: ZSFTH ! heat flux at atmospheric forcing level
+REAL, DIMENSION(KI,SB%NLVL) :: ZSFRV ! vapor flux at atmospheric forcing level
+REAL :: ZZ0 ! a value of z0 just for first time-step init.
+REAL, DIMENSION(KI,SB%NLVL) :: ZRHOA ! air density profile
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('CANOPY_EVOL',0,ZHOOK_HANDLE)
@@ -154,9 +146,9 @@ IF (PRESENT(ONEUTRAL)) GNEUTRAL = ONEUTRAL
!* first time step (i.e. wind profile is initially zero) :
! set a neutral wind profile in relation with forcing wind
DO JI=1,KI
- IF(PWIND(JI)>0. .AND. PU(JI,KLVL-1)==0.) THEN
- ZZ0 = PZ(JI,1)/2.
- PU(JI,:) = PWIND(JI) * LOG (PZ(JI,:)/ZZ0) / LOG (PZ(JI,KLVL)/ZZ0)
+ IF(PWIND(JI)>0. .AND. SB%XU(JI,SB%NLVL-1)==0.) THEN
+ ZZ0 = SB%XZ(JI,1)/2.
+ SB%XU(JI,:) = PWIND(JI) * LOG (SB%XZ(JI,:)/ZZ0) / LOG (SB%XZ(JI,SB%NLVL)/ZZ0)
END IF
END DO
!-------------------------------------------------------------------------------
@@ -164,7 +156,7 @@ END DO
!* 5. mixing and dissipative lengths (at full levels)
! ------------------------------
!
- CALL RMC01_SURF(PZZ,PLMO,PLM,PLEPS,GNEUTRAL)
+ CALL RMC01_SURF(PZZ,SB%XLMO,PLM,PLEPS,GNEUTRAL)
!
!-------------------------------------------------------------------------------
!
@@ -175,9 +167,9 @@ END DO
! ---------------------------
!
ZK = -999.
-DO JLAYER=2,KLVL
- ZK(:,JLAYER) = 0.5 * XCMFS * PLM(:,JLAYER) * SQRT(PTKE(:,JLAYER) ) &
- + 0.5 * XCMFS * PLM(:,JLAYER-1) * SQRT(PTKE(:,JLAYER-1))
+DO JLAYER=2,SB%NLVL
+ ZK(:,JLAYER) = 0.5 * XCMFS * PLM(:,JLAYER) * SQRT(SB%XTKE(:,JLAYER) ) &
+ + 0.5 * XCMFS * PLM(:,JLAYER-1) * SQRT(SB%XTKE(:,JLAYER-1))
END DO
!
!
@@ -191,12 +183,13 @@ ZDKDDVDZ = 0.
!* 6.3 time evolution of wind in canopy
! --------------------------------
!
- CALL CANOPY_EVOL_WIND(KI,KLVL,PTSTEP,KIMPL,PWIND,ZK,ZDKDDVDZ,PSFLUX_U,PFORC_U,PDFORC_UDU,PDZ,PDZF,PU,ZUW,PALFAU,PBETAU)
+ CALL CANOPY_EVOL_WIND(SB, KI, PTSTEP, KIMPL, PWIND, ZK, ZDKDDVDZ,&
+ PSFLUX_U, PFORC_U, PDFORC_UDU, ZUW, PALFAU, PBETAU)
!
!* 6.4 Friction velocity at top of SBL layers
! --------------------------------------
!
-PUSTAR = SQRT(ABS(ZUW(:,KLVL)))
+PUSTAR = SQRT(ABS(ZUW(:,SB%NLVL)))
!
!-------------------------------------------------------------------------------
!
@@ -214,23 +207,23 @@ ELSE
!* 7.3 convertion into potential temperature (at half levels)
! -------------------------------------
!
- DO JLAYER=1,KLVL
- PP(:,JLAYER) = PPA(:) + XG * PRHOA(:) * (PZ(:,KLVL) - PZ(:,JLAYER))
+ DO JLAYER=1,SB%NLVL
+ SB%XP(:,JLAYER) = PPA(:) + XG * PRHOA(:) * (SB%XZ(:,SB%NLVL) - SB%XZ(:,JLAYER))
END DO
- ZEXN = (PP/XP00)**(XRD/XCPD)
+ ZEXN = (SB%XP/XP00)**(XRD/XCPD)
!
ZTH = XUNDEF
- WHERE(PT/=XUNDEF) ZTH(:,:) = PT(:,:) / ZEXN(:,:)
+ WHERE(SB%XT/=XUNDEF) ZTH(:,:) = SB%XT(:,:) / ZEXN(:,:)
!
- ZTHA(:) = PTA(:) / ZEXN(:,KLVL)
+ ZTHA(:) = PTA(:) / ZEXN(:,SB%NLVL)
!
!* 7.1 mixing coefficient for wind at mid layers (at half levels)
! ---------------------------
!
ZK = -999.
- DO JLAYER=2,KLVL
- ZK(:,JLAYER) = 0.5 * XCSHF * PLM(:,JLAYER) * SQRT(PTKE(:,JLAYER) ) &
- + 0.5 * XCSHF * PLM(:,JLAYER-1) * SQRT(PTKE(:,JLAYER-1))
+ DO JLAYER=2,SB%NLVL
+ ZK(:,JLAYER) = 0.5 * XCSHF * PLM(:,JLAYER) * SQRT(SB%XTKE(:,JLAYER) ) &
+ + 0.5 * XCSHF * PLM(:,JLAYER-1) * SQRT(SB%XTKE(:,JLAYER-1))
END DO
!
!* 7.2 mixing coefficient vertical derivative at mid layers (at half levels)
@@ -250,19 +243,21 @@ ELSE
!* 7.5 time evolution of temperature in canopy
! ---------------------------------------
!
- CALL CANOPY_EVOL_TEMP(KI,KLVL,PTSTEP,KIMPL,ZTHA,ZK,ZDKDDVDZ,ZSFLUX_TH,ZFORC_TH,ZDFORC_THDTH,PDZ,PDZF,ZTH,ZWTH,PALFATH,PBETATH)
+ CALL CANOPY_EVOL_TEMP(SB, KI, PTSTEP, KIMPL, ZTHA, ZK, ZDKDDVDZ, &
+ ZSFLUX_TH, ZFORC_TH, ZDFORC_THDTH, ZTH, ZWTH, PALFATH, PBETATH)
!
!* 7.6 convertion into absolute temperature
! ------------------------------------
!
- WHERE(PT/=XUNDEF) PT(:,:) = ZTH(:,:) * ZEXN(:,:)
+ WHERE(SB%XT/=XUNDEF) SB%XT(:,:) = ZTH(:,:) * ZEXN(:,:)
!
!-------------------------------------------------------------------------------
!
!* 8. time evolution of Humidity in canopy
! ------------------------------------
!
- CALL CANOPY_EVOL_TEMP(KI,KLVL,PTSTEP,KIMPL,PQA,ZK,ZDKDDVDZ,PSFLUX_Q,PFORC_Q,PDFORC_QDQ,PDZ,PDZF,PQ,ZWQ,PALFAQ,PBETAQ)
+ CALL CANOPY_EVOL_TEMP(SB, KI, PTSTEP, KIMPL, PQA, ZK, ZDKDDVDZ, &
+ PSFLUX_Q, PFORC_Q, PDFORC_QDQ, SB%XQ, ZWQ, PALFAQ, PBETAQ)
!
!-------------------------------------------------------------------------------
IF (KIMPL==1 .AND. LHOOK) CALL DR_HOOK('CANOPY_EVOL',1,ZHOOK_HANDLE)
@@ -274,8 +269,7 @@ ENDIF
!* 9. time evolution of TKE in canopy
! -------------------------------
!
- CALL CANOPY_EVOL_TKE(KI,KLVL,PTSTEP,PRHOA,PZ,PZF,PDZ,PDZF,PFORC_E,PDFORC_EDE, &
- PU,ZTH,ZUW,ZWTH,ZWQ,PLEPS,PTKE )
+ CALL CANOPY_EVOL_TKE(SB, KI, PTSTEP, PRHOA, PFORC_E, PDFORC_EDE, ZTH, ZUW, ZWTH, ZWQ, PLEPS)
!
!-------------------------------------------------------------------------------
!
@@ -290,16 +284,16 @@ IF (.NOT.GNEUTRAL) THEN
! profile, in order to avoid unrealistically small MO length when using
! small time-steps
!
- ZRHOA(:,:) = SPREAD(PRHOA(:),2,KLVL)
+ ZRHOA(:,:) = SPREAD(PRHOA(:),2,SB%NLVL)
!
ZSFTH(:,:) = ZWTH(:,:)
ZSFRV(:,:) = ZWQ (:,:) / ZRHOA(:,:)
!
- PLMO(:,:) = LMO(SQRT(ABS(ZUW)),PT,PQ,ZSFTH,ZSFRV)
+ SB%XLMO(:,:) = LMO(SQRT(ABS(ZUW)),SB%XT,SB%XQ,ZSFTH,ZSFRV)
!
- DO JLAYER=1,KLVL
- WHERE (PLMO(:,JLAYER)>0.) PLMO(:,JLAYER) = MAX(PLMO(:,JLAYER),PZ(:,KLVL))
- WHERE (PLMO(:,JLAYER)<0.) PLMO(:,JLAYER) = MIN(PLMO(:,JLAYER),-PZ(:,KLVL))
+ DO JLAYER=1,SB%NLVL
+ WHERE (SB%XLMO(:,JLAYER)>0.) SB%XLMO(:,JLAYER) = MAX(SB%XLMO(:,JLAYER),SB%XZ(:,SB%NLVL))
+ WHERE (SB%XLMO(:,JLAYER)<0.) SB%XLMO(:,JLAYER) = MIN(SB%XLMO(:,JLAYER),-SB%XZ(:,SB%NLVL))
ENDDO
!
!-------------------------------------------------------------------------------
@@ -307,13 +301,13 @@ IF (.NOT.GNEUTRAL) THEN
!* 11. Security at atmospheric forcing level
! -------------------------------------
!
- PT(:,KLVL) = PTA(:)
+ SB%XT(:,SB%NLVL) = PTA(:)
!
- PQ(:,KLVL) = PQA(:)
+ SB%XQ(:,SB%NLVL) = PQA(:)
!
ENDIF
!
-PU(:,KLVL) = PWIND(:)
+SB%XU(:,SB%NLVL) = PWIND(:)
!
IF (LHOOK) CALL DR_HOOK('CANOPY_EVOL',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/canopy_evol_neutral.F90 b/src/SURFEX/canopy_evol_neutral.F90
deleted file mode 100644
index f801b71819273750d59c9ae3e05360fd6e334c0a..0000000000000000000000000000000000000000
--- a/src/SURFEX/canopy_evol_neutral.F90
+++ /dev/null
@@ -1,193 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########################################
- SUBROUTINE CANOPY_EVOL_NEUTRAL(KI,KLVL,PTSTEP,KIMPL,PWIND,PRHOA, &
- PSFLUX_U, &
- PFORC_U,PDFORC_UDU,PFORC_E,PDFORC_EDE, &
- PZ,PZF,PDZ,PDZF,PU,PTKE,PUSTAR, &
- PALFAU,PBETAU )
-! #########################################
-!
-!!**** *CANOPY_EVOL* - evolution of canopy
-!!
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 05/2010
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CSTS, ONLY : XKARMAN
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_CANOPY_TURB, ONLY : XCMFS, XALPSBL, XCED
-!
-USE MODI_CANOPY_EVOL_WIND
-USE MODI_CANOPY_EVOL_TKE
-!
-USE MODE_SBLS
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
-INTEGER, INTENT(IN) :: KI ! number of horizontal points
-INTEGER, INTENT(IN) :: KLVL ! number of levels in canopy
-REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s)
-INTEGER, INTENT(IN) :: KIMPL ! implicitation code:
-! ! 1 : computes only alfa and beta coupling
-! ! coefficients for all variables
-! ! 2 : computes temporal evolution of the
-! ! variables
-REAL, DIMENSION(KI), INTENT(IN) :: PWIND ! wind speed (m/s)
-REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! Air density at forcing level (kg/m3)
-REAL, DIMENSION(KI), INTENT(IN) :: PSFLUX_U ! surface flux u'w' (m2/s2)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PFORC_U ! tendency of wind due to canopy drag (m/s2)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDFORC_UDU! formal derivative of the tendency of
-! ! wind due to canopy drag (1/s)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PFORC_E ! tendency of TKE due to canopy drag (m2/s3)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDFORC_EDE! formal derivative of the tendency of
-! ! TKE due to canopy drag (1/s)
-!
-REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PZ ! heights of canopy levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PZF ! heights of bottom of canopy levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDZ ! depth of canopy levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDZF ! depth between canopy levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PU ! wind speed at canopy levels (m/s)
-REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PTKE ! TKE at canopy levels (m2/s2)
-REAL, DIMENSION(KI), INTENT(OUT) :: PUSTAR ! friction velocity at forcing level (m/s)
-REAL, DIMENSION(KI), INTENT(OUT) :: PALFAU ! V+(1) = alfa u'w'(1) + beta
-REAL, DIMENSION(KI), INTENT(OUT) :: PBETAU ! V+(1) = alfa u'w'(1) + beta
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-INTEGER :: JLAYER ! loop counter on layers
-INTEGER :: JI ! loop counter
-!
-REAL, DIMENSION(KI,KLVL) :: ZK ! mixing coefficient
-REAL, DIMENSION(KI,KLVL) :: ZDKDDVDZ ! formal derivative of mixing coefficient according to variable vertical gradient
-REAL, DIMENSION(KI,KLVL) :: ZEXN ! Exner function at full levels
-REAL, DIMENSION(KI,KLVL) :: ZUW ! friction at mid levels
-REAL, DIMENSION(KI,KLVL) :: ZTH ! temperature(meaningless here)
-REAL, DIMENSION(KI,KLVL) :: ZWTH ! heat flux (supposed equal to zero)
-REAL, DIMENSION(KI,KLVL) :: ZWQ ! vapor flux (supposed equal to zero)
-REAL, DIMENSION(KI,KLVL) :: ZLEPS ! Dissipative length at full levels
-REAL, DIMENSION(KI,KLVL) :: ZZ ! height above displacement height
-REAL, DIMENSION(KI,KLVL) :: ZLM ! Mixing length at mid levels
-REAL, DIMENSION(KI) :: ZUSTAR ! friction velocity (estimated from
-! ! fluxes at atmospheric forcing level)
-!
-REAL :: ZZ0 ! a value of z0 just for first time-step init.
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. First time step initialization
-! ------------------------------
-!
-!* first time step (i.e. wind profile is initially zero) :
-! set a neutral wind profile in relation with forcing wind
-IF (LHOOK) CALL DR_HOOK('CANOPY_EVOL_NEUTRAL',0,ZHOOK_HANDLE)
-DO JI=1,KI
- IF(PWIND(JI)>0. .AND. PU(JI,KLVL-1)==0.) THEN
- ZZ0 = PZ(JI,1)/2.
- PU(JI,:) = PWIND(JI) * LOG (PZ(JI,:)/ZZ0) / LOG (PZ(JI,KLVL)/ZZ0)
- END IF
-END DO
-!-------------------------------------------------------------------------------
-!
-!* 2. mixing and dissipative lengths (at full levels)
-! ------------------------------
-!
-!* influence of ground surface on mixing length in neutral case
-DO JLAYER=1,KLVL
- ZLM (:,JLAYER) = XKARMAN/SQRT(XALPSBL)/XCMFS * PZ(:,JLAYER)
- ZLEPS(:,JLAYER) = XKARMAN*(XALPSBL**1.5)*XCED * PZ(:,JLAYER)
-END DO
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. time evolution of wind in canopy
-! --------------------------------
-!
-!* 3.1 mixing coefficient for wind at mid layers (at half levels)
-! ---------------------------
-!
-ZK = -999.
-DO JLAYER=2,KLVL
- ZK(:,JLAYER) = 0.5 * XCMFS * ZLM(:,JLAYER) * SQRT(PTKE(:,JLAYER) ) &
- + 0.5 * XCMFS * ZLM(:,JLAYER-1) * SQRT(PTKE(:,JLAYER-1))
-END DO
-!
-!
-!* 3.2 mixing coefficient vertical derivative at mid layers (at half levels)
-! --------------------------------------
-!
-!* there is no formal dependency on wind
-ZDKDDVDZ = 0.
-!
-!
-!* 3.3 time evolution of wind in canopy
-! --------------------------------
-!
- CALL CANOPY_EVOL_WIND(KI,KLVL,PTSTEP,KIMPL,PWIND,ZK,ZDKDDVDZ,PSFLUX_U,PFORC_U,PDFORC_UDU,PDZ,PDZF,PU,ZUW,PALFAU,PBETAU)
-!
-!* 3.4 Friction velocity at top of SBL layers
-! --------------------------------------
-!
-PUSTAR = SQRT(ABS(ZUW(:,KLVL)))
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. time evolution of TKE in canopy
-! -------------------------------
-!
-!* neutral case, no thermal production
-ZWTH = 0.
-ZWQ = 0.
-ZTH = 300.
-!
- CALL CANOPY_EVOL_TKE(KI,KLVL,PTSTEP,PRHOA,PZ,PZF,PDZ,PDZF,PFORC_E,PDFORC_EDE, &
- PU,ZTH,ZUW,ZWTH,ZWQ,ZLEPS,PTKE )
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. Security at atmospheric forcing level
-! -------------------------------------
-!
-PU(:,KLVL) = PWIND(:)
-IF (LHOOK) CALL DR_HOOK('CANOPY_EVOL_NEUTRAL',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-END SUBROUTINE CANOPY_EVOL_NEUTRAL
-
-
diff --git a/src/SURFEX/canopy_evol_temp.F90 b/src/SURFEX/canopy_evol_temp.F90
index 1f0b5999652af8e8363516c89848c5f26a5842ac..f15a1df389651bb7363eaf95d9457150839f9bb4 100644
--- a/src/SURFEX/canopy_evol_temp.F90
+++ b/src/SURFEX/canopy_evol_temp.F90
@@ -3,9 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE CANOPY_EVOL_TEMP(KI,KLVL,PTSTEP,KIMPL,PTHA,PK,PDKDDVDZ, &
- PSFLUX_T,PFORC_T,PDFORC_TDT,PDZ,PDZF,PTH,PWTH, &
- PALFA,PBETA )
+ SUBROUTINE CANOPY_EVOL_TEMP(SB, KI, PTSTEP, KIMPL ,PTHA, PK, PDKDDVDZ, &
+ PSFLUX_T, PFORC_T, PDFORC_TDT, PTH, PWTH, PALFA, PBETA)
! #########################################
!
!!**** *CANOPY_EVOL_TEMP* - evolution of wind in canopy
@@ -40,6 +39,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_CANOPY_n, ONLY : CANOPY_t
+!
USE MODI_CANOPY_EVOL_FIELD
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -50,8 +51,9 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
+!
INTEGER, INTENT(IN) :: KI ! number of horizontal points
-INTEGER, INTENT(IN) :: KLVL ! number of levels in canopy
REAL, INTENT(IN) :: PTSTEP ! time-step (s)
INTEGER, INTENT(IN) :: KIMPL ! implicitation code:
! ! 1 : computes only alfa and beta coupling
@@ -59,20 +61,16 @@ INTEGER, INTENT(IN) :: KIMPL ! implicitation code:
! ! 2 : computes temporal evolution of the
! ! variables
REAL, DIMENSION(KI), INTENT(IN) :: PTHA ! potential temp. at forcing level (K)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PK ! mixing exchange coefficient (m2/s)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDKDDVDZ ! derivative of mixing coefficient as a
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PK ! mixing exchange coefficient (m2/s)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PDKDDVDZ ! derivative of mixing coefficient as a
! ! function of vertical gradient of wind
! ! (at mid levels) (m2)
REAL, DIMENSION(KI), INTENT(IN) :: PSFLUX_T ! surface flux w'Th' (mK/s)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PFORC_T ! tendency of wind due to canopy drag (K/s)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDFORC_TDT! formal derivative of the tendency of
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PFORC_T ! tendency of wind due to canopy drag (K/s)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PDFORC_TDT! formal derivative of the tendency of
! ! wind due to canopy drag (1/s)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDZ ! deltaZ between canopy half levels,
-! ! located at full levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDZF ! deltaZ between canopy (full) levels,
-! ! located at half levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PTH ! pot. temp. at canopy levels (K)
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PWTH ! turbulent flux (at half levels) (mK/s)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(INOUT) :: PTH ! pot. temp. at canopy levels (K)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PWTH ! turbulent flux (at half levels) (mK/s)
REAL, DIMENSION(KI), INTENT(OUT) :: PALFA ! V+(1) = alfa F(1) + beta
REAL, DIMENSION(KI), INTENT(OUT) :: PBETA ! V+(1) = alfa F(1) + beta
!
@@ -82,16 +80,16 @@ REAL, DIMENSION(KI), INTENT(OUT) :: PBETA ! V+(1) = alfa F(1) + beta
!
INTEGER :: JLAYER ! loop counter on layers
!
-REAL, DIMENSION(KI,KLVL) :: ZDTHDZ ! dTh/dz at mid levels
-REAL, DIMENSION(KI,KLVL) :: ZF ! turbulent flux at mid levels
-REAL, DIMENSION(KI,KLVL) :: ZDFDDVDZ ! derivative of turbulent flux as a
+REAL, DIMENSION(KI,SB%NLVL) :: ZDTHDZ ! dTh/dz at mid levels
+REAL, DIMENSION(KI,SB%NLVL) :: ZF ! turbulent flux at mid levels
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFDDVDZ ! derivative of turbulent flux as a
! ! function of vertical gradient of wind variable
! ! (at mid levels)
-REAL, DIMENSION(KI,KLVL) :: ZEXT ! external forcing at full levels
-REAL, DIMENSION(KI,KLVL) :: ZDEXTDV ! derivative of external forcing as a
+REAL, DIMENSION(KI,SB%NLVL) :: ZEXT ! external forcing at full levels
+REAL, DIMENSION(KI,SB%NLVL) :: ZDEXTDV ! derivative of external forcing as a
! ! function of vertical variable
! ! (at full levels)
-REAL, DIMENSION(KI,KLVL) :: ZTH ! work variable : pot. temp at futur instant
+REAL, DIMENSION(KI,SB%NLVL) :: ZTH ! work variable : pot. temp at futur instant
! ! (or past at the end of the routine)
REAL, DIMENSION(KI) :: ZDTHADT ! dTHa/dt at forcing level
REAL, DIMENSION(KI) :: ZDWTHDZ ! dw'Th'/dz at forcing level
@@ -136,17 +134,17 @@ ZDEXTDV = ZDEXTDV + PDFORC_TDT
! This means that one assume that the forcing layer is in the inertial sublayer
! (where turbulent fluxes are constant).
!
-ZDTHADT(:) = ( PTHA(:) - PTH(:,KLVL) ) /PTSTEP
+ZDTHADT(:) = ( PTHA(:) - PTH(:,SB%NLVL) ) /PTSTEP
!
ZDWTHDZ(:) = 0.
!
-DO JLAYER=1,KLVL
+DO JLAYER=1,SB%NLVL
ZEXT(:,JLAYER) = ZEXT(:,JLAYER) + ZDWTHDZ(:) + ZDTHADT(:)
END DO
!
- CALL CANOPY_EVOL_FIELD(KI, KLVL, PTSTEP, KIMPL, PK, PDKDDVDZ, &
- PSFLUX_T, PFORC_T, PDFORC_TDT, PDZ, PDZF, &
- ZEXT, ZDEXTDV, PTH, PWTH, PALFA, PBETA )
+ CALL CANOPY_EVOL_FIELD(KI, SB%NLVL, PTSTEP, KIMPL, PK, PDKDDVDZ, &
+ PSFLUX_T, PFORC_T, PDFORC_TDT, SB%XDZ, SB%XDZF, &
+ ZEXT, ZDEXTDV, PTH, PWTH, PALFA, PBETA )
!
IF (LHOOK) CALL DR_HOOK('CANOPY_EVOL_TEMP',1,ZHOOK_HANDLE)
!----------------------------------------------------------------
diff --git a/src/SURFEX/canopy_evol_tke.F90 b/src/SURFEX/canopy_evol_tke.F90
index 6bd6ecc49eafd93e294806b5f61e010513b3347c..bd820321e1bd381332ce8caba8dfe692b65d86b4 100644
--- a/src/SURFEX/canopy_evol_tke.F90
+++ b/src/SURFEX/canopy_evol_tke.F90
@@ -3,10 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE CANOPY_EVOL_TKE(KI,KLVL,PTSTEP,PRHOA, &
- PZ,PZF,PDZ,PDZF, &
- PFORC_E,PDFORC_EDE, &
- PU,PTH,PUW,PWTH,PWQ,PLEPS,PTKE )
+ SUBROUTINE CANOPY_EVOL_TKE(SB, KI, PTSTEP, PRHOA, PFORC_E, PDFORC_EDE, &
+ PTH, PUW, PWTH, PWQ, PLEPS )
! #########################################
!
!!**** *CANOPY_EVOL_TKE* - evolution of wind in canopy
@@ -41,6 +39,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_CANOPY_n, ONLY : CANOPY_t
+!
USE MODI_TRIDIAG_SURF
USE MODD_CANOPY_TURB, ONLY : XCED, XTKEMIN
USE MODD_CSTS, ONLY : XG, XRD, XRV
@@ -54,26 +54,19 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
+!
INTEGER, INTENT(IN) :: KI ! number of horizontal points
-INTEGER, INTENT(IN) :: KLVL ! number of levels in canopy
REAL, INTENT(IN) :: PTSTEP ! time-step (s)
REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! Air density (kg/m3)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PZ ! Z at full levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PZF ! Z at half levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDZ ! deltaZ between canopy half levels,
-! ! located at full levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDZF ! deltaZ between canopy (full) levels,
-! ! located at half levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PFORC_E ! tendency of wind due to canopy drag (m2/s3)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDFORC_EDE! formal derivative of the tendency of
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PFORC_E ! tendency of wind due to canopy drag (m2/s3)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PDFORC_EDE! formal derivative of the tendency of
! ! wind due to canopy drag (1/s)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PU ! wind speed at canopy levels (m/s)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PTH ! pot. temp. at canopy levels (K)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PUW ! turbulent flux (at half levels) (m2/s2)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PWTH ! w'Th' flux (at half levels) (mK/s)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PWQ ! w'q' flux (at half levels) (kg/m2/s)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PLEPS ! dissipative length (full levels) (m)
-REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PTKE ! TKE at canopy levels
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PTH ! pot. temp. at canopy levels (K)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PUW ! turbulent flux (at half levels) (m2/s2)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PWTH ! w'Th' flux (at half levels) (mK/s)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PWQ ! w'q' flux (at half levels) (kg/m2/s)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PLEPS ! dissipative length (full levels) (m)
!
!
!* 0.2 Declarations of local variables
@@ -81,21 +74,21 @@ REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PTKE ! TKE at canopy levels
!
INTEGER :: JLAYER ! loop counter on layers
!
-REAL, DIMENSION(KI,KLVL) :: ZDUDZ ! dU/dz at mid levels
-REAL, DIMENSION(KI,KLVL) :: ZDP ! dynamical production at full levels
+REAL, DIMENSION(KI,SB%NLVL) :: ZDUDZ ! dU/dz at mid levels
+REAL, DIMENSION(KI,SB%NLVL) :: ZDP ! dynamical production at full levels
! ! (at full levels)
-REAL, DIMENSION(KI,KLVL) :: ZTP ! thermal production at full levels
+REAL, DIMENSION(KI,SB%NLVL) :: ZTP ! thermal production at full levels
! ! (at full levels)
-REAL, DIMENSION(KI,KLVL) :: ZDISS_O_TKE ! dissipation/TKE ratio at full levels
-REAL, DIMENSION(KI,KLVL) :: ZF ! turbulent flux at mid levels
-REAL, DIMENSION(KI,KLVL) :: ZDFDDVDZ ! derivative of turbulent flux as a
+REAL, DIMENSION(KI,SB%NLVL) :: ZDISS_O_TKE ! dissipation/TKE ratio at full levels
+REAL, DIMENSION(KI,SB%NLVL) :: ZF ! turbulent flux at mid levels
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFDDVDZ ! derivative of turbulent flux as a
! ! function of vertical gradient of wind variable
! ! (at mid levels)
-REAL, DIMENSION(KI,KLVL) :: ZEXT ! external forcing at full levels
-REAL, DIMENSION(KI,KLVL) :: ZDEXTDV ! derivative of external forcing as a
+REAL, DIMENSION(KI,SB%NLVL) :: ZEXT ! external forcing at full levels
+REAL, DIMENSION(KI,SB%NLVL) :: ZDEXTDV ! derivative of external forcing as a
! ! function of vertical variable
! ! (at full levels)
-REAL, DIMENSION(KI,KLVL) :: ZTKE ! TKE at canopy levels (work var.)
+REAL, DIMENSION(KI,SB%NLVL) :: ZTKE ! TKE at canopy levels (work var.)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
@@ -121,8 +114,8 @@ ZDFDDVDZ = 0.
! ------------------------
!
ZDUDZ(:,:) = -999.
-DO JLAYER=2,KLVL
- ZDUDZ(:,JLAYER) = (PU(:,JLAYER) - PU(:,JLAYER-1)) / PDZF(:,JLAYER)
+DO JLAYER=2,SB%NLVL
+ ZDUDZ(:,JLAYER) = (SB%XU(:,JLAYER) - SB%XU(:,JLAYER-1)) / SB%XDZF(:,JLAYER)
END DO
!-------------------------------------------------------------------------------
!
@@ -132,16 +125,16 @@ END DO
ZDP(:,:) = -999.
!
!* first level using an extrapolation using a 1/z law
-ZDP(:,1) = - PUW(:,2) * ZDUDZ(:,2) * (PZF(:,2)/PZ(:,1))
+ZDP(:,1) = - PUW(:,2) * ZDUDZ(:,2) * (SB%XZF(:,2)/SB%XZ(:,1))
! other levels
-DO JLAYER=2,KLVL-1
+DO JLAYER=2,SB%NLVL-1
ZDP(:,JLAYER) = - 0.5 * (PUW(:,JLAYER) * ZDUDZ(:,JLAYER) ) &
- 0.5 * (PUW(:,JLAYER+1) * ZDUDZ(:,JLAYER+1))
END DO
!
!* upper level using an extrapolation using a 1/z law
-ZDP(:,KLVL) = - PUW(:,KLVL) * ZDUDZ(:,KLVL) * (PZF(:,KLVL)/PZ(:,KLVL))
+ZDP(:,SB%NLVL) = - PUW(:,SB%NLVL) * ZDUDZ(:,SB%NLVL) * (SB%XZF(:,SB%NLVL)/SB%XZ(:,SB%NLVL))
!
!* adds dynamical production in non-transport forces
ZEXT = ZEXT + ZDP
@@ -155,13 +148,13 @@ ZDEXTDV = ZDEXTDV + 0.
ZTP(:,:) = -999.
!
! other levels
-DO JLAYER=1,KLVL-1
- ZTP(:,JLAYER) = XG/PTH(:,JLAYER) * 0.5 * ( (PWTH(:,JLAYER)+ PWTH(:,JLAYER+1)) &
- + (XRV/XRD-1) * (PWQ(:,JLAYER) + PWQ(:,JLAYER) )/PRHOA(:) )
+DO JLAYER=1,SB%NLVL-1
+ ZTP(:,JLAYER) = XG/PTH(:,JLAYER) * 0.5 * ( (PWTH(:,JLAYER) + PWTH(:,JLAYER+1) ) &
+ + (XRV/XRD-1) * (PWQ (:,JLAYER) + PWQ (:,JLAYER) )/PRHOA(:) )
END DO
!
!* upper level
-ZTP(:,KLVL) = XG/PTH(:,KLVL) * PWTH(:,KLVL)
+ZTP(:,SB%NLVL) = XG/PTH(:,SB%NLVL) * PWTH(:,SB%NLVL)
!
!* adds dynamical production in non-transport forces
ZEXT = ZEXT + ZTP
@@ -172,10 +165,10 @@ ZDEXTDV = ZDEXTDV + 0.
!* 4. Dissipation/TKE ratio (to prepare implicitation of dissipation)
! ---------------------
!
-ZDISS_O_TKE = - XCED * SQRT(PTKE(:,:)) / PLEPS(:,:)
+ZDISS_O_TKE = - XCED * SQRT(SB%XTKE(:,:)) / PLEPS(:,:)
!
!* adds dissipation in non-transport forces
-ZEXT = ZEXT + ZDISS_O_TKE * PTKE(:,:)
+ZEXT = ZEXT + ZDISS_O_TKE * SB%XTKE(:,:)
ZDEXTDV = ZDEXTDV + 1.5 * ZDISS_O_TKE
!
!-------------------------------------------------------------------------------
@@ -195,22 +188,22 @@ ZDEXTDV = ZDEXTDV + PDFORC_EDE(:,:)
!
!* note that dissipation is implicited
!
- CALL TRIDIAG_SURF(PTKE,ZF,ZDFDDVDZ,ZEXT,ZDEXTDV,PTSTEP, &
- PDZF,PDZ,ZTKE )
+ CALL TRIDIAG_SURF(SB%XTKE,ZF,ZDFDDVDZ,ZEXT,ZDEXTDV,PTSTEP,SB%XDZF,SB%XDZ,ZTKE)
!
!-------------------------------------------------------------------------------
!
!* 7. New value of TKE (at full levels)
! ----------------
!
-PTKE(:,:) = ZTKE(:,:)
+SB%XTKE(:,:) = ZTKE(:,:)
!
!-------------------------------------------------------------------------------
!
!* 8. Security at all levels : set minimum threshold
! ----------------------
!
-PTKE(:,:) = MAX(PTKE,XTKEMIN)
+SB%XTKE(:,:) = MAX(SB%XTKE,XTKEMIN)
+!
IF (LHOOK) CALL DR_HOOK('CANOPY_EVOL_TKE',1,ZHOOK_HANDLE)
!
!----------------------------------------------------------------
diff --git a/src/SURFEX/canopy_evol_wind.F90 b/src/SURFEX/canopy_evol_wind.F90
index c1355983ea603ee0c3e0d6eaa7c30069801f18f0..3cd458e1f565563ba773ff191e17ecb49e5234a2 100644
--- a/src/SURFEX/canopy_evol_wind.F90
+++ b/src/SURFEX/canopy_evol_wind.F90
@@ -3,9 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE CANOPY_EVOL_WIND(KI,KLVL,PTSTEP,KIMPL,PWIND,PK,PDKDDVDZ, &
- PSFLUX_U,PFORC_U,PDFORC_UDU,PDZ,PDZF,PU,PUW, &
- PALFA,PBETA )
+ SUBROUTINE CANOPY_EVOL_WIND(SB, KI, PTSTEP, KIMPL, PWIND, PK, PDKDDVDZ, &
+ PSFLUX_U, PFORC_U, PDFORC_UDU, PUW, PALFA, PBETA )
! #########################################
!
!!**** *CANOPY_EVOL_WIND* - evolution of wind in canopy
@@ -40,6 +39,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_CANOPY_n, ONLY : CANOPY_t
+!
USE MODI_CANOPY_EVOL_FIELD
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -50,8 +51,9 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
+!
INTEGER, INTENT(IN) :: KI ! number of horizontal points
-INTEGER, INTENT(IN) :: KLVL ! number of levels in canopy
REAL, INTENT(IN) :: PTSTEP ! time-step (s)
INTEGER, INTENT(IN) :: KIMPL ! implicitation code:
! ! 1 : computes only alfa and beta coupling
@@ -59,20 +61,15 @@ INTEGER, INTENT(IN) :: KIMPL ! implicitation code:
! ! 2 : computes temporal evolution of the
! ! variables
REAL, DIMENSION(KI), INTENT(IN) :: PWIND ! wind at forcing level (m/s)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PK ! mixing exchange coefficient (m2/s)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDKDDVDZ ! derivative of mixing coefficient as a
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PK ! mixing exchange coefficient (m2/s)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PDKDDVDZ ! derivative of mixing coefficient as a
! ! function of vertical gradient of wind
! ! (at mid levels) (m2)
REAL, DIMENSION(KI), INTENT(IN) :: PSFLUX_U ! Surface flux u'w' (m2/s2)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PFORC_U ! tendency of wind due to canopy drag (m/s2)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDFORC_UDU! formal derivative of the tendency of
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PFORC_U ! tendency of wind due to canopy drag (m/s2)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PDFORC_UDU! formal derivative of the tendency of
! ! wind due to canopy drag (1/s)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDZ ! deltaZ between canopy half levels,
-! ! located at full levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDZF ! deltaZ between canopy (full) levels,
-! ! located at half levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PU ! wind speed at canopy levels (m/s)
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PUW ! turbulent flux (at half levels) (m2/s2)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PUW ! turbulent flux (at half levels) (m2/s2)
REAL, DIMENSION(KI), INTENT(OUT) :: PALFA ! V+(1) = alfa u'w' + beta
REAL, DIMENSION(KI), INTENT(OUT) :: PBETA ! V+(1) = alfa u'w' + beta
!
@@ -82,16 +79,16 @@ REAL, DIMENSION(KI), INTENT(OUT) :: PBETA ! V+(1) = alfa u'w' + beta
!
INTEGER :: JLAYER ! loop counter on layers
!
-REAL, DIMENSION(KI,KLVL) :: ZDUDZ ! dU/dz at mid levels
-REAL, DIMENSION(KI,KLVL) :: ZF ! turbulent flux at mid levels
-REAL, DIMENSION(KI,KLVL) :: ZDFDDVDZ ! derivative of turbulent flux as a
+REAL, DIMENSION(KI,SB%NLVL) :: ZDUDZ ! dU/dz at mid levels
+REAL, DIMENSION(KI,SB%NLVL) :: ZF ! turbulent flux at mid levels
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFDDVDZ ! derivative of turbulent flux as a
! ! function of vertical gradient of wind variable
! ! (at mid levels)
-REAL, DIMENSION(KI,KLVL) :: ZEXT ! external forcing at full levels
-REAL, DIMENSION(KI,KLVL) :: ZDEXTDV ! derivative of external forcing as a
+REAL, DIMENSION(KI,SB%NLVL) :: ZEXT ! external forcing at full levels
+REAL, DIMENSION(KI,SB%NLVL) :: ZDEXTDV ! derivative of external forcing as a
! ! function of vertical variable
! ! (at full levels)
-REAL, DIMENSION(KI,KLVL) :: ZU ! work variable : wind at futur instant
+REAL, DIMENSION(KI,SB%NLVL) :: ZU ! work variable : wind at futur instant
! ! (or past at the end of the routine)
REAL, DIMENSION(KI) :: ZDUADT ! dUa/dt at forcing level
LOGICAL :: LIMPL
@@ -111,8 +108,8 @@ ZDEXTDV = 0.
!
!* coupling coefficient with the surface
!
-PALFA(:)=0.
-PBETA(:)=PU(:,1)
+PALFA(:) = 0.
+PBETA(:) = SB%XU(:,1)
!
!-------------------------------------------------------------------------------
!
@@ -143,27 +140,28 @@ ZDEXTDV = ZDEXTDV + PDFORC_UDU(:,:)
! This means that one assume that the forcing layer is in the inertail sublayer
! (where turbulent fluxes are constant).
!
-ZDUADT(:) = ( PWIND(:) - PU(:,KLVL) ) /PTSTEP
+ZDUADT(:) = ( PWIND(:) - SB%XU(:,SB%NLVL) ) /PTSTEP
!
!* for smoother evolution at large time steps, does not include explicitely
! forcing term in lower layers
-DO JLAYER=1,KLVL-1
+DO JLAYER=1,SB%NLVL-1
ZEXT(:,JLAYER) = ZEXT(:,JLAYER)
END DO
!* evolution of forcing layer forced by forcing...
-ZEXT(:,KLVL) = ZDUADT(:)
+ZEXT(:,SB%NLVL) = ZDUADT(:)
!
- CALL CANOPY_EVOL_FIELD(KI, KLVL, PTSTEP, KIMPL, PK, PDKDDVDZ, &
- PSFLUX_U, PFORC_U, PDFORC_UDU, PDZ, PDZF, &
- ZEXT, ZDEXTDV, PU, PUW, PALFA, PBETA )
+ CALL CANOPY_EVOL_FIELD(KI, SB%NLVL, PTSTEP, KIMPL, PK, PDKDDVDZ, &
+ PSFLUX_U, PFORC_U, PDFORC_UDU, SB%XDZ, SB%XDZF, &
+ ZEXT, ZDEXTDV, SB%XU, PUW, PALFA, PBETA )
!
!-------------------------------------------------------------------------------
!
!* 10. Security at all levels : positivity of wind speed
! ----------------------
!
-PU(:,:) = MAX(PU,0.)
+SB%XU(:,:) = MAX(SB%XU,0.)
+!
IF (LHOOK) CALL DR_HOOK('CANOPY_EVOL_WIND',1,ZHOOK_HANDLE)
!
!----------------------------------------------------------------
diff --git a/src/SURFEX/canopy_grid.F90 b/src/SURFEX/canopy_grid.F90
index f8a2849e37d04aec28898e1f7685bba9bc2c16d4..61209b66680a60b79a76abb8bd4f36a81b97c7d4 100644
--- a/src/SURFEX/canopy_grid.F90
+++ b/src/SURFEX/canopy_grid.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########################################
- SUBROUTINE CANOPY_GRID(KI,KLVL,PZ,PZF,PDZ,PDZF)
+ SUBROUTINE CANOPY_GRID(KI,SB)
! #########################################
!
!!**** *CANOPY_GRID* - computation of vertical grid coordinatesa at
@@ -56,6 +56,7 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_CANOPY_n, ONLY : CANOPY_t
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -66,14 +67,8 @@ IMPLICIT NONE
! -------------------------
!
INTEGER, INTENT(IN) :: KI ! number of horizontal points
-INTEGER, INTENT(IN) :: KLVL ! number of levels in canopy
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PZ ! heights of canopy levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PZF ! heights of surface between canopy lev.(m)
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PDZF ! depth between 2 full canopy levels (m)
-! ! PDZF is located at half levels
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PDZ ! depth between 2 half canopy levels (m)
-! ! PDZ is located at full levels
!
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
!
!* 0.2 Declarations of local variables
! -------------------------------
@@ -83,6 +78,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('CANOPY_GRID',0,ZHOOK_HANDLE)
+!
!* 1. Geometric computations
! ----------------------
!
@@ -90,31 +87,32 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* 1.1 layer depths (variable located at half levels below full levels)
! ------------
!
-IF (LHOOK) CALL DR_HOOK('CANOPY_GRID',0,ZHOOK_HANDLE)
-PDZF(:,:) = -999.
-PDZF(:,1) = 2.*PZ(:,1)
-DO JLAYER=2,KLVL
- PDZF(:,JLAYER) = PZ(:,JLAYER) - PZ(:,JLAYER-1)
+SB%XDZF(:,:) = -999.
+SB%XDZF(:,1) = 2.*SB%XZ(:,1)
+DO JLAYER=2,SB%NLVL
+ SB%XDZF(:,JLAYER) = SB%XZ(:,JLAYER) - SB%XZ(:,JLAYER-1)
END DO
!
!* 1.2 Layer heights (variable located at half levels below full levels)
! -------------
!
-PZF(:,:) = -999.
-PZF(:,1) = 0.
-DO JLAYER=2,KLVL
- PZF(:,JLAYER) = 2.*PZ(:,JLAYER-1) - PZF(:,JLAYER-1)
+SB%XZF(:,:) = -999.
+SB%XZF(:,1) = 0.
+DO JLAYER=2,SB%NLVL
+ SB%XZF(:,JLAYER) = 2.*SB%XZ(:,JLAYER-1) - SB%XZF(:,JLAYER-1)
END DO
!
!
!* 1.3 layer depths (variable located at full levels)
! ------------
!
-PDZ(:,:) = -999.
-DO JLAYER=1,KLVL-1
- PDZ(:,JLAYER) = PZF(:,JLAYER+1) - PZF(:,JLAYER)
+SB%XDZ(:,:) = -999.
+DO JLAYER=1,SB%NLVL-1
+ SB%XDZ(:,JLAYER) = SB%XZF(:,JLAYER+1) - SB%XZF(:,JLAYER)
END DO
-PDZ(:,KLVL) = 2.*(PZ(:,KLVL)-PZF(:,KLVL))
+!
+SB%XDZ(:,SB%NLVL) = 2.*(SB%XZ(:,SB%NLVL)-SB%XZF(:,SB%NLVL))
+!
IF (LHOOK) CALL DR_HOOK('CANOPY_GRID',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/canopy_grid_update.F90 b/src/SURFEX/canopy_grid_update.F90
index dfb699f01429933070f44ab56a6d27b4e68af45a..0ad82723335979002382a8a2c791718f78c78fe4 100644
--- a/src/SURFEX/canopy_grid_update.F90
+++ b/src/SURFEX/canopy_grid_update.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########################################
- SUBROUTINE CANOPY_GRID_UPDATE(KI,KLVL,PH,PZFORC,PZ,PZF,PDZ,PDZF)
+ SUBROUTINE CANOPY_GRID_UPDATE(KI,PH,PZFORC,SB)
! #########################################
!
!!**** *CANOPY_GRID_UPDATE* - set the upper levels at and just below forcing level
@@ -36,6 +36,8 @@
!! S. Riette Oct 2010 Vectorisation
!-------------------------------------------------------------------------------
!
+USE MODD_CANOPY_n, ONLY : CANOPY_t
+!
!* 0. DECLARATIONS
! ------------
!
@@ -51,19 +53,16 @@ IMPLICIT NONE
! -------------------------
!
INTEGER, INTENT(IN) :: KI ! number of horizontal points
-INTEGER, INTENT(IN) :: KLVL ! number of levels in canopy
REAL, DIMENSION(KI), INTENT(IN) :: PH ! maximum canopy height (m)
REAL, DIMENSION(KI), INTENT(IN) :: PZFORC ! height of wind forcing (m)
-REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PZ ! heights of canopy levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PZF ! heights of bottom of canopy levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PDZ ! depth of canopy levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PDZF ! depth between canopy levels (m)
+!
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
!
!* 0.2 Declarations of local variables
! -------------------------------
!
INTEGER, DIMENSION(KI) :: IL ! latest level below forcing height
-INTEGER, DIMENSION(KI,KLVL) :: ILEVEL ! to test if level is high enough
+INTEGER, DIMENSION(KI,SB%NLVL) :: ILEVEL ! to test if level is high enough
!
INTEGER :: ICOUNT ! number of layers above forcing height, these must be changed
INTEGER :: JLAYER ! loop counter on layers
@@ -76,43 +75,45 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('CANOPY_GRID_UPDATE',0,ZHOOK_HANDLE)
-IF(ALL(PZ(:,KLVL)==PZFORC(:)) .AND. LHOOK) CALL DR_HOOK('CANOPY_GRID_UPDATE',1,ZHOOK_HANDLE)
-IF(ALL(PZ(:,KLVL)==PZFORC(:))) RETURN
+!
+IF(ALL(SB%XZ(:,SB%NLVL)==PZFORC(:)) .AND. LHOOK) CALL DR_HOOK('CANOPY_GRID_UPDATE',1,ZHOOK_HANDLE)
+IF(ALL(SB%XZ(:,SB%NLVL)==PZFORC(:))) RETURN
!
!-------------------------------------------------------------------------------
!
!* 1. set upper level to forcing height
! ---------------------------------
!
-PZ(:,KLVL) = PZFORC(:)
+SB%XZ(:,SB%NLVL) = PZFORC(:)
!
!* 2. all canopy levels remaining above forcing height are relocated below
! --------------------------------------------------------------------
!
! determination of levels below forcing height, low enough
+!
ILEVEL=0
DO JI=1,KI
- DO JLAYER=1,KLVL-1
- IF( PZFORC(JI) > PZF(JI,JLAYER+1) + 0.25 * PDZ(JI,JLAYER) .AND. &
- PZ(JI,JLAYER) < PZFORC(JI) ) ILEVEL(JI,JLAYER) = JLAYER
+ DO JLAYER=1,SB%NLVL-1
+ IF( PZFORC(JI) > SB%XZF(JI,JLAYER+1) + 0.25 * SB%XDZ(JI,JLAYER) .AND. &
+ SB%XZ(JI,JLAYER) < PZFORC(JI) ) ILEVEL(JI,JLAYER) = JLAYER
ENDDO
! determination of latest level from the ones selected before
- IL(JI)=MAXVAL(ILEVEL(JI,1:KLVL-1))
+ IL(JI)=MAXVAL(ILEVEL(JI,1:SB%NLVL-1))
!
- ICOUNT = KLVL-IL(JI)-1
+ ICOUNT = SB%NLVL-IL(JI)-1
!
!* determination grid top of this level
- ZZTOP = PZF(JI,IL(JI)+1) ! ZZTOP=0 for IL=0
- ZDZ = 2. * ( PZ(JI,KLVL)-ZZTOP ) / ( 2*ICOUNT+1 )
+ ZZTOP = SB%XZF(JI,IL(JI)+1) ! ZZTOP=0 for IL=0
+ ZDZ = 2. * ( SB%XZ(JI,SB%NLVL)-ZZTOP ) / ( 2*ICOUNT+1 )
DO JLAYER=1,ICOUNT
- PZ(JI,JLAYER+IL(JI)) = ZZTOP + (JLAYER-0.5) * ZDZ
+ SB%XZ(JI,JLAYER+IL(JI)) = ZZTOP + (JLAYER-0.5) * ZDZ
END DO
END DO
!
!* 3. New grid characteristics
! ------------------------
!
- CALL CANOPY_GRID(KI,KLVL,PZ,PZF,PDZ,PDZF)
+ CALL CANOPY_GRID(KI,SB)
!
!
!* 5. at least one canopy level in addition to forcing level must be above canopy top
@@ -121,23 +122,23 @@ END DO
DO JI=1,KI
!
!* tests if the level below forcing height is high enough above canopy
- IF(PZF(JI,KLVL-1) < PH(JI) ) THEN
+ IF(SB%XZF(JI,SB%NLVL-1) < PH(JI) ) THEN
!
!* sets bottom of grid box that is below the forcing level one at canopy height
!
- PZF(JI,KLVL-1) = PH(JI)
+ SB%XZF(JI,SB%NLVL-1) = PH(JI)
!
!* rebuilds vertical grid from the bottom of each grid
!
- PZ(JI,KLVL-2) = 0.5 * ( PZF(JI,KLVL-2) + PZF(JI,KLVL-1) )
- PZ(JI,KLVL-1) = ( 2.* PZF(JI,KLVL-1) + PZ (JI,KLVL) ) /3.
+ SB%XZ(JI,SB%NLVL-2) = 0.5 * ( SB%XZF(JI,SB%NLVL-2) + SB%XZF(JI,SB%NLVL-1) )
+ SB%XZ(JI,SB%NLVL-1) = ( 2.* SB%XZF(JI,SB%NLVL-1) + SB%XZ (JI,SB%NLVL) ) /3.
END IF
END DO
!
!* 6. Final grid characteristics
! --------------------------
!
- CALL CANOPY_GRID(KI,KLVL,PZ,PZF,PDZ,PDZF)
+ CALL CANOPY_GRID(KI,SB)
!
IF (LHOOK) CALL DR_HOOK('CANOPY_GRID_UPDATE',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/carbon_evol.F90 b/src/SURFEX/carbon_evol.F90
index c0743b58961edb70682f869d3bafd3870504ec90..c37e252fe36f7b18402b55c84ad7858e1b0beb48 100644
--- a/src/SURFEX/carbon_evol.F90
+++ b/src/SURFEX/carbon_evol.F90
@@ -3,12 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE CARBON_EVOL(HISBA, HRESPSL, HPHOTO, PTSTEP, KSPINS, &
- PRHOA, PTG, PWG, PWFC, PWWILT, PWSAT, PSAND, &
- PDG, PDZG, KWG_LAYER, &
- PRE25, PLAI, PRESP_BIOMASS_INST, PTURNOVER, &
- PLITTER, PLIGNIN_STRUC, PSOILCARB, &
- PRESP_AUTO, PRESP_ECO )
+ SUBROUTINE CARBON_EVOL(IO, KK, PK, PEK, DEK, PTSTEP, PRHOA, PRESP_BIOMASS_INST )
! ###############################################################
!!**** *CARBON EVOL*
!!
@@ -54,6 +49,10 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+!
USE MODD_CO2V_PAR, ONLY : XMC, XMCO2, XPCCO2
USE MODD_CSTS, ONLY : XDAY, XTT
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -72,40 +71,15 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
- CHARACTER(LEN=3),INTENT(IN) :: HISBA ! type of ISBA version:
-! ! '2-L' (default)
-! ! '3-L'
-! ! 'DIF'
- CHARACTER(LEN=3), INTENT(IN) :: HRESPSL ! Soil Respiration
-! ! 'DEF' = Norman 1992
-! ! 'PRM' = Rivalland PhD Thesis (2003)
-! ! 'CNT' = CENTURY model (Gibelin 2008)
- CHARACTER(LEN=3), INTENT(IN) :: HPHOTO ! type of photosynthesis
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK
!
REAL, INTENT(IN) :: PTSTEP ! time step
-INTEGER, INTENT(IN) :: KSPINS ! (spinup) number of times CARBON_SOIL subroutine
- ! is called for each time step
-!
REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! air density (kg/m3)
-REAL, DIMENSION(:,:), INTENT(IN) :: PTG ! soil layer average temperatures (K)
-REAL, DIMENSION(:,:), INTENT(IN) :: PWG ! soil liquid volumetric water content (m3/m3)
-REAL, DIMENSION(:,:), INTENT(IN) :: PWFC ! field capacity profile (m3/m3)
-REAL, DIMENSION(:,:), INTENT(IN) :: PWWILT ! wilting point profile (m3/m3)
-REAL, DIMENSION(:,:), INTENT(IN) :: PWSAT ! porosity profile (m3/m3)
-REAL, DIMENSION(:,:), INTENT(IN) :: PSAND ! profile of sand fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PDG ! Depth of Bottom of Soil layers (m)
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZG ! soil layers thicknesses (DIF option) (m)
-INTEGER, DIMENSION(:),INTENT(IN) :: KWG_LAYER ! Number of soil moisture layers (DIF option)
-!
-REAL,DIMENSION(:), INTENT(IN) :: PRE25 ! Ecosystem respiration parameter (kg m-2 s-1)
-REAL, DIMENSION(:), INTENT(IN) :: PLAI ! leaf area index
REAL, DIMENSION(:,:), INTENT(IN) :: PRESP_BIOMASS_INST ! instantaneous respiration of biomass (kgCO2/kgair m/s)
-REAL, DIMENSION(:,:), INTENT(IN) :: PTURNOVER ! biomass turnover going into litter (gC m-2 s-1)
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLITTER ! litter pools (gC m-2)
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PLIGNIN_STRUC ! L/C ratio in structural litter
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSOILCARB ! soil carbon pools (gC m-2)
-REAL, DIMENSION(:), INTENT(OUT) :: PRESP_AUTO ! autotrophic respiration (kgCO2/kgair m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PRESP_ECO ! total ecosystem respiration (kgCO2/kgair m/s)
!
!* 0.2 declarations of local variables
!
@@ -118,48 +92,48 @@ REAL, PARAMETER :: ZCOEF5 = 25.0
REAL, PARAMETER :: ZDTOP = 0.1 !Top depth m
REAL, PARAMETER :: ZDSUB = 1.0 !Sub depth m
!
-REAL, DIMENSION(SIZE(PTG,1)) :: ZRESP_SOIL_TOT ! total soil respiration (kgCO2/kgair m/s)
-REAL, DIMENSION(SIZE(PTG,1)) :: ZRESP_AUTO_ABOVE ! total above ground biomass respiration (kgCO2/kgair m/s)
-REAL, DIMENSION(SIZE(PTG,1)) :: ZRESP_HETERO ! total heterotrophic respiration (kgCO2/kgair m/s)
+REAL, DIMENSION(SIZE(PEK%XTG,1)) :: ZRESP_SOIL_TOT ! total soil respiration (kgCO2/kgair m/s)
+REAL, DIMENSION(SIZE(PEK%XTG,1)) :: ZRESP_AUTO_ABOVE ! total above ground biomass respiration (kgCO2/kgair m/s)
+REAL, DIMENSION(SIZE(PEK%XTG,1)) :: ZRESP_HETERO ! total heterotrophic respiration (kgCO2/kgair m/s)
!
!
-REAL, DIMENSION(SIZE(PSOILCARB,1),SIZE(PSOILCARB,2)) :: ZSOILCARBON_INPUT
+REAL, DIMENSION(SIZE(PEK%XSOILCARB,1),SIZE(PEK%XSOILCARB,2)) :: ZSOILCARBON_INPUT
! quantity of carbon going into carbon pools
! from litter decomposition (gC/m2/day)
!
-REAL, DIMENSION(SIZE(PSOILCARB,1)) :: ZRESP_HETERO_DAY_LITTER
+REAL, DIMENSION(SIZE(PEK%XSOILCARB,1)) :: ZRESP_HETERO_DAY_LITTER
! litter heterotrophic respiration (gC/m2/day)
-REAL, DIMENSION(SIZE(PSOILCARB,1)) :: ZRESP_HETERO_DAY_SOIL
+REAL, DIMENSION(SIZE(PEK%XSOILCARB,1)) :: ZRESP_HETERO_DAY_SOIL
! soil heterotrophic respiration (gC/m2/day)
!
-REAL, DIMENSION(SIZE(PLIGNIN_STRUC,1),SIZE(PLIGNIN_STRUC,2)) :: ZCONTROL_MOIST, &
+REAL, DIMENSION(SIZE(PEK%XLIGNIN_STRUC,1),SIZE(PEK%XLIGNIN_STRUC,2)) :: ZCONTROL_MOIST, &
ZCONTROL_TEMP
! ZCONTROL_MOIST = moisture control of heterotrophic respiration
! ZCONTROL_TEMP = temperature control of heterotrophic respiration
!
-REAL, DIMENSION(SIZE(PTG,1)) :: ZTG_TOP ! Top soil temperature (C)
-REAL, DIMENSION(SIZE(PTG,1)) :: ZTG_SUB ! Sub soil temperature (C)
-REAL, DIMENSION(SIZE(PTG,1)) :: ZSAND_SUB ! Sub soil sand fraction (-)
+REAL, DIMENSION(SIZE(PEK%XTG,1)) :: ZTG_TOP ! Top soil temperature (C)
+REAL, DIMENSION(SIZE(PEK%XTG,1)) :: ZTG_SUB ! Sub soil temperature (C)
+REAL, DIMENSION(SIZE(PEK%XTG,1)) :: ZSAND_SUB ! Sub soil sand fraction (-)
!
-REAL, DIMENSION(SIZE(PTG,1)) :: ZMOIST_TOP ! Top soil moisture index (-)
-REAL, DIMENSION(SIZE(PTG,1)) :: ZMOIST_SUB ! Sub soil moisture index (-)
-REAL, DIMENSION(SIZE(PTG,1)) :: ZSAT_TOP ! Top soil saturated index(-)
-REAL, DIMENSION(SIZE(PTG,1)) :: ZSAT_SUB ! Sub soil saturated index(-)
+REAL, DIMENSION(SIZE(PEK%XTG,1)) :: ZMOIST_TOP ! Top soil moisture index (-)
+REAL, DIMENSION(SIZE(PEK%XTG,1)) :: ZMOIST_SUB ! Sub soil moisture index (-)
+REAL, DIMENSION(SIZE(PEK%XTG,1)) :: ZSAT_TOP ! Top soil saturated index(-)
+REAL, DIMENSION(SIZE(PEK%XTG,1)) :: ZSAT_SUB ! Sub soil saturated index(-)
!
-REAL, DIMENSION(SIZE(PTG,1)) :: ZDG_TOP ! Top soil depth for DIF (m)
-REAL, DIMENSION(SIZE(PTG,1)) :: ZDG_SUB ! Sub soil depth for DIF (m)
+REAL, DIMENSION(SIZE(PEK%XTG,1)) :: ZDG_TOP ! Top soil depth for DIF (m)
+REAL, DIMENSION(SIZE(PEK%XTG,1)) :: ZDG_SUB ! Sub soil depth for DIF (m)
!
-REAL, DIMENSION(SIZE(PTG,1),SIZE(PTG,2)) :: ZWGHT_TOP ! Weight top for DIF (m)
-REAL, DIMENSION(SIZE(PTG,1),SIZE(PTG,2)) :: ZWGHT_SUB ! Weight sub for DIF (m)
+REAL, DIMENSION(SIZE(PEK%XTG,1),SIZE(PEK%XTG,2)) :: ZWGHT_TOP ! Weight top for DIF (m)
+REAL, DIMENSION(SIZE(PEK%XTG,1),SIZE(PEK%XTG,2)) :: ZWGHT_SUB ! Weight sub for DIF (m)
!
-REAL, DIMENSION(SIZE(PTG,1)) :: ZWORK ! work array
+REAL, DIMENSION(SIZE(PEK%XTG,1)) :: ZWORK ! work array
!
REAL :: ZMOISTL, ZSATL, ZLOG2
!
INTEGER :: JNBIOMASS
INTEGER :: ITCSPIN
!
-INTEGER :: INI, INL, JI, JL, IDEPTH, INBIOMASS
+INTEGER :: INI, INL, JI, JL, IDEKTH, INBIOMASS
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -170,11 +144,11 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('CARBON_EVOL',0,ZHOOK_HANDLE)
!
-PRESP_AUTO = 0.0
-PRESP_ECO = 0.0
+DEK%XRESP_AUTO = 0.0
+DEK%XRESP_ECO = 0.0
!
-INI=SIZE(PTG,1)
-INL=SIZE(PTG,2)
+INI=SIZE(PEK%XTG,1)
+INL=SIZE(PEK%XTG,2)
INBIOMASS=SIZE(PRESP_BIOMASS_INST,2)
!
ZRESP_SOIL_TOT(:) = XUNDEF
@@ -195,21 +169,21 @@ ZLOG2 = LOG(2.0)
!
! convert soil temperature from K to C (over 1m depth for DIF)
!
-IF(HISBA/='DIF')THEN
- ZTG_TOP (:) = PTG(:,1)-XTT
- ZTG_SUB (:) = PTG(:,2)-XTT
+IF(IO%CISBA/='DIF')THEN
+ ZTG_TOP (:) = PEK%XTG(:,1)-XTT
+ ZTG_SUB (:) = PEK%XTG(:,2)-XTT
ELSE
DO JI=1,INI
- IDEPTH=KWG_LAYER(JI)
- ZDG_TOP(JI)=MIN(ZDTOP,PDG(JI,IDEPTH))
- ZDG_SUB(JI)=MIN(ZDSUB,PDG(JI,IDEPTH))
+ IDEKTH=PK%NWG_LAYER(JI)
+ ZDG_TOP(JI)=MIN(ZDTOP,PK%XDG(JI,IDEKTH))
+ ZDG_SUB(JI)=MIN(ZDSUB,PK%XDG(JI,IDEKTH))
ENDDO
DO JL=1,INL
DO JI=1,INI
- ZWGHT_TOP(JI,JL)=MIN(PDZG(JI,JL),MAX(0.0,ZDG_TOP(JI)-PDG(JI,JL)+PDZG(JI,JL)))
- ZWGHT_SUB(JI,JL)=MIN(PDZG(JI,JL),MAX(0.0,ZDG_SUB(JI)-PDG(JI,JL)+PDZG(JI,JL)))
- ZTG_TOP(JI)=ZTG_TOP(JI)+(PTG(JI,JL)-XTT)*ZWGHT_TOP(JI,JL)/ZDG_TOP(JI)
- ZTG_SUB(JI)=ZTG_SUB(JI)+(PTG(JI,JL)-XTT)*ZWGHT_SUB(JI,JL)/ZDG_SUB(JI)
+ ZWGHT_TOP(JI,JL)=MIN(PK%XDZG(JI,JL),MAX(0.0,ZDG_TOP(JI)-PK%XDG(JI,JL)+PK%XDZG(JI,JL)))
+ ZWGHT_SUB(JI,JL)=MIN(PK%XDZG(JI,JL),MAX(0.0,ZDG_SUB(JI)-PK%XDG(JI,JL)+PK%XDZG(JI,JL)))
+ ZTG_TOP(JI)=ZTG_TOP(JI)+(PEK%XTG(JI,JL)-XTT)*ZWGHT_TOP(JI,JL)/ZDG_TOP(JI)
+ ZTG_SUB(JI)=ZTG_SUB(JI)+(PEK%XTG(JI,JL)-XTT)*ZWGHT_SUB(JI,JL)/ZDG_SUB(JI)
ENDDO
ENDDO
ENDIF
@@ -220,69 +194,70 @@ ENDIF
!
ZRESP_AUTO_ABOVE(:)=0.
!
-IF (HPHOTO=='NIT') THEN
+IF (IO%CPHOTO=='NIT') THEN
!
DO JNBIOMASS=1,2
ZRESP_AUTO_ABOVE(:) = ZRESP_AUTO_ABOVE(:) + PRESP_BIOMASS_INST(:,JNBIOMASS)
ENDDO
!
-ELSE IF (HPHOTO=='NCB') THEN
+ELSE IF (IO%CPHOTO=='NCB') THEN
!
DO JNBIOMASS=1,3
ZRESP_AUTO_ABOVE(:) = ZRESP_AUTO_ABOVE(:) + PRESP_BIOMASS_INST(:,JNBIOMASS)
ENDDO
!
-ELSE IF (HPHOTO=='AGS' .OR. HPHOTO=='AST' .OR. HPHOTO=='LAI' .OR. HPHOTO=='LST') THEN
+ELSE IF (IO%CPHOTO=='AST') THEN
!
ZRESP_AUTO_ABOVE(:) = PRESP_BIOMASS_INST(:,1)
!
ENDIF
!
DO JNBIOMASS=1,INBIOMASS
- PRESP_AUTO(:) = PRESP_AUTO (:) + PRESP_BIOMASS_INST(:,JNBIOMASS)
+ DEK%XRESP_AUTO(:) = DEK%XRESP_AUTO (:) + PRESP_BIOMASS_INST(:,JNBIOMASS)
ENDDO
!
!
!* 3. Soil and ecosystem respiration
! ------------------------------
!
-IF (HRESPSL == 'DEF') THEN
+IF (IO%CRESPSL == 'DEF') THEN
!
ZWORK(:)=0.0
!
- IF(HISBA/='DIF')THEN
- ZWORK (:) = PWG (:,1)
+ IF(IO%CISBA/='DIF')THEN
+ ZWORK (:) = PEK%XWG(:,1)
ELSE
DO JL=1,INL
DO JI=1,INI
- ZWORK(JI)=ZWORK(JI)+PWG(JI,JL)*ZWGHT_TOP(JI,JL)/ZDG_TOP(JI)
+ ZWORK(JI)=ZWORK(JI)+PEK%XWG(JI,JL)*ZWGHT_TOP(JI,JL)/ZDG_TOP(JI)
ENDDO
ENDDO
ENDIF
!
! Soil respiration from Norman et al 1992 (kgCO2/kgair m/s)
!
- WHERE (PLAI(:) == XUNDEF)
+ WHERE (PEK%XLAI(:) == XUNDEF)
ZRESP_SOIL_TOT(:) = 0.0
ELSEWHERE
-! Before optimization = (ZCOEF1/PRHOA)*(ZCOEF2+ZCOEF3*PLAI(:))*PWG(:,1)*2.**(ZCOEF4*(ZT2(:)-ZCOEF5))
- ZRESP_SOIL_TOT(:) = (ZCOEF1/PRHOA)*(ZCOEF2+ZCOEF3*PLAI(:))*ZWORK(:)*EXP(ZLOG2*(ZCOEF4*(ZTG_SUB(:)-ZCOEF5)))
+! Before optimization = (ZCOEF1/PRHOA)*(ZCOEF2+ZCOEF3*PEK%XLAI(:))*PEK%XWG(:,1)*2.**(ZCOEF4*(ZT2(:)-ZCOEF5))
+ ZRESP_SOIL_TOT(:) = (ZCOEF1/PRHOA)*(ZCOEF2+ZCOEF3*PEK%XLAI(:)) * &
+ ZWORK(:)*EXP(ZLOG2*(ZCOEF4*(ZTG_SUB(:)-ZCOEF5)))
ENDWHERE
!
! RESP_ECO is diagnosed from RESP_SOIL_TOT and RESP_AUTO_ABOVE
!
- PRESP_ECO(:) = ZRESP_SOIL_TOT(:) + ZRESP_AUTO_ABOVE(:)
+ DEK%XRESP_ECO(:) = ZRESP_SOIL_TOT(:) + ZRESP_AUTO_ABOVE(:)
!
-ELSE IF (HRESPSL == 'PRM') THEN
+ELSE IF (IO%CRESPSL == 'PRM') THEN
!
ZWORK(:)=0.0
!
- IF(HISBA/='DIF')THEN
- ZWORK (:) = PWG (:,1)
+ IF(IO%CISBA/='DIF')THEN
+ ZWORK (:) = PEK%XWG(:,1)
ELSE
DO JL=1,INL
DO JI=1,INI
- ZWORK(JI)=ZWORK(JI)+MIN(1.0,PWG(JI,JL)/PWFC(JI,JL))*ZWGHT_TOP(JI,JL)/ZDG_TOP(JI)
+ ZWORK(JI)=ZWORK(JI)+MIN(1.0,PEK%XWG(JI,JL)/KK%XWFC(JI,JL))*ZWGHT_TOP(JI,JL)/ZDG_TOP(JI)
ENDDO
ENDDO
ENDIF
@@ -292,10 +267,10 @@ ELSE IF (HRESPSL == 'PRM') THEN
! RESP_ECO is directly calculated by the parameterization
!
! Before optimization
-! PRESP_ECO(:) = PRE25(:)/PRHOA(:) * MIN(PWG(:,1)/PWFC(:,1),1.)*2.**(ZCOEF4*(ZT2(:)-ZCOEF5))
- PRESP_ECO(:) = PRE25(:)/PRHOA(:) * ZWORK(:)*EXP(ZLOG2*(ZCOEF4*(ZTG_SUB(:)-ZCOEF5)))
+! DEK%XRESP_ECO(:) = PK%XRE25(:)/PRHOA(:) * MIN(PEK%XWG(:,1)/KK%XWFC(:),1.)*2.**(ZCOEF4*(ZT2(:)-ZCOEF5))
+ DEK%XRESP_ECO(:) = PK%XRE25(:)/PRHOA(:) * ZWORK(:)*EXP(ZLOG2*(ZCOEF4*(ZTG_SUB(:)-ZCOEF5)))
!
-ELSE IF (HRESPSL == 'CNT') THEN
+ELSE IF (IO%CRESPSL == 'CNT') THEN
!
! Heterotrophic respiration following CENTURY model from Gibelin et al. 2008
!
@@ -305,29 +280,29 @@ ELSE IF (HRESPSL == 'CNT') THEN
ZSAT_SUB (:)=0.0
ZSAND_SUB (:)=0.0
!
- IF(HISBA/='DIF')THEN
+ IF(IO%CISBA/='DIF')THEN
!
- ZMOIST_TOP(:) = MIN(1.0,MAX(0.0,(PWG(:,1)-PWWILT(:,1))/(PWFC (:,1)-PWWILT(:,1))))
- ZSAT_TOP (:) = MIN(1.0,MAX(0.0,(PWG(:,1)-PWFC (:,1))/(PWSAT(:,1)-PWFC (:,1))))
- ZMOIST_SUB(:) = MIN(1.0,MAX(0.0,(PWG(:,2)-PWWILT(:,2))/(PWFC (:,2)-PWWILT(:,2))))
- ZSAT_SUB (:) = MIN(1.0,MAX(0.0,(PWG(:,2)-PWFC (:,2))/(PWSAT(:,2)-PWFC (:,2))))
+ ZMOIST_TOP(:) = MIN(1.0,MAX(0.0,(PEK%XWG(:,1)-KK%XWWILT(:,1))/(KK%XWFC (:,1)-KK%XWWILT(:,1))))
+ ZSAT_TOP (:) = MIN(1.0,MAX(0.0,(PEK%XWG(:,1)-KK%XWFC (:,1))/(KK%XWSAT(:,1)-KK%XWFC (:,1))))
+ ZMOIST_SUB(:) = MIN(1.0,MAX(0.0,(PEK%XWG(:,2)-KK%XWWILT(:,2))/(KK%XWFC (:,2)-KK%XWWILT(:,2))))
+ ZSAT_SUB (:) = MIN(1.0,MAX(0.0,(PEK%XWG(:,2)-KK%XWFC (:,2))/(KK%XWSAT(:,2)-KK%XWFC (:,2))))
!
- ZSAND_SUB (:) = PSAND (:,2)
+ ZSAND_SUB (:) = KK%XSAND (:,2)
!
ELSE
!
DO JL=1,INL
DO JI=1,INI
!
- ZMOISTL=MIN(1.0,MAX(0.0,(PWG(JI,JL)-PWWILT(JI,JL))/(PWFC (JI,JL)-PWWILT(JI,JL))))
- ZSATL =MIN(1.0,MAX(0.0,(PWG(JI,JL)-PWFC (JI,JL))/(PWSAT(JI,JL)-PWFC (JI,JL))))
+ ZMOISTL=MIN(1.0,MAX(0.0,(PEK%XWG(JI,JL)-KK%XWWILT(JI,JL))/(KK%XWFC (JI,JL)-KK%XWWILT(JI,JL))))
+ ZSATL =MIN(1.0,MAX(0.0,(PEK%XWG(JI,JL)-KK%XWFC (JI,JL))/(KK%XWSAT(JI,JL)-KK%XWFC (JI,JL))))
!
ZMOIST_TOP(JI)=ZMOIST_TOP(JI)+ZMOISTL*ZWGHT_TOP(JI,JL)/ZDG_TOP(JI)
ZSAT_TOP (JI)=ZSAT_TOP (JI)+ZSATL *ZWGHT_TOP(JI,JL)/ZDG_TOP(JI)
ZMOIST_SUB(JI)=ZMOIST_SUB(JI)+ZMOISTL*ZWGHT_SUB(JI,JL)/ZDG_SUB(JI)
ZSAT_SUB (JI)=ZSAT_SUB (JI)+ZSATL *ZWGHT_SUB(JI,JL)/ZDG_SUB(JI)
!
- ZSAND_SUB(JI)=ZSAND_SUB(JI)+PSAND(JI,JL)*ZWGHT_SUB(JI,JL)/ZDG_SUB(JI)
+ ZSAND_SUB(JI)=ZSAND_SUB(JI)+KK%XSAND(JI,JL)*ZWGHT_SUB(JI,JL)/ZDG_SUB(JI)
!
ENDDO
ENDDO
@@ -339,13 +314,12 @@ ELSE IF (HRESPSL == 'CNT') THEN
ZCONTROL_MOIST(:,1) = CONTROL_MOIST_FUNC(ZMOIST_TOP(:),ZSAT_TOP(:))
ZCONTROL_MOIST(:,2) = CONTROL_MOIST_FUNC(ZMOIST_SUB(:),ZSAT_SUB(:))
!
- CALL CARBON_LITTER (PTSTEP,PTURNOVER,PLITTER,PLIGNIN_STRUC, &
- ZCONTROL_TEMP,ZCONTROL_MOIST, &
- ZRESP_HETERO_DAY_LITTER,ZSOILCARBON_INPUT)
+ CALL CARBON_LITTER (PTSTEP, PK%XTURNOVER, PEK%XLITTER, PEK%XLIGNIN_STRUC, &
+ ZCONTROL_TEMP, ZCONTROL_MOIST, ZRESP_HETERO_DAY_LITTER,ZSOILCARBON_INPUT)
!
- DO ITCSPIN = 1,KSPINS
- CALL CARBON_SOIL (PTSTEP,ZSAND_SUB,ZSOILCARBON_INPUT,ZCONTROL_TEMP,&
- ZCONTROL_MOIST,PSOILCARB,ZRESP_HETERO_DAY_SOIL )
+ DO ITCSPIN = 1,IO%NSPINS
+ CALL CARBON_SOIL (PTSTEP, ZSAND_SUB, ZSOILCARBON_INPUT, ZCONTROL_TEMP,&
+ ZCONTROL_MOIST, PEK%XSOILCARB, ZRESP_HETERO_DAY_SOIL )
ENDDO
!
! Transform units : gC/m2/day -> kgCO2/kgair m/s
@@ -355,7 +329,7 @@ ELSE IF (HRESPSL == 'CNT') THEN
!
! RESP_ECO is diagnosed from RESP_HETERO and RESP_AUTO
!
- PRESP_ECO(:) = ZRESP_HETERO(:) + PRESP_AUTO(:)
+ DEK%XRESP_ECO(:) = ZRESP_HETERO(:) + DEK%XRESP_AUTO(:)
!
ENDIF
!
diff --git a/src/SURFEX/carbon_init.F90 b/src/SURFEX/carbon_init.F90
index 4e12c1c0f5dde3f58feb37f58b292b0f6ab1ffca..911c906a85393e2a7822679c2913a5765981c43b 100644
--- a/src/SURFEX/carbon_init.F90
+++ b/src/SURFEX/carbon_init.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE CARBON_INIT(KNBIOMASS,KNLITTER, KNLITTLEVS, KNSOILCARB)
+ SUBROUTINE CARBON_INIT
! #####################
!
!!**** *CARBON_INIT* - routine to initialize soil carbon parameters
@@ -54,10 +54,6 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-INTEGER, INTENT(IN) :: KNBIOMASS ! number of biomass pools
-INTEGER, INTENT(IN) :: KNLITTER ! number of litter pools
-INTEGER, INTENT(IN) :: KNLITTLEVS ! number of litter levels
-INTEGER, INTENT(IN) :: KNSOILCARB ! number of soil carbon pools
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/carbon_spinup.F90 b/src/SURFEX/carbon_spinup.F90
index a16b8478e349e4cee5763cc46f5b8979565ab40c..538945e4f026cb64702599fefe64f2f0737a90d7 100644
--- a/src/SURFEX/carbon_spinup.F90
+++ b/src/SURFEX/carbon_spinup.F90
@@ -3,11 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE CARBON_SPINUP(KMONTH,KDAY,PTIME, &
- OSPINUPCARBS, OSPINUPCARBW, PSPINMAXS, PSPINMAXW, &
- KNBYEARSPINS, KNBYEARSPINW, KNBYEARSOLD, HPHOTO, &
- HRESPSL, KSPINS, KSPINW )
-
+ SUBROUTINE CARBON_SPINUP(TPTIME, IO )
+!
! #######################################################################
!
!
@@ -43,6 +40,9 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TYPE_DATE_SURF
+!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
USE MODI_SPINUP_MAX
!
@@ -51,25 +51,8 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
- CHARACTER(LEN=3), INTENT(IN) :: HRESPSL ! Soil Respiration
-! ! 'DEF' = Norman 1992
-! ! 'PRM' = Rivalland PhD Thesis (2003)
-! ! 'CNT' = CENTURY model (Gibelin 2008)
- CHARACTER(LEN=3), INTENT(IN) :: HPHOTO ! type of photosynthesis
-!
-INTEGER, INTENT(IN) :: KMONTH ! Current month
-INTEGER, INTENT(IN) :: KDAY ! Current day
-REAL, INTENT(IN) :: PTIME ! Current time
-LOGICAL, INTENT(IN) :: OSPINUPCARBS ! T: do the soil carb spinup, F: no
-LOGICAL, INTENT(IN) :: OSPINUPCARBW ! T: do the wood carb spinup, F: no
-REAL, INTENT(IN) :: PSPINMAXS ! max number of times CARBON_SOIL subroutine
-REAL, INTENT(IN) :: PSPINMAXW ! max number of times the wood is accelerated
-INTEGER, INTENT(IN) :: KNBYEARSPINS ! nbr years needed to reaches soil equilibrium
-INTEGER, INTENT(IN) :: KNBYEARSPINW ! nbr years needed to reaches wood equilibrium
-!
-INTEGER, INTENT(INOUT) :: KNBYEARSOLD ! nbr years executed at curent time step
-INTEGER, INTENT(OUT) :: KSPINS ! number of times the soil is accelerated
-INTEGER, INTENT(OUT) :: KSPINW ! number of times the wood is accelerated
+TYPE(DATE_TIME), INTENT(IN) :: TPTIME
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
!
!* 0. declarations of local variables
!
@@ -85,20 +68,20 @@ IF (LHOOK) CALL DR_HOOK('CARBON_SPINUP',0,ZHOOK_HANDLE)
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! number of times CARBON_SOIL subroutine is called for each time step
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-KSPINS =1
-IF ( OSPINUPCARBS .AND. HPHOTO/='NON' .AND. HRESPSL=='CNT' ) THEN
- CALL SPINUP_MAX(PSPINMAXS,KNBYEARSPINS,KNBYEARSOLD,KSPINS)
+IO%NSPINS =1
+IF ( IO%LSPINUPCARBS .AND. IO%CPHOTO/='NON' .AND. IO%CRESPSL=='CNT' ) THEN
+ CALL SPINUP_MAX(IO%XSPINMAXS,IO%NNBYEARSPINS,IO%NNBYEARSOLD,IO%NSPINS)
ENDIF
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! number of times WOOD carbon subroutine is called for each time step
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-KSPINW=1
-IF ( OSPINUPCARBW .AND. HPHOTO=='NCB' ) THEN
- CALL SPINUP_MAX(PSPINMAXW,KNBYEARSPINW,KNBYEARSOLD,KSPINW)
+IO%NSPINW=1
+IF ( IO%LSPINUPCARBW .AND. IO%CPHOTO=='NCB' ) THEN
+ CALL SPINUP_MAX(IO%XSPINMAXW,IO%NNBYEARSPINW,IO%NNBYEARSOLD,IO%NSPINW)
ENDIF
!
-IF (KMONTH == 1 .AND. KDAY==1 .AND. PTIME == 0.0 )THEN
- KNBYEARSOLD = KNBYEARSOLD + 1
+IF (TPTIME%TDATE%MONTH == 1 .AND. TPTIME%TDATE%DAY==1 .AND. TPTIME%TIME == 0.0 )THEN
+ IO%NNBYEARSOLD = IO%NNBYEARSOLD + 1
ENDIF
!
IF (LHOOK) CALL DR_HOOK('CARBON_SPINUP',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/ch_bvocemn.F90 b/src/SURFEX/ch_bvocemn.F90
index 76887ffa392d5612b3aeb70ee3ebcfcaffec5948..0b3504e362d4855d14cc85bbd7b25260d8703b46 100644
--- a/src/SURFEX/ch_bvocemn.F90
+++ b/src/SURFEX/ch_bvocemn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!! ###############################
- SUBROUTINE CH_BVOCEM_n (CHI, GB, I, &
- PSW_FORBIO,PRHOA,PSFTS)
+ SUBROUTINE CH_BVOCEM_n (SV, NGB, GB, IO, S, NP, NPE, PSW_FORBIO, PRHOA, PSFTS)
!! ###############################
!!
!!*** *BVOCEM*
@@ -31,9 +30,11 @@
!! EXTERNAL
!! --------
!
-USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
-USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_SV_n, ONLY : SV_t
+!
+USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t, GR_BIOG_NP_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_NP_t, ISBA_NPE_t
!
USE MODI_VEGTYPE_TO_PATCH
!!
@@ -47,25 +48,26 @@ USE MODD_ISBA_PAR
USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, NVT_TEBD, NVT_BONE, NVT_TRBE, &
NVT_TRBD, NVT_TEBE, NVT_TENE, NVT_BOBD, &
NVT_BOND, NVT_SHRB, NVT_BOGR, NVT_GRAS, &
- NVT_TROG, NVT_PARK, NVT_C3, NVT_C4, &
- NVT_IRR
-!!
-!!
+ NVT_TROG, NVT_PARK, NVT_FLTR, NVT_FLGR, &
+ NVT_C3, NVT_C3W, NVT_C3S, NVT_C4, NVT_IRR
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! -----------------
!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
IMPLICIT NONE
-
!
-TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
+TYPE(SV_t), INTENT(INOUT) :: SV
+TYPE(GR_BIOG_NP_t), INTENT(INOUT) :: NGB
TYPE(GR_BIOG_t), INTENT(INOUT) :: GB
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
!
REAL, DIMENSION(:,:), INTENT(IN) :: PSW_FORBIO
REAL, DIMENSION(:), INTENT(IN) :: PRHOA
@@ -84,7 +86,7 @@ REAL, DIMENSION(SIZE(PSW_FORBIO,1)) :: ZFISO_FOR , ZFMONO_FOR, &
! Fluxes coming from different landuse
REAL, DIMENSION(SIZE(PSW_FORBIO,1), NVEGTYPE) :: ZTCOR ,ZTCORM
!
-REAL, DIMENSION(SIZE(PSW_FORBIO,1),SIZE(I%XABC),NVEGTYPE) :: ZBVOCPAR
+REAL, DIMENSION(SIZE(PSW_FORBIO,1),SIZE(S%XABC),NVEGTYPE) :: ZBVOCPAR
! PAR at gauss level in micromolphot/m2/s
!
REAL, DIMENSION(SIZE(PSW_FORBIO,1)) :: ZISOPOT, ZMONOPOT, ZRATIO
@@ -92,7 +94,7 @@ REAL, DIMENSION(SIZE(PSW_FORBIO,1)) :: ZISOPOT, ZMONOPOT, ZRATIO
INTEGER:: KNGAUSS
! nbre of gauss level in integration
! index of patch corresponding to forest(+ligneaous)
-INTEGER:: JPATCH, JSV
+INTEGER:: JP, JSV, IMASK, JI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!------------------------------------------------------------------------------
@@ -112,39 +114,49 @@ IF (LHOOK) CALL DR_HOOK('CH_BVOCEM_N',0,ZHOOK_HANDLE)
!
!1.1.1 Using ISBA_Ags explicit light attenuation
! number of g Gauss level for the integration
-IF (I%CPHOTO/='NON') THEN
- KNGAUSS = SIZE(I%XABC)
+IF (IO%CPHOTO/='NON') THEN
+ KNGAUSS = SIZE(S%XABC)
ELSE
!1.1.2 using isba std version
ZRAD_PAR (:)= 0.
- DO JPATCH = 1,I%NPATCH
- ZRAD_PAR (:)= ZRAD_PAR (:) +(PSW_FORBIO(:,JPATCH)*I%XPATCH(:,JPATCH) ) * XPARCF * 4.7
+ DO JP = 1,IO%NPATCH
+ ZRAD_PAR (:)= ZRAD_PAR (:) +(PSW_FORBIO(:,JP)*S%XPATCH(:,JP) ) * XPARCF * 4.7
END DO
ZLCOR_RAD (:) = ZLCOR_FUNC(ZRAD_PAR(:))
ENDIF
!
!
- CALL BY_PATCH(NVT_TEBD, ZTCOR(:,NVT_TEBD), ZTCORM(:,NVT_TEBD))
- CALL BY_PATCH(NVT_BONE, ZTCOR(:,NVT_BONE), ZTCORM(:,NVT_BONE))
- CALL BY_PATCH(NVT_TRBE, ZTCOR(:,NVT_TRBE), ZTCORM(:,NVT_TRBE))
- CALL BY_PATCH(NVT_TRBD, ZTCOR(:,NVT_TRBD), ZTCORM(:,NVT_TRBD))
- CALL BY_PATCH(NVT_TEBE, ZTCOR(:,NVT_TEBE), ZTCORM(:,NVT_TEBE))
- CALL BY_PATCH(NVT_TENE, ZTCOR(:,NVT_TENE), ZTCORM(:,NVT_TENE))
- CALL BY_PATCH(NVT_BOBD, ZTCOR(:,NVT_BOBD), ZTCORM(:,NVT_BOBD))
- CALL BY_PATCH(NVT_BOND, ZTCOR(:,NVT_BOND), ZTCORM(:,NVT_BOND))
- CALL BY_PATCH(NVT_SHRB, ZTCOR(:,NVT_SHRB), ZTCORM(:,NVT_SHRB))
- CALL BY_PATCH(NVT_BOGR, ZTCOR(:,NVT_BOGR), ZTCORM(:,NVT_BOGR))
- CALL BY_PATCH(NVT_GRAS, ZTCOR(:,NVT_GRAS), ZTCORM(:,NVT_GRAS))
- CALL BY_PATCH(NVT_TROG, ZTCOR(:,NVT_TROG), ZTCORM(:,NVT_TROG))
- CALL BY_PATCH(NVT_PARK, ZTCOR(:,NVT_PARK), ZTCORM(:,NVT_PARK))
- CALL BY_PATCH(NVT_C3 , ZTCOR(:,NVT_C3) , ZTCORM(:,NVT_C3) )
- CALL BY_PATCH(NVT_C4 , ZTCOR(:,NVT_C4) , ZTCORM(:,NVT_C4) )
- CALL BY_PATCH(NVT_IRR , ZTCOR(:,NVT_IRR) , ZTCORM(:,NVT_IRR) )
-!
-!
-ZRATIO (:) = I%XVEGTYPE(:,NVT_TEBD) + I%XVEGTYPE(:,NVT_BONE) + I%XVEGTYPE(:,NVT_TRBE) + &
- I%XVEGTYPE(:,NVT_TRBD) + I%XVEGTYPE(:,NVT_TEBE) + I%XVEGTYPE(:,NVT_TENE) + &
- I%XVEGTYPE(:,NVT_BOBD) + I%XVEGTYPE(:,NVT_BOND) + I%XVEGTYPE(:,NVT_SHRB)
+CALL BY_PATCH(NVT_TEBD, ZTCOR(:,NVT_TEBD), ZTCORM(:,NVT_TEBD))
+CALL BY_PATCH(NVT_BONE, ZTCOR(:,NVT_BONE), ZTCORM(:,NVT_BONE))
+CALL BY_PATCH(NVT_TRBE, ZTCOR(:,NVT_TRBE), ZTCORM(:,NVT_TRBE))
+CALL BY_PATCH(NVT_TRBD, ZTCOR(:,NVT_TRBD), ZTCORM(:,NVT_TRBD))
+CALL BY_PATCH(NVT_TEBE, ZTCOR(:,NVT_TEBE), ZTCORM(:,NVT_TEBE))
+CALL BY_PATCH(NVT_TENE, ZTCOR(:,NVT_TENE), ZTCORM(:,NVT_TENE))
+CALL BY_PATCH(NVT_BOBD, ZTCOR(:,NVT_BOBD), ZTCORM(:,NVT_BOBD))
+CALL BY_PATCH(NVT_BOND, ZTCOR(:,NVT_BOND), ZTCORM(:,NVT_BOND))
+CALL BY_PATCH(NVT_SHRB, ZTCOR(:,NVT_SHRB), ZTCORM(:,NVT_SHRB))
+CALL BY_PATCH(NVT_BOGR, ZTCOR(:,NVT_BOGR), ZTCORM(:,NVT_BOGR))
+CALL BY_PATCH(NVT_GRAS, ZTCOR(:,NVT_GRAS), ZTCORM(:,NVT_GRAS))
+CALL BY_PATCH(NVT_TROG, ZTCOR(:,NVT_TROG), ZTCORM(:,NVT_TROG))
+IF (NVT_PARK/=0) THEN
+ CALL BY_PATCH(NVT_PARK, ZTCOR(:,NVT_PARK), ZTCORM(:,NVT_PARK))
+ELSEIF (NVT_FLTR/=0 .AND. NVT_FLGR/=0) THEN
+ CALL BY_PATCH(NVT_FLTR, ZTCOR(:,NVT_FLTR), ZTCORM(:,NVT_FLTR))
+ CALL BY_PATCH(NVT_FLGR, ZTCOR(:,NVT_FLGR), ZTCORM(:,NVT_FLGR))
+ENDIF
+IF (NVT_C3/=0) THEN
+ CALL BY_PATCH(NVT_C3 , ZTCOR(:,NVT_C3) , ZTCORM(:,NVT_C3) )
+ELSEIF (NVT_C3W/=0.AND.NVT_C3S/=0) THEN
+ CALL BY_PATCH(NVT_C3W , ZTCOR(:,NVT_C3W) , ZTCORM(:,NVT_C3W) )
+ CALL BY_PATCH(NVT_C3S , ZTCOR(:,NVT_C3S) , ZTCORM(:,NVT_C3S) )
+ENDIF
+CALL BY_PATCH(NVT_C4 , ZTCOR(:,NVT_C4) , ZTCORM(:,NVT_C4) )
+IF (NVT_IRR/=0) CALL BY_PATCH(NVT_IRR , ZTCOR(:,NVT_IRR) , ZTCORM(:,NVT_IRR) )
+!
+!
+ZRATIO (:) = S%XVEGTYPE(:,NVT_TEBD) + S%XVEGTYPE(:,NVT_BONE) + S%XVEGTYPE(:,NVT_TRBE) + &
+ S%XVEGTYPE(:,NVT_TRBD) + S%XVEGTYPE(:,NVT_TEBE) + S%XVEGTYPE(:,NVT_TENE) + &
+ S%XVEGTYPE(:,NVT_BOBD) + S%XVEGTYPE(:,NVT_BOND) + S%XVEGTYPE(:,NVT_SHRB)
!
WHERE (ZRATIO(:)/=0.)
ZISOPOT (:) = GB%XISOPOT (:) / ZRATIO(:)
@@ -154,16 +166,24 @@ ELSEWHERE
ZMONOPOT(:) = 0.
END WHERE
!
- CALL BY_VEG9(NVT_TEBD, NVT_BONE, NVT_TRBE, NVT_TRBD, NVT_TEBE, NVT_TENE, NVT_BOBD, &
- NVT_BOND, NVT_SHRB, ZISOPOT, ZMONOPOT, ZFISO_FOR, ZFMONO_FOR)
+CALL BY_VEG9(NVT_TEBD, NVT_BONE, NVT_TRBE, NVT_TRBD, NVT_TEBE, NVT_TENE, NVT_BOBD, &
+ NVT_BOND, NVT_SHRB, NVT_FLTR, ZISOPOT, ZMONOPOT, ZFISO_FOR, ZFMONO_FOR)
!
ZISOPOT (:) = XISOPOT_GRASS
ZMONOPOT(:) = XMONOPOT_GRASS
- CALL BY_VEG4(NVT_GRAS, NVT_TROG, NVT_PARK, NVT_BOGR, ZISOPOT, ZMONOPOT, ZFISO_GRASS, ZFMONO_GRASS)
+IF (NVT_PARK/=0) THEN
+ CALL BY_VEG4(NVT_GRAS, NVT_TROG, NVT_PARK, NVT_BOGR, ZISOPOT, ZMONOPOT, ZFISO_GRASS, ZFMONO_GRASS)
+ELSEIF (NVT_FLGR/=0) THEN
+ CALL BY_VEG4(NVT_GRAS, NVT_TROG, NVT_FLGR, NVT_BOGR, ZISOPOT, ZMONOPOT, ZFISO_GRASS, ZFMONO_GRASS)
+ENDIF
!
ZISOPOT (:) = XISOPOT_CROP
-ZMONOPOT(:) = XMONOPOT_CROP
- CALL BY_VEG3(NVT_C3, NVT_C4, NVT_IRR, ZISOPOT, ZMONOPOT, ZFISO_CROP, ZFMONO_CROP)
+ZMONOPOT(:) = XMONOPOT_CROP!
+IF (NVT_C3/=0 .AND. NVT_IRR/=0) THEN
+ CALL BY_VEG3(NVT_C3, NVT_C4, NVT_IRR, ZISOPOT, ZMONOPOT, ZFISO_CROP, ZFMONO_CROP)
+ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ CALL BY_VEG3(NVT_C3W, NVT_C3S, NVT_C4, ZISOPOT, ZMONOPOT, ZFISO_CROP, ZFMONO_CROP)
+ENDIF
!
!---------------------------------------------------------------------------------------
!
@@ -180,15 +200,15 @@ GB%XFMONO(:)=(1.5006E-10/3600.) * ( ZFMONO_FOR(:) + ZFMONO_GRASS(:)+ ZFMONO_CROP
GB%XFISO(:) = GB%XFISO(:) * XAVOGADRO * PRHOA(:) / XMD
GB%XFMONO(:) = GB%XFMONO(:) * XAVOGADRO * PRHOA(:) / XMD
!
-DO JSV=CHI%SVI%NSV_CHSBEG,CHI%SVI%NSV_CHSEND
- IF (CHI%SVI%CSV(JSV) == "BIO") THEN
+DO JSV=SV%NSV_CHSBEG,SV%NSV_CHSEND
+ IF (SV%CSV(JSV) == "BIO") THEN
! RELACS CASE
PSFTS(:,JSV) = PSFTS(:,JSV) + (GB%XFISO(:) + GB%XFMONO(:))
- ELSE IF (CHI%SVI%CSV(JSV) == "ISO" .OR. CHI%SVI%CSV(JSV) == "ISOP") THEN
+ ELSE IF (SV%CSV(JSV) == "ISO" .OR. SV%CSV(JSV) == "ISOP") THEN
! RACM CASE
PSFTS(:,JSV) = PSFTS(:,JSV) + GB%XFISO(:)
- ELSE IF (CHI%SVI%CSV(JSV) == "API" .OR. CHI%SVI%CSV(JSV) == "LIM" .OR. &
- CHI%SVI%CSV(JSV) == "BIOL" .OR. CHI%SVI%CSV(JSV) == "BIOH" ) THEN
+ ELSE IF (SV%CSV(JSV) == "API" .OR. SV%CSV(JSV) == "LIM" .OR. &
+ SV%CSV(JSV) == "BIOL" .OR. SV%CSV(JSV) == "BIOH" ) THEN
! RACM CASE
! CACM or RELACS 2 CASE
PSFTS(:,JSV) = PSFTS(:,JSV) + 0.5 * GB%XFMONO(:)
@@ -197,7 +217,7 @@ END DO
!
!**********************************************************************************
IF (LHOOK) CALL DR_HOOK('CH_BVOCEM_N',1,ZHOOK_HANDLE)
- CONTAINS
+CONTAINS
!
SUBROUTINE BY_PATCH(NVT_VEGTYPE,PTCOR,PTCORM)
!
@@ -208,30 +228,36 @@ REAL, DIMENSION(:), INTENT(OUT) :: PTCOR
REAL, DIMENSION(:), INTENT(OUT) :: PTCORM
!
REAL, DIMENSION(SIZE(PSW_FORBIO,1)) :: ZBVOCSG
-REAL, DIMENSION(SIZE(PSW_FORBIO,1),SIZE(I%XABC)) :: ZBVOCPAR
+REAL, DIMENSION(SIZE(PSW_FORBIO,1),SIZE(S%XABC)) :: ZBVOCPAR
INTEGER:: IPATCH, JLAYER, IT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('CH_BVOCEM_N:BY_PATCH',0,ZHOOK_HANDLE)
!
-IPATCH = VEGTYPE_TO_PATCH(NVT_VEGTYPE, I%NPATCH)
+IPATCH = VEGTYPE_TO_PATCH(NVT_VEGTYPE, IO%NPATCH)
!
PTCOR (:) = 0.
PTCORM (:) = 0.
-DO IT=1,SIZE(I%XTG,1)
- IF (I%XTG(IT,1,IPATCH).LE.1000.) THEN
- PTCORM(IT)=ZTCORM0_FUNC(I%XTG(IT,1,IPATCH))
- PTCOR (IT)=ZTCOR0_FUNC (I%XTG(IT,1,IPATCH))
+ZBVOCPAR(:,:) = 0.
+!
+DO IT=1,SIZE(NPE%AL(IPATCH)%XTG,1)
+ !
+ IMASK = NP%AL(IPATCH)%NR_P(IT)
+ IF (NPE%AL(IPATCH)%XTG(IT,1).LE.1000.) THEN
+ PTCORM(IMASK) = ZTCORM0_FUNC(NPE%AL(IPATCH)%XTG(IT,1))
+ PTCOR (IMASK) = ZTCOR0_FUNC (NPE%AL(IPATCH)%XTG(IT,1))
+ ENDIF
+ !PAR over Forest canopies, in micro-molE.m-2.s-1
+ IF (IO%CPHOTO/='NON') THEN
+ ZBVOCPAR(IMASK,:) = NGB%AL(IPATCH)%XIACAN(IT,:)*4.7
ENDIF
ENDDO
!
-IF (I%CPHOTO/='NON') THEN
- !PAR over Forest canopies, in micro-molE.m-2.s-1
- ZBVOCPAR(:,:) = GB%XIACAN(:,:,IPATCH)*4.7
+IF (IO%CPHOTO/='NON') THEN
!Calculation of radiative attenuation effect in the canopy on correction factor
ZBVOCSG(:) = 0.
DO JLAYER=1,KNGAUSS
- ZBVOCSG(:) = ZBVOCSG(:) + I%XPOI(JLAYER) * ZLCOR_FUNC(ZBVOCPAR(:,JLAYER))
+ ZBVOCSG(:) = ZBVOCSG(:) + S%XPOI(JLAYER) * ZLCOR_FUNC(ZBVOCPAR(:,JLAYER))
ENDDO
PTCOR(:) = PTCOR(:) * ZBVOCSG(:)
ELSE
@@ -262,17 +288,17 @@ IF (LHOOK) CALL DR_HOOK('CH_BVOCEM_N:BY_VEG3',0,ZHOOK_HANDLE)
!isoprene flux
!!
!! warning, XISOPOT external map accounts for the total forest fraction
-WHERE ( I%XVEGTYPE(:,NVT_V1) + I%XVEGTYPE(:,NVT_V2) + I%XVEGTYPE(:,NVT_V3) > 0. )
+WHERE ( S%XVEGTYPE(:,NVT_V1) + S%XVEGTYPE(:,NVT_V2) + S%XVEGTYPE(:,NVT_V3) > 0. )
!
PFISO(:) = PISOPOT(:) * &
- ( ZTCOR(:,NVT_V1) * I%XVEGTYPE(:,NVT_V1) &
- +ZTCOR(:,NVT_V2) * I%XVEGTYPE(:,NVT_V2) &
- +ZTCOR(:,NVT_V3) * I%XVEGTYPE(:,NVT_V3) )
+ ( ZTCOR(:,NVT_V1) * S%XVEGTYPE(:,NVT_V1) &
+ +ZTCOR(:,NVT_V2) * S%XVEGTYPE(:,NVT_V2) &
+ +ZTCOR(:,NVT_V3) * S%XVEGTYPE(:,NVT_V3) )
!
PFMONO(:) = PMONOPOT(:) * &
- ( ZTCORM(:,NVT_V1) * I%XVEGTYPE(:,NVT_V1) &
- +ZTCORM(:,NVT_V2) * I%XVEGTYPE(:,NVT_V2) &
- +ZTCORM(:,NVT_V3) * I%XVEGTYPE(:,NVT_V3) )
+ ( ZTCORM(:,NVT_V1) * S%XVEGTYPE(:,NVT_V1) &
+ +ZTCORM(:,NVT_V2) * S%XVEGTYPE(:,NVT_V2) &
+ +ZTCORM(:,NVT_V3) * S%XVEGTYPE(:,NVT_V3) )
!
ELSEWHERE
!
@@ -306,20 +332,20 @@ IF (LHOOK) CALL DR_HOOK('CH_BVOCEM_N:BY_VEG4',0,ZHOOK_HANDLE)
!isoprene flux
!!
!! warning, XISOPOT external map accounts for the total forest fraction
-WHERE ( I%XVEGTYPE(:,NVT_V1) + I%XVEGTYPE(:,NVT_V2) + I%XVEGTYPE(:,NVT_V3) &
- +I%XVEGTYPE(:,NVT_V4) > 0. )
+WHERE ( S%XVEGTYPE(:,NVT_V1) + S%XVEGTYPE(:,NVT_V2) + S%XVEGTYPE(:,NVT_V3) &
+ +S%XVEGTYPE(:,NVT_V4) > 0. )
!
PFISO(:) = PISOPOT(:) * &
- ( ZTCOR(:,NVT_V1) * I%XVEGTYPE(:,NVT_V1) &
- +ZTCOR(:,NVT_V2) * I%XVEGTYPE(:,NVT_V2) &
- +ZTCOR(:,NVT_V3) * I%XVEGTYPE(:,NVT_V3) &
- +ZTCOR(:,NVT_V4) * I%XVEGTYPE(:,NVT_V4) )
+ ( ZTCOR(:,NVT_V1) * S%XVEGTYPE(:,NVT_V1) &
+ +ZTCOR(:,NVT_V2) * S%XVEGTYPE(:,NVT_V2) &
+ +ZTCOR(:,NVT_V3) * S%XVEGTYPE(:,NVT_V3) &
+ +ZTCOR(:,NVT_V4) * S%XVEGTYPE(:,NVT_V4) )
!
PFMONO(:) = PMONOPOT(:) * &
- ( ZTCORM(:,NVT_V1) * I%XVEGTYPE(:,NVT_V1) &
- +ZTCORM(:,NVT_V2) * I%XVEGTYPE(:,NVT_V2) &
- +ZTCORM(:,NVT_V3) * I%XVEGTYPE(:,NVT_V3) &
- +ZTCORM(:,NVT_V4) * I%XVEGTYPE(:,NVT_V4) )
+ ( ZTCORM(:,NVT_V1) * S%XVEGTYPE(:,NVT_V1) &
+ +ZTCORM(:,NVT_V2) * S%XVEGTYPE(:,NVT_V2) &
+ +ZTCORM(:,NVT_V3) * S%XVEGTYPE(:,NVT_V3) &
+ +ZTCORM(:,NVT_V4) * S%XVEGTYPE(:,NVT_V4) )
!
ELSEWHERE
!
@@ -333,7 +359,7 @@ IF (LHOOK) CALL DR_HOOK('CH_BVOCEM_N:BY_VEG4',1,ZHOOK_HANDLE)
END SUBROUTINE BY_VEG4
!--------------------------------------------------------------------------
SUBROUTINE BY_VEG9(NVT_V1, NVT_V2, NVT_V3, NVT_V4, NVT_V5, NVT_V6, &
- NVT_V7, NVT_V8, NVT_V9, PISOPOT, PMONOPOT, PFISO, PFMONO)
+ NVT_V7, NVT_V8, NVT_V9, NVT_V10, PISOPOT, PMONOPOT, PFISO, PFMONO)
!
IMPLICIT NONE
!
@@ -346,50 +372,64 @@ INTEGER, INTENT(IN) :: NVT_V6
INTEGER, INTENT(IN) :: NVT_V7
INTEGER, INTENT(IN) :: NVT_V8
INTEGER, INTENT(IN) :: NVT_V9
+INTEGER, INTENT(IN) :: NVT_V10
REAL, DIMENSION(:), INTENT(IN) :: PISOPOT
REAL, DIMENSION(:), INTENT(IN) :: PMONOPOT
REAL, DIMENSION(:), INTENT(OUT) :: PFISO
REAL, DIMENSION(:), INTENT(OUT) :: PFMONO
!
+REAL :: ZSUM
+INTEGER :: JJ
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('CH_BVOCEM_N:BY_VEG9',0,ZHOOK_HANDLE)
!
-!isoprene flux
-!!
-!! warning, XISOPOT external map accounts for the total forest fraction
-WHERE ( I%XVEGTYPE(:,NVT_V1) + I%XVEGTYPE(:,NVT_V2) + I%XVEGTYPE(:,NVT_V3) &
- +I%XVEGTYPE(:,NVT_V4) + I%XVEGTYPE(:,NVT_V5) + I%XVEGTYPE(:,NVT_V6) &
- +I%XVEGTYPE(:,NVT_V7) + I%XVEGTYPE(:,NVT_V8) + I%XVEGTYPE(:,NVT_V9) > 0. )
+DO JJ=1,SIZE(ZTCOR,1)
!
- PFISO(:) = PISOPOT(:) * &
- ( ZTCOR(:,NVT_V1) * I%XVEGTYPE(:,NVT_V1) &
- +ZTCOR(:,NVT_V2) * I%XVEGTYPE(:,NVT_V2) &
- +ZTCOR(:,NVT_V3) * I%XVEGTYPE(:,NVT_V3) &
- +ZTCOR(:,NVT_V4) * I%XVEGTYPE(:,NVT_V4) &
- +ZTCOR(:,NVT_V5) * I%XVEGTYPE(:,NVT_V5) &
- +ZTCOR(:,NVT_V6) * I%XVEGTYPE(:,NVT_V6) &
- +ZTCOR(:,NVT_V7) * I%XVEGTYPE(:,NVT_V7) &
- +ZTCOR(:,NVT_V8) * I%XVEGTYPE(:,NVT_V8) &
- +ZTCOR(:,NVT_V9) * I%XVEGTYPE(:,NVT_V9) )
+ ZSUM = S%XVEGTYPE(JJ,NVT_V1) + S%XVEGTYPE(JJ,NVT_V2) + S%XVEGTYPE(JJ,NVT_V3) &
+ +S%XVEGTYPE(JJ,NVT_V4) + S%XVEGTYPE(JJ,NVT_V5) + S%XVEGTYPE(JJ,NVT_V6) &
+ +S%XVEGTYPE(JJ,NVT_V7) + S%XVEGTYPE(JJ,NVT_V8) + S%XVEGTYPE(JJ,NVT_V9)
+ IF (NVT_V10/=0) ZSUM = ZSUM + S%XVEGTYPE(JJ,NVT_V10)
!
- PFMONO(:) = PMONOPOT(:) * &
- ( ZTCORM(:,NVT_V1) * I%XVEGTYPE(:,NVT_V1) &
- +ZTCORM(:,NVT_V2) * I%XVEGTYPE(:,NVT_V2) &
- +ZTCORM(:,NVT_V3) * I%XVEGTYPE(:,NVT_V3) &
- +ZTCORM(:,NVT_V4) * I%XVEGTYPE(:,NVT_V4) &
- +ZTCORM(:,NVT_V5) * I%XVEGTYPE(:,NVT_V5) &
- +ZTCORM(:,NVT_V6) * I%XVEGTYPE(:,NVT_V6) &
- +ZTCORM(:,NVT_V7) * I%XVEGTYPE(:,NVT_V7) &
- +ZTCORM(:,NVT_V8) * I%XVEGTYPE(:,NVT_V8) &
- +ZTCORM(:,NVT_V9) * I%XVEGTYPE(:,NVT_V9) )
- !
-ELSEWHERE
- !
- PFISO(:) = 0.
- PFMONO(:) = 0.
+ !isoprene flux
+ !!
+ !! warning, XISOPOT external map accounts for the total forest fraction
+ IF ( ZSUM > 0. ) THEN
+ !
+ PFISO(JJ) = PISOPOT(JJ) * &
+ ( ZTCOR(JJ,NVT_V1) * S%XVEGTYPE(JJ,NVT_V1) &
+ +ZTCOR(JJ,NVT_V2) * S%XVEGTYPE(JJ,NVT_V2) &
+ +ZTCOR(JJ,NVT_V3) * S%XVEGTYPE(JJ,NVT_V3) &
+ +ZTCOR(JJ,NVT_V4) * S%XVEGTYPE(JJ,NVT_V4) &
+ +ZTCOR(JJ,NVT_V5) * S%XVEGTYPE(JJ,NVT_V5) &
+ +ZTCOR(JJ,NVT_V6) * S%XVEGTYPE(JJ,NVT_V6) &
+ +ZTCOR(JJ,NVT_V7) * S%XVEGTYPE(JJ,NVT_V7) &
+ +ZTCOR(JJ,NVT_V8) * S%XVEGTYPE(JJ,NVT_V8) &
+ +ZTCOR(JJ,NVT_V9) * S%XVEGTYPE(JJ,NVT_V9) )
+ !
+ IF (NVT_V10/=0) PFISO(JJ) = PFISO(JJ) + PISOPOT(JJ) * ZTCOR(JJ,NVT_V10) * S%XVEGTYPE(JJ,NVT_V10)
+ !
+ PFMONO(JJ) = PMONOPOT(JJ) * &
+ ( ZTCORM(JJ,NVT_V1) * S%XVEGTYPE(JJ,NVT_V1) &
+ +ZTCORM(JJ,NVT_V2) * S%XVEGTYPE(JJ,NVT_V2) &
+ +ZTCORM(JJ,NVT_V3) * S%XVEGTYPE(JJ,NVT_V3) &
+ +ZTCORM(JJ,NVT_V4) * S%XVEGTYPE(JJ,NVT_V4) &
+ +ZTCORM(JJ,NVT_V5) * S%XVEGTYPE(JJ,NVT_V5) &
+ +ZTCORM(JJ,NVT_V6) * S%XVEGTYPE(JJ,NVT_V6) &
+ +ZTCORM(JJ,NVT_V7) * S%XVEGTYPE(JJ,NVT_V7) &
+ +ZTCORM(JJ,NVT_V8) * S%XVEGTYPE(JJ,NVT_V8) &
+ +ZTCORM(JJ,NVT_V9) * S%XVEGTYPE(JJ,NVT_V9) )
+ !
+ IF (NVT_V10/=0) PFMONO(JJ) = PFMONO(JJ) + PMONOPOT(JJ) * ZTCORM(JJ,NVT_V10) * S%XVEGTYPE(JJ,NVT_V10)
+ !
+ ELSE
+ !
+ PFISO(JJ) = 0.
+ PFMONO(JJ) = 0.
+ !
+ ENDIF
!
-END WHERE
+ENDDO
!
IF (LHOOK) CALL DR_HOOK('CH_BVOCEM_N:BY_VEG9',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/ch_conversion_factor.F90 b/src/SURFEX/ch_conversion_factor.F90
index e93d8fd1f98b8455d6c7fb56ed1f56ca69808bfc..31cdb9b3729a95ea5935a27b81a48459f81da491 100644
--- a/src/SURFEX/ch_conversion_factor.F90
+++ b/src/SURFEX/ch_conversion_factor.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE CH_CONVERSION_FACTOR (CHN, &
- HCONVERSION,PRHOA)
+ SUBROUTINE CH_CONVERSION_FACTOR (PCONVERSION, HCONVERSION,PRHOA)
! #######################################
!
!!**** *CH_CONVERSION_FACTOR
@@ -32,8 +31,6 @@
!* 0. DECLARATIONS
!
!
-USE MODD_CH_SNAP_n, ONLY : CH_EMIS_SNAP_t
-!
USE MODD_CSTS, ONLY : XAVOGADRO, XMD
USE MODI_ABOR1_SFX
!
@@ -46,7 +43,7 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(CH_EMIS_SNAP_t), INTENT(INOUT) :: CHN
+REAL, DIMENSION(:), INTENT(INOUT) :: PCONVERSION
!
CHARACTER(LEN=3), INTENT(IN) :: HCONVERSION ! Unit conversion code
REAL, DIMENSION(:),INTENT(IN) :: PRHOA ! air density
@@ -58,14 +55,14 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('CH_CONVERSION_FACTOR',0,ZHOOK_HANDLE)
!
! determine the conversion factor
- CHN%XCONVERSION(:) = 1.
+PCONVERSION(:) = 1.
SELECT CASE (HCONVERSION)
CASE ('MIX') ! flux given ppp*m/s, conversion to molec/m2/s
- CHN%XCONVERSION(:) = XAVOGADRO * PRHOA(:) / XMD
+ PCONVERSION(:) = XAVOGADRO * PRHOA(:) / XMD
CASE ('CON') ! flux given in molecules/cm2/s, conversion to molec/m2/s
- CHN%XCONVERSION(:) = 1E4
+ PCONVERSION(:) = 1E4
CASE ('MOL') ! flux given in microMol/m2/day, conversion to molec/m2/s
- CHN%XCONVERSION(:) = 1E-6 * XAVOGADRO / 86400.
+ PCONVERSION(:) = 1E-6 * XAVOGADRO / 86400.
CASE DEFAULT
CALL ABOR1_SFX('CH_BUILDEMISSN: UNKNOWN CONVERSION FACTOR')
END SELECT
diff --git a/src/SURFEX/ch_dep_isba.F90 b/src/SURFEX/ch_dep_isba.F90
index 3ab9aa2ca5652e95c8a8e8d676930d6550b0af83..a7e18a7053519f49c79400f9d1a5ae4c6e1a2b17 100644
--- a/src/SURFEX/ch_dep_isba.F90
+++ b/src/SURFEX/ch_dep_isba.F90
@@ -3,10 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE CH_DEP_ISBA (PUSTAR, PHU, PPSN, &
- PVEG, PLAI, PSAND, PCLAY, PRESA, &
- PRS, PZ0, PTA, PPA, PTRAD, PNO, PROCK, &
- HSV, PSOILRC_SO2, PSOILRC_O3, PDEP )
+ SUBROUTINE CH_DEP_ISBA(KK, PK, PEK, D, DM, CHIK, PUSTAR, PTA, PPA, PTRAD, KSIZE )
!###########################################################
!!
!! PURPOSE
@@ -34,6 +31,13 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_DIAG_n, ONLY : DIAG_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
+!
+USE MODD_DATA_COVER_PAR, ONLY : NVT_NO, NVT_ROCK
+!
USE MODD_ISBA_PAR
USE MODD_DATA_COVER_PAR
USE MODD_CSTS
@@ -50,75 +54,69 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(CH_ISBA_t), INTENT(INOUT) :: CHIK
+
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DM
+!
REAL, DIMENSION(:), INTENT(IN) :: PUSTAR ! friction velocity
-REAL, DIMENSION(:), INTENT(IN) :: PHU ! soil humidity
-REAL, DIMENSION(:), INTENT(IN) :: PPSN ! fraction of the grid covered
- ! by snow
-REAL, DIMENSION(:), INTENT(IN) :: PRS ! stomatal resistance
-REAL, DIMENSION(:), INTENT(IN) :: PZ0 ! vegetation roughness length
-REAL, DIMENSION(:), INTENT(IN) :: PVEG ! vegetation fraction
-REAL, DIMENSION(:), INTENT(IN) :: PLAI ! Leaf area index
-REAL, DIMENSION(:,:), INTENT(IN) :: PSAND ! Sand fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PCLAY ! Clay fraction
-REAL, DIMENSION(:), INTENT(IN) :: PRESA ! aerodynamical resistance
REAL, DIMENSION(:), INTENT(IN) :: PTA ! air temperature forcing (K)
REAL, DIMENSION(:), INTENT(IN) :: PPA ! surface atmospheric pressure
REAL, DIMENSION(:), INTENT(IN) :: PTRAD ! radiative temperature (K)
-REAL, DIMENSION(:), INTENT(IN) :: PSOILRC_SO2 ! bare soil resistance for SO2
-REAL, DIMENSION(:), INTENT(IN) :: PSOILRC_O3 ! bare soil resistance for O3
-REAL, DIMENSION(:,:), INTENT(OUT) :: PDEP ! deposition dry velocity (m/s)
-REAL, DIMENSION(:), INTENT(IN) :: PNO, PROCK ! fractions of bare soil, rock
- CHARACTER(LEN=6), DIMENSION(:), INTENT(IN) :: HSV ! name of chemical
- ! species
+!
+INTEGER, INTENT(IN) :: KSIZE
!
!* 0.2 Declarations of local variables :
!
-REAL , DIMENSION(SIZE(PTRAD,1),size(HSV,1)) :: ZDIFFMOLVAL
+REAL , DIMENSION(SIZE(PTRAD),KSIZE) :: ZDIFFMOLVAL
! Molecular diffusivity
-REAL , DIMENSION(SIZE(PTRAD,1),size(HSV,1)) :: ZSCMDT
+REAL , DIMENSION(SIZE(PTRAD),KSIZE) :: ZSCMDT
! Sc(:)hmidt number
-REAL , DIMENSION(SIZE(PTRAD,1),size(HSV,1)) :: ZNATRB
+REAL , DIMENSION(SIZE(PTRAD),KSIZE) :: ZNATRB
! nature quasi-laminar resistances
!
-REAL , DIMENSION(SIZE(PTRAD,1),size(HSV,1)) :: ZHENRYVALCOR
-REAL , DIMENSION(SIZE(PTRAD,1),size(HSV,1)) :: ZSTOMRC
+REAL , DIMENSION(SIZE(PTRAD),KSIZE) :: ZHENRYVALCOR
+REAL , DIMENSION(SIZE(PTRAD),KSIZE) :: ZSTOMRC
! stomatal surface resistance
-REAL , DIMENSION(SIZE(PTRAD,1),size(HSV,1)) :: ZMESORC
+REAL , DIMENSION(SIZE(PTRAD),KSIZE) :: ZMESORC
! mesophyl resistance
-REAL , DIMENSION(SIZE(PTRAD,1),size(HSV,1)) :: ZEXTRC
+REAL , DIMENSION(SIZE(PTRAD),KSIZE) :: ZEXTRC
! leaf uptake external surface resistance
!
-REAL , DIMENSION(SIZE(PTRAD,1),size(HSV,1)) :: ZSOILRC
+REAL , DIMENSION(SIZE(PTRAD),KSIZE) :: ZSOILRC
! bare soil surface resistance
-REAL , DIMENSION(SIZE(PTRAD,1),size(HSV,1)) :: ZNATRC
+REAL , DIMENSION(SIZE(PTRAD),KSIZE) :: ZNATRC
! nature surface resistances where vegetation is
-REAL , DIMENSION(SIZE(PTRAD,1),size(HSV,1)) :: ZSNOWRC
+REAL , DIMENSION(SIZE(PTRAD),KSIZE) :: ZSNOWRC
! snow surface resistance
-REAL , DIMENSION(SIZE(PTRAD,1),size(HSV,1)) :: ZCLAYRC
+REAL , DIMENSION(SIZE(PTRAD),KSIZE) :: ZCLAYRC
! clay surface resistance
-REAL , DIMENSION(SIZE(PTRAD,1),size(HSV,1)) :: ZSANDRC
+REAL , DIMENSION(SIZE(PTRAD),KSIZE) :: ZSANDRC
! sand surface resistance
-REAL , DIMENSION(SIZE(PTRAD,1),size(HSV,1)) :: ZBARERC
+REAL , DIMENSION(SIZE(PTRAD),KSIZE) :: ZBARERC
! nature surface resistances for bare soils
-REAL , DIMENSION(SIZE(PTRAD,1),size(HSV,1)) :: ZROCKRC
+REAL , DIMENSION(SIZE(PTRAD),KSIZE) :: ZROCKRC
! nature surface resistances for rocks
!
-REAL , DIMENSION(SIZE(PTRAD,1),size(HSV,1)) :: ZRES_VEGTYPE
-REAL , DIMENSION(SIZE(PTRAD,1),size(HSV,1)) :: ZRES_SNOWTYPE
+REAL , DIMENSION(SIZE(PTRAD),KSIZE) :: ZRES_VEGTYPE
+REAL , DIMENSION(SIZE(PTRAD),KSIZE) :: ZRES_SNOWTYPE
!
! final nature resistance by vegtype
-REAL, DIMENSION(SIZE(PTRAD,1)) :: ZTYPE1_SAND, ZTYPE1_CLAY, ZTYPE1_SNOW ! Type soil 1
-REAL, DIMENSION(SIZE(PTRAD,1)) :: ZUSTAR
-REAL, DIMENSION(SIZE(PTRAD,1)) :: ZDIFFMOLH2O
+REAL, DIMENSION(SIZE(PTRAD)) :: ZTYPE1_SAND, ZTYPE1_CLAY, ZTYPE1_SNOW ! Type soil 1
+REAL, DIMENSION(SIZE(PTRAD)) :: ZUSTAR
+REAL, DIMENSION(SIZE(PTRAD)) :: ZDIFFMOLH2O
! final nature resistance
-REAL, DIMENSION(SIZE(PTRAD,1)) :: ZLANDEXT
+REAL, DIMENSION(SIZE(PTRAD)) :: ZLANDEXT
! computed Rext from Wesely tabulations (89)
-REAL, DIMENSION(SIZE(PTRAD,1)) :: ZINCRC
+REAL, DIMENSION(SIZE(PTRAD)) :: ZINCRC
! in-canopy transport resistance
-REAL, DIMENSION(SIZE(PTRAD,1)) :: ZCOEF1, ZCOEF2, ZCOEF3, ZCOEF4, ZCOEF5, ZINV1, ZINV2
-REAL, DIMENSION(SIZE(PTRAD,1)) :: ZTCOR
+REAL, DIMENSION(SIZE(PTRAD)) :: ZCOEF1, ZCOEF2, ZCOEF3, ZCOEF4, ZCOEF5, ZINV1, ZINV2
+REAL, DIMENSION(SIZE(PTRAD)) :: ZTCOR
!
-REAL, DIMENSION(size(HSV,1)) :: ZVAR1, ZVAR2, ZFACT1
+REAL, DIMENSION(KSIZE) :: ZVAR1, ZVAR2, ZFACT1
!
REAL :: ZTYPE2_SAND, ZTYPE2_CLAY, ZTYPE2_SNOW ! Type soil 2
!
@@ -160,7 +158,7 @@ ELSE
ZTYPE2_SNOW = 2000.
ENDIF
!
-DO JI = 1, SIZE(PVEG)
+DO JI = 1, SIZE(PEK%XVEG)
!
IF (XRCCLAYSO2.NE.XUNDEF) THEN
ZTYPE1_CLAY(JI) = XRCCLAYSO2
@@ -190,8 +188,8 @@ DO JI = 1, SIZE(PVEG)
! 3.2.5 In-canopy transport resistance
! ------------------------------
!
- IF (PVEG(JI) > 0.) THEN
- ZINCRC(JI) = 14. * PLAI(JI) * 4. * PZ0(JI) / ZUSTAR(JI)
+ IF (PEK%XVEG(JI) > 0.) THEN
+ ZINCRC(JI) = 14. * PEK%XLAI(JI) * 4. * PEK%XZ0(JI) / ZUSTAR(JI)
ELSE
ZINCRC(JI) = 1E-4
ENDIF
@@ -202,9 +200,9 @@ DO JI = 1, SIZE(PVEG)
IF ( XLANDREXT.NE.XUNDEF ) THEN
! user value
ZLANDEXT(JI) = XLANDREXT
- ELSEIF (PLAI(JI) /= XUNDEF) THEN
+ ELSEIF (PEK%XLAI(JI) /= XUNDEF) THEN
! computed value
- ZLANDEXT(JI) = 6000. - 4000. * TANH( 1.6 * (PLAI(JI) - 1.6) )
+ ZLANDEXT(JI) = 6000. - 4000. * TANH( 1.6 * (PEK%XLAI(JI) - 1.6) )
ELSE
ZLANDEXT(JI) = 9999.
END IF
@@ -213,7 +211,7 @@ DO JI = 1, SIZE(PVEG)
ZCOEF1(JI) = 1./298. - 1./PTA(JI)
!
ZDIFFMOLH2O(JI) = 2.22E-05 + 1.46E-07 * (PTA(JI) * (PPA(JI)/XP00)**(XRD/XCPD) - 273.)
- ZCOEF2(JI) = PRS(JI) * ZDIFFMOLH2O(JI)
+ ZCOEF2(JI) = DM%XRS(JI) * ZDIFFMOLH2O(JI)
!
ZCOEF3(JI) = 1./ZLANDEXT(JI)
!
@@ -226,14 +224,14 @@ DO JI = 1, SIZE(PVEG)
ZTCOR(JI) = MIN(2.5E3, ZCOEF4(JI))
!
!
- ZINV1(JI) = 1.E-5/PSOILRC_SO2(JI)
+ ZINV1(JI) = 1.E-5/CHIK%XSOILRC_SO2(JI)
!
- ZINV2(JI) = 1./PSOILRC_O3(JI)
+ ZINV2(JI) = 1./CHIK%XSOILRC_O3(JI)
!
ENDDO
!
!
-DO JSV = 1, SIZE(HSV,1)
+DO JSV = 1, KSIZE
!
ZVAR1(JSV) = XSREALREACTVAL(JSV) / 3000.
ZVAR2(JSV) = XSREALREACTVAL(JSV) * 100.
@@ -244,7 +242,7 @@ ENDDO
!
!============================================================================
!
-DO JSV = 1, SIZE(HSV,1)
+DO JSV = 1, KSIZE
!
DO JI = 1, SIZE(PTA)
!
@@ -262,13 +260,13 @@ DO JSV = 1, SIZE(HSV,1)
ZSCMDT(JI,JSV) = 0.15E-4 / ZDIFFMOLVAL(JI,JSV)
ZNATRB(JI,JSV) = ((ZSCMDT(JI,JSV)/0.72)**(2./3.)) * ZCOEF5(JI)
!
- IF (PLAI(JI)/=XUNDEF) ZNATRB(JI,JSV) = 2. * ZNATRB(JI,JSV)
+ IF (PEK%XLAI(JI)/=XUNDEF) ZNATRB(JI,JSV) = 2. * ZNATRB(JI,JSV)
!
ENDDO
!
ENDDO
!
-DO JSV = 1, SIZE(HSV,1)
+DO JSV = 1, KSIZE
!
DO JI = 1, SIZE(PTA)
!
@@ -284,7 +282,7 @@ DO JSV = 1, SIZE(HSV,1)
!
ZHENRYVALCOR(JI,JSV) = XSREALHENRYVAL(JSV,1) * EXP(XSREALHENRYVAL(JSV,2) * ZCOEF1(JI))
!
- IF (PRS(JI)>0.) THEN
+ IF (DM%XRS(JI)>0.) THEN
!
ZSTOMRC(JI,JSV) = ZCOEF2(JI) / ZDIFFMOLVAL(JI,JSV)
!
@@ -304,13 +302,13 @@ DO JSV = 1, SIZE(HSV,1)
! 3.2.4 External leaf uptake resistance (Wesely, 1989)
! -------------------------------
!
- IF (PHU(JI) >= 1.) THEN ! for dew-wetted surface
+ IF (D%XHU(JI) >= 1.) THEN ! for dew-wetted surface
!
! compute Rext for any species exept O3
! taking acount of (Walmsley, Wesely, 95, technical note, Atm Env vol 30)
ZEXTRC(JI,JSV) = 1./( ZCOEF3(JI) + 1.0E-7*ZHENRYVALCOR(JI,JSV) + ZVAR1(JSV) )
!
- ELSEIF ( PRS(JI) > 0. ) THEN
+ ELSEIF ( DM%XRS(JI) > 0. ) THEN
!
ZEXTRC(JI,JSV) = ZLANDEXT(JI) / ( 1.0E-5 * ZHENRYVALCOR(JI,JSV) + XSREALREACTVAL(JSV) )
!
@@ -320,11 +318,6 @@ DO JSV = 1, SIZE(HSV,1)
!
ENDIF
!
- ! IF ((HSV(JSV)=='O3').OR.(HSV(JSV)=='O_3')) &
- ! ZEXTRC(:,JSV) = ZEXTRC_O3(:)*ZTCOR(:)
- ! IF ((HSV(JSV)=='SO2').OR.(HSV(JSV)=='SO_2')) &
- ! ZEXTRC(:,JSV) = ZTCOR(:)* 1./ (1/5000 +1./(3 *ZLANDEXT(:)))
- !
! Temperature correction
! ----------------------
!
@@ -334,7 +327,7 @@ DO JSV = 1, SIZE(HSV,1)
!
ENDDO
!
-DO JSV = 1, SIZE(HSV,1)
+DO JSV = 1, KSIZE
!
DO JI = 1, SIZE(PTA)
!
@@ -373,7 +366,7 @@ DO JSV = 1, SIZE(HSV,1)
! 3.3.3 Compute surface resistance on bare soil
! ---------------------------------------
!
- ZBARERC(JI,JSV) = 1./ ( PSAND(JI,1)/ZSANDRC(JI,JSV) + (1.-PSAND(JI,1))/ZCLAYRC(JI,JSV) )
+ ZBARERC(JI,JSV) = 1./ ( KK%XSAND(JI,1)/ZSANDRC(JI,JSV) + (1.-KK%XSAND(JI,1))/ZCLAYRC(JI,JSV) )
!
! 3.3.4 Surface temperature correction
! ------------------------------
@@ -383,8 +376,8 @@ DO JSV = 1, SIZE(HSV,1)
! 3.3.5 Compute surface resistance on ROCK AREA
! ---------------------------------------
!
- ZROCKRC(JI,JSV) = ( 1.E5 * PSOILRC_SO2(JI) * PSOILRC_O3(JI) ) / &
- (ZHENRYVALCOR(JI,JSV)*PSOILRC_O3(JI) + PSOILRC_SO2(JI)*1.E5*XSREALREACTVAL(JSV) )
+ ZROCKRC(JI,JSV) = ( 1.E5 * CHIK%XSOILRC_SO2(JI) * CHIK%XSOILRC_O3(JI) ) / &
+ (ZHENRYVALCOR(JI,JSV)*CHIK%XSOILRC_O3(JI) + CHIK%XSOILRC_SO2(JI)*1.E5*XSREALREACTVAL(JSV) )
!
! 3.3.6 Surface temperature correction
! ------------------------------
@@ -409,18 +402,19 @@ DO JSV = 1, SIZE(HSV,1)
! --------------------------------------------
!
! add rocks into bare soil resistance computation, when present
- IF ( PROCK(JI)>0. ) THEN
- ZBARERC(JI,JSV) = ( PNO(JI)+PROCK(JI) )/( PNO(JI)/ZBARERC(JI,JSV) + PROCK(JI)/ZROCKRC(JI,JSV) )
+ IF ( PK%XVEGTYPE_PATCH(JI,NVT_ROCK)>0. ) THEN
+ ZBARERC(JI,JSV) = ( PK%XVEGTYPE_PATCH(JI,NVT_NO)+PK%XVEGTYPE_PATCH(JI,NVT_ROCK) ) / &
+ ( PK%XVEGTYPE_PATCH(JI,NVT_NO)/ZBARERC(JI,JSV) + PK%XVEGTYPE_PATCH(JI,NVT_ROCK)/ZROCKRC(JI,JSV) )
ENDIF
!
! computes resistance due to soil and vegetation
- ZNATRC(JI,JSV) = 1./ ( PVEG(JI)/ZNATRC(JI,JSV) + (1.-PVEG(JI))/ZBARERC(JI,JSV) )
+ ZNATRC(JI,JSV) = 1./ ( PEK%XVEG(JI)/ZNATRC(JI,JSV) + (1.-PEK%XVEG(JI))/ZBARERC(JI,JSV) )
!
ENDDO
!
ENDDO
!
-DO JSV = 1, SIZE(HSV,1)
+DO JSV = 1, KSIZE
!
DO JI = 1, SIZE(PTA)
!
@@ -429,10 +423,10 @@ DO JSV = 1, SIZE(HSV,1)
! 4.0 Compute nature resistance
! --------------------------
!
- ZRES_VEGTYPE (JI,JSV) = PRESA(JI) + ZNATRB(JI,JSV) + ZNATRC(JI,JSV)
- ZRES_SNOWTYPE(JI,JSV) = PRESA(JI) + ZNATRB(JI,JSV) + ZSNOWRC(JI,JSV)
+ ZRES_VEGTYPE (JI,JSV) = PEK%XRESA(JI) + ZNATRB(JI,JSV) + ZNATRC(JI,JSV)
+ ZRES_SNOWTYPE(JI,JSV) = PEK%XRESA(JI) + ZNATRB(JI,JSV) + ZSNOWRC(JI,JSV)
!
- PDEP(JI,JSV) = ( 1-PPSN(JI) )/ZRES_VEGTYPE(JI,JSV) + PPSN(JI)/ZRES_SNOWTYPE(JI,JSV)
+ CHIK%XDEP(JI,JSV) = ( 1-PEK%XPSN(JI) )/ZRES_VEGTYPE(JI,JSV) + PEK%XPSN(JI)/ZRES_SNOWTYPE(JI,JSV)
!
ENDDO
!
diff --git a/src/SURFEX/ch_emission_fluxn.F90 b/src/SURFEX/ch_emission_fluxn.F90
index cb6bfb7f2f2021318b5e995ab74ff88b646c1703..25b6a7e646b86a910fcd2d6f54bc7569a41a46c6 100644
--- a/src/SURFEX/ch_emission_fluxn.F90
+++ b/src/SURFEX/ch_emission_fluxn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE CH_EMISSION_FLUX_n (YSC, &
- HPROGRAM,PSIMTIME,PSFSV, PRHOA, PTSTEP, KNBTS_MAX)
+ SUBROUTINE CH_EMISSION_FLUX_n (DTCO, U, CHE, SV, CHU, HPROGRAM,PSIMTIME,PSFSV, PRHOA, PTSTEP, KNBTS_MAX)
! ######################################################################
!!
!!*** *CH_EMISSION_FLUX_n* -
@@ -37,8 +36,11 @@
!! IMPLICIT ARGUMENTS
!! ------------------
!
-!
-USE MODD_SURFEX_n, ONLY : SURFEX_t
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_CH_EMIS_FIELD_n, ONLY : CH_EMIS_FIELD_t
+USE MODD_SV_n, ONLY : SV_t
+USE MODD_CH_SURF_n, ONLY : CH_SURF_t
!
USE MODD_TYPE_EFUTIL, ONLY: EMISSVAR_T, PRONOSVAR_T
USE MODD_CSTS, ONLY: NDAYSEC
@@ -66,7 +68,11 @@ IMPLICIT NONE
!
!* 0.1 declaration of arguments
!
-TYPE(SURFEX_t), INTENT(INOUT) :: YSC
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(CH_EMIS_FIELD_t), INTENT(INOUT) :: CHE
+TYPE(SV_t), INTENT(INOUT) :: SV
+TYPE(CH_SURF_t), INTENT(INOUT) :: CHU
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
REAL, INTENT(IN) :: PSIMTIME ! time of simulation in sec UTC
@@ -89,7 +95,7 @@ INTEGER :: INBTS ! Number of emission times for a species
INTEGER :: ITIM1,ITIM2 ! first/last time for interpolation
INTEGER :: INDX1,INDX2 ! first/next index for data interpolation
INTEGER :: ISIMTIME, ITPERIOD
-CHARACTER (LEN=LEN_HREC) :: YRECFM ! LFI article name
+ CHARACTER (LEN=LEN_HREC) :: YRECFM ! LFI article name
TYPE(PRONOSVAR_T),POINTER :: CURPRONOS !Current pronostic variable
!
!* 0.3 declaration of saved local variables
@@ -126,51 +132,51 @@ INEQ = SIZE(PSFSV,2)
!* 3. INTERPOLATE SURFACE FLUXES IN TIME IF NEEDED
! ------------------------------------------------
!
-IF (YSC%CHE%XTIME_SIMUL == 0.) THEN
- YSC%CHE%XTIME_SIMUL = PSIMTIME
+IF (CHE%XTIME_SIMUL == 0.) THEN
+ CHE%XTIME_SIMUL = PSIMTIME
ELSE
- YSC%CHE%XTIME_SIMUL = YSC%CHE%XTIME_SIMUL + PTSTEP
+ CHE%XTIME_SIMUL = CHE%XTIME_SIMUL + PTSTEP
END IF
IF (IVERB >= 5) WRITE(ILUOUT,*) '******** CH_EMISSION_FLUX ********'
-DO JI=1,SIZE(YSC%CHE%TSEMISS)
+DO JI=1,SIZE(CHE%TSEMISS)
! Simulation time (counting from midnight) is saved
- ISIMTIME = YSC%CHE%XTIME_SIMUL
+ ISIMTIME = CHE%XTIME_SIMUL
!
- INBTS = SIZE(YSC%CHE%TSEMISS(JI)%NETIMES) !
- IWS = YSC%CHE%TSEMISS(JI)%NWS ! Window Size for I/O
- INDX1 = YSC%CHE%TSEMISS(JI)%NDX ! Current data index
+ INBTS = SIZE(CHE%TSEMISS(JI)%NETIMES) !
+ IWS = CHE%TSEMISS(JI)%NWS ! Window Size for I/O
+ INDX1 = CHE%TSEMISS(JI)%NDX ! Current data index
!
IF (INBTS == 1) THEN
! Time Constant Flux
! XFWORK already points on data (see ch_buildemiss.f90)
IF (IVERB >= 6) THEN
- WRITE(ILUOUT,*) 'NO interpolation for ',TRIM(YSC%CHE%TSEMISS(JI)%CNAME)
- IF (IVERB >= 10 ) WRITE(ILUOUT,*) YSC%CHE%TSEMISS(JI)%XFWORK
+ WRITE(ILUOUT,*) 'NO interpolation for ',TRIM(CHE%TSEMISS(JI)%CNAME)
+ IF (IVERB >= 10 ) WRITE(ILUOUT,*) CHE%TSEMISS(JI)%XFWORK
END IF
ELSE
IF (IVERB >= 6) THEN
- WRITE(ILUOUT,*) 'Interpolation (T =',ISIMTIME,') : ',YSC%CHE%TSEMISS(JI)%CNAME
+ WRITE(ILUOUT,*) 'Interpolation (T =',ISIMTIME,') : ',CHE%TSEMISS(JI)%CNAME
END IF
- IF (ISIMTIME < YSC%CHE%TSEMISS(JI)%NETIMES(1)) THEN
+ IF (ISIMTIME < CHE%TSEMISS(JI)%NETIMES(1)) THEN
! Tsim < T(1)=Tmin should not happen but who knows ?
- YSC%CHE%TSEMISS(JI)%NTX = 1
+ CHE%TSEMISS(JI)%NTX = 1
ELSE
! Check for periodicity when ISIMTIME is beyond last emission time
! and probably correct ISIMTIME
- IF (ISIMTIME > YSC%CHE%TSEMISS(JI)%NETIMES(INBTS)) THEN
+ IF (ISIMTIME > CHE%TSEMISS(JI)%NETIMES(INBTS)) THEN
! Tsim > T(INBTS)=Tmax
- ITPERIOD = (1+(YSC%CHE%TSEMISS(JI)%NETIMES(INBTS)-&
- YSC%CHE%TSEMISS(JI)%NETIMES(YSC%CHE%TSEMISS(JI)%NPX))/NDAYSEC)*NDAYSEC
- ISIMTIME = MODULO(ISIMTIME-YSC%CHE%TSEMISS(JI)%NETIMES(YSC%CHE%TSEMISS(JI)%NPX),ITPERIOD)+&
- YSC%CHE%TSEMISS(JI)%NETIMES(YSC%CHE%TSEMISS(JI)%NPX)
+ ITPERIOD = (1+(CHE%TSEMISS(JI)%NETIMES(INBTS)-&
+ CHE%TSEMISS(JI)%NETIMES(CHE%TSEMISS(JI)%NPX))/NDAYSEC)*NDAYSEC
+ ISIMTIME = MODULO(ISIMTIME-CHE%TSEMISS(JI)%NETIMES(CHE%TSEMISS(JI)%NPX),ITPERIOD)+&
+ CHE%TSEMISS(JI)%NETIMES(CHE%TSEMISS(JI)%NPX)
IF (IVERB >= 6) THEN
WRITE(ILUOUT,*) ' ITPERIOD = ', ITPERIOD
WRITE(ILUOUT,*) ' ISIMTIME modifie = ', ISIMTIME
END IF
- IF (YSC%CHE%TSEMISS(JI)%NTX == INBTS .AND. ISIMTIME<YSC%CHE%TSEMISS(JI)%NETIMES(INBTS)) THEN
+ IF (CHE%TSEMISS(JI)%NTX == INBTS .AND. ISIMTIME<CHE%TSEMISS(JI)%NETIMES(INBTS)) THEN
! Update time index NTX
- YSC%CHE%TSEMISS(JI)%NTX = YSC%CHE%TSEMISS(JI)%NPX
+ CHE%TSEMISS(JI)%NTX = CHE%TSEMISS(JI)%NPX
! Increment data index NDX : NDX correction will occur later
! to assure 1 <= NDX <= IWS
INDX1 = INDX1 + 1
@@ -180,9 +186,9 @@ DO JI=1,SIZE(YSC%CHE%TSEMISS)
! search NTX such that : ETIMES(NTX) < ISIMTIME <= ETIMES(NTX+1)
! and make NDX follow NTX : NDX correction will occur later
! to assure 1 <= NDX <= IWS
- DO WHILE (YSC%CHE%TSEMISS(JI)%NTX < INBTS)
- IF (ISIMTIME >= YSC%CHE%TSEMISS(JI)%NETIMES(YSC%CHE%TSEMISS(JI)%NTX+1)) THEN
- YSC%CHE%TSEMISS(JI)%NTX = YSC%CHE%TSEMISS(JI)%NTX + 1
+ DO WHILE (CHE%TSEMISS(JI)%NTX < INBTS)
+ IF (ISIMTIME >= CHE%TSEMISS(JI)%NETIMES(CHE%TSEMISS(JI)%NTX+1)) THEN
+ CHE%TSEMISS(JI)%NTX = CHE%TSEMISS(JI)%NTX + 1
INDX1 = INDX1 + 1
INDX2 = INDX1 + 1
ELSE
@@ -196,18 +202,17 @@ DO JI=1,SIZE(YSC%CHE%TSEMISS)
!
! Data index reached the memory window limits
!
- IF (YSC%CHE%TSEMISS(JI)%LREAD) THEN
+ IF (CHE%TSEMISS(JI)%LREAD) THEN
!
! File must be read to update XEMISDATA array for this species
!
IF (.NOT. LIOINIT) THEN
! Must be done once before reading
-CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
- HPROGRAM,'FULL ','SURF ','READ ')
+ CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'FULL ','SURF ','READ ')
IF (IVERB >= 6) WRITE(ILUOUT,*) 'INIT des I/O DONE.'
LIOINIT=.TRUE.
END IF
- YRECFM='E_'//TRIM(YSC%CHE%TSEMISS(JI)%CNAME)
+ YRECFM='E_'//TRIM(CHE%TSEMISS(JI)%CNAME)
IF (IVERB >= 6)&
WRITE (ILUOUT,*) 'READ emission :',TRIM(YRECFM),&
', SIZE(ZWORK)=',SIZE(ZWORK,1),INBTS
@@ -221,17 +226,17 @@ CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
ZWORK(:,1:INBTS) = 0.
END WHERE
DO ITIME=1,INBTS
- ZWORK(:,ITIME) = ZWORK(:,ITIME)*YSC%CHU%XCONVERSION(:)
+ ZWORK(:,ITIME) = ZWORK(:,ITIME)*CHU%XCONVERSION(:)
END DO
!
!
- IF ((YSC%CHE%TSEMISS(JI)%NTX+IWS-1) > INBTS) THEN
+ IF ((CHE%TSEMISS(JI)%NTX+IWS-1) > INBTS) THEN
!
! ===== Periodic CASE =====
!
IF (IVERB >= 6)&
- WRITE (ILUOUT,*) 'Periodic CASE : NPX =',YSC%CHE%TSEMISS(JI)%NPX
- IF (IWS < (INBTS-YSC%CHE%TSEMISS(JI)%NPX+1)) THEN
+ WRITE (ILUOUT,*) 'Periodic CASE : NPX =',CHE%TSEMISS(JI)%NPX
+ IF (IWS < (INBTS-CHE%TSEMISS(JI)%NPX+1)) THEN
! Window size is smaller then number of periodical times
!
! example : IWS=5, NPX=2, INBTS=11, NTX=9
@@ -243,23 +248,23 @@ CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
! |
! NDX
!
- YSC%CHE%TSEMISS(JI)%XEMISDATA(:,1:INBTS-YSC%CHE%TSEMISS(JI)%NTX+1) = &
- ZWORK(:,YSC%CHE%TSEMISS(JI)%NTX:INBTS)
+ CHE%TSEMISS(JI)%XEMISDATA(:,1:INBTS-CHE%TSEMISS(JI)%NTX+1) = &
+ ZWORK(:,CHE%TSEMISS(JI)%NTX:INBTS)
!
IF (IVERB >= 6) THEN
WRITE(ILUOUT,*) 'Window SIZE smaller than INBTS !'
WRITE(ILUOUT,*) 'Window index, Time index'
- DO JW=1,INBTS-YSC%CHE%TSEMISS(JI)%NTX+1
- WRITE(ILUOUT,*) JW,YSC%CHE%TSEMISS(JI)%NTX+JW-1
+ DO JW=1,INBTS-CHE%TSEMISS(JI)%NTX+1
+ WRITE(ILUOUT,*) JW,CHE%TSEMISS(JI)%NTX+JW-1
END DO
END IF
!
- YSC%CHE%TSEMISS(JI)%XEMISDATA(:,INBTS-YSC%CHE%TSEMISS(JI)%NTX+2:IWS) = &
- ZWORK(:,YSC%CHE%TSEMISS(JI)%NPX:YSC%CHE%TSEMISS(JI)%NPX+IWS-INBTS+YSC%CHE%TSEMISS(JI)%NTX-2)
+ CHE%TSEMISS(JI)%XEMISDATA(:,INBTS-CHE%TSEMISS(JI)%NTX+2:IWS) = &
+ ZWORK(:,CHE%TSEMISS(JI)%NPX:CHE%TSEMISS(JI)%NPX+IWS-INBTS+CHE%TSEMISS(JI)%NTX-2)
!
IF (IVERB >= 6) THEN
- DO JW=INBTS-YSC%CHE%TSEMISS(JI)%NTX+2,IWS
- WRITE(ILUOUT,*) JW,YSC%CHE%TSEMISS(JI)%NPX+JW-(INBTS-YSC%CHE%TSEMISS(JI)%NTX+2)
+ DO JW=INBTS-CHE%TSEMISS(JI)%NTX+2,IWS
+ WRITE(ILUOUT,*) JW,CHE%TSEMISS(JI)%NPX+JW-(INBTS-CHE%TSEMISS(JI)%NTX+2)
END DO
END IF
INDX1 = 1
@@ -277,19 +282,19 @@ CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
! |
! NDX=NTX-NPX+1
!
- IWS = INBTS-YSC%CHE%TSEMISS(JI)%NPX+1
- YSC%CHE%TSEMISS(JI)%NWS = IWS
- YSC%CHE%TSEMISS(JI)%XEMISDATA(:,1:IWS) = ZWORK(:,YSC%CHE%TSEMISS(JI)%NPX:INBTS)
+ IWS = INBTS-CHE%TSEMISS(JI)%NPX+1
+ CHE%TSEMISS(JI)%NWS = IWS
+ CHE%TSEMISS(JI)%XEMISDATA(:,1:IWS) = ZWORK(:,CHE%TSEMISS(JI)%NPX:INBTS)
IF (IVERB >= 6) THEN
WRITE(ILUOUT,*) 'Window SIZE equal or greater than INBTS !'
WRITE(ILUOUT,*) 'Window index, Time index'
DO JW=1,IWS
- WRITE(ILUOUT,*) JW,YSC%CHE%TSEMISS(JI)%NPX+JW-1
+ WRITE(ILUOUT,*) JW,CHE%TSEMISS(JI)%NPX+JW-1
END DO
END IF
- INDX1 = YSC%CHE%TSEMISS(JI)%NTX-YSC%CHE%TSEMISS(JI)%NPX+1
+ INDX1 = CHE%TSEMISS(JI)%NTX-CHE%TSEMISS(JI)%NPX+1
INDX2 = MOD((INDX1+1),IWS)
- YSC%CHE%TSEMISS(JI)%LREAD = .FALSE. ! no more reading
+ CHE%TSEMISS(JI)%LREAD = .FALSE. ! no more reading
END IF
ELSE
!
@@ -304,11 +309,11 @@ CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
! |
! NDX
!
- YSC%CHE%TSEMISS(JI)%XEMISDATA(:,1:IWS) = ZWORK(:,YSC%CHE%TSEMISS(JI)%NTX:YSC%CHE%TSEMISS(JI)%NTX+IWS-1)
+ CHE%TSEMISS(JI)%XEMISDATA(:,1:IWS) = ZWORK(:,CHE%TSEMISS(JI)%NTX:CHE%TSEMISS(JI)%NTX+IWS-1)
IF (IVERB >= 6) THEN
WRITE(ILUOUT,*) 'Window index, Time index'
DO JW=1,IWS
- WRITE(ILUOUT,*) JW,YSC%CHE%TSEMISS(JI)%NTX+JW-1
+ WRITE(ILUOUT,*) JW,CHE%TSEMISS(JI)%NTX+JW-1
END DO
END IF
INDX1 = 1
@@ -330,9 +335,9 @@ CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
! |
! NDX
- INDX1 = YSC%CHE%TSEMISS(JI)%NTX
+ INDX1 = CHE%TSEMISS(JI)%NTX
INDX2 = INDX1+1
- IF (INDX2 > IWS) INDX2=YSC%CHE%TSEMISS(JI)%NPX
+ IF (INDX2 > IWS) INDX2=CHE%TSEMISS(JI)%NPX
ELSE
!
! Windows size changed during periodic case
@@ -345,7 +350,7 @@ CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
! data index : [1 2 3 ... IWS]
! |
! NDX
- INDX1 = YSC%CHE%TSEMISS(JI)%NTX-YSC%CHE%TSEMISS(JI)%NPX+1
+ INDX1 = CHE%TSEMISS(JI)%NTX-CHE%TSEMISS(JI)%NPX+1
INDX2 = MOD((INDX1+1),IWS)
END IF
END IF
@@ -354,15 +359,15 @@ CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
END IF
!
! Don't forget to update NDX with new value INDX1
- YSC%CHE%TSEMISS(JI)%NDX = INDX1
+ CHE%TSEMISS(JI)%NDX = INDX1
!
! Compute both times for interpolation
- IF (YSC%CHE%TSEMISS(JI)%NTX < INBTS) THEN
- ITIM1 = YSC%CHE%TSEMISS(JI)%NETIMES(YSC%CHE%TSEMISS(JI)%NTX)
- ITIM2 = YSC%CHE%TSEMISS(JI)%NETIMES(YSC%CHE%TSEMISS(JI)%NTX+1)
+ IF (CHE%TSEMISS(JI)%NTX < INBTS) THEN
+ ITIM1 = CHE%TSEMISS(JI)%NETIMES(CHE%TSEMISS(JI)%NTX)
+ ITIM2 = CHE%TSEMISS(JI)%NETIMES(CHE%TSEMISS(JI)%NTX+1)
ELSE
- ITIM1 = YSC%CHE%TSEMISS(JI)%NETIMES(INBTS)
- ITIM2 = YSC%CHE%TSEMISS(JI)%NETIMES(YSC%CHE%TSEMISS(JI)%NPX)+ITPERIOD
+ ITIM1 = CHE%TSEMISS(JI)%NETIMES(INBTS)
+ ITIM2 = CHE%TSEMISS(JI)%NETIMES(CHE%TSEMISS(JI)%NPX)+ITPERIOD
END IF
!
! Interpolate variables in time -> update XFWORK
@@ -374,14 +379,14 @@ CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
!
!
ZALPHA = (REAL(ISIMTIME) - ITIM1) / (ITIM2-ITIM1)
- YSC%CHE%TSEMISS(JI)%XFWORK(:) = ZALPHA*YSC%CHE%TSEMISS(JI)%XEMISDATA(:,INDX2) +&
- (1.-ZALPHA)*YSC%CHE%TSEMISS(JI)%XEMISDATA(:,INDX1)
+ CHE%TSEMISS(JI)%XFWORK(:) = ZALPHA*CHE%TSEMISS(JI)%XEMISDATA(:,INDX2) +&
+ (1.-ZALPHA)*CHE%TSEMISS(JI)%XEMISDATA(:,INDX1)
IF (IVERB >= 6) THEN
- WRITE(ILUOUT,*) ' Current time INDEX : ',YSC%CHE%TSEMISS(JI)%NTX
+ WRITE(ILUOUT,*) ' Current time INDEX : ',CHE%TSEMISS(JI)%NTX
WRITE(ILUOUT,*) ' TIME : ',ISIMTIME, ' (',ITIM1,',',ITIM2,')'
- WRITE(ILUOUT,*) ' Window size : ',YSC%CHE%TSEMISS(JI)%NWS
+ WRITE(ILUOUT,*) ' Window size : ',CHE%TSEMISS(JI)%NWS
WRITE(ILUOUT,*) ' Current data INDEX : ',INDX1,INDX2
- IF (IVERB >= 10) WRITE(ILUOUT,*) ' FLUX : ',YSC%CHE%TSEMISS(JI)%XFWORK
+ IF (IVERB >= 10) WRITE(ILUOUT,*) ' FLUX : ',CHE%TSEMISS(JI)%XFWORK
END IF
END IF
END DO
@@ -392,12 +397,12 @@ ZEMIS(:,:) = 0.
!
! Point on head of Pronostic variable list
! to cover the entire list.
-IF (YSC%SV%NSV_AEREND > 0) THEN
- CNAMES=>YSC%SV%CSV(YSC%SV%NSV_CHSBEG:YSC%SV%NSV_AEREND)
+IF (SV%NSV_AEREND > 0) THEN
+CNAMES=>SV%CSV(SV%NSV_CHSBEG:SV%NSV_AEREND)
ELSE
- CNAMES=>YSC%SV%CSV(YSC%SV%NSV_CHSBEG:YSC%SV%NSV_CHSEND)
+CNAMES=>SV%CSV(SV%NSV_CHSBEG:SV%NSV_CHSEND)
END IF
- CURPRONOS=>YSC%CHE%TSPRONOSLIST
+CURPRONOS=>CHE%TSPRONOSLIST
DO WHILE(ASSOCIATED(CURPRONOS))
IF (CURPRONOS%NAMINDEX > INEQ) THEN
WRITE(ILUOUT,*) 'FATAL ERROR in CH_EMISSION_FLUXN : SIZE(ZEMIS,2) =',&
@@ -411,7 +416,7 @@ DO WHILE(ASSOCIATED(CURPRONOS))
DO JI=1,CURPRONOS%NBCOEFF
! Compute agregated flux
ZEMIS(:,CURPRONOS%NAMINDEX) = ZEMIS(:,CURPRONOS%NAMINDEX)+&
- CURPRONOS%XCOEFF(JI)*YSC%CHE%TSEMISS(CURPRONOS%NEFINDEX(JI))%XFWORK(:)
+ CURPRONOS%XCOEFF(JI)*CHE%TSEMISS(CURPRONOS%NEFINDEX(JI))%XFWORK(:)
END DO
IF (IVERB >= 6) THEN
@@ -427,11 +432,11 @@ DO WHILE(ASSOCIATED(CURPRONOS))
!
END DO
!
-IF ((LCH_AERO_FLUX).AND.(YSC%SV%NSV_AERBEG > 0)) THEN
+IF ((LCH_AERO_FLUX).AND.(SV%NSV_AERBEG > 0)) THEN
IF (GCO) THEN
- CALL CH_AER_EMISSION(ZEMIS, PRHOA, YSC%SV%CSV, YSC%SV%NSV_CHSBEG, PFCO=ZFCO)
+ CALL CH_AER_EMISSION(ZEMIS, PRHOA, SV%CSV, SV%NSV_CHSBEG, PFCO=ZFCO)
ELSE
- CALL CH_AER_EMISSION(ZEMIS, PRHOA, YSC%SV%CSV, YSC%SV%NSV_CHSBEG)
+ CALL CH_AER_EMISSION(ZEMIS, PRHOA, SV%CSV, SV%NSV_CHSBEG)
ENDIF
END IF
!
diff --git a/src/SURFEX/ch_emission_snapn.F90 b/src/SURFEX/ch_emission_snapn.F90
index 58da797bb29dcb3311eaf2b3c26ef3a3774a7de7..0c7a50e03920a32972ff66c2423e899557d4dd6c 100644
--- a/src/SURFEX/ch_emission_snapn.F90
+++ b/src/SURFEX/ch_emission_snapn.F90
@@ -25,6 +25,9 @@
!! -------------
!! Original 10/2011
!!
+!! A. Alias 07/2016 gmkpack problem : name of the internal subroutine modified
+!! because exist already (view SURFEX/day_of_week.F90 )
+!!
!! EXTERNAL
!! --------
!!
@@ -95,8 +98,7 @@ IF (LHOOK) CALL DR_HOOK('CH_EMISSION_SNAP_N',0,ZHOOK_HANDLE)
!* 1. Updates Conversion Factor (may depends on air density)
! ------------------------------------------------------
!
- CALL CH_CONVERSION_FACTOR(CHN, &
- CHN%CCONVERSION,PRHOA(:))
+ CALL CH_CONVERSION_FACTOR(CHN%XCONVERSION, CHN%CCONVERSION, PRHOA(:))
!
!------------------------------------------------------------------------------
!
@@ -140,7 +142,7 @@ SELECT CASE (CHN%CSNAP_TIME_REF)
END SELECT
!
- CALL DAY_OF_WEEK(IDAY(:,1), IMONTH(:,1), IYEAR(:,1), IDOW(:,1))
+ CALL DAY_OF_WEEK_CH(IDAY(:,1), IMONTH(:,1), IYEAR(:,1), IDOW(:,1))
!
IHOUR(:,1) = INT((ZTIME0(:)+1.E-10)/3600.)! 1.E-10 and the where condition after are
WHERE (IHOUR(:,1)==24) IHOUR(:,1)=23 ! set to avoid computer precision problems
@@ -158,7 +160,7 @@ DO JI=1,KSIZE
CALL ADD_FORECAST_TO_DATE_SURF(IYEAR(JI,2),IMONTH(JI,2),IDAY(JI,2),ZTIME(JI,2))
ENDDO
!
- CALL DAY_OF_WEEK(IDAY(:,2), IMONTH(:,2), IYEAR(:,2), IDOW(:,2))
+ CALL DAY_OF_WEEK_CH(IDAY(:,2), IMONTH(:,2), IYEAR(:,2), IDOW(:,2))
!
IHOUR(:,2)=NINT(ZTIME(:,2))/3600
!
@@ -200,9 +202,9 @@ END DO
IF (LHOOK) CALL DR_HOOK('CH_EMISSION_SNAP_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!
-SUBROUTINE DAY_OF_WEEK(DATE, MONTH, YEAR, DOW)
+SUBROUTINE DAY_OF_WEEK_CH(DATE, MONTH, YEAR, DOW)
!! AUTHOR
!! ------
!! J.Arteta
@@ -212,6 +214,9 @@ SUBROUTINE DAY_OF_WEEK(DATE, MONTH, YEAR, DOW)
!! MODifICATIONS
!! -------------
!! S. Queguiner 10/2011 DAY:Monday->Sunday => DOW:1->7
+!! A. Alias 07/2016 gmkpack problem : name of the internal subroutine modified
+!! because exist already (view SURFEX/day_of_week.F90 )
+!!
!
IMPLICIT NONE
INTEGER, DIMENSION(:), INTENT(IN) :: DATE, MONTH, YEAR
@@ -219,7 +224,7 @@ INTEGER, DIMENSION(:), INTENT(OUT):: DOW
INTEGER, DIMENSION(SIZE(DOW)) :: DAY, YR, MN, N1, N2
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-IF (LHOOK) CALL DR_HOOK('CH_EMISSION_SNAP_N:DAY_OF_WEEK',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('CH_EMISSION_SNAP_N:DAY_OF_WEEK_CH',0,ZHOOK_HANDLE)
!
YR = YEAR
MN = MONTH
@@ -236,7 +241,7 @@ DAY = (DATE + N1 + N2 - (YR / 100) + (YR / 400) - 1)
DOW = MOD(DAY,7) + 7
WHERE (DOW.GT.7) DOW = DOW - 7
!
-IF (LHOOK) CALL DR_HOOK('CH_EMISSION_SNAP_N:DAY_OF_WEEK',1,ZHOOK_HANDLE)
-END SUBROUTINE DAY_OF_WEEK
+IF (LHOOK) CALL DR_HOOK('CH_EMISSION_SNAP_N:DAY_OF_WEEK_CH',1,ZHOOK_HANDLE)
+END SUBROUTINE DAY_OF_WEEK_CH
!
END SUBROUTINE CH_EMISSION_SNAP_n
diff --git a/src/SURFEX/ch_emission_to_atmn.F90 b/src/SURFEX/ch_emission_to_atmn.F90
index 792ebfd193a23a9a80a38fe5db30ab3886f75a4a..2a8f3f725e0bc0e8111f63368ffe92f8ad7b3481 100644
--- a/src/SURFEX/ch_emission_to_atmn.F90
+++ b/src/SURFEX/ch_emission_to_atmn.F90
@@ -88,8 +88,8 @@ ZEMIS(:,:) = 0.
!
! Point on head of Pronostic variable list
! to cover the entire list.
- CNAMES=>SV%CSV
- CURPRONOS=>CHN%TSPRONOSLIST
+CNAMES=>SV%CSV
+CURPRONOS=>CHN%TSPRONOSLIST
!
DO WHILE(ASSOCIATED(CURPRONOS))
IF (CURPRONOS%NAMINDEX > ISV) CALL ABOR1_SFX('CH_EMISSION_FLUXN: FATAL ERROR')
diff --git a/src/SURFEX/ch_init_dep_isban.F90 b/src/SURFEX/ch_init_dep_isban.F90
index d8d91ed843fa7f7c3cbbea991be22b4d13883346..ede4fe7742233a749f22ebc3f7331d86e878dcca 100644
--- a/src/SURFEX/ch_init_dep_isban.F90
+++ b/src/SURFEX/ch_init_dep_isban.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE CH_INIT_DEP_ISBA_n (CHI, DTCO, I, &
+ SUBROUTINE CH_INIT_DEP_ISBA_n (CHI, NCHI, NP, DTCO, KPATCH, OCOVER, PCOVER, &
KCH,KLUOUT,KLU)
!! ##################################################
!!
@@ -63,9 +63,9 @@
!! --------
!
!
-USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
+USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t, CH_ISBA_NP_t
+USE MODD_ISBA_n, ONLY : ISBA_NP_t
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_ISBA_n, ONLY : ISBA_t
!
USE MODI_CH_OPEN_INPUTB ! open the general purpose ASCII input file
USE MODI_CONVERT_COVER_CH_ISBA
@@ -90,8 +90,13 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
+TYPE(CH_ISBA_NP_t), INTENT(INOUT) :: NCHI
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(ISBA_t), INTENT(INOUT) :: I
+!
+INTEGER, INTENT(IN) :: KPATCH
+LOGICAL, DIMENSION(:), INTENT(IN) :: OCOVER
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOVER
!
INTEGER, INTENT(IN) :: KCH ! chemistry input file
INTEGER, INTENT(IN) :: KLUOUT ! output listing channel
@@ -108,7 +113,7 @@ INTEGER :: IRESIS ! number of chemical reactivity factor to be read
REAL , DIMENSION(:), ALLOCATABLE :: ZRESISVAL
! chemical reactivity factor value
!
-INTEGER :: JI, JNREAL ! loop control variables
+INTEGER :: JI, JNREAL, JP ! loop control variables
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!=============================================================================
@@ -132,20 +137,23 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 2. Physiographic fields
!
- ALLOCATE(CHI%XSOILRC_SO2(KLU,I%NPATCH))
- ALLOCATE(CHI%XSOILRC_O3(KLU,I%NPATCH))
-
- CALL CONVERT_COVER_CH_ISBA(DTCO, &
- I%XCOVER,I%LCOVER,CHI%XSOILRC_SO2,CHI%XSOILRC_O3)
- !
- !---------------------------------------------------------------------------
- !
- !
- !* 3. read surface resistance SURF_RES
- !
- ALLOCATE(CHI%XDEP(KLU,CHI%SVI%NBEQ,I%NPATCH))
+ DO JP = 1,KPATCH
+ !
+ ALLOCATE(NCHI%AL(JP)%XSOILRC_SO2(NP%AL(JP)%NSIZE_P))
+ ALLOCATE(NCHI%AL(JP)%XSOILRC_O3 (NP%AL(JP)%NSIZE_P))
+ !
+ CALL CONVERT_COVER_CH_ISBA(DTCO, PCOVER, OCOVER, KPATCH, JP, NP%AL(JP), &
+ NCHI%AL(JP)%XSOILRC_SO2, NCHI%AL(JP)%XSOILRC_O3)
+ !
+ !---------------------------------------------------------------------------
+ !
+ !
+ !* 3. read surface resistance SURF_RES
+ !
+ ALLOCATE(NCHI%AL(JP)%XDEP(KLU,CHI%SVI%NBEQ))
+ !
+ ENDDO
!
-!$OMP SINGLE
! open input file
WRITE(KLUOUT,*) &
"CH_INIT_DEP_ISBA_n: reading reactivity factor "
@@ -158,19 +166,16 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! read data input format
READ(KCH,"(A)") YFORMAT
WRITE(KLUOUT,*) "input format is: ", YFORMAT
-!$OMP END SINGLE COPYPRIVATE(IRESIS,YFORMAT)
!
! allocate fields
ALLOCATE(YRESISNAME(IRESIS))
ALLOCATE(ZRESISVAL(IRESIS))
!
-!$OMP SINGLE
! read reactivity factor
DO JI = 1, IRESIS
READ(KCH,YFORMAT) YRESISNAME(JI), ZRESISVAL(JI)
WRITE(KLUOUT,YFORMAT) YRESISNAME(JI), ZRESISVAL(JI)
END DO
-!$OMP END SINGLE COPYPRIVATE(YRESISNAME,ZRESISVAL)
!
! close file
DO JNREAL = 1, IRESIS
@@ -199,7 +204,9 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
DEALLOCATE(YRESISNAME)
DEALLOCATE(ZRESISVAL)
ELSE
- ALLOCATE(CHI%XDEP(0,0,0))
+ DO JP = 1,KPATCH
+ ALLOCATE(NCHI%AL(JP)%XDEP(0,0))
+ ENDDO
END IF
IF (LHOOK) CALL DR_HOOK('CH_INIT_DEP_ISBA_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/ch_init_depconst.F90 b/src/SURFEX/ch_init_depconst.F90
index 812ccb6557f535837ffe61ad15ad81053fc44d67..ab695881a28f0db7ef8545fee016e4818f3b00a3 100644
--- a/src/SURFEX/ch_init_depconst.F90
+++ b/src/SURFEX/ch_init_depconst.F90
@@ -35,14 +35,14 @@
!! MODIFICATIONS
!! -------------
!! Original 16/02/01
-!! 2016 M.Leriche add open_namelist
+
!! EXTERNAL
!! --------
!!
! open the general purpose ASCII input file
USE MODI_OPEN_NAMELIST
USE MODI_CLOSE_NAMELIST
-
+!
USE MODI_CH_OPEN_INPUTB
USE MODD_CH_SURF
!!
@@ -89,9 +89,9 @@ REAL , DIMENSION(:,:), ALLOCATABLE :: ZHENRYVAL
!chemical Henry constant value
!
INTEGER :: ICH ! unit of input chemical file
+!
INTEGER :: JI, JN, JNREAL ! loop control variables
INTEGER :: INACT ! array pointer
-logical :: lopened
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
@@ -100,12 +100,11 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! --------------
!
IF (LHOOK) CALL DR_HOOK('CH_INIT_DEPCONST',0,ZHOOK_HANDLE)
-!$OMP SINGLE
IF(.NOT. ALLOCATED(XSREALMASSMOLVAL)) ALLOCATE( XSREALMASSMOLVAL(SIZE(HSV,1)) )
IF(.NOT. ALLOCATED(XSREALREACTVAL) ) ALLOCATE( XSREALREACTVAL(SIZE(HSV,1)) )
IF(.NOT. ALLOCATED(XSREALHENRYVAL) ) ALLOCATE( XSREALHENRYVAL(SIZE(HSV,1),2) )
!
-CALL OPEN_NAMELIST(HPROGRAM,ICH,HFILE=HCHEM_SURF_FILE)
+ CALL OPEN_NAMELIST(HPROGRAM,ICH,HFILE=HCHEM_SURF_FILE)
!
!* 2. read chemical molecular diffusivity MASS_MOL
!
@@ -121,15 +120,12 @@ CALL OPEN_NAMELIST(HPROGRAM,ICH,HFILE=HCHEM_SURF_FILE)
! read data input format
READ(ICH,"(A)") YFORMAT
WRITE(KLUOUT,*) "input format is: ", YFORMAT
-!$OMP END SINGLE COPYPRIVATE(IMASS,YFORMAT)
!
! allocate fields
ALLOCATE(YMASSMOLNAME(IMASS))
ALLOCATE(ZMASSMOLVAL(IMASS))
!
-inquire(ICH,NAME=YNAME,opened=lopened)
! read molecular diffusivity
-!$OMP SINGLE
DO JI = 1, IMASS
READ(ICH,YFORMAT) YMASSMOLNAME(JI), ZMASSMOLVAL(JI)
WRITE(KLUOUT,YFORMAT) YMASSMOLNAME(JI), ZMASSMOLVAL(JI)
@@ -141,7 +137,6 @@ inquire(ICH,NAME=YNAME,opened=lopened)
WRITE(KLUOUT,'(A)') 'molecular mass (in g/mol) for molecular diffusion'
WRITE(KLUOUT,'(I4)') SIZE(HSV,1)
WRITE(KLUOUT,'(A)') YOUTFORMAT
-!$OMP END SINGLE COPYPRIVATE(YMASSMOLNAME,ZMASSMOLVAL)
!
XSREALMASSMOLVAL(:) = 50. ! default molecular mass
DO JNREAL = 1, SIZE(HSV,1)
@@ -162,7 +157,6 @@ inquire(ICH,NAME=YNAME,opened=lopened)
!* 3. read molecular reactivity factor REA_FACT
!
! open input file
-!$OMP SINGLE
WRITE(KLUOUT,*) &
"CH_INIT_CONST: reading reactivity factor "
CALL CH_OPEN_INPUTB("REA_FACT", ICH, KLUOUT)
@@ -174,13 +168,11 @@ inquire(ICH,NAME=YNAME,opened=lopened)
! read data input format
READ(ICH,"(A)") YFORMAT
WRITE(KLUOUT,*) "input format is: ", YFORMAT
-!$OMP END SINGLE COPYPRIVATE(IREACT,YFORMAT)
!
! allocate fields
ALLOCATE(YREACTNAME(IREACT))
ALLOCATE(ZREACTVAL(IREACT))
! read reactivity factor
-!$OMP SINGLE
DO JI = 1, IREACT
READ(ICH,YFORMAT) YREACTNAME(JI), ZREACTVAL(JI)
WRITE(KLUOUT,YFORMAT) YREACTNAME(JI), ZREACTVAL(JI)
@@ -191,7 +183,6 @@ inquire(ICH,NAME=YNAME,opened=lopened)
WRITE(KLUOUT,'(A)') 'reactivity factor'
WRITE(KLUOUT,'(I4)') SIZE(HSV,1)
WRITE(KLUOUT,'(A)') YOUTFORMAT
-!$OMP END SINGLE COPYPRIVATE(YREACTNAME,ZREACTVAL)
!
XSREALREACTVAL(:) = 0.0 ! default (high surface resistance)
DO JNREAL = 1, SIZE(HSV,1)
@@ -215,7 +206,6 @@ inquire(ICH,NAME=YNAME,opened=lopened)
WRITE(KLUOUT,*) &
"CH_INIT_CONST: reading effective Henry constant", &
" and its temperature correction "
-!$OMP SINGLE
CALL CH_OPEN_INPUTB("HENRY_SP", ICH, KLUOUT)
!
! read number of molecular diffusivity IHENRY
@@ -225,14 +215,12 @@ inquire(ICH,NAME=YNAME,opened=lopened)
! read data input format
READ(ICH,"(A)") YFORMAT
WRITE(KLUOUT,*) "input format is: ", YFORMAT
-!$OMP END SINGLE COPYPRIVATe(IHENRY,YFORMAT)
!
! allocate fields
ALLOCATE(YHENRYNAME(IHENRY))
ALLOCATE(ZHENRYVAL(IHENRY,2))
!
! read reactivity factor
-!$OMP SINGLE
DO JNREAL = 1, IHENRY
READ(ICH,YFORMAT) YHENRYNAME(JNREAL), ZHENRYVAL(JNREAL,1),&
ZHENRYVAL(JNREAL,2)
@@ -245,7 +233,6 @@ inquire(ICH,NAME=YNAME,opened=lopened)
WRITE(KLUOUT,'(A)') 'Henrys law constants factor / exponent'
WRITE(KLUOUT,'(I4)') SIZE(HSV,1)
WRITE(KLUOUT,'(A)') YOUTFORMAT
-!$OMP END SINGLE COPYPRIVATE(YHENRYNAME,ZHENRYVAL)
!
XSREALHENRYVAL(:,1) = 1E-8 ! no deposition; low Henry constant
XSREALHENRYVAL(:,2) = 0. !
@@ -264,7 +251,7 @@ inquire(ICH,NAME=YNAME,opened=lopened)
XSREALHENRYVAL(JNREAL,2)
END DO
-CALL CLOSE_NAMELIST(HPROGRAM,ICH)
+ CALL CLOSE_NAMELIST(HPROGRAM,ICH)
IF (LHOOK) CALL DR_HOOK('CH_INIT_DEPCONST',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/ch_init_emissionn.F90 b/src/SURFEX/ch_init_emissionn.F90
index 6ff89e7e28da3b0891807d436b29e8c6cf3f5f9a..0210bb992b8141cb7a07f4d04f5f07f97c66cd82 100644
--- a/src/SURFEX/ch_init_emissionn.F90
+++ b/src/SURFEX/ch_init_emissionn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE CH_INIT_EMISSION_n (CHE, CHU, SV, &
- HPROGRAM,KLU,HINIT,PRHOA,HCHEM_SURF_FILE)
+ SUBROUTINE CH_INIT_EMISSION_n (CHE, PCONVERSION, HSV, HPROGRAM,KLU,HINIT,PRHOA,HCHEM_SURF_FILE)
! #######################################
!
!!**** *CH_INIT_EMIISION_n* - routine to initialize chemical emissions data structure
@@ -29,7 +28,6 @@
!! P.Tulet 01/01/04 introduction of rhodref for externalization
!! M.Leriche 04/2014 change length of CHARACTER for emission 6->12
!! M.Leriche & V. Masson 05/16 bug in write emis fields for nest
-!! J. Pianezze 04/17 wrong length of YCOMMENT (100 instead of 40)
!! 06/06/17 (V.Masson & M. Leriche) add emission time by species
!-----------------------------------------------------------------------------
!
@@ -37,18 +35,16 @@
!
!
USE MODD_CH_EMIS_FIELD_n, ONLY : CH_EMIS_FIELD_t
-USE MODD_CH_SURF_n, ONLY : CH_SURF_t
-USE MODD_SV_n, ONLY : SV_t
!
USE MODI_GET_LUOUT
USE MODI_BUILD_EMISSTAB_n
USE MODI_BUILD_PRONOSLIST_n
USE MODI_READ_SURF
-!
USE MODI_OPEN_NAMELIST
USE MODI_CLOSE_NAMELIST
USE MODI_READ_SURF_FIELD2D
!
+!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -61,23 +57,23 @@ IMPLICIT NONE
!
!
TYPE(CH_EMIS_FIELD_t), INTENT(INOUT) :: CHE
-TYPE(CH_SURF_t), INTENT(INOUT) :: CHU
-TYPE(SV_t), INTENT(INOUT) :: SV
+REAL, DIMENSION(:), POINTER :: PCONVERSION
+ CHARACTER(LEN=*), DIMENSION(:), POINTER :: HSV
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Program name
INTEGER, INTENT(IN) :: KLU ! number of points
- CHARACTER(LEN=3), INTENT(IN) :: HINIT ! Flag to know if one initializes:
+CHARACTER(LEN=3), INTENT(IN) :: HINIT ! Flag to know if one initializes:
! ! 'ALL' : all variables for a run
! ! 'PRE' : only variables to build
! ! an initial file
REAL, DIMENSION(:),INTENT(IN) :: PRHOA ! air density
- CHARACTER(LEN=28), INTENT(IN) :: HCHEM_SURF_FILE ! ascii file for chemistry aggregation
+CHARACTER(LEN=28), INTENT(IN) :: HCHEM_SURF_FILE ! ascii file for chemistry aggregation
!
!* 0.2 declarations of local variables
!
INTEGER :: IRESP ! File
INTEGER :: ILUOUT ! output listing logical unit
- CHARACTER (LEN=LEN_HREC) :: YRECFM ! management
+ CHARACTER (LEN=LEN_HREC) :: YRECFM ! management
CHARACTER (LEN=40) :: YCOMMENT ! variables
INTEGER :: JSPEC ! Loop index for cover data
INTEGER :: IIND1,IIND2 ! Indices counter
@@ -91,7 +87,7 @@ INTEGER :: INBTS ! number of emission times for a sp
INTEGER :: INBOFF ! Number of offline emissions
INTEGER :: IVERB ! verbose level
INTEGER :: ICH ! logical unit of input chemistry file
- CHARACTER(LEN=3) :: YSURF ! surface type
+CHARACTER(LEN=3) :: YSURF ! surface type
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK2D ! work array to read emission fields
!
INTEGER :: IVERSION ! version of surfex file being read
@@ -103,19 +99,16 @@ WRITE(ILUOUT,*) '------ Beginning of CH_INIT_EMISSION ------'
!
!* ascendant compatibility
YRECFM='VERSION'
- CALL READ_SURF( &
- HPROGRAM,YRECFM,IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
!
!* 1. Chemical Emission fields
! ------------------------
!
! Read the total number of emission files
IF (IVERSION>=4) THEN
- CALL READ_SURF( &
- HPROGRAM,'EMISFILE_NBR',CHE%NEMIS_NBR,IRESP)
+ CALL READ_SURF(HPROGRAM,'EMISFILE_NBR',CHE%NEMIS_NBR,IRESP)
ELSE
- CALL READ_SURF( &
- HPROGRAM,'EMISFILE_GR_NBR',CHE%NEMIS_NBR,IRESP)
+ CALL READ_SURF(HPROGRAM,'EMISFILE_GR_NBR',CHE%NEMIS_NBR,IRESP)
END IF
IF (IRESP/=0) THEN
CALL ABOR1_SFX('CH_INIT_EMISSIONN: PROBLEM WHEN READING NB OF 2D CHEMICAL EMISSION FIELDS')
@@ -123,11 +116,9 @@ END IF
!
! Read the number of emission species
IF (IVERSION>=4) THEN
- CALL READ_SURF( &
- HPROGRAM,'EMISPEC_NBR',CHE%NEMISPEC_NBR,IRESP)
+ CALL READ_SURF(HPROGRAM,'EMISPEC_NBR',CHE%NEMISPEC_NBR,IRESP)
ELSE
- CALL READ_SURF( &
- HPROGRAM,'EMISPEC_GR_NBR',CHE%NEMISPEC_NBR,IRESP)
+ CALL READ_SURF(HPROGRAM,'EMISPEC_GR_NBR',CHE%NEMISPEC_NBR,IRESP)
END IF
IF (IRESP/=0) THEN
CALL ABOR1_SFX('CH_INIT_EMISSIONN: PROBLEM WHEN READING NB OF EMITTED CHEMICAL SPECIES')
@@ -140,9 +131,9 @@ ELSE
WRITE(ILUOUT,*) 'CEMIS_NAME already allocated with SIZE :',SIZE(CHE%CEMIS_NAME)
END IF
-IF (.NOT. ASSOCIATED(CHE%NEMIS_NBT)) ALLOCATE(CHE%NEMIS_NBT(CHE%NEMISPEC_NBR))
+IF (.NOT. ASSOCIATED(CHE%NEMIS_NBT)) ALLOCATE(CHE%NEMIS_NBT(CHE%NEMISPEC_NBR))
IF (.NOT. ASSOCIATED(CHE%NEMIS_TIME)) ALLOCATE(CHE%NEMIS_TIME(CHE%NEMIS_NBR))
- CHE%NEMIS_TIME(:) = -1
+CHE%NEMIS_TIME(:) = -1
!
IF (HINIT/='ALL') THEN
ALLOCATE(CHE%XEMIS_FIELDS(KLU,CHE%NEMIS_NBR))
@@ -165,21 +156,18 @@ DO JSPEC = 1,CHE%NEMISPEC_NBR ! Loop on the number of species
! Read article EMISNAMExxx for the name of species
! and extract from comment : surface type + number of emission times
WRITE(YRECFM,'("EMISNAME",I3.3)') JSPEC
- CALL READ_SURF( &
- HPROGRAM,YRECFM,YSPEC_NAME,IRESP,YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,YSPEC_NAME,IRESP,YCOMMENT)
IF (IRESP/=0) THEN
CALL ABOR1_SFX('CH_INIT_EMISSIONN: PROBLEM WHEN READING NAME OF EMITTED CHEMICAL SPECIES')
END IF
WRITE(YRECFM,'("EMISNBT",I3.3)') JSPEC
- CALL READ_SURF( &
- HPROGRAM,YRECFM,INBTS,IRESP,YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,INBTS,IRESP,YCOMMENT)
WRITE(ILUOUT,*) ' Emission ',JSPEC,' : ',TRIM(YSPEC_NAME),'(',INBTS,' instants )'
!
! Read emission times for species number JSPEC
WRITE(YRECFM,'("EMISTIMES",I3.3)') JSPEC
- CALL READ_SURF( &
- HPROGRAM,YRECFM,ITIMES(1:INBTS),IRESP,YCOMMENT,'-')
+ CALL READ_SURF(HPROGRAM,YRECFM,ITIMES(1:INBTS),IRESP,YCOMMENT,'-')
IF (IRESP/=0) THEN
CALL ABOR1_SFX('CH_INIT_EMISSIONN: PROBLEM WHEN READING EMISSION TIMES')
END IF
@@ -202,12 +190,12 @@ DO JSPEC = 1,CHE%NEMISPEC_NBR ! Loop on the number of species
END IF
END IF
!
- CHE%NTIME_MAX = MAXVAL(CHE%NEMIS_TIME)
+CHE%NTIME_MAX = MAXVAL(CHE%NEMIS_TIME)
!
-! INBTIMES and CEMIS_NAME
+! INBTIMES and CEMIS_NAME
! are updated for ALL species
CHE%CEMIS_NAME(JSPEC) = YSPEC_NAME
-!
+!
!* 2. Simple reading of emission fields
IF (HINIT /= "ALL") THEN
@@ -218,16 +206,17 @@ DO JSPEC = 1,CHE%NEMISPEC_NBR ! Loop on the number of species
CHE%CEMIS_COMMENT(IIND1:IIND2) = YCOMMENT
DEALLOCATE(ZWORK2D)
END IF
-!
+!
END DO
!
CHE%NEMIS_NBT(:) = INBTIMES(:)
-
+!
WRITE(ILUOUT,*) '---- Nunmer of OFFLINE species = ',INBOFF
WRITE(ILUOUT,*) 'INBTIMES=',INBTIMES
WRITE(ILUOUT,*) 'IOFFNDX=',IOFFNDX
IVERB=6
+
!* 3. Conversion and aggregation
IF (HINIT == "ALL") THEN
@@ -236,22 +225,20 @@ IF (HINIT == "ALL") THEN
ALLOCATE(CHE%TSEMISS(INBOFF))
ALLOCATE(YEMIS_NAME(INBOFF))
- CALL BUILD_EMISSTAB_n( &
- CHU, &
- HPROGRAM,ICH,CHE%CEMIS_NAME,INBTIMES,CHE%NEMIS_TIME,&
- IOFFNDX,CHE%TSEMISS,KLU,ILUOUT,IVERB,PRHOA)
+ CALL BUILD_EMISSTAB_n(PCONVERSION, HPROGRAM,ICH,CHE%CEMIS_NAME,INBTIMES,CHE%NEMIS_TIME,&
+ IOFFNDX,CHE%TSEMISS,KLU,ILUOUT,IVERB,PRHOA)
DO JSPEC = 1,INBOFF ! Loop on the number of species
YEMIS_NAME(JSPEC) = CHE%TSEMISS(JSPEC)%CNAME(1:12)
END DO
- CALL BUILD_PRONOSLIST_n(SV, &
- SIZE(CHE%TSEMISS),YEMIS_NAME,CHE%TSPRONOSLIST,ICH,ILUOUT,IVERB)
+ CALL BUILD_PRONOSLIST_n(HSV, SIZE(CHE%TSEMISS),YEMIS_NAME,CHE%TSPRONOSLIST,ICH,ILUOUT,IVERB)
DEALLOCATE(YEMIS_NAME)
CALL CLOSE_NAMELIST(HPROGRAM,ICH)
ELSE
ALLOCATE(CHE%TSEMISS(0))
NULLIFY(CHE%TSPRONOSLIST)
END IF
-END IF
+ENDIF
+
DEALLOCATE(ITIMES,INBTIMES,IOFFNDX)
WRITE(ILUOUT,*) '------ Leaving CH_INIT_EMISSION ------'
IF (LHOOK) CALL DR_HOOK('CH_INIT_EMISSION_N',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/ch_init_names.F90 b/src/SURFEX/ch_init_names.F90
index 7689f92dae5981705726c19c1dc0030e8aff705f..b457f682cc8c993d40013eb344783cc175345672 100644
--- a/src/SURFEX/ch_init_names.F90
+++ b/src/SURFEX/ch_init_names.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE CH_INIT_NAMES (KLUOUT,HSV,KBEQ,KBAER,HSVO,&
- KSV_CHSBEG,KSV_CHSEND, KSV_AERBEG, KSV_AEREND,&
- OVARSIGI, OVARSIGJ)
+SUBROUTINE CH_INIT_NAMES (KLUOUT,HSV, SV, OVARSIGI, OVARSIGJ)
!! ###########################################
!!
!!*** *CH_INIT_NAMES*
@@ -34,6 +32,8 @@ SUBROUTINE CH_INIT_NAMES (KLUOUT,HSV,KBEQ,KBAER,HSVO,&
!!
!! IMPLICIT ARGUMENTS
!! ------------------
+USE MODD_SV_n, ONLY : SV_t
+!
USE MODD_CHS_AEROSOL
!-------------------------------------------------------------------------------
!
@@ -52,13 +52,8 @@ INTEGER, INTENT(IN) :: KLUOUT ! output listing channel
CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSV ! name of chemical species
! with character # (gas chemistry )
! and character @ (aerosols)
-INTEGER, INTENT(OUT) :: KBEQ ! number of chemical variables
-INTEGER, INTENT(OUT) :: KBAER ! number of aerosol variables
- CHARACTER(LEN=*), DIMENSION(SIZE(HSV)), INTENT(OUT) :: HSVO ! name of scalar species without # and @
-INTEGER, INTENT(OUT) :: KSV_CHSBEG ! first chemical var.
-INTEGER, INTENT(OUT) :: KSV_CHSEND ! last chemical var.
-INTEGER, INTENT(OUT) :: KSV_AERBEG ! first aerosol var.
-INTEGER, INTENT(OUT) :: KSV_AEREND ! last aerosol var.
+TYPE(SV_t), INTENT(INOUT) :: SV
+!
LOGICAL, INTENT(OUT) :: OVARSIGI, OVARSIGJ ! type of standard deviation
!
!* 0.2 declarations of local variables
@@ -70,12 +65,12 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('CH_INIT_NAMES',0,ZHOOK_HANDLE)
-KBEQ = 0
-KBAER = 0
-KSV_CHSBEG = 0
-KSV_AERBEG = 0
-KSV_CHSEND = 0
-KSV_AEREND = 0
+SV%NBEQ = 0
+SV%NAEREQ = 0
+SV%NSV_CHSBEG = 0
+SV%NSV_AERBEG = 0
+SV%NSV_CHSEND = 0
+SV%NSV_AEREND = 0
OVARSIGI = .FALSE.
OVARSIGJ = .FALSE.
NSOA = 0
@@ -83,48 +78,48 @@ NSOA = 0
DO JSV=1, SIZE(HSV)
- HSVO(JSV) = HSV(JSV)
+ SV%CSV(JSV) = HSV(JSV)
YRC1= HSV(JSV)(1:1)
YRC2 = HSV(JSV)(2:)
IF (YRC1 == '#') THEN
- HSVO(JSV) = TRIM(YRC2)
- KBEQ = KBEQ + 1
- IF (KBEQ == 1) KSV_CHSBEG=JSV
+ SV%CSV(JSV) = TRIM(YRC2)
+ SV%NBEQ = SV%NBEQ + 1
+ IF (SV%NBEQ == 1) SV%NSV_CHSBEG=JSV
ELSE IF (YRC1 == '@') THEN
- HSVO(JSV) = TRIM(YRC2)
- KBAER = KBAER + 1
- IF (KBAER == 1) KSV_AERBEG=JSV
- IF (HSVO(JSV) == "M6I") OVARSIGI = .TRUE.
- IF (HSVO(JSV) == "M6J") OVARSIGJ = .TRUE.
- IF (HSVO(JSV) == "SOA1I") NSOA = 10
+ SV%CSV(JSV) = TRIM(YRC2)
+ SV%NAEREQ = SV%NAEREQ + 1
+ IF (SV%NAEREQ == 1) SV%NSV_AERBEG=JSV
+ IF (SV%CSV(JSV) == "M6I") OVARSIGI = .TRUE.
+ IF (SV%CSV(JSV) == "M6J") OVARSIGJ = .TRUE.
+ IF (SV%CSV(JSV) == "SOA1I") NSOA = 10
ENDIF
ENDDO
-KSV_CHSEND = KSV_CHSBEG + KBEQ -1
-KSV_AEREND = KSV_AERBEG + KBAER -1
+SV%NSV_CHSEND = SV%NSV_CHSBEG + SV%NBEQ -1
+SV%NSV_AEREND = SV%NSV_AERBEG + SV%NAEREQ -1
-IF (KBAER .GT. 0) THEN
-DO JSV=1, size(HSVO)
- IF (TRIM(HSVO(JSV)) == "M0I") JP_CH_M0i=JSV-KSV_CHSEND
- IF (TRIM(HSVO(JSV)) == "M0J") JP_CH_M0j=JSV-KSV_CHSEND
- IF (TRIM(HSVO(JSV)) == "M6I") JP_CH_M6i=JSV-KSV_CHSEND
- IF (TRIM(HSVO(JSV)) == "M6J") JP_CH_M6j=JSV-KSV_CHSEND
- IF (TRIM(HSVO(JSV)) == "H2OI") JP_CH_H2Oi=JSV-KSV_CHSEND
- IF (TRIM(HSVO(JSV)) == "H2OJ") JP_CH_H2Oj=JSV-KSV_CHSEND
- IF (TRIM(HSVO(JSV)) == "SO4I") JP_CH_SO4i=JSV-KSV_CHSEND
- IF (TRIM(HSVO(JSV)) == "SO4J") JP_CH_SO4j=JSV-KSV_CHSEND
- IF (TRIM(HSVO(JSV)) == "NO3I") JP_CH_NO3i=JSV-KSV_CHSEND
- IF (TRIM(HSVO(JSV)) == "NO3J") JP_CH_NO3j=JSV-KSV_CHSEND
- IF (TRIM(HSVO(JSV)) == "NH3I") JP_CH_NH3i=JSV-KSV_CHSEND
- IF (TRIM(HSVO(JSV)) == "NH3J") JP_CH_NH3j=JSV-KSV_CHSEND
- IF (TRIM(HSVO(JSV)) == "OCI") JP_CH_OCi=JSV-KSV_CHSEND
- IF (TRIM(HSVO(JSV)) == "OCJ") JP_CH_OCj=JSV-KSV_CHSEND
- IF (TRIM(HSVO(JSV)) == "BCI") JP_CH_BCi=JSV-KSV_CHSEND
- IF (TRIM(HSVO(JSV)) == "BCJ") JP_CH_BCj=JSV-KSV_CHSEND
- IF (TRIM(HSVO(JSV)) == "DSTI") JP_CH_DSTi=JSV-KSV_CHSEND
- IF (TRIM(HSVO(JSV)) == "DSTJ") JP_CH_DSTj=JSV-KSV_CHSEND
+IF (SV%NAEREQ .GT. 0) THEN
+DO JSV=1, size(SV%CSV)
+ IF (TRIM(SV%CSV(JSV)) == "M0I") JP_CH_M0i=JSV-SV%NSV_CHSEND
+ IF (TRIM(SV%CSV(JSV)) == "M0J") JP_CH_M0j=JSV-SV%NSV_CHSEND
+ IF (TRIM(SV%CSV(JSV)) == "M6I") JP_CH_M6i=JSV-SV%NSV_CHSEND
+ IF (TRIM(SV%CSV(JSV)) == "M6J") JP_CH_M6j=JSV-SV%NSV_CHSEND
+ IF (TRIM(SV%CSV(JSV)) == "H2OI") JP_CH_H2Oi=JSV-SV%NSV_CHSEND
+ IF (TRIM(SV%CSV(JSV)) == "H2OJ") JP_CH_H2Oj=JSV-SV%NSV_CHSEND
+ IF (TRIM(SV%CSV(JSV)) == "SO4I") JP_CH_SO4i=JSV-SV%NSV_CHSEND
+ IF (TRIM(SV%CSV(JSV)) == "SO4J") JP_CH_SO4j=JSV-SV%NSV_CHSEND
+ IF (TRIM(SV%CSV(JSV)) == "NO3I") JP_CH_NO3i=JSV-SV%NSV_CHSEND
+ IF (TRIM(SV%CSV(JSV)) == "NO3J") JP_CH_NO3j=JSV-SV%NSV_CHSEND
+ IF (TRIM(SV%CSV(JSV)) == "NH3I") JP_CH_NH3i=JSV-SV%NSV_CHSEND
+ IF (TRIM(SV%CSV(JSV)) == "NH3J") JP_CH_NH3j=JSV-SV%NSV_CHSEND
+ IF (TRIM(SV%CSV(JSV)) == "OCI") JP_CH_OCi=JSV-SV%NSV_CHSEND
+ IF (TRIM(SV%CSV(JSV)) == "OCJ") JP_CH_OCj=JSV-SV%NSV_CHSEND
+ IF (TRIM(SV%CSV(JSV)) == "BCI") JP_CH_BCi=JSV-SV%NSV_CHSEND
+ IF (TRIM(SV%CSV(JSV)) == "BCJ") JP_CH_BCj=JSV-SV%NSV_CHSEND
+ IF (TRIM(SV%CSV(JSV)) == "DSTI") JP_CH_DSTi=JSV-SV%NSV_CHSEND
+ IF (TRIM(SV%CSV(JSV)) == "DSTJ") JP_CH_DSTj=JSV-SV%NSV_CHSEND
END DO
END IF
diff --git a/src/SURFEX/ch_init_snapn.F90 b/src/SURFEX/ch_init_snapn.F90
index e9ead2aa00466f8f7a13397dda711591a82f18c4..e81ddd9078bbf445de0194ad50d99886c7db1f62 100644
--- a/src/SURFEX/ch_init_snapn.F90
+++ b/src/SURFEX/ch_init_snapn.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE CH_INIT_SNAP_n (&
- CHN, SV, &
- HPROGRAM,KLU,HINIT,PRHOA,HCHEM_SURF_FILE)
+ SUBROUTINE CH_INIT_SNAP_n (CHN, HSV, HPROGRAM,KLU,HINIT,PRHOA,HCHEM_SURF_FILE)
! #######################################
!
!!**** *CH_INIT_EMIISION_TEMP_n* - routine to initialize chemical emissions data structure
@@ -33,24 +31,18 @@
!
!* 0. DECLARATIONS
!
-!
-!
-!
-!
-!
USE MODD_CH_SNAP_n, ONLY : CH_EMIS_SNAP_t
-USE MODD_SV_n, ONLY : SV_t
!
USE MODD_CSTS, ONLY : XAVOGADRO, XMD
USE MODI_GET_LUOUT
USE MODI_READ_SURF
-USE MODI_READ_SURF_FIELD2D
USE MODI_ABOR1_SFX
USE MODI_CH_CONVERSION_FACTOR
USE MODI_CH_OPEN_INPUTB
+USE MODI_BUILD_PRONOSLIST_n
+USE MODI_READ_SURF_FIELD2D
USE MODI_OPEN_NAMELIST
USE MODI_CLOSE_NAMELIST
-USE MODI_BUILD_PRONOSLIST_n
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -64,7 +56,7 @@ IMPLICIT NONE
!
!
TYPE(CH_EMIS_SNAP_t), INTENT(INOUT) :: CHN
-TYPE(SV_t), INTENT(INOUT) :: SV
+ CHARACTER(LEN=*), DIMENSION(:), POINTER :: HSV
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Program name
INTEGER, INTENT(IN) :: KLU ! number of points
@@ -73,7 +65,7 @@ INTEGER, INTENT(IN) :: KLU ! number of points
! ! 'PRE' : only variables to build
! ! an initial file
REAL, DIMENSION(:),INTENT(IN) :: PRHOA ! air density
- CHARACTER(LEN=28), INTENT(IN) :: HCHEM_SURF_FILE ! ascii file for chemistry aggregation
+CHARACTER(LEN=28), INTENT(IN) :: HCHEM_SURF_FILE ! ascii file for chemistry aggregation
!
!* 0.2 declarations of local variables
!
@@ -82,16 +74,16 @@ INTEGER :: ISNAP
INTEGER :: IRESP ! File
INTEGER :: ILUOUT ! output listing logical unit
CHARACTER (LEN=3) :: YCONVERSION
- CHARACTER (LEN=LEN_HREC) :: YRECFM ! management
+ CHARACTER (LEN=LEN_HREC) :: YRECFM ! management
CHARACTER (LEN=100) :: YCOMMENT ! variables
INTEGER :: JSPEC ! Loop index for chemical species
INTEGER :: JSNAP ! Loop index for SNAP categories
!
- CHARACTER(LEN=40) :: YSPEC_NAME ! species name
+ CHARACTER(LEN=40) :: YSPEC_NAME ! species name
!
-INTEGER :: IVERSION ! version of surfex file being read
-INTEGER :: IBUG ! version of SURFEX bugfix
-INTEGER :: ICH ! unit of input chemical file
+INTEGER :: IVERSION ! version of surfex file being read
+INTEGER :: IBUG ! version of SURFEX bugfix
+INTEGER :: ICH ! unit of input chemical file
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('CH_INIT_SNAP_N',0,ZHOOK_HANDLE)
@@ -99,23 +91,18 @@ IF (LHOOK) CALL DR_HOOK('CH_INIT_SNAP_N',0,ZHOOK_HANDLE)
!
!* ascendant compatibility
YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
YRECFM='BUG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IBUG,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IBUG,IRESP)
!
!* 1. Chemical Emission snap configuration
! ------------------------------------
!
! Read the number of emission species and snaps
IF (IVERSION>7 .OR. (IVERSION==7 .AND. IBUG>=3) ) THEN
- CALL READ_SURF(&
- HPROGRAM,'EMISPEC_NBR',CHN%NEMIS_NBR,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'SNAP_NBR',CHN%NEMIS_SNAP,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'SNAP_TIME',CHN%CSNAP_TIME_REF,IRESP)
+ CALL READ_SURF(HPROGRAM,'EMISPEC_NBR',CHN%NEMIS_NBR,IRESP)
+ CALL READ_SURF(HPROGRAM,'SNAP_NBR',CHN%NEMIS_SNAP,IRESP)
+ CALL READ_SURF(HPROGRAM,'SNAP_TIME',CHN%CSNAP_TIME_REF,IRESP)
ELSE
CALL ABOR1_SFX('CH_INIT_SNAPN: NO SNAP EMISSIONS IN SURFEX FILE: FILE TOO OLD')
END IF
@@ -123,9 +110,9 @@ END IF
! Number of instants for each temporal profile.
! For the time being, they are constant (even for the diurnal cycle)
!
- CHN%NSNAP_M=12 ! 12 months
- CHN%NSNAP_D=7 ! 7 day a week
- CHN%NSNAP_H=24 ! 24 hours a day (=> temporal resolution = 1 hour)
+CHN%NSNAP_M=12 ! 12 months
+CHN%NSNAP_D=7 ! 7 day a week
+CHN%NSNAP_H=24 ! 24 hours a day (=> temporal resolution = 1 hour)
!
!
!* 2. Chemical Emission fields
@@ -143,8 +130,7 @@ ALLOCATE(CHN%XSNAP_HOURLY (CHN%NSNAP_H,CHN%NEMIS_SNAP,CHN%NEMIS_NBR))
IF (CHN%CSNAP_TIME_REF=='LEGAL') THEN
ALLOCATE(CHN%XDELTA_LEGAL_TIME(KLU))
YRECFM='LEGALTIME'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,CHN%XDELTA_LEGAL_TIME(:),IRESP,YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,CHN%XDELTA_LEGAL_TIME(:),IRESP,YCOMMENT)
END IF
!
IF (HPROGRAM=="NC ") THEN
@@ -156,8 +142,7 @@ DO JSPEC = 1,CHN%NEMIS_NBR ! Loop on the number of species
!
! Read the species name
WRITE(YRECFM,'("EMISNAME",I3.3)') JSPEC
- CALL READ_SURF(&
- HPROGRAM,YRECFM,YSPEC_NAME,IRESP,YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,YSPEC_NAME,IRESP,YCOMMENT)
CHN%CEMIS_COMMENT(JSPEC)=YCOMMENT
IF (IRESP/=0) THEN
CALL ABOR1_SFX('CH_INIT_SNAPN: PROBLEM WHEN READING NAME OF EMITTED CHEMICAL SPECIES')
@@ -168,37 +153,30 @@ DO JSPEC = 1,CHN%NEMIS_NBR ! Loop on the number of species
! Read the potential emission of species for each snap
DO JSNAP=1,CHN%NEMIS_SNAP
WRITE(YRECFM,'("SN",I2.2,"_",A7)') JSNAP,CHN%CEMIS_NAME(JSPEC)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,CHN%XEMIS_FIELDS_SNAP(:,JSNAP,JSPEC),IRESP,YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,CHN%XEMIS_FIELDS_SNAP(:,JSNAP,JSPEC),IRESP,YCOMMENT)
END DO
!
! Read the temporal profiles of all snaps
YRECFM = "E_"//TRIM(CHN%CEMIS_NAME(JSPEC))//"_M"
IF (HPROGRAM=="NC ") THEN
- CALL READ_SURF_FIELD2D(&
- HPROGRAM,ZTEMP,YRECFM,YCOMMENT,HDIR='-')
+ CALL READ_SURF_FIELD2D(HPROGRAM,ZTEMP,YRECFM,YCOMMENT,HDIR='-')
CHN%XSNAP_MONTHLY(:,:,JSPEC) = ZTEMP(1:CHN%NSNAP_M,:)
ELSE
- CALL READ_SURF_FIELD2D(&
- HPROGRAM,CHN%XSNAP_MONTHLY(:,:,JSPEC),YRECFM,YCOMMENT,HDIR='-')
+ CALL READ_SURF_FIELD2D(HPROGRAM,CHN%XSNAP_MONTHLY(:,:,JSPEC),YRECFM,YCOMMENT,HDIR='-')
ENDIF
YRECFM = "E_"//TRIM(CHN%CEMIS_NAME(JSPEC))//"_D"
IF (HPROGRAM=="NC ") THEN
- CALL READ_SURF_FIELD2D(&
- HPROGRAM,ZTEMP,YRECFM,YCOMMENT,HDIR='-')
+ CALL READ_SURF_FIELD2D(HPROGRAM,ZTEMP,YRECFM,YCOMMENT,HDIR='-')
CHN%XSNAP_DAILY(:,:,JSPEC) = ZTEMP(1:CHN%NSNAP_D,:)
ELSE
- CALL READ_SURF_FIELD2D(&
- HPROGRAM,CHN%XSNAP_DAILY(:,:,JSPEC),YRECFM,YCOMMENT,HDIR='-')
+ CALL READ_SURF_FIELD2D(HPROGRAM,CHN%XSNAP_DAILY(:,:,JSPEC),YRECFM,YCOMMENT,HDIR='-')
ENDIF
YRECFM = "E_"//TRIM(CHN%CEMIS_NAME(JSPEC))//"_H"
IF (HPROGRAM=="NC ") THEN
- CALL READ_SURF_FIELD2D(&
- HPROGRAM,ZTEMP,YRECFM,YCOMMENT,HDIR='-')
+ CALL READ_SURF_FIELD2D(HPROGRAM,ZTEMP,YRECFM,YCOMMENT,HDIR='-')
CHN%XSNAP_HOURLY(:,:,JSPEC) = ZTEMP(1:CHN%NSNAP_H,:)
ELSE
- CALL READ_SURF_FIELD2D(&
- HPROGRAM,CHN%XSNAP_HOURLY(:,:,JSPEC),YRECFM,YCOMMENT,HDIR='-')
+ CALL READ_SURF_FIELD2D(HPROGRAM,CHN%XSNAP_HOURLY(:,:,JSPEC),YRECFM,YCOMMENT,HDIR='-')
ENDIF
END DO
!
@@ -209,27 +187,23 @@ IF (HPROGRAM=="NC ") DEALLOCATE(ZTEMP)
!
IF (HINIT=='ALL') THEN
CALL OPEN_NAMELIST(HPROGRAM,ICH,HFILE=HCHEM_SURF_FILE)
-!$OMP SINGLE
CALL CH_OPEN_INPUTB("EMISUNIT", ICH, ILUOUT)
!
! read unit identifier
READ(ICH,'(A3)') YCONVERSION
-!$OMP END SINGLE COPYPRIVATE(YCONVERSION)
!
- CHN%CCONVERSION = YCONVERSION
+ CHN%CCONVERSION = YCONVERSION
!
ALLOCATE (CHN%XCONVERSION(KLU))
! determine the conversion factor
- CALL CH_CONVERSION_FACTOR(CHN, &
- CHN%CCONVERSION,PRHOA)
+ CALL CH_CONVERSION_FACTOR(CHN%XCONVERSION, CHN%CCONVERSION,PRHOA)
!
!* 4. List of emissions to be aggregated into atm. chemical species
! -------------------------------------------------------------
!
- CALL BUILD_PRONOSLIST_n(SV, &
- CHN%NEMIS_NBR,CHN%CEMIS_NAME,CHN%TSPRONOSLIST,ICH,ILUOUT,6)
- CALL CLOSE_NAMELIST(HPROGRAM,ICH)
+ CALL BUILD_PRONOSLIST_n(HSV, CHN%NEMIS_NBR,CHN%CEMIS_NAME,CHN%TSPRONOSLIST,ICH,ILUOUT,6)
!
+ CALL CLOSE_NAMELIST(HPROGRAM,ICH)
!-------------------------------------------------------------------------------
END IF
!
diff --git a/src/SURFEX/choldc.F90 b/src/SURFEX/choldc.F90
deleted file mode 100644
index 9049defe924384ca24de2c492a30bb9ba3cbe4c3..0000000000000000000000000000000000000000
--- a/src/SURFEX/choldc.F90
+++ /dev/null
@@ -1,35 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE CHOLDC(N,A,P)
-
-USE MODI_ABOR1_SFX
-
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-
- IMPLICIT NONE
-
- INTEGER, INTENT(IN) :: N
- REAL, DIMENSION(N,N), INTENT(INOUT) :: A
- REAL, DIMENSION(N), INTENT(OUT) :: P
- INTEGER :: I
- REAL :: SUMM
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
- IF (LHOOK) CALL DR_HOOK('CHOLDC',0,ZHOOK_HANDLE)
- DO I=1,N
-
- SUMM = A(I,I)- DOT_PRODUCT(A(I,1:I-1),A(I,1:I-1))
-
- IF (SUMM <= 0.0) CALL ABOR1_SFX("CHOLDC:ERROR IN CHOLDC")
-
- P(I) = SQRT(SUMM)
- A(I+1:N,I) = (A(I,I+1:N) - MATMUL(A(I+1:N,1:I-1),A(I,1:I-1)))/P(I)
-
- ENDDO
-
- IF (LHOOK) CALL DR_HOOK('CHOLDC',1,ZHOOK_HANDLE)
-
-END SUBROUTINE CHOLDC
diff --git a/src/SURFEX/cholsl.F90 b/src/SURFEX/cholsl.F90
deleted file mode 100644
index 6edebd86d8b0e6ba19cb2cda91074c5d6a20432a..0000000000000000000000000000000000000000
--- a/src/SURFEX/cholsl.F90
+++ /dev/null
@@ -1,30 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE CHOLSL(N,A,P,B,X)
-
- USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
- USE PARKIND1 ,ONLY : JPRB
-
- IMPLICIT NONE
-
- INTEGER, INTENT(IN) :: N
- REAL, DIMENSION (N,N), INTENT(IN) :: A
- REAL, DIMENSION (N), INTENT(IN) :: P,B
- REAL, DIMENSION (N), INTENT(INOUT) :: X
- INTEGER :: I
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
- IF (LHOOK) CALL DR_HOOK('CHOLSL',0,ZHOOK_HANDLE)
-
- DO I=1,N
- X(I) = (B(I) - DOT_PRODUCT(A(I,1:I-1),X(1:I-1)))/P(I)
- ENDDO
- DO I=N,1,-1
- X(I) = (X(I) - DOT_PRODUCT(A(I+1:N,I),X(I+1:N)))/P(I)
- ENDDO
-
- IF (LHOOK) CALL DR_HOOK('CHOLSL',1,ZHOOK_HANDLE)
-
-END SUBROUTINE CHOLSL
diff --git a/src/SURFEX/circumsolar_rad.F90 b/src/SURFEX/circumsolar_rad.F90
index 5f64298be9af1d369f940ec0f84b98f7b3d20a14..abb8e9abcc85285c65527eeeb4a8c2f7246daa2c 100644
--- a/src/SURFEX/circumsolar_rad.F90
+++ b/src/SURFEX/circumsolar_rad.F90
@@ -85,7 +85,7 @@ ENDDO
IF (LHOOK) CALL DR_HOOK('MODE_CONV_DOE:CHTC_VERT_DOE',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
SUBROUTINE FIJ(PE, PF11, PF13)
REAL, DIMENSION(:), INTENT(IN) :: PE !sky clearness factor
REAL, DIMENSION(:), INTENT(OUT):: PF11
diff --git a/src/SURFEX/cli_lake.F90 b/src/SURFEX/cli_lake.F90
index 0ab85f686a7160a3830c55f050c746e633f3c7f5..377bd5a3588b09ddc0da1bb95cc48a7545829a45 100644
--- a/src/SURFEX/cli_lake.F90
+++ b/src/SURFEX/cli_lake.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #######
-SUBROUTINE CLI_LAKE (FG, F)
+SUBROUTINE CLI_LAKE (G, F)
! ###############
!
!!**** *CLI_LAKE* - prepares input for lake variables from climate data
@@ -31,7 +31,7 @@ SUBROUTINE CLI_LAKE (FG, F)
!
!
!
-USE MODD_FLAKE_GRID_n, ONLY : FLAKE_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_FLAKE_n, ONLY : FLAKE_t
!
USE MODI_START_LAKE_OF
@@ -47,7 +47,7 @@ IMPLICIT NONE
!* 0.2 declarations of local variables
!
!
-TYPE(FLAKE_GRID_t), INTENT(INOUT) :: FG
+TYPE(GRID_t), INTENT(INOUT) :: G
TYPE(FLAKE_t), INTENT(INOUT) :: F
!
INTEGER :: JI
@@ -56,8 +56,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('CLI_LAKE',0,ZHOOK_HANDLE)
-DO JI=1,SIZE(FG%XLAT)
- CALL START_LAKE_OF(F%TTIME%TDATE%DAY,F%TTIME%TDATE%MONTH,FG%XLON(JI),FG%XLAT(JI),&
+DO JI=1,SIZE(G%XLAT)
+ CALL START_LAKE_OF(F%TTIME%TDATE%DAY,F%TTIME%TDATE%MONTH,G%XLON(JI),G%XLAT(JI),&
F%XWATER_DEPTH(JI), F%XT_SNOW(JI),F%XT_ICE(JI),F%XT_MNW(JI),F%XT_WML(JI), &
F%XT_BOT(JI),F%XT_B1(JI),F%XCT(JI), &
F%XH_SNOW(JI),F%XH_ICE(JI),F%XH_ML(JI),F%XH_B1(JI),F%XTS(JI))
diff --git a/src/SURFEX/close_aux_io_surf.F90 b/src/SURFEX/close_aux_io_surf.F90
index 6936972be0b90936c8e584b215c581ab1e6c25b8..54ee0ee81320dffadcd25fdd5bd5c87303af8ca9 100644
--- a/src/SURFEX/close_aux_io_surf.F90
+++ b/src/SURFEX/close_aux_io_surf.F90
@@ -68,8 +68,13 @@ USE MODI_CLOSE_AUX_IO_SURF_NC
USE MODI_MNHCLOSE_AUX_IO_SURF
#endif
!
+#ifdef SFX_ARO
+USE MODI_AROCLOSE_AUX_IO_SURF
+#endif
+
IMPLICIT NONE
!
+!
!* 0.1 Declarations of arguments
! -------------------------
!
diff --git a/src/SURFEX/close_aux_io_surf_asc.F90 b/src/SURFEX/close_aux_io_surf_asc.F90
index dade315cbc5a1af9540b398489d331c4a93cf492..a63278b4fc952bcf7f40f9ae454846603d68bf90 100644
--- a/src/SURFEX/close_aux_io_surf_asc.F90
+++ b/src/SURFEX/close_aux_io_surf_asc.F90
@@ -58,11 +58,11 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('CLOSE_AUX_IO_SURF_ASC',0,ZHOOK_HANDLE)
- CLOSE(NUNIT)
+CLOSE(NUNIT)
!
NFULL=0
NUNIT=0
- CMASK=' '
+CMASK=' '
DEALLOCATE(NMASK)
IF (LHOOK) CALL DR_HOOK('CLOSE_AUX_IO_SURF_ASC',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/close_aux_io_surf_fa.F90 b/src/SURFEX/close_aux_io_surf_fa.F90
index 1e942a83abb4564241009fa2d1a8b47d6251d607..968404712e50def9bea77b1a12711e99fa2bbc7c 100644
--- a/src/SURFEX/close_aux_io_surf_fa.F90
+++ b/src/SURFEX/close_aux_io_surf_fa.F90
@@ -37,7 +37,7 @@
!* 0. DECLARATIONS
! ------------
!
-USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, NFULL, CMASK, NLUOUT, NMASK
+USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, NFULL, CMASK, NLUOUT, NMASK, CFILEIN_FA, CDNOMC, NMASK
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -51,7 +51,7 @@ IMPLICIT NONE
CHARACTER(LEN=28), INTENT(IN) :: HFILE ! file name
CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! main program
INTEGER :: IRET ! error code
- CHARACTER(LEN=28) :: YFILE
+CHARACTER(LEN=28) :: YFILE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.2 Declarations of local variables
@@ -62,13 +62,18 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('CLOSE_AUX_IO_SURF_FA',0,ZHOOK_HANDLE)
!
NFULL = 0
- CMASK=' '
+CMASK=' '
DEALLOCATE(NMASK)
- CALL FAIRME(IRET,NUNIT_FA,'UNKNOWN')
+CALL FAIRME(IRET,NUNIT_FA,'UNKNOWN')
!
YFILE=HFILE(1:LEN_TRIM(HFILE))//'.fa'
WRITE(NLUOUT,*)'HFILETYPE ',HFILETYPE,'END EXTERNAL',NUNIT_FA,YFILE
!
+CFILEIN_FA = ' '
+NUNIT_FA = 0
+!
+CDNOMC = 'header'
+!
IF (LHOOK) CALL DR_HOOK('CLOSE_AUX_IO_SURF_FA',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/close_file_asc.F90 b/src/SURFEX/close_file_asc.F90
index 87478c71b550984d28675f7e35e705c34b5118c7..c5bbbbb3379a59b32aac1d30615136d39566c9c0 100644
--- a/src/SURFEX/close_file_asc.F90
+++ b/src/SURFEX/close_file_asc.F90
@@ -59,7 +59,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! -------------------
!
IF (LHOOK) CALL DR_HOOK('CLOSE_FILE_ASC',0,ZHOOK_HANDLE)
- CLOSE(KUNIT)
+CLOSE(KUNIT)
IF (LHOOK) CALL DR_HOOK('CLOSE_FILE_ASC',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/close_file_fa.F90 b/src/SURFEX/close_file_fa.F90
index 16fb822ccab4c562a57c3be68968d6b3131c897c..81808794b0c98886e6413d6070614e8be06a491a 100644
--- a/src/SURFEX/close_file_fa.F90
+++ b/src/SURFEX/close_file_fa.F90
@@ -59,7 +59,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! -------------------
!
IF (LHOOK) CALL DR_HOOK('CLOSE_FILE_FA',0,ZHOOK_HANDLE)
- CLOSE(KUNIT)
+CLOSE(KUNIT)
IF (LHOOK) CALL DR_HOOK('CLOSE_FILE_FA',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/close_namelist.F90 b/src/SURFEX/close_namelist.F90
index 4279767b2c2ffe950693a62c594625b87641d837..7894a0d4c700334454a7bc15d1f9a595499884d3 100644
--- a/src/SURFEX/close_namelist.F90
+++ b/src/SURFEX/close_namelist.F90
@@ -55,12 +55,16 @@ USE MODI_CLOSE_NAMELIST_NC
#ifdef SFX_MNH
USE MODI_MNHCLOSE_NAMELIST
#endif
+#ifdef SFX_ARO
+USE MODI_AROCLOSE_NAMELIST
+#endif
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+!
!* 0.1 Declarations of arguments
! -------------------------
!
@@ -74,7 +78,6 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('CLOSE_NAMELIST',0,ZHOOK_HANDLE)
-!$OMP SINGLE
IF (HPROGRAM=='MESONH') THEN
#ifdef SFX_MNH
CALL MNHCLOSE_NAMELIST(HPROGRAM,KLUNAM)
@@ -104,7 +107,6 @@ ELSE IF (HPROGRAM=='NC ') THEN
CALL CLOSE_NAMELIST_NC(HPROGRAM,KLUNAM)
#endif
END IF
-!$OMP END SINGLE
IF (LHOOK) CALL DR_HOOK('CLOSE_NAMELIST',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/close_namelist_asc.F90 b/src/SURFEX/close_namelist_asc.F90
index 0718eb0580f8b503db5c0c6ef63583084d2fd29a..b0857700fc7f6fb107754e66730729293fc5d899 100644
--- a/src/SURFEX/close_namelist_asc.F90
+++ b/src/SURFEX/close_namelist_asc.F90
@@ -59,7 +59,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! -------------------
!
IF (LHOOK) CALL DR_HOOK('CLOSE_NAMELIST_ASC',0,ZHOOK_HANDLE)
- CLOSE(KLUNAM)
+CLOSE(KLUNAM)
IF (LHOOK) CALL DR_HOOK('CLOSE_NAMELIST_ASC',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/close_namelist_fa.F90 b/src/SURFEX/close_namelist_fa.F90
index 9c0a294c1ac0fde28d62ff7a31629607e862d7a3..74d33613ac435801db2a9746c2c2a95ec44db2e0 100644
--- a/src/SURFEX/close_namelist_fa.F90
+++ b/src/SURFEX/close_namelist_fa.F90
@@ -59,7 +59,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! -------------------
!
IF (LHOOK) CALL DR_HOOK('CLOSE_NAMELIST_FA',0,ZHOOK_HANDLE)
- CLOSE(KLUNAM)
+CLOSE(KLUNAM)
IF (LHOOK) CALL DR_HOOK('CLOSE_NAMELIST_FA',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/cls_tq.F90 b/src/SURFEX/cls_tq.F90
index 86d2de2510b7129331ccc87b69bd0cac6f3e0e59..0fb06136374fba3357f4dddca55f20eba0aaff50 100644
--- a/src/SURFEX/cls_tq.F90
+++ b/src/SURFEX/cls_tq.F90
@@ -3,10 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE CLS_TQ( PTA, PQA, PPA, PPS, PHT, &
- PCD, PCH, PRI, &
- PTS, PHU, PZ0H, PH, &
- PTNM, PQNM, PHUNM )
+ SUBROUTINE CLS_TQ( PTA, PQA, PPA, PPS, PHT, PCD, PCH, PRI, &
+ PTS, PHU, PZ0H, PH, PTNM, PQNM, PHUNM )
! #####################################################################
!
!!**** *PARAMCLS*
diff --git a/src/SURFEX/cls_wind.F90 b/src/SURFEX/cls_wind.F90
index 2367ca9a11fcee474446ae74658cb9aaef417518..48fb0638fc5087241ab74381aa38dde929f7fcd3 100644
--- a/src/SURFEX/cls_wind.F90
+++ b/src/SURFEX/cls_wind.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE CLS_WIND( PZONA, PMERA, PHW, &
- PCD, PCDN, PRI, PHV, &
- PZON10M, PMER10M )
+ SUBROUTINE CLS_WIND( PZONA, PMERA, PHW, PCD, PCDN, PRI, PHV, PZON10M, PMER10M )
! ###############################################################
!
!!**** *PARAMCLS*
diff --git a/src/SURFEX/co2_initn.F90 b/src/SURFEX/co2_initn.F90
index 4f6045ef14f6e1f69951bbbd88ec360c86073ceb..b214c4deac96b9443e2bca9887b4a1d99edff185 100644
--- a/src/SURFEX/co2_initn.F90
+++ b/src/SURFEX/co2_initn.F90
@@ -3,13 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE CO2_INIT_n (I, &
- HPHOTO, KSIZE_NATURE_P, KR_NATURE_P, PVEGTYPE_PATCH, &
- PCO2, PGMES, PGC, PDMAX, PABC, PPOI, PANMAX, &
- PFZERO, PEPSO, PGAMM, PQDGAMM, PQDGMES, &
- PT1GMES, PT2GMES, PAMAX, PQDAMAX, &
- PT1AMAX, PT2AMAX, PAH, PBH, &
- PTAU_WOOD, PINCREASE, PTURNOVER )
+ SUBROUTINE CO2_INIT_n (IO, S, PK, PEK, KSIZE, PCO2 )
! #####################
!
!!**** *CO2_INIT_n* - routine to initialize ISBA-AGS variables
@@ -52,9 +46,8 @@
!* 0. DECLARATIONS
! ------------
!
-!
-!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_P_t, ISBA_S_t, ISBA_PE_t
!
USE MODD_SURFEX_MPI, ONLY : NRANK,NPIO
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -70,66 +63,20 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
!
-TYPE(ISBA_t), INTENT(INOUT) :: I
+INTEGER, INTENT(IN) :: KSIZE
!
- CHARACTER(LEN=3), INTENT(IN) :: HPHOTO
-INTEGER, DIMENSION(:), INTENT(IN) :: KSIZE_NATURE_P
-INTEGER, DIMENSION(:,:), INTENT(IN) :: KR_NATURE_P
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVEGTYPE_PATCH
REAL, DIMENSION(:), INTENT(IN) :: PCO2 ! air CO2 concentration (kg/kg)
-REAL, DIMENSION(:,:), INTENT(IN) :: PGMES
-REAL, DIMENSION(:,:), INTENT(IN) :: PGC
-REAL, DIMENSION(:,:), INTENT(IN) :: PDMAX
-REAL, DIMENSION(:), INTENT(OUT) :: PABC
-REAL, DIMENSION(:), INTENT(OUT) :: PPOI
-REAL, DIMENSION(:,:), INTENT(OUT) :: PANMAX
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFZERO
-REAL, DIMENSION(:,:), INTENT(OUT) :: PEPSO
-REAL, DIMENSION(:,:), INTENT(OUT) :: PGAMM
-REAL, DIMENSION(:,:), INTENT(OUT) :: PQDGAMM
-REAL, DIMENSION(:,:), INTENT(OUT) :: PQDGMES
-REAL, DIMENSION(:,:), INTENT(OUT) :: PT1GMES
-REAL, DIMENSION(:,:), INTENT(OUT) :: PT2GMES
-REAL, DIMENSION(:,:), INTENT(OUT) :: PAMAX
-REAL, DIMENSION(:,:), INTENT(OUT) :: PQDAMAX
-REAL, DIMENSION(:,:), INTENT(OUT) :: PT1AMAX
-REAL, DIMENSION(:,:), INTENT(OUT) :: PT2AMAX
-REAL, DIMENSION(:,:), INTENT(OUT) :: PAH
-REAL, DIMENSION(:,:), INTENT(OUT) :: PBH
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTAU_WOOD
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PINCREASE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTURNOVER
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_VEGTYPE_PATCH ! vegtypes present for each tile
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_GMES !
REAL, DIMENSION(:), ALLOCATABLE :: ZP_CO2 ! air CO2 concentration (kg/kg)
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_GC !
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_DMAX !
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_ANMAX !
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_FZERO !
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_EPSO !
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_GAMM !
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_QDGAMM !
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_QDGMES !
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_T1GMES !
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_T2GMES !
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_AMAX !
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_QDAMAX !
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_T1AMAX !
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_T2AMAX !
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_AH !
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_BH !
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_TAU_WOOD !
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_INCREASE !
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_TURNOVER !
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_ABC !
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_POI !
!
-INTEGER :: ILU ! size of arrays
INTEGER :: IPATCH
INTEGER :: INBIOMASS
INTEGER :: JP ! loop on tiles
@@ -137,168 +84,48 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('CO2_INIT_N',0,ZHOOK_HANDLE)
!
-ILU = SIZE(PVEGTYPE_PATCH,1)
-IPATCH = SIZE(PVEGTYPE_PATCH,3)
-INBIOMASS = SIZE(PINCREASE,2)
-!
-DO JP=1,IPATCH
+INBIOMASS = SIZE(PK%XINCREASE,2)
!
- IF (KSIZE_NATURE_P(JP) == 0 ) CYCLE
+IF (KSIZE == 0 ) THEN
+ IF (LHOOK) CALL DR_HOOK('CO2_INIT_N',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
!
- IF (MAXVAL(PGMES(:,JP)).NE.XUNDEF .OR. MINVAL(PGMES(:,JP)).NE.XUNDEF) THEN
+IF (MAXVAL(PEK%XGMES(:)).NE.XUNDEF .OR. MINVAL(PEK%XGMES(:)).NE.XUNDEF) THEN
- CALL PACK_CO2_INIT(KR_NATURE_P(:,JP),KSIZE_NATURE_P(JP),JP)
-!
- CALL COTWOINIT_n(I, &
- HPHOTO, ZP_VEGTYPE_PATCH,ZP_GMES,ZP_CO2,ZP_GC, &
- ZP_DMAX,ZP_ABC,ZP_POI,ZP_ANMAX,ZP_FZERO, &
- ZP_EPSO,ZP_GAMM,ZP_QDGAMM,ZP_QDGMES,ZP_T1GMES, &
- ZP_T2GMES,ZP_AMAX,ZP_QDAMAX,ZP_T1AMAX, &
- ZP_T2AMAX,ZP_AH,ZP_BH,ZP_TAU_WOOD )
-
- ZP_INCREASE = 0.
- ZP_TURNOVER = 0.
-!
- CALL UNPACK_CO2_INIT(KR_NATURE_P(:,JP),KSIZE_NATURE_P(JP),JP)
+ CALL PACK_CO2_INIT(PK%NR_P(:),KSIZE)
+ !
+ CALL COTWOINIT_n(IO, S, PK, PEK, ZP_CO2 )
- ENDIF
+ PK%XINCREASE = 0.
+ PK%XTURNOVER = 0.
+ !
-ENDDO
+ENDIF
!
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('CO2_INIT_N',1,ZHOOK_HANDLE)
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
-SUBROUTINE PACK_CO2_INIT(KMASK,KSIZE,KPATCH)
+SUBROUTINE PACK_CO2_INIT(KMASK,KSIZE)
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE, KPATCH
+INTEGER, INTENT(IN) :: KSIZE
INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
!
INTEGER JJ, JI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PACK_CO2_INIT',0,ZHOOK_HANDLE)
-ALLOCATE(ZP_VEGTYPE_PATCH(KSIZE,NVEGTYPE))
-ALLOCATE(ZP_GMES (KSIZE))
-ALLOCATE(ZP_CO2 (KSIZE))
-ALLOCATE(ZP_GC (KSIZE))
-ALLOCATE(ZP_DMAX (KSIZE))
-ALLOCATE(ZP_ANMAX (KSIZE))
-ALLOCATE(ZP_FZERO (KSIZE))
-ALLOCATE(ZP_EPSO (KSIZE))
-ALLOCATE(ZP_GAMM (KSIZE))
-ALLOCATE(ZP_QDGAMM (KSIZE))
-ALLOCATE(ZP_QDGMES (KSIZE))
-ALLOCATE(ZP_T1GMES (KSIZE))
-ALLOCATE(ZP_T2GMES (KSIZE))
-ALLOCATE(ZP_AMAX (KSIZE))
-ALLOCATE(ZP_QDAMAX (KSIZE))
-ALLOCATE(ZP_T1AMAX (KSIZE))
-ALLOCATE(ZP_T2AMAX (KSIZE))
-ALLOCATE(ZP_AH (KSIZE))
-ALLOCATE(ZP_BH (KSIZE))
-ALLOCATE(ZP_TAU_WOOD (KSIZE))
-ALLOCATE(ZP_INCREASE (KSIZE,INBIOMASS))
-ALLOCATE(ZP_TURNOVER (KSIZE,INBIOMASS))
!
-! initialisation needed for TORI
-ALLOCATE(ZP_ABC(SIZE(PABC)))
-ALLOCATE(ZP_POI(SIZE(PPOI)))
-ZP_ABC(:)=0.
-ZP_POI(:)=0.
+ALLOCATE(ZP_CO2 (KSIZE))
!
DO JJ=1,KSIZE
JI = KMASK(JJ)
- ZP_VEGTYPE_PATCH(JJ,:) = PVEGTYPE_PATCH(JI,:,KPATCH)
- ZP_GMES (JJ) = PGMES (JI,KPATCH)
ZP_CO2 (JJ) = PCO2 (JI)
- ZP_GC (JJ) = PGC (JI,KPATCH)
- ZP_DMAX (JJ) = PDMAX (JI,KPATCH)
END DO
+!
IF (LHOOK) CALL DR_HOOK('PACK_CO2_INIT',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
END SUBROUTINE PACK_CO2_INIT
-!-------------------------------------------------------------------------------
-SUBROUTINE UNPACK_CO2_INIT(KMASK,KSIZE,KPATCH)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSIZE, KPATCH
-INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
-!
-INTEGER JJ, JI
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-IF (LHOOK) CALL DR_HOOK('UNPACK_CO2_INIT',0,ZHOOK_HANDLE)
-PANMAX (:,KPATCH) = XUNDEF
-PFZERO (:,KPATCH) = XUNDEF
-PEPSO (:,KPATCH) = XUNDEF
-PGAMM (:,KPATCH) = XUNDEF
-PQDGAMM (:,KPATCH) = XUNDEF
-PQDGMES (:,KPATCH) = XUNDEF
-PT1GMES (:,KPATCH) = XUNDEF
-PT2GMES (:,KPATCH) = XUNDEF
-PAMAX (:,KPATCH) = XUNDEF
-PQDAMAX (:,KPATCH) = XUNDEF
-PT1AMAX (:,KPATCH) = XUNDEF
-PT2AMAX (:,KPATCH) = XUNDEF
-PAH (:,KPATCH) = XUNDEF
-PBH (:,KPATCH) = XUNDEF
-PTAU_WOOD (:,KPATCH) = XUNDEF
-PINCREASE (:,:,KPATCH) = XUNDEF
-PTURNOVER (:,:,KPATCH) = XUNDEF
-!
-DO JJ=1,KSIZE
- JI = KMASK (JJ)
- PANMAX (JI, KPATCH) = ZP_ANMAX (JJ)
- PFZERO (JI, KPATCH) = ZP_FZERO (JJ)
- PEPSO (JI, KPATCH) = ZP_EPSO (JJ)
- PGAMM (JI, KPATCH) = ZP_GAMM (JJ)
- PQDGAMM (JI, KPATCH) = ZP_QDGAMM (JJ)
- PQDGMES (JI, KPATCH) = ZP_QDGMES (JJ)
- PT1GMES (JI, KPATCH) = ZP_T1GMES (JJ)
- PT2GMES (JI, KPATCH) = ZP_T2GMES (JJ)
- PAMAX (JI, KPATCH) = ZP_AMAX (JJ)
- PQDAMAX (JI, KPATCH) = ZP_QDAMAX (JJ)
- PT1AMAX (JI, KPATCH) = ZP_T1AMAX (JJ)
- PT2AMAX (JI, KPATCH) = ZP_T2AMAX (JJ)
- PAH (JI, KPATCH) = ZP_AH (JJ)
- PBH (JI, KPATCH) = ZP_BH (JJ)
- PTAU_WOOD (JI, KPATCH) = ZP_TAU_WOOD (JJ)
- PINCREASE (JI, :, KPATCH) = ZP_INCREASE (JJ, :)
- PTURNOVER (JI, :, KPATCH) = ZP_TURNOVER (JJ, :)
-END DO
-!
-DO JJ=1,SIZE(PABC)
- PABC(JJ)=ZP_ABC(JJ)
- PPOI(JJ)=ZP_POI(JJ)
-END DO
-
-DEALLOCATE(ZP_VEGTYPE_PATCH)
-DEALLOCATE(ZP_GMES )
-DEALLOCATE(ZP_CO2 )
-DEALLOCATE(ZP_GC )
-DEALLOCATE(ZP_DMAX )
-DEALLOCATE(ZP_ANMAX )
-DEALLOCATE(ZP_FZERO )
-DEALLOCATE(ZP_EPSO )
-DEALLOCATE(ZP_GAMM )
-DEALLOCATE(ZP_QDGAMM )
-DEALLOCATE(ZP_QDGMES )
-DEALLOCATE(ZP_T1GMES )
-DEALLOCATE(ZP_T2GMES )
-DEALLOCATE(ZP_AMAX )
-DEALLOCATE(ZP_QDAMAX )
-DEALLOCATE(ZP_T1AMAX )
-DEALLOCATE(ZP_T2AMAX )
-DEALLOCATE(ZP_AH )
-DEALLOCATE(ZP_BH )
-DEALLOCATE(ZP_TAU_WOOD )
-DEALLOCATE(ZP_INCREASE )
-DEALLOCATE(ZP_TURNOVER )
-DEALLOCATE(ZP_ABC )
-DEALLOCATE(ZP_POI )
-IF (LHOOK) CALL DR_HOOK('UNPACK_CO2_INIT',1,ZHOOK_HANDLE)
-!-------------------------------------------------------------------------------
-END SUBROUTINE UNPACK_CO2_INIT
-!-------------------------------------------------------------------------------
!
END SUBROUTINE CO2_INIT_n
diff --git a/src/SURFEX/co2_teb_greenroof_initn.F90 b/src/SURFEX/co2_teb_greenroof_initn.F90
deleted file mode 100644
index 1ac2ef7e206d12e178d4edc655d1b30bb2fab872..0000000000000000000000000000000000000000
--- a/src/SURFEX/co2_teb_greenroof_initn.F90
+++ /dev/null
@@ -1,118 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE CO2_TEB_GREENROOF_INIT_n (I, TGRP, TVG, &
- PCO2)
-! #####################
-!
-!!**** *CO2_TEB_GREENROOF_INIT_n* - routine to initialize ISBA-AGS variables
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 02/2003
-!! J.C. Calvet 01/2004 Externalization
-!! P Le Moigne 11/2004 cotwoinit changed into cotwoinit_n
-!! P Le Moigne 09/2005 AGS modifs of L. Jarlan
-!! S Lafont 09/2008 Add initialisation of POI and ABC (needed for TORI)
-!! A.L. Gibelin 04/2009 : TAU_WOOD for NCB option
-!! A.L. Gibelin 04/2009 : Add carbon spinup
-!! A.L. Gibelin 07/2009 : Suppress RDK and transform GPP as a diagnostic
-!! A.L. Gibelin 07/2009 : Suppress PPST and PPSTF as outputs
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_TEB_GREENROOF_PGD_n, ONLY : TEB_GREENROOF_PGD_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
-!
-USE MODI_COTWOINIT_n
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
-!
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(TEB_GREENROOF_PGD_t), INTENT(INOUT) :: TGRP
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCO2 ! air CO2 concentration (kg/kg)
-!
-!
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-REAL, DIMENSION(SIZE(TGRP%XVEGTYPE,1)) :: ZTAU_WOOD
-INTEGER :: ILU ! size of arrays
-INTEGER :: JP ! loop on tiles
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('CO2_TEB_GREENROOF_INIT_N',0,ZHOOK_HANDLE)
-ILU = SIZE(TGRP%XVEGTYPE,1)
-!
-ALLOCATE(TGRP%XANMAX (ILU))
-ALLOCATE(TGRP%XFZERO (ILU))
-ALLOCATE(TGRP%XEPSO (ILU))
-ALLOCATE(TGRP%XGAMM (ILU))
-ALLOCATE(TGRP%XQDGAMM (ILU))
-ALLOCATE(TGRP%XQDGMES (ILU))
-ALLOCATE(TGRP%XT1GMES (ILU))
-ALLOCATE(TGRP%XT2GMES (ILU))
-ALLOCATE(TGRP%XAMAX (ILU))
-ALLOCATE(TGRP%XQDAMAX (ILU))
-ALLOCATE(TGRP%XT1AMAX (ILU))
-ALLOCATE(TGRP%XT2AMAX (ILU))
-ALLOCATE(TGRP%XAH (ILU))
-ALLOCATE(TGRP%XBH (ILU))
-!
- CALL COTWOINIT_n(I, &
- TVG%CPHOTO, TGRP%XVEGTYPE,TGRP%XGMES,PCO2,TGRP%XGC,&
- TGRP%XDMAX,TGRP%XABC,TGRP%XPOI,TGRP%XANMAX, TGRP%XFZERO, &
- TGRP%XEPSO,TGRP%XGAMM,TGRP%XQDGAMM,TGRP%XQDGMES,TGRP%XT1GMES, &
- TGRP%XT2GMES,TGRP%XAMAX,TGRP%XQDAMAX,TGRP%XT1AMAX, &
- TGRP%XT2AMAX,TGRP%XAH,TGRP%XBH,ZTAU_WOOD )
-!
-!-------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('CO2_TEB_GREENROOF_INIT_N',1,ZHOOK_HANDLE)
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE CO2_TEB_GREENROOF_INIT_n
diff --git a/src/SURFEX/coare30_flux.F90 b/src/SURFEX/coare30_flux.F90
index f5421ac738bc0089e4bd8e2545b38b6fd825bada..f8f6724ceba0f8140e025e9dfd19447a602b6156 100644
--- a/src/SURFEX/coare30_flux.F90
+++ b/src/SURFEX/coare30_flux.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE COARE30_FLUX (S, &
- PZ0SEA,PTA,PEXNA,PRHOA,PSST,PEXNS,PQA, &
+ SUBROUTINE COARE30_FLUX (S,PZ0SEA,PTA,PEXNA,PRHOA,PSST,PEXNS,PQA, &
PVMOD,PZREF,PUREF,PPS,PQSAT,PSFTH,PSFTQ,PUSTAR,PCD,PCDN,PCH,PCE,PRI,&
PRESA,PRAIN,PZ0HSEA)
! #######################################################################
@@ -495,7 +494,7 @@ ENDDO
!
!
ZDIRCOSZW(:) = 1.
- CALL SURFACE_RI(PSST,PQSAT,PEXNS,PEXNA,ZTA,ZQASAT,&
+CALL SURFACE_RI(PSST,PQSAT,PEXNS,PEXNA,ZTA,ZQASAT,&
PZREF,PUREF,ZDIRCOSZW,PVMOD,PRI )
!
! 5.2 Aerodynamical conductance and resistance
diff --git a/src/SURFEX/coare30_seaflux.F90 b/src/SURFEX/coare30_seaflux.F90
index c7822712bdb20d95cba683b8e09ced075717f098..ef0768ae35b2c059510a09fa2f7de0b038ca1b5d 100644
--- a/src/SURFEX/coare30_seaflux.F90
+++ b/src/SURFEX/coare30_seaflux.F90
@@ -3,12 +3,11 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE COARE30_SEAFLUX (S, &
- PMASK,KSIZE_WATER,KSIZE_ICE, &
- PTA,PEXNA,PRHOA,PSST,PEXNS,PQA, &
- PRAIN,PSNOW,PVMOD,PZREF,PUREF,PPS, &
- PQSAT,PSFTH,PSFTQ,PUSTAR, &
- PCD,PCDN,PCH,PCE,PRI,PRESA,PZ0HSEA )
+ SUBROUTINE COARE30_SEAFLUX (S, PMASK,KSIZE_WATER,KSIZE_ICE, &
+ PTA,PEXNA,PRHOA,PSST,PEXNS,PQA, &
+ PRAIN,PSNOW,PVMOD,PZREF,PUREF,PPS, &
+ PQSAT,PSFTH,PSFTQ,PUSTAR, &
+ PCD,PCDN,PCH,PCE,PRI,PRESA,PZ0HSEA )
! ##################################################################
!
!
@@ -158,7 +157,7 @@ IF ( (KSIZE_ICE > 0 ) .AND. (.NOT. S%LHANDLE_SIC) ) CALL TREAT_SURF(IR_ICE,'I')
IF (LHOOK) CALL DR_HOOK('MODI_COARE30_SEAFLUX:COARE30_SEAFLUX',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
- CONTAINS
+CONTAINS
!
SUBROUTINE TREAT_SURF(KMASK,YTYPE)
!
@@ -229,8 +228,7 @@ ZW_Z0HSEA(:) = XUNDEF
!
IF (YTYPE=='W') THEN
!
- CALL COARE30_FLUX(S, &
- ZW_Z0SEA,ZW_TA,ZW_EXNA,ZW_RHOA,ZW_SST,ZW_EXNS,&
+ CALL COARE30_FLUX(S, ZW_Z0SEA,ZW_TA,ZW_EXNA,ZW_RHOA,ZW_SST,ZW_EXNS,&
ZW_QA,ZW_VMOD,ZW_ZREF,ZW_UREF,ZW_PS,ZW_QSAT,ZW_SFTH,ZW_SFTQ,ZW_USTAR,&
ZW_CD,ZW_CDN,ZW_CH,ZW_CE,ZW_RI,ZW_RESA,ZW_RAIN,ZW_Z0HSEA)
!
diff --git a/src/SURFEX/coef_ver_interp_lin_surf.F90 b/src/SURFEX/coef_ver_interp_lin_surf.F90
index 36ff5ee1ebae913e63213ce6b6287daf0ec58b06..3a807f864b7bf69207798725cfcc78a12f7c44ba 100644
--- a/src/SURFEX/coef_ver_interp_lin_surf.F90
+++ b/src/SURFEX/coef_ver_interp_lin_surf.F90
@@ -3,138 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE COEF_VER_INTERP_LIN_SURF(PZ1,PZ2,KKLIN,PCOEFLIN)
+ SUBROUTINE COEF_VER_INTERP_LIN_SURF
! ###############################################################
!
-!!**** *VER_INTERP_LIN* - vertical linear interpolation
-!!
-!! PURPOSE
-!! -------
-! This function computes the interpolation coefficient XCOEFLIN
-! of the level XKLIN of grid PZ1 which is just under the points of
-! grid PZ2 (respectively called hereafter 'initial' and 'target'),
-! in order to perform linear interpolations between these 2 grids.
-!
-! CAUTION:
-! * The interpolation occurs on the WHOLE grid. Therefore, one must
-! only give as argument to this function the inner points of the domain,
-! particularly for the vertical grid, where there is no physical information
-! under the ground or at and over H.
-! * The level numbers must increase from bottom to top.
-!!
-!!** METHOD
-!! ------
-!! two extrapolations are possible: with the two or four nearest points.
-!!
-!! Interpolation with 2 points:
-!!
-!! If there is less than two points on one side, the interpolation is linear.
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!!
-! V.Masson Meteo-France
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 18/07/97
-!! 20/01/98 use explicit arguments
-!! P Jabouille 20/12/02 no extrapolation under the ground
-!! S. Malardel 11/2003 bug of no extrapolation under the ground
-!! V. Masson 10/2003 no extrapolation above top
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-REAL, DIMENSION(:,:), INTENT(IN) :: PZ1 ! altitudes of the points of the
-! ! initial grid
-REAL, DIMENSION(:,:), INTENT(IN) :: PZ2 ! altitudes of the points of the
-! ! target grid
-INTEGER, DIMENSION(:,:), INTENT(OUT) :: KKLIN ! number of the level
- ! of the data to be interpolated
-!
-REAL, DIMENSION(:,:), INTENT(OUT):: PCOEFLIN ! interpolation
- ! coefficient
-!
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-LOGICAL,DIMENSION(SIZE(PZ1,1),SIZE(PZ1,2)) :: GLEVEL
-INTEGER :: JK2,JI
-INTEGER,DIMENSION(SIZE(PZ1,1)) :: ILEVEL
-INTEGER,DIMENSION(SIZE(PZ1,1)) :: IUNDER
-REAL :: ZEPS ! a small number
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('COEF_VER_INTERP_LIN_SURF',0,ZHOOK_HANDLE)
-ZEPS=1.E-12
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. LOOP ON THE TARGET VERTICAL GRID
-! --------------------------------
-!
-DO JK2=1,SIZE(PZ2,2)
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. Determination of the initial level under the target level JK2
-! -------------------------------------------------------------
-!
- GLEVEL(:,:)=PZ1(:,:)<=SPREAD(PZ2(:,JK2),2,SIZE(PZ1,2)) *(1.-ZEPS)
- ILEVEL(:) =COUNT(GLEVEL(:,:),2)
-!
-!* linear extrapolation under the ground
- IUNDER=ILEVEL
- ILEVEL(:)=MAX(ILEVEL(:),1)
-!
-!* linear extrapolation above the uppest level
- ILEVEL(:)=MIN(ILEVEL(:),SIZE(PZ1,2)-1)
-!
- KKLIN(:,JK2)=ILEVEL(:)
-
-!-------------------------------------------------------------------------------
-!
-!* 4. Linear interpolation coefficients
-! ---------------------------------
-!
- DO JI=1,SIZE(PZ1,1)
- IF (PZ1(JI,ILEVEL(JI))==PZ1(JI,ILEVEL(JI)+1)) THEN
- PCOEFLIN(JI,JK2)= 0.
- ELSE
- PCOEFLIN(JI,JK2)=(PZ2(JI,JK2)-PZ1(JI,ILEVEL(JI)+1)) &
- /(PZ1(JI,ILEVEL(JI))-PZ1(JI,ILEVEL(JI)+1))
- END IF
- IF (IUNDER(JI) < 1 ) PCOEFLIN(JI,JK2)=1. ! no extrapolation
- IF (ILEVEL(JI)==SIZE(PZ1,2)-1) PCOEFLIN(JI,JK2)=MAX(PCOEFLIN(JI,JK2),0.) ! no extrapolation
- ENDDO
-!
-!-------------------------------------------------------------------------------
-!
-END DO
-IF (LHOOK) CALL DR_HOOK('COEF_VER_INTERP_LIN_SURF',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
END SUBROUTINE COEF_VER_INTERP_LIN_SURF
diff --git a/src/SURFEX/compute_isba_parameters.F90 b/src/SURFEX/compute_isba_parameters.F90
index 4c2044eb11cfa66b270ba524dbff54ae27880b5a..d17f22f1a217e5f83b92b450947806498b788a8c 100644
--- a/src/SURFEX/compute_isba_parameters.F90
+++ b/src/SURFEX/compute_isba_parameters.F90
@@ -3,13 +3,13 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#############################################################
-SUBROUTINE COMPUTE_ISBA_PARAMETERS (DTCO, DGU, UG, U, IM, DST, SLT, SV, &
- HPROGRAM,HINIT,OLAND_USE, &
- KI,KSV,KSW, &
- HSV,PCO2,PRHOA, &
- PZENITH,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD,PTSURF, &
- HTEST )
+SUBROUTINE COMPUTE_ISBA_PARAMETERS (DTCO, OREAD_BUDGETC, UG, U, &
+ IO, DTI, SB, S, IG, K, NK, NIG, NP, NPE, &
+ NAG, NISS, ISS, NCHI, CHI, ID, GB, NGB, &
+ NDST, SLT, SV, HPROGRAM,HINIT,OLAND_USE, &
+ KI,KSV,KSW,HSV,PCO2,PRHOA, &
+ PZENITH,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
+ PEMIS,PTSRAD,PTSURF, HTEST )
!#############################################################
!
!!**** *COMPUTE_ISBA_PARAMETERS_n* - routine to initialize ISBA
@@ -58,19 +58,29 @@ SUBROUTINE COMPUTE_ISBA_PARAMETERS (DTCO, DGU, UG, U, IM, DST, SLT, SV, &
!! water table / Surface coupling
!! P. Samuelsson 02/14 : MEB
!! B. Decharme 01/16 : Bug when vegetation veg, z0 and emis are imposed whith interactive vegetation
+!! B. Decharme 10/2016 bug surface/groundwater coupling
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_P_t, ISBA_PE_t, ISBA_K_t, ISBA_NK_t, &
+ ISBA_NP_t, ISBA_NPE_t
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t, GRID_NP_t
+USE MODD_AGRI_n, ONLY : AGRI_t, AGRI_NP_t
+USE MODD_SSO_n, ONLY : SSO_t, SSO_NP_t
+USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t, CH_ISBA_NP_t
+USE MODD_CANOPY_n, ONLY : CANOPY_t
+USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t, GR_BIOG_NP_t
+USE MODD_SURFEX_n, ONLY : ISBA_DIAG_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_DST_n, ONLY : DST_t
+USE MODD_DST_n, ONLY : DST_NP_t, DST_t
USE MODD_SLT_n, ONLY : SLT_t
USE MODD_SV_n, ONLY : SV_t
!
@@ -96,9 +106,10 @@ USE MODD_SNOW_PAR, ONLY : XEMISSN
USE MODD_TOPD_PAR, ONLY : NUNIT
USE MODD_TOPODYN, ONLY : NNCAT, NMESHT
!
-!
USE MODE_RANDOM
!
+USE MODI_GET_1D_MASK
+USE MODI_GET_Z0REL
USE MODI_GET_LUOUT
USE MODI_ABOR1_SFX
USE MODI_INIT_IO_SURF_n
@@ -112,21 +123,31 @@ USE MODI_CARBON_INIT
USE MODI_SOILTEMP_ARP_PAR
USE MODI_END_IO_SURF_n
!
+USE MODI_MAKE_CHOICE_ARRAY
USE MODI_READ_SURF
USE MODI_READ_ISBA_n
USE MODI_INIT_ISBA_LANDUSE
-USE MODI_READ_ISBA_CANOPY_n
+USE MODI_READ_SBL_n
USE MODI_INIT_VEG_n
+USE MODI_INIT_CHEMICAL_n
+USE MODI_OPEN_NAMELIST
+USE MODI_CH_INIT_DEP_ISBA_n
+USE MODI_CLOSE_NAMELIST
+USE MODI_INIT_DST
+USE MODI_INIT_SLT
USE MODI_AVERAGED_ALBEDO_EMIS_ISBA
USE MODI_DIAG_ISBA_INIT_n
USE MODI_INIT_SURF_TOPD
USE MODI_ISBA_SOC_PARAMETERS
+USE MODI_PACK_SAME_RANK
!
USE MODI_READ_AND_SEND_MPI
USE MODI_ISBA_TO_TOPD
USE MODI_OPEN_FILE
USE MODI_CLOSE_FILE
USE MODI_FIX_MEB_VEG
+USE MODI_AV_PGD
+USE MODI_SURF_PATCH
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -136,23 +157,41 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+LOGICAL, INTENT(IN) :: OREAD_BUDGETC
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(DST_t), INTENT(INOUT) :: DST
+!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(GRID_t), INTENT(INOUT) :: IG
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_NK_t), INTENT(INOUT) :: NK
+TYPE(GRID_NP_t), INTENT(INOUT) :: NIG
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
+TYPE(AGRI_NP_t), INTENT(INOUT) :: NAG
+TYPE(SSO_NP_t), INTENT(INOUT) :: NISS
+TYPE(SSO_t), INTENT(INOUT) :: ISS
+TYPE(CH_ISBA_NP_t), INTENT(INOUT) :: NCHI
+TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
+TYPE(ISBA_DIAG_t), INTENT(INOUT) :: ID
+TYPE(GR_BIOG_t), INTENT(INOUT) :: GB
+TYPE(GR_BIOG_NP_t), INTENT(INOUT) :: NGB
+!
+TYPE(DST_NP_t), INTENT(INOUT) :: NDST
TYPE(SLT_t), INTENT(INOUT) :: SLT
TYPE(SV_t), INTENT(INOUT) :: SV
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
- CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+ CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize
LOGICAL, INTENT(IN) :: OLAND_USE !
INTEGER, INTENT(IN) :: KI ! number of points
INTEGER, INTENT(IN) :: KSV ! number of scalars
INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands
- CHARACTER(LEN=6), DIMENSION(KSV), INTENT(IN) :: HSV ! name of all scalar variables
+ CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN) :: HSV ! name of all scalar variables
REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration (kg/m3)
REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density
REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! solar zenithal angle
@@ -169,27 +208,41 @@ REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF ! surface effective t
!* 0.2 Declarations of local variables
! -------------------------------
!
+TYPE(GRID_t), POINTER :: GK
+TYPE(ISBA_P_t), POINTER :: PK
+TYPE(ISBA_K_t), POINTER :: KK
+TYPE(ISBA_PE_t), POINTER :: PEK
+TYPE(AGRI_t), POINTER :: AGK
+TYPE(SSO_t), POINTER :: ISSK
+TYPE(DST_t), POINTER :: DSTK
+!
REAL, DIMENSION(U%NDIM_FULL) :: ZF_PARAM, ZC_DEPTH_RATIO
!
REAL, DIMENSION(KI) :: ZTSRAD_NAT !radiative temperature
REAL, DIMENSION(KI) :: ZTSURF_NAT !effective temperature
+REAL, DIMENSION(KI) :: ZM
!
-REAL, DIMENSION(KI,IM%I%NPATCH) :: ZWG1 ! work array for surface water content
-REAL, DIMENSION(KI,IM%I%NPATCH) :: ZTG1 ! work array for surface temperature
+REAL, DIMENSION(KI) :: ZWG1 ! work array for surface water content
+REAL, DIMENSION(KI,IO%NPATCH) :: ZTG1 ! work array for surface temperature
+REAL, DIMENSION(KI,IO%NPATCH) :: ZF
!
-REAL, DIMENSION(KI) :: ZM, ZWORK
-REAL, DIMENSION(KI,IM%I%NPATCH) :: ZF, ZPERTBUF
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDG_SOIL, ZDG_SOIL_P
+REAL, DIMENSION(:), ALLOCATABLE :: ZSUM_PATCH
!
-INTEGER :: IDIM_FULL, JL
-INTEGER :: JILU ! loop increment
+INTEGER :: ICH ! unit of input chemistry file
+INTEGER :: JI, JL ! loop increment
INTEGER :: ILUOUT ! unit of output listing file
INTEGER :: IRESP ! return code
INTEGER :: IDECADE, IDECADE2 ! decade of simulation
-INTEGER :: JPATCH ! loop counter on tiles
-INTEGER :: INFOMPI
+INTEGER :: JP ! loop counter on tiles
INTEGER :: ISIZE_LMEB_PATCH ! Number of patches with MEB=true
!
-LOGICAL :: LWORK
+LOGICAL :: GDIM, GCAS1, GCAS2, GCAS3
+INTEGER :: JVEG, IVERSION, IBUGFIX, IMASK, JMAXLOC
+!
+ CHARACTER(LEN=4) :: YLVL
+ CHARACTER(LEN=LEN_HREC) :: YRECFM
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -204,387 +257,629 @@ IF (HTEST/='OK') THEN
CALL ABOR1_SFX('COMPUTE_ISBA_PARAMETERS: FATAL ERROR DURING ARGUMENT TRANSFER')
END IF
!
-ZF (:,:) = XUNDEF
-ZM (:) = XUNDEF
-ZWORK(:) = XUNDEF
-!
-!* 2.3 Physiographic data fields from land cover:
-! -----------------------------------------
-!
- CALL ALLOCATE_PHYSIO(IM%I, &
- IM%I%CPHOTO, IM%I%CISBA, KI, NVEGTYPE, IM%I%NGROUND_LAYER, IM%I%NPATCH, &
- IM%I%XVEGTYPE, IM%I%XLAI, IM%I%XVEG, IM%I%XZ0, IM%I%XEMIS, IM%I%XDG, IM%I%XD_ICE, &
- IM%I%XRSMIN, IM%I%XGAMMA, IM%I%XWRMAX_CF, IM%I%XRGL, IM%I%XCV, &
- IM%I%XZ0_O_Z0H, IM%I%XALBNIR_VEG, IM%I%XALBVIS_VEG, IM%I%XALBUV_VEG, &
- IM%I%XH_TREE, IM%I%XRE25, IM%I%XLAIMIN, IM%I%XBSLAI, IM%I%XSEFOLD, &
- IM%I%XGMES, IM%I%XGC, IM%I%XF2I, IM%I%XDMAX, IM%I%LSTRESS, &
- IM%I%XCE_NITRO, IM%I%XCF_NITRO, IM%I%XCNA_NITRO, &
- IM%I%TSEED, IM%I%TREAP, IM%I%XWATSUP, IM%I%XIRRIG, &
- IM%I%XROOTFRAC, IM%I%NWG_LAYER, IM%I%XDROOT, IM%I%XDG2, &
- IM%I%XGNDLITTER,IM%I%XRGLGV,IM%I%XGAMMAGV,IM%I%XRSMINGV, &
- IM%I%XROOTFRACGV,IM%I%XWRMAX_CFGV,IM%I%XLAIGV,IM%I%XZ0LITTER,IM%I%XH_VEG )
-!
-IF (IM%I%TTIME%TDATE%MONTH /= NUNDEF) THEN
- IDECADE = 3 * ( IM%I%TTIME%TDATE%MONTH - 1 ) + MIN(IM%I%TTIME%TDATE%DAY-1,29) / 10 + 1
+!----------------------------------------------------------------------------------
+!----------------------------------------------------------------------------------
+!
+! PART 1 : Arrays of vegtypes & patches
+! -------------------------------------
+!
+! We need XVEGTYPE, XPATCH and XVEGTYPE_PATCH with dimension "PATCH" for some
+! cases: initialized here
+!
+! Vegtypes first
+ALLOCATE(S%XVEGTYPE(KI,NVEGTYPE))
+IF (DTI%LDATA_VEGTYPE) THEN
+ S%XVEGTYPE = DTI%XPAR_VEGTYPE
+ELSE
+ !classical ecoclimap case
+ DO JVEG=1,NVEGTYPE
+ CALL AV_PGD(DTCO, S%XVEGTYPE(:,JVEG),S%XCOVER ,DTCO%XDATA_VEGTYPE(:,JVEG),'NAT','ARI',S%LCOVER)
+ END DO
+ENDIF
+!
+! patches come from vegtypes
+ALLOCATE(S%XPATCH(KI,IO%NPATCH))
+ALLOCATE(S%XVEGTYPE_PATCH(KI,NVEGTYPE,IO%NPATCH))
+ CALL SURF_PATCH(IO%NPATCH,S%XVEGTYPE,S%XPATCH,S%XVEGTYPE_PATCH)
+!
+! removing little fractions of patches must be done of the XPATCH with dimension
+! "PATCH"
+IF (IO%XRM_PATCH/=0.) THEN
+ !
+ WRITE(ILUOUT,*) " REMOVE PATCH below 5 % add to dominant patch "
+ ! remove small fraction of PATCHES and add to MAIN PATCH
+ DO JI = 1,KI
+ !1) find most present patch maximum value
+ JMAXLOC = MAXVAL(MAXLOC(S%XPATCH(JI,:)))
+ !2) FIND small value of cover
+ DO JP = 1,IO%NPATCH
+ IF ( S%XPATCH(JI,JP)<IO%XRM_PATCH ) THEN
+ S%XPATCH(JI,JMAXLOC) = S%XPATCH(JI,JMAXLOC) + S%XPATCH(JI,JP)
+ S%XPATCH(JI,JP) = 0.0
+ ENDIF
+ ENDDO
+ ENDDO
+ !
+ENDIF
+!
+!----------------------------------------------------------------------------------
+!----------------------------------------------------------------------------------
+!
+! PART 2 : Things depending only on options and / or needed first
+! --------------------------------------------------------------
+
+!* Physiographic data fields from land cover:
+! -----------------------------------------
+!
+IF (S%TTIME%TDATE%MONTH /= NUNDEF) THEN
+ IDECADE = 3 * ( S%TTIME%TDATE%MONTH - 1 ) + MIN(S%TTIME%TDATE%DAY-1,29) / 10 + 1
ELSE
IDECADE = 1
END IF
!
IDECADE2 = IDECADE
!
- CALL INIT_ISBA_MIXPAR(DTCO, IM%DTI, IM%IG, IM%I, &
- IM%I%CISBA,IDECADE,IDECADE2,IM%I%XCOVER,IM%I%LCOVER,IM%I%CPHOTO,'NAT')
+! concern DATA_ISBA, so no dependence on patches
+ CALL INIT_ISBA_MIXPAR(DTCO, DTI, IG%NDIM, IO, IDECADE, IDECADE2, S%XCOVER, S%LCOVER, 'NAT')
!
-ISIZE_LMEB_PATCH=COUNT(IM%I%LMEB_PATCH(:))
+ISIZE_LMEB_PATCH=COUNT(IO%LMEB_PATCH(:))
IF (ISIZE_LMEB_PATCH>0) THEN
- CALL FIX_MEB_VEG(IM%DTI, IM%IG, IM%I, &
- IM%I%NPATCH)
+ CALL FIX_MEB_VEG(DTI, IG%NDIM, IO%LMEB_PATCH, IO%NPATCH)
ENDIF
!
- CALL CONVERT_PATCH_ISBA(DTCO, IM%DTI, IM%I, &
- IM%I%CISBA,IDECADE,IDECADE2,IM%I%XCOVER,IM%I%LCOVER,IM%I%CPHOTO,LAGRIP, &
- IM%I%LPERM,IM%I%LTR_ML,'NAT',PVEG=IM%I%XVEG,PLAI=IM%I%XLAI, &
- PRSMIN=IM%I%XRSMIN,PGAMMA=IM%I%XGAMMA,PWRMAX_CF=IM%I%XWRMAX_CF, &
- PRGL=IM%I%XRGL,PCV=IM%I%XCV,PSOILGRID=IM%I%XSOILGRID, &
- PDG=IM%I%XDG,KWG_LAYER=IM%I%NWG_LAYER,PDROOT=IM%I%XDROOT,PDG2=IM%I%XDG2, &
- PZ0=IM%I%XZ0,PZ0_O_Z0H=IM%I%XZ0_O_Z0H, &
- PALBNIR_VEG=IM%I%XALBNIR_VEG,PALBVIS_VEG=IM%I%XALBVIS_VEG, &
- PALBUV_VEG=IM%I%XALBUV_VEG,PEMIS_ECO=IM%I%XEMIS, &
- PVEGTYPE=IM%I%XVEGTYPE,PROOTFRAC=IM%I%XROOTFRAC, &
- PGMES=IM%I%XGMES,PBSLAI=IM%I%XBSLAI,PLAIMIN=IM%I%XLAIMIN, &
- PSEFOLD=IM%I%XSEFOLD,PGC=IM%I%XGC, &
- PDMAX=IM%I%XDMAX,PF2I=IM%I%XF2I,OSTRESS=IM%I%LSTRESS,PH_TREE=IM%I%XH_TREE, &
- PRE25=IM%I%XRE25,PCE_NITRO=IM%I%XCE_NITRO,PCF_NITRO=IM%I%XCF_NITRO, &
- PCNA_NITRO=IM%I%XCNA_NITRO,PD_ICE=IM%I%XD_ICE,TPSEED=IM%I%TSEED, &
- TPREAP=IM%I%TREAP,PWATSUP=IM%I%XWATSUP,PIRRIG=IM%I%XIRRIG, &
- PGNDLITTER=IM%I%XGNDLITTER, &
- PRGLGV=IM%I%XRGLGV, &
- PGAMMAGV=IM%I%XGAMMAGV,PRSMINGV=IM%I%XRSMINGV, &
- PROOTFRACGV=IM%I%XROOTFRACGV,PWRMAX_CFGV=IM%I%XWRMAX_CFGV, &
- PLAIGV=IM%I%XLAIGV,PZ0LITTER=IM%I%XZ0LITTER,PH_VEG=IM%I%XH_VEG )
!
-!-------------------------------------------------------------------------------
+!* Soil carbon
+! -----------
!
- CALL INIT_VEG_PGD_n(IM%CHI, DTCO, DST, IM%I, SLT, U, &
- HPROGRAM, 'NATURE', ILUOUT, KI, IM%I%NPATCH, IM%I%NGROUND_LAYER, &
- IM%I%TTIME%TDATE%MONTH, &
- IM%I%XVEGTYPE, IM%I%XPATCH, IM%I%XVEGTYPE_PATCH, IM%I%NSIZE_NATURE_P, &
- IM%I%NR_NATURE_P, IM%I%XRM_PATCH, &
- LDEEPSOIL, LPHYSDOMC, XTDEEP_CLI, XGAMMAT_CLI, IM%I%XTDEEP, &
- IM%I%XGAMMAT, LAGRIP, XTHRESHOLD, IM%AG%NIRRINUM, IM%AG%LIRRIDAY, IM%AG%LIRRIGATE, &
- IM%AG%XTHRESHOLDSPT, &
- IM%I%CPHOTO, HINIT, IM%I%LTR_ML, IM%I%NNBIOMASS, PCO2, PRHOA, IM%I%XABC, IM%I%XPOI, &
- IM%I%XGMES, IM%I%XGC, IM%I%XDMAX, IM%I%XANMAX, IM%I%XFZERO, IM%I%XEPSO, IM%I%XGAMM, IM%I%XQDGAMM, &
- IM%I%XQDGMES, IM%I%XT1GMES, IM%I%XT2GMES, IM%I%XAMAX, IM%I%XQDAMAX, IM%I%XT1AMAX, IM%I%XT2AMAX,&
- IM%I%XAH, IM%I%XBH, IM%I%XTAU_WOOD, IM%I%XINCREASE, IM%I%XTURNOVER, &
- KSV, HSV, IM%CHI%SVI, IM%CHI%CCH_NAMES, IM%CHI%CAER_NAMES, &
- IM%CHI%CDSTNAMES, IM%CHI%CSLTNAMES, IM%CHI%CCHEM_SURF_FILE, &
- DST%XSFDST, DST%XSFDSTM, SLT%XSFSLT, &
- IM%I%XAOSIP, IM%I%XAOSIM, IM%I%XAOSJP, IM%I%XAOSJM, IM%I%XHO2IP, IM%I%XHO2IM, IM%I%XHO2JP, &
- IM%I%XHO2JM, IM%I%XZ0, IM%I%XZ0EFFIP, IM%I%XZ0EFFIM, IM%I%XZ0EFFJP, IM%I%XZ0EFFJM, IM%I%XZ0REL,&
- IM%I%XCLAY, IM%I%XSAND, IM%I%CPEDOTF, &
- IM%I%XCONDSAT, IM%I%XMPOTSAT, IM%I%XBCOEF, IM%I%XWWILT, IM%I%XWFC, IM%I%XWSAT, IM%I%XWD0, &
- IM%I%XKANISO, IM%I%CRUNOFF, &
- IM%I%XTAUICE, IM%I%XCGSAT, IM%I%XC1SAT, IM%I%XC2REF, IM%I%XC3, IM%I%XC4B, IM%I%XACOEF, IM%I%XPCOEF, &
- IM%I%XC4REF, IM%I%XPCPS, IM%I%XPLVTT, IM%I%XPLSTT, &
- IM%I%CSCOND, IM%I%CISBA, IM%I%XHCAPSOIL, IM%I%XCONDDRY, IM%I%XCONDSLD, IM%I%CCPSURF, &
- IM%I%XDG, IM%I%XDROOT, IM%I%XDG2, IM%I%XROOTFRAC, IM%I%XRUNOFFD, IM%I%XDZG, IM%I%XDZDIF, &
- IM%I%XSOILWGHT, IM%I%NWG_LAYER, IM%I%NLAYER_HORT, IM%I%NLAYER_DUN, IM%I%XD_ICE, &
- IM%I%XKSAT_ICE, IM%I%XALBNIR_DRY, IM%I%XALBVIS_DRY, IM%I%XALBUV_DRY, &
- IM%I%XALBNIR_WET, IM%I%XALBVIS_WET, IM%I%XALBUV_WET, IM%I%XBSLAI_NITRO, &
- IM%I%XCE_NITRO, IM%I%XCNA_NITRO, IM%I%XCF_NITRO, IM%I%XFWTD, IM%I%XWTD )
+IF (HINIT == 'ALL' .AND. IO%CRESPSL=='CNT' .AND. IO%CPHOTO == 'NCB') CALL CARBON_INIT
!
-!-------------------------------------------------------------------------------
-!
-!DIF option :
-! Anisotropy coeficient for hydraulic conductivity for topmodel drainage (Fan et al. 2006)
-! Soil organic matter effect and/or Exponential decay for DIF option
-! Must be call before INIT_TOP
+!----------------------------------------------------------------------------------
+!----------------------------------------------------------------------------------
!
+! PART 3 : Loop on patches for general initialization
+! --------------------------------------------------
!
-IF(IM%I%CISBA=='DIF') THEN
+! loop on patches
+DO JP = 1, IO%NPATCH
+ !
+ KK => NK%AL(JP)
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+ AGK => NAG%AL(JP)
+ ISSK => NISS%AL(JP)
!
- IF( IM%I%CKSAT=='SGH' )THEN
- WRITE(ILUOUT,*)'THE KSAT EXP PROFILE WITH ISBA-DF IS NOT PHYSIC AND HAS BEEN REMOVED FOR NOW'
- WRITE(ILUOUT,*)'A NEW PHYSICAL APPROACH WILL BE DEVELLOPED ACCOUNTING FOR COMPACTION IN ALL '
- WRITE(ILUOUT,*)'HYDRODYNAMIC PARAMETERS (WSAT, PSISAT, KSAT, B) AND NOT ONLY IN KSAT '
- CALL ABOR1_SFX('CKSAT=SGH is not physic with ISBA-DF and has been removed for now')
+ ! dimension of the patch
+ PK%NSIZE_P = COUNT(S%XPATCH(:,JP) > 0.0)
+ !
+ ! mask of the patch in tile nature
+ ALLOCATE(PK%NR_P (PK%NSIZE_P))
+ CALL GET_1D_MASK(PK%NSIZE_P, KI, S%XPATCH(:,JP), PK%NR_P)
+ !
+ ! the array of vegtypes, patches and vegtypes by patches reduced on this patches
+ ALLOCATE(KK%XVEGTYPE(PK%NSIZE_P,NVEGTYPE))
+ CALL PACK_SAME_RANK(PK%NR_P,S%XVEGTYPE,KK%XVEGTYPE)
+ !
+ ALLOCATE(PK%XPATCH(PK%NSIZE_P))
+ ALLOCATE(PK%XVEGTYPE_PATCH (PK%NSIZE_P,NVEGTYPE))
+ CALL PACK_SAME_RANK(PK%NR_P,S%XPATCH(:,JP),PK%XPATCH)
+ CALL PACK_SAME_RANK(PK%NR_P,S%XVEGTYPE_PATCH(:,:,JP),PK%XVEGTYPE_PATCH)
+ !
+ !
+ ! soon needed packed fields
+ !
+ IF (IO%LPERM) THEN
+ ALLOCATE(KK%XPERM(PK%NSIZE_P))
+ CALL PACK_SAME_RANK(PK%NR_P, K%XPERM, KK%XPERM)
+ ELSE
+ ALLOCATE(KK%XPERM(0))
ENDIF
- !
- IF(IM%I%LSOC)THEN
- IF(.NOT.IM%I%LSOCP)THEN
- WRITE(ILUOUT,*)'LSOC = T can be activated only if SOC data given in PGD fields'
- CALL ABOR1_SFX('LSOC = T can be activated only if SOC data given in PGD fields')
- ENDIF
- ALLOCATE(IM%I%XFRACSOC(KI,IM%I%NGROUND_LAYER))
- IM%I%XFRACSOC(:,:)=0.0
- CALL ISBA_SOC_PARAMETERS(IM%I%CRUNOFF,IM%I%XPATCH,IM%I%XDG,IM%I%XSOC,IM%I%XBCOEF,IM%I%XMPOTSAT, &
- IM%I%XCONDSAT,IM%I%XWSAT,IM%I%XHCAPSOIL,IM%I%XCONDDRY, &
- IM%I%XCONDSLD,IM%I%XWFC,IM%I%XWWILT,IM%I%XWD0,IM%I%XKANISO,IM%I%XFRACSOC )
+ !
+ !
+ ALLOCATE(KK%XSAND(PK%NSIZE_P,IO%NGROUND_LAYER))
+ ALLOCATE(KK%XCLAY(PK%NSIZE_P,IO%NGROUND_LAYER))
+ !
+ ALLOCATE(ISSK%XAOSIP(PK%NSIZE_P))
+ ALLOCATE(ISSK%XAOSIM(PK%NSIZE_P))
+ ALLOCATE(ISSK%XAOSJP(PK%NSIZE_P))
+ ALLOCATE(ISSK%XAOSJM(PK%NSIZE_P))
+ ALLOCATE(ISSK%XHO2IP(PK%NSIZE_P))
+ ALLOCATE(ISSK%XHO2IM(PK%NSIZE_P))
+ ALLOCATE(ISSK%XHO2JP(PK%NSIZE_P))
+ ALLOCATE(ISSK%XHO2JM(PK%NSIZE_P))
+ !
+ !
+ CALL PACK_SAME_RANK(PK%NR_P, K%XSAND, KK%XSAND)
+ CALL PACK_SAME_RANK(PK%NR_P, K%XCLAY, KK%XCLAY)
+ !
+ CALL PACK_SAME_RANK(PK%NR_P,ISS%XAOSIP,ISSK%XAOSIP)
+ CALL PACK_SAME_RANK(PK%NR_P,ISS%XAOSIM,ISSK%XAOSIM)
+ CALL PACK_SAME_RANK(PK%NR_P,ISS%XAOSJP,ISSK%XAOSJP)
+ CALL PACK_SAME_RANK(PK%NR_P,ISS%XAOSJM,ISSK%XAOSJM)
+ CALL PACK_SAME_RANK(PK%NR_P,ISS%XHO2IP,ISSK%XHO2IP)
+ CALL PACK_SAME_RANK(PK%NR_P,ISS%XHO2IM,ISSK%XHO2IM)
+ CALL PACK_SAME_RANK(PK%NR_P,ISS%XHO2JP,ISSK%XHO2JP)
+ CALL PACK_SAME_RANK(PK%NR_P,ISS%XHO2JM,ISSK%XHO2JM)
+ !
+ !
+ !* 2.5 Physiographic fields
+ ! --------------------
+ !
+ CALL ALLOCATE_PHYSIO(IO, KK, PK, PEK, NVEGTYPE )
+ !
+ CALL CONVERT_PATCH_ISBA(DTCO, DTI, IO, IDECADE, IDECADE2, S%XCOVER, S%LCOVER, &
+ LAGRIP, 'NAT', JP, KK, PK, PEK, &
+ .TRUE., .TRUE., .TRUE., .TRUE., .FALSE., .FALSE., &
+ PSOILGRID=IO%XSOILGRID, PPERM=KK%XPERM )
+ !
+ !-------------------------------------------------------------------------------
+ !
+ ! in init_veg_pgd_n, things needed also by garden and greenroof
+ CALL INIT_VEG_PGD_n(ISSK, DTI, IO, S, K, KK, PK, PEK, AGK, KI, &
+ HPROGRAM, 'NATURE', ILUOUT, PK%NSIZE_P, S%TTIME%TDATE%MONTH, &
+ LDEEPSOIL, LPHYSDOMC, XTDEEP_CLI, XGAMMAT_CLI, &
+ LAGRIP, XTHRESHOLD, HINIT, PCO2, PRHOA )
+ !
+ !-------------------------------------------------------------------------------
+ !
+ ! Other fields needed to be initialized for isba only
+ !
+ !Rainfall spatial distribution
+ !CRAIN used in HYDRO_VEG and HYDRO_SGH and VEG_SGH_UPDATE
+ IF(IO%CRAIN=='SGH')THEN
+ ALLOCATE(KK%XMUF(PK%NSIZE_P))
+ KK%XMUF(:)=0.0
ELSE
- ALLOCATE(IM%I%XFRACSOC(0,0))
+ ALLOCATE(KK%XMUF(0))
ENDIF
+ !
+ ALLOCATE(KK%XFSAT(PK%NSIZE_P))
+ KK%XFSAT(:) = 0.0
+ !
+ ! * Initialize flood scheme :
+ !
+ ALLOCATE(KK%XFFLOOD (PK%NSIZE_P))
+ ALLOCATE(KK%XPIFLOOD(PK%NSIZE_P))
+ ALLOCATE(KK%XFF (PK%NSIZE_P))
+ ALLOCATE(KK%XFFG (PK%NSIZE_P))
+ ALLOCATE(KK%XFFV (PK%NSIZE_P))
+ ALLOCATE(KK%XFFROZEN(PK%NSIZE_P))
+ ALLOCATE(KK%XALBF (PK%NSIZE_P))
+ ALLOCATE(KK%XEMISF (PK%NSIZE_P))
+ KK%XFFLOOD = 0.0
+ KK%XPIFLOOD = 0.0
+ KK%XFF = 0.0
+ KK%XFFG = 0.0
+ KK%XFFV = 0.0
+ KK%XFFROZEN = 0.0
+ KK%XALBF = 0.0
+ KK%XEMISF = 0.0
+ !
+ENDDO
!
-ELSE
- ALLOCATE(IM%I%XFRACSOC(0,0))
+IF (DTI%LDATA_CONDSAT) DEALLOCATE(DTI%XPAR_CONDSAT)
+!
+!----------------------------------------------------------------------------------
+!----------------------------------------------------------------------------------
+!
+! PART 4 : Initialization not depending on patches
+! ------------------------------------------------
+!
+! Fields needed also unpacked
+!
+IF(IO%CRAIN=='SGH')THEN
+ ALLOCATE(K%XMUF(KI))
+ K%XMUF(:)=0.0
ENDIF
!
-!Topmodel
!
-!CRUNOFF used in hydro_sgh and isba_sgh_update
-IF( IM%I%CRUNOFF=='SGH ') THEN
+ALLOCATE(ISS%XZ0REL(KI))
+ CALL GET_Z0REL(ISS)
!
- ALLOCATE(IM%I%XTAB_FSAT(KI,NDIMTAB))
- ALLOCATE(IM%I%XTAB_WTOP(KI,NDIMTAB))
- ALLOCATE(IM%I%XTAB_QTOP(KI,NDIMTAB))
+!-------------------------------------------------------------------------------
!
- IM%I%XTAB_FSAT(:,:) = 0.0
- IM%I%XTAB_WTOP(:,:) = 0.0
- IM%I%XTAB_QTOP(:,:) = 0.0
+! PART 5: Initialize Chemical Deposition
+! -----------------------------------
!
- IF(HINIT/='PRE' .AND. .NOT.LASSIM)THEN
+! 3.1 Chemical gazes
+! --------------
!
- WHERE(IM%I%XCLAY(:,1)==XUNDEF.AND.IM%I%XTI_MEAN(:)/=XUNDEF) IM%I%XTI_MEAN(:)=XUNDEF
+ !* for the time being, chemistry on vegetation works only for
+ ! ISBA on nature tile (not for gardens), because subroutine INIT_CHEMICAL_n
+ ! contains explicitely modules from ISBAn. It should be cleaned in a future
+ ! version.
+ CALL INIT_CHEMICAL_n(ILUOUT, KSV, HSV, CHI%SVI, CHI%CCH_NAMES, CHI%CAER_NAMES, &
+ HDSTNAMES=CHI%CDSTNAMES, HSLTNAMES=CHI%CSLTNAMES )
!
- CALL INIT_TOP(IM%I, &
- IM%I%CISBA, ILUOUT, IM%I%XPATCH, IM%I%XRUNOFFD, &
- IM%I%XWD0, IM%I%XWSAT, IM%I%XTI_MIN, &
- IM%I%XTI_MAX, IM%I%XTI_MEAN, IM%I%XTI_STD, IM%I%XTI_SKEW, &
- IM%I%XSOILWGHT, IM%I%XTAB_FSAT, IM%I%XTAB_WTOP, &
- IM%I%XTAB_QTOP, ZM )
+IF (KSV /= 0) THEN
+ !
+ IF (CHI%SVI%NBEQ > 0) THEN
+ !* for the time being, chemistry deposition on vegetation works only for
+ ! ISBA on nature tile (not for gardens), because subroutine CH_INIT_DEP_ISBA_n
+ ! contains explicitely modules from ISBAn. It should be cleaned in a future
+ ! version.
+ CALL OPEN_NAMELIST(HPROGRAM, ICH, HFILE=CHI%CCHEM_SURF_FILE)
+ CALL CH_INIT_DEP_ISBA_n(CHI, NCHI, NP, DTCO, IO%NPATCH, S%LCOVER, S%XCOVER, ICH, ILUOUT, KI)
+ CALL CLOSE_NAMELIST(HPROGRAM, ICH)
+ END IF
+ !
+ DO JP = 1,IO%NPATCH
+ !
+ DSTK => NDST%AL(JP)
+ !
+ IF (CHI%SVI%NDSTEQ >=1) THEN
+ !
+ ALLOCATE (DSTK%XSFDST (PK%NSIZE_P, CHI%SVI%NDSTEQ)) !Output array
+ ALLOCATE (DSTK%XSFDSTM(PK%NSIZE_P, CHI%SVI%NDSTEQ)) !Output array
+ DSTK%XSFDST (:,:) = 0.
+ DSTK%XSFDSTM(:,:) = 0.
+ CALL INIT_DST(DSTK, U, HPROGRAM, PK%NSIZE_P, PK%NR_P, PK%XVEGTYPE_PATCH)
+ ELSE
+ ALLOCATE(DSTK%XSFDST (0,0))
+ ALLOCATE(DSTK%XSFDSTM(0,0))
+ END IF
+ !
+ ENDDO
+ !
+ IF (CHI%SVI%NSLTEQ >=1) THEN
+ CALL INIT_SLT(SLT, HPROGRAM)
+ END IF
+ !
+ENDIF
!
+!-------------------------------------------------------------------------------
!
- IF (IM%I%CKSAT=='SGH' .AND. IM%I%CISBA/='DIF') THEN
-! Exponential decay factor calculate using soil properties
-! (eq. 11, Decharme et al., J. Hydrometeor, 2006)
- DO JILU=1,KI
- IF (ZM(JILU)/=XUNDEF) ZF(JILU,:) = (IM%I%XWSAT(JILU,1)-IM%I%XWD0(JILU,1))/ZM(JILU)
- ENDDO
-!
- ENDIF
+! PART 6: Specific options
+! --------------------------
+
+!6.A. DIF option :
+!---------------
+! Anisotropy coeficient for hydraulic conductivity for topmodel drainage (Fan et al. 2006)
+! Soil organic matter effect and/or Exponential decay for DIF option
+! Must be call before INIT_TOP
!
- ENDIF
!
-! Subsurface flow by layer (m/s)
- IF(IM%I%CISBA=='DIF') THEN
- ALLOCATE(IM%I%XTOPQS(KI,IM%I%NGROUND_LAYER,IM%I%NPATCH))
- IM%I%XTOPQS(:,:,:)=0.0
- ELSE
- ALLOCATE(IM%I%XTOPQS(0,0,0))
+IF(IO%CISBA=='DIF' .AND. IO%CKSAT=='SGH') THEN
+ !
+ WRITE(ILUOUT,*)'THE KSAT EXP PROFILE WITH ISBA-DF IS NOT PHYSIC AND HAS BEEN REMOVED FOR NOW'
+ WRITE(ILUOUT,*)'A NEW PHYSICAL APPROACH WILL BE DEVELLOPED ACCOUNTING FOR COMPACTION IN ALL '
+ WRITE(ILUOUT,*)'HYDRODYNAMIC PARAMETERS (WSAT, PSISAT, KSAT, B) AND NOT ONLY IN KSAT '
+ CALL ABOR1_SFX('CKSAT=SGH is not physic with ISBA-DF and has been removed for now')
+ !
+ENDIF
+!
+IF(IO%CISBA=='DIF' .AND. IO%LSOC)THEN
+ !
+ IF(.NOT.IO%LSOCP)THEN
+ WRITE(ILUOUT,*)'LSOC = T can be activated only if SOC data given in PGD fields'
+ CALL ABOR1_SFX('LSOC = T can be activated only if SOC data given in PGD fields')
ENDIF
+ !
+ ALLOCATE(S%XFRACSOC(KI,IO%NGROUND_LAYER))
+ CALL ISBA_SOC_PARAMETERS(IO%CRUNOFF, S%XSOC, K, NP, S%XFRACSOC, &
+ K%XWSAT, K%XWFC, K%XWWILT, IO%NPATCH )
+ !
+ELSE
+ ALLOCATE(S%XFRACSOC(0,0))
+ENDIF
+!
!
+!6.B. Topmodel
+!--------------
+!
+ZF (:,:) = XUNDEF
+ZM (:) = XUNDEF
+!
+!CRUNOFF used in hydro_sgh and isba_sgh_update
+IF( IO%CRUNOFF=='SGH '.AND. HINIT/='PRE' .AND. .NOT.LASSIM ) THEN
+ !
+ ! Subsurface flow by layer (m/s)
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ IF(IO%CISBA=='DIF') THEN
+ ALLOCATE(PK%XTOPQS(PK%NSIZE_P,IO%NGROUND_LAYER))
+ PK%XTOPQS(:,:) = 0.0
+ ELSE
+ ALLOCATE(PK%XTOPQS(0,0))
+ ENDIF
+ ENDDO
+ !
+ ALLOCATE(S%XTAB_FSAT(KI,NDIMTAB))
+ ALLOCATE(S%XTAB_WTOP(KI,NDIMTAB))
+ ALLOCATE(S%XTAB_QTOP(KI,NDIMTAB))
+ S%XTAB_FSAT(:,:) = 0.0
+ S%XTAB_WTOP(:,:) = 0.0
+ S%XTAB_QTOP(:,:) = 0.0
+ !
+ WHERE(K%XCLAY(:,1)==XUNDEF.AND.S%XTI_MEAN(:)/=XUNDEF) S%XTI_MEAN(:)=XUNDEF
+ CALL INIT_TOP(IO, S, K, NK, NP, ILUOUT, ZM )
+ !
ELSE
-!
- ALLOCATE(IM%I%XTAB_FSAT(0,0))
- ALLOCATE(IM%I%XTAB_WTOP(0,0))
- ALLOCATE(IM%I%XTAB_QTOP(0,0))
- ALLOCATE(IM%I%XTOPQS(0,0,0))
-!
+ !
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ ALLOCATE(PK%XTOPQS(0,0))
+ ENDDO
+ !
+ ALLOCATE(S%XTAB_FSAT(0,0))
+ ALLOCATE(S%XTAB_WTOP(0,0))
+ ALLOCATE(S%XTAB_QTOP(0,0))
+ !
ENDIF
!
+!
!Exponential decay for ISBA-FR option
!CKSAT used in hydro_soil.F90 and soil.F90
-IF(HINIT/='PRE'.AND.IM%I%CISBA/='DIF')THEN
+IF ( IO%CISBA/='DIF' .AND. HINIT/='PRE' .AND. .NOT.LASSIM ) THEN
!
- IF(IM%I%CKSAT=='SGH') THEN
- !
- WHERE(ZF(:,:)==XUNDEF.AND.IM%I%XDG(:,2,:)/=XUNDEF)
- ZF(:,:) = 4.0/IM%I%XDG(:,2,:)
- ENDWHERE
- ZF(:,:) = MIN(ZF(:,:),XF_DECAY)
- !
- ALLOCATE(IM%I%XF_PARAM (KI))
- IM%I%XF_PARAM(:) = ZF(:,1)
- !
- DO JPATCH=1,IM%I%NPATCH
- IF (IM%I%NSIZE_NATURE_P(JPATCH) == 0 ) CYCLE
- CALL EXP_DECAY_SOIL_FR(IM%I%CISBA, ZF(:,JPATCH),IM%I%XC1SAT(:,JPATCH),IM%I%XC2REF(:,JPATCH), &
- IM%I%XDG(:,:,JPATCH),IM%I%XD_ICE(:,JPATCH),IM%I%XC4REF(:,JPATCH), &
- IM%I%XC3(:,:,JPATCH),IM%I%XCONDSAT(:,:,JPATCH),IM%I%XKSAT_ICE(:,JPATCH))
- ENDDO
- !
- ELSEIF ( IM%I%CKSAT=='EXP' .AND. IM%I%CISBA=='3-L' ) THEN
+ GCAS1 = (IO%CKSAT=='EXP' .AND. IO%CISBA=='3-L')
+ GCAS2 = (IO%CKSAT=='SGH')
+ GCAS3 = (HPROGRAM/='AROME ' .AND. HPROGRAM/='MESONH ')
+ !
+ IF ( GCAS1 .OR. GCAS2 ) THEN
!
- ALLOCATE(IM%I%XF_PARAM (KI))
- IM%I%XF_PARAM(:) = XUNDEF
+ ALLOCATE(S%XF_PARAM (KI))
+ S%XF_PARAM(:) = XUNDEF
!
- IF (HPROGRAM/='AROME ' .AND. HPROGRAM/='MESONH ') THEN
+ IF ( GCAS1 .AND. GCAS3 ) THEN
!
+ !reading of XF_PARAM in external file
CALL OPEN_FILE('ASCII ',NUNIT,HFILE='carte_f_dc.txt',HFORM='FORMATTED',HACTION='READ ')
- DO JILU=1,U%NDIM_FULL
- READ(NUNIT,*) ZF_PARAM(JILU), ZC_DEPTH_RATIO(JILU)
+ DO JI = 1,U%NDIM_FULL
+ READ(NUNIT,*) ZF_PARAM(JI), ZC_DEPTH_RATIO(JI)
ENDDO
CALL CLOSE_FILE('ASCII ',NUNIT)
- CALL READ_AND_SEND_MPI(ZF_PARAM,IM%I%XF_PARAM,U%NR_NATURE)
+ CALL READ_AND_SEND_MPI(ZF_PARAM,S%XF_PARAM,U%NR_NATURE)
#ifdef TOPD
-IF (.NOT.ALLOCATED(XC_DEPTH_RATIO)) ALLOCATE(XC_DEPTH_RATIO (KI))
- XC_DEPTH_RATIO(:) = XUNDEF
+ IF (.NOT.ALLOCATED(XC_DEPTH_RATIO)) ALLOCATE(XC_DEPTH_RATIO (KI))
+ XC_DEPTH_RATIO(:) = XUNDEF
CALL READ_AND_SEND_MPI(ZC_DEPTH_RATIO,XC_DEPTH_RATIO,U%NR_NATURE)
#endif
!
- ELSE
+ ELSEIF ( GCAS1 ) THEN
WRITE(ILUOUT,*) "COMPUTE_ISBA_PARAMETERS: WITH CKSAT=EXP, IN NOT OFFLINE "//&
"MODE, TOPMODEL FILE FOR F_PARAM IS NOT READ "
ENDIF
!
- DO JPATCH=1,IM%I%NPATCH
- WHERE (IM%I%XF_PARAM(:)==XUNDEF.AND.IM%I%XDG(:,2,JPATCH)/=XUNDEF)
- ZF(:,JPATCH) = 4.0/IM%I%XDG(:,2,JPATCH)
- ELSEWHERE
- ZF(:,JPATCH) = IM%I%XF_PARAM(:)
+ ! definition of ZF functions of options
+ !
+ ! Exponential decay factor calculate using soil properties
+ ! (eq. 11, Decharme et al., J. Hydrometeor, 2006)
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ !
+ DO JI = 1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+
+ IF ( GCAS2 .AND. IO%CRUNOFF=='SGH' .AND. ZM(IMASK)/=XUNDEF ) THEN
+ ZF(JI,JP) = (K%XWSAT(IMASK,1)-K%XWD0(IMASK,1)) / ZM(IMASK)
+ ELSEIF ( GCAS1 ) THEN
+ ZF(JI,JP) = S%XF_PARAM(IMASK)
+ ENDIF
+ ENDDO
+ ENDDO
+ !
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ !
+ WHERE ( ZF(1:PK%NSIZE_P,JP)==XUNDEF.AND.PK%XDG(:,2)/=XUNDEF )
+ ZF(1:PK%NSIZE_P,JP) = 4.0/PK%XDG(:,2)
ENDWHERE
+ ZF(1:PK%NSIZE_P,JP) = MIN(ZF(1:PK%NSIZE_P,JP),XF_DECAY)
+ !
+ ZC_DEPTH_RATIO(1:PK%NSIZE_P) = 1.
+#ifdef TOPD
+ IF (ALLOCATED(XC_DEPTH_RATIO)) THEN
+ CALL PACK_SAME_RANK(PK%NR_P,XC_DEPTH_RATIO,ZC_DEPTH_RATIO(1:PK%NSIZE_P))
+ ENDIF
+#endif
+ CALL EXP_DECAY_SOIL_FR(IO%CISBA, ZF(1:PK%NSIZE_P,JP), PK, ZC_DEPTH_RATIO(1:PK%NSIZE_P))
ENDDO
- ZF(:,:) = MIN(ZF(:,:),XF_DECAY)
!
- DO JPATCH=1,IM%I%NPATCH
- CALL EXP_DECAY_SOIL_FR(IM%I%CISBA, ZF(:,JPATCH),IM%I%XC1SAT(:,JPATCH),IM%I%XC2REF(:,JPATCH), &
- IM%I%XDG(:,:,JPATCH),IM%I%XD_ICE(:,JPATCH),IM%I%XC4REF(:,JPATCH), &
- IM%I%XC3(:,:,JPATCH),IM%I%XCONDSAT(:,:,JPATCH), &
- IM%I%XKSAT_ICE(:,JPATCH))
- ENDDO
- !
+ IF ( GCAS2 ) THEN
+ !
+ DO JI = 1,NP%AL(1)%NSIZE_P
+ IMASK = NP%AL(1)%NR_P(JI)
+ S%XF_PARAM(IMASK) = ZF(JI,1)
+ ENDDO
+ !
+ ENDIF
+ !
ENDIF
!
ENDIF
!
!
-!* 2.10 Soil carbon
-! -----------
-!
-IF (HINIT == 'ALL' .AND. IM%I%CRESPSL=='CNT' .AND. IM%I%CPHOTO == 'NCB') THEN
- CALL CARBON_INIT(IM%I%NNBIOMASS, IM%I%NNLITTER, IM%I%NNLITTLEVS, IM%I%NNSOILCARB)
-ENDIF
-!
-!Rainfall spatial distribution
-!CRAIN used in HYDRO_VEG and HYDRO_SGH and ISBA_SGH_UPDATE
-IF(IM%I%CRAIN=='SGH')THEN
- ALLOCATE(IM%I%XMUF(KI))
- IM%I%XMUF(:)=0.0
-ELSE
- ALLOCATE(IM%I%XMUF(0))
-ENDIF
-!
-ALLOCATE(IM%I%XFSAT(KI))
-IM%I%XFSAT(:) = 0.0
-!
-!-------------------------------------------------------------------------------
-!
-!* 6.2 Initialize of SFX - RRM coupling:
-! ---------------------------------
-!
-! * Check some key :
-!
-IF(LCPL_CALVING)THEN
- IF(.NOT.IM%I%LGLACIER)THEN
- CALL ABOR1_SFX('COMPUTE_ISBA_PARAMETERS: LGLACIER MUST BE ACTIVATED IF LCPL_CALVING')
- ENDIF
-ENDIF
-!
-! * Initialize required coupling fields :
+! 6.C. Initialize required coupling fields :
+!-------------------------------------------
!
-IM%I%LCPL_RRM = .FALSE.
-IM%I%LFLOOD = .FALSE.
-IM%I%LWTD = .FALSE.
+IO%LCPL_RRM = .FALSE.
+IO%LFLOOD = .FALSE.
+IO%LWTD = .FALSE.
!
IF(LCPL_LAND)THEN
!
- IM%I%LCPL_RRM = .TRUE.
-!
- ALLOCATE(IM%I%XCPL_DRAIN (KI))
- ALLOCATE(IM%I%XCPL_RUNOFF(KI))
- IM%I%XCPL_DRAIN (:) = 0.0
- IM%I%XCPL_RUNOFF(:) = 0.0
+ IO%LCPL_RRM = .TRUE.
!
- IF(IM%I%LGLACIER)THEN
- ALLOCATE(IM%I%XCPL_ICEFLUX(KI))
- IM%I%XCPL_ICEFLUX(:) = 0.0
- ELSE
- ALLOCATE(IM%I%XCPL_ICEFLUX(0))
+ IF(LCPL_GW)THEN
+ IO%LWTD = .TRUE.
ENDIF
!
- IF(LCPL_GW)THEN
- IM%I%LWTD = .TRUE.
- ALLOCATE(IM%I%XCPL_RECHARGE(KI))
- IM%I%XCPL_RECHARGE(:) = 0.0
+ ALLOCATE(S%XCPL_DRAIN (KI))
+ ALLOCATE(S%XCPL_RUNOFF(KI))
+ S%XCPL_DRAIN (:) = 0.0
+ S%XCPL_RUNOFF(:) = 0.0
+!
+ IF(IO%LGLACIER)THEN
+ ALLOCATE(S%XCPL_ICEFLUX(KI))
+ S%XCPL_ICEFLUX(:) = 0.0
ELSE
- ALLOCATE(IM%I%XCPL_RECHARGE(0))
+ ALLOCATE(S%XCPL_ICEFLUX(0))
ENDIF
!
IF(LCPL_FLOOD)THEN
- IM%I%LFLOOD = .TRUE.
- ALLOCATE(IM%I%XCPL_EFLOOD(KI))
- ALLOCATE(IM%I%XCPL_PFLOOD(KI))
- ALLOCATE(IM%I%XCPL_IFLOOD(KI))
- IM%I%XCPL_EFLOOD(:)= 0.0
- IM%I%XCPL_PFLOOD(:)= 0.0
- IM%I%XCPL_IFLOOD(:)= 0.0
+ IO%LFLOOD = .TRUE.
+ ALLOCATE(S%XCPL_EFLOOD(KI))
+ ALLOCATE(S%XCPL_PFLOOD(KI))
+ ALLOCATE(S%XCPL_IFLOOD(KI))
+ S%XCPL_EFLOOD(:)= 0.0
+ S%XCPL_PFLOOD(:)= 0.0
+ S%XCPL_IFLOOD(:)= 0.0
ELSE
- ALLOCATE(IM%I%XCPL_EFLOOD(0))
- ALLOCATE(IM%I%XCPL_PFLOOD(0))
- ALLOCATE(IM%I%XCPL_IFLOOD(0))
+ ALLOCATE(S%XCPL_EFLOOD(0))
+ ALLOCATE(S%XCPL_PFLOOD(0))
+ ALLOCATE(S%XCPL_IFLOOD(0))
ENDIF
!
ELSE
!
- ALLOCATE(IM%I%XCPL_RUNOFF (0))
- ALLOCATE(IM%I%XCPL_DRAIN (0))
- ALLOCATE(IM%I%XCPL_ICEFLUX (0))
- ALLOCATE(IM%I%XCPL_RECHARGE(0))
- ALLOCATE(IM%I%XCPL_EFLOOD (0))
- ALLOCATE(IM%I%XCPL_PFLOOD (0))
- ALLOCATE(IM%I%XCPL_IFLOOD (0))
+ ALLOCATE(S%XCPL_RUNOFF (0))
+ ALLOCATE(S%XCPL_DRAIN (0))
+ ALLOCATE(S%XCPL_ICEFLUX (0))
+ ALLOCATE(S%XCPL_EFLOOD (0))
+ ALLOCATE(S%XCPL_PFLOOD (0))
+ ALLOCATE(S%XCPL_IFLOOD (0))
!
ENDIF
!
-IF(IM%I%LWTD.AND..NOT.IM%I%LGW)THEN
- WRITE(ILUOUT,*)'COMPUTE_ISBA_PARAMETERS: Groundwater map is required by SFX - Groundwater coupling '
- WRITE(ILUOUT,*)'COMPUTE_ISBA_PARAMETERS: Please check your pgd namelist where this map must be '
- WRITE(ILUOUT,*)'COMPUTE_ISBA_PARAMETERS: specified (YGW and YGWFILETYPE, or XUNIF_GW, or LIMP_GW) '
- CALL ABOR1_SFX('COMPUTE_ISBA_PARAMETERS: Groundwater map is required by SFX - Groundwater coupling')
-ENDIF
!
-! * Initialize flood scheme :
-!
-IF(IM%I%LFLOOD)THEN
- ALLOCATE(IM%I%XFFLOOD (KI))
- ALLOCATE(IM%I%XPIFLOOD(KI))
- ALLOCATE(IM%I%XFF (KI,IM%I%NPATCH))
- ALLOCATE(IM%I%XFFG (KI,IM%I%NPATCH))
- ALLOCATE(IM%I%XFFV (KI,IM%I%NPATCH))
- ALLOCATE(IM%I%XFFROZEN(KI,IM%I%NPATCH))
- ALLOCATE(IM%I%XALBF (KI,IM%I%NPATCH))
- ALLOCATE(IM%I%XEMISF (KI,IM%I%NPATCH))
- IM%I%XFFLOOD = 0.0
- IM%I%XPIFLOOD = 0.0
- IM%I%XFF = 0.0
- IM%I%XFFG = 0.0
- IM%I%XFFV = 0.0
- IM%I%XFFROZEN = 0.0
- IM%I%XALBF = 0.0
- IM%I%XEMISF = 0.0
+IF (LCPL_LAND) THEN
+ !
+ ALLOCATE(K%XFWTD(KI))
+ ALLOCATE(K%XWTD (KI))
+ K%XFWTD(:) = 0.0
+ K%XWTD (:) = XUNDEF
+ !
+ IF(LCPL_FLOOD)THEN
+ ALLOCATE(K%XFFLOOD (KI))
+ ALLOCATE(K%XPIFLOOD(KI))
+ K%XFFLOOD (:) = 0.0
+ K%XPIFLOOD(:) = 0.0
+ !
+ ELSE
+ !
+ ALLOCATE(K%XFFLOOD (0))
+ ALLOCATE(K%XPIFLOOD(0))
+ !
+ ENDIF
+ !
ELSE
- ALLOCATE(IM%I%XFFLOOD (0))
- ALLOCATE(IM%I%XPIFLOOD (0))
- ALLOCATE(IM%I%XFF (0,0))
- ALLOCATE(IM%I%XFFG (0,0))
- ALLOCATE(IM%I%XFFV (0,0))
- ALLOCATE(IM%I%XFFROZEN(0,0))
- ALLOCATE(IM%I%XALBF (0,0))
- ALLOCATE(IM%I%XEMISF (0,0))
+ !
+ ALLOCATE(K%XFWTD(0))
+ ALLOCATE(K%XWTD (0))
+ ALLOCATE(K%XFFLOOD (0))
+ ALLOCATE(K%XPIFLOOD(0))
+ !
+ENDIF
+!
+! * Check some key :
+!
+IF(LCPL_CALVING)THEN
+ IF(.NOT.IO%LGLACIER)THEN
+ CALL ABOR1_SFX('COMPUTE_ISBA_PARAMETERS: LGLACIER MUST BE ACTIVATED IF LCPL_CALVING')
+ ENDIF
ENDIF
!
!-------------------------------------------------------------------------------
!
-!* 7. ISBA time-varying deep force-restore temperature initialization
-! ---------------------------------------------------------------
+!* 6.D. ISBA time-varying deep force-restore temperature initialization
+! --------------------------------------------------------------------
!
- CALL SOILTEMP_ARP_PAR(IM%I, &
- HPROGRAM,IM%I%LTEMP_ARP,IM%I%NTEMPLAYER_ARP)
+ CALL SOILTEMP_ARP_PAR(IO, HPROGRAM)
!
!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+!
+! PART 7: We packed needed fields and free unless ones
+! -----------------------------------------------------
+!
+!
+DO JP = 1,IO%NPATCH
+ !
+ KK => NK%AL(JP)
+ PK => NP%AL(JP)
+ ISSK => NISS%AL(JP)
+ GK => NIG%AL(JP)
+ !
+ ALLOCATE(KK%XMPOTSAT(PK%NSIZE_P,IO%NGROUND_LAYER))
+ ALLOCATE(KK%XBCOEF (PK%NSIZE_P,IO%NGROUND_LAYER))
+ ! needed to be written as diagnostics, so not free
+ ALLOCATE(KK%XWWILT (PK%NSIZE_P,IO%NGROUND_LAYER))
+ ALLOCATE(KK%XWFC (PK%NSIZE_P,IO%NGROUND_LAYER))
+ ALLOCATE(KK%XWSAT (PK%NSIZE_P,IO%NGROUND_LAYER))
+ !
+ CALL PACK_SAME_RANK(PK%NR_P,K%XMPOTSAT,KK%XMPOTSAT)
+ CALL PACK_SAME_RANK(PK%NR_P,K%XBCOEF,KK%XBCOEF)
+ !
+ CALL PACK_SAME_RANK(PK%NR_P,K%XWWILT,KK%XWWILT)
+ CALL PACK_SAME_RANK(PK%NR_P,K%XWFC,KK%XWFC)
+ CALL PACK_SAME_RANK(PK%NR_P,K%XWSAT,KK%XWSAT)
+ !
+ IF (IO%CISBA=='2-L' .OR. IO%CISBA=='3-L') THEN
+ ALLOCATE(KK%XCGSAT(PK%NSIZE_P))
+ ALLOCATE(KK%XC4B (PK%NSIZE_P))
+ ALLOCATE(KK%XACOEF(PK%NSIZE_P))
+ ALLOCATE(KK%XPCOEF(PK%NSIZE_P))
+ CALL PACK_SAME_RANK(PK%NR_P,K%XCGSAT,KK%XCGSAT)
+ CALL PACK_SAME_RANK(PK%NR_P,K%XC4B, KK%XC4B)
+ CALL PACK_SAME_RANK(PK%NR_P,K%XACOEF,KK%XACOEF)
+ CALL PACK_SAME_RANK(PK%NR_P,K%XPCOEF,KK%XPCOEF)
+ ENDIF
+ !
+ IF (IO%CSCOND=='PL98'.OR.IO%CISBA=='DIF') THEN
+ ALLOCATE(KK%XHCAPSOIL(PK%NSIZE_P,IO%NGROUND_LAYER))
+ ALLOCATE(KK%XCONDDRY (PK%NSIZE_P,IO%NGROUND_LAYER))
+ ALLOCATE(KK%XCONDSLD (PK%NSIZE_P,IO%NGROUND_LAYER))
+ CALL PACK_SAME_RANK(PK%NR_P,K%XHCAPSOIL,KK%XHCAPSOIL)
+ CALL PACK_SAME_RANK(PK%NR_P,K%XCONDDRY ,KK%XCONDDRY)
+ CALL PACK_SAME_RANK(PK%NR_P,K%XCONDSLD ,KK%XCONDSLD)
+ ENDIF
+ !
+ ALLOCATE(KK%XWDRAIN (PK%NSIZE_P))
+ ALLOCATE(KK%XRUNOFFB(PK%NSIZE_P))
+ CALL PACK_SAME_RANK(PK%NR_P,K%XWDRAIN,KK%XWDRAIN)
+ CALL PACK_SAME_RANK(PK%NR_P,K%XRUNOFFB,KK%XRUNOFFB)
+ !
+ ! needed to be written as diagnostics, so not free
+ ALLOCATE(ISSK%XZ0REL (PK%NSIZE_P))
+ ALLOCATE(ISSK%XSSO_SLOPE(PK%NSIZE_P))
+ !
+ CALL PACK_SAME_RANK(PK%NR_P,ISS%XZ0REL,ISSK%XZ0REL)
+ CALL PACK_SAME_RANK(PK%NR_P,ISS%XSSO_SLOPE,ISSK%XSSO_SLOPE)
+ !
+ ALLOCATE(GK%XLAT(PK%NSIZE_P))
+ ALLOCATE(GK%XLON(PK%NSIZE_P))
+ !
+ CALL PACK_SAME_RANK(PK%NR_P,IG%XLAT,GK%XLAT)
+ CALL PACK_SAME_RANK(PK%NR_P,IG%XLON,GK%XLON)
+ !
+ENDDO
+!
+! Useledd fields from now on
+ISS%XAOSIP => NULL()
+ISS%XAOSIM => NULL()
+ISS%XAOSJP => NULL()
+ISS%XAOSJM => NULL()
+ISS%XHO2IP => NULL()
+ISS%XHO2IM => NULL()
+ISS%XHO2JP => NULL()
+ISS%XHO2JM => NULL()
+!
+K%XMPOTSAT => NULL()
+K%XBCOEF => NULL()
!
-!* 9. Prints of cover parameters in a tex file
-! ----------------------------------------
+K%XCGSAT => NULL()
+K%XC4B => NULL()
+K%XACOEF => NULL()
+K%XPCOEF => NULL()
+!
+K%XHCAPSOIL => NULL()
+K%XCONDDRY => NULL()
+K%XCONDSLD => NULL()
+!
+K%XWDRAIN => NULL()
+K%XRUNOFFB => NULL()
+!
+!-------------------------------------------------------------------------------
!
!* if only physiographic fields are to be initialized, stop here.
!
@@ -594,21 +889,20 @@ IF (HINIT/='ALL' .AND. HINIT/='SOD') THEN
END IF
!
!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
!
-IF (CASSIM_ISBA=="ENKF ") THEN
- !
- CALL INIT_RANDOM_SEED()
- !
-ENDIF
+! PART 8: Reading of prognostic variables
+! ----------------------------------------
+!
+IF (CASSIM_ISBA=="ENKF ") CALL INIT_RANDOM_SEED()
!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'NATURE','ISBA ','READ ')
+!
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'NATURE','ISBA ','READ ')
!
!* 10. Prognostic and semi-prognostic fields
! -------------------------------------
!
- CALL READ_ISBA_n(DTCO, IM%I, U, &
- HPROGRAM)
+ CALL READ_ISBA_n(DTCO, IO, S, NP, NPE, K%XCLAY, U, HPROGRAM)
!
IF (HINIT/='ALL') THEN
CALL END_IO_SURF_n(HPROGRAM)
@@ -616,100 +910,133 @@ IF (HINIT/='ALL') THEN
RETURN
END IF
!
-IF (HINIT=='PRE' .AND. IM%I%TSNOW%SCHEME.NE.'3-L' .AND. IM%I%TSNOW%SCHEME.NE.'CRO' .AND. IM%I%CISBA=='DIF') THEN
- CALL ABOR1_SFX("INIT_ISBAN: WITH CISBA = DIF, CSNOW MUST BE 3-L OR CRO")
-ENDIF
+IF (HINIT=='PRE' .AND. NPE%AL(1)%TSNOW%SCHEME.NE.'3-L' .AND. &
+ NPE%AL(1)%TSNOW%SCHEME.NE.'CRO' .AND. IO%CISBA=='DIF') &
+ CALL ABOR1_SFX("INIT_ISBAN: WITH CISBA = DIF, CSNOW MUST BE 3-L OR CRO")
!
-!-------------------------------------------------------------------------------
!
-!* 11. Extrapolation of the prognostic and semi-prognostic fields
+!* Extrapolation of the prognostic and semi-prognostic fields
! LAND USE case
! -------------------------------------
!
IF (OLAND_USE) THEN
- CALL INIT_ISBA_LANDUSE(DTCO, IM%IG, IM%I, UG, U, &
+ !
+ CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP)
+ GDIM = (IVERSION>8 .OR. IVERSION==8 .AND. IBUGFIX>0)
+ IF (GDIM) CALL READ_SURF(HPROGRAM,'SPLIT_PATCH',GDIM,IRESP)
+ !
+ ALLOCATE(ZWORK(KI,IO%NPATCH))
+ !
+ !* read old patch fraction
+ !
+ DO JP = 1,IO%NPATCH
+ ALLOCATE(NP%AL(JP)%XPATCH_OLD(NP%AL(JP)%NSIZE_P))
+ ENDDO
+ !
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, 'PATCH', ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NP%AL(JP)%XPATCH_OLD(:))
+ ENDDO
+ !
+ !* read old soil layer thicknesses (m)
+ !
+ DO JP = 1,IO%NPATCH
+ ALLOCATE(NP%AL(JP)%XDG_OLD(NP%AL(JP)%NSIZE_P,IO%NGROUND_LAYER))
+ ENDDO
+ !
+ DO JL=1,IO%NGROUND_LAYER
+ WRITE(YLVL,'(I4)') JL
+ YRECFM='OLD_DG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NP%AL(JP)%XDG_OLD(:,JL))
+ ENDDO
+ END DO
+ DEALLOCATE(ZWORK)
+ !
+ CALL INIT_ISBA_LANDUSE(DTCO, UG, U, IO, NK, NP, NPE, IG%XMESH_SIZE, &
HPROGRAM)
END IF
!
-!-------------------------------------------------------------------------------
!
!* 12. Canopy air fields:
! -----------------
!
- CALL READ_ISBA_CANOPY_n(DTCO, IM%ICP, IM%I, U, &
- HPROGRAM)
+ CALL READ_SBL_n(DTCO, U, SB, IO%LCANOPY, HPROGRAM, "NATURE")
!
!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+!
+! PART 9: initialize radiative and physical properties
+! ----------------------------------------------------
+!
+DO JP=1,IO%NPATCH
+ PK => NP%AL(JP)
+ KK => NK%AL(JP)
+ PEK => NPE%AL(JP)
+ !
+ ALLOCATE(KK%XDIR_ALB_WITH_SNOW(PK%NSIZE_P,KSW))
+ ALLOCATE(KK%XSCA_ALB_WITH_SNOW(PK%NSIZE_P,KSW))
+ KK%XDIR_ALB_WITH_SNOW = 0.0
+ KK%XSCA_ALB_WITH_SNOW = 0.0
+ !
+ CALL INIT_VEG_n(IO, KK, PK, PEK, DTI, ID%DM%LSURF_DIAG_ALBEDO, PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD )
+ !
+ ZWG1(1:PK%NSIZE_P) = PEK%XWG(:,1)
+ ZTG1(1:PK%NSIZE_P,JP) = PEK%XTG(:,1)
+ !
+ CALL CONVERT_PATCH_ISBA(DTCO, DTI, IO, IDECADE, IDECADE2, S%XCOVER, S%LCOVER,&
+ LAGRIP, 'NAT', JP, KK, PK, PEK, &
+ .FALSE., .FALSE., .FALSE., .FALSE., .TRUE., .FALSE., &
+ PWG1=ZWG1(1:PK%NSIZE_P), PWSAT=KK%XWSAT)
+ !
+ENDDO
!
-!* 13. initialize radiative and physical properties
-! --------------------------------------------
-!
-ALLOCATE(IM%I%XDIR_ALB_WITH_SNOW(KI,KSW,IM%I%NPATCH))
-ALLOCATE(IM%I%XSCA_ALB_WITH_SNOW(KI,KSW,IM%I%NPATCH))
-IM%I%XDIR_ALB_WITH_SNOW = 0.0
-IM%I%XSCA_ALB_WITH_SNOW = 0.0
-!
- CALL INIT_VEG_n(IM%I%NPATCH, KI, IM%I%LCANOPY, IM%I%CROUGH, IM%I%LAGRI_TO_GRASS, IM%I%TSNOW, &
- IM%I%CPHOTO, IM%DTI%LIMP_VEG, IM%DTI%LIMP_Z0, IM%DTI%LIMP_EMIS, &
- IM%I%XLAIMIN, IM%I%XH_TREE, IM%I%XVEGTYPE_PATCH, IM%I%XLAI, &
- IM%I%XZ0, IM%I%XVEG, IM%I%XEMIS, &
- IM%I%LTR_ML, IM%I%XFAPARC, IM%I%XFAPIRC, IM%I%XLAI_EFFC, IM%I%XMUS, &
- IM%I%XALBNIR_SOIL, IM%I%XALBVIS_SOIL, IM%I%XALBUV_SOIL, IM%I%XALBNIR, &
- IM%I%XALBVIS, IM%I%XALBUV, &
- IM%DGMI%LSURF_DIAG_ALBEDO, IM%I%XPSN, IM%I%XPSNG, IM%I%XPSNV, IM%I%XPSNV_A, &
- PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD )
-!
-DO JPATCH=1,IM%I%NPATCH
- ZWG1(:,JPATCH) = IM%I%XWG(:,1,JPATCH)
- ZTG1(:,JPATCH) = IM%I%XTG(:,1,JPATCH)
-END DO
-!
- CALL CONVERT_PATCH_ISBA(DTCO, IM%DTI, IM%I, &
- IM%I%CISBA,IDECADE,IDECADE2,IM%I%XCOVER,IM%I%LCOVER,&
- IM%I%CPHOTO,LAGRIP,IM%I%LPERM,IM%I%LTR_ML,'NAT', &
- PWG1 = ZWG1, &
- PALBNIR_SOIL=IM%I%XALBNIR_SOIL, &
- PALBVIS_SOIL=IM%I%XALBVIS_SOIL, &
- PALBUV_SOIL=IM%I%XALBUV_SOIL )
!
! Load randomly perturbed fields. Perturbation ratios are saved in case fields are reset later.
-IF(IM%I%LPERTSURF) THEN
-!
- CALL READ_SURF(&
- HPROGRAM,'VEG',IM%I%XVEG(:,:),IRESP)
- ALLOCATE(IM%I%XPERTVEG(KI))
- IM%I%XPERTVEG(:)=IM%I%XVEG(:,1)
-!
- CALL READ_SURF(&
- HPROGRAM,'LAI',IM%I%XLAI(:,:),IRESP)
- ALLOCATE(IM%I%XPERTLAI(KI))
- IM%I%XPERTLAI(:)=IM%I%XLAI(:,1)
-!
- CALL READ_SURF(&
- HPROGRAM,'CV',IM%I%XCV(:,:),IRESP)
- ALLOCATE(IM%I%XPERTCV(KI))
- IM%I%XPERTCV(:)=IM%I%XCV(:,1)
-!
- CALL READ_SURF(&
- HPROGRAM,'PERTALB',ZPERTBUF(:,:),IRESP)
- ALLOCATE(IM%I%XPERTALB(KI))
- IM%I%XPERTALB(:)=ZPERTBUF(:,1)
- WHERE(IM%I%XALBNIR_VEG(:,1)/=XUNDEF) IM%I%XALBNIR_VEG(:,1) = IM%I%XALBNIR_VEG(:,1) *( 1.+ IM%I%XPERTALB(:) )
- WHERE(IM%I%XALBVIS_VEG(:,1)/=XUNDEF) IM%I%XALBVIS_VEG(:,1) = IM%I%XALBVIS_VEG(:,1) *( 1.+ IM%I%XPERTALB(:) )
- WHERE(IM%I%XALBUV_VEG(:,1)/=XUNDEF) IM%I%XALBUV_VEG(:,1) = IM%I%XALBUV_VEG(:,1) *( 1.+ IM%I%XPERTALB(:) )
- WHERE(IM%I%XALBNIR_SOIL(:,1)/=XUNDEF) IM%I%XALBNIR_SOIL(:,1)= IM%I%XALBNIR_SOIL(:,1)*( 1.+ IM%I%XPERTALB(:) )
- WHERE(IM%I%XALBVIS_SOIL(:,1)/=XUNDEF) IM%I%XALBVIS_SOIL(:,1)= IM%I%XALBVIS_SOIL(:,1)*( 1.+ IM%I%XPERTALB(:) )
- WHERE(IM%I%XALBUV_SOIL(:,1)/=XUNDEF) IM%I%XALBUV_SOIL(:,1) = IM%I%XALBUV_SOIL(:,1) *( 1.+ IM%I%XPERTALB(:) )
-!
- CALL READ_SURF(&
- HPROGRAM,'PERTZ0LAND',ZPERTBUF(:,:),IRESP)
- ALLOCATE(IM%I%XPERTZ0(KI))
- IM%I%XPERTZ0(:)=ZPERTBUF(:,1)
- WHERE(IM%I%XZ0(:,1)/=XUNDEF) IM%I%XZ0(:,1) =IM%I%XZ0(:,1) *( 1.+ IM%I%XPERTZ0(:) )
- WHERE(IM%I%XZ0EFFIP(:,1)/=XUNDEF) IM%I%XZ0EFFIP(:,1)=IM%I%XZ0EFFIP(:,1)*( 1.+ IM%I%XPERTZ0(:) )
- WHERE(IM%I%XZ0EFFIM(:,1)/=XUNDEF) IM%I%XZ0EFFIM(:,1)=IM%I%XZ0EFFIM(:,1)*( 1.+ IM%I%XPERTZ0(:) )
- WHERE(IM%I%XZ0EFFJP(:,1)/=XUNDEF) IM%I%XZ0EFFJP(:,1)=IM%I%XZ0EFFJP(:,1)*( 1.+ IM%I%XPERTZ0(:) )
- WHERE(IM%I%XZ0EFFJM(:,1)/=XUNDEF) IM%I%XZ0EFFJM(:,1)=IM%I%XZ0EFFJM(:,1)*( 1.+ IM%I%XPERTZ0(:) )
+IF(IO%LPERTSURF) THEN
+ !
+ CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP)
+ GDIM = (IVERSION>8 .OR. IVERSION==8 .AND. IBUGFIX>0)
+ !
+ ALLOCATE(ZWORK(KI,IO%NPATCH))
+ !
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, 'VEG', ZWORK)
+ ALLOCATE(S%XPERTVEG(KI))
+ S%XPERTVEG(:)=ZWORK(:,1)
+!
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, 'LAI', ZWORK)
+ ALLOCATE(S%XPERTLAI(KI))
+ S%XPERTLAI(:)=ZWORK(:,1)
+!
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, 'CV', ZWORK)
+ ALLOCATE(S%XPERTCV(KI))
+ S%XPERTCV(:)=ZWORK(:,1)
+!
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, 'PERTALB', ZWORK)
+ ALLOCATE(S%XPERTALB(KI))
+ S%XPERTALB(:)=ZWORK(:,1)
+
+ PEK => NPE%AL(1)
+ ISSK => NISS%AL(1)
+
+ WHERE(PEK%XALBNIR_VEG (:)/=XUNDEF) PEK%XALBNIR_VEG(:) = PEK%XALBNIR_VEG (:) *( 1.+ S%XPERTALB(:) )
+ WHERE(PEK%XALBVIS_VEG (:)/=XUNDEF) PEK%XALBVIS_VEG(:) = PEK%XALBVIS_VEG (:) *( 1.+ S%XPERTALB(:) )
+ WHERE(PEK%XALBUV_VEG (:)/=XUNDEF) PEK%XALBUV_VEG (:) = PEK%XALBUV_VEG (:) *( 1.+ S%XPERTALB(:) )
+ WHERE(PEK%XALBNIR_SOIL(:)/=XUNDEF) PEK%XALBNIR_SOIL(:) = PEK%XALBNIR_SOIL(:) *( 1.+ S%XPERTALB(:) )
+ WHERE(PEK%XALBVIS_SOIL(:)/=XUNDEF) PEK%XALBVIS_SOIL(:) = PEK%XALBVIS_SOIL(:) *( 1.+ S%XPERTALB(:) )
+ WHERE(PEK%XALBUV_SOIL (:)/=XUNDEF) PEK%XALBUV_SOIL (:) = PEK%XALBUV_SOIL (:) *( 1.+ S%XPERTALB(:) )
+!
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, 'PERTZ0LAND', ZWORK)
+ ALLOCATE(S%XPERTZ0(KI))
+ S%XPERTZ0(:)=ZWORK(:,1)
+ WHERE(PEK%XZ0(:)/=XUNDEF) PEK%XZ0(:) = PEK%XZ0(:) *( 1.+ S%XPERTZ0(:) )
+ WHERE(ISSK%XZ0EFFIP(:)/=XUNDEF) ISSK%XZ0EFFIP(:) = ISSK%XZ0EFFIP(:)*( 1.+ S%XPERTZ0(:) )
+ WHERE(ISSK%XZ0EFFIM(:)/=XUNDEF) ISSK%XZ0EFFIM(:) = ISSK%XZ0EFFIM(:)*( 1.+ S%XPERTZ0(:) )
+ WHERE(ISSK%XZ0EFFJP(:)/=XUNDEF) ISSK%XZ0EFFJP(:) = ISSK%XZ0EFFJP(:)*( 1.+ S%XPERTZ0(:) )
+ WHERE(ISSK%XZ0EFFJM(:)/=XUNDEF) ISSK%XZ0EFFJM(:) = ISSK%XZ0EFFJM(:)*( 1.+ S%XPERTZ0(:) )
!
ENDIF
!
@@ -718,26 +1045,14 @@ ENDIF
!* 14. Output radiative fields
! -----------------------
!
-ALLOCATE(IM%I%XEMIS_NAT (KI))
-IM%I%XEMIS_NAT (:) = XUNDEF
-!
- CALL AVERAGED_ALBEDO_EMIS_ISBA(IM%I, &
- IM%I%LFLOOD, IM%I%CALBEDO, PZENITH, &
- IM%I%XVEG,IM%I%XZ0,IM%I%XLAI, &
- IM%I%LMEB_PATCH,IM%I%XGNDLITTER,IM%I%XZ0LITTER,IM%I%XLAIGV, &
- IM%I%XH_VEG, IM%I%XTV, &
- ZTG1, &
- IM%I%XPATCH, &
- PSW_BANDS, &
- IM%I%XALBNIR_VEG,IM%I%XALBVIS_VEG,IM%I%XALBUV_VEG, &
- IM%I%XALBNIR_SOIL,IM%I%XALBVIS_SOIL,IM%I%XALBUV_SOIL, &
- IM%I%XEMIS, &
- IM%I%TSNOW, &
- IM%I%XALBNIR,IM%I%XALBVIS,IM%I%XALBUV, &
- PDIR_ALB, PSCA_ALB, &
- IM%I%XEMIS_NAT,ZTSRAD_NAT,ZTSURF_NAT )
-!
-PEMIS = IM%I%XEMIS_NAT
+ALLOCATE(S%XEMIS_NAT (KI))
+S%XEMIS_NAT (:) = XUNDEF
+!
+ CALL AVERAGED_ALBEDO_EMIS_ISBA(IO, S, NK, NP, NPE, &
+ PZENITH, ZTG1, PSW_BANDS, PDIR_ALB, PSCA_ALB, &
+ S%XEMIS_NAT, ZTSRAD_NAT, ZTSURF_NAT )
+!
+PEMIS = S%XEMIS_NAT
PTSRAD = ZTSRAD_NAT
PTSURF = ZTSURF_NAT
!
@@ -746,22 +1061,23 @@ PTSURF = ZTSURF_NAT
!* 15. ISBA diagnostics initialization
! -------------------------------
!
-IF(IM%I%NPATCH<=1) IM%DGI%LPATCH_BUDGET=.FALSE.
+IF(IO%NPATCH<=1) ID%O%LPATCH_BUDGET=.FALSE.
!
- CALL DIAG_ISBA_INIT_n(&
- IM%CHI, IM%DGEI, IM%DGI, IM%DGMI, DGU, IM%GB, IM%I, &
- HPROGRAM,KI,KSW)
+ CALL DIAG_ISBA_INIT_n(CHI, ID%DE, ID%DEC, ID%NDE, ID%NDEC, ID%O, &
+ ID%D, ID%DC, ID%ND, ID%NDC, ID%DM, ID%NDM, &
+ OREAD_BUDGETC, NGB, GB, IO, NP, NPE%AL(1)%TSNOW%SCHEME, &
+ NPE%AL(1)%TSNOW%NLAYER, SIZE(S%XABC), HPROGRAM,KI,KSW)
!
!-------------------------------------------------------------------------------
!
- CALL INIT_SURF_TOPD(IM%DGEI, IM%I, UG, U, &
- HPROGRAM,U%NDIM_FULL)
+ CALL INIT_SURF_TOPD(ID%DEC, IO, S, K, NP, NPE, UG, U, HPROGRAM, U%NDIM_FULL)
!
!-------------------------------------------------------------------------------
!
! End of IO
!
CALL END_IO_SURF_n(HPROGRAM)
+!
IF (LHOOK) CALL DR_HOOK('COMPUTE_ISBA_PARAMETERS',1,ZHOOK_HANDLE)
!
END SUBROUTINE COMPUTE_ISBA_PARAMETERS
diff --git a/src/SURFEX/conserv_global_mass.F90 b/src/SURFEX/conserv_global_mass.F90
index 0d5fb675890a6278044e24aeb01d47a5de5513f1..9162e3524c2f110741cbc2dd9a6c756f2adf765d 100644
--- a/src/SURFEX/conserv_global_mass.F90
+++ b/src/SURFEX/conserv_global_mass.F90
@@ -2,8 +2,8 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
- SUBROUTINE CONSERV_GLOBAL_MASS (DTCO, IG, I, U, &
- ILUOUT,PZDG,PZDG_OLD,PFIELD,PFIELD_OLD)
+ SUBROUTINE CONSERV_GLOBAL_MASS (DTCO, U, NP, NPE, PMESH_SIZE, KPATCH, &
+ ILUOUT, PZDG, PZDG_OLD, HNAME, PFIELD_OLD)
!!
!!**** *CONSERV_GLOBAL_MASS* - routine to conserve global 3D mass (LAND USE case)
!!
@@ -38,8 +38,8 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_ISBA_n, ONLY : ISBA_NP_t, ISBA_NPE_t, ISBA_P_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -47,57 +47,84 @@ USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODI_PACK_SAME_RANK
USE MODI_GET_SURF_MASK_n
!
+USE MODD_SURFEX_MPI, ONLY : NPROC, NRANK, NPIO, NCOMM
+USE MODI_GATHER_AND_WRITE_MPI
+!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1 Declaration of arguments
! ------------------------
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
+REAL, DIMENSION(:), INTENT(IN) :: PMESH_SIZE
+INTEGER, INTENT(IN) :: KPATCH
!
INTEGER, INTENT(IN ) :: ILUOUT
REAL, DIMENSION(:,:,:), INTENT(IN ) :: PFIELD_OLD,PZDG,PZDG_OLD
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIELD
+ CHARACTER(LEN=3), INTENT(IN) :: HNAME
!
!* 0.2 Declaration of local variables
! ------------------------------
!
-REAL, DIMENSION(SIZE(PFIELD,1)) :: ZFIELD,ZFIELD_OLD, ZFRAC_NAT
+TYPE(ISBA_P_t), POINTER :: PK
+!
+REAL, DIMENSION(U%NSIZE_NATURE,SIZE(NPE%AL(1)%XWG,2),KPATCH) :: ZFIELD0
+REAL, DIMENSION(U%NSIZE_NATURE) :: ZFIELD,ZFIELD_OLD, ZFRAC_NAT
INTEGER, DIMENSION(SIZE(U%XNATURE)) :: IMASK ! mask for packing from complete field to nature field
INTEGER :: INI, IPATCH, IFULL, ILEV
-INTEGER :: JLEV, JPATCH, JJ ! loop counter
+INTEGER :: JLEV, JP, JJ ! loop counter
REAL :: ZRATIO_TOT, ZWORK1,ZWORK2
!
+REAL, DIMENSION(:), ALLOCATABLE :: ZFIELD_TOT, ZFIELD_OLD_TOT, ZFRAC_NAT_TOT
+INTEGER :: INFOMPI
+!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('CONSERV_GLOBAL_MASS',0,ZHOOK_HANDLE)
!
-INI = SIZE(PFIELD,1)
-ILEV = SIZE(PFIELD,2)
-IPATCH = SIZE(PFIELD,3)
+IF (TRIM(HNAME)=="WG") THEN
+ DO JP = 1,KPATCH
+ ZFIELD0(:,:,JP) = NPE%AL(JP)%XWG(:,:)
+ ENDDO
+ELSEIF (TRIM(HNAME)=="WGI") THEN
+ DO JP = 1,KPATCH
+ ZFIELD0(:,:,JP) = NPE%AL(JP)%XWGI(:,:)
+ ENDDO
+ENDIF
+!
+INI = SIZE(PZDG,1)
+ILEV = SIZE(PZDG,2)
IFULL = SIZE(U%XNATURE )
!
ZFRAC_NAT = 1.
- CALL GET_SURF_MASK_n(DTCO, U, &
- 'NATURE',IFULL,IMASK,U%NSIZE_FULL,ILUOUT)
+ CALL GET_SURF_MASK_n(DTCO, U, 'NATURE',IFULL,IMASK,U%NSIZE_FULL,ILUOUT)
CALL PACK_SAME_RANK(IMASK,U%XNATURE,ZFRAC_NAT)
-ZFRAC_NAT(:)=ZFRAC_NAT(:)*IG%XMESH_SIZE(:)
+ZFRAC_NAT(:)=ZFRAC_NAT(:)*PMESH_SIZE(:)
!
ZFIELD(:) =0.0
ZFIELD_OLD(:)=0.0
-DO JPATCH=1,IPATCH
+DO JP=1,KPATCH
+ PK => NP%AL(JP)
DO JLEV=1,ILEV
- DO JJ=1,INI
- ZFIELD(JJ) = ZFIELD(JJ) + PFIELD(JJ,JLEV,JPATCH)*PZDG(JJ,JLEV,JPATCH)*I%XPATCH(JJ,JPATCH)
- ZFIELD_OLD(JJ)= ZFIELD_OLD(JJ) + PFIELD_OLD(JJ,JLEV,JPATCH)*PZDG_OLD(JJ,JLEV,JPATCH)*I%XPATCH_OLD(JJ,JPATCH)
+ DO JJ=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JJ)
+ !
+ ZFIELD(IMASK) = ZFIELD(IMASK) + ZFIELD0(JJ,JLEV,JP)*PZDG(JJ,JLEV,JP)*PK%XPATCH(JJ)
+ ZFIELD_OLD(IMASK)= ZFIELD_OLD(IMASK) + PFIELD_OLD(JJ,JLEV,JP)*PZDG_OLD(JJ,JLEV,JP)*PK%XPATCH_OLD(JJ)
+ !
ENDDO
ENDDO
ENDDO
@@ -106,16 +133,50 @@ ZWORK1=0.0
ZWORK2=0.0
ZRATIO_TOT = 1.0
!
-DO JJ=1,INI
- ZWORK1=ZWORK1+ZFIELD (JJ)*ZFRAC_NAT(JJ)
- ZWORK2=ZWORK2+ZFIELD_OLD(JJ)*ZFRAC_NAT(JJ)
-ENDDO
+IF (NPROC==1) THEN
+ DO JJ=1,INI
+ ZWORK1=ZWORK1+ZFIELD (JJ)*ZFRAC_NAT(JJ)
+ ZWORK2=ZWORK2+ZFIELD_OLD(JJ)*ZFRAC_NAT(JJ)
+ ENDDO
+ELSE
+ IF (NRANK==NPIO) THEN
+ ALLOCATE(ZFIELD_TOT(U%NDIM_FULL),ZFIELD_OLD_TOT(U%NDIM_FULL),ZFRAC_NAT_TOT(U%NDIM_FULL))
+ ELSE
+ ALLOCATE(ZFIELD_TOT(0),ZFIELD_OLD_TOT(0),ZFRAC_NAT_TOT(0))
+ ENDIF
+ CALL GATHER_AND_WRITE_MPI(ZFIELD,ZFIELD_TOT,U%NR_NATURE)
+ CALL GATHER_AND_WRITE_MPI(ZFIELD_OLD,ZFIELD_OLD_TOT,U%NR_NATURE)
+ CALL GATHER_AND_WRITE_MPI(ZFRAC_NAT,ZFRAC_NAT_TOT,U%NR_NATURE)
+ IF (NRANK==NPIO) THEN
+ DO JJ=1,U%NDIM_FULL
+ IF (ZFIELD_TOT(JJ)/=XUNDEF) THEN
+ ZWORK1=ZWORK1+ZFIELD_TOT (JJ)*ZFRAC_NAT_TOT(JJ)
+ ZWORK2=ZWORK2+ZFIELD_OLD_TOT(JJ)*ZFRAC_NAT_TOT(JJ)
+ ENDIF
+ ENDDO
+ ENDIF
+#ifdef SFX_MPI
+ CALL MPI_BCAST(ZWORK1,KIND(ZWORK1)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(ZWORK2,KIND(ZWORK2)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+#endif
+ DEALLOCATE(ZFIELD_TOT,ZFIELD_OLD_TOT,ZFRAC_NAT_TOT)
+ENDIF
!
IF(ZWORK2/= 0.)THEN
ZRATIO_TOT = ZWORK1/ZWORK2
ENDIF
!
-WHERE(PFIELD(:,:,:)/=XUNDEF) PFIELD(:,:,:)= PFIELD(:,:,:) * ZRATIO_TOT
+WHERE(ZFIELD0(:,:,:)/=XUNDEF) ZFIELD0(:,:,:)= ZFIELD0(:,:,:) * ZRATIO_TOT
+!
+IF (TRIM(HNAME)=="WG") THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%XWG(:,:) = ZFIELD0(:,:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=="WGI") THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%XWGI(:,:) = ZFIELD0(:,:,JP)
+ ENDDO
+ENDIF
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/consphy.h b/src/SURFEX/consphy.h
deleted file mode 100644
index c3683ff31033dd9cfe5d7b9247072b71e50bb27d..0000000000000000000000000000000000000000
--- a/src/SURFEX/consphy.h
+++ /dev/null
@@ -1,4 +0,0 @@
-
-!RJ: inlined
- ERROR aa
-#error should not be used
diff --git a/src/SURFEX/convert_cover_ch_isba.F90 b/src/SURFEX/convert_cover_ch_isba.F90
index 03a3e32a44e0b0bfc9785cd0c4f261eaa8c4c071..6820a5d7fd0dd2fef0cbd4b363508f9c2e59a8af 100644
--- a/src/SURFEX/convert_cover_ch_isba.F90
+++ b/src/SURFEX/convert_cover_ch_isba.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE CONVERT_COVER_CH_ISBA (DTCO, &
- PCOVER,OCOVER,PSOILRC_SO2,PSOILRC_O3)
+ SUBROUTINE CONVERT_COVER_CH_ISBA (DTCO, PCOVER, OCOVER, KNPATCH, KPATCH, PK, &
+ PSOILRC_SO2, PSOILRC_O3)
! ##############################################################
!
!!**** *CONVERT_COVER* convert surface cover classes into secondary
@@ -45,12 +45,13 @@
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
!
+USE MODD_ISBA_n, ONLY : ISBA_P_t
+!
USE MODD_DATA_COVER, ONLY : XDATA_SOILRC_SO2, XDATA_SOILRC_O3
!
USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, JPCOVER
!
-USE MODI_AV_PGD
-!
+USE MODI_AV_PGD_1P
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -63,11 +64,16 @@ IMPLICIT NONE
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
!
+INTEGER, INTENT(IN) :: KNPATCH
+INTEGER, INTENT(IN) :: KPATCH
+!
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+!
REAL, DIMENSION(:,:), INTENT(IN) :: PCOVER
LOGICAL, DIMENSION(:), INTENT(IN) :: OCOVER
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSOILRC_SO2
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSOILRC_O3
+REAL, DIMENSION(:), INTENT(OUT) :: PSOILRC_SO2
+REAL, DIMENSION(:), INTENT(OUT) :: PSOILRC_O3
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
@@ -80,10 +86,10 @@ IF (LHOOK) CALL DR_HOOK('CONVERT_COVER_CH_ISBA',0,ZHOOK_HANDLE)
!
IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
!
- CALL AV_PGD(DTCO, &
- PSOILRC_SO2 ,PCOVER ,XDATA_SOILRC_SO2(:,:) ,'NAT','ARI',OCOVER,KDECADE=1)
- CALL AV_PGD(DTCO, &
- PSOILRC_O3 ,PCOVER ,XDATA_SOILRC_O3 (:,:) ,'NAT','ARI',OCOVER,KDECADE=1)
+ CALL AV_PGD_1P(DTCO, PSOILRC_SO2 ,PCOVER, XDATA_SOILRC_SO2(:,:), 'NAT', 'ARI', OCOVER,&
+ PK%NR_P, KNPATCH, KPATCH, KDECADE=1)
+ CALL AV_PGD_1P(DTCO, PSOILRC_O3, PCOVER ,XDATA_SOILRC_O3 (:,:), 'NAT', 'ARI', OCOVER,&
+ PK%NR_P, KNPATCH, KPATCH, KDECADE=1)
!
IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
!
diff --git a/src/SURFEX/convert_cover_isba.F90 b/src/SURFEX/convert_cover_isba.F90
index 314546faf977c2f27808ac581be7e6f44c1c9fcc..b6e9dd6f3a3e969565ec95794413cf8ee64fa3bd 100644
--- a/src/SURFEX/convert_cover_isba.F90
+++ b/src/SURFEX/convert_cover_isba.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE CONVERT_COVER_ISBA (DTCO, I, &
- HISBA,KDECADE,PCOVER,OCOVER,HPHOTO, &
+ SUBROUTINE CONVERT_COVER_ISBA (DTCO, HALBEDO, &
+ HISBA,OTR_ML,KDECADE,PCOVER,OCOVER,HPHOTO, &
HSFTYPE,PVEG, &
PLAI,PRSMIN,PGAMMA,PWRMAX_CF, &
PRGL,PCV,PSOILGRID,PPERM, &
@@ -17,10 +17,9 @@
PDMAX, PF2I, OSTRESS, PH_TREE,PRE25,&
PCE_NITRO, PCF_NITRO, PCNA_NITRO, &
TPSEED, TPREAP, PWATSUP, PIRRIG, &
- PGNDLITTER, PLAIGV, PRSMINGV, &
- PGAMMAGV, &
- PWRMAX_CFGV, PRGLGV, PROOTFRACGV, &
- PZ0LITTER, PH_VEG )
+ PGNDLITTER, PZ0LITTER, PH_VEG, &
+ OWATER_TO_NATURE, OTOWN_TO_ROCK, &
+ OGARDEN )
! ##############################################################
!
!!**** *CONVERT_COVER* convert surface cover classes into secondary
@@ -61,9 +60,7 @@
!* 0. DECLARATION
! -----------
!
-!
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t, DATA_COVER_INIT
!
USE MODD_DATA_COVER, ONLY : XDATA_LAI, XDATA_H_TREE, &
XDATA_VEG, XDATA_Z0, XDATA_Z0_O_Z0H, &
@@ -85,19 +82,144 @@ USE MODD_DATA_COVER, ONLY : XDATA_LAI, XDATA_H_TREE, &
TDATA_SEED, TDATA_REAP,XDATA_IRRIG, &
XDATA_ROOT_DEPTH, XDATA_GROUND_DEPTH, &
XDATA_ROOT_EXTINCTION, XDATA_ROOT_LIN, &
- XDATA_GNDLITTER, &
- XDATA_RGLGV, XDATA_GAMMAGV, &
- XDATA_RSMINGV, XDATA_WRMAX_CFGV, &
- XDATA_LAIGV, XDATA_Z0LITTER, &
- XDATA_ROOT_DEPTHGV, XDATA_H_VEG, &
- XDATA_ROOT_EXTINCTIONGV
+ XDATA_GNDLITTER, XDATA_Z0LITTER, &
+ XDATA_H_VEG, XDATA_LAI_ALL_YEARS, XDATA_VEGTYPE
+!
+
-USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, JPCOVER, NVT_NO, NVT_ROCK, NVT_SNOW
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, JPCOVER, NVT_NO, NVT_ROCK, NVT_SNOW, &
+ NVT_TEBD, NVT_BONE, NVT_TRBE, NVT_C3, &
+ NVT_C4, NVT_IRR, NVT_GRAS, NVT_TROG, &
+ NVT_PARK, NVT_TRBD, NVT_TEBE, NVT_TENE, &
+ NVT_BOBD, NVT_BOND, NVT_BOGR, NVT_SHRB, &
+ NVT_C3W, NVT_C3S, NVT_FLTR, NVT_FLGR
USE MODD_TYPE_DATE_SURF
!
-!
USE MODI_AV_PGD
-!
+USE MODI_DEFAULT_DATA_COVER
+USE MODI_INI_DATA_PARAM
+!
+USE MODI_DEFAULT_LAI_ECO2_Y2002_01
+USE MODI_DEFAULT_LAI_ECO2_Y2002_02
+USE MODI_DEFAULT_LAI_ECO2_Y2002_03
+USE MODI_DEFAULT_LAI_ECO2_Y2002_04
+USE MODI_DEFAULT_LAI_ECO2_Y2002_05
+USE MODI_DEFAULT_LAI_ECO2_Y2002_06
+USE MODI_DEFAULT_LAI_ECO2_Y2002_07
+USE MODI_DEFAULT_LAI_ECO2_Y2002_08
+USE MODI_DEFAULT_LAI_ECO2_Y2002_09
+USE MODI_DEFAULT_LAI_ECO2_Y2002_10
+USE MODI_DEFAULT_LAI_ECO2_Y2002_11
+USE MODI_DEFAULT_LAI_ECO2_Y2002_12
+USE MODI_DEFAULT_LAI_ECO2_Y2002_13
+USE MODI_DEFAULT_LAI_ECO2_Y2002_14
+USE MODI_DEFAULT_LAI_ECO2_Y2002_15
+USE MODI_DEFAULT_LAI_ECO2_Y2002_16
+USE MODI_DEFAULT_LAI_ECO2_Y2002_17
+USE MODI_DEFAULT_LAI_ECO2_Y2002_18
+USE MODI_DEFAULT_LAI_ECO2_Y2002_19
+!
+USE MODI_DEFAULT_LAI_ECO2_Y2003_01
+USE MODI_DEFAULT_LAI_ECO2_Y2003_02
+USE MODI_DEFAULT_LAI_ECO2_Y2003_03
+USE MODI_DEFAULT_LAI_ECO2_Y2003_04
+USE MODI_DEFAULT_LAI_ECO2_Y2003_05
+USE MODI_DEFAULT_LAI_ECO2_Y2003_06
+USE MODI_DEFAULT_LAI_ECO2_Y2003_07
+USE MODI_DEFAULT_LAI_ECO2_Y2003_08
+USE MODI_DEFAULT_LAI_ECO2_Y2003_09
+USE MODI_DEFAULT_LAI_ECO2_Y2003_10
+USE MODI_DEFAULT_LAI_ECO2_Y2003_11
+USE MODI_DEFAULT_LAI_ECO2_Y2003_12
+USE MODI_DEFAULT_LAI_ECO2_Y2003_13
+USE MODI_DEFAULT_LAI_ECO2_Y2003_14
+USE MODI_DEFAULT_LAI_ECO2_Y2003_15
+USE MODI_DEFAULT_LAI_ECO2_Y2003_16
+USE MODI_DEFAULT_LAI_ECO2_Y2003_17
+USE MODI_DEFAULT_LAI_ECO2_Y2003_18
+USE MODI_DEFAULT_LAI_ECO2_Y2003_19
+!
+USE MODI_DEFAULT_LAI_ECO2_Y2004_01
+USE MODI_DEFAULT_LAI_ECO2_Y2004_02
+USE MODI_DEFAULT_LAI_ECO2_Y2004_03
+USE MODI_DEFAULT_LAI_ECO2_Y2004_04
+USE MODI_DEFAULT_LAI_ECO2_Y2004_05
+USE MODI_DEFAULT_LAI_ECO2_Y2004_06
+USE MODI_DEFAULT_LAI_ECO2_Y2004_07
+USE MODI_DEFAULT_LAI_ECO2_Y2004_08
+USE MODI_DEFAULT_LAI_ECO2_Y2004_09
+USE MODI_DEFAULT_LAI_ECO2_Y2004_10
+USE MODI_DEFAULT_LAI_ECO2_Y2004_11
+USE MODI_DEFAULT_LAI_ECO2_Y2004_12
+USE MODI_DEFAULT_LAI_ECO2_Y2004_13
+USE MODI_DEFAULT_LAI_ECO2_Y2004_14
+USE MODI_DEFAULT_LAI_ECO2_Y2004_15
+USE MODI_DEFAULT_LAI_ECO2_Y2004_16
+USE MODI_DEFAULT_LAI_ECO2_Y2004_17
+USE MODI_DEFAULT_LAI_ECO2_Y2004_18
+USE MODI_DEFAULT_LAI_ECO2_Y2004_19
+!
+USE MODI_DEFAULT_LAI_ECO2_Y2005_01
+USE MODI_DEFAULT_LAI_ECO2_Y2005_02
+USE MODI_DEFAULT_LAI_ECO2_Y2005_03
+USE MODI_DEFAULT_LAI_ECO2_Y2005_04
+USE MODI_DEFAULT_LAI_ECO2_Y2005_05
+USE MODI_DEFAULT_LAI_ECO2_Y2005_06
+USE MODI_DEFAULT_LAI_ECO2_Y2005_07
+USE MODI_DEFAULT_LAI_ECO2_Y2005_08
+USE MODI_DEFAULT_LAI_ECO2_Y2005_09
+USE MODI_DEFAULT_LAI_ECO2_Y2005_10
+USE MODI_DEFAULT_LAI_ECO2_Y2005_11
+USE MODI_DEFAULT_LAI_ECO2_Y2005_12
+USE MODI_DEFAULT_LAI_ECO2_Y2005_13
+USE MODI_DEFAULT_LAI_ECO2_Y2005_14
+USE MODI_DEFAULT_LAI_ECO2_Y2005_15
+USE MODI_DEFAULT_LAI_ECO2_Y2005_16
+USE MODI_DEFAULT_LAI_ECO2_Y2005_17
+USE MODI_DEFAULT_LAI_ECO2_Y2005_18
+USE MODI_DEFAULT_LAI_ECO2_Y2005_19
+!
+USE MODI_DEFAULT_LAI_ECO2_Y2006_01
+USE MODI_DEFAULT_LAI_ECO2_Y2006_02
+USE MODI_DEFAULT_LAI_ECO2_Y2006_03
+USE MODI_DEFAULT_LAI_ECO2_Y2006_04
+USE MODI_DEFAULT_LAI_ECO2_Y2006_05
+USE MODI_DEFAULT_LAI_ECO2_Y2006_06
+USE MODI_DEFAULT_LAI_ECO2_Y2006_07
+USE MODI_DEFAULT_LAI_ECO2_Y2006_08
+USE MODI_DEFAULT_LAI_ECO2_Y2006_09
+USE MODI_DEFAULT_LAI_ECO2_Y2006_10
+USE MODI_DEFAULT_LAI_ECO2_Y2006_11
+USE MODI_DEFAULT_LAI_ECO2_Y2006_12
+USE MODI_DEFAULT_LAI_ECO2_Y2006_13
+USE MODI_DEFAULT_LAI_ECO2_Y2006_14
+USE MODI_DEFAULT_LAI_ECO2_Y2006_15
+USE MODI_DEFAULT_LAI_ECO2_Y2006_16
+USE MODI_DEFAULT_LAI_ECO2_Y2006_17
+USE MODI_DEFAULT_LAI_ECO2_Y2006_18
+USE MODI_DEFAULT_LAI_ECO2_Y2006_19
+!
+USE MODI_DEFAULT_LAI_ECO1_01
+USE MODI_DEFAULT_LAI_ECO1_02
+USE MODI_DEFAULT_LAI_ECO1_03
+USE MODI_DEFAULT_LAI_ECO1_04
+USE MODI_DEFAULT_LAI_ECO1_05
+USE MODI_DEFAULT_LAI_ECO1_06
+USE MODI_DEFAULT_LAI_ECO1_07
+USE MODI_DEFAULT_LAI_ECO1_08
+USE MODI_DEFAULT_LAI_ECO1_09
+USE MODI_DEFAULT_LAI_ECO1_10
+USE MODI_DEFAULT_LAI_ECO1_11
+USE MODI_DEFAULT_LAI_ECO1_12
+USE MODI_DEFAULT_LAI_ECO1_13
+USE MODI_DEFAULT_LAI_ECO1_14
+USE MODI_DEFAULT_LAI_ECO1_15
+USE MODI_DEFAULT_LAI_ECO1_16
+USE MODI_DEFAULT_LAI_ECO1_17
+USE MODI_DEFAULT_LAI_ECO1_18
+USE MODI_DEFAULT_LAI_ECO1_19
+!
+USE MODI_ECOCLIMAP2_LAI
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -109,9 +231,10 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(ISBA_t), INTENT(INOUT) :: I
!
+ CHARACTER(LEN=*), INTENT(IN) :: HALBEDO
CHARACTER(LEN=*), INTENT(IN) :: HISBA ! type of soil (Force-Restore OR Diffusion)
+ LOGICAL, INTENT(IN) :: OTR_ML
INTEGER, INTENT(IN) :: KDECADE
REAL, DIMENSION(:,:), INTENT(IN) :: PCOVER
LOGICAL, DIMENSION(:), INTENT(IN) :: OCOVER
@@ -141,12 +264,6 @@ REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PALBUV_VEG
REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PEMIS_ECO
!
REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PGNDLITTER
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PLAIGV
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PRSMINGV
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PGAMMAGV
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PWRMAX_CFGV
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PRGLGV
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PROOTFRACGV
REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PZ0LITTER
REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PH_VEG
!
@@ -174,16 +291,29 @@ TYPE(DATE_TIME), DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: TPREAP
REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PWATSUP
REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PIRRIG
!
+LOGICAL, OPTIONAL, INTENT(IN) :: OWATER_TO_NATURE
+LOGICAL, OPTIONAL, INTENT(IN) :: OTOWN_TO_ROCK
+LOGICAL, OPTIONAL, INTENT(IN) :: OGARDEN
+!
!* 0.2 Declaration of local variables
! ------------------------------
! calculation of veg from lai in the pixel
!
+TYPE(DATA_COVER_t) :: YDTCO
+!
REAL, DIMENSION (:,:), ALLOCATABLE :: ZWORK ! work array
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDATA_VEG, ZDATA_LAI, ZDATA_LAI_ALL_YEARS
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDATA_VEGTYPE
+!
+REAL, DIMENSION (SIZE(OCOVER),NVEGTYPE) :: ZDATA_GROUND_DEPTH, ZDATA_ROOT_DEPTH, &
+ ZDATA_ROOT_LIN, ZDATA_ROOT_EXTINCTION
+REAL, DIMENSION (SIZE(OCOVER),3,NVEGTYPE) :: ZDATA_DG
!
CHARACTER(LEN=3) :: YTREE, YNAT, YLAI, YVEG, YDIF
!
+LOGICAL :: GWATER_TO_NATURE, GTOWN_TO_ROCK, GGARDEN
INTEGER :: JLAYER ! loop counter on surface layers
-INTEGER :: JVEG ! loop counter on vegetation types
+INTEGER :: JVEG, JP ! loop counter on vegetation types
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
@@ -193,6 +323,12 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('CONVERT_COVER_ISBA',0,ZHOOK_HANDLE)
!
+GWATER_TO_NATURE = .FALSE.
+GTOWN_TO_ROCK = .FALSE.
+IF (PRESENT(OWATER_TO_NATURE)) GWATER_TO_NATURE = OWATER_TO_NATURE
+IF (PRESENT(OTOWN_TO_ROCK)) GTOWN_TO_ROCK = OTOWN_TO_ROCK
+IF (PRESENT(OGARDEN)) GGARDEN = OGARDEN
+!
IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
!
IF (HSFTYPE=='NAT') THEN
@@ -201,13 +337,223 @@ IF (HSFTYPE=='NAT') THEN
YLAI='LAI'
YVEG='VEG'
YDIF='DVG'
-ELSEIF (HSFTYPE=='GRD') THEN
+ELSEIF (HSFTYPE=='GRD'.OR.HSFTYPE=='GD'.OR.HSFTYPE=='GR') THEN
YNAT='GRD'
YTREE='GRT'
YLAI='GRL'
YVEG='GRV'
YDIF='GDV'
ENDIF
+!
+ CALL DATA_COVER_INIT(YDTCO)
+ALLOCATE(YDTCO%XDATA_VEGTYPE(SIZE(OCOVER),NVEGTYPE))
+ALLOCATE(YDTCO%XDATA_NATURE(SIZE(OCOVER)))
+ALLOCATE(YDTCO%XDATA_GARDEN(SIZE(OCOVER)))
+ALLOCATE(YDTCO%XDATA_TOWN (SIZE(OCOVER)))
+!
+! if we run with ECOSG, and the init file was done with ECOCLIMAP
+IF (SIZE(OCOVER)/=SIZE(XDATA_GROUND_DEPTH,1)) THEN
+
+ ALLOCATE(YDTCO%XDATA_WATER (SIZE(OCOVER)))
+ CALL DEFAULT_DATA_COVER(PDATA_VEGTYPE=YDTCO%XDATA_VEGTYPE, &
+ PDATA_NATURE=YDTCO%XDATA_NATURE,PDATA_WATER=YDTCO%XDATA_WATER,&
+ PDATA_TOWN=YDTCO%XDATA_TOWN,PDATA_GARDEN=YDTCO%XDATA_GARDEN,&
+ PDATA_GROUND_DEPTH=ZDATA_GROUND_DEPTH,&
+ PDATA_ROOT_DEPTH=ZDATA_ROOT_DEPTH)
+
+ IF (GWATER_TO_NATURE) THEN
+ WHERE(YDTCO%XDATA_WATER(:)<1.) YDTCO%XDATA_NATURE(:) = YDTCO%XDATA_NATURE(:) + YDTCO%XDATA_WATER(:)
+ ENDIF
+
+ ! save current values for these arrays
+ ALLOCATE(ZDATA_LAI_ALL_YEARS(SIZE(XDATA_LAI_ALL_YEARS,1),SIZE(XDATA_LAI_ALL_YEARS,2),SIZE(XDATA_LAI_ALL_YEARS,3)))
+ ALLOCATE(ZDATA_VEGTYPE(SIZE(XDATA_VEGTYPE,1),SIZE(XDATA_VEGTYPE,2)))
+ ALLOCATE(ZDATA_VEG(SIZE(XDATA_VEG,1),SIZE(XDATA_VEG,2),SIZE(XDATA_VEG,3)))
+ ALLOCATE(ZDATA_LAI(SIZE(XDATA_LAI,1),SIZE(XDATA_LAI,2),SIZE(XDATA_LAI,3)))
+ ZDATA_LAI_ALL_YEARS(:,:,:) = XDATA_LAI_ALL_YEARS(:,:,:)
+ ZDATA_VEGTYPE(:,:) = XDATA_VEGTYPE(:,:)
+ ZDATA_VEG(:,:,:) = XDATA_VEG(:,:,:)
+ ZDATA_LAI(:,:,:) = XDATA_LAI(:,:,:)
+
+ DEALLOCATE(XDATA_VEG,XDATA_LAI,XDATA_LAI_ALL_YEARS,XDATA_VEGTYPE)
+
+ ! re-allocate official arrays
+ ALLOCATE(XDATA_VEGTYPE(SIZE(YDTCO%XDATA_VEGTYPE,1),SIZE(YDTCO%XDATA_VEGTYPE,2)))
+ ALLOCATE(XDATA_VEG(SIZE(OCOVER),36,NVEGTYPE))
+ ALLOCATE(XDATA_LAI(SIZE(OCOVER),36,NVEGTYPE))
+ ALLOCATE(XDATA_LAI_ALL_YEARS(SIZE(OCOVER),36*5,NVEGTYPE))
+ ! xdata_vegtype is used by DEFAULT_LAI....
+ XDATA_VEGTYPE(:,:) = YDTCO%XDATA_VEGTYPE
+!
+ CALL DEFAULT_LAI_ECO1_01
+ CALL DEFAULT_LAI_ECO1_02
+ CALL DEFAULT_LAI_ECO1_03
+ CALL DEFAULT_LAI_ECO1_04
+ CALL DEFAULT_LAI_ECO1_05
+ CALL DEFAULT_LAI_ECO1_06
+ CALL DEFAULT_LAI_ECO1_07
+ CALL DEFAULT_LAI_ECO1_08
+ CALL DEFAULT_LAI_ECO1_09
+ CALL DEFAULT_LAI_ECO1_10
+ CALL DEFAULT_LAI_ECO1_11
+ CALL DEFAULT_LAI_ECO1_12
+ CALL DEFAULT_LAI_ECO1_13
+ CALL DEFAULT_LAI_ECO1_14
+ CALL DEFAULT_LAI_ECO1_15
+ CALL DEFAULT_LAI_ECO1_16
+ CALL DEFAULT_LAI_ECO1_17
+ CALL DEFAULT_LAI_ECO1_18
+ CALL DEFAULT_LAI_ECO1_19
+
+ CALL DEFAULT_LAI_ECO2_Y2002_01
+ CALL DEFAULT_LAI_ECO2_Y2002_02
+ CALL DEFAULT_LAI_ECO2_Y2002_03
+ CALL DEFAULT_LAI_ECO2_Y2002_04
+ CALL DEFAULT_LAI_ECO2_Y2002_05
+ CALL DEFAULT_LAI_ECO2_Y2002_06
+ CALL DEFAULT_LAI_ECO2_Y2002_07
+ CALL DEFAULT_LAI_ECO2_Y2002_08
+ CALL DEFAULT_LAI_ECO2_Y2002_09
+ CALL DEFAULT_LAI_ECO2_Y2002_10
+ CALL DEFAULT_LAI_ECO2_Y2002_11
+ CALL DEFAULT_LAI_ECO2_Y2002_12
+ CALL DEFAULT_LAI_ECO2_Y2002_13
+ CALL DEFAULT_LAI_ECO2_Y2002_14
+ CALL DEFAULT_LAI_ECO2_Y2002_15
+ CALL DEFAULT_LAI_ECO2_Y2002_16
+ CALL DEFAULT_LAI_ECO2_Y2002_17
+ CALL DEFAULT_LAI_ECO2_Y2002_18
+ CALL DEFAULT_LAI_ECO2_Y2002_19
+!
+ CALL DEFAULT_LAI_ECO2_Y2003_01
+ CALL DEFAULT_LAI_ECO2_Y2003_02
+ CALL DEFAULT_LAI_ECO2_Y2003_03
+ CALL DEFAULT_LAI_ECO2_Y2003_04
+ CALL DEFAULT_LAI_ECO2_Y2003_05
+ CALL DEFAULT_LAI_ECO2_Y2003_06
+ CALL DEFAULT_LAI_ECO2_Y2003_07
+ CALL DEFAULT_LAI_ECO2_Y2003_08
+ CALL DEFAULT_LAI_ECO2_Y2003_09
+ CALL DEFAULT_LAI_ECO2_Y2003_10
+ CALL DEFAULT_LAI_ECO2_Y2003_11
+ CALL DEFAULT_LAI_ECO2_Y2003_12
+ CALL DEFAULT_LAI_ECO2_Y2003_13
+ CALL DEFAULT_LAI_ECO2_Y2003_14
+ CALL DEFAULT_LAI_ECO2_Y2003_15
+ CALL DEFAULT_LAI_ECO2_Y2003_16
+ CALL DEFAULT_LAI_ECO2_Y2003_17
+ CALL DEFAULT_LAI_ECO2_Y2003_18
+ CALL DEFAULT_LAI_ECO2_Y2003_19
+!
+ CALL DEFAULT_LAI_ECO2_Y2004_01
+ CALL DEFAULT_LAI_ECO2_Y2004_02
+ CALL DEFAULT_LAI_ECO2_Y2004_03
+ CALL DEFAULT_LAI_ECO2_Y2004_04
+ CALL DEFAULT_LAI_ECO2_Y2004_05
+ CALL DEFAULT_LAI_ECO2_Y2004_06
+ CALL DEFAULT_LAI_ECO2_Y2004_07
+ CALL DEFAULT_LAI_ECO2_Y2004_08
+ CALL DEFAULT_LAI_ECO2_Y2004_09
+ CALL DEFAULT_LAI_ECO2_Y2004_10
+ CALL DEFAULT_LAI_ECO2_Y2004_11
+ CALL DEFAULT_LAI_ECO2_Y2004_12
+ CALL DEFAULT_LAI_ECO2_Y2004_13
+ CALL DEFAULT_LAI_ECO2_Y2004_14
+ CALL DEFAULT_LAI_ECO2_Y2004_15
+ CALL DEFAULT_LAI_ECO2_Y2004_16
+ CALL DEFAULT_LAI_ECO2_Y2004_17
+ CALL DEFAULT_LAI_ECO2_Y2004_18
+ CALL DEFAULT_LAI_ECO2_Y2004_19
+!
+ CALL DEFAULT_LAI_ECO2_Y2005_01
+ CALL DEFAULT_LAI_ECO2_Y2005_02
+ CALL DEFAULT_LAI_ECO2_Y2005_03
+ CALL DEFAULT_LAI_ECO2_Y2005_04
+ CALL DEFAULT_LAI_ECO2_Y2005_05
+ CALL DEFAULT_LAI_ECO2_Y2005_06
+ CALL DEFAULT_LAI_ECO2_Y2005_07
+ CALL DEFAULT_LAI_ECO2_Y2005_08
+ CALL DEFAULT_LAI_ECO2_Y2005_09
+ CALL DEFAULT_LAI_ECO2_Y2005_10
+ CALL DEFAULT_LAI_ECO2_Y2005_11
+ CALL DEFAULT_LAI_ECO2_Y2005_12
+ CALL DEFAULT_LAI_ECO2_Y2005_13
+ CALL DEFAULT_LAI_ECO2_Y2005_14
+ CALL DEFAULT_LAI_ECO2_Y2005_15
+ CALL DEFAULT_LAI_ECO2_Y2005_16
+ CALL DEFAULT_LAI_ECO2_Y2005_17
+ CALL DEFAULT_LAI_ECO2_Y2005_18
+ CALL DEFAULT_LAI_ECO2_Y2005_19
+!
+ CALL DEFAULT_LAI_ECO2_Y2006_01
+ CALL DEFAULT_LAI_ECO2_Y2006_02
+ CALL DEFAULT_LAI_ECO2_Y2006_03
+ CALL DEFAULT_LAI_ECO2_Y2006_04
+ CALL DEFAULT_LAI_ECO2_Y2006_05
+ CALL DEFAULT_LAI_ECO2_Y2006_06
+ CALL DEFAULT_LAI_ECO2_Y2006_07
+ CALL DEFAULT_LAI_ECO2_Y2006_08
+ CALL DEFAULT_LAI_ECO2_Y2006_09
+ CALL DEFAULT_LAI_ECO2_Y2006_10
+ CALL DEFAULT_LAI_ECO2_Y2006_11
+ CALL DEFAULT_LAI_ECO2_Y2006_12
+ CALL DEFAULT_LAI_ECO2_Y2006_13
+ CALL DEFAULT_LAI_ECO2_Y2006_14
+ CALL DEFAULT_LAI_ECO2_Y2006_15
+ CALL DEFAULT_LAI_ECO2_Y2006_16
+ CALL DEFAULT_LAI_ECO2_Y2006_17
+ CALL DEFAULT_LAI_ECO2_Y2006_18
+ CALL DEFAULT_LAI_ECO2_Y2006_19
+
+ NVT_C3W = 0
+ NVT_C3S = 0
+ NVT_FLTR = 0
+ NVT_FLGR = 0
+ NVT_NO = 1 ! 1 ! no vegetation (smooth)
+ NVT_ROCK = 2 ! 2 ! no vegetation (rocks)
+ NVT_SNOW = 3 ! 3 ! permanent snow and ice
+ NVT_TEBD = 4 ! 4 ! temperate broadleaf cold-deciduous summergreen (TREE)
+ NVT_BONE = 5 ! 5 ! boreal needleleaf evergreen (CONI)
+ NVT_TRBE = 6 ! 6 ! tropical broadleaf evergreen (EVER)
+ NVT_C3 = 7 ! 7 ! C3 cultures types
+ NVT_C4 = 8 ! 8 ! C4 cultures types
+ NVT_IRR = 9 ! 9 ! irrigated crops
+ NVT_GRAS =10 !10 ! grassland
+ NVT_TROG =11 !11 ! tropical grassland
+ NVT_PARK =12 !12 ! peat bogs, parks and gardens (irrigated grass)
+ NVT_TRBD =13 ! 4 ! tropical broadleaf deciduous (TREE)
+ NVT_TEBE =14 ! 4 ! temperate broadleaf evergreen (TREE)
+ NVT_TENE =15 ! 5 ! temperate needleleaf evergreen (CONI)
+ NVT_BOBD =16 ! 4 ! boreal broadleaf cold-deciduous summergreen (TREE)
+ NVT_BOND =17 ! 5 ! boreal needleleaf cold-deciduous summergreen (CONI)
+ NVT_BOGR =18 !10 ! boreal grass (GRAS)
+ NVT_SHRB =19 ! 4 ! shrub (TREE)
+
+ ! calculate XDATA_LAI
+ CALL ECOCLIMAP2_LAI(DTCO%NYEAR)
+
+ ! no more needed
+ DEALLOCATE(XDATA_LAI_ALL_YEARS,XDATA_VEGTYPE)
+ ! we give back their values to data_lai_all_years dans data_vegtype
+ ALLOCATE(XDATA_LAI_ALL_YEARS(SIZE(ZDATA_LAI_ALL_YEARS,1),SIZE(ZDATA_LAI_ALL_YEARS,2),SIZE(ZDATA_LAI_ALL_YEARS,3)))
+ ALLOCATE(XDATA_VEGTYPE(SIZE(ZDATA_VEGTYPE,1),SIZE(ZDATA_VEGTYPE,2)))
+ XDATA_LAI_ALL_YEARS(:,:,:) = ZDATA_LAI_ALL_YEARS(:,:,:)
+ XDATA_VEGTYPE(:,:) = ZDATA_VEGTYPE(:,:)
+ DEALLOCATE(ZDATA_LAI_ALL_YEARS,ZDATA_VEGTYPE)
+ ! calculated XDATA_VEG
+ CALL INI_DATA_PARAM(PROOT_LIN=ZDATA_ROOT_LIN,PROOT_EXTINCTION=ZDATA_ROOT_EXTINCTION, &
+ PLAI=XDATA_LAI,PVEG_OUT=XDATA_VEG)
+
+ELSE
+ YDTCO%XDATA_VEGTYPE(:,:) = DTCO%XDATA_VEGTYPE(:,:)
+ YDTCO%XDATA_NATURE(:) = DTCO%XDATA_NATURE(:)
+ YDTCO%XDATA_TOWN(:) = DTCO%XDATA_TOWN(:)
+ YDTCO%XDATA_GARDEN(:) = DTCO%XDATA_GARDEN(:)
+ ZDATA_GROUND_DEPTH(:,:) = XDATA_GROUND_DEPTH(:,:)
+ ZDATA_ROOT_DEPTH (:,:) = XDATA_ROOT_DEPTH (:,:)
+ ZDATA_ROOT_LIN (:,:) = XDATA_ROOT_LIN (:,:)
+ ZDATA_ROOT_EXTINCTION(:,:) = XDATA_ROOT_EXTINCTION(:,:)
+ENDIF
!
!* 2.1 fields on natural surfaces only, taking into account patches/
! -------------------------------
@@ -217,106 +563,57 @@ ENDIF
! ---------------
!
IF (PRESENT(PLAI)) THEN
- CALL AV_PGD(DTCO, &
- PLAI ,PCOVER ,XDATA_LAI (:,KDECADE,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
-ENDIF
-!
-IF (PRESENT(PLAIGV)) THEN
- CALL AV_PGD(DTCO, &
- PLAIGV ,PCOVER ,XDATA_LAIGV (:,KDECADE,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD(YDTCO, PLAI ,PCOVER ,XDATA_LAI (:,KDECADE,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
ENDIF
!
-!
!* 1/Rsmin
!
IF (PRESENT(PRSMIN)) THEN
- IF (SIZE(PRSMIN)>0) &
- CALL AV_PGD(DTCO, &
- PRSMIN,PCOVER ,XDATA_RSMIN,YLAI,'INV',OCOVER,KDECADE=KDECADE)
-END IF
-!
-IF (PRESENT(PRSMINGV)) THEN
- IF (SIZE(PRSMINGV)>0) &
- CALL AV_PGD(DTCO, &
- PRSMINGV,PCOVER ,XDATA_RSMINGV,YLAI,'INV',OCOVER,KDECADE=KDECADE)
+ IF (SIZE(PRSMIN)>0) CALL AV_PGD(YDTCO, PRSMIN,PCOVER ,XDATA_RSMIN,YLAI,'INV',OCOVER,KDECADE=KDECADE)
END IF
!
-IF (PRESENT(PH_TREE)) &
- CALL AV_PGD(DTCO, &
- PH_TREE ,PCOVER ,XDATA_H_TREE (:,:) ,YTREE,'ARI',OCOVER)
+IF (PRESENT(PH_TREE)) CALL AV_PGD(YDTCO, PH_TREE ,PCOVER ,XDATA_H_TREE (:,:) ,YTREE,'ARI',OCOVER)
!
DO JVEG=1,NVEGTYPE
- IF (PRESENT(PVEGTYPE)) &
- CALL AV_PGD(DTCO, &
- PVEGTYPE(:,JVEG),PCOVER ,DTCO%XDATA_VEGTYPE(:,JVEG),YNAT,'ARI',OCOVER)
+ IF (PRESENT(PVEGTYPE)) CALL AV_PGD(YDTCO, PVEGTYPE(:,JVEG),PCOVER ,YDTCO%XDATA_VEGTYPE(:,JVEG),YNAT,'ARI',OCOVER)
END DO
!
!
! vegetation fraction
! -------------------
!
-IF (PRESENT(PVEG)) &
- CALL AV_PGD(DTCO, &
- PVEG ,PCOVER ,XDATA_VEG (:,KDECADE,:),YNAT,'ARI',OCOVER)
+IF (PRESENT(PVEG)) CALL AV_PGD(YDTCO, PVEG ,PCOVER ,XDATA_VEG (:,KDECADE,:),YNAT,'ARI',OCOVER)
!
!
-IF (PRESENT(PGNDLITTER)) &
- CALL AV_PGD(DTCO, &
- PGNDLITTER ,PCOVER ,XDATA_GNDLITTER (:,KDECADE,:),YNAT,'ARI',OCOVER)
+IF (PRESENT(PGNDLITTER)) CALL AV_PGD(YDTCO, PGNDLITTER ,PCOVER ,XDATA_GNDLITTER (:,KDECADE,:),YNAT,'ARI',OCOVER)
!
! roughness length
! ----------------
!
-IF (PRESENT(PZ0)) &
- CALL AV_PGD(DTCO, &
- PZ0 ,PCOVER ,XDATA_Z0 (:,KDECADE,:),YNAT,'CDN',OCOVER)
+IF (PRESENT(PZ0)) CALL AV_PGD(YDTCO, PZ0 ,PCOVER ,XDATA_Z0 (:,KDECADE,:),YNAT,'CDN',OCOVER)
!
-IF (PRESENT(PZ0_O_Z0H)) &
- CALL AV_PGD(DTCO, &
- PZ0_O_Z0H ,PCOVER ,XDATA_Z0_O_Z0H (:,:),YNAT,'ARI',OCOVER)
+IF (PRESENT(PZ0_O_Z0H)) CALL AV_PGD(YDTCO, PZ0_O_Z0H ,PCOVER ,XDATA_Z0_O_Z0H (:,:),YNAT,'ARI',OCOVER)
!
-IF (PRESENT(PZ0LITTER)) &
- CALL AV_PGD(DTCO, &
- PZ0LITTER ,PCOVER ,XDATA_Z0LITTER (:,KDECADE,:),YNAT,'CDN',OCOVER)
+IF (PRESENT(PZ0LITTER)) CALL AV_PGD(YDTCO, PZ0LITTER ,PCOVER ,XDATA_Z0LITTER (:,KDECADE,:),YNAT,'CDN',OCOVER)
!
!emis-eco
!--------
!
-IF (PRESENT(PEMIS_ECO)) &
- CALL AV_PGD(DTCO, &
- PEMIS_ECO ,PCOVER ,XDATA_EMIS_ECO (:,KDECADE,:),YNAT,'ARI',OCOVER)
+IF (PRESENT(PEMIS_ECO)) CALL AV_PGD(YDTCO, PEMIS_ECO ,PCOVER ,XDATA_EMIS_ECO (:,KDECADE,:),YNAT,'ARI',OCOVER)
!
!---------------------------------------------------------------------------------
!
!* other vegetation parameters
!
-IF (PRESENT(PGAMMA)) &
- CALL AV_PGD(DTCO, &
- PGAMMA ,PCOVER ,XDATA_GAMMA (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
-IF (PRESENT(PGAMMAGV)) &
- CALL AV_PGD(DTCO, &
- PGAMMAGV ,PCOVER ,XDATA_GAMMAGV (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
-IF (PRESENT(PWRMAX_CF)) &
- CALL AV_PGD(DTCO, &
- PWRMAX_CF ,PCOVER ,XDATA_WRMAX_CF(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
-IF (PRESENT(PWRMAX_CFGV)) &
- CALL AV_PGD(DTCO, &
- PWRMAX_CFGV ,PCOVER ,XDATA_WRMAX_CFGV(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
-!
-!
-IF (PRESENT(PRGL)) &
- CALL AV_PGD(DTCO, &
- PRGL ,PCOVER ,XDATA_RGL (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
-IF (PRESENT(PRGLGV)) &
- CALL AV_PGD(DTCO, &
- PRGLGV ,PCOVER ,XDATA_RGLGV (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
-IF (PRESENT(PCV)) &
- CALL AV_PGD(DTCO, &
- PCV ,PCOVER ,XDATA_CV (:,:),YVEG,'INV',OCOVER,KDECADE=KDECADE)
+IF (PRESENT(PGAMMA)) CALL AV_PGD(YDTCO, PGAMMA ,PCOVER ,XDATA_GAMMA (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+!
+IF (PRESENT(PWRMAX_CF)) CALL AV_PGD(YDTCO, PWRMAX_CF ,PCOVER ,XDATA_WRMAX_CF(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+!
+IF (PRESENT(PRGL)) CALL AV_PGD(YDTCO, PRGL ,PCOVER ,XDATA_RGL (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+IF (PRESENT(PCV)) CALL AV_PGD(YDTCO, PCV ,PCOVER ,XDATA_CV (:,:),YVEG,'INV',OCOVER,KDECADE=KDECADE)
!
IF (PRESENT(PH_VEG)) THEN
- CALL AV_PGD(DTCO, &
- PH_VEG,PCOVER,XDATA_H_VEG(:,KDECADE,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD(YDTCO, PH_VEG,PCOVER,XDATA_H_VEG(:,KDECADE,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
ENDIF
!
@@ -332,7 +629,7 @@ IF (PRESENT(PDG)) THEN
!
CALL SET_COVER_DG(SIZE(PDG,1),SIZE(PDG,2),SIZE(PDG,3),PRESENT(PPERM),&
PRESENT(PDG2),PRESENT(PDROOT),PRESENT(KWG_LAYER), &
- PRESENT(PROOTFRAC),PRESENT(PROOTFRACGV) )
+ PRESENT(PROOTFRAC) )
!
END IF
!
@@ -341,140 +638,101 @@ END IF
!* soil ice for runoff
! -------------------
!
-IF (PRESENT(PD_ICE)) &
- CALL AV_PGD(DTCO, &
- PD_ICE,PCOVER ,XDATA_DICE(:,:),YNAT,'ARI',OCOVER)
+IF (PRESENT(PD_ICE)) CALL AV_PGD(YDTCO, PD_ICE,PCOVER ,XDATA_DICE(:,:),YNAT,'ARI',OCOVER)
!
!---------------------------------------------------------------------------------
!
IF (PRESENT(PALBNIR_VEG)) THEN
- IF (I%CALBEDO=='CM13') THEN
- CALL AV_PGD(DTCO, &
- PALBVIS_VEG,PCOVER,XDATA_ALB_VEG_NIR(:,KDECADE,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ IF (HALBEDO=='CM13') THEN
+ CALL AV_PGD(YDTCO, PALBVIS_VEG,PCOVER,XDATA_ALB_VEG_NIR(:,KDECADE,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
ELSE
- CALL AV_PGD(DTCO, &
- PALBNIR_VEG,PCOVER ,XDATA_ALBNIR_VEG(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD(YDTCO, PALBNIR_VEG,PCOVER ,XDATA_ALBNIR_VEG(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
ENDIF
ENDIF
!
IF (PRESENT(PALBVIS_VEG)) THEN
- IF (I%CALBEDO=='CM13') THEN
- CALL AV_PGD(DTCO, &
- PALBVIS_VEG,PCOVER,XDATA_ALB_VEG_VIS(:,KDECADE,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ IF (HALBEDO=='CM13') THEN
+ CALL AV_PGD(YDTCO, PALBVIS_VEG,PCOVER,XDATA_ALB_VEG_VIS(:,KDECADE,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
ELSE
- CALL AV_PGD(DTCO, &
- PALBVIS_VEG,PCOVER ,XDATA_ALBVIS_VEG(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD(YDTCO, PALBVIS_VEG,PCOVER ,XDATA_ALBVIS_VEG(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
ENDIF
ENDIF
!
IF (PRESENT(PALBUV_VEG)) THEN
- IF ((I%CALBEDO=='CM13'.OR.I%LTR_ML).AND.PRESENT(PALBVIS_VEG)) THEN
+ IF ((HALBEDO=='CM13'.OR.OTR_ML).AND.PRESENT(PALBVIS_VEG)) THEN
PALBUV_VEG(:,:)=PALBVIS_VEG(:,:)
ELSE
- CALL AV_PGD(DTCO, &
- PALBUV_VEG, PCOVER ,XDATA_ALBUV_VEG (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD(YDTCO, PALBUV_VEG, PCOVER ,XDATA_ALBUV_VEG (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
ENDIF
ENDIF
!
! parameters for "stress option"
-IF (HPHOTO == 'AST' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT' .OR. HPHOTO == 'NCB') THEN
+IF (HPHOTO /='NON' ) THEN
IF (PRESENT(PGMES)) THEN
- IF (SIZE(PGMES)>0) &
- CALL AV_PGD(DTCO, &
- PGMES ,PCOVER ,XDATA_GMES_ST (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ IF (SIZE(PGMES)>0) CALL AV_PGD(YDTCO, PGMES ,PCOVER ,XDATA_GMES_ST (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
END IF
IF (PRESENT(PBSLAI)) THEN
- IF (SIZE(PBSLAI)>0) &
- CALL AV_PGD(DTCO, &
- PBSLAI ,PCOVER ,XDATA_BSLAI_ST (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ IF (SIZE(PBSLAI)>0) CALL AV_PGD(YDTCO, PBSLAI ,PCOVER ,XDATA_BSLAI_ST (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
END IF
IF (PRESENT(PSEFOLD)) THEN
- IF (SIZE(PSEFOLD)>0) &
- CALL AV_PGD(DTCO, &
- PSEFOLD,PCOVER ,XDATA_SEFOLD_ST(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ IF (SIZE(PSEFOLD)>0) CALL AV_PGD(YDTCO, PSEFOLD,PCOVER ,XDATA_SEFOLD_ST(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
END IF
IF (PRESENT(PGC)) THEN
- IF (SIZE(PGC)>0) &
- CALL AV_PGD(DTCO, &
- PGC ,PCOVER ,XDATA_GC_ST (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ IF (SIZE(PGC)>0) CALL AV_PGD(YDTCO, PGC ,PCOVER ,XDATA_GC_ST (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
END IF
IF (PRESENT(PDMAX)) THEN
- IF (SIZE(PDMAX)>0) &
- CALL AV_PGD(DTCO, &
- PDMAX ,PCOVER ,XDATA_DMAX_ST (:,:),YTREE,'ARI',OCOVER,KDECADE=KDECADE)
+ IF (SIZE(PDMAX)>0) CALL AV_PGD(YDTCO, PDMAX ,PCOVER ,XDATA_DMAX_ST (:,:),YTREE,'ARI',OCOVER,KDECADE=KDECADE)
END IF
ELSE
IF (PRESENT(PGMES)) THEN
- IF (SIZE(PGMES)>0) &
- CALL AV_PGD(DTCO, &
- PGMES ,PCOVER ,XDATA_GMES (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ IF (SIZE(PGMES)>0) CALL AV_PGD(YDTCO, PGMES ,PCOVER ,XDATA_GMES (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
END IF
IF (PRESENT(PBSLAI)) THEN
- IF (SIZE(PBSLAI)>0) &
- CALL AV_PGD(DTCO, &
- PBSLAI ,PCOVER ,XDATA_BSLAI (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ IF (SIZE(PBSLAI)>0) CALL AV_PGD(YDTCO, PBSLAI ,PCOVER ,XDATA_BSLAI (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
END IF
IF (PRESENT(PSEFOLD)) THEN
- IF (SIZE(PSEFOLD)>0) &
- CALL AV_PGD(DTCO, &
- PSEFOLD,PCOVER ,XDATA_SEFOLD(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ IF (SIZE(PSEFOLD)>0) CALL AV_PGD(YDTCO, PSEFOLD,PCOVER ,XDATA_SEFOLD(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
END IF
IF (PRESENT(PGC)) THEN
- IF (SIZE(PGC)>0) &
- CALL AV_PGD(DTCO, &
- PGC ,PCOVER ,XDATA_GC (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ IF (SIZE(PGC)>0) CALL AV_PGD(YDTCO, PGC ,PCOVER ,XDATA_GC (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
END IF
IF (PRESENT(PDMAX)) THEN
- IF (SIZE(PDMAX)>0) &
- CALL AV_PGD(DTCO, &
- PDMAX ,PCOVER ,XDATA_DMAX (:,:),YTREE,'ARI',OCOVER,KDECADE=KDECADE)
+ IF (SIZE(PDMAX)>0) CALL AV_PGD(YDTCO, PDMAX ,PCOVER ,XDATA_DMAX (:,:),YTREE,'ARI',OCOVER,KDECADE=KDECADE)
END IF
ENDIF
IF (PRESENT(PRE25)) THEN
- IF (SIZE(PRE25)>0) &
- CALL AV_PGD(DTCO, &
- PRE25 ,PCOVER ,XDATA_RE25 (:,:),YNAT,'ARI',OCOVER,KDECADE=KDECADE)
+ IF (SIZE(PRE25)>0) CALL AV_PGD(YDTCO, PRE25 ,PCOVER ,XDATA_RE25 (:,:),YNAT,'ARI',OCOVER,KDECADE=KDECADE)
END IF
IF (PRESENT(PLAIMIN)) THEN
- IF (SIZE(PLAIMIN)>0) &
- CALL AV_PGD(DTCO, &
- PLAIMIN,PCOVER ,XDATA_LAIMIN(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ IF (SIZE(PLAIMIN)>0) CALL AV_PGD(YDTCO, PLAIMIN,PCOVER ,XDATA_LAIMIN(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
END IF
IF (PRESENT(PCE_NITRO)) THEN
IF (SIZE(PCE_NITRO)>0) &
- CALL AV_PGD(DTCO, &
- PCE_NITRO ,PCOVER ,XDATA_CE_NITRO (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD(YDTCO, PCE_NITRO ,PCOVER ,XDATA_CE_NITRO (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
END IF
IF (PRESENT(PCF_NITRO)) THEN
- IF (SIZE(PCF_NITRO)>0) &
- CALL AV_PGD(DTCO, &
- PCF_NITRO ,PCOVER ,XDATA_CF_NITRO (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ IF (SIZE(PCF_NITRO)>0) CALL AV_PGD(YDTCO, PCF_NITRO ,PCOVER ,XDATA_CF_NITRO (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
END IF
IF (PRESENT(PCNA_NITRO)) THEN
- IF (SIZE(PCNA_NITRO)>0) &
- CALL AV_PGD(DTCO, &
- PCNA_NITRO ,PCOVER ,XDATA_CNA_NITRO(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ IF (SIZE(PCNA_NITRO)>0) CALL AV_PGD(YDTCO, PCNA_NITRO ,PCOVER ,XDATA_CNA_NITRO(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
END IF
IF (PRESENT(PF2I)) THEN
- IF (SIZE(PF2I)>0) &
- CALL AV_PGD(DTCO, &
- PF2I ,PCOVER ,XDATA_F2I (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ IF (SIZE(PF2I)>0) CALL AV_PGD(YDTCO, PF2I ,PCOVER ,XDATA_F2I (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
END IF
!
IF (PRESENT(OSTRESS)) THEN
IF (SIZE(OSTRESS)>0) THEN
ALLOCATE(ZWORK(SIZE(OSTRESS,1),SIZE(OSTRESS,2)))
- CALL AV_PGD(DTCO, &
- ZWORK,PCOVER ,XDATA_STRESS(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD(YDTCO, ZWORK,PCOVER ,XDATA_STRESS(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
WHERE (ZWORK<0.5)
OSTRESS = .FALSE.
ELSEWHERE
@@ -484,7 +742,7 @@ IF (PRESENT(OSTRESS)) THEN
END IF
END IF
!
-IF (HPHOTO == 'LAI' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT') THEN
+IF (HPHOTO == 'NIT' .OR. HPHOTO=='NCB') THEN
!
! date of seeding
! ---------------
@@ -507,8 +765,7 @@ IF (HPHOTO == 'LAI' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT') THEN
!
IF (PRESENT(PIRRIG)) THEN
IF (SIZE(PIRRIG)>0) &
- CALL AV_PGD(DTCO, &
- PIRRIG ,PCOVER ,XDATA_IRRIG(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD(YDTCO, PIRRIG ,PCOVER ,XDATA_IRRIG(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
END IF
!
! water supply for irrigation
@@ -516,22 +773,57 @@ IF (HPHOTO == 'LAI' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT') THEN
!
IF (PRESENT(PWATSUP)) THEN
IF (SIZE(PWATSUP)>0) &
- CALL AV_PGD(DTCO, &
- PWATSUP ,PCOVER ,XDATA_WATSUP(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD(YDTCO, PWATSUP ,PCOVER ,XDATA_WATSUP(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
END IF
!
END IF
!
-IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
+IF (ASSOCIATED(YDTCO%XDATA_WEIGHT)) DEALLOCATE(YDTCO%XDATA_WEIGHT)
+!
+! if we run with ECOSG, and the init file was done with ECOCLIMAP
+IF (SIZE(OCOVER)/=SIZE(XDATA_GROUND_DEPTH,1)) THEN
+ NVT_C3 = 0
+ NVT_PARK = 0
+ NVT_IRR = 0
+ NVT_NO = 1 ! 1 ! no vegetation (smooth)
+ NVT_ROCK = 2 ! 2 ! no vegetation (rocks)
+ NVT_SNOW = 3 ! 3 ! permanent snow and ice
+ NVT_BOBD = 4 ! 4 ! boreal broadleaf cold-deciduous summergreen (TREE)
+ NVT_TEBD = 5 ! 4 ! temperate broadleaf cold-deciduous summergreen (TREE)
+ NVT_TRBD = 6 ! 4 ! tropical broadleaf deciduous (TREE)
+ NVT_TEBE = 7 ! 4 ! temperate broadleaf evergreen (TREE)
+ NVT_TRBE = 8 ! 6 ! tropical broadleaf evergreen (EVER)
+ NVT_BONE = 9 ! 5 ! boreal needleleaf evergreen (CONI)
+ NVT_TENE =10 ! 5 ! temperate needleleaf evergreen (CONI)
+ NVT_BOND =11 ! 5 ! boreal needleleaf cold-deciduous summergreen (CONI)
+ NVT_SHRB =12 ! 4 ! shrub (TREE)
+ NVT_BOGR =13 !10 ! boreal grass (GRAS)
+ NVT_GRAS =14 !10 ! grassland
+ NVT_TROG =15 !11 ! tropical grassland
+ NVT_C3W =16 ! 7 ! C3W cultures types
+ NVT_C3S =17 ! 7 ! C3S cultures types
+ NVT_C4 =18 ! 8 ! C4 cultures types
+ NVT_FLTR =19 !12 ! flooded trees
+ NVT_FLGR =20 !12 ! flooded grassland
+
+ DEALLOCATE(XDATA_VEG,XDATA_LAI)
+ ALLOCATE(XDATA_VEG(SIZE(ZDATA_VEG,1),SIZE(ZDATA_VEG,2),SIZE(ZDATA_VEG,3)))
+ ALLOCATE(XDATA_LAI(SIZE(ZDATA_LAI,1),SIZE(ZDATA_LAI,2),SIZE(ZDATA_LAI,3)))
+ XDATA_VEG(:,:,:) = ZDATA_VEG(:,:,:)
+ XDATA_LAI(:,:,:) = ZDATA_LAI(:,:,:)
+ DEALLOCATE(ZDATA_LAI,ZDATA_VEG)
+
+ENDIF
+!
+ CALL DATA_COVER_INIT(YDTCO)
!
IF (LHOOK) CALL DR_HOOK('CONVERT_COVER_ISBA',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
!
-SUBROUTINE SET_COVER_DG(KNI,KGROUND,KPATCH,LPERM,LDG2,LDROOT,LWG_LAYER,LROOTFRAC, &
- LROOTFRACGV )
+SUBROUTINE SET_COVER_DG(KNI,KGROUND,KPATCH,LPERM,LDG2,LDROOT,LWG_LAYER,LROOTFRAC )
!
USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
!
@@ -551,17 +843,13 @@ LOGICAL, INTENT(IN) :: LDG2
LOGICAL, INTENT(IN) :: LDROOT
LOGICAL, INTENT(IN) :: LWG_LAYER
LOGICAL, INTENT(IN) :: LROOTFRAC
-LOGICAL, INTENT(IN) :: LROOTFRACGV
-!
-REAL, DIMENSION (SIZE(XDATA_GROUND_DEPTH,1),SIZE(XDATA_GROUND_DEPTH,2)) :: ZDATA_GROUND_DEPTH
-REAL, DIMENSION (SIZE(XDATA_ROOT_DEPTH ,1),3,SIZE(XDATA_ROOT_DEPTH,2)) :: ZDATA_DG
!
INTEGER, DIMENSION (KNI,KPATCH) :: IWG_LAYER
REAL, DIMENSION (KNI,KPATCH) :: ZDTOT, ZDROOT ! work array
REAL, DIMENSION (KNI,KPATCH) :: ZROOT_EXT ! "
REAL, DIMENSION (KNI,KPATCH) :: ZROOT_LIN ! "
!
-INTEGER :: JPATCH, JJ, JVEGTYPE
+INTEGER :: JPATCH, JJ, JVEGTYPE, JP
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -573,8 +861,6 @@ ZROOT_EXT(:,:) = XUNDEF
ZROOT_LIN(:,:) = XUNDEF
IWG_LAYER(:,:) = NUNDEF
!
-ZDATA_GROUND_DEPTH(:,:) = XDATA_GROUND_DEPTH(:,:)
-!
!####################################################################################
!
!CDGAVG : old for reprod = 'ARI' Arithmetic average for all depth
@@ -587,15 +873,16 @@ ZDATA_GROUND_DEPTH(:,:) = XDATA_GROUND_DEPTH(:,:)
!
IF(HISBA/='DIF')THEN
!
- CALL INI_DATA_SOIL(HISBA, ZDATA_DG, &
- PSURF = DTCO%XDATA_NATURE, &
- PSURF2 = DTCO%XDATA_GARDEN, &
- PROOTDEPTH = XDATA_ROOT_DEPTH, &
- PSOILDEPTH = XDATA_GROUND_DEPTH )
+ DO JP = 1,SIZE(ZDATA_DG,3)
+ CALL INI_DATA_SOIL(HISBA, ZDATA_DG(:,:,JP), &
+ PSURF = YDTCO%XDATA_NATURE, &
+ PSURF2 = YDTCO%XDATA_GARDEN, &
+ PROOTDEPTH = ZDATA_ROOT_DEPTH(:,JP), &
+ PSOILDEPTH = ZDATA_GROUND_DEPTH(:,JP) )
+ ENDDO
!
DO JLAYER=1,KGROUND
- CALL AV_PGD(DTCO, &
- PDG(:,JLAYER,:),PCOVER,ZDATA_DG(:,JLAYER,:),YNAT,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD(YDTCO, PDG(:,JLAYER,:),PCOVER,ZDATA_DG(:,JLAYER,:),YNAT,'ARI',OCOVER,KDECADE=KDECADE)
ENDDO
!
ELSE
@@ -603,19 +890,18 @@ ELSE
IF(CDGDIF=='ROOT')THEN
DO JVEGTYPE=1,NVEGTYPE
IF(JVEGTYPE==NVT_NO)THEN
- WHERE(XDATA_GROUND_DEPTH(:,JVEGTYPE)/=XUNDEF)
- ZDATA_GROUND_DEPTH(:,JVEGTYPE) = MIN(1.0,XDATA_GROUND_DEPTH(:,JVEGTYPE))
+ WHERE(ZDATA_GROUND_DEPTH(:,JVEGTYPE)/=XUNDEF)
+ ZDATA_GROUND_DEPTH(:,JVEGTYPE) = MIN(1.0,ZDATA_GROUND_DEPTH(:,JVEGTYPE))
ENDWHERE
ELSEIF(JVEGTYPE/=NVT_ROCK.AND.JVEGTYPE/=NVT_SNOW)THEN
- ZDATA_GROUND_DEPTH(:,JVEGTYPE) = MAX(1.0,XDATA_ROOT_DEPTH(:,JVEGTYPE))
+ ZDATA_GROUND_DEPTH(:,JVEGTYPE) = MAX(1.0,ZDATA_ROOT_DEPTH(:,JVEGTYPE))
ELSE
- ZDATA_GROUND_DEPTH(:,JVEGTYPE) = XDATA_ROOT_DEPTH(:,JVEGTYPE)
+ ZDATA_GROUND_DEPTH(:,JVEGTYPE) = ZDATA_ROOT_DEPTH(:,JVEGTYPE)
ENDIF
ENDDO
ENDIF
!
- CALL AV_PGD(DTCO, &
- ZDTOT (:,:),PCOVER,ZDATA_GROUND_DEPTH,YNAT,CDGAVG,OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD(YDTCO, ZDTOT (:,:),PCOVER,ZDATA_GROUND_DEPTH,YNAT,CDGAVG,OCOVER,KDECADE=KDECADE)
!
! CALCULATION OF GROUND_DEPTH over Permafrost area
IF(LPERM)THEN
@@ -624,38 +910,31 @@ ELSE
!
IF (LDG2) THEN
IF(CDGDIF=='ROOT')THEN
- CALL AV_PGD(DTCO, &
- PDG2(:,:),PCOVER,ZDATA_GROUND_DEPTH,YNAT,CDGAVG,OCOVER)
+ CALL AV_PGD(YDTCO, PDG2(:,:),PCOVER,ZDATA_GROUND_DEPTH,YNAT,CDGAVG,OCOVER)
ELSE
- CALL AV_PGD(DTCO, &
- PDG2(:,:),PCOVER,XDATA_ROOT_DEPTH,YNAT,CDGAVG,OCOVER)
+ CALL AV_PGD(YDTCO, PDG2(:,:),PCOVER,ZDATA_ROOT_DEPTH,YNAT,CDGAVG,OCOVER)
ENDIF
ENDIF
- IF (LDROOT .OR. LROOTFRAC .OR. LROOTFRACGV .OR. (CDGDIF=='ROOT')) THEN
- CALL AV_PGD(DTCO, &
- ZDROOT(:,:),PCOVER,XDATA_ROOT_DEPTH,YDIF,CDGAVG,OCOVER,KDECADE=KDECADE)
+ IF (LDROOT .OR. LROOTFRAC .OR. (CDGDIF=='ROOT')) THEN
+ CALL AV_PGD(YDTCO, ZDROOT(:,:),PCOVER,ZDATA_ROOT_DEPTH,YDIF,CDGAVG,OCOVER,KDECADE=KDECADE)
IF (LDROOT) PDROOT(:,:) = ZDROOT(:,:)
IF (CDGDIF=='ROOT') WHERE(ZDROOT(:,:).NE.XUNDEF) ZDTOT(:,:) = MAX(ZDROOT(:,:),ZDTOT(:,:))
ENDIF
!
- CALL INI_DATA_SOIL(HISBA, PDG, PSOILDEPTH=ZDTOT, PSOILGRID=PSOILGRID, &
- KWG_LAYER=IWG_LAYER )
+ DO JP = 1,SIZE(PDG,3)
+ CALL INI_DATA_SOIL(HISBA, PDG(:,:,JP), PSOILDEPTH=ZDTOT(:,JP), PSOILGRID=PSOILGRID, &
+ KWG_LAYER=IWG_LAYER(:,JP))
+ ENDDO
IF (LWG_LAYER) KWG_LAYER(:,:) = IWG_LAYER(:,:)
!
- IF (LROOTFRAC .OR. LROOTFRACGV) THEN
+ IF (LROOTFRAC) THEN
!
- CALL AV_PGD(DTCO, &
- ZROOT_LIN(:,:),PCOVER,XDATA_ROOT_LIN(:,:),YDIF,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD(YDTCO, ZROOT_LIN(:,:),PCOVER,ZDATA_ROOT_LIN(:,:),YDIF,'ARI',OCOVER,KDECADE=KDECADE)
IF (LROOTFRAC) THEN
- CALL AV_PGD(DTCO, &
- ZROOT_EXT(:,:),PCOVER,XDATA_ROOT_EXTINCTION(:,:),YDIF,'ARI',OCOVER,KDECADE=KDECADE)
- CALL INI_DATA_ROOTFRAC(PDG,PDROOT,ZROOT_EXT,ZROOT_LIN,PROOTFRAC)
- ENDIF
- IF (LROOTFRACGV) THEN
- CALL AV_PGD(DTCO, &
- ZROOT_EXT(:,:),PCOVER,XDATA_ROOT_EXTINCTIONGV(:,:),YDIF,'ARI',OCOVER,KDECADE=KDECADE)
- CALL INI_DATA_ROOTFRAC(PDG,PDROOT,ZROOT_EXT,ZROOT_LIN, &
- PROOTFRACGV,OGV=LROOTFRACGV)
+ CALL AV_PGD(YDTCO, ZROOT_EXT(:,:),PCOVER,ZDATA_ROOT_EXTINCTION(:,:),YDIF,'ARI',OCOVER,KDECADE=KDECADE)
+ DO JP = 1,SIZE(PDG,3)
+ CALL INI_DATA_ROOTFRAC(PDG(:,:,JP),PDROOT(:,JP),ZROOT_EXT(:,JP),ZROOT_LIN(:,JP),PROOTFRAC(:,:,JP))
+ ENDDO
ENDIF
!
ENDIF
diff --git a/src/SURFEX/convert_cover_teb_veg.F90 b/src/SURFEX/convert_cover_teb_veg.F90
deleted file mode 100644
index 29edd4392a9660f2ed9810436f061df510fb95a2..0000000000000000000000000000000000000000
--- a/src/SURFEX/convert_cover_teb_veg.F90
+++ /dev/null
@@ -1,670 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE CONVERT_COVER_TEB_VEG (DTCO, TVG, &
- HISBA,KDECADE,PCOVER,OCOVER,HPHOTO, &
- HSFTYPE,PVEG, &
- PLAI,PRSMIN,PGAMMA,PWRMAX_CF, &
- PRGL,PCV,PSOILGRID,PPERM, &
- PDG,KWG_LAYER,PDROOT,PDG2, &
- PD_ICE,PZ0,PZ0_O_Z0H, &
- PALBNIR_VEG,PALBVIS_VEG,PALBUV_VEG, &
- PEMIS_ECO, &
- PVEGTYPE,PROOTFRAC, &
- PGMES,PBSLAI,PLAIMIN,PSEFOLD,PGC, &
- PDMAX, PF2I, OSTRESS, PH_TREE,PRE25,&
- PCE_NITRO, PCF_NITRO, PCNA_NITRO, &
- TPSEED, TPREAP, PWATSUP, PIRRIG, &
- PGNDLITTER, PLAIGV, PRSMINGV, &
- PGAMMAGV, &
- PWRMAX_CFGV, PRGLGV, PROOTFRACGV, &
- PZ0LITTER, PH_VEG )
-! ##############################################################
-!
-!!**** *CONVERT_COVER* convert surface cover classes into secondary
-!! physiographic variables for ISBA
-!!
-!! PURPOSE
-!! -------
-!!
-!! METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! V. Masson Meteo-France
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 01/2004
-!!
-!! P Le Moigne 09/2005 AGS modifs of L. Jarlan
-!! B. Decharme 04/2013 Add CDGAVG (average depth)
-!! Soil depth = Root depth with ISBA-DF
-!! except for bare soil pft (but limited to 1m)
-!! P Samuelsson 10/2014 MEB
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
-!
-!
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
-!
-USE MODD_DATA_COVER, ONLY : XDATA_LAI, XDATA_H_TREE, &
- XDATA_VEG, XDATA_Z0, XDATA_Z0_O_Z0H, &
- XDATA_EMIS_ECO, XDATA_GAMMA, XDATA_CV, &
- XDATA_RGL, XDATA_RSMIN, &
- XDATA_ALBNIR_VEG, XDATA_ALBVIS_VEG, &
- XDATA_ALBUV_VEG, XDATA_DICE, &
- XDATA_ALB_VEG_NIR, XDATA_ALB_VEG_VIS, &
- XDATA_ALB_SOIL_NIR, XDATA_ALB_SOIL_VIS, &
- XDATA_GMES, XDATA_BSLAI, XDATA_LAIMIN, &
- XDATA_SEFOLD, XDATA_GC, XDATA_WRMAX_CF, &
- XDATA_STRESS, &
- XDATA_DMAX, XDATA_F2I, XDATA_RE25, &
- XDATA_CE_NITRO, XDATA_CF_NITRO, &
- XDATA_CNA_NITRO, &
- XDATA_GMES_ST, XDATA_BSLAI_ST, &
- XDATA_SEFOLD_ST, XDATA_GC_ST, &
- XDATA_DMAX_ST, XDATA_WATSUP, &
- TDATA_SEED, TDATA_REAP,XDATA_IRRIG, &
- XDATA_ROOT_DEPTH, XDATA_GROUND_DEPTH, &
- XDATA_ROOT_EXTINCTION, XDATA_ROOT_LIN, &
- XDATA_GNDLITTER, &
- XDATA_RGLGV, XDATA_GAMMAGV, &
- XDATA_RSMINGV, XDATA_WRMAX_CFGV, &
- XDATA_LAIGV, XDATA_Z0LITTER, &
- XDATA_ROOT_DEPTHGV, XDATA_H_VEG, &
- XDATA_ROOT_EXTINCTIONGV
-
-USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, JPCOVER, NVT_NO, NVT_ROCK, NVT_SNOW
-USE MODD_TYPE_DATE_SURF
-!
-!
-USE MODI_AV_PGD
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-!
-!
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
-!
- CHARACTER(LEN=*), INTENT(IN) :: HISBA ! type of soil (Force-Restore OR Diffusion)
-INTEGER, INTENT(IN) :: KDECADE
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOVER
-LOGICAL, DIMENSION(:), INTENT(IN) :: OCOVER
- CHARACTER(LEN=*), INTENT(IN) :: HPHOTO ! type of photosynthesis
- CHARACTER(LEN=*), INTENT(IN) :: HSFTYPE ! nature / garden
-!
-REAL, DIMENSION(:) , OPTIONAL, INTENT(IN) :: PSOILGRID
-REAL, DIMENSION(:) , OPTIONAL, INTENT(IN) :: PPERM
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PVEG
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PLAI
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PRSMIN
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PGAMMA
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PWRMAX_CF
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PRGL
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PCV
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PDG
-INTEGER, DIMENSION(:,:),OPTIONAL, INTENT(OUT) :: KWG_LAYER
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PDROOT
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PDG2
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PD_ICE
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PROOTFRAC
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PZ0
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PZ0_O_Z0H
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PALBNIR_VEG
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PALBVIS_VEG
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PALBUV_VEG
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PEMIS_ECO
-!
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PGNDLITTER
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PLAIGV
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PRSMINGV
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PGAMMAGV
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PWRMAX_CFGV
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PRGLGV
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PROOTFRACGV
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PZ0LITTER
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PH_VEG
-!
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PVEGTYPE
-!
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PGMES
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PRE25
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PBSLAI
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PLAIMIN
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PSEFOLD
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PGC
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PDMAX
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PF2I
-LOGICAL, DIMENSION(:,:),OPTIONAL, INTENT(OUT) :: OSTRESS
-!
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PH_TREE
-!
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PCE_NITRO
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PCF_NITRO
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PCNA_NITRO
-!
-TYPE(DATE_TIME), DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: TPSEED
-TYPE(DATE_TIME), DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: TPREAP
-!
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PWATSUP
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PIRRIG
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-! calculation of veg from lai in the pixel
-!
-REAL, DIMENSION (:,:), ALLOCATABLE :: ZWORK ! work array
-!
- CHARACTER(LEN=3) :: YTREE, YNAT, YLAI, YVEG, YDIF
-!
-INTEGER :: JLAYER ! loop counter on surface layers
-INTEGER :: JVEG ! loop counter on vegetation types
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-!
-!* 2. SECONDARY VARIABLES
-! -------------------
-!
-IF (LHOOK) CALL DR_HOOK('CONVERT_COVER_TEB_VEG',0,ZHOOK_HANDLE)
-!
-IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
-!
-IF (HSFTYPE=='NAT') THEN
- YNAT='NAT'
- YTREE='TRE'
- YLAI='LAI'
- YVEG='VEG'
- YDIF='DVG'
-ELSEIF (HSFTYPE=='GRD') THEN
- YNAT='GRD'
- YTREE='GRT'
- YLAI='GRL'
- YVEG='GRV'
- YDIF='GDV'
-ENDIF
-!
-!* 2.1 fields on natural surfaces only, taking into account patches/
-! -------------------------------
-!
-!
-! Leaf Aera Index
-! ---------------
-!
-IF (PRESENT(PLAI)) THEN
- CALL AV_PGD(DTCO, &
- PLAI ,PCOVER ,XDATA_LAI (:,KDECADE,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
-ENDIF
-!
-IF (PRESENT(PLAIGV)) THEN
- CALL AV_PGD(DTCO, &
- PLAIGV ,PCOVER ,XDATA_LAIGV (:,KDECADE,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
-ENDIF
-!
-!
-!* 1/Rsmin
-!
-IF (PRESENT(PRSMIN)) THEN
- IF (SIZE(PRSMIN)>0) &
- CALL AV_PGD(DTCO, &
- PRSMIN,PCOVER ,XDATA_RSMIN,YLAI,'INV',OCOVER,KDECADE=KDECADE)
-END IF
-!
-IF (PRESENT(PRSMINGV)) THEN
- IF (SIZE(PRSMINGV)>0) &
- CALL AV_PGD(DTCO, &
- PRSMINGV,PCOVER ,XDATA_RSMINGV,YLAI,'INV',OCOVER,KDECADE=KDECADE)
-END IF
-!
-IF (PRESENT(PH_TREE)) &
- CALL AV_PGD(DTCO, &
- PH_TREE ,PCOVER ,XDATA_H_TREE (:,:) ,YTREE,'ARI',OCOVER)
-!
-DO JVEG=1,NVEGTYPE
- IF (PRESENT(PVEGTYPE)) &
- CALL AV_PGD(DTCO, &
- PVEGTYPE(:,JVEG),PCOVER ,DTCO%XDATA_VEGTYPE(:,JVEG),YNAT,'ARI',OCOVER)
-END DO
-!
-!
-! vegetation fraction
-! -------------------
-!
-IF (PRESENT(PVEG)) &
- CALL AV_PGD(DTCO, &
- PVEG ,PCOVER ,XDATA_VEG (:,KDECADE,:),YNAT,'ARI',OCOVER)
-!
-!
-IF (PRESENT(PGNDLITTER)) &
- CALL AV_PGD(DTCO, &
- PGNDLITTER ,PCOVER ,XDATA_GNDLITTER (:,KDECADE,:),YNAT,'ARI',OCOVER)
-!
-! roughness length
-! ----------------
-!
-IF (PRESENT(PZ0)) &
- CALL AV_PGD(DTCO, &
- PZ0 ,PCOVER ,XDATA_Z0 (:,KDECADE,:),YNAT,'CDN',OCOVER)
-!
-IF (PRESENT(PZ0_O_Z0H)) &
- CALL AV_PGD(DTCO, &
- PZ0_O_Z0H ,PCOVER ,XDATA_Z0_O_Z0H (:,:),YNAT,'ARI',OCOVER)
-!
-IF (PRESENT(PZ0LITTER)) &
- CALL AV_PGD(DTCO, &
- PZ0LITTER ,PCOVER ,XDATA_Z0LITTER (:,KDECADE,:),YNAT,'CDN',OCOVER)
-!
-!emis-eco
-!--------
-!
-IF (PRESENT(PEMIS_ECO)) &
- CALL AV_PGD(DTCO, &
- PEMIS_ECO ,PCOVER ,XDATA_EMIS_ECO (:,KDECADE,:),YNAT,'ARI',OCOVER)
-!
-!---------------------------------------------------------------------------------
-!
-!* other vegetation parameters
-!
-IF (PRESENT(PGAMMA)) &
- CALL AV_PGD(DTCO, &
- PGAMMA ,PCOVER ,XDATA_GAMMA (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
-IF (PRESENT(PGAMMAGV)) &
- CALL AV_PGD(DTCO, &
- PGAMMAGV ,PCOVER ,XDATA_GAMMAGV (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
-IF (PRESENT(PWRMAX_CF)) &
- CALL AV_PGD(DTCO, &
- PWRMAX_CF ,PCOVER ,XDATA_WRMAX_CF(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
-IF (PRESENT(PWRMAX_CFGV)) &
- CALL AV_PGD(DTCO, &
- PWRMAX_CFGV ,PCOVER ,XDATA_WRMAX_CFGV(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
-!
-!
-IF (PRESENT(PRGL)) &
- CALL AV_PGD(DTCO, &
- PRGL ,PCOVER ,XDATA_RGL (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
-IF (PRESENT(PRGLGV)) &
- CALL AV_PGD(DTCO, &
- PRGLGV ,PCOVER ,XDATA_RGLGV (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
-IF (PRESENT(PCV)) &
- CALL AV_PGD(DTCO, &
- PCV ,PCOVER ,XDATA_CV (:,:),YVEG,'INV',OCOVER,KDECADE=KDECADE)
-!
-IF (PRESENT(PH_VEG)) THEN
- CALL AV_PGD(DTCO, &
- PH_VEG,PCOVER,XDATA_H_VEG(:,KDECADE,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
-ENDIF
-!
-
-!
-!---------------------------------------------------------------------------------
-!
-!* soil layers
-! -----------
-!
-IF (PRESENT(PDG)) THEN
-!
-!* soil layers (and cumulative root fraction for DIF only)
-!
- CALL SET_COVER_DG(SIZE(PDG,1),SIZE(PDG,2),SIZE(PDG,3),PRESENT(PPERM),&
- PRESENT(PDG2),PRESENT(PDROOT),PRESENT(KWG_LAYER), &
- PRESENT(PROOTFRAC),PRESENT(PROOTFRACGV) )
-!
-END IF
-!
-!---------------------------------------------------------------------------------
-!
-!* soil ice for runoff
-! -------------------
-!
-IF (PRESENT(PD_ICE)) &
- CALL AV_PGD(DTCO, &
- PD_ICE,PCOVER ,XDATA_DICE(:,:),YNAT,'ARI',OCOVER)
-!
-!---------------------------------------------------------------------------------
-!
-IF (PRESENT(PALBNIR_VEG)) THEN
- IF (TVG%CALBEDO=='CM13') THEN
- CALL AV_PGD(DTCO, &
- PALBVIS_VEG,PCOVER,XDATA_ALB_VEG_NIR(:,KDECADE,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ELSE
- CALL AV_PGD(DTCO, &
- PALBNIR_VEG,PCOVER ,XDATA_ALBNIR_VEG(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
-ENDIF
-!
-IF (PRESENT(PALBVIS_VEG)) THEN
- IF (TVG%CALBEDO=='CM13') THEN
- CALL AV_PGD(DTCO, &
- PALBVIS_VEG,PCOVER,XDATA_ALB_VEG_VIS(:,KDECADE,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ELSE
- CALL AV_PGD(DTCO, &
- PALBVIS_VEG,PCOVER ,XDATA_ALBVIS_VEG(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
-ENDIF
-!
-IF (PRESENT(PALBUV_VEG)) THEN
- IF ((TVG%CALBEDO=='CM13'.OR.TVG%LTR_ML).AND.PRESENT(PALBVIS_VEG)) THEN
- PALBUV_VEG(:,:)=PALBVIS_VEG(:,:)
- ELSE
- CALL AV_PGD(DTCO, &
- PALBUV_VEG, PCOVER ,XDATA_ALBUV_VEG (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
-ENDIF
-!
-! parameters for "stress option"
-IF (HPHOTO == 'AST' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT' .OR. HPHOTO == 'NCB') THEN
-
- IF (PRESENT(PGMES)) THEN
- IF (SIZE(PGMES)>0) &
- CALL AV_PGD(DTCO, &
- PGMES ,PCOVER ,XDATA_GMES_ST (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- END IF
-
- IF (PRESENT(PBSLAI)) THEN
- IF (SIZE(PBSLAI)>0) &
- CALL AV_PGD(DTCO, &
- PBSLAI ,PCOVER ,XDATA_BSLAI_ST (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- END IF
-
- IF (PRESENT(PSEFOLD)) THEN
- IF (SIZE(PSEFOLD)>0) &
- CALL AV_PGD(DTCO, &
- PSEFOLD,PCOVER ,XDATA_SEFOLD_ST(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- END IF
-
- IF (PRESENT(PGC)) THEN
- IF (SIZE(PGC)>0) &
- CALL AV_PGD(DTCO, &
- PGC ,PCOVER ,XDATA_GC_ST (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- END IF
-
- IF (PRESENT(PDMAX)) THEN
- IF (SIZE(PDMAX)>0) &
- CALL AV_PGD(DTCO, &
- PDMAX ,PCOVER ,XDATA_DMAX_ST (:,:),YTREE,'ARI',OCOVER,KDECADE=KDECADE)
- END IF
-
-ELSE
- IF (PRESENT(PGMES)) THEN
- IF (SIZE(PGMES)>0) &
- CALL AV_PGD(DTCO, &
- PGMES ,PCOVER ,XDATA_GMES (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- END IF
- IF (PRESENT(PBSLAI)) THEN
- IF (SIZE(PBSLAI)>0) &
- CALL AV_PGD(DTCO, &
- PBSLAI ,PCOVER ,XDATA_BSLAI (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- END IF
- IF (PRESENT(PSEFOLD)) THEN
- IF (SIZE(PSEFOLD)>0) &
- CALL AV_PGD(DTCO, &
- PSEFOLD,PCOVER ,XDATA_SEFOLD(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- END IF
- IF (PRESENT(PGC)) THEN
- IF (SIZE(PGC)>0) &
- CALL AV_PGD(DTCO, &
- PGC ,PCOVER ,XDATA_GC (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- END IF
- IF (PRESENT(PDMAX)) THEN
- IF (SIZE(PDMAX)>0) &
- CALL AV_PGD(DTCO, &
- PDMAX ,PCOVER ,XDATA_DMAX (:,:),YTREE,'ARI',OCOVER,KDECADE=KDECADE)
- END IF
-
-ENDIF
-
-IF (PRESENT(PRE25)) THEN
- IF (SIZE(PRE25)>0) &
- CALL AV_PGD(DTCO, &
- PRE25 ,PCOVER ,XDATA_RE25 (:,:),YNAT,'ARI',OCOVER,KDECADE=KDECADE)
-END IF
-
-IF (PRESENT(PLAIMIN)) THEN
- IF (SIZE(PLAIMIN)>0) &
- CALL AV_PGD(DTCO, &
- PLAIMIN,PCOVER ,XDATA_LAIMIN(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
-END IF
-IF (PRESENT(PCE_NITRO)) THEN
- IF (SIZE(PCE_NITRO)>0) &
- CALL AV_PGD(DTCO, &
- PCE_NITRO ,PCOVER ,XDATA_CE_NITRO (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
-END IF
-IF (PRESENT(PCF_NITRO)) THEN
- IF (SIZE(PCF_NITRO)>0) &
- CALL AV_PGD(DTCO, &
- PCF_NITRO ,PCOVER ,XDATA_CF_NITRO (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
-END IF
-IF (PRESENT(PCNA_NITRO)) THEN
- IF (SIZE(PCNA_NITRO)>0) &
- CALL AV_PGD(DTCO, &
- PCNA_NITRO ,PCOVER ,XDATA_CNA_NITRO(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
-END IF
-IF (PRESENT(PF2I)) THEN
- IF (SIZE(PF2I)>0) &
- CALL AV_PGD(DTCO, &
- PF2I ,PCOVER ,XDATA_F2I (:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
-END IF
-!
-IF (PRESENT(OSTRESS)) THEN
- IF (SIZE(OSTRESS)>0) THEN
- ALLOCATE(ZWORK(SIZE(OSTRESS,1),SIZE(OSTRESS,2)))
- CALL AV_PGD(DTCO, &
- ZWORK,PCOVER ,XDATA_STRESS(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- WHERE (ZWORK<0.5)
- OSTRESS = .FALSE.
- ELSEWHERE
- OSTRESS = .TRUE.
- END WHERE
- DEALLOCATE(ZWORK)
- END IF
-END IF
-!
-IF (HPHOTO == 'LAI' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT') THEN
- !
- ! date of seeding
- ! ---------------
- !
- IF (PRESENT(TPSEED)) THEN
- IF (SIZE(TPSEED)>0) &
- CALL AV_PGD (TPSEED ,PCOVER ,TDATA_SEED(:,:),YVEG,'MAJ',OCOVER,KDECADE=KDECADE)
- END IF
- !
- ! date of reaping
- ! ---------------
- !
- IF (PRESENT(TPREAP)) THEN
- IF (SIZE(TPREAP)>0) &
- CALL AV_PGD (TPREAP ,PCOVER ,TDATA_REAP(:,:),YVEG,'MAJ',OCOVER,KDECADE=KDECADE)
- END IF
- !
- ! fraction of irrigated surface
- ! ---------------------------
- !
- IF (PRESENT(PIRRIG)) THEN
- IF (SIZE(PIRRIG)>0) &
- CALL AV_PGD(DTCO, &
- PIRRIG ,PCOVER ,XDATA_IRRIG(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- END IF
- !
- ! water supply for irrigation
- ! ---------------------------
- !
- IF (PRESENT(PWATSUP)) THEN
- IF (SIZE(PWATSUP)>0) &
- CALL AV_PGD(DTCO, &
- PWATSUP ,PCOVER ,XDATA_WATSUP(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- END IF
-!
-END IF
-!
-IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
-!
-IF (LHOOK) CALL DR_HOOK('CONVERT_COVER_TEB_VEG',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-CONTAINS
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE SET_COVER_DG(KNI,KGROUND,KPATCH,LPERM,LDG2,LDROOT,LWG_LAYER,LROOTFRAC, &
- LROOTFRACGV )
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
-!
-USE MODD_REPROD_OPER, ONLY : CDGAVG, CDGDIF
-!
-USE MODI_INI_DATA_ROOTFRAC
-USE MODI_INI_DATA_SOIL
-USE MODI_PERMAFROST_DEPTH
-!
-IMPLICIT NONE
-!
-INTEGER, INTENT(IN) :: KNI
-INTEGER, INTENT(IN) :: KGROUND
-INTEGER, INTENT(IN) :: KPATCH
-LOGICAL, INTENT(IN) :: LPERM
-LOGICAL, INTENT(IN) :: LDG2
-LOGICAL, INTENT(IN) :: LDROOT
-LOGICAL, INTENT(IN) :: LWG_LAYER
-LOGICAL, INTENT(IN) :: LROOTFRAC
-LOGICAL, INTENT(IN) :: LROOTFRACGV
-!
-REAL, DIMENSION (SIZE(XDATA_GROUND_DEPTH,1),SIZE(XDATA_GROUND_DEPTH,2)) :: ZDATA_GROUND_DEPTH
-REAL, DIMENSION (SIZE(XDATA_ROOT_DEPTH ,1),3,SIZE(XDATA_ROOT_DEPTH,2)) :: ZDATA_DG
-!
-INTEGER, DIMENSION (KNI,KPATCH) :: IWG_LAYER
-REAL, DIMENSION (KNI,KPATCH) :: ZDTOT, ZDROOT ! work array
-REAL, DIMENSION (KNI,KPATCH) :: ZROOT_EXT ! "
-REAL, DIMENSION (KNI,KPATCH) :: ZROOT_LIN ! "
-!
-INTEGER :: JPATCH, JJ, JVEGTYPE
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-IF (LHOOK) CALL DR_HOOK('CONVERT_COVER_ISBA:SET_COVER_DG',0,ZHOOK_HANDLE)
-!
-ZDTOT (:,:) = XUNDEF
-ZDROOT (:,:) = XUNDEF
-ZROOT_EXT(:,:) = XUNDEF
-ZROOT_LIN(:,:) = XUNDEF
-IWG_LAYER(:,:) = NUNDEF
-!
-ZDATA_GROUND_DEPTH(:,:) = XDATA_GROUND_DEPTH(:,:)
-!
-!####################################################################################
-!
-!CDGAVG : old for reprod = 'ARI' Arithmetic average for all depth
-! recommended = 'INV' Harmonic average for all depth (default)
-!
-!CDGDIF : old for reprod = 'SOIL' d3 soil depth from ecoclimap for isba-df
-! recommended = 'ROOT' d2 soil depth from ecoclimap for isba-df (default)
-!
-!####################################################################################
-!
-IF(HISBA/='DIF')THEN
- !
- CALL INI_DATA_SOIL(HISBA, ZDATA_DG, &
- PSURF = DTCO%XDATA_NATURE, &
- PSURF2 = DTCO%XDATA_GARDEN, &
- PROOTDEPTH = XDATA_ROOT_DEPTH, &
- PSOILDEPTH = XDATA_GROUND_DEPTH )
- !
- DO JLAYER=1,KGROUND
- CALL AV_PGD(DTCO, &
- PDG(:,JLAYER,:),PCOVER,ZDATA_DG(:,JLAYER,:),YNAT,'ARI',OCOVER,KDECADE=KDECADE)
- ENDDO
- !
-ELSE
-!
- IF(CDGDIF=='ROOT')THEN
- DO JVEGTYPE=1,NVEGTYPE
- IF(JVEGTYPE==NVT_NO)THEN
- WHERE(XDATA_GROUND_DEPTH(:,JVEGTYPE)/=XUNDEF)
- ZDATA_GROUND_DEPTH(:,JVEGTYPE) = MIN(1.0,XDATA_GROUND_DEPTH(:,JVEGTYPE))
- ENDWHERE
- ELSEIF(JVEGTYPE/=NVT_ROCK.AND.JVEGTYPE/=NVT_SNOW)THEN
- ZDATA_GROUND_DEPTH(:,JVEGTYPE) = MAX(1.0,XDATA_ROOT_DEPTH(:,JVEGTYPE))
- ELSE
- ZDATA_GROUND_DEPTH(:,JVEGTYPE) = XDATA_ROOT_DEPTH(:,JVEGTYPE)
- ENDIF
- ENDDO
- ENDIF
-!
- CALL AV_PGD(DTCO, &
- ZDTOT (:,:),PCOVER,ZDATA_GROUND_DEPTH,YNAT,CDGAVG,OCOVER,KDECADE=KDECADE)
-!
-! CALCULATION OF GROUND_DEPTH over Permafrost area
- IF(LPERM)THEN
- CALL PERMAFROST_DEPTH(KNI,KPATCH,PPERM,ZDTOT)
- ENDIF
-!
- IF (LDG2) THEN
- IF(CDGDIF=='ROOT')THEN
- CALL AV_PGD(DTCO, &
- PDG2(:,:),PCOVER,ZDATA_GROUND_DEPTH,YNAT,CDGAVG,OCOVER)
- ELSE
- CALL AV_PGD(DTCO, &
- PDG2(:,:),PCOVER,XDATA_ROOT_DEPTH,YNAT,CDGAVG,OCOVER)
- ENDIF
- ENDIF
- IF (LDROOT .OR. LROOTFRAC .OR. LROOTFRACGV .OR. (CDGDIF=='ROOT')) THEN
- CALL AV_PGD(DTCO, &
- ZDROOT(:,:),PCOVER,XDATA_ROOT_DEPTH,YDIF,CDGAVG,OCOVER,KDECADE=KDECADE)
- IF (LDROOT) PDROOT(:,:) = ZDROOT(:,:)
- IF (CDGDIF=='ROOT') WHERE(ZDROOT(:,:).NE.XUNDEF) ZDTOT(:,:) = MAX(ZDROOT(:,:),ZDTOT(:,:))
- ENDIF
-!
- CALL INI_DATA_SOIL(HISBA, PDG, PSOILDEPTH=ZDTOT, PSOILGRID=PSOILGRID, &
- KWG_LAYER=IWG_LAYER )
- IF (LWG_LAYER) KWG_LAYER(:,:) = IWG_LAYER(:,:)
-!
- IF (LROOTFRAC .OR. LROOTFRACGV) THEN
-!
- CALL AV_PGD(DTCO, &
- ZROOT_LIN(:,:),PCOVER,XDATA_ROOT_LIN(:,:),YDIF,'ARI',OCOVER,KDECADE=KDECADE)
- IF (LROOTFRAC) THEN
- CALL AV_PGD(DTCO, &
- ZROOT_EXT(:,:),PCOVER,XDATA_ROOT_EXTINCTION(:,:),YDIF,'ARI',OCOVER,KDECADE=KDECADE)
- CALL INI_DATA_ROOTFRAC(PDG,PDROOT,ZROOT_EXT,ZROOT_LIN,PROOTFRAC)
- ENDIF
- IF (LROOTFRACGV) THEN
- CALL AV_PGD(DTCO, &
- ZROOT_EXT(:,:),PCOVER,XDATA_ROOT_EXTINCTIONGV(:,:),YDIF,'ARI',OCOVER,KDECADE=KDECADE)
- CALL INI_DATA_ROOTFRAC(PDG,PDROOT,ZROOT_EXT,ZROOT_LIN, &
- PROOTFRACGV,OGV=LROOTFRACGV)
- ENDIF
-!
- ENDIF
-!
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('CONVERT_COVER_TEB_VEG:SET_COVER_DG',1,ZHOOK_HANDLE)
-END SUBROUTINE SET_COVER_DG
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE CONVERT_COVER_TEB_VEG
diff --git a/src/SURFEX/convert_patch_garden.F90 b/src/SURFEX/convert_patch_garden.F90
deleted file mode 100644
index d907224ed5359f9789b8692acffa68ec06d99344..0000000000000000000000000000000000000000
--- a/src/SURFEX/convert_patch_garden.F90
+++ /dev/null
@@ -1,182 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-!#############################################################
-SUBROUTINE CONVERT_PATCH_GARDEN (DTCO, DTI, I, TGDO, TGDPE, TGDP, TOP, TVG, &
- KLU,KDECADE)
-!#############################################################
-!
-!!**** *CONVERT_PATCH_GARDEN* - routine to initialize GARDEN parameters
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! A. Lemonsu *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 09/2009
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_TEB_GARDEN_OPTION_n, ONLY : TEB_GARDEN_OPTIONS_t
-USE MODD_TEB_GARDEN_PGD_EVOL_n, ONLY : TEB_GARDEN_PGD_EVOL_t
-USE MODD_TEB_GARDEN_PGD_n, ONLY : TEB_GARDEN_PGD_t
-USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
-!
-USE MODD_TYPE_DATE_SURF, ONLY: DATE_TIME
-!
-USE MODI_CONVERT_PATCH_ISBA
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
-!
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(TEB_GARDEN_OPTIONS_t), INTENT(INOUT) :: TGDO
-TYPE(TEB_GARDEN_PGD_EVOL_t), INTENT(INOUT) :: TGDPE
-TYPE(TEB_GARDEN_PGD_t), INTENT(INOUT) :: TGDP
-TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
-!
-INTEGER, INTENT(IN) :: KLU ! number of points
-INTEGER, INTENT(IN) :: KDECADE ! number of decades
-!
-!
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-REAL, DIMENSION(KLU,1) :: ZLAI
-REAL, DIMENSION(KLU,1) :: ZVEG
-REAL, DIMENSION(KLU,1) :: ZZ0
-REAL, DIMENSION(KLU,1) :: ZEMIS
-REAL, DIMENSION(KLU,1) :: ZRSMIN
-REAL, DIMENSION(KLU,1) :: ZGAMMA
-REAL, DIMENSION(KLU,1) :: ZWRMAX_CF
-REAL, DIMENSION(KLU,1) :: ZRGL
-REAL, DIMENSION(KLU,1) :: ZCV
-REAL, DIMENSION(KLU,1) :: ZGMES
-REAL, DIMENSION(KLU,1) :: ZBSLAI
-REAL, DIMENSION(KLU,1) :: ZLAIMIN
-REAL, DIMENSION(KLU,1) :: ZSEFOLD
-REAL, DIMENSION(KLU,1) :: ZGC
-REAL, DIMENSION(KLU,1) :: ZDMAX
-REAL, DIMENSION(KLU,1) :: ZF2I
-REAL, DIMENSION(KLU,1) :: ZALBNIR_VEG
-REAL, DIMENSION(KLU,1) :: ZALBVIS_VEG
-REAL, DIMENSION(KLU,1) :: ZALBUV_VEG
-REAL, DIMENSION(KLU,1) :: ZCE_NITRO
-REAL, DIMENSION(KLU,1) :: ZCF_NITRO
-REAL, DIMENSION(KLU,1) :: ZCNA_NITRO
-REAL, DIMENSION(KLU,1) :: ZRE25
-REAL, DIMENSION(KLU,1) :: ZH_TREE
-REAL, DIMENSION(KLU,1) :: ZZ0_O_Z0H
-REAL, DIMENSION(KLU,1) :: ZD_ICE
-REAL, DIMENSION(KLU,TGDO%NGROUND_LAYER,1) :: ZROOTFRAC
-REAL, DIMENSION(KLU,TGDO%NGROUND_LAYER,1) :: ZDG
-REAL, DIMENSION(KLU,1) :: ZDROOT
-REAL, DIMENSION(KLU,1) :: ZDG2
-INTEGER, DIMENSION(KLU,1) :: IWG_LAYER
-LOGICAL, DIMENSION(KLU,1) :: GSTRESS
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-! Initialisation for IO
-!
-IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_GARDEN',0,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-!
- CALL CONVERT_PATCH_ISBA(DTCO, DTI, I, &
- TVG%CISBA,KDECADE,KDECADE,TOP%XCOVER,TOP%LCOVER,TVG%CPHOTO,.FALSE., &
- .FALSE.,TVG%LTR_ML,'GRD',PVEG=ZVEG,PLAI=ZLAI, &
- PRSMIN=ZRSMIN,PGAMMA=ZGAMMA,PWRMAX_CF=ZWRMAX_CF, &
- PRGL=ZRGL,PCV=ZCV,PSOILGRID=TGDO%XSOILGRID, &
- PDG=ZDG,KWG_LAYER=IWG_LAYER,PDROOT=ZDROOT,PDG2=ZDG2, &
- PZ0=ZZ0,PZ0_O_Z0H=ZZ0_O_Z0H, &
- PALBNIR_VEG=ZALBNIR_VEG,PALBVIS_VEG=ZALBVIS_VEG, &
- PALBUV_VEG=ZALBUV_VEG,PEMIS_ECO=ZEMIS, &
- PVEGTYPE=TGDP%XVEGTYPE,PROOTFRAC=ZROOTFRAC, &
- PGMES=ZGMES,PBSLAI=ZBSLAI,PLAIMIN=ZLAIMIN, &
- PSEFOLD=ZSEFOLD,PGC=ZGC, &
- PDMAX=ZDMAX,PF2I=ZF2I,OSTRESS=GSTRESS,PH_TREE=ZH_TREE, &
- PRE25=ZRE25,PCE_NITRO=ZCE_NITRO,PCF_NITRO=ZCF_NITRO, &
- PCNA_NITRO=ZCNA_NITRO,PD_ICE=ZD_ICE )
-!
-TGDPE%CUR%XVEG = ZVEG(:,1)
-TGDPE%CUR%XLAI = ZLAI(:,1)
-TGDPE%CUR%XZ0 = ZZ0(:,1)
-TGDPE%CUR%XEMIS = ZEMIS(:,1)
-TGDP%XRSMIN = ZRSMIN(:,1)
-TGDP%XGAMMA = ZGAMMA(:,1)
-TGDP%XWRMAX_CF = ZWRMAX_CF(:,1)
-TGDP%XRGL = ZRGL(:,1)
-TGDP%XCV = ZCV(:,1)
-TGDP%XGMES = ZGMES(:,1)
-TGDP%XBSLAI = ZBSLAI(:,1)
-TGDP%XLAIMIN = ZLAIMIN(:,1)
-TGDP%XSEFOLD = ZSEFOLD(:,1)
-TGDP%XGC = ZGC(:,1)
-TGDP%XDMAX = ZDMAX(:,1)
-TGDP%XF2I = ZF2I(:,1)
-TGDP%LSTRESS = GSTRESS(:,1)
-TGDP%XALBNIR_VEG = ZALBNIR_VEG(:,1)
-TGDP%XALBVIS_VEG = ZALBVIS_VEG(:,1)
-TGDP%XALBUV_VEG = ZALBUV_VEG(:,1)
-TGDP%XCE_NITRO = ZCE_NITRO(:,1)
-TGDP%XCF_NITRO = ZCF_NITRO(:,1)
-TGDP%XCNA_NITRO = ZCNA_NITRO(:,1)
-TGDP%XH_TREE = ZH_TREE(:,1)
-TGDP%XRE25 = ZRE25(:,1)
-TGDP%XROOTFRAC = ZROOTFRAC(:,:,1)
-TGDP%XDG = ZDG(:,:,1)
-TGDP%XDROOT = ZDROOT(:,1)
-TGDP%XDG2 = ZDG2(:,1)
-TGDP%NWG_LAYER = IWG_LAYER(:,1)
-TGDP%XZ0_O_Z0H = ZZ0_O_Z0H(:,1)
-TGDP%XD_ICE = ZD_ICE(:,1)
-!
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_GARDEN',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-!
-END SUBROUTINE CONVERT_PATCH_GARDEN
diff --git a/src/SURFEX/convert_patch_isba.F90 b/src/SURFEX/convert_patch_isba.F90
index ffbfb5fa1c7ca18b62ffc2049bf33f1a8925723d..0ad47ed03181fa254b9bb6478e062eaa474c80b7 100644
--- a/src/SURFEX/convert_patch_isba.F90
+++ b/src/SURFEX/convert_patch_isba.F90
@@ -3,23 +3,9 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE CONVERT_PATCH_ISBA (DTCO, DTI, I, &
- HISBA,KDECADE,KDECADE2,PCOVER,OCOVER,&
- HPHOTO,OAGRIP,OPERM,OTR_ML,HSFTYPE, &
- PVEG,PLAI,PRSMIN,PGAMMA,PWRMAX_CF, &
- PRGL,PCV,PSOILGRID,PDG,KWG_LAYER, &
- PDROOT,PDG2,PZ0,PZ0_O_Z0H, &
- PALBNIR_VEG,PALBVIS_VEG,PALBUV_VEG, &
- PEMIS_ECO,PVEGTYPE,PROOTFRAC, &
- PGMES,PBSLAI,PLAIMIN,PSEFOLD,PGC, &
- PDMAX, PF2I, OSTRESS, PH_TREE, PRE25, &
- PCE_NITRO, PCF_NITRO, PCNA_NITRO, &
- PD_ICE, PWG1, &
- PALBNIR_SOIL,PALBVIS_SOIL,PALBUV_SOIL, &
- TPSEED, TPREAP, PWATSUP, PIRRIG, &
- PGNDLITTER, PRGLGV, &
- PGAMMAGV, PRSMINGV, PROOTFRACGV, &
- PWRMAX_CFGV, PLAIGV, PZ0LITTER, PH_VEG )
+ SUBROUTINE CONVERT_PATCH_ISBA (DTCO, DTV, IO, KDEC, KDEC2, PCOVER, OCOVER,&
+ OAGRIP, HSFTYPE, KPATCH, KK, PK, PEK, OFIX, OTIME, &
+ OMEB, OIRR, OALB, OUPDATE_ALB, PSOILGRID, PWG1, PWSAT, PPERM )
! ##############################################################
!
!!**** *CONVERT_PATCH_ISBA*
@@ -68,7 +54,9 @@
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+!
+USE MODD_ISBA_n, ONLY : ISBA_P_t, ISBA_PE_t, ISBA_K_t
!
USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, NVT_NO, NVT_ROCK, NVT_SNOW
!
@@ -92,12 +80,7 @@ USE MODD_DATA_COVER, ONLY : XDATA_LAI, XDATA_H_TREE, &
XDATA_GMES_ST, XDATA_BSLAI_ST, &
XDATA_SEFOLD_ST, XDATA_GC_ST, &
XDATA_DMAX_ST, XDATA_WATSUP, &
- XDATA_GNDLITTER, &
- XDATA_RGLGV, XDATA_GAMMAGV, &
- XDATA_RSMINGV, XDATA_ROOT_DEPTHGV, &
- XDATA_WRMAX_CFGV, XDATA_LAIGV, &
- XDATA_Z0LITTER, XDATA_H_VEG, &
- XDATA_ROOT_EXTINCTIONGV, &
+ XDATA_GNDLITTER, XDATA_Z0LITTER, XDATA_H_VEG, &
TDATA_SEED, TDATA_REAP,XDATA_IRRIG, &
XDATA_ROOT_DEPTH, XDATA_GROUND_DEPTH, &
XDATA_ROOT_EXTINCTION, XDATA_ROOT_LIN
@@ -106,7 +89,7 @@ USE MODD_DATA_COVER, ONLY : XDATA_LAI, XDATA_H_TREE, &
USE MODD_TREEDRAG, ONLY : LTREEDRAG
!
USE MODI_AV_PGD_PARAM
-USE MODI_AV_PGD
+USE MODI_AV_PGD_1P
USE MODI_SOIL_ALBEDO
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -119,87 +102,42 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
!
- CHARACTER(LEN=*), INTENT(IN) :: HISBA ! type of soil (Force-Restore OR Diffusion)
-INTEGER, INTENT(IN) :: KDECADE
-INTEGER, INTENT(IN) :: KDECADE2
+INTEGER, INTENT(IN) :: KDEC
+INTEGER, INTENT(IN) :: KDEC2
REAL, DIMENSION(:,:), INTENT(IN) :: PCOVER
LOGICAL, DIMENSION(:), INTENT(IN) :: OCOVER
- CHARACTER(LEN=*), INTENT(IN) :: HPHOTO ! type of photosynthesis
LOGICAL, INTENT(IN) :: OAGRIP
-LOGICAL, INTENT(IN) :: OPERM
-LOGICAL, INTENT(IN) :: OTR_ML
- CHARACTER(LEN=*), INTENT(IN) :: HSFTYPE ! nature / garden
+CHARACTER(LEN=*), INTENT(IN) :: HSFTYPE ! nature / garden
+INTEGER, INTENT(IN) :: KPATCH
+!
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
+LOGICAL, INTENT(IN) :: OFIX
+LOGICAL, INTENT(IN) :: OTIME
+LOGICAL, INTENT(IN) :: OMEB
+LOGICAL, INTENT(IN) :: OIRR
+LOGICAL, INTENT(IN) :: OALB
+LOGICAL, INTENT(IN) :: OUPDATE_ALB
!
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PWG1
+REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PWG1
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PWSAT
+REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PPERM
!
REAL, DIMENSION(:) , OPTIONAL, INTENT(IN) :: PSOILGRID
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PVEG
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PLAI
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PRSMIN
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PGAMMA
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PWRMAX_CF
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PRGL
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PCV
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PDG
-INTEGER, DIMENSION(:,:),OPTIONAL, INTENT(OUT) :: KWG_LAYER
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PDROOT
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PDG2
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PZ0
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PZ0_O_Z0H
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PALBNIR_VEG
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PALBVIS_VEG
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PALBUV_VEG
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PEMIS_ECO
-!
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PVEGTYPE
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PROOTFRAC
-!
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PGMES
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PBSLAI
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PLAIMIN
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PSEFOLD
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PGC
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PDMAX
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PF2I
-LOGICAL, DIMENSION(:,:),OPTIONAL, INTENT(OUT) :: OSTRESS
-!
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PH_TREE
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PRE25
-!
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PCE_NITRO
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PCF_NITRO
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PCNA_NITRO
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PD_ICE
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PALBNIR_SOIL
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PALBVIS_SOIL
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PALBUV_SOIL
-!
-TYPE(DATE_TIME), DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: TPSEED
-TYPE(DATE_TIME), DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: TPREAP
-!
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PWATSUP
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PIRRIG
-!
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PGNDLITTER
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PRGLGV
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PGAMMAGV
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PRSMINGV
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PROOTFRACGV
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PWRMAX_CFGV
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PLAIGV
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PZ0LITTER
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PH_VEG
!
!* 0.2 Declaration of local variables
! ------------------------------
!
+REAL, DIMENSION(:), ALLOCATABLE :: ZWORKI
CHARACTER(LEN=3) :: YTREE, YNAT, YLAI, YVEG, YBAR, YDIF
!
INTEGER :: JLAYER ! loop counter on layers
-INTEGER :: JVEGTYPE ! loop counter on vegtypes
+INTEGER :: JVEG ! loop counter on vegtypes
!
LOGICAL :: GDATA ! Flag where initialization can be done
! ! either with ecoclimap of data fields specified
@@ -234,7 +172,7 @@ IF (HSFTYPE=='NAT') THEN
YBAR='BAR'
YDIF='DVG'
GDATA=.TRUE.
- ISIZE_LMEB_PATCH = COUNT(I%LMEB_PATCH(:))
+ ISIZE_LMEB_PATCH = COUNT(IO%LMEB_PATCH(:))
ELSEIF (HSFTYPE=='GRD') THEN
YNAT='GRD'
YTREE='GRT'
@@ -246,584 +184,478 @@ ELSEIF (HSFTYPE=='GRD') THEN
ISIZE_LMEB_PATCH = 0
ENDIF
!
-! vegtypes fraction
-! -----------------
+IF (OFIX) THEN
+ !
+ !* soil layers and root fraction
+! -----------------------------
+ !
+ ! compute soil layers (and root fraction if DIF)
+ !
+ CALL SET_GRID_PARAM(SIZE(PK%XDG,1),SIZE(PK%XDG,2))
!
-IF (PRESENT(PVEGTYPE)) THEN
- IF (GDATA .AND. DTI%LDATA_VEGTYPE) THEN
- PVEGTYPE=DTI%XPAR_VEGTYPE
- ELSE
- !classical ecoclimap case
- DO JVEGTYPE=1,NVEGTYPE
- CALL AV_PGD(DTCO, &
- PVEGTYPE(:,JVEGTYPE),PCOVER ,DTCO%XDATA_VEGTYPE(:,JVEGTYPE),YNAT,'ARI',OCOVER)
- END DO
+! D ICE
+! -----
+!
+ IF (IO%CISBA/='DIF') THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_DICE)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PK%XD_ICE,DTV%XPAR_VEGTYPE,DTV%XPAR_DICE,YNAT,'ARI',PK%NR_P,IO%NPATCH,KPATCH)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PK%XD_ICE,PCOVER,XDATA_DICE(:,:),YNAT,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
ENDIF
-ENDIF
!
-! VEG
-! ----
-IF (PRESENT(PVEG)) THEN
- IF (GDATA .AND. DTI%LDATA_VEG) THEN
- CALL AV_PGD_PARAM(DTI, &
- PVEG,DTI%XPAR_VEGTYPE,DTI%XPAR_VEG(:,KDECADE2,:),YNAT,'ARI')
+ IF (GDATA .AND. ANY(DTV%LDATA_Z0_O_Z0H)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PK%XZ0_O_Z0H,DTV%XPAR_VEGTYPE,DTV%XPAR_Z0_O_Z0H,YNAT,'ARI',PK%NR_P,IO%NPATCH,KPATCH)
ELSE
- CALL AV_PGD(DTCO, &
- PVEG,PCOVER,XDATA_VEG(:,KDECADE,:),YNAT,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD_1P(DTCO, PK%XZ0_O_Z0H,PCOVER,XDATA_Z0_O_Z0H,YNAT,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
-ENDIF
!
-! GNDLITTER
-! ---------
-IF (PRESENT(PGNDLITTER)) THEN
- IF (GDATA .AND. DTI%LDATA_GNDLITTER) THEN
- CALL AV_PGD_PARAM(DTI, &
- PGNDLITTER,DTI%XPAR_VEGTYPE,DTI%XPAR_GNDLITTER(:,KDECADE2,:),YNAT,'ARI',KDECADE=KDECADE2)
- ELSE
- CALL AV_PGD(DTCO, &
- PGNDLITTER,PCOVER,XDATA_GNDLITTER(:,KDECADE,:),YNAT,'ARI',OCOVER,KDECADE=KDECADE)
+ IF (IO%CPHOTO/='NON'.OR.LTREEDRAG) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_H_TREE)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PK%XH_TREE,DTV%XPAR_VEGTYPE,DTV%XPAR_H_TREE,YTREE,'ARI',PK%NR_P,IO%NPATCH,KPATCH)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PK%XH_TREE,PCOVER,XDATA_H_TREE(:,:),YTREE,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ ENDIF
+!
+ IF (IO%CPHOTO/='NON') THEN
+ !
+ IF (SIZE(PK%XRE25)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_RE25)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PK%XRE25,DTV%XPAR_VEGTYPE,DTV%XPAR_RE25,YNAT,'ARI',PK%NR_P,IO%NPATCH,KPATCH)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PK%XRE25,PCOVER,XDATA_RE25,YNAT,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ ENDIF
+ !
+ IF (SIZE(PK%XDMAX)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_DMAX)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PK%XDMAX,DTV%XPAR_VEGTYPE,DTV%XPAR_DMAX,YTREE,'ARI',PK%NR_P,IO%NPATCH,KPATCH)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PK%XDMAX,PCOVER,XDATA_DMAX_ST,YTREE,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ ENDIF
+ !
ENDIF
+!
ENDIF
!
-! LAI
+IF (OTIME) THEN
+!
+ IF (.NOT.OUPDATE_ALB) THEN
+! VEG
! ----
-IF (PRESENT(PLAI)) THEN
- IF (GDATA .AND. DTI%LDATA_LAI) THEN
- CALL AV_PGD_PARAM(DTI, &
- PLAI,DTI%XPAR_VEGTYPE,DTI%XPAR_LAI(:,KDECADE2,:),YVEG,'ARI',KDECADE=KDECADE2)
+ IF (GDATA .AND. ANY(DTV%LDATA_VEG)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, PEK%XVEG,DTV%XPAR_VEGTYPE,DTV%XPAR_VEG(:,KDEC2,:),&
+ YNAT,'ARI',PK%NR_P,IO%NPATCH,KPATCH)
ELSE
- CALL AV_PGD(DTCO, &
- PLAI,PCOVER,XDATA_LAI(:,KDECADE,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD_1P(DTCO, PEK%XVEG,PCOVER,XDATA_VEG(:,KDEC,:),YNAT,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
-ENDIF
!
-! LAIGV
+! LAI
! ----
-IF (PRESENT(PLAIGV)) THEN
- IF (GDATA .AND. DTI%LDATA_LAIGV) THEN
- CALL AV_PGD_PARAM(DTI, &
- PLAIGV,DTI%XPAR_VEGTYPE,DTI%XPAR_LAIGV(:,KDECADE2,:),YVEG,'ARI',KDECADE=KDECADE2)
+ IF (GDATA .AND. ANY(DTV%LDATA_LAI)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XLAI,DTV%XPAR_VEGTYPE,DTV%XPAR_LAI(:,KDEC2,:),YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
ELSE
- CALL AV_PGD(DTCO, &
- PLAIGV,PCOVER,XDATA_LAIGV(:,KDECADE,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD_1P(DTCO, PEK%XLAI,PCOVER,XDATA_LAI(:,KDEC,:),YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
-ENDIF
!
! EMIS
! ----
!emis needs VEG by vegtypes is changed at this step
-IF (PRESENT(PEMIS_ECO)) THEN
- IF (GDATA .AND. DTI%LDATA_EMIS) THEN
- CALL AV_PGD_PARAM(DTI, &
- PEMIS_ECO,DTI%XPAR_VEGTYPE,DTI%XPAR_EMIS(:,KDECADE2,:),YNAT,'ARI')
- ELSE
- CALL AV_PGD(DTCO, &
- PEMIS_ECO ,PCOVER ,XDATA_EMIS_ECO (:,KDECADE,:),YNAT,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
-ENDIF
-! H_VEG
-! -----
-IF (PRESENT(PH_VEG)) THEN
- IF (GDATA .AND. DTI%LDATA_H_VEG) THEN
- CALL AV_PGD_PARAM(DTI, &
- PH_VEG,DTI%XPAR_VEGTYPE,DTI%XPAR_H_VEG(:,KDECADE2,:),YVEG,'ARI',KDECADE=KDECADE2)
+ IF (GDATA .AND. ANY(DTV%LDATA_EMIS)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XEMIS ,DTV%XPAR_VEGTYPE,DTV%XPAR_EMIS(:,KDEC2,:),YNAT,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH)
ELSE
- CALL AV_PGD(DTCO, &
- PH_VEG,PCOVER,XDATA_H_VEG(:,KDECADE,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
-! In case of MEB, force 0<PH_VEG<XUNDEF for those patches where LMEB_PATCH=.T.
- IF (ISIZE_LMEB_PATCH>0)THEN
- ALLOCATE(ZH_VEG(SIZE(PH_VEG,1)))
- DO JJ=1,SIZE(I%LMEB_PATCH)
- IF(I%LMEB_PATCH(JJ))THEN
- ZH_VEG=PH_VEG(:,JJ)
- WHERE(ZH_VEG>1000.) ZH_VEG=0.
- ZH_VEG=MAX(ZH_VEG,1.0E-3)
- PH_VEG(:,JJ)=ZH_VEG
- ENDIF
- ENDDO
+ CALL AV_PGD_1P(DTCO, PEK%XEMIS ,PCOVER ,XDATA_EMIS_ECO (:,KDEC,:),YNAT,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
-ENDIF
-!
!
! Z0V
! ----
-IF (PRESENT(PZ0)) THEN
- IF (GDATA .AND. DTI%LDATA_Z0) THEN
- CALL AV_PGD_PARAM(DTI, &
- PZ0,DTI%XPAR_VEGTYPE,DTI%XPAR_Z0(:,KDECADE2,:),YNAT,'CDN')
+ IF (GDATA .AND. ANY(DTV%LDATA_Z0)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XZ0,DTV%XPAR_VEGTYPE,DTV%XPAR_Z0(:,KDEC2,:),YNAT,'CDN',&
+ PK%NR_P,IO%NPATCH,KPATCH)
ELSE
- CALL AV_PGD(DTCO, &
- PZ0 ,PCOVER ,XDATA_Z0 (:,KDECADE,:),YNAT,'CDN',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD_1P(DTCO, PEK%XZ0 ,PCOVER ,XDATA_Z0 (:,KDEC,:),YNAT,'CDN',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
-ENDIF
!
-! Z0LITTER
-! --------
-IF (PRESENT(PZ0LITTER)) THEN
- IF (GDATA .AND. DTI%LDATA_Z0LITTER) THEN
- CALL AV_PGD_PARAM(DTI, &
- PZ0LITTER,DTI%XPAR_VEGTYPE,DTI%XPAR_Z0LITTER(:,KDECADE2,:),YNAT,'CDN')
+ ENDIF
+
+ IF (GDATA .AND. ANY(DTV%LDATA_ALBNIR_VEG)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XALBNIR_VEG,DTV%XPAR_VEGTYPE,DTV%XPAR_ALBNIR_VEG(:,KDEC2,:),YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSEIF (IO%CALBEDO=='CM13') THEN
+ CALL AV_PGD_1P(DTCO, PEK%XALBNIR_VEG,PCOVER,XDATA_ALB_VEG_NIR(:,KDEC,:),YVEG,'ARI', OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ELSE
- CALL AV_PGD(DTCO, &
- PZ0LITTER ,PCOVER ,XDATA_Z0LITTER (:,KDECADE,:),YNAT,'CDN',OCOVER)
+ CALL AV_PGD_1P(DTCO, PEK%XALBNIR_VEG,PCOVER,XDATA_ALBNIR_VEG,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
-ENDIF
-!
!
-!* soil layers and root fraction
-! -----------------------------
-!
-IF ( PRESENT(PDG)) THEN
- !
- ! compute soil layers (and root fraction if DIF)
- !
- CALL SET_GRID_PARAM(SIZE(PDG,1),SIZE(PDG,2),SIZE(PDG,3),PRESENT(PDG2), &
- PRESENT(PDROOT),PRESENT(KWG_LAYER),PRESENT(PROOTFRAC), &
- PRESENT(PROOTFRACGV).AND.(ISIZE_LMEB_PATCH>0) )
- !
-ENDIF
-!
-! D ICE
-! -----
+ IF (GDATA .AND. ANY(DTV%LDATA_ALBVIS_VEG)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XALBVIS_VEG,DTV%XPAR_VEGTYPE,DTV%XPAR_ALBVIS_VEG(:,KDEC2,:),YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSEIF (IO%CALBEDO=='CM13') THEN
+ CALL AV_PGD_1P(DTCO, PEK%XALBVIS_VEG,PCOVER,XDATA_ALB_VEG_VIS(:,KDEC,:),YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XALBVIS_VEG,PCOVER,XDATA_ALBVIS_VEG,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
!
-IF (PRESENT(PD_ICE).AND.HISBA/='DIF') THEN
- IF (GDATA .AND. DTI%LDATA_DICE) THEN
- CALL AV_PGD_PARAM(DTI, &
- PD_ICE,DTI%XPAR_VEGTYPE,DTI%XPAR_DICE,YNAT,'ARI')
+ IF ((IO%CALBEDO=='CM13'.OR.IO%LTR_ML)) THEN
+ PEK%XALBUV_VEG(:)=PEK%XALBVIS_VEG(:)
+ ELSEIF (GDATA .AND. ANY(DTV%LDATA_ALBUV_VEG)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XALBUV_VEG,DTV%XPAR_VEGTYPE,DTV%XPAR_ALBUV_VEG(:,KDEC2,:),YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
ELSE
- CALL AV_PGD(DTCO, &
- PD_ICE,PCOVER,XDATA_DICE(:,:),YNAT,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD_1P(DTCO, PEK%XALBUV_VEG,PCOVER,XDATA_ALBUV_VEG,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
-ENDIF
!
+ IF (.NOT.OUPDATE_ALB) THEN
! Other parameters
! ----------------
-IF (PRESENT(PRSMIN)) THEN
- IF( SIZE(PRSMIN)>0) THEN
- IF (GDATA .AND. DTI%LDATA_RSMIN) THEN
- CALL AV_PGD_PARAM(DTI, &
- PRSMIN,DTI%XPAR_VEGTYPE,DTI%XPAR_RSMIN,YLAI,'INV',KDECADE=KDECADE2)
- ELSE
- CALL AV_PGD(DTCO, &
- PRSMIN,PCOVER,XDATA_RSMIN,YLAI,'INV',OCOVER,KDECADE=KDECADE)
- ENDIF
- ENDIF
-ENDIF
-!
-IF (PRESENT(PRSMINGV)) THEN
- IF( SIZE(PRSMINGV)>0) THEN
- IF (GDATA .AND. DTI%LDATA_RSMINGV) THEN
- CALL AV_PGD_PARAM(DTI, &
- PRSMINGV,DTI%XPAR_VEGTYPE,DTI%XPAR_RSMINGV,YLAI,'INV',KDECADE=KDECADE2)
+ IF( SIZE(PEK%XRSMIN)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_RSMIN)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XRSMIN,DTV%XPAR_VEGTYPE,DTV%XPAR_RSMIN,YLAI,'INV',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
ELSE
- CALL AV_PGD(DTCO, &
- PRSMINGV,PCOVER,XDATA_RSMINGV,YLAI,'INV',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD_1P(DTCO, PEK%XRSMIN,PCOVER,XDATA_RSMIN,YLAI,'INV',&
+ OCOVER,PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
ENDIF
-ENDIF
!
-IF (PRESENT(PGAMMA)) THEN
- IF (GDATA .AND. DTI%LDATA_GAMMA) THEN
- CALL AV_PGD_PARAM(DTI, &
- PGAMMA,DTI%XPAR_VEGTYPE,DTI%XPAR_GAMMA,YVEG,'ARI',KDECADE=KDECADE2)
+ IF (GDATA .AND. ANY(DTV%LDATA_GAMMA)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XGAMMA,DTV%XPAR_VEGTYPE,DTV%XPAR_GAMMA,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
ELSE
- CALL AV_PGD(DTCO, &
- PGAMMA,PCOVER,XDATA_GAMMA,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD_1P(DTCO, PEK%XGAMMA,PCOVER,XDATA_GAMMA,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
-ENDIF
!
-IF (PRESENT(PGAMMAGV)) THEN
- IF (GDATA .AND. DTI%LDATA_GAMMAGV) THEN
- CALL AV_PGD_PARAM(DTI, &
- PGAMMAGV,DTI%XPAR_VEGTYPE,DTI%XPAR_GAMMAGV,YVEG,'ARI',KDECADE=KDECADE2)
+ IF (GDATA .AND. ANY(DTV%LDATA_WRMAX_CF)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XWRMAX_CF,DTV%XPAR_VEGTYPE,DTV%XPAR_WRMAX_CF,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
ELSE
- CALL AV_PGD(DTCO, &
- PGAMMAGV,PCOVER,XDATA_GAMMAGV,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD_1P(DTCO, PEK%XWRMAX_CF,PCOVER,XDATA_WRMAX_CF,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
-ENDIF
!
-IF (PRESENT(PWRMAX_CF)) THEN
- IF (GDATA .AND. DTI%LDATA_WRMAX_CF) THEN
- CALL AV_PGD_PARAM(DTI, &
- PWRMAX_CF,DTI%XPAR_VEGTYPE,DTI%XPAR_WRMAX_CF,YVEG,'ARI',KDECADE=KDECADE2)
+ IF (GDATA .AND. ANY(DTV%LDATA_RGL)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XRGL,DTV%XPAR_VEGTYPE,DTV%XPAR_RGL,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
ELSE
- CALL AV_PGD(DTCO, &
- PWRMAX_CF,PCOVER,XDATA_WRMAX_CF,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD_1P(DTCO, PEK%XRGL,PCOVER,XDATA_RGL,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
-ENDIF
!
-IF (PRESENT(PWRMAX_CFGV)) THEN
- IF (GDATA .AND. DTI%LDATA_WRMAX_CFGV) THEN
- CALL AV_PGD_PARAM(DTI, &
- PWRMAX_CFGV,DTI%XPAR_VEGTYPE,DTI%XPAR_WRMAX_CFGV,YVEG,'ARI',KDECADE=KDECADE2)
+ IF (GDATA .AND. ANY(DTV%LDATA_CV)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XCV,DTV%XPAR_VEGTYPE,DTV%XPAR_CV,YVEG,'INV',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
ELSE
- CALL AV_PGD(DTCO, &
- PWRMAX_CFGV,PCOVER,XDATA_WRMAX_CFGV,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD_1P(DTCO, PEK%XCV,PCOVER,XDATA_CV,YVEG,'INV',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
-ENDIF
!
-IF (PRESENT(PRGL)) THEN
- IF (GDATA .AND. DTI%LDATA_RGL) THEN
- CALL AV_PGD_PARAM(DTI, &
- PRGL,DTI%XPAR_VEGTYPE,DTI%XPAR_RGL,YVEG,'ARI',KDECADE=KDECADE2)
- ELSE
- CALL AV_PGD(DTCO, &
- PRGL,PCOVER,XDATA_RGL,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
-ENDIF
-!
-IF (PRESENT(PRGLGV)) THEN
- IF (GDATA .AND. DTI%LDATA_RGLGV) THEN
- CALL AV_PGD_PARAM(DTI, &
- PRGLGV,DTI%XPAR_VEGTYPE,DTI%XPAR_RGLGV,YVEG,'ARI',KDECADE=KDECADE2)
- ELSE
- CALL AV_PGD(DTCO, &
- PRGLGV,PCOVER,XDATA_RGLGV,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
-ENDIF
-!
-IF (PRESENT(PCV)) THEN
- IF (GDATA .AND. DTI%LDATA_CV) THEN
- CALL AV_PGD_PARAM(DTI, &
- PCV,DTI%XPAR_VEGTYPE,DTI%XPAR_CV,YVEG,'INV',KDECADE=KDECADE2)
- ELSE
- CALL AV_PGD(DTCO, &
- PCV,PCOVER,XDATA_CV,YVEG,'INV',OCOVER,KDECADE=KDECADE)
- ENDIF
-ENDIF
+ IF (ISIZE_LMEB_PATCH>0 .OR. IO%CPHOTO/='NON') THEN
-IF (PRESENT(PZ0_O_Z0H)) THEN
- IF (GDATA .AND. DTI%LDATA_Z0_O_Z0H) THEN
- CALL AV_PGD_PARAM(DTI, &
- PZ0_O_Z0H,DTI%XPAR_VEGTYPE,DTI%XPAR_Z0_O_Z0H,YNAT,'ARI')
- ELSE
- CALL AV_PGD(DTCO, &
- PZ0_O_Z0H,PCOVER,XDATA_Z0_O_Z0H,YNAT,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
-ENDIF
-!
-IF (PRESENT(PALBNIR_VEG)) THEN
- IF (GDATA .AND. DTI%LDATA_ALBNIR_VEG) THEN
- CALL AV_PGD_PARAM(DTI, &
- PALBNIR_VEG,DTI%XPAR_VEGTYPE,DTI%XPAR_ALBNIR_VEG,YVEG,'ARI',KDECADE=KDECADE2)
- ELSEIF (I%CALBEDO=='CM13') THEN
- CALL AV_PGD(DTCO, &
- PALBNIR_VEG,PCOVER,XDATA_ALB_VEG_NIR(:,KDECADE,:),YVEG,'ARI',&
- OCOVER,KDECADE=KDECADE)
- ELSE
- CALL AV_PGD(DTCO, &
- PALBNIR_VEG,PCOVER,XDATA_ALBNIR_VEG,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
-ENDIF
-!
-IF (PRESENT(PALBVIS_VEG)) THEN
- IF (GDATA .AND. DTI%LDATA_ALBVIS_VEG) THEN
- CALL AV_PGD_PARAM(DTI, &
- PALBVIS_VEG,DTI%XPAR_VEGTYPE,DTI%XPAR_ALBVIS_VEG,YVEG,'ARI',KDECADE=KDECADE2)
- ELSEIF (I%CALBEDO=='CM13') THEN
- CALL AV_PGD(DTCO, &
- PALBVIS_VEG,PCOVER,XDATA_ALB_VEG_VIS(:,KDECADE,:),YVEG,'ARI',&
- OCOVER,KDECADE=KDECADE)
- ELSE
- CALL AV_PGD(DTCO, &
- PALBVIS_VEG,PCOVER,XDATA_ALBVIS_VEG,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
-ENDIF
-!
-IF (PRESENT(PALBUV_VEG)) THEN
- IF ((I%CALBEDO=='CM13'.OR.OTR_ML).AND.PRESENT(PALBVIS_VEG)) THEN
- PALBUV_VEG(:,:)=PALBVIS_VEG(:,:)
- ELSE
- IF (GDATA .AND. DTI%LDATA_ALBUV_VEG) THEN
- CALL AV_PGD_PARAM(DTI, &
- PALBUV_VEG,DTI%XPAR_VEGTYPE,DTI%XPAR_ALBUV_VEG,YVEG,'ARI',KDECADE=KDECADE2)
- ELSE
- CALL AV_PGD(DTCO, &
- PALBUV_VEG,PCOVER,XDATA_ALBUV_VEG,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
- ENDIF
-ENDIF
-!
-IF (ISIZE_LMEB_PATCH>0 .OR. HPHOTO/='NON') THEN
-
- IF (PRESENT(PBSLAI)) THEN
- IF( SIZE(PBSLAI)>0) THEN
- IF (GDATA .AND. DTI%LDATA_BSLAI) THEN
- CALL AV_PGD_PARAM(DTI, &
- PBSLAI,DTI%XPAR_VEGTYPE,DTI%XPAR_BSLAI,YVEG,'ARI',KDECADE=KDECADE2)
+ IF( SIZE(PEK%XBSLAI)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_BSLAI)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XBSLAI,DTV%XPAR_VEGTYPE,DTV%XPAR_BSLAI,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
ELSE
- IF (HPHOTO == 'AST' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT' .OR. HPHOTO == 'NCB') THEN
- CALL AV_PGD(DTCO, &
- PBSLAI,PCOVER,XDATA_BSLAI_ST,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ELSE
- CALL AV_PGD(DTCO, &
- PBSLAI,PCOVER,XDATA_BSLAI,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
+ CALL AV_PGD_1P(DTCO, PEK%XBSLAI,PCOVER,XDATA_BSLAI_ST,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
ENDIF
ENDIF
-
-ENDIF
!
-IF (HPHOTO/='NON'.OR.LTREEDRAG) THEN
- !
- IF (PRESENT(PH_TREE)) THEN
- IF (GDATA .AND. DTI%LDATA_H_TREE) THEN
- CALL AV_PGD_PARAM(DTI, &
- PH_TREE,DTI%XPAR_VEGTYPE,DTI%XPAR_H_TREE,YTREE,'ARI')
- ELSE
- CALL AV_PGD(DTCO, &
- PH_TREE,PCOVER,XDATA_H_TREE(:,:),YTREE,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
- ENDIF
+ IF (IO%CPHOTO/='NON') THEN
!
-ENDIF
-!
-IF (HPHOTO/='NON') THEN
- IF (PRESENT(PRE25)) THEN
- IF (SIZE(PRE25)>0) THEN
- IF (GDATA .AND. DTI%LDATA_RE25) THEN
- CALL AV_PGD_PARAM(DTI, &
- PRE25,DTI%XPAR_VEGTYPE,DTI%XPAR_RE25,YNAT,'ARI')
- ELSE
- CALL AV_PGD(DTCO, &
- PRE25,PCOVER,XDATA_RE25,YNAT,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
- ENDIF
- ENDIF
- !
- IF (PRESENT(PLAIMIN)) THEN
- IF (SIZE(PLAIMIN)>0) THEN
- IF (GDATA .AND. DTI%LDATA_LAIMIN) THEN
- CALL AV_PGD_PARAM(DTI, &
- PLAIMIN,DTI%XPAR_VEGTYPE,DTI%XPAR_LAIMIN,YVEG,'ARI',KDECADE=KDECADE2)
+ IF (SIZE(PEK%XLAIMIN)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_LAIMIN)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XLAIMIN,DTV%XPAR_VEGTYPE,DTV%XPAR_LAIMIN,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
ELSE
- CALL AV_PGD(DTCO, &
- PLAIMIN,PCOVER,XDATA_LAIMIN,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD_1P(DTCO, PEK%XLAIMIN,PCOVER,XDATA_LAIMIN,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
- ENDIF
- ENDIF
- !
- IF (PRESENT(PSEFOLD)) THEN
- IF (SIZE(PSEFOLD)>0) THEN
- IF (GDATA .AND. DTI%LDATA_SEFOLD) THEN
- CALL AV_PGD_PARAM(DTI, &
- PSEFOLD,DTI%XPAR_VEGTYPE,DTI%XPAR_SEFOLD,YVEG,'ARI',KDECADE=KDECADE2)
- ELSE
- IF (HPHOTO == 'AST' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT' .OR. HPHOTO == 'NCB') THEN
- CALL AV_PGD(DTCO, &
- PSEFOLD,PCOVER,XDATA_SEFOLD_ST,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ELSE
- CALL AV_PGD(DTCO, &
- PSEFOLD,PCOVER,XDATA_SEFOLD,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
- ENDIF
- ENDIF
- ENDIF
+ ENDIF
!
- IF (PRESENT(PGMES)) THEN
- IF ( SIZE(PGMES)>0) THEN
- IF (GDATA .AND. DTI%LDATA_GMES) THEN
- CALL AV_PGD_PARAM(DTI, &
- PGMES,DTI%XPAR_VEGTYPE,DTI%XPAR_GMES,YVEG,'ARI',KDECADE=KDECADE2)
+ IF (SIZE(PEK%XSEFOLD)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_SEFOLD)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XSEFOLD,DTV%XPAR_VEGTYPE,DTV%XPAR_SEFOLD,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
ELSE
- IF (HPHOTO == 'AST' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT' .OR. HPHOTO == 'NCB') THEN
- CALL AV_PGD(DTCO, &
- PGMES,PCOVER,XDATA_GMES_ST,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ELSE
- CALL AV_PGD(DTCO, &
- PGMES,PCOVER,XDATA_GMES,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
+ CALL AV_PGD_1P(DTCO, PEK%XSEFOLD,PCOVER,XDATA_SEFOLD_ST,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
ENDIF
- ENDIF
- !
- IF (PRESENT(PGC)) THEN
- IF ( SIZE(PGC)>0) THEN
- IF (GDATA .AND. DTI%LDATA_GC) THEN
- CALL AV_PGD_PARAM(DTI, &
- PGC,DTI%XPAR_VEGTYPE,DTI%XPAR_GC,YVEG,'ARI',KDECADE=KDECADE2)
+ !
+ IF ( SIZE(PEK%XGMES)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_GMES)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XGMES,DTV%XPAR_VEGTYPE,DTV%XPAR_GMES,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
ELSE
- IF (HPHOTO == 'AST' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT' .OR. HPHOTO == 'NCB') THEN
- CALL AV_PGD(DTCO, &
- PGC,PCOVER,XDATA_GC_ST,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ELSE
- CALL AV_PGD(DTCO, &
- PGC,PCOVER,XDATA_GC,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
+ CALL AV_PGD_1P(DTCO, PEK%XGMES,PCOVER,XDATA_GMES_ST,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
ENDIF
- ENDIF
- !
- IF (PRESENT(PDMAX)) THEN
- IF (SIZE(PDMAX)>0) THEN
- IF (GDATA .AND. DTI%LDATA_DMAX) THEN
- CALL AV_PGD_PARAM(DTI, &
- PDMAX,DTI%XPAR_VEGTYPE,DTI%XPAR_DMAX,YTREE,'ARI')
+ !
+ IF ( SIZE(PEK%XGC)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_GC)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XGC,DTV%XPAR_VEGTYPE,DTV%XPAR_GC,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
ELSE
- IF (HPHOTO == 'AST' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT' .OR. HPHOTO == 'NCB') THEN
- CALL AV_PGD(DTCO, &
- PDMAX,PCOVER,XDATA_DMAX_ST,YTREE,'ARI',OCOVER,KDECADE=KDECADE)
- ELSE
- CALL AV_PGD(DTCO, &
- PDMAX,PCOVER,XDATA_DMAX,YTREE,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
+ CALL AV_PGD_1P(DTCO, PEK%XGC,PCOVER,XDATA_GC_ST,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
ENDIF
- ENDIF
- !
- IF (HPHOTO/='AGS' .AND. HPHOTO/='LAI') THEN
!
- IF (PRESENT(PF2I)) THEN
- IF (SIZE(PF2I)>0) THEN
- IF (GDATA .AND. DTI%LDATA_F2I) THEN
- CALL AV_PGD_PARAM(DTI, &
- PF2I,DTI%XPAR_VEGTYPE,DTI%XPAR_F2I,YVEG,'ARI',KDECADE=KDECADE2)
- ELSE
- CALL AV_PGD(DTCO, &
- PF2I,PCOVER,XDATA_F2I,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
+ IF (SIZE(PEK%XF2I)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_F2I)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XF2I,DTV%XPAR_VEGTYPE,DTV%XPAR_F2I,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XF2I,PCOVER,XDATA_F2I,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
ENDIF
!
- IF (HPHOTO=='NIT' .OR. HPHOTO=='NCB') THEN
+ IF (IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') THEN
!
- IF (PRESENT(PCE_NITRO)) THEN
- IF (SIZE(PCE_NITRO)>0) THEN
- IF (GDATA .AND. DTI%LDATA_CE_NITRO) THEN
- CALL AV_PGD_PARAM(DTI, &
- PCE_NITRO,DTI%XPAR_VEGTYPE,DTI%XPAR_CE_NITRO,YVEG,'ARI',KDECADE=KDECADE2)
- ELSE
- CALL AV_PGD(DTCO, &
- PCE_NITRO,PCOVER,XDATA_CE_NITRO,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
+ IF (SIZE(PEK%XCE_NITRO)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_CE_NITRO)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XCE_NITRO,DTV%XPAR_VEGTYPE,DTV%XPAR_CE_NITRO,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XCE_NITRO,PCOVER,XDATA_CE_NITRO,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
ENDIF
!
- IF (PRESENT(PCF_NITRO)) THEN
- IF (SIZE(PCF_NITRO)>0) THEN
- IF (GDATA .AND. DTI%LDATA_CF_NITRO) THEN
- CALL AV_PGD_PARAM(DTI, &
- PCF_NITRO,DTI%XPAR_VEGTYPE,DTI%XPAR_CF_NITRO,YVEG,'ARI',KDECADE=KDECADE2)
- ELSE
- CALL AV_PGD(DTCO, &
- PCF_NITRO,PCOVER,XDATA_CF_NITRO,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
+ IF (SIZE(PEK%XCF_NITRO)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_CF_NITRO)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XCF_NITRO,DTV%XPAR_VEGTYPE,DTV%XPAR_CF_NITRO,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XCF_NITRO,PCOVER,XDATA_CF_NITRO,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
ENDIF
!
- IF (PRESENT(PCNA_NITRO)) THEN
- IF (SIZE(PCNA_NITRO)>0) THEN
- IF (GDATA .AND. DTI%LDATA_CNA_NITRO) THEN
- CALL AV_PGD_PARAM(DTI, &
- PCNA_NITRO,DTI%XPAR_VEGTYPE,DTI%XPAR_CNA_NITRO,YVEG,'ARI',KDECADE=KDECADE2)
- ELSE
- CALL AV_PGD(DTCO, &
- PCNA_NITRO,PCOVER,XDATA_CNA_NITRO,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
+ IF (SIZE(PEK%XCNA_NITRO)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_CNA_NITRO)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XCNA_NITRO,DTV%XPAR_VEGTYPE,DTV%XPAR_CNA_NITRO,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XCNA_NITRO,PCOVER,XDATA_CNA_NITRO,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
ENDIF
!
ENDIF
+ !
ENDIF
+!
+! STRESS
+! --------
+ IF (SIZE(PEK%LSTRESS)>0) THEN
+ CALL SET_STRESS
+ ENDIF
+!
+ ENDIF
+!
+ENDIF
+!
+IF (OMEB .AND. .NOT.OUPDATE_ALB) THEN
!
+! GNDLITTER
+! ---------
+ IF (GDATA .AND. ANY(DTV%LDATA_GNDLITTER)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, PEK%XGNDLITTER,DTV%XPAR_VEGTYPE,&
+ DTV%XPAR_GNDLITTER(:,KDEC2,:),YNAT,'ARI',PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XGNDLITTER,PCOVER,XDATA_GNDLITTER(:,KDEC,:),YNAT,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+!
+! H_VEG
+! -----
+ IF (GDATA .AND. ANY(DTV%LDATA_H_VEG)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XH_VEG,DTV%XPAR_VEGTYPE,DTV%XPAR_H_VEG(:,KDEC2,:),YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XH_VEG,PCOVER,XDATA_H_VEG(:,KDEC,:),YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+! In case of MEB, force 0<PH_VEG<XUNDEF for those patches where LMEB_PATCH=.T.
+ IF(IO%LMEB_PATCH(KPATCH))THEN
+ ALLOCATE(ZH_VEG(SIZE(PEK%XH_VEG)))
+ ZH_VEG=PEK%XH_VEG(:)
+ WHERE(ZH_VEG>1000.) ZH_VEG=0.
+ ZH_VEG=MAX(ZH_VEG,1.0E-3)
+ PEK%XH_VEG(:)=ZH_VEG
+ DEALLOCATE(ZH_VEG)
+ ENDIF
+!
+! Z0LITTER
+! --------
+ IF (GDATA .AND. ANY(DTV%LDATA_Z0LITTER)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XZ0LITTER,DTV%XPAR_VEGTYPE,DTV%XPAR_Z0LITTER(:,KDEC2,:),YNAT,'CDN',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XZ0LITTER ,PCOVER ,XDATA_Z0LITTER (:,KDEC,:),YNAT,'CDN',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+!
ENDIF
!
-IF ((HPHOTO == 'LAI' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT' .OR. HPHOTO=='NCB') .AND. OAGRIP) THEN
+IF (OIRR .AND. .NOT.OUPDATE_ALB) THEN
+!
+ IF ((IO%CPHOTO == 'NIT' .OR. IO%CPHOTO=='NCB') .AND. OAGRIP) THEN
!
! date of seeding
! ---------------
!
- IF (PRESENT(TPSEED)) THEN
- IF(SIZE(TPSEED)>0) THEN
- CALL AV_PGD (TPSEED ,PCOVER,TDATA_SEED(:,:),YVEG,'MAJ',OCOVER,KDECADE=KDECADE)
+ ALLOCATE(ZWORKI(SIZE(PEK%TSEED,1)))
+ !
+ IF(SIZE(PEK%TSEED)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_SEED_M) .AND. ANY(DTV%LDATA_SEED_D)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ ZWORKI,DTV%XPAR_VEGTYPE,DTV%XPAR_SEED_M(:,:),YVEG,'MAJ',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ PEK%TSEED(:)%TDATE%MONTH = NINT(ZWORKI(:))
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ ZWORKI,DTV%XPAR_VEGTYPE,DTV%XPAR_SEED_D(:,:),YVEG,'MAJ',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ PEK%TSEED(:)%TDATE%DAY = NINT(ZWORKI(:))
+ ELSE
+ CALL AV_PGD_1P (PEK%TSEED,PCOVER,TDATA_SEED(:,:),YVEG,'MAJ',OCOVER,&
+ PK%NR_P,IO%NPATCH, KPATCH, KDECADE=KDEC)
+ ENDIF
ENDIF
- END IF
!
! date of reaping
! ---------------
!
- IF (PRESENT(TPREAP)) THEN
- IF (SIZE(TPREAP)>0) THEN
- CALL AV_PGD (TPREAP ,PCOVER,TDATA_REAP(:,:),YVEG,'MAJ',OCOVER,KDECADE=KDECADE)
+ IF (SIZE(PEK%TREAP)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_REAP_M) .AND. ANY(DTV%LDATA_REAP_D)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ ZWORKI,DTV%XPAR_VEGTYPE,DTV%XPAR_REAP_M(:,:),YVEG,'MAJ',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ PEK%TREAP(:)%TDATE%MONTH = NINT(ZWORKI(:))
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ ZWORKI,DTV%XPAR_VEGTYPE,DTV%XPAR_REAP_D(:,:),YVEG,'MAJ',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ PEK%TREAP(:)%TDATE%DAY = NINT(ZWORKI(:))
+ ELSE
+ CALL AV_PGD_1P (PEK%TREAP ,PCOVER,TDATA_REAP(:,:),YVEG,'MAJ',OCOVER,&
+ PK%NR_P,IO%NPATCH, KPATCH, KDECADE=KDEC)
+ ENDIF
ENDIF
- END IF
- !
- IF (PRESENT(PIRRIG)) THEN
- IF (SIZE(PIRRIG)>0) THEN
- IF (GDATA .AND. DTI%LDATA_IRRIG) THEN
- CALL AV_PGD_PARAM(DTI, &
- PIRRIG,DTI%XPAR_VEGTYPE,DTI%XPAR_IRRIG(:,KDECADE2,:),YVEG,'ARI',KDECADE=KDECADE2)
+ !
+ DEALLOCATE(ZWORKI)
+ !
+ IF (SIZE(PEK%XIRRIG)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_IRRIG)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XIRRIG,DTV%XPAR_VEGTYPE,DTV%XPAR_IRRIG(:,KDEC2,:),YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
ELSE
- CALL AV_PGD(DTCO, &
- PIRRIG,PCOVER,XDATA_IRRIG,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD_1P(DTCO, PEK%XIRRIG,PCOVER,XDATA_IRRIG,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
ENDIF
- ENDIF
-
- IF (PRESENT(PWATSUP)) THEN
- IF (SIZE(PWATSUP)>0) THEN
- IF (GDATA .AND. DTI%LDATA_WATSUP) THEN
- CALL AV_PGD_PARAM(DTI, &
- PWATSUP,DTI%XPAR_VEGTYPE,DTI%XPAR_WATSUP(:,KDECADE2,:),YVEG,'ARI',KDECADE=KDECADE2)
+!
+ IF (SIZE(PEK%XWATSUP)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_WATSUP)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XWATSUP,DTV%XPAR_VEGTYPE,DTV%XPAR_WATSUP(:,KDEC2,:),YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
ELSE
- CALL AV_PGD(DTCO, &
- PWATSUP,PCOVER,XDATA_WATSUP,YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD_1P(DTCO, PEK%XWATSUP,PCOVER,XDATA_WATSUP,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
ENDIF
+ !
ENDIF
-
+!
ENDIF
!
-IF (PRESENT(PALBNIR_SOIL)) THEN
- IF (GDATA .AND. DTI%LDATA_ALBNIR_SOIL) THEN
- CALL AV_PGD_PARAM(DTI, &
- PALBNIR_SOIL,DTI%XPAR_VEGTYPE,DTI%XPAR_ALBNIR_SOIL,YBAR,'ARI',KDECADE=KDECADE2)
- ELSEIF (I%CALBEDO=='CM13') THEN
- CALL AV_PGD(DTCO, &
- PALBNIR_SOIL,PCOVER,XDATA_ALB_SOIL_NIR(:,KDECADE,:),YBAR,'ARI',&
- OCOVER,KDECADE=KDECADE)
+IF (OALB) THEN
+!
+ IF (GDATA .AND. ANY(DTV%LDATA_ALBNIR_SOIL)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XALBNIR_SOIL,DTV%XPAR_VEGTYPE,DTV%XPAR_ALBNIR_SOIL(:,KDEC2,:),YBAR,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSEIF (IO%CALBEDO=='CM13') THEN
+ CALL AV_PGD_1P(DTCO, PEK%XALBNIR_SOIL,PCOVER,XDATA_ALB_SOIL_NIR(:,KDEC,:),YBAR,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ELSE
- CALL SOIL_ALBEDO (I%CALBEDO, I%XWSAT(:,1),PWG1, I%XALBVIS_DRY,I%XALBNIR_DRY,I%XALBUV_DRY, &
- I%XALBVIS_WET,I%XALBNIR_WET,I%XALBUV_WET, PALBNIR_SOIL=PALBNIR_SOIL )
+ CALL SOIL_ALBEDO (IO%CALBEDO, PWSAT(:,1), PWG1, KK, PEK, "NIR" )
ENDIF
-ENDIF
!
-IF (PRESENT(PALBVIS_SOIL)) THEN
- IF (GDATA .AND. DTI%LDATA_ALBVIS_SOIL) THEN
- CALL AV_PGD_PARAM(DTI, &
- PALBVIS_SOIL,DTI%XPAR_VEGTYPE,DTI%XPAR_ALBVIS_SOIL,YBAR,'ARI',KDECADE=KDECADE2)
- ELSEIF (I%CALBEDO=='CM13') THEN
- CALL AV_PGD(DTCO, &
- PALBVIS_SOIL,PCOVER,XDATA_ALB_SOIL_VIS(:,KDECADE,:),YBAR,'ARI',&
- OCOVER,KDECADE=KDECADE)
+ IF (GDATA .AND. ANY(DTV%LDATA_ALBVIS_SOIL)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XALBVIS_SOIL,DTV%XPAR_VEGTYPE,DTV%XPAR_ALBVIS_SOIL(:,KDEC2,:),YBAR,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSEIF (IO%CALBEDO=='CM13') THEN
+ CALL AV_PGD_1P(DTCO, PEK%XALBVIS_SOIL,PCOVER,XDATA_ALB_SOIL_VIS(:,KDEC,:),YBAR,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ELSE
- CALL SOIL_ALBEDO (I%CALBEDO, I%XWSAT(:,1),PWG1, I%XALBVIS_DRY,I%XALBVIS_DRY,I%XALBUV_DRY, &
- I%XALBVIS_WET,I%XALBNIR_WET,I%XALBUV_WET, PALBVIS_SOIL=PALBVIS_SOIL )
+ CALL SOIL_ALBEDO (IO%CALBEDO, PWSAT(:,1), PWG1, KK, PEK, "VIS" )
ENDIF
-ENDIF
!
-IF (PRESENT(PALBUV_SOIL)) THEN
- IF ((I%CALBEDO=='CM13'.OR.OTR_ML).AND.PRESENT(PALBVIS_SOIL)) THEN
- PALBUV_SOIL(:,:)=PALBVIS_SOIL(:,:)
+
+ IF (IO%CALBEDO=='CM13'.OR.IO%LTR_ML) THEN
+ PEK%XALBUV_SOIL(:)=PEK%XALBVIS_SOIL(:)
+ ELSEIF (GDATA .AND. ANY(DTV%LDATA_ALBUV_SOIL)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XALBUV_SOIL,DTV%XPAR_VEGTYPE,DTV%XPAR_ALBUV_SOIL(:,KDEC2,:),YNAT,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
ELSE
- IF (GDATA .AND. DTI%LDATA_ALBUV_SOIL) THEN
- CALL AV_PGD_PARAM(DTI, &
- PALBUV_SOIL,DTI%XPAR_VEGTYPE,DTI%XPAR_ALBUV_SOIL,YNAT,'ARI',KDECADE=KDECADE2)
- ELSE
- CALL SOIL_ALBEDO (I%CALBEDO, I%XWSAT(:,1),PWG1, I%XALBVIS_DRY,I%XALBUV_DRY,I%XALBUV_DRY, &
- I%XALBVIS_WET,I%XALBNIR_WET,I%XALBUV_WET,PALBUV_SOIL=PALBUV_SOIL )
- ENDIF
+ CALL SOIL_ALBEDO (IO%CALBEDO, PWSAT(:,1), PWG1, KK, PEK, "UV" )
ENDIF
-ENDIF
!
-! STRESS
-! --------
-IF (PRESENT(OSTRESS)) THEN
- IF (SIZE(OSTRESS)>0) THEN
- CALL SET_STRESS(SIZE(OSTRESS,1),SIZE(OSTRESS,2))
- ENDIF
ENDIF
!
IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
@@ -831,46 +663,46 @@ IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
!
-SUBROUTINE SET_STRESS(KSIZE1,KSIZE2)
+SUBROUTINE SET_STRESS
!
IMPLICIT NONE
!
-INTEGER, INTENT(IN) :: KSIZE1
-INTEGER, INTENT(IN) :: KSIZE2
-!
-REAL, DIMENSION(KSIZE1,KSIZE2) :: ZWORK
-REAL, DIMENSION(KSIZE1,NVEGTYPE) :: ZSTRESS
+REAL, DIMENSION(PK%NSIZE_P) :: ZWORK
+REAL, DIMENSION(SIZE(DTV%LPAR_STRESS,1),NVEGTYPE) :: ZSTRESS
+INTEGER :: JI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA:SET_STRESS',0,ZHOOK_HANDLE)
!
-IF (GDATA .AND. DTI%LDATA_STRESS) THEN
+IF (GDATA .AND. ANY(DTV%LDATA_STRESS)) THEN
ZSTRESS(:,:)=0.
- DO JVEGTYPE=1,NVEGTYPE
- WHERE (DTI%LPAR_STRESS(:,JVEGTYPE)) ZSTRESS(:,JVEGTYPE)=1.
+ DO JVEG=1,NVEGTYPE
+ DO JI = 1,PK%NSIZE_P
+ IF (DTV%LPAR_STRESS(JI,JVEG)) ZSTRESS(PK%NR_P(JI),JVEG) = 1.
+ ENDDO
ENDDO
- CALL AV_PGD_PARAM(DTI, &
- ZWORK,DTI%XPAR_VEGTYPE,ZSTRESS,YVEG,'ARI',KDECADE=KDECADE2)
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ ZWORK,DTV%XPAR_VEGTYPE,ZSTRESS,YVEG,'ARI',PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
ELSE
- CALL AV_PGD(DTCO, &
- ZWORK,PCOVER,XDATA_STRESS(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD_1P(DTCO, ZWORK,PCOVER,XDATA_STRESS(:,:),YVEG,'ARI',OCOVER,PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
!
-WHERE (ZWORK(:,:)<0.5)
- OSTRESS(:,:) = .FALSE.
+WHERE (ZWORK(:)<0.5)
+ PEK%LSTRESS(:) = .FALSE.
ELSEWHERE
- OSTRESS(:,:) = .TRUE.
+ PEK%LSTRESS(:) = .TRUE.
END WHERE
!
IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA:SET_STRESS',1,ZHOOK_HANDLE)
END SUBROUTINE SET_STRESS
!
!-------------------------------------------------------------------------------
-SUBROUTINE SET_GRID_PARAM(KNI,KGROUND,KPATCH,LDG2,LDROOT,LWG_LAYER,LROOTFRAC, &
- LROOTFRACGV )
+SUBROUTINE SET_GRID_PARAM(KNI,KGROUND)
+!
+USE MODD_PGDWORK, ONLY : XPREC
!
USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
USE MODD_ISBA_PAR, ONLY : XPERMFRAC
@@ -884,51 +716,42 @@ USE MODI_ABOR1_SFX
!
IMPLICIT NONE
!
-REAL, PARAMETER :: ZPREC=1.0E+6
-!
INTEGER, INTENT(IN) :: KNI
INTEGER, INTENT(IN) :: KGROUND
-INTEGER, INTENT(IN) :: KPATCH
-LOGICAL, INTENT(IN) :: LDG2
-LOGICAL, INTENT(IN) :: LDROOT
-LOGICAL, INTENT(IN) :: LWG_LAYER
-LOGICAL, INTENT(IN) :: LROOTFRAC
-LOGICAL, INTENT(IN) :: LROOTFRACGV
!
REAL, DIMENSION (SIZE(XDATA_GROUND_DEPTH,1),NVEGTYPE) :: ZDATA_GROUND_DEPTH
!
-REAL, DIMENSION (KNI,KGROUND,KPATCH) :: ZROOTFRAC
-REAL, DIMENSION (KNI,KPATCH) :: ZDTOT, ZDG2, ZROOT_EXT, ZROOT_LIN
-INTEGER, DIMENSION (KNI,KPATCH) :: IWG_LAYER
+REAL, DIMENSION (KNI) :: ZDTOT, ZDG2, ZROOT_EXT, ZROOT_LIN
!
-INTEGER :: JJ, JL, JPATCH
+INTEGER :: JJ, JL
!
! flags taking general surface type flag into account
LOGICAL :: GDATA_DG, GDATA_GROUND_DEPTH, GDATA_ROOT_DEPTH, GDATA_ROOTFRAC, &
- GDATA_ROOTFRACGV, GNOECO
+ GNOECO, GMEB
!-------------------------------------------------------------------------!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA:SET_GRID_PARAM',0,ZHOOK_HANDLE)
!
-IF(HISBA=='DIF')THEN
- IF(.NOT.LWG_LAYER) CALL ABOR1_SFX('CONVERT_PATCH_ISBA: SET_GRID_PARAM: KWG_LAYER must be present with DIF')
- IF(.NOT.LDROOT ) CALL ABOR1_SFX('CONVERT_PATCH_ISBA: SET_GRID_PARAM: PDROOT must be present with DIF')
- IF(.NOT.LDG2 ) CALL ABOR1_SFX('CONVERT_PATCH_ISBA: SET_GRID_PARAM: PDG2 must be present with DIF')
+IF(IO%CISBA=='DIF')THEN
+ IF(.NOT.OFIX) CALL ABOR1_SFX('CONVERT_PATCH_ISBA: SET_GRID_PARAM: KWG_LAYER, PDROOT and PGD2 must be present with DIF')
+
ENDIF
!
-ZROOTFRAC(:,:,:) = XUNDEF
-ZDTOT (:,:) = XUNDEF
-ZDG2 (:,:) = XUNDEF
-IWG_LAYER(:,:) = NUNDEF
+GMEB = (OMEB .AND. (ISIZE_LMEB_PATCH>0))
+!
+ZDTOT (:) = XUNDEF
+ZDG2 (:) = XUNDEF
+!
+PK%NWG_LAYER(:) = NUNDEF
+PK%XROOTFRAC(:,:) = XUNDEF
!
ZDATA_GROUND_DEPTH(:,:) = XDATA_GROUND_DEPTH(:,:)
!
-GDATA_DG = GDATA .AND. DTI%LDATA_DG
-GDATA_GROUND_DEPTH = GDATA .AND. DTI%LDATA_GROUND_DEPTH
-GDATA_ROOT_DEPTH = GDATA .AND. DTI%LDATA_ROOT_DEPTH
-GDATA_ROOTFRAC = GDATA .AND. DTI%LDATA_ROOTFRAC
-GDATA_ROOTFRACGV = GDATA .AND. DTI%LDATA_ROOTFRACGV
+GDATA_DG = GDATA .AND. ANY(DTV%LDATA_DG)
+GDATA_GROUND_DEPTH = GDATA .AND. ANY(DTV%LDATA_GROUND_DEPTH)
+GDATA_ROOT_DEPTH = GDATA .AND. ANY(DTV%LDATA_ROOT_DEPTH)
+GDATA_ROOTFRAC = GDATA .AND. ANY(DTV%LDATA_ROOTFRAC)
!
!####################################################################################
!
@@ -939,269 +762,239 @@ GDATA_ROOTFRACGV = GDATA .AND. DTI%LDATA_ROOTFRACGV
! recommended = 'ROOT' d2 soil depth from ecoclimap for isba-df (default)
!
!####################################################################################
-!
+!n
!DG IN NAMELIST => GROUND_DEPTH KNOWN, ROOT_DEPTH UNKNOWN
IF (GDATA_DG) THEN
!
DO JLAYER=1,KGROUND
- CALL AV_PGD_PARAM(DTI, &
- PDG(:,JLAYER,:),DTI%XPAR_VEGTYPE,DTI%XPAR_DG(:,JLAYER,:),YNAT,CDGAVG)
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PK%XDG(:,JLAYER),DTV%XPAR_VEGTYPE,DTV%XPAR_DG(:,JLAYER,:),YNAT,CDGAVG,&
+ PK%NR_P,IO%NPATCH,KPATCH)
ENDDO
!
ENDIF
!
-IF(.NOT.GDATA_GROUND_DEPTH.AND.HISBA=='DIF'.AND.CDGDIF=='ROOT')THEN
- DO JVEGTYPE=1,NVEGTYPE
- IF(JVEGTYPE==NVT_NO)THEN
- WHERE(XDATA_GROUND_DEPTH(:,JVEGTYPE)/=XUNDEF)
- ZDATA_GROUND_DEPTH(:,JVEGTYPE) = MIN(1.0,XDATA_GROUND_DEPTH(:,JVEGTYPE))
- ENDWHERE
- ELSEIF(JVEGTYPE/=NVT_ROCK.AND.JVEGTYPE/=NVT_SNOW)THEN
- ZDATA_GROUND_DEPTH(:,JVEGTYPE) = MAX(1.0,XDATA_ROOT_DEPTH(:,JVEGTYPE))
- ELSE
- ZDATA_GROUND_DEPTH(:,JVEGTYPE) = XDATA_ROOT_DEPTH(:,JVEGTYPE)
- ENDIF
- ENDDO
+IF(.NOT.GDATA_GROUND_DEPTH.AND.IO%CISBA=='DIF'.AND.CDGDIF=='ROOT')THEN
+ !
+ DO JVEG=1,NVEGTYPE
+ IF(JVEG==NVT_NO)THEN
+ WHERE(XDATA_GROUND_DEPTH(:,JVEG)/=XUNDEF)
+ ZDATA_GROUND_DEPTH(:,JVEG) = MIN(1.0,XDATA_GROUND_DEPTH(:,JVEG))
+ ENDWHERE
+ ELSEIF(JVEG/=NVT_ROCK.AND.JVEG/=NVT_SNOW)THEN
+ ZDATA_GROUND_DEPTH(:,JVEG) = MAX(1.0,XDATA_ROOT_DEPTH(:,JVEG))
+ ELSE
+ ZDATA_GROUND_DEPTH(:,JVEG) = XDATA_ROOT_DEPTH(:,JVEG)
+ ENDIF
+ ENDDO
+ !
ENDIF
!
-!CALCULATION OF GROUND_DEPTH IN ZDTOT : ECOCLIMAP OR LDATA_GROUND_DEPTH
-IF (HISBA/='2-L') THEN
+!CALCULATION OF GROUND_DEPTH IN ZDTOT : ECOCLMAP OR LDATA_GROUND_DEPTH
+IF (IO%CISBA/='2-L') THEN
!
- IF (GDATA_GROUND_DEPTH .AND. (HISBA=='DIF' .OR. .NOT.GDATA_DG)) THEN
+ IF (GDATA_GROUND_DEPTH .AND. (IO%CISBA=='DIF' .OR. .NOT.GDATA_DG)) THEN
!GROUND DEPTH IN NAMELIST
- CALL AV_PGD_PARAM(DTI, &
- ZDTOT(:,:),DTI%XPAR_VEGTYPE,DTI%XPAR_GROUND_DEPTH(:,:),YNAT,CDGAVG)
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ ZDTOT(:),DTV%XPAR_VEGTYPE,DTV%XPAR_GROUND_DEPTH(:,:),YNAT,CDGAVG,&
+ PK%NR_P,IO%NPATCH,KPATCH)
!Error Due to machine precision
- WHERE(ZDTOT(:,:)/=XUNDEF)
- ZDTOT(:,:)=INT(ZDTOT(:,:)*ZPREC)/ZPREC
- ENDWHERE
+ WHERE(ZDTOT(:)/=XUNDEF) ZDTOT(:)=NINT(ZDTOT(:)*XPREC)/XPREC
!CONSISTENCY CHECK
- IF (GDATA_DG) ZDTOT(:,:) = MIN(ZDTOT(:,:),PDG(:,KGROUND,:))
+ IF (GDATA_DG) ZDTOT(:) = MIN(ZDTOT(:),PK%XDG(:,KGROUND))
ELSEIF (GDATA_DG) THEN
!GROUND DEPTH FROM NAMELIST DG
- ZDTOT(:,:) = PDG(:,KGROUND,:)
+ ZDTOT(:) = PK%XDG(:,KGROUND)
ELSE
- !GROUND DEPTH FROM ECOCLIMAP
- CALL AV_PGD(DTCO, &
- ZDTOT(:,:),PCOVER,ZDATA_GROUND_DEPTH(:,:),YNAT,CDGAVG,OCOVER,KDECADE=KDECADE)
- IF(HISBA=='DIF'.AND.CDGDIF=='ROOT')ZDG2(:,:)=ZDTOT(:,:)
+ !GROUND DEPTH FROM ECOCLMAP
+ CALL AV_PGD_1P(DTCO, ZDTOT(:),PCOVER,ZDATA_GROUND_DEPTH(:,:),YNAT,CDGAVG,OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ IF(IO%CISBA=='DIF'.AND.CDGDIF=='ROOT')ZDG2(:)=ZDTOT(:)
ENDIF
!
ENDIF
!
!CALCULATION OF GROUND_DEPTH : Permafrost depth put to 12m
-IF(HISBA=='DIF'.AND.OPERM)THEN
- CALL PERMAFROST_DEPTH(KNI,KPATCH,I%XPERM,ZDTOT)
-ENDIF
+IF(IO%CISBA=='DIF'.AND.IO%LPERM) CALL PERMAFROST_DEPTH(PK%NSIZE_P,KPATCH,PPERM,ZDTOT)
!
!IN BOTH CASES, ROOT_DEPTH IS NEEDED: PUT IN DG2
-IF (HISBA=='DIF' .OR. .NOT.GDATA_DG) THEN
+IF (IO%CISBA=='DIF' .OR. .NOT.GDATA_DG) THEN
!
GNOECO=(GDATA_ROOT_DEPTH .AND. .NOT.GDATA_ROOTFRAC)
IF (GNOECO) THEN
!ROOT_DEPTH IN NAMELIST
- CALL AV_PGD_PARAM(DTI, &
- ZDG2(:,:),DTI%XPAR_VEGTYPE,DTI%XPAR_ROOT_DEPTH(:,:),YNAT,CDGAVG)
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ ZDG2(:),DTV%XPAR_VEGTYPE,DTV%XPAR_ROOT_DEPTH(:,:),YNAT,CDGAVG,&
+ PK%NR_P,IO%NPATCH,KPATCH)
!Error Due to machine precision
- WHERE(ZDG2(:,:)/=XUNDEF)
- ZDG2(:,:)=INT(ZDG2(:,:)*ZPREC)/ZPREC
- ENDWHERE
+ WHERE(ZDG2(:)/=XUNDEF) ZDG2(:)=NINT(ZDG2(:)*XPREC)/XPREC
!CONSISTENCY CHECKS
- IF (DTI%LDATA_DG) ZDG2(:,:) = MIN(ZDG2(:,:),PDG(:,KGROUND,:))
- ZDTOT(:,:) = MAX(ZDG2(:,:),ZDTOT(:,:))
- IF (HISBA=='DIF') THEN
- CALL AV_PGD_PARAM(DTI, &
- PDROOT(:,:),DTI%XPAR_VEGTYPE,DTI%XPAR_ROOT_DEPTH(:,:),YDIF,CDGAVG)
+ IF (ANY(DTV%LDATA_DG)) ZDG2(:) = MIN(ZDG2(:),PK%XDG(:,KGROUND))
+ ZDTOT(:) = MAX(ZDG2(:),ZDTOT(:))
+ IF (IO%CISBA=='DIF') THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PK%XDROOT(:),DTV%XPAR_VEGTYPE,DTV%XPAR_ROOT_DEPTH(:,:),YDIF,CDGAVG,&
+ PK%NR_P,IO%NPATCH,KPATCH)
!Error Due to machine precision
- WHERE(PDROOT(:,:)/=XUNDEF)
- PDROOT(:,:)=INT(PDROOT(:,:)*ZPREC)/ZPREC
+ WHERE(PK%XDROOT(:)/=XUNDEF)
+ PK%XDROOT(:)=NINT(PK%XDROOT(:)*XPREC)/XPREC
ENDWHERE
IF(CDGDIF=='ROOT')THEN
- WHERE(PDROOT(:,:).NE.XUNDEF) ZDTOT(:,:) = MAX(PDROOT(:,:),ZDTOT(:,:))
- WHERE(PDROOT(:,:).NE.XUNDEF) ZDG2 (:,:) = MAX(PDROOT(:,:),ZDG2 (:,:))
+ WHERE(PK%XDROOT(:).NE.XUNDEF) ZDTOT(:) = MAX(PK%XDROOT(:),ZDTOT(:))
+ WHERE(PK%XDROOT(:).NE.XUNDEF) ZDG2 (:) = MAX(PK%XDROOT(:),ZDG2 (:))
ELSE
- CALL AV_PGD(DTCO, &
- ZDG2(:,:),PCOVER,XDATA_ROOT_DEPTH(:,:),YNAT,CDGAVG,OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD_1P(DTCO, ZDG2(:),PCOVER,XDATA_ROOT_DEPTH(:,:),YNAT,CDGAVG,OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
!CONSISTENCY CHECKS
- IF (GDATA_DG) WHERE (PDROOT(:,:).NE.XUNDEF) PDROOT(:,:) = MIN(PDROOT(:,:),PDG(:,KGROUND,:))
+ IF (GDATA_DG) WHERE (PK%XDROOT(:).NE.XUNDEF) PK%XDROOT(:) = MIN(PK%XDROOT(:),PK%XDG(:,KGROUND))
ENDIF
ELSE
- !ROOT_DEPTH FROM ECOCLIMAP
- IF (HISBA=='DIF')THEN
- CALL AV_PGD(DTCO, &
- PDROOT(:,:),PCOVER,XDATA_ROOT_DEPTH(:,:),YDIF,CDGAVG,OCOVER,KDECADE=KDECADE)
+ !ROOT_DEPTH FROM ECOCLMAP
+ IF (IO%CISBA=='DIF')THEN
+ CALL AV_PGD_1P(DTCO, PK%XDROOT(:),PCOVER,XDATA_ROOT_DEPTH(:,:),YDIF,CDGAVG,OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
IF(CDGDIF=='ROOT')THEN
- WHERE(PDROOT(:,:).NE.XUNDEF) ZDTOT(:,:) = MAX(PDROOT(:,:),ZDTOT(:,:))
- WHERE(PDROOT(:,:).NE.XUNDEF) ZDG2 (:,:) = MAX(PDROOT(:,:),ZDG2 (:,:))
+ WHERE(PK%XDROOT(:).NE.XUNDEF) ZDTOT(:) = MAX(PK%XDROOT(:),ZDTOT(:))
+ WHERE(PK%XDROOT(:).NE.XUNDEF) ZDG2 (:) = MAX(PK%XDROOT(:),ZDG2 (:))
ELSE
- CALL AV_PGD(DTCO, &
- ZDG2(:,:),PCOVER,XDATA_ROOT_DEPTH(:,:),YNAT,CDGAVG,OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD_1P(DTCO, ZDG2(:),PCOVER,XDATA_ROOT_DEPTH(:,:),YNAT,CDGAVG,OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
ELSE
- CALL AV_PGD(DTCO, &
- ZDG2(:,:),PCOVER,XDATA_ROOT_DEPTH(:,:),YNAT,CDGAVG,OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD_1P(DTCO, ZDG2(:),PCOVER,XDATA_ROOT_DEPTH(:,:),YNAT,CDGAVG,OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
IF ( GDATA_GROUND_DEPTH .OR. GDATA_DG ) THEN
- ZDG2 (:,:) = MIN(ZDG2 (:,:),ZDTOT(:,:))
- IF (HISBA=='DIF') WHERE (PDROOT(:,:).NE.XUNDEF) PDROOT(:,:) = MIN(PDROOT(:,:),ZDTOT(:,:))
+ ZDG2 (:) = MIN(ZDG2 (:),ZDTOT(:))
+ IF (IO%CISBA=='DIF') WHERE (PK%XDROOT(:).NE.XUNDEF) PK%XDROOT(:) = MIN(PK%XDROOT(:),ZDTOT(:))
ENDIF
ENDIF
!
!CALCULATION OF DG IF NOT IN NAMELIST
IF (.NOT.GDATA_DG) THEN
!
- IF (HISBA=='DIF') THEN
+ IF (IO%CISBA=='DIF') THEN
IF( MAXVAL(ZDTOT,ZDTOT/=XUNDEF)>PSOILGRID(KGROUND) ) THEN
CALL ABOR1_SFX('CONVERT_PATCH_ISBA: not enough soil layer with optimized grid')
ENDIF
ENDIF
!
- WHERE(ZDG2(:,:)==XUNDEF.AND.ZDTOT(:,:)/=XUNDEF) ZDG2(:,:)=0.0 !No vegetation
+ WHERE(ZDG2(:)==XUNDEF.AND.ZDTOT(:)/=XUNDEF) ZDG2(:)=0.0 !No vegetation
!
!IF CISBA=DIF CALCULATES ALSO KWG_LAYER WITH USE OF SOILGRID $
- CALL INI_DATA_SOIL(HISBA, PDG,PROOTDEPTH=ZDG2, PSOILDEPTH=ZDTOT,&
- PSOILGRID=PSOILGRID, KWG_LAYER=IWG_LAYER )
- IF (HISBA=='DIF'.AND.CDGDIF=='ROOT')THEN
- DO JPATCH=1,KPATCH
+ CALL INI_DATA_SOIL(IO%CISBA, PK%XDG,PROOTDEPTH=ZDG2, PSOILDEPTH=ZDTOT,&
+ PSOILGRID=PSOILGRID, KWG_LAYER=PK%NWG_LAYER )
+ IF (IO%CISBA=='DIF'.AND.CDGDIF=='ROOT')THEN
DO JJ=1,KNI
- IF(OPERM.AND.IWG_LAYER(JJ,JPATCH)/=NUNDEF)THEN
- IF(I%XPERM(JJ)<XPERMFRAC) ZDG2(JJ,JPATCH)=PDG(JJ,IWG_LAYER(JJ,JPATCH),JPATCH)
- ELSEIF(IWG_LAYER(JJ,JPATCH)/=NUNDEF)THEN
- ZDG2(JJ,JPATCH)=PDG(JJ,IWG_LAYER(JJ,JPATCH),JPATCH)
+ IF(IO%LPERM.AND.PK%NWG_LAYER(JJ)/=NUNDEF)THEN
+ IF(PPERM(JJ)<XPERMFRAC) ZDG2(JJ)=PK%XDG(JJ,PK%NWG_LAYER(JJ))
+ ELSEIF(PK%NWG_LAYER(JJ)/=NUNDEF)THEN
+ ZDG2(JJ)=PK%XDG(JJ,PK%NWG_LAYER(JJ))
ELSE
- ZDG2(JJ,JPATCH)=XUNDEF
+ ZDG2(JJ)=XUNDEF
ENDIF
ENDDO
- ENDDO
ENDIF
!
- ELSEIF ( HISBA=='DIF') THEN
+ ELSEIF ( IO%CISBA=='DIF') THEN
!
!CALCULATION OF KWG_LAYER IF DG IN NAMELIST
IF(GDATA_GROUND_DEPTH)THEN
- DO JPATCH=1,KPATCH
DO JJ=1,KNI
DO JL=1,KGROUND
- IF( PDG(JJ,JL,JPATCH) <= ZDTOT(JJ,JPATCH) .AND. ZDTOT(JJ,JPATCH) < XUNDEF ) &
- IWG_LAYER(JJ,JPATCH) = JL
+ IF( PK%XDG(JJ,JL) <= ZDTOT(JJ) .AND. ZDTOT(JJ) < XUNDEF ) &
+ PK%NWG_LAYER(JJ) = JL
ENDDO
- ENDDO
- ENDDO
+ ENDDO
ELSE
- IWG_LAYER(:,:) = KGROUND
+ PK%NWG_LAYER(:) = KGROUND
ENDIF
!
ENDIF
!
- ! DROOT AND DG2 LIMITED BY KWG_LAYER
- IF (HISBA=='DIF' .AND. .NOT.DTI%LDATA_ROOTFRAC) THEN
+ ! DROOT AND DG2 LMITED BY KWG_LAYER
+ IF (IO%CISBA=='DIF' .AND. .NOT.ANY(DTV%LDATA_ROOTFRAC)) THEN
!
- DO JPATCH=1,KPATCH
DO JJ=1,KNI
- IF(IWG_LAYER(JJ,JPATCH)/=NUNDEF) THEN
- JL = IWG_LAYER(JJ,JPATCH)
- ZDG2 (JJ,JPATCH)=MIN(ZDG2 (JJ,JPATCH),PDG(JJ,JL,JPATCH))
- IF (PDROOT(JJ,JPATCH)/=XUNDEF) PDROOT(JJ,JPATCH)=MIN(PDROOT(JJ,JPATCH),PDG(JJ,JL,JPATCH))
+ IF(PK%NWG_LAYER(JJ)/=NUNDEF) THEN
+ JL = PK%NWG_LAYER(JJ)
+ ZDG2 (JJ)=MIN(ZDG2 (JJ),PK%XDG(JJ,JL))
+ IF (PK%XDROOT(JJ)/=XUNDEF) PK%XDROOT(JJ)=MIN(PK%XDROOT(JJ),PK%XDG(JJ,JL))
ENDIF
ENDDO
- ENDDO
!
ENDIF
!
ENDIF
!
!CALCULATION OF ROOTFRAC
-IF (HISBA=='DIF') THEN
+IF (IO%CISBA=='DIF') THEN
!
- IF ( (GDATA_ROOTFRAC .OR. GDATA_ROOTFRACGV) .AND. (LDG2 .OR. LDROOT .OR. LROOTFRAC .OR. LROOTFRACGV)) THEN
- !
- !ROOTFRACGV IN NAMELIST
- IF(LROOTFRACGV)THEN
- DO JL=1,KGROUND
- CALL AV_PGD_PARAM(DTI, &
- PROOTFRACGV(:,JL,:),DTI%XPAR_VEGTYPE,DTI%XPAR_ROOTFRACGV(:,JL,:),YNAT,'ARI')
- ENDDO
- ENDIF
+ IF (GDATA_ROOTFRAC) THEN
!
!ROOTFRAC IN NAMELIST
DO JL=1,KGROUND
- CALL AV_PGD_PARAM(DTI, &
- ZROOTFRAC(:,JL,:),DTI%XPAR_VEGTYPE,DTI%XPAR_ROOTFRAC(:,JL,:),YNAT,'ARI',KDECADE=KDECADE)
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PK%XROOTFRAC(:,JL),DTV%XPAR_VEGTYPE,DTV%XPAR_ROOTFRAC(:,JL,:),YNAT,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDDO
- IF (LROOTFRAC) PROOTFRAC(:,:,:) = ZROOTFRAC(:,:,:)
!
- ZDG2 (:,:)=0.0
- PDROOT(:,:)=0.0
- DO JPATCH=1,KPATCH
+ ZDG2 (:)=0.0
+ PK%XDROOT(:)=0.0
DO JJ=1,KNI
!
!DROOT DEPENDS ON ROOTFRAC
DO JL=KGROUND,1,-1
- IF( ZROOTFRAC(JJ,JL,JPATCH)>=1.0 )THEN
- ZDG2 (JJ,JPATCH) = PDG(JJ,JL,JPATCH)
- PDROOT(JJ,JPATCH) = PDG(JJ,JL,JPATCH)
- ELSEIF (JL<KGROUND.AND.ZROOTFRAC(JJ,JL,JPATCH)>0.0) THEN
- IF (IWG_LAYER(JJ,JPATCH)<=JL) IWG_LAYER(JJ,JPATCH) = JL+1
+ IF( PK%XROOTFRAC(JJ,JL)>=1.0 )THEN
+ ZDG2 (JJ) = PK%XDG(JJ,JL)
+ PK%XDROOT(JJ) = PK%XDG(JJ,JL)
+ ELSEIF (JL<KGROUND.AND.PK%XROOTFRAC(JJ,JL)>0.0) THEN
+ IF (PK%NWG_LAYER(JJ)<=JL) PK%NWG_LAYER(JJ) = JL+1
EXIT
ENDIF
ENDDO
!
- IF(PDROOT(JJ,JPATCH)==0.0.AND.ZDG2(JJ,JPATCH)==0.0)THEN
- JL=IWG_LAYER(JJ,JPATCH)
- ZDG2(JJ,JPATCH)=MIN(0.6,PDG(JJ,JL,JPATCH))
+ IF(PK%XDROOT(JJ)==0.0.AND.ZDG2(JJ)==0.0)THEN
+ JL=PK%NWG_LAYER(JJ)
+ ZDG2(JJ)=MIN(0.6,PK%XDG(JJ,JL))
ENDIF
!
ENDDO
- ENDDO
!
- ELSEIF (LROOTFRAC .OR. LROOTFRACGV) THEN
+ ELSE
!
!DEPENDS ON DROOT
- IF (GDATA .AND. DTI%LDATA_ROOT_LIN) THEN
- CALL AV_PGD_PARAM(DTI, &
- ZROOT_LIN(:,:),DTI%XPAR_VEGTYPE,DTI%XPAR_ROOT_LIN(:,:),YDIF,'ARI')
+ IF (GDATA .AND. ANY(DTV%LDATA_ROOT_LIN)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ ZROOT_LIN(:),DTV%XPAR_VEGTYPE,DTV%XPAR_ROOT_LIN(:,:),YDIF,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH)
ELSE
- CALL AV_PGD(DTCO, &
- ZROOT_LIN(:,:),PCOVER,XDATA_ROOT_LIN(:,:),YDIF,'ARI',OCOVER,KDECADE=KDECADE)
+ CALL AV_PGD_1P(DTCO, ZROOT_LIN(:),PCOVER,XDATA_ROOT_LIN(:,:),YDIF,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
!
- IF(LROOTFRAC)THEN
- IF (GDATA .AND. DTI%LDATA_ROOT_EXTINCTION) THEN
- CALL AV_PGD_PARAM(DTI, &
- ZROOT_EXT(:,:),DTI%XPAR_VEGTYPE,DTI%XPAR_ROOT_EXTINCTION(:,:),YDIF,'ARI')
- ELSE
- CALL AV_PGD(DTCO, &
- ZROOT_EXT(:,:),PCOVER,XDATA_ROOT_EXTINCTION(:,:),YDIF,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
- !
- CALL INI_DATA_ROOTFRAC(PDG,PDROOT,ZROOT_EXT,ZROOT_LIN,PROOTFRAC)
- ENDIF
- IF(LROOTFRACGV)THEN
- IF (GDATA .AND. DTI%LDATA_ROOT_EXTINCTIONGV) THEN
- CALL AV_PGD_PARAM(DTI, &
- ZROOT_EXT(:,:),DTI%XPAR_VEGTYPE,DTI%XPAR_ROOT_EXTINCTIONGV(:,:),YDIF,'ARI')
- ELSE
- CALL AV_PGD(DTCO, &
- ZROOT_EXT(:,:),PCOVER,XDATA_ROOT_EXTINCTIONGV(:,:),YDIF,'ARI',OCOVER,KDECADE=KDECADE)
- ENDIF
- !
- CALL INI_DATA_ROOTFRAC(PDG,PDROOT,ZROOT_EXT,ZROOT_LIN, &
- PROOTFRACGV,OGV=LROOTFRACGV)
- !
+ IF (GDATA .AND. ANY(DTV%LDATA_ROOT_EXTINCTION)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ ZROOT_EXT(:),DTV%XPAR_VEGTYPE,DTV%XPAR_ROOT_EXTINCTION(:,:),YDIF,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH)
+ ELSE
+ CALL AV_PGD_1P(DTCO, ZROOT_EXT(:),PCOVER,XDATA_ROOT_EXTINCTION(:,:),YDIF,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
!
+ CALL INI_DATA_ROOTFRAC(PK%XDG,PK%XDROOT,ZROOT_EXT,ZROOT_LIN,PK%XROOTFRAC)
ENDIF
!
- IF (LDG2) PDG2 (:,:) = ZDG2 (:,:)
- IF (LWG_LAYER) KWG_LAYER(:,:) = IWG_LAYER(:,:)
+ WHERE(PK%XROOTFRAC(:,:)/=XUNDEF) PK%XROOTFRAC(:,:)=NINT(PK%XROOTFRAC(:,:)*XPREC)/XPREC
+ !
+ PK%XDG2(:) = ZDG2(:)
!
ENDIF
!
IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA:SET_GRID_PARAM',1,ZHOOK_HANDLE)
!
END SUBROUTINE SET_GRID_PARAM
-!
!-------------------------------------------------------------------------------
END SUBROUTINE CONVERT_PATCH_ISBA
diff --git a/src/SURFEX/convert_patch_teb.F90 b/src/SURFEX/convert_patch_teb.F90
index 12fed62843d0d21e71109c2c257557b285355511..3cf2716500cee2d648d476e659a2d77a03ae071f 100644
--- a/src/SURFEX/convert_patch_teb.F90
+++ b/src/SURFEX/convert_patch_teb.F90
@@ -4,36 +4,7 @@
!SFX_LIC for details. version 1.
! #########
SUBROUTINE CONVERT_PATCH_TEB (BDD, DTB, DTCO, DTT, TOP, &
- PCOVER,OCOVER,PDEF_ROAD_DIR, &
- PZ0_TOWN, &
- PALB_ROOF, &
- PEMIS_ROOF,PHC_ROOF,PTC_ROOF, &
- PD_ROOF, &
- PALB_ROAD, &
- PEMIS_ROAD,PHC_ROAD,PTC_ROAD, &
- PD_ROAD, &
- PALB_WALL, &
- PEMIS_WALL,PHC_WALL,PTC_WALL, &
- PD_WALL, &
- PBLD_HEIGHT, &
- PWALL_O_HOR,PBLD, &
- PGARDEN, PROAD_DIR, &
- PH_TRAFFIC, PLE_TRAFFIC, &
- PH_INDUSTRY, PLE_INDUSTRY, &
- PHC_FLOOR, PTC_FLOOR, PD_FLOOR, &
- PTCOOL_TARGET, PTHEAT_TARGET, &
- PF_WASTE_CAN, PEFF_HEAT, PQIN, &
- PQIN_FRAD, PSHGC, PU_WIN, PGR, &
- PSHGC_SH, PFLOOR_HEIGHT, PINF, &
- PF_WATER_COND, PQIN_FLAT, &
- PHR_TARGET, PV_VENT, PCAP_SYS_HEAT, &
- PCAP_SYS_RAT, PT_ADP, PM_SYS_RAT, &
- PCOP_RAT, PT_SIZE_MAX, PT_SIZE_MIN, &
- PSHADE, PNATVENT, PROUGH_ROOF, &
- PRESIDENTIAL, &
- PROUGH_WALL, PGREENROOF, &
- PEMIS_PANEL, PALB_PANEL, PEFF_PANEL,&
- PFRAC_PANEL )
+ PDEF_ROAD_DIR, T, B, TPN )
! ##############################################################
!
!!**** *CONVERT_PATCH_TEB* compilation of conver_cover_isba, pgd_isba_par and
@@ -79,6 +50,10 @@ USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_DATA_TEB_n, ONLY : DATA_TEB_t
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
!
+USE MODD_TEB_n, ONLY : TEB_t
+USE MODD_BEM_n, ONLY : BEM_t
+USE MODD_TEB_PANEL_n, ONLY : TEB_PANEL_t
+!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE MODD_DATA_COVER_PAR, ONLY : NDATA_ROAD_LAYER, NDATA_WALL_LAYER, &
@@ -127,71 +102,11 @@ TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(DATA_TEB_t), INTENT(INOUT) :: DTT
TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOVER
-LOGICAL, DIMENSION(:), INTENT(IN) :: OCOVER
REAL, INTENT(IN) :: PDEF_ROAD_DIR ! default road direction
!
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PZ0_TOWN
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PALB_ROOF
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PEMIS_ROOF
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PHC_ROOF
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PTC_ROOF
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PD_ROOF
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PALB_ROAD
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PEMIS_ROAD
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PHC_ROAD
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PTC_ROAD
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PD_ROAD
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PALB_WALL
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PEMIS_WALL
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PHC_WALL
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PTC_WALL
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PD_WALL
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PBLD_HEIGHT
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PWALL_O_HOR
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PBLD
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PGARDEN
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PROAD_DIR
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PH_TRAFFIC
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PLE_TRAFFIC
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PH_INDUSTRY
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PLE_INDUSTRY
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PHC_FLOOR
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PTC_FLOOR
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PD_FLOOR
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PTCOOL_TARGET
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PTHEAT_TARGET
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PF_WASTE_CAN
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PEFF_HEAT
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PQIN
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PQIN_FRAD
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PSHGC
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PU_WIN
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PGR
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PSHGC_SH
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PFLOOR_HEIGHT
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PINF
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PF_WATER_COND
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PQIN_FLAT
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PHR_TARGET
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PV_VENT
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PCAP_SYS_HEAT
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PCAP_SYS_RAT
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PT_ADP
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PM_SYS_RAT
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PCOP_RAT
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PT_SIZE_MAX
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PT_SIZE_MIN
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PSHADE
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PNATVENT
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PROUGH_ROOF
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PROUGH_WALL
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PRESIDENTIAL
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PGREENROOF
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PEMIS_PANEL
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PALB_PANEL
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PEFF_PANEL
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PFRAC_PANEL
+TYPE(TEB_t), INTENT(INOUT), OPTIONAL :: T
+TYPE(BEM_t), INTENT(INOUT), OPTIONAL :: B
+TYPE(TEB_PANEL_t), INTENT(INOUT), OPTIONAL :: TPN
!
!* 0.2 Declaration of local variables
! ------------------------------
@@ -223,109 +138,92 @@ ELSE
YAREA='BLV'
END IF
!
-IL = SIZE(PCOVER,1)
+IL = SIZE(TOP%XCOVER,1)
!-------------------------------------------------------------------------------
!
+IF (PRESENT(T)) THEN
! ROAD DIRECTION
! --------------
-IF (PRESENT(PROAD_DIR)) THEN
IF (DTT%LDATA_ROAD_DIR) THEN
- PROAD_DIR=DTT%XPAR_ROAD_DIR
+ T%XROAD_DIR=DTT%XPAR_ROAD_DIR
ELSE
- PROAD_DIR=PDEF_ROAD_DIR
+ T%XROAD_DIR=PDEF_ROAD_DIR
ENDIF
-ENDIF
-!
!
! GARDEN fraction
! ---------------
-IF (PRESENT(PGARDEN)) THEN
IF (DTT%LDATA_GARDEN) THEN
- PGARDEN=DTT%XPAR_GARDEN
+ T%XGARDEN=DTT%XPAR_GARDEN
ELSE
- CALL AV_PGD(DTCO, &
- PGARDEN, PCOVER, DTCO%XDATA_GARDEN(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, T%XGARDEN, TOP%XCOVER, DTCO%XDATA_GARDEN(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
+! GREENROOF FRACTION
+! ------------------
+ IF (DTT%LDATA_GREENROOF) THEN
+ T%XGREENROOF=DTT%XPAR_GREENROOF
+ ELSEIF (DTT%LDATA_BLDTYPE) THEN
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PGREENROOF=T%XGREENROOF)
+ ELSE
+ CALL AV_PGD(DTCO, T%XGREENROOF,TOP%XCOVER ,XDATA_FRAC_GR(:),'BLD','ARI',TOP%LCOVER)
+ ENDIF
!
! BLD fraction
! -------------
-IF (PRESENT(PBLD)) THEN
IF (DTT%LDATA_BLD) THEN
- PBLD=DTT%XPAR_BLD
+ T%XBLD=DTT%XPAR_BLD
ELSE
- CALL AV_PGD(DTCO, &
- PBLD, PCOVER, DTCO%XDATA_BLD(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, T%XBLD, TOP%XCOVER, DTCO%XDATA_BLD(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
!
! Z0_TOWN
! ----------
-IF (PRESENT(PZ0_TOWN)) THEN
IF (DTT%LDATA_Z0_TOWN) THEN
- PZ0_TOWN=DTT%XPAR_Z0_TOWN
+ T%XZ0_TOWN=DTT%XPAR_Z0_TOWN
ELSE
- CALL AV_PGD(DTCO, &
- PZ0_TOWN ,PCOVER ,XDATA_Z0_TOWN (:),'TWN','CDN',OCOVER)
+ CALL AV_PGD(DTCO, T%XZ0_TOWN ,TOP%XCOVER ,XDATA_Z0_TOWN (:),'TWN','CDN',TOP%LCOVER)
ENDIF
-ENDIF
!
! BLD Height
! ----------
-IF (PRESENT(PBLD_HEIGHT)) THEN
IF (DTT%LDATA_BLD_HEIGHT) THEN
- PBLD_HEIGHT=DTT%XPAR_BLD_HEIGHT
+ T%XBLD_HEIGHT=DTT%XPAR_BLD_HEIGHT
ELSE
- CALL AV_PGD(DTCO, &
- PBLD_HEIGHT ,PCOVER ,XDATA_BLD_HEIGHT (:),'BLD','ARI',OCOVER)
+ CALL AV_PGD(DTCO, T%XBLD_HEIGHT ,TOP%XCOVER ,XDATA_BLD_HEIGHT (:),'BLD','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! WALL O HOR
! ----------
-IF (PRESENT(PWALL_O_HOR)) THEN
IF (DTT%LDATA_WALL_O_HOR) THEN
- PWALL_O_HOR=DTT%XPAR_WALL_O_HOR
+ T%XWALL_O_HOR=DTT%XPAR_WALL_O_HOR
ELSE
- CALL AV_PGD(DTCO, &
- PWALL_O_HOR ,PCOVER ,DTCO%XDATA_WALL_O_HOR (:),'BLD','ARI',OCOVER)
+ CALL AV_PGD(DTCO, T%XWALL_O_HOR ,TOP%XCOVER ,DTCO%XDATA_WALL_O_HOR (:),'BLD','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! ALB_ROOF
! ----------
-IF (PRESENT(PALB_ROOF)) THEN
IF (DTT%LDATA_ALB_ROOF) THEN
- PALB_ROOF=DTT%XPAR_ALB_ROOF
+ T%XALB_ROOF=DTT%XPAR_ALB_ROOF
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PALB_ROOF=PALB_ROOF)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PALB_ROOF=T%XALB_ROOF)
ELSE
- CALL AV_PGD(DTCO, &
- PALB_ROOF ,PCOVER ,XDATA_ALB_ROOF (:),YAREA,YAVG,OCOVER)
+ CALL AV_PGD(DTCO, T%XALB_ROOF ,TOP%XCOVER ,XDATA_ALB_ROOF (:),YAREA,YAVG,TOP%LCOVER)
ENDIF
-ENDIF
!
! EMIS_ROOF
! ----------
-IF (PRESENT(PEMIS_ROOF)) THEN
IF (DTT%LDATA_EMIS_ROOF) THEN
- PEMIS_ROOF=DTT%XPAR_EMIS_ROOF
+ T%XEMIS_ROOF=DTT%XPAR_EMIS_ROOF
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PEMIS_ROOF=PEMIS_ROOF)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PEMIS_ROOF=T%XEMIS_ROOF)
ELSE
- CALL AV_PGD(DTCO, &
- PEMIS_ROOF ,PCOVER ,XDATA_EMIS_ROOF (:),YAREA,YAVG,OCOVER)
+ CALL AV_PGD(DTCO, T%XEMIS_ROOF ,TOP%XCOVER ,XDATA_EMIS_ROOF (:),YAREA,YAVG,TOP%LCOVER)
ENDIF
-ENDIF
!
! HC_ROOF, TC_ROOF, D_ROOF
! ------------------------
!
-IF (PRESENT(PHC_ROOF) .AND. PRESENT(PTC_ROOF) .AND. PRESENT(PD_ROOF)) THEN
IF (DTT%LDATA_HC_ROOF) THEN
CALL ALLOCATE_THERMAL_WORK(DTT%NPAR_ROOF_LAYER)
ZHC=DTT%XPAR_HC_ROOF
@@ -333,59 +231,45 @@ IF (PRESENT(PHC_ROOF) .AND. PRESENT(PTC_ROOF) .AND. PRESENT(PD_ROOF)) THEN
ZD =DTT%XPAR_D_ROOF
ELSEIF (DTT%LDATA_BLDTYPE) THEN
CALL ALLOCATE_THERMAL_WORK(BDD%NDESC_ROOF_LAYER)
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PHC_ROOF=ZHC)
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PTC_ROOF=ZTC)
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PD_ROOF =ZD )
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PHC_ROOF=ZHC)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PTC_ROOF=ZTC)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PD_ROOF =ZD )
ELSE
CALL ALLOCATE_THERMAL_WORK(NDATA_ROOF_LAYER)
DO JLAYER=1,NDATA_ROOF_LAYER
- CALL AV_PGD(DTCO, &
- ZHC(:,JLAYER), PCOVER, XDATA_HC_ROOF (:,JLAYER),YAREA,YAVG,OCOVER)
- CALL AV_PGD(DTCO, &
- ZTC(:,JLAYER), PCOVER ,XDATA_TC_ROOF (:,JLAYER),YAREA,YAVG,OCOVER)
- CALL AV_PGD(DTCO, &
- ZD (:,JLAYER), PCOVER ,XDATA_D_ROOF (:,JLAYER),YAREA,YAVG,OCOVER)
+ CALL AV_PGD(DTCO, ZHC(:,JLAYER), TOP%XCOVER, XDATA_HC_ROOF (:,JLAYER),YAREA,YAVG,TOP%LCOVER)
+ CALL AV_PGD(DTCO, ZTC(:,JLAYER), TOP%XCOVER ,XDATA_TC_ROOF (:,JLAYER),YAREA,YAVG,TOP%LCOVER)
+ CALL AV_PGD(DTCO, ZD (:,JLAYER), TOP%XCOVER ,XDATA_D_ROOF (:,JLAYER),YAREA,YAVG,TOP%LCOVER)
ENDDO
- ENDIF
- CALL THERMAL_LAYERS_CONF('ROOF ',ZHC,ZTC,ZD,PHC_ROOF,PTC_ROOF,PD_ROOF)
+ ENDIF
+ CALL THERMAL_LAYERS_CONF('ROOF ',ZD,T%XD_ROOF,ZHC,T%XHC_ROOF,ZTC,T%XTC_ROOF)
CALL DEALLOCATE_THERMAL_WORK
-ENDIF
!
! ALB_ROAD
! ----------
-IF (PRESENT(PALB_ROAD)) THEN
IF (DTT%LDATA_ALB_ROAD) THEN
- PALB_ROAD=DTT%XPAR_ALB_ROAD
+ T%XALB_ROAD=DTT%XPAR_ALB_ROAD
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PALB_ROAD=PALB_ROAD)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PALB_ROAD=T%XALB_ROAD)
ELSE
CALL AV_PGD(DTCO, &
- PALB_ROAD ,PCOVER ,XDATA_ALB_ROAD (:),'STR','ARI',OCOVER)
+ T%XALB_ROAD ,TOP%XCOVER ,XDATA_ALB_ROAD (:),'STR','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! EMIS_ROAD
! ----------
-IF (PRESENT(PEMIS_ROAD)) THEN
IF (DTT%LDATA_EMIS_ROAD) THEN
- PEMIS_ROAD=DTT%XPAR_EMIS_ROAD
+ T%XEMIS_ROAD=DTT%XPAR_EMIS_ROAD
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PEMIS_ROAD=PEMIS_ROAD)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PEMIS_ROAD=T%XEMIS_ROAD)
ELSE
CALL AV_PGD(DTCO, &
- PEMIS_ROAD ,PCOVER ,XDATA_EMIS_ROAD (:),'STR','ARI',OCOVER)
+ T%XEMIS_ROAD ,TOP%XCOVER ,XDATA_EMIS_ROAD (:),'STR','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! HC_ROAD, TC_ROAD, D_ROAD
! ------------------------
!
-IF (PRESENT(PHC_ROAD) .AND. PRESENT(PTC_ROAD) .AND. PRESENT(PD_ROAD)) THEN
IF (DTT%LDATA_HC_ROAD) THEN
CALL ALLOCATE_THERMAL_WORK(DTT%NPAR_ROAD_LAYER)
ZHC=DTT%XPAR_HC_ROAD
@@ -393,62 +277,46 @@ IF (PRESENT(PHC_ROAD) .AND. PRESENT(PTC_ROAD) .AND. PRESENT(PD_ROAD)) THEN
ZD =DTT%XPAR_D_ROAD
ELSEIF (DTT%LDATA_BLDTYPE) THEN
CALL ALLOCATE_THERMAL_WORK(BDD%NDESC_ROAD_LAYER)
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PHC_ROAD=ZHC)
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PTC_ROAD=ZTC)
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PD_ROAD =ZD )
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PHC_ROAD=ZHC)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PTC_ROAD=ZTC)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PD_ROAD =ZD )
ELSE
CALL ALLOCATE_THERMAL_WORK(NDATA_ROAD_LAYER)
DO JLAYER=1,NDATA_ROAD_LAYER
- CALL AV_PGD(DTCO, &
- ZHC(:,JLAYER), PCOVER, XDATA_HC_ROAD (:,JLAYER),YAREA,YAVG,OCOVER)
- CALL AV_PGD(DTCO, &
- ZTC(:,JLAYER), PCOVER ,XDATA_TC_ROAD (:,JLAYER),YAREA,YAVG,OCOVER)
- CALL AV_PGD(DTCO, &
- ZD (:,JLAYER), PCOVER ,XDATA_D_ROAD (:,JLAYER),YAREA,YAVG,OCOVER)
- !CALL AV_PGD (PHC_ROAD(:,JLAYER), PCOVER, XDATA_HC_ROAD (:,JLAYER),YAREA,YAVG)
- !CALL AV_PGD (PTC_ROAD(:,JLAYER), PCOVER ,XDATA_TC_ROAD (:,JLAYER),YAREA,YAVG)
- !CALL AV_PGD (PD_ROAD(:,JLAYER), PCOVER ,XDATA_D_ROAD (:,JLAYER),YAREA,YAVG)
+ CALL AV_PGD(DTCO, ZHC(:,JLAYER), TOP%XCOVER, XDATA_HC_ROAD (:,JLAYER),YAREA,YAVG,TOP%LCOVER)
+ CALL AV_PGD(DTCO, ZTC(:,JLAYER), TOP%XCOVER ,XDATA_TC_ROAD (:,JLAYER),YAREA,YAVG,TOP%LCOVER)
+ CALL AV_PGD(DTCO, ZD (:,JLAYER), TOP%XCOVER ,XDATA_D_ROAD (:,JLAYER),YAREA,YAVG,TOP%LCOVER)
+ !CALL AV_PGD (T%XHC_ROAD(:,JLAYER), TOP%XCOVER, XDATA_HC_ROAD (:,JLAYER),YAREA,YAVG)
+ !CALL AV_PGD (T%XTC_ROAD(:,JLAYER), TOP%XCOVER ,XDATA_TC_ROAD (:,JLAYER),YAREA,YAVG)
+ !CALL AV_PGD (T%XD_ROAD(:,JLAYER), TOP%XCOVER ,XDATA_D_ROAD (:,JLAYER),YAREA,YAVG)
ENDDO
- ENDIF
- CALL THERMAL_LAYERS_CONF('ROAD ',ZHC,ZTC,ZD,PHC_ROAD,PTC_ROAD,PD_ROAD)
+ ENDIF
+ CALL THERMAL_LAYERS_CONF('ROAD ',ZD,T%XD_ROAD,ZHC,T%XHC_ROAD,ZTC,T%XTC_ROAD)
CALL DEALLOCATE_THERMAL_WORK
-ENDIF
!
! ALB_WALL
! ----------
-IF (PRESENT(PALB_WALL)) THEN
IF (DTT%LDATA_ALB_WALL) THEN
- PALB_WALL=DTT%XPAR_ALB_WALL
+ T%XALB_WALL=DTT%XPAR_ALB_WALL
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PALB_WALL=PALB_WALL)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PALB_WALL=T%XALB_WALL)
ELSE
- CALL AV_PGD(DTCO, &
- PALB_WALL ,PCOVER ,XDATA_ALB_WALL (:),YAREA,YAVG,OCOVER)
+ CALL AV_PGD(DTCO, T%XALB_WALL ,TOP%XCOVER ,XDATA_ALB_WALL (:),YAREA,YAVG,TOP%LCOVER)
ENDIF
-ENDIF
!
! EMIS_WALL
! ----------
-IF (PRESENT(PEMIS_WALL)) THEN
IF (DTT%LDATA_EMIS_WALL) THEN
- PEMIS_WALL=DTT%XPAR_EMIS_WALL
+ T%XEMIS_WALL=DTT%XPAR_EMIS_WALL
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PEMIS_WALL=PEMIS_WALL)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PEMIS_WALL=T%XEMIS_WALL)
ELSE
- CALL AV_PGD(DTCO, &
- PEMIS_WALL ,PCOVER ,XDATA_EMIS_WALL (:),YAREA,YAVG,OCOVER)
+ CALL AV_PGD(DTCO, T%XEMIS_WALL ,TOP%XCOVER ,XDATA_EMIS_WALL (:),YAREA,YAVG,TOP%LCOVER)
ENDIF
-ENDIF
!
! HC_WALL, TC_WALL, D_WALL
! ------------------------
!
-IF (PRESENT(PHC_WALL) .AND. PRESENT(PTC_WALL) .AND. PRESENT(PD_WALL)) THEN
IF (DTT%LDATA_HC_WALL) THEN
CALL ALLOCATE_THERMAL_WORK(DTT%NPAR_WALL_LAYER)
ZHC=DTT%XPAR_HC_WALL
@@ -456,564 +324,404 @@ IF (PRESENT(PHC_WALL) .AND. PRESENT(PTC_WALL) .AND. PRESENT(PD_WALL)) THEN
ZD =DTT%XPAR_D_WALL
ELSEIF (DTT%LDATA_BLDTYPE) THEN
CALL ALLOCATE_THERMAL_WORK(BDD%NDESC_WALL_LAYER)
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PHC_WALL=ZHC)
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PTC_WALL=ZTC)
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PD_WALL =ZD )
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PHC_WALL=ZHC)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PTC_WALL=ZTC)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PD_WALL =ZD )
ELSE
CALL ALLOCATE_THERMAL_WORK(NDATA_WALL_LAYER)
DO JLAYER=1,NDATA_WALL_LAYER
- CALL AV_PGD(DTCO, &
- ZHC(:,JLAYER), PCOVER, XDATA_HC_WALL (:,JLAYER),YAREA,YAVG,OCOVER)
- CALL AV_PGD(DTCO, &
- ZTC(:,JLAYER), PCOVER ,XDATA_TC_WALL (:,JLAYER),YAREA,YAVG,OCOVER)
- CALL AV_PGD(DTCO, &
- ZD (:,JLAYER), PCOVER ,XDATA_D_WALL (:,JLAYER),YAREA,YAVG,OCOVER)
- ENDDO
- ENDIF
- CALL THERMAL_LAYERS_CONF('WALL ',ZHC,ZTC,ZD,PHC_WALL,PTC_WALL,PD_WALL)
- CALL DEALLOCATE_THERMAL_WORK
-ENDIF
-!
-! HC_FLOOR, TC_FLOOR, D_FLOOR
-! ------------------------
-!
-IF (PRESENT(PHC_FLOOR) .AND. PRESENT(PTC_FLOOR) .AND. PRESENT(PD_FLOOR)) THEN
- IF (DTB%LDATA_HC_FLOOR) THEN
- CALL ALLOCATE_THERMAL_WORK(DTB%NPAR_FLOOR_LAYER)
- ZHC=DTB%XPAR_HC_FLOOR
- ZTC=DTB%XPAR_TC_FLOOR
- ZD =DTB%XPAR_D_FLOOR
- ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL ALLOCATE_THERMAL_WORK(BDD%NDESC_FLOOR_LAYER)
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PHC_FLOOR=ZHC)
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PTC_FLOOR=ZTC)
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PD_FLOOR =ZD )
- ELSE
- CALL ALLOCATE_THERMAL_WORK(NDATA_FLOOR_LAYER)
- DO JLAYER=1,NDATA_FLOOR_LAYER
- CALL AV_PGD(DTCO, &
- ZHC(:,JLAYER), PCOVER, XDATA_HC_FLOOR (:,JLAYER),YAREA,YAVG,OCOVER)
- CALL AV_PGD(DTCO, &
- ZTC(:,JLAYER), PCOVER ,XDATA_TC_FLOOR (:,JLAYER),YAREA,YAVG,OCOVER)
- CALL AV_PGD(DTCO, &
- ZD (:,JLAYER), PCOVER ,XDATA_D_FLOOR (:,JLAYER),YAREA,YAVG,OCOVER)
+ CALL AV_PGD(DTCO, ZHC(:,JLAYER), TOP%XCOVER, XDATA_HC_WALL (:,JLAYER),YAREA,YAVG,TOP%LCOVER)
+ CALL AV_PGD(DTCO, ZTC(:,JLAYER), TOP%XCOVER ,XDATA_TC_WALL (:,JLAYER),YAREA,YAVG,TOP%LCOVER)
+ CALL AV_PGD(DTCO, ZD (:,JLAYER), TOP%XCOVER ,XDATA_D_WALL (:,JLAYER),YAREA,YAVG,TOP%LCOVER)
ENDDO
- ENDIF
- CALL THERMAL_LAYERS_CONF('FLOOR',ZHC,ZTC,ZD,PHC_FLOOR,PTC_FLOOR,PD_FLOOR)
+ ENDIF
+ CALL THERMAL_LAYERS_CONF('WALL ',ZD,T%XD_WALL,ZHC,T%XHC_WALL,ZTC,T%XTC_WALL)
CALL DEALLOCATE_THERMAL_WORK
-ENDIF
!
! H_TRAFFIC
! ---------
-IF (PRESENT(PH_TRAFFIC)) THEN
IF (DTT%LDATA_H_TRAFFIC) THEN
- PH_TRAFFIC=DTT%XPAR_H_TRAFFIC
+ T%XH_TRAFFIC=DTT%XPAR_H_TRAFFIC
ELSE
- CALL AV_PGD(DTCO, &
- PH_TRAFFIC ,PCOVER ,XDATA_H_TRAFFIC(:),'TWN','ARI',OCOVER)
- ENDIF
-ENDIF
+ CALL AV_PGD(DTCO, T%XH_TRAFFIC ,TOP%XCOVER ,XDATA_H_TRAFFIC(:),'TWN','ARI',TOP%LCOVER)
+ ENDIF
!
! LE_TRAFFIC
! ----------
-IF (PRESENT(PLE_TRAFFIC)) THEN
IF (DTT%LDATA_LE_TRAFFIC) THEN
- PLE_TRAFFIC=DTT%XPAR_LE_TRAFFIC
+ T%XLE_TRAFFIC=DTT%XPAR_LE_TRAFFIC
ELSE
- CALL AV_PGD(DTCO, &
- PLE_TRAFFIC ,PCOVER ,XDATA_LE_TRAFFIC(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, T%XLE_TRAFFIC ,TOP%XCOVER ,XDATA_LE_TRAFFIC(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! H_INDUSTRY
! ----------
-IF (PRESENT(PH_INDUSTRY)) THEN
IF (DTT%LDATA_H_INDUSTRY) THEN
- PH_INDUSTRY=DTT%XPAR_H_INDUSTRY
+ T%XH_INDUSTRY=DTT%XPAR_H_INDUSTRY
ELSE
- CALL AV_PGD(DTCO, &
- PH_INDUSTRY ,PCOVER ,XDATA_H_INDUSTRY(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, T%XH_INDUSTRY ,TOP%XCOVER ,XDATA_H_INDUSTRY(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
-! SOLAR PANELS
-! ------------
-IF (PRESENT(PEMIS_PANEL)) THEN
- IF (DTT%LDATA_EMIS_PANEL) THEN
- PEMIS_PANEL=DTT%XPAR_EMIS_PANEL
- ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PEMIS_PANEL=PEMIS_PANEL)
+! LE_INDUSTRY
+! -----------
+ IF (DTT%LDATA_LE_INDUSTRY) THEN
+ T%XLE_INDUSTRY=DTT%XPAR_LE_INDUSTRY
ELSE
- CALL AV_PGD(DTCO, &
- PEMIS_PANEL ,PCOVER ,XDATA_EMIS_PANEL(:),'BLD','ARI',OCOVER)
+ CALL AV_PGD(DTCO, T%XLE_INDUSTRY ,TOP%XCOVER ,XDATA_LE_INDUSTRY(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
-IF (PRESENT(PALB_PANEL)) THEN
- IF (DTT%LDATA_ALB_PANEL) THEN
- PALB_PANEL=DTT%XPAR_ALB_PANEL
+!
+! ROUGH_ROOF
+! ----------
+ IF (DTT%LDATA_ROUGH_ROOF) THEN
+ T%XROUGH_ROOF=DTT%XPAR_ROUGH_ROOF
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PALB_PANEL=PALB_PANEL)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PROUGH_ROOF=T%XROUGH_ROOF)
ELSE
- CALL AV_PGD(DTCO, &
- PALB_PANEL ,PCOVER ,XDATA_ALB_PANEL(:),'BLD','ARI',OCOVER)
+ CALL AV_PGD(DTCO, T%XROUGH_ROOF ,TOP%XCOVER ,XDATA_ROUGH_ROOF (:),YAREA,YAVG,TOP%LCOVER)
ENDIF
-ENDIF
!
-IF (PRESENT(PEFF_PANEL)) THEN
- IF (DTT%LDATA_EFF_PANEL) THEN
- PEFF_PANEL=DTT%XPAR_EFF_PANEL
+! ROUGH_WALL
+! ----------
+ IF (DTT%LDATA_ROUGH_WALL) THEN
+ T%XROUGH_WALL=DTT%XPAR_ROUGH_WALL
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PEFF_PANEL=PEFF_PANEL)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PROUGH_WALL=T%XROUGH_WALL)
ELSE
- CALL AV_PGD(DTCO, &
- PEFF_PANEL ,PCOVER ,XDATA_EFF_PANEL(:),'BLD','ARI',OCOVER)
+ CALL AV_PGD(DTCO, T%XROUGH_WALL ,TOP%XCOVER ,XDATA_ROUGH_WALL (:),YAREA,YAVG,TOP%LCOVER)
ENDIF
-ENDIF
!
-IF (PRESENT(PFRAC_PANEL)) THEN
- IF (DTT%LDATA_FRAC_PANEL) THEN
- PFRAC_PANEL=DTT%XPAR_FRAC_PANEL
- ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PFRAC_PANEL=PFRAC_PANEL)
+! RESIDENTIAL use fraction
+! ------------------------
+ IF (DTT%LDATA_RESIDENTIAL) THEN
+ T%XRESIDENTIAL=DTT%XPAR_RESIDENTIAL
+ ELSEIF (DTT%LDATA_USETYPE) THEN
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_USETYPE,PRESIDENTIAL=T%XRESIDENTIAL)
ELSE
- CALL AV_PGD(DTCO, &
- PFRAC_PANEL ,PCOVER ,XDATA_FRAC_PANEL(:),'BLD','ARI',OCOVER)
- ENDIF
+ CALL AV_PGD(DTCO, T%XRESIDENTIAL ,TOP%XCOVER ,XDATA_RESIDENTIAL (:),YAREA,YAVG,TOP%LCOVER)
+ ENDIF
+!
ENDIF
+! HC_FLOOR, TC_FLOOR, D_FLOOR
+! ------------------------
!
-! LE_INDUSTRY
-! -----------
-IF (PRESENT(PLE_INDUSTRY)) THEN
- IF (DTT%LDATA_LE_INDUSTRY) THEN
- PLE_INDUSTRY=DTT%XPAR_LE_INDUSTRY
+IF (PRESENT(B)) THEN
+
+ IF (DTB%LDATA_HC_FLOOR) THEN
+ CALL ALLOCATE_THERMAL_WORK(DTB%NPAR_FLOOR_LAYER)
+ ZHC=DTB%XPAR_HC_FLOOR
+ ZTC=DTB%XPAR_TC_FLOOR
+ ZD =DTB%XPAR_D_FLOOR
+ ELSEIF (DTT%LDATA_BLDTYPE) THEN
+ CALL ALLOCATE_THERMAL_WORK(BDD%NDESC_FLOOR_LAYER)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PHC_FLOOR=ZHC)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PTC_FLOOR=ZTC)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PD_FLOOR =ZD )
ELSE
- CALL AV_PGD(DTCO, &
- PLE_INDUSTRY ,PCOVER ,XDATA_LE_INDUSTRY(:),'TWN','ARI',OCOVER)
- ENDIF
-ENDIF
+ CALL ALLOCATE_THERMAL_WORK(NDATA_FLOOR_LAYER)
+ DO JLAYER=1,NDATA_FLOOR_LAYER
+ CALL AV_PGD(DTCO, ZHC(:,JLAYER), TOP%XCOVER, XDATA_HC_FLOOR (:,JLAYER),YAREA,YAVG,TOP%LCOVER)
+ CALL AV_PGD(DTCO, ZTC(:,JLAYER), TOP%XCOVER ,XDATA_TC_FLOOR (:,JLAYER),YAREA,YAVG,TOP%LCOVER)
+ CALL AV_PGD(DTCO, ZD (:,JLAYER), TOP%XCOVER ,XDATA_D_FLOOR (:,JLAYER),YAREA,YAVG,TOP%LCOVER)
+ ENDDO
+ ENDIF
+ CALL THERMAL_LAYERS_CONF('FLOOR',ZD,B%XD_FLOOR,ZHC,B%XHC_FLOOR,ZTC,B%XTC_FLOOR)
+ CALL DEALLOCATE_THERMAL_WORK
+!
!
! TCOOL_TARGET
! -----------
-IF (PRESENT(PTCOOL_TARGET)) THEN
IF (DTB%LDATA_TCOOL_TARGET) THEN
- PTCOOL_TARGET=DTB%XPAR_TCOOL_TARGET
+ B%XTCOOL_TARGET=DTB%XPAR_TCOOL_TARGET
ELSEIF (DTT%LDATA_USETYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_USETYPE,PTCOOL_TARGET=PTCOOL_TARGET)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_USETYPE,PTCOOL_TARGET=B%XTCOOL_TARGET)
ELSE
- CALL AV_PGD(DTCO, &
- PTCOOL_TARGET ,PCOVER ,XDATA_TCOOL_TARGET(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XTCOOL_TARGET ,TOP%XCOVER ,XDATA_TCOOL_TARGET(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! THEAT_TARGET
! -----------
-IF (PRESENT(PTHEAT_TARGET)) THEN
IF (DTB%LDATA_THEAT_TARGET) THEN
- PTHEAT_TARGET=DTB%XPAR_THEAT_TARGET
+ B%XTHEAT_TARGET=DTB%XPAR_THEAT_TARGET
ELSEIF (DTT%LDATA_USETYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_USETYPE,PTHEAT_TARGET=PTHEAT_TARGET)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_USETYPE,PTHEAT_TARGET=B%XTHEAT_TARGET)
ELSE
- CALL AV_PGD(DTCO, &
- PTHEAT_TARGET ,PCOVER ,XDATA_THEAT_TARGET(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XTHEAT_TARGET ,TOP%XCOVER ,XDATA_THEAT_TARGET(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! -----------
-IF (PRESENT(PF_WASTE_CAN)) THEN
IF (DTB%LDATA_F_WASTE_CAN) THEN
- PF_WASTE_CAN=DTB%XPAR_F_WASTE_CAN
+ B%XF_WASTE_CAN=DTB%XPAR_F_WASTE_CAN
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PF_WASTE_CAN=PF_WASTE_CAN)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PF_WASTE_CAN=B%XF_WASTE_CAN)
ELSE
- CALL AV_PGD(DTCO, &
- PF_WASTE_CAN ,PCOVER ,XDATA_F_WASTE_CAN(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XF_WASTE_CAN ,TOP%XCOVER ,XDATA_F_WASTE_CAN(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! EFF_HEAT
! -----------
-IF (PRESENT(PEFF_HEAT)) THEN
IF (DTB%LDATA_EFF_HEAT) THEN
- PEFF_HEAT=DTB%XPAR_EFF_HEAT
+ B%XEFF_HEAT=DTB%XPAR_EFF_HEAT
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PEFF_HEAT=PEFF_HEAT)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PEFF_HEAT=B%XEFF_HEAT)
ELSE
- CALL AV_PGD(DTCO, &
- PEFF_HEAT ,PCOVER ,XDATA_EFF_HEAT(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XEFF_HEAT ,TOP%XCOVER ,XDATA_EFF_HEAT(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! QIN
! -----------
-IF (PRESENT(PQIN)) THEN
IF (DTB%LDATA_QIN) THEN
- PQIN=DTB%XPAR_QIN
+ B%XQIN=DTB%XPAR_QIN
ELSEIF (DTT%LDATA_USETYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_USETYPE,PQIN=PQIN)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_USETYPE,PQIN=B%XQIN)
ELSE
- CALL AV_PGD(DTCO, &
- PQIN ,PCOVER ,XDATA_QIN(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XQIN ,TOP%XCOVER ,XDATA_QIN(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! QIN_FRAD
! -----------
-IF (PRESENT(PQIN_FRAD)) THEN
IF (DTB%LDATA_QIN_FRAD) THEN
- PQIN_FRAD=DTB%XPAR_QIN_FRAD
+ B%XQIN_FRAD=DTB%XPAR_QIN_FRAD
ELSEIF (DTT%LDATA_USETYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_USETYPE,PQIN_FRAD=PQIN_FRAD)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_USETYPE,PQIN_FRAD=B%XQIN_FRAD)
ELSE
- CALL AV_PGD(DTCO, &
- PQIN_FRAD ,PCOVER ,XDATA_QIN_FRAD(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XQIN_FRAD ,TOP%XCOVER ,XDATA_QIN_FRAD(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! SHGC
! -----------
-IF (PRESENT(PSHGC)) THEN
IF (DTB%LDATA_SHGC) THEN
- PSHGC=DTB%XPAR_SHGC
+ B%XSHGC=DTB%XPAR_SHGC
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PSHGC=PSHGC)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PSHGC=B%XSHGC)
ELSE
- CALL AV_PGD(DTCO, &
- PSHGC ,PCOVER ,XDATA_SHGC(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XSHGC ,TOP%XCOVER ,XDATA_SHGC(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! U_WIN
! -----------
-IF (PRESENT(PU_WIN)) THEN
IF (DTB%LDATA_U_WIN) THEN
- PU_WIN=DTB%XPAR_U_WIN
+ B%XU_WIN=DTB%XPAR_U_WIN
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PU_WIN=PU_WIN)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PU_WIN=B%XU_WIN)
ELSE
- CALL AV_PGD(DTCO, &
- PU_WIN ,PCOVER ,XDATA_U_WIN(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XU_WIN ,TOP%XCOVER ,XDATA_U_WIN(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! GR
! -----------
-IF (PRESENT(PGR)) THEN
IF (DTB%LDATA_GR) THEN
- PGR=DTB%XPAR_GR
+ B%XGR=DTB%XPAR_GR
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PGR=PGR)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PGR=B%XGR)
ELSE
- CALL AV_PGD(DTCO, &
- PGR ,PCOVER ,XDATA_GR(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XGR ,TOP%XCOVER ,XDATA_GR(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! SHGC_SH
! -----------
-IF (PRESENT(PSHGC_SH)) THEN
IF (DTB%LDATA_SHGC_SH) THEN
- PSHGC_SH=DTB%XPAR_SHGC_SH
+ B%XSHGC_SH=DTB%XPAR_SHGC_SH
ELSEIF (DTT%LDATA_USETYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_USETYPE,PSHGC_SH=PSHGC_SH)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_USETYPE,PSHGC_SH=B%XSHGC_SH)
ELSE
- CALL AV_PGD(DTCO, &
- PSHGC_SH ,PCOVER ,XDATA_SHGC_SH(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XSHGC_SH ,TOP%XCOVER ,XDATA_SHGC_SH(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! FLOOR_HEIGHT
! -----------
-IF (PRESENT(PFLOOR_HEIGHT)) THEN
IF (DTB%LDATA_FLOOR_HEIGHT) THEN
- PFLOOR_HEIGHT=DTB%XPAR_FLOOR_HEIGHT
+ B%XFLOOR_HEIGHT=DTB%XPAR_FLOOR_HEIGHT
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PFLOOR_HEIGHT=PFLOOR_HEIGHT)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PFLOOR_HEIGHT=B%XFLOOR_HEIGHT)
ELSE
- CALL AV_PGD(DTCO, &
- PFLOOR_HEIGHT ,PCOVER ,XDATA_FLOOR_HEIGHT(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XFLOOR_HEIGHT ,TOP%XCOVER ,XDATA_FLOOR_HEIGHT(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! INF
! -----------
-IF (PRESENT(PINF)) THEN
IF (DTB%LDATA_INF) THEN
- PINF=DTB%XPAR_INF
+ B%XINF=DTB%XPAR_INF
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PINF=PINF)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PINF=B%XINF)
ELSE
- CALL AV_PGD(DTCO, &
- PINF ,PCOVER ,XDATA_INF(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XINF ,TOP%XCOVER ,XDATA_INF(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! F_WATER_COND
! -----------
-IF (PRESENT(PF_WATER_COND)) THEN
IF (DTB%LDATA_F_WATER_COND) THEN
- PF_WATER_COND=DTB%XPAR_F_WATER_COND
+ B%XF_WATER_COND=DTB%XPAR_F_WATER_COND
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PF_WATER_COND=PF_WATER_COND)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PF_WATER_COND=B%XF_WATER_COND)
ELSE
- CALL AV_PGD(DTCO, &
- PF_WATER_COND ,PCOVER ,XDATA_F_WATER_COND(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XF_WATER_COND ,TOP%XCOVER ,XDATA_F_WATER_COND(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! QIN_FLAT
! -----------
-IF (PRESENT(PQIN_FLAT)) THEN
IF (DTB%LDATA_QIN_FLAT) THEN
- PQIN_FLAT=DTB%XPAR_QIN_FLAT
+ B%XQIN_FLAT=DTB%XPAR_QIN_FLAT
ELSEIF (DTT%LDATA_USETYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_USETYPE,PQIN_FLAT=PQIN_FLAT)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_USETYPE,PQIN_FLAT=B%XQIN_FLAT)
ELSE
- CALL AV_PGD(DTCO, &
- PQIN_FLAT ,PCOVER ,XDATA_QIN_FLAT(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XQIN_FLAT ,TOP%XCOVER ,XDATA_QIN_FLAT(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! HR_TARGET
! -----------
-IF (PRESENT(PHR_TARGET)) THEN
IF (DTB%LDATA_HR_TARGET) THEN
- PHR_TARGET=DTB%XPAR_HR_TARGET
+ B%XHR_TARGET=DTB%XPAR_HR_TARGET
ELSEIF (DTT%LDATA_USETYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_USETYPE,PHR_TARGET=PHR_TARGET)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_USETYPE,PHR_TARGET=B%XHR_TARGET)
ELSE
- CALL AV_PGD(DTCO, &
- PHR_TARGET ,PCOVER ,XDATA_HR_TARGET(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XHR_TARGET ,TOP%XCOVER ,XDATA_HR_TARGET(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! V_VENT
! -----------
-IF (PRESENT(PV_VENT)) THEN
IF (DTB%LDATA_V_VENT) THEN
- PV_VENT=DTB%XPAR_V_VENT
+ B%XV_VENT=DTB%XPAR_V_VENT
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PV_VENT=PV_VENT)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PV_VENT=B%XV_VENT)
ELSE
- CALL AV_PGD(DTCO, &
- PV_VENT ,PCOVER ,XDATA_V_VENT(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XV_VENT ,TOP%XCOVER ,XDATA_V_VENT(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! CAP_SYS_HEAT
! -----------
-IF (PRESENT(PCAP_SYS_HEAT)) THEN
IF (DTB%LDATA_CAP_SYS_HEAT) THEN
- PCAP_SYS_HEAT=DTB%XPAR_CAP_SYS_HEAT
+ B%XCAP_SYS_HEAT=DTB%XPAR_CAP_SYS_HEAT
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PCAP_SYS_HEAT=PCAP_SYS_HEAT)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PCAP_SYS_HEAT=B%XCAP_SYS_HEAT)
ELSE
- CALL AV_PGD(DTCO, &
- PCAP_SYS_HEAT ,PCOVER ,XDATA_CAP_SYS_HEAT(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XCAP_SYS_HEAT ,TOP%XCOVER ,XDATA_CAP_SYS_HEAT(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! CAP_SYS_RAT
! -----------
-IF (PRESENT(PCAP_SYS_RAT)) THEN
IF (DTB%LDATA_CAP_SYS_RAT) THEN
- PCAP_SYS_RAT=DTB%XPAR_CAP_SYS_RAT
+ B%XCAP_SYS_RAT=DTB%XPAR_CAP_SYS_RAT
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PCAP_SYS_RAT=PCAP_SYS_RAT)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PCAP_SYS_RAT=B%XCAP_SYS_RAT)
ELSE
- CALL AV_PGD(DTCO, &
- PCAP_SYS_RAT ,PCOVER ,XDATA_CAP_SYS_RAT(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XCAP_SYS_RAT ,TOP%XCOVER ,XDATA_CAP_SYS_RAT(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! T_ADP
! -----------
-IF (PRESENT(PT_ADP)) THEN
IF (DTB%LDATA_T_ADP) THEN
- PT_ADP=DTB%XPAR_T_ADP
+ B%XT_ADP=DTB%XPAR_T_ADP
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PT_ADP=PT_ADP)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PT_ADP=B%XT_ADP)
ELSE
- CALL AV_PGD(DTCO, &
- PT_ADP ,PCOVER ,XDATA_T_ADP(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XT_ADP ,TOP%XCOVER ,XDATA_T_ADP(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! M_SYS_RAT
! -----------
-IF (PRESENT(PM_SYS_RAT)) THEN
IF (DTB%LDATA_M_SYS_RAT) THEN
- PM_SYS_RAT=DTB%XPAR_M_SYS_RAT
+ B%XM_SYS_RAT=DTB%XPAR_M_SYS_RAT
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PM_SYS_RAT=PM_SYS_RAT)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PM_SYS_RAT=B%XM_SYS_RAT)
ELSE
- CALL AV_PGD(DTCO, &
- PM_SYS_RAT ,PCOVER ,XDATA_M_SYS_RAT(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XM_SYS_RAT ,TOP%XCOVER ,XDATA_M_SYS_RAT(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! COP_RAT
! -----------
-IF (PRESENT(PCOP_RAT)) THEN
IF (DTB%LDATA_COP_RAT) THEN
- PCOP_RAT=DTB%XPAR_COP_RAT
+ B%XCOP_RAT=DTB%XPAR_COP_RAT
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PCOP_RAT=PCOP_RAT)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PCOP_RAT=B%XCOP_RAT)
ELSE
- CALL AV_PGD(DTCO, &
- PCOP_RAT ,PCOVER ,XDATA_COP_RAT(:),'TWN','ARI',OCOVER)
- ENDIF
-ENDIF
-!
-! GREENROOF FRACTION
-! ------------------
-IF (PRESENT(PGREENROOF)) THEN
- IF (DTT%LDATA_GREENROOF) THEN
- PGREENROOF=DTT%XPAR_GREENROOF
- ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PGREENROOF=PGREENROOF)
- ELSE
- CALL AV_PGD(DTCO, &
- PGREENROOF,PCOVER ,XDATA_FRAC_GR(:),'BLD','ARI',OCOVER)
- ENDIF
-ENDIF
+ CALL AV_PGD(DTCO, B%XCOP_RAT ,TOP%XCOVER ,XDATA_COP_RAT(:),'TWN','ARI',TOP%LCOVER)
+ ENDIF
!
! T_SIZE_MAX
! -----------
-IF (PRESENT(PT_SIZE_MAX)) THEN
IF (DTB%LDATA_T_SIZE_MAX) THEN
- PT_SIZE_MAX=DTB%XPAR_T_SIZE_MAX
+ B%XT_SIZE_MAX=DTB%XPAR_T_SIZE_MAX
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PT_SIZE_MAX=PT_SIZE_MAX)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PT_SIZE_MAX=B%XT_SIZE_MAX)
ELSE
- CALL AV_PGD(DTCO, &
- PT_SIZE_MAX ,PCOVER ,XDATA_T_SIZE_MAX(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XT_SIZE_MAX ,TOP%XCOVER ,XDATA_T_SIZE_MAX(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! T_SIZE_MIN
! -----------
-IF (PRESENT(PT_SIZE_MIN)) THEN
IF (DTB%LDATA_T_SIZE_MIN) THEN
- PT_SIZE_MIN=DTB%XPAR_T_SIZE_MIN
+ B%XT_SIZE_MIN=DTB%XPAR_T_SIZE_MIN
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PT_SIZE_MIN=PT_SIZE_MIN)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PT_SIZE_MIN=B%XT_SIZE_MIN)
ELSE
- CALL AV_PGD(DTCO, &
- PT_SIZE_MIN ,PCOVER ,XDATA_T_SIZE_MIN(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XT_SIZE_MIN ,TOP%XCOVER ,XDATA_T_SIZE_MIN(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! SHADE
! -----
-IF (PRESENT(PSHADE)) THEN
IF (DTB%LDATA_SHADE) THEN
- PSHADE(:) = DTB%XPAR_SHADE(:)
+ B%XSHADE(:) = DTB%XPAR_SHADE(:)
ELSEIF (DTT%LDATA_USETYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_USETYPE,PSHADE=PSHADE)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_USETYPE,PSHADE=B%XSHADE)
ELSE
- CALL AV_PGD(DTCO, &
- PSHADE,PCOVER ,XDATA_SHADE(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XSHADE,TOP%XCOVER ,XDATA_SHADE(:),'TWN','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
! NATVENT
! -------
-IF (PRESENT(PNATVENT)) THEN
IF (DTB%LDATA_NATVENT) THEN
- PNATVENT(:) = DTB%XPAR_NATVENT(:)
+ B%XNATVENT(:) = DTB%XPAR_NATVENT(:)
ELSEIF (DTT%LDATA_USETYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_USETYPE,PNATVENT=PNATVENT)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_USETYPE,PNATVENT=B%XNATVENT)
ELSE
- CALL AV_PGD(DTCO, &
- PNATVENT,PCOVER,XDATA_NATVENT(:),'TWN','ARI',OCOVER)
+ CALL AV_PGD(DTCO, B%XNATVENT,TOP%XCOVER,XDATA_NATVENT(:),'TWN','ARI',TOP%LCOVER)
ENDIF
+!
ENDIF
!
+IF (PRESENT(TPN)) THEN
!
-! ROUGH_ROOF
-! ----------
-IF (PRESENT(PROUGH_ROOF)) THEN
- IF (DTT%LDATA_ROUGH_ROOF) THEN
- PROUGH_ROOF=DTT%XPAR_ROUGH_ROOF
+! SOLAR PANELS
+! ------------
+ IF (DTT%LDATA_EMIS_PANEL) THEN
+ TPN%XEMIS_PANEL=DTT%XPAR_EMIS_PANEL
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PROUGH_ROOF=PROUGH_ROOF)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PEMIS_PANEL=TPN%XEMIS_PANEL)
ELSE
- CALL AV_PGD(DTCO, &
- PROUGH_ROOF ,PCOVER ,XDATA_ROUGH_ROOF (:),YAREA,YAVG,OCOVER)
+ CALL AV_PGD(DTCO, TPN%XEMIS_PANEL ,TOP%XCOVER ,XDATA_EMIS_PANEL(:),'BLD','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
-! ROUGH_WALL
-! ----------
-IF (PRESENT(PROUGH_WALL)) THEN
- IF (DTT%LDATA_ROUGH_WALL) THEN
- PROUGH_WALL=DTT%XPAR_ROUGH_WALL
+ IF (DTT%LDATA_ALB_PANEL) THEN
+ TPN%XALB_PANEL=DTT%XPAR_ALB_PANEL
ELSEIF (DTT%LDATA_BLDTYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_BLDCODE,PROUGH_WALL=PROUGH_WALL)
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PALB_PANEL=TPN%XALB_PANEL)
ELSE
- CALL AV_PGD(DTCO, &
- PROUGH_WALL ,PCOVER ,XDATA_ROUGH_WALL (:),YAREA,YAVG,OCOVER)
+ CALL AV_PGD(DTCO, TPN%XALB_PANEL ,TOP%XCOVER ,XDATA_ALB_PANEL(:),'BLD','ARI',TOP%LCOVER)
ENDIF
-ENDIF
!
-! RESIDENTIAL use fraction
-! ------------------------
-IF (PRESENT(PRESIDENTIAL)) THEN
- IF (DTT%LDATA_RESIDENTIAL) THEN
- PRESIDENTIAL=DTT%XPAR_RESIDENTIAL
- ELSEIF (DTT%LDATA_USETYPE) THEN
- CALL INI_DATA_PARAM_TEB(BDD, &
- DTT%NPAR_USETYPE,PRESIDENTIAL=PRESIDENTIAL)
+ IF (DTT%LDATA_EFF_PANEL) THEN
+ TPN%XEFF_PANEL=DTT%XPAR_EFF_PANEL
+ ELSEIF (DTT%LDATA_BLDTYPE) THEN
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PEFF_PANEL=TPN%XEFF_PANEL)
ELSE
- CALL AV_PGD(DTCO, &
- PRESIDENTIAL ,PCOVER ,XDATA_RESIDENTIAL (:),YAREA,YAVG,OCOVER)
+ CALL AV_PGD(DTCO, TPN%XEFF_PANEL ,TOP%XCOVER ,XDATA_EFF_PANEL(:),'BLD','ARI',TOP%LCOVER)
ENDIF
+!
+ IF (DTT%LDATA_FRAC_PANEL) THEN
+ TPN%XFRAC_PANEL=DTT%XPAR_FRAC_PANEL
+ ELSEIF (DTT%LDATA_BLDTYPE) THEN
+ CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PFRAC_PANEL=TPN%XFRAC_PANEL)
+ ELSE
+ CALL AV_PGD(DTCO, TPN%XFRAC_PANEL ,TOP%XCOVER ,XDATA_FRAC_PANEL(:),'BLD','ARI',TOP%LCOVER)
+ ENDIF
+!
ENDIF
-!
!
IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_TEB',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!
SUBROUTINE ALLOCATE_THERMAL_WORK(KPAR)
INTEGER, INTENT(IN) :: KPAR
diff --git a/src/SURFEX/convert_patch_teb_greenroof.F90 b/src/SURFEX/convert_patch_teb_greenroof.F90
deleted file mode 100644
index acd08dab59a6e5eb29d0a9689a7efd9d2c2442a6..0000000000000000000000000000000000000000
--- a/src/SURFEX/convert_patch_teb_greenroof.F90
+++ /dev/null
@@ -1,192 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-!#############################################################
-SUBROUTINE CONVERT_PATCH_TEB_GREENROOF (DTCO, DTI, I, TGRO, TGRPE, TGRP, TOP, TVG, &
- KLU,KDECADE)
-!#############################################################
-!
-!!**** *CONVERT_PATCH_TEB_GREENROOF* - routine to initialize TEB_GREENROOF parameters
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! A. Lemonsu *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 09/2009
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
-USE MODD_TEB_GREENROOF_PGD_EVOL_n, ONLY : TEB_GREENROOF_PGD_EVOL_t
-USE MODD_TEB_GREENROOF_PGD_n, ONLY : TEB_GREENROOF_PGD_t
-USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
-!
-USE MODD_TYPE_DATE_SURF, ONLY: DATE_TIME
-!
-USE MODI_CONVERT_PATCH_ISBA
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
-!
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: TGRO
-TYPE(TEB_GREENROOF_PGD_EVOL_t), INTENT(INOUT) :: TGRPE
-TYPE(TEB_GREENROOF_PGD_t), INTENT(INOUT) :: TGRP
-TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
-!
-INTEGER, INTENT(IN) :: KLU ! number of points
-INTEGER, INTENT(IN) :: KDECADE ! number of decades
-!
-!
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-REAL, DIMENSION(KLU,1) :: ZLAI
-REAL, DIMENSION(KLU,1) :: ZVEG
-REAL, DIMENSION(KLU,1) :: ZZ0
-REAL, DIMENSION(KLU,1) :: ZALBNIR
-REAL, DIMENSION(KLU,1) :: ZALBVIS
-REAL, DIMENSION(KLU,1) :: ZALBUV
-REAL, DIMENSION(KLU,1) :: ZEMIS
-REAL, DIMENSION(KLU,1) :: ZRSMIN
-REAL, DIMENSION(KLU,1) :: ZGAMMA
-REAL, DIMENSION(KLU,1) :: ZWRMAX_CF
-REAL, DIMENSION(KLU,1) :: ZRGL
-REAL, DIMENSION(KLU,1) :: ZCV
-REAL, DIMENSION(KLU,1) :: ZGMES
-REAL, DIMENSION(KLU,1) :: ZBSLAI
-REAL, DIMENSION(KLU,1) :: ZLAIMIN
-REAL, DIMENSION(KLU,1) :: ZSEFOLD
-REAL, DIMENSION(KLU,1) :: ZGC
-REAL, DIMENSION(KLU,1) :: ZDMAX
-REAL, DIMENSION(KLU,1) :: ZF2I
-REAL, DIMENSION(KLU,1) :: ZALBNIR_VEG
-REAL, DIMENSION(KLU,1) :: ZALBVIS_VEG
-REAL, DIMENSION(KLU,1) :: ZALBUV_VEG
-REAL, DIMENSION(KLU,1) :: ZALBNIR_SOIL
-REAL, DIMENSION(KLU,1) :: ZALBVIS_SOIL
-REAL, DIMENSION(KLU,1) :: ZALBUV_SOIL
-REAL, DIMENSION(KLU,1) :: ZCE_NITRO
-REAL, DIMENSION(KLU,1) :: ZCF_NITRO
-REAL, DIMENSION(KLU,1) :: ZCNA_NITRO
-REAL, DIMENSION(KLU,1) :: ZRE25
-REAL, DIMENSION(KLU,1) :: ZH_TREE
-REAL, DIMENSION(KLU,TGRO%NLAYER_GR,1) :: ZROOTFRAC
-REAL, DIMENSION(KLU,TGRO%NLAYER_GR,1) :: ZDG
-REAL, DIMENSION(KLU,1) :: ZDROOT
-REAL, DIMENSION(KLU,1) :: ZDG2
-INTEGER, DIMENSION(KLU,1) :: IWG_LAYER
-REAL, DIMENSION(KLU,1) :: ZZ0_O_Z0H
-REAL, DIMENSION(KLU,1) :: ZD_ICE
-LOGICAL, DIMENSION(KLU,1) :: GSTRESS
-
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-! Initialisation for IO
-!
-IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_TEB_GREENROOF',0,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-!
- CALL CONVERT_PATCH_ISBA(DTCO, DTI, I, &
- TVG%CISBA,KDECADE,KDECADE,TOP%XCOVER,TOP%LCOVER,TVG%CPHOTO,.FALSE., &
- .FALSE.,TVG%LTR_ML,'GRD',PVEG=ZVEG,PLAI=ZLAI, &
- PRSMIN=ZRSMIN,PGAMMA=ZGAMMA,PWRMAX_CF=ZWRMAX_CF, &
- PRGL=ZRGL,PCV=ZCV,PSOILGRID=TGRO%XSOILGRID_GR, &
- PDG=ZDG,KWG_LAYER=IWG_LAYER,PDROOT=ZDROOT,PDG2=ZDG2, &
- PZ0=ZZ0,PZ0_O_Z0H=ZZ0_O_Z0H, &
- PALBNIR_VEG=ZALBNIR_VEG,PALBVIS_VEG=ZALBVIS_VEG, &
- PALBUV_VEG=ZALBUV_VEG,PEMIS_ECO=ZEMIS, &
- PVEGTYPE=TGRP%XVEGTYPE,PROOTFRAC=ZROOTFRAC, &
- PGMES=ZGMES,PBSLAI=ZBSLAI,PLAIMIN=ZLAIMIN, &
- PSEFOLD=ZSEFOLD,PGC=ZGC, &
- PDMAX=ZDMAX,PF2I=ZF2I,OSTRESS=GSTRESS,PH_TREE=ZH_TREE, &
- PRE25=ZRE25,PCE_NITRO=ZCE_NITRO,PCF_NITRO=ZCF_NITRO, &
- PCNA_NITRO=ZCNA_NITRO,PD_ICE=ZD_ICE )
-!
-TGRPE%CUR%XVEG = ZVEG(:,1)
-TGRPE%CUR%XLAI = ZLAI(:,1)
-TGRPE%CUR%XZ0 = ZZ0(:,1)
-TGRPE%CUR%XALBNIR = ZALBNIR(:,1)
-TGRPE%CUR%XALBVIS = ZALBVIS(:,1)
-TGRPE%CUR%XALBUV = ZALBUV(:,1)
-TGRPE%CUR%XEMIS = ZEMIS(:,1)
-TGRP%XRSMIN = ZRSMIN(:,1)
-TGRP%XGAMMA = ZGAMMA(:,1)
-TGRP%XWRMAX_CF = ZWRMAX_CF(:,1)
-TGRP%XRGL = ZRGL(:,1)
-TGRP%XCV = ZCV(:,1)
-TGRP%XGMES = ZGMES(:,1)
-TGRP%XBSLAI = ZBSLAI(:,1)
-TGRP%XLAIMIN = ZLAIMIN(:,1)
-TGRP%XSEFOLD = ZSEFOLD(:,1)
-TGRP%XGC = ZGC(:,1)
-TGRP%XDMAX = ZDMAX(:,1)
-TGRP%XF2I = ZF2I(:,1)
-TGRP%LSTRESS = GSTRESS(:,1)
-TGRP%XALBNIR_VEG = ZALBNIR_VEG(:,1)
-TGRP%XALBVIS_VEG = ZALBVIS_VEG(:,1)
-TGRP%XALBUV_VEG = ZALBUV_VEG(:,1)
-TGRP%XALBNIR_SOIL = ZALBNIR_SOIL(:,1)
-TGRP%XALBVIS_SOIL = ZALBVIS_SOIL(:,1)
-TGRP%XALBUV_SOIL = ZALBUV_SOIL(:,1)
-TGRP%XCE_NITRO = ZCE_NITRO(:,1)
-TGRP%XCF_NITRO = ZCF_NITRO(:,1)
-TGRP%XCNA_NITRO = ZCNA_NITRO(:,1)
-TGRP%XH_TREE = ZH_TREE(:,1)
-TGRP%XRE25 = ZRE25(:,1)
-TGRP%XROOTFRAC = ZROOTFRAC(:,:,1)
-TGRP%XDG = ZDG(:,:,1)
-TGRP%XZ0_O_Z0H = ZZ0_O_Z0H(:,1)
-TGRP%XD_ICE = ZD_ICE(:,1)
-!
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_TEB_GREENROOF',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-!
-END SUBROUTINE CONVERT_PATCH_TEB_GREENROOF
diff --git a/src/SURFEX/convert_teb.F90 b/src/SURFEX/convert_teb.F90
index dab94b4fb2206e0eb541009fde0232dcac623d20..eb4a5b77bcb1acead7aa4ecbbc031efe1a15ff7d 100644
--- a/src/SURFEX/convert_teb.F90
+++ b/src/SURFEX/convert_teb.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ######spl
- SUBROUTINE CONVERT_TEB (TOP, &
- PCOVER,PTEB_PATCH)
+ SUBROUTINE CONVERT_TEB (KTEB_PATCH,PCOVER,PTEB_PATCH)
! ##############################################################
!
!!**** *CONVERT_TEB* initialisation of TEB parameters valid for all patches
@@ -40,9 +39,6 @@
!* 0. DECLARATION
! -----------
!
-!
-USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
!
@@ -60,7 +56,7 @@ IMPLICIT NONE
! ------------------------
!
!
-TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+INTEGER, INTENT(IN) :: KTEB_PATCH
!
REAL, DIMENSION(:,:), INTENT(IN) :: PCOVER
!
@@ -89,8 +85,8 @@ IF (LHOOK) CALL DR_HOOK('CONVERT_TEB',0,ZHOOK_HANDLE)
! GARDEN fraction
! ---------------
IF (PRESENT(PTEB_PATCH)) THEN
- DO JPATCH=1,TOP%NTEB_PATCH
- PTEB_PATCH(:,JPATCH) = 1./FLOAT(TOP%NTEB_PATCH)
+ DO JPATCH=1,KTEB_PATCH
+ PTEB_PATCH(:,JPATCH) = 1./FLOAT(KTEB_PATCH)
END DO
ENDIF
!
diff --git a/src/SURFEX/cotwoinitn.F90 b/src/SURFEX/cotwoinitn.F90
index 5b2bd89fc49f5f54917bbb83e85a9d5b51d5b78e..61712296b650b86d0aac51f2242fdb552bfa94da 100644
--- a/src/SURFEX/cotwoinitn.F90
+++ b/src/SURFEX/cotwoinitn.F90
@@ -3,12 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE COTWOINIT_n (I, &
- HPHOTO,PVEGTYPE,PGMES,PCO2,PGC,PDMAX, &
- PABC,PPOI,PANMAX, &
- PFZERO,PEPSO,PGAMM,PQDGAMM,PQDGMES,PT1GMES, &
- PT2GMES,PAMAX,PQDAMAX,PT1AMAX,PT2AMAX,PAH,PBH, &
- PTAU_WOOD )
+ SUBROUTINE COTWOINIT_n (IO, S, PK, PEK, PCO2 )
! #######################################################################
!
!!**** *COTWOINIT*
@@ -47,7 +42,7 @@
!! MODIFICATIONS
!! -------------
!! Original 27/10/97
-!! (V. Rivalland) 10/04/02 Add: PAH and PBH coefficients for
+!! (V. Rivalland) 10/04/02 Add: PK%XAH and PK%XBH coefficients for
!! herbaceous water stress response
!! (P. LeMoigne) 03/2004: computation of zgmest in SI units
!! (P. LeMoigne) 10/2004: possibility of 2 different FZERO
@@ -63,19 +58,20 @@
!!
!-------------------------------------------------------------------------------
!
+USE MODD_DATA_COVER_PAR, ONLY :
!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_P_t, ISBA_S_t, ISBA_PE_t
!
-USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, NVT_C3, NVT_C4, NVT_IRR, NVT_TROG, &
- NVT_TEBD, NVT_BONE, NVT_TRBE, NVT_TRBD, NVT_TEBE,&
- NVT_TENE, NVT_BOBD, NVT_BOND, NVT_SHRB, NVT_GRAS
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE_ECOSG, NVEGTYPE, NVT_C3, NVT_C3W, NVT_C3S, NVT_C4, NVT_IRR, &
+ NVT_TROG, NVT_TEBD, NVT_BONE, NVT_TRBE, NVT_TRBD, &
+ NVT_TEBE, NVT_TENE, NVT_BOBD, NVT_BOND, NVT_SHRB, NVT_GRAS
USE MODD_CSTS, ONLY : XMD
USE MODD_CO2V_PAR, ONLY : XTOPT, XFZERO1, XFZERO2, XFZEROTROP, XEPSO, XGAMM, XQDGAMM, &
- XQDGMES, XT1GMES, XT2GMES, XAMAX, &
+ XQDGMES, XT1GMES, XT2GMES, XAMAX, ITRANSFERT_ESG, &
XQDAMAX, XT1AMAX, XT2AMAX, XAH, XBH, &
XDSPOPT, XIAOPT, XAW, XBW, XMCO2, XMC, XTAU_WOOD
!
-USE MODE_COTWO, ONLY : GAULEG
USE MODI_COTWO
!
!* 0. DECLARATIONS
@@ -89,65 +85,15 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
!
-!
-TYPE(ISBA_t), INTENT(INOUT) :: I
-!
- CHARACTER(LEN=3), INTENT(IN) :: HPHOTO ! type of photosynthesis
-REAL,DIMENSION(:,:),INTENT(IN) :: PVEGTYPE
-! PVEGTYPE = fraction of each
-! vegetation classification index;
-! C3 =>1, C4 => 2
-!
-REAL,DIMENSION(:),INTENT(IN) :: PGMES, PCO2
-! PGMES = mesophyll conductance (m s-1)
+REAL,DIMENSION(:),INTENT(IN) :: PCO2
+! PK%XGMES = mesophyll conductance (m s-1)
! PCO2 = atmospheric CO2 concentration
!
-REAL,DIMENSION(:),INTENT(IN) :: PDMAX, PGC
-! PDMAX = maximum air saturation deficit tolerate
-! by vegetation
-! PGC = cuticular conductance (m s-1)
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PABC, PPOI
-! ZABC = abscissa needed for integration
-! of net assimilation and stomatal conductance
-! over canopy depth
-! ZPOI = Gaussian weights (as above)
-!
-REAL,DIMENSION(:),INTENT(OUT) :: PANMAX
-! PANMAX = maximum net assimilation
-!
-REAL,DIMENSION(:),INTENT(OUT) :: PFZERO, PEPSO, PGAMM, PQDGAMM, PQDGMES, &
- PT1GMES, PT2GMES, PAMAX, PQDAMAX, &
- PT1AMAX, PT2AMAX, PTAU_WOOD
-! PFZERO = ideal value of F, no photorespiration or
-! saturation deficit
-! PEPSO = maximum initial quantum use efficiency
-! (kgCO2 kgAir-1 J-1 PAR)
-! PGAMM = CO2 conpensation concentration (kgCO2 kgAir-1)
-! PQDGAMM = Log of Q10 function for CO2 conpensation
-! concentration
-! PQDGMES = Log of Q10 function for mesophyll conductance
-! PT1GMES = reference temperature for computing
-! compensation concentration function for
-! mesophyll conductance: minimum temperature
-! PT2GMES = reference temperature for computing
-! compensation concentration function for
-! mesophyll conductance: maximum temperature
-! PAMAX = leaf photosynthetic capacity (Units of kgCO2 kgAir-1 m s-1)
-! PQDAMAX = Log of Q10 function for leaf photosynthetic capacity
-! PT1AMAX = reference temperature for computing
-! compensation concentration function for leaf
-! photosynthetic capacity: minimum temperature
-! PT2AMAX = reference temperature for computing
-! compensation concentration function for leaf
-! photosynthetic capacity: maximum temperature
-! PTAU_WOOD = residence time in woody biomass (s)
-!
-REAL,DIMENSION(:),INTENT(OUT) :: PAH, PBH
-! PAH = coeficient of universal relationship for herbaceous
-! PBH = coeficient of universal relationship for herbaceous
-!
!* 0.2 declaration of local variables
!
INTEGER :: JCLASS ! indexes for loops
@@ -155,7 +101,7 @@ INTEGER :: ICLASS ! indexes for loops
INTEGER :: ICO2TYPE ! type of CO2 vegetation
INTEGER :: IRAD ! with or without new radiative transfer
!
-REAL, DIMENSION(SIZE(PANMAX)) :: ZGS, ZGAMMT, ZTOPT, ZANMAX, ZGMEST, ZGPP, ZRDK, ZEPSO
+REAL, DIMENSION(SIZE(PK%XANMAX)) :: ZGS, ZGAMMT, ZTOPT, ZANMAX, ZGMEST, ZGPP, ZRDK, ZEPSO
! ZTOPT = optimum temperature for compensation
! point
! ZANMAX = maximum photosynthesis rate
@@ -165,13 +111,13 @@ REAL, DIMENSION(SIZE(PANMAX)) :: ZGS, ZGAMMT, ZTOPT, ZANMAX, ZGMEST, ZGPP, Z
! ZRDK = dark respiration
!
!
-REAL, DIMENSION(SIZE(PANMAX)) :: ZCO2INIT3, ZCO2INIT4, ZCO2INIT5, ZCO2INIT2,ZCO2INIT1
+REAL, DIMENSION(SIZE(PK%XANMAX)) :: ZCO2INIT3, ZCO2INIT4, ZCO2INIT5, ZCO2INIT2,ZCO2INIT1
! working arrays for initializing surface
! temperature, saturation deficit, global radiation,
! optimum temperature for determining maximum
! photosynthesis rate, and soil water stress (none)
-REAL, DIMENSION(SIZE(PDMAX)) :: ZDMAX
-REAL, DIMENSION(SIZE(PDMAX)) :: ZWORK
+REAL, DIMENSION(SIZE(PK%XDMAX)) :: ZDMAX
+REAL, DIMENSION(SIZE(PK%XDMAX)) :: ZWORK
! Local variable in order to initialise DMAX
! following Calvet, 2000 (AST or LST cases)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -181,21 +127,21 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('COTWOINIT_N',0,ZHOOK_HANDLE)
!
ZTOPT (:) = 0.
-PFZERO (:) = 0.
-PEPSO (:) = 0.
-PGAMM (:) = 0.
-PQDGAMM(:) = 0.
-PQDGMES(:) = 0.
-PT1GMES(:) = 0.
-PT2GMES(:) = 0.
-PAMAX (:) = 0.
-PQDAMAX(:) = 0.
-PT1AMAX(:) = 0.
-PT2AMAX(:) = 0.
-PTAU_WOOD(:) = 0.
-!
-PAH (:) = 0.
-PBH (:) = 0.
+PK%XFZERO (:) = 0.
+PK%XEPSO (:) = 0.
+PK%XGAMM (:) = 0.
+PK%XQDGAMM(:) = 0.
+PK%XQDGMES(:) = 0.
+PK%XT1GMES(:) = 0.
+PK%XT2GMES(:) = 0.
+PK%XAMAX (:) = 0.
+PK%XQDAMAX(:) = 0.
+PK%XT1AMAX(:) = 0.
+PK%XT2AMAX(:) = 0.
+PK%XTAU_WOOD(:) = 0.
+!
+PK%XAH (:) = 0.
+PK%XBH (:) = 0.
!
ZEPSO (:) = 0.
ZGPP (:) = 0.
@@ -211,11 +157,6 @@ ZCO2INIT5(:) = 0.
!
!-------------------------------------------------------------------------------
!
-! DETERMINE GAUSSIAN WEIGHTS NEEDED FOR CO2 MODEL
-! -----------------------------------------------
-!
- CALL GAULEG(0.0,1.0,PABC,PPOI,SIZE(PABC))
-!
!
! INITIALIZE VARIOUS PARAMETERS FOR CO2 MODEL:
! --------------------------------------------
@@ -228,54 +169,56 @@ DO JCLASS=1,NVEGTYPE
ELSE
ICO2TYPE = 1 ! C3 type
END IF
- IF(I%LAGRI_TO_GRASS.AND.(JCLASS==NVT_C4 .OR. JCLASS==NVT_IRR)) ICO2TYPE = 1
- IF (I%LTR_ML) THEN
+ IF(IO%LAGRI_TO_GRASS.AND.(JCLASS==NVT_C4 .OR. JCLASS==NVT_IRR)) ICO2TYPE = 1
+ IF (IO%LTR_ML) THEN
IRAD = 1 ! running with new radiative transfer
ELSE
IRAD = 2
ENDIF
!
- ZTOPT (:) = ZTOPT (:) + XTOPT (ICO2TYPE) * PVEGTYPE(:,JCLASS)
- IF (HPHOTO == 'AGS' .OR. HPHOTO == 'LAI') THEN
- PFZERO (:) = PFZERO (:) + XFZERO1 (ICO2TYPE) * PVEGTYPE(:,JCLASS)
+ ZTOPT (:) = ZTOPT (:) + XTOPT (ICO2TYPE) * PK%XVEGTYPE_PATCH(:,JCLASS)
+ IF((JCLASS==NVT_TEBD) .OR. (JCLASS==NVT_BONE) .OR. &
+ (JCLASS==NVT_TRBD) .OR. (JCLASS==NVT_TEBE) .OR. (JCLASS==NVT_TENE) .OR. &
+ (JCLASS==NVT_BOBD) .OR. (JCLASS==NVT_BOND) .OR. (JCLASS==NVT_SHRB)) THEN
+ PK%XFZERO (:) = PK%XFZERO (:) + ((XAW - LOG(PEK%XGMES(:)*1000.0))/XBW)*PK%XVEGTYPE_PATCH(:,JCLASS)
+ ELSE IF (JCLASS==NVT_TRBE) THEN
+ PK%XFZERO (:) = PK%XFZERO (:) + XFZEROTROP(IRAD) * PK%XVEGTYPE_PATCH(:,JCLASS)
ELSE
- IF((JCLASS==NVT_TEBD) .OR. (JCLASS==NVT_BONE) .OR. &
- (JCLASS==NVT_TRBD) .OR. (JCLASS==NVT_TEBE) .OR. (JCLASS==NVT_TENE) .OR. &
- (JCLASS==NVT_BOBD) .OR. (JCLASS==NVT_BOND) .OR. (JCLASS==NVT_SHRB)) THEN
- PFZERO (:) = PFZERO (:) + ((XAW - LOG(PGMES(:)*1000.0))/XBW)*PVEGTYPE(:,JCLASS)
- ELSE IF (JCLASS==NVT_TRBE) THEN
- PFZERO (:) = PFZERO (:) + XFZEROTROP(IRAD) * PVEGTYPE(:,JCLASS)
- ELSE
- PFZERO (:) = PFZERO (:) + XFZERO2 (ICO2TYPE) * PVEGTYPE(:,JCLASS)
- ENDIF
+ PK%XFZERO (:) = PK%XFZERO (:) + XFZERO2 (ICO2TYPE) * PK%XVEGTYPE_PATCH(:,JCLASS)
ENDIF
!
- PEPSO (:) = PEPSO (:) + XEPSO (ICO2TYPE) * PVEGTYPE(:,JCLASS)
- PGAMM (:) = PGAMM (:) + XGAMM (ICO2TYPE) * PVEGTYPE(:,JCLASS)
- PQDGAMM(:) = PQDGAMM(:) + XQDGAMM(ICO2TYPE) * PVEGTYPE(:,JCLASS)
- PQDGMES(:) = PQDGMES(:) + XQDGMES(ICO2TYPE) * PVEGTYPE(:,JCLASS)
- PT1GMES(:) = PT1GMES(:) + XT1GMES(ICO2TYPE) * PVEGTYPE(:,JCLASS)
- PT2GMES(:) = PT2GMES(:) + XT2GMES(ICO2TYPE) * PVEGTYPE(:,JCLASS)
- PQDAMAX(:) = PQDAMAX(:) + XQDAMAX(ICO2TYPE) * PVEGTYPE(:,JCLASS)
- PT1AMAX(:) = PT1AMAX(:) + XT1AMAX(ICO2TYPE) * PVEGTYPE(:,JCLASS)
- PT2AMAX(:) = PT2AMAX(:) + XT2AMAX(ICO2TYPE) * PVEGTYPE(:,JCLASS)
- PAH (:) = PAH (:) + XAH (ICO2TYPE) * PVEGTYPE(:,JCLASS)
- PBH (:) = PBH (:) + XBH (ICO2TYPE) * PVEGTYPE(:,JCLASS)
+ PK%XEPSO (:) = PK%XEPSO (:) + XEPSO (ICO2TYPE) * PK%XVEGTYPE_PATCH(:,JCLASS)
+ PK%XGAMM (:) = PK%XGAMM (:) + XGAMM (ICO2TYPE) * PK%XVEGTYPE_PATCH(:,JCLASS)
+ PK%XQDGAMM(:) = PK%XQDGAMM(:) + XQDGAMM(ICO2TYPE) * PK%XVEGTYPE_PATCH(:,JCLASS)
+ PK%XQDGMES(:) = PK%XQDGMES(:) + XQDGMES(ICO2TYPE) * PK%XVEGTYPE_PATCH(:,JCLASS)
+ PK%XT1GMES(:) = PK%XT1GMES(:) + XT1GMES(ICO2TYPE) * PK%XVEGTYPE_PATCH(:,JCLASS)
+ PK%XT2GMES(:) = PK%XT2GMES(:) + XT2GMES(ICO2TYPE) * PK%XVEGTYPE_PATCH(:,JCLASS)
+ PK%XQDAMAX(:) = PK%XQDAMAX(:) + XQDAMAX(ICO2TYPE) * PK%XVEGTYPE_PATCH(:,JCLASS)
+ PK%XT1AMAX(:) = PK%XT1AMAX(:) + XT1AMAX(ICO2TYPE) * PK%XVEGTYPE_PATCH(:,JCLASS)
+ PK%XT2AMAX(:) = PK%XT2AMAX(:) + XT2AMAX(ICO2TYPE) * PK%XVEGTYPE_PATCH(:,JCLASS)
+ PK%XAH (:) = PK%XAH (:) + XAH (ICO2TYPE) * PK%XVEGTYPE_PATCH(:,JCLASS)
+ PK%XBH (:) = PK%XBH (:) + XBH (ICO2TYPE) * PK%XVEGTYPE_PATCH(:,JCLASS)
!
- IF(I%LAGRI_TO_GRASS.AND.(JCLASS==NVT_C3 .OR. JCLASS==NVT_C4 .OR. JCLASS==NVT_IRR))THEN
+ IF(IO%LAGRI_TO_GRASS.AND.(JCLASS==NVT_C3 .OR. JCLASS==NVT_C3W .OR. JCLASS==NVT_C3S .OR. &
+ JCLASS==NVT_C4 .OR. JCLASS==NVT_IRR))THEN
ICLASS=NVT_GRAS
ELSE
ICLASS=JCLASS
ENDIF
!
- PTAU_WOOD(:) = PTAU_WOOD(:) + XTAU_WOOD(ICLASS) * PVEGTYPE(:,JCLASS)
- PAMAX (:) = PAMAX (:) + XAMAX (ICLASS) * PVEGTYPE(:,JCLASS)
+ IF (NVEGTYPE==NVEGTYPE_ECOSG) THEN
+ PK%XTAU_WOOD(:) = PK%XTAU_WOOD(:) + XTAU_WOOD(ITRANSFERT_ESG(ICLASS)) * PK%XVEGTYPE_PATCH(:,JCLASS)
+ PK%XAMAX (:) = PK%XAMAX (:) + XAMAX (ITRANSFERT_ESG(ICLASS)) * PK%XVEGTYPE_PATCH(:,JCLASS)
+ ELSE
+ PK%XTAU_WOOD(:) = PK%XTAU_WOOD(:) + XTAU_WOOD(ICLASS) * PK%XVEGTYPE_PATCH(:,JCLASS)
+ PK%XAMAX (:) = PK%XAMAX (:) + XAMAX (ICLASS) * PK%XVEGTYPE_PATCH(:,JCLASS)
+ ENDIF
!
END DO
!
-PQDGAMM(:)=LOG(PQDGAMM(:))
-PQDGMES(:)=LOG(PQDGMES(:))
-PQDAMAX(:)=LOG(PQDAMAX(:))
+PK%XQDGAMM(:)=LOG(PK%XQDGAMM(:))
+PK%XQDGMES(:)=LOG(PK%XQDGMES(:))
+PK%XQDAMAX(:)=LOG(PK%XQDAMAX(:))
!
!
! INITIALIZE VARIOUS VARIABLES FOR CO2 MODEL:
@@ -284,24 +227,24 @@ PQDAMAX(:)=LOG(PQDAMAX(:))
!
! compute temperature responses:
!
-!before optimization (with non log PQDGAMM) :
-!ZGAMMT(:) = PGAMM(:)*(PQDGAMM(:)**(0.1*(ZTOPT(:)-25.0)))
-ZWORK (:) = (0.1*(ZTOPT(:)-25.0)) * PQDGAMM(:)
-ZGAMMT(:) = PGAMM(:)*EXP(ZWORK(:))
+!before optimization (with non log PK%XQDGAMM) :
+!ZGAMMT(:) = PK%XGAMM(:)*(PK%XQDGAMM(:)**(0.1*(ZTOPT(:)-25.0)))
+ZWORK (:) = (0.1*(ZTOPT(:)-25.0)) * PK%XQDGAMM(:)
+ZGAMMT(:) = PK%XGAMM(:)*EXP(ZWORK(:))
!
-!before optimization (with non log PQDAMAX) :
-!ZANMAX(:) = ( PAMAX(:)*PQDAMAX(:)**(0.1*(ZTOPT(:)-25.0)) ) / ...
-ZWORK (:) = (0.1*(ZTOPT(:)-25.0)) * PQDAMAX(:)
-ZANMAX(:) = ( PAMAX(:)*EXP(ZWORK(:)) ) &
- /( (1.0+EXP(0.3*(PT1AMAX(:)-ZTOPT(:))))* &
- (1.0+EXP(0.3*(ZTOPT(:)-PT2AMAX(:)))) )
+!before optimization (with non log PK%XQDAMAX) :
+!ZANMAX(:) = ( PK%XAMAX(:)*PK%XQDAMAX(:)**(0.1*(ZTOPT(:)-25.0)) ) / ...
+ZWORK (:) = (0.1*(ZTOPT(:)-25.0)) * PK%XQDAMAX(:)
+ZANMAX(:) = ( PK%XAMAX(:)*EXP(ZWORK(:)) ) &
+ /( (1.0+EXP(0.3*(PK%XT1AMAX(:)-ZTOPT(:))))* &
+ (1.0+EXP(0.3*(ZTOPT(:)-PK%XT2AMAX(:)))) )
!
-!before optimization (with non log PQDGMES) :
-!ZGMEST(:) = ( PGMES(:)*PQDGMES(:)**(0.1*(ZTOPT(:)-25.0)) ) &
-ZWORK (:) = (0.1*(ZTOPT(:)-25.0)) * PQDGMES(:)
-ZGMEST(:) = ( PGMES(:)*EXP(ZWORK(:)) ) &
- /( (1.0+EXP(0.3*(PT1GMES(:)-ZTOPT(:))))* &
- (1.0+EXP(0.3*(ZTOPT(:)-PT2GMES(:)))) )
+!before optimization (with non log PK%XQDGMES) :
+!ZGMEST(:) = ( PEK%XGMES(:)*PK%XQDGMES(:)**(0.1*(ZTOPT(:)-25.0)) ) &
+ZWORK (:) = (0.1*(ZTOPT(:)-25.0)) * PK%XQDGMES(:)
+ZGMEST(:) = ( PEK%XGMES(:)*EXP(ZWORK(:)) ) &
+ /( (1.0+EXP(0.3*(PK%XT1GMES(:)-ZTOPT(:))))* &
+ (1.0+EXP(0.3*(ZTOPT(:)-PK%XT2GMES(:)))) )
!
!
! initialize other variables: (using optimum values for some variables)
@@ -321,10 +264,10 @@ ZGMEST(:) = ZGMEST(:)*ZCO2INIT5(:)
!
! Initialise DMAX following Calvet (2000) in the case of 'AST' or 'LST' photosynthesis option
!
-IF((HPHOTO=='AST').OR.(HPHOTO=='LST').OR.(HPHOTO=='NIT').OR.(HPHOTO=='NCB')) THEN
- ZDMAX(:) = EXP((LOG(ZGMEST(:)*1000.)-PAH(:))/PBH(:))/1000.
+IF(IO%CPHOTO/='NON') THEN
+ ZDMAX(:) = EXP((LOG(ZGMEST(:)*1000.)-PK%XAH(:))/PK%XBH(:))/1000.
ELSE
- ZDMAX(:) = PDMAX(:)
+ ZDMAX(:) = PK%XDMAX(:)
ENDIF
!
! Compute maximum/initial/optimum net assimilation of CO2:
@@ -333,13 +276,13 @@ ENDIF
! ZANMAX and ZEPSO from kgCO2/m2/s to kgCO2/kgair m/s by dividing by RHOA (kgair/m3)
! ZGAMMT from ppm to kgCO2/kgair
ZANMAX(:)=ZANMAX(:)/1.2
-ZEPSO(:)=PEPSO(:)/1.2
+ZEPSO(:)=PK%XEPSO(:)/1.2
ZGAMMT(:)=ZGAMMT(:)*XMCO2/XMD*1e-6
!
- CALL COTWO(PCO2, ZCO2INIT5, ZCO2INIT4, ZCO2INIT3, ZGAMMT, &
- PFZERO, ZEPSO, ZANMAX, ZGMEST, PGC, ZDMAX, &
- PANMAX, ZGS, ZRDK, ZCO2INIT2, ZCO2INIT1 )
-! change by sebastien PEPSO change into ZEPSO for units consistency
+CALL COTWO(PCO2, ZCO2INIT5, ZCO2INIT4, ZCO2INIT3, ZGAMMT, &
+ PK%XFZERO(:), ZEPSO, ZANMAX, ZGMEST, PEK%XGC, ZDMAX, &
+ PK%XANMAX(:), ZGS, ZRDK, ZCO2INIT2, ZCO2INIT1 )
+! change by sebastien PK%XEPSO change into ZEPSO for units consistency
!
!
!
diff --git a/src/SURFEX/cotwores.F90 b/src/SURFEX/cotwores.F90
index 7220c3d01eb7feb3eaf1016e535a9e098b04d0f8..e7f438656addafbe8351bece5b0f5983295d8ef9 100644
--- a/src/SURFEX/cotwores.F90
+++ b/src/SURFEX/cotwores.F90
@@ -3,14 +3,10 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE COTWORES(PTSTEP, HPHOTO, OTR_ML, OSHADE, &
- PVEGTYPE, OSTRESSDEF, PAH, PBH, PF2I, PDMAX, &
- PPOI, PCSP, PTG, PF2, PSW_RAD, PRA, PQA, PQSAT, PLE, &
- PPSNV, PDELTA, PLAI, PRHOA, PZENITH, PFZERO, PEPSO, &
- PGAMM, PQDGAMM, PGMES, PGC, PQDGMES, PT1GMES, PT2GMES, &
- PAMAX, PQDAMAX, PT1AMAX, PT2AMAX, PFFV, &
- PIACAN_SUNLIT, PIACAN_SHADE, PFRAC_SUN, PIACAN, &
- PABC, PAN, PANDAY, PRS, PANFM, PGPP, PANF, PRESP_LEAF )
+SUBROUTINE COTWORES(PTSTEP, IO, OSHADE, PK, PEK, PDMAX, PPOI, PCSP, &
+ PTG, PF2, PSW_RAD, PQA, PQSAT, PPSNV, PDELTA, PRHOA, &
+ PZENITH, PFFV, PIACAN_SUNLIT, PIACAN_SHADE, PFRAC_SUN, &
+ PIACAN, PABC, PRS, PGPP, PRESP_LEAF )
! #########################################################################
!
!!**** *COTWORES*
@@ -55,7 +51,7 @@ SUBROUTINE COTWORES(PTSTEP, HPHOTO, OTR_ML, OSHADE, &
!! L. Jarlan 27/10/04 : add of T2 to calculate soil respiration and use
!! of CRESPSL key to manage the calculation of soil
!! respiration
-!! PAN et PPST in kgCO2 m-2 s-1 to be fully
+!! PEK%XAN et PPST in kgCO2 m-2 s-1 to be fully
!! compatible with vegetation growth module (lailoss.f90)
!! P Le Moigne 09/2005 AGS modifs of L. Jarlan
!! S. Lafont 03/09 : change units of EPSO GAMM ANDAY
@@ -66,21 +62,24 @@ SUBROUTINE COTWORES(PTSTEP, HPHOTO, OTR_ML, OSHADE, &
!! A.L. Gibelin 07/09 : Suppress PPST and PPSTF as outputs, and diagnose GPP
!! S. Lafont 03/11 : Correct a bug fopr grassland below wilting point
!! D. Carrer 04/11 : new radiative transfert
-!! A. Boone 11/11 : add rsmax to MODD_ISBA_PAR
+!! A. Boone 11/11 : add rsmax to MODD_VEG_PAR
!! B. Decharme 05/12 : Bug : flood fraction in COTWORES
!! Optimization
!! R. Alkama 04/12 : add 6 new tree vegtype (9 instead 3)
!! C. Delire 01/14 : vertical profile of dark respiration for tropical forest
-!! (GTROP) with Carrer radiative transfer (OTR_ML = T)
+!! (GTROP) with Carrer radiative transfer (IO%LTR_ML = T)
!!Seferian & Delire 06/2015 : generalization of (i) linear water-stress reponse
! and (ii) exponential decrease of autothrophic respiration to all woody PFTs
!! B. Decharme 07/15 : Suppress some numerical adjustement for F2
!!
!-------------------------------------------------------------------------------
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_P_t, ISBA_PE_t
+!
USE MODD_CSTS, ONLY : XMD, XTT, XLVTT
USE MODD_ISBA_PAR, ONLY : XRS_MAX, XDENOM_MIN
-USE MODD_CO2V_PAR, ONLY : XPARCF, XMCO2, XDMAX_AGS, &
+USE MODD_CO2V_PAR, ONLY : XPARCF, XMCO2, &
XDMAXX, XDMAXN, XAW, XBW, XASW
USE MODD_DATA_COVER_PAR, ONLY : NVT_TEBD, NVT_TRBE, NVT_BONE, &
NVT_TRBD, NVT_TEBE, NVT_TENE, &
@@ -103,99 +102,51 @@ IMPLICIT NONE
!
!
REAL, INTENT(IN) :: PTSTEP ! time step
- CHARACTER(LEN=*), INTENT(IN) :: HPHOTO ! Kind of photosynthesis
-! ! 'NON'
-! ! 'AGS'
-! ! 'LAI'
-! ! 'AST'
-! ! 'LST'
-LOGICAL, INTENT(IN) :: OTR_ML ! new TR
+!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
LOGICAL, DIMENSION(:),INTENT(IN) :: OSHADE
!
-REAL, DIMENSION(:,:),INTENT(IN) :: PVEGTYPE
-! PVEGTYPE = type de vegetation (1 a 9)
+REAL, DIMENSION(:), INTENT(IN) :: PPOI ! Gaussian weights (as above)
!
-LOGICAL,DIMENSION(:),INTENT(IN) :: OSTRESSDEF
-REAL,DIMENSION(:), INTENT(IN) :: PAH, PBH, PF2I, PDMAX
-! PAH, PBH = coefficients for universal herbaceous
-! stress relation
-! OSTRESSDEF = water stress vegetation comportement
-! (true:defensif false:offensif)
-! PF2I = critical normalized soil water stress
+REAL,DIMENSION(:), INTENT(IN) :: PDMAX
! PDMAX = maximum saturation deficit of
! atmosphere tolerate by vegetation
!
-REAL, DIMENSION(:), INTENT(IN) :: PPOI ! Gaussian weights (as above)
-!
-REAL,DIMENSION(:), INTENT(IN) :: PCSP, PTG, PF2, PSW_RAD, PRA
+REAL,DIMENSION(:), INTENT(IN) :: PCSP, PTG, PF2, PSW_RAD
! PCSP = atmospheric concentration of CO2
! PTG = updated leaf temperature
! PF2 = normalized soil water stress factor
! PSW_RAD = incident solar radiation
-! PRA = aerodynamic resistance
!
-REAL,DIMENSION(:), INTENT(IN) :: PQA, PQSAT, PLE, PPSNV, PDELTA, PLAI, PRHOA
+REAL,DIMENSION(:), INTENT(IN) :: PQA, PQSAT, PPSNV, PDELTA, PRHOA
! PQA = atmospheric mixing ratio
! PQSAT = surface saturation mixing ratio
-! PLE = evapotranspiration (kgH2O kgAir-1 m s-1)
! PPSNV = snow cover fraction
! PDELTA= fraction of the foliage covered
! by intercepted water
-! PLAI = leaf area index
-! PRHOA = air density
+! PEK%XRESA = air density
!
REAL,DIMENSION(:), INTENT(IN) :: PZENITH
! PZENITH = solar zenith angle needed
! for computation of diffusuion of solar
! radiation: for CO2 model.
!
-REAL,DIMENSION(:), INTENT(IN) :: PFZERO, PEPSO, PGAMM, PQDGAMM, PGMES, PGC, &
- PQDGMES, PT1GMES, PT2GMES, PAMAX, PQDAMAX, &
- PT1AMAX, PT2AMAX
-! PFZERO = ideal value of F, no photorespiration or
-! saturation deficit
-! PEPSO = maximum initial quantum use efficiency
-! (kgCO2 J-1 PAR)
-! PGAMM = CO2 conpensation concentration (ppmv)
-! PQDGAMM = Log of Q10 function for CO2 conpensation
-! concentration
-! PGMES = mesophyll conductance (m s-1)
-! PGC = cuticular conductance (m s-1)
-! PQDGMES = Log of Q10 function for mesophyll conductance
-! PT1GMES = reference temperature for computing
-! compensation concentration function for
-! mesophyll conductance: minimum temperature
-! PT2GMES = reference temperature for computing
-! compensation concentration function for
-! mesophyll conductance: maximum temperature
-! PAMAX = leaf photosynthetic capacity (kg m-2 s-1)
-! PQDAMAX = Log of Q10 function for leaf photosynthetic capacity
-! PT1AMAX = reference temperature for computing
-! compensation concentration function for leaf
-! photosynthetic capacity: minimum temperature
-! PT2AMAX = reference temperature for computing
-! compensation concentration function for leaf
-! photosynthetic capacity: maximum temperature
-!
REAL, DIMENSION(:,:), INTENT(IN) :: PIACAN_SUNLIT, PIACAN_SHADE, PFRAC_SUN
!
REAL, DIMENSION(:), INTENT(IN) :: PFFV ! Floodplain fraction over vegetation
!
REAL, DIMENSION(:,:), INTENT(INOUT) :: PIACAN ! PAR in the canopy at different gauss level
!
-REAL,DIMENSION(:), INTENT(INOUT) :: PABC, PAN, PANDAY, PRS, PANFM, PGPP
+REAL,DIMENSION(:), INTENT(INOUT) :: PABC, PRS, PGPP
! PABC = Carrer radiative transfer: normalized heigh of considered layer (bottom=0, top=1)
! Calvet radiative transfer: abcissa of the 3-points Gaussian quadrature
-! (Goudriaan, Agric&For.Meteor, 38,1986)
-! PAN = Net assimilation of CO2 (kg_CO2/kg_air * m/s)
-! PANDAY= cumulated daily net assimilation of CO2 (kgCO2/m2/day)
+! (Goudriaan, Agric&For.Meteor, 38,1986)
! PRS = stomatal resistance
-! PANFM = maximum leaf assimilation
! PGPP = Gross Primary Production (kg_CO2/kg_air * m/s)
!
-REAL,DIMENSION(:), INTENT(OUT) :: PANF
-! PANF = total assimilation over canopy
-!
REAL,DIMENSION(:), INTENT(OUT) :: PRESP_LEAF
! PRESP_LEAF = dark respiration over canopy
!
@@ -205,22 +156,23 @@ REAL, PARAMETER :: ZRS_MIN = 1.E-4 ! minimum canopy resistan
!
INTEGER :: JINT, JJ ! index for loops
!
-REAL, DIMENSION(SIZE(PLAI)) :: ZCONVE1, ZTSPC, ZIA
+REAL, DIMENSION(SIZE(PEK%XLAI,1)) :: ZANF ! ZANF = total assimilation over canopy
+REAL, DIMENSION(SIZE(PEK%XLAI,1)) :: ZCONVE1, ZTSPC, ZIA
! ZTSPC = temperature conversion (K to C)
! ZIA = absorbed PAR
-REAL, DIMENSION(SIZE(PLAI)) :: ZLAI, ZGMEST, ZFZERO, ZDMAX
+REAL, DIMENSION(SIZE(PEK%XLAI,1)) :: ZLAI, ZGMEST, ZFZERO, ZDMAX
! ZLAI = LAI
! ZFZERO = ideal value of F, no photorespiration or
! saturation deficit
! ZDMAX = maximum saturation deficit of atmosphere
! tolerate by vegetation
!
-REAL, DIMENSION(SIZE(PLAI)) :: ZGAMMT, ZDSP, ZANMAX
+REAL, DIMENSION(SIZE(PEK%XLAI,1)) :: ZGAMMT, ZDSP, ZANMAX
! ZGAMMT = compensation point
! ZDSP = saturation deficit of atmosphere
! verses the leaf surface (with correction)
!
-REAL, DIMENSION(SIZE(PLAI)) :: ZXMUS, ZTAN, ZTGS, ZXIA, ZAN0, ZGS0, ZXTGS, ZRDK,ZLAITOP,ZTRDK,ZZLAI
+REAL, DIMENSION(SIZE(PEK%XLAI,1)) :: ZXMUS, ZTAN, ZTGS, ZXIA, ZAN0, ZGS0, ZXTGS, ZRDK,ZLAITOP,ZTRDK,ZZLAI
! ZXMUS = cosine of solar zenith angle
! ZTAN = canopy integrated net assimilation
! ZTGS = canopy integrated leaf conductance
@@ -235,12 +187,12 @@ REAL, DIMENSION(SIZE(PLAI)) :: ZXMUS, ZTAN, ZTGS, ZXIA, ZAN0, ZGS0, ZXTGS, ZRDK,
! ZTRDK = canopy integrated dark respiration
! ZZLAI = LAI, used for dark respiration profile
!
-REAL, DIMENSION(SIZE(PLAI)) :: ZAN0_,ZGS0_,ZRDK_ ! parameters for shaded leaves
+REAL, DIMENSION(SIZE(PEK%XLAI,1)) :: ZAN0_,ZGS0_,ZRDK_ ! parameters for shaded leaves
!
-REAL, DIMENSION(SIZE(PLAI)) :: ZEPSO
+REAL, DIMENSION(SIZE(PEK%XLAI,1)) :: ZEPSO
! ZEPSO conversion of PEPSO in kgCO2/kgair m/s
!
-REAL, DIMENSION(SIZE(PLAI)) :: ZDMAXSTAR, ZFZEROSTAR, ZFZERON, ZGMESTN
+REAL, DIMENSION(SIZE(PEK%XLAI,1)) :: ZDMAXSTAR, ZFZEROSTAR, ZFZERON, ZGMESTN
! ZDMAXSTAR = maximum saturation deficit of atmosphere
! tolerate by vegetation without soil water stress
! ZFZEROSTAR = initial optimal ratio Ci/Cs for woody vegetation
@@ -254,9 +206,9 @@ REAL :: ZABC, ZWEIGHT
! conductance over canopy depth
! (working scalar)
!
-REAL, DIMENSION(SIZE(PLAI)) :: ZWORK !Work array
+REAL, DIMENSION(SIZE(PEK%XLAI,1)) :: ZWORK !Work array
!
-LOGICAL, DIMENSION(SIZE(PLAI)) :: GHERB, GWOOD, GF2_INF_F2I, GTROP
+LOGICAL, DIMENSION(SIZE(PEK%XLAI,1)) :: GHERB, GWOOD, GF2_INF_F2I, GTROP
!
INTEGER, DIMENSION(1) :: IDMAX
!
@@ -273,128 +225,115 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('COTWORES',0,ZHOOK_HANDLE)
!
-ZCONVE1(:) = XMCO2*PRHOA(:)/XMD
+ZCONVE1(:) = XMCO2*PRHOA/XMD
!
! initialisation: convert from K to C
!
ZTSPC(:) = PTG(:) - XTT
!
-ZLAI(:) = PLAI(:)
-ZGMEST(:) = PGMES(:)
-ZFZERO(:) = PFZERO(:)
+ZLAI(:) = PEK%XLAI(:)
+ZGMEST(:) = PEK%XGMES(:)
+ZFZERO(:) = PK%XFZERO(:)
!
!GTROP = linear stress in case of tropical evergreen forest
! (with fixed f0=0.74 for Carrer rad. transf., f0=0.7 with Calvet rad. transf.)
-GTROP (:) = (PVEGTYPE(:,NVT_TRBE) > 0.8)
+GTROP (:) = (PK%XVEGTYPE_PATCH(:,NVT_TRBE) > 0.8)
!
-GHERB(:) = (PVEGTYPE(:,NVT_TEBD) + PVEGTYPE(:,NVT_TRBE) + PVEGTYPE(:,NVT_BONE) &
- +PVEGTYPE(:,NVT_TRBD) + PVEGTYPE(:,NVT_TEBE) + PVEGTYPE(:,NVT_TENE) &
- +PVEGTYPE(:,NVT_BOBD) + PVEGTYPE(:,NVT_BOND) + PVEGTYPE(:,NVT_SHRB)<0.5)
+GHERB(:) = (PK%XVEGTYPE_PATCH(:,NVT_TEBD) + PK%XVEGTYPE_PATCH(:,NVT_TRBE) + PK%XVEGTYPE_PATCH(:,NVT_BONE) &
+ +PK%XVEGTYPE_PATCH(:,NVT_TRBD) + PK%XVEGTYPE_PATCH(:,NVT_TEBE) + PK%XVEGTYPE_PATCH(:,NVT_TENE) &
+ +PK%XVEGTYPE_PATCH(:,NVT_BOBD) + PK%XVEGTYPE_PATCH(:,NVT_BOND) + PK%XVEGTYPE_PATCH(:,NVT_SHRB)<0.5)
GWOOD (:) = (.NOT.GHERB (:))
!
-IF (HPHOTO=='AGS' .OR. HPHOTO=='LAI') THEN
- !
- ! Compute conductance and assimilation of CO2:
- !
- ZDMAX = XDMAX_AGS
- !
- ! Add soil moisture stress effect to leaf conductance:
- !
- ZGMEST(:) = ZGMEST(:) * PF2(:)
- !
-ELSEIF (HPHOTO=='AST' .OR. HPHOTO=='LST' .OR. HPHOTO=='NIT' .OR. HPHOTO=='NCB') THEN
- !
- WHERE (PLAI(:)==XUNDEF) ZLAI(:)=0.0
- !
- ! See (Varlet-Granchet C., M. Chartier, G. Gosse, and R. Bonhomme, 1981:
- ! Rayonnement utilise pour la photosynthese des vegetaux en
- ! conditions naturelles: caracterisation et variations.
- ! Oecol. Plant. 2(16), 189-202.)
- !
- !-------------------------------------
- ! Add soil moisture stress effect to leaf conductance:
- ! OFFENSIVE and DEFENSIVE water stress response
- !
- ZDMAX(:) = PDMAX(:)
- !
- GF2_INF_F2I(:) = (PF2(:)<PF2I(:))
- !
- ! -HERBACEOUS-
- !
- WHERE(GHERB(:).AND.OSTRESSDEF(:))
- ZDMAX(:) = XDMAXN
- ENDWHERE
- WHERE(GHERB(:).AND..NOT.OSTRESSDEF(:))
- ZDMAX(:) = XDMAXX
- ENDWHERE
- !
- ! PAH and PBH are original coefficients of Calvet 2000
- WHERE(GHERB(:).AND.(.NOT.GF2_INF_F2I(:)))
- ZDMAXSTAR(:) = EXP((LOG(ZGMEST(:)*1000.)-PAH(:))/PBH(:))/1000.
- ZDMAX(:) = ZDMAXSTAR(:) - (ZDMAXSTAR(:)-ZDMAX(:))*(1.-PF2(:))/(1.-PF2I(:))
- ENDWHERE
- !
- WHERE(GHERB(:))
- ZGMEST(:) = EXP(PAH(:)+PBH(:)*LOG(ZDMAX(:)*1000.))/1000.
- ENDWHERE
- !
- WHERE (GHERB(:).AND.GF2_INF_F2I(:).AND.OSTRESSDEF(:))
- ZGMEST(:) = ZGMEST(:) * PF2(:)/PF2I(:)
- ENDWHERE
- WHERE(GHERB(:).AND.GF2_INF_F2I(:).AND.(.NOT.OSTRESSDEF(:)))
- ZDMAX(:) = ZDMAX(:) * PF2(:)/PF2I(:)
- ENDWHERE
- !
- ! to limit photosynthesis under wilting point
- WHERE (GHERB(:).AND.(.NOT.OSTRESSDEF(:)).AND.ZDMAX(:)<=XDMAXN)
- ZDMAX(:) = XDMAXN
- ZGMEST(:) = (EXP(PAH(:)+PBH(:)*LOG(XDMAXN*1000.))/1000.)*PF2(:)/PF2I(:)
- ENDWHERE
- !
- ! -WOODY but not tropical forest-
- !
- WHERE(GWOOD(:))
- ZFZEROSTAR(:) = ( XAW - LOG(ZGMEST(:)*1000.) )/XBW
- ENDWHERE
- !
- WHERE (GWOOD(:).AND.OSTRESSDEF(:))
- ZGMESTN(:) = ZGMEST(:)
- ENDWHERE
- WHERE(GWOOD(:).AND.(.NOT.OSTRESSDEF(:)))
- ZGMESTN(:) = EXP(XASW - XBW*ZFZEROSTAR(:))/1000.
- ENDWHERE
- !
- WHERE (GWOOD(:).AND.GF2_INF_F2I(:))
- ZGMESTN(:) = ZGMESTN(:)*PF2(:)/PF2I(:)
- ENDWHERE
- !
- WHERE(GWOOD(:))
- ZWORK (:) = MAX( XDENOM_MIN, ZGMESTN(:) )
- ZFZERON(:) = (XASW - LOG(ZWORK(:)*1000.))/XBW
- ENDWHERE
- !
- WHERE(GWOOD(:).AND.(.NOT.GF2_INF_F2I(:)).AND.OSTRESSDEF(:))
- ZFZERO(:) = ZFZEROSTAR(:)
- ZFZERO(:) = ZFZERO(:) - (ZFZERO(:)-ZFZERON(:))*(1.-PF2(:))/(1.-PF2I(:))
- ENDWHERE
- WHERE(GWOOD(:).AND.(.NOT.GF2_INF_F2I(:)).AND.(.NOT.OSTRESSDEF(:)))
- ZFZERO(:) = ZFZEROSTAR(:)
- ZGMEST(:) = ZGMEST(:) - (ZGMEST(:)-ZGMESTN(:))*(1.-PF2(:))/(1.-PF2I(:))
- ENDWHERE
- !
- WHERE(GWOOD(:).AND.GF2_INF_F2I(:))
- ZFZERO(:) = MIN(.95, ZFZERON(:))
- ZGMEST(:) = ZGMESTN(:)
- ENDWHERE
- !
- ! -Tropical Forest-
- !
- WHERE(GTROP(:))
- ZFZERO(:) = PFZERO(:)
- ZGMEST(:) = PGMES(:)*PF2(:)
- ENDWHERE
- !
-ENDIF
+!
+WHERE (PEK%XLAI(:)==XUNDEF) ZLAI(:)=0.0
+!
+! See (Varlet-Granchet C., M. Chartier, G. Gosse, and R. Bonhomme, 1981:
+! Rayonnement utilise pour la photosynthese des vegetaux en
+! conditions naturelles: caracterisation et variations.
+! Oecol. Plant. 2(16), 189-202.)
+!
+!-------------------------------------
+! Add soil moisture stress effect to leaf conductance:
+! OFFENSIVE and DEFENSIVE water stress response
+!
+ZDMAX(:) = PDMAX(:)
+!
+GF2_INF_F2I(:) = (PF2(:)<PEK%XF2I(:))
+!
+! -HERBACEOUS-
+!
+WHERE(GHERB(:).AND.PEK%LSTRESS(:))
+ ZDMAX(:) = XDMAXN
+ENDWHERE
+WHERE(GHERB(:).AND..NOT.PEK%LSTRESS(:))
+ ZDMAX(:) = XDMAXX
+ENDWHERE
+!
+! PAH and PBH are original coefficients of Calvet 2000
+WHERE(GHERB(:).AND.(.NOT.GF2_INF_F2I(:)))
+ ZDMAXSTAR(:) = EXP((LOG(ZGMEST(:)*1000.)-PK%XAH(:))/PK%XBH(:))/1000.
+ ZDMAX(:) = ZDMAXSTAR(:) - (ZDMAXSTAR(:)-ZDMAX(:))*(1.-PF2(:))/(1.-PEK%XF2I(:))
+ENDWHERE
+!
+WHERE(GHERB(:))
+ ZGMEST(:) = EXP(PK%XAH(:)+PK%XBH(:)*LOG(ZDMAX(:)*1000.))/1000.
+ENDWHERE
+!
+WHERE (GHERB(:).AND.GF2_INF_F2I(:).AND.PEK%LSTRESS(:))
+ ZGMEST(:) = ZGMEST(:) * PF2(:)/PEK%XF2I(:)
+ENDWHERE
+WHERE(GHERB(:).AND.GF2_INF_F2I(:).AND.(.NOT.PEK%LSTRESS(:)))
+ ZDMAX(:) = ZDMAX(:) * PF2(:)/PEK%XF2I(:)
+ENDWHERE
+!
+! to limit photosynthesis under wilting point
+WHERE (GHERB(:).AND.(.NOT.PEK%LSTRESS(:)).AND.ZDMAX(:)<=XDMAXN)
+ ZDMAX(:) = XDMAXN
+ ZGMEST(:) = (EXP(PK%XAH(:)+PK%XBH(:)*LOG(XDMAXN*1000.))/1000.)*PF2(:)/PEK%XF2I(:)
+ENDWHERE
+!
+! -WOODY but not tropical forest-
+!
+WHERE(GWOOD(:))
+ ZFZEROSTAR(:) = ( XAW - LOG(ZGMEST(:)*1000.) )/XBW
+ENDWHERE
+!
+WHERE (GWOOD(:).AND.PEK%LSTRESS(:))
+ ZGMESTN(:) = ZGMEST(:)
+ENDWHERE
+WHERE(GWOOD(:).AND.(.NOT.PEK%LSTRESS(:)))
+ ZGMESTN(:) = EXP(XASW - XBW*ZFZEROSTAR(:))/1000.
+ENDWHERE
+!
+WHERE (GWOOD(:).AND.GF2_INF_F2I(:))
+ ZGMESTN(:) = ZGMESTN(:)*PF2(:)/PEK%XF2I(:)
+ENDWHERE
+!
+WHERE(GWOOD(:))
+ ZWORK (:) = MAX( XDENOM_MIN, ZGMESTN(:) )
+ ZFZERON(:) = (XASW - LOG(ZWORK(:)*1000.))/XBW
+ENDWHERE
+!
+WHERE(GWOOD(:).AND.(.NOT.GF2_INF_F2I(:)).AND.PEK%LSTRESS(:))
+ ZFZERO(:) = ZFZEROSTAR(:)
+ ZFZERO(:) = ZFZERO(:) - (ZFZERO(:)-ZFZERON(:))*(1.-PF2(:))/(1.-PEK%XF2I(:))
+ENDWHERE
+WHERE(GWOOD(:).AND.(.NOT.GF2_INF_F2I(:)).AND.(.NOT.PEK%LSTRESS(:)))
+ ZFZERO(:) = ZFZEROSTAR(:)
+ ZGMEST(:) = ZGMEST(:) - (ZGMEST(:)-ZGMESTN(:))*(1.-PF2(:))/(1.-PEK%XF2I(:))
+ENDWHERE
+!
+WHERE(GWOOD(:).AND.GF2_INF_F2I(:))
+ ZFZERO(:) = MIN(.95, ZFZERON(:))
+ ZGMEST(:) = ZGMESTN(:)
+ENDWHERE
+!
+! -Tropical Forest-
+!
+WHERE(GTROP(:))
+ ZFZERO(:) = PK%XFZERO(:)
+ ZGMEST(:) = PEK%XGMES(:)*PF2(:)
+ENDWHERE
!
!-------------------------
!
@@ -402,12 +341,12 @@ ENDIF
!
!before optimization (with non log PQDGAMM) :
!ZGAMMT(:) = PGAMM(:)*PQDGAMM(:)**(0.1*(ZTSPC(:)-25.0))
-ZWORK (:) = (0.1*(ZTSPC(:)-25.0)) * PQDGAMM(:)
-ZGAMMT(:) = PGAMM(:) * EXP(ZWORK(:))
+ZWORK (:) = (0.1*(ZTSPC(:)-25.0)) * PK%XQDGAMM(:)
+ZGAMMT(:) = PK%XGAMM(:) * EXP(ZWORK(:))
!
! specific humidity deficit (kg kg-1)
!
-ZDSP(:) = MAX( 0.0, PQSAT(:) - PQA(:) - PLE(:)*PRA(:)/(PRHOA*XLVTT) )
+ZDSP(:) = MAX( 0.0, PQSAT(:) - PQA(:) - PEK%XLE(:)*PEK%XRESA(:)/(PRHOA*XLVTT) )
!
! cosine of solar zenith angle
!
@@ -419,16 +358,16 @@ ZXMUS(:) = MAX(COS(PZENITH(:)),0.01)
! kg/m2/s
!before optimization (with non log PQDAMAX) :
!ZANMAX(:) = ( PAMAX(:)*PQDAMAX(:)**(0.1*(ZTSPC(:)-25.0)) ) / ...
-ZWORK (:) = (0.1*(ZTSPC(:)-25.0)) * PQDAMAX(:)
-ZANMAX(:) = ( PAMAX(:) * EXP(ZWORK(:)) ) &
- / ( (1.0+EXP(0.3*(PT1AMAX(:)-ZTSPC(:))))* (1.0+EXP(0.3*(ZTSPC(:)-PT2AMAX(:)))) )
+ZWORK (:) = (0.1*(ZTSPC(:)-25.0)) * PK%XQDAMAX(:)
+ZANMAX(:) = ( PK%XAMAX(:) * EXP(ZWORK(:)) ) &
+ / ( (1.0+EXP(0.3*(PK%XT1AMAX(:)-ZTSPC(:))))* (1.0+EXP(0.3*(ZTSPC(:)-PK%XT2AMAX(:)))) )
!
! m/s
!before optimization (with non log PQDGMES) :
!ZGMEST(:) = ( ZGMEST(:)*PQDGMES(:)**(0.1*(ZTSPC(:)-25.0)) ) / ...
-ZWORK (:) = (0.1*(ZTSPC(:)-25.0)) * PQDGMES(:)
+ZWORK (:) = (0.1*(ZTSPC(:)-25.0)) * PK%XQDGMES(:)
ZGMEST(:) = ( ZGMEST(:) * EXP(ZWORK(:)) ) &
- / ( (1.0+EXP(0.3*(PT1GMES(:)-ZTSPC(:))))* (1.0+EXP(0.3*(ZTSPC(:)-PT2GMES(:)))) )
+ / ( (1.0+EXP(0.3*(PK%XT1GMES(:)-ZTSPC(:))))* (1.0+EXP(0.3*(ZTSPC(:)-PK%XT2GMES(:)))) )
!
!
! Integration over the canopy: SIZE(PABC) increments
@@ -442,8 +381,8 @@ ZTRDK(:)= 0.0
! ZANMAX and ZEPSO from kgCO2/m2/s to kgCO2/kgair m/s by dividing by RHOA (kgair/m3)
! ZGAMMT from ppm to kgCO2/kgair
ZGAMMT(:) = ZGAMMT(:) * XMCO2 / XMD * 1e-6
-ZANMAX(:) = ZANMAX(:) / PRHOA(:)
-ZEPSO(:) = PEPSO(:) / PRHOA(:)
+ZANMAX(:) = ZANMAX(:) / PRHOA
+ZEPSO(:) = PK%XEPSO(:) / PRHOA
!
ZIA(:) = PSW_RAD(:)*XPARCF
!
@@ -451,7 +390,7 @@ DO JINT = 1, SIZE(PABC)
!
! Diffusion of incident radiation:
!
- IF (OTR_ML) THEN
+ IF (IO%LTR_ML) THEN
!
ZABC = 1.
IF (JINT.LT.SIZE(PABC)) ZABC = PABC(JINT+1)
@@ -476,21 +415,21 @@ DO JINT = 1, SIZE(PABC)
!Extinction of respiration depends on LAI above only for tropical evergreen forest
ZLAITOP(:) = 0.
ZZLAI (:) = 1.
- IF (OTR_ML) THEN
+ IF (IO%LTR_ML) THEN
WHERE(GWOOD(:))
ZLAITOP(:) = (1.-(PABC(JINT)+ZABC)/2.)*ZLAI(:)
ZZLAI(:) = ZLAI(:)
ENDWHERE
ENDIF
CALL COTWO(PCSP, PF2, ZXIA, ZDSP, ZGAMMT, &
- ZFZERO, ZEPSO, ZANMAX, ZGMEST, PGC, ZDMAX, &
+ ZFZERO, ZEPSO, ZANMAX, ZGMEST, PEK%XGC(:), ZDMAX, &
ZAN0, ZGS0, ZRDK, ZLAITOP, ZZLAI )
!
- IF (OTR_ML) THEN
+ IF (IO%LTR_ML) THEN
!
ZXIA(:) = PIACAN_SHADE(:,JINT)
CALL COTWO(PCSP, PF2, ZXIA, ZDSP, ZGAMMT, &
- ZFZERO, ZEPSO, ZANMAX, ZGMEST, PGC, ZDMAX, &
+ ZFZERO, ZEPSO, ZANMAX, ZGMEST, PEK%XGC(:), ZDMAX, &
ZAN0_, ZGS0_, ZRDK_, ZLAITOP, ZZLAI )
!
WHERE (OSHADE(:))
@@ -512,11 +451,11 @@ END DO
!
! Total assimilation
!
-PANF(:)= ZTAN(:)
+ZANF(:)= ZTAN(:)
!
! Net assimilation over canopy
!
-PAN(:) = (1.0-PDELTA(:))*(1.0-PPSNV(:)-PFFV(:))*PANF(:)*ZLAI(:)
+PEK%XAN(:) = (1.0-PDELTA(:))*(1.0-PPSNV(:)-PFFV(:))*ZANF(:)*ZLAI(:)
!
! Dark respiration over canopy (does not depend on radiation,
! no need to integrate over vertical dimension)
@@ -525,15 +464,15 @@ PRESP_LEAF(:) = (1.0-PDELTA(:))*(1.0-PPSNV(:)-PFFV(:))*ZTRDK(:)*ZLAI(:)
!
! Gross primary production over canopy
!
-PGPP(:) = PAN(:) + PRESP_LEAF(:)
+PGPP(:) = PEK%XAN(:) + PRESP_LEAF(:)
!
! Cumulated daily net assimilation over canopy (kgCO2/m2/day)
!
-PANDAY(:) = PANDAY(:) + PAN(:) * PTSTEP * PRHOA(:)
+PEK%XANDAY(:) = PEK%XANDAY(:) + PEK%XAN(:) * PTSTEP * PRHOA
!
! Adjust maximum leaf assimilation:
!
-PANFM(:) = MAX( PANF(:), PANFM(:) )
+PEK%XANFM(:) = MAX( ZANF(:), PEK%XANFM(:) )
!
! Total conductance over canopy
!
diff --git a/src/SURFEX/coupling_dstn.F90 b/src/SURFEX/coupling_dstn.F90
index 454b5570656ad1837a984afaf38de885070e63a6..d2f64349f80478ad7af8497ec654d397a5754ab0 100644
--- a/src/SURFEX/coupling_dstn.F90
+++ b/src/SURFEX/coupling_dstn.F90
@@ -2,32 +2,19 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
-SUBROUTINE COUPLING_DST_n (DST, PKI, &
+SUBROUTINE COUPLING_DST_n (DSTK, KK, PK, PEK, DK, &
HPROGRAM, &!I [char] Type of ISBA version
KI, &!I [nbr] number of points in patch
KDST, &!I Number of dust emission variables
- KPATCH, &!I [nbr] number of patch in question
- PCLAY, &!I [frc] mass fraction of clay
PPS, &!I [Pa] surface pressure
- PTS, &!I [K] surface temperature
PQA, &!I [kg/kg] atmospheric specific humidity
- PRA, &!I [s/m] atmospheric resistance
PRHOA, &!I [kg/m3] atmospheric density
- PSAND, &!I [frc] mass fraction of sand
PPA, &!I [K] Atmospheric pressure
PTA, &!I [K] Atmospheric temperature
- PTG, &!I [K] Ground temperature
PU, &!I [m/s] zonal wind at atmospheric height
PUREF, &!I [m] reference height of wind
PV, &!I [m/s] meridional wind at atmospheric height
- PWG, &!I [m3/m3] ground volumetric water content
- PWSAT, &!I [m3/m3] saturation volumetric water content
PZREF, &!I [m] reference height of wind
- PCD, &!I [] Drag Coefficient for momentum
- PCDN, &!I [] Drag neutral Coefficient for momentum
- PCH, &!I [] drag coefficient for heat
- PRI, &!I [] Richardson number
- PZ0H_WITH_SNOW, &!I [frc] Z0 (heat) with snow
PSFDST &!O [kg/m2/sec] flux of dust
)
@@ -47,8 +34,10 @@ SUBROUTINE COUPLING_DST_n (DST, PKI, &
!! Modified 09/2012 : J. Escobar , SIZE(PTA) not allowed without-interface , replace by KI
!
!
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_DIAG_n, ONLY : DIAG_t
+!
USE MODD_DST_n, ONLY : DST_t
-USE MODD_PACK_ISBA, ONLY : PACK_ISBA_t
!
USE MODD_CSTS, ONLY : XRD ! [J/K/kg] The universal gas constant
@@ -69,34 +58,24 @@ IMPLICIT NONE
!INPUT
!
-TYPE(DST_t), INTENT(INOUT) :: DST
-TYPE(PACK_ISBA_t), INTENT(INOUT) :: PKI
+TYPE(DST_t), INTENT(INOUT) :: DSTK
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(DIAG_t), INTENT(INOUT) :: DK
!
CHARACTER(LEN=*), INTENT(IN) :: HPROGRAM !I Name of program
INTEGER, INTENT(IN) :: KI !I Number of points in patch
INTEGER, INTENT(IN) :: KDST !I Number of dust emission variables
-INTEGER, INTENT(IN) :: KPATCH !I Number of patch we are working on
-REAL, DIMENSION(KI), INTENT(IN) :: PCLAY !I [frc] mass fraction clay
REAL, DIMENSION(KI), INTENT(IN) :: PPS !I [Pa] surface pressure
-REAL, DIMENSION(KI), INTENT(IN) :: PTS !I [K] surface temperature
REAL, DIMENSION(KI), INTENT(IN) :: PQA !I [kg/kg] atmospheric specific humidity
-REAL, DIMENSION(KI), INTENT(IN) :: PRA !I [s/m] surface resistance
REAL, DIMENSION(KI), INTENT(IN) :: PRHOA !I [kg/m3] atmospheric density
-REAL, DIMENSION(KI), INTENT(IN) :: PSAND !I [frc] mass fraction sand
REAL, DIMENSION(KI), INTENT(IN) :: PPA !I [K] Atmospheric pressure
REAL, DIMENSION(KI), INTENT(IN) :: PTA !I [K] Atmospheric temperature
-REAL, DIMENSION(KI), INTENT(IN) :: PTG !I [K] Ground temperature
REAL, DIMENSION(KI), INTENT(IN) :: PU !I [m/s] zonal wind at atmospheric height
REAL, DIMENSION(KI), INTENT(IN) :: PUREF !I [m] reference height of wind
REAL, DIMENSION(KI), INTENT(IN) :: PV !I [m/s] meridional wind at atmospheric height
-REAL, DIMENSION(KI), INTENT(IN) :: PWG !I [m3/m3] ground volumetric water content
-REAL, DIMENSION(KI), INTENT(IN) :: PWSAT !I [m3/m3] saturation volumetric water content
REAL, DIMENSION(KI), INTENT(IN) :: PZREF !I [m] reference height of wind
-REAL, DIMENSION(KI), INTENT(IN) :: PCD !I [] Drag coefficient for momentum
-REAL, DIMENSION(KI), INTENT(IN) :: PCDN !I [] Drag coefficient for neutral momentum
-REAL, DIMENSION(KI), INTENT(IN) :: PCH !I [] Drag coefficient for heat
-REAL, DIMENSION(KI), INTENT(IN) :: PRI !I [] Richardson number from isba
-REAL, DIMENSION(KI), INTENT(IN) :: PZ0H_WITH_SNOW !I [frc] Z0 heat with snow
REAL, DIMENSION(KI,KDST), INTENT(OUT) :: PSFDST !O [kg/m2/sec] flux of dust for a patch
!LOCAL VARIABLES
@@ -116,11 +95,11 @@ ZSFDST_TILE(:,:,:)=0.d0
DO JVEG=1,NVEGNO_DST
!Jump out of loop if no dust emitter points
- IF (DST%NSIZE_PATCH_DST(JVEG,KPATCH)==0) CYCLE
+ IF (DSTK%NSIZE_PATCH_DST(JVEG)==0) CYCLE
CALL TREAT_SURF( &
- DST%NSIZE_PATCH_DST(JVEG,KPATCH), &!I[idx] number of dust emitter points in patch
- DST%NR_PATCH_DST(:,JVEG,KPATCH) &!I[idx] index translator from patch to dustemitter
+ DSTK%NSIZE_PATCH_DST(JVEG), &!I[idx] number of dust emitter points in patch
+ DSTK%NR_PATCH_DST (:,JVEG) &!I[idx] index translator from patch to dustemitter
)
ENDDO !Loop on dust emitter vegetation
@@ -134,10 +113,12 @@ ENDDO !Loop on dust emitter vegetation
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
IF (LHOOK) CALL DR_HOOK('COUPLING_DST_N',1,ZHOOK_HANDLE)
!
- CONTAINS
+CONTAINS
SUBROUTINE TREAT_SURF(KSIZE,KMASK)
-
+!
+USE MODD_DIAG_n, ONLY : DIAG_t
+!
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE !Size of dust emitter vector
@@ -145,44 +126,50 @@ INTEGER, DIMENSION(:), INTENT(IN) :: KMASK !mask from patch vector to dust em
!ALLOCATABLE VARIABLES FOR ALL VEGETATION TYPES
REAL, DIMENSION(KSIZE) :: ZP_CLAY ![frc] fraction of clay
-REAL, DIMENSION(KSIZE) :: ZP_MER10M ![m/s] meridional wind at 10m
-REAL, DIMENSION(KSIZE) :: ZP_PS ![Pa] surface pressure
-REAL, DIMENSION(KSIZE) :: ZP_TS ![K] surface temperature
+REAL, DIMENSION(KSIZE) :: ZP_SAND ![frc] fraction of sand
+!
+REAL, DIMENSION(KSIZE) :: ZP_PA ![K] Atmospheric pressure
+REAL, DIMENSION(KSIZE) :: ZP_TA ![K] Atmospheric temperature
REAL, DIMENSION(KSIZE) :: ZP_QA ![kg_{H2O}/kg_{air}] specific humidity
-REAL, DIMENSION(KSIZE) :: ZP_Q2M ![kg_{H2O}/kg_{air}] speficic humidity
-REAL, DIMENSION(KSIZE) :: ZP_HU2M ![-] relative humidity
-REAL, DIMENSION(KSIZE) :: ZP_RHOA ![kg/m3] atmospheric density
REAL, DIMENSION(KSIZE) :: ZP_RHOA_2M ![kg/m3] atmospheric density close to surface
-REAL, DIMENSION(KSIZE) :: ZP_SAND ![frc] fraction of sand
-REAL, DIMENSION(KSIZE) :: ZP_SFDST ![kg/m2/s] dust flux (kg/m2/s)
-REAL, DIMENSION(KSIZE,NDSTMDE) :: ZP_SFDST_MDE ![kg/m2/s] dust flux from modes
REAL, DIMENSION(KSIZE) :: ZP_SFMER ![m/s] wind friction in meridional direction
REAL, DIMENSION(KSIZE) :: ZP_SFZON ![m/s] wind friction in zonal direction
-REAL, DIMENSION(KSIZE) :: ZP_PA ![K] Atmospheric pressure
-REAL, DIMENSION(KSIZE) :: ZP_TA ![K] Atmospheric temperature
-REAL, DIMENSION(KSIZE) :: ZP_TG ![K] ground temperature
-REAL, DIMENSION(KSIZE) :: ZP_T2M ![K] 2M temperature
REAL, DIMENSION(KSIZE) :: ZP_U ![m/s] zonal wind at atmospheric height
-REAL, DIMENSION(KSIZE) :: ZP_UREF ![m] reference height for wind
-REAL, DIMENSION(KSIZE) :: ZP_USTAR ![m/s] wind friction speed
REAL, DIMENSION(KSIZE) :: ZP_V ![m/s] meridional wind at atmospheric height
REAL, DIMENSION(KSIZE) :: ZP_VMOD ![m/s] Wind at atmospheric height
+!
+REAL, DIMENSION(KSIZE) :: ZP_SFDST ![kg/m2/s] dust flux (kg/m2/s)
+REAL, DIMENSION(KSIZE,NDSTMDE) :: ZP_SFDST_MDE ![kg/m2/s] dust flux from modes
+!
+REAL, DIMENSION(KSIZE) :: ZP_TG ![K] ground temperature
REAL, DIMENSION(KSIZE) :: ZP_WG ![m3/m3] ground volumetric water content
-REAL, DIMENSION(KSIZE) :: ZP_WIND10M ![m/s] wind at 10m
REAL, DIMENSION(KSIZE) :: ZP_WSAT ![m3/m3] saturation volumetric water content
-REAL, DIMENSION(KSIZE) :: ZP_ZON10M ![m/s] zonal wind at 10m
-REAL, DIMENSION(KSIZE) :: ZP_ZREF ![m] reference height for wind
+REAL, DIMENSION(KSIZE) :: ZP_USTAR ![m/s] wind friction speed
+!
REAL, DIMENSION(KSIZE) :: ZP_Z0_EROD ![m] roughness length for erodible surface
+REAL, DIMENSION(KSIZE) :: ZP_DST_EROD !Erodable Surface (COVER004=1 and COVER005=0.01)
REAL, DIMENSION(KSIZE,3) :: ZP_MSS_FRC_SRC ![%] dust mode fraction of emitted mass
REAL, DIMENSION(KSIZE) :: ZP_INTER ![%] dust mode fraction of emitted mass
+REAL, DIMENSION(KSIZE) :: ZP_CD_DST ! drag coefficient uses by DEAD
+REAL, DIMENSION(KSIZE) :: ZH ! 10m (wind altitude)
+!
+REAL, DIMENSION(KSIZE) :: ZP_MER10M ![m/s] meridional wind at 10m
+REAL, DIMENSION(KSIZE) :: ZP_WIND10M ![m/s] wind at 10m
+REAL, DIMENSION(KSIZE) :: ZP_ZON10M ![m/s] zonal wind at 10m
+REAL, DIMENSION(KSIZE) :: ZP_PS ![Pa] surface pressure
+REAL, DIMENSION(KSIZE) :: ZP_TS ![K] surface temperature
+REAL, DIMENSION(KSIZE) :: ZP_Q2M ![kg_{H2O}/kg_{air}] speficic humidity
+REAL, DIMENSION(KSIZE) :: ZP_HU2M ![-] relative humidity
+REAL, DIMENSION(KSIZE) :: ZP_RHOA ![kg/m3] atmospheric density
+REAL, DIMENSION(KSIZE) :: ZP_T2M ![K] 2M temperature
+REAL, DIMENSION(KSIZE) :: ZP_UREF ![m] reference height for wind
+REAL, DIMENSION(KSIZE) :: ZP_ZREF ![m] reference height for wind
REAL, DIMENSION(KSIZE) :: ZP_CD !I [] drag coefficient for momentum from isba
REAL, DIMENSION(KSIZE) :: ZP_CH !I [] drag coefficient for heat
-REAL, DIMENSION(KSIZE) :: ZP_CD_DST ! drag coefficient uses by DEAD
REAL, DIMENSION(KSIZE) :: ZP_CDN ![-] drag coefficient neutral atm
REAL, DIMENSION(KSIZE) :: ZP_RI !I [-] Richardson number
-REAL, DIMENSION(KSIZE) :: ZP_Z0H_WITH_SNOW ![frc] Z0 heat with snow
-REAL, DIMENSION(KSIZE) :: ZP_DST_EROD !Erodable Surface (COVER004=1 and COVER005=0.01)
-REAL, DIMENSION(KSIZE) :: ZH ! 10m (wind altitude)
+REAL, DIMENSION(KSIZE) :: ZP_Z0H ![frc] Z0 heat with snow
+!
REAL, DIMENSION(5) :: ZSEUIL
REAL, DIMENSION(6,2) :: ZPCEN
INTEGER :: JJ, JS !Counter for vector points
@@ -194,30 +181,30 @@ IF (LHOOK) CALL DR_HOOK('COUPLING_DST_n:TREAT_SURF',0,ZHOOK_HANDLE)
!Pack patch-vectors to dust emitter vectors
!i.e. allocate memory for the packed (dust emitter) vectors
DO JJ=1,KSIZE
- ZP_CLAY(JJ) = PCLAY (KMASK(JJ))
- ZP_PS(JJ) = PPS (KMASK(JJ))
- ZP_TS(JJ) = PTS (KMASK(JJ))
- ZP_QA(JJ) = PQA (KMASK(JJ))
- ZP_RHOA(JJ) = PRHOA (KMASK(JJ))
- ZP_SAND(JJ) = PSAND (KMASK(JJ))
- ZP_PA(JJ) = PPA (KMASK(JJ))
- ZP_TA(JJ) = PTA (KMASK(JJ))
- ZP_TG(JJ) = PTG (KMASK(JJ))
- ZP_U(JJ) = PU (KMASK(JJ))
- ZP_UREF(JJ) = PUREF (KMASK(JJ))
- ZP_V(JJ) = PV (KMASK(JJ))
- ZP_WG(JJ) = PWG (KMASK(JJ))
- ZP_WSAT(JJ) = PWSAT (KMASK(JJ))
- ZP_ZREF(JJ) = PZREF (KMASK(JJ))
- ZP_CD(JJ) = PCD (KMASK(JJ))
- ZP_CDN(JJ) = PCDN (KMASK(JJ))
- ZP_CH(JJ) = PCH (KMASK(JJ))
- ZP_RI(JJ) = PRI (KMASK(JJ))
- ZP_Z0H_WITH_SNOW(JJ) = PZ0H_WITH_SNOW(KMASK(JJ))
+ ZP_CLAY(JJ) = KK%XCLAY(KMASK(JJ),1)
+ ZP_PS (JJ) = PPS (KMASK(JJ))
+ ZP_TS (JJ) = DK%XTS (KMASK(JJ))
+ ZP_QA (JJ) = PQA (KMASK(JJ))
+ ZP_RHOA(JJ) = PRHOA (KMASK(JJ))
+ ZP_SAND(JJ) = KK%XSAND(KMASK(JJ),1)
+ ZP_PA (JJ) = PPA (KMASK(JJ))
+ ZP_TA (JJ) = PTA (KMASK(JJ))
+ ZP_TG (JJ) = PEK%XTG (KMASK(JJ),1)
+ ZP_U (JJ) = PU (KMASK(JJ))
+ ZP_UREF(JJ) = PUREF (KMASK(JJ))
+ ZP_V (JJ) = PV (KMASK(JJ))
+ ZP_WG (JJ) = PEK%XWG (KMASK(JJ),1)
+ ZP_WSAT(JJ) = KK%XWSAT(KMASK(JJ),1)
+ ZP_ZREF(JJ) = PZREF (KMASK(JJ))
+ ZP_CD (JJ) = DK%XCD (KMASK(JJ))
+ ZP_CDN (JJ) = DK%XCDN (KMASK(JJ))
+ ZP_CH (JJ) = DK%XCH (KMASK(JJ))
+ ZP_RI (JJ) = DK%XRI (KMASK(JJ))
+ ZP_Z0H (JJ) = DK%XZ0H (KMASK(JJ))
ENDDO
!
!Manipulate some variables since we assume dust emission occurs over flat surface
-ZP_Z0_EROD(:) = DST%Z0_EROD_DST(JVEG) !Set z0 to roughness of erodible surface
+ZP_Z0_EROD(:) = DSTK%Z0_EROD_DST(JVEG) !Set z0 to roughness of erodible surface
!
IF (JVEG ==1) THEN
ZP_DST_EROD(:) = 1.
@@ -231,7 +218,7 @@ IF (CVERMOD/='CMDVER') THEN
!Re-calculate the drag over the dust emitter (erodable) surface. Since we
!don't use the roughness length of the patch, but rather use specific roughness
!lengths of dust emitter surfaces, the drag changes.
- CALL SURFACE_CD(ZP_RI, ZP_ZREF, ZP_UREF, ZP_Z0_EROD, ZP_Z0H_WITH_SNOW, ZP_CD_DST, ZP_CDN)
+ CALL SURFACE_CD(ZP_RI, ZP_ZREF, ZP_UREF, ZP_Z0_EROD, ZP_Z0H, ZP_CD_DST, ZP_CDN)
ENDIF
!
!Get total wind speed
@@ -250,7 +237,7 @@ ZH(:)=10.
ZP_ZON10M, ZP_MER10M )
ZH(:)=2.
CALL CLS_T(ZP_TA, ZP_QA, ZP_PA, ZP_PS, ZP_ZREF, ZP_CD_DST, ZP_CH, ZP_RI, &
- ZP_TS, ZP_Z0H_WITH_SNOW, ZH, ZP_T2M )
+ ZP_TS, ZP_Z0H, ZH, ZP_T2M )
!Get density at 2 meters rho=P/(RT)
ZP_RHOA_2M(:) = ZP_PS(:)/(ZP_T2M(:)*XRD)
@@ -373,7 +360,7 @@ IF (CEMISPARAM_DST == "EXPLI" .OR. CEMISPARAM_DST == "AMMA ") THEN
ELSE
DO JMODE = 1,NDSTMDE
- ZP_MSS_FRC_SRC(:,JORDER_DST(JMODE)) = DST%XMSS_FRC_SRC(JMODE)
+ ZP_MSS_FRC_SRC(:,JORDER_DST(JMODE)) = DSTK%XMSS_FRC_SRC(JMODE)
ENDDO
END IF
@@ -440,13 +427,13 @@ DO JMODE=1,NDSTMDE
!Get sum of vegetation fraction in this patch
!fxm: VERY BAD LOOP ORDER
- VEGFRAC_IN_PATCH = SUM(PKI%XP_VEGTYPE_PATCH(II,:))
+ VEGFRAC_IN_PATCH = SUM(PK%XVEGTYPE_PATCH(II,:))
!Get production of flux by adding up the contribution
!from the different tiles (here, "tiles" are dust emitter surfaces)
PSFDST(II,JSV_IDX) = PSFDST(II,JSV_IDX) & ![kg/m^2_{patch}/sec] dust flux per patch
+ (ZSFDST_TILE(II,JJ,JMODE) & ![kg/m^2_{emittersurface}/sec] Dust flux per surface area of dust emitter surface
- * PKI%XP_VEGTYPE_PATCH(II,DST%NVT_DST(JJ)) & ![frc] m^2_{emittersurface}/m^2_{nature}
+ * PK%XVEGTYPE_PATCH(II,DSTK%NVT_DST(JJ)) & ![frc] m^2_{emittersurface}/m^2_{nature}
/ VEGFRAC_IN_PATCH ) ![frc] m^2_{patch}/m^2_{nature}
ENDDO !loop on point in patch
ENDDO !loop on different dust emitter surfaces
diff --git a/src/SURFEX/coupling_flake_orographyn.F90 b/src/SURFEX/coupling_flake_orographyn.F90
index 69aa6300d46127c5d981151913cb99cfd0f3174e..d591ecc8dd45415c00b910bf9fe3890e0ffd306b 100644
--- a/src/SURFEX/coupling_flake_orographyn.F90
+++ b/src/SURFEX/coupling_flake_orographyn.F90
@@ -3,16 +3,16 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################################
-SUBROUTINE COUPLING_FLAKE_OROGRAPHY_n (FM, DST, SLT, &
- HPROGRAM, HCOUPLING, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, &
- PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+SUBROUTINE COUPLING_FLAKE_OROGRAPHY_n (FM, DST, SLT, HPROGRAM, HCOUPLING, &
+ PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, &
+ PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, &
+ PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
+ PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, &
+ PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV,&
+ PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, &
+ PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, &
+ PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
+ PPEQ_B_COEF, HTEST )
! ###############################################################################
!
!!**** *COUPLING_FLAKE_OROGRAPHY_n * - Modifies the input forcing if not
@@ -198,14 +198,14 @@ ELSE
!
ENDIF
!
- CALL COUPLING_FLAKE_SBL_n(FM, DST, SLT, &
- HPROGRAM, HCOUPLING, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PU, PV, &
- ZQA, ZTA, ZRHOA, PSV, PCO2, HSV, ZRAIN, ZSNOW, ZLW, PDIR_SW, PSCA_SW, &
- PSW_BANDS, ZPS, ZPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, ZPET_B_COEF, &
- ZPEQ_B_COEF, HTEST )
+ CALL COUPLING_FLAKE_SBL_n(FM%SB, FM%CHF, FM%DFO, FM%DF, FM%DFC, FM%DMF, FM%F, DST, SLT, &
+ HPROGRAM, HCOUPLING, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
+ KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PU, PV, &
+ ZQA, ZTA, ZRHOA, PSV, PCO2, HSV, ZRAIN, ZSNOW, ZLW, PDIR_SW, PSCA_SW, &
+ PSW_BANDS, ZPS, ZPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
+ PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
+ PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, ZPET_B_COEF, &
+ ZPEQ_B_COEF, HTEST )
!
IF (LHOOK) CALL DR_HOOK('COUPLING_FLAKE_OROGRAPHY_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/coupling_flake_sbln.F90 b/src/SURFEX/coupling_flake_sbln.F90
index de36804fc4e38da2672f91b2166f470f370de039..ecca6741aea698d34dda1bf21a36fb129468b1a1 100644
--- a/src/SURFEX/coupling_flake_sbln.F90
+++ b/src/SURFEX/coupling_flake_sbln.F90
@@ -3,14 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################################
-SUBROUTINE COUPLING_FLAKE_SBL_n (FM, DST, SLT, &
- HPROGRAM, HCOUPLING, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PU, PV, &
- PQA, PTA, PRHOA, PSV, PCO2, HSV,PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, &
- PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
- PPEQ_B_COEF, HTEST )
+SUBROUTINE COUPLING_FLAKE_SBL_n (SB, CHF, DGO, D, DC, DMF, F, DST, SLT, &
+ HPROGRAM, HCOUPLING, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
+ KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PU, PV, &
+ PQA, PTA, PRHOA, PSV, PCO2, HSV,PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, &
+ PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
+ PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
+ PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
+ PPEQ_B_COEF, HTEST )
! ###############################################################################
!
!!**** *COUPLING_FLAKE_SBL_n * - Adds a SBL into SEAFLUX
@@ -40,8 +40,11 @@ SUBROUTINE COUPLING_FLAKE_SBL_n (FM, DST, SLT, &
!----------------------------------------------------------------
!
!
-!
-USE MODD_SURFEX_n, ONLY : FLAKE_MODEL_t
+USE MODD_CANOPY_n, ONLY : CANOPY_t
+USE MODD_CH_FLAKE_n, ONLY : CH_FLAKE_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t, DIAG_t
+USE MODD_DIAG_MISC_FLAKE_n, ONLY : DIAG_MISC_FLAKE_t
+USE MODD_FLAKE_n, ONLY : FLAKE_t
!
USE MODD_DST_n, ONLY : DST_t
USE MODD_SLT_n, ONLY : SLT_t
@@ -66,7 +69,14 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(FLAKE_MODEL_t), INTENT(INOUT) :: FM
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
+TYPE(CH_FLAKE_t), INTENT(INOUT) :: CHF
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
+TYPE(DIAG_MISC_FLAKE_t), INTENT(INOUT) :: DMF
+TYPE(FLAKE_t), INTENT(INOUT) :: F
+!
TYPE(DST_t), INTENT(INOUT) :: DST
TYPE(SLT_t), INTENT(INOUT) :: SLT
!
@@ -159,21 +169,20 @@ REAL, DIMENSION(KI) :: ZPEQ_B_COEF ! coefficients (hum. in kg/kg)
REAL, DIMENSION(KI) :: ZSFLUX_U ! Surface flux u'w' (m2/s2)
REAL, DIMENSION(KI) :: ZSFLUX_T ! Surface flux w'T' (mK/s)
REAL, DIMENSION(KI) :: ZSFLUX_Q ! Surface flux w'q' (kgm2/s)
-REAL, DIMENSION(KI,FM%FSB%NLVL) :: ZFORC_U ! tendency due to drag force for wind
-REAL, DIMENSION(KI,FM%FSB%NLVL) :: ZDFORC_UDU! formal derivative of
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_U ! tendency due to drag force for wind
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_UDU! formal derivative of
! ! tendency due to drag force for wind
-REAL, DIMENSION(KI,FM%FSB%NLVL) :: ZFORC_E ! tendency due to drag force for TKE
-REAL, DIMENSION(KI,FM%FSB%NLVL) :: ZDFORC_EDE! formal derivative of
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_E ! tendency due to drag force for TKE
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_EDE! formal derivative of
! ! tendency due to drag force for TKE
-REAL, DIMENSION(KI,FM%FSB%NLVL) :: ZFORC_T ! tendency due to drag force for Temp
-REAL, DIMENSION(KI,FM%FSB%NLVL) :: ZDFORC_TDT! formal derivative of
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_T ! tendency due to drag force for Temp
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_TDT! formal derivative of
! ! tendency due to drag force for Temp
-REAL, DIMENSION(KI,FM%FSB%NLVL) :: ZFORC_Q ! tendency due to drag force for Temp
-REAL, DIMENSION(KI,FM%FSB%NLVL) :: ZDFORC_QDQ! formal derivative of
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_Q ! tendency due to drag force for Temp
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_QDQ! formal derivative of
! ! tendency due to drag force for hum.
-REAL, DIMENSION(KI,FM%FSB%NLVL) :: ZLMO ! MO length
-REAL, DIMENSION(KI,FM%FSB%NLVL) :: ZLM ! mixing length
-REAL, DIMENSION(KI,FM%FSB%NLVL) :: ZLEPS ! dissipative length
+REAL, DIMENSION(KI,SB%NLVL) :: ZLM ! mixing length
+REAL, DIMENSION(KI,SB%NLVL) :: ZLEPS ! dissipative length
REAL, DIMENSION(KI) :: ZH ! canopy height (m)
REAL, DIMENSION(KI) :: ZUSTAR ! friction velocity (m/s)
!
@@ -189,6 +198,7 @@ REAL, DIMENSION(KI) :: ZBETATH ! Th+(1) = - alfa rho w'th'(1) + beta
REAL, DIMENSION(KI) :: ZALFAQ ! Q+(1) = - alfa rho w'q'(1) + beta
REAL, DIMENSION(KI) :: ZBETAQ ! Q+(1) = - alfa rho w'q'(1) + beta
!
+INTEGER :: JLAYER
CHARACTER(LEN=1) :: GCOUPLING
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
@@ -198,7 +208,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('COUPLING_FLAKE_SBL_N',0,ZHOOK_HANDLE)
-IF (FM%F%LSBL) THEN
+IF (F%LSBL) THEN
!
!* 1.1 Updates SBL vertical grid as a function of forcing height
! ---------------------------------------------------------
@@ -206,45 +216,38 @@ IF (FM%F%LSBL) THEN
!* determines where is the forcing level and modifies the upper levels of the canopy grid
!
ZH = 0.
- CALL CANOPY_GRID_UPDATE(KI,FM%FSB%NLVL,ZH,PUREF,&
- FM%FSB%XZ,FM%FSB%XZF,FM%FSB%XDZ,FM%FSB%XDZF)
+ CALL CANOPY_GRID_UPDATE(KI,ZH,PUREF,SB)
!
!
!
!* 1.2 Initialisation at first time step
! ---------------------------------
!
- IF(ANY(FM%FSB%XT(:,:) == XUNDEF)) THEN
- CALL INIT_WATER_SBL(FM%FSB%NLVL, PPA, PPS, PTA, PQA, PRHOA, PU, PV, PRAIN, PSNOW, &
- PSFTH, PSFTQ, PZREF, PUREF, FM%F%XTS, FM%F%XZ0, FM%FSB%XZ, &
- FM%FSB%XT, FM%FSB%XQ, FM%FSB%XU, FM%FSB%XTKE, FM%FSB%XP)
+ IF(ANY(SB%XT(:,:) == XUNDEF)) THEN
+ CALL INIT_WATER_SBL(SB, PPA, PPS, PTA, PQA, PRHOA, PU, PV, PRAIN, PSNOW, &
+ PSFTH, PSFTQ, PZREF, PUREF, F%XTS, F%XZ0)
ENDIF
!
!
!* 1.3 Allocations
! -----------
!
- CALL INIT_FORC( ZFORC_U, ZDFORC_UDU, ZFORC_E, ZDFORC_EDE, &
+ CALL INIT_FORC(ZFORC_U, ZDFORC_UDU, ZFORC_E, ZDFORC_EDE, &
ZFORC_T, ZDFORC_TDT, ZFORC_Q, ZDFORC_QDQ )
!
ZSFLUX_U = 0.
ZSFLUX_T = 0.
ZSFLUX_Q = 0.
-!
- ZLMO = SPREAD(FM%FSB%XLMO,2,FM%FSB%NLVL)
!
!* 1.3 Computes coefficients for implicitation
! ---------------------------------------
!
ZWIND = SQRT(PU**2+PV**2)
- CALL CANOPY_EVOL(KI,FM%FSB%NLVL,PTSTEP,1,FM%FSB%XZ,ZWIND,PTA,PQA,PPA,PRHOA, &
- ZSFLUX_U,ZSFLUX_T,ZSFLUX_Q, &
- ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE, &
- ZFORC_T,ZDFORC_TDT,ZFORC_Q,ZDFORC_QDQ, &
- FM%FSB%XZ,FM%FSB%XZF,FM%FSB%XDZ,FM%FSB%XDZF, &
- FM%FSB%XU,FM%FSB%XTKE,FM%FSB%XT, &
- FM%FSB%XQ,ZLMO,ZLM,ZLEPS,FM%FSB%XP,ZUSTAR, &
- ZALFAU,ZBETAU,ZALFATH,ZBETATH,ZALFAQ,ZBETAQ )
+ CALL CANOPY_EVOL(SB,KI,PTSTEP,1,SB%XZ,ZWIND,PTA,PQA,PPA,PRHOA, &
+ ZSFLUX_U,ZSFLUX_T,ZSFLUX_Q,ZFORC_U,ZDFORC_UDU, &
+ ZFORC_E,ZDFORC_EDE,ZFORC_T,ZDFORC_TDT, &
+ ZFORC_Q,ZDFORC_QDQ,ZLM,ZLEPS,ZUSTAR, &
+ ZALFAU,ZBETAU,ZALFATH,ZBETATH,ZALFAQ,ZBETAQ )
!
!* 1.5 Goes from atmospheric forcing to canopy forcing height
@@ -252,9 +255,7 @@ IF (FM%F%LSBL) THEN
!
GCOUPLING = 'E'
!
- CALL INIT_COUPLING_CANOPY( FM%FSB%XP(:,1), PPA, FM%FSB%XT(:,1), &
- FM%FSB%XQ(:,1), PU, PV, FM%FSB%XZ(:,1), &
- FM%FSB%XU(:,1), &
+ CALL INIT_COUPLING_CANOPY(SB, PPA, PU, PV, &
PRHOA, ZALFAU, ZBETAU, ZALFATH, &
ZBETATH, ZALFAQ, ZBETAQ, &
ZPA, ZTA, ZQA, ZU, ZV, &
@@ -291,34 +292,30 @@ END IF
!* 2. Call of SEAFLUX
! ------------
!
- CALL COUPLING_FLAKE_n(FM, DST, SLT, &
- HPROGRAM, GCOUPLING, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- KI, KSV, KSW, &
- PTSUN, PZENITH, PZENITH2, PAZIM, &
- ZZREF, ZUREF, ZU, ZV, ZQA, ZTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, ZPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- ZPEW_A_COEF, ZPEW_B_COEF, &
- ZPET_A_COEF, ZPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF, &
- HTEST )
+ CALL COUPLING_FLAKE_n(CHF, DGO, D, DC, DMF, F, DST, SLT, &
+ HPROGRAM, GCOUPLING, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
+ KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, ZZREF, ZUREF, &
+ ZU, ZV, ZQA, ZTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, &
+ PDIR_SW, PSCA_SW, PSW_BANDS, PPS, ZPA, PSFTQ, PSFTH, PSFTS, &
+ PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF,&
+ PZ0, PZ0H, PQSURF, ZPEW_A_COEF, ZPEW_B_COEF, ZPET_A_COEF, &
+ ZPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF, HTEST )
!
!-------------------------------------------------------------------------------------
!
!* 3. End if no SBL is used
! ---------------------
!
-IF (.NOT. FM%F%LSBL .AND. LHOOK) CALL DR_HOOK('COUPLING_FLAKE_SBL_N',1,ZHOOK_HANDLE)
-IF (.NOT. FM%F%LSBL) RETURN
+IF (.NOT. F%LSBL .AND. LHOOK) CALL DR_HOOK('COUPLING_FLAKE_SBL_N',1,ZHOOK_HANDLE)
+IF (.NOT. F%LSBL) RETURN
!
!-------------------------------------------------------------------------------------
!
!* 4. Computes the impact of canopy and surfaces on air
! -------------------------------------------------
!
- CALL INIT_FORC( ZFORC_U, ZDFORC_UDU, ZFORC_E, ZDFORC_EDE, &
- ZFORC_T, ZDFORC_TDT, ZFORC_Q, ZDFORC_QDQ )
+ CALL INIT_FORC(ZFORC_U, ZDFORC_UDU, ZFORC_E, ZDFORC_EDE, &
+ ZFORC_T, ZDFORC_TDT, ZFORC_Q, ZDFORC_QDQ )
!
ZSFLUX_U = - SQRT(PSFU(:)**2+PSFV(:)**2) / PRHOA(:)
ZSFLUX_T(:) = PSFTH(:) / XCPD * ZEXNA(:) / PRHOA(:)
@@ -330,16 +327,15 @@ ZSFLUX_Q(:) = PSFTQ(:)
! --------------------------------------------
!
ZWIND = SQRT(PU**2+PV**2)
- CALL CANOPY_EVOL(KI,FM%FSB%NLVL,PTSTEP,2,FM%FSB%XZ,ZWIND,PTA,PQA,PPA,PRHOA, &
- ZSFLUX_U,ZSFLUX_T,ZSFLUX_Q, &
- ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE, &
- ZFORC_T,ZDFORC_TDT,ZFORC_Q,ZDFORC_QDQ, &
- FM%FSB%XZ,FM%FSB%XZF,FM%FSB%XDZ,FM%FSB%XDZF, &
- FM%FSB%XU,FM%FSB%XTKE,FM%FSB%XT, &
- FM%FSB%XQ,ZLMO,ZLM,ZLEPS,FM%FSB%XP,ZUSTAR, &
- ZALFAU,ZBETAU,ZALFATH,ZBETATH,ZALFAQ,ZBETAQ )
+ CALL CANOPY_EVOL(SB, KI, PTSTEP, 2,SB%XZ,ZWIND,PTA,PQA,PPA,PRHOA, &
+ ZSFLUX_U,ZSFLUX_T,ZSFLUX_Q,ZFORC_U,ZDFORC_UDU, &
+ ZFORC_E,ZDFORC_EDE,ZFORC_T,ZDFORC_TDT, &
+ ZFORC_Q,ZDFORC_QDQ,ZLM,ZLEPS,ZUSTAR, &
+ ZALFAU,ZBETAU,ZALFATH,ZBETATH,ZALFAQ,ZBETAQ )
!
-FM%FSB%XLMO(:) = ZLMO(:,FM%FSB%NLVL)
+DO JLAYER = 1,SB%NLVL-1
+ SB%XLMO(:,JLAYER) = SB%XLMO(:,SB%NLVL)
+ENDDO
!
!-------------------------------------------------------------------------------------
!
@@ -347,13 +343,7 @@ FM%FSB%XLMO(:) = ZLMO(:,FM%FSB%NLVL)
! ----------------------------------------
!
!
-IF (FM%F%LSBL .AND. FM%DGF%N2M>=1) CALL INIT_2M_10M( FM%FSB%XP(:,2), FM%FSB%XT(:,2), &
- FM%FSB%XQ(:,2), FM%FSB%XU, FM%FSB%XZ, &
- PU, PV, ZWIND, PRHOA, &
- FM%DGF%XT2M, FM%DGF%XQ2M, FM%DGF%XHU2M, &
- FM%DGF%XZON10M, FM%DGF%XMER10M,&
- FM%DGF%XWIND10M, FM%DGF%XWIND10M_MAX, FM%DGF%XT2M_MIN, &
- FM%DGF%XT2M_MAX, FM%DGF%XHU2M_MIN, FM%DGF%XHU2M_MAX )
+IF (F%LSBL .AND. DGO%N2M>=1) CALL INIT_2M_10M( SB, D, PU, PV, ZWIND, PRHOA )
!
IF (LHOOK) CALL DR_HOOK('COUPLING_FLAKE_SBL_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/coupling_flaken.F90 b/src/SURFEX/coupling_flaken.F90
index 4688a2423b3cea3d8e5e579c7d0ea27bb15eae55..cbd81bb0a5446aeca4b22f3dafa427f73c14370e 100644
--- a/src/SURFEX/coupling_flaken.F90
+++ b/src/SURFEX/coupling_flaken.F90
@@ -3,16 +3,15 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################################
-SUBROUTINE COUPLING_FLAKE_n (FM, DST, SLT, &
- HPROGRAM, HCOUPLING, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, &
- PZENITH2, PAZIM, PZREF, PUREF, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, &
- HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTSRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+SUBROUTINE COUPLING_FLAKE_n (CHF, DGO, D, DC, DMF, F, DST, SLT, &
+ HPROGRAM, HCOUPLING, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
+ KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, &
+ PUREF, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, &
+ PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, &
+ PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTSRAD, PDIR_ALB, &
+ PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, &
+ PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
+ PPEQ_B_COEF, HTEST )
! ###############################################################################
!
@@ -48,8 +47,10 @@ SUBROUTINE COUPLING_FLAKE_n (FM, DST, SLT, &
!!------------------------------------------------------------------------------
!
!
-!
-USE MODD_SURFEX_n, ONLY : FLAKE_MODEL_t
+USE MODD_CH_FLAKE_n, ONLY : CH_FLAKE_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t, DIAG_t
+USE MODD_DIAG_MISC_FLAKE_n, ONLY : DIAG_MISC_FLAKE_t
+USE MODD_FLAKE_n, ONLY : FLAKE_t
!
USE MODD_DST_n, ONLY : DST_t
USE MODD_SLT_n, ONLY : SLT_t
@@ -88,7 +89,13 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(FLAKE_MODEL_t), INTENT(INOUT) :: FM
+TYPE(CH_FLAKE_t), INTENT(INOUT) :: CHF
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
+TYPE(DIAG_MISC_FLAKE_t), INTENT(INOUT) :: DMF
+TYPE(FLAKE_t), INTENT(INOUT) :: F
+!
TYPE(DST_t), INTENT(INOUT) :: DST
TYPE(SLT_t), INTENT(INOUT) :: SLT
!
@@ -212,6 +219,8 @@ LOGICAL :: GHANDLE_SIC = .FALSE. ! no sea-ice model
!
REAL :: ZEPS = 1.E-7
!
+INTEGER :: IBEG, IEND
+!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
! Preliminaries:
@@ -262,8 +271,8 @@ ZHU(:) = 1.
! Time evolution
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-FM%F%TTIME%TIME = FM%F%TTIME%TIME + PTSTEP
- CALL ADD_FORECAST_TO_DATE_SURF(FM%F%TTIME%TDATE%YEAR,FM%F%TTIME%TDATE%MONTH,FM%F%TTIME%TDATE%DAY,FM%F%TTIME%TIME)
+F%TTIME%TIME = F%TTIME%TIME + PTSTEP
+ CALL ADD_FORECAST_TO_DATE_SURF(F%TTIME%TDATE%YEAR,F%TTIME%TDATE%MONTH,F%TTIME%TDATE%DAY,F%TTIME%TIME)
!
!----------------------------------------
!
@@ -271,16 +280,14 @@ PSFU(:) = 0.
PSFV(:) = 0.
ZSFM(:) = 0.
!
-IF (FM%F%CFLK_FLUX=='DEF ') THEN
+IF (F%CFLK_FLUX=='DEF ') THEN
!
- CALL WATER_FLUX(FM%F%XZ0, &
- PTA, ZEXNA, PRHOA, FM%F%XTS, ZEXNS, PQA,PRAIN, PSNOW, &
- XTT, ZWIND, PZREF, PUREF, &
- PPS, GHANDLE_SIC, ZQSAT, &
- PSFTH, PSFTQ, ZUSTAR, &
- ZCD, ZCDN, ZCH, ZRI, ZRESA_WATER, ZZ0H )
+ CALL WATER_FLUX(F%XZ0, PTA, ZEXNA, PRHOA, F%XTS, ZEXNS, PQA, &
+ PRAIN, PSNOW, XTT, ZWIND, PZREF, PUREF, &
+ PPS, GHANDLE_SIC, ZQSAT, PSFTH, PSFTQ, ZUSTAR,&
+ ZCD, ZCDN, ZCH, ZRI, ZRESA_WATER, ZZ0H )
!
- WHERE (FM%F%XTS(:)<XTT)
+ WHERE (F%XTS(:)<XTT)
ZLE (:) = PSFTQ(:) * XLSTT
ZLEI (:) = PSFTQ(:) * XLSTT
ZSUBL(:) = PSFTQ(:)
@@ -315,8 +322,8 @@ IF (FM%F%CFLK_FLUX=='DEF ') THEN
END WHERE
!
ELSE
- ZUSTAR(:) = FM%F%XUSTAR(:)
- ZZ0H (:) = FM%F%XZ0 (:)
+ ZUSTAR(:) = F%XUSTAR(:)
+ ZZ0H (:) = F%XZ0 (:)
ENDIF
!
!----------------------------------------
@@ -326,39 +333,32 @@ ENDIF
ISWB = SIZE(PSW_BANDS)
!
DO JSWB=1,ISWB
- ZDIR_ALB(:,JSWB) = FM%F%XDIR_ALB(:)
- ZSCA_ALB(:,JSWB) = FM%F%XSCA_ALB(:)
+ ZDIR_ALB(:,JSWB) = F%XDIR_ALB(:)
+ ZSCA_ALB(:,JSWB) = F%XSCA_ALB(:)
END DO
!
-ZTRAD = FM%F%XTS
+ZTRAD = F%XTS
!
CALL FLAKE_ALBEDO(PDIR_SW,PSCA_SW,KSW,ZDIR_ALB,ZSCA_ALB,ZGLOBAL_SW,ZALB)
!
- CALL FLAKE_INTERFACE( KI, &
+ CALL FLAKE_INTERFACE(F, KI, &
! Atmospheric forcing:
- PSNOW, ZGLOBAL_SW, PLW, PUREF, PZREF, ZWIND, PTA, ZQA, PPS, &
+ PSNOW, ZGLOBAL_SW, PLW, PUREF, PZREF, ZWIND, PTA, ZQA, PPS, &
! Constant parameters
- FM%F%XWATER_DEPTH, FM%F%XWATER_FETCH, FM%F%XDEPTH_BS, FM%F%XT_BS, FM%F%XCORIO,&
- ZTSTEP, &
+ ZTSTEP, &
! surface albedo
- FM%F%XEMIS, ZALB, &
-! Parameters that may change (constants for the moment)
- FM%F%XEXTCOEF_WATER, FM%F%XEXTCOEF_ICE, FM%F%XEXTCOEF_SNOW, &
-! Flake variables
- FM%F%XT_SNOW, FM%F%XT_ICE, FM%F%XT_MNW, FM%F%XT_WML, FM%F%XT_BOT, FM%F%XT_B1, FM%F%XCT, &
- FM%F%XH_SNOW, FM%F%XH_ICE, FM%F%XH_ML, FM%F%XH_B1, FM%F%XTS, &
+ ZALB, &
! Surface heat, momentum fluxes, and other diags
- PSFTH, ZLE, ZSFM, FM%F%XZ0, ZZ0H, ZQSAT, ZRI, ZUSTAR, &
- ZCD, PSFTQ, ZLEI, ZSUBL, ZLWUP, ZSWE, &
+ PSFTH, ZLE, ZSFM, ZZ0H, ZQSAT, ZRI, ZUSTAR, &
+ ZCD, PSFTQ, ZLEI, ZSUBL, ZLWUP, ZSWE, &
! Flags
- FM%F%LSEDIMENTS, FM%F%LSKINTEMP, FM%F%CFLK_FLUX, PPEW_A_COEF, &
- PPEW_B_COEF, PRHOA, CIMPLICIT_WIND )
+ PPEW_A_COEF, PPEW_B_COEF, PRHOA, CIMPLICIT_WIND )
!
!-------------------------------------------------------------------------------------
!
! Momentum fluxes
!
-IF (FM%F%CFLK_FLUX=='FLAKE') THEN
+IF (F%CFLK_FLUX=='FLAKE') THEN
PSFU = 0.
PSFV = 0.
WHERE (ZWIND(:)>0.)
@@ -373,13 +373,13 @@ IF (FM%F%CFLK_FLUX=='FLAKE') THEN
ZEXNA (:) = (PPA(:)/XP00)**(XRD/XCPD)
ZRESA_WATER=2.E4
WHERE (PSFTH/=0.)
- ZRESA_WATER (:) = XCPD * PRHOA(:) * (FM%F%XTS(:) - PTA(:) * ZEXNS(:)/ZEXNA(:)) &
+ ZRESA_WATER (:) = XCPD * PRHOA(:) * (F%XTS(:) - PTA(:) * ZEXNS(:)/ZEXNA(:)) &
/ (PSFTH(:) * ZEXNS(:))
END WHERE
!
ENDIF
!
-FM%F%XUSTAR(:) = ZUSTAR(:)
+F%XUSTAR(:) = ZUSTAR(:)
!
! CO2 flux
!
@@ -391,36 +391,47 @@ PSFCO2(:) = 0.0 ! Assumes no CO2 emission over water bodies
!
!
!salgado The scalar fluxes are computed as in watflux
-IF (FM%CHF%SVF%NBEQ>0) THEN
- IF (FM%CHF%CCH_DRY_DEP == "WES89") THEN
- CALL CH_DEP_WATER (ZRESA_WATER, ZUSTAR, PTA, ZTRAD, &
- PSV(:,FM%CHF%SVF%NSV_CHSBEG:FM%CHF%SVF%NSV_CHSEND), &
- FM%CHF%SVF%CSV(FM%CHF%SVF%NSV_CHSBEG:FM%CHF%SVF%NSV_CHSEND), &
- FM%CHF%XDEP(:,1:FM%CHF%SVF%NBEQ) )
+IF (CHF%SVF%NBEQ>0) THEN
+ !
+ IF (CHF%CCH_DRY_DEP == "WES89") THEN
+ !
+ IBEG = CHF%SVF%NSV_CHSBEG
+ IEND = CHF%SVF%NSV_CHSEND
+ !
+ CALL CH_DEP_WATER (ZRESA_WATER, ZUSTAR, PTA, ZTRAD, PSV(:,IBEG:IEND), &
+ CHF%SVF%CSV(IBEG:IEND), CHF%XDEP(:,1:CHF%SVF%NBEQ) )
- PSFTS(:,FM%CHF%SVF%NSV_CHSBEG:FM%CHF%SVF%NSV_CHSEND) = - PSV(:,FM%CHF%SVF%NSV_CHSBEG:FM%CHF%SVF%NSV_CHSEND) &
- * FM%CHF%XDEP(:,1:FM%CHF%SVF%NBEQ)
- IF (FM%CHF%SVF%NAEREQ > 0 ) THEN
- CALL CH_AER_DEP(PSV(:,FM%CHF%SVF%NSV_AERBEG:FM%CHF%SVF%NSV_AEREND),&
- PSFTS(:,FM%CHF%SVF%NSV_AERBEG:FM%CHF%SVF%NSV_AEREND),&
- ZUSTAR,ZRESA_WATER,PTA,PRHOA)
+ PSFTS(:,IBEG:IEND) = - PSV(:,IBEG:IEND) * CHF%XDEP(:,1:CHF%SVF%NBEQ)
+ !
+ IF (CHF%SVF%NAEREQ > 0 ) THEN
+ IBEG = CHF%SVF%NSV_AERBEG
+ IEND = CHF%SVF%NSV_AEREND
+ !
+ CALL CH_AER_DEP(PSV(:,IBEG:IEND),PSFTS(:,IBEG:IEND),ZUSTAR,ZRESA_WATER,PTA,PRHOA)
END IF
ELSE
- PSFTS(:,FM%CHF%SVF%NSV_CHSBEG:FM%CHF%SVF%NSV_CHSEND) =0.
- IF(FM%CHF%SVF%NSV_AERBEG.LT.FM%CHF%SVF%NSV_AEREND) PSFTS(:,FM%CHF%SVF%NSV_AERBEG:FM%CHF%SVF%NSV_AEREND) =0.
+ IBEG = CHF%SVF%NSV_AERBEG
+ IEND = CHF%SVF%NSV_AEREND
+ !
+ PSFTS(:,IBEG:IEND) =0.
+ IF(IBEG.LT.IEND) PSFTS(:,IBEG:IEND) =0.
ENDIF
+ !
ENDIF
-IF (FM%CHF%SVF%NDSTEQ>0) THEN
- CALL DSLT_DEP(PSV(:,FM%CHF%SVF%NSV_DSTBEG:FM%CHF%SVF%NSV_DSTEND), PSFTS(:,FM%CHF%SVF%NSV_DSTBEG:FM%CHF%SVF%NSV_DSTEND), &
- ZUSTAR, ZRESA_WATER, PTA, PRHOA, DST%XEMISSIG_DST, DST%XEMISRADIUS_DST, &
- JPMODE_DST, XDENSITY_DST, XMOLARWEIGHT_DST, ZCONVERTFACM0_DST, &
- ZCONVERTFACM6_DST, ZCONVERTFACM3_DST, LVARSIG_DST, LRGFIX_DST, &
- CVERMOD )
+IF (CHF%SVF%NDSTEQ>0) THEN
+ !
+ IBEG = CHF%SVF%NSV_DSTBEG
+ IEND = CHF%SVF%NSV_DSTEND
+ !
+ CALL DSLT_DEP(PSV(:,IBEG:IEND), PSFTS(:,IBEG:IEND), ZUSTAR, ZRESA_WATER, PTA, PRHOA, &
+ DST%XEMISSIG_DST, DST%XEMISRADIUS_DST, JPMODE_DST, XDENSITY_DST, &
+ XMOLARWEIGHT_DST, ZCONVERTFACM0_DST, ZCONVERTFACM6_DST, ZCONVERTFACM3_DST, &
+ LVARSIG_DST, LRGFIX_DST, CVERMOD )
CALL MASSFLUX2MOMENTFLUX( &
- PSFTS(:,FM%CHF%SVF%NSV_DSTBEG:FM%CHF%SVF%NSV_DSTEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
+ PSFTS(:,IBEG:IEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
PRHOA, & !I [kg/m3] air density
DST%XEMISRADIUS_DST, &!I [um] emitted radius for the modes (max 3)
DST%XEMISSIG_DST, &!I [-] emitted sigma for the different modes (max 3)
@@ -432,15 +443,18 @@ IF (FM%CHF%SVF%NDSTEQ>0) THEN
ENDIF
-IF (FM%CHF%SVF%NSLTEQ>0) THEN
- CALL DSLT_DEP(PSV(:,FM%CHF%SVF%NSV_SLTBEG:FM%CHF%SVF%NSV_SLTEND), PSFTS(:,FM%CHF%SVF%NSV_SLTBEG:FM%CHF%SVF%NSV_SLTEND), &
- ZUSTAR, ZRESA_WATER, PTA, PRHOA, SLT%XEMISSIG_SLT, SLT%XEMISRADIUS_SLT, &
- JPMODE_SLT, XDENSITY_SLT, XMOLARWEIGHT_SLT, ZCONVERTFACM0_SLT, &
- ZCONVERTFACM6_SLT, ZCONVERTFACM3_SLT, LVARSIG_SLT, LRGFIX_SLT, &
- CVERMOD )
+IF (CHF%SVF%NSLTEQ>0) THEN
+ !
+ IBEG = CHF%SVF%NSV_SLTBEG
+ IEND = CHF%SVF%NSV_SLTEND
+ !
+ CALL DSLT_DEP(PSV(:,IBEG:IEND), PSFTS(:,IBEG:IEND), ZUSTAR, ZRESA_WATER, PTA, PRHOA, &
+ SLT%XEMISSIG_SLT, SLT%XEMISRADIUS_SLT, JPMODE_SLT, XDENSITY_SLT, &
+ XMOLARWEIGHT_SLT, ZCONVERTFACM0_SLT, ZCONVERTFACM6_SLT, ZCONVERTFACM3_SLT, &
+ LVARSIG_SLT, LRGFIX_SLT, CVERMOD )
CALL MASSFLUX2MOMENTFLUX( &
- PSFTS(:,FM%CHF%SVF%NSV_SLTBEG:FM%CHF%SVF%NSV_SLTEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
+ PSFTS(:,IBEG:IEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
PRHOA, & !I [kg/m3] air density
SLT%XEMISRADIUS_SLT, &!I [um] emitted radius for the modes (max 3)
SLT%XEMISSIG_SLT, &!I [-] emitted sigma for the different modes (max 3)
@@ -456,31 +470,30 @@ ENDIF
! Inline diagnostics
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-IF (FM%F%CFLK_FLUX=='FLAKE') THEN !compute some variables not present in FLake code
+IF (F%CFLK_FLUX=='FLAKE') THEN !compute some variables not present in FLake code
!
ZCH = ZEPS
!
- WHERE (ABS((FM%F%XTS(:) - PTA(:) * ZEXNS(:)/ZEXNA(:))) > 1.E-2 .AND. ZWIND(:)/=0.)
- ZCH = MAX(ZEPS,PSFTH / (XCPD * PRHOA(:) * ZWIND(:) * (FM%F%XTS(:) - PTA(:) * ZEXNS(:)/ZEXNA(:))) * ZEXNS(:))
+ WHERE (ABS((F%XTS(:) - PTA(:) * ZEXNS(:)/ZEXNA(:))) > 1.E-2 .AND. ZWIND(:)/=0.)
+ ZCH = MAX(ZEPS,PSFTH / (XCPD * PRHOA(:) * ZWIND(:) * (F%XTS(:) - PTA(:) * ZEXNS(:)/ZEXNA(:))) * ZEXNS(:))
END WHERE
!
- ZCDN(:) = (XKARMAN/LOG(PUREF(:)/FM%F%XZ0(:)))**2
+ ZCDN(:) = (XKARMAN/LOG(PUREF(:)/F%XZ0(:)))**2
ZCD (:) = MAX(ZEPS,ZCD(:))
!
ENDIF
!
- CALL DIAG_INLINE_FLAKE_n(FM%DGF, FM%F, &
- PTSTEP, PTA, ZQA, PPA, PPS, PRHOA, PU, &
- PV, PZREF, PUREF, PRAIN, PSNOW, &
- ZCD, ZCDN, ZCH, ZRI, ZHU, &
- ZZ0H, ZQSAT, PSFTH, PSFTQ, PSFU, PSFV, &
- PDIR_SW, PSCA_SW, PLW, ZDIR_ALB, ZSCA_ALB, &
- ZLE, ZLEI, ZSUBL, ZLWUP, ZALB, ZSWE )
+ CALL DIAG_INLINE_FLAKE_n(DGO, D, DC, F, &
+ PTSTEP, PTA, ZQA, PPA, PPS, PRHOA, PU, &
+ PV, PZREF, PUREF, PRAIN, PSNOW, &
+ ZCD, ZCDN, ZCH, ZRI, ZHU, &
+ ZZ0H, ZQSAT, PSFTH, PSFTQ, PSFU, PSFV, &
+ PDIR_SW, PSCA_SW, PLW, ZDIR_ALB, ZSCA_ALB, &
+ ZLE, ZLEI, ZSUBL, ZLWUP, ZALB, ZSWE )
!
!-------------------------------------------------------------------------------------
!
- CALL DIAG_MISC_FLAKE_n(FM%DGMF, &
- FM%F%XT_WML,FM%F%XT_BOT,FM%F%XH_ML,FM%F%XCT,FM%F%XWATER_DEPTH)
+ CALL DIAG_MISC_FLAKE_n(DMF, F)
!
!-------------------------------------------------------------------------------
!Physical properties see by the atmosphere in order to close the energy budget
@@ -488,8 +501,8 @@ ENDIF
!difficult to do. Maybe it will be done later. However, Ts can be at time t+1
!-------------------------------------------------------------------------------
!
-PTSURF (:) = FM%F%XTS (:)
-PZ0 (:) = FM%F%XZ0 (:)
+PTSURF (:) = F%XTS (:)
+PZ0 (:) = F%XZ0 (:)
PZ0H (:) = ZZ0H (:)
PQSURF (:) = ZQSAT(:)
!
@@ -498,8 +511,7 @@ PQSURF (:) = ZQSAT(:)
!the energy budget between surfex and the atmosphere
!-------------------------------------------------------------------------------------
!
- CALL UPDATE_RAD_FLAKE(FM%F%CFLK_ALB,FM%F%XTS,PZENITH2,FM%F%XH_ICE,FM%F%XH_SNOW,FM%F%XICE_ALB,FM%F%XSNOW_ALB, &
- FM%F%XDIR_ALB,FM%F%XSCA_ALB,FM%F%XEMIS,PDIR_ALB,PSCA_ALB,PEMIS,PTSRAD )
+ CALL UPDATE_RAD_FLAKE(F,PZENITH2,PDIR_ALB,PSCA_ALB,PEMIS,PTSRAD )
!
IF (LHOOK) CALL DR_HOOK('COUPLING_FLAKE_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/coupling_icefluxn.F90 b/src/SURFEX/coupling_icefluxn.F90
index 68289dc38787f4d0af130d29206c7c7b38582b3c..6f879aac9a32686ab5ed4c703f87759270180f4b 100644
--- a/src/SURFEX/coupling_icefluxn.F90
+++ b/src/SURFEX/coupling_icefluxn.F90
@@ -125,7 +125,7 @@ ENDIF
!=======================================================================================
!
IF (LHOOK) CALL DR_HOOK('COUPLING_ICEFLUX_N',1,ZHOOK_HANDLE)
- CONTAINS
+CONTAINS
!
!=======================================================================================
SUBROUTINE TREAT_ICE(KSIZE,KMASK)
diff --git a/src/SURFEX/coupling_ideal_flux.F90 b/src/SURFEX/coupling_ideal_flux.F90
index 9b540df3aa9234f3ffefc7f7507b9a99ebdbf52d..63f851cdc0584da0d4d5e5c84fb92f9415166d5f 100644
--- a/src/SURFEX/coupling_ideal_flux.F90
+++ b/src/SURFEX/coupling_ideal_flux.F90
@@ -3,16 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ############################################################
-SUBROUTINE COUPLING_IDEAL_FLUX (DGL, &
- HPROGRAM, HCOUPLING, PTIMEC, &
+SUBROUTINE COUPLING_IDEAL_FLUX (DGO, D, DC, HPROGRAM, HCOUPLING, PTIMEC, &
PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PAZIM, &
PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+ PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST )
! ############################################################
!
!!**** *COUPLING_IDEAL_FLUX * - Computes the surface fluxes for the temperature,
@@ -56,7 +54,7 @@ SUBROUTINE COUPLING_IDEAL_FLUX (DGL, &
! ------------
!
!
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
!
USE MODD_CSTS, ONLY : XRD, XCPD, XP00, XPI, XLVTT, XDAY, XKARMAN, XTT, &
XLSTT, XSTEFAN
@@ -83,7 +81,9 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
+TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling
@@ -344,24 +344,23 @@ END WHERE
!
ZLWUP(:)=(1.-PEMIS(:))*PLW(:)+PEMIS(:)*XSTEFAN*PTSURF(:)**4
!
- CALL SURFACE_RI(PTSURF,PQSURF,ZEXNS,ZEXNA,PTA,PQA, &
- PZREF, PUREF, ZDIRCOSZW,ZWIND,ZRI)
+ CALL SURFACE_RI(PTSURF,PQSURF,ZEXNS,ZEXNA,PTA,PQA,PZREF, PUREF, ZDIRCOSZW,ZWIND,ZRI)
CALL SURFACE_AERO_COND(ZRI, PZREF, PUREF, ZWIND, PZ0, PZ0H, ZAC, ZRA, ZCH)
CALL SURFACE_CD(ZRI, PZREF, PUREF, PZ0, PZ0H, ZCD, ZCDN)
- CALL DIAG_INLINE_IDEAL_n(DGL, PTSTEP, PTA, PTSURF, ZQA, PPA, PPS, PRHOA, PU, &
- PV, PZREF, PUREF, PRAIN, PSNOW, &
- ZCD, ZCDN, ZCH, ZRI, ZHU, PZ0, &
- PZ0H, PQSURF, PSFTH, PSFTQ, PSFU, PSFV, &
- PDIR_SW, PSCA_SW, PLW, PDIR_ALB, PSCA_ALB, &
- ZLE, ZLEI, ZSUBL, ZLWUP )
+ CALL DIAG_INLINE_IDEAL_n(DGO, D, DC, PTSTEP, PTA, PTSURF, &
+ ZQA, PPA, PPS, PRHOA, PU, PV, PZREF, PUREF, &
+ PRAIN, PSNOW, ZCD, ZCDN, ZCH, ZRI, ZHU, PZ0, &
+ PZ0H, PQSURF, PSFTH, PSFTQ, PSFU, PSFV, &
+ PDIR_SW, PSCA_SW, PLW, PDIR_ALB, PSCA_ALB, &
+ ZLE, ZLEI, ZSUBL, ZLWUP )
!
IF (LHOOK) CALL DR_HOOK('COUPLING_IDEAL_FLUX',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!
SUBROUTINE TEMP_FORC_DISTS (PTIMEIN,PSTEP,KFORC,PTIMES,KHOUR,PALPHA)
!
diff --git a/src/SURFEX/coupling_inland_watern.F90 b/src/SURFEX/coupling_inland_watern.F90
index 07964ee9cf7d61542789037f95092ea3a601fc64..07302bbfef3679c47dc0aadce79f4d435debe4d2 100644
--- a/src/SURFEX/coupling_inland_watern.F90
+++ b/src/SURFEX/coupling_inland_watern.F90
@@ -3,16 +3,15 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################################
-SUBROUTINE COUPLING_INLAND_WATER_n (FM, WM, DGL, U, DST, SLT, &
- HPROGRAM, HCOUPLING, PTIMEC, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, &
- PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+SUBROUTINE COUPLING_INLAND_WATER_n (FM, WM, DGO, DL, DLC, U, DST, SLT, &
+ HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, &
+ PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, &
+ PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, &
+ HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, &
+ PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, &
+ PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
+ PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, &
+ PPET_B_COEF, PPEQ_B_COEF, HTEST )
! ###############################################################################
!
!!**** *COUPLING_INLAND_WATER_n * - Chooses the surface schemes for lakes
@@ -41,7 +40,7 @@ SUBROUTINE COUPLING_INLAND_WATER_n (FM, WM, DGL, U, DST, SLT, &
USE MODD_SURFEX_n, ONLY : WATFLUX_MODEL_t
USE MODD_SURFEX_n, ONLY : FLAKE_MODEL_t
!
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_DST_n, ONLY : DST_t
USE MODD_SLT_n, ONLY : SLT_t
@@ -67,7 +66,9 @@ IMPLICIT NONE
!
TYPE(FLAKE_MODEL_t), INTENT(INOUT) :: FM
TYPE(WATFLUX_MODEL_t), INTENT(INOUT) :: WM
-TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: DL
+TYPE(DIAG_t), INTENT(INOUT) :: DLC
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(DST_t), INTENT(INOUT) :: DST
TYPE(SLT_t), INTENT(INOUT) :: SLT
@@ -149,44 +150,33 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('COUPLING_INLAND_WATER_N',0,ZHOOK_HANDLE)
IF (U%CWATER=='WATFLX') THEN
- CALL COUPLING_WATFLUX_OROG_n(WM, DST, SLT, &
- HPROGRAM, HCOUPLING, PTIMEC, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- KI, KSV, KSW, &
- PTSUN, PZENITH, PZENITH2, PAZIM, &
- PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+ CALL COUPLING_WATFLUX_OROG_n(WM, DST, SLT, HPROGRAM, HCOUPLING, PTIMEC, &
+ PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, &
+ PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PZS, PU, PV, &
+ PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, &
+ PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, &
+ PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, &
+ PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, &
+ PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST )
ELSE IF (U%CWATER=='FLUX ') THEN
- CALL COUPLING_IDEAL_FLUX(DGL, &
- HPROGRAM, HCOUPLING, PTIMEC, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- KI, KSV, KSW, &
- PTSUN, PZENITH, PAZIM, &
- PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+ CALL COUPLING_IDEAL_FLUX(DGO, DL, DLC, HPROGRAM, HCOUPLING, PTIMEC, &
+ PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, &
+ PTSUN, PZENITH, PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, &
+ PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, &
+ PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
+ PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
+ PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
+ PPEQ_B_COEF, HTEST )
ELSE IF (U%CWATER=='FLAKE ') THEN
- CALL COUPLING_FLAKE_OROGRAPHY_n(FM, DST, SLT, &
- HPROGRAM, HCOUPLING, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- KI, KSV, KSW, &
- PTSUN, PZENITH, PZENITH2, PAZIM, &
- PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+ CALL COUPLING_FLAKE_OROGRAPHY_n(FM, DST, SLT, HPROGRAM, HCOUPLING, &
+ PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, &
+ PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PZS, &
+ PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, &
+ PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, &
+ PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, &
+ PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, &
+ PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
+ PPEQ_B_COEF, HTEST )
ELSE IF (U%CWATER=='NONE ') THEN
PSFTH = 0.
PSFTQ = 0.
diff --git a/src/SURFEX/coupling_isba_canopyn.F90 b/src/SURFEX/coupling_isba_canopyn.F90
index c3ace3a48ebaf5ee29654e7e75f38d11e92254d2..a483689c82847b2d127fe1fa1a5a2dca9c066a43 100644
--- a/src/SURFEX/coupling_isba_canopyn.F90
+++ b/src/SURFEX/coupling_isba_canopyn.F90
@@ -3,16 +3,17 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################################
-SUBROUTINE COUPLING_ISBA_CANOPY_n (DTCO, UG, U, USS, IM, DTGD, DTGR, TGRO, DST, SLT, &
- HPROGRAM, HCOUPLING, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, &
- PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+SUBROUTINE COUPLING_ISBA_CANOPY_n (DTCO, UG, U, USS, SB, NAG, CHI, NCHI, DTV, ID, NGB, GB, &
+ ISS, NISS, IG, NIG, IO, S, K, NK, NP, NPE, NDST, SLT, &
+ HPROGRAM, HCOUPLING, PTSTEP, &
+ KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, &
+ PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PZS, PU, PV, &
+ PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, &
+ PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, &
+ PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, &
+ PEMIS, PTSURF, PZ0,PZ0H, PQSURF, PPEW_A_COEF, &
+ PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
+ PPEQ_B_COEF, HTEST )
! ###############################################################################
!
!!**** *COUPLING_ISBA_CANOPY_n * - Adds a SBL into ISBA
@@ -40,17 +41,25 @@ SUBROUTINE COUPLING_ISBA_CANOPY_n (DTCO, UG, U, USS, IM, DTGD, DTGR, TGRO, DST,
!! B. Decharme 04/2013 new coupling variables
!----------------------------------------------------------------
!
-!
-USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t
+USE MODD_AGRI_n, ONLY : AGRI_NP_t
+USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t, CH_ISBA_NP_t
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_SURFEX_n, ONLY : ISBA_DIAG_t
+USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t, GR_BIOG_NP_t
+USE MODD_SSO_n, ONLY : SSO_t, SSO_NP_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t, GRID_NP_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_P_t, ISBA_PE_t, ISBA_NK_t, ISBA_NP_t, ISBA_NPE_t
+!
+USE MODD_DST_n, ONLY : DST_NP_t
+
+USE MODD_CANOPY_n, ONLY : CANOPY_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_DATA_TEB_GARDEN_n, ONLY : DATA_TEB_GARDEN_t
-USE MODD_DATA_TEB_GREENROOF_n, ONLY : DATA_TEB_GREENROOF_t
-USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
-USE MODD_DST_n, ONLY : DST_t
+USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
USE MODD_SLT_n, ONLY : SLT_t
!
!
@@ -77,16 +86,32 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(AGRI_NP_t), INTENT(INOUT) :: NAG
+TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
+TYPE(CH_ISBA_NP_t), INTENT(INOUT) :: NCHI
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+TYPE(ISBA_DIAG_t), INTENT(INOUT) :: ID
+TYPE(GR_BIOG_NP_t), INTENT(INOUT) :: NGB
+TYPE(GR_BIOG_t), INTENT(INOUT) :: GB
+TYPE(SSO_t), INTENT(INOUT) :: ISS
+TYPE(SSO_NP_t), INTENT(INOUT) :: NISS
+TYPE(GRID_t), INTENT(INOUT) :: IG
+TYPE(GRID_NP_t), INTENT(INOUT) :: NIG
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_NK_t), INTENT(INOUT) :: NK
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) ::NPE
+!
+TYPE(DST_NP_t), INTENT(INOUT) :: NDST
+!
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
!
-TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(DATA_TEB_GARDEN_t), INTENT(INOUT) :: DTGD
-TYPE(DATA_TEB_GREENROOF_t), INTENT(INOUT) :: DTGR
-TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: TGRO
-TYPE(DST_t), INTENT(INOUT) :: DST
+TYPE(SSO_t), INTENT(INOUT) :: USS
TYPE(SLT_t), INTENT(INOUT) :: SLT
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
@@ -161,6 +186,9 @@ REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF
!
!* forcing variables
!
+TYPE(ISBA_P_t), POINTER :: PK
+TYPE(ISBA_PE_t), POINTER :: PEK
+!
REAL, DIMENSION(KI) :: ZWIND ! lowest atmospheric level wind speed (m/s)
REAL, DIMENSION(KI) :: ZEXNA ! Exner function at lowest SBL scheme level (-)
REAL, DIMENSION(KI) :: ZTA ! temperature (K)
@@ -180,21 +208,20 @@ REAL, DIMENSION(KI) :: ZCANOPY ! height of canopy (m)
REAL, DIMENSION(KI) :: ZSFLUX_U ! Surface flux u'w' (m2/s2)
REAL, DIMENSION(KI) :: ZSFLUX_T ! Surface flux w'T' (mK/s)
REAL, DIMENSION(KI) :: ZSFLUX_Q ! Surface flux w'q' (kgm2/s)
-REAL, DIMENSION(KI,IM%ICP%NLVL) :: ZFORC_U ! tendency due to drag force for wind
-REAL, DIMENSION(KI,IM%ICP%NLVL) :: ZDFORC_UDU! formal derivative of
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_U ! tendency due to drag force for wind
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_UDU! formal derivative of
! ! tendency due to drag force for wind
-REAL, DIMENSION(KI,IM%ICP%NLVL) :: ZFORC_E ! tendency due to drag force for TKE
-REAL, DIMENSION(KI,IM%ICP%NLVL) :: ZDFORC_EDE! formal derivative of
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_E ! tendency due to drag force for TKE
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_EDE! formal derivative of
! ! tendency due to drag force for TKE
-REAL, DIMENSION(KI,IM%ICP%NLVL) :: ZFORC_T ! tendency due to drag force for Temp
-REAL, DIMENSION(KI,IM%ICP%NLVL) :: ZDFORC_TDT! formal derivative of
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_T ! tendency due to drag force for Temp
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_TDT! formal derivative of
! ! tendency due to drag force for Temp
-REAL, DIMENSION(KI,IM%ICP%NLVL) :: ZFORC_Q ! tendency due to drag force for Temp
-REAL, DIMENSION(KI,IM%ICP%NLVL) :: ZDFORC_QDQ! formal derivative of
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_Q ! tendency due to drag force for Temp
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_QDQ! formal derivative of
! ! tendency due to drag force for hum.
-REAL, DIMENSION(KI,IM%ICP%NLVL) :: ZLMO ! MO length
-REAL, DIMENSION(KI,IM%ICP%NLVL) :: ZLM ! mixing length
-REAL, DIMENSION(KI,IM%ICP%NLVL) :: ZLEPS ! dissipative length
+REAL, DIMENSION(KI,SB%NLVL) :: ZLM ! mixing length
+REAL, DIMENSION(KI,SB%NLVL) :: ZLEPS ! dissipative length
REAL, DIMENSION(KI) :: ZH ! canopy height (m)
REAL, DIMENSION(KI) :: ZUSTAR ! friction velocity including drag effect (m/s)
REAL, DIMENSION(KI) :: ZUSTAR_GROUND! friction velocity at ground only (ISBA) (m/s)
@@ -217,9 +244,7 @@ REAL, DIMENSION(KI) ::ZCANOPY_DENSITY
REAL, DIMENSION(KI) ::ZUW_GROUND
REAL, DIMENSION(KI) ::ZDUWDU_GROUND
!
-REAL, DIMENSION(KI,IM%ICP%NLVL) :: ZZ ! height above displacement height
-!
-INTEGER :: JJ
+INTEGER :: JJ, JLAYER, IMASK, JP, JI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
@@ -229,7 +254,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('COUPLING_ISBA_CANOPY_N',0,ZHOOK_HANDLE)
-IF (IM%I%LCANOPY) THEN
+!
+IF (IO%LCANOPY) THEN
!
!* 1.1 Updates canopy vertical grid as a function of forcing height
! ------------------------------------------------------------
@@ -237,7 +263,7 @@ IF (IM%I%LCANOPY) THEN
!* determines where is the forcing level and modifies the upper levels of the canopy grid
!
ZCANOPY = 0.
- CALL CANOPY_GRID_UPDATE(KI,IM%ICP%NLVL,ZCANOPY,PUREF,IM%ICP%XZ,IM%ICP%XZF,IM%ICP%XDZ,IM%ICP%XDZF)
+ CALL CANOPY_GRID_UPDATE(KI,ZCANOPY,PUREF,SB)
!
!
!
@@ -247,104 +273,84 @@ IF (IM%I%LCANOPY) THEN
!
! 1.2.1 First time step canopy initialisation
!
- IF(ANY(IM%ICP%XT(:,:) == XUNDEF)) THEN
- CALL INIT_ISBA_SBL(IM%I%CISBA, IM%I%CCPSURF, IM%ICP%NLVL, PTSTEP, PPA, PPS, PTA, PQA, PRHOA, PU, PV, &
- PDIR_SW, PSCA_SW, PSW_BANDS, PRAIN, PSNOW, &
- PZREF, PUREF, IM%I%XTG(:,1,:), IM%I%XPATCH, IM%I%XWG(:,1,:), IM%I%XWGI(:,1,:), &
- IM%I%XZ0, IM%I%XSSO_SLOPE, IM%I%XRESA, IM%I%XVEG, IM%I%XLAI, &
- IM%I%XWR, IM%I%XRGL, IM%I%XRSMIN, IM%I%XGAMMA, IM%I%XWRMAX_CF, IM%I%XZ0_O_Z0H, &
- IM%I%XWFC, IM%I%XWSAT, IM%I%TSNOW, IM%ICP%XZ, &
- IM%ICP%XT, IM%ICP%XQ, IM%ICP%XU, IM%ICP%XTKE, IM%ICP%XP)
+ IF(ANY(SB%XT(:,:) == XUNDEF)) THEN
+ CALL INIT_ISBA_SBL(IO, K, NP, NPE, SB, &
+ PTSTEP, PPA, PPS, PTA, PQA, PRHOA, PU, PV, PDIR_SW, &
+ PSCA_SW, PSW_BANDS, PRAIN, PSNOW, PZREF, PUREF, ISS%XSSO_SLOPE )
ENDIF
!
!* 1.3 Allocations
! -----------
!
- CALL INIT_FORC( ZFORC_U, ZDFORC_UDU, ZFORC_E, ZDFORC_EDE, &
- ZFORC_T, ZDFORC_TDT, ZFORC_Q, ZDFORC_QDQ )
+ CALL INIT_FORC(ZFORC_U, ZDFORC_UDU, ZFORC_E, ZDFORC_EDE, ZFORC_T, ZDFORC_TDT, ZFORC_Q, ZDFORC_QDQ )
!
ZSFLUX_U = 0.
ZSFLUX_T = 0.
ZSFLUX_Q = 0.
-!
- ZLMO = SPREAD(IM%ICP%XLMO,2,IM%ICP%NLVL)
!
!* default :
!* no canopy in ISBA scheme
!
ZH = 0.
+ ZCANOPY_DENSITY(:) = 0.
!
!
-!* determine for each level the height above displacement height
-!
- ZZ(:,:) = IM%ICP%XZ(:,:)
!
!* 1.4 canopy for wind drag only
! -------------------------
!
- IF (IM%I%LCANOPY_DRAG) THEN
+ IF (IO%LCANOPY_DRAG) THEN
!* mean canopy height
!
!* in ecoclimap, height is set retrieved from roughness length (z0/0.13)
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+ DO JJ = 1,PK%NSIZE_P
+ IMASK = PK%NR_P(JJ)
+ ZH(IMASK) = ZH(IMASK) + PK%XPATCH(JJ) * PEK%XZ0(JJ) / 0.13
+ ZCANOPY_DENSITY(IMASK) = ZCANOPY_DENSITY(IMASK) + PK%XPATCH(JJ) * PEK%XLAI(JJ)
+ ENDDO
+ ENDDO
+ !
DO JJ=1,KI
- ZH(JJ) = SUM(IM%I%XPATCH(JJ,:)*IM%I%XZ0(JJ,:)/0.13)
- ZH(JJ) = MIN(ZH(JJ), IM%ICP%XZF(JJ,IM%ICP%NLVL))
- IF (ZH(JJ)<=IM%ICP%XDZ(JJ,1)) ZH(JJ) = 0.
+ ZH(JJ) = MIN(ZH(JJ), SB%XZF(JJ,SB%NLVL))
+ IF (ZH(JJ)<=SB%XDZ(JJ,1)) ZH(JJ) = 0.
!
!* canopy for wind drag only
- ZCANOPY_DENSITY(JJ) = SUM(IM%I%XPATCH(JJ,:)*IM%I%XLAI(JJ,:))
ZUW_GROUND(JJ) = 0.
ZDUWDU_GROUND(JJ) = 0.
!
ENDDO
!
!* computes tendencies on wind and Tke due to canopy
- CALL ISBA_CANOPY(IM%I, &
- KI,IM%ICP%NLVL,IM%ICP%XZ,IM%ICP%XZF,IM%ICP%XDZ,IM%ICP%XDZF,&
- ZH,ZCANOPY_DENSITY,IM%ICP%XU,IM%ICP%XTKE, &
- ZUW_GROUND, ZDUWDU_GROUND, &
- ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE )
+ CALL ISBA_CANOPY(IO%XCDRAG, KI, SB, ZH,ZCANOPY_DENSITY, ZUW_GROUND, &
+ ZDUWDU_GROUND, ZFORC_U, ZDFORC_UDU, ZFORC_E, ZDFORC_EDE )
!
ENDIF
!
-!* 1.4 Subgrid-scale orographic drag (Beljaars et al 2004)
-! -----------------------------
-!
- IF (IM%I%CROUGH=='BE04') THEN
-!
-!* computes tendencies on wind and Tke due to subgridscale orography
- CALL SSO_BELJAARS04(USS, &
- KI,IM%ICP%NLVL,IM%ICP%XZ,IM%I%XSSO_STDEV,IM%ICP%XU,ZFORC_U,ZDFORC_UDU )
-!
- ENDIF
-!
-!
!* 1.5 Computes coefficients for implicitation
! ---------------------------------------
!
ZWIND = SQRT(PU**2+PV**2)
- CALL CANOPY_EVOL(KI,IM%ICP%NLVL,PTSTEP,1,ZZ,ZWIND,PTA,PQA,PPA,PRHOA, &
- ZSFLUX_U,ZSFLUX_T,ZSFLUX_Q, &
- ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE, &
- ZFORC_T,ZDFORC_TDT,ZFORC_Q,ZDFORC_QDQ, &
- IM%ICP%XZ,IM%ICP%XZF,IM%ICP%XDZ,IM%ICP%XDZF,IM%ICP%XU,&
- IM%ICP%XTKE,IM%ICP%XT,IM%ICP%XQ,ZLMO,ZLM,ZLEPS,IM%ICP%XP,ZUSTAR, &
- ZALFAU,ZBETAU,ZALFATH,ZBETATH,ZALFAQ,ZBETAQ )
+ CALL CANOPY_EVOL(SB, KI, PTSTEP, 1, SB%XZ, ZWIND, PTA, PQA, PPA, PRHOA, &
+ ZSFLUX_U, ZSFLUX_T, ZSFLUX_Q, ZFORC_U, ZDFORC_UDU, &
+ ZFORC_E, ZDFORC_EDE, ZFORC_T, ZDFORC_TDT, ZFORC_Q, &
+ ZDFORC_QDQ, ZLM, ZLEPS, ZUSTAR, ZALFAU, ZBETAU, ZALFATH, &
+ ZBETATH, ZALFAQ, ZBETAQ )
!
!* 1.6 Goes from atmospheric forcing to canopy forcing height
! ------------------------------------------------------
!
GCOUPLING ='I'
!
- CALL INIT_COUPLING_CANOPY( IM%ICP%XP(:,1), PPA, IM%ICP%XT(:,1), IM%ICP%XQ(:,1), &
- PU, PV, IM%ICP%XZ(:,1), IM%ICP%XU(:,1), &
- PRHOA, ZALFAU, ZBETAU, ZALFATH, &
- ZBETATH, ZALFAQ, ZBETAQ, &
- ZPA, ZTA, ZQA, ZU, ZV, &
- ZUREF, ZZREF, ZEXNA, &
- ZPEW_A_COEF, ZPEW_B_COEF, &
- ZPET_A_COEF, ZPET_B_COEF, &
- ZPEQ_A_COEF, ZPEQ_B_COEF )
+ CALL INIT_COUPLING_CANOPY(SB, PPA, PU, PV, PRHOA, ZALFAU, &
+ ZBETAU, ZALFATH, ZBETATH, ZALFAQ,&
+ ZBETAQ, ZPA, ZTA, ZQA, ZU, ZV, &
+ ZUREF, ZZREF, ZEXNA, ZPEW_A_COEF,&
+ ZPEW_B_COEF, ZPET_A_COEF, &
+ ZPET_B_COEF, ZPEQ_A_COEF, &
+ ZPEQ_B_COEF )
!
!-------------------------------------------------------------------------------------
ELSE
@@ -355,17 +361,16 @@ ELSE
!
GCOUPLING = HCOUPLING
!
- CALL INIT_COUPLING( HCOUPLING, &
- PPS, PPA, PTA, PQA, PU, PV, &
- PUREF, PZREF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPET_B_COEF, &
- PPEQ_A_COEF, PPEQ_B_COEF, &
- ZPA, ZTA, ZQA, ZU, ZV, &
- ZUREF, ZZREF, &
- ZPEW_A_COEF, ZPEW_B_COEF, &
- ZPET_A_COEF, ZPET_B_COEF, &
- ZPEQ_A_COEF, ZPEQ_B_COEF )
+ CALL INIT_COUPLING(HCOUPLING, PPS, PPA, PTA, PQA, &
+ PU, PV, PUREF, PZREF, &
+ PPEW_A_COEF, PPEW_B_COEF, &
+ PPET_A_COEF, PPET_B_COEF, &
+ PPEQ_A_COEF, PPEQ_B_COEF, &
+ ZPA, ZTA, ZQA, ZU, ZV, ZUREF, &
+ ZZREF, ZPEW_A_COEF, &
+ ZPEW_B_COEF, ZPET_A_COEF, &
+ ZPET_B_COEF, ZPEQ_A_COEF, &
+ ZPEQ_B_COEF )
!
END IF
!
@@ -374,34 +379,31 @@ END IF
!* 2. Call of ISBA
! ------------
!
- CALL COUPLING_ISBA_n(DTCO, UG, U, USS, IM, DTGD, DTGR, TGRO, DST, SLT, &
- HPROGRAM, GCOUPLING, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- KI, KSV, KSW, &
- PTSUN, PZENITH, PZENITH2, &
- ZZREF, ZUREF, PZS, ZU, ZV, ZQA, ZTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, ZPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- ZPEW_A_COEF, ZPEW_B_COEF, &
- ZPET_A_COEF, ZPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF, &
- 'OK' )
+ CALL COUPLING_ISBA_n(DTCO, UG, U, USS, NAG, CHI, NCHI, DTV, ID, NGB, GB, ISS,NISS, IG, &
+ NIG, IO, S, K, NK, NP, NPE, NDST, SLT, HPROGRAM, GCOUPLING, &
+ PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, &
+ PZENITH2, ZZREF, ZUREF, PZS, ZU, ZV, ZQA, ZTA, PRHOA, PSV, PCO2, &
+ HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, ZPA, &
+ PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, &
+ PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, ZPEW_A_COEF, &
+ ZPEW_B_COEF, ZPET_A_COEF, ZPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF, &
+ 'OK' )
!
!-------------------------------------------------------------------------------------
!
!* 3. End if no canopy is used
! ------------------------
!
-IF (.NOT. IM%I%LCANOPY .AND. LHOOK) CALL DR_HOOK('COUPLING_ISBA_CANOPY_N',1,ZHOOK_HANDLE)
-IF (.NOT. IM%I%LCANOPY) RETURN
+IF (.NOT. IO%LCANOPY .AND. LHOOK) CALL DR_HOOK('COUPLING_ISBA_CANOPY_N',1,ZHOOK_HANDLE)
+IF (.NOT. IO%LCANOPY) RETURN
!
!-------------------------------------------------------------------------------------
!
!* 4. Computes the impact of surface on air
! -------------------------------------
!
- CALL INIT_FORC( ZFORC_U, ZDFORC_UDU, ZFORC_E, ZDFORC_EDE, &
- ZFORC_T, ZDFORC_TDT, ZFORC_Q, ZDFORC_QDQ )
+ CALL INIT_FORC(ZFORC_U, ZDFORC_UDU, ZFORC_E, ZDFORC_EDE, &
+ ZFORC_T, ZDFORC_TDT, ZFORC_Q, ZDFORC_QDQ )
!
ZSFLUX_U = - SQRT(PSFU(:)**2+PSFV(:)**2) / PRHOA(:)
ZSFLUX_T(:) = PSFTH(:) / XCPD * ZEXNA(:) / PRHOA(:)
@@ -412,54 +414,42 @@ ZSFLUX_Q(:) = PSFTQ(:)
!* 5. Computes the impact of canopy on air
! ------------------------------------
!
-IF (IM%I%LCANOPY_DRAG) THEN
+IF (IO%LCANOPY_DRAG) THEN
!
DO JJ=1,KI
- ZUW_GROUND(JJ) = -SQRT(PSFU(JJ)**2+PSFV(JJ)**2)/ PRHOA(JJ)
+ ZUW_GROUND (JJ) = -SQRT(PSFU(JJ)**2+PSFV(JJ)**2)/ PRHOA(JJ)
ZDUWDU_GROUND(JJ) = 0.
- IF (IM%ICP%XU(JJ,1) /=0.) ZDUWDU_GROUND(JJ) = 2. * ZUW_GROUND(JJ) / IM%ICP%XU(JJ,1)
+ IF (SB%XU(JJ,1)/=0.) ZDUWDU_GROUND(JJ) = 2. * ZUW_GROUND(JJ) / SB%XU(JJ,1)
ENDDO
!* computes tendencies on wind and Tke due to canopy and surface
- CALL ISBA_CANOPY(IM%I, &
- KI,IM%ICP%NLVL,IM%ICP%XZ,IM%ICP%XZF,IM%ICP%XDZ,IM%ICP%XDZF,&
- ZH,ZCANOPY_DENSITY,IM%ICP%XU,IM%ICP%XTKE, &
- ZUW_GROUND, ZDUWDU_GROUND, &
- ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE )
+ CALL ISBA_CANOPY(IO%XCDRAG, KI, SB, ZH, ZCANOPY_DENSITY, ZUW_GROUND, &
+ ZDUWDU_GROUND, ZFORC_U, ZDFORC_UDU, ZFORC_E, ZDFORC_EDE )
ZSFLUX_U = 0. ! surface friction is incorporated in ZFORC_U by ISBA_CANOPY routine
!
END IF
!
-!
-IF (IM%I%CROUGH=='BE04') THEN
-!
-!* computes tendencies on wind and Tke due to subgridscale orography
- CALL SSO_BELJAARS04(USS, &
- KI,IM%ICP%NLVL,IM%ICP%XZ,IM%I%XSSO_STDEV,IM%ICP%XU,ZFORC_U,ZDFORC_UDU )
-!
-ENDIF
-!
!-------------------------------------------------------------------------------------
!
!* 6. Evolution of canopy air due to these impacts
! --------------------------------------------
!
ZWIND = SQRT(PU**2+PV**2)
- CALL CANOPY_EVOL(KI,IM%ICP%NLVL,PTSTEP,2,ZZ,ZWIND,PTA,PQA,PPA,PRHOA, &
- ZSFLUX_U,ZSFLUX_T,ZSFLUX_Q, &
- ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE, &
- ZFORC_T,ZDFORC_TDT,ZFORC_Q,ZDFORC_QDQ, &
- IM%ICP%XZ,IM%ICP%XZF,IM%ICP%XDZ,IM%ICP%XDZF,IM%ICP%XU,IM%ICP%XTKE,&
- IM%ICP%XT,IM%ICP%XQ,ZLMO,ZLM,ZLEPS,IM%ICP%XP,ZUSTAR, &
- ZALFAU,ZBETAU,ZALFATH,ZBETATH,ZALFAQ,ZBETAQ )
+ CALL CANOPY_EVOL(SB, KI, PTSTEP, 2, SB%XZ, ZWIND, PTA, PQA, PPA, PRHOA, &
+ ZSFLUX_U, ZSFLUX_T, ZSFLUX_Q, ZFORC_U, ZDFORC_UDU,ZFORC_E,&
+ ZDFORC_EDE, ZFORC_T, ZDFORC_TDT, ZFORC_Q, ZDFORC_QDQ, ZLM,&
+ ZLEPS, ZUSTAR, ZALFAU, ZBETAU, ZALFATH, ZBETATH, ZALFAQ, &
+ ZBETAQ )
!
-IM%ICP%XLMO(:) = ZLMO(:,IM%ICP%NLVL)
+DO JLAYER=1,SB%NLVL-1
+ SB%XLMO(:,JLAYER) = SB%XLMO(:,SB%NLVL)
+ENDDO
!
! Momentum fluxes if canopy is used
!
!* Total friction due to surface averaged friction and averaged canopy drag
-IF (IM%I%LCANOPY_DRAG .OR. IM%I%CROUGH=='BE04') THEN
+IF (IO%LCANOPY_DRAG) THEN
DO JJ=1,KI
ZUSTAR_GROUND(JJ) = SQRT(SQRT(PSFU(JJ)**2+PSFV(JJ)**2)/PRHOA(JJ))
IF (ZUSTAR_GROUND(JJ)>0.) THEN
@@ -468,9 +458,9 @@ IF (IM%I%LCANOPY_DRAG .OR. IM%I%CROUGH=='BE04') THEN
ENDIF
ENDDO
!* Total friction due to surface averaged friction and averaged canopy drag
- IF (IM%DGI%LSURF_BUDGET) THEN
- IM%DGI%XAVG_FMU = PSFU
- IM%DGI%XAVG_FMV = PSFV
+ IF (ID%O%LSURF_BUDGET) THEN
+ ID%D%XFMU = PSFU
+ ID%D%XFMV = PSFV
ENDIF
END IF
!
@@ -479,13 +469,7 @@ END IF
!* 7. 2m and 10m diagnostics if canopy is used
! ----------------------------------------
!
-!
-IF (IM%DGI%N2M>=1) CALL INIT_2M_10M( IM%ICP%XP(:,2), IM%ICP%XT(:,2), IM%ICP%XQ(:,2), IM%ICP%XU, IM%ICP%XZ, &
- PU, PV, ZWIND, PRHOA, &
- IM%DGI%XAVG_T2M, IM%DGI%XAVG_Q2M, IM%DGI%XAVG_HU2M, &
- IM%DGI%XAVG_ZON10M, IM%DGI%XAVG_MER10M, &
- IM%DGI%XAVG_WIND10M, IM%DGI%XAVG_WIND10M_MAX, IM%DGI%XAVG_T2M_MIN, &
- IM%DGI%XAVG_T2M_MAX, IM%DGI%XAVG_HU2M_MIN, IM%DGI%XAVG_HU2M_MAX )
+IF (ID%O%N2M>=1) CALL INIT_2M_10M(SB, ID%D, PU, PV, ZWIND, PRHOA )
!
IF (LHOOK) CALL DR_HOOK('COUPLING_ISBA_CANOPY_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/coupling_isba_orographyn.F90 b/src/SURFEX/coupling_isba_orographyn.F90
index 54895adb7b80d4378b2e23f8f635aeb3e93fa4ed..4c17a9c4a46dbee22cb4eb496ef0b87deae16c95 100644
--- a/src/SURFEX/coupling_isba_orographyn.F90
+++ b/src/SURFEX/coupling_isba_orographyn.F90
@@ -3,16 +3,17 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################################
-SUBROUTINE COUPLING_ISBA_OROGRAPHY_n (DTCO, UG, U, USS, IM, DTGD, DTGR, TGRO, DST, SLT, &
- HPROGRAM, HCOUPLING, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, &
- PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+SUBROUTINE COUPLING_ISBA_OROGRAPHY_n (DTCO, UG, U, USS, SB, NAG, CHI, NCHI, DTV, ID, NGB, GB, &
+ ISS, NISS, IG, NIG, IO, S, K, NK, NP, NPE, NDST, SLT, &
+ HPROGRAM, HCOUPLING, PTSTEP, &
+ KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, &
+ PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PZS, PU, PV, &
+ PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, &
+ PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, &
+ PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, &
+ PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, &
+ PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
+ PPEQ_B_COEF, HTEST )
! ###############################################################################
!
!!**** *COUPLING_ISBA_OROGRAPHY_n * - Parameterizes effects of subgrid
@@ -42,17 +43,25 @@ SUBROUTINE COUPLING_ISBA_OROGRAPHY_n (DTCO, UG, U, USS, IM, DTGD, DTGR, TGRO, DS
!! improve forcing vertical shift
!----------------------------------------------------------------
!
+USE MODD_AGRI_n, ONLY : AGRI_NP_t
+USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t, CH_ISBA_NP_t
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_SURFEX_n, ONLY : ISBA_DIAG_t
+USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t, GR_BIOG_NP_t
+USE MODD_SSO_n, ONLY : SSO_t, SSO_NP_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t, GRID_NP_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_NK_t, ISBA_NP_t, ISBA_NPE_t
!
-USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t
+USE MODD_DST_n, ONLY : DST_NP_t
+!
+USE MODD_CANOPY_n, ONLY : CANOPY_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_DATA_TEB_GARDEN_n, ONLY : DATA_TEB_GARDEN_t
-USE MODD_DATA_TEB_GREENROOF_n, ONLY : DATA_TEB_GREENROOF_t
-USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
-USE MODD_DST_n, ONLY : DST_t
+USE MODD_SSO_n, ONLY : SSO_t, SSO_NP_t
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
USE MODD_SLT_n, ONLY : SLT_t
!
USE MODD_SURF_PAR,ONLY : XUNDEF
@@ -70,16 +79,32 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(AGRI_NP_t), INTENT(INOUT) :: NAG
+TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
+TYPE(CH_ISBA_NP_t), INTENT(INOUT) :: NCHI
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+TYPE(ISBA_DIAG_t), INTENT(INOUT) :: ID
+TYPE(GR_BIOG_NP_t), INTENT(INOUT) :: NGB
+TYPE(GR_BIOG_t), INTENT(INOUT) :: GB
+TYPE(SSO_t), INTENT(INOUT) :: ISS
+TYPE(SSO_NP_t), INTENT(INOUT) :: NISS
+TYPE(GRID_t), INTENT(INOUT) :: IG
+TYPE(GRID_NP_t), INTENT(INOUT) :: NIG
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_NK_t), INTENT(INOUT) :: NK
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) ::NPE
+!
+TYPE(DST_NP_t), INTENT(INOUT) :: NDST
+!
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
!
-TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(DATA_TEB_GARDEN_t), INTENT(INOUT) :: DTGD
-TYPE(DATA_TEB_GREENROOF_t), INTENT(INOUT) :: DTGR
-TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: TGRO
-TYPE(DST_t), INTENT(INOUT) :: DST
+TYPE(SSO_t), INTENT(INOUT) :: USS
TYPE(SLT_t), INTENT(INOUT) :: SLT
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
@@ -199,8 +224,8 @@ IF(LVERTSHIFT)THEN
ZRAIN(:) = XUNDEF
ZSNOW(:) = XUNDEF
!
- CALL FORCING_VERT_SHIFT(PZS,IM%I%XZS,PTA,PQA,PPA,PRHOA,PLW,PRAIN,PSNOW,&
- ZTA,ZQA,ZPA,ZRHOA,ZLW,ZRAIN,ZSNOW )
+ CALL FORCING_VERT_SHIFT(PZS, S%XZS, PTA, PQA, PPA, PRHOA, PLW, PRAIN, PSNOW, &
+ ZTA, ZQA, ZPA, ZRHOA, ZLW, ZRAIN, ZSNOW )
!
ZPS(:) = ZPA(:) + (PPS(:) - PPA(:))
!
@@ -255,7 +280,7 @@ ELSE
!
! The subgrid slope comes from the XSSO_SLOPE field.
!
- Z3D_TOT_SURF(:) = SQRT(1.+IM%I%XSSO_SLOPE(:)**2)
+ Z3D_TOT_SURF(:) = SQRT(1.+ISS%XSSO_SLOPE(:)**2)
Z3D_TOT_SURF_INV(:) = 1./Z3D_TOT_SURF(:)
!
! number of spectral shortwave bands
@@ -277,8 +302,8 @@ ELSE
!
! incoming LW radiation per m2 of actual surface
!
- ZLW(:) = ZLW(:) * Z3D_TOT_SURF_INV(:) &
- + XSTEFAN*IM%I%XEMIS_NAT(:)*IM%I%XTSRAD_NAT(:)**4 * (1.-Z3D_TOT_SURF_INV(:))
+ ZLW(:) = ZLW(:) * Z3D_TOT_SURF_INV(:) &
+ + XSTEFAN*S%XEMIS_NAT(:)*S%XTSRAD_NAT(:)**4 * (1.-Z3D_TOT_SURF_INV(:))
!
! liquid precipitation per m2 of actual surface
!
@@ -295,18 +320,16 @@ ENDIF
!* 3. Call of ISBA
! ------------
!
- CALL COUPLING_ISBA_CANOPY_n(DTCO, UG, U, USS, IM, DTGD, DTGR, TGRO, DST, SLT, &
- HPROGRAM, HCOUPLING, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- KI, KSV, KSW, &
- PTSUN, PZENITH, PZENITH2, PAZIM, &
- PZREF, PUREF, PZS, PU, PV, ZQA, ZTA, ZRHOA, PSV, PCO2, HSV, &
- ZRAIN, ZSNOW, ZLW, ZDIR_SW, ZSCA_SW, PSW_BANDS, ZPS, ZPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF, &
- 'OK' )
+ CALL COUPLING_ISBA_CANOPY_n(DTCO, UG, U, USS, SB, NAG, CHI, NCHI, DTV, ID, NGB, GB, &
+ ISS, NISS, IG, NIG, IO, S, K, NK, NP, NPE, NDST, SLT, &
+ HPROGRAM, HCOUPLING, PTSTEP, &
+ KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, &
+ PZENITH2, PAZIM, PZREF, PUREF, PZS, PU, PV, ZQA, ZTA, &
+ ZRHOA, PSV, PCO2, HSV, ZRAIN, ZSNOW, ZLW, ZDIR_SW, &
+ ZSCA_SW, PSW_BANDS, ZPS, ZPA, PSFTQ, PSFTH, PSFTS, PSFCO2,&
+ PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0,&
+ PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, &
+ PPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF, 'OK' )
!
!-------------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/coupling_isba_svatn.F90 b/src/SURFEX/coupling_isba_svatn.F90
index 6b27aaa7e11f55a3c4e92a6e9ede7a7426a000f0..645616d2ef65b53e2005f02db1034df3fa02be70 100644
--- a/src/SURFEX/coupling_isba_svatn.F90
+++ b/src/SURFEX/coupling_isba_svatn.F90
@@ -3,16 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################################
-SUBROUTINE COUPLING_ISBA_SVAT_n (DTCO, UG, U, USS, IM, DTGD, DTGR, TGRO, DST, SLT, &
- HPROGRAM, HCOUPLING, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, &
- PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+SUBROUTINE COUPLING_ISBA_SVAT_n (DTCO, UG, U, USS, IM, NDST, SLT, HPROGRAM, HCOUPLING, PTSTEP, &
+ KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, &
+ PZENITH2, PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, &
+ PSV, PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, &
+ PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV,&
+ PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
+ PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, &
+ PPET_B_COEF, PPEQ_B_COEF, HTEST )
! ###############################################################################
!
!!**** *COUPLING_ISBA_SVAT_n * - Chooses the time method (explicit,
@@ -47,14 +45,10 @@ USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_DATA_TEB_GARDEN_n, ONLY : DATA_TEB_GARDEN_t
-USE MODD_DATA_TEB_GREENROOF_n, ONLY : DATA_TEB_GREENROOF_t
-USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
-USE MODD_DST_n, ONLY : DST_t
+USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_DST_n, ONLY : DST_NP_t
USE MODD_SLT_n, ONLY : SLT_t
!
-!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -66,16 +60,12 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-!
TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(DATA_TEB_GARDEN_t), INTENT(INOUT) :: DTGD
-TYPE(DATA_TEB_GREENROOF_t), INTENT(INOUT) :: DTGR
-TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: TGRO
-TYPE(DST_t), INTENT(INOUT) :: DST
+TYPE(SSO_t), INTENT(INOUT) :: USS
+TYPE(DST_NP_t), INTENT(INOUT) :: NDST
TYPE(SLT_t), INTENT(INOUT) :: SLT
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
@@ -186,14 +176,14 @@ IF (HCOUPLING=='I') THEN
ZTSTEP=PTSTEP
!
!* same timestep as atmospheric timestep as default
-ELSE IF (IM%I%XTSTEP==XUNDEF) THEN
+ELSE IF (IM%O%XTSTEP==XUNDEF) THEN
IT=1
ZT=1.
ZTSTEP=PTSTEP
!
!* case of specified SVAT time-step
ELSE
- IT=MAX(NINT(PTSTEP/IM%I%XTSTEP),1)
+ IT=MAX(NINT(PTSTEP/IM%O%XTSTEP),1)
ZT=FLOAT(IT)
ZTSTEP=PTSTEP/ZT
ENDIF
@@ -240,18 +230,16 @@ ZWORK_Z0H= 0.0 ! work array for mean roughness length for heat
!
DO JT=1,IT
!
- CALL COUPLING_ISBA_OROGRAPHY_n(DTCO, UG, U, USS, IM, DTGD, DTGR, TGRO, DST, SLT, &
- HPROGRAM, HCOUPLING, &
- ZTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- KI, KSV, KSW, &
- PTSUN, PZENITH, PZENITH2, PAZIM, &
- PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- ZSFTQ, ZSFTH, ZSFTS, ZSFCO2, ZSFU, ZSFV, &
- ZTRAD, ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTSURF, ZZ0, ZZ0H, ZQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- 'OK' )
+ CALL COUPLING_ISBA_OROGRAPHY_n(DTCO, UG, U, USS, IM%SB, IM%NAG, IM%CHI, IM%NCHI, IM%DTV, &
+ IM%ID, IM%NGB, IM%GB, IM%ISS, IM%NISS, IM%G, IM%NG, IM%O, &
+ IM%S, IM%K, IM%NK, IM%NP, IM%NPE, NDST, SLT, &
+ HPROGRAM, HCOUPLING, ZTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, &
+ KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PZS, &
+ PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, &
+ PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, ZSFTQ, ZSFTH, ZSFTS, &
+ ZSFCO2, ZSFU, ZSFV, ZTRAD, ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTSURF, &
+ ZZ0, ZZ0H, ZQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, &
+ PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, 'OK' )
!
PSFTQ = PSFTQ + ZSFTQ / ZT
PSFTH = PSFTH + ZSFTH / ZT
diff --git a/src/SURFEX/coupling_isban.F90 b/src/SURFEX/coupling_isban.F90
index b07945e304f5ff6bc9d2e007c8afece5b46461be..f2475b18f7584ccc37497d05cb7fdd472c15ee05 100644
--- a/src/SURFEX/coupling_isban.F90
+++ b/src/SURFEX/coupling_isban.F90
@@ -3,16 +3,15 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################################
-SUBROUTINE COUPLING_ISBA_n (DTCO, UG, U, USS, IM, DTGD, DTGR, TGRO, DST, SLT, &
- HPROGRAM, HCOUPLING, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, &
- PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+SUBROUTINE COUPLING_ISBA_n (DTCO, UG, U, USS, NAG, CHI, NCHI, DTI, ID, NGB, GB, &
+ ISS, NISS, IG, NIG, IO, S, K, NK, NP, NPE, NDST, SLT, &
+ HPROGRAM, HCOUPLING, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
+ KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PZREF, PUREF, PZS, &
+ PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, &
+ PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, &
+ PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, &
+ PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, &
+ PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST )
! ###############################################################################
!
!!**** *COUPLING_ISBA_n * - Driver for ISBA time step
@@ -69,20 +68,23 @@ SUBROUTINE COUPLING_ISBA_n (DTCO, UG, U, USS, IM, DTGD, DTGR, TGRO, DST, SLT,
!! P Samuelsson 10/2014 : MEB
!! P. LeMoigne 12/2014 EBA scheme update
!! R. Seferian 05/2015 : Add coupling fiels to vegetation_evol call
-!! B. Decharme 01/16 : Bug with flood budget
-!! B. Decharme 01/16 : Bug when vegetation veg, z0 and emis are imposed whith interactive vegetation
!!-------------------------------------------------------------------
!
-USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_DATA_TEB_GARDEN_n, ONLY : DATA_TEB_GARDEN_t
-USE MODD_DATA_TEB_GREENROOF_n, ONLY : DATA_TEB_GREENROOF_t
-USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
-USE MODD_DST_n, ONLY : DST_t
+!
+USE MODD_AGRI_n, ONLY : AGRI_NP_t
+USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t, CH_ISBA_NP_t
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_SURFEX_n, ONLY : ISBA_DIAG_t
+USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t, GR_BIOG_NP_t
+USE MODD_SSO_n, ONLY : SSO_t, SSO_NP_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t, GRID_NP_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_P_t, ISBA_PE_t, ISBA_NK_t, ISBA_NP_t, ISBA_NPE_t
+!
+USE MODD_DST_n, ONLY : DST_NP_t
USE MODD_SLT_n, ONLY : SLT_t
!
USE MODD_REPROD_OPER, ONLY : CIMPLICIT_WIND
@@ -101,11 +103,6 @@ USE MODD_SLT_SURF
USE MODE_DSLT_SURF
USE MODE_MEB
!
-!
-!
-
-USE MODD_DATA_COVER_PAR, ONLY : NVT_NO, NVT_ROCK
-!
USE MODD_AGRI, ONLY : LAGRIP
USE MODD_DEEPSOIL, ONLY : LDEEPSOIL
!
@@ -123,14 +120,14 @@ USE MODI_AVERAGE_RAD
USE MODI_AVERAGE_DIAG_ISBA_n
USE MODI_VEGETATION_EVOL
USE MODI_VEGETATION_UPDATE
-USE MODI_ALBEDO_VEG_UPDATE
USE MODI_CARBON_EVOL
USE MODI_SUBSCALE_Z0EFF
USE MODI_SOIL_ALBEDO
USE MODI_ALBEDO
USE MODI_DIAG_INLINE_ISBA_n
-USE MODI_DIAG_EVAP_ISBA_n
+USE MODI_DIAG_EVAP_CUMUL_ISBA_n
USE MODI_DIAG_MISC_ISBA_n
+USE MODI_REPROJ_DIAG_ISBA_n
!
USE MODI_UPDATE_RAD_ISBA_n
USE MODI_DEEPSOIL_UPDATE
@@ -139,15 +136,7 @@ USE MODI_ISBA_FLOOD_PROPERTIES
USE MODI_DIAG_CPL_ESM_ISBA
USE MODI_HYDRO_GLACIER
USE MODI_ISBA_ALBEDO
-USE MODI_CARBON_SPINUP
-USE MODI_PACK_ISBA_PATCH_n
-USE MODI_PACK_ISBA_PATCH_GET_SIZE_n
-USE MODI_PACK_CH_ISBA_PATCH_n
-USE MODI_PACK_DIAG_PATCH_n
-USE MODI_PACK_DIAG_PATCH_GET_SIZE_n
-USE MODI_UNPACK_ISBA_PATCH_n
-USE MODI_UNPACK_CH_ISBA_PATCH_n
-USE MODI_UNPACK_DIAG_PATCH_n
+USE MODI_CARBON_SPINUP
USE MODI_CH_AER_DEP
USE MODI_ABOR1_SFX
USE MODI_AVERAGE_DIAG_EVAP_ISBA_n
@@ -160,6 +149,7 @@ USE MODI_COUPLING_DST_n
USE MODI_COUPLING_SURF_TOPD
USE MODI_ISBA_BUDGET_INIT
USE MODI_ISBA_BUDGET
+USE MODI_UNPACK_DIAG_PATCH_n
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -168,16 +158,30 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-!
-TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(DATA_TEB_GARDEN_t), INTENT(INOUT) :: DTGD
-TYPE(DATA_TEB_GREENROOF_t), INTENT(INOUT) :: DTGR
-TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: TGRO
-TYPE(DST_t), INTENT(INOUT) :: DST
+TYPE(SSO_t), INTENT(INOUT) :: USS
+!
+TYPE(AGRI_NP_t), INTENT(INOUT) :: NAG
+TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
+TYPE(CH_ISBA_NP_t), INTENT(INOUT) :: NCHI
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
+TYPE(ISBA_DIAG_t), INTENT(INOUT) :: ID
+TYPE(GR_BIOG_NP_t), INTENT(INOUT) :: NGB
+TYPE(GR_BIOG_t), INTENT(INOUT) :: GB
+TYPE(SSO_t), INTENT(INOUT) :: ISS
+TYPE(SSO_NP_t), INTENT(INOUT) :: NISS
+TYPE(GRID_t), INTENT(INOUT) :: IG
+TYPE(GRID_NP_t), INTENT(INOUT) :: NIG
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_NK_t), INTENT(INOUT) :: NK
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) ::NPE
+!
+TYPE(DST_NP_t), INTENT(INOUT) :: NDST
TYPE(SLT_t), INTENT(INOUT) :: SLT
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
@@ -252,6 +256,11 @@ REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF
!
!* forcing variables
!
+TYPE(ISBA_K_t), POINTER :: KK
+TYPE(ISBA_P_t), POINTER :: PK
+TYPE(ISBA_PE_t), POINTER :: PEK
+TYPE(SSO_t), POINTER :: ISSK
+!
REAL, DIMENSION(KI) :: ZWIND ! lowest atmospheric level wind speed (m/s)
REAL, DIMENSION(KI) :: ZDIR ! wind direction (rad from N clockwise)
REAL, DIMENSION(KI) :: ZEXNA ! Exner function at lowest atmospheric level (-)
@@ -267,31 +276,31 @@ INTEGER ::ISPINEND
!
! Patch outputs:
!
-REAL, DIMENSION(KI,IM%I%NPATCH) :: ZSFTH_TILE ! surface heat flux (W/m2)
-REAL, DIMENSION(KI,IM%I%NPATCH) :: ZSFTQ_TILE ! surface vapor flux (kg/m2/s)
-REAL, DIMENSION(KI,IM%I%NPATCH) :: ZSFCO2_TILE ! surface CO2 flux positive toward the atmosphere (m/s*kg_CO2/kg_air)
-REAL, DIMENSION(KI,IM%I%NPATCH) :: ZSFU_TILE ! zonal momentum flux
-REAL, DIMENSION(KI,IM%I%NPATCH) :: ZSFV_TILE ! meridian momentum flux
-REAL, DIMENSION(KI,IM%I%NPATCH) :: ZTRAD_TILE ! radiative surface temperature
-REAL, DIMENSION(KI,IM%I%NPATCH) :: ZEMIS_TILE ! emissivity
-REAL, DIMENSION(KI,IM%I%NPATCH) :: ZTSURF_TILE ! surface effective temperature
-REAL, DIMENSION(KI,IM%I%NPATCH) :: ZZ0_TILE ! roughness length for momentum
-REAL, DIMENSION(KI,IM%I%NPATCH) :: ZZ0H_TILE ! roughness length for heat
-REAL, DIMENSION(KI,IM%I%NPATCH) :: ZQSURF_TILE ! specific humidity at surface
-REAL, DIMENSION(KI,KSW,IM%I%NPATCH) :: ZDIR_ALB_TILE ! direct albedo
-REAL, DIMENSION(KI,KSW,IM%I%NPATCH) :: ZSCA_ALB_TILE ! diffuse albedo
-REAL, DIMENSION(KI,KSV,IM%I%NPATCH) :: ZSFTS_TILE ! scalar surface flux
-!
-REAL, DIMENSION(KI, IM%I%NPATCH) :: ZCPL_DRAIN ! For the coupling with TRIP
-REAL, DIMENSION(KI, IM%I%NPATCH) :: ZCPL_RUNOFF ! For the coupling with TRIP
-REAL, DIMENSION(KI, IM%I%NPATCH) :: ZCPL_EFLOOD ! For the coupling with TRIP
-REAL, DIMENSION(KI, IM%I%NPATCH) :: ZCPL_PFLOOD ! For the coupling with TRIP
-REAL, DIMENSION(KI, IM%I%NPATCH) :: ZCPL_IFLOOD ! For the coupling with TRIP
-REAL, DIMENSION(KI, IM%I%NPATCH) :: ZCPL_ICEFLUX
+REAL, DIMENSION(KI,IO%NPATCH) :: ZSFTH_TILE ! surface heat flux (W/m2)
+REAL, DIMENSION(KI,IO%NPATCH) :: ZSFTQ_TILE ! surface vapor flux (kg/m2/s)
+REAL, DIMENSION(KI,IO%NPATCH) :: ZSFCO2_TILE ! surface CO2 flux positive toward the atmosphere (m/s*kg_CO2/kg_air)
+REAL, DIMENSION(KI,IO%NPATCH) :: ZSFU_TILE ! zonal momentum flux
+REAL, DIMENSION(KI,IO%NPATCH) :: ZSFV_TILE ! meridian momentum flux
+REAL, DIMENSION(KI,IO%NPATCH) :: ZTRAD_TILE ! radiative surface temperature
+REAL, DIMENSION(KI,IO%NPATCH) :: ZEMIS_TILE ! emissivity
+REAL, DIMENSION(KI,IO%NPATCH) :: ZTSURF_TILE ! surface effective temperature
+REAL, DIMENSION(KI,IO%NPATCH) :: ZZ0_TILE ! roughness length for momentum
+REAL, DIMENSION(KI,IO%NPATCH) :: ZZ0H_TILE ! roughness length for heat
+REAL, DIMENSION(KI,IO%NPATCH) :: ZQSURF_TILE ! specific humidity at surface
+REAL, DIMENSION(KI,KSW,IO%NPATCH) :: ZDIR_ALB_TILE ! direct albedo
+REAL, DIMENSION(KI,KSW,IO%NPATCH) :: ZSCA_ALB_TILE ! diffuse albedo
+REAL, DIMENSION(KI,KSV,IO%NPATCH) :: ZSFTS_TILE ! scalar surface flux
+!
+REAL, DIMENSION(KI, IO%NPATCH) :: ZCPL_DRAIN ! For the coupling with TRIP
+REAL, DIMENSION(KI, IO%NPATCH) :: ZCPL_RUNOFF ! For the coupling with TRIP
+REAL, DIMENSION(KI, IO%NPATCH) :: ZCPL_EFLOOD ! For the coupling with TRIP
+REAL, DIMENSION(KI, IO%NPATCH) :: ZCPL_PFLOOD ! For the coupling with TRIP
+REAL, DIMENSION(KI, IO%NPATCH) :: ZCPL_IFLOOD ! For the coupling with TRIP
+REAL, DIMENSION(KI, IO%NPATCH) :: ZCPL_ICEFLUX
!
! for chemical computations
!
-REAL, DIMENSION(KI, IM%I%NPATCH) :: ZSW_FORBIO
+REAL, DIMENSION(KI, IO%NPATCH) :: ZSW_FORBIO
!
REAL :: ZCONVERTFACM0_SLT, ZCONVERTFACM0_DST
REAL :: ZCONVERTFACM3_SLT, ZCONVERTFACM3_DST
@@ -301,14 +310,14 @@ REAL :: ZCONVERTFACM6_SLT, ZCONVERTFACM6_DST
!
INTEGER :: ISWB ! number of spectral shortwave bands
INTEGER :: JSWB ! loop on number of spectral shortwave bands
-INTEGER :: JPATCH ! loop on patches
-INTEGER :: JSV, IDST, IMOMENT, II
+INTEGER :: JP ! loop on patches
+INTEGER :: JSV, IDST, IMOMENT, II, IMASK, JI
INTEGER :: JLAYER, JMODE, JSV_IDX
!
! logical units
!
-INTEGER :: JJ
-LOGICAL :: LUPDATED ! T if VEGETATION_UPDATE has reset fields
+INTEGER :: JJ, IBEG, IEND, ISIZE
+LOGICAL :: GUPDATED, GALB ! T if VEGETATION_UPDATE has reset fields
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -380,7 +389,7 @@ DO JJ=1,SIZE(PQA)
!
!* angle between z0eff J axis and wind direction (rad., clockwise)
!
- ZALFA(JJ) = ZDIR(JJ) - IM%I%XZ0EFFJPDIR(JJ) * XPI/180.
+ ZALFA(JJ) = ZDIR(JJ) - ISS%XZ0EFFJPDIR(JJ) * XPI/180.
IF (ZALFA(JJ)<-XPI) ZALFA(JJ) = ZALFA(JJ) + 2.*XPI
IF (ZALFA(JJ)>=XPI) ZALFA(JJ) = ZALFA(JJ) - 2.*XPI
@@ -393,25 +402,22 @@ ISWB = KSW
!
!* irrigation
!
-IF (LAGRIP .AND. (IM%I%CPHOTO=='LAI' .OR. IM%I%CPHOTO=='LST' .OR. &
- IM%I%CPHOTO=='NIT'.OR. IM%I%CPHOTO=='NCB') ) THEN
- CALL IRRIGATION_UPDATE(IM%AG, &
- IM%I%XIRRIG,PTSTEP,KMONTH,KDAY,PTIME, &
- IM%I%TSEED(:,:)%TDATE%MONTH,IM%I%TSEED(:,:)%TDATE%DAY, &
- IM%I%TREAP(:,:)%TDATE%MONTH,IM%I%TREAP(:,:)%TDATE%DAY )
+IF (LAGRIP .AND. (IO%CPHOTO=='NIT'.OR. IO%CPHOTO=='NCB') ) THEN
+ CALL IRRIGATION_UPDATE(NAG, NPE, IO%NPATCH, PTSTEP, KMONTH, KDAY, PTIME )
ENDIF
!
!* Actualization of the SGH variable (Fmu, Fsat)
!
- CALL ISBA_SGH_UPDATE(IM%IG, IM%I, &
- IM%I%CISBA,IM%I%CRUNOFF,IM%I%CRAIN,PRAIN,IM%I%XMUF,IM%I%XFSAT,IM%I%XTOPQS)
+ CALL ISBA_SGH_UPDATE(IG%XMESH_SIZE, IO, S, K, NK, NP, NPE, PRAIN )
!
!
!* Actualization of deep soil characteristics
!
IF (LDEEPSOIL) THEN
- CALL DEEPSOIL_UPDATE(IM%I, &
- IM%I%TTIME%TDATE%MONTH)
+ DO JP = 1,IO%NPATCH
+ KK => NK%AL(JP)
+ CALL DEEPSOIL_UPDATE(KK%XTDEEP, KK%XGAMMAT, S%TTIME%TDATE%MONTH)
+ ENDDO
ENDIF
!
!* Actualization of soil and wood carbon spinup
@@ -420,32 +426,28 @@ ENDIF
! (1) Atmospheric CO2 concentration fixed to Pre-industrial CO2 consentration XCO2_START
! (2) Atmospheric CO2 concentration rampin up from XCO2_START to XCO2_END
!
-IF(IM%I%LSPINUPCARBS.OR.IM%I%LSPINUPCARBW)THEN
+IF(IO%LSPINUPCARBS.OR.IO%LSPINUPCARBW)THEN
!
- ISPINEND=IM%I%NNBYEARSPINS-NINT(IM%I%NNBYEARSPINS*XSPIN_CO2)
+ ISPINEND = IO%NNBYEARSPINS-NINT(IO%NNBYEARSPINS*XSPIN_CO2)
!
- IM%I%LAGRI_TO_GRASS = .FALSE.
+ IO%LAGRI_TO_GRASS = .FALSE.
!
- IF ( IM%I%LSPINUPCARBS .AND. (IM%I%NNBYEARSOLD <= ISPINEND) ) THEN
+ IF ( IO%LSPINUPCARBS .AND. (IO%NNBYEARSOLD <= ISPINEND) ) THEN
!
- IM%I%LAGRI_TO_GRASS = .TRUE.
+ IO%LAGRI_TO_GRASS = .TRUE.
!
- ZCO2(:) = IM%I%XCO2_START * 1.E-6 * XMCO2 / XMD
+ ZCO2(:) = IO%XCO2_START * 1.E-6 * XMCO2 / XMD
!
- ELSEIF(IM%I%LSPINUPCARBS .AND. (IM%I%NNBYEARSOLD > ISPINEND) .AND. &
- (IM%I%NNBYEARSOLD <= IM%I%NNBYEARSPINS) )THEN
+ ELSEIF(IO%LSPINUPCARBS .AND. (IO%NNBYEARSOLD > ISPINEND) .AND. (IO%NNBYEARSOLD <= IO%NNBYEARSPINS) )THEN
!
- ZSPINCO2 = IM%I%XCO2_START + (IM%I%XCO2_END-IM%I%XCO2_START) * &
- REAL(IM%I%NNBYEARSOLD - ISPINEND) / REAL(IM%I%NNBYEARSPINS - ISPINEND)
+ ZSPINCO2 = IO%XCO2_START + (IO%XCO2_END-IO%XCO2_START) * &
+ REAL(IO%NNBYEARSOLD - ISPINEND) / REAL(IO%NNBYEARSPINS - ISPINEND)
!
ZCO2 (:) = ZSPINCO2 * 1.E-6 * XMCO2 / XMD
!
ENDIF
!
- CALL CARBON_SPINUP(IM%I%TTIME%TDATE%MONTH,IM%I%TTIME%TDATE%DAY,IM%I%TTIME%TIME, &
- IM%I%LSPINUPCARBS, IM%I%LSPINUPCARBW, IM%I%XSPINMAXS, IM%I%XSPINMAXW, &
- IM%I%NNBYEARSPINS, IM%I%NNBYEARSPINW, IM%I%NNBYEARSOLD, IM%I%CPHOTO, &
- IM%I%CRESPSL, IM%I%NSPINS, IM%I%NSPINW )
+ CALL CARBON_SPINUP( S%TTIME, IO )
!
ENDIF
!
@@ -453,9 +455,8 @@ ENDIF
! Time evolution
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-IM%I%TTIME%TIME = IM%I%TTIME%TIME + PTSTEP
- CALL ADD_FORECAST_TO_DATE_SURF(IM%I%TTIME%TDATE%YEAR,IM%I%TTIME%TDATE%MONTH,&
- IM%I%TTIME%TDATE%DAY,IM%I%TTIME%TIME)
+S%TTIME%TIME = S%TTIME%TIME + PTSTEP
+ CALL ADD_FORECAST_TO_DATE_SURF(S%TTIME%TDATE%YEAR,S%TTIME%TDATE%MONTH,S%TTIME%TDATE%DAY,S%TTIME%TIME)
!
! --------------------------------------------------------------------------------------
!
@@ -465,16 +466,21 @@ IM%I%TTIME%TIME = IM%I%TTIME%TIME + PTSTEP
! Patch Dependent Calculations
! --------------------------------------------------------------------------------------
!
-PATCH_LOOP: DO JPATCH=1,IM%I%NPATCH
-!
- IF (IM%I%NSIZE_NATURE_P(JPATCH) == 0 ) CYCLE
+PATCH_LOOP: DO JP=1,IO%NPATCH
+
+ IF (NP%AL(JP)%NSIZE_P == 0 ) CYCLE
!
! Pack dummy arguments for each patch:
!
#ifdef TOPD
- IF (LCOUPL_TOPD)NMASKT_PATCH(:)=IM%I%NR_NATURE_P(:,JPATCH)
+ IF (LCOUPL_TOPD) THEN
+ NMASKT_PATCH(:) = 0
+ NMASKT_PATCH(1:NP%AL(JP)%NSIZE_P) = NP%AL(JP)%NR_P(:)
+ ENDIF
#endif
- CALL TREAT_PATCH(IM%I%NSIZE_NATURE_P(JPATCH),IM%I%NR_NATURE_P(:,JPATCH))
+ CALL TREAT_PATCH(NK%AL(JP), NP%AL(JP), NPE%AL(JP), NISS%AL(JP), NAG%AL(JP), &
+ NIG%AL(JP), NCHI%AL(JP), NDST%AL(JP), ID%ND%AL(JP), ID%NDC%AL(JP), &
+ ID%NDE%AL(JP), ID%NDEC%AL(JP), ID%NDM%AL(JP), NGB%AL(JP) )
!
ENDDO PATCH_LOOP
!
@@ -482,10 +488,9 @@ ENDDO PATCH_LOOP
! SFX - RRM coupling update if used :
! --------------------------------------------------------------------------------------
!
-IF(IM%I%LCPL_RRM)THEN
- CALL DIAG_CPL_ESM_ISBA(IM%I, &
- PTSTEP,ZCPL_DRAIN,ZCPL_RUNOFF,ZCPL_EFLOOD, &
- ZCPL_PFLOOD,ZCPL_IFLOOD,ZCPL_ICEFLUX )
+IF(IO%LCPL_RRM)THEN
+ CALL DIAG_CPL_ESM_ISBA(IO, S, NK, NP, PTSTEP, ZCPL_DRAIN, ZCPL_RUNOFF, &
+ ZCPL_EFLOOD, ZCPL_PFLOOD, ZCPL_IFLOOD, ZCPL_ICEFLUX )
ENDIF
!
! --------------------------------------------------------------------------------------
@@ -494,54 +499,44 @@ ENDIF
! Vegetation albedo only update (in case of interactive vegetation):
! --------------------------------------------------------------------------------------
!
-LUPDATED=.FALSE.
-IF ((IM%I%CPHOTO=='NON' .OR. IM%I%CPHOTO=='AGS' .OR. IM%I%CPHOTO=='AST') .AND. IM%I%LVEGUPD) THEN
- CALL VEGETATION_UPDATE(DTCO, IM%DTI, DTGD, DTGR, IM%IG, IM%I, TGRO, &
- PTSTEP,IM%I%TTIME,IM%I%XCOVER, IM%I%LCOVER, &
- IM%I%CISBA,IM%I%LECOCLIMAP,IM%I%CPHOTO,LAGRIP,IM%I%LTR_ML,'NAT', &
- IM%I%XLAI,IM%I%XVEG,IM%I%XZ0, &
- IM%I%XALBNIR,IM%I%XALBVIS,IM%I%XALBUV,IM%I%XEMIS, &
- IM%I%XRSMIN,IM%I%XGAMMA,IM%I%XWRMAX_CF, &
- IM%I%XRGL,IM%I%XCV, &
- IM%I%XGMES,IM%I%XBSLAI,IM%I%XLAIMIN,IM%I%XSEFOLD,IM%I%XGC,IM%I%XDMAX, &
- IM%I%XF2I, IM%I%LSTRESS, &
- IM%I%XAOSIP,IM%I%XAOSIM,IM%I%XAOSJP,IM%I%XAOSJM, &
- IM%I%XHO2IP,IM%I%XHO2IM,IM%I%XHO2JP,IM%I%XHO2JM, &
- IM%I%XZ0EFFIP,IM%I%XZ0EFFIM,IM%I%XZ0EFFJP,IM%I%XZ0EFFJM, &
- IM%I%CALBEDO, IM%I%XALBNIR_VEG, IM%I%XALBVIS_VEG, IM%I%XALBUV_VEG, &
- IM%I%XALBNIR_SOIL, IM%I%XALBVIS_SOIL, IM%I%XALBUV_SOIL, &
- IM%I%XCE_NITRO, IM%I%XCF_NITRO, IM%I%XCNA_NITRO, &
- IM%I%TSEED, IM%I%TREAP, IM%I%XWATSUP, IM%I%XIRRIG, &
- IM%I%XGNDLITTER, IM%I%XRGLGV,IM%I%XGAMMAGV, &
- IM%I%XRSMINGV, IM%I%XWRMAX_CFGV, &
- IM%I%XH_VEG, IM%I%XLAIGV, IM%I%XZ0LITTER, LUPDATED )
-!
-ELSEIF ((IM%I%CPHOTO=='LAI'.OR.IM%I%CPHOTO=='LST'.OR.IM%I%CPHOTO=='NIT'.OR.IM%I%CPHOTO=='NCB').AND.IM%I%LVEGUPD) THEN
-!
- CALL ALBEDO_VEG_UPDATE(DTCO, IM%DTI, IM%IG, IM%I, &
- PTSTEP,IM%I%TTIME,IM%I%XCOVER, IM%I%LCOVER, &
- IM%I%CISBA,IM%I%LECOCLIMAP,IM%I%CPHOTO,LAGRIP,IM%I%LTR_ML,'NAT', &
- IM%I%XVEG,IM%I%XALBNIR,IM%I%XALBVIS,IM%I%XALBUV, &
- IM%I%CALBEDO, IM%I%XALBNIR_VEG, IM%I%XALBVIS_VEG, IM%I%XALBUV_VEG, &
- IM%I%XALBNIR_SOIL, IM%I%XALBVIS_SOIL, IM%I%XALBUV_SOIL )
-END IF
+GUPDATED=.FALSE.
!
-IF(IM%I%LPERTSURF.AND.LUPDATED) THEN
- ! random perturbation for ensembles:
- ! reset these fields to their original values, as in compute_isba_parameters
- IM%I%XVEG(:,1) = IM%I%XPERTVEG(:)
- IM%I%XLAI(:,1) = IM%I%XPERTLAI(:)
- IM%I%XCV(:,1) = IM%I%XPERTCV(:)
- ! reapply original perturbation patterns
- WHERE(IM%I%XALBNIR(:,1)/=XUNDEF) IM%I%XALBNIR(:,1) =IM%I%XALBNIR(:,1) *( 1.+ IM%I%XPERTALB(:) )
- WHERE(IM%I%XALBVIS(:,1)/=XUNDEF) IM%I%XALBVIS(:,1) =IM%I%XALBVIS(:,1) *( 1.+ IM%I%XPERTALB(:) )
- WHERE(IM%I%XALBUV(:,1)/=XUNDEF) IM%I%XALBUV(:,1) =IM%I%XALBUV(:,1) *( 1.+ IM%I%XPERTALB(:) )
- WHERE(IM%I%XZ0(:,1)/=XUNDEF) IM%I%XZ0(:,1) =IM%I%XZ0(:,1) *( 1.+ IM%I%XPERTZ0(:) )
- WHERE(IM%I%XZ0EFFIP(:,1)/=XUNDEF) IM%I%XZ0EFFIP(:,1)=IM%I%XZ0EFFIP(:,1)*( 1.+ IM%I%XPERTZ0(:) )
- WHERE(IM%I%XZ0EFFIM(:,1)/=XUNDEF) IM%I%XZ0EFFIM(:,1)=IM%I%XZ0EFFIM(:,1)*( 1.+ IM%I%XPERTZ0(:) )
- WHERE(IM%I%XZ0EFFJP(:,1)/=XUNDEF) IM%I%XZ0EFFJP(:,1)=IM%I%XZ0EFFJP(:,1)*( 1.+ IM%I%XPERTZ0(:) )
- WHERE(IM%I%XZ0EFFJM(:,1)/=XUNDEF) IM%I%XZ0EFFJM(:,1)=IM%I%XZ0EFFJM(:,1)*( 1.+ IM%I%XPERTZ0(:) )
+IF (IO%LVEGUPD) THEN
+ GALB = .FALSE.
+ IF (IO%CPHOTO=='NIT'.OR.IO%CPHOTO=='NCB') GALB = .TRUE.
+ DO JP = 1,IO%NPATCH
+ CALL VEGETATION_UPDATE(DTCO, DTI, IG%NDIM, IO, NK%AL(JP), NP%AL(JP), NPE%AL(JP), JP, &
+ PTSTEP, S%TTIME, S%XCOVER, S%LCOVER, LAGRIP, &
+ 'NAT', GALB, NISS%AL(JP), GUPDATED )
+ ENDDO
+!
+ENDIF
+!
+IF(IO%LPERTSURF.AND.GUPDATED) THEN
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+ ISSK => NISS%AL(JP)
+ DO JI = 1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ !
+ ! random perturbation for ensembles:
+ ! reset these fields to their original values, as in compute_isba_parameters
+ PEK%XVEG(JI) = S%XPERTVEG(IMASK)
+ PEK%XLAI(JI) = S%XPERTLAI(IMASK)
+ PEK%XCV (JI) = S%XPERTCV (IMASK)
+ ! reapply original perturbation patterns
+ IF(PEK%XALBNIR(JI)/=XUNDEF) PEK%XALBNIR(JI) = PEK%XALBNIR(JI) *( 1.+ S%XPERTALB(IMASK) )
+ IF(PEK%XALBVIS(JI)/=XUNDEF) PEK%XALBVIS(JI) = PEK%XALBVIS(JI) *( 1.+ S%XPERTALB(IMASK) )
+ IF(PEK%XALBUV(JI)/=XUNDEF) PEK%XALBUV (JI) = PEK%XALBUV (JI) *( 1.+ S%XPERTALB(IMASK) )
+ IF(PEK%XZ0(JI)/=XUNDEF) PEK%XZ0(JI) = PEK%XZ0(JI) *( 1.+ S%XPERTZ0(IMASK) )
+ IF(ISSK%XZ0EFFIP(JI)/=XUNDEF) ISSK%XZ0EFFIP(JI) = ISSK%XZ0EFFIP(JI)*( 1.+ S%XPERTZ0(IMASK) )
+ IF(ISSK%XZ0EFFIM(JI)/=XUNDEF) ISSK%XZ0EFFIM(JI) = ISSK%XZ0EFFIM(JI)*( 1.+ S%XPERTZ0(IMASK) )
+ IF(ISSK%XZ0EFFJP(JI)/=XUNDEF) ISSK%XZ0EFFJP(JI) = ISSK%XZ0EFFJP(JI)*( 1.+ S%XPERTZ0(IMASK) )
+ IF(ISSK%XZ0EFFJM(JI)/=XUNDEF) ISSK%XZ0EFFJM(JI) = ISSK%XZ0EFFJM(JI)*( 1.+ S%XPERTZ0(IMASK) )
+ ENDDO
+ ENDDO
ENDIF
!
! --------------------------------------------------------------------------------------
@@ -549,11 +544,9 @@ ENDIF
! --------------------------------------------------------------------------------------
! Grid box average fluxes/properties: Arguments and standard diagnostics at time t+1
!
- CALL AVERAGE_FLUX(IM%I%XPATCH, &
- ZSFTH_TILE, ZSFTQ_TILE, ZSFTS_TILE, ZSFCO2_TILE, &
- ZSFU_TILE, ZSFV_TILE, &
- PSFTH, PSFTQ, PSFTS, PSFCO2, &
- PSFU, PSFV )
+ CALL AVERAGE_FLUX(S%XPATCH, ZSFTH_TILE, ZSFTQ_TILE, ZSFTS_TILE, &
+ ZSFCO2_TILE, ZSFU_TILE, ZSFV_TILE, PSFTH, PSFTQ,&
+ PSFTS, PSFCO2, PSFU, PSFV )
!
!
!-------------------------------------------------------------------------------
@@ -562,52 +555,46 @@ ENDIF
!difficult to do. Maybe it will be done later. However, Ts is at time t+1
!-------------------------------------------------------------------------------
!
- CALL AVERAGE_PHY(IM%I%XPATCH, &
- ZTSURF_TILE, ZZ0_TILE, ZZ0H_TILE, ZQSURF_TILE, &
- PUREF, PZREF, PTSURF, PZ0, PZ0H, PQSURF )
+ CALL AVERAGE_PHY(S%XPATCH, ZTSURF_TILE, ZZ0_TILE, ZZ0H_TILE, &
+ ZQSURF_TILE, PUREF, PZREF, PTSURF, PZ0, PZ0H, PQSURF )
!
!-------------------------------------------------------------------------------------
!Radiative properties at time t+1 (see by the atmosphere) in order to close
!the energy budget between surfex and the atmosphere
!-------------------------------------------------------------------------------------
!
- CALL UPDATE_RAD_ISBA_n(IM%I, &
- IM%I%LFLOOD, IM%I%TSNOW%SCHEME, PZENITH2, PSW_BANDS, &
- IM%I%XVEG, IM%I%XLAI, IM%I%XZ0, &
- IM%I%LMEB_PATCH,IM%I%XLAIGV,IM%I%XGNDLITTER,IM%I%XZ0LITTER,IM%I%XH_VEG, &
- IM%I%XALBNIR, IM%I%XALBVIS, IM%I%XALBUV, IM%I%XEMIS, &
- ZDIR_ALB_TILE,ZSCA_ALB_TILE,ZEMIS_TILE, &
- PDIR_SW, PSCA_SW, &
- IM%I%XALBNIR_VEG, IM%I%XALBNIR_SOIL, &
- IM%I%XALBVIS_VEG, IM%I%XALBVIS_SOIL )
+DO JP = 1,IO%NPATCH
+ CALL UPDATE_RAD_ISBA_n(IO, S, NK%AL(JP), NP%AL(JP), NPE%AL(JP), JP, PZENITH2, PSW_BANDS, &
+ ZDIR_ALB_TILE(:,:,JP), ZSCA_ALB_TILE(:,:,JP), &
+ ZEMIS_TILE(:,JP), PDIR_SW, PSCA_SW )
+ENDDO
!
- CALL AVERAGE_RAD(IM%I%XPATCH, &
- ZDIR_ALB_TILE, ZSCA_ALB_TILE, ZEMIS_TILE, ZTRAD_TILE, &
- PDIR_ALB, PSCA_ALB, IM%I%XEMIS_NAT, IM%I%XTSRAD_NAT )
+ CALL AVERAGE_RAD(S%XPATCH, ZDIR_ALB_TILE, ZSCA_ALB_TILE, ZEMIS_TILE, &
+ ZTRAD_TILE, PDIR_ALB, PSCA_ALB, S%XEMIS_NAT, S%XTSRAD_NAT )
!
-PEMIS = IM%I%XEMIS_NAT
-PTRAD = IM%I%XTSRAD_NAT
+PEMIS = S%XEMIS_NAT
+PTRAD = S%XTSRAD_NAT
!
!-------------------------------------------------------------------------------------
!
! Any additional diagnostics (stored in MODD_DIAG_ISBA_n)
!
- CALL AVERAGE_DIAG_ISBA_n(IM%DGEI, IM%DGI, IM%I, &
- PUREF,PZREF,PSFCO2,PTRAD)
+ CALL AVERAGE_DIAG_ISBA_n(ID%O, ID%D, ID%DC, ID%ND, ID%NDC, NP, IO%NPATCH, &
+ ID%O%LSURF_BUDGETC, IO%LCANOPY, PUREF, PZREF, PSFCO2, PTRAD)
!
! Cumulated diagnostics (stored in MODD_DIAG_EVAP_ISBA_n)
!
- CALL AVERAGE_DIAG_EVAP_ISBA_n(IM%DGEI, IM%I, &
- PTSTEP,PRAIN,PSNOW)
+ CALL AVERAGE_DIAG_EVAP_ISBA_n(ID%O%LSURF_BUDGETC, ID%DE, ID%DEC, ID%NDE, ID%NDEC, NP, &
+ IO%NPATCH, IO%LGLACIER, IO%LMEB_PATCH, PTSTEP, PRAIN, PSNOW)
!
! Miscellaneous diagnostics (stored in MODD_DIAG_MISC_ISBA_n)
!
- CALL AVERAGE_DIAG_MISC_ISBA_n(IM%DGMI, IM%I)
+ CALL AVERAGE_DIAG_MISC_ISBA_n(ID%DM, ID%NDM, IO, NP, NPE)
!
!--------------------------------------------------------------------------------------
!
- CALL COUPLING_SURF_TOPD(IM%DGEI, IM%DGMI, IM%IG, IM%I, UG, U, &
- HPROGRAM,U%NDIM_FULL)
+ CALL COUPLING_SURF_TOPD(ID%DE, ID%DEC, ID%DC, ID%DM, IG, &
+ IO, S, K, NK, NP, NPE, UG, U, HPROGRAM, U%NDIM_FULL)
!
! --------------------------------------------------------------------------------------
! Snow/Flood fractions, albedo and emissivity update :
@@ -617,122 +604,143 @@ PTRAD = IM%I%XTSRAD_NAT
! Chemical fluxes :
! --------------------------------------------------------------------------------------
!
-IF (IM%CHI%SVI%NBEQ>0 .AND. IM%CHI%LCH_BIO_FLUX) THEN
- CALL CH_BVOCEM_n(IM%CHI, IM%GB, IM%I, &
- ZSW_FORBIO,PRHOA,PSFTS)
+IF (CHI%SVI%NBEQ>0 .AND. CHI%LCH_BIO_FLUX) THEN
+ CALL CH_BVOCEM_n(CHI%SVI, NGB, GB, IO, S, NP, NPE, ZSW_FORBIO, PRHOA, PSFTS)
ENDIF
!
!SOILNOX
-IF (IM%CHI%LCH_NO_FLUX) THEN
- CALL SOILEMISNO_n(IM%GB, IM%I, &
- PU,PV)
+IF (CHI%LCH_NO_FLUX) THEN
+ CALL SOILEMISNO_n(GB, S, K, NP, NPE, PU, PV)
ENDIF
!
!==========================================================================================
!
IF (LHOOK) CALL DR_HOOK('COUPLING_ISBA_N',1,ZHOOK_HANDLE)
- CONTAINS
+CONTAINS
!
!=======================================================================================
-SUBROUTINE TREAT_PATCH(KSIZE,KMASK)
+SUBROUTINE TREAT_PATCH(KK, PK, PEK, ISSK, AGK, GK, CHIK, DSTK, DK, DCK, DEK, DECK, DMK, GBK )
+!
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_AGRI_n, ONLY : AGRI_t
+USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
+USE MODD_DST_n, ONLY : DST_t
+USE MODD_DIAG_n, ONLY : DIAG_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
+USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t
!
IMPLICIT NONE
!
-INTEGER, INTENT(IN) :: KSIZE
-INTEGER, INTENT(IN), DIMENSION(KI) :: KMASK
-!
-REAL, DIMENSION(KSIZE) :: ZP_ZREF ! height of T,q forcing (m)
-REAL, DIMENSION(KSIZE) :: ZP_UREF ! height of wind forcing (m)
-REAL, DIMENSION(KSIZE) :: ZP_U ! zonal wind (m/s)
-REAL, DIMENSION(KSIZE) :: ZP_V ! meridian wind (m/s)
-REAL, DIMENSION(KSIZE) :: ZP_WIND ! wind (m/s)
-REAL, DIMENSION(KSIZE) :: ZP_DIR ! wind direction (rad from N clockwise)
-REAL, DIMENSION(KSIZE) :: ZP_QA ! air specific humidity forcing (kg/kg)
-REAL, DIMENSION(KSIZE) :: ZP_TA ! air temperature forcing (K)
-REAL, DIMENSION(KSIZE) :: ZP_CO2 ! CO2 concentration in the air (kg/kg)
-REAL, DIMENSION(KSIZE,KSV) :: ZP_SV ! scalar concentration in the air (kg/kg)
-REAL, DIMENSION(KSIZE) :: ZP_ZENITH ! zenithal angle radian from the vertical)
-REAL, DIMENSION(KSIZE) :: ZP_PEW_A_COEF ! implicit coefficients
-REAL, DIMENSION(KSIZE) :: ZP_PEW_B_COEF ! needed if HCOUPLING='I'
-REAL, DIMENSION(KSIZE) :: ZP_PET_A_COEF
-REAL, DIMENSION(KSIZE) :: ZP_PET_B_COEF
-REAL, DIMENSION(KSIZE) :: ZP_PEQ_A_COEF
-REAL, DIMENSION(KSIZE) :: ZP_PEQ_B_COEF
-REAL, DIMENSION(KSIZE) :: ZP_RAIN ! liquid precipitation (kg/m2/s)
-REAL, DIMENSION(KSIZE) :: ZP_SNOW ! snow precipitation (kg/m2/s)
-REAL, DIMENSION(KSIZE) :: ZP_LW ! longwave radiation (W/m2)
-REAL, DIMENSION(KSIZE,ISWB) :: ZP_DIR_SW ! direct solar radiation (W/m2)
-REAL, DIMENSION(KSIZE,ISWB) :: ZP_SCA_SW ! diffuse solar radiation (W/m2)
-REAL, DIMENSION(KSIZE) :: ZP_PS ! pressure at atmospheric model surface (Pa)
-REAL, DIMENSION(KSIZE) :: ZP_PA ! pressure at forcing level (Pa)
-REAL, DIMENSION(KSIZE) :: ZP_ZS ! atmospheric model orography (m)
-REAL, DIMENSION(KSIZE) :: ZP_SFTQ ! flux of water vapor <w'q'> (kg.m-2.s-1)
-REAL, DIMENSION(KSIZE) :: ZP_SFTH ! flux of temperature <w'T'> (W/m2)
-REAL, DIMENSION(KSIZE,KSV) :: ZP_SFTS ! flux of scalar <w'sv'> (mkg/kg/s)
-REAL, DIMENSION(KSIZE) :: ZP_SFCO2 ! flux of CO2 positive toward the atmosphere (m/s*kg_CO2/kg_air)
-REAL, DIMENSION(KSIZE) :: ZP_USTAR ! friction velocity (m/s)
-REAL, DIMENSION(KSIZE) :: ZP_SFU ! zonal momentum flux (pa)
-REAL, DIMENSION(KSIZE) :: ZP_SFV ! meridian momentum flux (pa)
-REAL, DIMENSION(KSIZE) :: ZP_TRAD ! radiative temperature (K)
-REAL, DIMENSION(KSIZE) :: ZP_TSURF ! surface effective temperature (K)
-REAL, DIMENSION(KSIZE) :: ZP_Z0 ! roughness length for momentum (m)
-REAL, DIMENSION(KSIZE) :: ZP_Z0H ! roughness length for heat (m)
-REAL, DIMENSION(KSIZE) :: ZP_QSURF ! specific humidity at surface (kg/kg)
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(SSO_t), INTENT(INOUT) :: ISSK
+TYPE(AGRI_t), INTENT(INOUT) :: AGK
+TYPE(GRID_t), INTENT(INOUT) :: GK
+TYPE(CH_ISBA_t), INTENT(INOUT) :: CHIK
+TYPE(DST_t), INTENT(INOUT) :: DSTK
+TYPE(DIAG_t), INTENT(INOUT) :: DK
+TYPE(DIAG_t), INTENT(INOUT) :: DCK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DECK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK
+TYPE(GR_BIOG_t), INTENT(INOUT) :: GBK
+!
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_ZREF ! height of T,q forcing (m)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_UREF ! height of wind forcing (m)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_U ! zonal wind (m/s)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_V ! meridian wind (m/s)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_WIND ! wind (m/s)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_DIR ! wind direction (rad from N clockwise)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_QA ! air specific humidity forcing (kg/kg)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_TA ! air temperature forcing (K)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_CO2 ! CO2 concentration in the air (kg/kg)
+REAL, DIMENSION(PK%NSIZE_P,KSV) :: ZP_SV ! scalar concentration in the air (kg/kg)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_ZENITH ! zenithal angle radian from the vertical)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_PEW_A_COEF ! implicit coefficients
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_PEW_B_COEF ! needed if HCOUPLING='I'
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_PET_A_COEF
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_PET_B_COEF
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_PEQ_A_COEF
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_PEQ_B_COEF
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_RAIN ! liquid precipitation (kg/m2/s)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_SNOW ! snow precipitation (kg/m2/s)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_LW ! longwave radiation (W/m2)
+REAL, DIMENSION(PK%NSIZE_P,ISWB) :: ZP_DIR_SW ! direct solar radiation (W/m2)
+REAL, DIMENSION(PK%NSIZE_P,ISWB) :: ZP_SCA_SW ! diffuse solar radiation (W/m2)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_PS ! pressure at atmospheric model surface (Pa)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_PA ! pressure at forcing level (Pa)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_ZS ! atmospheric model orography (m)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_SFTQ ! flux of water vapor <w'q'> (kg.m-2.s-1)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_SFTH ! flux of temperature <w'T'> (W/m2)
+REAL, DIMENSION(PK%NSIZE_P,KSV) :: ZP_SFTS ! flux of scalar <w'sv'> (mkg/kg/s)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_SFCO2 ! flux of CO2 positive toward the atmosphere (m/s*kg_CO2/kg_air)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_USTAR ! friction velocity (m/s)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_SFU ! zonal momentum flux (pa)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_SFV ! meridian momentum flux (pa)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_TRAD ! radiative temperature (K)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_TSURF ! surface effective temperature (K)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_Z0 ! roughness length for momentum (m)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_Z0H ! roughness length for heat (m)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_QSURF ! specific humidity at surface (kg/kg)
!
!* other forcing variables (packed for each patch)
!
-REAL, DIMENSION(KSIZE) :: ZP_RHOA ! lowest atmospheric level air density (kg/m3)
-REAL, DIMENSION(KSIZE) :: ZP_EXNA ! Exner function at lowest atmospheric level (-)
-REAL, DIMENSION(KSIZE) :: ZP_EXNS ! Exner function at surface (-)
-REAL, DIMENSION(KSIZE) :: ZP_ALFA ! Wind direction (-)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_RHOA ! lowest atmospheric level air density (kg/m3)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_EXNA ! Exner function at lowest atmospheric level (-)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_EXNS ! Exner function at surface (-)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_ALFA ! Wind direction (-)
!
!* working variables (packed for each patch)
!
-REAL, DIMENSION(KSIZE) :: ZP_ALBNIR_TVEG ! total vegetation albedo in ir
-REAL, DIMENSION(KSIZE) :: ZP_ALBNIR_TSOIL ! total soil albedo in ir
-REAL, DIMENSION(KSIZE) :: ZP_ALBVIS_TVEG ! total vegetation albedo in vis
-REAL, DIMENSION(KSIZE) :: ZP_ALBVIS_TSOIL ! total soil albedo in vis
-REAL, DIMENSION(KSIZE) :: ZP_EMIS ! emissivity
-REAL, DIMENSION(KSIZE) :: ZP_GLOBAL_SW ! global incoming SW rad.
-REAL, DIMENSION(KSIZE) :: ZP_SLOPE_COS ! typical slope in the grid cosine
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_ALBNIR_TVEG ! total vegetation albedo in ir
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_ALBNIR_TSOIL ! total soil albedo in ir
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_ALBVIS_TVEG ! total vegetation albedo in vis
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_ALBVIS_TSOIL ! total soil albedo in vis
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_EMIS ! emissivity
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_GLOBAL_SW ! global incoming SW rad.
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_SLOPE_COS ! typical slope in the grid cosine
!
-REAL, DIMENSION(KSIZE) :: ZP_Z0FLOOD !Floodplain
-REAL, DIMENSION(KSIZE) :: ZP_FFGNOS !Floodplain fraction over the ground without snow
-REAL, DIMENSION(KSIZE) :: ZP_FFVNOS !Floodplain fraction over vegetation without snow
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_Z0FLOOD !Floodplain
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_FFGNOS !Floodplain fraction over the ground without snow
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_FFVNOS !Floodplain fraction over vegetation without snow
!
-REAL, DIMENSION(KSIZE,IM%I%NNBIOMASS) :: ZP_RESP_BIOMASS_INST ! instantaneous biomass respiration (kgCO2/kgair m/s)
+REAL, DIMENSION(PK%NSIZE_P,IO%NNBIOMASS) :: ZP_RESP_BIOMASS_INST ! instantaneous biomass respiration (kgCO2/kgair m/s)
!
!* Aggregated coeffs for evaporative flux calculations
!
-REAL, DIMENSION(KSIZE) :: ZP_AC_AGG ! aggregated aerodynamic resistance
-REAL, DIMENSION(KSIZE) :: ZP_HU_AGG ! aggregated relative humidity
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_AC_AGG ! aggregated aerodynamic resistance
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_HU_AGG ! aggregated relative humidity
!
!* For multi-energy balance
!
-REAL, DIMENSION(KSIZE) :: ZPALPHAN ! snow/canopy transition coefficient
-REAL, DIMENSION(KSIZE) :: ZSNOWDEPTH ! total snow depth
-REAL, DIMENSION(KSIZE) :: ZZ0G_WITHOUT_SNOW ! roughness length for momentum at snow-free canopy floor
-REAL, DIMENSION(KSIZE) :: ZZ0_MEBV ! roughness length for momentum over MEB vegetation part of patch
-REAL, DIMENSION(KSIZE) :: ZZ0H_MEBV ! roughness length for heat over MEB vegetation part of path
-REAL, DIMENSION(KSIZE) :: ZZ0EFF_MEBV ! roughness length for momentum over MEB vegetation part of patch
-REAL, DIMENSION(KSIZE) :: ZZ0_MEBN ! roughness length for momentum over MEB snow part of patch
-REAL, DIMENSION(KSIZE) :: ZZ0H_MEBN ! roughness length for heat over MEB snow part of path
-REAL, DIMENSION(KSIZE) :: ZZ0EFF_MEBN ! roughness length for momentum over MEB snow part of patch
+REAL, DIMENSION(PK%NSIZE_P) :: ZPALPHAN ! snow/canopy transition coefficient
+REAL, DIMENSION(PK%NSIZE_P) :: ZSNOWDEPTH ! total snow depth
+REAL, DIMENSION(PK%NSIZE_P) :: ZZ0G_WITHOUT_SNOW ! roughness length for momentum at snow-free canopy floor
+REAL, DIMENSION(PK%NSIZE_P) :: ZZ0_MEBV ! roughness length for momentum over MEB vegetation part of patch
+REAL, DIMENSION(PK%NSIZE_P) :: ZZ0H_MEBV ! roughness length for heat over MEB vegetation part of path
+REAL, DIMENSION(PK%NSIZE_P) :: ZZ0EFF_MEBV ! roughness length for momentum over MEB vegetation part of patch
+REAL, DIMENSION(PK%NSIZE_P) :: ZZ0_MEBN ! roughness length for momentum over MEB snow part of patch
+REAL, DIMENSION(PK%NSIZE_P) :: ZZ0H_MEBN ! roughness length for heat over MEB snow part of path
+REAL, DIMENSION(PK%NSIZE_P) :: ZZ0EFF_MEBN ! roughness length for momentum over MEB snow part of patch
! Temporary
-REAL, DIMENSION(KSIZE) :: ZP_MEB_SCA_SW ! diffuse incoming SW rad.
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_MEB_SCA_SW ! diffuse incoming SW rad.
!
!* ISBA water and energy budget
!
-REAL, DIMENSION(KSIZE) :: ZP_WG_INI
-REAL, DIMENSION(KSIZE) :: ZP_WGI_INI
-REAL, DIMENSION(KSIZE) :: ZP_WR_INI
-REAL, DIMENSION(KSIZE) :: ZP_SWE_INI
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_WG_INI
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_WGI_INI
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_WR_INI
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_SWE_INI
!
! miscellaneous
!
-REAL, DIMENSION(KSIZE) :: ZP_DEEP_FLUX ! Flux at the bottom of the soil
-REAL, DIMENSION(KSIZE) :: ZP_TDEEP_A ! coefficient for implicitation of Tdeep
-REAL, DIMENSION(KSIZE) :: ZIRRIG_GR ! green roof ground irrigation rate
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_DEEP_FLUX ! Flux at the bottom of the soil
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_TDEEP_A ! coefficient for implicitation of Tdeep
+REAL, DIMENSION(PK%NSIZE_P) :: ZIRRIG_GR ! green roof ground irrigation rate
!
! For multi-energy balance
LOGICAL :: GMEB ! True if multi-energy balance should be used for the specific patch
@@ -746,7 +754,7 @@ IF (LHOOK) CALL DR_HOOK('COUPLING_ISBA_n:TREAT_PATCH',0,ZHOOK_HANDLE)
!
! Pack isba forcing outputs
!
-IF (IM%I%NPATCH==1) THEN
+IF (IO%NPATCH==1) THEN
ZP_ZENITH(:) = PZENITH (:)
ZP_ZREF(:) = PZREF (:)
ZP_UREF(:) = PUREF (:)
@@ -780,8 +788,8 @@ IF (IM%I%NPATCH==1) THEN
ELSE
!cdir nodep
!cdir unroll=8
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
+ DO JJ=1,PK%NSIZE_P
+ JI = PK%NR_P(JJ)
ZP_ZENITH(JJ) = PZENITH (JI)
ZP_ZREF(JJ) = PZREF (JI)
ZP_UREF(JJ) = PUREF (JI)
@@ -814,8 +822,8 @@ ELSE
DO JK=1,KSV
!cdir nodep
!cdir unroll=8
- DO JJ=1,KSIZE
- JI=KMASK(JJ)
+ DO JJ=1,PK%NSIZE_P
+ JI=PK%NR_P(JJ)
ZP_SV(JJ,JK) = PSV(JI,JK)
ENDDO
ENDDO
@@ -823,8 +831,8 @@ ELSE
DO JK=1,SIZE(PDIR_SW,2)
!cdir nodep
!cdir unroll=8
- DO JJ=1,KSIZE
- JI=KMASK(JJ)
+ DO JJ=1,PK%NSIZE_P
+ JI=PK%NR_P(JJ)
ZP_DIR_SW(JJ,JK) = PDIR_SW (JI,JK)
ZP_SCA_SW(JJ,JK) = PSCA_SW (JI,JK)
ENDDO
@@ -835,39 +843,15 @@ ENDIF
!--------------------------------------------------------------------------------------
!
! For multi-energy balance
- GMEB=IM%I%LMEB_PATCH(JPATCH)
-!
-! Pack ISBA input and prognostic variables (modd_isban) for each patch:
-!
- CALL PACK_ISBA_PATCH_GET_SIZE_n(IM%I, IM%PKI, &
- JPATCH)
-!
- CALL PACK_DIAG_PATCH_GET_SIZE_n(IM%DGEI, IM%DGI, IM%DGMI, IM%I, IM%PKDI, &
- JPATCH)
-!
- CALL PACK_ISBA_PATCH_n(IM%AG, IM%IG, IM%I, IM%PKI, &
- KMASK,KSIZE,JPATCH)
-!
-! Pack chemistry input and prognostic variables (modd_ch_isban) for each patch:
-!
-IF (IM%CHI%SVI%NBEQ>0) THEN
- IF( IM%CHI%CCH_DRY_DEP == "WES89") THEN
- CALL PACK_CH_ISBA_PATCH_n(IM%CHI, IM%PKCI, &
- KMASK,KSIZE,IM%I%NPATCH,JPATCH)
- END IF
-END IF
-!
-! Allocate ISBA diagnostics for each patch:
-!
- CALL PACK_DIAG_PATCH_n(IM%DGEI, IM%DGI, IM%DGMI, IM%I, IM%PKDI, &
- KSIZE,ISWB,JPATCH)
+GMEB = IO%LMEB_PATCH(JP)
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Cosine of the slope typically encoutered in the grid mesh (including subgrid orography)
+! and orientation of this slope
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-ZP_SLOPE_COS(:) = 1./SQRT(1.+IM%PKI%XP_SSO_SLOPE(:)**2)
-IF(LNOSOF)ZP_SLOPE_COS(:) = 1.0
+ZP_SLOPE_COS(:) = 1./SQRT(1.+ISSK%XSSO_SLOPE(:)**2)
+IF(LNOSOF) ZP_SLOPE_COS(:) = 1.0
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Snow fractions
@@ -885,9 +869,8 @@ ZP_TDEEP_A = 0.
! Flood properties
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-IF(IM%I%LFLOOD)THEN
- CALL ISBA_FLOOD_PROPERTIES(IM%PKI%XP_LAI,IM%PKI%XP_FFLOOD,IM%PKI%XP_FFROZEN, &
- ZP_Z0FLOOD,ZP_FFGNOS,ZP_FFVNOS)
+IF(IO%LFLOOD)THEN
+ CALL ISBA_FLOOD_PROPERTIES(PEK%XLAI, KK%XFFLOOD, KK%XFFROZEN, ZP_Z0FLOOD, ZP_FFGNOS, ZP_FFVNOS)
ELSE
ZP_Z0FLOOD = XUNDEF
ZP_FFGNOS = 0.0
@@ -896,8 +879,8 @@ ENDIF
!
! For multi-energy balance
IF(GMEB)THEN
- ZSNOWDEPTH(:) = SUM(IM%PKI%XP_SNOWSWE(:,:)/IM%PKI%XP_SNOWRHO(:,:),2)
- ZPALPHAN(:)=MEBPALPHAN(ZSNOWDEPTH,IM%PKI%XP_H_VEG)
+ ZSNOWDEPTH(:) = SUM(PEK%TSNOW%WSNOW(:,:)/PEK%TSNOW%RHO(:,:),2)
+ ZPALPHAN (:) =MEBPALPHAN(ZSNOWDEPTH,PEK%XH_VEG(:))
ENDIF
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -906,18 +889,11 @@ ENDIF
!
!* effective roughness
!
- CALL Z0EFF(IM%I, &
- IM%I%CROUGH, GMEB, ZP_ALFA, ZP_ZREF, ZP_UREF, &
- IM%PKI%XP_Z0, IM%PKI%XP_Z0REL, IM%PKI%XP_PSN, &
- ZPALPHAN,IM%PKI%XP_Z0LITTER, IM%PKI%XP_SNOWSWE(:,1), &
- IM%PKI%XP_Z0EFFIP,IM%PKI%XP_Z0EFFIM,IM%PKI%XP_Z0EFFJP, &
- IM%PKI%XP_Z0EFFJM, IM%PKI%XP_FF, ZP_Z0FLOOD, &
- IM%PKI%XP_AOSIP,IM%PKI%XP_AOSIM,IM%PKI%XP_AOSJP,IM%PKI%XP_AOSJM, &
- IM%PKI%XP_HO2IP,IM%PKI%XP_HO2IM,IM%PKI%XP_HO2JP,IM%PKI%XP_HO2JM, &
- IM%PKI%XP_Z0_O_Z0H, IM%PKDI%XP_Z0_WITH_SNOW, IM%PKDI%XP_Z0H_WITH_SNOW, &
- IM%PKDI%XP_Z0EFF, ZZ0G_WITHOUT_SNOW, &
- ZZ0_MEBV,ZZ0H_MEBV,ZZ0EFF_MEBV, &
- ZZ0_MEBN,ZZ0H_MEBN,ZZ0EFF_MEBN )
+ CALL Z0EFF(PEK%TSNOW%SCHEME, GMEB, ZP_ALFA, ZP_ZREF, ZP_UREF, &
+ PEK%XZ0, ISSK%XZ0REL, PEK%XPSN, ZPALPHAN, PEK%XZ0LITTER, &
+ PEK%TSNOW%WSNOW(:,1), ISSK, KK%XFF, ZP_Z0FLOOD, PK%XZ0_O_Z0H, &
+ DK%XZ0, DK%XZ0H, DK%XZ0EFF, ZZ0G_WITHOUT_SNOW, &
+ ZZ0_MEBV, ZZ0H_MEBV, ZZ0EFF_MEBV, ZZ0_MEBN, ZZ0H_MEBN, ZZ0EFF_MEBN )
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Shortwave computations for outputs (albedo for radiative scheme)
@@ -937,205 +913,105 @@ ENDIF
!
!* Snow-free surface albedo for each wavelength
!
- CALL ISBA_ALBEDO(IM%I%TSNOW%SCHEME, IM%I%LTR_ML, GMEB, &
- ZP_DIR_SW, ZP_SCA_SW, PSW_BANDS,ISWB, &
- IM%PKI%XP_ALBNIR, IM%PKI%XP_ALBVIS, IM%PKI%XP_ALBUV, &
- IM%PKI%XP_ALBNIR_VEG, IM%PKI%XP_ALBVIS_VEG, IM%PKI%XP_ALBUV_VEG, &
- IM%PKI%XP_ALBNIR_SOIL, IM%PKI%XP_ALBVIS_SOIL, IM%PKI%XP_ALBUV_SOIL, &
- IM%PKI%XP_ALBF, IM%PKI%XP_FFV, IM%PKI%XP_FFG, &
- ZP_GLOBAL_SW, IM%PKDI%XP_SNOWFREE_ALB, IM%PKDI%XP_SNOWFREE_ALB_VEG, &
- IM%PKDI%XP_SNOWFREE_ALB_SOIL, ZP_MEB_SCA_SW, &
- ZP_ALBNIR_TVEG, ZP_ALBVIS_TVEG, &
- ZP_ALBNIR_TSOIL, ZP_ALBVIS_TSOIL )
+ CALL ISBA_ALBEDO(PEK, IO%LTR_ML, GMEB, ZP_DIR_SW, ZP_SCA_SW, &
+ PSW_BANDS, ISWB, KK%XALBF, KK%XFFV, KK%XFFG, ZP_GLOBAL_SW, &
+ ZP_MEB_SCA_SW, ZP_ALBNIR_TVEG, ZP_ALBVIS_TVEG, &
+ ZP_ALBNIR_TSOIL, ZP_ALBVIS_TSOIL )
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Intialize computation of ISBA water and energy budget
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
- CALL ISBA_BUDGET_INIT(IM%DGEI, &
- IM%I%CISBA,IM%I%TSNOW%SCHEME, &
- IM%PKI%XP_WG,IM%PKI%XP_WGI,IM%PKI%XP_WR,IM%PKI%XP_SNOWSWE, &
- IM%PKI%XP_DG, IM%PKI%XP_DZG, ZP_WG_INI, &
- ZP_WGI_INI, ZP_WR_INI, &
- ZP_SWE_INI )
+ CALL ISBA_BUDGET_INIT(ID%DE%LWATER_BUDGET, IO%CISBA, PEK, PK%XDG, PK%XDZG, &
+ ZP_WG_INI, ZP_WGI_INI, ZP_WR_INI, ZP_SWE_INI )
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Over Natural Land Surfaces:
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
ZIRRIG_GR(:)= 0.
!
- CALL ISBA(IM%I%CISBA, IM%I%CPHOTO, IM%I%LTR_ML, IM%I%CRUNOFF, IM%I%CKSAT, IM%I%CRAIN, &
- IM%I%CHORT, IM%I%CC1DRY, IM%I%CSCOND, IM%I%TSNOW%SCHEME, IM%I%CSNOWRES, &
- IM%I%CCPSURF, IM%I%CSOILFRZ, IM%I%CDIFSFCOND, IM%I%TTIME, IM%I%LFLOOD, &
- IM%I%LTEMP_ARP, IM%I%LGLACIER, GMEB, IM%I%LFORC_MEASURE, IM%I%LMEB_LITTER, &
- IM%I%LMEB_GNDRES, PTSTEP, &
- CIMPLICIT_WIND, IM%I%LAGRI_TO_GRASS, IM%I%LSNOWDRIFT, IM%I%LSNOWDRIFT_SUBLIM, &
- IM%I%LSNOW_ABS_ZENITH, IM%I%CSNOWMETAMO, IM%I%CSNOWRAD, IM%I%XCGMAX, ZP_ZREF, &
- ZP_UREF, ZP_SLOPE_COS, ZP_TA, ZP_QA, ZP_EXNA, ZP_RHOA, ZP_PS, ZP_EXNS, ZP_RAIN, &
- ZP_SNOW, ZP_ZENITH, ZP_MEB_SCA_SW, ZP_GLOBAL_SW, ZP_LW, ZP_WIND, ZP_PEW_A_COEF, &
- ZP_PEW_B_COEF, ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF, &
- IM%PKI%XP_RSMIN, IM%PKI%XP_RGL, IM%PKI%XP_GAMMA, IM%PKI%XP_CV, IM%PKI%XP_RUNOFFD, &
- IM%PKI%XP_SOILWGHT, IM%I%NLAYER_HORT, IM%I%NLAYER_DUN, ZP_ALBNIR_TVEG, ZP_ALBVIS_TVEG, &
- ZP_ALBNIR_TSOIL, ZP_ALBVIS_TSOIL, IM%PKDI%XP_SNOWFREE_ALB, IM%PKI%XP_WRMAX_CF, &
- IM%PKI%XP_VEG, IM%PKI%XP_LAI, IM%PKI%XP_EMIS, IM%PKDI%XP_Z0_WITH_SNOW, &
- IM%PKDI%XP_Z0H_WITH_SNOW, IM%PKI%XP_VEGTYPE_PATCH, IM%PKDI%XP_Z0EFF, &
- IM%PKI%XP_RGLV, IM%PKI%XP_GAMMAV, IM%PKI%XP_RSMINV, &
- IM%PKI%XP_ROOTFRACV, IM%PKI%XP_WRMAX_CFV, IM%PKI%XP_LAIV, IM%PKI%XP_BSLAI, &
- IM%PKI%XP_LAIMIN,IM%PKI%XP_H_VEG,ZPALPHAN, ZZ0G_WITHOUT_SNOW, ZZ0_MEBV, &
- ZZ0H_MEBV,ZZ0EFF_MEBV, ZZ0_MEBN,ZZ0H_MEBN,ZZ0EFF_MEBN, IM%PKI%XP_GNDLITTER, &
- IM%PKI%XP_RUNOFFB, IM%PKI%XP_CGSAT, IM%PKI%XP_C1SAT, IM%PKI%XP_C2REF, &
- IM%PKI%XP_C3, IM%PKI%XP_C4B, IM%PKI%XP_C4REF, IM%PKI%XP_ACOEF, IM%PKI%XP_PCOEF, &
- IM%PKI%XP_TAUICE, IM%PKI%XP_WDRAIN, ZP_TDEEP_A, IM%PKI%XP_TDEEP, IM%PKI%XP_GAMMAT, &
- IM%PKI%XP_PSN, IM%PKI%XP_PSNG, IM%PKI%XP_PSNV, IM%PKI%XP_PSNV_A, &
- IM%PKDI%XP_SNOWFREE_ALB_VEG, IM%PKDI%XP_SNOWFREE_ALB_SOIL, IM%PKI%XP_IRRIG, &
- IM%PKI%XP_WATSUP, IM%PKI%XP_THRESHOLD, IM%PKI%XP_LIRRIGATE, IM%PKI%XP_LIRRIDAY, &
- IM%PKI%LP_STRESS, IM%PKI%XP_GC, IM%PKI%XP_F2I, IM%PKI%XP_DMAX, IM%PKI%XP_AH, &
- IM%PKI%XP_BH, ZP_CO2, IM%PKI%XP_GMES, IM%I%XPOI, IM%PKI%XP_FZERO, IM%PKI%XP_EPSO, &
- IM%PKI%XP_GAMM, IM%PKI%XP_QDGAMM, IM%PKI%XP_QDGMES, IM%PKI%XP_T1GMES, IM%PKI%XP_T2GMES, &
- IM%PKI%XP_AMAX, IM%PKI%XP_QDAMAX, IM%PKI%XP_T1AMAX, IM%PKI%XP_T2AMAX, IM%I%XABC, &
- IM%PKI%XP_DG, IM%PKI%XP_DZG, IM%PKI%XP_DZDIF, IM%PKI%NK_WG_LAYER, IM%PKI%XP_ROOTFRAC, &
- IM%PKI%XP_WFC, IM%PKI%XP_WWILT, IM%PKI%XP_WSAT, IM%PKI%XP_BCOEF, IM%PKI%XP_CONDSAT, &
- IM%PKI%XP_MPOTSAT, IM%PKI%XP_HCAPSOIL, IM%PKI%XP_CONDDRY, IM%PKI%XP_CONDSLD, IM%PKI%XP_D_ICE, &
- IM%PKI%XP_KSAT_ICE, IM%PKI%XP_MUF, IM%PKI%XP_FF, IM%PKI%XP_FFG, IM%PKI%XP_FFV, ZP_FFGNOS, &
- ZP_FFVNOS, IM%PKI%XP_FFROZEN, IM%PKI%XP_ALBF, IM%PKI%XP_EMISF, IM%PKI%XP_FFLOOD, IM%PKI%XP_PIFLOOD, &
- IM%PKDI%XP_IFLOOD, IM%PKDI%XP_PFLOOD, IM%PKDI%XP_LE_FLOOD, IM%PKDI%XP_LEI_FLOOD, IM%I%XSODELX, &
- IM%PKI%XP_LAT, IM%PKI%XP_LON, IM%PKI%XP_TG, IM%PKI%XP_WG, IM%PKI%XP_WGI, IM%PKI%XP_CPS, &
- IM%PKI%XP_LVTT, IM%PKI%XP_LSTT, IM%PKI%XP_WR, IM%PKI%XP_WRL, IM%PKI%XP_WRLI, IM%PKI%XP_WRVN, &
- IM%PKI%XP_TV, IM%PKI%XP_TL, &
- IM%PKI%XP_RESA, IM%PKI%XP_ANFM, IM%PKI%XP_FSAT, IM%PKI%XP_SNOWALB, IM%PKI%XP_SNOWALBVIS, &
- IM%PKI%XP_SNOWALBNIR, IM%PKI%XP_SNOWALBFIR, IM%PKI%XP_SNOWSWE, IM%PKI%XP_SNOWHEAT, &
- IM%PKI%XP_SNOWRHO, IM%PKI%XP_SNOWGRAN1, IM%PKI%XP_SNOWGRAN2, IM%PKI%XP_SNOWHIST, IM%PKI%XP_SNOWAGE, &
- IM%PKDI%XP_GRNDFLUX, IM%PKDI%XP_HPSNOW, IM%PKDI%XP_SNOWHMASS, IM%PKDI%XP_RNSNOW, IM%PKDI%XP_HSNOW, &
- IM%PKDI%XP_GFLUXSNOW, IM%PKDI%XP_USTARSNOW, IM%PKDI%XP_SRSFC, IM%PKDI%XP_RRSFC, IM%PKDI%XP_LESL, &
- IM%PKI%XP_SNOWEMIS, IM%PKDI%XP_CDSNOW, IM%PKDI%XP_CHSNOW, IM%PKDI%XP_TSRAD, IM%PKDI%XP_TS, &
- IM%PKDI%XP_HV, IM%PKDI%XP_QS, IM%PKDI%XP_SNOWTEMP, IM%PKDI%XP_SNOWLIQ, IM%PKDI%XP_SNOWDZ, &
- IM%PKDI%XP_CG, IM%PKDI%XP_C1, IM%PKDI%XP_C2, IM%PKDI%XP_WGEQ, IM%PKDI%XP_CT, IM%PKDI%XP_CH, IM%PKDI%XP_CD, &
- IM%PKDI%XP_CDN, IM%PKDI%XP_RI, IM%PKDI%XP_HU, IM%PKDI%XP_HUG, ZP_EMIS, IM%PKDI%XP_ALBT, IM%PKDI%XP_RS, &
- IM%PKI%XP_LE, IM%PKDI%XP_RN, IM%PKDI%XP_H, IM%PKDI%XP_LEI, IM%PKDI%XP_LEGI, IM%PKDI%XP_LEG, IM%PKDI%XP_LEV, &
- IM%PKDI%XP_LES, IM%PKDI%XP_LER, IM%PKDI%XP_LETR, IM%PKDI%XP_EVAP, IM%PKDI%XP_GFLUX, IM%PKDI%XP_RESTORE, &
- ZP_USTAR, IM%PKDI%XP_DRAIN, IM%PKDI%XP_RUNOFF, IM%PKDI%XP_MELT, IM%PKDI%XP_MELTADV, IM%PKI%XP_TC, &
- IM%PKI%XP_QC, IM%PKDI%XP_RN_ISBA, IM%PKDI%XP_H_ISBA, IM%PKDI%XP_LEG_ISBA, IM%PKDI%XP_LEGI_ISBA, &
- IM%PKDI%XP_LEV_ISBA, IM%PKDI%XP_LETR_ISBA, IM%PKDI%XP_USTAR_ISBA, IM%PKDI%XP_LER_ISBA, IM%PKDI%XP_LE_ISBA, &
- IM%PKDI%XP_LEI_ISBA, IM%PKDI%XP_GFLUX_ISBA, IM%PKDI%XP_HORT, IM%PKDI%XP_DRIP, IM%PKDI%XP_RRVEG, &
- ZP_AC_AGG, ZP_HU_AGG, IM%PKI%XP_FAPARC, IM%PKI%XP_FAPIRC, IM%PKI%XP_MUS, IM%PKI%XP_LAI_EFFC, IM%PKI%XP_AN, &
- IM%PKI%XP_ANDAY, ZP_RESP_BIOMASS_INST, IM%PKDI%XP_IACAN, IM%PKI%XP_ANF, IM%PKDI%XP_GPP, IM%PKDI%XP_FAPAR, &
- IM%PKDI%XP_FAPIR, IM%PKDI%XP_FAPAR_BS, IM%PKDI%XP_FAPIR_BS, IM%PKDI%XP_IRRIG_FLUX, ZP_DEEP_FLUX, &
- IM%PKDI%XP_SWNET_V, IM%PKDI%XP_SWNET_G, IM%PKDI%XP_SWNET_N, IM%PKDI%XP_SWNET_NS, IM%PKDI%XP_LWNET_V, &
- IM%PKDI%XP_LWNET_G, IM%PKDI%XP_LWNET_N, IM%PKDI%XP_LEVCV, IM%PKDI%XP_LESC, IM%PKDI%XP_H_V_C, &
- IM%PKDI%XP_H_G_C, IM%PKDI%XP_LETRGV, IM%PKDI%XP_LETRCV, IM%PKDI%XP_LERGV, IM%PKDI%XP_LELITTER, &
- IM%PKDI%XP_LELITTERI,IM%PKDI%XP_DRIPLIT,IM%PKDI%XP_RRLIT, IM%PKDI%XP_LERCV, IM%PKDI%XP_H_C_A, &
- IM%PKDI%XP_H_N_C, IM%PKDI%XP_LE_C_A, IM%PKDI%XP_LE_V_C, IM%PKDI%XP_LE_G_C,IM%PKDI%XP_LE_N_C, &
- IM%PKDI%XP_EVAP_N_C, IM%PKDI%XP_EVAP_G_C, IM%PKDI%XP_SR_GN, IM%PKDI%XP_MELTCV, IM%PKDI%XP_FRZCV, &
- IM%PKDI%XP_SWDOWN_GN, IM%PKDI%XP_LWDOWN_GN, ZIRRIG_GR, IM%PKI%XP_TOPQS, IM%PKDI%XP_QSB, IM%PKDI%XP_SUBL, &
- IM%PKI%XP_FWTD, IM%PKI%XP_WTD, IM%PKDI%XP_SNDRIFT )
-!
-ZP_TRAD=IM%PKDI%XP_TSRAD
+ CALL ISBA(IO, KK, PK, PEK, GK, AGK, DK, DEK, DMK, &
+ S%TTIME, S%XPOI, S%XABC, GBK%XIACAN, GMEB, PTSTEP, CIMPLICIT_WIND, &
+ ZP_ZREF, ZP_UREF, ZP_SLOPE_COS, ZP_TA, ZP_QA, ZP_EXNA, ZP_RHOA, &
+ ZP_PS, ZP_EXNS, ZP_RAIN, ZP_SNOW, ZP_ZENITH, ZP_MEB_SCA_SW, ZP_GLOBAL_SW, ZP_LW, &
+ ZP_WIND, ZP_PEW_A_COEF, ZP_PEW_B_COEF, ZP_PET_A_COEF, ZP_PEQ_A_COEF, &
+ ZP_PET_B_COEF, ZP_PEQ_B_COEF, ZP_ALBNIR_TVEG, ZP_ALBVIS_TVEG, ZP_ALBNIR_TSOIL, &
+ ZP_ALBVIS_TSOIL, ZPALPHAN, ZZ0G_WITHOUT_SNOW, ZZ0_MEBV, ZZ0H_MEBV, ZZ0EFF_MEBV, &
+ ZZ0_MEBN, ZZ0H_MEBN, ZZ0EFF_MEBN, ZP_TDEEP_A, ZP_CO2, ZP_FFGNOS, ZP_FFVNOS, &
+ ZP_EMIS, ZP_USTAR, ZP_AC_AGG, ZP_HU_AGG, ZP_RESP_BIOMASS_INST, ZP_DEEP_FLUX, &
+ ZIRRIG_GR )
+!
+ZP_TRAD = DK%XTSRAD
+DK%XLE = PEK%XLE
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Glacier : ice runoff flux (especally for Earth System Model)
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-IF(IM%I%LGLACIER)THEN
-!
- CALL HYDRO_GLACIER(IM%I, &
- PTSTEP,ZP_SNOW,IM%PKI%XP_SNOWRHO,IM%PKI%XP_SNOWSWE,IM%PKI%XP_ICE_STO,IM%PKDI%XP_ICEFLUX)
-!
-ENDIF
+IF(IO%LGLACIER) CALL HYDRO_GLACIER(PTSTEP, ZP_SNOW, PEK, DEK%XICEFLUX)
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Calculation of ISBA water and energy budget (and time tendencies of each reservoir)
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
- CALL ISBA_BUDGET(IM%DGEI, &
- IM%I%CISBA,IM%I%TSNOW%SCHEME,IM%I%LGLACIER,PTSTEP, &
- IM%PKI%XP_WG,IM%PKI%XP_WGI,IM%PKI%XP_WR,IM%PKI%XP_SNOWSWE, &
- IM%PKI%XP_DG,IM%PKI%XP_DZG,ZP_WG_INI,ZP_WGI_INI,ZP_WR_INI, &
- ZP_SWE_INI,ZP_RAIN,ZP_SNOW,IM%PKDI%XP_EVAP,IM%PKDI%XP_DRAIN,&
- IM%PKDI%XP_RUNOFF,IM%PKDI%XP_IFLOOD,IM%PKDI%XP_PFLOOD, &
- IM%PKDI%XP_LE_FLOOD, IM%PKDI%XP_LEI_FLOOD, &
- IM%PKDI%XP_ICEFLUX,IM%PKDI%XP_IRRIG_FLUX,IM%PKDI%XP_SNDRIFT,&
- IM%PKI%XP_LVTT, IM%PKI%XP_LSTT, &
- IM%PKDI%XP_DWG,IM%PKDI%XP_DWGI,IM%PKDI%XP_DWR, &
- IM%PKDI%XP_DSWE,IM%PKDI%XP_WATBUD )
+CALL ISBA_BUDGET(IO, PK, PEK, DEK, ID%DE%LWATER_BUDGET, PTSTEP, ZP_WG_INI, ZP_WGI_INI, &
+ ZP_WR_INI, ZP_SWE_INI, ZP_RAIN, ZP_SNOW, DK%XEVAP )
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Evolution of soil albedo, when depending on surface soil wetness:
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-IF (IM%I%CALBEDO=='EVOL' .AND. IM%I%LECOCLIMAP) THEN
- CALL SOIL_ALBEDO(IM%I%CALBEDO, &
- IM%PKI%XP_WSAT(:,1),IM%PKI%XP_WG(:,1), &
- IM%PKI%XP_ALBVIS_DRY,IM%PKI%XP_ALBNIR_DRY,IM%PKI%XP_ALBUV_DRY, &
- IM%PKI%XP_ALBVIS_WET,IM%PKI%XP_ALBNIR_WET,IM%PKI%XP_ALBUV_WET, &
- IM%PKI%XP_ALBVIS_SOIL,IM%PKI%XP_ALBNIR_SOIL,IM%PKI%XP_ALBUV_SOIL )
+IF (IO%CALBEDO=='EVOL' .AND. IO%LECOCLIMAP) THEN
+ CALL SOIL_ALBEDO(IO%CALBEDO, KK%XWSAT(:,1),PEK%XWG(:,1), KK, PEK, "ALL")
!
- CALL ALBEDO(IM%I%CALBEDO, &
- IM%PKI%XP_ALBVIS_VEG,IM%PKI%XP_ALBNIR_VEG,IM%PKI%XP_ALBUV_VEG,IM%PKI%XP_VEG, &
- IM%PKI%XP_ALBVIS_SOIL,IM%PKI%XP_ALBNIR_SOIL,IM%PKI%XP_ALBUV_SOIL, &
- IM%PKI%XP_ALBVIS,IM%PKI%XP_ALBNIR,IM%PKI%XP_ALBUV )
+ CALL ALBEDO(IO%CALBEDO, PEK )
END IF
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Vegetation evolution for interactive LAI
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-IF (IM%I%CPHOTO=='LAI' .OR. IM%I%CPHOTO=='LST' .OR. IM%I%CPHOTO=='NIT' .OR. IM%I%CPHOTO=='NCB') THEN
- CALL VEGETATION_EVOL(IM%I%CISBA, IM%I%CPHOTO, IM%I%CRESPSL, IM%I%CALBEDO, LAGRIP, IM%I%LTR_ML, &
- IM%I%LNITRO_DILU, IM%I%LAGRI_TO_GRASS, IM%DTI%LIMP_VEG, IM%DTI%LIMP_Z0, IM%DTI%LIMP_EMIS, &
- PTSTEP, KMONTH, KDAY, IM%I%NSPINW, PTIME, IM%PKI%XP_LAT, ZP_RHOA, &
- IM%PKI%XP_DG, IM%PKI%XP_DZG, IM%PKI%NK_WG_LAYER, &
- IM%PKI%XP_TG, IM%PKI%XP_ALBNIR_VEG, IM%PKI%XP_ALBVIS_VEG, IM%PKI%XP_ALBUV_VEG, &
- IM%PKI%XP_ALBNIR_SOIL, IM%PKI%XP_ALBVIS_SOIL, IM%PKI%XP_ALBUV_SOIL, &
- IM%PKI%XP_VEGTYPE_PATCH, IM%PKI%XP_SEFOLD, IM%PKI%XP_ANMAX, IM%PKI%XP_H_TREE, IM%PKI%XP_BSLAI,&
- IM%PKI%XP_LAIMIN, ZP_CO2, IM%PKI%XP_CE_NITRO, IM%PKI%XP_CF_NITRO, IM%PKI%XP_CNA_NITRO, &
- IM%PKI%XP_BSLAI_NITRO, IM%PKI%XP_GMES, IM%PKI%XP_TAU_WOOD, IM%PKI%TP_SEED, &
- IM%PKI%TP_REAP, IM%PKI%XP_AOSIP, IM%PKI%XP_AOSIM, IM%PKI%XP_AOSJP, IM%PKI%XP_AOSJM, &
- IM%PKI%XP_HO2IP, IM%PKI%XP_HO2IM, IM%PKI%XP_HO2JP, IM%PKI%XP_HO2JM, IM%PKI%XP_Z0EFFIP, &
- IM%PKI%XP_Z0EFFIM, IM%PKI%XP_Z0EFFJP, IM%PKI%XP_Z0EFFJM, IM%PKI%XP_LAI, IM%PKI%XP_VEG, &
- IM%PKI%XP_Z0, IM%PKI%XP_ALBNIR, IM%PKI%XP_ALBVIS, IM%PKI%XP_ALBUV, IM%PKI%XP_EMIS, &
- IM%PKI%XP_ANFM, IM%PKI%XP_ANDAY, IM%PKI%XP_BIOMASS, IM%PKI%XP_RESP_BIOMASS, &
- ZP_RESP_BIOMASS_INST, IM%PKI%XP_INCREASE, IM%PKI%XP_TURNOVER, &
+IF (IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') THEN
+ CALL VEGETATION_EVOL(IO, DTI, PK, PEK, LAGRIP, PTSTEP, KMONTH, KDAY, PTIME, GK%XLAT, &
+ ZP_RHOA, ZP_CO2, ISSK, ZP_RESP_BIOMASS_INST, &
! add optional for accurate dependency to nitrogen
! limitation
PSWDIR=ZP_GLOBAL_SW )
END IF
!
-!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Diagnostic of respiration carbon fluxes and soil carbon evolution
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+!ii
+ZP_SFCO2 (:) = 0.
+DEK%XRESP_ECO (:) = 0.
+DEK%XRESP_AUTO(:) = 0.
!
-ZP_SFCO2 (:)=0.
-IM%PKDI%XP_RESP_ECO (:)=0.
-IM%PKDI%XP_RESP_AUTO(:)=0.
-!
-IF ( IM%I%CPHOTO/='NON' .AND. IM%I%CRESPSL/='NON' .AND. ANY(IM%PKI%XP_LAI(:)/=XUNDEF) ) THEN
- CALL CARBON_EVOL(IM%I%CISBA, IM%I%CRESPSL, IM%I%CPHOTO, PTSTEP, IM%I%NSPINS, &
- ZP_RHOA, IM%PKI%XP_TG, IM%PKI%XP_WG, IM%PKI%XP_WFC, IM%PKI%XP_WWILT, IM%PKI%XP_WSAT, IM%PKI%XP_SAND,&
- IM%PKI%XP_DG, IM%PKI%XP_DZG, IM%PKI%NK_WG_LAYER, &
- IM%PKI%XP_RE25, IM%PKI%XP_LAI, ZP_RESP_BIOMASS_INST, IM%PKI%XP_TURNOVER, &
- IM%PKI%XP_LITTER, IM%PKI%XP_LIGNIN_STRUC , IM%PKI%XP_SOILCARB, &
- IM%PKDI%XP_RESP_AUTO, IM%PKDI%XP_RESP_ECO )
+IF ( IO%CPHOTO/='NON' .AND. IO%CRESPSL/='NON' .AND. ANY(PEK%XLAI(:)/=XUNDEF) ) THEN
+ CALL CARBON_EVOL(IO, KK, PK, PEK, DEK, PTSTEP, ZP_RHOA, ZP_RESP_BIOMASS_INST )
! calculation of vegetation CO2 flux
! Positive toward the atmosphere
- ZP_SFCO2(:) = IM%PKDI%XP_RESP_ECO(:) - IM%PKDI%XP_GPP(:)
+ ZP_SFCO2(:) = DEK%XRESP_ECO(:) - DEK%XGPP(:)
END IF
!
+IF ( IO%CPHOTO/='NON') THEN
+ DEK%XGPP(:) = DEK%XGPP(:) * ZP_RHOA(:)
+ DEK%XRESP_ECO(:) = DEK%XRESP_ECO(:) * ZP_RHOA(:)
+ DEK%XRESP_AUTO(:) = DEK%XRESP_AUTO(:) * ZP_RHOA(:)
+ENDIF
+!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Reset effecitve roughness lentgh to its nominal value when snow has just disappeared
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
- CALL SUBSCALE_Z0EFF(IM%PKI%XP_AOSIP,IM%PKI%XP_AOSIM,IM%PKI%XP_AOSJP,IM%PKI%XP_AOSJM, &
- IM%PKI%XP_HO2IP,IM%PKI%XP_HO2IM,IM%PKI%XP_HO2JP,IM%PKI%XP_HO2JM,IM%PKI%XP_Z0, &
- IM%PKI%XP_Z0EFFIP,IM%PKI%XP_Z0EFFIM,IM%PKI%XP_Z0EFFJP,IM%PKI%XP_Z0EFFJM, &
- OMASK=(IM%PKI%XP_SNOWSWE(:,1)==0. .AND. IM%PKI%XP_PSN(:)>0.) )
+ CALL SUBSCALE_Z0EFF(ISSK,PEK%XZ0(:),.FALSE.,OMASK=(PEK%TSNOW%WSNOW(:,1)==0. .AND. PEK%XPSN(:)>0.) )
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Turbulent fluxes
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-ZP_SFTH(:) = IM%PKDI%XP_H(:)
-ZP_SFTQ(:) = IM%PKDI%XP_EVAP(:)
+ZP_SFTH(:) = DK%XH(:)
+ZP_SFTQ(:) = DK%XEVAP(:)
ZP_SFU (:) = 0.
ZP_SFV (:) = 0.
@@ -1155,29 +1031,31 @@ ZP_SFTS(:,:) = 0.
! --------------------------------------------------------------------------------------
! Chemical dry deposition :
! --------------------------------------------------------------------------------------
-IF (IM%CHI%SVI%NBEQ>0) THEN
- IF( IM%CHI%CCH_DRY_DEP == "WES89") THEN
+IF (CHI%SVI%NBEQ>0) THEN
+ IF( CHI%CCH_DRY_DEP == "WES89") THEN
- CALL CH_DEP_ISBA (ZP_USTAR, IM%PKDI%XP_HU, IM%PKI%XP_PSN, &
- IM%PKI%XP_VEG, IM%PKI%XP_LAI, IM%PKI%XP_SAND, IM%PKI%XP_CLAY, IM%PKI%XP_RESA, &
- IM%PKDI%XP_RS(:), IM%PKI%XP_Z0(:), &
- ZP_TA, ZP_PA, ZP_TRAD(:), &
- IM%PKI%XP_VEGTYPE_PATCH(:,NVT_NO), &
- IM%PKI%XP_VEGTYPE_PATCH(:,NVT_ROCK), &
- IM%CHI%SVI%CSV(IM%CHI%SVI%NSV_CHSBEG:IM%CHI%SVI%NSV_CHSEND), &
- IM%PKCI%XP_SOILRC_SO2, IM%PKCI%XP_SOILRC_O3 , &
- IM%PKCI%XP_DEP(:,1:IM%CHI%SVI%NBEQ) )
+ IBEG = CHI%SVI%NSV_CHSBEG
+ IEND = CHI%SVI%NSV_CHSEND
+ ISIZE = IEND - IBEG + 1
+
+ CALL CH_DEP_ISBA(KK, PK, PEK, DK, DMK, CHIK, &
+ ZP_USTAR, ZP_TA, ZP_PA, ZP_TRAD(:), ISIZE )
- ZP_SFTS(:,IM%CHI%SVI%NSV_CHSBEG:IM%CHI%SVI%NSV_CHSEND) = - ZP_SV(:,IM%CHI%SVI%NSV_CHSBEG:IM%CHI%SVI%NSV_CHSEND) &
- * IM%PKCI%XP_DEP(:,1:IM%CHI%SVI%NBEQ)
- IF (IM%CHI%SVI%NAEREQ > 0 ) THEN
- CALL CH_AER_DEP(ZP_SV(:,IM%CHI%SVI%NSV_AERBEG:IM%CHI%SVI%NSV_AEREND),&
- ZP_SFTS(:,IM%CHI%SVI%NSV_AERBEG:IM%CHI%SVI%NSV_AEREND),&
- ZP_USTAR, IM%PKI%XP_RESA,ZP_TA,ZP_RHOA)
+ ZP_SFTS(:,IBEG:IEND) = - ZP_SV(:,IBEG:IEND) * CHIK%XDEP(:,1:CHI%SVI%NBEQ)
+
+ IF (CHI%SVI%NAEREQ > 0 ) THEN
+
+ IBEG = CHI%SVI%NSV_AERBEG
+ IEND = CHI%SVI%NSV_AEREND
+ CALL CH_AER_DEP(ZP_SV(:,IBEG:IEND), ZP_SFTS(:,IBEG:IEND), ZP_USTAR, PEK%XRESA, ZP_TA, ZP_RHOA)
END IF
ELSE
- ZP_SFTS(:,IM%CHI%SVI%NSV_CHSBEG:IM%CHI%SVI%NSV_CHSEND) = 0.
- ZP_SFTS(:,IM%CHI%SVI%NSV_AERBEG:IM%CHI%SVI%NSV_AEREND) = 0.
+
+ IBEG = CHI%SVI%NSV_AERBEG
+ IEND = CHI%SVI%NSV_AEREND
+ ZP_SFTS(:,IBEG:IEND) = 0.
+ ZP_SFTS(:,IBEG:IEND) = 0.
+
ENDIF
ENDIF
!
@@ -1185,39 +1063,30 @@ ENDIF
! Dust deposition and emission:
! --------------------------------------------------------------------------------------
!
-IF(IM%CHI%SVI%NDSTEQ>0)THEN
- IDST = IM%CHI%SVI%NSV_DSTEND - IM%CHI%SVI%NSV_DSTBEG + 1
+IF(CHI%SVI%NDSTEQ>0)THEN
+
+ IBEG = CHI%SVI%NSV_DSTBEG
+ IEND = CHI%SVI%NSV_DSTEND
+ IDST = IEND - IBEG + 1
- CALL COUPLING_DST_n(DST, IM%PKI, &
+ CALL COUPLING_DST_n(DSTK, KK, PK, PEK, DK, &
HPROGRAM, &!I [char] Name of program
- KSIZE, &!I [nbr] number of points in patch
+ PK%NSIZE_P, &!I [nbr] number of points in patch
IDST, &!I [nbr] number of dust emissions variables
- JPATCH, &!I [idx] patch in question
- IM%PKI%XP_CLAY(:,1), &!I [frc] mass fraction clay in first soil layer
ZP_PS, &!I [Pa] surface pressure
- IM%PKDI%XP_TS, &!I [K] surface temperature
ZP_QA, &!I [kg/kg] specific humidity
- IM%PKI%XP_RESA, &!I [s/m] atmospheric resistance
ZP_RHOA, &!I [kg/m3] atmospheric density
- IM%PKI%XP_SAND(:,1), &!I [frc] mass fraction of sand in first soil layer
ZP_PA, &!I [K] Atmospheric pressure
ZP_TA, &!I [K] Atmospheric temperature
- IM%PKI%XP_TG(:,1), &!I [K] Ground temperature
ZP_U, &!I [m/s] zonal wind at atmospheric height
ZP_UREF, &!I [m] reference height of wind
ZP_V, &!I [m/s] meridional wind at atmospheric height
- IM%PKI%XP_WG(:,1), &!I [m3/m3] ground volumetric water content
- IM%PKI%XP_WSAT(:,1), &!I [m3/m3] saturation volumetric water content
ZP_ZREF, &!I [m] reference height of wind
- IM%PKDI%XP_CD, &!I [] Drag Coefficient for momentum
- IM%PKDI%XP_CDN, &!I [] Drag neutral Coefficient for momentum
- IM%PKDI%XP_CH, &!I [] drag coefficient for heat
- IM%PKDI%XP_RI, &!I [] Richardson number
- IM%PKDI%XP_Z0H_WITH_SNOW, &!I [frc] Z0 (heat) with snow
- ZP_SFTS(:,IM%CHI%SVI%NSV_DSTBEG:IM%CHI%SVI%NSV_DSTEND) &!O [kg/m2/sec] flux of dust
+ ZP_SFTS(:,IBEG:IEND) &!O [kg/m2/sec] flux of dust
)
!
- IF (IM%CHI%SVI%NSV_AEREND > 0) THEN ! case of dust/ anthropogenic aerosols coupling
+ IF (CHI%SVI%NSV_AEREND > 0) THEN ! case of dust/ anthropogenic aerosols coupling
+
DO JMODE=1,NDSTMDE
!
!Make index which is 0 for first mode, 3 for second, 6 for third etc
@@ -1232,11 +1101,11 @@ IF(IM%CHI%SVI%NDSTEQ>0)THEN
DO JSV=1, size(HSV)
IF ((TRIM(HSV(JSV)) == "@DSTI").AND.(JMODE==3)) THEN
! add dust flux and conversion kg/m2/s into molec.m2/s
- ZP_SFTS(:,JSV) = ZP_SFTS(:,JSV) + ZP_SFTS(:,IM%CHI%SVI%NSV_DSTBEG-1+JSV_IDX+2)*XAVOGADRO/XMOLARWEIGHT_DST
+ ZP_SFTS(:,JSV) = ZP_SFTS(:,JSV) + ZP_SFTS(:,IBEG-1+JSV_IDX+2)*XAVOGADRO/XMOLARWEIGHT_DST
END IF
IF ( (TRIM(HSV(JSV)) == "@DSTJ").AND.(JMODE==2)) THEN
! add dust flux and conversion kg/m2/sec into molec.m2/s
- ZP_SFTS(:,JSV) = ZP_SFTS(:,JSV) + ZP_SFTS(:,IM%CHI%SVI%NSV_DSTBEG-1+JSV_IDX+2)*XAVOGADRO/XMOLARWEIGHT_DST
+ ZP_SFTS(:,JSV) = ZP_SFTS(:,JSV) + ZP_SFTS(:,IBEG-1+JSV_IDX+2)*XAVOGADRO/XMOLARWEIGHT_DST
END IF
END DO
!
@@ -1244,19 +1113,17 @@ IF(IM%CHI%SVI%NDSTEQ>0)THEN
END IF
!
!Modify fluxes due to dry deposition, we introduce a negative flux where dust is lost
- CALL DSLT_DEP(ZP_SV(:,IM%CHI%SVI%NSV_DSTBEG:IM%CHI%SVI%NSV_DSTEND), &
- ZP_SFTS(:,IM%CHI%SVI%NSV_DSTBEG:IM%CHI%SVI%NSV_DSTEND), &
- ZP_USTAR, IM%PKI%XP_RESA, ZP_TA, ZP_RHOA, DST%XEMISSIG_DST, DST%XEMISRADIUS_DST, &
- JPMODE_DST, XDENSITY_DST, XMOLARWEIGHT_DST, ZCONVERTFACM0_DST, &
- ZCONVERTFACM6_DST, ZCONVERTFACM3_DST, LVARSIG_DST, LRGFIX_DST, &
- CVERMOD )
+ CALL DSLT_DEP(ZP_SV(:,IBEG:IEND), ZP_SFTS(:,IBEG:IEND), ZP_USTAR, PEK%XRESA, &
+ ZP_TA, ZP_RHOA, DSTK%XEMISSIG_DST, DSTK%XEMISRADIUS_DST, JPMODE_DST, &
+ XDENSITY_DST, XMOLARWEIGHT_DST, ZCONVERTFACM0_DST, ZCONVERTFACM6_DST, &
+ ZCONVERTFACM3_DST, LVARSIG_DST, LRGFIX_DST, CVERMOD )
!
!Transfer these fluxes to fluxes understandable by all moments
CALL MASSFLUX2MOMENTFLUX( &
- ZP_SFTS(:,IM%CHI%SVI%NSV_DSTBEG:IM%CHI%SVI%NSV_DSTEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
+ ZP_SFTS(:,IBEG:IEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
ZP_RHOA, & !I [kg/m3] air density
- DST%XEMISRADIUS_DST, &!I [um] emitted radius for the modes (max 3)
- DST%XEMISSIG_DST, &!I [-] emitted sigma for the different modes (max 3)
+ DSTK%XEMISRADIUS_DST, & !I [um] emitted radius for the modes (max 3)
+ DSTK%XEMISSIG_DST, & !I [-] emitted sigma for the different modes (max 3)
NDSTMDE, &
ZCONVERTFACM0_DST, &
ZCONVERTFACM6_DST, &
@@ -1269,19 +1136,21 @@ ENDIF !Check on CDSTYN
! Sea Salt deposition
! --------------------------------------------------------------------------------------
!
-IF (IM%CHI%SVI%NSLTEQ>0) THEN
- CALL DSLT_DEP(ZP_SV(:,IM%CHI%SVI%NSV_SLTBEG:IM%CHI%SVI%NSV_SLTEND), &
- ZP_SFTS(:,IM%CHI%SVI%NSV_SLTBEG:IM%CHI%SVI%NSV_SLTEND), &
- ZP_USTAR, IM%PKI%XP_RESA, ZP_TA, ZP_RHOA, SLT%XEMISSIG_SLT, SLT%XEMISRADIUS_SLT, &
- JPMODE_SLT, XDENSITY_SLT, XMOLARWEIGHT_SLT, ZCONVERTFACM0_SLT, &
- ZCONVERTFACM6_SLT, ZCONVERTFACM3_SLT, LVARSIG_SLT, LRGFIX_SLT, &
- CVERMOD )
+IF (CHI%SVI%NSLTEQ>0) THEN
+ !
+ IBEG = CHI%SVI%NSV_SLTBEG
+ IEND = CHI%SVI%NSV_SLTEND
+ !
+ CALL DSLT_DEP(ZP_SV(:,IBEG:IEND), ZP_SFTS(:,IBEG:IEND), ZP_USTAR, PEK%XRESA, &
+ ZP_TA, ZP_RHOA, SLT%XEMISSIG_SLT, SLT%XEMISRADIUS_SLT, JPMODE_SLT, &
+ XDENSITY_SLT, XMOLARWEIGHT_SLT, ZCONVERTFACM0_SLT, ZCONVERTFACM6_SLT, &
+ ZCONVERTFACM3_SLT, LVARSIG_SLT, LRGFIX_SLT, CVERMOD )
CALL MASSFLUX2MOMENTFLUX( &
- ZP_SFTS(:,IM%CHI%SVI%NSV_SLTBEG:IM%CHI%SVI%NSV_SLTEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
+ ZP_SFTS(:,IBEG:IEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
ZP_RHOA, & !I [kg/m3] air density
- SLT%XEMISRADIUS_SLT, &!I [um] emitted radius for the modes (max 3)
- SLT%XEMISSIG_SLT, &!I [-] emitted sigma for the different modes (max 3)
+ SLT%XEMISRADIUS_SLT, & !I [um] emitted radius for the modes (max 3)
+ SLT%XEMISSIG_SLT, & !I [-] emitted sigma for the different modes (max 3)
NSLTMDE, &
ZCONVERTFACM0_SLT, &
ZCONVERTFACM6_SLT, &
@@ -1293,15 +1162,9 @@ ENDIF !Check on CSLTYN
! Inline diagnostics
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
- CALL DIAG_INLINE_ISBA_n(IM%DGEI, IM%DGI, IM%I, IM%PKDI, &
- ZP_TA, IM%PKDI%XP_TS, ZP_QA, ZP_PA, ZP_PS, ZP_RHOA, ZP_U, ZP_V, &
- ZP_ZREF, ZP_UREF, &
- IM%PKDI%XP_CD, IM%PKDI%XP_CDN, IM%PKDI%XP_CH, IM%PKDI%XP_RI, &
- IM%PKDI%XP_HU, IM%PKDI%XP_Z0_WITH_SNOW, &
- IM%PKDI%XP_Z0H_WITH_SNOW, IM%PKDI%XP_Z0EFF, &
- ZP_SFTH, ZP_SFTQ, ZP_SFU, ZP_SFV, IM%PKDI%XP_QS, &
- IM%PKI%XP_DIR_ALB_WITH_SNOW, IM%PKI%XP_SCA_ALB_WITH_SNOW, &
- ZP_DIR_SW, ZP_SCA_SW, ZP_LW, IM%PKDI%XP_RN )
+ CALL DIAG_INLINE_ISBA_n(ID%O, KK, DK, IO%LCANOPY, ZP_TA, ZP_QA, ZP_PA, &
+ ZP_PS, ZP_RHOA, ZP_U, ZP_V, ZP_ZREF, ZP_UREF, ZP_SFTH, &
+ ZP_SFTQ, ZP_SFU, ZP_SFV, ZP_DIR_SW, ZP_SCA_SW, ZP_LW )
!
!
!-------------------------------------------------------------------------------
@@ -1310,10 +1173,10 @@ ENDIF !Check on CSLTYN
!difficult to do. Maybe it will be done later. However, Ts can be at time t+1
!-------------------------------------------------------------------------------
!
-ZP_TSURF (:) = IM%PKDI%XP_TS (:)
-ZP_Z0 (:) = IM%PKDI%XP_Z0_WITH_SNOW (:)
-ZP_Z0H (:) = IM%PKDI%XP_Z0H_WITH_SNOW(:)
-ZP_QSURF (:) = IM%PKDI%XP_QS (:)
+ZP_TSURF (:) = DK%XTS (:)
+ZP_Z0 (:) = DK%XZ0 (:)
+ZP_Z0H (:) = DK%XZ0H(:)
+ZP_QSURF (:) = DK%XQS (:)
!
!-------------------------------------------------------------------------------
!
@@ -1321,60 +1184,49 @@ ZP_QSURF (:) = IM%PKDI%XP_QS (:)
! Isba offline diagnostics for each patch
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
- CALL DIAG_EVAP_ISBA_n(IM%DGEI, IM%DGI, IM%I, IM%PKDI, IM%PKI, &
- IM%I%CPHOTO,PTSTEP,KMASK,KSIZE,JPATCH,ZP_RHOA)
+ CALL DIAG_EVAP_CUMUL_ISBA_n(ID%O%LSURF_BUDGETC, ID%DE, DECK, DCK, DEK, DK, PEK, &
+ IO, PTSTEP, PK%NSIZE_P, JP, ZP_RHOA)
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Isba offline diagnostics for miscellaneous terms over each patch
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
- CALL DIAG_MISC_ISBA_n(IM%DGMI, IM%PKDI, &
- PTSTEP, IM%I%CISBA, IM%I%CPHOTO, IM%I%TSNOW%SCHEME, LAGRIP, IM%I%LTR_ML, &
- PTIME, KSIZE, JPATCH, KMASK, IM%PKI%XP_THRESHOLD, &
- IM%PKI%XP_PSN, IM%PKI%XP_PSNG, IM%PKI%XP_PSNV, IM%PKI%XP_FF, IM%PKI%XP_FFG, IM%PKI%XP_FFV, &
- IM%PKI%XP_WG, IM%PKI%XP_WGI, IM%PKI%XP_WFC, IM%PKI%XP_WWILT, IM%PKI%XP_SNOWSWE, IM%PKI%XP_SNOWRHO,&
- IM%PKI%XP_FAPARC, IM%PKI%XP_FAPIRC, IM%PKI%XP_LAI_EFFC, IM%PKI%XP_MUS, IM%PKI%XP_FSAT, &
- IM%PKI%XP_DG, IM%PKI%XP_TG )
+ CALL DIAG_MISC_ISBA_n(DMK, KK, PK, PEK, AGK, IO, ID%DM%LSURF_MISC_BUDGET, &
+ ID%DM%LVOLUMETRIC_SNOWLIQ, PTSTEP, LAGRIP, PTIME, PK%NSIZE_P )
+!
+ CALL REPROJ_DIAG_ISBA_n(DK, DEK, DMK, PEK, ID%O%LSURF_BUDGET, ID%DE%LSURF_EVAP_BUDGET, &
+ ID%DE%LWATER_BUDGET, ID%DM%LSURF_MISC_BUDGET, ID%DM%LPROSNOW, &
+ IO%LMEB_PATCH(JP), ZP_SLOPE_COS)
!
! Unpack ISBA diagnostics (modd_diag_isban) for each patch:ISIZE_MAX = MAXVAL(NSIZE_NATURE_P)
! (MUST be done BEFORE UNPACK_ISBA_PATCH, because of XP_LE)
!
- CALL UNPACK_DIAG_PATCH_n(IM%DGI, IM%GB, IM%I, IM%PKDI, IM%PKI, &
- KMASK,KSIZE,IM%I%NPATCH,JPATCH, &
- ZCPL_DRAIN,ZCPL_RUNOFF,ZCPL_EFLOOD,ZCPL_PFLOOD, &
- ZCPL_IFLOOD, ZCPL_ICEFLUX)
-!
-! for chemical deposition
-!
-IF (IM%CHI%SVI%NBEQ>0) THEN
- IF( IM%CHI%CCH_DRY_DEP == "WES89") THEN
- CALL UNPACK_CH_ISBA_PATCH_n(IM%CHI, IM%PKCI, &
- KMASK,KSIZE,IM%I%NPATCH,JPATCH)
- END IF
-END IF
-!
-! Unpack ISBA variables (modd_isban) for each patch:
+IF (PEK%TSNOW%SCHEME=='3-L'.OR.PEK%TSNOW%SCHEME=='CRO') THEN
+ PEK%TSNOW%TEMP(:,:) = DMK%XSNOWTEMP(:,:)
+ PEK%TSNOW%TS (:) = DMK%XSNOWTEMP(:,1)
+ENDIF
!
- CALL UNPACK_ISBA_PATCH_n(IM%AG, IM%I, IM%PKI, &
- KMASK,KSIZE,JPATCH)
+
+ CALL UNPACK_DIAG_PATCH_n(IO, DEK, PK, PK%NR_P, PK%NSIZE_P, IO%NPATCH, JP, &
+ ZCPL_DRAIN, ZCPL_RUNOFF, ZCPL_EFLOOD, ZCPL_PFLOOD, &
+ ZCPL_IFLOOD, ZCPL_ICEFLUX)
!
!----------------------------------------------------------------------
!
! for further chemical biogenic emissions
!
-IF (IM%CHI%SVI%NBEQ>0 .AND. IM%CHI%LCH_BIO_FLUX) THEN
+IF (CHI%SVI%NBEQ>0 .AND. CHI%LCH_BIO_FLUX) THEN
!
- DO JJ=1,KSIZE
- ZSW_FORBIO(KMASK(JJ),JPATCH) = 0.
+ DO JJ=1,PK%NSIZE_P
+ ZSW_FORBIO(PK%NR_P(JJ),JP) = 0.
ENDDO
!
DO JSWB=1,ISWB
!cdir nodep
!cdir unroll=8
- DO JJ=1,KSIZE
- ZSW_FORBIO(KMASK(JJ),JPATCH) = ZSW_FORBIO(KMASK(JJ),JPATCH) &
- + ZP_DIR_SW(JJ,JSWB) + ZP_SCA_SW(JJ,JSWB)
+ DO JJ=1,PK%NSIZE_P
+ ZSW_FORBIO(PK%NR_P(JJ),JP) = ZSW_FORBIO(PK%NR_P(JJ),JP) + ZP_DIR_SW(JJ,JSWB) + ZP_SCA_SW(JJ,JSWB)
ENDDO
ENDDO
!
@@ -1383,41 +1235,41 @@ ENDIF
!
! Unpack output dummy arguments for each patch:
!
-IF (IM%I%NPATCH==1) THEN
- ZSFTQ_TILE (:,JPATCH) = ZP_SFTQ (:)
- ZSFTH_TILE (:,JPATCH) = ZP_SFTH (:)
- ZSFTS_TILE (:,:,JPATCH)= ZP_SFTS (:,:)
- ZSFCO2_TILE (:,JPATCH) = ZP_SFCO2 (:)
- ZSFU_TILE (:,JPATCH) = ZP_SFU (:)
- ZSFV_TILE (:,JPATCH) = ZP_SFV (:)
- ZTRAD_TILE (:,JPATCH) = ZP_TRAD (:)
- ZTSURF_TILE (:,JPATCH) = ZP_TSURF (:)
- ZZ0_TILE (:,JPATCH) = ZP_Z0 (:)
- ZZ0H_TILE (:,JPATCH) = ZP_Z0H (:)
- ZQSURF_TILE (:,JPATCH) = ZP_QSURF (:)
+IF (IO%NPATCH==1) THEN
+ ZSFTQ_TILE (:,JP) = ZP_SFTQ (:)
+ ZSFTH_TILE (:,JP) = ZP_SFTH (:)
+ ZSFTS_TILE (:,:,JP)= ZP_SFTS (:,:)
+ ZSFCO2_TILE (:,JP) = ZP_SFCO2 (:)
+ ZSFU_TILE (:,JP) = ZP_SFU (:)
+ ZSFV_TILE (:,JP) = ZP_SFV (:)
+ ZTRAD_TILE (:,JP) = ZP_TRAD (:)
+ ZTSURF_TILE (:,JP) = ZP_TSURF (:)
+ ZZ0_TILE (:,JP) = ZP_Z0 (:)
+ ZZ0H_TILE (:,JP) = ZP_Z0H (:)
+ ZQSURF_TILE (:,JP) = ZP_QSURF (:)
ELSE
!cdir nodep
!cdir unroll=8
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- ZSFTQ_TILE (JI,JPATCH) = ZP_SFTQ (JJ)
- ZSFTH_TILE (JI,JPATCH) = ZP_SFTH (JJ)
- ZSFCO2_TILE (JI,JPATCH) = ZP_SFCO2 (JJ)
- ZSFU_TILE (JI,JPATCH) = ZP_SFU (JJ)
- ZSFV_TILE (JI,JPATCH) = ZP_SFV (JJ)
- ZTRAD_TILE (JI,JPATCH) = ZP_TRAD (JJ)
- ZTSURF_TILE (JI,JPATCH) = ZP_TSURF (JJ)
- ZZ0_TILE (JI,JPATCH) = ZP_Z0 (JJ)
- ZZ0H_TILE (JI,JPATCH) = ZP_Z0H (JJ)
- ZQSURF_TILE (JI,JPATCH) = ZP_QSURF (JJ)
+ DO JJ=1,PK%NSIZE_P
+ JI = PK%NR_P(JJ)
+ ZSFTQ_TILE (JI,JP) = ZP_SFTQ (JJ)
+ ZSFTH_TILE (JI,JP) = ZP_SFTH (JJ)
+ ZSFCO2_TILE (JI,JP) = ZP_SFCO2 (JJ)
+ ZSFU_TILE (JI,JP) = ZP_SFU (JJ)
+ ZSFV_TILE (JI,JP) = ZP_SFV (JJ)
+ ZTRAD_TILE (JI,JP) = ZP_TRAD (JJ)
+ ZTSURF_TILE (JI,JP) = ZP_TSURF (JJ)
+ ZZ0_TILE (JI,JP) = ZP_Z0 (JJ)
+ ZZ0H_TILE (JI,JP) = ZP_Z0H (JJ)
+ ZQSURF_TILE (JI,JP) = ZP_QSURF (JJ)
ENDDO
!
!cdir nodep
!cdir unroll=8
DO JK=1,SIZE(ZP_SFTS,2)
- DO JJ=1,KSIZE
- JI=KMASK(JJ)
- ZSFTS_TILE (JI,JK,JPATCH)= ZP_SFTS (JJ,JK)
+ DO JJ=1,PK%NSIZE_P
+ JI=PK%NR_P(JJ)
+ ZSFTS_TILE (JI,JK,JP)= ZP_SFTS (JJ,JK)
ENDDO
ENDDO
ENDIF
@@ -1426,15 +1278,15 @@ ENDIF
!
! Get output dust flux if we are calculating dust
IF (NDSTMDE .GE. 1) IMOMENT = INT(IDST / NDSTMDE)
-IF (IM%CHI%SVI%NDSTEQ>0) THEN
+IF (CHI%SVI%NDSTEQ>0) THEN
DO JSV = 1,NDSTMDE
IF (IMOMENT == 1) THEN
- DST%XSFDST(:,JSV,JPATCH)=ZSFTS_TILE(:,NDST_MDEBEG+JSV-1,JPATCH)
+ DSTK%XSFDST(:,JSV) = ZSFTS_TILE(:,NDST_MDEBEG+JSV-1,JP)
ELSE
- DST%XSFDST(:,JSV,JPATCH)=ZSFTS_TILE(:,NDST_MDEBEG+(JSV-1)*IMOMENT+1,JPATCH)
+ DSTK%XSFDST(:,JSV) = ZSFTS_TILE(:,NDST_MDEBEG+(JSV-1)*IMOMENT+1,JP)
END IF
- DST%XSFDSTM(:,JSV,JPATCH)=DST%XSFDSTM(:,JSV,JPATCH) + DST%XSFDST(:,JSV,JPATCH) * PTSTEP
+ DSTK%XSFDSTM(:,JSV) = DSTK%XSFDSTM(:,JSV) + DSTK%XSFDST(:,JSV) * PTSTEP
ENDDO
ENDIF
!
diff --git a/src/SURFEX/coupling_naturen.F90 b/src/SURFEX/coupling_naturen.F90
index 179e50120baeb7737f9b87a90e137df7ac768e24..b811555bedc1ccab0933db5090d24fe73d7cd9f1 100644
--- a/src/SURFEX/coupling_naturen.F90
+++ b/src/SURFEX/coupling_naturen.F90
@@ -3,16 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################################
-SUBROUTINE COUPLING_NATURE_n (DTCO, UG, U, USS, IM, DTZ, DTGD, DTGR, TGRO, DGL, DST, SLT, &
- HPROGRAM, HCOUPLING, PTIMEC, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, &
- PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+SUBROUTINE COUPLING_NATURE_n (DTCO, UG, U, USS, IM, DTZ, DGO, DL, DLC, NDST, SLT, &
+ HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
+ KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PZS,&
+ PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, &
+ PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, &
+ PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, &
+ PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, &
+ PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST )
! ###############################################################################
!
!!**** *COUPLING_NATURE_n * - Chooses the surface schemes for natural continental parts
@@ -38,20 +36,15 @@ SUBROUTINE COUPLING_NATURE_n (DTCO, UG, U, USS, IM, DTZ, DTGD, DTGR, TGRO, DGL,
!! P. Le Moigne 03/2015 tsz0 time management
!!--------------------------------------------------------------------
!
-!
-!
USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
USE MODD_DATA_TSZ0_n, ONLY : DATA_TSZ0_t
-USE MODD_DATA_TEB_GARDEN_n, ONLY : DATA_TEB_GARDEN_t
-USE MODD_DATA_TEB_GREENROOF_n, ONLY : DATA_TEB_GREENROOF_t
-USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
-USE MODD_DST_n, ONLY : DST_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
+USE MODD_DST_n, ONLY : DST_NP_t
USE MODD_SLT_n, ONLY : SLT_t
!
USE MODD_CSTS, ONLY : XTT
@@ -69,18 +62,16 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-!
TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
TYPE(DATA_TSZ0_t), INTENT(INOUT) :: DTZ
-TYPE(DATA_TEB_GARDEN_t), INTENT(INOUT) :: DTGD
-TYPE(DATA_TEB_GREENROOF_t), INTENT(INOUT) :: DTGR
-TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: TGRO
-TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
-TYPE(DST_t), INTENT(INOUT) :: DST
+TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: DL
+TYPE(DIAG_t), INTENT(INOUT) :: DLC
+TYPE(DST_NP_t), INTENT(INOUT) :: NDST
TYPE(SLT_t), INTENT(INOUT) :: SLT
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
@@ -159,44 +150,31 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('COUPLING_NATURE_N',0,ZHOOK_HANDLE)
IF (U%CNATURE=='ISBA ') THEN
- CALL COUPLING_ISBA_SVAT_n(DTCO, UG, U, USS, IM, DTGD, DTGR, TGRO, DST, SLT, &
- HPROGRAM, HCOUPLING, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- KI,KSV,KSW, &
- PTSUN, PZENITH, PZENITH2, PAZIM, &
- PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- 'OK' )
+ CALL COUPLING_ISBA_SVAT_n(DTCO, UG, U, USS, IM, NDST, SLT, HPROGRAM, HCOUPLING, PTSTEP, &
+ KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, &
+ PZENITH2, PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV,&
+ PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, &
+ PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, &
+ PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, &
+ PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF,'OK')
ELSE IF (U%CNATURE=='TSZ0 ') THEN
- CALL COUPLING_TSZ0_n(DTCO, UG, U, USS, IM, DTZ, DTGD, DTGR, TGRO, DST, SLT, &
- HPROGRAM, HCOUPLING, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIMEC, &
- KI,KSV,KSW, &
- PTSUN, PZENITH, PZENITH2, PAZIM, &
- PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- 'OK' )
+ CALL COUPLING_TSZ0_n(DTCO, UG, U, USS, IM, DTZ, NDST, SLT, &
+ HPROGRAM, HCOUPLING, PTSTEP, KYEAR, KMONTH, KDAY, PTIMEC, KI, &
+ KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PZS, &
+ PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, &
+ PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, &
+ PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, &
+ PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, &
+ PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, 'OK' )
ELSE IF (U%CNATURE=='FLUX ') THEN
- CALL COUPLING_IDEAL_FLUX(DGL, &
- HPROGRAM, HCOUPLING, PTIMEC, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- KI,KSV,KSW, &
- PTSUN, PZENITH, PAZIM, &
- PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- 'OK' )
+ CALL COUPLING_IDEAL_FLUX(DGO, DL, DLC, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, &
+ KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PAZIM, &
+ PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
+ PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
+ PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, &
+ PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, &
+ PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
+ PPEQ_B_COEF, 'OK' )
ELSE IF (U%CNATURE=='NONE ') THEN
PSFTH = 0.
PSFTQ = 0.
diff --git a/src/SURFEX/coupling_seaflux_orogn.F90 b/src/SURFEX/coupling_seaflux_orogn.F90
index 5b60774c1c23e62f474a6c0949d888676f4b6de7..71b257f9f1cc6ad8c05be6223221fbc855a7ea35 100644
--- a/src/SURFEX/coupling_seaflux_orogn.F90
+++ b/src/SURFEX/coupling_seaflux_orogn.F90
@@ -1,213 +1,212 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ###############################################################################
-SUBROUTINE COUPLING_SEAFLUX_OROG_n (SM, DST, SLT, &
- HPROGRAM, HCOUPLING, PTIMEC, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, &
- PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
-! ###############################################################################
-!
-!!**** *COUPLING_SEAFLUX_OROG_n * - Modifies the input forcing if not
-!! initially at sea level
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! B. Decharme 2008 reset the subgrid topographic effect on the forcing
-!! J. Escobar 09/2012 SIZE(PTA) not allowed without-interface , replace by KI
-!! B. Decharme 04/2013 new coupling variables
-!! improve forcing vertical shift
-!!-------------------------------------------------------------
-!
-!
-USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t
-!
-USE MODD_DST_n, ONLY : DST_t
-USE MODD_SLT_n, ONLY : SLT_t
-!
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_CSTS, ONLY : XCPD, XRD, XP00
-!
-USE MODD_SURF_ATM, ONLY : LVERTSHIFT
-!
-USE MODI_FORCING_VERT_SHIFT
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODI_COUPLING_SEAFLUX_SBL_n
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM
-TYPE(DST_t), INTENT(INOUT) :: DST
-TYPE(SLT_t), INTENT(INOUT) :: SLT
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
- CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling
- ! 'E' : explicit
- ! 'I' : implicit
-REAL, INTENT(IN) :: PTIMEC ! current duration since start of the run (s)
-INTEGER, INTENT(IN) :: KYEAR ! current year (UTC)
-INTEGER, INTENT(IN) :: KMONTH ! current month (UTC)
-INTEGER, INTENT(IN) :: KDAY ! current day (UTC)
-REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s)
-INTEGER, INTENT(IN) :: KI ! number of points
-INTEGER, INTENT(IN) :: KSV ! number of scalars
-INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands
-REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight)
-REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s)
-REAL, DIMENSION(KI), INTENT(IN) :: PZREF ! height of T,q forcing (m)
-REAL, DIMENSION(KI), INTENT(IN) :: PUREF ! height of wind forcing (m)
-!
-REAL, DIMENSION(KI), INTENT(IN) :: PTA ! air temperature forcing (K)
-REAL, DIMENSION(KI), INTENT(IN) :: PQA ! air humidity forcing (kg/m3)
-REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3)
-REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables
-! ! chemistry: first char. in HSV: '#' (molecule/m3)
-! !
- CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables
-REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s)
-REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s)
-REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.)
-! ! (W/m2)
-REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.)
-! ! (W/m2)
-REAL, DIMENSION(KSW),INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m)
-REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle at t (radian from the vertical)
-REAL, DIMENSION(KI), INTENT(IN) :: PZENITH2 ! zenithal angle at t+1(radian from the vertical)
-REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! azimuthal angle (radian from North, clockwise)
-REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.)
-! ! (W/m2)
-REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa)
-REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa)
-REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model orography (m)
-REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3)
-REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s)
-REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s)
-!
-!
-REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH ! flux of heat (W/m2)
-REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ ! flux of water vapor (kg/m2/s)
-REAL, DIMENSION(KI), INTENT(OUT) :: PSFU ! zonal momentum flux (Pa)
-REAL, DIMENSION(KI), INTENT(OUT) :: PSFV ! meridian momentum flux (Pa)
-REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2 ! flux of CO2 (m/s*kg_CO2/kg_air)
-REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS ! flux of scalar var. (kg/m2/s)
-!
-REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD ! radiative temperature (K)
-REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band (-)
-REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-)
-REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity (-)
-!
-REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF ! surface effective temperature (K)
-REAL, DIMENSION(KI), INTENT(OUT) :: PZ0 ! roughness length for momentum (m)
-REAL, DIMENSION(KI), INTENT(OUT) :: PZ0H ! roughness length for heat (m)
-REAL, DIMENSION(KI), INTENT(OUT) :: PQSURF ! specific humidity at surface (kg/kg)
-!
-REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients
-REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I'
-REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF
-REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF
-REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF
-REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF
- CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
-!
-!* 0.2 declarations of local variables
-!
-REAL, DIMENSION(KI) :: ZPEQ_B_COEF ! 1st explicit coefficient
-REAL, DIMENSION(KI) :: ZPET_B_COEF ! 2nd explicit coefficient
-!
-REAL, DIMENSION(KI) :: ZTA ! Temperature at forcing height above surface orography
-REAL, DIMENSION(KI) :: ZPA ! Pressure at forcing height above surface orography
-REAL, DIMENSION(KI) :: ZPS ! Pressure at surface orography
-REAL, DIMENSION(KI) :: ZQA ! Humidity at forcing height above surface orography
-REAL, DIMENSION(KI) :: ZRHOA ! Density at forcing height above surface orography
-REAL, DIMENSION(KI) :: ZLW ! LW rad at forcing height above surface orography
-REAL, DIMENSION(KI) :: ZRAIN ! Rainfall at forcing height above surface orography
-REAL, DIMENSION(KI) :: ZSNOW ! Snowfall at forcing height above surface orography
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------------
-! Preliminaries:
-!-------------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_OROG_N',0,ZHOOK_HANDLE)
-!
-ZPEQ_B_COEF(:) = PPEQ_B_COEF(:)
-ZPET_B_COEF(:) = PPET_B_COEF(:)
-!
-IF(LVERTSHIFT)THEN
-!
- ZTA (:) = XUNDEF
- ZQA (:) = XUNDEF
- ZPS (:) = XUNDEF
- ZPA (:) = XUNDEF
- ZRHOA(:) = XUNDEF
- ZLW (:) = XUNDEF
- ZRAIN(:) = XUNDEF
- ZSNOW(:) = XUNDEF
-!
- CALL FORCING_VERT_SHIFT(PZS,SM%S%XZS,PTA,PQA,PPA,PRHOA,PLW,PRAIN,PSNOW,&
- ZTA,ZQA,ZPA,ZRHOA,ZLW,ZRAIN,ZSNOW )
-!
- ZPS(:) = ZPA(:) + (PPS(:) - PPA(:))
-!
- IF (HCOUPLING=='I') THEN
- ZPEQ_B_COEF = PPEQ_B_COEF + ZQA - PQA
- ZPET_B_COEF = PPET_B_COEF + ZTA/(ZPA/XP00)**(XRD/XCPD) - PTA/(PPA/XP00)**(XRD/XCPD)
- ENDIF
-!
-ELSE
-!
- ZTA (:) = PTA (:)
- ZQA (:) = PQA (:)
- ZPS (:) = PPS (:)
- ZPA (:) = PPA (:)
- ZRHOA(:) = PRHOA(:)
- ZLW (:) = PLW (:)
- ZRAIN(:) = PRAIN(:)
- ZSNOW(:) = PSNOW(:)
-!
-ENDIF
-!
- CALL COUPLING_SEAFLUX_SBL_n(SM, DST, SLT, &
- HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, &
- KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, &
- PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PU, PV, &
- ZQA, ZTA, ZRHOA, PSV, PCO2, HSV, ZRAIN, ZSNOW, ZLW, &
- PDIR_SW, PSCA_SW, PSW_BANDS, ZPS, ZPA, PSFTQ, PSFTH, &
- PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, &
- PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, &
- PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, ZPET_B_COEF, &
- ZPEQ_B_COEF, HTEST )
-!
-IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_OROG_N',1,ZHOOK_HANDLE)
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE COUPLING_SEAFLUX_OROG_n
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! ###############################################################################
+SUBROUTINE COUPLING_SEAFLUX_OROG_n (SM, DST, SLT, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, &
+ KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, &
+ PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PZS, PU, PV, &
+ PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, &
+ PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, &
+ PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB,&
+ PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, &
+ PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
+ PPEQ_B_COEF, HTEST )
+! ###############################################################################
+!
+!!**** *COUPLING_SEAFLUX_OROG_n * - Modifies the input forcing if not
+!! initially at sea level
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2004
+!! B. Decharme 2008 reset the subgrid topographic effect on the forcing
+!! J. Escobar 09/2012 SIZE(PTA) not allowed without-interface , replace by KI
+!! B. Decharme 04/2013 new coupling variables
+!! improve forcing vertical shift
+!!-------------------------------------------------------------
+!
+!
+USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t
+!
+USE MODD_DST_n, ONLY : DST_t
+USE MODD_SLT_n, ONLY : SLT_t
+!
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_CSTS, ONLY : XCPD, XRD, XP00
+!
+USE MODD_SURF_ATM, ONLY : LVERTSHIFT
+!
+USE MODI_FORCING_VERT_SHIFT
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODI_COUPLING_SEAFLUX_SBL_n
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+!
+TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM
+TYPE(DST_t), INTENT(INOUT) :: DST
+TYPE(SLT_t), INTENT(INOUT) :: SLT
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+ CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling
+ ! 'E' : explicit
+ ! 'I' : implicit
+REAL, INTENT(IN) :: PTIMEC ! current duration since start of the run (s)
+INTEGER, INTENT(IN) :: KYEAR ! current year (UTC)
+INTEGER, INTENT(IN) :: KMONTH ! current month (UTC)
+INTEGER, INTENT(IN) :: KDAY ! current day (UTC)
+REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s)
+INTEGER, INTENT(IN) :: KI ! number of points
+INTEGER, INTENT(IN) :: KSV ! number of scalars
+INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands
+REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight)
+REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s)
+REAL, DIMENSION(KI), INTENT(IN) :: PZREF ! height of T,q forcing (m)
+REAL, DIMENSION(KI), INTENT(IN) :: PUREF ! height of wind forcing (m)
+!
+REAL, DIMENSION(KI), INTENT(IN) :: PTA ! air temperature forcing (K)
+REAL, DIMENSION(KI), INTENT(IN) :: PQA ! air humidity forcing (kg/m3)
+REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3)
+REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables
+! ! chemistry: first char. in HSV: '#' (molecule/m3)
+! !
+ CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables
+REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s)
+REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s)
+REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.)
+! ! (W/m2)
+REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.)
+! ! (W/m2)
+REAL, DIMENSION(KSW),INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m)
+REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle at t (radian from the vertical)
+REAL, DIMENSION(KI), INTENT(IN) :: PZENITH2 ! zenithal angle at t+1(radian from the vertical)
+REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! azimuthal angle (radian from North, clockwise)
+REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.)
+! ! (W/m2)
+REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa)
+REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa)
+REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model orography (m)
+REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3)
+REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s)
+REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s)
+!
+!
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH ! flux of heat (W/m2)
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ ! flux of water vapor (kg/m2/s)
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFU ! zonal momentum flux (Pa)
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFV ! meridian momentum flux (Pa)
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2 ! flux of CO2 (m/s*kg_CO2/kg_air)
+REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS ! flux of scalar var. (kg/m2/s)
+!
+REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD ! radiative temperature (K)
+REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band (-)
+REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-)
+REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity (-)
+!
+REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF ! surface effective temperature (K)
+REAL, DIMENSION(KI), INTENT(OUT) :: PZ0 ! roughness length for momentum (m)
+REAL, DIMENSION(KI), INTENT(OUT) :: PZ0H ! roughness length for heat (m)
+REAL, DIMENSION(KI), INTENT(OUT) :: PQSURF ! specific humidity at surface (kg/kg)
+!
+REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients
+REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I'
+REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF
+REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF
+REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF
+REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF
+ CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
+!
+!* 0.2 declarations of local variables
+!
+REAL, DIMENSION(KI) :: ZPEQ_B_COEF ! 1st explicit coefficient
+REAL, DIMENSION(KI) :: ZPET_B_COEF ! 2nd explicit coefficient
+!
+REAL, DIMENSION(KI) :: ZTA ! Temperature at forcing height above surface orography
+REAL, DIMENSION(KI) :: ZPA ! Pressure at forcing height above surface orography
+REAL, DIMENSION(KI) :: ZPS ! Pressure at surface orography
+REAL, DIMENSION(KI) :: ZQA ! Humidity at forcing height above surface orography
+REAL, DIMENSION(KI) :: ZRHOA ! Density at forcing height above surface orography
+REAL, DIMENSION(KI) :: ZLW ! LW rad at forcing height above surface orography
+REAL, DIMENSION(KI) :: ZRAIN ! Rainfall at forcing height above surface orography
+REAL, DIMENSION(KI) :: ZSNOW ! Snowfall at forcing height above surface orography
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------------
+! Preliminaries:
+!-------------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_OROG_N',0,ZHOOK_HANDLE)
+!
+ZPEQ_B_COEF(:) = PPEQ_B_COEF(:)
+ZPET_B_COEF(:) = PPET_B_COEF(:)
+!
+IF(LVERTSHIFT)THEN
+!
+ ZTA (:) = XUNDEF
+ ZQA (:) = XUNDEF
+ ZPS (:) = XUNDEF
+ ZPA (:) = XUNDEF
+ ZRHOA(:) = XUNDEF
+ ZLW (:) = XUNDEF
+ ZRAIN(:) = XUNDEF
+ ZSNOW(:) = XUNDEF
+!
+ CALL FORCING_VERT_SHIFT(PZS,SM%S%XZS,PTA,PQA,PPA,PRHOA,PLW,PRAIN,PSNOW,&
+ ZTA,ZQA,ZPA,ZRHOA,ZLW,ZRAIN,ZSNOW )
+!
+ ZPS(:) = ZPA(:) + (PPS(:) - PPA(:))
+!
+ IF (HCOUPLING=='I') THEN
+ ZPEQ_B_COEF = PPEQ_B_COEF + ZQA - PQA
+ ZPET_B_COEF = PPET_B_COEF + ZTA/(ZPA/XP00)**(XRD/XCPD) - PTA/(PPA/XP00)**(XRD/XCPD)
+ ENDIF
+!
+ELSE
+!
+ ZTA (:) = PTA (:)
+ ZQA (:) = PQA (:)
+ ZPS (:) = PPS (:)
+ ZPA (:) = PPA (:)
+ ZRHOA(:) = PRHOA(:)
+ ZLW (:) = PLW (:)
+ ZRAIN(:) = PRAIN(:)
+ ZSNOW(:) = PSNOW(:)
+!
+ENDIF
+!
+ CALL COUPLING_SEAFLUX_SBL_n(SM%CHS, SM%DTS, SM%SD, SM%O, SM%OR, SM%G, SM%S, SM%SB, &
+ DST, SLT, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, &
+ KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, &
+ PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PU, PV, &
+ ZQA, ZTA, ZRHOA, PSV, PCO2, HSV, ZRAIN, ZSNOW, ZLW, &
+ PDIR_SW, PSCA_SW, PSW_BANDS, ZPS, ZPA, PSFTQ, PSFTH, &
+ PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, &
+ PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, &
+ PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, ZPET_B_COEF, &
+ ZPEQ_B_COEF, HTEST )
+!
+IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_OROG_N',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------------
+!
+END SUBROUTINE COUPLING_SEAFLUX_OROG_n
diff --git a/src/SURFEX/coupling_seaflux_sbln.F90 b/src/SURFEX/coupling_seaflux_sbln.F90
index 7af30fbefc8ed976137501cab1364b7b8a66ecb6..857f16473668a9831029b3f31d3bcaab7deb85c3 100644
--- a/src/SURFEX/coupling_seaflux_sbln.F90
+++ b/src/SURFEX/coupling_seaflux_sbln.F90
@@ -3,13 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################################
-SUBROUTINE COUPLING_SEAFLUX_SBL_n (SM, DST, SLT, &
+SUBROUTINE COUPLING_SEAFLUX_SBL_n (CHS, DTS, DGS, O, OR, G, S, SB, DST, SLT, &
HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PU, PV, &
- PQA, PTA, PRHOA, PSV, PCO2, HSV,PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, &
- PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
+ KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, &
+ PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
+ PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
+ PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
+ PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
+ PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
PPEQ_B_COEF, HTEST )
! ###############################################################################
!
@@ -40,7 +41,14 @@ SUBROUTINE COUPLING_SEAFLUX_SBL_n (SM, DST, SLT, &
!----------------------------------------------------------------
!
!
-USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t
+USE MODD_CH_SEAFLUX_n, ONLY : CH_SEAFLUX_t
+USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_t
+USE MODD_SURFEX_n, ONLY : SEAFLUX_DIAG_t
+USE MODD_OCEAN_n, ONLY : OCEAN_t
+USE MODD_OCEAN_REL_n, ONLY : OCEAN_REL_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
+USE MODD_CANOPY_n, ONLY : CANOPY_t
!
USE MODD_DST_n, ONLY : DST_t
USE MODD_SLT_n, ONLY : SLT_t
@@ -65,7 +73,14 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM
+TYPE(CH_SEAFLUX_t), INTENT(INOUT) :: CHS
+TYPE(DATA_SEAFLUX_t), INTENT(INOUT) :: DTS
+TYPE(SEAFLUX_DIAG_t), INTENT(INOUT) :: DGS
+TYPE(OCEAN_t), INTENT(INOUT) :: O
+TYPE(OCEAN_REL_t), INTENT(INOUT) :: OR
+TYPE(GRID_t), INTENT(INOUT) :: G
+TYPE(SEAFLUX_t), INTENT(INOUT) :: S
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
TYPE(DST_t), INTENT(INOUT) :: DST
TYPE(SLT_t), INTENT(INOUT) :: SLT
!
@@ -159,21 +174,20 @@ REAL, DIMENSION(KI) :: ZPEQ_B_COEF ! coefficients (hum. in kg/kg)
REAL, DIMENSION(KI) :: ZSFLUX_U ! Surface flux u'w' (m2/s2)
REAL, DIMENSION(KI) :: ZSFLUX_T ! Surface flux w'T' (mK/s)
REAL, DIMENSION(KI) :: ZSFLUX_Q ! Surface flux w'q' (kgm2/s)
-REAL, DIMENSION(KI,SM%SSB%NLVL) :: ZFORC_U ! tendency due to drag force for wind
-REAL, DIMENSION(KI,SM%SSB%NLVL) :: ZDFORC_UDU! formal derivative of
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_U ! tendency due to drag force for wind
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_UDU! formal derivative of
! ! tendency due to drag force for wind
-REAL, DIMENSION(KI,SM%SSB%NLVL) :: ZFORC_E ! tendency due to drag force for TKE
-REAL, DIMENSION(KI,SM%SSB%NLVL) :: ZDFORC_EDE! formal derivative of
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_E ! tendency due to drag force for TKE
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_EDE! formal derivative of
! ! tendency due to drag force for TKE
-REAL, DIMENSION(KI,SM%SSB%NLVL) :: ZFORC_T ! tendency due to drag force for Temp
-REAL, DIMENSION(KI,SM%SSB%NLVL) :: ZDFORC_TDT! formal derivative of
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_T ! tendency due to drag force for Temp
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_TDT! formal derivative of
! ! tendency due to drag force for Temp
-REAL, DIMENSION(KI,SM%SSB%NLVL) :: ZFORC_Q ! tendency due to drag force for Temp
-REAL, DIMENSION(KI,SM%SSB%NLVL) :: ZDFORC_QDQ! formal derivative of
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_Q ! tendency due to drag force for Temp
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_QDQ! formal derivative of
! ! tendency due to drag force for hum.
-REAL, DIMENSION(KI,SM%SSB%NLVL) :: ZLMO ! MO length
-REAL, DIMENSION(KI,SM%SSB%NLVL) :: ZLM ! mixing length
-REAL, DIMENSION(KI,SM%SSB%NLVL) :: ZLEPS ! dissipative length
+REAL, DIMENSION(KI,SB%NLVL) :: ZLM ! mixing length
+REAL, DIMENSION(KI,SB%NLVL) :: ZLEPS ! dissipative length
REAL, DIMENSION(KI) :: ZH ! canopy height (m)
REAL, DIMENSION(KI) :: ZUSTAR ! friction velocity (m/s)
!
@@ -189,6 +203,7 @@ REAL, DIMENSION(KI) :: ZBETATH ! Th+(1) = - alfa rho w'th'(1) + beta
REAL, DIMENSION(KI) :: ZALFAQ ! Q+(1) = - alfa rho w'q'(1) + beta
REAL, DIMENSION(KI) :: ZBETAQ ! Q+(1) = - alfa rho w'q'(1) + beta
!
+INTEGER :: JLAYER
CHARACTER(LEN=1) :: GCOUPLING
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
@@ -198,7 +213,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_SBL_N',0,ZHOOK_HANDLE)
-IF (SM%S%LSBL) THEN
+IF (S%LSBL) THEN
!
!* 1.1 Updates SBL vertical grid as a function of forcing height
! ---------------------------------------------------------
@@ -206,45 +221,38 @@ IF (SM%S%LSBL) THEN
!* determines where is the forcing level and modifies the upper levels of the canopy grid
!
ZH = 0.
- CALL CANOPY_GRID_UPDATE(KI,SM%SSB%NLVL,ZH,PUREF,&
- SM%SSB%XZ,SM%SSB%XZF,SM%SSB%XDZ,SM%SSB%XDZF)
+ CALL CANOPY_GRID_UPDATE(KI,ZH,PUREF,SB)
!
!
!
!* 1.2 Initialisation at first time step
! ---------------------------------
!
- IF(ANY(SM%SSB%XT(:,:) == XUNDEF)) THEN
- CALL INIT_WATER_SBL(SM%SSB%NLVL, PPA, PPS, PTA, PQA, PRHOA, PU, PV, PRAIN, PSNOW, &
- PSFTH, PSFTQ, PZREF, PUREF, SM%S%XSST, SM%S%XZ0, SM%SSB%XZ, &
- SM%SSB%XT, SM%SSB%XQ, SM%SSB%XU, SM%SSB%XTKE, SM%SSB%XP)
+ IF(ANY(SB%XT(:,:) == XUNDEF)) THEN
+ CALL INIT_WATER_SBL(SB, PPA, PPS, PTA, PQA, PRHOA, PU, PV, PRAIN, PSNOW, &
+ PSFTH, PSFTQ, PZREF, PUREF, S%XSST, S%XZ0 )
ENDIF
!
!
!* 1.3 Allocations
! -----------
!
- CALL INIT_FORC( ZFORC_U, ZDFORC_UDU, ZFORC_E, ZDFORC_EDE, &
+ CALL INIT_FORC(ZFORC_U, ZDFORC_UDU, ZFORC_E, ZDFORC_EDE, &
ZFORC_T, ZDFORC_TDT, ZFORC_Q, ZDFORC_QDQ )
!
ZSFLUX_U = 0.
ZSFLUX_T = 0.
ZSFLUX_Q = 0.
-!
- ZLMO = SPREAD(SM%SSB%XLMO,2,SM%SSB%NLVL)
!
!* 1.3 Computes coefficients for implicitation
! ---------------------------------------
!
ZWIND = SQRT(PU**2+PV**2)
- CALL CANOPY_EVOL(KI,SM%SSB%NLVL,PTSTEP,1,SM%SSB%XZ,ZWIND,PTA,PQA,PPA,PRHOA, &
- ZSFLUX_U,ZSFLUX_T,ZSFLUX_Q, &
- ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE, &
- ZFORC_T,ZDFORC_TDT,ZFORC_Q,ZDFORC_QDQ, &
- SM%SSB%XZ,SM%SSB%XZF,SM%SSB%XDZ,SM%SSB%XDZF, &
- SM%SSB%XU,SM%SSB%XTKE,SM%SSB%XT, &
- SM%SSB%XQ,ZLMO,ZLM,ZLEPS,SM%SSB%XP,ZUSTAR, &
- ZALFAU,ZBETAU,ZALFATH,ZBETATH,ZALFAQ,ZBETAQ )
+ CALL CANOPY_EVOL(SB, KI, PTSTEP,1, SB%XZ, ZWIND, PTA, PQA, PPA, PRHOA, &
+ ZSFLUX_U, ZSFLUX_T, ZSFLUX_Q, ZFORC_U, ZDFORC_UDU, &
+ ZFORC_E, ZDFORC_EDE, ZFORC_T, ZDFORC_TDT, &
+ ZFORC_Q, ZDFORC_QDQ, ZLM, ZLEPS, ZUSTAR, &
+ ZALFAU, ZBETAU, ZALFATH, ZBETATH, ZALFAQ ,ZBETAQ )
!
!* 1.5 Goes from atmospheric forcing to canopy forcing height
@@ -252,16 +260,13 @@ IF (SM%S%LSBL) THEN
!
GCOUPLING = 'I'
!
- CALL INIT_COUPLING_CANOPY( SM%SSB%XP(:,1), PPA, SM%SSB%XT(:,1), &
- SM%SSB%XQ(:,1), PU, PV, SM%SSB%XZ(:,1), &
- SM%SSB%XU(:,1), &
- PRHOA, ZALFAU, ZBETAU, ZALFATH, &
- ZBETATH, ZALFAQ, ZBETAQ, &
- ZPA, ZTA, ZQA, ZU, ZV, &
- ZUREF, ZZREF, ZEXNA, &
- ZPEW_A_COEF, ZPEW_B_COEF, &
- ZPET_A_COEF, ZPET_B_COEF, &
- ZPEQ_A_COEF, ZPEQ_B_COEF )
+ CALL INIT_COUPLING_CANOPY(SB, PPA, PU, PV, PRHOA, &
+ ZALFAU, ZBETAU, ZALFATH, ZBETATH,&
+ ZALFAQ, ZBETAQ, ZPA, ZTA, ZQA, &
+ ZU, ZV, ZUREF, ZZREF, ZEXNA, &
+ ZPEW_A_COEF, ZPEW_B_COEF, &
+ ZPET_A_COEF, ZPET_B_COEF, &
+ ZPEQ_A_COEF, ZPEQ_B_COEF )
!
!-------------------------------------------------------------------------------------
ELSE
@@ -291,26 +296,21 @@ END IF
!* 2. Call of SEAFLUX
! ------------
!
- CALL COUPLING_SEAFLUX_n(SM, DST, SLT, &
- HPROGRAM, GCOUPLING, PTIMEC, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- KI, KSV, KSW, &
- PTSUN, PZENITH, PZENITH2, PAZIM, &
- ZZREF, ZUREF, ZU, ZV, ZQA, ZTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, ZPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- ZPEW_A_COEF, ZPEW_B_COEF, &
- ZPET_A_COEF, ZPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF, &
- HTEST )
+ CALL COUPLING_SEAFLUX_n(CHS, DTS, DGS, O, OR, G, S, DST, SLT, HPROGRAM, GCOUPLING, &
+ PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, &
+ PTSUN, PZENITH, PZENITH2, PAZIM, ZZREF, ZUREF, ZU, ZV, ZQA, ZTA, PRHOA, &
+ PSV, PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, ZPA,&
+ PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, &
+ PEMIS, PTSURF, PZ0, PZ0H, PQSURF, ZPEW_A_COEF, ZPEW_B_COEF, &
+ ZPET_A_COEF, ZPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF, HTEST)
!
!-------------------------------------------------------------------------------------
!
!* 3. End if no SBL is used
! ---------------------
!
-IF (.NOT. SM%S%LSBL .AND. LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_SBL_N',1,ZHOOK_HANDLE)
-IF (.NOT. SM%S%LSBL) RETURN
+IF (.NOT. S%LSBL .AND. LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_SBL_N',1,ZHOOK_HANDLE)
+IF (.NOT. S%LSBL) RETURN
!
!-------------------------------------------------------------------------------------
!
@@ -318,7 +318,7 @@ IF (.NOT. SM%S%LSBL) RETURN
! -------------------------------------------------
!
CALL INIT_FORC( ZFORC_U, ZDFORC_UDU, ZFORC_E, ZDFORC_EDE, &
- ZFORC_T, ZDFORC_TDT, ZFORC_Q, ZDFORC_QDQ )
+ ZFORC_T, ZDFORC_TDT, ZFORC_Q, ZDFORC_QDQ )
!
ZSFLUX_U = - SQRT(PSFU(:)**2+PSFV(:)**2) / PRHOA(:)
ZSFLUX_T(:) = PSFTH(:) / XCPD * ZEXNA(:) / PRHOA(:)
@@ -330,30 +330,23 @@ ZSFLUX_Q(:) = PSFTQ(:)
! --------------------------------------------
!
ZWIND = SQRT(PU**2+PV**2)
- CALL CANOPY_EVOL(KI,SM%SSB%NLVL,PTSTEP,2,SM%SSB%XZ,ZWIND,PTA,PQA,PPA,PRHOA, &
- ZSFLUX_U,ZSFLUX_T,ZSFLUX_Q, &
- ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE, &
- ZFORC_T,ZDFORC_TDT,ZFORC_Q,ZDFORC_QDQ, &
- SM%SSB%XZ,SM%SSB%XZF,SM%SSB%XDZ,SM%SSB%XDZF, &
- SM%SSB%XU,SM%SSB%XTKE,SM%SSB%XT, &
- SM%SSB%XQ,ZLMO,ZLM,ZLEPS,SM%SSB%XP,ZUSTAR, &
- ZALFAU,ZBETAU,ZALFATH,ZBETATH,ZALFAQ,ZBETAQ )
+ CALL CANOPY_EVOL(SB,KI,PTSTEP,2,SB%XZ,ZWIND,PTA,PQA,PPA,PRHOA, &
+ ZSFLUX_U,ZSFLUX_T,ZSFLUX_Q, &
+ ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE, &
+ ZFORC_T,ZDFORC_TDT,ZFORC_Q,ZDFORC_QDQ, &
+ ZLM,ZLEPS,ZUSTAR, &
+ ZALFAU,ZBETAU,ZALFATH,ZBETATH,ZALFAQ,ZBETAQ )
!
-SM%SSB%XLMO(:) = ZLMO(:,SM%SSB%NLVL)
+DO JLAYER=1,SB%NLVL-1
+ SB%XLMO(:,JLAYER) = SB%XLMO(:,SB%NLVL)
+ENDDO
!
!-------------------------------------------------------------------------------------
!
!* 7. 2m and 10m diagnostics if canopy is used
! ----------------------------------------
!
-!
-IF (SM%S%LSBL .AND. SM%DGS%N2M>=1) CALL INIT_2M_10M( SM%SSB%XP(:,2), SM%SSB%XT(:,2), &
- SM%SSB%XQ(:,2), SM%SSB%XU, SM%SSB%XZ, &
- PU, PV, ZWIND, PRHOA, &
- SM%DGS%XT2M, SM%DGS%XQ2M, SM%DGS%XHU2M, &
- SM%DGS%XZON10M, SM%DGS%XMER10M,&
- SM%DGS%XWIND10M, SM%DGS%XWIND10M_MAX, SM%DGS%XT2M_MIN, &
- SM%DGS%XT2M_MAX, SM%DGS%XHU2M_MIN, SM%DGS%XHU2M_MAX )
+IF (S%LSBL .AND. DGS%O%N2M>=1) CALL INIT_2M_10M( SB, DGS%D, PU, PV, ZWIND, PRHOA )
!
IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_SBL_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/coupling_seafluxn.F90 b/src/SURFEX/coupling_seafluxn.F90
index 2710a7775423ccd958c5a255706e1df6f16e7843..b908374152ef74ca243d1810e1ac1e29f2e5b8e5 100644
--- a/src/SURFEX/coupling_seafluxn.F90
+++ b/src/SURFEX/coupling_seafluxn.F90
@@ -3,16 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################################
-SUBROUTINE COUPLING_SEAFLUX_n (SM, DST, SLT, &
- HPROGRAM, HCOUPLING, PTIMEC, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, &
- PAZIM, PZREF, PUREF, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+SUBROUTINE COUPLING_SEAFLUX_n (CHS, DTS, DGS, O, OR, G, S, DST, SLT, &
+ HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
+ KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, &
+ PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, &
+ PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, &
+ PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, &
+ PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, &
+ PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST )
! ###############################################################################
!
!!**** *COUPLING_SEAFLUX_n * - Driver of the WATER_FLUX scheme for sea
@@ -53,8 +51,13 @@ SUBROUTINE COUPLING_SEAFLUX_n (SM, DST, SLT, &
!!---------------------------------------------------------------------
!
!
-!
-USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t
+USE MODD_CH_SEAFLUX_n, ONLY : CH_SEAFLUX_t
+USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_t
+USE MODD_SURFEX_n, ONLY : SEAFLUX_DIAG_t
+USE MODD_OCEAN_n, ONLY : OCEAN_t
+USE MODD_OCEAN_REL_n, ONLY : OCEAN_REL_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
!
USE MODD_DST_n, ONLY : DST_t
USE MODD_SLT_n, ONLY : SLT_t
@@ -104,14 +107,20 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM
+TYPE(CH_SEAFLUX_t), INTENT(INOUT) :: CHS
+TYPE(DATA_SEAFLUX_t), INTENT(INOUT) :: DTS
+TYPE(SEAFLUX_DIAG_t), INTENT(INOUT) :: DGS
+TYPE(OCEAN_t), INTENT(INOUT) :: O
+TYPE(OCEAN_REL_t), INTENT(INOUT) :: OR
+TYPE(GRID_t), INTENT(INOUT) :: G
+TYPE(SEAFLUX_t), INTENT(INOUT) :: S
TYPE(DST_t), INTENT(INOUT) :: DST
TYPE(SLT_t), INTENT(INOUT) :: SLT
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
- CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling
- ! 'E' : explicit
- ! 'I' : implicit
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling
+ ! 'E' : explicit
+ ! 'I' : implicit
REAL, INTENT(IN) :: PTIMEC ! current duration since start of the run (s)
INTEGER, INTENT(IN) :: KYEAR ! current year (UTC)
INTEGER, INTENT(IN) :: KMONTH ! current month (UTC)
@@ -131,7 +140,7 @@ REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density
REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables
! ! chemistry: first char. in HSV: '#' (molecule/m3)
! !
- CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables
+CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables
REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s)
REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s)
REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.)
@@ -173,7 +182,7 @@ REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF
- CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
+CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
!
!* 0.2 declarations of local variables
!
@@ -236,6 +245,8 @@ INTEGER :: ISWB ! number of shortwave spectral ba
INTEGER :: JSWB ! loop counter on shortwave spectral bands
INTEGER :: ISLT ! number of sea salt variable
!
+INTEGER :: IBEG, IEND
+!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
! Preliminaries:
@@ -290,8 +301,8 @@ ZEXNA(:) = (PPA(:)/XP00)**(XRD/XCPD)
!
IF(LCPL_SEA)THEN
!Sea currents are taken into account
- ZU(:)=PU(:)-SM%S%XUMER(:)
- ZV(:)=PV(:)-SM%S%XVMER(:)
+ ZU(:)=PU(:)-S%XUMER(:)
+ ZV(:)=PV(:)-S%XVMER(:)
ELSE
ZU(:)=PU(:)
ZV(:)=PV(:)
@@ -309,71 +320,59 @@ ZQA(:) = PQA(:) / PRHOA(:)
! Time evolution
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-SM%S%TTIME%TIME = SM%S%TTIME%TIME + PTSTEP
- CALL ADD_FORECAST_TO_DATE_SURF(SM%S%TTIME%TDATE%YEAR,SM%S%TTIME%TDATE%MONTH,SM%S%TTIME%TDATE%DAY,SM%S%TTIME%TIME)
+S%TTIME%TIME = S%TTIME%TIME + PTSTEP
+ CALL ADD_FORECAST_TO_DATE_SURF(S%TTIME%TDATE%YEAR,S%TTIME%TDATE%MONTH,S%TTIME%TDATE%DAY,S%TTIME%TIME)
!
!--------------------------------------------------------------------------------------
! Fluxes over water according to Charnock formulae
!--------------------------------------------------------------------------------------
!
-IF (SM%S%LHANDLE_SIC) THEN
- ! Flux for sea are computed everywhere
- ISIZE_WATER = SIZE(ZMASK)
- ! Ensure freezing SST values where XSST actually has very low (sea-ice) values (old habits)
- ZSST(:)=MAX(SM%S%XSST(:), XTTSI)
- ! Flux over sea-ice will not be computed by next calls, but by coupling_iceflux. Hence :
- ISIZE_ICE = 0
- ! Flux over sea-ice will be computed by coupling_iceflux anywhere sea-ice could form in one
- ! time-step (incl. under forcing). ZMASK value is set to 1. on these points
- ZMASK(:)=0.
- WHERE ( SM%S%XSIC(:) > 0. ) ZMASK(:)=1.
- ! To be large, assume that seaice may form where SST is < 10C
- WHERE ( SM%S%XSST(:) - XTTS <= 10. ) ZMASK(:)=1.
- IF (SM%S%LINTERPOL_SIC) WHERE (SM%S%XFSIC(:) > 0. ) ZMASK(:)=1.
- IF (SM%S%LINTERPOL_SIT) WHERE (SM%S%XFSIT(:) > 0. ) ZMASK(:)=1.
+IF (S%LHANDLE_SIC) THEN
+ ! Flux for sea are computed everywhere
+ ISIZE_WATER = SIZE(ZMASK)
+ ! Ensure freezing SST values where XSST actually has very low (sea-ice) values (old habits)
+ ZSST(:)=MAX(S%XSST(:), XTTSI)
+ ! Flux over sea-ice will not be computed by next calls, but by coupling_iceflux. Hence :
+ ISIZE_ICE = 0
+ ! Flux over sea-ice will be computed by coupling_iceflux anywhere sea-ice could form in one
+ ! time-step (incl. under forcing). ZMASK value is set to 1. on these points
+ ZMASK(:)=0.
+ WHERE ( S%XSIC(:) > 0. ) ZMASK(:)=1.
+ ! To be large, assume that seaice may form where SST is < 10C
+ WHERE ( S%XSST(:) - XTTS <= 10. ) ZMASK(:)=1.
+ IF (S%LINTERPOL_SIC) WHERE (S%XFSIC(:) > 0. ) ZMASK(:)=1.
+ IF (S%LINTERPOL_SIT) WHERE (S%XFSIT(:) > 0. ) ZMASK(:)=1.
ELSE
- ZSST (:) = SM%S%XSST(:)
- ZMASK(:) = SM%S%XSST(:) - XTTS
- ISIZE_WATER = COUNT(ZMASK(:)>=0.)
- ISIZE_ICE = SIZE(SM%S%XSST) - ISIZE_WATER
+ ZSST (:) = S%XSST(:)
+ ZMASK(:) = S%XSST(:) - XTTS
+ ISIZE_WATER = COUNT(ZMASK(:)>=0.)
+ ISIZE_ICE = SIZE(S%XSST) - ISIZE_WATER
ENDIF
!
-SELECT CASE (SM%S%CSEA_FLUX)
- CASE ('DIRECT')
- CALL WATER_FLUX(SM%S%XZ0, &
- PTA, ZEXNA, PRHOA, ZSST, ZEXNS, ZQA, PRAIN, &
- PSNOW, XTTS, &
- ZWIND, PZREF, PUREF, &
- PPS, SM%S%LHANDLE_SIC, ZQSAT, &
- ZSFTH, ZSFTQ, ZUSTAR, &
- ZCD, ZCDN, ZCH, ZRI, ZRESA_SEA, ZZ0H )
- CASE ('ITERAT')
- CALL MR98 (SM%S%XZ0, &
- PTA, ZEXNA, PRHOA, SM%S%XSST, ZEXNS, ZQA, &
- XTTS, &
- ZWIND, PZREF, PUREF, &
- PPS, ZQSAT, &
- ZSFTH, ZSFTQ, ZUSTAR, &
- ZCD, ZCDN, ZCH, ZRI, ZRESA_SEA, ZZ0H )
+SELECT CASE (S%CSEA_FLUX)
+CASE ('DIRECT')
+CALL WATER_FLUX(S%XZ0, PTA, ZEXNA, PRHOA, ZSST, ZEXNS, ZQA, &
+ PRAIN, PSNOW, XTTS, ZWIND, PZREF, PUREF, &
+ PPS, S%LHANDLE_SIC, ZQSAT, ZSFTH, ZSFTQ, &
+ ZUSTAR, ZCD, ZCDN, ZCH, ZRI, ZRESA_SEA, ZZ0H )
+CASE ('ITERAT')
+CALL MR98 (S%XZ0, PTA, ZEXNA, PRHOA, S%XSST, ZEXNS, ZQA, &
+ XTTS, ZWIND, PZREF, PUREF, PPS, ZQSAT, &
+ ZSFTH, ZSFTQ, ZUSTAR, &
+ ZCD, ZCDN, ZCH, ZRI, ZRESA_SEA, ZZ0H )
- CASE ('ECUME ','ECUME6')
- CALL ECUME_SEAFLUX(SM%S%XZ0, ZMASK, ISIZE_WATER, ISIZE_ICE, &
- PTA, ZEXNA ,PRHOA, ZSST, SM%S%XSSS, ZEXNS, ZQA, &
- PRAIN, PSNOW, &
- ZWIND, PZREF, PUREF, PPS, PPA, &
- SM%S%XICHCE, SM%S%LPRECIP, SM%S%LPWEBB, SM%S%LPWG, SM%S%NZ0, &
- SM%S%LHANDLE_SIC, ZQSAT, ZSFTH, ZSFTQ, ZUSTAR, &
- ZCD, ZCDN, ZCH, ZCE, ZRI, ZRESA_SEA, ZZ0H, &
- SM%S%LPERTFLUX, SM%S%XPERTFLUX, SM%S%CSEA_FLUX )
- CASE ('COARE3')
- CALL COARE30_SEAFLUX(SM%S, &
- ZMASK, ISIZE_WATER, ISIZE_ICE, &
- PTA, ZEXNA ,PRHOA, ZSST, ZEXNS, ZQA, PRAIN, &
- PSNOW, &
- ZWIND, PZREF, PUREF, &
- PPS, ZQSAT, &
- ZSFTH, ZSFTQ, ZUSTAR, &
- ZCD, ZCDN, ZCH, ZCE, ZRI, ZRESA_SEA, ZZ0H )
+CASE ('ECUME ','ECUME6')
+CALL ECUME_SEAFLUX(S, ZMASK, ISIZE_WATER, ISIZE_ICE, &
+ PTA, ZEXNA ,PRHOA, ZSST, ZEXNS, ZQA, &
+ PRAIN, PSNOW, ZWIND, PZREF, PUREF, PPS, PPA, &
+ ZQSAT, ZSFTH, ZSFTQ, ZUSTAR, &
+ ZCD, ZCDN, ZCH, ZCE, ZRI, ZRESA_SEA, ZZ0H )
+CASE ('COARE3')
+CALL COARE30_SEAFLUX(S, ZMASK, ISIZE_WATER, ISIZE_ICE, &
+ PTA, ZEXNA ,PRHOA, ZSST, ZEXNS, ZQA, PRAIN, &
+ PSNOW, ZWIND, PZREF, PUREF, PPS, ZQSAT, &
+ ZSFTH, ZSFTQ, ZUSTAR, &
+ ZCD, ZCDN, ZCH, ZCE, ZRI, ZRESA_SEA, ZZ0H )
END SELECT
!
!-------------------------------------------------------------------------------------
@@ -383,18 +382,17 @@ END SELECT
ISWB = SIZE(PSW_BANDS)
!
DO JSWB=1,ISWB
- ZDIR_ALB(:,JSWB) = SM%S%XDIR_ALB(:)
- ZSCA_ALB(:,JSWB) = SM%S%XSCA_ALB(:)
+ZDIR_ALB(:,JSWB) = S%XDIR_ALB(:)
+ZSCA_ALB(:,JSWB) = S%XSCA_ALB(:)
END DO
!
-IF (SM%S%LHANDLE_SIC) THEN
- ZEMIS(:) = (1 - SM%S%XSIC(:)) * XEMISWAT + SM%S%XSIC(:) * XEMISWATICE
- ZTRAD(:) = (((1 - SM%S%XSIC(:)) * XEMISWAT * SM%S%XSST (:)**4 + &
- SM%S%XSIC(:) * XEMISWATICE * SM%S%XTICE(:)**4)/ &
- ZEMIS(:)) ** 0.25
+IF (S%LHANDLE_SIC) THEN
+ZEMIS(:) = (1 - S%XSIC(:)) * XEMISWAT + S%XSIC(:) * XEMISWATICE
+ZTRAD(:) = (((1 - S%XSIC(:)) * XEMISWAT * S%XSST (:)**4 + &
+ S%XSIC(:) * XEMISWATICE * S%XTICE(:)**4)/ ZEMIS(:)) ** 0.25
ELSE
- ZTRAD(:) = SM%S%XSST (:)
- ZEMIS(:) = SM%S%XEMIS(:)
+ZTRAD(:) = S%XSST (:)
+ZEMIS(:) = S%XEMIS(:)
END IF
!
!-------------------------------------------------------------------------------------
@@ -402,26 +400,26 @@ END IF
!seaice scheme)
!-------------------------------------------------------------------------------------
!
-IF(LCPL_SEAICE.OR.SM%S%LHANDLE_SIC)THEN
- CALL COUPLING_ICEFLUX_n(KI, PTA, ZEXNA, PRHOA, SM%S%XTICE, ZEXNS, &
- ZQA, PRAIN, PSNOW, ZWIND, PZREF, PUREF, &
- PPS, SM%S%XSST, XTTS, ZSFTH_ICE, ZSFTQ_ICE, &
- SM%S%LHANDLE_SIC, ZMASK, ZQSAT_ICE, ZZ0_ICE, &
- ZUSTAR_ICE, ZCD_ICE, ZCDN_ICE, ZCH_ICE, &
- ZRI_ICE, ZRESA_SEA_ICE, ZZ0H_ICE )
+IF(LCPL_SEAICE.OR.S%LHANDLE_SIC)THEN
+CALL COUPLING_ICEFLUX_n(KI, PTA, ZEXNA, PRHOA, S%XTICE, ZEXNS, &
+ ZQA, PRAIN, PSNOW, ZWIND, PZREF, PUREF, &
+ PPS, S%XSST, XTTS, ZSFTH_ICE, ZSFTQ_ICE, &
+ S%LHANDLE_SIC, ZMASK, ZQSAT_ICE, ZZ0_ICE, &
+ ZUSTAR_ICE, ZCD_ICE, ZCDN_ICE, ZCH_ICE, &
+ ZRI_ICE, ZRESA_SEA_ICE, ZZ0H_ICE )
ENDIF
!
-IF (SM%S%LHANDLE_SIC) CALL COMPLEMENT_EACH_OTHER_FLUX
+IF (S%LHANDLE_SIC) CALL COMPLEMENT_EACH_OTHER_FLUX
!
!-------------------------------------------------------------------------------------
! Momentum fluxes over sea or se-ice
!-------------------------------------------------------------------------------------
!
- CALL SEA_MOMENTUM_FLUXES(ZCD, ZSFU, ZSFV)
+CALL SEA_MOMENTUM_FLUXES(ZCD, ZSFU, ZSFV)
!
! Momentum fluxes over sea-ice if embedded seaice scheme is used
!
-IF (SM%S%LHANDLE_SIC) CALL SEA_MOMENTUM_FLUXES(ZCD_ICE, ZSFU_ICE, ZSFV_ICE)
+IF (S%LHANDLE_SIC) CALL SEA_MOMENTUM_FLUXES(ZCD_ICE, ZSFU_ICE, ZSFV_ICE)
!
! CO2 flux
!
@@ -442,105 +440,122 @@ PSFCO2(:) = - ZWIND(:)**2 * 1.13E-3 * 8.7 * 44.E-3 / ( 365*24*3600 )
! Scalar fluxes:
!-------------------------------------------------------------------------------------
!
-IF (SM%CHS%SVS%NBEQ>0) THEN
- IF (SM%CHS%CCH_DRY_DEP == "WES89") THEN
-
- CALL CH_DEP_WATER (ZRESA_SEA, ZUSTAR, PTA, ZTRAD, &
- PSV(:,SM%CHS%SVS%NSV_CHSBEG:SM%CHS%SVS%NSV_CHSEND), &
- SM%CHS%SVS%CSV(SM%CHS%SVS%NSV_CHSBEG:SM%CHS%SVS%NSV_CHSEND), &
- SM%CHS%XDEP(:,1:SM%CHS%SVS%NBEQ) )
-
- PSFTS(:,SM%CHS%SVS%NSV_CHSBEG:SM%CHS%SVS%NSV_CHSEND) = - PSV(:,SM%CHS%SVS%NSV_CHSBEG:SM%CHS%SVS%NSV_CHSEND) &
- * SM%CHS%XDEP(:,1:SM%CHS%SVS%NBEQ)
- IF (SM%CHS%SVS%NAEREQ > 0 ) THEN
- CALL CH_AER_DEP(PSV(:,SM%CHS%SVS%NSV_AERBEG:SM%CHS%SVS%NSV_AEREND),&
- PSFTS(:,SM%CHS%SVS%NSV_AERBEG:SM%CHS%SVS%NSV_AEREND),&
- ZUSTAR,ZRESA_SEA,PTA,PRHOA)
- END IF
-
+IF (CHS%SVS%NBEQ>0) THEN
+ !
+ IF (CHS%CCH_DRY_DEP == "WES89") THEN
+ !
+ IBEG = CHS%SVS%NSV_CHSBEG
+ IEND = CHS%SVS%NSV_CHSEND
+ !
+ CALL CH_DEP_WATER (ZRESA_SEA, ZUSTAR, PTA, ZTRAD,PSV(:,IBEG:IEND), &
+ CHS%SVS%CSV(IBEG:IEND), CHS%XDEP(:,1:CHS%SVS%NBEQ) )
+ !
+ PSFTS(:,IBEG:IEND) = - PSV(:,IBEG:IEND) * CHS%XDEP(:,1:CHS%SVS%NBEQ)
+ !
+ IF (CHS%SVS%NAEREQ > 0 ) THEN
+ !
+ IBEG = CHS%SVS%NSV_AERBEG
+ IEND = CHS%SVS%NSV_AEREND
+ !
+ CALL CH_AER_DEP(PSV(:,IBEG:IEND),PSFTS(:,IBEG:IEND),ZUSTAR,ZRESA_SEA,PTA,PRHOA)
+ !
+ END IF
+ !
ELSE
- PSFTS(:,SM%CHS%SVS%NSV_CHSBEG:SM%CHS%SVS%NSV_CHSEND) =0.
- IF (SM%CHS%SVS%NSV_AEREND.GT.SM%CHS%SVS%NSV_AERBEG) PSFTS(:,SM%CHS%SVS%NSV_AERBEG:SM%CHS%SVS%NSV_AEREND) =0.
+ !
+ IBEG = CHS%SVS%NSV_AERBEG
+ IEND = CHS%SVS%NSV_AEREND
+ !
+ PSFTS(:,IBEG:IEND) =0.
+ IF (IEND.GT.IBEG) PSFTS(:,IBEG:IEND) =0.
+ !
ENDIF
+ !
ENDIF
!
-IF (SM%CHS%SVS%NSLTEQ>0) THEN
- ISLT = SM%CHS%SVS%NSV_SLTEND - SM%CHS%SVS%NSV_SLTBEG + 1
-
- CALL COUPLING_SLT_n(SLT, &
- SIZE(ZUSTAR,1), & !I [nbr] number of sea point
- ISLT, & !I [nbr] number of sea salt variables
- ZWIND, & !I [m/s] wind velocity
- PSFTS(:,SM%CHS%SVS%NSV_SLTBEG:SM%CHS%SVS%NSV_SLTEND) )
-ENDIF
-!
-IF (SM%CHS%SVS%NDSTEQ>0) THEN
- CALL DSLT_DEP(PSV(:,SM%CHS%SVS%NSV_DSTBEG:SM%CHS%SVS%NSV_DSTEND), PSFTS(:,SM%CHS%SVS%NSV_DSTBEG:SM%CHS%SVS%NSV_DSTEND), &
- ZUSTAR, ZRESA_SEA, PTA, PRHOA, DST%XEMISSIG_DST, DST%XEMISRADIUS_DST, &
- JPMODE_DST, XDENSITY_DST, XMOLARWEIGHT_DST, ZCONVERTFACM0_DST, &
- ZCONVERTFACM6_DST, ZCONVERTFACM3_DST, LVARSIG_DST, LRGFIX_DST, &
- CVERMOD )
-
+IF (CHS%SVS%NDSTEQ>0) THEN
+ !
+ IBEG = CHS%SVS%NSV_DSTBEG
+ IEND = CHS%SVS%NSV_DSTEND
+ !
+ CALL DSLT_DEP(PSV(:,IBEG:IEND), PSFTS(:,IBEG:IEND), ZUSTAR, ZRESA_SEA, PTA, &
+ PRHOA, DST%XEMISSIG_DST, DST%XEMISRADIUS_DST, JPMODE_DST, &
+ XDENSITY_DST, XMOLARWEIGHT_DST, ZCONVERTFACM0_DST, ZCONVERTFACM6_DST, &
+ ZCONVERTFACM3_DST, LVARSIG_DST, LRGFIX_DST, CVERMOD )
+ !
CALL MASSFLUX2MOMENTFLUX( &
- PSFTS(:,SM%CHS%SVS%NSV_DSTBEG:SM%CHS%SVS%NSV_DSTEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
- PRHOA, & !I [kg/m3] air density
- DST%XEMISRADIUS_DST, &!I [um] emitted radius for the modes (max 3)
- DST%XEMISSIG_DST, &!I [-] emitted sigma for the different modes (max 3)
- NDSTMDE, &
- ZCONVERTFACM0_DST, &
- ZCONVERTFACM6_DST, &
- ZCONVERTFACM3_DST, &
- LVARSIG_DST, LRGFIX_DST )
+ PSFTS(:,IBEG:IEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
+ PRHOA, & !I [kg/m3] air density
+ DST%XEMISRADIUS_DST, &!I [um] emitted radius for the modes (max 3)
+ DST%XEMISSIG_DST, &!I [-] emitted sigma for the different modes (max 3)
+ NDSTMDE, &
+ ZCONVERTFACM0_DST, &
+ ZCONVERTFACM6_DST, &
+ ZCONVERTFACM3_DST, &
+ LVARSIG_DST, LRGFIX_DST )
+ !
ENDIF
-
-IF (SM%CHS%SVS%NSLTEQ>0) THEN
- CALL DSLT_DEP(PSV(:,SM%CHS%SVS%NSV_SLTBEG:SM%CHS%SVS%NSV_SLTEND), PSFTS(:,SM%CHS%SVS%NSV_SLTBEG:SM%CHS%SVS%NSV_SLTEND), &
- ZUSTAR, ZRESA_SEA, PTA, PRHOA, SLT%XEMISSIG_SLT, SLT%XEMISRADIUS_SLT, &
- JPMODE_SLT, XDENSITY_SLT, XMOLARWEIGHT_SLT, ZCONVERTFACM0_SLT, &
- ZCONVERTFACM6_SLT, ZCONVERTFACM3_SLT, LVARSIG_SLT, LRGFIX_SLT, &
- CVERMOD )
-
+!
+IF (CHS%SVS%NSLTEQ>0) THEN
+ !
+ IBEG = CHS%SVS%NSV_SLTBEG
+ IEND = CHS%SVS%NSV_SLTEND
+ !
+ ISLT = IEND - IBEG + 1
+ !
+ CALL COUPLING_SLT_n(SLT, &
+ SIZE(ZUSTAR,1), & !I [nbr] number of sea point
+ ISLT, & !I [nbr] number of sea salt variables
+ ZWIND, & !I [m/s] wind velocity
+ PSFTS(:,IBEG:IEND) )
+ !
+ CALL DSLT_DEP(PSV(:,IBEG:IEND), PSFTS(:,IBEG:IEND), ZUSTAR, ZRESA_SEA, PTA, &
+ PRHOA, SLT%XEMISSIG_SLT, SLT%XEMISRADIUS_SLT, JPMODE_SLT, &
+ XDENSITY_SLT, XMOLARWEIGHT_SLT, ZCONVERTFACM0_SLT, ZCONVERTFACM6_SLT, &
+ ZCONVERTFACM3_SLT, LVARSIG_SLT, LRGFIX_SLT, CVERMOD )
+ !
CALL MASSFLUX2MOMENTFLUX( &
- PSFTS(:,SM%CHS%SVS%NSV_SLTBEG:SM%CHS%SVS%NSV_SLTEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
- PRHOA, & !I [kg/m3] air density
- SLT%XEMISRADIUS_SLT, &!I [um] emitted radius for the modes (max 3)
- SLT%XEMISSIG_SLT, &!I [-] emitted sigma for the different modes (max 3)
- NSLTMDE, &
- ZCONVERTFACM0_SLT, &
- ZCONVERTFACM6_SLT, &
- ZCONVERTFACM3_SLT, &
- LVARSIG_SLT, LRGFIX_SLT )
+ PSFTS(:,IBEG:IEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
+ PRHOA, & !I [kg/m3] air density
+ SLT%XEMISRADIUS_SLT, &!I [um] emitted radius for the modes (max 3)
+ SLT%XEMISSIG_SLT, &!I [-] emitted sigma for the different modes (max 3)
+ NSLTMDE, &
+ ZCONVERTFACM0_SLT, &
+ ZCONVERTFACM6_SLT, &
+ ZCONVERTFACM3_SLT, &
+ LVARSIG_SLT, LRGFIX_SLT )
+ !
ENDIF
!
!-------------------------------------------------------------------------------
! Inline diagnostics at time t for SST and TRAD
!-------------------------------------------------------------------------------
!
- CALL DIAG_INLINE_SEAFLUX_n(SM%DGS, SM%DGSI, SM%S, &
- PTSTEP, PTA, ZQA, PPA, PPS, PRHOA, PU, &
- PV, PZREF, PUREF, ZCD, ZCDN, ZCH, ZCE, ZRI, ZHU, &
- ZZ0H, ZQSAT, ZSFTH, ZSFTQ, ZSFU, ZSFV, &
- PDIR_SW, PSCA_SW, PLW, ZDIR_ALB, ZSCA_ALB, &
- ZEMIS, ZTRAD, PRAIN, PSNOW, &
- ZCD_ICE, ZCDN_ICE, ZCH_ICE, ZCE_ICE, ZRI_ICE, &
- ZZ0_ICE, ZZ0H_ICE, ZQSAT_ICE, ZSFTH_ICE, ZSFTQ_ICE, &
- ZSFU_ICE, ZSFV_ICE)
+CALL DIAG_INLINE_SEAFLUX_n(DGS%O, DGS%D, DGS%DC, DGS%DI, DGS%DIC, DGS%DMI, &
+ S, PTSTEP, PTA, ZQA, PPA, PPS, PRHOA, PU, &
+ PV, PZREF, PUREF, ZCD, ZCDN, ZCH, ZCE, ZRI, ZHU,&
+ ZZ0H, ZQSAT, ZSFTH, ZSFTQ, ZSFU, ZSFV, &
+ PDIR_SW, PSCA_SW, PLW, ZDIR_ALB, ZSCA_ALB, &
+ ZEMIS, ZTRAD, PRAIN, PSNOW, &
+ ZCD_ICE, ZCDN_ICE, ZCH_ICE, ZCE_ICE, ZRI_ICE, &
+ ZZ0_ICE, ZZ0H_ICE, ZQSAT_ICE, ZSFTH_ICE, &
+ ZSFTQ_ICE, ZSFU_ICE, ZSFV_ICE)
!
!-------------------------------------------------------------------------------
! A kind of "average_flux"
!-------------------------------------------------------------------------------
!
-IF (SM%S%LHANDLE_SIC) THEN
- PSFTH (:) = ZSFTH (:) * ( 1 - SM%S%XSIC (:)) + ZSFTH_ICE(:) * SM%S%XSIC(:)
- PSFTQ (:) = ZSFTQ (:) * ( 1 - SM%S%XSIC (:)) + ZSFTQ_ICE(:) * SM%S%XSIC(:)
- PSFU (:) = ZSFU (:) * ( 1 - SM%S%XSIC (:)) + ZSFU_ICE(:) * SM%S%XSIC(:)
- PSFV (:) = ZSFV (:) * ( 1 - SM%S%XSIC (:)) + ZSFV_ICE(:) * SM%S%XSIC(:)
+IF (S%LHANDLE_SIC) THEN
+ PSFTH (:) = ZSFTH (:) * ( 1 - S%XSIC (:)) + ZSFTH_ICE(:) * S%XSIC(:)
+ PSFTQ (:) = ZSFTQ (:) * ( 1 - S%XSIC (:)) + ZSFTQ_ICE(:) * S%XSIC(:)
+ PSFU (:) = ZSFU (:) * ( 1 - S%XSIC (:)) + ZSFU_ICE(:) * S%XSIC(:)
+ PSFV (:) = ZSFV (:) * ( 1 - S%XSIC (:)) + ZSFV_ICE(:) * S%XSIC(:)
ELSE
- PSFTH (:) = ZSFTH (:)
- PSFTQ (:) = ZSFTQ (:)
- PSFU (:) = ZSFU (:)
- PSFV (:) = ZSFV (:)
+ PSFTH (:) = ZSFTH (:)
+ PSFTQ (:) = ZSFTQ (:)
+ PSFU (:) = ZSFU (:)
+ PSFV (:) = ZSFV (:)
ENDIF
!
!-------------------------------------------------------------------------------
@@ -549,81 +564,76 @@ ENDIF
!
! Daily update Sea surface salinity from monthly data
!
-IF (SM%S%LINTERPOL_SSS .AND. MOD(SM%S%TTIME%TIME,XDAY) == 0.) THEN
- CALL INTERPOL_SST_MTH(SM%S, &
- SM%S%TTIME%TDATE%YEAR,SM%S%TTIME%TDATE%MONTH,SM%S%TTIME%TDATE%DAY,'S',SM%S%XSSS)
- IF (ANY(SM%S%XSSS(:)<0.0)) THEN
- CALL ABOR1_SFX('COUPLING_SEAFLUX_N: XSSS should be >=0')
- ENDIF
+IF (S%LINTERPOL_SSS .AND. MOD(S%TTIME%TIME,XDAY) == 0.) THEN
+ CALL INTERPOL_SST_MTH(S,'S')
+ IF (ANY(S%XSSS(:)<0.0)) THEN
+ CALL ABOR1_SFX('COUPLING_SEAFLUX_N: XSSS should be >=0')
+ ENDIF
ENDIF
!
!-------------------------------------------------------------------------------
! SEA-ICE coupling at time t+1
!-------------------------------------------------------------------------------
!
-IF (SM%S%LHANDLE_SIC) THEN
- IF (SM%S%LINTERPOL_SIC) THEN
- IF ((MOD(SM%S%TTIME%TIME,XDAY) == 0.) .OR. (PTIMEC <= PTSTEP )) THEN
+IF (S%LHANDLE_SIC) THEN
+ !
+ IF (S%LINTERPOL_SIC) THEN
+ IF ((MOD(S%TTIME%TIME,XDAY) == 0.) .OR. (PTIMEC <= PTSTEP )) THEN
! Daily update Sea Ice Cover constraint from monthly data
- CALL INTERPOL_SST_MTH(SM%S, &
- SM%S%TTIME%TDATE%YEAR,SM%S%TTIME%TDATE%MONTH,SM%S%TTIME%TDATE%DAY,'C',SM%S%XFSIC)
- IF (ANY(SM%S%XFSIC(:)>1.0).OR.ANY(SM%S%XFSIC(:)<0.0)) THEN
- CALL ABOR1_SFX('COUPLING_SEAFLUX_N: FSIC should be >=0 and <=1')
- ENDIF
- ENDIF
- ENDIF
- IF (SM%S%LINTERPOL_SIT) THEN
- IF ((MOD(SM%S%TTIME%TIME,XDAY) == 0.) .OR. (PTIMEC <= PTSTEP )) THEN
+ CALL INTERPOL_SST_MTH(S,'C')
+ IF (ANY(S%XFSIC(:)>1.0).OR.ANY(S%XFSIC(:)<0.0)) THEN
+ CALL ABOR1_SFX('COUPLING_SEAFLUX_N: FSIC should be >=0 and <=1')
+ ENDIF
+ ENDIF
+ ENDIF
+ !
+ IF (S%LINTERPOL_SIT) THEN
+ IF ((MOD(S%TTIME%TIME,XDAY) == 0.) .OR. (PTIMEC <= PTSTEP )) THEN
! Daily update Sea Ice Thickness constraint from monthly data
- CALL INTERPOL_SST_MTH(SM%S, &
- SM%S%TTIME%TDATE%YEAR,SM%S%TTIME%TDATE%MONTH,SM%S%TTIME%TDATE%DAY,'H',SM%S%XFSIT)
- IF (ANY(SM%S%XFSIT(:)<0.0)) THEN
- CALL ABOR1_SFX('COUPLING_SEAFLUX_N: XFSIT should be >=0')
- ENDIF
- ENDIF
- ENDIF
- IF (SM%S%CSEAICE_SCHEME=='GELATO') THEN
- CALL SEAICE_GELATO1D_n(SM%S, &
- HPROGRAM,PTIMEC, PTSTEP, SM%S%TGLT, SM%S%XSST, SM%S%XSSS, &
- SM%S%XFSIC, SM%S%XFSIT, SM%S%XSIC, SM%S%XTICE, SM%S%XICE_ALB)
- ENDIF
- ! Update of cell-averaged albedo, emissivity and radiative
- ! temperature is done later
+ CALL INTERPOL_SST_MTH(S,'H')
+ IF (ANY(S%XFSIT(:)<0.0)) THEN
+ CALL ABOR1_SFX('COUPLING_SEAFLUX_N: XFSIT should be >=0')
+ ENDIF
+ ENDIF
+ ENDIF
+ !
+ IF (S%CSEAICE_SCHEME=='GELATO') THEN
+ CALL SEAICE_GELATO1D_n(S, HPROGRAM,PTIMEC, PTSTEP)
+ ENDIF
+ ! Update of cell-averaged albedo, emissivity and radiative
+ ! temperature is done later
ENDIF
!
!-------------------------------------------------------------------------------
! OCEANIC COUPLING, IMPOSED SST OR INTERPOLATED SST AT TIME t+1
!-------------------------------------------------------------------------------
!
-IF (SM%O%LMERCATOR) THEN
- !
- ! Update SST reference profile for relaxation purpose
- IF (SM%DTS%LSST_DATA) THEN
- CALL SST_UPDATE(SM%DTS, SM%S, &
- SM%OR%XSEAT_REL(:,NOCKMIN+1), SM%S%TTIME)
- !
- ! Convert to degree C for ocean model
- SM%OR%XSEAT_REL(:,NOCKMIN+1) = SM%OR%XSEAT_REL(:,NOCKMIN+1) - XTT
- ENDIF
- !
- CALL MOD1D_n(SM%DGO, SM%O, SM%OR, SM%SG, SM%S, &
- HPROGRAM,PTIME,ZEMIS(:),ZDIR_ALB(:,1:KSW),ZSCA_ALB(:,1:KSW),&
- PLW(:),PSCA_SW(:,1:KSW),PDIR_SW(:,1:KSW),PSFTH(:), &
- PSFTQ(:),PSFU(:),PSFV(:),PRAIN(:),SM%S%XSST(:))
- !
-ELSEIF(SM%DTS%LSST_DATA)THEN
- !
- ! Imposed SST
- !
- CALL SST_UPDATE(SM%DTS, SM%S, &
- SM%S%XSST, SM%S%TTIME)
- !
-ELSEIF (SM%S%LINTERPOL_SST.AND.MOD(SM%S%TTIME%TIME,XDAY) == 0.) THEN
+IF (O%LMERCATOR) THEN
+ !
+ ! Update SST reference profile for relaxation purpose
+ IF (DTS%LSST_DATA) THEN
+ CALL SST_UPDATE(DTS, S, OR%XSEAT_REL(:,NOCKMIN+1))
+ !
+ ! Convert to degree C for ocean model
+ OR%XSEAT_REL(:,NOCKMIN+1) = OR%XSEAT_REL(:,NOCKMIN+1) - XTT
+ ENDIF
+ !
+ CALL MOD1D_n(DGS%GO, O, OR, G%XLAT, S, &
+ HPROGRAM,PTIME,ZEMIS(:),ZDIR_ALB(:,1:KSW),ZSCA_ALB(:,1:KSW),&
+ PLW(:),PSCA_SW(:,1:KSW),PDIR_SW(:,1:KSW),PSFTH(:), &
+ PSFTQ(:),PSFU(:),PSFV(:),PRAIN(:))
+ !
+ELSEIF(DTS%LSST_DATA) THEN
+ !
+ ! Imposed SST
+ !
+ CALL SST_UPDATE(DTS, S, S%XSST)
+ !
+ELSEIF (S%LINTERPOL_SST.AND.MOD(S%TTIME%TIME,XDAY) == 0.) THEN
!
! Imposed monthly SST
!
- CALL INTERPOL_SST_MTH(SM%S, &
- SM%S%TTIME%TDATE%YEAR,SM%S%TTIME%TDATE%MONTH,SM%S%TTIME%TDATE%DAY,'T',SM%S%XSST)
+ CALL INTERPOL_SST_MTH(S,'T')
!
ENDIF
!
@@ -633,25 +643,25 @@ ENDIF
!difficult to do. Maybe it will be done later. However, Ts is at time t+1
!-------------------------------------------------------------------------------
!
-IF (SM%S%LHANDLE_SIC) THEN
- IF (SM%S%CSEAICE_SCHEME/='GELATO') THEN
- SM%S%XTICE=SM%S%XSST
- SM%S%XSIC=SM%S%XFSIC
- SM%S%XICE_ALB=XALBSEAICE
- ENDIF
- PTSURF (:) = SM%S%XSST (:) * ( 1 - SM%S%XSIC (:)) + SM%S%XTICE(:) * SM%S%XSIC(:)
- PQSURF (:) = ZQSAT (:) * ( 1 - SM%S%XSIC (:)) + ZQSAT_ICE(:) * SM%S%XSIC(:)
- ZZ0W (:) = ( 1 - SM%S%XSIC(:) ) * 1.0/(LOG(PUREF(:)/ZZ0(:)) **2) + &
- SM%S%XSIC(:) * 1.0/(LOG(PUREF(:)/ZZ0_ICE(:))**2)
- PZ0 (:) = PUREF (:) * EXP ( - SQRT ( 1./ ZZ0W(:) ))
- ZZ0W (:) = ( 1 - SM%S%XSIC(:) ) * 1.0/(LOG(PZREF(:)/ZZ0H(:)) **2) + &
- SM%S%XSIC(:) * 1.0/(LOG(PZREF(:)/ZZ0H_ICE(:))**2)
- PZ0H (:) = PZREF (:) * EXP ( - SQRT ( 1./ ZZ0W(:) ))
+IF (S%LHANDLE_SIC) THEN
+ IF (S%CSEAICE_SCHEME/='GELATO') THEN
+ S%XTICE = S%XSST
+ S%XSIC = S%XFSIC
+ S%XICE_ALB = XALBSEAICE
+ ENDIF
+ PTSURF (:) = S%XSST(:) * ( 1 - S%XSIC (:)) + S%XTICE(:) * S%XSIC(:)
+ PQSURF (:) = ZQSAT (:) * ( 1 - S%XSIC (:)) + ZQSAT_ICE(:) * S%XSIC(:)
+ ZZ0W (:) = ( 1 - S%XSIC(:) ) * 1.0/(LOG(PUREF(:)/ZZ0(:)) **2) + &
+ S%XSIC(:) * 1.0/(LOG(PUREF(:)/ZZ0_ICE(:))**2)
+ PZ0 (:) = PUREF (:) * EXP ( - SQRT ( 1./ ZZ0W(:) ))
+ ZZ0W (:) = ( 1 - S%XSIC(:) ) * 1.0/(LOG(PZREF(:)/ZZ0H(:)) **2) + &
+ S%XSIC(:) * 1.0/(LOG(PZREF(:)/ZZ0H_ICE(:))**2)
+ PZ0H (:) = PZREF (:) * EXP ( - SQRT ( 1./ ZZ0W(:) ))
ELSE
- PTSURF (:) = SM%S%XSST (:)
- PQSURF (:) = ZQSAT (:)
- PZ0 (:) = SM%S%XZ0 (:)
- PZ0H (:) = ZZ0H (:)
+ PTSURF (:) = S%XSST(:)
+ PQSURF (:) = ZQSAT (:)
+ PZ0 (:) = S%XZ0 (:)
+ PZ0H (:) = ZZ0H (:)
ENDIF
!
!-------------------------------------------------------------------------------
@@ -659,10 +669,7 @@ ENDIF
!the energy budget between surfex and the atmosphere
!-------------------------------------------------------------------------------
!
- CALL UPDATE_RAD_SEA(SM%S%CSEA_ALB,SM%S%XSST,PZENITH2,XTTS,SM%S%XEMIS, &
- SM%S%XDIR_ALB,SM%S%XSCA_ALB,PDIR_ALB,PSCA_ALB,&
- PEMIS,PTRAD,SM%S%LHANDLE_SIC,SM%S%XTICE,SM%S%XSIC, &
- SM%S%XICE_ALB,PU,PV)
+ CALL UPDATE_RAD_SEA(S,PZENITH2,XTTS,PDIR_ALB,PSCA_ALB,PEMIS,PTRAD,PU,PV)
!
!=======================================================================================
!
@@ -670,7 +677,7 @@ IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_N',1,ZHOOK_HANDLE)
!
!=======================================================================================
!
- CONTAINS
+CONTAINS
!
SUBROUTINE SEA_MOMENTUM_FLUXES(PCD, PSFU, PSFV)
!
@@ -733,7 +740,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_N: COMPLEMENT_EACH_OTHER_FLUX',0,ZHOOK_HANDLE)
!
- WHERE (SM%S%XSIC(:) == 1.)
+ WHERE (S%XSIC(:) == 1.)
ZSFTH=ZSFTH_ICE
ZSFTQ=ZSFTQ_ICE
ZSFU=ZSFU_ICE
@@ -746,7 +753,7 @@ IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_N: COMPLEMENT_EACH_OTHER_FLUX',0,ZHOOK
ZRI=ZRI_ICE
ZZ0H=ZZ0H_ICE
END WHERE
- WHERE (SM%S%XSIC(:) == 0.)
+ WHERE (S%XSIC(:) == 0.)
ZSFTH_ICE=ZSFTH
ZSFTQ_ICE=ZSFTQ
ZSFU_ICE=ZSFU
diff --git a/src/SURFEX/coupling_sean.F90 b/src/SURFEX/coupling_sean.F90
index 69dcd057d1c4da757c913c4baa26903674ec014f..97a8b1f7c6b4bc5a12c04551a6e869c22869d3b8 100644
--- a/src/SURFEX/coupling_sean.F90
+++ b/src/SURFEX/coupling_sean.F90
@@ -3,16 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################################
-SUBROUTINE COUPLING_SEA_n (SM, DGL, U, DST, SLT, &
- HPROGRAM, HCOUPLING, PTIMEC, &
+SUBROUTINE COUPLING_SEA_n (SM, DGO, DL, DLC, U, DST, SLT, HPROGRAM, HCOUPLING, PTIMEC, &
PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, &
PAZIM,PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+ PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST )
! ###############################################################################
!
!!**** *COUPLING_SEA_n * - Chooses the surface schemes for sea
@@ -40,7 +38,7 @@ SUBROUTINE COUPLING_SEA_n (SM, DGL, U, DST, SLT, &
!
USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t
!
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_DST_n, ONLY : DST_t
USE MODD_SLT_n, ONLY : SLT_t
@@ -61,7 +59,9 @@ IMPLICIT NONE
!
!
TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM
-TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: DL
+TYPE(DIAG_t), INTENT(INOUT) :: DLC
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(DST_t), INTENT(INOUT) :: DST
TYPE(SLT_t), INTENT(INOUT) :: SLT
@@ -142,31 +142,25 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('COUPLING_SEA_N',0,ZHOOK_HANDLE)
IF (U%CSEA=='SEAFLX') THEN
- CALL COUPLING_SEAFLUX_OROG_n(SM, DST, SLT, &
- HPROGRAM, HCOUPLING, PTIMEC, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- KI, KSV, KSW, &
+ CALL COUPLING_SEAFLUX_OROG_n(SM, DST, SLT, HPROGRAM, HCOUPLING, PTIMEC, &
+ PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, &
PTSUN, PZENITH, PZENITH2,PAZIM, &
PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+ PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST )
ELSE IF (U%CSEA=='FLUX ') THEN
- CALL COUPLING_IDEAL_FLUX(DGL, &
- HPROGRAM, HCOUPLING, PTIMEC, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- KI, KSV, KSW, &
+ CALL COUPLING_IDEAL_FLUX(DGO, DL, DLC, HPROGRAM, HCOUPLING, PTIMEC, &
+ PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, &
PTSUN, PZENITH, PAZIM, &
PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+ PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST )
ELSE IF (U%CSEA=='NONE ') THEN
PSFTH = 0.
PSFTQ = 0.
diff --git a/src/SURFEX/coupling_seawat_sbln.F90 b/src/SURFEX/coupling_seawat_sbln.F90
deleted file mode 100644
index f3426e66f37cfd62f50af42feec5654461a91c58..0000000000000000000000000000000000000000
--- a/src/SURFEX/coupling_seawat_sbln.F90
+++ /dev/null
@@ -1,34 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ###############################################################################
-SUBROUTINE COUPLING_SEAWAT_SBL_n !
-!!**** *COUPLING_SEAWAT_SBL_n * - Adds a SBL into SEAFLUX
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 09/2007
-!! V. Masson 05/2009 Implicitation of momentum fluxes
-!! S. Riette 06/2009 Initialisation of XT, PQ, XU and XTKE on canopy levels
-!! S. Riette 10/2009 Iterative computation of XZ0
-!! S. Riette 01/2010 Use of interpol_sbl to compute 10m wind diagnostic
-!! B. Decharme 04/2013 new coupling variables
-!----------------------------------------------------------------
-!
-!!
-END SUBROUTINE COUPLING_SEAWAT_SBL_n
diff --git a/src/SURFEX/coupling_surf_atmn.F90 b/src/SURFEX/coupling_surf_atmn.F90
index e472b0f4cb6a41b19c5a3a376080c017c1fc8527..112179e74e37237accb2cb7641a91125f7c302b3 100644
--- a/src/SURFEX/coupling_surf_atmn.F90
+++ b/src/SURFEX/coupling_surf_atmn.F90
@@ -3,16 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #################################################################################
-SUBROUTINE COUPLING_SURF_ATM_n (YSC, &
- HPROGRAM, HCOUPLING, PTIMEC, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, &
- PZENITH2,PAZIM,PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, &
- HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+SUBROUTINE COUPLING_SURF_ATM_n (YSC, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, &
+ KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, &
+ PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, &
+ PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS,&
+ PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, &
+ PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
+ PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, &
+ PPET_B_COEF, PPEQ_B_COEF, HTEST )
! #################################################################################
!
!!**** *COUPLING_INLAND_WATER_n * - Driver to call the schemes for the
@@ -158,7 +156,7 @@ REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF
- CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
+CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
!
!
!* 0.2 declarations of local variables
@@ -201,7 +199,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('COUPLING_SURF_ATM_N',0,ZHOOK_HANDLE)
- CPROGNAME=HPROGRAM
+CPROGNAME=HPROGRAM
!
IF (HTEST/='OK') THEN
CALL ABOR1_SFX('COUPLING_SURF_ATMN: FATAL ERROR DURING ARGUMENT TRANSFER')
@@ -362,12 +360,8 @@ XTIME_TOWN = XTIME_TOWN + (MPI_WTIME() - XTIME0)*100./MAX(1,YSC%U%NSIZE_TOWN)
! Grid box average fluxes/properties:
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
- CALL AVERAGE_FLUX(ZFRAC_TILE, &
- ZSFTH_TILE, ZSFTQ_TILE, &
- ZSFTS_TILE, ZSFCO2_TILE, &
- ZSFU_TILE, ZSFV_TILE, &
- PSFTH, PSFTQ, PSFTS, PSFCO2, &
- PSFU, PSFV )
+ CALL AVERAGE_FLUX(ZFRAC_TILE, ZSFTH_TILE, ZSFTQ_TILE, ZSFTS_TILE, ZSFCO2_TILE, &
+ ZSFU_TILE, ZSFV_TILE, PSFTH, PSFTQ, PSFTS, PSFCO2, PSFU, PSFV )
!
! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Chemical Emissions:
@@ -384,13 +378,11 @@ IF ((YSC%SV%NBEQ > 0).AND.(YSC%CHU%LCH_SURF_EMIS)) THEN
DO JI=1,SIZE(YSC%CHE%TSEMISS)
IF (SIZE(YSC%CHE%TSEMISS(JI)%NETIMES).GT.INBTS) INBTS=SIZE(YSC%CHE%TSEMISS(JI)%NETIMES)
ENDDO
- CALL CH_EMISSION_FLUX_n(YSC, &
- HPROGRAM,PTIME,PSFTS(:,YSC%SV%NSV_CHSBEG:IINDEXEND),PRHOA,PTSTEP,INBTS)
+ CALL CH_EMISSION_FLUX_n(YSC%DTCO, YSC%U, YSC%CHE, YSC%SV, YSC%CHU, &
+ HPROGRAM,PTIME,PSFTS(:,YSC%SV%NSV_CHSBEG:IINDEXEND),PRHOA,PTSTEP,INBTS)
ELSE IF (YSC%CHU%CCH_EMIS=='SNAP') THEN
- CALL CH_EMISSION_SNAP_n(YSC%CHN, &
- HPROGRAM,YSC%U%NSIZE_FULL,PTIME,PTSUN,KYEAR,KMONTH,KDAY,PRHOA,YSC%UG%XLON)
- CALL CH_EMISSION_TO_ATM_n(YSC%CHN, YSC%SV, &
- PSFTS,PRHOA)
+ CALL CH_EMISSION_SNAP_n(YSC%CHN, HPROGRAM,YSC%U%NSIZE_FULL,PTIME,PTSUN,KYEAR,KMONTH,KDAY,PRHOA,YSC%UG%G%XLON)
+ CALL CH_EMISSION_TO_ATM_n(YSC%CHN, YSC%SV, PSFTS,PRHOA)
END IF
END IF
!
@@ -414,23 +406,20 @@ END DO
! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Radiative fluxes
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- CALL AVERAGE_RAD(ZFRAC_TILE, &
- ZDIR_ALB_TILE, ZSCA_ALB_TILE, ZEMIS_TILE, ZTRAD_TILE, &
- PDIR_ALB, PSCA_ALB, PEMIS, PTRAD )
+ CALL AVERAGE_RAD(ZFRAC_TILE, ZDIR_ALB_TILE, ZSCA_ALB_TILE, &
+ ZEMIS_TILE, ZTRAD_TILE, PDIR_ALB, PSCA_ALB,&
+ PEMIS, PTRAD)
!
! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Physical properties
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- CALL AVERAGE_PHY(ZFRAC_TILE, &
- ZTSURF_TILE, ZZ0_TILE, &
+ CALL AVERAGE_PHY(ZFRAC_TILE, ZTSURF_TILE, ZZ0_TILE, &
ZZ0H_TILE, ZQSURF_TILE, &
- PUREF, PZREF, &
- PTSURF, PZ0, PZ0H, PQSURF )
+ PUREF, PZREF, PTSURF, PZ0, PZ0H, PQSURF )
!
! store these field to write in restart file (important for AGCM)
!
-IF(LCPL_GCM) CALL CPL_GCM_n(YSC%U, &
- KI,PZ0=PZ0,PZ0H=PZ0H,PQSURF=PQSURF)
+IF(LCPL_GCM) CALL CPL_GCM_n(YSC%U, KI,PZ0=PZ0,PZ0H=PZ0H,PQSURF=PQSURF)
!
! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Orographic friction
@@ -440,24 +429,22 @@ IF(LCPL_GCM) CALL CPL_GCM_n(YSC%U, &
! but only over continental area
!
IF (YSC%USS%CROUGH=="Z01D" .OR. YSC%USS%CROUGH=="Z04D") THEN
- CALL SSO_Z0_FRICTION_n(YSC%USS, &
- YSC%U%XSEA,PUREF,PRHOA,PU,PV,ZPEW_A_COEF,ZPEW_B_COEF,PSFU,PSFV)
+ CALL SSO_Z0_FRICTION_n(YSC%USS, YSC%U%XSEA,PUREF,PRHOA,PU,PV,ZPEW_A_COEF,ZPEW_B_COEF,PSFU,PSFV)
ELSE IF (YSC%USS%CROUGH=="BE04") THEN
- CALL SSO_BE04_FRICTION_n(YSC%SSCP, YSC%USS, &
- PTSTEP,YSC%U%XSEA,PUREF,PRHOA,PU,PV,PSFU,PSFV)
+ CALL SSO_BE04_FRICTION_n(YSC%SB, YSC%USS, PTSTEP,YSC%U%XSEA,PUREF,PRHOA,PU,PV,PSFU,PSFV)
END IF
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Inline diagnostics for full surface
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
- CALL DIAG_INLINE_SURF_ATM_n(YSC%DGU, &
+ CALL DIAG_INLINE_SURF_ATM_n(YSC%DUO, YSC%DU, &
PUREF, PZREF, PPS, PRHOA, PTRAD, PEMIS, PSFU, PSFV, PSFCO2)
!
IF (LHOOK) CALL DR_HOOK('COUPLING_SURF_ATM_N',1,ZHOOK_HANDLE)
!
!=======================================================================================
- CONTAINS
+CONTAINS
!=======================================================================================
SUBROUTINE TREAT_SURF(KTILE,KSIZE,KMASK)
!
@@ -588,65 +575,54 @@ ENDDO
!
IF (KTILE==1) THEN
!
- CALL COUPLING_SEA_n(YSC%SM, YSC%DGL, YSC%U, YSC%DST, YSC%SLT, &
- HPROGRAM, HCOUPLING, PTIMEC, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- YSC%U%NSIZE_SEA, KSV, KSW, &
- ZP_TSUN, ZP_ZENITH, ZP_ZENITH2,ZP_AZIM, &
- ZP_ZREF, ZP_UREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, ZP_CO2, HSV,&
- ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, PSW_BANDS, ZP_PS, ZP_PA, &
- ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, &
- ZP_TRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, ZP_TSURF, ZP_Z0, ZP_Z0H, ZP_QSURF, &
- ZP_PEW_A_COEF, ZP_PEW_B_COEF, &
- ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF, &
- 'OK' )
+ CALL COUPLING_SEA_n(YSC%SM, YSC%DLO, YSC%DL, YSC%DLC, YSC%U, YSC%NDST%AL(1), YSC%SLT, &
+ HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
+ YSC%U%NSIZE_SEA, KSV, KSW, ZP_TSUN, ZP_ZENITH, ZP_ZENITH2,ZP_AZIM, &
+ ZP_ZREF, ZP_UREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, &
+ ZP_CO2, HSV, ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, PSW_BANDS, &
+ ZP_PS, ZP_PA, ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, &
+ ZP_TRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, ZP_TSURF, ZP_Z0, ZP_Z0H, &
+ ZP_QSURF, ZP_PEW_A_COEF, ZP_PEW_B_COEF, ZP_PET_A_COEF, ZP_PEQ_A_COEF, &
+ ZP_PET_B_COEF, ZP_PEQ_B_COEF, 'OK' )
!
ELSEIF (KTILE==2) THEN
!
- CALL COUPLING_INLAND_WATER_n(YSC%FM, YSC%WM, YSC%DGL, YSC%U, YSC%DST, YSC%SLT, &
- HPROGRAM, HCOUPLING, PTIMEC, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- YSC%U%NSIZE_WATER, KSV, KSW, &
- ZP_TSUN, ZP_ZENITH, ZP_ZENITH2,ZP_AZIM, &
- ZP_ZREF, ZP_UREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, ZP_CO2, HSV,&
- ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, PSW_BANDS, ZP_PS, ZP_PA, &
- ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, &
- ZP_TRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, ZP_TSURF, ZP_Z0, ZP_Z0H, ZP_QSURF, &
- ZP_PEW_A_COEF, ZP_PEW_B_COEF, &
- ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF, &
- 'OK' )
+ CALL COUPLING_INLAND_WATER_n(YSC%FM, YSC%WM, YSC%DLO, YSC%DL, YSC%DLC, YSC%U, &
+ YSC%NDST%AL(1), YSC%SLT, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, &
+ KYEAR, KMONTH, KDAY, PTIME, YSC%U%NSIZE_WATER, KSV, KSW, &
+ ZP_TSUN, ZP_ZENITH, ZP_ZENITH2, ZP_AZIM, ZP_ZREF, ZP_UREF, &
+ ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, ZP_CO2, HSV, &
+ ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, PSW_BANDS, &
+ ZP_PS, ZP_PA, ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, &
+ ZP_SFV, ZP_TRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, ZP_TSURF, &
+ ZP_Z0, ZP_Z0H, ZP_QSURF, ZP_PEW_A_COEF, ZP_PEW_B_COEF, &
+ ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF, &
+ 'OK' )
!
ELSEIF (KTILE==3) THEN
!
- CALL COUPLING_NATURE_n(YSC%DTCO, YSC%UG, YSC%U, YSC%USS, YSC%IM, YSC%DTZ, &
- YSC%GDM%DTGD, YSC%GRM%DTGR, YSC%GRM%TGRO, YSC%DGL, YSC%DST, YSC%SLT, &
- HPROGRAM, HCOUPLING, PTIMEC, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- YSC%U%NSIZE_NATURE, KSV, KSW, &
- ZP_TSUN, ZP_ZENITH, ZP_ZENITH2,ZP_AZIM, &
- ZP_ZREF, ZP_UREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, ZP_CO2, HSV,&
- ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, PSW_BANDS, ZP_PS, ZP_PA, &
- ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, &
- ZP_TRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, ZP_TSURF, ZP_Z0, ZP_Z0H, ZP_QSURF, &
- ZP_PEW_A_COEF, ZP_PEW_B_COEF, &
- ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF, &
- 'OK' )
+ CALL COUPLING_NATURE_n(YSC%DTCO, YSC%UG, YSC%U, YSC%USS, YSC%IM, YSC%DTZ, YSC%DLO, YSC%DL, &
+ YSC%DLC, YSC%NDST, YSC%SLT, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, &
+ KYEAR, KMONTH, KDAY, PTIME, YSC%U%NSIZE_NATURE, KSV, KSW, ZP_TSUN, &
+ ZP_ZENITH, ZP_ZENITH2, ZP_AZIM, ZP_ZREF, ZP_UREF, ZP_ZS, ZP_U, ZP_V, &
+ ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, ZP_CO2, HSV, ZP_RAIN, ZP_SNOW, ZP_LW, &
+ ZP_DIR_SW, ZP_SCA_SW, PSW_BANDS, ZP_PS, ZP_PA, ZP_SFTQ, ZP_SFTH, &
+ ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, ZP_TRAD, ZP_DIR_ALB, ZP_SCA_ALB, &
+ ZP_EMIS, ZP_TSURF, ZP_Z0, ZP_Z0H, ZP_QSURF, ZP_PEW_A_COEF, &
+ ZP_PEW_B_COEF, ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, &
+ ZP_PEQ_B_COEF, 'OK' )
!
ELSEIF (KTILE==4) THEN
!
- CALL COUPLING_TOWN_n(YSC%DTCO, YSC%U, YSC%IM%DTI, YSC%IM%IG, YSC%IM%I, YSC%DGL, &
- YSC%DST, YSC%SLT, YSC%TM, YSC%GDM, YSC%GRM, &
- HPROGRAM, HCOUPLING, PTIMEC, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- YSC%U%NSIZE_TOWN, KSV, KSW, &
- ZP_TSUN, ZP_ZENITH, ZP_AZIM, &
- ZP_ZREF, ZP_UREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, ZP_CO2, HSV,&
- ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, PSW_BANDS, ZP_PS, ZP_PA, &
- ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, &
- ZP_TRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, ZP_TSURF, ZP_Z0, ZP_Z0H, ZP_QSURF, &
- ZP_PEW_A_COEF, ZP_PEW_B_COEF, &
- ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF, &
- 'OK' )
+ CALL COUPLING_TOWN_n(YSC%DTCO, YSC%U, YSC%DLO, YSC%DL, YSC%DLC, YSC%NDST%AL(1), YSC%SLT, YSC%TM, &
+ YSC%GDM, YSC%GRM, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, &
+ KDAY, PTIME, YSC%U%NSIZE_TOWN, KSV, KSW, ZP_TSUN, ZP_ZENITH, ZP_AZIM, &
+ ZP_ZREF, ZP_UREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, &
+ ZP_CO2, HSV, ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, PSW_BANDS, &
+ ZP_PS, ZP_PA, ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, &
+ ZP_TRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, ZP_TSURF, ZP_Z0, ZP_Z0H, &
+ ZP_QSURF, ZP_PEW_A_COEF, ZP_PEW_B_COEF, ZP_PET_A_COEF, ZP_PEQ_A_COEF, &
+ ZP_PET_B_COEF, ZP_PEQ_B_COEF, 'OK' )
!
ENDIF
!
diff --git a/src/SURFEX/coupling_teb_orographyn.F90 b/src/SURFEX/coupling_teb_orographyn.F90
index 5aa73710a19591bb3f84f270479877746156679c..388b266b1799dc158f7fcad4c2d0eb51ec85b060 100644
--- a/src/SURFEX/coupling_teb_orographyn.F90
+++ b/src/SURFEX/coupling_teb_orographyn.F90
@@ -3,16 +3,15 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################################
-SUBROUTINE COUPLING_TEB_OROGRAPHY_n (DTCO, DTI, IG, I, DST, SLT, TM, GDM, GRM, &
- HPROGRAM, HCOUPLING, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PAZIM, &
- PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+SUBROUTINE COUPLING_TEB_OROGRAPHY_n (DTCO, DST, SLT, TM, GDM, GRM, HPROGRAM, HCOUPLING, &
+ PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN,&
+ PZENITH, PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, &
+ PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, &
+ PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, &
+ PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, &
+ PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, &
+ PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
+ HTEST )
! ###############################################################################
!
!!**** *COUPLING_TEB_OROGRAPHY_n * - Modifies the input forcing if not
@@ -43,9 +42,6 @@ SUBROUTINE COUPLING_TEB_OROGRAPHY_n (DTCO, DTI, IG, I, DST, SLT, TM, GDM, GRM,
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
USE MODD_DST_n, ONLY : DST_t
USE MODD_SLT_n, ONLY : SLT_t
USE MODD_SURFEX_n, ONLY : TEB_MODEL_t
@@ -72,9 +68,6 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
TYPE(DST_t), INTENT(INOUT) :: DST
TYPE(SLT_t), INTENT(INOUT) :: SLT
TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM
@@ -183,8 +176,8 @@ IF(LVERTSHIFT)THEN
ZRAIN(:) = XUNDEF
ZSNOW(:) = XUNDEF
!
- CALL FORCING_VERT_SHIFT(PZS,TM%TOP%XZS,PTA,PQA,PPA,PRHOA,PLW,PRAIN,PSNOW,&
- ZTA,ZQA,ZPA,ZRHOA,ZLW,ZRAIN,ZSNOW )
+ CALL FORCING_VERT_SHIFT(PZS, TM%TOP%XZS, PTA, PQA, PPA, PRHOA, PLW, PRAIN, PSNOW, &
+ ZTA, ZQA, ZPA, ZRHOA, ZLW, ZRAIN, ZSNOW )
!
ZPS(:) = ZPA(:) + (PPS(:) - PPA(:))
!
@@ -206,18 +199,15 @@ ELSE
!
ENDIF
!
- CALL COUPLING_TEB_n(DTCO, DTI, IG, I, DST, SLT, TM, GDM, GRM, &
- HPROGRAM, HCOUPLING, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- KI, KSV, KSW, &
- PTSUN, PZENITH, PAZIM, &
- PZREF, PUREF, TM%TOP%XZS, PU, PV, ZQA, ZTA, ZRHOA,PSV, PCO2, HSV, &
- ZRAIN, ZSNOW, ZLW, PDIR_SW, PSCA_SW, PSW_BANDS, ZPS, ZPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF, &
- 'OK' )
+ CALL COUPLING_TEB_n(DTCO, DST, SLT, TM%TOP, TM%SB, TM%G, TM%CHT, TM%NT, TM%TPN, TM%TIR, TM%BOP, &
+ TM%NB, TM%TD, GDM, GRM,HPROGRAM, HCOUPLING, PTSTEP, KYEAR, KMONTH, KDAY,&
+ PTIME, KI, KSV, KSW, PTSUN, PZENITH, PAZIM, PZREF, PUREF, TM%TOP%XZS, &
+ PU, PV, ZQA, ZTA, ZRHOA,PSV, PCO2, HSV, ZRAIN, ZSNOW, ZLW, PDIR_SW, &
+ PSCA_SW, PSW_BANDS, ZPS, ZPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
+ PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
+ PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, ZPET_B_COEF, &
+ ZPEQ_B_COEF, 'OK' )
+!
IF (LHOOK) CALL DR_HOOK('COUPLING_TEB_OROGRAPHY_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/coupling_tebn.F90 b/src/SURFEX/coupling_tebn.F90
index affb77f4e99c2408894aa3f7f919ecb51c6da799..5f7072ea3ecf0e6f98a33359ac4fd703e72183a4 100644
--- a/src/SURFEX/coupling_tebn.F90
+++ b/src/SURFEX/coupling_tebn.F90
@@ -3,16 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################################
-SUBROUTINE COUPLING_TEB_n (DTCO, DTI, IG, I, DST, SLT, TM, GDM, GRM, &
- HPROGRAM, HCOUPLING, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PAZIM, &
- PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+SUBROUTINE COUPLING_TEB_n (DTCO, DST, SLT, TOP, SB, G, CHT, NT, TPN, TIR, BOP, NB, TD, GDM, GRM, &
+ HPROGRAM, HCOUPLING, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV,&
+ KSW, PTSUN, PZENITH, PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, &
+ PRHOA, PSV, PCO2, HSV, PRAIN, PSN, PLW, PDIR_SW, PSCA_SW, &
+ PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
+ PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
+ PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
+ PPEQ_B_COEF, HTEST )
! ###############################################################################
!
!!**** *COUPLING_TEB_n * - Driver for TEB
@@ -46,12 +44,20 @@ SUBROUTINE COUPLING_TEB_n (DTCO, DTI, IG, I, DST, SLT, TM, GDM, GRM, &
!!---------------------------------------------------------------
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
USE MODD_DST_n, ONLY : DST_t
USE MODD_SLT_n, ONLY : SLT_t
-USE MODD_SURFEX_n, ONLY : TEB_MODEL_t
+!
+USE MODD_CH_TEB_n, ONLY : CH_TEB_t
+USE MODD_CANOPY_n, ONLY: CANOPY_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
+USE MODD_TEB_PANEL_n, ONLY : TEB_PANEL_t
+USE MODD_TEB_IRRIG_n, ONLY : TEB_IRRIG_t
+USE MODD_TEB_n, ONLY : TEB_NP_t
+USE MODD_SURFEX_n, ONLY : TEB_DIAG_t
+USE MODD_BEM_OPTION_n, ONLY : BEM_OPTIONS_t
+USE MODD_BEM_n, ONLY : BEM_NP_t
+!
USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t
USE MODD_SURFEX_n, ONLY : TEB_GREENROOF_MODEL_t
!
@@ -59,22 +65,19 @@ USE MODD_REPROD_OPER, ONLY : CIMPLICIT_WIND
!
USE MODD_CSTS, ONLY : XRD, XCPD, XP00, XLVTT, XPI, XKARMAN, XG
USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-!
+!
USE MODD_DST_SURF
USE MODD_SLT_SURF
!
-!
USE MODE_DSLT_SURF
USE MODE_THERMOS
USE MODE_SBLS
!
-USE MODI_GOTO_WRAPPER_TEB_PATCH
USE MODI_AVERAGE_RAD
USE MODI_SM10
USE MODI_ADD_FORECAST_TO_DATE_SURF
USE MODI_DIAG_INLINE_TEB_n
-USE MODI_DIAG_MISC_TEB_n
+USE MODI_CUMUL_DIAG_TEB_n
USE MODI_CH_AER_DEP
USE MODI_CH_DEP_TOWN
USE MODI_DSLT_DEP
@@ -98,12 +101,22 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
TYPE(DST_t), INTENT(INOUT) :: DST
TYPE(SLT_t), INTENT(INOUT) :: SLT
-TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM
+!
+TYPE(CH_TEB_t), INTENT(INOUT) :: CHT
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
+TYPE(GRID_t), INTENT(INOUT) :: G
+TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+TYPE(TEB_PANEL_t), INTENT(INOUT) :: TPN
+TYPE(TEB_IRRIG_t), INTENT(INOUT) :: TIR
+TYPE(TEB_NP_t), INTENT(INOUT) :: NT
+!
+TYPE(TEB_DIAG_t), INTENT(INOUT) :: TD
+!
+TYPE(BEM_OPTIONS_t), INTENT(INOUT) :: BOP
+TYPE(BEM_NP_t), INTENT(INOUT) :: NB
+!
TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM
!
@@ -145,7 +158,7 @@ REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model su
REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa)
REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model orography (m)
REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3)
-REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s)
+REAL, DIMENSION(KI), INTENT(IN) :: PSN ! snow precipitation (kg/m2/s)
REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s)
!
!
@@ -189,274 +202,193 @@ REAL, DIMENSION(KI) :: ZWIND ! wind
REAL, DIMENSION(KI) :: ZU_CANYON ! wind in canyon
REAL, DIMENSION(KI) :: ZT_CANYON ! temperature in canyon
REAL, DIMENSION(KI) :: ZQ_CANYON ! specific humidity in canyon
+REAL, DIMENSION(KI) :: ZAVG_T_CANYON ! temperature in canyon for town
+REAL, DIMENSION(KI) :: ZAVG_Q_CANYON ! specific humidity in canyon for town
REAL, DIMENSION(KI) :: ZT_CAN ! temperature in canyon (evolving in TEB)
REAL, DIMENSION(KI) :: ZQ_CAN ! specific humidity in canyon (evolving in TEB)
!
-REAL, DIMENSION(KI) :: ZRN_ROOF ! net radiation on roof
-REAL, DIMENSION(KI) :: ZH_ROOF ! sensible heat flux on roof
-REAL, DIMENSION(KI) :: ZLE_ROOF ! latent heat flux on roof
-REAL, DIMENSION(KI) :: ZLEW_ROOF ! latent heat flux on snowfree roof
-REAL, DIMENSION(KI) :: ZGFLUX_ROOF ! storage flux in roof
-REAL, DIMENSION(KI) :: ZRUNOFF_ROOF! water runoff from roof
-REAL, DIMENSION(KI) :: ZRN_ROAD ! net radiation on road
-REAL, DIMENSION(KI) :: ZH_ROAD ! sensible heat flux on road
-REAL, DIMENSION(KI) :: ZLE_ROAD ! latent heat flux on road
-REAL, DIMENSION(KI) :: ZLEW_ROAD ! latent heat flux on snowfree road
-REAL, DIMENSION(KI) :: ZGFLUX_ROAD ! storage flux in road
-REAL, DIMENSION(KI) :: ZRUNOFF_ROAD! water runoff from road
-REAL, DIMENSION(KI) :: ZIRRIG_ROAD ! water supply from road summer watering
-REAL, DIMENSION(KI) :: ZRN_WALL_A ! net radiation on walls
-REAL, DIMENSION(KI) :: ZH_WALL_A ! sensible heat flux on walls
-REAL, DIMENSION(KI) :: ZLE_WALL_A ! latent heat flux on walls
-REAL, DIMENSION(KI) :: ZGFLUX_WALL_A!storage flux in walls
-REAL, DIMENSION(KI) :: ZRN_WALL_B ! net radiation on walls
-REAL, DIMENSION(KI) :: ZH_WALL_B ! sensible heat flux on walls
-REAL, DIMENSION(KI) :: ZLE_WALL_B ! latent heat flux on walls
-REAL, DIMENSION(KI) :: ZGFLUX_WALL_B!storage flux in walls
-REAL, DIMENSION(KI) :: ZRN_GARDEN ! net radiation on green areas
-REAL, DIMENSION(KI) :: ZH_GARDEN ! sensible heat flux on green areas
-REAL, DIMENSION(KI) :: ZLE_GARDEN ! latent heat flux on green areas
-REAL, DIMENSION(KI) :: ZGFLUX_GARDEN!storage flux in green areas
-REAL, DIMENSION(KI) :: ZRUNOFF_GARDEN!runoff over green areas
-REAL, DIMENSION(KI) :: ZDRAIN_GARDEN !drainage over green areas
-REAL, DIMENSION(KI) :: ZIRRIG_GARDEN !water supply from garden summer irrigation
-REAL, DIMENSION(KI) :: ZRN_GREENROOF! net radiation on green roofs
-REAL, DIMENSION(KI) :: ZH_GREENROOF ! sensible heat flux on green roofs
-REAL, DIMENSION(KI) :: ZLE_GREENROOF! latent heat flux on green roofs
-REAL, DIMENSION(KI) :: ZGFLUX_GREENROOF ! storage flux in green roofs
-REAL, DIMENSION(KI) :: ZG_GREENROOF_ROOF ! heat flux between base of greenroof
-REAL, DIMENSION(KI) :: ZRUNOFF_GREENROOF ! water runoff from green roof
-REAL, DIMENSION(KI) :: ZDRAIN_GREENROOF ! water drainage from green roof
-REAL, DIMENSION(KI) :: ZIRRIG_GREENROOF ! water supply from green roof summer irrigation
-REAL, DIMENSION(KI) :: ZRN_STRLROOF ! net radiation on structural roof
-REAL, DIMENSION(KI) :: ZH_STRLROOF ! sensible heat flux on structural roof
-REAL, DIMENSION(KI) :: ZLE_STRLROOF ! latent heat flux on structural roof
-REAL, DIMENSION(KI) :: ZGFLUX_STRLROOF ! storage flux in structural roof
-REAL, DIMENSION(KI) :: ZRUNOFF_STRLROOF ! runoff over structural roof
-REAL, DIMENSION(KI) :: ZH_PANEL ! sensible heat flux on solar panel
-REAL, DIMENSION(KI) :: ZTHER_PROD_PANEL ! thermal energy production from solar panel (W/m2 panel)
-REAL, DIMENSION(KI) :: ZPHOT_PROD_PANEL ! photovoltaic energy production from solar panel (W/m2 panel)
-REAL, DIMENSION(KI) :: ZPROD_PANEL ! averaged energy production from solar panel (W/m2 panel)
-REAL, DIMENSION(KI) :: ZTHER_PROD_BLD ! thermal energy production from solar panel (W/m2 bld)
-REAL, DIMENSION(KI) :: ZPHOT_PROD_BLD ! photovoltaic energy production from solar panel (W/m2 bld)
+REAL, DIMENSION(KI) :: ZPEW_A_COEF ! implicit coefficients
+REAL, DIMENSION(KI) :: ZPEW_B_COEF ! needed if HCOUPLING='I'
+!
+REAL, DIMENSION(KI) :: ZT_LOWCAN ! temperature at lowest canyon level (K)
+REAL, DIMENSION(KI) :: ZQ_LOWCAN ! humidity at lowest canyon level (kg/kg)
+REAL, DIMENSION(KI) :: ZU_LOWCAN ! wind at lowest canyon level (m/s)
+REAL, DIMENSION(KI) :: ZZ_LOWCAN ! height of lowest canyon level (m)
+!
+REAL, DIMENSION(KI) :: ZPEW_A_COEF_LOWCAN ! implicit coefficients for wind coupling
+REAL, DIMENSION(KI) :: ZPEW_B_COEF_LOWCAN ! between first canopy level and road
+!
+REAL, DIMENSION(KI) :: ZTA ! temperature at canyon level just above roof (K)
+REAL, DIMENSION(KI) :: ZPA ! pressure at canyon level just above roof (K)
+REAL, DIMENSION(KI) :: ZUA ! wind at canyon level just above roof (m/s)
+REAL, DIMENSION(KI) :: ZUREF ! height of canyon level just above roof (m)
+REAL, DIMENSION(KI) :: ZZREF ! height of canyon level just above roof (m)
+!
+REAL, DIMENSION(KI) :: ZDIR_SW ! total direct SW
+REAL, DIMENSION(KI) :: ZSCA_SW ! total diffuse SW
+REAL, DIMENSION(KI) :: ZAVG_SCA_SW
+REAL, DIMENSION(KI) :: ZAVG_DIR_SW
+REAL, DIMENSION(KI,SIZE(PDIR_SW,2)) :: ZDIR_SWB ! total direct SW per band
+REAL, DIMENSION(KI,SIZE(PSCA_SW,2)) :: ZSCA_SWB ! total diffuse SW per band
+!
+!
+REAL, DIMENSION(KI) :: ZLE_WL_A ! latent heat flux on walls
+REAL, DIMENSION(KI) :: ZLE_WL_B ! latent heat flux on walls
+REAL, DIMENSION(KI) :: ZAVG_H_WL
+!
REAL, DIMENSION(KI) :: ZPROD_BLD ! averaged energy production from solar panel (W/m2 bld)
-REAL, DIMENSION(KI) :: ZRN_PANEL ! net radiation of solar panel
-REAL, DIMENSION(KI) :: ZRN_BLT ! net radiation on built surf
-REAL, DIMENSION(KI) :: ZH_BLT ! sensible heat flux on built surf
-REAL, DIMENSION(KI) :: ZLE_BLT ! latent heat flux on built surf
-REAL, DIMENSION(KI) :: ZGFLUX_BLT ! storage flux in built surf
+REAL, DIMENSION(KI) :: ZHU_BLD
+REAL, DIMENSION(KI) :: ZAVG_TI_BLD
+REAL, DIMENSION(KI) :: ZAVG_QI_BLD
+!
REAL, DIMENSION(KI) :: ZRN_GRND ! net radiation on ground built surf
REAL, DIMENSION(KI) :: ZH_GRND ! sensible heat flux on ground built surf
REAL, DIMENSION(KI) :: ZLE_GRND ! latent heat flux on ground built surf
-REAL, DIMENSION(KI) :: ZGFLUX_GRND ! storage flux in ground built surf
-REAL, DIMENSION(KI) :: ZRNSNOW_ROOF ! net radiation over snow
-REAL, DIMENSION(KI) :: ZHSNOW_ROOF ! sensible heat flux over snow
-REAL, DIMENSION(KI) :: ZLESNOW_ROOF ! latent heat flux over snow
-REAL, DIMENSION(KI) :: ZGSNOW_ROOF ! flux under the snow
-REAL, DIMENSION(KI) :: ZMELT_ROOF ! snow melt
-REAL, DIMENSION(KI) :: ZRNSNOW_ROAD ! net radiation over snow
-REAL, DIMENSION(KI) :: ZHSNOW_ROAD ! sensible heat flux over snow
-REAL, DIMENSION(KI) :: ZLESNOW_ROAD ! latent heat flux over snow
-REAL, DIMENSION(KI) :: ZGSNOW_ROAD ! flux under the snow
-REAL, DIMENSION(KI) :: ZMELT_ROAD ! snow melt
+REAL, DIMENSION(KI) :: ZGFLX_GRND ! storage flux in ground built surf
+REAL, DIMENSION(KI) :: ZUW_GRND ! momentum flux for ground built surf
+REAL, DIMENSION(KI) :: ZDUWDU_GRND !
+REAL, DIMENSION(KI) :: ZAC_GRND ! ground built surf aerodynamical conductance
+REAL, DIMENSION(KI) :: ZAC_GRND_WAT ! ground built surf water aerodynamical conductance
+REAL, DIMENSION(KI) :: ZEMIT_LW_GRND
+REAL, DIMENSION(KI) :: ZREF_SW_GRND ! total solar rad reflected from ground
+REAL, DIMENSION(KI) :: ZAVG_UW_GRND
+REAL, DIMENSION(KI) :: ZAVG_DUWDU_GRND
+REAL, DIMENSION(KI) :: ZAVG_H_GRND
+REAL, DIMENSION(KI) :: ZAVG_AC_GRND
+REAL, DIMENSION(KI) :: ZAVG_AC_GRND_WAT
+REAL, DIMENSION(KI) :: ZAVG_E_GRND
+REAL, DIMENSION(KI) :: ZAVG_REF_SW_GRND
+REAL, DIMENSION(KI) :: ZAVG_EMIT_LW_GRND
+!
+REAL, DIMENSION(KI) :: ZLEW_RF ! latent heat flux on snowfree roof
+REAL, DIMENSION(KI) :: ZRNSN_RF ! net radiation over snow
+REAL, DIMENSION(KI) :: ZHSN_RF ! sensible heat flux over snow
+REAL, DIMENSION(KI) :: ZLESN_RF ! latent heat flux over snow
+REAL, DIMENSION(KI) :: ZGSN_RF ! flux under the snow
+REAL, DIMENSION(KI) :: ZMELT_RF ! snow melt
+REAL, DIMENSION(KI) :: ZUW_RF ! momentum flux for roofs
+REAL, DIMENSION(KI) :: ZDUWDU_RF !
+REAL, DIMENSION(KI) :: ZAVG_UW_RF
+REAL, DIMENSION(KI) :: ZAVG_DUWDU_RF
+REAL, DIMENSION(KI) :: ZAVG_H_RF
+REAL, DIMENSION(KI) :: ZAVG_E_RF
+!
+REAL, DIMENSION(KI) :: ZLEW_RD ! latent heat flux on snowfree road
+REAL, DIMENSION(KI) :: ZRNSN_RD ! net radiation over snow
+REAL, DIMENSION(KI) :: ZHSN_RD ! sensible heat flux over snow
+REAL, DIMENSION(KI) :: ZLESN_RD ! latent heat flux over snow
+REAL, DIMENSION(KI) :: ZGSN_RD ! flux under the snow
+REAL, DIMENSION(KI) :: ZMELT_RD ! snow melt
+REAL, DIMENSION(KI) :: ZAC_RD ! road aerodynamical conductance
+REAL, DIMENSION(KI) :: ZAC_RD_WAT ! road water aerodynamical conductance
+!
+REAL, DIMENSION(KI) :: ZAC_GD ! green area aerodynamical conductance
+REAL, DIMENSION(KI) :: ZAC_GD_WAT! green area water aerodynamical conductance
+REAL, DIMENSION(KI,1):: ZESN_GD ! green area snow emissivity
+!
+REAL, DIMENSION(KI) :: ZAC_GRF ! green roof aerodynamical conductance
+REAL, DIMENSION(KI) :: ZAC_GRF_WAT! green roof water aerodynamical conductance
!
REAL, DIMENSION(KI) :: ZTRAD ! radiative temperature for current patch
REAL, DIMENSION(KI) :: ZEMIS ! emissivity for current patch
-REAL, DIMENSION(KI,TM%TOP%NTEB_PATCH) :: ZTRAD_PATCH ! radiative temperature for each patch
-REAL, DIMENSION(KI,TM%TOP%NTEB_PATCH) :: ZEMIS_PATCH ! emissivity for each patch
-REAL, DIMENSION(KI,KSW,TM%TOP%NTEB_PATCH) :: ZDIR_ALB_PATCH ! direct albedo per wavelength and patch
-REAL, DIMENSION(KI,KSW,TM%TOP%NTEB_PATCH) :: ZSCA_ALB_PATCH ! diffuse albedo per wavelength and patch
+REAL, DIMENSION(KI,TOP%NTEB_PATCH) :: ZTRAD_PATCH ! radiative temperature for each patch
+REAL, DIMENSION(KI,TOP%NTEB_PATCH) :: ZEMIS_PATCH ! emissivity for each patch
+!
+REAL, DIMENSION(KI) :: ZDIR_ALB ! direct albedo of town
+REAL, DIMENSION(KI) :: ZSCA_ALB ! diffuse albedo of town
+REAL, DIMENSION(KI,KSW,TOP%NTEB_PATCH) :: ZDIR_ALB_PATCH ! direct albedo per wavelength and patch
+REAL, DIMENSION(KI,KSW,TOP%NTEB_PATCH) :: ZSCA_ALB_PATCH ! diffuse albedo per wavelength and patch
+REAL, DIMENSION(KI) :: ZAVG_DIR_ALB ! direct albedo of town
+REAL, DIMENSION(KI) :: ZAVG_SCA_ALB ! diffuse albedo of town
!
-REAL, DIMENSION(KI) :: ZRN ! net radiation over town
-REAL, DIMENSION(KI) :: ZH ! sensible heat flux over town
-REAL, DIMENSION(KI) :: ZLE ! latent heat flux over town
-REAL, DIMENSION(KI) :: ZGFLUX ! flux through the ground
REAL, DIMENSION(KI) :: ZSFCO2 ! CO2 flux over town
-REAL, DIMENSION(KI) :: ZQF_BLD ! domestic heating
-REAL, DIMENSION(KI) :: ZFLX_BLD ! flux from bld
-REAL, DIMENSION(KI) :: ZDQS_TOWN ! storage inside town materials
-REAL, DIMENSION(KI) :: ZQF_TOWN ! total anthropogenic heat
-REAL, DIMENSION(KI) :: ZEVAP ! evaporation (km/m2/s)
-REAL, DIMENSION(KI) :: ZRUNOFF_TOWN ! runoff over the ground
+!
+REAL, DIMENSION(KI) :: ZRI ! Richardson number
REAL, DIMENSION(KI) :: ZCD ! drag coefficient
REAL, DIMENSION(KI) :: ZCDN ! neutral drag coefficient
REAL, DIMENSION(KI) :: ZCH ! heat drag
-REAL, DIMENSION(KI) :: ZRI ! Richardson number
-REAL, DIMENSION(KI) :: ZUW_GRND ! momentum flux for ground built surf
-REAL, DIMENSION(KI) :: ZUW_ROOF ! momentum flux for roofs
-REAL, DIMENSION(KI) :: ZDUWDU_GRND !
-REAL, DIMENSION(KI) :: ZDUWDU_ROOF !
-REAL, DIMENSION(KI) :: ZUSTAR ! friction velocity
-REAL, DIMENSION(KI) :: ZSFU ! momentum flux for patch (U direction)
-REAL, DIMENSION(KI) :: ZSFV ! momentum flux for patch (V direction)
-REAL, DIMENSION(KI) :: ZAVG_DIR_ALB ! direct albedo of town
-REAL, DIMENSION(KI) :: ZAVG_SCA_ALB ! diffuse albedo of town
-REAL, DIMENSION(KI) :: ZAVG_T_CANYON ! temperature in canyon for town
-REAL, DIMENSION(KI) :: ZAVG_Q_CANYON ! specific humidity in canyon for town
+REAL, DIMENSION(KI) :: ZRN ! net radiation over town
+REAL, DIMENSION(KI) :: ZH ! sensible heat flux over town
+REAL, DIMENSION(KI) :: ZLE ! latent heat flux over town
+REAL, DIMENSION(KI) :: ZGFLX ! flux through the ground
+REAL, DIMENSION(KI) :: ZEVAP ! evaporation (km/m2/s)
!
REAL, DIMENSION(KI) :: ZAVG_CD ! aggregated drag coefficient
REAL, DIMENSION(KI) :: ZAVG_CDN ! aggregated neutral drag coefficient
REAL, DIMENSION(KI) :: ZAVG_RI ! aggregated Richardson number
REAL, DIMENSION(KI) :: ZAVG_CH ! aggregated Heat transfer coefficient
!
-REAL, DIMENSION(KI) :: ZDIR_ALB ! direct albedo of town
-REAL, DIMENSION(KI) :: ZSCA_ALB ! diffuse albedo of town
+REAL, DIMENSION(KI) :: ZUSTAR ! friction velocity
+REAL, DIMENSION(KI) :: ZSFU ! momentum flux for patch (U direction)
+REAL, DIMENSION(KI) :: ZSFV ! momentum flux for patch (V direction)
!
REAL, DIMENSION(KI) :: ZH_TRAFFIC ! anthropogenic sensible
-! ! heat fluxes due to traffic
+! ! heat fluxes due to traffic
REAL, DIMENSION(KI) :: ZLE_TRAFFIC ! anthropogenic latent
-! ! heat fluxes due to traffic
-REAL, DIMENSION(KI) :: ZRESA_TOWN ! aerodynamical resistance
-REAL, DIMENSION(KI) :: ZAC_ROAD ! road aerodynamical conductance
-REAL, DIMENSION(KI) :: ZAC_GARDEN ! green area aerodynamical conductance
-REAL, DIMENSION(KI) :: ZAC_GRND ! ground built surf aerodynamical conductance
-REAL, DIMENSION(KI) :: ZAC_GREENROOF ! green roof aerodynamical conductance
-REAL, DIMENSION(KI) :: ZAC_ROAD_WAT ! road water aerodynamical conductance
-REAL, DIMENSION(KI) :: ZAC_GARDEN_WAT! green area water aerodynamical conductance
-REAL, DIMENSION(KI) :: ZAC_GRND_WAT ! ground built surf water aerodynamical conductance
-REAL, DIMENSION(KI) :: ZAC_GREENROOF_WAT! green roof water aerodynamical conductance
-REAL, DIMENSION(KI,1):: ZESNOW_GARDEN ! green area snow emissivity
+! ! heat fluxes due to traffic
!
-REAL :: ZBEGIN_TRAFFIC_TIME ! start traffic time (solar time, s)
-REAL :: ZEND_TRAFFIC_TIME ! end traffic time (solar time, s)
-REAL, DIMENSION(KI) :: ZDIR_SW ! total direct SW
-REAL, DIMENSION(KI) :: ZSCA_SW ! total diffuse SW
-REAL, DIMENSION(KI) :: ZPEW_A_COEF ! implicit coefficients
-REAL, DIMENSION(KI) :: ZPEW_B_COEF ! needed if HCOUPLING='I'
-
-!***** CANOPY *****
-REAL, DIMENSION(KI) :: ZSFLUX_U ! Surface flux u'w' (m2/s2)
-REAL, DIMENSION(KI) :: ZSFLUX_T ! Surface flux w'T' (mK/s)
-REAL, DIMENSION(KI) :: ZSFLUX_Q ! Surface flux w'q' (kgm2/s)
-REAL, DIMENSION(KI,TM%TCP%NLVL) :: ZFORC_U ! tendency due to drag force for wind
-REAL, DIMENSION(KI,TM%TCP%NLVL) :: ZDFORC_UDU! formal derivative of
-! ! tendency due to drag force for wind
-REAL, DIMENSION(KI,TM%TCP%NLVL) :: ZFORC_E ! tendency due to drag force for TKE
-REAL, DIMENSION(KI,TM%TCP%NLVL) :: ZDFORC_EDE! formal derivative of
-! ! tendency due to drag force for TKE
-REAL, DIMENSION(KI,TM%TCP%NLVL) :: ZFORC_T ! tendency due to drag force for Temp
-REAL, DIMENSION(KI,TM%TCP%NLVL) :: ZDFORC_TDT! formal derivative of
-! ! tendency due to drag force for Temp
-REAL, DIMENSION(KI,TM%TCP%NLVL) :: ZFORC_Q ! tendency due to drag force for hum
-REAL, DIMENSION(KI,TM%TCP%NLVL) :: ZDFORC_QDQ! formal derivative of
-! ! tendency due to drag force for hum.
-
-REAL, DIMENSION(KI) :: ZAVG_UW_GRND
-REAL, DIMENSION(KI) :: ZAVG_DUWDU_GRND
-REAL, DIMENSION(KI) :: ZAVG_UW_ROOF
-REAL, DIMENSION(KI) :: ZAVG_DUWDU_ROOF
-REAL, DIMENSION(KI) :: ZAVG_H_GRND
-REAL, DIMENSION(KI) :: ZAVG_H_WALL
-REAL, DIMENSION(KI) :: ZAVG_H_ROOF
-REAL, DIMENSION(KI) :: ZAVG_E_GRND
-REAL, DIMENSION(KI) :: ZAVG_E_ROOF
-REAL, DIMENSION(KI) :: ZAVG_AC_GRND
-REAL, DIMENSION(KI) :: ZAVG_AC_GRND_WAT
-REAL, DIMENSION(KI) :: ZAVG_Z0_TOWN
-REAL, DIMENSION(KI) :: ZAVG_RESA_TOWN
-REAL, DIMENSION(KI) :: ZAVG_USTAR ! town avegared Ustar
-REAL, DIMENSION(KI) :: ZAVG_BLD ! town averaged building fraction
-REAL, DIMENSION(KI) :: ZAVG_BLD_HEIGHT ! town averaged building height
-REAL, DIMENSION(KI) :: ZAVG_WALL_O_HOR ! town averaged Wall/hor ratio
-REAL, DIMENSION(KI) :: ZAVG_CAN_HW_RATIO ! town averaged road aspect ratio
-REAL, DIMENSION(KI) :: ZAVG_H
-REAL, DIMENSION(KI) :: ZAVG_LE
-REAL, DIMENSION(KI) :: ZAVG_RN
-REAL, DIMENSION(KI) :: ZAVG_GFLUX
-REAL, DIMENSION(KI) :: ZAVG_REF_SW_GRND
-REAL, DIMENSION(KI) :: ZAVG_REF_SW_FAC
-REAL, DIMENSION(KI) :: ZAVG_SCA_SW
-REAL, DIMENSION(KI) :: ZAVG_DIR_SW
-REAL, DIMENSION(KI) :: ZAVG_EMIT_LW_FAC
-REAL, DIMENSION(KI) :: ZAVG_EMIT_LW_GRND
-REAL, DIMENSION(KI) :: ZAVG_T_RAD_IND
-REAL, DIMENSION(KI) :: ZT_LOWCAN ! temperature at lowest canyon level (K)
-REAL, DIMENSION(KI) :: ZQ_LOWCAN ! humidity at lowest canyon level (kg/kg)
-REAL, DIMENSION(KI) :: ZU_LOWCAN ! wind at lowest canyon level (m/s)
-REAL, DIMENSION(KI) :: ZZ_LOWCAN ! height of lowest canyon level (m)
-REAL, DIMENSION(KI) :: ZPEW_A_COEF_LOWCAN ! implicit coefficients for wind coupling
-REAL, DIMENSION(KI) :: ZPEW_B_COEF_LOWCAN ! between first canopy level and road
-REAL, DIMENSION(KI) :: ZTA ! temperature at canyon level just above roof (K)
-REAL, DIMENSION(KI) :: ZPA ! pressure at canyon level just above roof (K)
-REAL, DIMENSION(KI) :: ZUA ! wind at canyon level just above roof (m/s)
-REAL, DIMENSION(KI) :: ZUREF ! height of canyon level just above roof (m)
-REAL, DIMENSION(KI) :: ZZREF ! height of canyon level just above roof (m)
-REAL, DIMENSION(KI) :: ZLAMBDA_F ! frontal density (-)
-REAL, DIMENSION(KI) :: ZLMO ! Monin-Obukhov length at canopy height (m)
-REAL, DIMENSION(KI,TM%TCP%NLVL) :: ZL ! Mixing length generic profile at mid levels
+REAL :: ZBEGIN_TRAFFIC_TIME ! start traffic time (solar time, s)
+REAL :: ZEND_TRAFFIC_TIME ! end traffic time (solar time, s)
+!
+REAL, DIMENSION(KI) :: ZRESA ! aerodynamical resistance
+!
+REAL, DIMENSION(KI) :: ZEMIT_LW_FAC
+REAL, DIMENSION(KI) :: ZT_RAD_IND ! Indoor mean radiant temperature [K]
+REAL, DIMENSION(KI) :: ZREF_SW_FAC ! total solar rad reflected from facade
+!
+REAL, DIMENSION(KI) :: ZAVG_Z0
+REAL, DIMENSION(KI) :: ZAVG_RESA
+REAL, DIMENSION(KI) :: ZAVG_USTAR ! town avegared Ustar
+REAL, DIMENSION(KI) :: ZAVG_BLD ! town averaged building fraction
+REAL, DIMENSION(KI) :: ZAVG_BLD_HEIGHT ! town averaged building height
+REAL, DIMENSION(KI) :: ZAVG_WL_O_HOR ! town averaged Wall/hor ratio
+REAL, DIMENSION(KI) :: ZAVG_CAN_HW_RATIO ! town averaged road aspect ratio
+REAL, DIMENSION(KI) :: ZAVG_H
+REAL, DIMENSION(KI) :: ZAVG_LE
+REAL, DIMENSION(KI) :: ZAVG_RN
+REAL, DIMENSION(KI) :: ZAVG_GFLX
+REAL, DIMENSION(KI) :: ZAVG_REF_SW_FAC
+REAL, DIMENSION(KI) :: ZAVG_EMIT_LW_FAC
+REAL, DIMENSION(KI) :: ZAVG_T_RAD_IND
!
! absorbed solar and infra-red radiation by road, wall and roof
-!
-REAL, DIMENSION(KI) :: ZABS_SW_ROAD
-REAL, DIMENSION(KI) :: ZABS_SW_WALL_A
-REAL, DIMENSION(KI) :: ZABS_SW_WALL_B
-REAL, DIMENSION(KI) :: ZABS_SW_ROOF
-REAL, DIMENSION(KI) :: ZABS_SW_GARDEN
-REAL, DIMENSION(KI) :: ZABS_SW_GREENROOF
-REAL, DIMENSION(KI) :: ZABS_SW_PANEL
-REAL, DIMENSION(KI) :: ZABS_SW_SNOW_ROAD
-REAL, DIMENSION(KI) :: ZABS_SW_SNOW_ROOF
-REAL, DIMENSION(KI) :: ZABS_LW_SNOW_ROAD
-REAL, DIMENSION(KI) :: ZABS_LW_SNOW_ROOF
-REAL, DIMENSION(KI) :: ZABS_LW_ROAD
-REAL, DIMENSION(KI) :: ZABS_LW_WALL_A
-REAL, DIMENSION(KI) :: ZABS_LW_WALL_B
-REAL, DIMENSION(KI) :: ZABS_LW_ROOF
-REAL, DIMENSION(KI) :: ZABS_LW_GARDEN
-REAL, DIMENSION(KI) :: ZABS_LW_GREENROOF
-REAL, DIMENSION(KI) :: ZABS_LW_PANEL
-!
-REAL, DIMENSION(KI) :: ZU_UTCI ! wind speed for the UTCI calculation (m/s)
+!
+REAL, DIMENSION(KI) :: ZU_UTCI ! wind speed for the UTCI calculation (m/s)
-REAL, DIMENSION(KI) :: ZALFAU ! V+(1) = alfa u'w'(1) + beta
-REAL, DIMENSION(KI) :: ZBETAU ! V+(1) = alfa u'w'(1) + beta
-REAL, DIMENSION(KI) :: ZALFAT ! Th+(1) = alfa w'th'(1) + beta
-REAL, DIMENSION(KI) :: ZBETAT ! Th+(1) = alfa w'th'(1) + beta
-REAL, DIMENSION(KI) :: ZALFAQ ! Q+(1) = alfa w'q'(1) + beta
-REAL, DIMENSION(KI) :: ZBETAQ ! Q+(1) = alfa w'q'(1) + beta
+REAL, DIMENSION(KI) :: ZALFAU ! V+(1) = alfa u'w'(1) + beta
+REAL, DIMENSION(KI) :: ZBETAU ! V+(1) = alfa u'w'(1) + beta
+REAL, DIMENSION(KI) :: ZALFAT ! Th+(1) = alfa w'th'(1) + beta
+REAL, DIMENSION(KI) :: ZBETAT ! Th+(1) = alfa w'th'(1) + beta
+REAL, DIMENSION(KI) :: ZALFAQ ! Q+(1) = alfa w'q'(1) + beta
+REAL, DIMENSION(KI) :: ZBETAQ ! Q+(1) = alfa w'q'(1) + beta
!***** CANOPY *****
-REAL, DIMENSION(KI) :: ZWAKE ! reduction of average wind speed
+REAL, DIMENSION(KI) :: ZWAKE ! reduction of average wind speed
! ! in canyon due to direction average.
-! new local variables after BEM
-!
-REAL, DIMENSION(KI) :: ZCAP_SYS
-REAL, DIMENSION(KI) :: ZM_SYS
-REAL, DIMENSION(KI) :: ZCOP
-REAL, DIMENSION(KI) :: ZQ_SYS
-REAL, DIMENSION(KI) :: ZT_SYS
-REAL, DIMENSION(KI) :: ZTR_SW_WIN
-REAL, DIMENSION(KI) :: ZFAN_POWER
-REAL, DIMENSION(KI) :: ZABS_SW_WIN
-REAL, DIMENSION(KI) :: ZABS_LW_WIN
-REAL, DIMENSION(KI) :: ZH_BLD_COOL
-REAL, DIMENSION(KI) :: ZT_BLD_COOL
-REAL, DIMENSION(KI) :: ZH_BLD_HEAT
-REAL, DIMENSION(KI) :: ZLE_BLD_COOL
-REAL, DIMENSION(KI) :: ZLE_BLD_HEAT
-REAL, DIMENSION(KI) :: ZH_WASTE
-REAL, DIMENSION(KI) :: ZLE_WASTE
-REAL, DIMENSION(KI) :: ZHVAC_COOL
-REAL, DIMENSION(KI) :: ZHVAC_HEAT
!new local variables for UTCI calculation
-REAL, DIMENSION(KI) :: ZEMIT_LW_GRND
-REAL, DIMENSION(KI) :: ZEMIT_LW_FAC
-REAL, DIMENSION(KI) :: ZT_RAD_IND ! Indoor mean radiant temperature [K]
-REAL, DIMENSION(KI) :: ZREF_SW_GRND ! total solar rad reflected from ground
-REAL, DIMENSION(KI) :: ZREF_SW_FAC ! total solar rad reflected from facade
-REAL, DIMENSION(KI) :: ZHU_BLD
-REAL, DIMENSION(KI) :: ZAVG_TI_BLD
-REAL, DIMENSION(KI) :: ZAVG_QI_BLD
REAL, DIMENSION(KI) :: ZF1_o_B
-REAL, DIMENSION(KI,SIZE(PDIR_SW,2)) :: ZDIR_SWB ! total direct SW per band
-REAL, DIMENSION(KI,SIZE(PSCA_SW,2)) :: ZSCA_SWB ! total diffuse SW per band
!
-! occupation of buildings
-REAL, DIMENSION(SIZE(PTA)) :: ZCUR_TCOOL_TARGET ! Cooling target temperature at current time
-REAL, DIMENSION(SIZE(PTA)) :: ZCUR_THEAT_TARGET ! Heating target temperature at current time
-REAL, DIMENSION(SIZE(PTA)) :: ZCUR_QIN ! Internal heat gains at current time
+!***** CANOPY *****
+REAL, DIMENSION(KI) :: ZSFLUX_U ! Surface flux u'w' (m2/s2)
+REAL, DIMENSION(KI) :: ZSFLUX_T ! Surface flux w'T' (mK/s)
+REAL, DIMENSION(KI) :: ZSFLUX_Q ! Surface flux w'q' (kgm2/s)
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_U ! tendency due to drag force for wind
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_UDU! formal derivative of
+! ! tendency due to drag force for wind
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_E ! tendency due to drag force for TKE
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_EDE! formal derivative of
+! ! tendency due to drag force for TKE
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_T ! tendency due to drag force for Temp
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_TDT! formal derivative of
+! ! tendency due to drag force for Temp
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_Q ! tendency due to drag force for hum
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_QDQ! formal derivative of
+! ! tendency due to drag force for hum.
+REAL, DIMENSION(KI) :: ZLAMBDA_F ! frontal density (-)
+REAL, DIMENSION(KI) :: ZLMO ! Monin-Obukhov length at canopy height (m)
+REAL, DIMENSION(KI,SB%NLVL) :: ZL ! Mixing length generic profile at mid levels
!
-REAL, DIMENSION(KI) :: ZCOEF
+REAL, DIMENSION(KI) :: ZCOEF
!
REAL :: ZCONVERTFACM0_SLT, ZCONVERTFACM0_DST
REAL :: ZCONVERTFACM3_SLT, ZCONVERTFACM3_DST
@@ -468,7 +400,7 @@ INTEGER :: JJ
!
! number of TEB patches
!
-INTEGER :: JTEB_PATCH ! loop counter
+INTEGER :: JP, IBEG, IEND ! loop counter
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -522,14 +454,13 @@ ELSE
ZPEW_B_COEF = ZWIND
END IF
!
-!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Time evolution
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-TM%TOP%TTIME%TIME = TM%TOP%TTIME%TIME + PTSTEP
- CALL ADD_FORECAST_TO_DATE_SURF(TM%TOP%TTIME%TDATE%YEAR,TM%TOP%TTIME%TDATE%MONTH,&
- TM%TOP%TTIME%TDATE%DAY,TM%TOP%TTIME%TIME)
+TOP%TTIME%TIME = TOP%TTIME%TIME + PTSTEP
+ CALL ADD_FORECAST_TO_DATE_SURF(TOP%TTIME%TDATE%YEAR, TOP%TTIME%TDATE%MONTH,&
+ TOP%TTIME%TDATE%DAY, TOP%TTIME%TIME)
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Anthropogenic fluxes (except building heating)
@@ -538,10 +469,9 @@ TM%TOP%TTIME%TIME = TM%TOP%TTIME%TIME + PTSTEP
ZBEGIN_TRAFFIC_TIME = 21600.
ZEND_TRAFFIC_TIME = 64800.
!
-WHERE( PTSUN>ZBEGIN_TRAFFIC_TIME &
- .AND. PTSUN<ZEND_TRAFFIC_TIME )
- ZH_TRAFFIC (:) = TM%T%CUR%XH_TRAFFIC (:)
- ZLE_TRAFFIC (:) = TM%T%CUR%XLE_TRAFFIC (:)
+WHERE( PTSUN>ZBEGIN_TRAFFIC_TIME .AND. PTSUN<ZEND_TRAFFIC_TIME )
+ ZH_TRAFFIC (:) = NT%AL(1)%XH_TRAFFIC (:)
+ ZLE_TRAFFIC (:) = NT%AL(1)%XLE_TRAFFIC (:)
ELSEWHERE
ZH_TRAFFIC (:) = 0.
ZLE_TRAFFIC (:) = 0.
@@ -554,178 +484,168 @@ END WHERE
! Town averaged quantities to force canopy atmospheric layers
!-------------------------------------------------------------------------------------
-DO JTEB_PATCH=1,TM%TOP%NTEB_PATCH
- CALL GOTO_WRAPPER_TEB_PATCH(TM%B, TM%DGCT, TM%DGMT, TM%T, &
- GDM%TGD, GDM%TGDPE, GRM%TGR, GRM%TGRPE, JTEB_PATCH)
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_BLD, TM%T%CUR%XBLD )
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_BLD_HEIGHT, TM%T%CUR%XBLD_HEIGHT )
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_WALL_O_HOR, TM%T%CUR%XWALL_O_HOR )
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_CAN_HW_RATIO,TM%T%CUR%XCAN_HW_RATIO)
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_Z0_TOWN, TM%T%CUR%XZ0_TOWN )
+DO JP=1,TOP%NTEB_PATCH
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_BLD, NT%AL(JP)%XBLD )
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_BLD_HEIGHT, NT%AL(JP)%XBLD_HEIGHT )
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_WL_O_HOR, NT%AL(JP)%XWALL_O_HOR )
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_CAN_HW_RATIO,NT%AL(JP)%XCAN_HW_RATIO)
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_Z0, NT%AL(JP)%XZ0_TOWN )
END DO
!
-IF (TM%TOP%LCANOPY) THEN
-!-------------------------------------------------------------------------------------
-! Updates canopy vertical grid as a function of forcing height
-!-------------------------------------------------------------------------------------
-!
-!* determines where is the forcing level and modifies the upper levels of the canopy grid
-!
- CALL CANOPY_GRID_UPDATE(KI,TM%TCP%NLVL,ZAVG_BLD_HEIGHT,ZAVG_BLD_HEIGHT+PUREF,&
- TM%TCP%XZ,TM%TCP%XZF,TM%TCP%XDZ,TM%TCP%XDZF)
-!
-!* Initialisations of T, Q, TKE and wind at first time step
-!
-
- IF(ANY(TM%TCP%XT(:,:) == XUNDEF)) THEN
- DO JLAYER=1,TM%TCP%NLVL
- TM%TCP%XT(:,JLAYER) = PTA(:)
- TM%TCP%XQ(:,JLAYER) = PQA(:)
- TM%TCP%XU(:,JLAYER) = 2./XPI * ZWIND(:) &
- * LOG( ( 2.* TM%T%CUR%XBLD_HEIGHT(:)/3.) / TM%T%CUR%XZ0_TOWN(:)) &
- / LOG( (PUREF(:)+ 2.* TM%T%CUR%XBLD_HEIGHT(:)/3.) / TM%T%CUR%XZ0_TOWN(:))
+IF (TOP%LCANOPY) THEN
+ !-------------------------------------------------------------------------------------
+ ! Updates canopy vertical grid as a function of forcing height
+ !-------------------------------------------------------------------------------------
+ !
+ !* determines where is the forcing level and modifies the upper levels of the canopy grid
+ !
+ CALL CANOPY_GRID_UPDATE(KI, ZAVG_BLD_HEIGHT, ZAVG_BLD_HEIGHT+PUREF, SB)
+ !
+ !* Initialisations of T, Q, TKE and wind at first time step
+ !
+ IF(ANY(SB%XT(:,:) == XUNDEF)) THEN
+ DO JLAYER=1,SB%NLVL
+ SB%XT(:,JLAYER) = PTA(:)
+ SB%XQ(:,JLAYER) = PQA(:)
+ SB%XU(:,JLAYER) = 2./XPI * ZWIND(:) &
+ * LOG( ( 2.* NT%AL(1)%XBLD_HEIGHT(:)/3.) / NT%AL(1)%XZ0_TOWN(:)) &
+ / LOG( (PUREF(:)+ 2.* NT%AL(1)%XBLD_HEIGHT(:)/3.) / NT%AL(1)%XZ0_TOWN(:))
END DO
- TM%TCP%XTKE(:,:) = 1.
+ SB%XTKE(:,:) = 1.
ENDIF
-!
-!* default forcing above roof: forcing level
-ZUREF(:) = PUREF(:)
-ZZREF(:) = PZREF(:)
-ZUA(:) = TM%TCP%XU(:,TM%TCP%NLVL)
-ZTA(:) = TM%TCP%XT(:,TM%TCP%NLVL)
-ZQA(:) = TM%TCP%XQ(:,TM%TCP%NLVL)/PRHOA(:)
-ZPA(:) = TM%TCP%XP(:,TM%TCP%NLVL)
-!* for the time being, only one value is kept for wall in-canyon forcing, in the middle of the canyon
-ZU_CANYON(:) = ZUA(:)
-ZT_CANYON(:) = ZTA(:)
-ZQ_CANYON(:) = ZQA(:)
- DO JLAYER=1,TM%TCP%NLVL-1
+ !
+ !* default forcing above roof: forcing level
+ ZUREF(:) = PUREF(:)
+ ZZREF(:) = PZREF(:)
+ ZUA(:) = SB%XU(:,SB%NLVL)
+ ZTA(:) = SB%XT(:,SB%NLVL)
+ ZQA(:) = SB%XQ(:,SB%NLVL)/PRHOA(:)
+ ZPA(:) = SB%XP(:,SB%NLVL)
+ !* for the time being, only one value is kept for wall in-canyon forcing, in the middle of the canyon
+ ZU_CANYON(:) = ZUA(:)
+ ZT_CANYON(:) = ZTA(:)
+ ZQ_CANYON(:) = ZQA(:)
+ DO JLAYER=1,SB%NLVL-1
DO JI=1,KI
!* finds middle canyon layer
- IF (TM%TCP%XZ(JI,JLAYER)<ZAVG_BLD_HEIGHT(JI)/2. .AND. &
- TM%TCP%XZ(JI,JLAYER+1)>=ZAVG_BLD_HEIGHT(JI)/2.) THEN
- ZCOEF(JI) = (ZAVG_BLD_HEIGHT(JI)/2.-TM%TCP%XZ(JI,JLAYER))/(TM%TCP%XZ(JI,JLAYER+1)-TM%TCP%XZ(JI,JLAYER))
- ZU_CANYON(JI) = TM%TCP%XU(JI,JLAYER) + ZCOEF(JI) * (TM%TCP%XU(JI,JLAYER+1)-TM%TCP%XU(JI,JLAYER))
- ZT_CANYON(JI) = TM%TCP%XT(JI,JLAYER) + ZCOEF(JI) * (TM%TCP%XT(JI,JLAYER+1)-TM%TCP%XT(JI,JLAYER))
- ZQ_CANYON(JI) =(TM%TCP%XQ(JI,JLAYER) + ZCOEF(JI) * &
- (TM%TCP%XQ(JI,JLAYER+1)-TM%TCP%XQ(JI,JLAYER)))/PRHOA(JI)
+ IF (SB%XZ(JI,JLAYER)<ZAVG_BLD_HEIGHT(JI)/2. .AND. SB%XZ(JI,JLAYER+1)>=ZAVG_BLD_HEIGHT(JI)/2.) THEN
+ ZCOEF(JI) = (ZAVG_BLD_HEIGHT(JI)/2.-SB%XZ(JI,JLAYER))/(SB%XZ(JI,JLAYER+1)-SB%XZ(JI,JLAYER))
+ ZU_CANYON(JI) = SB%XU(JI,JLAYER) + ZCOEF(JI) * (SB%XU(JI,JLAYER+1)-SB%XU(JI,JLAYER))
+ ZT_CANYON(JI) = SB%XT(JI,JLAYER) + ZCOEF(JI) * (SB%XT(JI,JLAYER+1)-SB%XT(JI,JLAYER))
+ ZQ_CANYON(JI) =(SB%XQ(JI,JLAYER) + ZCOEF(JI) * (SB%XQ(JI,JLAYER+1)-SB%XQ(JI,JLAYER)))/PRHOA(JI)
END IF
!* finds layer just above roof (at least 1m above roof)
- IF (TM%TCP%XZ(JI,JLAYER)<ZAVG_BLD_HEIGHT(JI)+1. .AND. &
- TM%TCP%XZ(JI,JLAYER+1)>=ZAVG_BLD_HEIGHT(JI)+1.) THEN
- ZUREF(JI) = TM%TCP%XZ(JI,JLAYER+1) - ZAVG_BLD_HEIGHT(JI)
- ZZREF(JI) = TM%TCP%XZ(JI,JLAYER+1) - ZAVG_BLD_HEIGHT(JI)
- ZTA (JI) = TM%TCP%XT(JI,JLAYER+1)
- ZQA (JI) = TM%TCP%XQ(JI,JLAYER+1)/PRHOA(JI)
+ IF (SB%XZ(JI,JLAYER)<ZAVG_BLD_HEIGHT(JI)+1. .AND. SB%XZ(JI,JLAYER+1)>=ZAVG_BLD_HEIGHT(JI)+1.) THEN
+ ZUREF(JI) = SB%XZ(JI,JLAYER+1) - ZAVG_BLD_HEIGHT(JI)
+ ZZREF(JI) = SB%XZ(JI,JLAYER+1) - ZAVG_BLD_HEIGHT(JI)
+ ZTA (JI) = SB%XT(JI,JLAYER+1)
+ ZQA (JI) = SB%XQ(JI,JLAYER+1)/PRHOA(JI)
!ZUA (JI) = XU(JI,JLAYER+1)
- ZUA (JI) = MAX(TM%TCP%XU(JI,JLAYER+1) - 2.*SQRT(TM%TCP%XTKE(JI,JLAYER+1)) , TM%TCP%XU(JI,JLAYER+1)/3.)
- ZPA (JI) = TM%TCP%XP(JI,JLAYER+1)
- ZLMO (JI) = TM%TCP%XLMO(JI,JLAYER+1)
+ ZUA (JI) = MAX(SB%XU(JI,JLAYER+1) - 2.*SQRT(SB%XTKE(JI,JLAYER+1)) , SB%XU(JI,JLAYER+1)/3.)
+ ZPA (JI) = SB%XP(JI,JLAYER+1)
+ ZLMO (JI) = SB%XLMO(JI,JLAYER+1)
END IF
END DO
END DO
ZU_CANYON= MAX(ZU_CANYON,0.2)
- ZU_LOWCAN=TM%TCP%XU(:,1)
- ZT_LOWCAN=TM%TCP%XT(:,1)
- ZQ_LOWCAN=TM%TCP%XQ(:,1) / PRHOA(:)
- ZZ_LOWCAN=TM%TCP%XZ(:,1)
+ ZU_LOWCAN=SB%XU(:,1)
+ ZT_LOWCAN=SB%XT(:,1)
+ ZQ_LOWCAN=SB%XQ(:,1) / PRHOA(:)
+ ZZ_LOWCAN=SB%XZ(:,1)
WHERE(ZPA==XUNDEF) ZPA = PPA ! security for first time step
-!
-!-------------------------------------------------------------------------------------
-! determine the vertical profile for mixing and dissipative lengths (at full levels)
-!-------------------------------------------------------------------------------------
-!
-! frontal density
+ !
+ !-------------------------------------------------------------------------------------
+ ! determine the vertical profile for mixing and dissipative lengths (at full levels)
+ !-------------------------------------------------------------------------------------
+ !
+ ! frontal density
ZLAMBDA_F(:) = ZAVG_CAN_HW_RATIO*ZAVG_BLD / (0.5*XPI)
-!
- CALL SM10(TM%TCP%XZ,ZAVG_BLD_HEIGHT,ZLAMBDA_F,ZL)
-!
-!-------------------------------------------------------------------------------------
-! computes coefficients for implicitation
-!-------------------------------------------------------------------------------------
-!
- ZAVG_UW_GRND(:) = 0.
- ZAVG_DUWDU_GRND(:) = 0.
- ZAVG_UW_ROOF(:) = 0.
- ZAVG_DUWDU_ROOF(:) = 0.
- ZAVG_H_GRND(:) = 0.
- ZAVG_H_WALL(:) = 0.
- ZAVG_H_ROOF(:) = 0.
- ZAVG_E_GRND(:) = 0.
- ZAVG_E_ROOF(:) = 0.
- ZAVG_AC_GRND(:) = 0.
- ZAVG_AC_GRND_WAT(:) = 0.
- ZSFLUX_U(:) = 0.
- ZSFLUX_T(:) = 0.
- ZSFLUX_Q(:) = 0.
-!
- DO JLAYER=1,TM%TCP%NLVL-1
- !* Monin-Obuhkov theory not used inside the urban canopy
- ! => neutral mixing if layer is below : (roof level +1 meter)
- WHERE (TM%TCP%XZ(:,JLAYER)<=ZAVG_BLD_HEIGHT(:)+1.) TM%TCP%XLMO(:,JLAYER) = XUNDEF
+ !
+ CALL SM10(SB%XZ, ZAVG_BLD_HEIGHT, ZLAMBDA_F, ZL)
+ !
+ !-------------------------------------------------------------------------------------
+ ! computes coefficients for implicitation
+ !-------------------------------------------------------------------------------------
+ !
+ ZAVG_UW_GRND(:) = 0.
+ ZAVG_DUWDU_GRND(:) = 0.
+ ZAVG_UW_RF(:) = 0.
+ ZAVG_DUWDU_RF(:) = 0.
+ ZAVG_H_GRND(:) = 0.
+ ZAVG_H_WL(:) = 0.
+ ZAVG_H_RF(:) = 0.
+ ZAVG_E_GRND(:) = 0.
+ ZAVG_E_RF(:) = 0.
+ ZAVG_AC_GRND(:) = 0.
+ ZAVG_AC_GRND_WAT(:)= 0.
+ ZSFLUX_U(:) = 0.
+ ZSFLUX_T(:) = 0.
+ ZSFLUX_Q(:) = 0.
+ !
+ DO JLAYER=1,SB%NLVL-1
+ !* Monin-Obuhkov theory not used inside the urban canopy
+ ! => neutral mixing if layer is below : (roof level +1 meter)
+ WHERE (SB%XZ(:,JLAYER)<=ZAVG_BLD_HEIGHT(:)+1.) SB%XLMO(:,JLAYER) = XUNDEF
ENDDO
-!
-!
-!* computes tendencies on wind and Tke due to canopy
- CALL TEB_CANOPY(KI,TM%TCP%NLVL,TM%TCP%XZ,TM%TCP%XZF,TM%TCP%XDZ,TM%TCP%XDZF,&
- ZAVG_BLD,ZAVG_BLD_HEIGHT,ZAVG_WALL_O_HOR, &
- PPA,PRHOA,TM%TCP%XU, &
- ZAVG_DUWDU_GRND, ZAVG_UW_ROOF, ZAVG_DUWDU_ROOF, &
- ZAVG_H_WALL,ZAVG_H_ROOF,ZAVG_E_ROOF,ZAVG_AC_GRND,ZAVG_AC_GRND_WAT, &
- ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE,ZFORC_T,ZDFORC_TDT,ZFORC_Q,ZDFORC_QDQ)
-!
-!* computes coefficients for implicitation
- CALL CANOPY_EVOL(KI,TM%TCP%NLVL,PTSTEP,1, &
- ZL,ZWIND,PTA,PQA,PPA,PRHOA, &
- ZSFLUX_U,ZSFLUX_T,ZSFLUX_Q, &
- ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE, &
- ZFORC_T,ZDFORC_TDT,ZFORC_Q,ZDFORC_QDQ, &
- TM%TCP%XZ,TM%TCP%XZF,TM%TCP%XDZ,TM%TCP%XDZF,TM%TCP%XU,&
- TM%TCP%XTKE,TM%TCP%XT,TM%TCP%XQ,TM%TCP%XLMO, &
- TM%TCP%XLM,TM%TCP%XLEPS,TM%TCP%XP,ZAVG_USTAR, &
- ZALFAU,ZBETAU,ZALFAT,ZBETAT,ZALFAQ,ZBETAQ)
-!
+ !
+ !* computes tendencies on wind and Tke due to canopy
+ CALL TEB_CANOPY(KI, SB, ZAVG_BLD, ZAVG_BLD_HEIGHT, ZAVG_WL_O_HOR, PPA, PRHOA, &
+ ZAVG_DUWDU_GRND, ZAVG_UW_RF, ZAVG_DUWDU_RF, ZAVG_H_WL, &
+ ZAVG_H_RF, ZAVG_E_RF, ZAVG_AC_GRND, ZAVG_AC_GRND_WAT, ZFORC_U, &
+ ZDFORC_UDU, ZFORC_E, ZDFORC_EDE, ZFORC_T, ZDFORC_TDT, ZFORC_Q, &
+ ZDFORC_QDQ )
+ !
+ !* computes coefficients for implicitation
+ CALL CANOPY_EVOL(SB, KI, PTSTEP, 1, ZL, ZWIND, PTA, PQA, PPA, PRHOA, &
+ ZSFLUX_U, ZSFLUX_T, ZSFLUX_Q, ZFORC_U, ZDFORC_UDU, &
+ ZFORC_E, ZDFORC_EDE, ZFORC_T, ZDFORC_TDT, ZFORC_Q, &
+ ZDFORC_QDQ, SB%XLM, SB%XLEPS, ZAVG_USTAR, ZALFAU, &
+ ZBETAU, ZALFAT, ZBETAT, ZALFAQ, ZBETAQ)
+ !
ZPEW_A_COEF_LOWCAN = - ZALFAU / PRHOA
ZPEW_B_COEF_LOWCAN = ZBETAU
-!
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ !
+ !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
ELSE ! no canopy case
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
DO JI=1,KI
-!* skimming flow for h/w>1 (maximum effect of direction on wind in the canyon);
-!* isolated flow for h/w<0.5 (wind is the same in large streets for all dir.)
-!* wake flow between.
-!
+ !* skimming flow for h/w>1 (maximum effect of direction on wind in the canyon);
+ !* isolated flow for h/w<0.5 (wind is the same in large streets for all dir.)
+ !* wake flow between.
+ !
ZWAKE(JI)= 1. + (2./XPI-1.) * 2. * (ZAVG_CAN_HW_RATIO(JI)-0.5)
ZWAKE(JI)= MAX(MIN(ZWAKE(JI),1.),2./XPI)
-!
-!* Estimation of canyon wind speed from wind just above roof level
-! (at 1.33h). Wind at 1.33h is estimated using the log law.
-!
- IF (ZAVG_BLD_HEIGHT(JI) .GT. 0.) THEN
- ZU_CANYON(JI) = ZWAKE(JI) * EXP(-ZAVG_CAN_HW_RATIO(JI)/4.) * ZWIND(JI) &
- * LOG( ( 2.* ZAVG_BLD_HEIGHT(JI)/3.) / ZAVG_Z0_TOWN(JI)) &
- / LOG( (PUREF(JI)+ 2.* ZAVG_BLD_HEIGHT(JI)/3.) / ZAVG_Z0_TOWN(JI))
- ZZ_LOWCAN(JI) = ZAVG_BLD_HEIGHT(JI) / 2.
- ELSE
- ZU_CANYON(JI) = ZWIND(JI)
- ZZ_LOWCAN(JI) = PZREF(JI)
- ENDIF
- END DO
-!
-!* Without SBL scheme, canyon air is assumed at mid height
- ZU_LOWCAN=ZU_CANYON
- ZT_LOWCAN=TM%T%CUR%XT_CANYON
- ZQ_LOWCAN=TM%T%CUR%XQ_CANYON
- ZT_CANYON=TM%T%CUR%XT_CANYON
- ZQ_CANYON=TM%T%CUR%XQ_CANYON
- ZUREF =PUREF
- ZZREF =PZREF
- ZTA =PTA
- ZUA =ZWIND
- ZPA =PPA
+ !
+ !* Estimation of canyon wind speed from wind just above roof level
+ ! (at 1.33h). Wind at 1.33h is estimated using the log law.
+ !
+ IF (ZAVG_BLD_HEIGHT(JI) .GT. 0.) THEN
+ ZU_CANYON(JI) = ZWAKE(JI) * EXP(-ZAVG_CAN_HW_RATIO(JI)/4.) * ZWIND(JI) &
+ * LOG( ( 2.* ZAVG_BLD_HEIGHT(JI)/3.) / ZAVG_Z0(JI)) &
+ / LOG( (PUREF(JI)+ 2.* ZAVG_BLD_HEIGHT(JI)/3.) / ZAVG_Z0(JI))
+ ZZ_LOWCAN(JI) = ZAVG_BLD_HEIGHT(JI) / 2.
+ ELSE
+ ZU_CANYON(JI) = ZWIND(JI)
+ ZZ_LOWCAN(JI) = PZREF(JI)
+ ENDIF
+ END DO
+ !
+ !* Without SBL scheme, canyon air is assumed at mid height
+ ZU_LOWCAN = ZU_CANYON
+
+ ZT_LOWCAN = NT%AL(1)%XT_CANYON
+ ZQ_LOWCAN = NT%AL(1)%XQ_CANYON
+ ZT_CANYON = NT%AL(1)%XT_CANYON
+ ZQ_CANYON = NT%AL(1)%XQ_CANYON
+
+ ZUREF = PUREF
+ ZZREF = PZREF
+ ZTA = PTA
+ ZUA = ZWIND
+ ZPA = PPA
ZPEW_A_COEF_LOWCAN = 0.
ZPEW_B_COEF_LOWCAN = ZU_CANYON
+
END IF
!
! Exner functions
@@ -737,280 +657,167 @@ ZEXNA (:) = (ZPA(:)/XP00)**(XRD/XCPD)
! Over Urban surfaces/towns:
!--------------------------------------------------------------------------------------
!
-DO JTEB_PATCH=1,TM%TOP%NTEB_PATCH
- CALL GOTO_WRAPPER_TEB_PATCH(TM%B, TM%DGCT, TM%DGMT, TM%T, &
- GDM%TGD, GDM%TGDPE, GRM%TGR, GRM%TGRPE, JTEB_PATCH)
-!
-ZT_CAN=ZT_CANYON
-ZQ_CAN=ZQ_CANYON
-!
-IF (TM%TOP%LCANOPY) THEN
- TM%T%CUR%XT_CANYON(:) = ZT_CANYON(:)
- TM%T%CUR%XQ_CANYON(:) = ZQ_CANYON(:)
-END IF
-!
-ZLESNOW_ROOF(:) = 0.
-ZLESNOW_ROAD(:) = 0.
-ZG_GREENROOF_ROOF(:) = 0.
-!
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! Call the physical routines of TEB (including gardens & greenroofs)
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-!
- CALL TEB_GARDEN(DTCO, DTI, IG, I, TM, GDM, GRM, &
- TM%TOP%LGARDEN, TM%TOP%LGREENROOF, TM%TOP%LSOLAR_PANEL, &
- TM%TOP%CZ0H, CIMPLICIT_WIND, TM%TOP%CROAD_DIR, TM%TOP%CWALL_OPT, &
- TM%TOP%TTIME, PTSUN, ZT_CAN, ZQ_CAN, ZU_CANYON, &
- ZT_LOWCAN, ZQ_LOWCAN, ZU_LOWCAN, ZZ_LOWCAN, &
- TM%B%CUR%XTI_BLD,TM%T%CUR%XT_ROOF, TM%T%CUR%XT_ROAD, &
- TM%T%CUR%XT_WALL_A, TM%T%CUR%XT_WALL_B, TM%T%CUR%XWS_ROOF, &
- TM%T%CUR%XWS_ROAD,TM%T%CUR%TSNOW_ROOF%SCHEME, &
- TM%T%CUR%TSNOW_ROOF%WSNOW(:,:,1), TM%T%CUR%TSNOW_ROOF%T(:,:,1), &
- TM%T%CUR%TSNOW_ROOF%RHO(:,:,1), TM%T%CUR%TSNOW_ROOF%ALB(:,1), &
- TM%T%CUR%TSNOW_ROOF%TS(:,1), TM%T%CUR%TSNOW_ROOF%EMIS(:,1), &
- TM%T%CUR%TSNOW_ROAD%SCHEME, &
- TM%T%CUR%TSNOW_ROAD%WSNOW(:,:,1), TM%T%CUR%TSNOW_ROAD%T(:,:,1), &
- TM%T%CUR%TSNOW_ROAD%RHO(:,:,1), TM%T%CUR%TSNOW_ROAD%ALB(:,1), &
- TM%T%CUR%TSNOW_ROAD%TS(:,1), TM%T%CUR%TSNOW_ROAD%EMIS(:,1), &
- ZPEW_A_COEF, ZPEW_B_COEF,ZPEW_A_COEF_LOWCAN, ZPEW_B_COEF_LOWCAN, &
- PPS, ZPA, ZEXNS, ZEXNA, ZTA, ZQA, PRHOA, PCO2, &
- PLW, ZDIR_SWB, ZSCA_SWB, PSW_BANDS, KSW, PZENITH, PAZIM, &
- PRAIN, PSNOW, ZZREF, ZUREF, ZUA, &
- ZH_TRAFFIC, ZLE_TRAFFIC, TM%T%CUR%XH_INDUSTRY, TM%T%CUR%XLE_INDUSTRY, &
- PTSTEP, &
- TM%T%CUR%XZ0_TOWN, TM%T%CUR%XBLD, TM%T%CUR%XGARDEN, &
- TM%T%CUR%XROAD_DIR, TM%T%CUR%XROAD, TM%T%CUR%XGREENROOF, &
- TM%T%CUR%XBLD_HEIGHT, TM%T%CUR%XWALL_O_HOR, TM%T%CUR%XCAN_HW_RATIO, &
- TM%T%CUR%XROAD_O_GRND, TM%T%CUR%XGARDEN_O_GRND, TM%T%CUR%XWALL_O_GRND,&
- TM%T%CUR%XALB_ROOF, TM%T%CUR%XEMIS_ROOF, TM%T%CUR%XHC_ROOF, &
- TM%T%CUR%XTC_ROOF,TM%T%CUR%XD_ROOF,TM%T%CUR%XALB_ROAD, &
- TM%T%CUR%XEMIS_ROAD, TM%T%CUR%XSVF_ROAD,TM%T%CUR%XHC_ROAD, &
- TM%T%CUR%XTC_ROAD,TM%T%CUR%XD_ROAD,TM%T%CUR%XALB_WALL, &
- TM%T%CUR%XEMIS_WALL, TM%T%CUR%XSVF_WALL,TM%T%CUR%XSVF_GARDEN, &
- TM%T%CUR%XHC_WALL,TM%T%CUR%XTC_WALL,TM%T%CUR%XD_WALL, &
- ZRN_ROOF, ZH_ROOF, ZLE_ROOF, ZLEW_ROOF, ZGFLUX_ROOF, &
- ZRUNOFF_ROOF, &
- ZRN_ROAD, ZH_ROAD, ZLE_ROAD, ZLEW_ROAD, ZGFLUX_ROAD, &
- ZRUNOFF_ROAD, &
- ZRN_WALL_A, ZH_WALL_A, ZLE_WALL_A, ZGFLUX_WALL_A, &
- ZRN_WALL_B, ZH_WALL_B, ZLE_WALL_B, ZGFLUX_WALL_B, &
- ZRN_GARDEN,ZH_GARDEN,ZLE_GARDEN,ZGFLUX_GARDEN, &
- ZRUNOFF_GARDEN, ZDRAIN_GARDEN, ZIRRIG_GARDEN, &
- ZRN_GREENROOF,ZH_GREENROOF,ZLE_GREENROOF,ZGFLUX_GREENROOF, &
- ZRN_STRLROOF,ZH_STRLROOF,ZLE_STRLROOF,ZGFLUX_STRLROOF, &
- ZRUNOFF_STRLROOF, &
- ZRN_BLT,ZH_BLT,ZLE_BLT,ZGFLUX_BLT, &
- ZRNSNOW_ROOF, ZHSNOW_ROOF, ZLESNOW_ROOF, ZGSNOW_ROOF, &
- ZMELT_ROOF, &
- ZRNSNOW_ROAD, ZHSNOW_ROAD, ZLESNOW_ROAD, ZGSNOW_ROAD, &
- ZMELT_ROAD, &
- ZRN_GRND, ZH_GRND, ZLE_GRND, ZGFLUX_GRND, &
- ZRN, ZH, ZLE, ZGFLUX, ZEVAP, ZRUNOFF_TOWN, ZSFCO2, &
- ZUW_GRND, ZUW_ROOF, ZDUWDU_GRND, ZDUWDU_ROOF, &
- ZUSTAR, ZCD, ZCDN, ZCH, ZRI, &
- ZTRAD, ZEMIS, ZDIR_ALB, ZSCA_ALB, ZRESA_TOWN, ZDQS_TOWN, &
- ZQF_TOWN, ZQF_BLD, &
- ZFLX_BLD, ZAC_ROAD, ZAC_GARDEN, ZAC_GREENROOF, &
- ZAC_ROAD_WAT, ZAC_GARDEN_WAT, ZAC_GREENROOF_WAT, &
- ZABS_SW_ROOF,ZABS_LW_ROOF, &
- ZABS_SW_SNOW_ROOF,ZABS_LW_SNOW_ROOF, &
- ZABS_SW_ROAD,ZABS_LW_ROAD, &
- ZABS_SW_SNOW_ROAD,ZABS_LW_SNOW_ROAD, &
- ZABS_SW_WALL_A, ZABS_LW_WALL_A, &
- ZABS_SW_WALL_B, ZABS_LW_WALL_B, &
- ZABS_SW_PANEL,ZABS_LW_PANEL, &
- ZABS_SW_GARDEN,ZABS_LW_GARDEN, &
- ZABS_SW_GREENROOF,ZABS_LW_GREENROOF, ZG_GREENROOF_ROOF, &
- ZRUNOFF_GREENROOF, ZDRAIN_GREENROOF, &
- ZIRRIG_GREENROOF, TM%BOP%CCOOL_COIL, TM%B%CUR%XF_WATER_COND, &
- TM%BOP%CHEAT_COIL,TM%B%CUR%CNATVENT,KDAY, TM%B%CUR%XAUX_MAX, &
- TM%B%CUR%XT_FLOOR, TM%B%CUR%XT_MASS, ZH_BLD_COOL,ZT_BLD_COOL, &
- ZH_BLD_HEAT, ZLE_BLD_COOL, ZLE_BLD_HEAT, ZH_WASTE, ZLE_WASTE, &
- TM%B%CUR%XF_WASTE_CAN, ZHVAC_COOL, ZHVAC_HEAT, TM%B%CUR%XQIN, &
- TM%B%CUR%XQIN_FRAD, TM%B%CUR%XQIN_FLAT, TM%B%CUR%XGR, &
- TM%B%CUR%XEFF_HEAT, TM%B%CUR%XINF, TM%B%CUR%XTCOOL_TARGET, &
- TM%B%CUR%XTHEAT_TARGET, TM%B%CUR%XHR_TARGET, TM%B%CUR%XT_WIN2, &
- TM%B%CUR%XQI_BLD, TM%B%CUR%XV_VENT,TM%B%CUR%XCAP_SYS_HEAT, &
- TM%B%CUR%XCAP_SYS_RAT, TM%B%CUR%XT_ADP, TM%B%CUR%XM_SYS_RAT, &
- TM%B%CUR%XCOP_RAT, ZCAP_SYS, ZM_SYS, ZCOP, ZQ_SYS, ZT_SYS, &
- ZTR_SW_WIN, ZFAN_POWER, TM%B%CUR%XHC_FLOOR, TM%B%CUR%XTC_FLOOR, &
- TM%B%CUR%XD_FLOOR, TM%B%CUR%XT_WIN1, ZABS_SW_WIN, ZABS_LW_WIN, &
- TM%B%CUR%XSHGC, TM%B%CUR%XSHGC_SH, TM%B%CUR%XUGG_WIN, &
- TM%B%CUR%XALB_WIN, TM%B%CUR%XABS_WIN, ZEMIT_LW_FAC, ZEMIT_LW_GRND,&
- ZT_RAD_IND, ZREF_SW_GRND,ZREF_SW_FAC, ZHU_BLD, PTIME, &
- TM%B%CUR%LSHADE, TM%B%CUR%LSHAD_DAY, TM%B%CUR%LNATVENT_NIGHT, &
- TM%TOP%CBEM, TM%B%CUR%XN_FLOOR, TM%T%CUR%XWALL_O_BLD, &
- TM%B%CUR%XGLAZ_O_BLD, TM%B%CUR%XMASS_O_BLD, TM%B%CUR%XFLOOR_HW_RATIO,&
- TM%B%CUR%XF_FLOOR_MASS, TM%B%CUR%XF_FLOOR_WALL, TM%B%CUR%XF_FLOOR_WIN,&
- TM%B%CUR%XF_FLOOR_ROOF, TM%B%CUR%XF_WALL_FLOOR, TM%B%CUR%XF_WALL_MASS,&
- TM%B%CUR%XF_WALL_WIN, TM%B%CUR%XF_WIN_FLOOR, TM%B%CUR%XF_WIN_MASS, &
- TM%B%CUR%XF_WIN_WALL, TM%B%CUR%XF_MASS_FLOOR, TM%B%CUR%XF_MASS_WALL, &
- TM%B%CUR%XF_MASS_WIN, TM%TOP%LCANOPY, TM%B%CUR%XTRAN_WIN, &
- TM%TOP%CCH_BEM, TM%T%CUR%XROUGH_ROOF, TM%T%CUR%XROUGH_WALL, &
- TM%B%CUR%XF_WIN_WIN, GDM%TIR%LPAR_RD_IRRIG, GDM%TIR%XRD_START_MONTH, &
- GDM%TIR%XRD_END_MONTH, GDM%TIR%XRD_START_HOUR, GDM%TIR%XRD_END_HOUR, &
- GDM%TIR%XRD_24H_IRRIG, ZIRRIG_ROAD, TM%TPN%XEMIS_PANEL, &
- TM%TPN%XALB_PANEL, TM%TPN%XEFF_PANEL, TM%TPN%XFRAC_PANEL, &
- TM%T%CUR%XRESIDENTIAL, ZTHER_PROD_PANEL, ZPHOT_PROD_PANEL, &
- ZPROD_PANEL, ZTHER_PROD_BLD , ZPHOT_PROD_BLD, ZPROD_BLD, &
- TM%TPN%XTHER_PRODC_DAY, ZH_PANEL, ZRN_PANEL, &
- TM%T%CUR%XDT_RES, TM%T%CUR%XDT_OFF, &
- ZCUR_TCOOL_TARGET, ZCUR_THEAT_TARGET, ZCUR_QIN )
+DO JP = 1,TOP%NTEB_PATCH
+ !
+ ZT_CAN = ZT_CANYON
+ ZQ_CAN = ZQ_CANYON
+ !
+ IF (TOP%LCANOPY) THEN
+ NT%AL(JP)%XT_CANYON(:) = ZT_CANYON(:)
+ NT%AL(JP)%XQ_CANYON(:) = ZQ_CANYON(:)
+ END IF
+ !
+ ZLESN_RF(:) = 0.
+ ZLESN_RD(:) = 0.
+ TD%NDMT%AL(JP)%XG_GREENROOF_ROOF(:) = 0.
+ !
+ ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ ! Call the physical routines of TEB (including gardens & greenroofs)
+ ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ !
+ CALL TEB_GARDEN(DTCO, G, TOP, NT%AL(JP), BOP, NB%AL(JP), TPN, TIR, TD%NDMT%AL(JP), GDM, GRM, JP, &
+ CIMPLICIT_WIND, PTSUN, ZT_CAN, ZQ_CAN, ZU_CANYON, ZT_LOWCAN, ZQ_LOWCAN, &
+ ZU_LOWCAN, ZZ_LOWCAN, ZPEW_A_COEF, ZPEW_B_COEF, ZPEW_A_COEF_LOWCAN, &
+ ZPEW_B_COEF_LOWCAN, PPS, ZPA, ZEXNS, ZEXNA, ZTA, ZQA, PRHOA, PCO2, PLW, &
+ ZDIR_SWB, ZSCA_SWB, PSW_BANDS, KSW, PZENITH, PAZIM, PRAIN, PSN, ZZREF, &
+ ZUREF, ZUA, ZH_TRAFFIC, ZLE_TRAFFIC, PTSTEP, ZLEW_RF, ZLEW_RD, ZLE_WL_A,&
+ ZLE_WL_B, ZRNSN_RF, ZHSN_RF, ZLESN_RF, ZGSN_RF, ZMELT_RF, ZRNSN_RD, &
+ ZHSN_RD, ZLESN_RD, ZGSN_RD, ZMELT_RD, ZRN_GRND, ZH_GRND, ZLE_GRND, &
+ ZGFLX_GRND, ZRN, ZH, ZLE, ZGFLX, ZEVAP, ZSFCO2, ZUW_GRND, &
+ ZUW_RF, ZDUWDU_GRND, ZDUWDU_RF, ZUSTAR, ZCD, ZCDN, ZCH, ZRI, ZTRAD, &
+ ZEMIS, ZDIR_ALB, ZSCA_ALB, ZRESA, ZAC_RD, ZAC_GD, ZAC_GRF, ZAC_RD_WAT, &
+ ZAC_GD_WAT, ZAC_GRF_WAT, KDAY, ZEMIT_LW_FAC, ZEMIT_LW_GRND, ZT_RAD_IND, &
+ ZREF_SW_GRND, ZREF_SW_FAC, ZHU_BLD, PTIME, ZPROD_BLD )
-!
-IF (.NOT. TM%TOP%LCANOPY) THEN
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_T_CANYON,ZT_CAN)
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_Q_CANYON,ZQ_CAN)
-!
-! Momentum fluxes
-!
- ZSFU = 0.
- ZSFV = 0.
- DO JJ=1,SIZE(PU)
- IF (ZWIND(JJ)>0.) THEN
- ZCOEF(JJ) = - PRHOA(JJ) * ZUSTAR(JJ)**2 / ZWIND(JJ)
- ZSFU(JJ) = ZCOEF(JJ) * PU(JJ)
- ZSFV(JJ) = ZCOEF(JJ) * PV(JJ)
- ENDIF
- ENDDO
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,PSFU,ZSFU)
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,PSFV,ZSFV)
-!
-ENDIF
-!
-!-------------------------------------------------------------------------------------
-! Outputs:
-!-------------------------------------------------------------------------------------
-!
-! Grid box average fluxes/properties: Arguments and standard diagnostics
-!
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,PSFTH,ZH)
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,PSFTQ,ZEVAP)
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,PSFCO2,ZSFCO2)
-!
-!
-! Albedo for each wavelength and patch
-!
-DO JSWB=1,SIZE(PSW_BANDS)
- DO JJ=1,SIZE(ZDIR_ALB)
- ZDIR_ALB_PATCH(JJ,JSWB,JTEB_PATCH) = ZDIR_ALB(JJ)
- ZSCA_ALB_PATCH(JJ,JSWB,JTEB_PATCH) = ZSCA_ALB(JJ)
- ENDDO
-END DO
-!
-! emissivity and radiative temperature
-!
-ZEMIS_PATCH(:,JTEB_PATCH) = ZEMIS
-ZTRAD_PATCH(:,JTEB_PATCH) = ZTRAD
-!
-! computes some aggregated diagnostics
-!
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_CD ,ZCD )
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_CDN,ZCDN)
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_RI ,ZRI )
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_CH ,ZCH )
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_RN ,ZRN )
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_H ,ZH )
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_LE ,ZLE )
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_GFLUX ,ZGFLUX )
-!
-!* warning: aerodynamical resistance does not yet take into account gardens
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_RESA_TOWN,1./ZRESA_TOWN)
-IF (JTEB_PATCH==TM%TOP%NTEB_PATCH) ZAVG_RESA_TOWN = 1./ZAVG_RESA_TOWN
-!
-!-------------------------------------------------------------------------------------
-! Diagnostics on each patch
-!-------------------------------------------------------------------------------------
-!
- CALL DIAG_MISC_TEB_n(TM%DGCT, TM%DGMT, TM%DGMTO, TM%TOP, &
- PTSTEP, ZDQS_TOWN, ZQF_BLD, ZQF_TOWN, ZFLX_BLD, &
- ZRUNOFF_TOWN, &
- ZRN_ROAD, ZH_ROAD, ZLE_ROAD, ZGFLUX_ROAD, &
- ZRUNOFF_ROAD, ZIRRIG_ROAD, &
- ZRN_WALL_A, ZH_WALL_A, ZGFLUX_WALL_A, &
- ZRN_WALL_B, ZH_WALL_B, ZGFLUX_WALL_B, &
- ZRN_ROOF, ZH_ROOF, ZLE_ROOF, ZGFLUX_ROOF, ZRUNOFF_ROOF, &
- ZRN_STRLROOF, ZH_STRLROOF, ZLE_STRLROOF, ZGFLUX_STRLROOF, &
- ZRUNOFF_STRLROOF, &
- ZRN_GREENROOF, ZH_GREENROOF, &
- ZLE_GREENROOF, ZGFLUX_GREENROOF, ZG_GREENROOF_ROOF, &
- ZRUNOFF_GREENROOF, ZDRAIN_GREENROOF,ZIRRIG_GREENROOF, &
- ZRN_GARDEN,ZH_GARDEN,ZLE_GARDEN,ZGFLUX_GARDEN, &
- ZRUNOFF_GARDEN, ZDRAIN_GARDEN, ZIRRIG_GARDEN, &
- ZRN_BLT,ZH_BLT,ZLE_BLT,ZGFLUX_BLT, &
- ZABS_SW_ROOF,ZABS_LW_ROOF, &
- ZABS_SW_SNOW_ROOF,ZABS_LW_SNOW_ROOF, &
- ZABS_SW_ROAD,ZABS_LW_ROAD, &
- ZABS_SW_SNOW_ROAD,ZABS_LW_SNOW_ROAD, &
- ZABS_SW_WALL_A, ZABS_LW_WALL_A, ZABS_SW_WALL_B, &
- ZABS_LW_WALL_B, &
- ZABS_SW_GARDEN,ZABS_LW_GARDEN, &
- ZABS_SW_GREENROOF,ZABS_LW_GREENROOF, &
- ZH_BLD_COOL, ZT_BLD_COOL, &
- ZH_BLD_HEAT, ZLE_BLD_COOL, ZLE_BLD_HEAT, &
- ZH_WASTE, ZLE_WASTE, ZHVAC_COOL, &
- ZHVAC_HEAT, ZCAP_SYS, ZM_SYS, ZCOP, &
- ZQ_SYS, ZT_SYS, ZTR_SW_WIN, ZFAN_POWER, &
- ZABS_SW_WIN, ZABS_LW_WIN, &
- ZCUR_TCOOL_TARGET, ZCUR_THEAT_TARGET, ZCUR_QIN, &
- ZABS_SW_PANEL, ZABS_LW_PANEL, ZRN_PANEL, &
- ZH_PANEL, ZTHER_PROD_PANEL, ZPHOT_PROD_PANEL, ZPROD_PANEL,&
- ZTHER_PROD_BLD, ZPHOT_PROD_BLD )
-!
-!
-!-------------------------------------------------------------------------------------
-! Computes averaged parameters necessary for UTCI
-!-------------------------------------------------------------------------------------
-!
-IF (TM%DGT%N2M >0 .AND. TM%DGUT%LUTCI) THEN
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_REF_SW_GRND ,ZREF_SW_GRND )
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_REF_SW_FAC ,ZREF_SW_FAC )
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_SCA_SW ,ZSCA_SW )
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_DIR_SW ,ZDIR_SW )
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_EMIT_LW_FAC ,ZEMIT_LW_FAC )
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_EMIT_LW_GRND,ZEMIT_LW_GRND)
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_T_RAD_IND ,ZT_RAD_IND )
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_TI_BLD ,TM%B%CUR%XTI_BLD )
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_QI_BLD ,TM%B%CUR%XQI_BLD )
-END IF
-!
-!-------------------------------------------------------------------------------------
-! Use of the canopy version of TEB
-!-------------------------------------------------------------------------------------
-!
-IF (TM%TOP%LCANOPY) THEN
-!-------------------------------------------------------------------------------------
-! Town averaged quantities to force canopy atmospheric layers
-!-------------------------------------------------------------------------------------
+ !
+ IF (.NOT. TOP%LCANOPY) THEN
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_DUWDU_GRND ,ZDUWDU_GRND )
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_UW_ROOF ,ZUW_ROOF)
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_DUWDU_ROOF ,ZDUWDU_ROOF)
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_H_WALL ,0.5*(ZH_WALL_A+ZH_WALL_B))
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_H_ROOF ,(ZH_ROOF+TM%T%CUR%XH_INDUSTRY))
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_E_ROOF ,(ZLE_ROOF+TM%T%CUR%XLE_INDUSTRY)/XLVTT)
-!
-!-------------------------------------------------------------------------------------
-! Computes the impact of canopy and surfaces on air
-!-------------------------------------------------------------------------------------
-!
-ZAC_GRND (:) = (TM%T%CUR%XROAD(:)*ZAC_ROAD (:) + &
- TM%T%CUR%XGARDEN(:)*ZAC_GARDEN (:)) / (TM%T%CUR%XROAD(:)+TM%T%CUR%XGARDEN(:))
-ZAC_GRND_WAT(:) = (TM%T%CUR%XROAD(:)*ZAC_ROAD_WAT(:) + &
- TM%T%CUR%XGARDEN(:)*ZAC_GARDEN_WAT(:)) / (TM%T%CUR%XROAD(:)+TM%T%CUR%XGARDEN(:))
-!
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_AC_GRND ,ZAC_GRND )
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZAVG_AC_GRND_WAT ,ZAC_GRND_WAT)
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZSFLUX_U ,ZUW_GRND * (1.-TM%T%CUR%XBLD))
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZSFLUX_T ,ZH_GRND * (1.-TM%T%CUR%XBLD)/XCPD/PRHOA)
- CALL ADD_PATCH_CONTRIB(JTEB_PATCH,ZSFLUX_Q ,ZLE_GRND * (1.-TM%T%CUR%XBLD)/XLVTT)
-!
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_T_CANYON,ZT_CAN)
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_Q_CANYON,ZQ_CAN)
+ !
+ ! Momentum fluxes
+ !
+ ZSFU = 0.
+ ZSFV = 0.
+ DO JJ=1,SIZE(PU)
+ IF (ZWIND(JJ)>0.) THEN
+ ZCOEF(JJ) = - PRHOA(JJ) * ZUSTAR(JJ)**2 / ZWIND(JJ)
+ ZSFU(JJ) = ZCOEF(JJ) * PU(JJ)
+ ZSFV(JJ) = ZCOEF(JJ) * PV(JJ)
+ ENDIF
+ ENDDO
+ CALL ADD_PATCH_CONTRIB(JP,PSFU,ZSFU)
+ CALL ADD_PATCH_CONTRIB(JP,PSFV,ZSFV)
+ !
+ ENDIF
+ !
+ !-------------------------------------------------------------------------------------
+ ! Outputs:
+ !-------------------------------------------------------------------------------------
+ !
+ ! Grid box average fluxes/properties: Arguments and standard diagnostics
+ !
+ CALL ADD_PATCH_CONTRIB(JP,PSFTH,ZH)
+ CALL ADD_PATCH_CONTRIB(JP,PSFTQ,ZEVAP)
+ CALL ADD_PATCH_CONTRIB(JP,PSFCO2,ZSFCO2)
+ !
+ !
+ ! Albedo for each wavelength and patch
+ !
+ DO JSWB=1,SIZE(PSW_BANDS)
+ DO JJ=1,SIZE(ZDIR_ALB)
+ ZDIR_ALB_PATCH(JJ,JSWB,JP) = ZDIR_ALB(JJ)
+ ZSCA_ALB_PATCH(JJ,JSWB,JP) = ZSCA_ALB(JJ)
+ ENDDO
+ END DO
+ !
+ ! emissivity and radiative temperature
+ !
+ ZEMIS_PATCH(:,JP) = ZEMIS
+ ZTRAD_PATCH(:,JP) = ZTRAD
+ !
+ ! computes some aggregated diagnostics
+ !
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_CD ,ZCD )
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_CDN,ZCDN)
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_RI ,ZRI )
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_CH ,ZCH )
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_RN ,ZRN )
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_H ,ZH )
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_LE ,ZLE )
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_GFLX ,ZGFLX )
+ !
+ !* warning: aerodynamical resistance does not yet take into account gardens
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_RESA,1./ZRESA)
+ IF (JP==TOP%NTEB_PATCH) ZAVG_RESA = 1./ZAVG_RESA
+ !
+ !-------------------------------------------------------------------------------------
+ ! Diagnostics on each patch
+ !-------------------------------------------------------------------------------------
+ !
+ IF (TD%MTO%LSURF_MISC_BUDGET) THEN
+ !
+ ! cumulated diagnostics
+ ! ---------------------
+ !
+ CALL CUMUL_DIAG_TEB_n(TD%NDMTC%AL(JP), TD%NDMT%AL(JP), GDM%VD%NDEC%AL(JP), GDM%VD%NDE%AL(JP), &
+ GRM%VD%NDEC%AL(JP), GRM%VD%NDE%AL(JP), TOP, PTSTEP)
+ !
+ END IF
+ !
+ !
+ !-------------------------------------------------------------------------------------
+ ! Computes averaged parameters necessary for UTCI
+ !-------------------------------------------------------------------------------------
+ !
+ IF (TD%O%N2M >0 .AND. TD%DUT%LUTCI) THEN
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_REF_SW_GRND ,ZREF_SW_GRND )
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_REF_SW_FAC ,ZREF_SW_FAC )
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_SCA_SW ,ZSCA_SW )
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_DIR_SW ,ZDIR_SW )
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_EMIT_LW_FAC ,ZEMIT_LW_FAC )
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_EMIT_LW_GRND,ZEMIT_LW_GRND)
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_T_RAD_IND ,ZT_RAD_IND )
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_TI_BLD ,NB%AL(JP)%XTI_BLD)
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_QI_BLD ,NB%AL(JP)%XQI_BLD)
+ END IF
+ !
+ !-------------------------------------------------------------------------------------
+ ! Use of the canopy version of TEB
+ !-------------------------------------------------------------------------------------
+ !
+ IF (TOP%LCANOPY) THEN
+ !-------------------------------------------------------------------------------------
+ ! Town averaged quantities to force canopy atmospheric layers
+ !-------------------------------------------------------------------------------------
-END IF
-!
-!-------------------------------------------------------------------------------------
-! end of loop on TEB patches
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_DUWDU_GRND, ZDUWDU_GRND )
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_UW_RF , ZUW_RF)
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_DUWDU_RF , ZDUWDU_RF)
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_H_WL , 0.5*(TD%NDMT%AL(JP)%XH_WALL_A+TD%NDMT%AL(JP)%XH_WALL_B))
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_H_RF , (TD%NDMT%AL(JP)%XH_ROOF + NT%AL(JP)%XH_INDUSTRY))
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_E_RF , (TD%NDMT%AL(JP)%XLE_ROOF+ NT%AL(JP)%XLE_INDUSTRY)/XLVTT)
+ !
+ !-------------------------------------------------------------------------------------
+ ! Computes the impact of canopy and surfaces on air
+ !-------------------------------------------------------------------------------------
+ !
+ ZAC_GRND (:) = (NT%AL(JP)%XROAD(:)*ZAC_RD (:) + NT%AL(JP)%XGARDEN(:)*ZAC_GD (:)) / &
+ (NT%AL(JP)%XROAD(:)+NT%AL(JP)%XGARDEN(:))
+ ZAC_GRND_WAT(:) = (NT%AL(JP)%XROAD(:)*ZAC_RD_WAT(:) + NT%AL(JP)%XGARDEN(:)*ZAC_GD_WAT(:)) / &
+ (NT%AL(JP)%XROAD(:)+NT%AL(JP)%XGARDEN(:))
+ !
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_AC_GRND , ZAC_GRND )
+ CALL ADD_PATCH_CONTRIB(JP,ZAVG_AC_GRND_WAT, ZAC_GRND_WAT)
+ CALL ADD_PATCH_CONTRIB(JP,ZSFLUX_U , ZUW_GRND * (1.-NT%AL(JP)%XBLD))
+ CALL ADD_PATCH_CONTRIB(JP,ZSFLUX_T , ZH_GRND * (1.-NT%AL(JP)%XBLD)/XCPD/PRHOA)
+ CALL ADD_PATCH_CONTRIB(JP,ZSFLUX_Q , ZLE_GRND * (1.-NT%AL(JP)%XBLD)/XLVTT)
+ !
+ END IF
+ !
+ !-------------------------------------------------------------------------------------
+ ! end of loop on TEB patches
END DO
!-------------------------------------------------------------------------------------
!
@@ -1018,58 +825,52 @@ END DO
!* Evolution of canopy air if canopy option is active
!-------------------------------------------------------------------------------------
!
-IF (TM%TOP%LCANOPY) THEN
-!
-!-------------------------------------------------------------------------------------
-!* Impact of TEB fluxes on the air
-!-------------------------------------------------------------------------------------
-!
- CALL TEB_CANOPY(KI,TM%TCP%NLVL,TM%TCP%XZ,TM%TCP%XZF,TM%TCP%XDZ,TM%TCP%XDZF,ZAVG_BLD,&
- ZAVG_BLD_HEIGHT,ZAVG_WALL_O_HOR, PPA,PRHOA,TM%TCP%XU, &
- ZAVG_DUWDU_GRND, ZAVG_UW_ROOF, ZAVG_DUWDU_ROOF, &
- ZAVG_H_WALL,ZAVG_H_ROOF,ZAVG_E_ROOF,ZAVG_AC_GRND,ZAVG_AC_GRND_WAT, &
- ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE,ZFORC_T,ZDFORC_TDT,ZFORC_Q,ZDFORC_QDQ)
-!
-!-------------------------------------------------------------------------------------
-!* Evolution of canopy air due to these impacts
-!-------------------------------------------------------------------------------------
-!
- CALL CANOPY_EVOL(KI,TM%TCP%NLVL,PTSTEP,2, &
- ZL,ZWIND,PTA,PQA,PPA,PRHOA, &
- ZSFLUX_U,ZSFLUX_T,ZSFLUX_Q, &
- ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE, &
- ZFORC_T,ZDFORC_TDT,ZFORC_Q,ZDFORC_QDQ, &
- TM%TCP%XZ,TM%TCP%XZF,TM%TCP%XDZ,TM%TCP%XDZF,TM%TCP%XU, &
- TM%TCP%XTKE,TM%TCP%XT,TM%TCP%XQ,TM%TCP%XLMO,TM%TCP%XLM, &
- TM%TCP%XLEPS,TM%TCP%XP, &
- ZAVG_USTAR, &
- ZALFAU,ZBETAU,ZALFAT,ZBETAT,ZALFAQ,ZBETAQ )
-!
-!
-!-------------------------------------------------------------------------------------
-! Momentum fluxes in the case canopy is active
-!-------------------------------------------------------------------------------------
-!
-PSFU=0.
-PSFV=0.
-ZAVG_Z0_TOWN(:) = MIN(ZAVG_Z0_TOWN(:),PUREF(:)*0.5)
-ZAVG_CDN=(XKARMAN/LOG(PUREF(:)/ZAVG_Z0_TOWN(:)))**2
-ZAVG_CD = ZAVG_CDN
-ZAVG_RI = 0.
-DO JJ=1,SIZE(PU)
- IF (ZWIND(JJ)>0.) THEN
- ZCOEF(JJ) = - PRHOA(JJ) * ZAVG_USTAR(JJ)**2 / ZWIND(JJ)
- PSFU(JJ) = ZCOEF(JJ) * PU(JJ)
- PSFV(JJ) = ZCOEF(JJ) * PV(JJ)
- ZAVG_CD(JJ) = ZAVG_USTAR(JJ)**2 / ZWIND(JJ)**2
- ZAVG_RI(JJ) = -XG/PTA(JJ)*ZSFLUX_T(JJ)/ZAVG_USTAR(JJ)**4
- ENDIF
-ENDDO
-!
-!-------------------------------------------------------------------------------------
-! End of specific case with canopy option
-!-------------------------------------------------------------------------------------
-!
+IF (TOP%LCANOPY) THEN
+ !
+ !-------------------------------------------------------------------------------------
+ !* Impact of TEB fluxes on the air
+ !-------------------------------------------------------------------------------------
+ !
+ CALL TEB_CANOPY(KI, SB, ZAVG_BLD, ZAVG_BLD_HEIGHT, ZAVG_WL_O_HOR, PPA, PRHOA, &
+ ZAVG_DUWDU_GRND, ZAVG_UW_RF, ZAVG_DUWDU_RF, ZAVG_H_WL, &
+ ZAVG_H_RF, ZAVG_E_RF, ZAVG_AC_GRND, ZAVG_AC_GRND_WAT, ZFORC_U, &
+ ZDFORC_UDU, ZFORC_E, ZDFORC_EDE, ZFORC_T, ZDFORC_TDT, ZFORC_Q, &
+ ZDFORC_QDQ )
+ !
+ !-------------------------------------------------------------------------------------
+ !* Evolution of canopy air due to these impacts
+ !-------------------------------------------------------------------------------------
+ !
+ CALL CANOPY_EVOL(SB, KI, PTSTEP, 2, ZL, ZWIND, PTA, PQA, PPA, PRHOA, &
+ ZSFLUX_U, ZSFLUX_T, ZSFLUX_Q, ZFORC_U, ZDFORC_UDU, &
+ ZFORC_E, ZDFORC_EDE, ZFORC_T, ZDFORC_TDT, ZFORC_Q, &
+ ZDFORC_QDQ, SB%XLM, SB%XLEPS, ZAVG_USTAR, ZALFAU, &
+ ZBETAU, ZALFAT, ZBETAT, ZALFAQ, ZBETAQ )
+ !
+ !-------------------------------------------------------------------------------------
+ ! Momentum fluxes in the case canopy is active
+ !-------------------------------------------------------------------------------------
+ !
+ PSFU=0.
+ PSFV=0.
+ ZAVG_Z0(:) = MIN(ZAVG_Z0(:),PUREF(:)*0.5)
+ ZAVG_CDN=(XKARMAN/LOG(PUREF(:)/ZAVG_Z0(:)))**2
+ ZAVG_CD = ZAVG_CDN
+ ZAVG_RI = 0.
+ DO JJ=1,SIZE(PU)
+ IF (ZWIND(JJ)>0.) THEN
+ ZCOEF(JJ) = - PRHOA(JJ) * ZAVG_USTAR(JJ)**2 / ZWIND(JJ)
+ PSFU(JJ) = ZCOEF(JJ) * PU(JJ)
+ PSFV(JJ) = ZCOEF(JJ) * PV(JJ)
+ ZAVG_CD(JJ) = ZAVG_USTAR(JJ)**2 / ZWIND(JJ)**2
+ ZAVG_RI(JJ) = -XG/PTA(JJ)*ZSFLUX_T(JJ)/ZAVG_USTAR(JJ)**4
+ ENDIF
+ ENDDO
+ !
+ !-------------------------------------------------------------------------------------
+ ! End of specific case with canopy option
+ !-------------------------------------------------------------------------------------
+ !
END IF
!
!-------------------------------------------------------------------------------------
@@ -1082,9 +883,8 @@ END IF
!for ALB and EMIS
!-------------------------------------------------------------------------------------
!
- CALL AVERAGE_RAD(TM%TOP%XTEB_PATCH, &
- ZDIR_ALB_PATCH, ZSCA_ALB_PATCH, ZEMIS_PATCH, ZTRAD_PATCH,&
- PDIR_ALB, PSCA_ALB, PEMIS, PTRAD )
+ CALL AVERAGE_RAD(TOP%XTEB_PATCH, ZDIR_ALB_PATCH, ZSCA_ALB_PATCH, ZEMIS_PATCH, &
+ ZTRAD_PATCH, PDIR_ALB, PSCA_ALB, PEMIS, PTRAD )
!
!-------------------------------------------------------------------------------
!Physical properties see by the atmosphere in order to close the energy budget
@@ -1093,9 +893,9 @@ END IF
!-------------------------------------------------------------------------------
!
PTSURF (:) = PTRAD (:) ! Should be the surface effective temperature; not radative
-PZ0 (:) = ZAVG_Z0_TOWN (:) ! Should account for ISBA (greenroof and garden) Z0
+PZ0 (:) = ZAVG_Z0 (:) ! Should account for ISBA (greenroof and garden) Z0
PZ0H (:) = PZ0 (:) / 200. ! Should account for ISBA (greenroof and garden) Z0
-PQSURF (:) = TM%T%CUR%XQ_CANYON (:) ! Should account for ISBA (greenroof and garden) Qs
+PQSURF (:) = NT%AL(1)%XQ_CANYON(:) ! Should account for ISBA (greenroof and garden) Qs
!
!-------------------------------------------------------------------------------------
! Scalar fluxes:
@@ -1104,52 +904,67 @@ PQSURF (:) = TM%T%CUR%XQ_CANYON (:) ! Should account for ISBA (greenroof and
ZAVG_USTAR (:) = SQRT(SQRT(PSFU**2+PSFV**2))
!
!
-IF (TM%CHT%SVT%NBEQ>0) THEN
- IF (TM%CHT%CCH_DRY_DEP == "WES89") THEN
- CALL CH_DEP_TOWN(ZAVG_RESA_TOWN, ZAVG_USTAR, PTA, PTRAD, ZAVG_WALL_O_HOR,&
- PSV(:,TM%CHT%SVT%NSV_CHSBEG:TM%CHT%SVT%NSV_CHSEND), &
- TM%CHT%SVT%CSV(TM%CHT%SVT%NSV_CHSBEG:TM%CHT%SVT%NSV_CHSEND), &
- TM%CHT%XDEP(:,1:TM%CHT%SVT%NBEQ) )
+IF (CHT%SVT%NBEQ>0) THEN
+
+ IBEG = CHT%SVT%NSV_CHSBEG
+ IEND = CHT%SVT%NSV_CHSEND
+
+ IF (CHT%CCH_DRY_DEP == "WES89") THEN
+ CALL CH_DEP_TOWN(ZAVG_RESA, ZAVG_USTAR, PTA, PTRAD, ZAVG_WL_O_HOR,&
+ PSV(:,IBEG:IEND), CHT%SVT%CSV(IBEG:IEND), CHT%XDEP(:,1:CHT%SVT%NBEQ) )
- DO JI=TM%CHT%SVT%NSV_CHSBEG,TM%CHT%SVT%NSV_CHSEND
+ DO JI=IBEG,IEND
!cdir nodep
DO JJ=1,SIZE(PSFTS,1)
- PSFTS(JJ,JI) = - PSV(JJ,JI) * TM%CHT%XDEP(JJ,JI-TM%CHT%SVT%NSV_CHSBEG+1)
+ PSFTS(JJ,JI) = - PSV(JJ,JI) * CHT%XDEP(JJ,JI-IBEG+1)
ENDDO
ENDDO
- IF (TM%CHT%SVT%NAEREQ > 0 ) THEN
- CALL CH_AER_DEP(PSV(:,TM%CHT%SVT%NSV_AERBEG:TM%CHT%SVT%NSV_AEREND),&
- PSFTS(:,TM%CHT%SVT%NSV_AERBEG:TM%CHT%SVT%NSV_AEREND),&
- ZAVG_USTAR,ZAVG_RESA_TOWN,PTA,PRHOA)
+ IF (CHT%SVT%NAEREQ > 0 ) THEN
+
+ IBEG = CHT%SVT%NSV_AERBEG
+ IEND = CHT%SVT%NSV_AEREND
+
+ CALL CH_AER_DEP(PSV(:,IBEG:IEND), PSFTS(:,IBEG:IEND), &
+ ZAVG_USTAR, ZAVG_RESA, PTA, PRHOA)
END IF
ELSE
- DO JI=TM%CHT%SVT%NSV_CHSBEG,TM%CHT%SVT%NSV_CHSEND
+
+ IBEG = CHT%SVT%NSV_CHSBEG
+ IEND = CHT%SVT%NSV_CHSEND
+
+ DO JI=IBEG,IEND
PSFTS(:,JI) =0.
ENDDO
- IF(TM%CHT%SVT%NSV_AERBEG.LT.TM%CHT%SVT%NSV_AEREND) THEN
- DO JI=TM%CHT%SVT%NSV_AERBEG,TM%CHT%SVT%NSV_AEREND
+
+ IBEG = CHT%SVT%NSV_AERBEG
+ IEND = CHT%SVT%NSV_AEREND
+
+ IF(IBEG.LT.IEND) THEN
+ DO JI=IBEG,IEND
PSFTS(:,JI) =0.
ENDDO
ENDIF
ENDIF
+
ENDIF
-IF (TM%CHT%SVT%NDSTEQ>0) THEN
+IF (CHT%SVT%NDSTEQ>0) THEN
! Blindage à enlever lorsque que TEB aura été corrigé
- ZUSTAR(:) = MIN(ZUSTAR(:), 10.)
- ZRESA_TOWN(:) = MAX(ZRESA_TOWN(:), 10.)
+ ZUSTAR(:) = MIN(ZUSTAR(:), 10.)
+ ZRESA (:) = MAX(ZRESA(:), 10.)
+ !
+ IBEG = CHT%SVT%NSV_DSTBEG
+ IEND = CHT%SVT%NSV_DSTEND
!
- CALL DSLT_DEP(PSV(:,TM%CHT%SVT%NSV_DSTBEG:TM%CHT%SVT%NSV_DSTEND), &
- PSFTS(:,TM%CHT%SVT%NSV_DSTBEG:TM%CHT%SVT%NSV_DSTEND), &
- ZUSTAR, ZRESA_TOWN, PTA, PRHOA, DST%XEMISSIG_DST, DST%XEMISRADIUS_DST, &
- JPMODE_DST, XDENSITY_DST, XMOLARWEIGHT_DST, ZCONVERTFACM0_DST, &
- ZCONVERTFACM6_DST, ZCONVERTFACM3_DST, LVARSIG_DST, LRGFIX_DST, &
- CVERMOD )
+ CALL DSLT_DEP(PSV(:,IBEG:IEND), PSFTS(:,IBEG:IEND), ZUSTAR, ZRESA, PTA, PRHOA, &
+ DST%XEMISSIG_DST, DST%XEMISRADIUS_DST, JPMODE_DST, XDENSITY_DST, &
+ XMOLARWEIGHT_DST, ZCONVERTFACM0_DST, ZCONVERTFACM6_DST, &
+ ZCONVERTFACM3_DST, LVARSIG_DST, LRGFIX_DST, CVERMOD )
CALL MASSFLUX2MOMENTFLUX( &
- PSFTS(:,TM%CHT%SVT%NSV_DSTBEG:TM%CHT%SVT%NSV_DSTEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
+ PSFTS(:,IBEG:IEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
PRHOA, & !I [kg/m3] air density
DST%XEMISRADIUS_DST, &!I [um] emitted radius for the modes (max 3)
DST%XEMISSIG_DST, &!I [-] emitted sigma for the different modes (max 3)
@@ -1159,16 +974,18 @@ IF (TM%CHT%SVT%NDSTEQ>0) THEN
ZCONVERTFACM3_DST, &
LVARSIG_DST, LRGFIX_DST )
ENDIF
-IF (TM%CHT%SVT%NSLTEQ>0) THEN
- CALL DSLT_DEP(PSV(:,TM%CHT%SVT%NSV_SLTBEG:TM%CHT%SVT%NSV_SLTEND), &
- PSFTS(:,TM%CHT%SVT%NSV_SLTBEG:TM%CHT%SVT%NSV_SLTEND), &
- ZUSTAR, ZRESA_TOWN, PTA, PRHOA, SLT%XEMISSIG_SLT, SLT%XEMISRADIUS_SLT, &
- JPMODE_SLT, XDENSITY_SLT, XMOLARWEIGHT_SLT, ZCONVERTFACM0_SLT, &
- ZCONVERTFACM6_SLT, ZCONVERTFACM3_SLT, LVARSIG_SLT, LRGFIX_SLT, &
- CVERMOD )
+IF (CHT%SVT%NSLTEQ>0) THEN
+ !
+ IBEG = CHT%SVT%NSV_SLTBEG
+ IEND = CHT%SVT%NSV_SLTEND
+ !
+ CALL DSLT_DEP(PSV(:,IBEG:IEND), PSFTS(:,IBEG:IEND), ZUSTAR, ZRESA, PTA, PRHOA, &
+ SLT%XEMISSIG_SLT, SLT%XEMISRADIUS_SLT, JPMODE_SLT, XDENSITY_SLT, &
+ XMOLARWEIGHT_SLT, ZCONVERTFACM0_SLT, ZCONVERTFACM6_SLT, &
+ ZCONVERTFACM3_SLT, LVARSIG_SLT, LRGFIX_SLT, CVERMOD )
CALL MASSFLUX2MOMENTFLUX( &
- PSFTS(:,TM%CHT%SVT%NSV_SLTBEG:TM%CHT%SVT%NSV_SLTEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
+ PSFTS(:,IBEG:IEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
PRHOA, & !I [kg/m3] air density
SLT%XEMISRADIUS_SLT, &!I [um] emitted radius for the modes (max 3)
SLT%XEMISSIG_SLT, &!I [-] emitted sigma for the different modes (max 3)
@@ -1183,25 +1000,20 @@ ENDIF
! Inline diagnostics
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
- CALL DIAG_INLINE_TEB_n(TM%DGT, TM%TCP, TM%T, &
- TM%TOP%LCANOPY, PTA, PTRAD, ZQA, PPA, PPS, PRHOA, &
- PU, PV, ZWIND, PZREF, PUREF, &
- ZAVG_CD, ZAVG_CDN, ZAVG_RI, ZAVG_CH, ZAVG_Z0_TOWN, &
- PTRAD, PEMIS, PDIR_ALB, PSCA_ALB, &
- PLW, ZDIR_SWB, ZSCA_SWB, &
- PSFTH, PSFTQ, PSFU, PSFV, PSFCO2, &
- ZAVG_RN, ZAVG_H, ZAVG_LE, ZAVG_GFLUX )
+ CALL DIAG_INLINE_TEB_n(TD%O, TD%D, SB, NT%AL(1), TOP%LCANOPY, &
+ PTA, PTRAD, ZQA, PPA, PPS, PRHOA, PU, PV, ZWIND, PZREF, PUREF, &
+ ZAVG_CD, ZAVG_CDN, ZAVG_RI, ZAVG_CH, ZAVG_Z0, PTRAD, PEMIS, &
+ PDIR_ALB, PSCA_ALB, PLW, ZDIR_SWB, ZSCA_SWB, PSFTH, PSFTQ, &
+ PSFU, PSFV, PSFCO2, ZAVG_RN, ZAVG_H, ZAVG_LE, ZAVG_GFLX )
!
!-------------------------------------------------------------------------------------
! Stores Canyon air and humidity if historical option of TEB is active
!-------------------------------------------------------------------------------------
!
-IF (.NOT. TM%TOP%LCANOPY) THEN
- DO JTEB_PATCH=1,TM%TOP%NTEB_PATCH
- CALL GOTO_WRAPPER_TEB_PATCH(TM%B, TM%DGCT, TM%DGMT, TM%T, &
- GDM%TGD, GDM%TGDPE, GRM%TGR, GRM%TGRPE, JTEB_PATCH)
- TM%T%CUR%XT_CANYON(:) = ZAVG_T_CANYON(:)
- TM%T%CUR%XQ_CANYON(:) = ZAVG_Q_CANYON(:)
+IF (.NOT. TOP%LCANOPY) THEN
+ DO JP=1,TOP%NTEB_PATCH
+ NT%AL(JP)%XT_CANYON(:) = ZAVG_T_CANYON(:)
+ NT%AL(JP)%XQ_CANYON(:) = ZAVG_Q_CANYON(:)
END DO
END IF
!
@@ -1209,45 +1021,43 @@ END IF
! Thermal confort index
!-------------------------------------------------------------------------------------
!
-IF (TM%DGUT%LUTCI .AND. TM%DGT%N2M >0) THEN
+IF (TD%DUT%LUTCI .AND. TD%O%N2M >0) THEN
DO JJ=1,KI
- IF (TM%DGT%XZON10M(JJ)/=XUNDEF) THEN
- ZU_UTCI(JJ) = SQRT(TM%DGT%XZON10M(JJ)**2+TM%DGT%XMER10M(JJ)**2)
+ IF (TD%D%XZON10M(JJ)/=XUNDEF) THEN
+ ZU_UTCI(JJ) = SQRT(TD%D%XZON10M(JJ)**2+TD%D%XMER10M(JJ)**2)
ELSE
ZU_UTCI(JJ) = ZWIND(JJ)
ENDIF
ENDDO
- CALL UTCI_TEB(TM%T%CUR%XT_CANYON, TM%T%CUR%XQ_CANYON, ZAVG_TI_BLD, ZAVG_QI_BLD, ZU_UTCI, &
- PPS, ZAVG_REF_SW_GRND,ZAVG_REF_SW_FAC, ZAVG_SCA_SW, ZAVG_DIR_SW, PZENITH, &
- ZAVG_EMIT_LW_FAC, ZAVG_EMIT_LW_GRND, PLW, ZAVG_T_RAD_IND, TM%T%CUR%XBLD, &
- TM%T%CUR%XBLD_HEIGHT, TM%T%CUR%XWALL_O_HOR, TM%DGUT%XUTCI_IN, TM%DGUT%XUTCI_OUTSUN, &
- TM%DGUT%XUTCI_OUTSHADE, TM%DGUT%XTRAD_SUN, TM%DGUT%XTRAD_SHADE )
- CALL UTCIC_STRESS(PTSTEP,TM%DGUT%XUTCI_IN ,TM%DGUT%XUTCIC_IN )
- CALL UTCIC_STRESS(PTSTEP,TM%DGUT%XUTCI_OUTSUN ,TM%DGUT%XUTCIC_OUTSUN )
- CALL UTCIC_STRESS(PTSTEP,TM%DGUT%XUTCI_OUTSHADE,TM%DGUT%XUTCIC_OUTSHADE)
-ELSE IF (TM%DGUT%LUTCI) THEN
- TM%DGUT%XUTCI_IN(:) = XUNDEF
- TM%DGUT%XUTCI_OUTSUN(:) = XUNDEF
- TM%DGUT%XUTCI_OUTSHADE(:) = XUNDEF
- TM%DGUT%XTRAD_SUN(:) = XUNDEF
- TM%DGUT%XTRAD_SHADE(:) = XUNDEF
- TM%DGUT%XUTCIC_IN(:,:) = XUNDEF
- TM%DGUT%XUTCIC_OUTSUN(:,:) = XUNDEF
- TM%DGUT%XUTCIC_OUTSHADE(:,:) = XUNDEF
+ CALL UTCI_TEB(NT%AL(1), TD%DUT, ZAVG_TI_BLD, ZAVG_QI_BLD, ZU_UTCI, PPS, ZAVG_REF_SW_GRND, &
+ ZAVG_REF_SW_FAC, ZAVG_SCA_SW, ZAVG_DIR_SW, PZENITH, ZAVG_EMIT_LW_FAC, &
+ ZAVG_EMIT_LW_GRND, PLW, ZAVG_T_RAD_IND )
+ CALL UTCIC_STRESS(PTSTEP,TD%DUT%XUTCI_IN ,TD%DUT%XUTCIC_IN )
+ CALL UTCIC_STRESS(PTSTEP,TD%DUT%XUTCI_OUTSUN ,TD%DUT%XUTCIC_OUTSUN )
+ CALL UTCIC_STRESS(PTSTEP,TD%DUT%XUTCI_OUTSHADE,TD%DUT%XUTCIC_OUTSHADE)
+ELSE IF (TD%DUT%LUTCI) THEN
+ TD%DUT%XUTCI_IN (:) = XUNDEF
+ TD%DUT%XUTCI_OUTSUN (:) = XUNDEF
+ TD%DUT%XUTCI_OUTSHADE (:) = XUNDEF
+ TD%DUT%XTRAD_SUN (:) = XUNDEF
+ TD%DUT%XTRAD_SHADE (:) = XUNDEF
+ TD%DUT%XUTCIC_IN (:,:) = XUNDEF
+ TD%DUT%XUTCIC_OUTSUN (:,:) = XUNDEF
+ TD%DUT%XUTCIC_OUTSHADE(:,:) = XUNDEF
ENDIF
!
IF (LHOOK) CALL DR_HOOK('COUPLING_TEB_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
SUBROUTINE ADD_PATCH_CONTRIB(JP,PAVG,PFIELD)
INTEGER, INTENT(IN) :: JP
REAL, DIMENSION(:), INTENT(INOUT) :: PAVG
REAL, DIMENSION(:), INTENT(IN) :: PFIELD
!
-IF (JTEB_PATCH==1) PAVG = 0.
-PAVG = PAVG + TM%TOP%XTEB_PATCH(:,JP) * PFIELD(:)
+IF (JP==1) PAVG = 0.
+PAVG = PAVG + TOP%XTEB_PATCH(:,JP) * PFIELD(:)
!
END SUBROUTINE ADD_PATCH_CONTRIB
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/coupling_townn.F90 b/src/SURFEX/coupling_townn.F90
index df3dd83aa040626592433f3c86b904d4a848f101..17e80af002ac25ae52059c8d31fa1dc2b4069560 100644
--- a/src/SURFEX/coupling_townn.F90
+++ b/src/SURFEX/coupling_townn.F90
@@ -3,16 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################################
-SUBROUTINE COUPLING_TOWN_n (DTCO, U, DTI, IG, I, DGL, DST, SLT, TM, GDM, GRM, &
- HPROGRAM, HCOUPLING, PTIMEC, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PAZIM, &
- PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+SUBROUTINE COUPLING_TOWN_n (DTCO, U, DGO, DL, DLC, DST, SLT, TM, GDM, GRM, &
+ HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
+ KI, KSV, KSW, PTSUN, PZENITH, PAZIM, PZREF, PUREF, PZS, PU, PV, &
+ PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, &
+ PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, &
+ PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, &
+ PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, &
+ PPET_B_COEF, PPEQ_B_COEF, HTEST )
! ###############################################################################
!
!!**** *COUPLING_TOWN_n * - Chooses the surface schemes for towns
@@ -40,10 +38,7 @@ SUBROUTINE COUPLING_TOWN_n (DTCO, U, DTI, IG, I, DGL, DST, SLT, TM, GDM, GRM, &
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
USE MODD_DST_n, ONLY : DST_t
USE MODD_SLT_n, ONLY : SLT_t
USE MODD_SURFEX_n, ONLY : TEB_MODEL_t
@@ -68,10 +63,9 @@ IMPLICIT NONE
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
+TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: DL
+TYPE(DIAG_t), INTENT(INOUT) :: DLC
TYPE(DST_t), INTENT(INOUT) :: DST
TYPE(SLT_t), INTENT(INOUT) :: SLT
TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM
@@ -158,31 +152,23 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('COUPLING_TOWN_N',0,ZHOOK_HANDLE)
!
IF (U%CTOWN=='TEB ') THEN
- CALL COUPLING_TEB_OROGRAPHY_n(DTCO, DTI, IG, I, DST, SLT, TM, GDM, GRM, &
- HPROGRAM, HCOUPLING, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- KI, KSV, KSW, &
- PTSUN, PZENITH, PAZIM, &
- PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- 'OK' )
+ CALL COUPLING_TEB_OROGRAPHY_n(DTCO, DST, SLT, TM, GDM, GRM, HPROGRAM, HCOUPLING, PTSTEP, &
+ KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, &
+ PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, &
+ PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, &
+ PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, &
+ PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
+ PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, &
+ PPET_B_COEF, PPEQ_B_COEF, 'OK' )
ELSE IF (U%CTOWN=='FLUX ') THEN
- CALL COUPLING_IDEAL_FLUX(DGL, &
- HPROGRAM, HCOUPLING, PTIMEC, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- KI, KSV, KSW, &
- PTSUN, PZENITH, PAZIM, &
- PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- 'OK' )
+ CALL COUPLING_IDEAL_FLUX(DGO, DL, DLC, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, &
+ KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PAZIM, &
+ PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
+ PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
+ PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, &
+ PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, &
+ PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
+ PPEQ_B_COEF, 'OK' )
ELSE IF (U%CTOWN=='NONE ') THEN
PSFTH = 0.
PSFTQ = 0.
diff --git a/src/SURFEX/coupling_tsz0n.F90 b/src/SURFEX/coupling_tsz0n.F90
index 397840152a724559d5a0e2bd568d57a59d5fd122..1596f27187467672b9f8fc7629ad57c270dc408d 100644
--- a/src/SURFEX/coupling_tsz0n.F90
+++ b/src/SURFEX/coupling_tsz0n.F90
@@ -3,16 +3,15 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################################
-SUBROUTINE COUPLING_TSZ0_n (DTCO, UG, U, USS, IM, DTZ, DTGD, DTGR, TGRO, DST, SLT, &
- HPROGRAM, HCOUPLING, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, &
- PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+SUBROUTINE COUPLING_TSZ0_n (DTCO, UG, U, USS, IM, DTZ, NDST, SLT, HPROGRAM, HCOUPLING, &
+ PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN,&
+ PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PZS, PU, PV, &
+ PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, &
+ PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, &
+ PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, &
+ PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, &
+ PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
+ PPEQ_B_COEF, HTEST )
! ###############################################################################
!
!!**** *COUPLING_TSZ0_n * - Call of fluxes from vegetation scheme ISBA but
@@ -40,18 +39,16 @@ SUBROUTINE COUPLING_TSZ0_n (DTCO, UG, U, USS, IM, DTZ, DTGD, DTGR, TGRO, DST, SL
!! P. LeMoigne 12/2014 bug in "implicit" coefficients
!!------------------------------------------------------------------
!
-!
+USE MODD_ISBA_n, ONLY : ISBA_P_t, ISBA_PE_t
USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
USE MODD_DATA_TSZ0_n, ONLY : DATA_TSZ0_t
-USE MODD_DATA_TEB_GARDEN_n, ONLY : DATA_TEB_GARDEN_t
-USE MODD_DATA_TEB_GREENROOF_n, ONLY : DATA_TEB_GREENROOF_t
-USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
-USE MODD_DST_n, ONLY : DST_t
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_DST_n, ONLY : DST_NP_t
USE MODD_SLT_n, ONLY : SLT_t
!
!
@@ -68,17 +65,14 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-!
TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
+!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
TYPE(DATA_TSZ0_t), INTENT(INOUT) :: DTZ
-TYPE(DATA_TEB_GARDEN_t), INTENT(INOUT) :: DTGD
-TYPE(DATA_TEB_GREENROOF_t), INTENT(INOUT) :: DTGR
-TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: TGRO
-TYPE(DST_t), INTENT(INOUT) :: DST
+TYPE(DST_NP_t), INTENT(INOUT) :: NDST
TYPE(SLT_t), INTENT(INOUT) :: SLT
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
@@ -148,21 +142,23 @@ REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF
CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
-
!
!* 0.2 declarations of local variables
!
!
-REAL, DIMENSION(KI,IM%I%NGROUND_LAYER,IM%I%NPATCH) :: ZTG ! soil temperature
-REAL, DIMENSION(KI,IM%I%NGROUND_LAYER,IM%I%NPATCH) :: ZWG ! soil water content
-REAL, DIMENSION(KI,IM%I%NGROUND_LAYER,IM%I%NPATCH) :: ZWGI ! soil ice content
-REAL, DIMENSION(KI,IM%I%NPATCH) :: ZWR ! interception reservoir
-REAL, DIMENSION(KI,IM%I%NPATCH) :: ZRESA ! aerodynamical resistance
-REAL, DIMENSION(KI,IM%I%TSNOW%NLAYER,IM%I%NPATCH) :: ZWSNOW! snow reservoir
-REAL, DIMENSION(KI,IM%I%TSNOW%NLAYER,IM%I%NPATCH) :: ZRHOSN! snow density
-REAL, DIMENSION(KI,IM%I%TSNOW%NLAYER,IM%I%NPATCH) :: ZHEASN! snow heat content
-REAL, DIMENSION(KI,IM%I%NPATCH) :: ZALBSN! snow albedo
-REAL, DIMENSION(KI,IM%I%NPATCH) :: ZEMISN! snow emissivity
+TYPE(ISBA_P_t), POINTER :: PK
+TYPE(ISBA_PE_t), POINTER :: PEK
+!
+REAL, DIMENSION(KI,IM%O%NGROUND_LAYER,IM%O%NPATCH) :: ZTG ! soil temperature
+REAL, DIMENSION(KI,IM%O%NGROUND_LAYER,IM%O%NPATCH) :: ZWG ! soil water content
+REAL, DIMENSION(KI,IM%O%NGROUND_LAYER,IM%O%NPATCH) :: ZWGI ! soil ice content
+REAL, DIMENSION(KI,IM%O%NPATCH) :: ZWR ! interception reservoir
+REAL, DIMENSION(KI,IM%O%NPATCH) :: ZRESA ! aerodynamical resistance
+REAL, DIMENSION(KI,IM%NPE%AL(1)%TSNOW%NLAYER,IM%O%NPATCH) :: ZWSNOW! snow reservoir
+REAL, DIMENSION(KI,IM%NPE%AL(1)%TSNOW%NLAYER,IM%O%NPATCH) :: ZRHOSN! snow density
+REAL, DIMENSION(KI,IM%NPE%AL(1)%TSNOW%NLAYER,IM%O%NPATCH) :: ZHEASN! snow heat content
+REAL, DIMENSION(KI,IM%O%NPATCH) :: ZALBSN! snow albedo
+REAL, DIMENSION(KI,IM%O%NPATCH) :: ZEMISN! snow emissivity
!
REAL, DIMENSION(KI) :: ZPEW_A_COEF ! implicit coefficients
REAL, DIMENSION(KI) :: ZPEW_B_COEF ! needed if HCOUPLING='I'
@@ -170,6 +166,7 @@ REAL, DIMENSION(KI) :: ZPET_A_COEF
REAL, DIMENSION(KI) :: ZPEQ_A_COEF
REAL, DIMENSION(KI) :: ZPET_B_COEF
REAL, DIMENSION(KI) :: ZPEQ_B_COEF
+INTEGER :: JP
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
!
@@ -178,60 +175,69 @@ IF (LHOOK) CALL DR_HOOK('COUPLING_TSZ0_N',0,ZHOOK_HANDLE)
!* 1. Specified evolution of ISBA prognostic variables
! ------------------------------------------------
!
- CALL TSZ0(DTZ, &
- PTIME, PTSTEP, IM%I%XWFC, IM%I%XTG, IM%I%XWG)
+DO JP = 1,IM%O%NPATCH
+ CALL TSZ0(DTZ, PTIME, PTSTEP, IM%NK%AL(JP), IM%NPE%AL(JP))
+ENDDO
!
!
!* 2. Saves the prognostic variables
! ------------------------------
!
-ZTG (:,:,:) = IM%I%XTG (:,:,:)
-ZWG (:,:,:) = IM%I%XWG (:,:,:)
-ZWGI (:,:,:) = IM%I%XWGI (:,:,:)
-ZWR (:,:) = IM%I%XWR (:,:)
-ZRESA(:,:) = IM%I%XRESA (:,:)
-ZWSNOW(:,:,:)= IM%I%TSNOW%WSNOW(:,:,:)
-ZRHOSN(:,:,:)= IM%I%TSNOW%RHO (:,:,:)
-ZALBSN(:,:) = IM%I%TSNOW%ALB (:,:)
-IF (IM%I%TSNOW%SCHEME=='3-L' .OR. IM%I%TSNOW%SCHEME=='CRO') THEN
- ZHEASN(:,:,:)= IM%I%TSNOW%HEAT (:,:,:)
- ZEMISN(:,:) = IM%I%TSNOW%EMIS (:,:)
-END IF
+DO JP = 1,IM%O%NPATCH
+ PK => IM%NP%AL(JP)
+ PEK => IM%NPE%AL(JP)
+ !
+ ZTG (1:PK%NSIZE_P,:,JP) = PEK%XTG (:,:)
+ ZWG (1:PK%NSIZE_P,:,JP) = PEK%XWG (:,:)
+ ZWGI (1:PK%NSIZE_P,:,JP) = PEK%XWGI (:,:)
+ ZWR (1:PK%NSIZE_P,JP) = PEK%XWR (:)
+ ZRESA(1:PK%NSIZE_P,JP) = PEK%XRESA (:)
+ ZWSNOW(1:PK%NSIZE_P,:,JP)= PEK%TSNOW%WSNOW(:,:)
+ ZRHOSN(1:PK%NSIZE_P,:,JP)= PEK%TSNOW%RHO (:,:)
+ ZALBSN(1:PK%NSIZE_P,JP) = PEK%TSNOW%ALB (:)
+ IF (PEK%TSNOW%SCHEME=='3-L' .OR. PEK%TSNOW%SCHEME=='CRO') THEN
+ ZHEASN(1:PK%NSIZE_P,:,JP)= PEK%TSNOW%HEAT (:,:)
+ ZEMISN(1:PK%NSIZE_P,JP) = PEK%TSNOW%EMIS (:)
+ END IF
+ENDDO
!
!
!* 3. Call to surface scheme
! ----------------------
!
- CALL COUPLING_ISBA_OROGRAPHY_n(DTCO, UG, U, USS, IM, DTGD, DTGR, TGRO, DST, SLT, &
- HPROGRAM, 'E', &
- 0.001, KYEAR, KMONTH, KDAY, PTIME, &
- KI, KSV, KSW, &
- PTSUN, PZENITH, PZENITH2, PAZIM, &
- PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- 'OK' )
+ CALL COUPLING_ISBA_OROGRAPHY_n(DTCO, UG, U, USS, IM%SB, IM%NAG, IM%CHI, IM%NCHI, IM%DTV, IM%ID, &
+ IM%NGB, IM%GB, IM%ISS, IM%NISS, IM%G, IM%NG, IM%O, IM%S, IM%K, IM%NK, &
+ IM%NP, IM%NPE, NDST, SLT, HPROGRAM, 'E', 0.001, KYEAR, &
+ KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, &
+ PZENITH2, PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, &
+ PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, &
+ PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2,&
+ PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0,&
+ PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, &
+ PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, 'OK' )
!
!
!* 4. Removes temporal evolution of ISBA variables
! --------------------------------------------
!
!
-IM%I%XTG (:,:,:) = ZTG
-IM%I%XWG (:,:,:) = ZWG
-IM%I%XWGI (:,:,:) = ZWGI
-IM%I%XWR (:,:) = ZWR
-IM%I%XRESA(:,:) = ZRESA
-IM%I%TSNOW%WSNOW(:,:,:) = ZWSNOW
-IM%I%TSNOW%RHO (:,:,:) = ZRHOSN
-IM%I%TSNOW%ALB (:,:) = ZALBSN
-IF (IM%I%TSNOW%SCHEME=='3-L' .OR. IM%I%TSNOW%SCHEME=='CRO') THEN
- IM%I%TSNOW%HEAT (:,:,:) = ZHEASN
- IM%I%TSNOW%EMIS (:,:) = ZEMISN
-END IF
+DO JP = 1,IM%O%NPATCH
+ PK => IM%NP%AL(JP)
+ PEK => IM%NPE%AL(JP)
+ !
+ PEK%XTG (:,:) = ZTG (1:PK%NSIZE_P,:,JP)
+ PEK%XWG (:,:) = ZWG (1:PK%NSIZE_P,:,JP)
+ PEK%XWGI (:,:) = ZWGI (1:PK%NSIZE_P,:,JP)
+ PEK%XWR (:) = ZWR (1:PK%NSIZE_P,JP)
+ PEK%XRESA (:) = ZRESA(1:PK%NSIZE_P,JP)
+ PEK%TSNOW%WSNOW(:,:) = ZWSNOW(1:PK%NSIZE_P,:,JP)
+ PEK%TSNOW%RHO (:,:) = ZRHOSN(1:PK%NSIZE_P,:,JP)
+ PEK%TSNOW%ALB (:) = ZALBSN(1:PK%NSIZE_P,JP)
+ IF (PEK%TSNOW%SCHEME=='3-L' .OR. PEK%TSNOW%SCHEME=='CRO') THEN
+ PEK%TSNOW%HEAT (:,:) = ZHEASN(1:PK%NSIZE_P,:,JP)
+ PEK%TSNOW%EMIS (:) = ZEMISN(1:PK%NSIZE_P,JP)
+ END IF
+ENDDO
!
IF (LHOOK) CALL DR_HOOK('COUPLING_TSZ0_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/coupling_watflux_orogn.F90 b/src/SURFEX/coupling_watflux_orogn.F90
index 6b6fd386b5315e0b2871c512444a7d2805545872..03d0384b8671ea919d6de3db0828fb248114057c 100644
--- a/src/SURFEX/coupling_watflux_orogn.F90
+++ b/src/SURFEX/coupling_watflux_orogn.F90
@@ -1,212 +1,211 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ###############################################################################
-SUBROUTINE COUPLING_WATFLUX_OROG_n (WM, DST, SLT, &
- HPROGRAM, HCOUPLING, PTIMEC, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, &
- PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
-! ###############################################################################
-!
-!!**** *COUPLING_WATFLUX_OROG_n * - Modifies the input forcing if not
-!! initially at lake level
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! B. Decharme 2008 reset the subgrid topographic effect on the forcing
-!! J. Escobar 09/2012 SIZE(PTA) not allowed without-interface , replace by KI
-!! B. Decharme 04/2013 new coupling variables
-!! improve forcing vertical shift
-!!-------------------------------------------------------------
-!
-!
-!
-USE MODD_SURFEX_n, ONLY : WATFLUX_MODEL_t
-USE MODD_DST_n, ONLY : DST_t
-USE MODD_SLT_n, ONLY : SLT_t
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_CSTS, ONLY : XCPD, XRD, XP00
-!
-USE MODD_SURF_ATM, ONLY : LVERTSHIFT
-!
-USE MODI_FORCING_VERT_SHIFT
-!
-USE MODI_COUPLING_WATFLUX_SBL_n
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-TYPE(WATFLUX_MODEL_t), INTENT(INOUT) :: WM
-TYPE(DST_t), INTENT(INOUT) :: DST
-TYPE(SLT_t), INTENT(INOUT) :: SLT
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
- CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling
- ! 'E' : explicit
- ! 'I' : implicit
-REAL, INTENT(IN) :: PTIMEC ! cumulated time since beginning of simulation
-INTEGER, INTENT(IN) :: KYEAR ! current year (UTC)
-INTEGER, INTENT(IN) :: KMONTH ! current month (UTC)
-INTEGER, INTENT(IN) :: KDAY ! current day (UTC)
-REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s)
-INTEGER, INTENT(IN) :: KI ! number of points
-INTEGER, INTENT(IN) :: KSV ! number of scalars
-INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands
-REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight)
-REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s)
-REAL, DIMENSION(KI), INTENT(IN) :: PZREF ! height of T,q forcing (m)
-REAL, DIMENSION(KI), INTENT(IN) :: PUREF ! height of wind forcing (m)
-!
-REAL, DIMENSION(KI), INTENT(IN) :: PTA ! air temperature forcing (K)
-REAL, DIMENSION(KI), INTENT(IN) :: PQA ! air humidity forcing (kg/m3)
-REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3)
-REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables
-! ! chemistry: first char. in HSV: '#' (molecule/m3)
-! !
- CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables
-REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s)
-REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s)
-REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.)
-! ! (W/m2)
-REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.)
-! ! (W/m2)
-REAL, DIMENSION(KSW),INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m)
-REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle at t (radian from the vertical)
-REAL, DIMENSION(KI), INTENT(IN) :: PZENITH2 ! zenithal angle at t+1 (radian from the vertical)
-REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! azimuthal angle (radian from North, clockwise)
-REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.)
-! ! (W/m2)
-REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa)
-REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa)
-REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model orography (m)
-REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3)
-REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s)
-REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s)
-!
-!
-REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH ! flux of heat (W/m2)
-REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ ! flux of water vapor (kg/m2/s)
-REAL, DIMENSION(KI), INTENT(OUT) :: PSFU ! zonal momentum flux (Pa)
-REAL, DIMENSION(KI), INTENT(OUT) :: PSFV ! meridian momentum flux (Pa)
-REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2 ! flux of CO2 (m/s*kg_CO2/kg_air)
-REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS ! flux of scalar var. (kg/m2/s)
-!
-REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD ! radiative temperature (K)
-REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band (-)
-REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-)
-REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity (-)
-!
-REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF ! surface effective temperature (K)
-REAL, DIMENSION(KI), INTENT(OUT) :: PZ0 ! roughness length for momentum (m)
-REAL, DIMENSION(KI), INTENT(OUT) :: PZ0H ! roughness length for heat (m)
-REAL, DIMENSION(KI), INTENT(OUT) :: PQSURF ! specific humidity at surface (kg/kg)
-!
-REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients
-REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I'
-REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF
-REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF
-REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF
-REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF
- CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
-!
-!* 0.2 declarations of local variables
-!
-REAL, DIMENSION(KI) :: ZPEQ_B_COEF ! 1st explicit coefficient
-REAL, DIMENSION(KI) :: ZPET_B_COEF ! 2nd explicit coefficient
-!
-REAL, DIMENSION(KI) :: ZTA ! Temperature at forcing height above surface orography
-REAL, DIMENSION(KI) :: ZPA ! Pressure at forcing height above surface orography
-REAL, DIMENSION(KI) :: ZPS ! Pressure at surface orography
-REAL, DIMENSION(KI) :: ZQA ! Humidity at forcing height above surface orography
-REAL, DIMENSION(KI) :: ZRHOA ! Density at forcing height above surface orography
-REAL, DIMENSION(KI) :: ZLW ! LW rad at forcing height above surface orography
-REAL, DIMENSION(KI) :: ZRAIN ! Rainfall at forcing height above surface orography
-REAL, DIMENSION(KI) :: ZSNOW ! Snowfall at forcing height above surface orography
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------------
-! Preliminaries:
-!-------------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('COUPLING_WATFLUX_OROG_N',0,ZHOOK_HANDLE)
-!
-ZPEQ_B_COEF(:) = PPEQ_B_COEF(:)
-ZPET_B_COEF(:) = PPET_B_COEF(:)
-!
-IF(LVERTSHIFT)THEN
-!
- ZTA (:) = XUNDEF
- ZQA (:) = XUNDEF
- ZPS (:) = XUNDEF
- ZPA (:) = XUNDEF
- ZRHOA(:) = XUNDEF
- ZLW (:) = XUNDEF
- ZRAIN(:) = XUNDEF
- ZSNOW(:) = XUNDEF
-!
- CALL FORCING_VERT_SHIFT(PZS,WM%W%XZS,PTA,PQA,PPA,PRHOA,PLW,PRAIN,PSNOW,&
- ZTA,ZQA,ZPA,ZRHOA,ZLW,ZRAIN,ZSNOW )
-!
- ZPS(:) = ZPA(:) + (PPS(:) - PPA(:))
-!
- IF (HCOUPLING=='I') THEN
- ZPEQ_B_COEF = PPEQ_B_COEF + ZQA - PQA
- ZPET_B_COEF = PPET_B_COEF + ZTA/(ZPA/XP00)**(XRD/XCPD) - PTA/(PPA/XP00)**(XRD/XCPD)
- ENDIF
-!
-ELSE
-!
- ZTA (:) = PTA (:)
- ZQA (:) = PQA (:)
- ZPS (:) = PPS (:)
- ZPA (:) = PPA (:)
- ZRHOA(:) = PRHOA(:)
- ZLW (:) = PLW (:)
- ZRAIN(:) = PRAIN(:)
- ZSNOW(:) = PSNOW(:)
-!
-ENDIF
-!
- CALL COUPLING_WATFLUX_SBL_n(WM, DST, SLT, &
- HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME,&
- KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PU, PV, &
- ZQA, ZTA, ZRHOA, PSV, PCO2, HSV, ZRAIN, ZSNOW, ZLW, PDIR_SW, PSCA_SW, &
- PSW_BANDS, ZPS, ZPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, ZPET_B_COEF, &
- ZPEQ_B_COEF, HTEST )
-!
-IF (LHOOK) CALL DR_HOOK('COUPLING_WATFLUX_OROG_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE COUPLING_WATFLUX_OROG_n
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! ###############################################################################
+SUBROUTINE COUPLING_WATFLUX_OROG_n (WM, DST, SLT, HPROGRAM, HCOUPLING, PTIMEC, &
+ PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, &
+ PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PZS, PU, PV, &
+ PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, &
+ PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, &
+ PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, &
+ PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, &
+ PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
+ PPEQ_B_COEF, HTEST )
+! ###############################################################################
+!
+!!**** *COUPLING_WATFLUX_OROG_n * - Modifies the input forcing if not
+!! initially at lake level
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2004
+!! B. Decharme 2008 reset the subgrid topographic effect on the forcing
+!! J. Escobar 09/2012 SIZE(PTA) not allowed without-interface , replace by KI
+!! B. Decharme 04/2013 new coupling variables
+!! improve forcing vertical shift
+!!-------------------------------------------------------------
+!
+!
+!
+USE MODD_SURFEX_n, ONLY : WATFLUX_MODEL_t
+USE MODD_DST_n, ONLY : DST_t
+USE MODD_SLT_n, ONLY : SLT_t
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_CSTS, ONLY : XCPD, XRD, XP00
+!
+USE MODD_SURF_ATM, ONLY : LVERTSHIFT
+!
+USE MODI_FORCING_VERT_SHIFT
+!
+USE MODI_COUPLING_WATFLUX_SBL_n
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+!
+!
+TYPE(WATFLUX_MODEL_t), INTENT(INOUT) :: WM
+TYPE(DST_t), INTENT(INOUT) :: DST
+TYPE(SLT_t), INTENT(INOUT) :: SLT
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+ CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling
+ ! 'E' : explicit
+ ! 'I' : implicit
+REAL, INTENT(IN) :: PTIMEC ! cumulated time since beginning of simulation
+INTEGER, INTENT(IN) :: KYEAR ! current year (UTC)
+INTEGER, INTENT(IN) :: KMONTH ! current month (UTC)
+INTEGER, INTENT(IN) :: KDAY ! current day (UTC)
+REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s)
+INTEGER, INTENT(IN) :: KI ! number of points
+INTEGER, INTENT(IN) :: KSV ! number of scalars
+INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands
+REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight)
+REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s)
+REAL, DIMENSION(KI), INTENT(IN) :: PZREF ! height of T,q forcing (m)
+REAL, DIMENSION(KI), INTENT(IN) :: PUREF ! height of wind forcing (m)
+!
+REAL, DIMENSION(KI), INTENT(IN) :: PTA ! air temperature forcing (K)
+REAL, DIMENSION(KI), INTENT(IN) :: PQA ! air humidity forcing (kg/m3)
+REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3)
+REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables
+! ! chemistry: first char. in HSV: '#' (molecule/m3)
+! !
+ CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables
+REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s)
+REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s)
+REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.)
+! ! (W/m2)
+REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.)
+! ! (W/m2)
+REAL, DIMENSION(KSW),INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m)
+REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle at t (radian from the vertical)
+REAL, DIMENSION(KI), INTENT(IN) :: PZENITH2 ! zenithal angle at t+1 (radian from the vertical)
+REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! azimuthal angle (radian from North, clockwise)
+REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.)
+! ! (W/m2)
+REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa)
+REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa)
+REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model orography (m)
+REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3)
+REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s)
+REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s)
+!
+!
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH ! flux of heat (W/m2)
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ ! flux of water vapor (kg/m2/s)
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFU ! zonal momentum flux (Pa)
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFV ! meridian momentum flux (Pa)
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2 ! flux of CO2 (m/s*kg_CO2/kg_air)
+REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS ! flux of scalar var. (kg/m2/s)
+!
+REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD ! radiative temperature (K)
+REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band (-)
+REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-)
+REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity (-)
+!
+REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF ! surface effective temperature (K)
+REAL, DIMENSION(KI), INTENT(OUT) :: PZ0 ! roughness length for momentum (m)
+REAL, DIMENSION(KI), INTENT(OUT) :: PZ0H ! roughness length for heat (m)
+REAL, DIMENSION(KI), INTENT(OUT) :: PQSURF ! specific humidity at surface (kg/kg)
+!
+REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients
+REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I'
+REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF
+REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF
+REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF
+REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF
+ CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
+!
+!* 0.2 declarations of local variables
+!
+REAL, DIMENSION(KI) :: ZPEQ_B_COEF ! 1st explicit coefficient
+REAL, DIMENSION(KI) :: ZPET_B_COEF ! 2nd explicit coefficient
+!
+REAL, DIMENSION(KI) :: ZTA ! Temperature at forcing height above surface orography
+REAL, DIMENSION(KI) :: ZPA ! Pressure at forcing height above surface orography
+REAL, DIMENSION(KI) :: ZPS ! Pressure at surface orography
+REAL, DIMENSION(KI) :: ZQA ! Humidity at forcing height above surface orography
+REAL, DIMENSION(KI) :: ZRHOA ! Density at forcing height above surface orography
+REAL, DIMENSION(KI) :: ZLW ! LW rad at forcing height above surface orography
+REAL, DIMENSION(KI) :: ZRAIN ! Rainfall at forcing height above surface orography
+REAL, DIMENSION(KI) :: ZSNOW ! Snowfall at forcing height above surface orography
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------------
+! Preliminaries:
+!-------------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('COUPLING_WATFLUX_OROG_N',0,ZHOOK_HANDLE)
+!
+ZPEQ_B_COEF(:) = PPEQ_B_COEF(:)
+ZPET_B_COEF(:) = PPET_B_COEF(:)
+!
+IF(LVERTSHIFT)THEN
+!
+ ZTA (:) = XUNDEF
+ ZQA (:) = XUNDEF
+ ZPS (:) = XUNDEF
+ ZPA (:) = XUNDEF
+ ZRHOA(:) = XUNDEF
+ ZLW (:) = XUNDEF
+ ZRAIN(:) = XUNDEF
+ ZSNOW(:) = XUNDEF
+!
+ CALL FORCING_VERT_SHIFT(PZS,WM%W%XZS,PTA,PQA,PPA,PRHOA,PLW,PRAIN,PSNOW,&
+ ZTA,ZQA,ZPA,ZRHOA,ZLW,ZRAIN,ZSNOW )
+!
+ ZPS(:) = ZPA(:) + (PPS(:) - PPA(:))
+!
+ IF (HCOUPLING=='I') THEN
+ ZPEQ_B_COEF = PPEQ_B_COEF + ZQA - PQA
+ ZPET_B_COEF = PPET_B_COEF + ZTA/(ZPA/XP00)**(XRD/XCPD) - PTA/(PPA/XP00)**(XRD/XCPD)
+ ENDIF
+!
+ELSE
+!
+ ZTA (:) = PTA (:)
+ ZQA (:) = PQA (:)
+ ZPS (:) = PPS (:)
+ ZPA (:) = PPA (:)
+ ZRHOA(:) = PRHOA(:)
+ ZLW (:) = PLW (:)
+ ZRAIN(:) = PRAIN(:)
+ ZSNOW(:) = PSNOW(:)
+!
+ENDIF
+!
+ CALL COUPLING_WATFLUX_SBL_n(WM%SB, WM%CHW, WM%DWO, WM%DW, WM%DWC, WM%W, DST, SLT, &
+ HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
+ KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PU, PV, &
+ ZQA, ZTA, ZRHOA, PSV, PCO2, HSV, ZRAIN, ZSNOW, ZLW, PDIR_SW, PSCA_SW, &
+ PSW_BANDS, ZPS, ZPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
+ PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
+ PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, ZPET_B_COEF, &
+ ZPEQ_B_COEF, HTEST )
+!
+IF (LHOOK) CALL DR_HOOK('COUPLING_WATFLUX_OROG_N',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------------
+!
+END SUBROUTINE COUPLING_WATFLUX_OROG_n
diff --git a/src/SURFEX/coupling_watflux_sbln.F90 b/src/SURFEX/coupling_watflux_sbln.F90
index 07f8f7a99db699bf059a48019c3bb3866261e5a0..fa797332dfde506e2581745b1a5cc70607bacd4c 100644
--- a/src/SURFEX/coupling_watflux_sbln.F90
+++ b/src/SURFEX/coupling_watflux_sbln.F90
@@ -3,14 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################################
-SUBROUTINE COUPLING_WATFLUX_SBL_n (WM, DST, SLT, &
- HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PU, PV, &
- PQA, PTA, PRHOA, PSV, PCO2, HSV,PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, &
- PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
- PPEQ_B_COEF, HTEST )
+SUBROUTINE COUPLING_WATFLUX_SBL_n (SB, CHW, DGO, D, DC, W, DST, SLT, &
+ HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
+ KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PU, PV, &
+ PQA, PTA, PRHOA, PSV, PCO2, HSV,PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, &
+ PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
+ PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
+ PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
+ PPEQ_B_COEF, HTEST )
! ###############################################################################
!
!!**** *COUPLING_WATFLUX_SBL_n * - Adds a SBL into SEAFLUX
@@ -40,7 +40,11 @@ SUBROUTINE COUPLING_WATFLUX_SBL_n (WM, DST, SLT, &
!----------------------------------------------------------------
!
!
-USE MODD_SURFEX_n, ONLY : WATFLUX_MODEL_t
+USE MODD_CANOPY_n, ONLY : CANOPY_t
+USE MODD_CH_WATFLUX_n, ONLY : CH_WATFLUX_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t, DIAG_t
+USE MODD_WATFLUX_n, ONLY : WATFLUX_t
+!
USE MODD_DST_n, ONLY : DST_t
USE MODD_SLT_n, ONLY : SLT_t
!
@@ -64,7 +68,13 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(WATFLUX_MODEL_t), INTENT(INOUT) :: WM
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
+TYPE(CH_WATFLUX_t), INTENT(INOUT) :: CHW
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
+TYPE(WATFLUX_t), INTENT(INOUT) :: W
+!
TYPE(DST_t), INTENT(INOUT) :: DST
TYPE(SLT_t), INTENT(INOUT) :: SLT
!
@@ -158,21 +168,20 @@ REAL, DIMENSION(KI) :: ZPEQ_B_COEF ! coefficients (hum. in kg/kg)
REAL, DIMENSION(KI) :: ZSFLUX_U ! Surface flux u'w' (m2/s2)
REAL, DIMENSION(KI) :: ZSFLUX_T ! Surface flux w'T' (mK/s)
REAL, DIMENSION(KI) :: ZSFLUX_Q ! Surface flux w'q' (kgm2/s)
-REAL, DIMENSION(KI,WM%WSB%NLVL) :: ZFORC_U ! tendency due to drag force for wind
-REAL, DIMENSION(KI,WM%WSB%NLVL) :: ZDFORC_UDU! formal derivative of
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_U ! tendency due to drag force for wind
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_UDU! formal derivative of
! ! tendency due to drag force for wind
-REAL, DIMENSION(KI,WM%WSB%NLVL) :: ZFORC_E ! tendency due to drag force for TKE
-REAL, DIMENSION(KI,WM%WSB%NLVL) :: ZDFORC_EDE! formal derivative of
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_E ! tendency due to drag force for TKE
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_EDE! formal derivative of
! ! tendency due to drag force for TKE
-REAL, DIMENSION(KI,WM%WSB%NLVL) :: ZFORC_T ! tendency due to drag force for Temp
-REAL, DIMENSION(KI,WM%WSB%NLVL) :: ZDFORC_TDT! formal derivative of
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_T ! tendency due to drag force for Temp
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_TDT! formal derivative of
! ! tendency due to drag force for Temp
-REAL, DIMENSION(KI,WM%WSB%NLVL) :: ZFORC_Q ! tendency due to drag force for Temp
-REAL, DIMENSION(KI,WM%WSB%NLVL) :: ZDFORC_QDQ! formal derivative of
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_Q ! tendency due to drag force for Temp
+REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_QDQ! formal derivative of
! ! tendency due to drag force for hum.
-REAL, DIMENSION(KI,WM%WSB%NLVL) :: ZLMO ! MO length
-REAL, DIMENSION(KI,WM%WSB%NLVL) :: ZLM ! mixing length
-REAL, DIMENSION(KI,WM%WSB%NLVL) :: ZLEPS ! dissipative length
+REAL, DIMENSION(KI,SB%NLVL) :: ZLM ! mixing length
+REAL, DIMENSION(KI,SB%NLVL) :: ZLEPS ! dissipative length
REAL, DIMENSION(KI) :: ZH ! canopy height (m)
REAL, DIMENSION(KI) :: ZUSTAR ! friction velocity (m/s)
!
@@ -188,6 +197,7 @@ REAL, DIMENSION(KI) :: ZBETATH ! Th+(1) = - alfa rho w'th'(1) + beta
REAL, DIMENSION(KI) :: ZALFAQ ! Q+(1) = - alfa rho w'q'(1) + beta
REAL, DIMENSION(KI) :: ZBETAQ ! Q+(1) = - alfa rho w'q'(1) + beta
!
+INTEGER :: JLAYER
CHARACTER(LEN=1) :: GCOUPLING
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
@@ -197,7 +207,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('COUPLING_WATFLUX_SBL_N',0,ZHOOK_HANDLE)
-IF (WM%W%LSBL) THEN
+IF (W%LSBL) THEN
!
!* 1.1 Updates SBL vertical grid as a function of forcing height
! ---------------------------------------------------------
@@ -205,18 +215,16 @@ IF (WM%W%LSBL) THEN
!* determines where is the forcing level and modifies the upper levels of the canopy grid
!
ZH = 0.
- CALL CANOPY_GRID_UPDATE(KI,WM%WSB%NLVL,ZH,PUREF,&
- WM%WSB%XZ,WM%WSB%XZF,WM%WSB%XDZ,WM%WSB%XDZF)
+ CALL CANOPY_GRID_UPDATE(KI,ZH,PUREF,SB)
!
!
!
!* 1.2 Initialisation at first time step
! ---------------------------------
!
- IF(ANY(WM%WSB%XT(:,:) == XUNDEF)) THEN
- CALL INIT_WATER_SBL(WM%WSB%NLVL, PPA, PPS, PTA, PQA, PRHOA, PU, PV, PRAIN, PSNOW, &
- PSFTH, PSFTQ, PZREF, PUREF, WM%W%XTS, WM%W%XZ0, WM%WSB%XZ, &
- WM%WSB%XT, WM%WSB%XQ, WM%WSB%XU, WM%WSB%XTKE, WM%WSB%XP)
+ IF(ANY(SB%XT(:,:) == XUNDEF)) THEN
+ CALL INIT_WATER_SBL(SB, PPA, PPS, PTA, PQA, PRHOA, PU, PV, PRAIN, PSNOW, &
+ PSFTH, PSFTQ, PZREF, PUREF, W%XTS, W%XZ0)
ENDIF
!
!
@@ -224,26 +232,20 @@ IF (WM%W%LSBL) THEN
! -----------
!
CALL INIT_FORC( ZFORC_U, ZDFORC_UDU, ZFORC_E, ZDFORC_EDE, &
- ZFORC_T, ZDFORC_TDT, ZFORC_Q, ZDFORC_QDQ )
+ ZFORC_T, ZDFORC_TDT, ZFORC_Q, ZDFORC_QDQ )
!
ZSFLUX_U = 0.
ZSFLUX_T = 0.
ZSFLUX_Q = 0.
-!
- ZLMO = SPREAD(WM%WSB%XLMO,2,WM%WSB%NLVL)
!
!* 1.3 Computes coefficients for implicitation
! ---------------------------------------
!
ZWIND = SQRT(PU**2+PV**2)
- CALL CANOPY_EVOL(KI,WM%WSB%NLVL,PTSTEP,1,WM%WSB%XZ,ZWIND,PTA,PQA,PPA,PRHOA, &
- ZSFLUX_U,ZSFLUX_T,ZSFLUX_Q, &
- ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE, &
- ZFORC_T,ZDFORC_TDT,ZFORC_Q,ZDFORC_QDQ, &
- WM%WSB%XZ,WM%WSB%XZF,WM%WSB%XDZ,WM%WSB%XDZF, &
- WM%WSB%XU,WM%WSB%XTKE,WM%WSB%XT, &
- WM%WSB%XQ,ZLMO,ZLM,ZLEPS,WM%WSB%XP,ZUSTAR, &
- ZALFAU,ZBETAU,ZALFATH,ZBETATH,ZALFAQ,ZBETAQ )
+ CALL CANOPY_EVOL(SB,KI,PTSTEP,1,SB%XZ,ZWIND,PTA,PQA,PPA,PRHOA, &
+ ZSFLUX_U,ZSFLUX_T,ZSFLUX_Q,ZFORC_U,ZDFORC_UDU,&
+ ZFORC_E,ZDFORC_EDE,ZFORC_T,ZDFORC_TDT,ZFORC_Q,ZDFORC_QDQ, &
+ ZLM,ZLEPS,ZUSTAR,ZALFAU,ZBETAU,ZALFATH,ZBETATH,ZALFAQ,ZBETAQ )
!
!* 1.5 Goes from atmospheric forcing to canopy forcing height
@@ -251,16 +253,14 @@ IF (WM%W%LSBL) THEN
!
GCOUPLING = 'I'
!
- CALL INIT_COUPLING_CANOPY( WM%WSB%XP(:,1), PPA, WM%WSB%XT(:,1), &
- WM%WSB%XQ(:,1), PU, PV, WM%WSB%XZ(:,1), &
- WM%WSB%XU(:,1), &
- PRHOA, ZALFAU, ZBETAU, ZALFATH, &
- ZBETATH, ZALFAQ, ZBETAQ, &
- ZPA, ZTA, ZQA, ZU, ZV, &
- ZUREF, ZZREF, ZEXNA, &
- ZPEW_A_COEF, ZPEW_B_COEF, &
- ZPET_A_COEF, ZPET_B_COEF, &
- ZPEQ_A_COEF, ZPEQ_B_COEF )
+ CALL INIT_COUPLING_CANOPY( SB, PPA, PU, PV, &
+ PRHOA, ZALFAU, ZBETAU, ZALFATH, &
+ ZBETATH, ZALFAQ, ZBETAQ, &
+ ZPA, ZTA, ZQA, ZU, ZV, &
+ ZUREF, ZZREF, ZEXNA, &
+ ZPEW_A_COEF, ZPEW_B_COEF, &
+ ZPET_A_COEF, ZPET_B_COEF, &
+ ZPEQ_A_COEF, ZPEQ_B_COEF )
!
!-------------------------------------------------------------------------------------
ELSE
@@ -290,26 +290,21 @@ END IF
!* 2. Call of SEAFLUX
! ------------
!
- CALL COUPLING_WATFLUX_n(WM, DST, SLT, &
- HPROGRAM, GCOUPLING, PTIMEC, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
- KI, KSV, KSW, &
- PTSUN, PZENITH, PZENITH2, PAZIM, &
- ZZREF, ZUREF, ZU, ZV, ZQA, ZTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, ZPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- ZPEW_A_COEF, ZPEW_B_COEF, &
- ZPET_A_COEF, ZPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF, &
- 'OK' )
+ CALL COUPLING_WATFLUX_n(CHW, DGO, D, DC, W, DST, SLT, HPROGRAM, GCOUPLING, PTIMEC, &
+ PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, &
+ PZENITH2, PAZIM, ZZREF, ZUREF, ZU, ZV, ZQA, ZTA, PRHOA, PSV, PCO2,&
+ HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, ZPA, &
+ PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB,&
+ PEMIS, PTSURF, PZ0, PZ0H, PQSURF, ZPEW_A_COEF, ZPEW_B_COEF, &
+ ZPET_A_COEF, ZPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF,'OK' )
!
!-------------------------------------------------------------------------------------
!
!* 3. End if no SBL is used
! ---------------------
!
-IF (.NOT. WM%W%LSBL .AND. LHOOK) CALL DR_HOOK('COUPLING_WATFLUX_SBL_N',1,ZHOOK_HANDLE)
-IF (.NOT. WM%W%LSBL) RETURN
+IF (.NOT. W%LSBL .AND. LHOOK) CALL DR_HOOK('COUPLING_WATFLUX_SBL_N',1,ZHOOK_HANDLE)
+IF (.NOT. W%LSBL) RETURN
!
!-------------------------------------------------------------------------------------
!
@@ -317,7 +312,7 @@ IF (.NOT. WM%W%LSBL) RETURN
! -------------------------------------------------
!
CALL INIT_FORC( ZFORC_U, ZDFORC_UDU, ZFORC_E, ZDFORC_EDE, &
- ZFORC_T, ZDFORC_TDT, ZFORC_Q, ZDFORC_QDQ )
+ ZFORC_T, ZDFORC_TDT, ZFORC_Q, ZDFORC_QDQ )
!
ZSFLUX_U = - SQRT(PSFU(:)**2+PSFV(:)**2) / PRHOA(:)
ZSFLUX_T(:) = PSFTH(:) / XCPD * ZEXNA(:) / PRHOA(:)
@@ -329,16 +324,15 @@ ZSFLUX_Q(:) = PSFTQ(:)
! --------------------------------------------
!
ZWIND = SQRT(PU**2+PV**2)
- CALL CANOPY_EVOL(KI,WM%WSB%NLVL,PTSTEP,2,WM%WSB%XZ,ZWIND,PTA,PQA,PPA,PRHOA, &
- ZSFLUX_U,ZSFLUX_T,ZSFLUX_Q, &
- ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE, &
- ZFORC_T,ZDFORC_TDT,ZFORC_Q,ZDFORC_QDQ, &
- WM%WSB%XZ,WM%WSB%XZF,WM%WSB%XDZ,WM%WSB%XDZF, &
- WM%WSB%XU,WM%WSB%XTKE,WM%WSB%XT, &
- WM%WSB%XQ,ZLMO,ZLM,ZLEPS,WM%WSB%XP,ZUSTAR, &
- ZALFAU,ZBETAU,ZALFATH,ZBETATH,ZALFAQ,ZBETAQ )
+ CALL CANOPY_EVOL(SB,KI,PTSTEP,2,SB%XZ,ZWIND,PTA,PQA,PPA,PRHOA, &
+ ZSFLUX_U,ZSFLUX_T,ZSFLUX_Q,ZFORC_U,ZDFORC_UDU, &
+ ZFORC_E,ZDFORC_EDE,ZFORC_T,ZDFORC_TDT, &
+ ZFORC_Q,ZDFORC_QDQ,ZLM,ZLEPS,ZUSTAR, &
+ ZALFAU,ZBETAU,ZALFATH,ZBETATH,ZALFAQ,ZBETAQ )
!
-WM%WSB%XLMO(:) = ZLMO(:,WM%WSB%NLVL)
+DO JLAYER=1,SB%NLVL-1
+ SB%XLMO(:,JLAYER) = SB%XLMO(:,SB%NLVL)
+ENDDO
!
!-------------------------------------------------------------------------------------
!
@@ -346,13 +340,7 @@ WM%WSB%XLMO(:) = ZLMO(:,WM%WSB%NLVL)
! ----------------------------------------
!
!
-IF (WM%W%LSBL .AND. WM%DGW%N2M>=1) CALL INIT_2M_10M( WM%WSB%XP(:,2), WM%WSB%XT(:,2), &
- WM%WSB%XQ(:,2), WM%WSB%XU, WM%WSB%XZ, &
- PU, PV, ZWIND, PRHOA, &
- WM%DGW%XT2M, WM%DGW%XQ2M, WM%DGW%XHU2M, &
- WM%DGW%XZON10M, WM%DGW%XMER10M,&
- WM%DGW%XWIND10M, WM%DGW%XWIND10M_MAX, WM%DGW%XT2M_MIN, &
- WM%DGW%XT2M_MAX, WM%DGW%XHU2M_MIN, WM%DGW%XHU2M_MAX )
+IF (W%LSBL .AND. DGO%N2M>=1) CALL INIT_2M_10M( SB, D, PU, PV, ZWIND, PRHOA )
!
IF (LHOOK) CALL DR_HOOK('COUPLING_WATFLUX_SBL_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/coupling_watfluxn.F90 b/src/SURFEX/coupling_watfluxn.F90
index 465e2f0e7fa7f0def464b4a84c85855d26736b49..6a51671ea12166288e3c71ae41d434ae3accf47f 100644
--- a/src/SURFEX/coupling_watfluxn.F90
+++ b/src/SURFEX/coupling_watfluxn.F90
@@ -3,16 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################################
-SUBROUTINE COUPLING_WATFLUX_n (WM, DST, SLT, &
- HPROGRAM, HCOUPLING, PTIMEC, &
- PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, &
- PAZIM, PZREF, PUREF, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
- PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
- PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
- PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- HTEST )
+SUBROUTINE COUPLING_WATFLUX_n (CHW, DGO, D, DC, W, DST, SLT, &
+ HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
+ KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, &
+ PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, &
+ PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, &
+ PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, &
+ PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, &
+ PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST )
! ###############################################################################
!
!!**** *COUPLING_WATFLUX_n * - Driver for WATER_FLUX scheme for lakes
@@ -45,11 +43,12 @@ SUBROUTINE COUPLING_WATFLUX_n (WM, DST, SLT, &
!!----------------------------------------------------------------------------
!
!
+USE MODD_CH_WATFLUX_n, ONLY : CH_WATFLUX_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t, DIAG_t
+USE MODD_WATFLUX_n, ONLY : WATFLUX_t
!
-USE MODD_SURFEX_n, ONLY : WATFLUX_MODEL_t
USE MODD_DST_n, ONLY : DST_t
USE MODD_SLT_n, ONLY : SLT_t
-USE MODD_WATFLUX_n, ONLY : WATFLUX_t
!
USE MODD_REPROD_OPER, ONLY : CIMPLICIT_WIND
!
@@ -83,8 +82,12 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(CH_WATFLUX_t), INTENT(INOUT) :: CHW
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
+TYPE(WATFLUX_t), INTENT(INOUT) :: W
!
-TYPE(WATFLUX_MODEL_t), INTENT(INOUT) :: WM
TYPE(DST_t), INTENT(INOUT) :: DST
TYPE(SLT_t), INTENT(INOUT) :: SLT
!
@@ -188,6 +191,8 @@ REAL :: ZCONVERTFACM6_SLT, ZCONVERTFACM6_DST
INTEGER :: ISWB ! number of shortwave spectral bands
INTEGER :: JSWB ! loop counter on shortwave spectral bands
!
+INTEGER :: IBEG, IEND
+!
LOGICAL :: GHANDLE_SIC = .FALSE. ! no sea-ice model
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -242,17 +247,17 @@ ZQA(:) = PQA(:) / PRHOA(:)
! Time evolution
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-WM%W%TTIME%TIME = WM%W%TTIME%TIME + PTSTEP
- CALL ADD_FORECAST_TO_DATE_SURF(WM%W%TTIME%TDATE%YEAR,WM%W%TTIME%TDATE%MONTH,WM%W%TTIME%TDATE%DAY,WM%W%TTIME%TIME)
+W%TTIME%TIME = W%TTIME%TIME + PTSTEP
+CALL ADD_FORECAST_TO_DATE_SURF(W%TTIME%TDATE%YEAR,W%TTIME%TDATE%MONTH,W%TTIME%TDATE%DAY,W%TTIME%TIME)
!
!--------------------------------------------------------------------------------------
! Fluxes over water according to Charnock formulae
!--------------------------------------------------------------------------------------
!
!
- CALL WATER_FLUX(WM%W%XZ0, PTA, ZEXNA, PRHOA, WM%W%XTS, ZEXNS, ZQA, PRAIN, &
- PSNOW, XTT, ZWIND, PZREF, PUREF, PPS, GHANDLE_SIC, &
- ZQSAT, PSFTH, PSFTQ, ZUSTAR, ZCD, ZCDN, ZCH, ZRI, &
+CALL WATER_FLUX(W%XZ0, PTA, ZEXNA, PRHOA, W%XTS, ZEXNS, ZQA, PRAIN, &
+ PSNOW, XTT, ZWIND, PZREF, PUREF, PPS, GHANDLE_SIC, &
+ ZQSAT, PSFTH, PSFTQ, ZUSTAR, ZCD, ZCDN, ZCH, ZRI, &
ZRESA_WATER, ZZ0H )
!
!-------------------------------------------------------------------------------------
@@ -262,12 +267,12 @@ WM%W%TTIME%TIME = WM%W%TTIME%TIME + PTSTEP
ISWB = SIZE(PSW_BANDS)
!
DO JSWB=1,ISWB
- ZDIR_ALB(:,JSWB) = WM%W%XDIR_ALB(:)
- ZSCA_ALB(:,JSWB) = WM%W%XSCA_ALB(:)
+ ZDIR_ALB(:,JSWB) = W%XDIR_ALB(:)
+ ZSCA_ALB(:,JSWB) = W%XSCA_ALB(:)
END DO
!
-ZEMIS = WM%W%XEMIS
-ZTRAD = WM%W%XTS
+ZEMIS = W%XEMIS
+ZTRAD = W%XTS
!
!-------------------------------------------------------------------------------------
!Specific fields for GELATO when using earth system model
@@ -275,9 +280,9 @@ ZTRAD = WM%W%XTS
!-------------------------------------------------------------------------------------
!
IF(LCPL_SEAICE)THEN
- CALL COUPLING_ICEFLUX_n(KI, PTA, ZEXNA, PRHOA, WM%W%XTICE, ZEXNS, &
- ZQA, PRAIN, PSNOW, ZWIND, PZREF, PUREF, &
- PPS, WM%W%XTS, XTT, ZSFTH_ICE, ZSFTQ_ICE )
+ CALL COUPLING_ICEFLUX_n(KI, PTA, ZEXNA, PRHOA, W%XTICE, ZEXNS, &
+ ZQA, PRAIN, PSNOW, ZWIND, PZREF, PUREF, &
+ PPS, W%XTS, XTT, ZSFTH_ICE, ZSFTQ_ICE )
ENDIF
!
!-------------------------------------------------------------------------------------
@@ -285,36 +290,48 @@ ENDIF
!-------------------------------------------------------------------------------------
!
!
-IF (WM%CHW%SVW%NBEQ>0) THEN
- IF (WM%CHW%CCH_DRY_DEP == "WES89") THEN
- CALL CH_DEP_WATER (ZRESA_WATER, ZUSTAR, PTA, ZTRAD, &
- PSV(:,WM%CHW%SVW%NSV_CHSBEG:WM%CHW%SVW%NSV_CHSEND), &
- WM%CHW%SVW%CSV(WM%CHW%SVW%NSV_CHSBEG:WM%CHW%SVW%NSV_CHSEND), &
- WM%CHW%XDEP(:,1:WM%CHW%SVW%NBEQ) )
-
- PSFTS(:,WM%CHW%SVW%NSV_CHSBEG:WM%CHW%SVW%NSV_CHSEND) = - PSV(:,WM%CHW%SVW%NSV_CHSBEG:WM%CHW%SVW%NSV_CHSEND) &
- * WM%CHW%XDEP(:,1:WM%CHW%SVW%NBEQ)
- IF (WM%CHW%SVW%NAEREQ > 0 ) THEN
- CALL CH_AER_DEP(PSV(:,WM%CHW%SVW%NSV_AERBEG:WM%CHW%SVW%NSV_AEREND),&
- PSFTS(:,WM%CHW%SVW%NSV_AERBEG:WM%CHW%SVW%NSV_AEREND),&
- ZUSTAR,ZRESA_WATER,PTA,PRHOA)
- END IF
+IF (CHW%SVW%NBEQ>0) THEN
+ !
+ IF (CHW%CCH_DRY_DEP == "WES89") THEN
+ !
+ IBEG = CHW%SVW%NSV_CHSBEG
+ IEND = CHW%SVW%NSV_CHSEND
+ !
+ CALL CH_DEP_WATER (ZRESA_WATER, ZUSTAR, PTA, ZTRAD, PSV(:,IBEG:IEND), &
+ CHW%SVW%CSV(IBEG:IEND), CHW%XDEP(:,1:CHW%SVW%NBEQ) )
+ PSFTS(:,IBEG:IEND) = - PSV(:,IBEG:IEND) * CHW%XDEP(:,1:CHW%SVW%NBEQ)
+ IF (CHW%SVW%NAEREQ > 0 ) THEN
+ IBEG = CHW%SVW%NSV_AERBEG
+ IEND = CHW%SVW%NSV_AEREND
+ !
+ CALL CH_AER_DEP(PSV(:,IBEG:IEND),PSFTS(:,IBEG:IEND),ZUSTAR,ZRESA_WATER,PTA,PRHOA)
+ END IF
+ !
ELSE
- PSFTS(:,WM%CHW%SVW%NSV_CHSBEG:WM%CHW%SVW%NSV_CHSEND) =0.
- IF(WM%CHW%SVW%NSV_AERBEG.LT.WM%CHW%SVW%NSV_AEREND) PSFTS(:,WM%CHW%SVW%NSV_AERBEG:WM%CHW%SVW%NSV_AEREND) =0.
+ !
+ IBEG = CHW%SVW%NSV_AERBEG
+ IEND = CHW%SVW%NSV_AEREND
+ !
+ PSFTS(:,IBEG:IEND) =0.
+ IF(IBEG.LT.IBEG) PSFTS(:,IBEG:IBEG) =0.
+ !
ENDIF
+ !
ENDIF
!
-IF (WM%CHW%SVW%NDSTEQ>0) THEN
- CALL DSLT_DEP(PSV(:,WM%CHW%SVW%NSV_DSTBEG:WM%CHW%SVW%NSV_DSTEND), PSFTS(:,WM%CHW%SVW%NSV_DSTBEG:WM%CHW%SVW%NSV_DSTEND), &
- ZUSTAR, ZRESA_WATER, PTA, PRHOA, DST%XEMISSIG_DST, DST%XEMISRADIUS_DST, &
- JPMODE_DST, XDENSITY_DST, XMOLARWEIGHT_DST, ZCONVERTFACM0_DST, &
- ZCONVERTFACM6_DST, ZCONVERTFACM3_DST, LVARSIG_DST, LRGFIX_DST, &
- CVERMOD )
-
+IF (CHW%SVW%NDSTEQ>0) THEN
+ !
+ IBEG = CHW%SVW%NSV_DSTBEG
+ IEND = CHW%SVW%NSV_DSTEND
+ !
+ CALL DSLT_DEP(PSV(:,IBEG:IEND), PSFTS(:,IBEG:IEND), ZUSTAR, ZRESA_WATER, PTA, PRHOA, &
+ DST%XEMISSIG_DST, DST%XEMISRADIUS_DST, JPMODE_DST, XDENSITY_DST, &
+ XMOLARWEIGHT_DST, ZCONVERTFACM0_DST, ZCONVERTFACM6_DST, ZCONVERTFACM3_DST, &
+ LVARSIG_DST, LRGFIX_DST, CVERMOD )
+ !
CALL MASSFLUX2MOMENTFLUX( &
- PSFTS(:,WM%CHW%SVW%NSV_DSTBEG:WM%CHW%SVW%NSV_DSTEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
+ PSFTS(:,IBEG:IEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
PRHOA, & !I [kg/m3] air density
DST%XEMISRADIUS_DST, &!I [um] emitted radius for the modes (max 3)
DST%XEMISSIG_DST, &!I [-] emitted sigma for the different modes (max 3)
@@ -323,17 +340,21 @@ IF (WM%CHW%SVW%NDSTEQ>0) THEN
ZCONVERTFACM6_DST, &
ZCONVERTFACM3_DST, &
LVARSIG_DST, LRGFIX_DST )
+ !
ENDIF
!
-IF (WM%CHW%SVW%NSLTEQ>0) THEN
- CALL DSLT_DEP(PSV(:,WM%CHW%SVW%NSV_SLTBEG:WM%CHW%SVW%NSV_SLTEND), PSFTS(:,WM%CHW%SVW%NSV_SLTBEG:WM%CHW%SVW%NSV_SLTEND), &
- ZUSTAR, ZRESA_WATER, PTA, PRHOA, SLT%XEMISSIG_SLT, SLT%XEMISRADIUS_SLT, &
- JPMODE_SLT, XDENSITY_SLT, XMOLARWEIGHT_SLT, ZCONVERTFACM0_SLT, &
- ZCONVERTFACM6_SLT, ZCONVERTFACM3_SLT, LVARSIG_SLT, LRGFIX_SLT, &
- CVERMOD )
+IF (CHW%SVW%NSLTEQ>0) THEN
+ !
+ IBEG = CHW%SVW%NSV_SLTBEG
+ IEND = CHW%SVW%NSV_SLTEND
+ !
+ CALL DSLT_DEP(PSV(:,IBEG:IEND), PSFTS(:,IBEG:IEND), ZUSTAR, ZRESA_WATER, PTA, PRHOA, &
+ SLT%XEMISSIG_SLT, SLT%XEMISRADIUS_SLT, JPMODE_SLT, XDENSITY_SLT, &
+ XMOLARWEIGHT_SLT, ZCONVERTFACM0_SLT, ZCONVERTFACM6_SLT, ZCONVERTFACM3_SLT, &
+ LVARSIG_SLT, LRGFIX_SLT, CVERMOD )
CALL MASSFLUX2MOMENTFLUX( &
- PSFTS(:,WM%CHW%SVW%NSV_SLTBEG:WM%CHW%SVW%NSV_SLTEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
+ PSFTS(:,IBEG:IEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
PRHOA, & !I [kg/m3] air density
SLT%XEMISRADIUS_SLT, &!I [um] emitted radius for the modes (max 3)
SLT%XEMISSIG_SLT, &!I [-] emitted sigma for the different modes (max 3)
@@ -342,6 +363,7 @@ IF (WM%CHW%SVW%NSLTEQ>0) THEN
ZCONVERTFACM6_SLT, &
ZCONVERTFACM3_SLT, &
LVARSIG_SLT, LRGFIX_SLT )
+ !
ENDIF
!
!-------------------------------------------------------------------------------------
@@ -383,20 +405,19 @@ PSFCO2(:) = 0.0 ! Assumes no CO2 emission over water bodies
! Inline diagnostics at time t for TS and TRAD
!-------------------------------------------------------------------------------------
!
- CALL DIAG_INLINE_WATFLUX_n(WM%DGW, WM%W, &
+ CALL DIAG_INLINE_WATFLUX_n(DGO, D, DC, W, &
PTSTEP,PTA, ZQA, PPA, PPS, PRHOA, PU, PV, PZREF, &
- PUREF, ZCD, ZCDN, ZCH, ZRI, ZHU, ZZ0H, ZQSAT, &
- PSFTH, PSFTQ, PSFU, PSFV, PDIR_SW, PSCA_SW, PLW, &
- ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTRAD, PRAIN, PSNOW, &
- ZSFTH_ICE, ZSFTQ_ICE )
+ PUREF, ZCD, ZCDN, ZCH, ZRI, ZHU, ZZ0H, ZQSAT, &
+ PSFTH, PSFTQ, PSFU, PSFV, PDIR_SW, PSCA_SW, PLW, &
+ ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTRAD, PRAIN, PSNOW, &
+ ZSFTH_ICE, ZSFTQ_ICE )
!
!-------------------------------------------------------------------------------
! IMPOSED MONTHLY TS AT TIME t+1
!-------------------------------------------------------------------------------
!
-IF (WM%W%LINTERPOL_TS.AND.MOD(WM%W%TTIME%TIME,XDAY) == 0.) THEN
- CALL INTERPOL_TS_WATER_MTH(WM%W, &
- WM%W%TTIME%TDATE%YEAR,WM%W%TTIME%TDATE%MONTH,WM%W%TTIME%TDATE%DAY,WM%W%XTS)
+IF (W%LINTERPOL_TS.AND.MOD(W%TTIME%TIME,XDAY) == 0.) THEN
+ CALL INTERPOL_TS_WATER_MTH(W)
ENDIF
!
!-------------------------------------------------------------------------------
@@ -405,8 +426,8 @@ ENDIF
!difficult to do. Maybe it will be done later. However, Ts can be at time t+1
!-------------------------------------------------------------------------------
!
-PTSURF (:) = WM%W%XTS (:)
-PZ0 (:) = WM%W%XZ0 (:)
+PTSURF (:) = W%XTS (:)
+PZ0 (:) = W%XZ0 (:)
PZ0H (:) = ZZ0H (:)
PQSURF (:) = ZQSAT(:)
!
@@ -415,8 +436,7 @@ PQSURF (:) = ZQSAT(:)
!the energy budget between surfex and the atmosphere
!-------------------------------------------------------------------------------------
!
- CALL UPDATE_RAD_WATER(WM%W%CWAT_ALB,WM%W%XTS,PZENITH2,XTT,WM%W%XEMIS,WM%W%XDIR_ALB, &
- WM%W%XSCA_ALB,PDIR_ALB,PSCA_ALB,PEMIS,PTRAD )
+ CALL UPDATE_RAD_WATER(W,PZENITH2,XTT,PDIR_ALB,PSCA_ALB,PEMIS,PTRAD )
!
!=======================================================================================
!
diff --git a/src/SURFEX/cpl_gcmn.F90 b/src/SURFEX/cpl_gcmn.F90
index 6b4cfddd09a70871c87f48933cfbf503f98eb7fa..c388cdd76c37e7539435fc4e717df69563c92ae8 100644
--- a/src/SURFEX/cpl_gcmn.F90
+++ b/src/SURFEX/cpl_gcmn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE CPL_GCM_n (U, &
- KI,PRAIN,PSNOW,PZ0,PZ0H,PQSURF)
+ SUBROUTINE CPL_GCM_n (U, KI,PRAIN,PSNOW,PZ0,PZ0H,PQSURF)
! ####################################################
!
!!**** *CPL_GCM_n* - Save some phisical fields for ARPEGE/ALADIN run
diff --git a/src/SURFEX/cumul_diag_tebn.F90 b/src/SURFEX/cumul_diag_tebn.F90
index e71ade0675bce6f1cc1d3faad4637e52a9cd0ca6..29255b712d7b341786125ca435bff66e706ce074 100644
--- a/src/SURFEX/cumul_diag_tebn.F90
+++ b/src/SURFEX/cumul_diag_tebn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!##################################
-SUBROUTINE CUMUL_DIAG_TEB_n (DGCT, DGMT, TOP, &
- PTSTEP)
+SUBROUTINE CUMUL_DIAG_TEB_n (DMTC, DMT, GDDEC, GDDE, GRDEC, GRDE, TOP, PTSTEP)
!##################################
!
!
@@ -40,10 +39,11 @@ SUBROUTINE CUMUL_DIAG_TEB_n (DGCT, DGMT, TOP, &
!* 0. DECLARATIONS
! ------------
!
-USE MODD_DIAG_CUMUL_TEB_n, ONLY : DIAG_CUMUL_TEB_t
USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_t
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
!
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -54,11 +54,16 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(DIAG_CUMUL_TEB_t), INTENT(INOUT) :: DGCT
-TYPE(DIAG_MISC_TEB_t), INTENT(INOUT) :: DGMT
+TYPE(DIAG_MISC_TEB_t), INTENT(INOUT) :: DMTC
+TYPE(DIAG_MISC_TEB_t), INTENT(INOUT) :: DMT
TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
!
- REAL, INTENT(IN) :: PTSTEP ! time step
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: GDDE
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: GDDEC
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: GRDE
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: GRDEC
+!
+REAL, INTENT(IN) :: PTSTEP ! time step
!
!* 0.2 declarations of local variables
!
@@ -74,71 +79,76 @@ IF (LHOOK) CALL DR_HOOK('CUMUL_DIAG_TEB_N',0,ZHOOK_HANDLE)
! 1. Time-cumulated diagnostics for TEB
! ----------------------------------
!
-DO JI=1,SIZE(DGMT%CUR%XRUNOFF_ROOF,1)
+DO JI=1,SIZE(DMT%XRUNOFF_ROOF,1)
!
IF (TOP%LSOLAR_PANEL) THEN
- IF (DGMT%CUR%XTHER_PROD_BLD(JI) .NE. XUNDEF) THEN
- DGCT%CUR%XTHER_PROD_BLDC(JI) = DGCT%CUR%XTHER_PROD_BLDC(JI) + DGMT%CUR%XTHER_PROD_BLD(JI) * PTSTEP
+ IF (DMT%XTHER_PROD_BLD(JI) .NE. XUNDEF) THEN
+ DMTC%XTHER_PROD_BLD(JI) = DMTC%XTHER_PROD_BLD(JI) + DMT%XTHER_PROD_BLD(JI) * PTSTEP
ENDIF
!
- IF (DGMT%CUR%XPHOT_PROD_BLD(JI) .NE. XUNDEF) THEN
- DGCT%CUR%XPHOT_PROD_BLDC(JI) = DGCT%CUR%XPHOT_PROD_BLDC(JI) + DGMT%CUR%XPHOT_PROD_BLD(JI) * PTSTEP
+ IF (DMT%XPHOT_PROD_BLD(JI) .NE. XUNDEF) THEN
+ DMTC%XPHOT_PROD_BLD(JI) = DMTC%XPHOT_PROD_BLD(JI) + DMT%XPHOT_PROD_BLD(JI) * PTSTEP
ENDIF
END IF
IF (TOP%CBEM == 'BEM') THEN
- IF (DGMT%CUR%XHVAC_COOL(JI) .NE. XUNDEF) THEN
- DGCT%CUR%XHVACC_COOL(JI) = DGCT%CUR%XHVACC_COOL(JI) + DGMT%CUR%XHVAC_COOL(JI) * PTSTEP
+ IF (DMT%XHVAC_COOL(JI) .NE. XUNDEF) THEN
+ DMTC%XHVAC_COOL(JI) = DMTC%XHVAC_COOL(JI) + DMT%XHVAC_COOL(JI) * PTSTEP
ENDIF
!
- IF (DGMT%CUR%XHVAC_HEAT(JI) .NE. XUNDEF) THEN
- DGCT%CUR%XHVACC_HEAT(JI) = DGCT%CUR%XHVACC_HEAT(JI) + DGMT%CUR%XHVAC_HEAT(JI) * PTSTEP
+ IF (DMT%XHVAC_HEAT(JI) .NE. XUNDEF) THEN
+ DMTC%XHVAC_HEAT(JI) = DMTC%XHVAC_HEAT(JI) + DMT%XHVAC_HEAT(JI) * PTSTEP
ENDIF
ENDIF
!
- IF (DGMT%CUR%XRUNOFF_TOWN(JI) .NE. XUNDEF) THEN
- DGCT%CUR%XRUNOFFC_TOWN(JI) = DGCT%CUR%XRUNOFFC_TOWN(JI) + DGMT%CUR%XRUNOFF_TOWN(JI) * PTSTEP
- ENDIF
- !
- IF (DGMT%CUR%XRUNOFF_GARDEN(JI) .NE. XUNDEF) THEN
- DGCT%CUR%XRUNOFFC_GARDEN(JI) = DGCT%CUR%XRUNOFFC_GARDEN(JI) + DGMT%CUR%XRUNOFF_GARDEN(JI) * PTSTEP
+ IF (DMT%XRUNOFF_TOWN(JI) .NE. XUNDEF) THEN
+ DMTC%XRUNOFF_TOWN(JI) = DMTC%XRUNOFF_TOWN(JI) + DMT%XRUNOFF_TOWN(JI) * PTSTEP
ENDIF
!
- IF (DGMT%CUR%XRUNOFF_ROAD(JI) .NE. XUNDEF) THEN
- DGCT%CUR%XRUNOFFC_ROAD(JI) = DGCT%CUR%XRUNOFFC_ROAD(JI) + DGMT%CUR%XRUNOFF_ROAD(JI) * PTSTEP
+ IF (DMT%XRUNOFF_ROAD(JI) .NE. XUNDEF) THEN
+ DMTC%XRUNOFF_ROAD(JI) = DMTC%XRUNOFF_ROAD(JI) + DMT%XRUNOFF_ROAD(JI) * PTSTEP
ENDIF
!
- IF (DGMT%CUR%XRUNOFF_ROOF(JI) .NE. XUNDEF) THEN
- DGCT%CUR%XRUNOFFC_ROOF(JI) = DGCT%CUR%XRUNOFFC_ROOF(JI) + DGMT%CUR%XRUNOFF_ROOF(JI) * PTSTEP
+ IF (DMT%XRUNOFF_ROOF(JI) .NE. XUNDEF) THEN
+ DMTC%XRUNOFF_ROOF(JI) = DMTC%XRUNOFF_ROOF(JI) + DMT%XRUNOFF_ROOF(JI) * PTSTEP
ENDIF
!
- IF (DGMT%CUR%XRUNOFF_STRLROOF(JI) .NE. XUNDEF) THEN
- DGCT%CUR%XRUNOFFC_STRLROOF(JI) = DGCT%CUR%XRUNOFFC_STRLROOF(JI) + DGMT%CUR%XRUNOFF_STRLROOF(JI) * PTSTEP
+ IF (DMT%XRUNOFF_STRLROOF(JI) .NE. XUNDEF) THEN
+ DMTC%XRUNOFF_STRLROOF(JI) = DMTC%XRUNOFF_STRLROOF(JI) + DMT%XRUNOFF_STRLROOF(JI) * PTSTEP
ENDIF
!
- IF (DGMT%CUR%XDRAIN_GARDEN(JI) .NE. XUNDEF) THEN
- DGCT%CUR%XDRAINC_GARDEN(JI) = DGCT%CUR%XDRAINC_GARDEN(JI) + DGMT%CUR%XDRAIN_GARDEN(JI) * PTSTEP
+ IF (DMT%XIRRIG_ROAD(JI) .NE. XUNDEF) THEN
+ DMTC%XIRRIG_ROAD(JI) = DMTC%XIRRIG_ROAD(JI) + DMT%XIRRIG_ROAD(JI) * PTSTEP
ENDIF
!
- IF (DGMT%CUR%XIRRIG_GARDEN(JI) .NE. XUNDEF) THEN
- DGCT%CUR%XIRRIGC_GARDEN(JI) = DGCT%CUR%XIRRIGC_GARDEN(JI) + DGMT%CUR%XIRRIG_GARDEN(JI) * PTSTEP
+ IF (TOP%LGARDEN) THEN
+ !
+ IF (GDDE%XRUNOFF(JI) .NE. XUNDEF) THEN
+ GDDEC%XRUNOFF(JI) = GDDEC%XRUNOFF(JI) + GDDE%XRUNOFF(JI) * PTSTEP
+ ENDIF
+ !
+ IF (GDDE%XDRAIN(JI) .NE. XUNDEF) THEN
+ GDDEC%XDRAIN(JI) = GDDEC%XDRAIN(JI) + GDDE%XDRAIN(JI) * PTSTEP
+ ENDIF
+ !
+ IF (DMT%XIRRIG_GARDEN(JI) .NE. XUNDEF) THEN
+ DMTC%XIRRIG_GARDEN(JI) = DMTC%XIRRIG_GARDEN(JI) + DMT%XIRRIG_GARDEN(JI) * PTSTEP
+ ENDIF
+ !
ENDIF
- !
- IF (DGMT%CUR%XIRRIG_ROAD(JI) .NE. XUNDEF) THEN
- DGCT%CUR%XIRRIGC_ROAD(JI) = DGCT%CUR%XIRRIGC_ROAD(JI) + DGMT%CUR%XIRRIG_ROAD(JI) * PTSTEP
- ENDIF
- !
+ !
IF (TOP%LGREENROOF) THEN
- IF (DGMT%CUR%XRUNOFF_GREENROOF(JI) .NE. XUNDEF) THEN
- DGCT%CUR%XRUNOFFC_GREENROOF(JI) = DGCT%CUR%XRUNOFFC_GREENROOF(JI)+ DGMT%CUR%XRUNOFF_GREENROOF(JI) * PTSTEP
+
+ IF (GRDE%XRUNOFF(JI) .NE. XUNDEF) THEN
+ GRDEC%XRUNOFF(JI) = GRDEC%XRUNOFF(JI)+ GRDE%XRUNOFF(JI) * PTSTEP
ENDIF
!
- IF (DGMT%CUR%XDRAIN_GREENROOF(JI) .NE. XUNDEF) THEN
- DGCT%CUR%XDRAINC_GREENROOF(JI) = DGCT%CUR%XDRAINC_GREENROOF(JI) + DGMT%CUR%XDRAIN_GREENROOF(JI) * PTSTEP
+ IF (GRDE%XDRAIN(JI) .NE. XUNDEF) THEN
+ GRDEC%XDRAIN(JI) = GRDEC%XDRAIN(JI) + GRDE%XDRAIN(JI) * PTSTEP
ENDIF
!
- IF (DGMT%CUR%XIRRIG_GREENROOF(JI) .NE. XUNDEF) THEN
- DGCT%CUR%XIRRIGC_GREENROOF(JI) = DGCT%CUR%XIRRIGC_GREENROOF(JI) + DGMT%CUR%XIRRIG_GREENROOF(JI) * PTSTEP
+ IF (DMT%XIRRIG_GREENROOF(JI) .NE. XUNDEF) THEN
+ DMTC%XIRRIG_GREENROOF(JI) = DMTC%XIRRIG_GREENROOF(JI) + DMT%XIRRIG_GREENROOF(JI) * PTSTEP
ENDIF
ENDIF
!
diff --git a/src/SURFEX/dealloc_diag_surf_atmn.F90 b/src/SURFEX/dealloc_diag_surf_atmn.F90
index 857b72a6c5df4a5a7950dcf3bc53b5771a7fdc79..2c02b44ac4e20ee02ce18322c8652ab5f4d1e14b 100644
--- a/src/SURFEX/dealloc_diag_surf_atmn.F90
+++ b/src/SURFEX/dealloc_diag_surf_atmn.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #############################################################
- SUBROUTINE DEALLOC_DIAG_SURF_ATM_n (DGU)
+ SUBROUTINE DEALLOC_DIAG_SURF_ATM_n (D,DC,ND,NDC)
! #############################################################
!
!! AUTHOR
@@ -21,8 +21,9 @@
! ------------
!
!
+USE MODD_DATA_COVER_PAR, ONLY : NTILESFC
!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_NP_t
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -40,100 +41,110 @@ IMPLICIT NONE
!
!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
+TYPE(DIAG_NP_t), INTENT(INOUT) :: ND
+TYPE(DIAG_NP_t), INTENT(INOUT) :: NDC
!
+INTEGER :: JT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('DEALLOC_DIAG_SURF_ATM_N',0,ZHOOK_HANDLE)
-DEALLOCATE(DGU%XRI_TILE )
-DEALLOCATE(DGU%XCD_TILE )
-DEALLOCATE(DGU%XCH_TILE )
-DEALLOCATE(DGU%XCE_TILE )
-DEALLOCATE(DGU%XQS_TILE )
-DEALLOCATE(DGU%XZ0_TILE )
-DEALLOCATE(DGU%XZ0H_TILE )
-DEALLOCATE(DGU%XRN_TILE )
-DEALLOCATE(DGU%XH_TILE )
-DEALLOCATE(DGU%XLE_TILE )
-DEALLOCATE(DGU%XLEI_TILE )
-DEALLOCATE(DGU%XGFLUX_TILE )
-DEALLOCATE(DGU%XEVAP_TILE )
-DEALLOCATE(DGU%XSUBL_TILE )
-DEALLOCATE(DGU%XT2M_TILE )
-DEALLOCATE(DGU%XTS_TILE )
-DEALLOCATE(DGU%XT2M_MIN_TILE)
-DEALLOCATE(DGU%XT2M_MAX_TILE)
-DEALLOCATE(DGU%XQ2M_TILE )
-DEALLOCATE(DGU%XHU2M_TILE )
-DEALLOCATE(DGU%XZON10M_TILE )
-DEALLOCATE(DGU%XMER10M_TILE )
-DEALLOCATE(DGU%XDIAG_TRAD )
-DEALLOCATE(DGU%XDIAG_EMIS )
-!
-DEALLOCATE(DGU%XAVG_RI )
-DEALLOCATE(DGU%XAVG_CD )
-DEALLOCATE(DGU%XAVG_CH )
-DEALLOCATE(DGU%XAVG_CE )
-DEALLOCATE(DGU%XAVG_Z0 )
-DEALLOCATE(DGU%XAVG_Z0H )
-DEALLOCATE(DGU%XAVG_RN )
-DEALLOCATE(DGU%XAVG_H )
-DEALLOCATE(DGU%XAVG_LE )
-DEALLOCATE(DGU%XAVG_LEI )
-DEALLOCATE(DGU%XAVG_GFLUX )
-DEALLOCATE(DGU%XAVG_EVAP )
-DEALLOCATE(DGU%XAVG_SUBL )
-DEALLOCATE(DGU%XAVG_T2M )
-DEALLOCATE(DGU%XAVG_TS )
-DEALLOCATE(DGU%XAVG_T2M_MIN)
-DEALLOCATE(DGU%XAVG_T2M_MAX)
-DEALLOCATE(DGU%XAVG_Q2M )
-DEALLOCATE(DGU%XAVG_HU2M )
-DEALLOCATE(DGU%XAVG_ZON10M )
-DEALLOCATE(DGU%XAVG_MER10M )
-DEALLOCATE(DGU%XAVG_SFCO2 )
-DEALLOCATE(DGU%XAVG_T2M_MIN_ZS )
-DEALLOCATE(DGU%XAVG_Q2M_MIN_ZS )
-DEALLOCATE(DGU%XAVG_HU2M_MIN_ZS )
-DEALLOCATE(DGU%XPS )
-DEALLOCATE(DGU%XRHOA )
-!
-DEALLOCATE(DGU%XRNC_TILE )
-DEALLOCATE(DGU%XHC_TILE )
-DEALLOCATE(DGU%XLEC_TILE )
-DEALLOCATE(DGU%XLEIC_TILE )
-DEALLOCATE(DGU%XGFLUXC_TILE )
-DEALLOCATE(DGU%XEVAPC_TILE )
-DEALLOCATE(DGU%XSUBLC_TILE )
-DEALLOCATE(DGU%XSWDC_TILE )
-DEALLOCATE(DGU%XSWUC_TILE )
-DEALLOCATE(DGU%XLWDC_TILE )
-DEALLOCATE(DGU%XLWUC_TILE )
-DEALLOCATE(DGU%XFMUC_TILE )
-DEALLOCATE(DGU%XFMVC_TILE )
-!
-DEALLOCATE(DGU%XAVG_RNC )
-DEALLOCATE(DGU%XAVG_HC )
-DEALLOCATE(DGU%XAVG_LEC )
-DEALLOCATE(DGU%XAVG_LEIC )
-DEALLOCATE(DGU%XAVG_GFLUXC )
-DEALLOCATE(DGU%XAVG_EVAPC )
-DEALLOCATE(DGU%XAVG_SUBLC )
-DEALLOCATE(DGU%XAVG_SWDC )
-DEALLOCATE(DGU%XAVG_SWUC )
-DEALLOCATE(DGU%XAVG_LWDC )
-DEALLOCATE(DGU%XAVG_LWUC )
-DEALLOCATE(DGU%XAVG_FMUC )
-DEALLOCATE(DGU%XAVG_FMVC )
-!
-DEALLOCATE(DGU%XHU2M_MIN_TILE )
-DEALLOCATE(DGU%XAVG_HU2M_MIN )
-DEALLOCATE(DGU%XHU2M_MAX_TILE )
-DEALLOCATE(DGU%XAVG_HU2M_MAX )
-DEALLOCATE(DGU%XWIND10M_TILE )
-DEALLOCATE(DGU%XAVG_WIND10M )
-DEALLOCATE(DGU%XWIND10M_MAX_TILE )
-DEALLOCATE(DGU%XAVG_WIND10M_MAX )
+DO JT=1,NTILESFC
+ DEALLOCATE(ND%AL(JT)%XRI )
+ DEALLOCATE(ND%AL(JT)%XCD )
+ DEALLOCATE(ND%AL(JT)%XCH )
+ DEALLOCATE(ND%AL(JT)%XCE )
+ DEALLOCATE(ND%AL(JT)%XQS )
+ DEALLOCATE(ND%AL(JT)%XZ0 )
+ DEALLOCATE(ND%AL(JT)%XZ0H )
+ DEALLOCATE(ND%AL(JT)%XRN )
+ DEALLOCATE(ND%AL(JT)%XH )
+ DEALLOCATE(ND%AL(JT)%XLE )
+ DEALLOCATE(ND%AL(JT)%XLEI )
+ DEALLOCATE(ND%AL(JT)%XGFLUX )
+ DEALLOCATE(ND%AL(JT)%XEVAP )
+ DEALLOCATE(ND%AL(JT)%XSUBL )
+ DEALLOCATE(ND%AL(JT)%XT2M )
+ DEALLOCATE(ND%AL(JT)%XTS )
+ DEALLOCATE(ND%AL(JT)%XT2M_MIN)
+ DEALLOCATE(ND%AL(JT)%XT2M_MAX)
+ DEALLOCATE(ND%AL(JT)%XQ2M )
+ DEALLOCATE(ND%AL(JT)%XHU2M )
+ DEALLOCATE(ND%AL(JT)%XZON10M )
+ DEALLOCATE(ND%AL(JT)%XMER10M )
+ !
+ DEALLOCATE(ND%AL(JT)%XHU2M_MIN )
+ DEALLOCATE(ND%AL(JT)%XHU2M_MAX )
+ DEALLOCATE(ND%AL(JT)%XWIND10M )
+ DEALLOCATE(ND%AL(JT)%XWIND10M_MAX )
+ !
+ DEALLOCATE(NDC%AL(JT)%XRN )
+ DEALLOCATE(NDC%AL(JT)%XH )
+ DEALLOCATE(NDC%AL(JT)%XLE )
+ DEALLOCATE(NDC%AL(JT)%XLEI )
+ DEALLOCATE(NDC%AL(JT)%XGFLUX )
+ DEALLOCATE(NDC%AL(JT)%XEVAP )
+ DEALLOCATE(NDC%AL(JT)%XSUBL )
+ DEALLOCATE(NDC%AL(JT)%XSWD )
+ DEALLOCATE(NDC%AL(JT)%XSWU )
+ DEALLOCATE(NDC%AL(JT)%XLWD )
+ DEALLOCATE(NDC%AL(JT)%XLWU )
+ DEALLOCATE(NDC%AL(JT)%XFMU )
+ DEALLOCATE(NDC%AL(JT)%XFMV )
+ !
+ENDDO
+!
+DEALLOCATE(D%XTRAD )
+DEALLOCATE(D%XEMIS )
+!
+DEALLOCATE(D%XRI )
+DEALLOCATE(D%XCD )
+DEALLOCATE(D%XCH )
+DEALLOCATE(D%XCE )
+DEALLOCATE(D%XZ0 )
+DEALLOCATE(D%XZ0H )
+DEALLOCATE(D%XRN )
+DEALLOCATE(D%XH )
+DEALLOCATE(D%XLE )
+DEALLOCATE(D%XLEI )
+DEALLOCATE(D%XGFLUX )
+DEALLOCATE(D%XEVAP )
+DEALLOCATE(D%XSUBL )
+DEALLOCATE(D%XT2M )
+DEALLOCATE(D%XTS )
+DEALLOCATE(D%XT2M_MIN)
+DEALLOCATE(D%XT2M_MAX)
+DEALLOCATE(D%XQ2M )
+DEALLOCATE(D%XHU2M )
+DEALLOCATE(D%XZON10M )
+DEALLOCATE(D%XMER10M )
+DEALLOCATE(D%XSFCO2 )
+DEALLOCATE(D%XT2M_MIN_ZS )
+DEALLOCATE(D%XQ2M_MIN_ZS )
+DEALLOCATE(D%XHU2M_MIN_ZS )
+DEALLOCATE(D%XPS )
+DEALLOCATE(D%XRHOA )
+!
+DEALLOCATE(D%XHU2M_MIN )
+DEALLOCATE(D%XHU2M_MAX )
+DEALLOCATE(D%XWIND10M )
+DEALLOCATE(D%XWIND10M_MAX )
+!
+DEALLOCATE(DC%XRN )
+DEALLOCATE(DC%XH )
+DEALLOCATE(DC%XLE )
+DEALLOCATE(DC%XLEI )
+DEALLOCATE(DC%XGFLUX )
+DEALLOCATE(DC%XEVAP )
+DEALLOCATE(DC%XSUBL )
+DEALLOCATE(DC%XSWD )
+DEALLOCATE(DC%XSWU )
+DEALLOCATE(DC%XLWD )
+DEALLOCATE(DC%XLWU )
+DEALLOCATE(DC%XFMU )
+DEALLOCATE(DC%XFMV )
+!
IF (LHOOK) CALL DR_HOOK('DEALLOC_DIAG_SURF_ATM_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/dealloc_flaken.F90 b/src/SURFEX/dealloc_flaken.F90
index 3c139cf9214310c151aae3a5e3c3bf40398fcd65..73ccc8481199f921d29d2e2afd58788d0fc9974a 100644
--- a/src/SURFEX/dealloc_flaken.F90
+++ b/src/SURFEX/dealloc_flaken.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #################################################################################
-SUBROUTINE DEALLOC_FLAKE_n (CHF, FG, F)
+SUBROUTINE DEALLOC_FLAKE_n (FM)
! #################################################################################
!
!!**** *DEALLOC_FLAKE_n * - Deallocate all arrays
@@ -28,15 +28,16 @@ SUBROUTINE DEALLOC_FLAKE_n (CHF, FG, F)
!! Modified 04/2013, P. Le Moigne: FLake chemistry and XZ0
!!------------------------------------------------------------------
!
-
+USE MODD_SURFEX_n, ONLY : FLAKE_MODEL_t
!
-
-
+USE MODD_CH_FLAKE_n, ONLY : CH_FLAKE_INIT
+USE MODD_FLAKE_n, ONLY : FLAKE_INIT
!
+USE MODD_SFX_GRID_n, ONLY : GRID_INIT
+USE MODD_CANOPY_n, ONLY : CANOPY_INIT
!
-USE MODD_CH_FLAKE_n, ONLY : CH_FLAKE_t
-USE MODD_FLAKE_GRID_n, ONLY : FLAKE_GRID_t
-USE MODD_FLAKE_n, ONLY : FLAKE_t
+USE MODD_DIAG_n, ONLY : DIAG_INIT, DIAG_OPTIONS_INIT
+USE MODD_DIAG_MISC_FLAKE_n, ONLY : DIAG_MISC_FLAKE_INIT
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -45,62 +46,25 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(FLAKE_MODEL_t), INTENT(INOUT) :: FM
!
!* 0.2 declarations of local variables
!
-!-------------------------------------------------------------------------------------
-!
-
-!
-TYPE(CH_FLAKE_t), INTENT(INOUT) :: CHF
-TYPE(FLAKE_GRID_t), INTENT(INOUT) :: FG
-TYPE(FLAKE_t), INTENT(INOUT) :: F
-!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
-IF (LHOOK) CALL DR_HOOK('DEALLOC_FLAKE_N',0,ZHOOK_HANDLE)
-IF (ASSOCIATED(F%LCOVER )) DEALLOCATE(F%LCOVER )
-IF (ASSOCIATED(F%XCOVER )) DEALLOCATE(F%XCOVER )
-IF (ASSOCIATED(F%XZS )) DEALLOCATE(F%XZS )
-IF (ASSOCIATED(F%XEMIS )) DEALLOCATE(F%XEMIS )
-IF (ASSOCIATED(F%XWATER_DEPTH )) DEALLOCATE(F%XWATER_DEPTH )
-IF (ASSOCIATED(F%XWATER_FETCH )) DEALLOCATE(F%XWATER_FETCH )
-IF (ASSOCIATED(F%XT_BS )) DEALLOCATE(F%XT_BS )
-IF (ASSOCIATED(F%XDEPTH_BS )) DEALLOCATE(F%XDEPTH_BS )
-IF (ASSOCIATED(F%XCORIO )) DEALLOCATE(F%XCORIO )
-IF (ASSOCIATED(F%XDIR_ALB )) DEALLOCATE(F%XDIR_ALB )
-IF (ASSOCIATED(F%XSCA_ALB )) DEALLOCATE(F%XSCA_ALB )
-IF (ASSOCIATED(F%XICE_ALB )) DEALLOCATE(F%XICE_ALB )
-IF (ASSOCIATED(F%XSNOW_ALB )) DEALLOCATE(F%XSNOW_ALB )
-IF (ASSOCIATED(F%XEXTCOEF_WATER)) DEALLOCATE(F%XEXTCOEF_WATER)
-IF (ASSOCIATED(F%XEXTCOEF_ICE )) DEALLOCATE(F%XEXTCOEF_ICE )
-IF (ASSOCIATED(F%XEXTCOEF_SNOW )) DEALLOCATE(F%XEXTCOEF_SNOW )
-IF (ASSOCIATED(F%XT_SNOW )) DEALLOCATE(F%XT_SNOW )
-IF (ASSOCIATED(F%XT_ICE )) DEALLOCATE(F%XT_ICE )
-IF (ASSOCIATED(F%XT_MNW )) DEALLOCATE(F%XT_MNW )
-IF (ASSOCIATED(F%XT_WML )) DEALLOCATE(F%XT_WML )
-IF (ASSOCIATED(F%XT_BOT )) DEALLOCATE(F%XT_BOT )
-IF (ASSOCIATED(F%XT_B1 )) DEALLOCATE(F%XT_B1 )
-IF (ASSOCIATED(F%XCT )) DEALLOCATE(F%XCT )
-IF (ASSOCIATED(F%XH_SNOW )) DEALLOCATE(F%XH_SNOW )
-IF (ASSOCIATED(F%XH_ICE )) DEALLOCATE(F%XH_ICE )
-IF (ASSOCIATED(F%XH_ML )) DEALLOCATE(F%XH_ML )
-IF (ASSOCIATED(F%XH_B1 )) DEALLOCATE(F%XH_B1 )
-IF (ASSOCIATED(F%XTS )) DEALLOCATE(F%XTS )
-IF (ASSOCIATED(F%XZ0 )) DEALLOCATE(F%XZ0 )
-!
!-------------------------------------------------------------------------------------
!
-IF (ASSOCIATED(FG%XGRID_PAR )) DEALLOCATE(FG%XGRID_PAR )
-IF (ASSOCIATED(FG%XLAT )) DEALLOCATE(FG%XLAT )
-IF (ASSOCIATED(FG%XLON )) DEALLOCATE(FG%XLON )
-IF (ASSOCIATED(FG%XMESH_SIZE)) DEALLOCATE(FG%XMESH_SIZE)
+IF (LHOOK) CALL DR_HOOK('DEALLOC_FLAKE_N',0,ZHOOK_HANDLE)
!
-!-------------------------------------------------------------------------------------
+CALL DIAG_OPTIONS_INIT(FM%DFO)
+CALL DIAG_INIT(FM%DF)
+CALL DIAG_INIT(FM%DFC)
+CALL DIAG_MISC_FLAKE_INIT(FM%DMF)
+!
+CALL GRID_INIT(FM%G)
+CALL CANOPY_INIT(FM%SB)
+CALL CH_FLAKE_INIT(FM%CHF)
+CALL FLAKE_INIT(FM%F)
!
-IF(ASSOCIATED(CHF%XDEP)) DEALLOCATE(CHF%XDEP)
-IF(ASSOCIATED(CHF%CCH_NAMES)) DEALLOCATE(CHF%CCH_NAMES)
-IF(ASSOCIATED(CHF%SVF%CSV)) DEALLOCATE(CHF%SVF%CSV)
IF (LHOOK) CALL DR_HOOK('DEALLOC_FLAKE_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/dealloc_gr_snow.F90 b/src/SURFEX/dealloc_gr_snow.F90
new file mode 100644
index 0000000000000000000000000000000000000000..609739e6ceb3ff84e5d7d5749fcbc60abb8a2722
--- /dev/null
+++ b/src/SURFEX/dealloc_gr_snow.F90
@@ -0,0 +1,81 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE DEALLOC_GR_SNOW(TPSNOW)
+! ##############################################
+!
+!!**** *DEALLOC_GR_SNOW* -
+!!
+!! PURPOSE
+!! -------
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!! TPSNOW%SCHEME must yet be initialized
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 2
+!!
+!! AUTHOR
+!! ------
+!!
+!! S.Faroux Meteo-France
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 14/01/15
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_TYPE_SNOW
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+TYPE(SURF_SNOW), INTENT(INOUT) :: TPSNOW
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('DEALLOC_GR_SNOW',0,ZHOOK_HANDLE)
+!
+DEALLOCATE(TPSNOW%WSNOW)
+DEALLOCATE(TPSNOW%RHO)
+DEALLOCATE(TPSNOW%ALB)
+DEALLOCATE(TPSNOW%EMIS)
+DEALLOCATE(TPSNOW%TS )
+DEALLOCATE(TPSNOW%TEMP)
+DEALLOCATE(TPSNOW%HEAT)
+DEALLOCATE(TPSNOW%GRAN1)
+DEALLOCATE(TPSNOW%GRAN2)
+DEALLOCATE(TPSNOW%HIST )
+DEALLOCATE(TPSNOW%AGE )
+DEALLOCATE(TPSNOW%T)
+!
+IF (LHOOK) CALL DR_HOOK('DEALLOC_GR_SNOW',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------
+END SUBROUTINE DEALLOC_GR_SNOW
diff --git a/src/SURFEX/dealloc_inland_watern.F90 b/src/SURFEX/dealloc_inland_watern.F90
index 228957b856892826e15cf0048aa31ae4128fec53..94a86cea8f03a1268a9c44235b846f0faabcb807 100644
--- a/src/SURFEX/dealloc_inland_watern.F90
+++ b/src/SURFEX/dealloc_inland_watern.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE DEALLOC_INLAND_WATER_n (CHF, CHW, FG, F, U, WG, W)
+SUBROUTINE DEALLOC_INLAND_WATER_n ( WM, FM, U)
! ###############################################################################
!
!!**** *DEALLOC_INLAND_WATER_n * - Deallocate all arrays
@@ -28,18 +28,9 @@ SUBROUTINE DEALLOC_INLAND_WATER_n (CHF, CHW, FG, F, U, WG, W)
!!------------------------------------------------------------------
!
!
+USE MODD_SURFEX_n, ONLY : FLAKE_MODEL_t, WATFLUX_MODEL_t
!
-!
-!
-!
-!
-USE MODD_CH_FLAKE_n, ONLY : CH_FLAKE_t
-USE MODD_CH_WATFLUX_n, ONLY : CH_WATFLUX_t
-USE MODD_FLAKE_GRID_n, ONLY : FLAKE_GRID_t
-USE MODD_FLAKE_n, ONLY : FLAKE_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_WATFLUX_GRID_n, ONLY : WATFLUX_GRID_t
-USE MODD_WATFLUX_n, ONLY : WATFLUX_t
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -59,23 +50,17 @@ IMPLICIT NONE
!
!-------------------------------------------------------------------------------------
!
-
-!
-TYPE(CH_FLAKE_t), INTENT(INOUT) :: CHF
-TYPE(CH_WATFLUX_t), INTENT(INOUT) :: CHW
-TYPE(FLAKE_GRID_t), INTENT(INOUT) :: FG
-TYPE(FLAKE_t), INTENT(INOUT) :: F
+TYPE(WATFLUX_MODEL_t), INTENT(INOUT) :: WM
+TYPE(FLAKE_MODEL_t), INTENT(INOUT) :: FM
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(WATFLUX_GRID_t), INTENT(INOUT) :: WG
-TYPE(WATFLUX_t), INTENT(INOUT) :: W
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('DEALLOC_INLAND_WATER_N',0,ZHOOK_HANDLE)
IF (U%CWATER=='WATFLX') THEN
- CALL DEALLOC_WATFLUX_n(CHW, WG, W)
+ CALL DEALLOC_WATFLUX_n(WM)
ELSE IF (U%CWATER=='FLAKE ') THEN
- CALL DEALLOC_FLAKE_n(CHF, FG, F)
+ CALL DEALLOC_FLAKE_n(FM)
ELSE IF (U%CWATER=='FLUX ') THEN
CALL DEALLOC_IDEAL_FLUX
END IF
diff --git a/src/SURFEX/dealloc_isban.F90 b/src/SURFEX/dealloc_isban.F90
index 864f63a51a5eda5c9b1716af93f1a703d5d67197..7eba618da3659d13cd73c6f3d9e3858e4c5dfcda 100644
--- a/src/SURFEX/dealloc_isban.F90
+++ b/src/SURFEX/dealloc_isban.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #################################################################################
-SUBROUTINE DEALLOC_ISBA_n (CHI, DTI, GB, IG, I)
+SUBROUTINE DEALLOC_ISBA_n (IM)
! #################################################################################
!
!!**** *DEALLOC_ISBA_n * - Deallocate all arrays
@@ -28,12 +28,24 @@ SUBROUTINE DEALLOC_ISBA_n (CHI, DTI, GB, IG, I)
!! P Samuelsson 10/2014 MEB
!!------------------------------------------------------------------
!
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_INIT
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_INIT
+USE MODD_ISBA_n, ONLY : ISBA_S_INIT, ISBA_K_INIT, ISBA_NK_INIT, ISBA_NP_INIT, ISBA_NPE_INIT
+USE MODD_SSO_n, ONLY : SSO_INIT, SSO_NP_INIT
+USE MODD_SFX_GRID_n, ONLY : GRID_INIT, GRID_NP_INIT
+USE MODD_CH_ISBA_n, ONLY : CH_ISBA_INIT, CH_ISBA_NP_INIT
!
-USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_DIAG_n, ONLY : DIAG_INIT, DIAG_NP_INIT, DIAG_OPTIONS_INIT
+!
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_INIT, DIAG_EVAP_ISBA_NP_INIT
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_INIT, DIAG_MISC_ISBA_NP_INIT
+!
+USE MODD_AGRI_n, ONLY : AGRI_NP_INIT
+USE MODD_SFX_GRID_n, ONLY : GRID_INIT, GRID_NP_INIT
+USE MODD_CANOPY_n, ONLY : CANOPY_INIT
+USE MODD_GR_BIOG_n, ONLY : GR_BIOG_INIT, GR_BIOG_NP_INIT
+!
+USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -47,228 +59,43 @@ IMPLICIT NONE
!
!-------------------------------------------------------------------------------------
!
-
-!
-TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(GR_BIOG_t), INTENT(INOUT) :: GB
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('DEALLOC_ISBA_N',0,ZHOOK_HANDLE)
-IF (ASSOCIATED(I%LCOVER )) DEALLOCATE(I%LCOVER )
-IF (ASSOCIATED(I%XCOVER )) DEALLOCATE(I%XCOVER )
-IF (ASSOCIATED(I%XZS )) DEALLOCATE(I%XZS )
-IF (ASSOCIATED(I%XZ0EFFJPDIR)) DEALLOCATE(I%XZ0EFFJPDIR)
-IF (ASSOCIATED(I%XCLAY )) DEALLOCATE(I%XCLAY )
-IF (ASSOCIATED(I%XSAND )) DEALLOCATE(I%XSAND )
-IF (ASSOCIATED(I%XSOC )) DEALLOCATE(I%XSOC )
-IF (ASSOCIATED(I%XRUNOFFB )) DEALLOCATE(I%XRUNOFFB)
-!
-IF (ASSOCIATED(I%XAOSIP)) DEALLOCATE( I%XAOSIP)
-IF (ASSOCIATED(I%XAOSIM)) DEALLOCATE( I%XAOSIM)
-IF (ASSOCIATED(I%XAOSJP)) DEALLOCATE( I%XAOSJP)
-IF (ASSOCIATED(I%XAOSJM)) DEALLOCATE( I%XAOSJM)
-IF (ASSOCIATED(I%XHO2IP)) DEALLOCATE( I%XHO2IP)
-IF (ASSOCIATED(I%XHO2IM)) DEALLOCATE( I%XHO2IM)
-IF (ASSOCIATED(I%XHO2JP)) DEALLOCATE( I%XHO2JP)
-IF (ASSOCIATED(I%XHO2JM)) DEALLOCATE( I%XHO2JM)
-IF (ASSOCIATED(I%XZ0EFFIP)) DEALLOCATE( I%XZ0EFFIP)
-IF (ASSOCIATED(I%XZ0EFFIM)) DEALLOCATE( I%XZ0EFFIM)
-IF (ASSOCIATED(I%XZ0EFFJP)) DEALLOCATE( I%XZ0EFFJP)
-IF (ASSOCIATED(I%XZ0EFFJM)) DEALLOCATE( I%XZ0EFFJM)
-IF (ASSOCIATED(I%XZ0REL)) DEALLOCATE( I%XZ0REL)
-IF (ASSOCIATED(I%XSSO_SLOPE)) DEALLOCATE( I%XSSO_SLOPE)
-!
-!-------------------------------------------------------------------------------------
-!
-IF (ASSOCIATED(IG%XGRID_PAR )) DEALLOCATE(IG%XGRID_PAR )
-IF (ASSOCIATED(IG%XLAT )) DEALLOCATE(IG%XLAT )
-IF (ASSOCIATED(IG%XLON )) DEALLOCATE(IG%XLON )
-IF (ASSOCIATED(IG%XMESH_SIZE)) DEALLOCATE(IG%XMESH_SIZE)
-!
-!-------------------------------------------------------------------------------------
-!
-IF (ASSOCIATED(GB%XMONOPOT)) DEALLOCATE(GB%XMONOPOT)
-IF (ASSOCIATED(GB%XISOPOT)) DEALLOCATE(GB%XISOPOT)
-!
-!-------------------------------------------------------------------------------------
-!
-IF (ASSOCIATED(I%XLAI )) DEALLOCATE(I%XLAI )
-IF (ASSOCIATED(I%XVEG )) DEALLOCATE(I%XVEG )
-IF (ASSOCIATED(I%XRSMIN )) DEALLOCATE(I%XRSMIN )
-IF (ASSOCIATED(I%XGAMMA )) DEALLOCATE(I%XGAMMA )
-IF (ASSOCIATED(I%XWRMAX_CF )) DEALLOCATE(I%XWRMAX_CF )
-IF (ASSOCIATED(I%XRGL )) DEALLOCATE(I%XRGL )
-IF (ASSOCIATED(I%XCV )) DEALLOCATE(I%XCV )
-IF (ASSOCIATED(I%XDG )) DEALLOCATE(I%XDG )
-IF (ASSOCIATED(I%XDZG )) DEALLOCATE(I%XDZG )
-IF (ASSOCIATED(I%XDZDIF )) DEALLOCATE(I%XDZDIF )
-IF (ASSOCIATED(I%XDG_OLD )) DEALLOCATE(I%XDG_OLD )
-IF (ASSOCIATED(I%NWG_LAYER )) DEALLOCATE(I%NWG_LAYER )
-IF (ASSOCIATED(I%XDROOT )) DEALLOCATE(I%XDROOT )
-IF (ASSOCIATED(I%XDG2 )) DEALLOCATE(I%XDG2 )
-IF (ASSOCIATED(I%XROOTFRAC )) DEALLOCATE(I%XROOTFRAC )
-IF (ASSOCIATED(I%XZ0 )) DEALLOCATE(I%XZ0 )
-IF (ASSOCIATED(I%XZ0_O_Z0H )) DEALLOCATE(I%XZ0_O_Z0H )
-IF (ASSOCIATED(I%XALBNIR_VEG)) DEALLOCATE(I%XALBNIR_VEG)
-IF (ASSOCIATED(I%XALBVIS_VEG)) DEALLOCATE(I%XALBVIS_VEG)
-IF (ASSOCIATED(I%XALBUV_VEG )) DEALLOCATE(I%XALBUV_VEG )
-IF (ASSOCIATED(I%XEMIS )) DEALLOCATE(I%XEMIS )
-IF (ASSOCIATED(I%XVEGTYPE )) DEALLOCATE(I%XVEGTYPE )
-IF (ASSOCIATED(I%XGMES )) DEALLOCATE(I%XGMES )
-IF (ASSOCIATED(I%XRE25 )) DEALLOCATE(I%XRE25 )
-IF (ASSOCIATED(I%XBSLAI )) DEALLOCATE(I%XBSLAI )
-IF (ASSOCIATED(I%XLAIMIN )) DEALLOCATE(I%XLAIMIN )
-IF (ASSOCIATED(I%XSEFOLD )) DEALLOCATE(I%XSEFOLD )
-IF (ASSOCIATED(I%XGC )) DEALLOCATE(I%XGC )
-IF (ASSOCIATED(I%XDMAX )) DEALLOCATE(I%XDMAX )
-IF (ASSOCIATED(I%XF2I )) DEALLOCATE(I%XF2I )
-IF (ASSOCIATED(I%LSTRESS )) DEALLOCATE(I%LSTRESS )
-IF (ASSOCIATED(I%XH_TREE )) DEALLOCATE(I%XH_TREE )
-IF (ASSOCIATED(I%XCE_NITRO )) DEALLOCATE(I%XCE_NITRO )
-IF (ASSOCIATED(I%XCF_NITRO )) DEALLOCATE(I%XCF_NITRO )
-IF (ASSOCIATED(I%XCNA_NITRO )) DEALLOCATE(I%XCNA_NITRO )
-IF (ASSOCIATED(I%XBSLAI_NITRO)) DEALLOCATE(I%XBSLAI_NITRO)
-IF (ASSOCIATED(I%XPATCH )) DEALLOCATE(I%XPATCH )
-IF (ASSOCIATED(I%XVEGTYPE_PATCH)) DEALLOCATE(I%XVEGTYPE_PATCH)
-IF (ASSOCIATED(I%XPATCH_OLD )) DEALLOCATE(I%XPATCH_OLD )
-IF (ASSOCIATED(I%NSIZE_NATURE_P)) DEALLOCATE(I%NSIZE_NATURE_P)
-IF (ASSOCIATED(I%NR_NATURE_P)) DEALLOCATE(I%NR_NATURE_P)
-IF (ASSOCIATED(I%XWDRAIN)) DEALLOCATE(I%XWDRAIN)
-IF (ASSOCIATED(I%XTDEEP )) DEALLOCATE(I%XTDEEP )
-IF (ASSOCIATED(I%XGAMMAT)) DEALLOCATE(I%XGAMMAT)
-IF (ASSOCIATED(I%XWWILT)) DEALLOCATE(I%XWWILT)
-IF (ASSOCIATED(I%XWFC )) DEALLOCATE(I%XWFC )
-IF (ASSOCIATED(I%XWSAT )) DEALLOCATE(I%XWSAT )
-IF (ASSOCIATED(I%XWD0)) DEALLOCATE(I%XWD0)
-IF (ASSOCIATED(I%XKANISO)) DEALLOCATE(I%XKANISO)
-IF (ASSOCIATED(I%XTAUICE)) DEALLOCATE(I%XTAUICE)
-IF (ASSOCIATED(I%XBCOEF)) DEALLOCATE(I%XBCOEF)
-IF (ASSOCIATED(I%XRUNOFFD)) DEALLOCATE(I%XRUNOFFD)
-IF (ASSOCIATED(I%XSOILWGHT)) DEALLOCATE(I%XSOILWGHT)
-IF (ASSOCIATED(I%XHCAPSOIL)) DEALLOCATE(I%XHCAPSOIL)
-IF (ASSOCIATED(I%XCONDDRY )) DEALLOCATE(I%XCONDDRY )
-IF (ASSOCIATED(I%XCONDSLD )) DEALLOCATE(I%XCONDSLD )
-IF (ASSOCIATED(I%XCGSAT )) DEALLOCATE(I%XCGSAT )
-IF (ASSOCIATED(I%XC1SAT)) DEALLOCATE(I%XC1SAT)
-IF (ASSOCIATED(I%XC2REF)) DEALLOCATE(I%XC2REF)
-IF (ASSOCIATED(I%XC3 )) DEALLOCATE(I%XC3 )
-IF (ASSOCIATED(I%XC4B )) DEALLOCATE(I%XC4B )
-IF (ASSOCIATED(I%XACOEF)) DEALLOCATE(I%XACOEF)
-IF (ASSOCIATED(I%XPCOEF)) DEALLOCATE(I%XPCOEF)
-IF (ASSOCIATED(I%XC4REF)) DEALLOCATE(I%XC4REF)
-IF (ASSOCIATED(I%XCONDSAT)) DEALLOCATE(I%XCONDSAT)
-IF (ASSOCIATED(I%XMPOTSAT)) DEALLOCATE(I%XMPOTSAT)
-IF (ASSOCIATED(I%XALBNIR_DRY)) DEALLOCATE(I%XALBNIR_DRY)
-IF (ASSOCIATED(I%XALBVIS_DRY)) DEALLOCATE(I%XALBVIS_DRY)
-IF (ASSOCIATED(I%XALBUV_DRY )) DEALLOCATE(I%XALBUV_DRY )
-IF (ASSOCIATED(I%XALBNIR_WET)) DEALLOCATE(I%XALBNIR_WET)
-IF (ASSOCIATED(I%XALBVIS_WET)) DEALLOCATE(I%XALBVIS_WET)
-IF (ASSOCIATED(I%XALBUV_WET )) DEALLOCATE(I%XALBUV_WET )
-IF (ASSOCIATED(I%XABC)) DEALLOCATE(I%XABC)
-IF (ASSOCIATED(I%XPOI)) DEALLOCATE(I%XPOI)
-!
-IF (ASSOCIATED(I%XGNDLITTER )) DEALLOCATE(I%XGNDLITTER )
-IF (ASSOCIATED(I%XRGLGV )) DEALLOCATE(I%XRGLGV )
-IF (ASSOCIATED(I%XGAMMAGV )) DEALLOCATE(I%XGAMMAGV )
-IF (ASSOCIATED(I%XRSMINGV )) DEALLOCATE(I%XRSMINGV )
-IF (ASSOCIATED(I%XROOTFRACGV )) DEALLOCATE(I%XROOTFRACGV )
-IF (ASSOCIATED(I%XWRMAX_CFGV )) DEALLOCATE(I%XWRMAX_CFGV )
-IF (ASSOCIATED(I%XLAIGV )) DEALLOCATE(I%XLAIGV )
-IF (ASSOCIATED(I%XZ0LITTER )) DEALLOCATE(I%XZ0LITTER )
-IF (ASSOCIATED(I%XH_VEG )) DEALLOCATE(I%XH_VEG )
-!
-!-------------------------------------------------------------------------------------
-!
-IF(ASSOCIATED(CHI%XDEP)) DEALLOCATE(CHI%XDEP)
-IF(ASSOCIATED(CHI%CCH_NAMES)) DEALLOCATE(CHI%CCH_NAMES)
-IF(ASSOCIATED(CHI%SVI%CSV)) DEALLOCATE(CHI%SVI%CSV)
-!
-!-------------------------------------------------------------------------------------
-!
-IF(ASSOCIATED(I%XTI_MIN)) DEALLOCATE(I%XTI_MIN)
-IF(ASSOCIATED(I%XTI_MAX)) DEALLOCATE(I%XTI_MAX)
-IF(ASSOCIATED(I%XTI_MEAN)) DEALLOCATE(I%XTI_MEAN)
-IF(ASSOCIATED(I%XTI_STD)) DEALLOCATE(I%XTI_STD)
-IF(ASSOCIATED(I%XTI_SKEW)) DEALLOCATE(I%XTI_SKEW)
-IF(ASSOCIATED(I%XTAB_FSAT)) DEALLOCATE(I%XTAB_FSAT)
-IF(ASSOCIATED(I%XTAB_WTOP)) DEALLOCATE(I%XTAB_WTOP)
-IF(ASSOCIATED(I%XTAB_QTOP)) DEALLOCATE(I%XTAB_QTOP)
-IF(ASSOCIATED(I%XMUF)) DEALLOCATE(I%XMUF)
-IF(ASSOCIATED(I%XFSAT)) DEALLOCATE(I%XFSAT)
-IF(ASSOCIATED(I%XD_ICE)) DEALLOCATE(I%XD_ICE)
-IF(ASSOCIATED(I%XKSAT_ICE)) DEALLOCATE(I%XKSAT_ICE)
-IF(ASSOCIATED(I%XFRACSOC)) DEALLOCATE(I%XFRACSOC)
-IF(ASSOCIATED(I%XTOPQS)) DEALLOCATE(I%XTOPQS)
-IF(ASSOCIATED(I%XFWTD)) DEALLOCATE(I%XFWTD)
-IF(ASSOCIATED(I%XWTD)) DEALLOCATE(I%XWTD)
-!
-IF(ASSOCIATED(I%XFFLOOD)) DEALLOCATE(I%XFFLOOD)
-IF(ASSOCIATED(I%XPIFLOOD)) DEALLOCATE(I%XPIFLOOD)
-!
-IF(ASSOCIATED(I%XPSNG)) DEALLOCATE(I%XPSNG)
-IF(ASSOCIATED(I%XPSNV)) DEALLOCATE(I%XPSNV)
-IF(ASSOCIATED(I%XPSNV_A)) DEALLOCATE(I%XPSNV_A)
-IF(ASSOCIATED(I%XPSN)) DEALLOCATE(I%XPSN)
-IF(ASSOCIATED(I%XDIR_ALB_WITH_SNOW)) DEALLOCATE(I%XDIR_ALB_WITH_SNOW)
-IF(ASSOCIATED(I%XSCA_ALB_WITH_SNOW)) DEALLOCATE(I%XSCA_ALB_WITH_SNOW)
-IF(ASSOCIATED(I%XFFG)) DEALLOCATE(I%XFFG)
-IF(ASSOCIATED(I%XFFV)) DEALLOCATE(I%XFFV)
-IF(ASSOCIATED(I%XFF)) DEALLOCATE(I%XFF)
-IF(ASSOCIATED(I%XFFROZEN)) DEALLOCATE(I%XFFROZEN)
-IF(ASSOCIATED(I%XALBF)) DEALLOCATE(I%XALBF)
-IF(ASSOCIATED(I%XEMISF)) DEALLOCATE(I%XEMISF)
-!-------------------------------------------------------------------------------------
-IF(ASSOCIATED(I%XCPL_EFLOOD)) DEALLOCATE(I%XCPL_EFLOOD)
-IF(ASSOCIATED(I%XCPL_PFLOOD)) DEALLOCATE(I%XCPL_PFLOOD)
-IF(ASSOCIATED(I%XCPL_IFLOOD)) DEALLOCATE(I%XCPL_IFLOOD)
-IF(ASSOCIATED(I%XCPL_DRAIN)) DEALLOCATE(I%XCPL_DRAIN)
-IF(ASSOCIATED(I%XCPL_RUNOFF)) DEALLOCATE(I%XCPL_RUNOFF)
-IF(ASSOCIATED(I%XCPL_ICEFLUX)) DEALLOCATE(I%XCPL_ICEFLUX)
-IF(ASSOCIATED(I%XCPL_RECHARGE)) DEALLOCATE(I%XCPL_RECHARGE)
-!-------------------------------------------------------------------------------------
-IF(ASSOCIATED(I%XICE_STO)) DEALLOCATE(I%XICE_STO)
-!-------------------------------------------------------------------------------------
-IF(ASSOCIATED(DTI%XPAR_VEGTYPE )) DEALLOCATE(DTI%XPAR_VEGTYPE )
-IF(ASSOCIATED(DTI%XPAR_LAI )) DEALLOCATE(DTI%XPAR_LAI )
-IF(ASSOCIATED(DTI%XPAR_H_TREE )) DEALLOCATE(DTI%XPAR_H_TREE )
-IF(ASSOCIATED(DTI%XPAR_DG )) DEALLOCATE(DTI%XPAR_DG )
-IF(ASSOCIATED(DTI%XPAR_ROOTFRAC )) DEALLOCATE(DTI%XPAR_ROOTFRAC )
-IF(ASSOCIATED(DTI%XPAR_VEG )) DEALLOCATE(DTI%XPAR_VEG )
-IF(ASSOCIATED(DTI%XPAR_Z0 )) DEALLOCATE(DTI%XPAR_Z0 )
-IF(ASSOCIATED(DTI%XPAR_EMIS )) DEALLOCATE(DTI%XPAR_EMIS )
-IF(ASSOCIATED(DTI%XPAR_DICE )) DEALLOCATE(DTI%XPAR_DICE )
-IF(ASSOCIATED(DTI%XPAR_RSMIN )) DEALLOCATE(DTI%XPAR_RSMIN )
-IF(ASSOCIATED(DTI%XPAR_GAMMA )) DEALLOCATE(DTI%XPAR_GAMMA )
-IF(ASSOCIATED(DTI%XPAR_WRMAX_CF )) DEALLOCATE(DTI%XPAR_WRMAX_CF )
-IF(ASSOCIATED(DTI%XPAR_RGL )) DEALLOCATE(DTI%XPAR_RGL )
-IF(ASSOCIATED(DTI%XPAR_CV )) DEALLOCATE(DTI%XPAR_CV )
-IF(ASSOCIATED(DTI%XPAR_Z0_O_Z0H )) DEALLOCATE(DTI%XPAR_Z0_O_Z0H )
-IF(ASSOCIATED(DTI%XPAR_ALBNIR_VEG )) DEALLOCATE(DTI%XPAR_ALBNIR_VEG )
-IF(ASSOCIATED(DTI%XPAR_ALBVIS_VEG )) DEALLOCATE(DTI%XPAR_ALBVIS_VEG )
-IF(ASSOCIATED(DTI%XPAR_ALBUV_VEG )) DEALLOCATE(DTI%XPAR_ALBUV_VEG )
-IF(ASSOCIATED(DTI%XPAR_ALBNIR_SOIL)) DEALLOCATE(DTI%XPAR_ALBNIR_SOIL)
-IF(ASSOCIATED(DTI%XPAR_ALBVIS_SOIL)) DEALLOCATE(DTI%XPAR_ALBVIS_SOIL)
-IF(ASSOCIATED(DTI%XPAR_ALBUV_SOIL )) DEALLOCATE(DTI%XPAR_ALBUV_SOIL )
-IF(ASSOCIATED(DTI%XPAR_GMES )) DEALLOCATE(DTI%XPAR_GMES )
-IF(ASSOCIATED(DTI%XPAR_BSLAI )) DEALLOCATE(DTI%XPAR_BSLAI )
-IF(ASSOCIATED(DTI%XPAR_SEFOLD )) DEALLOCATE(DTI%XPAR_SEFOLD )
-IF(ASSOCIATED(DTI%XPAR_GC )) DEALLOCATE(DTI%XPAR_GC )
-IF(ASSOCIATED(DTI%XPAR_DMAX )) DEALLOCATE(DTI%XPAR_DMAX )
-IF(ASSOCIATED(DTI%XPAR_RE25 )) DEALLOCATE(DTI%XPAR_RE25 )
-IF(ASSOCIATED(DTI%XPAR_LAIMIN )) DEALLOCATE(DTI%XPAR_LAIMIN )
-IF(ASSOCIATED(DTI%XPAR_F2I )) DEALLOCATE(DTI%XPAR_F2I )
-IF(ASSOCIATED(DTI%XPAR_CE_NITRO )) DEALLOCATE(DTI%XPAR_CE_NITRO )
-IF(ASSOCIATED(DTI%XPAR_CF_NITRO )) DEALLOCATE(DTI%XPAR_CF_NITRO )
-IF(ASSOCIATED(DTI%XPAR_CNA_NITRO )) DEALLOCATE(DTI%XPAR_CNA_NITRO )
-IF(ASSOCIATED(DTI%LPAR_STRESS )) DEALLOCATE(DTI%LPAR_STRESS )
-IF(ASSOCIATED(DTI%XPAR_IRRIG )) DEALLOCATE(DTI%XPAR_IRRIG )
-IF(ASSOCIATED(DTI%XPAR_WATSUP )) DEALLOCATE(DTI%XPAR_WATSUP )
!
-IF(ASSOCIATED(I%XRED_NOISE )) DEALLOCATE(I%XRED_NOISE)
+CALL DIAG_OPTIONS_INIT(IM%ID%O)
+CALL DIAG_INIT(IM%ID%D)
+CALL DIAG_INIT(IM%ID%DC)
+CALL DIAG_EVAP_ISBA_INIT(IM%ID%DE)
+CALL DIAG_EVAP_ISBA_INIT(IM%ID%DEC)
+CALL DIAG_MISC_ISBA_INIT(IM%ID%DM)
+!
+CALL DIAG_NP_INIT(IM%ID%ND,0)
+CALL DIAG_NP_INIT(IM%ID%NDC,0)
+CALL DIAG_EVAP_ISBA_NP_INIT(IM%ID%NDE,0)
+CALL DIAG_EVAP_ISBA_NP_INIT(IM%ID%NDEC,0)
+CALL DIAG_MISC_ISBA_NP_INIT(IM%ID%NDM,0)
+ !
+CALL DATA_ISBA_INIT(IM%DTV)
+CALL CANOPY_INIT(IM%SB)
+CALL ISBA_OPTIONS_INIT(IM%O)
+CALL ISBA_S_INIT(IM%S)
+CALL CH_ISBA_INIT(IM%CHI)
+CALL GR_BIOG_INIT(IM%GB)
+CALL SSO_INIT(IM%ISS)
+CALL GRID_INIT(IM%G)
+CALL ISBA_K_INIT(IM%K)
+!
+CALL CH_ISBA_NP_INIT(IM%NCHI,0)
+CALL GR_BIOG_NP_INIT(IM%NGB,0)
+CALL SSO_NP_INIT(IM%NISS,0)
+CALL GRID_NP_INIT(IM%NG,0)
+CALL ISBA_NK_INIT(IM%NK,0)
+CALL ISBA_NP_INIT(IM%NP,0)
+CALL ISBA_NPE_INIT(IM%NPE,0)
+CALL AGRI_NP_INIT(IM%NAG,0)
!
!-------------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('DEALLOC_ISBA_N',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/dealloc_naturen.F90 b/src/SURFEX/dealloc_naturen.F90
index bf262df12d3590d47f5a7e23ea76b10fbc704881..9d03c857c000affe14b6fc8afa92a947db30e5c5 100644
--- a/src/SURFEX/dealloc_naturen.F90
+++ b/src/SURFEX/dealloc_naturen.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE DEALLOC_NATURE_n (CHI, DTI, GB, IG, I, U)
+SUBROUTINE DEALLOC_NATURE_n (IM, U)
! ###############################################################################
!
!!**** *DEALLOC_NATURE_n * - Deallocate all arrays
@@ -27,17 +27,8 @@ SUBROUTINE DEALLOC_NATURE_n (CHI, DTI, GB, IG, I, U)
!! Original 01/2004
!!------------------------------------------------------------------
!
-
-!
-!
-!
+USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t
!
-!
-USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -56,20 +47,14 @@ IMPLICIT NONE
!
!-------------------------------------------------------------------------------------
!
-
-!
-TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(GR_BIOG_t), INTENT(INOUT) :: GB
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('DEALLOC_NATURE_N',0,ZHOOK_HANDLE)
IF (U%CNATURE=='ISBA ' .OR. U%CNATURE=='TSZ0 ') THEN
- CALL DEALLOC_ISBA_n(CHI, DTI, GB, IG, I)
+ CALL DEALLOC_ISBA_n(IM)
ELSE IF (U%CNATURE=='FLUX ') THEN
CALL DEALLOC_IDEAL_FLUX
END IF
diff --git a/src/SURFEX/dealloc_seafluxn.F90 b/src/SURFEX/dealloc_seafluxn.F90
index ad6bf8ac335cc08555d215f6045b34283bbe425e..568fc710d984ecb13226e6ffe6c8dd4df2770460 100644
--- a/src/SURFEX/dealloc_seafluxn.F90
+++ b/src/SURFEX/dealloc_seafluxn.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #################################################################################
-SUBROUTINE DEALLOC_SEAFLUX_n (CHS, SG, S)
+SUBROUTINE DEALLOC_SEAFLUX_n (SM)
! #################################################################################
!
!!**** *DEALLOC_SEAFLUX_n * - Deallocate all arrays
@@ -29,12 +29,20 @@ SUBROUTINE DEALLOC_SEAFLUX_n (CHS, SG, S)
!! S. Senesi 09/2013 introduce sea-ice-cover ans sea-surface salinity
!!------------------------------------------------------------------
!
+USE MODD_DIAG_n, ONLY : DIAG_INIT, DIAG_OPTIONS_INIT
+USE MODD_DIAG_OCEAN_n, ONLY : DIAG_OCEAN_INIT
+USE MODD_DIAG_MISC_SEAICE_n, ONLY : DIAG_MISC_SEAICE_INIT
!
+USE MODD_CH_SEAFLUX_n, ONLY : CH_SEAFLUX_INIT
+USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_INIT
+USE MODD_SEAFLUX_n, ONLY : SEAFLUX_INIT
+USE MODD_OCEAN_n, ONLY : OCEAN_INIT
+USE MODD_OCEAN_REL_n, ONLY : OCEAN_REL_INIT
!
+USE MODD_SFX_GRID_n, ONLY : GRID_INIT
+USE MODD_CANOPY_n, ONLY : CANOPY_INIT
!
-USE MODD_CH_SEAFLUX_n, ONLY : CH_SEAFLUX_t
-USE MODD_SEAFLUX_GRID_n, ONLY : SEAFLUX_GRID_t
-USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
+USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t
!
USE MODI_GLTOOLS_DEALLOC
!
@@ -49,9 +57,7 @@ IMPLICIT NONE
!* 0.2 declarations of local variables
!
!
-TYPE(CH_SEAFLUX_t), INTENT(INOUT) :: CHS
-TYPE(SEAFLUX_GRID_t), INTENT(INOUT) :: SG
-TYPE(SEAFLUX_t), INTENT(INOUT) :: S
+TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -59,48 +65,26 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('DEALLOC_SEAFLUX_N',0,ZHOOK_HANDLE)
!
-IF (ASSOCIATED(S%LCOVER )) DEALLOCATE(S%LCOVER )
-IF (ASSOCIATED(S%XCOVER )) DEALLOCATE(S%XCOVER )
-IF (ASSOCIATED(S%XZS )) DEALLOCATE(S%XZS )
-IF (ASSOCIATED(S%XSST )) DEALLOCATE(S%XSST )
-IF (ASSOCIATED(S%XSSS )) DEALLOCATE(S%XSSS )
-IF (ASSOCIATED(S%XSIC )) DEALLOCATE(S%XSIC )
-IF (ASSOCIATED(S%XFSIC )) DEALLOCATE(S%XFSIC )
-IF (ASSOCIATED(S%XFSIT )) DEALLOCATE(S%XFSIT )
-IF (ASSOCIATED(S%XZ0 )) DEALLOCATE(S%XZ0 )
-IF (ASSOCIATED(S%XZ0H )) DEALLOCATE(S%XZ0H )
-IF (ASSOCIATED(S%XSEABATHY)) DEALLOCATE(S%XSEABATHY)
-IF (ASSOCIATED(S%XEMIS )) DEALLOCATE(S%XEMIS )
-IF (ASSOCIATED(S%XDIR_ALB)) DEALLOCATE(S%XDIR_ALB)
-IF (ASSOCIATED(S%XSCA_ALB)) DEALLOCATE(S%XSCA_ALB)
+CALL DIAG_OPTIONS_INIT(SM%SD%O)
+CALL DIAG_INIT(SM%SD%D)
+CALL DIAG_INIT(SM%SD%DC)
+CALL DIAG_INIT(SM%SD%DI)
+CALL DIAG_INIT(SM%SD%DIC)
+CALL DIAG_OCEAN_INIT(SM%SD%GO)
+CALL DIAG_MISC_SEAICE_INIT(SM%SD%DMI)
+ !
+CALL DATA_SEAFLUX_INIT(SM%DTS)
+CALL GRID_INIT(SM%G)
+CALL CANOPY_INIT(SM%SB)
+CALL CH_SEAFLUX_INIT(SM%CHS)
+CALL SEAFLUX_INIT(SM%S)
+CALL SEAFLUX_INIT(SM%S)
+CALL OCEAN_INIT(SM%O)
+CALL OCEAN_REL_INIT(SM%OR)
!
!-------------------------------------------------------------------------------------
!
-IF (ASSOCIATED(SG%XGRID_PAR )) DEALLOCATE(SG%XGRID_PAR )
-IF (ASSOCIATED(SG%XLAT )) DEALLOCATE(SG%XLAT )
-IF (ASSOCIATED(SG%XLON )) DEALLOCATE(SG%XLON )
-IF (ASSOCIATED(SG%XMESH_SIZE)) DEALLOCATE(SG%XMESH_SIZE)
-!
-!-------------------------------------------------------------------------------------
-!
-IF(ASSOCIATED(CHS%XDEP)) DEALLOCATE(CHS%XDEP)
-IF(ASSOCIATED(CHS%CCH_NAMES)) DEALLOCATE(CHS%CCH_NAMES)
-IF(ASSOCIATED(CHS%SVS%CSV)) DEALLOCATE(CHS%SVS%CSV)
-!
-!-------------------------------------------------------------------------------------
-!
-IF(ASSOCIATED(S%XCPL_SEA_WIND)) DEALLOCATE(S%XCPL_SEA_WIND)
-IF(ASSOCIATED(S%XCPL_SEA_FWSU)) DEALLOCATE(S%XCPL_SEA_FWSU)
-IF(ASSOCIATED(S%XCPL_SEA_FWSV)) DEALLOCATE(S%XCPL_SEA_FWSV)
-IF(ASSOCIATED(S%XCPL_SEA_SNET)) DEALLOCATE(S%XCPL_SEA_SNET)
-IF(ASSOCIATED(S%XCPL_SEA_HEAT)) DEALLOCATE(S%XCPL_SEA_HEAT)
-IF(ASSOCIATED(S%XCPL_SEA_EVAP)) DEALLOCATE(S%XCPL_SEA_EVAP)
-IF(ASSOCIATED(S%XCPL_SEA_RAIN)) DEALLOCATE(S%XCPL_SEA_RAIN)
-IF(ASSOCIATED(S%XCPL_SEA_SNOW)) DEALLOCATE(S%XCPL_SEA_SNOW)
-!
-!-------------------------------------------------------------------------------------
-!
-IF (ASSOCIATED(S%TGLT%bat) .AND. S%CSEAICE_SCHEME=='GELATO' ) CALL GLTOOLS_DEALLOC(S%TGLT)
+IF (ASSOCIATED(SM%S%TGLT%bat) .AND. SM%S%CSEAICE_SCHEME=='GELATO' ) CALL GLTOOLS_DEALLOC(SM%S%TGLT)
!
IF (LHOOK) CALL DR_HOOK('DEALLOC_SEAFLUX_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/dealloc_sean.F90 b/src/SURFEX/dealloc_sean.F90
index 968ff7938b2ab0377397b18bd30b538cb1080e97..cc836cfc8b5a4e111a052bfc2db92882eb494e53 100644
--- a/src/SURFEX/dealloc_sean.F90
+++ b/src/SURFEX/dealloc_sean.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE DEALLOC_SEA_n (CHS, SG, S, U)
+SUBROUTINE DEALLOC_SEA_n (SM, U)
! ###############################################################################
!
!!**** *DEALLOC_SEA_n * - Deallocate all arrays
@@ -27,15 +27,7 @@ SUBROUTINE DEALLOC_SEA_n (CHS, SG, S, U)
!! Original 01/2004
!!------------------------------------------------------------------
!
-
-!
-!
-!
-!
-!
-USE MODD_CH_SEAFLUX_n, ONLY : CH_SEAFLUX_t
-USE MODD_SEAFLUX_GRID_n, ONLY : SEAFLUX_GRID_t
-USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
+USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -54,18 +46,15 @@ IMPLICIT NONE
!
!-------------------------------------------------------------------------------------
!
-
+TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM
!
-TYPE(CH_SEAFLUX_t), INTENT(INOUT) :: CHS
-TYPE(SEAFLUX_GRID_t), INTENT(INOUT) :: SG
-TYPE(SEAFLUX_t), INTENT(INOUT) :: S
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('DEALLOC_SEA_N',0,ZHOOK_HANDLE)
IF (U%CSEA=='SEAFLX') THEN
- CALL DEALLOC_SEAFLUX_n(CHS, SG, S)
+ CALL DEALLOC_SEAFLUX_n(SM)
ELSE IF (U%CSEA=='FLUX ') THEN
CALL DEALLOC_IDEAL_FLUX
END IF
diff --git a/src/SURFEX/dealloc_surf_atmn.F90 b/src/SURFEX/dealloc_surf_atmn.F90
index 5c7eb6f60948ac8f09c7360a70ff0e1c7e2bb31c..eaef73317758c697a7212de6e6811494964f0983 100644
--- a/src/SURFEX/dealloc_surf_atmn.F90
+++ b/src/SURFEX/dealloc_surf_atmn.F90
@@ -27,6 +27,27 @@ SUBROUTINE DEALLOC_SURF_ATM_n (YSC)
!! Original 01/2004
!!------------------------------------------------------------------
!
+USE MODD_CH_EMIS_FIELD_n, ONLY : CH_EMIS_FIELD_INIT
+USE MODD_CH_SNAP_n, ONLY : CH_EMIS_SNAP_INIT
+USE MODD_CH_SURF_n, ONLY : CH_SURF_INIT
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_INIT
+USE MODD_DUMMY_SURF_FIELDS_n, ONLY : DUMMY_SURF_FIELDS_INIT
+USE MODD_EMIS_GR_FIELD_n, ONLY : EMIS_GR_FIELD_INIT
+USE MODD_CANOPY_n, ONLY : CANOPY_INIT
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_INIT
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_INIT
+USE MODD_SSO_n, ONLY : SSO_INIT
+USE MODD_SV_n, ONLY : SV_INIT
+!
+USE MODD_DATA_TSZ0_n, ONLY : DATA_TSZ0_INIT
+!
+USE MODD_IDEAL_n, ONLY : IDEAL_INIT
+!
+USE MODD_DST_n, ONLY : DST_NP_INIT
+USE MODD_SLT_n, ONLY : SLT_INIT
+!
+USE MODD_DIAG_n, ONLY : DIAG_INIT, DIAG_NP_INIT, DIAG_OPTIONS_INIT
+!
USE MODD_SURFEX_n, ONLY : SURFEX_t
!
USE MODI_DEALLOC_SEA_n
@@ -52,80 +73,49 @@ TYPE(SURFEX_t), INTENT(INOUT) :: YSC
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('DEALLOC_SURF_ATM_N',0,ZHOOK_HANDLE)
-IF (ASSOCIATED(YSC%U%XNATURE)) DEALLOCATE(YSC%U%XNATURE)
-IF (ASSOCIATED(YSC%U%XTOWN )) DEALLOCATE(YSC%U%XTOWN )
-IF (ASSOCIATED(YSC%U%XWATER )) DEALLOCATE(YSC%U%XWATER )
-IF (ASSOCIATED(YSC%U%XSEA )) DEALLOCATE(YSC%U%XSEA )
-!
-IF (ASSOCIATED(YSC%U%LCOVER )) DEALLOCATE(YSC%U%LCOVER )
-IF (ASSOCIATED(YSC%U%XCOVER )) DEALLOCATE(YSC%U%XCOVER )
-IF (ASSOCIATED(YSC%U%XZS )) DEALLOCATE(YSC%U%XZS )
!
-IF (ASSOCIATED(YSC%U%NR_NATURE)) DEALLOCATE(YSC%U%NR_NATURE)
-IF (ASSOCIATED(YSC%U%NR_TOWN )) DEALLOCATE(YSC%U%NR_TOWN )
-IF (ASSOCIATED(YSC%U%NR_WATER )) DEALLOCATE(YSC%U%NR_WATER )
-IF (ASSOCIATED(YSC%U%NR_SEA )) DEALLOCATE(YSC%U%NR_SEA )
+CALL DATA_COVER_INIT(YSC%DTCO)
+CALL DATA_TSZ0_INIT(YSC%DTZ)
+CALL DUMMY_SURF_FIELDS_INIT(YSC%DUU)
+ !
+CALL SURF_ATM_GRID_INIT(YSC%UG)
+CALL DIAG_OPTIONS_INIT(YSC%DUO)
+CALL DIAG_INIT(YSC%DU)
+CALL DIAG_INIT(YSC%DUC)
+CALL DIAG_NP_INIT(YSC%DUP,0)
+CALL DIAG_NP_INIT(YSC%DUPC,0)
+CALL SSO_INIT(YSC%USS)
+CALL CANOPY_INIT(YSC%SB)
+ !
+CALL DIAG_INIT(YSC%DL)
+CALL DIAG_INIT(YSC%DLC)
+CALL IDEAL_INIT(YSC%L)
+ !
+CALL SV_INIT(YSC%SV)
+CALL CH_SURF_INIT(YSC%CHU)
+CALL CH_EMIS_FIELD_INIT(YSC%CHE)
+CALL CH_EMIS_SNAP_INIT(YSC%CHN)
+CALL EMIS_GR_FIELD_INIT(YSC%EGF)
+CALL SLT_INIT(YSC%SLT)
+!
+CALL DST_NP_INIT(YSC%NDST,0)
!
!-------------------------------------------------------------------------------------
!
-IF (ASSOCIATED(YSC%UG%XGRID_PAR )) DEALLOCATE(YSC%UG%XGRID_PAR )
-IF (ASSOCIATED(YSC%UG%XLAT )) DEALLOCATE(YSC%UG%XLAT )
-IF (ASSOCIATED(YSC%UG%XLON )) DEALLOCATE(YSC%UG%XLON )
-IF (ASSOCIATED(YSC%UG%XMESH_SIZE)) DEALLOCATE(YSC%UG%XMESH_SIZE)
-IF (ASSOCIATED(YSC%UG%XJPDIR )) DEALLOCATE(YSC%UG%XJPDIR )
-!
-!-------------------------------------------------------------------------------------
+IF (YSC%U%NDIM_SEA >0) CALL DEALLOC_SEA_n(YSC%SM, YSC%U)
!
-IF (ASSOCIATED(YSC%USS%XAOSIP)) DEALLOCATE(YSC% USS%XAOSIP)
-IF (ASSOCIATED(YSC%USS%XAOSIM)) DEALLOCATE(YSC% USS%XAOSIM)
-IF (ASSOCIATED(YSC%USS%XAOSJP)) DEALLOCATE(YSC% USS%XAOSJP)
-IF (ASSOCIATED(YSC%USS%XAOSJM)) DEALLOCATE(YSC% USS%XAOSJM)
-IF (ASSOCIATED(YSC%USS%XHO2IP)) DEALLOCATE(YSC% USS%XHO2IP)
-IF (ASSOCIATED(YSC%USS%XHO2IM)) DEALLOCATE(YSC% USS%XHO2IM)
-IF (ASSOCIATED(YSC%USS%XHO2JP)) DEALLOCATE(YSC% USS%XHO2JP)
-IF (ASSOCIATED(YSC%USS%XHO2JM)) DEALLOCATE(YSC% USS%XHO2JM)
-IF (ASSOCIATED(YSC%USS%XZ0REL)) DEALLOCATE(YSC% USS%XZ0REL)
-IF (ASSOCIATED(YSC%USS%XSSO_SLOPE)) DEALLOCATE(YSC% USS%XSSO_SLOPE)
-IF (ASSOCIATED(YSC%USS%XSSO_ANIS)) DEALLOCATE(YSC% USS%XSSO_ANIS)
-IF (ASSOCIATED(YSC%USS%XSSO_DIR)) DEALLOCATE(YSC% USS%XSSO_DIR)
-IF (ASSOCIATED(YSC%USS%XSSO_STDEV)) DEALLOCATE(YSC% USS%XSSO_STDEV)
-IF (ASSOCIATED(YSC%USS%XAVG_ZS)) DEALLOCATE(YSC% USS%XAVG_ZS)
-IF (ASSOCIATED(YSC%USS%XSIL_ZS)) DEALLOCATE(YSC% USS%XSIL_ZS)
-IF (ASSOCIATED(YSC%USS%XMAX_ZS)) DEALLOCATE(YSC% USS%XMAX_ZS)
-IF (ASSOCIATED(YSC%USS%XMIN_ZS)) DEALLOCATE(YSC% USS%XMIN_ZS)
+IF (YSC%U%NDIM_WATER >0) CALL DEALLOC_INLAND_WATER_n(YSC%WM, YSC%FM, YSC%U)
!
-!-------------------------------------------------------------------------------------
-!
-IF (ASSOCIATED(YSC%CHE%CEMIS_AREA)) DEALLOCATE(YSC%CHE%CEMIS_AREA)
-IF (ASSOCIATED(YSC%CHE%CEMIS_COMMENT))DEALLOCATE(YSC%CHE%CEMIS_COMMENT)
-IF (ASSOCIATED(YSC%CHE%CEMIS_NAME)) DEALLOCATE(YSC%CHE%CEMIS_NAME)
-IF (ASSOCIATED(YSC%CHE%NEMIS_TIME)) DEALLOCATE(YSC%CHE%NEMIS_TIME)
-IF (ASSOCIATED(YSC%CHE%XEMIS_FIELDS)) DEALLOCATE(YSC%CHE%XEMIS_FIELDS)
-IF (ASSOCIATED(YSC%CHE%TSEMISS)) DEALLOCATE(YSC%CHE%TSEMISS)
-!
-!-------------------------------------------------------------------------------------
-!
-IF (ASSOCIATED(YSC%DUU%XDUMMY_FIELDS)) DEALLOCATE(YSC% DUU%XDUMMY_FIELDS)
-!
-!-------------------------------------------------------------------------------------
+IF (YSC%U%NDIM_NATURE >0) CALL DEALLOC_NATURE_n(YSC%IM, YSC%U)
!
-IF (ASSOCIATED(YSC%SV%CSV)) DEALLOCATE(YSC%SV%CSV)
+IF (YSC%U%NDIM_TOWN >0) CALL DEALLOC_TOWN_n(YSC%TM, YSC%GDM, YSC%GRM, YSC%U)
!
!-------------------------------------------------------------------------------------
!
-IF (ASSOCIATED(YSC%CHU%CCH_NAMES)) DEALLOCATE(YSC%CHU%CCH_NAMES)
-IF (ASSOCIATED(YSC%CHE%CEMIS_NAME)) DEALLOCATE(YSC%CHE%CEMIS_NAME)
-IF (ASSOCIATED(YSC%CHE%CEMIS_AREA)) DEALLOCATE(YSC%CHE%CEMIS_AREA)
-IF (ASSOCIATED(YSC%CHE%NEMIS_TIME)) DEALLOCATE(YSC%CHE%NEMIS_TIME )
-IF (ASSOCIATED(YSC%CHE%TSEMISS)) DEALLOCATE(YSC%CHE%TSEMISS)
+CALL SURF_ATM_INIT(YSC%U)
!
!-------------------------------------------------------------------------------------
!
-IF (YSC%U%NDIM_SEA >0) CALL DEALLOC_SEA_n(YSC%SM%CHS, YSC%SM%SG, YSC%SM%S, YSC%U)
-IF (YSC%U%NDIM_WATER >0) CALL DEALLOC_INLAND_WATER_n(YSC%FM%CHF, YSC%WM%CHW, YSC%FM%FG, YSC%FM%F, YSC%U, YSC%WM%WG, YSC%WM%W)
-IF (YSC%U%NDIM_NATURE >0) CALL DEALLOC_NATURE_n(YSC%IM%CHI, YSC%IM%DTI, YSC%IM%GB, YSC%IM%IG, YSC%IM%I, YSC%U)
-IF (YSC%U%NDIM_TOWN >0) CALL DEALLOC_TOWN_n(YSC%TM%B, YSC%TM%CHT, YSC%TM%DTT, YSC%U, YSC%TM%TG, &
- YSC%TM%T, YSC%TM%TOP, YSC%TM%TPN)
IF (LHOOK) CALL DR_HOOK('DEALLOC_SURF_ATM_N',1,ZHOOK_HANDLE)
!
!--------------------------------------------------------------------------------------
diff --git a/src/SURFEX/dealloc_surfex.F90 b/src/SURFEX/dealloc_surfex.F90
deleted file mode 100644
index 952d4cf8b778801f7f2f07dc35ef35f26db4ecdf..0000000000000000000000000000000000000000
--- a/src/SURFEX/dealloc_surfex.F90
+++ /dev/null
@@ -1,34 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #################################################################################
-SUBROUTINE DEALLOC_SURFEX
-! #################################################################################
-!
-!!**** *DEALLOC_SURFEX * - Deallocate the surfaces
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! R. El Khatib
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 04/2010
-!! Modified 04/2013, P. Le Moigne: FLake chemistry
-!!------------------------------------------------------------------
-!
-!
-!--------------------------------------------------------------------------------------
-!
-END SUBROUTINE DEALLOC_SURFEX
diff --git a/src/SURFEX/dealloc_tebn.F90 b/src/SURFEX/dealloc_tebn.F90
index a45a2667ddc633423507c05c22f76d5920cb5879..124a52a2b5ab238fb07319be13cbc6601bd022e9 100644
--- a/src/SURFEX/dealloc_tebn.F90
+++ b/src/SURFEX/dealloc_tebn.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #################################################################################
-SUBROUTINE DEALLOC_TEB_n (B, CHT, DTT, TG, T, TOP, TPN)
+SUBROUTINE DEALLOC_TEB_n (TM, GDM, GRM)
! #################################################################################
!
!!**** *DEALLOC_TEB_n * - Deallocate all arrays
@@ -29,21 +29,34 @@ SUBROUTINE DEALLOC_TEB_n (B, CHT, DTT, TG, T, TOP, TPN)
!! G. Pigeon 10/2012: deallocate BEM variables
!!------------------------------------------------------------------
!
-
-!
-
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_INIT
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_INIT
+USE MODD_ISBA_n, ONLY : ISBA_S_INIT, ISBA_K_INIT, ISBA_P_INIT, ISBA_NPE_INIT
!
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_NP_INIT
+USE MODD_DIAG_n, ONLY : DIAG_INIT, DIAG_NP_INIT, DIAG_OPTIONS_INIT
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_NP_INIT
!
+USE MODD_CH_TEB_n, ONLY : CH_TEB_INIT
+USE MODD_DATA_TEB_n, ONLY : DATA_TEB_INIT
+USE MODD_DIAG_MISC_TEB_OPTIONS_n, ONLY : DIAG_MISC_TEB_OPTIONS_INIT
+USE MODD_DIAG_UTCI_TEB_n, ONLY : DIAG_UTCI_TEB_INIT
+USE MODD_TEB_IRRIG_n, ONLY : TEB_IRRIG_INIT
+USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_INIT
+USE MODD_TEB_PANEL_n, ONLY : TEB_PANEL_INIT
+USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_NP_INIT
+USE MODD_TEB_n, ONLY : TEB_NP_INIT
!
+USE MODD_DATA_BEM_n, ONLY : DATA_BEM_INIT
+USE MODD_BEM_OPTION_n, ONLY : BEM_OPTIONS_INIT
+USE MODD_BLD_DESCRIPTION_n, ONLY : BLD_DESC_INIT
+USE MODD_BEM_n, ONLY : BEM_NP_INIT
!
+USE MODD_SFX_GRID_n, ONLY : GRID_INIT
+USE MODD_CANOPY_n, ONLY : CANOPY_INIT
+USE MODD_GR_BIOG_n, ONLY : GR_BIOG_INIT
!
-USE MODD_BEM_n, ONLY : BEM_t
-USE MODD_CH_TEB_n, ONLY : CH_TEB_t
-USE MODD_DATA_TEB_n, ONLY : DATA_TEB_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
-USE MODD_TEB_n, ONLY : TEB_t
-USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-USE MODD_TEB_PANEL_n, ONLY : TEB_PANEL_t
+USE MODD_SURFEX_n, ONLY : TEB_MODEL_t, TEB_GARDEN_MODEL_t, TEB_GREENROOF_MODEL_t
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -57,205 +70,66 @@ IMPLICIT NONE
!
!-------------------------------------------------------------------------------------
!
-
-!
-TYPE(BEM_t), INTENT(INOUT) :: B
-TYPE(CH_TEB_t), INTENT(INOUT) :: CHT
-TYPE(DATA_TEB_t), INTENT(INOUT) :: DTT
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
-TYPE(TEB_t), INTENT(INOUT) :: T
-TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
-TYPE(TEB_PANEL_t), INTENT(INOUT) :: TPN
+TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM
+TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
+TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('DEALLOC_TEB_N',0,ZHOOK_HANDLE)
-IF (ASSOCIATED(TOP%LCOVER )) DEALLOCATE(TOP%LCOVER )
-IF (ASSOCIATED(TOP%XCOVER )) DEALLOCATE(TOP%XCOVER )
-IF (ASSOCIATED(TOP%XZS )) DEALLOCATE(TOP%XZS )
-!
-!-------------------------------------------------------------------------------------
-!
-IF (ASSOCIATED(TG%XGRID_PAR )) DEALLOCATE(TG%XGRID_PAR )
-IF (ASSOCIATED(TG%XLAT )) DEALLOCATE(TG%XLAT )
-IF (ASSOCIATED(TG%XLON )) DEALLOCATE(TG%XLON )
-IF (ASSOCIATED(TG%XMESH_SIZE)) DEALLOCATE(TG%XMESH_SIZE)
-!
-!-------------------------------------------------------------------------------------
-!
-IF(ASSOCIATED(T%CUR%XZ0_TOWN )) DEALLOCATE(T%CUR%XZ0_TOWN )
-IF(ASSOCIATED(T%CUR%XALB_ROOF )) DEALLOCATE(T%CUR%XALB_ROOF )
-IF(ASSOCIATED(T%CUR%XEMIS_ROOF )) DEALLOCATE(T%CUR%XEMIS_ROOF )
-IF(ASSOCIATED(T%CUR%XALB_ROAD )) DEALLOCATE(T%CUR%XALB_ROAD )
-IF(ASSOCIATED(T%CUR%XEMIS_ROAD )) DEALLOCATE(T%CUR%XEMIS_ROAD )
-IF(ASSOCIATED(T%CUR%XALB_WALL )) DEALLOCATE(T%CUR%XALB_WALL )
-IF(ASSOCIATED(T%CUR%XEMIS_WALL )) DEALLOCATE(T%CUR%XEMIS_WALL )
-IF(ASSOCIATED(T%CUR%XBLD )) DEALLOCATE(T%CUR%XBLD )
-IF(ASSOCIATED(T%CUR%XGARDEN )) DEALLOCATE(T%CUR%XGARDEN )
-IF(ASSOCIATED(T%CUR%XROAD_DIR )) DEALLOCATE(T%CUR%XROAD_DIR )
-IF(ASSOCIATED(T%CUR%XGREENROOF )) DEALLOCATE(T%CUR%XGREENROOF )
-IF(ASSOCIATED(T%CUR%XBLD_HEIGHT )) DEALLOCATE(T%CUR%XBLD_HEIGHT )
-IF(ASSOCIATED(T%CUR%XWALL_O_HOR )) DEALLOCATE(T%CUR%XWALL_O_HOR )
-IF(ASSOCIATED(T%CUR%XCAN_HW_RATIO)) DEALLOCATE(T%CUR%XCAN_HW_RATIO)
-IF(ASSOCIATED(T%CUR%XROAD_O_GRND)) DEALLOCATE(T%CUR%XROAD_O_GRND)
-IF(ASSOCIATED(T%CUR%XGARDEN_O_GRND))DEALLOCATE(T%CUR%XGARDEN_O_GRND)
-IF(ASSOCIATED(T%CUR%XWALL_O_GRND)) DEALLOCATE(T%CUR%XWALL_O_GRND)
-IF(ASSOCIATED(T%CUR%XH_TRAFFIC )) DEALLOCATE(T%CUR%XH_TRAFFIC )
-IF(ASSOCIATED(T%CUR%XLE_TRAFFIC )) DEALLOCATE(T%CUR%XLE_TRAFFIC )
-IF(ASSOCIATED(T%CUR%XH_INDUSTRY )) DEALLOCATE(T%CUR%XH_INDUSTRY )
-IF(ASSOCIATED(T%CUR%XLE_INDUSTRY )) DEALLOCATE(T%CUR%XLE_INDUSTRY )
-IF(ASSOCIATED(T%CUR%XHC_ROOF )) DEALLOCATE(T%CUR%XHC_ROOF )
-IF(ASSOCIATED(T%CUR%XTC_ROOF )) DEALLOCATE(T%CUR%XTC_ROOF )
-IF(ASSOCIATED(T%CUR%XD_ROOF )) DEALLOCATE(T%CUR%XD_ROOF )
-IF(ASSOCIATED(T%CUR%XHC_ROAD )) DEALLOCATE(T%CUR%XHC_ROAD )
-IF(ASSOCIATED(T%CUR%XTC_ROAD )) DEALLOCATE(T%CUR%XTC_ROAD )
-IF(ASSOCIATED(T%CUR%XD_ROAD )) DEALLOCATE(T%CUR%XD_ROAD )
-IF(ASSOCIATED(T%CUR%XHC_WALL )) DEALLOCATE(T%CUR%XHC_WALL )
-IF(ASSOCIATED(T%CUR%XTC_WALL )) DEALLOCATE(T%CUR%XTC_WALL )
-IF(ASSOCIATED(T%CUR%XD_WALL )) DEALLOCATE(T%CUR%XD_WALL )
-IF(ASSOCIATED(T%CUR%XSVF_ROAD)) DEALLOCATE(T%CUR%XSVF_ROAD)
-IF(ASSOCIATED(T%CUR%XSVF_WALL)) DEALLOCATE(T%CUR%XSVF_WALL)
-!
-IF(ASSOCIATED(TPN%XEMIS_PANEL)) DEALLOCATE(TPN%XEMIS_PANEL)
-IF(ASSOCIATED(TPN%XALB_PANEL )) DEALLOCATE(TPN%XALB_PANEL )
-IF(ASSOCIATED(TPN%XEFF_PANEL )) DEALLOCATE(TPN%XEFF_PANEL )
-IF(ASSOCIATED(TPN%XFRAC_PANEL)) DEALLOCATE(TPN%XFRAC_PANEL)
-IF(ASSOCIATED(TPN%XTHER_PRODC_DAY)) DEALLOCATE(TPN%XTHER_PRODC_DAY)
-!
-IF (ASSOCIATED(T%CUR%XT_ROOF)) DEALLOCATE(T%CUR%XT_ROOF)
-IF (ASSOCIATED(T%CUR%XT_ROAD)) DEALLOCATE(T%CUR%XT_ROAD)
-IF (ASSOCIATED(T%CUR%XT_WALL_A)) DEALLOCATE(T%CUR%XT_WALL_A)
-IF (ASSOCIATED(T%CUR%XT_WALL_B)) DEALLOCATE(T%CUR%XT_WALL_B)
-IF (ASSOCIATED(T%CUR%XAC_ROOF)) DEALLOCATE(T%CUR%XAC_ROOF)
-IF (ASSOCIATED(T%CUR%XAC_ROAD)) DEALLOCATE(T%CUR%XAC_ROAD)
-IF (ASSOCIATED(T%CUR%XAC_WALL)) DEALLOCATE(T%CUR%XAC_WALL)
-IF (ASSOCIATED(T%CUR%XAC_TOP)) DEALLOCATE(T%CUR%XAC_TOP)
-IF (ASSOCIATED(T%CUR%XAC_ROOF_WAT)) DEALLOCATE(T%CUR%XAC_ROOF_WAT)
-IF (ASSOCIATED(T%CUR%XAC_ROAD_WAT)) DEALLOCATE(T%CUR%XAC_ROAD_WAT)
-IF (ASSOCIATED(T%CUR%XQSAT_ROOF)) DEALLOCATE(T%CUR%XQSAT_ROOF)
-IF (ASSOCIATED(T%CUR%XQSAT_ROAD)) DEALLOCATE(T%CUR%XQSAT_ROAD)
-IF (ASSOCIATED(T%CUR%XDELT_ROOF)) DEALLOCATE(T%CUR%XDELT_ROOF)
-IF (ASSOCIATED(T%CUR%XDELT_ROAD)) DEALLOCATE(T%CUR%XDELT_ROAD)
-!-------------------------------------------------------------------------------------
!
-IF(ASSOCIATED(T%CUR%XAC_ROOF )) DEALLOCATE(T%CUR%XAC_ROOF )
-IF(ASSOCIATED(T%CUR%XAC_ROAD )) DEALLOCATE(T%CUR%XAC_ROAD )
-IF(ASSOCIATED(T%CUR%XAC_WALL )) DEALLOCATE(T%CUR%XAC_WALL )
-IF(ASSOCIATED(T%CUR%XAC_TOP )) DEALLOCATE(T%CUR%XAC_TOP )
-IF(ASSOCIATED(T%CUR%XAC_ROOF_WAT)) DEALLOCATE(T%CUR%XAC_ROOF_WAT)
-IF(ASSOCIATED(T%CUR%XAC_ROAD_WAT)) DEALLOCATE(T%CUR%XAC_ROAD_WAT)
-IF(ASSOCIATED(T%CUR%XQSAT_ROOF )) DEALLOCATE(T%CUR%XQSAT_ROOF )
-IF(ASSOCIATED(T%CUR%XQSAT_ROAD )) DEALLOCATE(T%CUR%XQSAT_ROAD )
-IF(ASSOCIATED(T%CUR%XDELT_ROOF )) DEALLOCATE(T%CUR%XDELT_ROOF )
-IF(ASSOCIATED(T%CUR%XDELT_ROAD )) DEALLOCATE(T%CUR%XDELT_ROAD )
-!
-!-------------------------------------------------------------------------------------
-!
-IF(ASSOCIATED(CHT%XDEP)) DEALLOCATE(CHT%XDEP)
-IF(ASSOCIATED(CHT%CCH_NAMES)) DEALLOCATE(CHT%CCH_NAMES)
-IF(ASSOCIATED(CHT%SVT%CSV)) DEALLOCATE(CHT%SVT%CSV)
-!
-!-------------------------------------------------------------------------------------
-!
-IF(ASSOCIATED(DTT%XPAR_Z0_TOWN )) DEALLOCATE(DTT%XPAR_Z0_TOWN )
-IF(ASSOCIATED(DTT%XPAR_BLD )) DEALLOCATE(DTT%XPAR_BLD )
-IF(ASSOCIATED(DTT%XPAR_ALB_ROOF )) DEALLOCATE(DTT%XPAR_ALB_ROOF )
-IF(ASSOCIATED(DTT%XPAR_EMIS_ROOF )) DEALLOCATE(DTT%XPAR_EMIS_ROOF )
-IF(ASSOCIATED(DTT%XPAR_HC_ROOF )) DEALLOCATE(DTT%XPAR_HC_ROOF )
-IF(ASSOCIATED(DTT%XPAR_TC_ROOF )) DEALLOCATE(DTT%XPAR_TC_ROOF )
-IF(ASSOCIATED(DTT%XPAR_D_ROOF )) DEALLOCATE(DTT%XPAR_D_ROOF )
-IF(ASSOCIATED(DTT%XPAR_ALB_ROAD )) DEALLOCATE(DTT%XPAR_ALB_ROAD )
-IF(ASSOCIATED(DTT%XPAR_EMIS_ROAD )) DEALLOCATE(DTT%XPAR_EMIS_ROAD )
-IF(ASSOCIATED(DTT%XPAR_HC_ROAD )) DEALLOCATE(DTT%XPAR_HC_ROAD )
-IF(ASSOCIATED(DTT%XPAR_TC_ROAD )) DEALLOCATE(DTT%XPAR_TC_ROAD )
-IF(ASSOCIATED(DTT%XPAR_D_ROAD )) DEALLOCATE(DTT%XPAR_D_ROAD )
-IF(ASSOCIATED(DTT%XPAR_ALB_WALL )) DEALLOCATE(DTT%XPAR_ALB_WALL )
-IF(ASSOCIATED(DTT%XPAR_EMIS_WALL )) DEALLOCATE(DTT%XPAR_EMIS_WALL )
-IF(ASSOCIATED(DTT%XPAR_HC_WALL )) DEALLOCATE(DTT%XPAR_HC_WALL )
-IF(ASSOCIATED(DTT%XPAR_TC_WALL )) DEALLOCATE(DTT%XPAR_TC_WALL )
-IF(ASSOCIATED(DTT%XPAR_D_WALL )) DEALLOCATE(DTT%XPAR_D_WALL )
-IF(ASSOCIATED(DTT%XPAR_BLD_HEIGHT )) DEALLOCATE(DTT%XPAR_BLD_HEIGHT )
-IF(ASSOCIATED(DTT%XPAR_WALL_O_HOR )) DEALLOCATE(DTT%XPAR_WALL_O_HOR )
-IF(ASSOCIATED(DTT%XPAR_H_TRAFFIC )) DEALLOCATE(DTT%XPAR_H_TRAFFIC )
-IF(ASSOCIATED(DTT%XPAR_LE_TRAFFIC )) DEALLOCATE(DTT%XPAR_LE_TRAFFIC )
-IF(ASSOCIATED(DTT%XPAR_H_INDUSTRY )) DEALLOCATE(DTT%XPAR_H_INDUSTRY )
-IF(ASSOCIATED(DTT%XPAR_LE_INDUSTRY)) DEALLOCATE(DTT%XPAR_LE_INDUSTRY)
-IF(ASSOCIATED(DTT%XPAR_GARDEN )) DEALLOCATE(DTT%XPAR_GARDEN )
-IF(ASSOCIATED(DTT%XPAR_ROAD_DIR )) DEALLOCATE(DTT%XPAR_ROAD_DIR )
-IF(ASSOCIATED(DTT%NPAR_BLDTYPE )) DEALLOCATE(DTT%NPAR_BLDTYPE )
-IF(ASSOCIATED(DTT%NPAR_BLD_AGE )) DEALLOCATE(DTT%NPAR_BLD_AGE )
-IF(ASSOCIATED(DTT%NPAR_BLDCODE )) DEALLOCATE(DTT%NPAR_BLDCODE )
-IF(ASSOCIATED(DTT%NPAR_USETYPE )) DEALLOCATE(DTT%NPAR_USETYPE )
-!
-!-------------------------------------------------------------------------------------
-!
-IF(ASSOCIATED(B%CUR%XHC_FLOOR )) DEALLOCATE(B%CUR%XHC_FLOOR )
-IF(ASSOCIATED(B%CUR%XTC_FLOOR )) DEALLOCATE(B%CUR%XTC_FLOOR )
-IF(ASSOCIATED(B%CUR%XD_FLOOR )) DEALLOCATE(B%CUR%XD_FLOOR )
-!
-IF(ASSOCIATED(B%CUR%XF_WASTE_CAN)) DEALLOCATE(B%CUR%XF_WASTE_CAN)
-IF(ASSOCIATED(B%CUR%XEFF_HEAT )) DEALLOCATE(B%CUR%XEFF_HEAT )
-IF(ASSOCIATED(B%CUR%XQIN )) DEALLOCATE(B%CUR%XQIN )
-IF(ASSOCIATED(B%CUR%XQIN_FRAD )) DEALLOCATE(B%CUR%XQIN_FRAD )
-IF(ASSOCIATED(B%CUR%XSHGC )) DEALLOCATE(B%CUR%XSHGC )
-IF(ASSOCIATED(B%CUR%XU_WIN )) DEALLOCATE(B%CUR%XU_WIN )
-IF(ASSOCIATED(B%CUR%XTRAN_WIN )) DEALLOCATE(B%CUR%XTRAN_WIN )
-IF(ASSOCIATED(B%CUR%XGR )) DEALLOCATE(B%CUR%XGR )
-IF(ASSOCIATED(B%CUR%XFLOOR_HEIGHT)) DEALLOCATE(B%CUR%XFLOOR_HEIGHT)
-IF(ASSOCIATED(B%CUR%XINF )) DEALLOCATE(B%CUR%XINF )
-!
-IF(ASSOCIATED(B%CUR%XQIN_FLAT )) DEALLOCATE(B%CUR%XQIN_FLAT )
-IF(ASSOCIATED(B%CUR%XHR_TARGET )) DEALLOCATE(B%CUR%XHR_TARGET )
-IF(ASSOCIATED(B%CUR%XV_VENT )) DEALLOCATE(B%CUR%XV_VENT )
-IF(ASSOCIATED(B%CUR%XCAP_SYS_HEAT)) DEALLOCATE(B%CUR%XCAP_SYS_HEAT)
-IF(ASSOCIATED(B%CUR%XCAP_SYS_RAT)) DEALLOCATE(B%CUR%XCAP_SYS_RAT)
-IF(ASSOCIATED(B%CUR%XT_ADP )) DEALLOCATE(B%CUR%XT_ADP )
-IF(ASSOCIATED(B%CUR%XM_SYS_RAT )) DEALLOCATE(B%CUR%XM_SYS_RAT )
-IF(ASSOCIATED(B%CUR%XCOP_RAT )) DEALLOCATE(B%CUR%XCOP_RAT )
-IF(ASSOCIATED(B%CUR%XT_SIZE_MAX )) DEALLOCATE(B%CUR%XT_SIZE_MAX )
-IF(ASSOCIATED(B%CUR%XT_SIZE_MIN )) DEALLOCATE(B%CUR%XT_SIZE_MIN )
-!
-IF(ASSOCIATED(B%CUR%XABS_WIN )) DEALLOCATE(B%CUR%XABS_WIN )
-IF(ASSOCIATED(B%CUR%XALB_WIN )) DEALLOCATE(B%CUR%XALB_WIN )
-IF(ASSOCIATED(B%CUR%XUGG_WIN )) DEALLOCATE(B%CUR%XUGG_WIN )
-IF(ASSOCIATED(B%CUR%LSHAD_DAY )) DEALLOCATE(B%CUR%LSHAD_DAY )
-IF(ASSOCIATED(B%CUR%LNATVENT_NIGHT)) DEALLOCATE(B%CUR%LNATVENT_NIGHT)
-IF(ASSOCIATED(B%CUR%CNATVENT )) DEALLOCATE(B%CUR%CNATVENT)
-IF(ASSOCIATED(B%CUR%LSHADE )) DEALLOCATE(B%CUR%LSHADE)
-IF(ASSOCIATED(B%CUR%XF_WATER_COND)) DEALLOCATE(B%CUR%XF_WATER_COND)
-IF(ASSOCIATED(B%CUR%XSHGC_SH )) DEALLOCATE(B%CUR%XSHGC_SH)
-
-IF(ASSOCIATED(DTT%XPAR_ROUGH_ROOF )) DEALLOCATE(DTT%XPAR_ROUGH_ROOF)
-IF(ASSOCIATED(DTT%XPAR_ROUGH_WALL )) DEALLOCATE(DTT%XPAR_ROUGH_WALL)
-IF(ASSOCIATED(DTT%XPAR_RESIDENTIAL)) DEALLOCATE(DTT%XPAR_RESIDENTIAL)
-IF(ASSOCIATED(T%CUR%XROUGH_ROOF )) DEALLOCATE(T%CUR%XROUGH_ROOF)
-IF(ASSOCIATED(T%CUR%XROUGH_WALL )) DEALLOCATE(T%CUR%XROUGH_WALL)
-IF(ASSOCIATED(T%CUR%XRESIDENTIAL)) DEALLOCATE(T%CUR%XRESIDENTIAL)
-
-IF(ASSOCIATED(B%CUR%XN_FLOOR )) DEALLOCATE(B%CUR%XN_FLOOR)
-IF(ASSOCIATED(B%CUR%XGLAZ_O_BLD )) DEALLOCATE(B%CUR%XGLAZ_O_BLD)
-IF(ASSOCIATED(B%CUR%XMASS_O_BLD )) DEALLOCATE(B%CUR%XMASS_O_BLD)
-IF(ASSOCIATED(B%CUR%XFLOOR_HW_RATIO )) DEALLOCATE(B%CUR%XFLOOR_HW_RATIO)
-IF(ASSOCIATED(B%CUR%XF_FLOOR_MASS )) DEALLOCATE(B%CUR%XF_FLOOR_MASS)
-IF(ASSOCIATED(B%CUR%XF_FLOOR_WALL )) DEALLOCATE(B%CUR%XF_FLOOR_WALL)
-IF(ASSOCIATED(B%CUR%XF_FLOOR_WIN )) DEALLOCATE(B%CUR%XF_FLOOR_WIN)
-IF(ASSOCIATED(B%CUR%XF_FLOOR_ROOF )) DEALLOCATE(B%CUR%XF_FLOOR_ROOF)
-IF(ASSOCIATED(B%CUR%XF_WALL_FLOOR )) DEALLOCATE(B%CUR%XF_WALL_FLOOR)
-IF(ASSOCIATED(B%CUR%XF_WALL_MASS )) DEALLOCATE(B%CUR%XF_WALL_MASS)
-IF(ASSOCIATED(B%CUR%XF_WALL_WIN )) DEALLOCATE(B%CUR%XF_WALL_WIN)
-IF(ASSOCIATED(B%CUR%XF_WIN_FLOOR )) DEALLOCATE(B%CUR%XF_WIN_FLOOR)
-IF(ASSOCIATED(B%CUR%XF_WIN_MASS )) DEALLOCATE(B%CUR%XF_WIN_MASS)
-IF(ASSOCIATED(B%CUR%XF_WIN_WALL )) DEALLOCATE(B%CUR%XF_WIN_WALL)
-IF(ASSOCIATED(B%CUR%XF_MASS_FLOOR )) DEALLOCATE(B%CUR%XF_MASS_FLOOR)
-IF(ASSOCIATED(B%CUR%XF_MASS_WALL )) DEALLOCATE(B%CUR%XF_MASS_WALL)
-IF(ASSOCIATED(B%CUR%XF_MASS_WIN )) DEALLOCATE(B%CUR%XF_MASS_WIN)
-IF(ASSOCIATED(B%CUR%XTI_BLD )) DEALLOCATE(B%CUR%XTI_BLD)
-IF(ASSOCIATED(B%CUR%XQI_BLD )) DEALLOCATE(B%CUR%XQI_BLD)
-IF(ASSOCIATED(B%CUR%XT_FLOOR )) DEALLOCATE(B%CUR%XT_FLOOR)
-IF(ASSOCIATED(B%CUR%XT_MASS )) DEALLOCATE(B%CUR%XT_MASS)
-IF(ASSOCIATED(B%CUR%XAUX_MAX )) DEALLOCATE(B%CUR%XAUX_MAX)
-IF(ASSOCIATED(B%CUR%XT_WIN2 )) DEALLOCATE(B%CUR%XT_WIN2)
-IF(ASSOCIATED(B%CUR%XT_WIN1 )) DEALLOCATE(B%CUR%XT_WIN1)
+CALL DIAG_NP_INIT(GDM%VD%ND,0)
+CALL DIAG_EVAP_ISBA_NP_INIT(GDM%VD%NDE,0)
+CALL DIAG_EVAP_ISBA_NP_INIT(GDM%VD%NDEC,0)
+CALL DIAG_MISC_ISBA_NP_INIT(GDM%VD%NDM,0)
+ !
+CALL DATA_ISBA_INIT(GDM%DTV)
+CALL ISBA_OPTIONS_INIT(GDM%O)
+CALL ISBA_S_INIT(GDM%S)
+CALL GR_BIOG_INIT(GDM%GB)
+CALL ISBA_K_INIT(GDM%K)
+CALL ISBA_P_INIT(GDM%P)
+!
+CALL ISBA_NPE_INIT(GDM%NPE,0)
+!
+CALL DIAG_NP_INIT(GRM%VD%ND,0)
+CALL DIAG_EVAP_ISBA_NP_INIT(GRM%VD%NDE,0)
+CALL DIAG_EVAP_ISBA_NP_INIT(GRM%VD%NDEC,0)
+CALL DIAG_MISC_ISBA_NP_INIT(GRM%VD%NDM,0)
+ !
+CALL DATA_ISBA_INIT(GRM%DTV)
+CALL ISBA_OPTIONS_INIT(GRM%O)
+CALL ISBA_S_INIT(GRM%S)
+CALL GR_BIOG_INIT(GRM%GB)
+CALL ISBA_K_INIT(GRM%K)
+CALL ISBA_P_INIT(GRM%P)
+!
+CALL ISBA_NPE_INIT(GRM%NPE,0)
+!
+!
+CALL DIAG_OPTIONS_INIT(TM%TD%O)
+CALL DIAG_INIT(TM%TD%D)
+CALL DIAG_MISC_TEB_OPTIONS_INIT(TM%TD%MTO)
+CALL DIAG_UTCI_TEB_INIT(TM%TD%DUT)
+!
+CALL DIAG_MISC_TEB_NP_INIT(TM%TD%NDMT,0)
+CALL DIAG_MISC_TEB_NP_INIT(TM%TD%NDMTC,0)
+!
+CALL DATA_TEB_INIT(TM%DTT)
+CALL TEB_OPTIONS_INIT(TM%TOP)
+CALL CANOPY_INIT(TM%SB)
+CALL GRID_INIT(TM%G)
+CALL CH_TEB_INIT(TM%CHT)
+CALL TEB_PANEL_INIT(TM%TPN)
+CALL TEB_IRRIG_INIT(TM%TIR)
+!
+CALL TEB_NP_INIT(TM%NT,0)
+!
+CALL DATA_BEM_INIT(TM%DTB)
+CALL BEM_OPTIONS_INIT(TM%BOP)
+CALL BLD_DESC_INIT(TM%BDD)
+!
+CALL BEM_NP_INIT(TM%NB,0)
!
!
IF (LHOOK) CALL DR_HOOK('DEALLOC_TEB_N',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/dealloc_townn.F90 b/src/SURFEX/dealloc_townn.F90
index 6777520232a4dc49720baf98562c97c7677afe4e..a641a0ed602896e042a6f22a332b0cad5834c400 100644
--- a/src/SURFEX/dealloc_townn.F90
+++ b/src/SURFEX/dealloc_townn.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE DEALLOC_TOWN_n (B, CHT, DTT, U, TG, T, TOP, TPN)
+SUBROUTINE DEALLOC_TOWN_n (TM, GDM, GRM, U)
! ###############################################################################
!
!!**** *DEALLOC_TOWN_n * - Deallocate all arrays
@@ -27,20 +27,9 @@ SUBROUTINE DEALLOC_TOWN_n (B, CHT, DTT, U, TG, T, TOP, TPN)
!! Original 01/2004
!!------------------------------------------------------------------
!
-
-!
-!
-!
-!
+USE MODD_SURFEX_n, ONLY : TEB_MODEL_t, TEB_GARDEN_MODEL_t, TEB_GREENROOF_MODEL_t
!
-USE MODD_BEM_n, ONLY : BEM_t
-USE MODD_CH_TEB_n, ONLY : CH_TEB_t
-USE MODD_DATA_TEB_n, ONLY : DATA_TEB_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
-USE MODD_TEB_n, ONLY : TEB_t
-USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-USE MODD_TEB_PANEL_n, ONLY : TEB_PANEL_t
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -53,27 +42,21 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM
+TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
+TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
!* 0.2 declarations of local variables
!
!-------------------------------------------------------------------------------------
!
-
-!
-TYPE(BEM_t), INTENT(INOUT) :: B
-TYPE(CH_TEB_t), INTENT(INOUT) :: CHT
-TYPE(DATA_TEB_t), INTENT(INOUT) :: DTT
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
-TYPE(TEB_t), INTENT(INOUT) :: T
-TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
-TYPE(TEB_PANEL_t), INTENT(INOUT) :: TPN
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('DEALLOC_TOWN_N',0,ZHOOK_HANDLE)
IF (U%CTOWN=='TEB ') THEN
- CALL DEALLOC_TEB_n(B, CHT, DTT, TG, T, TOP, TPN)
+ CALL DEALLOC_TEB_n(TM, GDM, GRM)
ELSE IF (U%CTOWN=='FLUX ') THEN
CALL DEALLOC_IDEAL_FLUX
END IF
diff --git a/src/SURFEX/dealloc_watfluxn.F90 b/src/SURFEX/dealloc_watfluxn.F90
index 04a996cd3e770b82e7d38190157e5643c9916c2c..35a1ab2fca6c5ef3ed08758939bd4159c21ebd18 100644
--- a/src/SURFEX/dealloc_watfluxn.F90
+++ b/src/SURFEX/dealloc_watfluxn.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #################################################################################
-SUBROUTINE DEALLOC_WATFLUX_n (CHW, WG, W)
+SUBROUTINE DEALLOC_WATFLUX_n (WM)
! #################################################################################
!
!!**** *DEALLOC_WATFLUX_n * - Deallocate all arrays
@@ -27,15 +27,15 @@ SUBROUTINE DEALLOC_WATFLUX_n (CHW, WG, W)
!! Original 01/2004
!!------------------------------------------------------------------
!
-
+USE MODD_SURFEX_n, ONLY : WATFLUX_MODEL_t
!
-
-
+USE MODD_DIAG_n, ONLY : DIAG_INIT, DIAG_OPTIONS_INIT
!
+USE MODD_CH_WATFLUX_n, ONLY : CH_WATFLUX_INIT
+USE MODD_WATFLUX_n, ONLY : WATFLUX_INIT
!
-USE MODD_CH_WATFLUX_n, ONLY : CH_WATFLUX_t
-USE MODD_WATFLUX_GRID_n, ONLY : WATFLUX_GRID_t
-USE MODD_WATFLUX_n, ONLY : WATFLUX_t
+USE MODD_SFX_GRID_n, ONLY : GRID_INIT
+USE MODD_CANOPY_n, ONLY : CANOPY_INIT
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -49,48 +49,21 @@ IMPLICIT NONE
!
!-------------------------------------------------------------------------------------
!
-
-!
-TYPE(CH_WATFLUX_t), INTENT(INOUT) :: CHW
-TYPE(WATFLUX_GRID_t), INTENT(INOUT) :: WG
-TYPE(WATFLUX_t), INTENT(INOUT) :: W
+TYPE(WATFLUX_MODEL_t), INTENT(INOUT) :: WM
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('DEALLOC_WATFLUX_N',0,ZHOOK_HANDLE)
-IF (ASSOCIATED(W%LCOVER )) DEALLOCATE(W%LCOVER )
-IF (ASSOCIATED(W%XCOVER )) DEALLOCATE(W%XCOVER )
-IF (ASSOCIATED(W%XZS )) DEALLOCATE(W%XZS )
-IF (ASSOCIATED(W%XTS )) DEALLOCATE(W%XTS )
-IF (ASSOCIATED(W%XZ0 )) DEALLOCATE(W%XZ0 )
-IF (ASSOCIATED(W%XEMIS )) DEALLOCATE(W%XEMIS )
-!
-IF (ASSOCIATED(W%XDIR_ALB)) DEALLOCATE(W%XDIR_ALB)
-IF (ASSOCIATED(W%XSCA_ALB)) DEALLOCATE(W%XSCA_ALB)
!
-!-------------------------------------------------------------------------------------
-!
-IF (ASSOCIATED(WG%XGRID_PAR )) DEALLOCATE(WG%XGRID_PAR )
-IF (ASSOCIATED(WG%XLAT )) DEALLOCATE(WG%XLAT )
-IF (ASSOCIATED(WG%XLON )) DEALLOCATE(WG%XLON )
-IF (ASSOCIATED(WG%XMESH_SIZE)) DEALLOCATE(WG%XMESH_SIZE)
-!
-!-------------------------------------------------------------------------------------
-!
-IF(ASSOCIATED(CHW%XDEP)) DEALLOCATE(CHW%XDEP)
-IF(ASSOCIATED(CHW%CCH_NAMES)) DEALLOCATE(CHW%CCH_NAMES)
-IF(ASSOCIATED(CHW%SVW%CSV)) DEALLOCATE(CHW%SVW%CSV)
-!
-!-------------------------------------------------------------------------------------
+CALL DIAG_OPTIONS_INIT(WM%DWO)
+CALL DIAG_INIT(WM%DW)
+CALL DIAG_INIT(WM%DWC)
+!
+CALL GRID_INIT(WM%G)
+CALL CANOPY_INIT(WM%SB)
+CALL CH_WATFLUX_INIT(WM%CHW)
+CALL WATFLUX_INIT(WM%W)
!
-IF(ASSOCIATED(W%XCPL_WATER_WIND)) DEALLOCATE(W%XCPL_WATER_WIND)
-IF(ASSOCIATED(W%XCPL_WATER_FWSU)) DEALLOCATE(W%XCPL_WATER_FWSU)
-IF(ASSOCIATED(W%XCPL_WATER_FWSV)) DEALLOCATE(W%XCPL_WATER_FWSV)
-IF(ASSOCIATED(W%XCPL_WATER_SNET)) DEALLOCATE(W%XCPL_WATER_SNET)
-IF(ASSOCIATED(W%XCPL_WATER_HEAT)) DEALLOCATE(W%XCPL_WATER_HEAT)
-IF(ASSOCIATED(W%XCPL_WATER_EVAP)) DEALLOCATE(W%XCPL_WATER_EVAP)
-IF(ASSOCIATED(W%XCPL_WATER_RAIN)) DEALLOCATE(W%XCPL_WATER_RAIN)
-IF(ASSOCIATED(W%XCPL_WATER_SNOW)) DEALLOCATE(W%XCPL_WATER_SNOW)
IF (LHOOK) CALL DR_HOOK('DEALLOC_WATFLUX_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/deepsoil_update.F90 b/src/SURFEX/deepsoil_update.F90
index 50193ffec222624dad206e439149c167737a6514..e5cfaf347f8c05a2071da64b8f28149e9cdcaca9 100644
--- a/src/SURFEX/deepsoil_update.F90
+++ b/src/SURFEX/deepsoil_update.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DEEPSOIL_UPDATE (I, &
- KMONTH)
+ SUBROUTINE DEEPSOIL_UPDATE (PTDEEP, PGAMMAT, KMONTH)
! ###############################################################
!!**** *DEEPSOIL_UPDATE*
!!
@@ -43,9 +42,6 @@
!* 0. DECLARATIONS
! ------------
!
-!
-USE MODD_ISBA_n, ONLY : ISBA_t
-!
USE MODD_DEEPSOIL, ONLY : XTDEEP_CLI, XGAMMAT_CLI
!
!
@@ -57,8 +53,8 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-!
-TYPE(ISBA_t), INTENT(INOUT) :: I
+REAL, DIMENSION(:), INTENT(INOUT) :: PTDEEP
+REAL, DIMENSION(:), INTENT(INOUT) :: PGAMMAT
!
INTEGER, INTENT(IN) :: KMONTH ! current month
!
@@ -69,11 +65,11 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-----------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('DEEPSOIL_UPDATE',0,ZHOOK_HANDLE)
-DO IP=1,SIZE(I%XTDEEP)
+DO IP=1,SIZE(PTDEEP)
!
- I%XTDEEP (IP) = XTDEEP_CLI (KMONTH)
+ PTDEEP (IP) = XTDEEP_CLI (KMONTH)
!
- I%XGAMMAT(IP) = 1. / XGAMMAT_CLI(KMONTH)
+ PGAMMAT(IP) = 1. / XGAMMAT_CLI(KMONTH)
!
ENDDO
IF (LHOOK) CALL DR_HOOK('DEEPSOIL_UPDATE',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/default_assim.F90 b/src/SURFEX/default_assim.F90
index 5be7cde6c7551d7339f71ea5b1648724a277c46a..715870d263fc20546d2b242f792b2fe7dee974f9 100644
--- a/src/SURFEX/default_assim.F90
+++ b/src/SURFEX/default_assim.F90
@@ -1,244 +1,247 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE DEFAULT_ASSIM(OASSIM,HASSIM,HASSIM_ISBA,KPRINTLEV, &
- OAROME,OECSST,OAESST,OAESNM, &
- OALADSURF,OREAD_SST_FROM_FILE, &
- HFILE_FORMAT_SST,OEXTRAP_SEA, &
- OEXTRAP_WATER,OEXTRAP_NATURE, &
- OWATERTG2,KBOUTPUT,KECHGU,PRCLIMCA, &
- PRCLISST,PSIGH2MO,PSIGT2MO,PSIGWGO, &
- PSIGWGB,PSIGW2B,OOBSWG,OOBS2M,OIMVEG, &
- PSPRECIP2,PRTHR_QC,PSIGWGO_MAX, &
- PRSCAL_JAC,OPRT,OSIM,OBEV,OBFIXED, &
- KOBSTYPE,OOBSHEADER,HFILE_FORMAT_OBS,OOBSNAT,&
- HFILE_FORMAT_FG,HFILE_FORMAT_LSM, &
- HFILE_FORMAT_CLIM,PERROBS_M,PQCOBS_M, &
- KNCO,KIVAR,KVAR,HVAR_M,HPREFIX_M, &
- PSIGMA_M,PTPRT_M,KNCV,PSCALE_Q, &
- PSCALE_QLAI,HBIO,HPREFIX_BIO,PALPH, &
- KENS,KIE,PINFL_M,PADDINFL_M, PASSIM_WINH, &
- PADDTIMECORR_M,OENS_GEN,OPB_CORRELATIONS, &
- OPERTURBATION_RUN,OBIAS_CORRECTION, &
- OENKF,ODENKF,HTEST)
-! ########################################################################
-!
-!!**** *DEFAULT_ISBA* - routine to set default values for the configuration for ISBA assimilation scheme
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! L. Jarlan *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 02/2005
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODI_ABOR1_SFX
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODD_ASSIM, ONLY : NOBSMAX, NVARMAX
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-LOGICAL, INTENT(OUT) :: OASSIM ! assimilation or not
- CHARACTER(LEN=5), INTENT(OUT) :: HASSIM ! type of corrections PLUS/2DVAR
- CHARACTER(LEN=5), INTENT(OUT) :: HASSIM_ISBA
-INTEGER, INTENT(OUT) :: KPRINTLEV
-LOGICAL, INTENT(OUT) :: OAROME
-LOGICAL, INTENT(OUT) :: OECSST
-LOGICAL, INTENT(OUT) :: OAESST
-LOGICAL, INTENT(OUT) :: OAESNM
-LOGICAL, INTENT(OUT) :: OALADSURF
-LOGICAL, INTENT(OUT) :: OREAD_SST_FROM_FILE
- CHARACTER(LEN=6), INTENT(OUT) :: HFILE_FORMAT_SST
-LOGICAL, INTENT(OUT) :: OEXTRAP_SEA
-LOGICAL, INTENT(OUT) :: OEXTRAP_WATER
-LOGICAL, INTENT(OUT) :: OEXTRAP_NATURE
-LOGICAL, INTENT(OUT) :: OWATERTG2
-INTEGER, INTENT(OUT) :: KBOUTPUT
-!
-INTEGER, INTENT(OUT) :: KECHGU
-REAL, INTENT(OUT) :: PRCLIMCA
-REAL, INTENT(OUT) :: PRCLISST
-REAL, INTENT(OUT) :: PSIGH2MO
-REAL, INTENT(OUT) :: PSIGT2MO
-REAL, INTENT(OUT) :: PSIGWGO
-REAL, INTENT(OUT) :: PSIGWGB
-REAL, INTENT(OUT) :: PSIGW2B
-LOGICAL, INTENT(OUT) :: OOBSWG
-LOGICAL, INTENT(OUT) :: OOBS2M
-LOGICAL, INTENT(OUT) :: OIMVEG
-REAL, INTENT(OUT) :: PSPRECIP2
-REAL, INTENT(OUT) :: PRTHR_QC
-REAL, INTENT(OUT) :: PSIGWGO_MAX
-REAL, INTENT(OUT) :: PRSCAL_JAC
-!
-LOGICAL, INTENT(OUT) :: OPRT
-LOGICAL, INTENT(OUT) :: OSIM
-LOGICAL, INTENT(OUT) :: OBEV
-LOGICAL, INTENT(OUT) :: OBFIXED
-!
-INTEGER, INTENT(OUT) :: KOBSTYPE
-LOGICAL, INTENT(OUT) :: OOBSHEADER
- CHARACTER(LEN=6), INTENT(OUT) :: HFILE_FORMAT_OBS
- CHARACTER(LEN=6), INTENT(OUT) :: HFILE_FORMAT_FG
- CHARACTER(LEN=6), INTENT(OUT) :: HFILE_FORMAT_LSM
- CHARACTER(LEN=6), INTENT(OUT) :: HFILE_FORMAT_CLIM
-REAL, DIMENSION(NOBSMAX), INTENT(OUT) :: PERROBS_M
-REAL, DIMENSION(NOBSMAX), INTENT(OUT) :: PQCOBS_M
-INTEGER, DIMENSION(NOBSMAX), INTENT(OUT) :: KNCO
-LOGICAL, INTENT(OUT) :: OOBSNAT
-!
-INTEGER, INTENT(OUT) :: KIVAR
-INTEGER, INTENT(OUT) :: KVAR
- CHARACTER(LEN=3), DIMENSION(NVARMAX), INTENT(OUT) :: HVAR_M
- CHARACTER(LEN=100), DIMENSION(NVARMAX), INTENT(OUT) :: HPREFIX_M
-REAL, DIMENSION(NVARMAX), INTENT(OUT) :: PSIGMA_M
-REAL, DIMENSION(NVARMAX), INTENT(OUT) :: PTPRT_M
-INTEGER, DIMENSION(NVARMAX), INTENT(OUT) :: KNCV
-REAL, INTENT(OUT) :: PSCALE_Q
-REAL, INTENT(OUT) :: PSCALE_QLAI
- CHARACTER(LEN=LEN_HREC), INTENT(OUT) :: HBIO
- CHARACTER(LEN=100), INTENT(OUT) :: HPREFIX_BIO
-REAL, DIMENSION(12), INTENT(OUT) :: PALPH
-!
-INTEGER, INTENT(OUT) :: KENS
-INTEGER, INTENT(OUT) :: KIE
-REAL, INTENT(OUT) :: PASSIM_WINH
-REAL, DIMENSION(NVARMAX),INTENT(OUT) :: PINFL_M
-REAL, DIMENSION(NVARMAX),INTENT(OUT) :: PADDINFL_M
-REAL, DIMENSION(NVARMAX),INTENT(OUT) :: PADDTIMECORR_M
-LOGICAL, INTENT(OUT) :: OENKF
-LOGICAL, INTENT(OUT) :: ODENKF
-LOGICAL, INTENT(OUT) :: OENS_GEN
-LOGICAL, INTENT(OUT) :: OPB_CORRELATIONS
-LOGICAL, INTENT(OUT) :: OPERTURBATION_RUN
-LOGICAL, INTENT(OUT) :: OBIAS_CORRECTION
- CHARACTER(LEN=2), INTENT(IN) :: HTEST
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('DEFAULT_ASSIM',0,ZHOOK_HANDLE)
-
-IF (HTEST/='OK') THEN
- CALL ABOR1_SFX('default_assim: FATAL ERROR DURING ARGUMENT TRANSFER')
-END IF
-
-!
-OASSIM = .FALSE.
-HASSIM = "PLUS "
-HASSIM_ISBA = "OI"
-KPRINTLEV = 0
-OAROME = .TRUE.
-OECSST = .FALSE.
-OAESST = .FALSE.
-OAESNM = .FALSE.
-OALADSURF = .TRUE.
-OREAD_SST_FROM_FILE=.FALSE.
-HFILE_FORMAT_SST = "FA "
-OEXTRAP_SEA = .TRUE.
-OEXTRAP_WATER = .TRUE.
-OEXTRAP_NATURE = .FALSE.
-OWATERTG2 = .FALSE.
-
-KBOUTPUT = 1
-!
-KECHGU = 6
-! RCLIMCA : coef. de rappel vers la climatologie des champs de surface
-! RCLISST : coef. de rappel vers la climatologie de SST
-!PRCLIMCA=0.045
-PRCLIMCA = 0. ! no climatology relaxation
-!PRCLISST=0.05 ! as in the original cacsts
-PRCLISST = 0.05
-!*** SIGT2MO : ecart-type d'erreur "d'observation" sur T2m
-!*** SIGH2MO : ecart-type d'erreur "d'observation" sur Hu2m
-PSIGH2MO = 0.1 ! observation error for HU2m
-PSIGT2MO = 1.0 ! observation error for T2m
-PSIGWGO = 0.06 ! observation error for WG
-PSIGWGB = 0.06 ! background error for WG
-PSIGW2B = 0.03 ! background error for W2
-OOBSWG = .TRUE. ! assimilation of WG
-OOBS2M = .FALSE. ! assimilation of T2M + RH2M (with WG)
-! LIMVEG : activation de la limitation a wp > veg*wwilt
-!*** LIMVEG : si wp >= veg*wwilt
-OIMVEG = .TRUE.
-PSPRECIP2 = 4.0
-PRTHR_QC = 3.0
-PSIGWGO_MAX = 6.0 ! maximum acceptable WG obs error (%)
-PRSCAL_JAC = 4.0 ! to modify the "effective" assimilation window
-!
-! Initialization of EKF
-OPRT = .FALSE.
-OSIM = .FALSE.
-OBEV = .TRUE.
-OBFIXED = .FALSE.
-!
-KOBSTYPE = 2
-OOBSHEADER = .FALSE.
-HFILE_FORMAT_OBS = "FA "
-HFILE_FORMAT_FG = "FA "
-HFILE_FORMAT_LSM = "FA "
-HFILE_FORMAT_CLIM = "FA "
-PERROBS_M = (/1.0,0.1,0.4,0.2,0.1/)
-PQCOBS_M = (/999.,999.,999.,999.,999./)
-KNCO = (/1,1,0,0,0/)
-OOBSNAT = .FALSE.
-!
-KIVAR = 1
-KVAR = 4
-HVAR_M = (/"WG2","WG1","TG2","TG1","LAI"/)
-HPREFIX_M = (/"","","","",""/)
-PSIGMA_M = (/0.15,0.1,2.0,2.0,0.2/)
-PTPRT_M = (/0.0001,0.0001,0.00001,0.00001,0.001/)
-KNCV = (/1,1,1,1,1/)
-PSCALE_Q = 0.125
-PSCALE_QLAI = 0.5
-HBIO = "BIOMA1"
-HPREFIX_BIO = ""
-PALPH = (/0., 0., 0., 0.08203445, 0.07496252, 0.06846970, 0.06771856, 0.09744689, &
- 0.09744689, 0.07164350, 0.17686594, 0.07164350/)
-!
-KENS = 1
-KIE = 0
-PASSIM_WINH = 24
-PINFL_M = (/0.,0.,0.,0.,0./)
-PADDINFL_M = (/0.,0.,0.,0.,0./)
-PADDTIMECORR_M = (/0.,0.,0.,0.,0./)
-OENKF = .FALSE.
-ODENKF = .FALSE.
-OENS_GEN = .TRUE.
-OPB_CORRELATIONS = .FALSE.
-OPERTURBATION_RUN = .FALSE.
-OBIAS_CORRECTION = .FALSE.
-!
-IF (LHOOK) CALL DR_HOOK('DEFAULT_ASSIM',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE DEFAULT_ASSIM
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE DEFAULT_ASSIM(OASSIM,HASSIM,HASSIM_ISBA,KPRINTLEV, &
+ OAROME,OECSST,OAESST,OAESNM, &
+ OALADSURF,OREAD_SST_FROM_FILE, &
+ HFILE_FORMAT_SST,OEXTRAP_SEA, &
+ OEXTRAP_WATER,OEXTRAP_NATURE, &
+ OWATERTG2,KBOUTPUT,KECHGU,PRCLIMCA, &
+ PRCLISST,PSIGH2MO,PSIGT2MO,PSIGWGO, &
+ PSIGWGB,PSIGW2B,OOBSWG,OOBS2M,OIMVEG, &
+ PSPRECIP2,PRTHR_QC,PSIGWGO_MAX, &
+ PRSCAL_JAC,OPRT,OSIM,OBEV,OBFIXED, &
+ KOBSTYPE,OOBSHEADER,HFILE_FORMAT_OBS,OOBSNAT,&
+ HFILE_FORMAT_FG,HFILE_FORMAT_LSM, &
+ HFILE_FORMAT_CLIM,HOBS_M,PERROBS_M,PQCOBS_M, &
+ KNCO,KIVAR,KVAR,HVAR_M,HPREFIX_M, &
+ PSIGMA_M,PTPRT_M,KNCV,PSCALE_Q, &
+ PSCALE_QLAI,HBIO,HPREFIX_BIO,PALPH, &
+ KENS,KIE,PINFL_M,PADDINFL_M, PASSIM_WINH, &
+ PADDTIMECORR_M,OENS_GEN,OPB_CORRELATIONS, &
+ OPERTURBATION_RUN,OBIAS_CORRECTION, &
+ OENKF,ODENKF,HTEST)
+! ########################################################################
+!
+!!**** *DEFAULT_ISBA* - routine to set default values for the configuration for ISBA assimilation scheme
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! L. Jarlan *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 02/2005
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODD_ASSIM, ONLY : NOBSMAX, NVARMAX
+!
+USE MODI_ABOR1_SFX
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+LOGICAL, INTENT(OUT) :: OASSIM ! assimilation or not
+CHARACTER(LEN=5), INTENT(OUT) :: HASSIM ! type of corrections PLUS/2DVAR
+CHARACTER(LEN=5), INTENT(OUT) :: HASSIM_ISBA
+INTEGER, INTENT(OUT) :: KPRINTLEV
+LOGICAL, INTENT(OUT) :: OAROME
+LOGICAL, INTENT(OUT) :: OECSST
+LOGICAL, INTENT(OUT) :: OAESST
+LOGICAL, INTENT(OUT) :: OAESNM
+LOGICAL, INTENT(OUT) :: OALADSURF
+LOGICAL, INTENT(OUT) :: OREAD_SST_FROM_FILE
+CHARACTER(LEN=6), INTENT(OUT) :: HFILE_FORMAT_SST
+LOGICAL, INTENT(OUT) :: OEXTRAP_SEA
+LOGICAL, INTENT(OUT) :: OEXTRAP_WATER
+LOGICAL, INTENT(OUT) :: OEXTRAP_NATURE
+LOGICAL, INTENT(OUT) :: OWATERTG2
+INTEGER, INTENT(OUT) :: KBOUTPUT
+!
+INTEGER, INTENT(OUT) :: KECHGU
+REAL, INTENT(OUT) :: PRCLIMCA
+REAL, INTENT(OUT) :: PRCLISST
+REAL, INTENT(OUT) :: PSIGH2MO
+REAL, INTENT(OUT) :: PSIGT2MO
+REAL, INTENT(OUT) :: PSIGWGO
+REAL, INTENT(OUT) :: PSIGWGB
+REAL, INTENT(OUT) :: PSIGW2B
+LOGICAL, INTENT(OUT) :: OOBSWG
+LOGICAL, INTENT(OUT) :: OOBS2M
+LOGICAL, INTENT(OUT) :: OIMVEG
+REAL, INTENT(OUT) :: PSPRECIP2
+REAL, INTENT(OUT) :: PRTHR_QC
+REAL, INTENT(OUT) :: PSIGWGO_MAX
+REAL, INTENT(OUT) :: PRSCAL_JAC
+!
+LOGICAL, INTENT(OUT) :: OPRT
+LOGICAL, INTENT(OUT) :: OSIM
+LOGICAL, INTENT(OUT) :: OBEV
+LOGICAL, INTENT(OUT) :: OBFIXED
+!
+INTEGER, INTENT(OUT) :: KOBSTYPE
+LOGICAL, INTENT(OUT) :: OOBSHEADER
+CHARACTER(LEN=6), INTENT(OUT) :: HFILE_FORMAT_OBS
+CHARACTER(LEN=6), INTENT(OUT) :: HFILE_FORMAT_FG
+CHARACTER(LEN=6), INTENT(OUT) :: HFILE_FORMAT_LSM
+CHARACTER(LEN=6), INTENT(OUT) :: HFILE_FORMAT_CLIM
+CHARACTER(LEN=10), DIMENSION(NOBSMAX), INTENT(OUT) :: HOBS_M
+REAL, DIMENSION(NOBSMAX), INTENT(OUT) :: PERROBS_M
+REAL, DIMENSION(NOBSMAX), INTENT(OUT) :: PQCOBS_M
+INTEGER, DIMENSION(NOBSMAX), INTENT(OUT) :: KNCO
+LOGICAL, INTENT(OUT) :: OOBSNAT
+!
+INTEGER, INTENT(OUT) :: KIVAR
+INTEGER, INTENT(OUT) :: KVAR
+CHARACTER(LEN=3), DIMENSION(NVARMAX), INTENT(OUT) :: HVAR_M
+CHARACTER(LEN=100), DIMENSION(NVARMAX), INTENT(OUT) :: HPREFIX_M
+REAL, DIMENSION(NVARMAX), INTENT(OUT) :: PSIGMA_M
+REAL, DIMENSION(NVARMAX), INTENT(OUT) :: PTPRT_M
+INTEGER, DIMENSION(NVARMAX), INTENT(OUT) :: KNCV
+REAL, INTENT(OUT) :: PSCALE_Q
+REAL, INTENT(OUT) :: PSCALE_QLAI
+CHARACTER(LEN=LEN_HREC), INTENT(OUT) :: HBIO
+CHARACTER(LEN=100), INTENT(OUT) :: HPREFIX_BIO
+REAL, DIMENSION(12), INTENT(OUT) :: PALPH
+!
+INTEGER, INTENT(OUT) :: KENS
+INTEGER, INTENT(OUT) :: KIE
+REAL, INTENT(OUT) :: PASSIM_WINH
+REAL, DIMENSION(NVARMAX),INTENT(OUT) :: PINFL_M
+REAL, DIMENSION(NVARMAX),INTENT(OUT) :: PADDINFL_M
+REAL, DIMENSION(NVARMAX),INTENT(OUT) :: PADDTIMECORR_M
+LOGICAL, INTENT(OUT) :: OENKF
+LOGICAL, INTENT(OUT) :: ODENKF
+LOGICAL, INTENT(OUT) :: OENS_GEN
+LOGICAL, INTENT(OUT) :: OPB_CORRELATIONS
+LOGICAL, INTENT(OUT) :: OPERTURBATION_RUN
+LOGICAL, INTENT(OUT) :: OBIAS_CORRECTION
+CHARACTER(LEN=2), INTENT(IN) :: HTEST
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('DEFAULT_ASSIM',0,ZHOOK_HANDLE)
+
+IF (HTEST/='OK') THEN
+ CALL ABOR1_SFX('default_assim: FATAL ERROR DURING ARGUMENT TRANSFER')
+END IF
+
+!
+OASSIM = .FALSE.
+HASSIM = "PLUS "
+HASSIM_ISBA = "OI"
+KPRINTLEV = 0
+OAROME = .TRUE.
+OECSST = .FALSE.
+OAESST = .FALSE.
+OAESNM = .FALSE.
+OALADSURF = .TRUE.
+OREAD_SST_FROM_FILE=.FALSE.
+HFILE_FORMAT_SST = "FA "
+OEXTRAP_SEA = .TRUE.
+OEXTRAP_WATER = .TRUE.
+OEXTRAP_NATURE = .FALSE.
+OWATERTG2 = .FALSE.
+
+KBOUTPUT = 1
+!
+KECHGU = 6
+! RCLIMCA : coef. de rappel vers la climatologie des champs de surface
+! RCLISST : coef. de rappel vers la climatologie de SST
+!PRCLIMCA=0.045
+PRCLIMCA = 0. ! no climatology relaxation
+!PRCLISST=0.05 ! as in the original cacsts
+PRCLISST = 0.05
+!*** SIGT2MO : ecart-type d'erreur "d'observation" sur T2m
+!*** SIGH2MO : ecart-type d'erreur "d'observation" sur Hu2m
+PSIGH2MO = 0.1 ! observation error for HU2m
+PSIGT2MO = 1.0 ! observation error for T2m
+PSIGWGO = 0.06 ! observation error for WG
+PSIGWGB = 0.06 ! background error for WG
+PSIGW2B = 0.03 ! background error for W2
+OOBSWG = .TRUE. ! assimilation of WG
+OOBS2M = .FALSE. ! assimilation of T2M + RH2M (with WG)
+! LIMVEG : activation de la limitation a wp > veg*wwilt
+!*** LIMVEG : si wp >= veg*wwilt
+OIMVEG = .TRUE.
+PSPRECIP2 = 4.0
+PRTHR_QC = 3.0
+PSIGWGO_MAX = 6.0 ! maximum acceptable WG obs error (%)
+PRSCAL_JAC = 4.0 ! to modify the "effective" assimilation window
+!
+! Initialization of EKF
+OPRT = .FALSE.
+OSIM = .FALSE.
+OBEV = .TRUE.
+OBFIXED = .FALSE.
+!
+KOBSTYPE = 2
+OOBSHEADER = .FALSE.
+HFILE_FORMAT_OBS = "FA "
+HFILE_FORMAT_FG = "FA "
+HFILE_FORMAT_LSM = "FA "
+HFILE_FORMAT_CLIM = "FA "
+HOBS_M = (/"T2M ","HU2M","WG2 ","LAI ","SWE "/)
+PERROBS_M = (/1.0,0.1,0.4,0.2,0.1/)
+PQCOBS_M = (/999.,999.,999.,999.,999./)
+KNCO = (/0,0,0,0,0/)
+OOBSNAT = .FALSE.
+!
+KIVAR = 1
+KVAR = 4
+HVAR_M = (/"WG2","WG1","TG2","TG1","LAI","WG3","WG4","WG5","WG6"/)
+HPREFIX_M = (/"","","","","","","","",""/)
+PSIGMA_M = (/0.15,0.1,2.0,2.0,0.2,0.2,0.2,0.2,0.2/)
+PTPRT_M = (/0.0001,0.0001,0.00001,0.00001,0.001,0.00001,0.0001,0.00001,0.00001/)
+KNCV = (/0,0,0,0,0,0,0,0,0/)
+PSCALE_Q = 0.125
+PSCALE_QLAI = 0.5
+HBIO = "BIOMA1"
+HPREFIX_BIO = ""
+PALPH = (/0., 0., 0., 0.08203445, 0.07496252, 0.06846970, 0.06771856, 0.09744689, &
+ 0.09744689, 0.07164350, 0.17686594, 0.07164350/)
+!
+KENS = 1
+KIE = 0
+PASSIM_WINH = 24
+PINFL_M = (/0.,0.,0.,0.,0.,0.,0.,0.,0./)
+PADDINFL_M = (/0.,0.,0.,0.,0.,0.,0.,0.,0./)
+PADDTIMECORR_M = (/0.,0.,0.,0.,0.,0.,0.,0.,0./)
+OENKF = .FALSE.
+ODENKF = .FALSE.
+OENS_GEN = .TRUE.
+OPB_CORRELATIONS = .FALSE.
+OPERTURBATION_RUN = .FALSE.
+OBIAS_CORRECTION = .FALSE.
+!
+IF (LHOOK) CALL DR_HOOK('DEFAULT_ASSIM',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE DEFAULT_ASSIM
diff --git a/src/SURFEX/default_data_cover.F90 b/src/SURFEX/default_data_cover.F90
index d3d487eb0bc13e40ea23bae85d675ed817abe641..e70fbb26e7f96573455de87cdc19806be0ef584c 100644
--- a/src/SURFEX/default_data_cover.F90
+++ b/src/SURFEX/default_data_cover.F90
@@ -2,15 +2,62 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
-SUBROUTINE DEFAULT_DATA_COVER
+SUBROUTINE DEFAULT_DATA_COVER(PDATA_TOWN,PDATA_NATURE,PDATA_WATER,PDATA_SEA,&
+ PDATA_Z0_TOWN,PDATA_BLD_HEIGHT,PDATA_WALL_O_HOR,PDATA_BLD,PDATA_GARDEN,&
+ PDATA_ALB_ROOF,PDATA_ALB_ROAD,PDATA_ALB_WALL,PDATA_EMIS_ROOF,&
+ PDATA_EMIS_ROAD,PDATA_EMIS_WALL,PDATA_HC_ROOF,PDATA_TC_ROOF,&
+ PDATA_D_ROOF,PDATA_HC_ROAD,PDATA_TC_ROAD,PDATA_D_ROAD,&
+ PDATA_HC_WALL,PDATA_TC_WALL,PDATA_D_WALL,PDATA_H_TRAFFIC,&
+ PDATA_LE_TRAFFIC,PDATA_H_INDUSTRY,PDATA_LE_INDUSTRY,&
+ PDATA_VEGTYPE,PDATA_H_TREE,PDATA_WATSUP,PDATA_IRRIG,&
+ PDATA_ROOT_DEPTH,PDATA_GROUND_DEPTH,PDATA_DICE,TPDATA_SEED,&
+ TPDATA_REAP)
!
+USE MODD_TYPE_DATE_SURF
USE MODD_SURF_PAR
USE MODD_DATA_COVER_PAR
-USE MODD_DATA_COVER
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
IMPLICIT NONE
!
+REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PDATA_TOWN
+REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PDATA_NATURE
+REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PDATA_WATER
+REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PDATA_SEA
+REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PDATA_Z0_TOWN
+REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PDATA_BLD_HEIGHT
+REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PDATA_WALL_O_HOR
+REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PDATA_BLD
+REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PDATA_GARDEN
+REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PDATA_ALB_ROOF
+REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PDATA_ALB_ROAD
+REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PDATA_ALB_WALL
+REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PDATA_EMIS_ROOF
+REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PDATA_EMIS_ROAD
+REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PDATA_EMIS_WALL
+REAL, DIMENSION(:,:), INTENT(INOUT), OPTIONAL :: PDATA_HC_ROOF
+REAL, DIMENSION(:,:), INTENT(INOUT), OPTIONAL :: PDATA_TC_ROOF
+REAL, DIMENSION(:,:), INTENT(INOUT), OPTIONAL :: PDATA_D_ROOF
+REAL, DIMENSION(:,:), INTENT(INOUT), OPTIONAL :: PDATA_HC_ROAD
+REAL, DIMENSION(:,:), INTENT(INOUT), OPTIONAL :: PDATA_TC_ROAD
+REAL, DIMENSION(:,:), INTENT(INOUT), OPTIONAL :: PDATA_D_ROAD
+REAL, DIMENSION(:,:), INTENT(INOUT), OPTIONAL :: PDATA_HC_WALL
+REAL, DIMENSION(:,:), INTENT(INOUT), OPTIONAL :: PDATA_TC_WALL
+REAL, DIMENSION(:,:), INTENT(INOUT), OPTIONAL :: PDATA_D_WALL
+REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PDATA_H_TRAFFIC
+REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PDATA_LE_TRAFFIC
+REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PDATA_H_INDUSTRY
+REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PDATA_LE_INDUSTRY
+REAL, DIMENSION(:,:), INTENT(INOUT), OPTIONAL :: PDATA_VEGTYPE
+REAL, DIMENSION(:,:), INTENT(INOUT), OPTIONAL :: PDATA_H_TREE
+REAL, DIMENSION(:,:), INTENT(INOUT), OPTIONAL :: PDATA_WATSUP
+REAL, DIMENSION(:,:), INTENT(INOUT), OPTIONAL :: PDATA_IRRIG
+REAL, DIMENSION(:,:), INTENT(INOUT), OPTIONAL :: PDATA_ROOT_DEPTH
+REAL, DIMENSION(:,:), INTENT(INOUT), OPTIONAL :: PDATA_GROUND_DEPTH
+REAL, DIMENSION(:,:), INTENT(INOUT), OPTIONAL :: PDATA_DICE
+TYPE(DATE_TIME), DIMENSION(:,:), INTENT(INOUT), OPTIONAL :: TPDATA_SEED
+TYPE(DATE_TIME), DIMENSION(:,:), INTENT(INOUT), OPTIONAL :: TPDATA_REAP
+!
!* Declaration of local variables
! ------------------------------
!
@@ -20,7 +67,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('DEFAULT_DATA_COVER',0,ZHOOK_HANDLE)
!
-XDATA_TOWN(:) = (/ &
+IF (PRESENT(PDATA_TOWN)) THEN
+PDATA_TOWN(:) = (/ &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 1.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
@@ -80,8 +128,10 @@ XDATA_TOWN(:) = (/ &
1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, &
1.00, 0.00, 0.01 &
/)
-!-------------------------------------------------------------------
-XDATA_NATURE(:) = (/ &
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_NATURE)) THEN
+PDATA_NATURE(:) = (/ &
0.00, 0.00, 0.00, 1.00, 1.00, 1.00, 0.00, 1.00, 1.00, 1.00, &
1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, &
1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, &
@@ -141,8 +191,10 @@ XDATA_NATURE(:) = (/ &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 1.00, 0.99 &
/)
-!-------------------------------------------------------------------
-XDATA_WATER(:) = (/ &
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_WATER)) THEN
+PDATA_WATER(:) = (/ &
0.00, 1.00, 1.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
@@ -202,8 +254,10 @@ XDATA_WATER(:) = (/ &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00 &
/)
-!-------------------------------------------------------------------
-XDATA_SEA(:) = (/ &
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_SEA)) THEN
+PDATA_SEA(:) = (/ &
1.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
@@ -263,194 +317,244 @@ XDATA_SEA(:) = (/ &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00 &
/)
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_Z0_TOWN(:) = 1.000
-XDATA_Z0_TOWN(151) = 3.000
-XDATA_Z0_TOWN(155) = 2.000
-XDATA_Z0_TOWN(156) = 0.500
-XDATA_Z0_TOWN(157) = 2.000
-XDATA_Z0_TOWN(158) = 0.010
-XDATA_Z0_TOWN(159) = 0.100
-XDATA_Z0_TOWN(160) = 0.500
-XDATA_Z0_TOWN(254) = 2.000
-XDATA_Z0_TOWN(255) = 2.000
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_BLD_HEIGHT(:) = 10.
-XDATA_BLD_HEIGHT(151) = 30.
-XDATA_BLD_HEIGHT(155) = 20.
-XDATA_BLD_HEIGHT(156) = 5.
-XDATA_BLD_HEIGHT(157) = 20.
-XDATA_BLD_HEIGHT(159) = 5.
-XDATA_BLD_HEIGHT(160) = 5.
-XDATA_BLD_HEIGHT(254) = 20.
-XDATA_BLD_HEIGHT(255) = 20.
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_WALL_O_HOR(:) =0.50
-XDATA_WALL_O_HOR( 7) =0.30
-XDATA_WALL_O_HOR(151) =0.90
-XDATA_WALL_O_HOR(152) =0.30
-XDATA_WALL_O_HOR(153) =0.30
-XDATA_WALL_O_HOR(154) =0.30
-XDATA_WALL_O_HOR(155) =0.45
-XDATA_WALL_O_HOR(156) =0.09
-XDATA_WALL_O_HOR(157) =0.90
-XDATA_WALL_O_HOR(158) =0.10
-XDATA_WALL_O_HOR(159) =0.10
-XDATA_WALL_O_HOR(160) =0.10
-XDATA_WALL_O_HOR(161) =1.00
-XDATA_WALL_O_HOR(254) =1.50
-XDATA_WALL_O_HOR(255) =1.50
-XDATA_WALL_O_HOR(561) =0.28
-XDATA_WALL_O_HOR(562) =0.27
-XDATA_WALL_O_HOR(563) =0.25
-XDATA_WALL_O_HOR(564) =0.16
-XDATA_WALL_O_HOR(565) =0.31
-XDATA_WALL_O_HOR(566) =0.28
-XDATA_WALL_O_HOR(567) =0.31
-XDATA_WALL_O_HOR(568) =0.25
-XDATA_WALL_O_HOR(569) =0.24
-XDATA_WALL_O_HOR(570) =0.25
-XDATA_WALL_O_HOR(571) =0.28
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_BLD(:) =0.50
-XDATA_BLD( 7) =0.30
-XDATA_BLD(151) =0.45
-XDATA_BLD(152) =0.30
-XDATA_BLD(153) =0.30
-XDATA_BLD(154) =0.30
-XDATA_BLD(155) =0.45
-XDATA_BLD(156) =0.09
-XDATA_BLD(157) =0.45
-XDATA_BLD(158) =0.10
-XDATA_BLD(159) =0.10
-XDATA_BLD(160) =0.10
-XDATA_BLD(254) =0.60
-XDATA_BLD(255) =0.60
-XDATA_BLD(561) =0.28
-XDATA_BLD(562) =0.27
-XDATA_BLD(563) =0.25
-XDATA_BLD(564) =0.16
-XDATA_BLD(565) =0.31
-XDATA_BLD(566) =0.28
-XDATA_BLD(567) =0.31
-XDATA_BLD(568) =0.25
-XDATA_BLD(569) =0.24
-XDATA_BLD(570) =0.25
-XDATA_BLD(571) =0.28
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_GARDEN(:) =0.00
-XDATA_GARDEN( 7) =0.40
-XDATA_GARDEN(151) =0.10
-XDATA_GARDEN(152) =0.40
-XDATA_GARDEN(153) =0.40
-XDATA_GARDEN(154) =0.40
-XDATA_GARDEN(155) =0.10
-XDATA_GARDEN(156) =0.10
-XDATA_GARDEN(157) =0.10
-XDATA_GARDEN(561) =0.44
-XDATA_GARDEN(562) =0.45
-XDATA_GARDEN(563) =0.51
-XDATA_GARDEN(564) =0.48
-XDATA_GARDEN(565) =0.37
-XDATA_GARDEN(566) =0.44
-XDATA_GARDEN(567) =0.38
-XDATA_GARDEN(568) =0.49
-XDATA_GARDEN(569) =0.52
-XDATA_GARDEN(570) =0.51
-XDATA_GARDEN(571) =0.44
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_ALB_ROOF(:) =0.15
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_ALB_ROAD(:) =0.08
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_ALB_WALL(:) =0.25
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_EMIS_ROOF(:) =0.90
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_EMIS_ROAD(:) =0.94
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_EMIS_WALL(:) =0.85
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_HC_ROOF(:, 1) =2.11 * 1.E6
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_HC_ROOF(:, 2) =0.28 * 1.E6
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_HC_ROOF(:, 3) =0.29 * 1.E6
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_TC_ROOF(:, 1) =1.5100
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_TC_ROOF(:, 2) =0.0800
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_TC_ROOF(:, 3) =0.0500
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_D_ROOF(:, 1) =0.050
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_D_ROOF(:, 2) =0.400
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_D_ROOF(:, 3) =0.100
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_HC_ROAD(:, 1) =1.94 * 1.E6
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_HC_ROAD(:, 2) =1.28 * 1.E6
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_HC_ROAD(:, 3) =1.28 * 1.E6
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_TC_ROAD(:, 1) =0.7454
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_TC_ROAD(:, 2) =0.2513
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_TC_ROAD(:, 3) =0.2513
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_D_ROAD(:, 1) =0.050
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_D_ROAD(:, 2) =0.100
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_D_ROAD(:, 3) =1.000
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_HC_WALL(:, 1) =1.55 * 1.E6
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_HC_WALL(:, 2) =1.55 * 1.E6
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_HC_WALL(:, 3) =0.29 * 1.E6
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_TC_WALL(:, 1) =0.9338
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_TC_WALL(:, 2) =0.9338
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_TC_WALL(:, 3) =0.0500
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_D_WALL(:, 1) =0.020
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_D_WALL(:, 2) =0.125
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_D_WALL(:, 3) =0.050
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_H_TRAFFIC(:) = 10.
-XDATA_H_TRAFFIC(151) = 20.
-XDATA_H_TRAFFIC(156) = 30.
-XDATA_H_TRAFFIC(159) = 0.
-XDATA_H_TRAFFIC(160) = 0.
-XDATA_H_TRAFFIC(161) = 0.
-XDATA_H_TRAFFIC(254) = 0.
-XDATA_H_TRAFFIC(255) = 0.
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_LE_TRAFFIC(:) = 0.
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_H_INDUSTRY(:) = 5.
-XDATA_H_INDUSTRY(151) = 10.
-XDATA_H_INDUSTRY(155) = 20.
-XDATA_H_INDUSTRY(156) = 0.
-XDATA_H_INDUSTRY(157) = 20.
-XDATA_H_INDUSTRY(158) = 0.
-XDATA_H_INDUSTRY(159) = 0.
-XDATA_H_INDUSTRY(160) = 0.
-XDATA_H_INDUSTRY(161) = 0.
-XDATA_H_INDUSTRY(254) = 0.
-XDATA_H_INDUSTRY(255) = 0.
-!-------------------------------------------------------------------
-WHERE(XDATA_TOWN>0.) XDATA_LE_INDUSTRY(:) = 0.
-!-------------------------------------------------------------------
-XDATA_VEGTYPE(:, 1) = (/ &
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_Z0_TOWN)) THEN
+WHERE(PDATA_TOWN>0.) PDATA_Z0_TOWN(:) = 1.000
+PDATA_Z0_TOWN(151) = 3.000
+PDATA_Z0_TOWN(155) = 2.000
+PDATA_Z0_TOWN(156) = 0.500
+PDATA_Z0_TOWN(157) = 2.000
+PDATA_Z0_TOWN(158) = 0.010
+PDATA_Z0_TOWN(159) = 0.100
+PDATA_Z0_TOWN(160) = 0.500
+PDATA_Z0_TOWN(254) = 2.000
+PDATA_Z0_TOWN(255) = 2.000
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_BLD_HEIGHT)) THEN
+WHERE(PDATA_TOWN>0.) PDATA_BLD_HEIGHT(:) = 10.
+PDATA_BLD_HEIGHT(151) = 30.
+PDATA_BLD_HEIGHT(155) = 20.
+PDATA_BLD_HEIGHT(156) = 5.
+PDATA_BLD_HEIGHT(157) = 20.
+PDATA_BLD_HEIGHT(159) = 5.
+PDATA_BLD_HEIGHT(160) = 5.
+PDATA_BLD_HEIGHT(254) = 20.
+PDATA_BLD_HEIGHT(255) = 20.
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_WALL_O_HOR)) THEN
+WHERE(PDATA_TOWN>0.) PDATA_WALL_O_HOR(:) =0.50
+PDATA_WALL_O_HOR( 7) =0.30
+PDATA_WALL_O_HOR(151) =0.90
+PDATA_WALL_O_HOR(152) =0.30
+PDATA_WALL_O_HOR(153) =0.30
+PDATA_WALL_O_HOR(154) =0.30
+PDATA_WALL_O_HOR(155) =0.45
+PDATA_WALL_O_HOR(156) =0.09
+PDATA_WALL_O_HOR(157) =0.90
+PDATA_WALL_O_HOR(158) =0.10
+PDATA_WALL_O_HOR(159) =0.10
+PDATA_WALL_O_HOR(160) =0.10
+PDATA_WALL_O_HOR(161) =1.00
+PDATA_WALL_O_HOR(254) =1.50
+PDATA_WALL_O_HOR(255) =1.50
+PDATA_WALL_O_HOR(561) =0.28
+PDATA_WALL_O_HOR(562) =0.27
+PDATA_WALL_O_HOR(563) =0.25
+PDATA_WALL_O_HOR(564) =0.16
+PDATA_WALL_O_HOR(565) =0.31
+PDATA_WALL_O_HOR(566) =0.28
+PDATA_WALL_O_HOR(567) =0.31
+PDATA_WALL_O_HOR(568) =0.25
+PDATA_WALL_O_HOR(569) =0.24
+PDATA_WALL_O_HOR(570) =0.25
+PDATA_WALL_O_HOR(571) =0.28
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_BLD)) THEN
+WHERE(PDATA_TOWN>0.) PDATA_BLD(:) =0.50
+PDATA_BLD( 7) =0.30
+PDATA_BLD(151) =0.45
+PDATA_BLD(152) =0.30
+PDATA_BLD(153) =0.30
+PDATA_BLD(154) =0.30
+PDATA_BLD(155) =0.45
+PDATA_BLD(156) =0.09
+PDATA_BLD(157) =0.45
+PDATA_BLD(158) =0.10
+PDATA_BLD(159) =0.10
+PDATA_BLD(160) =0.10
+PDATA_BLD(254) =0.60
+PDATA_BLD(255) =0.60
+PDATA_BLD(561) =0.28
+PDATA_BLD(562) =0.27
+PDATA_BLD(563) =0.25
+PDATA_BLD(564) =0.16
+PDATA_BLD(565) =0.31
+PDATA_BLD(566) =0.28
+PDATA_BLD(567) =0.31
+PDATA_BLD(568) =0.25
+PDATA_BLD(569) =0.24
+PDATA_BLD(570) =0.25
+PDATA_BLD(571) =0.28
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_GARDEN)) THEN
+WHERE(PDATA_TOWN>0.) PDATA_GARDEN(:) =0.00
+PDATA_GARDEN( 7) =0.40
+PDATA_GARDEN(151) =0.10
+PDATA_GARDEN(152) =0.40
+PDATA_GARDEN(153) =0.40
+PDATA_GARDEN(154) =0.40
+PDATA_GARDEN(155) =0.10
+PDATA_GARDEN(156) =0.10
+PDATA_GARDEN(157) =0.10
+PDATA_GARDEN(561) =0.44
+PDATA_GARDEN(562) =0.45
+PDATA_GARDEN(563) =0.51
+PDATA_GARDEN(564) =0.48
+PDATA_GARDEN(565) =0.37
+PDATA_GARDEN(566) =0.44
+PDATA_GARDEN(567) =0.38
+PDATA_GARDEN(568) =0.49
+PDATA_GARDEN(569) =0.52
+PDATA_GARDEN(570) =0.51
+PDATA_GARDEN(571) =0.44
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_ALB_ROOF)) THEN
+ WHERE(PDATA_TOWN>0.) PDATA_ALB_ROOF(:) =0.15
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_ALB_ROAD)) THEN
+ WHERE(PDATA_TOWN>0.) PDATA_ALB_ROAD(:) =0.08
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_ALB_WALL)) THEN
+ WHERE(PDATA_TOWN>0.) PDATA_ALB_WALL(:) =0.25
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_EMIS_ROOF)) THEN
+ WHERE(PDATA_TOWN>0.) PDATA_EMIS_ROOF(:) =0.90
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_EMIS_ROAD)) THEN
+ WHERE(PDATA_TOWN>0.) PDATA_EMIS_ROAD(:) =0.94
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_EMIS_WALL)) THEN
+ WHERE(PDATA_TOWN>0.) PDATA_EMIS_WALL(:) =0.85
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_HC_ROOF)) THEN
+ WHERE(PDATA_TOWN>0.) PDATA_HC_ROOF(:, 1) =2.11 * 1.E6
+!-------------------------------------------------------------------
+ WHERE(PDATA_TOWN>0.) PDATA_HC_ROOF(:, 2) =0.28 * 1.E6
+!-------------------------------------------------------------------
+ WHERE(PDATA_TOWN>0.) PDATA_HC_ROOF(:, 3) =0.29 * 1.E6
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_TC_ROOF)) THEN
+ WHERE(PDATA_TOWN>0.) PDATA_TC_ROOF(:, 1) =1.5100
+!-------------------------------------------------------------------
+ WHERE(PDATA_TOWN>0.) PDATA_TC_ROOF(:, 2) =0.0800
+!-------------------------------------------------------------------
+ WHERE(PDATA_TOWN>0.) PDATA_TC_ROOF(:, 3) =0.0500
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_D_ROOF)) THEN
+ WHERE(PDATA_TOWN>0.) PDATA_D_ROOF(:, 1) =0.050
+!-------------------------------------------------------------------
+ WHERE(PDATA_TOWN>0.) PDATA_D_ROOF(:, 2) =0.400
+!-------------------------------------------------------------------
+ WHERE(PDATA_TOWN>0.) PDATA_D_ROOF(:, 3) =0.100
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_HC_ROAD)) THEN
+ WHERE(PDATA_TOWN>0.) PDATA_HC_ROAD(:, 1) =1.94 * 1.E6
+!-------------------------------------------------------------------
+ WHERE(PDATA_TOWN>0.) PDATA_HC_ROAD(:, 2) =1.28 * 1.E6
+!-------------------------------------------------------------------
+ WHERE(PDATA_TOWN>0.) PDATA_HC_ROAD(:, 3) =1.28 * 1.E6
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_TC_ROAD)) THEN
+ WHERE(PDATA_TOWN>0.) PDATA_TC_ROAD(:, 1) =0.7454
+!-------------------------------------------------------------------
+ WHERE(PDATA_TOWN>0.) PDATA_TC_ROAD(:, 2) =0.2513
+!-------------------------------------------------------------------
+ WHERE(PDATA_TOWN>0.) PDATA_TC_ROAD(:, 3) =0.2513
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_D_ROAD)) THEN
+ WHERE(PDATA_TOWN>0.) PDATA_D_ROAD(:, 1) =0.050
+!-------------------------------------------------------------------
+ WHERE(PDATA_TOWN>0.) PDATA_D_ROAD(:, 2) =0.100
+!-------------------------------------------------------------------
+ WHERE(PDATA_TOWN>0.) PDATA_D_ROAD(:, 3) =1.000
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_HC_WALL)) THEN
+ WHERE(PDATA_TOWN>0.) PDATA_HC_WALL(:, 1) =1.55 * 1.E6
+!-------------------------------------------------------------------
+ WHERE(PDATA_TOWN>0.) PDATA_HC_WALL(:, 2) =1.55 * 1.E6
+!-------------------------------------------------------------------
+ WHERE(PDATA_TOWN>0.) PDATA_HC_WALL(:, 3) =0.29 * 1.E6
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_TC_WALL)) THEN
+ WHERE(PDATA_TOWN>0.) PDATA_TC_WALL(:, 1) =0.9338
+!-------------------------------------------------------------------
+ WHERE(PDATA_TOWN>0.) PDATA_TC_WALL(:, 2) =0.9338
+!-------------------------------------------------------------------
+ WHERE(PDATA_TOWN>0.) PDATA_TC_WALL(:, 3) =0.0500
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_D_WALL)) THEN
+ WHERE(PDATA_TOWN>0.) PDATA_D_WALL(:, 1) =0.020
+!-------------------------------------------------------------------
+ WHERE(PDATA_TOWN>0.) PDATA_D_WALL(:, 2) =0.125
+!-------------------------------------------------------------------
+ WHERE(PDATA_TOWN>0.) PDATA_D_WALL(:, 3) =0.050
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_H_TRAFFIC)) THEN
+ WHERE(PDATA_TOWN>0.) PDATA_H_TRAFFIC(:) = 10.
+PDATA_H_TRAFFIC(151) = 20.
+PDATA_H_TRAFFIC(156) = 30.
+PDATA_H_TRAFFIC(159) = 0.
+PDATA_H_TRAFFIC(160) = 0.
+PDATA_H_TRAFFIC(161) = 0.
+PDATA_H_TRAFFIC(254) = 0.
+PDATA_H_TRAFFIC(255) = 0.
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_LE_TRAFFIC)) THEN
+ WHERE(PDATA_TOWN>0.) PDATA_LE_TRAFFIC(:) = 0.
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_H_INDUSTRY)) THEN
+ WHERE(PDATA_TOWN>0.) PDATA_H_INDUSTRY(:) = 5.
+PDATA_H_INDUSTRY(151) = 10.
+PDATA_H_INDUSTRY(155) = 20.
+PDATA_H_INDUSTRY(156) = 0.
+PDATA_H_INDUSTRY(157) = 20.
+PDATA_H_INDUSTRY(158) = 0.
+PDATA_H_INDUSTRY(159) = 0.
+PDATA_H_INDUSTRY(160) = 0.
+PDATA_H_INDUSTRY(161) = 0.
+PDATA_H_INDUSTRY(254) = 0.
+PDATA_H_INDUSTRY(255) = 0.
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_TOWN).AND.PRESENT(PDATA_LE_INDUSTRY)) THEN
+ WHERE(PDATA_TOWN>0.) PDATA_LE_INDUSTRY(:) = 0.
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_VEGTYPE)) THEN
+PDATA_VEGTYPE(:, 1) = (/ &
0.00, 0.00, 0.00, 1.00, 0.00, 0.00, 0.00, 0.00, 0.90, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
@@ -511,7 +615,7 @@ XDATA_VEGTYPE(:, 1) = (/ &
0.04, 0.47, 0.46 &
/)
!-------------------------------------------------------------------
-XDATA_VEGTYPE(:, 2) = (/ &
+PDATA_VEGTYPE(:, 2) = (/ &
0.00, 0.00, 0.00, 0.00, 1.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
@@ -572,7 +676,7 @@ XDATA_VEGTYPE(:, 2) = (/ &
0.02, 0.00, 0.00 &
/)
!-------------------------------------------------------------------
-XDATA_VEGTYPE(:, 3) = (/ &
+PDATA_VEGTYPE(:, 3) = (/ &
0.00, 0.00, 0.00, 0.00, 0.00, 1.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
@@ -633,7 +737,7 @@ XDATA_VEGTYPE(:, 3) = (/ &
0.00, 0.00, 0.00 &
/)
!-------------------------------------------------------------------
-XDATA_VEGTYPE(:, 4) = (/ &
+PDATA_VEGTYPE(:, 4) = (/ &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.50, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 1.00, 0.00, 0.00, 0.00, 0.50, &
@@ -694,7 +798,7 @@ XDATA_VEGTYPE(:, 4) = (/ &
0.00, 0.00, 0.00 &
/)
!-------------------------------------------------------------------
-XDATA_VEGTYPE(:, 5) = (/ &
+PDATA_VEGTYPE(:, 5) = (/ &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
1.00, 0.00, 1.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
@@ -755,7 +859,7 @@ XDATA_VEGTYPE(:, 5) = (/ &
0.00, 0.00, 0.00 &
/)
!-------------------------------------------------------------------
-XDATA_VEGTYPE(:, 6) = (/ &
+PDATA_VEGTYPE(:, 6) = (/ &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 1.00, 1.00, 1.00, 1.00, 1.00, &
1.00, 1.00, 1.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
@@ -816,7 +920,7 @@ XDATA_VEGTYPE(:, 6) = (/ &
0.00, 0.00, 0.00 &
/)
!-------------------------------------------------------------------
-XDATA_VEGTYPE(:, 7) = (/ &
+PDATA_VEGTYPE(:, 7) = (/ &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
@@ -877,7 +981,7 @@ XDATA_VEGTYPE(:, 7) = (/ &
0.19, 0.01, 0.01 &
/)
!-------------------------------------------------------------------
-XDATA_VEGTYPE(:, 8) = (/ &
+PDATA_VEGTYPE(:, 8) = (/ &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
@@ -938,7 +1042,7 @@ XDATA_VEGTYPE(:, 8) = (/ &
0.01, 0.01, 0.04 &
/)
!-------------------------------------------------------------------
-XDATA_VEGTYPE(:, 9) = (/ &
+PDATA_VEGTYPE(:, 9) = (/ &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
@@ -999,7 +1103,7 @@ XDATA_VEGTYPE(:, 9) = (/ &
0.10, 0.00, 0.00 &
/)
!-------------------------------------------------------------------
-XDATA_VEGTYPE(:, 10) = (/ &
+PDATA_VEGTYPE(:, 10) = (/ &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.10, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
@@ -1060,7 +1164,7 @@ XDATA_VEGTYPE(:, 10) = (/ &
0.40, 0.04, 0.00 &
/)
!-------------------------------------------------------------------
-XDATA_VEGTYPE(:, 11) = (/ &
+PDATA_VEGTYPE(:, 11) = (/ &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.50, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
@@ -1121,7 +1225,7 @@ XDATA_VEGTYPE(:, 11) = (/ &
0.00, 0.00, 0.00 &
/)
!-------------------------------------------------------------------
-XDATA_VEGTYPE(:, 12) = (/ &
+PDATA_VEGTYPE(:, 12) = (/ &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.50, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
@@ -1182,7 +1286,7 @@ XDATA_VEGTYPE(:, 12) = (/ &
0.02, 0.00, 0.00 &
/)
!-------------------------------------------------------------------
-XDATA_VEGTYPE(:, 13) = (/ &
+PDATA_VEGTYPE(:, 13) = (/ &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.50, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 1.00, 0.00, 0.00, 0.00, &
@@ -1243,7 +1347,7 @@ XDATA_VEGTYPE(:, 13) = (/ &
0.00, 0.00, 0.00 &
/)
!-------------------------------------------------------------------
-XDATA_VEGTYPE(:, 14) = (/ &
+PDATA_VEGTYPE(:, 14) = (/ &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 1.00, 0.00, 0.00, 1.00, 0.50, 0.00, &
@@ -1304,7 +1408,7 @@ XDATA_VEGTYPE(:, 14) = (/ &
0.17, 0.00, 0.00 &
/)
!-------------------------------------------------------------------
-XDATA_VEGTYPE(:, 15) = (/ &
+PDATA_VEGTYPE(:, 15) = (/ &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 1.00, &
0.00, 1.00, 0.00, 1.00, 1.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.50, 0.50, &
@@ -1365,7 +1469,7 @@ XDATA_VEGTYPE(:, 15) = (/ &
0.05, 0.00, 0.01 &
/)
!-------------------------------------------------------------------
-XDATA_VEGTYPE(:, 16) = (/ &
+PDATA_VEGTYPE(:, 16) = (/ &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
@@ -1426,7 +1530,7 @@ XDATA_VEGTYPE(:, 16) = (/ &
0.00, 0.00, 0.00 &
/)
!-------------------------------------------------------------------
-XDATA_VEGTYPE(:, 17) = (/ &
+PDATA_VEGTYPE(:, 17) = (/ &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 1.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
@@ -1487,7 +1591,7 @@ XDATA_VEGTYPE(:, 17) = (/ &
0.00, 0.00, 0.00 &
/)
!-------------------------------------------------------------------
-XDATA_VEGTYPE(:, 18) = (/ &
+PDATA_VEGTYPE(:, 18) = (/ &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
@@ -1548,7 +1652,7 @@ XDATA_VEGTYPE(:, 18) = (/ &
0.00, 0.00, 0.00 &
/)
!-------------------------------------------------------------------
-XDATA_VEGTYPE(:, 19) = (/ &
+PDATA_VEGTYPE(:, 19) = (/ &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
@@ -1608,8 +1712,10 @@ XDATA_VEGTYPE(:, 19) = (/ &
0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, &
0.00, 0.47, 0.48 &
/)
-!-------------------------------------------------------------------
-XDATA_H_TREE(:, 4) = (/ &
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_H_TREE)) THEN
+PDATA_H_TREE(:, 4) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 5., XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 15., XUNDEF, XUNDEF, XUNDEF, 15., &
@@ -1670,7 +1776,7 @@ XDATA_H_TREE(:, 4) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_H_TREE(:, 5) = (/ &
+PDATA_H_TREE(:, 5) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
15., XUNDEF, 15., XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -1731,7 +1837,7 @@ XDATA_H_TREE(:, 5) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_H_TREE(:, 6) = (/ &
+PDATA_H_TREE(:, 6) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 30., 20., 30., 20., 20., &
30., 30., 20., XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -1792,7 +1898,7 @@ XDATA_H_TREE(:, 6) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_H_TREE(:, 13) = (/ &
+PDATA_H_TREE(:, 13) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 15., XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 20., XUNDEF, XUNDEF, XUNDEF, &
@@ -1853,7 +1959,7 @@ XDATA_H_TREE(:, 13) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_H_TREE(:, 14) = (/ &
+PDATA_H_TREE(:, 14) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, 20., XUNDEF, XUNDEF, 20., 15., XUNDEF, &
@@ -1914,7 +2020,7 @@ XDATA_H_TREE(:, 14) = (/ &
6., XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_H_TREE(:, 15) = (/ &
+PDATA_H_TREE(:, 15) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 15., &
XUNDEF, 15., XUNDEF, 15., 20., XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 15., 15., &
@@ -1975,7 +2081,7 @@ XDATA_H_TREE(:, 15) = (/ &
6., XUNDEF, 1. &
/)
!-------------------------------------------------------------------
-XDATA_H_TREE(:, 16) = (/ &
+PDATA_H_TREE(:, 16) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -2035,10 +2141,14 @@ XDATA_H_TREE(:, 16) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 10., XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF &
/)
-!-------------------------------------------------------------------
-WHERE(XDATA_VEGTYPE(:,17)>0.) XDATA_H_TREE(:, 17) = 15.
-!-------------------------------------------------------------------
-XDATA_H_TREE(:, 19) = (/ &
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_VEGTYPE).AND.PRESENT(PDATA_H_TREE)) THEN
+ WHERE(PDATA_VEGTYPE(:,17)>0.) PDATA_H_TREE(:, 17) = 15.
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_H_TREE)) THEN
+PDATA_H_TREE(:, 19) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -2098,16 +2208,22 @@ XDATA_H_TREE(:, 19) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, 1., 1. &
/)
-!-------------------------------------------------------------------
-WHERE(XDATA_VEGTYPE(:, 8)>0.) XDATA_WATSUP(:, 8) = 0.
-!-------------------------------------------------------------------
-WHERE(XDATA_VEGTYPE(:, 9)>0.) XDATA_WATSUP(:, 9) = 30.
-!-------------------------------------------------------------------
-WHERE(XDATA_VEGTYPE(:, 8)>0.) XDATA_IRRIG(:, 8) = 0.00
-!-------------------------------------------------------------------
-WHERE(XDATA_VEGTYPE(:, 9)>0.) XDATA_IRRIG(:, 9) = 1.00
-!-------------------------------------------------------------------
-XDATA_ROOT_DEPTH(:, 1) = (/ &
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_VEGTYPE).AND.PRESENT(PDATA_WATSUP)) THEN
+ WHERE(PDATA_VEGTYPE(:, 8)>0.) PDATA_WATSUP(:, 8) = 0.
+!-------------------------------------------------------------------
+ WHERE(PDATA_VEGTYPE(:, 9)>0.) PDATA_WATSUP(:, 9) = 30.
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_VEGTYPE).AND.PRESENT(PDATA_IRRIG)) THEN
+ WHERE(PDATA_VEGTYPE(:, 8)>0.) PDATA_IRRIG(:, 8) = 0.00
+!-------------------------------------------------------------------
+ WHERE(PDATA_VEGTYPE(:, 9)>0.) PDATA_IRRIG(:, 9) = 1.00
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_ROOT_DEPTH)) THEN
+PDATA_ROOT_DEPTH(:, 1) = (/ &
XUNDEF, XUNDEF, XUNDEF, 0.50, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 0.50, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -2167,12 +2283,16 @@ XDATA_ROOT_DEPTH(:, 1) = (/ &
0.50, 0.50, 0.50, 0.50, 0.50, 0.50, 0.50, 0.50, XUNDEF, 0.50, &
0.50, 1.00, 1.00 &
/)
-!-------------------------------------------------------------------
-WHERE(XDATA_VEGTYPE(:, 2)>0.) XDATA_ROOT_DEPTH(:, 2) = 0.20
-!-------------------------------------------------------------------
-WHERE(XDATA_VEGTYPE(:, 3)>0.) XDATA_ROOT_DEPTH(:, 3) = 0.20
-!-------------------------------------------------------------------
-XDATA_ROOT_DEPTH(:, 4) = (/ &
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_VEGTYPE).AND.PRESENT(PDATA_ROOT_DEPTH)) THEN
+WHERE(PDATA_VEGTYPE(:, 2)>0.) PDATA_ROOT_DEPTH(:, 2) = 0.20
+!-------------------------------------------------------------------
+WHERE(PDATA_VEGTYPE(:, 3)>0.) PDATA_ROOT_DEPTH(:, 3) = 0.20
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_ROOT_DEPTH)) THEN
+PDATA_ROOT_DEPTH(:, 4) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 2.00, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 2.00, XUNDEF, XUNDEF, XUNDEF, 2.00, &
@@ -2233,7 +2353,7 @@ XDATA_ROOT_DEPTH(:, 4) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_ROOT_DEPTH(:, 5) = (/ &
+PDATA_ROOT_DEPTH(:, 5) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
2.00, XUNDEF, 2.00, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -2294,7 +2414,7 @@ XDATA_ROOT_DEPTH(:, 5) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_ROOT_DEPTH(:, 6) = (/ &
+PDATA_ROOT_DEPTH(:, 6) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 8.00, 5.00, 8.00, 5.00, 5.00, &
8.00, 5.00, 5.00, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -2355,7 +2475,7 @@ XDATA_ROOT_DEPTH(:, 6) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_ROOT_DEPTH(:, 7) = (/ &
+PDATA_ROOT_DEPTH(:, 7) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -2416,7 +2536,7 @@ XDATA_ROOT_DEPTH(:, 7) = (/ &
1.50, 1.50, 1.50 &
/)
!-------------------------------------------------------------------
-XDATA_ROOT_DEPTH(:, 8) = (/ &
+PDATA_ROOT_DEPTH(:, 8) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -2476,10 +2596,14 @@ XDATA_ROOT_DEPTH(:, 8) = (/ &
XUNDEF, 1.50, 1.50, 1.50, 1.50, XUNDEF, 1.50, 1.50, 1.50, 1.50, &
1.50, 1.50, 1.50 &
/)
-!-------------------------------------------------------------------
-WHERE(XDATA_VEGTYPE(:, 9)>0.) XDATA_ROOT_DEPTH(:, 9) = 1.50
-!-------------------------------------------------------------------
-XDATA_ROOT_DEPTH(:, 10) = (/ &
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_VEGTYPE).AND.PRESENT(PDATA_ROOT_DEPTH)) THEN
+WHERE(PDATA_VEGTYPE(:, 9)>0.) PDATA_ROOT_DEPTH(:, 9) = 1.50
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_ROOT_DEPTH)) THEN
+PDATA_ROOT_DEPTH(:, 10) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 0.50, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -2540,7 +2664,7 @@ XDATA_ROOT_DEPTH(:, 10) = (/ &
1.50, 1.50, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_ROOT_DEPTH(:, 11) = (/ &
+PDATA_ROOT_DEPTH(:, 11) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 1.00, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -2601,7 +2725,7 @@ XDATA_ROOT_DEPTH(:, 11) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_ROOT_DEPTH(:, 12) = (/ &
+PDATA_ROOT_DEPTH(:, 12) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 1.00, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -2662,7 +2786,7 @@ XDATA_ROOT_DEPTH(:, 12) = (/ &
1.50, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_ROOT_DEPTH(:, 13) = (/ &
+PDATA_ROOT_DEPTH(:, 13) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 2.00, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 3.00, XUNDEF, XUNDEF, XUNDEF, &
@@ -2723,7 +2847,7 @@ XDATA_ROOT_DEPTH(:, 13) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_ROOT_DEPTH(:, 14) = (/ &
+PDATA_ROOT_DEPTH(:, 14) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, 3.00, XUNDEF, XUNDEF, 3.00, 2.00, XUNDEF, &
@@ -2784,7 +2908,7 @@ XDATA_ROOT_DEPTH(:, 14) = (/ &
2.00, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_ROOT_DEPTH(:, 15) = (/ &
+PDATA_ROOT_DEPTH(:, 15) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 2.00, &
XUNDEF, 2.00, XUNDEF, 2.00, 3.00, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 2.00, 2.00, &
@@ -2844,12 +2968,16 @@ XDATA_ROOT_DEPTH(:, 15) = (/ &
2.00, 2.00, XUNDEF, XUNDEF, 2.00, XUNDEF, 2.00, 2.00, 2.00, 2.00, &
2.00, XUNDEF, 2.00 &
/)
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_VEGTYPE).AND.PRESENT(PDATA_ROOT_DEPTH)) THEN
+WHERE(PDATA_VEGTYPE(:,16)>0.) PDATA_ROOT_DEPTH(:, 16) = 2.00
!-------------------------------------------------------------------
-WHERE(XDATA_VEGTYPE(:,16)>0.) XDATA_ROOT_DEPTH(:, 16) = 2.00
-!-------------------------------------------------------------------
-WHERE(XDATA_VEGTYPE(:,17)>0.) XDATA_ROOT_DEPTH(:, 17) = 2.00
-!-------------------------------------------------------------------
-XDATA_ROOT_DEPTH(:, 18) = (/ &
+WHERE(PDATA_VEGTYPE(:,17)>0.) PDATA_ROOT_DEPTH(:, 17) = 2.00
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_ROOT_DEPTH)) THEN
+PDATA_ROOT_DEPTH(:, 18) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -2910,7 +3038,7 @@ XDATA_ROOT_DEPTH(:, 18) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_ROOT_DEPTH(:, 19) = (/ &
+PDATA_ROOT_DEPTH(:, 19) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -2970,8 +3098,10 @@ XDATA_ROOT_DEPTH(:, 19) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, 3.00, 3.00 &
/)
-!-------------------------------------------------------------------
-XDATA_GROUND_DEPTH(:, 1) = (/ &
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_GROUND_DEPTH)) THEN
+PDATA_GROUND_DEPTH(:, 1) = (/ &
XUNDEF, XUNDEF, XUNDEF, 1.00, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 1.00, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -3031,12 +3161,16 @@ XDATA_GROUND_DEPTH(:, 1) = (/ &
1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, XUNDEF, 1.00, &
1.00, 1.50, 1.50 &
/)
-!-------------------------------------------------------------------
-WHERE(XDATA_VEGTYPE(:, 2)>0.) XDATA_GROUND_DEPTH(:, 2) = 0.20
-!-------------------------------------------------------------------
-WHERE(XDATA_VEGTYPE(:, 3)>0.) XDATA_GROUND_DEPTH(:, 3) = 0.20
-!-------------------------------------------------------------------
-XDATA_GROUND_DEPTH(:, 4) = (/ &
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_VEGTYPE).AND.PRESENT(PDATA_GROUND_DEPTH)) THEN
+WHERE(PDATA_VEGTYPE(:, 2)>0.) PDATA_GROUND_DEPTH(:, 2) = 0.20
+!-------------------------------------------------------------------
+WHERE(PDATA_VEGTYPE(:, 3)>0.) PDATA_GROUND_DEPTH(:, 3) = 0.20
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_GROUND_DEPTH)) THEN
+PDATA_GROUND_DEPTH(:, 4) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 3.00, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 3.00, XUNDEF, XUNDEF, XUNDEF, 3.00, &
@@ -3097,7 +3231,7 @@ XDATA_GROUND_DEPTH(:, 4) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_GROUND_DEPTH(:, 5) = (/ &
+PDATA_GROUND_DEPTH(:, 5) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
3.00, XUNDEF, 3.00, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -3158,7 +3292,7 @@ XDATA_GROUND_DEPTH(:, 5) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_GROUND_DEPTH(:, 6) = (/ &
+PDATA_GROUND_DEPTH(:, 6) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 8.00, 5.00, 8.00, 5.00, 5.00, &
8.00, 5.00, 5.00, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -3219,7 +3353,7 @@ XDATA_GROUND_DEPTH(:, 6) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_GROUND_DEPTH(:, 7) = (/ &
+PDATA_GROUND_DEPTH(:, 7) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -3280,7 +3414,7 @@ XDATA_GROUND_DEPTH(:, 7) = (/ &
2.00, 2.00, 2.00 &
/)
!-------------------------------------------------------------------
-XDATA_GROUND_DEPTH(:, 8) = (/ &
+PDATA_GROUND_DEPTH(:, 8) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -3340,10 +3474,14 @@ XDATA_GROUND_DEPTH(:, 8) = (/ &
XUNDEF, 2.00, 2.00, 2.00, 2.00, XUNDEF, 2.00, 2.00, 2.00, 2.00, &
2.00, 2.00, 2.00 &
/)
-!-------------------------------------------------------------------
-WHERE(XDATA_VEGTYPE(:, 9)>0.) XDATA_GROUND_DEPTH(:, 9) = 2.00
-!-------------------------------------------------------------------
-XDATA_GROUND_DEPTH(:, 10) = (/ &
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_VEGTYPE).AND.PRESENT(PDATA_GROUND_DEPTH)) THEN
+WHERE(PDATA_VEGTYPE(:, 9)>0.) PDATA_GROUND_DEPTH(:, 9) = 2.00
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_GROUND_DEPTH)) THEN
+PDATA_GROUND_DEPTH(:, 10) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 1.00, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -3404,7 +3542,7 @@ XDATA_GROUND_DEPTH(:, 10) = (/ &
2.00, 2.00, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_GROUND_DEPTH(:, 11) = (/ &
+PDATA_GROUND_DEPTH(:, 11) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 1.00, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -3465,7 +3603,7 @@ XDATA_GROUND_DEPTH(:, 11) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_GROUND_DEPTH(:, 12) = (/ &
+PDATA_GROUND_DEPTH(:, 12) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 1.00, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -3526,7 +3664,7 @@ XDATA_GROUND_DEPTH(:, 12) = (/ &
2.00, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_GROUND_DEPTH(:, 13) = (/ &
+PDATA_GROUND_DEPTH(:, 13) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 3.00, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 5.00, XUNDEF, XUNDEF, XUNDEF, &
@@ -3587,7 +3725,7 @@ XDATA_GROUND_DEPTH(:, 13) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_GROUND_DEPTH(:, 14) = (/ &
+PDATA_GROUND_DEPTH(:, 14) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, 5.00, XUNDEF, XUNDEF, 5.00, 3.00, XUNDEF, &
@@ -3648,7 +3786,7 @@ XDATA_GROUND_DEPTH(:, 14) = (/ &
3.00, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_GROUND_DEPTH(:, 15) = (/ &
+PDATA_GROUND_DEPTH(:, 15) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 3.00, &
XUNDEF, 3.00, XUNDEF, 3.00, 4.00, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 3.00, 3.00, &
@@ -3708,12 +3846,16 @@ XDATA_GROUND_DEPTH(:, 15) = (/ &
3.00, 3.00, XUNDEF, XUNDEF, 3.00, XUNDEF, 3.00, 3.00, 3.00, 3.00, &
3.00, XUNDEF, 3.00 &
/)
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_VEGTYPE).AND.PRESENT(PDATA_GROUND_DEPTH)) THEN
+WHERE(PDATA_VEGTYPE(:,16)>0.) PDATA_GROUND_DEPTH(:, 16) = 3.00
!-------------------------------------------------------------------
-WHERE(XDATA_VEGTYPE(:,16)>0.) XDATA_GROUND_DEPTH(:, 16) = 3.00
-!-------------------------------------------------------------------
-WHERE(XDATA_VEGTYPE(:,17)>0.) XDATA_GROUND_DEPTH(:, 17) = 3.00
-!-------------------------------------------------------------------
-XDATA_GROUND_DEPTH(:, 18) = (/ &
+WHERE(PDATA_VEGTYPE(:,17)>0.) PDATA_GROUND_DEPTH(:, 17) = 3.00
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_GROUND_DEPTH)) THEN
+PDATA_GROUND_DEPTH(:, 18) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -3774,7 +3916,7 @@ XDATA_GROUND_DEPTH(:, 18) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_GROUND_DEPTH(:, 19) = (/ &
+PDATA_GROUND_DEPTH(:, 19) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -3834,8 +3976,10 @@ XDATA_GROUND_DEPTH(:, 19) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, 3.00, 3.00 &
/)
-!-------------------------------------------------------------------
-XDATA_DICE(:, 1) = (/ &
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_DICE)) THEN
+PDATA_DICE(:, 1) = (/ &
XUNDEF, XUNDEF, XUNDEF, 0.50, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 0.30, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -3896,7 +4040,7 @@ XDATA_DICE(:, 1) = (/ &
0.50, 1.00, 1.00 &
/)
!-------------------------------------------------------------------
-XDATA_DICE(:, 2) = (/ &
+PDATA_DICE(:, 2) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, 0.20, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -3957,7 +4101,7 @@ XDATA_DICE(:, 2) = (/ &
0.20, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_DICE(:, 3) = (/ &
+PDATA_DICE(:, 3) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 0.20, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -4018,7 +4162,7 @@ XDATA_DICE(:, 3) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_DICE(:, 4) = (/ &
+PDATA_DICE(:, 4) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 1.60, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 1.00, XUNDEF, XUNDEF, XUNDEF, 1.00, &
@@ -4079,7 +4223,7 @@ XDATA_DICE(:, 4) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_DICE(:, 5) = (/ &
+PDATA_DICE(:, 5) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
0.30, XUNDEF, 1.00, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -4140,7 +4284,7 @@ XDATA_DICE(:, 5) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_DICE(:, 6) = (/ &
+PDATA_DICE(:, 6) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 8.00, 5.00, 8.00, 4.00, 5.00, &
8.00, 4.00, 5.00, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -4201,7 +4345,7 @@ XDATA_DICE(:, 6) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_DICE(:, 7) = (/ &
+PDATA_DICE(:, 7) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -4262,7 +4406,7 @@ XDATA_DICE(:, 7) = (/ &
1.50, 1.50, 1.50 &
/)
!-------------------------------------------------------------------
-XDATA_DICE(:, 8) = (/ &
+PDATA_DICE(:, 8) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -4323,7 +4467,7 @@ XDATA_DICE(:, 8) = (/ &
1.50, 1.50, 1.50 &
/)
!-------------------------------------------------------------------
-XDATA_DICE(:, 9) = (/ &
+PDATA_DICE(:, 9) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -4384,7 +4528,7 @@ XDATA_DICE(:, 9) = (/ &
1.50, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_DICE(:, 10) = (/ &
+PDATA_DICE(:, 10) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 0.30, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -4445,7 +4589,7 @@ XDATA_DICE(:, 10) = (/ &
1.50, 1.50, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_DICE(:, 11) = (/ &
+PDATA_DICE(:, 11) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 1.00, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -4506,7 +4650,7 @@ XDATA_DICE(:, 11) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_DICE(:, 12) = (/ &
+PDATA_DICE(:, 12) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 0.80, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -4567,7 +4711,7 @@ XDATA_DICE(:, 12) = (/ &
1.50, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_DICE(:, 13) = (/ &
+PDATA_DICE(:, 13) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 2.00, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 3.00, XUNDEF, XUNDEF, XUNDEF, &
@@ -4628,7 +4772,7 @@ XDATA_DICE(:, 13) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_DICE(:, 14) = (/ &
+PDATA_DICE(:, 14) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, 3.00, XUNDEF, XUNDEF, 3.00, 2.00, XUNDEF, &
@@ -4689,7 +4833,7 @@ XDATA_DICE(:, 14) = (/ &
2.00, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_DICE(:, 15) = (/ &
+PDATA_DICE(:, 15) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 1.00, &
XUNDEF, 1.60, XUNDEF, 1.60, 1.50, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 2.00, 1.00, &
@@ -4750,7 +4894,7 @@ XDATA_DICE(:, 15) = (/ &
2.00, XUNDEF, 2.00 &
/)
!-------------------------------------------------------------------
-XDATA_DICE(:, 16) = (/ &
+PDATA_DICE(:, 16) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -4810,10 +4954,14 @@ XDATA_DICE(:, 16) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, 1.00, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF &
/)
-!-------------------------------------------------------------------
-WHERE(XDATA_VEGTYPE(:,17)>0.) XDATA_DICE(:, 17) = 0.30
-!-------------------------------------------------------------------
-XDATA_DICE(:, 18) = (/ &
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENT(PDATA_VEGTYPE).AND.PRESENT(PDATA_DICE)) THEN
+WHERE(PDATA_VEGTYPE(:,17)>0.) PDATA_DICE(:, 17) = 0.30
+ENDIF
+!-------------------------------------------------------------------
+IF (PRESENt(PDATA_DICE)) THEN
+PDATA_DICE(:, 18) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -4874,7 +5022,7 @@ XDATA_DICE(:, 18) = (/ &
XUNDEF, XUNDEF, XUNDEF &
/)
!-------------------------------------------------------------------
-XDATA_DICE(:, 19) = (/ &
+PDATA_DICE(:, 19) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
@@ -4934,15 +5082,22 @@ XDATA_DICE(:, 19) = (/ &
XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, XUNDEF, &
XUNDEF, 3.00, 3.00 &
/)
+ENDIF
+IF (PRESENT(PDATA_VEGTYPE)) THEN
+ IF (PRESENT(TPDATA_SEED)) THEN
!-------------------------------------------------------------------
-WHERE(XDATA_VEGTYPE(:, 9)>0. ) TDATA_SEED(:, 9)%TDATE%DAY =10
-!-------------------------------------------------------------------
-WHERE(XDATA_VEGTYPE(:, 9)>0. ) TDATA_SEED(:, 9)%TDATE%MONTH =05
+ WHERE(PDATA_VEGTYPE(:, 9)>0. ) TPDATA_SEED(:, 9)%TDATE%DAY =10
!-------------------------------------------------------------------
-WHERE(XDATA_VEGTYPE(:, 9)>0. ) TDATA_REAP(:, 9)%TDATE%DAY =01
+ WHERE(PDATA_VEGTYPE(:, 9)>0. ) TPDATA_SEED(:, 9)%TDATE%MONTH =05
+ ENDIF
+ IF (PRESENT(TPDATA_REAP)) THEN
!-------------------------------------------------------------------
-WHERE(XDATA_VEGTYPE(:, 9)>0. ) TDATA_REAP(:, 9)%TDATE%MONTH =08
+ WHERE(PDATA_VEGTYPE(:, 9)>0. ) TPDATA_REAP(:, 9)%TDATE%DAY =01
!-------------------------------------------------------------------
+ WHERE(PDATA_VEGTYPE(:, 9)>0. ) TPDATA_REAP(:, 9)%TDATE%MONTH =08
+!-------------------------------------------------------------------
+ ENDIF
+ENDIF
!
IF (LHOOK) CALL DR_HOOK('DEFAULT_DATA_COVER',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/default_diag_isba.F90 b/src/SURFEX/default_diag_isba.F90
index d0491071cd0e681ed62c82bda2397fa197472416..2c874bd51a094007fdb38443229da4db3b83db81 100644
--- a/src/SURFEX/default_diag_isba.F90
+++ b/src/SURFEX/default_diag_isba.F90
@@ -8,7 +8,8 @@
OSURF_MISC_BUDGET,OSURF_DIAG_ALBEDO, &
OSURF_BUDGETC,OSURF_MISC_DIF, &
OPATCH_BUDGET,OPGD,ORESET_BUDGETC, &
- OWATER_BUDGET,PDIAG_TSTEP )
+ OWATER_BUDGET,OPROSNOW, &
+ OVOLUMETRIC_SNOWLIQ,PDIAG_TSTEP )
! #################################################################################################################
!
!!**** *DEFAULT_DIAG_ISBA* - routine to set default values for the choice of diagnostics
@@ -43,6 +44,7 @@
!! Modified by B. Decharme , 05/2012: move carbon spinup to NAM_SPINUP_CARB
!! add miscellaneous field key for dif
!! add isba water budget key
+!! Modif M. Lafaysse 09/2015: OPROSNOW, OVOLUMETRIC_SNOWLIQ
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -75,6 +77,8 @@ LOGICAL, INTENT(OUT) :: OPATCH_BUDGET ! flag for patch output
LOGICAL, INTENT(OUT) :: OPGD ! flag for PGD fields
LOGICAL, INTENT(OUT) :: ORESET_BUDGETC ! flag for cumulated surface budget
LOGICAL, INTENT(OUT) :: OWATER_BUDGET ! flag for isba water budget
+LOGICAL, INTENT(OUT) :: OPROSNOW ! flag for Crocus-MEPRA diagnostics
+LOGICAL, INTENT(OUT) :: OVOLUMETRIC_SNOWLIQ ! volumetric snow liquid water content (kg m-3)
REAL, INTENT(OUT) :: PDIAG_TSTEP ! time-step for writing
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -108,6 +112,10 @@ ORESET_BUDGETC = .FALSE.
!
OWATER_BUDGET = .FALSE.
!
+OPROSNOW = .FALSE.
+!
+OVOLUMETRIC_SNOWLIQ = .FALSE.
+!
PDIAG_TSTEP = XUNDEF
IF (LHOOK) CALL DR_HOOK('DEFAULT_DIAG_ISBA',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/default_diag_seaflux.F90 b/src/SURFEX/default_diag_seaflux.F90
index 699cbe5a2b3774711aaf42419f6fef63c25e0a7d..2f0b3b9c11b3d31a84c2395d665b28ccd65d16c9 100644
--- a/src/SURFEX/default_diag_seaflux.F90
+++ b/src/SURFEX/default_diag_seaflux.F90
@@ -4,7 +4,7 @@
!SFX_LIC for details. version 1.
! #########
SUBROUTINE DEFAULT_DIAG_SEAFLUX(K2M,OSURF_BUDGET,O2M_MIN_ZS,ORAD_BUDGET,OCOEF,OSURF_VARS,&
- ODIAG_OCEAN,ODIAG_SEAICE,OSURF_BUDGETC,ORESET_BUDGETC,PDIAG_TSTEP )
+ ODIAG_OCEAN,ODIAG_MISC_SEAICE,OSURF_BUDGETC,ORESET_BUDGETC,PDIAG_TSTEP )
! ########################################################################
!
!!**** *DEFAULT_DIAG_SEAFLUX* - routine to set default values for the choice of diagnostics
@@ -50,7 +50,6 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
INTEGER, INTENT(OUT) :: K2M ! flag for operational 2m quantities
LOGICAL, INTENT(OUT) :: OSURF_BUDGET ! flag for surface budget
LOGICAL, INTENT(OUT) :: O2M_MIN_ZS
@@ -58,10 +57,11 @@ LOGICAL, INTENT(OUT) :: ORAD_BUDGET ! flag for radiative budget
LOGICAL, INTENT(OUT) :: OCOEF
LOGICAL, INTENT(OUT) :: OSURF_VARS
LOGICAL, INTENT(OUT) :: ODIAG_OCEAN
-LOGICAL, INTENT(OUT) :: ODIAG_SEAICE
+LOGICAL, INTENT(OUT) :: ODIAG_MISC_SEAICE
LOGICAL, INTENT(OUT) :: OSURF_BUDGETC ! flag for cumulated surface budget
LOGICAL, INTENT(OUT) :: ORESET_BUDGETC! flag for cumulated surface budget
REAL, INTENT(OUT) :: PDIAG_TSTEP ! time-step for writing
+!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.2 Declarations of local variables
@@ -82,7 +82,7 @@ OCOEF = .FALSE.
OSURF_VARS = .FALSE.
!
ODIAG_OCEAN = .FALSE.
-ODIAG_SEAICE = .FALSE.
+ODIAG_MISC_SEAICE = .FALSE.
!
OSURF_BUDGETC = .FALSE.
ORESET_BUDGETC= .FALSE.
diff --git a/src/SURFEX/default_diag_surf_atm.F90 b/src/SURFEX/default_diag_surf_atm.F90
index bb10c5b2279efcf06fa67110ba0d3dc0a50017ee..1afffb9f0d2c09a2f587761ba6cba98c182d263b 100644
--- a/src/SURFEX/default_diag_surf_atm.F90
+++ b/src/SURFEX/default_diag_surf_atm.F90
@@ -3,10 +3,10 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DEFAULT_DIAG_SURF_ATM(K2M,OT2MMW,OSURF_BUDGET,O2M_MIN_ZS,ORAD_BUDGET, &
- OCOEF,OSURF_VARS,OSURF_BUDGETC, &
- ORESET_BUDGETC, OSELECT, OPROVAR_TO_DIAG,&
- ODIAG_GRID, OFRAC, PDIAG_TSTEP, CSELECT )
+ SUBROUTINE DEFAULT_DIAG_SURF_ATM(K2M, OT2MMW, OSURF_BUDGET, O2M_MIN_ZS, ORAD_BUDGET, &
+ OCOEF, OSURF_VARS, OSURF_BUDGETC, ORESET_BUDGETC, &
+ OSELECT, OPROVAR_TO_DIAG, ODIAG_GRID, OFRAC, &
+ PDIAG_TSTEP, OSNOWDIMNC, ORESETCUMUL, CSELECT )
! ########################################################################
!
!!**** *DEFAULT_DIAG_SURF_ATM* - routine to set default values for the choice of diagnostics
@@ -66,10 +66,12 @@ LOGICAL, INTENT(OUT) :: OSURF_BUDGETC ! flag for cumulated surface budget
LOGICAL, INTENT(OUT) :: ORESET_BUDGETC ! flag for cumulated surface budget
LOGICAL, INTENT(OUT) :: OSELECT ! switch to control which fields are written
LOGICAL, INTENT(OUT) :: OPROVAR_TO_DIAG ! switch to write (or not) prognostic variable
+LOGICAL, INTENT(OUT) :: OSNOWDIMNC ! if true create a snow layer dimension in nc files
+LOGICAL, INTENT(OUT) :: ORESETCUMUL ! if true reset cumulated variables at each output timestep
LOGICAL, INTENT(OUT) :: ODIAG_GRID ! flag for mean grid diag
LOGICAL, INTENT(OUT) :: OFRAC ! flag for fractions of tiles
REAL, INTENT(OUT) :: PDIAG_TSTEP ! time-step for writing
- CHARACTER(LEN=LEN_HREC), DIMENSION(200), INTENT(OUT), OPTIONAL :: CSELECT
+CHARACTER(LEN=LEN_HREC), DIMENSION(200), INTENT(OUT), OPTIONAL :: CSELECT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.2 Declarations of local variables
@@ -97,6 +99,9 @@ OSELECT = .FALSE.
!
OPROVAR_TO_DIAG = .FALSE.
!
+OSNOWDIMNC = .FALSE.
+ORESETCUMUL = .FALSE.
+!
ODIAG_GRID = .TRUE.
!
OFRAC = .FALSE.
diff --git a/src/SURFEX/default_diag_teb.F90 b/src/SURFEX/default_diag_teb.F90
index 52f2f57184ccc325c78012597b1c0d6a613273cc..5fa9586804b6d636e918e9abf588bbd1f38c4c92 100644
--- a/src/SURFEX/default_diag_teb.F90
+++ b/src/SURFEX/default_diag_teb.F90
@@ -4,7 +4,7 @@
!SFX_LIC for details. version 1.
! #########
SUBROUTINE DEFAULT_DIAG_TEB (K2M,OSURF_BUDGET,O2M_MIN_ZS,ORAD_BUDGET,OCOEF,OSURF_VARS, &
- OSURF_MISC_BUDGET,OSURF_DIAG_ALBEDO,OUTCI,OPGD,OPGD_FIX,PDIAG_TSTEP )
+ OSURF_MISC_BUDGET,OSURF_DIAG_ALBEDO,OUTCI,OPGD,PDIAG_TSTEP )
! #################################################################################################################
!
!!**** *DEFAULT_DIAG_TEB * - routine to set default values for the choice of diagnostics
@@ -61,7 +61,6 @@ LOGICAL, INTENT(OUT) :: OSURF_MISC_BUDGET ! flag for surface miscellaneous bud
LOGICAL, INTENT(OUT) :: OSURF_DIAG_ALBEDO ! flag for albedo
LOGICAL, INTENT(OUT) :: OUTCI ! flag for UTCI fields
LOGICAL, INTENT(OUT) :: OPGD ! flag for PGD fields
-LOGICAL, INTENT(OUT) :: OPGD_FIX ! flag for PGD fields
REAL, INTENT(OUT) :: PDIAG_TSTEP ! time-step for writing
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -87,7 +86,6 @@ OSURF_DIAG_ALBEDO = .FALSE.
OUTCI = .FALSE.
!
OPGD = .FALSE.
-OPGD_FIX = .TRUE.
!
PDIAG_TSTEP = XUNDEF
IF (LHOOK) CALL DR_HOOK('DEFAULT_DIAG_TEB',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/default_dst.F90 b/src/SURFEX/default_dst.F90
index 61f86257177a41b7604c02b021388eb4f1217f66..279c5ecb3e90b254639617e3b46547eb8c6638e7 100644
--- a/src/SURFEX/default_dst.F90
+++ b/src/SURFEX/default_dst.F90
@@ -54,11 +54,11 @@ IMPLICIT NONE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('DEFAULT_DST',0,ZHOOK_HANDLE)
- CEMISPARAM_DST = "AMMA "
+CEMISPARAM_DST = "AMMA "
JPMODE_DST = 3
LVARSIG_DST = .FALSE.
LRGFIX_DST = .TRUE.
- CVERMOD = 'NONE '
+CVERMOD = 'NONE '
XFLX_MSS_FDG_FCT = 12.0e-4
IF (LHOOK) CALL DR_HOOK('DEFAULT_DST',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/default_flake.F90 b/src/SURFEX/default_flake.F90
index cdcf8c71e47d93d51f3c09d2dc2ce2425adb47b8..7f4e4bc7f82c07f72605da32e96644ed24459cfc 100644
--- a/src/SURFEX/default_flake.F90
+++ b/src/SURFEX/default_flake.F90
@@ -55,9 +55,9 @@ REAL, INTENT(OUT) :: POUT_TSTEP ! time step for writing
!
LOGICAL, INTENT(OUT) :: OSEDIMENTS
LOGICAL, INTENT(OUT) :: OSKINTEMP
- CHARACTER(LEN=3), INTENT(OUT) :: HSNOW_FLK
- CHARACTER(LEN=5), INTENT(OUT) :: HFLK_FLUX
- CHARACTER(LEN=4), INTENT(OUT) :: HFLK_ALB
+CHARACTER(LEN=3), INTENT(OUT) :: HSNOW_FLK
+CHARACTER(LEN=5), INTENT(OUT) :: HFLK_FLUX
+CHARACTER(LEN=4), INTENT(OUT) :: HFLK_ALB
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
diff --git a/src/SURFEX/default_isba.F90 b/src/SURFEX/default_isba.F90
index 6086101329ccd912f3f2b9b5c18cbd68c48b7a14..09fae542aaf47a5960e437c0061799587fd038b3 100644
--- a/src/SURFEX/default_isba.F90
+++ b/src/SURFEX/default_isba.F90
@@ -4,7 +4,7 @@
!SFX_LIC for details. version 1.
! #########
SUBROUTINE DEFAULT_ISBA(PTSTEP, POUT_TSTEP, &
- HROUGH, HRUNOFF, HALBEDO, HSCOND, &
+ HRUNOFF, HSCOND, &
HC1DRY, HSOILFRZ, HDIFSFCOND, HSNOWRES, &
HCPSURF, PCGMAX, PCDRAG, HKSAT, OSOC, &
HRAIN, HHORT, OGLACIER, OCANOPY_DRAG, &
@@ -60,21 +60,15 @@ IMPLICIT NONE
!
REAL, INTENT(OUT) :: PTSTEP ! time-step for run
REAL, INTENT(OUT) :: POUT_TSTEP ! time-step for writing
- CHARACTER(LEN=4), INTENT(OUT) :: HROUGH ! type of roughness length
- CHARACTER(LEN=4), INTENT(OUT) :: HALBEDO ! albedo type
-! ! 'DRY '
-! ! 'EVOL'
-! ! 'WET '
-! ! 'USER'
- CHARACTER(LEN=4), INTENT(OUT) :: HSCOND ! Thermal conductivity
+CHARACTER(LEN=4), INTENT(OUT) :: HSCOND ! Thermal conductivity
! ! 'DEF ' = DEFault: NP89 implicit method
! ! 'PL98' = Peters-Lidard et al. 1998 used
! ! for explicit computation of CG
- CHARACTER(LEN=4), INTENT(OUT) :: HC1DRY ! C1 formulation for dry soils
+CHARACTER(LEN=4), INTENT(OUT) :: HC1DRY ! C1 formulation for dry soils
! ! 'DEF ' = DEFault: Giard-Bazile formulation
! ! 'GB93' = Giordani 1993, Braud 1993
! !discontinuous at WILT
- CHARACTER(LEN=3), INTENT(OUT) :: HSOILFRZ ! soil freezing-physics option
+CHARACTER(LEN=3), INTENT(OUT) :: HSOILFRZ ! soil freezing-physics option
! ! 'DEF' = Default (Boone et al. 2000;
! ! Giard and Bazile 2000)
! ! 'LWT' = Phase changes as above,
@@ -84,30 +78,30 @@ REAL, INTENT(OUT) :: POUT_TSTEP ! time-step for writing
! the 'LWT' method is used. It is only an option
! when using the force-restore soil method ('2-L' or '3-L')
!
- CHARACTER(LEN=4), INTENT(OUT) :: HDIFSFCOND ! Mulch effects
+CHARACTER(LEN=4), INTENT(OUT) :: HDIFSFCOND ! Mulch effects
! ! 'MLCH' = include the insulating effect of
! ! leaf litter/mulch on the surf. thermal cond.
! ! 'DEF ' = no mulch effect
! NOTE: Only used when YISBA = DIF
!
- CHARACTER(LEN=3), INTENT(OUT) :: HSNOWRES ! Turbulent exchanges over snow
+CHARACTER(LEN=3), INTENT(OUT) :: HSNOWRES ! Turbulent exchanges over snow
! ! 'DEF' = Default: Louis (ISBA)
! ! 'RIL' = Maximum Richardson number limit
! ! for stable conditions ISBA-SNOW3L
! ! turbulent exchange option
- CHARACTER(LEN=3), INTENT(OUT) :: HCPSURF ! SPECIFIC HEAT
+CHARACTER(LEN=3), INTENT(OUT) :: HCPSURF ! SPECIFIC HEAT
! ! 'DRY' = dry Cp
! ! 'HUM' = Cp fct of qs
REAL, INTENT(OUT) :: PCGMAX ! maximum soil heat capacity
!
REAL, INTENT(OUT) :: PCDRAG ! drag coefficient in canopy
!
- CHARACTER(LEN=4), INTENT(OUT) :: HRUNOFF ! surface runoff formulation
+CHARACTER(LEN=4), INTENT(OUT) :: HRUNOFF ! surface runoff formulation
! ! 'WSAT'
! ! 'DT92'
! ! 'SGH ' Topmodel
!
- CHARACTER(LEN=3), INTENT(OUT) :: HKSAT ! SOIL HYDRAULIC CONDUCTIVITY PROFILE OPTION
+CHARACTER(LEN=3), INTENT(OUT) :: HKSAT ! SOIL HYDRAULIC CONDUCTIVITY PROFILE OPTION
! ! 'DEF' = ISBA homogenous soil
! ! 'SGH' = ksat exponential decay
!
@@ -115,12 +109,12 @@ LOGICAL, INTENT(OUT) :: OSOC ! SOIL ORGANIC CARBON PROFILE OPTION
! ! False = ISBA homogenous soil
! ! True = SOC profile effect
!
- CHARACTER(LEN=3), INTENT(OUT) :: HRAIN ! Rainfall spatial distribution
+CHARACTER(LEN=3), INTENT(OUT) :: HRAIN ! Rainfall spatial distribution
! 'DEF' = No rainfall spatial distribution
! 'SGH' = Rainfall exponential spatial distribution
!
!
- CHARACTER(LEN=3), INTENT(OUT) :: HHORT ! Horton runoff
+CHARACTER(LEN=3), INTENT(OUT) :: HHORT ! Horton runoff
! 'DEF' = no Horton runoff
! 'SGH' = Horton runoff
!
@@ -157,12 +151,7 @@ IF (LHOOK) CALL DR_HOOK('DEFAULT_ISBA',0,ZHOOK_HANDLE)
!
PTSTEP = XUNDEF
POUT_TSTEP = XUNDEF
-!!!!!do not phased!!!!!!!
-!HROUGH = "NONE"
-!!!!!do not phased!!!!!!!
-HROUGH = "UNDE" ! undefined. Needs further information on canopy scheme use to set default
HSCOND = "PL98"
-HALBEDO = "DRY "
!
HC1DRY = 'DEF '
HSOILFRZ = 'DEF'
diff --git a/src/SURFEX/default_prep_flake.F90 b/src/SURFEX/default_prep_flake.F90
index b6e1fa5f9b152a572fea6897aa3cb7d79f6094d5..ea91cc46373147d93211b6d2de3aa61fbd8daf1c 100644
--- a/src/SURFEX/default_prep_flake.F90
+++ b/src/SURFEX/default_prep_flake.F90
@@ -77,11 +77,11 @@ IMPLICIT NONE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('DEFAULT_PREP_FLAKE',0,ZHOOK_HANDLE)
- CFILE_FLAKE = ' '
- CTYPE = ' '
+CFILE_FLAKE = ' '
+CTYPE = ' '
!
- CFILEPGD_FLAKE = ' '
- CTYPEPGD = ' '
+CFILEPGD_FLAKE = ' '
+CTYPEPGD = ' '
!
XTS_UNIF = XUNDEF
XUNIF_T_SNOW = XUNDEF
diff --git a/src/SURFEX/default_prep_isba.F90 b/src/SURFEX/default_prep_isba.F90
index 8dc8d72d80087e735707e41b1f913b9509626119..ff12b9f763cd85dc094693536fe634b40603acf8 100644
--- a/src/SURFEX/default_prep_isba.F90
+++ b/src/SURFEX/default_prep_isba.F90
@@ -77,21 +77,21 @@ IMPLICIT NONE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('DEFAULT_PREP_ISBA',0,ZHOOK_HANDLE)
- CFILE_ISBA = ' '
- CTYPE = 'GRIB '
- CFILEPGD_ISBA = ' '
- CTYPEPGD = ' '
- CFILE_HUG = ' '
- CTYPE_HUG = ' '
- CFILE_TG = ' '
- CTYPE_TG = ' '
-!
- CFILE_HUG_SURF = ' '
- CFILE_HUG_ROOT = ' '
- CFILE_HUG_DEEP = ' '
- CFILE_TG_SURF = ' '
- CFILE_TG_ROOT = ' '
- CFILE_TG_DEEP = ' '
+CFILE_ISBA = ' '
+CTYPE = 'GRIB '
+CFILEPGD_ISBA = ' '
+CTYPEPGD = ' '
+CFILE_HUG = ' '
+CTYPE_HUG = ' '
+CFILE_TG = ' '
+CTYPE_TG = ' '
+!
+CFILE_HUG_SURF = ' '
+CFILE_HUG_ROOT = ' '
+CFILE_HUG_DEEP = ' '
+CFILE_TG_SURF = ' '
+CFILE_TG_ROOT = ' '
+CFILE_TG_DEEP = ' '
!
XHUG_SURF = XUNDEF
XHUG_ROOT = XUNDEF
diff --git a/src/SURFEX/default_prep_seaflux.F90 b/src/SURFEX/default_prep_seaflux.F90
index f74ea3334dd2326c97f50227ec03ed3a687acf6c..d8819dfd195606d37b982748306beef34bc2b5f0 100644
--- a/src/SURFEX/default_prep_seaflux.F90
+++ b/src/SURFEX/default_prep_seaflux.F90
@@ -71,18 +71,18 @@ IMPLICIT NONE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('DEFAULT_PREP_SEAFLUX',0,ZHOOK_HANDLE)
- CFILE_SEAFLX = ' '
- CTYPE_SEAFLX = 'GRIB '
+CFILE_SEAFLX = ' '
+CTYPE_SEAFLX = 'GRIB '
!
- CFILEPGD_SEAFLX = ' '
- CTYPEPGD = ' '
+CFILEPGD_SEAFLX = ' '
+CTYPEPGD = ' '
!
XSST_UNIF = XUNDEF
XSSS_UNIF = XUNDEF
XSIC_UNIF = XUNDEF
!
LSEA_SBL = .FALSE.
- CSEAICE_SCHEME='NONE '
+CSEAICE_SCHEME='NONE '
LOCEAN_MERCATOR = .FALSE.
LOCEAN_CURRENT = .FALSE.
!
diff --git a/src/SURFEX/default_prep_teb.F90 b/src/SURFEX/default_prep_teb.F90
index fdf3f96920c035e74659af7e1a8388bf2913080e..c8c06f94a7fcdd027bbb40af04f0985789bf7801 100644
--- a/src/SURFEX/default_prep_teb.F90
+++ b/src/SURFEX/default_prep_teb.F90
@@ -69,14 +69,14 @@ IMPLICIT NONE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('DEFAULT_PREP_TEB',0,ZHOOK_HANDLE)
- CFILE_TEB= ' '
- CTYPE = 'GRIB '
- CFILEPGD_TEB = ' '
- CTYPEPGD = ' '
- CFILE_WS = ' '
- CTYPE_WS = ' '
- CFILE_TS = ' '
- CTYPE_TS = ' '
+CFILE_TEB= ' '
+CTYPE = 'GRIB '
+CFILEPGD_TEB = ' '
+CTYPEPGD = ' '
+CFILE_WS = ' '
+CTYPE_WS = ' '
+CFILE_TS = ' '
+CTYPE_TS = ' '
!
XWS_ROOF = XUNDEF
XWS_ROAD = XUNDEF
@@ -96,8 +96,8 @@ XHUI_BLD_DEF = 0.5
XQ_CAN = 0.
!
LTEB_CANOPY = .FALSE.
- CROAD_DIR = 'UNIF'
- CWALL_OPT = 'UNIF'
+CROAD_DIR = 'UNIF'
+CWALL_OPT = 'UNIF'
!
IF (LHOOK) CALL DR_HOOK('DEFAULT_PREP_TEB',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/default_prep_teb_garden.F90 b/src/SURFEX/default_prep_teb_garden.F90
index dc8314c1a0a413656af1a96950600139481cbca0..523a1185a58496f7e430bb8334917741b7accd7e 100644
--- a/src/SURFEX/default_prep_teb_garden.F90
+++ b/src/SURFEX/default_prep_teb_garden.F90
@@ -72,21 +72,21 @@ IMPLICIT NONE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('DEFAULT_PREP_TEB_GARDEN',0,ZHOOK_HANDLE)
- CFILE_GD = ' '
- CTYPE = 'GRIB '
- CFILEPGD_GD = ' '
- CTYPEPGD = ' '
- CFILE_HUG_GD = ' '
- CTYPE_HUG = ' '
- CFILE_TG_GD = ' '
- CTYPE_TG = ' '
-!
- CFILE_HUG_SURF_GD = ' '
- CFILE_HUG_ROOT_GD = ' '
- CFILE_HUG_DEEP_GD = ' '
- CFILE_TG_SURF_GD = ' '
- CFILE_TG_ROOT_GD = ' '
- CFILE_TG_DEEP_GD = ' '
+CFILE_GD = ' '
+CTYPE = 'GRIB '
+CFILEPGD_GD = ' '
+CTYPEPGD = ' '
+CFILE_HUG_GD = ' '
+CTYPE_HUG = ' '
+CFILE_TG_GD = ' '
+CTYPE_TG = ' '
+!
+CFILE_HUG_SURF_GD = ' '
+CFILE_HUG_ROOT_GD = ' '
+CFILE_HUG_DEEP_GD = ' '
+CFILE_TG_SURF_GD = ' '
+CFILE_TG_ROOT_GD = ' '
+CFILE_TG_DEEP_GD = ' '
!
XHUG_SURF_GD = XUNDEF
XHUG_ROOT_GD = XUNDEF
diff --git a/src/SURFEX/default_prep_teb_greenroof.F90 b/src/SURFEX/default_prep_teb_greenroof.F90
index 1e51ae17ab1c6be62a649f1dfbf958ccfeb95601..5c20286c58b9a73df409e24bd4a12aa161272b7a 100644
--- a/src/SURFEX/default_prep_teb_greenroof.F90
+++ b/src/SURFEX/default_prep_teb_greenroof.F90
@@ -70,21 +70,21 @@ IMPLICIT NONE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('DEFAULT_PREP_TEB_GREENROOF',0,ZHOOK_HANDLE)
- CFILE_GR = ' '
- CTYPE = 'GRIB '
- CFILEPGD_GR = ' '
- CTYPEPGD = 'GRIB '
- CFILE_HUG_GR = ' '
- CTYPE_HUG = ' '
- CFILE_TG_GR = ' '
- CTYPE_TG = ' '
-!
- CFILE_HUG_SURF_GR = ' '
- CFILE_HUG_ROOT_GR = ' '
- CFILE_HUG_DEEP_GR = ' '
- CFILE_TG_SURF_GR = ' '
- CFILE_TG_ROOT_GR = ' '
- CFILE_TG_DEEP_GR = ' '
+CFILE_GR = ' '
+CTYPE = 'GRIB '
+CFILEPGD_GR = ' '
+CTYPEPGD = 'GRIB '
+CFILE_HUG_GR = ' '
+CTYPE_HUG = ' '
+CFILE_TG_GR = ' '
+CTYPE_TG = ' '
+!
+CFILE_HUG_SURF_GR = ' '
+CFILE_HUG_ROOT_GR = ' '
+CFILE_HUG_DEEP_GR = ' '
+CFILE_TG_SURF_GR = ' '
+CFILE_TG_ROOT_GR = ' '
+CFILE_TG_DEEP_GR = ' '
!
XHUG_SURF_GR = XUNDEF
XHUG_ROOT_GR = XUNDEF
diff --git a/src/SURFEX/default_prep_watflux.F90 b/src/SURFEX/default_prep_watflux.F90
index 2bb2c815102537491a71e6c16115129604c2ac77..309b2842e172c0922bacc9044e061fc869520a40 100644
--- a/src/SURFEX/default_prep_watflux.F90
+++ b/src/SURFEX/default_prep_watflux.F90
@@ -63,11 +63,11 @@ IMPLICIT NONE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('DEFAULT_PREP_WATFLUX',0,ZHOOK_HANDLE)
- CFILE_WATFLX = ' '
- CTYPE = 'GRIB '
+CFILE_WATFLX = ' '
+CTYPE = 'GRIB '
!
- CFILEPGD_WATFLX = ' '
- CTYPEPGD = ' '
+CFILEPGD_WATFLX = ' '
+CTYPEPGD = ' '
!
XTS_WATER_UNIF = XUNDEF
!
diff --git a/src/SURFEX/default_seaflux.F90 b/src/SURFEX/default_seaflux.F90
index cde5d7a7cd92591cb74ae00169e69044c5e816bc..bfa89dc0863aa84d7315b69f095a503d2511b859 100644
--- a/src/SURFEX/default_seaflux.F90
+++ b/src/SURFEX/default_seaflux.F90
@@ -57,8 +57,8 @@ IMPLICIT NONE
!
REAL, INTENT(OUT) :: PTSTEP ! time step for run
REAL, INTENT(OUT) :: POUT_TSTEP ! time step for writing
- CHARACTER(LEN=6), INTENT(OUT) :: HSEA_FLUX ! type of sea scheme
- CHARACTER(LEN=4), INTENT(OUT) :: HSEA_ALB ! type of sea albedo
+CHARACTER(LEN=6), INTENT(OUT) :: HSEA_FLUX ! type of sea scheme
+CHARACTER(LEN=4), INTENT(OUT) :: HSEA_ALB ! type of sea albedo
LOGICAL, INTENT(OUT) :: OPWG ! gustiness impact
LOGICAL, INTENT(OUT) :: OPRECIP ! precipitation correction
LOGICAL, INTENT(OUT) :: OPWEBB ! Webb correction
@@ -68,8 +68,8 @@ LOGICAL, INTENT(OUT) :: OPROGSST !two-way coupling
INTEGER, INTENT(OUT) :: KTIME_COUPLING!coupling frequency
REAL, INTENT(OUT) :: PICHCE !CE coef calculation for ECUME
REAL, INTENT(OUT) :: POCEAN_TSTEP !ocean 1D model time-step
- CHARACTER(LEN=6), INTENT(OUT) :: HINTERPOL_SST ! Quadratic interpolation of monthly SST
- CHARACTER(LEN=6), INTENT(OUT) :: HINTERPOL_SSS ! Quadratic interpolation of monthly SSS
+CHARACTER(LEN=6), INTENT(OUT) :: HINTERPOL_SST ! Quadratic interpolation of monthly SST
+CHARACTER(LEN=6), INTENT(OUT) :: HINTERPOL_SSS ! Quadratic interpolation of monthly SSS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.2 Declarations of local variables
diff --git a/src/SURFEX/default_seaice.F90 b/src/SURFEX/default_seaice.F90
index 57f639beb8065d66ecf94d00add6c660e8168068..5eecdfec7243bb6537fbf60fb559e85ad431b4a5 100644
--- a/src/SURFEX/default_seaice.F90
+++ b/src/SURFEX/default_seaice.F90
@@ -74,9 +74,9 @@ IMPLICIT NONE
! -------------------------
!
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling ISBA
- CHARACTER(LEN=6), INTENT(OUT) :: HINTERPOL_SIC ! Quadratic interpolation of monthly SIC
- CHARACTER(LEN=6), INTENT(OUT) :: HINTERPOL_SIT ! Quadratic interpolation of monthly SIT
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling ISBA
+CHARACTER(LEN=6), INTENT(OUT) :: HINTERPOL_SIC ! Quadratic interpolation of monthly SIC
+CHARACTER(LEN=6), INTENT(OUT) :: HINTERPOL_SIT ! Quadratic interpolation of monthly SIT
REAL, INTENT(OUT) :: PFREEZING_SST ! Value marking frozen sea in SST data
REAL, INTENT(OUT) :: PSEAICE_TSTEP ! For damping of SIC (days)
REAL, INTENT(OUT) :: PSIC_EFOLDING_TIME ! E-folding time on SIC relaxation
@@ -97,7 +97,7 @@ real zjl
!
IF (LHOOK) CALL DR_HOOK('DEFAULT_SEAICE',0,ZHOOK_HANDLE)
!
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
+CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
HINTERPOL_SIC = "NONE"
HINTERPOL_SIT = "NONE"
@@ -432,7 +432,7 @@ xhsimin = .2
!
alblc = 0.
xlmelt = 3.e-3
-xswhdfr = 0.95
+xswhdfr = 1.00
albyngi = 1.
albimlt = 0.56
albsmlt = 0.77
diff --git a/src/SURFEX/default_slt.F90 b/src/SURFEX/default_slt.F90
index 86ff743459502c9ca8b85144d6976e097f2aa7cc..e4f99f54a4c89da71b6fe82f411f277676888cc0 100644
--- a/src/SURFEX/default_slt.F90
+++ b/src/SURFEX/default_slt.F90
@@ -52,7 +52,7 @@ IMPLICIT NONE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('DEFAULT_SLT',0,ZHOOK_HANDLE)
- CEMISPARAM_SLT = 'Vig01'
+CEMISPARAM_SLT = 'Vig01'
JPMODE_SLT = 3
LVARSIG_SLT = .FALSE.
LRGFIX_SLT = .TRUE.
diff --git a/src/SURFEX/default_teb_veg.F90 b/src/SURFEX/default_teb_veg.F90
index e12325945ca1ce1d01d52591771c468139e8aaa4..5b72d9ea821342a2ec55f4b57a0d3197e8c8a442 100644
--- a/src/SURFEX/default_teb_veg.F90
+++ b/src/SURFEX/default_teb_veg.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DEFAULT_TEB_VEG(HROUGH,HRUNOFF,HALBEDO,HSCOND, &
+ SUBROUTINE DEFAULT_TEB_VEG(HRUNOFF, HSCOND, &
HC1DRY, HSOILFRZ, HDIFSFCOND, HSNOWRES, &
HCPSURF, PCGMAX, HKSAT, &
HRAIN, HHORT, &
@@ -53,8 +53,6 @@ IMPLICIT NONE
! -------------------------
!
!
- CHARACTER(LEN=4), INTENT(OUT) :: HROUGH ! type of roughness length
- CHARACTER(LEN=4), INTENT(OUT) :: HALBEDO ! albedo type ('DRY','EVOL4,'WET','USER')
CHARACTER(LEN=4), INTENT(OUT) :: HSCOND ! Thermal conductivity ('DEF','PL98')
CHARACTER(LEN=4), INTENT(OUT) :: HC1DRY ! C1 formulation for dry soils ('DEF','GB93')
CHARACTER(LEN=3), INTENT(OUT) :: HSOILFRZ ! soil freezing-physics option ('DEF','LWT')
@@ -84,9 +82,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('DEFAULT_TEB_VEG',0,ZHOOK_HANDLE)
!
-HROUGH = 'UNDE' ! undefined. Needs further information on canopy scheme use to set default
HSCOND = 'PL98'
-HALBEDO = 'DRY '
!
HC1DRY = 'DEF '
HSOILFRZ = 'DEF'
diff --git a/src/SURFEX/default_write_surf_atm.F90 b/src/SURFEX/default_write_surf_atm.F90
index e3a51c0072bcd64173ea9ad4d264da8d4e94152d..34b0b1d3746ae0ca85e793fac6b1ef590d6ce7af 100644
--- a/src/SURFEX/default_write_surf_atm.F90
+++ b/src/SURFEX/default_write_surf_atm.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DEFAULT_WRITE_SURF_ATM(ONOWRITE_CANOPY, ONOWRITE_TEXFILE)
+ SUBROUTINE DEFAULT_WRITE_SURF_ATM(ONOWRITE_CANOPY, ONOWRITE_TEXFILE, OSPLIT_PATCH)
! ########################################################################
!
!!**** *DEFAULT_WRITE_SURF_ATM* - routine to desactivate output writings
@@ -49,6 +49,7 @@ IMPLICIT NONE
!
LOGICAL, INTENT(OUT) :: ONOWRITE_CANOPY ! flag to desactivate writing of canopy fields
LOGICAL, INTENT(OUT) :: ONOWRITE_TEXFILE ! flag to desactivate writing of tex file
+LOGICAL, INTENT(OUT) :: OSPLIT_PATCH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.2 Declarations of local variables
@@ -58,6 +59,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('DEFAULT_WRITE_SURF_ATM',0,ZHOOK_HANDLE)
ONOWRITE_CANOPY = .FALSE.
ONOWRITE_TEXFILE = .TRUE.
+OSPLIT_PATCH = .TRUE.
IF (LHOOK) CALL DR_HOOK('DEFAULT_WRITE_SURF_ATM',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/detect_field.F90 b/src/SURFEX/detect_field.F90
index 7641d1b8351e7b1ddd1049d48e12d722c03a0031..73550f12aca9a34eb18299a5a73ebd23247aaa46 100644
--- a/src/SURFEX/detect_field.F90
+++ b/src/SURFEX/detect_field.F90
@@ -44,6 +44,9 @@
#ifdef SFX_MNH
USE MODI_DETECT_FIELD_MNH
#endif
+#ifdef SFX_ARO
+USE MODI_DETECT_FIELD_ARO
+#endif
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -51,6 +54,7 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+!
!* 0.1 declarations of arguments
!
CHARACTER (LEN=6), INTENT(IN) :: HPROGRAM ! program
diff --git a/src/SURFEX/dgam.F90 b/src/SURFEX/dgam.F90
index 4faad917bd2e653a360eaa7cc88e14ced080934a..6b8d46b14a5ae6695556d91d88118f17086788c0 100644
--- a/src/SURFEX/dgam.F90
+++ b/src/SURFEX/dgam.F90
@@ -5,11 +5,11 @@
!######################################################################
!######################################################################
!
-! THIS ROUTINE COMPUTE THE INCOMPLETE AND THE COMPLEMENTARY
+! THIS ROUTINE COMPUTE THE INCOMPLETE AND THE COMPLEMENTARY
! INCOMPLETE GAMMA FUNCTION REAL*8 IN BRIEF, THIS
! FUNCTION HELP TO COMPUTE THE DIFFERENT FRACTION PRESENT IN THE
! TOPMODEL FRAMEWORK.
-! MORE EXPLANATION ON THE SUBROUTINE USE ARE GIVEN IN THE NEXT
+! MORE EXPLANATION ON THE SUBROUTINE USE ARE GIVEN IN THE NEXT
! COMMENTARY
!
! THIS ROUTINE WAS FOUND ON http://www.netlib.org WEB SITE.
@@ -29,17 +29,17 @@
! FUNCTION, WHICH FOR A.GT.0. IS DEFINED BY
!
! GAMSTAR(A,X)=(X**(-A)/GAMMA(A))*INTEGRAL FROM T=0 TO T=X OF
-! EXP(-T)*T**(A-1),
+! EXP(-T)*T**(A-1),
!
! AND FOR A.LE.0. BY ANALYTIC CONTINUATION. FOR THE PURPOSE OF
! THIS SUBROUTINE, THESE FUNCTIONS ARE NORMALIZED AS FOLLOWS&
!
-! GAM(A,X)/GAMMA(A), IF A.GT.0.,
+! GAM(A,X)/GAMMA(A), IF A.GT.0.,
! G(A,X)=
-! EXP(X)*X**(-A)*GAM(A,X), IF A.LE.0.,
+! EXP(X)*X**(-A)*GAM(A,X), IF A.LE.0.,
!
! GSTAR(A,X)=(X**A)*GAMSTAR(A,X)
-! =(1/GAMMA(A))*INTEGRAL FROM T=0 TO T=X OF EXP(-T)*T**(A-1)
+! =(1/GAMMA(A))*INTEGRAL FROM T=0 TO T=X OF EXP(-T)*T**(A-1)
!
! THE PROGRAM BELOW ATTEMPTS TO EVALUATE G(A,X) AND GSTAR(A,X),
! BOTH TO AN ACCURACY OF ACC SIGNIFICANT DECIMAL DIGITS, FOR ARBI-
@@ -60,38 +60,38 @@
!
! PARAMETER LIST&
!
-! A - - THE FIRST ARGUMENT OF G AND GSTAR. TYPE REAL.
-! X - - THE SECOND ARGUMENT OF G AND GSTAR. TYPE REAL.
-! ACC - - THE NUMBER OF CORRECT SIGNIFICANT DECIMAL DIGITS
-! DESIRED IN THE RESULTS. TYPE REAL.
-! G - - AN OUTPUT VARIABLE RETURNING THE VALUE OF G(A,X).
-! TYPE REAL.
+! A - - THE FIRST ARGUMENT OF G AND GSTAR. TYPE REAL.
+! X - - THE SECOND ARGUMENT OF G AND GSTAR. TYPE REAL.
+!ACC - - THE NUMBER OF CORRECT SIGNIFICANT DECIMAL DIGITS
+! DESIRED IN THE RESULTS. TYPE REAL.
+! G - - AN OUTPUT VARIABLE RETURNING THE VALUE OF G(A,X).
+! TYPE REAL.
! GSTAR - - AN OUTPUT VARIABLE RETURNING THE VALUE OF
-! GSTAR(A,X). TYPE REAL.
+! GSTAR(A,X). TYPE REAL.
! IFLG - - AN ERROR FLAG INDICATING A NUMBER OF ERROR CONDI-
-! TIONS IN G UPON EXECUTION. TYPE INTEGER.
+! TIONS IN G UPON EXECUTION. TYPE INTEGER.
! IFLGST - - AN ERROR FLAG INDICATING A NUMBER OF ERROR CONDI-
-! TIONS IN GSTAR UPON EXECUTION. TYPE INTEGER.
-! THE VALUES OF IFLG AND IFLGST HAVE THE FOLLOWING
-! MEANINGS&
-! 0 - NO ERROR CONDITION.
-! 1 - ILLEGAL NEGATIVE ARGUMENT X. THE ROUTINE EXITS
-! WITH THE VALUES ZERO FOR G AND GSTAR.
-! 2 - INFINITELY LARGE RESULT AT X=0. THE ROUTINE
-! RETURNS THE LARGEST MACHINE-REPRESENTABLE NUMBER.
-! 3 - (ONLY FOR IFLGST) GSTAR IS INDETERMINATE AT
-! A=0. AND X=0. THE ROUTINE RETURNS THE VALUE 1.,
-! WHICH IS THE LIMIT VALUE AS X TENDS TO ZERO FOR
-! FIXED A=0.
-! 4 - THE RESULT UNDERFLOWS. IT IS SET EQUAL TO 0.
-! 5 - THE RESULT OVERFLOWS. IT IS SET EQUAL TO THE
-! LARGEST MACHINE-REPRESENTABLE NUMBER, WITH
-! PROPER SIGN.
-! 6 - CONVERGENCE FAILS WITHIN 600 ITERATIONS, EITHER
-! IN TAYLOR:S SERIES OR IN LEGENDRE:S CONTINUED
-! FRACTION. REASON UNKNOWN. THE COMPUTATION IS
-! ABORTED AND THE ROUTINE RETURNS WITH ZERO
-! VALUES FOR G AND GSTAR.
+! TIONS IN GSTAR UPON EXECUTION. TYPE INTEGER.
+! THE VALUES OF IFLG AND IFLGST HAVE THE FOLLOWING
+! MEANINGS&
+! 0 - NO ERROR CONDITION.
+! 1 - ILLEGAL NEGATIVE ARGUMENT X. THE ROUTINE EXITS
+!WITH THE VALUES ZERO FOR G AND GSTAR.
+! 2 - INFINITELY LARGE RESULT AT X=0. THE ROUTINE
+!RETURNS THE LARGEST MACHINE-REPRESENTABLE NUMBER.
+! 3 - (ONLY FOR IFLGST) GSTAR IS INDETERMINATE AT
+!A=0. AND X=0. THE ROUTINE RETURNS THE VALUE 1.,
+!WHICH IS THE LIMIT VALUE AS X TENDS TO ZERO FOR
+!FIXED A=0.
+! 4 - THE RESULT UNDERFLOWS. IT IS SET EQUAL TO 0.
+! 5 - THE RESULT OVERFLOWS. IT IS SET EQUAL TO THE
+!LARGEST MACHINE-REPRESENTABLE NUMBER, WITH
+!PROPER SIGN.
+! 6 - CONVERGENCE FAILS WITHIN 600 ITERATIONS, EITHER
+!IN TAYLOR:S SERIES OR IN LEGENDRE:S CONTINUED
+!FRACTION. REASON UNKNOWN. THE COMPUTATION IS
+!ABORTED AND THE ROUTINE RETURNS WITH ZERO
+!VALUES FOR G AND GSTAR.
!
! ALL MACHINE-DEPENDENT PARAMETERS ARE COLLECTED IN THE FIRST
! DATA DECLARATION. THEY ARE AS FOLLOWS&
@@ -124,331 +124,661 @@
!----------------------------------------------------
!! MODIFICATIONS
!! -------------
-!! J.Escobar 10/06/2013: replace DOUBLE PRECISION by REAL to handle problem for promotion of real on IBM SP
+!!J.Escobar10/06/2013: replace DOUBLE PRECISION by REAL to handle problem for promotion of real on IBM SP
!----------------------------------------------------
!################################################################
!
- SUBROUTINE DGAM(A, X, ACC, G, GSTAR, IFLG, IFLGST)
+SUBROUTINE DGAM(PA, PX, PACC, PG, PGSTAR, KFLG, KFLGST)
!
!################################################################
- USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
- USE PARKIND1 ,ONLY : JPRB
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
- IMPLICIT NONE
+IMPLICIT NONE
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL, INTENT(IN) :: PA, PX, PACC
+REAL, INTENT(OUT) :: PG, PGSTAR
+INTEGER, INTENT(OUT) :: KFLG, KFLGST
+!
+REAL, PARAMETER :: XALPREC=DIGITS(1.)*LOG(2.), &
+ XTOP=LOG10(HUGE(1.)), XBOT=LOG10(TINY(1.))
+!
+REAL :: ZALX, ZALPHA
+REAL :: ZAINF, ZEPS, ZEPS1, ZES, ZSGA
+REAL :: ZAE, ZAA, ZAP1, ZAM1, ZAEP1
+REAL :: ZAEM1, ZFMA, ZAEPS, ZSGAE, ZAAEPS, ZALGP1
+REAL :: ZSGGA, ZALGEP1, ZSGGS, ZALGS
+REAL :: ZALG, ZSUMM, ZGA, ZY, ZTERM, ZU, ZP, ZQ, ZR, ZV, ZT, ZH
+REAL :: ZSGT, ZA1X, ZRHO, ZXPA
+REAL :: ZXMA, ZS, ZTEMP
+!
+INTEGER :: JI, JK, JK1, JMA
+LOGICAL :: GRET
+!
+!RJ REAL,SAVE::AL10=2.3025850929940456840179914547
+REAL,DIMENSION(29),PARAMETER :: XC=(/ &
+ 0.57721566490153286060651209008, &
+ -.65587807152025388107701951515, &
+ -4.200263503409523552900393488e-2, &
+ 0.1665386113822914895017007951, &
+ -4.21977345555443367482083013e-2, &
+ -9.6219715278769735621149217e-3, &
+ 7.2189432466630995423950103e-3, &
+ -1.165167591859065112113971e-3, &
+ -2.15241674114950972815730e-4,&
+ 1.2805028238811618615320e-4, &
+ -2.013485478078823865569e-5, &
+ -1.2504934821426706573e-6, &
+ 1.1330272319816958824e-6, &
+ -2.056338416977607103e-7, &
+ 6.1160951044814158e-9, &
+ 5.0020076444692229e-9, &
+ -1.181274570487020e-9, &
+ 1.04342671169110e-10, &
+ 7.782263439905e-12, &
+ -3.696805618642e-12, &
+ 5.1003702875e-13,&
+ -2.058326054e-14, &
+ -5.34812254e-15, &
+ 1.2267786e-15, &
+ -1.181259e-16, &
+ 1.187e-18, &
+ 1.412e-18, &
+ -2.30e-19, &
+ 1.7e-20/)
- INTEGER,PARAMETER :: JDBL=8
- REAL :: A, X, ACC, G, GSTAR
- INTEGER :: IFLG, IFLGST, I, K, K1, MA
-
- REAL(KIND=JDBL) :: ALX, ALPHA, ALPREC
- REAL(KIND=JDBL) :: TOP, BOT, AINF, EPS, EPS1, ES, SGA
- REAL(KIND=JDBL) :: AE, AA, AP1, AM1, AEP1
- REAL(KIND=JDBL) :: AEM1, FMA, AEPS, SGAE, AAEPS, ALGP1
- REAL(KIND=JDBL) :: SGGA, ALGEP1, SGGS, ALGS
- REAL(KIND=JDBL) :: ALG, SUMM, GA, Y, TERM, U, P, Q, R, V, T, H
- REAL(KIND=JDBL) :: SGT, A1X, RHO, XPA
- REAL(KIND=JDBL) :: XMA, S, TEMP
-
-!RJ REAL(KIND=JDBL),SAVE::AL10=2.3025850929940456840179914547e0_JDBL
- REAL(KIND=JDBL),DIMENSION(29),PARAMETER :: C=(/ &
- & .57721566490153286060651209008e0_JDBL, &
- & -.65587807152025388107701951515e0_JDBL, &
- & -4.200263503409523552900393488e-2_JDBL, &
- & .1665386113822914895017007951e0_JDBL, &
- & -4.21977345555443367482083013e-2_JDBL, &
- & -9.6219715278769735621149217e-3_JDBL, &
- & 7.2189432466630995423950103e-3_JDBL, &
- & -1.165167591859065112113971e-3_JDBL, &
- & -2.15241674114950972815730e-4_JDBL, &
- & 1.2805028238811618615320e-4_JDBL, &
- & -2.013485478078823865569e-5_JDBL, &
- & -1.2504934821426706573e-6_JDBL, &
- & 1.1330272319816958824e-6_JDBL, &
- & -2.056338416977607103e-7_JDBL, &
- & 6.1160951044814158e-9_JDBL, &
- & 5.0020076444692229e-9_JDBL, &
- & -1.181274570487020e-9_JDBL, &
- & 1.04342671169110e-10_JDBL, &
- & 7.782263439905e-12_JDBL, &
- & -3.696805618642e-12_JDBL, &
- & 5.1003702875e-13_JDBL, &
- & -2.058326054e-14_JDBL, &
- & -5.34812254e-15_JDBL, &
- & 1.2267786e-15_JDBL, &
- & -1.181259e-16_JDBL, &
- & 1.187e-18_JDBL, &
- & 1.412e-18_JDBL, &
- & -2.30e-19_JDBL, &
- & 1.7e-20_JDBL/)
-
- IF (LHOOK) CALL DR_HOOK('DGAM',0,ZHOOK_HANDLE)
-
- G = 0.e0_JDBL
- GSTAR = 0.e0_JDBL
- IF (X<0.e0_JDBL) GO TO 290
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!
+IF (LHOOK) CALL DR_HOOK('DGAM',0,ZHOOK_HANDLE)
+!
+PG = 0.0
+PGSTAR = 0.0
+!
+KFLG = 0
+KFLGST = 0
+!
+IF ( PX<0. ) THEN
+ ! 290 deb
+ KFLG = 1
+ KFLGST = 1
+ IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
+ RETURN
+ ! 290 end
+ENDIF
!
! INITIALIZATION
!
- IFLG = 0
- IFLGST = 0
- I = 0
- IF (X>0.e0_JDBL) ALX = LOG(X*1.e0_JDBL)
- ALPHA = X + .25e0_JDBL
- IF (X<0.25e0_JDBL .AND. X>0.e0_JDBL) ALPHA = LOG(0.5e0_JDBL)/ALX
- ALPREC = DIGITS(1.e0_JDBL)*LOG(2.e0_JDBL)
- TOP = LOG10(HUGE(1.e0_JDBL))
- BOT = LOG10(TINY(1.e0_JDBL))
- AINF = HUGE(1.e0_JDBL)
- EPS = 0.5e0_JDBL*10.e0_JDBL**(-ACC)
- EPS1 = EPS/1.e2_JDBL
- SGA = 1.e0_JDBL
- IF (A<0.e0_JDBL) SGA = -SGA
- AE = A
- AA = ABS(A*1.e0_JDBL)
- AP1 = A + 1.e0_JDBL
- AEP1 = AP1
- MA = INT(0.5e0_JDBL-A)
- FMA = MA
- AEPS = A + FMA
- SGAE = 1.e0_JDBL
- IF (AEPS<0.e0_JDBL) SGAE = -SGAE
- AAEPS = ABS(AEPS)
- ALGP1 = 0.e0_JDBL
+ZAINF = HUGE(1.)
+ZAA = ABS(PA)
+!
+IF ( PX==0. ) THEN
+ !
+ ! EVALUATION OF GSTAR(A,0.) AND G(A,0.)
+ !
+ IF (PA<0.) THEN
+ KFLGST = 2
+ PGSTAR = ZAINF
+ PG = 1./ZAA
+ ELSEIF (PA==0.) THEN
+ KFLGST = 3
+ KFLG = 2
+ PGSTAR = 1.
+ PG = ZAINF
+ ELSEIF (PA>0.) THEN
+ PG = 1.
+ ENDIF
+ !
+ IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
+ RETURN
+ !
+ENDIF
+!
+! PX > 0.
+!
+! INITIALIZATION
+!
+JI = 0
+!
+ZEPS = 0.5*10.**(-PACC)
+ZEPS1 = ZEPS/100.
+!
+ZALX = LOG(PX)
+!
+ZALPHA = PX + 0.25
+IF ( PX<0.25 ) ZALPHA = LOG(0.5)/ZALX
+!
+ZSGA = 1.
+IF ( PA<0. ) ZSGA = -ZSGA
+!
+ZAE = PA
+ZAP1 = PA + 1.
+ZAEP1 = ZAP1
+!
+JMA = INT(0.5-PA)
+ZFMA = FLOAT(JMA)
+ZAEPS = PA + ZFMA
+ZAAEPS = ABS(ZAEPS)
+!
+ZSGAE = 1.
+IF (ZAEPS<0.) ZSGAE = -ZSGAE
!
! EVALUATION OF THE LOGARITHM OF THE ABSOLUTE VALUE OF
! GAMMA(A+1.) AND DETERMINATION OF THE SIGN OF GAMMA(A+1.)
!
- SGGA = 1.e0_JDBL
- IF (MA<=0) GO TO 10
- IF (AEPS==0.e0_JDBL) GO TO 20
- SGGA = SGAE
- IF (MA==2*(MA/2)) SGGA = -SGGA
- ALGP1 = DLGA(AEPS+1.e0_JDBL) - LOG(AAEPS)
- IF (MA==1) GO TO 20
- ALGP1 = ALGP1 + DLGA(1.e0_JDBL-AEPS) - DLGA(FMA-AEPS)
- GO TO 20
- 10 ALGP1 = DLGA(AP1)
- 20 ALGEP1 = ALGP1
- IF (X>0.e0_JDBL) GO TO 60
-!
-! EVALUATION OF GSTAR(A,0.) AND G(A,0.)
-!
- IF (A) 30, 40, 50
- 30 IFLGST = 2
- GSTAR = AINF
- G = 1.e0_JDBL/AA
- IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
- RETURN
- 40 IFLGST = 3
- GSTAR = 1.e0_JDBL
- IFLG = 2
- G = AINF
- IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
- RETURN
- 50 G = 1.e0_JDBL
- IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
- RETURN
- 60 IF (A>ALPHA) GO TO 220
- IF (X>1.5e0_JDBL) GO TO 240
- IF (A<-.5e0_JDBL) GO TO 170
-!
-! DIRECT EVALUATION OF G(A,X) AND GSTAR(A,X) FOR X.LE.1.5
-! AND -.5.LE.A.LE.ALPHA(X)
-!
- GSTAR = 1.e0_JDBL
- IF (A>=0.5e0_JDBL) GO TO 110
- 70 SUMM = C(29)
- DO 80 K=1,28
- K1 = 29 - K
- SUMM = AE*SUMM + C(K1)
- 80 CONTINUE
- GA = -SUMM/(1.e0_JDBL+AE*SUMM)
- Y = AE*ALX
- IF (ABS(Y)>=1.e0_JDBL) GO TO 100
- SUMM = 1.e0_JDBL
- TERM = 1.e0_JDBL
- K = 1
- 90 K = K + 1
- IF (K>600) GO TO 330
- TERM = Y*TERM/K
- SUMM = SUMM + TERM
- IF (ABS(TERM)>EPS1*SUMM) GO TO 90
- U = GA - SUMM*ALX
- GO TO 120
- 100 U = GA - (EXP(Y)-1.e0_JDBL)/AE
- GO TO 120
- 110 TEMP=DLGA(A*1.e0_JDBL)
- U = DEXP(TEMP) - (X**A)/A
- 120 P = AE*X
- Q = AEP1
- R = AE + 3.e0_JDBL
- TERM = 1.e0_JDBL
- SUMM = 1.e0_JDBL
- K = 1
- 130 K = K + 1
- IF (K>600) GO TO 330
- P = P + X
- Q = Q + R
- R = R + 2.e0_JDBL
- TERM = -P*TERM/Q
- SUMM = SUMM + TERM
- IF (ABS(TERM)>EPS1*SUMM) GO TO 130
- V = (X**AEP1)*SUMM/AEP1
- G = U + V
- IF (I==1) GO TO 180
- IF (A) 140, 150, 160
- 140 T = EXP(X*1.e0_JDBL)*X**(-A)
- G = T*G
- GSTAR = 1.e0_JDBL - A*G*DEXP(-ALGP1)/T
- IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
- RETURN
- 150 G = EXP(X*1.e0_JDBL)*G
+ZALGP1 = 0.
+ZSGGA = 1.
+!
+IF (JMA>0 .AND. ZAEPS/=0.) THEN
+
+ ZSGGA = ZSGAE
+ IF ( JMA==2*(JMA/2) ) ZSGGA = -ZSGGA
+ ZALGP1 = DLGA(ZAEPS+1.) - LOG(ZAAEPS)
+
+ IF (JMA/=1) THEN
+ ZALGP1 = ZALGP1 + DLGA(1.-ZAEPS) - DLGA(ZFMA-ZAEPS)
+ ENDIF
+
+ELSEIF ( JMA<=0 ) THEN
+ !10 deb
+ ZALGP1 = DLGA(ZAP1)
+ ! 10 end
+ENDIF
+!
+! 20 deb
+ZALGEP1 = ZALGP1
+!
+!Map:
+! PA<=ZALPHA
+! !
+! PX>1.5
+! PA <0., ==0., >0.
+! RETURN
+! !
+! PA<-0.5
+! PX<0.25 .AND. ZAE>ZALPHA
+! ELSE
+! !
+! PA <0.5
+! ELSE
+! !
+! CODE120
+! PA <0., ==0., >0.
+! RETURN
+! !
+! PA>ZALPHA
+!
+! 60 deb
+IF ( PA<=ZALPHA ) THEN
+ !
+ IF ( PX>1.5 ) THEN
+ !
+ ! EVALUATION OF G(A,X) FOR X.GT.1.5 AND A.LE.ALPHA(X) BY
+ ! MEANS OF THE LEGENDRE CONTINUED FRACTION
+ !
+ !240 deb
+ PGSTAR = 1.
+ ZXPA = PX + 1. - PA
+ ZXMA = PX - 1. - PA
+ ZP = 0.
+ ZQ = ZXPA*ZXMA
+ ZR = 4.*ZXPA
+ ZS = -PA + 1.
+ ZTERM = 1.
+ ZSUMM = 1.
+ ZRHO = 0.
+ !
+ DO JK = 1,600
+ !
+ ZP = ZP + ZS
+ ZQ = ZQ + ZR
+ ZR = ZR + 8.
+ ZS = ZS + 2.
+ ZT = ZP*(1.+ZRHO)
+ ZRHO = ZT/(ZQ-ZT)
+ ZTERM = ZRHO*ZTERM
+ ZSUMM = ZSUMM + ZTERM
+ !
+ IF ( ABS(ZTERM)<=ZEPS*ZSUMM ) EXIT
+ !
+ IF ( JK==600 ) THEN
+ ! 330 deb
+ KFLG = 6
+ IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
+ RETURN
+ ! 330 end
+ ENDIF
+ !
+ ENDDO
+ !
+ IF ( PA<0. ) THEN
+ !
+ ! 260 deb
+ PG = ZSUMM/ZXPA
+ ZALG = LOG (PG)
+ ! 260 end
+ !
+ ! EVALUATION OF GSTAR(A,X) IN TERMS OF G(A,X)
+ ! 200 deb (200 est la fin de 180)
+ CALL CODE200(JMA, PX, PA, ZAEPS, ZSGA, ZSGGA, ZAA, ZALX, &
+ ZALG, ZALGP1, ZAINF, PGSTAR, KFLGST, GRET)
+ !
+ IF ( GRET ) THEN
+ IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
+ RETURN
+ ENDIF
+ !
+ ELSEIF ( PA==0. ) THEN
+ !
+ ! 270 deb
+ PG = ZSUMM/ZXPA
+ ! 270 end
+ !
+ ELSEIF ( PA>0. ) THEN
+ !
+ ! 280 deb
+ ZALG = PA*ZALX - PX + LOG(PA*ZSUMM/ZXPA) - ZALGP1
+ !
+ IF ( ZALG<=XBOT ) THEN
+ ! 300 deb
+ KFLG = 4
+ IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
+ RETURN
+ ! 300 end
+ ENDIF
+ !
+ PG = EXP(ZALG)
+ PGSTAR = 1. - PG
+ ! 280 end
+ !
+ ENDIF
+ !
+ IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
+ RETURN
+ !
+ ENDIF ! end PX>1.5
+ !
+ !
+ IF ( PA<-0.5 ) THEN
+ !
+ ! RECURSIVE EVALUATION OF G(A,X) FOR X.LE.1.5 AND A.LT.-.5
+ !
+ ! 170 deb
+ JI = 1
+ ZAE = ZAEPS
+ ZAEP1 = ZAEPS + 1.
+ ! 170 end
+ !
+ IF ( PX<0.25 .AND. ZAE>ZALPHA ) THEN
+ !
+ ! 210 deb
+ JI = 2
+ ZALGEP1 = DLGA(ZAEP1)
+ !
+ ! EVALUATION OF GSTAR(A,X) FOR A.GT.ALPHA(X) BY TAYLOR
+ ! EXPANSION
+ !
+ CALL CODE220(PX,ZAE,ZALX,ZALGEP1,ZEPS,PG,PGSTAR,KFLGST,GRET)
+ !
+ IF ( GRET ) THEN
+ IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
+ RETURN
+ ENDIF
+ !
+ PG = PG*EXP(ZALGEP1)/ZAE
+ ! 210 end (220 230)
+ !
+ ! 180 deb
+ CALL CODE180(JMA, PX, PA, ZAE, ZAEPS, ZSGA, ZSGGA, ZAA, ZALX, &
+ ZALGP1, ZAINF, PG, PGSTAR, KFLGST, GRET)
+ !
+ IF ( GRET ) THEN
+ IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
+ RETURN
+ ENDIF
+ !
+ ENDIF ! PX<0.25 .AND. ZAE>ZALPHA
+ !
+ ELSE ! end PA < -0.5
+ !
+ ! DIRECT EVALUATION OF G(A,X) AND GSTAR(A,X) FOR X.LE.1.5
+ ! AND -.5.LE.A.LE.ALPHA(X)
+ !
+ PGSTAR = 1.
+ !
+ ENDIF
+ !
+ IF ( PA<0.5 ) THEN
+ !
+ ! 70 deb
+ ZSUMM = XC(29)
+ !
+ DO JK = 1,28
+ JK1 = 29 - JK
+ ZSUMM = ZAE*ZSUMM + XC(JK1)
+ ENDDO
+ !
+ ZGA = -ZSUMM / (1.+ZAE*ZSUMM)
+ ZY = ZAE*ZALX
+ !
+ IF ( ABS(ZY)<1. ) THEN
+ !
+ ZSUMM = 1.
+ ZTERM = 1.
+ !
+ DO JK = 1,600
+ !
+ ZTERM = ZY * ZTERM / JK
+ ZSUMM = ZSUMM + ZTERM
+ !
+ IF ( ABS(ZTERM)<=ZEPS1*ZSUMM ) EXIT
+ !
+ IF ( JK==600) THEN
+ KFLG = 6
+ IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
+ RETURN
+ ENDIF
+ !
+ ENDDO
+ !
+ ZU = ZGA - ZSUMM*ZALX
+ ! 70 end
+ !
+ ELSE
+ !
+ ! 100 deb
+ ZU = ZGA - (EXP(ZY)-1.)/ZAE
+ ! 100 end
+ !
+ ENDIF
+ !
+ ELSE
+ !
+ ! 110 deb
+ ZTEMP = DLGA(PA*1.)
+ ZU = DEXP(ZTEMP) - (PX**PA)/PA
+ ! 110 end
+ !
+ ENDIF
+ !
+ ! 120 deb
+ ZP = ZAE*PX
+ ZQ = ZAEP1
+ ZR = ZAE + 3.
+ ZTERM = 1.
+ ZSUMM = 1.
+ !
+ DO JK = 1,600
+ !
+ ZP = ZP + PX
+ ZQ = ZQ + ZR
+ ZR = ZR + 2.
+ ZTERM = -ZP * ZTERM / ZQ
+ ZSUMM = ZSUMM + ZTERM
+ !
+ IF ( ABS(ZTERM)<=ZEPS1*ZSUMM ) EXIT
+ !
+ IF ( JK==600) THEN
+ KFLG = 6
IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
RETURN
- 160 G = A*G*EXP(-ALGP1)
- GSTAR = 1.e0_JDBL - G
+ !
+ ENDIF
+ !
+ ENDDO
+ !
+ ZV = (PX**ZAEP1) * ZSUMM / ZAEP1
+ PG = ZU + ZV
+ !
+ IF (JI==1) THEN
+ !
+ ! 180 deb
+ CALL CODE180(JMA, PX, PA, ZAE, ZAEPS, ZSGA, ZSGGA, ZAA, ZALX, &
+ ZALGP1, ZAINF, PG, PGSTAR, KFLGST, GRET)
+ !
+ IF ( GRET ) THEN
IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
RETURN
+ ENDIF
+ !
+ ENDIF
+ !
+ IF (PA<0.) THEN
+ !
+ ZT = EXP(PX) * PX**(-PA)
+ PG = ZT * PG
+ PGSTAR = 1. - PA * PG * DEXP(-ZALGP1) / ZT
+ !
+ ELSEIF (PA==0.) THEN
+ !
+ PG = EXP(PX)*PG
+ !
+ ELSEIF (PA>0.) THEN
+ !
+ PG = PA*PG*EXP(-ZALGP1)
+ PGSTAR = 1. - PG
+ !
+ ENDIF
+ !
+ IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
+ RETURN
+ ! 120 end
+ !
+ENDIF
+!
+! EVALUATION OF GSTAR(A,X) FOR A.GT.ALPHA(X) BY TAYLOR
+! EXPANSION
+!
+! PA > ZALPHA : 220 deb
+ CALL CODE220(PX,ZAE,ZALX,ZALGEP1,ZEPS,PG,PGSTAR,KFLGST,GRET)
+!
+IF ( GRET .OR. JI/=2) THEN
+ IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
+!
+PG = PG*EXP(ZALGEP1)/ZAE
+! 220 230 end
+!
+! 180 deb
+! 180 deb
+ CALL CODE180(JMA, PX, PA, ZAE, ZAEPS, ZSGA, ZSGGA, ZAA, ZALX, &
+ ZALGP1, ZAINF, PG, PGSTAR, KFLGST, GRET)
+!
+CONTAINS
+!
+!
+SUBROUTINE CODE220(PX,PAE,PALX,PALGEP1,PEPS,PG,PGSTAR,KFLGST,ORET)
+!
+IMPLICIT NONE
+!
+REAL, INTENT(IN) :: PX
+REAL, INTENT(IN) :: PAE
+REAL, INTENT(IN) :: PALX
+REAL, INTENT(IN) :: PALGEP1
+REAL, INTENT(IN) :: PEPS
+REAL, INTENT(OUT) :: PG
+REAL, INTENT(INOUT) :: PGSTAR
+INTEGER, INTENT(INOUT) :: KFLGST
+LOGICAL, INTENT(OUT) :: ORET
+!
+REAL :: ZTERM, ZSUMM, ZALGS
+INTEGER :: JK
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('DGAM:CODE220',0,ZHOOK_HANDLE)
+!
+! 220 deb
+PG = 1.
+ZTERM = 1.
+ZSUMM = 1.
+!
+DO JK = 1,600
+ !
+ ZTERM = PX*ZTERM/(PAE+JK)
+ ZSUMM = ZSUMM + ZTERM
+ IF (ABS(ZTERM)<=PEPS*ZSUMM) EXIT
+ !
+ IF ( JK==600 ) THEN
+ KFLGST = 6
+ IF (LHOOK) CALL DR_HOOK('DGAM:CODE220',1,ZHOOK_HANDLE)
+ RETURN
+ ENDIF
+ !
+ENDDO
+!
+ZALGS = PAE*PALX - PX + LOG(ZSUMM) - PALGEP1
+!
+IF ( ZALGS<=XBOT ) THEN
+ KFLGST = 4
+ IF (LHOOK) CALL DR_HOOK('DGAM:CODE220',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
+!
+PGSTAR = EXP(ZALGS)
+PG = 1. - PGSTAR
+!
+IF (LHOOK) CALL DR_HOOK('DGAM:CODE220',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE CODE220
+!
+!
+SUBROUTINE CODE200(KMA, PX, PA, PAEPS, PSGA, PSGGA, PAA, PALX, &
+ PALG, PALGP1, PAINF, PGSTAR, KFLGST, ORET)
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KMA
+REAL, INTENT(IN) :: PX
+REAL, INTENT(IN) :: PA
+REAL, INTENT(IN) :: PAEPS
+REAL, INTENT(IN) :: PSGA
+REAL, INTENT(IN) :: PSGGA
+REAL, INTENT(IN) :: PAA
+REAL, INTENT(IN) :: PALX
+REAL, INTENT(IN) :: PALG
+REAL, INTENT(IN) :: PALGP1
+REAL, INTENT(IN) :: PAINF
+REAL, INTENT(OUT) :: PGSTAR
+INTEGER, INTENT(INOUT) :: KFLGST
+LOGICAL, INTENT(OUT) :: ORET
+!
+REAL :: ZSGT, ZT
+INTEGER :: JK
!
-! RECURSIVE EVALUATION OF G(A,X) FOR X.LE.1.5 AND A.LT.-.5
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
- 170 I = 1
- AE = AEPS
- AEP1 = AEPS + 1.e0_JDBL
- IF (X<0.25e0_JDBL .AND. AE>ALPHA) GO TO 210
- GO TO 70
- 180 G = G*EXP(X*1.e0_JDBL)*X**(-AE)
- DO 190 K=1,MA
- G = (1.e0_JDBL-X*G)/(K-AE)
- 190 CONTINUE
- ALG = LOG(G*1.e0_JDBL)
+IF (LHOOK) CALL DR_HOOK('DGAM:CODE200',0,ZHOOK_HANDLE)
+!
+ORET = .FALSE.
!
! EVALUATION OF GSTAR(A,X) IN TERMS OF G(A,X)
!
- 200 GSTAR = 1.e0_JDBL
- IF (MA>=0 .AND. AEPS==0.e0_JDBL .AND. LHOOK) &
- & CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
- IF (MA>=0 .AND. AEPS==0.0_JDBL) RETURN
- SGT = SGA*SGGA
- T = LOG(AA) - X + A*ALX + ALG - ALGP1
- IF (T<-ALPREC .AND. LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
- IF (T<-ALPREC) RETURN
- IF (T>=TOP) GO TO 320
- GSTAR = 1.e0_JDBL - SGT*EXP(T)
- IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
- RETURN
- 210 I = 2
- ALGEP1 = DLGA(AEP1)
+PGSTAR = 1.
!
-! EVALUATION OF GSTAR(A,X) FOR A.GT.ALPHA(X) BY TAYLOR
-! EXPANSION
+IF ( KMA>=0 .AND. PAEPS==0. ) THEN
+ ORET = .TRUE.
+ IF ( LHOOK ) CALL DR_HOOK('DGAM:CODE200',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
!
- 220 G = 1.e0_JDBL
- TERM = 1.e0_JDBL
- SUMM = 1.e0_JDBL
- K = 0
- 230 K = K + 1
- IF (K>600) GO TO 340
- TERM = X*TERM/(AE+K)
- SUMM = SUMM + TERM
- IF (ABS(TERM)>EPS*SUMM) GO TO 230
- ALGS = AE*ALX - X + LOG(SUMM) - ALGEP1
- IF (ALGS<=BOT) GO TO 310
- GSTAR = EXP(ALGS)
- G = 1.e0_JDBL - GSTAR
- IF (I/=2 .AND. LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
- IF (I/=2) RETURN
- G = G*EXP(ALGEP1)/AE
- GO TO 180
-!
-! EVALUATION OF G(A,X) FOR X.GT.1.5 AND A.LE.ALPHA(X) BY
-! MEANS OF THE LEGENDRE CONTINUED FRACTION
-!
- 240 GSTAR = 1.e0_JDBL
- XPA = X + 1.e0_JDBL - A
- XMA = X - 1.e0_JDBL - A
- P = 0.e0_JDBL
- Q = XPA*XMA
- R = 4.e0_JDBL*XPA
- S = -A + 1.e0_JDBL
- TERM = 1.e0_JDBL
- SUMM = 1.e0_JDBL
- RHO = 0.e0_JDBL
- K = 1
- 250 K = K + 1
- IF (K>600) GO TO 330
- P = P + S
- Q = Q + R
- R = R + 8.e0_JDBL
- S = S + 2.e0_JDBL
- T = P*(1.e0_JDBL+RHO)
- RHO = T/(Q-T)
- TERM = RHO*TERM
- SUMM = SUMM + TERM
- IF (ABS(TERM)>EPS*SUMM) GO TO 250
- IF (A) 260, 270, 280
- 260 G = SUMM/XPA
- ALG = LOG(G*1.e0_JDBL)
- GO TO 200
- 270 G = SUMM/XPA
- IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
- RETURN
- 280 ALG = A*ALX - X + LOG(A*SUMM/XPA) - ALGP1
- IF (ALG<=BOT) GO TO 300
- G = EXP(ALG)
- GSTAR = 1.e0_JDBL - G
- IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
- RETURN
- 290 IFLG = 1
- IFLGST = 1
- IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
- RETURN
- 300 IFLG = 4
- IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
- RETURN
- 310 IFLGST = 4
- IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
- RETURN
- 320 IFLGST = 5
- GSTAR = -SGT*AINF
- IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
- RETURN
- 330 IFLG = 6
- IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
- RETURN
- 340 IFLGST = 6
- IF (LHOOK) CALL DR_HOOK('DGAM',1,ZHOOK_HANDLE)
- RETURN
-
- CONTAINS
-
- FUNCTION DLGA(DX) RESULT(DLGAR)
-
- USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
- USE PARKIND1 ,ONLY : JPRB
+ZSGT = PSGA*PSGGA
+ZT = LOG(PAA) - PX + PA*PALX + PALG - PALGP1
+!
+IF ( ZT<-XALPREC .OR. ZT>=XTOP ) THEN
+ !
+ IF ( ZT>=XTOP ) THEN
+ KFLGST = 5
+ PGSTAR = -ZSGT*PAINF
+ ENDIF
+ !
+ ORET = .TRUE.
+ IF ( LHOOK ) CALL DR_HOOK('DGAM:CODE200',1,ZHOOK_HANDLE)
+ RETURN
+ !
+ENDIF
+!
+PGSTAR = 1. - ZSGT*EXP(ZT)
+!
+IF (LHOOK) CALL DR_HOOK('DGAM:CODE200',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE CODE200
+!
+!
+SUBROUTINE CODE180(KMA, PX, PA, PAE, PAEPS, PSGA, PSGGA, PAA, PALX, &
+ PALGP1, PAINF, PG, PGSTAR, KFLGST, ORET)
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KMA
+REAL, INTENT(IN) :: PX
+REAL, INTENT(IN) :: PA
+REAL, INTENT(IN) :: PAE
+REAL, INTENT(IN) :: PAEPS
+REAL, INTENT(IN) :: PSGA
+REAL, INTENT(IN) :: PSGGA
+REAL, INTENT(IN) :: PAA
+REAL, INTENT(IN) :: PALX
+REAL, INTENT(IN) :: PALGP1
+REAL, INTENT(IN) :: PAINF
+REAL, INTENT(INOUT) :: PG
+REAL, INTENT(OUT) :: PGSTAR
+INTEGER, INTENT(INOUT) :: KFLGST
+LOGICAL, INTENT(OUT) :: ORET
+!
+REAL :: ZALG
+INTEGER :: JK
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('DGAM:CODE180',0,ZHOOK_HANDLE)
+!
+PG = PG*EXP(PX)*PX**(-PAE)
+!
+DO JK = 1,KMA
+ PG = (1.-PX*PG)/(JK-PAE)
+ENDDO
+!
+ZALG = LOG(PG)
+!
+! EVALUATION OF GSTAR(A,X) IN TERMS OF G(A,X)
+!
+ CALL CODE200(KMA, PX, PA, PAEPS, PSGA, PSGGA, PAA, PALX, &
+ ZALG, PALGP1, PAINF, &
+ PGSTAR, KFLGST, ORET)
+!
+IF (LHOOK) CALL DR_HOOK('DGAM:CODE180',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE CODE180
+!
+!
+FUNCTION DLGA(PDX) RESULT(PDLGAR)
- IMPLICIT NONE
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IMPLICIT NONE
- REAL(KIND=JDBL) :: DLGAR
- REAL(KIND=JDBL) :: DX, DC, DP, DY, DT, DS
- REAL(KIND=JDBL),DIMENSION(8),PARAMETER :: DBNUM=(/ &
- & -3.617e3_JDBL,1.e0_JDBL,-6.91e2_JDBL,1.e0_JDBL, &
- & -1.e0_JDBL, 1.e0_JDBL,-1.e0_JDBL, 1.e0_JDBL/)
- REAL(KIND=JDBL),DIMENSION(8),PARAMETER :: DBDEN=(/ &
- & 1.224e5_JDBL,1.56e2_JDBL,3.6036e5_JDBL,1.188e3_JDBL, &
- & 1.68e3_JDBL, 1.26e3_JDBL,3.6e2_JDBL, 1.2e1_JDBL/)
+REAL :: PDLGAR
+!
+REAL, INTENT(IN) :: PDX
+!
+REAL :: ZDC, ZDP, ZDY, ZDT, ZDS
+!
+REAL,DIMENSION(8),PARAMETER :: &
+ XDBNUM=(/-3617., 1., -691., 1., -1., 1., -1., 1./)
+REAL,DIMENSION(8),PARAMETER :: &
+ XDBDEN=(/122400., 156., 360360., 1188., 1680., 1260., 360. , 12./)
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
- IF (LHOOK) CALL DR_HOOK('DLGA',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('DGAMM:DLGA',0,ZHOOK_HANDLE)
- DC = 0.5e0_JDBL*LOG(8.e0_JDBL*ATAN(1.e0_JDBL))
- DP = 1.e0_JDBL
- DY = DX
- Y = DY
+ZDC = 0.5*LOG(8.*ATAN(1.))
+ZDP = 1.
+ZDY = PDX
+ZY = ZDY
!
! THE CONDITIONAL CLAUSE IN THE NEXT STATEMENT EXPRESSES THE
! INEQUALITY Y.GT.EXP(.121189*DPREC+.053905), WHERE DPREC IS THE
@@ -456,19 +786,23 @@
! ARITHMETIC.
!
!RJ-remark this magic number is for 53 significant bit prec only +/-!!!!
- 10 IF (Y>35.027_JDBL) GO TO 20
- DP = DY*DP
- DY = DY + 1.e0_JDBL
- Y = DY
- GO TO 10
- 20 DT = 1.e0_JDBL/(DY*DY)
- DS = 4.3867e4_JDBL/2.44188e5_JDBL
- DO 30 I=1,8
- DS = DT*DS + DBNUM(I)/DBDEN(I)
- 30 CONTINUE
- DLGAR = (DY-0.5e0_JDBL)*LOG(DY) - DY + DC + DS/DY - LOG(DP)
- IF (LHOOK) CALL DR_HOOK('DLGA',1,ZHOOK_HANDLE)
- RETURN
- END FUNCTION DLGA
+DO WHILE ( ZY<=35.027 )
+ ZDP = ZDY*ZDP
+ ZDY = ZDY + 1.
+ ZY = ZDY
+ENDDO
+!
+ZDT = 1./(ZDY*ZDY)
+ZDS = 43867./244188.
+!
+DO JI=1,8
+ ZDS = ZDT*ZDS + XDBNUM(JI)/XDBDEN(JI)
+ENDDO
+!
+PDLGAR = (ZDY-0.5)*LOG(ZDY) - ZDY + ZDC + ZDS/ZDY - LOG(ZDP)
+!
+IF (LHOOK) CALL DR_HOOK('DGAMM:DLGA',1,ZHOOK_HANDLE)
+!
+END FUNCTION DLGA
- END SUBROUTINE DGAM
+END SUBROUTINE DGAM
diff --git a/src/SURFEX/diag_cpl_esm_flake.F90 b/src/SURFEX/diag_cpl_esm_flake.F90
index 26e27372b5da568b3e51e8342fba5d18208a802a..25abeda6ad71729077e781dce589133980c71e34 100644
--- a/src/SURFEX/diag_cpl_esm_flake.F90
+++ b/src/SURFEX/diag_cpl_esm_flake.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_CPL_ESM_FLAKE (F, &
- PTSTEP,PRAIN,PSNOW,PSFTQ)
+ SUBROUTINE DIAG_CPL_ESM_FLAKE (F,PTSTEP,PRAIN,PSNOW,PSFTQ)
! #####################################################################
!
!!**** *DIAG_CPL_ESM_FLAKE * - Computes diagnostics over sea for
diff --git a/src/SURFEX/diag_cpl_esm_isba.F90 b/src/SURFEX/diag_cpl_esm_isba.F90
index 7cc593c075f8294b9d087e2dcb9bd88810616ff2..0be40636c8efcb6aefac727db4104469fb491716 100644
--- a/src/SURFEX/diag_cpl_esm_isba.F90
+++ b/src/SURFEX/diag_cpl_esm_isba.F90
@@ -3,9 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_CPL_ESM_ISBA (I, &
- PTSTEP,PCPL_DRAIN,PCPL_RUNOFF,PCPL_EFLOOD, &
- PCPL_PFLOOD,PCPL_IFLOOD,PCPL_ICEFLUX )
+ SUBROUTINE DIAG_CPL_ESM_ISBA (IO, S, NK, NP, PTSTEP, PCPL_DRAIN, PCPL_RUNOFF, &
+ PCPL_EFLOOD,PCPL_PFLOOD,PCPL_IFLOOD,PCPL_ICEFLUX )
! #####################################################################
!
!!**** *DIAG_CPL_ESM_ISBA*
@@ -39,15 +38,16 @@
!! -------------
!!
!! B. Decharme 01/16 : Bug with flood budget and add cpl keys
+!! B. Decharme 10/2016 bug surface/groundwater coupling
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_P_t, ISBA_NK_t, ISBA_NP_t
!
USE MODN_SFX_OASIS, ONLY : XTSTEP_CPL_LAND
-!
USE MODD_SFX_OASIS, ONLY : LCPL_FLOOD, LCPL_GW
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -57,8 +57,10 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-!
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_NK_t), INTENT(INOUT) :: NK
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
!
REAL, INTENT(IN) :: PTSTEP
REAL, DIMENSION(:,:), INTENT(IN) :: PCPL_DRAIN
@@ -70,14 +72,16 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PCPL_ICEFLUX
!
!* 0.2 declarations of local variables
!
+TYPE(ISBA_K_t), POINTER :: KK
+TYPE(ISBA_P_t), POINTER :: PK
+!
REAL, DIMENSION(SIZE(PCPL_DRAIN,1),SIZE(PCPL_DRAIN,2)) :: ZCPL_DRAIN
-REAL, DIMENSION(SIZE(PCPL_DRAIN,1),SIZE(PCPL_DRAIN,2)) :: ZCPL_RECHARGE
!
-REAL, DIMENSION(SIZE(I%XPATCH,1)) :: ZSUMPATCH
-REAL, DIMENSION(SIZE(I%XPATCH,1)) :: ZBUDGET
+REAL, DIMENSION(SIZE(S%XPATCH,1)) :: ZSUMPATCH
+REAL, DIMENSION(SIZE(S%XPATCH,1)) :: ZBUDGET
!
-INTEGER :: INI,INP
-INTEGER :: JI, JPATCH ! tile loop counter
+INTEGER :: INJ, JP, IMASK
+INTEGER :: JI ! tile loop counter
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -88,63 +92,42 @@ IF (LHOOK) CALL DR_HOOK('DIAG_CPL_ESM_ISBA',0,ZHOOK_HANDLE)
!* Initialization
! --------------
!
-INI=SIZE(I%XPATCH,1)
-INP=SIZE(I%XPATCH,2)
+INJ=SIZE(S%XPATCH,1)
!
ZSUMPATCH(:) = 0.0
-DO JPATCH=1,INP
- DO JI=1,INI
- ZSUMPATCH(JI) = ZSUMPATCH(JI) + I%XPATCH(JI,JPATCH)
+DO JP=1,IO%NPATCH
+ DO JI=1,INJ
+ ZSUMPATCH(JI) = ZSUMPATCH(JI) + S%XPATCH(JI,JP)
ENDDO
ENDDO
!
-ZCPL_RECHARGE(:,:) = 0.0
-!
-IF(I%CISBA/='DIF')THEN
+IF(IO%CISBA/='DIF')THEN
! prevent small negatives values with ISBA-FR
ZCPL_DRAIN(:,:)=MAX(0.0,PCPL_DRAIN(:,:))
ELSE
ZCPL_DRAIN(:,:)=PCPL_DRAIN(:,:)
ENDIF
!
-!* groundwater case
-! ----------------
-!
-IF(LCPL_GW.AND.I%LWTD)THEN
- DO JPATCH=1,INP
- DO JI=1,INI
- IF(I%XGW(JI)>0.0.AND.ZSUMPATCH(JI)>0.0)THEN
- ZCPL_RECHARGE(JI,JPATCH) = PCPL_DRAIN(JI,JPATCH)
- ZCPL_DRAIN (JI,JPATCH) = 0.0
- ENDIF
- ENDDO
- ENDDO
-ENDIF
-!
!* update ISBA - RRM coupling variable (kg/m2)
! -------------------------------------------
!
!kg/m²
-DO JPATCH=1,INP
- DO JI=1,INI
+DO JP=1,IO%NPATCH
+ DO JI=1,INJ
!
IF(ZSUMPATCH(JI)>0.0)THEN
- I%XCPL_DRAIN (JI) = I%XCPL_DRAIN (JI) + PTSTEP * ZCPL_DRAIN (JI,JPATCH) * I%XPATCH(JI,JPATCH)/ZSUMPATCH(JI)
- I%XCPL_RUNOFF(JI) = I%XCPL_RUNOFF(JI) + PTSTEP * PCPL_RUNOFF(JI,JPATCH) * I%XPATCH(JI,JPATCH)/ZSUMPATCH(JI)
- ENDIF
-!
- IF(I%LGLACIER.AND.ZSUMPATCH(JI)>0.0)THEN
- I%XCPL_ICEFLUX(JI) = I%XCPL_ICEFLUX(JI) + PTSTEP * PCPL_ICEFLUX(JI,JPATCH) * I%XPATCH(JI,JPATCH)/ZSUMPATCH(JI)
+ S%XCPL_DRAIN (JI) = S%XCPL_DRAIN (JI) + PTSTEP * ZCPL_DRAIN (JI,JP) * S%XPATCH(JI,JP)/ZSUMPATCH(JI)
+ S%XCPL_RUNOFF(JI) = S%XCPL_RUNOFF(JI) + PTSTEP * PCPL_RUNOFF(JI,JP) * S%XPATCH(JI,JP)/ZSUMPATCH(JI)
ENDIF
!
- IF(LCPL_GW.AND.I%LWTD.AND.ZSUMPATCH(JI)>0.0)THEN
- I%XCPL_RECHARGE(JI) = I%XCPL_RECHARGE(JI) + PTSTEP * ZCPL_RECHARGE(JI,JPATCH) * I%XPATCH(JI,JPATCH)/ZSUMPATCH(JI)
+ IF(IO%LGLACIER.AND.ZSUMPATCH(JI)>0.0)THEN
+ S%XCPL_ICEFLUX(JI) = S%XCPL_ICEFLUX(JI) + PTSTEP * PCPL_ICEFLUX(JI,JP) * S%XPATCH(JI,JP)/ZSUMPATCH(JI)
ENDIF
!
- IF(LCPL_FLOOD.AND.I%LFLOOD.AND.ZSUMPATCH(JI)>0.0)THEN
- I%XCPL_EFLOOD (JI) = I%XCPL_EFLOOD (JI) + PTSTEP * PCPL_EFLOOD (JI,JPATCH)*I%XPATCH(JI,JPATCH)/ZSUMPATCH(JI)
- I%XCPL_PFLOOD (JI) = I%XCPL_PFLOOD (JI) + PTSTEP * PCPL_PFLOOD (JI,JPATCH)*I%XPATCH(JI,JPATCH)/ZSUMPATCH(JI)
- I%XCPL_IFLOOD (JI) = I%XCPL_IFLOOD (JI) + PTSTEP * PCPL_IFLOOD (JI,JPATCH)*I%XPATCH(JI,JPATCH)/ZSUMPATCH(JI)
+ IF(LCPL_FLOOD.AND.IO%LFLOOD.AND.ZSUMPATCH(JI)>0.0)THEN
+ S%XCPL_EFLOOD (JI) = S%XCPL_EFLOOD (JI) + PTSTEP * PCPL_EFLOOD (JI,JP)*S%XPATCH(JI,JP)/ZSUMPATCH(JI)
+ S%XCPL_PFLOOD (JI) = S%XCPL_PFLOOD (JI) + PTSTEP * PCPL_PFLOOD (JI,JP)*S%XPATCH(JI,JP)/ZSUMPATCH(JI)
+ S%XCPL_IFLOOD (JI) = S%XCPL_IFLOOD (JI) + PTSTEP * PCPL_IFLOOD (JI,JP)*S%XPATCH(JI,JP)/ZSUMPATCH(JI)
ENDIF
!
ENDDO
@@ -153,12 +136,31 @@ ENDDO
!* update ISBA Floodplains variable for mass conservation (kg/m2)
! --------------------------------------------------------------
!
-IF(LCPL_FLOOD.AND.I%LFLOOD)THEN
- ZBUDGET(:)=(I%XPIFLOOD(:)*XTSTEP_CPL_LAND)+I%XCPL_PFLOOD(:)-I%XCPL_IFLOOD(:)-I%XCPL_EFLOOD(:)
- WHERE(ZBUDGET (:)<=0.0)
- I%XPIFLOOD(:)=0.0
- I%XFFLOOD (:)=0.0
- ENDWHERE
+IF(LCPL_FLOOD.AND.IO%LFLOOD)THEN
+ ZBUDGET(:) = 0.0
+ DO JP = 1,IO%NPATCH
+ KK => NK%AL(JP)
+ PK => NP%AL(JP)
+
+ DO JI = 1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ ZBUDGET(IMASK) = ZBUDGET(IMASK) + (KK%XPIFLOOD(JI)*XTSTEP_CPL_LAND) + &
+ (S%XCPL_PFLOOD(IMASK)-S%XCPL_IFLOOD(IMASK)-S%XCPL_EFLOOD(IMASK))
+ ENDDO
+ ENDDO
+
+ DO JP = 1,IO%NPATCH
+ KK => NK%AL(JP)
+ PK => NP%AL(JP)
+
+ DO JI = 1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ IF (ZBUDGET(IMASK)<=0.) THEN
+ KK%XPIFLOOD(JI) = 0.0
+ KK%XFFLOOD (JI) = 0.0
+ ENDIF
+ ENDDO
+ ENDDO
ENDIF
!
IF (LHOOK) CALL DR_HOOK('DIAG_CPL_ESM_ISBA',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/diag_cpl_esm_sea.F90 b/src/SURFEX/diag_cpl_esm_sea.F90
index 14bbcc707247895f9de943c26987fde8076c882b..cdb0dbe4922cab64e8540c1500c079966ddfc695 100644
--- a/src/SURFEX/diag_cpl_esm_sea.F90
+++ b/src/SURFEX/diag_cpl_esm_sea.F90
@@ -3,12 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_CPL_ESM_SEA (S, &
- PTSTEP,PZON10M,PMER10M,PSFU,PSFV, &
- PSWD,PSWU,PGFLUX,PSFTQ,PRAIN,PSNOW, &
- PLW,PTICE,PSFTH_ICE,PSFTQ_ICE, &
- PDIR_SW,PSCA_SW,PSWU_ICE,PLWU_ICE, &
- OSIC )
+ SUBROUTINE DIAG_CPL_ESM_SEA (S, D, DI, PTSTEP, PSFTQ, PRAIN, PSNOW, &
+ PLW, PSFTH_ICE, PSFTQ_ICE, PDIR_SW, PSCA_SW, OSIC)
! ###################################################################
!
!!**** *DIAG_CPL_ESM_SEA * - Computes diagnostics over sea for
@@ -36,7 +32,7 @@
!! A.Voldoire 04/2015 Add LCPL_SEAICE test
!!------------------------------------------------------------------
!
-!
+USE MODD_DIAG_n, ONLY : DIAG_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
!
USE MODD_CSTS, ONLY : XSTEFAN, XLSTT
@@ -53,26 +49,18 @@ IMPLICIT NONE
!
!
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DI
!
REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step
-REAL, DIMENSION(:), INTENT(IN) :: PZON10M ! zonal wind
-REAL, DIMENSION(:), INTENT(IN) :: PMER10M ! meridian wind
-REAL, DIMENSION(:), INTENT(IN) :: PSFU ! zonal wind stress
-REAL, DIMENSION(:), INTENT(IN) :: PSFV ! meridian wind stress
-REAL, DIMENSION(:), INTENT(IN) :: PSWD ! total incoming short wave radiation
-REAL, DIMENSION(:), INTENT(IN) :: PSWU ! total upward short wave radiation
-REAL, DIMENSION(:), INTENT(IN) :: PGFLUX ! storage flux
REAL, DIMENSION(:), INTENT(IN) :: PSFTQ ! water flux
REAL, DIMENSION(:), INTENT(IN) :: PRAIN ! Rainfall
REAL, DIMENSION(:), INTENT(IN) :: PSNOW ! Snowfall
REAL, DIMENSION(:), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.)
REAL, DIMENSION(:), INTENT(IN) :: PSFTH_ICE ! heat flux (W/m2)
REAL, DIMENSION(:), INTENT(IN) :: PSFTQ_ICE ! water flux (kg/m2/s)
-REAL, DIMENSION(:), INTENT(IN) :: PTICE ! Ice Surface Temperature
REAL, DIMENSION(:,:),INTENT(IN):: PDIR_SW ! direct solar radiation (on horizontal surf.)
REAL, DIMENSION(:,:),INTENT(IN):: PSCA_SW ! diffuse solar radiation (on horizontal surf.)
-REAL, DIMENSION(:), INTENT(IN) :: PSWU_ICE ! upward short wave radiation on seaice
-REAL, DIMENSION(:), INTENT(IN) :: PLWU_ICE ! upward long wave radiation on seaice
LOGICAL, INTENT(IN) :: OSIC
!
!* 0.2 declarations of local variables
@@ -94,21 +82,21 @@ IF (LHOOK) CALL DR_HOOK('DIAG_CPL_ESM_SEA',0,ZHOOK_HANDLE)
!
!* 10m wind speed (m)
!
-S%XCPL_SEA_WIND(:) = S%XCPL_SEA_WIND(:) + PTSTEP * SQRT(PZON10M(:)**2+PMER10M(:)**2)
+S%XCPL_SEA_WIND(:) = S%XCPL_SEA_WIND(:) + PTSTEP * SQRT(D%XZON10M(:)**2+D%XMER10M(:)**2)
!
!* wind stress (Pa.s)
!
-S%XCPL_SEA_FWSU(:) = S%XCPL_SEA_FWSU(:) + PTSTEP * PSFU(:)
-S%XCPL_SEA_FWSV(:) = S%XCPL_SEA_FWSV(:) + PTSTEP * PSFV(:)
-S%XCPL_SEA_FWSM(:) = S%XCPL_SEA_FWSM(:) + PTSTEP * SQRT(PSFU(:)**2+PSFV(:)**2)
+S%XCPL_SEA_FWSU(:) = S%XCPL_SEA_FWSU(:) + PTSTEP * D%XFMU(:)
+S%XCPL_SEA_FWSV(:) = S%XCPL_SEA_FWSV(:) + PTSTEP * D%XFMV(:)
+S%XCPL_SEA_FWSM(:) = S%XCPL_SEA_FWSM(:) + PTSTEP * SQRT(D%XFMU(:)**2+D%XFMV(:)**2)
!
!* Solar net heat flux (J/m2)
!
-S%XCPL_SEA_SNET(:) = S%XCPL_SEA_SNET(:) + PTSTEP * (PSWD(:) - PSWU(:))
+S%XCPL_SEA_SNET(:) = S%XCPL_SEA_SNET(:) + PTSTEP * (D%XSWD(:) - D%XSWU(:))
!
!* Non solar heat flux (J/m2)
!
-S%XCPL_SEA_HEAT(:) = S%XCPL_SEA_HEAT(:) + PTSTEP * (PGFLUX(:) + PSWU(:) - PSWD(:))
+S%XCPL_SEA_HEAT(:) = S%XCPL_SEA_HEAT(:) + PTSTEP * (D%XGFLUX(:) + D%XSWU(:) - D%XSWD(:))
!
!* Evaporation (kg/m2)
!
@@ -130,7 +118,7 @@ IF (LCPL_SEAICE.OR.OSIC) THEN
!* Solar net heat flux (J/m2)
!
IF (OSIC) THEN
- ZSWU(:)=PSWU_ICE(:)
+ ZSWU(:)=DI%XSWU(:)
ELSE
ZSWU(:)=0.0
DO JSWB=1,ISWB
@@ -140,15 +128,15 @@ IF (LCPL_SEAICE.OR.OSIC) THEN
ENDDO
ENDIF
!
- S%XCPL_SEAICE_SNET(:) = S%XCPL_SEAICE_SNET(:) + PTSTEP * (PSWD(:) - ZSWU(:))
+ S%XCPL_SEAICE_SNET(:) = S%XCPL_SEAICE_SNET(:) + PTSTEP * (D%XSWD(:) - ZSWU(:))
!
!* Non solar heat flux (J/m2)
!
IF (OSIC) THEN
S%XCPL_SEAICE_HEAT(:) = S%XCPL_SEAICE_HEAT(:) + PTSTEP * &
- ( PLW(:) - PLWU_ICE(:) - PSFTH_ICE(:) - XLSTT*PSFTQ_ICE(:) )
+ ( PLW(:) - DI%XLWU(:) - PSFTH_ICE(:) - XLSTT*PSFTQ_ICE(:) )
ELSE
- ZTICE4(:)=PTICE(:)**4
+ ZTICE4(:)=S%XTICE(:)**4
S%XCPL_SEAICE_HEAT(:) = S%XCPL_SEAICE_HEAT(:) + PTSTEP * ( XEMISWATICE*(PLW(:)-XSTEFAN*ZTICE4(:)) &
- PSFTH_ICE(:) - XLSTT*PSFTQ_ICE(:) )
ENDIF
diff --git a/src/SURFEX/diag_cpl_esm_water.F90 b/src/SURFEX/diag_cpl_esm_water.F90
index 5a0d41ee8e701bbc6f1a72be76df4ed0f27b8f71..8aa7238464ca63f50154577dfc1d66f10d0a3f17 100644
--- a/src/SURFEX/diag_cpl_esm_water.F90
+++ b/src/SURFEX/diag_cpl_esm_water.F90
@@ -3,10 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_CPL_ESM_WATER (W, &
- OCPL_SEAICE,PTSTEP,PZON10M,PMER10M,PSFU,PSFV, &
- PSWD,PSWU,PGFLUX,PSFTQ,PRAIN,PSNOW,PLW,PTICE, &
- PSFTH_ICE,PSFTQ_ICE,PDIR_SW,PSCA_SW )
+ SUBROUTINE DIAG_CPL_ESM_WATER (W, D, OCPL_SEAICE, PTSTEP, PSFTQ, PRAIN, PSNOW, PLW, &
+ PSFTH_ICE, PSFTQ_ICE, PDIR_SW, PSCA_SW )
! #####################################################################
!
!!**** *DIAG_CPL_ESM_WATER * - Computes diagnostics over sea for
@@ -32,6 +30,7 @@
!!------------------------------------------------------------------
!
!
+USE MODD_DIAG_n, ONLY : DIAG_t
USE MODD_WATFLUX_n, ONLY : WATFLUX_t
!
USE MODD_CSTS, ONLY : XSTEFAN, XLSTT
@@ -47,24 +46,17 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
+TYPE(DIAG_t), INTENT(INOUT) :: D
TYPE(WATFLUX_t), INTENT(INOUT) :: W
!
LOGICAL, INTENT(IN) :: OCPL_SEAICE ! sea-ice / ocean key
REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step
-REAL, DIMENSION(:), INTENT(IN) :: PZON10M ! zonal wind
-REAL, DIMENSION(:), INTENT(IN) :: PMER10M ! meridian wind
-REAL, DIMENSION(:), INTENT(IN) :: PSFU ! zonal wind stress
-REAL, DIMENSION(:), INTENT(IN) :: PSFV ! meridian wind stress
-REAL, DIMENSION(:), INTENT(IN) :: PSWD ! total incoming short wave radiation
-REAL, DIMENSION(:), INTENT(IN) :: PSWU ! total upward short wave radiation
-REAL, DIMENSION(:), INTENT(IN) :: PGFLUX ! storage flux
REAL, DIMENSION(:), INTENT(IN) :: PSFTQ ! water flux
REAL, DIMENSION(:), INTENT(IN) :: PRAIN ! Rainfall
REAL, DIMENSION(:), INTENT(IN) :: PSNOW ! Snowfall
REAL, DIMENSION(:), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.)
REAL, DIMENSION(:), INTENT(IN) :: PSFTH_ICE ! heat flux (W/m2)
REAL, DIMENSION(:), INTENT(IN) :: PSFTQ_ICE ! water flux (kg/m2/s)
-REAL, DIMENSION(:), INTENT(IN) :: PTICE ! Ice Surface Temperature
REAL, DIMENSION(:,:),INTENT(IN):: PDIR_SW ! direct solar radiation (on horizontal surf.)
REAL, DIMENSION(:,:),INTENT(IN):: PSCA_SW ! diffuse solar radiation (on horizontal surf.)
!
@@ -87,21 +79,21 @@ IF (LHOOK) CALL DR_HOOK('DIAG_CPL_ESM_WATER',0,ZHOOK_HANDLE)
!
!* 10m wind speed (m)
!
-W%XCPL_WATER_WIND(:) = W%XCPL_WATER_WIND(:) + PTSTEP * SQRT(PZON10M(:)**2+PMER10M(:)**2)
+W%XCPL_WATER_WIND(:) = W%XCPL_WATER_WIND(:) + PTSTEP * SQRT(D%XZON10M(:)**2+D%XMER10M(:)**2)
!
!* wind stress (Pa.s)
!
-W%XCPL_WATER_FWSU(:) = W%XCPL_WATER_FWSU(:) + PTSTEP * PSFU(:)
-W%XCPL_WATER_FWSV(:) = W%XCPL_WATER_FWSV(:) + PTSTEP * PSFV(:)
-W%XCPL_WATER_FWSM(:) = W%XCPL_WATER_FWSM(:) + PTSTEP * SQRT(PSFU(:)**2+PSFV(:)**2)
+W%XCPL_WATER_FWSU(:) = W%XCPL_WATER_FWSU(:) + PTSTEP * D%XFMU(:)
+W%XCPL_WATER_FWSV(:) = W%XCPL_WATER_FWSV(:) + PTSTEP * D%XFMV(:)
+W%XCPL_WATER_FWSM(:) = W%XCPL_WATER_FWSM(:) + PTSTEP * SQRT(D%XFMU(:)**2+D%XFMV(:)**2)
!
!* Solar net heat flux (J/m2)
!
-W%XCPL_WATER_SNET(:) = W%XCPL_WATER_SNET(:) + PTSTEP * (PSWD(:) - PSWU(:))
+W%XCPL_WATER_SNET(:) = W%XCPL_WATER_SNET(:) + PTSTEP * (D%XSWD(:) - D%XSWU(:))
!
!* Non solar heat flux (J/m2)
!
-W%XCPL_WATER_HEAT(:) = W%XCPL_WATER_HEAT(:) + PTSTEP * (PGFLUX(:) + PSWU(:) - PSWD(:))
+W%XCPL_WATER_HEAT(:) = W%XCPL_WATER_HEAT(:) + PTSTEP * (D%XGFLUX(:) + D%XSWU(:) - D%XSWD(:))
!
!* Evaporation (kg/m2)
!
@@ -130,11 +122,11 @@ IF (OCPL_SEAICE) THEN
ENDDO
ENDDO
!
- W%XCPL_WATERICE_SNET(:) = W%XCPL_WATERICE_SNET(:) + PTSTEP * (PSWD(:) - ZSWU(:))
+ W%XCPL_WATERICE_SNET(:) = W%XCPL_WATERICE_SNET(:) + PTSTEP * (D%XSWD(:) - ZSWU(:))
!
!* Non solar heat flux (J/m2)
!
- ZTICE4(:)=PTICE(:)**4
+ ZTICE4(:)=W%XTICE(:)**4
!
W%XCPL_WATERICE_HEAT(:) = W%XCPL_WATERICE_HEAT(:) + PTSTEP * ( XEMISWATICE*(PLW(:)-XSTEFAN*ZTICE4(:)) &
- PSFTH_ICE(:) - XLSTT*PSFTQ_ICE(:) )
diff --git a/src/SURFEX/diag_evap_cumul_isban.F90 b/src/SURFEX/diag_evap_cumul_isban.F90
new file mode 100644
index 0000000000000000000000000000000000000000..d5eac38c0c4c5b6ae43897fd59b716c56b8064e0
--- /dev/null
+++ b/src/SURFEX/diag_evap_cumul_isban.F90
@@ -0,0 +1,193 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+SUBROUTINE DIAG_EVAP_CUMUL_ISBA_n (OSURF_BUDGETC, DE, DECK, DCK, DEK, DK, PEK, &
+ IO, PTSTEP, KSIZE, KPATCH, PRHOA)
+! ###############################################################################
+!
+!!**** *DIAG_EVAP-ISBA_n * - additional diagnostics for ISBA
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! P. LeMoigne
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2004
+!! 2008 New diag
+!! B. Decharme 2012 New snow diag LESL
+!! Add carbon fluxes diag
+!! Add isba water budget diag
+!! B. Decharme 04/2013 add Subsurface runoff if SGH (DIF option only)
+!! add sublimation
+!! P Samuelsson 04/2012 MEB
+!!------------------------------------------------------------------
+!
+!
+!
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+USE MODD_DIAG_n, ONLY : DIAG_t
+USE MODD_ISBA_n, ONLY : ISBA_PE_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+!
+LOGICAL, INTENT(IN) :: OSURF_BUDGETC
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DE
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DECK
+TYPE(DIAG_t), INTENT(INOUT) :: DCK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK
+TYPE(DIAG_t), INTENT(INOUT) :: DK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+!
+REAL, INTENT(IN) :: PTSTEP ! time step
+INTEGER, INTENT(IN) :: KSIZE
+INTEGER, INTENT(IN) :: KPATCH
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! air density for unit change
+!
+INTEGER :: JJ
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!* 0.2 declarations of local variables
+!
+!-------------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('DIAG_EVAP_CUMUL_ISBA_N',0,ZHOOK_HANDLE)
+!
+IF (OSURF_BUDGETC) THEN
+!cdir nodep
+ DO JJ=1,KSIZE
+ !
+ DCK%XRN (JJ) = DCK%XRN (JJ) + DK%XRN (JJ) * PTSTEP
+ DCK%XH (JJ) = DCK%XH (JJ) + DK%XH (JJ) * PTSTEP
+ DCK%XLE (JJ) = DCK%XLE (JJ) + PEK%XLE (JJ) * PTSTEP
+ DCK%XLEI (JJ) = DCK%XLEI (JJ) + DK%XLEI (JJ) * PTSTEP
+ DCK%XGFLUX(JJ) = DCK%XGFLUX(JJ) + DK%XGFLUX (JJ) * PTSTEP
+ !
+ DECK%XLEG (JJ) = DECK%XLEG (JJ) + DEK%XLEG (JJ) * PTSTEP
+ DECK%XLEGI (JJ) = DECK%XLEGI (JJ) + DEK%XLEGI (JJ) * PTSTEP
+ DECK%XLEV (JJ) = DECK%XLEV (JJ) + DEK%XLEV (JJ) * PTSTEP
+ DECK%XLES (JJ) = DECK%XLES (JJ) + DEK%XLES (JJ) * PTSTEP
+ DECK%XLER (JJ) = DECK%XLER (JJ) + DEK%XLER (JJ) * PTSTEP
+ DECK%XLETR (JJ) = DECK%XLETR (JJ) + DEK%XLETR (JJ) * PTSTEP
+ DCK%XEVAP (JJ) = DCK%XEVAP (JJ) + DK%XEVAP (JJ) * PTSTEP
+ DCK%XSUBL (JJ) = DCK%XSUBL (JJ) + DK%XSUBL (JJ) * PTSTEP
+ DECK%XDRAIN (JJ) = DECK%XDRAIN (JJ) + DEK%XDRAIN (JJ) * PTSTEP
+ DECK%XQSB (JJ) = DECK%XQSB (JJ) + DEK%XQSB (JJ) * PTSTEP
+ DECK%XRUNOFF (JJ) = DECK%XRUNOFF (JJ) + DEK%XRUNOFF (JJ) * PTSTEP
+ DECK%XHORT (JJ) = DECK%XHORT (JJ) + DEK%XHORT (JJ) * PTSTEP
+ DECK%XDRIP (JJ) = DECK%XDRIP (JJ) + DEK%XDRIP (JJ) * PTSTEP
+ DECK%XRRVEG (JJ) = DECK%XRRVEG (JJ) + DEK%XRRVEG (JJ) * PTSTEP
+ DECK%XMELT (JJ) = DECK%XMELT (JJ) + DEK%XMELT (JJ) * PTSTEP
+ DECK%XIFLOOD (JJ) = DECK%XIFLOOD (JJ) + DEK%XIFLOOD (JJ) * PTSTEP
+ DECK%XPFLOOD (JJ) = DECK%XPFLOOD (JJ) + DEK%XPFLOOD (JJ) * PTSTEP
+ DECK%XLE_FLOOD(JJ) = DECK%XLE_FLOOD(JJ) + DEK%XLE_FLOOD (JJ) * PTSTEP
+ DECK%XLEI_FLOOD (JJ) = DECK%XLEI_FLOOD (JJ) + DEK%XLEI_FLOOD (JJ) * PTSTEP
+ DECK%XIRRIG_FLUX(JJ) = DECK%XIRRIG_FLUX(JJ) + DEK%XIRRIG_FLUX(JJ) * PTSTEP
+ !
+ IF (IO%LMEB_PATCH(KPATCH)) THEN
+ DECK%XLEV_CV (JJ) = DECK%XLEV_CV (JJ) + DEK%XLEV_CV (JJ) * PTSTEP
+ DECK%XLES_CV (JJ) = DECK%XLES_CV (JJ) + DEK%XLES_CV (JJ) * PTSTEP
+ DECK%XLETR_CV(JJ) = DECK%XLETR_CV (JJ) + DEK%XLETR_CV(JJ) * PTSTEP
+ DECK%XLER_CV (JJ) = DECK%XLER_CV (JJ) + DEK%XLER_CV (JJ) * PTSTEP
+ DECK%XLE_CV (JJ) = DECK%XLE_CV (JJ) + DEK%XLE_CV (JJ) * PTSTEP
+ DECK%XH_CV (JJ) = DECK%XH_CV (JJ) + DEK%XH_CV (JJ) * PTSTEP
+ DECK%XMELT_CV(JJ) = DECK%XMELT_CV(JJ) + DEK%XMELT_CV(JJ) * PTSTEP
+ DECK%XFRZ_CV (JJ) = DECK%XFRZ_CV (JJ) + DEK%XFRZ_CV (JJ) * PTSTEP
+
+ DECK%XLE_GV (JJ) = DECK%XLE_GV (JJ) + DEK%XLE_GV (JJ) * PTSTEP
+ DECK%XH_GV (JJ) = DECK%XH_GV (JJ) + DEK%XH_GV (JJ) * PTSTEP
+
+ DECK%XLE_GN (JJ) = DECK%XLE_GN (JJ) + DEK%XLE_GN (JJ) * PTSTEP
+ DECK%XH_GN (JJ) = DECK%XH_GN (JJ) + DEK%XH_GN (JJ) * PTSTEP
+ DECK%XSR_GN (JJ) = DECK%XSR_GN (JJ) + DEK%XSR_GN (JJ) * PTSTEP
+ DECK%XSWDOWN_GN(JJ) = DECK%XSWDOWN_GN(JJ) + DEK%XSWDOWN_GN(JJ) * PTSTEP
+ DECK%XLWDOWN_GN(JJ) = DECK%XLWDOWN_GN(JJ) + DEK%XLWDOWN_GN(JJ) * PTSTEP
+
+ DECK%XLE_CA (JJ) = DECK%XLE_CA (JJ) + DEK%XLE_CA (JJ) * PTSTEP
+ DECK%XH_CA (JJ) = DECK%XH_CA (JJ) + DEK%XH_CA (JJ) * PTSTEP
+ !
+ DECK%XSWNET_V (JJ) = DECK%XSWNET_V (JJ) + DEK%XSWNET_V (JJ) * PTSTEP
+ DECK%XSWNET_G (JJ) = DECK%XSWNET_G (JJ) + DEK%XSWNET_G (JJ) * PTSTEP
+ DECK%XSWNET_N (JJ) = DECK%XSWNET_N (JJ) + DEK%XSWNET_N (JJ) * PTSTEP
+ DECK%XSWNET_NS (JJ) = DECK%XSWNET_NS (JJ) + DEK%XSWNET_NS (JJ) * PTSTEP
+ DECK%XLWNET_V (JJ) = DECK%XLWNET_V (JJ) + DEK%XLWNET_V (JJ) * PTSTEP
+ DECK%XLWNET_G (JJ) = DECK%XLWNET_G (JJ) + DEK%XLWNET_G (JJ) * PTSTEP
+ DECK%XLWNET_N (JJ) = DECK%XLWNET_N (JJ) + DEK%XLWNET_N (JJ) * PTSTEP
+ ENDIF
+ !
+ DCK%XSWD(JJ) = DCK%XSWD(JJ) + DK%XSWD(JJ) * PTSTEP
+ DCK%XSWU(JJ) = DCK%XSWU(JJ) + DK%XSWU(JJ) * PTSTEP
+ DCK%XLWD(JJ) = DCK%XLWD(JJ) + DK%XLWD(JJ) * PTSTEP
+ DCK%XLWU(JJ) = DCK%XLWU(JJ) + DK%XLWU(JJ) * PTSTEP
+ DCK%XFMU(JJ) = DCK%XFMU(JJ) + DK%XFMU(JJ) * PTSTEP
+ DCK%XFMV(JJ) = DCK%XFMV(JJ) + DK%XFMV(JJ) * PTSTEP
+ !
+ END DO
+ !
+ IF (PEK%TSNOW%SCHEME=='3-L' .OR. PEK%TSNOW%SCHEME=='CRO') THEN
+!cdir nodep
+ DO JJ=1,KSIZE
+ DECK%XLESL (JJ) = DECK%XLESL (JJ) + DEK%XLESL (JJ) * PTSTEP
+ DECK%XSNDRIFT (JJ) = DECK%XSNDRIFT (JJ) + DEK%XSNDRIFT (JJ) * PTSTEP
+ END DO
+ END IF
+ !
+ IF(IO%CPHOTO/='NON')THEN
+!cdir nodep
+ DO JJ=1,KSIZE
+ !Transform units from kgCO2/kgair m/s to kgCO2/m2
+ DECK%XGPP (JJ) = DECK%XGPP(JJ) + DEK%XGPP(JJ) * PTSTEP
+ DECK%XRESP_AUTO(JJ) = DECK%XRESP_AUTO(JJ) + DEK%XRESP_AUTO(JJ) * PTSTEP
+ DECK%XRESP_ECO (JJ) = DECK%XRESP_ECO (JJ) + DEK%XRESP_ECO(JJ) * PTSTEP
+ END DO
+ ELSE
+ DECK%XGPP (:)=0.0
+ DECK%XRESP_AUTO(:)=0.0
+ DECK%XRESP_ECO (:)=0.0
+ ENDIF
+ !
+ IF(IO%LGLACIER)THEN
+!cdir nodep
+ DO JJ=1,KSIZE
+ DECK%XICEFLUX(JJ) = DECK%XICEFLUX(JJ) + DEK%XICEFLUX(JJ) * PTSTEP
+ END DO
+ END IF
+ !
+ IF(DE%LWATER_BUDGET)THEN
+!cdir nodep
+ DO JJ=1,KSIZE
+ DECK%XDWG (JJ) = DECK%XDWG (JJ) + DEK%XDWG (JJ) * PTSTEP
+ DECK%XDWGI (JJ) = DECK%XDWGI (JJ) + DEK%XDWGI (JJ) * PTSTEP
+ DECK%XDWR (JJ) = DECK%XDWR (JJ) + DEK%XDWR (JJ) * PTSTEP
+ DECK%XDSWE (JJ) = DECK%XDSWE (JJ) + DEK%XDSWE (JJ) * PTSTEP
+ DECK%XWATBUD(JJ) = DECK%XWATBUD(JJ) + DEK%XWATBUD(JJ) * PTSTEP
+ END DO
+ ENDIF
+ !
+END IF
+IF (LHOOK) CALL DR_HOOK('DIAG_EVAP_CUMUL_ISBA_N',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------------
+!
+END SUBROUTINE DIAG_EVAP_CUMUL_ISBA_n
diff --git a/src/SURFEX/diag_evap_isban.F90 b/src/SURFEX/diag_evap_isban.F90
deleted file mode 100644
index b158d1fb17e11e3b94670e5f609bf6de459f8908..0000000000000000000000000000000000000000
--- a/src/SURFEX/diag_evap_isban.F90
+++ /dev/null
@@ -1,289 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE DIAG_EVAP_ISBA_n (DGEI, DGI, I, PKDI, PKI, &
- HPHOTO,PTSTEP,KMASK,KSIZE,KPATCH,PRHOA)
-! ###############################################################################
-!
-!!**** *DIAG_EVAP-ISBA_n * - additional diagnostics for ISBA
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! P. LeMoigne
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! 2008 New diag
-!! B. Decharme 2012 New snow diag LESL
-!! Add carbon fluxes diag
-!! Add isba water budget diag
-!! B. Decharme 04/2013 add Subsurface runoff if SGH (DIF option only)
-!! add sublimation
-!! P Samuelsson 04/2012 MEB
-!!------------------------------------------------------------------
-!
-!
-
-!
-!
-!
-!
-USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
-USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_PACK_DIAG_ISBA, ONLY : PACK_DIAG_ISBA_t
-USE MODD_PACK_ISBA, ONLY : PACK_ISBA_t
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DGEI
-TYPE(DIAG_ISBA_t), INTENT(INOUT) :: DGI
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(PACK_DIAG_ISBA_t), INTENT(INOUT) :: PKDI
-TYPE(PACK_ISBA_t), INTENT(INOUT) :: PKI
-!
- CHARACTER(LEN=*), INTENT(IN) :: HPHOTO ! type of photosynthesis
-REAL, INTENT(IN) :: PTSTEP ! time step
-INTEGER, INTENT(IN) :: KSIZE, KPATCH
-!
-INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
-REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! air density for unit change
-!
-INTEGER :: JJ
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!* 0.2 declarations of local variables
-!
-!-------------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_EVAP_ISBA_N',0,ZHOOK_HANDLE)
-!
-IF (DGEI%LSURF_EVAP_BUDGET) THEN
-!cdir nodep
- DO JJ=1,KSIZE
- !
- DGEI%XLEG (KMASK(JJ), KPATCH) = PKDI%XP_LEG (JJ)
- DGEI%XLEGI (KMASK(JJ), KPATCH) = PKDI%XP_LEGI (JJ)
- DGEI%XLEV (KMASK(JJ), KPATCH) = PKDI%XP_LEV (JJ)
- DGEI%XLES (KMASK(JJ), KPATCH) = PKDI%XP_LES (JJ)
- DGEI%XLER (KMASK(JJ), KPATCH) = PKDI%XP_LER (JJ)
- DGEI%XLETR (KMASK(JJ), KPATCH) = PKDI%XP_LETR (JJ)
- DGEI%XEVAP (KMASK(JJ), KPATCH) = PKDI%XP_EVAP (JJ)
- DGEI%XSUBL (KMASK(JJ), KPATCH) = PKDI%XP_SUBL (JJ)
- DGEI%XDRAIN (KMASK(JJ), KPATCH) = PKDI%XP_DRAIN (JJ)
- DGEI%XQSB (KMASK(JJ), KPATCH) = PKDI%XP_QSB (JJ)
- DGEI%XRUNOFF (KMASK(JJ), KPATCH) = PKDI%XP_RUNOFF (JJ)
- DGEI%XHORT (KMASK(JJ), KPATCH) = PKDI%XP_HORT (JJ)
- DGEI%XDRIP (KMASK(JJ), KPATCH) = PKDI%XP_DRIP (JJ)
- DGEI%XRRVEG (KMASK(JJ), KPATCH) = PKDI%XP_RRVEG (JJ)
- DGEI%XMELT (KMASK(JJ), KPATCH) = PKDI%XP_MELT (JJ)
- DGEI%XIFLOOD (KMASK(JJ), KPATCH) = PKDI%XP_IFLOOD (JJ)
- DGEI%XPFLOOD (KMASK(JJ), KPATCH) = PKDI%XP_PFLOOD (JJ)
- DGEI%XLE_FLOOD (KMASK(JJ), KPATCH) = PKDI%XP_LE_FLOOD (JJ)
- DGEI%XLEI_FLOOD (KMASK(JJ), KPATCH) = PKDI%XP_LEI_FLOOD (JJ)
- DGEI%XIRRIG_FLUX(KMASK(JJ), KPATCH) = PKDI%XP_IRRIG_FLUX (JJ)
- !
- IF (I%LMEB_PATCH(KPATCH)) THEN
- DGEI%XLEVCV (KMASK(JJ), KPATCH) = PKDI%XP_LEVCV (JJ)
- DGEI%XLESC (KMASK(JJ), KPATCH) = PKDI%XP_LESC (JJ)
- DGEI%XLETRCV (KMASK(JJ), KPATCH) = PKDI%XP_LETRCV (JJ)
- DGEI%XLELITTER (KMASK(JJ), KPATCH) = PKDI%XP_LELITTER (JJ)
- DGEI%XLELITTERI(KMASK(JJ), KPATCH) = PKDI%XP_LELITTERI(JJ)
- DGEI%XDRIPLIT (KMASK(JJ), KPATCH) = PKDI%XP_DRIPLIT (JJ)
- DGEI%XRRLIT (KMASK(JJ), KPATCH) = PKDI%XP_RRLIT (JJ)
- DGEI%XLERCV (KMASK(JJ), KPATCH) = PKDI%XP_LERCV (JJ)
- DGEI%XLE_C_A (KMASK(JJ), KPATCH) = PKDI%XP_LE_C_A (JJ)
- DGEI%XLE_V_C (KMASK(JJ), KPATCH) = PKDI%XP_LE_V_C (JJ)
- DGEI%XLE_G_C (KMASK(JJ), KPATCH) = PKDI%XP_LE_G_C (JJ)
- DGEI%XLE_N_C (KMASK(JJ), KPATCH) = PKDI%XP_LE_N_C (JJ)
- !
- DGEI%XSWNET_V (KMASK(JJ), KPATCH) = PKDI%XP_SWNET_V (JJ)
- DGEI%XSWNET_G (KMASK(JJ), KPATCH) = PKDI%XP_SWNET_G (JJ)
- DGEI%XSWNET_N (KMASK(JJ), KPATCH) = PKDI%XP_SWNET_N (JJ)
- DGEI%XSWNET_NS (KMASK(JJ), KPATCH) = PKDI%XP_SWNET_NS (JJ)
- DGEI%XLWNET_V (KMASK(JJ), KPATCH) = PKDI%XP_LWNET_V (JJ)
- DGEI%XLWNET_G (KMASK(JJ), KPATCH) = PKDI%XP_LWNET_G (JJ)
- DGEI%XLWNET_N (KMASK(JJ), KPATCH) = PKDI%XP_LWNET_N (JJ)
- DGEI%XSWDOWN_GN (KMASK(JJ), KPATCH) = PKDI%XP_SWDOWN_GN (JJ)
- DGEI%XLWDOWN_GN (KMASK(JJ), KPATCH) = PKDI%XP_LWDOWN_GN (JJ)
- DGEI%XH_V_C (KMASK(JJ), KPATCH) = PKDI%XP_H_V_C (JJ)
- DGEI%XH_G_C (KMASK(JJ), KPATCH) = PKDI%XP_H_G_C (JJ)
- DGEI%XH_C_A (KMASK(JJ), KPATCH) = PKDI%XP_H_C_A (JJ)
- DGEI%XH_N_C (KMASK(JJ), KPATCH) = PKDI%XP_H_N_C (JJ)
- DGEI%XSR_GN (KMASK(JJ), KPATCH) = PKDI%XP_SR_GN (JJ)
- DGEI%XMELTCV (KMASK(JJ), KPATCH) = PKDI%XP_MELTCV (JJ)
- DGEI%XFRZCV (KMASK(JJ), KPATCH) = PKDI%XP_FRZCV (JJ)
- ENDIF
- !
- END DO
- !
- IF (I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO') THEN
-!cdir nodep
- DO JJ=1,KSIZE
- DGEI%XLESL (KMASK(JJ), KPATCH) = PKDI%XP_LESL (JJ)
- DGEI%XSNDRIFT (KMASK(JJ), KPATCH) = PKDI%XP_SNDRIFT (JJ)
- END DO
- END IF
- !
- IF(HPHOTO/='NON')THEN
-!cdir nodep
- DO JJ=1,KSIZE
- ! Transform units from kgCO2/kgair m/s to kgCO2/m2/s
- DGEI%XGPP (KMASK(JJ), KPATCH) = PKDI%XP_GPP (JJ) * PRHOA(JJ)
- DGEI%XRESP_AUTO (KMASK(JJ), KPATCH) = PKDI%XP_RESP_AUTO (JJ) * PRHOA(JJ)
- DGEI%XRESP_ECO (KMASK(JJ), KPATCH) = PKDI%XP_RESP_ECO (JJ) * PRHOA(JJ)
- !
- END DO
- ELSE
- DGEI%XGPP (:,:)=0.0
- DGEI%XRESP_AUTO(:,:)=0.0
- DGEI%XRESP_ECO (:,:)=0.0
- ENDIF
- !
- IF(DGEI%LWATER_BUDGET)THEN
-!cdir nodep
- DO JJ=1,KSIZE
- DGEI%XDWG (KMASK(JJ), KPATCH) = PKDI%XP_DWG (JJ)
- DGEI%XDWGI (KMASK(JJ), KPATCH) = PKDI%XP_DWGI (JJ)
- DGEI%XDWR (KMASK(JJ), KPATCH) = PKDI%XP_DWR (JJ)
- DGEI%XDSWE (KMASK(JJ), KPATCH) = PKDI%XP_DSWE (JJ)
- DGEI%XWATBUD(KMASK(JJ), KPATCH) = PKDI%XP_WATBUD(JJ)
- END DO
- ENDIF
- !
-END IF
-!
-IF (DGEI%LSURF_BUDGETC) THEN
-!cdir nodep
- DO JJ=1,KSIZE
- !
- DGEI%XRNC (KMASK(JJ), KPATCH) = DGEI%XRNC (KMASK(JJ), KPATCH) + PKDI%XP_RN (JJ) * PTSTEP
- DGEI%XHC (KMASK(JJ), KPATCH) = DGEI%XHC (KMASK(JJ), KPATCH) + PKDI%XP_H (JJ) * PTSTEP
- DGEI%XLEC (KMASK(JJ), KPATCH) = DGEI%XLEC (KMASK(JJ), KPATCH) + PKI%XP_LE (JJ) * PTSTEP
- DGEI%XLEIC (KMASK(JJ), KPATCH) = DGEI%XLEIC (KMASK(JJ), KPATCH) + PKDI%XP_LEI (JJ) * PTSTEP
- DGEI%XGFLUXC (KMASK(JJ), KPATCH) = DGEI%XGFLUXC (KMASK(JJ), KPATCH) + PKDI%XP_GFLUX (JJ) * PTSTEP
- DGEI%XLEGC (KMASK(JJ), KPATCH) = DGEI%XLEGC (KMASK(JJ), KPATCH) + PKDI%XP_LEG (JJ) * PTSTEP
- DGEI%XLEGIC (KMASK(JJ), KPATCH) = DGEI%XLEGIC (KMASK(JJ), KPATCH) + PKDI%XP_LEGI (JJ) * PTSTEP
- DGEI%XLEVC (KMASK(JJ), KPATCH) = DGEI%XLEVC (KMASK(JJ), KPATCH) + PKDI%XP_LEV (JJ) * PTSTEP
- DGEI%XLESAC (KMASK(JJ), KPATCH) = DGEI%XLESAC (KMASK(JJ), KPATCH) + PKDI%XP_LES (JJ) * PTSTEP
- DGEI%XLERC (KMASK(JJ), KPATCH) = DGEI%XLERC (KMASK(JJ), KPATCH) + PKDI%XP_LER (JJ) * PTSTEP
- DGEI%XLETRC (KMASK(JJ), KPATCH) = DGEI%XLETRC (KMASK(JJ), KPATCH) + PKDI%XP_LETR (JJ) * PTSTEP
- DGEI%XEVAPC (KMASK(JJ), KPATCH) = DGEI%XEVAPC (KMASK(JJ), KPATCH) + PKDI%XP_EVAP (JJ) * PTSTEP
- DGEI%XSUBLC (KMASK(JJ), KPATCH) = DGEI%XSUBLC (KMASK(JJ), KPATCH) + PKDI%XP_SUBL (JJ) * PTSTEP
- DGEI%XDRAINC (KMASK(JJ), KPATCH) = DGEI%XDRAINC (KMASK(JJ), KPATCH) + PKDI%XP_DRAIN (JJ) * PTSTEP
- DGEI%XQSBC (KMASK(JJ), KPATCH) = DGEI%XQSBC (KMASK(JJ), KPATCH) + PKDI%XP_QSB (JJ) * PTSTEP
- DGEI%XRUNOFFC (KMASK(JJ), KPATCH) = DGEI%XRUNOFFC (KMASK(JJ), KPATCH) + PKDI%XP_RUNOFF (JJ) * PTSTEP
- DGEI%XHORTC (KMASK(JJ), KPATCH) = DGEI%XHORTC (KMASK(JJ), KPATCH) + PKDI%XP_HORT (JJ) * PTSTEP
- DGEI%XDRIPC (KMASK(JJ), KPATCH) = DGEI%XDRIPC (KMASK(JJ), KPATCH) + PKDI%XP_DRIP (JJ) * PTSTEP
- DGEI%XRRVEGC (KMASK(JJ), KPATCH) = DGEI%XRRVEGC (KMASK(JJ), KPATCH) + PKDI%XP_RRVEG (JJ) * PTSTEP
- DGEI%XMELTC (KMASK(JJ), KPATCH) = DGEI%XMELTC (KMASK(JJ), KPATCH) + PKDI%XP_MELT (JJ) * PTSTEP
- DGEI%XIFLOODC (KMASK(JJ), KPATCH) = DGEI%XIFLOODC (KMASK(JJ), KPATCH) + PKDI%XP_IFLOOD (JJ) * PTSTEP
- DGEI%XPFLOODC (KMASK(JJ), KPATCH) = DGEI%XPFLOODC (KMASK(JJ), KPATCH) + PKDI%XP_PFLOOD (JJ) * PTSTEP
- DGEI%XLE_FLOODC (KMASK(JJ), KPATCH) = DGEI%XLE_FLOODC (KMASK(JJ), KPATCH) + PKDI%XP_LE_FLOOD (JJ) * PTSTEP
- DGEI%XLEI_FLOODC (KMASK(JJ), KPATCH) = DGEI%XLEI_FLOODC (KMASK(JJ), KPATCH) + PKDI%XP_LEI_FLOOD (JJ) * PTSTEP
- DGEI%XIRRIG_FLUXC(KMASK(JJ), KPATCH) = DGEI%XIRRIG_FLUXC(KMASK(JJ), KPATCH) + PKDI%XP_IRRIG_FLUX(JJ) * PTSTEP
- !
- IF (I%LMEB_PATCH(KPATCH)) THEN
- DGEI%XLEVCVC (KMASK(JJ), KPATCH) = DGEI%XLEVCVC (KMASK(JJ), KPATCH) + PKDI%XP_LEVCV (JJ) * PTSTEP
- DGEI%XLESCC (KMASK(JJ), KPATCH) = DGEI%XLESCC (KMASK(JJ), KPATCH) + PKDI%XP_LESC (JJ) * PTSTEP
-! XLETRGVC (KMASK(JJ), KPATCH) = XLETRGVC (KMASK(JJ), KPATCH) + XP_LETRGV (JJ) * PTSTEP
- DGEI%XLETRCVC (KMASK(JJ), KPATCH) = DGEI%XLETRCVC (KMASK(JJ), KPATCH) + PKDI%XP_LETRCV (JJ) * PTSTEP
-! XLERGVC (KMASK(JJ), KPATCH) = XLERGVC (KMASK(JJ), KPATCH) + XP_LERGV (JJ) * PTSTEP
- DGEI%XLERCVC (KMASK(JJ), KPATCH) = DGEI%XLERCVC (KMASK(JJ), KPATCH) + PKDI%XP_LERCV (JJ) * PTSTEP
- DGEI%XLE_C_AC (KMASK(JJ), KPATCH) = DGEI%XLE_C_AC (KMASK(JJ), KPATCH) + PKDI%XP_LE_C_A (JJ) * PTSTEP
- DGEI%XLE_V_CC (KMASK(JJ), KPATCH) = DGEI%XLE_V_CC (KMASK(JJ), KPATCH) + PKDI%XP_LE_V_C (JJ) * PTSTEP
- DGEI%XLE_G_CC (KMASK(JJ), KPATCH) = DGEI%XLE_G_CC (KMASK(JJ), KPATCH) + PKDI%XP_LE_G_C (JJ) * PTSTEP
- DGEI%XLE_N_CC (KMASK(JJ), KPATCH) = DGEI%XLE_N_CC (KMASK(JJ), KPATCH) + PKDI%XP_LE_N_C (JJ) * PTSTEP
- !
- DGEI%XSWNET_VC (KMASK(JJ), KPATCH) = DGEI%XSWNET_VC (KMASK(JJ), KPATCH) + PKDI%XP_SWNET_V (JJ) * PTSTEP
- DGEI%XSWNET_GC (KMASK(JJ), KPATCH) = DGEI%XSWNET_GC (KMASK(JJ), KPATCH) + PKDI%XP_SWNET_G (JJ) * PTSTEP
- DGEI%XSWNET_NC (KMASK(JJ), KPATCH) = DGEI%XSWNET_NC (KMASK(JJ), KPATCH) + PKDI%XP_SWNET_N (JJ) * PTSTEP
- DGEI%XSWNET_NSC (KMASK(JJ), KPATCH) = DGEI%XSWNET_NSC (KMASK(JJ), KPATCH) + PKDI%XP_SWNET_NS (JJ) * PTSTEP
- DGEI%XLWNET_VC (KMASK(JJ), KPATCH) = DGEI%XLWNET_VC (KMASK(JJ), KPATCH) + PKDI%XP_LWNET_V (JJ) * PTSTEP
- DGEI%XLWNET_GC (KMASK(JJ), KPATCH) = DGEI%XLWNET_GC (KMASK(JJ), KPATCH) + PKDI%XP_LWNET_G (JJ) * PTSTEP
- DGEI%XLWNET_NC (KMASK(JJ), KPATCH) = DGEI%XLWNET_NC (KMASK(JJ), KPATCH) + PKDI%XP_LWNET_N (JJ) * PTSTEP
- DGEI%XSWDOWN_GNC (KMASK(JJ), KPATCH) = DGEI%XSWDOWN_GNC (KMASK(JJ), KPATCH) + PKDI%XP_SWDOWN_GN (JJ) * PTSTEP
- DGEI%XLWDOWN_GNC (KMASK(JJ), KPATCH) = DGEI%XLWDOWN_GNC (KMASK(JJ), KPATCH) + PKDI%XP_LWDOWN_GN (JJ) * PTSTEP
- DGEI%XH_V_CC (KMASK(JJ), KPATCH) = DGEI%XH_V_CC (KMASK(JJ), KPATCH) + PKDI%XP_H_V_C (JJ) * PTSTEP
- DGEI%XH_G_CC (KMASK(JJ), KPATCH) = DGEI%XH_G_CC (KMASK(JJ), KPATCH) + PKDI%XP_H_G_C (JJ) * PTSTEP
- DGEI%XH_C_AC (KMASK(JJ), KPATCH) = DGEI%XH_C_AC (KMASK(JJ), KPATCH) + PKDI%XP_H_C_A (JJ) * PTSTEP
- DGEI%XH_N_CC (KMASK(JJ), KPATCH) = DGEI%XH_N_CC (KMASK(JJ), KPATCH) + PKDI%XP_H_N_C (JJ) * PTSTEP
- DGEI%XSR_GNC (KMASK(JJ), KPATCH) = DGEI%XSR_GNC (KMASK(JJ), KPATCH) + PKDI%XP_SR_GN (JJ) * PTSTEP
- DGEI%XMELTCVC (KMASK(JJ), KPATCH) = DGEI%XMELTCVC (KMASK(JJ), KPATCH) + PKDI%XP_MELTCV (JJ) * PTSTEP
- DGEI%XFRZCVC (KMASK(JJ), KPATCH) = DGEI%XFRZCVC (KMASK(JJ), KPATCH) + PKDI%XP_FRZCV (JJ) * PTSTEP
- ENDIF
- !
- DGI%XSWDC(KMASK(JJ), KPATCH) = DGI%XSWDC(KMASK(JJ), KPATCH) + PKDI%XP_SWD(JJ) * PTSTEP
- DGI%XSWUC(KMASK(JJ), KPATCH) = DGI%XSWUC(KMASK(JJ), KPATCH) + PKDI%XP_SWU(JJ) * PTSTEP
- DGI%XLWDC(KMASK(JJ), KPATCH) = DGI%XLWDC(KMASK(JJ), KPATCH) + PKDI%XP_LWD(JJ) * PTSTEP
- DGI%XLWUC(KMASK(JJ), KPATCH) = DGI%XLWUC(KMASK(JJ), KPATCH) + PKDI%XP_LWU(JJ) * PTSTEP
- DGI%XFMUC(KMASK(JJ), KPATCH) = DGI%XFMUC(KMASK(JJ), KPATCH) + PKDI%XP_FMU(JJ) * PTSTEP
- DGI%XFMVC(KMASK(JJ), KPATCH) = DGI%XFMVC(KMASK(JJ), KPATCH) + PKDI%XP_FMV(JJ) * PTSTEP
- !
- END DO
- !
- IF (I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO') THEN
-!cdir nodep
- DO JJ=1,KSIZE
- DGEI%XLESLC (KMASK(JJ), KPATCH) = DGEI%XLESLC (KMASK(JJ), KPATCH) + PKDI%XP_LESL (JJ) * PTSTEP
- DGEI%XSNDRIFTC (KMASK(JJ), KPATCH) = DGEI%XSNDRIFTC (KMASK(JJ), KPATCH) + PKDI%XP_SNDRIFT (JJ) * PTSTEP
- END DO
- END IF
- !
- IF(HPHOTO/='NON')THEN
-!cdir nodep
- DO JJ=1,KSIZE
- !Transform units from kgCO2/kgair m/s to kgCO2/m2
- DGEI%XGPPC (KMASK(JJ), KPATCH) = DGEI%XGPPC (KMASK(JJ), KPATCH)+ PKDI%XP_GPP (JJ) * PRHOA(JJ) * PTSTEP
- DGEI%XRESPC_AUTO (KMASK(JJ), KPATCH) = DGEI%XRESPC_AUTO (KMASK(JJ), KPATCH)+ PKDI%XP_RESP_AUTO (JJ) * PRHOA(JJ) * PTSTEP
- DGEI%XRESPC_ECO (KMASK(JJ), KPATCH) = DGEI%XRESPC_ECO (KMASK(JJ), KPATCH)+ PKDI%XP_RESP_ECO (JJ) * PRHOA(JJ) * PTSTEP
- END DO
- ELSE
- DGEI%XGPPC (:,:)=0.0
- DGEI%XRESPC_AUTO(:,:)=0.0
- DGEI%XRESPC_ECO (:,:)=0.0
- ENDIF
- !
- IF(I%LGLACIER)THEN
-!cdir nodep
- DO JJ=1,KSIZE
- DGEI%XICEFLUXC(KMASK(JJ), KPATCH) = DGEI%XICEFLUXC(KMASK(JJ), KPATCH) + PKDI%XP_ICEFLUX(JJ) * PTSTEP
- END DO
- END IF
- !
- IF(DGEI%LWATER_BUDGET)THEN
-!cdir nodep
- DO JJ=1,KSIZE
- DGEI%XDWGC (KMASK(JJ), KPATCH) = DGEI%XDWGC (KMASK(JJ), KPATCH) + PKDI%XP_DWG (JJ) * PTSTEP
- DGEI%XDWGIC (KMASK(JJ), KPATCH) = DGEI%XDWGIC (KMASK(JJ), KPATCH) + PKDI%XP_DWGI (JJ) * PTSTEP
- DGEI%XDWRC (KMASK(JJ), KPATCH) = DGEI%XDWRC (KMASK(JJ), KPATCH) + PKDI%XP_DWR (JJ) * PTSTEP
- DGEI%XDSWEC (KMASK(JJ), KPATCH) = DGEI%XDSWEC (KMASK(JJ), KPATCH) + PKDI%XP_DSWE (JJ) * PTSTEP
- DGEI%XWATBUDC(KMASK(JJ), KPATCH) = DGEI%XWATBUDC(KMASK(JJ), KPATCH) + PKDI%XP_WATBUD(JJ) * PTSTEP
- END DO
- ENDIF
- !
-END IF
-IF (LHOOK) CALL DR_HOOK('DIAG_EVAP_ISBA_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE DIAG_EVAP_ISBA_n
diff --git a/src/SURFEX/diag_flake_initn.F90 b/src/SURFEX/diag_flake_initn.F90
index 1c58fd5ec0e5084b3e854eb27169727b06d6a4e2..6218a32583797e62e54d46b11332a0a83e2bef08 100644
--- a/src/SURFEX/diag_flake_initn.F90
+++ b/src/SURFEX/diag_flake_initn.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_FLAKE_INIT_n (DGU, DGF, DGMF, F, &
+ SUBROUTINE DIAG_FLAKE_INIT_n (OREAD_BUDGETC, DGO, D, DC, DMF, F, &
HPROGRAM,KLU,KSW)
! #####################
!
@@ -40,15 +40,15 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODE_DIAG
!
-!
-!
-!
-USE MODD_DIAG_FLAKE_n, ONLY : DIAG_FLAKE_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
USE MODD_DIAG_MISC_FLAKE_n, ONLY : DIAG_MISC_FLAKE_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_FLAKE_n, ONLY : FLAKE_t
!
+#ifdef SFX_OL
+USE MODN_IO_OFFLINE, ONLY : LRESTART
+#endif
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_SFX_OASIS, ONLY : LCPL_LAKE
!
@@ -67,22 +67,23 @@ IMPLICIT NONE
!
!
!
-!
-TYPE(DIAG_FLAKE_t), INTENT(INOUT) :: DGF
-TYPE(DIAG_MISC_FLAKE_t), INTENT(INOUT) :: DGMF
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
+TYPE(DIAG_MISC_FLAKE_t), INTENT(INOUT) :: DMF
+LOGICAL, INTENT(IN) :: OREAD_BUDGETC
TYPE(FLAKE_t), INTENT(INOUT) :: F
!
INTEGER, INTENT(IN) :: KLU ! size of arrays
INTEGER, INTENT(IN) :: KSW ! number of SW spectral bands
- CHARACTER(LEN=6), INTENT(IN):: HPROGRAM ! program calling
+CHARACTER(LEN=6), INTENT(IN):: HPROGRAM ! program calling
!
!* 0.2 Declarations of local variables
! -------------------------------
!
INTEGER :: IVERSION
INTEGER :: IRESP ! IRESP : return-code if a problem appears
- CHARACTER(LEN=LEN_HREC) :: YREC ! Name of the article to be read
+CHARACTER(LEN=LEN_HREC) :: YREC ! Name of the article to be read
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
@@ -91,291 +92,115 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('DIAG_FLAKE_INIT_N',0,ZHOOK_HANDLE)
!
-ALLOCATE(DGF%XDIAG_TS(KLU))
-DGF%XDIAG_TS = XUNDEF
-!
-IF (DGF%LSURF_BUDGET.OR.DGF%LSURF_BUDGETC) THEN
- ALLOCATE(DGF%XRN (KLU))
- ALLOCATE(DGF%XH (KLU))
- ALLOCATE(DGF%XLE (KLU))
- ALLOCATE(DGF%XLEI (KLU))
- ALLOCATE(DGF%XGFLUX (KLU))
- ALLOCATE(DGF%XEVAP (KLU))
- ALLOCATE(DGF%XSUBL (KLU))
- ALLOCATE(DGF%XSWD (KLU))
- ALLOCATE(DGF%XSWU (KLU))
- ALLOCATE(DGF%XLWD (KLU))
- ALLOCATE(DGF%XLWU (KLU))
- ALLOCATE(DGF%XSWBD (KLU,KSW))
- ALLOCATE(DGF%XSWBU (KLU,KSW))
- ALLOCATE(DGF%XFMU (KLU))
- ALLOCATE(DGF%XFMV (KLU))
- ALLOCATE(DGF%XALBT (KLU))
- ALLOCATE(DGF%XSWE (KLU))
- !
- DGF%XRN = XUNDEF
- DGF%XH = XUNDEF
- DGF%XLE = XUNDEF
- DGF%XLEI = XUNDEF
- DGF%XGFLUX = XUNDEF
- DGF%XEVAP = XUNDEF
- DGF%XSUBL = XUNDEF
- DGF%XSWD = XUNDEF
- DGF%XSWU = XUNDEF
- DGF%XLWD = XUNDEF
- DGF%XLWU = XUNDEF
- DGF%XSWBD = XUNDEF
- DGF%XSWBU = XUNDEF
- DGF%XFMU = XUNDEF
- DGF%XFMV = XUNDEF
- DGF%XALBT = XUNDEF
- DGF%XSWE = XUNDEF
-ELSE
- ALLOCATE(DGF%XRN (0))
- ALLOCATE(DGF%XH (0))
- ALLOCATE(DGF%XLE (0))
- ALLOCATE(DGF%XLEI (0))
- ALLOCATE(DGF%XGFLUX (0))
- ALLOCATE(DGF%XEVAP (0))
- ALLOCATE(DGF%XSUBL (0))
- ALLOCATE(DGF%XSWD (0))
- ALLOCATE(DGF%XSWU (0))
- ALLOCATE(DGF%XLWD (0))
- ALLOCATE(DGF%XLWU (0))
- ALLOCATE(DGF%XSWBD (0,0))
- ALLOCATE(DGF%XSWBU (0,0))
- ALLOCATE(DGF%XFMU (0))
- ALLOCATE(DGF%XFMV (0))
- ALLOCATE(DGF%XALBT (0))
- ALLOCATE(DGF%XSWE (0))
-END IF
-!
-!* cumulative surface energy budget
+ CALL ALLOC_BUD(DGO,D,KLU,KSW)
!
-IF (DGF%LSURF_BUDGETC) THEN
-!
- ALLOCATE(DGF%XRNC (KLU))
- ALLOCATE(DGF%XHC (KLU))
- ALLOCATE(DGF%XLEC (KLU))
- ALLOCATE(DGF%XLEIC (KLU))
- ALLOCATE(DGF%XGFLUXC (KLU))
- ALLOCATE(DGF%XEVAPC (KLU))
- ALLOCATE(DGF%XSUBLC (KLU))
- ALLOCATE(DGF%XSWDC (KLU))
- ALLOCATE(DGF%XSWUC (KLU))
- ALLOCATE(DGF%XLWDC (KLU))
- ALLOCATE(DGF%XLWUC (KLU))
- ALLOCATE(DGF%XFMUC (KLU))
- ALLOCATE(DGF%XFMVC (KLU))
-!
- IF (.NOT. DGU%LREAD_BUDGETC) THEN
- DGF%XRNC = 0.0
- DGF%XHC = 0.0
- DGF%XLEC = 0.0
- DGF%XLEIC = 0.0
- DGF%XGFLUXC = 0.0
- DGF%XEVAPC = 0.0
- DGF%XSUBLC = 0.0
- DGF%XSWDC = 0.0
- DGF%XSWUC = 0.0
- DGF%XLWDC = 0.0
- DGF%XLWUC = 0.0
- DGF%XFMUC = 0.0
- DGF%XFMVC = 0.0
- ELSEIF (DGU%LREAD_BUDGETC.AND.DGF%LRESET_BUDGETC) THEN
- DGF%XRNC = 0.0
- DGF%XHC = 0.0
- DGF%XLEC = 0.0
- DGF%XLEIC = 0.0
- DGF%XGFLUXC = 0.0
- DGF%XEVAPC = 0.0
- DGF%XSUBLC = 0.0
- DGF%XSWDC = 0.0
- DGF%XSWUC = 0.0
- DGF%XLWDC = 0.0
- DGF%XLWUC = 0.0
- DGF%XFMUC = 0.0
- DGF%XFMVC = 0.0
- ELSE
- CALL READ_SURF(&
- HPROGRAM,'VERSION',IVERSION,IRESP)
- IF (IVERSION<8)THEN
- DGF%XRNC = 0.0
- DGF%XHC = 0.0
- DGF%XLEC = 0.0
- DGF%XLEIC = 0.0
- DGF%XGFLUXC = 0.0
- DGF%XEVAPC = 0.0
- DGF%XSUBLC = 0.0
- DGF%XSWDC = 0.0
- DGF%XSWUC = 0.0
- DGF%XLWDC = 0.0
- DGF%XLWUC = 0.0
- DGF%XFMUC = 0.0
- DGF%XFMVC = 0.0
- ELSE
- YREC='RNC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGF%XRNC,IRESP)
- YREC='HC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGF%XHC ,IRESP)
- YREC='LEC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGF%XLEC,IRESP)
- YREC='LEIC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGF%XLEIC,IRESP)
- YREC='GFLUXC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGF%XGFLUXC,IRESP)
- YREC='SWDC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGF%XSWDC,IRESP)
- YREC='SWUC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGF%XSWUC,IRESP)
- YREC='LWDC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGF%XLWDC,IRESP)
- YREC='LWUC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGF%XLWUC,IRESP)
- YREC='FMUC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGF%XFMUC,IRESP)
- YREC='FMVC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGF%XFMVC,IRESP)
- YREC='EVAPC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGF%XEVAPC,IRESP)
- YREC='SUBLC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGF%XSUBLC,IRESP)
- ENDIF
-!
- ENDIF
-ELSE
- ALLOCATE(DGF%XRNC (0))
- ALLOCATE(DGF%XHC (0))
- ALLOCATE(DGF%XLEC (0))
- ALLOCATE(DGF%XLEIC (0))
- ALLOCATE(DGF%XGFLUXC (0))
- ALLOCATE(DGF%XEVAPC (0))
- ALLOCATE(DGF%XSUBLC (0))
- ALLOCATE(DGF%XSWDC (0))
- ALLOCATE(DGF%XSWUC (0))
- ALLOCATE(DGF%XLWDC (0))
- ALLOCATE(DGF%XLWUC (0))
- ALLOCATE(DGF%XFMUC (0))
- ALLOCATE(DGF%XFMVC (0))
-ENDIF
-!
-!* parameters at 2m
-!
-IF (DGF%N2M>=1) THEN
- ALLOCATE(DGF%XRI (KLU))
- ALLOCATE(DGF%XT2M (KLU))
- ALLOCATE(DGF%XT2M_MIN(KLU))
- ALLOCATE(DGF%XT2M_MAX(KLU))
- ALLOCATE(DGF%XQ2M (KLU))
- ALLOCATE(DGF%XHU2M (KLU))
- ALLOCATE(DGF%XHU2M_MIN(KLU))
- ALLOCATE(DGF%XHU2M_MAX(KLU))
- ALLOCATE(DGF%XZON10M (KLU))
- ALLOCATE(DGF%XMER10M (KLU))
- ALLOCATE(DGF%XWIND10M (KLU))
- ALLOCATE(DGF%XWIND10M_MAX(KLU))
+IF (DGO%LSURF_BUDGET.OR.DGO%LSURF_BUDGETC) THEN
!
- DGF%XRI = XUNDEF
- DGF%XT2M = XUNDEF
- DGF%XT2M_MIN = XUNDEF
- DGF%XT2M_MAX = 0.0
- DGF%XQ2M = XUNDEF
- DGF%XHU2M = XUNDEF
- DGF%XHU2M_MIN= XUNDEF
- DGF%XHU2M_MAX=-XUNDEF
- DGF%XZON10M = XUNDEF
- DGF%XMER10M = XUNDEF
- DGF%XWIND10M = XUNDEF
- DGF%XWIND10M_MAX = 0.0
-ELSE
- ALLOCATE(DGF%XRI (0))
- ALLOCATE(DGF%XT2M (0))
- ALLOCATE(DGF%XT2M_MIN (0))
- ALLOCATE(DGF%XT2M_MAX (0))
- ALLOCATE(DGF%XQ2M (0))
- ALLOCATE(DGF%XHU2M (0))
- ALLOCATE(DGF%XHU2M_MIN(0))
- ALLOCATE(DGF%XHU2M_MAX(0))
- ALLOCATE(DGF%XZON10M (0))
- ALLOCATE(DGF%XMER10M (0))
- ALLOCATE(DGF%XWIND10M (0))
- ALLOCATE(DGF%XWIND10M_MAX(0))
-END IF
-!
-!* transfer coefficients
-!
-IF (DGF%LCOEF) THEN
- ALLOCATE(DGF%XCD (KLU))
- ALLOCATE(DGF%XCH (KLU))
- ALLOCATE(DGF%XCE (KLU))
- ALLOCATE(DGF%XZ0 (KLU))
- ALLOCATE(DGF%XZ0H (KLU))
+ ALLOCATE(D%XEVAP (KLU))
+ ALLOCATE(D%XSUBL (KLU))
+ ALLOCATE(D%XALBT (KLU))
+ ALLOCATE(D%XSWE (KLU))
+ D%XEVAP = XUNDEF
+ D%XSUBL = XUNDEF
+ D%XALBT = XUNDEF
+ D%XSWE = XUNDEF
!
- DGF%XCD = XUNDEF
- DGF%XCH = XUNDEF
- DGF%XCE = XUNDEF
- DGF%XZ0 = XUNDEF
- DGF%XZ0H = XUNDEF
ELSE
- ALLOCATE(DGF%XCD (0))
- ALLOCATE(DGF%XCH (0))
- ALLOCATE(DGF%XCE (0))
- ALLOCATE(DGF%XZ0 (0))
- ALLOCATE(DGF%XZ0H (0))
+ !
+ ALLOCATE(D%XEVAP (0))
+ ALLOCATE(D%XSUBL (0))
+ ALLOCATE(D%XALBT (0))
+ ALLOCATE(D%XSWE (0))
+ !
END IF
!
-!* surface humidity
+!* cumulative surface energy budget
!
-IF (DGF%LSURF_VARS) THEN
- ALLOCATE(DGF%XQS (KLU))
+#ifdef SFX_OL
+IF (DGO%LSURF_BUDGETC .OR. (LRESTART .AND. .NOT.DGO%LRESET_BUDGETC)) THEN
+#else
+IF (DGO%LSURF_BUDGETC .OR. .NOT.DGO%LRESET_BUDGETC) THEN
+#endif
+ !
+ CALL ALLOC_SURF_BUD(DC,0,KLU,0)
+ ALLOCATE(DC%XEVAP (KLU))
+ ALLOCATE(DC%XSUBL (KLU))
!
- DGF%XQS = XUNDEF
+ IF (.NOT. OREAD_BUDGETC .OR. OREAD_BUDGETC.AND.DGO%LRESET_BUDGETC) THEN
+ CALL INIT_SURF_BUD(DC,0.)
+ DC%XEVAP = 0.
+ DC%XSUBL = 0.
+ ELSE
+ CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
+ IF (IVERSION<8)THEN
+ CALL INIT_SURF_BUD(DC,0.)
+ DC%XEVAP = 0.
+ DC%XSUBL = 0.
+ ELSE
+ YREC='RNC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XRN,IRESP)
+ YREC='HC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XH,IRESP)
+ YREC='LEC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLE,IRESP)
+ YREC='LEIC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLEI,IRESP)
+ YREC='GFLUXC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XGFLUX,IRESP)
+ YREC='SWDC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XSWD,IRESP)
+ YREC='SWUC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XSWU,IRESP)
+ YREC='LWDC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLWD,IRESP)
+ YREC='LWUC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLWU,IRESP)
+ YREC='FMUC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XFMU,IRESP)
+ YREC='FMVC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XFMV,IRESP)
+ YREC='EVAPC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XEVAP,IRESP)
+ YREC='SUBLC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XSUBL,IRESP)
+ ENDIF
+ !
+ ENDIF
+ !
ELSE
- ALLOCATE(DGF%XQS (0))
-END IF
+ CALL ALLOC_SURF_BUD(DC,0,0,0)
+ ALLOCATE(DC%XEVAP (0))
+ ALLOCATE(DC%XSUBL (0))
+ENDIF
!
!* Flake temperature profile
!
-IF (DGMF%LWATER_PROFILE) THEN
- ALLOCATE (DGMF%XZW_PROFILE(COUNT(DGMF%XZWAT_PROFILE/= XUNDEF)))
- ALLOCATE (DGMF%XTW_PROFILE(COUNT(DGMF%XZWAT_PROFILE/= XUNDEF),KLU))
- DGMF%XZW_PROFILE=DGMF%XZWAT_PROFILE(:COUNT(DGMF%XZWAT_PROFILE /= XUNDEF))
+IF (DMF%LWATER_PROFILE) THEN
+ ALLOCATE (DMF%XZW_PROFILE(COUNT(DMF%XZWAT_PROFILE/= XUNDEF)))
+ ALLOCATE (DMF%XTW_PROFILE(COUNT(DMF%XZWAT_PROFILE/= XUNDEF),KLU))
+ DMF%XZW_PROFILE=DMF%XZWAT_PROFILE(:COUNT(DMF%XZWAT_PROFILE /= XUNDEF))
ELSE
- ALLOCATE (DGMF%XZW_PROFILE(0))
- ALLOCATE (DGMF%XTW_PROFILE(0,0))
+ ALLOCATE (DMF%XZW_PROFILE(0))
+ ALLOCATE (DMF%XTW_PROFILE(0,0))
END IF
!
!* Coupling field with earth systme model
!
-!
IF(LCPL_LAKE)THEN
-!
+ !
ALLOCATE(F%XCPL_FLAKE_EVAP(KLU))
ALLOCATE(F%XCPL_FLAKE_RAIN(KLU))
ALLOCATE(F%XCPL_FLAKE_SNOW(KLU))
F%XCPL_FLAKE_EVAP(:) = 0.0
F%XCPL_FLAKE_RAIN(:) = 0.0
F%XCPL_FLAKE_SNOW(:) = 0.0
-!
+ !
ELSE
-!
+ !
ALLOCATE(F%XCPL_FLAKE_EVAP(0))
ALLOCATE(F%XCPL_FLAKE_RAIN(0))
ALLOCATE(F%XCPL_FLAKE_SNOW(0))
-!
+ !
ENDIF
!
IF (LHOOK) CALL DR_HOOK('DIAG_FLAKE_INIT_N',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/diag_flaken.F90 b/src/SURFEX/diag_flaken.F90
deleted file mode 100644
index 566661513df2a6534002ff329d7d8927f4478763..0000000000000000000000000000000000000000
--- a/src/SURFEX/diag_flaken.F90
+++ /dev/null
@@ -1,182 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE DIAG_FLAKE_n (DGF, &
- HPROGRAM, &
- PRN, PH, PLE, PLEI, PGFLUX, PRI, PCD, PCH, PCE, PQS, &
- PZ0, PZ0H, PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M, &
- PSWD, PSWU, PLWD, PLWU, PSWBD, PSWBU, PFMU, PFMV, &
- PRNC, PHC, PLEC, PGFLUXC, PSWDC, PSWUC, PLWDC, &
- PLWUC, PFMUC, PFMVC, PT2M_MIN, PT2M_MAX, PLEIC, &
- PHU2M_MIN, PHU2M_MAX, PWIND10M, PWIND10M_MAX, &
- PEVAP, PEVAPC, PSUBL, PSUBLC )
-! ###############################################################################
-!
-!!**** *DIAG_FLAKE_n * - diagnostics for lakes
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! V.Masson 10/2013 Adds min and max 2m parameters
-!! Modified 04/2013 P.LeMoigne : cumulated diag & t2m min/max
-!!------------------------------------------------------------------
-!
-
-!
-!
-USE MODD_DIAG_FLAKE_n, ONLY : DIAG_FLAKE_t
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(DIAG_FLAKE_t), INTENT(INOUT) :: DGF
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PRN ! Net radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PH ! Sensible heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLE ! Total latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEI ! Sublimation latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX ! Storage flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAP ! Total evapotranspiration (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSUBL ! Sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PRI ! Richardson number (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PCD ! drag coefficient (W/s2)
-REAL, DIMENSION(:), INTENT(OUT) :: PCH ! transf. coef heat (W/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PCE ! transf. coef vapor (W/s/K)
-REAL, DIMENSION(:), INTENT(OUT) :: PQS
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0 ! rough. length wind (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0H ! rough. length heat (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PTS ! surface temperature (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M ! temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PQ2M ! humidity at 2m (kg/kg)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M ! relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PZON10M ! zonal wind at 10m (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PMER10M ! meridian wind at 10m(m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWD ! incoming short-wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWU ! upward short-wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWD ! incoming long-wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWU ! upward long-wave radiation (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBD ! incoming short-wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBU ! upward short-wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMU ! zonal momentum flux (Pa)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMV ! meridian momentum flux (Pa)
-REAL, DIMENSION(:), INTENT(OUT) :: PRNC ! Net radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PHC ! Sensible heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEC ! Total latent heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEIC ! Sublimation latent heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUXC ! Storage flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAPC ! Total evapotranspiration (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSUBLC ! Sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWDC ! incoming short wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWUC ! outgoing short wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWDC ! incoming long wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWUC ! outgoing long wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMUC ! zonal friction
-REAL, DIMENSION(:), INTENT(OUT) :: PFMVC ! meridian friction
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MIN ! Minimum temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MAX ! Maximum temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MIN! Minimum relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MAX! Maximum relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M ! wind at 10m (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M_MAX! Maximum wind at 10m (m/s)
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!
-!* 0.2 declarations of local variables
-!
-!-------------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_FLAKE_N',0,ZHOOK_HANDLE)
-IF (DGF%LSURF_BUDGET) THEN
- PRN = DGF%XRN
- PH = DGF%XH
- PLE = DGF%XLE
- PLEI = DGF%XLEI
- PGFLUX = DGF%XGFLUX
- PEVAP = DGF%XEVAP
- PSUBL = DGF%XSUBL
- PSWD = DGF%XSWD
- PSWU = DGF%XSWU
- PLWD = DGF%XLWD
- PLWU = DGF%XLWU
- PSWBD = DGF%XSWBD
- PSWBU = DGF%XSWBU
- PFMU = DGF%XFMU
- PFMV = DGF%XFMV
-END IF
-!
-IF (DGF%LSURF_BUDGETC) THEN
- PRNC = DGF%XRNC
- PHC = DGF%XHC
- PLEC = DGF%XLEC
- PLEIC = DGF%XLEIC
- PGFLUXC = DGF%XGFLUXC
- PEVAPC = DGF%XEVAPC
- PSUBLC = DGF%XSUBLC
- PSWDC = DGF%XSWDC
- PSWUC = DGF%XSWUC
- PLWDC = DGF%XLWDC
- PLWUC = DGF%XLWUC
- PFMUC = DGF%XFMUC
- PFMVC = DGF%XFMVC
-END IF
-!
-IF (DGF%N2M>=1 .OR. DGF%LSURF_BUDGET .OR. DGF%LSURF_BUDGETC) PTS = DGF%XDIAG_TS
-!
-IF (DGF%N2M>=1) THEN
- PRI = DGF%XRI
- PT2M = DGF%XT2M
- PT2M_MIN = DGF%XT2M_MIN
- PT2M_MAX = DGF%XT2M_MAX
- PQ2M = DGF%XQ2M
- PHU2M = DGF%XHU2M
- PHU2M_MIN= DGF%XHU2M_MIN
- PHU2M_MAX= DGF%XHU2M_MAX
- PZON10M = DGF%XZON10M
- PMER10M = DGF%XMER10M
- PWIND10M = DGF%XWIND10M
- PWIND10M_MAX = DGF%XWIND10M_MAX
-END IF
-!
-IF (DGF%LCOEF) THEN
- PCD = DGF%XCD
- PCH = DGF%XCH
- PCE = DGF%XCE
- PZ0 = DGF%XZ0
- PZ0H = DGF%XZ0H
-END IF
-!
-IF (DGF%LSURF_VARS) THEN
- PQS = DGF%XQS
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_FLAKE_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE DIAG_FLAKE_n
diff --git a/src/SURFEX/diag_ideal_initn.F90 b/src/SURFEX/diag_ideal_initn.F90
index 67412ab4981b375ff1bc5333edd524712fc30358..add59ab7b8b443f54261b3877736cd3a366ba779 100644
--- a/src/SURFEX/diag_ideal_initn.F90
+++ b/src/SURFEX/diag_ideal_initn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_IDEAL_INIT_n (DGL, HPROGRAM, OREAD_BUDGETC, &
- KLU,KSW)
+ SUBROUTINE DIAG_IDEAL_INIT_n (DGO, D, DC, HPROGRAM, OREAD_BUDGETC, KLU, KSW)
! #####################
!
!!**** *DIAG_IDEAL_INIT_n* - routine to initialize IDEAL diagnostic variables
@@ -39,8 +38,9 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODE_DIAG
!
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
@@ -55,9 +55,11 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
!
- CHARACTER(LEN=6), INTENT(IN):: HPROGRAM ! program calling
+CHARACTER(LEN=6), INTENT(IN):: HPROGRAM ! program calling
LOGICAL, INTENT(IN) :: OREAD_BUDGETC
!
INTEGER, INTENT(IN) :: KLU ! size of arrays
@@ -68,7 +70,7 @@ INTEGER, INTENT(IN) :: KSW ! spectral bands
!
INTEGER :: IVERSION
INTEGER :: IRESP ! IRESP : return-code if a problem appears
- CHARACTER(LEN=LEN_HREC) :: YREC ! Name of the article to be read
+CHARACTER(LEN=LEN_HREC) :: YREC ! Name of the article to be read
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
@@ -77,248 +79,84 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('DIAG_IDEAL_INIT_N',0,ZHOOK_HANDLE)
!
-ALLOCATE(DGL%XDIAG_TS(KLU))
-DGL%XDIAG_TS = XUNDEF
+ CALL ALLOC_BUD(DGO,D,KLU,KSW)
!
-IF (DGL%LSURF_BUDGET .OR. DGL%LSURF_BUDGETC) THEN
- ALLOCATE(DGL%XRN (KLU))
- ALLOCATE(DGL%XH (KLU))
- ALLOCATE(DGL%XLE (KLU))
- ALLOCATE(DGL%XLEI (KLU))
- ALLOCATE(DGL%XGFLUX (KLU))
- ALLOCATE(DGL%XEVAP (KLU))
- ALLOCATE(DGL%XSUBL (KLU))
- ALLOCATE(DGL%XSWD (KLU))
- ALLOCATE(DGL%XSWU (KLU))
- ALLOCATE(DGL%XLWD (KLU))
- ALLOCATE(DGL%XLWU (KLU))
- ALLOCATE(DGL%XSWBD (KLU,KSW))
- ALLOCATE(DGL%XSWBU (KLU,KSW))
- ALLOCATE(DGL%XFMU (KLU))
- ALLOCATE(DGL%XFMV (KLU))
- ALLOCATE(DGL%XALBT (KLU))
- ALLOCATE(DGL%XSWE (KLU))
+IF (DGO%LSURF_BUDGET .OR. DGO%LSURF_BUDGETC) THEN
!
- DGL%XRN = XUNDEF
- DGL%XH = XUNDEF
- DGL%XLE = XUNDEF
- DGL%XLEI = XUNDEF
- DGL%XGFLUX = XUNDEF
- DGL%XEVAP = XUNDEF
- DGL%XSUBL = XUNDEF
- DGL%XSWD = XUNDEF
- DGL%XSWU = XUNDEF
- DGL%XLWD = XUNDEF
- DGL%XLWU = XUNDEF
- DGL%XSWBD = XUNDEF
- DGL%XSWBU = XUNDEF
- DGL%XFMU = XUNDEF
- DGL%XFMV = XUNDEF
- DGL%XALBT = XUNDEF
- DGL%XSWE = XUNDEF
+ ALLOCATE(D%XEVAP (KLU))
+ ALLOCATE(D%XSUBL (KLU))
+ ALLOCATE(D%XALBT (KLU))
+ ALLOCATE(D%XSWE (KLU))
+ !
+ D%XEVAP = XUNDEF
+ D%XSUBL = XUNDEF
+ D%XALBT = XUNDEF
+ D%XSWE = XUNDEF
+ !
ELSE
- ALLOCATE(DGL%XRN (0))
- ALLOCATE(DGL%XH (0))
- ALLOCATE(DGL%XLE (0))
- ALLOCATE(DGL%XLEI (0))
- ALLOCATE(DGL%XGFLUX (0))
- ALLOCATE(DGL%XEVAP (0))
- ALLOCATE(DGL%XSUBL (0))
- ALLOCATE(DGL%XSWD (0))
- ALLOCATE(DGL%XSWU (0))
- ALLOCATE(DGL%XLWD (0))
- ALLOCATE(DGL%XLWU (0))
- ALLOCATE(DGL%XSWBD (0,0))
- ALLOCATE(DGL%XSWBU (0,0))
- ALLOCATE(DGL%XFMU (0))
- ALLOCATE(DGL%XFMV (0))
- ALLOCATE(DGL%XALBT (0))
- ALLOCATE(DGL%XSWE (0))
+ !
+ ALLOCATE(D%XEVAP (0))
+ ALLOCATE(D%XSUBL (0))
+ ALLOCATE(D%XALBT (0))
+ ALLOCATE(D%XSWE (0))
+ !
END IF
!
!* cumulative surface energy budget
!
-IF (DGL%LSURF_BUDGETC) THEN
-!
- ALLOCATE(DGL%XRNC (KLU))
- ALLOCATE(DGL%XHC (KLU))
- ALLOCATE(DGL%XLEC (KLU))
- ALLOCATE(DGL%XLEIC (KLU))
- ALLOCATE(DGL%XGFLUXC (KLU))
- ALLOCATE(DGL%XEVAPC (KLU))
- ALLOCATE(DGL%XSUBLC (KLU))
- ALLOCATE(DGL%XSWDC (KLU))
- ALLOCATE(DGL%XSWUC (KLU))
- ALLOCATE(DGL%XLWDC (KLU))
- ALLOCATE(DGL%XLWUC (KLU))
- ALLOCATE(DGL%XFMUC (KLU))
- ALLOCATE(DGL%XFMVC (KLU))
-!
- IF (.NOT. OREAD_BUDGETC) THEN
- DGL%XRNC = 0.0
- DGL%XHC = 0.0
- DGL%XLEC = 0.0
- DGL%XLEIC = 0.0
- DGL%XGFLUXC = 0.0
- DGL%XEVAPC = 0.0
- DGL%XSUBLC = 0.0
- DGL%XSWDC = 0.0
- DGL%XSWUC = 0.0
- DGL%XLWDC = 0.0
- DGL%XLWUC = 0.0
- DGL%XFMUC = 0.0
- DGL%XFMVC = 0.0
- ELSEIF (OREAD_BUDGETC.AND.DGL%LRESET_BUDGETC) THEN
- DGL%XRNC = 0.0
- DGL%XHC = 0.0
- DGL%XLEC = 0.0
- DGL%XLEIC = 0.0
- DGL%XGFLUXC = 0.0
- DGL%XEVAPC = 0.0
- DGL%XSUBLC = 0.0
- DGL%XSWDC = 0.0
- DGL%XSWUC = 0.0
- DGL%XLWDC = 0.0
- DGL%XLWUC = 0.0
- DGL%XFMUC = 0.0
- DGL%XFMVC = 0.0
+IF (DGO%LSURF_BUDGETC) THEN
+ !
+ CALL ALLOC_SURF_BUD(DC,0,KLU,0)
+ !
+ ALLOCATE(DC%XEVAP (KLU))
+ ALLOCATE(DC%XSUBL (KLU))
+ !
+ IF (.NOT. OREAD_BUDGETC .OR. OREAD_BUDGETC.AND.DGO%LRESET_BUDGETC) THEN
+ CALL INIT_SURF_BUD(DC,0.)
+ DC%XEVAP = 0.
+ DC%XSUBL = 0.
ELSE
- CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
- IF (IVERSION<8)THEN
- DGL%XRNC = 0.0
- DGL%XHC = 0.0
- DGL%XLEC = 0.0
- DGL%XLEIC = 0.0
- DGL%XGFLUXC = 0.0
- DGL%XEVAPC = 0.0
- DGL%XSUBLC = 0.0
- DGL%XSWDC = 0.0
- DGL%XSWUC = 0.0
- DGL%XLWDC = 0.0
- DGL%XLWUC = 0.0
- DGL%XFMUC = 0.0
- DGL%XFMVC = 0.0
- ELSE
- YREC='RNC_WAT'
- CALL READ_SURF(HPROGRAM,YREC,DGL%XRNC,IRESP)
- YREC='HC_WAT'
- CALL READ_SURF(HPROGRAM,YREC,DGL%XHC ,IRESP)
- YREC='LEC_WAT'
- CALL READ_SURF(HPROGRAM,YREC,DGL%XLEC,IRESP)
- YREC='LEIC_WAT'
- CALL READ_SURF(HPROGRAM,YREC,DGL%XLEIC,IRESP)
- YREC='GFLUXC_WAT'
- CALL READ_SURF(HPROGRAM,YREC,DGL%XGFLUXC,IRESP)
- YREC='SWDC_WAT'
- CALL READ_SURF(HPROGRAM,YREC,DGL%XSWDC,IRESP)
- YREC='SWUC_WAT'
- CALL READ_SURF(HPROGRAM,YREC,DGL%XSWUC,IRESP)
- YREC='LWDC_WAT'
- CALL READ_SURF(HPROGRAM,YREC,DGL%XLWDC,IRESP)
- YREC='LWUC_WAT'
- CALL READ_SURF(HPROGRAM,YREC,DGL%XLWUC,IRESP)
- YREC='FMUC_WAT'
- CALL READ_SURF(HPROGRAM,YREC,DGL%XFMUC,IRESP)
- YREC='FMVC_WAT'
- CALL READ_SURF(HPROGRAM,YREC,DGL%XFMVC,IRESP)
- YREC='EVAPC_WAT'
- CALL READ_SURF(HPROGRAM,YREC,DGL%XEVAPC,IRESP)
- YREC='SUBLC_WAT'
- CALL READ_SURF(HPROGRAM,YREC,DGL%XSUBLC,IRESP)
- ENDIF
-!
+ CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
+ IF (IVERSION<8)THEN
+ CALL INIT_SURF_BUD(DC,0.)
+ DC%XEVAP = 0.
+ DC%XSUBL = 0.
+ ELSE
+ YREC='RNC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XRN,IRESP)
+ YREC='HC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XH,IRESP)
+ YREC='LEC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLE,IRESP)
+ YREC='LEIC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLEI,IRESP)
+ YREC='GFLUXC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XGFLUX,IRESP)
+ YREC='SWDC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XSWD,IRESP)
+ YREC='SWUC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XSWU,IRESP)
+ YREC='LWDC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLWD,IRESP)
+ YREC='LWUC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLWU,IRESP)
+ YREC='FMUC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XFMU,IRESP)
+ YREC='FMVC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XFMV,IRESP)
+ YREC='EVAPC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XEVAP,IRESP)
+ YREC='SUBLC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XSUBL,IRESP)
+ ENDIF
+ !
ENDIF
ELSE
- ALLOCATE(DGL%XRNC (0))
- ALLOCATE(DGL%XHC (0))
- ALLOCATE(DGL%XLEC (0))
- ALLOCATE(DGL%XLEIC (0))
- ALLOCATE(DGL%XGFLUXC (0))
- ALLOCATE(DGL%XEVAPC (0))
- ALLOCATE(DGL%XSUBLC (0))
- ALLOCATE(DGL%XSWDC (0))
- ALLOCATE(DGL%XSWUC (0))
- ALLOCATE(DGL%XLWDC (0))
- ALLOCATE(DGL%XLWUC (0))
- ALLOCATE(DGL%XFMUC (0))
- ALLOCATE(DGL%XFMVC (0))
+ CALL ALLOC_SURF_BUD(DC,0,0,0)
+ ALLOCATE(DC%XEVAP (0))
+ ALLOCATE(DC%XSUBL (0))
ENDIF
!
-!* parameters at 2m
-!
-IF (DGL%N2M>=1) THEN
- ALLOCATE(DGL%XRI (KLU))
- ALLOCATE(DGL%XT2M (KLU))
- ALLOCATE(DGL%XT2M_MIN(KLU))
- ALLOCATE(DGL%XT2M_MAX(KLU))
- ALLOCATE(DGL%XQ2M (KLU))
- ALLOCATE(DGL%XHU2M (KLU))
- ALLOCATE(DGL%XHU2M_MIN(KLU))
- ALLOCATE(DGL%XHU2M_MAX(KLU))
- ALLOCATE(DGL%XZON10M (KLU))
- ALLOCATE(DGL%XMER10M (KLU))
- ALLOCATE(DGL%XWIND10M (KLU))
- ALLOCATE(DGL%XWIND10M_MAX(KLU))
- !
- DGL%XRI = XUNDEF
- DGL%XT2M = XUNDEF
- DGL%XT2M_MIN = XUNDEF
- DGL%XT2M_MAX = 0.0
- DGL%XQ2M = XUNDEF
- DGL%XHU2M = XUNDEF
- DGL%XHU2M_MIN= XUNDEF
- DGL%XHU2M_MAX=-XUNDEF
- DGL%XZON10M = XUNDEF
- DGL%XMER10M = XUNDEF
- DGL%XWIND10M = XUNDEF
- DGL%XWIND10M_MAX = 0.0
-ELSE
- ALLOCATE(DGL%XRI (0))
- ALLOCATE(DGL%XT2M (0))
- ALLOCATE(DGL%XT2M_MIN (0))
- ALLOCATE(DGL%XT2M_MAX (0))
- ALLOCATE(DGL%XQ2M (0))
- ALLOCATE(DGL%XHU2M (0))
- ALLOCATE(DGL%XHU2M_MIN(0))
- ALLOCATE(DGL%XHU2M_MAX(0))
- ALLOCATE(DGL%XZON10M (0))
- ALLOCATE(DGL%XMER10M (0))
- ALLOCATE(DGL%XWIND10M (0))
- ALLOCATE(DGL%XWIND10M_MAX(0))
-END IF
-!
-!* transfer coefficients
-!
-IF (DGL%LCOEF) THEN
- ALLOCATE(DGL%XCD (KLU))
- ALLOCATE(DGL%XCH (KLU))
- ALLOCATE(DGL%XCE (KLU))
- ALLOCATE(DGL%XZ0 (KLU))
- ALLOCATE(DGL%XZ0H (KLU))
- !
- DGL%XCD = XUNDEF
- DGL%XCH = XUNDEF
- DGL%XCE = XUNDEF
- DGL%XZ0 = XUNDEF
- DGL%XZ0H = XUNDEF
-ELSE
- ALLOCATE(DGL%XCD (0))
- ALLOCATE(DGL%XCH (0))
- ALLOCATE(DGL%XCE (0))
- ALLOCATE(DGL%XZ0 (0))
- ALLOCATE(DGL%XZ0H (0))
-END IF
-!
-!
-!* surface humidity
-!
-IF (DGL%LSURF_VARS) THEN
- ALLOCATE(DGL%XQS (KLU))
- !
- DGL%XQS = XUNDEF
-ELSE
- ALLOCATE(DGL%XQS (0))
-END IF
IF (LHOOK) CALL DR_HOOK('DIAG_IDEAL_INIT_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/diag_idealn.F90 b/src/SURFEX/diag_idealn.F90
deleted file mode 100644
index f4f46c43fd5863396154e7ff66ab1ff4877c7abb..0000000000000000000000000000000000000000
--- a/src/SURFEX/diag_idealn.F90
+++ /dev/null
@@ -1,183 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE DIAG_IDEAL_n (DGL, &
- HPROGRAM, &
- PRN, PH, PLE, PLEI, PGFLUX, PRI, PCD, PCH, PCE, PQS, &
- PZ0, PZ0H, PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M, &
- PSWD, PSWU, PLWD, PLWU, PSWBD, PSWBU, PFMU, PFMV, &
- PRNC, PHC, PLEC, PGFLUXC, PSWDC, PSWUC, PLWDC, &
- PLWUC, PFMUC, PFMVC, PT2M_MIN, PT2M_MAX, PLEIC, &
- PHU2M_MIN, PHU2M_MAX, PWIND10M, PWIND10M_MAX, &
- PEVAP, PEVAPC, PSUBL, PSUBLC )
-! ###############################################################################
-!
-!!**** *DIAG_IDEAL_n * - Stores IDEAL_n diagnostics
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! P. Le Moigne
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 04/2009
-!! P.Le Moigne 03/2015 add diagnostics IDEAL case
-!!------------------------------------------------------------------
-!
-
-!
-!
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PRN ! Net radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PH ! Sensible heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLE ! Total latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEI ! Sublimation latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX ! Storage flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAP ! Total evapotranspiration (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSUBL ! Sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PRI ! Richardson number (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PCD ! drag coefficient (W/s2)
-REAL, DIMENSION(:), INTENT(OUT) :: PCH ! transf. coef heat (W/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PCE ! transf. coef vapor (W/s/K)
-REAL, DIMENSION(:), INTENT(OUT) :: PQS
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0 ! rough. length wind (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0H ! rough. length heat (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PTS ! surface temperature (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M ! temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PQ2M ! humidity at 2m (kg/kg)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M ! relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PZON10M ! zonal wind at 10m (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PMER10M ! meridian wind at 10m(m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWD ! incoming short-wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWU ! upward short-wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWD ! incoming long-wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWU ! upward long-wave radiation (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBD ! incoming short-wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBU ! upward short-wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMU ! zonal momentum flux (Pa)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMV ! meridian momentum flux (Pa)
-REAL, DIMENSION(:), INTENT(OUT) :: PRNC ! Net radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PHC ! Sensible heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEC ! Total latent heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEIC ! Sublimation latent heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUXC ! Storage flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAPC ! Total evapotranspiration (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSUBLC ! Sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWDC ! incoming short wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWUC ! outgoing short wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWDC ! incoming long wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWUC ! outgoing long wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMUC ! zonal friction
-REAL, DIMENSION(:), INTENT(OUT) :: PFMVC ! meridian friction
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MIN ! Minimum temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MAX ! Maximum temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MIN! Minimum relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MAX! Maximum relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M ! wind at 10m (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M_MAX! Maximum wind at 10m (m/s)
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!
-!* 0.2 declarations of local variables
-!
-!-------------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_IDEAL_N',0,ZHOOK_HANDLE)
-!
-IF (DGL%LSURF_BUDGET) THEN
- PRN = DGL%XRN
- PH = DGL%XH
- PLE = DGL%XLE
- PLEI = DGL%XLEI
- PGFLUX = DGL%XGFLUX
- PEVAP = DGL%XEVAP
- PSUBL = DGL%XSUBL
- PSWD = DGL%XSWD
- PSWU = DGL%XSWU
- PLWD = DGL%XLWD
- PLWU = DGL%XLWU
- PSWBD = DGL%XSWBD
- PSWBU = DGL%XSWBU
- PFMU = DGL%XFMU
- PFMV = DGL%XFMV
-END IF
-!
-IF (DGL%LSURF_BUDGETC) THEN
- PRNC = DGL%XRNC
- PHC = DGL%XHC
- PLEC = DGL%XLEC
- PLEIC = DGL%XLEIC
- PGFLUXC = DGL%XGFLUXC
- PEVAPC = DGL%XEVAPC
- PSUBLC = DGL%XSUBLC
- PSWDC = DGL%XSWDC
- PSWUC = DGL%XSWUC
- PLWDC = DGL%XLWDC
- PLWUC = DGL%XLWUC
- PFMUC = DGL%XFMUC
- PFMVC = DGL%XFMVC
-END IF
-!
-IF (DGL%N2M>=1 .OR. DGL%LSURF_BUDGET .OR. DGL%LSURF_BUDGETC) PTS = DGL%XDIAG_TS
-!
-IF (DGL%N2M>=1) THEN
- PRI = DGL%XRI
- PT2M = DGL%XT2M
- PT2M_MIN = DGL%XT2M_MIN
- PT2M_MAX = DGL%XT2M_MAX
- PQ2M = DGL%XQ2M
- PHU2M = DGL%XHU2M
- PHU2M_MIN= DGL%XHU2M_MIN
- PHU2M_MAX= DGL%XHU2M_MAX
- PZON10M = DGL%XZON10M
- PMER10M = DGL%XMER10M
- PWIND10M = DGL%XWIND10M
- PWIND10M_MAX = DGL%XWIND10M_MAX
-END IF
-!
-IF (DGL%LCOEF) THEN
- PCD = DGL%XCD
- PCH = DGL%XCH
- PCE = DGL%XCE
- PZ0 = DGL%XZ0
- PZ0H = DGL%XZ0H
-ENDIF
-!
-IF (DGL%LSURF_VARS) THEN
- PQS = DGL%XQS
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_IDEAL_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE DIAG_IDEAL_n
diff --git a/src/SURFEX/diag_inland_watern.F90 b/src/SURFEX/diag_inland_watern.F90
index 546c881a1460476d1ab530320f406cd1b2315820..3329957eb5912420e1b63c2efb4d1ae27ab1c67e 100644
--- a/src/SURFEX/diag_inland_watern.F90
+++ b/src/SURFEX/diag_inland_watern.F90
@@ -3,15 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE DIAG_INLAND_WATER_n (DGF, DGL, DGW, U, &
- HPROGRAM, &
- PRN, PH, PLE, PLEI, PGFLUX, PRI, PCD, PCH, PCE, PQS, &
- PZ0,PZ0H, PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M, &
- PSWD, PSWU, PSWBD, PSWBU, PLWD, PLWU, PFMU, PFMV, &
- PRNC, PHC, PLEC, PGFLUXC, PSWDC, PSWUC, PLWDC, &
- PLWUC, PFMUC, PFMVC, PT2M_MIN, PT2M_MAX, PLEIC, &
- PHU2M_MIN, PHU2M_MAX, PWIND10M, PWIND10M_MAX, &
- PEVAP, PEVAPC, PSUBL, PSUBLC )
+SUBROUTINE DIAG_INLAND_WATER_n (DLO, DL, DLC, FM, WM, HWATER, &
+ HPROGRAM, DUP, DUPC, KMASK )
! ###############################################################################
!
!!**** *DIAG_INLAND_WATER_n * - Chooses the surface schemes for lakes diagnostics
@@ -38,23 +31,12 @@ SUBROUTINE DIAG_INLAND_WATER_n (DGF, DGL, DGW, U, &
! B. decharme 04/2013 : Add EVAP and SUBL diag
!!------------------------------------------------------------------
!
-
+USE MODE_DIAG
!
-!
-!
-!
-!
-USE MODD_DIAG_FLAKE_n, ONLY : DIAG_FLAKE_t
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
-USE MODD_DIAG_WATFLUX_n, ONLY : DIAG_WATFLUX_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
+USE MODD_SURFEX_n, ONLY : FLAKE_MODEL_t, WATFLUX_MODEL_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
-
-USE MODI_DIAG_WATFLUX_n
-USE MODI_DIAG_FLAKE_n
-USE MODI_DIAG_IDEAL_n
-!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -64,146 +46,35 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(DIAG_FLAKE_t), INTENT(INOUT) :: DGF
-TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
-TYPE(DIAG_WATFLUX_t), INTENT(INOUT) :: DGW
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DLO
+TYPE(DIAG_t), INTENT(INOUT) :: DL
+TYPE(DIAG_t), INTENT(INOUT) :: DLC
+TYPE(FLAKE_MODEL_t), INTENT(INOUT) :: FM
+TYPE(WATFLUX_MODEL_t), INTENT(INOUT) :: WM
!
+ CHARACTER(LEN=*), INTENT(IN) :: HWATER
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
!
-REAL, DIMENSION(:), INTENT(OUT) :: PRN ! Net radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PH ! Sensible heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLE ! Total latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEI ! Sublimation latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX ! Storage flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAP ! Total evapotranspiration (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSUBL ! Sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PRI ! Richardson number (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PCD ! drag coefficient (W/s2)
-REAL, DIMENSION(:), INTENT(OUT) :: PCH ! transf. coef heat (W/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PCE ! transf. coef vapor (W/s/K)
-REAL, DIMENSION(:), INTENT(OUT) :: PQS
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0 ! rough. length wind (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0H ! rough. length heat (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PTS ! surface temperature (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M ! temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PQ2M ! humidity at 2m (kg/kg)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M ! relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PZON10M ! zonal wind at 10m (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PMER10M ! meridian wind at 10m (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWD ! incoming short wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWU ! outgoing short wave radiation (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBD ! incoming short wave radiation by spectral band(W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBU ! outgoing short wave radiation by spectral band(W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWD ! incoming long wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWU ! outgoing long wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMU ! zonal friction
-REAL, DIMENSION(:), INTENT(OUT) :: PFMV ! meridian friction
-REAL, DIMENSION(:), INTENT(OUT) :: PRNC ! Net radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PHC ! Sensible heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEC ! Total latent heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEIC ! Sublimation latent heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUXC ! Storage flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAPC ! Total evapotranspiration (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSUBLC ! Sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWDC ! incoming short wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWUC ! outgoing short wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWDC ! incoming long wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWUC ! outgoing long wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMUC ! zonal friction
-REAL, DIMENSION(:), INTENT(OUT) :: PFMVC ! meridian friction
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MIN ! Minimum temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MAX ! Maximum temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MIN! Minimum relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MAX! Maximum relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M ! wind at 10m (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M_MAX! Maximum wind at 10m (m/s)
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+TYPE(DIAG_t), INTENT(INOUT) :: DUP
+TYPE(DIAG_t), INTENT(INOUT) :: DUPC
!
+INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
!
!* 0.2 declarations of local variables
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('DIAG_INLAND_WATER_N',0,ZHOOK_HANDLE)
-IF (U%CWATER=='WATFLX') THEN
- CALL DIAG_WATFLUX_n(DGW, &
- HPROGRAM, &
- PRN, PH, PLE, PLEI, PGFLUX, PRI, PCD, PCH, PCE, PQS,&
- PZ0, PZ0H, PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M,&
- PSWD, PSWU, PLWD, PLWU, PSWBD, PSWBU, PFMU, PFMV, &
- PRNC, PHC, PLEC, PGFLUXC, PSWDC, PSWUC, PLWDC, &
- PLWUC, PFMUC, PFMVC, PT2M_MIN, PT2M_MAX, PLEIC, &
- PHU2M_MIN, PHU2M_MAX, PWIND10M, PWIND10M_MAX, &
- PEVAP, PEVAPC, PSUBL, PSUBLC )
-ELSE IF (U%CWATER=='FLAKE ') THEN
- CALL DIAG_FLAKE_n(DGF, &
- HPROGRAM, &
- PRN, PH, PLE, PLEI, PGFLUX, PRI, PCD, PCH, PCE, PQS,&
- PZ0, PZ0H, PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M,&
- PSWD, PSWU, PLWD, PLWU, PSWBD, PSWBU, PFMU, PFMV, &
- PRNC, PHC, PLEC, PGFLUXC, PSWDC, PSWUC, PLWDC, &
- PLWUC, PFMUC, PFMVC, PT2M_MIN, PT2M_MAX, PLEIC, &
- PHU2M_MIN, PHU2M_MAX, PWIND10M, PWIND10M_MAX, &
- PEVAP, PEVAPC, PSUBL, PSUBLC )
-!
-ELSE IF (U%CWATER=='FLUX ') THEN
- CALL DIAG_IDEAL_n(DGL, HPROGRAM, &
- PRN, PH, PLE, PLEI, PGFLUX, PRI, PCD, PCH, PCE, PQS,&
- PZ0, PZ0H, PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M,&
- PSWD, PSWU, PLWD, PLWU, PSWBD, PSWBU, PFMU, PFMV, &
- PRNC, PHC, PLEC, PGFLUXC, PSWDC, PSWUC, PLWDC, &
- PLWUC, PFMUC, PFMVC, PT2M_MIN, PT2M_MAX, PLEIC, &
- PHU2M_MIN, PHU2M_MAX, PWIND10M, PWIND10M_MAX, &
- PEVAP, PEVAPC, PSUBL, PSUBLC )
-ELSE IF (U%CWATER=='NONE ') THEN
- PRN = XUNDEF
- PH = XUNDEF
- PLE = XUNDEF
- PLEI = XUNDEF
- PEVAP = XUNDEF
- PSUBL = XUNDEF
- PGFLUX = XUNDEF
- PRI = XUNDEF
- PCD = XUNDEF
- PCH = XUNDEF
- PCE = XUNDEF
- PQS = XUNDEF
- PZ0 = XUNDEF
- PZ0H = XUNDEF
- PTS = XUNDEF
- PT2M = XUNDEF
- PQ2M = XUNDEF
- PHU2M = XUNDEF
- PZON10M = XUNDEF
- PMER10M = XUNDEF
- PSWD = XUNDEF
- PSWU = XUNDEF
- PSWBD = XUNDEF
- PSWBU = XUNDEF
- PLWD = XUNDEF
- PLWU = XUNDEF
- PFMU = XUNDEF
- PFMV = XUNDEF
- PRNC = XUNDEF
- PHC = XUNDEF
- PLEC = XUNDEF
- PLEIC = XUNDEF
- PEVAPC = XUNDEF
- PSUBLC = XUNDEF
- PGFLUXC = XUNDEF
- PSWDC = XUNDEF
- PSWUC = XUNDEF
- PLWDC = XUNDEF
- PLWUC = XUNDEF
- PFMUC = XUNDEF
- PFMVC = XUNDEF
- PT2M_MIN = XUNDEF
- PT2M_MAX = XUNDEF
- PHU2M_MIN= XUNDEF
- PHU2M_MAX= XUNDEF
- PWIND10M = XUNDEF
- PWIND10M_MAX = XUNDEF
+IF (HWATER=='WATFLX') THEN
+ CALL DIAG_EVAP(WM%DWO, WM%DW, WM%DWC, HPROGRAM, DUP, DUPC, KMASK)
+ELSE IF (HWATER=='FLAKE ') THEN
+ CALL DIAG_EVAP(FM%DFO, FM%DF, FM%DFC, HPROGRAM, DUP, DUPC, KMASK)
+ELSE IF (HWATER=='FLUX ') THEN
+ CALL DIAG_EVAP(DLO, DL, DLC, HPROGRAM, DUP, DUPC, KMASK)
+ELSE IF (HWATER=='NONE ') THEN
+ CALL INIT_BUD(WM%DWO,DUP,DUPC,XUNDEF)
END IF
IF (LHOOK) CALL DR_HOOK('DIAG_INLAND_WATER_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/diag_inline_flaken.F90 b/src/SURFEX/diag_inline_flaken.F90
index ab943fcaabb41772cc794e945b1cab9cb134d058..0a2db82312e0c33724fa863f26907125ed1b00ac 100644
--- a/src/SURFEX/diag_inline_flaken.F90
+++ b/src/SURFEX/diag_inline_flaken.F90
@@ -3,13 +3,13 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_INLINE_FLAKE_n (DGF, F, &
- PTSTEP, PTA, PQA, PPA, PPS, PRHOA, PZONA, &
- PMERA, PHT, PHW, PRAIN, PSNOW, &
- PCD, PCDN, PCH, PRI, PHU, &
- PZ0H, PQSAT, PSFTH, PSFTQ, PSFZON, PSFMER, &
- PDIR_SW, PSCA_SW, PLW, PDIR_ALB, PSCA_ALB, &
- PLE, PLEI, PSUBL, PLWUP, PALB, PSWE )
+ SUBROUTINE DIAG_INLINE_FLAKE_n (DGO, D, DC, F, &
+ PTSTEP, PTA, PQA, PPA, PPS, PRHOA, PZONA, &
+ PMERA, PHT, PHW, PRAIN, PSNOW, &
+ PCD, PCDN, PCH, PRI, PHU, &
+ PZ0H, PQSAT, PSFTH, PSFTQ, PSFZON, PSFMER, &
+ PDIR_SW, PSCA_SW, PLW, PDIR_ALB, PSCA_ALB, &
+ PLE, PLEI, PSUBL, PLWUP, PALB, PSWE )
! ###############################################################################
!
!!**** *DIAG_INLINE_FLAKE_n * - computes diagnostics during FLAKE time-step
@@ -41,18 +41,17 @@
!
!
!
-USE MODD_DIAG_FLAKE_n, ONLY : DIAG_FLAKE_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
USE MODD_FLAKE_n, ONLY : FLAKE_t
!
USE MODD_CSTS, ONLY : XTT
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_SFX_OASIS, ONLY : LCPL_LAKE
!
-USE MODI_PARAM_CLS
USE MODI_CLS_TQ
USE MODI_CLS_WIND
USE MODI_DIAG_SURF_BUDGET_FLAKE
-USE MODI_DIAG_SURF_BUDGETC_FLAKE
+USE MODI_DIAG_SURF_BUDGETC
USE MODI_DIAG_CPL_ESM_FLAKE
USE MODI_ABOR1_SFX
!
@@ -64,7 +63,9 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(DIAG_FLAKE_t), INTENT(INOUT) :: DGF
+TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
TYPE(FLAKE_t), INTENT(INOUT) :: F
!
REAL , INTENT(IN) :: PTSTEP ! atmospheric time-step (s)
@@ -113,99 +114,84 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('DIAG_INLINE_FLAKE_N',0,ZHOOK_HANDLE)
!
-DGF%XDIAG_TS(:) = F%XTS(:)
+D%XTS(:) = F%XTS(:)
!
IF (.NOT. F%LSBL) THEN
!
- IF (DGF%N2M==1) THEN
- CALL PARAM_CLS(PTA, F%XTS, PQA, PPA, PRHOA, PZONA, PMERA, PHT, PHW, &
- PSFTH, PSFTQ, PSFZON, PSFMER, &
- DGF%XT2M, DGF%XQ2M, DGF%XHU2M, DGF%XZON10M, DGF%XMER10M )
- ELSE IF (DGF%N2M==2) THEN
+ IF (DGO%N2M==2) THEN
ZH(:)=2.
- CALL CLS_TQ(PTA, PQA, PPA, PPS, PHT, &
- PCD, PCH, PRI, &
- F%XTS, PHU, PZ0H, ZH, &
- DGF%XT2M, DGF%XQ2M, DGF%XHU2M )
+ CALL CLS_TQ(PTA, PQA, PPA, PPS, PHT, PCD, PCH, PRI, &
+ F%XTS, PHU, PZ0H, ZH, D%XT2M, D%XQ2M, D%XHU2M )
ZH(:)=10.
- CALL CLS_WIND(PZONA, PMERA, PHW, &
- PCD, PCDN, PRI, ZH, &
- DGF%XZON10M, DGF%XMER10M )
+ CALL CLS_WIND(PZONA, PMERA, PHW, PCD, PCDN, PRI, ZH, D%XZON10M, D%XMER10M )
END IF
!
- IF (DGF%N2M>=1) THEN
+ IF (DGO%N2M>=1) THEN
!
- DGF%XT2M_MIN(:) = MIN(DGF%XT2M_MIN(:),DGF%XT2M(:))
- DGF%XT2M_MAX(:) = MAX(DGF%XT2M_MAX(:),DGF%XT2M(:))
+ D%XT2M_MIN(:) = MIN(D%XT2M_MIN(:),D%XT2M(:))
+ D%XT2M_MAX(:) = MAX(D%XT2M_MAX(:),D%XT2M(:))
!
- DGF%XHU2M_MIN(:) = MIN(DGF%XHU2M_MIN(:),DGF%XHU2M(:))
- DGF%XHU2M_MAX(:) = MAX(DGF%XHU2M_MAX(:),DGF%XHU2M(:))
+ D%XHU2M_MIN(:) = MIN(D%XHU2M_MIN(:),D%XHU2M(:))
+ D%XHU2M_MAX(:) = MAX(D%XHU2M_MAX(:),D%XHU2M(:))
!
- DGF%XWIND10M(:) = SQRT(DGF%XZON10M(:)**2+DGF%XMER10M(:)**2)
- DGF%XWIND10M_MAX(:) = MAX(DGF%XWIND10M_MAX(:),DGF%XWIND10M(:))
+ D%XWIND10M(:) = SQRT(D%XZON10M(:)**2+D%XMER10M(:)**2)
+ D%XWIND10M_MAX(:) = MAX(D%XWIND10M_MAX(:),D%XWIND10M(:))
!
!* Richardson number
- DGF%XRI = PRI
+ D%XRI = PRI
!
ENDIF
!
ELSE
!
- IF (DGF%N2M>=1) THEN
- DGF%XT2M = XUNDEF
- DGF%XQ2M = XUNDEF
- DGF%XHU2M = XUNDEF
- DGF%XZON10M = XUNDEF
- DGF%XMER10M = XUNDEF
- DGF%XRI = PRI
+ IF (DGO%N2M>=1) THEN
+ D%XT2M = XUNDEF
+ D%XQ2M = XUNDEF
+ D%XHU2M = XUNDEF
+ D%XZON10M = XUNDEF
+ D%XMER10M = XUNDEF
+ D%XRI = PRI
ENDIF
ENDIF
!
-IF (DGF%LSURF_BUDGET.OR.DGF%LSURF_BUDGETC) THEN
+IF (DGO%LSURF_BUDGET.OR.DGO%LSURF_BUDGETC) THEN
!
- DGF%XLE (:) = PLE (:)
- DGF%XLEI (:) = PLEI (:)
- DGF%XEVAP(:) = PSFTQ(:)
- DGF%XSUBL(:) = PSUBL(:)
- DGF%XALBT(:) = PALB (:)
- DGF%XSWE (:) = PSWE (:)
+ D%XLE (:) = PLE (:)
+ D%XLEI (:) = PLEI (:)
+ D%XEVAP(:) = PSFTQ(:)
+ D%XSUBL(:) = PSUBL(:)
+ D%XALBT(:) = PALB (:)
+ D%XSWE (:) = PSWE (:)
!
- CALL DIAG_SURF_BUDGET_FLAKE ( PRHOA, PSFTH, &
- PDIR_SW, PSCA_SW, PLW, &
- PDIR_ALB, PSCA_ALB, PLWUP, &
- PSFZON, PSFMER, DGF%XLE, DGF%XRN, DGF%XH, DGF%XGFLUX, &
- DGF%XSWD, DGF%XSWU, DGF%XSWBD, DGF%XSWBU, DGF%XLWD, DGF%XLWU, &
- DGF%XFMU, DGF%XFMV )
+ CALL DIAG_SURF_BUDGET_FLAKE (D, PRHOA, PSFTH, PDIR_SW, PSCA_SW, PLW, &
+ PDIR_ALB, PSCA_ALB, PLWUP, PSFZON, PSFMER )
!
END IF
!
-IF(DGF%LSURF_BUDGETC)THEN
- CALL DIAG_SURF_BUDGETC_FLAKE(DGF, &
- PTSTEP, DGF%XRN, DGF%XH, DGF%XLE, DGF%XLEI, DGF%XGFLUX, &
- DGF%XSWD, DGF%XSWU, DGF%XLWD, DGF%XLWU, DGF%XFMU, DGF%XFMV,&
- DGF%XEVAP, DGF%XSUBL )
+IF(DGO%LSURF_BUDGETC)THEN
+ CALL DIAG_SURF_BUDGETC(D, DC, PTSTEP, .TRUE.)
ENDIF
!
-IF (DGF%LCOEF) THEN
+IF (DGO%LCOEF) THEN
!
!* Transfer coefficients
!
- DGF%XCD = PCD
- DGF%XCH = PCH
- DGF%XCE = PCH
+ D%XCD = PCD
+ D%XCH = PCH
+ D%XCE = PCH
!
!* Roughness lengths
!
- DGF%XZ0 = F%XZ0
- DGF%XZ0H = PZ0H
+ D%XZ0 = F%XZ0
+ D%XZ0H = PZ0H
!
END IF
!
-IF (DGF%LSURF_VARS) THEN
+IF (DGO%LSURF_VARS) THEN
!
!* Humidity at saturation
!
- DGF%XQS = PQSAT
+ D%XQS = PQSAT
!
END IF
!
@@ -213,8 +199,7 @@ END IF
!
IF (LCPL_LAKE) THEN
!
- CALL DIAG_CPL_ESM_FLAKE(F, &
- PTSTEP,PRAIN,PSNOW,PSFTQ)
+ CALL DIAG_CPL_ESM_FLAKE(F,PTSTEP,PRAIN,PSNOW,PSFTQ)
!
ENDIF
!
diff --git a/src/SURFEX/diag_inline_idealn.F90 b/src/SURFEX/diag_inline_idealn.F90
index c3bbfd827f5193a8b3869193f478c48e2784e0fa..d98dc6708adb97792b50059278939bea2562f332 100644
--- a/src/SURFEX/diag_inline_idealn.F90
+++ b/src/SURFEX/diag_inline_idealn.F90
@@ -3,12 +3,12 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_INLINE_IDEAL_n (DGL, PTSTEP, PTA, PTS, PQA, PPA, PPS, PRHOA, PZONA, &
- PMERA, PHT, PHW, PRAIN, PSNOW, &
- PCD, PCDN, PCH, PRI, PHU, PZ0, &
- PZ0H, PQSAT, PSFTH, PSFTQ, PSFZON, PSFMER, &
- PDIR_SW, PSCA_SW, PLW, PDIR_ALB, PSCA_ALB, &
- PLE, PLEI, PSUBL, PLWUP)
+ SUBROUTINE DIAG_INLINE_IDEAL_n (DGO, D, DC, PTSTEP, PTA, PTS, &
+ PQA, PPA, PPS, PRHOA, PZONA, PMERA, PHT, PHW, &
+ PRAIN, PSNOW, PCD, PCDN, PCH, PRI, PHU, PZ0, &
+ PZ0H, PQSAT, PSFTH, PSFTQ, PSFZON, PSFMER, &
+ PDIR_SW, PSCA_SW, PLW, PDIR_ALB, PSCA_ALB, &
+ PLE, PLEI, PSUBL, PLWUP)
! ###############################################################################
!
!!**** *DIAG_INLINE_IDEAL_n * - computes diagnostics during IDEAL time-step
@@ -33,16 +33,15 @@
!!------------------------------------------------------------------
!
!
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
!
USE MODD_CSTS, ONLY : XTT, XLVTT
USE MODD_SURF_PAR, ONLY : XUNDEF
!
-USE MODI_PARAM_CLS
USE MODI_CLS_TQ
USE MODI_CLS_WIND
USE MODI_DIAG_SURF_BUDGET_IDEAL
-USE MODI_DIAG_SURF_BUDGETC_IDEAL
+USE MODI_DIAG_SURF_BUDGETC
USE MODI_ABOR1_SFX
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -52,7 +51,9 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
+TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
!
REAL , INTENT(IN) :: PTSTEP ! atmospheric time-step (s)
REAL, DIMENSION(:), INTENT(IN) :: PTA ! atmospheric temperature
@@ -99,84 +100,77 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('DIAG_INLINE_IDEAL_N',0,ZHOOK_HANDLE)
!
-DGL%XDIAG_TS(:) = PTS(:)
+D%XTS(:) = PTS(:)
!
- IF (DGL%N2M==1) THEN
- CALL PARAM_CLS(PTA, PTS, PQA, PPA, PRHOA, PZONA, PMERA, PHT, PHW, &
- PSFTH, PSFTQ, PSFZON, PSFMER, &
- DGL%XT2M, DGL%XQ2M, DGL%XHU2M, DGL%XZON10M, DGL%XMER10M )
- ELSE IF (DGL%N2M==2) THEN
+ IF (DGO%N2M==2) THEN
ZH(:)=2.
CALL CLS_TQ(PTA, PQA, PPA, PPS, PHT, &
- PCD, PCH, PRI, &
- PTS, PHU, PZ0H, ZH, &
- DGL%XT2M, DGL%XQ2M, DGL%XHU2M )
+ PCD, PCH, PRI, &
+ PTS, PHU, PZ0H, ZH, &
+ D%XT2M, D%XQ2M, D%XHU2M )
ZH(:)=10.
CALL CLS_WIND(PZONA, PMERA, PHW, &
PCD, PCDN, PRI, ZH, &
- DGL%XZON10M, DGL%XMER10M )
+ D%XZON10M, D%XMER10M )
END IF
!
- IF (DGL%N2M>=1) THEN
+ IF (DGO%N2M>=1) THEN
!
- DGL%XT2M_MIN(:) = MIN(DGL%XT2M_MIN(:),DGL%XT2M(:))
- DGL%XT2M_MAX(:) = MAX(DGL%XT2M_MAX(:),DGL%XT2M(:))
+ D%XT2M_MIN(:) = MIN(D%XT2M_MIN(:),D%XT2M(:))
+ D%XT2M_MAX(:) = MAX(D%XT2M_MAX(:),D%XT2M(:))
!
- DGL%XHU2M_MIN(:) = MIN(DGL%XHU2M_MIN(:),DGL%XHU2M(:))
- DGL%XHU2M_MAX(:) = MAX(DGL%XHU2M_MAX(:),DGL%XHU2M(:))
+ D%XHU2M_MIN(:) = MIN(D%XHU2M_MIN(:),D%XHU2M(:))
+ D%XHU2M_MAX(:) = MAX(D%XHU2M_MAX(:),D%XHU2M(:))
!
- DGL%XWIND10M(:) = SQRT(DGL%XZON10M(:)**2+DGL%XMER10M(:)**2)
- DGL%XWIND10M_MAX(:) = MAX(DGL%XWIND10M_MAX(:),DGL%XWIND10M(:))
+ D%XWIND10M(:) = SQRT(D%XZON10M(:)**2+D%XMER10M(:)**2)
+ D%XWIND10M_MAX(:) = MAX(D%XWIND10M_MAX(:),D%XWIND10M(:))
!
!* Richardson number
- DGL%XRI = PRI
+ D%XRI = PRI
!
ENDIF
!
-IF (DGL%LSURF_BUDGET) THEN
+IF (DGO%LSURF_BUDGET) THEN
!
- DGL%XLE (:) = PLE (:)
- DGL%XLEI (:) = PLEI (:)
- DGL%XEVAP(:) = PSFTQ(:)
- DGL%XSUBL(:) = PSUBL(:)
+ D%XLE (:) = PLE (:)
+ D%XLEI (:) = PLEI (:)
+ D%XEVAP(:) = PSFTQ(:)
+ D%XSUBL(:) = PSUBL(:)
!
CALL DIAG_SURF_BUDGET_IDEAL ( PRHOA, PSFTH, &
- PDIR_SW, PSCA_SW, PLW, &
- PDIR_ALB, PSCA_ALB, PLWUP, &
- PSFZON, PSFMER, DGL%XLE, DGL%XRN, &
- DGL%XH, DGL%XGFLUX, DGL%XSWD, &
- DGL%XSWU, DGL%XSWBD, DGL%XSWBU, &
- DGL%XLWD, DGL%XLWU, DGL%XFMU, DGL%XFMV )
+ PDIR_SW, PSCA_SW, PLW, &
+ PDIR_ALB, PSCA_ALB, PLWUP, &
+ PSFZON, PSFMER, D%XLE, D%XRN, &
+ D%XH, D%XGFLUX, D%XSWD, &
+ D%XSWU, D%XSWBD, D%XSWBU, &
+ D%XLWD, D%XLWU, D%XFMU, D%XFMV )
!
END IF
!
-IF( DGL%LSURF_BUDGETC)THEN
- CALL DIAG_SURF_BUDGETC_IDEAL(DGL, PTSTEP, DGL%XRN, DGL%XH, DGL%XLE, &
- DGL%XLEI, DGL%XGFLUX, DGL%XSWD, DGL%XSWU, &
- DGL%XLWD, DGL%XLWU, DGL%XFMU, DGL%XFMV, &
- DGL%XEVAP, DGL%XSUBL )
+IF( DGO%LSURF_BUDGETC)THEN
+ CALL DIAG_SURF_BUDGETC(D, DC, PTSTEP, .TRUE. )
ENDIF
!
-IF (DGL%LCOEF) THEN
+IF (DGO%LCOEF) THEN
!
!* Transfer coefficients
!
- DGL%XCD = PCD
- DGL%XCH = PCH
- DGL%XCE = PCH
+ D%XCD = PCD
+ D%XCH = PCH
+ D%XCE = PCH
!
!* Roughness lengths
!
- DGL%XZ0 = PZ0
- DGL%XZ0H = PZ0H
+ D%XZ0 = PZ0
+ D%XZ0H = PZ0H
!
END IF
!
-IF (DGL%LSURF_VARS) THEN
+IF (DGO%LSURF_VARS) THEN
!
!* Humidity at saturation
!
- DGL%XQS = PQSAT
+ D%XQS = PQSAT
!
END IF
!
diff --git a/src/SURFEX/diag_inline_isban.F90 b/src/SURFEX/diag_inline_isban.F90
index 4d7857cfe86ec312a7156ec5001d831506f3c97d..c18b405a63da8bc530601ea5721a8ce75a46e630 100644
--- a/src/SURFEX/diag_inline_isban.F90
+++ b/src/SURFEX/diag_inline_isban.F90
@@ -3,11 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_INLINE_ISBA_n (DGEI, DGI, I, PKDI, &
- PTA, PTS, PQA, PPA, PPS, PRHOA, PZONA, PMERA, &
- PHT, PHW, PCD, PCDN, PCH, PRI, PHU, PZ0, PZ0H, &
- PZ0EFF, PSFTH, PSFTQ, PSFZON, PSFMER, PQS, &
- PDIR_ALB, PSCA_ALB, PDIR_SW, PSCA_SW, PLW, PRN )
+ SUBROUTINE DIAG_INLINE_ISBA_n (DGO, KK, DK, OCANOPY, PTA, PQA, PPA, PPS, PRHOA, PZONA, PMERA, &
+ PHT, PHW, PSFTH, PSFTQ, PSFZON, PSFMER, PDIR_SW, PSCA_SW, PLW )
! ###############################################################################
!
!!**** *DIAG_INLINE_ISBA_n * - computes diagnostics during ISBA time-step
@@ -34,22 +31,17 @@
!! more argument (height of diagnostic)
!!------------------------------------------------------------------
!
-
!
!
!
-USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
-USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_PACK_DIAG_ISBA, ONLY : PACK_DIAG_ISBA_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
-USE MODI_PARAM_CLS
USE MODI_CLS_TQ
USE MODI_CLS_WIND
USE MODI_DIAG_SURF_BUDGET_ISBA
-!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -59,13 +51,13 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DGEI
-TYPE(DIAG_ISBA_t), INTENT(INOUT) :: DGI
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(PACK_DIAG_ISBA_t), INTENT(INOUT) :: PKDI
+TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DGO
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(DIAG_t), INTENT(INOUT) :: DK
+!
+LOGICAL, INTENT(IN) :: OCANOPY
!
REAL, DIMENSION(:), INTENT(IN) :: PTA ! atmospheric temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS ! surface temperature
REAL, DIMENSION(:), INTENT(IN) :: PQA ! atmospheric specific humidity
REAL, DIMENSION(:), INTENT(IN) :: PPA ! atmospheric level pressure
REAL, DIMENSION(:), INTENT(IN) :: PPS ! surface pressure
@@ -74,21 +66,9 @@ REAL, DIMENSION(:), INTENT(IN) :: PZONA ! zonal wind
REAL, DIMENSION(:), INTENT(IN) :: PMERA ! meridian wind
REAL, DIMENSION(:), INTENT(IN) :: PHT ! atmospheric level height
REAL, DIMENSION(:), INTENT(IN) :: PHW ! atmospheric level height for wind
-REAL, DIMENSION(:), INTENT(IN) :: PCD ! drag coefficient for momentum
-REAL, DIMENSION(:), INTENT(IN) :: PCDN ! neutral drag coefficient
-REAL, DIMENSION(:), INTENT(IN) :: PCH ! drag coefficient for heat
-REAL, DIMENSION(:), INTENT(IN) :: PRI ! Richardson number
-REAL, DIMENSION(:), INTENT(IN) :: PHU ! near-surface humidity
-REAL, DIMENSION(:), INTENT(IN) :: PZ0 ! roughness length for momentum
-REAL, DIMENSION(:), INTENT(IN) :: PZ0H ! roughness length for heat
-REAL, DIMENSION(:), INTENT(IN) :: PZ0EFF ! effective roughness length (z0+z0rel)
-REAL, DIMENSION(:), INTENT(IN) :: PQS ! humidity at surface
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIR_ALB ! direct albedo for each spectral band
-REAL, DIMENSION(:,:), INTENT(IN) :: PSCA_ALB ! diffuse albedo for each spectral band (-)
REAL, DIMENSION(:,:), INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.)
REAL, DIMENSION(:,:), INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.)
REAL, DIMENSION(:), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.)
-REAL, DIMENSION(:), INTENT(IN) :: PRN ! Surface net radiation
!
REAL, DIMENSION(:), INTENT(IN) :: PSFZON ! zonal friction
REAL, DIMENSION(:), INTENT(IN) :: PSFMER ! meridian friction
@@ -103,79 +83,66 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('DIAG_INLINE_ISBA_N',0,ZHOOK_HANDLE)
!
-! * Richardson number
-!
-IF (DGI%N2M>=1) THEN
- PKDI%XP_RI = PRI
-ENDIF
-!
! * Near surface atmospheric variables
!
-IF (.NOT. I%LCANOPY) THEN
-!
- IF (DGI%N2M==1) THEN
- CALL PARAM_CLS(PTA, PTS, PQA, PPA, PRHOA, PZONA, PMERA, PHT, PHW, &
- PSFTH, PSFTQ, PSFZON, PSFMER, &
- PKDI%XP_T2M, PKDI%XP_Q2M, PKDI%XP_HU2M, PKDI%XP_ZON10M, PKDI%XP_MER10M )
- ELSE IF (DGI%N2M==2) THEN
+IF (.NOT. OCANOPY) THEN
+ !
+ IF (DGO%N2M==2) THEN
ZH(:)=2.
- CALL CLS_TQ(PTA, PQA, PPA, PPS, PHT, &
- PCD, PCH, PRI, &
- PTS, PHU, PZ0H, ZH, &
- PKDI%XP_T2M, PKDI%XP_Q2M, PKDI%XP_HU2M )
+ CALL CLS_TQ(PTA, PQA, PPA, PPS, PHT, DK%XCD, DK%XCH, DK%XRI, &
+ DK%XTS, DK%XHU, DK%XZ0H, ZH, DK%XT2M, DK%XQ2M, DK%XHU2M )
ZH(:)=10.
- CALL CLS_WIND(PZONA, PMERA, PHW, &
- PCD, PCDN, PRI, ZH, &
- PKDI%XP_ZON10M, PKDI%XP_MER10M )
+ CALL CLS_WIND(PZONA, PMERA, PHW, DK%XCD, DK%XCDN, DK%XRI, ZH, &
+ DK%XZON10M, DK%XMER10M )
END IF
-!
+ !
+ IF (DGO%N2M>=1) DK%XWIND10M(:) = SQRT(DK%XZON10M(:)**2 + DK%XMER10M(:)**2)
+ !
ELSE
!
- IF (DGI%N2M>=1) THEN
- PKDI%XP_T2M = XUNDEF
- PKDI%XP_Q2M = XUNDEF
- PKDI%XP_HU2M = XUNDEF
- PKDI%XP_ZON10M = XUNDEF
- PKDI%XP_MER10M = XUNDEF
+ IF (DGO%N2M>=1) THEN
+ DK%XT2M = XUNDEF
+ DK%XQ2M = XUNDEF
+ DK%XHU2M = XUNDEF
+ DK%XZON10M = XUNDEF
+ DK%XMER10M = XUNDEF
+ DK%XWIND10M= XUNDEF
ENDIF
!
ENDIF
!
! * Surface energy budget
!
-IF (DGI%LSURF_BUDGET.OR.DGEI%LSURF_BUDGETC) THEN
+IF (DGO%LSURF_BUDGET.OR.DGO%LSURF_BUDGETC) THEN
!
- CALL DIAG_SURF_BUDGET_ISBA(PDIR_SW, PSCA_SW, PDIR_ALB, PSCA_ALB, &
- PLW, PRN, &
- PKDI%XP_SWD, PKDI%XP_SWU, PKDI%XP_SWBD, PKDI%XP_SWBU, &
- PKDI%XP_LWD, PKDI%XP_LWU )
+ CALL DIAG_SURF_BUDGET_ISBA(PDIR_SW, PSCA_SW, PLW, KK, DK)
!
- PKDI%XP_FMU = PSFZON
- PKDI%XP_FMV = PSFMER
+ DK%XFMU = PSFZON
+ DK%XFMV = PSFMER
!
END IF
!
-IF (DGI%LCOEF) THEN
+IF (DGO%LCOEF) THEN
!
!* Transfer coefficient
!
- PKDI%XP_CD = PCD
- PKDI%XP_CH = PCH
- PKDI%XP_CE = PCH
+ DK%XCD = DK%XCD
+ DK%XCH = DK%XCH
+ DK%XCE = DK%XCH
!
!* Roughness lengths
!
- PKDI%XP_Z0_WITH_SNOW = PZ0
- PKDI%XP_Z0H_WITH_SNOW = PZ0H
- PKDI%XP_Z0EFF = PZ0EFF
+ DK%XZ0 = DK%XZ0
+ DK%XZ0H = DK%XZ0H
+ DK%XZ0EFF = DK%XZ0EFF
!
ENDIF
!
-IF (DGI%LSURF_VARS) THEN
+IF (DGO%LSURF_VARS) THEN
!
!* Humidity at surface
!
- PKDI%XP_QS = PQS
+ DK%XQS = DK%XQS
!
ENDIF
IF (LHOOK) CALL DR_HOOK('DIAG_INLINE_ISBA_N',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/diag_inline_oceann.F90 b/src/SURFEX/diag_inline_oceann.F90
index 04f6e48b73de15202c97e0495b46df329c8ae4c0..650a72664353ce4492b6acccdb398babe57e8938 100644
--- a/src/SURFEX/diag_inline_oceann.F90
+++ b/src/SURFEX/diag_inline_oceann.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_INLINE_OCEAN_n (DGO, O, S)
+ SUBROUTINE DIAG_INLINE_OCEAN_n (DGO, O, PSEABATHY)
! ###############################################################################
!
!!**** *DIAG_INLINE_SEAFLUX_n * - computes diagnostics during SEAFLUX time-step
@@ -31,7 +31,6 @@
!
USE MODD_DIAG_OCEAN_n, ONLY : DIAG_OCEAN_t
USE MODD_OCEAN_n, ONLY : OCEAN_t
-USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
!
USE MODD_OCEAN_CSTS
!
@@ -53,7 +52,7 @@ IMPLICIT NONE
!
TYPE(DIAG_OCEAN_t), INTENT(INOUT) :: DGO
TYPE(OCEAN_t), INTENT(INOUT) :: O
-TYPE(SEAFLUX_t), INTENT(INOUT) :: S
+REAL, DIMENSION(:), INTENT(IN) :: PSEABATHY
!
REAL, DIMENSION(SIZE(O%XSEAT(:,1)),NOCKMIN:NOCKMAX) :: ZSEADENS
REAL, DIMENSION(SIZE(O%XSEAT(:,1))) :: ZRHO0,ZRHOCMO,ZDRHOX,ZTCMO
@@ -94,7 +93,7 @@ IF (DGO%LDIAG_OCEAN) THEN
EXIT
ENDIF
ENDDO
- O%XSEAHMO(JPT)=MIN(O%XSEAHMO(JPT),-S%XSEABATHY(JPT))
+ O%XSEAHMO(JPT)=MIN(O%XSEAHMO(JPT),-PSEABATHY(JPT))
!
IHMOLEVEL(JPT)=NOCKMAX
!
@@ -139,7 +138,7 @@ ENDIF
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('DIAG_INLINE_OCEAN_N',1,ZHOOK_HANDLE)
- CONTAINS
+CONTAINS
!
!
!! #########################################
diff --git a/src/SURFEX/diag_inline_seafluxn.F90 b/src/SURFEX/diag_inline_seafluxn.F90
index e532d22e143d2c8b200e20af89916ed8af18834e..9d263279ef315a9585bade545e52800bc57a34d2 100644
--- a/src/SURFEX/diag_inline_seafluxn.F90
+++ b/src/SURFEX/diag_inline_seafluxn.F90
@@ -3,16 +3,15 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE DIAG_INLINE_SEAFLUX_n (DGS, DGSI, S, &
- PTSTEP, PTA, PQA, &
- PPA, PPS, PRHOA, PZONA, &
- PMERA, PHT, PHW, PCD, PCDN, PCH, PCE, PRI, PHU, &
- PZ0H, PQSAT, PSFTH, PSFTQ, PSFZON, PSFMER, &
- PDIR_SW, PSCA_SW, PLW, PDIR_ALB, PSCA_ALB, &
- PEMIS, PTRAD, PRAIN, PSNOW, &
- PCD_ICE, PCDN_ICE, PCH_ICE, PCE_ICE, PRI_ICE, &
- PZ0_ICE, PZ0H_ICE, PQSAT_ICE, PSFTH_ICE, PSFTQ_ICE, &
- PSFZON_ICE, PSFMER_ICE )
+SUBROUTINE DIAG_INLINE_SEAFLUX_n (DGO, D, DC, DI, DIC, DGMSI, S, &
+ PTSTEP, PTA, PQA, PPA, PPS, PRHOA, PZONA, &
+ PMERA, PHT, PHW, PCD, PCDN, PCH, PCE, PRI, PHU, &
+ PZ0H, PQSAT, PSFTH, PSFTQ, PSFZON, PSFMER, &
+ PDIR_SW, PSCA_SW, PLW, PDIR_ALB, PSCA_ALB, &
+ PEMIS, PTRAD, PRAIN, PSNOW, &
+ PCD_ICE, PCDN_ICE, PCH_ICE, PCE_ICE, PRI_ICE, &
+ PZ0_ICE, PZ0H_ICE, PQSAT_ICE, PSFTH_ICE, PSFTQ_ICE, &
+ PSFZON_ICE, PSFMER_ICE )
! #####################################################################################
!
@@ -43,12 +42,8 @@ SUBROUTINE DIAG_INLINE_SEAFLUX_n (DGS, DGSI, S, &
!! S. Senesi 01/2014 ! introduce fractional seaice and sea-ice model
!!------------------------------------------------------------------
!
-
-!
-!
-!
-USE MODD_DIAG_SEAFLUX_n, ONLY : DIAG_SEAFLUX_t
-USE MODD_DIAG_SEAICE_n, ONLY : DIAG_SEAICE_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
+USE MODD_DIAG_MISC_SEAICE_n, ONLY : DIAG_MISC_SEAICE_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
!
USE MODD_CSTS, ONLY : XTTS
@@ -58,11 +53,10 @@ USE MODD_SFX_OASIS, ONLY : LCPL_SEA
USE MODD_TYPES_GLT, ONLY : T_GLT
USE MODD_GLT_PARAM , ONLY : GELATO_DIM=>NX
USE MODE_GLT_STATS , ONLY : GLT_AVHICEM, GLT_AVHSNWM
-USE MODI_PARAM_CLS
USE MODI_CLS_TQ
USE MODI_CLS_WIND
USE MODI_DIAG_SURF_BUDGET_SEA
-USE MODI_DIAG_SURF_BUDGETC_SEA
+USE MODI_DIAG_SURF_BUDGETC
USE MODI_DIAG_CPL_ESM_SEA
!
USE MODI_SEAFLUX_ALBEDO
@@ -75,8 +69,12 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(DIAG_SEAFLUX_t), INTENT(INOUT) :: DGS
-TYPE(DIAG_SEAICE_t), INTENT(INOUT) :: DGSI
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
+TYPE(DIAG_t), INTENT(INOUT) :: DI
+TYPE(DIAG_t), INTENT(INOUT) :: DIC
+TYPE(DIAG_MISC_SEAICE_t), INTENT(INOUT) :: DGMSI
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
!
REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s)
@@ -141,174 +139,152 @@ IF (LHOOK) CALL DR_HOOK('DIAG_INLINE_SEAFLUX_N',0,ZHOOK_HANDLE)
! * Mean surface temperature need to couple with AGCM
!
IF (S%LHANDLE_SIC) THEN
- DGS%XTS (:) = (1 - S%XSIC(:)) * S%XSST(:) + S%XSIC(:) * S%XTICE(:)
- DGS%XTSRAD(:) = PTRAD(:)
+ D%XTS (:) = (1 - S%XSIC(:)) * S%XSST(:) + S%XSIC(:) * S%XTICE(:)
+ D%XTSRAD(:) = PTRAD(:)
ELSE
- DGS%XTS (:) = S%XSST (:)
- DGS%XTSRAD(:) = PTRAD(:)
+ D%XTS (:) = S%XSST (:)
+ D%XTSRAD(:) = PTRAD(:)
ENDIF
!
IF (.NOT. S%LSBL) THEN
!
- IF (DGS%N2M==1) THEN
- CALL PARAM_CLS(PTA, S%XSST, PQA, PPA, PRHOA, PZONA, PMERA, PHT, PHW, &
- PSFTH, PSFTQ, PSFZON, PSFMER, &
- DGS%XT2M, DGS%XQ2M, DGS%XHU2M, DGS%XZON10M, DGS%XMER10M )
- IF (S%LHANDLE_SIC) THEN
- CALL PARAM_CLS(PTA, S%XTICE, PQA, PPA, PRHOA, PZONA, PMERA, PHT, PHW, &
- PSFTH_ICE, PSFTQ_ICE, PSFZON_ICE, PSFMER_ICE, &
- DGS%XT2M_ICE, DGS%XQ2M_ICE, DGS%XHU2M_ICE, DGS%XZON10M_ICE, DGS%XMER10M_ICE )
- ENDIF
- ELSE IF (DGS%N2M==2) THEN
+ IF (DGO%N2M==2) THEN
ZH(:)=2.
- CALL CLS_TQ(PTA, PQA, PPA, PPS, PHT, &
- PCD, PCH, PRI, &
- S%XSST, PHU, PZ0H, ZH, &
- DGS%XT2M, DGS%XQ2M, DGS%XHU2M)
+ CALL CLS_TQ(PTA, PQA, PPA, PPS, PHT, PCD, PCH, PRI, &
+ S%XSST, PHU, PZ0H, ZH,D%XT2M, D%XQ2M, D%XHU2M)
ZH(:)=10.
- CALL CLS_WIND(PZONA, PMERA, PHW, &
- PCD, PCDN, PRI, ZH, &
- DGS%XZON10M, DGS%XMER10M)
+ CALL CLS_WIND(PZONA, PMERA, PHW,PCD, PCDN, PRI, ZH, &
+ D%XZON10M, D%XMER10M)
IF (S%LHANDLE_SIC) THEN
ZH(:)=2.
- CALL CLS_TQ(PTA, PQA, PPA, PPS, PHT, &
- PCD_ICE, PCH_ICE, PRI_ICE, &
- S%XTICE, PHU, PZ0H_ICE, ZH, &
- DGS%XT2M_ICE, DGS%XQ2M_ICE, DGS%XHU2M_ICE)
+ CALL CLS_TQ(PTA, PQA, PPA, PPS, PHT, PCD_ICE, PCH_ICE, PRI_ICE, &
+ S%XTICE, PHU, PZ0H_ICE, ZH, DI%XT2M, DI%XQ2M, DI%XHU2M)
ZH(:)=10.
- CALL CLS_WIND(PZONA, PMERA, PHW, &
- PCD_ICE, PCDN_ICE, PRI_ICE, ZH, &
- DGS%XZON10M_ICE, DGS%XMER10M_ICE )
+ CALL CLS_WIND(PZONA, PMERA, PHW, PCD_ICE, PCDN_ICE, PRI_ICE, ZH, &
+ DI%XZON10M, DI%XMER10M )
ENDIF
END IF
!
- IF (DGS%N2M>=1) THEN
+ IF (DGO%N2M>=1) THEN
IF (S%LHANDLE_SIC) THEN
!
- DGS%XT2M = DGS%XT2M * (1 - S%XSIC) + DGS%XT2M_ICE * S%XSIC
- DGS%XQ2M = DGS%XQ2M * (1 - S%XSIC) + DGS%XQ2M_ICE * S%XSIC
- DGS%XHU2M = DGS%XHU2M * (1 - S%XSIC) + DGS%XHU2M_ICE * S%XSIC
+ D%XT2M = D%XT2M * (1 - S%XSIC) + DI%XT2M * S%XSIC
+ D%XQ2M = D%XQ2M * (1 - S%XSIC) + DI%XQ2M * S%XSIC
+ D%XHU2M = D%XHU2M * (1 - S%XSIC) + DI%XHU2M * S%XSIC
!
- DGS%XZON10M(:) = DGS%XZON10M(:) * (1 - S%XSIC(:)) + DGS%XZON10M_ICE(:) * S%XSIC(:)
- DGS%XMER10M(:) = DGS%XMER10M(:) * (1 - S%XSIC(:)) + DGS%XMER10M_ICE(:) * S%XSIC(:)
- DGS%XWIND10M_ICE(:) = SQRT(DGS%XZON10M_ICE(:)**2+DGS%XMER10M_ICE(:)**2)
+ D%XZON10M(:) = D%XZON10M(:) * (1 - S%XSIC(:)) + DI%XZON10M(:) * S%XSIC(:)
+ D%XMER10M(:) = D%XMER10M(:) * (1 - S%XSIC(:)) + DI%XMER10M(:) * S%XSIC(:)
+ DI%XWIND10M(:) = SQRT(DI%XZON10M(:)**2+DI%XMER10M(:)**2)
!
- DGS%XRI = PRI * (1 - S%XSIC) + PRI_ICE * S%XSIC
- DGS%XRI_ICE=PRI_ICE
+ D%XRI = PRI * (1 - S%XSIC) + PRI_ICE * S%XSIC
+ DI%XRI =PRI_ICE
ELSE
- DGS%XRI =PRI
+ D%XRI =PRI
ENDIF
!
- DGS%XT2M_MIN(:) = MIN(DGS%XT2M_MIN(:),DGS%XT2M(:))
- DGS%XT2M_MAX(:) = MAX(DGS%XT2M_MAX(:),DGS%XT2M(:))
+ D%XT2M_MIN(:) = MIN(D%XT2M_MIN(:),D%XT2M(:))
+ D%XT2M_MAX(:) = MAX(D%XT2M_MAX(:),D%XT2M(:))
!
- DGS%XHU2M_MIN(:) = MIN(DGS%XHU2M_MIN(:),DGS%XHU2M(:))
- DGS%XHU2M_MAX(:) = MAX(DGS%XHU2M_MAX(:),DGS%XHU2M(:))
+ D%XHU2M_MIN(:) = MIN(D%XHU2M_MIN(:),D%XHU2M(:))
+ D%XHU2M_MAX(:) = MAX(D%XHU2M_MAX(:),D%XHU2M(:))
!
- DGS%XWIND10M(:) = SQRT(DGS%XZON10M(:)**2+DGS%XMER10M(:)**2)
- DGS%XWIND10M_MAX(:) = MAX(DGS%XWIND10M_MAX(:),DGS%XWIND10M(:))
+ D%XWIND10M(:) = SQRT(D%XZON10M(:)**2+D%XMER10M(:)**2)
+ D%XWIND10M_MAX(:) = MAX(D%XWIND10M_MAX(:),D%XWIND10M(:))
!
ENDIF
!
ELSE
- IF (DGS%N2M>=1) THEN
- DGS%XT2M = XUNDEF
- DGS%XQ2M = XUNDEF
- DGS%XHU2M = XUNDEF
- DGS%XZON10M = XUNDEF
- DGS%XMER10M = XUNDEF
- DGS%XRI = PRI
+ IF (DGO%N2M>=1) THEN
+ D%XT2M = XUNDEF
+ D%XQ2M = XUNDEF
+ D%XHU2M = XUNDEF
+ D%XZON10M = XUNDEF
+ D%XMER10M = XUNDEF
+ D%XRI = PRI
ENDIF
ENDIF
!
-IF (DGS%LSURF_BUDGET.OR.DGS%LSURF_BUDGETC) THEN
+IF (DGO%LSURF_BUDGET.OR.DGO%LSURF_BUDGETC) THEN
!
- CALL SEAFLUX_ALBEDO(PDIR_SW,PSCA_SW,PDIR_ALB,PSCA_ALB,DGS%XALBT)
+ CALL SEAFLUX_ALBEDO(PDIR_SW,PSCA_SW,PDIR_ALB,PSCA_ALB,D%XALBT)
!
- CALL DIAG_SURF_BUDGET_SEA (XTTS, S%XSST, PRHOA, PSFTH, PSFTH_ICE, &
- PSFTQ, PSFTQ_ICE, &
- PDIR_SW, PSCA_SW, PLW, PDIR_ALB, &
- PSCA_ALB,S%XICE_ALB, PEMIS, PTRAD, &
- PSFZON, PSFZON_ICE, PSFMER, &
- PSFMER_ICE, S%LHANDLE_SIC, S%XSIC, S%XTICE, &
- DGS%XRN, DGS%XH, DGS%XLE, DGS%XLE_ICE, DGS%XGFLUX, &
- DGS%XSWD, DGS%XSWU, DGS%XSWBD, DGS%XSWBU, DGS%XLWD, DGS%XLWU, &
- DGS%XFMU, DGS%XFMV, DGS%XEVAP, DGS%XSUBL, &
- DGS%XRN_ICE, DGS%XH_ICE, DGS%XGFLUX_ICE, &
- DGS%XSWU_ICE, DGS%XSWBU_ICE, DGS%XLWU_ICE, &
- DGS%XFMU_ICE, DGS%XFMV_ICE )
+ CALL DIAG_SURF_BUDGET_SEA (D, DI, S, XTTS, PRHOA, PSFTH, PSFTH_ICE, &
+ PSFTQ, PSFTQ_ICE, PDIR_SW, PSCA_SW, PLW, &
+ PDIR_ALB, PSCA_ALB, PEMIS, PTRAD, &
+ PSFZON, PSFZON_ICE, PSFMER, PSFMER_ICE )
+ IF (S%LHANDLE_SIC) DI%XLE = D%XLEI
!
END IF
!
-IF(DGS%LSURF_BUDGETC)THEN
- CALL DIAG_SURF_BUDGETC_SEA(DGS, &
- PTSTEP, DGS%XRN, DGS%XH, DGS%XLE, DGS%XLE_ICE, DGS%XGFLUX, &
- DGS%XSWD, DGS%XSWU, DGS%XLWD, DGS%XLWU, DGS%XFMU, DGS%XFMV, &
- DGS%XEVAP, DGS%XSUBL, S%LHANDLE_SIC, &
- DGS%XRN_ICE, DGS%XH_ICE, DGS%XGFLUX_ICE, &
- DGS%XSWU_ICE, DGS%XLWU_ICE, DGS%XFMU_ICE, DGS%XFMV_ICE)
+IF(DGO%LSURF_BUDGETC)THEN
+ !
+ CALL DIAG_SURF_BUDGETC(D, DC, PTSTEP, .TRUE.)
+ !
+ IF (S%LHANDLE_SIC) THEN
+ CALL DIAG_SURF_BUDGETC(DI, DIC, PTSTEP, .FALSE.)
+ DIC%XLE = DC%XLEI
+ ENDIF
+ !
ENDIF
!
-IF (DGS%LCOEF) THEN
+IF (DGO%LCOEF) THEN
IF (S%LHANDLE_SIC) THEN
!
!* Transfer coefficients
!
- DGS%XCD = (1 - S%XSIC) * PCD + S%XSIC * PCD_ICE
- DGS%XCH = (1 - S%XSIC) * PCH + S%XSIC * PCH_ICE
- DGS%XCE = (1 - S%XSIC) * PCE + S%XSIC * PCE_ICE
+ D%XCD = (1 - S%XSIC) * PCD + S%XSIC * PCD_ICE
+ D%XCH = (1 - S%XSIC) * PCH + S%XSIC * PCH_ICE
+ D%XCE = (1 - S%XSIC) * PCE + S%XSIC * PCE_ICE
!
!* Roughness lengths
!
- ZZ0W = ( 1 - S%XSIC ) * 1.0/(LOG(PHW/S%XZ0) **2) + &
- S%XSIC * 1.0/(LOG(PHW/PZ0_ICE)**2)
- DGS%XZ0 = PHW * EXP ( - SQRT ( 1./ ZZ0W ))
- ZZ0W = ( 1 - S%XSIC ) * 1.0/(LOG(PHW/PZ0H) **2) + &
- S%XSIC * 1.0/(LOG(PHW/PZ0H_ICE)**2)
- DGS%XZ0H = PHW * EXP ( - SQRT ( 1./ ZZ0W ))
+ ZZ0W = ( 1 - S%XSIC ) * 1.0/(LOG(PHW/S%XZ0) **2) + S%XSIC * 1.0/(LOG(PHW/PZ0_ICE)**2)
+ D%XZ0 = PHW * EXP ( - SQRT ( 1./ ZZ0W ))
+ ZZ0W = ( 1 - S%XSIC ) * 1.0/(LOG(PHW/PZ0H) **2) + S%XSIC * 1.0/(LOG(PHW/PZ0H_ICE)**2)
+ D%XZ0H = PHW * EXP ( - SQRT ( 1./ ZZ0W ))
- DGS%XCD_ICE = PCD_ICE
- DGS%XCH_ICE = PCH_ICE
- DGS%XZ0_ICE = PZ0_ICE
- DGS%XZ0H_ICE = PZ0H_ICE
+ DI%XCD = PCD_ICE
+ DI%XCH = PCH_ICE
+ DI%XZ0 = PZ0_ICE
+ DI%XZ0H = PZ0H_ICE
!
ELSE
!
!* Transfer coefficients
!
- DGS%XCD = PCD
- DGS%XCH = PCH
- DGS%XCE = PCE
+ D%XCD = PCD
+ D%XCH = PCH
+ D%XCE = PCE
!
!* Roughness lengths
!
- DGS%XZ0 = S%XZ0
- DGS%XZ0H = PZ0H
+ D%XZ0 = S%XZ0
+ D%XZ0H = PZ0H
ENDIF
!
ENDIF
!
-IF (DGS%LSURF_VARS) THEN
+IF (DGO%LSURF_VARS) THEN
!
!* Humidity at saturation
!
IF (S%LHANDLE_SIC) THEN
- DGS%XQS = (1 - S%XSIC) * PQSAT + S%XSIC * PQSAT_ICE
- DGS%XQS_ICE = PQSAT_ICE
+ D%XQS = (1 - S%XSIC) * PQSAT + S%XSIC * PQSAT_ICE
+ DI%XQS = PQSAT_ICE
ELSE
- DGS%XQS = PQSAT
+ D%XQS = PQSAT
ENDIF
ENDIF
!
! Diags from embedded Seaice model
! CALL DIAG_INLINE_SEAICE() : simply :
!
-IF (DGSI%LDIAG_SEAICE) THEN
+IF (DGMSI%LDIAG_MISC_SEAICE) THEN
IF (TRIM(S%CSEAICE_SCHEME) == 'GELATO') THEN
GELATO_DIM=SIZE(PTA)
- DGSI%XSIT = RESHAPE(glt_avhicem(S%TGLT%dom,S%TGLT%sit),(/GELATO_DIM/))
- DGSI%XSND = RESHAPE(glt_avhsnwm(S%TGLT%dom,S%TGLT%sit),(/GELATO_DIM/))
- DGSI%XMLT = S%TGLT%oce_all(:,1)%tml
+ DGMSI%XSIT = RESHAPE(glt_avhicem(S%TGLT%dom,S%TGLT%sit),(/GELATO_DIM/))
+ DGMSI%XSND = RESHAPE(glt_avhsnwm(S%TGLT%dom,S%TGLT%sit),(/GELATO_DIM/))
+ DGMSI%XMLT = S%TGLT%oce_all(:,1)%tml
ELSE
! Placeholder for an alternate seaice scheme
ENDIF
@@ -321,12 +297,8 @@ GSIC=(S%LHANDLE_SIC.AND.(S%CSEAICE_SCHEME /= 'NONE '))
!
IF (LCPL_SEA.OR.GSIC) THEN
!
- CALL DIAG_CPL_ESM_SEA(S, &
- PTSTEP,DGS%XZON10M,DGS%XMER10M,DGS%XFMU,DGS%XFMV, &
- DGS%XSWD,DGS%XSWU,DGS%XGFLUX,PSFTQ,PRAIN, &
- PSNOW,PLW,S%XTICE,PSFTH_ICE, &
- PSFTQ_ICE,PDIR_SW,PSCA_SW, &
- DGS%XSWU_ICE,DGS%XLWU_ICE,GSIC )
+ CALL DIAG_CPL_ESM_SEA(S, D, DI, PTSTEP, PSFTQ, PRAIN, PSNOW, &
+ PLW, PSFTH_ICE, PSFTQ_ICE, PDIR_SW, PSCA_SW, GSIC )
!
ENDIF
IF (LHOOK) CALL DR_HOOK('DIAG_INLINE_SEAFLUX_N',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/diag_inline_surf_atmn.F90 b/src/SURFEX/diag_inline_surf_atmn.F90
index c19557efc343d630e6e5997e322e69531b6c2f31..8dbc29e7159d9850678c1eaac6e8c168814486c1 100644
--- a/src/SURFEX/diag_inline_surf_atmn.F90
+++ b/src/SURFEX/diag_inline_surf_atmn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_INLINE_SURF_ATM_n (DGU, &
- PHW, PHT, PPS, PRHOA, PTRAD, PEMIS, PSFU, PSFV, PSFCO2)
+ SUBROUTINE DIAG_INLINE_SURF_ATM_n (DGO, D, PHW, PHT, PPS, PRHOA, PTRAD, PEMIS, PSFU, PSFV, PSFCO2)
! ###############################################################################!
!!**** *DIAG_INLINE_SURF_ATM_n * - Computes diagnostics during SURF_ATM time-step
!!
@@ -32,7 +31,7 @@
!
!
!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -42,7 +41,8 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
!
REAL, DIMENSION(:), INTENT(IN) :: PHW ! atmospheric level height for wind
REAL, DIMENSION(:), INTENT(IN) :: PHT ! atmospheric level height
@@ -60,20 +60,20 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('DIAG_INLINE_SURF_ATM_N',0,ZHOOK_HANDLE)
-IF (DGU%LCOEF) THEN
- DGU%XDIAG_UREF = PHW
- DGU%XDIAG_ZREF = PHT
+IF (DGO%LCOEF) THEN
+ D%XUREF = PHW
+ D%XZREF = PHT
END IF
!
-DGU%XRHOA = PRHOA
-DGU%XPS = PPS
-DGU%XDIAG_TRAD = PTRAD
-DGU%XDIAG_EMIS = PEMIS
+D%XRHOA = PRHOA
+D%XPS = PPS
+D%XTRAD = PTRAD
+D%XEMIS = PEMIS
!
-DGU%XSSO_FMU = PSFU
-DGU%XSSO_FMV = PSFV
+D%XSSO_FMU = PSFU
+D%XSSO_FMV = PSFV
!
-DGU%XAVG_SFCO2 = PSFCO2
+D%XSFCO2 = PSFCO2
!
IF (LHOOK) CALL DR_HOOK('DIAG_INLINE_SURF_ATM_N',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/diag_inline_tebn.F90 b/src/SURFEX/diag_inline_tebn.F90
index ea38244df21ed2ad8dd1bb79fb0dbe0c9318191c..ac6ebaf5d2a57b7d9ec0e4ca19e826b348898721 100644
--- a/src/SURFEX/diag_inline_tebn.F90
+++ b/src/SURFEX/diag_inline_tebn.F90
@@ -3,14 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_INLINE_TEB_n (DGT, TCP, T, &
- OCANOPY, PTA, PTS, PQA, PPA, PPS, PRHOA, &
- PZONA, PMERA, PWIND, PHT, PHW, &
- PCD, PCDN, PRI, PCH, PZ0, &
- PTRAD, PEMIS, PDIR_ALB, PSCA_ALB, &
- PLW, PDIR_SW, PSCA_SW, &
- PSFTH, PSFTQ, PSFZON, PSFMER, PSFCO2, &
- PRN, PH, PLE, PGFLUX )
+ SUBROUTINE DIAG_INLINE_TEB_n (DGO, D, SB, T, &
+ OCANOPY, PTA, PTS, PQA, PPA, PPS, PRHOA, &
+ PZONA, PMERA, PWIND, PHT, PHW, &
+ PCD, PCDN, PRI, PCH, PZ0, &
+ PTRAD, PEMIS, PDIR_ALB, PSCA_ALB, &
+ PLW, PDIR_SW, PSCA_SW, &
+ PSFTH, PSFTQ, PSFZON, PSFMER, PSFCO2, &
+ PRN, PH, PLE, PGFLUX )
! ###############################################################################!
!!**** *DIAG_INLINE_TEB_n * - Computes diagnostics during TEB time-step
!!
@@ -40,14 +40,13 @@
!
!
!
-USE MODD_DIAG_TEB_n, ONLY : DIAG_TEB_t
-USE MODD_TEB_CANOPY_n, ONLY : TEB_CANOPY_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
+USE MODD_CANOPY_n, ONLY : CANOPY_t
USE MODD_TEB_n, ONLY : TEB_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE MODI_CLS_WIND
-USE MODI_PARAM_CLS
USE MODI_DIAG_SURF_BUDGET_TEB
USE MODI_INTERPOL_SBL
!
@@ -62,8 +61,9 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(DIAG_TEB_t), INTENT(INOUT) :: DGT
-TYPE(TEB_CANOPY_t), INTENT(INOUT) :: TCP
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
TYPE(TEB_t), INTENT(INOUT) :: T
!
LOGICAL, INTENT(IN) :: OCANOPY ! Flag for canopy
@@ -126,7 +126,7 @@ IF (LHOOK) CALL DR_HOOK('DIAG_INLINE_TEB_N',0,ZHOOK_HANDLE)
!It should be the arithmetic mean of the surface temperature
!of each independant energy budget, if there is. See ISBA for more detail.
!
-DGT%XDIAG_TS(:) = PTS(:)
+D%XTS(:) = PTS(:)
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
@@ -135,84 +135,61 @@ ZZ0_O_Z0H = 200.
!* 2m and 10m variables interpolated from canopy if used
!
IF (OCANOPY) THEN
- ZT2M_MIN(:) = XUNDEF
- ZT2M_MAX(:) = XUNDEF
- ZHU2M_MIN(:) = XUNDEF
- ZHU2M_MAX(:) = XUNDEF
+ ZT2M_MIN (:) = XUNDEF
+ ZT2M_MAX (:) = XUNDEF
+ ZHU2M_MIN (:) = XUNDEF
+ ZHU2M_MAX (:) = XUNDEF
ZWIND10M_MAX(:) = XUNDEF
- IF (DGT%N2M>0) CALL INIT_2M_10M( TCP%XP(:,2), TCP%XT(:,2), TCP%XQ(:,2), TCP%XU, TCP%XZ, &
- PZONA, PMERA, PWIND, PRHOA, &
- DGT%XT2M, DGT%XQ2M, DGT%XHU2M, DGT%XZON10M, DGT%XMER10M,&
- ZU10, ZWIND10M_MAX, ZT2M_MIN, &
- ZT2M_MAX, ZHU2M_MIN, ZHU2M_MAX )
+ IF (DGO%N2M>0) CALL INIT_2M_10M( SB, D, PZONA, PMERA, PWIND, PRHOA )
ELSE
!* 2m and 10m variables using CLS laws
- IF (DGT%N2M==1) THEN
- CALL PARAM_CLS(PTA, PTS, PQA, PPA, PRHOA, PZONA, PMERA, PHT, PHW, &
- PSFTH, PSFTQ, PSFZON, PSFMER, &
- DGT%XT2M, DGT%XQ2M, DGT%XHU2M, DGT%XZON10M, DGT%XMER10M )
+ IF (DGO%N2M==2) THEN
+ ZH(:)=10.
+ CALL CLS_WIND(PZONA, PMERA, PHW, PCD, PCDN, PRI, ZH, D%XZON10M, D%XMER10M )
+ D%XT2M = T%XT_CANYON
+ D%XQ2M = T%XQ_CANYON
+ D%XRI = PRI
+ D%XHU2M = MIN(T%XQ_CANYON /QSAT(T%XT_CANYON,PPA),1.)
+ END IF
!
- !* erases temperature and humidity 2m above roof level bu canyon air values
- !
- DGT%XT2M = T%CUR%XT_CANYON
- DGT%XQ2M = T%CUR%XQ_CANYON
- !
- !* Richardson number
- !
- DGT%XRI = PRI
- DGT%XHU2M = MIN(T%CUR%XQ_CANYON /QSAT(T%CUR%XT_CANYON,PPA),1.)
- ELSE IF (DGT%N2M==2) THEN
- ZH(:)=10.
- CALL CLS_WIND(PZONA, PMERA, PHW, &
- PCD, PCDN, PRI, ZH, &
- DGT%XZON10M, DGT%XMER10M )
- DGT%XT2M = T%CUR%XT_CANYON
- DGT%XQ2M = T%CUR%XQ_CANYON
- DGT%XRI = PRI
- DGT%XHU2M = MIN(T%CUR%XQ_CANYON /QSAT(T%CUR%XT_CANYON,PPA),1.)
- END IF
-END IF
-!
-IF (DGT%N2M>=1) THEN
- !
- DGT%XT2M_MIN(:) = MIN(DGT%XT2M_MIN(:),DGT%XT2M(:))
- DGT%XT2M_MAX(:) = MAX(DGT%XT2M_MAX(:),DGT%XT2M(:))
- !
- DGT%XHU2M_MIN(:) = MIN(DGT%XHU2M_MIN(:),DGT%XHU2M(:))
- DGT%XHU2M_MAX(:) = MAX(DGT%XHU2M_MAX(:),DGT%XHU2M(:))
- !
- DGT%XWIND10M (:) = SQRT(DGT%XZON10M**2+DGT%XMER10M**2)
- DGT%XWIND10M_MAX(:) = MAX(DGT%XWIND10M_MAX(:),DGT%XWIND10M(:))
- !
-END IF
-
-!
-IF (DGT%LSURF_BUDGET) THEN
+ IF (DGO%N2M>=1) THEN
+ !
+ D%XT2M_MIN(:) = MIN(D%XT2M_MIN(:),D%XT2M(:))
+ D%XT2M_MAX(:) = MAX(D%XT2M_MAX(:),D%XT2M(:))
+ !
+ D%XHU2M_MIN(:) = MIN(D%XHU2M_MIN(:),D%XHU2M(:))
+ D%XHU2M_MAX(:) = MAX(D%XHU2M_MAX(:),D%XHU2M(:))
+ !
+ D%XWIND10M (:) = SQRT(D%XZON10M**2+D%XMER10M**2)
+ D%XWIND10M_MAX(:) = MAX(D%XWIND10M_MAX(:),D%XWIND10M(:))
+ !
+ END IF
+ENDIF
+!
+IF (DGO%LSURF_BUDGET) THEN
!
- CALL DIAG_SURF_BUDGET_TEB(PDIR_SW, PSCA_SW, PDIR_ALB, PSCA_ALB, &
- PLW, PEMIS, PTRAD, &
- DGT%XSWD, DGT%XSWU, DGT%XSWBD, DGT%XSWBU, DGT%XLWD, DGT%XLWU )
+ CALL DIAG_SURF_BUDGET_TEB(D, PDIR_SW, PSCA_SW, PDIR_ALB, PSCA_ALB, PLW, PEMIS, PTRAD )
!
- DGT%XRN = PRN
- DGT%XH = PH
- DGT%XLE = PLE
- DGT%XGFLUX = PGFLUX
- DGT%XFMU = PSFZON
- DGT%XFMV = PSFMER
- DGT%XSFCO2 = PSFCO2
+ D%XRN = PRN
+ D%XH = PH
+ D%XLE = PLE
+ D%XGFLUX = PGFLUX
+ D%XFMU = PSFZON
+ D%XFMV = PSFMER
+ D%XSFCO2 = PSFCO2
!
END IF
!
-IF (DGT%LCOEF) THEN
- DGT%XCD = PCD
- DGT%XCH = PCH
- DGT%XCE = PCH
- DGT%XZ0 = PZ0
- DGT%XZ0H = PZ0 / ZZ0_O_Z0H
+IF (DGO%LCOEF) THEN
+ D%XCD = PCD
+ D%XCH = PCH
+ D%XCE = PCH
+ D%XZ0 = PZ0
+ D%XZ0H = PZ0 / ZZ0_O_Z0H
END IF
!
-IF (DGT%LSURF_VARS) THEN
- DGT%XQS = T%CUR%XQ_CANYON
+IF (DGO%LSURF_VARS) THEN
+ D%XQS = T%XQ_CANYON
END IF
IF (LHOOK) CALL DR_HOOK('DIAG_INLINE_TEB_N',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/diag_inline_watfluxn.F90 b/src/SURFEX/diag_inline_watfluxn.F90
index 961c99fa5e9bde0b85929a6fd4aefe9c3670d60a..9c88cb4c85884e9977cfc7e515cfdf0ba81abb41 100644
--- a/src/SURFEX/diag_inline_watfluxn.F90
+++ b/src/SURFEX/diag_inline_watfluxn.F90
@@ -3,13 +3,13 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_INLINE_WATFLUX_n (DGW, W, &
- PTSTEP, PTA, PQA, PPA, PPS, PRHOA, PZONA, &
- PMERA, PHT, PHW, PCD, PCDN, PCH, PRI, PHU, &
- PZ0H, PQSAT, PSFTH, PSFTQ, PSFZON, PSFMER, &
- PDIR_SW, PSCA_SW, PLW, PDIR_ALB, PSCA_ALB, &
- PEMIS, PTRAD, PRAIN, PSNOW, PSFTH_ICE, &
- PSFTQ_ICE )
+ SUBROUTINE DIAG_INLINE_WATFLUX_n (DGO, D, DC, W, &
+ PTSTEP, PTA, PQA, PPA, PPS, PRHOA, PZONA, &
+ PMERA, PHT, PHW, PCD, PCDN, PCH, PRI, PHU, &
+ PZ0H, PQSAT, PSFTH, PSFTQ, PSFZON, PSFMER, &
+ PDIR_SW, PSCA_SW, PLW, PDIR_ALB, PSCA_ALB, &
+ PEMIS, PTRAD, PRAIN, PSNOW, PSFTH_ICE, &
+ PSFTQ_ICE )
! ###############################################################################
!
!!**** *DIAG_INLINE_WATFLUX_n * - computes diagnostics during WATFLUX time-step
@@ -41,18 +41,17 @@
!
!
!
-USE MODD_DIAG_WATFLUX_n, ONLY : DIAG_WATFLUX_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
USE MODD_WATFLUX_n, ONLY : WATFLUX_t
!
USE MODD_CSTS, ONLY : XTT
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_SFX_OASIS, ONLY : LCPL_SEA, LCPL_SEAICE
!
-USE MODI_PARAM_CLS
USE MODI_CLS_TQ
USE MODI_CLS_WIND
USE MODI_DIAG_SURF_BUDGET_WATER
-USE MODI_DIAG_SURF_BUDGETC_WATER
+USE MODI_DIAG_SURF_BUDGETC
USE MODI_DIAG_CPL_ESM_WATER
!
!
@@ -64,7 +63,9 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(DIAG_WATFLUX_t), INTENT(INOUT) :: DGW
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
TYPE(WATFLUX_t), INTENT(INOUT) :: W
!
REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s)
@@ -113,92 +114,74 @@ IF (LHOOK) CALL DR_HOOK('DIAG_INLINE_WATFLUX_N',0,ZHOOK_HANDLE)
!
! * Mean surface temperature need to couple with AGCM
!
-DGW%XDIAG_TS(:) = W%XTS(:)
+D%XTS(:) = W%XTS(:)
!
IF (.NOT. W%LSBL) THEN
!
- IF (DGW%N2M==1) THEN
- CALL PARAM_CLS(PTA, W%XTS, PQA, PPA, PRHOA, PZONA, PMERA, PHT, PHW, &
- PSFTH, PSFTQ, PSFZON, PSFMER, &
- DGW%XT2M, DGW%XQ2M, DGW%XHU2M, DGW%XZON10M, DGW%XMER10M )
- ELSE IF (DGW%N2M==2) THEN
+ IF (DGO%N2M==2) THEN
ZH(:)=2.
- CALL CLS_TQ(PTA, PQA, PPA, PPS, PHT, &
- PCD, PCH, PRI, &
- W%XTS, PHU, PZ0H, ZH, &
- DGW%XT2M, DGW%XQ2M, DGW%XHU2M )
+ CALL CLS_TQ(PTA, PQA, PPA, PPS, PHT, PCD, PCH, PRI, &
+ W%XTS, PHU, PZ0H, ZH, D%XT2M, D%XQ2M, D%XHU2M )
ZH(:)=10.
- CALL CLS_WIND(PZONA, PMERA, PHW, &
- PCD, PCDN, PRI, ZH, &
- DGW%XZON10M, DGW%XMER10M )
+ CALL CLS_WIND(PZONA, PMERA, PHW, PCD, PCDN, PRI, ZH, D%XZON10M, D%XMER10M )
END IF
!
- IF (DGW%N2M>=1) THEN
+ IF (DGO%N2M>=1) THEN
!
- DGW%XT2M_MIN(:) = MIN(DGW%XT2M_MIN(:),DGW%XT2M(:))
- DGW%XT2M_MAX(:) = MAX(DGW%XT2M_MAX(:),DGW%XT2M(:))
+ D%XT2M_MIN(:) = MIN(D%XT2M_MIN(:),D%XT2M(:))
+ D%XT2M_MAX(:) = MAX(D%XT2M_MAX(:),D%XT2M(:))
!
- DGW%XHU2M_MIN(:) = MIN(DGW%XHU2M_MIN(:),DGW%XHU2M(:))
- DGW%XHU2M_MAX(:) = MAX(DGW%XHU2M_MAX(:),DGW%XHU2M(:))
+ D%XHU2M_MIN(:) = MIN(D%XHU2M_MIN(:),D%XHU2M(:))
+ D%XHU2M_MAX(:) = MAX(D%XHU2M_MAX(:),D%XHU2M(:))
!
- DGW%XWIND10M (:) = SQRT(DGW%XZON10M(:)**2+DGW%XMER10M(:)**2)
- DGW%XWIND10M_MAX(:) = MAX(DGW%XWIND10M_MAX(:),DGW%XWIND10M(:))
+ D%XWIND10M (:) = SQRT(D%XZON10M(:)**2+D%XMER10M(:)**2)
+ D%XWIND10M_MAX(:) = MAX(D%XWIND10M_MAX(:),D%XWIND10M(:))
!
!* Richardson number
- DGW%XRI = PRI
+ D%XRI = PRI
!
ENDIF
!
ELSE
- IF (DGW%N2M>=1) THEN
- DGW%XT2M = XUNDEF
- DGW%XQ2M = XUNDEF
- DGW%XHU2M = XUNDEF
- DGW%XZON10M = XUNDEF
- DGW%XMER10M = XUNDEF
- DGW%XRI = PRI
+ IF (DGO%N2M>=1) THEN
+ D%XT2M = XUNDEF
+ D%XQ2M = XUNDEF
+ D%XHU2M = XUNDEF
+ D%XZON10M = XUNDEF
+ D%XMER10M = XUNDEF
+ D%XRI = PRI
ENDIF
ENDIF
!
-IF (DGW%LSURF_BUDGET.OR.DGW%LSURF_BUDGETC) THEN
+IF (DGO%LSURF_BUDGET.OR.DGO%LSURF_BUDGETC) THEN
!
- CALL DIAG_SURF_BUDGET_WATER (XTT, W%XTS, PRHOA, PSFTH, PSFTQ, &
- PDIR_SW, PSCA_SW, PLW, &
- PDIR_ALB, PSCA_ALB, PEMIS, PTRAD, &
- PSFZON, PSFMER, &
- DGW%XRN, DGW%XH, DGW%XLE, DGW%XLEI, DGW%XGFLUX, &
- DGW%XSWD, DGW%XSWU, DGW%XSWBD, DGW%XSWBU, DGW%XLWD, DGW%XLWU, &
- DGW%XFMU, DGW%XFMV, DGW%XEVAP, DGW%XSUBL )
+ CALL DIAG_SURF_BUDGET_WATER (D, XTT, W%XTS, PRHOA, PSFTH, PSFTQ, PDIR_SW, PSCA_SW, PLW, &
+ PDIR_ALB, PSCA_ALB, PEMIS, PTRAD, PSFZON, PSFMER )
!
END IF
!
-IF(DGW%LSURF_BUDGETC)THEN
- CALL DIAG_SURF_BUDGETC_WATER(DGW, &
- PTSTEP, DGW%XRN, DGW%XH, DGW%XLE, DGW%XLEI, DGW%XGFLUX, &
- DGW%XSWD, DGW%XSWU, DGW%XLWD, DGW%XLWU, DGW%XFMU, DGW%XFMV,&
- DGW%XEVAP, DGW%XSUBL )
-ENDIF
+IF(DGO%LSURF_BUDGETC) CALL DIAG_SURF_BUDGETC(D, DC, PTSTEP, .TRUE.)
!
-IF (DGW%LCOEF) THEN
+IF (DGO%LCOEF) THEN
!
!* Transfer coefficients
!
- DGW%XCD = PCD
- DGW%XCH = PCH
- DGW%XCE = PCH
+ D%XCD = PCD
+ D%XCH = PCH
+ D%XCE = PCH
!
!* Roughness lengths
!
- DGW%XZ0 = W%XZ0
- DGW%XZ0H = PZ0H
+ D%XZ0 = W%XZ0
+ D%XZ0H = PZ0H
!
ENDIF
!
-IF (DGW%LSURF_VARS) THEN
+IF (DGO%LSURF_VARS) THEN
!
!* Humidity at saturation
!
- DGW%XQS = PQSAT
+ D%XQS = PQSAT
!
ENDIF
!
@@ -206,10 +189,8 @@ ENDIF
!
IF (LCPL_SEA) THEN
!
- CALL DIAG_CPL_ESM_WATER(W, &
- LCPL_SEAICE,PTSTEP,DGW%XZON10M,DGW%XMER10M,DGW%XFMU,DGW%XFMV, &
- DGW%XSWD,DGW%XSWU,DGW%XGFLUX,PSFTQ,PRAIN,PSNOW,PLW,W%XTICE, &
- PSFTH_ICE,PSFTQ_ICE,PDIR_SW,PSCA_SW )
+ CALL DIAG_CPL_ESM_WATER(W, D, LCPL_SEAICE, PTSTEP, PSFTQ, PRAIN, PSNOW, PLW, &
+ PSFTH_ICE, PSFTQ_ICE, PDIR_SW, PSCA_SW )
!
ENDIF
IF (LHOOK) CALL DR_HOOK('DIAG_INLINE_WATFLUX_N',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/diag_isba_initn.F90 b/src/SURFEX/diag_isba_initn.F90
index 8116c2667571e8f050fabcc87ef7c753cbbd62b0..c4716f23d7738a8f7d8adeaf35c8010f24e2e0a9 100644
--- a/src/SURFEX/diag_isba_initn.F90
+++ b/src/SURFEX/diag_isba_initn.F90
@@ -3,9 +3,9 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_ISBA_INIT_n (&
- CHI, DGEI, DGI, DGMI, DGU, GB, I, &
- HPROGRAM,KLU,KSW)
+ SUBROUTINE DIAG_ISBA_INIT_n (CHI, DE, DEC, NDE, NDEC, DGO, D, DC, ND, NDC, DM, NDM, &
+ OREAD_BUDGETC, NGB, GB, IO, NP, HSNOW_SCHEME, KSNOW_NLAYER, &
+ KABC, HPROGRAM,KLU,KSW)
! #####################
!
!!**** *DIAG_ISBA_INIT_n* - routine to initialize ISBA-AGS diagnostic variables
@@ -54,24 +54,22 @@
!! B. Vincendon 02/2014 : condition added for RAD_BUDGET variables (needed for
!! restart mode)
! B. decharme 04/2013 : Add new diag for coupling
-! Delete XAVG_TSRAD (because same than XTSRAD_NAT)
+! Delete XTSRAD (because same than XTSRAD_NAT)
!! P. Samuelsson 10/2014: MEB
!-------------------------------------------------------------------------------
!
!* 0.0 DECLARATIONS
! ------------
!
-!
+USE MODE_DIAG
!
USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
-USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
-USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
-USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-!
-!
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t, DIAG_EVAP_ISBA_NP_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_NP_t, DIAG_OPTIONS_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t, DIAG_MISC_ISBA_NP_t
+USE MODD_GR_BIOG_n, ONLY : GR_BIOG_NP_t, GR_BIOG_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_NP_t, ISBA_P_t
!
#ifdef SFX_OL
USE MODN_IO_OFFLINE, ONLY : LRESTART
@@ -80,12 +78,10 @@ USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_TYPE_DATE_SURF
USE MODD_AGRI, ONLY : LAGRIP
!
-!
-!
-!
+USE MODI_PACK_SAME_RANK
+USE MODI_MAKE_CHOICE_ARRAY
USE MODI_READ_SURF
!
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -94,16 +90,27 @@ IMPLICIT NONE
!* 0.01 Declarations of arguments
! -------------------------
!
-!
-!
-!
TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
-TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DGEI
-TYPE(DIAG_ISBA_t), INTENT(INOUT) :: DGI
-TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DGMI
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DE
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEC
+TYPE(DIAG_EVAP_ISBA_NP_t), INTENT(INOUT) :: NDE
+TYPE(DIAG_EVAP_ISBA_NP_t), INTENT(INOUT) :: NDEC
+TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
+TYPE(DIAG_NP_t), INTENT(INOUT) :: ND
+TYPE(DIAG_NP_t), INTENT(INOUT) :: NDC
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DM
+TYPE(DIAG_MISC_ISBA_NP_t), INTENT(INOUT) :: NDM
+LOGICAL, INTENT(IN) :: OREAD_BUDGETC
+TYPE(GR_BIOG_NP_t), INTENT(INOUT) :: NGB
TYPE(GR_BIOG_t), INTENT(INOUT) :: GB
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+ CHARACTER(LEN=*), INTENT(IN) :: HSNOW_SCHEME
+INTEGER, INTENT(IN) :: KSNOW_NLAYER
+!
+INTEGER, INTENT(IN) :: KABC
!
INTEGER, INTENT(IN) :: KLU ! size of arrays
INTEGER, INTENT(IN) :: KSW ! spectral bands
@@ -112,2318 +119,1511 @@ INTEGER, INTENT(IN) :: KSW ! spectral bands
!* 0.02 Declarations of local variables
! -------------------------------
!
+TYPE(DIAG_OPTIONS_t) :: YDO
+TYPE(DIAG_EVAP_ISBA_t) :: YDE
+TYPE(DIAG_MISC_ISBA_t) :: YDM
+TYPE(ISBA_P_t), POINTER :: PK
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK
+LOGICAL :: GCUMUL, GDIM
+INTEGER :: JP
INTEGER :: IVERSION, IBUG
INTEGER :: IRESP ! IRESP : return-code if a problem appears
INTEGER :: ISIZE_LMEB_PATCH ! Number of patches where multi-energy balance should be applied
CHARACTER(LEN=LEN_HREC) :: YREC ! Name of the article to be read
- CHARACTER(LEN=4) :: YREC2
+ CHARACTER(LEN=6) :: YREC2
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
+!////////////////NOT CUMULATED DIAGNOSTICS//////////////////////////////
+!
!* surface energy budget
!
IF (LHOOK) CALL DR_HOOK('DIAG_ISBA_INIT_N',0,ZHOOK_HANDLE)
!
-ISIZE_LMEB_PATCH=COUNT(I%LMEB_PATCH(:))
-!
-IF (DGI%LSURF_BUDGET) THEN
- ALLOCATE(DGI%XAVG_RN (KLU))
- ALLOCATE(DGI%XAVG_H (KLU))
- ALLOCATE(DGI%XAVG_LE (KLU))
- ALLOCATE(DGI%XAVG_LEI (KLU))
- ALLOCATE(DGI%XAVG_GFLUX (KLU))
- ALLOCATE(DGI%XAVG_SWD (KLU))
- ALLOCATE(DGI%XAVG_SWU (KLU))
- ALLOCATE(DGI%XAVG_SWBD (KLU,KSW))
- ALLOCATE(DGI%XAVG_SWBU (KLU,KSW))
- ALLOCATE(DGI%XAVG_LWD (KLU))
- ALLOCATE(DGI%XAVG_LWU (KLU))
- ALLOCATE(DGI%XAVG_FMU (KLU))
- ALLOCATE(DGI%XAVG_FMV (KLU))
- !
- DGI%XAVG_RN = XUNDEF
- DGI%XAVG_H = XUNDEF
- DGI%XAVG_LE = XUNDEF
- DGI%XAVG_LEI = XUNDEF
- DGI%XAVG_GFLUX = XUNDEF
- DGI%XAVG_SWD = XUNDEF
- DGI%XAVG_SWU = XUNDEF
- DGI%XAVG_SWBD = XUNDEF
- DGI%XAVG_SWBU = XUNDEF
- DGI%XAVG_LWD = XUNDEF
- DGI%XAVG_LWU = XUNDEF
- DGI%XAVG_FMU = XUNDEF
- DGI%XAVG_FMV = XUNDEF
- !
- ALLOCATE(DGI%XRN (KLU,I%NPATCH))
- ALLOCATE(DGI%XH (KLU,I%NPATCH))
- ALLOCATE(DGI%XGFLUX (KLU,I%NPATCH))
- ALLOCATE(DGI%XLEI (KLU,I%NPATCH))
- ALLOCATE(DGI%XSWD (KLU,I%NPATCH))
- ALLOCATE(DGI%XSWU (KLU,I%NPATCH))
- ALLOCATE(DGI%XSWBD (KLU,KSW,I%NPATCH))
- ALLOCATE(DGI%XSWBU (KLU,KSW,I%NPATCH))
- ALLOCATE(DGI%XLWD (KLU,I%NPATCH))
- ALLOCATE(DGI%XLWU (KLU,I%NPATCH))
- ALLOCATE(DGI%XFMU (KLU,I%NPATCH))
- ALLOCATE(DGI%XFMV (KLU,I%NPATCH))
- !
- DGI%XRN = XUNDEF
- DGI%XH = XUNDEF
- DGI%XGFLUX = XUNDEF
- DGI%XLEI = XUNDEF
- DGI%XSWD = XUNDEF
- DGI%XSWU = XUNDEF
- DGI%XSWBD = XUNDEF
- DGI%XSWBU = XUNDEF
- DGI%XLWD = XUNDEF
- DGI%XLWU = XUNDEF
- DGI%XFMU = XUNDEF
- DGI%XFMV = XUNDEF
+ISIZE_LMEB_PATCH=COUNT(IO%LMEB_PATCH(:))
+!
+YDO%LSURF_BUDGET = .TRUE.
+YDO%N2M = 1
+YDO%LCOEF = .TRUE.
+YDO%LSURF_VARS = .TRUE.
+!
+YDE%LSURF_EVAP_BUDGET = .TRUE.
+!
+YDM%LSURF_MISC_BUDGET = .TRUE.
+!
+ CALL ALLOC_BUD(YDO,D,KLU,KSW)
+!
+DO JP = 1,IO%NPATCH
+ CALL ALLOC_BUD(YDO,ND%AL(JP),NP%AL(JP)%NSIZE_P,KSW)
+ !
+ ALLOCATE(ND%AL(JP)%XCDN(NP%AL(JP)%NSIZE_P))
+ ALLOCATE(ND%AL(JP)%XHUG(NP%AL(JP)%NSIZE_P))
+ ALLOCATE(ND%AL(JP)%XHU (NP%AL(JP)%NSIZE_P))
+ !
+ ND%AL(JP)%XCDN = XUNDEF
+ ND%AL(JP)%XHUG = XUNDEF
+ ND%AL(JP)%XHU = XUNDEF
+ !
+ENDDO
+!
+IF (YDO%LSURF_BUDGET) THEN
+ !
+ ALLOCATE(D%XEVAP(KLU))
+ ALLOCATE(D%XSUBL(KLU))
+ D%XEVAP = XUNDEF
+ D%XSUBL = XUNDEF
+ !
+ DO JP = 1,IO%NPATCH
+ ALLOCATE(ND%AL(JP)%XEVAP(NP%AL(JP)%NSIZE_P))
+ ALLOCATE(ND%AL(JP)%XSUBL(NP%AL(JP)%NSIZE_P))
+ ND%AL(JP)%XEVAP = XUNDEF
+ ND%AL(JP)%XSUBL = XUNDEF
+ ENDDO
!
ELSE
- ALLOCATE(DGI%XAVG_RN (0))
- ALLOCATE(DGI%XAVG_H (0))
- ALLOCATE(DGI%XAVG_LE (0))
- ALLOCATE(DGI%XAVG_LEI (0))
- ALLOCATE(DGI%XAVG_GFLUX (0))
- ALLOCATE(DGI%XAVG_SWD (0))
- ALLOCATE(DGI%XAVG_SWU (0))
- ALLOCATE(DGI%XAVG_SWBD (0,0))
- ALLOCATE(DGI%XAVG_SWBU (0,0))
- ALLOCATE(DGI%XAVG_LWD (0))
- ALLOCATE(DGI%XAVG_LWU (0))
- ALLOCATE(DGI%XAVG_FMU (0))
- ALLOCATE(DGI%XAVG_FMV (0))
-!
- ALLOCATE(DGI%XRN (0,0))
- ALLOCATE(DGI%XH (0,0))
- ALLOCATE(DGI%XGFLUX (0,0))
- ALLOCATE(DGI%XLEI (0,0))
- ALLOCATE(DGI%XSWD (0,0))
- ALLOCATE(DGI%XSWU (0,0))
- ALLOCATE(DGI%XSWBD (0,0,0))
- ALLOCATE(DGI%XSWBU (0,0,0))
- ALLOCATE(DGI%XLWD (0,0))
- ALLOCATE(DGI%XLWU (0,0))
- ALLOCATE(DGI%XFMU (0,0))
- ALLOCATE(DGI%XFMV (0,0))
+ !
+ ALLOCATE(D%XEVAP(0))
+ ALLOCATE(D%XSUBL(0))
+ !
+ DO JP = 1,IO%NPATCH
+ ALLOCATE(ND%AL(JP)%XEVAP(0))
+ ALLOCATE(ND%AL(JP)%XSUBL(0))
+ ENDDO
+ !
+END IF
+!
+IF (YDO%N2M>=1) THEN
+ !
+ ALLOCATE(D%XSFCO2(KLU))
+ D%XSFCO2 = XUNDEF
+ DO JP = 1,IO%NPATCH
+ ALLOCATE(ND%AL(JP)%XSFCO2(NP%AL(JP)%NSIZE_P))
+ ND%AL(JP)%XSFCO2 = XUNDEF
+ ENDDO
+ !
+ELSE
+ !
+ ALLOCATE(D%XSFCO2(0))
+ DO JP=1,IO%NPATCH
+ ALLOCATE(ND%AL(JP)%XSFCO2(0))
+ ENDDO
+ !
+END IF
+!
+!* transfer coefficients
+!
+DO JP=1,IO%NPATCH
+ ALLOCATE(ND%AL(JP)%XZ0EFF(NP%AL(JP)%NSIZE_P))
+ ND%AL(JP)%XZ0EFF = XUNDEF
+ENDDO
+!
+IF (YDO%LCOEF) THEN
+ !
+ ALLOCATE(D%XZ0EFF(KLU))
+ D%XZ0EFF = XUNDEF
+ !
+ELSE
+ !
+ ALLOCATE(D%XZ0EFF(0))
+ !
END IF
!
+!
+!* surface temperature and parameters at 2m
+!
+ALLOCATE(D%XALBT(KLU))
+D%XALBT = XUNDEF
+DO JP=1,IO%NPATCH
+ ALLOCATE(ND%AL(JP)%XTS (NP%AL(JP)%NSIZE_P))
+ ALLOCATE(ND%AL(JP)%XALBT (NP%AL(JP)%NSIZE_P))
+ ALLOCATE(ND%AL(JP)%XTSRAD (NP%AL(JP)%NSIZE_P))
+ ND%AL(JP)%XTS = XUNDEF
+ ND%AL(JP)%XTSRAD = XUNDEF
+ ND%AL(JP)%XALBT = XUNDEF
+ENDDO
+!
!* detailed surface energy budget
!
-IF (DGEI%LSURF_EVAP_BUDGET) THEN
- ALLOCATE(DGEI%XAVG_LEG (KLU))
- ALLOCATE(DGEI%XAVG_LEGI (KLU))
- ALLOCATE(DGEI%XAVG_LEV (KLU))
- ALLOCATE(DGEI%XAVG_LES (KLU))
- ALLOCATE(DGEI%XAVG_LESL (KLU))
- ALLOCATE(DGEI%XAVG_LER (KLU))
- ALLOCATE(DGEI%XAVG_LETR (KLU))
- ALLOCATE(DGEI%XAVG_EVAP (KLU))
- ALLOCATE(DGEI%XAVG_SUBL (KLU))
- ALLOCATE(DGEI%XAVG_SNDRIFT (KLU))
- ALLOCATE(DGEI%XAVG_DRAIN (KLU))
- ALLOCATE(DGEI%XAVG_QSB (KLU))
- ALLOCATE(DGEI%XAVG_RUNOFF (KLU))
- ALLOCATE(DGEI%XAVG_HORT (KLU))
- ALLOCATE(DGEI%XAVG_DRIP (KLU))
- ALLOCATE(DGEI%XAVG_RRVEG (KLU))
- ALLOCATE(DGEI%XAVG_MELT (KLU))
- ALLOCATE(DGEI%XAVG_IRRIG_FLUX(KLU))
- ALLOCATE(DGEI%XAVG_GPP (KLU))
- ALLOCATE(DGEI%XAVG_RESP_AUTO (KLU))
- ALLOCATE(DGEI%XAVG_RESP_ECO (KLU))
- !
- DGEI%XAVG_LEG = XUNDEF
- DGEI%XAVG_LEGI = XUNDEF
- DGEI%XAVG_LEV = XUNDEF
- DGEI%XAVG_LES = XUNDEF
- DGEI%XAVG_LESL = XUNDEF
- DGEI%XAVG_LER = XUNDEF
- DGEI%XAVG_LETR = XUNDEF
- DGEI%XAVG_EVAP = XUNDEF
- DGEI%XAVG_SUBL = XUNDEF
- DGEI%XAVG_SNDRIFT = XUNDEF
- DGEI%XAVG_DRAIN = XUNDEF
- DGEI%XAVG_QSB = XUNDEF
- DGEI%XAVG_RUNOFF = XUNDEF
- DGEI%XAVG_HORT = XUNDEF
- DGEI%XAVG_DRIP = XUNDEF
- DGEI%XAVG_RRVEG = XUNDEF
- DGEI%XAVG_MELT = XUNDEF
- DGEI%XAVG_IRRIG_FLUX = XUNDEF
- DGEI%XAVG_GPP = XUNDEF
- DGEI%XAVG_RESP_AUTO = XUNDEF
- DGEI%XAVG_RESP_ECO = XUNDEF
- !
- ALLOCATE(DGEI%XAVG_IFLOOD (KLU))
- ALLOCATE(DGEI%XAVG_PFLOOD (KLU))
- ALLOCATE(DGEI%XAVG_LE_FLOOD (KLU))
- ALLOCATE(DGEI%XAVG_LEI_FLOOD(KLU))
- DGEI%XAVG_IFLOOD = XUNDEF
- DGEI%XAVG_PFLOOD = XUNDEF
- DGEI%XAVG_LE_FLOOD = XUNDEF
- DGEI%XAVG_LEI_FLOOD = XUNDEF
- !
- ALLOCATE(DGEI%XLEG (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLEGI (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLEV (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLES (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLESL (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLER (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLETR (KLU,I%NPATCH))
- ALLOCATE(DGEI%XEVAP (KLU,I%NPATCH))
- ALLOCATE(DGEI%XSUBL (KLU,I%NPATCH))
- ALLOCATE(DGEI%XSNDRIFT (KLU,I%NPATCH))
- ALLOCATE(DGEI%XDRAIN (KLU,I%NPATCH))
- ALLOCATE(DGEI%XQSB (KLU,I%NPATCH))
- ALLOCATE(DGEI%XRUNOFF (KLU,I%NPATCH))
- ALLOCATE(DGEI%XHORT (KLU,I%NPATCH))
- ALLOCATE(DGEI%XDRIP (KLU,I%NPATCH))
- ALLOCATE(DGEI%XRRVEG (KLU,I%NPATCH))
- ALLOCATE(DGEI%XMELT (KLU,I%NPATCH))
- ALLOCATE(DGEI%XIRRIG_FLUX(KLU,I%NPATCH))
- ALLOCATE(DGEI%XGPP (KLU,I%NPATCH))
- ALLOCATE(DGEI%XRESP_AUTO (KLU,I%NPATCH))
- ALLOCATE(DGEI%XRESP_ECO (KLU,I%NPATCH))
- !
- DGEI%XLEG = XUNDEF
- DGEI%XLEGI = XUNDEF
- DGEI%XLEV = XUNDEF
- DGEI%XLES = XUNDEF
- DGEI%XLESL = XUNDEF
- DGEI%XLER = XUNDEF
- DGEI%XLETR = XUNDEF
- DGEI%XEVAP = XUNDEF
- DGEI%XSUBL = XUNDEF
- DGEI%XSNDRIFT = XUNDEF
- DGEI%XDRAIN = XUNDEF
- DGEI%XQSB = XUNDEF
- DGEI%XRUNOFF = XUNDEF
- DGEI%XHORT = XUNDEF
- DGEI%XDRIP = XUNDEF
- DGEI%XRRVEG = XUNDEF
- DGEI%XMELT = XUNDEF
- DGEI%XIRRIG_FLUX = XUNDEF
- DGEI%XGPP = XUNDEF
- DGEI%XRESP_AUTO = XUNDEF
- DGEI%XRESP_ECO = XUNDEF
- !
- ALLOCATE(DGEI%XIFLOOD (KLU,I%NPATCH))
- ALLOCATE(DGEI%XPFLOOD (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLE_FLOOD(KLU,I%NPATCH))
- ALLOCATE(DGEI%XLEI_FLOOD(KLU,I%NPATCH))
- DGEI%XIFLOOD = XUNDEF
- DGEI%XPFLOOD = XUNDEF
- DGEI%XLE_FLOOD = XUNDEF
- DGEI%XLEI_FLOOD = XUNDEF
+IF (YDE%LSURF_EVAP_BUDGET) THEN
+ !
+ CALL ALLOC_EVAP_BUD(DE,KLU,0)
+ DO JP = 1,IO%NPATCH
+ CALL ALLOC_EVAP_BUD(NDE%AL(JP),NP%AL(JP)%NSIZE_P,NP%AL(JP)%NSIZE_P)
+ ENDDO
!
IF (ISIZE_LMEB_PATCH>0) THEN
- ALLOCATE(DGEI%XAVG_LEVCV (KLU))
- ALLOCATE(DGEI%XAVG_LESC (KLU))
- ALLOCATE(DGEI%XAVG_LETRGV (KLU))
- ALLOCATE(DGEI%XAVG_LETRCV (KLU))
- ALLOCATE(DGEI%XAVG_LERGV (KLU))
- ALLOCATE(DGEI%XAVG_LELITTER (KLU))
- ALLOCATE(DGEI%XAVG_LELITTERI(KLU))
- ALLOCATE(DGEI%XAVG_DRIPLIT (KLU))
- ALLOCATE(DGEI%XAVG_RRLIT (KLU))
- ALLOCATE(DGEI%XAVG_LERCV (KLU))
- ALLOCATE(DGEI%XAVG_LE_C_A (KLU))
- ALLOCATE(DGEI%XAVG_LE_V_C (KLU))
- ALLOCATE(DGEI%XAVG_LE_G_C (KLU))
- ALLOCATE(DGEI%XAVG_LE_N_C (KLU))
- !
- ALLOCATE(DGEI%XAVG_SWNET_V (KLU))
- ALLOCATE(DGEI%XAVG_SWNET_G (KLU))
- ALLOCATE(DGEI%XAVG_SWNET_N (KLU))
- ALLOCATE(DGEI%XAVG_SWNET_NS (KLU))
- ALLOCATE(DGEI%XAVG_LWNET_V (KLU))
- ALLOCATE(DGEI%XAVG_LWNET_G (KLU))
- ALLOCATE(DGEI%XAVG_LWNET_N (KLU))
- ALLOCATE(DGEI%XAVG_SWDOWN_GN (KLU))
- ALLOCATE(DGEI%XAVG_LWDOWN_GN (KLU))
- ALLOCATE(DGEI%XAVG_H_V_C (KLU))
- ALLOCATE(DGEI%XAVG_H_G_C (KLU))
- ALLOCATE(DGEI%XAVG_H_C_A (KLU))
- ALLOCATE(DGEI%XAVG_H_N_C (KLU))
- ALLOCATE(DGEI%XAVG_SR_GN (KLU))
- ALLOCATE(DGEI%XAVG_MELTCV (KLU))
- ALLOCATE(DGEI%XAVG_FRZCV (KLU))
-!
- DGEI%XAVG_LEVCV = XUNDEF
- DGEI%XAVG_LESC = XUNDEF
- DGEI%XAVG_LETRGV = XUNDEF
- DGEI%XAVG_LETRCV = XUNDEF
- DGEI%XAVG_LERGV = XUNDEF
- DGEI%XAVG_LELITTER = XUNDEF
- DGEI%XAVG_LELITTERI = XUNDEF
- DGEI%XAVG_DRIPLIT = XUNDEF
- DGEI%XAVG_RRLIT = XUNDEF
- DGEI%XAVG_LERCV = XUNDEF
- DGEI%XAVG_LE_C_A = XUNDEF
- DGEI%XAVG_LE_V_C = XUNDEF
- DGEI%XAVG_LE_G_C = XUNDEF
- DGEI%XAVG_LE_N_C = XUNDEF
- !
- DGEI%XAVG_SWNET_V = XUNDEF
- DGEI%XAVG_SWNET_G = XUNDEF
- DGEI%XAVG_SWNET_N = XUNDEF
- DGEI%XAVG_SWNET_NS = XUNDEF
- DGEI%XAVG_LWNET_V = XUNDEF
- DGEI%XAVG_LWNET_G = XUNDEF
- DGEI%XAVG_LWNET_N = XUNDEF
- DGEI%XAVG_SWDOWN_GN = XUNDEF
- DGEI%XAVG_LWDOWN_GN = XUNDEF
- DGEI%XAVG_H_V_C = XUNDEF
- DGEI%XAVG_H_G_C = XUNDEF
- DGEI%XAVG_H_C_A = XUNDEF
- DGEI%XAVG_H_N_C = XUNDEF
- DGEI%XAVG_SR_GN = XUNDEF
- DGEI%XAVG_MELTCV = XUNDEF
- DGEI%XAVG_FRZCV = XUNDEF
- !
- ALLOCATE(DGEI%XLEVCV (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLESC (KLU,I%NPATCH))
-! ALLOCATE(XLETRGV (KLU,NPATCH))
- ALLOCATE(DGEI%XLETRCV (KLU,I%NPATCH))
-! ALLOCATE(XLERGV (KLU,NPATCH))
- ALLOCATE(DGEI%XLELITTER (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLELITTERI(KLU,I%NPATCH))
- ALLOCATE(DGEI%XDRIPLIT (KLU,I%NPATCH))
- ALLOCATE(DGEI%XRRLIT (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLERCV (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLE_C_A (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLE_V_C (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLE_G_C (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLE_N_C (KLU,I%NPATCH))
- !
- ALLOCATE(DGEI%XSWNET_V (KLU,I%NPATCH))
- ALLOCATE(DGEI%XSWNET_G (KLU,I%NPATCH))
- ALLOCATE(DGEI%XSWNET_N (KLU,I%NPATCH))
- ALLOCATE(DGEI%XSWNET_NS (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLWNET_V (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLWNET_G (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLWNET_N (KLU,I%NPATCH))
- ALLOCATE(DGEI%XSWDOWN_GN (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLWDOWN_GN (KLU,I%NPATCH))
- ALLOCATE(DGEI%XH_V_C (KLU,I%NPATCH))
- ALLOCATE(DGEI%XH_G_C (KLU,I%NPATCH))
- ALLOCATE(DGEI%XH_C_A (KLU,I%NPATCH))
- ALLOCATE(DGEI%XH_N_C (KLU,I%NPATCH))
- ALLOCATE(DGEI%XSR_GN (KLU,I%NPATCH))
- ALLOCATE(DGEI%XMELTCV (KLU,I%NPATCH))
- ALLOCATE(DGEI%XFRZCV (KLU,I%NPATCH))
-!
- DGEI%XLEVCV = XUNDEF
- DGEI%XLESC = XUNDEF
-! XLETRGV = XUNDEF
- DGEI%XLETRCV = XUNDEF
-! XLERGV = XUNDEF
- DGEI%XLELITTER = XUNDEF
- DGEI%XLELITTERI = XUNDEF
- DGEI%XDRIPLIT = XUNDEF
- DGEI%XRRLIT = XUNDEF
- DGEI%XLERCV = XUNDEF
- DGEI%XLE_C_A = XUNDEF
- DGEI%XLE_V_C = XUNDEF
- DGEI%XLE_G_C = XUNDEF
- DGEI%XLE_N_C = XUNDEF
- !
- DGEI%XSWNET_V = XUNDEF
- DGEI%XSWNET_G = XUNDEF
- DGEI%XSWNET_N = XUNDEF
- DGEI%XSWNET_NS = XUNDEF
- DGEI%XLWNET_V = XUNDEF
- DGEI%XLWNET_G = XUNDEF
- DGEI%XLWNET_N = XUNDEF
- DGEI%XSWDOWN_GN = XUNDEF
- DGEI%XLWDOWN_GN = XUNDEF
- DGEI%XH_V_C = XUNDEF
- DGEI%XH_G_C = XUNDEF
- DGEI%XH_C_A = XUNDEF
- DGEI%XH_N_C = XUNDEF
- DGEI%XSR_GN = XUNDEF
- DGEI%XMELTCV = XUNDEF
- DGEI%XFRZCV = XUNDEF
- ELSE
- ALLOCATE(DGEI%XAVG_LEVCV (0))
- ALLOCATE(DGEI%XAVG_LESC (0))
- ALLOCATE(DGEI%XAVG_LETRGV (0))
- ALLOCATE(DGEI%XAVG_LELITTER (0))
- ALLOCATE(DGEI%XAVG_LELITTERI(0))
- ALLOCATE(DGEI%XAVG_DRIPLIT (0))
- ALLOCATE(DGEI%XAVG_RRLIT (0))
- ALLOCATE(DGEI%XAVG_LETRCV (0))
- ALLOCATE(DGEI%XAVG_LERGV (0))
- ALLOCATE(DGEI%XAVG_LERCV (0))
- ALLOCATE(DGEI%XAVG_LE_C_A (0))
- ALLOCATE(DGEI%XAVG_LE_V_C (0))
- ALLOCATE(DGEI%XAVG_LE_G_C (0))
- ALLOCATE(DGEI%XAVG_LE_N_C (0))
!
- ALLOCATE(DGEI%XAVG_SWNET_V (0))
- ALLOCATE(DGEI%XAVG_SWNET_G (0))
- ALLOCATE(DGEI%XAVG_SWNET_N (0))
- ALLOCATE(DGEI%XAVG_SWNET_NS (0))
- ALLOCATE(DGEI%XAVG_LWNET_V (0))
- ALLOCATE(DGEI%XAVG_LWNET_G (0))
- ALLOCATE(DGEI%XAVG_LWNET_N (0))
- ALLOCATE(DGEI%XAVG_SWDOWN_GN (0))
- ALLOCATE(DGEI%XAVG_LWDOWN_GN (0))
- ALLOCATE(DGEI%XAVG_H_V_C (0))
- ALLOCATE(DGEI%XAVG_H_G_C (0))
- ALLOCATE(DGEI%XAVG_H_C_A (0))
- ALLOCATE(DGEI%XAVG_H_N_C (0))
- ALLOCATE(DGEI%XAVG_SR_GN (0))
- ALLOCATE(DGEI%XAVG_MELTCV (0))
- ALLOCATE(DGEI%XAVG_FRZCV (0))
-!
- ALLOCATE(DGEI%XLEVCV (0,0))
- ALLOCATE(DGEI%XLESC (0,0))
-! ALLOCATE(XLETRGV (0,0))
- ALLOCATE(DGEI%XLETRCV (0,0))
-! ALLOCATE(XLERGV (0,0))
- ALLOCATE(DGEI%XLELITTER (0,0))
- ALLOCATE(DGEI%XLELITTERI(0,0))
- ALLOCATE(DGEI%XDRIPLIT (0,0))
- ALLOCATE(DGEI%XRRLIT (0,0))
- ALLOCATE(DGEI%XLERCV (0,0))
- ALLOCATE(DGEI%XLE_C_A (0,0))
- ALLOCATE(DGEI%XLE_V_C (0,0))
- ALLOCATE(DGEI%XLE_G_C (0,0))
- ALLOCATE(DGEI%XLE_N_C (0,0))
+ CALL ALLOC_MEB_BUD(DE,KLU)
+ DO JP = 1,IO%NPATCH
+ CALL ALLOC_MEB_BUD(NDE%AL(JP),NP%AL(JP)%NSIZE_P)
+ ENDDO
!
- ALLOCATE(DGEI%XSWNET_V (0,0))
- ALLOCATE(DGEI%XSWNET_G (0,0))
- ALLOCATE(DGEI%XSWNET_N (0,0))
- ALLOCATE(DGEI%XSWNET_NS (0,0))
- ALLOCATE(DGEI%XLWNET_V (0,0))
- ALLOCATE(DGEI%XLWNET_G (0,0))
- ALLOCATE(DGEI%XLWNET_N (0,0))
- ALLOCATE(DGEI%XSWDOWN_GN (0,0))
- ALLOCATE(DGEI%XLWDOWN_GN (0,0))
- ALLOCATE(DGEI%XH_V_C (0,0))
- ALLOCATE(DGEI%XH_G_C (0,0))
- ALLOCATE(DGEI%XH_C_A (0,0))
- ALLOCATE(DGEI%XH_N_C (0,0))
- ALLOCATE(DGEI%XSR_GN (0,0))
- ALLOCATE(DGEI%XMELTCV (0,0))
- ALLOCATE(DGEI%XFRZCV (0,0))
-
ENDIF
!
- IF(DGEI%LWATER_BUDGET)THEN
+ IF(IO%LGLACIER)THEN
+ ALLOCATE(DE%XICEFLUX(KLU))
+ DE%XICEFLUX(:) = XUNDEF
+ DO JP=1,IO%NPATCH
+ ALLOCATE(NDE%AL(JP)%XICEFLUX(NP%AL(JP)%NSIZE_P))
+ NDE%AL(JP)%XICEFLUX(:) = XUNDEF
+ ENDDO
+ ENDIF
+ !
+ IF(DE%LWATER_BUDGET)THEN
!
- ALLOCATE(DGEI%XRAINFALL (KLU))
- ALLOCATE(DGEI%XSNOWFALL (KLU))
- ALLOCATE(DGEI%XAVG_DWG (KLU))
- ALLOCATE(DGEI%XAVG_DWGI (KLU))
- ALLOCATE(DGEI%XAVG_DWR (KLU))
- ALLOCATE(DGEI%XAVG_DSWE (KLU))
- ALLOCATE(DGEI%XAVG_WATBUD(KLU))
- DGEI%XRAINFALL = XUNDEF
- DGEI%XSNOWFALL = XUNDEF
- DGEI%XAVG_DWG = XUNDEF
- DGEI%XAVG_DWGI = XUNDEF
- DGEI%XAVG_DWR = XUNDEF
- DGEI%XAVG_DSWE = XUNDEF
- DGEI%XAVG_WATBUD = XUNDEF
+ ALLOCATE(DE%XRAINFALL (KLU))
+ ALLOCATE(DE%XSNOWFALL (KLU))
+ DE%XRAINFALL = XUNDEF
+ DE%XSNOWFALL = XUNDEF
!
- ALLOCATE(DGEI%XDWG (KLU,I%NPATCH))
- ALLOCATE(DGEI%XDWGI (KLU,I%NPATCH))
- ALLOCATE(DGEI%XDWR (KLU,I%NPATCH))
- ALLOCATE(DGEI%XDSWE (KLU,I%NPATCH))
- ALLOCATE(DGEI%XWATBUD(KLU,I%NPATCH))
- DGEI%XDWG = XUNDEF
- DGEI%XDWGI = XUNDEF
- DGEI%XDWR = XUNDEF
- DGEI%XDSWE = XUNDEF
- DGEI%XWATBUD = XUNDEF
+ CALL ALLOC_WATER_BUD(DE,KLU)
+ DO JP=1,IO%NPATCH
+ CALL ALLOC_WATER_BUD(NDE%AL(JP),NP%AL(JP)%NSIZE_P)
+ ENDDO
!
- ELSE
- !
- ALLOCATE(DGEI%XRAINFALL (0))
- ALLOCATE(DGEI%XSNOWFALL (0))
- ALLOCATE(DGEI%XAVG_DWG (0))
- ALLOCATE(DGEI%XAVG_DWGI (0))
- ALLOCATE(DGEI%XAVG_DWR (0))
- ALLOCATE(DGEI%XAVG_DSWE (0))
- ALLOCATE(DGEI%XAVG_WATBUD(0))
- !
- ALLOCATE(DGEI%XDWG (0,0))
- ALLOCATE(DGEI%XDWGI (0,0))
- ALLOCATE(DGEI%XDWR (0,0))
- ALLOCATE(DGEI%XDSWE (0,0))
- ALLOCATE(DGEI%XWATBUD(0,0))
- !
ENDIF
!
ELSE
- ALLOCATE(DGEI%XAVG_LEG (0))
- ALLOCATE(DGEI%XAVG_LEGI (0))
- ALLOCATE(DGEI%XAVG_LEV (0))
- ALLOCATE(DGEI%XAVG_LES (0))
- ALLOCATE(DGEI%XAVG_LESL (0))
- ALLOCATE(DGEI%XAVG_LER (0))
- ALLOCATE(DGEI%XAVG_LETR (0))
- ALLOCATE(DGEI%XAVG_EVAP (0))
- ALLOCATE(DGEI%XAVG_SUBL (0))
- ALLOCATE(DGEI%XAVG_SNDRIFT (0))
- ALLOCATE(DGEI%XAVG_DRAIN (0))
- ALLOCATE(DGEI%XAVG_QSB (0))
- ALLOCATE(DGEI%XAVG_RUNOFF (0))
- ALLOCATE(DGEI%XAVG_HORT (0))
- ALLOCATE(DGEI%XAVG_DRIP (0))
- ALLOCATE(DGEI%XAVG_RRVEG (0))
- ALLOCATE(DGEI%XAVG_MELT (0))
- ALLOCATE(DGEI%XAVG_IRRIG_FLUX(0))
- ALLOCATE(DGEI%XAVG_GPP (0))
- ALLOCATE(DGEI%XAVG_RESP_AUTO (0))
- ALLOCATE(DGEI%XAVG_RESP_ECO (0))
- ALLOCATE(DGEI%XAVG_IFLOOD (0))
- ALLOCATE(DGEI%XAVG_PFLOOD (0))
- ALLOCATE(DGEI%XAVG_LE_FLOOD (0))
- ALLOCATE(DGEI%XAVG_LEI_FLOOD (0))
-!
- ALLOCATE(DGEI%XLEG (0,0))
- ALLOCATE(DGEI%XLEGI (0,0))
- ALLOCATE(DGEI%XLEV (0,0))
- ALLOCATE(DGEI%XLES (0,0))
- ALLOCATE(DGEI%XLESL (0,0))
- ALLOCATE(DGEI%XLER (0,0))
- ALLOCATE(DGEI%XLETR (0,0))
- ALLOCATE(DGEI%XEVAP (0,0))
- ALLOCATE(DGEI%XSUBL (0,0))
- ALLOCATE(DGEI%XSNDRIFT (0,0))
- ALLOCATE(DGEI%XDRAIN (0,0))
- ALLOCATE(DGEI%XQSB (0,0))
- ALLOCATE(DGEI%XRUNOFF (0,0))
- ALLOCATE(DGEI%XHORT (0,0))
- ALLOCATE(DGEI%XDRIP (0,0))
- ALLOCATE(DGEI%XRRVEG (0,0))
- ALLOCATE(DGEI%XMELT (0,0))
- ALLOCATE(DGEI%XIRRIG_FLUX(0,0))
- ALLOCATE(DGEI%XGPP (0,0))
- ALLOCATE(DGEI%XRESP_AUTO (0,0))
- ALLOCATE(DGEI%XRESP_ECO (0,0))
- ALLOCATE(DGEI%XIFLOOD (0,0))
- ALLOCATE(DGEI%XPFLOOD (0,0))
- ALLOCATE(DGEI%XLE_FLOOD (0,0))
- ALLOCATE(DGEI%XLEI_FLOOD (0,0))
- !
- ALLOCATE(DGEI%XRAINFALL (0))
- ALLOCATE(DGEI%XSNOWFALL (0))
- ALLOCATE(DGEI%XAVG_DWG (0))
- ALLOCATE(DGEI%XAVG_DWGI (0))
- ALLOCATE(DGEI%XAVG_DWR (0))
- ALLOCATE(DGEI%XAVG_DSWE (0))
- ALLOCATE(DGEI%XAVG_WATBUD(0))
- !
- ALLOCATE(DGEI%XDWG (0,0))
- ALLOCATE(DGEI%XDWGI (0,0))
- ALLOCATE(DGEI%XDWR (0,0))
- ALLOCATE(DGEI%XDSWE (0,0))
- ALLOCATE(DGEI%XWATBUD(0,0))
- !
- ALLOCATE(DGEI%XAVG_LEVCV (0))
- ALLOCATE(DGEI%XAVG_LESC (0))
- ALLOCATE(DGEI%XAVG_LETRGV (0))
- ALLOCATE(DGEI%XAVG_LETRCV (0))
- ALLOCATE(DGEI%XAVG_LERGV (0))
- ALLOCATE(DGEI%XAVG_LELITTER (0))
- ALLOCATE(DGEI%XAVG_LELITTERI(0))
- ALLOCATE(DGEI%XAVG_DRIPLIT (0))
- ALLOCATE(DGEI%XAVG_RRLIT (0))
- ALLOCATE(DGEI%XAVG_LERCV (0))
- ALLOCATE(DGEI%XAVG_LE_C_A (0))
- ALLOCATE(DGEI%XAVG_LE_V_C (0))
- ALLOCATE(DGEI%XAVG_LE_G_C (0))
- ALLOCATE(DGEI%XAVG_LE_N_C (0))
- !
- ALLOCATE(DGEI%XAVG_SWNET_V (0))
- ALLOCATE(DGEI%XAVG_SWNET_G (0))
- ALLOCATE(DGEI%XAVG_SWNET_N (0))
- ALLOCATE(DGEI%XAVG_SWNET_NS (0))
- ALLOCATE(DGEI%XAVG_LWNET_V (0))
- ALLOCATE(DGEI%XAVG_LWNET_G (0))
- ALLOCATE(DGEI%XAVG_LWNET_N (0))
- ALLOCATE(DGEI%XAVG_SWDOWN_GN (0))
- ALLOCATE(DGEI%XAVG_LWDOWN_GN (0))
- ALLOCATE(DGEI%XAVG_H_V_C (0))
- ALLOCATE(DGEI%XAVG_H_G_C (0))
- ALLOCATE(DGEI%XAVG_H_C_A (0))
- ALLOCATE(DGEI%XAVG_H_N_C (0))
- ALLOCATE(DGEI%XAVG_SR_GN (0))
- ALLOCATE(DGEI%XAVG_MELTCV (0))
- ALLOCATE(DGEI%XAVG_FRZCV (0))
-!
- ALLOCATE(DGEI%XLEVCV (0,0))
- ALLOCATE(DGEI%XLESC (0,0))
-! ALLOCATE(XLETRGV (0,0))
- ALLOCATE(DGEI%XLETRCV (0,0))
-! ALLOCATE(XLERGV (0,0))
- ALLOCATE(DGEI%XLELITTER (0,0))
- ALLOCATE(DGEI%XLELITTERI(0,0))
- ALLOCATE(DGEI%XDRIPLIT (0,0))
- ALLOCATE(DGEI%XRRLIT (0,0))
- ALLOCATE(DGEI%XLERCV (0,0))
- ALLOCATE(DGEI%XLE_C_A (0,0))
- ALLOCATE(DGEI%XLE_V_C (0,0))
- ALLOCATE(DGEI%XLE_G_C (0,0))
- ALLOCATE(DGEI%XLE_N_C (0,0))
- !
- ALLOCATE(DGEI%XSWNET_V (0,0))
- ALLOCATE(DGEI%XSWNET_G (0,0))
- ALLOCATE(DGEI%XSWNET_N (0,0))
- ALLOCATE(DGEI%XSWNET_NS (0,0))
- ALLOCATE(DGEI%XLWNET_V (0,0))
- ALLOCATE(DGEI%XLWNET_G (0,0))
- ALLOCATE(DGEI%XLWNET_N (0,0))
- ALLOCATE(DGEI%XSWDOWN_GN (0,0))
- ALLOCATE(DGEI%XLWDOWN_GN (0,0))
- ALLOCATE(DGEI%XH_V_C (0,0))
- ALLOCATE(DGEI%XH_G_C (0,0))
- ALLOCATE(DGEI%XH_C_A (0,0))
- ALLOCATE(DGEI%XH_N_C (0,0))
- ALLOCATE(DGEI%XSR_GN (0,0))
- ALLOCATE(DGEI%XMELTCV (0,0))
- ALLOCATE(DGEI%XFRZCV (0,0))
+ !
+ CALL ALLOC_EVAP_BUD(DE,0,0)
+ DO JP=1,IO%NPATCH
+ CALL ALLOC_EVAP_BUD(NDE%AL(JP),0,0)
+ ENDDO
+ !
+ENDIF
+!
+IF (.NOT. YDE%LSURF_EVAP_BUDGET .OR. .NOT.DE%LWATER_BUDGET) THEN
+ !
+ ALLOCATE(DE%XRAINFALL (0))
+ ALLOCATE(DE%XSNOWFALL (0))
+ !
+ CALL ALLOC_WATER_BUD(DE,0)
+ DO JP=1,IO%NPATCH
+ CALL ALLOC_WATER_BUD(NDE%AL(JP),0)
+ ENDDO
+ !
+ENDIF
+!
+IF (.NOT.YDE%LSURF_EVAP_BUDGET .OR. ISIZE_LMEB_PATCH<=0) THEN
+ !
+ CALL ALLOC_MEB_BUD(DE,0)
+ DO JP=1,IO%NPATCH
+ CALL ALLOC_MEB_BUD(NDE%AL(JP),0)
+ ENDDO
!
END IF
!
+IF(.NOT.YDE%LSURF_EVAP_BUDGET .OR. .NOT.IO%LGLACIER)THEN
+ ALLOCATE(DE%XICEFLUX(0))
+ DO JP=1,IO%NPATCH
+ ALLOCATE(NDE%AL(JP)%XICEFLUX(0))
+ ENDDO
+ENDIF
+!
+!////////////////CUMULATED DIAGNOSTICS//////////////////////////////
+!
!* surface cumulated energy budget
!
#ifdef SFX_OL
-IF (DGEI%LSURF_BUDGETC .OR. (LRESTART .AND. .NOT.DGEI%LRESET_BUDGETC)) THEN
+GCUMUL = (DGO%LSURF_BUDGETC .OR. (LRESTART .AND. .NOT.DGO%LRESET_BUDGETC))
#else
-IF (DGEI%LSURF_BUDGETC .OR. .NOT.DGEI%LRESET_BUDGETC) THEN
+GCUMUL = (DGO%LSURF_BUDGETC .OR. .NOT.DGO%LRESET_BUDGETC)
#endif
- ALLOCATE(DGEI%XAVG_RNC (KLU))
- ALLOCATE(DGEI%XAVG_HC (KLU))
- ALLOCATE(DGEI%XAVG_LEC (KLU))
- ALLOCATE(DGEI%XAVG_LEIC (KLU))
- ALLOCATE(DGEI%XAVG_GFLUXC (KLU))
- ALLOCATE(DGEI%XAVG_LEGC (KLU))
- ALLOCATE(DGEI%XAVG_LEGIC (KLU))
- ALLOCATE(DGEI%XAVG_LEVC (KLU))
- ALLOCATE(DGEI%XAVG_LESAC (KLU))
- ALLOCATE(DGEI%XAVG_LESLC (KLU))
- ALLOCATE(DGEI%XAVG_LERC (KLU))
- ALLOCATE(DGEI%XAVG_LETRC (KLU))
- ALLOCATE(DGEI%XAVG_EVAPC (KLU))
- ALLOCATE(DGEI%XAVG_SUBLC (KLU))
- ALLOCATE(DGEI%XAVG_SNDRIFTC (KLU))
- ALLOCATE(DGEI%XAVG_DRAINC (KLU))
- ALLOCATE(DGEI%XAVG_QSBC (KLU))
- ALLOCATE(DGEI%XAVG_RUNOFFC (KLU))
- ALLOCATE(DGEI%XAVG_HORTC (KLU))
- ALLOCATE(DGEI%XAVG_DRIPC (KLU))
- ALLOCATE(DGEI%XAVG_RRVEGC (KLU))
- ALLOCATE(DGEI%XAVG_MELTC (KLU))
- ALLOCATE(DGEI%XAVG_IRRIG_FLUXC(KLU))
- ALLOCATE(DGEI%XAVG_GPPC (KLU))
- ALLOCATE(DGEI%XAVG_RESPC_AUTO (KLU))
- ALLOCATE(DGEI%XAVG_RESPC_ECO (KLU))
- ALLOCATE(DGEI%XAVG_IFLOODC (KLU))
- ALLOCATE(DGEI%XAVG_PFLOODC (KLU))
- ALLOCATE(DGEI%XAVG_LE_FLOODC (KLU))
- ALLOCATE(DGEI%XAVG_LEI_FLOODC (KLU))
- !
- ALLOCATE(DGEI%XRNC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XHC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLEC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLEIC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XGFLUXC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLEGC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLEGIC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLEVC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLESAC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLESLC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLERC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLETRC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XEVAPC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XSUBLC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XSNDRIFTC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XDRAINC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XQSBC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XRUNOFFC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XHORTC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XDRIPC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XRRVEGC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XMELTC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XIRRIG_FLUXC(KLU,I%NPATCH))
- ALLOCATE(DGEI%XGPPC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XRESPC_AUTO (KLU,I%NPATCH))
- ALLOCATE(DGEI%XRESPC_ECO (KLU,I%NPATCH))
- ALLOCATE(DGEI%XIFLOODC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XPFLOODC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLE_FLOODC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLEI_FLOODC (KLU,I%NPATCH))
+!
+IF ( GCUMUL ) THEN
!
- IF (ISIZE_LMEB_PATCH>0) THEN
- ALLOCATE(DGEI%XAVG_LEVCVC (KLU))
- ALLOCATE(DGEI%XAVG_LESCC (KLU))
- ALLOCATE(DGEI%XAVG_LETRGVC (KLU))
- ALLOCATE(DGEI%XAVG_LETRCVC (KLU))
- ALLOCATE(DGEI%XAVG_LERGVC (KLU))
- ALLOCATE(DGEI%XAVG_LERCVC (KLU))
- ALLOCATE(DGEI%XAVG_LE_C_AC (KLU))
- ALLOCATE(DGEI%XAVG_LE_V_CC (KLU))
- ALLOCATE(DGEI%XAVG_LE_G_CC (KLU))
- ALLOCATE(DGEI%XAVG_LE_N_CC (KLU))
- !
- ALLOCATE(DGEI%XAVG_SWNET_VC (KLU))
- ALLOCATE(DGEI%XAVG_SWNET_GC (KLU))
- ALLOCATE(DGEI%XAVG_SWNET_NC (KLU))
- ALLOCATE(DGEI%XAVG_SWNET_NSC (KLU))
- ALLOCATE(DGEI%XAVG_LWNET_VC (KLU))
- ALLOCATE(DGEI%XAVG_LWNET_GC (KLU))
- ALLOCATE(DGEI%XAVG_LWNET_NC (KLU))
- ALLOCATE(DGEI%XAVG_SWDOWN_GNC (KLU))
- ALLOCATE(DGEI%XAVG_LWDOWN_GNC (KLU))
- ALLOCATE(DGEI%XAVG_H_V_CC (KLU))
- ALLOCATE(DGEI%XAVG_H_G_CC (KLU))
- ALLOCATE(DGEI%XAVG_H_C_AC (KLU))
- ALLOCATE(DGEI%XAVG_H_N_CC (KLU))
- ALLOCATE(DGEI%XAVG_SR_GNC (KLU))
- ALLOCATE(DGEI%XAVG_MELTCVC (KLU))
- ALLOCATE(DGEI%XAVG_FRZCVC (KLU))
- !
- ALLOCATE(DGEI%XLEVCVC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLESCC (KLU,I%NPATCH))
-! ALLOCATE(XLETRGVC (KLU,NPATCH))
- ALLOCATE(DGEI%XLETRCVC (KLU,I%NPATCH))
-! ALLOCATE(XLERGVC (KLU,NPATCH))
- ALLOCATE(DGEI%XLERCVC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLE_C_AC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLE_V_CC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLE_G_CC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLE_N_CC (KLU,I%NPATCH))
- !
- ALLOCATE(DGEI%XSWNET_VC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XSWNET_GC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XSWNET_NC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XSWNET_NSC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLWNET_VC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLWNET_GC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLWNET_NC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XSWDOWN_GNC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XLWDOWN_GNC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XH_V_CC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XH_G_CC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XH_C_AC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XH_N_CC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XSR_GNC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XMELTCVC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XFRZCVC (KLU,I%NPATCH))
- ELSE
- ALLOCATE(DGEI%XAVG_LEVCVC (0))
- ALLOCATE(DGEI%XAVG_LESCC (0))
- ALLOCATE(DGEI%XAVG_LETRGVC (0))
- ALLOCATE(DGEI%XAVG_LETRCVC (0))
- ALLOCATE(DGEI%XAVG_LERGVC (0))
- ALLOCATE(DGEI%XAVG_LERCVC (0))
- ALLOCATE(DGEI%XAVG_LE_C_AC (0))
- ALLOCATE(DGEI%XAVG_LE_V_CC (0))
- ALLOCATE(DGEI%XAVG_LE_G_CC (0))
- ALLOCATE(DGEI%XAVG_LE_N_CC (0))
+ !///////////////////////ALLOCATIONS//////////////////////
+ !
+ CALL ALLOC_EVAP_BUD(DEC,KLU,0)
+ DO JP=1,IO%NPATCH
+ CALL ALLOC_EVAP_BUD(NDEC%AL(JP),NP%AL(JP)%NSIZE_P,0)
+ ENDDO
!
- ALLOCATE(DGEI%XAVG_SWNET_VC (0))
- ALLOCATE(DGEI%XAVG_SWNET_GC (0))
- ALLOCATE(DGEI%XAVG_SWNET_NC (0))
- ALLOCATE(DGEI%XAVG_SWNET_NSC (0))
- ALLOCATE(DGEI%XAVG_LWNET_VC (0))
- ALLOCATE(DGEI%XAVG_LWNET_GC (0))
- ALLOCATE(DGEI%XAVG_LWNET_NC (0))
- ALLOCATE(DGEI%XAVG_SWDOWN_GNC (0))
- ALLOCATE(DGEI%XAVG_LWDOWN_GNC (0))
- ALLOCATE(DGEI%XAVG_H_V_CC (0))
- ALLOCATE(DGEI%XAVG_H_G_CC (0))
- ALLOCATE(DGEI%XAVG_H_C_AC (0))
- ALLOCATE(DGEI%XAVG_H_N_CC (0))
- ALLOCATE(DGEI%XAVG_SR_GNC (0))
- ALLOCATE(DGEI%XAVG_MELTCVC (0))
- ALLOCATE(DGEI%XAVG_FRZCVC (0))
+ IF (ISIZE_LMEB_PATCH>0) THEN
!
- ALLOCATE(DGEI%XLEVCVC (0,0))
- ALLOCATE(DGEI%XLESCC (0,0))
-! ALLOCATE(XLETRGVC (0,0))
- ALLOCATE(DGEI%XLETRCVC (0,0))
-! ALLOCATE(XLERGVC (0,0))
- ALLOCATE(DGEI%XLERCVC (0,0))
- ALLOCATE(DGEI%XLE_C_AC (0,0))
- ALLOCATE(DGEI%XLE_V_CC (0,0))
- ALLOCATE(DGEI%XLE_G_CC (0,0))
- ALLOCATE(DGEI%XLE_N_CC (0,0))
+ CALL ALLOC_MEB_BUD(DEC,KLU)
+ DO JP=1,IO%NPATCH
+ CALL ALLOC_MEB_BUD(NDEC%AL(JP),NP%AL(JP)%NSIZE_P)
+ ENDDO
!
- ALLOCATE(DGEI%XSWNET_VC (0,0))
- ALLOCATE(DGEI%XSWNET_GC (0,0))
- ALLOCATE(DGEI%XSWNET_NC (0,0))
- ALLOCATE(DGEI%XSWNET_NSC (0,0))
- ALLOCATE(DGEI%XLWNET_VC (0,0))
- ALLOCATE(DGEI%XLWNET_GC (0,0))
- ALLOCATE(DGEI%XLWNET_NC (0,0))
- ALLOCATE(DGEI%XSWDOWN_GNC (0,0))
- ALLOCATE(DGEI%XLWDOWN_GNC (0,0))
- ALLOCATE(DGEI%XH_V_CC (0,0))
- ALLOCATE(DGEI%XH_G_CC (0,0))
- ALLOCATE(DGEI%XH_C_AC (0,0))
- ALLOCATE(DGEI%XH_N_CC (0,0))
- ALLOCATE(DGEI%XSR_GNC (0,0))
- ALLOCATE(DGEI%XMELTCVC (0,0))
- ALLOCATE(DGEI%XFRZCVC (0,0))
ENDIF
!
- ALLOCATE(DGI%XAVG_SWDC (KLU))
- ALLOCATE(DGI%XAVG_SWUC (KLU))
- ALLOCATE(DGI%XAVG_LWDC (KLU))
- ALLOCATE(DGI%XAVG_LWUC (KLU))
- ALLOCATE(DGI%XAVG_FMUC (KLU))
- ALLOCATE(DGI%XAVG_FMVC (KLU))
- ALLOCATE(DGI%XSWDC (KLU,I%NPATCH))
- ALLOCATE(DGI%XSWUC (KLU,I%NPATCH))
- ALLOCATE(DGI%XLWDC (KLU,I%NPATCH))
- ALLOCATE(DGI%XLWUC (KLU,I%NPATCH))
- ALLOCATE(DGI%XFMUC (KLU,I%NPATCH))
- ALLOCATE(DGI%XFMVC (KLU,I%NPATCH))
- !
- IF(I%LGLACIER)THEN
- ALLOCATE(DGEI%XAVG_ICEFLUXC(KLU))
- ALLOCATE(DGEI%XICEFLUXC(KLU,I%NPATCH))
+ CALL ALLOC_SURF_BUD(DC,0,KLU,0)
+ ALLOCATE(DC%XEVAP(KLU))
+ ALLOCATE(DC%XSUBL(KLU))
+ DC%XEVAP = XUNDEF
+ DC%XSUBL = XUNDEF
+ DO JP=1,IO%NPATCH
+ CALL ALLOC_SURF_BUD(NDC%AL(JP),0,NP%AL(JP)%NSIZE_P,0)
+ ALLOCATE(NDC%AL(JP)%XEVAP(NP%AL(JP)%NSIZE_P))
+ ALLOCATE(NDC%AL(JP)%XSUBL(NP%AL(JP)%NSIZE_P))
+ NDC%AL(JP)%XEVAP = XUNDEF
+ NDC%AL(JP)%XSUBL = XUNDEF
+ ENDDO
+ !
+ IF(IO%LGLACIER)THEN
+ ALLOCATE(DEC%XICEFLUX(KLU))
+ DO JP=1,IO%NPATCH
+ ALLOCATE(NDEC%AL(JP)%XICEFLUX(NP%AL(JP)%NSIZE_P))
+ ENDDO
ENDIF
!
#ifdef SFX_OL
- IF(DGEI%LWATER_BUDGET .OR. (LRESTART .AND. .NOT.DGEI%LRESET_BUDGETC))THEN
+ IF(DE%LWATER_BUDGET .OR. (LRESTART .AND. .NOT.DGO%LRESET_BUDGETC))THEN
#else
- IF(DGEI%LWATER_BUDGET .OR. .NOT.DGEI%LRESET_BUDGETC)THEN
+ IF(DE%LWATER_BUDGET .OR. .NOT.DGO%LRESET_BUDGETC)THEN
#endif
!
- ALLOCATE(DGEI%XRAINFALLC (KLU))
- ALLOCATE(DGEI%XSNOWFALLC (KLU))
- ALLOCATE(DGEI%XAVG_DWGC (KLU))
- ALLOCATE(DGEI%XAVG_DWGIC (KLU))
- ALLOCATE(DGEI%XAVG_DWRC (KLU))
- ALLOCATE(DGEI%XAVG_DSWEC (KLU))
- ALLOCATE(DGEI%XAVG_WATBUDC(KLU))
+ ALLOCATE(DEC%XRAINFALL (KLU))
+ ALLOCATE(DEC%XSNOWFALL (KLU))
!
- ALLOCATE(DGEI%XDWGC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XDWGIC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XDWRC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XDSWEC (KLU,I%NPATCH))
- ALLOCATE(DGEI%XWATBUDC(KLU,I%NPATCH))
+ CALL ALLOC_WATER_BUD(DEC,KLU)
+ DO JP=1,IO%NPATCH
+ CALL ALLOC_WATER_BUD(NDEC%AL(JP),NP%AL(JP)%NSIZE_P)
+ ENDDO
+ !
+ ENDIF
+ !
+ !/////////////////INITIALISATIONS//////////////////////////
+ !
+ CALL INIT_EVAP_BUD(DEC)
+ !
+ IF (ISIZE_LMEB_PATCH>0) THEN
!
- ELSE
- !
- ALLOCATE(DGEI%XRAINFALLC (0))
- ALLOCATE(DGEI%XSNOWFALLC (0))
- ALLOCATE(DGEI%XAVG_DWGC (0))
- ALLOCATE(DGEI%XAVG_DWGIC (0))
- ALLOCATE(DGEI%XAVG_DWRC (0))
- ALLOCATE(DGEI%XAVG_DSWEC (0))
- ALLOCATE(DGEI%XAVG_WATBUDC(0))
+ CALL INIT_MEB_BUD(DEC)
!
- ALLOCATE(DGEI%XDWGC (0,0))
- ALLOCATE(DGEI%XDWGIC (0,0))
- ALLOCATE(DGEI%XDWRC (0,0))
- ALLOCATE(DGEI%XDSWEC (0,0))
- ALLOCATE(DGEI%XWATBUDC(0,0))
- !
ENDIF
!
- IF (.NOT.DGU%LREAD_BUDGETC) THEN
- DGEI%XAVG_RNC = 0.0
- DGEI%XAVG_HC = 0.0
- DGEI%XAVG_LEC = 0.0
- DGEI%XAVG_LEIC = 0.0
- DGEI%XAVG_GFLUXC = 0.0
- DGEI%XAVG_LEGC = 0.0
- DGEI%XAVG_LEGIC = 0.0
- DGEI%XAVG_LEVC = 0.0
- DGEI%XAVG_LESAC = 0.0
- DGEI%XAVG_LESLC = 0.0
- DGEI%XAVG_LERC = 0.0
- DGEI%XAVG_LETRC = 0.0
- DGEI%XAVG_EVAPC = 0.0
- DGEI%XAVG_SUBLC = 0.0
- DGEI%XAVG_SNDRIFTC = 0.0
- DGEI%XAVG_DRAINC = 0.0
- DGEI%XAVG_QSBC = 0.0
- DGEI%XAVG_RUNOFFC = 0.0
- DGEI%XAVG_HORTC = 0.0
- DGEI%XAVG_DRIPC = 0.0
- DGEI%XAVG_RRVEGC = 0.0
- DGEI%XAVG_MELTC = 0.0
- DGEI%XAVG_IRRIG_FLUXC = 0.0
- DGEI%XAVG_GPPC = 0.0
- DGEI%XAVG_RESPC_AUTO = 0.0
- DGEI%XAVG_RESPC_ECO = 0.0
- DGEI%XAVG_IFLOODC = 0.0
- DGEI%XAVG_PFLOODC = 0.0
- DGEI%XAVG_LE_FLOODC = 0.0
- DGEI%XAVG_LEI_FLOODC = 0.0
- !
- DGEI%XRNC = 0.0
- DGEI%XHC = 0.0
- DGEI%XLEC = 0.0
- DGEI%XLEIC = 0.0
- DGEI%XGFLUXC = 0.0
- DGEI%XLEGC = 0.0
- DGEI%XLEGIC = 0.0
- DGEI%XLEVC = 0.0
- DGEI%XLESAC = 0.0
- DGEI%XLESLC = 0.0
- DGEI%XLERC = 0.0
- DGEI%XLETRC = 0.0
- DGEI%XEVAPC = 0.0
- DGEI%XSUBLC = 0.0
- DGEI%XSNDRIFTC = 0.0
- DGEI%XDRAINC = 0.0
- DGEI%XQSBC = 0.0
- DGEI%XRUNOFFC = 0.0
- DGEI%XHORTC = 0.0
- DGEI%XDRIPC = 0.0
- DGEI%XRRVEGC = 0.0
- DGEI%XMELTC = 0.0
- DGEI%XIRRIG_FLUXC = 0.0
- DGEI%XGPPC = 0.0
- DGEI%XRESPC_AUTO = 0.0
- DGEI%XRESPC_ECO = 0.0
- DGEI%XIFLOODC = 0.0
- DGEI%XPFLOODC = 0.0
- DGEI%XLE_FLOODC = 0.0
- DGEI%XLEI_FLOODC = 0.0
- !
- IF (ISIZE_LMEB_PATCH>0) THEN
- DGEI%XAVG_LEVCVC = 0.0
- DGEI%XAVG_LESCC = 0.0
- DGEI%XAVG_LETRGVC = 0.0
- DGEI%XAVG_LETRCVC = 0.0
- DGEI%XAVG_LERGVC = 0.0
- DGEI%XAVG_LERCVC = 0.0
- DGEI%XAVG_LE_C_AC = 0.0
- DGEI%XAVG_LE_V_CC = 0.0
- DGEI%XAVG_LE_G_CC = 0.0
- DGEI%XAVG_LE_N_CC = 0.0
- !
- DGEI%XAVG_SWNET_VC = 0.0
- DGEI%XAVG_SWNET_GC = 0.0
- DGEI%XAVG_SWNET_NC = 0.0
- DGEI%XAVG_SWNET_NSC = 0.0
- DGEI%XAVG_LWNET_VC = 0.0
- DGEI%XAVG_LWNET_GC = 0.0
- DGEI%XAVG_LWNET_NC = 0.0
- DGEI%XAVG_SWDOWN_GNC = 0.0
- DGEI%XAVG_LWDOWN_GNC = 0.0
- DGEI%XAVG_H_V_CC = 0.0
- DGEI%XAVG_H_G_CC = 0.0
- DGEI%XAVG_H_C_AC = 0.0
- DGEI%XAVG_H_N_CC = 0.0
- DGEI%XAVG_SR_GNC = 0.0
- DGEI%XAVG_MELTCVC = 0.0
- DGEI%XAVG_FRZCVC = 0.0
-!
- DGEI%XLEVCVC = 0.0
- DGEI%XLESCC = 0.0
-! XLETRGVC = 0.0
- DGEI%XLETRCVC = 0.0
-! XLERGVC = 0.0
- DGEI%XLERCVC = 0.0
- DGEI%XLE_C_AC = 0.0
- DGEI%XLE_V_CC = 0.0
- DGEI%XLE_G_CC = 0.0
- DGEI%XLE_N_CC = 0.0
- !
- DGEI%XSWNET_VC = 0.0
- DGEI%XSWNET_GC = 0.0
- DGEI%XSWNET_NC = 0.0
- DGEI%XSWNET_NSC = 0.0
- DGEI%XLWNET_VC = 0.0
- DGEI%XLWNET_GC = 0.0
- DGEI%XLWNET_NC = 0.0
- DGEI%XSWDOWN_GNC = 0.0
- DGEI%XLWDOWN_GNC = 0.0
- DGEI%XH_V_CC = 0.0
- DGEI%XH_G_CC = 0.0
- DGEI%XH_C_AC = 0.0
- DGEI%XH_N_CC = 0.0
- DGEI%XSR_GNC = 0.0
- DGEI%XMELTCVC = 0.0
- DGEI%XFRZCVC = 0.0
- ENDIF
- !
- DGI%XAVG_SWDC = 0.0
- DGI%XAVG_SWUC = 0.0
- DGI%XAVG_LWDC = 0.0
- DGI%XAVG_LWUC = 0.0
- DGI%XAVG_FMUC = 0.0
- DGI%XAVG_FMVC = 0.0
- DGI%XSWDC = 0.0
- DGI%XSWUC = 0.0
- DGI%XLWDC = 0.0
- DGI%XLWUC = 0.0
- DGI%XFMUC = 0.0
- DGI%XFMVC = 0.0
- !
- IF(I%LGLACIER)THEN
- DGEI%XAVG_ICEFLUXC = 0.0
- DGEI%XICEFLUXC = 0.0
- ENDIF
- !
- IF(DGEI%LWATER_BUDGET)THEN
- !
- DGEI%XRAINFALLC = 0.0
- DGEI%XSNOWFALLC = 0.0
- DGEI%XAVG_DWGC = 0.0
- DGEI%XAVG_DWGIC = 0.0
- DGEI%XAVG_DWRC = 0.0
- DGEI%XAVG_DSWEC = 0.0
- DGEI%XAVG_WATBUDC = 0.0
- !
- DGEI%XDWGC = 0.0
- DGEI%XDWGIC = 0.0
- DGEI%XDWRC = 0.0
- DGEI%XDSWEC = 0.0
- DGEI%XWATBUDC = 0.0
- !
- ENDIF
- !
- ELSEIF (DGU%LREAD_BUDGETC.AND.DGEI%LRESET_BUDGETC) THEN
- !
- DGEI%XAVG_RNC = 0.0
- DGEI%XAVG_HC = 0.0
- DGEI%XAVG_LEC = 0.0
- DGEI%XAVG_LEIC = 0.0
- DGEI%XAVG_GFLUXC = 0.0
- DGEI%XAVG_LEGC = 0.0
- DGEI%XAVG_LEGIC = 0.0
- DGEI%XAVG_LEVC = 0.0
- DGEI%XAVG_LESAC = 0.0
- DGEI%XAVG_LESLC = 0.0
- DGEI%XAVG_LERC = 0.0
- DGEI%XAVG_LETRC = 0.0
- DGEI%XAVG_EVAPC = 0.0
- DGEI%XAVG_SUBLC = 0.0
- DGEI%XAVG_SNDRIFTC = 0.0
- DGEI%XAVG_DRAINC = 0.0
- DGEI%XAVG_QSBC = 0.0
- DGEI%XAVG_RUNOFFC = 0.0
- DGEI%XAVG_HORTC = 0.0
- DGEI%XAVG_DRIPC = 0.0
- DGEI%XAVG_RRVEGC = 0.0
- DGEI%XAVG_MELTC = 0.0
- DGEI%XAVG_IRRIG_FLUXC = 0.0
- DGEI%XAVG_GPPC = 0.0
- DGEI%XAVG_RESPC_AUTO = 0.0
- DGEI%XAVG_RESPC_ECO = 0.0
- DGEI%XAVG_IFLOODC = 0.0
- DGEI%XAVG_PFLOODC = 0.0
- DGEI%XAVG_LE_FLOODC = 0.0
- DGEI%XAVG_LEI_FLOODC = 0.0
- !
- IF (ISIZE_LMEB_PATCH>0) THEN
- DGEI%XAVG_LEVCVC = 0.0
- DGEI%XAVG_LESCC = 0.0
- DGEI%XAVG_LETRGVC = 0.0
- DGEI%XAVG_LETRCVC = 0.0
- DGEI%XAVG_LERGVC = 0.0
- DGEI%XAVG_LERCVC = 0.0
- DGEI%XAVG_LE_C_AC = 0.0
- DGEI%XAVG_LE_V_CC = 0.0
- DGEI%XAVG_LE_G_CC = 0.0
- DGEI%XAVG_LE_N_CC = 0.0
- !
- DGEI%XAVG_SWNET_VC = 0.0
- DGEI%XAVG_SWNET_GC = 0.0
- DGEI%XAVG_SWNET_NC = 0.0
- DGEI%XAVG_SWNET_NSC = 0.0
- DGEI%XAVG_LWNET_VC = 0.0
- DGEI%XAVG_LWNET_GC = 0.0
- DGEI%XAVG_LWNET_NC = 0.0
- DGEI%XAVG_SWDOWN_GNC = 0.0
- DGEI%XAVG_LWDOWN_GNC = 0.0
- DGEI%XAVG_H_V_CC = 0.0
- DGEI%XAVG_H_G_CC = 0.0
- DGEI%XAVG_H_C_AC = 0.0
- DGEI%XAVG_H_N_CC = 0.0
- DGEI%XAVG_SR_GNC = 0.0
- DGEI%XAVG_MELTCVC = 0.0
- DGEI%XAVG_FRZCVC = 0.0
- !
- DGEI%XLEVCVC = 0.0
- DGEI%XLESCC = 0.0
-! XLETRGVC = 0.0
- DGEI%XLETRCVC = 0.0
-! XLERGVC = 0.0
- DGEI%XLERCVC = 0.0
- DGEI%XLE_C_AC = 0.0
- DGEI%XLE_V_CC = 0.0
- DGEI%XLE_G_CC = 0.0
- DGEI%XLE_N_CC = 0.0
- !
- DGEI%XSWNET_VC = 0.0
- DGEI%XSWNET_GC = 0.0
- DGEI%XSWNET_NC = 0.0
- DGEI%XSWNET_NSC = 0.0
- DGEI%XLWNET_VC = 0.0
- DGEI%XLWNET_GC = 0.0
- DGEI%XLWNET_NC = 0.0
- DGEI%XSWDOWN_GNC = 0.0
- DGEI%XLWDOWN_GNC = 0.0
- DGEI%XH_V_CC = 0.0
- DGEI%XH_G_CC = 0.0
- DGEI%XH_C_AC = 0.0
- DGEI%XH_N_CC = 0.0
- DGEI%XSR_GNC = 0.0
- DGEI%XMELTCVC = 0.0
- DGEI%XFRZCVC = 0.0
- ENDIF
- !
- DGEI%XRNC = 0.0
- DGEI%XHC = 0.0
- DGEI%XLEC = 0.0
- DGEI%XLEIC = 0.0
- DGEI%XGFLUXC = 0.0
- DGEI%XLEGC = 0.0
- DGEI%XLEGIC = 0.0
- DGEI%XLEVC = 0.0
- DGEI%XLESAC = 0.0
- DGEI%XLESLC = 0.0
- DGEI%XLERC = 0.0
- DGEI%XLETRC = 0.0
- DGEI%XEVAPC = 0.0
- DGEI%XSUBLC = 0.0
- DGEI%XSNDRIFTC = 0.0
- DGEI%XDRAINC = 0.0
- DGEI%XQSBC = 0.0
- DGEI%XRUNOFFC = 0.0
- DGEI%XHORTC = 0.0
- DGEI%XDRIPC = 0.0
- DGEI%XRRVEGC = 0.0
- DGEI%XMELTC = 0.0
- DGEI%XIRRIG_FLUXC = 0.0
- DGEI%XGPPC = 0.0
- DGEI%XRESPC_AUTO = 0.0
- DGEI%XRESPC_ECO = 0.0
- DGEI%XIFLOODC = 0.0
- DGEI%XPFLOODC = 0.0
- DGEI%XLE_FLOODC = 0.0
- DGEI%XLEI_FLOODC = 0.0
- !
- DGI%XAVG_SWDC = 0.0
- DGI%XAVG_SWUC = 0.0
- DGI%XAVG_LWDC = 0.0
- DGI%XAVG_LWUC = 0.0
- DGI%XAVG_FMUC = 0.0
- DGI%XAVG_FMVC = 0.0
- DGI%XSWDC = 0.0
- DGI%XSWUC = 0.0
- DGI%XLWDC = 0.0
- DGI%XLWUC = 0.0
- DGI%XFMUC = 0.0
- DGI%XFMVC = 0.0
- !
- IF(I%LGLACIER)THEN
- DGEI%XAVG_ICEFLUXC = 0.0
- DGEI%XICEFLUXC = 0.0
- ENDIF
- !
- IF(DGEI%LWATER_BUDGET)THEN
- !
- DGEI%XRAINFALLC = 0.0
- DGEI%XSNOWFALLC = 0.0
- DGEI%XAVG_DWGC = 0.0
- DGEI%XAVG_DWGIC = 0.0
- DGEI%XAVG_DWRC = 0.0
- DGEI%XAVG_DSWEC = 0.0
- DGEI%XAVG_WATBUDC = 0.0
- !
- DGEI%XDWGC = 0.0
- DGEI%XDWGIC = 0.0
- DGEI%XDWRC = 0.0
- DGEI%XDSWEC = 0.0
- DGEI%XWATBUDC = 0.0
- !
- ENDIF
- !
- ELSE
- !
- CALL READ_SURF(&
- HPROGRAM,'VERSION',IVERSION,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'BUG ',IBUG,IRESP)
+ CALL INIT_SURF_BUD(DC,0.)
+ DC%XEVAP = 0.
+ DC%XSUBL = 0.
+ !
+ IF(IO%LGLACIER) DEC%XICEFLUX = 0.0
+ !
+ IF (.NOT.OREAD_BUDGETC .OR. (OREAD_BUDGETC.AND.DGO%LRESET_BUDGETC)) THEN
!
- YREC='RNC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_RNC ,IRESP)
- YREC='HC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_HC ,IRESP)
- YREC='LEC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LEC ,IRESP)
- YREC='LEIC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LEIC ,IRESP)
- YREC='GFLUXC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_GFLUXC ,IRESP)
- YREC='LEGC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LEGC ,IRESP)
- YREC='LEGIC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LEGIC ,IRESP)
- YREC='LEVC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LEVC ,IRESP)
- YREC='LESC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LESAC ,IRESP)
- IF(I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO')THEN
- IF(IVERSION>7 .OR. IVERSION==7 .AND. IBUG>=3)THEN
- YREC='LESLC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LESLC,IRESP)
- ELSE
- DGEI%XAVG_LESLC=0.0
- ENDIF
- IF(IVERSION>=8)THEN
- YREC='SNDRIFC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_SNDRIFTC,IRESP)
- ELSE
- DGEI%XAVG_SNDRIFTC = 0.0
- ENDIF
- ELSE
- DGEI%XAVG_LESLC = 0.0
- DGEI%XAVG_SNDRIFTC = 0.0
- ENDIF
- YREC='LERC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LERC ,IRESP)
- YREC='LETRC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LETRC ,IRESP)
- YREC='EVAPC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_EVAPC ,IRESP)
- IF (IVERSION<8)THEN
- DGEI%XAVG_SUBLC = 0.0
- ELSE
- YREC='SUBLC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_SUBLC ,IRESP)
- ENDIF
- YREC='DRAINC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_DRAINC ,IRESP)
- YREC='RUNOFFC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_RUNOFFC,IRESP)
- YREC='DRIVEGC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_DRIPC ,IRESP)
- YREC='RRVEGC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_RRVEGC ,IRESP)
- YREC='SNOMLTC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_MELTC,IRESP)
+ DO JP=1,IO%NPATCH
+ CALL INIT_EVAP_BUD(NDEC%AL(JP))
+ ENDDO
!
IF (ISIZE_LMEB_PATCH>0) THEN
- YREC='LEVCVC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LEVCVC ,IRESP)
- YREC='LESCC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LESCC ,IRESP)
- YREC='LETRGVC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LETRGVC ,IRESP)
- YREC='LETRCVC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LETRCVC ,IRESP)
- YREC='LERGVC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LERGVC ,IRESP)
- YREC='LERCVC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LERCVC ,IRESP)
- YREC='LE_C_AC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LE_C_AC ,IRESP)
- YREC='LE_V_CC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LE_V_CC ,IRESP)
- YREC='LE_G_CC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LE_G_CC ,IRESP)
- YREC='LE_N_CC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LE_N_CC ,IRESP)
!
- YREC='SWNT_VC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_SWNET_VC ,IRESP)
- YREC='SWNT_GC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_SWNET_GC ,IRESP)
- YREC='SWNT_NC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_SWNET_NC ,IRESP)
- YREC='SWNT_NSC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_SWNET_NSC ,IRESP)
- YREC='LWNT_VC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LWNET_VC ,IRESP)
- YREC='LWNT_GC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LWNET_GC ,IRESP)
- YREC='LWNT_NC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LWNET_NC ,IRESP)
- YREC='SWDN_GNC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_SWDOWN_GNC ,IRESP)
- YREC='LWDN_GNC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LWDOWN_GNC ,IRESP)
- YREC='H_V_CC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_H_V_CC ,IRESP)
- YREC='H_G_CC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_H_G_CC ,IRESP)
- YREC='H_C_AC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_H_C_AC ,IRESP)
- YREC='H_N_CC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_H_N_CC ,IRESP)
- YREC='SR_GNC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_SR_GNC ,IRESP)
- YREC='MELTCVC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_MELTCVC ,IRESP)
- YREC='FRZCVC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_FRZCVC ,IRESP)
+ DO JP=1,IO%NPATCH
+ CALL INIT_MEB_BUD(NDEC%AL(JP))
+ ENDDO
+ !
ENDIF
!
- IF (LAGRIP) THEN
- YREC='IRRIGC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_IRRIG_FLUXC,IRESP)
- ELSE
- DGEI%XAVG_IRRIG_FLUXC = 0.0
- ENDIF
+ DO JP=1,IO%NPATCH
+ CALL INIT_SURF_BUD(NDC%AL(JP),0.)
+ NDC%AL(JP)%XEVAP = 0.
+ NDC%AL(JP)%XSUBL = 0.
+ ENDDO
!
- IF(I%CPHOTO/='NON' .AND. (IVERSION>7 .OR. IVERSION==7 .AND. IBUG>=3))THEN
- YREC='GPPC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_GPPC,IRESP)
- YREC='RC_AUTO_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_RESPC_AUTO,IRESP)
- YREC='RC_ECO_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_RESPC_ECO,IRESP)
- ELSE
- DGEI%XAVG_GPPC = 0.0
- DGEI%XAVG_RESPC_AUTO = 0.0
- DGEI%XAVG_RESPC_ECO = 0.0
+ IF(IO%LGLACIER)THEN
+ DO JP=1,IO%NPATCH
+ NDEC%AL(JP)%XICEFLUX = 0.0
+ ENDDO
ENDIF
!
- IF((I%CRUNOFF=='SGH'.AND.I%CISBA=='DIF').AND.IVERSION>=8)THEN
- YREC='QSBC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_QSBC,IRESP)
- ELSE
- DGEI%XAVG_QSBC = 0.0
+#ifdef SFX_OL
+ IF(DE%LWATER_BUDGET .OR. (LRESTART .AND. .NOT.DGO%LRESET_BUDGETC))THEN
+#else
+ IF(DE%LWATER_BUDGET .OR. .NOT.DGO%LRESET_BUDGETC)THEN
+#endif
+ !
+ CALL INIT_WATER_BUD(DEC)
+ DO JP=1,IO%NPATCH
+ CALL INIT_WATER_BUD(NDEC%AL(JP))
+ ENDDO
+ !
+ DEC%XRAINFALL = 0.0
+ DEC%XSNOWFALL = 0.0
+ !
ENDIF
+ !
+ ELSE
!
- IF(I%CHORT=='SGH'.OR.I%CISBA=='DIF')THEN
- YREC='HORTONC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_HORTC,IRESP)
- ELSE
- DGEI%XAVG_HORTC = 0.0
- ENDIF
+ CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,'BUG ',IBUG,IRESP)
!
- IF(I%LFLOOD)THEN
- YREC='IFLOODC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_IFLOODC,IRESP)
- YREC='PFLOODC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_PFLOODC,IRESP)
- YREC='LEFC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LE_FLOODC,IRESP)
- YREC='LEIFC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_LEI_FLOODC,IRESP)
- ELSE
- DGEI%XAVG_IFLOODC = 0.0
- DGEI%XAVG_PFLOODC = 0.0
- DGEI%XAVG_LE_FLOODC = 0.0
- DGEI%XAVG_LEI_FLOODC = 0.0
- ENDIF
-!
- IF (DGI%LRAD_BUDGET) THEN
- YREC='SWDC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGI%XAVG_SWDC,IRESP)
- YREC='SWUC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGI%XAVG_SWUC,IRESP)
- YREC='LWDC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGI%XAVG_LWDC,IRESP)
- YREC='LWUC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGI%XAVG_LWUC,IRESP)
- ENDIF
- YREC='FMUC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGI%XAVG_FMUC,IRESP)
- YREC='FMVC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGI%XAVG_FMVC,IRESP)
+ GDIM = (IVERSION>8 .OR. IVERSION==8 .AND. IBUG>0)
!
- IF(I%LGLACIER)THEN
- YREC='ICE_FC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_ICEFLUXC,IRESP)
- ENDIF
- !
- IF(DGEI%LWATER_BUDGET .AND. (IVERSION>7 .OR. IVERSION==7 .AND. IBUG>=3))THEN
- YREC='RAINFC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XRAINFALLC,IRESP)
- YREC='SNOWFC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XSNOWFALLC,IRESP)
- YREC='DWGC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_DWGC,IRESP)
- YREC='DWGIC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_DWGIC,IRESP)
- YREC='DWRC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_DWRC,IRESP)
- YREC='DSWEC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_DSWEC,IRESP)
- YREC='WATBUDC_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XAVG_WATBUDC,IRESP)
- ELSE
- DGEI%XRAINFALLC = 0.0
- DGEI%XSNOWFALLC = 0.0
- DGEI%XAVG_DWGC = 0.0
- DGEI%XAVG_DWGIC = 0.0
- DGEI%XAVG_DWRC = 0.0
- DGEI%XAVG_DSWEC = 0.0
- DGEI%XAVG_WATBUDC = 0.0
+#ifdef SFX_OL
+ IF(DE%LWATER_BUDGET .OR. (LRESTART .AND. .NOT.DGO%LRESET_BUDGETC))THEN
+#else
+ IF(DE%LWATER_BUDGET .OR. .NOT.DGO%LRESET_BUDGETC)THEN
+#endif
+ IF(IVERSION>7 .OR. IVERSION==7 .AND. IBUG>=3)THEN
+ YREC='RAINFC_ISBA'
+ CALL READ_SURF(HPROGRAM,YREC,DEC%XRAINFALL,IRESP)
+ YREC='SNOWFC_ISBA'
+ CALL READ_SURF(HPROGRAM,YREC,DEC%XSNOWFALL,IRESP)
+ ELSE
+ DEC%XRAINFALL = 0.0
+ DEC%XSNOWFALL = 0.0
+ ENDIF
ENDIF
!
- IF(DGI%LPATCH_BUDGET .AND. I%NPATCH>1)THEN
+ IF(DGO%LPATCH_BUDGET .AND. IO%NPATCH>1)THEN
+ !
+ !
+ IF (GDIM) THEN
+ YREC2=''
+ ELSEIF (IVERSION<7 .OR. IVERSION==7 .AND. IBUG<3) THEN
+ YREC2='PATCH'
+ ELSE
+ YREC2='P'
+ ENDIF
!
- CALL READ_SURF(&
- HPROGRAM,'VERSION',IVERSION,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'BUG ',IBUG,IRESP)
- YREC2=''
- IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUG<3) YREC2='ATCH'
- YREC='RNC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XRNC ,IRESP)
- YREC='HC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XHC ,IRESP)
- YREC='LEC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XLEC ,IRESP)
- YREC='LEIC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XLEIC ,IRESP)
- YREC='GFLUXC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XGFLUXC ,IRESP)
- YREC='LEGC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XLEGC ,IRESP)
- YREC='LEGIC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XLEGIC ,IRESP)
- YREC='LEVC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XLEVC ,IRESP)
- YREC='LESC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XLESAC ,IRESP)
- IF(I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO')THEN
+ ALLOCATE(ZWORK(KLU,IO%NPATCH))
+ !
+ !/////////////EVAP PATCH/////////////////////////////
+ !
+ YREC='LEGC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XLEG(:))
+ ENDDO
+ !
+ YREC='LEGIC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XLEGI(:))
+ ENDDO
+ !
+ YREC='LEVC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XLEV(:))
+ ENDDO
+
+ !
+ YREC='LESC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XLES(:))
+ ENDDO
+ !
+ IF(HSNOW_SCHEME=='3-L' .OR. HSNOW_SCHEME=='CRO')THEN
IF(IVERSION>7 .OR. IVERSION==7 .AND. IBUG>=3)THEN
- YREC='LESLC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XLESLC,IRESP)
+ !
+ YREC='LESLC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XLESL(:))
+ ENDDO
+ !
ELSE
- DGEI%XLESLC = 0.0
+ !
+ DO JP=1,IO%NPATCH
+ NDEC%AL(JP)%XLESL(:) = 0.0
+ ENDDO
+ !
ENDIF
+ !
IF(IVERSION>=8)THEN
- YREC='SNDRIFC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XSNDRIFTC,IRESP)
+ !
+ YREC='SNDRIFC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XSNDRIFT(:))
+ ENDDO
+ !
ELSE
- DGEI%XSNDRIFTC = 0.0
- ENDIF
- ELSE
- DGEI%XLESLC = 0.0
- DGEI%XSNDRIFTC = 0.0
- ENDIF
- YREC='LERC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XLERC ,IRESP)
- YREC='LETRC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XLETRC ,IRESP)
- YREC='EVAPC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XEVAPC ,IRESP)
- IF (IVERSION<8)THEN
- DGEI%XSUBLC = 0.0
+ !
+ DO JP=1,IO%NPATCH
+ NDEC%AL(JP)%XSNDRIFT(:) = 0.0
+ ENDDO
+ !
+ ENDIF
+ !
ELSE
- YREC='SUBLC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XSUBLC,IRESP)
- ENDIF
- YREC='DRAINC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XDRAINC ,IRESP)
- YREC='RUNOFFC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XRUNOFFC,IRESP)
- YREC='DRIVEGC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XDRIPC,IRESP)
- YREC='RRVEGC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XRRVEGC,IRESP)
- YREC='SNOMLTC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XMELTC,IRESP)
- !
- IF (ISIZE_LMEB_PATCH>0) THEN
- YREC='LEVCVC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XLEVCVC ,IRESP)
- YREC='LESCC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XLESCC ,IRESP)
-! YREC='LETRGVC_P'
-! CALL READ_SURF(HPROGRAM,YREC,XLETRGVC ,IRESP)
- YREC='LETRCVC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XLETRCVC ,IRESP)
-! YREC='LERGVC_P'
-! CALL READ_SURF(HPROGRAM,YREC,XLERGVC ,IRESP)
- YREC='LERCVC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XLERCVC ,IRESP)
- YREC='LE_C_AC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XLE_C_AC ,IRESP)
- YREC='LE_V_CC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XLE_V_CC ,IRESP)
- YREC='LE_G_CC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XLE_G_CC ,IRESP)
- YREC='LE_N_CC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XLE_N_CC ,IRESP)
!
- YREC='SWNT_VC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XSWNET_VC ,IRESP)
- YREC='SWNT_GC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XSWNET_GC ,IRESP)
- YREC='SWNT_NC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XSWNET_NC ,IRESP)
- YREC='SWNT_NSC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XSWNET_NSC ,IRESP)
- YREC='LWNT_VC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XLWNET_VC ,IRESP)
- YREC='LWNT_GC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XLWNET_GC ,IRESP)
- YREC='LWNT_NC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XLWNET_NC ,IRESP)
- YREC='SWDN_GNC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XSWDOWN_GNC ,IRESP)
- YREC='LWDN_GNC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XLWDOWN_GNC ,IRESP)
- YREC='H_V_CC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XH_V_CC ,IRESP)
- YREC='H_G_CC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XH_G_CC ,IRESP)
- YREC='H_C_AC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XH_C_AC ,IRESP)
- YREC='H_N_CC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XH_N_CC ,IRESP)
- YREC='SR_GNC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XSR_GNC ,IRESP)
- YREC='MELTCVC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XMELTCVC ,IRESP)
- YREC='FRZCVC_P'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGEI%XFRZCVC ,IRESP)
+ DO JP=1,IO%NPATCH
+ NDEC%AL(JP)%XLESL(:) = 0.0
+ NDEC%AL(JP)%XSNDRIFT(:) = 0.0
+ ENDDO
+ !
ENDIF
!
- IF((I%CRUNOFF=='SGH'.AND.I%CISBA=='DIF').AND.IVERSION>=8)THEN
- YREC='QSBC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XQSBC,IRESP)
+ YREC='LERC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XLER(:))
+ ENDDO
+ !
+ YREC='LETRC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XLETR(:))
+ ENDDO
+ !
+ YREC='EVAPC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDC%AL(JP)%XEVAP(:))
+ ENDDO
+ !
+ IF (IVERSION<8)THEN
+ DO JP=1,IO%NPATCH
+ NDC%AL(JP)%XSUBL(:) = 0.0
+ ENDDO
ELSE
- DGEI%XQSBC = 0.0
- ENDIF
+ YREC='SUBLC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDC%AL(JP)%XSUBL(:))
+ ENDDO
+ ENDIF
+ !
+ YREC='DRAINC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XDRAIN(:))
+ ENDDO
!
+ YREC='RUNOFFC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XRUNOFF(:))
+ ENDDO
+ !
+ YREC='DRIVEGC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XDRIP(:))
+ ENDDO
+ !
+ YREC='RRVEGC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XRRVEG(:))
+ ENDDO
+ !
+ YREC='SNOMLTC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XMELT(:))
+ ENDDO
+ !
IF (LAGRIP) THEN
- YREC='IRRIGC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XIRRIG_FLUXC,IRESP)
+ YREC='IRRIGC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XIRRIG_FLUX(:))
+ ENDDO
ELSE
- DGEI%XIRRIG_FLUXC = 0.0
+ DO JP=1,IO%NPATCH
+ NDEC%AL(JP)%XIRRIG_FLUX(:) = 0.0
+ ENDDO
ENDIF
!
- IF(I%CPHOTO/='NON' .AND. (IVERSION>7 .OR. IVERSION==7 .AND. IBUG>=3))THEN
- YREC='GPPC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XGPPC,IRESP)
- YREC='RC_AUTO_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XRESPC_AUTO,IRESP)
- YREC='RC_ECO_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XRESPC_ECO,IRESP)
+ IF(IO%CPHOTO/='NON' .AND. (IVERSION>7 .OR. IVERSION==7 .AND. IBUG>=3))THEN
+ YREC='GPPC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XGPP(:))
+ ENDDO
+ !
+ YREC='RC_AUTO_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XRESP_AUTO(:))
+ ENDDO
+ !
+ YREC='RC_ECO_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XRESP_ECO(:))
+ ENDDO
ELSE
- DGEI%XGPPC =0.0
- DGEI%XRESPC_AUTO=0.0
- DGEI%XRESPC_ECO =0.0
- ENDIF
+ DO JP=1,IO%NPATCH
+ NDEC%AL(JP)%XGPP(:) = 0.0
+ NDEC%AL(JP)%XRESP_AUTO(:) = 0.0
+ NDEC%AL(JP)%XRESP_ECO(:) = 0.0
+ ENDDO
+ ENDIF
!
- IF (DGI%LRAD_BUDGET) THEN
- YREC='SWDC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGI%XSWDC,IRESP)
- YREC='SWUC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGI%XSWUC,IRESP)
- YREC='LWDC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGI%XLWDC,IRESP)
- YREC='LWUC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGI%XLWUC,IRESP)
- ENDIF
- YREC='FMUC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGI%XFMUC,IRESP)
- YREC='FMVC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGI%XFMVC,IRESP)
- !
- IF(I%LGLACIER)THEN
- YREC='ICE_FC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XICEFLUXC,IRESP)
- ENDIF
- !
- IF(I%CHORT=='SGH'.OR.I%CISBA=='DIF')THEN
- YREC='HORTONC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XHORTC ,IRESP)
+ IF((IO%CRUNOFF=='SGH'.AND.IO%CISBA=='DIF').AND.IVERSION>=8)THEN
+ YREC='QSBC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XQSB(:))
+ ENDDO
ELSE
- DGEI%XHORTC = 0.0
+ DE%XQSB = 0.0
ENDIF
!
- IF(I%LFLOOD)THEN
- YREC='IFLOODC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XIFLOODC,IRESP)
- YREC='PFLOODC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XPFLOODC,IRESP)
- YREC='LEFC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XLE_FLOODC,IRESP)
- YREC='LEIFC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XLEI_FLOODC,IRESP)
+ IF(IO%CHORT=='SGH'.OR.IO%CISBA=='DIF')THEN
+ YREC='HORTONC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XHORT(:))
+ ENDDO
ELSE
- DGEI%XIFLOODC = 0.0
- DGEI%XPFLOODC = 0.0
- DGEI%XLE_FLOODC = 0.0
- DGEI%XLEI_FLOODC = 0.0
+ DO JP=1,IO%NPATCH
+ NDEC%AL(JP)%XHORT(:) = 0.0
+ ENDDO
ENDIF
- !
- IF(DGEI%LWATER_BUDGET .AND. (IVERSION>7 .OR. IVERSION==7 .AND. IBUG>=3))THEN
- YREC='DWGC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XDWGC,IRESP)
- YREC='DWGIC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XDWGIC,IRESP)
- YREC='DWRC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XDWRC,IRESP)
- YREC='DSWEC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XDSWEC,IRESP)
- YREC='WATBUDC_P'
- CALL READ_SURF(&
- HPROGRAM,TRIM(YREC)//YREC2,DGEI%XWATBUDC,IRESP)
+ !
+ IF(IO%LFLOOD)THEN
+ YREC='IFLOODC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XIFLOOD(:))
+ ENDDO
+ !
+ YREC='PFLOODC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XPFLOOD(:))
+ ENDDO
+ !
+ YREC='LEFC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XLE_FLOOD(:))
+ ENDDO
+ !
+ YREC='LEIFC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XLEI_FLOOD(:))
+ ENDDO
ELSE
- DGEI%XDWGC = 0.0
- DGEI%XDWGIC = 0.0
- DGEI%XDWRC = 0.0
- DGEI%XDSWEC = 0.0
- DGEI%XWATBUDC = 0.0
+ DO JP=1,IO%NPATCH
+ NDEC%AL(JP)%XIFLOOD(:) = 0.0
+ NDEC%AL(JP)%XPFLOOD(:) = 0.0
+ NDEC%AL(JP)%XLE_FLOOD(:) = 0.0
+ NDEC%AL(JP)%XLEI_FLOOD(:) = 0.0
+ ENDDO
+ ENDIF
+ !
+ !
+ IF (ISIZE_LMEB_PATCH>0) THEN
+ !
+ YREC='LEV_CVC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XLEV_CV(:))
+ ENDDO
+ !
+ YREC='LES_CVC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XLES_CV(:))
+ ENDDO
+ !
+ YREC='LETR_CVC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XLETR_CV(:))
+ ENDDO
+ !
+ YREC='LER_CVC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XLER_CV(:))
+ ENDDO
+ !
+ YREC='LE_CVC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XLE_CV(:))
+ ENDDO
+ !
+ YREC='H_CVC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XH_CV(:))
+ ENDDO
+ !
+ YREC='MELT_CVC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XMELT_CV(:))
+ ENDDO
+ !
+ YREC='FRZ_CVC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XFRZ_CV(:))
+ ENDDO
+ !
+ YREC='LE_GVC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XLE_GV(:))
+ ENDDO
+ !
+ YREC='H_GVC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XH_GV(:))
+ ENDDO
+ !
+ YREC='LE_GNC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XLE_GN(:))
+ ENDDO
+ !
+ YREC='H_GNC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XH_GN(:))
+ ENDDO
+ !
+ YREC='SR_GNC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XSR_GN(:))
+ ENDDO
+ !
+ YREC='SWDN_GNC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XSWDOWN_GN(:))
+ ENDDO
+ !
+ YREC='LWDN_GNC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XLWDOWN_GN(:))
+ ENDDO
+ !
+ YREC='LE_CAC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XLE_CA(:))
+ ENDDO
+ !
+ YREC='H_CAC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XH_CA(:))
+ ENDDO
+ !
+ YREC='SWNT_VC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XSWNET_V(:))
+ ENDDO
+ !
+ YREC='SWNT_GC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XSWNET_G(:))
+ ENDDO
+ !
+ YREC='SWNT_NC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XSWNET_N(:))
+ ENDDO
+ !
+ YREC='SWNT_NSC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XSWNET_NS(:))
+ ENDDO
+ !
+ YREC='LWNT_VC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XLWNET_V(:))
+ ENDDO
+ !
+ YREC='LWNT_GC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XLWNET_G(:))
+ ENDDO
+ !
+ YREC='LWNT_NC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XLWNET_N(:))
+ ENDDO
+ !
ENDIF
!
- ELSE
+ YREC='RNC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDC%AL(JP)%XRN(:))
+ ENDDO
!
- DGEI%XRNC = 0.0
- DGEI%XHC = 0.0
- DGEI%XLEC = 0.0
- DGEI%XLEIC = 0.0
- DGEI%XGFLUXC = 0.0
- DGEI%XLEGC = 0.0
- DGEI%XLEGIC = 0.0
- DGEI%XLEVC = 0.0
- DGEI%XLESAC = 0.0
- DGEI%XLESLC = 0.0
- DGEI%XLERC = 0.0
- DGEI%XLETRC = 0.0
- DGEI%XEVAPC = 0.0
- DGEI%XSUBLC = 0.0
- DGEI%XSNDRIFTC = 0.0
- DGEI%XDRAINC = 0.0
- DGEI%XQSBC = 0.0
- DGEI%XRUNOFFC = 0.0
- DGEI%XHORTC = 0.0
- DGEI%XDRIPC = 0.0
- DGEI%XRRVEGC = 0.0
- DGEI%XMELTC = 0.0
- DGEI%XIRRIG_FLUXC = 0.0
- DGEI%XGPPC = 0.0
- DGEI%XRESPC_AUTO = 0.0
- DGEI%XRESPC_ECO = 0.0
- DGEI%XIFLOODC = 0.0
- DGEI%XPFLOODC = 0.0
- DGEI%XLE_FLOODC = 0.0
- DGEI%XLEI_FLOODC = 0.0
- !
- IF (ISIZE_LMEB_PATCH>0) THEN
- DGEI%XLEVCVC = 0.0
- DGEI%XLESCC = 0.0
-! XLETRGVC = 0.0
- DGEI%XLETRCVC = 0.0
-! XLERGVC = 0.0
- DGEI%XLERCVC = 0.0
- DGEI%XLE_C_AC = 0.0
- DGEI%XLE_V_CC = 0.0
- DGEI%XLE_G_CC = 0.0
- DGEI%XLE_N_CC = 0.0
+ YREC='HC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDC%AL(JP)%XH(:))
+ ENDDO
+ !
+ YREC='LEC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDC%AL(JP)%XLE(:))
+ ENDDO
+ !
+ YREC='LEIC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDC%AL(JP)%XLEI(:))
+ ENDDO
+ !
+ YREC='GFLUXC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDC%AL(JP)%XGFLUX(:))
+ ENDDO
+ !
+ IF (DGO%LRAD_BUDGET) THEN
+ !
+ YREC='SWDC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDC%AL(JP)%XSWD(:))
+ ENDDO
!
- DGEI%XSWNET_VC = 0.0
- DGEI%XSWNET_GC = 0.0
- DGEI%XSWNET_NC = 0.0
- DGEI%XSWNET_NSC = 0.0
- DGEI%XLWNET_VC = 0.0
- DGEI%XLWNET_GC = 0.0
- DGEI%XLWNET_NC = 0.0
- DGEI%XSWDOWN_GNC = 0.0
- DGEI%XLWDOWN_GNC = 0.0
- DGEI%XH_V_CC = 0.0
- DGEI%XH_G_CC = 0.0
- DGEI%XH_C_AC = 0.0
- DGEI%XH_N_CC = 0.0
- DGEI%XSR_GNC = 0.0
- DGEI%XMELTCVC = 0.0
- DGEI%XFRZCVC = 0.0
+ YREC='SWUC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDC%AL(JP)%XSWU(:))
+ ENDDO
+ !
+ YREC='LWDC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDC%AL(JP)%XLWD(:))
+ ENDDO
+ !
+ YREC='LWUC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDC%AL(JP)%XLWU(:))
+ ENDDO
+ !
ENDIF
!
- DGI%XSWDC = 0.0
- DGI%XSWUC = 0.0
- DGI%XLWDC = 0.0
- DGI%XLWUC = 0.0
- DGI%XFMUC = 0.0
- DGI%XFMVC = 0.0
+ YREC='FMUC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDC%AL(JP)%XFMU(:))
+ ENDDO
+ !
+ YREC='FMVC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDC%AL(JP)%XFMV(:))
+ ENDDO
!
- IF(I%LGLACIER)THEN
- DGEI%XICEFLUXC=0.0
+ IF(IO%LGLACIER)THEN
+ YREC='ICE_FC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XICEFLUX(:))
+ ENDDO
ENDIF
- !
- IF(DGEI%LWATER_BUDGET)THEN
- DGEI%XDWGC = 0.0
- DGEI%XDWGIC = 0.0
- DGEI%XDWRC = 0.0
- DGEI%XDSWEC = 0.0
- DGEI%XWATBUDC = 0.0
+ !
+ !
+#ifdef SFX_OL
+ IF(DE%LWATER_BUDGET .OR. (LRESTART .AND. .NOT.DGO%LRESET_BUDGETC))THEN
+#else
+ IF(DE%LWATER_BUDGET .OR. .NOT.DGO%LRESET_BUDGETC)THEN
+#endif
+ IF(IVERSION>7 .OR. IVERSION==7 .AND. IBUG>=3)THEN
+ !
+ YREC='DWGC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XDWG(:))
+ ENDDO
+ !
+ YREC='DWGIC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XDWGI(:))
+ ENDDO
+ !
+ YREC='DWRC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XDWR(:))
+ ENDDO
+ !
+ YREC='DSWEC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XDSWE(:))
+ ENDDO
+ !
+ YREC='WATBUDC_'//YREC2
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YREC, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NDEC%AL(JP)%XWATBUD(:))
+ ENDDO
+ !
+ ELSE
+ !
+ DO JP=1,IO%NPATCH
+ CALL INIT_WATER_BUD(NDEC%AL(JP))
+ ENDDO
+ !
+ ENDIF
+ !
+ DEALLOCATE(ZWORK)
+ !
+ ELSE
+ !
+ DO JP=1,IO%NPATCH
+ !
+ CALL INIT_EVAP_BUD(NDEC%AL(JP))
+ !
+ IF (ISIZE_LMEB_PATCH>0) THEN
+ CALL INIT_MEB_BUD(NDEC%AL(JP))
+ ENDIF
+ !
+ CALL INIT_SURF_BUD(DC,0.)
+ DC%XEVAP = 0.
+ DC%XSUBL = 0.
+ !
+ ENDDO
+ !
+ IF(IO%LGLACIER)THEN
+ DO JP=1,IO%NPATCH
+ NDEC%AL(JP)%XICEFLUX=0.0
+ ENDDO
+ ENDIF
+ !
+#ifdef SFX_OL
+ IF(DE%LWATER_BUDGET .OR. (LRESTART .AND. .NOT.DGO%LRESET_BUDGETC))THEN
+#else
+ IF(DE%LWATER_BUDGET .OR. .NOT.DGO%LRESET_BUDGETC)THEN
+#endif
+ !
+ DO JP=1,IO%NPATCH
+ CALL INIT_WATER_BUD(NDEC%AL(JP))
+ ENDDO
+ !
+ ENDIF
+ !
ENDIF
- !
+ !
ENDIF
!
ENDIF
+ !
ELSE
- ALLOCATE(DGEI%XAVG_RNC (0))
- ALLOCATE(DGEI%XAVG_HC (0))
- ALLOCATE(DGEI%XAVG_LEC (0))
- ALLOCATE(DGEI%XAVG_LEIC (0))
- ALLOCATE(DGEI%XAVG_GFLUXC (0))
- ALLOCATE(DGEI%XAVG_LEGC (0))
- ALLOCATE(DGEI%XAVG_LEGIC (0))
- ALLOCATE(DGEI%XAVG_LEVC (0))
- ALLOCATE(DGEI%XAVG_LESAC (0))
- ALLOCATE(DGEI%XAVG_LESLC (0))
- ALLOCATE(DGEI%XAVG_LERC (0))
- ALLOCATE(DGEI%XAVG_LETRC (0))
- ALLOCATE(DGEI%XAVG_EVAPC (0))
- ALLOCATE(DGEI%XAVG_SUBLC (0))
- ALLOCATE(DGEI%XAVG_SNDRIFTC (0))
- ALLOCATE(DGEI%XAVG_DRAINC (0))
- ALLOCATE(DGEI%XAVG_QSBC (0))
- ALLOCATE(DGEI%XAVG_RUNOFFC (0))
- ALLOCATE(DGEI%XAVG_HORTC (0))
- ALLOCATE(DGEI%XAVG_DRIPC (0))
- ALLOCATE(DGEI%XAVG_RRVEGC (0))
- ALLOCATE(DGEI%XAVG_MELTC (0))
- ALLOCATE(DGEI%XAVG_IRRIG_FLUXC(0))
- ALLOCATE(DGEI%XAVG_GPPC (0))
- ALLOCATE(DGEI%XAVG_RESPC_AUTO (0))
- ALLOCATE(DGEI%XAVG_RESPC_ECO (0))
- ALLOCATE(DGEI%XAVG_IFLOODC (0))
- ALLOCATE(DGEI%XAVG_PFLOODC (0))
- ALLOCATE(DGEI%XAVG_LE_FLOODC (0))
- ALLOCATE(DGEI%XAVG_LEI_FLOODC (0))
-
-!
- ALLOCATE(DGEI%XRNC (0,0))
- ALLOCATE(DGEI%XHC (0,0))
- ALLOCATE(DGEI%XLEC (0,0))
- ALLOCATE(DGEI%XLEIC (0,0))
- ALLOCATE(DGEI%XGFLUXC (0,0))
- ALLOCATE(DGEI%XLEGC (0,0))
- ALLOCATE(DGEI%XLEGIC (0,0))
- ALLOCATE(DGEI%XLEVC (0,0))
- ALLOCATE(DGEI%XLESAC (0,0))
- ALLOCATE(DGEI%XLESLC (0,0))
- ALLOCATE(DGEI%XLERC (0,0))
- ALLOCATE(DGEI%XLETRC (0,0))
- ALLOCATE(DGEI%XEVAPC (0,0))
- ALLOCATE(DGEI%XSUBLC (0,0))
- ALLOCATE(DGEI%XSNDRIFTC (0,0))
- ALLOCATE(DGEI%XDRAINC (0,0))
- ALLOCATE(DGEI%XQSBC (0,0))
- ALLOCATE(DGEI%XRUNOFFC (0,0))
- ALLOCATE(DGEI%XHORTC (0,0))
- ALLOCATE(DGEI%XDRIPC (0,0))
- ALLOCATE(DGEI%XRRVEGC (0,0))
- ALLOCATE(DGEI%XMELTC (0,0))
- ALLOCATE(DGEI%XIRRIG_FLUXC(0,0))
- ALLOCATE(DGEI%XGPPC (0,0))
- ALLOCATE(DGEI%XRESPC_AUTO (0,0))
- ALLOCATE(DGEI%XRESPC_ECO (0,0))
- ALLOCATE(DGEI%XIFLOODC (0,0))
- ALLOCATE(DGEI%XPFLOODC (0,0))
- ALLOCATE(DGEI%XLE_FLOODC (0,0))
- ALLOCATE(DGEI%XLEI_FLOODC (0,0))
-!
- ALLOCATE(DGI%XAVG_SWDC (0))
- ALLOCATE(DGI%XAVG_SWUC (0))
- ALLOCATE(DGI%XAVG_LWDC (0))
- ALLOCATE(DGI%XAVG_LWUC (0))
- ALLOCATE(DGI%XAVG_FMUC (0))
- ALLOCATE(DGI%XAVG_FMVC (0))
- ALLOCATE(DGI%XSWDC (0,0))
- ALLOCATE(DGI%XSWUC (0,0))
- ALLOCATE(DGI%XLWDC (0,0))
- ALLOCATE(DGI%XLWUC (0,0))
- ALLOCATE(DGI%XFMUC (0,0))
- ALLOCATE(DGI%XFMVC (0,0))
- !
- ALLOCATE(DGEI%XRAINFALLC (0))
- ALLOCATE(DGEI%XSNOWFALLC (0))
- ALLOCATE(DGEI%XAVG_DWGC (0))
- ALLOCATE(DGEI%XAVG_DWGIC (0))
- ALLOCATE(DGEI%XAVG_DWRC (0))
- ALLOCATE(DGEI%XAVG_DSWEC (0))
- ALLOCATE(DGEI%XAVG_WATBUDC(0))
- !
- ALLOCATE(DGEI%XDWGC (0,0))
- ALLOCATE(DGEI%XDWGIC (0,0))
- ALLOCATE(DGEI%XDWRC (0,0))
- ALLOCATE(DGEI%XDSWEC (0,0))
- ALLOCATE(DGEI%XWATBUDC(0,0))
- !
- ALLOCATE(DGEI%XAVG_LEVCVC (0))
- ALLOCATE(DGEI%XAVG_LESCC (0))
- ALLOCATE(DGEI%XAVG_LETRGVC (0))
- ALLOCATE(DGEI%XAVG_LETRCVC (0))
- ALLOCATE(DGEI%XAVG_LERGVC (0))
- ALLOCATE(DGEI%XAVG_LERCVC (0))
- ALLOCATE(DGEI%XAVG_LE_C_AC (0))
- ALLOCATE(DGEI%XAVG_LE_V_CC (0))
- ALLOCATE(DGEI%XAVG_LE_G_CC (0))
- ALLOCATE(DGEI%XAVG_LE_N_CC (0))
- !
- ALLOCATE(DGEI%XAVG_SWNET_VC (0))
- ALLOCATE(DGEI%XAVG_SWNET_GC (0))
- ALLOCATE(DGEI%XAVG_SWNET_NC (0))
- ALLOCATE(DGEI%XAVG_SWNET_NSC (0))
- ALLOCATE(DGEI%XAVG_LWNET_VC (0))
- ALLOCATE(DGEI%XAVG_LWNET_GC (0))
- ALLOCATE(DGEI%XAVG_LWNET_NC (0))
- ALLOCATE(DGEI%XAVG_SWDOWN_GNC (0))
- ALLOCATE(DGEI%XAVG_LWDOWN_GNC (0))
- ALLOCATE(DGEI%XAVG_H_V_CC (0))
- ALLOCATE(DGEI%XAVG_H_G_CC (0))
- ALLOCATE(DGEI%XAVG_H_C_AC (0))
- ALLOCATE(DGEI%XAVG_H_N_CC (0))
- ALLOCATE(DGEI%XAVG_SR_GNC (0))
- ALLOCATE(DGEI%XAVG_MELTCVC (0))
- ALLOCATE(DGEI%XAVG_FRZCVC (0))
- !
- ALLOCATE(DGEI%XLEVCVC (0,0))
- ALLOCATE(DGEI%XLESCC (0,0))
-! ALLOCATE(XLETRGVC (0,0))
- ALLOCATE(DGEI%XLETRCVC (0,0))
-! ALLOCATE(XLERGVC (0,0))
- ALLOCATE(DGEI%XLERCVC (0,0))
- ALLOCATE(DGEI%XLE_C_AC (0,0))
- ALLOCATE(DGEI%XLE_V_CC (0,0))
- ALLOCATE(DGEI%XLE_G_CC (0,0))
- ALLOCATE(DGEI%XLE_N_CC (0,0))
- !
- ALLOCATE(DGEI%XSWNET_VC (0,0))
- ALLOCATE(DGEI%XSWNET_GC (0,0))
- ALLOCATE(DGEI%XSWNET_NC (0,0))
- ALLOCATE(DGEI%XSWNET_NSC (0,0))
- ALLOCATE(DGEI%XLWNET_VC (0,0))
- ALLOCATE(DGEI%XLWNET_GC (0,0))
- ALLOCATE(DGEI%XLWNET_NC (0,0))
- ALLOCATE(DGEI%XSWDOWN_GNC (0,0))
- ALLOCATE(DGEI%XLWDOWN_GNC (0,0))
- ALLOCATE(DGEI%XH_V_CC (0,0))
- ALLOCATE(DGEI%XH_G_CC (0,0))
- ALLOCATE(DGEI%XH_C_AC (0,0))
- ALLOCATE(DGEI%XH_N_CC (0,0))
- ALLOCATE(DGEI%XSR_GNC (0,0))
- ALLOCATE(DGEI%XMELTCVC (0,0))
- ALLOCATE(DGEI%XFRZCVC (0,0))
+ !
+ CALL ALLOC_SURF_BUD(DC,0,0,0)
+ ALLOCATE(DC%XEVAP(0))
+ ALLOCATE(DC%XSUBL(0))
+ !
+ CALL ALLOC_EVAP_BUD(DEC,0,0)
+ !
+ DO JP=1,IO%NPATCH
+ !
+ CALL ALLOC_SURF_BUD(NDC%AL(JP),0,0,0)
+ ALLOCATE(NDC%AL(JP)%XEVAP(0))
+ ALLOCATE(NDC%AL(JP)%XSUBL(0))
+ !
+ CALL ALLOC_EVAP_BUD(NDEC%AL(JP),0,0)
+ !
+ ENDDO
!
ENDIF
!
-IF(.NOT.I%LGLACIER)THEN
- ALLOCATE(DGEI%XAVG_ICEFLUXC(0))
- ALLOCATE(DGEI%XICEFLUXC(0,0))
+#ifdef SFX_OL
+IF(.NOT.GCUMUL .AND. (.NOT.DE%LWATER_BUDGET .OR. .NOT.LRESTART .OR. DGO%LRESET_BUDGETC))THEN
+#else
+IF(.NOT.GCUMUL .AND. (.NOT.DE%LWATER_BUDGET .OR. DGO%LRESET_BUDGETC))THEN
+#endif
+ !
+ ALLOCATE(DEC%XRAINFALL (0))
+ ALLOCATE(DEC%XSNOWFALL (0))
+ !
+ CALL ALLOC_WATER_BUD(DEC,0)
+ DO JP=1,IO%NPATCH
+ CALL ALLOC_WATER_BUD(NDEC%AL(JP),0)
+ ENDDO
+ !
ENDIF
!
+IF (.NOT.GCUMUL .OR. ISIZE_LMEB_PATCH<=0) THEN
+ !
+ CALL ALLOC_MEB_BUD(DEC,0)
+ DO JP=1,IO%NPATCH
+ CALL ALLOC_MEB_BUD(NDEC%AL(JP),0)
+ ENDDO
+ !
+ENDIF
!
-!* surface temperature and parameters at 2m
-!
-ALLOCATE(DGI%XTS (KLU,I%NPATCH))
-ALLOCATE(DGI%XAVG_TS(KLU))
-DGI%XTS = XUNDEF
-DGI%XAVG_TS = XUNDEF
-ALLOCATE(DGI%XTSRAD (KLU,I%NPATCH))
-DGI%XTSRAD = XUNDEF
-!
-IF (DGI%N2M>=1) THEN
- ALLOCATE(DGI%XAVG_RI (KLU))
- ALLOCATE(DGI%XAVG_T2M (KLU))
- ALLOCATE(DGI%XAVG_T2M_MIN (KLU))
- ALLOCATE(DGI%XAVG_T2M_MAX (KLU))
- ALLOCATE(DGI%XAVG_Q2M (KLU))
- ALLOCATE(DGI%XAVG_HU2M (KLU))
- ALLOCATE(DGI%XAVG_HU2M_MIN (KLU))
- ALLOCATE(DGI%XAVG_HU2M_MAX (KLU))
- ALLOCATE(DGI%XAVG_ZON10M (KLU))
- ALLOCATE(DGI%XAVG_MER10M (KLU))
- ALLOCATE(DGI%XAVG_WIND10M (KLU))
- ALLOCATE(DGI%XAVG_WIND10M_MAX (KLU))
- ALLOCATE(DGI%XAVG_SFCO2 (KLU))
- DGI%XAVG_RI = XUNDEF
- DGI%XAVG_T2M = XUNDEF
- DGI%XAVG_T2M_MIN = XUNDEF
- DGI%XAVG_T2M_MAX = -XUNDEF
- DGI%XAVG_Q2M = XUNDEF
- DGI%XAVG_HU2M = XUNDEF
- DGI%XAVG_HU2M_MIN= XUNDEF
- DGI%XAVG_HU2M_MAX= -XUNDEF
- DGI%XAVG_ZON10M = XUNDEF
- DGI%XAVG_MER10M = XUNDEF
- DGI%XAVG_WIND10M = XUNDEF
- DGI%XAVG_WIND10M_MAX = 0.0
- DGI%XAVG_SFCO2 = XUNDEF
- !
- ALLOCATE(DGI%XRI (KLU,I%NPATCH))
- ALLOCATE(DGI%XT2M (KLU,I%NPATCH))
- ALLOCATE(DGI%XQ2M (KLU,I%NPATCH))
- ALLOCATE(DGI%XHU2M (KLU,I%NPATCH))
- ALLOCATE(DGI%XZON10M (KLU,I%NPATCH))
- ALLOCATE(DGI%XMER10M (KLU,I%NPATCH))
- ALLOCATE(DGI%XWIND10M(KLU,I%NPATCH))
- ALLOCATE(DGI%XT2M_MIN(KLU,I%NPATCH))
- ALLOCATE(DGI%XT2M_MAX(KLU,I%NPATCH))
- !
- DGI%XRI = XUNDEF
- DGI%XT2M = XUNDEF
- DGI%XQ2M = XUNDEF
- DGI%XHU2M = XUNDEF
- DGI%XZON10M = XUNDEF
- DGI%XMER10M = XUNDEF
- DGI%XWIND10M = XUNDEF
- DGI%XT2M_MIN = XUNDEF
- DGI%XT2M_MAX = 0.0
-ELSE
- ALLOCATE(DGI%XAVG_RI (0))
- ALLOCATE(DGI%XAVG_T2M (0))
- ALLOCATE(DGI%XAVG_T2M_MIN (0))
- ALLOCATE(DGI%XAVG_T2M_MAX (0))
- ALLOCATE(DGI%XAVG_Q2M (0))
- ALLOCATE(DGI%XAVG_HU2M (0))
- ALLOCATE(DGI%XAVG_HU2M_MIN (0))
- ALLOCATE(DGI%XAVG_HU2M_MAX (0))
- ALLOCATE(DGI%XAVG_ZON10M (0))
- ALLOCATE(DGI%XAVG_MER10M (0))
- ALLOCATE(DGI%XAVG_WIND10M (0))
- ALLOCATE(DGI%XAVG_WIND10M_MAX (0))
-!
- ALLOCATE(DGI%XRI (0,0))
- ALLOCATE(DGI%XT2M (0,0))
- ALLOCATE(DGI%XQ2M (0,0))
- ALLOCATE(DGI%XHU2M (0,0))
- ALLOCATE(DGI%XZON10M (0,0))
- ALLOCATE(DGI%XMER10M (0,0))
- ALLOCATE(DGI%XWIND10M(0,0))
- ALLOCATE(DGI%XT2M_MIN(0,0))
- ALLOCATE(DGI%XT2M_MAX(0,0))
-END IF
+IF(.NOT.IO%LGLACIER)THEN
+ ALLOCATE(DEC%XICEFLUX(0))
+ DO JP=1,IO%NPATCH
+ ALLOCATE(NDEC%AL(JP)%XICEFLUX(0))
+ ENDDO
+ENDIF
!
!* miscellaneous surface fields
!
-IF (DGMI%LSURF_MISC_BUDGET) THEN
- ALLOCATE(DGMI%XAVG_HV (KLU))
- ALLOCATE(DGMI%XAVG_PSNG (KLU))
- ALLOCATE(DGMI%XAVG_PSNV (KLU))
- ALLOCATE(DGMI%XAVG_PSN (KLU))
- ALLOCATE(DGMI%XAVG_ALBT (KLU))
- ALLOCATE(DGMI%XAVG_LAI (KLU))
- !
- ALLOCATE(DGMI%XAVG_FSAT (KLU))
- ALLOCATE(DGMI%XAVG_FFG (KLU))
- ALLOCATE(DGMI%XAVG_FFV (KLU))
- ALLOCATE(DGMI%XAVG_FF (KLU))
- !
- ALLOCATE(DGMI%XSOIL_TSWI (KLU))
- ALLOCATE(DGMI%XSOIL_SWI (KLU))
- ALLOCATE(DGMI%XSOIL_TWG (KLU))
- ALLOCATE(DGMI%XSOIL_TWGI (KLU))
- ALLOCATE(DGMI%XSOIL_WG (KLU))
- ALLOCATE(DGMI%XSOIL_WGI (KLU))
- ALLOCATE(DGMI%XAVG_SWI (KLU,I%NGROUND_LAYER))
- ALLOCATE(DGMI%XAVG_TSWI (KLU,I%NGROUND_LAYER))
- !
- ALLOCATE(DGMI%XAVG_TWSNOW (KLU))
- ALLOCATE(DGMI%XAVG_TDSNOW (KLU))
- ALLOCATE(DGMI%XAVG_TTSNOW (KLU))
- !
- DGMI%XAVG_HV = XUNDEF
- DGMI%XAVG_SWI = XUNDEF
- DGMI%XAVG_TSWI = XUNDEF
- DGMI%XSOIL_TSWI = XUNDEF
- DGMI%XSOIL_SWI = XUNDEF
- DGMI%XSOIL_TWG = XUNDEF
- DGMI%XSOIL_TWGI = XUNDEF
- DGMI%XSOIL_WG = XUNDEF
- DGMI%XSOIL_WGI = XUNDEF
- DGMI%XAVG_PSNG = XUNDEF
- DGMI%XAVG_PSNV = XUNDEF
- DGMI%XAVG_PSN = XUNDEF
- DGMI%XAVG_ALBT = XUNDEF
- DGMI%XAVG_LAI = XUNDEF
- DGMI%XAVG_FSAT = XUNDEF
- DGMI%XAVG_FFG = XUNDEF
- DGMI%XAVG_FFV = XUNDEF
- DGMI%XAVG_FF = XUNDEF
- DGMI%XAVG_TWSNOW = XUNDEF
- DGMI%XAVG_TDSNOW = XUNDEF
- DGMI%XAVG_TTSNOW = XUNDEF
- !
- ALLOCATE(DGMI%XHV (KLU,I%NPATCH))
- ALLOCATE(DGMI%XSWI (KLU,I%NGROUND_LAYER,I%NPATCH))
- ALLOCATE(DGMI%XTSWI (KLU,I%NGROUND_LAYER,I%NPATCH))
- ALLOCATE(DGMI%XTWSNOW (KLU,I%NPATCH))
- ALLOCATE(DGMI%XTDSNOW (KLU,I%NPATCH))
- ALLOCATE(DGMI%XTTSNOW (KLU,I%NPATCH))
- ALLOCATE(DGMI%XDPSNG (KLU,I%NPATCH))
- ALLOCATE(DGMI%XDPSNV (KLU,I%NPATCH))
- ALLOCATE(DGMI%XDPSN (KLU,I%NPATCH))
- ALLOCATE(DGMI%XALBT (KLU,I%NPATCH))
- !
- ALLOCATE(DGMI%XDFSAT (KLU,I%NPATCH))
- ALLOCATE(DGMI%XDFFG (KLU,I%NPATCH))
- ALLOCATE(DGMI%XDFFV (KLU,I%NPATCH))
- ALLOCATE(DGMI%XDFF (KLU,I%NPATCH))
- !
- ALLOCATE(DGMI%XSNOWLIQ (KLU,I%TSNOW%NLAYER,I%NPATCH))
- ALLOCATE(DGMI%XSNOWTEMP (KLU,I%TSNOW%NLAYER,I%NPATCH))
- !
- DGMI%XHV = XUNDEF
- DGMI%XSWI = XUNDEF
- DGMI%XTSWI = XUNDEF
- DGMI%XTWSNOW = XUNDEF
- DGMI%XTDSNOW = XUNDEF
- DGMI%XTTSNOW = XUNDEF
- DGMI%XDPSNG = XUNDEF
- DGMI%XDPSNV = XUNDEF
- DGMI%XDPSN = XUNDEF
- DGMI%XALBT = XUNDEF
- DGMI%XDFSAT = XUNDEF
- DGMI%XDFFG = XUNDEF
- DGMI%XDFFV = XUNDEF
- DGMI%XDFF = XUNDEF
- DGMI%XSNOWLIQ = XUNDEF
- DGMI%XSNOWTEMP= XUNDEF
- !
- IF(I%CISBA=='DIF'.AND.DGMI%LSURF_MISC_DIF)THEN
- ALLOCATE(DGMI%XFRD2_TSWI(KLU))
- ALLOCATE(DGMI%XFRD2_TWG (KLU))
- ALLOCATE(DGMI%XFRD2_TWGI(KLU))
- ALLOCATE(DGMI%XFRD3_TSWI(KLU))
- ALLOCATE(DGMI%XFRD3_TWG (KLU))
- ALLOCATE(DGMI%XFRD3_TWGI(KLU))
- DGMI%XFRD2_TSWI = XUNDEF
- DGMI%XFRD2_TWG = XUNDEF
- DGMI%XFRD2_TWGI = XUNDEF
- DGMI%XFRD3_TSWI = XUNDEF
- DGMI%XFRD3_TWG = XUNDEF
- DGMI%XFRD3_TWGI = XUNDEF
- ENDIF
+IF (YDM%LSURF_MISC_BUDGET) THEN
!
- IF(I%CISBA=='DIF')THEN
- ALLOCATE(DGMI%XALT(KLU,I%NPATCH))
- ALLOCATE(DGMI%XFLT(KLU,I%NPATCH))
- ALLOCATE(DGMI%XAVG_ALT(KLU))
- ALLOCATE(DGMI%XAVG_FLT(KLU))
- DGMI%XALT = XUNDEF
- DGMI%XFLT = XUNDEF
- DGMI%XAVG_ALT = XUNDEF
- DGMI%XAVG_FLT = XUNDEF
- ENDIF
- !
- IF (I%LTR_ML) THEN
- ALLOCATE (DGMI%XFAPAR (KLU, I%NPATCH))
- ALLOCATE (DGMI%XFAPIR (KLU, I%NPATCH))
- ALLOCATE (DGMI%XFAPAR_BS (KLU, I%NPATCH))
- ALLOCATE (DGMI%XFAPIR_BS (KLU, I%NPATCH))
- ALLOCATE (DGMI%XDFAPARC (KLU, I%NPATCH))
- ALLOCATE (DGMI%XDFAPIRC (KLU, I%NPATCH))
- ALLOCATE (DGMI%XDLAI_EFFC (KLU, I%NPATCH))
- !
- DGMI%XFAPAR = XUNDEF
- DGMI%XFAPIR = XUNDEF
- DGMI%XFAPAR_BS = XUNDEF
- DGMI%XFAPIR_BS = XUNDEF
- DGMI%XDFAPARC = 0.
- DGMI%XDFAPIRC = 0.
- DGMI%XDLAI_EFFC = 0.
- ENDIF
+ CALL ALLOC_MISC_BUD(DM,KLU,0,IO%NGROUND_LAYER,0,DM%LPROSNOW)
+ DO JP=1,IO%NPATCH
+ CALL ALLOC_MISC_BUD(NDM%AL(JP),NP%AL(JP)%NSIZE_P,NP%AL(JP)%NSIZE_P,&
+ IO%NGROUND_LAYER,KSNOW_NLAYER,DM%LPROSNOW)
+ ENDDO
!
ELSE
- ALLOCATE(DGMI%XAVG_HV (0))
- ALLOCATE(DGMI%XAVG_PSNG (0))
- ALLOCATE(DGMI%XAVG_PSNV (0))
- ALLOCATE(DGMI%XAVG_PSN (0))
- ALLOCATE(DGMI%XAVG_ALBT (0))
- ALLOCATE(DGMI%XAVG_LAI (0))
-!
- ALLOCATE(DGMI%XAVG_FSAT (0))
- ALLOCATE(DGMI%XAVG_FFG (0))
- ALLOCATE(DGMI%XAVG_FFV (0))
- ALLOCATE(DGMI%XAVG_FF (0))
-!
- ALLOCATE(DGMI%XSOIL_TSWI (0))
- ALLOCATE(DGMI%XSOIL_SWI (0))
- ALLOCATE(DGMI%XSOIL_TWG (0))
- ALLOCATE(DGMI%XSOIL_TWGI (0))
- ALLOCATE(DGMI%XSOIL_WG (0))
- ALLOCATE(DGMI%XSOIL_WGI (0))
- ALLOCATE(DGMI%XAVG_SWI (0,0))
- ALLOCATE(DGMI%XAVG_TSWI (0,0))
-!
- ALLOCATE(DGMI%XAVG_TWSNOW (0))
- ALLOCATE(DGMI%XAVG_TDSNOW (0))
- ALLOCATE(DGMI%XAVG_TTSNOW (0))
-!
- ALLOCATE(DGMI%XHV (0,0))
- ALLOCATE(DGMI%XSWI (0,0,0))
- ALLOCATE(DGMI%XTSWI (0,0,0))
- ALLOCATE(DGMI%XTWSNOW (0,0))
- ALLOCATE(DGMI%XTDSNOW (0,0))
- ALLOCATE(DGMI%XTTSNOW (0,0))
- ALLOCATE(DGMI%XDPSNG (0,0))
- ALLOCATE(DGMI%XDPSNV (0,0))
- ALLOCATE(DGMI%XDPSN (0,0))
- ALLOCATE(DGMI%XALBT (0,0))
-!
- ALLOCATE(DGMI%XDFSAT (0,0))
- ALLOCATE(DGMI%XDFFG (0,0))
- ALLOCATE(DGMI%XDFFV (0,0))
- ALLOCATE(DGMI%XDFF (0,0))
-!
- ALLOCATE(DGMI%XSNOWLIQ (0,0,0))
- ALLOCATE(DGMI%XSNOWTEMP (0,0,0))
+ !
+ CALL ALLOC_MISC_BUD(DM,0,0,0,0,DM%LPROSNOW)
+ DO JP=1,IO%NPATCH
+ CALL ALLOC_MISC_BUD(NDM%AL(JP),0,0,0,0,DM%LPROSNOW)
+ ENDDO
+ !
END IF
!
-IF (I%CISBA/='DIF') THEN
- ALLOCATE(DGMI%XFRD2_TSWI(0))
- ALLOCATE(DGMI%XFRD2_TWG (0))
- ALLOCATE(DGMI%XFRD2_TWGI(0))
- ALLOCATE(DGMI%XFRD3_TSWI(0))
- ALLOCATE(DGMI%XFRD3_TWG (0))
- ALLOCATE(DGMI%XFRD3_TWGI(0))
- ALLOCATE(DGMI%XALT(0,0))
- ALLOCATE(DGMI%XFLT(0,0))
- ALLOCATE(DGMI%XAVG_ALT(0))
- ALLOCATE(DGMI%XAVG_FLT(0))
+!* Chemical fluxes
+IF (CHI%SVI%NBEQ>0 .AND. CHI%LCH_BIO_FLUX) THEN
+ ALLOCATE(GB%XFISO(KLU))
+ ALLOCATE(GB%XFMONO(KLU))
+ !
+ GB%XFISO = XUNDEF
+ GB%XFMONO = XUNDEF
+ELSE
+ ALLOCATE(GB%XFISO(0))
+ ALLOCATE(GB%XFMONO(0))
ENDIF
!
-IF (.NOT.I%LTR_ML) THEN
- ALLOCATE (DGMI%XFAPAR (0, 0))
- ALLOCATE (DGMI%XFAPIR (0, 0))
- ALLOCATE (DGMI%XFAPAR_BS (0, 0))
- ALLOCATE (DGMI%XFAPIR_BS (0, 0))
- ALLOCATE (DGMI%XDFAPARC (0, 0))
- ALLOCATE (DGMI%XDFAPIRC (0, 0))
- ALLOCATE (DGMI%XDLAI_EFFC (0, 0))
+IF (IO%CPHOTO/='NON') THEN
+ DO JP = 1,IO%NPATCH
+ ALLOCATE(NGB%AL(JP)%XIACAN(NP%AL(JP)%NSIZE_P,KABC))
+ !
+ NGB%AL(JP)%XIACAN = XUNDEF
+ ENDDO
+ !
+ELSE
+ DO JP = 1,IO%NPATCH
+ ALLOCATE(NGB%AL(JP)%XIACAN(0,0))
+ ENDDO
ENDIF
!
-!* transfer coefficients
+IF (LHOOK) CALL DR_HOOK('DIAG_ISBA_INIT_N',1,ZHOOK_HANDLE)
!
-IF (DGI%LCOEF) THEN
- ALLOCATE(DGI%XAVG_CD (KLU))
- ALLOCATE(DGI%XAVG_CH (KLU))
- ALLOCATE(DGI%XAVG_CE (KLU))
- ALLOCATE(DGI%XAVG_Z0 (KLU))
- ALLOCATE(DGI%XAVG_Z0H (KLU))
- ALLOCATE(DGI%XAVG_Z0EFF(KLU))
- !
- DGI%XAVG_CD = XUNDEF
- DGI%XAVG_CH = XUNDEF
- DGI%XAVG_CE = XUNDEF
- DGI%XAVG_Z0 = XUNDEF
- DGI%XAVG_Z0H = XUNDEF
- DGI%XAVG_Z0EFF = XUNDEF
- !
- ALLOCATE(DGI%XCD (KLU,I%NPATCH))
- ALLOCATE(DGI%XCH (KLU,I%NPATCH))
- ALLOCATE(DGI%XCE (KLU,I%NPATCH))
- ALLOCATE(DGI%XZ0_WITH_SNOW (KLU,I%NPATCH))
- ALLOCATE(DGI%XZ0H_WITH_SNOW (KLU,I%NPATCH))
- ALLOCATE(DGI%XZ0EFF (KLU,I%NPATCH))
- !
- DGI%XCD = XUNDEF
- DGI%XCH = XUNDEF
- DGI%XCE = XUNDEF
- DGI%XZ0_WITH_SNOW = XUNDEF
- DGI%XZ0H_WITH_SNOW = XUNDEF
- DGI%XZ0EFF = XUNDEF
-ELSE
- ALLOCATE(DGI%XAVG_CD (0))
- ALLOCATE(DGI%XAVG_CH (0))
- ALLOCATE(DGI%XAVG_CE (0))
- ALLOCATE(DGI%XAVG_Z0 (0))
- ALLOCATE(DGI%XAVG_Z0H (0))
- ALLOCATE(DGI%XAVG_Z0EFF(0))
-!
- ALLOCATE(DGI%XCD (0,0))
- ALLOCATE(DGI%XCH (0,0))
- ALLOCATE(DGI%XCE (0,0))
- ALLOCATE(DGI%XZ0_WITH_SNOW (0,0))
- ALLOCATE(DGI%XZ0H_WITH_SNOW (0,0))
- ALLOCATE(DGI%XZ0EFF (0,0))
-END IF
+CONTAINS
+!
+!
+SUBROUTINE ALLOC_MISC_BUD(DMA,KLUA,KLUAP,KNLAYER,KSNLAYER,OPROSNOW)
+!
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMA
+INTEGER, INTENT(IN) :: KLUA
+INTEGER, INTENT(IN) :: KLUAP
+INTEGER, INTENT(IN) :: KNLAYER
+INTEGER, INTENT(IN) :: KSNLAYER
+LOGICAL, INTENT(IN) :: OPROSNOW
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('DIAG_ISBA_INIT_N:ALLOC_MISC_BUD',0,ZHOOK_HANDLE)
+!
+!////////////DIAG DEFINED BY PATCH AND AVERAGED//////////
!
+ALLOCATE(DMA%XHV (KLUA))
!
-!* surface humidity
+ALLOCATE(DMA%XSWI (KLUA,KNLAYER))
+ALLOCATE(DMA%XTSWI (KLUA,KNLAYER))
!
-IF (DGI%LSURF_VARS) THEN
- ALLOCATE(DGI%XAVG_QS (KLU))
+ALLOCATE(DMA%XTWSNOW (KLUA))
+ALLOCATE(DMA%XTDSNOW (KLUA))
+ALLOCATE(DMA%XTTSNOW (KLUA))
+!
+IF ( OPROSNOW .AND. HSNOW_SCHEME=="CRO" ) THEN
!
- DGI%XAVG_QS = XUNDEF
+ ALLOCATE(DMA%XSNOWDEND (KLUAP,KSNLAYER))
+ ALLOCATE(DMA%XSNOWSPHER (KLUAP,KSNLAYER))
+ ALLOCATE(DMA%XSNOWSIZE (KLUAP,KSNLAYER))
+ ALLOCATE(DMA%XSNOWSSA (KLUAP,KSNLAYER))
+ ALLOCATE(DMA%XSNOWTYPEMEPRA(KLUAP,KSNLAYER))
+ ALLOCATE(DMA%XSNOWRAM (KLUAP,KSNLAYER))
+ ALLOCATE(DMA%XSNOWSHEAR (KLUAP,KSNLAYER))
!
- ALLOCATE(DGI%XQS (KLU,I%NPATCH))
+ ALLOCATE(DMA%XSNDPT_1DY(KLUA))
+ ALLOCATE(DMA%XSNDPT_3DY(KLUA))
+ ALLOCATE(DMA%XSNDPT_5DY(KLUA))
+ ALLOCATE(DMA%XSNDPT_7DY(KLUA))
+ ALLOCATE(DMA%XSNSWE_1DY(KLUA))
+ ALLOCATE(DMA%XSNSWE_3DY(KLUA))
+ ALLOCATE(DMA%XSNSWE_5DY(KLUA))
+ ALLOCATE(DMA%XSNSWE_7DY(KLUA))
+ ALLOCATE(DMA%XSNRAM_SONDE(KLUA))
+ ALLOCATE(DMA%XSN_WETTHCKN(KLUA))
+ ALLOCATE(DMA%XSN_REFRZNTHCKN(KLUA))
!
- DGI%XQS = XUNDEF
ELSE
- ALLOCATE(DGI%XQS (0,0))
-END IF
+ !
+ ALLOCATE(DMA%XSNOWDEND (0,0))
+ ALLOCATE(DMA%XSNOWSPHER (0,0))
+ ALLOCATE(DMA%XSNOWSIZE (0,0))
+ ALLOCATE(DMA%XSNOWSSA (0,0))
+ ALLOCATE(DMA%XSNOWTYPEMEPRA(0,0))
+ ALLOCATE(DMA%XSNOWRAM (0,0))
+ ALLOCATE(DMA%XSNOWSHEAR (0,0))
+ !
+ ALLOCATE(DMA%XSNDPT_1DY(0))
+ ALLOCATE(DMA%XSNDPT_3DY(0))
+ ALLOCATE(DMA%XSNDPT_5DY(0))
+ ALLOCATE(DMA%XSNDPT_7DY(0))
+ ALLOCATE(DMA%XSNSWE_1DY(0))
+ ALLOCATE(DMA%XSNSWE_3DY(0))
+ ALLOCATE(DMA%XSNSWE_5DY(0))
+ ALLOCATE(DMA%XSNSWE_7DY(0))
+ ALLOCATE(DMA%XSNRAM_SONDE(0))
+ ALLOCATE(DMA%XSN_WETTHCKN(0))
+ ALLOCATE(DMA%XSN_REFRZNTHCKN(0))
+ !
+ENDIF
!
-!* Irrigation threshold
+ALLOCATE(DMA%XPSNG (KLUA))
+ALLOCATE(DMA%XPSNV (KLUA))
+ALLOCATE(DMA%XPSN (KLUA))
+!
+ALLOCATE(DMA%XFSAT (KLUA))
+!
+ALLOCATE(DMA%XFFG (KLUA))
+ALLOCATE(DMA%XFFV (KLUA))
+ALLOCATE(DMA%XFF (KLUA))
+!
+IF (KLUA>0) THEN
+ DMA%XHV = XUNDEF
+ DMA%XSWI = XUNDEF
+ DMA%XTSWI = XUNDEF
+ DMA%XTWSNOW = XUNDEF
+ DMA%XTDSNOW = XUNDEF
+ DMA%XTTSNOW = XUNDEF
+ DMA%XPSNG = XUNDEF
+ DMA%XPSNV = XUNDEF
+ DMA%XPSN = XUNDEF
+ DMA%XFSAT = XUNDEF
+ DMA%XFFG = XUNDEF
+ DMA%XFFV = XUNDEF
+ DMA%XFF = XUNDEF
+ENDIF
+!
+IF ( OPROSNOW .AND. HSNOW_SCHEME=="CRO" ) THEN
+ !
+ IF (KLUAP>0) THEN
+ DMA%XSNOWDEND = XUNDEF
+ DMA%XSNOWSPHER = XUNDEF
+ DMA%XSNOWSIZE = XUNDEF
+ DMA%XSNOWSSA = XUNDEF
+ DMA%XSNOWTYPEMEPRA = XUNDEF
+ DMA%XSNOWRAM = XUNDEF
+ DMA%XSNOWSHEAR = XUNDEF
+ ENDIF
+ !
+ IF (KLUA>0) THEN
+ DMA%XSNDPT_1DY = XUNDEF
+ DMA%XSNDPT_3DY = XUNDEF
+ DMA%XSNDPT_5DY = XUNDEF
+ DMA%XSNDPT_7DY = XUNDEF
+ DMA%XSNSWE_1DY = XUNDEF
+ DMA%XSNSWE_3DY = XUNDEF
+ DMA%XSNSWE_5DY = XUNDEF
+ DMA%XSNSWE_7DY = XUNDEF
+ DMA%XSNRAM_SONDE = XUNDEF
+ DMA%XSN_WETTHCKN = XUNDEF
+ DMA%XSN_REFRZNTHCKN = XUNDEF
+ ENDIF
+ !
+ENDIF
+!
+IF(IO%CISBA=='DIF')THEN
+ ALLOCATE(DMA%XALT(KLUA))
+ ALLOCATE(DMA%XFLT(KLUA))
+ IF (KLUA>0) THEN
+ DMA%XALT = XUNDEF
+ DMA%XFLT = XUNDEF
+ ENDIF
+ELSE
+ ALLOCATE(DMA%XALT(0))
+ ALLOCATE(DMA%XFLT(0))
+ENDIF
+!
+!//////////////DIAG DEFINED ONLY BY PATCH//////////////
+!
+ALLOCATE(DMA%XSNOWLIQ (KLUAP,KSNLAYER))
+ALLOCATE(DMA%XSNOWTEMP (KLUAP,KSNLAYER))
+ALLOCATE(DMA%XSNOWDZ (KLUAP,KSNLAYER))
+!
+IF (KLUAP>0) THEN
+ DMA%XSNOWLIQ = XUNDEF
+ DMA%XSNOWTEMP= XUNDEF
+ DMA%XSNOWDZ = XUNDEF
+ENDIF
!
IF (LAGRIP) THEN
- ALLOCATE(DGMI%XSEUIL (KLU,I%NPATCH))
+ ALLOCATE(DMA%XSEUIL (KLUAP))
!
- DGMI%XSEUIL = XUNDEF
+ IF (KLUAP>0) THEN
+ DMA%XSEUIL = XUNDEF
+ ENDIF
ELSE
- ALLOCATE(DGMI%XSEUIL (0,0))
-END IF
+ ALLOCATE(DMA%XSEUIL(0))
+ENDIF
!
-!* Chemical fluxes
-IF (CHI%SVI%NBEQ>0 .AND. CHI%LCH_BIO_FLUX) THEN
- ALLOCATE(GB%XFISO(KLU))
- ALLOCATE(GB%XFMONO(KLU))
+IF (IO%LTR_ML) THEN
+ ALLOCATE (DMA%XFAPAR (KLUAP))
+ ALLOCATE (DMA%XFAPIR (KLUAP))
+ ALLOCATE (DMA%XFAPAR_BS (KLUAP))
+ ALLOCATE (DMA%XFAPIR_BS (KLUAP))
+ ALLOCATE (DMA%XDFAPARC (KLUAP))
+ ALLOCATE (DMA%XDFAPIRC (KLUAP))
+ ALLOCATE (DMA%XDLAI_EFFC (KLUAP))
!
- GB%XFISO = XUNDEF
- GB%XFMONO = XUNDEF
+ IF (KLUAP>0) THEN
+ DMA%XFAPAR = XUNDEF
+ DMA%XFAPIR = XUNDEF
+ DMA%XFAPAR_BS = XUNDEF
+ DMA%XFAPIR_BS = XUNDEF
+ DMA%XDFAPARC = 0.
+ DMA%XDFAPIRC = 0.
+ DMA%XDLAI_EFFC = 0.
+ ENDIF
ELSE
- ALLOCATE(GB%XFISO(0))
- ALLOCATE(GB%XFMONO(0))
+ ALLOCATE (DMA%XFAPAR (0))
+ ALLOCATE (DMA%XFAPIR (0))
+ ALLOCATE (DMA%XFAPAR_BS (0))
+ ALLOCATE (DMA%XFAPIR_BS (0))
+ ALLOCATE (DMA%XDFAPARC (0))
+ ALLOCATE (DMA%XDFAPIRC (0))
+ ALLOCATE (DMA%XDLAI_EFFC (0))
+ENDIF
+!
+!
+ALLOCATE(DMA%XC1 (KLUAP))
+ALLOCATE(DMA%XC2 (KLUAP))
+ALLOCATE(DMA%XWGEQ (KLUAP))
+ALLOCATE(DMA%XCG (KLUAP))
+ALLOCATE(DMA%XCT (KLUAP))
+ALLOCATE(DMA%XRS (KLUAP))
+ALLOCATE(DMA%XGRNDFLUX (KLUAP))
+ALLOCATE(DMA%XSNOWHMASS(KLUAP))
+ALLOCATE(DMA%XSRSFC (KLUAP))
+ALLOCATE(DMA%XRRSFC (KLUAP))
+ALLOCATE(DMA%XRNSNOW (KLUAP))
+ALLOCATE(DMA%XHSNOW (KLUAP))
+ALLOCATE(DMA%XGFLUXSNOW(KLUAP))
+ALLOCATE(DMA%XHPSNOW (KLUAP))
+ALLOCATE(DMA%XUSTARSNOW(KLUAP))
+ALLOCATE(DMA%XCDSNOW (KLUAP))
+ALLOCATE(DMA%XCHSNOW (KLUAP))
+!
+IF (KLUAP>0) THEN
+ DMA%XC1 = XUNDEF
+ DMA%XC2 = XUNDEF
+ DMA%XWGEQ = XUNDEF
+ DMA%XCG = XUNDEF
+ DMA%XCT = XUNDEF
+ DMA%XRS = XUNDEF
+ DMA%XGRNDFLUX = XUNDEF
+ DMA%XSNOWHMASS = XUNDEF
+ DMA%XSRSFC = XUNDEF
+ DMA%XRRSFC = XUNDEF
+ DMA%XRNSNOW = XUNDEF
+ DMA%XHSNOW = XUNDEF
+ DMA%XGFLUXSNOW = XUNDEF
+ DMA%XHPSNOW = XUNDEF
+ DMA%XUSTARSNOW = XUNDEF
+ DMA%XCDSNOW = XUNDEF
+ DMA%XCHSNOW = XUNDEF
+ENDIF
+!
+!////////////DIAG DEFINED ONLY AVERAGED//////////////
+!
+ALLOCATE(DMA%XLAI (KLUA))
+!
+ALLOCATE(DMA%XSOIL_SWI (KLUA))
+ALLOCATE(DMA%XSOIL_TSWI (KLUA))
+ALLOCATE(DMA%XSOIL_TWG (KLUA))
+ALLOCATE(DMA%XSOIL_TWGI (KLUA))
+ALLOCATE(DMA%XSOIL_WG (KLUA))
+ALLOCATE(DMA%XSOIL_WGI (KLUA))
+!
+IF (KLUA>0) THEN
+ DMA%XLAI = XUNDEF
+ DMA%XSOIL_TSWI = XUNDEF
+ DMA%XSOIL_SWI = XUNDEF
+ DMA%XSOIL_TWG = XUNDEF
+ DMA%XSOIL_TWGI = XUNDEF
+ DMA%XSOIL_WG = XUNDEF
+ DMA%XSOIL_WGI = XUNDEF
ENDIF
!
-IF (I%CPHOTO/='NON') THEN
- ALLOCATE(GB%XIACAN(KLU,SIZE(I%XABC),I%NPATCH))
+IF(IO%CISBA=='DIF'.AND.DM%LSURF_MISC_DIF)THEN
+ ALLOCATE(DMA%XFRD2_TSWI(KLUA))
+ ALLOCATE(DMA%XFRD2_TWG (KLUA))
+ ALLOCATE(DMA%XFRD2_TWGI(KLUA))
+ ALLOCATE(DMA%XFRD3_TSWI(KLUA))
+ ALLOCATE(DMA%XFRD3_TWG (KLUA))
+ ALLOCATE(DMA%XFRD3_TWGI(KLUA))
!
- GB%XIACAN = XUNDEF
+ IF (KLUA>0) THEN
+ DMA%XFRD2_TSWI = XUNDEF
+ DMA%XFRD2_TWG = XUNDEF
+ DMA%XFRD2_TWGI = XUNDEF
+ DMA%XFRD3_TSWI = XUNDEF
+ DMA%XFRD3_TWG = XUNDEF
+ DMA%XFRD3_TWGI = XUNDEF
+ ENDIF
!
ELSE
- ALLOCATE(GB%XIACAN(0,0,0))
+ ALLOCATE(DMA%XFRD2_TSWI(0))
+ ALLOCATE(DMA%XFRD2_TWG (0))
+ ALLOCATE(DMA%XFRD2_TWGI(0))
+ ALLOCATE(DMA%XFRD3_TSWI(0))
+ ALLOCATE(DMA%XFRD3_TWG (0))
+ ALLOCATE(DMA%XFRD3_TWGI(0))
ENDIF
!
-IF (LHOOK) CALL DR_HOOK('DIAG_ISBA_INIT_N',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('DIAG_ISBA_INIT_N:ALLOC_MISC_BUD',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE ALLOC_MISC_BUD
+!
+SUBROUTINE ALLOC_EVAP_BUD(DEA,KLUA,KLUAP)
+!
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEA
+INTEGER, INTENT(IN) :: KLUA
+INTEGER, INTENT(IN) :: KLUAP
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('DIAG_ISBA_INIT_N:ALLOC_EVAP_BUD',0,ZHOOK_HANDLE)
+!
+ALLOCATE(DEA%XLEG (KLUA))
+ALLOCATE(DEA%XLEGI (KLUA))
+ALLOCATE(DEA%XLEV (KLUA))
+ALLOCATE(DEA%XLES (KLUA))
+!
+ALLOCATE(DEA%XLESL (KLUA))
+ALLOCATE(DEA%XSNDRIFT (KLUA))
+!
+ALLOCATE(DEA%XLER (KLUA))
+ALLOCATE(DEA%XLETR (KLUA))
+!
+ALLOCATE(DEA%XDRAIN (KLUA))
+ALLOCATE(DEA%XRUNOFF (KLUA))
+ALLOCATE(DEA%XDRIP (KLUA))
+ALLOCATE(DEA%XRRVEG (KLUA))
+ALLOCATE(DEA%XMELT (KLUA))
+!
+ALLOCATE(DEA%XIRRIG_FLUX(KLUA))
+!
+ALLOCATE(DEA%XGPP (KLUA))
+ALLOCATE(DEA%XRESP_AUTO (KLUA))
+ALLOCATE(DEA%XRESP_ECO (KLUA))
+!
+ALLOCATE(DEA%XQSB (KLUA))
+ALLOCATE(DEA%XHORT (KLUA))
+!
+ALLOCATE(DEA%XIFLOOD (KLUA))
+ALLOCATE(DEA%XPFLOOD (KLUA))
+ALLOCATE(DEA%XLE_FLOOD (KLUA))
+ALLOCATE(DEA%XLEI_FLOOD(KLUA))
+!
+ALLOCATE(DEA%XRN_SN_FR (KLUAP))
+ALLOCATE(DEA%XH_SN_FR (KLUAP))
+ALLOCATE(DEA%XLEI_SN_FR (KLUAP))
+ALLOCATE(DEA%XLE_SN_FR (KLUAP))
+ALLOCATE(DEA%XGFLUX_SN_FR(KLUAP))
+ALLOCATE(DEA%XLEG_SN_FR (KLUAP))
+ALLOCATE(DEA%XLEGI_SN_FR (KLUAP))
+ALLOCATE(DEA%XLEV_SN_FR (KLUAP))
+ALLOCATE(DEA%XLETR_SN_FR (KLUAP))
+ALLOCATE(DEA%XUSTAR_SN_FR(KLUAP))
+ALLOCATE(DEA%XLER_SN_FR (KLUAP))
+!
+ALLOCATE(DEA%XMELTADV (KLUAP))
+ALLOCATE(DEA%XRESTORE (KLUAP))
+!
+IF (KLUA>0) THEN
+ DEA%XLEG = XUNDEF
+ DEA%XLEGI = XUNDEF
+ DEA%XLEV = XUNDEF
+ DEA%XLES = XUNDEF
+ !
+ DEA%XLESL = XUNDEF
+ DEA%XSNDRIFT = XUNDEF
+ !
+ DEA%XLER = XUNDEF
+ DEA%XLETR = XUNDEF
+ !
+ DEA%XDRAIN = XUNDEF
+ DEA%XRUNOFF = XUNDEF
+ DEA%XDRIP = XUNDEF
+ DEA%XRRVEG = XUNDEF
+ DEA%XMELT = XUNDEF
+ !
+ DEA%XIRRIG_FLUX = XUNDEF
+ !
+ DEA%XGPP = XUNDEF
+ DEA%XRESP_AUTO = XUNDEF
+ DEA%XRESP_ECO = XUNDEF
+ !
+ DEA%XQSB = XUNDEF
+ DEA%XHORT = XUNDEF
+ !
+ DEA%XIFLOOD = XUNDEF
+ DEA%XPFLOOD = XUNDEF
+ DEA%XLE_FLOOD = XUNDEF
+ DEA%XLEI_FLOOD = XUNDEF
+ !
+ENDIF
+!
+IF (KLUAP>0) THEN
+ DEA%XRN_SN_FR = XUNDEF
+ DEA%XH_SN_FR = XUNDEF
+ DEA%XLEI_SN_FR = XUNDEF
+ DEA%XLE_SN_FR = XUNDEF
+ DEA%XGFLUX_SN_FR = XUNDEF
+ DEA%XLEG_SN_FR = XUNDEF
+ DEA%XLEGI_SN_FR = XUNDEF
+ DEA%XLEV_SN_FR = XUNDEF
+ DEA%XLETR_SN_FR = XUNDEF
+ DEA%XUSTAR_SN_FR = XUNDEF
+ DEA%XLER_SN_FR = XUNDEF
+ !
+ DEA%XMELTADV = XUNDEF
+ DEA%XRESTORE = XUNDEF
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('DIAG_ISBA_INIT_N:ALLOC_EVAP_BUD',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE ALLOC_EVAP_BUD
+!
+SUBROUTINE ALLOC_MEB_BUD(DEA,KLUA)
+!
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEA
+INTEGER, INTENT(IN) :: KLUA
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('DIAG_ISBA_INIT_N:ALLOC_MEB_BUD',0,ZHOOK_HANDLE)
+!
+ALLOCATE(DEA%XLELITTER (KLUA))
+ALLOCATE(DEA%XLELITTERI(KLUA))
+ALLOCATE(DEA%XDRIPLIT (KLUA))
+ALLOCATE(DEA%XRRLIT (KLUA))
+!
+ALLOCATE(DEA%XLEV_CV (KLUA))
+ALLOCATE(DEA%XLES_CV (KLUA))
+ALLOCATE(DEA%XLETR_CV(KLUA))
+ALLOCATE(DEA%XLER_CV (KLUA))
+ALLOCATE(DEA%XLE_CV (KLUA))
+ALLOCATE(DEA%XH_CV (KLUA))
+ALLOCATE(DEA%XMELT_CV(KLUA))
+ALLOCATE(DEA%XFRZ_CV (KLUA))
+
+ALLOCATE(DEA%XLETR_GV(KLUA))
+ALLOCATE(DEA%XLER_GV (KLUA))
+ALLOCATE(DEA%XLE_GV (KLUA))
+ALLOCATE(DEA%XH_GV (KLUA))
+
+ALLOCATE(DEA%XLE_GN (KLUA))
+ALLOCATE(DEA%XEVAP_GN(KLUA))
+ALLOCATE(DEA%XH_GN (KLUA))
+ALLOCATE(DEA%XSR_GN (KLUA))
+ALLOCATE(DEA%XSWDOWN_GN(KLUA))
+ALLOCATE(DEA%XLWDOWN_GN(KLUA))
+
+ALLOCATE(DEA%XEVAP_G (KLUA))
+ALLOCATE(DEA%XLE_CA (KLUA))
+ALLOCATE(DEA%XH_CA (KLUA))
+!
+ALLOCATE(DEA%XSWUP(KLUA))
+ALLOCATE(DEA%XLWUP(KLUA))
+!
+ALLOCATE(DEA%XSWNET_V (KLUA))
+ALLOCATE(DEA%XSWNET_G (KLUA))
+ALLOCATE(DEA%XSWNET_N (KLUA))
+ALLOCATE(DEA%XSWNET_NS (KLUA))
+ALLOCATE(DEA%XLWNET_V (KLUA))
+ALLOCATE(DEA%XLWNET_G (KLUA))
+ALLOCATE(DEA%XLWNET_N (KLUA))
+!
+IF (KLUA>0) THEN
+ DEA%XLELITTER = XUNDEF
+ DEA%XLELITTERI = XUNDEF
+ DEA%XDRIPLIT = XUNDEF
+ DEA%XRRLIT = XUNDEF
+
+ DEA%XLEV_CV = XUNDEF
+ DEA%XLES_CV = XUNDEF
+ DEA%XLETR_CV = XUNDEF
+ DEA%XLER_CV = XUNDEF
+ DEA%XLE_CV = XUNDEF
+ DEA%XH_CV = XUNDEF
+ DEA%XMELT_CV = XUNDEF
+ DEA%XFRZ_CV = XUNDEF
+
+ DEA%XLETR_GV = XUNDEF
+ DEA%XLER_GV = XUNDEF
+ DEA%XLE_GV = XUNDEF
+ DEA%XH_GV = XUNDEF
+
+ DEA%XLE_GN = XUNDEF
+ DEA%XEVAP_GN = XUNDEF
+ DEA%XH_GN = XUNDEF
+ DEA%XSR_GN = XUNDEF
+ DEA%XSWDOWN_GN = XUNDEF
+ DEA%XLWDOWN_GN = XUNDEF
+
+ DEA%XEVAP_G = XUNDEF
+ DEA%XLE_CA = XUNDEF
+ DEA%XH_CA = XUNDEF
+ !
+ DEA%XSWUP = XUNDEF
+ DEA%XLWUP = XUNDEF
+ !
+ DEA%XSWNET_V = XUNDEF
+ DEA%XSWNET_G = XUNDEF
+ DEA%XSWNET_N = XUNDEF
+ DEA%XSWNET_NS = XUNDEF
+ DEA%XLWNET_V = XUNDEF
+ DEA%XLWNET_G = XUNDEF
+ DEA%XLWNET_N = XUNDEF
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('DIAG_ISBA_INIT_N:ALLOC_MEB_BUD',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE ALLOC_MEB_BUD
+!
+SUBROUTINE ALLOC_WATER_BUD(DEA,KLUA)
+!
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEA
+INTEGER, INTENT(IN) :: KLUA
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('DIAG_ISBA_INIT_N:ALLOC_WATER_BUD',0,ZHOOK_HANDLE)
+!
+ALLOCATE(DEA%XDWG (KLUA))
+ALLOCATE(DEA%XDWGI (KLUA))
+ALLOCATE(DEA%XDWR (KLUA))
+ALLOCATE(DEA%XDSWE (KLUA))
+ALLOCATE(DEA%XWATBUD(KLUA))
+!
+IF (KLUA>0) THEN
+ DEA%XDWG = XUNDEF
+ DEA%XDWGI = XUNDEF
+ DEA%XDWR = XUNDEF
+ DEA%XDSWE = XUNDEF
+ DEA%XWATBUD = XUNDEF
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('DIAG_ISBA_INIT_N:ALLOC_WATER_BUD',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE ALLOC_WATER_BUD
+!
!-------------------------------------------------------------------------------
!
END SUBROUTINE DIAG_ISBA_INIT_n
diff --git a/src/SURFEX/diag_isban.F90 b/src/SURFEX/diag_isban.F90
deleted file mode 100644
index c757099e3781d53fcb80cf4e6df57fd9008556b9..0000000000000000000000000000000000000000
--- a/src/SURFEX/diag_isban.F90
+++ /dev/null
@@ -1,188 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE DIAG_ISBA_n (DGEI, DGI, &
- HPROGRAM, &
- PRN, PH, PLE, PLEI, PGFLUX, PRI, PCD, PCH, PCE, PQS, &
- PZ0, PZ0H, PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M, &
- PSWD, PSWU, PLWD, PLWU, PSWBD, PSWBU, PFMU, PFMV, &
- PRNC, PHC, PLEC, PGFLUXC, PSWDC, PSWUC, PLWDC, &
- PLWUC, PFMUC, PFMVC, PT2M_MIN, PT2M_MAX, PLEIC, &
- PHU2M_MIN, PHU2M_MAX, PWIND10M, PWIND10M_MAX, &
- PEVAP, PEVAPC, PSUBL, PSUBLC )
-! ###############################################################################
-!
-!!**** *DIAG_ISBA_n * - Stores ISBA diagnostics
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! Modified 01/2006 : sea flux parameterization.
-!! Modified 08/2009 : new diag
-! B. decharme 04/2013 : Add EVAP and SUBL diag
-!!------------------------------------------------------------------
-!
-!
-!
-USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
-USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DGEI
-TYPE(DIAG_ISBA_t), INTENT(INOUT) :: DGI
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PRN ! Net radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PH ! Sensible heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLE ! Total latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEI ! Sublimation latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX ! Storage flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAP ! Total evapotranspiration (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSUBL ! Sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PRI ! Richardson number (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PCD ! drag coefficient (W/s2)
-REAL, DIMENSION(:), INTENT(OUT) :: PCH ! transf. coef heat (W/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PCE ! transf. coef vapor (W/s/K)
-REAL, DIMENSION(:), INTENT(OUT) :: PQS
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0 ! rough. length wind (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0H ! rough. length heat (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PTS ! surface temperature (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M ! temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PQ2M ! humidity at 2m (kg/kg)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M ! relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PZON10M ! zonal wind at 10m (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PMER10M ! meridian wind at 10m(m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWD ! incoming short-wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWU ! upward short-wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWD ! incoming long-wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWU ! upward long-wave radiation (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBD ! incoming short-wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBU ! upward short-wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMU ! zonal momentum flux (Pa)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMV ! meridian momentum flux (Pa)
-REAL, DIMENSION(:), INTENT(OUT) :: PRNC ! Net radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PHC ! Sensible heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEC ! Total latent heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEIC ! Sublimation latent heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUXC ! Storage flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAPC ! Total evapotranspiration (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSUBLC ! Sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWDC ! incoming short wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWUC ! outgoing short wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWDC ! incoming long wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWUC ! outgoing long wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMUC ! zonal friction
-REAL, DIMENSION(:), INTENT(OUT) :: PFMVC ! meridian friction
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MIN ! Minimum temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MAX ! Maximum temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MIN! Minimum relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MAX! Maximum relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M ! wind at 10m (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M_MAX! Maximum wind at 10m (m/s)
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!
-!* 0.2 declarations of local variables
-!
-!-------------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_ISBA_N',0,ZHOOK_HANDLE)
-IF (DGI%LSURF_BUDGET) THEN
- PRN = DGI%XAVG_RN
- PH = DGI%XAVG_H
- PLE = DGI%XAVG_LE
- PLEI = DGI%XAVG_LEI
- PGFLUX = DGI%XAVG_GFLUX
- PSWD = DGI%XAVG_SWD
- PSWU = DGI%XAVG_SWU
- PLWD = DGI%XAVG_LWD
- PLWU = DGI%XAVG_LWU
- PSWBD = DGI%XAVG_SWBD
- PSWBU = DGI%XAVG_SWBU
- PFMU = DGI%XAVG_FMU
- PFMV = DGI%XAVG_FMV
-END IF
-!
-IF (DGEI%LSURF_EVAP_BUDGET) THEN
- PEVAP = DGEI%XAVG_EVAP
- PSUBL = DGEI%XAVG_SUBL
-ENDIF
-!
-IF (DGEI%LSURF_BUDGETC) THEN
- PRNC = DGEI%XAVG_RNC
- PHC = DGEI%XAVG_HC
- PLEC = DGEI%XAVG_LEC
- PLEIC = DGEI%XAVG_LEIC
- PGFLUXC = DGEI%XAVG_GFLUXC
- PEVAPC = DGEI%XAVG_EVAPC
- PSUBLC = DGEI%XAVG_SUBLC
- PSWDC = DGI%XAVG_SWDC
- PSWUC = DGI%XAVG_SWUC
- PLWDC = DGI%XAVG_LWDC
- PLWUC = DGI%XAVG_LWUC
- PFMUC = DGI%XAVG_FMUC
- PFMVC = DGI%XAVG_FMVC
-END IF
-!
-IF (DGI%N2M>=1 .OR. DGI%LSURF_BUDGET .OR. DGEI%LSURF_BUDGETC) PTS = DGI%XAVG_TS
-!
-IF (DGI%N2M>=1) THEN
- PRI = DGI%XAVG_RI
- PT2M = DGI%XAVG_T2M
- PT2M_MIN = DGI%XAVG_T2M_MIN
- PT2M_MAX = DGI%XAVG_T2M_MAX
- PQ2M = DGI%XAVG_Q2M
- PHU2M = DGI%XAVG_HU2M
- PHU2M_MIN= DGI%XAVG_HU2M_MIN
- PHU2M_MAX= DGI%XAVG_HU2M_MAX
- PZON10M = DGI%XAVG_ZON10M
- PMER10M = DGI%XAVG_MER10M
- PWIND10M = DGI%XAVG_WIND10M
- PWIND10M_MAX = DGI%XAVG_WIND10M_MAX
-END IF
-!
-IF (DGI%LCOEF) THEN
- PCD = DGI%XAVG_CD
- PCH = DGI%XAVG_CH
- PCE = DGI%XAVG_CE
- PZ0 = DGI%XAVG_Z0
- PZ0H = DGI%XAVG_Z0H
-END IF
-!
-IF (DGI%LSURF_VARS) THEN
- PQS = DGI%XAVG_QS
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_ISBA_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE DIAG_ISBA_n
diff --git a/src/SURFEX/diag_misc_flaken.F90 b/src/SURFEX/diag_misc_flaken.F90
index e3e2834b771adbeccb15e05b4e4624cbb7d71baf..e225a3f74d7822b1e066892c8c6210db56f85d0f 100644
--- a/src/SURFEX/diag_misc_flaken.F90
+++ b/src/SURFEX/diag_misc_flaken.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_MISC_FLAKE_n (DGMF, &
- PT_WML,PT_BOT,PH_ML,PCT,PWATER_DEPTH)
+ SUBROUTINE DIAG_MISC_FLAKE_n (DMF, F)
! ###############################################################################
!
!!**** *DIAG_MISC-FLAKE_n * - additional diagnostics for FLake
@@ -29,8 +28,7 @@
!!------------------------------------------------------------------
!
!
-!
-!
+USE MODD_FLAKE_n, ONLY : FLAKE_t
USE MODD_DIAG_MISC_FLAKE_n, ONLY : DIAG_MISC_FLAKE_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -44,21 +42,16 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(DIAG_MISC_FLAKE_t), INTENT(INOUT) :: DGMF
-!
- REAL, DIMENSION(:), INTENT(IN) :: PT_WML ! Mixed-layer temperature [K]
- REAL, DIMENSION(:), INTENT(IN) :: PT_BOT ! Temperature at the water-bottom sediment
- REAL, DIMENSION(:), INTENT(IN) :: PH_ML ! Thickness of the mixed-layer [m]
- REAL, DIMENSION(:), INTENT(IN) :: PCT ! Shape factor (thermocline)
- REAL, DIMENSION(:), INTENT(IN) :: PWATER_DEPTH ! Lake depth
+TYPE(FLAKE_t), INTENT(INOUT) :: F
+TYPE(DIAG_MISC_FLAKE_t), INTENT(INOUT) :: DMF
!
!* 0.2 declarations of local variables
!
- REAL, DIMENSION(SIZE(DGMF%XZW_PROFILE),SIZE(PT_WML)) :: ZCSI ! Vertical normalized coordinate
- REAL, DIMENSION(SIZE(DGMF%XZW_PROFILE),SIZE(PT_WML)) :: ZSHAPE ! Shape function
+REAL, DIMENSION(SIZE(DMF%XZW_PROFILE),SIZE(F%XT_WML)) :: ZCSI ! Vertical normalized coordinate
+REAL, DIMENSION(SIZE(DMF%XZW_PROFILE),SIZE(F%XT_WML)) :: ZSHAPE ! Shape function
!
- INTEGER :: IZW
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+INTEGER :: IZW
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
!
@@ -66,25 +59,25 @@ IF (LHOOK) CALL DR_HOOK('DIAG_MISC_FLAKE_N',0,ZHOOK_HANDLE)
!
!* Flake temperature profile
!
-DGMF%XTW_PROFILE(:,:) = XUNDEF
+DMF%XTW_PROFILE(:,:) = XUNDEF
!
-IF (DGMF%LWATER_PROFILE) THEN
+IF (DMF%LWATER_PROFILE) THEN
!
- DO IZW=1,SIZE(DGMF%XZW_PROFILE)
- WHERE (PWATER_DEPTH(:)==PH_ML(:))
+ DO IZW=1,SIZE(DMF%XZW_PROFILE)
+ WHERE (F%XWATER_DEPTH(:)==F%XH_ML(:))
ZCSI(IZW,:) = 0.
ELSEWHERE
- ZCSI(IZW,:) = (DGMF%XZW_PROFILE(IZW) - PH_ML(:))/(PWATER_DEPTH(:) - PH_ML(:))
+ ZCSI(IZW,:) = (DMF%XZW_PROFILE(IZW) - F%XH_ML(:))/(F%XWATER_DEPTH(:) - F%XH_ML(:))
END WHERE
- ZSHAPE(IZW,:) = (40./3.*PCT-20./3.)*ZCSI(IZW,:)+(18.-30.*PCT)*ZCSI(IZW,:)**2 &
- + (20.*PCT-12.)*ZCSI(IZW,:)**3+(5./3.-10./3.*PCT)*ZCSI(IZW,:)**4
+ ZSHAPE(IZW,:) = (40./3.*F%XCT-20./3.)*ZCSI(IZW,:) + (18.-30.*F%XCT)*ZCSI(IZW,:)**2 &
+ + (20.*F%XCT-12.) *ZCSI(IZW,:)**3+(5./3.-10./3.*F%XCT)*ZCSI(IZW,:)**4
END DO
!
- DO IZW=1,SIZE(DGMF%XZW_PROFILE)
- WHERE (PH_ML(:) >= DGMF%XZW_PROFILE(IZW))
- DGMF%XTW_PROFILE(IZW,:) = PT_WML(:)
- ELSEWHERE (PWATER_DEPTH(:) >= DGMF%XZW_PROFILE(IZW))
- DGMF%XTW_PROFILE(IZW,:) = PT_WML(:) - (PT_WML(:) - PT_BOT(:)) * ZSHAPE(IZW,:)
+ DO IZW=1,SIZE(DMF%XZW_PROFILE)
+ WHERE (F%XH_ML(:) >= DMF%XZW_PROFILE(IZW))
+ DMF%XTW_PROFILE(IZW,:) = F%XT_WML(:)
+ ELSEWHERE (F%XWATER_DEPTH(:) >= DMF%XZW_PROFILE(IZW))
+ DMF%XTW_PROFILE(IZW,:) = F%XT_WML(:) - (F%XT_WML(:) - F%XT_BOT(:)) * ZSHAPE(IZW,:)
END WHERE
END DO
!
diff --git a/src/SURFEX/diag_misc_isban.F90 b/src/SURFEX/diag_misc_isban.F90
index 349856924020b4f67b6dcdbbc816a0314202b024..a043db6e320a23d039d1dbb9b34ce7b76fe8a0bf 100644
--- a/src/SURFEX/diag_misc_isban.F90
+++ b/src/SURFEX/diag_misc_isban.F90
@@ -3,13 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE DIAG_MISC_ISBA_n (DGMI, PKDI, &
- PTSTEP, HISBA, HPHOTO, HSNOW, OAGRIP, OTR_ML, &
- PTIME, KSIZE, KPATCH, KMASK, PSEUIL, &
- PPSN, PPSNG, PPSNV, PFF, PFFG, PFFV, &
- PWG, PWGI, PWFC, PWWILT, PWSNOW, PRSNOW, &
- PFAPARC, PFAPIRC, PLAI_EFFC, PMUS, PFSAT, &
- PDG, PTG )
+SUBROUTINE DIAG_MISC_ISBA_n (DMK, KK, PK, PEK, AGK, IO, OSURF_MISC_BUDGET, &
+ OVOLUMETRIC_SNOWLIQ, PTSTEP, OAGRIP, PTIME, KSIZE )
! ###############################################################################
!
!!**** *DIAG_MISC-ISBA_n * - additional diagnostics for ISBA
@@ -46,9 +41,11 @@ SUBROUTINE DIAG_MISC_ISBA_n (DGMI, PKDI, &
!
!
USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
-USE MODD_PACK_DIAG_ISBA, ONLY : PACK_DIAG_ISBA_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_AGRI_n, ONLY : AGRI_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
-USE MODD_CSTS, ONLY : XTT
+USE MODD_CSTS, ONLY : XTT, XRHOLW
USE MODD_SURF_PAR, ONLY : XUNDEF
!
!
@@ -63,204 +60,132 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(AGRI_t), INTENT(INOUT) :: AGK
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
!
-TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DGMI
-TYPE(PACK_DIAG_ISBA_t), INTENT(INOUT) :: PKDI
+LOGICAL, INTENT(IN) :: OSURF_MISC_BUDGET
+LOGICAL, INTENT(IN) :: OVOLUMETRIC_SNOWLIQ
+REAL, INTENT(IN) :: PTSTEP ! timestep for accumulated values
+LOGICAL, INTENT(IN) :: OAGRIP
+REAL, INTENT(IN) :: PTIME ! current time since midnight
+INTEGER, INTENT(IN) :: KSIZE
!
-REAL, INTENT(IN) :: PTSTEP ! timestep for accumulated values
- CHARACTER(LEN=*), INTENT(IN) :: HISBA ! ISBA scheme
- CHARACTER(LEN=*), INTENT(IN) :: HPHOTO ! type of photosynthesis
- CHARACTER(LEN=*), INTENT(IN) :: HSNOW ! snow scheme
-LOGICAL, INTENT(IN) :: OAGRIP
-LOGICAL, INTENT(IN) :: OTR_ML
-REAL, INTENT(IN) :: PTIME ! current time since midnight
-INTEGER, INTENT(IN) :: KSIZE, KPATCH
-INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
-REAL, DIMENSION(:), INTENT(IN) :: PSEUIL
!
-!Snow/flood fraction at t
-REAL, DIMENSION(:), INTENT(IN) :: PPSN
-REAL, DIMENSION(:), INTENT(IN) :: PPSNG
-REAL, DIMENSION(:), INTENT(IN) :: PPSNV
-REAL, DIMENSION(:), INTENT(IN) :: PFF
-REAL, DIMENSION(:), INTENT(IN) :: PFFG
-REAL, DIMENSION(:), INTENT(IN) :: PFFV
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PWG ! soil water content profile (m3/m3)
-REAL, DIMENSION(:,:), INTENT(IN) :: PWGI ! soil solid water content profile (m3/m3)
-REAL, DIMENSION(:,:), INTENT(IN) :: PWFC ! field capacity profile (m3/m3)
-REAL, DIMENSION(:,:), INTENT(IN) :: PWWILT ! wilting point profile (m3/m3)
-REAL, DIMENSION(:,:), INTENT(IN) :: PWSNOW ! snow reservoir (kg/m2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PRSNOW ! snow density (kg/m3)
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PDG ! soil layer depth
-REAL, DIMENSION(:,:), INTENT(IN) :: PTG ! soil temperature
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PFAPARC
-REAL, DIMENSION(:), INTENT(INOUT) :: PFAPIRC
-REAL, DIMENSION(:), INTENT(INOUT) :: PLAI_EFFC
-REAL, DIMENSION(:), INTENT(INOUT) :: PMUS
-!
-REAL, DIMENSION(:), INTENT(IN) :: PFSAT
-!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(SIZE(PPSN)) :: ZSNOWTEMP
-REAL, DIMENSION(SIZE(PWSNOW,1),SIZE(PWSNOW,2)) :: ZWORK
-REAL, DIMENSION(SIZE(PWSNOW,1),SIZE(PWSNOW,2)) :: ZWORKTEMP
+REAL, DIMENSION(SIZE(PEK%XPSN)) :: ZSNOWTEMP
+REAL, DIMENSION(SIZE(PEK%TSNOW%WSNOW,1),SIZE(PEK%TSNOW%WSNOW,2)) :: ZWORK
+REAL, DIMENSION(SIZE(PEK%TSNOW%WSNOW,1),SIZE(PEK%TSNOW%WSNOW,2)) :: ZWORKTEMP
!
REAL, DIMENSION(KSIZE) :: ZALT, ZFLT
!
LOGICAL :: GMASK
-INTEGER :: JJ, JI, JK
+INTEGER :: JL, JI, JK
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('DIAG_MISC_ISBA_N',0,ZHOOK_HANDLE)
!
-IF (DGMI%LSURF_MISC_BUDGET) THEN
+IF (OSURF_MISC_BUDGET) THEN
!
- PKDI%XP_SWI (:,:)=XUNDEF
- PKDI%XP_TSWI(:,:)=XUNDEF
- DO JJ=1,SIZE(PWG,2)
- DO JI=1,SIZE(PWG,1)
- IF(PWG (JI,JJ)/=XUNDEF)THEN
- PKDI%XP_SWI (JI,JJ) = (PWG (JI,JJ) - PWWILT(JI,JJ)) / (PWFC(JI,JJ) - PWWILT(JI,JJ))
- PKDI%XP_TSWI(JI,JJ) = (PWG (JI,JJ) - PWWILT(JI,JJ)) / (PWFC(JI,JJ) - PWWILT(JI,JJ))
+ DMK%XSWI (:,:)=XUNDEF
+ DMK%XTSWI(:,:)=XUNDEF
+ DO JL=1,SIZE(PEK%XWG,2)
+ DO JI=1,SIZE(PEK%XWG,1)
+ IF(PEK%XWG (JI,JL)/=XUNDEF)THEN
+ DMK%XSWI (JI,JL) = (PEK%XWG (JI,JL) - KK%XWWILT(JI,JL)) / (KK%XWFC(JI,JL) - KK%XWWILT(JI,JL))
+ DMK%XTSWI(JI,JL) = (PEK%XWG (JI,JL) - KK%XWWILT(JI,JL)) / (KK%XWFC(JI,JL) - KK%XWWILT(JI,JL))
ENDIF
- IF(PWGI (JI,JJ)/=XUNDEF)THEN
- PKDI%XP_TSWI(JI,JJ) = PKDI%XP_TSWI(JI,JJ) + PWGI(JI,JJ) / (PWFC(JI,JJ) - PWWILT(JI,JJ))
+ IF(PEK%XWGI (JI,JL)/=XUNDEF)THEN
+ DMK%XTSWI(JI,JL) = DMK%XTSWI(JI,JL) + PEK%XWGI(JI,JL) / (KK%XWFC(JI,JL) - KK%XWWILT(JI,JL))
ENDIF
ENDDO
ENDDO
!
- DO JK=1,SIZE(PKDI%XP_SWI,2)
-!cdir nodep
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- !
- DGMI%XSWI (JI,JK,KPATCH) = PKDI%XP_SWI (JJ,JK)
- DGMI%XTSWI (JI,JK,KPATCH) = PKDI%XP_TSWI (JJ,JK)
- !
- END DO
- ENDDO
- !
- DO JI = 1,SIZE(PWSNOW,2)
-!cdir nodep
- DO JJ = 1,SIZE(PWSNOW,1)
- ZWORK(JJ,JI) = PWSNOW(JJ,JI) / PRSNOW(JJ,JI)
+ DO JL = 1,SIZE(PEK%TSNOW%WSNOW,2)
+ DO JI = 1,SIZE(PEK%TSNOW%WSNOW,1)
+ ZWORK(JI,JL) = PEK%TSNOW%WSNOW(JI,JL) / PEK%TSNOW%RHO(JI,JL)
ENDDO
ENDDO
!
- PKDI%XP_TWSNOW=0.
- PKDI%XP_TDSNOW=0.
+ DMK%XTWSNOW=0.
+ DMK%XTDSNOW=0.
ZSNOWTEMP=0.
!
- IF (HSNOW/='EBA')THEN
- ZWORKTEMP(:,:) = PKDI%XP_SNOWTEMP(:,:)
+ IF (PEK%TSNOW%SCHEME/='EBA')THEN
+ ZWORKTEMP(:,:) = DMK%XSNOWTEMP(:,:)
ELSE
- ZWORKTEMP(:,1) = MIN(PTG(:,1),XTT)
+ ZWORKTEMP(:,1) = MIN(PEK%XTG(:,1),XTT)
ENDIF
!
- DO JI = 1,SIZE(PWSNOW,2)
-!cdir nodep
- DO JJ = 1,SIZE(PWSNOW,1)
- PKDI%XP_TWSNOW(JJ) = PKDI%XP_TWSNOW(JJ) + PWSNOW(JJ,JI)
- PKDI%XP_TDSNOW(JJ) = PKDI%XP_TDSNOW(JJ) + ZWORK (JJ,JI)
- ZSNOWTEMP(JJ) = ZSNOWTEMP(JJ) + ZWORKTEMP(JJ,JI) * ZWORK(JJ,JI)
+ DO JL = 1,SIZE(PEK%TSNOW%WSNOW,2)
+ DO JI = 1,SIZE(PEK%TSNOW%WSNOW,1)
+ DMK%XTWSNOW(JI) = DMK%XTWSNOW(JI) + PEK%TSNOW%WSNOW(JI,JL)
+ DMK%XTDSNOW(JI) = DMK%XTDSNOW(JI) + ZWORK (JI,JL)
+ ZSNOWTEMP (JI) = ZSNOWTEMP(JI) + ZWORKTEMP(JI,JL) * ZWORK(JI,JL)
ENDDO
ENDDO
!
- WHERE(PKDI%XP_TDSNOW(:)>0.0)
- ZSNOWTEMP(:)=ZSNOWTEMP(:)/PKDI%XP_TDSNOW(:)
+ WHERE(DMK%XTDSNOW(:)>0.0)
+ ZSNOWTEMP(:)=ZSNOWTEMP(:)/DMK%XTDSNOW(:)
ELSEWHERE
ZSNOWTEMP(:)=XUNDEF
ENDWHERE
!
-!cdir nodep
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- !
- DGMI%XHV (JI, KPATCH) = PKDI%XP_HV (JJ)
- DGMI%XDPSNG (JI, KPATCH) = PPSNG (JJ)
- DGMI%XDPSNV (JI, KPATCH) = PPSNV (JJ)
- DGMI%XDPSN (JI, KPATCH) = PPSN (JJ)
- DGMI%XALBT (JI, KPATCH) = PKDI%XP_ALBT (JJ)
- DGMI%XDFF (JI, KPATCH) = PFF (JJ)
- DGMI%XDFFG (JI, KPATCH) = PFFG (JJ)
- DGMI%XDFFV (JI, KPATCH) = PFFV (JJ)
- DGMI%XTWSNOW (JI, KPATCH) = PKDI%XP_TWSNOW (JJ)
- DGMI%XTDSNOW (JI, KPATCH) = PKDI%XP_TDSNOW (JJ)
- DGMI%XTTSNOW (JI, KPATCH) = ZSNOWTEMP (JJ)
- DGMI%XDFSAT (JI, KPATCH) = PFSAT (JJ)
- !
- END DO
-!
- IF (HSNOW=='3-L' .OR. HSNOW=='CRO') THEN
- !
- DO JK=1,SIZE(PKDI%XP_SNOWLIQ,2)
-!cdir nodep
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- !
- DGMI%XSNOWLIQ (JI,JK,KPATCH) = PKDI%XP_SNOWLIQ (JJ,JK)
- DGMI%XSNOWTEMP(JI,JK,KPATCH) = PKDI%XP_SNOWTEMP (JJ,JK)
- !
- END DO
- ENDDO
- !
+ DMK%XPSNG (:) = PEK%XPSNG(:)
+ DMK%XPSNV (:) = PEK%XPSNV(:)
+ DMK%XPSN (:) = PEK%XPSN (:)
+ DMK%XFF (:) = KK%XFF (:)
+ DMK%XFFG (:) = KK%XFFG (:)
+ DMK%XFFV (:) = KK%XFFV (:)
+ DMK%XFSAT (:) = KK%XFSAT (:)
+ DMK%XTTSNOW(:) = ZSNOWTEMP(:)
+ !
+ IF ( (PEK%TSNOW%SCHEME=='3-L' .OR. PEK%TSNOW%SCHEME=='CRO') .AND. OVOLUMETRIC_SNOWLIQ ) THEN
+ !
+ WHERE (DMK%XSNOWLIQ(:,:)/=XUNDEF) &
+ DMK%XSNOWLIQ(:,:) = DMK%XSNOWLIQ(:,:) * XRHOLW / DMK%XSNOWDZ(:,:)
+ !
ENDIF
-!
-! cosine of solar zenith angle
-!
-
- IF (HPHOTO/='NON'.AND.OTR_ML) THEN
- !
-!cdir nodep
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- !
- DGMI%XFAPAR (JI, KPATCH) = PKDI%XP_FAPAR (JJ)
- DGMI%XFAPIR (JI, KPATCH) = PKDI%XP_FAPIR (JJ)
- DGMI%XFAPAR_BS (JI, KPATCH) = PKDI%XP_FAPAR_BS (JJ)
- DGMI%XFAPIR_BS (JI, KPATCH) = PKDI%XP_FAPIR_BS (JJ)
- !
- ENDDO
+ !
+ ! cosine of solar zenith angle
+ !
+ IF (IO%CPHOTO/='NON'.AND.IO%LTR_ML) THEN
!
! Mask where vegetation evolution is performed (just before solar midnight)
GMASK = ( PTIME - PTSTEP < 0. ) .AND. ( PTIME >= 0. )
IF (GMASK) THEN
-!cdir nodep
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
+ DO JI=1,KSIZE
!
- IF (PMUS(JJ).NE.0.) THEN
- DGMI%XDFAPARC (JI, KPATCH) = PFAPARC (JJ) / PMUS(JJ)
- DGMI%XDFAPIRC (JI, KPATCH) = PFAPIRC (JJ) / PMUS(JJ)
- DGMI%XDLAI_EFFC (JI, KPATCH) = PLAI_EFFC (JJ) / PMUS(JJ)
+ IF (PEK%XMUS(JI).NE.0.) THEN
+ DMK%XDFAPARC (JI) = PEK%XFAPARC (JI) / PEK%XMUS(JI)
+ DMK%XDFAPIRC (JI) = PEK%XFAPIRC (JI) / PEK%XMUS(JI)
+ DMK%XDLAI_EFFC (JI) = PEK%XLAI_EFFC (JI) / PEK%XMUS(JI)
ENDIF
!
ENDDO
-!cdir nodep
- DO JJ=1,KSIZE
- PFAPARC(JJ) = 0.
- PFAPIRC(JJ) = 0.
- PLAI_EFFC(JJ) = 0.
- PMUS(JJ) = 0.
+ DO JI=1,KSIZE
+ PEK%XFAPARC(JI) = 0.
+ PEK%XFAPIRC(JI) = 0.
+ PEK%XLAI_EFFC(JI) = 0.
+ PEK%XMUS(JI) = 0.
ENDDO
ENDIF
!
ENDIF
!
- IF(HISBA=='DIF')THEN
+ IF(IO%CISBA=='DIF')THEN
ZALT(:)=0.0
ZFLT(:)=0.0
- CALL COMPUT_COLD_LAYERS_THICK(PDG,PTG,ZALT,ZFLT)
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- DGMI%XALT(JI,KPATCH) = ZALT(JJ)
- DGMI%XFLT(JI,KPATCH) = ZFLT(JJ)
+ CALL COMPUT_COLD_LAYERS_THICK(PK%XDG(:,:),PEK%XTG(:,:),ZALT,ZFLT)
+ DO JI=1,KSIZE
+ DMK%XALT(JI) = ZALT(JI)
+ DMK%XFLT(JI) = ZFLT(JI)
ENDDO
ENDIF
!
@@ -268,12 +193,8 @@ END IF
!
IF (OAGRIP) THEN
!
-!cdir nodep
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- !
- DGMI%XSEUIL (JI, KPATCH) = PSEUIL (JJ)
- !
+ DO JI=1,KSIZE
+ DMK%XSEUIL (JI) = AGK%XTHRESHOLDSPT (JI)
END DO
!
END IF
diff --git a/src/SURFEX/diag_misc_teb_initn.F90 b/src/SURFEX/diag_misc_teb_initn.F90
index 3f897c6bd225a6b46f87c39e8ad582fc7d472888..103765747772f859abe09def639894b3f30f6996 100644
--- a/src/SURFEX/diag_misc_teb_initn.F90
+++ b/src/SURFEX/diag_misc_teb_initn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ######spl
- SUBROUTINE DIAG_MISC_TEB_INIT_n (DGCT, DGMT, DGMTO, TOP, &
- HPROGRAM,KLU,KSW)
+ SUBROUTINE DIAG_MISC_TEB_INIT_n (DMTC, DMT, DMTO, TOP, KLU, KSW)
! #####################
!
!!**** *DIAG_MISC_TEB_INIT_n* - routine to initialize TEB diagnostic variables
@@ -39,9 +38,8 @@
! ------------
!
!
-USE MODD_DIAG_CUMUL_TEB_n, ONLY : DIAG_CUMUL_TEB_t
USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_t
-USE MODD_DIAG_MISC_TEB_OPTION_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
+USE MODD_DIAG_MISC_TEB_OPTIONS_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -62,14 +60,13 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(DIAG_CUMUL_TEB_t), INTENT(INOUT) :: DGCT
-TYPE(DIAG_MISC_TEB_t), INTENT(INOUT) :: DGMT
-TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: DGMTO
+TYPE(DIAG_MISC_TEB_t), INTENT(INOUT) :: DMTC
+TYPE(DIAG_MISC_TEB_t), INTENT(INOUT) :: DMT
+TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: DMTO
TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
!
INTEGER, INTENT(IN) :: KLU ! size of arrays
INTEGER, INTENT(IN) :: KSW ! spectral bands
- CHARACTER(LEN=6), INTENT(IN):: HPROGRAM ! program calling
!
!* 0.2 Declarations of local variables
! -------------------------------
@@ -86,264 +83,232 @@ IF (LHOOK) CALL DR_HOOK('DIAG_MISC_TEB_INIT_N',0,ZHOOK_HANDLE)
!
!* miscellaneous fields
!
-IF (DGMTO%LSURF_MISC_BUDGET) THEN
- ALLOCATE(DGMT%CUR%XQF_BLD (KLU))
- ALLOCATE(DGMT%CUR%XFLX_BLD (KLU))
- ALLOCATE(DGMT%CUR%XQF_TOWN (KLU))
- ALLOCATE(DGMT%CUR%XDQS_TOWN (KLU))
- ALLOCATE(DGMT%CUR%XRN_ROAD (KLU))
- ALLOCATE(DGMT%CUR%XH_ROAD (KLU))
- ALLOCATE(DGMT%CUR%XLE_ROAD (KLU))
- ALLOCATE(DGMT%CUR%XGFLUX_ROAD (KLU))
- ALLOCATE(DGMT%CUR%XRN_WALL_A (KLU))
- ALLOCATE(DGMT%CUR%XH_WALL_A (KLU))
- ALLOCATE(DGMT%CUR%XGFLUX_WALL_A (KLU))
- ALLOCATE(DGMT%CUR%XRN_WALL_B (KLU))
- ALLOCATE(DGMT%CUR%XH_WALL_B (KLU))
- ALLOCATE(DGMT%CUR%XGFLUX_WALL_B (KLU))
- ALLOCATE(DGMT%CUR%XRN_ROOF (KLU))
- ALLOCATE(DGMT%CUR%XH_ROOF (KLU))
- ALLOCATE(DGMT%CUR%XLE_ROOF (KLU))
- ALLOCATE(DGMT%CUR%XGFLUX_ROOF (KLU))
- ALLOCATE(DGMT%CUR%XRN_GARDEN (KLU))
- ALLOCATE(DGMT%CUR%XH_GARDEN (KLU))
- ALLOCATE(DGMT%CUR%XLE_GARDEN (KLU))
- ALLOCATE(DGMT%CUR%XGFLUX_GARDEN (KLU))
- ALLOCATE(DGMT%CUR%XRN_BLT (KLU))
- ALLOCATE(DGMT%CUR%XH_BLT (KLU))
- ALLOCATE(DGMT%CUR%XLE_BLT (KLU))
- ALLOCATE(DGMT%CUR%XGFLUX_BLT (KLU))
- ALLOCATE(DGMT%CUR%XRN_STRLROOF (KLU))
- ALLOCATE(DGMT%CUR%XH_STRLROOF (KLU))
- ALLOCATE(DGMT%CUR%XLE_STRLROOF (KLU))
- ALLOCATE(DGMT%CUR%XGFLUX_STRLROOF (KLU))
- ALLOCATE(DGMT%CUR%XRN_GREENROOF (KLU))
- ALLOCATE(DGMT%CUR%XH_GREENROOF (KLU))
- ALLOCATE(DGMT%CUR%XLE_GREENROOF (KLU))
- ALLOCATE(DGMT%CUR%XGFLUX_GREENROOF (KLU))
- ALLOCATE(DGMT%CUR%XG_GREENROOF_ROOF (KLU))
- ALLOCATE(DGMT%CUR%XRUNOFF_TOWN (KLU))
- ALLOCATE(DGMT%CUR%XRUNOFF_GARDEN (KLU))
- ALLOCATE(DGMT%CUR%XRUNOFF_ROAD (KLU))
- ALLOCATE(DGMT%CUR%XRUNOFF_STRLROOF (KLU))
- ALLOCATE(DGMT%CUR%XRUNOFF_ROOF (KLU))
- ALLOCATE(DGMT%CUR%XRUNOFF_GREENROOF (KLU))
- ALLOCATE(DGMT%CUR%XDRAIN_GREENROOF (KLU))
- ALLOCATE(DGMT%CUR%XDRAIN_GARDEN (KLU))
- ALLOCATE(DGMT%CUR%XIRRIG_GREENROOF (KLU))
- ALLOCATE(DGMT%CUR%XIRRIG_GARDEN (KLU))
- ALLOCATE(DGMT%CUR%XIRRIG_ROAD (KLU))
+!IF (DMTO%LSURF_MISC_BUDGET) THEN
+ ALLOCATE(DMT%XQF_BLD (KLU))
+ ALLOCATE(DMT%XFLX_BLD (KLU))
+ ALLOCATE(DMT%XQF_TOWN (KLU))
+ ALLOCATE(DMT%XDQS_TOWN (KLU))
+ ALLOCATE(DMT%XRN_ROAD (KLU))
+ ALLOCATE(DMT%XH_ROAD (KLU))
+ ALLOCATE(DMT%XLE_ROAD (KLU))
+ ALLOCATE(DMT%XGFLUX_ROAD (KLU))
+ ALLOCATE(DMT%XRN_WALL_A (KLU))
+ ALLOCATE(DMT%XH_WALL_A (KLU))
+ ALLOCATE(DMT%XGFLUX_WALL_A (KLU))
+ ALLOCATE(DMT%XRN_WALL_B (KLU))
+ ALLOCATE(DMT%XH_WALL_B (KLU))
+ ALLOCATE(DMT%XGFLUX_WALL_B (KLU))
+ ALLOCATE(DMT%XRN_ROOF (KLU))
+ ALLOCATE(DMT%XH_ROOF (KLU))
+ ALLOCATE(DMT%XLE_ROOF (KLU))
+ ALLOCATE(DMT%XGFLUX_ROOF (KLU))
+ ALLOCATE(DMT%XRN_BLT (KLU))
+ ALLOCATE(DMT%XH_BLT (KLU))
+ ALLOCATE(DMT%XLE_BLT (KLU))
+ ALLOCATE(DMT%XGFLUX_BLT (KLU))
+ ALLOCATE(DMT%XRN_STRLROOF (KLU))
+ ALLOCATE(DMT%XH_STRLROOF (KLU))
+ ALLOCATE(DMT%XLE_STRLROOF (KLU))
+ ALLOCATE(DMT%XGFLUX_STRLROOF (KLU))
+ ALLOCATE(DMT%XG_GREENROOF_ROOF (KLU))
+ ALLOCATE(DMT%XRUNOFF_TOWN (KLU))
+ ALLOCATE(DMT%XRUNOFF_ROAD (KLU))
+ ALLOCATE(DMT%XRUNOFF_STRLROOF (KLU))
+ ALLOCATE(DMT%XRUNOFF_ROOF (KLU))
+ ALLOCATE(DMT%XIRRIG_GREENROOF (KLU))
+ ALLOCATE(DMT%XIRRIG_GARDEN (KLU))
+ ALLOCATE(DMT%XIRRIG_ROAD (KLU))
!
- ALLOCATE(DGMT%CUR%XABS_SW_ROOF (KLU))
- ALLOCATE(DGMT%CUR%XABS_SW_SNOW_ROOF (KLU))
- ALLOCATE(DGMT%CUR%XABS_LW_ROOF (KLU))
- ALLOCATE(DGMT%CUR%XABS_LW_SNOW_ROOF (KLU))
- ALLOCATE(DGMT%CUR%XABS_SW_ROAD (KLU))
- ALLOCATE(DGMT%CUR%XABS_SW_SNOW_ROAD (KLU))
- ALLOCATE(DGMT%CUR%XABS_LW_ROAD (KLU))
- ALLOCATE(DGMT%CUR%XABS_LW_SNOW_ROAD (KLU))
- ALLOCATE(DGMT%CUR%XABS_SW_WALL_A (KLU))
- ALLOCATE(DGMT%CUR%XABS_SW_WALL_B (KLU))
- ALLOCATE(DGMT%CUR%XABS_LW_WALL_A (KLU))
- ALLOCATE(DGMT%CUR%XABS_LW_WALL_B (KLU))
- ALLOCATE(DGMT%CUR%XABS_SW_GARDEN (KLU))
- ALLOCATE(DGMT%CUR%XABS_LW_GARDEN (KLU))
- ALLOCATE(DGMT%CUR%XABS_SW_GREENROOF (KLU))
- ALLOCATE(DGMT%CUR%XABS_LW_GREENROOF (KLU))
+ ALLOCATE(DMT%XABS_SW_ROOF (KLU))
+ ALLOCATE(DMT%XABS_SW_SNOW_ROOF (KLU))
+ ALLOCATE(DMT%XABS_LW_ROOF (KLU))
+ ALLOCATE(DMT%XABS_LW_SNOW_ROOF (KLU))
+ ALLOCATE(DMT%XABS_SW_ROAD (KLU))
+ ALLOCATE(DMT%XABS_SW_SNOW_ROAD (KLU))
+ ALLOCATE(DMT%XABS_LW_ROAD (KLU))
+ ALLOCATE(DMT%XABS_LW_SNOW_ROAD (KLU))
+ ALLOCATE(DMT%XABS_SW_WALL_A (KLU))
+ ALLOCATE(DMT%XABS_SW_WALL_B (KLU))
+ ALLOCATE(DMT%XABS_LW_WALL_A (KLU))
+ ALLOCATE(DMT%XABS_LW_WALL_B (KLU))
+ ALLOCATE(DMT%XABS_SW_GARDEN (KLU))
+ ALLOCATE(DMT%XABS_LW_GARDEN (KLU))
+ ALLOCATE(DMT%XABS_SW_GREENROOF (KLU))
+ ALLOCATE(DMT%XABS_LW_GREENROOF (KLU))
!
- ALLOCATE(DGMT%CUR%XREF_SW_FAC (KLU))
- ALLOCATE(DGMT%CUR%XREF_SW_GRND (KLU))
+ ALLOCATE(DMT%XREF_SW_FAC (KLU))
+ ALLOCATE(DMT%XREF_SW_GRND (KLU))
!
- ALLOCATE(DGMT%CUR%XEMIT_LW_FAC (KLU))
- ALLOCATE(DGMT%CUR%XEMIT_LW_GRND (KLU))
+ ALLOCATE(DMT%XEMIT_LW_FAC (KLU))
+ ALLOCATE(DMT%XEMIT_LW_GRND (KLU))
!
- ALLOCATE(DGMT%CUR%XTCOOL_CUR_TARGET (KLU))
- ALLOCATE(DGMT%CUR%XTHEAT_CUR_TARGET (KLU))
- ALLOCATE(DGMT%CUR%XCUR_QIN (KLU))
+ ALLOCATE(DMT%XTCOOL_TARGET (KLU))
+ ALLOCATE(DMT%XTHEAT_TARGET (KLU))
+ ALLOCATE(DMT%XQIN (KLU))
!
IF (TOP%CBEM=='BEM') THEN
- ALLOCATE(DGMT%CUR%XH_BLD_COOL (KLU))
- ALLOCATE(DGMT%CUR%XT_BLD_COOL (KLU))
- ALLOCATE(DGMT%CUR%XH_BLD_HEAT (KLU))
- ALLOCATE(DGMT%CUR%XLE_BLD_COOL (KLU))
- ALLOCATE(DGMT%CUR%XLE_BLD_HEAT (KLU))
- ALLOCATE(DGMT%CUR%XH_WASTE (KLU))
- ALLOCATE(DGMT%CUR%XLE_WASTE (KLU))
- ALLOCATE(DGMT%CUR%XHVAC_COOL (KLU))
- ALLOCATE(DGMT%CUR%XHVAC_HEAT (KLU))
- ALLOCATE(DGMT%CUR%XCAP_SYS (KLU))
- ALLOCATE(DGMT%CUR%XM_SYS (KLU))
- ALLOCATE(DGMT%CUR%XCOP (KLU))
- ALLOCATE(DGMT%CUR%XQ_SYS (KLU))
- ALLOCATE(DGMT%CUR%XT_SYS (KLU))
- ALLOCATE(DGMT%CUR%XTR_SW_WIN (KLU))
- ALLOCATE(DGMT%CUR%XFAN_POWER (KLU))
- ALLOCATE(DGMT%CUR%XT_RAD_IND (KLU))
- ALLOCATE(DGMT%CUR%XHU_BLD (KLU))
- ALLOCATE(DGMT%CUR%XABS_SW_WIN (KLU))
- ALLOCATE(DGMT%CUR%XABS_LW_WIN (KLU))
+ ALLOCATE(DMT%XH_BLD_COOL (KLU))
+ ALLOCATE(DMT%XT_BLD_COOL (KLU))
+ ALLOCATE(DMT%XH_BLD_HEAT (KLU))
+ ALLOCATE(DMT%XLE_BLD_COOL (KLU))
+ ALLOCATE(DMT%XLE_BLD_HEAT (KLU))
+ ALLOCATE(DMT%XH_WASTE (KLU))
+ ALLOCATE(DMT%XLE_WASTE (KLU))
+ ALLOCATE(DMT%XHVAC_COOL (KLU))
+ ALLOCATE(DMT%XHVAC_HEAT (KLU))
+ ALLOCATE(DMT%XCAP_SYS (KLU))
+ ALLOCATE(DMT%XM_SYS (KLU))
+ ALLOCATE(DMT%XCOP (KLU))
+ ALLOCATE(DMT%XQ_SYS (KLU))
+ ALLOCATE(DMT%XT_SYS (KLU))
+ ALLOCATE(DMT%XTR_SW_WIN (KLU))
+ ALLOCATE(DMT%XFAN_POWER (KLU))
+ ALLOCATE(DMT%XT_RAD_IND (KLU))
+ ALLOCATE(DMT%XHU_BLD (KLU))
+ ALLOCATE(DMT%XABS_SW_WIN (KLU))
+ ALLOCATE(DMT%XABS_LW_WIN (KLU))
ENDIF
!
IF (TOP%LSOLAR_PANEL) THEN
- ALLOCATE(DGMT%CUR%XABS_SW_PANEL (KLU))
- ALLOCATE(DGMT%CUR%XABS_LW_PANEL (KLU))
- ALLOCATE(DGMT%CUR%XRN_PANEL (KLU))
- ALLOCATE(DGMT%CUR%XH_PANEL (KLU))
- ALLOCATE(DGMT%CUR%XTHER_PROD_PANEL(KLU))
- ALLOCATE(DGMT%CUR%XPHOT_PROD_PANEL(KLU))
- ALLOCATE(DGMT%CUR%XPROD_PANEL (KLU))
- ALLOCATE(DGMT%CUR%XTHER_PROD_BLD (KLU))
- ALLOCATE(DGMT%CUR%XPHOT_PROD_BLD (KLU))
+ ALLOCATE(DMT%XABS_SW_PANEL (KLU))
+ ALLOCATE(DMT%XABS_LW_PANEL (KLU))
+ ALLOCATE(DMT%XRN_PANEL (KLU))
+ ALLOCATE(DMT%XH_PANEL (KLU))
+ ALLOCATE(DMT%XTHER_PROD_PANEL(KLU))
+ ALLOCATE(DMT%XPHOT_PROD_PANEL(KLU))
+ ALLOCATE(DMT%XPROD_PANEL (KLU))
+ ALLOCATE(DMT%XTHER_PROD_BLD (KLU))
+ ALLOCATE(DMT%XPHOT_PROD_BLD (KLU))
END IF
!
- ALLOCATE(DGCT%CUR%XRUNOFFC_TOWN (KLU))
- ALLOCATE(DGCT%CUR%XRUNOFFC_GARDEN (KLU))
- ALLOCATE(DGCT%CUR%XDRAINC_GARDEN (KLU))
- ALLOCATE(DGCT%CUR%XIRRIGC_GARDEN (KLU))
- ALLOCATE(DGCT%CUR%XRUNOFFC_ROAD (KLU))
- ALLOCATE(DGCT%CUR%XIRRIGC_ROAD (KLU))
- ALLOCATE(DGCT%CUR%XRUNOFFC_STRLROOF (KLU))
- ALLOCATE(DGCT%CUR%XRUNOFFC_ROOF (KLU))
- ALLOCATE(DGCT%CUR%XRUNOFFC_GREENROOF (KLU))
- ALLOCATE(DGCT%CUR%XDRAINC_GREENROOF (KLU))
- ALLOCATE(DGCT%CUR%XIRRIGC_GREENROOF (KLU))
+ ALLOCATE(DMTC%XRUNOFF_TOWN (KLU))
+ ALLOCATE(DMTC%XIRRIG_GARDEN (KLU))
+ ALLOCATE(DMTC%XRUNOFF_ROAD (KLU))
+ ALLOCATE(DMTC%XIRRIG_ROAD (KLU))
+ ALLOCATE(DMTC%XRUNOFF_STRLROOF (KLU))
+ ALLOCATE(DMTC%XRUNOFF_ROOF (KLU))
+ ALLOCATE(DMTC%XIRRIG_GREENROOF (KLU))
IF (TOP%CBEM=='BEM') THEN
- ALLOCATE(DGCT%CUR%XHVACC_COOL (KLU))
- ALLOCATE(DGCT%CUR%XHVACC_HEAT (KLU))
+ ALLOCATE(DMTC%XHVAC_COOL (KLU))
+ ALLOCATE(DMTC%XHVAC_HEAT (KLU))
END IF
IF (TOP%LSOLAR_PANEL) THEN
- ALLOCATE(DGCT%CUR%XTHER_PROD_BLDC(KLU))
- ALLOCATE(DGCT%CUR%XPHOT_PROD_BLDC(KLU))
+ ALLOCATE(DMTC%XTHER_PROD_BLD(KLU))
+ ALLOCATE(DMTC%XPHOT_PROD_BLD(KLU))
END IF
- DGMT%CUR%XQF_BLD = XUNDEF
- DGMT%CUR%XFLX_BLD = XUNDEF
- DGMT%CUR%XQF_TOWN = XUNDEF
- DGMT%CUR%XDQS_TOWN = XUNDEF
- DGMT%CUR%XRN_ROAD = XUNDEF
- DGMT%CUR%XH_ROAD = XUNDEF
- DGMT%CUR%XLE_ROAD = XUNDEF
- DGMT%CUR%XGFLUX_ROAD = XUNDEF
- DGMT%CUR%XRN_WALL_A = XUNDEF
- DGMT%CUR%XH_WALL_A = XUNDEF
- DGMT%CUR%XGFLUX_WALL_A = XUNDEF
- DGMT%CUR%XRN_WALL_B = XUNDEF
- DGMT%CUR%XH_WALL_B = XUNDEF
- DGMT%CUR%XGFLUX_WALL_B = XUNDEF
- DGMT%CUR%XRN_ROOF = XUNDEF
- DGMT%CUR%XH_ROOF = XUNDEF
- DGMT%CUR%XLE_ROOF = XUNDEF
- DGMT%CUR%XGFLUX_ROOF = XUNDEF
- DGMT%CUR%XRN_GARDEN = XUNDEF
- DGMT%CUR%XH_GARDEN = XUNDEF
- DGMT%CUR%XLE_GARDEN = XUNDEF
- DGMT%CUR%XGFLUX_GARDEN = XUNDEF
- DGMT%CUR%XRN_BLT = XUNDEF
- DGMT%CUR%XH_BLT = XUNDEF
- DGMT%CUR%XLE_BLT = XUNDEF
- DGMT%CUR%XGFLUX_BLT = XUNDEF
- DGMT%CUR%XRN_STRLROOF = XUNDEF
- DGMT%CUR%XH_STRLROOF = XUNDEF
- DGMT%CUR%XLE_STRLROOF = XUNDEF
- DGMT%CUR%XGFLUX_STRLROOF = XUNDEF
- DGMT%CUR%XRN_GREENROOF = XUNDEF
- DGMT%CUR%XH_GREENROOF = XUNDEF
- DGMT%CUR%XLE_GREENROOF = XUNDEF
- DGMT%CUR%XGFLUX_GREENROOF = XUNDEF
- DGMT%CUR%XG_GREENROOF_ROOF = XUNDEF
- DGMT%CUR%XRUNOFF_TOWN = XUNDEF
- DGMT%CUR%XRUNOFF_GARDEN = XUNDEF
- DGMT%CUR%XRUNOFF_ROAD = XUNDEF
- DGMT%CUR%XRUNOFF_ROOF = XUNDEF
- DGMT%CUR%XRUNOFF_STRLROOF = XUNDEF
- DGMT%CUR%XRUNOFF_GREENROOF = XUNDEF
- DGMT%CUR%XDRAIN_GREENROOF = XUNDEF
- DGMT%CUR%XDRAIN_GARDEN = XUNDEF
- DGMT%CUR%XIRRIG_GREENROOF = XUNDEF
- DGMT%CUR%XIRRIG_GARDEN = XUNDEF
- DGMT%CUR%XIRRIG_ROAD = XUNDEF
+ DMT%XQF_BLD = XUNDEF
+ DMT%XFLX_BLD = XUNDEF
+ DMT%XQF_TOWN = XUNDEF
+ DMT%XDQS_TOWN = XUNDEF
+ DMT%XRN_ROAD = XUNDEF
+ DMT%XH_ROAD = XUNDEF
+ DMT%XLE_ROAD = XUNDEF
+ DMT%XGFLUX_ROAD = XUNDEF
+ DMT%XRN_WALL_A = XUNDEF
+ DMT%XH_WALL_A = XUNDEF
+ DMT%XGFLUX_WALL_A = XUNDEF
+ DMT%XRN_WALL_B = XUNDEF
+ DMT%XH_WALL_B = XUNDEF
+ DMT%XGFLUX_WALL_B = XUNDEF
+ DMT%XRN_ROOF = XUNDEF
+ DMT%XH_ROOF = XUNDEF
+ DMT%XLE_ROOF = XUNDEF
+ DMT%XGFLUX_ROOF = XUNDEF
+ DMT%XRN_BLT = XUNDEF
+ DMT%XH_BLT = XUNDEF
+ DMT%XLE_BLT = XUNDEF
+ DMT%XGFLUX_BLT = XUNDEF
+ DMT%XRN_STRLROOF = XUNDEF
+ DMT%XH_STRLROOF = XUNDEF
+ DMT%XLE_STRLROOF = XUNDEF
+ DMT%XGFLUX_STRLROOF = XUNDEF
+ DMT%XG_GREENROOF_ROOF = XUNDEF
+ DMT%XRUNOFF_TOWN = XUNDEF
+ DMT%XRUNOFF_ROAD = XUNDEF
+ DMT%XRUNOFF_ROOF = XUNDEF
+ DMT%XRUNOFF_STRLROOF = XUNDEF
+ DMT%XIRRIG_GREENROOF = XUNDEF
+ DMT%XIRRIG_GARDEN = XUNDEF
+ DMT%XIRRIG_ROAD = XUNDEF
!
- DGMT%CUR%XABS_SW_ROOF = XUNDEF
- DGMT%CUR%XABS_SW_SNOW_ROOF = XUNDEF
- DGMT%CUR%XABS_LW_ROOF = XUNDEF
- DGMT%CUR%XABS_LW_SNOW_ROOF = XUNDEF
- DGMT%CUR%XABS_SW_ROAD = XUNDEF
- DGMT%CUR%XABS_SW_SNOW_ROAD = XUNDEF
- DGMT%CUR%XABS_LW_ROAD = XUNDEF
- DGMT%CUR%XABS_LW_SNOW_ROAD = XUNDEF
- DGMT%CUR%XABS_SW_WALL_A = XUNDEF
- DGMT%CUR%XABS_SW_WALL_B = XUNDEF
- DGMT%CUR%XABS_LW_WALL_A = XUNDEF
- DGMT%CUR%XABS_LW_WALL_B = XUNDEF
- DGMT%CUR%XABS_SW_GARDEN = XUNDEF
- DGMT%CUR%XABS_LW_GARDEN = XUNDEF
- DGMT%CUR%XABS_SW_GREENROOF = XUNDEF
- DGMT%CUR%XABS_LW_GREENROOF = XUNDEF
+ DMT%XABS_SW_ROOF = XUNDEF
+ DMT%XABS_SW_SNOW_ROOF = XUNDEF
+ DMT%XABS_LW_ROOF = XUNDEF
+ DMT%XABS_LW_SNOW_ROOF = XUNDEF
+ DMT%XABS_SW_ROAD = XUNDEF
+ DMT%XABS_SW_SNOW_ROAD = XUNDEF
+ DMT%XABS_LW_ROAD = XUNDEF
+ DMT%XABS_LW_SNOW_ROAD = XUNDEF
+ DMT%XABS_SW_WALL_A = XUNDEF
+ DMT%XABS_SW_WALL_B = XUNDEF
+ DMT%XABS_LW_WALL_A = XUNDEF
+ DMT%XABS_LW_WALL_B = XUNDEF
+ DMT%XABS_SW_GARDEN = XUNDEF
+ DMT%XABS_LW_GARDEN = XUNDEF
+ DMT%XABS_SW_GREENROOF = XUNDEF
+ DMT%XABS_LW_GREENROOF = XUNDEF
!
- DGMT%CUR%XREF_SW_FAC = XUNDEF
- DGMT%CUR%XREF_SW_GRND = XUNDEF
+ DMT%XREF_SW_FAC = XUNDEF
+ DMT%XREF_SW_GRND = XUNDEF
!
- DGMT%CUR%XEMIT_LW_FAC = XUNDEF
- DGMT%CUR%XEMIT_LW_GRND = XUNDEF
+ DMT%XEMIT_LW_FAC = XUNDEF
+ DMT%XEMIT_LW_GRND = XUNDEF
!
- DGMT%CUR%XTCOOL_CUR_TARGET = XUNDEF
- DGMT%CUR%XTHEAT_CUR_TARGET = XUNDEF
- DGMT%CUR%XCUR_QIN = XUNDEF
+ DMT%XTCOOL_TARGET = XUNDEF
+ DMT%XTHEAT_TARGET = XUNDEF
+ DMT%XQIN = XUNDEF
!
IF (TOP%CBEM=='BEM') THEN
- DGMT%CUR%XH_BLD_COOL = XUNDEF
- DGMT%CUR%XT_BLD_COOL = XUNDEF
- DGMT%CUR%XH_BLD_HEAT = XUNDEF
- DGMT%CUR%XLE_BLD_COOL = XUNDEF
- DGMT%CUR%XLE_BLD_HEAT = XUNDEF
- DGMT%CUR%XH_WASTE = XUNDEF
- DGMT%CUR%XLE_WASTE = XUNDEF
- DGMT%CUR%XHVAC_COOL = XUNDEF
- DGMT%CUR%XHVAC_HEAT = XUNDEF
- DGMT%CUR%XCAP_SYS = XUNDEF
- DGMT%CUR%XM_SYS = XUNDEF
- DGMT%CUR%XCOP = XUNDEF
- DGMT%CUR%XQ_SYS = XUNDEF
- DGMT%CUR%XT_SYS = XUNDEF
- DGMT%CUR%XTR_SW_WIN = XUNDEF
- DGMT%CUR%XFAN_POWER = XUNDEF
- DGMT%CUR%XT_RAD_IND = XUNDEF
- DGMT%CUR%XHU_BLD = XUNDEF
- DGMT%CUR%XABS_SW_WIN = XUNDEF
- DGMT%CUR%XABS_LW_WIN = XUNDEF
+ DMT%XH_BLD_COOL = XUNDEF
+ DMT%XT_BLD_COOL = XUNDEF
+ DMT%XH_BLD_HEAT = XUNDEF
+ DMT%XLE_BLD_COOL = XUNDEF
+ DMT%XLE_BLD_HEAT = XUNDEF
+ DMT%XH_WASTE = XUNDEF
+ DMT%XLE_WASTE = XUNDEF
+ DMT%XHVAC_COOL = XUNDEF
+ DMT%XHVAC_HEAT = XUNDEF
+ DMT%XCAP_SYS = XUNDEF
+ DMT%XM_SYS = XUNDEF
+ DMT%XCOP = XUNDEF
+ DMT%XQ_SYS = XUNDEF
+ DMT%XT_SYS = XUNDEF
+ DMT%XTR_SW_WIN = XUNDEF
+ DMT%XFAN_POWER = XUNDEF
+ DMT%XT_RAD_IND = XUNDEF
+ DMT%XHU_BLD = XUNDEF
+ DMT%XABS_SW_WIN = XUNDEF
+ DMT%XABS_LW_WIN = XUNDEF
ENDIF
IF (TOP%LSOLAR_PANEL) THEN
- DGMT%CUR%XABS_SW_PANEL = XUNDEF
- DGMT%CUR%XABS_LW_PANEL = XUNDEF
- DGMT%CUR%XRN_PANEL = XUNDEF
- DGMT%CUR%XH_PANEL = XUNDEF
- DGMT%CUR%XTHER_PROD_PANEL= XUNDEF
- DGMT%CUR%XPHOT_PROD_PANEL= XUNDEF
- DGMT%CUR%XPROD_PANEL = XUNDEF
- DGMT%CUR%XTHER_PROD_BLD = XUNDEF
- DGMT%CUR%XPHOT_PROD_BLD = XUNDEF
+ DMT%XABS_SW_PANEL = XUNDEF
+ DMT%XABS_LW_PANEL = XUNDEF
+ DMT%XRN_PANEL = XUNDEF
+ DMT%XH_PANEL = XUNDEF
+ DMT%XTHER_PROD_PANEL= XUNDEF
+ DMT%XPHOT_PROD_PANEL= XUNDEF
+ DMT%XPROD_PANEL = XUNDEF
+ DMT%XTHER_PROD_BLD = XUNDEF
+ DMT%XPHOT_PROD_BLD = XUNDEF
END IF
!
- DGCT%CUR%XRUNOFFC_TOWN = 0.0
- DGCT%CUR%XRUNOFFC_GARDEN = 0.0
- DGCT%CUR%XRUNOFFC_ROAD = 0.0
- DGCT%CUR%XRUNOFFC_ROOF = 0.0
- DGCT%CUR%XRUNOFFC_STRLROOF = 0.0
- DGCT%CUR%XRUNOFFC_GREENROOF = 0.0
- DGCT%CUR%XDRAINC_GREENROOF = 0.0
- DGCT%CUR%XDRAINC_GARDEN = 0.0
- DGCT%CUR%XIRRIGC_GREENROOF = 0.0
- DGCT%CUR%XIRRIGC_GARDEN = 0.0
- DGCT%CUR%XIRRIGC_ROAD = 0.0
+ DMTC%XRUNOFF_TOWN = 0.0
+ DMTC%XRUNOFF_ROAD = 0.0
+ DMTC%XRUNOFF_ROOF = 0.0
+ DMTC%XRUNOFF_STRLROOF = 0.0
+ DMTC%XIRRIG_GREENROOF = 0.0
+ DMTC%XIRRIG_GARDEN = 0.0
+ DMTC%XIRRIG_ROAD = 0.0
IF (TOP%CBEM=='BEM') THEN
- DGCT%CUR%XHVACC_COOL = 0.0
- DGCT%CUR%XHVACC_HEAT = 0.0
+ DMTC%XHVAC_COOL = 0.0
+ DMTC%XHVAC_HEAT = 0.0
END IF
IF (TOP%LSOLAR_PANEL) THEN
- DGCT%CUR%XTHER_PROD_BLDC = 0.
- DGCT%CUR%XPHOT_PROD_BLDC = 0.
+ DMTC%XTHER_PROD_BLD = 0.
+ DMTC%XPHOT_PROD_BLD = 0.
END IF
-ENDIF
+!ENDIF
!
IF (LHOOK) CALL DR_HOOK('DIAG_MISC_TEB_INIT_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/diag_misc_tebn.F90 b/src/SURFEX/diag_misc_tebn.F90
deleted file mode 100644
index a57330c6637342d0f44e12409caac791d1a39ca3..0000000000000000000000000000000000000000
--- a/src/SURFEX/diag_misc_tebn.F90
+++ /dev/null
@@ -1,321 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE DIAG_MISC_TEB_n (DGCT, DGMT, DGMTO, TOP, &
- PTSTEP, PDQS_TOWN,PQF_BLD,PQF_TOWN, PFLX_BLD, &
- PRUNOFF_TOWN, &
- PRN_ROAD, PH_ROAD, PLE_ROAD, PGFLUX_ROAD, &
- PRUNOFF_ROAD, PIRRIG_ROAD, &
- PRN_WALL_A, PH_WALL_A, PGFLUX_WALL_A, &
- PRN_WALL_B, PH_WALL_B, PGFLUX_WALL_B, &
- PRN_ROOF, PH_ROOF, PLE_ROOF, PGFLUX_ROOF, &
- PRUNOFF_ROOF, &
- PRN_STRLROOF, PH_STRLROOF, &
- PLE_STRLROOF, PGFLUX_STRLROOF, &
- PRUNOFF_STRLROOF, &
- PRN_GREENROOF, PH_GREENROOF, &
- PLE_GREENROOF, PGFLUX_GREENROOF, PG_GREENROOF_ROOF, &
- PRUNOFF_GREENROOF, PDRAIN_GREENROOF, PIRRIG_GREENROOF, &
- PRN_GARDEN,PH_GARDEN,PLE_GARDEN,PGFLUX_GARDEN, &
- PRUNOFF_GARDEN, PDRAIN_GARDEN, PIRRIG_GARDEN, &
- PRN_BLT,PH_BLT,PLE_BLT,PGFLUX_BLT, &
- PABS_SW_ROOF,PABS_LW_ROOF, &
- PABS_SW_SNOW_ROOF,PABS_LW_SNOW_ROOF, &
- PABS_SW_ROAD,PABS_LW_ROAD, &
- PABS_SW_SNOW_ROAD,PABS_LW_SNOW_ROAD, &
- PABS_SW_WALL_A, PABS_LW_WALL_A, &
- PABS_SW_WALL_B, PABS_LW_WALL_B, &
- PABS_SW_GARDEN,PABS_LW_GARDEN, &
- PABS_SW_GREENROOF,PABS_LW_GREENROOF, &
- PH_BLD_COOL, PT_BLD_COOL, &
- PH_BLD_HEAT, PLE_BLD_COOL, PLE_BLD_HEAT, &
- PH_WASTE, PLE_WASTE, PHVAC_COOL, &
- PHVAC_HEAT, PCAP_SYS, PM_SYS, PCOP, &
- PQ_SYS, PT_SYS, PTR_SW_WIN, PFAN_POWER, &
- PABS_SW_WIN, PABS_LW_WIN, &
- PTCOOL_TARGET, PTHEAT_TARGET, PQIN, &
- PABS_SW_PANEL, PABS_LW_PANEL, PRN_PANEL, &
- PH_PANEL, PTHER_PROD_PANEL, PPHOT_PROD_PANEL, &
- PPROD_PANEL, PTHER_PROD_BLD, PPHOT_PROD_BLD )
-! ###############################################################################
-!
-!!**** *DIAG_MISC-TEB_n * - additional diagnostics for TEB
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! P. Le Moigne
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 10/2005
-!!------------------------------------------------------------------
-!
-!
-!
-!
-!
-!
-USE MODD_DIAG_CUMUL_TEB_n, ONLY : DIAG_CUMUL_TEB_t
-USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_t
-USE MODD_DIAG_MISC_TEB_OPTION_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
-USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-!
-USE MODI_CUMUL_DIAG_TEB_n
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(DIAG_CUMUL_TEB_t), INTENT(INOUT) :: DGCT
-TYPE(DIAG_MISC_TEB_t), INTENT(INOUT) :: DGMT
-TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: DGMTO
-TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
-!
- REAL, INTENT(IN) :: PTSTEP ! time step
- REAL, DIMENSION(:), INTENT(IN) :: PQF_BLD ! domestic heating
- REAL, DIMENSION(:), INTENT(IN) :: PFLX_BLD ! heat flux from bld
- REAL, DIMENSION(:), INTENT(IN) :: PQF_TOWN ! total anthropogenic heat
- REAL, DIMENSION(:), INTENT(IN) :: PDQS_TOWN ! storage inside town mat.
- REAL, DIMENSION(:), INTENT(IN) :: PRN_ROAD ! net radiation for roads
- REAL, DIMENSION(:), INTENT(IN) :: PH_ROAD ! sensible heat flux for roads
- REAL, DIMENSION(:), INTENT(IN) :: PLE_ROAD ! latent heat flux for roads
- REAL, DIMENSION(:), INTENT(IN) :: PGFLUX_ROAD ! storage flux for roads
- REAL, DIMENSION(:), INTENT(IN) :: PRUNOFF_ROAD ! runoff for roads
- REAL, DIMENSION(:), INTENT(IN) :: PIRRIG_ROAD ! water supply for watering of roads
- REAL, DIMENSION(:), INTENT(IN) :: PRN_WALL_A ! net radiation for wall
- REAL, DIMENSION(:), INTENT(IN) :: PH_WALL_A ! sensible heat flux for walls
- REAL, DIMENSION(:), INTENT(IN) :: PGFLUX_WALL_A ! storage flux for walls
- REAL, DIMENSION(:), INTENT(IN) :: PRN_WALL_B ! net radiation for wall
- REAL, DIMENSION(:), INTENT(IN) :: PH_WALL_B ! sensible heat flux for walls
- REAL, DIMENSION(:), INTENT(IN) :: PGFLUX_WALL_B ! storage flux for walls
- REAL, DIMENSION(:), INTENT(IN) :: PRN_ROOF ! net radiation for roofs
- REAL, DIMENSION(:), INTENT(IN) :: PH_ROOF ! sensible heat flux for roofs
- REAL, DIMENSION(:), INTENT(IN) :: PLE_ROOF ! latent heat flux for roofs
- REAL, DIMENSION(:), INTENT(IN) :: PGFLUX_ROOF ! storage flux for roofs
- REAL, DIMENSION(:), INTENT(IN) :: PRUNOFF_ROOF ! aggregated runoff for roof
- REAL, DIMENSION(:), INTENT(IN) :: PRUNOFF_TOWN ! aggregated runoff for town
- REAL, DIMENSION(:), INTENT(IN) :: PRN_STRLROOF ! net radiation for structural roofs
- REAL, DIMENSION(:), INTENT(IN) :: PH_STRLROOF ! sensible heat flux for structural roofs
- REAL, DIMENSION(:), INTENT(IN) :: PLE_STRLROOF ! latent heat flux for structural roofs
- REAL, DIMENSION(:), INTENT(IN) :: PGFLUX_STRLROOF ! storage flux for structural roofs
- REAL, DIMENSION(:), INTENT(IN) :: PRUNOFF_STRLROOF ! runoff for structural roofs
- REAL, DIMENSION(:), INTENT(IN) :: PRN_GREENROOF ! net radiation for green roofs
- REAL, DIMENSION(:), INTENT(IN) :: PH_GREENROOF ! sensible heat flux for green roofs
- REAL, DIMENSION(:), INTENT(IN) :: PLE_GREENROOF ! latent heat flux for green roofs
- REAL, DIMENSION(:), INTENT(IN) :: PGFLUX_GREENROOF ! storage flux for green roofs
- REAL, DIMENSION(:), INTENT(IN) :: PG_GREENROOF_ROOF ! heat flux between green/structural roofs
- REAL, DIMENSION(:), INTENT(IN) :: PRUNOFF_GREENROOF ! runoff for green roofs
- REAL, DIMENSION(:), INTENT(IN) :: PDRAIN_GREENROOF ! total vertical drainage for green roofs
- REAL, DIMENSION(:), INTENT(IN) :: PIRRIG_GREENROOF ! water supply from green roof ground irrigation
- REAL, DIMENSION(:), INTENT(IN) :: PRN_GARDEN ! net radiation for GARDEN areas
- REAL, DIMENSION(:), INTENT(IN) :: PH_GARDEN ! sensible heat flux for GARDEN areas
- REAL, DIMENSION(:), INTENT(IN) :: PLE_GARDEN ! latent heat flux for GARDEN areas
- REAL, DIMENSION(:), INTENT(IN) :: PGFLUX_GARDEN ! storage flux for GARDEN areas
- REAL, DIMENSION(:), INTENT(IN) :: PRUNOFF_GARDEN ! runoff for green areas
- REAL, DIMENSION(:), INTENT(IN) :: PDRAIN_GARDEN ! drainage for green areas
- REAL, DIMENSION(:), INTENT(IN) :: PIRRIG_GARDEN ! water supply for irrigation for green areas
- REAL, DIMENSION(:), INTENT(IN) :: PRN_BLT ! net radiation for built surf
- REAL, DIMENSION(:), INTENT(IN) :: PH_BLT ! sensible heat flux for built surf
- REAL, DIMENSION(:), INTENT(IN) :: PLE_BLT ! latent heat flux for built surf
- REAL, DIMENSION(:), INTENT(IN) :: PGFLUX_BLT ! storage flux for built surf
-!
- REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_ROOF ! Sdown absorbed by roofs
- REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_SNOW_ROOF ! Sdown absorbed by snow on roofs
- REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_ROOF ! Ldown absorbed by roofs
- REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_SNOW_ROOF ! Ldown absorbed by snow on roofs
- REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_ROAD ! Sdown absorbed by roads
- REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_SNOW_ROAD ! Sdown absorbed by snow on roads
- REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_ROAD ! Ldown absorbed by roads
- REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_SNOW_ROAD ! Ldown absorbed by snow on roads
- REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_WALL_A ! Sdown absorbed by walls
- REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_WALL_A ! Ldown absorbed by walls
- REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_WALL_B ! Sdown absorbed by walls
- REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_WALL_B ! Ldown absorbed by walls
- REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_GARDEN ! Sdown absorbed by GARDEN areas
- REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_GARDEN ! Ldown absorbed by GARDEN areas
- REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_GREENROOF ! Sdown absorbed by green roofs
- REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_GREENROOF ! Ldown absorbed by green roofs
-! new arguments after BEM
- REAL, DIMENSION(:), INTENT(IN) :: PH_BLD_COOL ! Sensible cooling energy demand
- ! of the building [W m-2(bld)]
- REAL, DIMENSION(:), INTENT(IN) :: PT_BLD_COOL ! Total cooling energy demand
- ! of the building [W m-2(bld)]
- REAL, DIMENSION(:), INTENT(IN) :: PH_BLD_HEAT ! Heating energy demand
- ! of the building [W m-2(bld)]
- REAL, DIMENSION(:), INTENT(IN) :: PLE_BLD_COOL ! Latent cooling energy demand
- ! of the building [W m-2(bld)]
- REAL, DIMENSION(:), INTENT(IN) :: PLE_BLD_HEAT ! Latent heating energy demand
- ! of the building [W m-2(bld)]
- REAL, DIMENSION(:), INTENT(IN) :: PH_WASTE ! Sensible waste heat from HVAC system
- ! [W m-2(bld)]
- REAL, DIMENSION(:), INTENT(IN) :: PLE_WASTE ! Latent waste heat from HVAC system
- ! [W m-2(bld)]
- REAL, DIMENSION(:), INTENT(IN) :: PHVAC_COOL ! Energy consumption of the cooling system
- ! [W m-2(bld)]
- REAL, DIMENSION(:), INTENT(IN) :: PHVAC_HEAT ! Energy consumption of the heating system
- ! [W m-2(bld)]
- REAL, DIMENSION(:), INTENT(IN) :: PCAP_SYS ! Actual capacity of the cooling system
- ! [W m-2(bld)]
- REAL, DIMENSION(:), INTENT(IN) :: PM_SYS ! Actual HVAC mass flow rate
- ! [kg s-1 m-2(bld)]
- REAL, DIMENSION(:), INTENT(IN) :: PCOP ! COP of the cooling system
- REAL, DIMENSION(:), INTENT(IN) :: PQ_SYS ! Supply air specific humidity [kg kg-1]
- REAL, DIMENSION(:), INTENT(IN) :: PT_SYS ! Supply air temperature [K]
- REAL, DIMENSION(:), INTENT(IN) :: PTR_SW_WIN ! Solar radiation transmitted throught
- ! windows [W m-2(bld)]
- REAL, DIMENSION(:), INTENT(IN) :: PFAN_POWER ! HVAC fan power
- REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_WIN ! window absorbed shortwave radiation [W m-2]
- REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_WIN ! absorbed infrared rad. [W m-2]
- !
- REAL, DIMENSION(:), INTENT(IN) :: PTCOOL_TARGET ! Cooling system set point modulated by bld_occ_calendar [K]
- REAL, DIMENSION(:), INTENT(IN) :: PTHEAT_TARGET ! Heating system set point modulated by bld_occ_calendar [K]
- REAL, DIMENSION(:), INTENT(IN) :: PQIN ! Building interal heat load modulated by bld_occ_calendar [W m-2(floor)]
-!
- REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_PANEL ! absorbed solar energy by solar panels [W m-2(panel)]
- REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_PANEL ! absorbed longwave energy by solar panels [W m-2(panel)]
- REAL, DIMENSION(:), INTENT(IN) :: PRN_PANEL ! net radiation of solar panels [W m-2(panel)]
- REAL, DIMENSION(:), INTENT(IN) :: PH_PANEL ! sensible heat flux of solar panels [W m-2(panel)]
- REAL, DIMENSION(:), INTENT(IN) :: PTHER_PROD_PANEL ! thermal production of solar panels [W m-2(panel)]
- REAL, DIMENSION(:), INTENT(IN) :: PPHOT_PROD_PANEL ! photovoltaic production of solar panels [W m-2(panel)]
- REAL, DIMENSION(:), INTENT(IN) :: PPROD_PANEL ! averaged production of solar panels [W m-2(panel)]
- REAL, DIMENSION(:), INTENT(IN) :: PTHER_PROD_BLD ! thermal production of solar panels [W m-2(bld)]
- REAL, DIMENSION(:), INTENT(IN) :: PPHOT_PROD_BLD ! photovoltaic production of solar panels [W m-2(bld)]
-!
-!* 0.2 declarations of local variables
-!
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_MISC_TEB_N',0,ZHOOK_HANDLE)
-IF (DGMTO%LSURF_MISC_BUDGET) THEN
- DGMT%CUR%XQF_BLD = PQF_BLD
- DGMT%CUR%XFLX_BLD = PFLX_BLD
- DGMT%CUR%XQF_TOWN = PQF_TOWN
- DGMT%CUR%XDQS_TOWN = PDQS_TOWN
- DGMT%CUR%XRN_ROAD = PRN_ROAD
- DGMT%CUR%XH_ROAD = PH_ROAD
- DGMT%CUR%XLE_ROAD = PLE_ROAD
- DGMT%CUR%XGFLUX_ROAD = PGFLUX_ROAD
- DGMT%CUR%XRN_WALL_A = PRN_WALL_A
- DGMT%CUR%XH_WALL_A = PH_WALL_A
- DGMT%CUR%XGFLUX_WALL_A = PGFLUX_WALL_A
- DGMT%CUR%XRN_WALL_B = PRN_WALL_B
- DGMT%CUR%XH_WALL_B = PH_WALL_B
- DGMT%CUR%XGFLUX_WALL_B = PGFLUX_WALL_B
- DGMT%CUR%XRN_ROOF = PRN_ROOF
- DGMT%CUR%XH_ROOF = PH_ROOF
- DGMT%CUR%XLE_ROOF = PLE_ROOF
- DGMT%CUR%XGFLUX_ROOF = PGFLUX_ROOF
- DGMT%CUR%XRN_STRLROOF = PRN_STRLROOF
- DGMT%CUR%XH_STRLROOF = PH_STRLROOF
- DGMT%CUR%XLE_STRLROOF = PLE_STRLROOF
- DGMT%CUR%XGFLUX_STRLROOF = PGFLUX_STRLROOF
- DGMT%CUR%XRN_GREENROOF = PRN_GREENROOF
- DGMT%CUR%XH_GREENROOF = PH_GREENROOF
- DGMT%CUR%XLE_GREENROOF = PLE_GREENROOF
- DGMT%CUR%XGFLUX_GREENROOF = PGFLUX_GREENROOF
- DGMT%CUR%XG_GREENROOF_ROOF = PG_GREENROOF_ROOF
- DGMT%CUR%XRUNOFF_TOWN = PRUNOFF_TOWN
- DGMT%CUR%XRUNOFF_GARDEN = PRUNOFF_GARDEN
- DGMT%CUR%XRUNOFF_ROAD = PRUNOFF_ROAD
- DGMT%CUR%XRUNOFF_ROOF = PRUNOFF_ROOF
- DGMT%CUR%XRUNOFF_STRLROOF = PRUNOFF_STRLROOF
- DGMT%CUR%XRUNOFF_GREENROOF = PRUNOFF_GREENROOF
- DGMT%CUR%XDRAIN_GARDEN = PDRAIN_GARDEN
- DGMT%CUR%XDRAIN_GREENROOF = PDRAIN_GREENROOF
- DGMT%CUR%XIRRIG_ROAD = PIRRIG_ROAD
- DGMT%CUR%XIRRIG_GARDEN = PIRRIG_GARDEN
- DGMT%CUR%XIRRIG_GREENROOF = PIRRIG_GREENROOF
- DGMT%CUR%XRN_GARDEN = PRN_GARDEN
- DGMT%CUR%XH_GARDEN = PH_GARDEN
- DGMT%CUR%XLE_GARDEN = PLE_GARDEN
- DGMT%CUR%XGFLUX_GARDEN = PGFLUX_GARDEN
- DGMT%CUR%XRN_BLT = PRN_BLT
- DGMT%CUR%XH_BLT = PH_BLT
- DGMT%CUR%XLE_BLT = PLE_BLT
- DGMT%CUR%XGFLUX_BLT = PGFLUX_BLT
-!
- DGMT%CUR%XABS_SW_ROOF = PABS_SW_ROOF
- DGMT%CUR%XABS_LW_ROOF = PABS_LW_ROOF
- DGMT%CUR%XABS_SW_SNOW_ROOF = PABS_SW_SNOW_ROOF
- DGMT%CUR%XABS_LW_SNOW_ROOF = PABS_LW_SNOW_ROOF
- DGMT%CUR%XABS_SW_ROAD = PABS_SW_ROAD
- DGMT%CUR%XABS_LW_ROAD = PABS_LW_ROAD
- DGMT%CUR%XABS_SW_SNOW_ROAD = PABS_SW_SNOW_ROAD
- DGMT%CUR%XABS_LW_SNOW_ROAD = PABS_LW_SNOW_ROAD
- DGMT%CUR%XABS_SW_WALL_A = PABS_SW_WALL_A
- DGMT%CUR%XABS_LW_WALL_A = PABS_LW_WALL_A
- DGMT%CUR%XABS_SW_WALL_B = PABS_SW_WALL_B
- DGMT%CUR%XABS_LW_WALL_B = PABS_LW_WALL_B
- DGMT%CUR%XABS_SW_GARDEN = PABS_SW_GARDEN
- DGMT%CUR%XABS_LW_GARDEN = PABS_LW_GARDEN
- DGMT%CUR%XABS_SW_GREENROOF = PABS_SW_GREENROOF
- DGMT%CUR%XABS_LW_GREENROOF = PABS_LW_GREENROOF
- !
- IF (TOP%CBEM=='BEM') THEN
- DGMT%CUR%XH_BLD_COOL = PH_BLD_COOL
- DGMT%CUR%XT_BLD_COOL = PT_BLD_COOL
- DGMT%CUR%XH_BLD_HEAT = PH_BLD_HEAT
- DGMT%CUR%XLE_BLD_COOL= PLE_BLD_COOL
- DGMT%CUR%XLE_BLD_HEAT= PLE_BLD_HEAT
- DGMT%CUR%XH_WASTE = PH_WASTE
- DGMT%CUR%XLE_WASTE = PLE_WASTE
- DGMT%CUR%XHVAC_COOL = PHVAC_COOL
- DGMT%CUR%XHVAC_HEAT = PHVAC_HEAT
- DGMT%CUR%XCAP_SYS = PCAP_SYS
- DGMT%CUR%XM_SYS = PM_SYS
- DGMT%CUR%XCOP = PCOP
- DGMT%CUR%XQ_SYS = PQ_SYS
- DGMT%CUR%XT_SYS = PT_SYS
- DGMT%CUR%XTR_SW_WIN = PTR_SW_WIN
- DGMT%CUR%XFAN_POWER = PFAN_POWER
- !
- DGMT%CUR%XABS_SW_WIN = PABS_SW_WIN
- DGMT%CUR%XABS_LW_WIN = PABS_LW_WIN
- !
- DGMT%CUR%XTCOOL_CUR_TARGET = PTCOOL_TARGET
- DGMT%CUR%XTHEAT_CUR_TARGET = PTHEAT_TARGET
- DGMT%CUR%XCUR_QIN = PQIN
- ENDIF
- !
- IF (TOP%LSOLAR_PANEL) THEN
- DGMT%CUR%XABS_SW_PANEL = PABS_SW_PANEL
- DGMT%CUR%XABS_LW_PANEL = PABS_LW_PANEL
- DGMT%CUR%XRN_PANEL = PRN_PANEL
- DGMT%CUR%XH_PANEL = PH_PANEL
- DGMT%CUR%XTHER_PROD_PANEL = PTHER_PROD_PANEL
- DGMT%CUR%XPHOT_PROD_PANEL = PPHOT_PROD_PANEL
- DGMT%CUR%XPROD_PANEL = PPROD_PANEL
- DGMT%CUR%XTHER_PROD_BLD = PTHER_PROD_BLD
- DGMT%CUR%XPHOT_PROD_BLD = PPHOT_PROD_BLD
- END IF
- !
- ! cumulated diagnostics
- ! ---------------------
- !
- CALL CUMUL_DIAG_TEB_n(DGCT, DGMT, TOP, &
- PTSTEP)
- !
-END IF
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_MISC_TEB_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE DIAG_MISC_TEB_n
diff --git a/src/SURFEX/diag_naturen.F90 b/src/SURFEX/diag_naturen.F90
index 5395a502608bafc8412ec605789fc010bc113674..eb389e625ba4d14f825f6dfa39c678018f13db4e 100644
--- a/src/SURFEX/diag_naturen.F90
+++ b/src/SURFEX/diag_naturen.F90
@@ -3,15 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE DIAG_NATURE_n (DGEI, DGL, DGI, U, &
- HPROGRAM, &
- PRN, PH, PLE, PLEI, PGFLUX, PRI, PCD, PCH, PCE, PQS, &
- PZ0, PZ0H, PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M, &
- PSWD, PSWU, PSWBD, PSWBU, PLWD, PLWU, PFMU, PFMV, &
- PRNC, PHC, PLEC, PGFLUXC, PSWDC, PSWUC, PLWDC, &
- PLWUC, PFMUC, PFMVC, PT2M_MIN, PT2M_MAX, PLEIC, &
- PHU2M_MIN, PHU2M_MAX, PWIND10M, PWIND10M_MAX, &
- PEVAP, PEVAPC, PSUBL, PSUBLC )
+SUBROUTINE DIAG_NATURE_n (DLO, DL, DLC, ID, HNATURE, &
+ HPROGRAM, DUP, DUPC, KMASK )
! ###############################################################################
!
!!**** *DIAG_NATURE_n * - Chooses the surface schemes for diagnostics over
@@ -40,22 +33,14 @@ SUBROUTINE DIAG_NATURE_n (DGEI, DGL, DGI, U, &
! P. Le Moigne 03/2015 : add diagnostics IDEAL case
!!------------------------------------------------------------------
!
-
-!
-!
-!
+USE MODE_DIAG
!
USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
-USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
+USE MODD_SURFEX_n, ONLY : ISBA_DIAG_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
-USE MODI_DIAG_ISBA_n
-USE MODI_DIAG_IDEAL_n
-!
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -63,139 +48,43 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DLO
+TYPE(DIAG_t), INTENT(INOUT) :: DL
+TYPE(DIAG_t), INTENT(INOUT) :: DLC
+TYPE(ISBA_DIAG_t), INTENT(INOUT) :: ID
!
-TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DGEI
-TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
-TYPE(DIAG_ISBA_t), INTENT(INOUT) :: DGI
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-!
+ CHARACTER(LEN=*), INTENT(IN) :: HNATURE
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
!
-REAL, DIMENSION(:), INTENT(OUT) :: PRN ! Net radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PH ! Sensible heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLE ! Total latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEI ! Sublimation latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX ! Storage flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAP ! Total evapotranspiration (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSUBL ! Sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PRI ! Richardson number (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PCD ! drag coefficient (W/s2)
-REAL, DIMENSION(:), INTENT(OUT) :: PCH ! transf. coef heat (W/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PCE ! transf. coef vapor (W/s/K)
-REAL, DIMENSION(:), INTENT(OUT) :: PQS
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0 ! rough. length wind (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0H ! rough. length heat (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PTS ! surface temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M ! temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PQ2M ! humidity at 2m (kg/kg)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M ! relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PZON10M ! zonal wind at 10m (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PMER10M ! meridian wind at 10m(m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWD ! incoming short-wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWU ! upward short-wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWD ! incoming long-wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWU ! upward long-wave radiation (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBD ! incoming short-wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBU ! upward short-wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMU ! zonal momentum flux (Pa)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMV ! meridian momentum flux (Pa)
-REAL, DIMENSION(:), INTENT(OUT) :: PRNC ! Net radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PHC ! Sensible heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEC ! Total latent heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEIC ! Sublimation latent heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUXC ! Storage flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAPC ! Total evapotranspiration (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSUBLC ! Sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWDC ! incoming short wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWUC ! outgoing short wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWDC ! incoming long wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWUC ! outgoing long wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMUC ! zonal friction
-REAL, DIMENSION(:), INTENT(OUT) :: PFMVC ! meridian friction
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MIN ! Minimum temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MAX ! Maximum temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MIN! Minimum relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MAX! Maximum relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M ! wind at 10m (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M_MAX! Maximum wind at 10m (m/s)
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+TYPE(DIAG_t), INTENT(INOUT) :: DUP
+TYPE(DIAG_t), INTENT(INOUT) :: DUPC
!
+INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
!
!* 0.2 declarations of local variables
!
+INTEGER :: ISIZE, JJ
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('DIAG_NATURE_N',0,ZHOOK_HANDLE)
-IF (U%CNATURE=='ISBA ' .OR. U%CNATURE=='TSZ0 ' ) THEN
-!
- CALL DIAG_ISBA_n(DGEI, DGI, &
- HPROGRAM, &
- PRN, PH, PLE, PLEI, PGFLUX, PRI, PCD, PCH, PCE, PQS, &
- PZ0, PZ0H, PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M, &
- PSWD, PSWU, PLWD, PLWU, PSWBD, PSWBU, PFMU, PFMV, &
- PRNC, PHC, PLEC, PGFLUXC, PSWDC, PSWUC, PLWDC, &
- PLWUC, PFMUC, PFMVC, PT2M_MIN, PT2M_MAX, PLEIC, &
- PHU2M_MIN, PHU2M_MAX, PWIND10M, PWIND10M_MAX, &
- PEVAP, PEVAPC, PSUBL, PSUBLC )
-!
-ELSE IF (U%CNATURE=='FLUX ') THEN
-!
- CALL DIAG_IDEAL_n(DGL, HPROGRAM, &
- PRN, PH, PLE, PLEI, PGFLUX, PRI, PCD, PCH, PCE, PQS, &
- PZ0, PZ0H, PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M, &
- PSWD, PSWU, PLWD, PLWU, PSWBD, PSWBU, PFMU, PFMV, &
- PRNC, PHC, PLEC, PGFLUXC, PSWDC, PSWUC, PLWDC, &
- PLWUC, PFMUC, PFMVC, PT2M_MIN, PT2M_MAX, PLEIC, &
- PHU2M_MIN, PHU2M_MAX, PWIND10M, PWIND10M_MAX, &
- PEVAP, PEVAPC, PSUBL, PSUBLC )
-ELSE IF (U%CNATURE=='NONE ') THEN
- PRN = XUNDEF
- PH = XUNDEF
- PLE = XUNDEF
- PLEI = XUNDEF
- PEVAP = XUNDEF
- PSUBL = XUNDEF
- PGFLUX = XUNDEF
- PRI = XUNDEF
- PCD = XUNDEF
- PCH = XUNDEF
- PCE = XUNDEF
- PQS = XUNDEF
- PZ0 = XUNDEF
- PZ0H = XUNDEF
- PTS = XUNDEF
- PT2M = XUNDEF
- PQ2M = XUNDEF
- PHU2M = XUNDEF
- PZON10M = XUNDEF
- PMER10M = XUNDEF
- PSWD = XUNDEF
- PSWU = XUNDEF
- PSWBD = XUNDEF
- PSWBU = XUNDEF
- PLWD = XUNDEF
- PLWU = XUNDEF
- PFMU = XUNDEF
- PFMV = XUNDEF
- PRNC = XUNDEF
- PHC = XUNDEF
- PLEC = XUNDEF
- PLEIC = XUNDEF
- PEVAPC = XUNDEF
- PSUBLC = XUNDEF
- PGFLUXC = XUNDEF
- PSWDC = XUNDEF
- PSWUC = XUNDEF
- PLWDC = XUNDEF
- PLWUC = XUNDEF
- PFMUC = XUNDEF
- PFMVC = XUNDEF
- PT2M_MIN = XUNDEF
- PT2M_MAX = XUNDEF
- PHU2M_MIN= XUNDEF
- PHU2M_MAX= XUNDEF
- PWIND10M = XUNDEF
- PWIND10M_MAX = XUNDEF
+IF (HNATURE=='ISBA ' .OR. HNATURE=='TSZ0 ' ) THEN
+ !
+ CALL DIAG_CUMUL(ID%O, ID%D, ID%DC, HPROGRAM, DUP, DUPC, KMASK)
+ !
+ ISIZE = SIZE(KMASK)
+ !
+ IF (ID%O%LSURF_BUDGET.AND.ID%DE%LSURF_EVAP_BUDGET) THEN
+ DO JJ=1,ISIZE
+ DUP%XEVAP (KMASK(JJ)) = ID%D%XEVAP (JJ)
+ DUP%XSUBL (KMASK(JJ)) = ID%D%XSUBL (JJ)
+ ENDDO
+ ENDIF
+ !
+ELSE IF (HNATURE=='FLUX ') THEN
+ CALL DIAG_EVAP(DLO, DL, DLC, HPROGRAM, DUP, DUPC, KMASK)
+ELSE IF (HNATURE=='NONE ') THEN
+ CALL INIT_BUD(ID%O, DUP, DUPC, XUNDEF)
END IF
IF (LHOOK) CALL DR_HOOK('DIAG_NATURE_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/diag_seaflux_initn.F90 b/src/SURFEX/diag_seaflux_initn.F90
index 80141bc001b957bedb7dfd5d40286076963925f5..65cadc124bda74b6d7e0864117435700e8a7d758 100644
--- a/src/SURFEX/diag_seaflux_initn.F90
+++ b/src/SURFEX/diag_seaflux_initn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_SEAFLUX_INIT_n (&
- DGO, DGS, DGSI, DGU, S, &
+ SUBROUTINE DIAG_SEAFLUX_INIT_n (DOC, DGO, D, DC, OREAD_BUDGETC, S, &
HPROGRAM,KLU,KSW)
! #####################
!
@@ -43,29 +42,20 @@
!* 0. DECLARATIONS
! ------------
!
-!
+USE MODE_DIAG
!
USE MODD_DIAG_OCEAN_n, ONLY : DIAG_OCEAN_t
-USE MODD_DIAG_SEAFLUX_n, ONLY : DIAG_SEAFLUX_t
-USE MODD_DIAG_SEAICE_n, ONLY : DIAG_SEAICE_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
!
-!
-!
#ifdef SFX_OL
USE MODN_IO_OFFLINE, ONLY : LRESTART
#endif
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_SFX_OASIS, ONLY : LCPL_SEA,LCPL_SEAICE
-
-!
-!
-!
-!
+!
USE MODI_READ_SURF
!
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -74,13 +64,11 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-!
-!
-TYPE(DIAG_OCEAN_t), INTENT(INOUT) :: DGO
-TYPE(DIAG_SEAFLUX_t), INTENT(INOUT) :: DGS
-TYPE(DIAG_SEAICE_t), INTENT(INOUT) :: DGSI
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_OCEAN_t), INTENT(INOUT) :: DOC
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
+LOGICAL, INTENT(IN) :: OREAD_BUDGETC
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
!
INTEGER, INTENT(IN) :: KLU ! size of arrays
@@ -92,396 +80,115 @@ INTEGER, INTENT(IN) :: KSW ! number of SW spectral bands
!
INTEGER :: IVERSION
INTEGER :: IRESP ! IRESP : return-code if a problem appears
- CHARACTER(LEN=LEN_HREC) :: YREC ! Name of the article to be read
+CHARACTER(LEN=LEN_HREC) :: YREC ! Name of the article to be read
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('DIAG_SEAFLUX_INIT_N',0,ZHOOK_HANDLE)
!
!* surface energy budget
!
-IF (LHOOK) CALL DR_HOOK('DIAG_SEAFLUX_INIT_N',0,ZHOOK_HANDLE)
-ALLOCATE(DGS%XTS (KLU))
-ALLOCATE(DGS%XTSRAD(KLU))
-DGS%XTS = XUNDEF
-DGS%XTSRAD = XUNDEF
+ CALL ALLOC_BUD(DGO,D,KLU,KSW)
!
-IF (DGS%LSURF_BUDGET.OR.DGS%LSURF_BUDGETC) THEN
- ALLOCATE(DGS%XRN (KLU))
- ALLOCATE(DGS%XRN_ICE (KLU))
- ALLOCATE(DGS%XH (KLU))
- ALLOCATE(DGS%XH_ICE (KLU))
- ALLOCATE(DGS%XLE (KLU))
- ALLOCATE(DGS%XLE_ICE (KLU))
- ALLOCATE(DGS%XGFLUX (KLU))
- ALLOCATE(DGS%XGFLUX_ICE(KLU))
- ALLOCATE(DGS%XEVAP (KLU))
- ALLOCATE(DGS%XSUBL (KLU))
- ALLOCATE(DGS%XSWD (KLU))
- ALLOCATE(DGS%XSWU (KLU))
- ALLOCATE(DGS%XSWU_ICE(KLU))
- ALLOCATE(DGS%XLWD (KLU))
- ALLOCATE(DGS%XLWU (KLU))
- ALLOCATE(DGS%XLWU_ICE(KLU))
- ALLOCATE(DGS%XSWBD (KLU,KSW))
- ALLOCATE(DGS%XSWBU (KLU,KSW))
- ALLOCATE(DGS%XSWBU_ICE(KLU,KSW))
- ALLOCATE(DGS%XFMU (KLU))
- ALLOCATE(DGS%XFMU_ICE(KLU))
- ALLOCATE(DGS%XFMV (KLU))
- ALLOCATE(DGS%XFMV_ICE(KLU))
- ALLOCATE(DGS%XALBT (KLU))
+IF (DGO%LSURF_BUDGET.OR.DGO%LSURF_BUDGETC) THEN
+ !
+ ALLOCATE(D%XEVAP (KLU))
+ ALLOCATE(D%XSUBL (KLU))
+ ALLOCATE(D%XALBT (KLU))
!
- DGS%XRN = XUNDEF
- DGS%XRN_ICE = XUNDEF
- DGS%XH = XUNDEF
- DGS%XH_ICE = XUNDEF
- DGS%XLE = XUNDEF
- DGS%XLE_ICE = XUNDEF
- DGS%XGFLUX = XUNDEF
- DGS%XGFLUX_ICE=XUNDEF
- DGS%XEVAP = XUNDEF
- DGS%XSUBL = XUNDEF
- DGS%XSWD = XUNDEF
- DGS%XSWU = XUNDEF
- DGS%XSWU_ICE = XUNDEF
- DGS%XLWD = XUNDEF
- DGS%XLWU = XUNDEF
- DGS%XLWU_ICE = XUNDEF
- DGS%XSWBD = XUNDEF
- DGS%XSWBU = XUNDEF
- DGS%XSWBU_ICE= XUNDEF
- DGS%XFMU = XUNDEF
- DGS%XFMU_ICE = XUNDEF
- DGS%XFMV = XUNDEF
- DGS%XFMV_ICE = XUNDEF
- DGS%XALBT = XUNDEF
+ D%XEVAP = XUNDEF
+ D%XSUBL = XUNDEF
+ D%XALBT = XUNDEF
!
ELSE
- ALLOCATE(DGS%XRN (0))
- ALLOCATE(DGS%XRN_ICE (0))
- ALLOCATE(DGS%XH (0))
- ALLOCATE(DGS%XH_ICE (0))
- ALLOCATE(DGS%XLE (0))
- ALLOCATE(DGS%XLE_ICE (0))
- ALLOCATE(DGS%XGFLUX (0))
- ALLOCATE(DGS%XGFLUX_ICE(0))
- ALLOCATE(DGS%XEVAP (0))
- ALLOCATE(DGS%XSUBL (0))
- ALLOCATE(DGS%XSWD (0))
- ALLOCATE(DGS%XSWU (0))
- ALLOCATE(DGS%XSWU_ICE(0))
- ALLOCATE(DGS%XLWD (0))
- ALLOCATE(DGS%XLWU (0))
- ALLOCATE(DGS%XLWU_ICE(0))
- ALLOCATE(DGS%XSWBD (0,0))
- ALLOCATE(DGS%XSWBU (0,0))
- ALLOCATE(DGS%XSWBU_ICE(0,0))
- ALLOCATE(DGS%XFMU (0))
- ALLOCATE(DGS%XFMU_ICE(0))
- ALLOCATE(DGS%XFMV (0))
- ALLOCATE(DGS%XFMV_ICE(0))
- ALLOCATE(DGS%XALBT (0))
+ !
+ ALLOCATE(D%XEVAP (0))
+ ALLOCATE(D%XSUBL (0))
+ ALLOCATE(D%XALBT (0))
+ !
ENDIF
!
+ALLOCATE(D%XTSRAD(KLU))
+D%XTSRAD = XUNDEF
+!
!* cumulative surface energy budget
!
#ifdef SFX_OL
-IF (DGS%LSURF_BUDGETC .OR. (LRESTART .AND. .NOT.DGS%LRESET_BUDGETC)) THEN
+IF (DGO%LSURF_BUDGETC .OR. (LRESTART .AND. .NOT.DGO%LRESET_BUDGETC)) THEN
#else
-IF (DGS%LSURF_BUDGETC .OR. .NOT.DGS%LRESET_BUDGETC) THEN
+IF (DGO%LSURF_BUDGETC .OR. .NOT.DGO%LRESET_BUDGETC) THEN
#endif
-!
- ALLOCATE(DGS%XRNC (KLU))
- ALLOCATE(DGS%XRNC_ICE(KLU))
- ALLOCATE(DGS%XHC (KLU))
- ALLOCATE(DGS%XHC_ICE (KLU))
- ALLOCATE(DGS%XLEC (KLU))
- ALLOCATE(DGS%XLEC_ICE(KLU))
- ALLOCATE(DGS%XGFLUXC (KLU))
- ALLOCATE(DGS%XGFLUXC_ICE(KLU))
- ALLOCATE(DGS%XEVAPC (KLU))
- ALLOCATE(DGS%XSUBLC (KLU))
- ALLOCATE(DGS%XSWDC (KLU))
- ALLOCATE(DGS%XSWUC (KLU))
- ALLOCATE(DGS%XSWUC_ICE(KLU))
- ALLOCATE(DGS%XLWDC (KLU))
- ALLOCATE(DGS%XLWUC (KLU))
- ALLOCATE(DGS%XLWUC_ICE(KLU))
- ALLOCATE(DGS%XFMUC (KLU))
- ALLOCATE(DGS%XFMUC_ICE(KLU))
- ALLOCATE(DGS%XFMVC (KLU))
- ALLOCATE(DGS%XFMVC_ICE(KLU))
-!
- IF (.NOT. DGU%LREAD_BUDGETC) THEN
- DGS%XRNC = 0.0
- DGS%XRNC_ICE =0.0
- DGS%XHC = 0.0
- DGS%XHC_ICE =0.0
- DGS%XLEC = 0.0
- DGS%XLEC_ICE= 0.0
- DGS%XGFLUXC = 0.0
- DGS%XGFLUXC_ICE=0.0
- DGS%XEVAPC = 0.0
- DGS%XSUBLC = 0.0
- DGS%XSWDC = 0.0
- DGS%XSWUC = 0.0
- DGS%XSWUC_ICE=0.0
- DGS%XLWDC = 0.0
- DGS%XLWUC = 0.0
- DGS%XLWUC_ICE=0.0
- DGS%XFMUC = 0.0
- DGS%XFMUC_ICE=0.0
- DGS%XFMVC = 0.0
- DGS%XFMVC_ICE=0.0
- ELSEIF (DGU%LREAD_BUDGETC.AND.DGS%LRESET_BUDGETC) THEN
- DGS%XRNC = 0.0
- DGS%XRNC_ICE= 0.0
- DGS%XHC = 0.0
- DGS%XHC_ICE = 0.0
- DGS%XLEC = 0.0
- DGS%XLEC_ICE= 0.0
- DGS%XGFLUXC = 0.0
- DGS%XGFLUXC_ICE=0.0
- DGS%XEVAPC = 0.0
- DGS%XSUBLC = 0.0
- DGS%XSWDC = 0.0
- DGS%XSWUC = 0.0
- DGS%XSWUC_ICE=0.0
- DGS%XLWDC = 0.0
- DGS%XLWUC = 0.0
- DGS%XLWUC_ICE=0.0
- DGS%XFMUC = 0.0
- DGS%XFMUC_ICE=0.0
- DGS%XFMVC = 0.0
- DGS%XFMVC_ICE=0.0
+ !
+ CALL ALLOC_SURF_BUD(DC,KLU,KLU,KSW)
+ ALLOCATE(DC%XEVAP (KLU))
+ ALLOCATE(DC%XSUBL (KLU))
+ !
+ IF (.NOT.OREAD_BUDGETC .OR. OREAD_BUDGETC.AND.DGO%LRESET_BUDGETC) THEN
+ CALL INIT_SURF_BUD(DC,0.)
+ DC%XEVAP = 0.0
+ DC%XSUBL = 0.0
ELSE
- CALL READ_SURF(&
- HPROGRAM,'VERSION',IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
YREC='RNC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XRNC,IRESP)
+ CALL READ_SURF(HPROGRAM,YREC,DC%XRN,IRESP)
YREC='HC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XHC ,IRESP)
+ CALL READ_SURF(HPROGRAM,YREC,DC%XH,IRESP)
YREC='LEC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XLEC,IRESP)
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLE,IRESP)
YREC='LEIC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XLEC_ICE,IRESP)
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLEI,IRESP)
YREC='GFLUXC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XGFLUXC ,IRESP)
+ CALL READ_SURF(HPROGRAM,YREC,DC%XGFLUX,IRESP)
YREC='SWDC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XSWDC,IRESP)
+ CALL READ_SURF(HPROGRAM,YREC,DC%XSWD,IRESP)
YREC='SWUC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XSWUC,IRESP)
+ CALL READ_SURF(HPROGRAM,YREC,DC%XSWU,IRESP)
YREC='LWDC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XLWDC,IRESP)
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLWD,IRESP)
YREC='LWUC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XLWUC,IRESP)
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLWU,IRESP)
YREC='FMUC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XFMUC,IRESP)
+ CALL READ_SURF(HPROGRAM,YREC,DC%XFMU,IRESP)
YREC='FMVC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XFMVC,IRESP)
+ CALL READ_SURF(HPROGRAM,YREC,DC%XFMV,IRESP)
IF (IVERSION<8)THEN
- DGS%XEVAPC = 0.0
- DGS%XSUBLC = 0.0
+ DC%XEVAP = 0.0
+ DC%XSUBL = 0.0
ELSE
- !
- YREC='EVAPC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XEVAPC,IRESP)
- YREC='SUBLC_SEA'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGS%XSUBLC,IRESP)
+ !
+ YREC='EVAPC_SEA'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XEVAP,IRESP)
+ YREC='SUBLC_SEA'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XSUBL,IRESP)
ENDIF
- DGS%XRNC_ICE = 0.0
- DGS%XHC_ICE = 0.0
- DGS%XGFLUXC_ICE = 0.0
- DGS%XSWUC_ICE = 0.0
- DGS%XLWUC_ICE = 0.0
- DGS%XFMUC_ICE = 0.0
- DGS%XFMVC_ICE = 0.0
ENDIF
ELSE
- ALLOCATE(DGS%XRNC (0))
- ALLOCATE(DGS%XRNC_ICE(0))
- ALLOCATE(DGS%XHC (0))
- ALLOCATE(DGS%XHC_ICE (0))
- ALLOCATE(DGS%XLEC (0))
- ALLOCATE(DGS%XLEC_ICE(0))
- ALLOCATE(DGS%XGFLUXC (0))
- ALLOCATE(DGS%XGFLUXC_ICE(0))
- ALLOCATE(DGS%XEVAPC (0))
- ALLOCATE(DGS%XSUBLC (0))
- ALLOCATE(DGS%XSWDC (0))
- ALLOCATE(DGS%XSWUC (0))
- ALLOCATE(DGS%XSWUC_ICE(0))
- ALLOCATE(DGS%XLWDC (0))
- ALLOCATE(DGS%XLWUC (0))
- ALLOCATE(DGS%XLWUC_ICE(0))
- ALLOCATE(DGS%XFMUC (0))
- ALLOCATE(DGS%XFMUC_ICE(0))
- ALLOCATE(DGS%XFMVC (0))
- ALLOCATE(DGS%XFMVC_ICE(0))
+ CALL ALLOC_SURF_BUD(DC,0,0,0)
ENDIF
!
-!* parameters at 2m
-!
-IF (DGS%N2M>=1) THEN
- ALLOCATE(DGS%XRI (KLU))
- ALLOCATE(DGS%XRI_ICE (KLU))
- ALLOCATE(DGS%XT2M (KLU))
- ALLOCATE(DGS%XT2M_ICE (KLU))
- ALLOCATE(DGS%XT2M_MIN (KLU))
- ALLOCATE(DGS%XT2M_MAX (KLU))
- ALLOCATE(DGS%XQ2M (KLU))
- ALLOCATE(DGS%XQ2M_ICE (KLU))
- ALLOCATE(DGS%XHU2M (KLU))
- ALLOCATE(DGS%XHU2M_ICE(KLU))
- ALLOCATE(DGS%XHU2M_MIN(KLU))
- ALLOCATE(DGS%XHU2M_MAX(KLU))
- ALLOCATE(DGS%XZON10M (KLU))
- ALLOCATE(DGS%XZON10M_ICE(KLU))
- ALLOCATE(DGS%XMER10M (KLU))
- ALLOCATE(DGS%XMER10M_ICE(KLU))
- ALLOCATE(DGS%XWIND10M (KLU))
- ALLOCATE(DGS%XWIND10M_ICE(KLU))
- ALLOCATE(DGS%XWIND10M_MAX(KLU))
- !
- DGS%XRI = XUNDEF
- DGS%XRI_ICE = XUNDEF
- DGS%XT2M = XUNDEF
- DGS%XT2M_ICE = XUNDEF
- DGS%XT2M_MIN = XUNDEF
- DGS%XT2M_MAX = 0.0
- DGS%XQ2M = XUNDEF
- DGS%XQ2M_ICE = XUNDEF
- DGS%XHU2M = XUNDEF
- DGS%XHU2M_ICE= XUNDEF
- DGS%XHU2M_MIN= XUNDEF
- DGS%XHU2M_MAX=-XUNDEF
- DGS%XZON10M = XUNDEF
- DGS%XZON10M_ICE=XUNDEF
- DGS%XMER10M = XUNDEF
- DGS%XMER10M_ICE=XUNDEF
- DGS%XWIND10M = XUNDEF
- DGS%XWIND10M_ICE=XUNDEF
- DGS%XWIND10M_MAX = 0.0
-ELSE
- ALLOCATE(DGS%XRI (0))
- ALLOCATE(DGS%XRI_ICE (0))
- ALLOCATE(DGS%XT2M (0))
- ALLOCATE(DGS%XT2M_ICE (0))
- ALLOCATE(DGS%XT2M_MIN (0))
- ALLOCATE(DGS%XT2M_MAX (0))
- ALLOCATE(DGS%XQ2M (0))
- ALLOCATE(DGS%XQ2M_ICE (0))
- ALLOCATE(DGS%XHU2M (0))
- ALLOCATE(DGS%XHU2M_ICE(0))
- ALLOCATE(DGS%XHU2M_MIN(0))
- ALLOCATE(DGS%XHU2M_MAX(0))
- ALLOCATE(DGS%XZON10M (0))
- ALLOCATE(DGS%XZON10M_ICE(0))
- ALLOCATE(DGS%XMER10M (0))
- ALLOCATE(DGS%XMER10M_ICE(0))
- ALLOCATE(DGS%XWIND10M (0))
- ALLOCATE(DGS%XWIND10M_ICE(0))
- ALLOCATE(DGS%XWIND10M_MAX(0))
-END IF
-!
-!* transfer coefficients
-!
-IF (DGS%LCOEF) THEN
- ALLOCATE(DGS%XCD (KLU))
- ALLOCATE(DGS%XCD_ICE (KLU))
- ALLOCATE(DGS%XCH (KLU))
- ALLOCATE(DGS%XCH_ICE (KLU))
- ALLOCATE(DGS%XCE (KLU))
- ALLOCATE(DGS%XZ0 (KLU))
- ALLOCATE(DGS%XZ0_ICE (KLU))
- ALLOCATE(DGS%XZ0H (KLU))
- ALLOCATE(DGS%XZ0H_ICE(KLU))
- !
- DGS%XCD = XUNDEF
- DGS%XCD_ICE = XUNDEF
- DGS%XCH = XUNDEF
- DGS%XCH_ICE = XUNDEF
- DGS%XCE = XUNDEF
- DGS%XZ0 = XUNDEF
- DGS%XZ0_ICE = XUNDEF
- DGS%XZ0H = XUNDEF
- DGS%XZ0H_ICE = XUNDEF
-ELSE
- ALLOCATE(DGS%XCD (0))
- ALLOCATE(DGS%XCD_ICE (0))
- ALLOCATE(DGS%XCH (0))
- ALLOCATE(DGS%XCH_ICE (0))
- ALLOCATE(DGS%XCE (0))
- ALLOCATE(DGS%XZ0 (0))
- ALLOCATE(DGS%XZ0_ICE (0))
- ALLOCATE(DGS%XZ0H (0))
- ALLOCATE(DGS%XZ0H_ICE(0))
-END IF
-!
-!
-!* surface humidity
-!
-IF (DGS%LSURF_VARS) THEN
- ALLOCATE(DGS%XQS (KLU))
- ALLOCATE(DGS%XQS_ICE (KLU))
- !
- DGS%XQS = XUNDEF
- DGS%XQS_ICE = XUNDEF
-ELSE
- ALLOCATE(DGS%XQS (0))
- ALLOCATE(DGS%XQS_ICE (0))
-END IF
-!
!* ocean diag
!
-IF (DGO%LDIAG_OCEAN) THEN
- ALLOCATE(DGO%XTOCMOY (KLU))
- ALLOCATE(DGO%XSOCMOY (KLU))
- ALLOCATE(DGO%XUOCMOY (KLU))
- ALLOCATE(DGO%XVOCMOY (KLU))
- ALLOCATE(DGO%XDOCMOY (KLU))
+IF (DOC%LDIAG_OCEAN) THEN
+ ALLOCATE(DOC%XTOCMOY (KLU))
+ ALLOCATE(DOC%XSOCMOY (KLU))
+ ALLOCATE(DOC%XUOCMOY (KLU))
+ ALLOCATE(DOC%XVOCMOY (KLU))
+ ALLOCATE(DOC%XDOCMOY (KLU))
!
- DGO%XTOCMOY(:)=XUNDEF
- DGO%XSOCMOY(:)=XUNDEF
- DGO%XUOCMOY(:)=XUNDEF
- DGO%XVOCMOY(:)=XUNDEF
- DGO%XDOCMOY(:)=XUNDEF
+ DOC%XTOCMOY(:)=XUNDEF
+ DOC%XSOCMOY(:)=XUNDEF
+ DOC%XUOCMOY(:)=XUNDEF
+ DOC%XVOCMOY(:)=XUNDEF
+ DOC%XDOCMOY(:)=XUNDEF
ELSE
- ALLOCATE(DGO%XTOCMOY (0))
- ALLOCATE(DGO%XSOCMOY (0))
- ALLOCATE(DGO%XUOCMOY (0))
- ALLOCATE(DGO%XVOCMOY (0))
- ALLOCATE(DGO%XDOCMOY (0))
+ ALLOCATE(DOC%XTOCMOY (0))
+ ALLOCATE(DOC%XSOCMOY (0))
+ ALLOCATE(DOC%XUOCMOY (0))
+ ALLOCATE(DOC%XVOCMOY (0))
+ ALLOCATE(DOC%XDOCMOY (0))
ENDIF
!
-!* Seaice model diagnostics init
-!
-IF (DGSI%LDIAG_SEAICE) THEN
- ALLOCATE(DGSI%XSIT(KLU))
- DGSI%XSIT=XUNDEF
- ALLOCATE(DGSI%XSND(KLU))
- DGSI%XSND=XUNDEF
- ALLOCATE(DGSI%XMLT(KLU))
- DGSI%XMLT=XUNDEF
-ELSE
- ALLOCATE(DGSI%XSIT (0))
- ALLOCATE(DGSI%XSND (0))
- ALLOCATE(DGSI%XMLT (0))
-ENDIF
!
!* Earth system model coupling variables
!
@@ -518,19 +225,6 @@ ELSE
ALLOCATE(S%XCPL_SEA_FWSM(0))
ENDIF
!
-IF(LCPL_SEAICE.OR.S%LHANDLE_SIC)THEN
- ALLOCATE(S%XCPL_SEAICE_SNET(KLU))
- ALLOCATE(S%XCPL_SEAICE_HEAT(KLU))
- ALLOCATE(S%XCPL_SEAICE_EVAP(KLU))
- S%XCPL_SEAICE_SNET(:) = 0.0
- S%XCPL_SEAICE_HEAT(:) = 0.0
- S%XCPL_SEAICE_EVAP(:) = 0.0
-ELSE
- ALLOCATE(S%XCPL_SEAICE_SNET(0))
- ALLOCATE(S%XCPL_SEAICE_HEAT(0))
- ALLOCATE(S%XCPL_SEAICE_EVAP(0))
-ENDIF
-!
IF (LHOOK) CALL DR_HOOK('DIAG_SEAFLUX_INIT_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/diag_seafluxn.F90 b/src/SURFEX/diag_seafluxn.F90
deleted file mode 100644
index 8366d9cf121abc0520ee3dc97989e2a32a472232..0000000000000000000000000000000000000000
--- a/src/SURFEX/diag_seafluxn.F90
+++ /dev/null
@@ -1,183 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE DIAG_SEAFLUX_n (DGS, &
- HPROGRAM, &
- PRN, PH, PLE, PLEI, PGFLUX, PRI, PCD, PCH, PCE, PQS,&
- PZ0, PZ0H, PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M,&
- PSWD, PSWU, PLWD, PLWU, PSWBD, PSWBU, PFMU, PFMV, &
- PRNC, PHC, PLEC, PGFLUXC, PSWDC, PSWUC, PLWDC, &
- PLWUC, PFMUC, PFMVC, PT2M_MIN, PT2M_MAX, PLEIC, &
- PHU2M_MIN, PHU2M_MAX, PWIND10M, PWIND10M_MAX, &
- PEVAP, PEVAPC, PSUBL, PSUBLC )
-! ###############################################################################
-!
-!!**** *DIAG_SEAFLUX_n * - diagnostics for SEAFLUX
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! Modified 01/2006 : sea flux parameterization.
-!! Modified 08/2009 : new diag
-! B. decharme 04/2013 : Add EVAP and SUBL diag
-!!------------------------------------------------------------------
-!
-
-!
-!
-USE MODD_DIAG_SEAFLUX_n, ONLY : DIAG_SEAFLUX_t
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(DIAG_SEAFLUX_t), INTENT(INOUT) :: DGS
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PRN ! Net radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PH ! Sensible heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLE ! Total latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEI ! Sublimation latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX ! Storage flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAP ! Total evapotranspiration (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSUBL ! Sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PRI ! Richardson number (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PCD ! drag coef (W/s2)
-REAL, DIMENSION(:), INTENT(OUT) :: PCH ! transfer coef heat (W/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PCE ! transfer coef vapor (W/s/K)
-REAL, DIMENSION(:), INTENT(OUT) :: PQS
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0 ! rough. length wind (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0H ! rough. length heat (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PTS ! surface temperature (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M ! temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PQ2M ! humidity at 2m (kg/kg)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M ! relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PZON10M ! zonal wind at 10m (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PMER10M ! meridian wind at 10m(m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWD ! incoming short-wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWU ! upward short-wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWD ! incoming long-wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWU ! upward long-wave radiation (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBD ! incoming short-wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBU ! upward short-wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMU ! zonal momentum flux (Pa)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMV ! meridian momentum flux (Pa)
-REAL, DIMENSION(:), INTENT(OUT) :: PRNC ! Net radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PHC ! Sensible heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEC ! Total latent heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEIC ! Sublimation latent heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUXC ! Storage flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAPC ! Total evapotranspiration (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSUBLC ! Sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWDC ! incoming short wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWUC ! outgoing short wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWDC ! incoming long wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWUC ! outgoing long wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMUC ! zonal friction
-REAL, DIMENSION(:), INTENT(OUT) :: PFMVC ! meridian friction
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MIN ! Minimum temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MAX ! Maximum temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MIN! Minimum relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MAX! Maximum relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M ! wind at 10m (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M_MAX! Maximum wind at 10m (m/s)
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!
-!* 0.2 declarations of local variables
-!
-!-------------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_SEAFLUX_N',0,ZHOOK_HANDLE)
-IF (DGS%LSURF_BUDGET) THEN
- PRN = DGS%XRN
- PH = DGS%XH
- PLE = DGS%XLE
- PLEI = DGS%XLE_ICE
- PGFLUX = DGS%XGFLUX
- PEVAP = DGS%XEVAP
- PSUBL = DGS%XSUBL
- PSWD = DGS%XSWD
- PSWU = DGS%XSWU
- PLWD = DGS%XLWD
- PLWU = DGS%XLWU
- PSWBD = DGS%XSWBD
- PSWBU = DGS%XSWBU
- PFMU = DGS%XFMU
- PFMV = DGS%XFMV
-END IF
-!
-IF (DGS%LSURF_BUDGETC) THEN
- PRNC = DGS%XRNC
- PHC = DGS%XHC
- PLEC = DGS%XLEC
- PLEIC = DGS%XLEC_ICE
- PGFLUXC = DGS%XGFLUXC
- PEVAPC = DGS%XEVAPC
- PSUBLC = DGS%XSUBLC
- PSWDC = DGS%XSWDC
- PSWUC = DGS%XSWUC
- PLWDC = DGS%XLWDC
- PLWUC = DGS%XLWUC
- PFMUC = DGS%XFMUC
- PFMVC = DGS%XFMVC
-END IF
-!
-IF (DGS%N2M>=1 .OR. DGS%LSURF_BUDGET .OR. DGS%LSURF_BUDGETC) PTS = DGS%XTS
-!
-IF (DGS%N2M>=1) THEN
- PRI = DGS%XRI
- PT2M = DGS%XT2M
- PT2M_MIN = DGS%XT2M_MIN
- PT2M_MAX = DGS%XT2M_MAX
- PQ2M = DGS%XQ2M
- PHU2M = DGS%XHU2M
- PHU2M_MIN= DGS%XHU2M_MIN
- PHU2M_MAX= DGS%XHU2M_MAX
- PZON10M = DGS%XZON10M
- PMER10M = DGS%XMER10M
- PWIND10M = DGS%XWIND10M
- PWIND10M_MAX = DGS%XWIND10M_MAX
-END IF
-!
-IF (DGS%LCOEF) THEN
- PCD = DGS%XCD
- PCH = DGS%XCH
- PCE = DGS%XCE
- PZ0 = DGS%XZ0
- PZ0H = DGS%XZ0H
-END IF
-!
-IF (DGS%LSURF_VARS) THEN
- PQS = DGS%XQS
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_SEAFLUX_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE DIAG_SEAFLUX_n
diff --git a/src/SURFEX/diag_seaice_initn.F90 b/src/SURFEX/diag_seaice_initn.F90
new file mode 100644
index 0000000000000000000000000000000000000000..73f9aead1d997c0339b86150f216516bee560e64
--- /dev/null
+++ b/src/SURFEX/diag_seaice_initn.F90
@@ -0,0 +1,142 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE DIAG_SEAICE_INIT_n (DGO, DI, DIC, DGMSI, OREAD_BUDGETC, S, &
+ HPROGRAM,KLU,KSW)
+! #####################
+!
+!!**** *DIAG_SEAFLUX_INIT_n* - routine to initialize SEAFLUX diagnostic variables
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2004
+!! Modified 01/2006 : sea flux parameterization.
+!! Modified 08/2009 : cumulative sea flux
+!! B. decharme 04/2013 : Add EVAP and SUBL diag
+!! S.Senesi 01/2014 : introduce fractional seaice
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODE_DIAG
+!
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
+USE MODD_DIAG_MISC_SEAICE_n, ONLY : DIAG_MISC_SEAICE_t
+USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
+!
+#ifdef SFX_OL
+USE MODN_IO_OFFLINE, ONLY : LRESTART
+#endif
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_SFX_OASIS, ONLY : LCPL_SEA,LCPL_SEAICE
+!
+USE MODI_READ_SURF
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: DI
+TYPE(DIAG_t), INTENT(INOUT) :: DIC
+TYPE(DIAG_MISC_SEAICE_t), INTENT(INOUT) :: DGMSI
+LOGICAL, INTENT(IN) :: OREAD_BUDGETC
+TYPE(SEAFLUX_t), INTENT(INOUT) :: S
+!
+INTEGER, INTENT(IN) :: KLU ! size of arrays
+INTEGER, INTENT(IN) :: KSW ! number of SW spectral bands
+ CHARACTER(LEN=6), INTENT(IN):: HPROGRAM ! program calling
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: IVERSION
+INTEGER :: IRESP ! IRESP : return-code if a problem appears
+CHARACTER(LEN=LEN_HREC) :: YREC ! Name of the article to be read
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+!
+!* surface energy budget
+!
+IF (LHOOK) CALL DR_HOOK('DIAG_SEAICE_INIT_N',0,ZHOOK_HANDLE)
+!
+ CALL ALLOC_BUD(DGO,DI,KLU,KSW)
+!
+!* cumulative surface energy budget
+!
+#ifdef SFX_OL
+IF (DGO%LSURF_BUDGETC .OR. (LRESTART .AND. .NOT.DGO%LRESET_BUDGETC)) THEN
+#else
+IF (DGO%LSURF_BUDGETC .OR. .NOT.DGO%LRESET_BUDGETC) THEN
+#endif
+ !
+ CALL ALLOC_SURF_BUD(DIC,KLU,KLU,KSW)
+ CALL INIT_SURF_BUD(DIC,0.)
+ !
+ELSE
+ CALL ALLOC_SURF_BUD(DIC,0,0,0)
+ENDIF
+!
+!* Seaice model diagnostics init
+!
+IF (DGMSI%LDIAG_MISC_SEAICE) THEN
+ ALLOCATE(DGMSI%XSIT(KLU))
+ ALLOCATE(DGMSI%XSND(KLU))
+ ALLOCATE(DGMSI%XMLT(KLU))
+ DGMSI%XSIT=XUNDEF
+ DGMSI%XSND=XUNDEF
+ DGMSI%XMLT=XUNDEF
+ELSE
+ ALLOCATE(DGMSI%XSIT (0))
+ ALLOCATE(DGMSI%XSND (0))
+ ALLOCATE(DGMSI%XMLT (0))
+ENDIF
+!
+IF(LCPL_SEAICE.OR.S%LHANDLE_SIC)THEN
+ ALLOCATE(S%XCPL_SEAICE_SNET(KLU))
+ ALLOCATE(S%XCPL_SEAICE_HEAT(KLU))
+ ALLOCATE(S%XCPL_SEAICE_EVAP(KLU))
+ S%XCPL_SEAICE_SNET(:) = 0.0
+ S%XCPL_SEAICE_HEAT(:) = 0.0
+ S%XCPL_SEAICE_EVAP(:) = 0.0
+ELSE
+ ALLOCATE(S%XCPL_SEAICE_SNET(0))
+ ALLOCATE(S%XCPL_SEAICE_HEAT(0))
+ ALLOCATE(S%XCPL_SEAICE_EVAP(0))
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('DIAG_SEAICE_INIT_N',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE DIAG_SEAICE_INIT_n
diff --git a/src/SURFEX/diag_sean.F90 b/src/SURFEX/diag_sean.F90
index f6b0aaa584fa8b40fda49d413518f99d96babf31..8ee9d2480460c84a67070f5a04355fd6e3b56b91 100644
--- a/src/SURFEX/diag_sean.F90
+++ b/src/SURFEX/diag_sean.F90
@@ -3,15 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE DIAG_SEA_n (DGL, DGS, U, &
- HPROGRAM, &
- PRN, PH, PLE, PLEI, PGFLUX, PRI, PCD, PCH, PCE, PQS,&
- PZ0, PZ0H, PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M,&
- PSWD, PSWU, PSWBD, PSWBU, PLWD, PLWU, PFMU, PFMV, &
- PRNC, PHC, PLEC, PGFLUXC, PSWDC, PSWUC, PLWDC, &
- PLWUC, PFMUC, PFMVC, PT2M_MIN, PT2M_MAX, PLEIC, &
- PHU2M_MIN, PHU2M_MAX, PWIND10M, PWIND10M_MAX, &
- PEVAP, PEVAPC, PSUBL, PSUBLC )
+SUBROUTINE DIAG_SEA_n (DLO, DL, DLC, SD, HSEA, HPROGRAM, DUP, DUPC, KMASK )
! #####################################################################
!
!!**** *DIAG_SEA_n * - Chooses the surface schemes for sea diagnostics
@@ -38,20 +30,13 @@ SUBROUTINE DIAG_SEA_n (DGL, DGS, U, &
! B. decharme 04/2013 : Add EVAP and SUBL diag
!!------------------------------------------------------------------
!
-
+USE MODE_DIAG
!
-!
-!
-!
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
-USE MODD_DIAG_SEAFLUX_n, ONLY : DIAG_SEAFLUX_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
+USE MODD_SURFEX_n, ONLY : SEAFLUX_DIAG_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
-USE MODI_DIAG_SEAFLUX_n
-USE MODI_DIAG_IDEAL_n
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -59,60 +44,19 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DLO
+TYPE(DIAG_t), INTENT(INOUT) :: DL
+TYPE(DIAG_t), INTENT(INOUT) :: DLC
+TYPE(SEAFLUX_DIAG_t), INTENT(INOUT) :: SD
!
-TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
-TYPE(DIAG_SEAFLUX_t), INTENT(INOUT) :: DGS
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-!
+ CHARACTER(LEN=*), INTENT(IN) :: HSEA
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
!
-REAL, DIMENSION(:), INTENT(OUT) :: PRN ! Net radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PH ! Sensible heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLE ! Total latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEI ! Sublimation latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX ! Storage flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAP ! Total evapotranspiration (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSUBL ! Sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PRI ! Richardson number (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PCD ! drag coefficient (W/s2)
-REAL, DIMENSION(:), INTENT(OUT) :: PCH ! transf. coef heat (W/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PCE ! transf. coef vapor (W/s/K)
-REAL, DIMENSION(:), INTENT(OUT) :: PQS
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0 ! rough. length wind (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0H ! rough. length heat (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PTS ! surface temperature (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M ! temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PQ2M ! humidity at 2m (kg/kg)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M ! relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PZON10M ! zonal wind at 10m (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PMER10M ! meridian wind at 10m(m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWD ! incoming short wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWU ! outgoing short wave radiation (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBD ! incoming short wave radiation by spectral band(W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBU ! outgoing short wave radiation by spectral band(W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWD ! incoming long wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWU ! outgoing long wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMU ! zonal friction
-REAL, DIMENSION(:), INTENT(OUT) :: PFMV ! meridian friction
-REAL, DIMENSION(:), INTENT(OUT) :: PRNC ! Net radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PHC ! Sensible heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEC ! Total latent heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEIC ! Sublimation latent heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUXC ! Storage flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAPC ! Total evapotranspiration (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSUBLC ! Sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWDC ! incoming short wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWUC ! outgoing short wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWDC ! incoming long wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWUC ! outgoing long wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMUC ! zonal friction
-REAL, DIMENSION(:), INTENT(OUT) :: PFMVC ! meridian friction
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MIN ! Minimum temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MAX ! Maximum temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MIN! Minimum relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MAX! Maximum relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M ! wind at 10m (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M_MAX! Maximum wind at 10m (m/s)
+TYPE(DIAG_t), INTENT(INOUT) :: DUP
+TYPE(DIAG_t), INTENT(INOUT) :: DUPC
+!
+INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
+!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
@@ -121,73 +65,12 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('DIAG_SEA_N',0,ZHOOK_HANDLE)
-IF (U%CSEA=='SEAFLX') THEN
- CALL DIAG_SEAFLUX_n(DGS, &
- HPROGRAM, &
- PRN, PH, PLE, PLEI, PGFLUX, PRI, PCD, PCH, PCE, PQS,&
- PZ0, PZ0H, PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M,&
- PSWD, PSWU, PLWD, PLWU, PSWBD, PSWBU, PFMU, PFMV, &
- PRNC, PHC, PLEC, PGFLUXC, PSWDC, PSWUC, PLWDC, &
- PLWUC, PFMUC, PFMVC, PT2M_MIN, PT2M_MAX, PLEIC, &
- PHU2M_MIN, PHU2M_MAX, PWIND10M, PWIND10M_MAX, &
- PEVAP, PEVAPC, PSUBL, PSUBLC )
-ELSEIF (U%CSEA=='FLUX') THEN
- CALL DIAG_IDEAL_n(DGL, HPROGRAM, &
- PRN, PH, PLE, PLEI, PGFLUX, PRI, PCD, PCH, PCE, PQS,&
- PZ0, PZ0H, PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M,&
- PSWD, PSWU, PLWD, PLWU, PSWBD, PSWBU, PFMU, PFMV, &
- PRNC, PHC, PLEC, PGFLUXC, PSWDC, PSWUC, PLWDC, &
- PLWUC, PFMUC, PFMVC, PT2M_MIN, PT2M_MAX, PLEIC, &
- PHU2M_MIN, PHU2M_MAX, PWIND10M, PWIND10M_MAX, &
- PEVAP, PEVAPC, PSUBL, PSUBLC )
-ELSE IF (U%CSEA=='NONE ') THEN
- PRN = XUNDEF
- PH = XUNDEF
- PLE = XUNDEF
- PLEI = XUNDEF
- PEVAP = XUNDEF
- PSUBL = XUNDEF
- PGFLUX = XUNDEF
- PRI = XUNDEF
- PCD = XUNDEF
- PCH = XUNDEF
- PCE = XUNDEF
- PQS = XUNDEF
- PZ0 = XUNDEF
- PZ0H = XUNDEF
- PTS = XUNDEF
- PT2M = XUNDEF
- PQ2M = XUNDEF
- PHU2M = XUNDEF
- PZON10M = XUNDEF
- PMER10M = XUNDEF
- PSWD = XUNDEF
- PSWU = XUNDEF
- PSWBD = XUNDEF
- PSWBU = XUNDEF
- PLWD = XUNDEF
- PLWU = XUNDEF
- PFMU = XUNDEF
- PFMV = XUNDEF
- PRNC = XUNDEF
- PHC = XUNDEF
- PLEC = XUNDEF
- PLEIC = XUNDEF
- PEVAPC = XUNDEF
- PSUBLC = XUNDEF
- PGFLUXC = XUNDEF
- PSWDC = XUNDEF
- PSWUC = XUNDEF
- PLWDC = XUNDEF
- PLWUC = XUNDEF
- PFMUC = XUNDEF
- PFMVC = XUNDEF
- PT2M_MIN = XUNDEF
- PT2M_MAX = XUNDEF
- PHU2M_MIN= XUNDEF
- PHU2M_MAX= XUNDEF
- PWIND10M = XUNDEF
- PWIND10M_MAX = XUNDEF
+IF (HSEA=='SEAFLX') THEN
+ CALL DIAG_EVAP(SD%O, SD%D, SD%DC, HPROGRAM, DUP, DUPC, KMASK)
+ELSEIF (HSEA=='FLUX') THEN
+ CALL DIAG_EVAP(DLO, DL, DLC, HPROGRAM, DUP, DUPC, KMASK)
+ELSE IF (HSEA=='NONE ') THEN
+ CALL INIT_BUD(SD%O, DUP, DUPC, XUNDEF)
END IF
IF (LHOOK) CALL DR_HOOK('DIAG_SEA_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/diag_surf_atmn.F90 b/src/SURFEX/diag_surf_atmn.F90
index dc9fe0c48501179a33dfb006f15a64c6917fe231..6ed4173396ef75a7965b8c7942065df136ef5383 100644
--- a/src/SURFEX/diag_surf_atmn.F90
+++ b/src/SURFEX/diag_surf_atmn.F90
@@ -2,9 +2,8 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE DIAG_SURF_ATM_n (DGEI, DGF, DGL, DGI, DGS, DGU, DGT, DGW, U, USS, &
- HPROGRAM)
+! ########
+SUBROUTINE DIAG_SURF_ATM_n (YSC, HPROGRAM)
! #################################################################################
!
!!**** *DIAG_SURF_ATM_n * - Chooses the surface schemes for diagnostics
@@ -31,23 +30,7 @@ SUBROUTINE DIAG_SURF_ATM_n (DGEI, DGF, DGL, DGI, DGS, DGU, DGT, DGW, U, USS, &
! B. decharme 04/2013 : Add EVAP and SUBL diag
!!------------------------------------------------------------------
!
-
-!
-!
-!
-!
-!
-!
-USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
-USE MODD_DIAG_FLAKE_n, ONLY : DIAG_FLAKE_t
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
-USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
-USE MODD_DIAG_SEAFLUX_n, ONLY : DIAG_SEAFLUX_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_DIAG_TEB_n, ONLY : DIAG_TEB_t
-USE MODD_DIAG_WATFLUX_n, ONLY : DIAG_WATFLUX_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SURFEX_n, ONLY : SURFEX_t
!
USE MODD_SURF_CONF, ONLY : CPROGNAME
USE MODD_DATA_COVER_PAR, ONLY : NTILESFC
@@ -68,19 +51,9 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(SURFEX_t), INTENT(INOUT) :: YSC
!
-TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DGEI
-TYPE(DIAG_FLAKE_t), INTENT(INOUT) :: DGF
-TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
-TYPE(DIAG_ISBA_t), INTENT(INOUT) :: DGI
-TYPE(DIAG_SEAFLUX_t), INTENT(INOUT) :: DGS
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(DIAG_TEB_t), INTENT(INOUT) :: DGT
-TYPE(DIAG_WATFLUX_t), INTENT(INOUT) :: DGW
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
!
!
!* 0.2 declarations of local variables
@@ -89,22 +62,21 @@ INTEGER :: JTILE ! loop on type of surface
LOGICAL :: GNATURE, GTOWN, GWATER, GSEA ! .T. if the corresponding surface is represented
INTEGER :: JSW ! number of spectral whort wave bands
!
-REAL, DIMENSION(SIZE(U%XSEA),NTILESFC) :: ZFRAC_TILE! fraction of each tile
-INTEGER, DIMENSION(5) :: IFACT
+REAL, DIMENSION(SIZE(YSC%U%XSEA),NTILESFC) :: ZFRAC_TILE! fraction of each tile
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
! Preliminaries: Tile related operations
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('DIAG_SURF_ATM_N',0,ZHOOK_HANDLE)
- CPROGNAME = HPROGRAM
+CPROGNAME = HPROGRAM
!
! FLAGS for the various surfaces:
!
-GSEA = U%NDIM_SEA >0
-GWATER = U%NDIM_WATER >0
-GTOWN = U%NDIM_TOWN >0
-GNATURE = U%NDIM_NATURE >0
+GSEA = YSC%U%NDIM_SEA >0
+GWATER = YSC%U%NDIM_WATER >0
+GTOWN = YSC%U%NDIM_TOWN >0
+GNATURE = YSC%U%NDIM_NATURE >0
!
! Tile counter:
!
@@ -115,10 +87,7 @@ JTILE = 0
ZFRAC_TILE(:,:) = 0.0
!
! Number of spectral short wave bands for detailed radiation budget
-JSW = SIZE(DGU%XSWBD_TILE,3)
-!
-!
- CALL GET_DIMS(IFACT)
+JSW = SIZE(YSC%DUP%AL(1)%XSWBD,2)
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! SEA Tile calculations:
@@ -130,9 +99,10 @@ JTILE = JTILE + 1
!
IF(GSEA)THEN
!
- ZFRAC_TILE(:,JTILE) = U%XSEA(:)
+ ZFRAC_TILE(:,JTILE) = YSC%U%XSEA(:)
!
- CALL TREAT_SURF(JTILE,U%NSIZE_SEA,U%NR_SEA,IFACT)
+ CALL DIAG_SEA_n(YSC%DLO, YSC%DL, YSC%DLC, YSC%SM%SD, &
+ YSC%U%CSEA, HPROGRAM, YSC%DUP%AL(1), YSC%DUPC%AL(1), YSC%U%NR_SEA)
!
ENDIF
!
@@ -144,9 +114,10 @@ JTILE = JTILE + 1
!
IF(GWATER)THEN
!
- ZFRAC_TILE(:,JTILE) = U%XWATER(:)
+ ZFRAC_TILE(:,JTILE) = YSC%U%XWATER(:)
!
- CALL TREAT_SURF(JTILE,U%NSIZE_WATER,U%NR_WATER,IFACT)
+ CALL DIAG_INLAND_WATER_n(YSC%DLO, YSC%DL, YSC%DLC, YSC%FM, YSC%WM, &
+ YSC%U%CWATER, HPROGRAM, YSC%DUP%AL(2), YSC%DUPC%AL(2), YSC%U%NR_WATER)
!
ENDIF
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -157,9 +128,10 @@ JTILE = JTILE + 1
!
IF(GNATURE)THEN
!
- ZFRAC_TILE(:,JTILE) = U%XNATURE(:)
+ ZFRAC_TILE(:,JTILE) = YSC%U%XNATURE(:)
!
- CALL TREAT_SURF(JTILE,U%NSIZE_NATURE,U%NR_NATURE,IFACT)
+ CALL DIAG_NATURE_n(YSC%DLO, YSC%DL, YSC%DLC, YSC%IM%ID, &
+ YSC%U%CNATURE, HPROGRAM, YSC%DUP%AL(3), YSC%DUPC%AL(3), YSC%U%NR_NATURE)
!
ENDIF
!
@@ -171,9 +143,10 @@ JTILE = JTILE + 1
!
IF(GTOWN)THEN
!
- ZFRAC_TILE(:,JTILE) = U%XTOWN(:)
+ ZFRAC_TILE(:,JTILE) = YSC%U%XTOWN(:)
!
- CALL TREAT_SURF(JTILE,U%NSIZE_TOWN,U%NR_TOWN,IFACT)
+ CALL DIAG_TOWN_n(YSC%DLO, YSC%DL, YSC%DLC, YSC%TM%TD, &
+ YSC%U%CTOWN, HPROGRAM, YSC%DUP%AL(4), YSC%DUPC%AL(4), YSC%U%NR_TOWN)
!
ENDIF
!
@@ -181,315 +154,31 @@ ENDIF
! Grid box average fluxes/properties:
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
- CALL AVERAGE_DIAG(DGU%N2M, DGU%LT2MMW, DGU%LSURF_BUDGET, DGU%LSURF_BUDGETC, DGU%LCOEF, DGU%LSURF_VARS, &
- ZFRAC_TILE, DGU%XRN_TILE, DGU%XH_TILE, DGU%XLE_TILE, DGU%XLEI_TILE , &
- DGU%XGFLUX_TILE,DGU%XRI_TILE, DGU%XCD_TILE, DGU%XCH_TILE, DGU%XCE_TILE, &
- DGU%XT2M_TILE, DGU%XTS_TILE, DGU%XQ2M_TILE, DGU%XHU2M_TILE, &
- DGU%XZON10M_TILE, DGU%XMER10M_TILE, &
- DGU%XQS_TILE, DGU%XZ0_TILE, DGU%XZ0H_TILE, &
- DGU%XSWD_TILE, DGU%XSWU_TILE, DGU%XSWBD_TILE, DGU%XSWBU_TILE, &
- DGU%XLWD_TILE, DGU%XLWU_TILE, DGU%XFMU_TILE, DGU%XFMV_TILE, &
- DGU%XRNC_TILE, DGU%XHC_TILE, DGU%XLEC_TILE, DGU%XGFLUXC_TILE, &
- DGU%XSWDC_TILE, DGU%XSWUC_TILE, DGU%XLWDC_TILE, DGU%XLWUC_TILE, &
- DGU%XFMUC_TILE, DGU%XFMVC_TILE, DGU%XT2M_MIN_TILE, &
- DGU%XT2M_MAX_TILE, DGU%XLEIC_TILE, &
- DGU%XAVG_RN, DGU%XAVG_H, DGU%XAVG_LE, DGU%XAVG_LEI, DGU%XAVG_GFLUX, &
- DGU%XAVG_RI, DGU%XAVG_CD, DGU%XAVG_CH, DGU%XAVG_CE, &
- DGU%XAVG_T2M, DGU%XAVG_TS, DGU%XAVG_Q2M, DGU%XAVG_HU2M, &
- DGU%XAVG_ZON10M, DGU%XAVG_MER10M, &
- DGU%XAVG_QS, DGU%XAVG_Z0, DGU%XAVG_Z0H, &
- DGU%XDIAG_UREF, DGU%XDIAG_ZREF, &
- DGU%XAVG_SWD, DGU%XAVG_SWU, DGU%XAVG_SWBD, DGU%XAVG_SWBU, &
- DGU%XAVG_LWD, DGU%XAVG_LWU, DGU%XAVG_FMU, DGU%XAVG_FMV, &
- DGU%XAVG_RNC, DGU%XAVG_HC, DGU%XAVG_LEC, DGU%XAVG_GFLUXC, &
- DGU%XAVG_SWDC, DGU%XAVG_SWUC, DGU%XAVG_LWDC, DGU%XAVG_LWUC, &
- DGU%XAVG_FMUC, DGU%XAVG_FMVC, DGU%XAVG_T2M_MIN, &
- DGU%XAVG_T2M_MAX, DGU%XAVG_LEIC, &
- DGU%XHU2M_MIN_TILE, DGU%XHU2M_MAX_TILE, DGU%XAVG_HU2M_MIN, &
- DGU%XAVG_HU2M_MAX, DGU%XWIND10M_TILE, DGU%XWIND10M_MAX_TILE, &
- DGU%XAVG_WIND10M, DGU%XAVG_WIND10M_MAX, &
- DGU%XEVAP_TILE, DGU%XEVAPC_TILE, DGU%XAVG_EVAP, DGU%XAVG_EVAPC, &
- DGU%XSUBL_TILE, DGU%XSUBLC_TILE, DGU%XAVG_SUBL, DGU%XAVG_SUBLC )
+CALL AVERAGE_DIAG(ZFRAC_TILE, YSC%DUO, YSC%DU, YSC%DUP, YSC%DUC, YSC%DUPC)
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Quantities at 2 meters above the minimum orography of the grid mesh
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-IF (DGU%L2M_MIN_ZS) CALL GET_2M
+IF (YSC%DUO%L2M_MIN_ZS) CALL GET_2M
!
IF (LHOOK) CALL DR_HOOK('DIAG_SURF_ATM_N',1,ZHOOK_HANDLE)
- CONTAINS
+CONTAINS
!=======================================================================================
SUBROUTINE GET_2M
!
-REAL, DIMENSION(SIZE(U%XSEA)) :: ZPS ! surface air pressure
-REAL, DIMENSION(SIZE(U%XSEA)) :: ZRHOA ! surface air density
+REAL, DIMENSION(SIZE(YSC%U%XSEA)) :: ZPS ! surface air pressure
+REAL, DIMENSION(SIZE(YSC%U%XSEA)) :: ZRHOA ! surface air density
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('DIAG_SURF_ATM_n:GET_2M',0,ZHOOK_HANDLE)
!
- CALL MINZS_VERT_SHIFT(U%XZS,USS%XMIN_ZS,DGU%XAVG_T2M,DGU%XAVG_Q2M,DGU%XPS,DGU%XRHOA, &
- DGU%XAVG_T2M_MIN_ZS,DGU%XAVG_Q2M_MIN_ZS,ZPS,ZRHOA)
-DGU%XAVG_HU2M_MIN_ZS = DGU%XAVG_HU2M
+CALL MINZS_VERT_SHIFT(YSC%DU, YSC%U%XZS, YSC%USS%XMIN_ZS, ZPS, ZRHOA)
+YSC%DU%XHU2M_MIN_ZS = YSC%DU%XHU2M
!
IF (LHOOK) CALL DR_HOOK('DIAG_SURF_ATM_n:GET_2M',1,ZHOOK_HANDLE)
!
END SUBROUTINE GET_2M
!
!=======================================================================================
-!
-SUBROUTINE GET_DIMS(KFACT)
-!
-IMPLICIT NONE
-!
-INTEGER, DIMENSION(5), INTENT(OUT) :: KFACT
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_SURF_ATM_n:GET_DIMS',0,ZHOOK_HANDLE)
-!
-KFACT(:)=0
-!
-IF (DGU%LSURF_BUDGET) KFACT(1)=1
-!
-IF (DGU%LSURF_BUDGETC) KFACT(2)=1
-!
-IF (DGU%N2M>=1) KFACT(3)=1
-!
-IF (DGU%LCOEF) KFACT(4)=1
-!
-IF (DGU%LSURF_VARS) KFACT(5)=1
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_SURF_ATM_n:GET_DIMS',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE GET_DIMS
-!
-!=======================================================================================
-!
-SUBROUTINE TREAT_SURF(KTILE,KSIZE,KMASK,KFACT)
-!
-IMPLICIT NONE
-!
-INTEGER, INTENT(IN) :: KTILE
-INTEGER, INTENT(IN) :: KSIZE
-INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
-INTEGER, DIMENSION(5), INTENT(IN) :: KFACT
-!
-REAL, DIMENSION(KSIZE) :: ZP_TS ! surface temperature (K)
-!
-REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_RN ! Net radiation (W/m2)
-REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_H ! sensible heat flux (W/m2)
-REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_LE ! total latent heat flux (W/m2)
-REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_LEI ! sublimation latent heat flux (W/m2)
-REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_GFLUX ! storage flux (W/m2)
-REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_EVAP ! total evapotranspiration (kg/m2/s)
-REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_SUBL ! sublimation (kg/m2/s)
-!
-REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_SWD ! short wave incoming radiation (W/m2)
-REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_SWU ! short wave outgoing radiation (W/m2)
-REAL, DIMENSION(KSIZE*KFACT(1),JSW*KFACT(1)) :: ZP_SWBD ! short wave incoming radiation by spectral band (W/m2)
-REAL, DIMENSION(KSIZE*KFACT(1),JSW*KFACT(1)) :: ZP_SWBU ! short wave outgoing radiation by spectral band (W/m2)
-REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_LWD ! long wave incoming radiation (W/m2)
-REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_LWU ! long wave outgoing radiation (W/m2)
-REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_FMU ! zonal friction
-REAL, DIMENSION(KSIZE*KFACT(1)) :: ZP_FMV ! meridian friction
-!
-REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_RNC ! Cumulated Net radiation (W/m2)
-REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_HC ! Cumulated sensible heat flux (W/m2)
-REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_LEC ! Cumulated total latent heat flux (W/m2)
-REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_LEIC ! Cumulated sublimation latent heat flux (W/m2)
-REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_GFLUXC ! Cumulated storage flux (W/m2)
-REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_EVAPC ! Cumulated total evapotranspiration (kg/m2)
-REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_SUBLC ! Cumulated sublimation (kg/m2)
-REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_SWDC ! Cumulated short wave incoming radiation (W/m2)
-REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_SWUC ! Cumulated short wave outgoing radiation (W/m2)
-REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_LWDC ! Cumulated long wave incoming radiation (W/m2)
-REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_LWUC ! Cumulated long wave outgoing radiation (W/m2)
-REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_FMUC ! Cumulated zonal friction
-REAL, DIMENSION(KSIZE*KFACT(2)) :: ZP_FMVC ! Cumulated meridian friction
-!
-REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_RI ! Richardson number
-REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_T2M ! air temperature at 2 meters (K)
-REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_T2M_MIN ! Minimum air temperature at 2 meters (K)
-REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_T2M_MAX ! Maximum air temperature at 2 meters (K)
-REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_Q2M ! air humidity at 2 meters (kg/kg)
-REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_HU2M ! air relative humidity at 2 meters (-)
-REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_HU2M_MIN ! Minimum air relative humidity at 2 meters (-)
-REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_HU2M_MAX ! Maximum air relative humidity at 2 meters (-)
-REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_ZON10M ! zonal wind at 10 meters (m/s)
-REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_MER10M ! meridian wind at 10 meters (m/s)
-REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_WIND10M ! wind at 10 meters (m/s)
-REAL, DIMENSION(KSIZE*KFACT(3)) :: ZP_WIND10M_MAX ! Maximum wind at 10 meters (m/s)
-!
-REAL, DIMENSION(KSIZE*KFACT(4)) :: ZP_CD ! drag coefficient for wind
-REAL, DIMENSION(KSIZE*KFACT(4)) :: ZP_CH ! drag coefficient for heat
-REAL, DIMENSION(KSIZE*KFACT(4)) :: ZP_CE ! drag coefficient for evaporation
-REAL, DIMENSION(KSIZE*KFACT(4)) :: ZP_Z0 ! roughness length for momentum
-REAL, DIMENSION(KSIZE*KFACT(4)) :: ZP_Z0H ! roughness length for heat
-!
-REAL, DIMENSION(KSIZE*KFACT(5)) :: ZP_QS ! specific humidity
-!
-INTEGER :: JJ, JJSW
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_SURF_ATM_n:TREAT_SURF',0,ZHOOK_HANDLE)
-!
-IF (KTILE==1) THEN
- !
- CALL DIAG_SEA_n(DGL, DGS, U, &
- HPROGRAM, &
- ZP_RN, ZP_H, ZP_LE, ZP_LEI, ZP_GFLUX, &
- ZP_RI, ZP_CD, ZP_CH, ZP_CE, &
- ZP_QS, ZP_Z0, ZP_Z0H, &
- ZP_T2M, ZP_TS, ZP_Q2M, ZP_HU2M, &
- ZP_ZON10M, ZP_MER10M, &
- ZP_SWD, ZP_SWU, ZP_SWBD, ZP_SWBU, &
- ZP_LWD, ZP_LWU, ZP_FMU, ZP_FMV, &
- ZP_RNC, ZP_HC, ZP_LEC, ZP_GFLUXC, &
- ZP_SWDC, ZP_SWUC, ZP_LWDC, ZP_LWUC, &
- ZP_FMUC, ZP_FMVC, ZP_T2M_MIN, &
- ZP_T2M_MAX, ZP_LEIC, ZP_HU2M_MIN, &
- ZP_HU2M_MAX, ZP_WIND10M, &
- ZP_WIND10M_MAX, &
- ZP_EVAP, ZP_EVAPC, ZP_SUBL, ZP_SUBLC )
- !
-ELSEIF (KTILE==2) THEN
- !
- CALL DIAG_INLAND_WATER_n(DGF, DGL, DGW, U, &
- HPROGRAM, &
- ZP_RN, ZP_H, ZP_LE, ZP_LEI, ZP_GFLUX,&
- ZP_RI, ZP_CD, ZP_CH, ZP_CE, &
- ZP_QS, ZP_Z0, ZP_Z0H, &
- ZP_T2M, ZP_TS, ZP_Q2M, ZP_HU2M, &
- ZP_ZON10M, ZP_MER10M, &
- ZP_SWD, ZP_SWU, ZP_SWBD, ZP_SWBU, &
- ZP_LWD, ZP_LWU, ZP_FMU, ZP_FMV, &
- ZP_RNC, ZP_HC, ZP_LEC, ZP_GFLUXC, &
- ZP_SWDC, ZP_SWUC, ZP_LWDC, ZP_LWUC, &
- ZP_FMUC, ZP_FMVC, ZP_T2M_MIN, &
- ZP_T2M_MAX, ZP_LEIC, ZP_HU2M_MIN, &
- ZP_HU2M_MAX, ZP_WIND10M, &
- ZP_WIND10M_MAX, &
- ZP_EVAP, ZP_EVAPC, ZP_SUBL, ZP_SUBLC )
- !
-ELSEIF (KTILE==3) THEN
- !
- CALL DIAG_NATURE_n(DGEI, DGL, DGI, U, &
- HPROGRAM, &
- ZP_RN, ZP_H, ZP_LE, ZP_LEI, ZP_GFLUX,&
- ZP_RI, ZP_CD, ZP_CH, ZP_CE, &
- ZP_QS, ZP_Z0, ZP_Z0H, &
- ZP_T2M, ZP_TS, ZP_Q2M, ZP_HU2M, &
- ZP_ZON10M, ZP_MER10M, &
- ZP_SWD, ZP_SWU, ZP_SWBD, ZP_SWBU, &
- ZP_LWD, ZP_LWU, ZP_FMU, ZP_FMV, &
- ZP_RNC, ZP_HC, ZP_LEC, ZP_GFLUXC, &
- ZP_SWDC, ZP_SWUC, ZP_LWDC, ZP_LWUC, &
- ZP_FMUC, ZP_FMVC, ZP_T2M_MIN, &
- ZP_T2M_MAX, ZP_LEIC, ZP_HU2M_MIN, &
- ZP_HU2M_MAX, ZP_WIND10M, &
- ZP_WIND10M_MAX, &
- ZP_EVAP, ZP_EVAPC, ZP_SUBL, ZP_SUBLC )
- !
-ELSEIF (KTILE==4) THEN
- !
- CALL DIAG_TOWN_n(DGL, DGT, U, &
- HPROGRAM, &
- ZP_RN, ZP_H, ZP_LE, ZP_LEI, ZP_GFLUX,&
- ZP_RI, ZP_CD, ZP_CH, ZP_CE, &
- ZP_QS, ZP_Z0, ZP_Z0H, &
- ZP_T2M, ZP_TS, ZP_Q2M, ZP_HU2M, &
- ZP_ZON10M, ZP_MER10M, &
- ZP_SWD, ZP_SWU, ZP_SWBD, ZP_SWBU, &
- ZP_LWD, ZP_LWU, ZP_FMU, ZP_FMV, &
- ZP_RNC, ZP_HC, ZP_LEC, ZP_GFLUXC, &
- ZP_SWDC, ZP_SWUC, ZP_LWDC, ZP_LWUC, &
- ZP_FMUC, ZP_FMVC, ZP_T2M_MIN, &
- ZP_T2M_MAX, ZP_LEIC, ZP_HU2M_MIN, &
- ZP_HU2M_MAX, ZP_WIND10M, &
- ZP_WIND10M_MAX, &
- ZP_EVAP, ZP_EVAPC, ZP_SUBL, ZP_SUBLC )
- !
-ENDIF
-!
-!----------------------------------------------------------------------
-IF (DGU%LSURF_BUDGET) THEN
- DO JJ=1,KSIZE
- DGU%XRN_TILE (KMASK(JJ),KTILE) = ZP_RN (JJ)
- DGU%XH_TILE (KMASK(JJ),KTILE) = ZP_H (JJ)
- DGU%XLE_TILE (KMASK(JJ),KTILE) = ZP_LE (JJ)
- DGU%XLEI_TILE (KMASK(JJ),KTILE) = ZP_LEI (JJ)
- DGU%XGFLUX_TILE (KMASK(JJ),KTILE) = ZP_GFLUX (JJ)
- DGU%XEVAP_TILE (KMASK(JJ),KTILE) = ZP_EVAP (JJ)
- DGU%XSUBL_TILE (KMASK(JJ),KTILE) = ZP_SUBL (JJ)
- DGU%XSWD_TILE (KMASK(JJ),KTILE) = ZP_SWD (JJ)
- DGU%XSWU_TILE (KMASK(JJ),KTILE) = ZP_SWU (JJ)
- DGU%XLWD_TILE (KMASK(JJ),KTILE) = ZP_LWD (JJ)
- DGU%XLWU_TILE (KMASK(JJ),KTILE) = ZP_LWU (JJ)
- DGU%XFMU_TILE (KMASK(JJ),KTILE) = ZP_FMU (JJ)
- DGU%XFMV_TILE (KMASK(JJ),KTILE) = ZP_FMV (JJ)
- DO JJSW=1, SIZE(DGU%XSWBD_TILE,3)
- DGU%XSWBD_TILE (KMASK(JJ),KTILE,JJSW) = ZP_SWBD (JJ,JJSW)
- DGU%XSWBU_TILE (KMASK(JJ),KTILE,JJSW) = ZP_SWBU (JJ,JJSW)
- ENDDO
- ENDDO
-END IF
-!
-IF (DGU%LSURF_BUDGETC) THEN
- DO JJ=1,KSIZE
- DGU%XRNC_TILE (KMASK(JJ),KTILE) = ZP_RNC (JJ)
- DGU%XHC_TILE (KMASK(JJ),KTILE) = ZP_HC (JJ)
- DGU%XLEC_TILE (KMASK(JJ),KTILE) = ZP_LEC (JJ)
- DGU%XLEIC_TILE (KMASK(JJ),KTILE) = ZP_LEIC (JJ)
- DGU%XGFLUXC_TILE (KMASK(JJ),KTILE) = ZP_GFLUXC (JJ)
- DGU%XEVAPC_TILE (KMASK(JJ),KTILE) = ZP_EVAPC (JJ)
- DGU%XSUBLC_TILE (KMASK(JJ),KTILE) = ZP_SUBLC (JJ)
- DGU%XSWDC_TILE (KMASK(JJ),KTILE) = ZP_SWDC (JJ)
- DGU%XSWUC_TILE (KMASK(JJ),KTILE) = ZP_SWUC (JJ)
- DGU%XLWDC_TILE (KMASK(JJ),KTILE) = ZP_LWDC (JJ)
- DGU%XLWUC_TILE (KMASK(JJ),KTILE) = ZP_LWUC (JJ)
- DGU%XFMUC_TILE (KMASK(JJ),KTILE) = ZP_FMUC (JJ)
- DGU%XFMVC_TILE (KMASK(JJ),KTILE) = ZP_FMVC (JJ)
- ENDDO
-END IF
-!
-DO JJ=1,KSIZE
- DGU%XTS_TILE (KMASK(JJ),KTILE) = ZP_TS (JJ)
-ENDDO
-!
-IF (DGU%N2M>=1) THEN
- DO JJ=1,KSIZE
- DGU%XRI_TILE (KMASK(JJ),KTILE) = ZP_RI (JJ)
- DGU%XT2M_TILE (KMASK(JJ),KTILE) = ZP_T2M (JJ)
- DGU%XT2M_MIN_TILE (KMASK(JJ),KTILE) = ZP_T2M_MIN (JJ)
- DGU%XT2M_MAX_TILE (KMASK(JJ),KTILE) = ZP_T2M_MAX (JJ)
- DGU%XQ2M_TILE (KMASK(JJ),KTILE) = ZP_Q2M (JJ)
- DGU%XHU2M_TILE (KMASK(JJ),KTILE) = ZP_HU2M (JJ)
- DGU%XHU2M_MIN_TILE(KMASK(JJ),KTILE) = ZP_HU2M_MIN (JJ)
- DGU%XHU2M_MAX_TILE(KMASK(JJ),KTILE) = ZP_HU2M_MAX (JJ)
- DGU%XZON10M_TILE (KMASK(JJ),KTILE) = ZP_ZON10M (JJ)
- DGU%XMER10M_TILE (KMASK(JJ),KTILE) = ZP_MER10M (JJ)
- DGU%XWIND10M_TILE (KMASK(JJ),KTILE) = ZP_WIND10M (JJ)
- DGU%XWIND10M_MAX_TILE (KMASK(JJ),KTILE) = ZP_WIND10M_MAX (JJ)
- ENDDO
-END IF
-!
-IF (DGU%LCOEF) THEN
- DO JJ=1,KSIZE
- DGU%XCD_TILE (KMASK(JJ),KTILE) = ZP_CD (JJ)
- DGU%XCH_TILE (KMASK(JJ),KTILE) = ZP_CH (JJ)
- DGU%XCE_TILE (KMASK(JJ),KTILE) = ZP_CE (JJ)
- DGU%XZ0_TILE (KMASK(JJ),KTILE) = ZP_Z0 (JJ)
- DGU%XZ0H_TILE (KMASK(JJ),KTILE) = ZP_Z0H (JJ)
- ENDDO
-END IF
-IF (DGU%LSURF_VARS) THEN
- DO JJ=1,KSIZE
- DGU%XQS_TILE (KMASK(JJ),KTILE) = ZP_QS (JJ)
- ENDDO
-END IF
-!----------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('DIAG_SURF_ATM_n:TREAT_SURF',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE TREAT_SURF
-!=======================================================================================
END SUBROUTINE DIAG_SURF_ATM_n
diff --git a/src/SURFEX/diag_surf_budget_flake.F90 b/src/SURFEX/diag_surf_budget_flake.F90
index 6b78fea79fcaabe3da0cd22edf809ffb61321c21..d63ef2e8d92275d315d1fdfa0199b4e4b40d9ff2 100644
--- a/src/SURFEX/diag_surf_budget_flake.F90
+++ b/src/SURFEX/diag_surf_budget_flake.F90
@@ -3,13 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_SURF_BUDGET_FLAKE (PRHOA, PSFTH, &
- PDIR_SW, PSCA_SW, PLW, &
- PDIR_ALB, PSCA_ALB, PLWUP, &
- PSFZON, PSFMER, PLE, &
- PRN, PH, PGFLUX, &
- PSWD, PSWU, PSWBD, PSWBU, PLWD, PLWU, &
- PFMU, PFMV )
+ SUBROUTINE DIAG_SURF_BUDGET_FLAKE (D, PRHOA, PSFTH, PDIR_SW, PSCA_SW, PLW, &
+ PDIR_ALB, PSCA_ALB, PLWUP, PSFZON, PSFMER )
! ###############################################################################
!
!!**** *DIAG_SURF_BUDGET_FLAKE * - Computes diagnostics over lake
@@ -33,6 +28,7 @@
!! Original 04/2013
!!------------------------------------------------------------------
!
+USE MODD_DIAG_n, ONLY : DIAG_t
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -41,6 +37,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(DIAG_t), INTENT(INOUT) :: D
+!
REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! air density
REAL, DIMENSION(:), INTENT(IN) :: PSFTH ! heat flux
REAL, DIMENSION(:,:),INTENT(IN):: PDIR_SW ! direct solar radiation (on horizontal surf.)
@@ -54,22 +52,6 @@ REAL, DIMENSION(:,:),INTENT(IN):: PSCA_ALB ! diffuse albedo for each spectral b
REAL, DIMENSION(:), INTENT(IN) :: PSFZON ! zonal friction
REAL, DIMENSION(:), INTENT(IN) :: PSFMER ! meridional friction
!
-REAL, DIMENSION(:), INTENT(IN) :: PLE ! total latent heat flux (W/m2)
-!
-REAL, DIMENSION(:), INTENT(OUT):: PRN ! net radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PH ! sensible heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PGFLUX ! storage flux (W/m2)
-!
-REAL, DIMENSION(:,:), INTENT(OUT):: PSWBD ! incoming short wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT):: PSWBU ! upward short wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PSWD ! total incoming short wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PSWU ! total upward short wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PLWD ! Downward long wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PLWU ! upward long wave radiation (W/m2)
-!
-REAL, DIMENSION(:), INTENT(OUT):: PFMU ! zonal friction
-REAL, DIMENSION(:), INTENT(OUT):: PFMV ! meridional friction
-!
!* 0.2 declarations of local variables
!
INTEGER :: ISWB ! number of SW bands
@@ -84,39 +66,39 @@ ISWB = SIZE(PDIR_SW,2)
!* total incoming and outgoing SW
!
DO JSWB=1,ISWB
- PSWBD(:,JSWB) = PDIR_SW(:,JSWB) + PSCA_SW(:,JSWB)
- PSWBU(:,JSWB) = PDIR_SW(:,JSWB) * PDIR_ALB(:,JSWB) + PSCA_SW(:,JSWB) * PSCA_ALB(:,JSWB)
+ D%XSWBD(:,JSWB) = PDIR_SW(:,JSWB) + PSCA_SW(:,JSWB)
+ D%XSWBU(:,JSWB) = PDIR_SW(:,JSWB) * PDIR_ALB(:,JSWB) + PSCA_SW(:,JSWB) * PSCA_ALB(:,JSWB)
ENDDO
!
-PSWD(:) = 0.
-PSWU(:) = 0.
+D%XSWD(:) = 0.
+D%XSWU(:) = 0.
DO JSWB=1,ISWB
- PSWD(:)=PSWD(:)+PSWBD(:,JSWB)
- PSWU(:)=PSWU(:)+PSWBU(:,JSWB)
+ D%XSWD(:)=D%XSWD(:)+D%XSWBD(:,JSWB)
+ D%XSWU(:)=D%XSWU(:)+D%XSWBU(:,JSWB)
ENDDO
!
!*incoming outgoing LW
!
-PLWD(:)=PLW (:)
-PLWU(:)=PLWUP(:)
+D%XLWD(:)=PLW (:)
+D%XLWU(:)=PLWUP(:)
!
!* net radiation
!
-PRN = PSWD(:) - PSWU(:) + PLWD(:) - PLWU(:)
+D%XRN = D%XSWD(:) - D%XSWU(:) + D%XLWD(:) - D%XLWU(:)
!
!* sensible heat flux
!
-PH = PSFTH(:)
+D%XH = PSFTH(:)
!
!* storage flux
!
-PGFLUX = PRN - PH - PLE
+D%XGFLUX = D%XRN - D%XH - D%XLE
!
!* wind stress
!
-PFMU = PSFZON
+D%XFMU = PSFZON
!
-PFMV = PSFMER
+D%XFMV = PSFMER
IF (LHOOK) CALL DR_HOOK('DIAG_SURF_BUDGET_FLAKE',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/diag_surf_budget_isba.F90 b/src/SURFEX/diag_surf_budget_isba.F90
index eecd56b9182bd50e310f2eb3bbcf47e4e042d095..75c858ff04854147d2d0947febe9e9ef36ca75b1 100644
--- a/src/SURFEX/diag_surf_budget_isba.F90
+++ b/src/SURFEX/diag_surf_budget_isba.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_SURF_BUDGET_ISBA (PDIR_SW, PSCA_SW, PDIR_ALB, PSCA_ALB, &
- PLW, PRN, &
- PSWD, PSWU, PSWBD, PSWBU, PLWD, PLWU )
+ SUBROUTINE DIAG_SURF_BUDGET_ISBA (PDIR_SW, PSCA_SW, PLW, K, DK )
! ###############################################################################
!
!!**** *DIAG_SURF_BUDGET_ISBA * - Computes diagnostics over ISBA
@@ -30,9 +28,10 @@
!! Modified 08/2008 (B. Decharme) LWU diag
!!------------------------------------------------------------------
!
-USE MODD_CSTS, ONLY : XSTEFAN
+USE MODD_DIAG_n, ONLY : DIAG_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t
!
-!
+USE MODD_CSTS, ONLY : XSTEFAN
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -46,17 +45,9 @@ REAL, DIMENSION(:,:),INTENT(IN) :: PDIR_SW ! direct solar radiation (on hori
REAL, DIMENSION(:,:),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.)
! ! (W/m2)
REAL, DIMENSION(:), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.)
-REAL, DIMENSION(:,:),INTENT(IN) :: PDIR_ALB ! direct albedo for each spectral band (-)
-REAL, DIMENSION(:,:),INTENT(IN) :: PSCA_ALB ! diffuse albedo for each spectral band (-)
-REAL, DIMENSION(:), INTENT(IN) :: PRN ! Surface net radiation
-!
-REAL, DIMENSION(:,:), INTENT(OUT):: PSWBD ! incoming short wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT):: PSWBU ! upward short wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWD ! total incoming short wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWU ! total upward short wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWD ! Downward long wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWU ! upward long wave radiation (W/m2)
!
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(DIAG_t), INTENT(INOUT) :: DK
!
!* 0.2 declarations of local variables
!
@@ -72,15 +63,16 @@ ISWB = SIZE(PDIR_SW,2)
!* total incoming and outgoing SW
!
DO JSWB=1,ISWB
- PSWBD(:,JSWB) = PDIR_SW(:,JSWB) + PSCA_SW(:,JSWB)
- PSWBU(:,JSWB) = PDIR_SW(:,JSWB) * PDIR_ALB(:,JSWB) + PSCA_SW(:,JSWB) * PSCA_ALB(:,JSWB)
+ DK%XSWBD(:,JSWB) = PDIR_SW(:,JSWB) + PSCA_SW(:,JSWB)
+ DK%XSWBU(:,JSWB) = PDIR_SW(:,JSWB) * K%XDIR_ALB_WITH_SNOW(:,JSWB) + &
+ PSCA_SW(:,JSWB) * K%XSCA_ALB_WITH_SNOW(:,JSWB)
ENDDO
!
-PSWD(:) = 0.
-PSWU(:) = 0.
+DK%XSWD(:) = 0.
+DK%XSWU(:) = 0.
DO JSWB=1,ISWB
- PSWD(:)=PSWD(:)+PSWBD(:,JSWB)
- PSWU(:)=PSWU(:)+PSWBU(:,JSWB)
+ DK%XSWD(:) = DK%XSWD(:) + DK%XSWBD(:,JSWB)
+ DK%XSWU(:) = DK%XSWU(:) + DK%XSWBU(:,JSWB)
ENDDO
!
!*incoming outgoing LW
@@ -88,8 +80,9 @@ ENDDO
!Wrong old diag : LWU=EMIS*STEFAN*Ts**4 + (1.-EMIS)*LW
!Due to e_budget.f90 linearization, LWU can not be calculated using actual Ts
!
-PLWD(:)=PLW(:)
-PLWU(:)=PSWD(:)-PSWU(:)+PLWD(:)-PRN(:)
+DK%XLWD(:) = PLW(:)
+DK%XLWU(:) = DK%XSWD(:) - DK%XSWU(:) + DK%XLWD(:) - DK%XRN(:)
+!
IF (LHOOK) CALL DR_HOOK('DIAG_SURF_BUDGET_ISBA',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/diag_surf_budget_sea.F90 b/src/SURFEX/diag_surf_budget_sea.F90
index 5b156c99ea98c6e44bfe19bcecf3ada53a9bc531..f79d7c1faf6b98b2cb56c4a3aadb6e739ad61d6c 100644
--- a/src/SURFEX/diag_surf_budget_sea.F90
+++ b/src/SURFEX/diag_surf_budget_sea.F90
@@ -3,18 +3,10 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE DIAG_SURF_BUDGET_SEA(PTT , PSST, PRHOA, PSFTH, PSFTH_ICE, &
- PSFTQ, PSFTQ_ICE, &
- PDIR_SW, PSCA_SW, PLW, &
- PDIR_ALB,PSCA_ALB,PALB_ICE,PEMIS, PTRAD,&
- PSFZON, PSFZON_ICE, PSFMER, PSFMER_ICE, &
- OHANDLE_SIC, PSIC, PTICE, &
- PRN, PH, PLE, PLE_ICE, PGFLUX, &
- PSWD, PSWU, PSWBD, PSWBU, PLWD, PLWU, &
- PFMU, PFMV, PEVAP, PSUBL, &
- PRN_ICE, PH_ICE, PGFLUX_ICE, &
- PSWU_ICE, PSWBU_ICE, PLWU_ICE, &
- PFMU_ICE, PFMV_ICE )
+SUBROUTINE DIAG_SURF_BUDGET_SEA(D, DI, S, PTT, PRHOA, PSFTH, PSFTH_ICE, &
+ PSFTQ, PSFTQ_ICE, PDIR_SW, PSCA_SW, PLW, &
+ PDIR_ALB, PSCA_ALB, PEMIS, PTRAD, &
+ PSFZON, PSFZON_ICE, PSFMER, PSFMER_ICE )
! ###############################################################################
@@ -42,8 +34,8 @@ SUBROUTINE DIAG_SURF_BUDGET_SEA(PTT , PSST, PRHOA, PSFTH, PSFTH_ICE, &
! S.Senesi 01/2014 : Handle fluxes on seaice
!!------------------------------------------------------------------
!
-
-!
+USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
+USE MODD_DIAG_n, ONLY : DIAG_t
!
USE MODD_CSTS, ONLY : XSTEFAN, XLSTT, XLVTT
USE MODD_WATER_PAR, ONLY : XEMISWATICE, XALBSEAICE
@@ -57,8 +49,11 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DI
+TYPE(SEAFLUX_t), INTENT(INOUT) :: S
+!
REAL, INTENT(IN) :: PTT ! freezing temperature of water surface
-REAL, DIMENSION(:), INTENT(IN) :: PSST ! sea surface temperature (K)
REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! air density
REAL, DIMENSION(:), INTENT(IN) :: PSFTH ! heat flux
REAL, DIMENSION(:), INTENT(IN) :: PSFTH_ICE ! heat flux on seaice
@@ -74,7 +69,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PLW ! longwave radiation (on horizontal
!
REAL, DIMENSION(:,:),INTENT(IN):: PDIR_ALB ! direct albedo for each spectral band (-)
REAL, DIMENSION(:,:),INTENT(IN):: PSCA_ALB ! diffuse albedo for each spectral band (-)
-REAL, DIMENSION(:) ,INTENT(IN):: PALB_ICE ! Seaice albedo
REAL, DIMENSION(:), INTENT(IN) :: PEMIS ! emissivity (-)
REAL, DIMENSION(:), INTENT(IN) :: PTRAD ! radiative temperature (K)
!
@@ -83,38 +77,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PSFZON_ICE! zonal friction
REAL, DIMENSION(:), INTENT(IN) :: PSFMER ! meridional friction
REAL, DIMENSION(:), INTENT(IN) :: PSFMER_ICE! meridional friction
!
-LOGICAL, INTENT(IN) :: OHANDLE_SIC ! Do we weight seaice and open sea fluxes
-REAL, DIMENSION(:), INTENT(IN) :: PSIC ! Sea ice cover (-)
-REAL, DIMENSION(:), INTENT(IN) :: PTICE ! Sea ice temperature (°K)
-!
-REAL, DIMENSION(:), INTENT(OUT):: PRN ! net radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PH ! sensible heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PLE ! total latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PLE_ICE ! sublimation latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PGFLUX ! storage flux (W/m2)
-!
-REAL, DIMENSION(:), INTENT(OUT):: PSWD ! total incoming short wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PSWU ! total upward short wave radiation (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT):: PSWBD ! incoming short wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT):: PSWBU ! upward short wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PLWD ! Downward long wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PLWU ! Upward long wave radiation (W/m2)
-!
-REAL, DIMENSION(:), INTENT(OUT):: PFMU ! zonal wind stress
-REAL, DIMENSION(:), INTENT(OUT):: PFMV ! meridian wind stress
-REAL, DIMENSION(:), INTENT(OUT):: PEVAP ! total evaporation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT):: PSUBL ! sublimation (kg/m2/s)
-! Fluxes on seaice
-REAL, DIMENSION(:), INTENT(OUT):: PRN_ICE ! net radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PH_ICE ! sensible heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PGFLUX_ICE! storage flux (W/m2)
-! Continued
-REAL, DIMENSION(:), INTENT(OUT):: PSWU_ICE ! total upward short wave radiation (W/m2)
-REAL, DIMENSION(:,:),INTENT(OUT):: PSWBU_ICE! upward short wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PLWU_ICE ! upward long wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PFMU_ICE ! zonal wind stress on sea-ice
-REAL, DIMENSION(:), INTENT(OUT):: PFMV_ICE ! meridian wind stress on sea-ice
-
!* 0.2 declarations of local variables
!
INTEGER :: I
@@ -130,51 +92,51 @@ ISWB = SIZE(PDIR_SW,2)
!* total incoming and outgoing SW
!
DO JSWB=1,ISWB
- PSWBD(:,JSWB) = PDIR_SW(:,JSWB) + PSCA_SW(:,JSWB)
- PSWBU(:,JSWB) = PDIR_SW(:,JSWB) * PDIR_ALB(:,JSWB) + PSCA_SW(:,JSWB) * PSCA_ALB(:,JSWB)
+ D%XSWBD(:,JSWB) = PDIR_SW(:,JSWB) + PSCA_SW(:,JSWB)
+ D%XSWBU(:,JSWB) = PDIR_SW(:,JSWB) * PDIR_ALB(:,JSWB) + PSCA_SW(:,JSWB) * PSCA_ALB(:,JSWB)
ENDDO
!
-PSWD(:) = 0.
-PSWU(:) = 0.
+D%XSWD(:) = 0.
+D%XSWU(:) = 0.
DO JSWB=1,ISWB
- PSWD(:)=PSWD(:)+PSWBD(:,JSWB)
- PSWU(:)=PSWU(:)+PSWBU(:,JSWB)
+ D%XSWD(:) = D%XSWD(:) + D%XSWBD(:,JSWB)
+ D%XSWU(:) = D%XSWU(:) + D%XSWBU(:,JSWB)
ENDDO
!
!*incoming outgoing LW
!
-PLWD(:)=PLW(:)
-PLWU(:)=PEMIS(:)*XSTEFAN*PTRAD(:)**4 + (1.-PEMIS(:))*PLW(:)
+D%XLWD(:)=PLW(:)
+D%XLWU(:)=PEMIS(:)*XSTEFAN*PTRAD(:)**4 + (1.-PEMIS(:))*PLW(:)
!
!* net radiation
!
-PRN(:) = PSWD(:) - PSWU(:) + PLWD(:) - PLWU (:)
+D%XRN(:) = D%XSWD(:) - D%XSWU(:) + D%XLWD(:) - D%XLWU (:)
!
-IF (.NOT.OHANDLE_SIC) THEN
+IF (.NOT.S%LHANDLE_SIC) THEN
!
!* sensible heat flux
!
- PH = PSFTH
+ D%XH = PSFTH
!
!* latent heat flux
!
- WHERE (PSST<PTT )
- PLE = PSFTQ * XLSTT
- PLE_ICE= PSFTQ * XLSTT
- PEVAP = PSFTQ
- PSUBL = PSFTQ
+ WHERE (S%XSST<PTT )
+ D%XLE = PSFTQ * XLSTT
+ D%XLEI = PSFTQ * XLSTT
+ D%XEVAP = PSFTQ
+ D%XSUBL = PSFTQ
ELSEWHERE
- PLE = PSFTQ * XLVTT
- PLE_ICE= 0.0
- PEVAP = PSFTQ
- PSUBL = 0.0
+ D%XLE = PSFTQ * XLVTT
+ D%XLEI = 0.0
+ D%XEVAP = PSFTQ
+ D%XSUBL = 0.0
END WHERE
!
!* wind stress
!
- PFMU = PSFZON
- PFMV = PSFMER
-!
+ D%XFMU = PSFZON
+ D%XFMV = PSFMER
+ !
ELSE
!
!----------------------------------------------------------------------------
@@ -185,50 +147,50 @@ ELSE
!* total incoming and outgoing SW
!
DO JSWB=1,ISWB
- PSWBU_ICE(:,JSWB) = (PDIR_SW(:,JSWB) + PSCA_SW(:,JSWB)) * PALB_ICE(:)
+ DI%XSWBU(:,JSWB) = (PDIR_SW(:,JSWB) + PSCA_SW(:,JSWB)) * S%XICE_ALB(:)
ENDDO
!
- PSWU_ICE(:) = 0.
+ DI%XSWU(:) = 0.
DO JSWB=1,ISWB
- PSWU_ICE(:)=PSWU_ICE(:)+PSWBU_ICE(:,JSWB)
+ DI%XSWU(:) = DI%XSWU(:) + DI%XSWBU(:,JSWB)
ENDDO
!
!*incoming outgoing LW
!
- PLWU_ICE(:)=XEMISWATICE*XSTEFAN*PTICE(:)**4 + (1.-XEMISWATICE)*PLW(:)
+ DI%XLWU(:)=XEMISWATICE*XSTEFAN*S%XTICE(:)**4 + (1.-XEMISWATICE)*PLW(:)
!
!* net radiation
!
- PRN_ICE(:) = PSWD(:) - PSWU_ICE(:) + PLWD(:) - PLWU_ICE(:)
+ DI%XRN(:) = D%XSWD(:) - DI%XSWU(:) + D%XLWD(:) - DI%XLWU(:)
!
!* sensible heat flux
!
- PH = (1 - PSIC) * PSFTH + PSIC * PSFTH_ICE
- PH_ICE = PSFTH_ICE
+ D%XH = (1 - S%XSIC) * PSFTH + S%XSIC * PSFTH_ICE
+ DI%XH = PSFTH_ICE
!
!* latent heat flux
!
- PLE = (1 - PSIC) * PSFTQ * XLVTT + PSIC * PSFTQ_ICE * XLSTT
- PLE_ICE = PSFTQ_ICE * XLSTT
- PEVAP = (1 - PSIC) * PSFTQ + PSIC * PSFTQ_ICE
- PSUBL = PSIC * PSFTQ_ICE
+ D%XLE = (1 - S%XSIC) * PSFTQ * XLVTT + S%XSIC * PSFTQ_ICE * XLSTT
+ D%XLEI = PSFTQ_ICE * XLSTT
+ D%XEVAP = (1 - S%XSIC) * PSFTQ + S%XSIC * PSFTQ_ICE
+ D%XSUBL = S%XSIC * PSFTQ_ICE
!
!* ice storage flux
!
- PGFLUX_ICE = PRN_ICE - PH_ICE - PLE_ICE
+ DI%XGFLUX = DI%XRN - DI%XH - D%XLEI
!
!* wind stress
!
- PFMU = (1 - PSIC) * PSFZON + PSIC * PSFZON_ICE
- PFMU_ICE = PSFZON_ICE
- PFMV = (1 - PSIC) * PSFMER + PSIC * PSFMER_ICE
- PFMV_ICE = PSFMER_ICE
+ D%XFMU = (1 - S%XSIC) * PSFZON + S%XSIC * PSFZON_ICE
+ DI%XFMU = PSFZON_ICE
+ D%XFMV = (1 - S%XSIC) * PSFMER + S%XSIC * PSFMER_ICE
+ DI%XFMV = PSFMER_ICE
!
ENDIF
!
!* total storage flux
!
-PGFLUX = PRN - PH - PLE
+D%XGFLUX = D%XRN - D%XH - D%XLE
!
!
IF (LHOOK) CALL DR_HOOK('DIAG_SURF_BUDGET_SEA',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/diag_surf_budget_teb.F90 b/src/SURFEX/diag_surf_budget_teb.F90
index 3711d7403be2e0ce9c47690e1ea4bce5a3c72952..6b383ac82c20df2890b737a4d4a36541408064d9 100644
--- a/src/SURFEX/diag_surf_budget_teb.F90
+++ b/src/SURFEX/diag_surf_budget_teb.F90
@@ -3,9 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_SURF_BUDGET_TEB (PDIR_SW, PSCA_SW, PDIR_ALB, PSCA_ALB, &
- PLW, PEMIS, PTRAD, &
- PSWD, PSWU, PSWBD, PSWBU, PLWD, PLWU )
+ SUBROUTINE DIAG_SURF_BUDGET_TEB (D, PDIR_SW, PSCA_SW, PDIR_ALB, PSCA_ALB, &
+ PLW, PEMIS, PTRAD )
! ###############################################################################
!
!!**** *DIAG_SURF_BUDGET_TEB * - Computes diagnostics over TEB
@@ -29,13 +28,10 @@
!! Original 04/2006
!!------------------------------------------------------------------
!
-
-!
+USE MODD_DIAG_n, ONLY : DIAG_t
!
USE MODD_CSTS, ONLY : XSTEFAN
!
-!
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -43,6 +39,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(DIAG_t), INTENT(INOUT) :: D
+!
REAL, DIMENSION(:,:),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.)
! ! (W/m2)
REAL, DIMENSION(:,:),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.)
@@ -51,16 +49,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PLW ! longwave radiation (on horizonta
REAL, DIMENSION(:), INTENT(IN) :: PTRAD ! radiative temperature (K)
REAL, DIMENSION(:,:),INTENT(IN) :: PDIR_ALB ! direct albedo for each spectral band (-)
REAL, DIMENSION(:,:),INTENT(IN) :: PSCA_ALB ! diffuse albedo for each spectral band (-)
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS ! emissivity (-)
-!
-REAL, DIMENSION(:,:), INTENT(OUT):: PSWBD ! incoming short wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT):: PSWBU ! upward short wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWD ! total incoming short wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWU ! total upward short wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWD ! Downward long wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWU ! upward long wave radiation (W/m2)
-!
-
+REAL, DIMENSION(:), INTENT(IN) :: PEMIS ! emissivity (-)
!
!* 0.2 declarations of local variables
!
@@ -76,21 +65,22 @@ ISWB = SIZE(PDIR_SW,2)
!* total incoming and outgoing SW
!
DO JSWB=1,ISWB
- PSWBD(:,JSWB) = PDIR_SW(:,JSWB) + PSCA_SW(:,JSWB)
- PSWBU(:,JSWB) = PDIR_SW(:,JSWB) * PDIR_ALB(:,JSWB) + PSCA_SW(:,JSWB) * PSCA_ALB(:,JSWB)
+ D%XSWBD(:,JSWB) = PDIR_SW(:,JSWB) + PSCA_SW(:,JSWB)
+ D%XSWBU(:,JSWB) = PDIR_SW(:,JSWB) * PDIR_ALB(:,JSWB) + PSCA_SW(:,JSWB) * PSCA_ALB(:,JSWB)
ENDDO
!
-PSWD(:) = 0.
-PSWU(:) = 0.
+D%XSWD(:) = 0.
+D%XSWU(:) = 0.
DO JSWB=1,ISWB
- PSWD(:)=PSWD(:)+PSWBD(:,JSWB)
- PSWU(:)=PSWU(:)+PSWBU(:,JSWB)
+ D%XSWD(:)=D%XSWD(:)+D%XSWBD(:,JSWB)
+ D%XSWU(:)=D%XSWU(:)+D%XSWBU(:,JSWB)
ENDDO
!
!*incoming outgoing LW
!
-PLWD(:)=PLW(:)
-PLWU(:)=PEMIS(:)*XSTEFAN*PTRAD(:)**4 + (1.-PEMIS(:))*PLW(:)
+D%XLWD(:)=PLW(:)
+D%XLWU(:)=PEMIS(:)*XSTEFAN*PTRAD(:)**4 + (1.-PEMIS(:))*PLW(:)
+!
IF (LHOOK) CALL DR_HOOK('DIAG_SURF_BUDGET_TEB',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/diag_surf_budget_water.F90 b/src/SURFEX/diag_surf_budget_water.F90
index 458964c6c87fc4af8b2015dd2282ec0bb04d5a13..4e8b4f62b3c6a28260abd7fbb77228d69a638934 100644
--- a/src/SURFEX/diag_surf_budget_water.F90
+++ b/src/SURFEX/diag_surf_budget_water.F90
@@ -3,13 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_SURF_BUDGET_WATER (PTT, PTS, PRHOA, PSFTH, PSFTQ, &
- PDIR_SW, PSCA_SW, PLW, &
- PDIR_ALB, PSCA_ALB, PEMIS, PTRAD, &
- PSFZON, PSFMER, &
- PRN, PH, PLE, PLEI, PGFLUX, &
- PSWD, PSWU, PSWBD, PSWBU, PLWD, PLWU, &
- PFMU, PFMV, PEVAP, PSUBL )
+ SUBROUTINE DIAG_SURF_BUDGET_WATER (D, PTT, PTS, PRHOA, PSFTH, PSFTQ, PDIR_SW, PSCA_SW, PLW, &
+ PDIR_ALB, PSCA_ALB, PEMIS, PTRAD, PSFZON, PSFMER )
! ###############################################################################
!
!!**** *DIAG_SURF_BUDGET_WATER * - Computes diagnostics over water
@@ -35,8 +30,7 @@
! Ts instead of Tsrad
!!------------------------------------------------------------------
!
-
-!
+USE MODD_DIAG_n, ONLY : DIAG_t
!
USE MODD_CSTS, ONLY : XSTEFAN, XLSTT, XLVTT, XCPD
!
@@ -49,6 +43,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(DIAG_t), INTENT(INOUT) :: D
+!
REAL, INTENT(IN) :: PTT ! freezing temperature of water surface
REAL, DIMENSION(:), INTENT(IN) :: PTS ! surface temperature (K)
REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! air density
@@ -66,24 +62,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PEMIS ! emissivity
REAL, DIMENSION(:), INTENT(IN) :: PSFZON ! zonal friction
REAL, DIMENSION(:), INTENT(IN) :: PSFMER ! meridional friction
!
-REAL, DIMENSION(:), INTENT(OUT):: PRN ! net radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PH ! sensible heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PLE ! total latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PLEI ! sublimation latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PGFLUX ! storage flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PEVAP ! total evaporation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT):: PSUBL ! sublimation (kg/m2/s)
-!
-REAL, DIMENSION(:,:), INTENT(OUT):: PSWBD ! incoming short wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT):: PSWBU ! upward short wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PSWD ! total incoming short wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PSWU ! total upward short wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PLWD ! Downward long wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT):: PLWU ! upward long wave radiation (W/m2)
-!
-REAL, DIMENSION(:), INTENT(OUT):: PFMU ! zonal friction
-REAL, DIMENSION(:), INTENT(OUT):: PFMV ! meridional friction
-!
!* 0.2 declarations of local variables
!
INTEGER :: ISWB ! number of SW bands
@@ -98,53 +76,53 @@ ISWB = SIZE(PDIR_SW,2)
!* total incoming and outgoing SW
!
DO JSWB=1,ISWB
- PSWBD(:,JSWB) = PDIR_SW(:,JSWB) + PSCA_SW(:,JSWB)
- PSWBU(:,JSWB) = PDIR_SW(:,JSWB) * PDIR_ALB(:,JSWB) + PSCA_SW(:,JSWB) * PSCA_ALB(:,JSWB)
+ D%XSWBD(:,JSWB) = PDIR_SW(:,JSWB) + PSCA_SW(:,JSWB)
+ D%XSWBU(:,JSWB) = PDIR_SW(:,JSWB) * PDIR_ALB(:,JSWB) + PSCA_SW(:,JSWB) * PSCA_ALB(:,JSWB)
ENDDO
!
-PSWD(:) = 0.
-PSWU(:) = 0.
+D%XSWD(:) = 0.
+D%XSWU(:) = 0.
DO JSWB=1,ISWB
- PSWD(:)=PSWD(:)+PSWBD(:,JSWB)
- PSWU(:)=PSWU(:)+PSWBU(:,JSWB)
+ D%XSWD(:)=D%XSWD(:)+D%XSWBD(:,JSWB)
+ D%XSWU(:)=D%XSWU(:)+D%XSWBU(:,JSWB)
ENDDO
!
!*incoming outgoing LW
!
-PLWD(:)=PLW(:)
-PLWU(:)=PEMIS(:)*XSTEFAN*PTRAD(:)**4 + (1.-PEMIS(:))*PLW(:)
+D%XLWD(:) = PLW(:)
+D%XLWU(:) = PEMIS(:)*XSTEFAN*PTRAD(:)**4 + (1.-PEMIS(:))*PLW(:)
!
!* net radiation
!
-PRN = PSWD(:) - PSWU(:) + PLWD(:) - PLWU(:)
+D%XRN = D%XSWD(:) - D%XSWU(:) + D%XLWD(:) - D%XLWU(:)
!
!* sensible heat flux
!
-PH = PSFTH(:)
+D%XH = PSFTH(:)
!
!* latent heat flux
!
WHERE (PTS<PTT )
- PLE = PSFTQ * XLSTT
- PLEI = PSFTQ * XLSTT
- PEVAP = PSFTQ
- PSUBL = PSFTQ
+ D%XLE = PSFTQ * XLSTT
+ D%XLEI = PSFTQ * XLSTT
+ D%XEVAP = PSFTQ
+ D%XSUBL = PSFTQ
ELSEWHERE
- PLE = PSFTQ * XLVTT
- PLEI = 0.0
- PEVAP = PSFTQ
- PSUBL = 0.0
+ D%XLE = PSFTQ * XLVTT
+ D%XLEI = 0.0
+ D%XEVAP = PSFTQ
+ D%XSUBL = 0.0
END WHERE
!
!* storage flux
!
-PGFLUX = PRN - PH - PLE
+D%XGFLUX = D%XRN - D%XH - D%XLE
!
!* wind stress
!
-PFMU = PSFZON
+D%XFMU = PSFZON
!
-PFMV = PSFMER
+D%XFMV = PSFMER
IF (LHOOK) CALL DR_HOOK('DIAG_SURF_BUDGET_WATER',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/diag_surf_budgetc.F90 b/src/SURFEX/diag_surf_budgetc.F90
new file mode 100644
index 0000000000000000000000000000000000000000..91ed9dda039d1056edd8b63245bf09be228de718
--- /dev/null
+++ b/src/SURFEX/diag_surf_budgetc.F90
@@ -0,0 +1,100 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE DIAG_SURF_BUDGETC (D, DC, PTSTEP, ONOTICE)
+! #########################################################################
+!
+!!**** *DIAG_SURF_BUDGETC * - Computes cumulated diagnostics
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! B. Decharme
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 08/2009
+!!------------------------------------------------------------------
+!
+USE MODD_DIAG_n, ONLY : DIAG_t
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+!
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
+!
+REAL, INTENT(IN) :: PTSTEP
+!
+LOGICAL, INTENT(IN) :: ONOTICE
+!
+!* 0.2 declarations of local variables
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------------
+!
+!* total incoming and outgoing SW
+!
+IF (LHOOK) CALL DR_HOOK('DIAG_SURF_BUDGETC_FLAKE',0,ZHOOK_HANDLE)
+!
+IF (ONOTICE) DC%XSWD(:) = DC%XSWD(:) + D%XSWD(:) * PTSTEP
+DC%XSWU(:) = DC%XSWU(:) + D%XSWU(:) * PTSTEP
+!
+!*incoming outgoing LW
+!
+IF (ONOTICE) DC%XLWD(:) = DC%XLWD(:) + D%XLWD(:) * PTSTEP
+DC%XLWU(:) = DC%XLWU(:) + D%XLWU(:) * PTSTEP
+!
+!* net radiation
+!
+DC%XRN(:) = DC%XRN(:) + D%XRN(:) * PTSTEP
+!
+!* sensible heat flux
+!
+DC%XH(:) = DC%XH(:) + D%XH(:) * PTSTEP
+!
+IF (ONOTICE) THEN
+ !
+ !* latent heat flux
+ !
+ DC%XLE (:) = DC%XLE (:) + D%XLE (:) * PTSTEP
+ DC%XLEI(:) = DC%XLEI(:) + D%XLEI(:) * PTSTEP
+ !
+ !* evaporation and sublimation (kg/m2)
+ !
+ DC%XEVAP(:) = DC%XEVAP(:) + D%XEVAP(:) * PTSTEP
+ DC%XSUBL(:) = DC%XSUBL(:) + D%XSUBL(:) * PTSTEP
+ !
+ENDIF
+!
+!* storage flux
+!
+DC%XGFLUX(:) = DC%XGFLUX(:) + D%XGFLUX(:) * PTSTEP
+!
+!* wind stress
+!
+DC%XFMU(:) = DC%XFMU(:) + D%XFMU(:) * PTSTEP
+DC%XFMV(:) = DC%XFMV(:) + D%XFMV(:) * PTSTEP
+!
+IF (LHOOK) CALL DR_HOOK('DIAG_SURF_BUDGETC',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------------
+!
+END SUBROUTINE DIAG_SURF_BUDGETC
diff --git a/src/SURFEX/diag_surf_budgetc_flake.F90 b/src/SURFEX/diag_surf_budgetc_flake.F90
deleted file mode 100644
index 87f980f409562c079e1aa514c219f40a77ab7392..0000000000000000000000000000000000000000
--- a/src/SURFEX/diag_surf_budgetc_flake.F90
+++ /dev/null
@@ -1,110 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE DIAG_SURF_BUDGETC_FLAKE (DGF, &
- PTSTEP, PRN, PH, PLE, PLEI, PGFLUX, &
- PSWD, PSWU, PLWD, PLWU, PFMU, PFMV,&
- PEVAP, PSUBL )
-! #########################################################################
-!
-!!**** *DIAG_SURF_BUDGETC_FLAKE * - Computes cumulated diagnostics over water
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! B. Decharme
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 08/2009
-!!------------------------------------------------------------------
-!
-!
-!
-!
-USE MODD_DIAG_FLAKE_n, ONLY : DIAG_FLAKE_t
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(DIAG_FLAKE_t), INTENT(INOUT) :: DGF
-!
-REAL, INTENT(IN) :: PTSTEP
-REAL, DIMENSION(:), INTENT(IN) :: PRN ! net radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PH ! sensible heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PLE ! total latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PLEI ! sublimation latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PGFLUX ! storage flux (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PEVAP ! total evaporation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(IN) :: PSUBL ! sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(IN) :: PSWD ! total incoming short wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PSWU ! total upward short wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PLWD ! Downward long wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PLWU ! upward long wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PFMU ! zonal wind stress
-REAL, DIMENSION(:), INTENT(IN) :: PFMV ! meridian wind stress
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!* 0.2 declarations of local variables
-!
-!-------------------------------------------------------------------------------------
-!
-!* total incoming and outgoing SW
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_SURF_BUDGETC_FLAKE',0,ZHOOK_HANDLE)
-DGF%XSWDC(:) = DGF%XSWDC(:) + PSWD(:) * PTSTEP
-DGF%XSWUC(:) = DGF%XSWUC(:) + PSWU(:) * PTSTEP
-!
-!*incoming outgoing LW
-!
-DGF%XLWDC(:) = DGF%XLWDC(:) + PLWD(:) * PTSTEP
-DGF%XLWUC(:) = DGF%XLWUC(:) + PLWU(:) * PTSTEP
-!
-!* net radiation
-!
-DGF%XRNC(:) = DGF%XRNC(:) + PRN(:) * PTSTEP
-!
-!* sensible heat flux
-!
-DGF%XHC(:) = DGF%XHC(:) + PH(:) * PTSTEP
-!
-!* latent heat flux
-!
-DGF%XLEC (:) = DGF%XLEC (:) + PLE (:) * PTSTEP
-DGF%XLEIC(:) = DGF%XLEIC(:) + PLEI(:) * PTSTEP
-!
-!* evaporation and sublimation (kg/m2)
-!
-DGF%XEVAPC(:) = DGF%XEVAPC(:) + PEVAP(:) * PTSTEP
-DGF%XSUBLC(:) = DGF%XSUBLC(:) + PSUBL(:) * PTSTEP
-!
-!* storage flux
-!
-DGF%XGFLUXC(:) = DGF%XGFLUXC(:) + PGFLUX(:) * PTSTEP
-!
-!* wind stress
-!
-DGF%XFMUC(:) = DGF%XFMUC(:) + PFMU(:) * PTSTEP
-DGF%XFMVC(:) = DGF%XFMVC(:) + PFMV(:) * PTSTEP
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_SURF_BUDGETC_FLAKE',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE DIAG_SURF_BUDGETC_FLAKE
diff --git a/src/SURFEX/diag_surf_budgetc_ideal.F90 b/src/SURFEX/diag_surf_budgetc_ideal.F90
deleted file mode 100644
index 256286da0093df0ebf797e14c0b8bd239be30c0b..0000000000000000000000000000000000000000
--- a/src/SURFEX/diag_surf_budgetc_ideal.F90
+++ /dev/null
@@ -1,105 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE DIAG_SURF_BUDGETC_IDEAL(DGL, PTSTEP, PRN, PH, PLE, PLEI, PGFLUX, &
- PSWD, PSWU, PLWD, PLWU, PFMU, PFMV,&
- PEVAP, PSUBL )
-! #########################################################################
-!
-!!**** *DIAG_SURF_BUDGETC_IDEAL * - Computes cumulated diagnostics in IDEAL case
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! P. Le Moigne
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 03/2015
-!!------------------------------------------------------------------
-!
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-TYPE(DIAG_IDEAL_t) :: DGL
-!
-REAL, INTENT(IN) :: PTSTEP
-REAL, DIMENSION(:), INTENT(IN) :: PRN ! net radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PH ! sensible heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PLE ! total latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PLEI ! sublimation latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PGFLUX ! storage flux (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PEVAP ! total evaporation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(IN) :: PSUBL ! sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(IN) :: PSWD ! total incoming short wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PSWU ! total upward short wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PLWD ! Downward long wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PLWU ! upward long wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PFMU ! zonal wind stress
-REAL, DIMENSION(:), INTENT(IN) :: PFMV ! meridian wind stress
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!* 0.2 declarations of local variables
-!
-!-------------------------------------------------------------------------------------
-!
-!* total incoming and outgoing SW
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_SURF_BUDGETC_IDEAL',0,ZHOOK_HANDLE)
-DGL%XSWDC(:) = DGL%XSWDC(:) + PSWD(:) * PTSTEP
-DGL%XSWUC(:) = DGL%XSWUC(:) + PSWU(:) * PTSTEP
-!
-!*incoming outgoing LW
-!
-DGL%XLWDC(:) = DGL%XLWDC(:) + PLWD(:) * PTSTEP
-DGL%XLWUC(:) = DGL%XLWUC(:) + PLWU(:) * PTSTEP
-!
-!* net radiation
-!
-DGL%XRNC(:) = DGL%XRNC(:) + PRN(:) * PTSTEP
-!
-!* sensible heat flux
-!
-DGL%XHC(:) = DGL%XHC(:) + PH(:) * PTSTEP
-!
-!* latent heat flux
-!
-DGL%XLEC (:) = DGL%XLEC (:) + PLE (:) * PTSTEP
-DGL%XLEIC(:) = DGL%XLEIC(:) + PLEI(:) * PTSTEP
-!
-!* evaporation and sublimation (kg/m2)
-!
-DGL%XEVAPC(:) = DGL%XEVAPC(:) + PEVAP(:) * PTSTEP
-DGL%XSUBLC(:) = DGL%XSUBLC(:) + PSUBL(:) * PTSTEP
-!
-!* storage flux
-!
-DGL%XGFLUXC(:) = DGL%XGFLUXC(:) + PGFLUX(:) * PTSTEP
-!
-!* wind stress
-!
-DGL%XFMUC(:) = DGL%XFMUC(:) + PFMU(:) * PTSTEP
-DGL%XFMVC(:) = DGL%XFMVC(:) + PFMV(:) * PTSTEP
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_SURF_BUDGETC_IDEAL',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE DIAG_SURF_BUDGETC_IDEAL
diff --git a/src/SURFEX/diag_surf_budgetc_sea.F90 b/src/SURFEX/diag_surf_budgetc_sea.F90
deleted file mode 100644
index 4f8b2afaae893bb56c0bf0debe967f4d4aed79bc..0000000000000000000000000000000000000000
--- a/src/SURFEX/diag_surf_budgetc_sea.F90
+++ /dev/null
@@ -1,155 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE DIAG_SURF_BUDGETC_SEA (DGS, &
- PTSTEP, PRN, PH, PLE, PLE_ICE, PGFLUX,&
- PSWD, PSWU, PLWD, PLWU, PFMU, PFMV, &
- PEVAP, PSUBL, OHANDLE_SIC, &
- PRN_ICE, PH_ICE, PGFLUX_ICE, &
- PSWU_ICE, PLWU_ICE, PFMU_ICE, PFMV_ICE)
-! ########################################################################
-!
-!!**** *DIAG_SURF_BUDGETC_SEA * - Computes cumulated diagnostics over sea
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! B. Decharme
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 08/2009
-!! S.Senesi 01/2014 Add fluxes on seaice
-!!------------------------------------------------------------------
-!
-!
-!
-!
-USE MODD_DIAG_SEAFLUX_n, ONLY : DIAG_SEAFLUX_t
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(DIAG_SEAFLUX_t), INTENT(INOUT) :: DGS
-!
-REAL, INTENT(IN) :: PTSTEP
-REAL, DIMENSION(:), INTENT(IN) :: PRN ! net radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PH ! sensible heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PLE ! total latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PLE_ICE ! sublimation latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PGFLUX ! storage flux (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PEVAP ! total evaporation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(IN) :: PSUBL ! sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(IN) :: PSWD ! total incoming short wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PSWU ! total upward short wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PLWD ! Downward long wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PLWU ! upward long wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PFMU ! zonal wind stress
-REAL, DIMENSION(:), INTENT(IN) :: PFMV ! meridian wind stress
-!
-LOGICAL, INTENT(IN) :: OHANDLE_SIC ! Do we weight seaice and open sea fluxes
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRN_ICE ! net radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PH_ICE ! sensible heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PGFLUX_ICE!storage flux (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PSWU_ICE ! total upward short wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PLWU_ICE ! upward long wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PFMU_ICE ! zonal wind stress
-REAL, DIMENSION(:), INTENT(IN) :: PFMV_ICE ! meridian wind stress
-!
-!
-!* 0.2 declarations of local variables
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_SURF_BUDGETC_SEA',0,ZHOOK_HANDLE)
-!
-!* total incoming and outgoing SW
-!
-DGS%XSWDC(:) = DGS%XSWDC(:) + PSWD(:) * PTSTEP
-DGS%XSWUC(:) = DGS%XSWUC(:) + PSWU(:) * PTSTEP
-!
-!*incoming outgoing LW
-!
-DGS%XLWDC(:) = DGS%XLWDC(:) + PLWD(:) * PTSTEP
-DGS%XLWUC(:) = DGS%XLWUC(:) + PLWU(:) * PTSTEP
-!
-!* net radiation
-!
-DGS%XRNC(:) = DGS%XRNC(:) + PRN(:) * PTSTEP
-!
-!* sensible heat flux
-!
-DGS%XHC(:) = DGS%XHC(:) + PH(:) * PTSTEP
-!
-!* latent heat flux (J/m2)
-!
-DGS%XLEC (:) = DGS%XLEC (:) + PLE (:) * PTSTEP
-DGS%XLEC_ICE(:) = DGS%XLEC_ICE(:) + PLE_ICE(:) * PTSTEP
-!
-!* evaporation and sublimation (kg/m2)
-!
-DGS%XEVAPC(:) = DGS%XEVAPC(:) + PEVAP(:) * PTSTEP
-DGS%XSUBLC(:) = DGS%XSUBLC(:) + PSUBL(:) * PTSTEP
-!
-!* storage flux
-!
-DGS%XGFLUXC(:) = DGS%XGFLUXC(:) + PGFLUX(:) * PTSTEP
-!
-!* wind stress
-!
-DGS%XFMUC(:) = DGS%XFMUC(:) + PFMU(:) * PTSTEP
-DGS%XFMVC(:) = DGS%XFMVC(:) + PFMV(:) * PTSTEP
-!
-IF (OHANDLE_SIC) THEN
-!
-!* total incoming and outgoing SW
-!
- DGS%XSWUC_ICE(:) = DGS%XSWUC_ICE(:) + PSWU_ICE(:) * PTSTEP
-!
-!*incoming outgoing LW
-!
- DGS%XLWUC_ICE(:) = DGS%XLWUC_ICE(:) + PLWU_ICE(:) * PTSTEP
-!
-!* net radiation
-!
- DGS%XRNC_ICE(:) = DGS%XRNC_ICE(:) + PRN_ICE(:) * PTSTEP
-!
-!* sensible heat flux
-!
- DGS%XHC_ICE(:) = DGS%XHC_ICE(:) + PH_ICE(:) * PTSTEP
-!
-!* storage flux
-!
- DGS%XGFLUXC_ICE(:) = DGS%XGFLUXC_ICE(:) + PGFLUX_ICE(:) * PTSTEP
-!
-!* wind stress
-!
- DGS%XFMUC_ICE(:) = DGS%XFMUC_ICE(:) + PFMU_ICE(:) * PTSTEP
- DGS%XFMVC_ICE(:) = DGS%XFMVC_ICE(:) + PFMV_ICE(:) * PTSTEP
-!
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_SURF_BUDGETC_SEA',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE DIAG_SURF_BUDGETC_SEA
diff --git a/src/SURFEX/diag_surf_budgetc_water.F90 b/src/SURFEX/diag_surf_budgetc_water.F90
deleted file mode 100644
index 33aaab92979ffed4671aa3ad08e19c59a025557e..0000000000000000000000000000000000000000
--- a/src/SURFEX/diag_surf_budgetc_water.F90
+++ /dev/null
@@ -1,110 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE DIAG_SURF_BUDGETC_WATER (DGW, &
- PTSTEP, PRN, PH, PLE, PLEI, PGFLUX, &
- PSWD, PSWU, PLWD, PLWU, PFMU, PFMV,&
- PEVAP, PSUBL )
-! #########################################################################
-!
-!!**** *DIAG_SURF_BUDGETC_WATER * - Computes cumulated diagnostics over water
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! B. Decharme
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 08/2009
-!!------------------------------------------------------------------
-!
-!
-!
-!
-USE MODD_DIAG_WATFLUX_n, ONLY : DIAG_WATFLUX_t
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(DIAG_WATFLUX_t), INTENT(INOUT) :: DGW
-!
-REAL, INTENT(IN) :: PTSTEP
-REAL, DIMENSION(:), INTENT(IN) :: PRN ! net radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PH ! sensible heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PLE ! total latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PLEI ! sublimation latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PGFLUX ! storage flux (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PEVAP ! total evaporation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(IN) :: PSUBL ! sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(IN) :: PSWD ! total incoming short wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PSWU ! total upward short wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PLWD ! Downward long wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PLWU ! upward long wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PFMU ! zonal wind stress
-REAL, DIMENSION(:), INTENT(IN) :: PFMV ! meridian wind stress
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!* 0.2 declarations of local variables
-!
-!-------------------------------------------------------------------------------------
-!
-!* total incoming and outgoing SW
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_SURF_BUDGETC_WATER',0,ZHOOK_HANDLE)
-DGW%XSWDC(:) = DGW%XSWDC(:) + PSWD(:) * PTSTEP
-DGW%XSWUC(:) = DGW%XSWUC(:) + PSWU(:) * PTSTEP
-!
-!*incoming outgoing LW
-!
-DGW%XLWDC(:) = DGW%XLWDC(:) + PLWD(:) * PTSTEP
-DGW%XLWUC(:) = DGW%XLWUC(:) + PLWU(:) * PTSTEP
-!
-!* net radiation
-!
-DGW%XRNC(:) = DGW%XRNC(:) + PRN(:) * PTSTEP
-!
-!* sensible heat flux
-!
-DGW%XHC(:) = DGW%XHC(:) + PH(:) * PTSTEP
-!
-!* latent heat flux (J/m2)
-!
-DGW%XLEC (:) = DGW%XLEC (:) + PLE (:) * PTSTEP
-DGW%XLEIC(:) = DGW%XLEIC(:) + PLEI(:) * PTSTEP
-!
-!* evaporation and sublimation (kg/m2)
-!
-DGW%XEVAPC(:) = DGW%XEVAPC(:) + PEVAP(:) * PTSTEP
-DGW%XSUBLC(:) = DGW%XSUBLC(:) + PSUBL(:) * PTSTEP
-!
-!* storage flux
-!
-DGW%XGFLUXC(:) = DGW%XGFLUXC(:) + PGFLUX(:) * PTSTEP
-!
-!* wind stress
-!
-DGW%XFMUC(:) = DGW%XFMUC(:) + PFMU(:) * PTSTEP
-DGW%XFMVC(:) = DGW%XFMVC(:) + PFMV(:) * PTSTEP
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_SURF_BUDGETC_WATER',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE DIAG_SURF_BUDGETC_WATER
diff --git a/src/SURFEX/diag_teb_garden_initn.F90 b/src/SURFEX/diag_teb_garden_initn.F90
deleted file mode 100644
index b903c518469a522e9ee3fdc0cca07bad796e7839..0000000000000000000000000000000000000000
--- a/src/SURFEX/diag_teb_garden_initn.F90
+++ /dev/null
@@ -1,302 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE DIAG_TEB_GARDEN_INIT_n (DGMTO, DGGD, TGD, TGDO, TGDP, TVG, &
- HPROGRAM,KLU,KSW)
-! #####################
-!
-!!**** *DIAG_TEB_GARDEN_INIT_n* - routine to initialize TEB-ISBA diagnostic variables
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 02/2003
-!! modified 11/2003 by P. LeMoigne: surface cumulated energy budget
-!! modified 10/2004 by P. LeMoigne: surface miscellaneous fields
-!! B. Decharme 2008 New diag for water budget and allow to reset
-! cumulatives variables at the beginning of a run
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE MODD_DIAG_MISC_TEB_OPTION_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
-USE MODD_DIAG_TEB_GARDEN_n, ONLY : DIAG_TEB_GARDEN_t
-USE MODD_TEB_GARDEN_n, ONLY : TEB_GARDEN_t
-USE MODD_TEB_GARDEN_OPTION_n, ONLY : TEB_GARDEN_OPTIONS_t
-USE MODD_TEB_GARDEN_PGD_n, ONLY : TEB_GARDEN_PGD_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_TYPE_DATE_SURF
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
-!
-TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: DGMTO
-TYPE(DIAG_TEB_GARDEN_t), INTENT(INOUT) :: DGGD
-TYPE(TEB_GARDEN_t), INTENT(INOUT) :: TGD
-TYPE(TEB_GARDEN_OPTIONS_t), INTENT(INOUT) :: TGDO
-TYPE(TEB_GARDEN_PGD_t), INTENT(INOUT) :: TGDP
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
-!
-INTEGER, INTENT(IN) :: KLU ! size of arrays
-INTEGER, INTENT(IN) :: KSW ! spectral bands
- CHARACTER(LEN=6), INTENT(IN):: HPROGRAM ! program calling
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-INTEGER :: IRESP ! IRESP : return-code if a problem appears
- CHARACTER(LEN=LEN_HREC) :: YREC ! Name of the article to be read
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_TEB_GARDEN_INIT_N',0,ZHOOK_HANDLE)
-!
-ALLOCATE(DGGD%XRI (KLU))
-!
-DGGD%XRI = XUNDEF
-!
-ALLOCATE(DGGD%XCD (KLU))
-ALLOCATE(DGGD%XCH (KLU))
-ALLOCATE(DGGD%XRN (KLU))
-ALLOCATE(DGGD%XH (KLU))
-ALLOCATE(DGGD%XGFLUX (KLU))
-ALLOCATE(DGGD%XQS (KLU))
-!
-DGGD%XCD = XUNDEF
-DGGD%XCH = XUNDEF
-DGGD%XRN = XUNDEF
-DGGD%XH = XUNDEF
-DGGD%XGFLUX = XUNDEF
-DGGD%XQS = XUNDEF
-!
-ALLOCATE(DGGD%XLEI (KLU))
-ALLOCATE(DGGD%XLEG (KLU))
-ALLOCATE(DGGD%XLEGI (KLU))
-ALLOCATE(DGGD%XLEV (KLU))
-ALLOCATE(DGGD%XLES (KLU))
-ALLOCATE(DGGD%XLER (KLU))
-ALLOCATE(DGGD%XLETR (KLU))
-ALLOCATE(DGGD%XEVAP (KLU))
-ALLOCATE(DGGD%XDRAIN (KLU))
-ALLOCATE(DGGD%XRUNOFF (KLU))
-ALLOCATE(DGGD%XHORT (KLU))
-ALLOCATE(DGGD%XDRIP (KLU))
-ALLOCATE(DGGD%XRRVEG (KLU))
-ALLOCATE(DGGD%XMELT (KLU))
-ALLOCATE(DGGD%XIRRIG_FLUX(KLU))
-!
-DGGD%XLEI = XUNDEF
-DGGD%XLEG = XUNDEF
-DGGD%XLEGI = XUNDEF
-DGGD%XLEV = XUNDEF
-DGGD%XLES = XUNDEF
-DGGD%XLER = XUNDEF
-DGGD%XLETR = XUNDEF
-DGGD%XEVAP = XUNDEF
-DGGD%XDRAIN = XUNDEF
-DGGD%XRUNOFF = XUNDEF
-DGGD%XHORT = XUNDEF
-DGGD%XDRIP = XUNDEF
-DGGD%XRRVEG = XUNDEF
-DGGD%XMELT = XUNDEF
-DGGD%XIRRIG_FLUX = XUNDEF
-!
-ALLOCATE(DGGD%XCG (KLU))
-ALLOCATE(DGGD%XC1 (KLU))
-ALLOCATE(DGGD%XC2 (KLU))
-ALLOCATE(DGGD%XWGEQ (KLU))
-ALLOCATE(DGGD%XCT (KLU))
-ALLOCATE(DGGD%XRS (KLU))
-ALLOCATE(DGGD%XCDN (KLU))
-ALLOCATE(DGGD%XHU (KLU))
-ALLOCATE(DGGD%XHUG (KLU))
-ALLOCATE(DGGD%XRESTORE(KLU))
-ALLOCATE(DGGD%XUSTAR (KLU))
-IF (TVG%CPHOTO/='NON') THEN
- ALLOCATE(DGGD%XIACAN (KLU,SIZE(TGDP%XABC) ))
-ELSE
- ALLOCATE(DGGD%XIACAN (0,0))
-END IF
-!
-DGGD%XCG = XUNDEF
-DGGD%XC1 = XUNDEF
-DGGD%XC2 = XUNDEF
-DGGD%XWGEQ = XUNDEF
-DGGD%XCT = XUNDEF
-DGGD%XRS = XUNDEF
-DGGD%XCDN = XUNDEF
-DGGD%XHU = XUNDEF
-DGGD%XHUG = XUNDEF
-DGGD%XRESTORE = XUNDEF
-DGGD%XUSTAR = XUNDEF
-IF (TVG%CPHOTO/='NON') THEN
- DGGD%XIACAN = XUNDEF
-END IF
-!
-ALLOCATE(DGGD%XSNOWTEMP(KLU,TGD%CUR%TSNOW%NLAYER ))
-ALLOCATE(DGGD%XSNOWLIQ (KLU,TGD%CUR%TSNOW%NLAYER ))
-ALLOCATE(DGGD%XSNOWDZ (KLU,TGD%CUR%TSNOW%NLAYER ))
-ALLOCATE(DGGD%XSNOWHMASS(KLU))
-ALLOCATE(DGGD%XMELTADV (KLU))
-!
-DGGD%XSNOWTEMP = XUNDEF
-DGGD%XSNOWLIQ = XUNDEF
-DGGD%XSNOWDZ = XUNDEF
-DGGD%XSNOWHMASS = XUNDEF
-DGGD%XMELTADV = XUNDEF
-!
-ALLOCATE(DGGD%XHV (KLU))
-ALLOCATE(DGGD%XALBT (KLU))
-ALLOCATE(DGGD%XEMIST (KLU))
-!
-DGGD%XHV = XUNDEF
-DGGD%XALBT = XUNDEF
-DGGD%XEMIST = XUNDEF
-!
-ALLOCATE(DGGD%XFAPAR (KLU))
-ALLOCATE(DGGD%XFAPIR (KLU))
-ALLOCATE(DGGD%XFAPAR_BS (KLU))
-ALLOCATE(DGGD%XFAPIR_BS (KLU))
-ALLOCATE(DGGD%XDFAPARC (KLU))
-ALLOCATE(DGGD%XDFAPIRC (KLU))
-ALLOCATE(DGGD%XDLAI_EFFC(KLU))
-!
-DGGD%XFAPAR = XUNDEF
-DGGD%XFAPIR = XUNDEF
-DGGD%XFAPAR_BS = XUNDEF
-DGGD%XFAPIR_BS = XUNDEF
-DGGD%XDFAPARC = XUNDEF
-DGGD%XDFAPIRC = XUNDEF
-DGGD%XDLAI_EFFC = XUNDEF
-!
-!* surface energy budget
-!
-!IF (LSURF_BUDGET) THEN
- !
- ALLOCATE(DGGD%XSWD (KLU))
- ALLOCATE(DGGD%XSWU (KLU))
- ALLOCATE(DGGD%XSWBD (KLU,KSW))
- ALLOCATE(DGGD%XSWBU (KLU,KSW))
- ALLOCATE(DGGD%XLWD (KLU))
- ALLOCATE(DGGD%XLWU (KLU))
- ALLOCATE(DGGD%XFMU (KLU))
- ALLOCATE(DGGD%XFMV (KLU))
- !
- DGGD%XSWD = XUNDEF
- DGGD%XSWU = XUNDEF
- DGGD%XSWBD = XUNDEF
- DGGD%XSWBU = XUNDEF
- DGGD%XLWD = XUNDEF
- DGGD%XLWU = XUNDEF
- DGGD%XFMU = XUNDEF
- DGGD%XFMV = XUNDEF
- !
-!END IF
-!
-!* surface temperature and parameters at 2m
-!
-ALLOCATE(DGGD%XTS (KLU))
-DGGD%XTS = XUNDEF
-ALLOCATE(DGGD%XTSRAD (KLU))
-DGGD%XTSRAD = XUNDEF
-!
-!* miscellaneous surface fields
-!
-IF (DGMTO%LSURF_MISC_BUDGET) THEN
- ALLOCATE(DGGD%XSWI (KLU,TGDO%NGROUND_LAYER))
- ALLOCATE(DGGD%XTSWI (KLU,TGDO%NGROUND_LAYER))
- ALLOCATE(DGGD%XTWSNOW (KLU))
- ALLOCATE(DGGD%XTDSNOW (KLU))
- DGGD%XSWI = XUNDEF
- DGGD%XTSWI = XUNDEF
- DGGD%XTWSNOW = XUNDEF
- DGGD%XTDSNOW = XUNDEF
-ELSE
- ALLOCATE(DGGD%XSWI (0,0))
- ALLOCATE(DGGD%XTSWI (0,0))
- ALLOCATE(DGGD%XTWSNOW (0))
- ALLOCATE(DGGD%XTDSNOW (0))
-ENDIF
-!
-ALLOCATE(DGGD%XALBT (KLU))
-ALLOCATE(DGGD%XGPP (KLU))
-ALLOCATE(DGGD%XRESP_AUTO (KLU))
-ALLOCATE(DGGD%XRESP_ECO (KLU))
-!
-DGGD%XALBT = XUNDEF
-DGGD%XGPP = XUNDEF
-DGGD%XRESP_AUTO = XUNDEF
-DGGD%XRESP_ECO = XUNDEF
-!
-!END IF
-!
-!* transfer coefficients
-!
-!IF (LCOEF) THEN
- !
- ALLOCATE(DGGD%XCE (KLU))
- ALLOCATE(DGGD%XZ0_WITH_SNOW (KLU))
- ALLOCATE(DGGD%XZ0H_WITH_SNOW (KLU))
- ALLOCATE(DGGD%XZ0EFF (KLU))
- !
- DGGD%XCE = XUNDEF
- DGGD%XZ0_WITH_SNOW = XUNDEF
- DGGD%XZ0H_WITH_SNOW = XUNDEF
- DGGD%XZ0EFF = XUNDEF
-!END IF
-!
-!
-!* surface humidity
-!
-!IF (LSURF_VARS) THEN
- ALLOCATE(DGGD%XQS (KLU))
- !
- DGGD%XQS = XUNDEF
-!END IF
-!
-!* Irrigation threshold
-!
-!IF (LAGRIP) THEN
- ALLOCATE(DGGD%XSEUIL(KLU))
- !
- DGGD%XSEUIL = XUNDEF
-!END IF
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_TEB_GARDEN_INIT_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE DIAG_TEB_GARDEN_INIT_n
diff --git a/src/SURFEX/diag_teb_greenroof_initn.F90 b/src/SURFEX/diag_teb_greenroof_initn.F90
deleted file mode 100644
index 9300d54c2b2d1e0963fbcd314d98c041611123e6..0000000000000000000000000000000000000000
--- a/src/SURFEX/diag_teb_greenroof_initn.F90
+++ /dev/null
@@ -1,215 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE DIAG_TEB_GREENROOF_INIT_n (DGMTO, DGGR, TGRO, TVG, &
- HPROGRAM,KLU,KSW)
-! #####################
-!
-!!**** *DIAG_TEB_GREENROOF_INIT_n* - routine to initialize TEB-ISBA diagnostic variables
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!! Based on diag_teb_garden_initn
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 02/2003
-!! modified 11/2003 by P. LeMoigne: surface cumulated energy budget
-!! modified 10/2004 by P. LeMoigne: surface miscellaneous fields
-!! B. Decharme 2008 New diag for water budget and allow to reset
-!! cumulatives variables at the beginning of a run
-! C. de Munck & A. Lemonsu 09/2011 Greenroofs
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE MODD_DIAG_MISC_TEB_OPTION_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
-USE MODD_DIAG_TEB_GREENROOF_n, ONLY : DIAG_TEB_GREENROOF_t
-USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_TYPE_DATE_SURF
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
-!
-TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: DGMTO
-TYPE(DIAG_TEB_GREENROOF_t), INTENT(INOUT) :: DGGR
-TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: TGRO
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
-!
-INTEGER, INTENT(IN) :: KLU ! size of arrays
-INTEGER, INTENT(IN) :: KSW ! spectral bands
- CHARACTER(LEN=6), INTENT(IN):: HPROGRAM ! program calling
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-INTEGER :: IRESP ! IRESP : return-code if a problem appears
- CHARACTER(LEN=LEN_HREC) :: YREC ! Name of the article to be read
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_TEB_GREENROOF_INIT_N',0,ZHOOK_HANDLE)
-DGGR%XCG = XUNDEF
-DGGR%XC1 = XUNDEF
-DGGR%XC2 = XUNDEF
-DGGR%XWGEQ = XUNDEF
-DGGR%XCT = XUNDEF
-DGGR%XRS = XUNDEF
-DGGR%XHU = XUNDEF
-DGGR%XHUG = XUNDEF
-DGGR%XHV = XUNDEF
-DGGR%XRESTORE = XUNDEF
-DGGR%XRI = XUNDEF
-DGGR%XUSTAR = XUNDEF
-DGGR%XRN = XUNDEF
-DGGR%XH = XUNDEF
-DGGR%XGFLUX = XUNDEF
-DGGR%XSNOWTEMP = XUNDEF
-DGGR%XSNOWLIQ = XUNDEF
-DGGR%XSNOWDZ = XUNDEF
-DGGR%XSNOWHMASS = XUNDEF
-DGGR%XMELTADV = XUNDEF
-IF (TVG%CPHOTO/='NON') THEN
- DGGR%XIACAN = XUNDEF
-END IF
-DGGR%XCD = XUNDEF
-DGGR%XCDN = XUNDEF
-DGGR%XCH = XUNDEF
-DGGR%XQS = XUNDEF
-DGGR%XLEI = XUNDEF
-DGGR%XLEG = XUNDEF
-DGGR%XLEGI = XUNDEF
-DGGR%XLEV = XUNDEF
-DGGR%XLES = XUNDEF
-DGGR%XLER = XUNDEF
-DGGR%XLETR = XUNDEF
-DGGR%XEVAP = XUNDEF
-DGGR%XDRAIN = XUNDEF
-DGGR%XRUNOFF = XUNDEF
-DGGR%XHORT = XUNDEF
-DGGR%XDRIP = XUNDEF
-DGGR%XRRVEG = XUNDEF
-DGGR%XMELT = XUNDEF
-DGGR%XALBT = XUNDEF
-DGGR%XEMIST = XUNDEF
-!
-!* surface energy budget
-!
-!IF (LSURF_BUDGET) THEN
- !
- ALLOCATE(DGGR%XSWD (KLU))
- ALLOCATE(DGGR%XSWU (KLU))
- ALLOCATE(DGGR%XSWBD (KLU,KSW))
- ALLOCATE(DGGR%XSWBU (KLU,KSW))
- ALLOCATE(DGGR%XLWD (KLU))
- ALLOCATE(DGGR%XLWU (KLU))
- ALLOCATE(DGGR%XFMU (KLU))
- ALLOCATE(DGGR%XFMV (KLU))
- !
- DGGR%XSWD = XUNDEF
- DGGR%XSWU = XUNDEF
- DGGR%XSWBD = XUNDEF
- DGGR%XSWBU = XUNDEF
- DGGR%XLWD = XUNDEF
- DGGR%XLWU = XUNDEF
- DGGR%XFMU = XUNDEF
- DGGR%XFMV = XUNDEF
- !
-!END IF
-!
-!* surface temperature and parameters at 2m
-!
-ALLOCATE(DGGR%XTS (KLU))
-DGGR%XTS = XUNDEF
-ALLOCATE(DGGR%XTSRAD (KLU))
-DGGR%XTSRAD = XUNDEF
-!
-!* miscellaneous surface fields
-!
-IF (DGMTO%LSURF_MISC_BUDGET) THEN
- !
- ALLOCATE(DGGR%XSWI (KLU,TGRO%NLAYER_GR))
- ALLOCATE(DGGR%XTSWI (KLU,TGRO%NLAYER_GR))
- ALLOCATE(DGGR%XTWSNOW (KLU))
- ALLOCATE(DGGR%XTDSNOW (KLU))
- DGGR%XSWI = XUNDEF
- DGGR%XTSWI = XUNDEF
- DGGR%XTWSNOW = XUNDEF
- DGGR%XTDSNOW = XUNDEF
-ENDIF
-
-
- ALLOCATE(DGGR%XALBT (KLU))
- ALLOCATE(DGGR%XGPP (KLU))
- ALLOCATE(DGGR%XRESP_AUTO (KLU))
- ALLOCATE(DGGR%XRESP_ECO (KLU))
- !
- DGGR%XALBT = XUNDEF
- DGGR%XGPP = XUNDEF
- DGGR%XRESP_AUTO = XUNDEF
- DGGR%XRESP_ECO = XUNDEF
- !
-!END IF
-!
-!* transfer coefficients
-!
-!IF (LCOEF) THEN
- !
- ALLOCATE(DGGR%XCE (KLU))
- ALLOCATE(DGGR%XZ0_WITH_SNOW (KLU))
- ALLOCATE(DGGR%XZ0H_WITH_SNOW (KLU))
- ALLOCATE(DGGR%XZ0EFF (KLU))
- !
- DGGR%XCE = XUNDEF
- DGGR%XZ0_WITH_SNOW = XUNDEF
- DGGR%XZ0H_WITH_SNOW = XUNDEF
- DGGR%XZ0EFF = XUNDEF
-!END IF
-!
-!
-!* surface humidity
-!
-!IF (LSURF_VARS) THEN
- ALLOCATE(DGGR%XQS (KLU))
- !
- DGGR%XQS = XUNDEF
-!END IF
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_TEB_GREENROOF_INIT_N',1,ZHOOK_HANDLE)
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE DIAG_TEB_GREENROOF_INIT_n
diff --git a/src/SURFEX/diag_teb_initn.F90 b/src/SURFEX/diag_teb_initn.F90
index b80ee886286f90c6a1bd74881cc8040b6f29b3d4..c4e28cf92dd6d4a9552432b87e6da17c6369e26b 100644
--- a/src/SURFEX/diag_teb_initn.F90
+++ b/src/SURFEX/diag_teb_initn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_TEB_INIT_n (DGT, DGUT, &
- HPROGRAM,KLU,KSW)
+ SUBROUTINE DIAG_TEB_INIT_n (DGO, D, DUT, HPROGRAM,KLU,KSW)
! #####################
!
!!**** *DIAG_TEB_INIT_n* - routine to initialize TEB diagnostic variables
@@ -40,8 +39,9 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODE_DIAG
!
-USE MODD_DIAG_TEB_n, ONLY : DIAG_TEB_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
USE MODD_DIAG_UTCI_TEB_n, ONLY : DIAG_UTCI_TEB_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -61,9 +61,9 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-TYPE(DIAG_TEB_t), INTENT(INOUT) :: DGT
-TYPE(DIAG_UTCI_TEB_t), INTENT(INOUT) :: DGUT
+TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_UTCI_TEB_t), INTENT(INOUT) :: DUT
!
INTEGER, INTENT(IN) :: KLU ! size of arrays
INTEGER, INTENT(IN) :: KSW ! spectral bands
@@ -82,161 +82,48 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('DIAG_TEB_INIT_N',0,ZHOOK_HANDLE)
!
-ALLOCATE(DGT%XDIAG_TS(KLU))
-DGT%XDIAG_TS = XUNDEF
-!
-IF (DGT%LSURF_BUDGET) THEN
- ALLOCATE(DGT%XRN (KLU))
- ALLOCATE(DGT%XH (KLU))
- ALLOCATE(DGT%XLE (KLU))
- ALLOCATE(DGT%XGFLUX (KLU))
- ALLOCATE(DGT%XSWD (KLU))
- ALLOCATE(DGT%XSWU (KLU))
- ALLOCATE(DGT%XSWBD (KLU,KSW))
- ALLOCATE(DGT%XSWBU (KLU,KSW))
- ALLOCATE(DGT%XLWD (KLU))
- ALLOCATE(DGT%XLWU (KLU))
- ALLOCATE(DGT%XFMU (KLU))
- ALLOCATE(DGT%XFMV (KLU))
- ALLOCATE(DGT%XSFCO2 (KLU))
- !
- DGT%XRN = XUNDEF
- DGT%XH = XUNDEF
- DGT%XLE = XUNDEF
- DGT%XGFLUX = XUNDEF
- DGT%XSWD = XUNDEF
- DGT%XSWU = XUNDEF
- DGT%XSWBD = XUNDEF
- DGT%XSWBU = XUNDEF
- DGT%XLWD = XUNDEF
- DGT%XLWU = XUNDEF
- DGT%XFMU = XUNDEF
- DGT%XFMV = XUNDEF
- DGT%XSFCO2 = XUNDEF
-ELSE
- ALLOCATE(DGT%XRN (0))
- ALLOCATE(DGT%XH (0))
- ALLOCATE(DGT%XLE (0))
- ALLOCATE(DGT%XGFLUX (0))
- ALLOCATE(DGT%XSWD (0))
- ALLOCATE(DGT%XSWU (0))
- ALLOCATE(DGT%XSWBD (0,0))
- ALLOCATE(DGT%XSWBU (0,0))
- ALLOCATE(DGT%XLWD (0))
- ALLOCATE(DGT%XLWU (0))
- ALLOCATE(DGT%XFMU (0))
- ALLOCATE(DGT%XFMV (0))
- ALLOCATE(DGT%XSFCO2 (0))
-END IF
+ CALL ALLOC_BUD(DGO,D,KLU,KSW)
!
-!* parameters at 2m
-!
-IF (DGT%N2M>=1) THEN
- ALLOCATE(DGT%XRI (KLU))
- ALLOCATE(DGT%XT2M (KLU))
- ALLOCATE(DGT%XT2M_MIN (KLU))
- ALLOCATE(DGT%XT2M_MAX (KLU))
- ALLOCATE(DGT%XQ2M (KLU))
- ALLOCATE(DGT%XHU2M (KLU))
- ALLOCATE(DGT%XHU2M_MIN(KLU))
- ALLOCATE(DGT%XHU2M_MAX(KLU))
- ALLOCATE(DGT%XZON10M (KLU))
- ALLOCATE(DGT%XMER10M (KLU))
- ALLOCATE(DGT%XWIND10M (KLU))
- ALLOCATE(DGT%XWIND10M_MAX(KLU))
- !
- DGT%XRI = XUNDEF
- DGT%XT2M = XUNDEF
- DGT%XT2M_MIN = XUNDEF
- DGT%XT2M_MAX = -XUNDEF
- DGT%XQ2M = XUNDEF
- DGT%XHU2M = XUNDEF
- DGT%XHU2M_MIN= XUNDEF
- DGT%XHU2M_MAX=-XUNDEF
- DGT%XZON10M = XUNDEF
- DGT%XMER10M = XUNDEF
- DGT%XWIND10M = XUNDEF
- DGT%XWIND10M_MAX = -XUNDEF
+IF (DGO%LSURF_BUDGET) THEN
+ ALLOCATE(D%XSFCO2(KLU))
+ D%XSFCO2 = XUNDEF
ELSE
- ALLOCATE(DGT%XRI (0))
- ALLOCATE(DGT%XT2M (0))
- ALLOCATE(DGT%XT2M_MIN (0))
- ALLOCATE(DGT%XT2M_MAX (0))
- ALLOCATE(DGT%XQ2M (0))
- ALLOCATE(DGT%XHU2M (0))
- ALLOCATE(DGT%XHU2M_MIN(0))
- ALLOCATE(DGT%XHU2M_MAX(0))
- ALLOCATE(DGT%XZON10M (0))
- ALLOCATE(DGT%XMER10M (0))
- ALLOCATE(DGT%XWIND10M (0))
- ALLOCATE(DGT%XWIND10M_MAX(0))
+ ALLOCATE(D%XSFCO2(0))
END IF
-!!
+!
!* miscellaneous fields
!
-IF (DGT%N2M>0 .AND. DGUT%LUTCI) THEN
+IF (DGO%N2M>0 .AND. DUT%LUTCI) THEN
!
- ALLOCATE(DGUT%XUTCI_IN (KLU))
- ALLOCATE(DGUT%XUTCI_OUTSUN (KLU))
- ALLOCATE(DGUT%XUTCI_OUTSHADE (KLU))
- ALLOCATE(DGUT%XTRAD_SUN (KLU))
- ALLOCATE(DGUT%XTRAD_SHADE (KLU))
- ALLOCATE(DGUT%XUTCIC_IN (KLU,NUTCI_STRESS))
- ALLOCATE(DGUT%XUTCIC_OUTSUN (KLU,NUTCI_STRESS))
- ALLOCATE(DGUT%XUTCIC_OUTSHADE(KLU,NUTCI_STRESS))
+ ALLOCATE(DUT%XUTCI_IN (KLU))
+ ALLOCATE(DUT%XUTCI_OUTSUN (KLU))
+ ALLOCATE(DUT%XUTCI_OUTSHADE (KLU))
+ ALLOCATE(DUT%XTRAD_SUN (KLU))
+ ALLOCATE(DUT%XTRAD_SHADE (KLU))
+ ALLOCATE(DUT%XUTCIC_IN (KLU,NUTCI_STRESS))
+ ALLOCATE(DUT%XUTCIC_OUTSUN (KLU,NUTCI_STRESS))
+ ALLOCATE(DUT%XUTCIC_OUTSHADE(KLU,NUTCI_STRESS))
!
- DGUT%XUTCI_IN = XUNDEF
- DGUT%XUTCI_OUTSUN = XUNDEF
- DGUT%XUTCI_OUTSHADE = XUNDEF
- DGUT%XTRAD_SUN = XUNDEF
- DGUT%XTRAD_SHADE = XUNDEF
- DGUT%XUTCIC_IN = 0.
- DGUT%XUTCIC_OUTSUN = 0.
- DGUT%XUTCIC_OUTSHADE = 0.
+ DUT%XUTCI_IN = XUNDEF
+ DUT%XUTCI_OUTSUN = XUNDEF
+ DUT%XUTCI_OUTSHADE = XUNDEF
+ DUT%XTRAD_SUN = XUNDEF
+ DUT%XTRAD_SHADE = XUNDEF
+ DUT%XUTCIC_IN = 0.
+ DUT%XUTCIC_OUTSUN = 0.
+ DUT%XUTCIC_OUTSHADE = 0.
!
ELSE
- ALLOCATE(DGUT%XUTCI_IN (0))
- ALLOCATE(DGUT%XUTCI_OUTSUN (0))
- ALLOCATE(DGUT%XUTCI_OUTSHADE (0))
- ALLOCATE(DGUT%XTRAD_SUN (0))
- ALLOCATE(DGUT%XTRAD_SHADE (0))
- ALLOCATE(DGUT%XUTCIC_IN (0,0))
- ALLOCATE(DGUT%XUTCIC_OUTSUN (0,0))
- ALLOCATE(DGUT%XUTCIC_OUTSHADE(0,0))
+ ALLOCATE(DUT%XUTCI_IN (0))
+ ALLOCATE(DUT%XUTCI_OUTSUN (0))
+ ALLOCATE(DUT%XUTCI_OUTSHADE (0))
+ ALLOCATE(DUT%XTRAD_SUN (0))
+ ALLOCATE(DUT%XTRAD_SHADE (0))
+ ALLOCATE(DUT%XUTCIC_IN (0,0))
+ ALLOCATE(DUT%XUTCIC_OUTSUN (0,0))
+ ALLOCATE(DUT%XUTCIC_OUTSHADE(0,0))
ENDIF
!
-!* transfer coefficients
-!
-IF (DGT%LCOEF) THEN
- ALLOCATE(DGT%XCD (KLU))
- ALLOCATE(DGT%XCH (KLU))
- ALLOCATE(DGT%XCE (KLU))
- ALLOCATE(DGT%XZ0 (KLU))
- ALLOCATE(DGT%XZ0H (KLU))
- !
- DGT%XCD = XUNDEF
- DGT%XCH = XUNDEF
- DGT%XCE = XUNDEF
- DGT%XZ0 = XUNDEF
- DGT%XZ0H = XUNDEF
-ELSE
- ALLOCATE(DGT%XCD (0))
- ALLOCATE(DGT%XCH (0))
- ALLOCATE(DGT%XCE (0))
- ALLOCATE(DGT%XZ0 (0))
- ALLOCATE(DGT%XZ0H (0))
-END IF
-!
-!
-!* surface humidity
-!
-IF (DGT%LSURF_VARS) THEN
- ALLOCATE(DGT%XQS (KLU))
- !
- DGT%XQS = XUNDEF
-ELSE
- ALLOCATE(DGT%XQS (0))
-END IF
IF (LHOOK) CALL DR_HOOK('DIAG_TEB_INIT_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/diag_teb_veg_initn.F90 b/src/SURFEX/diag_teb_veg_initn.F90
new file mode 100644
index 0000000000000000000000000000000000000000..88749bef0b841a4b2f420a3e51533f57c497f68c
--- /dev/null
+++ b/src/SURFEX/diag_teb_veg_initn.F90
@@ -0,0 +1,253 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE DIAG_TEB_VEG_INIT_n(DK, DEK, DECK, DMK, KLU, KSNOW_LAYER)
+ ! #####################
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE MODE_DIAG
+!
+USE MODD_DIAG_n, ONLY : DIAG_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+TYPE(DIAG_t), INTENT(INOUT) :: DK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DECK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK
+INTEGER, INTENT(IN) :: KLU
+INTEGER, INTENT(IN) :: KSNOW_LAYER
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('DIAG_TEB_VEG_INIT',0,ZHOOK_HANDLE)
+!
+! Main diag
+!
+!general
+ALLOCATE(DK%XRN (KLU))
+ALLOCATE(DK%XH (KLU))
+ALLOCATE(DK%XLE (KLU))
+ALLOCATE(DK%XLEI (KLU))
+ALLOCATE(DK%XGFLUX(KLU))
+ALLOCATE(DK%XEVAP (KLU))
+ALLOCATE(DK%XSUBL (KLU))
+!
+DK%XRN (:) = XUNDEF
+DK%XH (:) = XUNDEF
+DK%XLE (:) = XUNDEF
+DK%XLEI (:) = XUNDEF
+DK%XGFLUX(:) = XUNDEF
+DK%XEVAP (:) = XUNDEF
+DK%XSUBL (:) = XUNDEF
+!
+!
+ALLOCATE(DK%XRI(KLU))
+!
+DK%XRI(:) = XUNDEF
+!
+!
+ALLOCATE(DK%XCD (KLU))
+ALLOCATE(DK%XCH (KLU))
+ALLOCATE(DK%XZ0 (KLU))
+ALLOCATE(DK%XZ0H(KLU))
+!
+DK%XCD (:) = XUNDEF
+DK%XCH (:) = XUNDEF
+DK%XZ0 (:) = XUNDEF
+DK%XZ0H(:) = XUNDEF
+!
+!
+ALLOCATE(DK%XZ0EFF(KLU))
+ALLOCATE(DK%XCDN (KLU))
+ALLOCATE(DK%XHUG (KLU))
+ALLOCATE(DK%XHU (KLU))
+ALLOCATE(DK%XQS (KLU))
+!
+DK%XZ0EFF(:) = XUNDEF
+DK%XCDN (:) = XUNDEF
+DK%XHUG (:) = XUNDEF
+DK%XHU (:) = XUNDEF
+DK%XQS (:) = XUNDEF
+!
+!
+ALLOCATE(DK%XTS (KLU))
+ALLOCATE(DK%XTSRAD(KLU))
+ALLOCATE(DK%XALBT (KLU))
+!
+DK%XTS (:) = XUNDEF
+DK%XTSRAD(:) = XUNDEF
+DK%XALBT (:) = XUNDEF
+!
+!---------------------------
+!
+! Evaporation diag
+!
+! general
+ALLOCATE(DEK%XLEG (KLU))
+ALLOCATE(DEK%XLEGI(KLU))
+ALLOCATE(DEK%XLEV (KLU))
+ALLOCATE(DEK%XLES (KLU))
+ALLOCATE(DEK%XLESL(KLU))
+ALLOCATE(DEK%XLER (KLU))
+ALLOCATE(DEK%XLETR(KLU))
+!
+DEK%XLEG (:) = XUNDEF
+DEK%XLEGI(:) = XUNDEF
+DEK%XLEV (:) = XUNDEF
+DEK%XLES (:) = XUNDEF
+DEK%XLESL(:) = XUNDEF
+DEK%XLER (:) = XUNDEF
+DEK%XLETR(:) = XUNDEF
+!
+!
+ALLOCATE(DEK%XDRAIN (KLU))
+ALLOCATE(DEK%XRUNOFF(KLU))
+ALLOCATE(DEK%XHORT (KLU))
+ALLOCATE(DEK%XQSB (KLU))
+ALLOCATE(DEK%XIRRIG_FLUX(KLU))
+!
+DEK%XDRAIN (:) = XUNDEF
+DEK%XRUNOFF(:) = XUNDEF
+DEK%XHORT (:) = XUNDEF
+DEK%XQSB (:) = XUNDEF
+DEK%XIRRIG_FLUX(:) = XUNDEF
+!
+!
+ALLOCATE(DEK%XDRIP (KLU))
+ALLOCATE(DEK%XRRVEG(KLU))
+!
+DEK%XDRIP (:) = XUNDEF
+DEK%XRRVEG(:) = XUNDEF
+!
+!
+ALLOCATE(DEK%XMELT (KLU))
+ALLOCATE(DEK%XMELTADV (KLU))
+ALLOCATE(DEK%XRESTORE (KLU))
+ALLOCATE(DEK%XSNDRIFT (KLU))
+ALLOCATE(DEK%XSWNET_N (KLU))
+ALLOCATE(DEK%XSWNET_NS(KLU))
+ALLOCATE(DEK%XLWNET_N (KLU))
+!
+DEK%XMELT (:) = XUNDEF
+DEK%XMELTADV (:) = XUNDEF
+DEK%XRESTORE (:) = XUNDEF
+DEK%XSNDRIFT (:) = XUNDEF
+DEK%XSWNET_N (:) = XUNDEF
+DEK%XSWNET_NS(:) = XUNDEF
+DEK%XLWNET_N (:) = XUNDEF
+!
+!
+ALLOCATE(DEK%XLE_FLOOD (KLU))
+ALLOCATE(DEK%XLEI_FLOOD(KLU))
+ALLOCATE(DEK%XPFLOOD (KLU))
+ALLOCATE(DEK%XIFLOOD (KLU))
+!
+DEK%XLE_FLOOD (:) = XUNDEF
+DEK%XLEI_FLOOD(:) = XUNDEF
+DEK%XPFLOOD (:) = XUNDEF
+DEK%XIFLOOD (:) = XUNDEF
+!
+!
+ALLOCATE(DEK%XGPP (KLU))
+ALLOCATE(DEK%XRESP_ECO (KLU))
+ALLOCATE(DEK%XRESP_AUTO(KLU))
+!
+DEK%XGPP (:) = XUNDEF
+DEK%XRESP_ECO (:) = XUNDEF
+DEK%XRESP_AUTO(:) = XUNDEF
+!
+!
+ALLOCATE(DEK%XRN_SN_FR (KLU))
+ALLOCATE(DEK%XH_SN_FR (KLU))
+ALLOCATE(DEK%XLEI_SN_FR (KLU))
+ALLOCATE(DEK%XLE_SN_FR (KLU))
+ALLOCATE(DEK%XGFLUX_SN_FR(KLU))
+ALLOCATE(DEK%XLEG_SN_FR (KLU))
+ALLOCATE(DEK%XLEGI_SN_FR (KLU))
+ALLOCATE(DEK%XLEV_SN_FR (KLU))
+ALLOCATE(DEK%XLETR_SN_FR (KLU))
+ALLOCATE(DEK%XUSTAR_SN_FR(KLU))
+ALLOCATE(DEK%XLER_SN_FR (KLU))
+!
+DEK%XRN_SN_FR (:) = XUNDEF
+DEK%XH_SN_FR (:) = XUNDEF
+DEK%XLEI_SN_FR (:) = XUNDEF
+DEK%XLE_SN_FR (:) = XUNDEF
+DEK%XGFLUX_SN_FR(:) = XUNDEF
+DEK%XLEG_SN_FR (:) = XUNDEF
+DEK%XLEGI_SN_FR (:) = XUNDEF
+DEK%XLEV_SN_FR (:) = XUNDEF
+DEK%XLETR_SN_FR (:) = XUNDEF
+DEK%XUSTAR_SN_FR(:) = XUNDEF
+DEK%XLER_SN_FR (:) = XUNDEF
+!
+!
+ALLOCATE(DECK%XDRAIN (KLU))
+ALLOCATE(DECK%XRUNOFF(KLU))
+!
+DECK%XDRAIN (:) = 0.
+DECK%XRUNOFF(:) = 0.
+!
+!--------------------------------------
+!
+! Misc diag
+!
+ALLOCATE(DMK%XC1 (KLU))
+ALLOCATE(DMK%XC2 (KLU))
+ALLOCATE(DMK%XWGEQ(KLU))
+ALLOCATE(DMK%XCG (KLU))
+ALLOCATE(DMK%XCT (KLU))
+ALLOCATE(DMK%XRS (KLU))
+ALLOCATE(DMK%XHV (KLU))
+ALLOCATE(DMK%XGRNDFLUX (KLU))
+ALLOCATE(DMK%XSNOWTEMP (KLU,KSNOW_LAYER))
+ALLOCATE(DMK%XSNOWHMASS(KLU))
+ALLOCATE(DMK%XSNOWLIQ (KLU,KSNOW_LAYER))
+ALLOCATE(DMK%XSNOWDZ (KLU,KSNOW_LAYER))
+ALLOCATE(DMK%XSRSFC (KLU))
+ALLOCATE(DMK%XRRSFC (KLU))
+ALLOCATE(DMK%XRNSNOW (KLU))
+ALLOCATE(DMK%XHSNOW (KLU))
+ALLOCATE(DMK%XGFLUXSNOW(KLU))
+ALLOCATE(DMK%XHPSNOW (KLU))
+ALLOCATE(DMK%XUSTARSNOW(KLU))
+ALLOCATE(DMK%XCDSNOW (KLU))
+ALLOCATE(DMK%XCHSNOW (KLU))
+!
+DMK%XC1 = XUNDEF
+DMK%XC2 = XUNDEF
+DMK%XWGEQ = XUNDEF
+DMK%XCG = XUNDEF
+DMK%XCT = XUNDEF
+DMK%XRS = XUNDEF
+DMK%XHV = XUNDEF
+DMK%XGRNDFLUX = XUNDEF
+DMK%XSNOWTEMP = XUNDEF
+DMK%XSNOWHMASS = XUNDEF
+DMK%XSNOWLIQ = XUNDEF
+DMK%XSNOWDZ = XUNDEF
+DMK%XSRSFC = XUNDEF
+DMK%XRRSFC = XUNDEF
+DMK%XRNSNOW = XUNDEF
+DMK%XHSNOW = XUNDEF
+DMK%XGFLUXSNOW = XUNDEF
+DMK%XHPSNOW = XUNDEF
+DMK%XUSTARSNOW = XUNDEF
+DMK%XCDSNOW = XUNDEF
+DMK%XCHSNOW = XUNDEF
+!
+! LPROSNOW = .FALSE. for GARDEN GREENROOF
+ALLOCATE(DMK%XSNOWDEND(0,0))
+!
+IF (LHOOK) CALL DR_HOOK('DIAG_TEB_VEG_INIT',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE DIAG_TEB_VEG_INIT_n
diff --git a/src/SURFEX/diag_tebn.F90 b/src/SURFEX/diag_tebn.F90
deleted file mode 100644
index 38c99143449ec03337e787666a26d8b648f2406b..0000000000000000000000000000000000000000
--- a/src/SURFEX/diag_tebn.F90
+++ /dev/null
@@ -1,143 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE DIAG_TEB_n (DGT, &
- HPROGRAM, &
- PRN, PH, PLE, PGFLUX, PRI, PCD, PCH, PCE, PQS, &
- PZ0, PZ0H, PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M, &
- PSWD, PSWU, PLWD, PLWU, PSWBD, PSWBU, PFMU, PFMV, &
- PT2M_MIN, PT2M_MAX, PHU2M_MIN, PHU2M_MAX, &
- PWIND10M, PWIND10M_MAX )
-! ###############################################################################
-!
-!!**** *DIAG_TEB_n * - diagnostics for TEB
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-! B. decharme 04/2013 : Add Ts diag
-!!------------------------------------------------------------------
-!
-!
-!
-USE MODD_DIAG_TEB_n, ONLY : DIAG_TEB_t
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(DIAG_TEB_t), INTENT(INOUT) :: DGT
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PRN ! Net radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PH ! Sensible heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLE ! Latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX ! Storage flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PRI ! Richardson number (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PCD ! drag coefficient (W/s2)
-REAL, DIMENSION(:), INTENT(OUT) :: PCH ! transf. coef heat (W/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PCE ! transf. coef vapor (W/s/K)
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0 ! rough. length wind (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PQS
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0H ! rough. length heat (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PTS ! surface temperature (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M ! temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PQ2M ! humidity at 2m (kg/kg)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M ! relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PZON10M ! zonal wind at 10m (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PMER10M ! meridian wind at 10m(m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWD ! incoming short-wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWU ! upward short-wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWD ! incoming long-wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWU ! upward long-wave radiation (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBD ! incoming short-wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBU ! upward short-wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMU ! zonal momentum flux (m2/s2)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMV ! meridian momentum flux (m2/s2)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MIN ! Minimum temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MAX ! Maximum temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MIN! Minimum relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MAX! Maximum relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M ! wind at 10m (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M_MAX! Maximum wind at 10m (m/s)
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!
-!* 0.2 declarations of local variables
-!
-!-------------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_TEB_N',0,ZHOOK_HANDLE)
-IF (DGT%LSURF_BUDGET) THEN
- PRN = DGT%XRN
- PH = DGT%XH
- PLE = DGT%XLE
- PGFLUX = DGT%XGFLUX
- PSWD = DGT%XSWD
- PSWU = DGT%XSWU
- PLWD = DGT%XLWD
- PLWU = DGT%XLWU
- PSWBD = DGT%XSWBD
- PSWBU = DGT%XSWBU
- PFMU = DGT%XFMU
- PFMV = DGT%XFMV
-END IF
-!
-IF (DGT%N2M>=1 .OR. DGT%LSURF_BUDGET) PTS = DGT%XDIAG_TS
-!
-IF (DGT%N2M>=1) THEN
- PRI = DGT%XRI
- PT2M = DGT%XT2M
- PT2M_MIN = DGT%XT2M_MIN
- PT2M_MAX = DGT%XT2M_MAX
- PQ2M = DGT%XQ2M
- PHU2M = DGT%XHU2M
- PHU2M_MIN= DGT%XHU2M_MIN
- PHU2M_MAX= DGT%XHU2M_MAX
- PZON10M = DGT%XZON10M
- PMER10M = DGT%XMER10M
- PWIND10M = DGT%XWIND10M
- PWIND10M_MAX = DGT%XWIND10M_MAX
-END IF
-!
-IF (DGT%LCOEF) THEN
- PCD = DGT%XCD
- PCH = DGT%XCH
- PCE = DGT%XCE
- PZ0 = DGT%XZ0
- PZ0H = DGT%XZ0H
-END IF
-!
-IF (DGT%LSURF_VARS) THEN
- PQS = DGT%XQS
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_TEB_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE DIAG_TEB_n
diff --git a/src/SURFEX/diag_townn.F90 b/src/SURFEX/diag_townn.F90
index facc318a55f51854095cf5767a0d94e3d55b64bc..c1274b092d62889873deb7f090013cc1a9a0d305 100644
--- a/src/SURFEX/diag_townn.F90
+++ b/src/SURFEX/diag_townn.F90
@@ -3,15 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE DIAG_TOWN_n (DGL, DGT, U, &
- HPROGRAM, &
- PRN, PH, PLE, PLEI, PGFLUX, PRI, PCD, PCH, PCE, PQS,&
- PZ0, PZ0H, PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M,&
- PSWD, PSWU, PSWBD, PSWBU, PLWD, PLWU, PFMU, PFMV, &
- PRNC, PHC, PLEC, PGFLUXC, PSWDC, PSWUC, PLWDC, &
- PLWUC, PFMUC, PFMVC, PT2M_MIN, PT2M_MAX, PLEIC, &
- PHU2M_MIN, PHU2M_MAX, PWIND10M, PWIND10M_MAX, &
- PEVAP, PEVAPC, PSUBL, PSUBLC )
+SUBROUTINE DIAG_TOWN_n (DLO, DL, DLC, TD, HTOWN, HPROGRAM, DUP, DUPC, KMASK )
! ######################################################################
!
!!**** *DIAG_TOWN_n * - Chooses the surface schemes for town diagnostics
@@ -39,21 +31,14 @@ SUBROUTINE DIAG_TOWN_n (DGL, DGT, U, &
! B. decharme 04/2013 : Add EVAP and SUBL diag
!!------------------------------------------------------------------
!
-
-!
-!
-!
+USE MODE_DIAG
!
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
-USE MODD_DIAG_TEB_n, ONLY : DIAG_TEB_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
+USE MODD_SURFEX_n, ONLY : TEB_DIAG_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_CSTS, ONLY : XTT, XLSTT, XLVTT
!
-USE MODI_DIAG_TEB_n
-USE MODI_DIAG_IDEAL_n
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -62,76 +47,30 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
-TYPE(DIAG_TEB_t), INTENT(INOUT) :: DGT
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DLO
+TYPE(DIAG_t), INTENT(INOUT) :: DL
+TYPE(DIAG_t), INTENT(INOUT) :: DLC
+TYPE(TEB_DIAG_t), INTENT(INOUT) :: TD
!
+ CHARACTER(LEN=*), INTENT(IN) :: HTOWN
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
!
-REAL, DIMENSION(:), INTENT(OUT) :: PRN ! Net radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PH ! Sensible heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLE ! Total latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEI ! Sublimation latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX ! Storage flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAP ! Total evapotranspiration (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSUBL ! Sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PRI ! Richardson number (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PCD ! drag coefficient (W/s2)
-REAL, DIMENSION(:), INTENT(OUT) :: PCH ! transf. coef heat (W/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PCE ! transf. coef vapor (W/s/K)
-REAL, DIMENSION(:), INTENT(OUT) :: PQS
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0 ! rough. length wind (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0H ! rough. length heat (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PTS ! surface temperature (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M ! temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PQ2M ! humidity at 2m (kg/kg)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M ! relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PZON10M ! zonal wind at 10m (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PMER10M ! meridian wind at 10m(m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWD ! incoming short wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWU ! outgoing short wave radiation (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBD ! incoming short wave radiation by spectral band(W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBU ! outgoing short wave radiation by spectral band(W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWD ! incoming long wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWU ! outgoing long wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMU ! zonal friction
-REAL, DIMENSION(:), INTENT(OUT) :: PFMV ! meridian friction
-REAL, DIMENSION(:), INTENT(OUT) :: PRNC ! Net radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PHC ! Sensible heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEC ! Total latent heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEIC ! Sublimation latent heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUXC ! Storage flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAPC ! Total evapotranspiration (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSUBLC ! Sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWDC ! incoming short wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWUC ! outgoing short wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWDC ! incoming long wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWUC ! outgoing long wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMUC ! zonal friction
-REAL, DIMENSION(:), INTENT(OUT) :: PFMVC ! meridian friction
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MIN ! Minimum temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MAX ! Maximum temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MIN! Minimum relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MAX! Maximum relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M ! wind at 10m (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M_MAX! Maximum wind at 10m (m/s)
+TYPE(DIAG_t), INTENT(INOUT) :: DUP
+TYPE(DIAG_t), INTENT(INOUT) :: DUPC
+!
+INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(SIZE(PRN)) :: ZDELTA
+REAL, DIMENSION(SIZE(DUP%XRN)) :: ZDELTA
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('DIAG_TOWN_N',0,ZHOOK_HANDLE)
-IF (U%CTOWN=='TEB ') THEN
- CALL DIAG_TEB_n(DGT, &
- HPROGRAM, &
- PRN, PH, PLE, PGFLUX, PRI, PCD, PCH, PCE, PQS, &
- PZ0, PZ0H, PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M,&
- PSWD, PSWU, PLWD, PLWU, PSWBD, PSWBU, PFMU, PFMV, &
- PT2M_MIN, PT2M_MAX, PHU2M_MIN, PHU2M_MAX, &
- PWIND10M, PWIND10M_MAX )
+IF (HTOWN=='TEB ') THEN
+
+ CALL DIAG(TD%O, TD%D, HPROGRAM, DUP, KMASK)
!
!!!!! important, diagd should be computed in teb !!!!!!
!
@@ -141,91 +80,30 @@ IF (U%CTOWN=='TEB ') THEN
! and SUBL (sublimation kg/m2/s) must by implemented in TEB as well as theirs cumulative values
! Not good if LCPL_ARP = TRUE in ISBA (ALARO)
!
- IF (SIZE(PLEI)>0) THEN
- PLEI (:) = XUNDEF
- PEVAP(:) = XUNDEF
- PSUBL(:) = XUNDEF
- WHERE(PLE(:)/=XUNDEF)
- ZDELTA(:) = MAX(0.0,SIGN(1.0,XTT-PTS(:)))
- PEVAP (:) = (PLE(:) * ZDELTA(:))/XLSTT + (PLE(:) * (1.0-ZDELTA(:)))/XLVTT
- PLEI (:) = PLE(:) * ZDELTA(:)
- PSUBL (:) = PLEI(:)/XLSTT
+ IF (SIZE(DUP%XLEI)>0) THEN
+ DUP%XLEI (:) = XUNDEF
+ DUP%XEVAP(:) = XUNDEF
+ DUP%XSUBL(:) = XUNDEF
+ WHERE(DUP%XLE(:)/=XUNDEF)
+ ZDELTA(:) = MAX(0.0,SIGN(1.0,XTT-DUP%XTS(:)))
+ DUP%XEVAP (:) = (DUP%XLE(:) * ZDELTA(:))/XLSTT + (DUP%XLE(:) * (1.0-ZDELTA(:)))/XLVTT
+ DUP%XLEI (:) = DUP%XLE(:) * ZDELTA(:)
+ DUP%XSUBL (:) = DUP%XLEI(:)/XLSTT
ENDWHERE
ENDIF
!
- PLEC = XUNDEF
- PLEIC = XUNDEF
- PEVAPC = XUNDEF
- PSUBLC = XUNDEF
- PRNC = XUNDEF
- PHC = XUNDEF
- PGFLUXC = XUNDEF
- PSWDC = XUNDEF
- PSWUC = XUNDEF
- PLWDC = XUNDEF
- PLWUC = XUNDEF
- PFMUC = XUNDEF
- PFMVC = XUNDEF
+ IF (TD%O%LSURF_BUDGETC) THEN
+ CALL INIT_SURF_BUD(DUPC,XUNDEF)
+ DUPC%XEVAP = XUNDEF
+ DUPC%XSUBL = XUNDEF
+ ENDIF
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
-ELSE IF (U%CTOWN=='FLUX ') THEN
- CALL DIAG_IDEAL_n(DGL, HPROGRAM, &
- PRN, PH, PLE, PLEI, PGFLUX, PRI, PCD, PCH, PCE, PQS,&
- PZ0, PZ0H, PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M,&
- PSWD, PSWU, PLWD, PLWU, PSWBD, PSWBU, PFMU, PFMV, &
- PRNC, PHC, PLEC, PGFLUXC, PSWDC, PSWUC, PLWDC, &
- PLWUC, PFMUC, PFMVC, PT2M_MIN, PT2M_MAX, PLEIC, &
- PHU2M_MIN, PHU2M_MAX, PWIND10M, PWIND10M_MAX, &
- PEVAP, PEVAPC, PSUBL, PSUBLC )
-ELSE IF (U%CTOWN=='NONE ') THEN
- PRN = XUNDEF
- PH = XUNDEF
- PLE = XUNDEF
- PLEI = XUNDEF
- PEVAP = XUNDEF
- PSUBL = XUNDEF
- PGFLUX = XUNDEF
- PRI = XUNDEF
- PCD = XUNDEF
- PCH = XUNDEF
- PCE = XUNDEF
- PQS = XUNDEF
- PZ0 = XUNDEF
- PZ0H = XUNDEF
- PTS = XUNDEF
- PT2M = XUNDEF
- PQ2M = XUNDEF
- PHU2M = XUNDEF
- PZON10M = XUNDEF
- PMER10M = XUNDEF
- PSWD = XUNDEF
- PSWU = XUNDEF
- PSWBD = XUNDEF
- PSWBU = XUNDEF
- PLWD = XUNDEF
- PLWU = XUNDEF
- PFMU = XUNDEF
- PFMV = XUNDEF
- PRNC = XUNDEF
- PHC = XUNDEF
- PLEC = XUNDEF
- PLEIC = XUNDEF
- PEVAPC = XUNDEF
- PSUBLC = XUNDEF
- PGFLUXC = XUNDEF
- PSWDC = XUNDEF
- PSWUC = XUNDEF
- PLWDC = XUNDEF
- PLWUC = XUNDEF
- PFMUC = XUNDEF
- PFMVC = XUNDEF
- PT2M_MIN = XUNDEF
- PT2M_MAX = XUNDEF
- PHU2M_MIN= XUNDEF
- PHU2M_MAX= XUNDEF
- PWIND10M = XUNDEF
- PWIND10M_MAX = XUNDEF
+ELSE IF (HTOWN=='FLUX ') THEN
+ CALL DIAG_EVAP(DLO, DL, DLC, HPROGRAM, DUP, DUPC, KMASK)
+ELSE IF (HTOWN=='NONE ') THEN
+ CALL INIT_BUD(TD%O, DUP, DUPC, XUNDEF)
END IF
IF (LHOOK) CALL DR_HOOK('DIAG_TOWN_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/diag_watflux_initn.F90 b/src/SURFEX/diag_watflux_initn.F90
index 8dd54621e389a079ae6fec32604bffc416feef44..3e1c03d6d491f8810fd9d6077e9e9c11d3b026c5 100644
--- a/src/SURFEX/diag_watflux_initn.F90
+++ b/src/SURFEX/diag_watflux_initn.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DIAG_WATFLUX_INIT_n (&
- DGU, DGW, W, &
- HPROGRAM,KLU,KSW)
+ SUBROUTINE DIAG_WATFLUX_INIT_n (OREAD_BUDGETC, DGO, D, DC, W, HPROGRAM,KLU,KSW)
! #####################
!
!!**** *DIAG_WATFLUX_INIT_n* - routine to initialize WATFLUX diagnostic variables
@@ -40,14 +38,11 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODE_DIAG
!
-!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_DIAG_WATFLUX_n, ONLY : DIAG_WATFLUX_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
USE MODD_WATFLUX_n, ONLY : WATFLUX_t
!
-!
-!
#ifdef SFX_OL
USE MODN_IO_OFFLINE, ONLY : LRESTART
#endif
@@ -67,9 +62,10 @@ IMPLICIT NONE
!
!
!
-!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(DIAG_WATFLUX_t), INTENT(INOUT) :: DGW
+LOGICAL, INTENT(IN) :: OREAD_BUDGETC
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
TYPE(WATFLUX_t), INTENT(INOUT) :: W
!
INTEGER, INTENT(IN) :: KLU ! size of arrays
@@ -90,250 +86,80 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('DIAG_WATFLUX_INIT_N',0,ZHOOK_HANDLE)
!
-ALLOCATE(DGW%XDIAG_TS(KLU))
-DGW%XDIAG_TS = XUNDEF
+ CALL ALLOC_BUD(DGO,D,KLU,KSW)
!
-IF (DGW%LSURF_BUDGET.OR.DGW%LSURF_BUDGETC) THEN
- ALLOCATE(DGW%XRN (KLU))
- ALLOCATE(DGW%XH (KLU))
- ALLOCATE(DGW%XLE (KLU))
- ALLOCATE(DGW%XLEI (KLU))
- ALLOCATE(DGW%XGFLUX (KLU))
- ALLOCATE(DGW%XEVAP (KLU))
- ALLOCATE(DGW%XSUBL (KLU))
- ALLOCATE(DGW%XSWD (KLU))
- ALLOCATE(DGW%XSWU (KLU))
- ALLOCATE(DGW%XLWD (KLU))
- ALLOCATE(DGW%XLWU (KLU))
- ALLOCATE(DGW%XSWBD (KLU,KSW))
- ALLOCATE(DGW%XSWBU (KLU,KSW))
- ALLOCATE(DGW%XFMU (KLU))
- ALLOCATE(DGW%XFMV (KLU))
+IF (DGO%LSURF_BUDGET.OR.DGO%LSURF_BUDGETC) THEN
!
- DGW%XRN = XUNDEF
- DGW%XH = XUNDEF
- DGW%XLE = XUNDEF
- DGW%XLEI = XUNDEF
- DGW%XGFLUX = XUNDEF
- DGW%XEVAP = XUNDEF
- DGW%XSUBL = XUNDEF
- DGW%XSWD = XUNDEF
- DGW%XSWU = XUNDEF
- DGW%XLWD = XUNDEF
- DGW%XLWU = XUNDEF
- DGW%XSWBD = XUNDEF
- DGW%XSWBU = XUNDEF
- DGW%XFMU = XUNDEF
- DGW%XFMV = XUNDEF
+ ALLOCATE(D%XEVAP (KLU))
+ ALLOCATE(D%XSUBL (KLU))
+ D%XEVAP = XUNDEF
+ D%XSUBL = XUNDEF
+ !
ELSE
- ALLOCATE(DGW%XRN (0))
- ALLOCATE(DGW%XH (0))
- ALLOCATE(DGW%XLE (0))
- ALLOCATE(DGW%XLEI (0))
- ALLOCATE(DGW%XGFLUX (0))
- ALLOCATE(DGW%XEVAP (0))
- ALLOCATE(DGW%XSUBL (0))
- ALLOCATE(DGW%XSWD (0))
- ALLOCATE(DGW%XSWU (0))
- ALLOCATE(DGW%XLWD (0))
- ALLOCATE(DGW%XLWU (0))
- ALLOCATE(DGW%XSWBD (0,0))
- ALLOCATE(DGW%XSWBU (0,0))
- ALLOCATE(DGW%XFMU (0))
- ALLOCATE(DGW%XFMV (0))
+ !
+ ALLOCATE(D%XEVAP (0))
+ ALLOCATE(D%XSUBL (0))
+ !
END IF
!
!* cumulative surface energy budget
!
#ifdef SFX_OL
-IF (DGW%LSURF_BUDGETC .OR. (LRESTART .AND. .NOT.DGW%LRESET_BUDGETC)) THEN
+IF (DGO%LSURF_BUDGETC .OR. (LRESTART .AND. .NOT.DGO%LRESET_BUDGETC)) THEN
#else
-IF (DGW%LSURF_BUDGETC .OR. .NOT.DGW%LRESET_BUDGETC) THEN
+IF (DGO%LSURF_BUDGETC .OR. .NOT.DGO%LRESET_BUDGETC) THEN
#endif
-!
- ALLOCATE(DGW%XRNC (KLU))
- ALLOCATE(DGW%XHC (KLU))
- ALLOCATE(DGW%XLEC (KLU))
- ALLOCATE(DGW%XLEIC (KLU))
- ALLOCATE(DGW%XGFLUXC (KLU))
- ALLOCATE(DGW%XEVAPC (KLU))
- ALLOCATE(DGW%XSUBLC (KLU))
- ALLOCATE(DGW%XSWDC (KLU))
- ALLOCATE(DGW%XSWUC (KLU))
- ALLOCATE(DGW%XLWDC (KLU))
- ALLOCATE(DGW%XLWUC (KLU))
- ALLOCATE(DGW%XFMUC (KLU))
- ALLOCATE(DGW%XFMVC (KLU))
-!
- IF (.NOT. DGU%LREAD_BUDGETC) THEN
- DGW%XRNC = 0.0
- DGW%XHC = 0.0
- DGW%XLEC = 0.0
- DGW%XLEIC = 0.0
- DGW%XGFLUXC = 0.0
- DGW%XEVAPC = 0.0
- DGW%XSUBLC = 0.0
- DGW%XSWDC = 0.0
- DGW%XSWUC = 0.0
- DGW%XLWDC = 0.0
- DGW%XLWUC = 0.0
- DGW%XFMUC = 0.0
- DGW%XFMVC = 0.0
- ELSEIF (DGU%LREAD_BUDGETC.AND.DGW%LRESET_BUDGETC) THEN
- DGW%XRNC = 0.0
- DGW%XHC = 0.0
- DGW%XLEC = 0.0
- DGW%XLEIC = 0.0
- DGW%XGFLUXC = 0.0
- DGW%XEVAPC = 0.0
- DGW%XSUBLC = 0.0
- DGW%XSWDC = 0.0
- DGW%XSWUC = 0.0
- DGW%XLWDC = 0.0
- DGW%XLWUC = 0.0
- DGW%XFMUC = 0.0
- DGW%XFMVC = 0.0
- ELSE
- YREC='RNC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGW%XRNC,IRESP)
- YREC='HC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGW%XHC ,IRESP)
- YREC='LEC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGW%XLEC,IRESP)
- YREC='LEIC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGW%XLEIC,IRESP)
- YREC='GFLUXC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGW%XGFLUXC,IRESP)
- YREC='SWDC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGW%XSWDC,IRESP)
- YREC='SWUC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGW%XSWUC,IRESP)
- YREC='LWDC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGW%XLWDC,IRESP)
- YREC='LWUC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGW%XLWUC,IRESP)
- YREC='FMUC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGW%XFMUC,IRESP)
- YREC='FMVC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGW%XFMVC,IRESP)
-!
- CALL READ_SURF(&
- HPROGRAM,'VERSION',IVERSION,IRESP)
- IF (IVERSION<8)THEN
- DGW%XEVAPC = 0.0
- DGW%XSUBLC = 0.0
- ELSE
- YREC='EVAPC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGW%XEVAPC,IRESP)
- YREC='SUBLC_WAT'
- CALL READ_SURF(&
- HPROGRAM,YREC,DGW%XSUBLC,IRESP)
- ENDIF
-!
- ENDIF
-ELSE
- ALLOCATE(DGW%XRNC (0))
- ALLOCATE(DGW%XHC (0))
- ALLOCATE(DGW%XLEC (0))
- ALLOCATE(DGW%XLEIC (0))
- ALLOCATE(DGW%XGFLUXC (0))
- ALLOCATE(DGW%XEVAPC (0))
- ALLOCATE(DGW%XSUBLC (0))
- ALLOCATE(DGW%XSWDC (0))
- ALLOCATE(DGW%XSWUC (0))
- ALLOCATE(DGW%XLWDC (0))
- ALLOCATE(DGW%XLWUC (0))
- ALLOCATE(DGW%XFMUC (0))
- ALLOCATE(DGW%XFMVC (0))
-ENDIF
-!
-!* parameters at 2m
-!
-IF (DGW%N2M>=1) THEN
- ALLOCATE(DGW%XRI (KLU))
- ALLOCATE(DGW%XT2M (KLU))
- ALLOCATE(DGW%XT2M_MIN(KLU))
- ALLOCATE(DGW%XT2M_MAX(KLU))
- ALLOCATE(DGW%XQ2M (KLU))
- ALLOCATE(DGW%XHU2M (KLU))
- ALLOCATE(DGW%XHU2M_MIN(KLU))
- ALLOCATE(DGW%XHU2M_MAX(KLU))
- ALLOCATE(DGW%XZON10M (KLU))
- ALLOCATE(DGW%XMER10M (KLU))
- ALLOCATE(DGW%XWIND10M (KLU))
- ALLOCATE(DGW%XWIND10M_MAX(KLU))
!
- DGW%XRI = XUNDEF
- DGW%XT2M = XUNDEF
- DGW%XT2M_MIN = XUNDEF
- DGW%XT2M_MAX = 0.0
- DGW%XQ2M = XUNDEF
- DGW%XHU2M = XUNDEF
- DGW%XHU2M_MIN= XUNDEF
- DGW%XHU2M_MAX=-XUNDEF
- DGW%XZON10M = XUNDEF
- DGW%XMER10M = XUNDEF
- DGW%XWIND10M = XUNDEF
- DGW%XWIND10M_MAX = 0.0
-ELSE
- ALLOCATE(DGW%XRI (0))
- ALLOCATE(DGW%XT2M (0))
- ALLOCATE(DGW%XT2M_MIN (0))
- ALLOCATE(DGW%XT2M_MAX (0))
- ALLOCATE(DGW%XQ2M (0))
- ALLOCATE(DGW%XHU2M (0))
- ALLOCATE(DGW%XHU2M_MIN(0))
- ALLOCATE(DGW%XHU2M_MAX(0))
- ALLOCATE(DGW%XZON10M (0))
- ALLOCATE(DGW%XMER10M (0))
- ALLOCATE(DGW%XWIND10M (0))
- ALLOCATE(DGW%XWIND10M_MAX(0))
-END IF
-!
-!* transfer coefficients
-!
-IF (DGW%LCOEF) THEN
- ALLOCATE(DGW%XCD (KLU))
- ALLOCATE(DGW%XCH (KLU))
- ALLOCATE(DGW%XCE (KLU))
- ALLOCATE(DGW%XZ0 (KLU))
- ALLOCATE(DGW%XZ0H (KLU))
+ CALL ALLOC_SURF_BUD(DC,KLU,KLU,KSW)
+ ALLOCATE(DC%XEVAP (KLU))
+ ALLOCATE(DC%XSUBL (KLU))
!
- DGW%XCD = XUNDEF
- DGW%XCH = XUNDEF
- DGW%XCE = XUNDEF
- DGW%XZ0 = XUNDEF
- DGW%XZ0H = XUNDEF
-ELSE
- ALLOCATE(DGW%XCD (0))
- ALLOCATE(DGW%XCH (0))
- ALLOCATE(DGW%XCE (0))
- ALLOCATE(DGW%XZ0 (0))
- ALLOCATE(DGW%XZ0H (0))
-END IF
-!
-!
-!* surface humidity
-!
-IF (DGW%LSURF_VARS) THEN
- ALLOCATE(DGW%XQS (KLU))
+ IF (.NOT. OREAD_BUDGETC .OR. OREAD_BUDGETC.AND.DGO%LRESET_BUDGETC) THEN
+ CALL INIT_SURF_BUD(DC,0.)
+ DC%XEVAP = 0.0
+ DC%XSUBL = 0.0
+ ELSE
+ YREC='RNC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XRN,IRESP)
+ YREC='HC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XH,IRESP)
+ YREC='LEC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLE,IRESP)
+ YREC='LEIC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLEI,IRESP)
+ YREC='GFLUXC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XGFLUX,IRESP)
+ YREC='SWDC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XSWD,IRESP)
+ YREC='SWUC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XSWU,IRESP)
+ YREC='LWDC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLWD,IRESP)
+ YREC='LWUC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XLWU,IRESP)
+ YREC='FMUC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XFMU,IRESP)
+ YREC='FMVC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XFMV,IRESP)
+!
+ CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
+ IF (IVERSION<8)THEN
+ DC%XEVAP = 0.0
+ DC%XSUBL = 0.0
+ ELSE
+ YREC='EVAPC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XEVAP,IRESP)
+ YREC='SUBLC_WAT'
+ CALL READ_SURF(HPROGRAM,YREC,DC%XSUBL,IRESP)
+ ENDIF
+ !
+ ENDIF
!
- DGW%XQS = XUNDEF
ELSE
- ALLOCATE(DGW%XQS (0))
-END IF
+ CALL ALLOC_SURF_BUD(DC,0,0,0)
+ ALLOCATE(DC%XEVAP (0))
+ ALLOCATE(DC%XSUBL (0))
+ENDIF
!
IF(LCPL_SEA)THEN
!
diff --git a/src/SURFEX/diag_watfluxn.F90 b/src/SURFEX/diag_watfluxn.F90
deleted file mode 100644
index 421c609d19dfe562e66b67a251a8650b78b08740..0000000000000000000000000000000000000000
--- a/src/SURFEX/diag_watfluxn.F90
+++ /dev/null
@@ -1,182 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE DIAG_WATFLUX_n (DGW, &
- HPROGRAM, &
- PRN, PH, PLE, PLEI, PGFLUX, PRI, PCD, PCH, PCE, PQS, &
- PZ0, PZ0H, PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M, &
- PSWD, PSWU, PLWD, PLWU, PSWBD, PSWBU, PFMU, PFMV, &
- PRNC, PHC, PLEC, PGFLUXC, PSWDC, PSWUC, PLWDC, &
- PLWUC, PFMUC, PFMVC, PT2M_MIN, PT2M_MAX, PLEIC, &
- PHU2M_MIN, PHU2M_MAX, PWIND10M, PWIND10M_MAX, &
- PEVAP, PEVAPC, PSUBL, PSUBLC )
-! ###############################################################################
-!
-!!**** *DIAG_WATFLUX_n * - diagnostics for lakes
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! Modified 08/2009 : cumulated diag & t2m min/max
-! B. decharme 04/2013 : Add EVAP and SUBL diag
-!!------------------------------------------------------------------
-!
-
-!
-!
-USE MODD_DIAG_WATFLUX_n, ONLY : DIAG_WATFLUX_t
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(DIAG_WATFLUX_t), INTENT(INOUT) :: DGW
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PRN ! Net radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PH ! Sensible heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLE ! Total latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEI ! Sublimation latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX ! Storage flux (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAP ! Total evapotranspiration (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSUBL ! Sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PRI ! Richardson number (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PCD ! drag coefficient (W/s2)
-REAL, DIMENSION(:), INTENT(OUT) :: PCH ! transf. coef heat (W/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PCE ! transf. coef vapor (W/s/K)
-REAL, DIMENSION(:), INTENT(OUT) :: PQS
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0 ! rough. length wind (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0H ! rough. length heat (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PTS ! surface temperature (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M ! temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PQ2M ! humidity at 2m (kg/kg)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M ! relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PZON10M ! zonal wind at 10m (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PMER10M ! meridian wind at 10m(m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWD ! incoming short-wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWU ! upward short-wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWD ! incoming long-wave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWU ! upward long-wave radiation (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBD ! incoming short-wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBU ! upward short-wave radiation by spectral band (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMU ! zonal momentum flux (Pa)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMV ! meridian momentum flux (Pa)
-REAL, DIMENSION(:), INTENT(OUT) :: PRNC ! Net radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PHC ! Sensible heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEC ! Total latent heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEIC ! Sublimation latent heat flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUXC ! Storage flux (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAPC ! Total evapotranspiration (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSUBLC ! Sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWDC ! incoming short wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWUC ! outgoing short wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWDC ! incoming long wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PLWUC ! outgoing long wave radiation (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PFMUC ! zonal friction
-REAL, DIMENSION(:), INTENT(OUT) :: PFMVC ! meridian friction
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MIN ! Minimum temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MAX ! Maximum temperature at 2m (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MIN! Minimum relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MAX! Maximum relative humidity at 2m (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M ! wind at 10m (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M_MAX! Maximum wind at 10m (m/s)
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!
-!* 0.2 declarations of local variables
-!
-!-------------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_WATFLUX_N',0,ZHOOK_HANDLE)
-IF (DGW%LSURF_BUDGET) THEN
- PRN = DGW%XRN
- PH = DGW%XH
- PLE = DGW%XLE
- PLEI = DGW%XLEI
- PGFLUX = DGW%XGFLUX
- PEVAP = DGW%XEVAP
- PSUBL = DGW%XSUBL
- PSWD = DGW%XSWD
- PSWU = DGW%XSWU
- PLWD = DGW%XLWD
- PLWU = DGW%XLWU
- PSWBD = DGW%XSWBD
- PSWBU = DGW%XSWBU
- PFMU = DGW%XFMU
- PFMV = DGW%XFMV
-END IF
-!
-IF (DGW%LSURF_BUDGETC) THEN
- PRNC = DGW%XRNC
- PHC = DGW%XHC
- PLEC = DGW%XLEC
- PLEIC = DGW%XLEIC
- PGFLUXC = DGW%XGFLUXC
- PEVAPC = DGW%XEVAPC
- PSUBLC = DGW%XSUBLC
- PSWDC = DGW%XSWDC
- PSWUC = DGW%XSWUC
- PLWDC = DGW%XLWDC
- PLWUC = DGW%XLWUC
- PFMUC = DGW%XFMUC
- PFMVC = DGW%XFMVC
-END IF
-!
-IF (DGW%N2M>=1 .OR. DGW%LSURF_BUDGET .OR. DGW%LSURF_BUDGETC) PTS = DGW%XDIAG_TS
-!
-IF (DGW%N2M>=1) THEN
- PRI = DGW%XRI
- PT2M = DGW%XT2M
- PT2M_MIN = DGW%XT2M_MIN
- PT2M_MAX = DGW%XT2M_MAX
- PQ2M = DGW%XQ2M
- PHU2M = DGW%XHU2M
- PHU2M_MIN= DGW%XHU2M_MIN
- PHU2M_MAX= DGW%XHU2M_MAX
- PZON10M = DGW%XZON10M
- PMER10M = DGW%XMER10M
- PWIND10M = DGW%XWIND10M
- PWIND10M_MAX = DGW%XWIND10M_MAX
-END IF
-!
-IF (DGW%LCOEF) THEN
- PCD = DGW%XCD
- PCH = DGW%XCH
- PCE = DGW%XCE
- PZ0 = DGW%XZ0
- PZ0H = DGW%XZ0H
-END IF
-!
-IF (DGW%LSURF_VARS) THEN
- PQS = DGW%XQS
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('DIAG_WATFLUX_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE DIAG_WATFLUX_n
diff --git a/src/SURFEX/dif_layer.F90 b/src/SURFEX/dif_layer.F90
index 75666b6cfb0e72e62fc7e15f0c6befbdcb330361..10669c7b915def24e3213afd52d591eaa1353219 100644
--- a/src/SURFEX/dif_layer.F90
+++ b/src/SURFEX/dif_layer.F90
@@ -3,10 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#############################################################
-SUBROUTINE DIF_LAYER(KLU, KGROUND_LAYER, KPATCH, KSIZE_NATURE_P, &
- PPATCH, PDG, PDROOT, PDG2, PROOTFRAC, &
- KWG_LAYER, PDZG, PDZDIF, PSOILWGHT, &
- PRUNOFFD, KLAYER_HORT, KLAYER_DUN )
+SUBROUTINE DIF_LAYER(KLU, IO, PK, OMEB_3L )
!#############################################################
!
!!**** *DIF_LAYER_n* - routine to initialize dif numbers of layers
@@ -40,6 +37,9 @@ SUBROUTINE DIF_LAYER(KLU, KGROUND_LAYER, KPATCH, KSIZE_NATURE_P, &
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_P_t
+!
USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
USE MODD_SGH_PAR, ONLY : XHORT_DEPTH
!
@@ -54,28 +54,18 @@ IMPLICIT NONE
! -------------------------
!
INTEGER, INTENT(IN) :: KLU
-INTEGER, INTENT(IN) :: KGROUND_LAYER
-INTEGER, INTENT(IN) :: KPATCH
-INTEGER, DIMENSION(:), INTENT(IN) :: KSIZE_NATURE_P
-REAL, DIMENSION(:,:), INTENT(IN) :: PPATCH
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDG
-REAL, DIMENSION(:,:), INTENT(IN) :: PDROOT
-REAL, DIMENSION(:,:), INTENT(IN) :: PDG2
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PROOTFRAC
-INTEGER, DIMENSION(:,:),INTENT(IN) :: KWG_LAYER
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDZG
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDZDIF
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSOILWGHT
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRUNOFFD
-INTEGER, INTENT(OUT) :: KLAYER_HORT
-INTEGER, INTENT(OUT) :: KLAYER_DUN
+!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+LOGICAL, INTENT(IN), OPTIONAL :: OMEB_3L
!
!* 0.2 Declarations of local variables
! -------------------------------
!
REAL, DIMENSION(KLU) :: ZWORK
-INTEGER, DIMENSION(KLU,KPATCH) :: IWORK
-INTEGER :: JLAYER, JPATCH, JILU, IDEPTH
+INTEGER, DIMENSION(KLU) :: IWORK
+INTEGER :: JL, JI, IDEPTH
+LOGICAL :: GMEB_3L
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -85,104 +75,103 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('DIF_LAYER',0,ZHOOK_HANDLE)
!
-DO JLAYER = 1, KGROUND_LAYER
- IF (ANY((PROOTFRAC(:,JLAYER,:)<0. .OR. PROOTFRAC(:,JLAYER,:)>1.) .AND. PPATCH(:,:).NE.0.)) &
- CALL ABOR1_SFX('DIF_LAYER: WITH CISBA=DIF ROOTFRAC MUST BE DEFINED')
-ENDDO
-!
-PDZG (:,:,:) = XUNDEF
-PDZDIF (:,:,:) = XUNDEF
-PSOILWGHT(:,:,:) = 0.0
-!
-DO JPATCH=1,KPATCH
+GMEB_3L = .FALSE.
+IF (PRESENT(OMEB_3L)) GMEB_3L = OMEB_3L
!
- IF (KSIZE_NATURE_P(JPATCH) == 0 ) CYCLE
+PK%XDZG (:,:) = XUNDEF
!
!* soil layers thicknesses
- PDZG(:,1,JPATCH) = PDG(:,1,JPATCH)
- DO JLAYER=2,KGROUND_LAYER
- DO JILU=1,KLU
- PDZG(JILU,JLAYER,JPATCH) = PDG(JILU,JLAYER,JPATCH) - PDG(JILU,JLAYER-1,JPATCH)
- ENDDO
+PK%XDZG(:,1) = PK%XDG(:,1)
+DO JL=2,IO%NGROUND_LAYER
+ DO JI=1,KLU
+ PK%XDZG(JI,JL) = PK%XDG(JI,JL) - PK%XDG(JI,JL-1)
ENDDO
+ENDDO
+!
+IF (GMEB_3L) THEN
+ IF (LHOOK) CALL DR_HOOK('DIF_LAYER',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
+!
+DO JL = 1, IO%NGROUND_LAYER
+ IF (ANY((PK%XROOTFRAC(:,JL)<0. .OR. PK%XROOTFRAC(:,JL)>1.) .AND. PK%XPATCH(:).NE.0.)) &
+ CALL ABOR1_SFX('DIF_LAYER: WITH CISBA=DIF ROOTFRAC MUST BE DEFINED')
+ENDDO
+!
+PK%XDZDIF (:,:) = XUNDEF
+PK%XSOILWGHT(:,:) = 0.0
!
!* distance between consecuative layer mid-points
- DO JLAYER=1,KGROUND_LAYER
- DO JILU=1,KLU
- IF(JLAYER<KGROUND_LAYER)THEN
- PDZDIF(JILU,JLAYER,JPATCH)=0.5*(PDZG(JILU,JLAYER,JPATCH)+PDZG(JILU,JLAYER+1,JPATCH))
- ELSE
- PDZDIF(JILU,JLAYER,JPATCH)=0.5*PDZG(JILU,JLAYER,JPATCH)
- ENDIF
- ENDDO
- ENDDO
+DO JL=1,IO%NGROUND_LAYER
+ DO JI=1,KLU
+ IF(JL<IO%NGROUND_LAYER)THEN
+ PK%XDZDIF(JI,JL)=0.5*(PK%XDZG(JI,JL)+PK%XDZG(JI,JL+1))
+ ELSE
+ PK%XDZDIF(JI,JL)=0.5*PK%XDZG(JI,JL)
+ ENDIF
+ ENDDO
+ENDDO
!
-ENDDO
!
! Horton runoff parameter
!
-IWORK(:,:) = KWG_LAYER(:,:)
+IWORK(:) = PK%NWG_LAYER(:)
!
-DO JPATCH=1,KPATCH
-!
- IF( KSIZE_NATURE_P(JPATCH) == 0 ) CYCLE
-!
- DO JILU=1,KLU
- IDEPTH = KWG_LAYER(JILU,JPATCH)
- IF (IDEPTH==NUNDEF) IDEPTH = KGROUND_LAYER
- DO JLAYER=1,IDEPTH-1
- IF(PDG(JILU,JLAYER,JPATCH)<XHORT_DEPTH) IWORK(JILU,JPATCH)=JLAYER+1
- ENDDO
+DO JI=1,KLU
+ IDEPTH = PK%NWG_LAYER(JI)
+ IF (IDEPTH==NUNDEF) IDEPTH = IO%NGROUND_LAYER
+ DO JL=1,IDEPTH-1
+ IF(PK%XDG(JI,JL)<XHORT_DEPTH) IWORK(JI)=JL+1
ENDDO
+ENDDO
!
-END DO
-!
-KLAYER_HORT=MAXVAL(IWORK(:,:),IWORK(:,:)/=NUNDEF)
+!
+IF (SIZE(IWORK)>0.AND.MAXVAL(IWORK(:),IWORK(:)/=NUNDEF)>IO%NLAYER_HORT) THEN
+ IO%NLAYER_HORT=MAXVAL(IWORK(:),IWORK(:)/=NUNDEF)
+ENDIF
!
! Dunne runoff parameter
!
-IWORK(:,:)=KWG_LAYER(:,:)
+IWORK(:)=PK%NWG_LAYER(:)
!
-DO JPATCH=1,KPATCH
!
- IF (KSIZE_NATURE_P(JPATCH) == 0 ) CYCLE
-!
- DO JILU=1,KLU
- IF(PPATCH(JILU,JPATCH)>0.0)THEN
- IDEPTH = KWG_LAYER(JILU,JPATCH)
- IF(PDROOT(JILU,JPATCH)>0.0.AND.PDROOT(JILU,JPATCH)/=XUNDEF)THEN
- PRUNOFFD(JILU,JPATCH) = PDG(JILU,1,JPATCH)
- DO JLAYER=1,IDEPTH-1
- IF(PROOTFRAC(JILU,JLAYER,JPATCH)<0.90)THEN
- PRUNOFFD(JILU,JPATCH) = PDG(JILU,JLAYER+1,JPATCH)
- ENDIF
- ENDDO
- ELSE
- PRUNOFFD(JILU,JPATCH) = MIN(0.6,PDG2(JILU,JPATCH))
- ENDIF
+DO JI=1,KLU
+ IF(PK%XPATCH(JI)>0.0)THEN
+ IDEPTH = PK%NWG_LAYER(JI)
+ IF(PK%XDROOT(JI)>0.0.AND.PK%XDROOT(JI)/=XUNDEF)THEN
+ PK%XRUNOFFD(JI) = PK%XDG(JI,1)
+ DO JL=1,IDEPTH-1
+ IF(PK%XROOTFRAC(JI,JL)<0.90)THEN
+ PK%XRUNOFFD(JI) = PK%XDG(JI,JL+1)
+ ENDIF
+ ENDDO
+ ELSE
+ PK%XRUNOFFD(JI) = MIN(0.6,PK%XDG2(JI))
ENDIF
- ENDDO
+ ENDIF
+ENDDO
!
- ZWORK(:) = 0.0
- DO JLAYER=1,KGROUND_LAYER
- DO JILU=1,KLU
- IF(PPATCH(JILU,JPATCH)>0.0)THEN
- IDEPTH=KWG_LAYER(JILU,JPATCH)
- IF(JLAYER<=IDEPTH)THEN
- ZWORK (JILU ) = ZWORK(JILU) + PDZG(JILU,JLAYER,JPATCH)
- PSOILWGHT(JILU,JLAYER,JPATCH) = MIN(PDZG(JILU,JLAYER,JPATCH), &
- MAX(0.0,PRUNOFFD(JILU,JPATCH)-ZWORK(JILU)+PDZG(JILU,JLAYER,JPATCH)))
- ENDIF
- IF(PDG(JILU,JLAYER,JPATCH)<PRUNOFFD(JILU,JPATCH))THEN
- IWORK(JILU,JPATCH)=JLAYER+1
- ENDIF
+ZWORK(:) = 0.0
+DO JL=1,IO%NGROUND_LAYER
+ DO JI=1,KLU
+ IF(PK%XPATCH(JI)>0.0)THEN
+ IDEPTH=PK%NWG_LAYER(JI)
+ IF(JL<=IDEPTH)THEN
+ ZWORK (JI ) = ZWORK(JI) + PK%XDZG(JI,JL)
+ PK%XSOILWGHT(JI,JL) = MIN(PK%XDZG(JI,JL), &
+ MAX(0.0,PK%XRUNOFFD(JI)-ZWORK(JI)+PK%XDZG(JI,JL)))
ENDIF
- ENDDO
+ IF(PK%XDG(JI,JL)<PK%XRUNOFFD(JI))THEN
+ IWORK(JI)=JL+1
+ ENDIF
+ ENDIF
ENDDO
+ENDDO
!
-END DO
!
-KLAYER_DUN=MAXVAL(IWORK(:,:),IWORK(:,:)/=NUNDEF)
+IF (SIZE(IWORK)>0.AND.MAXVAL(IWORK(:),IWORK(:)/=NUNDEF)>IO%NLAYER_DUN) THEN
+ IO%NLAYER_DUN=MAXVAL(IWORK(:),IWORK(:)/=NUNDEF)
+ENDIF
!
IF (LHOOK) CALL DR_HOOK('DIF_LAYER',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/drag.F90 b/src/SURFEX/drag.F90
index 105d45b270e6018a97520213bdecd22a92d50648..2798577f15a269f45e271229dcbf54b6b38deb7b 100644
--- a/src/SURFEX/drag.F90
+++ b/src/SURFEX/drag.F90
@@ -3,16 +3,13 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DRAG(HISBA, HSNOW_ISBA, HCPSURF, PTSTEP, &
- PTG, PWG, PWGI, &
- PEXNS, PEXNA, PTA, PVMOD, PQA, PRR, PSR, &
- PPS, PRS, PVEG, PZ0, PZ0EFF, PZ0H, &
- PWFC, PWSAT, PPSNG, PPSNV, PZREF, PUREF, &
- PDIRCOSZW, PDELTA, PF5, PRA, &
- PCH, PCD, PCDN, PRI, PHUG, PHUGI, &
- PHV, PHU, PCPS, PQS, PFFG, PFFV, PFF, &
- PFFG_NOSNOW, PFFV_NOSNOW, &
- PLEG_DELTA, PLEGI_DELTA, PWR, PRHOA, PLVTT, PQSAT )
+ SUBROUTINE DRAG(HISBA, HSNOW_ISBA, HCPSURF, PTSTEP, PTG, PWG, PWGI, &
+ PEXNS, PEXNA, PTA, PVMOD, PQA, PRR, PSR, PPS, PRS, &
+ PVEG, PZ0, PZ0EFF, PZ0H, PWFC, PWSAT, PPSNG, PPSNV, &
+ PZREF, PUREF, PDIRCOSZW, PDELTA, PF5, PRA, PCH, PCD, &
+ PCDN, PRI, PHUG, PHUGI, PHV, PHU, PCPS, PQS, PFFG, &
+ PFFV, PFF, PFFG_NOSNOW, PFFV_NOSNOW, PLEG_DELTA, &
+ PLEGI_DELTA, PWR, PRHOA, PLVTT, PQSAT )
! ############################################################################
!
!!**** *DRAG*
@@ -104,15 +101,15 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
- CHARACTER(LEN=*), INTENT(IN) :: HISBA ! type of ISBA version:
+CHARACTER(LEN=*), INTENT(IN) :: HISBA ! type of ISBA version:
! ! '2-L' (default)
! ! '3-L'
! ! 'DIF'
- CHARACTER(LEN=*), INTENT(IN) :: HSNOW_ISBA ! 'DEF' = Default F-R snow scheme
+CHARACTER(LEN=*), INTENT(IN) :: HSNOW_ISBA ! 'DEF' = Default F-R snow scheme
! ! (Douville et al. 1995)
! ! '3-L' = 3-L snow scheme (option)
! ! (Boone and Etchevers 2000)
- CHARACTER(LEN=*), INTENT(IN) :: HCPSURF ! option for specific heat Cp:
+CHARACTER(LEN=*), INTENT(IN) :: HCPSURF ! option for specific heat Cp:
! ! 'DRY' = dry Cp
! ! 'HUM' = Cp as a function of qs
!
@@ -234,7 +231,7 @@ PRI(:) =0.
!
ZVMOD = WIND_THRESHOLD(PVMOD,PUREF)
!
-ZQSAT(:) = QSAT(PTG(:),PPS(:))
+ZQSAT(:) = QSAT(PTG(:),PPS(:))
!
IF(PRESENT(PQSAT))PQSAT(:)=ZQSAT(:)
!
@@ -350,7 +347,7 @@ ENDIF
!* 6. COMPUTATION OF RESISTANCE AND DRAG COEFFICIENT
! ----------------------------------------------
!
- CALL SURFACE_RI(PTG, PQS, PEXNS, PEXNA, PTA, PQA, &
+CALL SURFACE_RI(PTG, PQS, PEXNS, PEXNA, PTA, PQA, &
PZREF, PUREF, PDIRCOSZW, PVMOD, PRI )
!
!-------------------------------------------------------------------------------
@@ -416,7 +413,7 @@ PHV(:) = PDELTA(:) + (1.- PDELTA(:))*
( PRA(:) + PRS(:)*(1.0 - ZZHV(:)) )* &
( (1/(PRA(:)+PRS(:))) - (ZZHV(:)*(1.-PF5(:))/(PRA(:)+XRS_MAX)) )
!
- CALL LIMIT_LER(PDELTA)
+CALL LIMIT_LER(PDELTA)
!
WHERE(PHV(:)<ZHVLIM)
PHV(:)=0.0
@@ -426,7 +423,7 @@ IF (LHOOK) CALL DR_HOOK('DRAG',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
!
- CONTAINS
+CONTAINS
!
!-------------------------------------------------------------------------------
!
@@ -473,7 +470,6 @@ ENDIF
! In DRAG, we use the timestep of ISBA (PTSTEP) and not the split time step (ZTSTEP)
! because diagnostic canopy evaporation (Er) must be consistent with PWR to
! limit negative dripping in hydro_veg
-
!
ZLEV(:) = PRHOA(:) * PLVTT(:) * PVEG(:) * (1-ZPSNV(:)) * PHV(:) * (ZQSAT(:) - PQA(:)) / PRA(:)
!
diff --git a/src/SURFEX/drag_meb.F90 b/src/SURFEX/drag_meb.F90
index 10c323a3f20b6bbfa4ae9bdfb4cb8d98312830f1..fb453f7db529b1eb680dc904481a0f1355e846cb 100644
--- a/src/SURFEX/drag_meb.F90
+++ b/src/SURFEX/drag_meb.F90
@@ -4,24 +4,15 @@
!SFX_LIC for details. version 1.
! ############################################################################
!
-SUBROUTINE DRAG_MEB(LFORC_MEASURE, &
- PTG, PTC, PTV, PSNOWTEMP, PTA, PQC, PQA, PVMOD, &
- PWG, PWGI, PWSAT, PWFC, &
- PEXNS, PEXNA, PPS, &
- PRR, PSR, PRHOA, PZ0G_WITHOUT_SNOW, &
- PZ0_MEBV, PZ0H_MEBV, PZ0EFF_MEBV, &
- PZ0_MEBN, PZ0H_MEBN, PZ0EFF_MEBN, &
- PZ0_WITH_SNOW, PZ0H_WITH_SNOW, PZ0EFF, &
- PSNOWSWE, &
- PWR, PCHIP, PTSTEP, PRS_VG, PRS_VN, &
- PPSN, PPALPHAN, PZREF, PUREF, PH_VEG, PDIRCOSZW, &
- PPSNCV, PDELTA, PLAI, OMEB_GNDRES, &
- PCH, PCD, PCDN, PRI, PRA, PVELC, &
- PCDSNOW, PCHSNOW, PRISNOW, PUSTAR2SNOW, &
- PHUG, PHUGI, PHV, PHVG, PHVN, PHU, PQS, PRS, &
- PLEG_DELTA, PLEGI_DELTA, PHSGL, PHSGF, &
- PFLXC_C_A, PFLXC_N_A, PFLXC_G_C, PFLXC_N_C, &
- PFLXC_VG_C, PFLXC_VN_C, PFLXC_MOM, &
+SUBROUTINE DRAG_MEB(IO, PEK, DMK, DK, PTG, PTA, PQA, PVMOD, &
+ PWG, PWGI, PWSAT, PWFC, PEXNS, PEXNA, PPS, PRR, PSR, &
+ PRHOA, PZ0G_WITHOUT_SNOW, PZ0_MEBV, PZ0H_MEBV, &
+ PZ0EFF_MEBV, PZ0_MEBN, PZ0H_MEBN, PZ0EFF_MEBN, PSNOWSWE,&
+ PCHIP, PTSTEP, PRS_VG, PRS_VN, PPALPHAN, PZREF, PUREF, &
+ PDIRCOSZW, PSNCV, PDELTA, PVELC, &
+ PRISNOW, PUSTAR2SNOW, PHUGI, PHVG, PHVN, PLEG_DELTA, &
+ PLEGI_DELTA, PHSGL, PHSGF, PFLXC_C_A, PFLXC_N_A, &
+ PFLXC_G_C, PFLXC_N_C, PFLXC_VG_C, PFLXC_VN_C, PFLXC_MOM,&
PQSATG, PQSATV, PQSATC, PQSATN, PDELTAVK )
!
! ############################################################################
@@ -69,9 +60,14 @@ SUBROUTINE DRAG_MEB(LFORC_MEASURE, &
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_PE_t
+USE MODD_DIAG_n, ONLY : DIAG_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
+!
USE MODD_CSTS, ONLY : XPI
USE MODD_SNOW_PAR, ONLY : XZ0SN
-USE MODD_ISBA_PAR, ONLY : XWGMIN, XFLXMAX
+USE MODD_ISBA_PAR, ONLY : XWGMIN
USE MODD_SURF_ATM, ONLY : LDRAG_COEF_ARP, XRIMAX, LRRGUST_ARP, XRRSCALE, &
XRRGAMMA, XUTILGUST, LCPL_ARP
USE MODD_MEB_PAR, ONLY : XKDELTA_WR
@@ -91,22 +87,19 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-LOGICAL, INTENT(IN) :: LFORC_MEASURE
-! LFORC_MEASURE = switch for using measured data
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(DIAG_t), INTENT(INOUT) :: DK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK
!
REAL, INTENT(IN) :: PTSTEP
! PTSTEP = Model time step (s)
!
-REAL, DIMENSION(:), INTENT(IN) :: PTG, PTC, PTV, PSNOWTEMP, PTA, PQC, PQA, PVMOD, &
- PWG, PWGI, PWSAT, PWFC, PEXNS, PEXNA, PPS, &
- PSNOWSWE
+REAL, DIMENSION(:), INTENT(IN) :: PTG, PTA, PQA, PVMOD, PWG, PWGI, PWSAT, PWFC, &
+ PEXNS, PEXNA, PPS, PSNOWSWE
! PTG = surface temperature
-! PTC = canopy air temperature
-! PTV = canopy temperature
-! PSNOWTEMP = sfc layer snow temperature (K)
! PSNOWSWE = sfc layer snow water equiv (SWE) kg m-2
! PTA = temperature of the atmosphere/forcing-level
-! PQC = canopy air humidity
! PQA = specific humidity of the atmosphere/forcing-level
! PVMOD = module of the horizontal wind
! NOTE it should be input as >= 1. (m)
@@ -125,34 +118,23 @@ REAL, DIMENSION(:), INTENT(IN) :: PRR, PSR, PRHOA
!
REAL, DIMENSION(:), INTENT(IN) :: PZ0G_WITHOUT_SNOW, &
PZ0_MEBV, PZ0H_MEBV, PZ0EFF_MEBV, &
- PZ0_MEBN, PZ0H_MEBN, PZ0EFF_MEBN, &
- PZ0_WITH_SNOW, PZ0H_WITH_SNOW, PZ0EFF
+ PZ0_MEBN, PZ0H_MEBN, PZ0EFF_MEBN
!
! PZ0G_WITHOUT_SNOW ! roughness length for momentum at snow-free canopy floor
! PZ0_MEBV ! roughness length for momentum over MEB vegetation part of patch
! PZ0H_MEBV ! roughness length for heat over MEB vegetataion part of path
-! PZ0EFF_MEBV ! roughness length for momentum over MEB vegetation part of patch
-! eventuelly including orograhic roughness
! PZ0_MEBN ! roughness length for momentum over MEB snow part of patch
! PZ0H_MEBN ! roughness length for heat over MEB snow part of path
-! PZ0EFF_MEBN ! roughness length for momentum over MEB snow part of patch
-! eventuelly including orograhic roughness
-! PZ0_WITH_SNOW ! roughness length for momentum over MEB total patch
-! PZ0H_WITH_SNOW ! roughness length for heat over MEB total path
-! PZ0EFF ! roughness length for momentum over MEB total patch
-! eventuelly including orograhic roughness
-!
-REAL, DIMENSION(:), INTENT(IN) :: PWR,PCHIP
-! PWR = intercepted water for the canopy
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCHIP
! PCHIP = view factor (for LW)
!
-REAL, DIMENSION(:), INTENT(IN) :: PRS_VG, PRS_VN, PPSN, PPSNCV, &
- PPALPHAN, PZREF, PUREF, PH_VEG, PDIRCOSZW
+REAL, DIMENSION(:), INTENT(IN) :: PRS_VG, PRS_VN, PSNCV, &
+ PPALPHAN, PZREF, PUREF, PDIRCOSZW
!
! PRS_VG = surface resistance for canopy (1-png)
! PRS_VN = surface resistance for canopy (png)
-! PPSN = fraction of the patch covered by snow
-! PPSNCV = fraction of the canopy vegetation covered by snow
+! PSNCV = fraction of the canopy vegetation covered by snow
! PPALPHAN = weight between canopy air flow and direct flow
! between snow and atmosphere
! PZREF = reference height of the first
@@ -161,43 +143,27 @@ REAL, DIMENSION(:), INTENT(IN) :: PRS_VG, PRS_VN, PPSN, PPSNCV, &
! NOTE this is different from ZZREF
! ONLY in stand-alone/forced mode,
! NOT when coupled to a model (MesoNH)
-! PH_VEG = height of the vegetation
! PDIRCOSZW= Cosinus of the angle between
! the normal to the surface and the vertical
!
-REAL, DIMENSION(:), INTENT(IN) :: PDELTA, PLAI
+REAL, DIMENSION(:), INTENT(IN) :: PDELTA
! PDELTA = fraction of the canopy foliage covered
! by intercepted water (-)
-! PLAI = vegetation LAI (m2 m-2)
!
-LOGICAL, INTENT(IN) :: OMEB_GNDRES ! Flag for ground resistance
REAL, DIMENSION(:), INTENT(OUT) :: PDELTAVK
! PDELTAVK = fraction of the canopy foliage covered
! by intercepted water *including* K-factor (-)
! (i.e. that the intercepted water fraction is not
! necessarily reaching 100%)
!
-REAL, DIMENSION(:), INTENT(OUT) :: PCH, PCD, PCDN, PRI, PRA, PVELC
-! PCH = drag coefficient for heat, averaged over whole patch
-! PCD = drag coefficient for momentum, averaged over whole patch
-! PCDN= neutral drag coefficient for momentum,
-! averaged over whole patch
-! PRI = Richardson number, averaged over whole patch
-! PRA = aerodynamic resistance between
-! the whole patch and atmosphere
+REAL, DIMENSION(:), INTENT(OUT) :: PVELC
! PVELC = wind speed at top of vegetation
!
-REAL, DIMENSION(:), INTENT(OUT) :: PHUG, PHUGI, PHVG, PHVN, PHV, &
- PHU, PQS, PLEG_DELTA, PLEGI_DELTA, PHSGL, PHSGF, PRS
+REAL, DIMENSION(:), INTENT(OUT) :: PHUGI, PHVG, PHVN, PLEG_DELTA, PLEGI_DELTA, PHSGL, PHSGF
!
-! PRS = total effective stomatal resistance (under and overstory) diagnostic (s m-1)
-! PHUG = ground relative humidity
! PHUGI = ground (ice) relative humidity
-! PHV = Total effective Halstead coefficient
! PHVN = Halstead coefficient vegetation canopy above snow
! PHVG = Halstead coefficient vegetation canopy above ground
-! PHU = effective relative humidity at the surface
-! PQS = effective specific humidity at surface
! PLEG_DELTA = soil evaporation delta fn
! PLEGI_DELTA = soil sublimation delta fn
! PHSGL = surface halstead cofficient for bare soil (currently==1)
@@ -218,13 +184,11 @@ REAL, DIMENSION(:), INTENT(OUT) :: PFLXC_C_A, PFLXC_N_A, PFLXC_G_C, PFLXC_N_C,
REAL, DIMENSION(:), INTENT(OUT) :: PFLXC_MOM, PQSATG, PQSATV, PQSATC, PQSATN
! PFLXC_MOM = effective drag coefficient for momentum [kg/m2/s]
! PQSATG = qsat for PTG
-! PQSATV = qsat for PTV
-! PQSATC = qsat for PTC
-! PQSATN = qsat for PSNOWTEMP
+! PQSATV = qsat for PEK%XTV(:)
+! PQSATC = qsat for PEK%XTC(:)
+! PQSATN = qsat for DMK%XSNOWTEMP(:)
!
-REAL, DIMENSION(:), INTENT(OUT) :: PCDSNOW, PCHSNOW, PRISNOW, PUSTAR2SNOW
-! PCDSNOW = drag coefficient over snow (-)
-! PCHSNOW = heat/mass exchange coefficient over snow (-)
+REAL, DIMENSION(:), INTENT(OUT) :: PRISNOW, PUSTAR2SNOW
! PRISNOW = Richardson number over snow (-)
! PUSTAR2SNOW = Surface friction velocity squared (m2 s-2)
! Just a diagnostic, not used in coupling
@@ -295,16 +259,18 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('DRAG_MEB',0,ZHOOK_HANDLE)
!
-PCH(:) = 0.
-PCD(:) = 0.
-PCDN(:) = 0.
-PRI(:) = 0.
-PHUG(:) = 0.
+DK%XCH(:) = 0.
+DK%XCD(:) = 0.
+DK%XCDN(:) = 0.
+DK%XRI(:) = 0.
+DK%XHUG(:) = 0.
+!
+DMK%XHV(:) = 0.
+DK%XHU(:) = 0.
+!
PHUGI(:) = 0.
-PHV(:) = 0.
PHVN(:) = 0.
PHVG(:) = 0.
-PHU(:) = 0.
PHSGL(:) = 0.
PHSGF(:) = 0.
!
@@ -330,19 +296,21 @@ ZZ0SN(:) = XZ0SN
! field capacity of the ground
!
ZWSAT(:) = PWSAT(:)-PWGI(:)
-ZWFC(:) = PWFC(:)*ZWSAT(:)/PWSAT(:)
-PHUG(:) = 0.5 * ( 1.-COS(XPI*MIN((PWG(:)-XWGMIN) /ZWFC(:),1.)) )
-ZWSAT(:) = MAX(XWGMIN, ZWSAT(:))
-ZWFC(:) = PWFC(:)*ZWSAT(:)/PWSAT(:)
+ZWFC (:) = PWFC(:)*ZWSAT(:)/PWSAT(:)
+!
+DK%XHUG(:) = 0.5 * ( 1.-COS(XPI*MIN((PWG(:)-XWGMIN) /ZWFC(:),1.)) )
+!
+ZWSAT(:) = MAX(XWGMIN, PWSAT(:)-PWG(:))
+ZWFC (:) = PWFC(:)*ZWSAT(:)/PWSAT(:)
PHUGI(:) = 0.5 * ( 1.-COS(XPI*MIN(PWGI(:)/ZWFC(:),1.)) )
!
! there is a specific treatment for dew
! (see Mahfouf and Noilhan, jam, 1991)
!
PQSATG(:) = QSAT(PTG(:),PPS(:))
-PQSATV(:) = QSAT(PTV(:),PPS(:))
-PQSATC(:) = QSAT(PTC(:),PPS(:))
-PQSATN(:) = QSATI(PSNOWTEMP(:),PPS(:))
+PQSATV(:) = QSAT(PEK%XTV(:),PPS(:))
+PQSATC(:) = QSAT(PEK%XTC(:),PPS(:))
+PQSATN(:) = QSATI(DMK%XSNOWTEMP(:,1),PPS(:))
!
!-------------------------------------------------------------------------------
!
@@ -351,8 +319,8 @@ PQSATN(:) = QSATI(PSNOWTEMP(:),PPS(:))
! average of canopy air humidity and saturation humidity of snowpack
!
!
- PQS(:) =(1.-PPSN(:)*PPALPHAN(:))*PQC(:)+ PPSN(:)*PPALPHAN(:)*PQSATN(:)
- PHU(:) =(1.-PPSN(:)*PPALPHAN(:))*PQC(:)/PQSATC(:)+ PPSN(:)*PPALPHAN(:)
+DK%XQS(:) =(1.-PEK%XPSN(:)*PPALPHAN(:))*PEK%XQC(:) + PEK%XPSN(:)*PPALPHAN(:)*PQSATN(:)
+DK%XHU(:) =(1.-PEK%XPSN(:)*PPALPHAN(:))*PEK%XQC(:)/PQSATC(:)+ PEK%XPSN(:)*PPALPHAN(:)
!
!-------------------------------------------------------------------------------
!
@@ -377,17 +345,14 @@ ZLW(:)=0.02
!
! Calculate the displacement height
!
- CALL DISPH_FOR_MEB(ZCHIL,PLAI,ZLW,PH_VEG,PZREF,PZ0_MEBV,ZDISPH)
+CALL DISPH_FOR_MEB(ZCHIL,PEK%XLAI,ZLW,PEK%XH_VEG,PZREF,PZ0_MEBV,ZDISPH)
!
! Here ZRICN,ZRA_C_A,ZCHCN,ZCDNCN,ZCDCN are valid for the snow free part in meb:
!
- CALL PREPS_FOR_MEB_DRAG(.TRUE.,LFORC_MEASURE, &
- PZ0_MEBV, PZ0H_MEBV, PZ0EFF_MEBV, &
- PH_VEG, PZREF, &
- PTC, PTA, PQC, PQA, PUREF, PVMOD, &
- PEXNA, PEXNS, PDIRCOSZW, ZDISPH, &
- PVELC, ZVMOD, ZRICN, ZRA_C_A, &
- ZCHCN,ZCDNCN,ZCDCN )
+CALL PREPS_FOR_MEB_DRAG(.TRUE.,IO%LFORC_MEASURE, PZ0_MEBV, PZ0H_MEBV, PZ0EFF_MEBV, &
+ PEK%XH_VEG, PZREF, PEK%XTC, PTA, PEK%XQC, PQA, PUREF, &
+ PVMOD, PEXNA, PEXNS, PDIRCOSZW, ZDISPH, PVELC, ZVMOD, ZRICN,&
+ ZRA_C_A, ZCHCN, ZCDNCN, ZCDCN )
!
IF (LRRGUST_ARP) THEN
@@ -411,41 +376,37 @@ PFLXC_MOM(:)=ZCDCN(:)*ZVMOD(:)*PRHOA(:)
!Calculate the aerodynamic resistance between the snowfree part of the ground
!and canopy air, ZRA_G_C, and the conductance between the canopy and canopy air, ZG_VG_C
!
- CALL SURFACE_AIR_MEB(PZ0_MEBV, PZ0H_MEBV, PZ0G_WITHOUT_SNOW, PH_VEG, PLAI, &
- PTG, PTC, PTV, PVELC, ZLW, &
- ZDISPH, &
- ZRA_G_C, ZG_VG_C, &
- ZUSTAR2G, ZCDG, ZCHG, ZRIG )
+CALL SURFACE_AIR_MEB(PZ0_MEBV, PZ0H_MEBV, PZ0G_WITHOUT_SNOW, PEK%XH_VEG, PEK%XLAI, &
+ PTG, PEK%XTC, PEK%XTV, PVELC, ZLW, ZDISPH, &
+ ZRA_G_C, ZG_VG_C, ZUSTAR2G, ZCDG, ZCHG, ZRIG )
!
!Compute the lai of the canopy that is above snow
!
-ZLAISN(:)=PLAI(:)*(1.-PPALPHAN(:))
+ZLAISN(:)= PEK%XLAI(:)*(1.-PPALPHAN(:))
!
! Note that we use the same displacement height also for the snow covered part
!
! The same as ZRA_G_C/ZG_VG_C but for the snow part (png) =>ZRA_N_C/ZG_VN_C
!
- CALL SURFACE_AIR_MEB(PZ0_MEBN, PZ0H_MEBN, ZZ0SN, PH_VEG, ZLAISN, &
- PSNOWTEMP, PTC, PTV, PVELC, ZLW, &
- ZDISPH, &
- ZRA_N_C, ZG_VN_C, &
+CALL SURFACE_AIR_MEB(PZ0_MEBN, PZ0H_MEBN, ZZ0SN, PEK%XH_VEG, ZLAISN, &
+ DMK%XSNOWTEMP(:,1), PEK%XTC, PEK%XTV, &
+ PVELC, ZLW, ZDISPH, ZRA_N_C, ZG_VN_C, &
ZUSTAR2G, ZCDG, ZCHG, ZRIG )
! save values over snow for diagnostic purposes:
PUSTAR2SNOW(:) = ZUSTAR2G(:)
-PCDSNOW(:) = ZCDG(:)
-PCHSNOW(:) = ZCHG(:)
+DMK%XCDSNOW(:) = ZCDG(:)
+DMK%XCHSNOW(:) = ZCHG(:)
PRISNOW(:) = ZRIG(:)
!
!------------------------------------------------------------------------------
! Now calculate the aerodynamic resistance for the completely snow covered part,
! i.e. between the snow surface and atmosphere directly
!
- CALL PREPS_FOR_MEB_DRAG(.FALSE.,LFORC_MEASURE, &
- PZ0_MEBN, PZ0H_MEBN, PZ0EFF_MEBN, &
- PH_VEG, PZREF, &
- PSNOWTEMP, PTA, PQSATN, PQA, PUREF, PVMOD, &
+CALL PREPS_FOR_MEB_DRAG(.FALSE.,IO%LFORC_MEASURE, &
+ PZ0_MEBN, PZ0H_MEBN, PZ0EFF_MEBN, PEK%XH_VEG, PZREF, &
+ DMK%XSNOWTEMP(:,1), PTA, PQSATN, PQA, PUREF, PVMOD, &
PEXNA, PEXNS, PDIRCOSZW, ZDISPH, &
ZVELC, ZVMOD, ZRINN, ZRANN, &
ZCHNN,ZCDNNN,ZCDNN )
@@ -453,7 +414,7 @@ PRISNOW(:) = ZRIG(:)
IF (LRRGUST_ARP) THEN
ZRRCOR(:)=SQRT(1.0+((((ZFP(:)/(ZFP(:)+XRRSCALE))**XRRGAMMA)*XUTILGUST)**2) &
- & /(ZCDNN(:)*ZVMOD(:)**2))
+ /(ZCDNN(:)*ZVMOD(:)**2))
ZCDNN(:) = ZCDNN(:) * ZRRCOR(:)
ZCHNN(:) = ZCHNN(:) * ZRRCOR(:)
@@ -465,42 +426,39 @@ PFLXC_N_A(:)=ZCHNN(:)*ZVMOD(:)*PRHOA(:)
!
! The effective momentum drag:
!
-PFLXC_MOM(:)=(1.-PPSN(:)*PPALPHAN(:))*PFLXC_MOM(:) + &
- PPSN(:)*PPALPHAN(:)*ZCDNN(:)*ZVMOD(:)*PRHOA(:)
+PFLXC_MOM(:)=(1.-PEK%XPSN(:)*PPALPHAN(:))*PFLXC_MOM(:) + &
+ PEK%XPSN(:)*PPALPHAN(:)*ZCDNN(:)*ZVMOD(:)*PRHOA(:)
!
! Now calculate the aerodynamic resistance for the whole meb-patch
!
! Calculate the effective temperature
!
-ZPSNA(:) = PPSN(:)*PPALPHAN(:)
+ZPSNA(:) = PEK%XPSN(:)*PPALPHAN(:)
!
-ZTEFF(:) = (1.-ZPSNA(:))*PTC(:)+ ZPSNA(:)*PSNOWTEMP(:)
+ZTEFF(:) = (1.-ZPSNA(:))*PEK%XTC(:)+ ZPSNA(:)*DMK%XSNOWTEMP(:,1)
!
! Some additional diagnostics:
!
PUSTAR2SNOW(:) = (1.-ZPSNA(:))*PUSTAR2SNOW(:) + ZPSNA(:)*ZCDNN(:)*ZVMOD(:)**2
-PCDSNOW(:) = (1.-ZPSNA(:))*PCDSNOW(:) + ZPSNA(:)*ZCDNN(:)
-PCHSNOW(:) = (1.-ZPSNA(:))*PCHSNOW(:) + ZPSNA(:)*ZCHNN(:)
+DMK%XCDSNOW(:) = (1.-ZPSNA(:))*DMK%XCDSNOW(:) + ZPSNA(:)*ZCDNN(:)
+DMK%XCHSNOW(:) = (1.-ZPSNA(:))*DMK%XCHSNOW(:) + ZPSNA(:)*ZCHNN(:)
PRISNOW(:) = (1.-ZPSNA(:))*PRISNOW(:) + ZPSNA(:)*ZRINN(:)
!
!-------------------------------------------------------------------------------
!
- CALL PREPS_FOR_MEB_DRAG(.FALSE.,LFORC_MEASURE, &
- PZ0_WITH_SNOW, PZ0H_WITH_SNOW, PZ0EFF, &
- PH_VEG, PZREF, &
- ZTEFF, PTA, PQS, PQA, PUREF, PVMOD, &
- PEXNA, PEXNS, PDIRCOSZW, ZDISPH, &
- ZVELC, ZVMOD, PRI, PRA, &
- PCH,PCDN,PCD )
+CALL PREPS_FOR_MEB_DRAG(.FALSE.,IO%LFORC_MEASURE, DK%XZ0, DK%XZ0H, DK%XZ0EFF, &
+ PEK%XH_VEG, PZREF, ZTEFF, PTA, DK%XQS, PQA, PUREF, PVMOD, &
+ PEXNA, PEXNS, PDIRCOSZW, ZDISPH, ZVELC, ZVMOD, DK%XRI, &
+ PEK%XRESA(:), DK%XCH,DK%XCDN,DK%XCD )
!
IF (LRRGUST_ARP) THEN
ZRRCOR(:)=SQRT(1.0+((((ZFP(:)/(ZFP(:)+XRRSCALE))**XRRGAMMA)*XUTILGUST)**2) &
- & /(PCD(:)*ZVMOD(:)**2))
+ /(DK%XCD(:)*ZVMOD(:)**2))
- PCD(:) = PCD(:) * ZRRCOR(:)
- PCH(:) = PCH(:) * ZRRCOR(:)
- PCDN(:) = PCDN(:) * ZRRCOR(:)
+ DK%XCD(:) = DK%XCD(:) * ZRRCOR(:)
+ DK%XCH(:) = DK%XCH(:) * ZRRCOR(:)
+ DK%XCDN(:) = DK%XCDN(:) * ZRRCOR(:)
ENDIF
@@ -519,24 +477,15 @@ ENDIF
! ZG_VG_C = conductance between canopy and canopy air (1-png)
! ZG_VN_C = conductance between canopy and canopy air (png)
!
-! The resistances between ground/snow and canopy air go to zero when lai => 0,
-! limit exchange coefficients to 5000.
-!
-WHERE(ZRA_G_C(:) > ZRAEPS)
- PFLXC_G_C(:) = PRHOA(:) / ZRA_G_C(:)
- PHSGL(:) = ZRA_G_C(:)/(ZRA_G_C(:)+ZRSGL(:))
- PHSGF(:) = ZRA_G_C(:)/(ZRA_G_C(:)+ZRSGF(:))
-ELSEWHERE
- PFLXC_G_C(:) = XFLXMAX
- PHSGL(:) = 1.
- PHSGF(:) = 1.
-END WHERE
+! The resistances between ground/snow and canopy air go to zero when lai => 0
!
-WHERE(ZRA_N_C>ZRAEPS)
- PFLXC_N_C(:) = PRHOA(:)/ZRA_N_C(:)
-ELSEWHERE
- PFLXC_N_C(:) = XFLXMAX
-END WHERE
+ZRA_G_C(:) = MAX(ZRAEPS,ZRA_G_C(:))
+PFLXC_G_C(:) = PRHOA(:) / ZRA_G_C(:)
+PHSGL(:) = ZRA_G_C(:)/(ZRA_G_C(:)+ZRSGL(:))
+PHSGF(:) = ZRA_G_C(:)/(ZRA_G_C(:)+ZRSGF(:))
+
+ZRA_N_C(:) = MAX(ZRA_N_C(:),ZRAEPS)
+PFLXC_N_C(:) = PRHOA(:)/ZRA_N_C(:)
!
! Reduce sublimation from ground based snowpack as it
! becomes vanishingly thin. This is mainly just for numerical reasons within the snow scheme
@@ -556,26 +505,26 @@ PFLXC_VN_C(:) = PRHOA(:)*ZG_VN_C(:)
!* 5. HALSTEAD COEFFICIENT (RELATIVE HUMIDITY OF THE VEGETATION)
! ----------------------------------------------------------
!
-ZDELTAMAX(:) = (1.-PCHIP(:))*(1.-PPSN(:)*PPALPHAN(:))*PRR(:)+ PWR(:)/PTSTEP
-ZDENOM(:) = (1.-PPSNCV(:))*XKDELTA_WR* &
- ( PPSN(:)*(1.-PPALPHAN(:))*PFLXC_VN_C(:) + (1.-PPSN(:))*PFLXC_VG_C(:) )* &
- ( PQSATV(:)-PQC(:))
+ZDELTAMAX(:) = (1.-PCHIP(:))*(1.-PEK%XPSN(:)*PPALPHAN(:))*PRR(:)+ PEK%XWR(:)/PTSTEP
+ZDENOM(:) = (1.-PSNCV(:))*XKDELTA_WR * &
+ ( PEK%XPSN(:)*(1.-PPALPHAN(:))*PFLXC_VN_C(:) + (1.-PEK%XPSN(:))*PFLXC_VG_C(:) )* &
+ ( PQSATV(:)-PEK%XQC(:))
ZDELTAMAX(:) = MAX(0., MIN(1.0, ZDELTAMAX(:)/MAX(1.E-10,ZDENOM(:))))
!
ZDELTAV(:) = XKDELTA_WR*MIN(ZDELTAMAX(:),PDELTA(:))
PDELTAVK(:) = XKDELTA_WR*PDELTA(:) ! delta including K factor
!
-PHVG(:) = 1. - MAX(0.,SIGN(1.,PQSATV(:)-PQC(:))) &
+PHVG(:) = 1. - MAX(0.,SIGN(1.,PQSATV(:)-PEK%XQC(:))) &
*(1.-ZDELTAV(:))*PRS_VG(:)*ZG_VG_C(:) / (1.+PRS_VG(:)*ZG_VG_C(:))
!
-PHVN(:) = 1. - MAX(0.,SIGN(1.,PQSATV(:)-PQC(:))) &
+PHVN(:) = 1. - MAX(0.,SIGN(1.,PQSATV(:)-PEK%XQC(:))) &
*(1.-ZDELTAV(:))*PRS_VN(:)*ZG_VN_C(:) / (1.+PRS_VN(:)*ZG_VN_C(:))
! Diagnostics:
! Compute an effective canopy stomatal resistance (s m-1) and Halstead Coef:
!
-PRS(:) = PPALPHAN(:)*PRS_VN(:) + (1.0-PPALPHAN(:))*PRS_VG(:)
-PHV(:) = PPALPHAN(:)*PHVN(:) + (1.0-PPALPHAN(:))*PHVG(:)
+DMK%XRS(:) = PPALPHAN(:)*PRS_VN(:) + (1.0-PPALPHAN(:))*PRS_VG(:)
+DMK%XHV(:) = PPALPHAN(:)*PHVN(:) + (1.0-PPALPHAN(:))*PHVG(:)
!
!
!-------------------------------------------------------------------------
@@ -586,15 +535,12 @@ PHV(:) = PPALPHAN(:)*PHVN(:) + (1.0-PPALPHAN(:))*PHVG(:)
! We use the existing LEG_DELTA (formerly a delta function) as a Beta-type-function
! (based on Sellers et al., 1992, J Geophys Res)
!
-IF (OMEB_GNDRES) THEN
-PLEG_DELTA(:) = ZRA_G_C(:) / &
- ( ZRA_G_C(:) + EXP(ZRG_COEF1 - ZRG_COEF2 * PWG(:) / ZWSAT(:) ) )
-PLEGI_DELTA(:) =ZRA_G_C(:) / &
- ( ZRA_G_C(:) + EXP(ZRG_COEF1 - ZRG_COEF2 * PWGI(:)/ ZWSAT(:) ) )
-
+IF (IO%LMEB_GNDRES) THEN
+ PLEG_DELTA (:) = ZRA_G_C(:) / ( ZRA_G_C(:) + EXP(ZRG_COEF1 - ZRG_COEF2 * PWG(:) / ZWSAT(:) ) )
+ PLEGI_DELTA(:) = ZRA_G_C(:) / ( ZRA_G_C(:) + EXP(ZRG_COEF1 - ZRG_COEF2 * PWGI(:)/ ZWSAT(:) ) )
ELSE
-PLEG_DELTA(:) = 1.0
-PLEGI_DELTA(:) = 1.0
+ PLEG_DELTA (:) = 1.0
+ PLEGI_DELTA(:) = 1.0
ENDIF
!
! when hu*qsat < qa, there are two
@@ -607,19 +553,19 @@ ENDIF
! here are needed owing to linearization
! of Qsat in the surface energy budget.
!
-WHERE ( PHUG(:)*PQSATG(:) < PQC(:) .AND. PQSATG(:) > PQC(:) )
- PHUG(:) = PQC(:) / PQSATG(:)
+WHERE ( DK%XHUG(:)*PQSATG(:) < PEK%XQC(:) .AND. PQSATG(:) > PEK%XQC(:) )
+ DK%XHUG(:) = PEK%XQC(:) / PQSATG(:)
PLEG_DELTA(:) = 0.0
END WHERE
-WHERE ( PHUGI(:)*PQSATG(:) < PQC(:) .AND. PQSATG(:) > PQC(:) )
- PHUGI(:) = PQC(:) / PQSATG(:)
+WHERE ( PHUGI(:)*PQSATG(:) < PEK%XQC(:) .AND. PQSATG(:) > PEK%XQC(:) )
+ PHUGI(:) = PEK%XQC(:) / PQSATG(:)
PLEGI_DELTA(:) = 0.0
END WHERE
!
! b) low-level air is humid, i.e., qa >= qsat (condensation)
!
-WHERE ( PHUG*PQSATG < PQC .AND. PQSATG <= PQC )PHUG(:) = 1.0
-WHERE ( PHUGI*PQSATG < PQC .AND. PQSATG <= PQC )PHUGI(:) = 1.0
+WHERE ( DK%XHUG*PQSATG < PEK%XQC(:) .AND. PQSATG <= PEK%XQC(:) )DK%XHUG(:) = 1.0
+WHERE ( PHUGI*PQSATG < PEK%XQC(:) .AND. PQSATG <= PEK%XQC(:) )PHUGI(:) = 1.0
!
!
IF (LHOOK) CALL DR_HOOK('DRAG_MEB',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/dry_wet_soil_albedos.F90 b/src/SURFEX/dry_wet_soil_albedos.F90
index 9ad4a58bf583ad759f2c03c61a5f41067d9e0cd8..6621073e6d2230e647c7f5953815231dc3563d0b 100644
--- a/src/SURFEX/dry_wet_soil_albedos.F90
+++ b/src/SURFEX/dry_wet_soil_albedos.F90
@@ -2,69 +2,8 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
-! #########################
-MODULE MODI_DRY_WET_SOIL_ALBEDOS
-! #########################
-!
-INTERFACE DRY_WET_SOIL_ALBEDOS
-!
-!
- SUBROUTINE DRY_WET_SOIL_ALBEDOS_1D(PSAND,PCLAY, &
- PVEGTYPE, &
- PALBNIR_DRY,PALBVIS_DRY,PALBUV_DRY, &
- PALBNIR_WET,PALBVIS_WET,PALBUV_WET )
-!
-!
-!* 0.1 declarations of arguments
-! -------------------------
-!
-!
-REAL, DIMENSION(:), INTENT(IN) :: PSAND ! sand fraction
-REAL, DIMENSION(:), INTENT(IN) :: PCLAY ! clay fraction
-REAL, DIMENSION(:,:), INTENT(IN):: PVEGTYPE ! vegetation type
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PALBVIS_DRY ! visible, near infra-red and UV
-REAL, DIMENSION(:), INTENT(OUT) :: PALBNIR_DRY ! dry bare soil albedo
-REAL, DIMENSION(:), INTENT(OUT) :: PALBUV_DRY !
-REAL, DIMENSION(:), INTENT(OUT) :: PALBVIS_WET ! visible, near infra-red and UV
-REAL, DIMENSION(:), INTENT(OUT) :: PALBNIR_WET ! wet bare soil albedo
-REAL, DIMENSION(:), INTENT(OUT) :: PALBUV_WET !
-!
-END SUBROUTINE DRY_WET_SOIL_ALBEDOS_1D
-!
-!
- SUBROUTINE DRY_WET_SOIL_ALBEDOS_2D(PSAND,PCLAY, &
- PVEGTYPE, &
- PALBNIR_DRY,PALBVIS_DRY,PALBUV_DRY, &
- PALBNIR_WET,PALBVIS_WET,PALBUV_WET )
-!
-!
-!* 0.1 declarations of arguments
-! -------------------------
-!
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSAND ! sand fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PCLAY ! clay fraction
-REAL, DIMENSION(:,:,:), INTENT(IN):: PVEGTYPE ! vegetation type
-!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PALBVIS_DRY ! visible, near infra-red and UV
-REAL, DIMENSION(:,:), INTENT(OUT) :: PALBNIR_DRY ! dry bare soil albedo
-REAL, DIMENSION(:,:), INTENT(OUT) :: PALBUV_DRY !
-REAL, DIMENSION(:,:), INTENT(OUT) :: PALBVIS_WET ! visible, near infra-red and UV
-REAL, DIMENSION(:,:), INTENT(OUT) :: PALBNIR_WET ! wet bare soil albedo
-REAL, DIMENSION(:,:), INTENT(OUT) :: PALBUV_WET !
-!
-END SUBROUTINE DRY_WET_SOIL_ALBEDOS_2D
-!
-END INTERFACE
-!
-END MODULE MODI_DRY_WET_SOIL_ALBEDOS
-!
! ##################################################################
- SUBROUTINE DRY_WET_SOIL_ALBEDOS_1D(PSAND,PCLAY, &
- PVEGTYPE, &
- PALBNIR_DRY,PALBVIS_DRY,PALBUV_DRY, &
- PALBNIR_WET,PALBVIS_WET,PALBUV_WET )
+ SUBROUTINE DRY_WET_SOIL_ALBEDOS( KK )
! ##################################################################
!
!!**** *DRY_WET_SOIL_ALBEDOS*
@@ -106,12 +45,12 @@ END MODULE MODI_DRY_WET_SOIL_ALBEDOS
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_n, ONLY : ISBA_K_t
+!
USE MODD_DATA_COVER_PAR, ONLY : NVT_PARK, NVT_TEBD, NVT_BONE, NVT_TRBE, NVT_TRBD, &
NVT_TEBE, NVT_TENE, NVT_BOBD, NVT_BOND, NVT_SHRB, &
NVT_C3, NVT_C4, NVT_IRR, NVT_GRAS, NVT_BOGR, &
- NVT_TROG
-!
-!
+ NVT_TROG, NVT_C3W, NVT_C3S, NVT_FLTR, NVT_FLGR
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -121,162 +60,51 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
! -------------------------
!
-REAL, DIMENSION(:), INTENT(IN) :: PSAND ! sand fraction
-REAL, DIMENSION(:), INTENT(IN) :: PCLAY ! clay fraction
-REAL, DIMENSION(:,:), INTENT(IN):: PVEGTYPE ! vegetation type
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
!
-REAL, DIMENSION(:), INTENT(OUT) :: PALBVIS_DRY ! visible, near infra-red and UV
-REAL, DIMENSION(:), INTENT(OUT) :: PALBNIR_DRY ! dry bare soil albedo
-REAL, DIMENSION(:), INTENT(OUT) :: PALBUV_DRY !
-REAL, DIMENSION(:), INTENT(OUT) :: PALBVIS_WET ! visible, near infra-red and UV
-REAL, DIMENSION(:), INTENT(OUT) :: PALBNIR_WET ! wet bare soil albedo
-REAL, DIMENSION(:), INTENT(OUT) :: PALBUV_WET !
+REAL :: ZSUM
+INTEGER :: JJ
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
-IF (LHOOK) CALL DR_HOOK('MODI_DRY_WET_SOIL_ALBEDOS:DRY_WET_SOIL_ALBEDOS_1D',0,ZHOOK_HANDLE)
-PALBVIS_DRY(:) = 0.05 + ( 0.05 + MAX(0.30 * PSAND(:), 0.10) ) &
- * ( 1. - 0.9 * ( PVEGTYPE(:,NVT_C3) &
- + PVEGTYPE(:,NVT_C4) &
- + PVEGTYPE(:,NVT_IRR) &
- + PVEGTYPE(:,NVT_GRAS) &
- + PVEGTYPE(:,NVT_TROG) &
- + PVEGTYPE(:,NVT_PARK) &
- + PVEGTYPE(:,NVT_TRBE) &
- + PVEGTYPE(:,NVT_BONE) &
- + PVEGTYPE(:,NVT_TEBD) &
- + PVEGTYPE(:,NVT_TRBD) &
- + PVEGTYPE(:,NVT_TEBE) &
- + PVEGTYPE(:,NVT_TENE) &
- + PVEGTYPE(:,NVT_BOBD) &
- + PVEGTYPE(:,NVT_BOND) &
- + PVEGTYPE(:,NVT_BOGR) &
- + PVEGTYPE(:,NVT_SHRB))**2 )
-!
-PALBNIR_DRY(:) = PALBVIS_DRY(:) + 0.10
-!
-PALBUV_DRY (:) = 0.06 + 0.14 * PSAND(:)
-!
-PALBVIS_WET(:) = PALBVIS_DRY(:) / 2.
-PALBNIR_WET(:) = PALBNIR_DRY(:) / 2.
-PALBUV_WET (:) = PALBUV_DRY (:) / 2.
-IF (LHOOK) CALL DR_HOOK('MODI_DRY_WET_SOIL_ALBEDOS:DRY_WET_SOIL_ALBEDOS_1D',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE DRY_WET_SOIL_ALBEDOS_1D
-!
-! ##################################################################
- SUBROUTINE DRY_WET_SOIL_ALBEDOS_2D(PSAND,PCLAY, &
- PVEGTYPE, &
- PALBNIR_DRY,PALBVIS_DRY,PALBUV_DRY, &
- PALBNIR_WET,PALBVIS_WET,PALBUV_WET )
-! ##################################################################
-!
-!!**** *DRY_WET_SOIL_ALBEDOS*
-!!
-!! PURPOSE
-!! -------
-! computes the albedo of bare soil, for dry or wet conditions
-!
-!
-!!** METHOD
-!! ------
-!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 17/12/99
-! (V. Masson) 16/02/01 Better fit with ISLSCP2;
-! Ba et al 2001;
-! Pinty et al 2000
-! (V. Masson) Add UV albedo
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_DATA_COVER_PAR, ONLY : NVT_PARK, NVT_TEBD, NVT_BONE, NVT_TRBE, NVT_TRBD, &
- NVT_TEBE, NVT_TENE, NVT_BOBD, NVT_BOND, NVT_SHRB, &
- NVT_C3, NVT_C4, NVT_IRR, NVT_GRAS, NVT_BOGR, &
- NVT_TROG
-!
+IF (LHOOK) CALL DR_HOOK('DRY_WET_SOIL_ALBEDOS',0,ZHOOK_HANDLE)
!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-! -------------------------
+DO JJ=1,SIZE(KK%XVEGTYPE,1)
+ !
+ ZSUM = KK%XVEGTYPE(JJ,NVT_C4) + KK%XVEGTYPE(JJ,NVT_GRAS) + KK%XVEGTYPE(JJ,NVT_TROG) &
+ + KK%XVEGTYPE(JJ,NVT_TRBE) + KK%XVEGTYPE(JJ,NVT_BONE) + KK%XVEGTYPE(JJ,NVT_TEBD) &
+ + KK%XVEGTYPE(JJ,NVT_TRBD) + KK%XVEGTYPE(JJ,NVT_TEBE) + KK%XVEGTYPE(JJ,NVT_TENE) &
+ + KK%XVEGTYPE(JJ,NVT_BOBD) + KK%XVEGTYPE(JJ,NVT_BOND) + KK%XVEGTYPE(JJ,NVT_BOGR) &
+ + KK%XVEGTYPE(JJ,NVT_SHRB)
+ !
+ IF (NVT_C3/=0 .AND. NVT_IRR/=0) THEN
+ ZSUM = ZSUM + KK%XVEGTYPE(JJ,NVT_C3) + KK%XVEGTYPE(JJ,NVT_IRR)
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ ZSUM = ZSUM + KK%XVEGTYPE(JJ,NVT_C3W) + KK%XVEGTYPE(JJ,NVT_C3S)
+ ENDIF
+ !
+ IF (NVT_PARK/=0) THEN
+ ZSUM = ZSUM + KK%XVEGTYPE(JJ,NVT_PARK)
+ ELSEIF (NVT_FLTR/=0 .AND. NVT_FLGR/=0) THEN
+ ZSUM = ZSUM + KK%XVEGTYPE(JJ,NVT_FLTR) + KK%XVEGTYPE(JJ,NVT_FLGR)
+ ENDIF
+ !
+ KK%XALBVIS_DRY(JJ) = 0.05 + ( 0.05 + MAX(0.30 * KK%XSAND(JJ,1), 0.10) ) &
+ * ( 1. - 0.9 * ZSUM**2 )
+ !
+ENDDO
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSAND ! sand fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PCLAY ! clay fraction
-REAL, DIMENSION(:,:,:), INTENT(IN):: PVEGTYPE ! vegetation type
+KK%XALBNIR_DRY(:) = KK%XALBVIS_DRY(:) + 0.10
!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PALBVIS_DRY ! visible, near infra-red and UV
-REAL, DIMENSION(:,:), INTENT(OUT) :: PALBNIR_DRY ! dry bare soil albedo
-REAL, DIMENSION(:,:), INTENT(OUT) :: PALBUV_DRY !
-REAL, DIMENSION(:,:), INTENT(OUT) :: PALBVIS_WET ! visible, near infra-red and UV
-REAL, DIMENSION(:,:), INTENT(OUT) :: PALBNIR_WET ! wet bare soil albedo
-REAL, DIMENSION(:,:), INTENT(OUT) :: PALBUV_WET !
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
+KK%XALBUV_DRY (:) = 0.06 + 0.14 * KK%XSAND(:,1)
!
-IF (LHOOK) CALL DR_HOOK('MODI_DRY_WET_SOIL_ALBEDOS:DRY_WET_SOIL_ALBEDOS_2D',0,ZHOOK_HANDLE)
-PALBVIS_DRY(:,:) = XUNDEF
-PALBNIR_DRY(:,:) = XUNDEF
-PALBUV_DRY (:,:) = XUNDEF
-PALBVIS_WET(:,:) = XUNDEF
-PALBNIR_WET(:,:) = XUNDEF
-PALBUV_WET (:,:) = XUNDEF
+KK%XALBVIS_WET(:) = KK%XALBVIS_DRY(:) / 2.
+KK%XALBNIR_WET(:) = KK%XALBNIR_DRY(:) / 2.
+KK%XALBUV_WET (:) = KK%XALBUV_DRY (:) / 2.
!
-WHERE (PSAND(:,:)/=XUNDEF)
- PALBVIS_DRY(:,:) = 0.05 + ( 0.05 + MAX( 0.30 * PSAND(:,:), 0.10) ) &
- * ( 1. - 0.9 * ( PVEGTYPE(:,:,NVT_C3) &
- + PVEGTYPE(:,:,NVT_C4) &
- + PVEGTYPE(:,:,NVT_IRR) &
- + PVEGTYPE(:,:,NVT_GRAS) &
- + PVEGTYPE(:,:,NVT_TROG) &
- + PVEGTYPE(:,:,NVT_PARK) &
- + PVEGTYPE(:,:,NVT_TRBE) &
- + PVEGTYPE(:,:,NVT_BONE) &
- + PVEGTYPE(:,:,NVT_TEBD) &
- + PVEGTYPE(:,:,NVT_TRBD) &
- + PVEGTYPE(:,:,NVT_TEBE) &
- + PVEGTYPE(:,:,NVT_TENE) &
- + PVEGTYPE(:,:,NVT_BOBD) &
- + PVEGTYPE(:,:,NVT_BOND) &
- + PVEGTYPE(:,:,NVT_BOGR) &
- + PVEGTYPE(:,:,NVT_SHRB))**2 )
- !
- PALBNIR_DRY(:,:) = PALBVIS_DRY(:,:) + 0.10
- !
- PALBUV_DRY (:,:) = 0.06 + 0.14 * PSAND(:,:)
- !
- PALBVIS_WET(:,:) = PALBVIS_DRY(:,:) / 2.
- PALBNIR_WET(:,:) = PALBNIR_DRY(:,:) / 2.
- PALBUV_WET (:,:) = PALBUV_DRY (:,:) / 2.
-END WHERE
-IF (LHOOK) CALL DR_HOOK('MODI_DRY_WET_SOIL_ALBEDOS:DRY_WET_SOIL_ALBEDOS_2D',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('DRY_WET_SOIL_ALBEDOS',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
!
-END SUBROUTINE DRY_WET_SOIL_ALBEDOS_2D
-
+END SUBROUTINE DRY_WET_SOIL_ALBEDOS
diff --git a/src/SURFEX/e_budget.F90 b/src/SURFEX/e_budget.F90
index 298f65156ab17d9cfe80a9cb0f2fc0b0d78f0eae..a717d91e81b0dacd266604e49073136d94ebb081 100644
--- a/src/SURFEX/e_budget.F90
+++ b/src/SURFEX/e_budget.F90
@@ -3,25 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE E_BUDGET(HISBA, HSNOW_ISBA, OFLOOD, OTEMP_ARP, HIMPLICIT_WIND, &
- PTSTEP, PSODELX, PUREF, PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- PVMOD, PCD, &
- PTG, PTSM, PT2M, PSNOWALBM, &
- PSW_RAD, PLW_RAD, PTA, PQA, PPS, PRHOA, &
- PEXNS, PEXNA, PCPS, PLVTT, PLSTT, &
- PVEG, PHUG, PHUI, PHV, &
- PLEG_DELTA, PLEGI_DELTA, &
- PEMIS, PALB, PRA, &
- PCT, PCG, PPSN, PPSNV, PPSNG, &
- PGRNDFLUX, PFLUX_COR, &
- PD_G, PDZG, PDZDIF, PSOILCONDZ, PSOILHCAPZ, &
- PALBT, PEMIST, PQSAT, PDQSAT, &
- PFROZEN1, PTDEEP_A, PTDEEP_B, PGAMMAT, &
- PTA_IC, PQA_IC, PUSTAR2_IC, &
- PSNOWFREE_ALB_VEG, PPSNV_A,PSNOWFREE_ALB_SOIL, &
- PFFG, PFFV, PFF, PFFROZEN, PFALB, PFEMIS, PDEEP_FLUX,&
- PRESTORE )
+ SUBROUTINE E_BUDGET(IO, KK, PK, PEK, DK, DMK, HIMPLICIT_WIND, &
+ PTSTEP, PUREF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, &
+ PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, PVMOD, PTSM, PT2M, &
+ PSW_RAD, PLW_RAD, PTA, PQA, PPS, PRHOA, PEXNS, PEXNA, &
+ PHUI, PLEG_DELTA, PLEGI_DELTA, PGRNDFLUX, PFLUX_COR, &
+ PSOILCONDZ, PSOILHCAPZ, PALBT, PEMIST, PQSAT, PDQSAT, &
+ PFROZEN1, PTDEEP_A,PTA_IC, PQA_IC, PUSTAR2_IC, PDEEP_FLUX, &
+ PRESTORE )
! ##########################################################################
!
!!**** *E_BUDGET*
@@ -56,7 +45,7 @@
!! ---------
!!
!! Noilhan and Planton (1989)
-!! Belair (1995)
+!! Belair (199:)
!!
!! AUTHOR
!! ------
@@ -92,6 +81,11 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_DIAG_n, ONLY : DIAG_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
+!
USE MODD_CSTS, ONLY : XLVTT, XLSTT, XSTEFAN, XCPD, XPI, XDAY, &
XTT, XCL, XCPV, XCI
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -112,51 +106,33 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-!
- CHARACTER(LEN=*), INTENT(IN) :: HISBA ! type of soil (Force-Restore OR Diffusion)
-! ! '2-L'
-! ! '3-L'
-! ! 'DIF' ISBA-DF
-!
- CHARACTER(LEN=*), INTENT(IN) :: HSNOW_ISBA ! 'DEF' = Default F-R snow scheme
-! ! (Douville et al. 1995)
-! ! '3-L' = 3-L snow scheme (option)
-! ! (Boone and Etchevers 2000)
-LOGICAL, INTENT(IN) :: OFLOOD ! Activation of the flooding scheme
-LOGICAL, INTENT(IN) :: OTEMP_ARP ! True = time-varying force-restore soil temperature (as in ARPEGE)
- ! False = No time-varying force-restore soil temperature (Default)
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(DIAG_t), INTENT(INOUT) :: DK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK
!
CHARACTER(LEN=*), INTENT(IN) :: HIMPLICIT_WIND ! wind implicitation option
! ! 'OLD' = direct
! ! 'NEW' = Taylor serie, order 1
-!
REAL, INTENT(IN) :: PTSTEP
! timestep of the integration
-!!
-REAL, DIMENSION(:), INTENT (IN) :: PSODELX ! Pulsation for each layer (Only used if LTEMP_ARP=True)
-
-!
REAL, DIMENSION(:), INTENT(IN) :: PUREF ! reference height of the wind
-REAL, DIMENSION(:), INTENT(IN) :: PSNOWALBM
-! prognostic variables at time 't-dt'
-! PSNOWALBM = albedo of the snow
-!
-!
-REAL, DIMENSION(:), INTENT (IN) :: PSW_RAD, PLW_RAD, PPS, PRHOA, PTA, PQA, PCD, PVMOD
+REAL, DIMENSION(:), INTENT (IN) :: PSW_RAD, PLW_RAD, PPS, PRHOA, PTA, PQA, PVMOD
! PSW_RAD = incoming solar radiation
! PLW_RAD = atmospheric infrared radiation
! PRHOA = near-ground air density
! PPS = surface pressure
! PTA = near-ground air temperature
! PQA = near-ground air specific humidity
-! PCD = drag coefficient
! PVMOD = wind speed
!
! implicit atmospheric coupling coefficients:
!
REAL, DIMENSION(:), INTENT(IN) :: PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
- PPEQ_B_COEF
+ PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
+ PPEQ_B_COEF
! PPEW_A_COEF = A-wind coefficient (m2s/kg)
! PPEW_B_COEF = B-wind coefficient (m/s)
! PPET_A_COEF = A-air temperature coefficient
@@ -165,40 +141,13 @@ REAL, DIMENSION(:), INTENT(IN) :: PPEW_A_COEF, PPEW_B_COEF, &
! PPEQ_B_COEF = B-air specific humidity coefficient
!
REAL, DIMENSION(:), INTENT(IN) :: PEXNS, PEXNA
-REAL, DIMENSION(:), INTENT(IN) :: PVEG, PHUG, PHUI, PHV
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS, PALB, PCT, PCG
-REAL, DIMENSION(:), INTENT(IN) :: PPSNV, PPSNG, PPSN
-! PVEG = fraction of vegetation
-! PHUG = relative humidity of the soil
-! PHV = Halstead coefficient
-! PEMIS = emissivity
-! PALB = albedo
-! PCT = area-averaged heat capacity
-! PCG = heat capacity of the ground
-! PPSN = grid fraction covered by snow
-! PPSNV = fraction of the vegetation covered by snow
-! PPSNG = fraction of the ground covered by snow
+REAL, DIMENSION(:), INTENT(IN) :: PHUI
!
REAL, DIMENSION(:), INTENT(IN) :: PFROZEN1
! PFROZEN1 = ice fraction in supurficial soil
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTDEEP_A, PTDEEP_B, PGAMMAT
+REAL, DIMENSION(:), INTENT(IN) :: PTDEEP_A
! PTDEEP_A = Deep soil temperature
! coefficient depending on flux
-! PTDEEP_B = Deep soil temperature (prescribed)
-! which models heating/cooling from
-! below the diurnal wave penetration
-! (surface temperature) depth. If it
-! is FLAGGED as undefined, then the zero
-! flux lower BC is applied.
-! Tdeep = PTDEEP_B + PTDEEP_A * PDEEP_FLUX
-! (with PDEEP_FLUX in W/m2)
-! PGAMMAT = Deep soil heat transfer coefficient:
-! assuming homogeneous soil so that
-! this can be prescribed in units of
-! (1/days): associated time scale with
-! PTDEEP.
-!
REAL, DIMENSION(:), INTENT(IN) :: PGRNDFLUX
! PGRNDFLUX = soil/snow interface flux (W/m2) using
! ISBA-SNOW3L option
@@ -206,17 +155,9 @@ REAL, DIMENSION(:), INTENT(IN) :: PGRNDFLUX
REAL, DIMENSION(:,:), INTENT(IN) :: PFLUX_COR
! PFLUX_COR = correction flux to conserve energy (W/m2)
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_G, PSOILCONDZ, PSOILHCAPZ
-! PD_G = Depth of bottom of Soil layers (m)
+REAL, DIMENSION(:,:), INTENT(IN) :: PSOILCONDZ, PSOILHCAPZ
! PSOILCONDZ= ISBA-DF Soil conductivity profile [W/(m K)]
! PSOILHCAPZ=ISBA-DF Soil heat capacity profile [J/(m3 K)]
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZG ! soil layers thicknesses (DIF option) (m)
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZDIF ! distance between consecuative layer mid-points (DIF option) (m)
-!
-!
-REAL, DIMENSION(:), INTENT(IN) :: PSNOWFREE_ALB_VEG !snow free albedo of vegetation for EBA
-REAL, DIMENSION(:), INTENT(IN) :: PSNOWFREE_ALB_SOIL !snow free albedo of soil for EBA option
-REAL, DIMENSION(:), INTENT(IN) :: PPSNV_A !fraction of the the vegetation covered by snow for EBA scheme
!
REAL, DIMENSION(:), INTENT(INOUT) :: PLEG_DELTA, PLEGI_DELTA
! PLEG_DELTA = soil evaporation delta fn
@@ -229,22 +170,12 @@ REAL, DIMENSION(:), INTENT (OUT) :: PQA_IC, PTA_IC, PUSTAR2_IC
! (modified if implicit coupling with
! atmosphere used)
!
-REAL, DIMENSION(:), INTENT(IN) :: PRA
-! PRA = aerodynamic surface resistance for
-! heat transfers
-!
-REAL, DIMENSION(:,:), INTENT(INOUT):: PTG
-! PTG = soil temperature profile (K)
-!
REAL, DIMENSION(:), INTENT (IN) :: PTSM, PT2M
! PTSM = surface temperature at start
! of time step (K)
! PT2M = mean surface (or restore) temperature at start
! of time step (K)
!
-REAL, DIMENSION(:), INTENT(INOUT) :: PCPS
-! PCPS = heat capacity at surface
-!
REAL, DIMENSION(:), INTENT(OUT) :: PALBT, PEMIST, PDQSAT
! PALBT = averaged albedo
! PEMIST = averaged emissivity
@@ -252,15 +183,6 @@ REAL, DIMENSION(:), INTENT(OUT) :: PALBT, PEMIST, PDQSAT
REAL, DIMENSION(:), INTENT(IN) :: PQSAT
! PQSAT = saturation vapor humidity
!
-REAL, DIMENSION(:), INTENT(IN) :: PFFV, PFF, PFFG, PFALB, PFEMIS, PFFROZEN
-! PFFG = Floodplain fraction over ground
-! PFFV = Floodplain fraction over vegetation
-! PFF = Floodplain fraction at the surface
-! PFALB = Floodplain albedo
-! PFEMIS= Floodplain emis
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PLSTT, PLVTT
-!
REAL, DIMENSION(:), INTENT(OUT) :: PDEEP_FLUX ! Heat flux at bottom of ISBA (W/m2)
!
REAL, DIMENSION(:), INTENT(OUT) :: PRESTORE
@@ -269,19 +191,19 @@ REAL, DIMENSION(:), INTENT(OUT) :: PRESTORE
!* 0.2 declarations of local variables
!
!
-REAL, DIMENSION(SIZE(PALB)) :: ZRORA, &
+REAL, DIMENSION(SIZE(PEK%XSNOWFREE_ALB)) :: ZRORA, &
! rhoa / ra
!
- ZA,ZB,ZC
+ ZA,ZB,ZC
! terms for the calculation of Ts(t)
!
! ISBA-DF:
!
-REAL, DIMENSION(SIZE(PALB)) :: ZCONDAVG, ZCOND1, ZCOND2, ZTERM2, ZTERM1
+REAL, DIMENSION(SIZE(PEK%XSNOWFREE_ALB)) :: ZCONDAVG, ZCOND1, ZCOND2, ZTERM2, ZTERM1
!
! implicit atmospheric coupling coefficients: (modified-form)
!
-REAL, DIMENSION(SIZE(PALB)) :: ZPET_A_COEF, ZPEQ_A_COEF, ZPET_B_COEF, &
+REAL, DIMENSION(SIZE(PEK%XSNOWFREE_ALB)) :: ZPET_A_COEF, ZPEQ_A_COEF, ZPET_B_COEF, &
ZPEQ_B_COEF, Z_CCOEF, ZHUMS, ZHUMA, ZLAVG, &
ZHUMSD, ZHUMAD
! ZPET_A_COEF = A-air temperature coefficient
@@ -290,11 +212,11 @@ REAL, DIMENSION(SIZE(PALB)) :: ZPET_A_COEF, ZPEQ_A_COEF, ZPET_B_COEF, &
! ZPEQ_B_COEF = B-air specific humidity coefficient
! Z_CCOEF = C-working variable
!
-REAL, DIMENSION(SIZE(PALB)) :: ZUSTAR2, ZVMOD
+REAL, DIMENSION(SIZE(PEK%XSNOWFREE_ALB)) :: ZUSTAR2, ZVMOD
! ZUSTAR2 = friction (m2/s2)
! ZVMOD = wind modulus (m/s)
-REAL, DIMENSION(SIZE(PALB)) :: ZXCPV_XCL_AVG
-REAL, DIMENSION(SIZE(PALB)) :: ZCNHUMA, ZPEQA2, ZDPQB, ZCDQSAT, ZINCR, ZTRAD, &
+REAL, DIMENSION(SIZE(PEK%XSNOWFREE_ALB)) :: ZXCPV_XCL_AVG
+REAL, DIMENSION(SIZE(PEK%XSNOWFREE_ALB)) :: ZCNHUMA, ZPEQA2, ZDKQB, ZCDQSAT, ZINCR, ZTRAD, &
ZCHUMS, ZCHUMA, ZPETA2, ZPETB2,ZTEMP, ZFGNFRZ, &
ZFGFRZ, ZFV, ZFG, ZFNFRZ, ZFFRZ, ZFNSNOW, ZCPS,&
ZLVTT, ZLSTT
@@ -323,13 +245,13 @@ ZHUMAD(:) = 0.0
!
! function dqsat(Ts,ps)
!
-PDQSAT(:) = DQSAT(PTG(:,1),PPS(:),PQSAT(:))
+PDQSAT(:) = DQSAT(PEK%XTG(:,1),PPS(:),PQSAT(:))
! function zrsra
!
! Modify flux-form implicit coupling coefficients:
! - wind components:
!
-ZTEMP (:) = PCD(:)*PVMOD(:)
+ZTEMP (:) = DK%XCD(:)*PVMOD(:)
!
IF(HIMPLICIT_WIND=='OLD')THEN
! old implicitation (m2/s2)
@@ -349,7 +271,7 @@ ENDWHERE
!
ZUSTAR2(:) = MAX(ZUSTAR2(:),0.)
!
-ZRORA(:) = PRHOA(:) / PRA(:)
+ZRORA(:) = PRHOA(:) / PEK%XRESA(:)
!
! terms za, zb, and zc for the
! calculation of ts(t)
@@ -371,14 +293,14 @@ ZPET_B_COEF(:) = PPET_B_COEF(:)/Z_CCOEF(:)
!
! - air specific humidity:
!
-ZFV(:) = PVEG(:) * (1-PPSNV(:)-PFFV(:))
-ZFG(:) = (1.-PVEG(:))*(1.-PPSNG(:)-PFFG(:))
-ZFNFRZ(:) = (1.-PFFROZEN(:))*PFF(:) + ZFV + ZFG(:)*(1.-PFROZEN1(:))
-ZFFRZ(:) = PFFROZEN(:)*PFF(:) + ZFG(:)*PFROZEN1(:) + PPSN(:)
+ZFV(:) = PEK%XVEG(:) *(1-PEK%XPSNV(:)-KK%XFFV(:))
+ZFG(:) = (1.-PEK%XVEG(:))*(1.-PEK%XPSNG(:)-KK%XFFG(:))
+ZFNFRZ(:) = (1.-KK%XFFROZEN(:))*KK%XFF(:) + ZFV + ZFG(:)*(1.-PFROZEN1(:))
+ZFFRZ(:) = KK%XFFROZEN(:) *KK%XFF(:) + ZFG(:)*PFROZEN1(:) + PEK%XPSN(:)
!
-ZSNOW=1.
-ZFNSNOW(:)=1.
-ZCPS(:)=PCPS(:)
+ZSNOW = 1.
+ZFNSNOW(:) = 1.
+ZCPS(:) = PK%XCPS(:)
!
IF (LCPL_ARP) THEN
@@ -388,17 +310,17 @@ IF (LCPL_ARP) THEN
PLEG_DELTA(:) = 1.0
PLEGI_DELTA(:) = 1.0
- ZLAVG(:) = PLVTT(:)*ZFNFRZ(:) + PLSTT(:)*ZFFRZ(:)
- ZXCPV_XCL_AVG(:)= (XCPV-XCL)*ZFNFRZ(:) + (XCPV-XCI)*ZFFRZ(:)
+ ZLAVG(:) = PK%XLVTT(:)*ZFNFRZ(:) + PK%XLSTT(:)*ZFFRZ(:)
+ ZXCPV_XCL_AVG(:)= (XCPV-XCL)*ZFNFRZ(:) + (XCPV-XCI) *ZFFRZ(:)
ZLVTT(:) = ZLAVG(:)
ZLSTT(:) = ZLAVG(:)
ELSE
- IF(HSNOW_ISBA == '3-L' .OR. HSNOW_ISBA == 'CRO' .OR. HISBA == 'DIF')THEN
+ IF(PEK%TSNOW%SCHEME == '3-L' .OR. PEK%TSNOW%SCHEME == 'CRO' .OR. IO%CISBA == 'DIF')THEN
ZSNOW = 0.
- ZFNSNOW(:) = 1. - PPSN(:)
+ ZFNSNOW(:) = 1. - PEK%XPSN(:)
ZCPS(:)=XCPD
ENDIF
@@ -409,21 +331,21 @@ ELSE
ENDIF
!
-ZFGNFRZ(:) = ZFG(:)*(1.-PFROZEN1(:))*PLEG_DELTA(:)
-ZFGFRZ(:) = ZFG(:)*PFROZEN1(:)*PLEGI_DELTA(:)
+ZFGNFRZ(:) = ZFG(:) * (1.-PFROZEN1(:)) * PLEG_DELTA(:)
+ZFGFRZ (:) = ZFG(:) * PFROZEN1(:) * PLEGI_DELTA(:)
!
-ZHUMA(:) = ZLVTT(:)/ZLAVG(:) * ((1.-PFFROZEN(:))*PFF(:) + ZFV(:)*PHV(:) + ZFGNFRZ(:)) + &
- ZLSTT(:)/ZLAVG(:) * (PFFROZEN(:)*PFF(:) + ZFGFRZ(:) + ZSNOW*PPSN(:) )
+ZHUMA(:) = ZLVTT(:)/ZLAVG(:) * ((1.-KK%XFFROZEN(:))*KK%XFF(:) + ZFV(:)*DMK%XHV(:) + ZFGNFRZ(:)) + &
+ ZLSTT(:)/ZLAVG(:) * (KK%XFFROZEN(:) *KK%XFF(:) + ZFGFRZ(:) + ZSNOW*PEK%XPSN(:) )
!
-ZHUMS(:) = ZLVTT(:)/ZLAVG(:) * ((1.-PFFROZEN(:))*PFF(:) + ZFV(:)*PHV(:) + ZFGNFRZ(:)*PHUG(:)) + &
- ZLSTT(:)/ZLAVG(:) * (PFFROZEN(:)*PFF(:) + ZFGFRZ(:)*PHUI(:) + ZSNOW*PPSN(:) )
+ZHUMS(:) = ZLVTT(:)/ZLAVG(:) * ((1.-KK%XFFROZEN(:))*KK%XFF(:) + ZFV(:)*DMK%XHV(:) + ZFGNFRZ(:)*DK%XHUG(:)) + &
+ ZLSTT(:)/ZLAVG(:) * (KK%XFFROZEN(:) *KK%XFF(:) + ZFGFRZ(:)*PHUI(:) + ZSNOW*PEK%XPSN(:) )
!
-IF(HSNOW_ISBA == '3-L' .OR. HSNOW_ISBA == 'CRO' .OR. HISBA == 'DIF')THEN
+IF(PEK%TSNOW%SCHEME == '3-L' .OR. PEK%TSNOW%SCHEME == 'CRO' .OR. IO%CISBA == 'DIF')THEN
!
! humidity considering no snow (done elsewhere) and flooded zones:
!
- ZHUMAD(:) = PFF(:) + ZFV(:)*PHV(:) + ZFGNFRZ(:) + ZFGFRZ(:)
- ZHUMSD(:) = PFF(:) + ZFV(:)*PHV(:) + ZFGNFRZ(:)*PHUG(:) + ZFGFRZ(:)*PHUI(:)
+ ZHUMAD(:) = KK%XFF(:) + ZFV(:)*DMK%XHV(:) + ZFGNFRZ(:) + ZFGFRZ(:)
+ ZHUMSD(:) = KK%XFF(:) + ZFV(:)*DMK%XHV(:) + ZFGNFRZ(:)*DK%XHUG(:) + ZFGFRZ(:)*PHUI(:)
ELSE
ZHUMAD(:) = ZHUMA(:)
ZHUMSD(:) = ZHUMS(:)
@@ -441,8 +363,7 @@ Z_CCOEF(:) = 1.0 - ZTEMP(:)*ZHUMAD(:)
!
ZPEQ_A_COEF(:) = - ZTEMP(:)*PDQSAT(:)*ZHUMSD(:)/Z_CCOEF(:)
!
-ZPEQ_B_COEF(:) = ( PPEQ_B_COEF(:) - ZTEMP(:)*ZHUMSD(:)* &
- (PQSAT(:) - PDQSAT(:)*PTG(:,1)) )/Z_CCOEF(:)
+ZPEQ_B_COEF(:) = ( PPEQ_B_COEF(:) - ZTEMP(:)*ZHUMSD(:)* (PQSAT(:) - PDQSAT(:)*PEK%XTG(:,1)) )/Z_CCOEF(:)
!
!-------------------------------------------------------------------------------
!
@@ -450,28 +371,28 @@ ZPEQ_B_COEF(:) = ( PPEQ_B_COEF(:) - ZTEMP(:)*ZHUMSD(:)* &
! ---------------------------
!
!
-IF(HSNOW_ISBA == '3-L' .OR. HSNOW_ISBA == 'CRO' .OR. HISBA == 'DIF')THEN
+IF(PEK%TSNOW%SCHEME == '3-L' .OR. PEK%TSNOW%SCHEME == 'CRO' .OR. IO%CISBA == 'DIF')THEN
!
! NON-SNOW covered Grid averaged albedo and emissivity for explicit
! snow scheme
!
- IF(.NOT.OFLOOD)THEN
+ IF(.NOT.IO%LFLOOD)THEN
!
- PALBT (:) = PALB (:)
- PEMIST(:) = PEMIS(:)
+ PALBT (:) = PEK%XSNOWFREE_ALB(:)
+ PEMIST(:) = PEK%XEMIS(:)
!
ELSE
!
! Taking into account the floodplains with snow grid fractions :
-! PFF 1.-PFF-PPSN PPSN
+! PFF 1.-PFF-PEK%XPSN(:) PEK%XPSN(:)
! |------------|----|---------------|
!
- WHERE(PPSN(:)<1.0)
- PALBT (:) = ((1.-PFF(:)-PPSN(:))*PALB(:) + PFF(:)*PFALB (:))/(1.-PPSN(:))
- PEMIST(:) = ((1.-PFF(:)-PPSN(:))*PEMIS(:) + PFF(:)*PFEMIS(:))/(1.-PPSN(:))
+ WHERE(PEK%XPSN(:)<1.0)
+ PALBT (:) = ((1.-KK%XFF(:)-PEK%XPSN(:))*PEK%XSNOWFREE_ALB(:) + KK%XFF(:)*KK%XALBF(:) )/(1.-PEK%XPSN(:))
+ PEMIST(:) = ((1.-KK%XFF(:)-PEK%XPSN(:))*PEK%XEMIS(:) + KK%XFF(:)*KK%XEMISF(:))/(1.-PEK%XPSN(:))
ELSEWHERE
- PALBT (:) = PALB (:)
- PEMIST(:) = PEMIS(:)
+ PALBT (:) = PEK%XSNOWFREE_ALB(:)
+ PEMIST(:) = PEK%XEMIS(:)
ENDWHERE
!
ENDIF
@@ -481,19 +402,22 @@ ELSE
!
! Grid averaged albedo and emissivity for composite snow scheme:
!
- IF(HSNOW_ISBA=='EBA') THEN
+ IF(PEK%TSNOW%SCHEME=='EBA') THEN
!
- PALBT(:) = (1-PVEG(:))*(PSNOWFREE_ALB_SOIL(:)*(1-PPSNG(:))+PSNOWALBM(:)*PPSNG(:)) + &
- PVEG(:)*(PSNOWFREE_ALB_VEG(:)*(1-PPSNV_A(:)) + &
- PSNOWALBM(:)*PPSNV_A(:))
+ PALBT(:) = (1-PEK%XVEG(:)) * (PEK%XSNOWFREE_ALB_SOIL(:)*(1-PEK%XPSNG(:)) + &
+ PEK%TSNOW%ALB(:)*PEK%XPSNG(:)) + &
+ PEK%XVEG(:) * (PEK%XSNOWFREE_ALB_VEG (:)*(1-PEK%XPSNV_A(:)) + &
+ PEK%TSNOW%ALB(:)*PEK%XPSNV_A(:))
!
- PEMIST(:) = PEMIS(:)-PPSN(:)*(PEMIS(:)-XEMCRIN)
+ PEMIST(:) = PEK%XEMIS(:)-PEK%XPSN(:)*(PEK%XEMIS(:)-XEMCRIN)
!
ELSE
!
- PALBT (:) = ( 1.-PPSN(:)-PFF(:))*PALB(:) + PPSN(:)*PSNOWALBM(:) + PFF(:)*PFALB(:)
+ PALBT (:) = ( 1.-PEK%XPSN(:)-KK%XFF(:))* PEK%XSNOWFREE_ALB(:) + &
+ PEK%XPSN(:) * PEK%TSNOW%ALB(:) + KK%XFF(:)*KK%XALBF(:)
!
- PEMIST(:) = ( 1.-PPSN(:)-PFF(:))*PEMIS(:) + PPSN(:)*XEMISSN + PFF(:)*PFEMIS(:)
+ PEMIST(:) = ( 1.-PEK%XPSN(:)-KK%XFF(:))* PEK%XEMIS(:) + &
+ PEK%XPSN(:) * XEMISSN + KK%XFF(:)*KK%XEMISF(:)
!
ENDIF
@@ -507,7 +431,7 @@ ENDIF
! 5.1. Default
! ------------
!
-ZTRAD(:) = PEMIST(:) * XSTEFAN * (PTG(:,1)**3)
+ZTRAD(:) = PEMIST(:) * XSTEFAN * (PEK%XTG(:,1)**3)
ZCHUMS(:) = ZRORA(:)*ZLAVG(:)*ZHUMS(:)
ZCHUMA(:) = ZRORA(:)*ZLAVG(:)*ZHUMA(:)
!
@@ -524,26 +448,26 @@ ZPETB2(:) = ZPET_B_COEF(:)/PEXNA(:)
! is OFF because the corresponding energy should be compensated for
! (but code is retained for possible future activation).
!
-ZA(:) = 1. / PTSTEP + PCT(:) * &
+ZA(:) = 1. / PTSTEP + DMK%XCT(:) * &
((ZFNSNOW(:) * &
( 4.*ZTRAD(:) + ZRORA(:)*ZCPS(:)*ZPETA2(:) )) &
+ ZCHUMS(:)*PDQSAT(:) - ZCHUMA(:)*ZPEQ_A_COEF(:)) &
+ 2. * XPI / XDAY
!
-ZB(:) = 1. / PTSTEP + PCT(:) * ( ZFNSNOW(:)* 3.*ZTRAD(:) + ZCHUMS(:)*PDQSAT(:) )
+ZB(:) = 1. / PTSTEP + DMK%XCT(:) * ( ZFNSNOW(:)* 3.*ZTRAD(:) + ZCHUMS(:)*PDQSAT(:) )
!
-ZC(:) = 2. * XPI * PTG(:,2) / XDAY + PCT(:) * &
+ZC(:) = 2. * XPI * PEK%XTG(:,2) / XDAY + DMK%XCT(:) * &
( ZFNSNOW(:) * &
( ZRORA(:)*ZCPS(:)*ZPETB2(:) &
+ PSW_RAD(:)*(1.-PALBT(:)) + PLW_RAD(:)*PEMIST(:)) &
- (ZCHUMS(:)*PQSAT(:) - ZCHUMA(:)*ZPEQ_B_COEF(:)))
!
-IF(HSNOW_ISBA == '3-L' .OR. HSNOW_ISBA == 'CRO' .OR. HISBA == 'DIF')THEN
+IF(PEK%TSNOW%SCHEME == '3-L' .OR. PEK%TSNOW%SCHEME == 'CRO' .OR. IO%CISBA == 'DIF')THEN
!
-! 5.2. With CSNOW=SNOW3L or CSNOW=CRO or HISBA=DIF
+! 5.2. With CSNOW=SNOW3L or CSNOW=CRO or IO%CISBA=DIF
! -------------------------------------------------
!
- ZC(:) = ZC(:) + PCT(:)*(PPSN(:)*PGRNDFLUX(:)+PFLUX_COR(:,1))
+ ZC(:) = ZC(:) + DMK%XCT(:)*(PEK%XPSN(:)*PGRNDFLUX(:)+PFLUX_COR(:,1))
!
ELSEIF (LCPL_ARP) THEN
!
@@ -551,10 +475,10 @@ ELSEIF (LCPL_ARP) THEN
! ----------------
!
ZCDQSAT(:) = (XCPV-XCPD)*ZHUMS(:)*PDQSAT(:)
-ZINCR(:)= PCT(:) * ZRORA(:) * &
- (ZCDQSAT(:) * ( ZPETA2(:)*PTG(:,1) - ZPETB2(:)) + &
- ZXCPV_XCL_AVG(:) * &
- (ZHUMS(:)*PQSAT(:) - ZHUMA(:) * (ZPEQ_B_COEF(:) + ZPEQ_A_COEF(:) * PTG(:,1))))
+ZINCR(:)= DMK%XCT(:) * ZRORA(:) * &
+ (ZCDQSAT(:) * ( ZPETA2(:)*PEK%XTG(:,1) - ZPETB2(:)) + &
+ ZXCPV_XCL_AVG(:) * &
+ (ZHUMS(:)*PQSAT(:) - ZHUMA(:) * (ZPEQ_B_COEF(:) + ZPEQ_A_COEF(:) * PEK%XTG(:,1))))
! Surface Energy Budget linearization coefficients for a composite
! (soil-vegetation-flood-snow) energy budget: composite fluxes "felt" by
@@ -572,16 +496,16 @@ ZINCR(:)= PCT(:) * ZRORA(:) * &
! ------------------------
!
ZCNHUMA(:)=(XCPV-XCPD)*(1.-ZHUMA(:))
- ZPEQA2(:)=ZCNHUMA(:)*ZPEQ_A_COEF(:)*ZPETA2(:)*PTG(:,1)
- ZDPQB(:)=ZPEQ_B_COEF(:)-PQA(:)
+ ZPEQA2(:)=ZCNHUMA(:)*ZPEQ_A_COEF(:)*ZPETA2(:)*PEK%XTG(:,1)
+ ZDKQB(:)=ZPEQ_B_COEF(:)-PQA(:)
- ZA(:) = ZA(:) + PCT(:) * ZRORA(:) * &
+ ZA(:) = ZA(:) + DMK%XCT(:) * ZRORA(:) * &
(2.* ZPEQA2(:) + &
- ZCNHUMA(:) * (ZDPQB(:)*ZPETA2(:) - ZPEQ_A_COEF(:)*ZPETB2(:) ))
+ ZCNHUMA(:) * (ZDKQB(:)*ZPETA2(:) - ZPEQ_A_COEF(:)*ZPETB2(:) ))
- ZB(:) = ZB(:) + PCT(:) * ZRORA(:) * ZPEQA2(:)
+ ZB(:) = ZB(:) + DMK%XCT(:) * ZRORA(:) * ZPEQA2(:)
- ZC(:) = ZC(:) + PCT(:)*ZRORA(:)*ZCNHUMA(:) *ZDPQB(:)*ZPETB2(:)
+ ZC(:) = ZC(:) + DMK%XCT(:)*ZRORA(:)*ZCNHUMA(:) *ZDKQB(:)*ZPETB2(:)
ENDIF
ENDIF
@@ -592,59 +516,59 @@ ENDIF
!* 6. T AT TIME 'T+DT' (before snowmelt or soil ice evolution)
! -----------------
!
-IF(HISBA == 'DIF')THEN
+IF(IO%CISBA == 'DIF')THEN
!
! First determine terms needed for implicit linearization of surface:
!
! We use harmonic mean to compute the thermal conductivity at the layers interface
!
- ZCOND1(:) = PDZG(:,1)/((PDZG(:,1)+PDZG(:,2))*PSOILCONDZ(:,1))
- ZCOND2(:) = PDZG(:,2)/((PDZG(:,1)+PDZG(:,2))*PSOILCONDZ(:,2))
+ ZCOND1(:) = PK%XDZG(:,1)/((PK%XDZG(:,1)+PK%XDZG(:,2))*PSOILCONDZ(:,1))
+ ZCOND2(:) = PK%XDZG(:,2)/((PK%XDZG(:,1)+PK%XDZG(:,2))*PSOILCONDZ(:,2))
!
ZCONDAVG(:) = 1.0/(ZCOND1(:)+ZCOND2(:))
!
- ZA(:) = ZA(:) - (2. * XPI / XDAY) + ZCONDAVG(:)*PCG(:)/PDZDIF(:,1)
- ZTERM2(:) = ZCONDAVG(:)*PCG(:)/(ZA(:)*PDZDIF(:,1))
- ZTERM1(:) = (PTG(:,1)*ZB(:) + (ZC(:) - (2. * XPI * PTG(:,2) / XDAY)) )/ZA(:)
+ ZA(:) = ZA(:) - (2. * XPI / XDAY) + ZCONDAVG(:)*DMK%XCG(:)/PK%XDZDIF(:,1)
+ ZTERM2(:) = ZCONDAVG(:)*DMK%XCG(:)/(ZA(:)*PK%XDZDIF(:,1))
+ ZTERM1(:) = (PEK%XTG(:,1)*ZB(:) + (ZC(:) - (2. * XPI * PEK%XTG(:,2) / XDAY)) )/ZA(:)
!
! Determine the soil temperatures:
!
- CALL SOIL_HEATDIF(PTSTEP,PDZG,PDZDIF,PSOILCONDZ, &
- PSOILHCAPZ,PCG,ZTERM1,ZTERM2, &
- PTDEEP_A,PTDEEP_B,PTG,PDEEP_FLUX, &
- PFLUX_COR )
+ CALL SOIL_HEATDIF(PTSTEP,PK%XDZG(:,:),PK%XDZDIF(:,:),PSOILCONDZ, &
+ PSOILHCAPZ,DMK%XCG,ZTERM1,ZTERM2, PTDEEP_A, &
+ KK%XTDEEP, PEK%XTG(:,:), PDEEP_FLUX, PFLUX_COR )
!
!
! "Restore" flux here is actually the heat flux between the surface
! and sub-surface layers (W m-2):
!
- PRESTORE(:) = ZCONDAVG(:)*(PTG(:,1)-PTG(:,2))/PDZDIF(:,1)
+ PRESTORE(:) = ZCONDAVG(:)*(PEK%XTG(:,1)-PEK%XTG(:,2))/PK%XDZDIF(:,1)
!
ELSE
!
- IF(OTEMP_ARP)THEN
+ IF(IO%LTEMP_ARP)THEN
!
- CALL SOIL_TEMP_ARP(PTSTEP,ZA,ZB,ZC,PGAMMAT,PTDEEP_B,PSODELX,PTG)
+ CALL SOIL_TEMP_ARP(PTSTEP,ZA,ZB,ZC,KK%XGAMMAT,KK%XTDEEP,IO%XSODELX,PEK%XTG(:,:))
!
! "Restore" flux between surface and deep layer(W m-2):
- PRESTORE(:)=2.0*XPI*(PTG(:,1)-PTG(:,2))/(PCT(:)*XDAY*PSODELX(1)*(PSODELX(1)+PSODELX(2)))
+ PRESTORE(:) = 2.0 * XPI * (PEK%XTG(:,1)-PEK%XTG(:,2)) / &
+ ( DMK%XCT(:)*XDAY*IO%XSODELX(1)*(IO%XSODELX(1)+IO%XSODELX(2)) )
!
- ELSE
+ ELSE
!
- PTG(:,1) = ( PTG(:,1)*ZB(:) + ZC(:) ) / ZA(:)
+ PEK%XTG(:,1) = ( PEK%XTG(:,1)*ZB(:) + ZC(:) ) / ZA(:)
!
- WHERE(PTDEEP_B(:) /= XUNDEF .AND. PGAMMAT(:) /= XUNDEF)
- PTG(:,2) = (PTG(:,2) + (PTSTEP/XDAY)*(PTG(:,1) + PGAMMAT(:)*PTDEEP_B(:)))/ &
- (1.+(PTSTEP/XDAY)*(1.0+PGAMMAT(:)))
- ELSEWHERE
- PTG(:,2) = (PTG(:,2) + (PTSTEP/XDAY)*PTG(:,1))/ &
+ WHERE(KK%XTDEEP(:) /= XUNDEF .AND. KK%XGAMMAT(:) /= XUNDEF)
+ PEK%XTG(:,2) = (PEK%XTG(:,2) + (PTSTEP/XDAY)*(PEK%XTG(:,1) + KK%XGAMMAT(:)*KK%XTDEEP(:))) / &
+ (1.+(PTSTEP/XDAY)*(1.0+KK%XGAMMAT(:)))
+ ELSEWHERE
+ PEK%XTG(:,2) = (PEK%XTG(:,2) + (PTSTEP/XDAY)*PEK%XTG(:,1)) / &
(1.+(PTSTEP/XDAY) )
- END WHERE
+ END WHERE
!
! "Restore" flux between surface and deep layer(W m-2):
- PRESTORE(:) = 2.0*XPI*(PTG(:,1)-PT2M(:))/(PCT(:)*XDAY)
+ PRESTORE(:) = 2.0*XPI*(PEK%XTG(:,1)-PT2M(:))/(DMK%XCT(:)*XDAY)
!
- ENDIF
+ ENDIF
!
ENDIF
!
@@ -654,9 +578,9 @@ ENDIF
! (QA and TA are only modified by these expressions
! if the implicit atmospheric coupling is used)
!
-PQA_IC(:) = ZPEQ_A_COEF(:)*PTG(:,1) + ZPEQ_B_COEF(:)
+PQA_IC(:) = ZPEQ_A_COEF(:)*PEK%XTG(:,1) + ZPEQ_B_COEF(:)
!
-PTA_IC(:) = ZPET_A_COEF(:)*PTG(:,1) + ZPET_B_COEF(:)
+PTA_IC(:) = ZPET_A_COEF(:)*PEK%XTG(:,1) + ZPET_B_COEF(:)
!
PUSTAR2_IC(:) = ZUSTAR2(:)
!
@@ -667,18 +591,18 @@ PUSTAR2_IC(:) = ZUSTAR2(:)
IF (LCPL_ARP) THEN
IF (.NOT.LQVNPLUS) THEN
- PCPS(:) = PCPS(:) + (XCPV-XCPD) *ZHUMS(:)*PDQSAT(:)*(PTG(:,1)-PTSM(:))
+ PK%XCPS(:) = PK%XCPS(:) + (XCPV-XCPD) *ZHUMS(:)*PDQSAT(:)*(PEK%XTG(:,1)-PTSM(:))
ENDIF
IF (LQVNPLUS) THEN
- PCPS(:) = PCPS(:) + (XCPV-XCPD) *ZHUMS(:)*PDQSAT(:)*(PTG(:,1)-PTSM(:)) &
+ PK%XCPS(:) = PK%XCPS(:) + (XCPV-XCPD) *ZHUMS(:)*PDQSAT(:)*(PEK%XTG(:,1)-PTSM(:)) &
+ (XCPV-XCPD) *(1-ZHUMA(:))*(PQA_IC(:)-PQA(:))
ENDIF
- PLSTT(:) = PLSTT(:) + (XCPV-XCI)*(PTG(:,1)-PTSM(:))
+ PK%XLSTT(:) = PK%XLSTT(:) + (XCPV-XCI)*(PEK%XTG(:,1)-PTSM(:))
- PLVTT(:) = PLVTT(:) + (XCPV-XCL)*(PTG(:,1)-PTSM(:))
+ PK%XLVTT(:) = PK%XLVTT(:) + (XCPV-XCL)*(PEK%XTG(:,1)-PTSM(:))
ENDIF
diff --git a/src/SURFEX/e_budget_meb.F90 b/src/SURFEX/e_budget_meb.F90
index 478d37bfcb745aeaf8267bafdd0602ac172546e8..ffb942c2a7a178f6239b1652a877e589d94ac0c4 100644
--- a/src/SURFEX/e_budget_meb.F90
+++ b/src/SURFEX/e_budget_meb.F90
@@ -3,31 +3,26 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ##########################################################################
- SUBROUTINE E_BUDGET_MEB(HISBA,HCPSURF,PTSTEP, &
- PPS,PCG,PCT,PCV,PWRVN,PWR, &
- PTDEEP_A,PTDEEP_B,PD_G,PSOILCONDZ,PSOILHCAPZ, &
- PSNOWDZ,PSNOWCONDZ,PSNOWHCAPZ, &
- PSWNET_V,PSWNET_G,PSWNET_N,PTAU_N, &
- PLWNET_V,PLWNET_G,PLWNET_N, &
- PLWNET_V_DTV,PLWNET_V_DTG,PLWNET_V_DTN, &
- PLWNET_G_DTV,PLWNET_G_DTG,PLWNET_G_DTN, &
- PLWNET_N_DTV,PLWNET_N_DTG,PLWNET_N_DTN, &
- PPEW_A_COEF,PPEW_B_COEF,PPET_A_COEF,PPEQ_A_COEF,PPET_B_COEF,PPEQ_B_COEF, &
- PTHRMA_TA,PTHRMB_TA,PTHRMA_TC,PTHRMB_TC, &
- PTHRMA_TG,PTHRMB_TG,PTHRMA_TV,PTHRMB_TV,PTHRMA_TN,PTHRMB_TN, &
- PQSAT_G,PQSAT_V,PQSATI_N, &
- PFF,PFFROZEN,PPSN,PPSNA,PPSNCV, &
- PCHEATV,PCHEATG,PCHEATN, &
- PLEG_DELTA,PLEGI_DELTA,PHUG,PHUGI,PHVG,PHVN,PFROZEN1, &
- PFLXC_C_A,PFLXC_G_C,PFLXC_VG_C,PFLXC_VN_C,PFLXC_N_C,PFLXC_N_A, &
- PFLXC_MOM, &
- PTG,PTV,PTN, &
- PFLXC_V_C,PHVGS,PHVNS, &
- PDQSAT_G,PDQSAT_V,PDQSATI_N, &
- PTC,PQC,PTA_IC,PQA_IC,PUSTAR2_IC,PVMOD, &
- PDELTAT_G,PDELTAT_V,PDELTAT_N,PGRNDFLUX,PCPS,PLVTT,PLSTT, &
- PHPSNOW,PMELTADV,PRESTORE,PDEEP_FLUX, &
- PDELHEATV_SFC,PDELHEATG_SFC,PDELHEATG )
+ SUBROUTINE E_BUDGET_MEB(IO, KK, PK, PEK, DK, DEK, DMK, &
+ PTSTEP, PLTT, PPS, PCT, PTDEEP_A, PD_G, PSOILCONDZ, &
+ PSOILHCAPZ, PSNOWRHO, PSNOWCONDZ, PSNOWHCAPZ, PTAU_N, &
+ PLWNET_V_DTV, PLWNET_V_DTG, PLWNET_V_DTN, &
+ PLWNET_G_DTV, PLWNET_G_DTG, PLWNET_G_DTN, &
+ PLWNET_N_DTV, PLWNET_N_DTG, PLWNET_N_DTN, &
+ PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, &
+ PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
+ PTHRMA_TA, PTHRMB_TA, PTHRMA_TC, PTHRMB_TC, &
+ PTHRMA_TG, PTHRMB_TG, PTHRMA_TV, PTHRMB_TV, &
+ PTHRMA_TN, PTHRMB_TN, PQSAT_G, PQSAT_V, &
+ PQSATI_N, PPSNA, PPSNCV, PCHEATV, PCHEATG, &
+ PCHEATN, PLEG_DELTA, PLEGI_DELTA, PHUGI, &
+ PHVG, PHVN, PFROZEN1, PFLXC_C_A, PFLXC_G_C, &
+ PFLXC_VG_C, PFLXC_VN_C, PFLXC_N_C, PFLXC_N_A,&
+ PFLXC_MOM, PTG, PSNOWLIQ, PFLXC_V_C, PHVGS, PHVNS, &
+ PDQSAT_G, PDQSAT_V, PDQSATI_N, PTA_IC, &
+ PQA_IC, PUSTAR2_IC, PVMOD, PDELTAT_G, &
+ PDELTAT_V, PDELTAT_N, PGRNDFLUX, PDEEP_FLUX, &
+ PDELHEATV_SFC, PDELHEATG_SFC, PDELHEATG )
! ##########################################################################
!
!!**** *E_BUDGET*
@@ -91,14 +86,21 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_DIAG_n, ONLY : DIAG_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
+!
USE MODD_CSTS, ONLY : XLVTT, XLSTT, XTT, XCPD, XCPV, XCL, &
- XDAY, XPI
+ XDAY, XPI, XLMTT, XRHOLW
USE MODD_SURF_ATM, ONLY : LCPL_ARP
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_SNOW_METAMO, ONLY : XSNOWDZMIN
!
USE MODE_THERMOS
USE MODE_MEB, ONLY : SFC_HEATCAP_VEG
+USE MODE_SNOW3L, ONLY : SNOW3LHOLD
!
USE MODI_TRIDIAG_GROUND_RM_COEFS
USE MODI_TRIDIAG_GROUND_RM_SOLN
@@ -110,35 +112,24 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
- CHARACTER(LEN=*), INTENT(IN) :: HISBA ! type of ISBA version:
-! ! '2-L' (default)
-! ! '3-L'
-! ! 'DIF'
-!
- CHARACTER(LEN=*), INTENT(IN) :: HCPSURF ! Specific heat
-! ! 'DRY' = dry Cp
-! ! 'HUM' = humid Cp fct of qc for MEB
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(DIAG_t), INTENT(INOUT) :: DK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK
!
REAL, INTENT(IN) :: PTSTEP
! PTSTEP = timestep of the integration (s)
!
-REAL, DIMENSION(:), INTENT(IN) :: PCT, PCV, PWRVN, PWR, PCG
-! PCG = area-averaged soil heat capacity (m2 K J-1)
+REAL, DIMENSION(:), INTENT(IN) :: PCT
! PCT = surface understory or composite thermal inertia (m2 K J-1)
-! PCV = vegetation canopy thermal inertia (m2 K J-1)
-! PWRVN = liquid water equivalent snow intercepted on the canopy (kg m-2)
-! PWR = liquid water intercepted on the canopy (kg m-2)
!
-REAL, DIMENSION(:), INTENT(IN) :: PTDEEP_A, PTDEEP_B
+REAL, DIMENSION(:), INTENT(IN) :: PTDEEP_A
! PTDEEP_A = Deep soil temperature
! coefficient depending on flux
-! PTDEEP_B = Deep soil temperature (prescribed)
-! which models heating/cooling from
-! below the diurnal wave penetration
-! (surface temperature) depth. If it
-! is FLAGGED as undefined, then the zero
-! flux lower BC is applied.
-! Tdeep = PTDEEP_B + PTDEEP_A * PDEEP_FLUX
+! Tdeep = IP%XTDEEP + PTDEEP_A * PDEEP_FLUX
! (with PDEEP_FLUX in W/m2)
!
REAL, DIMENSION(:), INTENT(IN) :: PPS
@@ -149,15 +140,10 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PD_G, PSOILCONDZ, PSOILHCAPZ
! PSOILCONDZ = soil thermal conductivity (W m-1 K-1)
! PSOILHCAPZ = soil heat capacity (J m-3 K-1)
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWDZ, PSNOWCONDZ, PSNOWHCAPZ
-! PSNOWDZ = snow layer thickness (m)
+REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWCONDZ, PSNOWHCAPZ, PSNOWRHO
! PSNOWCONDZ = snow thermal conductivity (W m-1 K-1)
! PSNOWHCAPZ = snow heat capacity (J m-3 K-1)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PSWNET_V, PSWNET_G, PSWNET_N
-! PSWNET_G = Understory-ground net SW radiation explicit term (W m-2)
-! PSWNET_V = Vegetation canopy net SW radiation explicit term (W m-2)
-! PSWNET_N = Ground-based snow net SW radiation explicit term (W m-2)
+! PSNOWRHO = snow layer density (kg/m3)
!
REAL, DIMENSION(:,:), INTENT(IN) :: PTAU_N
! PTAU_N = shortwave radiation transmission through (at the base of)
@@ -166,11 +152,6 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PTAU_N
! but can be above 0 at snowpack base for shallow snow, then
! it is presumed to go into the uppermost soil layer.
!
-REAL, DIMENSION(:), INTENT(IN) :: PLWNET_V, PLWNET_G, PLWNET_N
-! PLWNET_G = Understory-ground net LW radiation explicit term (W m-2)
-! PLWNET_V = Vegetation canopy net LW radiation explicit term (W m-2)
-! PLWNET_N = Ground-based snow net LW radiation explicit term (W m-2)
-!
REAL, DIMENSION(:), INTENT(IN) :: PLWNET_V_DTV, PLWNET_V_DTG, PLWNET_V_DTN
! PLWNET_V_DTV, PLWNET_V_DTG, PLWNET_V_DTN = Vegetation canopy net LW radiation
! derivatives w/r/t surface temperature(s) (W m-2 K-1)
@@ -212,15 +193,12 @@ REAL, DIMENSION(:), INTENT(IN) :: PQSAT_G, PQSAT_V, PQSATI_N
! PQSAT_V = saturation specific humidity for the vegetation canopy (kg kg-1)
! PQSATI_N = saturation specific humidity over ice for the snowpack (kg kg-1)
!
-REAL, DIMENSION(:), INTENT(IN) :: PFF, PFFROZEN, PPSN, PPSNA, PPSNCV
-! PFF = total flooded fraction (-)
-! PFFROZEN = total frozen flooded fraction (-)
+REAL, DIMENSION(:), INTENT(IN) :: PPSNA, PPSNCV
! PPSN = fraction of snow on ground and understory vegetation (-)
! PPSNA = fraction of vegetation canopy buried by ground-based snowpack (-)
! PPSNCV = fraction of vegetation canopy covered by intercepted snow (-)
!
-REAL, DIMENSION(:), INTENT(IN) :: PLEG_DELTA, PLEGI_DELTA, PHUG, PHUGI, PHVG, PHVN, PFROZEN1
-! PHUG = relative humidity of the surface soil (-)
+REAL, DIMENSION(:), INTENT(IN) :: PLEG_DELTA, PLEGI_DELTA, PHUGI, PHVG, PHVN, PFROZEN1
! PHUGI = relative humidity of the frozen surface soil (-)
! PHVG = Halstead coefficient of non-buried (snow) canopy vegetation (-)
! PHVN = Halstead coefficient of paritally-buried (snow) canopy vegetation (-)
@@ -238,15 +216,15 @@ REAL, DIMENSION(:), INTENT(IN) :: PFLXC_C_A, PFLXC_G_C, PFLXC_VG_C, PFLXC_VN
! PFLXC_N_A = As above, but for : ground-based snow to canopy air (kg m-2 s-1)
! PFLXC_MOM = flux form drag transfer coefficient: canopy air to atmosphere (kg m-2 s-1)
!
-REAL, DIMENSION(:,:), INTENT(INOUT):: PTN
-! PTN = Ground-based snow temperature profile (K)
-!
-REAL, DIMENSION(:), INTENT(INOUT):: PTV
-! PTV = Vegetation canopy temperature (K)
+REAL, DIMENSION(:), INTENT(IN) :: PLTT
+! PLTT = latent heat normalization factor (J kg-1)
!
REAL, DIMENSION(:,:), INTENT(INOUT):: PTG
! PTG = Soil temperature profile (K)
!
+REAL, DIMENSION(:,:), INTENT(INOUT):: PSNOWLIQ
+! PSNOWLIQ = Snow layer liquid water content (m)
+!
REAL, DIMENSION(:), INTENT(OUT) :: PCHEATV, PCHEATG, PCHEATN
! PCHEATV = Vegetation canopy *effective surface* heat capacity (J m-2 K-1)
! PCHEATG = Understory-ground *effective surface* heat capacity (J m-2 K-1)
@@ -268,9 +246,7 @@ REAL, DIMENSION(:), INTENT(OUT) :: PFLXC_V_C, PHVGS, PHVNS
! PHVNS = Dimensionless pseudo humidity factor for computing vapor
! fluxes from the partly-buried part of the canopy to the canopy air (-)
!
-REAL, DIMENSION(:), INTENT(OUT) :: PTC, PQC, PTA_IC, PQA_IC, PUSTAR2_IC, PVMOD
-! PTC = Canopy air space temperature (K)
-! PQC = Canopy air space specific humidity (kg kg-1)
+REAL, DIMENSION(:), INTENT(OUT) :: PTA_IC, PQA_IC, PUSTAR2_IC, PVMOD
! PTA_IC = Near-ground air temperature (K)
! PQA_IC = Near-ground air specific humidity (kg kg-1)
! PUSTAR2_IC = Surface friction velocity squared (m2 s-2)
@@ -286,17 +262,6 @@ REAL, DIMENSION(:), INTENT(OUT) :: PDELTAT_V, PDELTAT_N, PDELTAT_G
REAL, DIMENSION(:), INTENT(OUT) :: PGRNDFLUX
! PGRNDFLUX = Flux between snowpack base and ground surface (W m-2)
!
-REAL, DIMENSION(:), INTENT(OUT) :: PCPS, PLVTT, PLSTT
-! PCPS = specific heat capacity of the surface (J kg-1 K-1)
-! PLVTT= latent heat of vaporization (J kg-1)
-! PLSTT= latent heat of sublimation (J kg-1)
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PHPSNOW, PMELTADV, PRESTORE
-! PHPSNOW = Precipitation heating term for ground-based snowpack (W m-2)
-! PMELTADV= Heating resulting when meltwater enters soil at sub-freezing
-! temperatures (W m-2)
-! PRESTORE= flux between surface and sub-surface in soil (W m-2)
-!
REAL, DIMENSION(:), INTENT(OUT) :: PDEEP_FLUX ! Heat flux at bottom of ISBA (W/m2)
!
REAL, DIMENSION(:), INTENT(OUT) :: PDELHEATV_SFC, PDELHEATG_SFC, PDELHEATG
@@ -309,16 +274,14 @@ REAL, DIMENSION(:), INTENT(OUT) :: PDELHEATV_SFC, PDELHEATG_SFC, PDELHEATG
!
INTEGER :: JNSNOW, JNGRND, JNPTS, JJ, JK, JL
!
-REAL :: ZHNS
+REAL, DIMENSION(SIZE(PPS)) :: ZHN, ZHS, ZHVS, ZHNS
!
REAL, DIMENSION(SIZE(PTG,1),SIZE(PTG,2)) :: ZTGO
!
-REAL, DIMENSION(SIZE(PTN,1),SIZE(PTN,2)) :: ZTNO
+REAL, DIMENSION(SIZE(DMK%XSNOWTEMP,1),SIZE(DMK%XSNOWTEMP,2)) :: ZTNO
!
REAL, DIMENSION(SIZE(PTG,1)) :: ZTVO
!
-REAL, DIMENSION(SIZE(PPS)) :: ZHN, ZHS, ZHVS
-!
REAL, DIMENSION(SIZE(PPS)) :: ZPSNAG, ZWORK, ZFFF, ZGCOND1
!
REAL, DIMENSION(SIZE(PPS)) :: ZPET_A_COEF_P, ZPET_B_COEF_P, ZPET_C_COEF_P
@@ -341,9 +304,11 @@ REAL, DIMENSION(SIZE(PPS)) :: ZTCONDA_DELZ_G, ZTCONDA_DELZ_N, ZTC
!
REAL, DIMENSION(SIZE(PTG,1),SIZE(PTG,2)) :: ZSOIL_COEF_A, ZSOIL_COEF_B
!
-REAL, DIMENSION(SIZE(PSNOWDZ,1),SIZE(PSNOWDZ,2)):: ZSNOW_COEF_A, ZSNOW_COEF_B, ZSNOWDZ
+REAL, DIMENSION(SIZE(DMK%XSNOWDZ,1),SIZE(DMK%XSNOWDZ,2)):: ZSNOW_COEF_A, ZSNOW_COEF_B
!
-REAL, DIMENSION(SIZE(PD_G,1),SIZE(PD_G,2)+SIZE(PSNOWDZ,2)) :: ZD, ZT, ZHCAPZ, ZCONDZ, &
+REAL, DIMENSION(SIZE(DMK%XSNOWDZ,1),SIZE(DMK%XSNOWDZ,2)):: ZWHOLDMAX
+!
+REAL, DIMENSION(SIZE(PD_G,1),SIZE(PD_G,2)+SIZE(DMK%XSNOWDZ,2)) :: ZD, ZT, ZHCAPZ, ZCONDZ, &
ZCOEF_A, ZCOEF_B, ZSOURCE
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -360,17 +325,15 @@ REAL, PARAMETER :: ZERTOL_FLX_C = 1.0E-12 ! -
IF (LHOOK) CALL DR_HOOK('E_BUDGET_MEB',0,ZHOOK_HANDLE)
!
ZTGO(:,:) = PTG(:,:)
-ZTNO(:,:) = PTN(:,:)
-ZTVO(:) = PTV(:)
+ZTNO(:,:) = DMK%XSNOWTEMP(:,:)
+ZTVO(:) = PEK%XTV(:)
! To prevent possible numerical problems in the limit as psna==>1, we
! limit the value for certain computations:
ZPSNA(:) = MIN(1.0-ZERTOL, PPSNA(:))
-ZSNOWDZ(:,:) = 0.0 ! local working variable
-
-JNSNOW = SIZE(PTN,2)
+JNSNOW = SIZE(DMK%XSNOWTEMP,2)
JNGRND = SIZE(PTG,2)
JNPTS = SIZE(PTG,1)
@@ -387,11 +350,11 @@ ZSNOW_COEF_B(:,:) = 0.0
! -----------------------------------------------------------
! - Effective Surface heat capacities for each energy budget (J m-2 K-1)
!
-PCHEATG(:) = 1/PCT(:) ! understory soil/floodplain
+PCHEATG(:) = 1/PCT(:) ! understory soil/floodplain
!
-PCHEATV(:) = SFC_HEATCAP_VEG(PWRVN,PWR,PCV) ! vegetation canopy heat capacity
+PCHEATV(:) = SFC_HEATCAP_VEG(PEK%XWRVN(:),PEK%XWR(:),PEK%XCV) ! vegetation canopy heat capacity
!
-PCHEATN(:) = PSNOWHCAPZ(:,1)*PSNOWDZ(:,1) ! snow surface layer
+PCHEATN(:) = PSNOWHCAPZ(:,1)*DMK%XSNOWDZ(:,1) ! snow surface layer
!
! - Specific humidity derivatives (kg kg-1 K-1)
!
@@ -414,7 +377,7 @@ PDQSATI_N(:) = DQSATI(ZTNO(:,1), PPS(:),PQSATI_N(:) )
! modification to this routine and flux routine: but retain it here for possible
! future implementation.
!
-PHPSNOW(:) = 0.0 ! W m-2
+DMK%XHPSNOW(:) = 0.0 ! W m-2
!
! Snowmeltwater advection which can heat uppermost soil layer if below freezing.
! NOTE this term is currently OFF for MEB since it would mean keeping meltwater
@@ -423,7 +386,7 @@ PHPSNOW(:) = 0.0 ! W m-2
! not done) so we turn off for now (set to 0), but retain it here for possible
! future implementation.
!
-PMELTADV(:) = 0.0 ! W m-2
+DEK%XMELTADV(:) = 0.0 ! W m-2
!
! - Implicit wind speed at lowest atmospheric level for this patch:
!
@@ -444,7 +407,7 @@ PUSTAR2_IC(:)= ZUSTAR2(:)
!
ZSOURCE(:,:) = 0. ! heat Eq source term initialization: c dz dT/dt = d/dz(k dT/dz) + Source
!
-IF(HISBA == 'DIF')THEN
+IF(IO%CISBA == 'DIF')THEN
!
!* 2.a Compute sub-surface soil coupling coefficients: upward sweep
! ------------------------------------------------------------
@@ -452,8 +415,9 @@ IF(HISBA == 'DIF')THEN
! interfacial thermal conductivity to layer thickness ratio (W m-2 K-1)
! These coefficients are used to compute the temperature profile implicitly.
!
- CALL TRIDIAG_GROUND_RM_COEFS(PTSTEP,PD_G,ZTGO,PSOILHCAPZ,PSOILCONDZ, &
- ZSOURCE(:,1:JNGRND),PTDEEP_A,PTDEEP_B,ZTCONDA_DELZ_G,ZSOIL_COEF_A,ZSOIL_COEF_B)
+ CALL TRIDIAG_GROUND_RM_COEFS(PTSTEP, PD_G, ZTGO, PSOILHCAPZ, PSOILCONDZ, &
+ ZSOURCE(:,1:JNGRND), PTDEEP_A, KK%XTDEEP, &
+ ZTCONDA_DELZ_G, ZSOIL_COEF_A, ZSOIL_COEF_B)
!
! Here we repeat this for the snowpack: but note, this is just
! to better estimate surface fluxes via the surface-sub surface heat
@@ -466,11 +430,8 @@ IF(HISBA == 'DIF')THEN
! so it is more accurate as the snow fraction approaches unity.
! Starting from snowpack surface downward to base of ground:
!
- ZSNOWDZ(:,:) = MAX(XSNOWDZMIN, PSNOWDZ(:,:))
-!
-
JL = 1
- ZD(:,JL) = ZSNOWDZ(:,1)
+ ZD(:,JL) = DMK%XSNOWDZ(:,1)
ZT(:,JL) = ZTNO(:,1)
ZHCAPZ(:,JL) = PSNOWHCAPZ(:,1)
ZCONDZ(:,JL) = PSNOWCONDZ(:,1)
@@ -478,11 +439,11 @@ IF(HISBA == 'DIF')THEN
DO JK=2,JNSNOW
JL = JL + 1
DO JJ=1,JNPTS
- ZD(JJ,JL) = ZSNOWDZ(JJ,JK)
+ ZD(JJ,JL) = ZD(JJ,JL-1) + DMK%XSNOWDZ(JJ,JK)
ZT(JJ,JL) = ZTNO(JJ,JK)
ZHCAPZ(JJ,JL) = PSNOWHCAPZ(JJ,JK)
ZCONDZ(JJ,JL) = PSNOWCONDZ(JJ,JK)
- ZSOURCE(JJ,JL) = PSWNET_N(JJ)*(PTAU_N(JJ,JK-1)-PTAU_N(JJ,JK))
+ ZSOURCE(JJ,JL) = DEK%XSWNET_NS(JJ)*(PTAU_N(JJ,JK-1)-PTAU_N(JJ,JK))
ENDDO
ENDDO
JL = JL + 1
@@ -490,7 +451,7 @@ IF(HISBA == 'DIF')THEN
ZT(:,JL) = ZTGO(:,1)
ZHCAPZ(:,JL) = PCHEATG(:)/PD_G(:,1)
ZCONDZ(:,JL) = PSOILCONDZ(:,1)
- ZSOURCE(:,JL) = PSWNET_N(:)*PTAU_N(:,JNSNOW)
+ ZSOURCE(:,JL) = DEK%XSWNET_NS(:)*PTAU_N(:,JNSNOW)
DO JK=2,JNGRND
JL = JL + 1
DO JJ=1,JNPTS
@@ -504,8 +465,8 @@ IF(HISBA == 'DIF')THEN
!
! Get coefficients from upward sweep (starting from soil base to snow surface):
!
- CALL TRIDIAG_GROUND_RM_COEFS(PTSTEP,ZD,ZT,ZHCAPZ,ZCONDZ, &
- ZSOURCE,PTDEEP_A,PTDEEP_B,ZTCONDA_DELZ_N,ZCOEF_A,ZCOEF_B)
+ CALL TRIDIAG_GROUND_RM_COEFS(PTSTEP, ZD, ZT, ZHCAPZ, ZCONDZ, ZSOURCE, &
+ PTDEEP_A, KK%XTDEEP, ZTCONDA_DELZ_N, ZCOEF_A, ZCOEF_B)
!
ZSNOW_COEF_A(:,2) = ZCOEF_A(:,2)
ZSNOW_COEF_B(:,2) = ZCOEF_B(:,2)
@@ -524,11 +485,11 @@ ELSE
! must be backed-out of surface thermal coefficients
! (Etchevers and Martin 1997):
- ZGCOND1(:) = (4*XPI/XDAY)/( PCG(:)*PCG(:)/(PD_G(:,1)*PCT(:)) )
+ ZGCOND1(:) = (4*XPI/XDAY)/( DMK%XCG(:)*DMK%XCG(:)/(PD_G(:,1)*PCT(:)) )
JL = 1
- ZD(:,JL) = ZSNOWDZ(:,1)
+ ZD(:,JL) = DMK%XSNOWDZ(:,1)
ZT(:,JL) = ZTNO(:,1)
ZHCAPZ(:,JL) = PSNOWHCAPZ(:,1)
ZCONDZ(:,JL) = PSNOWCONDZ(:,1)
@@ -536,11 +497,11 @@ ELSE
DO JK=2,JNSNOW
JL = JL + 1
DO JJ=1,JNPTS
- ZD(JJ,JL) = ZSNOWDZ(JJ,JK)
+ ZD(JJ,JL) = ZD(JJ,JL-1) + DMK%XSNOWDZ(JJ,JK)
ZT(JJ,JL) = ZTNO(JJ,JK)
ZHCAPZ(JJ,JL) = PSNOWHCAPZ(JJ,JK)
ZCONDZ(JJ,JL) = PSNOWCONDZ(JJ,JK)
- ZSOURCE(JJ,JL) = PSWNET_N(JJ)*(PTAU_N(JJ,JK-1)-PTAU_N(JJ,JK))
+ ZSOURCE(JJ,JL) = DEK%XSWNET_NS(JJ)*(PTAU_N(JJ,JK-1)-PTAU_N(JJ,JK))
ENDDO
ENDDO
JL = JL + 1
@@ -548,13 +509,13 @@ ELSE
ZT(:,JL) = ZTGO(:,1)
ZHCAPZ(:,JL) = 1/PCT(:)
ZCONDZ(:,JL) = ZGCOND1(:)
- ZSOURCE(:,JL) = PSWNET_N(:)*PTAU_N(:,JNSNOW)
+ ZSOURCE(:,JL) = DEK%XSWNET_NS(:)*PTAU_N(:,JNSNOW)
! Get coefficients from upward sweep (starting from soil base to snow surface):
!
- CALL TRIDIAG_GROUND_RM_COEFS(PTSTEP,ZD(:,1:JL),ZT(:,1:JL), &
- ZHCAPZ(:,1:JL),ZCONDZ(:,1:JL),ZSOURCE(:,1:JL), &
- PTDEEP_A,PTDEEP_B,ZTCONDA_DELZ_N,ZCOEF_A(:,1:JL),ZCOEF_B(:,1:JL))
+ CALL TRIDIAG_GROUND_RM_COEFS(PTSTEP, ZD(:,1:JL), ZT(:,1:JL), ZHCAPZ(:,1:JL), ZCONDZ(:,1:JL), &
+ ZSOURCE(:,1:JL), PTDEEP_A, KK%XTDEEP, ZTCONDA_DELZ_N, &
+ ZCOEF_A(:,1:JL), ZCOEF_B(:,1:JL))
ZSNOW_COEF_A(:,2) = ZCOEF_A(:,2)
ZSNOW_COEF_B(:,2) = ZCOEF_B(:,2)
@@ -563,53 +524,55 @@ ENDIF
!
! Interfacial ground-snowbase thermal conductivity divided by interfacial dz:
!
-ZTCONDA_DELZ_NG(:) = 2/((ZSNOWDZ(:,JNSNOW)/PSNOWCONDZ(:,JNSNOW))+(PD_G(:,1)/ZGCOND1(:) ))
+ZTCONDA_DELZ_NG(:) = 2/((DMK%XSNOWDZ(:,JNSNOW)/PSNOWCONDZ(:,JNSNOW))+(PD_G(:,1)/ZGCOND1(:) ))
!
!
-!* 3. Pseudo humidity factors (-)
+!* 3. Pseudo humidity factors (-) and effective latent heat (J kg-1)
! ---------------------------------------------------------
!
-! First, compute the average flux heat exchange coefficient for the canopy: (kg m-2 s-1)
+! Compute the average flux heat exchange coefficient for the canopy: (kg m-2 s-1)
! Numerical: let get very small (fluxes can become essentially negligible), but not zero
!
-PFLXC_V_C(:) = PFLXC_VG_C(:)*(1.-PPSN(:)) + PFLXC_VN_C(:)*PPSN(:)*(1.-ZPSNA(:))
+PFLXC_V_C(:) = PFLXC_VG_C(:)*(1.-PEK%XPSN(:)) + PFLXC_VN_C(:)*PEK%XPSN(:)*(1.-ZPSNA(:))
PFLXC_V_C(:) = MAX(PFLXC_V_C(:), ZERTOL_FLX_C)
! Understory vegetation and ground factors:
-ZFFF(:) = PFF(:)*( 1.0 - PFFROZEN(:)*(1.0 - (XLSTT/XLVTT)) )
+ZFFF(:) = KK%XFF(:)*( (1.0 - KK%XFFROZEN(:))*(XLVTT/PLTT(:)) + &
+ KK%XFFROZEN(:) *(XLSTT/PLTT(:)) )
-ZHN(:) = (1.0-PPSN(:)-ZFFF(:))*( &
- PLEG_DELTA(:) *(1.0-PFROZEN1(:)) &
- + PLEGI_DELTA(:)* PFROZEN1(:)*(XLSTT/XLVTT) ) + ZFFF(:)
+ZHN(:) = (1.0-PEK%XPSN(:)-KK%XFF(:))*( &
+ PLEG_DELTA (:) *(1.0-PFROZEN1(:))*(XLVTT/PLTT(:)) &
+ + PLEGI_DELTA(:)* PFROZEN1(:) *(XLSTT/PLTT(:)) ) + ZFFF(:)
-ZHS(:) = (1.0-PPSN(:)-ZFFF(:))*( &
- PHUG(:) *PLEG_DELTA(:) *(1.0-PFROZEN1(:)) &
- + PHUGI(:)*PLEGI_DELTA(:)* PFROZEN1(:)*(XLSTT/XLVTT) ) + ZFFF(:)
+ZHS(:) = (1.0-PEK%XPSN(:)-KK%XFF(:))*( &
+ DK%XHUG(:) *PLEG_DELTA (:) *(1.0-PFROZEN1(:)) *(XLVTT/PLTT(:)) &
+ + PHUGI(:)*PLEGI_DELTA(:)* PFROZEN1(:) *(XLSTT/PLTT(:)) ) + ZFFF(:)
! adjust for local use in solution (since they are multiplied by 1-psn herein):
-ZHN(:) = ZHN(:)/MAX(1.0 - PPSN(:) , ZERTOL)
+ZHN(:) = ZHN(:)/MAX(1.0 - PEK%XPSN(:) , ZERTOL)
-ZHS(:) = ZHS(:)/MAX(1.0 - PPSN(:) , ZERTOL)
+ZHS(:) = ZHS(:)/MAX(1.0 - PEK%XPSN(:) , ZERTOL)
-! Vegetation canopy factor:
+! Vegetation canopy factors:
-PHVGS(:) = (1.-ZPSNA(:))*PPSN(:) *PHVN(:)*(PFLXC_VN_C(:)/PFLXC_V_C(:)) + &
- (1.-PPSN(:))*PHVG(:)*(PFLXC_VG_C(:)/PFLXC_V_C(:))
+PHVGS(:) = (1.-ZPSNA(:))*PEK%XPSN(:) *PHVN(:)*(PFLXC_VN_C(:)/PFLXC_V_C(:)) + &
+ (1.-PEK%XPSN(:))*PHVG(:)*(PFLXC_VG_C(:)/PFLXC_V_C(:))
-PHVNS(:) = (1.-ZPSNA(:))*PPSN(:) * (PFLXC_VN_C(:)/PFLXC_V_C(:)) + &
- (1.-PPSN(:))* (PFLXC_VG_C(:)/PFLXC_V_C(:))
+PHVNS(:) = (1.-ZPSNA(:))*PEK%XPSN(:) * (PFLXC_VN_C(:)/PFLXC_V_C(:)) + &
+ (1.-PEK%XPSN(:))* (PFLXC_VG_C(:)/PFLXC_V_C(:))
! - total canopy H factor (including intercepted snow)
-ZHVS(:) = (1.-PPSNCV(:))*PHVGS(:) + PPSNCV(:)*(XLSTT/XLVTT)*PHVNS(:)
+ZHVS(:) = (1.-PPSNCV(:))*(XLVTT/PLTT(:))*PHVGS(:) + &
+ PPSNCV(:) *(XLSTT/PLTT(:))*PHVNS(:)
! Snow latent heating factor:
! NOTE, for now we consider only snow sublimation
! (not evaporation from snow liquid)
!
-ZHNS = (XLSTT/XLVTT)
+ZHNS = (XLSTT/PLTT(:))
!
!
!* 4. Transform atmospheric coupling coefficients for T and q
@@ -620,25 +583,25 @@ ZHNS = (XLSTT/XLVTT)
!
! - first, to shorten computations a bit, define a snow fraction product
-ZPSNAG(:) = 1.0 - PPSN(:)*PPSNA(:)
+ZPSNAG(:) = 1.0 - PEK%XPSN(:)*PPSNA(:)
! T coefficients: where : TA = PET_B_COEF_P + PET_A_COEF_P*TC + PET_C_COEF_P*TN
ZWORK(:) = PTHRMA_TA(:)*( 1.0 + PPET_A_COEF(:)*( &
- PFLXC_C_A(:)*ZPSNAG(:) + PFLXC_N_A(:)*PPSN(:)*PPSNA(:)) )
-ZPET_A_COEF_P(:) = PPET_A_COEF(:)*PFLXC_C_A(:)*ZPSNAG(:)*PTHRMA_TC(:) /ZWORK(:)
+ PFLXC_C_A(:)*ZPSNAG(:) + PFLXC_N_A(:)*PEK%XPSN(:)*PPSNA(:)) )
+ZPET_A_COEF_P(:) = PPET_A_COEF(:)*PFLXC_C_A(:)*ZPSNAG(:)*PTHRMA_TC(:)/ZWORK(:)
ZPET_B_COEF_P(:) = ( PPET_B_COEF(:) - PTHRMB_TA(:) + &
PPET_A_COEF(:)*(PFLXC_C_A(:)*ZPSNAG(:)*(PTHRMB_TC(:)-PTHRMB_TA(:)) + &
- PFLXC_N_A(:)*PPSN(:)*PPSNA(:)*(PTHRMB_TN(:)-PTHRMB_TA(:)) ) ) /ZWORK(:)
-ZPET_C_COEF_P(:) = PPET_A_COEF(:)*PFLXC_N_A(:)*PPSN(:)*PPSNA(:)*PTHRMA_TN(:) /ZWORK(:)
+ PFLXC_N_A(:)*PEK%XPSN(:)*PPSNA(:)*(PTHRMB_TN(:)-PTHRMB_TA(:)) ) ) /ZWORK(:)
+ZPET_C_COEF_P(:) = PPET_A_COEF(:)*PFLXC_N_A(:)*PEK%XPSN(:)*PPSNA(:)*PTHRMA_TN(:) /ZWORK(:)
! q coefficients:
ZWORK(:) = 1.0 + PPEQ_A_COEF(:)*(PFLXC_C_A(:)*ZPSNAG(:) + &
- PFLXC_N_A(:)*PPSN(:)*PPSNA(:)*ZHNS)
-ZPEQ_A_COEF_P(:) = PPEQ_A_COEF(:)*PFLXC_C_A(:)*ZPSNAG(:) /ZWORK(:)
-ZPEQ_B_COEF_P(:) = PPEQ_B_COEF(:) /ZWORK(:)
-ZPEQ_C_COEF_P(:) = PPEQ_A_COEF(:)*PFLXC_N_A(:)*PPSN(:)*PPSNA(:)*ZHNS/ZWORK(:)
+ PFLXC_N_A(:)*PEK%XPSN(:)*PPSNA(:)*ZHNS)
+ZPEQ_A_COEF_P(:) = PPEQ_A_COEF(:)*PFLXC_C_A(:)*ZPSNAG(:) /ZWORK(:)
+ZPEQ_B_COEF_P(:) = PPEQ_B_COEF(:) /ZWORK(:)
+ZPEQ_C_COEF_P(:) = PPEQ_A_COEF(:)*PFLXC_N_A(:)*PEK%XPSN(:)*PPSNA(:)*ZHNS/ZWORK(:)
!* 5. Compute canopy air coefficients (T and q)
@@ -649,43 +612,42 @@ ZPEQ_C_COEF_P(:) = PPEQ_A_COEF(:)*PFLXC_N_A(:)*PPSN(:)*PPSNA(:)*ZHNS/ZWORK(:)
ZWORK(:) = PFLXC_C_A(:) *(PTHRMA_TC(:)-PTHRMA_TA(:)*ZPET_A_COEF_P(:))*ZPSNAG(:) &
+ PFLXC_V_C(:) *PTHRMA_TC(:) &
- + PFLXC_G_C(:) *PTHRMA_TC(:)*(1.0-PPSN(:)) &
- + PFLXC_N_C(:) *PTHRMA_TC(:)* PPSN(:) *(1.0-PPSNA(:))
+ + PFLXC_G_C(:) *PTHRMA_TC(:)*(1.0-PEK%XPSN(:)) &
+ + PFLXC_N_C(:) *PTHRMA_TC(:)* PEK%XPSN(:) *(1.0-PPSNA(:))
ZCOEFA_TC(:) = (PFLXC_C_A(:) * ZPSNAG(:) *(PTHRMA_TA(:)*ZPET_B_COEF_P(:)-PTHRMB_TC(:)+PTHRMB_TA(:)) &
+ PFLXC_V_C(:) * (PTHRMB_TV(:)-PTHRMB_TC(:)) &
- + PFLXC_G_C(:) * (PTHRMB_TG(:)-PTHRMB_TC(:))*(1.0-PPSN(:)) &
- + PFLXC_N_C(:) * (PTHRMB_TN(:)-PTHRMB_TC(:))* PPSN(:) *(1.0-PPSNA(:)) &
+ + PFLXC_G_C(:) * (PTHRMB_TG(:)-PTHRMB_TC(:))*(1.0-PEK%XPSN(:)) &
+ + PFLXC_N_C(:) * (PTHRMB_TN(:)-PTHRMB_TC(:))* PEK%XPSN(:) *(1.0-PPSNA(:)) &
)/ZWORK(:)
-ZCOEFB_TC(:) = PFLXC_V_C(:)*PTHRMA_TV(:) /ZWORK(:)
+ZCOEFB_TC(:) = PFLXC_V_C(:)*PTHRMA_TV(:)/ZWORK(:)
-ZCOEFC_TC(:) = PFLXC_G_C(:)*PTHRMA_TG(:)*(1.0-PPSN(:)) /ZWORK(:)
+ZCOEFC_TC(:) = PFLXC_G_C(:)*PTHRMA_TG(:)*(1.0-PEK%XPSN(:))/ZWORK(:)
-ZCOEFD_TC(:) =(PFLXC_N_C(:)*PTHRMA_TN(:)* PPSN(:)*(1.0-PPSNA(:)) + &
+ZCOEFD_TC(:) =(PFLXC_N_C(:)*PTHRMA_TN(:)*PEK%XPSN(:)*(1.0-PPSNA(:)) + &
PFLXC_C_A(:) *PTHRMA_TA(:)*ZPET_C_COEF_P(:)*ZPSNAG(:) ) /ZWORK(:)
!- Canopy air q coefs, where : QC = COEFA_QC + COEFB_QC*TV + COEFC_QC*TG + COEFD_QC*TN
-
ZWORK(:) = PFLXC_C_A(:) *(1.-ZPEQ_A_COEF_P(:))*ZPSNAG(:) &
+ PFLXC_V_C(:)* ZHVS(:) &
- + PFLXC_G_C(:) *ZHN(:) *(1.0-PPSN(:)) &
- + PFLXC_N_C(:) *ZHNS * PPSN(:) *(1.0-PPSNA(:))
+ + PFLXC_G_C(:) *ZHN(:) *(1.0-PEK%XPSN(:)) &
+ + PFLXC_N_C(:) *ZHNS(:)* PEK%XPSN(:) *(1.0-PPSNA(:))
ZWORK(:) = MAX(ZERTOL, ZWORK(:))
ZCOEFA_QC(:) = ( PFLXC_C_A(:) *ZPEQ_B_COEF_P(:)*ZPSNAG(:) &
+ PFLXC_V_C(:) *ZHVS(:)*(PQSAT_V(:)-PDQSAT_V(:)*ZTVO(:) ) &
- + PFLXC_G_C(:) *ZHS(:) *(PQSAT_G(:)-PDQSAT_G(:)*ZTGO(:,1))*(1.0-PPSN(:)) &
- + PFLXC_N_C(:) *ZHNS *(PQSATI_N(:)-PDQSATI_N(:)*ZTNO(:,1))* &
- PPSN(:)*(1.0-PPSNA(:)) &
+ + PFLXC_G_C(:) *ZHS(:) *(PQSAT_G(:)-PDQSAT_G(:)*ZTGO(:,1))*(1.0-PEK%XPSN(:)) &
+ + PFLXC_N_C(:) *ZHNS(:)*(PQSATI_N(:)-PDQSATI_N(:)*ZTNO(:,1))* &
+ PEK%XPSN(:)*(1.0-PPSNA(:)) &
)/ZWORK(:)
-ZCOEFB_QC(:) = PFLXC_V_C(:) *ZHVS(:)*PDQSAT_V(:) /ZWORK(:)
+ZCOEFB_QC(:) = PFLXC_V_C(:) *ZHVS(:)*PDQSAT_V(:) /ZWORK(:)
-ZCOEFC_QC(:) = PFLXC_G_C(:) *ZHS(:) *PDQSAT_G(:)*(1.0-PPSN(:)) /ZWORK(:)
+ZCOEFC_QC(:) = PFLXC_G_C(:) *ZHS(:) *PDQSAT_G(:)*(1.0-PEK%XPSN(:))/ZWORK(:)
-ZCOEFD_QC(:) = PFLXC_N_C(:) *ZHNS *PDQSATI_N(:)* PPSN(:)*(1.0-PPSNA(:))/ZWORK(:)
+ZCOEFD_QC(:) = PFLXC_N_C(:) *ZHNS(:)*PDQSATI_N(:)* PEK%XPSN(:)*(1.0-PPSNA(:))/ZWORK(:)
!* 6. Surface Energy Budget(s) coefficients
! -------------------------------------
@@ -693,84 +655,84 @@ ZCOEFD_QC(:) = PFLXC_N_C(:) *ZHNS *PDQSATI_N(:)* PPSN(:)*(1.0-PPSNA(:))/
! 'N' linear equations and 'N' unknowns. Here we set up the coefficients.
! For computations here, make snow radiative terms relative to snow surface:
-ZWORK(:) = 1/MAX(ZERTOL, PPSN(:))
+ZWORK(:) = 1/MAX(ZERTOL, PEK%XPSN(:))
-ZRNET_NN(:) = (PSWNET_N(:) + PLWNET_N(:))*ZWORK(:)
+ZRNET_NN(:) = (DEK%XSWNET_NS(:) + DEK%XLWNET_N(:))*ZWORK(:)
ZRNET_N_DTNN(:) = PLWNET_N_DTN(:) *ZWORK(:)
ZRNET_N_DTGN(:) = PLWNET_N_DTG(:) *ZWORK(:)
ZRNET_N_DTVN(:) = PLWNET_N_DTV(:) *ZWORK(:)
-
! Tv coefs, where TV = BETA_V + ALPHA_V*TG + GAMMA_V*TN
+!
ZWORK(:) = (PCHEATV(:)/PTSTEP) - PLWNET_V_DTV(:) &
- + PFLXC_V_C(:)*(PTHRMA_TV(:) - PTHRMA_TC(:)*ZCOEFB_TC(:) &
- + XLVTT*ZHVS(:)*(PDQSAT_V(:) - ZCOEFB_QC(:)) )
+ + PFLXC_V_C(:) * ( PTHRMA_TV(:) - PTHRMA_TC(:)*ZCOEFB_TC(:) &
+ + PLTT(:)*ZHVS(:)*(PDQSAT_V(:) - ZCOEFB_QC(:)) )
-ZBETA_V(:) = ( (PCHEATV(:)/PTSTEP)*ZTVO(:) + PLWNET_V(:) + PSWNET_V(:) &
- - PLWNET_V_DTV(:)*ZTVO(:) - PLWNET_V_DTG(:)*ZTGO(:,1) - PLWNET_V_DTN(:)*ZTNO(:,1) &
- - PFLXC_V_C(:)*( PTHRMB_TV(:)-PTHRMB_TC(:)-PTHRMA_TC(:)*ZCOEFA_TC(:) &
- + XLVTT*ZHVS(:)*(PQSAT_V(:) - PDQSAT_V(:)*ZTVO(:) &
+ZBETA_V(:) = ( (PCHEATV(:)/PTSTEP)*ZTVO(:) + DEK%XLWNET_V(:) + DEK%XSWNET_V(:) &
+ - PLWNET_V_DTV(:)*ZTVO(:) - PLWNET_V_DTG(:)*ZTGO(:,1) - PLWNET_V_DTN(:)*ZTNO(:,1) &
+ - PFLXC_V_C(:)*( PTHRMB_TV(:)-PTHRMB_TC(:)-PTHRMA_TC(:)*ZCOEFA_TC(:) &
+ + PLTT(:)*ZHVS(:)*(PQSAT_V(:) - PDQSAT_V(:)*ZTVO(:) &
- ZCOEFA_QC(:)) ) )/ZWORK(:)
ZALPHA_V(:) = (PLWNET_V_DTG(:) + PFLXC_V_C(:)*(PTHRMA_TC(:)*ZCOEFC_TC(:) &
- + XLVTT*ZHVS(:)*ZCOEFC_QC(:) ) )/ZWORK(:)
+ + PLTT(:)*ZHVS(:)*ZCOEFC_QC(:) ) )/ZWORK(:)
ZGAMMA_V(:) = (PLWNET_V_DTN(:) + PFLXC_V_C(:)*(PTHRMA_TC(:)*ZCOEFD_TC(:) &
- + XLVTT*ZHVS(:)*ZCOEFD_QC(:) ) )/ZWORK(:)
+ + PLTT(:)*ZHVS(:)*ZCOEFD_QC(:) ) )/ZWORK(:)
! Tg coefs, where TG = BETA_G + ALPHA_G*TV + GAMMA_G*TN
-ZWORK(:) = (PCHEATG(:)/PTSTEP) - PLWNET_G_DTG(:) &
- + (1.0-PPSN(:))*PFLXC_G_C(:)*( (PTHRMA_TG(:) - PTHRMA_TC(:)*ZCOEFC_TC(:)) &
- + XLVTT*(ZHS(:)*PDQSAT_G(:) - ZHN(:)*ZCOEFC_QC(:)) ) &
+ZWORK(:) = (PCHEATG(:)/PTSTEP) - PLWNET_G_DTG(:) &
+ + (1.0-PEK%XPSN(:))*PFLXC_G_C(:)*( (PTHRMA_TG(:) - PTHRMA_TC(:)*ZCOEFC_TC(:)) &
+ + PLTT(:)*(ZHS(:)*PDQSAT_G(:) - ZHN(:)*ZCOEFC_QC(:)) ) &
+ ZTCONDA_DELZ_G(:)*(1.0-ZSOIL_COEF_A(:,2)) &
- + PPSN(:)*ZTCONDA_DELZ_NG(:)
+ + PEK%XPSN(:)*ZTCONDA_DELZ_NG(:)
-ZBETA_G(:) = ( (PCHEATG(:)/PTSTEP)*ZTGO(:,1) + PLWNET_G(:) + PSWNET_G(:) &
+ZBETA_G(:) = ( (PCHEATG(:)/PTSTEP)*ZTGO(:,1) + DEK%XLWNET_G(:) + DEK%XSWNET_G(:) &
- PLWNET_G_DTV(:)*ZTVO(:) - PLWNET_G_DTG(:)*ZTGO(:,1) - PLWNET_G_DTN(:)*ZTNO(:,1) &
- - (1.0-PPSN(:))*PFLXC_G_C(:)*( PTHRMB_TG(:)-PTHRMB_TC(:)-PTHRMA_TC(:)*ZCOEFA_TC(:) &
- + XLVTT*(ZHS(:)*(PQSAT_G(:) - PDQSAT_G(:)*ZTGO(:,1)) &
+ - (1.0-PEK%XPSN(:))*PFLXC_G_C(:)*( PTHRMB_TG(:)-PTHRMB_TC(:)-PTHRMA_TC(:)*ZCOEFA_TC(:) &
+ + PLTT(:)*(ZHS(:)*(PQSAT_G(:) - PDQSAT_G(:)*ZTGO(:,1)) &
- ZHN(:)*ZCOEFA_QC(:)) ) &
+ ZTCONDA_DELZ_G(:)*ZSOIL_COEF_B(:,2) &
- + PPSN(:)*ZTCONDA_DELZ_NG(:)*ZTNO(:,JNSNOW) )/ZWORK(:)
+ + PEK%XPSN(:)*ZTCONDA_DELZ_NG(:)*ZTNO(:,JNSNOW) )/ZWORK(:)
-ZALPHA_G(:) = (PLWNET_G_DTV(:) + PFLXC_G_C(:)*(1.0-PPSN(:))*( PTHRMA_TC(:)*ZCOEFB_TC(:) &
- + XLVTT*ZHN(:)*ZCOEFB_QC(:) ) )/ZWORK(:)
+ZALPHA_G(:) = (PLWNET_G_DTV(:) + PFLXC_G_C(:)*(1.0-PEK%XPSN(:))*( PTHRMA_TC(:)*ZCOEFB_TC(:) &
+ + PLTT(:)*ZHN(:)*ZCOEFB_QC(:) ) )/ZWORK(:)
-ZGAMMA_G(:) = (PLWNET_G_DTN(:) + PFLXC_G_C(:)*(1.0-PPSN(:))*( PTHRMA_TC(:)*ZCOEFD_TC(:) &
- + XLVTT*ZHN(:)*ZCOEFD_QC(:) ) )/ZWORK(:)
+ZGAMMA_G(:) = (PLWNET_G_DTN(:) + PFLXC_G_C(:)*(1.0-PEK%XPSN(:))*( PTHRMA_TC(:)*ZCOEFD_TC(:) &
+ + PLTT(:)*ZHN(:)*ZCOEFD_QC(:) ) )/ZWORK(:)
! Tn coefs, where TN = BETA_N + ALPHA_N*TV + GAMMA_N*TG
ZWORK(:) = (PCHEATN(:)/PTSTEP) - ZRNET_N_DTNN(:) &
+ PFLXC_N_C(:)*(1.-PPSNA(:))*( PTHRMA_TN(:) - PTHRMA_TC(:)*ZCOEFD_TC(:) &
- + (XLVTT*ZHNS)*(PDQSATI_N(:) - ZCOEFD_QC(:)) ) &
+ + (PLTT(:)*ZHNS)*(PDQSATI_N(:) - ZCOEFD_QC(:)) ) &
+ PFLXC_N_A(:)* PPSNA(:)*( &
PTHRMA_TN(:) - PTHRMA_TA(:)*(ZPET_A_COEF_P(:)*ZCOEFD_TC(:) + ZPET_C_COEF_P(:)) &
- + (XLVTT*ZHNS)*(PDQSATI_N(:)*(1.0-ZPEQ_C_COEF_P(:)) - ZPEQ_A_COEF_P(:)*ZCOEFD_QC(:)) ) &
+ + (PLTT(:)*ZHNS)*(PDQSATI_N(:)*(1.0-ZPEQ_C_COEF_P(:)) - ZPEQ_A_COEF_P(:)*ZCOEFD_QC(:)) ) &
+ ZTCONDA_DELZ_N(:)*(1.0-ZSNOW_COEF_A(:,2))
-ZBETA_N(:) = ( (PCHEATN(:)/PTSTEP)*ZTNO(:,1) + ZRNET_NN(:) + PHPSNOW(:) + PMELTADV(:) &
+ZBETA_N(:) = ( (PCHEATN(:)/PTSTEP)*ZTNO(:,1) + ZRNET_NN(:) + DMK%XHPSNOW(:) + DEK%XMELTADV(:) &
- ZRNET_N_DTVN(:)*ZTVO(:) - ZRNET_N_DTGN(:)*ZTGO(:,1) - ZRNET_N_DTNN(:)*ZTNO(:,1) &
- PFLXC_N_C(:)*(1.-PPSNA(:))*( PTHRMB_TN(:) - PTHRMB_TC(:) - PTHRMA_TC(:)*ZCOEFA_TC(:) &
- + (XLVTT*ZHNS)*(PQSATI_N(:) - PDQSATI_N(:)*ZTNO(:,1) &
+ + (PLTT(:)*ZHNS)*(PQSATI_N(:) - PDQSATI_N(:)*ZTNO(:,1) &
- ZCOEFA_QC(:)) ) &
- PFLXC_N_A(:)*PPSNA(:)*( PTHRMB_TC(:) - PTHRMB_TA(:) - &
PTHRMA_TA(:)*(ZPET_B_COEF_P(:) + ZCOEFA_TC(:)*ZPET_A_COEF_P(:)) &
- + (XLVTT*ZHNS)*((PQSATI_N(:) - PDQSATI_N(:)*ZTNO(:,1))*(1.0-ZPEQ_C_COEF_P(:)) &
+ + (PLTT(:)*ZHNS)*((PQSATI_N(:) - PDQSATI_N(:)*ZTNO(:,1))*(1.0-ZPEQ_C_COEF_P(:)) &
- ZPEQ_B_COEF_P(:) - ZPEQ_A_COEF_P(:)*ZCOEFA_QC(:)) ) &
+ ZTCONDA_DELZ_N(:)*ZSNOW_COEF_B(:,2) )/ZWORK(:)
ZALPHA_N(:) = ( ZRNET_N_DTVN(:) + PFLXC_N_C(:)*(1.-PPSNA(:))*( PTHRMA_TC(:)*ZCOEFB_TC(:) &
- + (XLVTT*ZHNS)*ZCOEFB_QC(:) ) &
+ + (PLTT(:)*ZHNS)*ZCOEFB_QC(:) ) &
+ PFLXC_N_A(:)* PPSNA(:) *( PTHRMA_TA(:)*ZCOEFB_TC(:)*ZPET_A_COEF_P(:) &
- + (XLVTT*ZHNS)*ZCOEFB_QC(:)*ZPEQ_A_COEF_P(:) ) )/ZWORK(:)
+ + (PLTT(:)*ZHNS)*ZCOEFB_QC(:)*ZPEQ_A_COEF_P(:) ) )/ZWORK(:)
ZGAMMA_N(:) = ( ZRNET_N_DTGN(:) + PFLXC_N_C(:)*(1.-PPSNA(:))*( PTHRMA_TC(:)*ZCOEFC_TC(:) &
- + (XLVTT*ZHNS)*ZCOEFC_QC(:)) &
+ + (PLTT(:)*ZHNS)*ZCOEFC_QC(:)) &
+ PFLXC_N_A(:)* PPSNA(:) *( PTHRMA_TA(:)*ZCOEFC_TC(:)*ZPET_A_COEF_P(:) &
- + (XLVTT*ZHNS)*ZCOEFC_QC(:)*ZPEQ_A_COEF_P(:) ) )/ZWORK(:)
+ + (PLTT(:)*ZHNS)*ZCOEFC_QC(:)*ZPEQ_A_COEF_P(:) ) )/ZWORK(:)
!* 7. Solve multiple energy budgets simultaneously (using an implicit time scheme)
! ----------------------------------------------------------------------------
@@ -779,7 +741,7 @@ ZGAMMA_N(:) = ( ZRNET_N_DTGN(:) + PFLXC_N_C(:)*(1.-PPSNA(:))*( PTHRMA_TC(:)*ZCOE
! fluxes (depending upon the values of the atmospheric Implicit Coupling (IC) coefficients)
-WHERE(PPSN(:) > 0.0)
+WHERE(PEK%XPSN(:) > 0.0)
ZWORK(:) = 1.0 - ZALPHA_V(:)*ZALPHA_G(:)
ZBETA_P_V(:) = (ZBETA_V(:) + ZALPHA_V(:)*ZBETA_G(:) )/ZWORK(:)
@@ -789,7 +751,7 @@ WHERE(PPSN(:) > 0.0)
ZBETA_P_N(:) = (ZBETA_N(:) + ZGAMMA_N(:)*ZBETA_G(:) )/ZWORK(:)
ZALPHA_P_N(:) = (ZALPHA_N(:) + ZGAMMA_N(:)*ZALPHA_G(:))/ZWORK(:)
- PTN(:,1) = (ZBETA_P_N(:) + ZALPHA_P_N(:)*ZBETA_P_V(:))/ &
+ DMK%XSNOWTEMP(:,1) = (ZBETA_P_N(:) + ZALPHA_P_N(:)*ZBETA_P_V(:))/ &
(1.0 - ZALPHA_P_N(:)*ZALPHA_P_V(:) )
! Since the fluxes are passed to the snow scheme, we can simply limit Tn here
@@ -797,79 +759,124 @@ WHERE(PPSN(:) > 0.0)
! doesn't exceed it's physical limit, Tf). The new real snow Tn consistent with these fluxes
! (and the T-profile within the snow) will be computed within the snow scheme.
- PTN(:,1) = MIN(XTT, PTN(:,1))
+ PSNOWLIQ(:,1) = PSNOWLIQ(:,1) + &
+ MAX(0., (DMK%XSNOWTEMP(:,1)-XTT)*PSNOWHCAPZ(:,1)*DMK%XSNOWDZ(:,1)/(XLMTT*XRHOLW)) ! m
+
+ DMK%XSNOWTEMP(:,1) = MIN(XTT, DMK%XSNOWTEMP(:,1))
- PTV(:) = ZBETA_P_V(:) + ZALPHA_P_V(:)*PTN(:,1)
+ PEK%XTV(:) = ZBETA_P_V(:) + ZALPHA_P_V(:)*DMK%XSNOWTEMP(:,1)
- PTG(:,1) = ZBETA_G(:) + ZALPHA_G(:)*PTV(:) + ZGAMMA_G(:)*PTN(:,1)
+ PTG(:,1) = ZBETA_G(:) + ZALPHA_G(:)*PEK%XTV(:) + ZGAMMA_G(:)*DMK%XSNOWTEMP(:,1)
- PTC(:) = ZCOEFA_TC(:) + ZCOEFB_TC(:)*PTV(:) + ZCOEFC_TC(:)*PTG(:,1) + ZCOEFD_TC(:)*PTN(:,1)
+ PEK%XTC(:) = ZCOEFA_TC(:) + ZCOEFB_TC(:)*PEK%XTV(:) + ZCOEFC_TC(:)*PTG(:,1) + ZCOEFD_TC(:)*DMK%XSNOWTEMP(:,1)
- PQC(:) = ZCOEFA_QC(:) + ZCOEFB_QC(:)*PTV(:) + ZCOEFC_QC(:)*PTG(:,1) + ZCOEFD_QC(:)*PTN(:,1)
+ PEK%XQC(:) = ZCOEFA_QC(:) + ZCOEFB_QC(:)*PEK%XTV(:) + ZCOEFC_QC(:)*PTG(:,1) + ZCOEFD_QC(:)*DMK%XSNOWTEMP(:,1)
! Lowest atmospheric level air temperature (for this patch):
- PTA_IC(:) = ZPET_B_COEF_P(:) + ZPET_A_COEF_P(:) *PTC(:) + ZPET_C_COEF_P(:) *PTN(:,1)
+ PTA_IC(:) = ZPET_B_COEF_P(:) + ZPET_A_COEF_P(:) *PEK%XTC(:) + ZPET_C_COEF_P(:) *DMK%XSNOWTEMP(:,1)
! Lowest atmospheric level specific humidity (for this patch):
! - First, compute the surface specific humidity of the snow:
- ZWORK(:) = ZHNS*( PQSATI_N(:) + PDQSATI_N(:)*(PTN(:,1) - ZTNO(:,1)) ) ! q_n+
+ ZWORK(:) = ZHNS(:)*( PQSATI_N(:) + PDQSATI_N(:)*(DMK%XSNOWTEMP(:,1) - ZTNO(:,1)) ) ! q_n+
- PQA_IC(:) = ZPEQ_B_COEF_P(:) + ZPEQ_A_COEF_P(:) *PQC(:) + ZPEQ_C_COEF_P(:) *ZWORK(:)
+ PQA_IC(:) = ZPEQ_B_COEF_P(:) + ZPEQ_A_COEF_P(:) *PEK%XQC(:) + ZPEQ_C_COEF_P(:) *ZWORK(:)
! diagnostic snow thermal flux: surface to sub-surface thermal transfer
-! ZRESTOREN(:) = PPSN(:)*ZTCONDA_DELZ_N(:)*(PTN(:,1)*(1.0-ZSNOW_COEF_A(:,2)) - ZSNOW_COEF_B(:,2))
+! ZRESTOREN(:) = PEK%XPSN(:)*ZTCONDA_DELZ_N(:)*(DMK%XSNOWTEMP(:)*(1.0-ZSNOW_COEF_A(:,2)) - ZSNOW_COEF_B(:,2))
ELSEWHERE ! snow free canopy-understory case:
PTG(:,1) = (ZBETA_G(:) + ZALPHA_G(:)*ZBETA_V(:))/ &
(1.0 - ZALPHA_G(:)*ZALPHA_V(:) )
- PTV(:) = ZBETA_V(:) + ZALPHA_V(:)*PTG(:,1)
+ PEK%XTV(:) = ZBETA_V(:) + ZALPHA_V(:)*PTG(:,1)
- PTC(:) = ZCOEFA_TC(:) + ZCOEFB_TC(:)*PTV(:) + ZCOEFC_TC(:)*PTG(:,1)
+ PEK%XTC(:) = ZCOEFA_TC(:) + ZCOEFB_TC(:)*PEK%XTV(:) + ZCOEFC_TC(:)*PTG(:,1)
- PQC(:) = ZCOEFA_QC(:) + ZCOEFB_QC(:)*PTV(:) + ZCOEFC_QC(:)*PTG(:,1)
+ PEK%XQC(:) = ZCOEFA_QC(:) + ZCOEFB_QC(:)*PEK%XTV(:) + ZCOEFC_QC(:)*PTG(:,1)
! Lowest atmospheric level air temperature (for this patch):
- PTA_IC(:) = ZPET_B_COEF_P(:) + ZPET_A_COEF_P(:) *PTC(:)
+ PTA_IC(:) = ZPET_B_COEF_P(:) + ZPET_A_COEF_P(:) *PEK%XTC(:)
! Lowest atmospheric level specific humidity (for this patch):
- PQA_IC(:) = ZPEQ_B_COEF_P(:) + ZPEQ_A_COEF_P(:) *PQC(:)
+ PQA_IC(:) = ZPEQ_B_COEF_P(:) + ZPEQ_A_COEF_P(:) *PEK%XQC(:)
! arbitrary: (as no snow mass present)
- PTN(:,1) = XTT
+ DMK%XSNOWTEMP(:,1) = XTT
! ZRESTOREN(:) = 0.0
END WHERE
!
-!
+!* 8. Solve for sub-surface test snow temperature profile
+! -----------------------------------------------------------------------------
! Compute test sub-surface snow temperatures: this improves time split estimate of
! surface to sub-surface flux estimates. Note that the sub-surface
! snow temperatures are "test" temperatures, with final "true" values
-! computed within the snow routine.
+! computed within the snow routine.
+! But we also include simple hydrology and refreezing since this can have
+! a significant impact during melt events on the sub-surface test
+! snow Temperature profile...
+!
+!
+CALL TRIDIAG_GROUND_RM_SOLN(ZT,ZCOEF_A,ZCOEF_B)
+!
+! Update Test T and Liquid content of snow:
!
-
- CALL TRIDIAG_GROUND_RM_SOLN(ZT,ZCOEF_A,ZCOEF_B)
DO JK=2,JNSNOW
- WHERE(PPSN(:) > 0.0)
- PTN(:,JK) = MIN(XTT,ZT(:,JK))
- ENDWHERE
+ DO JJ=1,JNPTS
+ IF(PEK%XPSN(JJ) > 0.0)THEN
+ PSNOWLIQ(JJ,JK) = PSNOWLIQ(JJ,JK) + MAX(0., (ZT(JJ,JK)-XTT)* &
+ PSNOWHCAPZ(JJ,JK)*DMK%XSNOWDZ(JJ,JK)/(XLMTT*XRHOLW)) ! m
+ DMK%XSNOWTEMP(JJ,JK) = MIN(XTT,ZT(JJ,JK))
+ ENDIF
+ ENDDO
ENDDO
!
+! Tipping bucket snow hydrology: update Liq
+! NOTE this mimicks what is assumed to be done in the snow scheme. If a more sophisticated
+! snow hydrology scheme is used, this code should be adapted.
!
-!* 8. Solve soil temperature profile (implicitly coupled to surface energy budgets)
+ZWHOLDMAX(:,:) = SNOW3LHOLD(PSNOWRHO,DMK%XSNOWDZ) ! m
+ZWORK(:) = MAX(0., PSNOWLIQ(:,1)-ZWHOLDMAX(:,1))
+PSNOWLIQ(:,1) = PSNOWLIQ(:,1) - ZWORK(:)
+DO JK=2,JNSNOW
+ DO JJ=1,JNPTS
+ PSNOWLIQ(JJ,JK) = PSNOWLIQ(JJ,JK) + ZWORK(JJ)
+ ZWORK(JJ) = MAX(0., PSNOWLIQ(JJ,JK)-ZWHOLDMAX(JJ,JK))
+ PSNOWLIQ(JJ,JK) = PSNOWLIQ(JJ,JK) - ZWORK(JJ)
+ ENDDO
+ENDDO
+PSNOWLIQ(:,:) = MAX(0.0, PSNOWLIQ(:,:)) ! numerical check
+!
+! Now, possibly refreeze liquid water which has flowed into a layer,
+! thus reducing liquid water and warming the snowpack:
+!
+DO JK=2,JNSNOW
+ DO JJ=1,JNPTS
+ IF(PEK%XPSN(JJ) > 0.0)THEN
+ DMK%XSNOWTEMP(JJ,JK) = DMK%XSNOWTEMP(JJ,JK) + PSNOWLIQ(JJ,JK)*(XLMTT*XRHOLW)/ &
+ (PSNOWHCAPZ(JJ,JK)*MAX(1.E-6,DMK%XSNOWDZ(JJ,JK))) ! K
+ ZWORK(JJ) = MAX(0., (XTT-DMK%XSNOWTEMP(JJ,JK))* &
+ PSNOWHCAPZ(JJ,JK)*DMK%XSNOWDZ(JJ,JK)/(XLMTT*XRHOLW)) ! m
+ PSNOWLIQ(JJ,JK) = PSNOWLIQ(JJ,JK) - ZWORK(JJ)
+ DMK%XSNOWTEMP(JJ,JK) = MIN(XTT,DMK%XSNOWTEMP(JJ,JK))
+ ENDIF
+ ENDDO
+ENDDO
+!
+!* 9. Solve soil temperature profile (implicitly coupled to surface energy budgets)
! -----------------------------------------------------------------------------
! The back-substitution of sub-surface soil T profile
! (update all temperatures *below* the surface)
!
-IF(HISBA == 'DIF')THEN
+IF(IO%CISBA == 'DIF')THEN
CALL TRIDIAG_GROUND_RM_SOLN(PTG,ZSOIL_COEF_A,ZSOIL_COEF_B)
ELSE
PTG(:,2) = ZSOIL_COEF_B(:,2) + ZSOIL_COEF_A(:,2)*PTG(:,1)
@@ -878,26 +885,26 @@ ENDIF
! Diagnose (semi-implicit) flux across ground base:
! (semi-implicit if T imposed, explicit if flux imposed)
!
-WHERE(PTDEEP_B(:) == XUNDEF)
+WHERE(KK%XTDEEP(:) == XUNDEF)
PDEEP_FLUX(:) = 0.0
ELSEWHERE
ZWORK(:) = PSOILCONDZ(:,JNGRND)*2/(PD_G(:,JNGRND)-PD_G(:,JNGRND-1)) ! (W/m2/K)
- PDEEP_FLUX(:) = ZWORK(:)*(PTDEEP_B(:) - PTG(:,JNGRND))/ &
+ PDEEP_FLUX(:) = ZWORK(:)*(KK%XTDEEP(:) - PTG(:,JNGRND))/ &
(1. - ZWORK(:)*PTDEEP_A(:)) ! (W/m2)
END WHERE
!
-!* 9. Temperature tendencies
+!* 10. Temperature tendencies
! ----------------------
!
! Compute energy budget tendencies (for flux computations)
! and sub-sfc soil tendencies (K) (for phase changes)
PDELTAT_G(:) = PTG(:,1) - ZTGO(:,1)
-PDELTAT_V(:) = PTV(:) - ZTVO(:)
-PDELTAT_N(:) = PTN(:,1) - ZTNO(:,1)
+PDELTAT_V(:) = PEK%XTV(:) - ZTVO(:)
+PDELTAT_N(:) = DMK%XSNOWTEMP(:,1) - ZTNO(:,1)
!
!
-!* 10. Flux Diagnostics
+!* 11. Flux Diagnostics
! ----------------
!
! Locally implicit (with respect to the ground T) snow-ground heat flux (W m-2).
@@ -907,24 +914,24 @@ PDELTAT_N(:) = PTN(:,1) - ZTNO(:,1)
! transferred to the soil as heating/cooling, thus
! conserving energy.
!
-PGRNDFLUX(:) = PPSN(:)*ZTCONDA_DELZ_NG(:)*( PTN(:,JNSNOW) - PTG(:,1) )
+PGRNDFLUX(:) = PEK%XPSN(:)*ZTCONDA_DELZ_NG(:)*( DMK%XSNOWTEMP(:,JNSNOW) - PTG(:,1) )
!
!
-!* 10. Energy Storage Diagnostics (W m-2)
+!* 12. Energy Storage Diagnostics (W m-2)
! ----------------------------------
!
PDELHEATG_SFC(:) = PCHEATG(:)*PDELTAT_G(:)/PTSTEP
PDELHEATV_SFC(:) = PCHEATV(:)*PDELTAT_V(:)/PTSTEP
!
-IF(HISBA == 'DIF')THEN
+IF(IO%CISBA == 'DIF')THEN
! Flux between surface and sub-surface (W m-2):
- PRESTORE(:) = (PTG(:,1) - PTG(:,2))* 2/( ((PD_G(:,2)-PD_G(:,1))/PSOILCONDZ(:,2)) + &
- ( PD_G(:,1) /PSOILCONDZ(:,1)) )
+ DEK%XRESTORE(:) = (PTG(:,1) - PTG(:,2))* 2/( ((PD_G(:,2)-PD_G(:,1))/PSOILCONDZ(:,2)) + &
+ ( PD_G(:,1) /PSOILCONDZ(:,1)) )
!
!
-!* 10.a Energy Storage Diagnostics (W m-2): DIF
+!* 12.a Energy Storage Diagnostics (W m-2): DIF
! ---------------------------------------
!
! These terms are used for computing energy budget diagnostics.
@@ -940,34 +947,37 @@ IF(HISBA == 'DIF')THEN
!
ELSE
-!* 10.b Energy Storage Diagnostics (W m-2): Force Restore
+!* 12.b Energy Storage Diagnostics (W m-2): Force Restore
! -------------------------------------------------
!
! Flux between surface and sub-surface (W m-2):
- PRESTORE(:) = (2*XPI/XDAY)*(PTG(:,1) - PTG(:,2))/PCT(:)
+ DEK%XRESTORE(:) = (2*XPI/XDAY)*(PTG(:,1) - PTG(:,2))/PCT(:)
! These terms are used for computing energy budget diagnostics.
!
- PDELHEATG(:) = PDELHEATG_SFC(:) + PRESTORE(:)
+ PDELHEATG(:) = PDELHEATG_SFC(:) + DEK%XRESTORE(:)
!
ENDIF
!
-!* 11. Additional Diagnostics
+!* 13. Additional Diagnostics
! ----------------------
!
! Here compute the updated (time t+dt) effective reference level specific heat capacity:
! (just a diagnostic here):
!
-IF (HCPSURF=='DRY') THEN
- PCPS(:) = XCPD
+IF (IO%CCPSURF=='DRY') THEN
+ PK%XCPS(:) = XCPD
ELSEIF(.NOT.LCPL_ARP)THEN
- PCPS(:) = XCPD + ( XCPV - XCPD ) * PQC(:)
+ PK%XCPS(:) = XCPD + ( XCPV - XCPD ) * PEK%XQC(:)
ENDIF
!
-PLVTT(:) = XLVTT
-PLSTT(:) = XLVTT ! latent heat of sublimation already accounted for
+! These latent heats are used to convert between
+! latent heat and water mass fluxes:
+!
+PK%XLVTT(:) = PLTT(:)
+PK%XLSTT(:) = PLTT(:)
!
!
IF (LHOOK) CALL DR_HOOK('E_BUDGET_MEB',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/ecoclimap2_lai.F90 b/src/SURFEX/ecoclimap2_lai.F90
index ce4206affaf419485a125c7f7b495b0e01c49ca2..467ca6d840d0385ecb27b3cc4a6ac6d9b4b05127 100644
--- a/src/SURFEX/ecoclimap2_lai.F90
+++ b/src/SURFEX/ecoclimap2_lai.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########################
- SUBROUTINE ECOCLIMAP2_LAI (DTCO)
+ SUBROUTINE ECOCLIMAP2_LAI (KYEAR)
! #########################
!
!!**** *ECOCLIMAP2_LAI* initializes cover-field correspondance arrays
@@ -38,9 +38,6 @@
!* 0. DECLARATION
! -----------
!
-!
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE MODD_DATA_COVER, ONLY : XDATA_LAI, XDATA_LAI_ALL_YEARS, LCLIM_LAI, &
@@ -60,8 +57,7 @@ IMPLICIT NONE
!* 0.2 Declaration of local variables
! ------------------------------
!
-!
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+INTEGER, INTENT(IN) :: KYEAR
!
REAL, DIMENSION(36) :: ZLAI
!
@@ -81,17 +77,15 @@ XDATA_LAI(301:,:,:) = XUNDEF
!* 2. if averaged LAI
! ---------------
!
-IF (LCLIM_LAI .OR. DTCO%NYEAR<NECO2_START_YEAR .OR. DTCO%NYEAR>NECO2_END_YEAR) THEN
+IF (LCLIM_LAI .OR. KYEAR<NECO2_START_YEAR .OR. KYEAR>NECO2_END_YEAR) THEN
!
DO JCOVER=301,JPCOVER
DO JVEGTYPE=1,NVEGTYPE
- IF (DTCO%XDATA_VEGTYPE(JCOVER,JVEGTYPE).ne.0.) THEN
- ZLAI(:) = 0.
- DO JYEAR=1,5
- ZLAI(:) = ZLAI(:) + XDATA_LAI_ALL_YEARS(JCOVER,(JYEAR-1)*36+1:JYEAR*36,JVEGTYPE)/5.
- END DO
- XDATA_LAI(JCOVER,:,JVEGTYPE) = ZLAI(:)
- ENDIF
+ ZLAI(:) = 0.
+ DO JYEAR=1,5
+ ZLAI(:) = ZLAI(:) + XDATA_LAI_ALL_YEARS(JCOVER,(JYEAR-1)*36+1:JYEAR*36,JVEGTYPE)/5.
+ END DO
+ XDATA_LAI(JCOVER,:,JVEGTYPE) = ZLAI(:)
END DO
END DO
@@ -100,12 +94,10 @@ IF (LCLIM_LAI .OR. DTCO%NYEAR<NECO2_START_YEAR .OR. DTCO%NYEAR>NECO2_END_YEAR) T
! -------------------------
ELSE
!
- IYEAR = DTCO%NYEAR - NECO2_START_YEAR
+ IYEAR = KYEAR - NECO2_START_YEAR
DO JCOVER=301,JPCOVER
DO JVEGTYPE=1,NVEGTYPE
- IF (DTCO%XDATA_VEGTYPE(JCOVER,JVEGTYPE).ne.0.) THEN
- XDATA_LAI(JCOVER,:,JVEGTYPE)=XDATA_LAI_ALL_YEARS(JCOVER,IYEAR*36+1:(IYEAR+1)*36,JVEGTYPE)
- ENDIF
+ XDATA_LAI(JCOVER,:,JVEGTYPE)=XDATA_LAI_ALL_YEARS(JCOVER,IYEAR*36+1:(IYEAR+1)*36,JVEGTYPE)
ENDDO
ENDDO
!
diff --git a/src/SURFEX/ecume_seaflux.F90 b/src/SURFEX/ecume_seaflux.F90
index 0e74ca14505a17928627e38e9a010723289a52d7..9df4460ce75539c030f953867757953aa00ee503 100644
--- a/src/SURFEX/ecume_seaflux.F90
+++ b/src/SURFEX/ecume_seaflux.F90
@@ -3,13 +3,11 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE ECUME_SEAFLUX(PZ0SEA,PMASK,KSIZE_WATER,KSIZE_ICE, &
- PTA,PEXNA,PRHOA,PSST,PSSS,PEXNS,PQA, &
+ SUBROUTINE ECUME_SEAFLUX(S,PMASK,KSIZE_WATER,KSIZE_ICE, &
+ PTA,PEXNA,PRHOA,PSST,PEXNS,PQA, &
PRAIN,PSNOW,PVMOD,PZREF,PUREF,PPS,PPA, &
- PICHCE,OPRECIP,OPWEBB,OPWG,KZ0, &
- OHANDLE_SIC,PQSAT,PSFTH,PSFTQ,PUSTAR,PCD,&
- PCDN,PCH,PCE,PRI,PRESA,PZ0HSEA, &
- OPERTFLUX,PPERTFLUX,HECUME )
+ PQSAT,PSFTH,PSFTQ,PUSTAR,PCD, &
+ PCDN,PCH,PCE,PRI,PRESA,PZ0HSEA )
! #######################################################################
!
!
@@ -54,6 +52,9 @@
!
!* 0. DECLARATIONS
! ------------
+!
+USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
+!
USE MODD_SURF_PAR, ONLY : XUNDEF
!!
USE MODI_ICE_SEA_FLUX
@@ -67,6 +68,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(SEAFLUX_t), INTENT(INOUT) :: S
+!
REAL, DIMENSION(:), INTENT(IN) :: PMASK ! Either a mask positive for open sea, or a seaice fraction
INTEGER , INTENT(IN) :: KSIZE_WATER ! number of points with some sea water
INTEGER , INTENT(IN) :: KSIZE_ICE ! number of points with some sea ice
@@ -79,25 +82,11 @@ REAL, DIMENSION(:), INTENT(IN) :: PVMOD ! module of wind at atm. wind level (
REAL, DIMENSION(:), INTENT(IN) :: PZREF ! atm. level for temp. and humidity (m)
REAL, DIMENSION(:), INTENT(IN) :: PUREF ! atm. level for wind (m)
REAL, DIMENSION(:), INTENT(IN) :: PSST ! Sea Surface Temperature (K)
-REAL, DIMENSION(:), INTENT(IN) :: PSSS ! Sea Surface Salinity (g/kg)
REAL, DIMENSION(:), INTENT(IN) :: PEXNS ! Exner function at sea surface
REAL, DIMENSION(:), INTENT(IN) :: PPS ! air pressure at sea surface (Pa)
REAL, DIMENSION(:), INTENT(IN) :: PPA ! air pressure at atm. level (Pa)
REAL, DIMENSION(:), INTENT(IN) :: PRAIN ! precipitation rate (kg/s/m2)
REAL, DIMENSION(:), INTENT(IN) :: PSNOW ! snow rate (kg/s/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PPERTFLUX ! stochastic flux perturbation pattern
-!
-REAL, INTENT(IN) :: PICHCE !
-LOGICAL, INTENT(IN) :: OPRECIP!
-LOGICAL, INTENT(IN) :: OPWEBB !
-LOGICAL, INTENT(IN) :: OPWG !
-LOGICAL, INTENT(IN) :: OPERTFLUX !
-INTEGER, INTENT(IN) :: KZ0
-LOGICAL, INTENT(IN) :: OHANDLE_SIC ! Do we weight seaice and open sea fluxes
- CHARACTER(LEN=6), INTENT(IN) :: HECUME ! type of ecume scheme
-!
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0SEA! roughness length over the ocean
!
! surface fluxes : latent heat, sensible heat, friction fluxes
REAL, DIMENSION(:), INTENT(OUT) :: PSFTH ! heat flux (W/m2)
@@ -132,7 +121,7 @@ IR_ICE(:)=0
J1=0
J2=0
!
-IF (OHANDLE_SIC) THEN
+IF (S%LHANDLE_SIC) THEN
! Must compute open sea fluxes even over fully ice-covered sea, which may melt partly
DO JJ=1,SIZE(PSST(:))
IR_WATER(JJ)= JJ
@@ -163,13 +152,13 @@ IF (KSIZE_WATER > 0 ) CALL TREAT_SURF(IR_WATER,'W')
! 3. sea ice : call to ICE_SEA_FLUX
! ------------------------------------
!
-IF ( (KSIZE_ICE > 0 ) .AND. (.NOT. OHANDLE_SIC) ) CALL TREAT_SURF(IR_ICE,'I')
+IF ( (KSIZE_ICE > 0 ) .AND. (.NOT. S%LHANDLE_SIC) ) CALL TREAT_SURF(IR_ICE,'I')
!
!
IF (LHOOK) CALL DR_HOOK('ECUME_SEAFLUX',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
- CONTAINS
+CONTAINS
SUBROUTINE TREAT_SURF(KMASK,YTYPE)
!
@@ -223,14 +212,14 @@ DO JJ=1, SIZE(KMASK)
ZW_ZREF(JJ) = PZREF(KMASK(JJ))
ZW_UREF(JJ) = PUREF(KMASK(JJ))
ZW_SST(JJ) = PSST(KMASK(JJ))
- ZW_SSS(JJ) = PSSS(KMASK(JJ))
+ ZW_SSS(JJ) = S%XSSS(KMASK(JJ))
ZW_EXNS(JJ) = PEXNS(KMASK(JJ))
ZW_PS(JJ) = PPS(KMASK(JJ))
ZW_PA(JJ) = PPA(KMASK(JJ))
ZW_RAIN(JJ) = PRAIN(KMASK(JJ))
ZW_SNOW(JJ) = PSNOW(KMASK(JJ))
- ZW_PERTFLUX(JJ) = PPERTFLUX(KMASK(JJ))
- ZW_Z0SEA(JJ)= PZ0SEA(KMASK(JJ))
+ ZW_PERTFLUX(JJ) = S%XPERTFLUX(KMASK(JJ))
+ ZW_Z0SEA(JJ)= S%XZ0(KMASK(JJ))
END DO
!
ZW_SFTH(:) = XUNDEF
@@ -247,21 +236,21 @@ ZW_Z0HSEA(:) = XUNDEF
!
IF (YTYPE=='W') THEN
!
- IF(HECUME=='ECUME6')THEN
+ IF(S%CSEA_FLUX=='ECUME6')THEN
!new ecume scheme
CALL ECUMEV6_FLUX(ZW_Z0SEA,ZW_TA,ZW_EXNA,ZW_RHOA,ZW_SST,ZW_SSS,ZW_EXNS, &
- ZW_QA,ZW_VMOD,ZW_ZREF,ZW_UREF,ZW_PS,ZW_PA,PICHCE,OPRECIP,OPWEBB,&
+ ZW_QA,ZW_VMOD,ZW_ZREF,ZW_UREF,ZW_PS,ZW_PA,S%XICHCE,S%LPRECIP,S%LPWEBB,&
ZW_QSAT,ZW_SFTH,ZW_SFTQ,ZW_USTAR,ZW_CD,ZW_CDN,ZW_CH,ZW_CE, &
- ZW_RI,ZW_RESA,ZW_RAIN,KZ0,ZW_Z0HSEA,OPERTFLUX,ZW_PERTFLUX)
+ ZW_RI,ZW_RESA,ZW_RAIN,S%NZ0,ZW_Z0HSEA,S%LPERTFLUX,ZW_PERTFLUX)
ELSE
!old ecume scheme
CALL ECUME_FLUX(ZW_Z0SEA,ZW_TA,ZW_EXNA,ZW_RHOA,ZW_SST,ZW_EXNS, &
- ZW_QA,ZW_VMOD,ZW_ZREF,ZW_UREF,ZW_PS,PICHCE,OPRECIP,OPWEBB,OPWG,&
+ ZW_QA,ZW_VMOD,ZW_ZREF,ZW_UREF,ZW_PS,S%XICHCE,S%LPRECIP,S%LPWEBB,S%LPWG,&
ZW_QSAT,ZW_SFTH,ZW_SFTQ,ZW_USTAR,ZW_CD,ZW_CDN,ZW_CH,ZW_CE, &
- ZW_RI,ZW_RESA,ZW_RAIN,ZW_Z0HSEA,OPERTFLUX,ZW_PERTFLUX)
+ ZW_RI,ZW_RESA,ZW_RAIN,ZW_Z0HSEA,S%LPERTFLUX,ZW_PERTFLUX)
ENDIF
!
-ELSEIF ( (YTYPE=='I') .AND. (.NOT. OHANDLE_SIC)) THEN
+ELSEIF ( (YTYPE=='I') .AND. (.NOT. S%LHANDLE_SIC)) THEN
!
CALL ICE_SEA_FLUX(ZW_Z0SEA,ZW_TA,ZW_EXNA,ZW_RHOA,ZW_SST,ZW_EXNS,ZW_QA,ZW_RAIN,ZW_SNOW, &
ZW_VMOD,ZW_ZREF,ZW_UREF,ZW_PS,ZW_QSAT,ZW_SFTH,ZW_SFTQ,ZW_USTAR,ZW_CD, &
@@ -271,7 +260,7 @@ ENDIF
!
DO JJ=1, SIZE(KMASK)
PQSAT(KMASK(JJ)) = ZW_QSAT(JJ)
- PZ0SEA(KMASK(JJ))= ZW_Z0SEA(JJ)
+ S%XZ0(KMASK(JJ))= ZW_Z0SEA(JJ)
PUSTAR(KMASK(JJ))= ZW_USTAR(JJ)
PSFTH(KMASK(JJ)) = ZW_SFTH(JJ)
PSFTQ(KMASK(JJ)) = ZW_SFTQ(JJ)
diff --git a/src/SURFEX/ecumev6_flux.F90 b/src/SURFEX/ecumev6_flux.F90
index 0b74d77571dce0ab0aa8b8e3cd1452def5c1597d..5adc6b78ead46bbea74ba6ff18db9533c1058e01 100644
--- a/src/SURFEX/ecumev6_flux.F90
+++ b/src/SURFEX/ecumev6_flux.F90
@@ -2,6 +2,10 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
! #########
SUBROUTINE ECUMEV6_FLUX(PZ0SEA,PTA,PEXNA,PRHOA,PSST,PSSS,PEXNS,PQA,PVMOD, &
PZREF,PUREF,PPS,PPA,PICHCE,OPRECIP,OPWEBB, &
diff --git a/src/SURFEX/emis_from_veg.F90 b/src/SURFEX/emis_from_veg.F90
index 13389eebc9514e17fd64e8896b15e913b82174e1..51fb55cccb5b39c4e4a6ae0f4b2578e5071b1aa9 100644
--- a/src/SURFEX/emis_from_veg.F90
+++ b/src/SURFEX/emis_from_veg.F90
@@ -37,14 +37,13 @@ REAL, DIMENSION(SIZE(PVEG,1),SIZE(PVEG,2)) :: PEMIS! emissivity
!
END FUNCTION EMIS_FROM_VEG_2D
!
- FUNCTION EMIS_FROM_VEG_PATCH(PVEG,PVEGTYPE) RESULT(PEMIS)
+ FUNCTION EMIS_FROM_VEG_VEGTYPE(PVEG) RESULT(PEMIS)
!
REAL, DIMENSION(:), INTENT (IN) :: PVEG
-REAL, DIMENSION(:), INTENT (IN) :: PVEGTYPE
!
REAL, DIMENSION(SIZE(PVEG)) :: PEMIS
-END FUNCTION EMIS_FROM_VEG_PATCH
+END FUNCTION EMIS_FROM_VEG_VEGTYPE
!
END INTERFACE
!
@@ -280,7 +279,7 @@ IF (LHOOK) CALL DR_HOOK('MODI_EMIS_FROM_VEG:EMIS_FROM_VEG_2D',1,ZHOOK_HANDLE)
END FUNCTION EMIS_FROM_VEG_2D
!
! ####################################################
- FUNCTION EMIS_FROM_VEG_PATCH(PVEG,PVEGTYPE) RESULT(PEMIS)
+ FUNCTION EMIS_FROM_VEG_VEGTYPE(PVEG) RESULT(PEMIS)
! ####################################################
!!
!! PURPOSE
@@ -332,30 +331,34 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
REAL, DIMENSION(:), INTENT(IN) :: PVEG ! vegetation fraction
-REAL, DIMENSION(:), INTENT(IN) :: PVEGTYPE ! type of vegetation
!
REAL, DIMENSION(SIZE(PVEG)) :: PEMIS ! emissivity
!
!* 0.2 declarations of local variables
!
REAL, DIMENSION(SIZE(PVEG)) :: ZEMISSOIL ! soil emissivity
+!
+INTEGER :: JJ
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-----------------------------------------------------------------
!
-IF (LHOOK) CALL DR_HOOK('MODI_EMIS_FROM_VEG:EMIS_FROM_VEG_PATCH',0,ZHOOK_HANDLE)
-ZEMISSOIL(:) = XEMISSN * PVEGTYPE(NVT_SNOW) &
- + XEMISSOIL * (1.-PVEGTYPE(NVT_SNOW))
+IF (LHOOK) CALL DR_HOOK('MODI_EMIS_FROM_VEG:EMIS_FROM_VEG_VEGTYPE',0,ZHOOK_HANDLE)
!
-PEMIS(:) = XEMISVEG * PVEG(:) &
- + ZEMISSOIL * (1.-PVEG(:))
+PEMIS(:) = XUNDEF
!
-WHERE (PVEG(:) == XUNDEF)
- PEMIS(:) = XUNDEF
-END WHERE
+DO JJ = 1,SIZE(PEMIS)
+ IF (PVEG(JJ)/=XUNDEF) THEN
+ IF (JJ/=NVT_SNOW) THEN
+ PEMIS(JJ) = XEMISVEG * PVEG(JJ) + XEMISSOIL * (1.-PVEG(JJ))
+ ELSE
+ PEMIS(JJ) = XEMISSN
+ ENDIF
+ ENDIF
+ENDDO
!
-IF (LHOOK) CALL DR_HOOK('MODI_EMIS_FROM_VEG:EMIS_FROM_VEG_PATCH',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('MODI_EMIS_FROM_VEG:EMIS_FROM_VEG_VEGTYPE',1,ZHOOK_HANDLE)
!
!-----------------------------------------------------------------
!
-END FUNCTION EMIS_FROM_VEG_PATCH
+END FUNCTION EMIS_FROM_VEG_VEGTYPE
diff --git a/src/SURFEX/end_io_surf_ascn.F90 b/src/SURFEX/end_io_surf_ascn.F90
index be41c82f257202c2c5c076d504612ee45c4f97bf..71dc9a70a91663a300664bdc21571530013c3a38 100644
--- a/src/SURFEX/end_io_surf_ascn.F90
+++ b/src/SURFEX/end_io_surf_ascn.F90
@@ -37,7 +37,8 @@
!* 0. DECLARATIONS
! ------------
!
-USE MODD_IO_SURF_ASC, ONLY : NUNIT, NFULL, CMASK, LOPEN
+USE MODD_IO_SURF_ASC, ONLY : NUNIT, NFULL, CMASK, CFILEIN, CFILEOUT, &
+ CFILE, NMASK
!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
!
@@ -60,19 +61,19 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('END_IO_SURF_ASC_N',0,ZHOOK_HANDLE)
!
-!$OMP BARRIER
-!
-IF (NRANK==NPIO .AND. LOPEN) THEN
-!$OMP SINGLE
+IF (CFILE==CFILEOUT .AND. NRANK==NPIO .OR. CFILE==CFILEIN) THEN
CLOSE(NUNIT)
-!$OMP END SINGLE
ENDIF
!
+CFILE = ' '
+!
NFULL = 0
!
NUNIT = 0
!
- CMASK = ' '
+CMASK = ' '
+!
+NMASK=>NULL()
!
IF (LHOOK) CALL DR_HOOK('END_IO_SURF_ASC_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/end_io_surf_fan.F90 b/src/SURFEX/end_io_surf_fan.F90
index 3cca4548c8d5563bcffba5eadeb4913b1a67a978..01170a98ee2b37a8f7e333c51b04b999db4d919e 100644
--- a/src/SURFEX/end_io_surf_fan.F90
+++ b/src/SURFEX/end_io_surf_fan.F90
@@ -37,7 +37,8 @@
!* 0. DECLARATIONS
! ------------
!
-USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, NFULL, CMASK, LOPEN
+USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, NFULL, CMASK, LOPEN, CFILEIN_FA, CFILEOUT_FA, CFILE_FA, &
+ NMASK
!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, WLOG_MPI
!
@@ -61,18 +62,20 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('END_IO_SURF_FA_N',0,ZHOOK_HANDLE)
!
-!$OMP BARRIER
-!
NFULL = 0
!
- CMASK = ' '
+CMASK = ' '
!
-IF (NRANK==NPIO .AND. LOPEN) THEN
-!$OMP SINGLE
+IF ((CFILE_FA==CFILEOUT_FA .AND. NRANK==NPIO .OR. CFILE_FA==CFILEIN_FA).AND.LOPEN) THEN
CALL FAIRME(IRET,NUNIT_FA,'UNKNOWN')
-!$OMP END SINGLE
+ NUNIT_FA = 0
+ LOPEN = .FALSE.
END IF
!
+CFILE_FA = ' '
+!
+NMASK=>NULL()
+!
IF (LHOOK) CALL DR_HOOK('END_IO_SURF_FA_N',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/end_io_surfn.F90 b/src/SURFEX/end_io_surfn.F90
index 29ddadc92b7b01e4e74f426e0f85c5cc9ccc5c67..e62b232250cf3c5f82679b7d00c539f89b039221 100644
--- a/src/SURFEX/end_io_surfn.F90
+++ b/src/SURFEX/end_io_surfn.F90
@@ -55,12 +55,16 @@ USE MODI_END_IO_SURF_OL_n
#ifdef SFX_MNH
USE MODI_MNHEND_IO_SURF_n
#endif
+#ifdef SFX_ARO
+USE MODI_AROEND_IO_SURF_n
+#endif
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+!
!* 0.1 Declarations of arguments
! -------------------------
!
diff --git a/src/SURFEX/exp_decay_soil_dif.F90 b/src/SURFEX/exp_decay_soil_dif.F90
deleted file mode 100644
index c0aa4f800799e65e92ce81537948ce7dd8115bd6..0000000000000000000000000000000000000000
--- a/src/SURFEX/exp_decay_soil_dif.F90
+++ /dev/null
@@ -1,16 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########################
-SUBROUTINE EXP_DECAY_SOIL_DIF
-! #################################################################
-!
-! Ã supprimer
-!
-END SUBROUTINE EXP_DECAY_SOIL_DIF
-
-
-
-
-
diff --git a/src/SURFEX/exp_decay_soil_fr.F90 b/src/SURFEX/exp_decay_soil_fr.F90
index b72f53a1e55ef441a65f2367a1f8b41c07af396f..6095c9d7bfb18ea59f23d0bace6073b53e0bfa4c 100644
--- a/src/SURFEX/exp_decay_soil_fr.F90
+++ b/src/SURFEX/exp_decay_soil_fr.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ##########
- SUBROUTINE EXP_DECAY_SOIL_FR (HISBA, PF, PC1SAT, PC2REF, PD_G, PD_ICE, &
- PC4REF, PC3, PCONDSAT, PKSAT_ICE )
+ SUBROUTINE EXP_DECAY_SOIL_FR (HISBA, PF, PK, PC_DEPTH_RATIO)
! ##########################################################################
!
!!**** *EXP_DECAY_SOIL_FR*
@@ -45,12 +44,11 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_n, ONLY : ISBA_P_t
+!
USE MODD_SURF_PAR,ONLY : XUNDEF
USE MODD_SGH_PAR, ONLY : X2
USE MODD_CSTS, ONLY : XDAY
-#ifdef TOPD
-USE MODD_DUMMY_EXP_PROFILE,ONLY : XC_DEPTH_RATIO
-#endif
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -67,30 +65,9 @@ IMPLICIT NONE
REAL, DIMENSION(:), INTENT(IN) :: PF
! PF = exponential decay factor (1/m)
!
-REAL, DIMENSION(:), INTENT(INOUT) :: PC2REF,PC1SAT
-! PC1SAT = C1 at saturation
-! PC2REF = reference value of C2
-!
-REAL, DIMENSION(:,:),INTENT(INOUT):: PCONDSAT
-! PCONDSAT = hydraulic conductivity at saturation (m s-1)
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_G
-! PD_G = Depth of bottom of Soil layers (m)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PD_ICE
-! PD_ICE = depth of the soil column for
-! fraction of frozen soil calculation (m)
-
-REAL, DIMENSION(:,:),INTENT(INOUT):: PC3
-! PC3 = C3 coef with exponential decay of hydraulic soil profil
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PC4REF
-! PC4REF = fiiting soil paramater for vertical diffusion (C4)
-! with exponential decay of hydraulic soil profil
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
!
-REAL, DIMENSION(:), INTENT(OUT) :: PKSAT_ICE
-! PKSAT_ICE = hydraulic conductivity at saturation (m s-1)
-! on frozen soil depth (Horton calculation)
+REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: PC_DEPTH_RATIO
!
!* 0.2 declarations of local variables
!
@@ -102,74 +79,75 @@ REAL, DIMENSION(SIZE(PF)) :: ZD_G_TOT, ZC_DEPTH, ZKSAT_NOEXP, ZC_DEPTH_R
! Hornberger. (m)
! For ISBA-FR, we take the root depth.
!
+INTEGER :: JP
+!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('EXP_DECAY_SOIL_FR',0,ZHOOK_HANDLE)
!
-ZD_G_TOT(:) = PD_G(:,2)
-IF(HISBA=='3-L')ZD_G_TOT(:) = PD_G(:,3)
+ZD_G_TOT(:) = PK%XDG(:,2)
+IF(HISBA=='3-L')ZD_G_TOT(:) = PK%XDG(:,3)
!
-ZKSAT_NOEXP(:) = PCONDSAT(:,2)
+ZKSAT_NOEXP(:) = PK%XCONDSAT(:,2)
!
ZC_DEPTH_RATIO(:) = 1.
!
-#ifdef TOPD
-IF (ALLOCATED(XC_DEPTH_RATIO)) ZC_DEPTH_RATIO(:) = XC_DEPTH_RATIO(:)
-#endif
+IF (PRESENT(PC_DEPTH_RATIO)) ZC_DEPTH_RATIO(:) = PC_DEPTH_RATIO(:)
!
WHERE(ZD_G_TOT(:)/=XUNDEF)
-!
-!compacted depth
-!
-ZC_DEPTH(:) = PD_G(:,2)*ZC_DEPTH_RATIO(:)
-!ZC_DEPTH(:) = PD_G(:,2)
-!
-!surface hydraulic conductivity at saturation
-!
-PCONDSAT(:,1) = PCONDSAT(:,1)*EXP(PF(:)*ZC_DEPTH(:))
-!
-!mean hydraulic conductivity at saturation over the root zone
-!
-PCONDSAT(:,2) = ZKSAT_NOEXP(:)*( EXP(PF(:)*ZC_DEPTH)-EXP(PF(:)*(ZC_DEPTH(:)-PD_G(:,2))) ) &
- /(PF(:)*PD_G(:,2))
-!
-!mean hydraulic conductivity at saturation over the first soil centimeters
-!
-PKSAT_ICE(:) = ZKSAT_NOEXP(:)*( EXP(PF(:)*ZC_DEPTH)-EXP(PF(:)*(ZC_DEPTH(:)-PD_ICE(:))) ) &
- /(PF(:)*PD_ICE(:))
-!
-!decay factor for C1 coef
-!
-PC1SAT(:) = PC1SAT(:)*SQRT( EXP(-PF(:)*ZC_DEPTH(:)) )
-!
-!decay factor for C2 coef
-!
-PC2REF(:)=PC2REF(:)+( PCONDSAT(:,2)-ZKSAT_NOEXP(:) ) * XDAY/PD_G(:,2)
-!
-!C3 coef with exponential decay in root soil layer
-!
-PC3(:,1)=PC3(:,1)*( EXP(PF(:)*ZC_DEPTH(:))-EXP(PF(:)*(ZC_DEPTH(:)-PD_G(:,2))) ) / (PF(:)*PD_G(:,2))
-!
+ !
+ !compacted depth
+ !
+ ZC_DEPTH(:) = PK%XDG(:,2)*ZC_DEPTH_RATIO(:)
+ !ZC_DEPTH(:) = PK%XDG(:,2)
+ !
+ !surface hydraulic conductivity at saturation
+ !
+ PK%XCONDSAT(:,1) = PK%XCONDSAT(:,1)*EXP(PF(:)*ZC_DEPTH(:))
+ !
+ !mean hydraulic conductivity at saturation over the root zone
+ !
+ PK%XCONDSAT(:,2) = ZKSAT_NOEXP(:)*( EXP(PF(:)*ZC_DEPTH)-EXP(PF(:)*(ZC_DEPTH(:)-PK%XDG(:,2))) ) &
+ /(PF(:)*PK%XDG(:,2))
+ !
+ !mean hydraulic conductivity at saturation over the first soil centimeters
+ !
+ PK%XKSAT_ICE(:) = ZKSAT_NOEXP(:)*( EXP(PF(:)*ZC_DEPTH)-EXP(PF(:)*(ZC_DEPTH(:)-PK%XD_ICE(:))) ) &
+ /(PF(:)*PK%XD_ICE(:))
+ !
+ !decay factor for C1 coef
+ !
+ PK%XC1SAT(:) = PK%XC1SAT(:)*SQRT( EXP(-PF(:)*ZC_DEPTH(:)) )
+ !
+ !decay factor for C2 coef
+ !
+ PK%XC2REF(:)=PK%XC2REF(:)+( PK%XCONDSAT(:,2)-ZKSAT_NOEXP(:) ) * XDAY/PK%XDG(:,2)
+ !
+ !C3 coef with exponential decay in root soil layer
+ !
+ PK%XC3(:,1)=PK%XC3(:,1)*( EXP(PF(:)*ZC_DEPTH(:))-EXP(PF(:)*(ZC_DEPTH(:)-PK%XDG(:,2))) ) / &
+ (PF(:)*PK%XDG(:,2))
+ !
ENDWHERE
!
IF(HISBA=='3-L')THEN
-!
- WHERE(PD_G(:,2)< ZD_G_TOT(:).AND.PD_G(:,2)/=XUNDEF)
-!
-! C3 coef with exponential decay in deep soil layer
-!
- PC3(:,2)=PC3(:,2)*( EXP(PF(:)*(ZC_DEPTH(:)-PD_G(:,2)))-EXP(PF(:)*(ZC_DEPTH(:)-ZD_G_TOT(:))) ) &
- / (PF(:)*(ZD_G_TOT(:)-PD_G(:,2)))
-!
-! decay factor for C4 coef
-!
- PC4REF(:)=PC4REF(:)*( EXP(PF(:)*(ZC_DEPTH(:)-PD_G(:,2)/X2))-EXP(PF(:)*(ZC_DEPTH(:)&
- -((PD_G(:,2)+ZD_G_TOT(:))/2.))) ) * X2/(PF(:)*ZD_G_TOT(:))
-!
- ENDWHERE
-!
+ !
+ WHERE(PK%XDG(:,2)< ZD_G_TOT(:).AND.PK%XDG(:,2)/=XUNDEF)
+ !
+ ! C3 coef with exponential decay in deep soil layer
+ !
+ PK%XC3(:,2)=PK%XC3(:,2)*( EXP(PF(:)*(ZC_DEPTH(:)-PK%XDG(:,2)))-EXP(PF(:)*(ZC_DEPTH(:)-ZD_G_TOT(:))) ) &
+ / (PF(:)*(ZD_G_TOT(:)-PK%XDG(:,2)))
+ !
+ ! decay factor for C4 coef
+ !
+ PK%XC4REF(:)=PK%XC4REF(:)*( EXP(PF(:)*(ZC_DEPTH(:)-PK%XDG(:,2)/X2))-EXP(PF(:)*(ZC_DEPTH(:)&
+ -((PK%XDG(:,2)+ZD_G_TOT(:))/2.))) ) * X2/(PF(:)*ZD_G_TOT(:))
+ !
+ ENDWHERE
+ !
ENDIF
!
IF (LHOOK) CALL DR_HOOK('EXP_DECAY_SOIL_FR',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/explicit_slope.F90 b/src/SURFEX/explicit_slope.F90
index 0175b4920b256ca8f6b2a7f0d45fb27a86248b64..e52db21426b90f1f10d263b6420aa7c0de9532cc 100644
--- a/src/SURFEX/explicit_slope.F90
+++ b/src/SURFEX/explicit_slope.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########################################################################
-SUBROUTINE EXPLICIT_SLOPE (UG, &
+SUBROUTINE EXPLICIT_SLOPE (UG,KDIM_FULL, &
PZS,PSSO_SLOPE)
! #########################################################################
!! AUTHOR
@@ -16,11 +16,12 @@ SUBROUTINE EXPLICIT_SLOPE (UG, &
!
!* 0. DECLARATIONS
! ------------
-!
-
!
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
!
+USE MODI_READ_AND_SEND_MPI
+USE MODI_GATHER_AND_WRITE_MPI
+!
USE MODI_GET_GRID_DIM
USE MODI_GET_MESH_DIM
@@ -30,6 +31,7 @@ IMPLICIT NONE
!
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
!
+INTEGER, INTENT(IN) :: KDIM_FULL
REAL,DIMENSION(:),INTENT(IN)::PZS ! resolved model orography
REAL,DIMENSION(:),INTENT(OUT)::PSSO_SLOPE ! resolved slope tangent
@@ -63,6 +65,9 @@ REAL, DIMENSION(:),ALLOCATABLE :: ZYHAT ! Y coordinate
REAL,DIMENSION(:), ALLOCATABLE :: ZDX ! grid mesh size in x direction
REAL,DIMENSION(:), ALLOCATABLE :: ZDY ! grid mesh size in y direction
+REAL, DIMENSION(:), ALLOCATABLE :: ZZS0
+REAL, DIMENSION(:), ALLOCATABLE :: ZSSO_SLOPE0
+!
! parameters
REAL, PARAMETER :: XPI=4.*ATAN(1.) ! Pi
INTEGER, PARAMETER :: JPHEXT = 1 ! number of points around the physical domain
@@ -83,7 +88,7 @@ REAL :: ZSURF ! surface of 4 triangles
!* 1.1 Gets the geometry of the grid
! -----------------------------
!
- CALL GET_GRID_DIM(UG%CGRID,SIZE(UG%XGRID_PAR),UG%XGRID_PAR,GRECT,IX,IY)
+CALL GET_GRID_DIM(UG%G%CGRID,SIZE(UG%XGRID_FULL_PAR),UG%XGRID_FULL_PAR,GRECT,IX,IY)
!
INNX=IX+2
INNY=IY+2
@@ -96,17 +101,18 @@ INNY=IY+2
ALLOCATE(ZDX (IX*IY))
ALLOCATE(ZDY (IX*IY))
-
- CALL GET_MESH_DIM(UG%CGRID,SIZE(UG%XGRID_PAR),IX*IY,UG%XGRID_PAR,ZDX,ZDY,UG%XMESH_SIZE)
-
+CALL GET_MESH_DIM(UG%G%CGRID,SIZE(UG%XGRID_FULL_PAR),IX*IY,UG%XGRID_FULL_PAR,ZDX,ZDY,UG%G%XMESH_SIZE)
!
!* 2. If grid is not rectangular, nothing is done
! -------------------------------------------
!
+ ALLOCATE(ZZS0(KDIM_FULL))
+ CALL GATHER_AND_WRITE_MPI(PZS,ZZS0)
+ !
!IF (.NOT. GRECT) RETURN
!
-IF (SIZE(PZS) /= IX * IY) RETURN
+IF (SIZE(ZZS0) /= IX * IY) RETURN
!
!-------------------------------------------------------------------------------
!
@@ -118,10 +124,12 @@ ALLOCATE(ZZSL (INNX,INNY))
DO JY=1,IY
DO JX=1,IX
- ZZS (JX,JY) = PZS ( JX + (JY-1)*IX )
+ ZZS (JX,JY) = ZZS0 ( JX + (JY-1)*IX )
END DO
END DO
+DEALLOCATE(ZZS0)
+!
ZZSL(2:INNX-1,2:INNY-1) = ZZS(:,:)
ZZSL(1,:) = ZZSL(2,:)
ZZSL(INNX,:) = ZZSL(INNX-1,:)
@@ -230,13 +238,17 @@ DEALLOCATE(ZZSL)
DEALLOCATE(ZZS)
DEALLOCATE(ZZS_XY)
DEALLOCATE(ZMAP)
-
+!
+ALLOCATE(ZSSO_SLOPE0(KDIM_FULL))
+!
DO JY=1,IY
DO JX=1,IX
- PSSO_SLOPE( JX + (JY-1)*IX )=ZSSO_SLOPE(JX,JY)
+ ZSSO_SLOPE0( JX + (JY-1)*IX )=ZSSO_SLOPE(JX,JY)
END DO
END DO
-
-
-
+!
+CALL READ_AND_SEND_MPI(ZSSO_SLOPE0,PSSO_SLOPE)
+!
+DEALLOCATE(ZSSO_SLOPE0)
+!
END SUBROUTINE EXPLICIT_SLOPE
diff --git a/src/SURFEX/extend_grid_on_halo.F90 b/src/SURFEX/extend_grid_on_halo.F90
index 71225a15580a81d3c9826d7c90854fc4825d1229..75863656354fb4b87fd2f4dd9b0566400a01876b 100644
--- a/src/SURFEX/extend_grid_on_halo.F90
+++ b/src/SURFEX/extend_grid_on_halo.F90
@@ -67,18 +67,19 @@ REAL, DIMENSION(:), POINTER, INTENT(INOUT) :: PGRID_PAR ! parameters defining th
REAL(KIND=JPRB) :: ZHOOK_HANDLE
CHARACTER(LEN=100) :: YCOMMENT
INTEGER :: IRESP ! error return code
-INTEGER :: IHALO
+INTEGER :: IHALO, ISIZE_FULL
!------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('SPLIT_GRID',0,ZHOOK_HANDLE)
!
-SELECT CASE(UG%CGRID)
+SELECT CASE(UG%G%CGRID)
CASE('CONF PROJ ')
CALL EXTEND_GRID_ON_HALO_CONF_PROJ(HPROGRAM,U%NDIM_FULL,U%NSIZE_FULL,KGRID_PAR,PGRID_PAR)
CASE('CARTESIAN ')
CALL EXTEND_GRID_ON_HALO_CARTESIAN(HPROGRAM,U%NDIM_FULL,U%NSIZE_FULL,KGRID_PAR,PGRID_PAR)
CASE DEFAULT
- CALL GET_SIZE_FULL_n(U,HPROGRAM,U%NDIM_FULL,U%NSIZE_FULL)
+ CALL GET_SIZE_FULL_n(HPROGRAM,U%NDIM_FULL,U%NSIZE_FULL,ISIZE_FULL)
+ U%NSIZE_FULL = ISIZE_FULL
END SELECT
!
diff --git a/src/SURFEX/extrapol_fields.F90 b/src/SURFEX/extrapol_fields.F90
index b25265dcd707fe82bd316ea2e393bbe4a0567394..d17d63183f5c160f67e0710d172d48009c770c7b 100644
--- a/src/SURFEX/extrapol_fields.F90
+++ b/src/SURFEX/extrapol_fields.F90
@@ -2,12 +2,11 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
-SUBROUTINE EXTRAPOL_FIELDS (DTCO, DTI, IG, I, UG, U, &
- HPROGRAM,KLUOUT)
+SUBROUTINE EXTRAPOL_FIELDS (DTCO, DTV, KDIM, IO, S, UG, U, HPROGRAM,KLUOUT)
!!
!! PURPOSE
!! -------
-!! parameters defined by cover need to be extrapolated if LDATA_VEGTYPE and NOT LDATA_"PARAM"
+!! parameters defined by cover need to be extrapolated if LDATA_ISBATYPE and NOT LDATA_"PARAM"
!! all ten-day periods are calculated one time for all, then written in PGD.txt
!!
!! METHOD
@@ -41,24 +40,29 @@ SUBROUTINE EXTRAPOL_FIELDS (DTCO, DTI, IG, I, UG, U, &
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
+USE MODD_TYPE_DATE_SURF
+USE MODD_AGRI, ONLY : LAGRIP
+USE MODD_TREEDRAG, ONLY : LTREEDRAG
+!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE MODD_REPROD_OPER, ONLY : CDGDIF, CDGAVG
!
USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, NVT_NO, NVT_ROCK, NVT_SNOW, JPCOVER
!
-USE MODD_DATA_COVER, ONLY : XDATA_LAI, XDATA_H_TREE, &
- XDATA_IRRIG, XDATA_WATSUP, &
- XDATA_GARDEN, XDATA_NATURE, &
- XDATA_ROOT_DEPTH, XDATA_ROOT_DEPTHGV, XDATA_GROUND_DEPTH, &
- XDATA_ROOT_EXTINCTION, XDATA_ROOT_LIN
-!
-!
+USE MODD_DATA_COVER, ONLY : XDATA_LAI, XDATA_H_TREE, &
+ XDATA_IRRIG, XDATA_WATSUP, &
+ XDATA_GARDEN, XDATA_NATURE, &
+ XDATA_ROOT_DEPTH,XDATA_GROUND_DEPTH, &
+ XDATA_ROOT_EXTINCTION, XDATA_ROOT_LIN, &
+ TDATA_SEED, TDATA_REAP, XDATA_ALB_VEG_NIR, &
+ XDATA_ALB_VEG_VIS, XDATA_ALB_SOIL_NIR, &
+ XDATA_ALB_SOIL_VIS
!
USE MODI_AV_PGD
USE MODI_INI_VAR_FROM_VEGTYPE_DATA
@@ -73,9 +77,10 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+INTEGER, INTENT(IN) :: KDIM
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
@@ -86,10 +91,11 @@ INTEGER, INTENT(IN) :: KLUOUT
!* 0.2 Declaration of local variables
! ------------------------------
!
+TYPE(DATE_TIME), DIMENSION(:,:), ALLOCATABLE :: TPWORK
REAL, DIMENSION (SIZE(XDATA_GROUND_DEPTH,1),NVEGTYPE) :: ZDATA_GROUND_DEPTH
!
- CHARACTER(LEN=3) :: YTREE, YNAT, YVEG, YDIF, YROOT
-REAL, DIMENSION(IG%NDIM,36,NVEGTYPE) :: ZWORK
+CHARACTER(LEN=3) :: YTREE, YNAT, YVEG, YDIF, YROOT, YBAR
+REAL, DIMENSION(KDIM,36,NVEGTYPE) :: ZWORK
REAL, DIMENSION(NVEGTYPE) :: ZDEF
REAL :: ZFRAC
INTEGER :: JTIME, JVEGTYPE, JCOVER
@@ -103,27 +109,28 @@ YNAT ='NAT'
YTREE='TRE'
YVEG ='VEG'
YDIF ='DVG'
+YBAR='BAR'
!
! 2. Extrapolations for land use or user
! --------------------------------------
!
! LAI
! ---
-IF (.NOT.DTI%LDATA_LAI) THEN
+IF (.NOT.ANY(DTV%LDATA_LAI).AND.IO%CPHOTO/='NIT'.AND.IO%CPHOTO/='NCB') THEN
!
+ ALLOCATE(DTV%XPAR_LAI (KDIM,DTV%NTIME,NVEGTYPE))
DO JTIME=1,36
!
! ECOCLIMAP spatial distribution field
IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
- CALL AV_PGD(DTCO, &
- ZWORK(:,JTIME,:),I%XCOVER,XDATA_LAI(:,JTIME,:),YVEG,'ARI',I%LCOVER,KDECADE=JTIME)
+ CALL AV_PGD(DTCO,ZWORK(:,JTIME,:),S%XCOVER,XDATA_LAI(:,JTIME,:),YVEG,'ARI',S%LCOVER,KDECADE=JTIME)
DO JVEGTYPE=1,3
- WHERE (DTI%XPAR_VEGTYPE(:,JVEGTYPE)/=0.) ZWORK(:,JTIME,JVEGTYPE) = 0.
+ WHERE (DTV%XPAR_VEGTYPE(:,JVEGTYPE)/=0.) ZWORK(:,JTIME,JVEGTYPE) = 0.
ENDDO
!
ZDEF(:) = XUNDEF
DO JVEGTYPE=1,NVEGTYPE
- IF (ANY(DTI%XPAR_VEGTYPE(:,JVEGTYPE)/=0.) .AND. ALL(ZWORK(:,JTIME,JVEGTYPE)==XUNDEF)) THEN
+ IF (ANY(DTV%XPAR_VEGTYPE(:,JVEGTYPE)/=0.) .AND. ALL(ZWORK(:,JTIME,JVEGTYPE)==XUNDEF)) THEN
ZFRAC = 0.
DO JCOVER = 1,JPCOVER
IF (DTCO%XDATA_VEGTYPE(JCOVER,JVEGTYPE)>ZFRAC) THEN
@@ -136,21 +143,22 @@ IF (.NOT.DTI%LDATA_LAI) THEN
ENDDO
!
! Extrapolation toward new vegtype distribution field from updated land-use map or user
- CALL INI_VAR_FROM_VEGTYPE_DATA(DTCO, DTI, UG, U, &
+ CALL INI_VAR_FROM_VEGTYPE_DATA(DTCO, DTV, UG, U, &
HPROGRAM,KLUOUT,'LAI: leaf area index',ZWORK(:,JTIME,:),PDEF=ZDEF)
!
ENDDO
!
- CALL GOTO_NTIME(DTI%NTIME,ZWORK,DTI%XPAR_LAI)
+ CALL GOTO_NTIME(DTV%NTIME,ZWORK,DTV%XPAR_LAI)
!
- DTI%LDATA_LAI=.TRUE.
+ DTV%LDATA_LAI(:)=.TRUE.
!
ENDIF
!
! H_TREE
! ------
-IF (.NOT.DTI%LDATA_H_TREE .AND. (I%CPHOTO/='NON' .OR. .NOT.DTI%LDATA_Z0)) THEN
+IF (.NOT.ANY(DTV%LDATA_H_TREE) .AND. ((IO%CPHOTO/='NON'.OR.LTREEDRAG) .OR. .NOT.ANY(DTV%LDATA_Z0))) THEN
!
+ ALLOCATE(DTV%XPAR_H_TREE (KDIM,NVEGTYPE))
ZDEF(:)=1.
ZDEF(4:6)=10.
ZDEF(13:17)=10.
@@ -158,14 +166,13 @@ IF (.NOT.DTI%LDATA_H_TREE .AND. (I%CPHOTO/='NON' .OR. .NOT.DTI%LDATA_Z0)) THEN
!
! ECOCLIMAP spatial distribution field
IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
- CALL AV_PGD(DTCO, &
- DTI%XPAR_H_TREE,I%XCOVER,XDATA_H_TREE,YTREE,'ARI',I%LCOVER,KDECADE=1)
+ CALL AV_PGD(DTCO,DTV%XPAR_H_TREE,S%XCOVER,XDATA_H_TREE,YTREE,'ARI',S%LCOVER,KDECADE=1)
!
! Extrapolation toward new vegtype distribution field from updated land-use map or user
- CALL INI_VAR_FROM_VEGTYPE_DATA(DTCO, DTI, UG, U, &
- HPROGRAM,KLUOUT,'H_TREE: height of trees',DTI%XPAR_H_TREE,PDEF=ZDEF)
+ CALL INI_VAR_FROM_VEGTYPE_DATA(DTCO, DTV, UG, U, &
+ HPROGRAM,KLUOUT,'H_TREE: height of trees',DTV%XPAR_H_TREE,PDEF=ZDEF)
!
- DTI%LDATA_H_TREE=.TRUE.
+ DTV%LDATA_H_TREE(:)=.TRUE.
!
ENDIF
!
@@ -173,16 +180,16 @@ ENDIF
! --
!
!ROOT_DEPTH is needed for DIF, 2-L, 3-L
-IF (.NOT.DTI%LDATA_DG .AND. .NOT.DTI%LDATA_ROOT_DEPTH) THEN
+IF (.NOT.ANY(DTV%LDATA_DG) .AND. .NOT.ANY(DTV%LDATA_ROOT_DEPTH)) THEN
YROOT=YNAT
- IF(I%CISBA=='DIF')YROOT=YDIF
+ IF(IO%CISBA=='DIF')YROOT=YDIF
+ ALLOCATE(DTV%XPAR_ROOT_DEPTH (KDIM,NVEGTYPE))
IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
- CALL AV_PGD(DTCO, &
- DTI%XPAR_ROOT_DEPTH(:,:),I%XCOVER,XDATA_ROOT_DEPTH(:,:),YNAT,CDGAVG,I%LCOVER,KDECADE=1)
+ CALL AV_PGD(DTCO,DTV%XPAR_ROOT_DEPTH(:,:),S%XCOVER,XDATA_ROOT_DEPTH(:,:),YNAT,CDGAVG,S%LCOVER,KDECADE=1)
ZDEF(:) = XUNDEF
DO JVEGTYPE=1,NVEGTYPE
- IF (ANY(DTI%XPAR_VEGTYPE(:,JVEGTYPE)/=0.) .AND. ALL(DTI%XPAR_ROOT_DEPTH(:,JVEGTYPE)==XUNDEF)) THEN
+ IF (ANY(DTV%XPAR_VEGTYPE(:,JVEGTYPE)/=0.) .AND. ALL(DTV%XPAR_ROOT_DEPTH(:,JVEGTYPE)==XUNDEF)) THEN
ZFRAC = 0.
DO JCOVER = 1,JPCOVER
IF (DTCO%XDATA_VEGTYPE(JCOVER,JVEGTYPE)>ZFRAC) THEN
@@ -194,42 +201,15 @@ IF (.NOT.DTI%LDATA_DG .AND. .NOT.DTI%LDATA_ROOT_DEPTH) THEN
ENDIF
ENDDO
- CALL INI_VAR_FROM_VEGTYPE_DATA(DTCO, DTI, UG, U, &
- HPROGRAM,KLUOUT,'ROOTDEPTH', DTI%XPAR_ROOT_DEPTH(:,:),PDEF=ZDEF)
- DTI%LDATA_ROOT_DEPTH = .TRUE.
-ENDIF
-!
-!ROOT_DEPTH is needed for DIF, 2-L, 3-L
-IF (.NOT.DTI%LDATA_DG .AND. .NOT.DTI%LDATA_ROOT_DEPTHGV) THEN
- YROOT=YNAT
- IF(I%CISBA=='DIF')YROOT=YDIF
- IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
- CALL AV_PGD(DTCO, &
- DTI%XPAR_ROOT_DEPTHGV(:,:),I%XCOVER,XDATA_ROOT_DEPTHGV(:,:),YNAT,CDGAVG,I%LCOVER,KDECADE=1)
-
- ZDEF(:) = XUNDEF
- DO JVEGTYPE=1,NVEGTYPE
- IF (ANY(DTI%XPAR_VEGTYPE(:,JVEGTYPE)/=0.) .AND. ALL(DTI%XPAR_ROOT_DEPTHGV(:,JVEGTYPE)==XUNDEF)) THEN
- ZFRAC = 0.
- DO JCOVER = 1,JPCOVER
- IF (DTCO%XDATA_VEGTYPE(JCOVER,JVEGTYPE)>ZFRAC) THEN
- ZDEF(JVEGTYPE) = XDATA_ROOT_DEPTHGV(JCOVER,JVEGTYPE)
- ZFRAC = DTCO%XDATA_VEGTYPE(JCOVER,JVEGTYPE)
- IF (ZFRAC==1.) EXIT
- ENDIF
- ENDDO
- ENDIF
- ENDDO
-
- CALL INI_VAR_FROM_VEGTYPE_DATA(DTCO, DTI, UG, U, &
- HPROGRAM,KLUOUT,'ROOTDEPTH', DTI%XPAR_ROOT_DEPTHGV(:,:),PDEF=ZDEF)
- DTI%LDATA_ROOT_DEPTHGV = .TRUE.
+ CALL INI_VAR_FROM_VEGTYPE_DATA(DTCO, DTV, UG, U, &
+ HPROGRAM,KLUOUT,'ROOTDEPTH', DTV%XPAR_ROOT_DEPTH(:,:),PDEF=ZDEF)
+ DTV%LDATA_ROOT_DEPTH(:) = .TRUE.
ENDIF
!
!GROUND_DEPTH is needed for DIF and 3-L
-IF (.NOT.DTI%LDATA_DG .AND. I%CISBA/='2-L' .AND. .NOT.DTI%LDATA_GROUND_DEPTH) THEN
+IF (.NOT.ANY(DTV%LDATA_DG) .AND. IO%CISBA/='2-L' .AND. .NOT.ANY(DTV%LDATA_GROUND_DEPTH)) THEN
ZDATA_GROUND_DEPTH(:,:)=XDATA_GROUND_DEPTH(:,:)
- IF(I%CISBA=='DIF'.AND.CDGDIF=='ROOT')THEN
+ IF(IO%CISBA=='DIF'.AND.CDGDIF=='ROOT')THEN
DO JVEGTYPE=1,NVEGTYPE
IF(JVEGTYPE==NVT_NO)THEN
WHERE(XDATA_GROUND_DEPTH(:,JVEGTYPE)/=XUNDEF)
@@ -239,16 +219,16 @@ IF (.NOT.DTI%LDATA_DG .AND. I%CISBA/='2-L' .AND. .NOT.DTI%LDATA_GROUND_DEPTH) TH
ZDATA_GROUND_DEPTH(:,JVEGTYPE) = MAX(1.0,XDATA_ROOT_DEPTH(:,JVEGTYPE))
ELSE
ZDATA_GROUND_DEPTH(:,JVEGTYPE) = XDATA_ROOT_DEPTH(:,JVEGTYPE)
- ENDIF
+ ENDIF
ENDDO
ENDIF
+ ALLOCATE(DTV%XPAR_GROUND_DEPTH (KDIM,NVEGTYPE))
IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
- CALL AV_PGD(DTCO, &
- DTI%XPAR_GROUND_DEPTH(:,:),I%XCOVER,ZDATA_GROUND_DEPTH(:,:),YNAT,CDGAVG,I%LCOVER,KDECADE=1)
+ CALL AV_PGD(DTCO,DTV%XPAR_GROUND_DEPTH(:,:),S%XCOVER,ZDATA_GROUND_DEPTH(:,:),YNAT,CDGAVG,S%LCOVER,KDECADE=1)
ZDEF(:) = XUNDEF
DO JVEGTYPE=1,NVEGTYPE
- IF (ANY(DTI%XPAR_VEGTYPE(:,JVEGTYPE)/=0.) .AND. ALL(DTI%XPAR_GROUND_DEPTH(:,JVEGTYPE)==XUNDEF)) THEN
+ IF (ANY(DTV%XPAR_VEGTYPE(:,JVEGTYPE)/=0.) .AND. ALL(DTV%XPAR_GROUND_DEPTH(:,JVEGTYPE)==XUNDEF)) THEN
ZFRAC = 0.
DO JCOVER = 1,JPCOVER
IF (DTCO%XDATA_VEGTYPE(JCOVER,JVEGTYPE)>ZFRAC) THEN
@@ -260,53 +240,165 @@ IF (.NOT.DTI%LDATA_DG .AND. I%CISBA/='2-L' .AND. .NOT.DTI%LDATA_GROUND_DEPTH) TH
ENDIF
ENDDO
- CALL INI_VAR_FROM_VEGTYPE_DATA(DTCO, DTI, UG, U, &
- HPROGRAM,KLUOUT,'GROUNDDEPTH', DTI%XPAR_GROUND_DEPTH(:,:),PDEF=ZDEF)
- DTI%LDATA_GROUND_DEPTH = .TRUE.
+ CALL INI_VAR_FROM_VEGTYPE_DATA(DTCO, DTV, UG, U, &
+ HPROGRAM,KLUOUT,'GROUNDDEPTH', DTV%XPAR_GROUND_DEPTH(:,:),PDEF=ZDEF)
+ DTV%LDATA_GROUND_DEPTH(:) = .TRUE.
ENDIF
!
-! IRRIG
-! -----
-IF (.NOT.DTI%LDATA_IRRIG) THEN
- ZDEF(:)=0.
- DO JTIME=1,36
-! ECOCLIMAP spatial distribution field
- IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
- CALL AV_PGD(DTCO, &
- ZWORK(:,JTIME,:),I%XCOVER,XDATA_IRRIG,YVEG,'ARI',I%LCOVER,KDECADE=JTIME)
-! Extrapolation toward new vegtype distribution field from updated land-use map or user
- CALL INI_VAR_FROM_VEGTYPE_DATA(DTCO, DTI, UG, U, &
- HPROGRAM,KLUOUT,'IRRIG ', ZWORK(:,JTIME,:), PDEF=ZDEF)
- ENDDO
+IF (IO%CALBEDO=='CM13') THEN
+!
+ IF (.NOT.ANY(DTV%LDATA_ALBNIR_VEG)) THEN
+ ALLOCATE(DTV%XPAR_ALBNIR_VEG(KDIM,DTV%NTIME,NVEGTYPE))
+ DO JTIME=1,36
+! ECOCLIMAP spatial distribution field
+ IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
+ CALL AV_PGD(DTCO,ZWORK(:,JTIME,:),S%XCOVER,XDATA_ALB_VEG_NIR(:,JTIME,:),YVEG,'ARI',S%LCOVER,KDECADE=JTIME)
+
+! Extrapolation toward new vegtype distribution field from updated land-use map or user
+ CALL INI_VAR_FROM_VEGTYPE_DATA(DTCO, DTV, UG, U, &
+ HPROGRAM,KLUOUT,'ALBNIR_VEG',ZWORK(:,JTIME,:),PDEF=ZDEF)
+ ENDDO
+ CALL GOTO_NTIME(DTV%NTIME,ZWORK,DTV%XPAR_ALBNIR_VEG)
+ DTV%LDATA_ALBNIR_VEG(:)=.TRUE.
+ ENDIF
+!
+ IF (.NOT.ANY(DTV%LDATA_ALBVIS_VEG)) THEN
+ ALLOCATE(DTV%XPAR_ALBVIS_VEG(KDIM,DTV%NTIME,NVEGTYPE))
+ DO JTIME=1,36
+! ECOCLIMAP spatial distribution field
+ IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
+ CALL AV_PGD(DTCO,ZWORK(:,JTIME,:),S%XCOVER,XDATA_ALB_VEG_VIS(:,JTIME,:),YVEG,'ARI',S%LCOVER,KDECADE=JTIME)
+
+! Extrapolation toward new vegtype distribution field from updated land-use map or user
+ CALL INI_VAR_FROM_VEGTYPE_DATA(DTCO, DTV, UG, U, &
+ HPROGRAM,KLUOUT,'ALBVIS_VEG',ZWORK(:,JTIME,:),PDEF=ZDEF)
+ ENDDO
+ CALL GOTO_NTIME(DTV%NTIME,ZWORK,DTV%XPAR_ALBVIS_VEG)
+ DTV%LDATA_ALBVIS_VEG(:)=.TRUE.
+ ENDIF
!
- CALL GOTO_NTIME(DTI%NTIME,ZWORK,DTI%XPAR_IRRIG)
+ IF (.NOT.ANY(DTV%LDATA_ALBNIR_SOIL)) THEN
+ ALLOCATE(DTV%XPAR_ALBNIR_SOIL(KDIM,DTV%NTIME,NVEGTYPE))
+ DO JTIME=1,36
+! ECOCLIMAP spatial distribution field
+ IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
+ CALL AV_PGD(DTCO,ZWORK(:,JTIME,:),S%XCOVER,XDATA_ALB_SOIL_NIR(:,JTIME,:),YBAR,'ARI',S%LCOVER,KDECADE=JTIME)
+
+! Extrapolation toward new vegtype distribution field from updated land-use map or user
+ CALL INI_VAR_FROM_VEGTYPE_DATA(DTCO, DTV, UG, U, &
+ HPROGRAM,KLUOUT,'ALBNIR_SOIL',ZWORK(:,JTIME,:),PDEF=ZDEF)
+ ENDDO
+ CALL GOTO_NTIME(DTV%NTIME,ZWORK,DTV%XPAR_ALBNIR_SOIL)
+ DTV%LDATA_ALBNIR_SOIL(:)=.TRUE.
+ ENDIF
!
- DTI%LDATA_IRRIG=.TRUE.
+ IF (.NOT.ANY(DTV%LDATA_ALBVIS_SOIL)) THEN
+ ALLOCATE(DTV%XPAR_ALBVIS_SOIL(KDIM,DTV%NTIME,NVEGTYPE))
+ DO JTIME=1,36
+! ECOCLIMAP spatial distribution field
+ IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
+ CALL AV_PGD(DTCO,ZWORK(:,JTIME,:),S%XCOVER,XDATA_ALB_SOIL_VIS(:,JTIME,:),YBAR,'ARI',S%LCOVER,KDECADE=JTIME)
+
+! Extrapolation toward new vegtype distribution field from updated land-use map or user
+ CALL INI_VAR_FROM_VEGTYPE_DATA(DTCO, DTV, UG, U, &
+ HPROGRAM,KLUOUT,'ALBVIS_SOIL',ZWORK(:,JTIME,:),PDEF=ZDEF)
+ ENDDO
+ CALL GOTO_NTIME(DTV%NTIME,ZWORK,DTV%XPAR_ALBVIS_SOIL)
+ DTV%LDATA_ALBVIS_SOIL(:)=.TRUE.
+ ENDIF
!
ENDIF
!
-! WATSUP
-! ------
-IF (.NOT.DTI%LDATA_WATSUP) THEN
- ZDEF(:)=0.
- DO JTIME=1,36
-! ECOCLIMAP spatial distribution field
- IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
- CALL AV_PGD(DTCO, &
- ZWORK(:,JTIME,:),I%XCOVER,XDATA_WATSUP,YVEG,'ARI',I%LCOVER,KDECADE=JTIME)
-! Extrapolation toward new vegtype distribution field from updated land-use map or user
- CALL INI_VAR_FROM_VEGTYPE_DATA(DTCO, DTI, UG, U, &
- HPROGRAM,KLUOUT,'WATSUP ', ZWORK(:,JTIME,:), PDEF=ZDEF)
- ENDDO
+IF(IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') THEN
+ !
+ IF (LAGRIP) THEN
+ !
+ ! IRRIG
+ ! -----
+ IF (.NOT.ANY(DTV%LDATA_IRRIG)) THEN
+ ZDEF(:)=0.
+ ALLOCATE(DTV%XPAR_IRRIG (KDIM,DTV%NTIME,NVEGTYPE))
+ DO JTIME=1,36
+ ! ECOCLIMAP spatial distribution field
+ IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
+ CALL AV_PGD(DTCO,ZWORK(:,JTIME,:),S%XCOVER,XDATA_IRRIG,YVEG,'ARI',S%LCOVER,KDECADE=JTIME)
+ ! Extrapolation toward new vegtype distribution field from updated land-use map or user
+ CALL INI_VAR_FROM_VEGTYPE_DATA(DTCO, DTV, UG, U, &
+ HPROGRAM,KLUOUT,'IRRIG ', ZWORK(:,JTIME,:), PDEF=ZDEF)
+ ENDDO
+ !
+ CALL GOTO_NTIME(DTV%NTIME,ZWORK,DTV%XPAR_IRRIG)
+ !
+ DTV%LDATA_IRRIG(:)=.TRUE.
+ !
+ ENDIF
+ !
+ ! WATSUP
+ ! ------
+ IF (.NOT.ANY(DTV%LDATA_WATSUP)) THEN
+ ZDEF(:)=0.
+ ALLOCATE(DTV%XPAR_WATSUP (KDIM,DTV%NTIME,NVEGTYPE))
+ DO JTIME=1,36
+ ! ECOCLIMAP spatial distribution field
+ IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
+ CALL AV_PGD(DTCO,ZWORK(:,JTIME,:),S%XCOVER,XDATA_WATSUP,YVEG,'ARI',S%LCOVER,KDECADE=JTIME)
+ ! Extrapolation toward new vegtype distribution field from updated land-use map or user
+ CALL INI_VAR_FROM_VEGTYPE_DATA(DTCO, DTV, UG, U, &
+ HPROGRAM,KLUOUT,'WATSUP ', ZWORK(:,JTIME,:), PDEF=ZDEF)
+ ENDDO
+ !
+ CALL GOTO_NTIME(DTV%NTIME,ZWORK,DTV%XPAR_WATSUP)
+ !
+ DTV%LDATA_WATSUP(:)=.TRUE.
+ ENDIF
+ !
+ ALLOCATE(TPWORK(KDIM,NVEGTYPE))
+ !
+ IF (.NOT.ANy(DTV%LDATA_SEED_M).OR..NOT.ANY(DTV%LDATA_SEED_D)) THEN
+ ALLOCATE(DTV%XPAR_SEED_M(KDIM,NVEGTYPE))
+ ALLOCATE(DTV%XPAR_SEED_D(KDIM,NVEGTYPE))
+ IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
+ CALL AV_PGD(TPWORK(:,:),S%XCOVER,TDATA_SEED(:,:),YVEG,'MAJ',S%LCOVER,KDECADE=1)
+ DTV%XPAR_SEED_M(:,:) = FLOAT(TPWORK(:,:)%TDATE%MONTH)
+ DTV%XPAR_SEED_D(:,:) = FLOAT(TPWORK(:,:)%TDATE%DAY)
+ ZDEF(:)=5.
+ CALL INI_VAR_FROM_VEGTYPE_DATA(DTCO, DTV, UG, U, &
+ HPROGRAM,KLUOUT,'SEED_M', DTV%XPAR_SEED_M(:,:), PDEF=ZDEF)
+ ZDEF(:)=10.
+ CALL INI_VAR_FROM_VEGTYPE_DATA(DTCO, DTV, UG, U, &
+ HPROGRAM,KLUOUT,'SEED_D', DTV%XPAR_SEED_D(:,:), PDEF=ZDEF)
+ ENDIF
+ !
+ DTV%LDATA_SEED_M(:) = .TRUE.
+ DTV%LDATA_SEED_D(:) = .TRUE.
+ !
+ IF (.NOT.ANY(DTV%LDATA_REAP_M).OR..NOT.ANY(DTV%LDATA_REAP_D)) THEN
+ ALLOCATE(DTV%XPAR_REAP_M(KDIM,NVEGTYPE))
+ ALLOCATE(DTV%XPAR_REAP_D(KDIM,NVEGTYPE))
+ IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
+ CALL AV_PGD(TPWORK(:,:),S%XCOVER,TDATA_REAP(:,:),YVEG,'MAJ',S%LCOVER,KDECADE=1)
+ DTV%XPAR_REAP_M(:,:) = FLOAT(TPWORK(:,:)%TDATE%MONTH)
+ DTV%XPAR_REAP_D(:,:) = FLOAT(TPWORK(:,:)%TDATE%DAY)
+ ZDEF(:)=8.
+ CALL INI_VAR_FROM_VEGTYPE_DATA(DTCO, DTV, UG, U, &
+ HPROGRAM,KLUOUT,'REAP_M', DTV%XPAR_REAP_M(:,:), PDEF=ZDEF)
+ ZDEF(:)=1.
+ CALL INI_VAR_FROM_VEGTYPE_DATA(DTCO, DTV, UG, U, &
+ HPROGRAM,KLUOUT,'REAP_D', DTV%XPAR_REAP_D(:,:), PDEF=ZDEF)
+ ENDIF
+ !
+ DTV%LDATA_REAP_M(:) = .TRUE.
+ DTV%LDATA_REAP_D(:) = .TRUE.
+ !
+ DEALLOCATE(TPWORK)
+ !
+ ENDIF
!
- CALL GOTO_NTIME(DTI%NTIME,ZWORK,DTI%XPAR_WATSUP)
- !
- DTI%LDATA_WATSUP=.TRUE.
ENDIF
!
IF (LHOOK) CALL DR_HOOK('EXTRAPOL_FIELDS',1,ZHOOK_HANDLE)
!
- CONTAINS
+CONTAINS
!
SUBROUTINE GOTO_NTIME(KTIME,PWORK,PPAR_DATA)
!
diff --git a/src/SURFEX/facade_e_budget.F90 b/src/SURFEX/facade_e_budget.F90
index 29e2e6807fc2390ee1506e19f2e3194880e49257..a47cd79da7ac80db87f10f25d3247aa6179905c1 100644
--- a/src/SURFEX/facade_e_budget.F90
+++ b/src/SURFEX/facade_e_budget.F90
@@ -2,32 +2,17 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
-SUBROUTINE FACADE_E_BUDGET(HWALL_OPT, HBEM, &
- PT_WALL_A, PT_WALL_B, PTSTEP, &
- PHC_WALL, PTC_WALL, PD_WALL, &
- PDN_ROAD, PRHOA, PAC_WALL, &
- PAC_BLD, &
- PTI_BLD, PLW_RAD, PPS, PEXNS, &
- PABS_SW_WALL_A, PABS_SW_WALL_B, PT_CANYON, &
- PTS_ROAD, PTSNOW_ROAD, PTS_GARDEN, PU_WIN, PGR, &
- PABS_SW_WIN, PF_WIN_MASS, PF_WIN_WALL, &
- PF_WIN_FLOOR, PTS_MASS, PTS_FLOOR, PEMIS_WALL, &
- PLW_WA_TO_WB, &
- PLW_R_TO_WA, PLW_R_TO_WB, PLW_G_TO_WA, PLW_G_TO_WB, &
- PLW_S_TO_WA, PLW_S_TO_WB, PLW_NR_TO_WA,PLW_NR_TO_WB,&
- PLW_WIN_TO_WA, PLW_WIN_TO_WB, &
- PLW_S_TO_WIN, PLW_WA_TO_WIN, PLW_WB_TO_WIN, &
- PLW_R_TO_WIN, PLW_G_TO_WIN, PLW_NR_TO_WIN, PT_WIN1, &
- PFLX_BLD_WALL_A, PDQS_WALL_A, &
- PFLX_BLD_WALL_B, PDQS_WALL_B, &
- PT_WIN2, PEMIT_LW_FAC, &
- PABS_LW_WALL_A, PABS_LW_WALL_B, PABS_LW_WIN, &
- PH_WALL_A, PH_WALL_B, &
- PIMB_WALL, PF_WALL_MASS, PF_WALL_FLOOR, &
- PF_WALL_WIN, PRADHT_IN, PRAD_ROOF_WALL, &
- PRAD_ROOF_WIN, PRAD_WALL_FLOOR, PRAD_WALL_MASS, &
- PRAD_WIN_FLOOR, PRAD_WIN_MASS, PCONV_WALL_BLD, &
- PCONV_WIN_BLD, PAC_WIN, PLOAD_IN_WALL, PLOAD_IN_WIN )
+SUBROUTINE FACADE_E_BUDGET(TOP, T, B, DMT, PTSTEP, PDN_RD, PRHOA, PAC_WL, PAC_BLD, &
+ PLW_RAD, PPS, PEXNS, PT_CANYON, PTS_RD, PTSN_RD, PTS_GD, &
+ PTS_FL, PLW_WA_TO_WB, PLW_R_TO_WA, PLW_R_TO_WB, &
+ PLW_G_TO_WA, PLW_G_TO_WB, PLW_S_TO_WA, PLW_S_TO_WB, &
+ PLW_NR_TO_WA,PLW_NR_TO_WB, PLW_WIN_TO_WA, PLW_WIN_TO_WB, &
+ PLW_S_TO_WIN, PLW_WA_TO_WIN, PLW_WB_TO_WIN, PLW_R_TO_WIN,&
+ PLW_G_TO_WIN, PLW_NR_TO_WIN, PFLX_BLD_WL_A, PDQS_WL_A, &
+ PFLX_BLD_WL_B, PDQS_WL_B, PEMIT_LW_FAC, PIMB_WL, &
+ PRADHT_IN, PRAD_RF_WL, PRAD_RF_WIN, PRAD_WL_FL, &
+ PRAD_WL_MA, PRAD_WIN_FL, PRAD_WIN_MA, PCONV_WL_BLD, &
+ PCONV_WIN_BLD, PAC_WIN, PLOAD_IN_WL, PLOAD_IN_WIN )
!
! ##########################################################################
!
@@ -72,6 +57,11 @@ SUBROUTINE FACADE_E_BUDGET(HWALL_OPT, HBEM, &
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
+USE MODD_TEB_n, ONLY : TEB_t
+USE MODD_BEM_n, ONLY : BEM_t
+USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_t
+!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_CSTS, ONLY : XCPD
!
@@ -84,41 +74,26 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
- CHARACTER(LEN=4), INTENT(IN) :: HWALL_OPT ! TEB option for walls
- ! 'UNIF' : uniform walls
- ! 'TWO ' : two different opposite walls
- CHARACTER(LEN=3), INTENT(IN) :: HBEM ! Building Energy model 'DEF' or 'BEM'
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PT_WALL_A ! wall A layers temperatures
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PT_WALL_B ! wall B layers temperatures
+TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+TYPE(TEB_t), INTENT(INOUT) :: T
+TYPE(BEM_t), INTENT(INOUT) :: B
+TYPE(DIAG_MISC_TEB_t), INTENT(INOUT) :: DMT
+!
REAL, INTENT(IN) :: PTSTEP ! time step
-REAL, DIMENSION(:,:), INTENT(IN) :: PHC_WALL ! heat capacity for wall layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PTC_WALL ! thermal conductivity for wall layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_WALL ! depth of wall layers
-REAL, DIMENSION(:), INTENT(IN) :: PDN_ROAD ! snow-covered fraction on roads
+REAL, DIMENSION(:), INTENT(IN) :: PDN_RD ! snow-covered fraction on roads
REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! rho
-REAL, DIMENSION(:), INTENT(IN) :: PAC_WALL ! aerodynamical conductance
+REAL, DIMENSION(:), INTENT(IN) :: PAC_WL ! aerodynamical conductance
! ! between wall and canyon
REAL, DIMENSION(:), INTENT(IN) :: PAC_BLD ! aerodynamical conductance
! inside the building itself
-REAL, DIMENSION(:), INTENT(IN) :: PTI_BLD ! inside building temperature
REAL, DIMENSION(:), INTENT(IN) :: PLW_RAD ! atmospheric infrared radiation
REAL, DIMENSION(:), INTENT(IN) :: PPS ! pressure at the surface
REAL, DIMENSION(:), INTENT(IN) :: PEXNS ! surface Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_WALL_A! absorbed solar radiation
-REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_WALL_B! absorbed solar radiation
REAL, DIMENSION(:), INTENT(IN) :: PT_CANYON ! air canyon temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS_ROAD ! road surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTSNOW_ROAD ! road snow temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS_GARDEN ! green area surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PU_WIN ! window U-factor [W m-2 K-1]
-REAL, DIMENSION(:), INTENT(IN) :: PGR ! glazing ratio
-REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_WIN ! window absorbed shortwave radiation [W m-2]
-REAL, DIMENSION(:), INTENT(IN) :: PF_WIN_MASS ! window mass view factor
-REAL, DIMENSION(:), INTENT(IN) :: PF_WIN_WALL ! window wall view factor
-REAL, DIMENSION(:), INTENT(IN) :: PF_WIN_FLOOR ! window floor view factor
-REAL, DIMENSION(:), INTENT(IN) :: PTS_MASS ! surface mass temperature [K]
-REAL, DIMENSION(:), INTENT(IN) :: PTS_FLOOR ! floor layers temperatures [K]
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_WALL ! wall emissivity
+REAL, DIMENSION(:), INTENT(IN) :: PTS_RD ! road surface temperature
+REAL, DIMENSION(:), INTENT(IN) :: PTSN_RD ! road snow temperature
+REAL, DIMENSION(:), INTENT(IN) :: PTS_GD ! green area surface temperature
+REAL, DIMENSION(:), INTENT(IN) :: PTS_FL ! floor layers temperatures [K]
!
REAL, DIMENSION(:), INTENT(IN) :: PLW_WA_TO_WB ! LW interactions wall -> wall (both versions)
REAL, DIMENSION(:), INTENT(IN) :: PLW_R_TO_WA ! LW interactions road -> wall ; DEF formulation
@@ -144,77 +119,65 @@ REAL, DIMENSION(:), INTENT(IN) :: PLW_R_TO_WIN ! Radiative heat trasfer coeff
REAL, DIMENSION(:), INTENT(IN) :: PLW_G_TO_WIN ! Radiative heat trasfer coeff window-garden
REAL, DIMENSION(:), INTENT(IN) :: PLW_NR_TO_WIN! Radiative heat trasfer coeff window-snow
!
-REAL, DIMENSION(:), INTENT(INOUT) :: PT_WIN1 ! outdoor window temperature [K]
-REAL, DIMENSION(:), INTENT(OUT) :: PFLX_BLD_WALL_A! flux from bld to wall
-REAL, DIMENSION(:), INTENT(INOUT) :: PDQS_WALL_A ! heat storage inside the wall
-REAL, DIMENSION(:), INTENT(OUT) :: PFLX_BLD_WALL_B! flux from bld to wall
-REAL, DIMENSION(:), INTENT(INOUT) :: PDQS_WALL_B ! heat storage inside the wall
-REAL, DIMENSION(:), INTENT(INOUT) :: PT_WIN2 ! indoor window temperature [K]
+REAL, DIMENSION(:), INTENT(OUT) :: PFLX_BLD_WL_A! flux from bld to wall
+REAL, DIMENSION(:), INTENT(INOUT) :: PDQS_WL_A ! heat storage inside the wall
+REAL, DIMENSION(:), INTENT(OUT) :: PFLX_BLD_WL_B! flux from bld to wall
+REAL, DIMENSION(:), INTENT(INOUT) :: PDQS_WL_B ! heat storage inside the wall
REAL, DIMENSION(:), INTENT(OUT) :: PEMIT_LW_FAC ! LW flux emitted by the facade (W/m2 of facade)
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_LW_WALL_A ! absorbed infrared rad.
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_LW_WALL_B ! absorbed infrared rad.
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_LW_WIN ! window absorbed shortwave radiation [W m-2]
-REAL, DIMENSION(:), INTENT(OUT) :: PH_WALL_A ! Sensible heat flux from wall to air [W/m2(wall)]
- ! wall = facade - glazing
-REAL, DIMENSION(:), INTENT(OUT) :: PH_WALL_B ! Sensible heat flux from wall to air [W/m2(wall)]
- ! wall = facade - glazing
-REAL, DIMENSION(:), INTENT(OUT) :: PIMB_WALL ! wall residual energy imbalance
+REAL, DIMENSION(:), INTENT(OUT) :: PIMB_WL ! wall residual energy imbalance
! for verification [W m-2]
-REAL, DIMENSION(:), INTENT(IN) :: PF_WALL_FLOOR ! View factor wall-floor
-REAL, DIMENSION(:), INTENT(IN) :: PF_WALL_MASS ! View factor wall-mass
-REAL, DIMENSION(:), INTENT(IN) :: PF_WALL_WIN ! View factor wall-win
REAL, DIMENSION(:), INTENT(IN) :: PRADHT_IN ! Indoor radiant heat transfer coefficient
! [W K-1 m-2]
-REAL, DIMENSION(:), INTENT(IN) :: PRAD_ROOF_WALL ! rad. fluxes from roof to wall [W m-2(roof)]
-REAL, DIMENSION(:), INTENT(IN) :: PRAD_ROOF_WIN ! rad. fluxes from roof to win [W m-2(roof)]
-REAL, DIMENSION(:), INTENT(OUT) :: PRAD_WALL_FLOOR! rad. fluxes from wall to floor [W m-2(wall)]
-REAL, DIMENSION(:), INTENT(OUT) :: PRAD_WALL_MASS ! rad. fluxes from wall to mass [W m-2(wall)]
-REAL, DIMENSION(:), INTENT(OUT) :: PRAD_WIN_FLOOR ! rad. fluxes from window to floor [W m-2(win)]
-REAL, DIMENSION(:), INTENT(OUT) :: PRAD_WIN_MASS ! rad. fluxes from window to mass [W m-2(win)]
-REAL, DIMENSION(:), INTENT(OUT) :: PCONV_WALL_BLD ! conv. fluxes from wall to bld [W m-2(wall)]
+REAL, DIMENSION(:), INTENT(IN) :: PRAD_RF_WL ! rad. fluxes from roof to wall [W m-2(roof)]
+REAL, DIMENSION(:), INTENT(IN) :: PRAD_RF_WIN ! rad. fluxes from roof to win [W m-2(roof)]
+REAL, DIMENSION(:), INTENT(OUT) :: PRAD_WL_FL! rad. fluxes from wall to floor [W m-2(wall)]
+REAL, DIMENSION(:), INTENT(OUT) :: PRAD_WL_MA ! rad. fluxes from wall to mass [W m-2(wall)]
+REAL, DIMENSION(:), INTENT(OUT) :: PRAD_WIN_FL ! rad. fluxes from window to floor [W m-2(win)]
+REAL, DIMENSION(:), INTENT(OUT) :: PRAD_WIN_MA ! rad. fluxes from window to mass [W m-2(win)]
+REAL, DIMENSION(:), INTENT(OUT) :: PCONV_WL_BLD ! conv. fluxes from wall to bld [W m-2(wall)]
REAL, DIMENSION(:), INTENT(OUT) :: PCONV_WIN_BLD ! conv. fluxes from window to bld [W m-2(wind.)]
REAL, DIMENSION(:), INTENT(IN) :: PAC_WIN ! window aerodynamic conductance
!
-REAL, DIMENSION(:), INTENT(IN) :: PLOAD_IN_WALL ! solar + inter. heat gains W/m2 [wall]
+REAL, DIMENSION(:), INTENT(IN) :: PLOAD_IN_WL ! solar + inter. heat gains W/m2 [wall]
REAL, DIMENSION(:), INTENT(IN) :: PLOAD_IN_WIN ! solar + inter. heat gains W/m2 [win]
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(SIZE(PTI_BLD)) :: ZRAD_WALL_WIN ! rad. fluxes between averaged wall and win [W m-2(wall)]
-REAL, DIMENSION(SIZE(PTI_BLD)) :: ZRAD_WALL_A_WIN ! rad. fluxes between one wall and win [W m-2(wall)]
-REAL, DIMENSION(SIZE(PTI_BLD)) :: ZEMIS_WIN ! window emissivity
-REAL, DIMENSION(SIZE(PTI_BLD)) :: ZEMIT_LW_WIN ! Longwave radiation emitted by the window [W m-2(window)]
-REAL, DIMENSION(SIZE(PTI_BLD)) :: ZEMIT_LW_WALL_A ! Longwave radiation emitted by the wall [W m-2(wall)]
-REAL, DIMENSION(SIZE(PTI_BLD)) :: ZEMIT_LW_WALL_B ! Longwave radiation emitted by the wall [W m-2(wall)]
-REAL, DIMENSION(SIZE(PTI_BLD)) :: ZTS_WALL_A ! surface temperature of wall A at previous time-step
-REAL, DIMENSION(SIZE(PTI_BLD)) :: ZTS_WALL_B ! surface temperature of wall B at previous time-step
-REAL, DIMENSION(SIZE(PTI_BLD)) :: ZTI_WALL_A ! internal temperature of wall A at previous time-step
-REAL, DIMENSION(SIZE(PTI_BLD)) :: ZTI_WALL_B ! internal temperature of wall B at previous time-step
-REAL, DIMENSION(SIZE(PTI_BLD)) :: ZTS_WALL ! surface temperature of averaged wall at new time-step
-REAL, DIMENSION(SIZE(PTI_BLD)) :: ZIMB_WALL ! wall residual energy imbalance for verification [W m-2]
-REAL, DIMENSION(SIZE(PTI_BLD)) :: ZRAD_WALL_FLOOR! rad. fluxes from wall to floor [W m-2(wall)]
-REAL, DIMENSION(SIZE(PTI_BLD)) :: ZRAD_WALL_MASS ! rad. fluxes from wall to mass [W m-2(wall)]
-REAL, DIMENSION(SIZE(PTI_BLD)) :: ZCONV_WALL_BLD ! conv. fluxes from wall to bld [W m-2(wall)]
-REAL, DIMENSION(SIZE(PTI_BLD)) :: ZLW_W_TO_WIN ! Radiative heat trasfer coeff wall-window [W K-1 m-2]
-INTEGER :: IWALL
+REAL, DIMENSION(SIZE(B%XTI_BLD)) :: ZRAD_WL_WIN ! rad. fluxes between averaged wall and win [W m-2(wall)]
+REAL, DIMENSION(SIZE(B%XTI_BLD)) :: ZRAD_WL_A_WIN ! rad. fluxes between one wall and win [W m-2(wall)]
+REAL, DIMENSION(SIZE(B%XTI_BLD)) :: ZEMIS_WIN ! window emissivity
+REAL, DIMENSION(SIZE(B%XTI_BLD)) :: ZEMIT_LW_WIN ! Longwave radiation emitted by the window [W m-2(window)]
+REAL, DIMENSION(SIZE(B%XTI_BLD)) :: ZEMIT_LW_WL_A ! Longwave radiation emitted by the wall [W m-2(wall)]
+REAL, DIMENSION(SIZE(B%XTI_BLD)) :: ZEMIT_LW_WL_B ! Longwave radiation emitted by the wall [W m-2(wall)]
+REAL, DIMENSION(SIZE(B%XTI_BLD)) :: ZTS_WL_A ! surface temperature of wall A at previous time-step
+REAL, DIMENSION(SIZE(B%XTI_BLD)) :: ZTS_WL_B ! surface temperature of wall B at previous time-step
+REAL, DIMENSION(SIZE(B%XTI_BLD)) :: ZTI_WL_A ! internal temperature of wall A at previous time-step
+REAL, DIMENSION(SIZE(B%XTI_BLD)) :: ZTI_WL_B ! internal temperature of wall B at previous time-step
+REAL, DIMENSION(SIZE(B%XTI_BLD)) :: ZTS_WL ! surface temperature of averaged wall at new time-step
+REAL, DIMENSION(SIZE(B%XTI_BLD)) :: ZIMB_WL ! wall residual energy imbalance for verification [W m-2]
+REAL, DIMENSION(SIZE(B%XTI_BLD)) :: ZRAD_WL_FL! rad. fluxes from wall to floor [W m-2(wall)]
+REAL, DIMENSION(SIZE(B%XTI_BLD)) :: ZRAD_WL_MA ! rad. fluxes from wall to mass [W m-2(wall)]
+REAL, DIMENSION(SIZE(B%XTI_BLD)) :: ZCONV_WL_BLD ! conv. fluxes from wall to bld [W m-2(wall)]
+REAL, DIMENSION(SIZE(B%XTI_BLD)) :: ZLW_W_TO_WIN ! Radiative heat trasfer coeff wall-window [W K-1 m-2]
+INTEGER :: IWL
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('FACADE_E_BUDGET',0,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
-PRAD_WALL_FLOOR= XUNDEF
-PRAD_WALL_MASS = XUNDEF
-PRAD_WIN_FLOOR = XUNDEF
-PRAD_WIN_MASS = XUNDEF
-PCONV_WALL_BLD = XUNDEF
+PRAD_WL_FL= XUNDEF
+PRAD_WL_MA = XUNDEF
+PRAD_WIN_FL = XUNDEF
+PRAD_WIN_MA = XUNDEF
+PCONV_WL_BLD = XUNDEF
PCONV_WIN_BLD = XUNDEF
!
!* surface temperature of the opposite wall
! ----------------------------------------
!
-ZTS_WALL_A(:) = PT_WALL_A(:,1)
-ZTS_WALL_B(:) = PT_WALL_B(:,1)
-IWALL = SIZE(PT_WALL_A,2)
-ZTI_WALL_A(:) = PT_WALL_A(:,IWALL)
-ZTI_WALL_B(:) = PT_WALL_B(:,IWALL)
+ZTS_WL_A(:) = T%XT_WALL_A(:,1)
+ZTS_WL_B(:) = T%XT_WALL_B(:,1)
+IWL = SIZE(T%XT_WALL_A,2)
+ZTI_WL_A(:) = T%XT_WALL_A(:,IWL)
+ZTI_WL_B(:) = T%XT_WALL_B(:,IWL)
!
! *Convection heat transfer coefficients [W m-2 K-1] from EP Engineering Reference
! --------------------------------------------------------------------------------
@@ -223,85 +186,76 @@ ZTI_WALL_B(:) = PT_WALL_B(:,IWALL)
! *opaque balance of the facade for wall A
! ---------------------------------------
!
- CALL WALL_LAYER_E_BUDGET(HBEM, PT_WALL_A, ZTS_WALL_B, ZTI_WALL_B, PTSTEP, &
- PHC_WALL, PTC_WALL, PD_WALL, PDN_ROAD, PRHOA, PAC_WALL, &
- PAC_BLD, PTI_BLD, PLW_RAD, PPS, PEXNS, PABS_SW_WALL_A, PT_CANYON, &
- PTS_ROAD, PTSNOW_ROAD, PTS_GARDEN, PTS_MASS, PTS_FLOOR, PEMIS_WALL, &
- PLW_WA_TO_WB, PLW_R_TO_WA, PLW_G_TO_WA, PLW_NR_TO_WA, &
- PLW_WIN_TO_WA, PLW_S_TO_WA, &
- PT_WIN1, PFLX_BLD_WALL_A, PDQS_WALL_A, PT_WIN2, PABS_LW_WALL_A, &
- ZEMIT_LW_WALL_A, PH_WALL_A, ZIMB_WALL, PF_WALL_MASS, &
- PF_WALL_FLOOR, PF_WALL_WIN, PRADHT_IN, PRAD_ROOF_WALL, &
- ZRAD_WALL_A_WIN, ZRAD_WALL_FLOOR, ZRAD_WALL_MASS, ZCONV_WALL_BLD, &
- PLOAD_IN_WALL)
-!
-PIMB_WALL = 0.5 * ZIMB_WALL
-PRAD_WALL_FLOOR = 0.5 * ZRAD_WALL_FLOOR
-PRAD_WALL_MASS = 0.5 * ZRAD_WALL_MASS
-PCONV_WALL_BLD = 0.5 * ZCONV_WALL_BLD
-ZRAD_WALL_WIN = 0.5 * ZRAD_WALL_A_WIN
+ CALL WALL_LAYER_E_BUDGET(TOP, T, B, T%XT_WALL_A, ZTS_WL_B, ZTI_WL_B, PTSTEP, PDN_RD, &
+ PRHOA, PAC_WL, PAC_BLD, PLW_RAD, PPS, PEXNS, DMT%XABS_SW_WALL_A,&
+ PT_CANYON, PTS_RD, PTSN_RD, PTS_GD, PTS_FL, PLW_WA_TO_WB, &
+ PLW_R_TO_WA, PLW_G_TO_WA, PLW_NR_TO_WA, PLW_WIN_TO_WA, &
+ PLW_S_TO_WA, PFLX_BLD_WL_A, PDQS_WL_A, DMT%XABS_LW_WALL_A, &
+ ZEMIT_LW_WL_A, DMT%XH_WALL_A, ZIMB_WL, PRADHT_IN, PRAD_RF_WL, &
+ ZRAD_WL_A_WIN, ZRAD_WL_FL, ZRAD_WL_MA, ZCONV_WL_BLD, &
+ PLOAD_IN_WL)
+!
+PIMB_WL = 0.5 * ZIMB_WL
+PRAD_WL_FL = 0.5 * ZRAD_WL_FL
+PRAD_WL_MA = 0.5 * ZRAD_WL_MA
+PCONV_WL_BLD = 0.5 * ZCONV_WL_BLD
+ZRAD_WL_WIN = 0.5 * ZRAD_WL_A_WIN
!
! *opaque balance of the facade for wall B
! ---------------------------------------
!
-IF (HWALL_OPT/='UNIF') THEN
- CALL WALL_LAYER_E_BUDGET(HBEM, PT_WALL_B, ZTS_WALL_A, ZTI_WALL_A, PTSTEP, &
- PHC_WALL, PTC_WALL, PD_WALL, PDN_ROAD, PRHOA, PAC_WALL, &
- PAC_BLD, PTI_BLD, PLW_RAD, PPS, PEXNS, PABS_SW_WALL_B, PT_CANYON, &
- PTS_ROAD, PTSNOW_ROAD, PTS_GARDEN, PTS_MASS, PTS_FLOOR, PEMIS_WALL, &
- PLW_WA_TO_WB, PLW_R_TO_WB, PLW_G_TO_WB, PLW_NR_TO_WB, &
- PLW_WIN_TO_WB, PLW_S_TO_WB, &
- PT_WIN1, PFLX_BLD_WALL_B, PDQS_WALL_B, PT_WIN2, PABS_LW_WALL_B, &
- ZEMIT_LW_WALL_B, PH_WALL_B, ZIMB_WALL, PF_WALL_MASS, &
- PF_WALL_FLOOR, PF_WALL_WIN, PRADHT_IN, PRAD_ROOF_WALL, &
- ZRAD_WALL_A_WIN, ZRAD_WALL_FLOOR, ZRAD_WALL_MASS, ZCONV_WALL_BLD, &
- PLOAD_IN_WALL )
+IF (TOP%CWALL_OPT/='UNIF') THEN
+ CALL WALL_LAYER_E_BUDGET(TOP, T, B, T%XT_WALL_B, ZTS_WL_A, ZTI_WL_A, PTSTEP, PDN_RD, &
+ PRHOA, PAC_WL, PAC_BLD, PLW_RAD, PPS, PEXNS, DMT%XABS_SW_WALL_B, &
+ PT_CANYON, PTS_RD, PTSN_RD, PTS_GD, PTS_FL, PLW_WA_TO_WB, &
+ PLW_R_TO_WB, PLW_G_TO_WB, PLW_NR_TO_WB, PLW_WIN_TO_WB, &
+ PLW_S_TO_WB, PFLX_BLD_WL_B, PDQS_WL_B, DMT%XABS_LW_WALL_B, &
+ ZEMIT_LW_WL_B, DMT%XH_WALL_B, ZIMB_WL, PRADHT_IN, PRAD_RF_WL,&
+ ZRAD_WL_A_WIN, ZRAD_WL_FL, ZRAD_WL_MA, ZCONV_WL_BLD, &
+ PLOAD_IN_WL )
ELSE
- PT_WALL_B = PT_WALL_A
- PH_WALL_B = PH_WALL_A
- PABS_LW_WALL_B = PABS_LW_WALL_A
- PDQS_WALL_B = PDQS_WALL_A
- PFLX_BLD_WALL_B = PFLX_BLD_WALL_A
- ZEMIT_LW_WALL_B = ZEMIT_LW_WALL_A
+ T%XT_WALL_B = T%XT_WALL_A
+ DMT%XH_WALL_B = DMT%XH_WALL_A
+ DMT%XABS_LW_WALL_B = DMT%XABS_LW_WALL_A
+ PDQS_WL_B = PDQS_WL_A
+ PFLX_BLD_WL_B = PFLX_BLD_WL_A
+ ZEMIT_LW_WL_B = ZEMIT_LW_WL_A
END IF
!
-PIMB_WALL = PIMB_WALL + 0.5 * ZIMB_WALL
-PRAD_WALL_FLOOR = PRAD_WALL_FLOOR + 0.5 * ZRAD_WALL_FLOOR
-PRAD_WALL_MASS = PRAD_WALL_MASS + 0.5 * ZRAD_WALL_MASS
-PCONV_WALL_BLD = PCONV_WALL_BLD + 0.5 * ZCONV_WALL_BLD
-ZRAD_WALL_WIN = ZRAD_WALL_WIN + 0.5 * ZRAD_WALL_A_WIN
+PIMB_WL = PIMB_WL + 0.5 * ZIMB_WL
+PRAD_WL_FL = PRAD_WL_FL + 0.5 * ZRAD_WL_FL
+PRAD_WL_MA = PRAD_WL_MA + 0.5 * ZRAD_WL_MA
+PCONV_WL_BLD = PCONV_WL_BLD + 0.5 * ZCONV_WL_BLD
+ZRAD_WL_WIN = ZRAD_WL_WIN + 0.5 * ZRAD_WL_A_WIN
!
!-------------------------------------------------------------------------------
!
! *Energy Balance for windows (averaged on both walls)
! ---------------------------------------------------
!
-IF (HBEM == 'DEF') THEN
+IF (TOP%CBEM == 'DEF') THEN
ZEMIT_LW_WIN(:) = 0.
- PABS_LW_WIN (:) = XUNDEF
END IF
!
-IF (HBEM == 'BEM') THEN
- ZEMIS_WIN(:) = 0.84 ! From Engineering Reference documentation p219
- ! (see http://apps1.eere.energy.gov/buildings/energyplus/
+IF (TOP%CBEM == 'BEM') THEN
+ ZEMIS_WIN(:) = 0.84 ! From Engineering Reference documentation p219
+ ! (see http://apps1.eere.energy.gov/buildings/energyplus/
ZLW_W_TO_WIN(:) = PLW_WA_TO_WIN(:) + PLW_WB_TO_WIN(:)
- ZTS_WALL(:) = XUNDEF
+ ZTS_WL(:) = XUNDEF
WHERE (ZLW_W_TO_WIN(:)>0.) &
- ZTS_WALL(:) = ( PLW_WA_TO_WIN(:)*PT_WALL_A(:,1)+PLW_WB_TO_WIN(:)*PT_WALL_B(:,1) ) / ZLW_W_TO_WIN(:)
- CALL WINDOW_E_BUDGET(PU_WIN, ZEMIS_WIN, PF_WIN_FLOOR, PF_WIN_WALL, PF_WIN_MASS, &
- ZLW_W_TO_WIN, PLW_R_TO_WIN, PLW_G_TO_WIN, PLW_NR_TO_WIN, PLW_S_TO_WIN, &
- PRAD_ROOF_WIN, ZRAD_WALL_WIN, PABS_SW_WIN, PLW_RAD, PAC_WIN, &
- PRADHT_IN, PTI_BLD, PTS_MASS, PTS_FLOOR, PRHOA, PDN_ROAD, &
- PT_CANYON, ZTS_WALL, PTS_ROAD, PTSNOW_ROAD, PTS_GARDEN, &
- PT_WIN1, PT_WIN2, PRAD_WIN_FLOOR, PRAD_WIN_MASS, PCONV_WIN_BLD, &
- ZEMIT_LW_WIN, PABS_LW_WIN, PLOAD_IN_WIN )
+ ZTS_WL(:) = ( PLW_WA_TO_WIN(:)*T%XT_WALL_A(:,1)+PLW_WB_TO_WIN(:)*T%XT_WALL_B(:,1) ) / ZLW_W_TO_WIN(:)
+ CALL WINDOW_E_BUDGET(B, ZEMIS_WIN, ZLW_W_TO_WIN, PLW_R_TO_WIN, PLW_G_TO_WIN, PLW_NR_TO_WIN, &
+ PLW_S_TO_WIN, PRAD_RF_WIN, ZRAD_WL_WIN, DMT%XABS_SW_WIN, PLW_RAD, PAC_WIN, &
+ PRADHT_IN, PTS_FL, PRHOA, PDN_RD, PT_CANYON, ZTS_WL, PTS_RD, PTSN_RD, &
+ PTS_GD, PRAD_WIN_FL, PRAD_WIN_MA, PCONV_WIN_BLD, ZEMIT_LW_WIN, &
+ DMT%XABS_LW_WIN, PLOAD_IN_WIN )
ENDIF
!* wall, and win emitted LW radiation on snow-free surfaces
! ----------------------------------------------------------------
!
!
-PEMIT_LW_FAC (:) = 0.5*(ZEMIT_LW_WALL_A(:)+ZEMIT_LW_WALL_B(:)) * (1-PGR(:)) + ZEMIT_LW_WIN(:) * PGR(:)
+PEMIT_LW_FAC (:) = 0.5*(ZEMIT_LW_WL_A(:)+ZEMIT_LW_WL_B(:)) * (1-B%XGR(:)) + ZEMIT_LW_WIN(:) * B%XGR(:)
!
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('FACADE_E_BUDGET',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/fapair.F90 b/src/SURFEX/fapair.F90
index 9866468934445aabdc3a4b46a59305875e9855d5..fe1404e073f286fc7d8135044c81ed80097959e6 100644
--- a/src/SURFEX/fapair.F90
+++ b/src/SURFEX/fapair.F90
@@ -45,11 +45,13 @@ SUBROUTINE FAPAIR(PABC, PFD_SKY, PIA, PLAI, PXMUS, PSSA_SUP, PSSA_INF, &
!! Original 01/04/2011
!! Commented by C. Delire 07/13
!! C. Delire 08/13 : moved calculation of diffuse fraction from here to radiative_transfert.F90
+!! A. Boone 02/17 : corrected computation of PFAPR_BS
!!
!!-------------------------------------------------------------------------------
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_CO2V_PAR, ONLY : XK_SUP, XK_INF, XXSI_SUP, XXSI_INF ! clumping index parameters (Carrer et al 2.1.3)
!
+USE MODD_SURFEX_MPI, ONLY : NRANK
USE MODI_CCETR_PAIR
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -214,7 +216,7 @@ DO JINT = SIZE(PABC),1,-1
!
!sunlit leaves
!absorbed PAR of an equivalent canopy representative of the layer of leaves eq. (8)
- ZCOEF = (1.0-ZFD_SUP(I))/ZTR(I)+ ZFD_SUP(I)
+ ZCOEF = (1.0-ZFD_SUP(I))/ZTR(I)+ ZFD_SUP(I)
ZIACAN_SUNLIT(I,JINT) = ZCOEF/(ZWEIGHT*MAX(0.0001,PLAI(I)))*ZIACAN(I,JINT)
!not sunlit leaves
ZIACAN_SHADE(I,JINT) = MAX(0.,ZFD_SUP(I)/(ZWEIGHT*MAX(0.0001,PLAI(I)))*ZIACAN(I,JINT))
@@ -243,8 +245,7 @@ END DO
!
WHERE (PIA(:).NE.0.)
PFAPR(:) = PFAPR(:) / PIA(:)
- PFAPR_BS(:)=(1.-PALB_VEG(:))*(1-PALB_SOIL(:))*(1.+PALB_VEG(:)*PALB_SOIL(:))*ZTR(:)
- WHERE (PLAI(:).EQ.0) PFAPR_BS(:) = 1-PALB_SOIL(:)
+ PFAPR_BS(:)= ZTR(:)*(1.-PALB_SOIL(:)*(1. - PALB_VEG(:)*(1.-ZTR(:))))
END WHERE
!
!WHERE (ZLAI_SHADE(:) .NE.0.) ZRN_SHADE(:) = ZXIA_SHADE(:) / ZLAI_SHADE(:)
diff --git a/src/SURFEX/fix_meb_veg.F90 b/src/SURFEX/fix_meb_veg.F90
index 0a16d5c1cb26737e7429105ebe278bff4ff3e74f..5d51f6bde32aa9a03d459acc3e011a37f41142f6 100644
--- a/src/SURFEX/fix_meb_veg.F90
+++ b/src/SURFEX/fix_meb_veg.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ################################################################
- SUBROUTINE FIX_MEB_VEG (DTI, IG, I, &
- KPATCH)
+ SUBROUTINE FIX_MEB_VEG (DTV, KDIM, OMEB_PATCH, KPATCH)
! ################################################################
!
!! PURPOSE
@@ -56,8 +55,6 @@
!
!
USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
!
USE MODD_DATA_COVER, ONLY : XDATA_VEG
USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
@@ -75,9 +72,9 @@ IMPLICIT NONE
! ------------------------
!
!
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+INTEGER, INTENT(IN) :: KDIM
+LOGICAL, DIMENSION(:), INTENT(IN) :: OMEB_PATCH
!
INTEGER, INTENT(IN) :: KPATCH
!
@@ -86,7 +83,7 @@ INTEGER, INTENT(IN) :: KPATCH
!
INTEGER :: IPATCH
!
-REAL, DIMENSION(IG%NDIM,DTI%NTIME) :: ZWORKPAR
+REAL, DIMENSION(KDIM,DTV%NTIME) :: ZWORKPAR
REAL, DIMENSION(SIZE(XDATA_VEG,1),SIZE(XDATA_VEG,2)) :: ZWORKDATA
!
INTEGER :: JVEGTYPE! loop on vegtype
@@ -105,18 +102,18 @@ ENDDO
DO JVEGTYPE=1,NVEGTYPE
!
ZWORKDATA(:,:)=XDATA_VEG(:,:,JVEGTYPE)
- IF (DTI%LDATA_VEG) ZWORKPAR(:,:)=DTI%XPAR_VEG(:,:,JVEGTYPE)
+ IF (ANy(DTV%LDATA_VEG)) ZWORKPAR(:,:)=DTV%XPAR_VEG(:,:,JVEGTYPE)
!
DO IPATCH=1,KPATCH
- IF(PATCH_LIST(JVEGTYPE)==IPATCH .AND. I%LMEB_PATCH(IPATCH))THEN
+ IF(PATCH_LIST(JVEGTYPE)==IPATCH .AND. OMEB_PATCH(IPATCH))THEN
ZWORKDATA(:,:)=0.5
- IF (DTI%LDATA_VEG) ZWORKPAR(:,:)=0.5
+ IF (ANY(DTV%LDATA_VEG)) ZWORKPAR(:,:)=0.5
EXIT
ENDIF
ENDDO
!
XDATA_VEG(:,:,JVEGTYPE)=ZWORKDATA(:,:)
- IF (DTI%LDATA_VEG) DTI%XPAR_VEG(:,:,JVEGTYPE)=ZWORKPAR(:,:)
+ IF (ANy(DTV%LDATA_VEG)) DTV%XPAR_VEG(:,:,JVEGTYPE)=ZWORKPAR(:,:)
!
ENDDO
!
diff --git a/src/SURFEX/flag_diag_update.F90 b/src/SURFEX/flag_diag_update.F90
index a6b79d6b83d25dd45384ea808ab159cebfc3052e..4e3ca1f6b51af3d9cfebdc53fb372207f36e6f3a 100644
--- a/src/SURFEX/flag_diag_update.F90
+++ b/src/SURFEX/flag_diag_update.F90
@@ -3,13 +3,12 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE FLAG_DIAG_UPDATE (CHF, CHI, CHS, CHT, CHW, DGEI, DGF, DGI, DGMF, DGMI, DGMTO, &
- DGO, DGS, DGSI, DGU, DGT, DGW, I, U, &
+SUBROUTINE FLAG_DIAG_UPDATE (FM, IM, SM, TM, WM, DGO, U, SV, &
OFRAC, ODIAG_GRID, K2M, OSURF_BUDGET, ORAD_BUDGET, OCOEF, &
- OSURF_VARS, KBEQ, KDSTEQ, ODIAG_OCEAN, ODIAG_SEAICE, &
- OWATER_PROFILE, &
- OSURF_EVAP_BUDGET, OFLOOD, OPGD_ISBA, OCH_NO_FLUX_ISBA, &
- OSURF_MISC_BUDGET_ISBA, OPGD_TEB, OSURF_MISC_BUDGET_TEB )
+ OSURF_VARS, KBEQ, KDSTEQ, ODIAG_OCEAN, ODIAG_MISC_SEAICE, &
+ OWATER_PROFILE, OSURF_EVAP_BUDGET, OFLOOD, OPGD_ISBA, &
+ OCH_NO_FLUX_ISBA, OSURF_MISC_BUDGET_ISBA, OPGD_TEB, &
+ OSURF_MISC_BUDGET_TEB )
! ############################################################
!
!!**** *FLAG_DIAG_UPDATE* - routine to modify selection of output fields
@@ -47,28 +46,11 @@ SUBROUTINE FLAG_DIAG_UPDATE (CHF, CHI, CHS, CHT, CHW, DGEI, DGF, DGI, DGMF, DGMI
!* 0. DECLARATIONS
! ------------
!
-!
-!
-!
-USE MODD_CH_FLAKE_n, ONLY : CH_FLAKE_t
-USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
-USE MODD_CH_SEAFLUX_n, ONLY : CH_SEAFLUX_t
-USE MODD_CH_TEB_n, ONLY : CH_TEB_t
-USE MODD_CH_WATFLUX_n, ONLY : CH_WATFLUX_t
-USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
-USE MODD_DIAG_FLAKE_n, ONLY : DIAG_FLAKE_t
-USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
-USE MODD_DIAG_MISC_FLAKE_n, ONLY : DIAG_MISC_FLAKE_t
-USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
-USE MODD_DIAG_MISC_TEB_OPTION_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
-USE MODD_DIAG_OCEAN_n, ONLY : DIAG_OCEAN_t
-USE MODD_DIAG_SEAFLUX_n, ONLY : DIAG_SEAFLUX_t
-USE MODD_DIAG_SEAICE_n, ONLY : DIAG_SEAICE_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_DIAG_TEB_n, ONLY : DIAG_TEB_t
-USE MODD_DIAG_WATFLUX_n, ONLY : DIAG_WATFLUX_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_SURFEX_n, ONLY : FLAKE_MODEL_t, ISBA_MODEL_t, SEAFLUX_MODEL_t, &
+ TEB_MODEL_t, WATFLUX_MODEL_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SV_n, ONLY : SV_t
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -78,26 +60,15 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
+TYPE(FLAKE_MODEL_t), INTENT(INOUT) :: FM
+TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
+TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM
+TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM
+TYPE(WATFLUX_MODEL_t), INTENT(INOUT) :: WM
!
-TYPE(CH_FLAKE_t), INTENT(INOUT) :: CHF
-TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
-TYPE(CH_SEAFLUX_t), INTENT(INOUT) :: CHS
-TYPE(CH_TEB_t), INTENT(INOUT) :: CHT
-TYPE(CH_WATFLUX_t), INTENT(INOUT) :: CHW
-TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DGEI
-TYPE(DIAG_FLAKE_t), INTENT(INOUT) :: DGF
-TYPE(DIAG_ISBA_t), INTENT(INOUT) :: DGI
-TYPE(DIAG_MISC_FLAKE_t), INTENT(INOUT) :: DGMF
-TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DGMI
-TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: DGMTO
-TYPE(DIAG_OCEAN_t), INTENT(INOUT) :: DGO
-TYPE(DIAG_SEAFLUX_t), INTENT(INOUT) :: DGS
-TYPE(DIAG_SEAICE_t), INTENT(INOUT) :: DGSI
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(DIAG_TEB_t), INTENT(INOUT) :: DGT
-TYPE(DIAG_WATFLUX_t), INTENT(INOUT) :: DGW
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SV_t), INTENT(INOUT) :: SV
!
LOGICAL, INTENT(IN) :: OFRAC
LOGICAL, INTENT(IN) :: ODIAG_GRID
@@ -111,7 +82,7 @@ INTEGER, INTENT(IN) :: KBEQ
INTEGER, INTENT(IN) :: KDSTEQ
!
LOGICAL, INTENT(IN) :: ODIAG_OCEAN
-LOGICAL, INTENT(IN) :: ODIAG_SEAICE
+LOGICAL, INTENT(IN) :: ODIAG_MISC_SEAICE
LOGICAL, INTENT(IN) :: OWATER_PROFILE
LOGICAL, INTENT(IN) :: OSURF_EVAP_BUDGET
LOGICAL, INTENT(IN) :: OFLOOD
@@ -128,38 +99,39 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('FLAG_DIAG_UPDATE',0,ZHOOK_HANDLE)
!
-DGU%LFRAC = OFRAC
-DGU%LDIAG_GRID = ODIAG_GRID
-DGU%N2M = K2M
-DGU%LSURF_BUDGET = OSURF_BUDGET
-DGU%LRAD_BUDGET = ORAD_BUDGET
-DGU%LCOEF = OCOEF
-DGU%LSURF_VARS = OSURF_VARS
-!
-DGU%LSURF_BUDGETC = .FALSE.
-IF (.NOT.DGU%LRESET_BUDGETC) DGU%LSURF_BUDGETC = .TRUE.
-!
-IF (U%CSEA =='SEAFLX') CALL FLAG_SEA_UPDATE(KBEQ, ODIAG_OCEAN, ODIAG_SEAICE, &
- DGU%LSURF_BUDGETC, DGU%LRAD_BUDGET, K2M)
-IF (U%CWATER =='FLAKE ') CALL FLAG_FLAKE_UPDATE(KBEQ, OWATER_PROFILE, DGU%LSURF_BUDGETC, DGU%LRAD_BUDGET, K2M)
-IF (U%CWATER =='WATFLX') CALL FLAG_WATER_UPDATE(KBEQ, DGU%LSURF_BUDGETC, DGU%LRAD_BUDGET, K2M)
+DGO%LFRAC = OFRAC
+DGO%LDIAG_GRID = ODIAG_GRID
+DGO%N2M = K2M
+DGO%LSURF_BUDGET = OSURF_BUDGET
+DGO%LRAD_BUDGET = ORAD_BUDGET
+DGO%LCOEF = OCOEF
+DGO%LSURF_VARS = OSURF_VARS
+!
+SV%NBEQ = KBEQ
+!
+DGO%LSURF_BUDGETC = .FALSE.
+IF (.NOT.DGO%LRESET_BUDGETC) DGO%LSURF_BUDGETC = .TRUE.
+!
+IF (U%CSEA =='SEAFLX') CALL FLAG_SEA_UPDATE(KBEQ, ODIAG_OCEAN, ODIAG_MISC_SEAICE, &
+ DGO%LSURF_BUDGETC, DGO%LRAD_BUDGET, K2M)
+IF (U%CWATER =='FLAKE ') CALL FLAG_FLAKE_UPDATE(KBEQ, OWATER_PROFILE, DGO%LSURF_BUDGETC, DGO%LRAD_BUDGET, K2M)
+IF (U%CWATER =='WATFLX') CALL FLAG_WATER_UPDATE(KBEQ, DGO%LSURF_BUDGETC, DGO%LRAD_BUDGET, K2M)
IF (U%CNATURE=='ISBA ') CALL FLAG_ISBA_UPDATE(KBEQ, KDSTEQ, OSURF_EVAP_BUDGET, OFLOOD, &
- OPGD_ISBA, OCH_NO_FLUX_ISBA, OSURF_MISC_BUDGET_ISBA,&
- DGU%LSURF_BUDGETC, DGU%LRAD_BUDGET, K2M)
-IF (U%CTOWN =='TEB ') CALL FLAG_TEB_UPDATE(KBEQ, OPGD_TEB, OSURF_MISC_BUDGET_TEB, DGU%LRAD_BUDGET, K2M)
+ OPGD_ISBA, OCH_NO_FLUX_ISBA, OSURF_MISC_BUDGET_ISBA,&
+ DGO%LSURF_BUDGETC, DGO%LRAD_BUDGET, K2M)
+IF (U%CTOWN =='TEB ') CALL FLAG_TEB_UPDATE(KBEQ, OPGD_TEB, OSURF_MISC_BUDGET_TEB, DGO%LRAD_BUDGET, K2M)
!
IF (LHOOK) CALL DR_HOOK('FLAG_DIAG_UPDATE',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
- CONTAINS
-!
-SUBROUTINE FLAG_SEA_UPDATE(KBEQ, ODIAG_OCEAN, ODIAG_SEAICE, OSURF_BUDGETC, ORAD_BUDGET, K2M)
+CONTAINS
!
+SUBROUTINE FLAG_SEA_UPDATE(KBEQ, ODIAG_OCEAN, ODIAG_MISC_SEAICE, OSURF_BUDGETC, ORAD_BUDGET, K2M)
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KBEQ
LOGICAL, INTENT(IN) :: ODIAG_OCEAN
-LOGICAL, INTENT(IN) :: ODIAG_SEAICE
+LOGICAL, INTENT(IN) :: ODIAG_MISC_SEAICE
LOGICAL, INTENT(IN) :: OSURF_BUDGETC
LOGICAL, INTENT(IN) :: ORAD_BUDGET
INTEGER, INTENT(IN) :: K2M
@@ -167,12 +139,12 @@ INTEGER, INTENT(IN) :: K2M
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('FLAG_DIAG_UPDATE:FLAG_SEA_UPDATE',0,ZHOOK_HANDLE)
- CHS%SVS%NBEQ = KBEQ
-DGO%LDIAG_OCEAN = ODIAG_OCEAN
-DGSI%LDIAG_SEAICE = ODIAG_SEAICE
-DGS%LSURF_BUDGETC = OSURF_BUDGETC
-DGS%LRAD_BUDGET = ORAD_BUDGET
-DGS%N2M = K2M
+SM%CHS%SVS%NBEQ = KBEQ
+SM%SD%GO%LDIAG_OCEAN = ODIAG_OCEAN
+SM%SD%DMI%LDIAG_MISC_SEAICE = ODIAG_MISC_SEAICE
+SM%SD%O%LSURF_BUDGETC = OSURF_BUDGETC
+SM%SD%O%LRAD_BUDGET = ORAD_BUDGET
+SM%SD%O%N2M = K2M
IF (LHOOK) CALL DR_HOOK('FLAG_DIAG_UPDATE:FLAG_SEA_UPDATE',1,ZHOOK_HANDLE)
!
END SUBROUTINE FLAG_SEA_UPDATE
@@ -190,10 +162,10 @@ INTEGER, INTENT(IN) :: K2M
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('FLAG_DIAG_UPDATE:FLAG_WATER_UPDATE',0,ZHOOK_HANDLE)
- CHW%SVW%NBEQ = KBEQ
-DGW%LSURF_BUDGETC = OSURF_BUDGETC
-DGW%LRAD_BUDGET = ORAD_BUDGET
-DGW%N2M = K2M
+WM%CHW%SVW%NBEQ = KBEQ
+WM%DWO%LSURF_BUDGETC = OSURF_BUDGETC
+WM%DWO%LRAD_BUDGET = ORAD_BUDGET
+WM%DWO%N2M = K2M
IF (LHOOK) CALL DR_HOOK('FLAG_DIAG_UPDATE:FLAG_WATER_UPDATE',1,ZHOOK_HANDLE)
!
END SUBROUTINE FLAG_WATER_UPDATE
@@ -212,11 +184,11 @@ INTEGER, INTENT(IN) :: K2M
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('FLAG_DIAG_UPDATE:FLAG_FLAKE_UPDATE',0,ZHOOK_HANDLE)
- CHF%SVF%NBEQ = KBEQ
-DGMF%LWATER_PROFILE = OWATER_PROFILE
-DGF%LSURF_BUDGETC = OSURF_BUDGETC
-DGF%LRAD_BUDGET = ORAD_BUDGET
-DGF%N2M = K2M
+FM%CHF%SVF%NBEQ = KBEQ
+FM%DMF%LWATER_PROFILE = OWATER_PROFILE
+FM%DFO%LSURF_BUDGETC = OSURF_BUDGETC
+FM%DFO%LRAD_BUDGET = ORAD_BUDGET
+FM%DFO%N2M = K2M
IF (LHOOK) CALL DR_HOOK('FLAG_DIAG_UPDATE:FLAG_FLAKE_UPDATE',1,ZHOOK_HANDLE)
!
END SUBROUTINE FLAG_FLAKE_UPDATE
@@ -243,17 +215,17 @@ INTEGER, INTENT(IN) :: K2M
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('FLAG_DIAG_UPDATE:FLAG_ISBA_UPDATE',0,ZHOOK_HANDLE)
- CHI%SVI%NBEQ = KBEQ
- CHI%SVI%NDSTEQ = KDSTEQ
-DGEI%LSURF_EVAP_BUDGET = OSURF_EVAP_BUDGET
-I%LFLOOD = OFLOOD
-DGI%LPGD = OPGD
- CHI%LCH_NO_FLUX = OCH_NO_FLUX
-DGMI%LSURF_MISC_BUDGET = OSURF_MISC_BUDGET
-DGEI%LSURF_BUDGETC = OSURF_BUDGETC
-DGI%LPATCH_BUDGET = OSURF_BUDGETC
-DGI%LRAD_BUDGET = ORAD_BUDGET
-DGI%N2M = K2M
+IM%CHI%SVI%NBEQ = KBEQ
+IM%CHI%SVI%NDSTEQ = KDSTEQ
+IM%ID%DE%LSURF_EVAP_BUDGET = OSURF_EVAP_BUDGET
+IM%O%LFLOOD = OFLOOD
+IM%ID%O%LPGD = OPGD
+IM%CHI%LCH_NO_FLUX = OCH_NO_FLUX
+IM%ID%DM%LSURF_MISC_BUDGET = OSURF_MISC_BUDGET
+IM%ID%O%LSURF_BUDGETC = OSURF_BUDGETC
+IM%ID%O%LPATCH_BUDGET = OSURF_BUDGETC
+IM%ID%O%LRAD_BUDGET = ORAD_BUDGET
+IM%ID%O%N2M = K2M
IF (LHOOK) CALL DR_HOOK('FLAG_DIAG_UPDATE:FLAG_ISBA_UPDATE',1,ZHOOK_HANDLE)
!
END SUBROUTINE FLAG_ISBA_UPDATE
@@ -272,11 +244,11 @@ INTEGER, INTENT(IN) :: K2M
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('FLAG_DIAG_UPDATE:FLAG_TEB_UPDATE',0,ZHOOK_HANDLE)
- CHT%SVT%NBEQ = KBEQ
-DGT%LPGD = OPGD
-DGMTO%LSURF_MISC_BUDGET = OSURF_MISC_BUDGET
-DGT%LRAD_BUDGET = ORAD_BUDGET
-DGT%N2M = K2M
+TM%CHT%SVT%NBEQ = KBEQ
+TM%TD%O%LPGD = OPGD
+TM%TD%MTO%LSURF_MISC_BUDGET = OSURF_MISC_BUDGET
+TM%TD%O%LRAD_BUDGET = ORAD_BUDGET
+TM%TD%O%N2M = K2M
IF (LHOOK) CALL DR_HOOK('FLAG_DIAG_UPDATE:FLAG_TEB_UPDATE',1,ZHOOK_HANDLE)
!
END SUBROUTINE FLAG_TEB_UPDATE
diff --git a/src/SURFEX/flag_gr_snow.F90 b/src/SURFEX/flag_gr_snow.F90
index c66b9d8d213f29a8f4e4875646afc8befe5e2c6b..978ebc67a5fa99c1b8b7456612a2e056e3c291f6 100644
--- a/src/SURFEX/flag_gr_snow.F90
+++ b/src/SURFEX/flag_gr_snow.F90
@@ -43,7 +43,6 @@
!
USE MODD_TYPE_SNOW
!
-!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -62,7 +61,7 @@ TYPE(SURF_SNOW), INTENT(INOUT) :: TPSNOW ! snow characteristics
!* 0.2 declarations of local variables
!
REAL :: ZVAL
-INTEGER :: JLAYER, JPATCH
+INTEGER :: JLAYER
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('FLAG_GR_SNOW',0,ZHOOK_HANDLE)
@@ -73,31 +72,29 @@ ELSEIF (KFLAG==2) THEN
ZVAL = XUNDEF
ENDIF
!
-DO JPATCH = 1,SIZE(TPSNOW%WSNOW,3)
- !
DO JLAYER = 1,TPSNOW%NLAYER
!
- WHERE(OMASK(:)) TPSNOW%WSNOW(:,JLAYER,JPATCH) = ZVAL
+ WHERE(OMASK(:)) TPSNOW%WSNOW(:,JLAYER) = ZVAL
!
IF (KFLAG==1) THEN
!
- WHERE(OMASK(:)) TPSNOW%RHO (:,JLAYER,JPATCH) = XUNDEF
+ WHERE(OMASK(:)) TPSNOW%RHO (:,JLAYER) = XUNDEF
!
IF (SIZE(TPSNOW%TEMP ) >0) THEN
WHERE(OMASK(:))
- TPSNOW%TEMP (:,JLAYER,JPATCH) = XUNDEF
- TPSNOW%HEAT (:,JLAYER,JPATCH) = XUNDEF
+ TPSNOW%TEMP (:,JLAYER) = XUNDEF
+ TPSNOW%HEAT (:,JLAYER) = XUNDEF
END WHERE
ENDIF
!
- IF (SIZE(TPSNOW%T ) >0) WHERE(OMASK(:)) TPSNOW%T(:,JLAYER,JPATCH) = XUNDEF
+ IF (SIZE(TPSNOW%T ) >0) WHERE(OMASK(:)) TPSNOW%T(:,JLAYER) = XUNDEF
!
IF (SIZE(TPSNOW%GRAN1) >0) THEN
WHERE(OMASK(:))
- TPSNOW%GRAN1(:,JLAYER,JPATCH) = XUNDEF
- TPSNOW%GRAN2(:,JLAYER,JPATCH) = XUNDEF
- TPSNOW%HIST (:,JLAYER,JPATCH) = XUNDEF
- TPSNOW%AGE (:,JLAYER,JPATCH) = XUNDEF
+ TPSNOW%GRAN1(:,JLAYER) = XUNDEF
+ TPSNOW%GRAN2(:,JLAYER) = XUNDEF
+ TPSNOW%HIST (:,JLAYER) = XUNDEF
+ TPSNOW%AGE (:,JLAYER) = XUNDEF
END WHERE
END IF
!
@@ -107,21 +104,19 @@ DO JPATCH = 1,SIZE(TPSNOW%WSNOW,3)
!
IF (KFLAG==1) THEN
!
- WHERE(OMASK(:)) TPSNOW%ALB (:,JPATCH) = XUNDEF
- WHERE(OMASK(:)) TPSNOW%ALBVIS (:,JPATCH) = XUNDEF
- WHERE(OMASK(:)) TPSNOW%ALBNIR (:,JPATCH) = XUNDEF
- WHERE(OMASK(:)) TPSNOW%ALBFIR (:,JPATCH) = XUNDEF
+ WHERE(OMASK(:)) TPSNOW%ALB (:) = XUNDEF
+ WHERE(OMASK(:)) TPSNOW%ALBVIS (:) = XUNDEF
+ WHERE(OMASK(:)) TPSNOW%ALBNIR (:) = XUNDEF
+ WHERE(OMASK(:)) TPSNOW%ALBFIR (:) = XUNDEF
!
IF (SIZE(TPSNOW%EMIS ) >0) THEN
WHERE(OMASK(:))
- TPSNOW%EMIS (:,JPATCH) = XUNDEF
- TPSNOW%TS (:,JPATCH) = XUNDEF
+ TPSNOW%EMIS (:) = XUNDEF
+ TPSNOW%TS (:) = XUNDEF
END WHERE
END IF
!
ENDIF
- !
-END DO
!
IF (LHOOK) CALL DR_HOOK('FLAG_GR_SNOW',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/flag_teb_greenroofn.F90 b/src/SURFEX/flag_teb_greenroofn.F90
deleted file mode 100644
index 90ab4aa0df94f9d9db167c8f78d6a56c8a0215ec..0000000000000000000000000000000000000000
--- a/src/SURFEX/flag_teb_greenroofn.F90
+++ /dev/null
@@ -1,174 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE FLAG_TEB_GREENROOF_n (TGR, TGRO, TGRPE, T, TVG, &
- KFLAG)
-! ##################################
-!
-!!**** *FLAG_TEB_GREENROOF_n* - routine to flag ISBA variables where green roofs are
-!! not present
-!!
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 10/2011
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!
-USE MODD_TEB_GREENROOF_n, ONLY : TEB_GREENROOF_t
-USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
-USE MODD_TEB_GREENROOF_PGD_EVOL_n, ONLY : TEB_GREENROOF_PGD_EVOL_t
-USE MODD_TEB_n, ONLY : TEB_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
-!
-USE MODD_CO2V_PAR, ONLY : XANFMINIT, XCONDCTMIN
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE MODI_FLAG_GR_SNOW
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
-!
-TYPE(TEB_GREENROOF_t), INTENT(INOUT) :: TGR
-TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: TGRO
-TYPE(TEB_GREENROOF_PGD_EVOL_t), INTENT(INOUT) :: TGRPE
-TYPE(TEB_t), INTENT(INOUT) :: T
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
-!
-INTEGER, INTENT(IN) :: KFLAG ! 1 : to put physical values to run ISBA afterwards
-! ! 2 : to flag with XUNDEF value for points without green roof
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-REAL :: ZWR, ZTG, ZWG, ZRESA, ZANFM, ZDEF
-INTEGER :: JL1, JL2 ! loop counter on layers
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1D physical dimension
-!
-IF (LHOOK) CALL DR_HOOK('FLAG_TEB_GREENROOF_N',0,ZHOOK_HANDLE)
-!
-ZWR = XUNDEF
-!
-IF (KFLAG==1) THEN
- ZTG = 300.
- ZWG = 0.5
- ZRESA = 100.
- ZANFM = XANFMINIT
- ZDEF = 0.
-ELSEIF (KFLAG==2) THEN
- ZTG = XUNDEF
- ZWG = XUNDEF
- ZRESA = XUNDEF
- ZANFM = XUNDEF
- ZDEF = XUNDEF
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
- !
- DO JL1=1,TGRO%NLAYER_GR
- WHERE (T%CUR%XGREENROOF(:)==0.)
- TGR%CUR%XTG (:,JL1) = ZTG
- TGR%CUR%XWG (:,JL1) = ZWG
- TGR%CUR%XWGI(:,JL1) = ZDEF
- END WHERE
- END DO
- !
- WHERE (T%CUR%XGREENROOF(:)==0.)
- TGR%CUR%XWR (:) = ZWR
- TGR%CUR%XRESA(:) = ZRESA
- END WHERE
- !
- IF (TVG%CPHOTO/='NON') THEN
- !
- WHERE (T%CUR%XGREENROOF(:)==0.)
- TGR%CUR%XANFM (:) = ZANFM
- TGR%CUR%XAN (:) = ZDEF
- TGR%CUR%XANDAY(:) = ZDEF
- TGR%CUR%XLE (:) = ZDEF
- END WHERE
- !
- ELSE IF (TVG%CPHOTO=='LAI' .OR. TVG%CPHOTO=='LST' .OR. TVG%CPHOTO=='NIT' .OR. TVG%CPHOTO=='NCB') THEN
- !
- WHERE (T%CUR%XGREENROOF(:)==0.) TGRPE%CUR%XLAI(:) = ZDEF
- !
- ELSE IF (TVG%CPHOTO=='AGS' .OR. TVG%CPHOTO=='AST') THEN
- !
- DO JL1=1,SIZE(TGR%CUR%XBIOMASS,2)
- WHERE (T%CUR%XGREENROOF(:)==0.)
- TGR%CUR%XBIOMASS (:,JL1) = ZDEF
- TGR%CUR%XRESP_BIOMASS(:,JL1) = ZDEF
- END WHERE
- END DO
- !
- END IF
- !
-!ENDIF
- !
-!
-!-------------------------------------------------------------------------------
-!
-!* Flag snow characteristics
-!
- CALL FLAG_GR_SNOW(KFLAG,T%CUR%XGREENROOF(:)==0.,TGR%CUR%TSNOW)
-!
-!
-!* snow-free characteristics
-!
-IF (KFLAG==1) THEN
- WHERE (T%CUR%XGREENROOF==0.) TGR%CUR%XSNOWFREE_ALB = 0.2
- WHERE (T%CUR%XGREENROOF==0.) TGR%CUR%XSNOWFREE_ALB_VEG = 0.2
- WHERE (T%CUR%XGREENROOF==0.) TGR%CUR%XSNOWFREE_ALB_SOIL = 0.2
-ELSEIF (KFLAG==2) THEN
- WHERE (T%CUR%XGREENROOF==0.) TGR%CUR%XSNOWFREE_ALB = XUNDEF
- WHERE (T%CUR%XGREENROOF==0.) TGR%CUR%XSNOWFREE_ALB_VEG = XUNDEF
- WHERE (T%CUR%XGREENROOF==0.) TGR%CUR%XSNOWFREE_ALB_SOIL = XUNDEF
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('FLAG_TEB_GREENROOF_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE FLAG_TEB_GREENROOF_n
diff --git a/src/SURFEX/flag_teb_gardenn.F90 b/src/SURFEX/flag_teb_vegn.F90
similarity index 55%
rename from src/SURFEX/flag_teb_gardenn.F90
rename to src/SURFEX/flag_teb_vegn.F90
index cfc35a5d0e9c51e780b919cef2b64261487067fa..79d588230903f840359f27934c8fdfb87f6e558f 100644
--- a/src/SURFEX/flag_teb_gardenn.F90
+++ b/src/SURFEX/flag_teb_vegn.F90
@@ -3,11 +3,10 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE FLAG_TEB_GARDEN_n (TGD, TGDO, TGDPE, T, TVG, &
- KFLAG)
+ SUBROUTINE FLAG_TEB_VEG_n (PEK, IO, PMASK, KFLAG)
! ##################################
!
-!!**** *FLAG_TEB_GARDEN_n* - routine to flag ISBA variables where gardens are
+!!**** *FLAG_TEB_VEG_n* - routine to flag ISBA variables where gardens are
!! not present
!!
!!
@@ -43,11 +42,8 @@
!
!
!
-USE MODD_TEB_GARDEN_n, ONLY : TEB_GARDEN_t
-USE MODD_TEB_GARDEN_OPTION_n, ONLY : TEB_GARDEN_OPTIONS_t
-USE MODD_TEB_GARDEN_PGD_EVOL_n, ONLY : TEB_GARDEN_PGD_EVOL_t
-USE MODD_TEB_n, ONLY : TEB_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_PE_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
USE MODD_CO2V_PAR, ONLY : XANFMINIT, XCONDCTMIN
!
@@ -64,11 +60,9 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(TEB_GARDEN_t), INTENT(INOUT) :: TGD
-TYPE(TEB_GARDEN_OPTIONS_t), INTENT(INOUT) :: TGDO
-TYPE(TEB_GARDEN_PGD_EVOL_t), INTENT(INOUT) :: TGDPE
-TYPE(TEB_t), INTENT(INOUT) :: T
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+REAL, DIMENSION(:), INTENT(IN) :: PMASK
!
INTEGER, INTENT(IN) :: KFLAG ! 1 : to put physical values to run ISBA afterwards
! ! 2 : to flag with XUNDEF value for points wihtout garden
@@ -85,7 +79,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 1D physical dimension
!
-IF (LHOOK) CALL DR_HOOK('FLAG_TEB_GARDEN_N',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('FLAG_TEB_VEG_N',0,ZHOOK_HANDLE)
!
ZWR = XUNDEF
!
@@ -106,38 +100,38 @@ ENDIF
!-------------------------------------------------------------------------------
!
!
- DO JL1=1,TGDO%NGROUND_LAYER
- WHERE (T%CUR%XGARDEN(:)==0.)
- TGD%CUR%XTG (:,JL1) = ZTG
- TGD%CUR%XWG (:,JL1) = ZWG
- TGD%CUR%XWGI(:,JL1) = ZDEF
+ DO JL1=1,IO%NGROUND_LAYER
+ WHERE (PMASK(:)==0.)
+ PEK%XTG (:,JL1) = ZTG
+ PEK%XWG (:,JL1) = ZWG
+ PEK%XWGI(:,JL1) = ZDEF
END WHERE
END DO
!
- WHERE (T%CUR%XGARDEN(:)==0.)
- TGD%CUR%XWR (:) = ZWR
- TGD%CUR%XRESA(:) = ZRESA
+ WHERE (PMASK(:)==0.)
+ PEK%XWR (:) = ZWR
+ PEK%XRESA(:) = ZRESA
END WHERE
!
- IF (TVG%CPHOTO/='NON') THEN
+ IF (IO%CPHOTO/='NON') THEN
!
- WHERE (T%CUR%XGARDEN(:)==0.)
- TGD%CUR%XANFM (:) = ZANFM
- TGD%CUR%XAN (:) = ZDEF
- TGD%CUR%XANDAY(:) = ZDEF
- TGD%CUR%XLE (:) = ZDEF
+ WHERE (PMASK(:)==0.)
+ PEK%XANFM (:) = ZANFM
+ PEK%XAN (:) = ZDEF
+ PEK%XANDAY(:) = ZDEF
+ PEK%XLE (:) = ZDEF
END WHERE
!
- IF (TVG%CPHOTO=='LAI' .OR. TVG%CPHOTO=='LST' .OR. TVG%CPHOTO=='NIT' .OR. TVG%CPHOTO=='NCB') THEN
+ IF (IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') THEN
!
- WHERE (T%CUR%XGARDEN(:)==0.) TGDPE%CUR%XLAI(:) = ZDEF
+ WHERE (PMASK(:)==0.) PEK%XLAI(:) = ZDEF
!
- ELSE IF (TVG%CPHOTO=='AGS' .OR. TVG%CPHOTO=='AST') THEN
+ ELSE IF (IO%CPHOTO=='AST') THEN
!
- DO JL1=1,SIZE(TGD%CUR%XBIOMASS,2)
- WHERE (T%CUR%XGARDEN(:)==0.)
- TGD%CUR%XBIOMASS (:,JL1) = ZDEF
- TGD%CUR%XRESP_BIOMASS(:,JL1) = ZDEF
+ DO JL1=1,SIZE(PEK%XBIOMASS,2)
+ WHERE (PMASK(:)==0.)
+ PEK%XBIOMASS (:,JL1) = ZDEF
+ PEK%XRESP_BIOMASS(:,JL1) = ZDEF
END WHERE
END DO
!
@@ -150,25 +144,29 @@ ENDIF
!
!* Flag snow characteristics
!
- CALL FLAG_GR_SNOW(KFLAG,T%CUR%XGARDEN(:)==0.,TGD%CUR%TSNOW)
+ CALL FLAG_GR_SNOW(KFLAG,PMASK(:)==0.,PEK%TSNOW)
!
!
!* snow-free characteristics
!
IF (KFLAG==1) THEN
- WHERE (T%CUR%XGARDEN==0.) TGD%CUR%XSNOWFREE_ALB = 0.2
- WHERE (T%CUR%XGARDEN==0.) TGD%CUR%XSNOWFREE_ALB_VEG = 0.2
- WHERE (T%CUR%XGARDEN==0.) TGD%CUR%XSNOWFREE_ALB_SOIL = 0.2
+ WHERE (PMASK(:)==0.)
+ PEK%XSNOWFREE_ALB(:) = 0.2
+ PEK%XSNOWFREE_ALB_VEG(:) = 0.2
+ PEK%XSNOWFREE_ALB_SOIL(:) = 0.2
+ END WHERE
ELSEIF (KFLAG==2) THEN
- WHERE (T%CUR%XGARDEN==0.) TGD%CUR%XSNOWFREE_ALB = XUNDEF
- WHERE (T%CUR%XGARDEN==0.) TGD%CUR%XSNOWFREE_ALB_VEG = XUNDEF
- WHERE (T%CUR%XGARDEN==0.) TGD%CUR%XSNOWFREE_ALB_SOIL = XUNDEF
+ WHERE (PMASK==0.)
+ PEK%XSNOWFREE_ALB(:) = XUNDEF
+ PEK%XSNOWFREE_ALB_VEG(:) = XUNDEF
+ PEK%XSNOWFREE_ALB_SOIL(:) = XUNDEF
+ END WHERE
END IF
!
!-------------------------------------------------------------------------------
!
-IF (LHOOK) CALL DR_HOOK('FLAG_TEB_GARDEN_N',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('FLAG_TEB_VEG_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
!
-END SUBROUTINE FLAG_TEB_GARDEN_n
+END SUBROUTINE FLAG_TEB_VEG_n
diff --git a/src/SURFEX/flag_update.F90 b/src/SURFEX/flag_update.F90
index 2b5c8e7a71837dcade3815907a17eb75f3458ee5..2d31d8fc2f7d32fd914ba8b5c92d397f7188e5fd 100644
--- a/src/SURFEX/flag_update.F90
+++ b/src/SURFEX/flag_update.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE FLAG_UPDATE (DGI, DGU, &
+ SUBROUTINE FLAG_UPDATE (DIO, DUO, &
ONOWRITE_CANOPY,OPGD,OPROVAR_TO_DIAG,OSELECT)
! ############################################################
!
@@ -41,8 +41,7 @@
! ------------
!
!
-USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
USE MODD_WRITE_SURF_ATM, ONLY : LNOWRITE_CANOPY
!
@@ -56,8 +55,8 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(DIAG_ISBA_t), INTENT(INOUT) :: DGI
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DIO
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DUO
!
LOGICAL, INTENT(IN) :: ONOWRITE_CANOPY ! flag to (des)activate writing of canopy fields
LOGICAL, INTENT(IN) :: OPGD ! flag to (des)activate writing of pgd field
@@ -71,9 +70,9 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('FLAG_UPDATE',0,ZHOOK_HANDLE)
LNOWRITE_CANOPY = ONOWRITE_CANOPY
-DGI%LPGD = OPGD
-DGU%LPROVAR_TO_DIAG = OPROVAR_TO_DIAG
-DGU%LSELECT = OSELECT
+DIO%LPGD = OPGD
+DUO%LPROVAR_TO_DIAG = OPROVAR_TO_DIAG
+DUO%LSELECT = OSELECT
IF (LHOOK) CALL DR_HOOK('FLAG_UPDATE',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/flake_interface.F90 b/src/SURFEX/flake_interface.F90
index d65b179524b381dbd4a65a93e7f9817981b5274b..a5b88e3489f0d216237856432f6d432db694690e 100644
--- a/src/SURFEX/flake_interface.F90
+++ b/src/SURFEX/flake_interface.F90
@@ -3,24 +3,19 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################################
-SUBROUTINE flake_interface (KI, &
+SUBROUTINE flake_interface (F, KI, &
! Atmospheric forcing
dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, height_tq_in, &
U_a_in, T_a_in, q_a_in, P_a_in, &
! Constant parameters
- depth_w, fetch, depth_bs, T_bs, par_Coriolis, del_time, &
+ del_time, &
! Parameters that may change
- emis_water, albedo, &
- extincoef_water, extincoef_ice, extincoef_snow, &
-! Flake variables
- T_snow, T_ice, T_mnw, T_wML, T_bot, T_B1, C_T, h_snow, h_ice, &
- h_ML, H_B1, T_sfc, &
+ albedo, &
! Surface heat, momentum fluxes, and other diags
- Q_sensible, Q_latent ,Q_momentum, z0, z0t, Qsat, Ri, ustar, Cd_a, &
+ Q_sensible, Q_latent ,Q_momentum, z0t, Qsat, Ri, ustar, Cd_a, &
Q_watvap, Q_latenti, Q_sublim, Q_atm_lw_up, pswe, &
! Switches to configure FLake runs
- lflk_botsed, lflk_skintemp, hflk_flux, PPEW_A_COEF, PPEW_B_COEF, &
- rho_a, HIMPLICIT_WIND )
+ PPEW_A_COEF, PPEW_B_COEF, rho_a, HIMPLICIT_WIND )
!------------------------------------------------------------------------------
!
! Description:
@@ -73,6 +68,8 @@ SUBROUTINE flake_interface (KI, &
!
! Declarations:
!
+USE MODD_FLAKE_n, ONLY : FLAKE_t
+!
! Modules used:
!USE modd_data_parameters , ONLY : &
@@ -155,6 +152,8 @@ IMPLICIT NONE
!
! Input (procedure arguments)
!
+TYPE(FLAKE_t), INTENT(INOUT) :: F
+!
INTEGER, INTENT(IN) :: KI ! number of points
!
INTEGER :: i ! DO loop index
@@ -171,51 +170,21 @@ REAL, DIMENSION(KI), INTENT(IN) :: &
P_a_in ! Surface air pressure [N m^{-2} = kg m^{-1} s^{-2}]
REAL, DIMENSION(KI), INTENT(IN) :: &
- depth_w , &! The lake depth [m]
- fetch , &! Typical wind fetch [m]
- depth_bs , &! Depth of the thermally active layer of the bottom sediments [m]
- T_bs , &! Temperature at the outer edge of
- ! the thermally active layer of the bottom sediments [K]
- par_Coriolis , &! The Coriolis parameter [s^{-1}]
del_time , &! The model time step [s]
PPEW_A_COEF , &! coefficient A (m^2 s kg^{-1}) and B (m s^{-1})
PPEW_B_COEF , &! for wind implicitation : V+ = - A * rho_a u'w' + B
- rho_a , &! Air density (kg m ^{-3}) (from forcing atm. data)
- emis_water ! Water surface emissivity
+ rho_a ! Air density (kg m ^{-3}) (from forcing atm. data)
!
CHARACTER(LEN=*), INTENT(IN) :: HIMPLICIT_WIND ! wind implicitation option
! ! 'OLD' = direct
! ! 'NEW' = Taylor serie, order 1
!
-LOGICAL, INTENT(IN) :: lflk_botsed ! Switch, .TRUE. -> use the bottom-sediment scheme
-LOGICAL, INTENT(IN) :: lflk_skintemp ! Switch, .TRUE. -> use the skin temperature parameterization
- CHARACTER(LEN=5),INTENT(IN) :: hflk_flux ! 'DEF '/'FLAKE' compute the surface fluxes if = 'FLAKE'
-
!
! Input/Output (procedure arguments)
REAL, DIMENSION(KI), INTENT(IN) :: albedo ! surface albedo with respect to the solar radiation
! (free water, ice or snow; e.g. update_rade_flake.f90)
-
-REAL, DIMENSION(KI), INTENT(INOUT) :: &
- extincoef_water , &! extintion coefficient of water
- extincoef_ice , &! extintion coefficient of ice
- extincoef_snow ! extintion coefficient of snow
-
-REAL, DIMENSION(KI), INTENT(INOUT) :: &
- T_snow , &! Temperature at the air-snow interface [K]
- T_ice , &! Temperature at the snow-ice or air-ice interface [K]
- T_mnw , &! Mean temperature of the water column [K]
- T_wML , &! Mixed-layer temperature [K]
- T_bot , &! Temperature at the water-bottom sediment interface [K]
- T_B1 , &! Temperature at the bottom of the upper layer of the sediments [K]
- C_T , &! Shape factor (thermocline)
- h_snow , &! Snow thickness [m]
- h_ice , &! Ice thickness [m]
- h_ML , &! Thickness of the mixed-layer [m]
- H_B1 , &! Thickness of the upper layer of bottom sediments [m]
- T_sfc ! Surface temperature at the previous time step [K]
-
+
! Output (procedure arguments)
REAL, DIMENSION(KI), INTENT(INOUT) :: &
@@ -225,7 +194,6 @@ REAL, DIMENSION(KI), INTENT(INOUT) :: &
Q_latenti , &! Sublimation Latent heat flux [W m^{-2}]
Q_sublim , &! Flux of sublimation [kg m^{-2} s^{-1}]
Q_momentum , &! Momentum flux [N m^{-2}]
- z0 , &! Roughness length with respect to wind velocity [m]
z0t , &! Roughness length with respect to potential temperature [m]
Ri , &! Gradient Richardson number
ustar , &! air friction velocity
@@ -272,7 +240,7 @@ IF (LHOOK) CALL DR_HOOK('FLAKE_INTERFACE',0,ZHOOK_HANDLE)
opticpar_ice = opticpar_ice_opaque ! Opaque ice
opticpar_snow = opticpar_snow_opaque ! Opaque snow
!
-lflk_botsed_use = lflk_botsed
+lflk_botsed_use = F%LSEDIMENTS
!
zwind = WIND_THRESHOLD(U_a_in,height_u_in)
!
@@ -283,18 +251,18 @@ H_POINT_LOOP: DO JL = 1,KI ! begin of loop on horizontal points
opticpar_water(JL) = opticpar_medium(1, &
(/1., (0.,i=2,nband_optic_max)/), &
- (/extincoef_water(JL), (1.E+10,i=2,nband_optic_max)/))
- T_snow_p_flk = T_snow(JL)
- T_ice_p_flk = T_ice(JL)
- T_mnw_p_flk = T_mnw(JL)
- T_wML_p_flk = T_wML(JL)
- T_bot_p_flk = T_bot(JL)
- T_B1_p_flk = T_B1(JL)
- C_T_p_flk = C_T(JL)
- h_snow_p_flk = h_snow(JL)
- h_ice_p_flk = h_ice(JL)
- h_ML_p_flk = h_ML(JL)
- H_B1_p_flk = H_B1(JL)
+ (/F%XEXTCOEF_WATER(JL), (1.E+10,i=2,nband_optic_max)/))
+ T_snow_p_flk = F%XT_SNOW(JL)
+ T_ice_p_flk = F%XT_ICE(JL)
+ T_mnw_p_flk = F%XT_MNW(JL)
+ T_wML_p_flk = F%XT_WML(JL)
+ T_bot_p_flk = F%XT_BOT(JL)
+ T_B1_p_flk = F%XT_B1(JL)
+ C_T_p_flk = F%XCT(JL)
+ h_snow_p_flk = F%XH_SNOW(JL)
+ h_ice_p_flk = F%XH_ICE(JL)
+ h_ML_p_flk = F%XH_ML(JL)
+ H_B1_p_flk = F%XH_B1(JL)
!------------------------------------------------------------------------------
! Set the rate of snow accumulation
@@ -307,7 +275,7 @@ opticpar_water(JL) = opticpar_medium(1, &
!------------------------------------------------------------------------------
I_atm_flk = I_atm_in(JL)
- CALL flake_radflux ( depth_w(JL), albedo(JL), opticpar_water(JL), &
+ CALL flake_radflux ( F%XWATER_DEPTH(JL), albedo(JL), opticpar_water(JL), &
opticpar_ice(JL), opticpar_snow(JL) )
!------------------------------------------------------------------------------
@@ -315,7 +283,7 @@ opticpar_water(JL) = opticpar_medium(1, &
! lwd-lwu = emis*(lwd-sigma*ts**4)
!------------------------------------------------------------------------------
!
- Q_w_flk = emis_water(JL)*Q_atm_lw_in(JL) - sfcflx_lwradwsfc(emis_water(JL),T_sfc(JL))
+ Q_w_flk = F%XEMIS(JL)*Q_atm_lw_in(JL) - sfcflx_lwradwsfc(F%XEMIS(JL),F%XTS(JL))
!
Q_atm_lw_up(JL) = Q_atm_lw_in(JL) - Q_w_flk
!
@@ -323,17 +291,17 @@ opticpar_water(JL) = opticpar_medium(1, &
! Compute the surface friction velocity and fluxes of sensible and latent heat
!------------------------------------------------------------------------------
- IF (hflk_flux=='FLAKE') THEN
+ IF (F%CFLK_FLUX=='FLAKE') THEN
!
Q_momentum(JL) = - rho_a(JL) * ustar(JL)**2
!
- CALL sfcflx_momsenlat ( height_u_in(JL), height_tq_in(JL), fetch(JL), &
- U_a_in(JL), T_a_in(JL), q_a_in(JL), T_sfc(JL), &
+ CALL sfcflx_momsenlat ( height_u_in(JL), height_tq_in(JL), F%XWATER_FETCH(JL), &
+ U_a_in(JL), T_a_in(JL), q_a_in(JL), F%XTS(JL), &
P_a_in(JL), h_ice_p_flk, Q_momentum(JL), &
Q_sensible(JL), Q_latent(JL), Q_watvap(JL), &
- Ri(JL), z0(JL), z0t(JL), Qsat(JL), &
+ Ri(JL), F%XZ0(JL), z0t(JL), Qsat(JL), &
Q_latenti(JL), Q_sublim(JL) )
- z0(JL)= z0u_sf
+ F%XZ0(JL)= z0u_sf
z0t(JL)=z0t_sf
! recomputes the future wind speed and associated momentum flux
! in the case wind speed is implicited (V. Masson, Meteo-France)
@@ -398,42 +366,42 @@ opticpar_water(JL) = opticpar_medium(1, &
DO JDT=1,INDT
!
- T_snow_p_flk = T_snow(JL)
- T_ice_p_flk = T_ice(JL)
- T_mnw_p_flk = T_mnw(JL)
- T_wML_p_flk = T_wML(JL)
- T_bot_p_flk = T_bot(JL)
- T_B1_p_flk = T_B1(JL)
- C_T_p_flk = C_T(JL)
- h_snow_p_flk = h_snow(JL)
- h_ice_p_flk = h_ice(JL)
- h_ML_p_flk = h_ML(JL)
- H_B1_p_flk = H_B1(JL)
-!
- CALL flake_driver ( depth_w(JL), depth_bs(JL), T_bs(JL), par_Coriolis(JL), &
+ T_snow_p_flk = F%XT_SNOW(JL)
+ T_ice_p_flk = F%XT_ICE(JL)
+ T_mnw_p_flk = F%XT_MNW(JL)
+ T_wML_p_flk = F%XT_WML(JL)
+ T_bot_p_flk = F%XT_BOT(JL)
+ T_B1_p_flk = F%XT_B1(JL)
+ C_T_p_flk = F%XCT(JL)
+ h_snow_p_flk = F%XH_SNOW(JL)
+ h_ice_p_flk = F%XH_ICE(JL)
+ h_ML_p_flk = F%XH_ML(JL)
+ H_B1_p_flk = F%XH_B1(JL)
+!
+ CALL flake_driver ( F%XWATER_DEPTH(JL), F%XDEPTH_BS(JL), F%XT_BS(JL), F%XCORIO(JL), &
opticpar_water(JL)%extincoef_optic(1), &
- ZTSTEP, T_sfc(JL), T_sfc_n )
+ ZTSTEP, F%XTS(JL), T_sfc_n )
!
!------------------------------------------------------------------------------
! Set output values
!------------------------------------------------------------------------------
!
- T_snow(JL) = T_snow_n_flk
- T_ice(JL) = T_ice_n_flk
- T_mnw(JL) = T_mnw_n_flk
- T_wML(JL) = T_wML_n_flk
- T_bot(JL) = T_bot_n_flk
- T_B1(JL) = T_B1_n_flk
- C_T(JL) = C_T_n_flk
- h_snow(JL) = h_snow_n_flk
- h_ice(JL) = h_ice_n_flk
- h_ML(JL) = h_ML_n_flk
- H_B1(JL) = H_B1_n_flk
- T_sfc(JL) = T_sfc_n
+ F%XT_SNOW(JL) = T_snow_n_flk
+ F%XT_ICE(JL) = T_ice_n_flk
+ F%XT_MNW(JL) = T_mnw_n_flk
+ F%XT_WML(JL) = T_wML_n_flk
+ F%XT_BOT(JL) = T_bot_n_flk
+ F%XT_B1(JL) = T_B1_n_flk
+ F%XCT(JL) = C_T_n_flk
+ F%XH_SNOW(JL) = h_snow_n_flk
+ F%XH_ICE(JL) = h_ice_n_flk
+ F%XH_ML(JL) = h_ML_n_flk
+ F%XH_B1(JL) = H_B1_n_flk
+ F%XTS(JL) = T_sfc_n
!
ENDDO
!
- pswe(JL) = h_snow(JL)*flake_snowdensity(h_snow(JL))
+ pswe(JL) = F%XH_SNOW(JL)*flake_snowdensity(F%XH_SNOW(JL))
!
!------------------------------------------------------------------------------
! Compute skin temperature in case of no ice nor snow
@@ -442,7 +410,7 @@ opticpar_water(JL) = opticpar_medium(1, &
! Q_w_flk=LWD-LWU-(QH+QE) accounts for water phase (water, ice, snow)
! (1-albedo)*I_atm_flk=SWD-SWU accounts for water phase (water, ice, snow)
!
- IF (lflk_skintemp.AND.(h_ice(JL)<h_Ice_min_flk).AND.(hflk_flux=='FLAKE')) THEN
+ IF (F%LSKINTEMP.AND.(F%XH_ICE(JL)<h_Ice_min_flk).AND.(F%CFLK_FLUX=='FLAKE')) THEN
zaux = (1.0-exp(-opticpar_water(JL)%extincoef_optic(1) * h_skinlayer_flk)) &
/ opticpar_water(JL)%extincoef_optic(1)
@@ -451,7 +419,7 @@ opticpar_water(JL) = opticpar_medium(1, &
zloc = ((1.0-albedo(JL))*I_atm_flk+Q_w_flk)*h_skinlayer_flk-(1.0-albedo(JL))*I_atm_flk*zaux
- T_sfc(JL) = T_sfc_n + zloc / zcond
+ F%XTS(JL) = T_sfc_n + zloc / zcond
ENDIF
!
diff --git a/src/SURFEX/floor_layer_e_budget.F90 b/src/SURFEX/floor_layer_e_budget.F90
index 4c3f1d94d5a0480a3679976ad599a1f316787512..544636514d2c5bb03a0f3723c79a103ad36865bd 100644
--- a/src/SURFEX/floor_layer_e_budget.F90
+++ b/src/SURFEX/floor_layer_e_budget.F90
@@ -3,13 +3,9 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ##########################################################################
- SUBROUTINE FLOOR_LAYER_E_BUDGET(PT_FLOOR, PTSTEP, PHC_FLOOR, PTC_FLOOR, PD_FLOOR, &
- PFLX_BLD_FLOOR, PDQS_FLOOR, PIMB_FLOOR, &
- PF_FLOOR_MASS, PF_FLOOR_WALL, PF_FLOOR_WIN, &
- PF_FLOOR_ROOF, PRADHT_IN, &
- PTS_MASS, PRAD_WALL_FLOOR, PRAD_ROOF_FLOOR, &
- PRAD_WIN_FLOOR, PLOAD_FLOOR, PTI_BLD, &
- PRAD_FLOOR_MASS, PCONV_FLOOR_BLD )
+ SUBROUTINE FLOOR_LAYER_E_BUDGET(B, PTSTEP, PFLX_BLD_FL, PDQS_FL, PIMB_FL, PRADHT_IN, &
+ PRAD_WL_FL, PRAD_RF_FL, PRAD_WIN_FL, PLOAD_FL, &
+ PRAD_FL_MA, PCONV_FL_BLD )
! ##########################################################################
!
!!**** *FLOOR_LAYER_E_BUDGET*
@@ -78,6 +74,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_BEM_n, ONLY : BEM_t
+!
USE MODI_LAYER_E_BUDGET_GET_COEF
USE MODI_LAYER_E_BUDGET
USE MODE_CONV_DOE
@@ -89,29 +87,20 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PT_FLOOR ! floor layers temperatures
+TYPE(BEM_t), INTENT(INOUT) :: B
+!
REAL, INTENT(IN) :: PTSTEP ! time step
-REAL, DIMENSION(:,:), INTENT(IN) :: PHC_FLOOR ! heat capacity for road layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PTC_FLOOR ! thermal conductivity for
- !road layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_FLOOR ! depth of road layers
-REAL, DIMENSION(:), INTENT(OUT) :: PFLX_BLD_FLOOR !flux from building to floor
-REAL, DIMENSION(:), INTENT(OUT) :: PDQS_FLOOR !heat storage inside the floor
-REAL, DIMENSION(:), INTENT(OUT) :: PIMB_FLOOR !floor energy residual imbalance for verification
-REAL, DIMENSION(:), INTENT(IN) :: PF_FLOOR_MASS ! View factor floor-mass
-REAL, DIMENSION(:), INTENT(IN) :: PF_FLOOR_WALL ! View factor floor-wall
-REAL, DIMENSION(:), INTENT(IN) :: PF_FLOOR_WIN ! View factor floor-window
-REAL, DIMENSION(:), INTENT(IN) :: PF_FLOOR_ROOF ! View factor floor-roof
+REAL, DIMENSION(:), INTENT(OUT) :: PFLX_BLD_FL !flux from building to floor
+REAL, DIMENSION(:), INTENT(OUT) :: PDQS_FL !heat storage inside the floor
+REAL, DIMENSION(:), INTENT(OUT) :: PIMB_FL !floor energy residual imbalance for verification
REAL, DIMENSION(:), INTENT(IN) :: PRADHT_IN ! Indoor radiant heat transfer coefficient
! [W K-1 m-2]
-REAL, DIMENSION(:), INTENT(IN) :: PTS_MASS ! surf. mass temp. (contact with bld air)
-REAL, DIMENSION(:), INTENT(IN) :: PRAD_ROOF_FLOOR ! rad. fluxes from roof to floor[W m-2(roof)]
-REAL, DIMENSION(:), INTENT(IN) :: PRAD_WALL_FLOOR ! rad. fluxes from wall to floor[W m-2(wall)]
-REAL, DIMENSION(:), INTENT(IN) :: PRAD_WIN_FLOOR ! rad. fluxes from win to floor[W m-2(win)]
-REAL, DIMENSION(:), INTENT(IN) :: PTI_BLD ! indoor air temp.
-REAL, DIMENSION(:), INTENT(IN) :: PLOAD_FLOOR ! solar and internal load to the floor
-REAL, DIMENSION(:), INTENT(OUT) :: PRAD_FLOOR_MASS ! rad. fluxes from floor to mass [W m-2(floor)]
-REAL, DIMENSION(:), INTENT(OUT) :: PCONV_FLOOR_BLD ! conv. fluxes from floor to bld [W m-2(floor)]
+REAL, DIMENSION(:), INTENT(IN) :: PRAD_RF_FL ! rad. fluxes from roof to floor[W m-2(roof)]
+REAL, DIMENSION(:), INTENT(IN) :: PRAD_WL_FL ! rad. fluxes from wall to floor[W m-2(wall)]
+REAL, DIMENSION(:), INTENT(IN) :: PRAD_WIN_FL ! rad. fluxes from win to floor[W m-2(win)]
+REAL, DIMENSION(:), INTENT(IN) :: PLOAD_FL ! solar and internal load to the floor
+REAL, DIMENSION(:), INTENT(OUT) :: PRAD_FL_MA ! rad. fluxes from floor to mass [W m-2(floor)]
+REAL, DIMENSION(:), INTENT(OUT) :: PCONV_FL_BLD ! conv. fluxes from floor to bld [W m-2(floor)]
!
!* 0.2 declarations of local variables
!
@@ -119,15 +108,15 @@ REAL, DIMENSION(:), INTENT(OUT) :: PCONV_FLOOR_BLD ! conv. fluxes from floor
REAL :: ZIMPL=1.0 ! implicit coefficient
REAL :: ZEXPL=0.0 ! explicit coefficient
!
-REAL, DIMENSION(SIZE(PT_FLOOR,1),SIZE(PT_FLOOR,2)) :: ZA,& ! lower diag.
+REAL, DIMENSION(SIZE(B%XT_FLOOR,1),SIZE(B%XT_FLOOR,2)) :: ZA,& ! lower diag.
ZB,& ! main diag.
ZC,& ! upper diag.
ZY ! r.h.s.
!
-REAL, DIMENSION(SIZE(PT_FLOOR,1)) :: ZTS_FLOOR ! surf. floor temp. used for rad. exchanges
-REAL, DIMENSION(SIZE(PT_FLOOR,1)) :: ZTS_FLOOR_CONV ! surf. floor temp. used for conv exchanges
+REAL, DIMENSION(SIZE(B%XT_FLOOR,1)) :: ZTS_FL ! surf. floor temp. used for rad. exchanges
+REAL, DIMENSION(SIZE(B%XT_FLOOR,1)) :: ZTS_FL_CONV ! surf. floor temp. used for conv exchanges
! used during calculation
-REAL, DIMENSION(SIZE(PT_FLOOR,1)) :: ZCHTC_IN_FLOOR ! Indoor floor convec heat transfer coefficient
+REAL, DIMENSION(SIZE(B%XT_FLOOR,1)) :: ZCHTC_IN_FL ! Indoor floor convec heat transfer coefficient
! [W K-1 m-2(bld)]
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -137,55 +126,51 @@ IF (LHOOK) CALL DR_HOOK('FLOOR_LAYER_E_BUDGET',0,ZHOOK_HANDLE)
!
! *Convection heat transfer coefficients [W m-2 K-1]
! From EP Engineering Reference
-ZCHTC_IN_FLOOR(:) = CHTC_UP_DOE(PT_FLOOR(:,1), PTI_BLD(:))
-DO JJ=1,SIZE(ZCHTC_IN_FLOOR)
- ZCHTC_IN_FLOOR(JJ) = MAX(1., ZCHTC_IN_FLOOR(JJ))
+ZCHTC_IN_FL(:) = CHTC_UP_DOE(B%XT_FLOOR(:,1), B%XTI_BLD(:))
+DO JJ=1,SIZE(ZCHTC_IN_FL)
+ ZCHTC_IN_FL(JJ) = MAX(1., ZCHTC_IN_FL(JJ))
ENDDO
!
- CALL LAYER_E_BUDGET_GET_COEF( PT_FLOOR, PTSTEP, ZIMPL, PHC_FLOOR, PTC_FLOOR, PD_FLOOR, &
+ CALL LAYER_E_BUDGET_GET_COEF( B%XT_FLOOR, PTSTEP, ZIMPL, B%XHC_FLOOR, B%XTC_FLOOR, B%XD_FLOOR, &
ZA, ZB, ZC, ZY )
!
-ZTS_FLOOR(:) = PT_FLOOR(:,1)
+ZTS_FL(:) = B%XT_FLOOR(:,1)
-ZB(:,1) = ZB(:,1) + ZIMPL * &
- (ZCHTC_IN_FLOOR(:)*4./3. + PRADHT_IN(:) * PF_FLOOR_MASS(:))
+ZB(:,1) = ZB(:,1) + ZIMPL * (ZCHTC_IN_FL(:)*4./3. + PRADHT_IN(:) * B%XF_FLOOR_MASS(:))
ZY(:,1) = ZY(:,1) &
- + ZCHTC_IN_FLOOR(:) * (PTI_BLD(:) - 1./3. * PT_FLOOR(:, 1) * (4* ZEXPL -1)) &
- + PF_FLOOR_WIN (:) * PRAD_WIN_FLOOR(:) &
- + PF_FLOOR_WALL (:) * PRAD_WALL_FLOOR(:) &
- + PF_FLOOR_ROOF (:) * PRAD_ROOF_FLOOR(:) &
- + PRADHT_IN(:) * PF_FLOOR_MASS (:) * (PTS_MASS(:) - ZEXPL * PT_FLOOR(:,1)) &
- + PLOAD_FLOOR(:)
+ + ZCHTC_IN_FL(:) * (B%XTI_BLD(:) - 1./3. * B%XT_FLOOR(:, 1) * (4* ZEXPL -1)) &
+ + B%XF_FLOOR_WIN (:) * PRAD_WIN_FL(:) + B%XF_FLOOR_WALL (:) * PRAD_WL_FL(:) &
+ + B%XF_FLOOR_ROOF (:) * PRAD_RF_FL(:) &
+ + PRADHT_IN(:) * B%XF_FLOOR_MASS (:) * (B%XT_MASS(:,1) - ZEXPL * B%XT_FLOOR(:,1)) &
+ + PLOAD_FL(:)
!
- CALL LAYER_E_BUDGET( PT_FLOOR, PTSTEP, ZIMPL, PHC_FLOOR, PTC_FLOOR, PD_FLOOR, &
- ZA, ZB, ZC, ZY, PDQS_FLOOR )
+ CALL LAYER_E_BUDGET( B%XT_FLOOR, PTSTEP, ZIMPL, B%XHC_FLOOR, B%XTC_FLOOR, B%XD_FLOOR, &
+ ZA, ZB, ZC, ZY, PDQS_FL )
!
!* floor surface temperature used in the implicit formulation
! ----------------------------------------------------------
-ZTS_FLOOR_CONV(:) = 4./3. * ZIMPL * PT_FLOOR(:,1) + 1./3. * ZTS_FLOOR(:) * (4 * ZEXPL - 1.)
-ZTS_FLOOR(:) = ZEXPL * ZTS_FLOOR(:) + ZIMPL * PT_FLOOR(:,1)
+ZTS_FL_CONV(:) = 4./3. * ZIMPL * B%XT_FLOOR(:,1) + 1./3. * ZTS_FL(:) * (4 * ZEXPL - 1.)
+ZTS_FL(:) = ZEXPL * ZTS_FL(:) + ZIMPL * B%XT_FLOOR(:,1)
!
!* fluxes with mass and indoor air
! ----------------------------------------------------------
-PRAD_FLOOR_MASS(:) = PRADHT_IN(:) * (ZTS_FLOOR(:) - PTS_MASS(:))
-PCONV_FLOOR_BLD(:) = ZCHTC_IN_FLOOR(:) * (ZTS_FLOOR_CONV(:) - PTI_BLD (:))
+PRAD_FL_MA(:) = PRADHT_IN(:) * (ZTS_FL(:) - B%XT_MASS(:,1))
+PCONV_FL_BLD(:) = ZCHTC_IN_FL(:) * (ZTS_FL_CONV(:) - B%XTI_BLD (:))
!
!* Flux between floor and indoor surfaces and air
! ------------------------------------------------
-PFLX_BLD_FLOOR(:) = - PCONV_FLOOR_BLD(:) &
- + PF_FLOOR_WIN (:) * PRAD_WIN_FLOOR(:) &
- + PF_FLOOR_WALL (:) * PRAD_WALL_FLOOR(:) &
- + PF_FLOOR_ROOF (:) * PRAD_ROOF_FLOOR(:) &
- + PRADHT_IN(:) * PF_FLOOR_MASS(:) * (PTS_MASS (:) - ZTS_FLOOR(:)) &
- + PLOAD_FLOOR(:)
+PFLX_BLD_FL(:) = - PCONV_FL_BLD(:) + B%XF_FLOOR_WIN (:) * PRAD_WIN_FL(:) &
+ + B%XF_FLOOR_WALL (:) * PRAD_WL_FL(:) + B%XF_FLOOR_ROOF (:) * PRAD_RF_FL(:) &
+ + PRADHT_IN(:) * B%XF_FLOOR_MASS(:) * (B%XT_MASS(:,1) - ZTS_FL(:)) &
+ + PLOAD_FL(:)
!
!* Floor residual energy imbalance for verification
! ------------------------------------------------
-PIMB_FLOOR(:) = PFLX_BLD_FLOOR(:) - PDQS_FLOOR(:)
+PIMB_FL(:) = PFLX_BLD_FL(:) - PDQS_FL(:)
!
IF (LHOOK) CALL DR_HOOK('FLOOR_LAYER_E_BUDGET',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/garden.F90 b/src/SURFEX/garden.F90
index 80aec658d8a3660227dcd6fd94b7a52ff0fd28a7..2f2408c0b51e72a72a441226933d786aa0137b0e 100644
--- a/src/SURFEX/garden.F90
+++ b/src/SURFEX/garden.F90
@@ -3,17 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GARDEN (DTCO, DTI, IG, I, TG, T, TOP, DTGR, TGRO, GDM, &
- HIMPLICIT_WIND, TPTIME, PTSUN, PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- PTSTEP, PZ_LOWCAN, &
- PT_LOWCAN, PQ_LOWCAN, PEXNS, PRHOA, PCO2, PPS, PRR, PSR, PZENITH, &
- PSW, PLW, PU_LOWCAN, &
- PALBNIR_TVEG, PALBVIS_TVEG, PALBNIR_TSOIL, PALBVIS_TSOIL, &
- PRN_GARDEN,PH_GARDEN,PLE_GARDEN,PGFLUX_GARDEN,PSFCO2, &
- PEVAP_GARDEN, PUW_GARDEN,PRUNOFF_GARDEN, &
- PAC_GARDEN,PQSAT_GARDEN,PTS_GARDEN, &
- PAC_AGG_GARDEN, PHU_AGG_GARDEN, PDRAIN_GARDEN, PIRRIG_GARDEN )
+ SUBROUTINE GARDEN (DTCO, G, T, TOP, TIR, DTV, GB, DK, DEK, DMK, GDO, S, K, P, PEK, &
+ HIMPLICIT_WIND, TPTIME, PTSUN, PPEW_A_COEF, PPEW_B_COEF, &
+ PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
+ PTSTEP, PZREF, PTA, PQA, PEXNS, PRHOA, PCO2, PPS, PRR, &
+ PSR, PZENITH, PSW, PLW, PVMOD, PALBNIR_TVEG, &
+ PALBVIS_TVEG, PALBNIR_TSOIL, PALBVIS_TSOIL, &
+ PRN, PH, PLE, PGFLUX, PSFCO2, PEVAP, PUW, PRUNOFF, &
+ PAC, PQSAT, PTSRAD, PAC_AGG, PHU_AGG, PIRRIG )
! ##########################################################################
!
!!**** *GARDEN*
@@ -57,14 +54,24 @@
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_SSO_n, ONLY : SSO_t, SSO_INIT
USE MODD_TEB_n, ONLY : TEB_t
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-USE MODD_DATA_TEB_GREENROOF_n, ONLY : DATA_TEB_GREENROOF_t
-USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
-USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t
+!
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t
+!
+USE MODD_DIAG_n, ONLY : DIAG_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
+!
+USE MODD_TEB_IRRIG_n, ONLY : TEB_IRRIG_t
+!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_P_t, ISBA_PE_t
+!
+USE MODD_AGRI_n, ONLY : AGRI_t,AGRI_INIT
!
USE MODD_TYPE_DATE_SURF, ONLY: DATE_TIME
USE MODD_SURF_PAR, ONLY: XUNDEF
@@ -72,10 +79,10 @@ USE MODD_CSTS, ONLY: XCPD
!
!
USE MODI_ISBA
-USE MODI_VEGETATION_UPDATE_GARDEN
+USE MODI_VEGETATION_UPDATE
USE MODE_THERMOS
!
-USE MODI_FLAG_TEB_GARDEN_n
+USE MODI_FLAG_TEB_VEG_n
USE MODI_CARBON_EVOL
USE MODI_VEGETATION_EVOL
USE MODI_TEB_IRRIG
@@ -90,15 +97,24 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
+TYPE(GRID_t), INTENT(INOUT) :: G
TYPE(TEB_t), INTENT(INOUT) :: T
TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
-TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: TGRO
-TYPE(DATA_TEB_GREENROOF_t), INTENT(INOUT) :: DTGR
-TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
+!
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+TYPE(GR_BIOG_t), INTENT(INOUT) :: GB
+!
+TYPE(DIAG_t), INTENT(INOUT) :: DK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK
+!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: GDO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_P_t), INTENT(INOUT) :: P
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
+TYPE(TEB_IRRIG_t), INTENT(INOUT) :: TIR
!
CHARACTER(LEN=*), INTENT(IN) :: HIMPLICIT_WIND ! wind implicitation option
! ! 'OLD' = direct
@@ -112,9 +128,9 @@ REAL, DIMENSION(:) , INTENT(IN) :: PPEQ_B_COEF ! for humidity
REAL, DIMENSION(:) , INTENT(IN) :: PPET_A_COEF ! implicit coefficients
REAL, DIMENSION(:) , INTENT(IN) :: PPET_B_COEF ! for temperature
REAL , INTENT(IN) :: PTSTEP ! time step
-REAL, DIMENSION(:) , INTENT(IN) :: PZ_LOWCAN ! height of atm. var. near the road
-REAL, DIMENSION(:) , INTENT(IN) :: PT_LOWCAN ! temp. near the road
-REAL, DIMENSION(:) , INTENT(IN) :: PQ_LOWCAN ! hum. near the road
+REAL, DIMENSION(:) , INTENT(IN) :: PZREF ! height of atm. var. near the road
+REAL, DIMENSION(:) , INTENT(IN) :: PTA ! temp. near the road
+REAL, DIMENSION(:) , INTENT(IN) :: PQA ! hum. near the road
REAL, DIMENSION(:) , INTENT(IN) :: PPS ! pressure at the surface
REAL, DIMENSION(:) , INTENT(IN) :: PEXNS ! surface exner function
REAL, DIMENSION(:) , INTENT(IN) :: PRHOA ! air density at the lowest level
@@ -124,53 +140,36 @@ REAL, DIMENSION(:) , INTENT(IN) :: PSR ! snow rate
REAL, DIMENSION(:) , INTENT(IN) :: PZENITH ! solar zenithal angle
REAL, DIMENSION(:) , INTENT(IN) :: PSW ! incoming total solar rad on an horizontal surface
REAL, DIMENSION(:) , INTENT(IN) :: PLW ! atmospheric infrared radiation
-REAL, DIMENSION(:) , INTENT(IN) :: PU_LOWCAN ! wind near the road
+REAL, DIMENSION(:) , INTENT(IN) :: PVMOD ! wind near the road
REAL, DIMENSION(:) , INTENT(IN) :: PALBNIR_TVEG ! nearIR veg tot albedo
REAL, DIMENSION(:) , INTENT(IN) :: PALBVIS_TVEG ! visible veg tot albedo
REAL, DIMENSION(:) , INTENT(IN) :: PALBNIR_TSOIL ! nearIR soil tot albedo
REAL, DIMENSION(:) , INTENT(IN) :: PALBVIS_TSOIL ! visible soil tot albedo
!
-!
-REAL, DIMENSION(:) , INTENT(OUT) :: PRN_GARDEN ! net radiation over green areas
-REAL, DIMENSION(:) , INTENT(OUT) :: PH_GARDEN ! sensible heat flux over green areas
-REAL, DIMENSION(:) , INTENT(OUT) :: PLE_GARDEN ! latent heat flux over green areas
-REAL, DIMENSION(:) , INTENT(OUT) :: PGFLUX_GARDEN ! flux through the green areas
-REAL, DIMENSION(:) , INTENT(OUT) :: PSFCO2 ! flux of CO2 positive toward the atmosphere (m/s*kg_CO2/kg_air)
-REAL, DIMENSION(:) , INTENT(OUT) :: PEVAP_GARDEN ! total evaporation over gardens (kg/m2/s)
-REAL, DIMENSION(:) , INTENT(OUT) :: PUW_GARDEN ! friction flux (m2/s2)
-REAL, DIMENSION(:) , INTENT(OUT) :: PRUNOFF_GARDEN ! runoff over garden (kg/m2/s)
-REAL, DIMENSION(:) , INTENT(OUT) :: PAC_GARDEN ! aerodynamical conductance
-REAL, DIMENSION(:) , INTENT(OUT) :: PQSAT_GARDEN ! saturation humidity
-REAL, DIMENSION(:) , INTENT(INOUT) :: PTS_GARDEN ! radiative surface temp. (snow free)
-REAL, DIMENSION(:) , INTENT(OUT) :: PAC_AGG_GARDEN ! aggreg. aeodynamic resistance for green areas for latent heat flux
-REAL, DIMENSION(:) , INTENT(OUT) :: PHU_AGG_GARDEN ! aggreg. relative humidity for green areas for latent heat flux
-REAL, DIMENSION(:) , INTENT(OUT) :: PDRAIN_GARDEN ! garden total (vertical) drainage
-REAL, DIMENSION(:) , INTENT(OUT) :: PIRRIG_GARDEN ! garden summer irrigation rate
+REAL, DIMENSION(:) , INTENT(OUT) :: PRN ! net radiation over green areas
+REAL, DIMENSION(:) , INTENT(OUT) :: PH ! sensible heat flux over green areas
+REAL, DIMENSION(:) , INTENT(OUT) :: PLE ! latent heat flux over green areas
+REAL, DIMENSION(:) , INTENT(OUT) :: PGFLUX ! flux through the green areas
+REAL, DIMENSION(:) , INTENT(OUT) :: PSFCO2 ! flux of CO2 positive toward the atmosphere (m/s*kg_CO2/kg_air)
+REAL, DIMENSION(:) , INTENT(OUT) :: PEVAP ! total evaporation over gardens (kg/m2/s)
+REAL, DIMENSION(:) , INTENT(OUT) :: PUW ! friction flux (m2/s2)
+REAL, DIMENSION(:) , INTENT(OUT) :: PRUNOFF ! runoff over garden (kg/m2/s)
+REAL, DIMENSION(:) , INTENT(OUT) :: PAC ! aerodynamical conductance
+REAL, DIMENSION(:) , INTENT(OUT) :: PQSAT ! saturation humidity
+REAL, DIMENSION(:) , INTENT(OUT) :: PTSRAD ! garden radiative surface temp. (snow free)
+REAL, DIMENSION(:) , INTENT(OUT) :: PAC_AGG ! aggreg. aeodynamic resistance for green areas for latent heat flux
+REAL, DIMENSION(:) , INTENT(OUT) :: PHU_AGG ! aggreg. relative humidity for green areas for latent heat flux
+REAL, DIMENSION(:) , INTENT(OUT) :: PIRRIG ! garden summer irrigation rate
!
!
!* 0.2 Declarations of local variables
!
- CHARACTER(LEN=3) :: HRAIN ! Rainfall spatial distribution
- ! 'DEF' = No rainfall spatial distribution
- ! 'SGH' = Rainfall exponential spatial distribution
-LOGICAL :: OFLOOD ! Activation of the flooding scheme
-LOGICAL :: OTEMP_ARP ! True = time-varying force-restore soil temperature (as in ARPEGE)
- ! False = No time-varying force-restore soil temperature (Default)
-LOGICAL :: OGLACIER ! True = Over permanent snow and ice,
-! initialise WGI=WSAT,
-! Hsnow>=10m and allow 0.8<SNOALB<0.85
- ! False = No specific treatment
-REAL, DIMENSION(0) :: ZSODELX ! Pulsation for each layer (Only used if LTEMP_ARP=True)
-!
-REAL, DIMENSION(SIZE(PPS)) :: ZMUF ! fraction of the grid cell reached by the rainfall
-REAL, DIMENSION(SIZE(PPS)) :: ZFSAT ! Topmodel (SGH not used in TEB) saturated fraction
-REAL, DIMENSION(SIZE(PPS),GDM%TGDO%NGROUND_LAYER) :: ZTOPQS ! Topmodel (SGH not used in TEB) lateral subsurface flow by layer
-REAL, DIMENSION(SIZE(PPS)) :: ZQSB ! Topmodel (SGH not used in TEB) output lateral subsurface
-REAL, DIMENSION(SIZE(PPS)) :: ZFWTD ! grid-cell fraction of water table to rise
-REAL, DIMENSION(SIZE(PPS)) :: ZWTD ! water table depth from Obs, TRIP or MODCOU
+TYPE(SSO_t) :: YSS
+TYPE(AGRI_t) :: YAG
!
REAL, DIMENSION(SIZE(PPS)) :: ZDIRCOSZW ! orography slope cosine (=1 in TEB)
-REAL, DIMENSION(SIZE(PPS),GDM%TVG%NNBIOMASS) :: ZRESP_BIOMASS_INST ! instantaneous biomass respiration (kgCO2/kgair m/s)
+REAL, DIMENSION(SIZE(PPS),GDO%NNBIOMASS) :: ZRESP_BIOMASS_INST ! instantaneous biomass respiration (kgCO2/kgair m/s)
+REAL, DIMENSION(SIZE(PPS)) :: ZUSTAR
!
! temperatures
!
@@ -178,174 +177,20 @@ REAL, DIMENSION(SIZE(PPS)) :: ZTA ! estimate of air temperature at future time
! ! step as if modified by ISBA flux alone.
REAL, DIMENSION(SIZE(PPS)) :: ZDEEP_FLUX ! heat flux at base of the deep soil
!
-! desactivated diag
-!
-REAL, DIMENSION(SIZE(PPS)) :: ZRN_ISBA ! net radiative flux from snow-free surface
-REAL, DIMENSION(SIZE(PPS)) :: ZH_ISBA ! sensible heat flux from snow-free surface
-REAL, DIMENSION(SIZE(PPS)) :: ZLEI_ISBA ! baresoil evaporation from snow-free surface
-REAL, DIMENSION(SIZE(PPS)) :: ZLEG_ISBA ! baresoil evaporation from snow-free surface
-REAL, DIMENSION(SIZE(PPS)) :: ZLEGI_ISBA ! baresoil sublimation from snow-free surface
-REAL, DIMENSION(SIZE(PPS)) :: ZLEV_ISBA ! total evapotranspiration from vegetation over
-REAL, DIMENSION(SIZE(PPS)) :: ZLETR_ISBA ! transpiration from snow-free surface
-REAL, DIMENSION(SIZE(PPS)) :: ZUSTAR_ISBA ! friction velocity from snow-free
-REAL, DIMENSION(SIZE(PPS)) :: ZLER_ISBA ! evaporation from canopy water interception
-REAL, DIMENSION(SIZE(PPS)) :: ZLE_ISBA ! latent heat flux from snow-free surface
-REAL, DIMENSION(SIZE(PPS)) :: ZGFLUX_ISBA ! net energy flux into the snow-free surface
-REAL, DIMENSION(SIZE(PPS)) :: ZRNSNOW ! net radiative flux from snow (ISBA-ES:3-L) (W/m2)
-REAL, DIMENSION(SIZE(PPS)) :: ZHSNOW ! sensible heat flux from snow (ISBA-ES:3-L) (W/m2)
-REAL, DIMENSION(SIZE(PPS)) :: ZHPSNOW ! heat release from rainfall (ISBA-ES:3-L) (W/m2)
-REAL, DIMENSION(SIZE(PPS)) :: ZGFLUXSNOW ! net surface energy flux into snowpack (ISBA-ES:3-L)(W/m2)
-REAL, DIMENSION(SIZE(PPS)) :: ZUSTARSNOW ! friction velocity over snow (ISBA-ES:3-L) (m/s)
-REAL, DIMENSION(SIZE(PPS)) :: ZGRNDFLUX ! soil/snow interface heat flux (ISBA-ES:3-L) (W/m2)
-REAL, DIMENSION(SIZE(PPS)) :: ZSRSFC ! snowfall over snowpack (ISBA-ES:3-L) (kg/m2/s)
-REAL, DIMENSION(SIZE(PPS)) :: ZRRSFC ! rainfall over snowpack (ISBA-ES:3-L) (kg/m2/s)
-REAL, DIMENSION(SIZE(PPS)) :: ZLESL ! snowpack evaporation (ISBA-ES:3-L) (W/m2)
-REAL, DIMENSION(SIZE(PPS)) :: ZCDSNOW ! snow drag coefficient (ISBA-ES:3-L) (-)
-REAL, DIMENSION(SIZE(PPS)) :: ZCHSNOW ! heat turbulent transfer coefficient (-)
-!
-REAL, DIMENSION(SIZE(PPS)) :: ZCG
-REAL, DIMENSION(SIZE(PPS)) :: ZC1
-REAL, DIMENSION(SIZE(PPS)) :: ZC2
-REAL, DIMENSION(SIZE(PPS)) :: ZWGEQ
-REAL, DIMENSION(SIZE(PPS)) :: ZCT
-REAL, DIMENSION(SIZE(PPS)) :: ZRS
-REAL, DIMENSION(SIZE(PPS)) :: ZCH
-REAL, DIMENSION(SIZE(PPS)) :: ZCD
-REAL, DIMENSION(SIZE(PPS)) :: ZCDN
-REAL, DIMENSION(SIZE(PPS)) :: ZRI
-REAL, DIMENSION(SIZE(PPS)) :: ZHU
-REAL, DIMENSION(SIZE(PPS)) :: ZHUG
-REAL, DIMENSION(SIZE(PPS)) :: ZRN
-REAL, DIMENSION(SIZE(PPS)) :: ZH
-REAL, DIMENSION(SIZE(PPS)) :: ZLEI
-REAL, DIMENSION(SIZE(PPS)) :: ZLEG
-REAL, DIMENSION(SIZE(PPS)) :: ZLEGI
-REAL, DIMENSION(SIZE(PPS)) :: ZLEV
-REAL, DIMENSION(SIZE(PPS)) :: ZLES
-REAL, DIMENSION(SIZE(PPS)) :: ZLER
-REAL, DIMENSION(SIZE(PPS)) :: ZLETR
-REAL, DIMENSION(SIZE(PPS)) :: ZEVAP
-REAL, DIMENSION(SIZE(PPS)) :: ZSUBL !Sublimation
-REAL, DIMENSION(SIZE(PPS)) :: ZGFLUX
-REAL, DIMENSION(SIZE(PPS)) :: ZRESTORE
-REAL, DIMENSION(SIZE(PPS)) :: ZUSTAR
-REAL, DIMENSION(SIZE(PPS)) :: ZMELT
-REAL, DIMENSION(SIZE(PPS),GDM%TGD%CUR%TSNOW%NLAYER) :: ZSNOWTEMP
-REAL, DIMENSION(SIZE(PPS),GDM%TGD%CUR%TSNOW%NLAYER) :: ZSNOWLIQ
-REAL, DIMENSION(SIZE(PPS),GDM%TGD%CUR%TSNOW%NLAYER) :: ZSNOWDZ
-REAL, DIMENSION(SIZE(PPS)) :: ZSNOWHMASS
-REAL, DIMENSION(SIZE(PPS)) :: ZMELTADV
-REAL, DIMENSION(SIZE(PPS),SIZE(GDM%TGDP%XABC)) :: ZIACAN
-REAL, DIMENSION(SIZE(PPS)) :: ZQS
-REAL, DIMENSION(SIZE(PPS)) :: ZHV
-REAL, DIMENSION(SIZE(PPS)) :: ZHORT
-REAL, DIMENSION(SIZE(PPS)) :: ZDRIP
-REAL, DIMENSION(SIZE(PPS)) :: ZTS
-REAL, DIMENSION(SIZE(PPS)) :: ZRRVEG
-REAL, DIMENSION(SIZE(PPS)) :: ZALBT
-REAL, DIMENSION(SIZE(PPS)) :: ZEMIST
-REAL, DIMENSION(SIZE(PPS)) :: ZGPP
-REAL, DIMENSION(SIZE(PPS)) :: ZRESP_AUTO
-REAL, DIMENSION(SIZE(PPS)) :: ZRESP_ECO
-REAL, DIMENSION(SIZE(PPS)) :: ZFAPAR
-REAL, DIMENSION(SIZE(PPS)) :: ZFAPIR
-REAL, DIMENSION(SIZE(PPS)) :: ZFAPARC
-REAL, DIMENSION(SIZE(PPS)) :: ZFAPIRC
-REAL, DIMENSION(SIZE(PPS)) :: ZLAI_EFFC
-REAL, DIMENSION(SIZE(PPS)) :: ZFAPAR_BS
-REAL, DIMENSION(SIZE(PPS)) :: ZFAPIR_BS
-REAL, DIMENSION(SIZE(PPS)) :: ZDFAPARC
-REAL, DIMENSION(SIZE(PPS)) :: ZDFAPIRC
-REAL, DIMENSION(SIZE(PPS)) :: ZDLAI_EFFC
-REAL, DIMENSION(SIZE(PPS)) :: ZMUS
-REAL, DIMENSION(SIZE(PPS)) :: ZIRRIG_FLUX
-REAL, DIMENSION(0,0,0) :: ZLITTER
-REAL, DIMENSION(0,0) :: ZLIGNIN_STRUC , ZSOILCARB, ZTURNOVER
-!
-REAL, DIMENSION(SIZE(PPS)) :: ZSNDRIFT
-!
! surfaces relative fractions
! for flood
-REAL, DIMENSION(SIZE(PPS)) :: ZFFG
-REAL, DIMENSION(SIZE(PPS)) :: ZFFV
-REAL, DIMENSION(SIZE(PPS)) :: ZFF
-REAL, DIMENSION(SIZE(PPS)) :: ZALBF
REAL, DIMENSION(SIZE(PPS)) :: ZEMISF
-REAL, DIMENSION(SIZE(PPS)) :: ZFFROZEN
-REAL, DIMENSION(SIZE(PPS)) :: ZFFLOOD
-REAL, DIMENSION(SIZE(PPS)) :: ZPIFLOOD
-REAL, DIMENSION(SIZE(PPS)) :: ZIFLOOD
-REAL, DIMENSION(SIZE(PPS)) :: ZPFLOOD
-REAL, DIMENSION(SIZE(PPS)) :: ZLEFLOOD
-REAL, DIMENSION(SIZE(PPS)) :: ZLEIFLOOD
-REAL, DIMENSION(SIZE(PPS)) :: ZFFG_NOSNOW
-REAL, DIMENSION(SIZE(PPS)) :: ZFFV_NOSNOW
-!
-! variables for irrigation
-REAL, DIMENSION(SIZE(PPS)) :: ZIRRIG
-REAL, DIMENSION(SIZE(PPS)) :: ZWATSUP
-REAL, DIMENSION(SIZE(PPS)) :: ZTHRESHOLDSPT
-LOGICAL, DIMENSION(SIZE(PPS)) :: GIRRIGATE
-LOGICAL, DIMENSION(SIZE(PPS)) :: GIRRIDAY
-!
!
! variables for deep soil temperature
REAL, DIMENSION(SIZE(PPS)) :: ZTDEEP_A
-REAL, DIMENSION(SIZE(PPS)) :: ZTDEEP_B
-REAL, DIMENSION(SIZE(PPS)) :: ZGAMMAT
-!
-REAL, DIMENSION(0) :: ZAOSIP ! A/S for increasing x
-REAL, DIMENSION(0) :: ZAOSIM ! A/S for decreasing x
-REAL, DIMENSION(0) :: ZAOSJP ! A/S for increasing y
-REAL, DIMENSION(0) :: ZAOSJM ! A/S for decreasing y
-REAL, DIMENSION(0) :: ZHO2IP ! h/2 for increasing x
-REAL, DIMENSION(0) :: ZHO2IM ! h/2 for decreasing x
-REAL, DIMENSION(0) :: ZHO2JP ! h/2 for increasing y
-REAL, DIMENSION(0) :: ZHO2JM ! h/2 for decreasing y
-REAL, DIMENSION(0) :: ZZ0EFFIP! roughness length for increasing x
-REAL, DIMENSION(0) :: ZZ0EFFIM! roughness length for decreasing x
-REAL, DIMENSION(0) :: ZZ0EFFJP! roughness length for increasing y
-REAL, DIMENSION(0) :: ZZ0EFFJM! roughness length for decreasing y
-REAL, DIMENSION(0) :: ZTAU_WOOD ! residence time in wood (s)
-REAL, DIMENSION(0,0) :: ZINCREASE
!
! Dummy variables for MEB:
-LOGICAL,PARAMETER::OMEB=.FALSE.
-LOGICAL,PARAMETER::OFORC_MEASURE=.FALSE.
-LOGICAL,PARAMETER::OMEB_LITTER=.FALSE.
-LOGICAL,PARAMETER::OMEB_GNDRES=.FALSE.
-REAL, DIMENSION(SIZE(PPS)) :: ZP_MEB_SCA_SW, &
- ZP_RGLV, ZP_GAMMAV, ZP_RSMINV, &
- ZP_WRMAX_CFV, ZP_LAIV, &
- ZP_BSLAI,ZP_LAIMIN,ZP_H_VEG,ZPALPHAN, &
- ZZ0G_WITHOUT_SNOW, &
- ZZ0_MEBV,ZZ0H_MEBV,ZZ0EFF_MEBV, &
- ZZ0_MEBN,ZZ0H_MEBN,ZZ0EFF_MEBN, &
- ZP_ALBNIR_VEG, ZP_ALBVIS_VEG, &
- ZP_ALBNIR_SOIL, ZP_ALBVIS_SOIL, ZP_GNDLITTER
-REAL, DIMENSION(SIZE(GDM%TGDP%XROOTFRAC,1),SIZE(GDM%TGDP%XROOTFRAC,2)) :: ZP_ROOTFRACV
-REAL, DIMENSION(SIZE(PPS)) :: ZP_WRL,ZP_WRLI,ZP_WRVN,ZP_TV, ZP_TL
-REAL, DIMENSION(SIZE(PPS)) :: ZP_TC,ZP_QC
-REAL, DIMENSION(SIZE(PPS)) :: ZP_SWNET_V, ZP_SWNET_G, ZP_SWNET_N, ZP_SWNET_NS, &
- ZP_LWNET_V, ZP_LWNET_G, ZP_LWNET_N, &
- ZP_LEVCV, ZP_LESC, ZP_H_V_C, ZP_H_G_C, &
- ZP_LETRGV, ZP_LETRCV, ZP_LERGV, ZP_LELITTER, ZP_LELITTERI, &
- ZP_DRIPLIT,ZP_RRLIT, ZP_LERCV, ZP_H_C_A, ZP_H_N_C, &
- ZP_LE_C_A, ZP_LE_V_C, ZP_LE_G_C, ZP_LE_N_C, &
- ZP_EVAP_N_C, ZP_EVAP_G_C, &
- ZP_SR_GN, ZP_MELTCV, ZP_FRZCV, &
- ZP_SWDOWN_GN, ZP_LWDOWN_GN
-!
-TYPE (DATE_TIME), DIMENSION(0) :: TPSEED ! seeding date
-TYPE (DATE_TIME), DIMENSION(0) :: TPREAP ! reaping date
-!
+REAL, DIMENSION(SIZE(PPS)) :: ZP_MEB_SCA_SW, ZPALPHAN, ZZ0G_WITHOUT_SNOW, &
+ ZZ0_MEBV, ZZ0H_MEBV, ZZ0EFF_MEBV, ZZ0_MEBN, &
+ ZZ0H_MEBN, ZZ0EFF_MEBN
INTEGER :: ILU
-!
-LOGICAL :: GMASK, GAGRI_TO_GRASS
-!
-!Snow options
-LOGICAL :: GSNOWDRIFT,GSNOWDRIFT_SUBLIM,GSNOW_ABS_ZENITH
- CHARACTER(3) :: YSNOWMETAMO,YSNOWRAD
+LOGICAL :: GMASK, GALB
+LOGICAL :: GUPDATED
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -359,229 +204,89 @@ ILU = SIZE(PPS)
!
ZDIRCOSZW = 1.
!
-HRAIN = 'DEF'
-OFLOOD = .FALSE.
-OTEMP_ARP = .FALSE.
-OGLACIER = .FALSE.
-ZMUF = 0.
-ZFSAT = 0.
-ZTOPQS = 0.
-ZQSB = 0.
-ZFWTD = 0.
-ZWTD = XUNDEF
-ZSNDRIFT = 0.
-!
-GAGRI_TO_GRASS = .FALSE.
-!
-!* 1.2 flood
-! -----
-!
-ZFFG = 0.
-ZFFV = 0.
-ZFF = 0.
-ZFFROZEN = 0.
-ZALBF = 0.
-ZEMISF = 0.
-ZIFLOOD = 0.
-ZPFLOOD = 0.
-ZFFLOOD = 0.
-ZPIFLOOD = 0.
-ZLEFLOOD = 0.
-ZLEIFLOOD = 0.
-ZFFG_NOSNOW = 0.
-ZFFV_NOSNOW = 0.
-!
-!* ISBA like irrigation (not implemented)
-!
-ZIRRIG = 0.
-ZWATSUP = 0.
-ZTHRESHOLDSPT = 0.
-GIRRIGATE = .FALSE.
-GIRRIDAY = .FALSE.
-!
-ZTDEEP_A = XUNDEF
-ZTDEEP_B = XUNDEF
-ZGAMMAT = XUNDEF
+CALL SSO_INIT(YSS)
!
-!-------------------------------------------------------------------------------
-!
-!* Variables required in TEB to allow coupling
-! with AROME/ALADIN/ARPEGE as LE or EVAP
-!
-ZLEI = 0.0 ! sublimation heat flux (W/m2)
-ZSUBL = 0.0 ! sublimation (kg/m2/s)
-ZTS = 0.0 ! surface temperature (K) (non-radiative)
+CALL AGRI_INIT(YAG)
!
!-------------------------------------------------------------------------------
-! Snow options
-GSNOWDRIFT=.TRUE.
-GSNOWDRIFT_SUBLIM=.FALSE.
-GSNOW_ABS_ZENITH=.FALSE.
-YSNOWMETAMO="B92"
-YSNOWRAD="B92"
-!-------------------------------------------------------------------------------
!
!* 2. Treatment of green areas
! ------------------------
+!* 2.1 Automatic irrigation
+! --------------------
!
+CALL TEB_IRRIG(TIR%LPAR_GD_IRRIG, PTSTEP, TPTIME%TDATE%MONTH, PTSUN, &
+ TIR%XGD_START_MONTH, TIR%XGD_END_MONTH, TIR%XGD_START_HOUR, &
+ TIR%XGD_END_HOUR, TIR%XGD_24H_IRRIG, PIRRIG )
!
+! --------------------------------------------------------------------------------------
+! Vegetation update (in case of non-interactive vegetation):
+! --------------------------------------------------------------------------------------
!
-!* 2.1 Automatic irrigation
-! --------------------
+S%TTIME = TPTIME
!
- CALL TEB_IRRIG(GDM%TIR%LPAR_GD_IRRIG, PTSTEP, TPTIME%TDATE%MONTH, PTSUN, &
- GDM%TIR%XGD_START_MONTH, GDM%TIR%XGD_END_MONTH, GDM%TIR%XGD_START_HOUR, &
- GDM%TIR%XGD_END_HOUR, GDM%TIR%XGD_24H_IRRIG, PIRRIG_GARDEN )
+GUPDATED=.FALSE.
+GALB = .FALSE.
+IF (GDO%CPHOTO=='NIT'.OR.GDO%CPHOTO=='NCB') GALB = .TRUE.
+!
+ CALL VEGETATION_UPDATE(DTCO, DTV, G%NDIM, GDO, K, P, PEK, 1, &
+ PTSTEP, S%TTIME, TOP%XCOVER, TOP%LCOVER, .FALSE., &
+ 'GRD', GALB, YSS, GUPDATED, OABSENT=(T%XGARDEN==0.) )
+!
+!
+DK%XZ0 (:) = PEK%XZ0(:)
+DK%XZ0H(:) = PEK%XZ0(:) / P%XZ0_O_Z0H(:)
+!
+DK%XZ0EFF(:) = PEK%XZ0(:)
!
!* 2.2 Call ISBA for green areas
! -------------------------
!
+ALLOCATE(GB%XIACAN(SIZE(PPS),SIZE(S%XABC)))
+!
+ CALL ISBA(GDO, K, P, PEK, G, YAG, DK, DEK, DMK, &
+ TPTIME, S%XPOI, S%XABC, GB%XIACAN, .FALSE., PTSTEP, &
+ HIMPLICIT_WIND, PZREF, PZREF, ZDIRCOSZW, PTA, PQA, PEXNS, PRHOA, PPS, &
+ PEXNS, PRR, PSR, PZENITH, ZP_MEB_SCA_SW, PSW, PLW, PVMOD, PPEW_A_COEF, &
+ PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
+ PALBNIR_TVEG, PALBVIS_TVEG, PALBNIR_TSOIL, PALBVIS_TSOIL, ZPALPHAN, &
+ ZZ0G_WITHOUT_SNOW, ZZ0_MEBV, ZZ0H_MEBV, ZZ0EFF_MEBV, ZZ0_MEBN, &
+ ZZ0H_MEBN, ZZ0EFF_MEBN, ZTDEEP_A, PCO2, K%XFFG(:), K%XFFV(:), &
+ ZEMISF, ZUSTAR, PAC_AGG, PHU_AGG, ZRESP_BIOMASS_INST, ZDEEP_FLUX, PIRRIG )
+!
+IF (PEK%TSNOW%SCHEME=='3-L' .OR. PEK%TSNOW%SCHEME=='CRO') PEK%TSNOW%TS(:)= DMK%XSNOWTEMP(:,1)
!
- CALL ISBA(GDM%TVG%CISBA, GDM%TVG%CPHOTO, GDM%TVG%LTR_ML, GDM%TVG%CRUNOFF, &
- GDM%TVG%CKSAT, HRAIN, GDM%TVG%CHORT, &
- GDM%TVG%CC1DRY, GDM%TVG%CSCOND, GDM%TGD%CUR%TSNOW%SCHEME, &
- GDM%TVG%CSNOWRES, GDM%TVG%CCPSURF, GDM%TVG%CSOILFRZ, &
- GDM%TVG%CDIFSFCOND, TPTIME, OFLOOD, OTEMP_ARP, OGLACIER, &
- OMEB, OFORC_MEASURE,OMEB_LITTER, OMEB_GNDRES, PTSTEP, HIMPLICIT_WIND, GAGRI_TO_GRASS,&
- GSNOWDRIFT,GSNOWDRIFT_SUBLIM,GSNOW_ABS_ZENITH, &
- YSNOWMETAMO,YSNOWRAD, &
- GDM%TVG%XCGMAX, PZ_LOWCAN, PZ_LOWCAN, ZDIRCOSZW, PT_LOWCAN, &
- PQ_LOWCAN, PEXNS, PRHOA, PPS, PEXNS, PRR, PSR, PZENITH, &
- ZP_MEB_SCA_SW, &
- PSW, PLW, PU_LOWCAN, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, &
- PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, GDM%TGDP%XRSMIN, &
- GDM%TGDP%XRGL, GDM%TGDP%XGAMMA,&
- GDM%TGDP%XCV, GDM%TGDP%XRUNOFFD, GDM%TGDP%XSOILWGHT, &
- GDM%TGDO%NLAYER_HORT, GDM%TGDO%NLAYER_DUN, &
- PALBNIR_TVEG, PALBVIS_TVEG, PALBNIR_TSOIL, PALBVIS_TSOIL, &
- GDM%TGD%CUR%XSNOWFREE_ALB, GDM%TGDP%XWRMAX_CF, GDM%TGDPE%CUR%XVEG, &
- GDM%TGDPE%CUR%XLAI, GDM%TGDPE%CUR%XEMIS, GDM%TGDPE%CUR%XZ0, &
- GDM%TGDPE%CUR%XZ0/GDM%TGDP%XZ0_O_Z0H, GDM%TGDP%XVEGTYPE, GDM%TGDPE%CUR%XZ0, &
- ZP_RGLV, ZP_GAMMAV, ZP_RSMINV, &
- ZP_ROOTFRACV, ZP_WRMAX_CFV, ZP_LAIV, &
- ZP_BSLAI,ZP_LAIMIN,ZP_H_VEG,ZPALPHAN, &
- ZZ0G_WITHOUT_SNOW, &
- ZZ0_MEBV,ZZ0H_MEBV,ZZ0EFF_MEBV, &
- ZZ0_MEBN,ZZ0H_MEBN,ZZ0EFF_MEBN, ZP_GNDLITTER, &
- GDM%TGDP%XRUNOFFB, GDM%TGDP%XCGSAT, GDM%TGDP%XC1SAT, &
- GDM%TGDP%XC2REF, GDM%TGDP%XC3, GDM%TGDP%XC4B, GDM%TGDP%XC4REF, &
- GDM%TGDP%XACOEF, GDM%TGDP%XPCOEF, GDM%TGDP%XTAUICE, GDM%TGDP%XWDRAIN,&
- ZTDEEP_A, ZTDEEP_B, ZGAMMAT, GDM%TGD%CUR%XPSN, GDM%TGD%CUR%XPSNG, &
- GDM%TGD%CUR%XPSNV, GDM%TGD%CUR%XPSNV_A, &
- GDM%TGD%CUR%XSNOWFREE_ALB_VEG, GDM%TGD%CUR%XSNOWFREE_ALB_SOIL, ZIRRIG, ZWATSUP, &
- ZTHRESHOLDSPT, GIRRIGATE, GIRRIDAY, GDM%TGDP%LSTRESS, GDM%TGDP%XGC, GDM%TGDP%XF2I, &
- GDM%TGDP%XDMAX, GDM%TGDP%XAH, GDM%TGDP%XBH, PCO2, GDM%TGDP%XGMES, GDM%TGDP%XPOI, &
- GDM%TGDP%XFZERO, GDM%TGDP%XEPSO, GDM%TGDP%XGAMM, &
- GDM%TGDP%XQDGAMM, GDM%TGDP%XQDGMES, GDM%TGDP%XT1GMES, GDM%TGDP%XT2GMES, &
- GDM%TGDP%XAMAX, GDM%TGDP%XQDAMAX, GDM%TGDP%XT1AMAX,&
- GDM%TGDP%XT2AMAX, GDM%TGDP%XABC, GDM%TGDP%XDG, GDM%TGDP%XDZG, GDM%TGDP%XDZDIF, &
- GDM%TGDP%NWG_LAYER, GDM%TGDP%XROOTFRAC, &
- GDM%TGDP%XWFC, GDM%TGDP%XWWILT, GDM%TGDP%XWSAT, GDM%TGDP%XBCOEF, &
- GDM%TGDP%XCONDSAT, GDM%TGDP%XMPOTSAT, &
- GDM%TGDP%XHCAPSOIL, GDM%TGDP%XCONDDRY, GDM%TGDP%XCONDSLD, GDM%TGDP%XD_ICE, &
- GDM%TGDP%XKSAT_ICE, ZMUF, ZFF,&
- ZFFG, ZFFV, ZFFG_NOSNOW, ZFFV_NOSNOW, ZFFROZEN, ZALBF, &
- ZEMISF, ZFFLOOD, ZPIFLOOD, ZIFLOOD, ZPFLOOD, ZLEFLOOD, &
- ZLEIFLOOD, ZSODELX, TG%XLAT, TG%XLON, GDM%TGD%CUR%XTG, GDM%TGD%CUR%XWG, &
- GDM%TGD%CUR%XWGI, GDM%TGDP%XPCPS, &
- GDM%TGDP%XPLVTT, GDM%TGDP%XPLSTT, GDM%TGD%CUR%XWR, &
- ZP_WRL,ZP_WRLI,ZP_WRVN,ZP_TV, ZP_TL, &
- GDM%TGD%CUR%XRESA, GDM%TGD%CUR%XANFM, ZFSAT, GDM%TGD%CUR%TSNOW%ALB(:,1), &
- GDM%TGD%CUR%TSNOW%ALBVIS(:,1), GDM%TGD%CUR%TSNOW%ALBNIR(:,1), GDM%TGD%CUR%TSNOW%ALBFIR(:,1), &
- GDM%TGD%CUR%TSNOW%WSNOW(:,:,1), GDM%TGD%CUR%TSNOW%HEAT(:,:,1), GDM%TGD%CUR%TSNOW%RHO(:,:,1), &
- GDM%TGD%CUR%TSNOW%GRAN1(:,:,1), GDM%TGD%CUR%TSNOW%GRAN2(:,:,1), GDM%TGD%CUR%TSNOW%HIST(:,:,1), &
- GDM%TGD%CUR%TSNOW%AGE(:,:,1), ZGRNDFLUX, ZHPSNOW, ZSNOWHMASS, &
- ZRNSNOW, ZHSNOW, ZGFLUXSNOW, ZUSTARSNOW, &
- ZSRSFC, ZRRSFC, ZLESL, GDM%TGD%CUR%TSNOW%EMIS(:,1), ZCDSNOW, ZCHSNOW, &
- PTS_GARDEN, ZTS, ZHV, ZQS, ZSNOWTEMP, ZSNOWLIQ, ZSNOWDZ, &
- ZCG, ZC1, ZC2, ZWGEQ, ZCT, ZCH, ZCD, ZCDN, ZRI, ZHU, ZHUG, &
- ZEMIST, ZALBT, ZRS, GDM%TGD%CUR%XLE, ZRN, ZH, ZLEI, ZLEGI, ZLEG, ZLEV, &
- ZLES, ZLER, ZLETR, ZEVAP, ZGFLUX, ZRESTORE, ZUSTAR, &
- PDRAIN_GARDEN, PRUNOFF_GARDEN, &
- ZMELT, ZMELTADV, &
- ZP_TC,ZP_QC, &
- ZRN_ISBA, ZH_ISBA, ZLEG_ISBA, &
- ZLEGI_ISBA, ZLEV_ISBA, ZLETR_ISBA, ZUSTAR_ISBA, ZLER_ISBA, &
- ZLE_ISBA, ZLEI_ISBA, ZGFLUX_ISBA, ZHORT, ZDRIP, ZRRVEG, &
- PAC_AGG_GARDEN, PHU_AGG_GARDEN, ZFAPARC, ZFAPIRC, ZMUS, &
- ZLAI_EFFC, GDM%TGD%CUR%XAN, GDM%TGD%CUR%XANDAY, ZRESP_BIOMASS_INST, ZIACAN, GDM%TGDP%XANF, &
- ZGPP, ZFAPAR, ZFAPIR, ZFAPAR_BS, ZFAPIR_BS, ZIRRIG_FLUX, &
- ZDEEP_FLUX, &
- ZP_SWNET_V, ZP_SWNET_G, ZP_SWNET_N, ZP_SWNET_NS, &
- ZP_LWNET_V, ZP_LWNET_G, ZP_LWNET_N, &
- ZP_LEVCV, ZP_LESC, ZP_H_V_C, ZP_H_G_C, &
- ZP_LETRGV, ZP_LETRCV, ZP_LERGV, ZP_LELITTER,ZP_LELITTERI, &
- ZP_DRIPLIT,ZP_RRLIT, ZP_LERCV, ZP_H_C_A, ZP_H_N_C, &
- ZP_LE_C_A, ZP_LE_V_C, ZP_LE_G_C, ZP_LE_N_C, &
- ZP_EVAP_N_C, ZP_EVAP_G_C, &
- ZP_SR_GN, ZP_MELTCV, ZP_FRZCV, &
- ZP_SWDOWN_GN, ZP_LWDOWN_GN, &
- PIRRIG_GARDEN, ZTOPQS, ZQSB, ZSUBL, ZFWTD, ZWTD, ZSNDRIFT )
-!
-!
-IF (GDM%TGD%CUR%TSNOW%SCHEME=='3-L' .OR. GDM%TGD%CUR%TSNOW%SCHEME=='CRO') &
- GDM%TGD%CUR%TSNOW%TS(:,1)=ZSNOWTEMP(:,1)
-!
-IF (GDM%TVG%LTR_ML) THEN
+IF (GDO%LTR_ML) THEN
GMASK = ( TPTIME%TIME - PTSTEP < 0. ) .AND. ( TPTIME%TIME >= 0. )
IF (GMASK) THEN
- ZDFAPARC (:) = ZFAPARC (:) / ZMUS (:)
- ZDFAPIRC (:) = ZFAPIRC (:) / ZMUS (:)
- ZDLAI_EFFC(:) = ZLAI_EFFC (:) / ZMUS (:)
+ ALLOCATE(DMK%XDFAPARC(ILU),DMK%XDFAPIRC(ILU),DMK%XDLAI_EFFC(ILU))
+ DMK%XDFAPARC (:) = PEK%XFAPARC (:) / PEK%XMUS (:)
+ DMK%XDFAPIRC (:) = PEK%XFAPIRC (:) / PEK%XMUS (:)
+ DMK%XDLAI_EFFC(:) = PEK%XLAI_EFFC (:) / PEK%XMUS (:)
ENDIF
ENDIF
!
-! --------------------------------------------------------------------------------------
-! Vegetation update (in case of non-interactive vegetation):
-! --------------------------------------------------------------------------------------
-!
-IF (GDM%TVG%CPHOTO=='NON' .OR. GDM%TVG%CPHOTO=='AGS' .OR. GDM%TVG%CPHOTO=='AST') THEN
- CALL VEGETATION_UPDATE_GARDEN(DTCO, DTI, IG, I, T, TOP, DTGR, TGRO, GDM, &
- TPTIME,PTSTEP,ILU)
-END IF
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Vegetation evolution for interactive LAI
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-IF (GDM%TVG%CPHOTO=='LAI' .OR. GDM%TVG%CPHOTO=='LST' .OR. GDM%TVG%CPHOTO=='NIT') THEN
- CALL VEGETATION_EVOL(GDM%TVG%CISBA, GDM%TVG%CPHOTO, GDM%TVG%CRESPSL, &
- GDM%TVG%CALBEDO, .FALSE., GDM%TVG%LTR_ML, &
- GDM%TVG%LNITRO_DILU, GAGRI_TO_GRASS, .FALSE., .FALSE., .FALSE., &
- PTSTEP, TPTIME%TDATE%MONTH, TPTIME%TDATE%DAY, 1, &
- TPTIME%TIME, TG%XLAT, PRHOA, GDM%TGDP%XDG, GDM%TGDP%XDZG, GDM%TGDP%NWG_LAYER, &
- GDM%TGD%CUR%XTG, GDM%TGDP%XALBNIR_VEG, GDM%TGDP%XALBVIS_VEG, &
- GDM%TGDP%XALBUV_VEG, GDM%TGDP%XALBNIR_SOIL, GDM%TGDP%XALBVIS_SOIL, &
- GDM%TGDP%XALBUV_SOIL, GDM%TGDP%XVEGTYPE, GDM%TGDP%XSEFOLD, GDM%TGDP%XANMAX, &
- GDM%TGDP%XH_TREE, GDM%TGDP%XBSLAI, GDM%TGDP%XLAIMIN, PCO2, &
- GDM%TGDP%XCE_NITRO, GDM%TGDP%XCF_NITRO, GDM%TGDP%XCNA_NITRO, &
- GDM%TGDP%XBSLAI_NITRO, GDM%TGDP%XGMES, ZTAU_WOOD, TPSEED, &
- TPREAP, ZAOSIP, ZAOSIM, ZAOSJP, ZAOSJM, &
- ZHO2IP, ZHO2IM, ZHO2JP, ZHO2JM, ZZ0EFFIP, &
- ZZ0EFFIM, ZZ0EFFJP, ZZ0EFFJM, GDM%TGDPE%CUR%XLAI, GDM%TGDPE%CUR%XVEG, &
- GDM%TGDPE%CUR%XZ0, GDM%TGDPE%CUR%XALBNIR, GDM%TGDPE%CUR%XALBVIS, &
- GDM%TGDPE%CUR%XALBUV, GDM%TGDPE%CUR%XEMIS, GDM%TGD%CUR%XANFM, &
- GDM%TGD%CUR%XANDAY, GDM%TGD%CUR%XBIOMASS, GDM%TGD%CUR%XRESP_BIOMASS, &
- ZRESP_BIOMASS_INST, ZINCREASE, ZTURNOVER )
+IF (GDO%CPHOTO=='NIT') THEN
+ CALL VEGETATION_EVOL(GDO, DTV, P, PEK, .FALSE., PTSTEP, TPTIME%TDATE%MONTH, TPTIME%TDATE%DAY, &
+ TPTIME%TIME, G%XLAT, PRHOA, PCO2, YSS, ZRESP_BIOMASS_INST )
END IF
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Diagnostic of respiration carbon fluxes and soil carbon evolution
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-PSFCO2(:)=0.
-ZRESP_ECO (:)=0.
-ZRESP_AUTO(:)=0.
-!
-IF (GDM%TVG%CPHOTO/='NON' .AND. GDM%TVG%CRESPSL/='NON' .AND. ANY(GDM%TGDPE%CUR%XLAI(:)/=XUNDEF)) THEN
- CALL CARBON_EVOL(GDM%TVG%CISBA, GDM%TVG%CRESPSL, GDM%TVG%CPHOTO, PTSTEP, 1, &
- PRHOA, GDM%TGD%CUR%XTG, GDM%TGD%CUR%XWG, GDM%TGDP%XWFC, &
- GDM%TGDP%XWWILT, GDM%TGDP%XWSAT, GDM%TGDP%XSAND, &
- GDM%TGDP%XDG, GDM%TGDP%XDZG, GDM%TGDP%NWG_LAYER, &
- GDM%TGDP%XRE25, GDM%TGDPE%CUR%XLAI, ZRESP_BIOMASS_INST, ZTURNOVER, &
- ZLITTER, ZLIGNIN_STRUC , ZSOILCARB, &
- ZRESP_AUTO, ZRESP_ECO )
+PSFCO2 (:) = 0.
+DEK%XRESP_ECO (:) = 0.
+DEK%XRESP_AUTO(:) = 0.
+!
+IF (GDO%CPHOTO/='NON' .AND. GDO%CRESPSL/='NON' .AND. ANY(PEK%XLAI(:)/=XUNDEF)) THEN
+ CALL CARBON_EVOL(GDO, K, P, PEK, DEK, PTSTEP, PRHOA, ZRESP_BIOMASS_INST )
! calculation of vegetation CO2 flux
- PSFCO2(:) = - ZGPP(:) + ZRESP_ECO(:)
+ PSFCO2(:) = - DEK%XGPP(:) + DEK%XRESP_ECO(:)
END IF
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -592,52 +297,58 @@ END IF
! This way, these points are clearly flaged, and one will not try to interpret
! the values for those points
!
- CALL FLAG_TEB_GARDEN_n(GDM%TGD, GDM%TGDO, GDM%TGDPE, T, GDM%TVG, &
- 2)
+ CALL FLAG_TEB_VEG_n(PEK, GDO, T%XGARDEN, 2)
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
!* 9. Fields required for TEB
! -----------------------
!
-WHERE (T%CUR%XGARDEN/=0.)
+WHERE (T%XGARDEN/=0.)
!
! energy balance
!
- PRN_GARDEN (:) = ZRN (:)
- PH_GARDEN (:) = ZH (:)
- PLE_GARDEN (:) = GDM%TGD%CUR%XLE
- PGFLUX_GARDEN (:) = ZGFLUX (:)
- PEVAP_GARDEN (:) = ZEVAP (:)
- !
+ DK%XLE(:) = PEK%XLE(:)
!
! Estimate of green area aerodynamic conductance recomputed from heat flux,
! surface (radiative) temp. and forcing air temperature (estimated at future time step)
- ZTA = PPET_B_COEF + PPET_A_COEF * PH_GARDEN
- PAC_GARDEN = 0.
- WHERE (PTS_GARDEN /= ZTA)
- PAC_GARDEN(:) = MAX(PH_GARDEN(:) / XCPD / PRHOA(:) / (PTS_GARDEN - ZTA) , 0.)
+ ZTA = PPET_B_COEF + PPET_A_COEF * DK%XH
+ PAC = 0.
+ WHERE (DK%XTSRAD /= ZTA)
+ PAC(:) = MAX(DK%XH(:) / XCPD / PRHOA(:) / (DK%XTSRAD - ZTA) , 0.)
ENDWHERE
!
! Humidity of saturation for green areas
- PQSAT_GARDEN(:) = QSAT(GDM%TGD%CUR%XTG(:,1),PPS(:))
+ PQSAT(:) = QSAT(PEK%XTG(:,1),PPS(:))
!
!* friction flux
- PUW_GARDEN(:) = -ZUSTAR(:)**2
+ PUW(:) = -ZUSTAR(:)**2
!
ELSEWHERE
!
- PRN_GARDEN (:) = XUNDEF
- PH_GARDEN (:) = XUNDEF
- PLE_GARDEN (:) = XUNDEF
- PGFLUX_GARDEN (:) = XUNDEF
- PEVAP_GARDEN (:) = XUNDEF
- PAC_GARDEN (:) = XUNDEF
- PQSAT_GARDEN (:) = XUNDEF
- PUW_GARDEN (:) = XUNDEF
+ DK%XRN (:) = XUNDEF
+ DK%XH (:) = XUNDEF
+ DK%XLE (:) = XUNDEF
+ DK%XGFLUX (:) = XUNDEF
+ DK%XEVAP (:) = XUNDEF
+ DEK%XRUNOFF(:) = XUNDEF
+ !
+ PAC (:) = XUNDEF
+ PQSAT (:) = XUNDEF
+ PUW (:) = XUNDEF
!
END WHERE
!
+!
+PTSRAD(:) = DK%XTSRAD(:)
+!
+PRN (:) = DK%XRN (:)
+PH (:) = DK%XH (:)
+PLE (:) = DK%XLE (:)
+PGFLUX (:) = DK%XGFLUX (:)
+PEVAP (:) = DK%XEVAP (:)
+PRUNOFF(:) =DEK%XRUNOFF(:)
+!
IF (LHOOK) CALL DR_HOOK('GARDEN',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/gather_and_write_mpi.F90 b/src/SURFEX/gather_and_write_mpi.F90
index b5ab7dc5e7de8c9af22b325bd6259794b70cf66a..2670cc85b7ecfde552614d6ecea263547f92994d 100644
--- a/src/SURFEX/gather_and_write_mpi.F90
+++ b/src/SURFEX/gather_and_write_mpi.F90
@@ -30,6 +30,15 @@ INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
END SUBROUTINE GATHER_AND_WRITE_MPI_N2D
!
+SUBROUTINE GATHER_AND_WRITE_MPI_N3D(KWORK,KWORK2,KMASK)
+!
+INTEGER, DIMENSION(:,:,:), INTENT(IN) :: KWORK
+INTEGER, DIMENSION(:,:,:), INTENT(OUT) :: KWORK2
+!
+INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
+!
+END SUBROUTINE GATHER_AND_WRITE_MPI_N3D
+!
SUBROUTINE GATHER_AND_WRITE_MPI_X1D(PWORK,PWORK2,KMASK)
!
REAL, DIMENSION(:), INTENT(IN) :: PWORK
@@ -48,7 +57,15 @@ INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
END SUBROUTINE GATHER_AND_WRITE_MPI_X2D
!
-#ifndef MNH_SP4
+SUBROUTINE GATHER_AND_WRITE_MPI_X3D(PWORK,PWORK2,KMASK)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWORK
+REAL(KIND=8), DIMENSION(:,:,:), INTENT(OUT) :: PWORK2
+!
+INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
+!
+END SUBROUTINE GATHER_AND_WRITE_MPI_X3D
+!
SUBROUTINE GATHER_AND_WRITE_MPI_X1DK4(PWORK,PWORK2,KMASK)
!
REAL, DIMENSION(:), INTENT(IN) :: PWORK
@@ -66,7 +83,15 @@ REAL(KIND=4), DIMENSION(:,:), INTENT(OUT) :: PWORK2
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
END SUBROUTINE GATHER_AND_WRITE_MPI_X2DK4
-#endif
+!
+SUBROUTINE GATHER_AND_WRITE_MPI_X3DK4(PWORK,PWORK2,KMASK)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWORK
+REAL(KIND=4), DIMENSION(:,:,:), INTENT(OUT) :: PWORK2
+!
+INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
+!
+END SUBROUTINE GATHER_AND_WRITE_MPI_X3DK4
!
END INTERFACE
!
@@ -76,8 +101,7 @@ SUBROUTINE GATHER_AND_WRITE_MPI_N1D(KWORK,KWORK2,KMASK)
!
USE MODD_SURFEX_MPI, ONLY : NINDEX, NPROC, NRANK, NCOMM, NPIO, NSIZE, &
XTIME_CALC_WRITE, XTIME_COMM_WRITE, &
- XTIME_OMP_BARR, IDX_W, WLOG_MPI
-USE MODD_SURFEX_OMP, ONLY : NINDX1SFX, NINDX2SFX, NWORK, NWORK_FULL
+ IDX_W, WLOG_MPI
!
USE MODI_UNPACK_SAME_RANK
!
@@ -96,6 +120,7 @@ INTEGER, DIMENSION(:), INTENT(OUT) :: KWORK2
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
INTEGER, DIMENSION(NSIZE) :: IINTER
+INTEGER, DIMENSION(NSIZE) :: IWORK
REAL :: XTIME0
!
#ifdef SFX_MPI
@@ -105,22 +130,20 @@ INTEGER :: ICPT
INTEGER :: I,J, IP1, IS1
INTEGER :: INFOMPI
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!
IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_N1D',0,ZHOOK_HANDLE)
!
-!$OMP BARRIER
-!
-NWORK(NINDX1SFX:NINDX2SFX) = 0
+IWORK(:) = 0
!
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
#endif
!
IF (PRESENT(KMASK)) THEN
- CALL UNPACK_SAME_RANK(KMASK,KWORK,NWORK(NINDX1SFX:NINDX2SFX))
+ CALL UNPACK_SAME_RANK(KMASK,KWORK,IWORK(:))
ELSE
- NWORK(NINDX1SFX:NINDX2SFX) = KWORK(:)
+ IWORK(1:SIZE(KWORK)) = KWORK(:)
ENDIF
!
#ifdef SFX_MPI
@@ -129,55 +152,34 @@ XTIME_CALC_WRITE = XTIME_CALC_WRITE + (MPI_WTIME() - XTIME0)
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP BARRIER
-!
-#ifdef SFX_MPI
-XTIME_OMP_BARR = XTIME_OMP_BARR + (MPI_WTIME() - XTIME0)
-#endif
-!
IF (NRANK/=NPIO) THEN
!
-!$OMP SINGLE
- !
IDX_W = IDX_W + 1
!
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
- CALL MPI_SEND(NWORK,SIZE(NWORK)*KIND(NWORK)/4,MPI_INTEGER,NPIO,IDX_W,NCOMM,INFOMPI)
+ CALL MPI_SEND(IWORK,SIZE(IWORK)*KIND(IWORK)/4,MPI_INTEGER,NPIO,IDX_W,NCOMM,INFOMPI)
XTIME_COMM_WRITE = XTIME_COMM_WRITE + (MPI_WTIME() - XTIME0)
#endif
!
-!$OMP END SINGLE
- !
ELSE
!
- IP1 = SIZE(KWORK2)
- !
-!$OMP SINGLE
- !
- IS1 = SIZE(NWORK_FULL)
- !
- IF (IP1>IS1) THEN
- DEALLOCATE(NWORK_FULL)
- ALLOCATE(NWORK_FULL(IP1))
- ENDIF
- !
- NWORK_FULL(:) = 0
+ KWORK2(:) = 0
!
IDX_W = IDX_W + 1
!
- DO I=1,NPROC
+ DO I=0,NPROC-1
!
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
#endif
!
- IF (I<NPROC) THEN
+ IF (I/=NPIO) THEN
#ifdef SFX_MPI
CALL MPI_RECV(IINTER,SIZE(IINTER)*KIND(IINTER)/4,MPI_INTEGER,I,IDX_W,NCOMM,ISTATUS,INFOMPI)
#endif
ELSE
- IINTER(1:SIZE(NWORK)) = NWORK(:)
+ IINTER(:) = IWORK(:)
ENDIF
!
#ifdef SFX_MPI
@@ -190,9 +192,9 @@ ELSE
!
DO J=1,SIZE(NINDEX)
!
- IF ( NINDEX(J)==MOD(I,NPROC) ) THEN
+ IF ( NINDEX(J)==I ) THEN
ICPT = ICPT + 1
- NWORK_FULL(J) = IINTER(ICPT)
+ KWORK2(J) = IINTER(ICPT)
ENDIF
!
ENDDO
@@ -203,10 +205,6 @@ ELSE
!
ENDDO
!
-!$OMP END SINGLE
- !
- KWORK2(:) = NWORK_FULL(1:IP1)
- !
ENDIF
!
IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_N1D',1,ZHOOK_HANDLE)
@@ -220,8 +218,7 @@ SUBROUTINE GATHER_AND_WRITE_MPI_N2D(KWORK,KWORK2,KMASK)
!
USE MODD_SURFEX_MPI, ONLY : NINDEX, NPROC, NRANK, NCOMM, NPIO, NSIZE, &
XTIME_CALC_WRITE, XTIME_COMM_WRITE, &
- XTIME_OMP_BARR, IDX_W, WLOG_MPI
-USE MODD_SURFEX_OMP, ONLY : NINDX1SFX, NINDX2SFX, NWORK2, NWORK2_FULL
+ IDX_W, WLOG_MPI
!
USE MODI_UNPACK_SAME_RANK
!
@@ -240,12 +237,13 @@ INTEGER, DIMENSION(:,:), INTENT(OUT) :: KWORK2
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
INTEGER, DIMENSION(NSIZE,SIZE(KWORK2,2)) :: IINTER
+INTEGER, DIMENSION(NSIZE,SIZE(KWORK2,2)) :: IWORK
REAL :: XTIME0
!
#ifdef SFX_MPI
INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
#endif
-INTEGER :: ICPT, IX2, IS1, IS2, IP1, IP2
+INTEGER :: ICPT
INTEGER :: I,J
INTEGER :: INFOMPI
!
@@ -253,19 +251,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_N2D',0,ZHOOK_HANDLE)
!
-IP2 = SIZE(KWORK,2)
-IX2 = SIZE(NWORK2,2)
-!
-!$OMP SINGLE
-!
-IF (IP2>IX2) THEN
- DEALLOCATE(NWORK2)
- ALLOCATE(NWORK2(NSIZE,IP2))
-ENDIF
-!
-!$OMP END SINGLE
-!
-NWORK2(NINDX1SFX:NINDX2SFX,1:IP2) = 0
+IWORK(:,:) = 0
!
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
@@ -273,9 +259,9 @@ XTIME0 = MPI_WTIME()
!
IF (SIZE(KWORK,1)>0) THEN
IF (PRESENT(KMASK)) THEN
- CALL UNPACK_SAME_RANK(KMASK,KWORK,NWORK2(NINDX1SFX:NINDX2SFX,1:IP2))
+ CALL UNPACK_SAME_RANK(KMASK,KWORK,IWORK(:,:))
ELSE
- NWORK2(NINDX1SFX:NINDX2SFX,1:IP2) = KWORK(:,:)
+ IWORK(1:SIZE(KWORK,1),:) = KWORK(:,:)
ENDIF
ENDIF
!
@@ -285,41 +271,17 @@ XTIME_CALC_WRITE = XTIME_CALC_WRITE + (MPI_WTIME() - XTIME0)
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP BARRIER
-!
-#ifdef SFX_MPI
-XTIME_OMP_BARR = XTIME_OMP_BARR + (MPI_WTIME() - XTIME0)
-#endif
-!
IF (NRANK/=NPIO) THEN
!
-!$OMP SINGLE
- !
IDX_W = IDX_W + 1
!
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
- CALL MPI_SEND(NWORK2(:,1:IP2),NSIZE*IP2*KIND(NWORK2)/4,MPI_INTEGER,NPIO,IDX_W,NCOMM,INFOMPI)
+ CALL MPI_SEND(IWORK(:,:),SIZE(IWORK)*KIND(IWORK)/4,MPI_INTEGER,NPIO,IDX_W,NCOMM,INFOMPI)
XTIME_COMM_WRITE = XTIME_COMM_WRITE + (MPI_WTIME() - XTIME0)
#endif
!
-!$OMP END SINGLE
- !
ELSE
- !
- IP1 = SIZE(KWORK2,1)
- !
-!$OMP SINGLE
- !
- IS1 = SIZE(NWORK2_FULL,1)
- IS2 = SIZE(NWORK2_FULL,2)
- !
- IF (IP1>IS1 .OR. IP2>IS2) THEN
- DEALLOCATE(NWORK2_FULL)
- ALLOCATE(NWORK2_FULL(MAX(IP1,IS1),MAX(IP2,IS2)))
- ENDIF
- !
- NWORK2_FULL(:,:) = 0
!
IDX_W = IDX_W + 1
!
@@ -334,7 +296,7 @@ ELSE
CALL MPI_RECV(IINTER,SIZE(IINTER)*KIND(IINTER)/4,MPI_INTEGER,I,IDX_W,NCOMM,ISTATUS,INFOMPI)
#endif
ELSE
- IINTER(:,:) = NWORK2(:,1:IP2)
+ IINTER(:,:) = IWORK(:,:)
ENDIF
!
#ifdef SFX_MPI
@@ -349,7 +311,7 @@ ELSE
!
IF ( NINDEX(J)==MOD(I,NPROC) ) THEN
ICPT = ICPT + 1
- NWORK2_FULL(J,1:IP2) = IINTER(ICPT,:)
+ KWORK2(J,:) = IINTER(ICPT,:)
ENDIF
!
ENDDO
@@ -360,10 +322,6 @@ ELSE
!
ENDDO
!
-!$OMP END SINGLE
- !
- KWORK2(:,:) = NWORK2_FULL(1:IP1,1:IP2)
- !
ENDIF
!
IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_N2D',1,ZHOOK_HANDLE)
@@ -373,6 +331,126 @@ END SUBROUTINE GATHER_AND_WRITE_MPI_N2D
!
!**************************************************************************
!
+SUBROUTINE GATHER_AND_WRITE_MPI_N3D(KWORK,KWORK2,KMASK)
+!
+USE MODD_SURFEX_MPI, ONLY : NINDEX, NPROC, NRANK, NCOMM, NPIO, NSIZE, &
+ XTIME_CALC_WRITE, XTIME_COMM_WRITE, &
+ IDX_W, WLOG_MPI
+!
+USE MODI_UNPACK_SAME_RANK
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
+INTEGER, DIMENSION(:,:,:), INTENT(IN) :: KWORK
+INTEGER, DIMENSION(:,:,:), INTENT(OUT) :: KWORK2
+!
+INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
+!
+INTEGER, DIMENSION(NSIZE,SIZE(KWORK2,2),SIZE(KWORK2,3)) :: IINTER
+INTEGER, DIMENSION(NSIZE,SIZE(KWORK,2),SIZE(KWORK,3)) :: IWORK
+!
+DOUBLE PRECISION :: XTIME0
+!
+#ifdef SFX_MPI
+INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+#endif
+INTEGER :: ICPT
+INTEGER :: I,J
+INTEGER :: INFOMPI
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_N3D',0,ZHOOK_HANDLE)
+!
+IWORK(:,:,:) = 0
+!
+#ifdef SFX_MPI
+XTIME0 = MPI_WTIME()
+#endif
+!
+IF (SIZE(KWORK,1)>0) THEN
+ IF (PRESENT(KMASK)) THEN
+ CALL UNPACK_SAME_RANK(KMASK,KWORK(:,:,:),IWORK(:,:,:))
+ ELSE
+ IWORK(1:SIZE(KWORK,1),:,:) = KWORK(:,:,:)
+ ENDIF
+ENDIF
+!
+#ifdef SFX_MPI
+XTIME_CALC_WRITE = XTIME_CALC_WRITE + (MPI_WTIME() - XTIME0)
+!
+XTIME0 = MPI_WTIME()
+#endif
+!
+IF (NRANK/=NPIO) THEN
+ !
+ IDX_W = IDX_W + 1
+ !
+#ifdef SFX_MPI
+ XTIME0 = MPI_WTIME()
+ CALL MPI_SEND(IWORK(:,:,:),SIZE(IWORK)*KIND(IWORK)/4,MPI_INTEGER,NPIO,IDX_W,NCOMM,INFOMPI)
+ XTIME_COMM_WRITE = XTIME_COMM_WRITE + (MPI_WTIME() - XTIME0)
+#endif
+ !
+ELSE
+ !
+ KWORK2(:,:,:) = 0
+ !
+ IDX_W = IDX_W + 1
+ !
+ DO I=0,NPROC-1
+ !
+#ifdef SFX_MPI
+ XTIME0 = MPI_WTIME()
+#endif
+ !
+ IF (I/=NPIO) THEN
+#ifdef SFX_MPI
+ CALL MPI_RECV(IINTER,SIZE(IINTER)*KIND(IINTER)/4,MPI_INTEGER,I,IDX_W,NCOMM,ISTATUS,INFOMPI)
+#endif
+ ELSE
+ IINTER(:,:,:) = IWORK(:,:,:)
+ ENDIF
+ !
+#ifdef SFX_MPI
+ XTIME_COMM_WRITE = XTIME_COMM_WRITE + (MPI_WTIME() - XTIME0)
+ !
+ XTIME0 = MPI_WTIME()
+#endif
+ !
+ ICPT = 0
+ !
+ DO J=1,SIZE(NINDEX)
+ !
+ IF ( NINDEX(J)==I ) THEN
+ ICPT = ICPT + 1
+ KWORK2(J,:,:) = IINTER(ICPT,:,:)
+ ENDIF
+ !
+ ENDDO
+ !
+#ifdef SFX_MPI
+ XTIME_CALC_WRITE = XTIME_CALC_WRITE + (MPI_WTIME() - XTIME0)
+#endif
+ !
+ ENDDO
+ !
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_N3D',1,ZHOOK_HANDLE)
+!
+!
+END SUBROUTINE GATHER_AND_WRITE_MPI_N3D
+!
+!**************************************************************************
+!
SUBROUTINE GATHER_AND_WRITE_MPI_X1D(PWORK,PWORK2,KMASK)
!
USE MODI_GATHER_AND_WRITE_MPI_K4
@@ -385,22 +463,17 @@ USE PARKIND1 ,ONLY : JPRB
IMPLICIT NONE
!
REAL, DIMENSION(:), INTENT(IN) :: PWORK
-REAL(KIND=8), DIMENSION(:), INTENT(OUT) :: PWORK2
+REAL(KIND=KIND(PWORK)), DIMENSION(:), INTENT(OUT) :: PWORK2
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
-REAL, DIMENSION(SIZE(PWORK2)) :: ZINTER
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X1D',0,ZHOOK_HANDLE)
!
IF (PRESENT(KMASK)) THEN
- CALL GATHER_AND_WRITE_MPI_K4(PWORK,ZINTER,KMASK)
+ CALL GATHER_AND_WRITE_MPI_K4(PWORK,PWORK2,KMASK)
ELSE
- CALL GATHER_AND_WRITE_MPI_K4(PWORK,ZINTER)
-ENDIF
-!
-IF (NRANK==NPIO) THEN
- PWORK2(:) = ZINTER(:)
+ CALL GATHER_AND_WRITE_MPI_K4(PWORK,PWORK2)
ENDIF
!
IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X1D',1,ZHOOK_HANDLE)
@@ -421,22 +494,17 @@ USE PARKIND1 ,ONLY : JPRB
IMPLICIT NONE
!
REAL, DIMENSION(:,:), INTENT(IN) :: PWORK
-REAL(KIND=8), DIMENSION(:,:), INTENT(OUT) :: PWORK2
+REAL(KIND=KIND(PWORK)), DIMENSION(:,:), INTENT(OUT) :: PWORK2
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
-REAL, DIMENSION(SIZE(PWORK2,1),SIZE(PWORK2,2)) :: ZINTER
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X2D',0,ZHOOK_HANDLE)
!
IF (PRESENT(KMASK)) THEN
- CALL GATHER_AND_WRITE_MPI_K4(PWORK,ZINTER,KMASK)
+ CALL GATHER_AND_WRITE_MPI_K4(PWORK,PWORK2,KMASK)
ELSE
- CALL GATHER_AND_WRITE_MPI_K4(PWORK,ZINTER)
-ENDIF
-!
-IF (NRANK==NPIO) THEN
- PWORK2(:,:) = ZINTER(:,:)
+ CALL GATHER_AND_WRITE_MPI_K4(PWORK,PWORK2)
ENDIF
!
IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X2D',1,ZHOOK_HANDLE)
@@ -445,6 +513,37 @@ END SUBROUTINE GATHER_AND_WRITE_MPI_X2D
!
!**************************************************************************
!
+SUBROUTINE GATHER_AND_WRITE_MPI_X3D(PWORK,PWORK2,KMASK)
+!
+USE MODI_GATHER_AND_WRITE_MPI_K4
+!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWORK
+REAL(KIND=KIND(PWORK)), DIMENSION(:,:,:), INTENT(OUT) :: PWORK2
+INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D',0,ZHOOK_HANDLE)
+!
+IF (PRESENT(KMASK)) THEN
+ CALL GATHER_AND_WRITE_MPI_K4(PWORK,PWORK2,KMASK)
+ELSE
+ CALL GATHER_AND_WRITE_MPI_K4(PWORK,PWORK2)
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE GATHER_AND_WRITE_MPI_X3D
+!
+!**************************************************************************
+!
SUBROUTINE GATHER_AND_WRITE_MPI_X1DK4(PWORK,PWORK2,KMASK)
!
USE MODI_GATHER_AND_WRITE_MPI_K4
@@ -457,14 +556,15 @@ USE PARKIND1 ,ONLY : JPRB
IMPLICIT NONE
!
REAL, DIMENSION(:), INTENT(IN) :: PWORK
-REAL(KIND=4), DIMENSION(:), INTENT(OUT) :: PWORK2
+REAL(KIND=KIND(PWORK)/2), DIMENSION(:), INTENT(OUT) :: PWORK2
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
-REAL, DIMENSION(SIZE(PWORK2)) :: ZINTER
+REAL, DIMENSION(:), ALLOCATABLE :: ZINTER
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X1DK4',0,ZHOOK_HANDLE)
!
+ALLOCATE(ZINTER(SIZE(PWORK2)))
IF (PRESENT(KMASK)) THEN
CALL GATHER_AND_WRITE_MPI_K4(PWORK,ZINTER,KMASK)
ELSE
@@ -474,6 +574,7 @@ ENDIF
IF (NRANK==NPIO) THEN
PWORK2(:) = ZINTER(:)
ENDIF
+DEALLOCATE(ZINTER)
!
IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X1DK4',1,ZHOOK_HANDLE)
!
@@ -493,14 +594,15 @@ USE PARKIND1 ,ONLY : JPRB
IMPLICIT NONE
!
REAL, DIMENSION(:,:), INTENT(IN) :: PWORK
-REAL(KIND=4), DIMENSION(:,:), INTENT(OUT) :: PWORK2
+REAL(KIND=KIND(PWORK)/2), DIMENSION(:,:), INTENT(OUT) :: PWORK2
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
-REAL, DIMENSION(SIZE(PWORK2,1),SIZE(PWORK2,2)) :: ZINTER
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZINTER
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X2DK4',0,ZHOOK_HANDLE)
!
+ALLOCATE(ZINTER(SIZE(PWORK2,1),SIZE(PWORK2,2)))
IF (PRESENT(KMASK)) THEN
CALL GATHER_AND_WRITE_MPI_K4(PWORK,ZINTER,KMASK)
ELSE
@@ -510,6 +612,7 @@ ENDIF
IF (NRANK==NPIO) THEN
PWORK2(:,:) = ZINTER(:,:)
ENDIF
+DEALLOCATE(ZINTER)
!
IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X2DK4',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/gather_and_write_mpi_k4.F90 b/src/SURFEX/gather_and_write_mpi_k4.F90
index 426d94c097bd1da78385431233430643611e57fe..ddeace8a76b520008e22492a85becb10cf372cff 100644
--- a/src/SURFEX/gather_and_write_mpi_k4.F90
+++ b/src/SURFEX/gather_and_write_mpi_k4.F90
@@ -30,6 +30,15 @@ INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
END SUBROUTINE GATHER_AND_WRITE_MPI_X2D0
!
+SUBROUTINE GATHER_AND_WRITE_MPI_X3D0(PWORK,PWORK2,KMASK)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWORK
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWORK2
+!
+INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
+!
+END SUBROUTINE GATHER_AND_WRITE_MPI_X3D0
+!
END INTERFACE
!
END MODULE MODI_GATHER_AND_WRITE_MPI_K4
@@ -40,8 +49,7 @@ SUBROUTINE GATHER_AND_WRITE_MPI_X1D0(PWORK,PWORK2,KMASK)
!
USE MODD_SURFEX_MPI, ONLY : NINDEX, NPROC, NRANK, NCOMM, NPIO, NSIZE, &
XTIME_COMM_WRITE, XTIME_CALC_WRITE, &
- XTIME_OMP_BARR, IDX_W, WLOG_MPI
-USE MODD_SURFEX_OMP, ONLY : NINDX1SFX, NINDX2SFX, XWORK, XWORK_FULL
+ IDX_W, WLOG_MPI
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
@@ -62,6 +70,7 @@ REAL, DIMENSION(:), INTENT(OUT) :: PWORK2
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
REAL, DIMENSION(NSIZE) :: ZINTER
+REAL, DIMENSION(NSIZE) :: ZWORK
REAL :: XTIME0
!
#ifdef SFX_MPI
@@ -71,12 +80,12 @@ INTEGER :: ICPT
INTEGER :: I,J, IP1, IS1
INTEGER :: INFOMPI
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!
!
IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X1D0',0,ZHOOK_HANDLE)
!
-XWORK(NINDX1SFX:NINDX2SFX) = XUNDEF
+ZWORK(:) = XUNDEF
!
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
@@ -84,9 +93,9 @@ XTIME0 = MPI_WTIME()
!
IF (SIZE(PWORK)>0) THEN
IF (PRESENT(KMASK)) THEN
- CALL UNPACK_SAME_RANK(KMASK,PWORK,XWORK(NINDX1SFX:NINDX2SFX))
+ CALL UNPACK_SAME_RANK(KMASK,PWORK,ZWORK(:))
ELSE
- XWORK(NINDX1SFX:NINDX2SFX) = PWORK(:)
+ ZWORK(1:SIZE(PWORK)) = PWORK(:)
ENDIF
ENDIF
!
@@ -96,55 +105,34 @@ XTIME_CALC_WRITE = XTIME_CALC_WRITE + (MPI_WTIME() - XTIME0)
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP BARRIER
-!
-#ifdef SFX_MPI
-XTIME_OMP_BARR = XTIME_OMP_BARR + (MPI_WTIME() - XTIME0)
-#endif
-!
IF (NRANK/=NPIO) THEN
!
-!$OMP SINGLE
- !
IDX_W = IDX_W + 1
!
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
- CALL MPI_SEND(XWORK,SIZE(XWORK)*KIND(XWORK)/4,MPI_REAL,NPIO,IDX_W,NCOMM,INFOMPI)
+ CALL MPI_SEND(ZWORK,SIZE(ZWORK)*KIND(ZWORK)/4,MPI_REAL,NPIO,IDX_W,NCOMM,INFOMPI)
XTIME_COMM_WRITE = XTIME_COMM_WRITE + (MPI_WTIME() - XTIME0)
#endif
!
-!$OMP END SINGLE
- !
ELSE
!
- IP1 = SIZE(PWORK2)
- !
-!$OMP SINGLE
- !
- IS1 = SIZE(XWORK_FULL)
- !
- IF (IP1>IS1) THEN
- DEALLOCATE(XWORK_FULL)
- ALLOCATE(XWORK_FULL(IP1))
- ENDIF
- !
- XWORK_FULL(:) = 0.
- !
+ PWORK2(:) = 0.
+ !
IDX_W = IDX_W + 1
!
- DO I=1,NPROC
+ DO I=0,NPROC-1
!
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
#endif
!
- IF (I<NPROC) THEN
+ IF (I/=NPIO) THEN
#ifdef SFX_MPI
CALL MPI_RECV(ZINTER,SIZE(ZINTER)*KIND(ZINTER)/4,MPI_REAL,I,IDX_W,NCOMM,ISTATUS,INFOMPI)
#endif
ELSE
- ZINTER(1:SIZE(XWORK)) = XWORK(:)
+ ZINTER(:) = ZWORK(:)
ENDIF
!
#ifdef SFX_MPI
@@ -157,9 +145,9 @@ ELSE
!
DO J=1,SIZE(NINDEX)
!
- IF ( NINDEX(J)==MOD(I,NPROC) ) THEN
+ IF ( NINDEX(J)==I ) THEN
ICPT = ICPT + 1
- XWORK_FULL(J) = ZINTER(ICPT)
+ PWORK2(J) = ZINTER(ICPT)
ENDIF
!
ENDDO
@@ -170,10 +158,6 @@ ELSE
!
ENDDO
!
-!$OMP END SINGLE
- !
- PWORK2 = XWORK_FULL(1:IP1)
- !
ENDIF
!
@@ -188,9 +172,8 @@ SUBROUTINE GATHER_AND_WRITE_MPI_X2D0(PWORK,PWORK2,KMASK)
USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE MODD_SURFEX_MPI, ONLY : NINDEX, NPROC, NRANK, NCOMM, NPIO, NSIZE, &
- XTIME_COMM_WRITE, XTIME_OMP_BARR, &
+ XTIME_COMM_WRITE, &
XTIME_CALC_WRITE, IDX_W, WLOG_MPI
-USE MODD_SURFEX_OMP, ONLY : NINDX1SFX, NINDX2SFX, XWORK2, XWORK2_FULL, NBLOCK
!
USE MODI_UNPACK_SAME_RANK
!
@@ -209,6 +192,7 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PWORK2
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
REAL, DIMENSION(NSIZE,SIZE(PWORK2,2)) :: ZINTER
+REAL, DIMENSION(NSIZE,SIZE(PWORK,2)) :: ZWORK
REAL:: XTIME0
!
#ifdef SFX_MPI
@@ -218,24 +202,12 @@ INTEGER :: ICPT, IX2, IS1, IS2, IP1, IP2
INTEGER :: I,J
INTEGER :: INFOMPI
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!
!
IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X2D0',0,ZHOOK_HANDLE)
!
-IP2 = SIZE(PWORK,2)
-IX2 = SIZE(XWORK2,2)
-!
-!$OMP SINGLE
-!
-IF (IP2>IX2) THEN
- DEALLOCATE(XWORK2)
- ALLOCATE(XWORK2(NSIZE,IP2))
-ENDIF
-!
-!$OMP END SINGLE
-!
-XWORK2(NINDX1SFX:NINDX2SFX,1:IP2) = XUNDEF
+ZWORK(:,:) = XUNDEF
!
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
@@ -243,9 +215,9 @@ XTIME0 = MPI_WTIME()
!
IF (SIZE(PWORK,1)>0) THEN
IF (PRESENT(KMASK)) THEN
- CALL UNPACK_SAME_RANK(KMASK,PWORK,XWORK2(NINDX1SFX:NINDX2SFX,1:IP2))
+ CALL UNPACK_SAME_RANK(KMASK,PWORK,ZWORK(:,:))
ELSE
- XWORK2(NINDX1SFX:NINDX2SFX,1:IP2) = PWORK(:,:)
+ ZWORK(1:SIZE(PWORK,1),:) = PWORK(:,:)
ENDIF
ENDIF
!
@@ -255,56 +227,35 @@ XTIME_CALC_WRITE = XTIME_CALC_WRITE + (MPI_WTIME() - XTIME0)
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP BARRIER
-!
-#ifdef SFX_MPI
-XTIME_OMP_BARR = XTIME_OMP_BARR + (MPI_WTIME() - XTIME0)
-#endif
-!
IF (NRANK/=NPIO) THEN
!
-!$OMP SINGLE
- !
IDX_W = IDX_W + 1
!
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
- CALL MPI_SEND(XWORK2(:,1:IP2),NSIZE*IP2*KIND(XWORK2)/4,MPI_REAL,NPIO,IDX_W,NCOMM,INFOMPI)
+ CALL MPI_SEND(ZWORK(:,:),SIZE(ZWORK)*KIND(ZWORK)/4,MPI_REAL,NPIO,IDX_W,NCOMM,INFOMPI)
XTIME_COMM_WRITE = XTIME_COMM_WRITE + (MPI_WTIME() - XTIME0)
#endif
!
-!$OMP END SINGLE
- !
-ELSE
- !
- IP1 = SIZE(PWORK2,1)
- !
-!$OMP SINGLE
- !
- IS1 = SIZE(XWORK2_FULL,1)
- IS2 = SIZE(XWORK2_FULL,2)
- !
- IF (IP1>IS1 .OR. IP2>IS2) THEN
- DEALLOCATE(XWORK2_FULL)
- ALLOCATE(XWORK2_FULL(MAX(IP1,IS1),MAX(IP2,IS2)))
- ENDIF
+ELSEIF (NPROC>1) THEN
!
- XWORK2_FULL(1:IP1,1:IP2) = 0.
+ PWORK2(:,:) = 0.
!
IDX_W = IDX_W + 1
- !
- DO I=1,NPROC
+ !
+!!$OMP PARALLEL DO PRIVATE(I,ZINTER,ICPT,J,ISTATUS,INFOMPI,ZHOOK_HANDLE_OMP)
+ DO I=0,NPROC-1
!
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
#endif
!
- IF (I<NPROC) THEN
+ IF (I/=NPIO) THEN
#ifdef SFX_MPI
CALL MPI_RECV(ZINTER,SIZE(ZINTER)*KIND(ZINTER)/4,MPI_REAL,I,IDX_W,NCOMM,ISTATUS,INFOMPI)
#endif
ELSE
- ZINTER(:,:) = XWORK2(:,1:IP2)
+ ZINTER(:,:) = ZWORK(:,:)
ENDIF
! !
#ifdef SFX_MPI
@@ -317,9 +268,9 @@ ELSE
!
DO J=1,SIZE(NINDEX)
!
- IF ( NINDEX(J)==MOD(I,NPROC) ) THEN
+ IF ( NINDEX(J)==I ) THEN
ICPT = ICPT + 1
- XWORK2_FULL(J,1:IP2) = ZINTER(ICPT,:)
+ PWORK2(J,:) = ZINTER(ICPT,:)
ENDIF
!
ENDDO
@@ -329,10 +280,11 @@ ELSE
#endif
!
ENDDO
+!!$OMP END PARALLEL DO
!
-!$OMP END SINGLE
+ELSE
!
- PWORK2(:,:) = XWORK2_FULL(1:IP1,1:IP2)
+ PWORK2(:,:) = ZWORK(:,:)
!
ENDIF
!
@@ -342,3 +294,148 @@ IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X2D0',1,ZHOOK_HANDLE)
END SUBROUTINE GATHER_AND_WRITE_MPI_X2D0
!
!**************************************************************************
+!
+SUBROUTINE GATHER_AND_WRITE_MPI_X3D0(PWORK,PWORK2,KMASK)
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE MODD_SURFEX_MPI, ONLY : NINDEX, NPROC, NRANK, NCOMM, NPIO, NSIZE, &
+ XTIME_COMM_WRITE, &
+ XTIME_CALC_WRITE, IDX_W, WLOG_MPI
+!
+USE MODI_UNPACK_SAME_RANK
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWORK
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWORK2
+!
+INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
+!
+REAL, DIMENSION(NSIZE,SIZE(PWORK2,2),SIZE(PWORK2,3)) :: ZINTER
+REAL, DIMENSION(NSIZE,SIZE(PWORK,2),SIZE(PWORK,3)) :: ZWORK
+DOUBLE PRECISION :: XTIME0
+!
+#ifdef SFX_MPI
+INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+#endif
+INTEGER :: ICPT, IX2, IS1, IS2, IP1, IP2
+INTEGER :: I,J
+INTEGER :: INFOMPI
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
+!
+!
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D0_1',0,ZHOOK_HANDLE)
+!
+ZWORK(:,:,:) = XUNDEF
+!
+#ifdef SFX_MPI
+XTIME0 = MPI_WTIME()
+#endif
+!
+IF (SIZE(PWORK,1)>0) THEN
+ IF (PRESENT(KMASK)) THEN
+ CALL UNPACK_SAME_RANK(KMASK,PWORK(:,:,:),ZWORK(:,:,:))
+ ELSE
+ ZWORK(1:SIZE(PWORK,1),:,:) = PWORK(:,:,:)
+ ENDIF
+ENDIF
+!
+#ifdef SFX_MPI
+XTIME_CALC_WRITE = XTIME_CALC_WRITE + (MPI_WTIME() - XTIME0)
+!
+XTIME0 = MPI_WTIME()
+#endif
+!
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D0_1',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D0_2',0,ZHOOK_HANDLE)
+
+IF (NRANK/=NPIO) THEN
+ !
+ !
+ IDX_W = IDX_W + 1
+ !
+#ifdef SFX_MPI
+ XTIME0 = MPI_WTIME()
+ CALL MPI_SEND(ZWORK(:,:,:),SIZE(ZWORK)*KIND(ZWORK)/4,MPI_REAL,NPIO,IDX_W,NCOMM,INFOMPI)
+ XTIME_COMM_WRITE = XTIME_COMM_WRITE + (MPI_WTIME() - XTIME0)
+#endif
+ !
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D0_2',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D0_5',0,ZHOOK_HANDLE)
+ !
+ELSEIF (NPROC>1) THEN
+ !
+ PWORK2(:,:,:) = 0.
+ !
+ IDX_W = IDX_W + 1
+ !
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D0_2',1,ZHOOK_HANDLE)
+
+!!$OMP PARALLEL DO PRIVATE(I,ZINTER,ICPT,J,INFOMPI,ISTATUS,ZHOOK_HANDLE_OMP)
+ DO I=0,NPROC-1
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D0_3',0,ZHOOK_HANDLE_OMP)
+ !
+#ifdef SFX_MPI
+ XTIME0 = MPI_WTIME()
+#endif
+ !
+ IF (I/=NPIO) THEN
+#ifdef SFX_MPI
+ CALL MPI_RECV(ZINTER,SIZE(ZINTER)*KIND(ZINTER)/4,MPI_REAL,I,IDX_W,NCOMM,ISTATUS,INFOMPI)
+#endif
+ ELSE
+ ZINTER(:,:,:) = ZWORK(:,:,:)
+ ENDIF
+! !
+#ifdef SFX_MPI
+ XTIME_COMM_WRITE = XTIME_COMM_WRITE + (MPI_WTIME() - XTIME0)
+ !
+ XTIME0 = MPI_WTIME()
+#endif
+ !
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D0_3',1,ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D0_4',0,ZHOOK_HANDLE_OMP)
+
+ ICPT = 0
+ !
+ DO J=1,SIZE(NINDEX)
+ !
+ IF ( NINDEX(J)==I ) THEN
+ ICPT = ICPT + 1
+ PWORK2(J,:,:) = ZINTER(ICPT,:,:)
+ ENDIF
+ !
+ ENDDO
+ !
+#ifdef SFX_MPI
+ XTIME_CALC_WRITE = XTIME_CALC_WRITE + (MPI_WTIME() - XTIME0)
+#endif
+ !
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D0_4',1,ZHOOK_HANDLE_OMP)
+ ENDDO
+!!$OMP END PARALLEL DO
+ !
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D0_5',0,ZHOOK_HANDLE)
+ !
+ELSE
+ PWORK2(:,:,:) = ZWORK(:,:,:)
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D0_2',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D0_5',0,ZHOOK_HANDLE)
+
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D0_5',1,ZHOOK_HANDLE)
+!
+!
+END SUBROUTINE GATHER_AND_WRITE_MPI_X3D0
+!
+!**************************************************************************
diff --git a/src/SURFEX/gauss_index.F90 b/src/SURFEX/gauss_index.F90
deleted file mode 100644
index 841072f848294f98d87689a477f177b0370f2608..0000000000000000000000000000000000000000
--- a/src/SURFEX/gauss_index.F90
+++ /dev/null
@@ -1,11 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE GAUSS_INDEX
-! #####################################################################
-!!
-!!! to be suppressed
-!
-END SUBROUTINE GAUSS_INDEX
diff --git a/src/SURFEX/get_aosn.F90 b/src/SURFEX/get_aosn.F90
index 1451f0fda0f7c9bd0658639337e22d0f54f3d49c..2263f1cd46de9651e159d68ce2c8cab5b4505730 100644
--- a/src/SURFEX/get_aosn.F90
+++ b/src/SURFEX/get_aosn.F90
@@ -40,7 +40,7 @@
! ------------
!
!
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODI_GET_LUOUT
!
@@ -57,7 +57,7 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
INTEGER, INTENT(IN) :: KI ! horizontal dim. of cover
diff --git a/src/SURFEX/get_coordn.F90 b/src/SURFEX/get_coordn.F90
index 915897fbde0fe44b4db6de8f315ff4bf7f177166..46661d33159063bf2b13c362b80954e3877d6bca 100644
--- a/src/SURFEX/get_coordn.F90
+++ b/src/SURFEX/get_coordn.F90
@@ -74,16 +74,16 @@ IF (LHOOK) CALL DR_HOOK('GET_COORD_N',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!-------------------------------------------------------------------------------
!
-IF ( SIZE(PLON) /= SIZE(UG%XLON) .OR. SIZE(PLAT) /= SIZE(UG%XLAT) ) THEN
+IF ( SIZE(PLON) /= SIZE(UG%G%XLON) .OR. SIZE(PLAT) /= SIZE(UG%G%XLAT) ) THEN
WRITE(ILUOUT,*) 'try to get LON/LAT field from atmospheric model, but size is not correct'
WRITE(ILUOUT,*) 'size of field expected by the atmospheric model (PLON) :', SIZE(PLON)
WRITE(ILUOUT,*) 'size of field expected by the atmospheric model (PLAT) :', SIZE(PLAT)
- WRITE(ILUOUT,*) 'size of field in the surface (XLAT) :', SIZE(UG%XLAT)
- WRITE(ILUOUT,*) 'size of field in the surface (XLAT) :', SIZE(UG%XLAT)
+ WRITE(ILUOUT,*) 'size of field in the surface (XLAT) :', SIZE(UG%G%XLAT)
+ WRITE(ILUOUT,*) 'size of field in the surface (XLAT) :', SIZE(UG%G%XLAT)
CALL ABOR1_SFX('GET_COORDN: LON/LAT SIZE NOT CORRECT')
ELSE
- PLON = UG%XLON
- PLAT = UG%XLAT
+ PLON = UG%G%XLON
+ PLAT = UG%G%XLAT
END IF
IF (LHOOK) CALL DR_HOOK('GET_COORD_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/get_cpl_gcmn.F90 b/src/SURFEX/get_cpl_gcmn.F90
index 88b04d5dca4124318a0e4e2caf17dd51251e7bb3..ec34b7dbc80f9d10171072fd593139db7689a0d5 100644
--- a/src/SURFEX/get_cpl_gcmn.F90
+++ b/src/SURFEX/get_cpl_gcmn.F90
@@ -60,7 +60,7 @@ IMPLICIT NONE
!
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
INTEGER, INTENT(IN) :: KI ! number of points
!
REAL, DIMENSION(KI), INTENT(OUT) :: PRAIN ! total rainfall rate (kg/m2/s)
@@ -79,7 +79,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('GET_CPL_GCM_N',0,ZHOOK_HANDLE)
!
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
+CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
IF(LCPL_GCM) THEN
!
diff --git a/src/SURFEX/get_current_teb_patch.F90 b/src/SURFEX/get_current_teb_patch.F90
deleted file mode 100644
index d12a09cea449cecaebd2a8e66051bdb255a6daee..0000000000000000000000000000000000000000
--- a/src/SURFEX/get_current_teb_patch.F90
+++ /dev/null
@@ -1,10 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE GET_CURRENT_TEB_PATCH
-! #######################################################
-!
-!
-END SUBROUTINE GET_CURRENT_TEB_PATCH
diff --git a/src/SURFEX/get_default_namn.F90 b/src/SURFEX/get_default_namn.F90
index 9afa4cad57f4b3e0f97fdc84e34e48689c4d0667..91b684257796a17ecd77a04ab314cc4998d0b616 100644
--- a/src/SURFEX/get_default_namn.F90
+++ b/src/SURFEX/get_default_namn.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GET_DEFAULT_NAM_n(HPROGRAM,HACTION,KLUDES)
+ SUBROUTINE GET_DEFAULT_NAM_n(HPROGRAM,HACTION,KLUDES,ONAM_WRITTEN)
! #######################################################
!
!!**** *GET_DEFAULT_NAM* - routine to open a namelist file with new defaults in it
@@ -37,11 +37,12 @@
!* 0. DECLARATIONS
! ------------
!
-USE MODD_WRITE_SURF_ATM, ONLY : LNAM_WRITTEN
-!
#ifdef SFX_MNH
USE MODI_MNHGET_DESFM_n
#endif
+#ifdef SFX_ARO
+USE MODI_AROGET_DESFM_n
+#endif
!
USE MODI_GET_LUOUT
!
@@ -56,11 +57,13 @@ IMPLICIT NONE
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
CHARACTER(LEN=5), INTENT(IN) :: HACTION ! 'READ ', 'WRITE'
INTEGER, INTENT(OUT) :: KLUDES ! logical unit of .des file
+LOGICAL, INTENT(INOUT), OPTIONAL :: ONAM_WRITTEN
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.2 Declarations of local variables
! -------------------------------
!
+LOGICAL :: GNAM_WRITTEN
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('GET_DEFAULT_NAM_N',0,ZHOOK_HANDLE)
@@ -70,14 +73,25 @@ IF (HPROGRAM=='MESONH') THEN
IF (HACTION=='READ ' .AND. KLUDES.NE.0) REWIND(KLUDES)
#endif
ELSEIF (HPROGRAM=='AROME ') THEN
+ GNAM_WRITTEN = .TRUE.
+ IF (PRESENT(ONAM_WRITTEN)) GNAM_WRITTEN = ONAM_WRITTEN
#ifdef SFX_ARO
CALL AROGET_DESFM_n(HACTION,KLUDES)
#endif
+ IF (HACTION=='WRITE') THEN
+ IF (GNAM_WRITTEN) THEN
+ IF (PRESENT(ONAM_WRITTEN)) ONAM_WRITTEN = .FALSE.
+ ELSE
+ KLUDES = 0
+ ENDIF
+ ENDIF
ELSE
+ GNAM_WRITTEN = .TRUE.
+ IF (PRESENT(ONAM_WRITTEN)) GNAM_WRITTEN = ONAM_WRITTEN
KLUDES = 0
- IF (HACTION=='WRITE' .AND. LNAM_WRITTEN) THEN
+ IF (HACTION=='WRITE' .AND. GNAM_WRITTEN) THEN
CALL GET_LUOUT(HPROGRAM,KLUDES)
- LNAM_WRITTEN = .FALSE.
+ IF (PRESENT(ONAM_WRITTEN)) ONAM_WRITTEN = .FALSE.
ENDIF
END IF
IF (LHOOK) CALL DR_HOOK('GET_DEFAULT_NAM_N',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/get_dim_fulln.F90 b/src/SURFEX/get_dim_fulln.F90
index 0ca06a8a4a1683da32f541f044cc3463bfab7b95..acc66ebc15a7492fdd7ba5f55857ea6b690bb429 100644
--- a/src/SURFEX/get_dim_fulln.F90
+++ b/src/SURFEX/get_dim_fulln.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ########################################
- SUBROUTINE GET_DIM_FULL_n (U, &
- KDIM_FULL)
+ SUBROUTINE GET_DIM_FULL_n (KDIM_FULL_IN, KDIM_FULL_OUT)
! ########################################
!
!!**** *GET_DIM_FULL_n* - routine to get some ISBA fields
@@ -38,11 +37,6 @@
!* 0. DECLARATIONS
! ------------
!
-!
-!
-!
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -51,10 +45,8 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-!
-INTEGER, INTENT(OUT) :: KDIM_FULL ! total number of points
+INTEGER, INTENT(IN) :: KDIM_FULL_IN
+INTEGER, INTENT(OUT) :: KDIM_FULL_OUT ! total number of points
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
@@ -64,7 +56,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('GET_DIM_FULL_N',0,ZHOOK_HANDLE)
-KDIM_FULL = U%NDIM_FULL
+KDIM_FULL_OUT = KDIM_FULL_IN
IF (LHOOK) CALL DR_HOOK('GET_DIM_FULL_N',1,ZHOOK_HANDLE)
!
!==============================================================================
diff --git a/src/SURFEX/get_fluxn.F90 b/src/SURFEX/get_fluxn.F90
index cb83fbc567def8c42c4eb12b19609127df3fdc08..267012c91c1be3afba8503d486c08c57c8d1f24d 100644
--- a/src/SURFEX/get_fluxn.F90
+++ b/src/SURFEX/get_fluxn.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GET_FLUX_n (DGU, &
+ SUBROUTINE GET_FLUX_n (DGO, D, &
HPROGRAM,KI,PRN,PH,PLE,PLEI,PGFLUX,PT2M,PQ2M, &
PHU2M,PZON10M,PMER10M,PSURFLWNET,PSURFSWNET,PCD,&
PEVAP, PSUBL )
@@ -42,7 +42,7 @@
! ------------
!
!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
!
USE MODI_GET_LUOUT
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -57,9 +57,10 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
INTEGER, INTENT(IN) :: KI ! Number of points
REAL, DIMENSION(KI), INTENT(OUT) :: PRN ! Net radiation at surface (W/m2)
REAL, DIMENSION(KI), INTENT(OUT) :: PH ! Sensible heat flux (W/m2)
@@ -89,16 +90,16 @@ IF (LHOOK) CALL DR_HOOK('GET_FLUX_N',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!-------------------------------------------------------------------------------
!
-IF (DGU%LSURF_BUDGET) THEN
- PRN = DGU%XAVG_RN
- PH = DGU%XAVG_H
- PLE = DGU%XAVG_LE
- PLEI = DGU%XAVG_LEI
- PGFLUX = DGU%XAVG_GFLUX
- PSURFLWNET= DGU%XAVG_LWD-DGU%XAVG_LWU
- PSURFSWNET= DGU%XAVG_SWD-DGU%XAVG_SWU
- PEVAP = DGU%XAVG_EVAP
- PSUBL = DGU%XAVG_SUBL
+IF (DGO%LSURF_BUDGET) THEN
+ PRN = D%XRN
+ PH = D%XH
+ PLE = D%XLE
+ PLEI = D%XLEI
+ PGFLUX = D%XGFLUX
+ PSURFLWNET= D%XLWD-D%XLWU
+ PSURFSWNET= D%XSWD-D%XSWU
+ PEVAP = D%XEVAP
+ PSUBL = D%XSUBL
ELSE
PRN = XUNDEF
PH = XUNDEF
@@ -111,12 +112,12 @@ IF (DGU%LSURF_BUDGET) THEN
PSUBL = XUNDEF
ENDIF
!
-IF (DGU%N2M>0) THEN
- PT2M = DGU%XAVG_T2M
- PQ2M = DGU%XAVG_Q2M
- PHU2M = DGU%XAVG_HU2M
- PZON10M = DGU%XAVG_ZON10M
- PMER10M = DGU%XAVG_MER10M
+IF (DGO%N2M>0) THEN
+ PT2M = D%XT2M
+ PQ2M = D%XQ2M
+ PHU2M = D%XHU2M
+ PZON10M = D%XZON10M
+ PMER10M = D%XMER10M
ELSE
PT2M = XUNDEF
PQ2M = XUNDEF
@@ -125,8 +126,8 @@ IF (DGU%N2M>0) THEN
PMER10M = XUNDEF
ENDIF
!
-IF (DGU%LCOEF) THEN
- PCD = DGU%XAVG_CD
+IF (DGO%LCOEF) THEN
+ PCD = D%XCD
ELSE
PCD = XUNDEF
ENDIF
diff --git a/src/SURFEX/get_grid_coord.F90 b/src/SURFEX/get_grid_coord.F90
index 099d40a4a272713e39aa50fc3329358f625d5ab8..ba08f1aefe825b3cb734d31ae63e7f1084cec69e 100644
--- a/src/SURFEX/get_grid_coord.F90
+++ b/src/SURFEX/get_grid_coord.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GET_GRID_COORD (UG, U, &
+ SUBROUTINE GET_GRID_COORD (HGRID_IN, KGRID_PAR_IN, PGRID_PAR_IN, KSIZE_FULL, &
KLUOUT,PX,PY,KL,HGRID,PGRID_PAR)
! #######################################
!!
@@ -41,12 +41,6 @@
!* 0. DECLARATION
! -----------
!
-!
-!
-!
-USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -70,9 +64,11 @@ IMPLICIT NONE
!* 0.1 Declaration of dummy arguments
! ------------------------------
!
+ CHARACTER(LEN=10), INTENT(IN) :: HGRID_IN ! grid type
+INTEGER, INTENT(IN) :: KGRID_PAR_IN
+REAL, DIMENSION(:), INTENT(IN) :: PGRID_PAR_IN ! parameters defining this grid
!
-TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+INTEGER, INTENT(IN) :: KSIZE_FULL
!
INTEGER, INTENT(IN) :: KLUOUT ! output listing logical unit
REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PX ! X natural coordinate in the projection
@@ -103,11 +99,11 @@ IF (PRESENT(HGRID)) THEN
ALLOCATE(ZGRID_PAR(IGRID_PAR))
ZGRID_PAR = PGRID_PAR
ELSE
- YGRID = UG%CGRID
- IGRID_PAR = UG%NGRID_PAR
- IL = U%NSIZE_FULL
+ YGRID = HGRID_IN
+ IGRID_PAR = KGRID_PAR_IN
+ IL = KSIZE_FULL
ALLOCATE(ZGRID_PAR(IGRID_PAR))
- ZGRID_PAR = UG%XGRID_PAR
+ ZGRID_PAR = PGRID_PAR_IN
END IF
!
ALLOCATE(ZX(IL))
diff --git a/src/SURFEX/get_grid_dim_gauss.F90 b/src/SURFEX/get_grid_dim_gauss.F90
index 8990bb0dc8a4f3e1fefb5b99fa67e38c312a7aec..7a1e7261b00e1c1854178077ff03da967baf0541 100644
--- a/src/SURFEX/get_grid_dim_gauss.F90
+++ b/src/SURFEX/get_grid_dim_gauss.F90
@@ -48,11 +48,11 @@ REAL, DIMENSION(KGRID_PAR), INTENT(IN) :: PGRID_PAR ! grid parameters
LOGICAL, INTENT(OUT) :: ORECT ! T if rectangular grid
INTEGER, INTENT(OUT) :: KDIM1 ! 1st dimension
INTEGER, INTENT(OUT) :: KDIM2 ! 2nd dimension
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.2 Declaration of other local variables
! ------------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('GET_GRID_DIM_GAUSS',0,ZHOOK_HANDLE)
diff --git a/src/SURFEX/get_ign_maskall.F90 b/src/SURFEX/get_ign_maskall.F90
new file mode 100644
index 0000000000000000000000000000000000000000..9e10e85600e7dd77e62c4ac7accc76b4b523fb76
--- /dev/null
+++ b/src/SURFEX/get_ign_maskall.F90
@@ -0,0 +1,99 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+SUBROUTINE GET_IGN_MASKALL (UG, KNI, PX, PY, OTOT)
+! #######################################################
+!!**** *GET_IGN_MASKALL* -
+!!
+!! PURPOSE
+!! -------
+!!
+ !!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! S. Faroux *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/2010
+!! 07/2011 add specific computation for IGN grid (B. Decharme)
+!-------------------------------------------------------------------------------
+!
+!
+!
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+!
+#ifdef SFX_OL
+USE MODD_IO_SURF_OL, ONLY: NMASK_IGN
+#endif
+!
+USE MODE_GRIDTYPE_IGN
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+!
+INTEGER, INTENT(IN) :: KNI
+REAL,DIMENSION(:), INTENT(OUT) :: PX, PY
+LOGICAL, INTENT(IN), OPTIONAL :: OTOT
+!
+REAL, DIMENSION(KNI) :: ZXX, ZYY
+INTEGER :: JI, JJ, JK, JL
+LOGICAL :: GTOT
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('GET_IGN_MASKALL',0,ZHOOK_HANDLE)
+!
+GTOT = .TRUE.
+IF (PRESENT(OTOT)) GTOT = OTOT
+!
+IF (ASSOCIATED(UG%XGRID_FULL_PAR).AND.GTOT) THEN
+ CALL GET_GRIDTYPE_IGN(UG%XGRID_FULL_PAR,PX=ZXX,PY=ZYY,PXALL=PX,PYALL=PY)
+ENDIF
+IF (.NOT.GTOT .AND. ASSOCIATED(UG%G%XGRID_PAR)) THEN
+ IF (ASSOCIATED(UG%XGRID_FULL_PAR)) THEN
+ CALL GET_GRIDTYPE_IGN(UG%XGRID_FULL_PAR,PXALL=PX,PYALL=PY)
+ CALL GET_GRIDTYPE_IGN(UG%G%XGRID_PAR,PX=ZXX,PY=ZYY)
+ ELSE
+ CALL GET_GRIDTYPE_IGN(UG%G%XGRID_PAR,PX=ZXX,PY=ZYY,PXALL=PX,PYALL=PY)
+ ENDIF
+ENDIF
+!
+#ifdef SFX_OL
+IF (.NOT.ALLOCATED(NMASK_IGN))THEN
+ ALLOCATE(NMASK_IGN(KNI))
+ JL=0
+ DO JJ=1,SIZE(PY)
+ DO JI=1,SIZE(PX)
+ JL=JL+1
+ DO JK=1,KNI
+ IF((ZXX(JK)==PX(JI)).AND.(ZYY(JK)==PY(JJ)))THEN
+ NMASK_IGN(JK) = JL
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ENDIF
+#endif
+!
+IF (LHOOK) CALL DR_HOOK('GET_IGN_MASKALL',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE GET_IGN_MASKALL
diff --git a/src/SURFEX/get_iok_assim.F90 b/src/SURFEX/get_iok_assim.F90
index 0f96c4c1e406966acc3a2c31e1f701c1216d8fb0..c648ce13d8b9ccb63bbd3c985098c7fd91fd08b8 100644
--- a/src/SURFEX/get_iok_assim.F90
+++ b/src/SURFEX/get_iok_assim.F90
@@ -11,7 +11,7 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
- CHARACTER(LEN=LEN_HREC), INTENT(IN) :: HREC
+CHARACTER(LEN=LEN_HREC), INTENT(IN) :: HREC
INTEGER, INTENT(OUT) :: KOK
!
INTEGER :: ILEN
diff --git a/src/SURFEX/get_isba_confn.F90 b/src/SURFEX/get_isba_confn.F90
index c6a016ba528575763190a4ec75a7865e1c2545b4..03f36abecb6de45f18cae1daeba4e01070b55276 100644
--- a/src/SURFEX/get_isba_confn.F90
+++ b/src/SURFEX/get_isba_confn.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ########################################
- SUBROUTINE GET_ISBA_CONF_n (I, &
+ SUBROUTINE GET_ISBA_CONF_n (IO, KSNOW_LAYER_IN, &
HISBA, KPATCH,KGROUND_LAYER,KSNOW_LAYER,KNBIOMASS, &
KNLITTER, KNLITTLEVS, KNSOILCARB)
! ########################################
@@ -41,10 +41,7 @@
!* 0. DECLARATIONS
! ------------
!
-!
-!
-!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -55,9 +52,10 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(IN) :: IO
+INTEGER, INTENT(IN) :: KSNOW_LAYER_IN
!
- CHARACTER(LEN=3), INTENT(OUT) :: HISBA
+CHARACTER(LEN=3), INTENT(OUT) :: HISBA
INTEGER, INTENT(OUT) :: KPATCH ! number of patchs
INTEGER, INTENT(OUT) :: KGROUND_LAYER ! number of ground layers
INTEGER, INTENT(OUT) :: KSNOW_LAYER ! number of snow layers
@@ -74,14 +72,14 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('GET_ISBA_CONF_N',0,ZHOOK_HANDLE)
-HISBA = I%CISBA
-KPATCH = I%NPATCH
-KGROUND_LAYER = I%NGROUND_LAYER
-KSNOW_LAYER = I%TSNOW%NLAYER
-KNBIOMASS = I%NNBIOMASS
-KNLITTER = I%NNLITTER
-KNLITTLEVS = I%NNLITTLEVS
-KNSOILCARB = I%NNSOILCARB
+HISBA = IO%CISBA
+KPATCH = IO%NPATCH
+KGROUND_LAYER = IO%NGROUND_LAYER
+KSNOW_LAYER = KSNOW_LAYER_IN
+KNBIOMASS = IO%NNBIOMASS
+KNLITTER = IO%NNLITTER
+KNLITTLEVS = IO%NNLITTLEVS
+KNSOILCARB = IO%NNSOILCARB
IF (LHOOK) CALL DR_HOOK('GET_ISBA_CONF_N',1,ZHOOK_HANDLE)
!
!==============================================================================
diff --git a/src/SURFEX/get_latlonmaskn.F90 b/src/SURFEX/get_latlonmaskn.F90
index 35621a5978fc6c6f068615323cc0ae956edf5d78..72fe3308e2d6613c8d2918d57616dd4498a29d44 100644
--- a/src/SURFEX/get_latlonmaskn.F90
+++ b/src/SURFEX/get_latlonmaskn.F90
@@ -64,17 +64,16 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
IF (LHOOK) CALL DR_HOOK('GET_LATLONMASK_N',0,ZHOOK_HANDLE)
-UG%NGRID_PAR=SIZE(UG%XGRID_PAR)
-
- CALL LATLONMASK(UG%CGRID,UG%NGRID_PAR,UG%XGRID_PAR,OLATLONMASK)
+UG%NGRID_FULL_PAR=SIZE(UG%XGRID_FULL_PAR)
+ CALL LATLONMASK(UG%G%CGRID,UG%NGRID_FULL_PAR,UG%XGRID_FULL_PAR,OLATLONMASK)
!
-HGRID=UG%CGRID
+HGRID=UG%G%CGRID
!
-KGRID_PAR=UG%NGRID_PAR
+KGRID_PAR=UG%NGRID_FULL_PAR
!
ALLOCATE(PGRID_PAR(KGRID_PAR))
!
-PGRID_PAR(:)=UG%XGRID_PAR(:)
+PGRID_PAR(:)=UG%XGRID_FULL_PAR(:)
IF (LHOOK) CALL DR_HOOK('GET_LATLONMASK_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/get_lcovern.F90 b/src/SURFEX/get_lcovern.F90
index cc4e2cd86dc78f50c67d32ff8c7bf59cc8006625..fa77effb89b508d41ddf3a5cd3c33e7fa3c8dc5a 100644
--- a/src/SURFEX/get_lcovern.F90
+++ b/src/SURFEX/get_lcovern.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GET_LCOVER_n (U, &
- HPROGRAM,KCOVER,OCOVER)
+ SUBROUTINE GET_LCOVER_n (U,HPROGRAM,KCOVER,OCOVER)
! ########################################
!
!!**** *GET_LCOVER_n* - routine to get some surface fields
diff --git a/src/SURFEX/get_lonlatn.F90 b/src/SURFEX/get_lonlatn.F90
index f6a07911cc2ad8bea47d2bd64521d1676ebef909..95dd0091d4c6fffd62aba0c557939f960a3e3b95 100644
--- a/src/SURFEX/get_lonlatn.F90
+++ b/src/SURFEX/get_lonlatn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GET_LONLAT_n (YSC, &
- HPROGRAM)
+ SUBROUTINE GET_LONLAT_n (DTCO, U, UG, HSELECT, HPROGRAM)
! ####################################
!
!!**** *GET_LONLAT_n* - routine to get some surface fields
@@ -39,7 +38,9 @@
! ------------
!
!
-USE MODD_SURFEX_n, ONLY : SURFEX_t
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
!
USE MODI_GET_LUOUT
USE MODI_GET_COORD_n
@@ -60,7 +61,11 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(SURFEX_t), INTENT(INOUT) :: YSC
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+!
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
!
@@ -82,26 +87,21 @@ IF (LHOOK) CALL DR_HOOK('GET_LONLAT_N',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!-------------------------------------------------------------------------------
!
- CALL GET_SURF_SIZE_n(YSC%DTCO, YSC%U, &
- 'FULL', INI)
+ CALL GET_SURF_SIZE_n(DTCO, U, 'FULL', INI)
!
ALLOCATE(ZLON(INI))
ALLOCATE(ZLAT(INI))
!
- CALL GET_COORD_n(YSC%UG, &
- HPROGRAM,INI,ZLON,ZLAT)
+ CALL GET_COORD_n(UG, HPROGRAM,INI,ZLON,ZLAT)
!
CALL IO_BUFF_CLEAN
- CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
- HPROGRAM,'FULL ','SURF ','WRITE')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'FULL ','SURF ','WRITE')
!
YCOMMENT='XLON'
- CALL WRITE_SURF(YSC%DGU, YSC%U, &
- HPROGRAM,'XLON',ZLON(:),IRET,HCOMMENT=YCOMMENT,HDIR='A')
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'XLON',ZLON(:),IRET,HCOMMENT=YCOMMENT,HDIR='A')
!
YCOMMENT='XLAT'
- CALL WRITE_SURF(YSC%DGU, YSC%U, &
- HPROGRAM,'XLAT',ZLAT(:),IRET,HCOMMENT=YCOMMENT,HDIR='A')
+ CALL WRITE_SURF(HSELECT, HPROGRAM,'XLAT',ZLAT(:),IRET,HCOMMENT=YCOMMENT,HDIR='A')
!
CALL END_IO_SURF_n(HPROGRAM)
IF (LHOOK) CALL DR_HOOK('GET_LONLAT_N',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/get_luout.F90 b/src/SURFEX/get_luout.F90
index 4fb9d5a1585eb513dce7d9725eea29d010ec5446..41911175b7bbcfd0592f59230d85b976bbb44e45 100644
--- a/src/SURFEX/get_luout.F90
+++ b/src/SURFEX/get_luout.F90
@@ -48,9 +48,13 @@ USE MODI_LFIGET_LUOUT
#ifdef SFX_MNH
USE MODI_MNHGET_LUOUT
#endif
+#ifdef SFX_ARO
+USE MODI_AROGET_LUOUT
+#endif
!
IMPLICIT NONE
!
+!
!* 0.1 Declarations of arguments
! -------------------------
!
diff --git a/src/SURFEX/get_mesh_corner.F90 b/src/SURFEX/get_mesh_corner.F90
index 07ce145c69ff1a3bbcffbf6f476064c2562f6bc5..44732ebe12c8e9222a75f31f55c3060887cfdf13 100644
--- a/src/SURFEX/get_mesh_corner.F90
+++ b/src/SURFEX/get_mesh_corner.F90
@@ -37,6 +37,7 @@
!
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
!
+USE MODI_GET_MESH_CORNER_CARTESIAN
USE MODI_GET_MESH_CORNER_CONF_PROJ
USE MODI_GET_MESH_CORNER_GAUSS
USE MODI_GET_MESH_CORNER_IGN
@@ -77,22 +78,24 @@ IF (LHOOK) CALL DR_HOOK('GET_MESH_CORNER',0,ZHOOK_HANDLE)
IL = SIZE(PCORNER_LAT,1)
IC = SIZE(PCORNER_LAT,2)
!
-SELECT CASE (UG%CGRID)
+SELECT CASE (UG%G%CGRID)
!
CASE("LONLAT REG")
- CALL GET_MESH_CORNER_LONLAT_REG(UG%NGRID_PAR,IL,IC,UG%XGRID_PAR,PCORNER_LAT,PCORNER_LON)
+ CALL GET_MESH_CORNER_LONLAT_REG(UG%G%NGRID_PAR,IL,IC,UG%G%XGRID_PAR,PCORNER_LAT,PCORNER_LON)
+ CASE("CARTESIAN")
+ CALL GET_MESH_CORNER_CARTESIAN(UG%G%NGRID_PAR,IL,IC,UG%G%XGRID_PAR,PCORNER_LAT,PCORNER_LON)
CASE("CONF PROJ")
- CALL GET_MESH_CORNER_CONF_PROJ(UG%NGRID_PAR,IL,IC,UG%XGRID_PAR,PCORNER_LAT,PCORNER_LON)
+ CALL GET_MESH_CORNER_CONF_PROJ(UG%G%NGRID_PAR,IL,IC,UG%G%XGRID_PAR,PCORNER_LAT,PCORNER_LON)
CASE("GAUSS ")
- CALL GET_MESH_CORNER_GAUSS(UG%NGRID_PAR,IL,IC,UG%XGRID_PAR,PCORNER_LAT,PCORNER_LON)
+ CALL GET_MESH_CORNER_GAUSS(UG%G%NGRID_PAR,IL,IC,UG%G%XGRID_PAR,PCORNER_LAT,PCORNER_LON)
CASE("IGN ")
- CALL GET_MESH_CORNER_IGN(UG%NGRID_PAR,IL,IC,UG%XGRID_PAR,PCORNER_LAT,PCORNER_LON)
+ CALL GET_MESH_CORNER_IGN(UG%G%NGRID_PAR,IL,IC,UG%G%XGRID_PAR,PCORNER_LAT,PCORNER_LON)
CASE("LONLATVAL ")
- CALL GET_MESH_CORNER_LONLATVAL(UG%NGRID_PAR,IL,IC,UG%XGRID_PAR,PCORNER_LAT,PCORNER_LON)
+ CALL GET_MESH_CORNER_LONLATVAL(UG%G%NGRID_PAR,IL,IC,UG%G%XGRID_PAR,PCORNER_LAT,PCORNER_LON)
CASE DEFAULT
WRITE(KLUOUT,*) 'error in grid cell corner computations (routine GET_MESH_CORNER)'
WRITE(KLUOUT,*) 'It is impossible to retrieve geographical coordinates (latitude, longitude)'
- WRITE(KLUOUT,*) 'for the following grid type: CGRID = ', UG%CGRID
+ WRITE(KLUOUT,*) 'for the following grid type: CGRID = ', UG%G%CGRID
CALL ABOR1_SFX('GET_MESH_CORNER: IMPOSSIBLE TO CALCULATE GRID CELL CORNER')
!
END SELECT
diff --git a/src/SURFEX/get_mesh_corner_cartesian.F90 b/src/SURFEX/get_mesh_corner_cartesian.F90
new file mode 100644
index 0000000000000000000000000000000000000000..06020f1d1a729e7b4c74e872132983ba582e46a2
--- /dev/null
+++ b/src/SURFEX/get_mesh_corner_cartesian.F90
@@ -0,0 +1,106 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #######################################################################################
+ SUBROUTINE GET_MESH_CORNER_CARTESIAN(KGRID_PAR,KL,KC,PGRID_PAR,PCORNER_LAT,PCORNER_LON)
+! #######################################################################################
+!
+!!**** *GET_MESH_CORNER_CARTESIAN* get the grid mesh where point (lat,lon) is located
+!!
+!! PURPOSE
+!! -------
+!!
+!! AUTHOR
+!! ------
+!!
+!! B. Decharme Meteo-France
+!!
+!! MODIFICATION
+!! ------------
+!!
+!! Original 10/2013
+!!
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATION
+! -----------
+!
+USE MODE_GRIDTYPE_CARTESIAN
+!
+USE MODI_ABOR1_SFX
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
+INTEGER, INTENT(IN) :: KL ! number of points
+INTEGER, INTENT(IN) :: KC ! number of grid point corner
+REAL, DIMENSION(KGRID_PAR), INTENT(IN) :: PGRID_PAR ! grid parameters
+REAL, DIMENSION(KL,KC), INTENT(OUT) :: PCORNER_LAT ! Grid corner Latitude
+REAL, DIMENSION(KL,KC), INTENT(OUT) :: PCORNER_LON ! Grid corner Longitude
+!
+!* 0.2 Declaration of other local variables
+! ------------------------------------
+!
+INTEGER :: INI ! Number of point
+!
+REAL :: ZLAT0 ! reference latitude
+REAL :: ZLON0 ! reference longitude
+REAL, DIMENSION(KL) :: ZX ! X conformal coordinate
+REAL, DIMENSION(KL) :: ZY ! Y conformal coordinate
+REAL, DIMENSION(KL) :: ZDX ! size in X conformal coordinate
+REAL, DIMENSION(KL) :: ZDY ! size in Y conformal coordinate
+!
+REAL, DIMENSION(KL,KC) :: ZCX ! Grid corner in X
+REAL, DIMENSION(KL,KC) :: ZCY ! Grid corner in Y
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!----------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('GET_MESH_CORNER_CARTESIAN',0,ZHOOK_HANDLE)
+!
+!* 1. Gets parameters of the projection
+! ---------------------------------
+!
+CALL GET_GRIDTYPE_CARTESIAN(PGRID_PAR,KL=INI)
+!
+IF(KL/=INI)THEN
+ CALL ABOR1_SFX('GET_MESH_CORNER_CARTESIAN: WRONG NUMBER OF POINT')
+ENDIF
+!
+CALL GET_GRIDTYPE_CARTESIAN(PGRID_PAR,ZLAT0,ZLON0,PX=ZX,PY=ZY,PDX=ZDX,PDY=ZDY )
+!
+!* 2. grid cell corner (counterclockwise sense)
+! -----------------------------------------
+!
+! 4_______3
+! | |
+! | . |
+! | |
+! |_______|
+! 1 2
+!
+!
+ZCX(:,1) = ZX(:)-ZDX(:)/2.
+ZCY(:,1) = ZY(:)-ZDY(:)/2.
+!
+ZCX(:,3) = ZX(:)+ZDX(:)/2.
+ZCY(:,3) = ZY(:)+ZDY(:)/2.
+!
+ZCX(:,2) = ZCX(:,3)
+ZCY(:,2) = ZCY(:,1)
+!
+ZCX(:,4) = ZCX(:,1)
+ZCY(:,4) = ZCY(:,3)
+!
+IF (LHOOK) CALL DR_HOOK('GET_MESH_CORNER_CARTESIAN',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+END SUBROUTINE GET_MESH_CORNER_CARTESIAN
diff --git a/src/SURFEX/get_mesh_corner_conf_proj.F90 b/src/SURFEX/get_mesh_corner_conf_proj.F90
index c8aed70e03e9c96b71f32c1b5993b3c2c2c55742..3a180c601504a504726d3e481f1ba4e8b26af991 100644
--- a/src/SURFEX/get_mesh_corner_conf_proj.F90
+++ b/src/SURFEX/get_mesh_corner_conf_proj.F90
@@ -75,13 +75,13 @@ IF (LHOOK) CALL DR_HOOK('GET_MESH_CORNER_CONF_PROJ',0,ZHOOK_HANDLE)
!* 1. Gets parameters of the projection
! ---------------------------------
!
- CALL GET_GRIDTYPE_CONF_PROJ(PGRID_PAR,KL=INI)
+CALL GET_GRIDTYPE_CONF_PROJ(PGRID_PAR,KL=INI)
!
IF(KL/=INI)THEN
CALL ABOR1_SFX('GET_MESH_CORNER_CONF_PROJ: WRONG NUMBER OF POINT')
ENDIF
!
- CALL GET_GRIDTYPE_CONF_PROJ(PGRID_PAR,ZLAT0,ZLON0,ZRPK,ZBETA,ZLATOR, &
+CALL GET_GRIDTYPE_CONF_PROJ(PGRID_PAR,ZLAT0,ZLON0,ZRPK,ZBETA,ZLATOR, &
ZLONOR,PX=ZX,PY=ZY,PDX=ZDX,PDY=ZDY )
!
!* 2. grid cell corner (counterclockwise sense)
diff --git a/src/SURFEX/get_mesh_corner_gauss.F90 b/src/SURFEX/get_mesh_corner_gauss.F90
index a7623d865b767c12556bf8d5998a4658619cc24f..23d59e69cd0cbe430c1d62dc24ce4b2308fbb1fe 100644
--- a/src/SURFEX/get_mesh_corner_gauss.F90
+++ b/src/SURFEX/get_mesh_corner_gauss.F90
@@ -59,7 +59,7 @@ IF (LHOOK) CALL DR_HOOK('GET_MESH_CORNER_GAUSS',0,ZHOOK_HANDLE)
!* 1. Gets parameters of the projection
! ---------------------------------
!
- CALL GET_GRIDTYPE_GAUSS(PGRID_PAR,KL=INI)
+CALL GET_GRIDTYPE_GAUSS(PGRID_PAR,KL=INI)
!
IF(KL/=INI)THEN
CALL ABOR1_SFX('GET_MESH_CORNER_GAUSS: WRONG NUMBER OF POINT')
@@ -75,7 +75,7 @@ ENDIF
! |_______|
! 1 2
!
- CALL GET_GRIDTYPE_GAUSS(PGRID_PAR,PLONINF=PCORNER_LON(:,1), &
+CALL GET_GRIDTYPE_GAUSS(PGRID_PAR,PLONINF=PCORNER_LON(:,1), &
PLATINF=PCORNER_LAT(:,1), &
PLONSUP=PCORNER_LON(:,3), &
PLATSUP=PCORNER_LAT(:,3) )
diff --git a/src/SURFEX/get_mesh_corner_ign.F90 b/src/SURFEX/get_mesh_corner_ign.F90
index 7d1295a46a57709391640204abcd4e14cbf2279b..c3d3d3f2dabf98ddd3e459b7df9bb71618c6d708 100644
--- a/src/SURFEX/get_mesh_corner_ign.F90
+++ b/src/SURFEX/get_mesh_corner_ign.F90
@@ -69,13 +69,13 @@ IF (LHOOK) CALL DR_HOOK('GET_MESH_CORNER_IGN',0,ZHOOK_HANDLE)
!* 1. Gets parameters of the projection
! ---------------------------------
!
- CALL GET_GRIDTYPE_IGN(PGRID_PAR,KLAMBERT=ILAMBERT,KL=INI)
+CALL GET_GRIDTYPE_IGN(PGRID_PAR,KLAMBERT=ILAMBERT,KL=INI)
!
IF(KL/=INI)THEN
CALL ABOR1_SFX('GET_MESH_CORNER_IGN: WRONG NUMBER OF POINT')
ENDIF
!
- CALL GET_GRIDTYPE_IGN(PGRID_PAR,PX=ZX,PY=ZY,PDX=ZDX,PDY=ZDY)
+CALL GET_GRIDTYPE_IGN(PGRID_PAR,PX=ZX,PY=ZY,PDX=ZDX,PDY=ZDY)
!
!* 2. grid cell corner (counterclockwise sense)
! -----------------------------------------
diff --git a/src/SURFEX/get_mesh_corner_lonlat_reg.F90 b/src/SURFEX/get_mesh_corner_lonlat_reg.F90
index d8fbdbcba531e5631909021df848ffc26ddfded7..37c200f57b8e8dbcd022fd35e3df2b0c186b7324 100644
--- a/src/SURFEX/get_mesh_corner_lonlat_reg.F90
+++ b/src/SURFEX/get_mesh_corner_lonlat_reg.F90
@@ -69,13 +69,13 @@ IF (LHOOK) CALL DR_HOOK('GET_MESH_CORNER_LONLAT_REG',0,ZHOOK_HANDLE)
!* 1. Uncode parameters of the grid
! -----------------------------
!
- CALL GET_GRIDTYPE_LONLAT_REG(PGRID_PAR,ZLONMIN,ZLONMAX,ZLATMIN,ZLATMAX,ILON,ILAT,INI)
+CALL GET_GRIDTYPE_LONLAT_REG(PGRID_PAR,ZLONMIN,ZLONMAX,ZLATMIN,ZLATMAX,ILON,ILAT,INI)
!
IF(KL/=INI)THEN
CALL ABOR1_SFX('GET_MESH_CORNER_LONLAT_REG: WRONG NUMBER OF POINT')
ENDIF
!
- CALL GET_GRIDTYPE_LONLAT_REG(PGRID_PAR,PLON=ZLON,PLAT=ZLAT)
+CALL GET_GRIDTYPE_LONLAT_REG(PGRID_PAR,PLON=ZLON,PLAT=ZLAT)
!
ZDLON = (ZLONMAX-ZLONMIN) / FLOAT(ILON)
ZDLAT = (ZLATMAX-ZLATMIN) / FLOAT(ILAT)
diff --git a/src/SURFEX/get_mesh_corner_lonlaval.F90 b/src/SURFEX/get_mesh_corner_lonlaval.F90
index c58e24eac64ad67c9ee0a8a75448f36a56b6a3f1..56a3f9554679fbe64eb35af717fab4f2b56bfbf0 100644
--- a/src/SURFEX/get_mesh_corner_lonlaval.F90
+++ b/src/SURFEX/get_mesh_corner_lonlaval.F90
@@ -65,7 +65,7 @@ IF (LHOOK) CALL DR_HOOK('GET_MESH_CORNER_LONLATVAL',0,ZHOOK_HANDLE)
!* 1. Uncode parameters of the grid
! -----------------------------
!
- CALL GET_GRIDTYPE_LONLATVAL(PGRID_PAR,KL=INI,PX=ZLON,PY=ZLAT,PDX=ZDLON,PDY=ZDLAT)
+CALL GET_GRIDTYPE_LONLATVAL(PGRID_PAR,KL=INI,PX=ZLON,PY=ZLAT,PDX=ZDLON,PDY=ZDLAT)
!
IF(KL/=INI)THEN
CALL ABOR1_SFX('GET_GRIDTYPE_LONLATVAL: WRONG NUMBER OF POINT')
diff --git a/src/SURFEX/get_mesh_index.F90 b/src/SURFEX/get_mesh_index.F90
index d6fb5acf93bd61d16e23b170c72e1ba4a5200309..81bb52df7e1ceccf71222e1fdef78d4c254d601f 100644
--- a/src/SURFEX/get_mesh_index.F90
+++ b/src/SURFEX/get_mesh_index.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GET_MESH_INDEX(KLUOUT,KNBLINES,PLAT,PLON,KINDEX,PVALUE,PNODATA,KSSO,KISSOX,KISSOY)
+ SUBROUTINE GET_MESH_INDEX(UG,KLUOUT,KNBLINES,PLAT,PLON,KINDEX,PVALUE,PNODATA,KSSO,KISSOX,KISSOY)
! ##############################################################
!
!!**** *GET_MESH_INDEX* get the grid mesh where point (lat,lon) is located
@@ -33,7 +33,7 @@
!* 0. DECLARATION
! -----------
!
-USE MODD_PGD_GRID, ONLY : CGRID, XGRID_PAR, NGRID_PAR
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_POINT_OVERLAY
!
!
@@ -58,6 +58,8 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+!
INTEGER, INTENT(IN) :: KLUOUT ! output listing
INTEGER, INTENT(IN) :: KNBLINES
REAL, DIMENSION(:), INTENT(IN) :: PLAT ! latitude of the point
@@ -84,7 +86,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ------------
!
IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX',0,ZHOOK_HANDLE)
-SELECT CASE (CGRID)
+SELECT CASE (UG%G%CGRID)
!
CASE("CONF PROJ ","LONLAT REG","GAUSS ","IGN ","LONLATVAL ","LONLAT ROT")
IF (PRESENT(KSSO) .AND. PRESENT(KISSOX) .AND. PRESENT(KISSOY)) THEN
@@ -93,37 +95,37 @@ SELECT CASE (CGRID)
ISSO = 0
ENDIF
!
- IF (CGRID=="CONF PROJ ") THEN
- CALL GET_MESH_INDEX_CONF_PROJ(NGRID_PAR,ISSO,XGRID_PAR,PLAT,PLON,KINDEX,IISSOX,IISSOY)
+ IF (UG%G%CGRID=="CONF PROJ ") THEN
+ CALL GET_MESH_INDEX_CONF_PROJ(ISSO,UG%XGRID_FULL_PAR,PLAT,PLON,KINDEX,IISSOX,IISSOY)
ENDIF
- IF (CGRID=="LONLAT REG") THEN
+ IF (UG%G%CGRID=="LONLAT REG") THEN
IF (PRESENT(PVALUE) .AND. PRESENT(PNODATA)) THEN
- CALL GET_MESH_INDEX_LONLAT_REG(NGRID_PAR,ISSO,XGRID_PAR,PLAT,PLON,KINDEX,IISSOX,IISSOY, &
+ CALL GET_MESH_INDEX_LONLAT_REG(ISSO,UG%XGRID_FULL_PAR,PLAT,PLON,KINDEX,IISSOX,IISSOY, &
PVALUE,PNODATA)
ELSE
- CALL GET_MESH_INDEX_LONLAT_REG(NGRID_PAR,ISSO,XGRID_PAR,PLAT,PLON,KINDEX,IISSOX,IISSOY)
+ CALL GET_MESH_INDEX_LONLAT_REG(ISSO,UG%XGRID_FULL_PAR,PLAT,PLON,KINDEX,IISSOX,IISSOY)
ENDIF
ENDIF
- IF (CGRID=="GAUSS ") THEN
+ IF (UG%G%CGRID=="GAUSS ") THEN
IF (PRESENT(PVALUE) .AND. PRESENT(PNODATA)) THEN
- CALL GET_MESH_INDEX_GAUSS(KNBLINES,NGRID_PAR,ISSO,XGRID_PAR,PLAT,PLON,KINDEX,IISSOX,IISSOY, &
+ CALL GET_MESH_INDEX_GAUSS(KNBLINES,ISSO,UG%XGRID_FULL_PAR,PLAT,PLON,KINDEX,IISSOX,IISSOY, &
PVALUE,PNODATA)
ELSE
- CALL GET_MESH_INDEX_GAUSS(KNBLINES,NGRID_PAR,ISSO,XGRID_PAR,PLAT,PLON,KINDEX,IISSOX,IISSOY)
+ CALL GET_MESH_INDEX_GAUSS(KNBLINES,ISSO,UG%XGRID_FULL_PAR,PLAT,PLON,KINDEX,IISSOX,IISSOY)
ENDIF
ENDIF
- IF (CGRID=="IGN ") THEN
+ IF (UG%G%CGRID=="IGN ") THEN
IF (PRESENT(PVALUE) .AND. PRESENT(PNODATA)) THEN
- CALL GET_MESH_INDEX_IGN(NGRID_PAR,ISSO,XGRID_PAR,PLAT,PLON,KINDEX,IISSOX,IISSOY, &
+ CALL GET_MESH_INDEX_IGN(ISSO,UG%XGRID_FULL_PAR,PLAT,PLON,KINDEX,IISSOX,IISSOY, &
PVALUE,PNODATA)
ELSE
- CALL GET_MESH_INDEX_IGN(NGRID_PAR,ISSO,XGRID_PAR,PLAT,PLON,KINDEX,IISSOX,IISSOY)
+ CALL GET_MESH_INDEX_IGN(ISSO,UG%XGRID_FULL_PAR,PLAT,PLON,KINDEX,IISSOX,IISSOY)
ENDIF
ENDIF
- IF (CGRID=="LONLATVAL ") &
- CALL GET_MESH_INDEX_LONLATVAL(NGRID_PAR,ISSO,XGRID_PAR,PLAT,PLON,KINDEX,IISSOX,IISSOY)
- IF (CGRID=="LONLAT ROT") THEN
- CALL GET_MESH_INDEX_LONLAT_ROT(NGRID_PAR,SIZE(PLAT),XGRID_PAR,PLAT,PLON,KINDEX,ISSO,IISSOX,IISSOY)
+ IF (UG%G%CGRID=="LONLATVAL ") &
+ CALL GET_MESH_INDEX_LONLATVAL(ISSO,UG%XGRID_FULL_PAR,PLAT,PLON,KINDEX,IISSOX,IISSOY)
+ IF (UG%G%CGRID=="LONLAT ROT") THEN
+ CALL GET_MESH_INDEX_LONLAT_ROT(SIZE(PLAT),UG%XGRID_FULL_PAR,PLAT,PLON,KINDEX,ISSO,IISSOX,IISSOY)
ENDIF
!
IF (PRESENT(KSSO) .AND. PRESENT(KISSOX) .AND. PRESENT(KISSOY)) THEN
@@ -134,7 +136,7 @@ SELECT CASE (CGRID)
CASE DEFAULT
WRITE(KLUOUT,*) 'error in physiographic fields computations (routine GET_MESH_INDEX)'
WRITE(KLUOUT,*) 'It is impossible to retrieve geographical coordinates (latitude, longitude)'
- WRITE(KLUOUT,*) 'for the following grid type: CGRID = ', CGRID
+ WRITE(KLUOUT,*) 'for the following grid type: CGRID = ', UG%G%CGRID
CALL ABOR1_SFX('GET_MESH_INDEX: IMPOSSIBLE TO RETRIEVE GEOGRAPHICAL COORDINATES')
END SELECT
IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/get_mesh_index_conf_proj.F90 b/src/SURFEX/get_mesh_index_conf_proj.F90
index 49fb2377762a4242e472c3ba52ee427944692cd9..32b8f6dd66cbc170ed90b5ee416ab65b18134ff2 100644
--- a/src/SURFEX/get_mesh_index_conf_proj.F90
+++ b/src/SURFEX/get_mesh_index_conf_proj.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################
- SUBROUTINE GET_MESH_INDEX_CONF_PROJ(KGRID_PAR,KSSO,PGRID_PAR,PLAT,PLON,KINDEX,KISSOX,KISSOY)
+ SUBROUTINE GET_MESH_INDEX_CONF_PROJ(KSSO,PGRID_PAR,PLAT,PLON,KINDEX,KISSOX,KISSOY)
! ###############################################################
!
!!**** *GET_MESH_INDEX_CONF_PROJ* get the grid mesh where point (lat,lon) is located
@@ -43,7 +43,6 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
-INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
INTEGER, INTENT(IN) :: KSSO ! number of subgrid mesh in each direction
!
REAL, DIMENSION(:), INTENT(IN) :: PGRID_PAR ! grid parameters
diff --git a/src/SURFEX/get_mesh_index_gauss.F90 b/src/SURFEX/get_mesh_index_gauss.F90
index 813837145d3a5f4862635b341c82d8b0f0507088..254e4284ab244517c8db9ad1bd9632d9c097590c 100644
--- a/src/SURFEX/get_mesh_index_gauss.F90
+++ b/src/SURFEX/get_mesh_index_gauss.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################
- SUBROUTINE GET_MESH_INDEX_GAUSS(KNBLINES,KGRID_PAR,KSSO,PGRID_PAR,PLAT,PLON,&
+ SUBROUTINE GET_MESH_INDEX_GAUSS(KNBLINES,KSSO,PGRID_PAR,PLAT,PLON,&
KINDEX,KISSOX,KISSOY,PVALUE,PNODATA)
! ###############################################################
!
@@ -47,7 +47,6 @@ IMPLICIT NONE
! ------------------------
!
INTEGER, INTENT(IN) :: KNBLINES
-INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
INTEGER, INTENT(IN) :: KSSO ! number of subgrid mesh in each direction
REAL, DIMENSION(:), INTENT(IN) :: PGRID_PAR ! grid parameters
REAL, DIMENSION(:), INTENT(IN) :: PLAT ! latitude of the point (degrees)
@@ -69,12 +68,12 @@ REAL :: ZPC2
REAL :: ZNODATA
!
INTEGER, DIMENSION(SIZE(PLAT)) :: ICJ
-INTEGER :: ILGRID, ISIZE ! number of grid points
+INTEGER :: ILGRID, ISIZE_LON, ISIZE_DLAT, INBLINES ! number of grid points
INTEGER :: IFACTX, ISIZEX, ISIZEY
INTEGER :: JI, JJ, JL ! loop counter in x
INTEGER :: JGRID, IGRID0 ! loop counter on grid points
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!----------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_GAUSS_1',0,ZHOOK_HANDLE)
@@ -175,10 +174,24 @@ IF (.NOT. ALLOCATED(NNLOPA)) THEN
!
ENDIF
!
-ISIZE = SIZE(PLAT)/KNBLINES
+! case where the grid is not regular: all points are considered independently
+IF (KNBLINES==0) THEN
+ INBLINES = SIZE(PLAT)
+ELSE
+ INBLINES = KNBLINES
+ENDIF
+!
+ISIZE_DLAT = SIZE(PLAT)/INBLINES
+!
+! case where the grid is not regular: all points are considered independently
+IF (KNBLINES==0) THEN
+ ISIZE_LON = INBLINES
+ELSE
+ ISIZE_LON = ISIZE_DLAT
+ENDIF
!
IF (ALLOCATED(XLON)) THEN
- IF ( ISIZE/=SIZE(XLON) .OR. KNBLINES/=SIZE(XLAT) ) THEN
+ IF ( ISIZE_LON/=SIZE(XLON) .OR. INBLINES/=SIZE(XLAT) ) THEN
DEALLOCATE(XLON)
DEALLOCATE(XLAT)
DEALLOCATE(XCOST)
@@ -191,8 +204,8 @@ ENDIF
!
IF (.NOT.ALLOCATED(XLON)) THEN
!
- ALLOCATE(XLON(ISIZE))
- ALLOCATE(XLAT(KNBLINES))
+ ALLOCATE(XLON(ISIZE_LON))
+ ALLOCATE(XLAT(INBLINES))
!
ALLOCATE(XCOST (SIZE(XLAT)))
ALLOCATE(XSINTC(SIZE(XLAT)))
@@ -200,7 +213,7 @@ IF (.NOT.ALLOCATED(XLON)) THEN
ALLOCATE(XCOSN (SIZE(XLON)))
ALLOCATE(XSINN (SIZE(XLON)))
!
- XLON(:) = ANGLE_DOMAIN(PLON(1:ISIZE),DOM='0+',UNIT='D') * XDR
+ XLON(:) = ANGLE_DOMAIN(PLON(1:ISIZE_LON),DOM='0+',UNIT='D') * XDR
XCOSN(:) = COS(XLON(:)-XLONP)
XSINN(:) = SIN(XLON(:)-XLONP)
!
@@ -213,23 +226,20 @@ IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_GAUSS_2',0,ZHOOK_HANDLE)
!* 3. Projection of input points into pseudo coordinates
! --------------------------------------------------
!
-DO JJ=1,KNBLINES
- XLAT (JJ) = PLAT(JJ*ISIZE) * XDR
+DO JJ=1,INBLINES
+ XLAT (JJ) = PLAT(JJ*ISIZE_DLAT) * XDR
XSINTC(JJ) = SIN(XLAT(JJ)) * XCOSP
XSINTS(JJ) = SIN(XLAT(JJ)) * XSINP
XCOST (JJ) = COS(XLAT(JJ))
ENDDO
!
IF (LROTSTRETCH) THEN
- CALL XY_GAUSS(XCODIL,ISIZE,ZNODATA,ZVALUE,ZY,ZX)
+ CALL XY_GAUSS(XCODIL,ISIZE_DLAT,ISIZE_LON,ZNODATA,ZVALUE,ZY,ZX)
ELSE
ZX(:) = PLON(:)
ZY(:) = PLAT(:)
ENDIF
!
-IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_GAUSS_2',1,ZHOOK_HANDLE)
-IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_GAUSS_3',0,ZHOOK_HANDLE)
-!
!-------------------------------------------------------------------------------
!
!* 5. Localisation of the data points on (x,y) grid
@@ -238,7 +248,12 @@ IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_GAUSS_3',0,ZHOOK_HANDLE)
ICJ(:) = 0
!
IFACTX = SIZE(NFRACDX)
-!$OMP PARALLEL DO PRIVATE(JJ,JI,JGRID)
+!
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_GAUSS_2',1,ZHOOK_HANDLE)
+!
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_GAUSS_3',0,ZHOOK_HANDLE_OMP)
+!$OMP DO PRIVATE(JJ,JI,JGRID)
DO JL=1,SIZE(PLAT)
!
IF (ZVALUE(JL)==ZNODATA) CYCLE
@@ -272,12 +287,14 @@ DO JL=1,SIZE(PLAT)
ENDDO fracx
!
ENDDO
-!$OMP END PARALLEL DO
+!$OMP END DO
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_GAUSS_3',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
!
-IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_GAUSS_3',1,ZHOOK_HANDLE)
-IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_GAUSS_4',0,ZHOOK_HANDLE)
!
-!$OMP PARALLEL DO PRIVATE(IGRID0,JGRID,JI,JJ)
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_GAUSS_4',0,ZHOOK_HANDLE_OMP)
+!$OMP DO PRIVATE(IGRID0,JGRID,JI,JJ)
DO JL=1,SIZE(PLAT)
!
IF (ZVALUE(JL)==ZNODATA) CYCLE
@@ -313,26 +330,29 @@ DO JL=1,SIZE(PLAT)
END DO fracy
!
END DO
-!$OMP END PARALLEL DO
+!£$OMP END DO
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_GAUSS_4',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
!
-IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_GAUSS_4',1,ZHOOK_HANDLE)
-IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_GAUSS_5',0,ZHOOK_HANDLE)
!
!* 6. Localisation of the data points on in the subgrid of this mesh
! --------------------------------------------------------------
!
IF (KSSO/=0) THEN
-!$OMP PARALLEL DO
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_GAUSS_5',0,ZHOOK_HANDLE_OMP)
+!$OMP DO
DO JL=1,SIZE(PLAT)
IF (KINDEX(1,JL)/=0) THEN
KISSOX(1,JL) = 1 + INT( FLOAT(KSSO) * (ZX(JL)-XXINF(KINDEX(1,JL)))/(XXSUP(KINDEX(1,JL))-XXINF(KINDEX(1,JL))) )
KISSOY(1,JL) = 1 + INT( FLOAT(KSSO) * (ZY(JL)-XYINF(KINDEX(1,JL)))/(XYSUP(KINDEX(1,JL))-XYINF(KINDEX(1,JL))) )
ENDIF
ENDDO
-!$OMP END PARALLEL DO
+!$OMP END DO
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_GAUSS_5',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
ENDIF
!
-IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_GAUSS_5',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
END SUBROUTINE GET_MESH_INDEX_GAUSS
diff --git a/src/SURFEX/get_mesh_index_ign.F90 b/src/SURFEX/get_mesh_index_ign.F90
index c7a88385cc0c7ce38c5f2f7e6645e437b2eb1b20..2c7c7b27542a0f062d63974133b9aa789b33822c 100644
--- a/src/SURFEX/get_mesh_index_ign.F90
+++ b/src/SURFEX/get_mesh_index_ign.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################
- SUBROUTINE GET_MESH_INDEX_IGN(KGRID_PAR,KSSO,PGRID_PAR,PLAT,PLON,&
+ SUBROUTINE GET_MESH_INDEX_IGN(KSSO,PGRID_PAR,PLAT,PLON,&
KINDEX,KISSOX,KISSOY,PVALUE,PNODATA)
! ###############################################################
!
@@ -43,7 +43,6 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
-INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
INTEGER, INTENT(IN) :: KSSO ! number of subgrid mesh in each direction
REAL, DIMENSION(:), INTENT(IN) :: PGRID_PAR ! grid parameters
REAL, DIMENSION(:), INTENT(IN) :: PLAT ! latitude of the point
@@ -79,7 +78,7 @@ INTEGER :: JL ! loop counter in lambert grid
INTEGER :: JI, JJ ! loop counter on input points
INTEGER, DIMENSION(SIZE(PLAT),2) :: ICI
INTEGER, DIMENSION(1) :: IDX0
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!----------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_IGN_1',0,ZHOOK_HANDLE)
@@ -175,9 +174,6 @@ ENDDO
!* 5. Localisation of the data points on (x,y) grid
! ---------------------------------------------
!
-IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_IGN_2',1,ZHOOK_HANDLE)
-IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_IGN_3',0,ZHOOK_HANDLE)
-!
IFACT = SIZE(NFRACD) - 1
!
KINDEX(:,:)=0
@@ -186,7 +182,12 @@ KISSOX(:,:) = 0
KISSOY(:,:) = 0
!
ICI(:,:) = 0
-!$OMP PARALLEL DO PRIVATE(JL,JI,JJ)
+!
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_IGN_2',1,ZHOOK_HANDLE)
+!
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_IGN_3',0,ZHOOK_HANDLE_OMP)
+!$OMP DO PRIVATE(JL,JI,JJ)
DO JL=1,SIZE(PLAT)
!
IF (ZVALUE(JL)==ZNODATA) CYCLE
@@ -218,9 +219,10 @@ DO JL=1,SIZE(PLAT)
ENDDO frac
!
ENDDO
-!$OMP END PARALLEL DO
+!$OMP END DO
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_IGN_3',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
!
-IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_IGN_3',1,ZHOOK_HANDLE)
IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_IGN_4',0,ZHOOK_HANDLE)
!
DO JL=1,SIZE(PLAT)
@@ -251,10 +253,10 @@ DO JL=1,SIZE(PLAT)
!
ENDDO
!
-IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_IGN_4',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
DEALLOCATE(ZX )
DEALLOCATE(ZY )
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_IGN_4',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
END SUBROUTINE GET_MESH_INDEX_IGN
diff --git a/src/SURFEX/get_mesh_index_lonlat_reg.F90 b/src/SURFEX/get_mesh_index_lonlat_reg.F90
index a14a29949c3cc3285074bb343ac6dae0698a1b4a..d3ab7b2d9e5128a816b0818ac7b8bf0aeb8b9c2c 100644
--- a/src/SURFEX/get_mesh_index_lonlat_reg.F90
+++ b/src/SURFEX/get_mesh_index_lonlat_reg.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################
- SUBROUTINE GET_MESH_INDEX_LONLAT_REG(KGRID_PAR,KSSO,PGRID_PAR,PLAT,PLON,&
+ SUBROUTINE GET_MESH_INDEX_LONLAT_REG(KSSO,PGRID_PAR,PLAT,PLON,&
KINDEX,KISSOX,KISSOY,PVALUE,PNODATA)
! ###############################################################
!
@@ -27,9 +27,13 @@
!* 0. DECLARATION
! -----------
!
-USE MODD_GET_MESH_INDEX_LONLAT_REG, ONLY : XLONLIM, XLATLIM, NLAT, NLON, XLON0
+USE MODD_SURFEX_OMP, ONLY : NBLOCKTOT
+USE MODD_SURFEX_MPI, ONLY : NRANK
+USE MODD_GET_MESH_INDEX_LONLAT_REG, ONLY : XLONLIM, XLATLIM, NLAT, NLON, XLON0,&
+ NFRACDLAT, NFRACDLON
USE MODE_GRIDTYPE_LONLAT_REG
!
+USE MODD_POINT_OVERLAY, ONLY : NOVMX
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -39,7 +43,6 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
-INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
INTEGER, INTENT(IN) :: KSSO ! number of subgrid mesh in each direction
REAL, DIMENSION(:), INTENT(IN) :: PGRID_PAR ! grid parameters
REAL, DIMENSION(:), INTENT(IN) :: PLAT ! latitude of the point
@@ -73,7 +76,9 @@ REAL, DIMENSION(SIZE(PLON)) :: ZLON
!
INTEGER, DIMENSION(SIZE(PLAT)) :: ICI, ICJ
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+INTEGER :: IFACTLON, ISIZELON, IFACTLAT, ISIZELAT, ISIZE_OMP
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!
!----------------------------------------------------------------------------
!
@@ -93,7 +98,7 @@ IF (.NOT. ALLOCATED(XLATLIM)) THEN
! -----------------------------
!
CALL GET_GRIDTYPE_LONLAT_REG(PGRID_PAR,ZLONMIN,ZLONMAX, &
- ZLATMIN,ZLATMAX,NLON,NLAT )
+ ZLATMIN,ZLATMAX,NLON,NLAT )
!
!----------------------------------------------------------------------------
!
@@ -112,91 +117,158 @@ IF (.NOT. ALLOCATED(XLATLIM)) THEN
DO JI=1,NLAT+1
XLATLIM(JI) = ZLATMIN + FLOAT(JI-1)*ZDLAT
END DO
-!
+ !
XLON0 = 0.5*(ZLONMIN+ZLONMAX)
-!
+ !
+ IFACTLON = FLOOR(SQRT(FLOAT(NLON+1))) + 1
+ ISIZELON = FLOOR(FLOAT(NLON+1) / IFACTLON)
+ ALLOCATE(NFRACDLON(IFACTLON+1))
+ DO JJ=1,IFACTLON
+ NFRACDLON(JJ) = 1 + (JJ-1) * ISIZELON
+ ENDDO
+ NFRACDLON(IFACTLON+1) = NLON+1
+ !
+ IFACTLAT = FLOOR(SQRT(FLOAT(NLAT+1))) + 1
+ ISIZELAT = FLOOR(FLOAT(NLAT+1) / IFACTLAT)
+ ALLOCATE(NFRACDLAT(IFACTLAT+1))
+ DO JJ=1,IFACTLAT
+ NFRACDLAT(JJ) = 1 + (JJ-1) * ISIZELAT
+ ENDDO
+ NFRACDLAT(IFACTLAT+1) = NLAT+1
+ !
END IF
IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLAT_REG_1',1,ZHOOK_HANDLE)
-IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLAT_REG_2',0,ZHOOK_HANDLE)
!----------------------------------------------------------------------------
!
!* 3. Reshifts the longitudes with respect to projection reference point
! ------------------------------------------------------------------
!
!
-ZLON(:) = PLON(:)+NINT((XLON0-PLON(:))/360.)*360.
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLAT_REG_2',0,ZHOOK_HANDLE_OMP)
+!$OMP DO PRIVATE(JL)
+DO JL = 1,SIZE(PLON)
+ IF (PLON(JL)>=XLON0+360.) THEN
+ ZLON(JL) = PLON(JL) - 360.
+ ELSEIF (PLON(JL)<=XLON0-360.) THEN
+ ZLON(JL) = PLON(JL) + 360.
+ ELSE
+ ZLON(JL) = PLON(JL)
+ ENDIF
+ENDDO
+!$OMP END DO
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLAT_REG_2',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
+!
+!ZLON(JL) = PLON(JL)+NINT((XLON0-PLON(JL))/360.)*360.
!
!----------------------------------------------------------------------------
!
!* 4. Localisation of the data points on (x,y) grid
! ---------------------------------------------
!
-IF (SIZE(PLAT)/=NLON*NLAT) THEN
- KINDEX = 0
- KISSOX = 0
- KISSOY = 0
-END IF
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLAT_REG_2b',0,ZHOOK_HANDLE)
+!
+!IF (SIZE(PLAT)/=NLON*NLAT) THEN
+! KINDEX = 0
+! KISSOX = 0
+! KISSOY = 0
+!END IF
!
-IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLAT_REG_2',1,ZHOOK_HANDLE)
-IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLAT_REG_3',0,ZHOOK_HANDLE)
+IFACTLAT = SIZE(NFRACDLAT)-1
+IFACTLON = SIZE(NFRACDLON)-1
!
-ICI(:) = 0
-ICJ(:) = 0
-!$OMP PARALLEL DO PRIVATE(JL,JJ)
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLAT_REG_2b',1,ZHOOK_HANDLE)
+!
+ISIZE_OMP = MAX(1,SIZE(PLAT)/NBLOCKTOT)
+!
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLAT_REG_3',0,ZHOOK_HANDLE_OMP)
+!$OMP DO SCHEDULE(STATIC,ISIZE_OMP) PRIVATE(JL,JJ,JI)
DO JL=1,SIZE(PLAT)
+ !
+ ICI(JL) = 0
+ ICJ(JL) = 0
!
IF (ZVALUE(JL)==ZNODATA) CYCLE
- !
- DO JJ=SIZE(XLONLIM),1,-1
- IF (XLONLIM(JJ)<=ZLON(JL)) THEN
- ICI(JL) = JJ
- EXIT
- ENDIF
- ENDDO
- DO JJ=SIZE(XLATLIM),1,-1
- IF (XLATLIM(JJ)<=PLAT(JL)) THEN
- ICJ(JL) = JJ
- EXIT
+ !
+ IF ( ZLON(JL)<XLONLIM(1) .OR. ZLON(JL)>=XLONLIM(NLON+1) &
+ .OR. PLAT(JL)<XLATLIM(1) .OR. PLAT(JL)>=XLATLIM(NLAT+1) ) CYCLE
+ !
+ fraclat: &
+ DO JJ = IFACTLAT,1,-1
+ IF (PLAT(JL)>XLATLIM(NFRACDLAT(JJ))) THEN
+ DO JI = NFRACDLAT(JJ+1),NFRACDLAT(JJ)+1,-1
+ IF (PLAT(JL)>=XLATLIM(JI)) THEN
+ ICJ(JL) = JI
+ EXIT fraclat
+ ENDIF
+ ENDDO
+ ICJ(JL) = NFRACDLAT(JJ)
+ EXIT fraclat
ENDIF
- ENDDO
+ ENDDO fraclat
!
+ fraclon: &
+ DO JJ = IFACTLON,1,-1
+ IF (ZLON(JL)>XLONLIM(NFRACDLON(JJ))) THEN
+ DO JI = NFRACDLON(JJ+1),NFRACDLON(JJ)+1,-1
+ IF (ZLON(JL)>=XLONLIM(JI)) THEN
+ ICI(JL) = JI
+ EXIT fraclon
+ ENDIF
+ ENDDO
+ ICI(JL) = NFRACDLON(JJ)
+ EXIT fraclon
+ ENDIF
+ ENDDO fraclon
+ !
ENDDO
-!$OMP END PARALLEL DO
+!$OMP END DO
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLAT_REG_3',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
!
-IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLAT_REG_3',1,ZHOOK_HANDLE)
-IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLAT_REG_4',0,ZHOOK_HANDLE)
-!
-KINDEX(:,:) = 0
-
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLAT_REG_4',0,ZHOOK_HANDLE_OMP)
+!$OMP DO PRIVATE(JL,JI,JJ)
DO JL=1,SIZE(PLAT)
!
- IF (ZVALUE(JL)==ZNODATA) CYCLE
- !
- IF ( ZLON(JL)<XLONLIM(1) .OR. ZLON(JL)>=XLONLIM(NLON+1) &
- .OR. PLAT(JL)<XLATLIM(1) .OR. PLAT(JL)>=XLATLIM(NLAT+1) ) THEN
-
+ IF (NOVMX>1) KINDEX(2:NOVMX,JL) = 0
+ !
+ IF (ZVALUE(JL)==ZNODATA) THEN
+ !
+ KINDEX(1,JL) = 0
+ !
+ ELSEIF ( ICI(JL)==0 .OR. ICJ(JL)==0 ) THEN
+ !
+ KINDEX(1,JL) = 0
+ !
IF (KSSO/=0) THEN
KISSOX(1,JL) = 0
KISSOY(1,JL) = 0
- END IF
- CYCLE
-
- END IF
+ ENDIF
+ !
+ ELSE
- JI = ICI(JL)
- JJ = ICJ(JL)
- KINDEX(1,JL) = (JJ-1) * NLON + JI
+ JI = ICI(JL)
+ JJ = ICJ(JL)
+ KINDEX(1,JL) = (JJ-1) * NLON + JI
!
!
!* 6. Localisation of the data points on in the subgrid of this mesh
! --------------------------------------------------------------
!
- IF (KSSO/=0) THEN
- KISSOX(1,JL) = 1 + INT( FLOAT(KSSO) * (ZLON(JL)-XLONLIM(JI))/(XLONLIM(JI+1)-XLONLIM(JI)) )
- KISSOY(1,JL) = 1 + INT( FLOAT(KSSO) * (PLAT(JL)-XLATLIM(JJ))/(XLATLIM(JJ+1)-XLATLIM(JJ)) )
- END IF
+ IF (KSSO/=0) THEN
+ KISSOX(1,JL) = 1 + INT( FLOAT(KSSO) * (ZLON(JL)-XLONLIM(JI))/(XLONLIM(JI+1)-XLONLIM(JI)) )
+ KISSOY(1,JL) = 1 + INT( FLOAT(KSSO) * (PLAT(JL)-XLATLIM(JJ))/(XLATLIM(JJ+1)-XLATLIM(JJ)) )
+ END IF
+
+ ENDIF
+
END DO
-IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLAT_REG_4',1,ZHOOK_HANDLE)
+!$OMP END DO
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLAT_REG_4',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/get_mesh_index_lonlat_rot.F90 b/src/SURFEX/get_mesh_index_lonlat_rot.F90
index 97e0a1044106452ec14a053f35b2d89fcf069325..8af7a56e7a16abf396aac5f9d2c643e6362a0e14 100644
--- a/src/SURFEX/get_mesh_index_lonlat_rot.F90
+++ b/src/SURFEX/get_mesh_index_lonlat_rot.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################
- SUBROUTINE GET_MESH_INDEX_LONLAT_ROT(KGRID_PAR,KL,PGRID_PAR,PLAT,PLON,KINDEX,KSSO,KISSOX,KISSOY)
+ SUBROUTINE GET_MESH_INDEX_LONLAT_ROT(KL,PGRID_PAR,PLAT,PLON,KINDEX,KSSO,KISSOX,KISSOY)
! ###############################################################
!
!!**** *GET_MESH_INDEX_LONLAT_ROT* get the grid mesh where point (lat,lon) is located
@@ -43,9 +43,8 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
-INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
INTEGER, INTENT(IN) :: KL ! number of points
-REAL, DIMENSION(KGRID_PAR), INTENT(IN) :: PGRID_PAR ! grid parameters
+REAL, DIMENSION(:), INTENT(IN) :: PGRID_PAR ! grid parameters
REAL, DIMENSION(KL), INTENT(IN) :: PLAT ! latitude of the point
REAL, DIMENSION(KL), INTENT(IN) :: PLON ! longitude of the point
INTEGER, DIMENSION(KL), INTENT(OUT) :: KINDEX ! index of the grid mesh where the point is
diff --git a/src/SURFEX/get_mesh_index_lonlatval.F90 b/src/SURFEX/get_mesh_index_lonlatval.F90
index e512b25e822cd9d5dc47a864f32595b8f9958577..d7ecd3146a2a8ca9cf61f6a5af2a14d76dd60265 100644
--- a/src/SURFEX/get_mesh_index_lonlatval.F90
+++ b/src/SURFEX/get_mesh_index_lonlatval.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################
- SUBROUTINE GET_MESH_INDEX_LONLATVAL(KGRID_PAR,KSSO,PGRID_PAR,PLAT,PLON,KINDEX,KISSOX,KISSOY)
+ SUBROUTINE GET_MESH_INDEX_LONLATVAL(KSSO,PGRID_PAR,PLAT,PLON,KINDEX,KISSOX,KISSOY)
! ###############################################################
!
!!**** *GET_MESH_INDEX_LONLATVAL* get the grid mesh where point (lat,lon) is located
@@ -42,7 +42,6 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
-INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
INTEGER, INTENT(IN) :: KSSO ! number of subgrid mesh in each direction
REAL, DIMENSION(:), INTENT(IN) :: PGRID_PAR ! grid parameters
REAL, DIMENSION(:), INTENT(IN) :: PLAT ! latitude of the point
@@ -72,11 +71,11 @@ INTEGER, DIMENSION(1) :: IDX0
!
LOGICAL, DIMENSION(SIZE(PLAT)) :: GMASK
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!----------------------------------------------------------------------------
!
!
-IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLATVAL',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLATVAL_1',0,ZHOOK_HANDLE)
IF (.NOT. ALLOCATED(XXLIM)) THEN
!
!* 1. Uncode parameters of the grid
@@ -163,7 +162,12 @@ KISSOX(:,:) = 0
KISSOY(:,:) = 0
!
ICI(:,:) = 0
-!$OMP PARALLEL DO PRIVATE(JL,JI,JJ)
+!
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLATVAL_1',1,ZHOOK_HANDLE)
+!
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLATVAL_2',0,ZHOOK_HANDLE_OMP)
+!$OMP DO PRIVATE(JL,JI,JJ)
DO JL=1,SIZE(PLAT)
!
IF (GMASK(JL)) CYCLE
@@ -194,7 +198,11 @@ DO JL=1,SIZE(PLAT)
ENDDO frac
!
ENDDO
-!$OMP END PARALLEL DO
+!$OMP END DO
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLATVAL_2',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
+!
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLATVAL_3',0,ZHOOK_HANDLE)
!
DO JL=1,SIZE(PLAT)
!
@@ -223,7 +231,7 @@ DO JL=1,SIZE(PLAT)
!
ENDDO
!
-IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLATVAL',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('GET_MESH_INDEX_LONLATVAL_3',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
END SUBROUTINE GET_MESH_INDEX_LONLATVAL
diff --git a/src/SURFEX/get_near_meshes_cartesian.F90 b/src/SURFEX/get_near_meshes_cartesian.F90
index d280c929bfc1e4e46a72c0a7e5d2bc255a483401..4b7ab0efd735bbe2f3b9af53c32ac2c8d78a6580 100644
--- a/src/SURFEX/get_near_meshes_cartesian.F90
+++ b/src/SURFEX/get_near_meshes_cartesian.F90
@@ -34,6 +34,7 @@
!
USE MODE_GRIDTYPE_CARTESIAN
!
+USE MODD_SURFEX_MPI, ONLY : NINDEX, NRANK, NNUM
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -73,16 +74,18 @@ IF (IIMAX*IJMAX==KL) THEN
DO JI=1,IIMAX
ICOUNT = 0
JL = JI + IIMAX * (JJ-1)
- KNEAR(JL,:) = 0
- DO JX=-(IDIST-1)/2,IDIST/2
- DO JY=-(IDIST-1)/2,IDIST/2
- IF (JI+JX>0 .AND. JI+JX<IIMAX+1 .AND. JJ+JY>0 .AND. JJ+JY<IJMAX+1) THEN
- ICOUNT = ICOUNT + 1
- KNEAR(JL,ICOUNT) = (JI+JX) + IIMAX * (JJ+JY-1)
- END IF
+ IF (NINDEX(JL)==NRANK) THEN
+ KNEAR(NNUM(JL),:) = 0
+ DO JX=-(IDIST-1)/2,IDIST/2
+ DO JY=-(IDIST-1)/2,IDIST/2
+ IF (JI+JX>0 .AND. JI+JX<IIMAX+1 .AND. JJ+JY>0 .AND. JJ+JY<IJMAX+1) THEN
+ ICOUNT = ICOUNT + 1
+ KNEAR(NNUM(JL),ICOUNT) = (JI+JX) + IIMAX * (JJ+JY-1)
+ END IF
+ END DO
END DO
- END DO
- END DO
+ ENDIF
+ ENDDO
END DO
END IF
IF (LHOOK) CALL DR_HOOK('GET_NEAR_MESHES_CARTESIAN',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/get_near_meshes_conf_proj.F90 b/src/SURFEX/get_near_meshes_conf_proj.F90
index 55c3c7171c69a9967ebc80de091968c1130dc818..078b9765292cf27b9f9c3a2aee65f82e9ad3aee8 100644
--- a/src/SURFEX/get_near_meshes_conf_proj.F90
+++ b/src/SURFEX/get_near_meshes_conf_proj.F90
@@ -32,6 +32,8 @@
!* 0. DECLARATION
! -----------
!
+USE MODD_SURFEX_MPI, ONLY : NINDEX, NRANK, NNUM
+!
USE MODE_GRIDTYPE_CONF_PROJ
!
!
@@ -73,15 +75,17 @@ IF (IIMAX*IJMAX==KL) THEN
DO JI=1,IIMAX
ICOUNT = 0
JL = JI + IIMAX * (JJ-1)
- KNEAR(JL,:) = 0
- DO JX=-(IDIST-1)/2,IDIST/2
- DO JY=-(IDIST-1)/2,IDIST/2
- IF (JI+JX>0 .AND. JI+JX<IIMAX+1 .AND. JJ+JY>0 .AND. JJ+JY<IJMAX+1) THEN
- ICOUNT = ICOUNT + 1
- KNEAR(JL,ICOUNT) = (JI+JX) + IIMAX * (JJ+JY-1)
- END IF
+ IF (NINDEX(JL)==NRANK) THEN
+ KNEAR(NNUM(JL),:) = 0
+ DO JX=-(IDIST-1)/2,IDIST/2
+ DO JY=-(IDIST-1)/2,IDIST/2
+ IF (JI+JX>0 .AND. JI+JX<IIMAX+1 .AND. JJ+JY>0 .AND. JJ+JY<IJMAX+1) THEN
+ ICOUNT = ICOUNT + 1
+ KNEAR(NNUM(JL),ICOUNT) = (JI+JX) + IIMAX * (JJ+JY-1)
+ END IF
+ END DO
END DO
- END DO
+ ENDIF
END DO
END DO
END IF
diff --git a/src/SURFEX/get_near_meshes_gauss.F90 b/src/SURFEX/get_near_meshes_gauss.F90
index cee0fc6b5ea6d5007cdc65b1111edb8812ad4097..050bdd8cbed179619ca070233d836738da975222 100644
--- a/src/SURFEX/get_near_meshes_gauss.F90
+++ b/src/SURFEX/get_near_meshes_gauss.F90
@@ -33,6 +33,9 @@
! -----------
!
!
+USE MODE_GRIDTYPE_GAUSS
+!
+USE MODD_SURFEX_MPI, ONLY : NINDEX, NRANK, NNUM
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -47,15 +50,54 @@ INTEGER, INTENT(IN) :: KL ! number of points
INTEGER, INTENT(IN) :: KNEAR_NBR ! number of nearest points wanted
REAL, DIMENSION(KGRID_PAR), INTENT(IN) :: PGRID_PAR ! grid parameters
INTEGER, DIMENSION(:,:),POINTER :: KNEAR ! near mesh indices
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.2 Declaration of other local variables
! ------------------------------------
!
+REAL, DIMENSION(KL) :: ZDIS
+REAL,DIMENSION(KL) :: ZLON
+REAL,DIMENSION(KL) :: ZLAT
+REAL :: ZDMAX
+INTEGER :: ID0
+INTEGER :: JP1, JP2, JN, IL
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('GET_NEAR_MESHES_GAUSS',0,ZHOOK_HANDLE)
+!
+ CALL GET_GRIDTYPE_GAUSS(PGRID_PAR,KL=IL,PLON_XY=ZLON,PLAT_XY=ZLAT)
+!
KNEAR (:,:) = 0
+!
+! calcul de la distance de tous les points 2 Ã 2
+!
+ZDIS = 1.E20
+!
+DO JP1=1,KL
+ !
+ IF (NINDEX(JP1)==NRANK) THEN
+ !
+ DO JP2=1,KL
+ ZDIS(JP2) = SQRT((ZLON(JP1)-ZLON(JP2))**2+(ZLAT(JP1)-ZLAT(JP2))**2)
+ ENDDO
+ ZDMAX = MAXVAL(ZDIS(:)) + 1.
+ ZDIS(JP1) = ZDMAX
+ !
+ ! on prend les knear_nbr premiers, pour chaque
+ !
+ DO JN=1,MIN(KL-1,KNEAR_NBR)
+ !
+ ID0 = MAXVAL(MINLOC(ZDIS(:)))
+ !
+ KNEAR(NNUM(JP1),JN) = ID0
+ ZDIS(ID0) = ZDMAX
+ !
+ ENDDO
+ !
+ ENDIF
+ !
+ENDDO
+!
IF (LHOOK) CALL DR_HOOK('GET_NEAR_MESHES_GAUSS',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/get_near_meshes_ign.F90 b/src/SURFEX/get_near_meshes_ign.F90
index 11b8ac29b7f8304d71eb2bb750bc38e15ccf8856..09cab7547cb5c18ccce31be8a2cc44957c50cbd5 100644
--- a/src/SURFEX/get_near_meshes_ign.F90
+++ b/src/SURFEX/get_near_meshes_ign.F90
@@ -38,6 +38,7 @@
!* 0. DECLARATION
! -----------
!
+USE MODD_SURFEX_MPI, ONLY : NINDEX, NRANK, NNUM
USE MODE_GRIDTYPE_IGN
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -66,7 +67,7 @@ INTEGER,DIMENSION(KL) :: INDZDIS
REAL :: ZMAXVALDIS
-INTEGER :: ISIZE, JP
+INTEGER :: JP, ID, ISIZE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!----------------------------------------------------------------------------
@@ -85,10 +86,14 @@ ISIZE = MIN(KNEAR_NBR,KL)
IF (LHOOK) CALL DR_HOOK('GET_NEAR_MESHES_IGN_1',1,ZHOOK_HANDLE)
IF (LHOOK) CALL DR_HOOK('GET_NEAR_MESHES_IGN_2',0,ZHOOK_HANDLE)
!
-!$OMP PARALLEL DO PRIVATE(JP,ZDIS,ZMAXVALDIS,INDZDIS)
+!$OMP PARALLEL DO PRIVATE(JP,ZDIS,ZMAXVALDIS,INDZDIS,ID)
!
DO JP=1,KL
!
+ IF (NINDEX(JP)==NRANK) THEN
+ !
+ ID = NNUM(JP)
+ !
! distance du point JP Ã tous les autres points
ZDIS(:) = SQRT((ZX(:)-ZX(JP))**2 + (ZY(:)-ZY(JP))**2)
! distance maximale entre JP et les autres moints
@@ -96,14 +101,16 @@ DO JP=1,KL
ZDIS(JP) = ZMAXVALDIS
CALL QUICK_SORT(ZDIS, INDZDIS)
- KNEAR(JP,1:ISIZE) = INDZDIS(1:ISIZE)
+ KNEAR(ID,1:ISIZE) = INDZDIS(1:ISIZE)
+ !
+ ENDIF
!
ENDDO
!$OMP END PARALLEL DO
!
IF (LHOOK) CALL DR_HOOK('GET_NEAR_MESHES_IGN_2',1,ZHOOK_HANDLE)
!
- CONTAINS
+CONTAINS
!
RECURSIVE SUBROUTINE QUICK_SORT(PLIST, KORDER)
@@ -125,7 +132,7 @@ DO JI = 1, SIZE(PLIST)
KORDER(JI) = JI
END DO
- CALL QUICK_SORT_1(1, SIZE(PLIST), PLIST, KORDER)
+CALL QUICK_SORT_1(1, SIZE(PLIST), PLIST, KORDER)
END SUBROUTINE QUICK_SORT
diff --git a/src/SURFEX/get_near_meshes_lonlat_reg.F90 b/src/SURFEX/get_near_meshes_lonlat_reg.F90
index a3b150b74ad8072fa6a949bf566751e985d3560a..24f431a9c207ca3981192c23f286615b52b2fbb0 100644
--- a/src/SURFEX/get_near_meshes_lonlat_reg.F90
+++ b/src/SURFEX/get_near_meshes_lonlat_reg.F90
@@ -32,8 +32,9 @@
!* 0. DECLARATION
! -----------
!
-USE MODE_GRIDTYPE_LONLAT_REG
+USE MODD_SURFEX_MPI, ONLY : NINDEX, NRANK, NNUM
!
+USE MODE_GRIDTYPE_LONLAT_REG
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -74,15 +75,17 @@ IF (ILON*ILAT==KL) THEN
DO JLON=1,ILON
ICOUNT = 0
JL = JLON + ILON * (JLAT-1)
- KNEAR(JL,:) = 0
- DO JX=-(IDIST-1)/2,IDIST/2
- DO JY=-(IDIST-1)/2,IDIST/2
- IF (JLON+JX>0 .AND. JLON+JX<ILON+1 .AND. JLAT+JY>0 .AND. JLAT+JY<ILAT+1) THEN
- ICOUNT = ICOUNT + 1
- KNEAR(JL,ICOUNT) = (JLON+JX) + ILON * (JLAT+JY-1)
- END IF
+ IF (NINDEX(JL)==NRANK) THEN
+ KNEAR(NNUM(JL),:) = 0
+ DO JX=-(IDIST-1)/2,IDIST/2
+ DO JY=-(IDIST-1)/2,IDIST/2
+ IF (JLON+JX>0 .AND. JLON+JX<ILON+1 .AND. JLAT+JY>0 .AND. JLAT+JY<ILAT+1) THEN
+ ICOUNT = ICOUNT + 1
+ KNEAR(NNUM(JL),ICOUNT) = (JLON+JX) + ILON * (JLAT+JY-1)
+ END IF
+ END DO
END DO
- END DO
+ ENDIF
END DO
END DO
END IF
diff --git a/src/SURFEX/get_near_meshes_lonlat_rot.F90 b/src/SURFEX/get_near_meshes_lonlat_rot.F90
index a3e76f9a81834392bbf5b30ed2699128effc1a9c..d64d40691f0db3813eb85e67882b1e8018263245 100644
--- a/src/SURFEX/get_near_meshes_lonlat_rot.F90
+++ b/src/SURFEX/get_near_meshes_lonlat_rot.F90
@@ -34,6 +34,7 @@
!
USE MODE_GRIDTYPE_LONLAT_ROT
!
+USE MODD_SURFEX_MPI, ONLY : NINDEX, NRANK, NNUM
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -74,15 +75,17 @@ IF (ILON*ILAT==KL) THEN
DO JLON=1,ILON
ICOUNT = 0
JL = JLON + ILON * (JLAT-1)
- KNEAR(JL,:) = 0
- DO JX=-(IDIST-1)/2,IDIST/2
- DO JY=-(IDIST-1)/2,IDIST/2
- IF (JLON+JX>0 .AND. JLON+JX<ILON+1 .AND. JLAT+JY>0 .AND. JLAT+JY<ILAT+1) THEN
- ICOUNT = ICOUNT + 1
- KNEAR(JL,ICOUNT) = (JLON+JX) + ILON * (JLAT+JY-1)
- END IF
+ IF (NINDEX(JL)==NRANK) THEN
+ KNEAR(NNUM(JL),:) = 0
+ DO JX=-(IDIST-1)/2,IDIST/2
+ DO JY=-(IDIST-1)/2,IDIST/2
+ IF (JLON+JX>0 .AND. JLON+JX<ILON+1 .AND. JLAT+JY>0 .AND. JLAT+JY<ILAT+1) THEN
+ ICOUNT = ICOUNT + 1
+ KNEAR(NNUM(JL),ICOUNT) = (JLON+JX) + ILON * (JLAT+JY-1)
+ END IF
+ END DO
END DO
- END DO
+ END IF
END DO
END DO
END IF
diff --git a/src/SURFEX/get_near_meshes_lonlatval.F90 b/src/SURFEX/get_near_meshes_lonlatval.F90
index bdd082ac61c59cf9e50d45b0cf60329fe9e02c93..f598a4c3d895fa09f7473222180e99a447392fb6 100644
--- a/src/SURFEX/get_near_meshes_lonlatval.F90
+++ b/src/SURFEX/get_near_meshes_lonlatval.F90
@@ -34,6 +34,7 @@
!
USE MODE_GRIDTYPE_LONLATVAL
!
+USE MODD_SURFEX_MPI, ONLY : NINDEX, NRANK, NNUM
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -76,22 +77,26 @@ ZDIS = 1.E20
!
DO JP1=1,KL
!
- DO JP2=1,KL
- ZDIS(JP2) = SQRT((ZX(JP1)-ZX(JP2))**2+(ZY(JP1)-ZY(JP2))**2)
- ENDDO
- ZDMAX = MAXVAL(ZDIS(:)) + 1.
- ZDIS(JP1) = ZDMAX
- !
- ! on prend les knear_nbr premiers, pour chaque
- !
- DO JN=1,MIN(KL-1,KNEAR_NBR)
+ IF (NINDEX(JP1)==NRANK) THEN
+ !
+ DO JP2=1,KL
+ ZDIS(JP2) = SQRT((ZX(JP1)-ZX(JP2))**2+(ZY(JP1)-ZY(JP2))**2)
+ ENDDO
+ ZDMAX = MAXVAL(ZDIS(:)) + 1.
+ ZDIS(JP1) = ZDMAX
!
- ID0 = MAXVAL(MINLOC(ZDIS(:)))
+ ! on prend les knear_nbr premiers, pour chaque
!
- KNEAR(JP1,JN) = ID0
- ZDIS(ID0) = ZDMAX
+ DO JN=1,MIN(KL-1,KNEAR_NBR)
+ !
+ ID0 = MAXVAL(MINLOC(ZDIS(:)))
+ !
+ KNEAR(NNUM(JP1),JN) = ID0
+ ZDIS(ID0) = ZDMAX
+ !
+ ENDDO
!
- ENDDO
+ ENDIF
!
ENDDO
!
diff --git a/src/SURFEX/get_prep_interp.F90 b/src/SURFEX/get_prep_interp.F90
new file mode 100644
index 0000000000000000000000000000000000000000..16c85010d2125310c0c2b98dac03740df05baaf5
--- /dev/null
+++ b/src/SURFEX/get_prep_interp.F90
@@ -0,0 +1,122 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+SUBROUTINE GET_PREP_INTERP(KNP_IN,KNP_OUT,PVEGTYPE,PPATCH_IN,PPATCH_OUT,KMASK_IN)
+!
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
+!
+USE MODI_VEGTYPE_TO_PATCH
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KNP_IN
+INTEGER, INTENT(IN) :: KNP_OUT
+REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE
+REAL, DIMENSION(:,:), INTENT(IN) :: PPATCH_IN
+REAL, DIMENSION(:,:), INTENT(OUT) :: PPATCH_OUT
+INTEGER, DIMENSION(:,:), INTENT(IN), OPTIONAL :: KMASK_IN
+!
+INTEGER, DIMENSION(SIZE(PPATCH_OUT,1),SIZE(PPATCH_IN,2)) :: IMASK_IN
+REAL, DIMENSION(SIZE(PPATCH_OUT,1),SIZE(PPATCH_OUT,2)) :: ZPATCH_OUT
+INTEGER :: JP, JVEG, IP_I, IP_O, JI, IMASK, JP2
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('GET_PREP_INTERP',0,ZHOOK_HANDLE)
+!
+
+IF (PRESENT(KMASK_IN)) THEN
+ IMASK_IN(:,:) = KMASK_IN(:,:)
+ELSE
+ DO JI = 1,SIZE(IMASK_IN,1)
+ IMASK_IN(JI,:) = JI
+ ENDDO
+ENDIF
+!
+ZPATCH_OUT(:,:) = 0.
+!
+! if NPATCH (in) == NVEGTYPE, the arrays of patches is this of vegtypes
+IF (KNP_IN==NVEGTYPE) THEN
+ !
+ DO JVEG = 1,NVEGTYPE
+ ! mask of the output patch in which is this vegtype
+ IP_O = VEGTYPE_TO_PATCH(JVEG,KNP_OUT)
+ DO JI = 1,SIZE(IMASK_IN,1)
+ IMASK = IMASK_IN(JI,IP_O)
+ IF (IMASK/=0) ZPATCH_OUT(IMASK,JVEG) = PVEGTYPE(JI,JVEG)
+ ENDDO
+ ENDDO
+ !
+! if there is the same number of patches before / after, patch_out = patch_in
+ELSEIF (KNP_IN==KNP_OUT) THEN
+ !
+ ! the mask can be applied to the patches before and after
+ DO JP2 = 1,SIZE(IMASK_IN,2)
+ DO JI = 1,SIZE(IMASK_IN,1)
+ IMASK = IMASK_IN(JI,JP2)
+ IF (IMASK/=0) ZPATCH_OUT(IMASK,JP2) = PPATCH_IN(JI,JP2)
+ ENDDO
+ ENDDO
+ !
+! less patches before than after
+ELSEIF (KNP_IN<KNP_OUT) THEN
+ !
+ ! to which input patch contributes each output patch?
+ DO JP = 1,KNP_OUT
+ ! which vegtype is in this output patch?
+ DO JVEG = 1,NVEGTYPE
+ ! output patch in which is this vegtype
+ IP_O = VEGTYPE_TO_PATCH(JVEG,KNP_OUT)
+ ! input patch in which is this vegtype
+ IP_I = VEGTYPE_TO_PATCH(JVEG,KNP_IN)
+ !
+ ! if VEG is in JP
+ IF (IP_O==JP) THEN
+ ! the input patch takes the contribution of the output patch
+ DO JI = 1,SIZE(IMASK_IN,1)
+ ! the mask is this of the current output patch
+ IMASK = IMASK_IN(JI,IP_O)
+ IF (IMASK/=0) ZPATCH_OUT(IMASK,IP_I) = ZPATCH_OUT(IMASK,IP_I) + PPATCH_IN(JI,IP_O)
+ ENDDO
+ ! just one time if several vegtypes are in this patch JP
+ EXIT
+ ENDIF
+ ENDDO
+ ENDDO
+ !
+! more patches before than after
+ELSEIF (KNP_IN>KNP_OUT) THEN
+ !
+ ! for each input patch, what is the corresponding output patch?
+ DO JP = 1,KNP_IN
+ ! which vegtype is in this output patch?
+ DO JVEG = 1,NVEGTYPE
+ ! input patch in which is this vegtype
+ IP_I = VEGTYPE_TO_PATCH(JVEG,KNP_IN)
+ ! output patch in which is this vegtype
+ IP_O = VEGTYPE_TO_PATCH(JVEG,KNP_OUT)
+ !
+ ! if VEG is in JP
+ IF (IP_I==JP) THEN
+ ! this input patch gets the value of the corresponding output patch
+ DO JI = 1,SIZE(IMASK_IN,1)
+ IMASK = IMASK_IN(JI,IP_O)
+ IF (IMASK/=0) ZPATCH_OUT(IMASK,IP_I) = PPATCH_IN(JI,IP_O)
+ ENDDO
+ ! just one time because another vegtype of IP_I will be also in IP_O
+ EXIT
+ ENDIF
+ ENDDO
+ ENDDO
+ !
+ENDIF
+!
+PPATCH_OUT(:,:) = ZPATCH_OUT(:,:)
+!
+IF (LHOOK) CALL DR_HOOK('GET_PREP_INTERP',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE GET_PREP_INTERP
diff --git a/src/SURFEX/get_qsn.F90 b/src/SURFEX/get_qsn.F90
index 253a23e7dd16904cf16963b33bb71285860f2d82..b32d018874a5a13d099f7fd2cf28e63eafff0a4c 100644
--- a/src/SURFEX/get_qsn.F90
+++ b/src/SURFEX/get_qsn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GET_QS_n (DGU, &
- HPROGRAM,KI,PQS)
+ SUBROUTINE GET_QS_n (DGO, D, HPROGRAM,KI,PQS)
! #########################################
!
!!**** *GET_QS_n* - routine to get roughness lengths
@@ -39,7 +38,7 @@
! ------------
!
!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
!
USE MODI_GET_LUOUT
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -55,7 +54,8 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
INTEGER, INTENT(IN) :: KI ! Number of points
@@ -73,8 +73,8 @@ IF (LHOOK) CALL DR_HOOK('GET_QS_N',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!-------------------------------------------------------------------------------
!
-IF (DGU%LSURF_VARS) THEN
- PQS = DGU%XAVG_QS
+IF (DGO%LSURF_VARS) THEN
+ PQS = D%XQS
ELSE
PQS = XUNDEF
ENDIF
diff --git a/src/SURFEX/get_sfx_land.F90 b/src/SURFEX/get_sfx_land.F90
index 38d4265dd38ee528a97fc541220d0021c4fdd843..494f03cc05b63375f4bb00e600093ecf3cea725f 100644
--- a/src/SURFEX/get_sfx_land.F90
+++ b/src/SURFEX/get_sfx_land.F90
@@ -3,10 +3,9 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GET_SFX_LAND (I, U, &
+ SUBROUTINE GET_SFX_LAND (IO, S, U, &
OCPL_GW,OCPL_FLOOD,OCPL_CALVING, &
- PRUNOFF,PDRAIN,PCALVING,PRECHARGE, &
- PSRCFLOOD )
+ PRUNOFF,PDRAIN,PCALVING,PSRCFLOOD )
! ###############################################################################
!
!!**** *GET_SFX_LAND* - routine to get some land surface variables from surfex
@@ -34,13 +33,14 @@
!! MODIFICATIONS
!! -------------
!! Original 10/2013
+!! 10/2016 B. Decharme : bug surface/groundwater coupling
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -57,8 +57,8 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
LOGICAL, INTENT(IN) :: OCPL_GW ! groundwater/surface key
@@ -68,13 +68,12 @@ LOGICAL, INTENT(IN) :: OCPL_CALVING ! calving key
REAL, DIMENSION(:), INTENT(OUT) :: PRUNOFF ! Cumulated Surface runoff (kg/m2)
REAL, DIMENSION(:), INTENT(OUT) :: PDRAIN ! Cumulated Deep drainage (kg/m2)
REAL, DIMENSION(:), INTENT(OUT) :: PCALVING ! Cumulated Calving flux (kg/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PRECHARGE ! Cumulated Recharge to groundwater (kg/m2)
REAL, DIMENSION(:), INTENT(OUT) :: PSRCFLOOD ! Cumulated freshwater flux (kg/m2)
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-REAL, DIMENSION(SIZE(I%XCPL_PFLOOD)) :: ZSRCFLOOD
+REAL, DIMENSION(SIZE(S%XCPL_PFLOOD)) :: ZSRCFLOOD
!
REAL, DIMENSION(SIZE(PCALVING)) :: ZCALVING
!
@@ -90,7 +89,6 @@ IF (LHOOK) CALL DR_HOOK('GET_SFX_LAND',0,ZHOOK_HANDLE)
PRUNOFF (:) = XUNDEF
PDRAIN (:) = XUNDEF
PCALVING (:) = XUNDEF
-PRECHARGE(:) = XUNDEF
PSRCFLOOD(:) = XUNDEF
!
!* 2.0 Get variable over nature
@@ -100,38 +98,31 @@ IF(U%NSIZE_NATURE>0)THEN
!
! * surface runoff
!
- CALL UNPACK_SAME_RANK(U%NR_NATURE,I%XCPL_RUNOFF(:),PRUNOFF(:),XUNDEF)
- I%XCPL_RUNOFF (:) = 0.0
+ CALL UNPACK_SAME_RANK(U%NR_NATURE,S%XCPL_RUNOFF(:),PRUNOFF(:),XUNDEF)
+ S%XCPL_RUNOFF (:) = 0.0
!
! * deep drainage
!
- CALL UNPACK_SAME_RANK(U%NR_NATURE,I%XCPL_DRAIN(:),PDRAIN(:),XUNDEF)
- I%XCPL_DRAIN(:) = 0.0
+ CALL UNPACK_SAME_RANK(U%NR_NATURE,S%XCPL_DRAIN(:),PDRAIN(:),XUNDEF)
+ S%XCPL_DRAIN(:) = 0.0
!
! * Calving flux
!
IF(OCPL_CALVING)THEN
- CALL UNPACK_SAME_RANK(U%NR_NATURE,I%XCPL_ICEFLUX(:),PCALVING(:),XUNDEF)
- I%XCPL_ICEFLUX(:) = 0.0
- ELSEIF(I%LGLACIER)THEN
- I%XCPL_DRAIN (:) = I%XCPL_DRAIN(:) + I%XCPL_ICEFLUX(:)
- I%XCPL_ICEFLUX(:) = 0.0
- ENDIF
-!
-! * groundwater recharge
-!
- IF(OCPL_GW)THEN
- CALL UNPACK_SAME_RANK(U%NR_NATURE,I%XCPL_RECHARGE(:),PRECHARGE(:),XUNDEF)
- I%XCPL_RECHARGE(:)=0.0
+ CALL UNPACK_SAME_RANK(U%NR_NATURE,S%XCPL_ICEFLUX(:),PCALVING(:),XUNDEF)
+ S%XCPL_ICEFLUX(:) = 0.0
+ ELSEIF(IO%LGLACIER)THEN
+ S%XCPL_DRAIN (:) = S%XCPL_DRAIN(:) + S%XCPL_ICEFLUX(:)
+ S%XCPL_ICEFLUX(:) = 0.0
ENDIF
!
! * floodplain source terms
!
IF(OCPL_FLOOD)THEN
- ZSRCFLOOD (:) = I%XCPL_PFLOOD(:)-I%XCPL_EFLOOD(:)-I%XCPL_IFLOOD(:)
- I%XCPL_PFLOOD(:) = 0.0
- I%XCPL_EFLOOD(:) = 0.0
- I%XCPL_IFLOOD(:) = 0.0
+ ZSRCFLOOD (:) = S%XCPL_PFLOOD(:)-S%XCPL_EFLOOD(:)-S%XCPL_IFLOOD(:)
+ S%XCPL_PFLOOD(:) = 0.0
+ S%XCPL_EFLOOD(:) = 0.0
+ S%XCPL_IFLOOD(:) = 0.0
CALL UNPACK_SAME_RANK(U%NR_NATURE,ZSRCFLOOD(:),PSRCFLOOD(:),XUNDEF)
ENDIF
!
diff --git a/src/SURFEX/get_sfxcpln.F90 b/src/SURFEX/get_sfxcpln.F90
index d627034a5cab7e10e3a7ceaed726223fa7b83a5c..23747c21a8f9a953ae57607d8bfa168918d61690 100644
--- a/src/SURFEX/get_sfxcpln.F90
+++ b/src/SURFEX/get_sfxcpln.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GET_SFXCPL_n (I, S, U, W, &
+ SUBROUTINE GET_SFXCPL_n (IM, S, U, W, &
HPROGRAM,KI,PRUI,PWIND,PFWSU,PFWSV,PSNET, &
PHEAT,PEVAP,PRAIN,PSNOW,PICEFLUX,PFWSM, &
PHEAT_ICE,PEVAP_ICE,PSNET_ICE)
@@ -41,6 +41,7 @@
!! MODIFICATIONS
!! -------------
!! Original 08/2009
+!! 10/2016 B. Decharme : bug surface/groundwater coupling
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -49,7 +50,7 @@
!
!
!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_WATFLUX_n, ONLY : WATFLUX_t
@@ -77,7 +78,7 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(WATFLUX_t), INTENT(INOUT) :: W
@@ -106,7 +107,6 @@ REAL, DIMENSION(KI), INTENT(OUT) :: PSNET_ICE
REAL, DIMENSION(KI) :: ZRUNOFF ! Cumulated Surface runoff (kg/m2)
REAL, DIMENSION(KI) :: ZDRAIN ! Cumulated Deep drainage (kg/m2)
REAL, DIMENSION(KI) :: ZCALVING ! Cumulated Calving flux (kg/m2)
-REAL, DIMENSION(KI) :: ZRECHARGE ! Cumulated Recharge to groundwater (kg/m2)
REAL, DIMENSION(KI) :: ZSRCFLOOD ! Cumulated flood freshwater flux (kg/m2)
!
REAL, DIMENSION(KI) :: ZSEA_FWSU ! Cumulated zonal wind stress (Pa.s)
@@ -131,7 +131,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('GET_SFXCPL_N',0,ZHOOK_HANDLE)
!
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
+CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
!-------------------------------------------------------------------------------
! Global argument
@@ -152,15 +152,13 @@ IF(LCPL_LAND)THEN
ZRUNOFF (:) = XUNDEF
ZDRAIN (:) = XUNDEF
ZCALVING (:) = XUNDEF
- ZRECHARGE(:) = XUNDEF
ZSRCFLOOD(:) = XUNDEF
!
! * Get land output fields
!
- CALL GET_SFX_LAND(I, U, &
+ CALL GET_SFX_LAND(IM%O, IM%S, U, &
LCPL_GW,LCPL_FLOOD,LCPL_CALVING, &
- ZRUNOFF,ZDRAIN,ZCALVING,ZRECHARGE, &
- ZSRCFLOOD )
+ ZRUNOFF,ZDRAIN,ZCALVING,ZSRCFLOOD )
!
! * Assign land output fields
!
diff --git a/src/SURFEX/get_size_fulln.F90 b/src/SURFEX/get_size_fulln.F90
index 1f9d178e8953de8712faf42956402907242aa624..36113323f313292906ff6ceac1b7b3b63d22abe2 100644
--- a/src/SURFEX/get_size_fulln.F90
+++ b/src/SURFEX/get_size_fulln.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GET_SIZE_FULL_n (U, &
- HPROGRAM,KDIM_FULL,KSIZE_FULL)
+ SUBROUTINE GET_SIZE_FULL_n (HPROGRAM,KDIM_FULL,KSIZE_FULL_IN,KSIZE_FULL_OUT)
! #######################################################
!
!!**** *GET_SIZE_FULL_n* - get number of points for this proc
@@ -38,34 +37,31 @@
!* 0. DECLARATIONS
! ------------
!
-!
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
-USE MODD_SURFEX_MPI, ONLY : WLOG_MPI
+USE MODD_SURFEX_MPI, ONLY : NSIZE_TASK, NRANK, NPROC
!
USE MODD_SURF_PAR, ONLY : NUNDEF
!
-USE MODD_SURFEX_MPI, ONLY : NINDEX, NRANK, NPROC
-USE MODD_SURFEX_OMP, ONLY : NINDX1SFX, NINDX2SFX
!
#ifdef SFX_MNH
USE MODI_MNHGET_SIZE_FULL_n
#endif
+#ifdef SFX_ARO
+USE MODI_AROGET_SIZE_FULL_n
+#endif
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+!
!* 0.1 Declarations of arguments
! -------------------------
-!
-!
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! main program
INTEGER , INTENT(IN) :: KDIM_FULL ! total number of points
-INTEGER , INTENT(OUT) :: KSIZE_FULL ! total number of points on this proc
+INTEGER , INTENT(IN) :: KSIZE_FULL_IN ! total number of points on this proc
+INTEGER , INTENT(OUT) :: KSIZE_FULL_OUT ! total number of points on this proc
!
!* 0.2 Declarations of local variables
! -------------------------------
@@ -77,30 +73,26 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('GET_SIZE_FULL_N',0,ZHOOK_HANDLE)
IF (HPROGRAM=='MESONH') THEN
#ifdef SFX_MNH
- CALL MNHGET_SIZE_FULL_n(HPROGRAM,KDIM_FULL,KSIZE_FULL)
+ CALL MNHGET_SIZE_FULL_n(HPROGRAM,KDIM_FULL,KSIZE_FULL_OUT)
#endif
END IF
!
IF ( HPROGRAM=='OFFLIN' .OR. HPROGRAM=='ASCII ' .OR. HPROGRAM=='FA ' .OR. HPROGRAM=='LFI ' .OR. &
HPROGRAM=='TEXTE ' .OR. HPROGRAM=='BINARY' .OR. HPROGRAM=='NC ') THEN
#ifdef SFX_OL
- IF (U%NSIZE_FULL/=NUNDEF .AND. U%NSIZE_FULL/=0) THEN
- KSIZE_FULL = U%NSIZE_FULL
- ELSEIF (ALLOCATED(NINDEX)) THEN
- KSIZE_FULL = 0
- DO J=1,SIZE(NINDEX)
- IF ( NINDEX(J)==MOD(NRANK,NPROC) ) KSIZE_FULL = KSIZE_FULL + 1
- ENDDO
+ IF (KSIZE_FULL_IN/=NUNDEF .AND. KSIZE_FULL_IN/=0) THEN
+ KSIZE_FULL_OUT = KSIZE_FULL_IN
+ ELSEIF (ALLOCATED(NSIZE_TASK)) THEN
+ KSIZE_FULL_OUT = NSIZE_TASK(NRANK)
ELSE
- KSIZE_FULL = KDIM_FULL
+ KSIZE_FULL_OUT = KDIM_FULL
END IF
- IF ( NINDX2SFX/=KDIM_FULL .OR. NINDX1SFX/=1 ) KSIZE_FULL = MIN(KSIZE_FULL,NINDX2SFX-NINDX1SFX+1)
#endif
ENDIF
!
IF (HPROGRAM=='AROME ') THEN
#ifdef SFX_ARO
- CALL AROGET_SIZE_FULL_n(HPROGRAM,KDIM_FULL,KSIZE_FULL)
+ CALL AROGET_SIZE_FULL_n(HPROGRAM,KDIM_FULL,KSIZE_FULL_OUT)
#endif
ENDIF
IF (LHOOK) CALL DR_HOOK('GET_SIZE_FULL_N',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/get_sizes_parallel.F90 b/src/SURFEX/get_sizes_parallel.F90
index 2f3b8ac8249bb3f960ee8e15807180a7ec6a7748..5c32c82d415be05233a87d106f399223d3b38cc5 100644
--- a/src/SURFEX/get_sizes_parallel.F90
+++ b/src/SURFEX/get_sizes_parallel.F90
@@ -2,8 +2,7 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
-SUBROUTINE GET_SIZES_PARALLEL (DTCO, DGU, UG, U, &
- KPROC,KSIZE,KPROCMIN,KSIZE_TASK,OSHADOWS)
+SUBROUTINE GET_SIZES_PARALLEL (DTCO, UG, U, KPROC,KSIZE,KPROCMIN,KSIZE_TASK,OSHADOWS)
!
!
! Modified by B. Decharme (08/2013): bug in KSIZE_TASK
@@ -15,7 +14,6 @@ SUBROUTINE GET_SIZES_PARALLEL (DTCO, DGU, UG, U, &
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
@@ -38,7 +36,6 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
@@ -77,24 +74,22 @@ IF (GSHADOWS) THEN
! Get x and y dimension lengths
#ifdef SFX_OL
-!$OMP SINGLE
IF (NIX==0) THEN
!CALL SET_SURFEX_FILEIN(CSURF_FILETYPE,'PREP ') ! not necessary, it works with PGD or PREP file
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
+CALL INIT_IO_SURF_n(DTCO, U, &
CSURF_FILETYPE,'FULL ','SURF ','READ ')
CALL READ_SURF(&
- CSURF_FILETYPE,'GRID_TYPE',UG%CGRID,IRESP,HDIR='A')
+ CSURF_FILETYPE,'GRID_TYPE',UG%G%CGRID,IRESP,HDIR='A')
CALL READ_GRIDTYPE(&
- CSURF_FILETYPE,UG%CGRID,UG%NGRID_PAR,U%NDIM_FULL,.FALSE.,HDIR="A")
- ALLOCATE(UG%XGRID_FULL_PAR(UG%NGRID_PAR))
+ CSURF_FILETYPE,UG%G%CGRID,UG%NGRID_FULL_PAR,U%NDIM_FULL,.FALSE.,HDIR="A")
+ ALLOCATE(UG%XGRID_FULL_PAR(UG%NGRID_FULL_PAR))
CALL READ_GRIDTYPE(&
- CSURF_FILETYPE,UG%CGRID,UG%NGRID_PAR,U%NDIM_FULL,.TRUE.,UG%XGRID_FULL_PAR,IRESP,HDIR="A")
+ CSURF_FILETYPE,UG%G%CGRID,UG%NGRID_FULL_PAR,U%NDIM_FULL,.TRUE.,UG%XGRID_FULL_PAR,IRESP,HDIR="A")
CALL END_IO_SURF_n(CSURF_FILETYPE)
- CALL GET_GRID_DIM(UG%CGRID,SIZE(UG%XGRID_FULL_PAR),UG%XGRID_FULL_PAR,GRECT,NIX,NIY)
+ CALL GET_GRID_DIM(UG%G%CGRID,SIZE(UG%XGRID_FULL_PAR),UG%XGRID_FULL_PAR,GRECT,NIX,NIY)
UG%XGRID_FULL_PAR=>NULL()
ENDIF
-!$OMP END SINGLE
!If get_sizes_parallel is called by init_index_mpi
!ISIZE_Y represents the number of lines of the total domain
diff --git a/src/SURFEX/get_sso_stdevn.F90 b/src/SURFEX/get_sso_stdevn.F90
index 6ca6c65e5f9ef30c7dced380d28fa10d10fa7522..cbfeade67486b6c60ab2c828693c7430a6e1adff 100644
--- a/src/SURFEX/get_sso_stdevn.F90
+++ b/src/SURFEX/get_sso_stdevn.F90
@@ -39,7 +39,7 @@
! ------------
!
!
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODI_GET_LUOUT
USE MODI_ABOR1_SFX
@@ -54,7 +54,7 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
INTEGER, INTENT(IN) :: KI ! horizontal dim. of cover
diff --git a/src/SURFEX/get_sson.F90 b/src/SURFEX/get_sson.F90
index b7d6cc94ec6eb9711885a800da78610ecd4f8c7c..26c5ed2a730781d0904f2920ac69a6a8a5d70007 100644
--- a/src/SURFEX/get_sson.F90
+++ b/src/SURFEX/get_sson.F90
@@ -39,7 +39,7 @@
! ------------
!
!
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODI_GET_LUOUT
!
@@ -56,7 +56,7 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
INTEGER, INTENT(IN) :: KI ! horizontal dim. of cover
diff --git a/src/SURFEX/get_surf_atm_sso_rough.F90 b/src/SURFEX/get_surf_atm_sso_rough.F90
deleted file mode 100644
index bcbd039fe59e8ab43a2cc5c1f0120609d723d0f4..0000000000000000000000000000000000000000
--- a/src/SURFEX/get_surf_atm_sso_rough.F90
+++ /dev/null
@@ -1,59 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ########################################################################
- SUBROUTINE GET_SURF_ATM_SSO_ROUGH(HROUGH)
-! ########################################################################
-!
-!!**** *DEFAULT_ISBA* - routine to get value of the
-! main logical switch for orographic roughness
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 10/2010
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODN_SSO_n, ONLY : CROUGH
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
- CHARACTER(LEN=4), INTENT(OUT) :: HROUGH
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!* 0.1 Declarations of arguments
-!-------------------------------------------------------------------------------
-!
-! General switch
-!
-IF (LHOOK) CALL DR_HOOK('GET_SURF_ATM_SSO_ROUGH',0,ZHOOK_HANDLE)
-HROUGH = CROUGH
-IF (LHOOK) CALL DR_HOOK('GET_SURF_ATM_SSO_ROUGH',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE GET_SURF_ATM_SSO_ROUGH
diff --git a/src/SURFEX/get_surf_grid_dimn.F90 b/src/SURFEX/get_surf_grid_dimn.F90
index 82d36f87b22e33a1cf72ad83e7b7e82caf7a5a19..3c9df0c5abd52922d7e0cf7a129e47f97646dfca 100644
--- a/src/SURFEX/get_surf_grid_dimn.F90
+++ b/src/SURFEX/get_surf_grid_dimn.F90
@@ -3,14 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #######################################################
-#ifdef MNH_PARALLEL
- SUBROUTINE GET_SURF_GRID_DIM_n (UG, &
- HGRID,ORECT,KDIM1,KDIM2,&
+ SUBROUTINE GET_SURF_GRID_DIM_n (UG,HGRID,ORECT,KDIM1,KDIM2,&
KGRID_PAR,PGRID_PAR)
-#else
- SUBROUTINE GET_SURF_GRID_DIM_n (UG, &
- HGRID,ORECT,KDIM1,KDIM2)
-#endif
! #######################################################
!
!!**** *GET_SURF_GRID_DIM_n* get the grid mesh dimensions
@@ -34,7 +28,6 @@
!!
!! Original 03/2004
!! M.Moge 02/2015 Passing KGRID_PAR,PGRID_PAR as input parameters, instead of using XGRID_PAR, NGRID_PAR from MODD_SURF_ATM_GRID_n
-!!!
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
@@ -61,25 +54,25 @@ TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
LOGICAL, INTENT(OUT) :: ORECT ! T if rectangular grid
INTEGER, INTENT(OUT) :: KDIM1 ! 1st dimension
INTEGER, INTENT(OUT) :: KDIM2 ! 2nd dimension
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-#ifdef MNH_PARALLEL
-INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
-REAL, DIMENSION(KGRID_PAR), INTENT(IN) :: PGRID_PAR ! grid parameters
-#endif
+!
+INTEGER, OPTIONAL, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
+REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PGRID_PAR ! grid parameters
!
!* 0.2 Declaration of other local variables
! ------------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('GET_SURF_GRID_DIM_N',0,ZHOOK_HANDLE)
-HGRID = UG%CGRID
+HGRID = UG%G%CGRID
+!
+IF (PRESENT(KGRID_PAR).AND.PRESENT(PGRID_PAR)) THEN
+ CALL GET_GRID_DIM(UG%G%CGRID,KGRID_PAR,PGRID_PAR,ORECT,KDIM1,KDIM2)
+ELSE
+ CALL GET_GRID_DIM(UG%G%CGRID,UG%NGRID_FULL_PAR,UG%XGRID_FULL_PAR,ORECT,KDIM1,KDIM2)
+ENDIF
!
-#ifdef MNH_PARALLEL
- CALL GET_GRID_DIM(UG%CGRID,KGRID_PAR,PGRID_PAR,ORECT,KDIM1,KDIM2)
-#else
- CALL GET_GRID_DIM(UG%CGRID,UG%NGRID_PAR,UG%XGRID_PAR,ORECT,KDIM1,KDIM2)
-#endif
IF (LHOOK) CALL DR_HOOK('GET_SURF_GRID_DIM_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/get_surf_maskn.F90 b/src/SURFEX/get_surf_maskn.F90
index 09d8307a2975aa89fc3c953de91d806f80aec185..00fefe5cfe608b91c4e12656c2f78b933e7da9da 100644
--- a/src/SURFEX/get_surf_maskn.F90
+++ b/src/SURFEX/get_surf_maskn.F90
@@ -75,7 +75,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! -------------------------
!
IF (LHOOK) CALL DR_HOOK('GET_SURF_MASK_N',0,ZHOOK_HANDLE)
-IF (.NOT. ASSOCIATED(U%XCOVER)) THEN
+IF (.NOT. ASSOCIATED(U%XCOVER).AND..NOT.ASSOCIATED(U%XSEA)) THEN
CALL GET_MASK(KLU,'FULL',KMASK)
IF (LHOOK) CALL DR_HOOK('GET_SURF_MASK_N',1,ZHOOK_HANDLE)
RETURN
@@ -86,7 +86,11 @@ END IF
!* 2. Fractions
! ---------
!
-ILU = SIZE(U%XCOVER,1)
+IF (ASSOCIATED(U%XCOVER)) THEN
+ ILU = SIZE(U%XCOVER,1)
+ELSEIF (ASSOCIATED(U%XSEA)) THEN
+ ILU = SIZE(U%XSEA)
+ENDIF
!
IF (KLU==NUNDEF .OR. KLU==0) KLU = ILU
!
@@ -101,7 +105,7 @@ END IF
!
IF (LHOOK) CALL DR_HOOK('GET_SURF_MASK_N',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!
SUBROUTINE GET_MASK(KLU,YTYPE,IMASK)
!
diff --git a/src/SURFEX/get_surf_varn.F90 b/src/SURFEX/get_surf_varn.F90
index c498dbdf7714c5d577c61c0c815350860254f55d..f732f03161620077971e172764a7af89d51acc92 100644
--- a/src/SURFEX/get_surf_varn.F90
+++ b/src/SURFEX/get_surf_varn.F90
@@ -3,16 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GET_SURF_VAR_n (DGF, I, DGI, DGMI, DGS, DGU, DGT, DGW, F, UG, U, USS, &
- HPROGRAM, KI, KS, &
- PSEA, PWATER, PNATURE, PTOWN, &
- PT2M, PQ2M, PQS, PZ0, PZ0H, PZ0EFF, &
- PZ0_SEA, PZ0_WATER, PZ0_NATURE, PZ0_TOWN, &
- PZ0H_SEA, PZ0H_WATER, PZ0H_NATURE, PZ0H_TOWN,&
- PQS_SEA, PQS_WATER, PQS_NATURE, PQS_TOWN, &
- PPSNG, PPSNV, PZS, PSERIES, PTWSNOW, &
- PSSO_STDEV, PLON, PLAT, &
- PBARE, PLAI_TREE, PH_TREE )
+ SUBROUTINE GET_SURF_VAR_n (FM, IM, SM, TM, WM, DGO, D, UG, U, USS, &
+ HPROGRAM, KI, KS,PSEA, PWATER, PNATURE, PTOWN, &
+ PT2M, PQ2M, PQS, PZ0, PZ0H, PZ0EFF, PZ0_SEA, &
+ PZ0_WATER, PZ0_NATURE, PZ0_TOWN, PZ0H_SEA, &
+ PZ0H_WATER, PZ0H_NATURE, PZ0H_TOWN, PQS_SEA, &
+ PQS_WATER, PQS_NATURE, PQS_TOWN, PPSNG, PPSNV, &
+ PZS, PSERIES, PTWSNOW, PSSO_STDEV, PLON, PLAT, &
+ PBARE, PLAI_TREE, PH_TREE )
! #######################################################################
!
!!**** *GET_SURF_VAR_n* - gets some surface fields on atmospheric grid
@@ -54,18 +52,12 @@
!* 0. DECLARATIONS
! ------------
!
-USE MODD_DIAG_FLAKE_n, ONLY : DIAG_FLAKE_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
-USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
-USE MODD_DIAG_SEAFLUX_n, ONLY : DIAG_SEAFLUX_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_DIAG_TEB_n, ONLY : DIAG_TEB_t
-USE MODD_DIAG_WATFLUX_n, ONLY : DIAG_WATFLUX_t
-USE MODD_FLAKE_n, ONLY : FLAKE_t
+USE MODD_SURFEX_n, ONLY : FLAKE_MODEL_t, ISBA_MODEL_t, SEAFLUX_MODEL_t, &
+ TEB_MODEL_t, WATFLUX_MODEL_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODI_GET_LUOUT
@@ -94,19 +86,17 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
+TYPE(FLAKE_MODEL_t), INTENT(INOUT) :: FM
+TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
+TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM
+TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM
+TYPE(WATFLUX_MODEL_t), INTENT(INOUT) :: WM
!
-TYPE(DIAG_FLAKE_t), INTENT(INOUT) :: DGF
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(DIAG_ISBA_t), INTENT(INOUT) :: DGI
-TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DGMI
-TYPE(DIAG_SEAFLUX_t), INTENT(INOUT) :: DGS
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(DIAG_TEB_t), INTENT(INOUT) :: DGT
-TYPE(DIAG_WATFLUX_t), INTENT(INOUT) :: DGW
-TYPE(FLAKE_t), INTENT(INOUT) :: F
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
INTEGER, INTENT(IN) :: KI ! number of points
@@ -188,8 +178,7 @@ IF (LHOOK) CALL DR_HOOK('GET_SURF_VAR_N',0,ZHOOK_HANDLE)
!
IF (PRESENT(PSEA) .OR. PRESENT(PWATER) .OR. PRESENT(PNATURE) .OR. PRESENT(PTOWN)) THEN
!
- CALL GET_FRAC_n(U, &
- HPROGRAM, KI, ZFIELD1, ZFIELD2, ZFIELD3, ZFIELD4)
+ CALL GET_FRAC_n(U, HPROGRAM, KI, ZFIELD1, ZFIELD2, ZFIELD3, ZFIELD4)
!
IF (PRESENT(PSEA) ) PSEA = ZFIELD1
IF (PRESENT(PWATER) ) PWATER = ZFIELD2
@@ -204,10 +193,10 @@ END IF
!
IF ( PRESENT(PT2M) .OR. PRESENT(PQ2M) ) THEN
!
- CALL GET_FLUX_n(DGU, &
- HPROGRAM, KI, ZFIELD1, ZFIELD1, ZFIELD1, ZFIELD1, ZFIELD1, ZFIELD2, &
- ZFIELD3, ZFIELD4, ZFIELD4, ZFIELD4, ZFIELD4, ZFIELD4, &
- ZFIELD4, ZFIELD4, ZFIELD4 )
+ CALL GET_FLUX_n(DGO, D, HPROGRAM, KI, &
+ ZFIELD1, ZFIELD1, ZFIELD1, ZFIELD1, ZFIELD1, ZFIELD2, &
+ ZFIELD3, ZFIELD4, ZFIELD4, ZFIELD4, ZFIELD4, ZFIELD4, &
+ ZFIELD4, ZFIELD4, ZFIELD4 )
!
IF (PRESENT(PT2M) ) PT2M = ZFIELD2
IF (PRESENT(PQ2M) ) PQ2M = ZFIELD3
@@ -220,8 +209,7 @@ END IF
!
IF ( PRESENT(PZ0) .OR. PRESENT(PZ0H) ) THEN
!
- CALL GET_Z0_n(DGU, &
- HPROGRAM, KI, ZFIELD1, ZFIELD2)
+ CALL GET_Z0_n(DGO, D, HPROGRAM, KI, ZFIELD1, ZFIELD2)
!
IF (PRESENT(PZ0) ) PZ0 = ZFIELD1
IF (PRESENT(PZ0H) ) PZ0H = ZFIELD2
@@ -234,8 +222,7 @@ END IF
!
IF ( PRESENT(PQS) ) THEN
!
- CALL GET_QS_n(DGU, &
- HPROGRAM, KI, PQS)
+ CALL GET_QS_n(DGO, D, HPROGRAM, KI, PQS)
!
END IF
!
@@ -258,7 +245,7 @@ IF ( PRESENT(PQS_SEA) .OR. PRESENT(PZ0_SEA) .OR. PRESENT(PZ0H_SEA) ) THEN
IMASK(:)=0
CALL GET_1D_MASK(KI_SEA, KI, PSEA, IMASK(1:KI_SEA))
!
- CALL GET_VAR_SEA_n(DGS, &
+ CALL GET_VAR_SEA_n(SM%SD%O, SM%SD%D, &
HPROGRAM, KI_SEA, ZFIELD1(1:KI_SEA), ZFIELD2(1:KI_SEA), ZFIELD3(1:KI_SEA))
!
IF(PRESENT(PQS_SEA))THEN
@@ -299,9 +286,9 @@ IF ( PRESENT(PQS_WATER) .OR. PRESENT(PZ0_WATER) .OR. PRESENT(PZ0H_WATER) ) THEN
IMASK(:)=0
CALL GET_1D_MASK(KI_WATER, KI, PWATER, IMASK(1:KI_WATER))
!
- CALL GET_VAR_WATER_n(DGF, DGW, &
+ CALL GET_VAR_WATER_n(FM%DFO, FM%DF, WM%DWO, WM%DW, &
HPROGRAM, KI_WATER, U%CWATER, ZFIELD1(1:KI_WATER), &
- ZFIELD2(1:KI_WATER), ZFIELD3(1:KI_WATER))
+ ZFIELD2(1:KI_WATER), ZFIELD3(1:KI_WATER))
!
IF(PRESENT(PQS_WATER))THEN
PQS_WATER (:) = XUNDEF
@@ -346,11 +333,10 @@ IF ( PRESENT(PQS_NATURE) .OR. PRESENT(PPSNG) .OR. PRESENT(PPSNV) .OR. PRESENT(P
CALL GET_1D_MASK(KI_NATURE, KI, PNATURE, IMASK(1:KI_NATURE))
!
IF (KI_NATURE>0) THEN
- CALL GET_VAR_NATURE_n(I, DGI, DGMI, &
- HPROGRAM, KI_NATURE, ZFIELD1(1:KI_NATURE), ZFIELD2(1:KI_NATURE), &
- ZFIELD3(1:KI_NATURE), ZFIELD4(1:KI_NATURE), &
- ZFIELD5(1:KI_NATURE), ZFIELD6(1:KI_NATURE), ZFIELD7(1:KI_NATURE), &
- ZFIELD8(1:KI_NATURE))
+ CALL GET_VAR_NATURE_n(IM%S, IM%ID%O, IM%ID%D, IM%ID%DM, HPROGRAM, KI_NATURE, &
+ ZFIELD1(1:KI_NATURE), ZFIELD2(1:KI_NATURE), ZFIELD3(1:KI_NATURE), &
+ ZFIELD4(1:KI_NATURE), ZFIELD5(1:KI_NATURE), ZFIELD6(1:KI_NATURE), &
+ ZFIELD7(1:KI_NATURE), ZFIELD8(1:KI_NATURE))
ENDIF
!
IF(PRESENT(PQS_NATURE))THEN
@@ -416,7 +402,7 @@ IF ( PRESENT(PQS_NATURE) .OR. PRESENT(PPSNG) .OR. PRESENT(PPSNV) .OR. PRESENT(P
!
IF (PRESENT(PLAI_TREE) .OR. PRESENT(PH_TREE) ) THEN
!
- CALL GET_VEG_n(HPROGRAM, KI_NATURE, U, I, ZFIELD1(1:KI_NATURE), ZFIELD2(1:KI_NATURE))
+ CALL GET_VEG_n(HPROGRAM, KI_NATURE, U, IM%O, IM%S, IM%NP, IM%NPE, ZFIELD1(1:KI_NATURE), ZFIELD2(1:KI_NATURE))
!
IF (PRESENT(PLAI_TREE)) THEN
PLAI_TREE(:) = XUNDEF
@@ -454,8 +440,8 @@ IF ( PRESENT(PQS_TOWN) .OR. PRESENT(PZ0_TOWN) .OR. PRESENT(PZ0H_TOWN) ) THEN
IMASK(:)=0
CALL GET_1D_MASK(KI_TOWN, KI, PTOWN, IMASK(1:KI_TOWN))
!
- CALL GET_VAR_TOWN_n(DGT, &
- HPROGRAM, KI_TOWN, ZFIELD1(1:KI_TOWN), ZFIELD2(1:KI_TOWN), ZFIELD3(1:KI_TOWN))
+ CALL GET_VAR_TOWN_n(TM%TD%O, TM%TD%D, HPROGRAM, KI_TOWN, &
+ ZFIELD1(1:KI_TOWN), ZFIELD2(1:KI_TOWN), ZFIELD3(1:KI_TOWN))
!
IF(PRESENT(PQS_TOWN))THEN
PQS_TOWN (:) = XUNDEF
@@ -484,8 +470,7 @@ END IF
!
IF (PRESENT(PZS)) THEN
!
- CALL GET_ZS_n(U, &
- HPROGRAM, KI, ZFIELD1)
+ CALL GET_ZS_n(U, HPROGRAM, KI, ZFIELD1)
!
PZS = ZFIELD1
!
@@ -501,8 +486,7 @@ IF (PRESENT(PSERIES)) THEN
!
IF ( COUNT(PWATER (:) > 0.0) > 0.0 ) THEN
!
- CALL GET_SERIES_n(F, &
- HPROGRAM, KI, KS, ZSERIES)
+ CALL GET_SERIES_n(FM%F, HPROGRAM, KI, KS, ZSERIES)
!
PSERIES = ZSERIES
!
@@ -516,8 +500,7 @@ END IF
!
IF (PRESENT(PSSO_STDEV)) THEN
!
- CALL GET_SSO_STDEV_n(USS, &
- 'ASCII ', KI, ZFIELD1)
+ CALL GET_SSO_STDEV_n(USS, 'ASCII ', KI, ZFIELD1)
!
PSSO_STDEV = ZFIELD1
!
@@ -527,8 +510,7 @@ END IF
!
IF (PRESENT(PLON).OR.PRESENT(PLAT)) THEN
!
- CALL GET_COORD_n(UG, &
- HPROGRAM, KI, ZFIELD1, ZFIELD2)
+ CALL GET_COORD_n(UG, HPROGRAM, KI, ZFIELD1, ZFIELD2)
!
IF (PRESENT(PLON) ) PLON = ZFIELD1
IF (PRESENT(PLAT) ) PLAT = ZFIELD2
diff --git a/src/SURFEX/get_teb_depths.F90 b/src/SURFEX/get_teb_depths.F90
index 50f24202a416130f7c7b2a731793798ae65feb25..440a9fcc199e64796e02369a48d275cfbf8e0fa1 100644
--- a/src/SURFEX/get_teb_depths.F90
+++ b/src/SURFEX/get_teb_depths.F90
@@ -3,9 +3,9 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GET_TEB_DEPTHS (&
- DTCO, &
- HFILEPGD, HFILEPGDTYPE, PD_ROOF, PD_ROAD, PD_WALL, PD_FLOOR)
+ SUBROUTINE GET_TEB_DEPTHS (DTCO, &
+ HFILE, HFILETYPE, HFILEPGD, HFILEPGDTYPE, &
+ PD_ROOF, PD_ROAD, PD_WALL, PD_FLOOR,HDIR)
! ##############################################################
!
!!**** *CONVERT_COVER*
@@ -40,17 +40,15 @@
!* 0. DECLARATION
! -----------
!
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t, DATA_COVER_INIT
!
-!
-!
-!
-!
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
USE MODD_DATA_COVER, ONLY : XDATA_D_ROOF, XDATA_D_ROAD, XDATA_D_WALL, XDATA_D_FLOOR
-USE MODD_DATA_COVER_PAR, ONLY : JPCOVER, NDATA_ROOF_LAYER, NDATA_ROAD_LAYER, &
+USE MODD_DATA_COVER_PAR, ONLY : NCOVER, NTYPE, NDATA_ROOF_LAYER, NDATA_ROAD_LAYER, &
NDATA_WALL_LAYER, NDATA_FLOOR_LAYER
!
+USE MODI_OPEN_AUX_IO_SURF
+USE MODI_CLOSE_AUX_IO_SURF
USE MODE_READ_SURF_COV, ONLY : READ_SURF_COV
!
USE MODI_READ_SURF
@@ -59,14 +57,14 @@ USE MODI_OLD_NAME
USE MODI_THERMAL_LAYERS_CONF
USE MODI_OPEN_AUX_IO_SURF
USE MODI_CLOSE_AUX_IO_SURF
+USE MODI_READ_LECOCLIMAP
+USE MODI_DEFAULT_DATA_COVER
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
USE MODI_ABOR1_SFX
!
-USE MODI_READ_COVERS_AND_AV_PGD_1D_ON_LAYERS
-!
IMPLICIT NONE
!
!* 0.1 Declaration of arguments
@@ -77,39 +75,52 @@ IMPLICIT NONE
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
!
- CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! name of file
+ CHARACTER(LEN=28), INTENT(IN) :: HFILE ! type of input file
+ CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! type of input file
+ CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! type of input file
CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! type of input file
!
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PD_ROOF
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PD_ROAD
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PD_WALL
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PD_FLOOR
+!
+ CHARACTER(LEN=1), INTENT(IN), OPTIONAL :: HDIR
!
!* 0.2 Declaration of local variables
! ------------------------------
!
-LOGICAL, DIMENSION(JPCOVER) :: GCOVER ! flag to read the covers
+TYPE(DATA_COVER_t) :: YDTCO
+!
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GCOVER ! flag to read the covers
REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOVER ! cover fractions
REAL, DIMENSION(:,:), ALLOCATABLE :: ZD ! depth of surface layers
REAL, DIMENSION(:,:), ALLOCATABLE :: ZPAR_D ! depth of data_surface layers
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZPAR_HC, ZPAR_TC, ZHC, ZTC ! work arrays
!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDATA
+!
+INTEGER :: IVERSION_PGD, IVERSION_PREP ! surface version
+INTEGER :: IBUGFIX_PGD, IBUGFIX_PREP ! surface bugfix version
INTEGER :: IVERSION ! surface version
INTEGER :: IBUGFIX ! surface bugfix version
+ CHARACTER(LEN=1) :: YDIR
+ CHARACTER(LEN=3) :: YAREA ! Area where field is to be averaged
CHARACTER(LEN=5) :: YSURF ! Type of surface
CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+ CHARACTER(LEN=LEN_HREC) :: YRECFMOLD ! Name of the article to be read
CHARACTER(LEN=LEN_HREC) :: YRECFM0 ! Name of the article to be read
CHARACTER(LEN=LEN_HREC) :: YRECFM1 ! Name of the article to be read
CHARACTER(LEN=LEN_HREC) :: YRECFM2 ! Name of the article to be read
- CHARACTER(LEN=3) :: YAREA ! Area where field is to be averaged
-INTEGER :: IRESP ! reading return code
-LOGICAL :: GDATA ! T if depth is to be read in the file
-REAL, DIMENSION(SIZE(XDATA_D_ROOF,1),SIZE(XDATA_D_ROOF,2)) :: ZDATA
+ CHARACTER(LEN=LEN_HREC) :: YRECFM3 ! Name of the article to be read
+INTEGER :: IRESP ! reading return code
INTEGER :: ILAYER ! number of surface layers
-INTEGER :: JLAYER ! loop counter on surface layers
+INTEGER :: JL ! loop counter on surface layers
INTEGER :: IPAR_LAYER ! number of data surface layers
INTEGER :: IDATA_LAYER ! number of data surface layers from ecoclimap
INTEGER :: ILU ! number of points
+LOGICAL :: GECOCLIMAP, GECOSG
+LOGICAL :: GDATA, GDIM ! T if depth is to be read in the file
+LOGICAL :: GREAD_EXT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
@@ -121,22 +132,57 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('GET_TEB_DEPTHS',0,ZHOOK_HANDLE)
!
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'FULL ')
+YDIR = 'H'
+IF (PRESENT(HDIR)) YDIR = HDIR
+!
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'FULL ')
YRECFM='VERSION'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,IVERSION,IRESP)
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,IVERSION_PGD,IRESP,HDIR='-')
YRECFM='BUG'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,IBUGFIX,IRESP)
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,IBUGFIX_PGD,IRESP,HDIR='-')
+ CALL READ_LECOCLIMAP(HFILEPGDTYPE,GECOCLIMAP,GECOSG,HDIR='-')
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+GDIM = (IVERSION_PGD>8 .OR. IVERSION_PGD==8 .AND. IBUGFIX_PGD>0)
+!
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'FULL ')
+YRECFM='VERSION'
+ CALL READ_SURF(HFILETYPE,YRECFM,IVERSION_PREP,IRESP,HDIR='-')
+YRECFM='BUG'
+ CALL READ_SURF(HFILETYPE,YRECFM,IBUGFIX_PREP,IRESP,HDIR='-')
+ CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
+!
+IF (GECOSG) THEN
+ ALLOCATE(ZDATA(SUM(NTYPE),SIZE(XDATA_D_ROOF,2)))
+ELSE
+ ALLOCATE(ZDATA(NCOVER,SIZE(XDATA_D_ROOF,2)))
+ENDIF
+ZDATA(:,:) = 0.
+!
+ CALL DATA_COVER_INIT(YDTCO)
+ALLOCATE(YDTCO%XDATA_GARDEN(SIZE(ZDATA,1)))
+ALLOCATE(YDTCO%XDATA_TOWN (SIZE(ZDATA,1)))
+ALLOCATE(YDTCO%XDATA_BLD (SIZE(ZDATA,1)))
+!
+IF (SIZE(ZDATA,1)/=SIZE(XDATA_D_ROOF,1)) THEN
+ CALL DEFAULT_DATA_COVER(PDATA_TOWN=YDTCO%XDATA_TOWN,PDATA_GARDEN=YDTCO%XDATA_GARDEN,&
+ PDATA_BLD=YDTCO%XDATA_BLD)
+ELSE
+ YDTCO%XDATA_TOWN (:) = DTCO%XDATA_TOWN(:)
+ YDTCO%XDATA_GARDEN(:) = DTCO%XDATA_GARDEN(:)
+ YDTCO%XDATA_BLD (:) = DTCO%XDATA_BLD(:)
+ENDIF
!
IF (PRESENT(PD_ROOF)) THEN
YSURF='ROOF '
- ZDATA = XDATA_D_ROOF
+ IF (GECOSG) THEN
+ ZDATA = XDATA_D_ROOF
+ ELSE
+ CALL DEFAULT_DATA_COVER(PDATA_TOWN=YDTCO%XDATA_TOWN,PDATA_D_ROOF=ZDATA)
+ ENDIF
YRECFM0 = 'PAR_RF_LAYER'
YRECFM1 = 'L_D_ROOF'
YRECFM2 = 'D_D_ROOF'
+ YRECFM3 = 'D_ROOF'
IDATA_LAYER = NDATA_ROOF_LAYER
ILU = SIZE(PD_ROOF,1)
ILAYER = SIZE(PD_ROOF,2)
@@ -144,10 +190,15 @@ IF (PRESENT(PD_ROOF)) THEN
END IF
IF (PRESENT(PD_WALL)) THEN
YSURF='WALL '
- ZDATA = XDATA_D_WALL
+ IF (GECOSG) THEN
+ ZDATA = XDATA_D_WALL
+ ELSE
+ CALL DEFAULT_DATA_COVER(PDATA_TOWN=YDTCO%XDATA_TOWN,PDATA_D_WALL=ZDATA)
+ ENDIF
YRECFM0 = 'PAR_WL_LAYER'
YRECFM1 = 'L_D_WALL'
YRECFM2 = 'D_D_WALL'
+ YRECFM3 = 'D_WALL'
IDATA_LAYER = NDATA_WALL_LAYER
ILU = SIZE(PD_WALL,1)
ILAYER = SIZE(PD_WALL,2)
@@ -155,10 +206,15 @@ IF (PRESENT(PD_WALL)) THEN
END IF
IF (PRESENT(PD_ROAD)) THEN
YSURF='ROAD '
- ZDATA = XDATA_D_ROAD
+ IF (GECOSG) THEN
+ ZDATA = XDATA_D_ROAD
+ ELSE
+ CALL DEFAULT_DATA_COVER(PDATA_TOWN=YDTCO%XDATA_TOWN,PDATA_D_ROAD=ZDATA)
+ ENDIF
YRECFM0 = 'PAR_RD_LAYER'
YRECFM1 = 'L_D_ROAD'
YRECFM2 = 'D_D_ROAD'
+ YRECFM3 = 'D_ROAD'
IDATA_LAYER = NDATA_ROAD_LAYER
ILU = SIZE(PD_ROAD,1)
ILAYER = SIZE(PD_ROAD,2)
@@ -166,95 +222,118 @@ IF (PRESENT(PD_ROAD)) THEN
END IF
IF (PRESENT(PD_FLOOR)) THEN
YSURF='FLOOR'
- ZDATA = XDATA_D_FLOOR
+ IF (GECOSG) THEN
+ ZDATA = XDATA_D_FLOOR
+ ELSE
+ WHERE (YDTCO%XDATA_TOWN>0.)
+ ZDATA(:,1) = 0.01
+ ZDATA(:,2) = 0.04
+ ZDATA(:,3) = 0.10
+ END WHERE
+ ENDIF
YRECFM0 = 'PAR_FL_LAYER'
YRECFM1 = 'L_D_FLOOR'
YRECFM2 = 'D_D_FLOOR'
+ YRECFM3 = 'D_FLOOR'
IDATA_LAYER = NDATA_FLOOR_LAYER
ILU = SIZE(PD_FLOOR,1)
ILAYER = SIZE(PD_FLOOR,2)
YAREA = 'BLD'
END IF
!
-ALLOCATE(ZD(ILU,ILAYER))
-!
!* read if the depths description are written in the file
-IF (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<=2)) THEN
+IF (IVERSION_PGD<7 .OR. (IVERSION_PGD==7 .AND. IBUGFIX_PGD<=2)) THEN
GDATA = .FALSE.
ELSE
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'TOWN ')
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM1,GDATA,IRESP)
+ !
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ')
+ !
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM1,GDATA,IRESP,HDIR='-')
+ !* depths are read in the file
+ IF (GDATA) THEN
+ !* gets number of data layers
+ IPAR_LAYER = 0
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM0,IPAR_LAYER,IRESP,HDIR='-')
+ !* gets the data layers depths
+ ALLOCATE(ZD(ILU,IPAR_LAYER))
+ DO JL=1,IPAR_LAYER
+ WRITE(YRECFM,FMT='(A,I1)') TRIM(YRECFM2),JL
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZD(:,JL),IRESP,HDIR=YDIR)
+ END DO
+ ENDIF
+ !
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ !
END IF
!
!* depths are read in the file
-IF (GDATA) THEN
- !* gets number of data layers
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'TOWN ')
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM0,IPAR_LAYER,IRESP)
- !* gets the data layers depths
- ALLOCATE(ZPAR_D(ILU,IPAR_LAYER))
- DO JLAYER=1,IPAR_LAYER
- WRITE(YRECFM,FMT='(A,I1)') TRIM(YRECFM2),JLAYER
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,ZPAR_D(:,JLAYER),IRESP,HDIR='A')
- END DO
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
-!
-ELSE
+IF (.NOT.GDATA) THEN
+ !
!* depths are deduced from the cover types
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'FULL ')
- ALLOCATE(ZPAR_D(ILU,IDATA_LAYER))
- !* reading of the cover to obtain the thickness of layers
- CALL OLD_NAME(&
- HFILEPGDTYPE,'COVER_LIST ',YRECFM)
-#ifdef MNH_PARALLEL
- CALL READ_COVERS_AND_AV_PGD_1D_ON_LAYERS(&
- HFILEPGDTYPE, YRECFM, DTCO, ILU, IDATA_LAYER, ZPAR_D, ZDATA, YAREA,'ARI' )
-#else
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,GCOVER(:),IRESP,HDIR='-')
- !* reading of the cover fractions
- ALLOCATE(ZCOVER(ILU,COUNT(GCOVER)))
- YRECFM='COVER'
- CALL READ_SURF_COV(&
- HFILEPGDTYPE,YRECFM,ZCOVER(:,:),GCOVER,IRESP,HDIR='A')
+ ALLOCATE(ZD(ILU,ILAYER))
+ !
+ IF (IVERSION_PREP>8 .OR. (IVERSION_PREP==8 .AND. IBUGFIX_PREP>=1)) THEN
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ')
+ CALL READ_SURF(HFILETYPE,'WRITE_EXT ',GREAD_EXT,IRESP,HDIR='-')
+ IF (GREAD_EXT) THEN
+ DO JL=1,ILAYER
+ WRITE(YRECFM,FMT='(A,I1)') TRIM(YRECFM3),JL
+ CALL READ_SURF(HFILETYPE,YRECFM,ZD(:,JL),IRESP,HDIR=YDIR)
+ END DO
+ ENDIF
+ CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
+ ELSE
+ GREAD_EXT = .FALSE.
+ ENDIF
!
- !* deduces the depths of each layer
- DO JLAYER=1,IDATA_LAYER
- CALL AV_PGD(DTCO, &
- ZPAR_D(:,JLAYER), ZCOVER, ZDATA(:,JLAYER),YAREA,'ARI',GCOVER)
- END DO
- DEALLOCATE(ZCOVER)
-#endif
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ IF (.NOT.GREAD_EXT) THEN
+ !
+ IF (GDIM.AND.GECOSG) THEN
+ ALLOCATE(GCOVER(SUM(NTYPE)))
+ ELSE
+ ALLOCATE(GCOVER(NCOVER))
+ ENDIF
+ !
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'FULL ')
+ !* reading of the cover to obtain the thickness of layers
+ YRECFMOLD='COVER_LIST'
+ CALL OLD_NAME(HFILEPGDTYPE,YRECFMOLD,YRECFM,'-')
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,GCOVER(:),IRESP,HDIR='-')
+ !* reading of the cover fractions
+ IF (YDIR/='E'.OR.NRANK==NPIO) THEN
+ ALLOCATE(ZCOVER(ILU,COUNT(GCOVER)))
+ ELSE
+ ALLOCATE(ZCOVER(0,0))
+ ENDIF
+ YRECFM='COVER'
+ CALL READ_SURF_COV(HFILEPGDTYPE,YRECFM,ZCOVER(:,:),GCOVER,IRESP,&
+ HDIR=YDIR)
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ !
+ ALLOCATE(ZPAR_D(ILU,IDATA_LAYER))
+ IF (NRANK==NPIO) THEN
+ !* deduces the depths of each layer
+ DO JL=1,IDATA_LAYER
+ CALL AV_PGD (YDTCO,ZPAR_D(:,JL), ZCOVER, ZDATA(:,JL),YAREA,'ARI',GCOVER)
+ END DO
+ ENDIF
+ CALL DATA_COVER_INIT(YDTCO)
+ DEALLOCATE(ZDATA)
+ DEALLOCATE(GCOVER,ZCOVER)
+ !
+ IF (IVERSION_PREP<7 .OR. (IVERSION_PREP==7 .AND. IBUGFIX_PREP<=2)) THEN
+ !* ind version of TEB, the computational grid was equal to the data grid
+ ZD(:,:) = ZPAR_D(:,:)
+ ELSEIF (NRANK==NPIO) THEN
+ !* recomputes the grid from the available data
+ CALL THERMAL_LAYERS_CONF(YSURF,ZPAR_D,ZD)
+ END IF
+ DEALLOCATE(ZPAR_D)
+ !
+ ENDIF
+ !
ENDIF
!
-!* recomputes the grid from the available data
-!
-IF (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<=2)) THEN
- !* in old version of TEB, the computational grid was equal to the data grid
- ZD(:,:) = ZPAR_D(:,:)
-ELSE
- !* recomputes the grid from the available data
- ALLOCATE(ZPAR_HC(ILU,SIZE(ZPAR_D,2)))
- ALLOCATE(ZPAR_TC(ILU,SIZE(ZPAR_D,2)))
- ALLOCATE(ZTC (ILU,ILAYER))
- ALLOCATE(ZHC (ILU,ILAYER))
- ZPAR_HC = 1.E6 ! not physically used
- ZPAR_TC = 1. ! not physically used
- CALL THERMAL_LAYERS_CONF(YSURF,ZPAR_HC,ZPAR_TC,ZPAR_D,ZHC,ZTC,ZD)
- DEALLOCATE(ZPAR_HC)
- DEALLOCATE(ZPAR_TC)
- DEALLOCATE(ZHC)
- DEALLOCATE(ZTC)
-END IF
-!
IF (PRESENT(PD_ROOF )) PD_ROOF = ZD
IF (PRESENT(PD_WALL )) PD_WALL = ZD
IF (PRESENT(PD_ROAD )) PD_ROAD = ZD
diff --git a/src/SURFEX/get_type_dimn.F90 b/src/SURFEX/get_type_dimn.F90
index 363cb24514f55b1a0abc20db373cdc630abdddc1..b3b98462276242e11e3e7f37dc6cbc980aea6adc 100644
--- a/src/SURFEX/get_type_dimn.F90
+++ b/src/SURFEX/get_type_dimn.F90
@@ -70,13 +70,20 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('GET_TYPE_DIM_N',0,ZHOOK_HANDLE)
-IF (.NOT. ASSOCIATED(U%XCOVER) .AND. LHOOK) CALL DR_HOOK('GET_TYPE_DIM_N',1,ZHOOK_HANDLE)
-IF (.NOT. ASSOCIATED(U%XCOVER)) RETURN
+!
+IF (.NOT. ASSOCIATED(U%XCOVER).AND..NOT.ASSOCIATED(U%XSEA)) THEN
+ IF (LHOOK) CALL DR_HOOK('GET_TYPE_DIM_N',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
!
!* 1. Fractions
! ---------
!
-ILU = SIZE(U%XCOVER,1)
+IF (ASSOCIATED(U%XCOVER)) THEN
+ ILU = SIZE(U%XCOVER,1)
+ELSEIF (ASSOCIATED(U%XSEA)) THEN
+ ILU = SIZE(U%XSEA)
+ENDIF
!
ALLOCATE(ZSEA (ILU))
ALLOCATE(ZNATURE(ILU))
diff --git a/src/SURFEX/get_var_naturen.F90 b/src/SURFEX/get_var_naturen.F90
index 021443bbae7fba275a3aa8bdc06101c441c0186c..e877d594d133bc85e18f62a596f5d24edb1fdc2c 100644
--- a/src/SURFEX/get_var_naturen.F90
+++ b/src/SURFEX/get_var_naturen.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GET_VAR_NATURE_n (I, DGI, DGMI, &
+ SUBROUTINE GET_VAR_NATURE_n (S, DGO, D, DMI, &
HPROGRAM,KI,PQS,PSNG,PSNV,PZ0EFF,PZ0,PZ0H,PTWSNOW,PBARE)
! ######################################################################
!
@@ -42,8 +42,8 @@
! ------------
!
!
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
!
USE MODI_GET_LUOUT
@@ -60,9 +60,10 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(DIAG_ISBA_t), INTENT(INOUT) :: DGI
-TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DGMI
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMI
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
INTEGER, INTENT(IN) :: KI ! Number of points
@@ -87,33 +88,33 @@ IF (LHOOK) CALL DR_HOOK('GET_VAR_NATURE_N',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!-------------------------------------------------------------------------------
!
-IF (DGI%LSURF_VARS) THEN
- PQS = DGI%XAVG_QS
+IF (DGO%LSURF_VARS) THEN
+ PQS = D%XQS
ELSE
PQS = XUNDEF
ENDIF
!
-IF (DGMI%LSURF_MISC_BUDGET) THEN
- PSNG = DGMI%XAVG_PSNG
- PSNV = DGMI%XAVG_PSNV
- PTWSNOW = DGMI%XAVG_TWSNOW
+IF (DMI%LSURF_MISC_BUDGET) THEN
+ PSNG = DMI%XPSNG
+ PSNV = DMI%XPSNV
+ PTWSNOW = DMI%XTWSNOW
ELSE
PSNG = XUNDEF
PSNV = XUNDEF
PTWSNOW = XUNDEF
ENDIF
!
-IF (DGI%LCOEF) THEN
- PZ0EFF = DGI%XAVG_Z0EFF
- PZ0 = DGI%XAVG_Z0
- PZ0H = DGI%XAVG_Z0H
+IF (DGO%LCOEF) THEN
+ PZ0EFF = D%XZ0EFF
+ PZ0 = D%XZ0
+ PZ0H = D%XZ0H
ELSE
PZ0EFF = XUNDEF
PZ0 = XUNDEF
PZ0H = XUNDEF
ENDIF
!
-PBARE = I%XVEGTYPE(:,NVT_NO)
+PBARE = S%XVEGTYPE(:,NVT_NO)
!
IF (LHOOK) CALL DR_HOOK('GET_VAR_NATURE_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/get_var_sean.F90 b/src/SURFEX/get_var_sean.F90
index 2de64a72ecb96efb848df25a93b9c10183591296..b4b312b171075813a891e7327adfdae6310d92e8 100644
--- a/src/SURFEX/get_var_sean.F90
+++ b/src/SURFEX/get_var_sean.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GET_VAR_SEA_n (DGS, &
- HPROGRAM,KI,PQS,PZ0,PZ0H)
+ SUBROUTINE GET_VAR_SEA_n (DGO, D, HPROGRAM,KI,PQS,PZ0,PZ0H)
! ##################################################
!
!!**** *GET_VAR_SEA_n* - routine to get variables defined only over sea
@@ -40,7 +39,7 @@
! ------------
!
!
-USE MODD_DIAG_SEAFLUX_n, ONLY : DIAG_SEAFLUX_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
!
USE MODI_GET_LUOUT
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -56,7 +55,8 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(DIAG_SEAFLUX_t), INTENT(INOUT) :: DGS
+TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
INTEGER, INTENT(IN) :: KI ! Number of points
@@ -76,14 +76,14 @@ IF (LHOOK) CALL DR_HOOK('GET_VAR_SEA_N',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!-------------------------------------------------------------------------------
!
-IF (DGS%LSURF_VARS) THEN
- PQS = DGS%XQS
+IF (DGO%LSURF_VARS) THEN
+ PQS = D%XQS
ELSE
PQS = XUNDEF
ENDIF
-IF (DGS%LCOEF) THEN
- PZ0 = DGS%XZ0
- PZ0H = DGS%XZ0H
+IF (DGO%LCOEF) THEN
+ PZ0 = D%XZ0
+ PZ0H = D%XZ0H
ELSE
PZ0 = XUNDEF
PZ0H = XUNDEF
diff --git a/src/SURFEX/get_var_townn.F90 b/src/SURFEX/get_var_townn.F90
index e91507451affe9404e6c2c5df8fe63af4577787b..0f2e9c9d7a8501a326655eb869dbe19ee0f69416 100644
--- a/src/SURFEX/get_var_townn.F90
+++ b/src/SURFEX/get_var_townn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GET_VAR_TOWN_n (DGT, &
- HPROGRAM,KI,PQS,PZ0,PZ0H)
+ SUBROUTINE GET_VAR_TOWN_n (DGO, D, HPROGRAM,KI,PQS,PZ0,PZ0H)
! ###################################################
!
!!**** *GET_VAR_TOWN_n* - routine to get variables defined only over town
@@ -40,7 +39,7 @@
! ------------
!
!
-USE MODD_DIAG_TEB_n, ONLY : DIAG_TEB_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
!
USE MODI_GET_LUOUT
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -55,8 +54,8 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-TYPE(DIAG_TEB_t), INTENT(INOUT) :: DGT
+TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DGO
+TYPE(DIAG_t), INTENT(IN) :: D
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
INTEGER, INTENT(IN) :: KI ! Number of points
@@ -76,14 +75,14 @@ IF (LHOOK) CALL DR_HOOK('GET_VAR_TOWN_N',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!-------------------------------------------------------------------------------
!
-IF (DGT%LSURF_VARS) THEN
- PQS = DGT%XQS
+IF (DGO%LSURF_VARS) THEN
+ PQS = D%XQS
ELSE
PQS = XUNDEF
ENDIF
-IF (DGT%LCOEF) THEN
- PZ0 = DGT%XZ0
- PZ0H = DGT%XZ0H
+IF (DGO%LCOEF) THEN
+ PZ0 = D%XZ0
+ PZ0H = D%XZ0H
ELSE
PZ0 = XUNDEF
PZ0H = XUNDEF
diff --git a/src/SURFEX/get_var_watern.F90 b/src/SURFEX/get_var_watern.F90
index fb87f14e3a520daabf28ac55a5abfe149a656c7b..5a8dff8120c48d550c16678f2677255f1b9b72d9 100644
--- a/src/SURFEX/get_var_watern.F90
+++ b/src/SURFEX/get_var_watern.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GET_VAR_WATER_n (DGF, DGW, &
+ SUBROUTINE GET_VAR_WATER_n (DFO, DF, DWO, DW, &
HPROGRAM,KI,HWATER,PQS,PZ0,PZ0H)
! ###########################################################
!
@@ -38,9 +38,7 @@
!* 0. DECLARATIONS
! ------------
!
-!
-USE MODD_DIAG_FLAKE_n, ONLY : DIAG_FLAKE_t
-USE MODD_DIAG_WATFLUX_n, ONLY : DIAG_WATFLUX_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
!
USE MODI_GET_LUOUT
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -55,8 +53,10 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(DIAG_FLAKE_t), INTENT(INOUT) :: DGF
-TYPE(DIAG_WATFLUX_t), INTENT(INOUT) :: DGW
+TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DFO
+TYPE(DIAG_t), INTENT(INOUT) :: DF
+TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DWO
+TYPE(DIAG_t), INTENT(INOUT) :: DW
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
CHARACTER(LEN=6), INTENT(IN) :: HWATER
@@ -80,7 +80,7 @@ ELSE
END IF
!
IF (LHOOK) CALL DR_HOOK('GET_VAR_WATER_N',1,ZHOOK_HANDLE)
- CONTAINS
+CONTAINS
!
!------------------------------------------------------------------------------
!------------------------------------------------------------------------------
@@ -96,14 +96,14 @@ IF (LHOOK) CALL DR_HOOK('GET_VAR_WATFLX_N',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!-------------------------------------------------------------------------------
!
-IF (DGW%LSURF_VARS) THEN
- PQS = DGW%XQS
+IF (DWO%LSURF_VARS) THEN
+ PQS = DW%XQS
ELSE
PQS = XUNDEF
ENDIF
-IF (DGW%LCOEF) THEN
- PZ0 = DGW%XZ0
- PZ0H = DGW%XZ0H
+IF (DWO%LCOEF) THEN
+ PZ0 = DW%XZ0
+ PZ0H = DW%XZ0H
ELSE
PZ0 = XUNDEF
PZ0H = XUNDEF
@@ -125,14 +125,14 @@ IF (LHOOK) CALL DR_HOOK('GET_VAR_FLAKE_N',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!-------------------------------------------------------------------------------
!
-IF (DGF%LSURF_VARS) THEN
- PQS = DGF%XQS
+IF (DFO%LSURF_VARS) THEN
+ PQS = DF%XQS
ELSE
PQS = XUNDEF
ENDIF
-IF (DGF%LCOEF) THEN
- PZ0 = DGF%XZ0
- PZ0H = DGF%XZ0H
+IF (DFO%LCOEF) THEN
+ PZ0 = DF%XZ0
+ PZ0H = DF%XZ0H
ELSE
PZ0 = XUNDEF
PZ0H = XUNDEF
diff --git a/src/SURFEX/get_vegn.F90 b/src/SURFEX/get_vegn.F90
index 4959d594a056354276e2019476e3d03ed4eff85e..7a0237ff87ee7d01f44838b2597a0a558f0b63c9 100644
--- a/src/SURFEX/get_vegn.F90
+++ b/src/SURFEX/get_vegn.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #######################################################################
- SUBROUTINE GET_VEG_n(HPROGRAM, KI, U, I, PLAI, PVH)
+ SUBROUTINE GET_VEG_n(HPROGRAM, KI, U, IO, S, NP, NPE, PLAI, PVH)
! #######################################################################
!
!!**** *GET_VEG_n* - gets some veg fields on atmospheric grid
@@ -35,7 +35,8 @@
! ------------
!
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_P_t, ISBA_PE_t, ISBA_NP_t, ISBA_NPE_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_DATA_COVER_PAR
@@ -50,11 +51,14 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
INTEGER, INTENT(IN) :: KI ! number of points
!
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
!
REAL, DIMENSION(KI), INTENT(OUT) :: PVH ! Tree height
REAL, DIMENSION(KI), INTENT(OUT) :: PLAI
@@ -67,71 +71,74 @@ REAL, DIMENSION(KI), INTENT(OUT) :: PLAI
! Arrays defined for each tile
!
!
+TYPE(ISBA_P_t), POINTER :: PK
+TYPE(ISBA_PE_t), POINTER :: PEK
INTEGER :: JI,JJ ! loop index over tiles
INTEGER :: ILUOUT ! unit numberi
REAL, DIMENSION(U%NSIZE_NATURE) :: ZH_TREE, ZLAI,ZWORK
INTEGER:: IPATCH_TRBE, IPATCH_TRBD, IPATCH_TEBE, IPATCH_TEBD, IPATCH_TENE, &
- IPATCH_BOBD, IPATCH_BONE, IPATCH_BOND
+ IPATCH_BOBD, IPATCH_BONE, IPATCH_BOND, IMASK, JP
!
!-------------------------------------------------------------------------------
!
!* 0. Logical unit for writing out
!
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
+CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
!-------------------------------------------------------------------------------
!
!* 1. Passage dur le masque global
! -------------------------------
-IPATCH_TRBE = VEGTYPE_TO_PATCH(NVT_TRBE, I%NPATCH)
-IPATCH_TRBD = VEGTYPE_TO_PATCH(NVT_TRBD, I%NPATCH)
-IPATCH_TEBE = VEGTYPE_TO_PATCH(NVT_TEBE, I%NPATCH)
-IPATCH_TEBD = VEGTYPE_TO_PATCH(NVT_TEBD, I%NPATCH)
-IPATCH_TENE = VEGTYPE_TO_PATCH(NVT_TENE, I%NPATCH)
-IPATCH_BOBD = VEGTYPE_TO_PATCH(NVT_BOBD, I%NPATCH)
-IPATCH_BONE = VEGTYPE_TO_PATCH(NVT_BONE, I%NPATCH)
-IPATCH_BOND = VEGTYPE_TO_PATCH(NVT_BOND, I%NPATCH)
+IPATCH_TRBE = VEGTYPE_TO_PATCH(NVT_TRBE, IO%NPATCH)
+IPATCH_TRBD = VEGTYPE_TO_PATCH(NVT_TRBD, IO%NPATCH)
+IPATCH_TEBE = VEGTYPE_TO_PATCH(NVT_TEBE, IO%NPATCH)
+IPATCH_TEBD = VEGTYPE_TO_PATCH(NVT_TEBD, IO%NPATCH)
+IPATCH_TENE = VEGTYPE_TO_PATCH(NVT_TENE, IO%NPATCH)
+IPATCH_BOBD = VEGTYPE_TO_PATCH(NVT_BOBD, IO%NPATCH)
+IPATCH_BONE = VEGTYPE_TO_PATCH(NVT_BONE, IO%NPATCH)
+IPATCH_BOND = VEGTYPE_TO_PATCH(NVT_BOND, IO%NPATCH)
-ZWORK(:) = I%XVEGTYPE(:,NVT_TRBE) + I%XVEGTYPE(:,NVT_TRBD) + I%XVEGTYPE(:,NVT_TEBE) + &
- I%XVEGTYPE(:,NVT_TEBD) + I%XVEGTYPE(:,NVT_TENE) + I%XVEGTYPE(:,NVT_BOBD) + &
- I%XVEGTYPE(:,NVT_BONE) + I%XVEGTYPE(:,NVT_BOND)
+ZWORK(:) = S%XVEGTYPE(:,NVT_TRBE) + S%XVEGTYPE(:,NVT_TRBD) + S%XVEGTYPE(:,NVT_TEBE) + &
+ S%XVEGTYPE(:,NVT_TEBD) + S%XVEGTYPE(:,NVT_TENE) + S%XVEGTYPE(:,NVT_BOBD) + &
+ S%XVEGTYPE(:,NVT_BONE) + S%XVEGTYPE(:,NVT_BOND)
-DO JJ=1,U%NSIZE_NATURE
+ZH_TREE(:) = 0.
+ZLAI(:) = 0.
+!
+DO JP = 1,IO%NPATCH
!
- IF (ZWORK(JJ)==0) THEN
- !
- ZH_TREE(JJ) = 0.
- ZLAI(JJ) = 0.
+ IF (JP==IPATCH_TRBE .OR. JP==IPATCH_TRBD .OR. JP==IPATCH_TEBE .OR. JP==IPATCH_TEBD .OR. &
+ JP==IPATCH_TENE .OR. JP==IPATCH_BOBD .OR. JP==IPATCH_BONE .OR. JP==IPATCH_BOND) THEN
!
- ELSE
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
!
- ZH_TREE(JJ) = ( (I%XH_TREE(JJ,IPATCH_TRBE) * I%XVEGTYPE(JJ,NVT_TRBE) ) + &
- (I%XH_TREE(JJ,IPATCH_TRBD) * I%XVEGTYPE(JJ,NVT_TRBD) ) + &
- (I%XH_TREE(JJ,IPATCH_TEBE) * I%XVEGTYPE(JJ,NVT_TEBE) ) + &
- (I%XH_TREE(JJ,IPATCH_TEBD) * I%XVEGTYPE(JJ,NVT_TEBD) ) + &
- (I%XH_TREE(JJ,IPATCH_TENE) * I%XVEGTYPE(JJ,NVT_TENE) ) + &
- (I%XH_TREE(JJ,IPATCH_BOBD) * I%XVEGTYPE(JJ,NVT_BOBD) ) + &
- (I%XH_TREE(JJ,IPATCH_BONE) * I%XVEGTYPE(JJ,NVT_BONE) ) + &
- (I%XH_TREE(JJ,IPATCH_BOND) * I%XVEGTYPE(JJ,NVT_BOND) ) &
- ) / ZWORK(JJ)
-
- ZLAI(JJ) = ( I%XLAI(JJ,IPATCH_TRBE) * I%XVEGTYPE(JJ,NVT_TRBE) ) + &
- ( I%XLAI(JJ,IPATCH_TRBD) * I%XVEGTYPE(JJ,NVT_TRBD) ) + &
- ( I%XLAI(JJ,IPATCH_TEBE) * I%XVEGTYPE(JJ,NVT_TEBE) ) + &
- ( I%XLAI(JJ,IPATCH_TEBD) * I%XVEGTYPE(JJ,NVT_TEBD) ) + &
- ( I%XLAI(JJ,IPATCH_TENE) * I%XVEGTYPE(JJ,NVT_TENE) ) + &
- ( I%XLAI(JJ,IPATCH_BOBD) * I%XVEGTYPE(JJ,NVT_BOBD) ) + &
- ( I%XLAI(JJ,IPATCH_BONE) * I%XVEGTYPE(JJ,NVT_BONE) )+ &
- ( I%XLAI(JJ,IPATCH_BOND) * I%XVEGTYPE(JJ,NVT_BOND) )
-
+ DO JJ=1,PK%NSIZE_P
+ !
+ IMASK = PK%NR_P(JJ)
+ !
+ IF (S%XVEGTYPE(IMASK,JP)/=0) THEN
+ !
+ ZH_TREE(IMASK) = ZH_TREE(IMASK) + PK%XH_TREE(JJ) * PK%XPATCH(JJ)
+ !
+ ZLAI(IMASK) = ZLAI(IMASK) + PEK%XLAI(JJ) * PK%XPATCH(JJ)
+ !
+ ENDIF
+ !
+ ENDDO
!
- END IF
+ ENDIF
!
- ZLAI(JJ) = U%XNATURE(U%NR_NATURE(JJ)) * ZLAI(JJ)
- !
-END DO
+ENDDO
+!
+WHERE(ZWORK(:)/=0.)
+ ZH_TREE(:) = ZH_TREE(:)/ZWORK(:)
+ ZLAI(:) = ZLAI(:)/ZWORK(:)
+END WHERE
+!
+ZLAI(:) = U%XNATURE(:) * ZLAI(:)
!
!* 2. Envoi les variables vers mesonH
! ------------------------------
diff --git a/src/SURFEX/get_vegtype_2_patch_mask.F90 b/src/SURFEX/get_vegtype_2_patch_mask.F90
index 0dbfb5c88282b0379e550e585c1cb19f2f738390..93ea7f1b5dfc69270d63fafb6da26c95b31a763a 100644
--- a/src/SURFEX/get_vegtype_2_patch_mask.F90
+++ b/src/SURFEX/get_vegtype_2_patch_mask.F90
@@ -6,12 +6,9 @@ SUBROUTINE GET_VEGTYPE_2_PATCH_MASK( &
KLUOUT, &! output listing logical unit
KSIZE_VEG, &!I Size of a vegetation vector within a patch vector
KSIZE_PATCH, &!I Size of a patch within a nature vector
- KSIZE_NAT, &!I Size of nature vector
KMASK_PATCH_NATURE, &!I Mask to transform from patch vector to nature vector
PVEGTYPE_PATCH, &!I Fraction of a nature point #i with vegetation #j which is packed to patch #k
KMASK, &!O Mask from vegtype vector to patch vector
- KPATCH_MAX, &!I Number of possible patches
- KPATCH, &!I Index of patch in question
KVEGTYPE &!I Index of vegtype in question
)
!
@@ -43,14 +40,11 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KLUOUT !Output listing logical unit
INTEGER, INTENT(IN) :: KSIZE_VEG !Size of vegetation vector in question
INTEGER, INTENT(IN) :: KSIZE_PATCH !Size of patch vector in question
-INTEGER, INTENT(IN) :: KSIZE_NAT !Size of nature vector
-INTEGER, INTENT(IN),DIMENSION(KSIZE_PATCH) :: KMASK_PATCH_NATURE !PATCH -->NATURE mask
-INTEGER, INTENT(IN) :: KPATCH_MAX !Number of possible patches
+INTEGER, INTENT(IN),DIMENSION(:) :: KMASK_PATCH_NATURE !PATCH -->NATURE mask
!
-INTEGER, INTENT(IN) :: KPATCH !Patch in question
INTEGER, INTENT(IN) :: KVEGTYPE !Vegtype in quesition
-REAL, DIMENSION(KSIZE_NAT,NVEGTYPE,KPATCH_MAX), INTENT(IN) :: PVEGTYPE_PATCH !Fraction of nature point in npatch with nveg vegetation
+REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE_PATCH !Fraction of nature point in npatch with nveg vegetation
!
!OUTPUT
INTEGER, DIMENSION(KSIZE_VEG), INTENT(OUT) :: KMASK !vegetation type to patch
@@ -71,7 +65,7 @@ KMASK(:) = 0
KK=1 !First point of vegetation-vector
DO JJ=1,KSIZE_PATCH !Number of points in the patch in question
II=KMASK_PATCH_NATURE(JJ) !Nature-index corresponding to the point in question
- IF(PVEGTYPE_PATCH(II,KVEGTYPE,KPATCH)>0.)THEN
+ IF(PVEGTYPE_PATCH(II,KVEGTYPE)>0.)THEN
KMASK(KK)=JJ
KK=KK+1
ENDIF
diff --git a/src/SURFEX/get_xyall_ign.F90 b/src/SURFEX/get_xyall_ign.F90
index cf1313eff11a4d407db62c0b3f693cca538a0548..8e006ee9a8162bcd37c62be3cbc2f5a2d573db38 100644
--- a/src/SURFEX/get_xyall_ign.F90
+++ b/src/SURFEX/get_xyall_ign.F90
@@ -65,16 +65,14 @@ KDIMX = 0
KDIMY = 0
!
CALL GET_COORD(PX,PDX,ZALL,KDIMX)
-!sort values from lower to grower
- CALL SORT(KDIMX,ZALL,PXALL)
+PXALL(1:KDIMX) = ZALL(1:KDIMX)
!
CALL GET_COORD(PY,PDY,ZALL,KDIMY)
-!sort values from lower to grower
- CALL SORT(KDIMY,ZALL,PYALL)
+PYALL(1:KDIMY) = ZALL(1:KDIMY)
!
IF (LHOOK) CALL DR_HOOK('GET_XYALL_IGN',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!
SUBROUTINE GET_COORD(PIN,PDIN,POUT,KSIZE)
!
@@ -84,82 +82,70 @@ REAL, DIMENSION(:), INTENT(IN) :: PIN
REAL, DIMENSION(:), INTENT(IN) :: PDIN
REAL, DIMENSION(:), INTENT(OUT) :: POUT
INTEGER, INTENT(INOUT) :: KSIZE
-REAL, DIMENSION(SIZE(POUT)) :: ZDOUT
-INTEGER :: I, J
+REAL, DIMENSION(SIZE(POUT)) :: ZDOUT, ZOUT, ZDOUT2
+REAL :: ZMAX, ZMIN
+INTEGER :: I, J, IDMIN, ICPT, ISIZE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('GET_XYALL_IGN:GET_COORD',0,ZHOOK_HANDLE)
!
-ZDOUT(:) = 0.
-POUT (:) = -9999.
-IF (SIZE(POUT)>0) THEN
- ZDOUT(1) = PDIN(1)/2.
- POUT (1) = PIN(1)
- IF (SIZE(POUT)>1) POUT (2) = PIN(1)-PDIN(1)
- IF (SIZE(POUT)>2) POUT (3) = PIN(1)+PDIN(1)
-ENDIF
-KSIZE = MIN(3,SIZE(PIN))
-!
-DO I=1,SIZE(PIN)
- !point
- DO J=1,KSIZE
- IF ( POUT(J) == PIN(I) ) EXIT
- IF ( J == KSIZE ) THEN
- KSIZE = KSIZE + 1
- POUT (KSIZE) = PIN (I)
- ZDOUT(KSIZE) = PDIN(I)/2.
- ENDIF
- ENDDO
- !limits of the mesh
- DO J=1,KSIZE
- IF ( POUT(J)<PIN(I) .AND. POUT(J)+ZDOUT(J)>=PIN(I)-PDIN(I) ) EXIT
- IF ( J == KSIZE ) THEN
- KSIZE = KSIZE + 1
- POUT(KSIZE) = PIN(I)-PDIN(I)
- ENDIF
- ENDDO
- DO J=1,KSIZE
- IF ( POUT(J)>PIN(I) .AND. POUT(J)-ZDOUT(J)<=PIN(I)+PDIN(I) ) EXIT
- IF ( J == KSIZE ) THEN
- KSIZE = KSIZE + 1
- POUT(KSIZE) = PIN(I)+PDIN(I)
- ENDIF
- ENDDO
-ENDDO
-!
-IF (LHOOK) CALL DR_HOOK('GET_XYALL_IGN:GET_COORD',1,ZHOOK_HANDLE)
+KSIZE = SIZE(PIN)
+ZOUT (1:KSIZE) = PIN (:)
+ZDOUT(1:KSIZE) = PDIN(:)
!
-END SUBROUTINE GET_COORD
+ZMAX = MAXVAL(ZOUT(1:KSIZE))
+DO J=1,KSIZE
+ ZMIN = MINVAL(ZOUT(1:KSIZE))
+ POUT(J) = ZMIN
+ IDMIN = MINLOC(ZOUT(1:KSIZE),1)
+ ZDOUT2(J) = ZDOUT(IDMIN)
+ ZOUT(IDMIN) = ZMAX+1
+ENDDO
!
-SUBROUTINE SORT(KSIZE,PIN,POUT)
+ZOUT (1:KSIZE) = POUT (1:KSIZE)
+ZDOUT(1:KSIZE) = ZDOUT2(1:KSIZE)
!
-IMPLICIT NONE
+ICPT = 1
+ISIZE = KSIZE
+DO J=1,ISIZE-1
+ IF (ZOUT(J)==ZOUT(J+1)) THEN
+ IF (J<ISIZE-1) THEN
+ POUT (ICPT+1:KSIZE-1) = ZOUT (J+2:ISIZE)
+ ZDOUT(ICPT+1:KSIZE-1) = ZDOUT2(J+2:ISIZE)
+ ENDIF
+ KSIZE = KSIZE - 1
+ ELSE
+ ICPT = ICPT + 1
+ ENDIF
+ENDDO
!
-INTEGER, INTENT(INOUT) :: KSIZE
-REAL, DIMENSION(:), INTENT(INOUT) :: PIN
-REAL, DIMENSION(:), INTENT(OUT) :: POUT
-REAL, DIMENSION(SIZE(PIN)) :: ZOUT
-REAL :: ZMIN, ZMAX
-INTEGER,DIMENSION(1) :: IDMIN
-INTEGER :: J
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ISIZE = KSIZE
+DO J=1,ISIZE-1
+ IF (POUT(J)+ZDOUT(J)/2.<POUT(J+1)-ZDOUT(J+1)/2.) THEN
+ ICPT = 0
+ KSIZE = KSIZE + 1
+ POUT (KSIZE) = POUT (J) + ZDOUT(J)
+ ZDOUT(KSIZE) = ZDOUT(J)
+ DO WHILE ( POUT(KSIZE)+ZDOUT(KSIZE)/2. < POUT(J+1)-ZDOUT(J+1)/2. )
+ POUT (KSIZE+1) = POUT (KSIZE) + ZDOUT(KSIZE)
+ ZDOUT(KSIZE+1) = ZDOUT(KSIZE)
+ KSIZE = KSIZE + 1
+ ENDDO
+ ENDIF
+ENDDO
!
-IF (LHOOK) CALL DR_HOOK('GET_XYALL_IGN:SORT',0,ZHOOK_HANDLE)
+ZOUT(1:KSIZE) = POUT(1:KSIZE)
!
-ZMAX = MAXVAL(PIN(1:KSIZE))
+ZMAX = MAXVAL(ZOUT(1:KSIZE))
DO J=1,KSIZE
- ZMIN = MINVAL(PIN(1:KSIZE))
- ZOUT(J) = ZMIN
- IDMIN = MINLOC(PIN(1:KSIZE))
- PIN(IDMIN(1)) = ZMAX+1
+ ZMIN = MINVAL(ZOUT(1:KSIZE))
+ POUT(J) = ZMIN
+ IDMIN = MINLOC(ZOUT(1:KSIZE),1)
+ ZOUT(IDMIN) = ZMAX+1
ENDDO
!
-!to suppress fictive points at boundaries
-POUT(1:KSIZE-2) = ZOUT(2:KSIZE-1)
-KSIZE = MAX(0,KSIZE-2)
-!
-IF (LHOOK) CALL DR_HOOK('GET_XYALL_IGN:SORT',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('GET_XYALL_IGN:GET_COORD',1,ZHOOK_HANDLE)
!
-END SUBROUTINE SORT
+END SUBROUTINE GET_COORD
!
END SUBROUTINE GET_XYALL_IGN
diff --git a/src/SURFEX/get_z0n.F90 b/src/SURFEX/get_z0n.F90
index c5ceb42c394f792644f7ce88cd0daad10e6ece3f..cfe9717b798fe7539bbcd7b2a0b7944e045357a6 100644
--- a/src/SURFEX/get_z0n.F90
+++ b/src/SURFEX/get_z0n.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GET_Z0_n (DGU, &
- HPROGRAM,KI,PZ0,PZ0H)
+ SUBROUTINE GET_Z0_n (DGO, D, HPROGRAM,KI,PZ0,PZ0H)
! #########################################
!
!!**** *GET_Z0_n* - routine to get roughness lengths
@@ -39,7 +38,7 @@
! ------------
!
!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
!
USE MODI_GET_LUOUT
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -54,8 +53,8 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
INTEGER, INTENT(IN) :: KI ! Number of points
@@ -74,9 +73,9 @@ IF (LHOOK) CALL DR_HOOK('GET_Z0_N',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!-------------------------------------------------------------------------------
!
-IF (DGU%LCOEF) THEN
- PZ0 = DGU%XAVG_Z0
- PZ0H = DGU%XAVG_Z0H
+IF (DGO%LCOEF) THEN
+ PZ0 = D%XZ0
+ PZ0H = D%XZ0H
ELSE
PZ0 = XUNDEF
PZ0H = XUNDEF
diff --git a/src/SURFEX/get_z0rel.F90 b/src/SURFEX/get_z0rel.F90
new file mode 100644
index 0000000000000000000000000000000000000000..dacae5e4505b35d8f5af9c90c142507dbd53d232
--- /dev/null
+++ b/src/SURFEX/get_z0rel.F90
@@ -0,0 +1,70 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! ######spl
+ SUBROUTINE GET_Z0REL(ISS,OMASK )
+! ######################################################################
+!
+!* 0. DECLARATION
+! -----------
+!
+USE MODD_CSTS, ONLY : XKARMAN
+USE MODD_ISBA_PAR, ONLY : XCDZ0EFF
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE MODD_SSO_n, ONLY : SSO_t
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of dummy arguments
+! ------------------------------
+!
+TYPE(SSO_t), INTENT(INOUT) :: ISS
+!
+LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL :: OMASK ! mask where computations
+ ! are done
+!
+!* 0.2 Declaration of other local variables
+! ------------------------------------
+!
+REAL, DIMENSION(SIZE(ISS%XAOSIP)) :: ZLOC
+LOGICAL, DIMENSION(SIZE(ISS%XAOSIP)) :: GMASK
+!
+INTEGER :: JJ ! loop counter on points
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!----------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('GET_Z0REL',0,ZHOOK_HANDLE)
+!
+IF (PRESENT(OMASK)) THEN
+ GMASK=OMASK
+ELSE
+ GMASK=(ISS%XAOSIP/=XUNDEF)
+END IF
+!
+ISS%XZ0REL=XUNDEF
+!
+ZLOC(:) = 0.
+!
+WHERE (GMASK(:))
+ ZLOC (:) = 0.25 * XCDZ0EFF/(2.*XKARMAN**2) &
+ * (ISS%XAOSIP(:) + ISS%XAOSIM(:) + ISS%XAOSJP(:) + ISS%XAOSJM(:))
+ WHERE ( ZLOC(:) > 0. )
+ ISS%XZ0REL(:) = 0.25 * (ISS%XHO2IP(:) + ISS%XHO2IM(:) + ISS%XHO2JP(:) + ISS%XHO2JM(:)) &
+ * EXP(-SQRT(1./ZLOC(:)))
+ ISS%XZ0REL(:) = MAX(ISS%XZ0REL(:),1E-10)
+ ELSEWHERE
+ ISS%XZ0REL(:) = 0.
+ END WHERE
+END WHERE
+!
+IF (LHOOK) CALL DR_HOOK('GET_Z0REL',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE GET_Z0REL
+!
diff --git a/src/SURFEX/goto_surfex.F90 b/src/SURFEX/goto_surfex.F90
deleted file mode 100644
index e2c3e443a5b19f077cf0e652b4f4d03effd2a6df..0000000000000000000000000000000000000000
--- a/src/SURFEX/goto_surfex.F90
+++ /dev/null
@@ -1,8 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE GOTO_SURFEX(KMI, LKFROM)
-!
-!!
-END SUBROUTINE GOTO_SURFEX
diff --git a/src/SURFEX/goto_teb.F90 b/src/SURFEX/goto_teb.F90
deleted file mode 100644
index 2b671658c1e059567895a5f767d87075154d9ba3..0000000000000000000000000000000000000000
--- a/src/SURFEX/goto_teb.F90
+++ /dev/null
@@ -1,7 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE GOTO_TEB
-!!
-END SUBROUTINE GOTO_TEB
diff --git a/src/SURFEX/goto_wrapper_flake.F90 b/src/SURFEX/goto_wrapper_flake.F90
deleted file mode 100644
index bc43ca1ed900a75896400d417cdb09e4304d3de5..0000000000000000000000000000000000000000
--- a/src/SURFEX/goto_wrapper_flake.F90
+++ /dev/null
@@ -1,7 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE GOTO_WRAPPER_FLAKE(KFROM,KTO, LKFROM)
-!
-END SUBROUTINE GOTO_WRAPPER_FLAKE
diff --git a/src/SURFEX/goto_wrapper_ideal.F90 b/src/SURFEX/goto_wrapper_ideal.F90
deleted file mode 100644
index 43666d406bed8e53eff8168aaa231afc7c89b44a..0000000000000000000000000000000000000000
--- a/src/SURFEX/goto_wrapper_ideal.F90
+++ /dev/null
@@ -1,8 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE GOTO_WRAPPER_IDEAL(KFROM,KTO, LKFROM)
-
-!
-END SUBROUTINE GOTO_WRAPPER_IDEAL
diff --git a/src/SURFEX/goto_wrapper_isba.F90 b/src/SURFEX/goto_wrapper_isba.F90
deleted file mode 100644
index 3741ba22d711bb7dd9537da2d9516628fcabdfea..0000000000000000000000000000000000000000
--- a/src/SURFEX/goto_wrapper_isba.F90
+++ /dev/null
@@ -1,7 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE GOTO_WRAPPER_ISBA(KFROM,KTO, LKFROM)
-!
-END SUBROUTINE GOTO_WRAPPER_ISBA
diff --git a/src/SURFEX/goto_wrapper_ocean.F90 b/src/SURFEX/goto_wrapper_ocean.F90
deleted file mode 100644
index bc1d3c205f5f30f054d205815ea165176c83687e..0000000000000000000000000000000000000000
--- a/src/SURFEX/goto_wrapper_ocean.F90
+++ /dev/null
@@ -1,7 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE GOTO_WRAPPER_OCEAN(KFROM,KTO, LKFROM)
-!
-END SUBROUTINE GOTO_WRAPPER_OCEAN
diff --git a/src/SURFEX/goto_wrapper_pack.F90 b/src/SURFEX/goto_wrapper_pack.F90
deleted file mode 100644
index 99db43ee0ee682ee9af51b00302b83bc1a34bb6c..0000000000000000000000000000000000000000
--- a/src/SURFEX/goto_wrapper_pack.F90
+++ /dev/null
@@ -1,8 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE GOTO_WRAPPER_PACK (KFROM, KTO, LKFROM)
-
-!
-END SUBROUTINE GOTO_WRAPPER_PACK
diff --git a/src/SURFEX/goto_wrapper_seaflux.F90 b/src/SURFEX/goto_wrapper_seaflux.F90
deleted file mode 100644
index ade121456fe8db0c96b5fc1dded9f3a61024c8af..0000000000000000000000000000000000000000
--- a/src/SURFEX/goto_wrapper_seaflux.F90
+++ /dev/null
@@ -1,7 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE GOTO_WRAPPER_SEAFLUX(KFROM,KTO, LKFROM)
-!
-END SUBROUTINE GOTO_WRAPPER_SEAFLUX
diff --git a/src/SURFEX/goto_wrapper_surfatm.F90 b/src/SURFEX/goto_wrapper_surfatm.F90
deleted file mode 100644
index 61d0f646768a60daa40aeebfa0c1d73097094809..0000000000000000000000000000000000000000
--- a/src/SURFEX/goto_wrapper_surfatm.F90
+++ /dev/null
@@ -1,7 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE GOTO_WRAPPER_SURFATM(KFROM,KTO, LKFROM)
-!
-END SUBROUTINE GOTO_WRAPPER_SURFATM
diff --git a/src/SURFEX/goto_wrapper_teb.F90 b/src/SURFEX/goto_wrapper_teb.F90
deleted file mode 100644
index 0941f97d8fd3a13ab05bd14ea696e123c81b424c..0000000000000000000000000000000000000000
--- a/src/SURFEX/goto_wrapper_teb.F90
+++ /dev/null
@@ -1,7 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE GOTO_WRAPPER_TEB(KFROM,KTO, LKFROM, KTO_PATCH)
-!
-END SUBROUTINE GOTO_WRAPPER_TEB
diff --git a/src/SURFEX/goto_wrapper_teb_patch.F90 b/src/SURFEX/goto_wrapper_teb_patch.F90
deleted file mode 100644
index 28c6eb40d6aaa2fc1f7caa7d933cbb84f88eee80..0000000000000000000000000000000000000000
--- a/src/SURFEX/goto_wrapper_teb_patch.F90
+++ /dev/null
@@ -1,47 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE GOTO_WRAPPER_TEB_PATCH(B, DGCT, DGMT, T, TGD, TGDPE, TGR, TGRPE, KTO_PATCH)
-!
-USE MODD_DIAG_CUMUL_TEB_n, ONLY : DIAG_CUMUL_TEB_t, DIAG_CUMUL_TEB_GOTO_PATCH
-USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_t, DIAG_MISC_TEB_GOTO_PATCH
-USE MODD_TEB_n, ONLY : TEB_t, TEB_GOTO_PATCH
-USE MODD_BEM_n, ONLY : BEM_t, BEM_GOTO_PATCH
-USE MODD_TEB_GARDEN_n, ONLY : TEB_GARDEN_t, TEB_GARDEN_GOTO_PATCH
-USE MODD_TEB_GARDEN_PGD_EVOL_n, ONLY : TEB_GARDEN_PGD_EVOL_t, TEB_GARDEN_PGD_EVOL_GOTO_PATCH
-USE MODD_TEB_GREENROOF_n, ONLY : TEB_GREENROOF_t, TEB_GREENROOF_GOTO_PATCH
-USE MODD_TEB_GREENROOF_PGD_EVOL_n, ONLY : TEB_GREENROOF_PGD_EVOL_t, TEB_GREENROOF_PGD_EVOL_GOTO_PATCH
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-TYPE(BEM_t), INTENT(INOUT) :: B
-TYPE(DIAG_CUMUL_TEB_t), INTENT(INOUT) :: DGCT
-TYPE(DIAG_MISC_TEB_t), INTENT(INOUT) :: DGMT
-TYPE(TEB_t), INTENT(INOUT) :: T
-TYPE(TEB_GARDEN_t), INTENT(INOUT) :: TGD
-TYPE(TEB_GARDEN_PGD_EVOL_t), INTENT(INOUT) :: TGDPE
-TYPE(TEB_GREENROOF_t), INTENT(INOUT) :: TGR
-TYPE(TEB_GREENROOF_PGD_EVOL_t), INTENT(INOUT) :: TGRPE
-INTEGER,INTENT(IN) :: KTO_PATCH
-!
-INTEGER :: ICURRENT_PATCH
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-IF (LHOOK) CALL DR_HOOK('GOTO_WRAPPER_TEB_PATCH',0,ZHOOK_HANDLE)
-!
- CALL DIAG_CUMUL_TEB_GOTO_PATCH(DGCT,KTO_PATCH)
- CALL DIAG_MISC_TEB_GOTO_PATCH(DGMT,KTO_PATCH)
- CALL TEB_GOTO_PATCH(T,KTO_PATCH)
- CALL BEM_GOTO_PATCH(B,KTO_PATCH)
- CALL TEB_GARDEN_PGD_EVOL_GOTO_PATCH(TGDPE,KTO_PATCH)
- CALL TEB_GREENROOF_PGD_EVOL_GOTO_PATCH(TGRPE,KTO_PATCH)
- CALL TEB_GARDEN_GOTO_PATCH(TGD,KTO_PATCH)
- CALL TEB_GREENROOF_GOTO_PATCH(TGR,KTO_PATCH)
-!
-IF (LHOOK) CALL DR_HOOK('GOTO_WRAPPER_TEB_PATCH',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE GOTO_WRAPPER_TEB_PATCH
diff --git a/src/SURFEX/goto_wrapper_watflux.F90 b/src/SURFEX/goto_wrapper_watflux.F90
deleted file mode 100644
index bff9b078ab781c1733cb601ce7717d6cd0bc0a14..0000000000000000000000000000000000000000
--- a/src/SURFEX/goto_wrapper_watflux.F90
+++ /dev/null
@@ -1,8 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE GOTO_WRAPPER_WATFLUX(KFROM,KTO, LKFROM)
-
-!
-END SUBROUTINE GOTO_WRAPPER_WATFLUX
diff --git a/src/SURFEX/green_from_lai.F90 b/src/SURFEX/green_from_lai.F90
index 2b06d7b34a7ddc96ba32d1769996b9bbf2c4467a..cf010c3829912eec4062ff8a476234e771ce654a 100644
--- a/src/SURFEX/green_from_lai.F90
+++ b/src/SURFEX/green_from_lai.F90
@@ -41,15 +41,14 @@ REAL, DIMENSION(SIZE(PLAI,1),SIZE(PLAI,2))::PGREEN ! greeness fraction
END FUNCTION GREEN_FROM_LAI_2D
!
- FUNCTION GREEN_FROM_LAI_PATCH_1D(PLAI,PVEGTYPE,OAGRI_TO_GRASS) RESULT(PGREEN)
+ FUNCTION GREEN_FROM_LAI_VEGTYPE_1D(PLAI,OAGRI_TO_GRASS) RESULT(PGREEN)
!
REAL, DIMENSION(:), INTENT(IN) :: PLAI ! Leaf area Index for each vegtype
-REAL, DIMENSION(:), INTENT(IN) :: PVEGTYPE !
LOGICAL, INTENT(IN) :: OAGRI_TO_GRASS
!
REAL, DIMENSION(SIZE(PLAI)) :: PGREEN ! greeness fraction
!
-END FUNCTION GREEN_FROM_LAI_PATCH_1D
+END FUNCTION GREEN_FROM_LAI_VEGTYPE_1D
!
END INTERFACE
!
@@ -207,7 +206,8 @@ USE MODD_DATA_COVER_PAR, ONLY : NVT_NO, NVT_ROCK, NVT_SNOW, NVT_PARK, &
NVT_TEBD, NVT_BONE, NVT_TRBE, NVT_TRBD, &
NVT_TEBE, NVT_TENE, NVT_BOBD, NVT_BOND, &
NVT_SHRB, NVT_C3, NVT_C4, NVT_IRR, &
- NVT_GRAS, NVT_BOGR, NVT_TROG
+ NVT_GRAS, NVT_BOGR, NVT_TROG, NVT_C3W, &
+ NVT_C3S, NVT_FLTR, NVT_FLGR
!
USE MODD_REPROD_OPER, ONLY : XEVERG_VEG
!
@@ -227,6 +227,8 @@ REAL, DIMENSION(SIZE(PLAI)) :: PGREEN ! greeness fraction
!* 0.2 declarations of local variables
!
REAL, DIMENSION(SIZE(PLAI)) :: ZLAI, ZAGRI
+REAL :: ZSUM1, ZSUM2, ZSUM3
+INTEGER :: JJ
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-----------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('MODI_GREEN_FROM_LAI:GREEN_FROM_LAI_1D',0,ZHOOK_HANDLE)
@@ -239,27 +241,36 @@ END WHERE
ZAGRI(:)=(1. - EXP( -0.6 * ZLAI(:) ))
IF(OAGRI_TO_GRASS)ZAGRI(:)=MIN(ZAGRI(:),0.95)
!
-PGREEN(:)= ZAGRI(:) *(PVEGTYPE(:,NVT_C4 ) + &! C4 crops
- PVEGTYPE(:,NVT_IRR ) + &! irrigated crops
- PVEGTYPE(:,NVT_C3 ) ) &! C3 crops
- + MIN(1. - EXP( -0.5 * ZLAI(:) ),0.95) &
- *(PVEGTYPE(:,NVT_TRBD) + &! tropical broadleaf deciduous
- PVEGTYPE(:,NVT_TEBE) + &! temperate broadleaf evergreen
- PVEGTYPE(:,NVT_TEBD) + &! temperate broadleaf cold-deciduous (summergreen)
- PVEGTYPE(:,NVT_TENE) + &! temperate needleleaf evergreen
- PVEGTYPE(:,NVT_BOBD) + &! boreal broadleaf cold-deciduous (summergreen)
- PVEGTYPE(:,NVT_BONE) + &! boreal needleleaf evergreen
- PVEGTYPE(:,NVT_BONE) + &! boreal needleleaf cold-deciduous (summergreen)
- PVEGTYPE(:,NVT_SHRB) ) &! shrub
- + XEVERG_VEG * PVEGTYPE(:,NVT_TRBE) &! tropical broadleaf evergreen
- + MIN(1. - EXP( -0.6 * ZLAI(:) ),0.95) &
- *(PVEGTYPE(:,NVT_GRAS) + &! grassland
- PVEGTYPE(:,NVT_BOGR) + &! Boreal grassland
- PVEGTYPE(:,NVT_TROG) + &! torp. grass
- PVEGTYPE(:,NVT_PARK) ) &! irr. parks
- + 0. * PVEGTYPE(:,NVT_NO ) &! no vegetation (smooth)
- + 0. * PVEGTYPE(:,NVT_SNOW) &! no vegetation (snow)
- + 0. * PVEGTYPE(:,NVT_ROCK) ! no vegetation (rocks)
+DO JJ = 1,SIZE(PGREEN)
+ !
+ ZSUM1 = PVEGTYPE(JJ,NVT_C4)
+ IF (NVT_C3/=0 .AND. NVT_IRR/=0) THEN
+ ZSUM1 = ZSUM1 + PVEGTYPE(JJ,NVT_C3) + PVEGTYPE(JJ,NVT_IRR)
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ ZSUM1 = ZSUM1 + PVEGTYPE(JJ,NVT_C3W) + PVEGTYPE(JJ,NVT_C3S)
+ ENDIF
+ !
+ ZSUM2 = PVEGTYPE(JJ,NVT_TRBD) + PVEGTYPE(JJ,NVT_TEBE) + PVEGTYPE(JJ,NVT_TEBD) + &
+ PVEGTYPE(JJ,NVT_TENE) + PVEGTYPE(JJ,NVT_BOBD) + PVEGTYPE(JJ,NVT_BONE) + &
+ PVEGTYPE(JJ,NVT_BONE) + PVEGTYPE(JJ,NVT_SHRB)
+ IF (NVT_FLTR/=0) ZSUM2 = ZSUM2 + PVEGTYPE(JJ,NVT_FLTR)
+ !
+ ZSUM3 = PVEGTYPE(JJ,NVT_GRAS) + PVEGTYPE(JJ,NVT_BOGR) + PVEGTYPE(JJ,NVT_TROG)
+ IF (NVT_PARK/=0) THEN
+ ZSUM3 = ZSUM3 + PVEGTYPE(JJ,NVT_PARK)
+ ELSEIF (NVT_FLGR/=0) THEN
+ ZSUM3 = ZSUM3 + PVEGTYPE(JJ,NVT_FLGR)
+ ENDIF
+ !
+ PGREEN(JJ)= ZAGRI(JJ) * ZSUM1 &
+ + MIN(1. - EXP( -0.5 * ZLAI(JJ) ),0.95) * ZSUM2 &
+ + XEVERG_VEG * PVEGTYPE(JJ,NVT_TRBE) &! tropical broadleaf evergreen
+ + MIN(1. - EXP( -0.6 * ZLAI(JJ) ),0.95) * ZSUM3 &
+ + 0. * PVEGTYPE(JJ,NVT_NO ) &! no vegetation (smooth)
+ + 0. * PVEGTYPE(JJ,NVT_SNOW) &! no vegetation (snow)
+ + 0. * PVEGTYPE(JJ,NVT_ROCK) ! no vegetation (rocks)
+ !
+ENDDO
!
IF (LHOOK) CALL DR_HOOK('MODI_GREEN_FROM_LAI:GREEN_FROM_LAI_1D',1,ZHOOK_HANDLE)
!-----------------------------------------------------------------
@@ -311,7 +322,8 @@ USE MODD_DATA_COVER_PAR, ONLY : NVT_NO, NVT_ROCK, NVT_SNOW, NVT_PARK, &
NVT_TEBD, NVT_BONE, NVT_TRBE, NVT_TRBD, &
NVT_TEBE, NVT_TENE, NVT_BOBD, NVT_BOND, &
NVT_SHRB, NVT_C3, NVT_C4, NVT_IRR, &
- NVT_GRAS, NVT_BOGR, NVT_TROG
+ NVT_GRAS, NVT_BOGR, NVT_TROG, NVT_C3W, &
+ NVT_C3S, NVT_FLTR, NVT_FLGR
USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE MODD_REPROD_OPER, ONLY : XEVERG_VEG
@@ -332,6 +344,8 @@ REAL, DIMENSION(SIZE(PLAI,1),SIZE(PLAI,2))::PGREEN ! greeness fraction
!* 0.2 declarations of local variables
!
REAL, DIMENSION(SIZE(PLAI,1),SIZE(PLAI,2)) :: ZLAI, ZAGRI
+REAL, DIMENSION(SIZE(PLAI,2)) :: ZSUM1, ZSUM2, ZSUM3
+INTEGER :: JJ
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-----------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('MODI_GREEN_FROM_LAI:GREEN_FROM_LAI_2D',0,ZHOOK_HANDLE)
@@ -348,29 +362,42 @@ WHERE (PLAI(:,:) /= XUNDEF)
ENDWHERE
IF(OAGRI_TO_GRASS)ZAGRI(:,:)=MIN(ZAGRI(:,:),0.95)
!
-WHERE (PLAI(:,:) /= XUNDEF)
-PGREEN(:,:)= ZAGRI(:,:) *(PVEGTYPE(:,:,NVT_C4 ) + &! C4 crops
- PVEGTYPE(:,:,NVT_IRR ) + &! irrigated crops
- PVEGTYPE(:,:,NVT_C3 ) ) &! C3 crops
- + MIN((1. - EXP( -0.5 * ZLAI(:,:) )),0.95) &
- *(PVEGTYPE(:,:,NVT_TRBD) + &! tropical broadleaf deciduous
- PVEGTYPE(:,:,NVT_TEBE) + &! temperate broadleaf evergreen
- PVEGTYPE(:,:,NVT_TEBD) + &! temperate broadleaf cold-deciduous (summergreen)
- PVEGTYPE(:,:,NVT_TENE) + &! temperate needleleaf evergreen
- PVEGTYPE(:,:,NVT_BOBD) + &! boreal broadleaf cold-deciduous (summergreen)
- PVEGTYPE(:,:,NVT_BONE) + &! boreal needleleaf evergreen
- PVEGTYPE(:,:,NVT_BONE) + &! boreal needleleaf cold-deciduous (summergreen)
- PVEGTYPE(:,:,NVT_SHRB) ) &! shrub
- + XEVERG_VEG * PVEGTYPE(:,:,NVT_TRBE) &! tropical broadleaf evergreen
- + MIN((1. - EXP( -0.6 * ZLAI(:,:) )),0.95) &
- *(PVEGTYPE(:,:,NVT_GRAS) + &! grassland
- PVEGTYPE(:,:,NVT_BOGR) + &! Boreal grassland
- PVEGTYPE(:,:,NVT_TROG) + &! trop grassland
- PVEGTYPE(:,:,NVT_PARK) )&! irr. parks
- + 0. * PVEGTYPE(:,:,NVT_NO ) &! no vegetation (smooth)
- + 0. * PVEGTYPE(:,:,NVT_SNOW) &! no vegetation (snow)
- + 0. * PVEGTYPE(:,:,NVT_ROCK) ! no vegetation (rocks)
-END WHERE
+!
+DO JJ = 1,SIZE(PGREEN)
+ !
+ ZSUM1(:) = PVEGTYPE(JJ,:,NVT_C4)
+ IF (NVT_C3/=0 .AND. NVT_IRR/=0) THEN
+ ZSUM1(:) = ZSUM1(:) + PVEGTYPE(JJ,:,NVT_C3) + PVEGTYPE(JJ,:,NVT_IRR)
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ ZSUM1(:) = ZSUM1(:) + PVEGTYPE(JJ,:,NVT_C3W) + PVEGTYPE(JJ,:,NVT_C3S)
+ ENDIF
+ !
+ ZSUM2(:) = PVEGTYPE(JJ,:,NVT_TRBD) + PVEGTYPE(JJ,:,NVT_TEBE) + PVEGTYPE(JJ,:,NVT_TEBD) + &
+ PVEGTYPE(JJ,:,NVT_TENE) + PVEGTYPE(JJ,:,NVT_BOBD) + PVEGTYPE(JJ,:,NVT_BONE) + &
+ PVEGTYPE(JJ,:,NVT_BONE) + PVEGTYPE(JJ,:,NVT_SHRB)
+ IF (NVT_FLTR/=0) ZSUM2(:) = ZSUM2(:) + PVEGTYPE(JJ,:,NVT_FLTR)
+ !
+ ZSUM3(:) = PVEGTYPE(JJ,:,NVT_GRAS) + PVEGTYPE(JJ,:,NVT_BOGR) + PVEGTYPE(JJ,:,NVT_TROG)
+ IF (NVT_PARK/=0) THEN
+ ZSUM3(:) = ZSUM3(:) + PVEGTYPE(JJ,:,NVT_PARK)
+ ELSEIF (NVT_FLGR/=0) THEN
+ ZSUM3(:) = ZSUM3(:) + PVEGTYPE(JJ,:,NVT_FLGR)
+ ENDIF
+ !
+ WHERE (PLAI(JJ,:) /= XUNDEF)
+ !
+ PGREEN(JJ,:)= ZAGRI(JJ,:) * ZSUM1(:) &
+ + MIN((1. - EXP( -0.5 * ZLAI(JJ,:) )),0.95) * ZSUM2 &
+ + XEVERG_VEG * PVEGTYPE(JJ,:,NVT_TRBE) &! tropical broadleaf evergreen
+ + MIN((1. - EXP( -0.6 * ZLAI(JJ,:) )),0.95) * ZSUM3 &
+ + 0. * PVEGTYPE(JJ,:,NVT_NO ) &! no vegetation (smooth)
+ + 0. * PVEGTYPE(JJ,:,NVT_SNOW) &! no vegetation (snow)
+ + 0. * PVEGTYPE(JJ,:,NVT_ROCK) ! no vegetation (rocks)
+ !
+ END WHERE
+ !
+ENDDO
+!
IF (LHOOK) CALL DR_HOOK('MODI_GREEN_FROM_LAI:GREEN_FROM_LAI_2D',1,ZHOOK_HANDLE)
!
!-----------------------------------------------------------------
@@ -380,7 +407,7 @@ END FUNCTION GREEN_FROM_LAI_2D
!
!
! ####################################################
- FUNCTION GREEN_FROM_LAI_PATCH_1D(PLAI,PVEGTYPE,OAGRI_TO_GRASS) RESULT(PGREEN)
+ FUNCTION GREEN_FROM_LAI_VEGTYPE_1D(PLAI,OAGRI_TO_GRASS) RESULT(PGREEN)
! ####################################################
!!
!! PURPOSE
@@ -424,7 +451,8 @@ USE MODD_DATA_COVER_PAR, ONLY : NVT_NO, NVT_ROCK, NVT_SNOW, NVT_PARK, &
NVT_TEBD, NVT_BONE, NVT_TRBE, NVT_TRBD, &
NVT_TEBE, NVT_TENE, NVT_BOBD, NVT_BOND, &
NVT_SHRB, NVT_C3, NVT_C4, NVT_IRR, &
- NVT_GRAS, NVT_BOGR, NVT_TROG
+ NVT_GRAS, NVT_BOGR, NVT_TROG, NVT_C3W, &
+ NVT_C3S, NVT_FLTR, NVT_FLGR
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
@@ -438,53 +466,68 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
REAL, DIMENSION(:), INTENT(IN) :: PLAI ! Leaf area Index
-REAL, DIMENSION(:), INTENT(IN) :: PVEGTYPE ! type of vegetation
LOGICAL, INTENT(IN) :: OAGRI_TO_GRASS
!
REAL, DIMENSION(SIZE(PLAI)) :: PGREEN ! greeness fraction
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(SIZE(PLAI)) :: ZLAI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-----------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('MODI_GREEN_FROM_LAI:GREEN_FROM_LAI_PATCH_1D',0,ZHOOK_HANDLE)
-ZLAI(:) = PLAI(:)
+IF (LHOOK) CALL DR_HOOK('MODI_GREEN_FROM_LAI:GREEN_FROM_LAI_VEGTYPE_1D',0,ZHOOK_HANDLE)
PGREEN(:) = XUNDEF
!
IF(OAGRI_TO_GRASS)THEN
- IF (PVEGTYPE(NVT_C4 )>0.) PGREEN(NVT_C4 )= MIN(1. - EXP( -0.6 * ZLAI(NVT_C4 ) ),0.95)
- IF (PVEGTYPE(NVT_IRR )>0.) PGREEN(NVT_IRR )= MIN(1. - EXP( -0.6 * ZLAI(NVT_IRR ) ),0.95)
- IF (PVEGTYPE(NVT_C3 )>0.) PGREEN(NVT_C3 )= MIN(1. - EXP( -0.6 * ZLAI(NVT_C3 ) ),0.95)
+ IF (PLAI(NVT_C4 )/=XUNDEF) PGREEN(NVT_C4 )= MIN(1. - EXP( -0.6 * PLAI(NVT_C4 ) ),0.95)
+ IF (NVT_IRR>0 .AND. NVT_C3>0) THEN
+ IF (PLAI(NVT_IRR )/=XUNDEF) PGREEN(NVT_IRR )= MIN(1. - EXP( -0.6 * PLAI(NVT_IRR ) ),0.95)
+ IF (PLAI(NVT_C3 )/=XUNDEF) PGREEN(NVT_C3 )= MIN(1. - EXP( -0.6 * PLAI(NVT_C3 ) ),0.95)
+ ELSEIF (NVT_C3W>0 .AND. NVT_C3S>0) THEN
+ IF (PLAI(NVT_C3W )/=XUNDEF) PGREEN(NVT_C3W )= MIN(1. - EXP( -0.6 * PLAI(NVT_C3W ) ),0.95)
+ IF (PLAI(NVT_C3S )/=XUNDEF) PGREEN(NVT_C3S )= MIN(1. - EXP( -0.6 * PLAI(NVT_C3S ) ),0.95)
+ ENDIF
ELSE
- IF (PVEGTYPE(NVT_C4 )>0.) PGREEN(NVT_C4 )= 1. - EXP( -0.6 * ZLAI(NVT_C4 ) )
- IF (PVEGTYPE(NVT_IRR )>0.) PGREEN(NVT_IRR )= 1. - EXP( -0.6 * ZLAI(NVT_IRR ) )
- IF (PVEGTYPE(NVT_C3 )>0.) PGREEN(NVT_C3 )= 1. - EXP( -0.6 * ZLAI(NVT_C3 ) )
+ IF (PLAI(NVT_C4 )/=XUNDEF) PGREEN(NVT_C4 )= 1. - EXP( -0.6 * PLAI(NVT_C4 ) )
+ IF (NVT_IRR>0 .AND. NVT_C3>0) THEN
+ IF (PLAI(NVT_IRR )/=XUNDEF) PGREEN(NVT_IRR )= 1. - EXP( -0.6 * PLAI(NVT_IRR ) )
+ IF (PLAI(NVT_C3 )/=XUNDEF) PGREEN(NVT_C3 )= 1. - EXP( -0.6 * PLAI(NVT_C3 ) )
+ ELSEIF (NVT_C3W>0 .AND. NVT_C3S>0) THEN
+ IF (PLAI(NVT_C3W )/=XUNDEF) PGREEN(NVT_C3W )= 1. - EXP( -0.6 * PLAI(NVT_C3W ) )
+ IF (PLAI(NVT_C3S )/=XUNDEF) PGREEN(NVT_C3S )= 1. - EXP( -0.6 * PLAI(NVT_C3S ) )
+ ENDIF
ENDIF
!
-IF (PVEGTYPE(NVT_TEBD)>0.) PGREEN(NVT_TEBD)= MIN(1. - EXP( -0.5 * ZLAI(NVT_TEBD) ),0.95)
-IF (PVEGTYPE(NVT_BONE)>0.) PGREEN(NVT_BONE)= MIN(1. - EXP( -0.5 * ZLAI(NVT_BONE) ),0.95)
-IF (PVEGTYPE(NVT_TRBD)>0.) PGREEN(NVT_TRBD)= MIN(1. - EXP( -0.5 * ZLAI(NVT_TRBD) ),0.95)
-IF (PVEGTYPE(NVT_TEBE)>0.) PGREEN(NVT_TEBE)= MIN(1. - EXP( -0.5 * ZLAI(NVT_TEBE) ),0.95)
-IF (PVEGTYPE(NVT_TENE)>0.) PGREEN(NVT_TENE)= MIN(1. - EXP( -0.5 * ZLAI(NVT_TENE) ),0.95)
-IF (PVEGTYPE(NVT_BOBD)>0.) PGREEN(NVT_BOBD)= MIN(1. - EXP( -0.5 * ZLAI(NVT_BOBD) ),0.95)
-IF (PVEGTYPE(NVT_BOND)>0.) PGREEN(NVT_BOND)= MIN(1. - EXP( -0.5 * ZLAI(NVT_BOND) ),0.95)
-IF (PVEGTYPE(NVT_SHRB)>0.) PGREEN(NVT_SHRB)= MIN(1. - EXP( -0.5 * ZLAI(NVT_SHRB) ),0.95)
-
-IF (PVEGTYPE(NVT_TRBE)>0.) PGREEN(NVT_TRBE)= XEVERG_VEG
+IF (PLAI(NVT_TEBD)/=XUNDEF) PGREEN(NVT_TEBD)= MIN(1. - EXP( -0.5 * PLAI(NVT_TEBD) ),0.95)
+IF (PLAI(NVT_BONE)/=XUNDEF) PGREEN(NVT_BONE)= MIN(1. - EXP( -0.5 * PLAI(NVT_BONE) ),0.95)
+IF (PLAI(NVT_TRBD)/=XUNDEF) PGREEN(NVT_TRBD)= MIN(1. - EXP( -0.5 * PLAI(NVT_TRBD) ),0.95)
+IF (PLAI(NVT_TEBE)/=XUNDEF) PGREEN(NVT_TEBE)= MIN(1. - EXP( -0.5 * PLAI(NVT_TEBE) ),0.95)
+IF (PLAI(NVT_TENE)/=XUNDEF) PGREEN(NVT_TENE)= MIN(1. - EXP( -0.5 * PLAI(NVT_TENE) ),0.95)
+IF (PLAI(NVT_BOBD)/=XUNDEF) PGREEN(NVT_BOBD)= MIN(1. - EXP( -0.5 * PLAI(NVT_BOBD) ),0.95)
+IF (PLAI(NVT_BOND)/=XUNDEF) PGREEN(NVT_BOND)= MIN(1. - EXP( -0.5 * PLAI(NVT_BOND) ),0.95)
+IF (PLAI(NVT_SHRB)/=XUNDEF) PGREEN(NVT_SHRB)= MIN(1. - EXP( -0.5 * PLAI(NVT_SHRB) ),0.95)
+!
+IF (NVT_FLTR>0) THEN
+ IF (PLAI(NVT_FLTR)/=XUNDEF) PGREEN(NVT_FLTR)= MIN(1. - EXP( -0.5 * PLAI(NVT_FLTR) ),0.95)
+ENDIF
!
-IF (PVEGTYPE(NVT_GRAS)>0.) PGREEN(NVT_GRAS)= MIN(1. - EXP( -0.6 * ZLAI(NVT_GRAS) ),0.95)
-IF (PVEGTYPE(NVT_BOGR)>0.) PGREEN(NVT_BOGR)= MIN(1. - EXP( -0.6 * ZLAI(NVT_BOGR) ),0.95)
-IF (PVEGTYPE(NVT_TROG)>0.) PGREEN(NVT_TROG)= MIN(1. - EXP( -0.6 * ZLAI(NVT_TROG) ),0.95)
-IF (PVEGTYPE(NVT_PARK)>0.) PGREEN(NVT_PARK)= MIN(1. - EXP( -0.6 * ZLAI(NVT_PARK) ),0.95)
+IF (PLAI(NVT_TRBE)/=XUNDEF) PGREEN(NVT_TRBE)= XEVERG_VEG
+!
+IF (PLAI(NVT_GRAS)/=XUNDEF) PGREEN(NVT_GRAS)= MIN(1. - EXP( -0.6 * PLAI(NVT_GRAS) ),0.95)
+IF (PLAI(NVT_BOGR)/=XUNDEF) PGREEN(NVT_BOGR)= MIN(1. - EXP( -0.6 * PLAI(NVT_BOGR) ),0.95)
+IF (PLAI(NVT_TROG)/=XUNDEF) PGREEN(NVT_TROG)= MIN(1. - EXP( -0.6 * PLAI(NVT_TROG) ),0.95)
+IF (NVT_PARK>0) THEN
+ IF (PLAI(NVT_PARK)/=XUNDEF) PGREEN(NVT_PARK)= MIN(1. - EXP( -0.6 * PLAI(NVT_PARK) ),0.95)
+ELSEIF (NVT_FLGR>0) THEN
+ IF (PLAI(NVT_FLGR)/=XUNDEF) PGREEN(NVT_FLGR)= MIN(1. - EXP( -0.6 * PLAI(NVT_FLGR) ),0.95)
+ENDIF
!
-IF (PVEGTYPE(NVT_NO )>0.) PGREEN(NVT_NO )= 0.
-IF (PVEGTYPE(NVT_SNOW)>0.) PGREEN(NVT_SNOW)= 0.
-IF (PVEGTYPE(NVT_ROCK)>0.) PGREEN(NVT_ROCK)= 0.
-IF (LHOOK) CALL DR_HOOK('MODI_GREEN_FROM_LAI:GREEN_FROM_LAI_PATCH_1D',1,ZHOOK_HANDLE)
+PGREEN(NVT_NO )= 0.
+PGREEN(NVT_SNOW)= 0.
+PGREEN(NVT_ROCK)= 0.
+IF (LHOOK) CALL DR_HOOK('MODI_GREEN_FROM_LAI:GREEN_FROM_LAI_VEGTYPE_1D',1,ZHOOK_HANDLE)
!
-END FUNCTION GREEN_FROM_LAI_PATCH_1D
+END FUNCTION GREEN_FROM_LAI_VEGTYPE_1D
!
!--------------------------------------------
!
diff --git a/src/SURFEX/greenroof.F90 b/src/SURFEX/greenroof.F90
index e842fd498a7c3150c12105ec740e19de021eff0b..f4defd37eb3e5f02c47ef2c91019e6966a40809c 100644
--- a/src/SURFEX/greenroof.F90
+++ b/src/SURFEX/greenroof.F90
@@ -3,18 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GREENROOF (DTCO, DTI, IG, I, TG, T, TOP, TVG, DTGD, TIR, GRM, &
- HIMPLICIT_WIND, TPTIME, PTSUN, PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- PTSTEP, PZREF, PUREF, &
- PTA, PQA, PEXNS, PEXNA,PRHOA, PCO2, PPS, PRR, PSR, PZENITH, &
- PSW,PLW, PVMOD, &
- PALBNIR_TVEG, PALBVIS_TVEG, PALBNIR_TSOIL, PALBVIS_TSOIL, &
- PRN_GREENROOF,PH_GREENROOF,PLE_GREENROOF,PGFLUX_GREENROOF, &
- PSFCO2,PEVAP_GREENROOF, PUW_GREENROOF, &
- PAC_GREENROOF,PQSAT_GREENROOF,PTS_GREENROOF, &
- PAC_AGG_GREENROOF, PHU_AGG_GREENROOF,PDEEP_FLUX, &
- PRUNOFF_GREENROOF, PDRAIN_GREENROOF, PIRRIG_GREENROOF )
+ SUBROUTINE GREENROOF (DTCO, G, T, TOP, TIR, DTV, GB, DK, DEK, DMK, GRO, S, K, P, PEK, &
+ HIMPLICIT_WIND, TPTIME, PTSUN, PPEW_A_COEF, PPEW_B_COEF, &
+ PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
+ PTSTEP, PZREF, PUREF, PTA, PQA, PEXNS, PEXNA, PRHOA, &
+ PCO2, PPS, PRR, PSR, PZENITH, PSW, PLW, PVMOD, &
+ PALBNIR_TVEG, PALBVIS_TVEG, PALBNIR_TSOIL, PALBVIS_TSOIL, &
+ PRN, PH, PLE, PGFLUX, PSFCO2, PEVAP, PUW, PRUNOFF, PDRAIN,&
+ PAC, PQSAT, PTSRAD, PAC_AGG, PHU_AGG, PDEEP_FLUX, PIRRIG )
! ##################################################################################
!
!!**** *GREENROOF*
@@ -61,31 +57,36 @@
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_SSO_n, ONLY : SSO_t, SSO_INIT
USE MODD_TEB_n, ONLY : TEB_t
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
-USE MODD_DATA_TEB_GARDEN_n, ONLY : DATA_TEB_GARDEN_t
USE MODD_TEB_IRRIG_n, ONLY : TEB_IRRIG_t
-USE MODD_SURFEX_n, ONLY : TEB_GREENROOF_MODEL_t
!
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t
+!
+USE MODD_DIAG_n, ONLY : DIAG_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
+!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_P_t, ISBA_PE_t
+!
+USE MODD_AGRI_n, ONLY : AGRI_t, AGRI_INIT
!
USE MODD_SURF_PAR, ONLY: XUNDEF
USE MODD_TYPE_DATE_SURF, ONLY: DATE_TIME
USE MODD_CSTS, ONLY: XCPD
-
-
!
USE MODI_ISBA
-USE MODI_VEGETATION_UPDATE_GREENROOF
+USE MODI_VEGETATION_UPDATE
USE MODI_VEGETATION_EVOL
USE MODI_CARBON_EVOL
USE MODE_THERMOS
USE MODI_ROOF_IMPL_COEF
USE MODI_TEB_IRRIG
-!
+USE MODI_FLAG_TEB_VEG_n
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -97,17 +98,23 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
+TYPE(GRID_t), INTENT(INOUT) :: G
TYPE(TEB_t), INTENT(INOUT) :: T
TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
-TYPE(DATA_TEB_GARDEN_t), INTENT(INOUT) :: DTGD
TYPE(TEB_IRRIG_t), INTENT(INOUT) :: TIR
-TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM
-
+!
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+TYPE(GR_BIOG_t), INTENT(INOUT) :: GB
+!
+TYPE(DIAG_t), INTENT(INOUT) :: DK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK
+!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: GRO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_P_t), INTENT(INOUT) :: P
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
!
CHARACTER(LEN=*), INTENT(IN) :: HIMPLICIT_WIND ! wind implicitation option
! ! 'OLD' = direct
@@ -141,217 +148,53 @@ REAL, DIMENSION(:) , INTENT(IN) :: PALBVIS_TVEG ! visible veg tot albe
REAL, DIMENSION(:) , INTENT(IN) :: PALBNIR_TSOIL ! nearIR soil tot albedo
REAL, DIMENSION(:) , INTENT(IN) :: PALBVIS_TSOIL ! visible soil tot albedo
!
-REAL, DIMENSION(:) , INTENT(OUT) :: PRN_GREENROOF ! net radiation over greenroofs
-REAL, DIMENSION(:) , INTENT(OUT) :: PH_GREENROOF ! sensible heat flux over greenroofs
-REAL, DIMENSION(:) , INTENT(OUT) :: PLE_GREENROOF ! latent heat flux over greenroofs
-REAL, DIMENSION(:) , INTENT(OUT) :: PGFLUX_GREENROOF ! flux through the greenroofs
-REAL, DIMENSION(:) , INTENT(OUT) :: PSFCO2 ! flux of greenroof CO2 (m/s*kg_CO2/kg_air)
-REAL, DIMENSION(:) , INTENT(OUT) :: PEVAP_GREENROOF ! total evaporation over greenroofs (kg/m2/s)
-REAL, DIMENSION(:) , INTENT(OUT) :: PUW_GREENROOF ! friction flux (m2/s2)
-REAL, DIMENSION(:) , INTENT(OUT) :: PAC_GREENROOF ! greenroof aerodynamical conductance
-REAL, DIMENSION(:) , INTENT(OUT) :: PQSAT_GREENROOF ! saturation humidity
-REAL, DIMENSION(:) , INTENT(INOUT) :: PTS_GREENROOF ! greenroof radiative surface temp. (snow free)
-REAL, DIMENSION(:) , INTENT(OUT) :: PAC_AGG_GREENROOF ! aggreg. aeodynamic resistance for greenroofs for latent heat flux
-REAL, DIMENSION(:) , INTENT(OUT) :: PHU_AGG_GREENROOF ! aggreg. relative humidity for greenroofs for latent heat flux
-REAL, DIMENSION(:) , INTENT(OUT) :: PDEEP_FLUX ! Heat Flux at the bottom layer of the greenroof
-REAL, DIMENSION(:) , INTENT(OUT) :: PRUNOFF_GREENROOF ! greenroof surface runoff
-REAL, DIMENSION(:) , INTENT(OUT) :: PDRAIN_GREENROOF ! greenroof total (vertical) drainage
-REAL, DIMENSION(:) , INTENT(OUT) :: PIRRIG_GREENROOF ! greenroof summer irrigation rate
+REAL, DIMENSION(:) , INTENT(OUT) :: PRN ! net radiation over greenroofs
+REAL, DIMENSION(:) , INTENT(OUT) :: PH ! sensible heat flux over greenroofs
+REAL, DIMENSION(:) , INTENT(OUT) :: PLE ! latent heat flux over greenroofs
+REAL, DIMENSION(:) , INTENT(OUT) :: PGFLUX ! flux through the greenroofs
+REAL, DIMENSION(:) , INTENT(OUT) :: PSFCO2 ! flux of greenroof CO2 (m/s*kg_CO2/kg_air)
+REAL, DIMENSION(:) , INTENT(OUT) :: PEVAP ! total evaporation over greenroofs (kg/m2/s)
+REAL, DIMENSION(:) , INTENT(OUT) :: PUW ! friction flux (m2/s2)
+REAL, DIMENSION(:) , INTENT(OUT) :: PRUNOFF ! greenroof surface runoff
+REAL, DIMENSION(:) , INTENT(OUT) :: PDRAIN ! greenroof surface drainage
+REAL, DIMENSION(:) , INTENT(OUT) :: PAC ! greenroof aerodynamical conductance
+REAL, DIMENSION(:) , INTENT(OUT) :: PQSAT ! saturation humidity
+REAL, DIMENSION(:) , INTENT(OUT) :: PTSRAD ! greenroof radiative surface temp. (snow free)
+REAL, DIMENSION(:) , INTENT(OUT) :: PAC_AGG ! aggreg. aeodynamic resistance for greenroofs for latent heat flux
+REAL, DIMENSION(:) , INTENT(OUT) :: PHU_AGG ! aggreg. relative humidity for greenroofs for latent heat flux
+REAL, DIMENSION(:) , INTENT(OUT) :: PDEEP_FLUX ! Heat Flux at the bottom layer of the greenroof
+REAL, DIMENSION(:) , INTENT(OUT) :: PIRRIG ! greenroof summer irrigation rate
!
!
!* 0.2 Declarations of local variables
!
- CHARACTER(LEN=3) :: HRAIN ! Rainfall spatial distribution ('DEF','SGH')
-LOGICAL :: OFLOOD ! Activation of the flooding scheme
-LOGICAL :: OTEMP_ARP ! True = time-varying force-restore soil temperature (as in ARPEGE)
- ! False = No time-varying force-restore soil temperature (Default)
-LOGICAL :: OGLACIER ! True = Over permanent snow and ice,
-! initialise WGI=WSAT,
-! Hsnow>=10m and allow 0.8<SNOALB<0.85
- ! False = No specific treatment
-REAL, DIMENSION(0) :: ZSODELX ! Pulsation for each layer (Only used if LTEMP_ARP=True)
-REAL, DIMENSION(SIZE(PPS)) :: ZMUF ! fraction of the grid cell reached by the rainfall
-REAL, DIMENSION(SIZE(PPS)) :: ZFSAT ! Topmodel saturated fraction
-REAL, DIMENSION(SIZE(PPS),GRM%TGRO%NLAYER_GR) :: ZTOPQS ! Topmodel (SGH not used in TEB) lateral subsurface flow by layer
-REAL, DIMENSION(SIZE(PPS)) :: ZQSB ! Topmodel (SGH not used in TEB) output lateral subsurface
-REAL, DIMENSION(SIZE(PPS)) :: ZFWTD ! grid-cell fraction of water table to rise
-REAL, DIMENSION(SIZE(PPS)) :: ZWTD ! water table depth from TRIP or MODCOU
-!
-REAL, DIMENSION(SIZE(PPS)) :: ZDIRCOSZW ! orography slope cosine (=1 in TEB)
-REAL, DIMENSION(SIZE(PPS),TVG%NNBIOMASS) :: ZRESP_BIOMASS_INST ! instantaneous biomass respiration (kgCO2/kgair m/s)
-!
-! temperatures & thermal conductivities
-!
-REAL, DIMENSION(SIZE(PPS)) :: ZTA ! estimate of air temperature at future time
-! ! step as if modified by ISBA flux alone.
-!
-! desactivated diag
-!
-REAL, DIMENSION(SIZE(PPS)) :: ZRN_ISBA ! net radiative flux from snow-free surface
-REAL, DIMENSION(SIZE(PPS)) :: ZH_ISBA ! sensible heat flux from snow-free surface
-REAL, DIMENSION(SIZE(PPS)) :: ZLEI_ISBA ! baresoil evaporation from snow-free surface
-REAL, DIMENSION(SIZE(PPS)) :: ZLEG_ISBA ! baresoil evaporation from snow-free surface
-REAL, DIMENSION(SIZE(PPS)) :: ZLEGI_ISBA ! baresoil sublimation from snow-free surface
-REAL, DIMENSION(SIZE(PPS)) :: ZLEV_ISBA ! total evapotranspiration from vegetation over
-REAL, DIMENSION(SIZE(PPS)) :: ZLETR_ISBA ! transpiration from snow-free surface
-REAL, DIMENSION(SIZE(PPS)) :: ZUSTAR_ISBA ! friction velocity from snow-free surface
-REAL, DIMENSION(SIZE(PPS)) :: ZLER_ISBA ! evaporation from canopy water interception
-REAL, DIMENSION(SIZE(PPS)) :: ZLE_ISBA ! latent heat flux from snow-free surface
-REAL, DIMENSION(SIZE(PPS)) :: ZGFLUX_ISBA ! net energy flux into the snow-free surface
-REAL, DIMENSION(SIZE(PPS)) :: ZRNSNOW ! net radiative flux from snow (ISBA-ES:3-L) (W/m2)
-REAL, DIMENSION(SIZE(PPS)) :: ZHSNOW ! sensible heat flux from snow (ISBA-ES:3-L) (W/m2)
-REAL, DIMENSION(SIZE(PPS)) :: ZHPSNOW ! heat release from rainfall (ISBA-ES:3-L) (W/m2)
-REAL, DIMENSION(SIZE(PPS)) :: ZGFLUXSNOW ! net surface energy flux into snowpack (ISBA-ES:3-L)(W/m2)
-REAL, DIMENSION(SIZE(PPS)) :: ZUSTARSNOW ! friction velocity over snow (ISBA-ES:3-L) (m/s)
-REAL, DIMENSION(SIZE(PPS)) :: ZGRNDFLUX ! soil/snow interface heat flux (ISBA-ES:3-L) (W/m2)
-REAL, DIMENSION(SIZE(PPS)) :: ZSRSFC ! snowfall over snowpack (ISBA-ES:3-L) (kg/m2/s)
-REAL, DIMENSION(SIZE(PPS)) :: ZRRSFC ! rainfall over snowpack (ISBA-ES:3-L) (kg/m2/s)
-REAL, DIMENSION(SIZE(PPS)) :: ZLESL ! snowpack evaporation (ISBA-ES:3-L) (W/m2)
-REAL, DIMENSION(SIZE(PPS)) :: ZCDSNOW ! snow drag coefficient (ISBA-ES:3-L) (-)
-REAL, DIMENSION(SIZE(PPS)) :: ZCHSNOW ! heat turbulent transfer coefficient (-)
-!
-REAL, DIMENSION(SIZE(PPS)) :: ZCG
-REAL, DIMENSION(SIZE(PPS)) :: ZC1
-REAL, DIMENSION(SIZE(PPS)) :: ZC2
-REAL, DIMENSION(SIZE(PPS)) :: ZWGEQ
-REAL, DIMENSION(SIZE(PPS)) :: ZCT
-REAL, DIMENSION(SIZE(PPS)) :: ZRS
-REAL, DIMENSION(SIZE(PPS)) :: ZCH
-REAL, DIMENSION(SIZE(PPS)) :: ZCD
-REAL, DIMENSION(SIZE(PPS)) :: ZCDN
-REAL, DIMENSION(SIZE(PPS)) :: ZRI
-REAL, DIMENSION(SIZE(PPS)) :: ZHU
-REAL, DIMENSION(SIZE(PPS)) :: ZHUG
-REAL, DIMENSION(SIZE(PPS)) :: ZRN
-REAL, DIMENSION(SIZE(PPS)) :: ZH
-REAL, DIMENSION(SIZE(PPS)) :: ZLEI
-REAL, DIMENSION(SIZE(PPS)) :: ZLEG
-REAL, DIMENSION(SIZE(PPS)) :: ZLEGI
-REAL, DIMENSION(SIZE(PPS)) :: ZLEV
-REAL, DIMENSION(SIZE(PPS)) :: ZLES
-REAL, DIMENSION(SIZE(PPS)) :: ZLER
-REAL, DIMENSION(SIZE(PPS)) :: ZLETR
-REAL, DIMENSION(SIZE(PPS)) :: ZEVAP
-REAL, DIMENSION(SIZE(PPS)) :: ZSUBL
-REAL, DIMENSION(SIZE(PPS)) :: ZGFLUX
-REAL, DIMENSION(SIZE(PPS)) :: ZRESTORE
-REAL, DIMENSION(SIZE(PPS)) :: ZUSTAR
-REAL, DIMENSION(SIZE(PPS)) :: ZDRAIN
-REAL, DIMENSION(SIZE(PPS)) :: ZRUNOFF
-REAL, DIMENSION(SIZE(PPS)) :: ZMELT
-REAL, DIMENSION(SIZE(PPS),GRM%TGR%CUR%TSNOW%NLAYER) :: ZSNOWTEMP
-REAL, DIMENSION(SIZE(PPS),GRM%TGR%CUR%TSNOW%NLAYER) :: ZSNOWLIQ
-REAL, DIMENSION(SIZE(PPS),GRM%TGR%CUR%TSNOW%NLAYER) :: ZSNOWDZ
-REAL, DIMENSION(SIZE(PPS)) :: ZSNOWHMASS
-REAL, DIMENSION(SIZE(PPS)) :: ZMELTADV
-REAL, DIMENSION(SIZE(PPS),3) :: ZIACAN
-REAL, DIMENSION(SIZE(PPS)) :: ZQS
-REAL, DIMENSION(SIZE(PPS)) :: ZHV
-REAL, DIMENSION(SIZE(PPS)) :: ZHORT
-REAL, DIMENSION(SIZE(PPS)) :: ZDRIP
-REAL, DIMENSION(SIZE(PPS)) :: ZTS
-REAL, DIMENSION(SIZE(PPS)) :: ZRRVEG
-REAL, DIMENSION(SIZE(PPS)) :: ZALBT
-REAL, DIMENSION(SIZE(PPS)) :: ZEMIST
-REAL, DIMENSION(SIZE(PPS)) :: ZGPP
-REAL, DIMENSION(SIZE(PPS)) :: ZRESP_AUTO
-REAL, DIMENSION(SIZE(PPS)) :: ZRESP_ECO
-REAL, DIMENSION(SIZE(PPS)) :: ZFAPAR
-REAL, DIMENSION(SIZE(PPS)) :: ZFAPIR
-REAL, DIMENSION(SIZE(PPS)) :: ZFAPARC
-REAL, DIMENSION(SIZE(PPS)) :: ZFAPIRC
-REAL, DIMENSION(SIZE(PPS)) :: ZLAI_EFFC
-REAL, DIMENSION(SIZE(PPS)) :: ZMUS
-REAL, DIMENSION(SIZE(PPS)) :: ZFAPAR_BS
-REAL, DIMENSION(SIZE(PPS)) :: ZFAPIR_BS
-REAL, DIMENSION(SIZE(PPS)) :: ZIRRIG_FLUX
-REAL, DIMENSION(0,0,0) :: ZLITTER
-REAL, DIMENSION(0,0) :: ZSOILCARB, ZLIGNIN_STRUC, ZTURNOVER
-!
-REAL, DIMENSION(SIZE(PPS)) :: ZSNDRIFT
+TYPE(SSO_t) :: YSS
+TYPE(AGRI_t) :: YAG
!
-! surfaces relative fractions
+REAL, DIMENSION(SIZE(PPS)) :: ZDIRCOSZW ! orography slope cosine (=1 in TEB)
+REAL, DIMENSION(SIZE(PPS),GRO%NNBIOMASS) :: ZRESP_BIOMASS_INST ! instantaneous biomass respiration (kgCO2/kgair m/s)
+REAL, DIMENSION(SIZE(PPS)) :: ZUSTAR
+!
+! temperatures
+!
+REAL, DIMENSION(SIZE(PPS)) :: ZTA ! estimate of air temperature at future time
+! ! step as if modified by ISBA flux alone.
!
-REAL, DIMENSION(SIZE(PPS)) :: ZFFG
-REAL, DIMENSION(SIZE(PPS)) :: ZFFV
-REAL, DIMENSION(SIZE(PPS)) :: ZFF
-REAL, DIMENSION(SIZE(PPS)) :: ZALBF
+! surfaces relative fractions
+! for flood
REAL, DIMENSION(SIZE(PPS)) :: ZEMISF
-REAL, DIMENSION(SIZE(PPS)) :: ZFFROZEN
-REAL, DIMENSION(SIZE(PPS)) :: ZFFLOOD
-REAL, DIMENSION(SIZE(PPS)) :: ZPIFLOOD
-REAL, DIMENSION(SIZE(PPS)) :: ZIFLOOD
-REAL, DIMENSION(SIZE(PPS)) :: ZPFLOOD
-REAL, DIMENSION(SIZE(PPS)) :: ZLEFLOOD
-REAL, DIMENSION(SIZE(PPS)) :: ZLEIFLOOD
-REAL, DIMENSION(SIZE(PPS)) :: ZFFG_NOSNOW
-REAL, DIMENSION(SIZE(PPS)) :: ZFFV_NOSNOW
-!
-! variables for irrigation
-REAL, DIMENSION(SIZE(PPS)) :: ZIRRIG
-REAL, DIMENSION(SIZE(PPS)) :: ZWATSUP
-REAL, DIMENSION(SIZE(PPS)) :: ZTHRESHOLDSPT
-LOGICAL, DIMENSION(SIZE(PPS)) :: GIRRIGATE
-LOGICAL, DIMENSION(SIZE(PPS)) :: GIRRIDAY
-!
-! variables for deep soil
-!
-REAL, DIMENSION(SIZE(PPS)) :: ZGAMMAT ! not used
+!
+! variables for deep soil temperature
REAL, DIMENSION(SIZE(PPS)) :: ZTDEEP_A
-REAL, DIMENSION(SIZE(PPS)) :: ZTDEEP_B
-!
-REAL, DIMENSION(0) :: ZAOSIP ! A/S for increasing x
-REAL, DIMENSION(0) :: ZAOSIM ! A/S for decreasing x
-REAL, DIMENSION(0) :: ZAOSJP ! A/S for increasing y
-REAL, DIMENSION(0) :: ZAOSJM ! A/S for decreasing y
-REAL, DIMENSION(0) :: ZHO2IP ! h/2 for increasing x
-REAL, DIMENSION(0) :: ZHO2IM ! h/2 for decreasing x
-REAL, DIMENSION(0) :: ZHO2JP ! h/2 for increasing y
-REAL, DIMENSION(0) :: ZHO2JM ! h/2 for decreasing y
-REAL, DIMENSION(0) :: ZZ0EFFIP! roughness length for increasing x
-REAL, DIMENSION(0) :: ZZ0EFFIM! roughness length for decreasing x
-REAL, DIMENSION(0) :: ZZ0EFFJP! roughness length for increasing y
-REAL, DIMENSION(0) :: ZZ0EFFJM! roughness length for decreasing y
-REAL, DIMENSION(0) :: ZTAU_WOOD ! residence time in wood (s)
-REAL, DIMENSION(0,0) :: ZINCREASE
!
! Dummy variables for MEB:
-LOGICAL,PARAMETER::OMEB=.FALSE.
-LOGICAL,PARAMETER::OFORC_MEASURE=.FALSE.
-LOGICAL,PARAMETER::OMEB_LITTER=.FALSE.
-LOGICAL,PARAMETER::OMEB_GNDRES=.FALSE.
-REAL, DIMENSION(SIZE(PPS)) :: ZP_MEB_SCA_SW, &
- ZP_RGLV, ZP_GAMMAV, ZP_RSMINV, &
- ZP_WRMAX_CFV, ZP_LAIV, &
- ZP_BSLAI,ZP_LAIMIN,ZP_H_VEG,ZPALPHAN, &
- ZZ0G_WITHOUT_SNOW, &
- ZZ0_MEBV,ZZ0H_MEBV,ZZ0EFF_MEBV, &
- ZZ0_MEBN,ZZ0H_MEBN,ZZ0EFF_MEBN, &
- ZP_ALBNIR_VEG, ZP_ALBVIS_VEG, &
- ZP_ALBNIR_SOIL, ZP_ALBVIS_SOIL, ZP_GNDLITTER
-REAL, DIMENSION(SIZE(GRM%TGRP%XROOTFRAC,1),SIZE(GRM%TGRP%XROOTFRAC,2)) :: ZP_ROOTFRACV
-REAL, DIMENSION(SIZE(PPS)) :: ZP_WRL,ZP_WRLI,ZP_WRVN,ZP_TV,ZP_TL
-REAL, DIMENSION(SIZE(PPS)) :: ZP_TC,ZP_QC
-REAL, DIMENSION(SIZE(PPS)) :: ZP_SWNET_V, ZP_SWNET_G, ZP_SWNET_N, ZP_SWNET_NS, &
- ZP_LWNET_V, ZP_LWNET_G, ZP_LWNET_N, &
- ZP_LEVCV, ZP_LESC, ZP_H_V_C, ZP_H_G_C, &
- ZP_LETRGV, ZP_LETRCV, ZP_LERGV, ZP_LELITTER, ZP_LELITTERI, &
- ZP_DRIPLIT,ZP_RRLIT, ZP_LERCV, ZP_H_C_A, ZP_H_N_C, &
- ZP_LE_C_A, ZP_LE_V_C, ZP_LE_G_C, ZP_LE_N_C, &
- ZP_EVAP_N_C, ZP_EVAP_G_C, &
- ZP_SR_GN, ZP_MELTCV, ZP_FRZCV, &
- ZP_SWDOWN_GN, ZP_LWDOWN_GN
-!
-TYPE (DATE_TIME), DIMENSION(0) :: TPSEED ! seeding date
-TYPE (DATE_TIME), DIMENSION(0) :: TPREAP ! reaping date
-!
-INTEGER :: ILU
+REAL, DIMENSION(SIZE(PPS)) :: ZP_MEB_SCA_SW, ZPALPHAN, ZZ0G_WITHOUT_SNOW, &
+ ZZ0_MEBV, ZZ0H_MEBV, ZZ0EFF_MEBV, ZZ0_MEBN, &
+ ZZ0H_MEBN, ZZ0EFF_MEBN
!
-LOGICAL :: GAGRI_TO_GRASS
!
-!Snow options
-LOGICAL :: GSNOWDRIFT,GSNOWDRIFT_SUBLIM,GSNOW_ABS_ZENITH
- CHARACTER(3) :: YSNOWMETAMO,YSNOWRAD
+INTEGER :: ILU
+LOGICAL :: GUPDATED, GALB
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -365,73 +208,17 @@ ILU = SIZE(PPS)
!
ZDIRCOSZW = 1.
!
-HRAIN = 'DEF'
-OFLOOD = .FALSE.
-OTEMP_ARP = .FALSE.
-OGLACIER = .FALSE.
-ZMUF = 0.
-ZFSAT = 0.
-ZTOPQS = 0.
-ZQSB = 0.
-ZFWTD = 0.
-ZWTD = XUNDEF
-ZSNDRIFT = 0.
-!
-GAGRI_TO_GRASS = .FALSE.
-!
-! Snow options
-GSNOWDRIFT=.TRUE.
-GSNOWDRIFT_SUBLIM=.FALSE.
-GSNOW_ABS_ZENITH=.FALSE.
-YSNOWMETAMO="B92"
-YSNOWRAD="B92"
-!
-! Van genuchten parameter (not yet inplemented)
-!
-!* 1.3 flood
-! -----
-!
-ZFFG = 0.
-ZFFV = 0.
-ZFF = 0.
-ZFFROZEN = 0.
-ZALBF = 0.
-ZEMISF = 0.
-ZIFLOOD = 0.
-ZPFLOOD = 0.
-ZFFLOOD = 0.
-ZPIFLOOD = 0.
-ZLEFLOOD = 0.
-ZLEIFLOOD = 0.
-ZFFG_NOSNOW = 0.
-ZFFV_NOSNOW = 0.
-!
-!* irrigation (not implemented)
-!
-ZIRRIG = 0.
-ZWATSUP = 0.
-ZTHRESHOLDSPT = 0.
-GIRRIGATE = .FALSE.
-GIRRIDAY = .FALSE.
+ CALL SSO_INIT(YSS)
+!
+ CALL AGRI_INIT(YAG)
!
!* automatic summer irrigation
!
-PIRRIG_GREENROOF(:) = 0.
+PIRRIG(:) = 0.
!
!* deep soil implicitation with roof
!
-ZGAMMAT = XUNDEF
- CALL ROOF_IMPL_COEF(PTSTEP,TOP%NROOF_LAYER, T%CUR%XD_ROOF, T%CUR%XTC_ROOF, T%CUR%XHC_ROOF, &
- T%CUR%XT_ROOF, ZTDEEP_A,ZTDEEP_B)
-!
-!-------------------------------------------------------------------------------
-!
-!* Variables required in TEB to allow coupling
-! with AROME/ALADIN/ARPEGE as LE or EVAP
-!
-ZLEI = 0.0 ! sublimation heat flux (W/m2)
-ZSUBL = 0.0 ! sublimation (kg/m2/s)
-ZTS = 0.0 ! surface temperature (K) (non-radiative)
+ CALL ROOF_IMPL_COEF(T, PTSTEP, ZTDEEP_A, K%XTDEEP)
!
!-------------------------------------------------------------------------------
!
@@ -446,178 +233,133 @@ ZTS = 0.0 ! surface temperature (K) (non-radiative)
!
!* irrigation automatique de type goutte à goutte (arrosage du sol seulement)
!
- CALL TEB_IRRIG(TIR%LPAR_GR_IRRIG, PTSTEP, TPTIME%TDATE%MONTH, PTSUN, &
+CALL TEB_IRRIG(TIR%LPAR_GR_IRRIG, PTSTEP, TPTIME%TDATE%MONTH, PTSUN, &
TIR%XGR_START_MONTH, TIR%XGR_END_MONTH, TIR%XGR_START_HOUR, &
- TIR%XGR_END_HOUR, TIR%XGR_24H_IRRIG, PIRRIG_GREENROOF )
+ TIR%XGR_END_HOUR, TIR%XGR_24H_IRRIG, PIRRIG )
+!
+! --------------------------------------------------------------------------------------
+! Vegetation update (in case of non-interactive vegetation):
+! --------------------------------------------------------------------------------------
+!
+S%TTIME = TPTIME
+!
+GUPDATED=.FALSE.
+GALB = .FALSE.
+IF (GRO%CPHOTO=='NIT'.OR.GRO%CPHOTO=='NCB') GALB = .TRUE.
+!
+ CALL VEGETATION_UPDATE(DTCO, DTV, G%NDIM, GRO, K, P, PEK, 1, &
+ PTSTEP, S%TTIME, TOP%XCOVER, TOP%LCOVER, .FALSE., &
+ 'GNR', GALB, YSS, GUPDATED, OABSENT=(T%XGREENROOF==0.) )
!
!* 9.2 Call ISBA for greenroofs
! ------------------------
!
- CALL ISBA(GRM%TGRO%CISBA_GR, TVG%CPHOTO, GRM%TGRO%LTR_ML_GR, 'WSAT', GRM%TGRO%CKSAT_GR, &
- HRAIN, GRM%TGRO%CHORT_GR, TVG%CC1DRY, GRM%TGRO%CSCOND_GR, GRM%TGR%CUR%TSNOW%SCHEME, &
- TVG%CSNOWRES, TVG%CCPSURF, TVG%CSOILFRZ, TVG%CDIFSFCOND, TPTIME, OFLOOD, &
- OTEMP_ARP, OGLACIER, OMEB, OFORC_MEASURE, OMEB_LITTER, OMEB_GNDRES, PTSTEP, &
- HIMPLICIT_WIND, GAGRI_TO_GRASS, &
- GSNOWDRIFT,GSNOWDRIFT_SUBLIM,GSNOW_ABS_ZENITH, &
- YSNOWMETAMO,YSNOWRAD, &
- TVG%XCGMAX, PZREF, PUREF, ZDIRCOSZW, PTA, &
- PQA, PEXNA, PRHOA, PPS, PEXNS, PRR, PSR, PZENITH, &
- ZP_MEB_SCA_SW, &
- PSW, PLW, PVMOD, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, &
- PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, GRM%TGRP%XRSMIN, GRM%TGRP%XRGL, GRM%TGRP%XGAMMA,&
- GRM%TGRP%XCV, GRM%TGRP%XRUNOFFD, GRM%TGRP%XSOILWGHT, &
- GRM%TGRO%NLAYER_HORT_GR, GRM%TGRO%NLAYER_DUN_GR, &
- PALBNIR_TVEG, PALBVIS_TVEG, PALBNIR_TSOIL, PALBVIS_TSOIL, &
- GRM%TGR%CUR%XSNOWFREE_ALB, GRM%TGRP%XWRMAX_CF, GRM%TGRPE%CUR%XVEG, &
- GRM%TGRPE%CUR%XLAI, GRM%TGRPE%CUR%XEMIS, GRM%TGRPE%CUR%XZ0, &
- GRM%TGRPE%CUR%XZ0/GRM%TGRP%XZ0_O_Z0H, GRM%TGRP%XVEGTYPE, GRM%TGRPE%CUR%XZ0, &
- ZP_RGLV, ZP_GAMMAV, ZP_RSMINV, &
- ZP_ROOTFRACV, ZP_WRMAX_CFV, ZP_LAIV, &
- ZP_BSLAI,ZP_LAIMIN,ZP_H_VEG,ZPALPHAN, &
- ZZ0G_WITHOUT_SNOW, &
- ZZ0_MEBV,ZZ0H_MEBV,ZZ0EFF_MEBV, &
- ZZ0_MEBN,ZZ0H_MEBN,ZZ0EFF_MEBN, ZP_GNDLITTER, &
- GRM%TGRP%XRUNOFFB_GR, GRM%TGRP%XCGSAT, GRM%TGRP%XC1SAT, &
- GRM%TGRP%XC2REF, GRM%TGRP%XC3, GRM%TGRP%XC4B, GRM%TGRP%XC4REF, GRM%TGRP%XACOEF, &
- GRM%TGRP%XPCOEF, GRM%TGRP%XTAUICE, GRM%TGRP%XWDRAIN_GR,&
- ZTDEEP_A, ZTDEEP_B, ZGAMMAT, GRM%TGR%CUR%XPSN, GRM%TGR%CUR%XPSNG, &
- GRM%TGR%CUR%XPSNV, GRM%TGR%CUR%XPSNV_A, &
- GRM%TGR%CUR%XSNOWFREE_ALB_VEG, GRM%TGR%CUR%XSNOWFREE_ALB_SOIL, ZIRRIG, ZWATSUP, &
- ZTHRESHOLDSPT, GIRRIGATE, GIRRIDAY, GRM%TGRP%LSTRESS, GRM%TGRP%XGC, GRM%TGRP%XF2I, &
- GRM%TGRP%XDMAX, GRM%TGRP%XAH, GRM%TGRP%XBH, PCO2, GRM%TGRP%XGMES, &
- GRM%TGRP%XPOI, GRM%TGRP%XFZERO, GRM%TGRP%XEPSO, GRM%TGRP%XGAMM, &
- GRM%TGRP%XQDGAMM, GRM%TGRP%XQDGMES, GRM%TGRP%XT1GMES, GRM%TGRP%XT2GMES, &
- GRM%TGRP%XAMAX, GRM%TGRP%XQDAMAX, GRM%TGRP%XT1AMAX,&
- GRM%TGRP%XT2AMAX, GRM%TGRP%XABC, GRM%TGRP%XDG, GRM%TGRP%XDZG, GRM%TGRP%XDZDIF, &
- GRM%TGRP%NWG_LAYER, GRM%TGRP%XROOTFRAC, &
- GRM%TGRP%XWFC, GRM%TGRP%XWWILT, GRM%TGRP%XWSAT, GRM%TGRP%XBCOEF, GRM%TGRP%XCONDSAT, &
- GRM%TGRP%XMPOTSAT, GRM%TGRP%XHCAPSOIL, GRM%TGRP%XCONDDRY, GRM%TGRP%XCONDSLD, &
- GRM%TGRP%XD_ICE, GRM%TGRP%XKSAT_ICE, ZMUF, ZFF,&
- ZFFG, ZFFV, ZFFG_NOSNOW, ZFFV_NOSNOW, ZFFROZEN, ZALBF, &
- ZEMISF, ZFFLOOD, ZPIFLOOD, ZIFLOOD, ZPFLOOD, ZLEFLOOD, &
- ZLEIFLOOD, ZSODELX, TG%XLAT, TG%XLON, GRM%TGR%CUR%XTG, GRM%TGR%CUR%XWG, &
- GRM%TGR%CUR%XWGI, GRM%TGRP%XPCPS, GRM%TGRP%XPLVTT, GRM%TGRP%XPLSTT, GRM%TGR%CUR%XWR, &
- ZP_WRL,ZP_WRLI,ZP_WRVN,ZP_TV, ZP_TL, &
- GRM%TGR%CUR%XRESA, GRM%TGR%CUR%XANFM, ZFSAT, GRM%TGR%CUR%TSNOW%ALB(:,1), &
- GRM%TGR%CUR%TSNOW%ALBVIS(:,1), GRM%TGR%CUR%TSNOW%ALBNIR(:,1), GRM%TGR%CUR%TSNOW%ALBFIR(:,1), &
- GRM%TGR%CUR%TSNOW%WSNOW(:,:,1), GRM%TGR%CUR%TSNOW%HEAT(:,:,1), GRM%TGR%CUR%TSNOW%RHO(:,:,1), &
- GRM%TGR%CUR%TSNOW%GRAN1(:,:,1), GRM%TGR%CUR%TSNOW%GRAN2(:,:,1), GRM%TGR%CUR%TSNOW%HIST(:,:,1), &
- GRM%TGR%CUR%TSNOW%AGE(:,:,1), ZGRNDFLUX, ZHPSNOW, ZSNOWHMASS, &
- ZRNSNOW, ZHSNOW, ZGFLUXSNOW, ZUSTARSNOW, &
- ZSRSFC, ZRRSFC, ZLESL, GRM%TGR%CUR%TSNOW%EMIS(:,1), ZCDSNOW, ZCHSNOW, &
- PTS_GREENROOF, ZTS, ZHV, ZQS, ZSNOWTEMP, ZSNOWLIQ, ZSNOWDZ, &
- ZCG, ZC1, ZC2, ZWGEQ, ZCT, ZCH, ZCD, ZCDN, ZRI, ZHU, ZHUG, &
- ZEMIST, ZALBT, ZRS, GRM%TGR%CUR%XLE, ZRN, ZH, ZLEI, ZLEGI, ZLEG, ZLEV, &
- ZLES, ZLER, ZLETR, ZEVAP, ZGFLUX, ZRESTORE, ZUSTAR, ZDRAIN, &
- ZRUNOFF, ZMELT, ZMELTADV, &
- ZP_TC,ZP_QC, &
- ZRN_ISBA, ZH_ISBA, ZLEG_ISBA, &
- ZLEGI_ISBA, ZLEV_ISBA, ZLETR_ISBA, ZUSTAR_ISBA, ZLER_ISBA, &
- ZLE_ISBA, ZLEI_ISBA, ZGFLUX_ISBA, ZHORT, ZDRIP, ZRRVEG, &
- PAC_AGG_GREENROOF, PHU_AGG_GREENROOF, ZFAPARC, ZFAPIRC, ZMUS, &
- ZLAI_EFFC, GRM%TGR%CUR%XAN, GRM%TGR%CUR%XANDAY, ZRESP_BIOMASS_INST, ZIACAN, GRM%TGRP%XANF, &
- ZGPP, ZFAPAR, ZFAPIR, ZFAPAR_BS, ZFAPIR_BS, ZIRRIG_FLUX, &
- PDEEP_FLUX, &
- ZP_SWNET_V, ZP_SWNET_G, ZP_SWNET_N, ZP_SWNET_NS, &
- ZP_LWNET_V, ZP_LWNET_G, ZP_LWNET_N, &
- ZP_LEVCV, ZP_LESC, ZP_H_V_C, ZP_H_G_C, &
- ZP_LETRGV, ZP_LETRCV, ZP_LERGV, ZP_LELITTER, ZP_LELITTERI, &
- ZP_DRIPLIT,ZP_RRLIT, ZP_LERCV, ZP_H_C_A, ZP_H_N_C, &
- ZP_LE_C_A, ZP_LE_V_C, ZP_LE_G_C, ZP_LE_N_C, &
- ZP_EVAP_N_C, ZP_EVAP_G_C, &
- ZP_SR_GN, ZP_MELTCV, ZP_FRZCV, &
- ZP_SWDOWN_GN, ZP_LWDOWN_GN, &
- PIRRIG_GREENROOF, ZTOPQS, ZQSB, ZSUBL, ZFWTD, ZWTD, ZSNDRIFT)
-!
-PRUNOFF_GREENROOF(:) = ZRUNOFF(:)
-PDRAIN_GREENROOF(:) = ZDRAIN(:)
-
-!
-IF (GRM%TGR%CUR%TSNOW%SCHEME=='3-L' .OR. GRM%TGR%CUR%TSNOW%SCHEME=='CRO') GRM%TGR%CUR%TSNOW%TS(:,1)=ZSNOWTEMP(:,1)
+DK%XZ0(:) = PEK%XZ0(:)
+DK%XZ0H(:) = PEK%XZ0(:) / P%XZ0_O_Z0H(:)
+!
+DK%XZ0EFF(:) = PEK%XZ0(:)
+!
+ALLOCATE(GB%XIACAN(SIZE(PPS),SIZE(S%XABC)))
+!
+ CALL ISBA(GRO, K, P, PEK, G, YAG, DK, DEK, DMK, &
+ TPTIME, S%XPOI, S%XABC, GB%XIACAN, .FALSE., PTSTEP, &
+ HIMPLICIT_WIND, PZREF, PUREF, ZDIRCOSZW, PTA, PQA, PEXNA, PRHOA, PPS, &
+ PEXNS, PRR, PSR, PZENITH, ZP_MEB_SCA_SW, PSW, PLW, PVMOD, PPEW_A_COEF, &
+ PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
+ PALBNIR_TVEG, PALBVIS_TVEG, PALBNIR_TSOIL, PALBVIS_TSOIL, ZPALPHAN, &
+ ZZ0G_WITHOUT_SNOW, ZZ0_MEBV, ZZ0H_MEBV, ZZ0EFF_MEBV, ZZ0_MEBN, &
+ ZZ0H_MEBN, ZZ0EFF_MEBN, ZTDEEP_A, PCO2, K%XFFG(:), K%XFFV(:), &
+ ZEMISF, ZUSTAR, PAC_AGG, PHU_AGG, ZRESP_BIOMASS_INST, PDEEP_FLUX, PIRRIG )
+!
+IF (PEK%TSNOW%SCHEME=='3-L' .OR. PEK%TSNOW%SCHEME=='CRO') PEK%TSNOW%TS(:) = DMK%XSNOWTEMP(:,1)
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Diagnostic of respiration carbon fluxes and soil carbon evolution
!
-! --------------------------------------------------------------------------------------
-! Vegetation update (in case of non-interactive vegetation):
-! --------------------------------------------------------------------------------------
-!
-IF (TVG%CPHOTO=='NON' .OR. TVG%CPHOTO=='AGS' .OR. TVG%CPHOTO=='AST') THEN
- CALL VEGETATION_UPDATE_GREENROOF(DTCO, DTI, IG, I, T, TOP, TVG, DTGD, GRM, &
- TPTIME,PTSTEP,ILU)
-END IF
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Vegetation evolution for interactive LAI
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-IF (TVG%CPHOTO=='LAI' .OR. TVG%CPHOTO=='LST' .OR. TVG%CPHOTO=='NIT') THEN
- CALL VEGETATION_EVOL(GRM%TGRO%CISBA_GR, TVG%CPHOTO, TVG%CRESPSL, TVG%CALBEDO, .FALSE., &
- GRM%TGRO%LTR_ML_GR, TVG%LNITRO_DILU, GAGRI_TO_GRASS, &
- .FALSE., .FALSE., .FALSE., &
- PTSTEP, TPTIME%TDATE%MONTH, TPTIME%TDATE%DAY, 1, &
- TPTIME%TIME, TG%XLAT, PRHOA, GRM%TGRP%XDG, GRM%TGRP%XDZG, &
- GRM%TGRP%NWG_LAYER, GRM%TGR%CUR%XTG, GRM%TGRP%XALBNIR_VEG, &
- GRM%TGRP%XALBVIS_VEG, GRM%TGRP%XALBUV_VEG, GRM%TGRP%XALBNIR_SOIL, &
- GRM%TGRP%XALBVIS_SOIL, GRM%TGRP%XALBUV_SOIL, GRM%TGRP%XVEGTYPE, &
- GRM%TGRP%XSEFOLD, GRM%TGRP%XANMAX, GRM%TGRP%XH_TREE, GRM%TGRP%XBSLAI, &
- GRM%TGRP%XLAIMIN, PCO2, GRM%TGRP%XCE_NITRO, GRM%TGRP%XCF_NITRO, &
- GRM%TGRP%XCNA_NITRO, GRM%TGRP%XBSLAI_NITRO, GRM%TGRP%XGMES, &
- ZTAU_WOOD, TPSEED, TPREAP, ZAOSIP, ZAOSIM, ZAOSJP, ZAOSJM, &
- ZHO2IP, ZHO2IM, ZHO2JP, ZHO2JM, ZZ0EFFIP, &
- ZZ0EFFIM, ZZ0EFFJP, ZZ0EFFJM, GRM%TGRPE%CUR%XLAI, GRM%TGRPE%CUR%XVEG, &
- GRM%TGRPE%CUR%XZ0, GRM%TGRPE%CUR%XALBNIR, GRM%TGRPE%CUR%XALBVIS, &
- GRM%TGRPE%CUR%XALBUV, GRM%TGRPE%CUR%XEMIS, GRM%TGR%CUR%XANFM, &
- GRM%TGR%CUR%XANDAY, GRM%TGR%CUR%XBIOMASS, GRM%TGR%CUR%XRESP_BIOMASS, &
- ZRESP_BIOMASS_INST, ZINCREASE, ZTURNOVER )
+!
+IF (GRO%CPHOTO=='NIT') THEN
+ CALL VEGETATION_EVOL(GRO, DTV, P, PEK, .FALSE., PTSTEP, TPTIME%TDATE%MONTH, TPTIME%TDATE%DAY, &
+ TPTIME%TIME, G%XLAT, PRHOA, PCO2, YSS, ZRESP_BIOMASS_INST )
END IF
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-PSFCO2 (:)=0.
-ZRESP_ECO (:)=0.
-ZRESP_AUTO(:)=0.
+PSFCO2 (:) = 0.
+DEK%XRESP_ECO (:) = 0.
+DEK%XRESP_AUTO(:) = 0.
!
-IF (TVG%CPHOTO/='NON' .AND. TVG%CRESPSL/='NON' .AND. ANY(GRM%TGRPE%CUR%XLAI(:)/=XUNDEF)) THEN
+IF (GRO%CPHOTO/='NON' .AND. GRO%CRESPSL/='NON' .AND. ANY(PEK%XLAI(:)/=XUNDEF)) THEN
! faire intervenir le type de vegetation du greenroof ? (CTYP_GR)
- CALL CARBON_EVOL(TVG%CISBA, TVG%CRESPSL, TVG%CPHOTO, PTSTEP, 1, &
- PRHOA, GRM%TGR%CUR%XTG, GRM%TGR%CUR%XWG, GRM%TGRP%XWFC, &
- GRM%TGRP%XWWILT, GRM%TGRP%XWSAT, GRM%TGRP%XSAND_GR,&
- GRM%TGRP%XDG, GRM%TGRP%XDZG, GRM%TGRP%NWG_LAYER, &
- GRM%TGRP%XRE25, GRM%TGRPE%CUR%XLAI, ZRESP_BIOMASS_INST, ZTURNOVER, &
- ZLITTER, ZLIGNIN_STRUC , ZSOILCARB, &
- ZRESP_AUTO, ZRESP_ECO )
+ CALL CARBON_EVOL(GRO, K, P, PEK, DEK, PTSTEP, PRHOA, ZRESP_BIOMASS_INST )
! calculation of vegetation CO2 flux
! Positive toward the atmosphere
- PSFCO2(:) = ZRESP_ECO(:) - ZGPP(:)
+ PSFCO2(:) = DEK%XRESP_ECO(:) - DEK%XGPP(:)
END IF
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-!* 9. Fields required for TEB
-! -----------------------
+!* 4. Set undefined values for points where there is no garden
+! --------------------------------------------------------
!
-! energy balance
+! This way, these points are clearly flaged, and one will not try to interpret
+! the values for those points
!
- PRN_GREENROOF (:) = ZRN (:)
- PH_GREENROOF (:) = ZH (:)
- PLE_GREENROOF (:) = GRM%TGR%CUR%XLE (:)
- PGFLUX_GREENROOF (:) = ZGFLUX (:)
- PEVAP_GREENROOF (:) = ZEVAP (:)
+ CALL FLAG_TEB_VEG_n(PEK, GRO, T%XGREENROOF, 2)
!
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-! Estimate of green area aerodynamic conductance recomputed from heat flux,
-! surface (radiative) temp. and forcing air temperature (estimated at future time step)
- ZTA = PPET_B_COEF + PPET_A_COEF * PH_GREENROOF
- PAC_GREENROOF = 0.
- WHERE (PTS_GREENROOF /= ZTA)
- PAC_GREENROOF(:) = MAX(PH_GREENROOF(:) / XCPD / PRHOA(:) / (PTS_GREENROOF - ZTA) , 0.)
- ENDWHERE
+!* 9. Fields required for TEB
+! -----------------------
!
-! Humidity of saturation for green areas
- PQSAT_GREENROOF(:) = QSAT(GRM%TGR%CUR%XTG(:,1),PPS(:))
+WHERE (T%XGREENROOF/=0.)
+ !
+ ! energy balance
+ !
+ DK%XLE(:) = PEK%XLE(:)
+ !
+ ! Estimate of green area aerodynamic conductance recomputed from heat flux,
+ ! surface (radiative) temp. and forcing air temperature (estimated at future time step)
+ ZTA = PPET_B_COEF + PPET_A_COEF * DK%XH
+ PAC = 0.
+ WHERE (DK%XTSRAD /= ZTA)
+ PAC(:) = MAX(DK%XH(:) / XCPD / PRHOA(:) / (DK%XTSRAD - ZTA) , 0.)
+ ENDWHERE
+ !
+ ! Humidity of saturation for green areas
+ PQSAT(:) = QSAT(PEK%XTG(:,1),PPS(:))
+ !
+ !* friction flux
+ PUW(:) = -ZUSTAR(:)**2
+ !
+ELSEWHERE
+ !
+ DK%XRN (:) = XUNDEF
+ DK%XH (:) = XUNDEF
+ DK%XLE (:) = XUNDEF
+ DK%XGFLUX (:) = XUNDEF
+ DK%XEVAP (:) = XUNDEF
+ !
+ PAC (:) = XUNDEF
+ PQSAT (:) = XUNDEF
+ PUW (:) = XUNDEF
+ !
+END WHERE
+!
+!
+PTSRAD(:) = DK%XTSRAD(:)
+!
+PRN (:) = DK%XRN (:)
+PH (:) = DK%XH (:)
+PLE (:) = DK%XLE (:)
+PGFLUX(:) = DK%XGFLUX (:)
+PEVAP (:) = DK%XEVAP (:)
+PRUNOFF(:) =DEK%XRUNOFF(:)
+PDRAIN (:) =DEK%XDRAIN (:)
!
-!* friction flux
- PUW_GREENROOF(:) = -ZUSTAR(:)**2
IF (LHOOK) CALL DR_HOOK('GREENROOF',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/greenroof_properties.F90 b/src/SURFEX/greenroof_properties.F90
deleted file mode 100644
index c4dfdefc27d55ad0eb9635d93500ce8d9de7413b..0000000000000000000000000000000000000000
--- a/src/SURFEX/greenroof_properties.F90
+++ /dev/null
@@ -1,159 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE GREENROOF_PROPERTIES (T, TVG, GRM, &
- PDIR_SW, PSCA_SW, PSW_BANDS, KSW,&
- PTS, PEMIS, PALB, PTA, &
- PALBNIR_TVEG, PALBVIS_TVEG, &
- PALBNIR_TSOIL, PALBVIS_TSOIL )
-! ##########################################################################
-!
-!!**** *GREENROOF_PROPERTIES*
-!!
-!! PURPOSE
-!! -------
-!
-! Based on garden_properties
-! Calculates grid-averaged albedo and emissivity (according to snow scheme)
-!
-!! EXTERNAL
-!! --------
-!!
-!! none
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! AUTHOR
-!! ------
-!!
-!! S. Belair * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ?
-!! C. de Munck and A. Lemonsu 09/2011
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE MODD_TEB_n, ONLY : TEB_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
-USE MODD_SURFEX_n, ONLY : TEB_GREENROOF_MODEL_t
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-!
-!
-USE MODI_ISBA_PROPERTIES
-USE MODI_FLAG_TEB_GREENROOF_n
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(TEB_t), INTENT(INOUT) :: T
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
-TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIR_SW ! direct incoming solar radiation
-REAL, DIMENSION(:,:), INTENT(IN) :: PSCA_SW ! diffus incoming solar radiation
-REAL, DIMENSION(:) , INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m)
-INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands
-!
-REAL, DIMENSION(:) , INTENT(OUT) :: PTS ! radiative surface temperature
-REAL, DIMENSION(:) , INTENT(OUT) :: PEMIS ! green areas emissivity
-REAL, DIMENSION(:) , INTENT(OUT) :: PALB ! green areas albedo
-!
-REAL, DIMENSION(:) , INTENT(IN), OPTIONAL :: PTA ! Air temperature (K)
-!
-REAL, DIMENSION(:) , INTENT(OUT), OPTIONAL :: PALBNIR_TVEG ! nearIR veg tot albedo
-REAL, DIMENSION(:) , INTENT(OUT), OPTIONAL :: PALBVIS_TVEG ! visible veg tot albedo
-REAL, DIMENSION(:) , INTENT(OUT), OPTIONAL :: PALBNIR_TSOIL ! nearIR soil tot albedo
-REAL, DIMENSION(:) , INTENT(OUT), OPTIONAL :: PALBVIS_TSOIL ! visible soil tot albedo
-!
-!-------------------------------------------------------------------------------
-!
-!* 0.2 Local variables
-! ---------------
-!
-INTEGER :: JLAYER
-INTEGER :: JSWB
-!
-REAL, DIMENSION(SIZE(PALB)) :: ZTSNOSNOW ! surf. temp. on snow free part
-REAL, DIMENSION(SIZE(PALB)) :: ZTSSNOW ! surf. temp. on snow covered part
-REAL, DIMENSION(SIZE(PALB)) :: ZANOSNOW ! snow-free surface albedo
-REAL, DIMENSION(SIZE(PALB)) :: ZASNOW ! snow albedo
-REAL, DIMENSION(SIZE(PALB)) :: ZENOSNOW ! snow-free surface emissivity
-REAL, DIMENSION(SIZE(PALB)) :: ZESNOW ! snow emissivity
-!
-REAL, DIMENSION(SIZE(PALB)) :: ZALBNIR_TVEG ! nearIR veg tot albedo
-REAL, DIMENSION(SIZE(PALB)) :: ZALBVIS_TVEG ! visible veg tot albedo
-REAL, DIMENSION(SIZE(PALB)) :: ZALBNIR_TSOIL ! nearIR soil tot albedo
-REAL, DIMENSION(SIZE(PALB)) :: ZALBVIS_TSOIL ! visible soil tot albedo
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-!
-!* only one patch for green roofs
-IF (LHOOK) CALL DR_HOOK('GREENROOF_PROPERTIES',0,ZHOOK_HANDLE)
-!
-!* 1. Set physical values for points where there is no green roof
-! -----------------------------------------------------------
-!
-! This way, ISBA can run without problem for these points
-!
- CALL FLAG_TEB_GREENROOF_n(GRM%TGR, GRM%TGRO, GRM%TGRPE, T, TVG, &
- 1)
-!
-!
-!* 2. Computes several properties of green roofs
-! ------------------------------------------
-!
-!
- CALL ISBA_PROPERTIES(GRM%TGRO%CISBA_GR, GRM%TGRO%LTR_ML_GR, GRM%TGR%CUR%TSNOW, 1, &
- PDIR_SW, PSCA_SW, PSW_BANDS, KSW, &
- GRM%TGRPE%CUR%XALBNIR, GRM%TGRPE%CUR%XALBVIS, GRM%TGRPE%CUR%XALBUV, &
- GRM%TGRP%XALBNIR_VEG, GRM%TGRP%XALBVIS_VEG, GRM%TGRP%XALBUV_VEG, &
- GRM%TGRP%XALBNIR_SOIL, GRM%TGRP%XALBVIS_SOIL, &
- GRM%TGRP%XALBUV_SOIL, GRM%TGRPE%CUR%XVEG, GRM%TGRPE%CUR%XLAI, &
- GRM%TGRPE%CUR%XZ0, GRM%TGRPE%CUR%XEMIS, GRM%TGR%CUR%XTG(:,1), &
- ZASNOW,ZANOSNOW, &
- ZESNOW,ZENOSNOW, &
- ZTSSNOW,ZTSNOSNOW, &
- GRM%TGR%CUR%XSNOWFREE_ALB_VEG, GRM%TGR%CUR%XSNOWFREE_ALB_SOIL, &
- ZALBNIR_TVEG, ZALBVIS_TVEG, ZALBNIR_TSOIL, &
- ZALBVIS_TSOIL, &
- GRM%TGR%CUR%XPSN, GRM%TGR%CUR%XPSNV_A, GRM%TGR%CUR%XPSNG, GRM%TGR%CUR%XPSNV )
-!
-GRM%TGR%CUR%XSNOWFREE_ALB = ZANOSNOW
-!
-!* averaged albedo
-PALB = GRM%TGR%CUR%XPSN(:) * ZASNOW + (1.-GRM%TGR%CUR%XPSN(:)) * ZANOSNOW
-!* averaged emissivity
-PEMIS= GRM%TGR%CUR%XPSN(:) * ZESNOW + (1.-GRM%TGR%CUR%XPSN(:)) * ZENOSNOW
-!* averaged surface radiative temperature
-! (recomputed from emitted long wave)
-PTS =((GRM%TGR%CUR%XPSN(:) * ZESNOW * ZTSSNOW**4 + &
- (1.-GRM%TGR%CUR%XPSN(:)) * ZENOSNOW * ZTSNOSNOW**4) / PEMIS)**0.25
-!
-IF(PRESENT(PALBNIR_TVEG))PALBNIR_TVEG(:)=ZALBNIR_TVEG(:)
-IF(PRESENT(PALBVIS_TVEG))PALBVIS_TVEG(:)=ZALBVIS_TVEG(:)
-IF(PRESENT(PALBNIR_TSOIL))PALBNIR_TSOIL(:)=ZALBNIR_TSOIL(:)
-IF(PRESENT(PALBVIS_TSOIL))PALBVIS_TSOIL(:)=ZALBVIS_TSOIL(:)
-!
-IF (LHOOK) CALL DR_HOOK('GREENROOF_PROPERTIES',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-
-END SUBROUTINE GREENROOF_PROPERTIES
diff --git a/src/SURFEX/grid_from_file.F90 b/src/SURFEX/grid_from_file.F90
index f0d25b0b0dcf6e4956f2c042afbc342b7b2d1396..63e70df28994d16a0afe1d7b2608f038c45c5060 100644
--- a/src/SURFEX/grid_from_file.F90
+++ b/src/SURFEX/grid_from_file.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GRID_FROM_FILE (&
- HPROGRAM,HFILE,HFILETYPE,OGRID,HGRID,KGRID_PAR,PGRID_PAR,KL,U)
+ SUBROUTINE GRID_FROM_FILE (U,GCP,PGRID_FULL_PAR,HPROGRAM,HFILE,HFILETYPE,&
+ OGRID,HGRID,KGRID_PAR,PGRID_PAR,KL,HDIR)
! ##########################################################
!!
!! PURPOSE
@@ -41,9 +41,16 @@
!* 0. DECLARATION
! -----------
!
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NSIZE_TASK
!
+#ifdef MNH_PARALLEL
+USE MODE_TOOLS_ll, ONLY : GET_DIM_PHYS_ll
+#endif
!
+USE MODI_READ_NAM_GRIDTYPE
USE MODI_OPEN_AUX_IO_SURF
USE MODI_READ_GRIDTYPE
USE MODI_CLOSE_AUX_IO_SURF
@@ -56,18 +63,15 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
USE MODI_GET_LUOUT
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
-#ifdef MNH_PARALLEL
-USE MODE_TOOLS_ll, ONLY : GET_DIM_PHYS_ll
-#endif
-
IMPLICIT NONE
!
!* 0.1 Declaration of dummy arguments
! ------------------------------
!
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
+REAL, DIMENSION(:), POINTER :: PGRID_FULL_PAR
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling the surface
CHARACTER(LEN=28), INTENT(IN) :: HFILE ! file name
@@ -77,19 +81,19 @@ LOGICAL, INTENT(IN) :: OGRID ! .true. if grid is imposed by atm
INTEGER, INTENT(OUT) :: KGRID_PAR ! size of PGRID_PAR
REAL, DIMENSION(:), POINTER :: PGRID_PAR ! parameters defining this grid
INTEGER, INTENT(OUT) :: KL ! number of points on processor
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+ CHARACTER(LEN=1), INTENT(IN) :: HDIR
!
!
!* 0.2 Declaration of local variables
! ------------------------------
!
-INTEGER :: ILUOUT ! listing file logical unit
-INTEGER :: ILUNAM ! namelist file logical unit
-INTEGER :: IRESP ! return code
INTEGER :: IIMAX
INTEGER :: IJMAX
INTEGER :: IIMAX_LOC
INTEGER :: IJMAX_LOC
+INTEGER :: ILUOUT ! listing file logical unit
+INTEGER :: ILUNAM ! namelist file logical unit
+INTEGER :: IRESP ! return code
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.3 Declaration of namelists
@@ -107,79 +111,84 @@ IF (LHOOK) CALL DR_HOOK('GRID_FROM_FILE',0,ZHOOK_HANDLE)
!
!* 2. Opening of the file
! -------------------
-!
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'FULL ')
!
!---------------------------------------------------------------------------
!
!* 3. Number of points in this file
! -----------------------------
!
- CALL READ_SURF(&
- HFILETYPE,'DIM_FULL ',KL,IRESP)
- U%NDIM_FULL = KL
-!
-!---------------------------------------------------------------------------
-!
-!* 4. Grid type
-! ---------
-!
- CALL READ_SURF(&
- HFILETYPE,'GRID_TYPE',HGRID,IRESP)
-!
-!---------------------------------------------------------------------------
-!
-!* 5. Reading parameters of the grid
-! ------------------------------
-!
+IF (HDIR/='H') THEN
+ !
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'FULL ',HDIR=HDIR)
+ !
+ CALL READ_SURF(HFILETYPE,'DIM_FULL ',KL,IRESP,HDIR=HDIR)
+ U%NDIM_FULL = KL
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 4. Grid type
+ ! ---------
+ !
+ CALL READ_SURF(HFILETYPE,'GRID_TYPE',HGRID,IRESP,HDIR=HDIR)
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 5. Reading parameters of the grid
+ ! ------------------------------
+ !
#ifdef MNH_PARALLEL
- CALL READ_SURF(HPROGRAM,'IMAX ',IIMAX, IRESP,HDIR='H')
- CALL READ_SURF(HPROGRAM,'JMAX ',IJMAX, IRESP,HDIR='H')
- U%NIMAX_SURF_ll = IIMAX
- U%NJMAX_SURF_ll = IJMAX
- CALL GET_DIM_PHYS_ll('B',IIMAX_LOC,IJMAX_LOC)
- U%NSIZE_FULL = IIMAX_LOC*IJMAX_LOC
- KL = U%NSIZE_FULL
- CALL READ_GRIDTYPE(HFILETYPE,HGRID,KGRID_PAR,U%NSIZE_FULL,.FALSE.,HDIR='H')
-!
-ALLOCATE(PGRID_PAR(KGRID_PAR))
- CALL READ_GRIDTYPE(HFILETYPE,HGRID,KGRID_PAR,U%NSIZE_FULL,.TRUE.,PGRID_PAR,IRESP,HDIR='H')
-#else
- CALL READ_GRIDTYPE(HFILETYPE,HGRID,KGRID_PAR,KL,.FALSE.,HDIR='A')
-!
-ALLOCATE(PGRID_PAR(KGRID_PAR))
- CALL READ_GRIDTYPE(&
- HFILETYPE,HGRID,KGRID_PAR,KL,.TRUE.,PGRID_PAR,IRESP,HDIR='A')
+ CALL READ_SURF(HPROGRAM,'IMAX ',IIMAX, IRESP,HDIR='H')
+ CALL READ_SURF(HPROGRAM,'JMAX ',IJMAX, IRESP,HDIR='H')
+ U%NIMAX_SURF_ll = IIMAX
+ U%NJMAX_SURF_ll = IJMAX
+ CALL GET_DIM_PHYS_ll('B',IIMAX_LOC,IJMAX_LOC)
+ U%NSIZE_FULL = IIMAX_LOC*IJMAX_LOC
+ KL = U%NSIZE_FULL
+ CALL READ_GRIDTYPE(HFILETYPE,HGRID,KGRID_PAR,U%NSIZE_FULL,.FALSE.,HDIR='H')
+ !
+ ALLOCATE(PGRID_PAR(KGRID_PAR))
+ CALL READ_GRIDTYPE(HFILETYPE,HGRID,KGRID_PAR,U%NSIZE_FULL,.TRUE.,PGRID_PAR,IRESP,HDIR='H')
+#else
+ CALL READ_GRIDTYPE(HFILETYPE,HGRID,KGRID_PAR,KL,.FALSE.,HDIR=HDIR)
+ !
+ ALLOCATE(PGRID_PAR(KGRID_PAR))
+ CALL READ_GRIDTYPE(HFILETYPE,HGRID,KGRID_PAR,KL,.TRUE.,PGRID_PAR,IRESP,HDIR=HDIR)
#endif
-!
-!---------------------------------------------------------------------------
-!
-!* 6. Closes the file
-! ---------------
-!
- CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
-!
-!------------------------------------------------------------------------------
-!
-!* 7. Open namelist
-! -------------
-!
- CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
-!
-!------------------------------------------------------------------------------
-!
-!* 8. Grid modification
-! -----------------
-!
-IF (.NOT. OGRID) CALL GRID_MODIF(U,ILUOUT,ILUNAM,HGRID,KGRID_PAR,PGRID_PAR,KL)
-!
-!------------------------------------------------------------------------------
-!
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 6. Closes the file
+ ! ---------------
+ !
+ CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
+ !
+ !------------------------------------------------------------------------------
+ !
+ !* 7. Open namelist
+ ! -------------
+ !
+ CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
+ !
+ !------------------------------------------------------------------------------
+ !
+ !* 8. Grid modification
+ ! -----------------
+ !
+ IF (.NOT. OGRID) CALL GRID_MODIF(U,ILUOUT,ILUNAM,HGRID,KGRID_PAR,PGRID_PAR,KL)
+ !
+ CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
+ !
+ELSE
+ !
+ CALL READ_NAM_GRIDTYPE(GCP,PGRID_FULL_PAR,U%NDIM_FULL,HPROGRAM,HGRID,KGRID_PAR,PGRID_PAR,KL,HDIR)
+ !
+ENDIF
+ !
+ !------------------------------------------------------------------------------
+ !
!* 9. Close namelist
! --------------
!
- CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
IF (LHOOK) CALL DR_HOOK('GRID_FROM_FILE',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/grid_modif.F90 b/src/SURFEX/grid_modif.F90
index 8b00d2224f18fcac4c866bb128e61b5aeaf546cc..8cbb97475be2fc08c9172fcf81344a355651b8fa 100644
--- a/src/SURFEX/grid_modif.F90
+++ b/src/SURFEX/grid_modif.F90
@@ -39,8 +39,8 @@
!* 0. DECLARATION
! -----------
!
-!
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -54,6 +54,7 @@ IMPLICIT NONE
! ------------------------------
!
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+!
INTEGER, INTENT(IN) :: KLUOUT ! output listing logical unit
INTEGER, INTENT(IN) :: KLUNAM ! namelist file logical unit
CHARACTER(LEN=10), INTENT(IN) :: HGRID ! type of horizontal grid
@@ -99,7 +100,7 @@ DEALLOCATE(ZGRID_PAR)
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('GRID_MODIF',1,ZHOOK_HANDLE)
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/grid_modif_cartesian.F90 b/src/SURFEX/grid_modif_cartesian.F90
index 58b4cb14aa0193d677f50bd11f9003dff0fe8eef..416efad9706e9d60a3d1053c4930afec10e94a98 100644
--- a/src/SURFEX/grid_modif_cartesian.F90
+++ b/src/SURFEX/grid_modif_cartesian.F90
@@ -40,6 +40,7 @@
! ------------
!
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+!
USE MODD_SURF_PAR, ONLY : NUNDEF
#ifdef SFX_MNH
USE MODD_SPAWN, ONLY : NDXRATIO,NDYRATIO,NXSIZE,NYSIZE,NXOR,NYOR
@@ -60,6 +61,7 @@ IMPLICIT NONE
! -------------------------
!
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+!
INTEGER, INTENT(IN) :: KLUOUT ! output listing logical unit
INTEGER, INTENT(IN) :: KLUNAM ! namelist file logical unit
INTEGER, INTENT(IN) :: KL ! number of points
@@ -118,6 +120,7 @@ NAMELIST/NAM_INIFILE_CARTESIAN/IXOR,IYOR,IXSIZE,IYSIZE,IDXRATIO,IDYRATIO
IF (LHOOK) CALL DR_HOOK('GRID_MODIF_CARTESIAN',0,ZHOOK_HANDLE)
CALL POSNAM(KLUNAM,'NAM_INIFILE_CARTESIAN',GFOUND,KLUOUT)
IF (GFOUND) READ(UNIT=KLUNAM,NML=NAM_INIFILE_CARTESIAN)
+!
#ifdef SFX_MNH
! store the parameter in MODD_SPAWN
NXOR = IXOR
@@ -162,12 +165,7 @@ IJMAX2=IYSIZE*IDYRATIO
!
KL2 = IIMAX2 * IJMAX2
!
-ALLOCATE(ZX2 (IIMAX2*IJMAX2))
-ALLOCATE(ZY2 (IIMAX2*IJMAX2))
-ALLOCATE(ZDX2(IIMAX2*IJMAX2))
-ALLOCATE(ZDY2(IIMAX2*IJMAX2))
-!
- CALL REGULAR_GRID_SPAWN(U,KLUOUT, &
+ CALL REGULAR_GRID_SPAWN(U,KLUOUT, &
KL, IIMAX1,IJMAX1,ZX1,ZY1,ZDX1,ZDY1, &
IXOR, IYOR, IDXRATIO, IDYRATIO, &
IXSIZE, IYSIZE, &
diff --git a/src/SURFEX/grid_modif_conf_proj.F90 b/src/SURFEX/grid_modif_conf_proj.F90
index 67cbe7749a23b018c356c93e3ecab052110d93c0..3be1c2c7635370da4915ea56973d903a201784d1 100644
--- a/src/SURFEX/grid_modif_conf_proj.F90
+++ b/src/SURFEX/grid_modif_conf_proj.F90
@@ -32,22 +32,23 @@
!!
!! MODIFICATIONS
!! -------------
-!! Original 01/2004
+!! Original 01/2004
!! M.Moge 06/2015 Initialization of MODD_SPAWN variables
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+!
USE MODD_SURF_PAR, ONLY : NUNDEF
+!
#ifdef SFX_MNH
USE MODD_SPAWN, ONLY : NDXRATIO,NDYRATIO,NXSIZE,NYSIZE,NXOR,NYOR
#endif
-
+!
USE MODE_POS_SURF
USE MODE_GRIDTYPE_CONF_PROJ
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -60,6 +61,7 @@ IMPLICIT NONE
! -------------------------
!
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+!
INTEGER, INTENT(IN) :: KLUOUT ! output listing logical unit
INTEGER, INTENT(IN) :: KLUNAM ! namelist file logical unit
INTEGER, INTENT(IN) :: KL ! number of points
@@ -127,6 +129,7 @@ NAMELIST/NAM_INIFILE_CONF_PROJ/IXOR,IYOR,IXSIZE,IYSIZE,IDXRATIO,IDYRATIO
IF (LHOOK) CALL DR_HOOK('GRID_MODIF_CONF_PROJ',0,ZHOOK_HANDLE)
CALL POSNAM(KLUNAM,'NAM_INIFILE_CONF_PROJ',GFOUND,KLUOUT)
IF (GFOUND) READ(UNIT=KLUNAM,NML=NAM_INIFILE_CONF_PROJ)
+!
#ifdef SFX_MNH
! store the parameter in MODD_SPAWN
NXOR = IXOR
@@ -172,15 +175,7 @@ IJMAX2=IYSIZE*IDYRATIO
!
KL2 = IIMAX2 * IJMAX2
!
-#ifdef MNH_PARALLEL
-#else
-ALLOCATE(ZX2 (IIMAX2*IJMAX2))
-ALLOCATE(ZY2 (IIMAX2*IJMAX2))
-ALLOCATE(ZDX2(IIMAX2*IJMAX2))
-ALLOCATE(ZDY2(IIMAX2*IJMAX2))
-#endif
-!
- CALL REGULAR_GRID_SPAWN(U,KLUOUT, &
+ CALL REGULAR_GRID_SPAWN(U,KLUOUT, &
KL, IIMAX1,IJMAX1,ZX1,ZY1,ZDX1,ZDY1, &
IXOR, IYOR, IDXRATIO, IDYRATIO, &
IXSIZE, IYSIZE, &
diff --git a/src/SURFEX/hor_extrapol_surf.F90 b/src/SURFEX/hor_extrapol_surf.F90
index facae43659ecac07ce01b5b5c0a72a96cc647e81..238a4a9b49e2650012db6827413974b92998283b 100644
--- a/src/SURFEX/hor_extrapol_surf.F90
+++ b/src/SURFEX/hor_extrapol_surf.F90
@@ -3,8 +3,9 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE HOR_EXTRAPOL_SURF(KLUOUT,HCOORTYPE,PLAT_IN,PLON_IN,PFIELD_IN, &
- PLAT,PLON,PFIELD,OINTERP)
+ SUBROUTINE HOR_EXTRAPOL_SURF(KLUOUT,HCOORTYPE,KILEN,PILA1,PILA2,PILO1,PILO2,&
+ KINLA,KINLO,KP,PFIELD_IN,PLAT,PLON,PFIELD,OINTERP,&
+ PILATARRAY)
! ###################################################################
!
!!**** *HOR_EXTRAPOL_SURF* extrapolate a surface field
@@ -41,117 +42,389 @@
!* 0. DECLARATION
! -----------
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC, NPIO, NCOMM, IDX_I
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_CSTS, ONLY : XPI
+USE MODN_PREP_SURF_ATM, ONLY : NHALO_PREP
+!
+USE MODI_ABOR1_SFX
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1 Declaration of arguments
! ------------------------
!
INTEGER, INTENT(IN) :: KLUOUT ! output listing logical unit
CHARACTER(LEN=4), INTENT(IN) :: HCOORTYPE! type of coordinate
-REAL, DIMENSION(:), INTENT(IN) :: PLAT_IN ! input lat. of each grid mesh.
-REAL, DIMENSION(:), INTENT(IN) :: PLON_IN ! input lon. of each grid mesh.
-REAL, DIMENSION(:), INTENT(IN) :: PFIELD_IN! input field on grid mesh
+ INTEGER, INTENT(IN) :: KILEN
+REAL, INTENT(IN) :: PILA1
+REAL, INTENT(IN) :: PILA2
+REAL, INTENT(IN) :: PILO1
+REAL, INTENT(IN) :: PILO2
+INTEGER, INTENT(IN) :: KINLA
+INTEGER, DIMENSION(:), INTENT(IN) :: KINLO
+INTEGER, DIMENSION(:,:), INTENT(IN) :: KP
+REAL, DIMENSION(:,:), INTENT(IN) :: PFIELD_IN! input field on grid mesh
REAL, DIMENSION(:), INTENT(IN) :: PLAT ! latitude of each grid mesh.
REAL, DIMENSION(:), INTENT(IN) :: PLON ! longitude of each grid mesh.
-REAL, DIMENSION(:), INTENT(INOUT) :: PFIELD ! field on grid mesh
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PFIELD ! field on grid mesh
LOGICAL,DIMENSION(:), INTENT(IN) :: OINTERP ! .true. where physical value is needed
+REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: PILATARRAY
!
!* 0.2 Declaration of local variables
! ------------------------------
!
-INTEGER :: INO ! output array size
-INTEGER :: INO_IN ! input array size
-!
-REAL :: ZLAT ! latitude of point to define
-REAL :: ZLON ! longitude of point to define
-REAL :: ZDIST ! current distance to valid point (in lat/lon grid)
-REAL :: ZFIELD! current found field value
-REAL :: ZNDIST! smallest distance to valid point
-REAL :: ZCOSLA! cosine of latitude
+REAL, DIMENSION(:), ALLOCATABLE :: ZTLONMIN, ZTLONMAX, ZTLATMIN, ZTLATMAX
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFIELD
+REAL :: ZLAT ! latitude of point to define
+REAL :: ZLON ! longitude of point to define
+REAL :: ZDIST ! current distance to valid point (in lat/lon grid)
+REAL, DIMENSION(:), ALLOCATABLE :: ZNDIST! smallest distance to valid point
+REAL :: ZCOSLA! cosine of latitude
+REAL :: ZLONSC! longitude of valid point
+REAL :: ZIDLO, ZIDLOMAX, ZIDLOMIN, ZIDLAMAX, ZIDLAMIN
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOOR
+REAL, DIMENSION(:), ALLOCATABLE :: ZIDLA
+REAL, DIMENSION(:), ALLOCATABLE :: ZLA ! input "latitude" coordinate
+REAL, DIMENSION(:), ALLOCATABLE :: ZLO ! input "longitude" coordinate
+REAL(KIND=JPRB) :: ZRAD ! conversion degrees to radians
!
-INTEGER :: JI ! loop index on points
+INTEGER, DIMENSION(:), ALLOCATABLE :: IMASK, IMASKR
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: IVAL_EXT
+INTEGER, DIMENSION(NPROC) :: INO_TAB
+INTEGER :: INO ! output array size
+INTEGER, DIMENSION(2) :: ITSIZE, ITDIM
+INTEGER, DIMENSION(2,0:NPROC-1) :: IBOR
+INTEGER :: ISIZE, ISIZE_MAX, J, ID0, ICOMPT, ICPT
+INTEGER :: INFOMPI, IDX, INL
+INTEGER :: JI, JL, JLAT, JLON, JIPOS, JP ! loop index on points
INTEGER :: JISC ! loop index on valid points
-REAL :: ZLONSC! longitude of valid point
+#ifdef SFX_MPI
+INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+#endif
LOGICAL :: GLALO ! flag true is second coordinate is a longitude or pseudo-lon.
! false if metric coordinates
-!
-REAL(KIND=JPRB) :: ZRAD ! conversion degrees to radians
-!
REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!-------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('HOR_EXTRAPOL_SURF',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('HOR_EXTRAPOL_SURF_1',0,ZHOOK_HANDLE)
!
INO = SIZE(PFIELD,1)
+INL = SIZE(PFIELD,2)
!
-WHERE (.NOT. OINTERP(:)) PFIELD(:) = XUNDEF
+ALLOCATE(ZNDIST(INL))
!
!-------------------------------------------------------------------------------
!
-INO_IN = SIZE(PFIELD_IN)
-!
GLALO = HCOORTYPE=='LALO'
!
!-------------------------------------------------------------------------------
!
-!* 3. No data point
-! -------------
+ALLOCATE(ZIDLA(KINLA))
!
-IF (COUNT(PFIELD_IN(:)/=XUNDEF)==0 .AND. LHOOK) CALL DR_HOOK('HOR_EXTRAPOL_SURF',1,ZHOOK_HANDLE)
-IF (COUNT(PFIELD_IN(:)/=XUNDEF)==0) RETURN
+ALLOCATE(ZLA(KILEN))
+ALLOCATE(ZLO(KILEN))
+!
+ZIDLOMAX = 0.
+ZIDLOMIN = XUNDEF
+JIPOS = 0
+IF (PRESENT(PILATARRAY)) THEN
+ ZIDLA(1) = 0.
+ DO JLAT=2,KINLA
+ ZIDLA(JLAT) = PILATARRAY(JLAT) - PILATARRAY(JLAT-1)
+ ENDDO
+ELSE
+ ZIDLA(:) = (PILA2 - PILA1) / (KINLA - 1)
+ENDIF
+!
+ZIDLAMAX = MAXVAL(ABS(ZIDLA))
+ZIDLAMIN = MINVAL(ABS(ZIDLA(2:KINLA)))
+!
+DO JLAT=1,KINLA
+ IF (GLALO) THEN
+ ZIDLO = (PILO2-PILO1) / KINLO(JLAT)
+ ELSE
+ ZIDLO = (PILO2-PILO1) / (KINLO(JLAT)-1)
+ ENDIF
+ DO JLON=1,KINLO(JLAT)
+ JIPOS = JIPOS + 1
+ ZLA(JIPOS) = PILA1 + SUM(ZIDLA(2:JLAT))
+ ZLO(JIPOS) = PILO1 + (JLON-1) * ZIDLO
+ END DO
+ ZIDLO = ABS(ZIDLO)
+ IF (ZIDLO>ZIDLOMAX) ZIDLOMAX = ZIDLO
+ IF (ZIDLO<ZIDLOMIN) ZIDLOMIN = ZIDLO
+END DO
!
!-------------------------------------------------------------------------------
!
!* 4. Loop on points to define
! ------------------------
!
+ALLOCATE(ZTLONMIN(INO),ZTLONMAX(INO),ZTLATMIN(INO),ZTLATMAX(INO))
+ZTLONMIN(:) = 0.
+ZTLONMAX(:) = 0.
+ZTLATMIN(:) = 0.
+ZTLATMAX(:) = 0.
+!
ZRAD=XPI/180.0_JPRB
!
-!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(JI,JISC,ZLAT,ZLON,ZFIELD,ZCOSLA,ZLONSC,ZDIST,ZNDIST,ZHOOK_HANDLE_OMP)
+!1: ZTLONMIN, ZTLONMAX, ZTLATMIN, ZTLATMAX contain for each point to extrapol
+! the limits of the domain where to search for the valid points, according
+! to NHALO_PREP
+ICPT = 0
+ISIZE_MAX = 0
+ISIZE = 0
DO JI=1,INO
- IF (PFIELD(JI)/=XUNDEF) CYCLE
+ !
+ IF (ALL(PFIELD(JI,:)/=XUNDEF)) CYCLE
IF (.NOT. OINTERP(JI)) CYCLE
+ ICPT = ICPT + 1
+ !
+ IF (NHALO_PREP>0) THEN
+ ZTLONMIN(JI) = MINVAL(ZLO(KP(JI,:)))-ZIDLOMAX*NHALO_PREP
+ ZTLONMAX(JI) = MAXVAL(ZLO(KP(JI,:)))+ZIDLOMAX*NHALO_PREP
+ ZTLATMIN(JI) = MINVAL(ZLA(KP(JI,:)))-ZIDLAMAX*NHALO_PREP
+ ZTLATMAX(JI) = MAXVAL(ZLA(KP(JI,:)))+ZIDLAMAX*NHALO_PREP
+ ELSE
+ ZTLONMIN(JI) = MINVAL(ZLO(:))
+ ZTLONMAX(JI) = MAXVAL(ZLO(:))
+ ZTLATMIN(JI) = MINVAL(ZLA(:))
+ ZTLATMAX(JI) = MAXVAL(ZLA(:))
+ ENDIF
+ ISIZE = CEILING((ZTLONMAX(JI)-ZTLONMIN(JI)+1)/ZIDLOMIN)*&
+ CEILING((ZTLATMAX(JI)-ZTLATMIN(JI)+1)/ZIDLAMIN)
+ IF (ISIZE>ISIZE_MAX) ISIZE_MAX = ISIZE
+ !
+ENDDO
!
-!* 4.1 initialisation
-! --------------
+!number of points to extrapol and maximum number of points to sound
+ITSIZE(1) = ICPT
+ITSIZE(2) = ISIZE_MAX
!
- IF (LHOOK) CALL DR_HOOK('HOR_EXTRAPOL_SURF OMP',0,ZHOOK_HANDLE_OMP)
- ZNDIST=1.E20
- ZLAT=PLAT(JI)
- ZLON=PLON(JI)
- ZFIELD=PFIELD(JI)
- ZCOSLA=COS(ZLAT*ZRAD)
+!NPIO knows the numbers of points to extrapolate for all tasks
+IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_GATHER(ITSIZE,2*KIND(ITSIZE)/4,MPI_INTEGER,&
+ IBOR,2*KIND(IBOR)/4,MPI_INTEGER,&
+ NPIO,NCOMM,INFOMPI)
+#endif
+ELSE
+ IBOR(:,0) = ITSIZE(:)
+ENDIF
!
-!* 4.2 extrapolation with nearest valid point
-! --------------------------------------
+!imask associated the number of the point to extrapolate to its real index in
+!the field
+ALLOCATE(IMASK(ITSIZE(1)))
+IMASK(:) = 0
!
- DO JISC=1,INO_IN
- IF (PFIELD_IN(JISC)/=XUNDEF) THEN
- ZLONSC = PLON_IN(JISC)
+IF (NRANK==NPIO) THEN
+ ALLOCATE(IVAL_EXT(MAXVAL(IBOR(1,:)),MAXVAL(IBOR(2,:))))
+ ALLOCATE(ZCOOR (MAXVAL(IBOR(1,:)),2))
+ELSE
+ ALLOCATE(IVAL_EXT(ITSIZE(1),ITSIZE(2)))
+ ALLOCATE(ZCOOR(ITSIZE(1),2))
+ENDIF
+IVAL_EXT(:,:) = 0
+ZCOOR (:,:) = 0.
+!
+!
+ICPT = 0
+!2: loop on the points
+DO JI=1,INO
+ !
+ IF (ALL(PFIELD(JI,:)/=XUNDEF)) CYCLE
+ IF (.NOT. OINTERP(JI)) CYCLE
+ !
+ ICPT = ICPT + 1
+ !imask associated the number of the point to extrapolate to its real index in
+ !the field
+ IMASK(ICPT) = JI
+ !
+ ICOMPT = 0
+ JISC = 0
+ !
+ !coordinates of the point in the grid
+ ZCOOR(ICPT,1) = PLAT(JI)
+ ZCOOR(ICPT,2) = PLON(JI)
+ !
+ !loop on the grid
+ DO JLAT = 1,KINLA
+ ZLAT = PILA1 + SUM(ZIDLA(2:JLAT))
+ IF (ZLAT>=ZTLATMIN(JI) .AND. ZLAT<=ZTLATMAX(JI)) THEN
IF (GLALO) THEN
- IF (ZLONSC-ZLON> 180.) ZLONSC = ZLONSC - 360.
- IF (ZLONSC-ZLON<-180.) ZLONSC = ZLONSC + 360.
- ZDIST= (PLAT_IN(JISC)-ZLAT) ** 2 + ((ZLONSC-ZLON)*ZCOSLA) ** 2
+ ZIDLO = (PILO2-PILO1) / KINLO(JLAT)
ELSE
- ZDIST= (PLAT_IN(JISC)-ZLAT) ** 2 + (ZLONSC-ZLON) ** 2
- END IF
- IF (ZDIST<=ZNDIST) THEN
- ZFIELD=PFIELD_IN(JISC)
- ZNDIST=ZDIST
- END IF
- END IF
- END DO
- PFIELD(JI) = ZFIELD
+ ZIDLO = (PILO2-PILO1) / (KINLO(JLAT)-1)
+ ENDIF
+ IF (JLAT>1) JISC = SUM(KINLO(1:JLAT-1))
+ DO JLON = 1,KINLO(JLAT)
+ ZLON = PILO1 + (JLON-1) * ZIDLO
+ IF (ZLON>=ZTLONMIN(JI) .AND. ZLON<=ZTLONMAX(JI)) THEN
+ ICOMPT = ICOMPT + 1
+ !ival_ext contains the indexes of the points needed to interpolate
+ !in the complete grid
+ IVAL_EXT(ICPT,ICOMPT) = JISC + JLON
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+ !
+ENDDO
+!
+DEALLOCATE(ZIDLA)
+!
+!
+IF (LHOOK) CALL DR_HOOK('HOR_EXTRAPOL_SURF_1',1,ZHOOK_HANDLE)
+!
+IF (NRANK/=NPIO) THEN
- IF (LHOOK) CALL DR_HOOK('HOR_EXTRAPOL_SURF OMP',1,ZHOOK_HANDLE_OMP)
-END DO
+ IF (LHOOK) CALL DR_HOOK('HOR_EXTRAPOL_SURF_2',0,ZHOOK_HANDLE)
+
+ !if some points of this task need to be extrapolated
+ IF (SUM(ITSIZE)/=0) THEN
+
+ !zfield will contain the values of the field
+ ALLOCATE(ZFIELD(ITSIZE(1),INL))
+
+ IDX_I = IDX_I + 1
+ !sends indexes to npio
+#ifdef SFX_MPI
+ CALL MPI_SEND(IVAL_EXT,SIZE(IVAL_EXT)*KIND(IVAL_EXT)/4,MPI_INTEGER,NPIO,IDX_I,NCOMM,INFOMPI)
+#endif
+
+ IDX_I = IDX_I + 1
+ !send coords of the points to extrapolate
+#ifdef SFX_MPI
+ CALL MPI_SEND(ZCOOR,SIZE(ZCOOR)*KIND(ZCOOR)/4,MPI_REAL,NPIO,IDX_I,NCOMM,INFOMPI)
+#endif
+
+ IDX_I = IDX_I + 1
+ !receives values of the field from NPIO
+#ifdef SFX_MPI
+ CALL MPI_RECV(ZFIELD,SIZE(ZFIELD)*KIND(ZFIELD)/4,MPI_REAL,NPIO,IDX_I,NCOMM,ISTATUS,INFOMPI)
+#endif
+
+ DO JI=1,ITSIZE(1)
+ PFIELD(IMASK(JI),:) = ZFIELD(JI,:)
+ ENDDO
+ DEALLOCATE(ZFIELD)
+
+ ELSE
+ IDX_I = IDX_I + 3
+ ENDIF
+
+ IF (LHOOK) CALL DR_HOOK('HOR_EXTRAPOL_SURF_2',1,ZHOOK_HANDLE)
+
+ELSE
+
+IF (LHOOK) CALL DR_HOOK('HOR_EXTRAPOL_SURF_31',0,ZHOOK_HANDLE_OMP)
+ DO JP = NPIO,NPROC-1+NPIO
+
+ J = JP
+ IF (JP>NPROC-1) J = JP-NPROC
+
+ IF (SUM(IBOR(:,J))/=0) THEN
+
+ ALLOCATE(ZFIELD(IBOR(1,J),INL))
+ ZFIELD=XUNDEF
+
+ IF (J/=NPIO) THEN
+
+ !receives indexes and coordinaites
+#ifdef SFX_MPI
+ CALL MPI_RECV(IVAL_EXT(1:IBOR(1,J),1:IBOR(2,J)), IBOR(1,J)*IBOR(2,J)*KIND(IVAL_EXT)/4, &
+ MPI_INTEGER, J, IDX_I+1, NCOMM, ISTATUS, INFOMPI)
+ CALL MPI_RECV(ZCOOR(1:IBOR(1,J),:), IBOR(1,J)*SIZE(ZCOOR,2)*KIND(ZCOOR)/4,&
+ MPI_REAL, J, IDX_I+2, NCOMM, ISTATUS, INFOMPI)
+#endif
+
+ ENDIF
+
+!$OMP PARALLEL DO PRIVATE(JI,ZNDIST,IDX,ZCOSLA,JISC,ID0,ZLONSC,ZDIST)
+ DO JI=1,IBOR(1,J)
+ ZNDIST(:) = XUNDEF
+ IDX = IBOR(2,J)+1
+ ZCOSLA=COS(ZCOOR(JI,1)*ZRAD)
+ DO JISC = 1,IBOR(2,J)
+ !index in the whole grid of the point used to interpolate
+ ID0 = IVAL_EXT(JI,JISC)
+ IF (ID0==0) EXIT
+ IF (ANY(PFIELD_IN(ID0,:)/=XUNDEF)) THEN
+ ZLONSC = ZLO(ID0)
+ IF (GLALO) THEN
+ IF (ZLONSC-ZCOOR(JI,2)> 180.) ZLONSC = ZLONSC - 360.
+ IF (ZLONSC-ZCOOR(JI,2)<-180.) ZLONSC = ZLONSC + 360.
+ ZDIST= (ZLA(ID0)-ZCOOR(JI,1)) ** 2 + ((ZLONSC-ZCOOR(JI,2))*ZCOSLA) ** 2
+ ELSE
+ ZDIST= (ZLA(ID0)-ZCOOR(JI,1)) ** 2 + (ZLONSC-ZCOOR(JI,2)) ** 2
+ END IF
+ DO JL=1,INL
+ IF (ZDIST<=ZNDIST(JL)) THEN
+ IF (PFIELD_IN(ID0,JL)/=XUNDEF) THEN
+ ZFIELD(JI,JL) = PFIELD_IN(ID0,JL)
+ ZNDIST(JL) = ZDIST
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+ END DO
+ ENDDO
!$OMP END PARALLEL DO
+ !
+ IF (J/=NPIO) THEN
+ !send values found to extrapolate
+#ifdef SFX_MPI
+ CALL MPI_SEND(ZFIELD,SIZE(ZFIELD)*KIND(ZFIELD)/4,MPI_REAL,J,IDX_I+3,NCOMM,INFOMPI)
+#endif
+ ELSE
+ DO JI = 1,IBOR(1,J)
+ PFIELD(IMASK(JI),:) = ZFIELD(JI,:)
+ ENDDO
+ ENDIF
+ !
+ DEALLOCATE(ZFIELD)
+ !
+ ENDIF
+ !
+ ENDDO
+IF (LHOOK) CALL DR_HOOK('HOR_EXTRAPOL_SURF_31',1,ZHOOK_HANDLE_OMP)
+!
+DEALLOCATE(ZNDIST)
+ !
+IF (LHOOK) CALL DR_HOOK('HOR_EXTRAPOL_SURF_32',0,ZHOOK_HANDLE)
+ !
+ IDX_I = IDX_I + 3
+ !
+IF (LHOOK) CALL DR_HOOK('HOR_EXTRAPOL_SURF_32',1,ZHOOK_HANDLE)
+ !
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('HOR_EXTRAPOL_SURF_4',0,ZHOOK_HANDLE)
+!
+DEALLOCATE(ZCOOR)
+DEALLOCATE(IVAL_EXT)
+DEALLOCATE(IMASK)
+!
+IF (ALLOCATED(ZLA)) DEALLOCATE(ZLA)
+IF (ALLOCATED(ZLO)) DEALLOCATE(ZLO)
+DEALLOCATE(ZTLONMIN,ZTLONMAX,ZTLATMIN,ZTLATMAX)
+!
+DO JL=1,INL
+ IF (ANY(PFIELD(:,JL)==XUNDEF .AND. OINTERP(:))) THEN
+ WRITE(*,*) 'LAYER ',JL,': NO EXTRAPOLATION : INCREASE YOUR HALO_PREP IN NAM_PREP_SURF_ATM'
+ CALL ABOR1_SFX('NO EXTRAPOLATION : INCREASE YOUR HALO_PREP IN NAM_PREP_SURF_ATM')
+ ENDIF
+ WHERE (.NOT. OINTERP(:)) PFIELD(:,JL) = XUNDEF
+ENDDO
+!
!-------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('HOR_EXTRAPOL_SURF',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('HOR_EXTRAPOL_SURF_4',1,ZHOOK_HANDLE)
!
END SUBROUTINE HOR_EXTRAPOL_SURF
diff --git a/src/SURFEX/hor_extrapol_surf_cheap.F90 b/src/SURFEX/hor_extrapol_surf_cheap.F90
deleted file mode 100644
index 2739831d9e0438158a66af5e6ea231625f629934..0000000000000000000000000000000000000000
--- a/src/SURFEX/hor_extrapol_surf_cheap.F90
+++ /dev/null
@@ -1,192 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE HOR_EXTRAPOL_SURF_CHEAP(KLUOUT,HCOORTYPE,PLAT_IN,PLON_IN,PFIELD_IN, &
- PLAT,PLON,PFIELD,OINTERP)
-! ###################################################################
-!
-!!**** *HOR_EXTRAPOL_SURF_CHEAP* extrapolate a surface field
-!!
-!! PURPOSE
-!! -------
-!!
-!! METHOD
-!! ------
-!! For each point to interpolate, the nearest valid point value is set.
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! V. Masson Meteo-France
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 01/12/98
-!! V. Masson 01/2004 extrapolation in latitude and longitude
-!! M. Jidane 11/2013 add OpenMP directives
-!! L. Raynaudl 06/2014 cheap version : nearest point looked for in a
-!! neighbourhood
-!
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_CSTS, ONLY : XPI, XRADIUS
-USE MODN_PREP_SURF_ATM, ONLY : NHALO_PREP
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODI_ABOR1_SFX
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-!
-INTEGER, INTENT(IN) :: KLUOUT ! output listing logical unit
- CHARACTER(LEN=4), INTENT(IN) :: HCOORTYPE
-REAL, DIMENSION(:), INTENT(IN) :: PLAT_IN ! input lat. of each grid mesh.
-REAL, DIMENSION(:), INTENT(IN) :: PLON_IN ! input lon. of each grid mesh.
-REAL, DIMENSION(:,:), INTENT(IN) :: PFIELD_IN! input field on grid mesh
-REAL, DIMENSION(:), INTENT(IN) :: PLAT ! latitude of each grid mesh.
-REAL, DIMENSION(:), INTENT(IN) :: PLON ! longitude of each grid mesh.
-REAL, DIMENSION(:), INTENT(INOUT) :: PFIELD ! field on grid mesh
-LOGICAL,DIMENSION(:), INTENT(IN) :: OINTERP ! .true. where physical value is needed
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-INTEGER :: INO ! output array size
-!
-REAL :: ZLAT ! latitude of point to define
-REAL :: ZLON ! longitude of point to define
-REAL :: ZDIST ! current distance to valid point (in lat/lon grid)
-REAL :: ZFIELD! current found field value
-REAL :: ZNDIST! smallest distance to valid point
-REAL :: ZCOSLA! cosine of latitude
-!
-INTEGER :: JI,JII,JJ,ICI,ICJ,ICI_MIN,ICI_MAX,ICJ_MIN,ICJ_MAX,ICOMPT ! loop index on points
-REAL :: ZLONSC! longitude of valid point
-LOGICAL :: GLALO ! flag true is second coordinate is a longitude or pseudo-lon.
- ! false if metric coordinates
-!
-REAL(KIND=JPRB) :: ZRAD ! conversion degrees to radians
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
-!-------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('HOR_EXTRAPOL_SURF_CHEAP',0,ZHOOK_HANDLE)
-!
-INO = SIZE(PFIELD,1)
-!
-WHERE (.NOT. OINTERP(:)) PFIELD(:) = XUNDEF
-!
-!-------------------------------------------------------------------------------
-!
-GLALO = HCOORTYPE=='LALO'
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. No data point
-! -------------
-!
-IF (COUNT(PFIELD_IN(:,:)/=XUNDEF)==0 .AND. LHOOK) CALL DR_HOOK('HOR_EXTRAPOL_SURF_CHEAP',1,ZHOOK_HANDLE)
-IF (COUNT(PFIELD_IN(:,:)/=XUNDEF)==0) RETURN
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. Loop on points to define
-! ------------------------
-!
-ZRAD=XPI/180.0_JPRB
-!
-!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(JI,JII,JJ,ZLAT,ZLON,ZFIELD,ZCOSLA,ZLONSC,ZDIST,ZNDIST,ZHOOK_HANDLE_OMP)
-DO JI=1,INO
-
- IF (PFIELD(JI)/=XUNDEF) CYCLE
- IF (.NOT. OINTERP(JI)) CYCLE
-!
-!* 4.1 initialisation
-! --------------
-!
- IF (LHOOK) CALL DR_HOOK('HOR_EXTRAPOL_SURF_CHEAP OMP',0,ZHOOK_HANDLE_OMP)
- ZNDIST=1.E20
- ZLAT=PLAT(JI)
- ZLON=PLON(JI)
- ZFIELD=PFIELD(JI)
- ZCOSLA=COS(ZLAT*ZRAD)
-
- ! Locate surrounding input points around the interpolated output point
- ! Size of the neighbourhood is given by NHALO_PREP
- ICI = 1
- DO JJ=SIZE(PLON_IN),1,-1
- IF (PLON_IN(JJ)<=ZLON) THEN
- ICI = JJ
- EXIT
- ENDIF
- ENDDO
- ICJ = 1
- DO JJ=SIZE(PLAT_IN),1,-1
- IF (PLAT_IN(JJ)<=ZLAT) THEN
- ICJ = JJ
- EXIT
- ENDIF
- ENDDO
-
- ICI_MIN=MAX(ICI-NHALO_PREP,1)
- ICI_MAX=MIN(ICI+NHALO_PREP,SIZE(PLON_IN))
- ICJ_MIN=MAX(ICJ-NHALO_PREP,1)
- ICJ_MAX=MIN(ICJ+NHALO_PREP,SIZE(PLAT_IN))
-!
-!* 4.2 extrapolation with nearest valid point
-! --------------------------------------
-
- ! The nearest point is looked for in a neighbourhood
- ! This helps reducing the cost
- ICOMPT=0
- DO JJ=ICJ_MIN,ICJ_MAX
- DO JII=ICI_MIN,ICI_MAX
- IF (PFIELD_IN(JII,JJ)/=XUNDEF) THEN
- ICOMPT=ICOMPT+1
- ZLONSC = PLON_IN(JII)
- IF (GLALO) THEN
- IF (ZLONSC-ZLON> 180.) ZLONSC = ZLONSC - 360.
- IF (ZLONSC-ZLON<-180.) ZLONSC = ZLONSC + 360.
- ZDIST= (PLAT_IN(JJ)-ZLAT) ** 2 + ((ZLONSC-ZLON)*ZCOSLA) ** 2
- ELSE
- ZDIST= (PLAT_IN(JJ)-ZLAT) ** 2 + (ZLONSC-ZLON) ** 2
- END IF
- IF (ZDIST<=ZNDIST) THEN
- ZFIELD=PFIELD_IN(JII,JJ)
- ZNDIST=ZDIST
- END IF
- END IF
- ENDDO
- ENDDO
- PFIELD(JI) = ZFIELD
- IF (ICOMPT==0) THEN
- WRITE(*,*) 'NO EXTRAPOLATION : INCREASE YOUR HALO_PREP IN NAM_PREP_SURF_ATM'
- CALL ABOR1_SFX("HOR_EXTRAPOL_SURF_CHEAP: INCREASE YOUR HALO_PREP IN NAM_PREP_SURF_ATM")
- ENDIF
-
- IF (LHOOK) CALL DR_HOOK('HOR_EXTRAPOL_SURF_CHEAP OMP',1,ZHOOK_HANDLE_OMP)
-END DO
-!$OMP END PARALLEL DO
-!-------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('HOR_EXTRAPOL_SURF_CHEAP',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE HOR_EXTRAPOL_SURF_CHEAP
diff --git a/src/SURFEX/hor_interpol.F90 b/src/SURFEX/hor_interpol.F90
index 90b2a5ac4f06f44c4fe102d35814447c79d273c9..75f65f2d986d8a71f2010efa2a7b54224aa7e050 100644
--- a/src/SURFEX/hor_interpol.F90
+++ b/src/SURFEX/hor_interpol.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE HOR_INTERPOL (DTCO, U, GCP,&
- KLUOUT,PFIELDIN,PFIELDOUT)
+SUBROUTINE HOR_INTERPOL (DTCO, U, GCP, KLUOUT,PFIELDIN,PFIELDOUT)
! #################################################################################
!
!!**** *HOR_INTERPOL * - Call the interpolation of a surface field
@@ -29,12 +28,9 @@ SUBROUTINE HOR_INTERPOL (DTCO, U, GCP,&
!! P. Le Moigne 10/2005, Phasage Arome
!!------------------------------------------------------------------
!
-!
-!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
!
@@ -129,8 +125,7 @@ SELECT CASE (CINTERP_TYPE)
! ------------------------------
!
CASE('BUFFER')
- CALL HOR_INTERPOL_BUFFER(DTCO, U, &
- KLUOUT,PFIELDIN,PFIELDOUT)
+ CALL HOR_INTERPOL_BUFFER(DTCO, U, KLUOUT,PFIELDIN,PFIELDOUT)
!
!* 4. no interpolation
diff --git a/src/SURFEX/hor_interpol_1cov.F90 b/src/SURFEX/hor_interpol_1cov.F90
deleted file mode 100644
index 94d5a872db7eede818ade5202b67d27d8c9f6d50..0000000000000000000000000000000000000000
--- a/src/SURFEX/hor_interpol_1cov.F90
+++ /dev/null
@@ -1,148 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE HOR_INTERPOL_1COV(DTCO, U,GCP, &
- KLUOUT,PFIELDIN,PFIELDOUT)
-! #################################################################################
-!
-!!**** *HOR_INTERPOL * - Call the interpolation of a surface field
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! M.Moge (adapted from HOR_INTERPOL)
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 06/2015
-!! J.Escobar 18/12/2015 : missing interface
-!!------------------------------------------------------------------
-!
-!
-!
-!
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
-!
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
-!
-USE MODI_HOR_INTERPOL_GAUSS_1COV
-USE MODI_HOR_INTERPOL_ROTLATLON_1COV
-USE MODI_HOR_INTERPOL_AROME_1COV
-USE MODI_HOR_INTERPOL_CONF_PROJ_1COV
-USE MODI_HOR_INTERPOL_CARTESIAN_1COV
-USE MODI_HOR_INTERPOL_LATLON_1COV
-USE MODI_HOR_INTERPOL_BUFFER_1COV
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODI_ABOR1_SFX
-!
-USE MODI_HOR_INTERPOL_BUFFER
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
-!
-INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
-REAL, DIMENSION(:), INTENT(IN) :: PFIELDIN ! field to interpolate horizontally
-REAL, DIMENSION(:), INTENT(OUT) :: PFIELDOUT ! interpolated field
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: JL ! loop counter
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_1COV',0,ZHOOK_HANDLE)
-SELECT CASE (CINTERP_TYPE)
-!
-!* 1. Interpolation with horibl (from gaussian, Legendre or regular grid)
-! -------------------------------------------------------------------
-!
- CASE('HORIBL')
- SELECT CASE(CINGRID_TYPE)
-!
-!* 1.1 Interpolation from gaussian or Legendre
-!
- CASE ('GAUSS ')
- CALL HOR_INTERPOL_GAUSS_1COV(KLUOUT,PFIELDIN,PFIELDOUT)
-!
-!* 1.2 Interpolation from regular grid
-!
- CASE ('AROME ')
- CALL HOR_INTERPOL_AROME_1COV(KLUOUT,PFIELDIN,PFIELDOUT)
-!
-!* 1.3 Interpolation from regular lat/lon coord
-!
- CASE ('LATLON ')
- CALL HOR_INTERPOL_LATLON_1COV(KLUOUT,PFIELDIN,PFIELDOUT)
-!
-!* 1.4 Interpolation from rotated lat/lon coord
-!
- CASE ('ROTLATLON ')
- CALL HOR_INTERPOL_ROTLATLON_1COV(KLUOUT,PFIELDIN,PFIELDOUT)
-!
- CASE DEFAULT
- CALL ABOR1_SFX('HOR_INTERPOL_1COV: WRONG GRID TYPE'//CINGRID_TYPE)
-
- END SELECT
-!
-!* 2. Prescribed uniform field
-! ------------------------
-!
- CASE('UNIF ')
- PFIELDOUT(:) = PFIELDIN(1)
-!
-!* 3. Bilinear interpolation
-! ----------------------
-!
- CASE('BILIN ')
- SELECT CASE(CINGRID_TYPE)
- CASE ('CONF PROJ ')
- CALL HOR_INTERPOL_CONF_PROJ_1COV(GCP,KLUOUT,PFIELDIN,PFIELDOUT)
- CASE ('CARTESIAN ')
- CALL HOR_INTERPOL_CARTESIAN_1COV(KLUOUT,PFIELDIN,PFIELDOUT)
- END SELECT
-!
-!* 4. no interpolation, only packing
-! ------------------------------
-!
- CASE('BUFFER')
- CALL HOR_INTERPOL_BUFFER_1COV(DTCO, U, &
- KLUOUT,PFIELDIN,PFIELDOUT)
-
-!
-!* 4. no interpolation
-! ----------------
-!
- CASE('NONE ')
- PFIELDOUT(:) = PFIELDIN(:)
-
- CASE DEFAULT
- CALL ABOR1_SFX('HOR_INTERPOL_1COV: WRONG INTERPOLATION TYPE'//CINTERP_TYPE)
-
-END SELECT
-IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_1COV',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-END SUBROUTINE HOR_INTERPOL_1COV
diff --git a/src/SURFEX/hor_interpol_arome.F90 b/src/SURFEX/hor_interpol_arome.F90
index ea97666b476efd970a99766eb2b093b5dcd91025..b61364661ea4cf06f2b9cd6f1a77e8d0a95d3cb4 100644
--- a/src/SURFEX/hor_interpol_arome.F90
+++ b/src/SURFEX/hor_interpol_arome.F90
@@ -29,13 +29,18 @@ SUBROUTINE HOR_INTERPOL_AROME(KLUOUT,PFIELDIN,PFIELDOUT)
!
!
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
+USE MODD_HORIBL, ONLY : LGLOBLON, LGLOBS, LGLOBN, XILO1H, XILO2H, NINLOH, &
+ XLA, XOLA, XOLO, NP, XLOPH
USE MODD_PREP, ONLY : XLAT_OUT, XLON_OUT,LINTERP
-USE MODD_GRID_AROME, ONLY : XX, XY, NX, NY, XLAT0, XLON0, XLATOR, XLONOR, XRPK, XBETA
+USE MODD_GRID_AROME, ONLY : XX, XY, NX, NY, XLAT0, XLON0, XLATOR, XLONOR, XRPK, XBETA, &
+ XZX, XZY, NIX
USE MODD_GRID_GRIB, ONLY : NNI
USE MODD_SURF_PAR, ONLY : XUNDEF
!
-USE MODE_GRIDTYPE_CONF_PROJ
-USE MODI_HORIBL_SURF
+USE MODI_HORIBL_SURF_GRIDIN
+USE MODI_HORIBL_SURF_VALUE
+USE MODI_HORIBL_SURF_EXTRAP
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -51,13 +56,16 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELDOUT ! interpolated field
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(:), ALLOCATABLE :: ZX ! X coordinate
-REAL, DIMENSION(:), ALLOCATABLE :: ZY ! Y coordinate
-INTEGER, DIMENSION(:), ALLOCATABLE :: IMASKIN ! input mask
+REAL, DIMENSION(:,:), POINTER :: ZFIELDIN0
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFIELDIN
+!
+INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: ILSMIN
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: IMASKIN ! input mask
INTEGER, DIMENSION(:), ALLOCATABLE :: IMASKOUT ! output mask
-INTEGER :: INO ! output number of points
-INTEGER :: JL ! loop counter
-INTEGER, DIMENSION(:), ALLOCATABLE :: IX ! number of points on each line
+INTEGER, DIMENSION(:), POINTER :: IMASK=>NULL()
+INTEGER, DIMENSION(SIZE(NP,1),SIZE(NP,2)) :: IP
+INTEGER :: INO, INL ! output number of points
+INTEGER :: JL, JI ! loop counter
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
@@ -66,42 +74,53 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_AROME',0,ZHOOK_HANDLE)
INO = SIZE(XLAT_OUT)
+INL = SIZE(PFIELDOUT,2)
!
-ALLOCATE(IMASKIN (NNI))
-!
-ALLOCATE(ZX (INO))
-ALLOCATE(ZY (INO))
ALLOCATE(IMASKOUT(INO))
IMASKOUT = 1
-ALLOCATE(IX(NY))
-IX=NX
!
-!* 2. Transformation of latitudes/longitudes into metric coordinates of input grid
+ALLOCATE(IMASKIN (NNI,INL))
+!
+IF (NRANK==NPIO) THEN
+ IMASKIN(:,:) = 1.
+ WHERE(PFIELDIN(:,:)==XUNDEF) IMASKIN(:,:) = 0.
+ENDIF
!
- CALL XY_CONF_PROJ(XLAT0,XLON0,XRPK,XBETA,XLATOR,XLONOR,ZX,ZY,XLAT_OUT,XLON_OUT)
+ALLOCATE(ZFIELDIN(INO,INL,12))
+ALLOCATE(ILSMIN(INO,INL,12))
!
+CALL HORIBL_SURF_GRIDIN(NY,NIX,NNI,PFIELDIN(:,:),INO, &
+ .FALSE.,KLUOUT,LGLOBS,LGLOBN,LGLOBLON,NP, &
+ ZFIELDIN0,ZFIELDIN,ILSMIN,IMASKIN,IMASKOUT,IMASK)
+!
+DO JL=1,SIZE(NP,2)
+ DO JI = 1,SIZE(NP,1)
+ IP(JI,JL) = IMASK(NP(JI,JL))
+ ENDDO
+ENDDO
!
!* 3. Input mask
!
-DO JL=1,SIZE(PFIELDIN,2)
- IMASKIN(:) = 1
- WHERE(PFIELDIN(:,JL)==XUNDEF) IMASKIN = 0
+DO JL=1,INL
!
+ CALL HORIBL_SURF_VALUE(NNI,INO,PFIELDOUT(:,JL),LINTERP,ZFIELDIN(:,JL,:),ILSMIN(:,JL,:),&
+ XOLO,XOLA,XLA,XLOPH,IMASKIN(:,JL),IMASKOUT)
!
-!* 4. Interpolation with horibl
+ENDDO
!
- CALL HORIBL_SURF(0.,0.,XY,XX,NY,IX,NNI,PFIELDIN(:,JL),INO,ZX,ZY,PFIELDOUT(:,JL), &
- .FALSE.,KLUOUT,LINTERP,IMASKIN,IMASKOUT)
-END DO
+ CALL HORIBL_SURF_EXTRAP(0.,XILO1H,XY,XILO2H,NY,NIX,NNI,PFIELDIN,&
+ INO,IP,XZX,XZY,PFIELDOUT,KLUOUT,LINTERP)
!
!* 5. Deallocations
!
-DEALLOCATE(ZX)
-DEALLOCATE(IX)
-DEALLOCATE(ZY)
+IMASK => NULL()
DEALLOCATE(IMASKIN )
DEALLOCATE(IMASKOUT)
+DEALLOCATE(ZFIELDIN0)
+DEALLOCATE(ZFIELDIN)
+DEALLOCATE(ILSMIN)
+!
IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_AROME',1,ZHOOK_HANDLE)
-
+!
!-------------------------------------------------------------------------------------
END SUBROUTINE HOR_INTERPOL_AROME
diff --git a/src/SURFEX/hor_interpol_arome_1cov.F90 b/src/SURFEX/hor_interpol_arome_1cov.F90
deleted file mode 100644
index 8ccd8c8387d70fb7340c992e067f9887b71a4552..0000000000000000000000000000000000000000
--- a/src/SURFEX/hor_interpol_arome_1cov.F90
+++ /dev/null
@@ -1,105 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE HOR_INTERPOL_AROME_1COV(KLUOUT,PFIELDIN,PFIELDOUT)
-! #################################################################################
-!
-!!**** *HOR_INTERPOL_AROME * - Interpolation from an AROME grid on 1 vertical level only
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! M.Moge (adapted from HOR_INTERPOL_AROME)
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 06/2015
-!!------------------------------------------------------------------
-!
-!
-!
-USE MODD_PREP, ONLY : XLAT_OUT, XLON_OUT,LINTERP
-USE MODD_GRID_AROME, ONLY : XX, XY, NX, NY, XLAT0, XLON0, XLATOR, XLONOR, XRPK, XBETA
-USE MODD_GRID_GRIB, ONLY : NNI
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE MODE_GRIDTYPE_CONF_PROJ
-USE MODI_HORIBL_SURF
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
-REAL, DIMENSION(:), INTENT(IN) :: PFIELDIN ! field to interpolate horizontally
-REAL, DIMENSION(:), INTENT(OUT) :: PFIELDOUT ! interpolated field
-!
-!* 0.2 declarations of local variables
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZX ! X coordinate
-REAL, DIMENSION(:), ALLOCATABLE :: ZY ! Y coordinate
-INTEGER, DIMENSION(:), ALLOCATABLE :: IMASKIN ! input mask
-INTEGER, DIMENSION(:), ALLOCATABLE :: IMASKOUT ! output mask
-INTEGER :: INO ! output number of points
-INTEGER :: JL ! loop counter
-INTEGER, DIMENSION(:), ALLOCATABLE :: IX ! number of points on each line
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------------
-!
-!* 1. Allocations
-!
-IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_AROME_1COV',0,ZHOOK_HANDLE)
-INO = SIZE(XLAT_OUT)
-!
-ALLOCATE(IMASKIN (NNI))
-!
-ALLOCATE(ZX (INO))
-ALLOCATE(ZY (INO))
-ALLOCATE(IMASKOUT(INO))
-IMASKOUT = 1
-ALLOCATE(IX(NY))
-IX=NX
-!
-!* 2. Transformation of latitudes/longitudes into metric coordinates of input grid
-!
- CALL XY_CONF_PROJ(XLAT0,XLON0,XRPK,XBETA,XLATOR,XLONOR,ZX,ZY,XLAT_OUT,XLON_OUT)
-!
-!
-!* 3. Input mask
-!
-IMASKIN(:) = 1
-WHERE(PFIELDIN(:)==XUNDEF) IMASKIN = 0
-!
-!
-!* 4. Interpolation with horibl
-!
-CALL HORIBL_SURF(0.,0.,XY,XX,NY,IX,NNI,PFIELDIN(:),INO,ZX,ZY,PFIELDOUT(:), &
- .FALSE.,KLUOUT,LINTERP,IMASKIN,IMASKOUT)
-!
-!* 5. Deallocations
-!
-DEALLOCATE(ZX)
-DEALLOCATE(IX)
-DEALLOCATE(ZY)
-DEALLOCATE(IMASKIN )
-DEALLOCATE(IMASKOUT)
-IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_AROME_1COV',1,ZHOOK_HANDLE)
-
-!-------------------------------------------------------------------------------------
-END SUBROUTINE HOR_INTERPOL_AROME_1COV
diff --git a/src/SURFEX/hor_interpol_buffer.F90 b/src/SURFEX/hor_interpol_buffer.F90
index 987a6232955cc6620c08249df8d44d01ee9ca9bf..ed2c261ad605fdccfe2362ae1206676782be1905 100644
--- a/src/SURFEX/hor_interpol_buffer.F90
+++ b/src/SURFEX/hor_interpol_buffer.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE HOR_INTERPOL_BUFFER (DTCO, U, &
- KLUOUT,PFIELDIN,PFIELDOUT)
+SUBROUTINE HOR_INTERPOL_BUFFER (DTCO, U, KLUOUT,PFIELDIN,PFIELDOUT)
! #################################################################################
!
!!**** *HOR_INTERPOL_BUFFER * - Only extrapolation
@@ -71,10 +70,10 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* 1. Initialisation of the output mask
!
IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_BUFFER',0,ZHOOK_HANDLE)
+!
INO = SIZE(PFIELDOUT,1)
ALLOCATE(IMASKOUT(INO))
- CALL GET_SURF_MASK_n(DTCO, U, &
- CMASK,INO,IMASKOUT,NNI,KLUOUT)
+ CALL GET_SURF_MASK_n(DTCO, U, CMASK,INO,IMASKOUT,NNI,KLUOUT)
!
!* 2. Mask the input field with the output mask
!!mask du tableau de taille FULL en fonction du type de surface
@@ -83,6 +82,7 @@ ALLOCATE(IMASKOUT(INO))
!* 6. Deallocations
!
DEALLOCATE(IMASKOUT)
+!
IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_BUFFER',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/hor_interpol_buffer_1cov.F90 b/src/SURFEX/hor_interpol_buffer_1cov.F90
deleted file mode 100644
index 6287924fcbc65023951748a98a7b6903e5725e2f..0000000000000000000000000000000000000000
--- a/src/SURFEX/hor_interpol_buffer_1cov.F90
+++ /dev/null
@@ -1,89 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE HOR_INTERPOL_BUFFER_1COV (DTCO, U, &
- KLUOUT,PFIELDIN,PFIELDOUT)
-! #################################################################################
-!
-!!**** *HOR_INTERPOL_BUFFER_1COV * - Only extrapolation on 1 vertical level only
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! M.Moge (adapted from HOR_INTERPOL_BUFFER)
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 06/2015
-!!------------------------------------------------------------------
-!
-!
-!
-!
-!
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
-USE MODD_PREP, ONLY : CMASK
-!
-USE MODD_GRID_BUFFER, ONLY : NNI
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE MODI_PACK_SAME_RANK
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODI_GET_SURF_MASK_n
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-!
-INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
-REAL, DIMENSION(:), INTENT(IN) :: PFIELDIN ! field to interpolate horizontally
-REAL, DIMENSION(:), INTENT(OUT) :: PFIELDOUT ! interpolated field
-!
-!* 0.2 declarations of local variables
-!
-INTEGER, DIMENSION(:), ALLOCATABLE :: IMASKOUT ! output mask
-INTEGER :: INO ! output number of points
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!------------------------------------------------------------------------------
-!
-!* 1. Initialisation of the output mask
-!
-IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_BUFFER_1COV',0,ZHOOK_HANDLE)
-INO = SIZE(PFIELDOUT,1)
-ALLOCATE(IMASKOUT(INO))
- CALL GET_SURF_MASK_n(DTCO, U, &
- CMASK,INO,IMASKOUT,NNI,KLUOUT)
-!
-!* 2. Mask the input field with the output mask
-!!mask du tableau de taille FULL en fonction du type de surface
- CALL PACK_SAME_RANK(IMASKOUT,PFIELDIN,PFIELDOUT)
-!
-!* 6. Deallocations
-!
-DEALLOCATE(IMASKOUT)
-IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_BUFFER_1COV',1,ZHOOK_HANDLE)
-
-!-------------------------------------------------------------------------------------
-END SUBROUTINE HOR_INTERPOL_BUFFER_1COV
diff --git a/src/SURFEX/hor_interpol_cartesian.F90 b/src/SURFEX/hor_interpol_cartesian.F90
index e5468d3b5e11fbdbd1bce83a31b1111a1aa676b6..84b1181977dbb32230adfd3a7ba1a85f4f6022a8 100644
--- a/src/SURFEX/hor_interpol_cartesian.F90
+++ b/src/SURFEX/hor_interpol_cartesian.F90
@@ -7,13 +7,13 @@ SUBROUTINE HOR_INTERPOL_CARTESIAN(KLUOUT,PFIELDIN,PFIELDOUT)
! #################################################################################
!
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
USE MODD_PREP, ONLY : XLAT_OUT, XLON_OUT, XX_OUT, XY_OUT, LINTERP
-USE MODD_GRID_CARTESIAN, ONLY : XX, XY, NX, NY
+USE MODD_GRID_CARTESIAN, ONLY : XX, XY, NX, NY, XCX, XCY, NCIJ
USE MODD_SURF_PAR, ONLY : XUNDEF
!
-USE MODE_GRIDTYPE_CARTESIAN
-USE MODI_BILIN
-!
+USE MODI_BILIN_VALUE
+USE MODI_BILIN_EXTRAP
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -28,14 +28,6 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELDOUT ! interpolated field
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(:), ALLOCATABLE :: ZX ! X coordinate
-REAL, DIMENSION(:), ALLOCATABLE :: ZY ! Y coordinate
-INTEGER :: INO ! output number of points
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFIELDIN ! input field
-!
-INTEGER :: JI ! loop index
-INTEGER :: JJ ! loop index
-INTEGER :: JL ! loop index
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
@@ -43,44 +35,12 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* 1. Allocations
!
IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_CARTESIAN',0,ZHOOK_HANDLE)
-INO = SIZE(XX_OUT)
-!
-ALLOCATE(ZX (INO))
-ALLOCATE(ZY (INO))
-!
-!* 2. Transformation of latitudes/longitudes into metric coordinates of output grid
-!
-!* WARNING : here, because the input grid is not geographic, one assumes that
-! coordinates are coherent between input and output grid, but without
-! any way to check it.
-!
-ZX = XX_OUT
-ZY = XY_OUT
-!
-!
-!* 3. Put input field on its squared grid
-!
-ALLOCATE(ZFIELDIN(NX,NY,SIZE(PFIELDIN,2)))
-!
-DO JJ=1,NY
- DO JI=1,NX
- ZFIELDIN(JI,JJ,:) = PFIELDIN(JI+NX*(JJ-1),:)
- END DO
-END DO
!
!* 4. Interpolation with bilinear
!
-DO JL=1,SIZE(PFIELDIN,2)
- CALL BILIN(KLUOUT,XX,XY,ZFIELDIN(:,:,JL),ZX,ZY,PFIELDOUT(:,JL),LINTERP)
-END DO
-!
-!
-!* 5. Deallocations
-!
+CALL BILIN_VALUE(KLUOUT,NX,NY,PFIELDIN,XCX,XCY,NCIJ(:,1),NCIJ(:,2),PFIELDOUT)
+CALL BILIN_EXTRAP(KLUOUT,NX,NY,NCIJ,XX,XY,PFIELDIN,XX_OUT,XY_OUT,PFIELDOUT,LINTERP)
!
-DEALLOCATE(ZX)
-DEALLOCATE(ZY)
-DEALLOCATE(ZFIELDIN)
IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_CARTESIAN',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/hor_interpol_cartesian_1cov.F90 b/src/SURFEX/hor_interpol_cartesian_1cov.F90
deleted file mode 100644
index bb58c347f8ca2f23c8f69925218909605e9102ce..0000000000000000000000000000000000000000
--- a/src/SURFEX/hor_interpol_cartesian_1cov.F90
+++ /dev/null
@@ -1,107 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE HOR_INTERPOL_CARTESIAN_1COV(KLUOUT,PFIELDIN,PFIELDOUT)
-! #################################################################################
-!
-!!**** *HOR_INTERPOL_CARTESIAN_1COV * - Interpolation from a CARTESIAN grid on 1 vertical level only
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! M.Moge (adapted from HOR_INTERPOL_CARTESIAN)
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 06/2015
-!!------------------------------------------------------------------
-! #################################################################################
-!
-!
-USE MODD_PREP, ONLY : XLAT_OUT, XLON_OUT, XX_OUT, XY_OUT, LINTERP
-USE MODD_GRID_CARTESIAN, ONLY : XX, XY, NX, NY
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE MODE_GRIDTYPE_CARTESIAN
-USE MODI_BILIN
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
-REAL, DIMENSION(:), INTENT(IN) :: PFIELDIN ! field to interpolate horizontally
-REAL, DIMENSION(:), INTENT(OUT) :: PFIELDOUT ! interpolated field
-!
-!* 0.2 declarations of local variables
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZX ! X coordinate
-REAL, DIMENSION(:), ALLOCATABLE :: ZY ! Y coordinate
-INTEGER :: INO ! output number of points
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZFIELDIN ! input field
-!
-INTEGER :: JI ! loop index
-INTEGER :: JJ ! loop index
-INTEGER :: JL ! loop index
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
-!-------------------------------------------------------------------------------------
-!
-!* 1. Allocations
-!
-IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_CARTESIAN_1COV',0,ZHOOK_HANDLE)
-INO = SIZE(XX_OUT)
-!
-ALLOCATE(ZX (INO))
-ALLOCATE(ZY (INO))
-!
-!* 2. Transformation of latitudes/longitudes into metric coordinates of output grid
-!
-!* WARNING : here, because the input grid is not geographic, one assumes that
-! coordinates are coherent between input and output grid, but without
-! any way to check it.
-!
-ZX = XX_OUT
-ZY = XY_OUT
-!
-!
-!* 3. Put input field on its squared grid
-!
-ALLOCATE(ZFIELDIN(NX,NY))
-!
-DO JJ=1,NY
- DO JI=1,NX
- ZFIELDIN(JI,JJ) = PFIELDIN(JI+NX*(JJ-1))
- END DO
-END DO
-!
-!* 4. Interpolation with bilinear
-!
-CALL BILIN(KLUOUT,XX,XY,ZFIELDIN(:,:),ZX,ZY,PFIELDOUT(:),LINTERP)
-!
-!
-!* 5. Deallocations
-!
-!
-DEALLOCATE(ZX)
-DEALLOCATE(ZY)
-DEALLOCATE(ZFIELDIN)
-IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_CARTESIAN_1COV',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-END SUBROUTINE HOR_INTERPOL_CARTESIAN_1COV
diff --git a/src/SURFEX/hor_interpol_conf_proj.F90 b/src/SURFEX/hor_interpol_conf_proj.F90
index 12b1b72b9c5166b44642bde4315d0598c75fd7ae..b66ea779061bcbe47d5d7051febc25004e7f3ea9 100644
--- a/src/SURFEX/hor_interpol_conf_proj.F90
+++ b/src/SURFEX/hor_interpol_conf_proj.F90
@@ -35,14 +35,14 @@ SUBROUTINE HOR_INTERPOL_CONF_PROJ(GCP,KLUOUT,PFIELDIN,PFIELDOUT)
!! 10/02/15 M.Moge using SIZE(PFIELDOUT,1) instead of SIZE(XLAT_OUT)
!-------------------------------------------------------------------------------
!
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t, XY, XX, XCX, XCY, NCIJ
!
-USE MODD_PREP, ONLY : XLAT_OUT, XLON_OUT, LINTERP
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t,XY,XX
+USE MODD_SURFEX_MPI, ONLY : NRANK,NPIO
+USE MODD_PREP, ONLY : XX_OUT, XY_OUT, LINTERP
USE MODD_SURF_PAR, ONLY : XUNDEF
!
-USE MODE_GRIDTYPE_CONF_PROJ
-USE MODI_BILIN
-!
+USE MODI_BILIN_VALUE
+USE MODI_BILIN_EXTRAP
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -52,93 +52,24 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
REAL, DIMENSION(:,:), INTENT(IN) :: PFIELDIN ! field to interpolate horizontally
REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELDOUT ! interpolated field
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(:), ALLOCATABLE :: ZX,ZY ! coordinate of the output field
-REAL, DIMENSION(:), ALLOCATABLE :: ZX_DUPLIQUE ! X coordinate of the output field ! Ajout MT
-REAL, DIMENSION(:), ALLOCATABLE :: ZY_DUPLIQUE ! Y coordinate of the output field ! Ajout MT
-REAL, DIMENSION(:), ALLOCATABLE :: ZXY_DUPLIQUE ! Y coordinate of the input field ! Ajout MT
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFIELDIN ! input field
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFIELDIN_DUPLIQUE ! input field ! Ajout MT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZFIELDOUT_DUPLIQUE ! interpolated output field ! Ajout MT
-!
-INTEGER :: INO ! output number of points
-INTEGER :: JI,JJ,JL ! loop index
-!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
LOGICAL, DIMENSION(:), ALLOCATABLE :: GINTERP_DUPLIQUE ! .true. where physical value is needed ! Ajout MT
!-------------------------------------------------------------------------------------
!
-!* 1. Allocations
-!
IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_CONF_PROJ',0,ZHOOK_HANDLE)
-INO = SIZE(PFIELDOUT,1)
-!
-ALLOCATE(ZX (INO))
-ALLOCATE(ZY (INO))
-!
-IF (GCP%NY==1) THEN ! Ajout MT
- ALLOCATE(ZXY_DUPLIQUE(2),ZFIELDIN_DUPLIQUE(GCP%NX,2,SIZE(PFIELDIN,2)))
- ALLOCATE(ZX_DUPLIQUE(2*INO),ZY_DUPLIQUE(2*INO),ZFIELDOUT_DUPLIQUE(2*INO,SIZE(PFIELDIN,2)))
- ALLOCATE(GINTERP_DUPLIQUE(SIZE(ZFIELDOUT_DUPLIQUE,1)))
-END IF
-!
-!* 2. Transformation of latitudes/longitudes into metric coordinates of output grid
-!
- CALL XY_CONF_PROJ(GCP%XLAT0,GCP%XLON0,GCP%XRPK,GCP%XBETA,GCP%XLATORI,GCP%XLONORI, &
- ZX,ZY,XLAT_OUT,XLON_OUT )
-!
-!* 3. Put input field on its squared grid
-!
-ALLOCATE(ZFIELDIN(GCP%NX,GCP%NY,SIZE(PFIELDIN,2)))
-!
-DO JJ=1,GCP%NY
- DO JI=1,GCP%NX
- ZFIELDIN(JI,JJ,:) = PFIELDIN(JI+GCP%NX*(JJ-1),:)
- END DO
-END DO
-!
-IF (GCP%NY==1) THEN ! Ajout MT
- ZFIELDIN_DUPLIQUE(:,1,:)=ZFIELDIN(:,1,:)
- ZFIELDIN_DUPLIQUE(:,2,:)=ZFIELDIN(:,1,:)
- ZXY_DUPLIQUE(1)=XY(1)
- ZXY_DUPLIQUE(2)=XY(1)+10000.
- ZX_DUPLIQUE(1:INO) =ZX(:)
- ZX_DUPLIQUE(INO+1:2*INO)=ZX(:)
- ZY_DUPLIQUE(1:INO) =ZY(:)
- ZY_DUPLIQUE(INO+1:2*INO)=ZY(:)+10000.
- GINTERP_DUPLIQUE(1:INO) =LINTERP(1:INO)
- GINTERP_DUPLIQUE(INO+1:2*INO)=LINTERP(1:INO)
-END IF
!
!* 4. Interpolation with bilinear
!
-IF (GCP%NY==1) THEN ! Ajout MT
- DO JL=1,SIZE(PFIELDIN,2)
- CALL BILIN(KLUOUT,XX,ZXY_DUPLIQUE,ZFIELDIN_DUPLIQUE(:,:,JL), &
- ZX_DUPLIQUE,ZY_DUPLIQUE,ZFIELDOUT_DUPLIQUE(:,JL),GINTERP_DUPLIQUE)
-
- PFIELDOUT(1:INO,JL)=ZFIELDOUT_DUPLIQUE(1:INO,JL)
- END DO
-ELSE
- DO JL=1,SIZE(PFIELDIN,2)
- CALL BILIN(KLUOUT,XX,XY,ZFIELDIN(:,:,JL),ZX,ZY,PFIELDOUT(:,JL),LINTERP)
- END DO
-END IF
-!
-!
-!* 5. Deallocations
-!
-!
-DEALLOCATE(ZX,ZY)
-DEALLOCATE(ZFIELDIN)
-IF (GCP%NY==1) DEALLOCATE(ZXY_DUPLIQUE,ZX_DUPLIQUE,ZY_DUPLIQUE, &
- ZFIELDIN_DUPLIQUE,ZFIELDOUT_DUPLIQUE,GINTERP_DUPLIQUE) ! Ajout MT
+ CALL BILIN_VALUE(KLUOUT,GCP%NX,GCP%NY,PFIELDIN,XCX,XCY,NCIJ(:,1),NCIJ(:,2),PFIELDOUT)
+ CALL BILIN_EXTRAP(KLUOUT,GCP%NX,GCP%NY,NCIJ,XX,XY,PFIELDIN,XX_OUT,XY_OUT,PFIELDOUT,LINTERP)
!
IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_CONF_PROJ',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/hor_interpol_conf_proj_1cov.F90 b/src/SURFEX/hor_interpol_conf_proj_1cov.F90
deleted file mode 100644
index 2029304bea365e45d17212ea41a7cc79f2d46a0e..0000000000000000000000000000000000000000
--- a/src/SURFEX/hor_interpol_conf_proj_1cov.F90
+++ /dev/null
@@ -1,143 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE HOR_INTERPOL_CONF_PROJ_1COV(GCP,KLUOUT,PFIELDIN,PFIELDOUT)
-! #################################################################################
-!!
-!! PURPOSE
-!! ------- same as HOR_INTERPOL_CONF_PROJ on only 1 vertical level
-!!
-!! METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! 02/04/12 M. Tomasini Add an index in the second dimension of the ISBA
-!! array variables for BILIN interpolation routine to
-!! not bug in case 2D (this is not the more beautiful
-!! method; the BILIN routine should better be adapted)
-!! Search ! Ajout MT
-!! 10/02/15 M.Moge using SIZE(PFIELDOUT,1) instead of SIZE(XLAT_OUT)
-!-------------------------------------------------------------------------------
-!
-!
-USE MODD_PREP, ONLY : XLAT_OUT, XLON_OUT, LINTERP
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t,XY,XX
-
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE MODE_GRIDTYPE_CONF_PROJ
-USE MODI_BILIN
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
-INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
-REAL, DIMENSION(:), INTENT(IN) :: PFIELDIN ! field to interpolate horizontally
-REAL, DIMENSION(:), INTENT(OUT) :: PFIELDOUT ! interpolated field
-!
-!* 0.2 declarations of local variables
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZX,ZY ! coordinate of the output field
-REAL, DIMENSION(:), ALLOCATABLE :: ZX_DUPLIQUE ! X coordinate of the output field ! Ajout MT
-REAL, DIMENSION(:), ALLOCATABLE :: ZY_DUPLIQUE ! Y coordinate of the output field ! Ajout MT
-REAL, DIMENSION(:), ALLOCATABLE :: ZXY_DUPLIQUE ! Y coordinate of the input field ! Ajout MT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZFIELDIN ! input field
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZFIELDIN_DUPLIQUE ! input field ! Ajout MT
-REAL, DIMENSION(:), ALLOCATABLE :: ZFIELDOUT_DUPLIQUE ! interpolated output field ! Ajout MT
-!
-INTEGER :: INO ! output number of points
-INTEGER :: JI,JJ,JL ! loop index
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-LOGICAL, DIMENSION(:), ALLOCATABLE :: GINTERP_DUPLIQUE ! .true. where physical value is needed ! Ajout MT
-!-------------------------------------------------------------------------------------
-!
-!* 1. Allocations
-!
-IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_CONF_PROJ_1COV',0,ZHOOK_HANDLE)
-INO = SIZE(PFIELDOUT)
-!
-ALLOCATE(ZX (INO))
-ALLOCATE(ZY (INO))
-!
-IF (GCP%NY==1) THEN ! Ajout MT
- ALLOCATE(ZXY_DUPLIQUE(2),ZFIELDIN_DUPLIQUE(GCP%NX,2))
- ALLOCATE(ZX_DUPLIQUE(2*INO),ZY_DUPLIQUE(2*INO),ZFIELDOUT_DUPLIQUE(2*INO))
- ALLOCATE(GINTERP_DUPLIQUE(SIZE(ZFIELDOUT_DUPLIQUE)))
-END IF
-!
-!* 2. Transformation of latitudes/longitudes into metric coordinates of output grid
-!
- CALL XY_CONF_PROJ(GCP%XLAT0,GCP%XLON0,GCP%XRPK,GCP%XBETA,GCP%XLATORI,GCP%XLONORI, &
- ZX,ZY,XLAT_OUT,XLON_OUT )
-!
-!* 3. Put input field on its squared grid
-!
-ALLOCATE(ZFIELDIN(GCP%NX,GCP%NY))
-!
-DO JJ=1,GCP%NY
- DO JI=1,GCP%NX
- ZFIELDIN(JI,JJ) = PFIELDIN(JI+GCP%NX*(JJ-1))
- END DO
-END DO
-!
-IF (GCP%NY==1) THEN ! Ajout MT
- ZFIELDIN_DUPLIQUE(:,1)=ZFIELDIN(:,1)
- ZFIELDIN_DUPLIQUE(:,2)=ZFIELDIN(:,1)
- ZXY_DUPLIQUE(1)=XY(1)
- ZXY_DUPLIQUE(2)=XY(1)+10000.
- ZX_DUPLIQUE(1:INO) =ZX(:)
- ZX_DUPLIQUE(INO+1:2*INO)=ZX(:)
- ZY_DUPLIQUE(1:INO) =ZY(:)
- ZY_DUPLIQUE(INO+1:2*INO)=ZY(:)+10000.
- GINTERP_DUPLIQUE(1:INO) =LINTERP(1:INO)
- GINTERP_DUPLIQUE(INO+1:2*INO)=LINTERP(1:INO)
-END IF
-!
-!* 4. Interpolation with bilinear
-!
-IF (GCP%NY==1) THEN ! Ajout MT
- CALL BILIN(KLUOUT,XX,ZXY_DUPLIQUE,ZFIELDIN_DUPLIQUE(:,:), &
- ZX_DUPLIQUE,ZY_DUPLIQUE,ZFIELDOUT_DUPLIQUE(:),GINTERP_DUPLIQUE)
-
- PFIELDOUT(1:INO)=ZFIELDOUT_DUPLIQUE(1:INO)
-ELSE
- CALL BILIN(KLUOUT,XX,XY,ZFIELDIN(:,:),ZX,ZY,PFIELDOUT(:),LINTERP)
-END IF
-!
-!
-!* 5. Deallocations
-!
-!
-DEALLOCATE(ZX,ZY)
-DEALLOCATE(ZFIELDIN)
-IF (GCP%NY==1) DEALLOCATE(ZXY_DUPLIQUE,ZX_DUPLIQUE,ZY_DUPLIQUE, &
- ZFIELDIN_DUPLIQUE,ZFIELDOUT_DUPLIQUE,GINTERP_DUPLIQUE) ! Ajout MT
-!
-IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_CONF_PROJ_1COV',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-END SUBROUTINE HOR_INTERPOL_CONF_PROJ_1COV
diff --git a/src/SURFEX/hor_interpol_gauss.F90 b/src/SURFEX/hor_interpol_gauss.F90
index 3b140a4475a43bcebf29eed77f604792a35cee63..4dc5994618631aaa9dedea94d7d2ca93ab10897f 100644
--- a/src/SURFEX/hor_interpol_gauss.F90
+++ b/src/SURFEX/hor_interpol_gauss.F90
@@ -27,14 +27,18 @@ SUBROUTINE HOR_INTERPOL_GAUSS(KLUOUT,PFIELDIN,PFIELDOUT)
!! M. Jidane Dec 2013 : initialize NNI if not already done
!!------------------------------------------------------------------
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
+USE MODD_HORIBL, ONLY : LGLOBLON, LGLOBS, LGLOBN, XILO1H, XILO2H, NINLOH, &
+ XLA, XOLA, XOLO, NP, XLOPH
USE MODD_PREP, ONLY : XLAT_OUT, XLON_OUT, LINTERP
USE MODD_GRID_GAUSS, ONLY : XILA1, XILO1, XILA2, XILO2, NINLA, NINLO, NILEN, LROTPOLE, &
- XLAP, XLOP, XCOEF
+ XLAP, XLOP, XCOEF, XLAT, XLON
USE MODD_GRID_GRIB, ONLY : NNI
USE MODD_SURF_PAR, ONLY : XUNDEF
!
-USE MODI_HORIBL_SURF
-!
+USE MODI_HORIBL_SURF_GRIDIN
+USE MODI_HORIBL_SURF_VALUE
+USE MODI_HORIBL_SURF_EXTRAP
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -49,12 +53,16 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELDOUT ! interpolated field
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(:), ALLOCATABLE :: ZLAT ! latitudes
-REAL, DIMENSION(:), ALLOCATABLE :: ZLON ! longitudes
-INTEGER, DIMENSION(:), ALLOCATABLE :: IMASKIN ! input mask
+REAL, DIMENSION(:,:), POINTER :: ZFIELDIN0=>NULL()
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFIELDIN
+!
+INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: ILSMIN
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: IMASKIN ! input mask
INTEGER, DIMENSION(:), ALLOCATABLE :: IMASKOUT ! output mask
-INTEGER :: INO ! output number of points
-INTEGER :: JL ! loop counter
+INTEGER, DIMENSION(:), POINTER :: IMASK=>NULL()
+INTEGER, DIMENSION(SIZE(NP,1),SIZE(NP,2)) :: IP
+INTEGER :: INO, INL ! output number of points
+INTEGER :: JL, JI ! loop counter
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
@@ -63,193 +71,52 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_GAUSS',0,ZHOOK_HANDLE)
INO = SIZE(XLAT_OUT)
+INL = SIZE(PFIELDOUT,2)
!
-IF (NNI==0) NNI=NILEN
-ALLOCATE(IMASKIN (NNI))
-!
-ALLOCATE(ZLAT (INO))
-ALLOCATE(ZLON (INO))
ALLOCATE(IMASKOUT(INO))
IMASKOUT = 1
!
-!* 2. Is pole rotated?
-!
-IF (LROTPOLE) THEN
-!* transformation of output latitudes, longitudes into rotated coordinates
- CALL ARPEGE_STRETCH_A(INO,XLAP,XLOP,XCOEF,XLAT_OUT,XLON_OUT,ZLAT,ZLON)
-ELSE
- ZLAT = XLAT_OUT
- ZLON = XLON_OUT
-END IF
-!
-!* 3. Input mask
-!
-DO JL=1,SIZE(PFIELDIN,2)
+IF (NNI==0) NNI=NILEN
+ALLOCATE(IMASKIN (NNI,INL))
!
-IMASKIN(:) = 1.
-WHERE(PFIELDIN(:,JL)==XUNDEF) IMASKIN = 0.
+IF (NRANK==NPIO) THEN
+ IMASKIN(:,:) = 1.
+ WHERE(PFIELDIN(:,:)==XUNDEF) IMASKIN(:,:) = 0.
+ENDIF
+
+ALLOCATE(ZFIELDIN(INO,INL,12))
+ALLOCATE(ILSMIN(INO,INL,12))
!
+CALL HORIBL_SURF_GRIDIN(NINLA,NINLO,NNI,PFIELDIN(:,:),INO, &
+ .FALSE.,KLUOUT,LGLOBS,LGLOBN,LGLOBLON,NP, &
+ ZFIELDIN0,ZFIELDIN,ILSMIN,IMASKIN,IMASKOUT,IMASK)
!
-!* 4. Interpolation with horibl
+DO JL=1,SIZE(NP,2)
+ DO JI = 1,SIZE(NP,1)
+ IP(JI,JL) = IMASK(NP(JI,JL))
+ ENDDO
+ENDDO
!
- CALL HORIBL_SURF(XILA1,XILO1,XILA2,XILO2,NINLA,NINLO,NNI,PFIELDIN(:,JL),INO,ZLON,ZLAT,PFIELDOUT(:,JL), &
- .FALSE.,KLUOUT,LINTERP,IMASKIN,IMASKOUT)
-END DO
+DO JL=1,SIZE(PFIELDOUT,2)
+ !
+ CALL HORIBL_SURF_VALUE(NNI,INO,PFIELDOUT(:,JL),LINTERP,ZFIELDIN(:,JL,:),ILSMIN(:,JL,:),&
+ XOLO,XOLA,XLA,XLOPH,IMASKIN(:,JL),IMASKOUT)
+ !
+ENDDO
!
+ CALL HORIBL_SURF_EXTRAP(XILA1,XILO1H,XILA2,XILO2H,NINLA,NINLO,NNI,PFIELDIN,&
+ INO,IP,XLON,XLAT,PFIELDOUT,KLUOUT,LINTERP)
!
!* 5. Deallocations
!
-DEALLOCATE(ZLAT)
-DEALLOCATE(ZLON)
+IMASK => NULL()
DEALLOCATE(IMASKIN )
DEALLOCATE(IMASKOUT)
+DEALLOCATE(ZFIELDIN0)
+DEALLOCATE(ZFIELDIN)
+DEALLOCATE(ILSMIN)
!
!-------------------------------------------------------------------------------
-!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_GAUSS',1,ZHOOK_HANDLE)
- CONTAINS
-!
-! ##########################################################################
-SUBROUTINE ARPEGE_STRETCH_A(KN,PLAP,PLOP,PCOEF,PLAR,PLOR,PLAC,PLOC)
-! ##########################################################################
-!!**** *ARPEGE_STRETCH_A* - Projection to Arpege stretched grid
-!!
-!! PURPOSE
-!! -------
-!!
-!! Projection from standard Lat,Lon grid to Arpege stretched grid
-!!
-!! METHOD
-!! ------
-!!
-!! The projection is defined in two steps :
-!! 1. A rotation to place the stretching pole at the north pole
-!! 2. The stretching
-!! This routine is a basic implementation of the informations founded in
-!! 'Note de travail Arpege n#3'
-!! 'Transformation de coordonnees'
-!! J.F.Geleyn 1988
-!! This document describes a slightly different transformation in 3 steps. Only the
-!! two first steps are to be taken in account (at the time of writing this paper has
-!! not been updated).
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! This routine is based on :
-!! 'Note de travail ARPEGE' number 3
-!! by J.F. GELEYN (may 1988)
-!!
-!! AUTHOR
-!! ------
-!!
-!! V.Bousquet
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!! Original 07/01/1999
-!! V. Masson 01/2004 Externalization of surface
-!!
-!
-! 0. DECLARATIONS
-! ---------------
-!
- USE MODD_CSTS,ONLY : XPI
!
- IMPLICIT NONE
-!
-! 0.1. Declaration of arguments
-! -----------------------------
-
- INTEGER, INTENT(IN) :: KN ! Number of points to convert
- REAL, INTENT(IN) :: PLAP ! Latitude of stretching pole
- REAL, INTENT(IN) :: PLOP ! Longitude of stretching pole
- REAL, INTENT(IN) :: PCOEF ! Stretching coefficient
- REAL, DIMENSION(KN), INTENT(IN) :: PLAR ! Lat. of points
- REAL, DIMENSION(KN), INTENT(IN) :: PLOR ! Lon. of points
- REAL, DIMENSION(KN), INTENT(OUT) :: PLAC ! Computed pseudo-lat. of points
- REAL, DIMENSION(KN), INTENT(OUT) :: PLOC ! Computed pseudo-lon. of points
-!
- REAL :: ZSINSTRETCHLA ! Sine of stretching point lat.
- REAL :: ZSINSTRETCHLO ! Sine of stretching point lon.
- REAL :: ZCOSSTRETCHLA ! Cosine of stretching point lat.
- REAL :: ZCOSSTRETCHLO ! Cosine of stretching point lon.
- REAL :: ZSINLA ! Sine of computed point latitude
- REAL :: ZSINLO ! Sine of computed point longitude
- REAL :: ZCOSLA ! Cosine of computed point latitude
- REAL :: ZCOSLO ! Cosine of computed point longitude
- REAL :: ZSINLAS ! Sine of point's pseudo-latitude
- REAL :: ZSINLOS ! Sine of point's pseudo-longitude
- REAL :: ZCOSLOS ! Cosine of point's pseudo-lon.
- REAL :: ZA,ZB,ZD ! Dummy variables used for
- REAL :: ZX,ZY ! computations
-!
- INTEGER :: JLOOP1 ! Dummy loop counter
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
- IF (LHOOK) CALL DR_HOOK('ARPEGE_STRETCH_A',0,ZHOOK_HANDLE)
- ZSINSTRETCHLA = SIN(PLAP*XPI/180.)
- ZCOSSTRETCHLA = COS(PLAP*XPI/180.)
- ZSINSTRETCHLO = SIN(PLOP*XPI/180.)
- ZCOSSTRETCHLO = COS(PLOP*XPI/180.)
- ! L = longitude (0 = Greenwich, + toward east)
- ! l = latitude (90 = N.P., -90 = S.P.)
- ! p stands for stretching pole
- PLAC(:) = PLAR(:) * XPI / 180.
- PLOC(:) = PLOR(:) * XPI / 180.
- ! A = 1 + c.c
- ZA = 1. + PCOEF*PCOEF
- ! B = 1 - c.c
- ZB = 1. - PCOEF*PCOEF
- DO JLOOP1=1, KN
- ZSINLA = SIN(PLAC(JLOOP1))
- ZCOSLA = COS(PLAC(JLOOP1))
- ZSINLO = SIN(PLOC(JLOOP1))
- ZCOSLO = COS(PLOC(JLOOP1))
- ! X = cos(Lp-L)
- ZX = ZCOSLO*ZCOSSTRETCHLO + ZSINLO*ZSINSTRETCHLO
- ! Y = sin(Lp-L)
- ZY = ZSINSTRETCHLO*ZCOSLO - ZSINLO*ZCOSSTRETCHLO
- ! D = (1+c.c) + (1-c.c)(sin lp.sin l + cos lp.cos l.cos(Lp-L))
- ZD = ZA + ZB*(ZSINSTRETCHLA*ZSINLA+ZCOSSTRETCHLA*ZCOSLA*ZX)
- ! (1-c.c)+(1+c.c)((sin lp.sin l + cos lp.cos l.cos(Lp-L))
- ! sin lr = -------------------------------------------------------
- ! D
- ZSINLAS = (ZB + ZA*(ZSINSTRETCHLA*ZSINLA+ZCOSSTRETCHLA*ZCOSLA*ZX)) / ZD
- ! D' = D * cos lr
- ZD = ZD * (AMAX1(1e-6,SQRT(1.-ZSINLAS*ZSINLAS)))
- ! 2.c.(cos lp.sin l - sin lp.cos l.cos(Lp-L))
- ! cos Lr = -------------------------------------------
- ! D'
- ZCOSLOS = 2.*PCOEF*(ZCOSSTRETCHLA*ZSINLA-ZSINSTRETCHLA*ZCOSLA*ZX) / ZD
- ! 2.c.cos l.cos(Lp-L)
- ! sin Lr = -------------------
- ! D'
- ZSINLOS = 2.*PCOEF*(ZCOSLA*ZY) / ZD
- ! saturations (corrects calculation errors)
- ZSINLAS = MAX(ZSINLAS,-1.)
- ZSINLAS = MIN(ZSINLAS, 1.)
- ZCOSLOS = MAX(ZCOSLOS,-1.)
- ZCOSLOS = MIN(ZCOSLOS, 1.)
- ! back from sine & cosine
- PLAC(JLOOP1) = ASIN(ZSINLAS)
- IF (ZSINLOS>0) THEN
- PLOC(JLOOP1) = ACOS(ZCOSLOS)
- ELSE
- PLOC(JLOOP1) = -ACOS(ZCOSLOS)
- ENDIF
- ENDDO
- PLOC(:) = PLOC(:) * 180. / XPI
- PLAC(:) = PLAC(:) * 180. / XPI
-IF (LHOOK) CALL DR_HOOK('ARPEGE_STRETCH_A',1,ZHOOK_HANDLE)
-END SUBROUTINE ARPEGE_STRETCH_A
-!-------------------------------------------------------------------------------
END SUBROUTINE HOR_INTERPOL_GAUSS
diff --git a/src/SURFEX/hor_interpol_latlon.F90 b/src/SURFEX/hor_interpol_latlon.F90
index 9cda907111c12bb68528082a0905b7ff2cdd4303..ee124b8aacc20ce8a536f99a1c02442ee970286a 100644
--- a/src/SURFEX/hor_interpol_latlon.F90
+++ b/src/SURFEX/hor_interpol_latlon.F90
@@ -33,13 +33,17 @@ SUBROUTINE HOR_INTERPOL_LATLON(KLUOUT,PFIELDIN,PFIELDOUT)
!
!
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
+USE MODD_HORIBL, ONLY : LGLOBLON, LGLOBS, LGLOBN, XILO1H, XILO2H, NINLOH, &
+ XLA, XOLA, XOLO, NP, XLOPH
USE MODD_PREP, ONLY : XLAT_OUT, XLON_OUT, LINTERP
USE MODD_GRID_LATLONREGUL, ONLY : XILAT1, XILON1, XILAT2, XILON2, &
NINLAT, NINLON, NILENGTH,XILATARRAY
USE MODD_SURF_PAR, ONLY : XUNDEF
!
-USE MODI_HORIBL_SURF
-USE MODI_ADAPT_HORIBL_SURF
+USE MODI_HORIBL_SURF_GRIDIN
+USE MODI_HORIBL_SURF_VALUE
+USE MODI_HORIBL_SURF_EXTRAP
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -54,12 +58,16 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELDOUT ! interpolated field
!
!* 0.2 declarations of local variables
!
-INTEGER, DIMENSION(:), ALLOCATABLE :: IMASKIN ! input mask
+REAL, DIMENSION(:,:), POINTER :: ZFIELDIN0
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFIELDIN
+!
+INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: ILSMIN
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: IMASKIN ! input mask
INTEGER, DIMENSION(:), ALLOCATABLE :: IMASKOUT ! output mask
-INTEGER :: INO ! output number of points
-INTEGER :: JL ! loop counter
-LOGICAL :: GREGULAR
-REAL :: ZDLAT,ZDLAT_REG
+INTEGER, DIMENSION(:), POINTER :: IMASK=>NULL()
+INTEGER, DIMENSION(SIZE(NP,1),SIZE(NP,2)) :: IP
+INTEGER :: INO, INL ! output number of points
+INTEGER :: JL, JI ! loop counter
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -69,51 +77,53 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_LATLON',0,ZHOOK_HANDLE)
!
INO = SIZE(XLAT_OUT)
-!
-ALLOCATE(IMASKIN(NILENGTH))
+INL = SIZE(PFIELDOUT,2)
!
ALLOCATE(IMASKOUT(INO))
+IMASKOUT = 1
!
-!* 2. Initializations
+ALLOCATE(IMASKIN (NILENGTH,INL))
!
-GREGULAR= .TRUE.
+IF (NRANK==NPIO) THEN
+ IMASKIN(:,:) = 1.
+ WHERE(PFIELDIN(:,:)==XUNDEF) IMASKIN(:,:) = 0.
+ENDIF
!
-IMASKOUT = 1
+ALLOCATE(ZFIELDIN(INO,INL,12))
+ALLOCATE(ILSMIN(INO,INL,12))
!
-ZDLAT_REG = (XILAT2-XILAT1)/REAL(NINLAT-1)
!
-DO JL=2,NINLAT
- ZDLAT=XILATARRAY(JL)-XILATARRAY(JL-1)
- IF(ZDLAT/=ZDLAT_REG)THEN
- GREGULAR=.FALSE.
- ENDIF
-ENDDO
+CALL HORIBL_SURF_GRIDIN(NINLAT,NINLON,NILENGTH,PFIELDIN(:,:),INO, &
+ .FALSE.,KLUOUT,LGLOBS,LGLOBN,LGLOBLON,NP, &
+ ZFIELDIN0,ZFIELDIN,ILSMIN,IMASKIN,IMASKOUT,IMASK)
!
+DO JL=1,SIZE(NP,2)
+ DO JI = 1,SIZE(NP,1)
+ IP(JI,JL) = IMASK(NP(JI,JL))
+ ENDDO
+ENDDO
!
!* 3. Interpolation with horibl
!
-IF(GREGULAR)THEN
- DO JL=1,SIZE(PFIELDIN,2)
- IMASKIN(:) = 1
- WHERE(PFIELDIN(:,JL)==XUNDEF) IMASKIN(:) = 0
- CALL HORIBL_SURF(XILAT1,XILON1,XILAT2,XILON2,NINLAT,NINLON,NILENGTH, &
- PFIELDIN(:,JL),INO,XLON_OUT,XLAT_OUT,PFIELDOUT(:,JL),.FALSE., &
- KLUOUT,LINTERP,IMASKIN,IMASKOUT)
- ENDDO
-ELSE
- DO JL=1,SIZE(PFIELDIN,2)
- IMASKIN(:) = 1
- WHERE(PFIELDIN(:,JL)==XUNDEF) IMASKIN(:) = 0
- CALL ADAPT_HORIBL_SURF(XILATARRAY,XILAT1,XILON1,XILAT2,XILON2,NINLAT,NINLON,NILENGTH, &
- PFIELDIN(:,JL),INO,XLON_OUT,XLAT_OUT,PFIELDOUT(:,JL),.FALSE., &
- KLUOUT,LINTERP,IMASKIN,IMASKOUT)
- ENDDO
-ENDIF
+DO JL=1,INL
+!
+ CALL HORIBL_SURF_VALUE(NILENGTH,INO,PFIELDOUT(:,JL),LINTERP,ZFIELDIN(:,JL,:),&
+ ILSMIN(:,JL,:),XOLO,XOLA,XLA,XLOPH,IMASKIN(:,JL),IMASKOUT)
+!
+ENDDO
+!
+ CALL HORIBL_SURF_EXTRAP(XILAT1,XILO1H,XILAT2,XILO2H,NINLAT,NINLON,NILENGTH,&
+ PFIELDIN,INO,IP,XLON_OUT,XLAT_OUT,&
+ PFIELDOUT,KLUOUT,LINTERP,XILATARRAY)
!
!* 6. Deallocations
!
-IF (ALLOCATED(IMASKIN )) DEALLOCATE(IMASKIN )
-IF (ALLOCATED(IMASKOUT)) DEALLOCATE(IMASKOUT)
+IMASK => NULL()
+DEALLOCATE(IMASKIN )
+DEALLOCATE(IMASKOUT)
+DEALLOCATE(ZFIELDIN)
+DEALLOCATE(ZFIELDIN0)
+DEALLOCATE(ILSMIN)
!
IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_LATLON',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/hor_interpol_latlon_1cov.F90 b/src/SURFEX/hor_interpol_latlon_1cov.F90
deleted file mode 100644
index 33204dcdd26c7484d3443eb72406970ddc5c1108..0000000000000000000000000000000000000000
--- a/src/SURFEX/hor_interpol_latlon_1cov.F90
+++ /dev/null
@@ -1,114 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE HOR_INTERPOL_LATLON_1COV(KLUOUT,PFIELDIN,PFIELDOUT)
-! #################################################################################
-!
-!!**** *HOR_INTERPOL_LATLON_1COV* - Interpolation from a lat/lon regular grid on 1 vertical level only
-!!
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! M.Moge (adapted from HOR_INTERPOL_LATLON)
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 06/2015
-!!
-!!------------------------------------------------------------------
-!
-!
-!
-USE MODD_PREP, ONLY : XLAT_OUT, XLON_OUT, LINTERP
-USE MODD_GRID_LATLONREGUL, ONLY : XILAT1, XILON1, XILAT2, XILON2, &
- NINLAT, NINLON, NILENGTH,XILATARRAY
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE MODI_HORIBL_SURF
-USE MODI_ADAPT_HORIBL_SURF
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
-REAL, DIMENSION(:), INTENT(IN) :: PFIELDIN ! field to interpolate horizontally
-REAL, DIMENSION(:), INTENT(OUT) :: PFIELDOUT ! interpolated field
-!
-!* 0.2 declarations of local variables
-!
-INTEGER, DIMENSION(:), ALLOCATABLE :: IMASKIN ! input mask
-INTEGER, DIMENSION(:), ALLOCATABLE :: IMASKOUT ! output mask
-INTEGER :: INO ! output number of points
-INTEGER :: JL ! loop counter
-LOGICAL :: GREGULAR
-REAL :: ZDLAT,ZDLAT_REG
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------------
-!* 1. Allocations
-!
-IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_LATLON1COV',0,ZHOOK_HANDLE)
-!
-INO = SIZE(XLAT_OUT)
-!
-ALLOCATE(IMASKIN(NILENGTH))
-!
-ALLOCATE(IMASKOUT(INO))
-!
-!* 2. Initializations
-!
-GREGULAR= .TRUE.
-!
-IMASKOUT = 1
-!
-ZDLAT_REG = (XILAT2-XILAT1)/REAL(NINLAT-1)
-!
-DO JL=2,NINLAT
- ZDLAT=XILATARRAY(JL)-XILATARRAY(JL-1)
- IF(ZDLAT/=ZDLAT_REG)THEN
- GREGULAR=.FALSE.
- ENDIF
-ENDDO
-!
-!
-!* 3. Interpolation with horibl
-!
-IF(GREGULAR)THEN
- IMASKIN(:) = 1
- WHERE(PFIELDIN(:)==XUNDEF) IMASKIN(:) = 0
- CALL HORIBL_SURF(XILAT1,XILON1,XILAT2,XILON2,NINLAT,NINLON,NILENGTH, &
- PFIELDIN(:),INO,XLON_OUT,XLAT_OUT,PFIELDOUT(:),.FALSE., &
- KLUOUT,LINTERP,IMASKIN,IMASKOUT)
-ELSE
- IMASKIN(:) = 1
- WHERE(PFIELDIN(:)==XUNDEF) IMASKIN(:) = 0
- CALL ADAPT_HORIBL_SURF(XILATARRAY,XILAT1,XILON1,XILAT2,XILON2,NINLAT,NINLON,NILENGTH, &
- PFIELDIN(:),INO,XLON_OUT,XLAT_OUT,PFIELDOUT(:),.FALSE., &
- KLUOUT,LINTERP,IMASKIN,IMASKOUT)
-ENDIF
-!
-!* 6. Deallocations
-!
-IF (ALLOCATED(IMASKIN )) DEALLOCATE(IMASKIN )
-IF (ALLOCATED(IMASKOUT)) DEALLOCATE(IMASKOUT)
-!
-IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_LATLON_1COV',1,ZHOOK_HANDLE)
-!-------------------------------------------------------------------------------
-END SUBROUTINE HOR_INTERPOL_LATLON_1COV
diff --git a/src/SURFEX/hor_interpol_none_1cov.F90 b/src/SURFEX/hor_interpol_none_1cov.F90
deleted file mode 100644
index b0ff486c28595505e19790ae606d582e0123d582..0000000000000000000000000000000000000000
--- a/src/SURFEX/hor_interpol_none_1cov.F90
+++ /dev/null
@@ -1,90 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE HOR_INTERPOL_NONE_1COV (DTCO, U, &
- KLUOUT,PFIELDIN,PFIELDOUT)
-! #################################################################################
-!
-!!**** *HOR_INTERPOL_NONE_1COV * - Only extrapolation on 1 vertical level only
-!!
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! M.Moge (adapted from HOR_INTERPOL_NONE)
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 06/2015
-!!------------------------------------------------------------------
-!
-!
-!
-!
-!
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
-USE MODD_PREP, ONLY : XLAT_OUT, XLON_OUT, CMASK
-!
-USE MODD_GRID_BUFFER, ONLY : NNI
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE MODI_PACK_SAME_RANK
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODI_GET_SURF_MASK_n
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-!
-INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
-REAL, POINTER, DIMENSION(:) :: PFIELDIN ! field to interpolate horizontally
-REAL, DIMENSION(:), INTENT(OUT) :: PFIELDOUT ! interpolated field
-!
-!* 0.2 declarations of local variables
-!
-INTEGER, DIMENSION(:), ALLOCATABLE :: IMASKOUT ! output mask
-INTEGER :: INO ! output number of points
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!------------------------------------------------------------------------------
-!
-!* 1. Initialisation of the output mask
-!
-IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_NONE_1COV',0,ZHOOK_HANDLE)
-INO = SIZE(XLAT_OUT)
-ALLOCATE(IMASKOUT(INO))
- CALL GET_SURF_MASK_n(DTCO, U, &
- CMASK,INO,IMASKOUT,NNI,KLUOUT)
-!
-!* 2. Mask the input field with the output mask
-!!mask du tableau de taille FULL en fonction du type de surface
- CALL PACK_SAME_RANK(IMASKOUT,PFIELDIN,PFIELDOUT)
-!
-!* 6. Deallocations
-!
-DEALLOCATE(IMASKOUT)
-IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_NONE_1COV',1,ZHOOK_HANDLE)
-
-!-------------------------------------------------------------------------------------
-END SUBROUTINE HOR_INTERPOL_NONE_1COV
diff --git a/src/SURFEX/hor_interpol_rotlatlon.F90 b/src/SURFEX/hor_interpol_rotlatlon.F90
index a452008b336f2eff1c33eb7485ff952b51678a76..4fce0f376f609f38f3e8249a6ff42a9a8ce78328 100644
--- a/src/SURFEX/hor_interpol_rotlatlon.F90
+++ b/src/SURFEX/hor_interpol_rotlatlon.F90
@@ -25,18 +25,15 @@ SUBROUTINE HOR_INTERPOL_ROTLATLON(KLUOUT,PFIELDIN,PFIELDOUT)
!! MODIFICATIONS
!! -------------
!! Original 10/2007
-!! P. Samuelsson 10/2014 Moved subroutine REGROT to separate routine
!!------------------------------------------------------------------
!
!
-!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC, IDX_I
USE MODD_PREP, ONLY : XLAT_OUT, XLON_OUT
USE MODD_GRID_ROTLATLON
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_GRID_GRIB, ONLY : NNI
-!
-!RJ: missing modi
-USE MODI_REGROT_LONLAT_ROT
+
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -44,6 +41,10 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1 declarations of arguments
!
INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
@@ -52,139 +53,282 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELDOUT ! interpolated field
!
!* 0.2 declarations of local variables
!
-
- INTEGER, ALLOCATABLE :: ii(:),jj(:)
-
- REAL, ALLOCATABLE :: XLAT_IND(:),XLON_IND(:), &
- XRAT_OUT(:),XRON_OUT(:), &
- w00(:),w01(:), &
- w10(:),w11(:)
-
- LOGICAL, ALLOCATABLE :: LMASK(:)
-
-INTEGER :: I,J,K,L,IJ,IJ00,IJ01,IJ10,IJ11,INO,JL
-REAL :: WX,WY,WSUM
+#ifdef SFX_MPI
+INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+#endif
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZW, ZFIELDIN,ZFGET
+INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: IJD,IJGET
+REAL, DIMENSION(:), ALLOCATABLE :: XLAT_IND, XLON_IND, XRAT_OUT, XRON_OUT
+!
+INTEGER :: INFOMPI
+INTEGER :: J, I, JI, INO, JL, INL, ILON, ILAT, ISIZE
+REAL :: ZWX, ZWY, ZWSUM
+!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_ROTLATLON',0,ZHOOK_HANDLE)
+!
WRITE(KLUOUT,'(A)')' | Running rotated latlon interpolation'
-
+!
INO = SIZE(XLAT_OUT)
-
+INL = SIZE(PFIELDOUT,2)
+!
!
!* 1. Allocations
!
-ALLOCATE(XRAT_OUT(INO), &
- XRON_OUT(INO), &
- XLAT_IND(INO), &
- XLON_IND(INO), &
- II(INO), &
- JJ(INO), &
- W00(INO), &
- W01(INO), &
- W10(INO), &
- W11(INO))
-
-ALLOCATE(LMASK(NNI))
+ALLOCATE(XRAT_OUT(INO),XRON_OUT(INO),XLAT_IND(INO),XLON_IND(INO),IJD(INO,INL,4),ZW(INO,INL,4))
!
!* Transformation of latitudes/longitudes into rotated coordinates
-
- WRITE(KLUOUT,*)'XLAT_OUT',XLAT_OUT(10:10)
- WRITE(KLUOUT,*)'XLON_OUT',XLON_OUT(10:10)
-
- CALL REGROT_LONLAT_ROT(XLON_OUT,XLAT_OUT, &
- XRON_OUT,XRAT_OUT, &
- INO,1,INO,1, &
- XRLOP,XRLAP,1 )
-
- WRITE(KLUOUT,*)'XRAT_OUT',XRAT_OUT(10:10)
- WRITE(KLUOUT,*)'XRON_OUT',XRON_OUT(10:10)
-
- DO IJ=1,INO
- XLAT_IND(IJ) = ( XRAT_OUT(IJ) - XRILA1) / XRDY + 1.
- XLON_IND(IJ) = ( XRON_OUT(IJ) - XRILO1) / XRDX + 1.
- ENDDO
-
- PFIELDOUT(:,:) = XUNDEF
-
- DO JL=1,SIZE(PFIELDIN,2)
-
- LMASK= .TRUE.
- WHERE ( ABS(PFIELDIN(:,JL)-XUNDEF) < 1.e-6 ) LMASK = .FALSE.
-
- DO IJ=1,INO
-
- II(IJ) = INT(XLON_IND(IJ))
- JJ(IJ) = INT(XLAT_IND(IJ))
-
- WX = XLON_IND(IJ) - FLOAT(II(IJ))
- WY = XLAT_IND(IJ) - FLOAT(JJ(IJ))
-
- W00(IJ) = (1.-WX)*(1.-WY)
- W01(IJ) = (1.-WX)* WY
- W10(IJ) = WX *(1.-WY)
- W11(IJ) = WX * WY
-
- K = II(IJ)
- L = JJ(IJ)
- IJ00 = k + NRX*(l -1)
- IJ01 = k + NRX*(l+1 -1)
- IJ10 = k+1 + NRX*(l -1)
- IJ11 = k+1 + NRX*(l+1 -1)
-
- IF (.NOT. LMASK(IJ00)) w00(IJ) = 0.
- IF (.NOT. LMASK(IJ01)) w01(IJ) = 0.
- IF (.NOT. LMASK(IJ10)) w10(IJ) = 0.
- IF (.NOT. LMASK(IJ11)) w11(IJ) = 0.
-
- wsum = w00(IJ) + w01(IJ) + &
- w10(IJ) + w11(IJ)
-
- IF ( ABS(wsum) < 1.e-6 ) CYCLE
-
- w00(IJ) = w00(IJ) / wsum
- w01(IJ) = w01(IJ) / wsum
- w10(IJ) = w10(IJ) / wsum
- w11(IJ) = w11(IJ) / wsum
-
+!
+ CALL REGROT(XLON_OUT,XLAT_OUT,XRON_OUT,XRAT_OUT,XRLOP,XRLAP,1)
+!
+DO J=1,INO
+ XLAT_IND(J) = ( XRAT_OUT(J) - XRILA1) / XRDY + 1.
+ XLON_IND(J) = ( XRON_OUT(J) - XRILO1) / XRDX + 1.
+ENDDO
+!
+PFIELDOUT(:,:) = XUNDEF
+!
+ZW(:,:,:) = 0.
+DO JL=1,INL
+ !
+ DO JI=1,INO
+ !
+ ILON = INT(XLON_IND(JI))
+ ILAT = INT(XLAT_IND(JI))
+ !
+ ZWX = XLON_IND(JI) - FLOAT(ILON)
+ ZWY = XLAT_IND(JI) - FLOAT(ILAT)
+ !
+ ZW(JI,JL,1) = (1.-ZWX)*(1.-ZWY)
+ ZW(JI,JL,2) = (1.-ZWX)* ZWY
+ ZW(JI,JL,3) = ZWX *(1.-ZWY)
+ ZW(JI,JL,4) = ZWX * ZWY
+ !
+ IJD(JI,JL,1) = ILON + NRX*(ILAT -1)
+ IJD(JI,JL,2) = ILON + NRX*(ILAT+1 -1)
+ IJD(JI,JL,3) = ILON+1 + NRX*(ILAT -1)
+ IJD(JI,JL,4) = ILON+1 + NRX*(ILAT+1 -1)
+ !
+ ENDDO
+ !
+ENDDO
+!
+ALLOCATE(ZFIELDIN(INO,INL,4))
+!
+IF (NRANK/=NPIO) THEN
+ !
+ IDX_I = IDX_I + 1
+#ifdef SFX_MPI
+ CALL MPI_SEND(INO,KIND(INO)/4,MPI_INTEGER,NPIO,IDX_I,NCOMM,INFOMPI)
+#endif
+ !
+ IDX_I = IDX_I + 1
+#ifdef SFX_MPI
+ CALL MPI_SEND(IJD,SIZE(IJD)*KIND(IJD)/4,MPI_INTEGER,NPIO,IDX_I,NCOMM,INFOMPI)
+#endif
+ !
+ IDX_I = IDX_I + 1
+#ifdef SFX_MPI
+ CALL MPI_RECV(ZFIELDIN,SIZE(ZFIELDIN)*KIND(ZFIELDIN)/4,MPI_REAL,NPIO,IDX_I,NCOMM,ISTATUS,INFOMPI)
+#endif
+ !
+ELSE
+ !
+ DO J=0,NPROC-1
+ !
+ IF (J/=NPIO) THEN
+#ifdef SFX_MPI
+ CALL MPI_RECV(ISIZE,KIND(ISIZE)/4,MPI_INTEGER,J,IDX_I+1,NCOMM,ISTATUS,INFOMPI)
+#endif
+ ALLOCATE(IJGET(ISIZE,INL,4))
+#ifdef SFX_MPI
+ CALL MPI_RECV(IJGET,SIZE(IJGET)*KIND(IJGET)/4,MPI_INTEGER,J,IDX_I+2,NCOMM,ISTATUS,INFOMPI)
+#endif
+ ELSE
+ ISIZE = INO
+ ALLOCATE(IJGET(ISIZE,INL,4))
+ IJGET(:,:,:) = IJD(:,:,:)
+ ENDIF
+ !
+ ALLOCATE(ZFGET(ISIZE,INL,4))
+ !
+ ZFGET(:,:,:) = 0.
+ DO JL = 1,INL
+ DO JI = 1,ISIZE
+ DO I = 1,4
+ ZFGET(JI,JL,I) = PFIELDIN(IJGET(JI,JL,I),JL)
+ ENDDO
+ ENDDO
ENDDO
-
!
- ! Bi linear
+ IF (J/=NPIO) THEN
+#ifdef SFX_MPI
+ CALL MPI_SEND(ZFGET,SIZE(ZFGET)*KIND(ZFGET)/4,MPI_REAL,J,IDX_I+3,NCOMM,INFOMPI)
+#endif
+ ELSE
+ ZFIELDIN(:,:,:) = ZFGET(:,:,:)
+ ENDIF
!
-
- WRITE(KLUOUT,*)'NRX,NRY',NRX,NRY
-
- DO IJ=1,INO
-
- K = II(IJ)
- L = JJ(IJ)
- IJ00 = k + NRX*(l -1)
- IJ01 = k + NRX*(l+1 -1)
- IJ10 = k+1 + NRX*(l -1)
- IJ11 = k+1 + NRX*(l+1 -1)
-
- WRITE(KLUOUT,*)PFIELDIN(IJ00,JL)
-
- PFIELDOUT(IJ,JL) = w00(IJ)*PFIELDIN(IJ00,JL) + &
- w01(IJ)*PFIELDIN(IJ01,JL) + &
- w10(IJ)*PFIELDIN(IJ10,JL) + &
- w11(IJ)*PFIELDIN(IJ11,JL)
-
- ENDDO
+ DEALLOCATE(IJGET,ZFGET)
+ !
+ ENDDO
+ !
+ IDX_I = IDX_I + 3
+ !
+ENDIF
+!
+DO JL = 1,INL
+ DO JI = 1,INO
+ !
+ DO I = 1,4
+ IF (ABS(ZFIELDIN(JI,JL,I)-XUNDEF)<1.E-6) ZW(JI,JL,I) = 0.
ENDDO
-
-
+ !
+ ZWSUM = ZW(JI,JL,1) + ZW(JI,JL,2) + ZW(JI,JL,3) + ZW(JI,JL,4)
+ !
+ IF ( ABS(ZWSUM)<1.E-6 ) THEN
+ ZW(JI,JL,1) = 1.
+ ELSE
+ DO I = 1,4
+ ZW(JI,JL,I) = ZW(JI,JL,I)/ZWSUM
+ ENDDO
+ ENDIF
+ !
+ PFIELDOUT(JI,JL) = ZW(JI,JL,1)*ZFIELDIN(JI,JL,1) + ZW(JI,JL,2)*ZFIELDIN(JI,JL,2) + &
+ ZW(JI,JL,3)*ZFIELDIN(JI,JL,3) + ZW(JI,JL,4)*ZFIELDIN(JI,JL,4)
+ !
+ ENDDO
+ENDDO
!
!* 5. Deallocations
-!
-DEALLOCATE(XRAT_OUT,XRON_OUT, &
- XLAT_IND,XLON_IND, &
- II,JJ, &
- W00,W01,W10,W11, &
- LMASK)
+DEALLOCATE(XRAT_OUT,XRON_OUT,XLAT_IND,XLON_IND,IJD,ZFIELDIN)
!
IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_ROTLATLON',1,ZHOOK_HANDLE)
+!
+CONTAINS
+!
+SUBROUTINE REGROT(PXREG,PYREG,PXROT,PYROT,PXCEN,PYCEN,KCALL)
+!
+USE MODD_CSTS, ONLY : XPI
+!
+USE MODI_ABOR1_SFX
+!
+IMPLICIT NONE
+!
+!-----------------------------------------------------------------------
+!
+!* CONVERSION BETWEEN REGULAR AND ROTATED SPHERICAL COORDINATES.
+!*
+!* PXREG LONGITUDES OF THE REGULAR COORDINATES
+!* PYREG LATITUDES OF THE REGULAR COORDINATES
+!* PXROT LONGITUDES OF THE ROTATED COORDINATES
+!* PYROT LATITUDES OF THE ROTATED COORDINATES
+!* ALL COORDINATES GIVEN IN DEGREES N (NEGATIVE FOR S)
+!* AND DEGREES E (NEGATIVE VALUES FOR W)
+!* KXDIM DIMENSION OF THE GRIDPOINT FIELDS IN THE X-DIRECTION
+!* KYDIM DIMENSION OF THE GRIDPOINT FIELDS IN THE Y-DIRECTION
+!* KX NUMBER OF GRIDPOINT IN THE X-DIRECTION
+!* KY NUMBER OF GRIDPOINTS IN THE Y-DIRECTION
+!* PXCEN REGULAR LONGITUDE OF THE SOUTH POLE OF THE ROTATED GRID
+!* PYCEN REGULAR LATITUDE OF THE SOUTH POLE OF THE ROTATED GRID
+!*
+!* KCALL=-1: FIND REGULAR AS FUNCTIONS OF ROTATED COORDINATES.
+!* KCALL= 1: FIND ROTATED AS FUNCTIONS OF REGULAR COORDINATES.
+!*
+!* J.E. HAUGEN HIRLAM JUNE -92
+!
+!-----------------------------------------------------------------------
+!
+INTEGER, INTENT(IN) :: KCALL
+REAL, INTENT(IN) :: PXCEN,PYCEN
+REAL, DIMENSION(:), INTENT(INOUT) :: PXREG, PYREG
+REAL, DIMENSION(:), INTENT(INOUT) :: PXROT, PYROT
+!
+!-----------------------------------------------------------------------
+!
+REAL :: ZRAD,ZSYCEN,ZCYCEN,ZXMXC,ZSXMXC,ZCXMXC,ZSYREG,ZCYREG, &
+ ZSYROT,ZCYROT,ZCXROT,ZSXROT,ZRADI
+INTEGER :: JI, ISIZE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-----------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('REGROT',0,ZHOOK_HANDLE)
+!
+ISIZE = SIZE(PXREG)
+!
+ZRAD = XPI/180.
+ZRADI = 1./ZRAD
+ZSYCEN = SIN(ZRAD*(PYCEN+90.))
+ZCYCEN = COS(ZRAD*(PYCEN+90.))
+!
+IF (KCALL.EQ.1) THEN
+ !
+ DO JI = 1,ISIZE
+ !
+ ZXMXC = ZRAD*(PXREG(JI) - PXCEN)
+ ZSXMXC = SIN(ZXMXC)
+ ZCXMXC = COS(ZXMXC)
+ !
+ ZSYREG = SIN(ZRAD*PYREG(JI))
+ ZCYREG = COS(ZRAD*PYREG(JI))
+ !
+ ZSYROT = ZCYCEN*ZSYREG - ZSYCEN*ZCYREG*ZCXMXC
+ ZSYROT = MIN(MAX(ZSYROT,-1.0),+1.0)
+ !
+ PYROT(JI) = ASIN(ZSYROT)*ZRADI
+ !
+ ZCYROT = COS(ZRAD*PYROT(JI))
+ ZCXROT = (ZCYCEN*ZCYREG*ZCXMXC + ZSYCEN*ZSYREG)/ZCYROT
+ ZCXROT = MIN(MAX(ZCXROT,-1.0),+1.0)
+ ZSXROT = ZCYREG*ZSXMXC/ZCYROT
+ !
+ PXROT(JI) = ACOS(ZCXROT)*ZRADI
+ !
+ IF (ZSXROT.LT.0.0) PXROT(JI) = -PXROT(JI)
+ !
+ ENDDO
+ !
+ELSEIF (KCALL.EQ.-1) THEN
+ !
+ DO JI = 1,ISIZE
+ !
+ ZSXROT = SIN(ZRAD*PXROT(JI))
+ ZCXROT = COS(ZRAD*PXROT(JI))
+ ZSYROT = SIN(ZRAD*PYROT(JI))
+ ZCYROT = COS(ZRAD*PYROT(JI))
+ !
+ ZSYREG = ZCYCEN*ZSYROT + ZSYCEN*ZCYROT*ZCXROT
+ ZSYREG = MAX(ZSYREG,-1.0)
+ ZSYREG = MIN(ZSYREG,+1.0)
+ !
+ PYREG(JI) = ASIN(ZSYREG)*ZRADI
+ !
+ ZCYREG = COS(PYREG(JI)*ZRAD)
+ !
+ ZCXMXC = (ZCYCEN*ZCYROT*ZCXROT - ZSYCEN*ZSYROT)/ZCYREG
+ ZCXMXC = MAX(ZCXMXC,-1.0)
+ ZCXMXC = MIN(ZCXMXC,+1.0)
+ ZSXMXC = ZCYROT*ZSXROT/ZCYREG
+ ZXMXC = ACOS(ZCXMXC)*ZRADI
+ IF (ZSXMXC.LT.0.0) ZXMXC = -ZXMXC
+ !
+ PXREG(JI) = ZXMXC + PXCEN
+ !
+ ENDDO
+ !
+ELSE
+ !
+ WRITE(6,'(1X,''INVALID KCALL IN REGROT'')')
+ CALL ABOR1_SFX('HOR_INTERPOL_ROTLATON:REGROT:KCALL MUST BE 1 OR -1')
+ !
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('REGROT',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE REGROT
+!
!-------------------------------------------------------------------------------------
END SUBROUTINE HOR_INTERPOL_ROTLATLON
diff --git a/src/SURFEX/hor_interpol_rotlatlon_1cov.F90 b/src/SURFEX/hor_interpol_rotlatlon_1cov.F90
deleted file mode 100644
index 6d32cd88647fd39fa3f70512d7841b322d4b7582..0000000000000000000000000000000000000000
--- a/src/SURFEX/hor_interpol_rotlatlon_1cov.F90
+++ /dev/null
@@ -1,187 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE HOR_INTERPOL_ROTLATLON_1COV(KLUOUT,PFIELDIN,PFIELDOUT)
-! #################################################################################
-!
-!!**** *HOR_INTERPOL_ROTLATLON_1COV * - Interpolation from a rotated lat/lon grid
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! M.Moge (adapted from HOR_INTERPOL_ROTLATLON)
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 06/2015
-!!------------------------------------------------------------------
-!
-!
-!
-USE MODD_PREP, ONLY : XLAT_OUT, XLON_OUT
-USE MODD_GRID_ROTLATLON
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_GRID_GRIB, ONLY : NNI
-!
-!RJ: missing modi
-USE MODI_REGROT_LONLAT_ROT
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
-REAL, DIMENSION(:), INTENT(IN) :: PFIELDIN ! field to interpolate horizontally
-REAL, DIMENSION(:), INTENT(OUT) :: PFIELDOUT ! interpolated field
-!
-!* 0.2 declarations of local variables
-!
-
- INTEGER, ALLOCATABLE :: ii(:),jj(:)
-
- REAL, ALLOCATABLE :: XLAT_IND(:),XLON_IND(:), &
- XRAT_OUT(:),XRON_OUT(:), &
- w00(:),w01(:), &
- w10(:),w11(:)
-
- LOGICAL, ALLOCATABLE :: LMASK(:)
-
-INTEGER :: I,J,K,L,IJ,IJ00,IJ01,IJ10,IJ11,INO,JL
-REAL :: WX,WY,WSUM
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_ROTLATLON_1COV',0,ZHOOK_HANDLE)
-WRITE(KLUOUT,'(A)')' | Running rotated latlon interpolation'
-
-INO = SIZE(XLAT_OUT)
-
-!
-!* 1. Allocations
-!
-ALLOCATE(XRAT_OUT(INO), &
- XRON_OUT(INO), &
- XLAT_IND(INO), &
- XLON_IND(INO), &
- II(INO), &
- JJ(INO), &
- W00(INO), &
- W01(INO), &
- W10(INO), &
- W11(INO))
-
-ALLOCATE(LMASK(NNI))
-!
-!* Transformation of latitudes/longitudes into rotated coordinates
-
- WRITE(KLUOUT,*)'XLAT_OUT',XLAT_OUT(10:10)
- WRITE(KLUOUT,*)'XLON_OUT',XLON_OUT(10:10)
-
- CALL REGROT_LONLAT_ROT(XLON_OUT,XLAT_OUT, &
- XRON_OUT,XRAT_OUT, &
- INO,1,INO,1, &
- XRLOP,XRLAP,1 )
-
- WRITE(KLUOUT,*)'XRAT_OUT',XRAT_OUT(10:10)
- WRITE(KLUOUT,*)'XRON_OUT',XRON_OUT(10:10)
-
- DO IJ=1,INO
- XLAT_IND(IJ) = ( XRAT_OUT(IJ) - XRILA1) / XRDY + 1.
- XLON_IND(IJ) = ( XRON_OUT(IJ) - XRILO1) / XRDX + 1.
- ENDDO
-
- PFIELDOUT(:) = XUNDEF
-
-
- LMASK= .TRUE.
- WHERE ( ABS(PFIELDIN(:)-XUNDEF) < 1.e-6 ) LMASK = .FALSE.
-
- DO IJ=1,INO
-
- II(IJ) = INT(XLON_IND(IJ))
- JJ(IJ) = INT(XLAT_IND(IJ))
-
- WX = XLON_IND(IJ) - FLOAT(II(IJ))
- WY = XLAT_IND(IJ) - FLOAT(JJ(IJ))
-
- W00(IJ) = (1.-WX)*(1.-WY)
- W01(IJ) = (1.-WX)* WY
- W10(IJ) = WX *(1.-WY)
- W11(IJ) = WX * WY
-
- K = II(IJ)
- L = JJ(IJ)
- IJ00 = k + NRX*(l -1)
- IJ01 = k + NRX*(l+1 -1)
- IJ10 = k+1 + NRX*(l -1)
- IJ11 = k+1 + NRX*(l+1 -1)
-
- IF (.NOT. LMASK(IJ00)) w00(IJ) = 0.
- IF (.NOT. LMASK(IJ01)) w01(IJ) = 0.
- IF (.NOT. LMASK(IJ10)) w10(IJ) = 0.
- IF (.NOT. LMASK(IJ11)) w11(IJ) = 0.
-
- wsum = w00(IJ) + w01(IJ) + &
- w10(IJ) + w11(IJ)
-
- IF ( ABS(wsum) < 1.e-6 ) CYCLE
-
- w00(IJ) = w00(IJ) / wsum
- w01(IJ) = w01(IJ) / wsum
- w10(IJ) = w10(IJ) / wsum
- w11(IJ) = w11(IJ) / wsum
-
- ENDDO
-
- !
- ! Bi linear
- !
-
- WRITE(KLUOUT,*)'NRX,NRY',NRX,NRY
-
- DO IJ=1,INO
-
- K = II(IJ)
- L = JJ(IJ)
- IJ00 = k + NRX*(l -1)
- IJ01 = k + NRX*(l+1 -1)
- IJ10 = k+1 + NRX*(l -1)
- IJ11 = k+1 + NRX*(l+1 -1)
-
- WRITE(KLUOUT,*)PFIELDIN(IJ00)
-
- PFIELDOUT(IJ) = w00(IJ)*PFIELDIN(IJ00) + &
- w01(IJ)*PFIELDIN(IJ01) + &
- w10(IJ)*PFIELDIN(IJ10) + &
- w11(IJ)*PFIELDIN(IJ11)
-
- ENDDO
-
-
-!
-!* 5. Deallocations
-!
-DEALLOCATE(XRAT_OUT,XRON_OUT, &
- XLAT_IND,XLON_IND, &
- II,JJ, &
- W00,W01,W10,W11, &
- LMASK)
-!
-IF (LHOOK) CALL DR_HOOK('HOR_INTERPOL_ROTLATLON_1COV',1,ZHOOK_HANDLE)
-!-------------------------------------------------------------------------------------
-END SUBROUTINE HOR_INTERPOL_ROTLATLON_1COV
diff --git a/src/SURFEX/horibl_surf.F90 b/src/SURFEX/horibl_surf.F90
deleted file mode 100644
index 83726943437b3e2f3ca3aa0a1366200c479e431d..0000000000000000000000000000000000000000
--- a/src/SURFEX/horibl_surf.F90
+++ /dev/null
@@ -1,816 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE HORIBL_SURF(PILA1,PILO1,PILA2,PILO2,KINLA,KINLO,KILEN,PARIN, &
- KOLEN,PXOUT,PYOUT,PAROUT,ODVECT,KLUOUT,OINTERP, &
- KLSMIN,KLSMOUT )
-! ###########################################################################
-!
-!!**** *HORIBL_SURF* - horitontal bilinear interpolation
-!!
-!! PURPOSE
-!! -------
-!!
-!! Interpolates a field, supports masks.
-!!
-!! METHOD
-!! ------
-!!
-!! This routine performs a bilinear interpolation based on the 12 surrounding
-!! points. It begins with an interpolation along the latitudes (with third order
-!! polynoms interpolation with 4 points and linear interpolation for 2 points)
-!! and then a second along the longitude (third order polynoms interpolation).
-!! Two interpolations are performed : first along the parallels then between the
-!! four resulting points.
-!!
-!! The disposition of the points is the following :
-!!
-!!
-!! N 1 2
-!!
-!! ^ 3 4 5 6
-!! | x
-!! | 7 8 9 10
-!! |
-!! 11 12
-!! S
-!! W ---------------> E
-!!
-!! Note : the name 'south', 'north', may not be exact if the last data point is
-!! to the south of first (delta latitude < 0). This does not affect computations.
-!!
-!! The formula used to compute the weight is :
-!! (Lon - Lon.i) . (Lon - Lon.i) . (Lon - Lon.i)
-!! Wi = ---------------------------------------------------
-!! (Lon.i - Lon.j) . (Lon.i - Lon.k) . (Lon.i - Lon.l)
-!! Where j,k,l are the other points of the line.
-!!
-!! When masks are used, points with different types than the output points are
-!! not taken in account (in the formula, the corresponding coefficient is set
-!! to 1). If no points of the same nature are available, the interpolation is
-!! performed anyway with the 12 points. It is the task of the calling program
-!! to react to this situation.
-!!
-!! When the inputs parameters define a circular map (or global), the inputs data
-!! are extended. The value of the parameter ODVECT is used to know if the datas
-!! are vectorial or scalar (this affects the sign of extended values).
-!!
-!! EXTERNAL
-!! --------
-!!
-!! subroutine FMLOOK_ll : to retrieve the logical unit number of the listing file
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! This routine is based on the one used by the software FULL-POS from Meteo France.
-!! More informations may be found in 'Book 1'
-!!
-!! AUTHOR
-!! ------
-!!
-!! J.Pettre & V.Bousquet
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!! Original 07/01/1999
-!! 21/04/1999 (V. Masson) set correct prefixes and bug in
-!! a logical definition
-!! 21/04/1999 (V. Masson) bug in north and south poles
-!! extension for input map land-sea mask
-!! 27/05/1999 (V. Masson) bug in 'grib south pole'
-!! extrapolation (number of point per parallel)
-!! 27/05/1999 (V. Masson) bug in 'grib pole' extrapolation
-!! extra latitudes are now computed symetrically
-!! to the poles.
-!! 17/03/2010 (P. LeMoigne) bug in weights computations
-!! 16/06/2010 (G. Tanguy) bug in 'grib north pole"
-!! extrapolation (tabular ZARIN not totaly filled)
-!!
-!------------------------------------------------------------------------------
-!
-!
-!* 0. DECLARATIONS
-! ---------------
-!
-USE MODI_HOR_EXTRAPOL_SURF
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODI_ABOR1_SFX
-!
-IMPLICIT NONE
-!
-!* 0.1. Declaration of arguments
-!
-REAL, INTENT(IN) :: PILA1 ! Lat. (y) of first input point KDGSA
-REAL, INTENT(IN) :: PILO1 ! Lon. (x) of first input point
-REAL, INTENT(IN) :: PILA2 ! Lat. (y) of last input point KDGEN
-REAL, INTENT(IN) :: PILO2 ! Lon. (x) of last input point
-INTEGER, INTENT(IN) :: KINLA ! Number of parallels
-INTEGER, DIMENSION(KINLA), INTENT(IN) :: KINLO ! Number of point along a parallel
-INTEGER, INTENT(IN) :: KILEN ! size of input arrays
-REAL, DIMENSION(KILEN), INTENT(IN) :: PARIN ! input array
-INTEGER, INTENT(IN) :: KOLEN ! size of output array
-REAL, DIMENSION(KOLEN), INTENT(IN) :: PXOUT ! X (lon.) of output points
-REAL, DIMENSION(KOLEN), INTENT(IN) :: PYOUT ! Y (lat.) of output points
-REAL, DIMENSION(KOLEN), INTENT(OUT) :: PAROUT ! output array
-LOGICAL, DIMENSION(KOLEN), INTENT(IN) :: OINTERP ! .true. where physical value is needed
-LOGICAL, INTENT(IN) :: ODVECT ! data is vectorial (True/False)
-INTEGER, INTENT(IN) :: KLUOUT ! output listing logical unit
-INTEGER, DIMENSION(KILEN), INTENT(IN), OPTIONAL :: KLSMIN ! input land/sea mask
-INTEGER, DIMENSION(KOLEN), INTENT(IN), OPTIONAL :: KLSMOUT ! output land/sea mask
-!
-!* 0.2. Declaration of local variables
-!
- ! Variables used to perform the interpolation
-REAL :: ZOLA ! Latitude of the output point
-REAL :: ZOLO ! Longitude of the output point
-REAL :: ZIDLA ! Delta latitude
-REAL :: ZIDLO ! Delta longitude
-INTEGER, DIMENSION(:), ALLOCATABLE :: IOFS ! Offset of each parallel in the array
- ! Number of the surrounding latitudes
-INTEGER :: IOSS,IOS,ION,IONN
- ! Posiiton in the array of the twelwe surrounding points
-INTEGER :: IP1,IP2,IP3,IP4,IP5,IP6,IP7,IP8,IP9,IP10, &
- IP11,IP12
- ! Latitudes and longitudes of the surrounding points
-REAL :: ZLANN,ZLAN,ZLAS,ZLASS
-REAL :: ZLOP1,ZLOP2,ZLOP3,ZLOP4 ,ZLOP5 ,ZLOP6, &
- ZLOP7,ZLOP8,ZLOP9,ZLOP10,ZLOP11,ZLOP12
- ! Weights of the latitudes and of the points
-REAL :: ZWNN,ZWN,ZWS,ZWSS
-REAL :: ZW1,ZW2,ZW3,ZW4,ZW5,ZW6,ZW7,ZW8,ZW9,ZW10, &
- ZW11,ZW12
- ! Land/sea mask coefficient for each point : 0 -> point not taken in account,
- ! 1 -> point taken in account
-REAL :: ZLSM1,ZLSM2 ,ZLSM3 ,ZLSM4 ,ZLSM5 ,ZLSM6,ZLSM7,ZLSM8, &
- ZLSM9,ZLSM10,ZLSM11,ZLSM12,ZLSMNN,ZLSMN,ZLSMS,ZLSMSS,&
- ZLSMTOT
- ! Variables implied in the extension procedure
-REAL :: ZILO1 ! Longitude of the first data point
-REAL :: ZILO2 ! Longitude of the last data point
-LOGICAL :: GGLOBLON ! True if the map is circular
-LOGICAL :: GGLOBN ! True if the map has the north pole
-LOGICAL :: GGLOBS ! True if the map has the south pole
-INTEGER :: IBIGSIZE ! Size of the extended map
-INTEGER :: IMIDDLE ! Used for extensions around the poles
-INTEGER :: IOFFSET1 ! Offset in map
-INTEGER :: IOFFSET2 ! Offset in map
-REAL :: ZSOUTHPOLE! south pole latitude (-90 or 90)
-REAL :: ZNORTHPOLE! north pole latitude ( 90 or -90)
-REAL, DIMENSION(:), ALLOCATABLE :: ZLA ! input "latitude" coordinate
-REAL, DIMENSION(:), ALLOCATABLE :: ZLO ! input "longitude" coordinate
-REAL, DIMENSION(:), ALLOCATABLE :: ZARIN ! Extended input datas
-INTEGER, DIMENSION(:), ALLOCATABLE :: ILSMIN ! Extended land/sea mask
-INTEGER, DIMENSION(:), ALLOCATABLE :: IINLO ! Extended KINLO
-INTEGER :: IINLA ! Number of parallel
-REAL :: ZVECT ! -1 if input is vectorial
-LOGICAL :: LDLSM ! Specify if land/sea mask is present or not
- ! Loop counters
-INTEGER :: JOPOS ! Output position
-INTEGER :: JIPOS ! Input position
-INTEGER :: JLOOP1 ! Dummy counter
-!
-!
-!------------------------------------------------------------------------------
-REAL :: ZMAX ! Max of 12 surrounding values
-REAL :: ZMIN ! Min of 12 surrounding values
-INTEGER :: JLOOP2 ! Dummy counter
-INTEGER, DIMENSION(12) :: IP ! Array for IPn
-INTEGER :: JLAT ! latitude loop counter
-INTEGER :: JLON ! longitude loop counter
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!------------------------------------------------------------------------------
-!
-!* 1. DETERMINATION of the latitude of the poles (depending of the latitude
-! ------------- of the first data point)
-!
-IF (LHOOK) CALL DR_HOOK('HORIBL_SURF',0,ZHOOK_HANDLE)
-IF (PILA1>0.) THEN
- ZSOUTHPOLE= 90.
- ZNORTHPOLE=-90.
-ELSE
- ZSOUTHPOLE=-90.
- ZNORTHPOLE= 90.
-END IF
-!
-!------------------------------------------------------------------------------
-!
-!* 2. EXTEND DATA GRID
-! ----------------
- ! Land / Sea mask
-LDLSM = .FALSE.
-IF (PRESENT(KLSMIN) .AND. PRESENT(KLSMOUT)) LDLSM = .TRUE.
-!
-!* 2.1 Alias input data
-!
-ZILO1 = PILO1
-ZILO2 = PILO2
-ZVECT = 1.
-IF (ODVECT) ZVECT=-1.
-!
-!* 2.2 Center input domain in order to have Lo1 < Lo 2
-!
-IF (ZILO2 < 0.) ZILO2 = ZILO2 + 360.
-IF (ZILO1 < 0.) ZILO1 = ZILO1 + 360.
-IF (ZILO2 < ZILO1) ZILO1 = ZILO1 - 360.
-!
-!* 2.3 Extend one point (needed for reduced grids)
-!
-! Longitude coordinate of points are found by :
-! i
-! Lon(i) = Lon1 + ------------- . (Lon2 - Lon1)
-! Npts(Lat)-1
-! Where i goes from 0 to Npts(Lat)-1. The result of this is that the last point of
-! each parallel is located at Lon2. This is not the case for reduced grid where the
-! position of the last point depends upon the number of points of the parallel. For
-! reduced grid, the right formula to use is the following :
-! i
-! Lon(i) = Lon1 + ----------- . (Lon2' - Lon1)
-! Npts(Lat)
-! Where Lon2' = Lon1 + 2.PI.
-!
-! Lon2 - Lon1
-! This can be generalized with Lon2' = Lon2 + -------------
-! Nptsmax - 1
-!
-JOPOS = MAXVAL(KINLO(1:KINLA))
-ZILO2 = ZILO1 + (ZILO2 - ZILO1) * JOPOS / (JOPOS - 1.)
-!
-!
-!* 2.4 Test if the input is global or partially global
-!
-! Note that we must have a global map to make extension around the poles
-GGLOBN = .FALSE.
-GGLOBS = .FALSE.
-GGLOBLON = .FALSE.
-IF (ZILO2-360.>ZILO1-1.E-3) GGLOBLON = .TRUE.
-ZIDLA = (PILA2 - PILA1) / (KINLA - 1)
-IF ((PILA1-ZIDLA>= 90.) .OR. (PILA1-ZIDLA<=-90.)) GGLOBS=GGLOBLON
-IF ((PILA2+ZIDLA>= 90.) .OR. (PILA2+ZIDLA<=-90.)) GGLOBN=GGLOBLON
-! Aladin case (input PILA2, PILO2 are in meters) no extension
-IF ( PILA2 > 100. ) THEN
- GGLOBN = .FALSE.
- GGLOBS = .FALSE.
- GGLOBLON = .FALSE.
-END IF
-!
-!
-!* 2.5 Compute the size of the resulting map
-!
-IBIGSIZE = KILEN
-IF (GGLOBS ) IBIGSIZE=IBIGSIZE+(4+KINLO( 1))+(4+KINLO( 2))
-IF (GGLOBN ) IBIGSIZE=IBIGSIZE+(4+KINLO(KINLA))+(4+KINLO(KINLA-1))
-IF (GGLOBLON) IBIGSIZE=IBIGSIZE+ 4*KINLA
-!
-!* 2.6 Compute the resulting map
-!
-ALLOCATE (ZARIN(IBIGSIZE))
-ALLOCATE (ILSMIN(IBIGSIZE))
-!
-! 2.6.1 Compute the longitude extension
-!
-! This is a basic copy of the data. If extension is possible, the first and last
-! two lines are copied twice this way :
-!
-! /---------------\
-! | |
-! [.] [.] [.... ...] [.] [.]
-! | |
-! \------------/
-!
-! A point represent a data.
-!
-JIPOS = 1
-JOPOS = 1
-IF (GGLOBS) JOPOS=JOPOS+(4+KINLO(1))+(4+KINLO(2))
-IF (GGLOBLON) THEN
- DO JLOOP1 = 1, KINLA
- ZARIN(JOPOS ) = PARIN(JIPOS+KINLO(JLOOP1)-2)
- ZARIN(JOPOS+1) = PARIN(JIPOS+KINLO(JLOOP1)-1)
- ZARIN(JOPOS+2:JOPOS+2+KINLO(JLOOP1)-1) = PARIN(JIPOS:JIPOS+KINLO(JLOOP1)-1)
- ZARIN(JOPOS+2+KINLO(JLOOP1) ) = PARIN(JIPOS )
- ZARIN(JOPOS+2+KINLO(JLOOP1)+1) = PARIN(JIPOS+1)
- IF (LDLSM) THEN
- ILSMIN(JOPOS ) = KLSMIN(JIPOS+KINLO(JLOOP1)-2)
- ILSMIN(JOPOS+1) = KLSMIN(JIPOS+KINLO(JLOOP1)-1)
- ILSMIN(JOPOS+2:JOPOS+2+KINLO(JLOOP1)-1) = KLSMIN(JIPOS:JIPOS+KINLO(JLOOP1)-1)
- ILSMIN(JOPOS+2+KINLO(JLOOP1) ) = KLSMIN(JIPOS )
- ILSMIN(JOPOS+2+KINLO(JLOOP1)+1) = KLSMIN(JIPOS+1)
- END IF
- JIPOS = JIPOS + KINLO(JLOOP1)
- JOPOS = JOPOS + KINLO(JLOOP1) + 4
- END DO
-ELSE
- ZARIN(JOPOS:JOPOS+KILEN-1) = PARIN(JIPOS:JIPOS+KILEN-1)
- IF (LDLSM) THEN
- ILSMIN(JOPOS:JOPOS+KILEN-1) = KLSMIN(JIPOS:JIPOS+KILEN-1)
- END IF
-END IF
-!
-! 2.6.2 Compute the south pole extension
-!
-! Pole extension is performed by copying the first half datas to the last half
-! datas of the extension parallel :
-!
-! [.] [.] [....] [....] [.] [.]
-! ||||
-! /-------/
-! ||||
-! [.] [.] [....] [....] [.] [.]
-!
-IF (GGLOBS) THEN ! South pole (south meaning begining of the grib)
- IOFFSET1 = 4 + KINLO(2)
- IOFFSET2 = IOFFSET1 + 4 + KINLO(1)
- IMIDDLE = (KINLO(1)+4) / 2
- ZARIN(IOFFSET1+1:IOFFSET1+IMIDDLE) = &
- ZVECT*ZARIN(IOFFSET2+1+IMIDDLE-2:IOFFSET2+2*IMIDDLE-2)
- ZARIN(IOFFSET1+IMIDDLE+1:IOFFSET1+KINLO(1)+4) = &
- ZVECT*ZARIN(IOFFSET2+1+2:IOFFSET2+KINLO(1)+4-IMIDDLE+2)
- IF (LDLSM) THEN
- ILSMIN(IOFFSET1+1:IOFFSET1+IMIDDLE) = &
- ILSMIN(IOFFSET2+1+IMIDDLE-2:IOFFSET2+2*IMIDDLE-2)
- ILSMIN(IOFFSET1+IMIDDLE+1:IOFFSET1+KINLO(1)+4) = &
- ILSMIN(IOFFSET2+1+2:IOFFSET2+KINLO(1)+4-IMIDDLE+2)
- END IF
- IOFFSET2 = IOFFSET2 + 4 + KINLO(1)
- IMIDDLE = (KINLO(2)+4) / 2
- ZARIN(1:IMIDDLE) = ZVECT*ZARIN(IOFFSET2+1+IMIDDLE-2:IOFFSET2+2*IMIDDLE-2)
- ZARIN(IMIDDLE+1:KINLO(2)+4) = &
- ZVECT*ZARIN(IOFFSET2+1+2:IOFFSET2+KINLO(2)+4-IMIDDLE+2)
- IF (LDLSM) THEN
- ILSMIN(1:IMIDDLE) = ILSMIN(IOFFSET2+1+IMIDDLE:IOFFSET2+2*IMIDDLE)
- ILSMIN(IMIDDLE+1:KINLO(2)+4) = ILSMIN(IOFFSET2+1+2:IOFFSET2+KINLO(2)+4-IMIDDLE+2)
- END IF
-END IF
-!
-! 2.6.3 Compute the north pole extension
-!
-IF (GGLOBN) THEN ! North pole (north meaning end of the grib)
- IOFFSET1 = IBIGSIZE - (4+KINLO(KINLA-1)) - (4+KINLO(KINLA))
- IOFFSET2 = IOFFSET1 - (4+KINLO(KINLA))
- IMIDDLE = (KINLO(KINLA)+4) / 2
- ZARIN(IOFFSET1+1:IOFFSET1+IMIDDLE) = &
- ZVECT*ZARIN(IOFFSET2+1+IMIDDLE-2:IOFFSET2+2*IMIDDLE-2)
- ZARIN(IOFFSET1+IMIDDLE+1:IOFFSET1+KINLO(KINLA)+4) = &
- ZVECT*ZARIN(IOFFSET2+1+2:IOFFSET2+KINLO(KINLA)+4-IMIDDLE+2)
- IF (LDLSM) THEN
- ILSMIN(IOFFSET1+1:IOFFSET1+IMIDDLE) = &
- ILSMIN(IOFFSET2+1+IMIDDLE-2:IOFFSET2+2*IMIDDLE-2)
- ILSMIN(IOFFSET1+IMIDDLE+1:IOFFSET1+KINLO(KINLA)+4) = &
- ILSMIN(IOFFSET2+1+2:IOFFSET2+KINLO(KINLA)+4-IMIDDLE+2)
- END IF
- IOFFSET1 = IOFFSET1 + (4+KINLO(KINLA))
- IOFFSET2 = IOFFSET2 - (4+KINLO(KINLA-1))
- IMIDDLE = (KINLO(KINLA-1)+4) / 2
- ZARIN(IOFFSET1+1:IOFFSET1+IMIDDLE) = &
- ZVECT*ZARIN(IOFFSET2+1+IMIDDLE-2:IOFFSET2+2*IMIDDLE-2)
- ZARIN(IOFFSET1+IMIDDLE+1:IOFFSET1+KINLO(KINLA-1)+4) = &
- ZVECT*ZARIN(IOFFSET2+1+2:IOFFSET2+KINLO(KINLA-1)+4-IMIDDLE+2)
- IF (LDLSM) THEN
- ILSMIN(IOFFSET1+1:IOFFSET1+IMIDDLE) = &
- ILSMIN(IOFFSET2+1+IMIDDLE-2:IOFFSET2+2*IMIDDLE-2)
- ILSMIN(IOFFSET1+IMIDDLE+1:IOFFSET1+KINLO(KINLA-1)+4) = &
- ILSMIN(IOFFSET2+1+2:IOFFSET2+KINLO(KINLA-1)+4-IMIDDLE+2)
- END IF
-END IF
-!
-!* 2.7 Compute the resulting parameters of the map
-!
-IINLA = KINLA
-IF (GGLOBS) IINLA = IINLA + 2
-IF (GGLOBN) IINLA = IINLA + 2
-!
-ALLOCATE (IINLO(IINLA))
-IOFFSET1 = 0
-IF (GGLOBS) THEN
- IINLO(IOFFSET1+1) = KINLO(2)
- IINLO(IOFFSET1+2) = KINLO(1)
- IOFFSET1 = IOFFSET1 + 2
-END IF
-IINLO(IOFFSET1+1:IOFFSET1+KINLA) = KINLO(1:KINLA)
-IOFFSET1 = IOFFSET1 + KINLA
-IF (GGLOBN) THEN
- IINLO(IOFFSET1+1) = KINLO(KINLA)
- IINLO(IOFFSET1+2) = KINLO(KINLA-1)
- IOFFSET1 = IOFFSET1 + 2
-END IF
-!
-!* 2.8 Compute Offset array used to acces the lines
-!
-ALLOCATE (IOFS(IINLA))
-IOFS(1) = 1
-IF (GGLOBLON) IOFS(1)=IOFS(1)+2
-DO JLOOP1=2, IINLA
- IOFS(JLOOP1) = IOFS(JLOOP1-1) + IINLO(JLOOP1-1)
- IF (GGLOBLON) IOFS(JLOOP1) = IOFS(JLOOP1) + 4
-END DO
-!
-!------------------------------------------------------------------------------
-!
-!* 3. LOOP OVER ALL THE POINTS OF THE OUTPUT GRID
-! -------------------------------------------
-!
-PAROUT(:) = XUNDEF
-!
-JOPOS = 0
-DO JLOOP1 = 1, KOLEN
- JOPOS = JOPOS + 1
- IF (.NOT. OINTERP(JOPOS)) CYCLE
- ZOLA = PYOUT(JOPOS)
- ZOLO = PXOUT(JOPOS)
- IF (ZOLO < ZILO1) ZOLO = ZOLO + 360.
- IF (ZOLO > ZILO2) ZOLO = ZOLO - 360.
-!
-!* 3.1 Locate the 12 input points around the interpolated output point
-!*
-!* N 1 2
-!*
-!* ^ 3 4 5 6
-!* | x
-!* | 7 8 9 10
-!* |
-!* 11 12
-!* S
-!* W ---------------> E
-!*
-!* Note : the name 'south', 'north', may not be exact if the point 2 is
-!* to the south of point 1 (IDLA < 0). This does not affect computation.
-!
- ! 3.1.1. find positions of latitudes
- IOS = NINT( (ZOLA-PILA1)/ZIDLA -0.5) ! because of the zero
- IF ( IOS<-1 ) THEN
- CALL ABOR1_SFX('HORIBLE_SURF: INPUT DOMAIN SMALLER THAN OUTPUT ONE - LATITUDE')
- END IF
- ZLAS = PILA1 + IOS * ZIDLA
- IOS = IOS + 1
- IF (GGLOBS) THEN
- IOS = IOS + 2
- IOSS = IOS - 1
- ION = IOS + 1
- IONN = ION + 1
- ELSE
- IOSS = MAX(IOS - 1,1)
- ION = MIN(IOS + 1,IINLA)
- IONN = MIN(ION + 1,IINLA)
- IOS = MAX(IOS, 1)
- ENDIF
- ZLASS = ZLAS - ZIDLA
- ZLAN = ZLAS + ZIDLA
- ZLANN = ZLAN + ZIDLA
- !
- ! extra latitudes are computed symetrically compared to the poles
- !
- IF (GGLOBS .AND. IOS==2) THEN
- ZLASS = 2. * ZSOUTHPOLE - ZLANN
- ZLAS = 2. * ZSOUTHPOLE - ZLAN
- END IF
- IF (GGLOBS .AND. IOS==3) THEN
- ZLASS = 2. * ZSOUTHPOLE - ZLAS
- END IF
- IF (GGLOBN .AND. IOS==IINLA-2) THEN
- ZLANN = 2. * ZNORTHPOLE - ZLASS
- ZLAN = 2. * ZNORTHPOLE - ZLAS
- END IF
- IF (GGLOBN .AND. IOS==IINLA-3) THEN
- ZLANN = 2. * ZNORTHPOLE - ZLAN
- END IF
-!
- IF ((IOSS<1).OR.(IONN>IINLA).OR. &
- (IOSS<1).OR.(IONN>IINLA)) THEN
- CALL ABOR1_SFX('HORIBLE_SURF: INPUT DOMAIN SMALLER THAN OUTPUT ONE - LATITUDE')
- END IF
-!
- ! 3.1.2. northern
- ZIDLO = (ZILO2 - ZILO1) / (IINLO(IONN))
- IP1 = INT((ZOLO - ZILO1) / ZIDLO)
- IF (GGLOBLON) THEN
- IP2 = IP1 + 1
- ELSE
- IP2 = MIN(IINLO(IONN)-1, IP1+1)
- ENDIF
- ZLOP1 = ZILO1 + IP1 * ZIDLO
- ZLOP2 = ZLOP1 + ZIDLO
-!
- ! 3.1.3. north
- ZIDLO = (ZILO2 - ZILO1) / (IINLO(ION ))
- IP4 = INT((ZOLO - ZILO1) / ZIDLO)
- IF (GGLOBLON) THEN
- IP3 = IP4 - 1
- IP5 = IP4 + 1
- IP6 = IP5 + 1
- ELSE
- IP3 = MAX(0,IP4-1)
- IP5 = MIN(IINLO(ION)-1,IP4+1)
- IP6 = MIN(IINLO(ION)-1,IP5+1)
- ENDIF
- ZLOP4 = ZILO1 + IP4 * ZIDLO
- ZLOP3 = ZLOP4 - ZIDLO
- ZLOP5 = ZLOP4 + ZIDLO
- ZLOP6 = ZLOP5 + ZIDLO
-!
- ! 3.1.4. south
- ZIDLO = (ZILO2 - ZILO1) / (IINLO(IOS ))
- IP8 = INT((ZOLO - ZILO1) / ZIDLO)
- IF (GGLOBLON) THEN
- IP7 = IP8 - 1
- IP9 = IP8 + 1
- IP10 = IP9 + 1
- ELSE
- IP7 = MAX(0,IP8-1)
- IP9 = MIN(IINLO(IOS)-1,IP8+1)
- IP10 = MIN(IINLO(IOS)-1,IP9+1)
- ENDIF
- ZLOP8 = ZILO1 + IP8 * ZIDLO
- ZLOP7 = ZLOP8 - ZIDLO
- ZLOP9 = ZLOP8 + ZIDLO
- ZLOP10= ZLOP9 + ZIDLO
-!
- ! 3.1.5. southern
- ZIDLO = (ZILO2 - ZILO1) / (IINLO(IOSS))
- IP11 = INT((ZOLO - ZILO1) / ZIDLO)
- IF (GGLOBLON) THEN
- IP12 = IP11 + 1
- ELSE
- IP12 = MIN(IINLO(IOSS)-1,IP11+1)
- ENDIF
- ZLOP11= ZILO1 + IP11* ZIDLO
- ZLOP12= ZLOP11+ ZIDLO
-!
- ! 3.1.6. check position of points
- IF (GGLOBLON ) THEN
- IF ((IP1 <-2) .OR. (IP2 >IINLO(IONN)+1) .OR. &
- (IP3 <-2) .OR. (IP6 >IINLO(ION )+1) .OR. &
- (IP7 <-2) .OR. (IP10>IINLO(IOS )+1) .OR. &
- (IP11<-2) .OR. (IP12>IINLO(IOSS)+1)) THEN
- CALL ABOR1_SFX('HORIBLE_SURF: INPUT DOMAIN SMALLER THAN OUTPUT ONE - LONGITUDE GLOBAL')
- END IF
- ELSE
- IF ((IP1 <0) .OR. (IP2 >IINLO(IONN)-1) .OR. &
- (IP3 <0) .OR. (IP6 >IINLO(ION )-1) .OR. &
- (IP7 <0) .OR. (IP10>IINLO(IOS )-1) .OR. &
- (IP11<0) .OR. (IP12>IINLO(IOSS)-1)) THEN
- CALL ABOR1_SFX('HORIBLE_SURF: INPUT DOMAIN SMALLER THAN OUTPUT ONE - LONGITUDE LOCAL')
- END IF
- END IF
-!
- ! 3.1.7. add parallel offset
- IP1 =IP1 + IOFS(IONN)
- IP2 =IP2 + IOFS(IONN)
- IP3 =IP3 + IOFS(ION )
- IP4 =IP4 + IOFS(ION )
- IP5 =IP5 + IOFS(ION )
- IP6 =IP6 + IOFS(ION )
- IP7 =IP7 + IOFS(IOS )
- IP8 =IP8 + IOFS(IOS )
- IP9 =IP9 + IOFS(IOS )
- IP10=IP10+ IOFS(IOS )
- IP11=IP11+ IOFS(IOSS)
- IP12=IP12+ IOFS(IOSS)
-!
-!* 3.2 Land / Sea mask
-!
- ZLSM1 = 1.
- ZLSM2 = 1.
- ZLSM3 = 1.
- ZLSM4 = 1.
- ZLSM5 = 1.
- ZLSM6 = 1.
- ZLSM7 = 1.
- ZLSM8 = 1.
- ZLSM9 = 1.
- ZLSM10 = 1.
- ZLSM11 = 1.
- ZLSM12 = 1.
- ZLSMNN = 1.
- ZLSMN = 1.
- ZLSMS = 1.
- ZLSMSS = 1.
- IF (LDLSM) THEN
- IF (ILSMIN(IP1 ).NE.KLSMOUT(JOPOS)) ZLSM1 = 0.
- IF (ILSMIN(IP2 ).NE.KLSMOUT(JOPOS)) ZLSM2 = 0.
- IF (ILSMIN(IP3 ).NE.KLSMOUT(JOPOS)) ZLSM3 = 0.
- IF (ILSMIN(IP4 ).NE.KLSMOUT(JOPOS)) ZLSM4 = 0.
- IF (ILSMIN(IP5 ).NE.KLSMOUT(JOPOS)) ZLSM5 = 0.
- IF (ILSMIN(IP6 ).NE.KLSMOUT(JOPOS)) ZLSM6 = 0.
- IF (ILSMIN(IP7 ).NE.KLSMOUT(JOPOS)) ZLSM7 = 0.
- IF (ILSMIN(IP8 ).NE.KLSMOUT(JOPOS)) ZLSM8 = 0.
- IF (ILSMIN(IP9 ).NE.KLSMOUT(JOPOS)) ZLSM9 = 0.
- IF (ILSMIN(IP10).NE.KLSMOUT(JOPOS)) ZLSM10 = 0.
- IF (ILSMIN(IP11).NE.KLSMOUT(JOPOS)) ZLSM11 = 0.
- IF (ILSMIN(IP12).NE.KLSMOUT(JOPOS)) ZLSM12 = 0.
- ZLSMNN = MIN(ZLSM1 +ZLSM2,1.)
- ZLSMN = MIN(ZLSM3 +ZLSM4 +ZLSM5 +ZLSM6,1.)
- ZLSMS = MIN(ZLSM7 +ZLSM8 +ZLSM9 +ZLSM10,1.)
- ZLSMSS = MIN(ZLSM11+ZLSM12,1.)
- ZLSMTOT = MIN(ZLSMNN+ZLSMN+ZLSMS+ZLSMSS,1.)
- IF (ZLSMNN < 1.E-3) THEN
- ZLSM1 = 1.
- ZLSM2 = 1.
- END IF
- IF (ZLSMN < 1.E-3) THEN
- ZLSM3 = 1.
- ZLSM4 = 1.
- ZLSM5 = 1.
- ZLSM6 = 1.
- END IF
- IF (ZLSMS < 1.E-3) THEN
- ZLSM7 = 1.
- ZLSM8 = 1.
- ZLSM9 = 1.
- ZLSM10= 1.
- END IF
- IF (ZLSMSS < 1.E-3) THEN
- ZLSM11= 1.
- ZLSM12= 1.
- END IF
- IF (ZLSMTOT < 1.E-3) THEN
- ZLSMNN = 1.
- ZLSMN = 1.
- ZLSMS = 1.
- ZLSMSS = 1.
- END IF
- ENDIF
-!
-!* 3.3 Weight of points
-!
- ! 3.3.1 northern
- ZW1 = ZLSM1 * (1.+ZLSM2 *(ZOLO -ZLOP1 )/(ZLOP1 -ZLOP2 ))
- ZW2 = 1. - ZW1
- ZWNN = ZLSMNN* (1.+ZLSMN *(ZOLA -ZLANN)/(ZLANN-ZLAN )) &
- * (1.+ZLSMS *(ZOLA -ZLANN)/(ZLANN-ZLAS )) &
- * (1.+ZLSMSS*(ZOLA -ZLANN)/(ZLANN-ZLASS))
-!
- ! 3.3.2. north
- ZW3 = ZLSM3 * (1.+ZLSM4 *(ZOLO -ZLOP3 )/(ZLOP3 -ZLOP4 )) &
- * (1.+ZLSM5 *(ZOLO -ZLOP3 )/(ZLOP3 -ZLOP5 )) &
- * (1.+ZLSM6 *(ZOLO -ZLOP3 )/(ZLOP3 -ZLOP6 ))
- ZW4 = ZLSM4 * (1.+ZLSM3 *(ZOLO -ZLOP4 )/(ZLOP4 -ZLOP3 )) &
- * (1.+ZLSM5 *(ZOLO -ZLOP4 )/(ZLOP4 -ZLOP5 )) &
- * (1.+ZLSM6 *(ZOLO -ZLOP4 )/(ZLOP4 -ZLOP6 ))
- ZW5 = ZLSM5 * (1.+ZLSM3 *(ZOLO -ZLOP5 )/(ZLOP5 -ZLOP3 )) &
- * (1.+ZLSM4 *(ZOLO -ZLOP5 )/(ZLOP5 -ZLOP4 )) &
- * (1.+ZLSM6 *(ZOLO -ZLOP5 )/(ZLOP5 -ZLOP6 ))
- ZW6 = 1. - ZW3 - ZW4 - ZW5
- ZWN = ZLSMN * (1.+ZLSMNN*(ZOLA -ZLAN )/(ZLAN -ZLANN)) &
- * (1.+ZLSMS *(ZOLA -ZLAN )/(ZLAN -ZLAS )) &
- * (1.+ZLSMSS*(ZOLA -ZLAN )/(ZLAN -ZLASS))
-!
- ! 3.3.3. south
- ZW7 = ZLSM7 * (1.+ZLSM8 *(ZOLO -ZLOP7 )/(ZLOP7 -ZLOP8 )) &
- * (1.+ZLSM9 *(ZOLO -ZLOP7 )/(ZLOP7 -ZLOP9 )) &
- * (1.+ZLSM10*(ZOLO -ZLOP7 )/(ZLOP7 -ZLOP10))
- ZW8 = ZLSM8 * (1.+ZLSM7 *(ZOLO -ZLOP8 )/(ZLOP8 -ZLOP7 )) &
- * (1.+ZLSM9 *(ZOLO -ZLOP8 )/(ZLOP8 -ZLOP9 )) &
- * (1.+ZLSM10*(ZOLO -ZLOP8 )/(ZLOP8 -ZLOP10))
- ZW9 = ZLSM9 * (1.+ZLSM7 *(ZOLO -ZLOP9 )/(ZLOP9 -ZLOP7 )) &
- * (1.+ZLSM8 *(ZOLO -ZLOP9 )/(ZLOP9 -ZLOP8 )) &
- * (1.+ZLSM10*(ZOLO -ZLOP9 )/(ZLOP9 -ZLOP10))
- ZW10 = 1. - ZW7 - ZW8 - ZW9
- ZWS = ZLSMS * (1.+ZLSMNN*(ZOLA -ZLAS )/(ZLAS -ZLANN)) &
- * (1.+ZLSMN *(ZOLA -ZLAS )/(ZLAS -ZLAN )) &
- * (1.+ZLSMSS*(ZOLA -ZLAS )/(ZLAS -ZLASS))
-!
- ! 3.3.4. southern
- ZW11 = ZLSM11* (1.+ZLSM12*(ZOLO -ZLOP11)/(ZLOP11-ZLOP12))
- ZW12 = 1. - ZW11
- ZWSS = 1. - ZWNN - ZWN - ZWS
-!
-! In order to exclude undef values from computation of PAROUT,
-! weights w2, w6, w10, w12 and wss which can be numerically very low
-! because they are residual, are set to 0
-!
-IF (ABS(ZW2 ) < 1.E-10) ZW2=0.
-IF (ABS(ZW6 ) < 1.E-10) ZW6=0.
-IF (ABS(ZW10) < 1.E-10) ZW10=0.
-IF (ABS(ZW12) < 1.E-10) ZW12=0.
-IF (ABS(ZWSS) < 1.E-10) ZWSS=0.
-!
- ! 3.3.5. longitude weight x latitude weight
- ZW1 = ZW1 * ZWNN
- ZW2 = ZW2 * ZWNN
- ZW3 = ZW3 * ZWN
- ZW4 = ZW4 * ZWN
- ZW5 = ZW5 * ZWN
- ZW6 = ZW6 * ZWN
- ZW7 = ZW7 * ZWS
- ZW8 = ZW8 * ZWS
- ZW9 = ZW9 * ZWS
- ZW10 = ZW10 * ZWS
- ZW11 = ZW11 * ZWSS
- ZW12 = ZW12 * ZWSS
-!
- PAROUT (JOPOS) = ZW1 * ZARIN(IP1 ) + &
- ZW2 * ZARIN(IP2 ) + &
- ZW3 * ZARIN(IP3 ) + &
- ZW4 * ZARIN(IP4 ) + &
- ZW5 * ZARIN(IP5 ) + &
- ZW6 * ZARIN(IP6 ) + &
- ZW7 * ZARIN(IP7 ) + &
- ZW8 * ZARIN(IP8 ) + &
- ZW9 * ZARIN(IP9 ) + &
- ZW10 * ZARIN(IP10) + &
- ZW11 * ZARIN(IP11) + &
- ZW12 * ZARIN(IP12)
-!
-! For surface fields, the interpoalted value is bounded
-! by the min max values of the initial field
-
- IF (PRESENT(KLSMIN)) THEN
-
- IP(1)=IP1
- IP(2)=IP2
- IP(3)=IP3
- IP(4)=IP4
- IP(5)=IP5
- IP(6)=IP6
- IP(7)=IP7
- IP(8)=IP8
- IP(9)=IP9
- IP(10)=IP10
- IP(11)=IP11
- IP(12)=IP12
-
- ZMIN=XUNDEF
- ZMAX=XUNDEF
-
- DO JLOOP2=1,12
- IF (ZARIN(IP(JLOOP2))==XUNDEF) CYCLE
-
- IF ((ZMAX==XUNDEF)) THEN
- ZMAX=ZARIN(IP(JLOOP2))
- ZMIN=ZARIN(IP(JLOOP2))
- ELSE
- ZMAX=MAX(ZMAX,ZARIN(IP(JLOOP2)))
- ZMIN=MIN(ZMIN,ZARIN(IP(JLOOP2)))
- ENDIF
-
- END DO
-
- PAROUT(JOPOS) = MAX(MIN(PAROUT(JOPOS),ZMAX),ZMIN)
-
- ENDIF
-
-END DO
-!
-DEALLOCATE (IINLO)
-DEALLOCATE (ZARIN)
-DEALLOCATE (ILSMIN)
-DEALLOCATE (IOFS)
-!
-WHERE(ABS(PAROUT-XUNDEF)<1.E-6) PAROUT=XUNDEF
-!
-!------------------------------------------------------------------------------
-!
-!* 4. EXTRAPOLATIONS IF SOME POINTS WERE NOT INTERPOLATED
-! ---------------------------------------------------
-!
-!* no missing point
-IF (COUNT(PAROUT(:)==XUNDEF .AND. OINTERP(:))==0 .AND. LHOOK) CALL DR_HOOK('HORIBL_SURF',1,ZHOOK_HANDLE)
-IF (COUNT(PAROUT(:)==XUNDEF .AND. OINTERP(:))==0) RETURN
-!
-!* no data point
-IF (COUNT(PARIN(:)/=XUNDEF)==0 .AND. LHOOK) CALL DR_HOOK('HORIBL_SURF',1,ZHOOK_HANDLE)
-IF (COUNT(PARIN(:)/=XUNDEF)==0) RETURN
-!
-WRITE(KLUOUT,*) ' Remaining horizontal extrapolations'
-WRITE(KLUOUT,*) ' Total number of input data : ',COUNT(PARIN(:)/=XUNDEF)
-WRITE(KLUOUT,*) ' Number of points to interpolate: ',COUNT(PAROUT(:)==XUNDEF .AND. OINTERP(:))
-!
-!* input grid coordinates
-!
-ALLOCATE(ZLA(KILEN))
-ALLOCATE(ZLO(KILEN))
-!
-JIPOS = 0
-ZIDLA = (PILA2 - PILA1) / (KINLA - 1)
-DO JLAT=1,KINLA
- ZIDLO = (ZILO2-ZILO1) / KINLO(JLAT)
- DO JLON=1,KINLO(JLAT)
- JIPOS = JIPOS + 1
- ZLA(JIPOS) = PILA1 + (JLAT-1) * ZIDLA
- ZLO(JIPOS) = ZILO1 + (JLON-1) * ZIDLO
- END DO
-END DO
-!
- CALL HOR_EXTRAPOL_SURF(KLUOUT,'LALO',ZLA,ZLO,PARIN,PYOUT,PXOUT,PAROUT,OINTERP)
-!
-DEALLOCATE(ZLA)
-DEALLOCATE(ZLO)
-IF (LHOOK) CALL DR_HOOK('HORIBL_SURF',1,ZHOOK_HANDLE)
-!
-!------------------------------------------------------------------------------
-!
-!
-END SUBROUTINE HORIBL_SURF
diff --git a/src/SURFEX/horibl_surf_coef.F90 b/src/SURFEX/horibl_surf_coef.F90
new file mode 100644
index 0000000000000000000000000000000000000000..6e2957b4046df085a533e234765db905af6fece0
--- /dev/null
+++ b/src/SURFEX/horibl_surf_coef.F90
@@ -0,0 +1,238 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE HORIBL_SURF_COEF(KOLEN,OINTERP,OGLOBLON,PILO1,PILO2,POLO,&
+ KO,KINLO,KP,PLOP )
+! ###########################################################################
+!
+!!**** *HORIBL_SURF_COEF* - horitontal bilinear interpolation
+!!
+!! PURPOSE
+!! -------
+!!
+!! Interpolates a field, supports masks.
+!!
+!! METHOD
+!! ------
+!!
+!! This routine performs a bilinear interpolation based on the 12 surrounding
+!! points. It begins with an interpolation along the latitudes (with third order
+!! polynoms interpolation with 4 points and linear interpolation for 2 points)
+!! and then a second along the longitude (third order polynoms interpolation).
+!! Two interpolations are performed : first along the parallels then between the
+!! four resulting points.
+!!
+!! The disposition of the points is the following :
+!!
+!!
+!! N 1 2
+!!
+!! ^ 3 4 5 6
+!! | x
+!! | 7 8 9 10
+!! |
+!! 11 12
+!! S
+!! W ---------------> E
+!!
+!! Note : the name 'south', 'north', may not be exact if the last data point is
+!! to the south of first (delta latitude < 0). This does not affect computations.
+!!
+!! The formula used to compute the weight is :
+!! (Lon - Lon.i) . (Lon - Lon.i) . (Lon - Lon.i)
+!! Wi = ---------------------------------------------------
+!! (Lon.i - Lon.j) . (Lon.i - Lon.k) . (Lon.i - Lon.l)
+!! Where j,k,l are the other points of the line.
+!!
+!! When masks are used, points with different types than the output points are
+!! not taken in account (in the formula, the corresponding coefficient is set
+!! to 1). If no points of the same nature are available, the interpolation is
+!! performed anyway with the 12 points. It is the task of the calling program
+!! to react to this situation.
+!!
+!! When the inputs parameters define a circular map (or global), the inputs data
+!! are extended. The value of the parameter ODVECT is used to know if the datas
+!! are vectorial or scalar (this affects the sign of extended values).
+!!
+!! EXTERNAL
+!! --------
+!!
+!! subroutine FMLOOK_ll : to retrieve the logical unit number of the listing file
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! This routine is based on the one used by the software FULL-POS from Meteo France.
+!! More informations may be found in 'Book 1'
+!!
+!! AUTHOR
+!! ------
+!!
+!! J.Pettre & V.Bousquet
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! Original 07/01/1999
+!! 21/04/1999 (V. Masson) set correct prefixes and bug in
+!! a logical definition
+!! 21/04/1999 (V. Masson) bug in north and south poles
+!! extension for input map land-sea mask
+!! 27/05/1999 (V. Masson) bug in 'grib south pole'
+!! extrapolation (number of point per parallel)
+!! 27/05/1999 (V. Masson) bug in 'grib pole' extrapolation
+!! extra latitudes are now computed symetrically
+!! to the poles.
+!! 17/03/2010 (P. LeMoigne) bug in weights computations
+!! 16/06/2010 (G. Tanguy) bug in 'grib north pole"
+!! extrapolation (tabular ZARIN not totaly filled)
+!!
+!------------------------------------------------------------------------------
+!
+!
+!* 0. DECLARATIONS
+! ---------------
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODI_ABOR1_SFX
+!
+IMPLICIT NONE
+!
+!* 0.1. Declaration of arguments
+!
+INTEGER, INTENT(IN) :: KOLEN ! size of output array
+LOGICAL, DIMENSION(:), INTENT(IN) :: OINTERP ! .true. where physical value is needed
+!
+LOGICAL, INTENT(IN) :: OGLOBLON ! True if the map is circular
+REAL, INTENT(IN) :: PILO1 ! Longitude of the first data point
+REAL, INTENT(IN) :: PILO2 ! Longitude of the last data point
+REAL, DIMENSION(:), INTENT(IN) :: POLO
+INTEGER, DIMENSION(:,:), INTENT(IN) :: KO
+!
+INTEGER, DIMENSION(:), INTENT(IN) :: KINLO ! Extended KINLO
+!
+! Posiiton in the array of the twelwe surrounding points
+INTEGER, DIMENSION(:,:), INTENT(OUT) :: KP
+ ! Latitudes and longitudes of the surrounding points
+REAL, DIMENSION(:,:), INTENT(OUT) :: PLOP
+!
+!* 0.2. Declaration of local variables
+!
+ ! Variables used to perform the interpolation
+REAL :: ZIDLO ! Delta longitude
+INTEGER, DIMENSION(:), ALLOCATABLE :: IOFS ! Offset of each parallel in the array
+!
+INTEGER :: IINLA
+INTEGER :: JL, IS1, IS2, JI
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!------------------------------------------------------------------------------
+!
+!* 1. DETERMINATION of the latitude of the poles (depending of the latitude
+! ------------- of the first data point)
+!
+IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_COEF',0,ZHOOK_HANDLE)
+!
+!------------------------------------------------------------------------------
+!
+!* 3. LOOP OVER ALL THE POINTS OF THE OUTPUT GRID
+! -------------------------------------------
+!
+IINLA = SIZE(KINLO)
+ALLOCATE (IOFS(IINLA))
+IOFS(1) = 1
+IF (OGLOBLON) IOFS(1)=IOFS(1)+2
+DO JL = 2,IINLA
+ IOFS(JL) = IOFS(JL-1) + KINLO(JL-1)
+ IF (OGLOBLON) IOFS(JL) = IOFS(JL) + 4
+END DO
+!
+DO JL = 1, KOLEN
+ !
+ IF (.NOT. OINTERP(JL)) CYCLE
+ !
+ ! 3.1.2. northern
+ ZIDLO = (PILO2 - PILO1) / (KINLO(KO(JL,1)))
+ KP(JL,1) = INT((POLO(JL) - PILO1) / ZIDLO)
+ KP(JL,2) = KP(JL,1) + 1
+ IF (.NOT.OGLOBLON) KP(JL,2) = MIN(KINLO(KO(JL,1))-1, KP(JL,2))
+ PLOP(JL,1) = PILO1 + KP(JL,1) * ZIDLO
+ PLOP(JL,2) = PLOP(JL,1) + ZIDLO
+!
+ ! 3.1.3. north
+ ZIDLO = (PILO2 - PILO1) / (KINLO(KO(JL,2) ))
+ KP(JL,4) = INT((POLO(JL) - PILO1) / ZIDLO)
+ KP(JL,3) = KP(JL,4) - 1
+ KP(JL,5) = KP(JL,4) + 1
+ KP(JL,6) = KP(JL,4) + 2
+ IF (.NOT.OGLOBLON) THEN
+ KP(JL,3) = MAX(0,KP(JL,3))
+ KP(JL,5:6) = MIN(KINLO(KO(JL,2))-1,KP(JL,5:6))
+ ENDIF
+ PLOP(JL,4) = PILO1 + KP(JL,4) * ZIDLO
+ PLOP(JL,3) = PLOP(JL,4) - ZIDLO
+ PLOP(JL,5) = PLOP(JL,4) + ZIDLO
+ PLOP(JL,6) = PLOP(JL,4) + 2*ZIDLO
+!
+ ! 3.1.4. south
+ ZIDLO = (PILO2 - PILO1) / (KINLO(KO(JL,3) ))
+ KP(JL,8) = INT((POLO(JL) - PILO1) / ZIDLO)
+ KP(JL,7) = KP(JL,8) - 1
+ KP(JL,9) = KP(JL,8) + 1
+ KP(JL,10) = KP(JL,8) + 2
+ IF (.NOT.OGLOBLON) THEN
+ KP(JL,7) = MAX(0,KP(JL,7))
+ KP(JL,9:10) = MIN(KINLO(KO(JL,3))-1,KP(JL,9:10))
+ ENDIF
+ PLOP(JL,8) = PILO1 + KP(JL,8) * ZIDLO
+ PLOP(JL,7) = PLOP(JL,8) - ZIDLO
+ PLOP(JL,9) = PLOP(JL,8) + ZIDLO
+ PLOP(JL,10) = PLOP(JL,8) + 2*ZIDLO
+!
+ ! 3.1.5. southern
+ ZIDLO = (PILO2 - PILO1) / (KINLO(KO(JL,4)))
+ KP(JL,11) = INT((POLO(JL) - PILO1) / ZIDLO)
+ KP(JL,12) = KP(JL,11) + 1
+ IF (.NOT.OGLOBLON) KP(JL,12) = MIN(KINLO(KO(JL,4))-1,KP(JL,12))
+ PLOP(JL,11) = PILO1 + KP(JL,11) * ZIDLO
+ PLOP(JL,12) = PLOP(JL,11) + ZIDLO
+!
+ ! 3.1.6. check position of points
+ IF (OGLOBLON) THEN
+ IS1 = -2
+ IS2 = 1
+ ELSE
+ IS1 = 0
+ IS2 = -1
+ ENDIF
+ !
+ IF ((KP(JL,1) <IS1) .OR. (KP(JL,2) >KINLO(KO(JL,1))+IS2) .OR. &
+ (KP(JL,3) <IS1) .OR. (KP(JL,6) >KINLO(KO(JL,2))+IS2) .OR. &
+ (KP(JL,7) <IS1) .OR. (KP(JL,10)>KINLO(KO(JL,3))+IS2) .OR. &
+ (KP(JL,11)<IS1) .OR. (KP(JL,12)>KINLO(KO(JL,4))+IS2)) THEN
+ CALL ABOR1_SFX('HORIBLE_SURF: INPUT DOMAIN SMALLER THAN OUTPUT ONE - LONGITUDE GLOBAL')
+ END IF
+!
+ ! 3.1.7. add parallel offset
+ KP(JL,1:2) = KP(JL,1:2) + IOFS(KO(JL,1))
+ KP(JL,3:6) = KP(JL,3:6) + IOFS(KO(JL,2))
+ KP(JL,7:10) = KP(JL,7:10) + IOFS(KO(JL,3))
+ KP(JL,11:12)= KP(JL,11:12) + IOFS(KO(JL,4))
+!
+END DO
+!
+!
+IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_COEF',1,ZHOOK_HANDLE)
+!
+!------------------------------------------------------------------------------
+!
+!
+END SUBROUTINE HORIBL_SURF_COEF
diff --git a/src/SURFEX/horibl_surf_extrap.F90 b/src/SURFEX/horibl_surf_extrap.F90
new file mode 100644
index 0000000000000000000000000000000000000000..20103ca1fbf425de4ddc86245b0afde1fad4289b
--- /dev/null
+++ b/src/SURFEX/horibl_surf_extrap.F90
@@ -0,0 +1,194 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE HORIBL_SURF_EXTRAP(PILA1,PILO1,PILA2,PILO2,KINLA,KINLO,KILEN,PARIN, &
+ KOLEN,KP,PXOUT,PYOUT,PAROUT,KLUOUT,OINTERP,PILATARRAY )
+! ###########################################################################
+!
+!!**** *HORIBL_SURF_EXTRAP* - horitontal bilinear interpolation
+!!
+!! PURPOSE
+!! -------
+!!
+!! Interpolates a field, supports masks.
+!!
+!! METHOD
+!! ------
+!!
+!! This routine performs a bilinear interpolation based on the 12 surrounding
+!! points. It begins with an interpolation along the latitudes (with third order
+!! polynoms interpolation with 4 points and linear interpolation for 2 points)
+!! and then a second along the longitude (third order polynoms interpolation).
+!! Two interpolations are performed : first along the parallels then between the
+!! four resulting points.
+!!
+!! The disposition of the points is the following :
+!!
+!!
+!! N 1 2
+!!
+!! ^ 3 4 5 6
+!! | x
+!! | 7 8 9 10
+!! |
+!! 11 12
+!! S
+!! W ---------------> E
+!!
+!! Note : the name 'south', 'north', may not be exact if the last data point is
+!! to the south of first (delta latitude < 0). This does not affect computations.
+!!
+!! The formula used to compute the weight is :
+!! (Lon - Lon.i) . (Lon - Lon.i) . (Lon - Lon.i)
+!! Wi = ---------------------------------------------------
+!! (Lon.i - Lon.j) . (Lon.i - Lon.k) . (Lon.i - Lon.l)
+!! Where j,k,l are the other points of the line.
+!!
+!! When masks are used, points with different types than the output points are
+!! not taken in account (in the formula, the corresponding coefficient is set
+!! to 1). If no points of the same nature are available, the interpolation is
+!! performed anyway with the 12 points. It is the task of the calling program
+!! to react to this situation.
+!!
+!! When the inputs parameters define a circular map (or global), the inputs data
+!! are extended. The value of the parameter ODVECT is used to know if the datas
+!! are vectorial or scalar (this affects the sign of extended values).
+!!
+!! EXTERNAL
+!! --------
+!!
+!! subroutine FMLOOK_ll : to retrieve the logical unit number of the listing file
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! This routine is based on the one used by the software FULL-POS from Meteo France.
+!! More informations may be found in 'Book 1'
+!!
+!! AUTHOR
+!! ------
+!!
+!! J.Pettre & V.Bousquet
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! Original 07/01/1999
+!! 21/04/1999 (V. Masson) set correct prefixes and bug in
+!! a logical definition
+!! 21/04/1999 (V. Masson) bug in north and south poles
+!! extension for input map land-sea mask
+!! 27/05/1999 (V. Masson) bug in 'grib south pole'
+!! extrapolation (number of point per parallel)
+!! 27/05/1999 (V. Masson) bug in 'grib pole' extrapolation
+!! extra latitudes are now computed symetrically
+!! to the poles.
+!! 17/03/2010 (P. LeMoigne) bug in weights computations
+!! 16/06/2010 (G. Tanguy) bug in 'grib north pole"
+!! extrapolation (tabular ZARIN not totaly filled)
+!!
+!------------------------------------------------------------------------------
+!
+!
+!* 0. DECLARATIONS
+! ---------------
+!
+USE MODI_HOR_EXTRAPOL_SURF
+!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
+!* 0.1. Declaration of arguments
+!
+REAL, INTENT(IN) :: PILA1 ! Lat. (y) of first input point KDGSA
+REAL, INTENT(IN) :: PILO1 ! Lon. (x) of first input point
+REAL, INTENT(IN) :: PILA2 ! Lat. (y) of last input point KDGEN
+REAL, INTENT(IN) :: PILO2 ! Lon. (x) of last input point
+INTEGER, INTENT(IN) :: KINLA ! Number of parallels
+INTEGER, DIMENSION(:), INTENT(IN) :: KINLO ! Number of point along a parallel
+INTEGER, INTENT(IN) :: KILEN ! size of input arrays
+REAL, DIMENSION(:,:), INTENT(IN) :: PARIN ! input array
+INTEGER, INTENT(IN) :: KOLEN ! size of output array
+INTEGER, DIMENSION(:,:), INTENT(IN) :: KP
+REAL, DIMENSION(:), INTENT(IN) :: PXOUT ! X (lon.) of output points
+REAL, DIMENSION(:), INTENT(IN) :: PYOUT ! Y (lat.) of output points
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PAROUT ! output array
+LOGICAL, DIMENSION(:), INTENT(IN) :: OINTERP ! .true. where physical value is needed
+INTEGER, INTENT(IN) :: KLUOUT ! output listing logical unit
+REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: PILATARRAY
+!
+!* 0.2. Declaration of local variables
+!
+#ifdef SFX_MPI
+INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+#endif
+ ! Variables implied in the extension procedure
+INTEGER :: ICOUNT, JL, INL
+ ! Loop counters
+INTEGER :: INFOMPI, J, ICPT
+!------------------------------------------------------------------------------
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
+!------------------------------------------------------------------------------
+!
+!* 1. DETERMINATION of the latitude of the poles (depending of the latitude
+! ------------- of the first data point)
+!
+!------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_EXTRAP_2',0,ZHOOK_HANDLE)
+
+INL = SIZE(PAROUT,2)
+
+!* no data point
+IF (NRANK==NPIO) ICOUNT = COUNT(PARIN(:,:)/=XUNDEF)
+IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(ICOUNT,KIND(ICOUNT)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ENDIF
+IF (ICOUNT==0 .AND. LHOOK) CALL DR_HOOK('HORIBL_SURF_EXTRAP_2',1,ZHOOK_HANDLE)
+IF (ICOUNT==0) RETURN
+!
+IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_EXTRAP_2',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_EXTRAP_3',0,ZHOOK_HANDLE)
+!
+DO JL=1,INL
+WRITE(KLUOUT,*) ' Remaining horizontal extrapolations'
+WRITE(KLUOUT,*) ' Total number of input data : ',ICOUNT
+WRITE(KLUOUT,*) ' Number of points to interpolate: ',COUNT(PAROUT(:,JL)==XUNDEF .AND. OINTERP(:))
+ENDDO
+!
+IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_EXTRAP_3',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_EXTRAP_4',0,ZHOOK_HANDLE)
+
+!* input grid coordinates
+!
+!
+IF (PRESENT(PILATARRAY)) THEN
+ CALL HOR_EXTRAPOL_SURF(KLUOUT,'LALO',KILEN,PILA1,PILA2,PILO1,PILO2,KINLA,KINLO,&
+ KP,PARIN,PYOUT,PXOUT,PAROUT,OINTERP,PILATARRAY)
+ELSE
+ CALL HOR_EXTRAPOL_SURF(KLUOUT,'LALO',KILEN,PILA1,PILA2,PILO1,PILO2,KINLA,KINLO,&
+ KP,PARIN,PYOUT,PXOUT,PAROUT,OINTERP)
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_EXTRAP_4',1,ZHOOK_HANDLE)
+!
+!------------------------------------------------------------------------------
+!
+!
+END SUBROUTINE HORIBL_SURF_EXTRAP
diff --git a/src/SURFEX/horibl_surf_gridin.F90 b/src/SURFEX/horibl_surf_gridin.F90
new file mode 100644
index 0000000000000000000000000000000000000000..1e78f573238ad716bc1df6110fb55f3889e83a93
--- /dev/null
+++ b/src/SURFEX/horibl_surf_gridin.F90
@@ -0,0 +1,430 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE HORIBL_SURF_GRIDIN(KINLA,KINLO,KILEN,PARIN,KOLEN,&
+ ODVECT,KLUOUT,OGLOBS,OGLOBN,OGLOBLON,KP,&
+ PARIN0_OUT,PARIN_OUT,KLSMIN_OUT,KLSMIN,KLSMOUT,KMASK )
+! ###########################################################################
+!
+!!**** *HORIBL_SURF_GRIDIN* - horitontal bilinear interpolation
+!!
+!! PURPOSE
+!! -------
+!!
+!! Interpolates a field, supports masks.
+!!
+!! METHOD
+!! ------
+!!
+!! This routine performs a bilinear interpolation based on the 12 surrounding
+!! points. It begins with an interpolation along the latitudes (with third order
+!! polynoms interpolation with 4 points and linear interpolation for 2 points)
+!! and then a second along the longitude (third order polynoms interpolation).
+!! Two interpolations are performed : first along the parallels then between the
+!! four resulting points.
+!!
+!! The disposition of the points is the following :
+!!
+!!
+!! N 1 2
+!!
+!! ^ 3 4 5 6
+!! | x
+!! | 7 8 9 10
+!! |
+!! 11 12
+!! S
+!! W ---------------> E
+!!
+!! Note : the name 'south', 'north', may not be exact if the last data point is
+!! to the south of first (delta latitude < 0). This does not affect computations.
+!!
+!! The formula used to compute the weight is :
+!! (Lon - Lon.i) . (Lon - Lon.i) . (Lon - Lon.i)
+!! Wi = ---------------------------------------------------
+!! (Lon.i - Lon.j) . (Lon.i - Lon.k) . (Lon.i - Lon.l)
+!! Where j,k,l are the other points of the line.
+!!
+!! When masks are used, points with different types than the output points are
+!! not taken in account (in the formula, the corresponding coefficient is set
+!! to 1). If no points of the same nature are available, the interpolation is
+!! performed anyway with the 12 points. It is the task of the calling program
+!! to react to this situation.
+!!
+!! When the inputs parameters define a circular map (or global), the inputs data
+!! are extended. The value of the parameter ODVECT is used to know if the datas
+!! are vectorial or scalar (this affects the sign of extended values).
+!!
+!! EXTERNAL
+!! --------
+!!
+!! subroutine FMLOOK_ll : to retrieve the logical unit number of the listing file
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! This routine is based on the one used by the software FULL-POS from Meteo France.
+!! More informations may be found in 'Book 1'
+!!
+!! AUTHOR
+!! ------
+!!
+!! J.Pettre & V.Bousquet
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! Original 07/01/1999
+!! 21/04/1999 (V. Masson) set correct prefixes and bug in
+!! a logical definition
+!! 21/04/1999 (V. Masson) bug in north and south poles
+!! extension for input map land-sea mask
+!! 27/05/1999 (V. Masson) bug in 'grib south pole'
+!! extrapolation (number of point per parallel)
+!! 27/05/1999 (V. Masson) bug in 'grib pole' extrapolation
+!! extra latitudes are now computed symetrically
+!! to the poles.
+!! 17/03/2010 (P. LeMoigne) bug in weights computations
+!! 16/06/2010 (G. Tanguy) bug in 'grib north pole"
+!! extrapolation (tabular ZARIN not totaly filled)
+!!
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ---------------
+!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC, IDX_I
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODI_ABOR1_SFX
+!
+IMPLICIT NONE
+!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
+!* 0.1. Declaration of arguments
+!
+INTEGER, INTENT(IN) :: KINLA ! Number of parallels
+INTEGER, DIMENSION(:), INTENT(IN) :: KINLO ! Number of point along a parallel
+INTEGER, INTENT(IN) :: KILEN ! size of input arrays
+REAL, DIMENSION(:,:), INTENT(IN) :: PARIN ! input array
+INTEGER, INTENT(IN) :: KOLEN ! size of output array
+LOGICAL, INTENT(IN) :: ODVECT ! data is vectorial (True/False)
+INTEGER, INTENT(IN) :: KLUOUT ! output listing logical unit
+LOGICAL, INTENT(IN) :: OGLOBS
+LOGICAL, INTENT(IN) :: OGLOBN
+LOGICAL, INTENT(IN) :: OGLOBLON
+INTEGER, DIMENSION(:,:), INTENT(IN) :: KP
+REAL, DIMENSION(:,:), POINTER :: PARIN0_OUT ! input array
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PARIN_OUT
+INTEGER, DIMENSION(:,:,:), INTENT(OUT) :: KLSMIN_OUT
+INTEGER, DIMENSION(:), POINTER, OPTIONAL :: KMASK
+INTEGER, DIMENSION(:,:), INTENT(IN), OPTIONAL :: KLSMIN ! input land/sea mask
+INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KLSMOUT ! output land/sea mask
+!
+!* 0.2. Declaration of local variables
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZARIN ! Extended input datas
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZOUT
+REAL :: ZVECT ! -1 if input is vectorial
+ ! Variables implied in the extension procedure
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: ILSMIN ! Extended land/sea mask
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: IP
+INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: IOUT
+#ifdef SFX_MPI
+INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+#endif
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDARIN
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: IDLS
+INTEGER, DIMENSION(2) :: IEXT
+INTEGER :: IBIGSIZE ! Size of the extended map
+INTEGER :: IMID ! Used for extensions around the poles
+INTEGER :: IOF1 ! Offset in map
+INTEGER :: IOF2 ! Offset in map
+ ! Loop counters
+INTEGER :: JOP ! Output position
+INTEGER :: JIP ! Input position
+INTEGER :: JL, JI, JI2, JL2, JT, INL, JC ! Dummy counter
+INTEGER :: ID1, ID2, ISIZE
+INTEGER :: INFOMPI, I, J
+INTEGER :: IKINLO
+LOGICAL :: LDLSM ! Specify if land/sea mask is present or not
+!
+!------------------------------------------------------------------------------
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
+!------------------------------------------------------------------------------
+!
+!* 1. DETERMINATION of the latitude of the poles (depending of the latitude
+! ------------- of the first data point)
+!
+IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_GRIDIN_1',0,ZHOOK_HANDLE)
+!
+IF (PRESENT(KMASK)) NULLIFY(KMASK)
+!
+INL = SIZE(PARIN_OUT,2)
+!
+LDLSM = .FALSE.
+IF (PRESENT(KLSMIN) .AND. PRESENT(KLSMOUT)) LDLSM = .TRUE.
+!
+!* 2.6 Compute the resulting map
+!
+ZVECT = 1.
+IF (ODVECT) ZVECT=-1.
+!
+IF (NRANK==NPIO) THEN
+
+ IBIGSIZE = KILEN
+ IF (OGLOBS ) IBIGSIZE=IBIGSIZE+(4+KINLO( 1))+(4+KINLO( 2))
+ IF (OGLOBN ) IBIGSIZE=IBIGSIZE+(4+KINLO(KINLA))+(4+KINLO(KINLA-1))
+ IF (OGLOBLON) IBIGSIZE=IBIGSIZE+ 4*KINLA
+ !
+ ALLOCATE (ZARIN (IBIGSIZE,INL))
+ ALLOCATE (ILSMIN(IBIGSIZE,INL))
+ ALLOCATE (KMASK (IBIGSIZE))
+ KMASK(:) = -1
+!
+! 2.6.1 Compute the longitude extension
+!
+! This is a basic copy of the data. If extension is possible, the first and last
+! two lines are copied twice this way :
+!
+! /---------------\
+! | |
+! [.] [.] [.... ...] [.] [.]
+! | |
+! \------------/
+!
+! A point represent a data.
+!
+
+ DO JT = 1,INL
+
+ JIP = 1
+ JOP = 1
+ IF (OGLOBS) JOP = JOP + (4+KINLO(1)) + (4+KINLO(2))
+
+ IF (OGLOBLON) THEN
+
+ DO JL = 1,KINLA
+ ID1 = JIP+KINLO(JL)
+ ID2 = JOP+2+KINLO(JL)
+
+ KMASK(JOP ) = ID1-2
+ KMASK(JOP+1) = ID1-1
+ DO JI = JOP+2,ID2-1
+ KMASK(JI) = JIP + JI - (JOP+2)
+ ENDDO
+ KMASK(ID2 ) = JIP
+ KMASK(ID2+1) = JIP+1
+
+ ZARIN(JOP ,JT) = PARIN(ID1-2,JT)
+ ZARIN(JOP+1,JT) = PARIN(ID1-1,JT)
+ ZARIN(JOP+2:ID2-1,JT) = PARIN(JIP:ID1-1,JT)
+ ZARIN(ID2 ,JT) = PARIN(JIP ,JT)
+ ZARIN(ID2+1,JT) = PARIN(JIP+1,JT)
+
+ IF (LDLSM) THEN
+ ILSMIN(JOP ,JT) = KLSMIN(ID1-2,JT)
+ ILSMIN(JOP+1,JT) = KLSMIN(ID1-1,JT)
+ ILSMIN(JOP+2:ID2-1,JT) = KLSMIN(JIP:ID1-1,JT)
+ ILSMIN(ID2 ,JT) = KLSMIN(JIP ,JT)
+ ILSMIN(ID2+1,JT) = KLSMIN(JIP+1,JT)
+ END IF
+
+ JIP = JIP + KINLO(JL)
+ JOP = JOP + KINLO(JL) + 4
+
+ END DO
+
+ ELSE
+
+ DO JI = JOP,JOP+KILEN-1
+ KMASK(JI) = JIP + JI - JOP
+ ENDDO
+
+ ZARIN(JOP:JOP+KILEN-1,JT) = PARIN(JIP:JIP+KILEN-1,JT)
+ IF (LDLSM) THEN
+ ILSMIN(JOP:JOP+KILEN-1,JT) = KLSMIN(JIP:JIP+KILEN-1,JT)
+ END IF
+ END IF
+!
+! 2.6.2 Compute the south pole extension
+!
+! Pole extension is performed by copying the first half datas to the last half
+! datas of the extension parallel :
+!
+! [.] [.] [....] [....] [.] [.]
+! ||||
+! /-------/
+! ||||
+! [.] [.] [....] [....] [.] [.]
+!
+ DO JC = 1,4
+ !
+ IF (JC<3.AND.OGLOBS.OR.JC>2.AND.OGLOBN) THEN
+ !
+ IF (JC==1) THEN
+ IOF1 = 4 + KINLO(2)
+ IOF2 = IOF1 + 4 + KINLO(1)
+ IMID = (KINLO(1)+4) / 2
+ IKINLO = KINLO(1)
+ ELSEIF (JC==2) THEN
+ IOF1 = 0
+ IOF2 = IOF2 + 4 + KINLO(2)
+ IMID = (KINLO(2)+4) / 2
+ IKINLO = KINLO(2)
+ ELSEIF (JC==3) THEN
+ IOF1 = IBIGSIZE - (4+KINLO(KINLA-1)) - (4+KINLO(KINLA))
+ IOF2 = IOF1 - (4+KINLO(KINLA))
+ IMID = (KINLO(KINLA)+4) / 2
+ IKINLO = KINLO(KINLA)
+ ELSEIF (JC==4) THEN
+ IOF1 = IOF1 + (4+KINLO(KINLA))
+ IOF2 = IOF2 - (4+KINLO(KINLA-1))
+ IMID = (KINLO(KINLA-1)+4) / 2
+ IKINLO = KINLO(KINLA-1)
+ ENDIF
+ !
+ DO JI = 1,IMID
+ KMASK(IOF1+JI) = IOF2 + IMID + JI - 2
+ ENDDO
+ DO JI = IMID+1,IKINLO+4
+ KMASK(IOF1+JI) = IOF2 + 1 + 2 + JI - (IMID + 1)
+ ENDDO
+ !
+ ZARIN(IOF1+1:IOF1+IMID,JT) = ZVECT*ZARIN(IOF2+1+IMID-2:IOF2+2*IMID-2,JT)
+ ZARIN(IOF1+IMID+1:IOF1+IKINLO+4,JT) = ZVECT*ZARIN(IOF2+1+2:IOF2+IKINLO+4-IMID+2,JT)
+ IF (LDLSM) THEN
+ ILSMIN(IOF1+1:IOF1+IMID,JT) = ILSMIN(IOF2+1+IMID-2:IOF2+2*IMID-2,JT)
+ ILSMIN(IOF1+IMID+1:IOF1+IKINLO+4,JT) = ILSMIN(IOF2+1+2:IOF2+IKINLO+4-IMID+2,JT)
+ END IF
+ !
+ END IF
+ !
+ ENDDO
+ !
+ ENDDO
+ !
+ENDIF
+!
+IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(IBIGSIZE,KIND(IBIGSIZE)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ IF (NRANK/=NPIO) ALLOCATE(KMASK(IBIGSIZE))
+ CALL MPI_BCAST(KMASK,SIZE(KMASK)*KIND(KMASK)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ENDIF
+!
+IF (NRANK==NPIO .AND. (OGLOBLON.OR.OGLOBN.OR.OGLOBS)) THEN
+ !
+ ALLOCATE(PARIN0_OUT(SIZE(ZARIN,1),SIZE(ZARIN,2)))
+ PARIN0_OUT = ZARIN
+ !
+ELSE
+ !
+ ALLOCATE(PARIN0_OUT(0,0))
+ !
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_GRIDIN_1',1,ZHOOK_HANDLE)
+
+IF (NRANK/=NPIO) THEN
+IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_GRIDIN_3',0,ZHOOK_HANDLE)
+ IEXT(1) = MINVAL(KP)
+ IEXT(2) = MAXVAL(KP)
+ IDX_I = IDX_I + 1
+#ifdef SFX_MPI
+ CALL MPI_SEND(IEXT,2*KIND(IEXT)/4,MPI_INTEGER,NPIO,IDX_I,NCOMM,INFOMPI)
+#endif
+ IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_GRIDIN_3',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_GRIDIN_4',0,ZHOOK_HANDLE)
+ ISIZE = IEXT(2)-IEXT(1)+1
+ ALLOCATE(ZDARIN(ISIZE,INL))
+ ALLOCATE(IDLS(ISIZE,INL))
+ IDX_I = IDX_I + 1
+#ifdef SFX_MPI
+ CALL MPI_RECV(ZDARIN,SIZE(ZDARIN)*KIND(ZDARIN)/4,MPI_REAL,NPIO,IDX_I,NCOMM,ISTATUS,INFOMPI)
+#endif
+ IDX_I = IDX_I + 1
+#ifdef SFX_MPI
+ CALL MPI_RECV(IDLS,SIZE(IDLS)*KIND(IDLS)/4,MPI_INTEGER,NPIO,IDX_I,NCOMM,ISTATUS,INFOMPI)
+#endif
+ IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_GRIDIN_4',1,ZHOOK_HANDLE)
+ELSE
+#ifdef SFX_MPI
+!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(J,IEXT,ISIZE,ZDARIN,IDLS,JT,JL,ISTATUS,INFOMPI,ZHOOK_HANDLE_OMP)
+#endif
+ DO J=0,NPROC-1
+ IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_GRIDIN_2',0,ZHOOK_HANDLE_OMP)
+ IF (J/=NPIO) THEN
+#ifdef SFX_MPI
+ CALL MPI_RECV(IEXT,2*KIND(IEXT)/4,MPI_INTEGER,J,IDX_I+1,NCOMM,ISTATUS,INFOMPI)
+#endif
+ ELSE
+ IEXT(1) = MINVAL(KP)
+ IEXT(2) = MAXVAL(KP)
+ ENDIF
+ IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_GRIDIN_2',1,ZHOOK_HANDLE_OMP)
+ IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_GRIDIN_30',0,ZHOOK_HANDLE_OMP)
+ ISIZE = IEXT(2)-IEXT(1)+1
+ ALLOCATE(ZDARIN(ISIZE,INL))
+ ALLOCATE(IDLS(ISIZE,INL))
+ DO JT = 1,INL
+ DO JL = IEXT(1),IEXT(2)
+ ZDARIN(JL-IEXT(1)+1,JT) = ZARIN(JL,JT)
+ IDLS(JL-IEXT(1)+1,JT) = ILSMIN(JL,JT)
+ ENDDO
+ ENDDO
+ IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_GRIDIN_30',1,ZHOOK_HANDLE_OMP)
+ IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_GRIDIN_40',0,ZHOOK_HANDLE_OMP)
+ IF (J/=NPIO) THEN
+#ifdef SFX_MPI
+ CALL MPI_SEND(ZDARIN,SIZE(ZDARIN)*KIND(ZDARIN)/4,MPI_REAL,J,IDX_I+2,NCOMM,INFOMPI)
+ CALL MPI_SEND(IDLS,SIZE(IDLS)*KIND(IDLS)/4,MPI_INTEGER,J,IDX_I+3,NCOMM,INFOMPI)
+#endif
+ ELSE
+ DO JT = 1,INL
+ DO JL2 = 1,12
+ DO JL = 1,SIZE(KP,1)
+ ID1 = KP(JL,JL2) - IEXT(1) + 1
+ PARIN_OUT(JL,JT,JL2) = ZDARIN(ID1,JT)
+ KLSMIN_OUT(JL,JT,JL2) = IDLS(ID1,JT)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+ DEALLOCATE(ZDARIN,IDLS)
+ IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_GRIDIN_40',1,ZHOOK_HANDLE_OMP)
+ ENDDO
+#ifdef SFX_MPI
+!$OMP END PARALLEL DO
+#endif
+ IDX_I = IDX_I+3
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_GRIDIN_5',0,ZHOOK_HANDLE)
+IF (NRANK/=NPIO) THEN
+DO JT = 1,INL
+ DO JL2 = 1,12
+ DO JL = 1,SIZE(KP,1)
+ ID1 = KP(JL,JL2) - IEXT(1) + 1
+ PARIN_OUT(JL,JT,JL2) = ZDARIN(ID1,JT)
+ KLSMIN_OUT(JL,JT,JL2) = IDLS(ID1,JT)
+ ENDDO
+ ENDDO
+ENDDO
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_GRIDIN_5',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE HORIBL_SURF_GRIDIN
diff --git a/src/SURFEX/horibl_surf_init.F90 b/src/SURFEX/horibl_surf_init.F90
new file mode 100644
index 0000000000000000000000000000000000000000..5173bc4f13a8ea6385c64f6bca66dd7950386f99
--- /dev/null
+++ b/src/SURFEX/horibl_surf_init.F90
@@ -0,0 +1,367 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE HORIBL_SURF_INIT(PILA1,PILO1,PILA2,PILO2,KINLA,KINLO,KOLEN,&
+ PXOUT,PYOUT,OINTERP,OGLOBLON,OGLOBN,OGLOBS,&
+ KO,KINLO_OUT,POLA,POLO,PILO1_OUT,&
+ PILO2_OUT,PLA,PILATARRAY )
+! ###########################################################################
+!
+!!**** *HORIBL_SURF_INIT* - horitontal bilinear interpolation
+!!
+!! PURPOSE
+!! -------
+!!
+!! Interpolates a field, supports masks.
+!!
+!! METHOD
+!! ------
+!!
+!! This routine performs a bilinear interpolation based on the 12 surrounding
+!! points. It begins with an interpolation along the latitudes (with third order
+!! polynoms interpolation with 4 points and linear interpolation for 2 points)
+!! and then a second along the longitude (third order polynoms interpolation).
+!! Two interpolations are performed : first along the parallels then between the
+!! four resulting points.
+!!
+!! The disposition of the points is the following :
+!!
+!!
+!! N 1 2
+!!
+!! ^ 3 4 5 6
+!! | x
+!! | 7 8 9 10
+!! |
+!! 11 12
+!! S
+!! W ---------------> E
+!!
+!! Note : the name 'south', 'north', may not be exact if the last data point is
+!! to the south of first (delta latitude < 0). This does not affect computations.
+!!
+!! The formula used to compute the weight is :
+!! (Lon - Lon.i) . (Lon - Lon.i) . (Lon - Lon.i)
+!! Wi = ---------------------------------------------------
+!! (Lon.i - Lon.j) . (Lon.i - Lon.k) . (Lon.i - Lon.l)
+!! Where j,k,l are the other points of the line.
+!!
+!! When masks are used, points with different types than the output points are
+!! not taken in account (in the formula, the corresponding coefficient is set
+!! to 1). If no points of the same nature are available, the interpolation is
+!! performed anyway with the 12 points. It is the task of the calling program
+!! to react to this situation.
+!!
+!! When the inputs parameters define a circular map (or global), the inputs data
+!! are extended. The value of the parameter ODVECT is used to know if the datas
+!! are vectorial or scalar (this affects the sign of extended values).
+!!
+!! EXTERNAL
+!! --------
+!!
+!! subroutine FMLOOK_ll : to retrieve the logical unit number of the listing file
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! This routine is based on the one used by the software FULL-POS from Meteo France.
+!! More informations may be found in 'Book 1'
+!!
+!! AUTHOR
+!! ------
+!!
+!! J.Pettre & V.Bousquet
+!!
+!! MODIFICATKONS
+!! -------------
+!!
+!! Original 07/01/1999
+!! 21/04/1999 (V. Masson) set correct prefixes and bug in
+!! a logical definition
+!! 21/04/1999 (V. Masson) bug in north and south poles
+!! extension for input map land-sea mask
+!! 27/05/1999 (V. Masson) bug in 'grib south pole'
+!! extrapolation (number of point per parallel)
+!! 27/05/1999 (V. Masson) bug in 'grib pole' extrapolation
+!! extra latitudes are now computed symetrically
+!! to the poles.
+!! 17/03/2010 (P. LeMoigne) bug in weights computations
+!! 16/06/2010 (G. Tanguy) bug in 'grib north pole"
+!! extrapolation (tabular ZARIN not totaly filled)
+!!
+!------------------------------------------------------------------------------
+!
+!
+!* 0. DECLARATKONS
+! ---------------
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODI_ABOR1_SFX
+!
+IMPLICIT NONE
+!
+!* 0.1. Declaration of arguments
+!
+REAL, INTENT(IN) :: PILA1 ! Lat. (y) of first input point KDGSA
+REAL, INTENT(IN) :: PILO1 ! Lon. (x) of first input point
+REAL, INTENT(IN) :: PILA2 ! Lat. (y) of last input point KDGEN
+REAL, INTENT(IN) :: PILO2 ! Lon. (x) of last input point
+INTEGER, INTENT(IN) :: KINLA ! Number of parallels
+INTEGER, DIMENSION(:), INTENT(IN) :: KINLO ! Number of point along a parallel
+INTEGER, INTENT(IN) :: KOLEN ! size of output array
+REAL, DIMENSION(:), INTENT(IN) :: PXOUT ! X (lon.) of output points
+REAL, DIMENSION(:), INTENT(IN) :: PYOUT ! Y (lat.) of output points
+LOGICAL, DIMENSION(:), INTENT(IN) :: OINTERP ! .true. where physical value is needed
+!
+LOGICAL, INTENT(OUT) :: OGLOBLON ! True if the map is circular
+LOGICAL, INTENT(OUT) :: OGLOBN ! True if the map has the north pole
+LOGICAL, INTENT(OUT) :: OGLOBS ! True if the map has the south pole
+ ! Number of the surrounding latitudes
+INTEGER, DIMENSION(:,:), INTENT(OUT) :: KO
+INTEGER, DIMENSION(:), INTENT(OUT) :: KINLO_OUT ! Extended KINLO
+REAL, INTENT(OUT) :: PILO1_OUT ! Longitude of the first data point
+REAL, INTENT(OUT) :: PILO2_OUT ! Longitude of the last data point
+! Variables used to perform the interpolation
+REAL, DIMENSION(:), INTENT(OUT) :: POLA ! Latitude of the output point
+REAL, DIMENSION(:), INTENT(OUT) :: POLO ! Longitude of the output point
+ ! Latitudes and longitudes of the surrounding points
+REAL, DIMENSION(:,:), INTENT(OUT) :: PLA
+REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: PILATARRAY! latitudes array
+!
+!* 0.2. Declaration of local variables
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZIDLAT ! Deltai latitude
+REAL :: ZIDLA ! Delta latitude
+REAL :: ZSOUTHPOLE! south pole latitude (-90 or 90)
+REAL :: ZNORTHPOLE! north pole latitude ( 90 or -90)
+!
+! Variables implied in the extension procedure
+!
+INTEGER :: IOFFSET ! Offset in map
+INTEGER :: IINLA ! Number of parallel
+ ! Loop counters
+INTEGER :: JOPOS ! Output position
+INTEGER :: JL, JL2 ! Dummy counter
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!------------------------------------------------------------------------------
+!
+!* 1. DETERMINATKON of the latitude of the poles (depending of the latitude
+! ------------- of the first data point)
+!
+IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_INIT',0,ZHOOK_HANDLE)
+!
+IF (PILA1>0.) THEN
+ ZSOUTHPOLE= 90.
+ ZNORTHPOLE=-90.
+ELSE
+ ZSOUTHPOLE=-90.
+ ZNORTHPOLE= 90.
+END IF
+!
+!------------------------------------------------------------------------------
+!
+!* 2. EXTEND DATA GRID
+! ----------------
+!
+!* 2.1 Alias input data
+!
+PILO1_OUT = PILO1
+PILO2_OUT = PILO2
+!
+!* 2.2 Center input domain in order to have Lo1 < Lo 2
+!
+IF (PILO2_OUT < 0.) PILO2_OUT = PILO2_OUT + 360.
+IF (PILO1_OUT < 0.) PILO1_OUT = PILO1_OUT + 360.
+IF (PILO2_OUT < PILO1_OUT) PILO1_OUT = PILO1_OUT - 360.
+!
+!* 2.3 Extend one point (needed for reduced grids)
+!
+! Longitude coordinate of points are found by :
+! i
+! Lon(i) = Lon1 + ------------- . (Lon2 - Lon1)
+! Npts(Lat)-1
+! Where i goes from 0 to Npts(Lat)-1. The result of this is that the last point of
+! each parallel is located at Lon2. This is not the case for reduced grid where the
+! position of the last point depends upon the number of points of the parallel. For
+! reduced grid, the right formula to use is the following :
+! i
+! Lon(i) = Lon1 + ----------- . (Lon2' - Lon1)
+! Npts(Lat)
+! Where Lon2' = Lon1 + 2.PI.
+!
+! Lon2 - Lon1
+! This can be generalized with Lon2' = Lon2 + -------------
+! Nptsmax - 1
+!
+JOPOS = MAXVAL(KINLO(1:KINLA))
+PILO2_OUT = PILO1_OUT + (PILO2_OUT - PILO1_OUT) * JOPOS / (JOPOS - 1.)
+!
+!* 2.4 Test if the input is global or partially global
+!
+! Note that we must have a global map to make extension around the poles
+OGLOBN = .FALSE.
+OGLOBS = .FALSE.
+OGLOBLON = .FALSE.
+IF (PILO2_OUT-360.>PILO1_OUT-1.E-3) OGLOBLON = .TRUE.
+ZIDLA = (PILA2 - PILA1) / (KINLA - 1)
+IF (PRESENT(PILATARRAY)) THEN
+ ALLOCATE(ZIDLAT(KINLA+1))
+ DO JL=2,KINLA
+ ZIDLAT(JL) = PILATARRAY(JL)-PILATARRAY(JL-1)
+ END DO
+ ZIDLAT(1)=ZIDLAT(2)
+ ZIDLAT(KINLA+1) = ZIDLAT(KINLA)
+ENDIF
+IF ((PILA1-ZIDLA>= 90.) .OR. (PILA1-ZIDLA<=-90.)) OGLOBS=OGLOBLON
+IF ((PILA2+ZIDLA>= 90.) .OR. (PILA2+ZIDLA<=-90.)) OGLOBN=OGLOBLON
+! Aladin case (input PILA2, PILO2 are in meters) no extension
+IF ( PILA2 > 100. ) THEN
+ OGLOBN = .FALSE.
+ OGLOBS = .FALSE.
+ OGLOBLON = .FALSE.
+END IF
+!
+!
+!* 2.7 Compute the resulting parameters of the map
+!
+IINLA = KINLA
+IF (OGLOBS) IINLA = IINLA + 2
+IF (OGLOBN) IINLA = IINLA + 2
+!
+IOFFSET = 0
+IF (OGLOBS) THEN
+ KINLO_OUT(IOFFSET+1) = KINLO(2)
+ KINLO_OUT(IOFFSET+2) = KINLO(1)
+ IOFFSET = IOFFSET + 2
+END IF
+KINLO_OUT(IOFFSET+1:IOFFSET+KINLA) = KINLO(1:KINLA)
+IOFFSET = IOFFSET + KINLA
+IF (OGLOBN) THEN
+ KINLO_OUT(IOFFSET+1) = KINLO(KINLA)
+ KINLO_OUT(IOFFSET+2) = KINLO(KINLA-1)
+ IOFFSET = IOFFSET + 2
+END IF
+!
+!------------------------------------------------------------------------------
+!
+!* 3. LOOP OVER ALL THE POINTS OF THE OUTPUT GRID
+! -------------------------------------------
+!
+POLA(:) = 0.
+POLO(:) = 0.
+!
+DO JL = 1, KOLEN
+ !
+ IF (.NOT. OINTERP(JL)) CYCLE
+ !
+ POLA(JL) = PYOUT(JL)
+ !
+ POLO(JL) = PXOUT(JL)
+ IF (POLO(JL) < PILO1_OUT) POLO(JL) = POLO(JL) + 360.
+ IF (POLO(JL) > PILO2_OUT) POLO(JL) = POLO(JL) - 360.
+ !
+ ! 3.1.1. find positions of latitudes
+ IF (PRESENT(PILATARRAY)) THEN
+ !
+ DO JL2 = 1,KINLA
+ IF((POLA(JL)>=PILATARRAY(JL2)-ZIDLAT(JL2)/2..AND.POLA(JL)<PILATARRAY(JL2)+ZIDLAT(JL2+1)/2.).OR.&
+ (POLA(JL)<=PILATARRAY(JL2)-ZIDLAT(JL2)/2..AND.POLA(JL)>PILATARRAY(JL2)+ZIDLAT(JL2+1)/2.)) THEN
+ KO(JL,3) = JL2
+ EXIT
+ ELSEIF (POLA(JL)>MAXVAL(PILATARRAY(:))) THEN
+ KO(JL,3) = MAXLOC(PILATARRAY,1)
+ ELSEIF (POLA(JL)<MINVAL(PILATARRAY(:))) THEN
+ KO(JL,3) = MINLOC(PILATARRAY,1)
+ ENDIF
+ ENDDO
+ PLA(JL,3) = PILATARRAY(KO(JL,3))
+ !
+ ELSE
+ !
+ KO(JL,3) = NINT( (POLA(JL)-PILA1)/ZIDLA - 0.5 ) ! because of the zero
+ IF ( KO(JL,3)<-1) CALL ABOR1_SFX('HORIBLE_SURF_INIT: INPUT DOMAIN SMALLER THAN OUTPUT ONE - LATITUDE')
+ !
+ PLA(JL,3) = PILA1 + KO(JL,3) * ZIDLA
+ !
+ KO (JL,3) = KO(JL,3) + 1
+ !
+ ENDIF
+ !
+ IF (PRESENT(PILATARRAY)) THEN
+ !
+ IF (KO(JL,3)==1) THEN
+ PLA(JL,4) = PILATARRAY(1) - ZIDLAT(1)
+ ELSE
+ PLA(JL,4) = PILATARRAY(KO(JL,3)-1)
+ ENDIF
+ IF (KO(JL,3)>=KINLA) THEN
+ PLA(JL,2) = PILATARRAY(KINLA) + ZIDLAT(KINLA)
+ ELSE
+ PLA(JL,2) = PILATARRAY(KO(JL,3)+1)
+ ENDIF
+ IF (KO(JL,3)>=KINLA) THEN
+ PLA(JL,1) = PILATARRAY(KINLA) + 2.*ZIDLAT(KINLA)
+ ELSE
+ PLA(JL,1) = PILATARRAY(KO(JL,3)+2)
+ ENDIF
+ !
+ ELSE
+ !
+ PLA(JL,1) = PLA(JL,3) + 2*ZIDLA
+ PLA(JL,2) = PLA(JL,3) + ZIDLA
+ PLA(JL,4) = PLA(JL,3) - ZIDLA
+ !
+ ENDIF
+ !
+ IF (OGLOBS) KO(JL,3) = KO(JL,3) + 2
+ !
+ KO(JL,1) = KO(JL,3) + 2
+ KO(JL,2) = KO(JL,3) + 1
+ KO(JL,4) = KO(JL,3) - 1
+ !
+ IF (.NOT.OGLOBS) THEN
+ KO(JL,1:2) = MIN(KO(JL,1:2),IINLA)
+ KO(JL,3:4) = MAX(KO(JL,3:4),1)
+ ENDIF
+ !
+ ! extra latitudes are computed symetrically compared to the poles
+ !
+ IF (OGLOBS) THEN
+ IF (KO(JL,3)==2) THEN
+ PLA(JL,4) = 2. * ZSOUTHPOLE - PLA(JL,1)
+ PLA(JL,3) = 2. * ZSOUTHPOLE - PLA(JL,2)
+ ELSEIF (KO(JL,3)==3) THEN
+ PLA(JL,4) = 2. * ZSOUTHPOLE - PLA(JL,3)
+ END IF
+ ENDIF
+ IF (OGLOBN) THEN
+ IF (KO(JL,3)==IINLA-2) THEN
+ PLA(JL,1) = 2. * ZNORTHPOLE - PLA(JL,4)
+ PLA(JL,2) = 2. * ZNORTHPOLE - PLA(JL,3)
+ ELSEIF (KO(JL,3)==IINLA-3) THEN
+ PLA(JL,1) = 2. * ZNORTHPOLE - PLA(JL,2)
+ END IF
+ ENDIF
+ !
+ IF ((KO(JL,4)<1).OR.ANY((KO(JL,:)>IINLA))) THEN
+ CALL ABOR1_SFX('HORIBLE_SURF_INIT: INPUT DOMAIN SMALLER THAN OUTPUT ONE - LATITUDE')
+ END IF
+ !
+END DO
+!
+IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_INIT',1,ZHOOK_HANDLE)
+!
+!------------------------------------------------------------------------------
+!
+!
+END SUBROUTINE HORIBL_SURF_INIT
diff --git a/src/SURFEX/horibl_surf_value.F90 b/src/SURFEX/horibl_surf_value.F90
new file mode 100644
index 0000000000000000000000000000000000000000..4f7913d0e29c5088e8f8d3e73fffdd8464c68b60
--- /dev/null
+++ b/src/SURFEX/horibl_surf_value.F90
@@ -0,0 +1,307 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE HORIBL_SURF_VALUE(KILEN,KOLEN,PAROUT,OINTERP,PARIN,KLSMIN,&
+ POLO,POLA,PLA,PLOP,&
+ KMASKIN,KLSMOUT )
+! ###########################################################################
+!
+!!**** *HORIBL_SURF_VALUE* - horitontal bilinear interpolation
+!!
+!! PURPOSE
+!! -------
+!!
+!! Interpolates a field, supports masks.
+!!
+!! METHOD
+!! ------
+!!
+!! This routine performs a bilinear interpolation based on the 12 surrounding
+!! points. It begins with an interpolation along the latitudes (with third order
+!! polynoms interpolation with 4 points and linear interpolation for 2 points)
+!! and then a second along the longitude (third order polynoms interpolation).
+!! Two interpolations are performed : first along the parallels then between the
+!! four resulting points.
+!!
+!! The disposition of the points is the following :
+!!
+!!
+!! N 1 2
+!!
+!! ^ 3 4 5 6
+!! | x
+!! | 7 8 9 10
+!! |
+!! 11 12
+!! S
+!! W ---------------> E
+!!
+!! Note : the name 'south', 'north', may not be exact if the last data point is
+!! to the south of first (delta latitude < 0). This does not affect computations.
+!!
+!! The formula used to compute the weight is :
+!! (Lon - Lon.i) . (Lon - Lon.i) . (Lon - Lon.i)
+!! Wi = ---------------------------------------------------
+!! (Lon.i - Lon.j) . (Lon.i - Lon.k) . (Lon.i - Lon.l)
+!! Where j,k,l are the other points of the line.
+!!
+!! When masks are used, points with different types than the output points are
+!! not taken in account (in the formula, the corresponding coefficient is set
+!! to 1). If no points of the same nature are available, the interpolation is
+!! performed anyway with the 12 points. It is the task of the calling program
+!! to react to this situation.
+!!
+!! When the inputs parameters define a circular map (or global), the inputs data
+!! are extended. The value of the parameter ODVECT is used to know if the datas
+!! are vectorial or scalar (this affects the sign of extended values).
+!!
+!! EXTERNAL
+!! --------
+!!
+!! subroutine FMLOOK_ll : to retrieve the logical unit number of the listing file
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! This routine is based on the one used by the software FULL-POS from Meteo France.
+!! More informations may be found in 'Book 1'
+!!
+!! AUTHOR
+!! ------
+!!
+!! J.Pettre & V.Bousquet
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! Original 07/01/1999
+!! 21/04/1999 (V. Masson) set correct prefixes and bug in
+!! a logical definition
+!! 21/04/1999 (V. Masson) bug in north and south poles
+!! extension for input map land-sea mask
+!! 27/05/1999 (V. Masson) bug in 'grib south pole'
+!! extrapolation (number of point per parallel)
+!! 27/05/1999 (V. Masson) bug in 'grib pole' extrapolation
+!! extra latitudes are now computed symetrically
+!! to the poles.
+!! 17/03/2010 (P. LeMoigne) bug in weights computations
+!! 16/06/2010 (G. Tanguy) bug in 'grib north pole"
+!! extrapolation (tabular PARIN not totaly filled)
+!!
+!------------------------------------------------------------------------------
+!
+!
+!* 0. DECLARATIONS
+! ---------------
+!
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODI_ABOR1_SFX
+!
+IMPLICIT NONE
+!
+!* 0.1. Declaration of arguments
+!
+INTEGER, INTENT(IN) :: KILEN
+INTEGER, INTENT(IN) :: KOLEN ! size of output array
+REAL, DIMENSION(:), INTENT(OUT) :: PAROUT ! output array
+LOGICAL, DIMENSION(:), INTENT(IN) :: OINTERP ! .true. where physical value is needed
+REAL, DIMENSION(:,:), INTENT(IN) :: PARIN
+INTEGER, DIMENSION(:,:), INTENT(IN) :: KLSMIN
+REAL, DIMENSION(:), INTENT(IN) :: POLO, POLA
+REAL, DIMENSION(:,:), INTENT(IN) :: PLA
+REAL, DIMENSION(:,:), INTENT(IN) :: PLOP
+INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASKIN ! input land/sea mask
+INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KLSMOUT ! output land/sea mask
+!
+!* 0.2. Declaration of local variables
+!
+! Weights of the latitudes and of the points
+REAL, DIMENSION(4) :: ZWV
+REAL, DIMENSION(12) :: ZWP
+ ! Land/sea mask coefficient for each point : 0 -> point not taken in account,
+ ! 1 -> point taken in account
+REAL, DIMENSION(12) :: ZLSMP
+REAL, DIMENSION(4) :: ZLSMV
+REAL :: ZLSMTOT
+ ! Variables implied in the extension procedure
+LOGICAL :: LDLSM ! Specify if land/sea mask is present or not
+ ! Loop counters
+INTEGER :: JL, JI ! Dummy counter
+!
+!------------------------------------------------------------------------------
+REAL, DIMENSION(3) :: ZP
+REAL :: ZMAX, ZT ! Max of 12 surrounding values
+REAL :: ZMIN ! Min of 12 surrounding values
+INTEGER :: JL2 ! Dummy counter
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
+!------------------------------------------------------------------------------
+!
+!* 1. DETERMINATION of the latitude of the poles (depending of the latitude
+! ------------- of the first data point)
+!
+IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_VALUE_1',0,ZHOOK_HANDLE)
+!
+LDLSM = .FALSE.
+IF (PRESENT(KMASKIN) .AND. PRESENT(KLSMOUT)) LDLSM = .TRUE.
+!
+!------------------------------------------------------------------------------
+!
+!* 3. LOOP OVER ALL THE POINTS OF THE OUTPUT GRID
+! -------------------------------------------
+!
+PAROUT(:) = XUNDEF
+!
+IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_VALUE_1',1,ZHOOK_HANDLE)
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_VALUE_2',0,ZHOOK_HANDLE_OMP)
+!$OMP DO SCHEDULE(DYNAMIC,1) PRIVATE(JL,ZLSMP,ZLSMV,ZLSMTOT,ZP,ZT,&
+!$OMP ZWV,ZWP,JI,ZMIN,ZMAX,JL2)
+DO JL = 1, KOLEN
+!
+ IF (.NOT. OINTERP(JL)) CYCLE
+!
+!* 3.2 Land / Sea mask
+!
+ ZLSMP(:) = 1.
+ ZLSMV(:) = 1.
+ !
+ IF (LDLSM) THEN
+ !
+ DO JI = 1,12
+ IF (KLSMIN(JL,JI).NE.KLSMOUT(JL)) ZLSMP(JI) = 0.
+ ENDDO
+ !
+ ZLSMV(1) = ZLSMP(1) + ZLSMP(2)
+ ZLSMV(2) = ZLSMP(3) + ZLSMP(4) + ZLSMP(5) + ZLSMP(6)
+ ZLSMV(3) = ZLSMP(7) + ZLSMP(8) + ZLSMP(9) + ZLSMP(10)
+ ZLSMV(4) = ZLSMP(11) + ZLSMP(12)
+ !
+ ZLSMV(:) = MIN(ZLSMV(:),1.)
+ ZLSMTOT = MIN(SUM(ZLSMV),1.)
+ !
+ IF (ZLSMV(1) < 1.E-3) ZLSMP (1:2) = 1.
+ IF (ZLSMV(2) < 1.E-3) ZLSMP (3:6) = 1.
+ IF (ZLSMV(3) < 1.E-3) ZLSMP (7:10) = 1.
+ IF (ZLSMV(4) < 1.E-3) ZLSMP(11:12) = 1.
+ IF (ZLSMTOT < 1.E-3) ZLSMV(:) = 1.
+ !
+ ENDIF
+!
+!* 3.3 Weight of points
+!
+ ZP(1) = PLA(JL,1) - PLA(JL,2)
+ ZP(2) = PLA(JL,1) - PLA(JL,3)
+ ZP(3) = PLA(JL,2) - PLA(JL,3)
+ !
+ ZT = POLA(JL) - PLA(JL,1)
+ ZWV(1) = ZLSMV(1) * (1.+ZLSMV(2)*ZT/ZP(1)) * (1.+ZLSMV(3)*ZT/ZP(2)) * (1.+ZLSMV(4)*ZT/(PLA(JL,1)-PLA(JL,4)))
+ ZT = POLA(JL) - PLA(JL,2)
+ ZWV(2) = ZLSMV(2) * (1.-ZLSMV(1)*ZT/ZP(1)) * (1.+ZLSMV(3)*ZT/ZP(3)) * (1.+ZLSMV(4)*ZT/(PLA(JL,2)-PLA(JL,4)))
+ ZT = POLA(JL) - PLA(JL,3)
+ ZWV(3) = ZLSMV(3) * (1.-ZLSMV(1)*ZT/ZP(2)) * (1.-ZLSMV(2)*ZT/ZP(3)) * (1.+ZLSMV(4)*ZT/(PLA(JL,3)-PLA(JL,4)))
+ ZWV(4) = 1. - ZWV(1) - ZWV(2) - ZWV(3)
+!
+ ! 3.3.1 northern
+ ZWP(1) = ZLSMP(1) * (1.+ZLSMP(2) *(POLO(JL) -PLOP(JL,1))/(PLOP(JL,1) -PLOP(JL,2)))
+ ZWP(2) = 1. - ZWP(1)
+ ! 3.3.4. southern
+ ZWP(11) = ZLSMP(11)* (1.+ZLSMP(12)*(POLO(JL)-PLOP(JL,11))/(PLOP(JL,11)-PLOP(JL,12)))
+ ZWP(12) = 1. - ZWP(11)
+
+ ! 3.3.2. north
+ ZP(1) = PLOP(JL,3) - PLOP(JL,4)
+ ZP(2) = PLOP(JL,3) - PLOP(JL,5)
+ ZP(3) = PLOP(JL,4) - PLOP(JL,5)
+ !
+ ZT = POLO(JL) - PLOP(JL,3)
+ ZWP(3) = ZLSMP(3) * (1.+ZLSMP(4)*ZT/ZP(1)) * (1.+ZLSMP(5)*ZT/ZP(2)) * (1.+ZLSMP(6)*ZT/(PLOP(JL,3)-PLOP(JL,6)))
+ ZT = POLO(JL) - PLOP(JL,4)
+ ZWP(4) = ZLSMP(4) * (1.-ZLSMP(3)*ZT/ZP(1)) * (1.+ZLSMP(5)*ZT/ZP(3)) * (1.+ZLSMP(6)*ZT/(PLOP(JL,4)-PLOP(JL,6)))
+ ZT = POLO(JL) - PLOP(JL,5)
+ ZWP(5) = ZLSMP(5) * (1.-ZLSMP(3)*ZT/ZP(2)) * (1.-ZLSMP(4)*ZT/ZP(3)) * (1.+ZLSMP(6)*ZT/(PLOP(JL,5)-PLOP(JL,6)))
+ ZWP(6) = 1. - ZWP(3) - ZWP(4) - ZWP(5)
+!
+ ! 3.3.3. south
+ ZP(1) = PLOP(JL,7) - PLOP(JL,8)
+ ZP(2) = PLOP(JL,7) - PLOP(JL,9)
+ ZP(3) = PLOP(JL,8) - PLOP(JL,9)
+ !
+ ZT = POLO(JL) - PLOP(JL,7)
+ ZWP(7) = ZLSMP(7) * (1.+ZLSMP(8)*ZT/ZP(1)) * (1.+ZLSMP(9)*ZT/ZP(2)) * (1.+ZLSMP(10)*ZT/(PLOP(JL,7)-PLOP(JL,10)))
+ ZT = POLO(JL) - PLOP(JL,8)
+ ZWP(8) = ZLSMP(8) * (1.-ZLSMP(7)*ZT/ZP(1)) * (1.+ZLSMP(9)*ZT/ZP(3)) * (1.+ZLSMP(10)*ZT/(PLOP(JL,8)-PLOP(JL,10)))
+ ZT = POLO(JL) - PLOP(JL,9)
+ ZWP(9) = ZLSMP(9) * (1.-ZLSMP(7)*ZT/ZP(2)) * (1.-ZLSMP(8)*ZT/ZP(3)) * (1.+ZLSMP(10)*ZT/(PLOP(JL,9)-PLOP(JL,10)))
+ ZWP(10) = 1. - ZWP(7) - ZWP(8) - ZWP(9)
+!
+! In order to exclude undef values from computation of PAROUT,
+! weights w2, w6, w10, w12 and wss which can be numerically very low
+! because they are residual, are set to 0
+!
+ IF (ABS(ZWP(2)) < 1.E-10) ZWP(2) =0.
+ IF (ABS(ZWP(6)) < 1.E-10) ZWP(6) =0.
+ IF (ABS(ZWP(10))< 1.E-10) ZWP(10)=0.
+ IF (ABS(ZWP(12))< 1.E-10) ZWP(12)=0.
+ IF (ABS(ZWV(4)) < 1.E-10) ZWV(4) =0.
+!
+ ! 3.3.5. longitude weight x latitude weight
+ ZWP(1:2) = ZWP(1:2) * ZWV(1)
+ ZWP(3:6) = ZWP(3:6) * ZWV(2)
+ ZWP(7:10) = ZWP(7:10) * ZWV(3)
+ ZWP(11:12) = ZWP(11:12) * ZWV(4)
+ WHERE (ZWP(:)<1.E-4) ZWP(:) = 0.
+ ZWP(:) = ZWP(:) / SUM(ZWP)
+!
+ PAROUT(JL) = 0.
+ DO JI = 1,12
+ PAROUT(JL) = PAROUT(JL) + ZWP(JI) * PARIN(JL,JI)
+ ENDDO
+!
+! For surface fields, the interpoalted value is bounded
+! by the min max values of the initial field
+
+ IF (PRESENT(KMASKIN)) THEN
+
+ ZMIN=XUNDEF
+ ZMAX=XUNDEF
+
+ DO JL2=1,12
+ IF (PARIN(JL,JL2)==XUNDEF) CYCLE
+
+ IF ((ZMAX==XUNDEF)) THEN
+ ZMAX=PARIN(JL,JL2)
+ ZMIN=PARIN(JL,JL2)
+ ELSE
+ ZMAX=MAX(ZMAX,PARIN(JL,JL2))
+ ZMIN=MIN(ZMIN,PARIN(JL,JL2))
+ ENDIF
+
+ END DO
+
+ PAROUT(JL) = MAX(MIN(PAROUT(JL),ZMAX),ZMIN)
+
+ ENDIF
+
+END DO
+!$OMP END DO
+IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_VALUE_2',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
+!
+IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_VALUE_3',0,ZHOOK_HANDLE)
+WHERE(ABS(PAROUT-XUNDEF)<1.E-6) PAROUT=XUNDEF
+IF (LHOOK) CALL DR_HOOK('HORIBL_SURF_VALUE_3',1,ZHOOK_HANDLE)
+!
+!------------------------------------------------------------------------------
+!
+!
+END SUBROUTINE HORIBL_SURF_VALUE
diff --git a/src/SURFEX/hvac_autosize.F90 b/src/SURFEX/hvac_autosize.F90
index 73bcc5cbba76873ecccdc5d48f8f9a1bcfb1e8e2..b600627f5117f6cc0779fdaba1e1b886070e2ee5 100644
--- a/src/SURFEX/hvac_autosize.F90
+++ b/src/SURFEX/hvac_autosize.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #############################################################
-SUBROUTINE HVAC_AUTOSIZE (BDD, DTCO, DGU, B, BOP, UG, U, TG, T, TOP, &
- KI,KLUOUT)
+SUBROUTINE HVAC_AUTOSIZE (B, BOP, G, T, TOP, KI,KLUOUT)
! #############################################################
!!
!! PURPOSE
@@ -28,21 +27,18 @@ SUBROUTINE HVAC_AUTOSIZE (BDD, DTCO, DGU, B, BOP, UG, U, TG, T, TOP, &
!
!
!
-USE MODD_BLD_DESCRIPTION_n, ONLY : BLD_DESC_t
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_BEM_n, ONLY : BEM_t
USE MODD_BEM_OPTION_n, ONLY : BEM_OPTIONS_t
-USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_TEB_IRRIG_n, ONLY : TEB_IRRIG_t
USE MODD_TEB_n, ONLY : TEB_t
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
+USE MODD_TEB_IRRIG_n, ONLY : TEB_IRRIG_t, TEB_IRRIG_INIT
+USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_t, DIAG_MISC_TEB_INIT
+USE MODD_DIAG_MISC_TEB_OPTIONS_n, ONLY : DIAG_MISC_TEB_OPTIONS_t, DIAG_MISC_TEB_OPTIONS_INIT
!
-!
-USE MODD_CSTS, ONLY : XCPD, XPI, XP00, XRD, XSTEFAN
-!
-USE MODD_SURFEX_OMP, ONLY : NBLOCKTOT
+USE MODD_CSTS, ONLY : XCPD, XPI, XP00, XRD, XSTEFAN
!
USE MODI_TEB
USE MODI_SUNPOS
@@ -50,76 +46,109 @@ USE MODI_SW_DAYCYCLE
USE MODI_URBAN_LW_COEF
USE MODI_URBAN_SOLAR_ABS
USE MODI_GET_SIZES_PARALLEL
+USE MODI_DIAG_MISC_TEB_INIT_n
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
#ifdef AIX64
-!$ USE OMP_LIB
+USE OMP_LIB
#endif
!
IMPLICIT NONE
!
#ifndef AIX64
-!$ INCLUDE 'omp_lib.h'
+ INCLUDE 'omp_lib.h'
#endif
!
!* 0.1 Declaration of arguments
! ------------------------
!
-TYPE(BLD_DESC_t), INTENT(INOUT) :: BDD
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(BEM_t), INTENT(INOUT) :: B
TYPE(BEM_OPTIONS_t), INTENT(INOUT) :: BOP
-TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
+TYPE(GRID_t), INTENT(INOUT) :: G
TYPE(TEB_t), INTENT(INOUT) :: T
TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
!
-!
INTEGER, INTENT(IN) :: KI ! number of points
INTEGER, INTENT(IN) :: KLUOUT ! output listing logical unit
!
!* 0.2 Declaration of local variables
! ------------------------------
!
-LOGICAL, PARAMETER :: GCANOPY=.FALSE.
- CHARACTER(LEN=3), PARAMETER :: YBEM='BEM'
-
-REAL, PARAMETER :: PPTSTEP = 300.
-INTEGER, PARAMETER :: JPYEAR = 2004 ! Current year (UTC)
-
+!-------------------------------------------------------------------------
+!
+TYPE(DIAG_MISC_TEB_t) :: YDMTC
+TYPE(DIAG_MISC_TEB_t) :: YDMT
+TYPE(DIAG_MISC_TEB_OPTIONS_t) :: YDMTO
+TYPE(TEB_IRRIG_t) :: YTIR
+!
+! Options TOP
+!
+LOGICAL :: GCANOPY
+ CHARACTER(LEN=3) :: YBEM
+ CHARACTER(LEN=6) :: YZ0H
+ CHARACTER(LEN=5) :: YCH_BEM
+!
+! Teb Fields T
+!
+REAL, DIMENSION(KI) :: ZGD
+!
+! Bem Options BOP
+!
+ CHARACTER(LEN=6) :: YCOOL_COIL
+ CHARACTER(LEN=6) :: YHEAT_COIL
+!
+! Bem!
+ CHARACTER(LEN=4),DIMENSION(KI) :: YNATVENT
+REAL, DIMENSION(KI) :: ZF_WATER_COND
+REAL, DIMENSION(KI) :: ZAUX_MAX
+REAL, DIMENSION(KI) :: ZT_WIN2
+LOGICAL, DIMENSION(KI) :: GNATVENT_NIGHT
+!
+! Road irrigation (not used here)
+!
+TYPE(TEB_IRRIG_t) :: YIR
+!
+!-------------------------------------------------------------------------
+!
+REAL, PARAMETER :: ZTSTEP = 300.
+INTEGER, PARAMETER :: JPYEAR = 2004 ! Current year (UTC)
+!
!local variable
-INTEGER :: IMONTH ! Current month (UTC)
-INTEGER :: IDAY ! Current day (UTC)
-REAL :: ZTIME ! Time at start of the run (s)
-!
-REAL, DIMENSION(KI) :: ZU_ROOF
-REAL, DIMENSION(KI) :: ZU_WALL
-REAL, DIMENSION(KI) :: ZT_CANYON
-REAL, DIMENSION(KI) :: ZQ_CANYON
-REAL, DIMENSION(KI) :: ZU_CANYON
-REAL, DIMENSION(KI) :: ZZ_LOWCAN
-REAL, DIMENSION(KI) :: ZDIR_SW
-REAL, DIMENSION(KI) :: ZSCA_SW
!
- CHARACTER(LEN=3) :: HIMPLICIT_WIND
- CHARACTER(LEN=6) :: HZ0H
- CHARACTER(LEN=5) :: YCH_BEM
+INTEGER :: IMONTH = 7 ! Current month (UTC)
+INTEGER :: IDAY = 12 ! Current day (UTC)
+REAL :: ZTIME = 0. ! Time at start of the run (s)
+!
+ CHARACTER(LEN=3) :: YIMPLICIT_WIND = 'NEW'
+!
+! Loop control indexes
+!
INTEGER :: JJ
INTEGER :: JFORC_STEP
INTEGER :: INB_STEP_ATM
!
-REAL, DIMENSION(KI) :: ZFRAC_PANEL
-REAL, DIMENSION(KI) :: ZALB_PANEL
-!! GREGOIRE 13/03
-REAL, DIMENSION(KI) :: ZROAD
-REAL, DIMENSION(KI) :: ZGARDEN
-REAL, DIMENSION(KI) :: ZSVF_GARDEN
-!! GREGOIRE 13/03
-REAL, DIMENSION(KI) :: ZZREF
+! Intermediate variables
+!
+REAL, DIMENSION(KI) :: ZU_RF
+REAL, DIMENSION(KI) :: ZU_WL
+!
+REAL,DIMENSION(KI) :: ZT1 ! intermediate variable
+REAL,DIMENSION(KI) :: ZTN ! intermediate variable
+!
+REAL, DIMENSION(KI) :: ZT_SKY
+!
+REAL, DIMENSION(KI) :: ZTOT_SW
+REAL, DIMENSION(KI) :: ZTOUT_EQ
+!
+! Arguments to TEB
+!
+REAL, DIMENSION(KI) :: ZT_CAN
+REAL, DIMENSION(KI) :: ZQ_CAN
+REAL, DIMENSION(KI) :: ZU_CAN
+REAL, DIMENSION(KI) :: ZZ_LOWCAN
+!
REAL, DIMENSION(KI) :: ZPS
REAL, DIMENSION(KI) :: ZPA
REAL, DIMENSION(KI) :: ZEXNS
@@ -128,232 +157,153 @@ REAL, DIMENSION(KI) :: ZTA
REAL, DIMENSION(KI) :: ZQA
REAL, DIMENSION(KI) :: ZRHOA
REAL, DIMENSION(KI) :: ZLW_RAD
-REAL, DIMENSION(KI) :: ZASNOW_ROOF
-REAL, DIMENSION(KI) :: ZASNOW_ROAD
-REAL, DIMENSION(KI) :: ZDN_ROOF
-REAL, DIMENSION(KI) :: ZDF_ROOF
-REAL, DIMENSION(KI) :: ZDN_ROAD
-REAL, DIMENSION(KI) :: ZDF_ROAD
-REAL, DIMENSION(KI) :: ZEMIS_GARDEN
-REAL, DIMENSION(KI) :: ZESNOW_ROAD
-REAL, DIMENSION(KI) :: ZTSSNOW_ROAD
-REAL, DIMENSION(KI) :: ZWS_ROOF
-REAL, DIMENSION(KI) :: ZWS_ROAD
- CHARACTER(LEN=4) :: HSNOW_ROOF
-REAL, DIMENSION(KI,1):: ZWSNOW_ROOF
-REAL, DIMENSION(KI,1) :: ZTSNOW_ROOF
-REAL, DIMENSION(KI,1) :: ZRSNOW_ROOF
-REAL, DIMENSION(KI) :: ZTSSNOW_ROOF
-REAL, DIMENSION(KI) :: ZESNOW_ROOF
- CHARACTER(LEN=4) :: HSNOW_ROAD
-REAL, DIMENSION(KI,1) :: ZWSNOW_ROAD
-REAL, DIMENSION(KI,1) :: ZTSNOW_ROAD
-REAL, DIMENSION(KI,1) :: ZRSNOW_ROAD
REAL, DIMENSION(KI) :: ZRR
REAL, DIMENSION(KI) :: ZSR
-REAL, DIMENSION(KI) :: ZQSAT_ROOF
-REAL, DIMENSION(KI) :: ZQSAT_ROAD
-REAL, DIMENSION(KI) :: ZDELT_ROOF
-REAL, DIMENSION(KI) :: ZDELT_ROAD
-REAL, DIMENSION(KI) :: ZABS_SW_ROOF
-REAL, DIMENSION(KI) :: ZABS_SW_ROAD
-REAL, DIMENSION(KI) :: ZABS_SW_WALL_A
-REAL, DIMENSION(KI) :: ZABS_SW_WALL_B
-REAL, DIMENSION(KI) :: ZABS_SW_GARDEN
-REAL, DIMENSION(KI) :: ZABS_SW_GREENROOF
-REAL, DIMENSION(KI) :: ZABS_SW_PANEL
-REAL, DIMENSION(KI) :: ZABS_SW_SNOW_ROOF
-REAL, DIMENSION(KI) :: ZABS_SW_SNOW_ROAD
-REAL, DIMENSION(KI) :: ZREC_SW_ROAD
-REAL, DIMENSION(KI) :: ZREC_SW_SNOW_ROAD
-REAL, DIMENSION(KI) :: ZREC_SW_WALL_A
-REAL, DIMENSION(KI) :: ZREC_SW_WALL_B
-REAL, DIMENSION(KI) :: ZREC_SW_GARDEN
-REAL, DIMENSION(KI) :: ZREC_SW_ROOF
-REAL, DIMENSION(KI) :: ZABS_LW_ROOF ! absorbed IR rad by roof
-REAL, DIMENSION(KI) :: ZABS_LW_SNOW_ROOF ! absorbed IR rad by snow on roof
-REAL, DIMENSION(KI) :: ZABS_LW_ROAD ! absorbed IR rad by road
-REAL, DIMENSION(KI) :: ZABS_LW_SNOW_ROAD ! absorbed IR rad by snow on road
-REAL, DIMENSION(KI) :: ZABS_LW_WALL_A ! absorbed IR rad by wall
-REAL, DIMENSION(KI) :: ZABS_LW_WALL_B ! absorbed IR rad by wall
-REAL, DIMENSION(KI) :: ZDIR_ALB_TOWN
-REAL, DIMENSION(KI) :: ZSCA_ALB_TOWN
-REAL, DIMENSION(KI) :: ZSW_RAD_GARDEN
-REAL, DIMENSION(KI) :: ZABS_SW_WIN
-REAL, DIMENSION(KI) :: ZREC_SW_WIN
-REAL, DIMENSION(KI) :: ZREF_SW_GRND
-REAL, DIMENSION(KI) :: ZREF_SW_FAC
-REAL,DIMENSION(KI) :: ZT1 ! intermediate variable
-REAL,DIMENSION(KI) :: ZTN ! intermediate variable
-REAL,DIMENSION(KI,TOP%NROAD_LAYER ) :: ZT_ROAD ! road layers temperatures
-REAL,DIMENSION(KI,TOP%NROOF_LAYER) :: ZT_ROOF ! roof layers temperatures
-REAL,DIMENSION(KI,TOP%NWALL_LAYER) :: ZT_WALL_A ! wall layers temperatures
-REAL,DIMENSION(KI,TOP%NWALL_LAYER) :: ZT_WALL_B ! wall layers temperatures
-REAL,DIMENSION(KI,BOP%NFLOOR_LAYER ) :: ZT_FLOOR ! building floor temperature
-REAL,DIMENSION(KI,BOP%NFLOOR_LAYER ) :: ZT_MASS ! building mass temperature
-REAL, DIMENSION(KI) :: ZTS_GARDEN
-REAL, DIMENSION(KI) :: ZT_WIN1
+REAL, DIMENSION(KI) :: ZZREF
+!
+REAL, DIMENSION(KI) :: ZPEW_A_COEF
+REAL, DIMENSION(KI) :: ZPEW_B_COEF
+!
+REAL, DIMENSION(KI) :: ZTS_GD
+!
+REAL, DIMENSION(KI) :: ZDF_RF
+REAL, DIMENSION(KI) :: ZDN_RF
+REAL, DIMENSION(KI) :: ZDN_RD
+REAL, DIMENSION(KI) :: ZDF_RD
+!
+REAL, DIMENSION(KI) :: ZQSAT_RF
+REAL, DIMENSION(KI) :: ZQSAT_RD
+REAL, DIMENSION(KI) :: ZDELT_RF
+REAL, DIMENSION(KI) :: ZDELT_RD
+!
+ CHARACTER(LEN=4) :: YSNOW_RF
+ CHARACTER(LEN=4) :: YSNOW_RD
+!
REAL, DIMENSION(KI) :: ZLW_WA_TO_WB ! longwave exchange coefficients
REAL, DIMENSION(KI) :: ZLW_WA_TO_R
REAL, DIMENSION(KI) :: ZLW_WB_TO_R
REAL, DIMENSION(KI) :: ZLW_WA_TO_NR
REAL, DIMENSION(KI) :: ZLW_WB_TO_NR
-REAL, DIMENSION(KI) :: ZLW_WA_TO_G
-REAL, DIMENSION(KI) :: ZLW_WB_TO_G
-REAL, DIMENSION(KI) :: ZLW_WA_TO_WIN
-REAL, DIMENSION(KI) :: ZLW_WB_TO_WIN
REAL, DIMENSION(KI) :: ZLW_R_TO_WA
REAL, DIMENSION(KI) :: ZLW_R_TO_WB
-REAL, DIMENSION(KI) :: ZLW_R_TO_WIN
REAL, DIMENSION(KI) :: ZLW_G_TO_WA
REAL, DIMENSION(KI) :: ZLW_G_TO_WB
-REAL, DIMENSION(KI) :: ZLW_G_TO_WIN
REAL, DIMENSION(KI) :: ZLW_S_TO_WA
REAL, DIMENSION(KI) :: ZLW_S_TO_WB
REAL, DIMENSION(KI) :: ZLW_S_TO_R
REAL, DIMENSION(KI) :: ZLW_S_TO_NR
-REAL, DIMENSION(KI) :: ZLW_S_TO_G
+REAL, DIMENSION(KI) :: ZLW_NR_TO_WA
+REAL, DIMENSION(KI) :: ZLW_NR_TO_WB
+REAL, DIMENSION(KI) :: ZLW_NR_TO_WIN
+REAL, DIMENSION(KI) :: ZLW_WA_TO_WIN
+REAL, DIMENSION(KI) :: ZLW_WB_TO_WIN
+REAL, DIMENSION(KI) :: ZLW_G_TO_WIN
+REAL, DIMENSION(KI) :: ZLW_R_TO_WIN
REAL, DIMENSION(KI) :: ZLW_S_TO_WIN
REAL, DIMENSION(KI) :: ZLW_WIN_TO_WA
REAL, DIMENSION(KI) :: ZLW_WIN_TO_WB
REAL, DIMENSION(KI) :: ZLW_WIN_TO_R
REAL, DIMENSION(KI) :: ZLW_WIN_TO_NR
-REAL, DIMENSION(KI) :: ZLW_WIN_TO_G
-REAL, DIMENSION(KI) :: ZLW_NR_TO_WA
-REAL, DIMENSION(KI) :: ZLW_NR_TO_WB
-REAL, DIMENSION(KI) :: ZLW_NR_TO_WIN
-REAL, DIMENSION(KI) :: ZTI_BLD
-REAL, DIMENSION(KI) :: ZRN_ROOF ! net radiation over roof
-REAL, DIMENSION(KI) :: ZH_ROOF ! sensible heat flux over roof
-REAL, DIMENSION(KI) :: ZLE_ROOF ! latent heat flux over roof
-REAL, DIMENSION(KI) :: ZLEW_ROOF ! latent heat flux over roof (snow)
-REAL, DIMENSION(KI) :: ZGFLUX_ROOF ! flux through the roof
-REAL, DIMENSION(KI) :: ZRUNOFF_ROOF ! runoff over the ground
-REAL, DIMENSION(KI) :: ZRN_ROAD ! net radiation over road
-REAL, DIMENSION(KI) :: ZH_ROAD ! sensible heat flux over road
-REAL, DIMENSION(KI) :: ZLE_ROAD ! latent heat flux over road
-REAL, DIMENSION(KI) :: ZLEW_ROAD ! latent heat flux over road (snow)
-REAL, DIMENSION(KI) :: ZGFLUX_ROAD ! flux through the road
-REAL, DIMENSION(KI) :: ZRUNOFF_ROAD ! runoff over the ground
-REAL, DIMENSION(KI) :: ZRN_WALL_A ! net radiation over wall
-REAL, DIMENSION(KI) :: ZH_WALL_A ! sensible heat flux over wall
-REAL, DIMENSION(KI) :: ZLE_WALL_A ! latent heat flux over wall
-REAL, DIMENSION(KI) :: ZGFLUX_WALL_A ! flux through the wall
-REAL, DIMENSION(KI) :: ZRN_WALL_B ! net radiation over wall
-REAL, DIMENSION(KI) :: ZH_WALL_B ! sensible heat flux over wall
-REAL, DIMENSION(KI) :: ZLE_WALL_B ! latent heat flux over wall
-REAL, DIMENSION(KI) :: ZGFLUX_WALL_B ! flux through the wall
-REAL, DIMENSION(KI) :: ZRN_BLT ! net radiation over built surf
-REAL, DIMENSION(KI) :: ZH_BLT ! sensible heat flux over built surf
-REAL, DIMENSION(KI) :: ZLE_BLT ! latent heat flux over built surf
-REAL, DIMENSION(KI) :: ZGFLUX_BLT ! flux through the built surf
-REAL, DIMENSION(KI) :: ZRNSNOW_ROOF ! net radiation over snow
-REAL, DIMENSION(KI) :: ZHSNOW_ROOF ! sensible heat flux over snow
-REAL, DIMENSION(KI) :: ZLESNOW_ROOF ! latent heat flux over snow
-REAL, DIMENSION(KI) :: ZGSNOW_ROOF ! flux under the snow
-REAL, DIMENSION(KI) :: ZMELT_ROOF ! snow melt
-REAL, DIMENSION(KI) :: ZRNSNOW_ROAD ! net radiation over snow
-REAL, DIMENSION(KI) :: ZHSNOW_ROAD ! sensible heat flux over snow
-REAL, DIMENSION(KI) :: ZLESNOW_ROAD ! latent heat flux over snow
-REAL, DIMENSION(KI) :: ZGSNOW_ROAD ! flux under the snow
-REAL, DIMENSION(KI) :: ZMELT_ROAD ! snow melt
-REAL, DIMENSION(KI) :: ZUW_ROAD ! Momentum flux for roads
-REAL, DIMENSION(KI) :: ZUW_ROOF ! Momentum flux for roofs
-REAL, DIMENSION(KI) :: ZDUWDU_ROAD !
-REAL, DIMENSION(KI) :: ZDUWDU_ROOF !
-REAL, DIMENSION(KI) :: ZUSTAR_TOWN ! friction velocity over town
+!
+REAL, DIMENSION(KI) :: ZLEW_RF ! latent heat flux over roof (snow)
+!
+REAL, DIMENSION(KI) :: ZLEW_RD ! latent heat flux over road (snow)
+!
+REAL, DIMENSION(KI) :: ZLE_WL_A ! latent heat flux over wall
+REAL, DIMENSION(KI) :: ZLE_WL_B ! latent heat flux over wall
+
+!
+REAL, DIMENSION(KI) :: ZRNSNOW_RF ! net radiation over snow
+REAL, DIMENSION(KI) :: ZHSNOW_RF ! sensible heat flux over snow
+REAL, DIMENSION(KI) :: ZLESNOW_RF ! latent heat flux over snow
+REAL, DIMENSION(KI) :: ZGSNOW_RF ! flux under the snow
+REAL, DIMENSION(KI) :: ZMELT_RF ! snow melt
+!
+REAL, DIMENSION(KI) :: ZRNSNOW_RD ! net radiation over snow
+REAL, DIMENSION(KI) :: ZHSNOW_RD ! sensible heat flux over snow
+REAL, DIMENSION(KI) :: ZLESNOW_RD ! latent heat flux over snow
+REAL, DIMENSION(KI) :: ZGSNOW_RD ! flux under the snow
+REAL, DIMENSION(KI) :: ZMELT_RD ! snow melt
+!
+REAL, DIMENSION(KI) :: ZUW_RD ! Momentum flux for roads
+REAL, DIMENSION(KI) :: ZUW_RF ! Momentum flux for roofs
+REAL, DIMENSION(KI) :: ZDUWDU_RD !
+REAL, DIMENSION(KI) :: ZDUWDU_RF !
+REAL, DIMENSION(KI) :: ZUSTAR_TWN ! friction velocity over town
+!
REAL, DIMENSION(KI) :: ZCD ! town averaged drag coefficient
REAL, DIMENSION(KI) :: ZCDN ! town averaged neutral drag coefficient
-REAL, DIMENSION(KI) :: ZCH_TOWN ! town averaged heat transfer coefficient
-REAL, DIMENSION(KI) :: ZRI_TOWN ! town averaged Richardson number
-REAL, DIMENSION(KI) :: ZRESA_TOWN ! town aerodynamical resistance
-REAL, DIMENSION(KI) :: ZDQS_TOWN ! heat storage inside town
-REAL, DIMENSION(KI) :: ZQF_TOWN ! total anthropogenic heat
-REAL, DIMENSION(KI) :: ZQF_BLD ! anthropogenic heat flux of domestic heating
-REAL, DIMENSION(KI) :: ZFLX_BLD ! heat flux between inside of the bld
-REAL, DIMENSION(KI) :: ZAC_ROOF ! roof conductance
-REAL, DIMENSION(KI) :: ZAC_ROAD ! road conductance
-REAL, DIMENSION(KI) :: ZAC_WALL ! wall conductance
+REAL, DIMENSION(KI) :: ZCH_TWN ! town averaged heat transfer coefficient
+REAL, DIMENSION(KI) :: ZRI_TWN ! town averaged Richardson number
+REAL, DIMENSION(KI) :: ZRESA_TWN ! town aerodynamical resistance
+REAL, DIMENSION(KI) :: ZAC_RF ! roof conductance
+REAL, DIMENSION(KI) :: ZAC_RD ! road conductance
+REAL, DIMENSION(KI) :: ZAC_WL ! wall conductance
REAL, DIMENSION(KI) :: ZAC_TOP ! top conductance
-REAL, DIMENSION(KI) :: ZAC_GARDEN ! garden conductance
-REAL, DIMENSION(KI) :: ZAC_ROOF_WAT ! roof water conductance
-REAL, DIMENSION(KI) :: ZAC_ROAD_WAT ! roof water conductance
-REAL, DIMENSION(KI) :: ZH_BLD_COOL
-REAL, DIMENSION(KI) :: ZT_BLD_COOL
-REAL, DIMENSION(KI) :: ZH_BLD_HEAT
-REAL, DIMENSION(KI) :: ZLE_BLD_COOL
-REAL, DIMENSION(KI) :: ZLE_BLD_HEAT
-REAL, DIMENSION(KI) :: ZH_WASTE
-REAL, DIMENSION(KI) :: ZLE_WASTE
-REAL, DIMENSION(KI) :: ZHVAC_COOL
-REAL, DIMENSION(KI) :: ZHVAC_HEAT
-REAL, DIMENSION(KI) :: ZT_WIN2
-REAL, DIMENSION(KI) :: ZQI_BLD
-REAL, DIMENSION(KI) :: ZM_SYS
-REAL, DIMENSION(KI) :: ZQ_SYS
-REAL, DIMENSION(KI) :: ZT_SYS
-REAL, DIMENSION(KI) :: ZTR_SW_WIN
-REAL, DIMENSION(KI) :: ZFAN_POWER
-REAL, DIMENSION(KI) :: ZABS_LW_WIN
+REAL, DIMENSION(KI) :: ZAC_GD ! garden conductance
+REAL, DIMENSION(KI) :: ZAC_RF_WAT ! roof water conductance
+REAL, DIMENSION(KI) :: ZAC_RD_WAT ! roof water conductance
REAL, DIMENSION(KI) :: ZEMIT_LW_FAC
-REAL, DIMENSION(KI) :: ZEMIT_LW_ROAD
+REAL, DIMENSION(KI) :: ZEMIT_LW_RD
REAL, DIMENSION(KI) :: ZT_RAD_IND
REAL, DIMENSION(KI) :: ZHU_BLD
REAL, DIMENSION(KI) :: ZTSUN
+!
+! Arguments to urban_solar_abs
+!
REAL, DIMENSION(KI) :: ZZENITH
REAL, DIMENSION(KI) :: ZAZIM
-REAL, DIMENSION(KI) :: ZALB_GARDEN
-REAL, DIMENSION(KI) :: ZALB_GREENROOF
-REAL, DIMENSION(KI) :: ZAUX_MAX
-REAL, DIMENSION(KI) :: ZCAP_SYS
-REAL, DIMENSION(KI) :: ZCOP
-REAL, DIMENSION(KI) :: ZPEW_A_COEF
-REAL, DIMENSION(KI) :: ZPEW_B_COEF
-REAL, DIMENSION(KI) :: ZTOT_SW
-REAL, DIMENSION(KI) :: ZTOUT_EQ
-REAL, DIMENSION(KI) :: ZT_SKY
-REAL, DIMENSION(KI) :: ZF_WATER_COND
+!
+REAL, DIMENSION(KI) :: ZDIR_SW
+REAL, DIMENSION(KI) :: ZSCA_SW
+!
+REAL, DIMENSION(KI) :: ZFRAC_PANEL
+REAL, DIMENSION(KI) :: ZALB_PANEL
+REAL, DIMENSION(KI) :: ZSVF_GD
+!
+REAL, DIMENSION(KI) :: ZREC_SW_RD
+REAL, DIMENSION(KI) :: ZREC_SW_SNOW_RD
+REAL, DIMENSION(KI) :: ZREC_SW_WL_A
+REAL, DIMENSION(KI) :: ZREC_SW_WL_B
+REAL, DIMENSION(KI) :: ZREC_SW_GD
+REAL, DIMENSION(KI) :: ZREC_SW_RF
+!
+REAL, DIMENSION(KI) :: ZDIR_ALB_TWN
+REAL, DIMENSION(KI) :: ZSCA_ALB_TWN
+REAL, DIMENSION(KI) :: ZSW_RAD_GD
+REAL, DIMENSION(KI) :: ZREC_SW_WIN
+REAL, DIMENSION(KI) :: ZREF_SW_GRND
+REAL, DIMENSION(KI) :: ZREF_SW_FAC
+!
+REAL, DIMENSION(KI) :: ZALB_GR
+REAL, DIMENSION(KI) :: ZALB_GD
+!
+! Arguments to urban_lw_coef
+!
+REAL, DIMENSION(KI) :: ZEMIS_GD
+!
+REAL, DIMENSION(KI) :: ZLW_WA_TO_G
+REAL, DIMENSION(KI) :: ZLW_WB_TO_G
+REAL, DIMENSION(KI) :: ZLW_S_TO_G
+REAL, DIMENSION(KI) :: ZLW_WIN_TO_G
+!
+!! GREGOIRE 13/03
+!
!
!new for shading
REAL, DIMENSION(KI) :: ZE_SHADING
LOGICAL, DIMENSION(KI) :: GSHAD_DAY
LOGICAL, DIMENSION(KI) :: GSHADE
-LOGICAL, DIMENSION(KI) :: GNATVENT_NIGHT
!
- CHARACTER(LEN=6) :: YCOOL_COIL
- CHARACTER(LEN=6) :: YHEAT_COIL
- CHARACTER(LEN=4),DIMENSION(KI) :: YNATVENT
!
! Case greenroof
-REAL, DIMENSION(KI) :: ZRN_GREENROOF
-REAL, DIMENSION(KI) :: ZH_GREENROOF
-REAL, DIMENSION(KI) :: ZLE_GREENROOF
-REAL, DIMENSION(KI) :: ZGFLUX_GREENROOF
-REAL, DIMENSION(KI) :: ZRUNOFF_GREENROOF
-REAL, DIMENSION(KI) :: ZDRAIN_GREENROOF
-REAL, DIMENSION(KI) :: ZUW_GREENROOF
-REAL, DIMENSION(KI) :: ZG_GREENROOF_ROOF
-REAL, DIMENSION(KI) :: ZRN_STRLROOF
-REAL, DIMENSION(KI) :: ZH_STRLROOF
-REAL, DIMENSION(KI) :: ZLE_STRLROOF
-REAL, DIMENSION(KI) :: ZGFLUX_STRLROOF
-REAL, DIMENSION(KI) :: ZRUNOFF_STRLROOF
-!
-! Road irrigation (not used here)
-LOGICAL :: GPAR_RD_IRRIG = .FALSE.
-REAL, DIMENSION(KI) :: ZRD_START_MONTH
-REAL, DIMENSION(KI) :: ZRD_END_MONTH
-REAL, DIMENSION(KI) :: ZRD_START_HOUR
-REAL, DIMENSION(KI) :: ZRD_END_HOUR
-REAL, DIMENSION(KI) :: ZRD_24H_IRRIG
-REAL, DIMENSION(KI) :: ZIRRIG_ROAD
-!
-INTEGER, DIMENSION(:), ALLOCATABLE :: ISIZE_OMP
-!
-!RJ: temp variable for OMP region handling
-#ifdef RJ_OFIX
-INTEGER :: INBLOCKTOT
-#endif
+REAL, DIMENSION(KI) :: ZUW_GR
+REAL, DIMENSION(KI) :: ZRN_GR
+REAL, DIMENSION(KI) :: ZH_GR
+REAL, DIMENSION(KI) :: ZLE_GR
+REAL, DIMENSION(KI) :: ZGFLUX_GR
+REAL, DIMENSION(KI) :: ZRUNOFF_GR
+REAL, DIMENSION(KI) :: ZDRAIN_GR
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -362,369 +312,435 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('HVAC_AUTOSIZE',0,ZHOOK_HANDLE)
!
-HIMPLICIT_WIND = 'NEW'
-!
-! Date
-IMONTH = 7
-IDAY = 12
-ZTIME = 0.
-!
! Design parameters
-ZZREF = 50.
-ZPS = 101325.
-ZQA = 0.011
-ZU_CANYON = 2.5
-ZAUX_MAX = 0.
-ZT_SKY = 253.15
-!
-!
-! Initialization
-B%CUR%XM_SYS_RAT = 0.
-B%CUR%XCAP_SYS_RAT = 0.
-B%CUR%XCAP_SYS_HEAT = 0.
-ZLW_RAD= 300.
!
-! Non-used parameters
-ZZ_LOWCAN = ZZREF
-HZ0H = 'KAND07'
-YCH_BEM = 'DOE-2'
-
-
-INB_STEP_ATM = 3600*24*4/PPTSTEP
+ZPS = 101325.
ZPA = ZPS
ZEXNS = (ZPS/XP00)**(XRD/XCPD)
ZEXNA = (ZPA/XP00)**(XRD/XCPD)
-HSNOW_ROOF = 'NONE'
-HSNOW_ROAD = 'NONE'
-ZASNOW_ROOF = 0.8
-ZASNOW_ROAD = 0.8
-ZDN_ROOF = 0.0
-ZDF_ROOF = 1.0
-ZDN_ROAD = 0.0
-ZDF_ROAD = 1.0
-ZEMIS_GARDEN = 1.0
-ZESNOW_ROAD = 1.0
-ZTSSNOW_ROAD = 273.0
-ZWS_ROOF = 0.0
-ZWS_ROAD = 0.0
-ZWSNOW_ROOF = 0.0
-ZTSNOW_ROOF = 273.0
-ZRSNOW_ROOF = 0.0
-ZTSSNOW_ROOF = 273.0
-ZESNOW_ROOF = 0.0
-ZWSNOW_ROAD = 0.0
-ZTSNOW_ROAD = 273.0
-ZRSNOW_ROAD = 0.0
+ZQA = 0.011
+ZLW_RAD= 300.
ZRR = 0.0
ZSR = 0.0
-ZQSAT_ROOF = 0.015
-ZQSAT_ROAD = 0.015
-ZDELT_ROOF = 0.0
-ZDELT_ROAD = 0.0
-ZTS_GARDEN = 300.
+ZZREF = 50.
+!
ZPEW_A_COEF = 0.5
ZPEW_B_COEF = 0.5
-ZE_SHADING(:) = 0.
-GNATVENT_NIGHT(:) = .FALSE.
-GSHADE (:) = .FALSE.
-GSHAD_DAY (:) = .FALSE.
-! solar panels are not taken into account in the building's HVAC equipment sizing process
-ZFRAC_PANEL = 0.
-ZALB_PANEL = 0.1
!
-! greenroofs are not taken into account in the building's HVAC equipment sizing process
-ZRN_GREENROOF (:) = 0.
-ZH_GREENROOF (:) = 0.
-ZLE_GREENROOF (:) = 0.
-ZGFLUX_GREENROOF (:) = 0.
-ZUW_GREENROOF (:) = 0.
-ZRUNOFF_GREENROOF (:) = 0.
-ZDRAIN_GREENROOF (:) = 0.
-!* one supposes zero conduction heat flux between the greenroof and the roof.
-ZG_GREENROOF_ROOF(:) = 0.
+! initial value for air temperature and outdoor wall/roof/window/road temperature
+ZT_CAN(:) = 10.7/2 * SIN(2*XPI/(24*3600) * (ZTIME+16*3600)) + (B%XT_SIZE_MAX(:)-10.7/2)
+!
+ZQ_CAN = 0.011
+ZU_CAN = 2.5
+ZZ_LOWCAN = ZZREF
+!
+!
+ZTS_GD = 300.
+!
+ZDN_RF = 0.0
+ZDF_RF = 1.0
+ZDN_RD = 0.0
+ZDF_RD = 1.0
+!
+ZQSAT_RF = 0.015
+ZQSAT_RD = 0.015
+ZDELT_RF = 0.0
+ZDELT_RD = 0.0
+!
!
-!* road watering (not used)
-ZRD_START_MONTH= 1.
-ZRD_END_MONTH = 1.
-ZRD_START_HOUR = 0.
-ZRD_END_HOUR = 24.
-ZRD_24H_IRRIG = 0.
!
!* A. Autosize of the heating system
! ---------------------------------
!
-YCOOL_COIL = 'IDEAL '
-YHEAT_COIL = 'IDEAL '
-YNATVENT(:) = 'NONE'
-ZF_WATER_COND(:) = 0.
-ZRHOA = 1.30
-ZTOUT_EQ(:) = (B%CUR%XT_SIZE_MIN(:) + ZT_SKY(:))/2.
-!
-ZU_ROOF(:) = 0.0
+ZU_RF(:) = 0.0
DO JJ=1,TOP%NROOF_LAYER
- ZU_ROOF(:) = ZU_ROOF(:) + T%CUR%XD_ROOF(:,JJ)/T%CUR%XTC_ROOF(:,JJ)
+ ZU_RF(:) = ZU_RF(:) + T%XD_ROOF(:,JJ)/T%XTC_ROOF(:,JJ)
END DO
-ZU_ROOF(:) = ZU_ROOF(:) + 1./10. + 1./25.
-ZU_ROOF(:) = 1. / ZU_ROOF(:)
+ZU_RF(:) = ZU_RF(:) + 1./10. + 1./25.
+ZU_RF(:) = 1. / ZU_RF(:)
!
-ZU_WALL(:) = 0.0
+ZU_WL(:) = 0.0
DO JJ=1,TOP%NWALL_LAYER
- ZU_WALL(:) = ZU_WALL(:) + T%CUR%XD_WALL(:,JJ)/T%CUR%XTC_WALL(:,JJ)
+ ZU_WL(:) = ZU_WL(:) + T%XD_WALL(:,JJ)/T%XTC_WALL(:,JJ)
END DO
-ZU_WALL(:) = ZU_WALL(:) + 1./10. + 1./25.
-ZU_WALL(:) = 1. / ZU_WALL(:)
+ZU_WL(:) = ZU_WL(:) + 1./10. + 1./25.
+ZU_WL(:) = 1. / ZU_WL(:)
+!
+ZRHOA = 1.30
+ZT_SKY = 253.15
+ZTOUT_EQ(:) = (B%XT_SIZE_MIN(:) + ZT_SKY(:))/2.
!
! Heating Coil Capacity [W m-2(bld)]
-B%CUR%XCAP_SYS_HEAT(:) = ZU_WALL(:) * T%CUR%XWALL_O_BLD(:) * (B%CUR%XTHEAT_TARGET(:) - ZTOUT_EQ(:)) &
- + B%CUR%XU_WIN(:) * B%CUR%XGLAZ_O_BLD(:) * (B%CUR%XTHEAT_TARGET(:) - ZTOUT_EQ(:)) &
- + ZU_ROOF(:) * (B%CUR%XTHEAT_TARGET(:) - ZTOUT_EQ(:)) &
- - B%CUR%XQIN(:) * T%CUR%XBLD_HEIGHT(:) / B%CUR%XFLOOR_HEIGHT(:)* &
- (1 - B%CUR%XQIN_FLAT(:)) &
- + B%CUR%XINF(:) * T%CUR%XBLD_HEIGHT(:) / 3600* ZRHOA(:) * XCPD * &
- (B%CUR%XTHEAT_TARGET(:) - B%CUR%XT_SIZE_MIN(:)) &
- + B%CUR%XV_VENT(:) * T%CUR%XBLD_HEIGHT(:) / 3600* ZRHOA(:) * XCPD * &
- (B%CUR%XTHEAT_TARGET(:) - B%CUR%XT_SIZE_MIN(:))
+B%XCAP_SYS_HEAT(:) = ZU_WL(:) * T%XWALL_O_BLD(:) * (B%XTHEAT_TARGET(:) - ZTOUT_EQ(:)) &
+ + B%XU_WIN(:) * B%XGLAZ_O_BLD(:) * (B%XTHEAT_TARGET(:) - ZTOUT_EQ(:)) &
+ + ZU_RF(:) * (B%XTHEAT_TARGET(:) - ZTOUT_EQ(:)) &
+ - B%XQIN(:) * T%XBLD_HEIGHT(:) / B%XFLOOR_HEIGHT(:)* &
+ (1 - B%XQIN_FLAT(:)) &
+ + B%XINF(:) * T%XBLD_HEIGHT(:) / 3600* ZRHOA(:) * XCPD * &
+ (B%XTHEAT_TARGET(:) - B%XT_SIZE_MIN(:)) &
+ + B%XV_VENT(:) * T%XBLD_HEIGHT(:) / 3600* ZRHOA(:) * XCPD * &
+ (B%XTHEAT_TARGET(:) - B%XT_SIZE_MIN(:))
!
! Rated air flow rate [kg s-1 m-2(bld)]
-B%CUR%XM_SYS_RAT(:) = B%CUR%XCAP_SYS_HEAT(:)/XCPD/(323.15 - B%CUR%XTHEAT_TARGET(:))
+B%XM_SYS_RAT(:) = B%XCAP_SYS_HEAT(:)/XCPD/(323.15 - B%XTHEAT_TARGET(:))
!
+! Initialization
+B%XCAP_SYS_RAT = 0.
!
!* B. Autosize of the cooling system
! -----------------------------------
!
ZRHOA = 1.15
+!
+!-------------------------------------------------------
+!
! Initial values
-! initial value for air temperature and outdoor wall/roof/window/road temperature
-ZT_CANYON(:) = 10.7/2 * SIN(2*XPI/(24*3600) * (ZTIME+16*3600)) + (B%CUR%XT_SIZE_MAX(:)-10.7/2)
+!
+! Options TOP
+!
+YBEM = TOP%CBEM
+TOP%CBEM = "BEM"
+!
+YZ0H = TOP%CZ0H
+TOP%CZ0H = 'KAND07'
+!
+GCANOPY = TOP%LCANOPY
+TOP%LCANOPY = .FALSE.
+!
+YCH_BEM = TOP%CCH_BEM
+TOP%CCH_BEM = 'DOE-2'
+!
+!
+! Teb Fields T
+!
+ALLOCATE(T%XWS_ROOF(KI))
+ALLOCATE(T%XWS_ROAD(KI))
+T%XWS_ROOF = 0.0
+T%XWS_ROAD = 0.0
+!
+ALLOCATE(T%TSNOW_ROOF%WSNOW(KI,1))
+ALLOCATE(T%TSNOW_ROOF%T (KI,1))
+ALLOCATE(T%TSNOW_ROOF%ALB (KI))
+ALLOCATE(T%TSNOW_ROOF%RHO (KI,1))
+ALLOCATE(T%TSNOW_ROOF%TS (KI))
+ALLOCATE(T%TSNOW_ROOF%EMIS (KI))
+!
+YSNOW_RF = T%TSNOW_ROOF%SCHEME
+T%TSNOW_ROOF%SCHEME = 'NONE'
+T%TSNOW_ROOF%WSNOW = 0.0
+T%TSNOW_ROOF%T = 273.0
+T%TSNOW_ROOF%RHO = 0.0
+T%TSNOW_ROOF%ALB = 0.8
+T%TSNOW_ROOF%TS = 273.0
+T%TSNOW_ROOF%EMIS = 0.0
+!
+ALLOCATE(T%TSNOW_ROAD%WSNOW(KI,1))
+ALLOCATE(T%TSNOW_ROAD%T (KI,1))
+ALLOCATE(T%TSNOW_ROAD%ALB (KI))
+ALLOCATE(T%TSNOW_ROAD%RHO (KI,1))
+ALLOCATE(T%TSNOW_ROAD%TS (KI))
+ALLOCATE(T%TSNOW_ROAD%EMIS (KI))
+!
+YSNOW_RD = T%TSNOW_ROAD%SCHEME
+T%TSNOW_ROAD%SCHEME = 'NONE'
+T%TSNOW_ROAD%WSNOW = 0.0
+T%TSNOW_ROAD%T = 273.0
+T%TSNOW_ROAD%RHO = 0.0
+T%TSNOW_ROAD%ALB = 0.8
+T%TSNOW_ROAD%TS = 273.0
+T%TSNOW_ROAD%EMIS = 1.0
+!
+ZGD = T%XGARDEN
+T%XGARDEN = 0.
+!
+!------------------------------------------------
+!BEM
+!
+YCOOL_COIL = BOP%CCOOL_COIL
+BOP%CCOOL_COIL = 'IDEAL '
+YHEAT_COIL = BOP%CHEAT_COIL
+BOP%CHEAT_COIL ='IDEAL '
+!
+!!TI_BLD
+ALLOCATE(B%XTI_BLD(KI))
!! !ZTI_BLD = 297.16 ! indoor air temperature
DO JJ=1,KI
- ZTI_BLD(JJ) = MAX(B%CUR%XTHEAT_TARGET(JJ),ZT_CANYON(JJ)) ! indoor air temperature
+ B%XTI_BLD(JJ) = MAX(B%XTHEAT_TARGET(JJ),ZT_CAN(JJ)) ! indoor air temperature
ENDDO
-ZT_ROOF (:,TOP%NROOF_LAYER) = ZTI_BLD(:) ! roof layers temperatures
-ZT_WALL_A(:,TOP%NWALL_LAYER) = ZTI_BLD(:) ! wall layers temperatures
+!
+!T_FLOOR, T_MASS
+ALLOCATE(B%XT_FLOOR(KI,BOP%NFLOOR_LAYER))
+ALLOCATE(B%XT_MASS (KI,BOP%NFLOOR_LAYER))
+!
DO JJ=1,BOP%NFLOOR_LAYER
- ZT_FLOOR(:,JJ) = ZTI_BLD(:) ! building floor temperature
- ZT_MASS(:,JJ) = ZTI_BLD(:) ! building mass temperature
+ B%XT_FLOOR(:,JJ) = B%XTI_BLD(:) ! building floor temperature
+ B%XT_MASS(:,JJ) = B%XTI_BLD(:) ! building mass temperature
ENDDO
-
-!ROAD
-DO JJ=1,TOP%NROAD_LAYER
- ZT_ROAD(:,JJ) = ZT_CANYON(:)
-ENDDO
-!ROOF
-ZT_ROOF(:,1) = ZT_CANYON(:)
-ZT1(:)=ZT_ROOF(:,1)
-ZTN(:)=ZT_ROOF(:,TOP%NROOF_LAYER)
-IF (TOP%NROOF_LAYER .GT. 2) CALL INTERP_PROFTWALL(ZT1, ZTN, T%CUR%XD_ROOF, ZT_ROOF)
-!WALL
-ZT_WALL_A(:,1) = ZT_CANYON(:)
-ZT1(:)=ZT_WALL_A(:,1)
-ZTN(:)=ZT_WALL_A(:,TOP%NWALL_LAYER)
-IF (TOP%NWALL_LAYER .GT. 2) CALL INTERP_PROFTWALL(ZT1, ZTN, T%CUR%XD_WALL, ZT_WALL_A)
-ZT_WALL_B = ZT_WALL_A
+!
!OUTDOOR WINDOW TEMPERATURE
-ZT_WIN1(:) = ZT_CANYON(:)
-!!
-ZT_WIN2(:) = ZTI_BLD(:)
+ALLOCATE(B%XT_WIN1(KI))
+B%XT_WIN1(:) = ZT_CAN(:)
!!
-ZQ_CANYON = 0.011
-ZQI_BLD = 0.011
-ZT_SYS = ZTI_BLD
-ZQ_SYS = ZQI_BLD
+ALLOCATE(B%XT_WIN2(KI))
+B%XT_WIN2(:) = B%XTI_BLD(:)
!
-!! GREGOIRE 13/03
-ZROAD (:) = T%CUR%XROAD(:)+T%CUR%XGARDEN(:)
-ZGARDEN (:) = 0.
-ZALB_GARDEN (:) = 0.
-ZALB_GREENROOF(:) = 0.
-ZAC_GARDEN (:) = 0.
-ZSVF_GARDEN (:) = 0.
-!
-!
-!RJ: fix for OMP races
-!RJ: run parallely for prep, but pseudo serially for offline (already in OMP here)
-#ifdef RJ_OFIX
-INBLOCKTOT=NBLOCKTOT
-!RJ: next one prevents double split in OMP parallel region
-!$ IF(OMP_IN_PARALLEL()) INBLOCKTOT=1
-ALLOCATE(ISIZE_OMP(0:INBLOCKTOT-1))
- CALL GET_SIZES_PARALLEL(DTCO, DGU, UG, U, &
- INBLOCKTOT,KI,0,ISIZE_OMP)
-#else
-ALLOCATE(ISIZE_OMP(0:0))
- CALL GET_SIZES_PARALLEL(DTCO, DGU, UG, U, &
- 1,KI,0,ISIZE_OMP)
-#endif
-
+YNATVENT(:) = B%CNATVENT(:)
+B%CNATVENT(:) = 'NONE'
+ZF_WATER_COND(:) = B%XF_WATER_COND(:)
+B%XF_WATER_COND(:) = 0.
+ZAUX_MAX = B%XAUX_MAX
+B%XAUX_MAX = 0.
+!
+ALLOCATE(B%XQI_BLD(KI))
+B%XQI_BLD = 0.011
+!
+GNATVENT_NIGHT(:) = B%LNATVENT_NIGHT(:)
+B%LNATVENT_NIGHT(:) = .FALSE.
+!
+!
+! TEB
+!
+ALLOCATE(T%XT_ROOF (KI,TOP%NROOF_LAYER))
+ALLOCATE(T%XT_ROAD (KI,TOP%NROAD_LAYER))
+ALLOCATE(T%XT_WALL_A(KI,TOP%NWALL_LAYER))
+ALLOCATE(T%XT_WALL_B(KI,TOP%NWALL_LAYER))
+!
+!RF
+T%XT_ROOF (:,TOP%NROOF_LAYER) = B%XTI_BLD(:) ! roof layers temperatures
+T%XT_ROOF(:,1) = ZT_CAN(:)
+ZT1(:) = T%XT_ROOF(:,1)
+ZTN(:) = T%XT_ROOF(:,TOP%NROOF_LAYER)
+IF (TOP%NROOF_LAYER .GT. 2) CALL INTERP_PROFTWL(ZT1, ZTN, T%XD_ROOF, T%XT_ROOF)
+!
+!RD
+DO JJ=1,TOP%NROAD_LAYER
+ T%XT_ROAD(:,JJ) = ZT_CAN(:)
+ENDDO
+!
+!WL_A
+T%XT_WALL_A(:,TOP%NWALL_LAYER) = B%XTI_BLD(:) ! wall layers temperatures
+T%XT_WALL_A(:,1) = ZT_CAN(:)
+ZT1(:)=T%XT_WALL_A(:,1)
+ZTN(:)=T%XT_WALL_A(:,TOP%NWALL_LAYER)
+IF (TOP%NWALL_LAYER .GT. 2) CALL INTERP_PROFTWL(ZT1, ZTN, T%XD_WALL, T%XT_WALL_A)
+!
+!WL_B
+T%XT_WALL_B = T%XT_WALL_A
+!
+!
+!* road watering (not used)
+YIR%LPAR_RD_IRRIG = .FALSE.
+!
+ALLOCATE(YIR%XRD_START_MONTH(KI))
+ALLOCATE(YIR%XRD_END_MONTH (KI))
+ALLOCATE(YIR%XRD_START_HOUR (KI))
+ALLOCATE(YIR%XRD_END_HOUR (KI))
+ALLOCATE(YIR%XRD_24H_IRRIG (KI))
+!
+YIR%XRD_START_MONTH = 1.
+YIR%XRD_END_MONTH = 1.
+YIR%XRD_START_HOUR = 0.
+YIR%XRD_END_HOUR = 24.
+YIR%XRD_24H_IRRIG = 0.
+!
+!----------------------------------------------
+!
+! greenroofs are not taken into account in the building's HVAC equipment sizing process
+!
+ZRN_GR (:) = 0.
+ZH_GR (:) = 0.
+ZLE_GR (:) = 0.
+ZGFLUX_GR (:) = 0.
+ZRUNOFF_GR(:) = 0.
+ZDRAIN_GR (:) = 0.
+!
+ CALL DIAG_MISC_TEB_INIT(YDMT)
+!
+ZUW_GR (:) = 0.
+!
+ZAC_GD (:) = 0.
+!
+ZFRAC_PANEL = 0.
+ZALB_PANEL = 0.1
+ZSVF_GD (:) = 0.
+ZALB_GD (:) = 0.
+ZALB_GR(:) = 0.
+GSHADE (:) = .FALSE.
+GSHAD_DAY (:) = .FALSE.
+ZE_SHADING(:) = 0.
+!
+ CALL DIAG_MISC_TEB_OPTIONS_INIT(YDMTO)
+ CALL DIAG_MISC_TEB_INIT(YDMTC)
+!
+ YDMTO%LSURF_MISC_BUDGET = .TRUE.
+ CALL DIAG_MISC_TEB_INIT_n(YDMTC, YDMT, YDMTO, TOP, KI, 0)
+!
+!* one supposes zero conduction heat flux between the greenroof and the nnroof.
+YDMT%XG_GREENROOF_ROOF(:) = 0.
+!
+YDMT%XQIN(:) = B%XQIN(:)
+!
+YDMT%XT_SYS(:) = B%XTI_BLD(:)
+YDMT%XQ_SYS(:) = B%XQI_BLD(:)
+!
+YDMT%XTHEAT_TARGET(:) = B%XTHEAT_TARGET(:)
+YDMT%XTCOOL_TARGET(:) = B%XTCOOL_TARGET(:)
+!
+INB_STEP_ATM = 3600*24*4/ZTSTEP
DO JFORC_STEP= 1,INB_STEP_ATM
!
-! Daily outdoor air temperature cycle
- ZT_CANYON(:) = 10.7/2 * SIN(2*XPI/(24*3600) * (ZTIME+16*3600)) &
- + (B%CUR%XT_SIZE_MAX(:)-10.7/2)
- ZTA(:) = ZT_CANYON(:)
+! Daily outdoor air temperature cycle
+ ZT_CAN(:) = 10.7/2 * SIN(2*XPI/(24*3600) * (ZTIME+16*3600)) &
+ + (B%XT_SIZE_MAX(:)-10.7/2)
+ ZTA(:) = ZT_CAN(:)
!
!
!* B.1 Solar radiation
! ---------------
!
- CALL SUNPOS(ISIZE_OMP, JPYEAR, IMONTH, IDAY, ZTIME, TG%XLON, TG%XLAT, ZTSUN, ZZENITH, ZAZIM)
+ CALL SUNPOS(JPYEAR, IMONTH, IDAY, ZTIME, G%XLON, G%XLAT, ZTSUN, ZZENITH, ZAZIM)
!
- CALL SW_DAYCYCLE(KI, ZZENITH, ZTOT_SW)
+ CALL SW_DAYCYCLE(KI, ZZENITH, ZTOT_SW)
!
- ZDIR_SW(:) = 0.88 * ZTOT_SW(:) * 0.85 ! manual adjustment
- ZSCA_SW(:) = 0.12 * ZTOT_SW(:) * 0.85 ! manual adjustment
- WHERE (ZDIR_SW < 0.0)
- ZDIR_SW = 0.0
- END WHERE
- WHERE (ZSCA_SW < 0.0)
- ZSCA_SW = 0.0
- END WHERE
-
+ ZDIR_SW(:) = 0.88 * ZTOT_SW(:) * 0.85 ! manual adjustment
+ ZSCA_SW(:) = 0.12 * ZTOT_SW(:) * 0.85 ! manual adjustment
+ WHERE (ZDIR_SW < 0.0)
+ ZDIR_SW = 0.0
+ END WHERE
+ WHERE (ZSCA_SW < 0.0)
+ ZSCA_SW = 0.0
+ END WHERE
!
- CALL URBAN_SOLAR_ABS(YBEM, TOP%CROAD_DIR, TOP%CWALL_OPT, &
- ZDIR_SW, ZSCA_SW, ZZENITH, ZAZIM, &
- T%CUR%XBLD, ZGARDEN, T%CUR%XROAD_DIR, T%CUR%XROAD, T%CUR%XGREENROOF, &
- T%CUR%XWALL_O_HOR, T%CUR%XCAN_HW_RATIO, &
- T%CUR%XALB_ROOF, &
- T%CUR%XALB_ROAD, T%CUR%XSVF_ROAD, T%CUR%XALB_WALL, T%CUR%XSVF_WALL, &
- ZFRAC_PANEL, ZALB_PANEL, &
- ZALB_GARDEN, ZSVF_GARDEN, &
- ZALB_GREENROOF, &
- ZASNOW_ROOF, ZASNOW_ROAD, &
- ZDN_ROOF, ZDF_ROOF, ZDN_ROAD, ZDF_ROAD, &
- B%CUR%XGR, B%CUR%XABS_WIN, B%CUR%XSHGC, B%CUR%XSHGC_SH, B%CUR%XALB_WIN, &
- ZABS_SW_ROOF, ZABS_SW_ROAD, &
- ZABS_SW_WALL_A, ZABS_SW_WALL_B, &
- ZABS_SW_GARDEN, ZABS_SW_GREENROOF, &
- ZABS_SW_SNOW_ROOF, ZABS_SW_SNOW_ROAD, &
- ZABS_SW_PANEL, &
- ZREC_SW_ROAD, ZREC_SW_SNOW_ROAD, &
- ZREC_SW_WALL_A, ZREC_SW_WALL_B, &
- ZREC_SW_GARDEN, ZREC_SW_ROOF, &
- ZDIR_ALB_TOWN,ZSCA_ALB_TOWN, &
- ZSW_RAD_GARDEN, ZABS_SW_WIN, ZREC_SW_WIN, &
- B%CUR%XTRAN_WIN, &
- ZREF_SW_GRND, ZREF_SW_FAC, ZTR_SW_WIN, &
- ZE_SHADING, GSHAD_DAY, GSHADE )
+!
+! solar panels are not taken into account in the building's HVAC equipment sizing process
+ CALL URBAN_SOLAR_ABS(TOP, T, B, YDMT, ZDIR_SW, ZSCA_SW, ZZENITH, ZAZIM,&
+ ZFRAC_PANEL, ZALB_PANEL, ZALB_GD, ZSVF_GD,&
+ ZALB_GR, ZDN_RF, ZDF_RF, ZDN_RD, &
+ ZDF_RD, ZREC_SW_RD, ZREC_SW_SNOW_RD, &
+ ZREC_SW_WL_A, ZREC_SW_WL_B, ZREC_SW_GD, &
+ ZREC_SW_RF, ZDIR_ALB_TWN, ZSCA_ALB_TWN, &
+ ZSW_RAD_GD, ZREC_SW_WIN, ZREF_SW_GRND, &
+ ZREF_SW_FAC, ZE_SHADING, GSHAD_DAY, GSHADE )
!
!
!* B.2 LW properties
! -------------
!
- CALL URBAN_LW_COEF(B%CUR%XGR, T%CUR%XBLD, ZLW_RAD, &
- T%CUR%XEMIS_ROAD, T%CUR%XSVF_ROAD, T%CUR%XEMIS_WALL, T%CUR%XSVF_WALL, &
- ZEMIS_GARDEN, T%CUR%XROAD, ZGARDEN, &
- ZESNOW_ROAD, &
- ZTSSNOW_ROAD, ZT_WALL_A(:,1), ZT_WALL_B(:,1), &
- ZT_ROAD(:,1), ZTS_GARDEN, ZT_WIN1, &
- ZLW_WA_TO_WB, ZLW_WA_TO_R, ZLW_WB_TO_R, &
- ZLW_WA_TO_NR,ZLW_WB_TO_NR, &
- ZLW_WA_TO_G, ZLW_WB_TO_G, &
- ZLW_WA_TO_WIN, ZLW_WB_TO_WIN, &
- ZLW_R_TO_WA, ZLW_R_TO_WB, ZLW_R_TO_WIN, &
- ZLW_G_TO_WA, ZLW_G_TO_WB, ZLW_G_TO_WIN, &
- ZLW_S_TO_WA, ZLW_S_TO_WB, ZLW_S_TO_R, &
- ZLW_S_TO_NR, ZLW_S_TO_G, ZLW_S_TO_WIN, &
- ZLW_WIN_TO_WA, ZLW_WIN_TO_WB, ZLW_WIN_TO_R, &
- ZLW_WIN_TO_NR, ZLW_WIN_TO_G, &
- ZLW_NR_TO_WA, ZLW_NR_TO_WB, ZLW_NR_TO_WIN )
+ ZEMIS_GD = 1.0
+ CALL URBAN_LW_COEF(B, T, ZLW_RAD, ZEMIS_GD, &
+ T%TSNOW_ROAD%TS, ZTS_GD, &
+ ZLW_WA_TO_WB, ZLW_WA_TO_R, ZLW_WB_TO_R, &
+ ZLW_WA_TO_NR,ZLW_WB_TO_NR, &
+ ZLW_WA_TO_G, ZLW_WB_TO_G, &
+ ZLW_WA_TO_WIN, ZLW_WB_TO_WIN, &
+ ZLW_R_TO_WA, ZLW_R_TO_WB, ZLW_R_TO_WIN, &
+ ZLW_G_TO_WA, ZLW_G_TO_WB, ZLW_G_TO_WIN, &
+ ZLW_S_TO_WA, ZLW_S_TO_WB, ZLW_S_TO_R, &
+ ZLW_S_TO_NR, ZLW_S_TO_G, ZLW_S_TO_WIN, &
+ ZLW_WIN_TO_WA, ZLW_WIN_TO_WB, ZLW_WIN_TO_R, &
+ ZLW_WIN_TO_NR, ZLW_WIN_TO_G, &
+ ZLW_NR_TO_WA, ZLW_NR_TO_WB, ZLW_NR_TO_WIN )
!
!* B.3 TEB simulation
! -------------
!
- CALL TEB (HZ0H, HIMPLICIT_WIND, TOP%CWALL_OPT, YBEM, &
- TOP%TTIME, ZTSUN, &
- ZT_CANYON, ZQ_CANYON, ZU_CANYON, &
- ZT_CANYON, ZQ_CANYON, ZU_CANYON, ZZ_LOWCAN, ZTI_BLD, &
- ZT_ROOF, ZT_ROAD, ZT_WALL_A, ZT_WALL_B, &
- ZWS_ROOF, ZWS_ROAD, &
- HSNOW_ROOF, ZWSNOW_ROOF, ZTSNOW_ROOF, ZRSNOW_ROOF, &
- ZASNOW_ROOF, ZTSSNOW_ROOF, ZESNOW_ROOF, &
- HSNOW_ROAD, ZWSNOW_ROAD, ZTSNOW_ROAD, ZRSNOW_ROAD, &
- ZASNOW_ROAD, ZTSSNOW_ROAD, ZESNOW_ROAD, &
- ZPEW_A_COEF, ZPEW_B_COEF, &
- ZPEW_A_COEF, ZPEW_B_COEF, &
- ZPS, ZPA, ZEXNS, ZEXNA, ZTA, ZQA, ZRHOA, ZLW_RAD, &
- ZRR, ZSR, ZZREF, ZZREF, ZU_CANYON, &
- T%CUR%XH_TRAFFIC, T%CUR%XLE_TRAFFIC, T%CUR%XH_INDUSTRY, T%CUR%XLE_INDUSTRY, &
- PPTSTEP, T%CUR%XZ0_TOWN, T%CUR%XBLD, ZGARDEN, T%CUR%XROAD, T%CUR%XGREENROOF, &
- T%CUR%XBLD_HEIGHT, T%CUR%XWALL_O_HOR, T%CUR%XCAN_HW_RATIO, T%CUR%XWALL_O_GRND, &
- ZDF_ROOF, ZDN_ROOF, ZDF_ROAD, &
- ZDN_ROAD, ZQSAT_ROOF, ZQSAT_ROAD, ZDELT_ROOF, ZDELT_ROAD,&
- T%CUR%XEMIS_ROOF, T%CUR%XHC_ROOF, T%CUR%XTC_ROOF, T%CUR%XD_ROOF, &
- T%CUR%XEMIS_ROAD, T%CUR%XHC_ROAD, T%CUR%XTC_ROAD, &
- T%CUR%XD_ROAD, T%CUR%XEMIS_WALL, ZTS_GARDEN, &
- T%CUR%XHC_WALL, T%CUR%XTC_WALL, T%CUR%XD_WALL, ZRN_ROOF, ZH_ROOF, ZLE_ROOF,&
- ZLEW_ROOF, ZGFLUX_ROOF, ZRUNOFF_ROOF, &
- ZRN_GREENROOF, ZH_GREENROOF, ZLE_GREENROOF, &
- ZGFLUX_GREENROOF, ZUW_GREENROOF, &
- ZRUNOFF_GREENROOF,ZDRAIN_GREENROOF, &
- ZRN_STRLROOF, ZH_STRLROOF, ZLE_STRLROOF, ZGFLUX_STRLROOF,&
- ZRUNOFF_STRLROOF, &
- ZRN_ROAD, ZH_ROAD, &
- ZLE_ROAD, ZLEW_ROAD, ZGFLUX_ROAD, ZRUNOFF_ROAD, &
- ZRN_WALL_A, ZH_WALL_A, ZLE_WALL_A, ZGFLUX_WALL_A, &
- ZRN_WALL_B, ZH_WALL_B, ZLE_WALL_B, ZGFLUX_WALL_B, &
- ZRN_BLT, ZH_BLT, ZLE_BLT, ZGFLUX_BLT, &
- ZRNSNOW_ROOF, ZHSNOW_ROOF, ZLESNOW_ROOF, ZGSNOW_ROOF, &
- ZMELT_ROOF, &
- ZRNSNOW_ROAD, ZHSNOW_ROAD, ZLESNOW_ROAD, ZGSNOW_ROAD, &
- ZMELT_ROAD, &
- ZG_GREENROOF_ROOF, &
- ZUW_ROAD, ZUW_ROOF, ZDUWDU_ROAD, ZDUWDU_ROOF, &
- ZUSTAR_TOWN, ZCD, ZCDN, ZCH_TOWN, ZRI_TOWN, &
- ZRESA_TOWN, ZDQS_TOWN, ZQF_TOWN, ZQF_BLD, ZFLX_BLD, &
- ZAC_ROOF, ZAC_ROAD, ZAC_WALL, ZAC_TOP, ZAC_GARDEN, &
- ZAC_ROOF_WAT, ZAC_ROAD_WAT, ZABS_SW_ROOF, ZABS_LW_ROOF, &
- ZABS_SW_SNOW_ROOF, ZABS_LW_SNOW_ROOF, ZABS_SW_ROAD, &
- ZABS_LW_ROAD, ZABS_SW_SNOW_ROAD, ZABS_LW_SNOW_ROAD, &
- ZABS_SW_WALL_A, ZABS_LW_WALL_A, &
- ZABS_SW_WALL_B, ZABS_LW_WALL_B, &
- ZLW_WA_TO_WB, &
- ZLW_WA_TO_R, ZLW_WB_TO_R, &
- ZLW_WA_TO_NR, ZLW_WB_TO_NR, &
- ZLW_R_TO_WA, ZLW_R_TO_WB, &
- ZLW_G_TO_WA, ZLW_G_TO_WB, &
- ZLW_S_TO_WA, ZLW_S_TO_WB, ZLW_S_TO_R, &
- ZLW_S_TO_NR, ZLW_NR_TO_WA, ZLW_NR_TO_WB, &
- ZLW_NR_TO_WIN, ZLW_WA_TO_WIN, ZLW_WB_TO_WIN, &
- ZLW_G_TO_WIN, &
- ZLW_R_TO_WIN, ZLW_S_TO_WIN, ZLW_WIN_TO_WA, ZLW_WIN_TO_WB,&
- ZLW_WIN_TO_R, ZLW_WIN_TO_NR, &
- YNATVENT, &
- YCOOL_COIL, ZF_WATER_COND, YHEAT_COIL, BOP%LAUTOSIZE, &
- IDAY, ZAUX_MAX, ZT_FLOOR, ZT_MASS, ZH_BLD_COOL, &
- ZT_BLD_COOL, ZH_BLD_HEAT, ZLE_BLD_COOL, ZLE_BLD_HEAT, &
- ZH_WASTE, ZLE_WASTE, B%CUR%XF_WASTE_CAN, ZHVAC_COOL, ZHVAC_HEAT,&
- B%CUR%XQIN, B%CUR%XQIN_FRAD, B%CUR%XQIN_FLAT, B%CUR%XGR, B%CUR%XEFF_HEAT, &
- B%CUR%XINF, B%CUR%XTCOOL_TARGET, B%CUR%XTHEAT_TARGET, B%CUR%XHR_TARGET, ZT_WIN2, &
- ZQI_BLD, B%CUR%XV_VENT, B%CUR%XCAP_SYS_HEAT, B%CUR%XCAP_SYS_RAT, B%CUR%XT_ADP, &
- B%CUR%XM_SYS_RAT, B%CUR%XCOP_RAT, ZCAP_SYS, ZM_SYS, ZCOP, ZQ_SYS, &
- ZT_SYS, ZTR_SW_WIN, ZFAN_POWER, B%CUR%XHC_FLOOR, B%CUR%XTC_FLOOR, &
- B%CUR%XD_FLOOR, ZT_WIN1, ZABS_SW_WIN, ZABS_LW_WIN, &
- B%CUR%XUGG_WIN, ZEMIT_LW_FAC, &
- ZEMIT_LW_ROAD, ZT_RAD_IND, ZHU_BLD, ZTIME, ZE_SHADING, &
- GNATVENT_NIGHT(:), B%CUR%XN_FLOOR, T%CUR%XWALL_O_BLD, B%CUR%XGLAZ_O_BLD, &
- B%CUR%XMASS_O_BLD, B%CUR%XFLOOR_HW_RATIO, B%CUR%XF_FLOOR_MASS, B%CUR%XF_FLOOR_WALL, &
- B%CUR%XF_FLOOR_WIN, B%CUR%XF_FLOOR_ROOF, B%CUR%XF_WALL_FLOOR, B%CUR%XF_WALL_MASS, &
- B%CUR%XF_WALL_WIN, B%CUR%XF_WIN_FLOOR, B%CUR%XF_WIN_MASS, B%CUR%XF_WIN_WALL, &
- B%CUR%XF_MASS_FLOOR, B%CUR%XF_MASS_WALL, B%CUR%XF_MASS_WIN, GCANOPY, YCH_BEM, &
- T%CUR%XROUGH_ROOF, T%CUR%XROUGH_WALL, B%CUR%XF_WIN_WIN, &
- GPAR_RD_IRRIG, ZRD_START_MONTH, ZRD_END_MONTH, &
- ZRD_START_HOUR, ZRD_END_HOUR, ZRD_24H_IRRIG, ZIRRIG_ROAD )
+ CALL TEB (TOP, T, BOP, B, YIR, YDMT, YIMPLICIT_WIND, ZTSUN, &
+ ZT_CAN, ZQ_CAN, ZU_CAN, ZT_CAN, ZQ_CAN, ZU_CAN, ZZ_LOWCAN, &
+ ZPEW_A_COEF, ZPEW_B_COEF, ZPEW_A_COEF, ZPEW_B_COEF, ZPS, ZPA, &
+ ZEXNS, ZEXNA, ZTA, ZQA, ZRHOA, ZLW_RAD, ZRR, ZSR, ZZREF, ZZREF, &
+ ZU_CAN, T%XH_TRAFFIC, T%XLE_TRAFFIC, ZTSTEP, ZDF_RF, ZDN_RF, &
+ ZDF_RD, ZDN_RD, ZQSAT_RF, ZQSAT_RD, ZDELT_RF, ZDELT_RD, ZTS_GD, &
+ ZLEW_RF, ZUW_GR, ZLEW_RD, ZLE_WL_A, ZLE_WL_B,ZRNSNOW_RF, &
+ ZHSNOW_RF, ZLESNOW_RF, ZGSNOW_RF, ZMELT_RF, ZRN_GR, ZH_GR, &
+ ZLE_GR, ZGFLUX_GR, ZDRAIN_GR, ZRUNOFF_GR, ZRNSNOW_RD, &
+ ZHSNOW_RD, ZLESNOW_RD, ZGSNOW_RD, ZMELT_RD, ZUW_RD, ZUW_RF, &
+ ZDUWDU_RD, ZDUWDU_RF, ZUSTAR_TWN, ZCD, ZCDN, ZCH_TWN, ZRI_TWN, &
+ ZRESA_TWN, ZAC_RF, ZAC_RD, ZAC_WL, ZAC_TOP, ZAC_GD, ZAC_RF_WAT, &
+ ZAC_RD_WAT, ZLW_WA_TO_WB, ZLW_WA_TO_R, ZLW_WB_TO_R, &
+ ZLW_WA_TO_NR, ZLW_WB_TO_NR, ZLW_R_TO_WA, ZLW_R_TO_WB, &
+ ZLW_G_TO_WA, ZLW_G_TO_WB, ZLW_S_TO_WA, ZLW_S_TO_WB, ZLW_S_TO_R, &
+ ZLW_S_TO_NR, ZLW_NR_TO_WA, ZLW_NR_TO_WB, ZLW_NR_TO_WIN, &
+ ZLW_WA_TO_WIN, ZLW_WB_TO_WIN, ZLW_G_TO_WIN, ZLW_R_TO_WIN, &
+ ZLW_S_TO_WIN, ZLW_WIN_TO_WA, ZLW_WIN_TO_WB, ZLW_WIN_TO_R, &
+ ZLW_WIN_TO_NR, IDAY, ZEMIT_LW_FAC, ZEMIT_LW_RD, ZT_RAD_IND, &
+ ZHU_BLD, ZTIME, ZE_SHADING )
!
-!
! Time update
- ZTIME = ZTIME + PPTSTEP
- IF (ZTIME >= 86400) THEN
- ZTIME = 0.0
- IDAY = IDAY + 1
- END IF
+ ZTIME = ZTIME + ZTSTEP
+ IF (ZTIME >= 86400) THEN
+ ZTIME = 0.0
+ IDAY = IDAY + 1
+ END IF
!
ENDDO
-
!
+B%XQIN(:) = YDMT%XQIN(:)
+B%XTHEAT_TARGET(:) = YDMT%XTHEAT_TARGET(:)
+B%XTCOOL_TARGET(:) = YDMT%XTCOOL_TARGET(:)
+!
+ CALL TEB_IRRIG_INIT(YIR)
+ CALL DIAG_MISC_TEB_INIT(YDMT)
+ CALL DIAG_MISC_TEB_INIT(YDMTC)
+!----------------------------------------------------
+!
+! Options
+!
+TOP%CZ0H = YZ0H
+TOP%CBEM = YBEM
+TOP%LCANOPY = GCANOPY
+TOP%CCH_BEM = YCH_BEM
+!
+! Teb Fields T
+!
+DEALLOCATE(T%XWS_ROOF,T%XWS_ROAD)
+!
+T%TSNOW_ROOF%SCHEME = YSNOW_RF
+DEALLOCATE(T%TSNOW_ROOF%WSNOW)
+DEALLOCATE(T%TSNOW_ROOF%T)
+DEALLOCATE(T%TSNOW_ROOF%ALB)
+DEALLOCATE(T%TSNOW_ROOF%RHO)
+DEALLOCATE(T%TSNOW_ROOF%TS)
+DEALLOCATE(T%TSNOW_ROOF%EMIS)
+!
+T%TSNOW_ROAD%SCHEME = YSNOW_RD
+DEALLOCATE(T%TSNOW_ROAD%WSNOW)
+DEALLOCATE(T%TSNOW_ROAD%T)
+DEALLOCATE(T%TSNOW_ROAD%ALB)
+DEALLOCATE(T%TSNOW_ROAD%RHO)
+DEALLOCATE(T%TSNOW_ROAD%TS)
+DEALLOCATE(T%TSNOW_ROAD%EMIS)
+!
+T%XGARDEN = ZGD
+!
+!------------------------------------------------
+!BEM
+!
+BOP%CCOOL_COIL = YCOOL_COIL
+BOP%CHEAT_COIL = YHEAT_COIL
+!
+!!TI_BLD
+DEALLOCATE(B%XTI_BLD)
+!
+!T_FLOOR, T_MASS
+DEALLOCATE(B%XT_FLOOR,B%XT_MASS)
+!
+!OUTDOOR WINDOW TEMPERATURE
+DEALLOCATE(B%XT_WIN1)
+DEALLOCATE(B%XT_WIN2)
+!
+B%CNATVENT(:) = YNATVENT(:)
+B%XF_WATER_COND(:) = ZF_WATER_COND(:)
+B%XAUX_MAX = ZAUX_MAX
+!
+DEALLOCATE(B%XQI_BLD)
+!
+B%LNATVENT_NIGHT(:) = GNATVENT_NIGHT(:)
+!
+! TEB
+!
+DEALLOCATE(T%XT_ROOF,T%XT_ROAD,T%XT_WALL_A,T%XT_WALL_B)
!
+!--------------------------------------------------------
!
! -----------------------------------------------------------
! Print autosize results
@@ -735,21 +751,21 @@ WRITE(KLUOUT,*) ' --------------------------------'
WRITE(KLUOUT,*) ' HVAC AUTOSIZE CALCULATIONS '
WRITE(KLUOUT,*) ' '
WRITE(KLUOUT,*) ' Rated mass flow rate:'
-WRITE(KLUOUT,*) ' ',MAXVAL(B%CUR%XM_SYS_RAT), 'kg s-1 m-2(bld)'
-WRITE(KLUOUT,*) ' ',MINVAL(B%CUR%XM_SYS_RAT), 'kg s-1 m-2(bld)'
+WRITE(KLUOUT,*) ' ',MAXVAL(B%XM_SYS_RAT), 'kg s-1 m-2(bld)'
+WRITE(KLUOUT,*) ' ',MINVAL(B%XM_SYS_RAT), 'kg s-1 m-2(bld)'
WRITE(KLUOUT,*) ' Rated cooling system capacity:'
-WRITE(KLUOUT,*) ' ',MAXVAL(B%CUR%XCAP_SYS_RAT), 'W m-2(bld)'
-WRITE(KLUOUT,*) ' ',MINVAL(B%CUR%XCAP_SYS_RAT), 'W m-2(bld)'
+WRITE(KLUOUT,*) ' ',MAXVAL(B%XCAP_SYS_RAT), 'W m-2(bld)'
+WRITE(KLUOUT,*) ' ',MINVAL(B%XCAP_SYS_RAT), 'W m-2(bld)'
WRITE(KLUOUT,*) ' Rated heating sysem capacity:'
-WRITE(KLUOUT,*) ' ',MAXVAL(B%CUR%XCAP_SYS_HEAT), 'W m-2(bld)'
-WRITE(KLUOUT,*) ' ',MINVAL(B%CUR%XCAP_SYS_HEAT), 'W m-2(bld)'
+WRITE(KLUOUT,*) ' ',MAXVAL(B%XCAP_SYS_HEAT), 'W m-2(bld)'
+WRITE(KLUOUT,*) ' ',MINVAL(B%XCAP_SYS_HEAT), 'W m-2(bld)'
WRITE(KLUOUT,*) ' --------------------------------'
WRITE(KLUOUT,*) ' '
IF (LHOOK) CALL DR_HOOK('HVAC_AUTOSIZE',1,ZHOOK_HANDLE)
!
- CONTAINS
+CONTAINS
!
-SUBROUTINE INTERP_PROFTWALL(PT1, PTN, PD, PT)
+SUBROUTINE INTERP_PROFTWL(PT1, PTN, PD, PT)
!interpolation of vertical profile for 'wall' : roof/wall
!arguments
REAL, DIMENSION(:), INTENT(IN) :: PT1 !temperature layer 1
@@ -780,6 +796,6 @@ DO JI=1,KI
PT(JI,1) = PT1(JI)
PT(JI,ILAYER) = PTN(JI)
ENDDO
-END SUBROUTINE INTERP_PROFTWALL
+END SUBROUTINE INTERP_PROFTWL
END SUBROUTINE HVAC_AUTOSIZE
diff --git a/src/SURFEX/hydro.F90 b/src/SURFEX/hydro.F90
index 77fc0a3ad468dc348693a56e2d3ec6bdab95cb8f..fca65affef22d0f38e8db74af90ea1597370ac63 100644
--- a/src/SURFEX/hydro.F90
+++ b/src/SURFEX/hydro.F90
@@ -3,28 +3,10 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE HYDRO(HISBA, HSNOW_ISBA, HRUNOFF, HSOILFRZ, OMEB, OGLACIER,&
- OFLOOD, PTSTEP, PVEGTYPE, &
- PRR, PSR, PLEV, PLETR, PLEG, PLES, &
- PRUNOFFB, PWDRAIN, &
- PC1, PC2, PC3, PC4B, PC4REF, PWGEQ, PCG, PCT, &
- PVEG, PLAI, PWRMAX, PMELT, PTAUICE, PLEGI, &
- PRUNOFFD, PSOILWGHT, KLAYER_HORT, KLAYER_DUN, &
- PPSNV, PPSNG, &
- PSNOW_THRUFAL, PEVAPCOR, PSUBVCOR, &
- PWR, PSOILHCAPZ, &
- PSNOWSWE, PSNOWALB, PSNOWRHO, &
- PBCOEF, PWSAT, PCONDSAT, PMPOTSAT, PWFC, &
- PWWILT, PF2WGHT, PF2, PD_G, PDZG, PDZDIF, PPS, &
- PWG, PWGI, PTG, KWG_LAYER, &
- PDRAIN, PRUNOFF, PTOPQS, &
- PIRRIG, PWATSUP, PTHRESHOLD, LIRRIDAY, LIRRIGATE, &
- HKSAT, HRAIN, HHORT, PMUF, PFSAT, PKSAT_ICE, &
- PD_ICE, PHORTON, PDRIP, PFFG, PFFV , PFFLOOD, &
- PPIFLOOD, PIFLOOD, PPFLOOD, PRRVEG, PIRRIG_FLUX, &
- PIRRIG_GR, PQSB, PFWTD, PWTD, &
- PDELHEATG, PDELHEATG_SFC, &
- PDELPHASEG, PDELPHASEG_SFC, PLVTT, PLSTT )
+ SUBROUTINE HYDRO(IO, KK, PK, PEK, AG, DEK, DMK, OMEB, PTSTEP, PVEG, &
+ PWRMAX, PSNOW_THRUFAL, PEVAPCOR, PSUBVCOR, PSOILHCAPZ, &
+ PF2WGHT, PF2, PPS, PIRRIG_GR, PDELHEATG, PDELHEATG_SFC,&
+ PDELPHASEG, PDELPHASEG_SFC )
! #####################################################################
!
!!**** *HYDRO*
@@ -92,13 +74,17 @@
!! 10/2014 (A. Boone) MEB added
!! 07/15 (B. Decharme) Numerical adjustement for F2 soilstress function
!! 03/16 (B. Decharme) Limit flood infiltration
-!! 05/2016 (B. Decharme) Bug : no Horton runoff in hydr_soildif because is already
-!! computed in hydro_sgh if required
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_AGRI_n, ONLY : AGRI_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
+!
USE MODD_CSTS, ONLY : XRHOLW, XDAY, XTT, XLSTT, XLMTT
USE MODD_ISBA_PAR, ONLY : XWGMIN, XDENOM_MIN
USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
@@ -125,77 +111,24 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
- CHARACTER(LEN=*), INTENT(IN) :: HISBA ! type of ISBA version:
-! ! '2-L' (default)
-! ! '3-L'
-! ! 'DIF' ISBA-DF
- CHARACTER(LEN=*), INTENT(IN) :: HSNOW_ISBA ! 'DEF' = Default F-R snow scheme
-! ! (Douville et al. 1995)
-! ! '3-L' = 3-L snow scheme (option)
-! ! (Boone and Etchevers 2001)
- CHARACTER(LEN=*), INTENT(IN) :: HRUNOFF ! surface runoff formulation
-! ! 'WSAT'
-! ! 'DT92'
-! ! 'SGH ' Topmodel
- CHARACTER(LEN=*), INTENT(IN) :: HSOILFRZ ! soil freezing-physics option
-! ! 'DEF' Default (Boone et al. 2000; Giard and Bazile 2000)
-! ! 'LWT' phase changes as above, but relation between unfrozen
-! water and temperature considered
-LOGICAL, INTENT(IN) :: OGLACIER ! True = Over permanent snow and ice,
-! initialise WGI=WSAT,
-! Hsnow>=10m and allow 0.8<SNOALB<0.85
-! False = No specific treatment
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(AGRI_t), INTENT(INOUT) :: AG
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK
!
LOGICAL, INTENT(IN) :: OMEB ! True = patch with multi-energy balance
-! ! False = patch with classical (composite) ISBA
-!
-LOGICAL, INTENT(IN) :: OFLOOD ! Flood scheme
-!
+! ! False = patch with classical (composite) ISBA
REAL, INTENT(IN) :: PTSTEP
! timestep of the integration
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE ! fraction of each vegetation
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRR, PSR, PLEV, PLETR, PLEG, PLES
-! PRR = rain rate
-! PSR = snow rate
-! PLEV = latent heat of evaporation over vegetation
-! PLETR = evapotranspiration of the vegetation
-! PLEG = latent heat of evaporation over the ground
-! PLES = latent heat of sublimation over the snow
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRUNOFFB ! slope of the runoff curve
-REAL, DIMENSION(:), INTENT(IN) :: PLVTT, PLSTT ! latent heat of vaporization and sublimation (J/kg)
-REAL, DIMENSION(:), INTENT(IN) :: PWDRAIN ! minimum Wg for drainage (m3/m3)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PC1, PC2, PWGEQ, PCG, PCT
-REAL, DIMENSION(:,:), INTENT(IN) :: PC3
-! soil coefficients
-! C1, C2 = coefficients for the moisture calculations
-! C3 = coefficient for WG2 calculation
-! PWGEQ = equilibrium surface volumetric moisture
-! PCG = soil heat capacity
-! PCT = grid-averaged heat capacity
-!
-REAL, DIMENSION(:), INTENT(IN) :: PVEG, PLAI, PRUNOFFD, PWRMAX
+REAL, DIMENSION(:), INTENT(IN) :: PVEG, PWRMAX
! PVEG = fraction of vegetation
-! PLAI = Leaf Area Index
-! PRUNOFFD = depth over which sub-grid runoff calculated (m)
! PWRMAX = maximum equivalent water content
! in the vegetation canopy
!
-REAL, DIMENSION(:), INTENT(IN) :: PC4B, PC4REF
-! PC4REF, PC4B = fiiting soil paramter for vertical diffusion (C4)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PPSNV, PPSNG
-! PPSNV = vegetation covered by snow
-! PPSNG = baresoil covered by snow
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTAUICE, PLEGI
-! PTAUICE = characteristic time scale for soil water
-! phase changes (s)
-! PLEGI = surface soil ice sublimation
-!
REAL, DIMENSION(:), INTENT(IN) :: PSNOW_THRUFAL, PEVAPCOR, PSUBVCOR
! PSNOW_THRUFAL = rate that liquid water leaves snow pack:
! *ISBA-ES* [kg/(m2 s)]
@@ -209,117 +142,28 @@ REAL, DIMENSION(:), INTENT(IN) :: PPS, PF2
! PPS = surface pressure (Pa)
! PF2 = total water stress factor (-)
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PWSAT, PCONDSAT, PWFC, PD_G, PF2WGHT, PWWILT
-! PD_G = Depth of bottom of Soil layers (m)
-! PWFC = field capacity profile (m3/m3)
-! PWWILT = wilting point profile (m3/m3)
-! PWSAT = porosity profile (m3/m3)
-! PCONDSAT = hydraulic conductivity at saturation (m/s)
+REAL, DIMENSION(:,:), INTENT(IN) :: PF2WGHT
! PF2WGHT = water stress factor (profile) (-)
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZDIF, PDZG
-! PDZDIF = distance between consecuative layer mid-points
-! PDZG = soil layers thicknesses
!
REAL, DIMENSION(:,:), INTENT(IN) :: PSOILHCAPZ
! PSOILHCAPZ = ISBA-DF Soil heat capacity profile [J/(m3 K)]
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSOILWGHT ! ISBA-DIF: weights for vertical
-! ! integration of soil water and properties
-INTEGER, INTENT(IN) :: KLAYER_HORT! DIF optimization
-INTEGER, INTENT(IN) :: KLAYER_DUN ! DIF optimization
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PMPOTSAT,PBCOEF
-! PMPOTSAT = matric potential at saturation (m)
-! PBCOEF = slope of the retention curve (-)
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTG
-! PTG = soil layer average temperatures (K)
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PWGI, PWG
-! PWGI = soil frozen volumetric water content (m3/m3)
-! PWG = soil liquid volumetric water content (m3/m3)
-! Prognostic variables of ISBA at 't-dt'
-! PWGI(:,1) = surface-soil volumetric ice content
-! PWGI(:,2) = deep-soil volumetric ice content
-!
-INTEGER, DIMENSION(:), INTENT(IN) :: KWG_LAYER
-! KWG_LAYER = Number of soil moisture layers (DIF option)
-!
REAL, DIMENSION(:), INTENT(INOUT) :: PDELHEATG, PDELHEATG_SFC
! PDELHEATG_SFC = change in heat storage of the surface soil layer over the current time step (W m-2)
! PDELHEATG = change in heat storage of the entire soil column over the current time step (W m-2)
!
-REAL, DIMENSION(:), INTENT(INOUT) :: PWR, PSNOWSWE, PSNOWALB, PSNOWRHO
-REAL, DIMENSION(:), INTENT(INOUT) :: PMELT
-REAL, DIMENSION(:), INTENT(OUT) :: PDRAIN, PRUNOFF
-! PWR = liquid water retained on the foliage
-! of the vegetation at time 't+dt'
-! PSNOWSWE = equivalent water content of the
-! snow reservoir at time 't+dt'
-! PSNOWALB = albedo of the snow at 't+dt'
-! PSNOWRHO = density of the snow at 't+dt'
-! PMELT = melting rate of the snow
-!
REAL, DIMENSION(:), INTENT(OUT) :: PDELPHASEG, PDELPHASEG_SFC
! PDELPHASEG = latent heating due to soil freeze-thaw in the entire soil column (W m-2)
! PDELPHASEG_SFC = latent heating due to soil freeze-thaw in the surface soil layer (W m-2)
!
-!
-REAL ,DIMENSION(:),INTENT(IN) :: PIRRIG
-REAL ,DIMENSION(:),INTENT(IN) :: PWATSUP
-REAL ,DIMENSION(:),INTENT(IN) :: PTHRESHOLD
-LOGICAL,DIMENSION(:),INTENT(INOUT) :: LIRRIDAY
-LOGICAL,DIMENSION(:),INTENT(IN) :: LIRRIGATE
-REAL ,DIMENSION(:),INTENT(INOUT) :: PIRRIG_FLUX ! irrigation rate (kg/m2/s)
REAL ,DIMENSION(:),INTENT(IN) :: PIRRIG_GR ! ground irrigation rate (kg/m2/s)
!
-!
-!
- CHARACTER(LEN=*), INTENT(IN) :: HKSAT ! soil hydraulic profil option
-! ! 'DEF' = ISBA homogenous soil
-! ! 'SGH' = ksat exponential decay
-!
- CHARACTER(LEN=*), INTENT(IN) :: HRAIN ! Rainfall spatial distribution
- ! 'DEF' = No rainfall spatial distribution
- ! 'SGH' = Rainfall exponential spatial distribution
- !
-!
- CHARACTER(LEN=*), INTENT(IN) :: HHORT ! Horton runoff
- ! 'DEF' = no Horton runoff
- ! 'SGH' = Horton runoff
-!
-REAL, DIMENSION(:), INTENT(IN) :: PD_ICE !depth of the soil column for the calculation
-! of the frozen soil fraction (m)
-REAL, DIMENSION(:), INTENT(IN) :: PKSAT_ICE!hydraulic conductivity at saturation (m/s)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PMUF !fraction of the grid cell reached by the rainfall
-REAL, DIMENSION(:), INTENT(INOUT):: PFSAT !Topmodel/dt92 saturated fraction
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PHORTON !Horton runoff (kg/m2/s)
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PDRIP !Dripping from the vegetation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(INOUT) :: PRRVEG !Precip. intercepted by vegetation (kg/m2/s)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PFFG,PFFV
-REAL, DIMENSION(:), INTENT(IN) :: PFFLOOD !Floodplain effective fraction
-REAL, DIMENSION(:), INTENT(IN) :: PPIFLOOD !Floodplain potential infiltration [kg/m²/s]
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PIFLOOD !Floodplain real infiltration [kg/m²/s]
-REAL, DIMENSION(:), INTENT(INOUT) :: PPFLOOD !Floodplain interception [kg/m²/s]
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PTOPQS !Topmodel (HRUNOFF=SGH) subsurface flow by layer (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PQSB !Topmodel (HRUNOFF=SGH) lateral subsurface flow [kg/m²/s]
-!
-REAL, DIMENSION(:), INTENT(IN) :: PFWTD !grid-cell fraction of water table to rise
-REAL, DIMENSION(:), INTENT(IN) :: PWTD !water table depth (m)
-!
!* 0.2 declarations of local variables
!
!
INTEGER :: JJ, JL ! loop control
INTEGER :: INDT, JDT ! Time splitting indicies
-INTEGER :: INI, INL, IDEPTH ! (ISBA-DF option)
+INTEGER :: INJ, INL, IDEKTH ! (ISBA-DF option)
!
REAL :: ZTSTEP ! maximum time split time step (<= PTSTEP)
! ! ONLY used for DIF option.
@@ -355,10 +199,10 @@ REAL, DIMENSION(SIZE(PVEG)) :: ZWGI_EXCESS, ZF2
! ZWGI_EXCESS = Soil ice excess water content
! ZF2 = Soilstress function for transpiration
!
-REAL, DIMENSION(SIZE(PWG,1),SIZE(PWG,2)) :: ZQSAT, ZQSATI, ZTI, ZPS
+REAL, DIMENSION(SIZE(PEK%XWG,1),SIZE(PEK%XWG,2)) :: ZQSAT, ZQSATI, ZTI, ZPS
! For specific humidity at saturation computation (ISBA-DIF)
!
-REAL, DIMENSION(SIZE(PWG,1),SIZE(PWG,2)) :: ZWGI0
+REAL, DIMENSION(SIZE(PEK%XWG,1),SIZE(PEK%XWG,2)) :: ZWGI0
! ZWGI0 = initial soil ice content (m3 m-3) before update
! for budget diagnostics
!
@@ -378,6 +222,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('HYDRO',0,ZHOOK_HANDLE)
!
+
JDT = 0
INDT = 0
ZTSTEP = 0.0
@@ -390,7 +235,7 @@ ZWSAT_AVG(:) = 0.0
ZWWILT_AVG(:) = 0.0
ZWFC_AVG(:) = 0.0
!
-ZRR(:) = PRR(:)
+ZRR(:) = DMK%XRRSFC(:)
!
ZDRAIN(:) = 0.
ZHORTON(:) = 0.
@@ -399,10 +244,10 @@ ZWGI_EXCESS(:) = 0.
ZEVAPCOR(:) = 0.
ZQSB (:) = 0.
!
-PDRAIN(:) = 0.
-PRUNOFF(:) = 0.
-PHORTON(:) = 0.
-PQSB (:) = 0.
+DEK%XDRAIN(:) = 0.
+DEK%XRUNOFF(:) = 0.
+DEK%XHORT(:) = 0.
+DEK%XQSB (:) = 0.
!
PDELPHASEG(:) = 0.0
PDELPHASEG_SFC(:)= 0.0
@@ -418,10 +263,10 @@ IF(OMEB)THEN
! MEB uses explicit snow scheme by default, but fluxes already aggregated
! for snow and floods so no need to multiply by fractions here.
!
- ZLEV(:) = PLEV(:)
- ZLETR(:) = PLETR(:)
- ZLEG(:) = PLEG(:)
- ZLEGI(:) = PLEGI(:)
+ ZLEV(:) = DEK%XLEV(:)
+ ZLETR(:) = DEK%XLETR(:)
+ ZLEG(:) = DEK%XLEG(:)
+ ZLEGI(:) = DEK%XLEGI(:)
ZPSNV(:) = 0.0
!
ZEVAPCOR(:) = PEVAPCOR(:) + PSUBVCOR(:)
@@ -431,18 +276,18 @@ ELSE
! Initialize evaporation components: variable definitions
! depend on snow scheme:
!
- IF(HSNOW_ISBA == '3-L' .OR. HSNOW_ISBA == 'CRO' .OR. HISBA == 'DIF')THEN
- ZLEV(:) = (1.0-PPSNV(:)-PFFV(:)) * PLEV(:)
- ZLETR(:) = (1.0-PPSNV(:)-PFFV(:)) * PLETR(:)
- ZLEG(:) = (1.0-PPSNG(:)-PFFG(:)) * PLEG(:)
- ZLEGI(:) = (1.0-PPSNG(:)-PFFG(:)) * PLEGI(:)
+ IF(PEK%TSNOW%SCHEME == '3-L' .OR. PEK%TSNOW%SCHEME == 'CRO' .OR. IO%CISBA == 'DIF')THEN
+ ZLEV(:) = (1.0-PEK%XPSNV(:)-KK%XFFV(:)) * DEK%XLEV(:)
+ ZLETR(:) = (1.0-PEK%XPSNV(:)-KK%XFFV(:)) * DEK%XLETR(:)
+ ZLEG(:) = (1.0-PEK%XPSNG(:)-KK%XFFG(:)) * DEK%XLEG(:)
+ ZLEGI(:) = (1.0-PEK%XPSNG(:)-KK%XFFG(:)) * DEK%XLEGI(:)
ZPSNV(:) = 0.0
ELSE
- ZLEV(:) = PLEV(:)
- ZLETR(:) = PLETR(:)
- ZLEG(:) = PLEG(:)
- ZLEGI(:) = PLEGI(:)
- ZPSNV(:) = PPSNV(:)+PFFV(:)
+ ZLEV(:) = DEK%XLEV(:)
+ ZLETR(:) = DEK%XLETR(:)
+ ZLEG(:) = DEK%XLEG(:)
+ ZLEGI(:) = DEK%XLEGI(:)
+ ZPSNV(:) = PEK%XPSNV(:)+KK%XFFV(:)
ENDIF
!
ZEVAPCOR(:) = PEVAPCOR(:)
@@ -456,15 +301,15 @@ ENDIF
! the Diffusion option is in force, the relevant
! calculation is done later within this routine.
!
-IF(HISBA == '2-L' .OR. HISBA == '3-L')THEN
- ZWSAT_AVG(:) = PWSAT(:,1)
- ZWWILT_AVG(:) = PWWILT(:,1)
- ZWFC_AVG(:) = PWFC(:,1)
+IF(IO%CISBA == '2-L' .OR. IO%CISBA == '3-L')THEN
+ ZWSAT_AVG(:) = KK%XWSAT(:,1)
+ ZWWILT_AVG(:) = KK%XWWILT(:,1)
+ ZWFC_AVG(:) = KK%XWFC(:,1)
ENDIF
!
-IF (HISBA == '3-L') THEN
- ZDG3(:) = PD_G(:,3)
- ZWG3(:) = PWG (:,3)
+IF (IO%CISBA == '3-L') THEN
+ ZDG3(:) = PK%XDG(:,3)
+ ZWG3(:) = PEK%XWG(:,3)
ELSE
ZDG3(:) = XUNDEF
ZWG3(:) = XUNDEF
@@ -479,41 +324,40 @@ END IF
!
IF(.NOT.OMEB)THEN ! Canopy Int & Irrig Already accounted for if MEB in use.
!
- PIRRIG_FLUX(:)=0.0
+ DEK%XIRRIG_FLUX(:)=0.0
!
!* add irrigation over vegetation to liquid precipitation (rr)
!
!
- IF (SIZE(LIRRIGATE)>0) THEN
- WHERE (LIRRIGATE(:) .AND. PIRRIG(:)>0. .AND. PIRRIG(:) /= XUNDEF .AND. (PF2(:)<PTHRESHOLD(:)) )
- PIRRIG_FLUX(:) = PWATSUP(:) / XDAY
- ZRR (:) = ZRR(:) + PWATSUP(:) / XDAY
- LIRRIDAY (:) = .TRUE.
- END WHERE
+ IF (ASSOCIATED(AG%LIRRIGATE)) THEN
+ IF (SIZE(AG%LIRRIGATE)>0) THEN
+ WHERE (AG%LIRRIGATE(:) .AND. PEK%XIRRIG(:)>0. .AND. PEK%XIRRIG(:) /= XUNDEF .AND. (PF2(:)<AG%XTHRESHOLDSPT(:)) )
+ DEK%XIRRIG_FLUX(:) = PEK%XWATSUP(:) / XDAY
+ ZRR (:) = ZRR(:) + PEK%XWATSUP(:) / XDAY
+ AG%LIRRIDAY(:) = .TRUE.
+ END WHERE
+ ENDIF
ENDIF
!
!* interception reservoir and dripping computation
!
- CALL HYDRO_VEG(HRAIN, PTSTEP, PMUF, &
- ZRR, ZLEV, ZLETR, PVEG, ZPSNV, &
- PWR, PWRMAX, ZPG, PDRIP, PRRVEG, PLVTT )
-!
-!
+ CALL HYDRO_VEG(IO%CRAIN, PTSTEP, KK%XMUF, ZRR, ZLEV, ZLETR, PVEG, &
+ ZPSNV, PEK%XWR(:), PWRMAX, ZPG, DEK%XDRIP, DEK%XRRVEG, PK%XLVTT )
!
ELSE
!
-! For MEB case, interception interactions already computed and PRR represents
+! For MEB case, interception interactions already computed and DMK%XRRSFC represents
! water falling (drip and not intercepted by vegetation) outside of snow covered
! areas. Part for snow covered areas (net outflow at base of snowpack) accounted
! for in PSNOW_THRUFAL.
!
- ZPG(:) = PRR(:)
+ ZPG(:) = DMK%XRRSFC(:)
!
ENDIF
!
!* add irrigation over ground to potential soil infiltration (pg)
!
-PIRRIG_FLUX(:) = PIRRIG_FLUX(:) + PIRRIG_GR(:)
+DEK%XIRRIG_FLUX(:) = DEK%XIRRIG_FLUX(:) + PIRRIG_GR(:)
!
ZPG(:) = ZPG(:) + PIRRIG_GR(:)
!
@@ -529,7 +373,7 @@ ZPG(:) = ZPG(:) + PIRRIG_GR(:)
! -------------------------
!
! Boone and Etchevers '3-L' snow option
-IF(HSNOW_ISBA == '3-L' .OR. HSNOW_ISBA == 'CRO' .OR. HISBA == 'DIF')THEN
+IF(PEK%TSNOW%SCHEME == '3-L' .OR. PEK%TSNOW%SCHEME == 'CRO' .OR. IO%CISBA == 'DIF')THEN
!
ZPG_MELT(:) = ZPG_MELT(:) + PSNOW_THRUFAL(:) ! [kg/(m2 s)]
!
@@ -537,13 +381,12 @@ IF(HSNOW_ISBA == '3-L' .OR. HSNOW_ISBA == 'CRO' .OR. HISBA == 'DIF')THEN
! running off from the snowpack in a timestep for ISBA-ES,
! not the actual amount of ice converted to liquid.
!
- PMELT(:) = PMELT(:) + PSNOW_THRUFAL(:) ! [kg/(m2 s)]
+ DEK%XMELT(:) = DEK%XMELT(:) + PSNOW_THRUFAL(:) ! [kg/(m2 s)]
!
ELSE
!
- CALL HYDRO_SNOW(OGLACIER, PTSTEP, PVEGTYPE, &
- PSR, PLES, PMELT, &
- PSNOWSWE, PSNOWALB, PSNOWRHO,ZPG_MELT)
+ CALL HYDRO_SNOW(IO%LGLACIER, PTSTEP, PK%XVEGTYPE_PATCH(:,:), DMK%XSRSFC, &
+ DEK%XLES, DEK%XMELT, PEK%TSNOW, ZPG_MELT)
!
ENDIF
!
@@ -556,20 +399,9 @@ ENDIF
! - Horton runoff : Direct or exponential precipitation distribution
! - Floodplains interception and infiltration
!
- CALL HYDRO_SGH(HISBA,HRUNOFF,HRAIN,HHORT, &
- PTSTEP,PD_G,PDZG, &
- PWSAT,PWFC,PWWILT, &
- PWG, PWGI, KWG_LAYER, &
- ZPG, ZPG_MELT, PMUF, &
- PCONDSAT, PBCOEF, &
- PMPOTSAT, PKSAT_ICE, PD_ICE, &
- PFSAT, PHORTON, ZDUNNE, PFFLOOD, &
- PPIFLOOD, PIFLOOD, PPFLOOD, &
- PRUNOFFB, PRUNOFFD, PCG, &
- PSOILWGHT, OFLOOD, KLAYER_HORT, &
- KLAYER_DUN )
+ CALL HYDRO_SGH(IO, KK, PK, PEK, DEK, DMK, PTSTEP, ZPG, ZPG_MELT, ZDUNNE )
!
-!-------------------------------------------------------------------------------
+!----------------------------------------------------------------------------
!
!* 6. EVOLUTION OF THE SOIL WATER CONTENT
! -----------------------------------
@@ -608,19 +440,19 @@ ZTSTEP = PTSTEP/REAL(INDT)
! vegetation cover. This used by both 'DEF' (code blocks 3.-4.) and 'DIF' options.
! ------------------------------------------------------------------
!
-WHERE(PLAI(:)/=XUNDEF .AND. PVEG(:)/=0.)
- ZKSFC_IVEG(:) = (1.0-ZINSOLFRZ_VEG*PVEG(:)) * (1.0-(PLAI(:)/ZINSOLFRZ_LAI))
+WHERE(PEK%XLAI(:)/=XUNDEF .AND. PVEG(:)/=0.)
+ ZKSFC_IVEG(:) = (1.0-ZINSOLFRZ_VEG*PVEG(:)) * MIN(MAX(1.0-(PEK%XLAI(:)/ZINSOLFRZ_LAI),0.0),1.0)
ELSEWHERE
ZKSFC_IVEG(:) = 1.0 ! No vegetation
ENDWHERE
!
!
-ZWGI0 (:,:) = PWGI(:,:) ! save initial ice content before phase changes and sublimation
+ZWGI0 (:,:) = PEK%XWGI(:,:) ! save initial ice content before phase changes and sublimation
!
-IF (HISBA=='DIF') THEN
+IF (IO%CISBA=='DIF') THEN
!
- INI = SIZE(PD_G(:,:),1)
- INL = MAXVAL(KWG_LAYER(:))
+ INJ = SIZE(PK%XDG(:,:),1)
+ INL = MAXVAL(PK%NWG_LAYER(:))
!
! Initialize some field
! ---------------------
@@ -628,11 +460,11 @@ IF (HISBA=='DIF') THEN
ZPS(:,:)=XUNDEF
ZTI(:,:)=XUNDEF
DO JL=1,INL
- DO JJ=1,INI
- IDEPTH=KWG_LAYER(JJ)
- IF(JL<=IDEPTH)THEN
+ DO JJ=1,INJ
+ IDEKTH=PK%NWG_LAYER(JJ)
+ IF(JL<=IDEKTH)THEN
ZPS(JJ,JL) = PPS(JJ)
- ZTI(JJ,JL) = MIN(XTT,PTG(JJ,JL))
+ ZTI(JJ,JL) = MIN(XTT,PEK%XTG(JJ,JL))
ENDIF
ENDDO
ENDDO
@@ -640,49 +472,45 @@ IF (HISBA=='DIF') THEN
! Compute specific humidity at saturation for the vapor conductivity
! ------------------------------------------------------------------
!
- ZQSAT (:,:) = QSAT (PTG(:,:),ZPS(:,:),KWG_LAYER(:),INL)
- ZQSATI(:,:) = QSATI(ZTI(:,:),ZPS(:,:),KWG_LAYER(:),INL)
+ ZQSAT (:,:) = QSAT (PEK%XTG,ZPS,PK%NWG_LAYER,INL)
+ ZQSATI(:,:) = QSATI(ZTI,ZPS,PK%NWG_LAYER,INL)
!
! Soil water sink terms: convert from (W m-2) and (kg m-2 s-1) to (m s-1)
! ------------------------------------------------------------------
!
ZPG (:) = ZPG (:) / XRHOLW
ZEVAPCOR(:) = ZEVAPCOR(:) / XRHOLW
- ZLEG (:) = ZLEG (:) /(XRHOLW*PLVTT(:))
- ZLETR (:) = (ZLETR (:)/ZF2(:))/(XRHOLW*PLVTT(:))
- ZLEGI (:) = ZLEGI (:) /(XRHOLW*PLSTT(:))
+ ZLEG (:) = ZLEG (:) /(XRHOLW*PK%XLVTT(:))
+ ZLETR (:) = (ZLETR (:)/ZF2(:))/(XRHOLW*PK%XLVTT(:))
+ ZLEGI (:) = ZLEGI (:) /(XRHOLW*PK%XLSTT(:))
!
DO JDT = 1,INDT
!
- CALL HYDRO_SOILDIF(HRUNOFF, ZTSTEP, &
- PBCOEF, PWSAT, PCONDSAT, PMPOTSAT, PWFC, &
- PD_G, PDZG, PDZDIF, ZPG, ZLETR, ZLEG, ZEVAPCOR, &
- PF2WGHT, PWG, PWGI, PTG, PPS, ZQSAT, ZQSATI, &
- ZDRAIN, ZHORTON, KWG_LAYER, INL, &
- PTOPQS, ZQSB, PFWTD, PWTD )
-!
- CALL ICE_SOILDIF(ZTSTEP, PTAUICE, ZKSFC_IVEG, ZLEGI, &
- PSOILHCAPZ, PWSAT, PMPOTSAT, PBCOEF, &
- PTG, PWGI, PWG, KWG_LAYER, &
- PDZG, ZWGI_EXCESS )
-!
- PDRAIN (:) = PDRAIN (:) + (ZDRAIN(:)+ZQSB(:)+ZWGI_EXCESS(:))/REAL(INDT)
- PQSB (:) = PQSB (:) + ZQSB (:)/REAL(INDT)
- PHORTON(:) = PHORTON(:) + ZHORTON(:)/REAL(INDT)
+ CALL HYDRO_SOILDIF(IO, KK, PK, PEK, ZTSTEP, ZPG, ZLETR, ZLEG, ZEVAPCOR, &
+ PF2WGHT, PPS, ZQSAT, ZQSATI, ZDRAIN, ZHORTON, INL, ZQSB )
+!
+
+ CALL ICE_SOILDIF(KK, PK, PEK, ZTSTEP, ZKSFC_IVEG, ZLEGI, PSOILHCAPZ, ZWGI_EXCESS )
+!
+ DEK%XDRAIN(:) = DEK%XDRAIN(:) + (ZDRAIN(:)+ZQSB(:)+ZWGI_EXCESS(:))/REAL(INDT)
+ DEK%XQSB (:) = DEK%XQSB (:) + ZQSB (:)/REAL(INDT)
+ DEK%XHORT (:) = DEK%XHORT (:) + ZHORTON(:)/REAL(INDT)
!
! Output diagnostics:
! Compute latent heating from phase change only in surface layer and total soil column,
! then adjust surface and total soil heat content to maintain balance.
!
- PDELPHASEG_SFC(:) = (PWGI(:,1)-ZWGI0(:,1))*(XLMTT*XRHOLW/PTSTEP)*PDZG(:,1) + ZLEGI(:)*(XRHOLW*XLSTT)
- PDELPHASEG(:) = PDELPHASEG_SFC(:)
- DO JL=2,INL
- DO JJ=1,INI
- PDELPHASEG(JJ) = PDELPHASEG(JJ) + (PWGI(JJ,JL)-ZWGI0(JJ,JL))*(XLMTT*XRHOLW/PTSTEP)*PDZG(JJ,JL)
- ENDDO
- ENDDO
- PDELHEATG_SFC(:) = PDELHEATG_SFC(:) + PDELPHASEG_SFC(:)
- PDELHEATG(:) = PDELHEATG(:) + PDELPHASEG(:)
+ PDELPHASEG_SFC(:) = (PEK%XWGI(:,1)-ZWGI0(:,1))*(XLMTT*XRHOLW/PTSTEP)*PK%XDZG(:,1) + &
+ ZLEGI(:)*(XRHOLW*XLSTT)
+ PDELPHASEG(:) = PDELPHASEG_SFC(:)
+ DO JL=2,INL
+ DO JJ=1,INJ
+ PDELPHASEG(JJ) = PDELPHASEG(JJ) + (PEK%XWGI(JJ,JL)-ZWGI0(JJ,JL))*&
+ (XLMTT*XRHOLW/PTSTEP)*PK%XDZG(JJ,JL)
+ ENDDO
+ ENDDO
+ PDELHEATG_SFC(:) = PDELHEATG_SFC(:) + PDELPHASEG_SFC(:)
+ PDELHEATG(:) = PDELHEATG(:) + PDELPHASEG(:)
ENDDO
!
@@ -691,24 +519,13 @@ ELSE
DO JDT = 1,INDT
!
! Only layer 1 and 2 are used for soil freezing (ZWG3 not used)
- CALL ICE_SOILFR(HSNOW_ISBA, HSOILFRZ, ZTSTEP, ZKSFC_IVEG, PCG, PCT, &
- PPSNG, PFFG, PTAUICE, ZDWGI1, ZDWGI2, PWSAT, &
- PMPOTSAT, PBCOEF, PD_G, PTG, PWGI, PWG )
-!
- CALL HYDRO_SOIL(HISBA, &
- ZTSTEP, &
- ZLETR, ZLEG, ZPG, ZEVAPCOR, &
- PWDRAIN, &
- PC1, PC2, PC3, PC4B, PC4REF, PWGEQ, &
- PD_G(:,2), ZDG3, ZWSAT_AVG, ZWFC_AVG, &
- ZDWGI1, ZDWGI2, ZLEGI, PD_G(:,1), PCG, PCT, &
- PTG(:,1), PTG(:,2), &
- PWG(:,1), PWG(:,2), ZWG3(:), &
- PWGI(:,1), PWGI(:,2), &
- ZRUNOFF,ZDRAIN,HKSAT,ZWWILT_AVG )
-!
- PDRAIN (:) = PDRAIN (:) + ZDRAIN (:)/REAL(INDT)
- PRUNOFF(:) = PRUNOFF(:) + ZRUNOFF(:)/REAL(INDT)
+ CALL ICE_SOILFR(IO, KK, PK, PEK, DMK, ZTSTEP, ZKSFC_IVEG, ZDWGI1, ZDWGI2)
+!
+ CALL HYDRO_SOIL(IO, KK, PK, PEK, DMK, ZTSTEP, ZLETR, ZLEG, ZPG, ZEVAPCOR, ZDG3, &
+ ZWSAT_AVG, ZWFC_AVG, ZDWGI1, ZDWGI2, ZLEGI, ZWG3, ZRUNOFF, ZDRAIN, ZWWILT_AVG )
+!
+ DEK%XDRAIN (:) = DEK%XDRAIN (:) + ZDRAIN (:)/REAL(INDT)
+ DEK%XRUNOFF(:) = DEK%XRUNOFF(:) + ZRUNOFF(:)/REAL(INDT)
!
ENDDO
!
@@ -716,12 +533,12 @@ ELSE
! Compute latent heating from phase change only in surface layer and total soil column,
! then adjust surface and total soil heat content to maintain balance.
!
- PDELPHASEG_SFC(:) = (PWGI(:,1)-ZWGI0(:,1))*(XLMTT*XRHOLW/PTSTEP)*PD_G(:,1) + ZLEGI(:)
- PDELPHASEG(:) = (PWGI(:,2)-ZWGI0(:,2))*(XLMTT*XRHOLW/PTSTEP)*PD_G(:,2)
+ PDELPHASEG_SFC(:) = (PEK%XWGI(:,1)-ZWGI0(:,1))*(XLMTT*XRHOLW/PTSTEP)*PK%XDG(:,1) + ZLEGI(:)
+ PDELPHASEG(:) = (PEK%XWGI(:,2)-ZWGI0(:,2))*(XLMTT*XRHOLW/PTSTEP)*PK%XDG(:,2)
PDELHEATG_SFC(:) = PDELHEATG_SFC(:) + PDELPHASEG_SFC(:)
PDELHEATG(:) = PDELHEATG(:) + PDELPHASEG(:)
!
- IF (HISBA == '3-L') PWG(:,3) = ZWG3(:)
+ IF (IO%CISBA == '3-L') PEK%XWG(:,3) = ZWG3(:)
!
#ifdef TOPD
IF (LCOUPL_TOPD) THEN
@@ -730,12 +547,13 @@ ELSE
IF (NMASKT_PATCH(JJ)/=0) THEN
IF ( XATOP(NMASKT_PATCH(JJ))/=XUNDEF) THEN
XRUNOFF_TOP(NMASKT_PATCH(JJ)) = XRUNOFF_TOP(NMASKT_PATCH(JJ)) + &
- (PRUNOFF(JJ)+ PHORTON(JJ))*XATOP(NMASKT_PATCH(JJ))*PTSTEP
- IF (HRUNOFF=='TOPD') THEN
+ (DEK%XRUNOFF(JJ)+ DEK%XHORT(JJ))*XATOP(NMASKT_PATCH(JJ))*PTSTEP
+ IF (IO%CRUNOFF=='TOPD') THEN
XRUNOFF_TOP(NMASKT_PATCH(JJ)) = XRUNOFF_TOP(NMASKT_PATCH(JJ)) + ZDUNNE(JJ)*PTSTEP
ELSE
! ZDUNNE contains only saturated pixels on mesh so only catchment
- XRUNOFF_TOP(NMASKT_PATCH(JJ)) = XRUNOFF_TOP(NMASKT_PATCH(JJ)) + ZDUNNE(JJ)*XATOP(NMASKT_PATCH(JJ))*PTSTEP
+ XRUNOFF_TOP(NMASKT_PATCH(JJ)) = XRUNOFF_TOP(NMASKT_PATCH(JJ)) + &
+ ZDUNNE(JJ)*XATOP(NMASKT_PATCH(JJ))*PTSTEP
ENDIF
ENDIF
ENDIF
@@ -750,7 +568,7 @@ ENDIF
!
! Add sub-grid surface and subsurface runoff to saturation excess:
!
-PRUNOFF(:) = PRUNOFF(:) + ZDUNNE(:) + PHORTON(:)
+DEK%XRUNOFF(:) = DEK%XRUNOFF(:) + ZDUNNE(:) + DEK%XHORT(:)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/hydro_glacier.F90 b/src/SURFEX/hydro_glacier.F90
index e916e1a2e784a101d1c323b6f0b84f757bf684d6..1a262f1777a4c69ea364b024b8c554c120ebfc70 100644
--- a/src/SURFEX/hydro_glacier.F90
+++ b/src/SURFEX/hydro_glacier.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE HYDRO_GLACIER (I, &
- PTSTEP,PSR,PSNOWRHO,PSNOWSWE,PGLASTO,PICEFLUX)
+ SUBROUTINE HYDRO_GLACIER (PTSTEP, PSR, PEK, PICEFLUX)
! ########################################################################
!
!!**** *HYDRO_GLACIER*
@@ -44,8 +43,7 @@
!* 0. DECLARATIONS
! ------------
!
-!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_n, ONLY : ISBA_PE_t
!
USE MODD_CSTS, ONLY : XDAY
USE MODD_SNOW_PAR, ONLY : XRHOSMAX, XHGLA, XSNOWDMIN, XRHOSMAX_ES
@@ -58,23 +56,13 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-!
-TYPE(ISBA_t), INTENT(INOUT) :: I
-!
REAL, INTENT(IN) :: PTSTEP
! KTSTEP = timestep [s]
!
REAL, DIMENSION(:), INTENT(IN) :: PSR
! PSR = Snowfall [kg/m²s]
!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWRHO
-! PSNOWRHO = Snow density [kg/m3]
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWSWE
-! PSNOWSWE = Snow water equivalent [kg/m²]
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PGLASTO
-! PGLASTO = Glacier storage [kg/m²]
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
!
REAL, DIMENSION(:), INTENT(OUT) :: PICEFLUX
! PICEFLUX = Ice flux from the Snowfall reservoir [kg/m²s]
@@ -98,7 +86,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('HYDRO_GLACIER',0,ZHOOK_HANDLE)
!
-ZGLASTO (:) = PGLASTO(:)
+ZGLASTO (:) = PEK%XICE_STO(:)
ZSTOMAX (:) = 0.0
ZFLUX (:) = 0.0
ZSR (:) = 0.0
@@ -109,13 +97,13 @@ PICEFLUX(:) = 0.0
!-------------------------------------------------------------------------------
!Ice accumulation only if snow amount is > to 33.3 meters of aged snow
!
-IF(I%TSNOW%SCHEME/='3-L' .AND. I%TSNOW%SCHEME/='CRO')THEN
- ZRHOSMAX=XRHOSMAX
- ZSWE(:)=PSNOWSWE(:,1)
+IF(PEK%TSNOW%SCHEME/='3-L' .AND. PEK%TSNOW%SCHEME/='CRO')THEN
+ ZRHOSMAX = XRHOSMAX
+ ZSWE(:) = PEK%TSNOW%WSNOW(:,1)
ELSE
ZRHOSMAX=XRHOSMAX_ES
- DO JWRK=1,SIZE(PSNOWSWE,2)
- ZSWE (:) = ZSWE (:) + PSNOWSWE(:,JWRK)
+ DO JWRK=1,SIZE(PEK%TSNOW%WSNOW,2)
+ ZSWE(:) = ZSWE(:) + PEK%TSNOW%WSNOW(:,JWRK)
END DO
ENDIF
!
@@ -127,32 +115,32 @@ ENDWHERE
!
!Snow storage calculation
!
-PGLASTO(:)=(ZGLASTO(:)+PTSTEP*ZSR(:))/(1.0+PTSTEP/(ZTAU*XDAY))
+PEK%XICE_STO(:) = (ZGLASTO(:)+PTSTEP*ZSR(:))/(1.0+PTSTEP/(ZTAU*XDAY))
!
!supress numerical artifacs
!
-ZSTOMAX(:)=ZSR(:)*PTSTEP+ZGLASTO(:)
+ZSTOMAX(:) = ZSR(:)*PTSTEP+ZGLASTO(:)
!
-PGLASTO(:)=MIN(ZSTOMAX(:),PGLASTO(:))
+PEK%XICE_STO(:) = MIN(ZSTOMAX(:),PEK%XICE_STO(:))
!
!Ice flux calculation
!
-ZFLUX(:)=(ZGLASTO(:)-PGLASTO(:))/PTSTEP+ZSR(:)
+ZFLUX(:) = (ZGLASTO(:)-PEK%XICE_STO(:))/PTSTEP+ZSR(:)
!
!supress numerical artifacs
!
PICEFLUX(:) = MAX(0.0,ZFLUX(:))
-PGLASTO (:) = PGLASTO(:) + PICEFLUX(:)-ZFLUX(:)
+PEK%XICE_STO(:) = PEK%XICE_STO(:) + PICEFLUX(:)-ZFLUX(:)
!
-WHERE(PGLASTO(:)<=1.E-10)PGLASTO(:)=0.0
+WHERE(PEK%XICE_STO(:)<=1.E-10)PEK%XICE_STO(:)=0.0
!
!-------------------------------------------------------------------------------
!Snow pack update
!
-IF(I%TSNOW%SCHEME/='3-L' .AND. I%TSNOW%SCHEME/='CRO')THEN
+IF(PEK%TSNOW%SCHEME/='3-L' .AND. PEK%TSNOW%SCHEME/='CRO')THEN
!
- WHERE(PSNOWSWE(:,1)<=XHGLA*ZRHOSMAX)PICEFLUX(:)=0.0
- PSNOWSWE(:,1)=PSNOWSWE(:,1)-PICEFLUX(:)*PTSTEP
+ WHERE(PEK%TSNOW%WSNOW(:,1)<=XHGLA*ZRHOSMAX)PICEFLUX(:)=0.0
+ PEK%TSNOW%WSNOW(:,1)=PEK%TSNOW%WSNOW(:,1)-PICEFLUX(:)*PTSTEP
!
ELSE
!
@@ -160,15 +148,15 @@ ELSE
!
! Snow total depth
ZSNOWD(:) = 0.
- DO JWRK=1,SIZE(PSNOWSWE,2)
- ZSNOWD(:) = ZSNOWD(:) + PSNOWSWE(:,JWRK)/PSNOWRHO(:,JWRK)
+ DO JWRK=1,SIZE(PEK%TSNOW%WSNOW,2)
+ ZSNOWD(:) = ZSNOWD(:) + PEK%TSNOW%WSNOW(:,JWRK)/PEK%TSNOW%RHO(:,JWRK)
END DO
!
! Flux
- DO JWRK=1,SIZE(PSNOWSWE,2)
- ZFLUX(:) = PICEFLUX(:)*(PSNOWSWE(:,JWRK)/PSNOWRHO(:,JWRK)) &
+ DO JWRK=1,SIZE(PEK%TSNOW%WSNOW,2)
+ ZFLUX(:) = PICEFLUX(:)*(PEK%TSNOW%WSNOW(:,JWRK)/PEK%TSNOW%RHO(:,JWRK)) &
/MAX(ZSNOWD(:),0.0001)
- PSNOWSWE(:,JWRK)=PSNOWSWE(:,JWRK)-ZFLUX(:)*PTSTEP
+ PEK%TSNOW%WSNOW(:,JWRK)=PEK%TSNOW%WSNOW(:,JWRK)-ZFLUX(:)*PTSTEP
END DO
!
ENDIF
diff --git a/src/SURFEX/hydro_sgh.F90 b/src/SURFEX/hydro_sgh.F90
index 1c0050746207f0bbe33a9773c57a8cdaa8671ee2..683dcb404d1fc9873be6884411fca044441dd91a 100644
--- a/src/SURFEX/hydro_sgh.F90
+++ b/src/SURFEX/hydro_sgh.F90
@@ -3,14 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE HYDRO_SGH (HISBA,HRUNOFF,HRAIN,HHORT,PTSTEP, &
- PD_G,PDZG,PWSAT,PWFC,PWWILT,PWG,PWGI, &
- KWG_LAYER,PPG,PPG_MELT,PMUF, &
- PCONDSAT,PBCOEF,PMPOTSAT, &
- PKSAT_ICE,PD_ICE,PFSAT,PHORTON,PDUNNE, &
- PFFLOOD,PPIFLOOD,PIFLOOD,PPFLOOD, &
- PRUNOFFB,PRUNOFFD,PCG,PSOILWGHT, &
- OFLOOD,KLAYER_HORT,KLAYER_DUN )
+ SUBROUTINE HYDRO_SGH(IO, KK, PK, PEK, DEK, DMK, PTSTEP, PPG, PPG_MELT, PDUNNE )
!
! #####################################################################
!
@@ -36,6 +29,10 @@
!* 0. DECLARATIONS
! ===================
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
!
USE MODD_CSTS, ONLY : XRHOLW, XDAY, XCL, XCI, XRHOLI
USE MODD_ISBA_PAR, ONLY : XWGMIN, XSPHSOIL, XDRYWGHT
@@ -57,90 +54,23 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-!
-!
- CHARACTER(LEN=*),INTENT(IN) :: HISBA ! hydrology/soil:
-! ! '2-L' = single column
-! ! '3-L' = root zone/baseflow layer
-! ! 'DIF' = N-layer diffusion: Richard's Eq.
-! ! (Boone and Etchevers 2001)
-!
- CHARACTER(LEN=*), INTENT(IN) :: HRUNOFF ! surface runoff formulation
-! ! 'WSAT'
-! ! 'DT92'
-! ! 'SGH ' Topmodel
-!
-!
- CHARACTER(LEN=*), INTENT(IN) :: HRAIN ! Rainfall spatial distribution
- ! 'DEF' = No rainfall spatial distribution
- ! 'SGH' = Rainfall exponential spatial distribution
- !
-!
- CHARACTER(LEN=*), INTENT(IN) :: HHORT ! Horton runoff
- ! 'DEF' = no Horton runoff
- ! 'SGH' = Horton runoff
-!
-LOGICAL, INTENT(IN) :: OFLOOD ! Flood scheme
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK
!
REAL, INTENT(IN) :: PTSTEP
! timestep of the integration
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PWG,PWGI
-! PWG = layer average liquid volumetric water content (m3 m-3)
-! PWGI = layer average frozen volumetric water content (m3 m-3)
-!
-INTEGER, DIMENSION(:),INTENT(IN) :: KWG_LAYER
-! KWG_LAYER = Number of soil moisture layers (DIF option)
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_G,PDZG,PWSAT,PWFC,PWWILT
-REAL, DIMENSION(:,:), INTENT(IN) :: PCONDSAT
-! PD_G = layer depth (m)
-! PDZG= layer thickness (m)
-! PCONDSAT = surface saturated hydraulic conductivity
-! PWSAT = soil porosity (m3 m-3)
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PBCOEF,PMPOTSAT
-! PMPOTSAT = matric potential at saturation (m) (BC parameters)
-! PBCOEF = slope of the retention curve (-) (BC parameters)
-!
-REAL, DIMENSION(:,:),INTENT(IN) :: PSOILWGHT ! ISBA-DIF: weights for vertical
-! ! integration of soil water and properties
-INTEGER, INTENT(IN) :: KLAYER_HORT! DIF optimization
-INTEGER, INTENT(IN) :: KLAYER_DUN ! DIF optimization
-!
-REAL, DIMENSION(:), INTENT(INOUT):: PFSAT
-! PFSAT = satured fraction
-!
REAL, DIMENSION(:), INTENT(INOUT):: PPG
-REAL, DIMENSION(:), INTENT(IN) :: PPG_MELT, PMUF
+REAL, DIMENSION(:), INTENT(IN) :: PPG_MELT
! PPG = water reaching the ground
! PPG_MELT = snowmelt reaching the ground
-! PMUF = wet fraction reached by rain
!
-REAL, DIMENSION(:), INTENT(IN) :: PKSAT_ICE, PD_ICE
-! PKSAT_ICE = hydraulic conductivity at saturation (m s-1)
-! on frozen soil depth (Horton calculation)
-! PD_ICE = depth of the soil column for
-! fraction of frozen soil calculation (m)
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PDUNNE, PHORTON
+REAL, DIMENSION(:), INTENT(OUT) :: PDUNNE
! PDUNNE = Dunne runoff
-! PHORTON = Horton runoff
-!
-REAL, DIMENSION(:), INTENT(IN ) :: PFFLOOD
-REAL, DIMENSION(:), INTENT(IN ) :: PPIFLOOD
-! PPIFLOOD = Floodplain potential infiltration [kg/m²/s]
-! = Floodplain mass
-REAL, DIMENSION(:), INTENT(INOUT) :: PIFLOOD, PPFLOOD
-! PIFLOOD = Floodplain infiltration [kg/m²/s]
-! PPFLOOD = Floodplain interception [kg/m²/s]
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRUNOFFB ! slope of the runoff curve
-REAL, DIMENSION(:), INTENT(IN) :: PRUNOFFD
-! PRUNOFFD = depth over which sub-grid runoff calculated (m)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCG
-! PCG = soil heat capacity to compute thermal penetration depth
!
!* 0.2 declarations of local variables
!
@@ -153,12 +83,11 @@ REAL, DIMENSION(SIZE(PPG)) :: ZPG_INI, ZFROZEN, ZIMAX_ICE, ZIMAX
! ZIMAX_ICE = maximum infiltration rate for frozen soil
! ZIMAX = maximum infiltration rate for unfrozen soil
! ZPIFLDMAX = maximum floodplains infiltration during 1 day (kg/m2/s)
-!
REAL, DIMENSION(SIZE(PPG)) :: ZWG2_AVG, ZWGI2_AVG, ZWSAT_AVG, ZWWILT_AVG
! Average water and ice content
! values over the soil depth D2 (for calculating surface runoff)
!
-REAL, DIMENSION(SIZE(PD_G,1),SIZE(PD_G,2)) :: ZWSAT, ZWFC, ZFRZ
+REAL, DIMENSION(SIZE(PK%XDG,1),SIZE(PK%XDG,2)) :: ZWSAT, ZWFC, ZFRZ
!
REAL, DIMENSION(SIZE(PPG)) :: ZPG_WORK, ZRUISDT, ZNL_HORT, ZDEPTH
!
@@ -170,7 +99,7 @@ REAL :: ZTDIURN, ZSOILHEATCAP
! ZTDIURN = thermal penetration depth for restore (m)
! ZSOILHEATCAP = Total soil volumetric heat capacity [J/(m3 K)]
!
-INTEGER :: INI, INL, JJ, JL, IDEPTH
+INTEGER :: INJ, INL, JJ, JL, IDEPTH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
@@ -190,82 +119,82 @@ ZWFC (:,:) = 0.0
!
ZLOG10 = LOG(10.0)
!
-!HRUNOFF = DT92 ZFSAT calculation
+!IO%CRUNOFF = DT92 ZFSAT calculation
ZWG2_AVG(:) = 0.0
ZWGI2_AVG(:) = 0.0
ZWSAT_AVG(:) = 0.0
ZWWILT_AVG(:) = 0.0
!
-!HHORT=SGH
+!IO%CHORT=SGH
ZHORT_R(:) = 0.0
ZHORT_M(:) = 0.0
!
-!PIFLOOD calculation
-ZSOILMAX (:) = 0.0
-ZIF_MAX (:) = 0.0
+!DEK%XIFLOOD calculation
+ZSOILMAX(:) = 0.0
+ZIF_MAX(:) = 0.0
ZPIFLDMAX(:) = 0.0
!
-!HRUNOFF = DT92 DUNNE calculation
+!IO%CRUNOFF = DT92 DUNNE calculation
ZPG_WORK(:) = 0.0
ZRUISDT(:) = 0.0
!
-!HRUNOFF = TOPD DUNNE calculation
+!IO%CRUNOFF = TOPD DUNNE calculation
ZRUNOFF_TOPD(:) = 0.0
!
!to limit numerical artifacts
ZPG_INI(:) = PPG(:) + PPG_MELT(:)
!
!
-INI=SIZE(PD_G,1)
-INL=MAXVAL(KWG_LAYER(:))
+INJ=SIZE(PK%XDG,1)
+INL=MAXVAL(PK%NWG_LAYER)
!
!-------------------------------------------------------------------------------
!
!* 1. Surface saturated fraction
! -----------------------------
!
-IF( HRUNOFF=='DT92' .OR. HRUNOFF == 'TOPD' )THEN
+IF( IO%CRUNOFF=='DT92' .OR. IO%CRUNOFF == 'TOPD' )THEN
!
! Calculate the layer average water content for the sub-grid
-! surface runoff computation: use PRUNOFFD as the depth over which
+! surface runoff computation: use PK%XRUNOFFD(:,1) as the depth over which
! runoff is calculated.
!
! First, determine a weight for each layer's contribution
! to thickness averaged water content and soil properties for runoff.
!
- IF (HISBA == 'DIF') THEN
+ IF (IO%CISBA == 'DIF') THEN
!
! Vertically averaged soil properties and moisture for surface runoff computation:
!
- DO JL=1,KLAYER_DUN
- DO JJ=1,INI
- IDEPTH=KWG_LAYER(JJ)
- IF(JL<=IDEPTH)THEN
- ZWG2_AVG (JJ) = ZWG2_AVG (JJ) + PSOILWGHT(JJ,JL)*PWG (JJ,JL)/MAX(1.E-6,PRUNOFFD(JJ))
- ZWGI2_AVG (JJ) = ZWGI2_AVG (JJ) + PSOILWGHT(JJ,JL)*PWGI (JJ,JL)/MAX(1.E-6,PRUNOFFD(JJ))
- ZWSAT_AVG (JJ) = ZWSAT_AVG (JJ) + PSOILWGHT(JJ,JL)*PWSAT (JJ,JL)/MAX(1.E-6,PRUNOFFD(JJ))
- ZWWILT_AVG(JJ) = ZWWILT_AVG(JJ) + PSOILWGHT(JJ,JL)*PWWILT(JJ,JL)/MAX(1.E-6,PRUNOFFD(JJ))
- ENDIF
- ENDDO
+ DO JL=1,IO%NLAYER_DUN
+ DO JJ=1,INJ
+ IDEPTH=PK%NWG_LAYER(JJ)
+ IF(JL<=IDEPTH)THEN
+ ZWG2_AVG (JJ) = ZWG2_AVG (JJ) + PK%XSOILWGHT(JJ,JL)*PEK%XWG (JJ,JL) /MAX(1.E-6,PK%XRUNOFFD(JJ))
+ ZWGI2_AVG (JJ) = ZWGI2_AVG (JJ) + PK%XSOILWGHT(JJ,JL)*PEK%XWGI(JJ,JL) /MAX(1.E-6,PK%XRUNOFFD(JJ))
+ ZWSAT_AVG (JJ) = ZWSAT_AVG (JJ) + PK%XSOILWGHT(JJ,JL)*KK%XWSAT (JJ,JL)/MAX(1.E-6,PK%XRUNOFFD(JJ))
+ ZWWILT_AVG(JJ) = ZWWILT_AVG(JJ) + PK%XSOILWGHT(JJ,JL)*KK%XWWILT(JJ,JL)/MAX(1.E-6,PK%XRUNOFFD(JJ))
+ ENDIF
ENDDO
+ ENDDO
!
- ELSE
+ ELSE
!
- ZWG2_AVG(:) = PWG(:, 2)
- ZWGI2_AVG(:) = PWGI(:,2)
- ZWSAT_AVG(:) = PWSAT(:,1)
- ZWWILT_AVG(:) = PWWILT(:,1)
+ ZWG2_AVG(:) = PEK%XWG (:,2)
+ ZWGI2_AVG(:) = PEK%XWGI(:,2)
+ ZWSAT_AVG(:) = KK%XWSAT (:,1)
+ ZWWILT_AVG(:) = KK%XWWILT(:,1)
!
- ENDIF
+ ENDIF
!
- IF(HHORT=='SGH')THEN
- !runoff over frozen soil explicitly calculated
- ZWGI2_AVG(:)=0.0
- ENDIF
+ IF(IO%CHORT=='SGH')THEN
+ !runoff over frozen soil explicitly calculated
+ ZWGI2_AVG(:)=0.0
+ ENDIF
!
- DO JJ=1,INI
- ZS=MIN(1.0,(ZWG2_AVG(JJ)+ZWGI2_AVG(JJ)-ZWWILT_AVG(JJ))/(ZWSAT_AVG(JJ)-ZWWILT_AVG(JJ)))
- PFSAT(JJ) = 1.0-(1.0-MAX(0.0,ZS))**(PRUNOFFB(JJ)/(PRUNOFFB(JJ)+1.))
+ DO JJ=1,INJ
+ ZS = MIN(1.0,(ZWG2_AVG(JJ)+ZWGI2_AVG(JJ)-ZWWILT_AVG(JJ))/(ZWSAT_AVG(JJ)-ZWWILT_AVG(JJ)))
+ KK%XFSAT(JJ) = 1.0-(1.0-MAX(0.0,ZS))**(KK%XRUNOFFB(JJ)/(KK%XRUNOFFB(JJ)+1.))
ENDDO
!
ENDIF
@@ -273,74 +202,75 @@ ENDIF
!* 2. Horton runoff
! ----------------
!
-IF(HHORT=='SGH'.OR.OFLOOD)THEN
+IF(IO%CHORT=='SGH'.OR.IO%LFLOOD)THEN
!
- IF(HISBA == 'DIF')THEN
+ IF(IO%CISBA == 'DIF')THEN
!
! no subgrid frozen soil fraction of the grid cells
ZFROZEN(:) = 0.0
!
- DO JL=1,KLAYER_HORT
- DO JJ=1,INI
+ DO JL=1,IO%NLAYER_HORT
+ DO JJ=1,INJ
!
! Modify soil porosity as ice assumed to become part
! of solid soil matrix (with respect to liquid flow):
- ZWSAT(JJ,JL) = MAX(XWGMIN, PWSAT(JJ,JL)-PWGI(JJ,JL))
- ZWFC (JJ,JL) = PWFC(JJ,JL)*ZWSAT(JJ,JL)/PWSAT(JJ,JL)
+ ZWSAT(JJ,JL) = MAX(XWGMIN, KK%XWSAT(JJ,JL)-PEK%XWGI(JJ,JL))
+ ZWFC (JJ,JL) = KK%XWFC(JJ,JL)*ZWSAT(JJ,JL)/KK%XWSAT(JJ,JL)
!
! Impedance Factor from (Johnsson and Lundin 1991).
- ZFRZ(JJ,JL) = EXP(ZLOG10*(-ZEICE*(PWGI(JJ,JL)/(PWGI(JJ,JL)+PWG(JJ,JL)))))
+ ZFRZ(JJ,JL) = EXP(ZLOG10*(-ZEICE*(PEK%XWGI(JJ,JL)/(PEK%XWGI(JJ,JL)+PEK%XWG(JJ,JL)))))
!
ENDDO
ENDDO
!
! Calculate infiltration MAX using green-ampt approximation (derived form)
- ZIMAX(:) = INFMAX_FUNC(PWG,ZWSAT,ZFRZ,PCONDSAT,PMPOTSAT,PBCOEF,PDZG,PD_G,KLAYER_HORT)
+ ZIMAX(:) = INFMAX_FUNC(PEK%XWG, ZWSAT, ZFRZ, PK%XCONDSAT, KK%XMPOTSAT, KK%XBCOEF, &
+ PK%XDZG, PK%XDG, IO%NLAYER_HORT)
!
ELSE
!
- DO JJ=1,INI
+ DO JJ=1,INJ
!
! Total soil volumetric heat capacity [J/(m3 K)]:
!
- ZSOILHEATCAP = XCL*XRHOLW*PWG (JJ,2) + &
- XCI*XRHOLI*PWGI(JJ,2) + &
- XSPHSOIL*XDRYWGHT*(1.0-PWSAT(JJ,1))
+ ZSOILHEATCAP = XCL*XRHOLW*PEK%XWG (JJ,2) + &
+ XCI*XRHOLI*PEK%XWGI(JJ,2) + &
+ XSPHSOIL*XDRYWGHT*(1.0-KK%XWSAT(JJ,1))
!
! Soil thickness which corresponds to the diurnal surface temperature
! wave penetration depth as T2 is the average temperature for this layer:
!
- ZTDIURN = MIN(PD_G(JJ,2), 4./(ZSOILHEATCAP*PCG(JJ)))
+ ZTDIURN = MIN(PK%XDG(JJ,2), 4./(ZSOILHEATCAP*DMK%XCG(JJ)))
!
! Effective frozen depth penetration
!
- ZEFFICE=PD_G(JJ,2)*PWGI(JJ,2)/(PWGI(JJ,2)+PWG(JJ,2))
+ ZEFFICE = PK%XDG(JJ,2)*PEK%XWGI(JJ,2)/(PEK%XWGI(JJ,2)+PEK%XWG(JJ,2))
!
! Modify soil porosity as ice assumed to become part
! of solid soil matrix (with respect to liquid flow):
!
- ZWSAT(JJ,1) = MAX(XWGMIN, PWSAT(JJ,1)-PWGI(JJ,2))
+ ZWSAT(JJ,1) = MAX(XWGMIN, KK%XWSAT(JJ,1)-PEK%XWGI(JJ,2))
!
! calculate the subgrid frozen soil fraction of the grid cells
!
- ZFROZEN (JJ) = MIN(1.,ZEFFICE/MAX(PD_ICE(JJ),ZTDIURN))
+ ZFROZEN (JJ) = MIN(1.,ZEFFICE/MAX(PK%XD_ICE(JJ),ZTDIURN))
!
! Impedance Factor from (Johnsson and Lundin 1991).
!
ZFRZ(JJ,1) = EXP(ZLOG10*(-ZEICE*MIN(1.,ZEFFICE/ZTDIURN)))
!
! Calculate infiltration MAX on frozen soil as Johnsson and Lundin (1991).
-! The max infiltration is equal to the unsaturated conductivity function at a
-! water content corresponding to the total porosity less the ice-filled volume.
+! The max infiltration is equal ,1to the unsaturated conductivity function at a
+! water content c,1orresponding to the total porosity less the ice-filled volume.
!
- ZS =MIN(1.,ZWSAT(JJ,1)/PWSAT(JJ,1))
- ZIMAX_ICE(JJ)=ZFRZ(JJ,1)*PKSAT_ICE(JJ)*(ZS**(2*PBCOEF(JJ,1)+3.))
+ ZS =MIN(1.,ZWSAT(JJ,1)/KK%XWSAT(JJ,1))
+ ZIMAX_ICE(JJ)=ZFRZ(JJ,1)*PK%XKSAT_ICE(JJ)*(ZS**(2*KK%XBCOEF(JJ,1)+3.))
!
! Calculate infiltration MAX on unfrozen soil using green-ampt approximation
!
- ZS =MIN(1.,PWG(JJ,2)/ZWSAT(JJ,1))
- ZD_H =MIN(0.10,PD_G(JJ,2))
- ZIMAX(JJ)=PCONDSAT(JJ,1)*(PBCOEF(JJ,1)*PMPOTSAT(JJ,1)*(ZS-1.0)/ZD_H+1.0)
+ ZS =MIN(1.,PEK%XWG(JJ,2)/ZWSAT(JJ,1))
+ ZD_H =MIN(0.10,PK%XDG(JJ,2))
+ ZIMAX(JJ)=PK%XCONDSAT(JJ,1)*(KK%XBCOEF(JJ,1)*KK%XMPOTSAT(JJ,1)*(ZS-1.0)/ZD_H+1.0)
!
ENDDO
!
@@ -348,15 +278,15 @@ IF(HHORT=='SGH'.OR.OFLOOD)THEN
!
ENDIF
!
-IF(HHORT=='SGH')THEN
+IF(IO%CHORT=='SGH')THEN
!
! calculate the Horton runoff generated by the rainfall rate
!
- IF(HRAIN=='SGH')THEN
+ IF(IO%CRAIN=='SGH')THEN
!
WHERE(PPG(:)>0.)
- ZHORT_R(:) = (1.- ZFROZEN(:))* PPG(:)/((ZIMAX (:)*XRHOLW*PMUF(:)/PPG(:)) + 1.) & !unfrozen soil
- + ZFROZEN(:) * PPG(:)/((ZIMAX_ICE(:)*XRHOLW*PMUF(:)/PPG(:)) + 1.) !frozen soil
+ ZHORT_R(:) = (1.- ZFROZEN(:))* PPG(:)/((ZIMAX (:)*XRHOLW*KK%XMUF(:)/PPG(:)) + 1.) & !unfrozen soil
+ + ZFROZEN(:) * PPG(:)/((ZIMAX_ICE(:)*XRHOLW*KK%XMUF(:)/PPG(:)) + 1.) !frozen soil
END WHERE
!
ELSE
@@ -373,15 +303,15 @@ IF(HHORT=='SGH')THEN
!
! calculate the total Horton runoff
!
- WHERE(PFFLOOD(:)<=PFSAT(:))
- PHORTON(:) = (1. - PFSAT(:)) * (ZHORT_R(:) + ZHORT_M(:))
+ WHERE(KK%XFFLOOD(:)<=KK%XFSAT(:))
+ DEK%XHORT(:) = (1. - KK%XFSAT(:)) * (ZHORT_R(:) + ZHORT_M(:))
ELSEWHERE
- PHORTON(:) = (1. - PFFLOOD(:)) * (ZHORT_R(:) + ZHORT_M(:))
+ DEK%XHORT(:) = (1. - KK%XFFLOOD(:)) * (ZHORT_R(:) + ZHORT_M(:))
ENDWHERE
!
ELSE
!
- PHORTON(:) = 0.0
+ DEK%XHORT(:) = 0.0
!
ENDIF
!
@@ -395,29 +325,29 @@ PPG (:) = PPG(:) + PPG_MELT(:)
!
! Interception by the flooplains
!
-IF(OFLOOD)THEN
- PPFLOOD(:)=PFFLOOD(:)*MAX(0.0,PPG(:))
+IF(IO%LFLOOD)THEN
+ DEK%XPFLOOD(:)=KK%XFFLOOD(:)*MAX(0.0,PPG(:))
ELSE
- PPFLOOD(:)=0.0
+ DEK%XPFLOOD(:)=0.0
ENDIF
!
-IF(HRUNOFF=='SGH ')THEN
+IF(IO%CRUNOFF=='SGH ')THEN
!
! calculate the Dunne runoff with TOPMODEL
!
- PDUNNE(:) = MAX(PPG(:),0.0) * MAX(PFSAT(:)-PFFLOOD(:),0.0)
+ PDUNNE(:) = MAX(PPG(:),0.0) * MAX(KK%XFSAT(:)-KK%XFFLOOD(:),0.0)
!
-ELSEIF (HRUNOFF=='DT92' .OR. HRUNOFF=='TOPD')THEN
+ELSEIF (IO%CRUNOFF=='DT92' .OR. IO%CRUNOFF=='TOPD')THEN
!
!* Dumenil et Todini (1992) RUNOFF SCHEME
! ---------------------------------------
!
! surface runoff done only on the Fsat-Fflood fraction
!
- ZPG_WORK(:) = PPG(:) - PHORTON(:) - PPFLOOD(:)
+ ZPG_WORK(:) = PPG(:) - DEK%XHORT(:) - DEK%XPFLOOD(:)
!
#ifdef TOPD
- IF ( LCOUPL_TOPD.AND.HRUNOFF == 'TOPD' )THEN
+ IF ( LCOUPL_TOPD.AND.IO%CRUNOFF == 'TOPD' )THEN
!
DO JJ=1,SIZE(NMASKT_PATCH)
IF (NMASKT_PATCH(JJ)/=0) THEN
@@ -430,88 +360,85 @@ ELSEIF (HRUNOFF=='DT92' .OR. HRUNOFF=='TOPD')THEN
ENDIF
#endif
!
- CALL HYDRO_DT92(PTSTEP, &
- PRUNOFFB, ZWWILT_AVG, &
- PRUNOFFD, ZWSAT_AVG, &
- ZWG2_AVG, ZWGI2_AVG, &
- ZPG_WORK, ZRUISDT )
+ CALL HYDRO_DT92(PTSTEP, KK%XRUNOFFB, ZWWILT_AVG, PK%XRUNOFFD, ZWSAT_AVG, &
+ ZWG2_AVG, ZWGI2_AVG, ZPG_WORK, ZRUISDT )
!
- PDUNNE(:) = ZRUISDT(:)*PRUNOFFD(:)*XRHOLW/PTSTEP
+ PDUNNE(:) = ZRUISDT(:)*PK%XRUNOFFD(:)*XRHOLW/PTSTEP
!
#ifdef TOPD
- IF (LCOUPL_TOPD.AND.HRUNOFF == 'TOPD') THEN
+ IF (LCOUPL_TOPD.AND.IO%CRUNOFF == 'TOPD') THEN
PDUNNE(:) = ZRUNOFF_TOPD(:) + PDUNNE(:)*(1-XATOP(NMASKT_PATCH(:)))
ENDIF
#endif
!
- IF(OFLOOD)THEN
- WHERE(PFFLOOD(:)>=PFSAT(:).AND.PFFLOOD(:)>0.0)PDUNNE(:) = 0.0
+ IF(IO%LFLOOD)THEN
+ WHERE(KK%XFFLOOD(:)>=KK%XFSAT(:).AND.KK%XFFLOOD(:)>0.0)PDUNNE(:) = 0.0
ENDIF
!
ELSE
!
! Default case (no subgrid runoff)
!
- PFSAT (:) = 0.0
+ KK%XFSAT (:) = 0.0
PDUNNE(:) = 0.0
!
ENDIF
!
! calculate the infiltration rate after runoff
!
-PPG (:) = PPG(:) - PDUNNE(:) - PHORTON(:) - PPFLOOD(:)
+PPG (:) = PPG(:) - PDUNNE(:) - DEK%XHORT(:) - DEK%XPFLOOD(:)
!
! Supress numerical artifacts:
!
WHERE (ZPG_INI(:)<0.0)
- PPG(:) = ZPG_INI(:)
- PHORTON(:) = 0.0
- PDUNNE (:) = 0.0
- PPFLOOD(:) = 0.0
+ PPG(:) = ZPG_INI(:)
+ DEK%XHORT(:) = 0.0
+ PDUNNE (:) = 0.0
+ DEK%XPFLOOD(:) = 0.0
ENDWHERE
!
!* 4. infiltration rate from floodplains (à revoir pour DF !!!)
! -------------------------------------
!
-IF(OFLOOD)THEN
+IF(IO%LFLOOD)THEN
!
! calculate the maximum flood infiltration
!
- ZPIFLDMAX(:) = MIN(PPIFLOOD(:),XRHOLW/XDAY) ! no more than 1 meter of water per days
+ ZPIFLDMAX(:) = MIN(KK%XPIFLOOD(:),XRHOLW/XDAY) ! no more than 1 meter of water per days
!
ZIF_MAX(:) = MAX(0.,(1.- ZFROZEN(:))) * ZIMAX (:)*XRHOLW & !unfrozen soil
+ ZFROZEN(:) * ZIMAX_ICE(:)*XRHOLW !frozen soil
!
- IF(HISBA == 'DIF')THEN
+ IF(IO%CISBA == 'DIF')THEN
ZDEPTH(:)=0.0
- DO JL=1,KLAYER_HORT
- DO JJ=1,INI
- IF(ZDEPTH(JJ)<XHORT_DEPTH)THEN
- ZSOILMAX(JJ) = ZSOILMAX(JJ)+MAX(0.0,ZWFC(JJ,JL)-PWG(JJ,JL))*PDZG(JJ,JL)*XRHOLW/PTSTEP
- ZDEPTH (JJ) = PD_G(JJ,JL)
- ENDIF
- ENDDO
+ DO JL=1,IO%NLAYER_HORT
+ DO JJ=1,INJ
+ IF(ZDEPTH(JJ)<XHORT_DEPTH)THEN
+ ZSOILMAX(JJ) = ZSOILMAX(JJ)+MAX(0.0,ZWFC(JJ,JL)-PEK%XWG(JJ,JL))*PK%XDZG(JJ,JL)*XRHOLW/PTSTEP
+ ZDEPTH (JJ) = PK%XDG(JJ,JL)
+ ENDIF
+ ENDDO
ENDDO
ELSE
- DO JJ=1,INI
- ZWSAT(JJ,1) = MAX(XWGMIN, PWSAT(JJ,1)-PWGI(JJ,2))
- ZSOILMAX(JJ) = MAX(0.0,ZWSAT(JJ,1)-PWG(JJ,2))*PD_G(JJ,2)*XRHOLW/PTSTEP
+ DO JJ=1,INJ
+ ZWSAT(JJ,1) = MAX(XWGMIN, KK%XWSAT(JJ,1)-PEK%XWGI(JJ,2))
+ ZSOILMAX(JJ) = MAX(0.0,ZWSAT(JJ,1)-PEK%XWG(JJ,2))*PK%XDG(JJ,2)*XRHOLW/PTSTEP
ENDDO
ENDIF
!
ZSOILMAX(:) = MIN(ZSOILMAX(:),ZIF_MAX(:))
!
- PIFLOOD(:) = MAX(0.0,(PFFLOOD(:)-PFSAT(:))) * MIN(ZPIFLDMAX(:),ZSOILMAX(:))
+ DEK%XIFLOOD(:) = MAX(0.0,(KK%XFFLOOD(:)-KK%XFSAT(:))) * MIN(ZPIFLDMAX(:),ZSOILMAX(:))
!
ELSE
!
- PIFLOOD(:)=0.0
+ DEK%XIFLOOD(:)=0.0
!
ENDIF
!
!calculate the infiltration rate
!
-PPG (:) = PPG(:) + PIFLOOD(:)
+PPG (:) = PPG(:) + DEK%XIFLOOD(:)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/hydro_snow.F90 b/src/SURFEX/hydro_snow.F90
index 01bf26394dec843de84ae7f52c7ac9f2263db008..7e3beace17901ced2d618486f117dc438cb30ed7 100644
--- a/src/SURFEX/hydro_snow.F90
+++ b/src/SURFEX/hydro_snow.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE HYDRO_SNOW( OGLACIER, PTSTEP, PVEGTYPE, &
- PSR, PLES, PMELT, &
- PSNOWSWE, PSNOWALB, PSNOWRHO, PPG_MELT )
+ SUBROUTINE HYDRO_SNOW(OGLACIER, PTSTEP, PVEGTYPE, PSR, PLES, PMELT, TPSNOW, PPG_MELT )
! #####################################################################
!
!!**** *HYDRO_SNOW*
@@ -63,6 +61,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TYPE_SNOW, ONLY : SURF_SNOW
+!
USE MODD_CSTS, ONLY : XLSTT, XLMTT, XDAY
USE MODD_SNOW_PAR, ONLY : XANS_T, XANS_TODRY, XANSMIN, XANSMAX, &
XRHOSMAX, XRHOSMIN, XWCRN, XAGLAMIN, &
@@ -90,11 +90,9 @@ REAL, DIMENSION(:), INTENT(IN) :: PSR, PLES, PMELT
! PSR = snow rate
! PLES = latent heat of sublimation over the snow
! PMELT = melting rate of snow
-REAL, DIMENSION(:), INTENT(INOUT) :: PSNOWSWE, PSNOWALB, PSNOWRHO, PPG_MELT
-! PSNOWSWE = equivalent water content of the
-! snow reservoir at time 't+dt'
-! PSNOWALB = albedo of the snow at 't+dt'
-! PSNOWRHO = density of the snow at 't+dt'
+TYPE(SURF_SNOW), INTENT(INOUT) :: TPSNOW
+REAL, DIMENSION(:), INTENT(INOUT) :: PPG_MELT
+! TPSNOW%WSNOW(:,1,1) = equivalent water content of the
! PPG_MELT = total water reaching the ground
!
!* 0.2 declarations of local variables
@@ -125,7 +123,7 @@ ZANSMAX(:) = XANSMAX
!* 2. Fields at time t-dt
! -------------------
!
-ZSNOWSWEM (:) = PSNOWSWE(:)
+ZSNOWSWEM (:) = TPSNOW%WSNOW(:,1)
!
!* 3. EVOLUTION OF THE SNOWPACK ('DEF' OPTION)
! ----------------------------------------
@@ -135,7 +133,7 @@ ZSNOWSWEM (:) = PSNOWSWE(:)
!
! evolution of Ws (without melting)
!
-PSNOWSWE(:) = ZSNOWSWEM(:) + PTSTEP * ( PSR(:) - PLES(:)/XLSTT - PMELT(:))
+TPSNOW%WSNOW(:,1) = ZSNOWSWEM(:) + PTSTEP * ( PSR(:) - PLES(:)/XLSTT - PMELT(:))
!
! melting of snow: more liquid water
! reaches the surface
@@ -144,7 +142,7 @@ PPG_MELT(:) = PPG_MELT(:) + PMELT(:)
!
! removes very small values due to computation precision
!
-WHERE(PSNOWSWE(:) < 1.0E-10) PSNOWSWE(:) = 0.
+WHERE(TPSNOW%WSNOW(:,1) < 1.0E-10) TPSNOW%WSNOW(:,1) = 0.
!
!-------------------------------------------------------------------------------
!
@@ -161,29 +159,29 @@ ENDIF
! the evolution of the snow albedo differs
! if there is melting or not
!
-WHERE (PSNOWSWE > 0.0 )
+WHERE (TPSNOW%WSNOW(:,1) > 0.0 )
!
WHERE ( ZSNOWSWEM > 0.0)
!
! when there is melting
WHERE ( PMELT > 0.0 )
- PSNOWALB(:) = (PSNOWALB(:)-ZANSMIN(:))*EXP(-XANS_T*PTSTEP/XDAY) + ZANSMIN(:) &
- + PSR(:)*PTSTEP/XWCRN*(ZANSMAX(:)-ZANSMIN(:))
+ TPSNOW%ALB(:) = (TPSNOW%ALB(:)-ZANSMIN(:))*EXP(-XANS_T*PTSTEP/XDAY) + ZANSMIN(:) &
+ + PSR(:)*PTSTEP/XWCRN*(ZANSMAX(:)-ZANSMIN(:))
! when there is no melting
ELSEWHERE
- PSNOWALB(:) = PSNOWALB(:) - XANS_TODRY*PTSTEP/XDAY &
- + PSR(:)*PTSTEP/XWCRN*(ZANSMAX(:)-ZANSMIN(:))
+ TPSNOW%ALB(:) = TPSNOW%ALB(:) - XANS_TODRY*PTSTEP/XDAY &
+ + PSR(:)*PTSTEP/XWCRN*(ZANSMAX(:)-ZANSMIN(:))
END WHERE
!
ELSEWHERE (ZSNOWSWEM == 0.0)
!
! new snow covered surface
- PSNOWALB(:) = ZANSMAX(:)
+ TPSNOW%ALB(:) = ZANSMAX(:)
END WHERE
!
! limits of the albedo
- PSNOWALB(:) = MIN( ZANSMAX(:), PSNOWALB(:) )
- PSNOWALB(:) = MAX( ZANSMIN(:), PSNOWALB(:) )
+ TPSNOW%ALB(:) = MIN( ZANSMAX(:), TPSNOW%ALB(:) )
+ TPSNOW%ALB(:) = MAX( ZANSMIN(:), TPSNOW%ALB(:) )
END WHERE
!
!-------------------------------------------------------------------------------
@@ -195,14 +193,14 @@ END WHERE
! evolution will depend whether or not
! the snow is melting
!
-WHERE ( PSNOWSWE > 0.0 )
+WHERE ( TPSNOW%WSNOW(:,1) > 0.0 )
WHERE ( ZSNOWSWEM > 0.0 )
- ZWSX(:) = MAX( PSNOWSWE(:),PSR(:)*PTSTEP)
- PSNOWRHO(:) = (PSNOWRHO(:)-XRHOSMAX)*EXP(-XANS_T*PTSTEP/XDAY) + XRHOSMAX
- PSNOWRHO(:) = ( (ZWSX(:)-PSR(:)*PTSTEP) * PSNOWRHO(:) &
- + (PSR(:)*PTSTEP) * XRHOSMIN ) / ZWSX(:)
+ ZWSX(:) = MAX( TPSNOW%WSNOW(:,1),PSR(:)*PTSTEP)
+ TPSNOW%RHO(:,1) = (TPSNOW%RHO(:,1)-XRHOSMAX)*EXP(-XANS_T*PTSTEP/XDAY) + XRHOSMAX
+ TPSNOW%RHO(:,1) = ( (ZWSX(:)-PSR(:)*PTSTEP) * TPSNOW%RHO(:,1) &
+ + (PSR(:)*PTSTEP) * XRHOSMIN ) / ZWSX(:)
ELSEWHERE ( ZSNOWSWEM == 0.0)
- PSNOWRHO(:) = XRHOSMIN
+ TPSNOW%RHO(:,1) = XRHOSMIN
END WHERE
END WHERE
!
@@ -211,9 +209,9 @@ END WHERE
!* 4. No SNOW
! -------
!
-WHERE ( PSNOWSWE == 0.0 )
- PSNOWRHO(:) = XUNDEF
- PSNOWALB(:) = XUNDEF
+WHERE ( TPSNOW%WSNOW(:,1) == 0.0 )
+ TPSNOW%RHO(:,1) = XUNDEF
+ TPSNOW%ALB(:) = XUNDEF
END WHERE
!
IF (LHOOK) CALL DR_HOOK('HYDRO_SNOW',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/hydro_soil.F90 b/src/SURFEX/hydro_soil.F90
index 0dddb1888a6097d610aca4cc58272c6aa3c7244c..d68398c330d4b2a78e62fda9a4c4f3da42373880 100644
--- a/src/SURFEX/hydro_soil.F90
+++ b/src/SURFEX/hydro_soil.F90
@@ -3,16 +3,10 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE HYDRO_SOIL(HISBA, &
- PTSTEP, &
- PLETR, PLEG, PPG, PEVAPCOR, &
- PWDRAIN, &
- PC1, PC2, PC3, PC4B, PC4REF, PWGEQ, &
- PD_G2, PD_G3, PWSAT, PWFC, &
- PDWGI1, PDWGI2, PLEGI, PD_G1, PCG, PCT, &
- PTG, PTG2, &
- PWG1, PWG2, PWG3, PWGI1, PWGI2, &
- PRUNOFF, PDRAIN, HKSAT, PWWILT )
+ SUBROUTINE HYDRO_SOIL(IO, KK, PK, PEK, DMK, PTSTEP, &
+ PLETR, PLEG, PPG, PEVAPCOR, PD_G3, &
+ PWSAT, PWFC, PDWGI1, PDWGI2, PLEGI,&
+ PWG3, PRUNOFF, PDRAIN, PWWILT )
! #####################################################################
!
!!**** *HYDRO_SOIL*
@@ -65,7 +59,7 @@
!! 25/01/00 A. Boone : fully implicit method for WG2, WG3
!! 05/03/07 A. Boone : changed drainage diagnostic computation for
!! single bulk-soil option...i.e. for
-!! cases when HISBA=2-L or d2>=d3 (HISBA=3-L)
+!! cases when IO%CISBA=2-L or d2>=d3 (IO%CISBA=3-L)
!! for tighter water budget closure
!! 07/08/12 B. Decharme : Soil ice energy conservation
!! 04/13 B. Decharme : Apply physical limits on wg here instead of in hydro.F90
@@ -74,10 +68,13 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
+!
USE MODD_CSTS, ONLY : XLVTT, XRHOLW, XLMTT, XLSTT, XDAY
USE MODD_ISBA_PAR, ONLY : XWGMIN
!
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -85,17 +82,15 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-!
- CHARACTER(LEN=*), INTENT(IN) :: HISBA ! type of ISBA version:
-! ! '2-L' (default)
-! ! '3-L'
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK
!
REAL, INTENT(IN) :: PTSTEP
! timestep of the integration (s)
!
-REAL, DIMENSION(:), INTENT(IN) :: PD_G1
-! depth of surface ice reservoir (m)
-!
REAL, DIMENSION(:), INTENT(IN) :: PLETR, PLEG, PPG, PEVAPCOR
! PLETR = evapotranspiration of the vegetation (W m-2)
! PLEG = latent heat of evaporation over the ground (W m-2)
@@ -103,29 +98,13 @@ REAL, DIMENSION(:), INTENT(IN) :: PLETR, PLEG, PPG, PEVAPCOR
! PEVAPCOR = correction for any excess evaporation
! from snow as it completely ablates (kg m-2 s-1)
!
-REAL, DIMENSION(:), INTENT(IN) :: PWDRAIN ! minimum Wg for drainage (m3 m-3)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PC1, PC2, PWGEQ, PCG, PCT
-REAL, DIMENSION(:,:), INTENT(IN) :: PC3
-! soil coefficients
-! C1, C2 = coefficients for the moisture calculations (-)
-! C3 = coefficient for drainage calculation (m)
-! PWGEQ = equilibrium surface volumetric moisture (m3 m-3)
-! PCG = soil heat capacity
-! PCT = grid-averaged heat capacity (K m2 J-1)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PD_G2, PD_G3, PWSAT, PWFC
-! PD_G2 = root depth (m)
+REAL, DIMENSION(:), INTENT(IN) :: PD_G3, PWSAT, PWFC
! PD_G3 = depth of the soil column (m)
! PWSAT = saturation volumetric water content
! of the soil (m3 m-3)
! PWFC = field capacity volumetric water
! content (m3 m-3)
!
-REAL, DIMENSION(:), INTENT(IN) :: PC4B, PC4REF
-! PC4REF, PC4B = fiiting soil paramter for vertical
-! diffusion (C4) (-)
-!
REAL, DIMENSION(:), INTENT(IN) :: PDWGI1, PDWGI2, PLEGI
! PDWGI1 = surface layer liquid water equivalent
! volumetric ice content time tendency (m3 m-3)
@@ -133,46 +112,32 @@ REAL, DIMENSION(:), INTENT(IN) :: PDWGI1, PDWGI2, PLEGI
! volumetric ice content time tendency (m3 m-3)
! PLEGI = surface soil ice sublimation (W m-2)
!
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PTG, PTG2
-! PTG = surface temperature at 't' (K)
-! PTG2 = soil temperature at 't' (K)
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PWG1, PWG2, PWG3, PWGI1, PWGI2
-! PWG1 = near-surface soil moisture at 't+dt' (m3 m-3)
-! PWG2 = bulk root-soil moisture at 't+dt' (m3 m-3)
+REAL, DIMENSION(:), INTENT(INOUT) :: PWG3
! PWG3 = bulk deep-soil moisture at 't+dt' (m3 m-3)
-! PWGI1 = bulk surface-soil ice at 't+dt' (m3 m-3)
-! PWGI2 = bulk deep-soil ice at 't+dt' (m3 m-3)
!
REAL, DIMENSION(:), INTENT(OUT) :: PRUNOFF, PDRAIN
! PRUNOFF = runoff (kg m-2 s-1)
! PDRAIN = drainage (kg m-2 s-1)
-!
- CHARACTER(LEN=*), INTENT(IN) :: HKSAT ! soil hydraulic profil option
-! ! 'DEF' = ISBA homogenous soil
-! ! 'SGH' = ksat exponential decay
!
REAL, DIMENSION(:), INTENT(IN) :: PWWILT
! PWWILT = wilting point volumetric water
! content (m3 m-3)
-!
!* 0.2 declarations of local variables
!
!
-REAL, DIMENSION(SIZE(PTG)) :: ZWGI1M, ZWG2M, ZWG3M, ZWGI2M
+REAL, DIMENSION(SIZE(PEK%XTG,1)) :: ZWGI1M, ZWG2M, ZWG3M, ZWGI2M
! Prognostic variables of ISBA at 't-dt'
! ZWG2M = root-soil volumetric water content
! ZWG3M = deep-soil volumetric water content
! ZWGI1M = surface-soil volumetric ice content
! ZWGI2M = deep-soil volumetric ice content
!
-REAL, DIMENSION(SIZE(PTG)) :: ZETR, ZEG
+REAL, DIMENSION(SIZE(PEK%XTG,1)) :: ZETR, ZEG
! ZETR = evapotranspiration rate
! ZEG = evaporation rate from the ground
!
!
-REAL, DIMENSION(SIZE(PTG)) :: ZWSAT, ZWFC
+REAL, DIMENSION(SIZE(PEK%XTG,1)) :: ZWSAT, ZWFC
! ZWSAT = Wsat when ice is present
! ZWFC = Wfc when ice is present
!
@@ -224,14 +189,14 @@ ZEXCESSF(:) = 0.0
!
! Fields at time t-dt
!
-ZWG2M(:) = PWG2(:)
+ZWG2M(:) = PEK%XWG(:,2)
ZWG3M(:) = PWG3(:)
-ZWGI1M(:) = PWGI1(:)
-ZWGI2M(:) = PWGI2(:)
+ZWGI1M(:) = PEK%XWGI(:,1)
+ZWGI2M(:) = PEK%XWGI(:,2)
!-------------------------------------------------------------------------------
!
-DO JJ=1,SIZE(PTG)
+DO JJ=1,SIZE(PEK%XTG,1)
!
!* 1. New Wsat
! --------
@@ -267,14 +232,14 @@ DO JJ=1,SIZE(PTG)
!
! updated values for wg
!
- PWG1(JJ) = (PWG1(JJ) - PTSTEP * (PC1(JJ) * (ZEG(JJ) - PPG(JJ)) / XRHOLW &
- - PC2(JJ) * PWGEQ(JJ) / XDAY) ) &
- / (1. + PTSTEP * PC2(JJ) / XDAY)
+ PEK%XWG(JJ,1) = (PEK%XWG(JJ,1) - PTSTEP * &
+ (DMK%XC1(JJ)*(ZEG(JJ)-PPG(JJ))/XRHOLW - DMK%XC2(JJ)*DMK%XWGEQ(JJ)/XDAY)) &
+ / (1. + PTSTEP * DMK%XC2(JJ) / XDAY)
!
!
ENDDO
!
-IF(HKSAT=='SGH' .OR. HKSAT=='EXP') THEN
+IF(IO%CKSAT=='SGH' .OR. IO%CKSAT=='EXP') THEN
ZWLIM2(:)=ZWWILT(:)
ZWLIM3(:)=PWWILT(:)
ELSE
@@ -290,56 +255,56 @@ ENDIF
!* 5.1 2-L ISBA version
! ----------------
!
-IF (HISBA=='2-L') THEN
+IF (IO%CISBA=='2-L') THEN
!
- DO JJ=1,SIZE(PTG)
-
+ DO JJ=1,SIZE(PEK%XTG,1)
!
- PWG2(JJ) = ZWG2M(JJ) - PTSTEP*(ZEG(JJ) + ZETR(JJ) - PPG(JJ)) &
- / (PD_G2(JJ) * XRHOLW)
+ PEK%XWG(JJ,2) = ZWG2M(JJ) - PTSTEP*(ZEG(JJ) + ZETR(JJ) - PPG(JJ)) / (PK%XDG(JJ,2) * XRHOLW)
!
!* 6. DRAINAGE FROM THE DEEP SOIL
! ------------------
!
- ZWDRAIN(JJ) = PWDRAIN(JJ) * MAX(0.0, MIN(ZWFC(JJ),PWG2(JJ))-ZWLIM2(JJ))/(ZWFC(JJ)-ZWLIM2(JJ))
+ ZWDRAIN(JJ) = KK%XWDRAIN(JJ) * &
+ MAX(0.0, MIN(ZWFC(JJ),PEK%XWG(JJ,2))-ZWLIM2(JJ))/(ZWFC(JJ)-ZWLIM2(JJ))
- ZDRAIN2(JJ) = MAX( MIN(ZWDRAIN(JJ),PWG2(JJ)) , PWG2(JJ)-ZWFC(JJ) )*PC3(JJ,1) &
- / (PD_G2(JJ)*XDAY) * PTSTEP
+ ZDRAIN2(JJ) = MAX( MIN(ZWDRAIN(JJ),PEK%XWG(JJ,2)) , &
+ PEK%XWG(JJ,2)-ZWFC(JJ) )*PK%XC3(JJ,1) / (PK%XDG(JJ,2)*XDAY) * PTSTEP
!
! the deep-soil volumetric water content w2
! is modified consequently
!
- PWG2(JJ) = PWG2(JJ) - ZDRAIN2(JJ)
+ PEK%XWG(JJ,2) = PEK%XWG(JJ,2) - ZDRAIN2(JJ)
- PDRAIN(JJ) = ZDRAIN2(JJ)*PD_G2(JJ)*XRHOLW/PTSTEP ! Final output units: kg m-2 s-1
+ PDRAIN(JJ) = ZDRAIN2(JJ)*PK%XDG(JJ,2)*XRHOLW/PTSTEP ! Final output units: kg m-2 s-1
!
ENDDO
!
ELSE
!
- DO JJ=1,SIZE(PTG)
+ DO JJ=1,SIZE(PEK%XTG,1)
!* 5.2 3-L ISBA version (with only 2 active layers)
! ----------------
!
- IF (PD_G2(JJ) >= PD_G3(JJ)) THEN
+ IF (PK%XDG(JJ,2) >= PD_G3(JJ)) THEN
- PWG2(JJ) = ZWG2M(JJ) - PTSTEP*(ZEG(JJ) + ZETR(JJ) - PPG(JJ)) &
- / (PD_G2(JJ) * XRHOLW)
+ PEK%XWG(JJ,2) = ZWG2M(JJ) - PTSTEP*(ZEG(JJ) + ZETR(JJ) - PPG(JJ)) &
+ / (PK%XDG(JJ,2) * XRHOLW)
!* 6. DRAINAGE FROM THE DEEP SOIL
! ------------------
! when w2 > wfc, there is drainage
!
- ZWDRAIN(JJ) = PWDRAIN(JJ) * MAX(0.0, MIN(ZWFC(JJ),PWG2(JJ))-ZWLIM2(JJ))/(ZWFC(JJ)-ZWLIM2(JJ))
+ ZWDRAIN(JJ) = KK%XWDRAIN(JJ) * &
+ MAX(0.0, MIN(ZWFC(JJ),PEK%XWG(JJ,2))-ZWLIM2(JJ))/(ZWFC(JJ)-ZWLIM2(JJ))
- ZDRAIN2(JJ) = MAX( MIN(ZWDRAIN(JJ),PWG2(JJ)) , PWG2(JJ)-ZWFC(JJ) )*PC3(JJ,1) &
- / (PD_G2(JJ)*XDAY) * PTSTEP
+ ZDRAIN2(JJ) = MAX( MIN(ZWDRAIN(JJ),PEK%XWG(JJ,2)) , &
+ PEK%XWG(JJ,2)-ZWFC(JJ) )*PK%XC3(JJ,1) / (PK%XDG(JJ,2)*XDAY) * PTSTEP
- PWG2(JJ) = PWG2(JJ) - ZDRAIN2(JJ)
- PWG3(JJ) = PWG2(JJ)
+ PEK%XWG(JJ,2) = PEK%XWG(JJ,2) - ZDRAIN2(JJ)
+ PWG3(JJ) = PEK%XWG(JJ,2)
- PDRAIN(JJ) = ZDRAIN2(JJ)*PD_G2(JJ)*XRHOLW/PTSTEP ! Final output units: kg m-2 s-1
+ PDRAIN(JJ) = ZDRAIN2(JJ)*PK%XDG(JJ,2)*XRHOLW/PTSTEP ! Final output units: kg m-2 s-1
!
ELSE
!
@@ -352,8 +317,8 @@ ELSE
! rhobust (but more complicated) method is developed for maintaining a minimum river
! flow under dry conditions, this method will be used.
!
- ZWDRAIN2(JJ) = PWDRAIN(JJ)* MAX(0.0, MIN(ZWFC(JJ),ZWG2M(JJ))-ZWLIM2(JJ))/(ZWFC(JJ)-ZWLIM2(JJ))
- ZWDRAIN3(JJ) = PWDRAIN(JJ)* MAX(0.0, MIN(PWFC(JJ),ZWG3M(JJ))-ZWLIM3(JJ))/(PWFC(JJ)-ZWLIM3(JJ))
+ ZWDRAIN2(JJ) = KK%XWDRAIN(JJ)* MAX(0.0, MIN(ZWFC(JJ),ZWG2M(JJ))-ZWLIM2(JJ))/(ZWFC(JJ)-ZWLIM2(JJ))
+ ZWDRAIN3(JJ) = KK%XWDRAIN(JJ)* MAX(0.0, MIN(PWFC(JJ),ZWG3M(JJ))-ZWLIM3(JJ))/(PWFC(JJ)-ZWLIM3(JJ))
!
! Delta functions:
!
@@ -367,54 +332,54 @@ ELSE
! evaluate inter-facial water content, grid factor, and diffusion coefficient:
- ZWAVG(JJ) = ( ( (ZWG2M(JJ)**6)* PD_G2(JJ) + &
- (ZWG3M(JJ)**6)*(PD_G3(JJ)-PD_G2(JJ)) )/PD_G3(JJ) )**(1./6.)
+ ZWAVG(JJ) = ( ( (ZWG2M(JJ)**6)* PK%XDG(JJ,2) + &
+ (ZWG3M(JJ)**6)*(PD_G3(JJ)-PK%XDG(JJ,2)) )/PD_G3(JJ) )**(1./6.)
- ZFACTOR(JJ) = PD_G2(JJ)/(PD_G3(JJ)-PD_G2(JJ))
+ ZFACTOR(JJ) = PK%XDG(JJ,2)/(PD_G3(JJ)-PK%XDG(JJ,2))
- ZC4 (JJ) = PC4REF(JJ)*(ZWAVG(JJ)**PC4B(JJ)) &
- *(10.**(-PC4B(JJ)*PWGI2(JJ)/(PWSAT(JJ)-XWGMIN)))
+ ZC4 (JJ) = PK%XC4REF(JJ)*(ZWAVG(JJ)**KK%XC4B(JJ)) &
+ *(10.**(-KK%XC4B(JJ)*PEK%XWGI(JJ,2)/(PWSAT(JJ)-XWGMIN)))
!
! calculate sources/sinks
!
- ZSINK2 (JJ) = -(ZEG(JJ) + ZETR(JJ) - PPG(JJ) )/(PD_G2(JJ)*XRHOLW)
+ ZSINK2 (JJ) = -(ZEG(JJ) + ZETR(JJ) - PPG(JJ) )/(PK%XDG(JJ,2)*XRHOLW)
! Compute evolution of water content using linearized equations
! (see Boone 2000, Appendix F.2 for details)
!
! sink terms are treated explicitly, other terms are implicit
!
- ZDRAINCF2(JJ) = PC3(JJ,1) / (PD_G2(JJ) * XDAY)
+ ZDRAINCF2(JJ) = PK%XC3(JJ,1) / (PK%XDG(JJ,2) * XDAY)
ZDELTA22(JJ) = ZDELTA2(JJ)*ZWFC(JJ) - (1.0-ZDELTA2(JJ))*ZWDRAIN2(JJ)
ZC2(JJ) = 1.0 + PTSTEP*(ZDELTA2(JJ)*ZDRAINCF2(JJ) + (ZC4(JJ)/XDAY))
ZB2(JJ) = PTSTEP*ZC4(JJ)/(XDAY*ZC2(JJ))
ZA2(JJ) = ( ZWG2M(JJ) + PTSTEP*(ZSINK2(JJ) + ZDRAINCF2(JJ)*ZDELTA22(JJ)) )/ZC2(JJ)
!
- ZDRAINCF3(JJ) = PC3(JJ,2) / ( (PD_G3(JJ)-PD_G2(JJ)) * XDAY)
+ ZDRAINCF3(JJ) = PK%XC3(JJ,2) / ( (PD_G3(JJ)-PK%XDG(JJ,2)) * XDAY)
ZDELTA33(JJ) = ZDELTA3(JJ)*PWFC(JJ) - (1.0-ZDELTA3(JJ))*ZWDRAIN3(JJ)
ZC3(JJ) = 1.0 + PTSTEP*(ZDELTA3(JJ)*ZDRAINCF3(JJ) + ZFACTOR(JJ)*(ZC4(JJ)/XDAY))
ZB3(JJ) = PTSTEP*ZFACTOR(JJ)*(ZDELTA2(JJ)*ZDRAINCF2(JJ) + (ZC4(JJ)/XDAY) )/ZC3(JJ)
ZA3(JJ) = ( ZWG3M(JJ) + PTSTEP*( &
- - ZFACTOR(JJ)*ZDRAINCF2(JJ)*ZDELTA22(JJ) &
- + ZDRAINCF3(JJ)*ZDELTA33(JJ)) )/ZC3(JJ)
+ - ZFACTOR(JJ)*ZDRAINCF2(JJ)*ZDELTA22(JJ) &
+ + ZDRAINCF3(JJ)*ZDELTA33(JJ)) )/ZC3(JJ)
!
! Advance volumetric water content values in time:
! system of 2 linear equations:
!
- PWG2(JJ) = ( ZA2(JJ)+ZB2(JJ)*ZA3(JJ) )/(1.0 - ZB2(JJ)*ZB3(JJ))
- PWG3(JJ) = ZA3(JJ) + ZB3(JJ)*PWG2(JJ)
+ PEK%XWG(JJ,2) = ( ZA2(JJ)+ZB2(JJ)*ZA3(JJ) )/(1.0 - ZB2(JJ)*ZB3(JJ))
+ PWG3(JJ) = ZA3(JJ) + ZB3(JJ)*PEK%XWG(JJ,2)
!
! Drainage (kg m-2 s-1): this term is implicit and is extracted directly from
! the drainage computation in the above equations.
!
- ZWDRAIN(JJ) = (XRHOLW*PC3(JJ,2)/XDAY)* &
+ ZWDRAIN(JJ) = (XRHOLW*PK%XC3(JJ,2)/XDAY)* &
( ZDELTA3(JJ)*(PWG3(JJ)-PWFC(JJ)) + (1.0-ZDELTA3(JJ))*ZWDRAIN3(JJ) )
!
! As drainage is implicit, perform a check to prevent any negative drainage
! (can arise rarely and is generally negligible, but to ensure a high order conservation):
!
PDRAIN(JJ) = MAX(0.0, ZWDRAIN(JJ))
- PWG3(JJ) = PWG3(JJ) + (PDRAIN(JJ) - ZWDRAIN(JJ))*PTSTEP/((PD_G3(JJ)-PD_G2(JJ))*XRHOLW)
+ PWG3(JJ) = PWG3(JJ) + (PDRAIN(JJ) - ZWDRAIN(JJ))*PTSTEP/((PD_G3(JJ)-PK%XDG(JJ,2))*XRHOLW)
!
ENDIF
ENDDO
@@ -422,7 +387,7 @@ END IF
!
!-------------------------------------------------------------------------------
!
-DO JJ=1,SIZE(PTG)
+DO JJ=1,SIZE(PEK%XTG,1)
!* 7. EFFECT OF THE MELTING/FREEZING ON THE SOIL WATER CONTENT
! --------------------------------------------------------
!
@@ -433,11 +398,11 @@ DO JJ=1,SIZE(PTG)
! and sublimation (*heat effect* of sublimation already accounted
! for in latent heat flux calculation):
!
- PWGI1(JJ) = ZWGI1M(JJ) + PDWGI1(JJ) - PLEGI(JJ)*PTSTEP/(XLSTT*PD_G1(JJ)*XRHOLW)
+ PEK%XWGI(JJ,1) = ZWGI1M(JJ) + PDWGI1(JJ) - PLEGI(JJ)*PTSTEP/(XLSTT*PK%XDG(JJ,1)*XRHOLW)
!
! Next, update the liquid water content:
!
- PWG1(JJ) = PWG1(JJ) - PDWGI1(JJ)
+ PEK%XWG(JJ,1) = PEK%XWG(JJ,1) - PDWGI1(JJ)
!
! Make sure that ice has not dropped below
! zero due to sublimation (the ONLY way
@@ -450,9 +415,9 @@ DO JJ=1,SIZE(PTG)
!
ZEXCESSFC(JJ)= 0.0
!
- ZEXCESSF(JJ) = MAX(0.0, - PWGI1(JJ))
- PWG1(JJ) = PWG1(JJ) - ZEXCESSF(JJ)
- PWGI1(JJ) = PWGI1(JJ) + ZEXCESSF(JJ)
+ ZEXCESSF(JJ) = MAX(0.0, - PEK%XWGI(JJ,1))
+ PEK%XWG(JJ,1) = PEK%XWG(JJ,1) - ZEXCESSF(JJ)
+ PEK%XWGI(JJ,1) = PEK%XWGI(JJ,1) + ZEXCESSF(JJ)
ZEXCESSFC(JJ)= ZEXCESSFC(JJ) - ZEXCESSF(JJ)
!
! Modif H.Douville 26/08/03 (global scale)
@@ -462,9 +427,9 @@ DO JJ=1,SIZE(PTG)
! (thus cooling the layer) to ensure sublimation
! is accomodated, then extract this from frozen water store.
!
- ZEXCESSF(JJ) = MIN(0.0, PWSAT(JJ) - XWGMIN - PWGI1(JJ))
- PWG1(JJ) = PWG1(JJ) - ZEXCESSF(JJ)
- PWGI1(JJ) = PWGI1(JJ) + ZEXCESSF(JJ)
+ ZEXCESSF(JJ) = MIN(0.0, PWSAT(JJ) - XWGMIN - PEK%XWGI(JJ,1))
+ PEK%XWG(JJ,1) = PEK%XWG(JJ,1) - ZEXCESSF(JJ)
+ PEK%XWGI(JJ,1) = PEK%XWGI(JJ,1) + ZEXCESSF(JJ)
ZEXCESSFC(JJ)= ZEXCESSFC(JJ) - ZEXCESSF(JJ)
!
! Make sure that liquid has not dropped below
@@ -473,23 +438,23 @@ DO JJ=1,SIZE(PTG)
! Normally simply a budget check, i.e. usually small but accounted
! for none-the-less to assure high accuracy.
!
- ZEXCESSF(JJ) = MAX(0.0, XWGMIN - PWG1(JJ))
- PWGI1(JJ) = PWGI1(JJ) - ZEXCESSF(JJ)
- PWG1(JJ) = PWG1(JJ) + ZEXCESSF(JJ)
+ ZEXCESSF(JJ) = MAX(0.0, XWGMIN - PEK%XWG(JJ,1))
+ PEK%XWGI(JJ,1) = PEK%XWGI(JJ,1) - ZEXCESSF(JJ)
+ PEK%XWG(JJ,1) = PEK%XWG(JJ,1) + ZEXCESSF(JJ)
ZEXCESSFC(JJ)= ZEXCESSFC(JJ) + ZEXCESSF(JJ)
!
! removes very small values due to computation precision
!
- IF(PWGI1(JJ) < 1.0E-10) THEN
- ZEXCESSF(JJ) = PWGI1(JJ)
- PWG1(JJ) = PWG1(JJ) + ZEXCESSF(JJ)
- PWGI1(JJ) = 0.0
- ZEXCESSFC(JJ)= ZEXCESSFC(JJ) + ZEXCESSF(JJ)
+ IF(PEK%XWGI(JJ,1) < 1.0E-10) THEN
+ ZEXCESSF(JJ) = PEK%XWGI(JJ,1)
+ PEK%XWG(JJ,1) = PEK%XWG(JJ,1) + ZEXCESSF(JJ)
+ PEK%XWGI(JJ,1) = 0.0
+ ZEXCESSFC(JJ) = ZEXCESSFC(JJ) + ZEXCESSF(JJ)
ENDIF
!
! Cummulative phase change for the ice/liquid budget corrections:
!
- PTG(JJ) = PTG(JJ) - ZEXCESSFC(JJ)*XLMTT*PCT(JJ)*XRHOLW*PD_G1(JJ)
+ PEK%XTG(JJ,1) = PEK%XTG(JJ,1) - ZEXCESSFC(JJ)*XLMTT*DMK%XCT(JJ)*XRHOLW*PK%XDG(JJ,1)
!
!
!* 7.2 Effect on deep-soil liquid and ice reservoirs
@@ -499,20 +464,20 @@ DO JJ=1,SIZE(PTG)
! Since this reservoir includes surface reservoir, add
! any changes in ice content due to sublimation:
!
- PWGI2(JJ) = ZWGI2M(JJ) + PDWGI2(JJ) - PLEGI(JJ)*PTSTEP/(XLSTT*PD_G2(JJ)*XRHOLW)
+ PEK%XWGI(JJ,2) = ZWGI2M(JJ) + PDWGI2(JJ) - PLEGI(JJ)*PTSTEP/(XLSTT*PK%XDG(JJ,2)*XRHOLW)
!
! Update the liquid water content:
!
- PWG2(JJ) = PWG2(JJ) - PDWGI2(JJ)
+ PEK%XWG(JJ,2) = PEK%XWG(JJ,2) - PDWGI2(JJ)
!
! Make sure that ice has not dropped below
! zero due to sublimation (as above).
!
ZEXCESSFC(JJ)= 0.0
!
- ZEXCESSF(JJ) = MAX(0.0, -PWGI2(JJ))
- PWG2(JJ) = PWG2(JJ) - ZEXCESSF(JJ)
- PWGI2(JJ) = PWGI2(JJ) + ZEXCESSF(JJ)
+ ZEXCESSF(JJ) = MAX(0.0, -PEK%XWGI(JJ,2))
+ PEK%XWG(JJ,2) = PEK%XWG(JJ,2) - ZEXCESSF(JJ)
+ PEK%XWGI(JJ,2) = PEK%XWGI(JJ,2) + ZEXCESSF(JJ)
ZEXCESSFC(JJ)= ZEXCESSFC(JJ) - ZEXCESSF(JJ)
!
! Budget check of minimum threshold for liquid
@@ -520,23 +485,23 @@ DO JJ=1,SIZE(PTG)
! to be utilized, but retained for accuracy
! in energy and water balance (as above).
!
- ZEXCESSF(JJ) = MAX(0.0, XWGMIN - PWG2(JJ))
- PWGI2(JJ) = PWGI2(JJ) - ZEXCESSF(JJ)
- PWG2(JJ) = PWG2(JJ) + ZEXCESSF(JJ)
+ ZEXCESSF(JJ) = MAX(0.0, XWGMIN - PEK%XWG(JJ,2))
+ PEK%XWGI(JJ,2) = PEK%XWGI(JJ,2) - ZEXCESSF(JJ)
+ PEK%XWG(JJ,2) = PEK%XWG(JJ,2) + ZEXCESSF(JJ)
ZEXCESSFC(JJ)= ZEXCESSFC(JJ) + ZEXCESSF(JJ)
!
! removes very small values due to computation precision
!
- IF (PWGI2(JJ) < 1.0E-10 * PTSTEP) THEN
- ZEXCESSF(JJ) = PWGI2(JJ)
- PWG2 (JJ) = PWG2(JJ) + ZEXCESSF(JJ)
- PWGI2(JJ) = 0.
+ IF (PEK%XWGI(JJ,2) < 1.0E-10 * PTSTEP) THEN
+ ZEXCESSF(JJ) = PEK%XWGI(JJ,2)
+ PEK%XWG(JJ,2) = PEK%XWG(JJ,2) + ZEXCESSF(JJ)
+ PEK%XWGI(JJ,2) = 0.
ZEXCESSFC(JJ)= ZEXCESSFC(JJ) + ZEXCESSF(JJ)
ENDIF
!
! Cummulative phase change for the ice/liquid budget corrections:
!
- PTG2(JJ) = PTG2(JJ) - ZEXCESSFC(JJ)*XLMTT*PCG(JJ)*XRHOLW*PD_G2(JJ)
+ PEK%XTG(JJ,2) = PEK%XTG(JJ,2) - ZEXCESSFC(JJ)*XLMTT*DMK%XCG(JJ)*XRHOLW*PK%XDG(JJ,2)
!
!
ENDDO
@@ -548,20 +513,20 @@ ENDDO
!
! runoff of second layer
!
-PRUNOFF(:) = MAX( 0., PWG2(:)+PWGI2(:)-PWSAT(:) )*PD_G2(:) * XRHOLW / PTSTEP
+PRUNOFF(:) = MAX( 0., PEK%XWG(:,2)+PEK%XWGI(:,2)-PWSAT(:) )*PK%XDG(:,2) * XRHOLW / PTSTEP
!
! now apply limits:
!
-PWG1(:) = MIN( PWG1(:), PWSAT(:) - PWGI1(:) )
-PWG1(:) = MAX( PWG1(:), XWGMIN )
+PEK%XWG(:,1) = MIN( PEK%XWG(:,1), PWSAT(:) - PEK%XWGI(:,1) )
+PEK%XWG(:,1) = MAX( PEK%XWG(:,1), XWGMIN )
!
-PWG2(:) = MIN( PWG2(:), PWSAT(:) - PWGI2(:) )
-PWG2(:) = MAX( PWG2(:), XWGMIN )
+PEK%XWG(:,2) = MIN( PEK%XWG(:,2), PWSAT(:) - PEK%XWGI(:,2) )
+PEK%XWG(:,2) = MAX( PEK%XWG(:,2), XWGMIN )
!
!runoff of third layer added to drainage
!
-IF (HISBA=='3-L') THEN
- PDRAIN(:) = PDRAIN(:) + MAX( 0., PWG3(:)-PWSAT(:) )* (PD_G3(:)-PD_G2(:)) * XRHOLW / PTSTEP
+IF (IO%CISBA=='3-L') THEN
+ PDRAIN(:) = PDRAIN(:) + MAX( 0., PWG3(:)-PWSAT(:) )* (PD_G3(:)-PK%XDG(:,2)) * XRHOLW / PTSTEP
PWG3(:) = MIN( PWG3(:), PWSAT(:) )
PWG3(:) = MAX( PWG3(:), XWGMIN )
END IF
diff --git a/src/SURFEX/hydro_soildif.F90 b/src/SURFEX/hydro_soildif.F90
index f5fc3a38e5e1bb876a8287f4732fd08950935039..bba799420374c0346a0b4224655479975eefc9b5 100644
--- a/src/SURFEX/hydro_soildif.F90
+++ b/src/SURFEX/hydro_soildif.F90
@@ -3,12 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE HYDRO_SOILDIF(HRUNOFF,PTSTEP, &
- PBCOEF,PWSAT,PCONDSAT,PMPOTSAT,PWFC,PDG,PDZG, &
- PDZDIF,PPG,PLETR,PLEG,PEVAPCOR,PF2WGHT, &
- PWG,PWGI,PTG,PPS,PQSAT,PQSATI, &
- PDRAIN,PHORTON,KWG_LAYER, &
- KMAX_LAYER,PTOPQS,PQSB,PFWTD,PWTD )
+ SUBROUTINE HYDRO_SOILDIF(IO, KK, PK, PEK, PTSTEP, PPG, PLETR, PLEG, PEVAPCOR, &
+ PF2WGHT, PPS, PQSAT, PQSATI, PDRAIN, PHORTON, KMAX_LAYER, PQSB)
! ##########################################################################
!
!
@@ -75,13 +71,15 @@
!! 10/12 B.Decharme: EVAPCOR snow correction in DIF
!! 04/13 B.Decharme: Subsurface runoff if SGH (DIF option only)
!! 07/2013 B.Decharme: Surface / Water table depth coupling
-!! 05/2016 B.Decharme: Bug : no Horton runoff because is already
-!! computed in hydro_sgh if required
+!! 01/2016 B.Decharme: Bug : if no surface runoff (HRUNOFF=WSAT) then no Horton
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+!
USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
USE MODD_CSTS, ONLY : XRHOLW
USE MODD_ISBA_PAR, ONLY : XWGMIN
@@ -93,14 +91,14 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
- CHARACTER(LEN=*), INTENT(IN) :: HRUNOFF ! surface runoff formulation
-! ! 'WSAT'
-! ! 'DT92'
-! ! 'SGH ' Topmodel
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
!
REAL, INTENT(IN) :: PTSTEP ! Model time step (s)
!
-REAL, DIMENSION(:), INTENT(IN) :: PPS, PPG, PLETR, PLEG, PEVAPCOR, PFWTD, PWTD
+REAL, DIMENSION(:), INTENT(IN) :: PPS, PPG, PLETR, PLEG, PEVAPCOR
! PPS = surface pressure (Pa)
! PPG = throughfall rate:
! rate at which water reaches the surface
@@ -110,44 +108,18 @@ REAL, DIMENSION(:), INTENT(IN) :: PPS, PPG, PLETR, PLEG, PEVAPCOR, PFWTD, P
! PLEG = bare-soil evaporation rate (m/s)
! PEVAPCOR = correction for any excess evaporation
! from snow as it completely ablates (m/s)
-! PFWTD = grid-cell fraction of water table to rise
-! PWTD = water table depth negative below soil surface (m)
!
REAL, DIMENSION(:,:), INTENT(IN) :: PQSAT,PQSATI
! specific humidity at saturation
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PTG, PDG, PDZG, PDZDIF
-! PTG = layer-average soil temperatures (K)
-! PDG = soil layer depth (m)
-! PDZG= soil layer thicknesses (m)
-! PDZDIF = distance between the midpoints of consecutive layers (m)
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PWSAT, PCONDSAT, PF2WGHT, PWFC
-! PWSAT = porosity profile (m3 m-3)
-! PCONDSAT = hydraulic conductivity at saturation (m s-1)
+REAL, DIMENSION(:,:), INTENT(IN) :: PF2WGHT
! PF2WGHT = root-zone transpiration weights (-)
-! PWFC = field capacity water content (m3 m-3)
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PBCOEF,PMPOTSAT
-! PMPOTSAT = matric potential at saturation (m) (BC parameters)
-! PBCOEF = slope of the retention curve (-) (BC parameters)
-!
-INTEGER, DIMENSION(:), INTENT(IN) :: KWG_LAYER
-! KWG_LAYER = Number of soil moisture layers
!
INTEGER, INTENT(IN) :: KMAX_LAYER
! KMAX_LAYER = Max number of soil moisture layers (DIF option)
!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PWG, PWGI
-! PWG = volumetric liquid water content (m3 m-3)
-! PWGI = volumetric ice content (m3 m-3)
-!
REAL, DIMENSION(:), INTENT(OUT) :: PDRAIN, PHORTON
! PDRAIN = drainage (flux out of model base) (kg m-2 s-1)
-! PHORTON = runoff (due to saturation (lateral) (kg m-2 s-1)
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PTOPQS
-! PTOPQS = Topmodel subsurface flow by layer (m/s)
!
REAL, DIMENSION(:), INTENT(OUT) :: PQSB !Lateral subsurface flow [kg/m²/s]
!
@@ -156,9 +128,9 @@ REAL, DIMENSION(:), INTENT(OUT) :: PQSB !Lateral subsurface flow [kg/m²
!
INTEGER :: JJ, JL ! loop control
!
-INTEGER :: INI, INL, IDEPTH ! Number of point and grid layers
+INTEGER :: INJ, INL, IDEPTH ! Number of point and grid layers
!
-REAL, DIMENSION(SIZE(PDZG,1)) :: ZINFILTC, ZEXCESS, ZDGN, ZWGTOT, ZPSIWTD, ZWTD
+REAL, DIMENSION(SIZE(PK%XDZG,1)) :: ZINFILTC, ZEXCESS, ZDGN, ZWGTOT, ZPSIWTD, ZWTD
! ZEXCESS = working variable: excess soil water
! which is used as a constraint
! ZDGN = Depth of the last node (m)
@@ -167,16 +139,15 @@ REAL, DIMENSION(SIZE(PDZG,1)) :: ZINFILTC, ZEXCESS, ZDGN, ZWGTOT, ZPSIWTD,
! ZPSIWTD = matric potential at saturation for water table depth coupling
! ZWTD = water table depth positive below soil surface (m)
!
-REAL, DIMENSION(SIZE(PDZG,1),SIZE(PDZG,2)) :: ZWFLUX, ZDFLUXDT1, ZDFLUXDT2, ZWFLUXN
+REAL, DIMENSION(SIZE(PK%XDZG,1),SIZE(PK%XDZG,2)) :: ZWFLUX, ZDFLUXDT1, ZDFLUXDT2, ZWFLUXN
! ZWFLUX = vertical soil water flux (+ up) (m s-1)
! ZDFLUXDT = total vertical flux derrivative
! ZDFLUXDT1 = vertical flux derrivative: dF_j/dw_j
! ZDFLUXDT2 = vertical flux derrivative: dF_j/dw_j+1
! ZWFLUXN = vertical soil water flux at end of time
-!
-REAL, DIMENSION(SIZE(PDZG,1),SIZE(PDZG,2)) :: ZPSI, ZK, ZNU, ZWSAT, ZHEAD, &
- ZVAPCOND, ZFRZ, ZKI, &
- ZCAPACITY, ZINFNEG
+
+REAL, DIMENSION(SIZE(PK%XDZG,1),SIZE(PK%XDZG,2)) :: ZPSI, ZK, ZNU, ZWSAT, ZHEAD, &
+ ZVAPCOND, ZFRZ, ZKI, ZCAPACITY, ZINFNEG
! ZNU = interfacial total conductivity (m s-1)
! at level z_j
! ZK = hydraulic conductivity (m s-1)
@@ -189,7 +160,7 @@ REAL, DIMENSION(SIZE(PDZG,1),SIZE(PDZG,2)) :: ZPSI, ZK, ZNU, ZWSAT, ZHEAD, &
! wetting front penetration (-)
! ZINFNEG = Negative infiltration (m s-1)
!
-REAL, DIMENSION(SIZE(PDZG,1),SIZE(PDZG,2)) :: ZAMTRX, ZBMTRX, ZCMTRX, ZFRC, ZSOL, &
+REAL, DIMENSION(SIZE(PK%XDZG,1),SIZE(PK%XDZG,2)) :: ZAMTRX, ZBMTRX, ZCMTRX, ZFRC, ZSOL, &
ZTOPQS
! ZAMTRX = leftmost diagonal element of tri-diagonal
! coefficient matrix
@@ -198,7 +169,7 @@ REAL, DIMENSION(SIZE(PDZG,1),SIZE(PDZG,2)) :: ZAMTRX, ZBMTRX, ZCMTRX, ZFRC, ZSOL
! ZFRC = forcing function (vector)
! ZSOL = solution vector
!
-REAL, DIMENSION(SIZE(PDZG,1),SIZE(PDZG,2)) :: ZINFLAYER
+REAL, DIMENSION(SIZE(PK%XDZG,1),SIZE(PK%XDZG,2)) :: ZINFLAYER
!
REAL, PARAMETER :: ZWGHT = 0.5 ! time scheme weight for calculating flux.
! varies from 0 (explicit time scheme)
@@ -224,7 +195,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('HYDRO_SOILDIF',0,ZHOOK_HANDLE)
!
-INI = SIZE(PDZG(:,:),1)
+INJ = SIZE(PK%XDZG,1)
INL = KMAX_LAYER
!
ZLOG10 = LOG(10.0)
@@ -265,35 +236,35 @@ ZCMTRX (:,:) = XUNDEF
! -----------------------------------------------
!
DO JL=1,INL
- DO JJ=1,INI
+ DO JJ=1,INJ
!
- IDEPTH=KWG_LAYER(JJ)
- IF(JL<=IDEPTH)THEN
+ IDEPTH=PK%NWG_LAYER(JJ)
+ IF(JL<=IDEPTH)THEN
!
-! Modify soil porosity as ice assumed to become part
-! of solid soil matrix (with respect to liquid flow):
- ZWSAT (JJ,JL) = MAX(XWGMIN, PWSAT(JJ,JL)-PWGI(JJ,JL))
+! Modify soil porosity as ice assumed to become part
+! of solid soil matrix (with respect to liquid flow):
+ ZWSAT (JJ,JL) = MAX(XWGMIN, KK%XWSAT(JJ,JL)-PEK%XWGI(JJ,JL))
!
-! Factor from (Johnsson and Lundin 1991), except here it is normalized so that it
-! goes to zero in the limit as all available pore space is filled up with ice.
-! For now, a simple constant is used for all soils. Further modifications
-! will be made as research warrents.
-! Old : 10.**(-ZEICE*(PWGI(JJ,JL)/(PWGI(JJ,JL)+PWG(JJ,JL))))
- ZFRZ(JJ,JL) = EXP(ZLOG10*(-ZEICE*(PWGI(JJ,JL)/(PWGI(JJ,JL)+PWG(JJ,JL)))))
+! Factor from (Johnsson and Lundin 1991), except here it is normalized so that it
+! goes to zero in the limit as all available pore space is filled up with ice.
+! For now, a simple constant is used for all soils. Further modifications
+! will be made as research warrents.
+! Old : 10.**(-ZEICE*(PEK%XWGI(JJ,JL)/(PEK%XWGI(JJ,JL)+PEK%XWG(JJ,JL))))
+ ZFRZ(JJ,JL) = EXP(ZLOG10*(-ZEICE*(PEK%XWGI(JJ,JL)/(PEK%XWGI(JJ,JL)+PEK%XWG(JJ,JL)))))
!
- ENDIF
+ ENDIF
!
- ENDDO
+ ENDDO
ENDDO
!
! Lateral sub-surface flow (m s-1) if Topmodel
! --------------------------------------------
!
- IF(HRUNOFF=='SGH')THEN
- ZTOPQS(:,:)=ZFRZ(:,:)*PTOPQS(:,:)
- ELSE
- ZTOPQS(:,:)=0.0
- ENDIF
+IF(IO%CRUNOFF=='SGH')THEN
+ ZTOPQS(:,:)=ZFRZ(:,:)*PK%XTOPQS(:,:)
+ELSE
+ ZTOPQS(:,:)=0.0
+ENDIF
!
! 1. Infiltration at "t"
! -------------------
@@ -305,25 +276,25 @@ ENDDO
!
!Surface cumulative infiltration (m)
ZINFILTC(:) = MAX(0.0,PPG(:))*PTSTEP
+
!
! 2. Initialise soil moisture profile according to infiltration terms at "t"
! ----------------------------------------------------------------------
!
-!
DO JL=1,INL
- DO JJ=1,INI
- IDEPTH=KWG_LAYER(JJ)
- IF(JL<=IDEPTH)THEN
-! Simple volumetric water holding capacity estimate for wetting front penetration
- ZCAPACITY(JJ,JL) = MAX(0.0,ZWSAT(JJ,JL)-PWG(JJ,JL))*PDZG(JJ,JL)
-! Infiltration terms (m) :
- ZINFLAYER(JJ,JL) = MIN(ZINFILTC(JJ),ZCAPACITY(JJ,JL))
-! Soil moisture (m3/m3) :
- PWG (JJ,JL) = PWG(JJ,JL)+ZINFLAYER(JJ,JL)/PDZG(JJ,JL)
-! Put remainding infiltration into the next layer (m)
- ZINFILTC(JJ) = ZINFILTC(JJ) - ZINFLAYER(JJ,JL)
- ENDIF
- ENDDO
+ DO JJ=1,INJ
+ IDEPTH=PK%NWG_LAYER(JJ)
+ IF(JL<=IDEPTH)THEN
+! Simple volumetric water holding capacity estimate for wetting front penetration
+ ZCAPACITY(JJ,JL) = MAX(0.0,ZWSAT(JJ,JL)-PEK%XWG(JJ,JL))*PK%XDZG(JJ,JL)
+! Infiltration terms (m) :
+ ZINFLAYER(JJ,JL) = MIN(ZINFILTC(JJ),ZCAPACITY(JJ,JL))
+! Soil moisture (m3/m3) :
+ PEK%XWG(JJ,JL) = PEK%XWG(JJ,JL)+ZINFLAYER(JJ,JL)/PK%XDZG(JJ,JL)
+! Put remainding infiltration into the next layer (m)
+ ZINFILTC(JJ) = ZINFILTC(JJ) - ZINFLAYER(JJ,JL)
+ ENDIF
+ ENDDO
ENDDO
!
! 3. Compute Fast(temporal)-response runoff and Possible negative infiltration
@@ -332,18 +303,18 @@ ENDDO
!Possible negative infiltration (m s-1)
ZWGTOT(:)=0.0
DO JL=1,INL
- DO JJ=1,INI
- IDEPTH=KWG_LAYER(JJ)
- IF(JL<IDEPTH)THEN
- ZINFNEG(JJ,JL) = (MIN(0.0,PPG(JJ))-PEVAPCOR(JJ))*PDZG(JJ,JL)*PWG(JJ,JL)
- ZWGTOT (JJ ) = ZWGTOT(JJ)+PDZG(JJ,JL)*PWG(JJ,JL)
- ENDIF
- ENDDO
+ DO JJ=1,INJ
+ IDEPTH=PK%NWG_LAYER(JJ)
+ IF(JL<IDEPTH)THEN
+ ZINFNEG(JJ,JL) = (MIN(0.0,PPG(JJ))-PEVAPCOR(JJ))*PK%XDZG(JJ,JL)*PEK%XWG(JJ,JL)
+ ZWGTOT (JJ ) = ZWGTOT(JJ)+PK%XDZG(JJ,JL)*PEK%XWG(JJ,JL)
+ ENDIF
+ ENDDO
ENDDO
DO JL=1,INL
- DO JJ=1,INI
- ZINFNEG(JJ,JL) = ZINFNEG(JJ,JL)/ZWGTOT(JJ)
- ENDDO
+ DO JJ=1,INJ
+ ZINFNEG(JJ,JL) = ZINFNEG(JJ,JL)/ZWGTOT(JJ)
+ ENDDO
ENDDO
!
!Fast(temporal)-response runoff (surface excess) (kg m2 s-1):
@@ -355,44 +326,45 @@ PHORTON(:)=(PHORTON(:)+ZINFILTC(:)/PTSTEP)*XRHOLW
! -------------------------------------------------------------
!
DO JL=1,INL
- DO JJ=1,INI
- IDEPTH=KWG_LAYER(JJ)
- IF(JL<=IDEPTH)THEN
-! Matric potential (m) :
-! psi=mpotsat*(w/wsat)**(-bcoef)
- ZS = MIN(1.0,PWG(JJ,JL)/ZWSAT(JJ,JL))
- ZLOG = PBCOEF(JJ,JL)*LOG(ZS)
- ZPSI(JJ,JL) = PMPOTSAT(JJ,JL)*EXP(-ZLOG)
-! Hydraulic conductivity from matric potential (m s-1):
-! k=frz*condsat*(psi/mpotsat)**(-2-3/bcoef)
- ZLOG = -ZLOG*(2.0+3.0/PBCOEF(JJ,JL))
- ZK(JJ,JL) = ZFRZ(JJ,JL)*PCONDSAT(JJ,JL)*EXP(-ZLOG)
- ENDIF
- ENDDO
+ DO JJ=1,INJ
+ IDEPTH=PK%NWG_LAYER(JJ)
+ IF(JL<=IDEPTH)THEN
+! Matric potential (m) :
+! psi=mpotsat*(w/wsat)**(-bcoef)
+ ZS = MIN(1.0,PEK%XWG(JJ,JL)/ZWSAT(JJ,JL))
+ ZLOG = KK%XBCOEF(JJ,JL)*LOG(ZS)
+ ZPSI(JJ,JL) = KK%XMPOTSAT(JJ,JL)*EXP(-ZLOG)
+! Hydraulic conductivity from matric potential (m s-1):
+! k=frz*condsat*(psi/mpotsat)**(-2-3/bcoef)
+ ZLOG = -ZLOG*(2.0+3.0/KK%XBCOEF(JJ,JL))
+ ZK(JJ,JL) = ZFRZ(JJ,JL)*PK%XCONDSAT(JJ,JL)*EXP(-ZLOG)
+ ENDIF
+ ENDDO
ENDDO
!
! Prepare water table depth coupling
! ----------------------------------
!
-DO JJ=1,INI
- IDEPTH=KWG_LAYER(JJ)
-! Depth of the last node
- ZDGN (JJ) = 0.5*(PDG(JJ,IDEPTH)+PDG(JJ,IDEPTH-1))
- ZPSIWTD(JJ) = ZPSI(JJ,IDEPTH)
- IF(PWTD(JJ)/=XUNDEF)THEN
-! Water table depth
- ZWTD(JJ) = MAX(PDG(JJ,IDEPTH),-PWTD(JJ))
-! Modify matric potential at saturation for water table coupling
- ZS = MIN(1.0,ZWSAT(JJ,IDEPTH)/PWSAT(JJ,IDEPTH))
- ZLOG = PBCOEF(JJ,IDEPTH)*LOG(ZS)
- ZPSIWTD(JJ) = PMPOTSAT(JJ,IDEPTH)*EXP(-ZLOG)
- ENDIF
+DO JJ=1,INJ
+ IDEPTH=PK%NWG_LAYER(JJ)
+! Depth of the last node
+ ZDGN (JJ) = 0.5*(PK%XDG(JJ,IDEPTH)+PK%XDG(JJ,IDEPTH-1))
+ ZPSIWTD(JJ) = ZPSI(JJ,IDEPTH)
+ IF(KK%XWTD(JJ)/=XUNDEF)THEN
+! Water table depth
+ ZWTD(JJ) = MAX(PK%XDG(JJ,IDEPTH),-KK%XWTD(JJ))
+! Modify matric potential at saturation for water table coupling
+ ZS = MIN(1.0,ZWSAT(JJ,IDEPTH)/KK%XWSAT(JJ,IDEPTH))
+ ZLOG = KK%XBCOEF(JJ,IDEPTH)*LOG(ZS)
+ ZPSIWTD(JJ) = KK%XMPOTSAT(JJ,IDEPTH)*EXP(-ZLOG)
+ ENDIF
ENDDO
!
! 5. Vapor diffusion conductivity (m s-1)
! ------------------------------------
!
-ZVAPCOND(:,:) = VAPCONDCF(PTG,PPS,PWG,PWGI,ZPSI,PWSAT,PWFC,PQSAT,PQSATI,KWG_LAYER,INL)
+ZVAPCOND(:,:) = VAPCONDCF(PEK%XTG, PPS, PEK%XWG, PEK%XWGI, ZPSI,&
+ KK%XWSAT, KK%XWFC, PQSAT, PQSATI, PK%NWG_LAYER, INL)
ZVAPCOND(:,:) = ZFRZ(:,:)*ZVAPCOND(:,:)
!
! 6. Linearized water flux: values at "t"
@@ -400,34 +372,34 @@ ZVAPCOND(:,:) = ZFRZ(:,:)*ZVAPCOND(:,:)
! calculate flux at the beginning of the time step:
!
DO JL=1,INL
- DO JJ=1,INI
+ DO JJ=1,INJ
!
- IDEPTH=KWG_LAYER(JJ)
- IF(JL<IDEPTH)THEN
+ IDEPTH=PK%NWG_LAYER(JJ)
+ IF(JL<IDEPTH)THEN
!
-! Total interfacial conductivity (m s-1) And Potential gradient (dimensionless):
- ZKI (JJ,JL) = SQRT(ZK(JJ,JL)*ZK(JJ,JL+1))
- ZNU (JJ,JL) = ZKI(JJ,JL) + SQRT(ZVAPCOND(JJ,JL)*ZVAPCOND(JJ,JL+1))
- ZHEAD(JJ,JL) = (ZPSI(JJ,JL)-ZPSI(JJ,JL+1))/PDZDIF(JJ,JL)
+! Total interfacial conductivity (m s-1) And Potential gradient (dimensionless):
+ ZKI (JJ,JL) = SQRT(ZK(JJ,JL)*ZK(JJ,JL+1))
+ ZNU (JJ,JL) = ZKI(JJ,JL) + SQRT(ZVAPCOND(JJ,JL)*ZVAPCOND(JJ,JL+1))
+ ZHEAD(JJ,JL) = (ZPSI(JJ,JL)-ZPSI(JJ,JL+1))/PK%XDZDIF(JJ,JL)
!
-! Total Sub-surface soil water fluxes (m s-1): (+ up, - down) using Darcy's
-! Law with an added linear drainage term:
- ZWFLUX(JJ,JL) = -ZNU(JJ,JL) * ZHEAD(JJ,JL) - ZKI(JJ,JL)
+! Total Sub-surface soil water fluxes (m s-1): (+ up, - down) using Darcy's
+! Law with an added linear drainage term:
+ ZWFLUX(JJ,JL) = -ZNU(JJ,JL) * ZHEAD(JJ,JL) - ZKI(JJ,JL)
!
- ELSEIF(JL==IDEPTH)THEN !Last layers
+ ELSEIF(JL==IDEPTH)THEN !Last layers
!
-! Total interfacial conductivity (m s-1) And Potential gradient (dimensionless):
- ZKI (JJ,IDEPTH) = ZK(JJ,IDEPTH)
- ZNU (JJ,IDEPTH) = ZK(JJ,IDEPTH) * PFWTD(JJ)
- ZHEAD(JJ,IDEPTH) = (ZPSI(JJ,IDEPTH)-ZPSIWTD(JJ))/(ZWTD(JJ)-ZDGN(JJ))
+! Total interfacial conductivity (m s-1) And Potential gradient (dimensionless):
+ ZKI (JJ,IDEPTH) = ZK(JJ,IDEPTH)
+ ZNU (JJ,IDEPTH) = ZK(JJ,IDEPTH) * KK%XFWTD(JJ)
+ ZHEAD(JJ,IDEPTH) = (ZPSI(JJ,IDEPTH)-ZPSIWTD(JJ))/(ZWTD(JJ)-ZDGN(JJ))
!
-! Total Sub-surface soil water fluxes (m s-1): (+ up, - down) using Darcy's
-! Law with an added linear drainage term:
- ZWFLUX(JJ,IDEPTH) = -ZNU(JJ,IDEPTH) * ZHEAD(JJ,IDEPTH) - ZKI(JJ,IDEPTH)
+! Total Sub-surface soil water fluxes (m s-1): (+ up, - down) using Darcy's
+! Law with an added linear drainage term:
+ ZWFLUX(JJ,IDEPTH) = -ZNU(JJ,IDEPTH) * ZHEAD(JJ,IDEPTH) - ZKI(JJ,IDEPTH)
!
- ENDIF
+ ENDIF
!
- ENDDO
+ ENDDO
ENDDO
!
!
@@ -436,27 +408,27 @@ ENDDO
! Flux Derrivative terms, see A. Boone thesis (Annexe E).
!
DO JL=1,INL
- DO JJ=1,INI
- IDEPTH=KWG_LAYER(JJ)
- IF(JL<IDEPTH)THEN
- ZDHEADDT1 = -PBCOEF(JJ,JL )*ZPSI(JJ,JL )/(PWG(JJ,JL )*PDZDIF(JJ,JL))
- ZDHEADDT2 = -PBCOEF(JJ,JL+1)*ZPSI(JJ,JL+1)/(PWG(JJ,JL+1)*PDZDIF(JJ,JL))
- ZDKDT1 = (2.*PBCOEF(JJ,JL )+3.)*ZKI(JJ,JL)/(2.0*PWG(JJ,JL ))
- ZDKDT2 = (2.*PBCOEF(JJ,JL+1)+3.)*ZKI(JJ,JL)/(2.0*PWG(JJ,JL+1))
-! Total Flux derrivative terms:
- ZDFLUXDT1(JJ,JL) = -ZDKDT1*ZHEAD(JJ,JL) - ZNU(JJ,JL)*ZDHEADDT1 - ZDKDT1
- ZDFLUXDT2(JJ,JL) = -ZDKDT2*ZHEAD(JJ,JL) + ZNU(JJ,JL)*ZDHEADDT2 - ZDKDT2
- ELSEIF(JL==IDEPTH)THEN !Last layers
- ZDHEADDT1 = -PBCOEF(JJ,IDEPTH)*ZPSI (JJ,IDEPTH)/(PWG (JJ,IDEPTH)*(ZWTD(JJ)-ZDGN(JJ))) &
- +PBCOEF(JJ,IDEPTH)*ZPSIWTD(JJ )/(ZWSAT(JJ,IDEPTH)*(ZWTD(JJ)-ZDGN(JJ)))
- ZDHEADDT2 = 0.0
- ZDKDT1 = (2.*PBCOEF(JJ,IDEPTH)+3.)*ZK(JJ,IDEPTH)/PWG(JJ,IDEPTH)
- ZDKDT2 = 0.0
-! Total Flux derrivative terms:
- ZDFLUXDT1(JJ,IDEPTH) = -ZDKDT1*ZHEAD(JJ,IDEPTH)*PFWTD(JJ) - ZNU(JJ,IDEPTH)*ZDHEADDT1 - ZDKDT1
- ZDFLUXDT2(JJ,IDEPTH) = -ZDKDT2*ZHEAD(JJ,IDEPTH)*PFWTD(JJ) + ZNU(JJ,IDEPTH)*ZDHEADDT2 - ZDKDT2
- ENDIF
- ENDDO
+ DO JJ=1,INJ
+ IDEPTH=PK%NWG_LAYER(JJ)
+ IF(JL<IDEPTH)THEN
+ ZDHEADDT1 = -KK%XBCOEF(JJ,JL )*ZPSI(JJ,JL )/(PEK%XWG(JJ,JL )*PK%XDZDIF(JJ,JL))
+ ZDHEADDT2 = -KK%XBCOEF(JJ,JL+1)*ZPSI(JJ,JL+1)/(PEK%XWG(JJ,JL+1)*PK%XDZDIF(JJ,JL))
+ ZDKDT1 = (2.*KK%XBCOEF(JJ,JL )+3.)*ZKI(JJ,JL)/(2.0*PEK%XWG(JJ,JL ))
+ ZDKDT2 = (2.*KK%XBCOEF(JJ,JL+1)+3.)*ZKI(JJ,JL)/(2.0*PEK%XWG(JJ,JL+1))
+! Total Flux derrivative terms:
+ ZDFLUXDT1(JJ,JL) = -ZDKDT1*ZHEAD(JJ,JL) - ZNU(JJ,JL)*ZDHEADDT1 - ZDKDT1
+ ZDFLUXDT2(JJ,JL) = -ZDKDT2*ZHEAD(JJ,JL) + ZNU(JJ,JL)*ZDHEADDT2 - ZDKDT2
+ ELSEIF(JL==IDEPTH)THEN !Last layers
+ ZDHEADDT1 = -KK%XBCOEF(JJ,IDEPTH)*ZPSI (JJ,IDEPTH)/(PEK%XWG (JJ,IDEPTH)*(ZWTD(JJ)-ZDGN(JJ))) &
+ +KK%XBCOEF(JJ,IDEPTH)*ZPSIWTD(JJ )/(ZWSAT(JJ,IDEPTH) *(ZWTD(JJ)-ZDGN(JJ)))
+ ZDHEADDT2 = 0.0
+ ZDKDT1 = (2.*KK%XBCOEF(JJ,IDEPTH)+3.)*ZK(JJ,IDEPTH)/PEK%XWG(JJ,IDEPTH)
+ ZDKDT2 = 0.0
+! Total Flux derrivative terms:
+ ZDFLUXDT1(JJ,IDEPTH) = -ZDKDT1*ZHEAD(JJ,IDEPTH)*KK%XFWTD(JJ) - ZNU(JJ,IDEPTH)*ZDHEADDT1 - ZDKDT1
+ ZDFLUXDT2(JJ,IDEPTH) = -ZDKDT2*ZHEAD(JJ,IDEPTH)*KK%XFWTD(JJ) + ZNU(JJ,IDEPTH)*ZDHEADDT2 - ZDKDT2
+ ENDIF
+ ENDDO
ENDDO
!
! 8. Jacobian Matrix coefficients and Forcing function
@@ -465,99 +437,99 @@ ENDDO
!surface layer:
ZFRC (:,1) = ZWFLUX(:,1) - PLEG(:) - PF2WGHT(:,1)*PLETR(:) + ZINFNEG(:,1) - ZTOPQS(:,1)
ZAMTRX(:,1) = 0.0
-ZBMTRX(:,1) = (PDZG(:,1)/PTSTEP) - ZWGHT*ZDFLUXDT1(:,1)
+ZBMTRX(:,1) = (PK%XDZG(:,1)/PTSTEP) - ZWGHT*ZDFLUXDT1(:,1)
ZCMTRX(:,1) = -ZWGHT*ZDFLUXDT2(:,1)
!
!Other sub-surface layers:
DO JL=2,INL
- DO JJ=1,INI
- IDEPTH=KWG_LAYER(JJ)
- IF(JL<=IDEPTH)THEN
- ZFRC (JJ,JL) = ZWFLUX (JJ,JL) - ZWFLUX(JJ,JL-1) - PF2WGHT(JJ,JL)*PLETR(JJ) + ZINFNEG(JJ,JL) - ZTOPQS(JJ,JL)
- ZAMTRX(JJ,JL) = ZWGHT*ZDFLUXDT1(JJ,JL-1)
- ZBMTRX(JJ,JL) = (PDZG(JJ,JL)/PTSTEP) - ZWGHT*(ZDFLUXDT1(JJ,JL)-ZDFLUXDT2(JJ,JL-1))
- ZCMTRX(JJ,JL) = -ZWGHT*ZDFLUXDT2(JJ,JL)
- ENDIF
- ENDDO
+ DO JJ=1,INJ
+ IDEPTH=PK%NWG_LAYER(JJ)
+ IF(JL<=IDEPTH)THEN
+ ZFRC (JJ,JL) = ZWFLUX (JJ,JL) - ZWFLUX(JJ,JL-1) - PF2WGHT(JJ,JL)*PLETR(JJ) + ZINFNEG(JJ,JL) - ZTOPQS(JJ,JL)
+ ZAMTRX(JJ,JL) = ZWGHT*ZDFLUXDT1(JJ,JL-1)
+ ZBMTRX(JJ,JL) = (PK%XDZG(JJ,JL)/PTSTEP) - ZWGHT*(ZDFLUXDT1(JJ,JL)-ZDFLUXDT2(JJ,JL-1))
+ ZCMTRX(JJ,JL) = -ZWGHT*ZDFLUXDT2(JJ,JL)
+ ENDIF
+ ENDDO
ENDDO
!
!Solve Matrix Equation: tridiagonal system: solve for soil
!water (volumetric water content) tendencies:
!
- CALL TRIDIAG_DIF(ZAMTRX,ZBMTRX,ZCMTRX,ZFRC,KWG_LAYER,INL,ZSOL)
+CALL TRIDIAG_DIF(ZAMTRX,ZBMTRX,ZCMTRX,ZFRC,PK%NWG_LAYER(:),INL,ZSOL)
!
! 9. Final calculations and diagnostics:
! -----------------------------------
!
!
DO JL=1,INL
- DO JJ=1,INI
+ DO JJ=1,INJ
!
- IDEPTH=KWG_LAYER(JJ)
- IF(JL<IDEPTH)THEN
+ IDEPTH=PK%NWG_LAYER(JJ)
+ IF(JL<IDEPTH)THEN
!
-! Update liquid water content (m3 m-3):
- PWG(JJ,JL) = PWG(JJ,JL) + ZSOL(JJ,JL)
+! Update liquid water content (m3 m-3):
+ PEK%XWG(JJ,JL) = PEK%XWG(JJ,JL) + ZSOL(JJ,JL)
!
-! Supersaturated drainage (kg m-2 s-1):
- ZEXCESS(JJ) = MAX(0.0, PWG(JJ,JL) - ZWSAT(JJ,JL))
- PWG(JJ,JL ) = MIN(PWG(JJ,JL),ZWSAT(JJ,JL))
- PWG(JJ,JL+1) = PWG(JJ,JL+1) + ZEXCESS(JJ)*(PDZG(JJ,JL)/PDZG(JJ,JL+1))
+! Supersaturated drainage (kg m-2 s-1):
+ ZEXCESS(JJ) = MAX(0.0, PEK%XWG(JJ,JL) - ZWSAT(JJ,JL))
+ PEK%XWG(JJ,JL ) = MIN(PEK%XWG(JJ,JL),ZWSAT(JJ,JL))
+ PEK%XWG(JJ,JL+1) = PEK%XWG(JJ,JL+1) + ZEXCESS(JJ)*(PK%XDZG(JJ,JL)/PK%XDZG(JJ,JL+1))
!
-! final fluxes (at end of time step) (m s-1):
- ZWFLUXN(JJ,JL) = ZWFLUX(JJ,JL) + ZDFLUXDT1(JJ,JL)*ZSOL(JJ,JL) + ZDFLUXDT2(JJ,JL)*ZSOL(JJ,JL+1)
+! final fluxes (at end of time step) (m s-1):
+ ZWFLUXN(JJ,JL) = ZWFLUX(JJ,JL) + ZDFLUXDT1(JJ,JL)*ZSOL(JJ,JL) + ZDFLUXDT2(JJ,JL)*ZSOL(JJ,JL+1)
!
-! Total topmodel subsurface flow
- PQSB (JJ) = PQSB(JJ) + ZTOPQS(JJ,JL)*XRHOLW
+! Total topmodel subsurface flow
+ PQSB (JJ) = PQSB(JJ) + ZTOPQS(JJ,JL)*XRHOLW
!
- ELSEIF(JL==IDEPTH)THEN
+ ELSEIF(JL==IDEPTH)THEN
!
-! Update liquid water content (m3 m-3):
- PWG(JJ,IDEPTH) = PWG(JJ,IDEPTH) + ZSOL(JJ,IDEPTH)
+! Update liquid water content (m3 m-3):
+ PEK%XWG(JJ,IDEPTH) = PEK%XWG(JJ,IDEPTH) + ZSOL(JJ,IDEPTH)
!
-! Supersaturated drainage (kg m-2 s-1):
- ZEXCESS(JJ) = MAX(0.0, PWG(JJ,IDEPTH) - ZWSAT(JJ,IDEPTH))
- PWG(JJ,IDEPTH) = MIN(PWG(JJ,IDEPTH),ZWSAT(JJ,IDEPTH))
- PDRAIN (JJ) = PDRAIN(JJ) + ZEXCESS(JJ)*PDZG(JJ,IDEPTH)*XRHOLW/PTSTEP
+! Supersaturated drainage (kg m-2 s-1):
+ ZEXCESS(JJ) = MAX(0.0, PEK%XWG(JJ,IDEPTH) - ZWSAT(JJ,IDEPTH))
+ PEK%XWG(JJ,IDEPTH) = MIN(PEK%XWG(JJ,IDEPTH),ZWSAT(JJ,IDEPTH))
+ PDRAIN (JJ) = PDRAIN(JJ) + ZEXCESS(JJ)*PK%XDZG(JJ,IDEPTH)*XRHOLW/PTSTEP
!
-! final fluxes (at end of time step) (m s-1):
- ZWFLUXN(JJ,IDEPTH) = ZWFLUX(JJ,IDEPTH) + ZDFLUXDT1(JJ,IDEPTH)*ZSOL(JJ,IDEPTH)
+! final fluxes (at end of time step) (m s-1):
+ ZWFLUXN(JJ,IDEPTH) = ZWFLUX(JJ,IDEPTH) + ZDFLUXDT1(JJ,IDEPTH)*ZSOL(JJ,IDEPTH)
!
-! Drainage or baseflow out of bottom of model (slow time response) (kg m-2 s-1):
-! Final fluxes (if needed) over the time step (kg m-2 s-1)
-! would be calculated as (for water budget checks) as F = [ wgt*F(t+dt) + (1.-wgt)*F(t) ]*XRHOLW
- PDRAIN (JJ) = PDRAIN(JJ)-(ZWGHT*ZWFLUXN(JJ,IDEPTH)+(1.-ZWGHT)*ZWFLUX(JJ,IDEPTH))*XRHOLW
+! Drainage or baseflow out of bottom of model (slow time response) (kg m-2 s-1):
+! Final fluxes (if needed) over the time step (kg m-2 s-1)
+! would be calculated as (for water budget checks) as F = [ wgt*F(t+dt) + (1.-wgt)*F(t) ]*XRHOLW
+ PDRAIN (JJ) = PDRAIN(JJ)-(ZWGHT*ZWFLUXN(JJ,IDEPTH)+(1.-ZWGHT)*ZWFLUX(JJ,IDEPTH))*XRHOLW
!
-! Total topmodel subsurface flow
- PQSB (JJ) = PQSB(JJ) + ZTOPQS(JJ,IDEPTH)*XRHOLW
+! Total topmodel subsurface flow
+ PQSB (JJ) = PQSB(JJ) + ZTOPQS(JJ,IDEPTH)*XRHOLW
!
- ENDIF
+ ENDIF
!
- ENDDO
+ ENDDO
ENDDO
!
! Possible correction/Constraint application:
!
DO JL=1,INL
- DO JJ=1,INI
- IDEPTH=KWG_LAYER(JJ)
- IF(JL<IDEPTH)THEN
-! if the soil water happens to fall below the minimum, then
-! extract needed water from the layer below: this should
-! generally be non-existant: but added to ensure conservation
-! even for the most extreme events.
- ZEXCESS(JJ) = MAX(0., XWGMIN - PWG(JJ,JL))
- PWG(JJ,JL) = PWG(JJ,JL) + ZEXCESS(JJ)
- PWG(JJ,JL+1) = PWG(JJ,JL+1) - ZEXCESS(JJ)*PDZG(JJ,JL)/PDZG(JJ,JL+1)
- ELSEIF(JL==IDEPTH.AND.PWG(JJ,IDEPTH)<XWGMIN)THEN
-! NOTE, negative moisture can arise for *completely* dry/dessicated soils
-! owing to the above check because vertical fluxes
-! can be *very* small but nonzero. Here correct owing to
-! small numerical drainage.
- PDRAIN(JJ) = PDRAIN(JJ) + MIN(0.0,PWG(JJ,IDEPTH)-XWGMIN)*PDZG(JJ,IDEPTH)*XRHOLW/PTSTEP
- PWG(JJ,IDEPTH) = XWGMIN
- ENDIF
- ENDDO
+ DO JJ=1,INJ
+ IDEPTH=PK%NWG_LAYER(JJ)
+ IF(JL<IDEPTH)THEN
+! if the soil water happens to fall below the minimum, then
+! extract needed water from the layer below: this should
+! generally be non-existant: but added to ensure conservation
+! even for the most extreme events.
+ ZEXCESS(JJ) = MAX(0., XWGMIN - PEK%XWG(JJ,JL))
+ PEK%XWG(JJ,JL) = PEK%XWG(JJ,JL) + ZEXCESS(JJ)
+ PEK%XWG(JJ,JL+1) = PEK%XWG(JJ,JL+1) - ZEXCESS(JJ)*PK%XDZG(JJ,JL)/PK%XDZG(JJ,JL+1)
+ ELSEIF(JL==IDEPTH.AND.PEK%XWG(JJ,IDEPTH)<XWGMIN)THEN
+! NOTE, negative moisture can arise for *completely* dry/dessicated soils
+! owing to the above check because vertical fluxes
+! can be *very* small but nonzero. Here correct owing to
+! small numerical drainage.
+ PDRAIN(JJ) = PDRAIN(JJ) + MIN(0.0,PEK%XWG(JJ,IDEPTH)-XWGMIN)*PK%XDZG(JJ,IDEPTH)*XRHOLW/PTSTEP
+ PEK%XWG(JJ,IDEPTH) = XWGMIN
+ ENDIF
+ ENDDO
ENDDO
!
IF (LHOOK) CALL DR_HOOK('HYDRO_SOILDIF',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/ice_soildif.F90 b/src/SURFEX/ice_soildif.F90
index a142b0bc1fc5d3e1f592b770738e019de5227685..2d3e2bdef90fcc10cce204ed085926cda6800c3c 100644
--- a/src/SURFEX/ice_soildif.F90
+++ b/src/SURFEX/ice_soildif.F90
@@ -3,10 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE ICE_SOILDIF(PTSTEP, PTAUICE, PKSFC_IVEG, PLEGI, &
- PSOILHCAPZ, PWSATZ, PMPOTSATZ, PBCOEFZ, &
- PTG, PWGI, PWG, KWG_LAYER, &
- PDZG, PWGI_EXCESS )
+ SUBROUTINE ICE_SOILDIF(KK, PK, PEK, PTSTEP, PKSFC_IVEG, PLEGI, PSOILHCAPZ, PWGI_EXCESS)
! ##########################################################################
!
!!**** *ICE_SOILDIF*
@@ -50,7 +47,7 @@
!!
!! MODIFICATIONS
!! -------------
-!! Original 28/02/00 Boone
+!! Original 28/02/00 Boonei
!! Modified 24/11/09 Boone
!! Limit energy available for phase change by
! local amount owing to diffusion. Has almost
@@ -77,6 +74,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+!
USE MODD_CSTS, ONLY : XLMTT, XTT, XG, XCI, XRHOLI, XRHOLW
USE MODD_ISBA_PAR, ONLY : XWGMIN
!
@@ -87,32 +86,19 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
REAL, INTENT(IN) :: PTSTEP ! Model time step (s)
!
-REAL, DIMENSION(:), INTENT(IN) :: PTAUICE, PKSFC_IVEG, PLEGI
+REAL, DIMENSION(:), INTENT(IN) :: PKSFC_IVEG, PLEGI
! PKSFC_IVEG = effect of surface layer insolation on phase changes
! Giard and Bazile (2000): non-dimensional
-! PTAUICE = soil phase change characteristic time scale (s)
! PLEGI = ice sublimation (m s-1)
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSOILHCAPZ, PWSATZ
+REAL, DIMENSION(:,:), INTENT(IN) :: PSOILHCAPZ
! PSOILHCAPZ = soil heat capacity [J/(m3 K)]
-! PWSATZ = soil porosity (m3/m3)
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZG
-! PDZG = Layer thickness (DIF option)
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PMPOTSATZ, PBCOEFZ
-! PMPOTSATZ = matric potential at saturation (m)
-! PBCOEFZ = slope of the water retention curve (-)
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTG, PWGI, PWG
-! PTG = soil temperature (K)
-! PWGI = soil volumetric ice content (m3/m3)
-! PWGI = soil volumetric liquid water content (m3/m3)
-!
-INTEGER, DIMENSION(:), INTENT(IN) :: KWG_LAYER
-! KWG_LAYER = Number of soil moisture layers (DIF option)
!
REAL, DIMENSION(:), INTENT(OUT) :: PWGI_EXCESS
! PWGI_EXCESS = Soil ice excess water content
@@ -125,9 +111,9 @@ INTEGER :: INI ! Number of point
INTEGER :: INL ! Number of explicit soil layers
INTEGER :: IDEPTH ! Total moisture soil depth
!
-REAL, DIMENSION(SIZE(PTG,1),SIZE(PTG,2)) :: ZK, ZEXCESSFC
+REAL, DIMENSION(SIZE(PEK%XTG,1),SIZE(PEK%XTG,2)) :: ZK, ZEXCESSFC
!
-REAL, DIMENSION(SIZE(PTG,1)) :: ZEXCESS
+REAL, DIMENSION(SIZE(PEK%XTG,1)) :: ZEXCESS
!
REAL :: ZWGMAX, ZPSIMAX, ZPSI, ZDELTAT, &
ZPHASE, ZTGM, ZWGM, ZWGIM, ZLOG, &
@@ -142,8 +128,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('ICE_SOILDIF',0,ZHOOK_HANDLE)
!
-INI = SIZE(PTG(:,:),1)
-INL = MAXVAL(KWG_LAYER(:))
+INI = SIZE(PEK%XTG,1)
+INL = MAXVAL(PK%NWG_LAYER)
!
ZEXCESSFC (:,:)=0.0
ZEXCESS (: )=0.0
@@ -162,32 +148,32 @@ ZK(:,1) = PKSFC_IVEG(:)
!
DO JL=1,INL
DO JJ=1,INI
- IDEPTH=KWG_LAYER(JJ)
+ IDEPTH=PK%NWG_LAYER(JJ)
IF(JL<=IDEPTH)THEN
!
- ZWGIM = PWGI(JJ,JL)
- ZWGM = PWG(JJ,JL)
- ZTGM = PTG(JJ,JL)
+ ZWGIM = PEK%XWGI(JJ,JL)
+ ZWGM = PEK%XWG (JJ,JL)
+ ZTGM = PEK%XTG (JJ,JL)
! The maximum liquid water content as
! as function of temperature (sub-freezing)
! based on Gibbs free energy (Fuchs et al., 1978):
!
- ZPSIMAX = MIN(PMPOTSATZ(JJ,JL),XLMTT*(PTG(JJ,JL)-XTT)/(XG*PTG(JJ,JL)))
+ ZPSIMAX = MIN(KK%XMPOTSAT(JJ,JL),XLMTT*(PEK%XTG(JJ,JL)-XTT)/(XG*PEK%XTG(JJ,JL)))
!
- ZWORK = ZPSIMAX/PMPOTSATZ(JJ,JL)
- ZLOG = LOG(ZWORK)/PBCOEFZ(JJ,JL)
- ZWGMAX = PWSATZ(JJ,JL)*EXP(-ZLOG)
+ ZWORK = ZPSIMAX/KK%XMPOTSAT(JJ,JL)
+ ZLOG = LOG(ZWORK)/KK%XBCOEF(JJ,JL)
+ ZWGMAX = KK%XWSAT(JJ,JL)*EXP(-ZLOG)
!
! Calculate maximum temperature for ice based on Gibbs free energy: first
! compute soil water potential using Brook and Corey (1966) model:
! psi=mpotsat*(w/wsat)**(-bcoef)
!
- ZWORK = PWG(JJ,JL)/PWSATZ(JJ,JL)
- ZLOG = PBCOEFZ(JJ,JL)*LOG(ZWORK)
- ZPSI = PMPOTSATZ(JJ,JL)*EXP(-ZLOG)
+ ZWORK = PEK%XWG(JJ,JL)/KK%XWSAT(JJ,JL)
+ ZLOG = KK%XBCOEF(JJ,JL)*LOG(ZWORK)
+ ZPSI = KK%XMPOTSAT(JJ,JL)*EXP(-ZLOG)
!
- ZDELTAT = PTG(JJ,JL) - XLMTT*XTT/(XLMTT-XG*ZPSI)
+ ZDELTAT = PEK%XTG(JJ,JL) - XLMTT*XTT/(XLMTT-XG*ZPSI)
!
! Compute apparent heat capacity. This is considered
! only when there is available energy (cold) and liquid water
@@ -201,24 +187,24 @@ DO JL=1,INL
!
ZAPPHEATCAP=0.0
IF(ZDELTAT<0.0.AND.ZWGM>=ZWGMAX.AND.ZWORK>=MAX(0.0,ZWGM-ZWGMAX))THEN
- ZAPPHEATCAP = -(XTT*XRHOLW*XLMTT*XLMTT/XG)*ZWGMAX/(ZPSIMAX*PBCOEFZ(JJ,JL)*ZTGM*ZTGM)
+ ZAPPHEATCAP = -(XTT*XRHOLW*XLMTT*XLMTT/XG)*ZWGMAX/(ZPSIMAX*KK%XBCOEF(JJ,JL)*ZTGM*ZTGM)
ENDIF
!
! *Melt* ice if energy and ice available:
- ZPHASEM = (PTSTEP/PTAUICE(JJ))*MIN(ZK(JJ,JL)*XCI*XRHOLI*MAX(0.0,ZDELTAT),ZWGIM*XLMTT*XRHOLW)
+ ZPHASEM = (PTSTEP/PK%XTAUICE(JJ))*MIN(ZK(JJ,JL)*XCI*XRHOLI*MAX(0.0,ZDELTAT),ZWGIM*XLMTT*XRHOLW)
!
! *Freeze* liquid water if energy and water available:
- ZPHASEF = (PTSTEP/PTAUICE(JJ))*MIN(ZK(JJ,JL)*XCI*XRHOLI*MAX(0.0,-ZDELTAT),MAX(0.0,ZWGM-ZWGMAX)*XLMTT*XRHOLW)
+ ZPHASEF = (PTSTEP/PK%XTAUICE(JJ))*MIN(ZK(JJ,JL)*XCI*XRHOLI*MAX(0.0,-ZDELTAT),MAX(0.0,ZWGM-ZWGMAX)*XLMTT*XRHOLW)
!
! Update heat content if melting or freezing
- PTG(JJ,JL) = ZTGM + (ZPHASEF - ZPHASEM)/(PSOILHCAPZ(JJ,JL)+ZAPPHEATCAP)
+ PEK%XTG(JJ,JL) = ZTGM + (ZPHASEF - ZPHASEM)/(PSOILHCAPZ(JJ,JL)+ZAPPHEATCAP)
!
! Get estimate of actual total phase change (J/m3) for equivalent soil water changes:
- ZPHASE = (PSOILHCAPZ(JJ,JL)+ZAPPHEATCAP)*(PTG(JJ,JL)-ZTGM)
+ ZPHASE = (PSOILHCAPZ(JJ,JL)+ZAPPHEATCAP)*(PEK%XTG(JJ,JL)-ZTGM)
!
! Adjust ice and liquid water conents (m3/m3) accordingly :
- PWGI(JJ,JL) = ZWGIM + ZPHASE/(XLMTT*XRHOLW)
- PWG (JJ,JL) = ZWGM - ZPHASE/(XLMTT*XRHOLW)
+ PEK%XWGI(JJ,JL) = ZWGIM + ZPHASE/(XLMTT*XRHOLW)
+ PEK%XWG(JJ,JL) = ZWGM - ZPHASE/(XLMTT*XRHOLW)
!
ENDIF
ENDDO
@@ -227,7 +213,7 @@ ENDDO
! 3. Adjust surface soil ice content for sublimation
! -----------------------------------------------
!
-PWGI(:,1) = PWGI(:,1) - PLEGI(:)*PTSTEP/PDZG(:,1)
+PEK%XWGI(:,1) = PEK%XWGI(:,1) - PLEGI(:)*PTSTEP/PK%XDZG(:,1)
!
! The remaining code in this block are merely constraints to ensure a highly
! accurate water budget: most of the time this code will not have any
@@ -236,10 +222,10 @@ PWGI(:,1) = PWGI(:,1) - PLEGI(:)*PTSTEP/PDZG(:,1)
! some of the liquid (a correction): NOTE that latent heating already accounted
! for in sublimation term, so no need to alter soil temperature.
!
-ZEXCESS(:) = MAX(0.0, - PWGI(:,1))
-PWG (:,1) = PWG (:,1) - ZEXCESS(:)
-PWGI(:,1) = PWGI(:,1) + ZEXCESS(:)
-ZEXCESSFC(:,1)= ZEXCESSFC(:,1) - ZEXCESS(:)
+ZEXCESS(:) = MAX(0.0, - PEK%XWGI(:,1))
+PEK%XWG(:,1) = PEK%XWG (:,1) - ZEXCESS(:)
+PEK%XWGI(:,1) = PEK%XWGI (:,1) + ZEXCESS(:)
+ZEXCESSFC(:,1) = ZEXCESSFC(:,1) - ZEXCESS(:)
!
! 4. Prevent some possible problems
! ------------------------------
@@ -252,16 +238,16 @@ ZEXCESSFC(:,1)= ZEXCESSFC(:,1) - ZEXCESS(:)
!
DO JL=1,INL
DO JJ=1,INI
- IDEPTH=KWG_LAYER(JJ)
+ IDEPTH=PK%NWG_LAYER(JJ)
IF(JL<=IDEPTH)THEN
- ZEXCESS(JJ) = MAX(0.0, PWGI(JJ,JL) - (PWSATZ(JJ,JL)-XWGMIN) )
- PWGI(JJ,JL) = PWGI(JJ,JL) - ZEXCESS(JJ)
+ ZEXCESS(JJ) = MAX(0.0, PEK%XWGI(JJ,JL) - (KK%XWSAT(JJ,JL)-XWGMIN) )
+ PEK%XWGI(JJ,JL) = PEK%XWGI(JJ,JL) - ZEXCESS(JJ)
ZEXCESSFC(JJ,JL) = ZEXCESSFC(JJ,JL) + ZEXCESS(JJ)
IF(JL<IDEPTH)THEN
- PWGI(JJ,JL+1) = PWGI(JJ,JL+1) + ZEXCESS(JJ)*(PDZG(JJ,JL)/PDZG(JJ,JL+1))
- ZEXCESSFC(JJ,JL+1)= ZEXCESSFC(JJ,JL+1) - ZEXCESS(JJ)*(PDZG(JJ,JL)/PDZG(JJ,JL+1))
+ PEK%XWGI(JJ,JL+1) = PEK%XWGI(JJ,JL+1) + ZEXCESS(JJ)*(PK%XDZG(JJ,JL)/PK%XDZG(JJ,JL+1))
+ ZEXCESSFC(JJ,JL+1) = ZEXCESSFC(JJ,JL+1) - ZEXCESS(JJ)*(PK%XDZG(JJ,JL)/PK%XDZG(JJ,JL+1))
ELSE
- PWGI_EXCESS(JJ) = ZEXCESS(JJ)*PDZG(JJ,IDEPTH)*XRHOLW/PTSTEP
+ PWGI_EXCESS(JJ) = ZEXCESS(JJ)*PK%XDZG(JJ,IDEPTH)*XRHOLW/PTSTEP
ENDIF
ENDIF
ENDDO
@@ -272,13 +258,13 @@ ENDDO
!
DO JL=1,INL
DO JJ=1,INI
- IDEPTH=KWG_LAYER(JJ)
- IF(JL<=IDEPTH.AND.PWGI(JJ,JL)>0.0.AND.PWGI(JJ,JL)<1.0E-6)THEN
- PWG (JJ,JL) = PWG(JJ,JL) + PWGI(JJ,JL)
- ZEXCESSFC(JJ,JL) = ZEXCESSFC(JJ,JL) + PWGI(JJ,JL)
- PWGI (JJ,JL) = 0.0
+ IDEPTH=PK%NWG_LAYER(JJ)
+ IF(JL<=IDEPTH.AND.PEK%XWGI(JJ,JL)>0.0.AND.PEK%XWGI(JJ,JL)<1.0E-6)THEN
+ PEK%XWG (JJ,JL) = PEK%XWG(JJ,JL) + PEK%XWGI(JJ,JL)
+ ZEXCESSFC(JJ,JL) = ZEXCESSFC(JJ,JL) + PEK%XWGI(JJ,JL)
+ PEK%XWGI(JJ,JL) = 0.0
ENDIF
- PTG (JJ,JL) = PTG(JJ,JL) - ZEXCESSFC(JJ,JL)*XLMTT*XRHOLW/PSOILHCAPZ(JJ,JL)
+ PEK%XTG(JJ,JL) = PEK%XTG(JJ,JL) - ZEXCESSFC(JJ,JL)*XLMTT*XRHOLW/PSOILHCAPZ(JJ,JL)
ENDDO
ENDDO
!
diff --git a/src/SURFEX/ice_soilfr.F90 b/src/SURFEX/ice_soilfr.F90
index 1a87ed50812596283ef2d4687fa1b5f83605f46d..fc300678ccc021aec6fec64b111b6d3c64dd4410 100644
--- a/src/SURFEX/ice_soilfr.F90
+++ b/src/SURFEX/ice_soilfr.F90
@@ -2,9 +2,7 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
- SUBROUTINE ICE_SOILFR(HSNOW_ISBA, HSOILFRZ, PTSTEP, PKSFC_IVEG, PCG, PCT, &
- PPSNG, PFFG, PTAUICE, PDWGI1, PDWGI2, PWSATZ, &
- PMPOTSATZ, PBCOEFZ, PD_G, PTG, PWGI, PWG )
+ SUBROUTINE ICE_SOILFR(IO, KK, PK, PEK, DMK, PTSTEP, PKSFC_IVEG, PDWGI1, PDWGI2 )
!! ##########################################################################
!
!!**** *ICE_SOILFR*
@@ -48,7 +46,7 @@
!! -------------
!! Original 14/03/95
!! (A.Boone) 08/11/00 soil ice phase changes herein
-!! (A.Boone) 06/05/02 Updates, ordering. Addition of 'HSOILFRZ' option
+!! (A.Boone) 06/05/02 Updates, ordering. Addition of 'IO%CSOILFRZ' option
!! (B. Decharme) 03/2009 BUG : effect of insolation due to vegetation cover
!! at 1 for bare soil
!! (B. Decharme) 07/2012 Time spliting for soil ice
@@ -58,6 +56,10 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
+!
USE MODD_CSTS, ONLY : XCL, XTT, XPI, XDAY, XCI, XRHOLI, &
XLMTT, XRHOLW, XG, XCONDI
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -70,61 +72,28 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-!
- CHARACTER(LEN=*), INTENT(IN) :: HSNOW_ISBA ! 'DEF' = Default F-R snow scheme
-! ! (Douville et al. 1995)
-! ! '3-L' = 3-L snow scheme (option)
-! ! (Boone and Etchevers 2001)
-!
- CHARACTER(LEN=*), INTENT(IN) :: HSOILFRZ ! soil freezing-physics option
-! ! 'DEF' Default (Boone et al. 2000; Giard and Bazile 2000)
-! ! 'LWT' phase changes as above, but relation between unfrozen
-! water and temperature considered
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK
!
REAL, INTENT (IN) :: PTSTEP ! model time step (s)
!
-!
REAL, DIMENSION(:), INTENT(IN) :: PKSFC_IVEG
! PKSFC_IVEG= non-dimensional vegetation insolation coefficient
!
-REAL, DIMENSION(:), INTENT(IN) :: PTAUICE
-! PTAUICE = characteristic time scale for soil water phase changes (s)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PPSNG
-! PPSNG = snow fractions over ground
-!
-REAL, DIMENSION(:), INTENT(IN) :: PFFG
-! PPSNG = flood fractions over ground
-!
-REAL, DIMENSION(:), INTENT (IN) :: PCG, PCT
-! PCT = area-averaged heat capacity (K m2 J-1)
-! PCG = heat capacity of the soil (K m2 J-1)
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_G, PWSATZ
-! PD_G = Depth of bottom of Soil layers (m)
-! PWSATZ = porosity (m3/m3)
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PMPOTSATZ, PBCOEFZ
-! PMPOTSATZ = matric potential at saturation (m)
-! PBCOEFZ = slope of the water retention curve (-)
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PWG, PWGI, PTG
-! PWGI = soil frozen volumetric water content (m3/m3)
-! PWG = soil liquid volumetric water content (m3/m3)
-! PTG = soil temperature profile (K)
-!
REAL, DIMENSION(:), INTENT(OUT) :: PDWGI1, PDWGI2
! PDWGI1 = near-surface liquid water equivalent
! volumetric ice content tendency
! PDWGI2 = deep ground liquid water equivalent
! volumetric ice content tendency
!
-!
!* 0.2 declarations of local variables
!
REAL :: ZKSOIL ! coefficient for soil freeze/thaw
!
-REAL, DIMENSION(SIZE(PCG)) :: ZKSFC_FRZ, ZFREEZING, ZICE_MELT, ZWIM, &
+REAL, DIMENSION(SIZE(DMK%XCG)) :: ZKSFC_FRZ, ZFREEZING, ZICE_MELT, ZWIM, &
ZWIT, ZWGI1, ZWGI2, ZWM, ZSOILHEATCAP, &
ZICEEFF, ZEFFIC, ZTAUICE, &
ZWGMIN, ZTGMAX, ZMATPOT, ZDELTAT
@@ -145,18 +114,18 @@ REAL, DIMENSION(SIZE(PCG)) :: ZKSFC_FRZ, ZFREEZING, ZICE_MELT, ZWIM, &
! ZDELTAT = Freezing or melting temperature depression (K) after
! possible flux correction
!
-REAL, DIMENSION(SIZE(PCG)) :: ZWSAT_AVGZ
+REAL, DIMENSION(SIZE(DMK%XCG)) :: ZWSAT_AVGZ
! ZWSAT_AVGZ = soil column average porosity (m3 m-3)
!
-REAL, DIMENSION(SIZE(PCG)) :: ZPSNG
+REAL, DIMENSION(SIZE(DMK%XCG)) :: ZPSNG
! ZPSNG = snow fractions corresponding to
-! dummy argument PPSNG
-! if HSNOW_ISBA = 'DEF' (composite
+! dummy argument PEK%XPSNG(:)
+! if PEK%TSNOW%SCHEME = 'DEF' (composite
! or Force-Restore snow scheme), else
! they are zero for explicit snow case
! as snow fluxes calculated outside of
! this routine using the
-! HSNOW_ISBA = '3-L' or 'CRO' option.
+! PEK%TSNOW%SCHEME = '3-L' or 'CRO' option.
!
!* 0.3 declarations of local parameters
!
@@ -174,9 +143,9 @@ REAL, PARAMETER :: ZEFFIC_MIN = 0.01 ! (-) (0 <= ZEFFIC_MIN <<
! If it is zero, then this effect off.
!
!
-INTEGER :: INI, JJ
+INTEGER :: INJ, JJ
!
-REAL, DIMENSION(SIZE(PCG)) :: ZWORK1, ZWORK2, ZTDIURN
+REAL, DIMENSION(SIZE(DMK%XCG)) :: ZWORK1, ZWORK2, ZTDIURN
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
@@ -201,7 +170,7 @@ ZWSAT_AVGZ(:) = XUNDEF
ZDELTAT(:) = 0.0
ZTDIURN(:) = 0.0
!
-INI = SIZE(PTG,1)
+INJ = SIZE(PEK%XTG,1)
!
!-------------------------------------------------------------------------------
!
@@ -209,20 +178,20 @@ INI = SIZE(PTG,1)
! fluxes calculated outside of this routine, so set
! the local snow fractions here to zero:
!
-IF(HSNOW_ISBA == '3-L' .OR. HSNOW_ISBA == 'CRO')THEN
- ZPSNG(:) = 0.0
+IF(PEK%TSNOW%SCHEME == '3-L' .OR. PEK%TSNOW%SCHEME == 'CRO')THEN
+ ZPSNG(:) = 0.0
ELSE
- ZPSNG(:) = PPSNG(:)+PFFG(:)
+ ZPSNG(:) = PEK%XPSNG(:)+KK%XFFG(:)
ENDIF
!
!* 1. Melting/freezing normalized coefficient
! ---------------------------------------
!
-ZKSOIL = (0.5 * SQRT(XCONDI*XCI*XRHOLI*XDAY/XPI))/XLMTT
+ZKSOIL = (0.5 * SQRT(XCONDI*XCI*XRHOLI*XDAY/XPI))/XLMTT
!
-ZTAUICE (:) = MAX(PTSTEP,PTAUICE(:))
+ZTAUICE (:) = MAX(PTSTEP,PK%XTAUICE(:))
!
-DO JJ=1,INI
+DO JJ=1,INJ
!-------------------------------------------------------------------------------
!* 2. EFFECT OF THE MELTING/FREEZING
! ON THE SURFACE-SOIL HEAT AND ICE CONTENTS
@@ -235,17 +204,17 @@ DO JJ=1,INI
! profiles of soil hydrological parameters are constant,
! so use the values in uppermost element (arbitrary)
!
- ZWSAT_AVGZ(JJ) = PWSATZ(JJ,1)
+ ZWSAT_AVGZ(JJ) = KK%XWSAT(JJ,1)
!
! Influence of vegetation insolation on surface:
!
- ZKSFC_FRZ(JJ) = ZKSOIL * PKSFC_IVEG(JJ)
+ ZKSFC_FRZ(JJ) = ZKSOIL * PKSFC_IVEG(JJ)
!
ENDDO
!* 2.2 Water freezing
! --------------
!
-IF(HSOILFRZ == 'LWT')THEN
+IF(IO%CSOILFRZ == 'LWT')THEN
!
! use option to control phase changes based on a relationship
! between the unfrozen liquid water content and temperature.
@@ -253,32 +222,32 @@ IF(HSOILFRZ == 'LWT')THEN
! The energy-limit method used by Boone et al. 2000 and
! Giard and Bazile (2000) is the default.
!
- DO JJ=1,INI
- ZMATPOT(JJ) = MIN(PMPOTSATZ(JJ,1), XLMTT*(PTG(JJ,1)-XTT)/(XG*PTG(JJ,1)) )
- ZWGMIN(JJ) = ZWSAT_AVGZ(JJ)*( (ZMATPOT(JJ)/PMPOTSATZ(JJ,1))**(-1./PBCOEFZ(JJ,1)) )
+ DO JJ=1,INJ
+ ZMATPOT(JJ) = MIN(KK%XMPOTSAT(JJ,1), XLMTT*(PEK%XTG(JJ,1)-XTT)/(XG*PEK%XTG(JJ,1)) )
+ ZWGMIN(JJ) = ZWSAT_AVGZ(JJ)*( (ZMATPOT(JJ)/KK%XMPOTSAT(JJ,1))**(-1./KK%XBCOEF(JJ,1)) )
- ZMATPOT(JJ) = PMPOTSATZ(JJ,1)*( (PWG(JJ,1)/ZWSAT_AVGZ(JJ))**(-PBCOEFZ(JJ,1)) )
- ZTGMAX(JJ) = XLMTT*XTT/(XLMTT - XG* ZMATPOT(JJ))
+ ZMATPOT(JJ) = KK%XMPOTSAT(JJ,1)*( (PEK%XWG(JJ,1)/ZWSAT_AVGZ(JJ))**(-KK%XBCOEF(JJ,1)) )
+ ZTGMAX(JJ) = XLMTT*XTT/(XLMTT - XG* ZMATPOT(JJ))
ENDDO
ELSE
- ZWGMIN(:) = XWGMIN
- ZTGMAX(:) = XTT
+ ZWGMIN(:) = XWGMIN
+ ZTGMAX(:) = XTT
ENDIF
!
-DO JJ=1,INI
+DO JJ=1,INJ
!
- ZDELTAT(JJ) = PTG(JJ,1) - ZTGMAX(JJ) ! initial temperature depression
+ ZDELTAT(JJ) = PEK%XTG(JJ,1) - ZTGMAX(JJ) ! initial temperature depression
!
- ZWORK2(JJ) = XRHOLW*PD_G(JJ,1)
- ZEFFIC(JJ) = MAX(ZEFFIC_MIN,(PWG(JJ,1)-XWGMIN)/ZWSAT_AVGZ(JJ))
- ZFREEZING(JJ) = MIN( MAX(0.0,PWG(JJ,1)-ZWGMIN(JJ))*ZWORK2(JJ), &
+ ZWORK2(JJ) = XRHOLW*PK%XDG(JJ,1)
+ ZEFFIC(JJ) = MAX(ZEFFIC_MIN,(PEK%XWG(JJ,1)-XWGMIN)/ZWSAT_AVGZ(JJ))
+ ZFREEZING(JJ) = MIN( MAX(0.0,PEK%XWG(JJ,1)-ZWGMIN(JJ))*ZWORK2(JJ), &
ZKSFC_FRZ(JJ)*ZEFFIC(JJ)*MAX( -ZDELTAT(JJ), 0.) )
!
!* 2.3 Ground Ice melt
! ---------------
!
- ZEFFIC(JJ) = MAX(ZEFFIC_MIN,PWGI(JJ,1)/(ZWSAT_AVGZ(JJ)-XWGMIN))
- ZICE_MELT(JJ) = MIN( PWGI(JJ,1)*ZWORK2(JJ), &
+ ZEFFIC(JJ) = MAX(ZEFFIC_MIN,PEK%XWGI(JJ,1)/(ZWSAT_AVGZ(JJ)-XWGMIN))
+ ZICE_MELT(JJ) = MIN( PEK%XWGI(JJ,1)*ZWORK2(JJ), &
ZKSFC_FRZ(JJ)*ZEFFIC(JJ)*MAX( ZDELTAT(JJ), 0. ) )
!
!* 2.4 Ice reservoir evolution
@@ -286,22 +255,22 @@ DO JJ=1,INI
!
! Melting of ice/freezing of water:
!
- ZWGI1(JJ) = PWGI(JJ,1) + (PTSTEP/ZTAUICE(JJ))*(1.0-ZPSNG(JJ))* &
+ ZWGI1(JJ) = PEK%XWGI(JJ,1) + (PTSTEP/ZTAUICE(JJ))*(1.0-ZPSNG(JJ))* &
(ZFREEZING(JJ) - ZICE_MELT(JJ))/ZWORK2(JJ)
!
!
- ZWGI1(JJ) = MAX( ZWGI1(JJ) , 0. )
- ZWGI1(JJ) = MIN( ZWGI1(JJ) , ZWSAT_AVGZ(JJ)-XWGMIN)
+ ZWGI1(JJ) = MAX( ZWGI1(JJ) , 0. )
+ ZWGI1(JJ) = MIN( ZWGI1(JJ) , ZWSAT_AVGZ(JJ)-XWGMIN)
!
! Time tendency:
!
- PDWGI1(JJ) = ZWGI1(JJ) - PWGI(JJ,1)
+ PDWGI1(JJ) = ZWGI1(JJ) - PEK%XWGI(JJ,1)
!
!
!* 2.5 Effect on temperature
! ---------------------
!
- PTG(JJ,1) = PTG(JJ,1) + PDWGI1(JJ)*XLMTT*PCT(JJ)*ZWORK2(JJ)
+ PEK%XTG(JJ,1) = PEK%XTG(JJ,1) + PDWGI1(JJ)*XLMTT*DMK%XCT(JJ)*ZWORK2(JJ)
!
!-------------------------------------------------------------------------------
!
@@ -310,41 +279,41 @@ DO JJ=1,INI
! ('DEF' or Force-Restore soil option)
! --------------------------------------
!
- ZWORK1(JJ) = PD_G(JJ,1)/PD_G(JJ,2)
+ ZWORK1(JJ) = PK%XDG(JJ,1)/PK%XDG(JJ,2)
!* 3.1 Available Deep ice content
! --------------------------
!
- ZWIM(JJ) = ( PWGI(JJ,2) - ZWORK1(JJ) * PWGI(JJ,1) ) / ( 1. - ZWORK1(JJ) )
+ ZWIM(JJ) = ( PEK%XWGI(JJ,2) - ZWORK1(JJ) * PEK%XWGI(JJ,1) ) / ( 1. - ZWORK1(JJ) )
!
- ZWIM(JJ) = MAX(0.,ZWIM(JJ)) ! Just in case of round-off errors
+ ZWIM(JJ) = MAX(0.,ZWIM(JJ)) ! Just in case of round-off errors
!
!* 3.2 Deep liquid water content
! -------------------------
!
- ZWM(JJ) = ( PWG(JJ,2) - ZWORK1(JJ) * PWG(JJ,1) ) / ( 1. - ZWORK1(JJ) )
+ ZWM(JJ) = ( PEK%XWG(JJ,2) - ZWORK1(JJ) * PEK%XWG(JJ,1) ) / ( 1. - ZWORK1(JJ) )
!
!* 3.3 Water freezing
! --------------
!
! Total soil volumetric heat capacity [J/(m3 K)]:
!
- ZSOILHEATCAP(JJ) = XCL*XRHOLW*PWG(JJ,2) + &
- XCI*XRHOLI*PWGI(JJ,2) + &
+ ZSOILHEATCAP(JJ) = XCL*XRHOLW*PEK%XWG(JJ,2) + &
+ XCI*XRHOLI*PEK%XWGI(JJ,2) + &
XSPHSOIL*XDRYWGHT*(1.0-ZWSAT_AVGZ(JJ))*(1.0-ZWSAT_AVGZ(JJ))
!
! Soil thickness which corresponds to T2 (m): 2 times the diurnal
! surface temperature wave penetration depth as T2 is the average
! temperature for this layer:
!
- ZTDIURN(JJ) = MIN(PD_G(JJ,2), 4./(ZSOILHEATCAP(JJ)*PCG(JJ)))
+ ZTDIURN(JJ) = MIN(PK%XDG(JJ,2), 4./(ZSOILHEATCAP(JJ)*DMK%XCG(JJ)))
!
! Effective soil ice penetration depth (m):
!
- ZICEEFF(JJ) = (PWGI(JJ,2)/(PWGI(JJ,2)+PWG(JJ,2)))*PD_G(JJ,2)
+ ZICEEFF(JJ) = (PEK%XWGI(JJ,2)/(PEK%XWGI(JJ,2)+PEK%XWG(JJ,2)))*PK%XDG(JJ,2)
!
ENDDO
!
-IF(HSOILFRZ == 'LWT')THEN
+IF(IO%CSOILFRZ == 'LWT')THEN
!
! as for the surface layer (above)JJ
! Note also that if the 'DIF'
@@ -352,69 +321,69 @@ IF(HSOILFRZ == 'LWT')THEN
! to be homogeneous (in the verticalJJ thus we use 1st element of 2nd dimension
! of the 2D-soil parameter arrays).
!
- DO JJ=1,INI
+ DO JJ=1,INJ
- ZMATPOT(JJ) = MIN(PMPOTSATZ(JJ,1), XLMTT*(PTG(JJ,2)-XTT)/(XG*PTG(JJ,2)) )
- ZWGMIN(JJ) = ZWSAT_AVGZ(JJ)*( (ZMATPOT(JJ)/PMPOTSATZ(JJ,1))**(-1./PBCOEFZ(JJ,1)) )
+ ZMATPOT(JJ) = MIN(KK%XMPOTSAT(JJ,1), XLMTT*(PEK%XTG(JJ,2)-XTT)/(XG*PEK%XTG(JJ,2)) )
+ ZWGMIN(JJ) = ZWSAT_AVGZ(JJ)*( (ZMATPOT(JJ)/KK%XMPOTSAT(JJ,1))**(-1./KK%XBCOEF(JJ,1)) )
- ZMATPOT(JJ) = PMPOTSATZ(JJ,1)*( (PWG(JJ,2)/ZWSAT_AVGZ(JJ))**(-PBCOEFZ(JJ,1)) )
- ZTGMAX(JJ) = XLMTT*XTT/(XLMTT - XG* ZMATPOT(JJ))
+ ZMATPOT(JJ) = KK%XMPOTSAT(JJ,1)*( (PEK%XWG(JJ,2)/ZWSAT_AVGZ(JJ))**(-KK%XBCOEF(JJ,1)) )
+ ZTGMAX(JJ) = XLMTT*XTT/(XLMTT - XG* ZMATPOT(JJ))
ENDDO
ELSE
- ZWGMIN(:) = XWGMIN
- ZTGMAX(:) = XTT
+ ZWGMIN(:) = XWGMIN
+ ZTGMAX(:) = XTT
ENDIF
!
! Allow freezing by T2 up to a certain depth so that
! T2 energy can not be used to freeze soil water
! at levels sufficiently deep in the soil.
!
-DO JJ=1,INI
+DO JJ=1,INJ
!
- ZDELTAT(JJ) = PTG(JJ,2) - ZTGMAX(JJ) ! initial temperature depression
+ ZDELTAT(JJ) = PEK%XTG(JJ,2) - ZTGMAX(JJ) ! initial temperature depression
!
- ZWORK1(JJ) = PD_G(JJ,1)/PD_G(JJ,2)
- ZWORK2(JJ) = XRHOLW*(PD_G(JJ,2)-PD_G(JJ,1))
+ ZWORK1(JJ) = PK%XDG(JJ,1)/PK%XDG(JJ,2)
+ ZWORK2(JJ) = XRHOLW*(PK%XDG(JJ,2)-PK%XDG(JJ,1))
- ZFREEZING(JJ) = 0.0
- IF (ZICEEFF(JJ) <= ZTDIURN(JJ)) THEN
+ ZFREEZING(JJ) = 0.0
+ IF (ZICEEFF(JJ) <= ZTDIURN(JJ)) THEN
!
- ZEFFIC(JJ) = MAX(ZEFFIC_MIN, MAX(0.0,ZWM(JJ) - XWGMIN)/ZWSAT_AVGZ(JJ))
- ZFREEZING(JJ) = MIN( MAX(0.0, ZWM(JJ) - ZWGMIN(JJ))* ZWORK2(JJ), &
+ ZEFFIC(JJ) = MAX(ZEFFIC_MIN, MAX(0.0,ZWM(JJ) - XWGMIN)/ZWSAT_AVGZ(JJ))
+ ZFREEZING(JJ) = MIN( MAX(0.0, ZWM(JJ) - ZWGMIN(JJ))* ZWORK2(JJ), &
ZKSOIL*ZEFFIC(JJ)*MAX( -ZDELTAT(JJ) , 0. ) )
- ENDIF
+ ENDIF
!
!
!* 3.4 Ground Ice melt
! ---------------
!
- ZEFFIC(JJ) = MAX(ZEFFIC_MIN, ZWIM(JJ)/(ZWSAT_AVGZ(JJ)-XWGMIN))
- ZICE_MELT(JJ) = MIN( ZWIM(JJ)*ZWORK2(JJ), &
+ ZEFFIC(JJ) = MAX(ZEFFIC_MIN, ZWIM(JJ)/(ZWSAT_AVGZ(JJ)-XWGMIN))
+ ZICE_MELT(JJ) = MIN( ZWIM(JJ)*ZWORK2(JJ), &
ZKSOIL*ZEFFIC(JJ)*MAX( ZDELTAT(JJ) , 0. ) )
!
!
!* 3.5 Deep-part of deep-soil Ice reservoir evolution
! ----------------------------------------------
!
- ZWIT(JJ) = ZWIM(JJ) + (PTSTEP/ZTAUICE(JJ))*(1.0-ZPSNG(JJ))* &
+ ZWIT(JJ) = ZWIM(JJ) + (PTSTEP/ZTAUICE(JJ))*(1.0-ZPSNG(JJ))* &
((ZFREEZING(JJ) - ZICE_MELT(JJ))/ ZWORK2(JJ))
!
- ZWIT(JJ) = MAX( ZWIT(JJ) , 0. )
- ZWIT(JJ) = MIN( ZWIT(JJ) , ZWSAT_AVGZ(JJ)-XWGMIN)
+ ZWIT(JJ) = MAX( ZWIT(JJ) , 0. )
+ ZWIT(JJ) = MIN( ZWIT(JJ) , ZWSAT_AVGZ(JJ)-XWGMIN)
!
!
!* 3.6 Add reservoir evolution from surface freezing (WI2 contains WI1)
! ----------------------------------------------------------------
!
- ZWGI2(JJ) = (1.-ZWORK1(JJ))*ZWIT(JJ) + ZWORK1(JJ)*ZWGI1(JJ)
+ ZWGI2(JJ) = (1.-ZWORK1(JJ))*ZWIT(JJ) + ZWORK1(JJ)*ZWGI1(JJ)
!
- PDWGI2(JJ) = ZWGI2(JJ) - PWGI(JJ,2)
+ PDWGI2(JJ) = ZWGI2(JJ) - PEK%XWGI(JJ,2)
!
!
!* 3.7 Effect on temperature
! ---------------------
!
- PTG(JJ,2) = PTG(JJ,2) + PDWGI2(JJ)*XLMTT*PCG(JJ)*XRHOLW*PD_G(JJ,2)
+ PEK%XTG(JJ,2) = PEK%XTG(JJ,2) + PDWGI2(JJ)*XLMTT*DMK%XCG(JJ)*XRHOLW*PK%XDG(JJ,2)
!
ENDDO
!
diff --git a/src/SURFEX/impnone.h b/src/SURFEX/impnone.h
deleted file mode 100644
index ce6b0019a92b1e2f2e725d63df3fba0525a6c831..0000000000000000000000000000000000000000
--- a/src/SURFEX/impnone.h
+++ /dev/null
@@ -1,3 +0,0 @@
-!RJ: inlined
- ERROR aa
-#error should not be used
diff --git a/src/SURFEX/info_lcover b/src/SURFEX/info_lcover
new file mode 100644
index 0000000000000000000000000000000000000000..ed90b1734a094074f5d454d4d73eda2861a6c461
--- /dev/null
+++ b/src/SURFEX/info_lcover
@@ -0,0 +1,61 @@
+average1_cover.F90: U%LCOVER(ICOVERCLASS) = .TRUE.
+get_jcovern.F90:KCOVER = COUNT(U%LCOVER)
+get_lcovern.F90:IF ( SIZE(OCOVER) /= SIZE(U%LCOVER) ) THEN
+get_lcovern.F90: WRITE(ILUOUT,*) 'size of field inthe surface (LCOVER) :', SIZE(U%LCOVER)
+get_lcovern.F90: OCOVER = U%LCOVER
+get_surf_maskn.F90: U%XCOVER,U%LCOVER,ZSEA,ZNATURE,ZTOWN,ZWATER)
+get_surf_sizen.F90: U%XCOVER,U%LCOVER,ZSEA,ZNATURE,ZTOWN,ZWATER)
+get_type_dimn.F90: U%XCOVER,U%LCOVER,ZSEA,ZNATURE,ZTOWN,ZWATER)
+pgd_cover.F90:ALLOCATE(U%LCOVER (JPCOVER))
+pgd_cover.F90:U%LCOVER = .FALSE.
+pgd_cover.F90: U%LCOVER(JCOV) = .TRUE.
+pgd_cover.F90: ALLOCATE(U%LCOVER(JPCOVER))
+pgd_cover.F90: CALL READ_LCOVER(YFILETYPE,U%LCOVER)
+pgd_cover.F90: CALL READ_SURF_COV(YFILETYPE,'COVER',U%XCOVER(:,:),U%LCOVER,IRESP)
+pgd_cover.F90: U%LCOVER(:) = .FALSE.
+pgd_cover.F90: IF (ANY(U%XCOVER(:,JCOV)/=0.)) U%LCOVER(IMASK_COVER(JCOV)) = .TRUE.
+pgd_cover.F90: CALL MAKE_LCOVER(U%LCOVER)
+pgd_cover.F90: ICOVER = COUNT(U%LCOVER)
+pgd_cover.F90: IF (U%LCOVER(IMASK_COVER(JCOV))) THEN
+pgd_cover.F90: IF (ICOVERSUM==0) U%LCOVER(IMASK_COVER(JCOV) )= .FALSE.
+pgd_cover.F90: ICOVER = COUNT(U%LCOVER)
+pgd_cover.F90: IF (U%LCOVER(IMASK_COVER(JCOV))) THEN
+pgd_cover.F90: IF (ANY(U%LCOVER(301:))) IECO2=1
+pgd_cover.F90: CALL CONVERT_COVER_FRAC(DTCO, U%XCOVER,U%LCOVER,U%XSEA,U%XNATURE,U%XTOWN,U%XWATER)
+pgd_cover.F90: CALL CONVERT_COVER_FRAC(DTCO, U%XCOVER,U%LCOVER,ZSEA,ZNATURE,ZTOWN,ZWATER)
+pgd_cover.F90: IF (U%LCOVER(JCOV)) THEN
+pgd_cover.F90: U%LCOVER(KSURF) = .TRUE.
+pgd_cover.F90: IF (U%LCOVER(JCOV)) THEN
+pgd_fieldin.F90: IF( (U%LECOSG.AND..NOT.U%LCOVER(JT)) .OR. (.NOT.U%LECOSG.AND..NOT.LVEG_PRES(JT)) ) THEN
+pgd_frac.F90: ALLOCATE(U%LCOVER(JPCOVER))
+pgd_frac.F90: U%LCOVER(:) = .FALSE.
+pgd_frac.F90: U%LCOVER(ID_COV(1)) = .TRUE.
+pgd_frac.F90: U%LCOVER(ID_COV(2)) = .TRUE.
+pgd_frac.F90: U%LCOVER(ID_COV(3)) = .TRUE.
+pgd_frac.F90: U%LCOVER(ID_COV(4)) = .TRUE.
+pgd_frac.F90: IF (U%LCOVER(ID_COV(1))) THEN
+pgd_frac.F90: IF (U%LCOVER(ID_COV(2))) THEN
+pgd_frac.F90: IF (U%LCOVER(ID_COV(3))) THEN
+pgd_frac.F90: IF (U%LCOVER(ID_COV(4))) THEN
+read_covern.F90:ALLOCATE(U%LCOVER(JPCOVER))
+read_covern.F90: CALL READ_LCOVER(HPROGRAM,U%LCOVER)
+read_covern.F90:ALLOCATE(U%XCOVER(U%NSIZE_FULL,COUNT(U%LCOVER)))
+read_covern.F90: CALL READ_SURF_COV(HPROGRAM,'COVER',U%XCOVER(:,:),U%LCOVER,IRESP)
+read_covern.F90: CALL CONVERT_COVER_FRAC(DTCO,U%XCOVER,U%LCOVER,U%XSEA,U%XNATURE,U%XTOWN,U%XWATER)
+read_direct.F90: IF (HFIELD(1:5)=="COVER") U%LCOVER(:) = .FALSE.
+read_direct_gauss.F90: IF (HFIELD(1:5)=="COVER") U%LCOVER(:) = .FALSE.
+treat_field.F90: CALL MAKE_LCOVER(U%LCOVER)
+treat_field.F90: ALLOCATE(IMASK(SIZE(U%LCOVER)))
+treat_field.F90: DO JCOV = 1,SIZE(U%LCOVER)
+treat_field.F90: IF (U%LCOVER(JCOV)) THEN
+treat_field.F90: ALLOCATE(XSUMVAL(U%NSIZE_FULL,COUNT(U%LCOVER)))
+writesurf_covern.F90:CALL WRITE_LCOVER(HSELECT,HPROGRAM,U%LCOVER)
+writesurf_covern.F90: HPROGRAM,'COVER',U%XCOVER(:,:),U%LCOVER,IRESP,HCOMMENT=YCOMMENT)
+zoom_pgd_cover.F90:ALLOCATE(U%LCOVER(JPCOVER))
+zoom_pgd_cover.F90: CALL READ_LCOVER(HPROGRAM,U%LCOVER)
+zoom_pgd_cover.F90:ALLOCATE(ZCOVER(INI,COUNT(U%LCOVER)))
+zoom_pgd_cover.F90: CALL READ_SURF_COV(HPROGRAM,YRECFM,ZCOVER(:,:),U%LCOVER,IRESP,HDIR='A')
+zoom_pgd_cover.F90: CALL CONVERT_COVER_FRAC(DTCO,ZCOVER,U%LCOVER,ZSEA1(:,1),ZNATURE1(:,1),ZTOWN1(:,1),ZWATER1(:,1))
+zoom_pgd_cover.F90:ALLOCATE(U%XCOVER(IL,COUNT(U%LCOVER)))
+zoom_pgd_cover.F90: IF ( U%LCOVER( JCOVER ) ) THEN
+zoom_pgd_cover.F90:ALLOCATE(ZCOVER(IL,COUNT(U%LCOVER)))
diff --git a/src/SURFEX/info_rsmin b/src/SURFEX/info_rsmin
new file mode 100644
index 0000000000000000000000000000000000000000..163ac9d72795cf63870d74a44771062649475f75
--- /dev/null
+++ b/src/SURFEX/info_rsmin
@@ -0,0 +1,143 @@
+allocate_physio.F90:ALLOCATE(PEK%XRSMIN (ISIZE ))
+allocate_teb_veg_pgd.F90:ALLOCATE(PEK%XRSMIN (KLU))
+convert_cover_isba.F90: PLAI,PRSMIN,PGAMMA,PWRMAX_CF, &
+convert_cover_isba.F90: XDATA_RGL, XDATA_RSMIN, &
+convert_cover_isba.F90:REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PRSMIN
+convert_cover_isba.F90:IF (PRESENT(PRSMIN)) THEN
+convert_cover_isba.F90: IF (SIZE(PRSMIN)>0) CALL AV_PGD(YDTCO, PRSMIN,PCOVER ,XDATA_RSMIN,YLAI,'INV',OCOVER,KDECADE=KDECADE)
+convert_patch_isba.F90: XDATA_RGL, XDATA_RSMIN, &
+convert_patch_isba.F90: IF( SIZE(PEK%XRSMIN)>0) THEN
+convert_patch_isba.F90: IF (GDATA .AND. ANY(DTV%LDATA_RSMIN)) THEN
+convert_patch_isba.F90: PEK%XRSMIN,DTV%XPAR_VEGTYPE,DTV%XPAR_RSMIN,YLAI,'INV',&
+convert_patch_isba.F90: CALL AV_PGD_1P(DTCO, PEK%XRSMIN,PCOVER,XDATA_RSMIN,YLAI,'INV',&
+ini_data_cover.F90: XDATA_ALBUV_VEG, XDATA_RSMIN, &
+ini_data_cover.F90: DEALLOCATE(XDATA_RSMIN,XDATA_GAMMA,XDATA_WRMAX_CF,XDATA_RGL,XDATA_CV)
+ini_data_cover.F90:ALLOCATE(XDATA_RSMIN(JPCOVER,NVEGTYPE))
+ini_data_cover.F90:XDATA_RSMIN (:,:) = XUNDEF
+ini_data_cover.F90: PALBUV_VEG=XDATA_ALBUV_VEG, PRSMIN=XDATA_RSMIN, &
+ini_data_param.F90: PALBNIR_VEG, PALBVIS_VEG, PALBUV_VEG, PRSMIN, &
+ini_data_param.F90:!! V Masson 03/04/2002 set RSMIN value to 120 for NVT_TROG and NVT_C4
+ini_data_param.F90:USE MODD_REPROD_OPER, ONLY : XEVERG_RSMIN
+ini_data_param.F90:REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PRSMIN
+ini_data_param.F90:IF (PRESENT(PRSMIN)) THEN
+ini_data_param.F90: PRSMIN(:,:)= 40.
+ini_data_param.F90: PRSMIN(:,NVT_TEBD)= 150.
+ini_data_param.F90: PRSMIN(:,NVT_TRBD)= 150.
+ini_data_param.F90: PRSMIN(:,NVT_TEBE)= 150.
+ini_data_param.F90: PRSMIN(:,NVT_BOBD)= 150.
+ini_data_param.F90: PRSMIN(:,NVT_SHRB)= 150.
+ini_data_param.F90: PRSMIN(:,NVT_BONE)= 150.
+ini_data_param.F90: PRSMIN(:,NVT_TENE)= 150.
+ini_data_param.F90: PRSMIN(:,NVT_BOND)= 150.
+ini_data_param.F90: PRSMIN(:,NVT_FLTR) = 150.
+ini_data_param.F90: PRSMIN(:,NVT_TRBE)= XEVERG_RSMIN
+ini_data_param.F90: PRSMIN(:,NVT_TROG)= 120.
+ini_data_param.F90: PRSMIN(:,NVT_C4 )= 40.
+ini_data_param.F90: PRSMIN(:,NVT_IRR )= 40.
+ini_data_param.F90: PRSMIN(:,NVT_C4 )= 120.
+ini_data_param.F90: PRSMIN(:,NVT_IRR )= 120.
+ini_surf_csts.F90:USE MODD_REPROD_OPER, ONLY : XEVERG_RSMIN, XEVERG_VEG, &
+ini_surf_csts.F90:NAMELIST/NAM_REPROD_OPER/ LREPROD_OPER, XEVERG_RSMIN, XEVERG_VEG, &
+ini_surf_csts.F90:!XEVERG_RSMIN : old = 250. (Manzi 1993) but observations range
+ini_surf_csts.F90:XEVERG_RSMIN = 175. !Rsmin
+ini_surf_csts.F90: CALL TEST_NAM_VAR_SURF(ILUOUT,'XEVERG_RSMIN',XEVERG_RSMIN,175.0,250.0)
+ini_surf_csts.F90: XEVERG_RSMIN = 250.
+init_from_data_teb_vegn.F90: PEK%XRSMIN(:) = DTV%XPAR_RSMIN(:,1)
+init_isba_mixpar.F90:!RSMIN
+init_isba_mixpar.F90: IF (.NOT.ANY(DTV%LDATA_RSMIN)) THEN
+init_isba_mixpar.F90: ALLOCATE(DTV%XPAR_RSMIN(KDIM,NVEGTYPE))
+init_isba_mixpar.F90: CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PRSMIN=DTV%XPAR_RSMIN)
+init_isba_mixpar.F90: DTV%LDATA_RSMIN(:)=.TRUE.
+init_isban.F90: XDATA_ALBUV_VEG, XDATA_RSMIN, &
+init_isban.F90: PALBUV_VEG=XDATA_ALBUV_VEG, PRSMIN=XDATA_RSMIN, &
+init_isba_sbl.F90:REAL, DIMENSION(SIZE(PTA)) ::ZRSMIN
+init_isba_sbl.F90:ZRSMIN(:) = 0.
+init_isba_sbl.F90: ZRSMIN(IMASK) = ZRSMIN(IMASK) + PK%XPATCH(JI) * PEK%XRSMIN(JI)
+init_isba_sbl.F90: CALL VEG(ZP_GLOBAL_SW, PTA, ZQA, PPS, ZRGL, ZLAI, ZRSMIN, ZGAMMA, ZF2, ZRS)
+isba.F90: CALL VEG(PSW_RAD, PTA, PQA, PPS, PEK%XRGL, PEK%XLAI, PEK%XRSMIN, PEK%XGAMMA, ZF2, DMK%XRS)
+isba_meb.F90: PEK%XRSMIN(:), PEK%XGAMMA(:), PF2, ZRS)
+modd_data_cover.F90:REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_RSMIN ! minimum stomatal resistance
+modd_data_isban.F90: LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_RSMIN
+modd_data_isban.F90: REAL, POINTER, DIMENSION(:,:) :: XPAR_RSMIN ! minimum stomatal resistance (s/m)
+modd_data_isban.F90: NULLIFY(YDATA_ISBA%XPAR_RSMIN)
+modd_data_isban.F90:YDATA_ISBA%LDATA_RSMIN(:) = .FALSE.
+modd_isban.F90:REAL, POINTER, DIMENSION(:) :: XRSMIN ! minimum stomatal resistance (s/m)
+modd_isban.F90:NULLIFY(YISBA_PE%XRSMIN)
+modd_reprod_oper.F90:!XEVERG_RSMIN : old = 250. (Manzi 1993) but observations range
+modd_reprod_oper.F90:REAL :: XEVERG_RSMIN
+mode_teb_veg.F90: PEK%XRSMIN(:)=40.
+pgd_isba_par.F90:REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_RSMIN ! minimal stomatal resistance
+pgd_isba_par.F90: CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_RSMIN ! minimal stomatal resistance
+pgd_isba_par.F90: CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_RSMIN ! minimal stomatal resistance
+pgd_isba_par.F90: XUNIF_RSMIN, XUNIF_GAMMA, XUNIF_WRMAX_CF, XUNIF_RGL, &
+pgd_isba_par.F90: CFNAM_VEG,CFNAM_LAI,CFNAM_RSMIN,CFNAM_GAMMA,CFNAM_WRMAX_CF, &
+pgd_isba_par.F90: CFTYP_VEG,CFTYP_LAI,CFTYP_RSMIN,CFTYP_GAMMA,CFTYP_WRMAX_CF, &
+pgd_isba_par.F90:XUNIF_RSMIN = XUNDEF ! minimal stomatal resistance
+pgd_isba_par.F90:CFNAM_RSMIN (:) = ' '
+pgd_isba_par.F90:CFTYP_RSMIN (:) = ' '
+pgd_isba_par.F90:ALLOCATE(DTV%XPAR_RSMIN(KDIM,NVEGTYPE))
+pgd_isba_par.F90: HPROGRAM,'INV','RSMIN: minimal stomatal resistance','NAT',CFNAM_RSMIN, &
+pgd_isba_par.F90: CFTYP_RSMIN,XUNIF_RSMIN,DTV%XPAR_RSMIN,DTV%LDATA_RSMIN)
+pgd_isba_par.F90:IF (ALL(.NOT.DTV%LDATA_RSMIN)) DEALLOCATE(DTV%XPAR_RSMIN)
+pgd_isba_par.F90:IF (.NOT.IO%LECOCLIMAP .AND. .NOT.(ANY(DTV%LDATA_RSMIN).AND.ANY(DTV%LDATA_GAMMA).AND.ANY(DTV%LDATA_WRMAX_CF).AND.&
+pgd_isba_par.F90: IF (ALL(.NOT.DTV%LDATA_RSMIN )) WRITE(ILUOUT,*) '* for RSMIN *'
+read_pgd_isba_parn.F90: DTI%LDATA_RSMIN =.TRUE.
+read_pgd_isba_parn.F90: YRECFM='L_RSMIN'
+read_pgd_isba_parn.F90: CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_RSMIN(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+read_pgd_isba_parn.F90: IF (ANY(DTI%LDATA_RSMIN)) DTI%LDATA_MIXPAR = .TRUE.
+read_pgd_isba_parn.F90: IF (ANY(DTI%LDATA_RSMIN)) THEN
+read_pgd_isba_parn.F90: ALLOCATE(DTI%XPAR_RSMIN (KDIM,NVEGTYPE))
+read_pgd_isba_parn.F90: YRECFM='D_RSMIN_'
+read_pgd_isba_parn.F90: YRECFM='D_RSMIN'
+read_pgd_isba_parn.F90: IVERSION, IBUGFIX, DTI%LDATA_RSMIN,DTI%XPAR_RSMIN(:,:),IRESP,&
+read_pgd_teb_garden_parn.F90:USE MODD_REPROD_OPER, ONLY : XEVERG_RSMIN
+read_pgd_teb_garden_parn.F90:REAL, DIMENSION(KDIM,3) :: ZDATA_RSMIN
+read_pgd_teb_garden_parn.F90:ALLOCATE(DTV%XPAR_RSMIN (KDIM,1))
+read_pgd_teb_garden_parn.F90:DTV%XPAR_RSMIN (:,:) = XUNDEF
+read_pgd_teb_garden_parn.F90: ZDATA_RSMIN(JI,:)= 40.
+read_pgd_teb_garden_parn.F90: IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_RSMIN(JI,1)= 150.
+read_pgd_teb_garden_parn.F90: IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_RSMIN(JI,1)= 150.
+read_pgd_teb_garden_parn.F90: IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_RSMIN(JI,1)= 150.
+read_pgd_teb_garden_parn.F90: IF(DTV%XPAR_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_RSMIN(JI,1)= 150.
+read_pgd_teb_garden_parn.F90: IF(DTV%XPAR_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_RSMIN(JI,1)= 150.
+read_pgd_teb_garden_parn.F90: IF(DTV%XPAR_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_RSMIN(JI,1)= 150.
+read_pgd_teb_garden_parn.F90: IF(DTV%XPAR_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_RSMIN(JI,1)= 150.
+read_pgd_teb_garden_parn.F90: IF(DTV%XPAR_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_RSMIN(JI,1)= 150.
+read_pgd_teb_garden_parn.F90: IF (DTV%XPAR_VEGTYPE(JI,NVT_FLTR)>0.) ZDATA_RSMIN(JI,1) = 150.
+read_pgd_teb_garden_parn.F90: IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_RSMIN(JI,1)= XEVERG_RSMIN
+read_pgd_teb_garden_parn.F90: IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) ZDATA_RSMIN(JI,2)= 120.
+read_pgd_teb_garden_parn.F90: IF(DTV%XPAR_VEGTYPE(JI,NVT_C4 )>0. ) ZDATA_RSMIN(JI,2)= 120.
+read_pgd_teb_garden_parn.F90: DTV%XPAR_RSMIN(JI,1) = ( ZDATA_RSMIN(JI,1)*DTV%XPAR_FRAC_HVEG(JI) &
+read_pgd_teb_garden_parn.F90: + ZDATA_RSMIN(JI,2)*DTV%XPAR_FRAC_LVEG(JI) ) &
+read_pgd_teb_greenroof_parn.F90:ALLOCATE(DTV%XPAR_RSMIN (KDIM,1))
+read_pgd_teb_greenroof_parn.F90:DTV%XPAR_RSMIN (:,:) = XUNDEF
+read_pgd_teb_greenroof_parn.F90: !IF(XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) XPAR_RSMIN(JI)= 40 (dans isba & garden)
+read_pgd_teb_greenroof_parn.F90: IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTV%XPAR_RSMIN(JI,:)= 120 ! for GRASS
+read_pgd_teb_greenroof_parn.F90: IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTV%XPAR_RSMIN(JI,:)= 150. ! for SEDUM
+read_pgd_teb_greenroof_parn.F90: !IF(XPAR_VEGTYPE(JI,NVT_TROG)>0. ) XPAR_RSMIN(JI)= 120.
+vegetation_update.F90: PEK%XRSMIN (:) = 40.
+veg.F90:SUBROUTINE VEG( PSW_RAD, PTA, PQA, PPS, PRGL, PLAI, PRSMIN, &
+veg.F90:REAL, DIMENSION(:), INTENT(IN) :: PRGL, PLAI, PRSMIN, PGAMMA
+veg.F90:! PRSMIN = minimum surface resistance
+veg.F90:ZF1(:) = ( ZF(:) + PRSMIN(:)/XRS_MAX) /( 1. + ZF(:) )
+veg.F90:PRS(:) = PRSMIN(:) / ( PLAI(:)+ XDENOM_MIN ) &
+write_cover_tex_isba.F90:USE MODD_REPROD_OPER, ONLY : XEVERG_VEG, XEVERG_RSMIN
+write_cover_tex_isba.F90: IF(XEVERG_RSMIN==250.)THEN
+write_cover_tex_isba.F90: IF(XEVERG_RSMIN==250.)THEN
+write_cover_tex_isba_par.F90:REAL, DIMENSION(JPCOVER,KPATCH ) :: ZRSMIN,ZGAMMA,ZRGL,ZCV, &
+write_cover_tex_isba_par.F90: PRSMIN=ZRSMIN,PGAMMA=ZGAMMA,PWRMAX_CF=ZWRMAX_CF, &
+write_cover_tex_isba_par.F90: ZRSMIN(JI,JPATCH) = NINT(ZRSMIN(JI,JPATCH))
+write_cover_tex_isba_par.F90: WRITE(YFMT,'(A2,I1,A1,I1,A1)') '(F',NB(ZRSMIN(JI,JPATCH)),'.',DEC(ZRSMIN(JI,JPATCH)),')'
+write_cover_tex_isba_par.F90: WRITE(YSTRING6, FMT=YFMT) ZRSMIN(JI,JPATCH)
+write_diag_pgd_grdnn.F90:YRECFM='GD_RSMIN'
+write_diag_pgd_grdnn.F90: CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,PEK%XRSMIN(:),IRESP,HCOMMENT=YCOMMENT)
+write_diag_pgd_grdnn.F90:YCOMMENT='coefficient for RSMIN calculation (-)'
+write_diag_pgd_isban.F90:YRECFM='RSMIN'
+write_diag_pgd_isban.F90: NP%AL(JP)%NR_P,NPE%AL(JP)%XRSMIN(:),ILU,S%XWORK_WR)
+write_diag_pgd_isban.F90:YCOMMENT='coefficient for RSMIN calculation (-)'
+writesurf_pgd_isba_parn.F90:YRECFM='L_RSMIN'
+writesurf_pgd_isba_parn.F90: CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DTV%LDATA_RSMIN,IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+writesurf_pgd_isba_parn.F90:YCOMMENT='X_Y_D_RSMIN'
+writesurf_pgd_isba_parn.F90: IF (DTV%LDATA_RSMIN(JV)) THEN
+writesurf_pgd_isba_parn.F90: WRITE(YRECFM,FMT='(A9,I2.2)') 'D_RSMIN_V',JV
+writesurf_pgd_isba_parn.F90: CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DTV%XPAR_RSMIN(:,JV),IRESP,HCOMMENT=YCOMMENT)
diff --git a/src/SURFEX/ini_data_cover.F90 b/src/SURFEX/ini_data_cover.F90
index 3f442bcc1a05376a0ebf9de081e6d192addaaa36..16723ac75cf689026c490ba500b1ebc1320d45b7 100644
--- a/src/SURFEX/ini_data_cover.F90
+++ b/src/SURFEX/ini_data_cover.F90
@@ -72,7 +72,6 @@ USE MODD_DATA_COVER, ONLY : XDATA_TOWN, XDATA_NATURE, XDATA_SEA, XDATA_WATER
XDATA_EMIS_ECO, XDATA_WRMAX_CF, &
XDATA_CE_NITRO,XDATA_CF_NITRO,XDATA_CNA_NITRO, &
XDATA_GROUND_DEPTH, XDATA_ROOT_DEPTH, &
- XDATA_ROOT_DEPTHGV, &
XDATA_ROOT_EXTINCTION, XDATA_ROOT_LIN, &
XDATA_SOILRC_SO2, XDATA_SOILRC_O3, &
XDATA_Z0_TOWN, XDATA_Z0H_TOWN, XDATA_ALB_ROOF, &
@@ -102,20 +101,21 @@ USE MODD_DATA_COVER, ONLY : XDATA_TOWN, XDATA_NATURE, XDATA_SEA, XDATA_WATER
XDATA_ROUGH_WALL, XDATA_FRAC_GR,XDATA_RESIDENTIAL,&
XDATA_EMIS_PANEL, XDATA_ALB_PANEL, &
XDATA_EFF_PANEL, XDATA_FRAC_PANEL, &
- XDATA_GNDLITTER, &
- XDATA_RGLGV, XDATA_GAMMAGV, XDATA_RSMINGV, &
- XDATA_ROOT_EXTINCTIONGV, XDATA_WRMAX_CFGV, &
- XDATA_LAIGV, XDATA_Z0LITTER, XDATA_H_VEG
+ XDATA_GNDLITTER, XDATA_Z0LITTER, XDATA_H_VEG
!
-USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, NVT_NO, NVT_ROCK, NVT_SNOW, &
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, NVEGTYPE_OLD, NVEGTYPE_ECOSG, &
+ NVT_NO, NVT_ROCK, NVT_SNOW, &
NVT_TEBD, NVT_BONE, NVT_TRBE, NVT_C3, &
NVT_C4, NVT_IRR, NVT_GRAS, NVT_TROG, &
NVT_PARK, NVT_TRBD, NVT_TEBE, NVT_TENE, &
NVT_BOBD, NVT_BOND, NVT_BOGR, NVT_SHRB, &
- JPCOVER, NDATA_ROAD_LAYER, &
+ JPCOVER, NCOVER, NTYPE, NDATA_ROAD_LAYER, &
NDATA_WALL_LAYER, NDATA_ROOF_LAYER, &
NDATA_FLOOR_LAYER, CNAMES, NBARE_SOIL, &
- NROCK, NSEA, NWATER, NPERMSNOW
+ NROCK, NSEA, NWATER, NPERMSNOW, NUT_CPHR, &
+ NUT_CPMR, NUT_CPLR, NUT_OPHR, NUT_OPMR, &
+ NUT_OPLR, NUT_LWLR, NUT_LALR, NUT_SPAR, &
+ NUT_INDU, NVT_C3W, NVT_C3S, NVT_FLTR, NVT_FLGR
!
USE MODD_WRITE_COVER_TEX,ONLY : CNAME, CLANG
!
@@ -123,6 +123,7 @@ USE MODD_WRITE_COVER_TEX,ONLY : CNAME, CLANG
USE MODE_POS_SURF
!
USE MODI_READ_COVERS_PARAM
+USE MODI_INIT_TYPES_PARAM
!
USE MODI_ABOR1_SFX
!
@@ -191,11 +192,9 @@ TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!* 0.2 Declaration of local variables
! ------------------------------
!
-INTEGER :: JCOVER, JVEGTYPE ! loop counters on covers and decades
+INTEGER :: JCOV, JVEG, JDEC ! loop counters on covers and decades
INTEGER :: ICPT_SEA, ICPT_WATER
!
-!
-integer :: j
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.3 Declaration of namelists
@@ -205,9 +204,48 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('INI_DATA_COVER',0,ZHOOK_HANDLE)
!
-IF (IDC==0) THEN
+IF (U%LECOSG) THEN
+ JPCOVER = SUM(NTYPE)
+ELSE
+ JPCOVER = NCOVER
+ENDIF
+!
+IF (ALLOCATED(XDATA_TOWN)) THEN
+ IF (SIZE(XDATA_TOWN)/=JPCOVER) THEN
+ IDC = 0
+ DEALLOCATE(XDATA_TOWN,XDATA_GARDEN,XDATA_NATURE,XDATA_WATER,XDATA_SEA)
+ DEALLOCATE(XDATA_LAI,XDATA_LAI_ALL_YEARS,XDATA_VEGTYPE)
+ DEALLOCATE(XDATA_H_TREE,XDATA_GROUND_DEPTH,XDATA_ROOT_DEPTH,XDATA_DICE)
+ DEALLOCATE(XDATA_ROOT_EXTINCTION,XDATA_ROOT_LIN)
+ DEALLOCATE(XDATA_ALBNIR_VEG,XDATA_ALBVIS_VEG,XDATA_ALBUV_VEG)
+ DEALLOCATE(XDATA_ALB_VEG_VIS,XDATA_ALB_VEG_NIR,XDATA_ALB_SOIL_VIS,XDATA_ALB_SOIL_NIR)
+ DEALLOCATE(XDATA_RSMIN,XDATA_GAMMA,XDATA_WRMAX_CF,XDATA_RGL,XDATA_CV)
+ DEALLOCATE(XDATA_GMES,XDATA_GMES_ST,XDATA_RE25,XDATA_GC,XDATA_GC_ST)
+ DEALLOCATE(XDATA_F2I,XDATA_BSLAI,XDATA_BSLAI_ST,XDATA_DMAX,XDATA_DMAX_ST,XDATA_STRESS)
+ DEALLOCATE(XDATA_SEFOLD,XDATA_SEFOLD_ST,XDATA_LAIMIN,XDATA_VEG,XDATA_GREEN)
+ DEALLOCATE(XDATA_Z0,XDATA_Z0_O_Z0H,XDATA_EMIS_ECO,XDATA_SOILRC_SO2,XDATA_SOILRC_O3)
+ DEALLOCATE(XDATA_CE_NITRO,XDATA_CF_NITRO,XDATA_CNA_NITRO,TDATA_SEED,TDATA_REAP)
+ DEALLOCATE(XDATA_IRRIG,XDATA_WATSUP,XDATA_GNDLITTER,XDATA_Z0LITTER,XDATA_H_VEG)
+ DEALLOCATE(XDATA_Z0_TOWN,XDATA_ALB_ROOF,XDATA_ALB_ROAD,XDATA_ALB_WALL)
+ DEALLOCATE(XDATA_EMIS_ROOF,XDATA_EMIS_ROAD,XDATA_EMIS_WALL)
+ DEALLOCATE(XDATA_HC_ROOF,XDATA_HC_ROAD,XDATA_HC_WALL,XDATA_HC_FLOOR)
+ DEALLOCATE(XDATA_TC_ROOF,XDATA_TC_ROAD,XDATA_TC_WALL,XDATA_TC_FLOOR)
+ DEALLOCATE(XDATA_D_ROOF,XDATA_D_ROAD,XDATA_D_WALL,XDATA_D_FLOOR)
+ DEALLOCATE(XDATA_BLD_HEIGHT,XDATA_WALL_O_HOR,XDATA_BLD,XDATA_CAN_HW_RATIO)
+ DEALLOCATE(XDATA_H_TRAFFIC,XDATA_LE_TRAFFIC,XDATA_H_INDUSTRY,XDATA_LE_INDUSTRY)
+ DEALLOCATE(XDATA_TCOOL_TARGET,XDATA_THEAT_TARGET,XDATA_F_WASTE_CAN)
+ DEALLOCATE(XDATA_EFF_HEAT,XDATA_QIN,XDATA_QIN_FRAD,XDATA_SHGC,XDATA_U_WIN,XDATA_GR)
+ DEALLOCATE(XDATA_SHGC_SH,XDATA_FLOOR_HEIGHT,XDATA_INF,XDATA_F_WATER_COND)
+ DEALLOCATE(XDATA_QIN_FLAT,XDATA_HR_TARGET,XDATA_V_VENT,XDATA_CAP_SYS_HEAT)
+ DEALLOCATE(XDATA_CAP_SYS_RAT,XDATA_T_ADP,XDATA_M_SYS_RAT,XDATA_COP_RAT)
+ DEALLOCATE(XDATA_T_SIZE_MAX,XDATA_T_SIZE_MIN,XDATA_SHADE,XDATA_NATVENT)
+ DEALLOCATE(XDATA_ROUGH_ROOF,XDATA_ROUGH_WALL,XDATA_RESIDENTIAL,XDATA_FRAC_GR)
+ DEALLOCATE(XDATA_EMIS_PANEL,XDATA_ALB_PANEL,XDATA_EFF_PANEL,XDATA_FRAC_PANEL)
+ DEALLOCATE(NSEA,NWATER,CNAMES,CNAME)
+ ENDIF
+ENDIF
!
-!$OMP SINGLE
+IF (IDC==0) THEN
!
!* 1.1 artificial surfaces fraction
! ----------------------------
@@ -255,29 +293,59 @@ XDATA_SEA = 0.
!
!* 2.0 vegetation type fractions
!
-NVEGTYPE = 19
-!
!New name N Nold Comments
!-----------------------------
-NVT_NO = 1 ! 1 ! no vegetation (smooth)
-NVT_ROCK = 2 ! 2 ! no vegetation (rocks)
-NVT_SNOW = 3 ! 3 ! permanent snow and ice
-NVT_TEBD = 4 ! 4 ! temperate broadleaf cold-deciduous summergreen (TREE)
-NVT_BONE = 5 ! 5 ! boreal needleleaf evergreen (CONI)
-NVT_TRBE = 6 ! 6 ! tropical broadleaf evergreen (EVER)
-NVT_C3 = 7 ! 7 ! C3 cultures types
-NVT_C4 = 8 ! 8 ! C4 cultures types
-NVT_IRR = 9 ! 9 ! irrigated crops
-NVT_GRAS =10 !10 ! grassland
-NVT_TROG =11 !11 ! tropical grassland
-NVT_PARK =12 !12 ! peat bogs, parks and gardens (irrigated grass)
-NVT_TRBD =13 ! 4 ! tropical broadleaf deciduous (TREE)
-NVT_TEBE =14 ! 4 ! temperate broadleaf evergreen (TREE)
-NVT_TENE =15 ! 5 ! temperate needleleaf evergreen (CONI)
-NVT_BOBD =16 ! 4 ! boreal broadleaf cold-deciduous summergreen (TREE)
-NVT_BOND =17 ! 5 ! boreal needleleaf cold-deciduous summergreen (CONI)
-NVT_BOGR =18 !10 ! boreal grass (GRAS)
-NVT_SHRB =19 ! 4 ! shrub (TREE)
+IF (U%LECOSG) THEN
+ NVEGTYPE = NVEGTYPE_ECOSG
+ NVT_C3 = 0
+ NVT_PARK = 0
+ NVT_IRR = 0
+ NVT_NO = 1 ! 1 ! no vegetation (smooth)
+ NVT_ROCK = 2 ! 2 ! no vegetation (rocks)
+ NVT_SNOW = 3 ! 3 ! permanent snow and ice
+ NVT_BOBD = 4 ! 4 ! boreal broadleaf cold-deciduous summergreen (TREE)
+ NVT_TEBD = 5 ! 4 ! temperate broadleaf cold-deciduous summergreen (TREE)
+ NVT_TRBD = 6 ! 4 ! tropical broadleaf deciduous (TREE)
+ NVT_TEBE = 7 ! 4 ! temperate broadleaf evergreen (TREE)
+ NVT_TRBE = 8 ! 6 ! tropical broadleaf evergreen (EVER)
+ NVT_BONE = 9 ! 5 ! boreal needleleaf evergreen (CONI)
+ NVT_TENE =10 ! 5 ! temperate needleleaf evergreen (CONI)
+ NVT_BOND =11 ! 5 ! boreal needleleaf cold-deciduous summergreen (CONI)
+ NVT_SHRB =12 ! 4 ! shrub (TREE)
+ NVT_BOGR =13 !10 ! boreal grass (GRAS)
+ NVT_GRAS =14 !10 ! grassland
+ NVT_TROG =15 !11 ! tropical grassland
+ NVT_C3W =16 ! 7 ! C3W cultures types
+ NVT_C3S =17 ! 7 ! C3S cultures types
+ NVT_C4 =18 ! 8 ! C4 cultures types
+ NVT_FLTR =19 !12 ! flooded trees
+ NVT_FLGR =20 !12 ! flooded grassland
+ELSE
+ NVEGTYPE = NVEGTYPE_OLD
+ NVT_C3W = 0
+ NVT_C3S = 0
+ NVT_FLTR = 0
+ NVT_FLGR = 0
+ NVT_NO = 1 ! 1 ! no vegetation (smooth)
+ NVT_ROCK = 2 ! 2 ! no vegetation (rocks)
+ NVT_SNOW = 3 ! 3 ! permanent snow and ice
+ NVT_TEBD = 4 ! 4 ! temperate broadleaf cold-deciduous summergreen (TREE)
+ NVT_BONE = 5 ! 5 ! boreal needleleaf evergreen (CONI)
+ NVT_TRBE = 6 ! 6 ! tropical broadleaf evergreen (EVER)
+ NVT_C3 = 7 ! 7 ! C3 cultures types
+ NVT_C4 = 8 ! 8 ! C4 cultures types
+ NVT_IRR = 9 ! 9 ! irrigated crops
+ NVT_GRAS =10 !10 ! grassland
+ NVT_TROG =11 !11 ! tropical grassland
+ NVT_PARK =12 !12 ! peat bogs, parks and gardens (irrigated grass)
+ NVT_TRBD =13 ! 4 ! tropical broadleaf deciduous (TREE)
+ NVT_TEBE =14 ! 4 ! temperate broadleaf evergreen (TREE)
+ NVT_TENE =15 ! 5 ! temperate needleleaf evergreen (CONI)
+ NVT_BOBD =16 ! 4 ! boreal broadleaf cold-deciduous summergreen (TREE)
+ NVT_BOND =17 ! 5 ! boreal needleleaf cold-deciduous summergreen (CONI)
+ NVT_BOGR =18 !10 ! boreal grass (GRAS)
+ NVT_SHRB =19 ! 4 ! shrub (TREE)
+ENDIF
!
!* 2.1 leaf area index
! ---------------
@@ -321,11 +389,8 @@ XDATA_GROUND_DEPTH(:,:) = XUNDEF
! ----------
!
ALLOCATE(XDATA_ROOT_DEPTH(JPCOVER,NVEGTYPE))
-XDATA_ROOT_DEPTH(:,:) = XUNDEF
!
-!
-ALLOCATE(XDATA_ROOT_DEPTHGV(JPCOVER,NVEGTYPE))
-XDATA_ROOT_DEPTHGV(:,:) = XUNDEF
+XDATA_ROOT_DEPTH(:,:) = XUNDEF
!
!-------------------------------------------------------------------------------
!
@@ -665,24 +730,6 @@ XDATA_WATSUP (:,:) = 0.
!* 2.26 For multi-energy balance (MEB)
! ------------------------------
!
-ALLOCATE(XDATA_RGLGV(JPCOVER,NVEGTYPE))
-XDATA_RGLGV (:,:) = XUNDEF
-!
-ALLOCATE(XDATA_GAMMAGV(JPCOVER,NVEGTYPE))
-XDATA_GAMMAGV (:,:) = XUNDEF
-!
-ALLOCATE(XDATA_RSMINGV(JPCOVER,NVEGTYPE))
-XDATA_RSMINGV (:,:) = XUNDEF
-!
-ALLOCATE(XDATA_ROOT_EXTINCTIONGV(JPCOVER,NVEGTYPE))
-XDATA_ROOT_EXTINCTIONGV (:,:) = XUNDEF
-!
-ALLOCATE(XDATA_WRMAX_CFGV(JPCOVER,NVEGTYPE))
-XDATA_WRMAX_CFGV (:,:) = XUNDEF
-!
-ALLOCATE(XDATA_LAIGV(JPCOVER,36,NVEGTYPE))
-XDATA_LAIGV (:,:,:) = XUNDEF
-!
ALLOCATE(XDATA_GNDLITTER(JPCOVER,36,NVEGTYPE))
XDATA_GNDLITTER (:,:,:) = XUNDEF
!
@@ -694,6 +741,17 @@ XDATA_H_VEG (:,:,:) = XUNDEF
!
!-------------------------------------------------------------------------------
!
+NUT_CPHR = SUM(NTYPE(1:3)) + 1
+NUT_CPMR = SUM(NTYPE(1:3)) + 2
+NUT_CPLR = SUM(NTYPE(1:3)) + 3
+NUT_OPHR = SUM(NTYPE(1:3)) + 4
+NUT_OPMR = SUM(NTYPE(1:3)) + 5
+NUT_OPLR = SUM(NTYPE(1:3)) + 6
+NUT_LWLR = SUM(NTYPE(1:3)) + 7
+NUT_LALR = SUM(NTYPE(1:3)) + 8
+NUT_SPAR = SUM(NTYPE(1:3)) + 9
+NUT_INDU = SUM(NTYPE(1:3)) + 10
+!
!* 3.1 z0 for artificial surfaces
! --------------------------
!
@@ -961,13 +1019,22 @@ XDATA_FRAC_PANEL (:) = XUNDEF
!
!* Global data set
!
-
-!
-IF (LREAD_DATA_COVER) THEN
+IF (U%LECOSG) THEN
+ CALL INIT_TYPES_PARAM
+ELSEIF (LREAD_DATA_COVER) THEN
CALL READ_COVERS_PARAM(1)
ELSE
- CALL DEFAULT_DATA_COVER
-!
+ CALL DEFAULT_DATA_COVER(XDATA_TOWN,XDATA_NATURE,XDATA_WATER,XDATA_SEA, &
+ XDATA_Z0_TOWN,XDATA_BLD_HEIGHT,XDATA_WALL_O_HOR,XDATA_BLD,XDATA_GARDEN,&
+ XDATA_ALB_ROOF,XDATA_ALB_ROAD,XDATA_ALB_WALL,XDATA_EMIS_ROOF, &
+ XDATA_EMIS_ROAD,XDATA_EMIS_WALL,XDATA_HC_ROOF,XDATA_TC_ROOF, &
+ XDATA_D_ROOF,XDATA_HC_ROAD,XDATA_TC_ROAD,XDATA_D_ROAD, &
+ XDATA_HC_WALL,XDATA_TC_WALL,XDATA_D_WALL,XDATA_H_TRAFFIC, &
+ XDATA_LE_TRAFFIC,XDATA_H_INDUSTRY,XDATA_LE_INDUSTRY, &
+ XDATA_VEGTYPE,XDATA_H_TREE,XDATA_WATSUP,XDATA_IRRIG, &
+ XDATA_ROOT_DEPTH,XDATA_GROUND_DEPTH,XDATA_DICE,TDATA_SEED, &
+ TDATA_REAP)
+ !
CALL DEFAULT_LAI_ECO1_01
CALL DEFAULT_LAI_ECO1_02
CALL DEFAULT_LAI_ECO1_03
@@ -987,10 +1054,10 @@ ELSE
CALL DEFAULT_LAI_ECO1_17
CALL DEFAULT_LAI_ECO1_18
CALL DEFAULT_LAI_ECO1_19
-!
+ !
CALL DEFAULT_ALB_SOIL_ECO1
CALL DEFAULT_ALB_SOIL_ECO2
-!
+ !
CALL DEFAULT_ALB_VEG_ECO1_01
CALL DEFAULT_ALB_VEG_ECO1_02
CALL DEFAULT_ALB_VEG_ECO1_03
@@ -1010,104 +1077,289 @@ ELSE
CALL DEFAULT_ALB_VEG_ECO1_17
CALL DEFAULT_ALB_VEG_ECO1_18
CALL DEFAULT_ALB_VEG_ECO1_19
-!
ENDIF
!
- CALL COVER301_573
+IF (.NOT.U%LECOSG) CALL COVER301_573
!
!-------------------------------------------------------------------------------
!
-!For one cover, the soil albedo from CM13 is the same for each vegtype
-DO JVEGTYPE=2,NVEGTYPE
- DO JCOVER = 1, JPCOVER
- XDATA_ALB_SOIL_NIR(JCOVER,:,JVEGTYPE) = XDATA_ALB_SOIL_NIR(JCOVER,:,1)
- XDATA_ALB_SOIL_VIS(JCOVER,:,JVEGTYPE) = XDATA_ALB_SOIL_VIS(JCOVER,:,1)
- ENDDO
-ENDDO
+!default values for ECOSG
+IF (U%LECOSG) THEN
+
+ !lai
+ DO JDEC = 1,SIZE(XDATA_LAI,2)
+ WHERE(XDATA_VEGTYPE(:,1)>0.) XDATA_LAI(:,JDEC,1) = 0.
+ WHERE(XDATA_VEGTYPE(:,2)>0.) XDATA_LAI(:,JDEC,2) = 0.
+ WHERE(XDATA_VEGTYPE(:,3)>0.) XDATA_LAI(:,JDEC,3) = 0.
+ WHERE(XDATA_VEGTYPE(:,4)>0.) XDATA_LAI(:,JDEC,4) = 4.
+ WHERE(XDATA_VEGTYPE(:,5)>0.) XDATA_LAI(:,JDEC,5) = 4.
+ WHERE(XDATA_VEGTYPE(:,6)>0.) XDATA_LAI(:,JDEC,6) = 4.
+ WHERE(XDATA_VEGTYPE(:,7)>0.) XDATA_LAI(:,JDEC,7) = 4.
+ WHERE(XDATA_VEGTYPE(:,8)>0.) XDATA_LAI(:,JDEC,8) = 4.
+ WHERE(XDATA_VEGTYPE(:,9)>0.) XDATA_LAI(:,JDEC,9) = 4.
+ WHERE(XDATA_VEGTYPE(:,10)>0.) XDATA_LAI(:,JDEC,10) = 4.
+ WHERE(XDATA_VEGTYPE(:,11)>0.) XDATA_LAI(:,JDEC,11) = 4.
+ WHERE(XDATA_VEGTYPE(:,12)>0.) XDATA_LAI(:,JDEC,12) = 4.
+ WHERE(XDATA_VEGTYPE(:,13)>0.) XDATA_LAI(:,JDEC,13) = 4.
+ WHERE(XDATA_VEGTYPE(:,14)>0.) XDATA_LAI(:,JDEC,14) = 3.
+ WHERE(XDATA_VEGTYPE(:,15)>0.) XDATA_LAI(:,JDEC,15) = 3.
+ WHERE(XDATA_VEGTYPE(:,16)>0.) XDATA_LAI(:,JDEC,16) = 2.
+ WHERE(XDATA_VEGTYPE(:,17)>0.) XDATA_LAI(:,JDEC,17) = 2.
+ WHERE(XDATA_VEGTYPE(:,18)>0.) XDATA_LAI(:,JDEC,18) = 2.
+ WHERE(XDATA_VEGTYPE(:,19)>0.) XDATA_LAI(:,JDEC,19) = 4.
+ WHERE(XDATA_VEGTYPE(:,20)>0.) XDATA_LAI(:,JDEC,20) = 3.
+ ENDDO
+
+ !root_depth
+ WHERE(XDATA_VEGTYPE(:,1)>0.) XDATA_ROOT_DEPTH(:,1) = 0.5
+ WHERE(XDATA_VEGTYPE(:,2)>0.) XDATA_ROOT_DEPTH(:,2) = 0.2
+ WHERE(XDATA_VEGTYPE(:,3)>0.) XDATA_ROOT_DEPTH(:,3) = 0.2
+ WHERE(XDATA_VEGTYPE(:,4)>0.) XDATA_ROOT_DEPTH(:,4) = 2.0
+ WHERE(XDATA_VEGTYPE(:,5)>0.) XDATA_ROOT_DEPTH(:,5) = 2.0
+ WHERE(XDATA_VEGTYPE(:,6)>0.) XDATA_ROOT_DEPTH(:,6) = 3.0
+ WHERE(XDATA_VEGTYPE(:,7)>0.) XDATA_ROOT_DEPTH(:,7) = 2.0
+ WHERE(XDATA_VEGTYPE(:,8)>0.) XDATA_ROOT_DEPTH(:,8) = 5.0
+ WHERE(XDATA_VEGTYPE(:,9)>0.) XDATA_ROOT_DEPTH(:,9) = 2.0
+ WHERE(XDATA_VEGTYPE(:,10)>0.) XDATA_ROOT_DEPTH(:,10) = 2.0
+ WHERE(XDATA_VEGTYPE(:,11)>0.) XDATA_ROOT_DEPTH(:,11) = 2.0
+ WHERE(XDATA_VEGTYPE(:,12)>0.) XDATA_ROOT_DEPTH(:,12) = 2.0
+ WHERE(XDATA_VEGTYPE(:,13)>0.) XDATA_ROOT_DEPTH(:,13) = 1.0
+ WHERE(XDATA_VEGTYPE(:,14)>0.) XDATA_ROOT_DEPTH(:,14) = 1.0
+ WHERE(XDATA_VEGTYPE(:,15)>0.) XDATA_ROOT_DEPTH(:,15) = 1.5
+ WHERE(XDATA_VEGTYPE(:,16)>0.) XDATA_ROOT_DEPTH(:,16) = 1.5
+ WHERE(XDATA_VEGTYPE(:,17)>0.) XDATA_ROOT_DEPTH(:,17) = 1.5
+ WHERE(XDATA_VEGTYPE(:,18)>0.) XDATA_ROOT_DEPTH(:,18) = 1.5
+ WHERE(XDATA_VEGTYPE(:,19)>0.) XDATA_ROOT_DEPTH(:,19) = 2.0
+ WHERE(XDATA_VEGTYPE(:,20)>0.) XDATA_ROOT_DEPTH(:,20) = 1.0
+
+ !soil_depth
+ WHERE(XDATA_VEGTYPE(:,1)>0.) XDATA_GROUND_DEPTH(:,1) = 1.0
+ WHERE(XDATA_VEGTYPE(:,2)>0.) XDATA_GROUND_DEPTH(:,2) = 0.2
+ WHERE(XDATA_VEGTYPE(:,3)>0.) XDATA_GROUND_DEPTH(:,3) = 0.2
+ WHERE(XDATA_VEGTYPE(:,4)>0.) XDATA_GROUND_DEPTH(:,4) = 3.0
+ WHERE(XDATA_VEGTYPE(:,5)>0.) XDATA_GROUND_DEPTH(:,5) = 3.0
+ WHERE(XDATA_VEGTYPE(:,6)>0.) XDATA_GROUND_DEPTH(:,6) = 3.0
+ WHERE(XDATA_VEGTYPE(:,7)>0.) XDATA_GROUND_DEPTH(:,7) = 3.0
+ WHERE(XDATA_VEGTYPE(:,8)>0.) XDATA_GROUND_DEPTH(:,8) = 8.0
+ WHERE(XDATA_VEGTYPE(:,9)>0.) XDATA_GROUND_DEPTH(:,9) = 3.0
+ WHERE(XDATA_VEGTYPE(:,10)>0.) XDATA_GROUND_DEPTH(:,10) = 3.0
+ WHERE(XDATA_VEGTYPE(:,11)>0.) XDATA_GROUND_DEPTH(:,11) = 3.0
+ WHERE(XDATA_VEGTYPE(:,12)>0.) XDATA_GROUND_DEPTH(:,12) = 3.0
+ WHERE(XDATA_VEGTYPE(:,13)>0.) XDATA_GROUND_DEPTH(:,13) = 1.5
+ WHERE(XDATA_VEGTYPE(:,14)>0.) XDATA_GROUND_DEPTH(:,14) = 1.5
+ WHERE(XDATA_VEGTYPE(:,15)>0.) XDATA_GROUND_DEPTH(:,15) = 2.0
+ WHERE(XDATA_VEGTYPE(:,16)>0.) XDATA_GROUND_DEPTH(:,16) = 2.0
+ WHERE(XDATA_VEGTYPE(:,17)>0.) XDATA_GROUND_DEPTH(:,17) = 2.0
+ WHERE(XDATA_VEGTYPE(:,18)>0.) XDATA_GROUND_DEPTH(:,18) = 2.0
+ WHERE(XDATA_VEGTYPE(:,19)>0.) XDATA_GROUND_DEPTH(:,19) = 2.0
+ WHERE(XDATA_VEGTYPE(:,20)>0.) XDATA_GROUND_DEPTH(:,20) = 1.5
+
+ !height_trees
+ WHERE(XDATA_VEGTYPE(:,4)>0.) XDATA_H_TREE(:,4) = 15.0
+ WHERE(XDATA_VEGTYPE(:,5)>0.) XDATA_H_TREE(:,5) = 10.0
+ WHERE(XDATA_VEGTYPE(:,6)>0.) XDATA_H_TREE(:,6) = 30.0
+ WHERE(XDATA_VEGTYPE(:,7)>0.) XDATA_H_TREE(:,7) = 10.0
+ WHERE(XDATA_VEGTYPE(:,8)>0.) XDATA_H_TREE(:,8) = 30.0
+ WHERE(XDATA_VEGTYPE(:,9)>0.) XDATA_H_TREE(:,9) = 15.0
+ WHERE(XDATA_VEGTYPE(:,10)>0.) XDATA_H_TREE(:,10) = 10.0
+ WHERE(XDATA_VEGTYPE(:,11)>0.) XDATA_H_TREE(:,11) = 15.0
+ WHERE(XDATA_VEGTYPE(:,12)>0.) XDATA_H_TREE(:,12) = 1.0
+
+ !ice_depth
+ WHERE(XDATA_VEGTYPE(:,1)>0.) XDATA_DICE(:,1) = 0.5
+ WHERE(XDATA_VEGTYPE(:,2)>0.) XDATA_DICE(:,2) = 0.2
+ WHERE(XDATA_VEGTYPE(:,3)>0.) XDATA_DICE(:,3) = 0.2
+ WHERE(XDATA_VEGTYPE(:,4)>0.) XDATA_DICE(:,4) = 1.0
+ WHERE(XDATA_VEGTYPE(:,5)>0.) XDATA_DICE(:,5) = 1.5
+ WHERE(XDATA_VEGTYPE(:,6)>0.) XDATA_DICE(:,6) = 3.0
+ WHERE(XDATA_VEGTYPE(:,7)>0.) XDATA_DICE(:,7) = 2.0
+ WHERE(XDATA_VEGTYPE(:,8)>0.) XDATA_DICE(:,8) = 8.0
+ WHERE(XDATA_VEGTYPE(:,9)>0.) XDATA_DICE(:,9) = 1.0
+ WHERE(XDATA_VEGTYPE(:,10)>0.) XDATA_DICE(:,10) = 1.5
+ WHERE(XDATA_VEGTYPE(:,11)>0.) XDATA_DICE(:,11) = 0.3
+ WHERE(XDATA_VEGTYPE(:,12)>0.) XDATA_DICE(:,12) = 1.5
+ WHERE(XDATA_VEGTYPE(:,13)>0.) XDATA_DICE(:,13) = 0.3
+ WHERE(XDATA_VEGTYPE(:,14)>0.) XDATA_DICE(:,14) = 1.0
+ WHERE(XDATA_VEGTYPE(:,15)>0.) XDATA_DICE(:,15) = 1.5
+ WHERE(XDATA_VEGTYPE(:,16)>0.) XDATA_DICE(:,16) = 1.0
+ WHERE(XDATA_VEGTYPE(:,17)>0.) XDATA_DICE(:,17) = 1.2
+ WHERE(XDATA_VEGTYPE(:,18)>0.) XDATA_DICE(:,18) = 1.5
+ WHERE(XDATA_VEGTYPE(:,19)>0.) XDATA_DICE(:,19) = 1.5
+ WHERE(XDATA_VEGTYPE(:,20)>0.) XDATA_DICE(:,20) = 1.0
+
+ DO JCOV = 1,JPCOVER
+ DO JVEG = 1,NVEGTYPE
+ IF (XDATA_VEGTYPE(JCOV,JVEG)/=0.) THEN
+ !alb_soil_nir
+ XDATA_ALB_SOIL_NIR(JCOV,:,JVEG) = 0.3
+ !alb_soil_vis
+ XDATA_ALB_SOIL_VIS(JCOV,:,JVEG) = 0.1
+ !alb_veg_nir
+ XDATA_ALB_VEG_NIR(JCOV,:,JVEG) = 0.3
+ !alb_veg_vis
+ XDATA_ALB_VEG_VIS(JCOV,:,JVEG) = 0.1
+ ENDIF
+ ENDDO
+ ENDDO
+
+ WHERE(XDATA_TOWN(:)>0.)
+ XDATA_ALB_ROOF (:) = 0.15
+ XDATA_ALB_ROAD (:) = 0.08
+ XDATA_ALB_WALL (:) = 0.25
+ XDATA_EMIS_ROOF (:) = 0.90
+ XDATA_EMIS_ROAD (:) = 0.94
+ XDATA_EMIS_WALL (:) = 0.85
+ XDATA_HC_ROOF (:,1) = 2.11 * 1.E6
+ XDATA_HC_ROOF (:,2) = 0.28 * 1.E6
+ XDATA_HC_ROOF (:,3) = 0.29 * 1.E6
+ XDATA_TC_ROOF (:,1) = 1.5100
+ XDATA_TC_ROOF (:,2) = 0.0800
+ XDATA_TC_ROOF (:,3) = 0.0500
+ XDATA_D_ROOF (:,1) = 0.050
+ XDATA_D_ROOF (:,2) = 0.400
+ XDATA_D_ROOF (:,3) = 0.100
+ XDATA_HC_ROAD (:,1) = 1.94 * 1.E6
+ XDATA_HC_ROAD (:,2) = 1.28 * 1.E6
+ XDATA_HC_ROAD (:,3) = 1.28 * 1.E6
+ XDATA_TC_ROAD (:,1) = 0.7454
+ XDATA_TC_ROAD (:,2) = 0.2513
+ XDATA_TC_ROAD (:,3) = 0.2513
+ XDATA_D_ROAD (:,1) = 0.050
+ XDATA_D_ROAD (:,2) = 0.100
+ XDATA_D_ROAD (:,3) = 1.000
+ XDATA_HC_WALL (:,1) = 1.55 * 1.E6
+ XDATA_HC_WALL (:,2) = 1.55 * 1.E6
+ XDATA_HC_WALL (:,3) = 0.29 * 1.E6
+ XDATA_TC_WALL (:,1) = 0.9338
+ XDATA_TC_WALL (:,2) = 0.9338
+ XDATA_TC_WALL (:,3) = 0.0500
+ XDATA_D_WALL (:,1) = 0.020
+ XDATA_D_WALL (:,2) = 0.125
+ XDATA_D_WALL (:,3) = 0.050
+ XDATA_LE_TRAFFIC(:) = 0.
+ XDATA_LE_INDUSTRY(:)= 0.
+ END WHERE
+ !
+ WHERE(XDATA_VEGTYPE(:,8)>0.)
+ XDATA_WATSUP(:,8) = 0.
+ XDATA_IRRIG (:,8) = 0.00
+ END WHERE
+ !
+ WHERE(XDATA_VEGTYPE(:,9)>0.)
+ XDATA_WATSUP(:,9) = 30.
+ XDATA_IRRIG (:,9) = 1.00
+ TDATA_SEED (:,9)%TDATE%DAY = 10
+ TDATA_SEED (:,9)%TDATE%MONTH = 05
+ TDATA_REAP (:,9)%TDATE%DAY = 01
+ TDATA_REAP (:,9)%TDATE%MONTH = 08
+ END WHERE
+ !
+ELSE
+
+ !For one cover, the soil albedo from CM13 is the same for each vegtype
+ DO JVEG=2,NVEGTYPE
+ DO JCOV = 1, JPCOVER
+ XDATA_ALB_SOIL_NIR(JCOV,:,JVEG) = XDATA_ALB_SOIL_NIR(JCOV,:,1)
+ XDATA_ALB_SOIL_VIS(JCOV,:,JVEG) = XDATA_ALB_SOIL_VIS(JCOV,:,1)
+ ENDDO
+ ENDDO
+
+ENDIF
!
!-------------------------------------------------------------------------------
!
ICPT_SEA = 0
ICPT_WATER = 0
!
-DO JCOVER = 1, JPCOVER
+IF (U%LECOSG) THEN
+ ALLOCATE(NSEA(1))
+ ALLOCATE(NWATER(2))
+ELSE
+ ALLOCATE(NSEA(3))
+ ALLOCATE(NWATER(2))
+ENDIF
+!
+NSEA(:) = 0
+NWATER(:) = 0
+!
+DO JCOV = 1, JPCOVER
!
- IF (XDATA_NATURE(JCOVER)==1.) THEN
- IF (XDATA_VEGTYPE(JCOVER,NVT_NO )==1.) NBARE_SOIL = JCOVER
- IF (XDATA_VEGTYPE(JCOVER,NVT_ROCK)==1.) NROCK = JCOVER
- IF (XDATA_VEGTYPE(JCOVER,NVT_SNOW)==1.) NPERMSNOW = JCOVER
+ IF (XDATA_NATURE(JCOV)==1.) THEN
+ IF (XDATA_VEGTYPE(JCOV,NVT_NO )==1.) NBARE_SOIL = JCOV
+ IF (XDATA_VEGTYPE(JCOV,NVT_ROCK)==1.) NROCK = JCOV
+ IF (XDATA_VEGTYPE(JCOV,NVT_SNOW)==1.) NPERMSNOW = JCOV
END IF
!
- IF (XDATA_SEA(JCOVER)==1.) THEN
+ IF (XDATA_SEA(JCOV)==1.) THEN
ICPT_SEA = ICPT_SEA + 1
IF(ICPT_SEA>SIZE(NSEA))THEN
CALL ABOR1_SFX('INI_DATA_COVER: problem with ecoclimap param : ICPT_SEA > SIZE(NSEA) ')
ENDIF
- NSEA(ICPT_SEA) = JCOVER
+ NSEA(ICPT_SEA) = JCOV
ENDIF
!
- IF (XDATA_WATER(JCOVER)==1.) THEN
+ IF (XDATA_WATER(JCOV)==1.) THEN
ICPT_WATER = ICPT_WATER + 1
IF(ICPT_WATER>SIZE(NWATER))THEN
CALL ABOR1_SFX('INI_DATA_COVER: problem with ecoclimap param : ICPT_WATER > SIZE(NWATER) ')
ENDIF
- NWATER(ICPT_WATER) = JCOVER
+ NWATER(ICPT_WATER) = JCOV
ENDIF
!
- IF (XDATA_TOWN(JCOVER)==0.) CYCLE
+ IF (XDATA_TOWN(JCOV)==0.) CYCLE
!
- XDATA_CAN_HW_RATIO(JCOVER) = 0.5 * XDATA_WALL_O_HOR(JCOVER) / (1.-XDATA_BLD (JCOVER))
+ XDATA_CAN_HW_RATIO(JCOV) = 0.5 * XDATA_WALL_O_HOR(JCOV) / (1.-XDATA_BLD (JCOV))
!
!* Building Energy Model variables
!
- XDATA_HC_FLOOR(JCOVER,:) = 2016000.
- XDATA_TC_FLOOR(JCOVER,:) = 1.95
- XDATA_D_FLOOR(JCOVER,1) = 0.01
- XDATA_D_FLOOR(JCOVER,2) = 0.04
- XDATA_D_FLOOR(JCOVER,3) = 0.10
+ XDATA_HC_FLOOR(JCOV,:) = 2016000.
+ XDATA_TC_FLOOR(JCOV,:) = 1.95
+ XDATA_D_FLOOR(JCOV,1) = 0.01
+ XDATA_D_FLOOR(JCOV,2) = 0.04
+ XDATA_D_FLOOR(JCOV,3) = 0.10
!
- XDATA_TCOOL_TARGET(JCOVER) = 297.16
- XDATA_THEAT_TARGET(JCOVER) = 292.16
- XDATA_F_WASTE_CAN(JCOVER) = 1.0
- XDATA_EFF_HEAT(JCOVER) = 0.9
- XDATA_QIN(JCOVER) = 5.8
- XDATA_QIN_FRAD(JCOVER) = 0.2
- XDATA_QIN_FLAT(JCOVER) = 0.2
- XDATA_SHGC(JCOVER) = 0.763
- XDATA_U_WIN(JCOVER) = 2.716
- XDATA_GR(JCOVER) = 0.3
- XDATA_SHGC_SH(JCOVER) = 0.763
- XDATA_FLOOR_HEIGHT(JCOVER) = 3.0
- XDATA_INF(JCOVER) = 0.5
- XDATA_F_WATER_COND(JCOVER) = 0.
- XDATA_QIN_FLAT(JCOVER) = 0.2
- XDATA_HR_TARGET(JCOVER) = 0.5
- XDATA_V_VENT(JCOVER) = 0.0
- XDATA_CAP_SYS_HEAT(JCOVER) = 100.
- XDATA_CAP_SYS_RAT(JCOVER) = 90.
- XDATA_T_ADP(JCOVER) = 285.66
- XDATA_M_SYS_RAT(JCOVER) = 0.0067
- XDATA_COP_RAT(JCOVER) = 2.5
- XDATA_T_SIZE_MAX(JCOVER) = 301.95
- XDATA_T_SIZE_MIN(JCOVER) = 268.96
- XDATA_SHADE(JCOVER) = 0.0
- XDATA_NATVENT(JCOVER) = 0.0
- XDATA_ROUGH_ROOF(JCOVER) = 1.52
- XDATA_ROUGH_WALL(JCOVER) = 1.52
- XDATA_RESIDENTIAL(JCOVER) = 1.
+ XDATA_TCOOL_TARGET(JCOV) = 297.16
+ XDATA_THEAT_TARGET(JCOV) = 292.16
+ XDATA_F_WASTE_CAN(JCOV) = 1.0
+ XDATA_EFF_HEAT(JCOV) = 0.9
+ XDATA_QIN(JCOV) = 5.8
+ XDATA_QIN_FRAD(JCOV) = 0.2
+ XDATA_QIN_FLAT(JCOV) = 0.2
+ XDATA_SHGC(JCOV) = 0.763
+ XDATA_U_WIN(JCOV) = 2.716
+ XDATA_GR(JCOV) = 0.3
+ XDATA_SHGC_SH(JCOV) = 0.763
+ XDATA_FLOOR_HEIGHT(JCOV) = 3.0
+ XDATA_INF(JCOV) = 0.5
+ XDATA_F_WATER_COND(JCOV) = 0.
+ XDATA_QIN_FLAT(JCOV) = 0.2
+ XDATA_HR_TARGET(JCOV) = 0.5
+ XDATA_V_VENT(JCOV) = 0.0
+ XDATA_CAP_SYS_HEAT(JCOV) = 100.
+ XDATA_CAP_SYS_RAT(JCOV) = 90.
+ XDATA_T_ADP(JCOV) = 285.66
+ XDATA_M_SYS_RAT(JCOV) = 0.0067
+ XDATA_COP_RAT(JCOV) = 2.5
+ XDATA_T_SIZE_MAX(JCOV) = 301.95
+ XDATA_T_SIZE_MIN(JCOV) = 268.96
+ XDATA_SHADE(JCOV) = 0.0
+ XDATA_NATVENT(JCOV) = 0.0
+ XDATA_ROUGH_ROOF(JCOV) = 1.52
+ XDATA_ROUGH_WALL(JCOV) = 1.52
+ XDATA_RESIDENTIAL(JCOV) = 1.
!
- XDATA_EMIS_PANEL (JCOVER) = 0.9
- XDATA_ALB_PANEL (JCOVER) = 0.1
- XDATA_EFF_PANEL (JCOVER) = 0.14
- XDATA_FRAC_PANEL (JCOVER) = 0.
+ XDATA_EMIS_PANEL (JCOV) = 0.9
+ XDATA_ALB_PANEL (JCOV) = 0.1
+ XDATA_EFF_PANEL (JCOV) = 0.14
+ XDATA_FRAC_PANEL (JCOV) = 0.
!
- IF (XDATA_GARDEN(JCOVER)/=0.) THEN
- DO JVEGTYPE=1,NVEGTYPE
- IF (XDATA_VEGTYPE(JCOVER,JVEGTYPE)/=0.) THEN
- XDATA_ALB_SOIL_NIR(JCOVER,:,JVEGTYPE) = 0.3
- XDATA_ALB_SOIL_VIS(JCOVER,:,JVEGTYPE) = 0.1
- XDATA_ALB_VEG_NIR (JCOVER,:,JVEGTYPE) = 0.3
- XDATA_ALB_VEG_VIS (JCOVER,:,JVEGTYPE) = 0.1
+ IF (XDATA_GARDEN(JCOV)/=0.) THEN
+ DO JVEG=1,NVEGTYPE
+ IF (XDATA_VEGTYPE(JCOV,JVEG)/=0.) THEN
+ XDATA_ALB_SOIL_NIR(JCOV,:,JVEG) = 0.3
+ XDATA_ALB_SOIL_VIS(JCOV,:,JVEG) = 0.1
+ XDATA_ALB_VEG_NIR (JCOV,:,JVEG) = 0.3
+ XDATA_ALB_VEG_VIS (JCOV,:,JVEG) = 0.1
ENDIF
ENDDO
ENDIF
@@ -1122,1145 +1374,1195 @@ IF(ICPT_WATER<SIZE(NWATER))THEN
ENDIF
!
!-------------------------------------------------------------------------------
- CNAMES(:,:) = ' '
+ALLOCATE(CNAMES(JPCOVER,2))
+CNAMES(:,:) = ' '
!-------------------------------------------------------------------------------
!
- CNAMES(1,1) = 'Sea and ocean'
- CNAMES(2,1) = 'Lakes'
- CNAMES(3,1) = 'Rivers'
- CNAMES(4,1) = 'Bare land'
- CNAMES(5,1) = 'Rocks'
- CNAMES(6,1) = 'Permanent snow and ice'
- CNAMES(7,1) = 'Urban and built-up'
+IF (U%LECOSG) THEN
+
+ CNAMES(1,1) = 'No vegetation (smooth)'
+ CNAMES(2,1) = 'No vegetation (rocks) '
+ CNAMES(3,1) = 'Permanent snow and ice'
+ CNAMES(4,1) = 'temperate broadleaf cold-deciduous summergreen'
+ CNAMES(5,1) = 'boreal needleleaf evergreen'
+ CNAMES(6,1) = 'tropical broadleaf evergreen'
+ CNAMES(7,1) = 'C3 cultures types'
+ CNAMES(8,1) = 'C4 cultures types'
+ CNAMES(9,1) = 'irrigated crops'
+ CNAMES(10,1) = 'temperate grassland'
+ CNAMES(11,1) = 'tropical grassland'
+ CNAMES(12,1) = 'peat bogs, parks and gardens (irrigated grass)'
+ CNAMES(13,1) = 'tropical broadleaf deciduous'
+ CNAMES(14,1) = 'temperate broadleaf evergreen'
+ CNAMES(15,1) = 'temperate needleleaf evergreen'
+ CNAMES(16,1) = 'boreal broadleaf cold-deciduous summergreen'
+ CNAMES(17,1) = 'boreal needleleaf cold-deciduous summergreen'
+ CNAMES(18,1) = 'boreal grass'
+ CNAMES(19,1) = 'shrub'
+!
+ CNAMES(20,1) = 'urban areas'
+ CNAMES(21,1) = 'sea and oceans'
+ CNAMES(22,1) = 'lakes'
+ CNAMES(23,1) = 'rivers'
+!
+!-------------------------------------------------------------------------------
+!
+ CNAMES(1,2) = 'Sol nu'
+ CNAMES(2,2) = 'Roche nue'
+ CNAMES(3,2) = 'Neige permanente et glaciers'
+ CNAMES(4,2) = 'Feuillus decidus en zone temperee'
+ CNAMES(5,2) = 'Coniferes sempervirents en zone boreale'
+ CNAMES(6,2) = 'Feuillus sempervirentsn en zone tropicale'
+ CNAMES(7,2) = 'Cultures C3'
+ CNAMES(8,2) = 'Cultures C4'
+ CNAMES(9,2) = 'Cultures irriguées'
+ CNAMES(10,2) = 'Prairies en zone temperee'
+ CNAMES(11,2) = 'Prairies en zone tropicale'
+ CNAMES(12,2) = 'Zone humides, parcs et jardins'
+ CNAMES(13,2) = 'Feuillus decidus en zone tropicale'
+ CNAMES(14,2) = 'Feuillus sempervirents en zone temperee'
+ CNAMES(15,2) = 'Coniferes sempervirents en zone temperee'
+ CNAMES(16,2) = 'Feuillus boreal broadleaf cold-deciduous summergreen'
+ CNAMES(17,2) = 'Coniferes decidus en zone boreale'
+ CNAMES(18,2) = 'Prairies en zone boreale'
+ CNAMES(19,2) = 'Buissons'
+!
+ CNAMES(20,2) = 'Zones urbaines'
+ CNAMES(21,2) = 'Mer et oceans'
+ CNAMES(22,2) = 'Lacs'
+ CNAMES(23,2) = 'Rivieres'
- CNAMES(8,1) = 'Tropical undefined islands'
- CNAMES(9,1) = 'Subpolar undefined islands'
-!
- CNAMES(10,1) = 'S-America cool ENF'
- CNAMES(11,1) = 'Boreal ENF'
- CNAMES(12,1) = 'Asia subtropical ENF'
- CNAMES(13,1) = 'American Continental ENF'
- CNAMES(14,1) = 'American Subtropical ENF'
- CNAMES(15,1) = 'American Cool Marine ENF'
+ELSE
+
+ CNAMES(1,1) = 'Sea and ocean'
+ CNAMES(2,1) = 'Lakes'
+ CNAMES(3,1) = 'Rivers'
+ CNAMES(4,1) = 'Bare land'
+ CNAMES(5,1) = 'Rocks'
+ CNAMES(6,1) = 'Permanent snow and ice'
+ CNAMES(7,1) = 'Urban and built-up'
- CNAMES(16,1) = 'Africa Equatorial EBF'
- CNAMES(17,1) = 'Africa Tr. wind EBF'
- CNAMES(18,1) = 'Oceanian Equatorial EBF'
- CNAMES(19,1) = 'Asia tropical EBF'
- CNAMES(20,1) = 'Oceania tropical EBF'
- CNAMES(21,1) = 'Amazonian EBF'
- CNAMES(22,1) = 'SH subtropical EBF'
- CNAMES(23,1) = 'Cent. America Tr. wind EBF'
+ CNAMES(8,1) = 'Tropical undefined islands'
+ CNAMES(9,1) = 'Subpolar undefined islands'
+!
+ CNAMES(10,1) = 'S-America cool ENF'
+ CNAMES(11,1) = 'Boreal ENF'
+ CNAMES(12,1) = 'Asia subtropical ENF'
+ CNAMES(13,1) = 'American Continental ENF'
+ CNAMES(14,1) = 'American Subtropical ENF'
+ CNAMES(15,1) = 'American Cool Marine ENF'
- CNAMES(24,1) = 'Asian boreal DNF'
+ CNAMES(16,1) = 'Africa Equatorial EBF'
+ CNAMES(17,1) = 'Africa Tr. wind EBF'
+ CNAMES(18,1) = 'Oceanian Equatorial EBF'
+ CNAMES(19,1) = 'Asia tropical EBF'
+ CNAMES(20,1) = 'Oceania tropical EBF'
+ CNAMES(21,1) = 'Amazonian EBF'
+ CNAMES(22,1) = 'SH subtropical EBF'
+ CNAMES(23,1) = 'Cent. America Tr. wind EBF'
- CNAMES(25,1) = 'S-America tropical DBF'
- CNAMES(26,1) = 'N-America humid continental DBF'
- CNAMES(27,1) = 'Cent. America Tr. wind DBF'
- CNAMES(28,1) = 'S-America humid subtropical DBF'
+ CNAMES(24,1) = 'Asian boreal DNF'
- CNAMES(29,1) = 'Africa dry tropical MF'
- CNAMES(30,1) = 'S-America cool MF'
- CNAMES(31,1) = 'NH Subpolar MF'
- CNAMES(32,1) = 'NH Humid subtropical MF'
- CNAMES(33,1) = 'NH Continental MF'
+ CNAMES(25,1) = 'S-America tropical DBF'
+ CNAMES(26,1) = 'N-America humid continental DBF'
+ CNAMES(27,1) = 'Cent. America Tr. wind DBF'
+ CNAMES(28,1) = 'S-America humid subtropical DBF'
- CNAMES(34,1) = 'NH Africa WL'
- CNAMES(35,1) = 'SH Africa WL'
- CNAMES(36,1) = 'Tr. wind humid and subtrop. WL'
- CNAMES(37,1) = 'Oceanian Equatorial WL'
- CNAMES(38,1) = 'Asia wet tropical WL'
- CNAMES(39,1) = 'S-America tropical WL'
- CNAMES(40,1) = 'S-America humid subtropical WL'
- CNAMES(41,1) = 'NH Subpolar WL'
- CNAMES(42,1) = 'NH Continental WL'
- CNAMES(43,1) = 'Asia humid subtropical WL'
- CNAMES(44,1) = 'N-America Semi arid WL'
- CNAMES(45,1) = 'N-America moderate polar WL'
- CNAMES(46,1) = 'S-America moderate polar WL'
- CNAMES(47,1) = 'N-America humid subtropical WL'
+ CNAMES(29,1) = 'Africa dry tropical MF'
+ CNAMES(30,1) = 'S-America cool MF'
+ CNAMES(31,1) = 'NH Subpolar MF'
+ CNAMES(32,1) = 'NH Humid subtropical MF'
+ CNAMES(33,1) = 'NH Continental MF'
- CNAMES(48,1) = 'NH Africa semiarid WG'
- CNAMES(49,1) = 'NH Africa dry tropical WG'
- CNAMES(50,1) = 'Africa dry equatorial WG'
- CNAMES(51,1) = 'SH Africa dry tropical WG'
- CNAMES(52,1) = 'Oceania tropical WG'
- CNAMES(53,1) = 'Oceania semiarid WG'
- CNAMES(54,1) = 'Oceania subtrop. cool marine WG'
- CNAMES(55,1) = 'Asia humid and subtropical WG'
- CNAMES(56,1) = 'S-America trop. and subtrop. WG'
- CNAMES(57,1) = 'S-America Tr. wind WG'
- CNAMES(58,1) = 'S-America semiarid WG'
- CNAMES(59,1) = 'NH Subpolar WG'
- CNAMES(60,1) = 'NH Continental WG'
- CNAMES(61,1) = 'Asia wet and dry tropical WG'
- CNAMES(62,1) = 'N-America semi arid WG'
- CNAMES(63,1) = 'N-America humid subtropical WG'
- CNAMES(64,1) = 'S-America moderate polar WG'
- CNAMES(65,1) = 'Cent. Amer. Tr. wind \& trop. WG'
- CNAMES(66,1) = 'NH Africa dry summer subtrop. WG'
+ CNAMES(34,1) = 'NH Africa WL'
+ CNAMES(35,1) = 'SH Africa WL'
+ CNAMES(36,1) = 'Tr. wind humid and subtrop. WL'
+ CNAMES(37,1) = 'Oceanian Equatorial WL'
+ CNAMES(38,1) = 'Asia wet tropical WL'
+ CNAMES(39,1) = 'S-America tropical WL'
+ CNAMES(40,1) = 'S-America humid subtropical WL'
+ CNAMES(41,1) = 'NH Subpolar WL'
+ CNAMES(42,1) = 'NH Continental WL'
+ CNAMES(43,1) = 'Asia humid subtropical WL'
+ CNAMES(44,1) = 'N-America Semi arid WL'
+ CNAMES(45,1) = 'N-America moderate polar WL'
+ CNAMES(46,1) = 'S-America moderate polar WL'
+ CNAMES(47,1) = 'N-America humid subtropical WL'
- CNAMES(67,1) = 'NH Africa arid CS'
- CNAMES(68,1) = 'NH Africa semiarid CS'
- CNAMES(69,1) = 'SH Africa semiarid CS'
- CNAMES(70,1) = 'Oceania arid CS'
- CNAMES(71,1) = 'Oceania, S-America semiarid CS'
- CNAMES(72,1) = 'Oceania Tr. wind CS'
- CNAMES(73,1) = 'SH dry summer subtropical CS'
- CNAMES(74,1) = 'Asia polar CS'
- CNAMES(75,1) = 'Asia continental CS'
- CNAMES(76,1) = 'Asia tropical CS'
- CNAMES(77,1) = 'N-America polar CS'
- CNAMES(78,1) = 'N-America continental CS'
- CNAMES(79,1) = 'NH Africa dry summer subtrop. CS'
+ CNAMES(48,1) = 'NH Africa semiarid WG'
+ CNAMES(49,1) = 'NH Africa dry tropical WG'
+ CNAMES(50,1) = 'Africa dry equatorial WG'
+ CNAMES(51,1) = 'SH Africa dry tropical WG'
+ CNAMES(52,1) = 'Oceania tropical WG'
+ CNAMES(53,1) = 'Oceania semiarid WG'
+ CNAMES(54,1) = 'Oceania subtrop. cool marine WG'
+ CNAMES(55,1) = 'Asia humid and subtropical WG'
+ CNAMES(56,1) = 'S-America trop. and subtrop. WG'
+ CNAMES(57,1) = 'S-America Tr. wind WG'
+ CNAMES(58,1) = 'S-America semiarid WG'
+ CNAMES(59,1) = 'NH Subpolar WG'
+ CNAMES(60,1) = 'NH Continental WG'
+ CNAMES(61,1) = 'Asia wet and dry tropical WG'
+ CNAMES(62,1) = 'N-America semi arid WG'
+ CNAMES(63,1) = 'N-America humid subtropical WG'
+ CNAMES(64,1) = 'S-America moderate polar WG'
+ CNAMES(65,1) = 'Cent. Amer. Tr. wind \& trop. WG'
+ CNAMES(66,1) = 'NH Africa dry summer subtrop. WG'
- CNAMES(80,1) = 'NH arid OS'
- CNAMES(81,1) = 'NH semiarid tropical OS'
- CNAMES(82,1) = 'SH Africa and Oceania arid OS'
- CNAMES(83,1) = 'S-America semiarid tropical OS'
- CNAMES(84,1) = 'Asia dry tropical OS'
- CNAMES(85,1) = 'NH Polar OS'
- CNAMES(86,1) = 'N-America Subpolar OS'
- CNAMES(87,1) = 'N-America semiarid continental OS'
+ CNAMES(67,1) = 'NH Africa arid CS'
+ CNAMES(68,1) = 'NH Africa semiarid CS'
+ CNAMES(69,1) = 'SH Africa semiarid CS'
+ CNAMES(70,1) = 'Oceania arid CS'
+ CNAMES(71,1) = 'Oceania, S-America semiarid CS'
+ CNAMES(72,1) = 'Oceania Tr. wind CS'
+ CNAMES(73,1) = 'SH dry summer subtropical CS'
+ CNAMES(74,1) = 'Asia polar CS'
+ CNAMES(75,1) = 'Asia continental CS'
+ CNAMES(76,1) = 'Asia tropical CS'
+ CNAMES(77,1) = 'N-America polar CS'
+ CNAMES(78,1) = 'N-America continental CS'
+ CNAMES(79,1) = 'NH Africa dry summer subtrop. CS'
- CNAMES(88,1) = 'Africa wet Tropical G'
- CNAMES(89,1) = 'NH Africa Semiarid G'
- CNAMES(90,1) = 'SH Africa Semiarid G'
- CNAMES(91,1) = 'S-America, Oceania equatorial G'
- CNAMES(92,1) = 'S-America, Oceania Semiarid G'
- CNAMES(93,1) = 'Oceania cool littoral G'
- CNAMES(94,1) = 'Asia wet and dry tropical G'
- CNAMES(95,1) = 'NH S-America wet tropical G'
- CNAMES(96,1) = 'SH S-America wet tropical G'
- CNAMES(97,1) = 'S-America semiarid G'
- CNAMES(98,1) = 'S-America moderate polar G'
- CNAMES(99,1) = 'NH semiarid Continental G'
- CNAMES(100,1) = 'Asia Subpolar G'
- CNAMES(101,1) = 'Asia humid Continental G'
- CNAMES(102,1) = 'Asia semiarid tropical G'
- CNAMES(103,1) = 'N-America continental G'
- CNAMES(104,1) = 'Asia humid subtropical G'
+ CNAMES(80,1) = 'NH arid OS'
+ CNAMES(81,1) = 'NH semiarid tropical OS'
+ CNAMES(82,1) = 'SH Africa and Oceania arid OS'
+ CNAMES(83,1) = 'S-America semiarid tropical OS'
+ CNAMES(84,1) = 'Asia dry tropical OS'
+ CNAMES(85,1) = 'NH Polar OS'
+ CNAMES(86,1) = 'N-America Subpolar OS'
+ CNAMES(87,1) = 'N-America semiarid continental OS'
- CNAMES(105,1) = 'NH Africa arid C'
- CNAMES(106,1) = 'NH Africa, Asia wet and dry trop. C'
- CNAMES(107,1) = 'SH Africa wet and dry tropical C'
- CNAMES(108,1) = 'SH Afr. Tr. wind \& semiarid trop. C'
- CNAMES(109,1) = 'Oceania dry summer subtropical C'
- CNAMES(110,1) = 'Cent. \& S-Amer., Oceania Tr. wind C'
- CNAMES(111,1) = 'S-America humid subtropical C'
- CNAMES(112,1) = 'SH S-America tropical C'
- CNAMES(113,1) = 'N-Amer., Asia semiarid continental C'
- CNAMES(114,1) = 'Asia humid continental C'
- CNAMES(115,1) = 'Asia humid subtropical C'
- CNAMES(116,1) = 'Asia subpolar C'
- CNAMES(117,1) = 'Asia semiarid tropical C'
- CNAMES(118,1) = 'N-America humid continental C'
- CNAMES(119,1) = 'N-America humid subtropical C'
- CNAMES(120,1) = 'NH dry summer subtropical C'
- CNAMES(121,1) = 'NH Africa dry summer subtropical C'
- CNAMES(122,1) = 'SH Africa dry summer subtropical C'
+ CNAMES(88,1) = 'Africa wet Tropical G'
+ CNAMES(89,1) = 'NH Africa Semiarid G'
+ CNAMES(90,1) = 'SH Africa Semiarid G'
+ CNAMES(91,1) = 'S-America, Oceania equatorial G'
+ CNAMES(92,1) = 'S-America, Oceania Semiarid G'
+ CNAMES(93,1) = 'Oceania cool littoral G'
+ CNAMES(94,1) = 'Asia wet and dry tropical G'
+ CNAMES(95,1) = 'NH S-America wet tropical G'
+ CNAMES(96,1) = 'SH S-America wet tropical G'
+ CNAMES(97,1) = 'S-America semiarid G'
+ CNAMES(98,1) = 'S-America moderate polar G'
+ CNAMES(99,1) = 'NH semiarid Continental G'
+ CNAMES(100,1) = 'Asia Subpolar G'
+ CNAMES(101,1) = 'Asia humid Continental G'
+ CNAMES(102,1) = 'Asia semiarid tropical G'
+ CNAMES(103,1) = 'N-America continental G'
+ CNAMES(104,1) = 'Asia humid subtropical G'
- CNAMES(123,1) = 'Bare soil with sparse polar vegetation'
+ CNAMES(105,1) = 'NH Africa arid C'
+ CNAMES(106,1) = 'NH Africa, Asia wet and dry trop. C'
+ CNAMES(107,1) = 'SH Africa wet and dry tropical C'
+ CNAMES(108,1) = 'SH Afr. Tr. wind \& semiarid trop. C'
+ CNAMES(109,1) = 'Oceania dry summer subtropical C'
+ CNAMES(110,1) = 'Cent. \& S-Amer., Oceania Tr. wind C'
+ CNAMES(111,1) = 'S-America humid subtropical C'
+ CNAMES(112,1) = 'SH S-America tropical C'
+ CNAMES(113,1) = 'N-Amer., Asia semiarid continental C'
+ CNAMES(114,1) = 'Asia humid continental C'
+ CNAMES(115,1) = 'Asia humid subtropical C'
+ CNAMES(116,1) = 'Asia subpolar C'
+ CNAMES(117,1) = 'Asia semiarid tropical C'
+ CNAMES(118,1) = 'N-America humid continental C'
+ CNAMES(119,1) = 'N-America humid subtropical C'
+ CNAMES(120,1) = 'NH dry summer subtropical C'
+ CNAMES(121,1) = 'NH Africa dry summer subtropical C'
+ CNAMES(122,1) = 'SH Africa dry summer subtropical C'
- CNAMES(124,1) = 'Warm subtropical wetlands'
- CNAMES(125,1) = 'Subpolar wetlands'
-!
- CNAMES(151,1) = 'Dense urban'
- CNAMES(152,1) = 'Mediterranean sub-urban'
- CNAMES(153,1) = 'Temperate sub-urban'
- CNAMES(154,1) = 'Cold sub-urban'
- CNAMES(155,1) = 'Industries and commercial areas'
- CNAMES(156,1) = 'Road and rail networks'
- CNAMES(157,1) = 'Port facilities'
- CNAMES(158,1) = 'Airport'
- CNAMES(159,1) = 'Mineral extraction, construction sites'
- CNAMES(160,1) = 'Urban parks'
- CNAMES(161,1) = 'Sport facilities'
-!
- CNAMES(162,1) = 'Spanish crops'
- CNAMES(163,1) = 'Estremadura crops'
- CNAMES(164,1) = 'Mediterranean crops'
- CNAMES(165,1) = 'Atlantic coast crops'
- CNAMES(166,1) = 'Temperate crops'
- CNAMES(167,1) = 'Po plain crops'
- CNAMES(168,1) = 'Warm temperate crops'
- CNAMES(169,1) = 'Ukrainian crops'
- CNAMES(170,1) = 'Subpolar crops'
- CNAMES(171,1) = 'Mountain crops'
- CNAMES(172,1) = 'Central Europe crops'
- CNAMES(173,1) = 'Turkish crops'
-!
- CNAMES(174,1) = 'Mediterranean irrigated crops'
- CNAMES(175,1) = 'Irrigated crops'
- CNAMES(176,1) = 'Rice fields'
-!
- CNAMES(177,1) = 'Mediterranean vineyards'
- CNAMES(178,1) = 'Temperate vineyards'
- CNAMES(179,1) = 'Mediterranean fruit trees'
- CNAMES(180,1) = 'Temperate fruit trees'
- CNAMES(181,1) = 'Olive groves'
-!
- CNAMES(182,1) = 'Temperate pastures'
- CNAMES(183,1) = 'Atlantic border pastures'
- CNAMES(184,1) = 'Central and Eastern Europe pastures'
- CNAMES(185,1) = 'Ukrainian pastures'
- CNAMES(186,1) = 'Subpolar pastures'
-!
- CNAMES(187,1) = 'Spanish complex cultivation pattern'
- CNAMES(188,1) = 'Mediter. complex cultivation pat.'
- CNAMES(189,1) = 'Temperate complex cultivation pat.'
- CNAMES(190,1) = 'French complex cultivation pat.'
- CNAMES(191,1) = 'Balkanish complex cultivation pat.'
-!
- CNAMES(192,1) = 'Mediterranean crops and woodland'
- CNAMES(193,1) = 'Crops and woodland'
- CNAMES(194,1) = 'French crops and woodland'
- CNAMES(195,1) = 'Balkanish crops and woodland'
- CNAMES(196,1) = 'Spanish crops and woodland'
- CNAMES(197,1) = 'Baltic states crops and woodland'
-!
- CNAMES(198,1) = 'Agro-forestry areas'
-!
- CNAMES(199,1) = 'Spanish broad-leaved forest'
- CNAMES(200,1) = 'Estremadura broad-leaved forest'
- CNAMES(201,1) = 'Mediterranean broad-leaved forest'
- CNAMES(202,1) = 'Atlantic coast broad-leaved forest'
- CNAMES(203,1) = 'Temperate broad-leaved forest'
- CNAMES(204,1) = 'Moutain broad-leaved forest'
- CNAMES(205,1) = 'Balkanish broad-leaved forest'
- CNAMES(206,1) = 'Subpolar broad-leaved forest'
- CNAMES(207,1) = 'Black Sea broad-leaved forest'
-!
- CNAMES(208,1) = 'Mediterranean pines'
- CNAMES(209,1) = 'Landes forest'
- CNAMES(210,1) = 'Moutain coniferous forest'
- CNAMES(211,1) = 'Temperate coniferous forest'
- CNAMES(212,1) = 'Subpolar Taiga'
- CNAMES(213,1) = 'Russian Taiga'
- CNAMES(214,1) = 'Turkish coniferous forest'
-!
- CNAMES(215,1) = 'Mediterranean mixed forest'
- CNAMES(216,1) = 'Atlantic coast \& french mixed forest'
- CNAMES(217,1) = 'Subpolar mixed forest'
- CNAMES(218,1) = 'Mountain mixed forest'
- CNAMES(219,1) = 'Eastern Europe mixed forest'
-!
- CNAMES(220,1) = 'Mediterranean GR'
- CNAMES(221,1) = 'Atlantic coast GR'
- CNAMES(222,1) = 'Balkanish GR'
- CNAMES(223,1) = 'Estremadura GR'
- CNAMES(224,1) = 'Subpolar GR'
- CNAMES(225,1) = 'Tundra'
-!
- CNAMES(226,1) = 'Turkish moors'
- CNAMES(227,1) = 'Mediter. moors \& heath lands'
- CNAMES(228,1) = 'Moutain moors \& heath lands'
- CNAMES(229,1) = 'Atlantic coast moors \& heath lands'
-!
- CNAMES(230,1) = 'Turkish shrubland'
- CNAMES(231,1) = 'Mediterranean maquis'
- CNAMES(232,1) = 'Moutain maquis'
-!
- CNAMES(233,1) = 'Spanish woodland'
- CNAMES(234,1) = 'Mediterranean woodland'
- CNAMES(235,1) = 'Temperate woodland'
-!
- CNAMES(236,1) = 'Sparsely vegetated areas'
- CNAMES(237,1) = 'Burnt areas'
- CNAMES(238,1) = 'Temperate wetlands'
- CNAMES(239,1) = 'Subpolar wetlands'
- CNAMES(240,1) = 'Peat bogs'
- CNAMES(241,1) = 'Salines and salt marshes'
-!
- CNAMES(242,1) = 'Intertidal flats'
- CNAMES(243,1) = 'Coastal lagoons'
-!
- CNAMES(301,1)='N SCANDINAVIA TUNDRA1'
- CNAMES(302,1)='OURAL BF1'
- CNAMES(303,1)='CARELIE BF1'
- CNAMES(304,1)='NORTH RUSSIAN TAIGA1'
- CNAMES(305,1)='NORTH RUSSIAN TAIGA2'
- CNAMES(306,1)='CARELIE BF2'
- CNAMES(307,1)='RUSSIAN TAIGA3'
- CNAMES(308,1)='RUSSIAN BF1'
- CNAMES(309,1)='RUSSIAN TAIGA4'
- CNAMES(310,1)='S SCANDINAVIA TAIGA1'
- CNAMES(311,1)='SOUTH FINLANDIA MF1'
- CNAMES(312,1)='SOUTH NORWAY MF1'
- CNAMES(313,1)='BALTIC BF1'
- CNAMES(314,1)='BALTIC MF1'
- CNAMES(315,1)='SOUTH SWEDEN CF1'
- CNAMES(316,1)='BALTIC MF2'
- CNAMES(317,1)='SOUTH SWEDEN CF2'
- CNAMES(318,1)='SOUTH SWEDEN CF3'
- CNAMES(319,1)='SOUTH SWEDEN MF1'
- CNAMES(320,1)='MOUNTAIN MF1'
- CNAMES(321,1)='MOUNTAIN BF1'
- CNAMES(322,1)='TEMPERATE BF1'
- CNAMES(323,1)='TEMPERATE COMPLEX1'
- CNAMES(324,1)='MOUNTAIN CF1'
- CNAMES(325,1)='TEMP HERBACEOUS CF1'
- CNAMES(326,1)='ATLANTIC COAST BF1'
- CNAMES(327,1)='TURKISH CF1'
- CNAMES(328,1)='BALKAN CF1'
- CNAMES(329,1)='N SPAIN HERBAC MF1'
- CNAMES(330,1)='TEMP SW HERBAC CF1'
- CNAMES(331,1)='ATLANTIC COMPLEX1'
- CNAMES(332,1)='N SPAIN HERBAC MF2'
- CNAMES(333,1)='MEDITER COMPLEX1'
- CNAMES(334,1)='MEDITER COMPLEX2'
- CNAMES(335,1)='MEDITER COMPLEX3'
- CNAMES(336,1)='MEDITER COMPLEX4'
- CNAMES(337,1)='MEDITER COMPLEX5'
- CNAMES(338,1)='BURNT PORT HERBAC CF1'
- CNAMES(339,1)='BURNT PORT HERBAC BF1'
- CNAMES(340,1)='EGEE COAST COMPLEX1'
- CNAMES(341,1)='W MED COAST COMPLEX1'
- CNAMES(342,1)='MAGHR HERBACEOUS MF1'
- CNAMES(343,1)='ESTREM HERBACEOUS MF1'
+ CNAMES(123,1) = 'Bare soil with sparse polar vegetation'
+
+ CNAMES(124,1) = 'Warm subtropical wetlands'
+ CNAMES(125,1) = 'Subpolar wetlands'
+!
+ CNAMES(151,1) = 'Dense urban'
+ CNAMES(152,1) = 'Mediterranean sub-urban'
+ CNAMES(153,1) = 'Temperate sub-urban'
+ CNAMES(154,1) = 'Cold sub-urban'
+ CNAMES(155,1) = 'Industries and commercial areas'
+ CNAMES(156,1) = 'Road and rail networks'
+ CNAMES(157,1) = 'Port facilities'
+ CNAMES(158,1) = 'Airport'
+ CNAMES(159,1) = 'Mineral extraction, construction sites'
+ CNAMES(160,1) = 'Urban parks'
+ CNAMES(161,1) = 'Sport facilities'
+!
+ CNAMES(162,1) = 'Spanish crops'
+ CNAMES(163,1) = 'Estremadura crops'
+ CNAMES(164,1) = 'Mediterranean crops'
+ CNAMES(165,1) = 'Atlantic coast crops'
+ CNAMES(166,1) = 'Temperate crops'
+ CNAMES(167,1) = 'Po plain crops'
+ CNAMES(168,1) = 'Warm temperate crops'
+ CNAMES(169,1) = 'Ukrainian crops'
+ CNAMES(170,1) = 'Subpolar crops'
+ CNAMES(171,1) = 'Mountain crops'
+ CNAMES(172,1) = 'Central Europe crops'
+ CNAMES(173,1) = 'Turkish crops'
+!
+ CNAMES(174,1) = 'Mediterranean irrigated crops'
+ CNAMES(175,1) = 'Irrigated crops'
+ CNAMES(176,1) = 'Rice fields'
+!
+ CNAMES(177,1) = 'Mediterranean vineyards'
+ CNAMES(178,1) = 'Temperate vineyards'
+ CNAMES(179,1) = 'Mediterranean fruit trees'
+ CNAMES(180,1) = 'Temperate fruit trees'
+ CNAMES(181,1) = 'Olive groves'
+!
+ CNAMES(182,1) = 'Temperate pastures'
+ CNAMES(183,1) = 'Atlantic border pastures'
+ CNAMES(184,1) = 'Central and Eastern Europe pastures'
+ CNAMES(185,1) = 'Ukrainian pastures'
+ CNAMES(186,1) = 'Subpolar pastures'
+!
+ CNAMES(187,1) = 'Spanish complex cultivation pattern'
+ CNAMES(188,1) = 'Mediter. complex cultivation pat.'
+ CNAMES(189,1) = 'Temperate complex cultivation pat.'
+ CNAMES(190,1) = 'French complex cultivation pat.'
+ CNAMES(191,1) = 'Balkanish complex cultivation pat.'
+!
+ CNAMES(192,1) = 'Mediterranean crops and woodland'
+ CNAMES(193,1) = 'Crops and woodland'
+ CNAMES(194,1) = 'French crops and woodland'
+ CNAMES(195,1) = 'Balkanish crops and woodland'
+ CNAMES(196,1) = 'Spanish crops and woodland'
+ CNAMES(197,1) = 'Baltic states crops and woodland'
+!
+ CNAMES(198,1) = 'Agro-forestry areas'
+!
+ CNAMES(199,1) = 'Spanish broad-leaved forest'
+ CNAMES(200,1) = 'Estremadura broad-leaved forest'
+ CNAMES(201,1) = 'Mediterranean broad-leaved forest'
+ CNAMES(202,1) = 'Atlantic coast broad-leaved forest'
+ CNAMES(203,1) = 'Temperate broad-leaved forest'
+ CNAMES(204,1) = 'Moutain broad-leaved forest'
+ CNAMES(205,1) = 'Balkanish broad-leaved forest'
+ CNAMES(206,1) = 'Subpolar broad-leaved forest'
+ CNAMES(207,1) = 'Black Sea broad-leaved forest'
+!
+ CNAMES(208,1) = 'Mediterranean pines'
+ CNAMES(209,1) = 'Landes forest'
+ CNAMES(210,1) = 'Moutain coniferous forest'
+ CNAMES(211,1) = 'Temperate coniferous forest'
+ CNAMES(212,1) = 'Subpolar Taiga'
+ CNAMES(213,1) = 'Russian Taiga'
+ CNAMES(214,1) = 'Turkish coniferous forest'
+!
+ CNAMES(215,1) = 'Mediterranean mixed forest'
+ CNAMES(216,1) = 'Atlantic coast \& french mixed forest'
+ CNAMES(217,1) = 'Subpolar mixed forest'
+ CNAMES(218,1) = 'Mountain mixed forest'
+ CNAMES(219,1) = 'Eastern Europe mixed forest'
+!
+ CNAMES(220,1) = 'Mediterranean GR'
+ CNAMES(221,1) = 'Atlantic coast GR'
+ CNAMES(222,1) = 'Balkanish GR'
+ CNAMES(223,1) = 'Estremadura GR'
+ CNAMES(224,1) = 'Subpolar GR'
+ CNAMES(225,1) = 'Tundra'
+!
+ CNAMES(226,1) = 'Turkish moors'
+ CNAMES(227,1) = 'Mediter. moors \& heath lands'
+ CNAMES(228,1) = 'Moutain moors \& heath lands'
+ CNAMES(229,1) = 'Atlantic coast moors \& heath lands'
+!
+ CNAMES(230,1) = 'Turkish shrubland'
+ CNAMES(231,1) = 'Mediterranean maquis'
+ CNAMES(232,1) = 'Moutain maquis'
+!
+ CNAMES(233,1) = 'Spanish woodland'
+ CNAMES(234,1) = 'Mediterranean woodland'
+ CNAMES(235,1) = 'Temperate woodland'
+!
+ CNAMES(236,1) = 'Sparsely vegetated areas'
+ CNAMES(237,1) = 'Burnt areas'
+ CNAMES(238,1) = 'Temperate wetlands'
+ CNAMES(239,1) = 'Subpolar wetlands'
+ CNAMES(240,1) = 'Peat bogs'
+ CNAMES(241,1) = 'Salines and salt marshes'
+!
+ CNAMES(242,1) = 'Intertidal flats'
+ CNAMES(243,1) = 'Coastal lagoons'
+!
+ CNAMES(301,1)='N SCANDINAVIA TUNDRA1'
+ CNAMES(302,1)='OURAL BF1'
+ CNAMES(303,1)='CARELIE BF1'
+ CNAMES(304,1)='NORTH RUSSIAN TAIGA1'
+ CNAMES(305,1)='NORTH RUSSIAN TAIGA2'
+ CNAMES(306,1)='CARELIE BF2'
+ CNAMES(307,1)='RUSSIAN TAIGA3'
+ CNAMES(308,1)='RUSSIAN BF1'
+ CNAMES(309,1)='RUSSIAN TAIGA4'
+ CNAMES(310,1)='S SCANDINAVIA TAIGA1'
+ CNAMES(311,1)='SOUTH FINLANDIA MF1'
+ CNAMES(312,1)='SOUTH NORWAY MF1'
+ CNAMES(313,1)='BALTIC BF1'
+ CNAMES(314,1)='BALTIC MF1'
+ CNAMES(315,1)='SOUTH SWEDEN CF1'
+ CNAMES(316,1)='BALTIC MF2'
+ CNAMES(317,1)='SOUTH SWEDEN CF2'
+ CNAMES(318,1)='SOUTH SWEDEN CF3'
+ CNAMES(319,1)='SOUTH SWEDEN MF1'
+ CNAMES(320,1)='MOUNTAIN MF1'
+ CNAMES(321,1)='MOUNTAIN BF1'
+ CNAMES(322,1)='TEMPERATE BF1'
+ CNAMES(323,1)='TEMPERATE COMPLEX1'
+ CNAMES(324,1)='MOUNTAIN CF1'
+ CNAMES(325,1)='TEMP HERBACEOUS CF1'
+ CNAMES(326,1)='ATLANTIC COAST BF1'
+ CNAMES(327,1)='TURKISH CF1'
+ CNAMES(328,1)='BALKAN CF1'
+ CNAMES(329,1)='N SPAIN HERBAC MF1'
+ CNAMES(330,1)='TEMP SW HERBAC CF1'
+ CNAMES(331,1)='ATLANTIC COMPLEX1'
+ CNAMES(332,1)='N SPAIN HERBAC MF2'
+ CNAMES(333,1)='MEDITER COMPLEX1'
+ CNAMES(334,1)='MEDITER COMPLEX2'
+ CNAMES(335,1)='MEDITER COMPLEX3'
+ CNAMES(336,1)='MEDITER COMPLEX4'
+ CNAMES(337,1)='MEDITER COMPLEX5'
+ CNAMES(338,1)='BURNT PORT HERBAC CF1'
+ CNAMES(339,1)='BURNT PORT HERBAC BF1'
+ CNAMES(340,1)='EGEE COAST COMPLEX1'
+ CNAMES(341,1)='W MED COAST COMPLEX1'
+ CNAMES(342,1)='MAGHR HERBACEOUS MF1'
+ CNAMES(343,1)='ESTREM HERBACEOUS MF1'
!herbaceous / shrub covers
- CNAMES(344,1)='POLAR MOUNT TUNDRA1'
- CNAMES(345,1)='POLAR MOUNT TUNDRA2'
- CNAMES(346,1)='S SCANDINAVIA TUNDRA1'
- CNAMES(347,1)='NORTH TUNDRA1'
- CNAMES(348,1)='S SCANDINAVIA TUNDRA2'
- CNAMES(349,1)='NORTH RUSSIA TUNDRA1'
- CNAMES(350,1)='ARAL CONTINENTAL GR1'
- CNAMES(351,1)='MOUNTAIN TAIGA MOORS1'
- CNAMES(352,1)='SCOTTISH SWAMP MOORS1'
- CNAMES(353,1)='ATLANTIC COMPLEX2'
- CNAMES(354,1)='ATLANTIC GR1'
- CNAMES(355,1)='IR SCOT SWAMP MOORS1'
- CNAMES(356,1)='ASIAN SPARSE GR1'
- CNAMES(357,1)='AS SPARSE SW COMPLEX1'
- CNAMES(358,1)='N CASPIAN DES OS1'
- CNAMES(359,1)='ATLAS AS SPARSE COMP1'
- CNAMES(360,1)='SPARSE SCO CEN EU GR1'
- CNAMES(361,1)='TEMPERATE COMPLEX2'
- CNAMES(362,1)='ATLANTIC COMPLEX3'
- CNAMES(363,1)='ATLANTIC COMPLEX4'
- CNAMES(364,1)='N ATLANTIC PASTURES1'
- CNAMES(365,1)='SPARSE SCO CEN EU GR2'
- CNAMES(366,1)='SPARSE MOUNT E EU GR1'
- CNAMES(367,1)='TUR N CASP CONT GR1'
- CNAMES(368,1)='N CASPIAN CONT GR1'
- CNAMES(369,1)='IRA N CASP CONT GR1'
- CNAMES(370,1)='TUR IRA MOUNT CONT GR1'
- CNAMES(371,1)='E CASPIAN DES OS1'
- CNAMES(372,1)='N CASPIAN COMPLEX1'
- CNAMES(373,1)='IRAN MOUNT CONT GR1'
- CNAMES(374,1)='ASIAN SPARSE DES OS1'
- CNAMES(375,1)='E CASPIAN DES OS2'
- CNAMES(376,1)='N MEDITER COMPLEX1'
- CNAMES(377,1)='N MEDITER COMPLEX2'
- CNAMES(378,1)='ASIAN MEDIT CONT GR1'
- CNAMES(379,1)='SOUTH RUSSIA CONT GR1'
- CNAMES(380,1)='BLSEA SPARSE CONT GR1'
- CNAMES(381,1)='BLSEA SPARSE CONT GR2'
- CNAMES(382,1)='TURK MOUNT CONT GR1'
- CNAMES(383,1)='TURKISH COMPLEX1'
- CNAMES(384,1)='CAUCASIAN COMPLEX1'
- CNAMES(385,1)='N CASPIAN CONT GR2'
- CNAMES(386,1)='VOLGA VALLEY CONT GR1'
- CNAMES(387,1)='VOLGA VALLEY CONT GR2'
- CNAMES(388,1)='W CASPIAN CONT GR1'
- CNAMES(389,1)='CAUCASIAN COMPLEX2'
- CNAMES(390,1)='CAUCASIAN COMPLEX3'
- CNAMES(391,1)='BLSEA SPARSE CONT GR3'
- CNAMES(392,1)='CENT MASSIF COMPLEX1'
- CNAMES(393,1)='CENT MASSIF COMPLEX2'
- CNAMES(394,1)='TURK COAST COMPLEX1'
- CNAMES(395,1)='MESOPOTAMIA GR1'
- CNAMES(396,1)='TURK CILICIA COMPLEX1'
- CNAMES(397,1)='ASIAN COMPLEX1'
- CNAMES(398,1)='N MED SPARSE COMPLEX1'
- CNAMES(399,1)='MEDITER COMPLEX6'
- CNAMES(400,1)='MEDIT SPARSE COMPLEX1'
- CNAMES(401,1)='MEDIT SPARSE COMPLEX2'
- CNAMES(402,1)='MEDIT SPARSE COMPLEX3'
- CNAMES(403,1)='MEDIT SPARSE COMPLEX4'
- CNAMES(404,1)='N MED HERBACEOUS CF1'
- CNAMES(405,1)='ESTREMADURA GR1'
- CNAMES(406,1)='TUNISIA COMPLEX1'
- CNAMES(407,1)='TUNISIA HERBACEOUS1'
- CNAMES(408,1)='ALGERIA HERBACEOUS1'
- CNAMES(409,1)='DESERTIC HERBACEOUS1'
- CNAMES(410,1)='DESERTIC HERBACEOUS2'
- CNAMES(411,1)='SPAIN DES COMPLEX1'
- CNAMES(412,1)='MED SPARSE COMPLEX5'
- CNAMES(413,1)='MED SPARSE COMPLEX6'
- CNAMES(414,1)='MED SPARSE COMPLEX7'
- CNAMES(415,1)='ME SPARSE DES COMPL1'
- CNAMES(416,1)='NORTH ARABIA GR1'
- CNAMES(417,1)='N ARABIA DES COMPLEX1'
- CNAMES(418,1)='N ARABIA DESERTIC GR1'
- CNAMES(419,1)='MOROCCO HERBACEOUS1'
- CNAMES(420,1)='S MED COAST HERBAC1'
- CNAMES(421,1)='W MEDITER WOODLAND1'
- CNAMES(422,1)='S MED COAST HERBAC2'
- CNAMES(423,1)='MESOP DES HERBACEOUS1'
- CNAMES(424,1)='MAG COAST DES HERBAC1'
- CNAMES(425,1)='TU AR SPARSE HERBAC1'
- CNAMES(426,1)='MEDIT SPARSE COMPLEX8'
- CNAMES(427,1)='MED SPARSE HERBAC1'
- CNAMES(428,1)='MEDIT SPARSE COMPLEX9'
- CNAMES(429,1)='SPAIN SPARSE COMPLEX1'
- CNAMES(430,1)='N MED SPARSE COMPLEX2'
- CNAMES(431,1)='N MED SPARSE COMPLEX3'
- CNAMES(432,1)='MAGHRE DES HERBAC1'
- CNAMES(433,1)='MAGHRE DES HERBAC2'
- CNAMES(434,1)='MAGHRE DES HERBAC3'
- CNAMES(435,1)='N ARAB DES HERBAC1'
- CNAMES(436,1)='MESOPO DES HERBAC2'
- CNAMES(437,1)='TOURAN DES HERBAC1'
- CNAMES(438,1)='MESOPO DES HERBAC2'
- CNAMES(439,1)='TOURAN DES HERBAC2'
- CNAMES(440,1)='NEW ZEMBLE HERBAC1'
- CNAMES(441,1)='NEW ZEMBLE HERBAC2'
+ CNAMES(344,1)='POLAR MOUNT TUNDRA1'
+ CNAMES(345,1)='POLAR MOUNT TUNDRA2'
+ CNAMES(346,1)='S SCANDINAVIA TUNDRA1'
+ CNAMES(347,1)='NORTH TUNDRA1'
+ CNAMES(348,1)='S SCANDINAVIA TUNDRA2'
+ CNAMES(349,1)='NORTH RUSSIA TUNDRA1'
+ CNAMES(350,1)='ARAL CONTINENTAL GR1'
+ CNAMES(351,1)='MOUNTAIN TAIGA MOORS1'
+ CNAMES(352,1)='SCOTTISH SWAMP MOORS1'
+ CNAMES(353,1)='ATLANTIC COMPLEX2'
+ CNAMES(354,1)='ATLANTIC GR1'
+ CNAMES(355,1)='IR SCOT SWAMP MOORS1'
+ CNAMES(356,1)='ASIAN SPARSE GR1'
+ CNAMES(357,1)='AS SPARSE SW COMPLEX1'
+ CNAMES(358,1)='N CASPIAN DES OS1'
+ CNAMES(359,1)='ATLAS AS SPARSE COMP1'
+ CNAMES(360,1)='SPARSE SCO CEN EU GR1'
+ CNAMES(361,1)='TEMPERATE COMPLEX2'
+ CNAMES(362,1)='ATLANTIC COMPLEX3'
+ CNAMES(363,1)='ATLANTIC COMPLEX4'
+ CNAMES(364,1)='N ATLANTIC PASTURES1'
+ CNAMES(365,1)='SPARSE SCO CEN EU GR2'
+ CNAMES(366,1)='SPARSE MOUNT E EU GR1'
+ CNAMES(367,1)='TUR N CASP CONT GR1'
+ CNAMES(368,1)='N CASPIAN CONT GR1'
+ CNAMES(369,1)='IRA N CASP CONT GR1'
+ CNAMES(370,1)='TUR IRA MOUNT CONT GR1'
+ CNAMES(371,1)='E CASPIAN DES OS1'
+ CNAMES(372,1)='N CASPIAN COMPLEX1'
+ CNAMES(373,1)='IRAN MOUNT CONT GR1'
+ CNAMES(374,1)='ASIAN SPARSE DES OS1'
+ CNAMES(375,1)='E CASPIAN DES OS2'
+ CNAMES(376,1)='N MEDITER COMPLEX1'
+ CNAMES(377,1)='N MEDITER COMPLEX2'
+ CNAMES(378,1)='ASIAN MEDIT CONT GR1'
+ CNAMES(379,1)='SOUTH RUSSIA CONT GR1'
+ CNAMES(380,1)='BLSEA SPARSE CONT GR1'
+ CNAMES(381,1)='BLSEA SPARSE CONT GR2'
+ CNAMES(382,1)='TURK MOUNT CONT GR1'
+ CNAMES(383,1)='TURKISH COMPLEX1'
+ CNAMES(384,1)='CAUCASIAN COMPLEX1'
+ CNAMES(385,1)='N CASPIAN CONT GR2'
+ CNAMES(386,1)='VOLGA VALLEY CONT GR1'
+ CNAMES(387,1)='VOLGA VALLEY CONT GR2'
+ CNAMES(388,1)='W CASPIAN CONT GR1'
+ CNAMES(389,1)='CAUCASIAN COMPLEX2'
+ CNAMES(390,1)='CAUCASIAN COMPLEX3'
+ CNAMES(391,1)='BLSEA SPARSE CONT GR3'
+ CNAMES(392,1)='CENT MASSIF COMPLEX1'
+ CNAMES(393,1)='CENT MASSIF COMPLEX2'
+ CNAMES(394,1)='TURK COAST COMPLEX1'
+ CNAMES(395,1)='MESOPOTAMIA GR1'
+ CNAMES(396,1)='TURK CILICIA COMPLEX1'
+ CNAMES(397,1)='ASIAN COMPLEX1'
+ CNAMES(398,1)='N MED SPARSE COMPLEX1'
+ CNAMES(399,1)='MEDITER COMPLEX6'
+ CNAMES(400,1)='MEDIT SPARSE COMPLEX1'
+ CNAMES(401,1)='MEDIT SPARSE COMPLEX2'
+ CNAMES(402,1)='MEDIT SPARSE COMPLEX3'
+ CNAMES(403,1)='MEDIT SPARSE COMPLEX4'
+ CNAMES(404,1)='N MED HERBACEOUS CF1'
+ CNAMES(405,1)='ESTREMADURA GR1'
+ CNAMES(406,1)='TUNISIA COMPLEX1'
+ CNAMES(407,1)='TUNISIA HERBACEOUS1'
+ CNAMES(408,1)='ALGERIA HERBACEOUS1'
+ CNAMES(409,1)='DESERTIC HERBACEOUS1'
+ CNAMES(410,1)='DESERTIC HERBACEOUS2'
+ CNAMES(411,1)='SPAIN DES COMPLEX1'
+ CNAMES(412,1)='MED SPARSE COMPLEX5'
+ CNAMES(413,1)='MED SPARSE COMPLEX6'
+ CNAMES(414,1)='MED SPARSE COMPLEX7'
+ CNAMES(415,1)='ME SPARSE DES COMPL1'
+ CNAMES(416,1)='NORTH ARABIA GR1'
+ CNAMES(417,1)='N ARABIA DES COMPLEX1'
+ CNAMES(418,1)='N ARABIA DESERTIC GR1'
+ CNAMES(419,1)='MOROCCO HERBACEOUS1'
+ CNAMES(420,1)='S MED COAST HERBAC1'
+ CNAMES(421,1)='W MEDITER WOODLAND1'
+ CNAMES(422,1)='S MED COAST HERBAC2'
+ CNAMES(423,1)='MESOP DES HERBACEOUS1'
+ CNAMES(424,1)='MAG COAST DES HERBAC1'
+ CNAMES(425,1)='TU AR SPARSE HERBAC1'
+ CNAMES(426,1)='MEDIT SPARSE COMPLEX8'
+ CNAMES(427,1)='MED SPARSE HERBAC1'
+ CNAMES(428,1)='MEDIT SPARSE COMPLEX9'
+ CNAMES(429,1)='SPAIN SPARSE COMPLEX1'
+ CNAMES(430,1)='N MED SPARSE COMPLEX2'
+ CNAMES(431,1)='N MED SPARSE COMPLEX3'
+ CNAMES(432,1)='MAGHRE DES HERBAC1'
+ CNAMES(433,1)='MAGHRE DES HERBAC2'
+ CNAMES(434,1)='MAGHRE DES HERBAC3'
+ CNAMES(435,1)='N ARAB DES HERBAC1'
+ CNAMES(436,1)='MESOPO DES HERBAC2'
+ CNAMES(437,1)='TOURAN DES HERBAC1'
+ CNAMES(438,1)='MESOPO DES HERBAC2'
+ CNAMES(439,1)='TOURAN DES HERBAC2'
+ CNAMES(440,1)='NEW ZEMBLE HERBAC1'
+ CNAMES(441,1)='NEW ZEMBLE HERBAC2'
!crops
- CNAMES(442,1)='TRANS SIBERIAN CROPS1'
- CNAMES(443,1)='PO PLAIN CROPS1'
- CNAMES(444,1)='PO PLAIN CROPS2'
- CNAMES(445,1)='SPANISH FRENCH CROPS1'
- CNAMES(446,1)='SPANISH FR ITAL CROPS1'
- CNAMES(447,1)='DANUBE PLAIN CROPS1'
- CNAMES(448,1)='N MED SPARSE COMPLEX4'
- CNAMES(449,1)='BALKAN CROPS1'
- CNAMES(450,1)='SPAIN FR ITAL CROPS2'
- CNAMES(451,1)='ATLANTIC CROPS1'
- CNAMES(452,1)='FR MED SPARSE CROPS1'
- CNAMES(453,1)='FR MED SPARSE CROPS2'
- CNAMES(454,1)='ATL MED SPARSE CROPS1'
- CNAMES(455,1)='BENE BLACK SEA CROPS1'
- CNAMES(456,1)='FRENCH ITALIAN CROPS1'
- CNAMES(457,1)='FR MED SPARSE CROPS3'
- CNAMES(458,1)='MEDITER SPARSE CROPS1'
- CNAMES(459,1)='ATLANTIC CROPS2'
- CNAMES(460,1)='NORTH ATLANTIC CROPS1'
- CNAMES(461,1)='SOUTH RUSSIA CROPS1'
- CNAMES(462,1)='S RUSSIA BALTIC CROPS1'
- CNAMES(463,1)='UKRAINIAN CROPS1'
- CNAMES(464,1)='EAST CARPATES CROPS1'
- CNAMES(465,1)='E CENT EUROPE CROPS1'
- CNAMES(466,1)='W CENT EU SW CROPS1'
- CNAMES(467,1)='HUNGARIAN CROPS1'
- CNAMES(468,1)='N BLACK SEA CROPS1'
- CNAMES(469,1)='HUNG BULG CAUC CROPS1'
- CNAMES(470,1)='SOUTH SWEDEN CROPS1'
- CNAMES(471,1)='SW RUSSIA CROPS1'
- CNAMES(472,1)='SOUTH RUSSIA CROPS1'
- CNAMES(473,1)='IRAN N CASPIAN CROPS1'
- CNAMES(474,1)='FR TEMP SPARSE CROPS1'
- CNAMES(475,1)='BULGARIAN CROPS1'
- CNAMES(476,1)='BULGARIAN CROPS2'
- CNAMES(477,1)='SP TURK SPARSE CROPS1'
- CNAMES(478,1)='FRENCH CENT EU CROPS1'
- CNAMES(479,1)='N BLACK SEA CROPS2'
- CNAMES(480,1)='BULGARIAN CROPS3'
- CNAMES(481,1)='POLE CROPS1'
- CNAMES(482,1)='POLE CROPS2'
- CNAMES(483,1)='N BLACK SEA CROPS3'
- CNAMES(484,1)='CENT EU SPARSE CROPS1'
- CNAMES(485,1)='GERMAN CROPS1'
- CNAMES(486,1)='BEAUCE CROPS1'
- CNAMES(487,1)='DANE CROPS1'
- CNAMES(488,1)='DANE CROPS2'
- CNAMES(489,1)='NEU ATL SPARSE CROPS1'
- CNAMES(490,1)='SYRIAN CROPS1'
- CNAMES(491,1)='GERMAN CROPS2'
- CNAMES(492,1)='CHANNEL CROPS1'
- CNAMES(493,1)='CHANNEL CROPS2'
- CNAMES(494,1)='ITALIAN CROPS1'
- CNAMES(495,1)='TURKISH CROPS1'
- CNAMES(496,1)='N MEDIT SPARSE CROPS1'
- CNAMES(497,1)='SPAIN TUR ARAB CROPS1'
- CNAMES(498,1)='NORTH SPAIN CROPS1'
- CNAMES(499,1)='MOROCCO TUNIS CROPS1'
- CNAMES(500,1)='MOROCCO CROPS1'
- CNAMES(501,1)='MOROCCO CROPS2'
- CNAMES(502,1)='ALGERIAN CROPS1'
- CNAMES(503,1)='MOROCCO CROPS3'
- CNAMES(504,1)='WEST SPAIN CROPS1'
- CNAMES(505,1)='MOROCCO CROPS4'
- CNAMES(506,1)='NORTH MEDITER CROPS1'
- CNAMES(507,1)='SOUTH SPANISH CROPS1'
- CNAMES(508,1)='SICILIAN CROPS1'
- CNAMES(509,1)='MAGHREB SPARSE CROPS1'
- CNAMES(510,1)='N MEDIT SPARSE CROPS2'
- CNAMES(511,1)='N MEDIT SPARSE CROPS3'
- CNAMES(512,1)='SP IT WCOAST CROPS1'
- CNAMES(513,1)='ESTREMADURA CROPS1'
- CNAMES(514,1)='ESTREMADURA CROPS2'
- CNAMES(515,1)='SP IT WCOAST CROPS2'
- CNAMES(516,1)='ESTREMADURA CROPS3'
- CNAMES(517,1)='MEDIT ISLANDS CROPS1'
- CNAMES(518,1)='SPAIN W COAST CROPS1'
- CNAMES(519,1)='ESTREMADURA CROPS4'
- CNAMES(520,1)='MECOAST SPARSE CROPS1'
- CNAMES(521,1)='BRITTANY CROPS1'
- CNAMES(522,1)='SYRIAN CROPS2'
+ CNAMES(442,1)='TRANS SIBERIAN CROPS1'
+ CNAMES(443,1)='PO PLAIN CROPS1'
+ CNAMES(444,1)='PO PLAIN CROPS2'
+ CNAMES(445,1)='SPANISH FRENCH CROPS1'
+ CNAMES(446,1)='SPANISH FR ITAL CROPS1'
+ CNAMES(447,1)='DANUBE PLAIN CROPS1'
+ CNAMES(448,1)='N MED SPARSE COMPLEX4'
+ CNAMES(449,1)='BALKAN CROPS1'
+ CNAMES(450,1)='SPAIN FR ITAL CROPS2'
+ CNAMES(451,1)='ATLANTIC CROPS1'
+ CNAMES(452,1)='FR MED SPARSE CROPS1'
+ CNAMES(453,1)='FR MED SPARSE CROPS2'
+ CNAMES(454,1)='ATL MED SPARSE CROPS1'
+ CNAMES(455,1)='BENE BLACK SEA CROPS1'
+ CNAMES(456,1)='FRENCH ITALIAN CROPS1'
+ CNAMES(457,1)='FR MED SPARSE CROPS3'
+ CNAMES(458,1)='MEDITER SPARSE CROPS1'
+ CNAMES(459,1)='ATLANTIC CROPS2'
+ CNAMES(460,1)='NORTH ATLANTIC CROPS1'
+ CNAMES(461,1)='SOUTH RUSSIA CROPS1'
+ CNAMES(462,1)='S RUSSIA BALTIC CROPS1'
+ CNAMES(463,1)='UKRAINIAN CROPS1'
+ CNAMES(464,1)='EAST CARPATES CROPS1'
+ CNAMES(465,1)='E CENT EUROPE CROPS1'
+ CNAMES(466,1)='W CENT EU SW CROPS1'
+ CNAMES(467,1)='HUNGARIAN CROPS1'
+ CNAMES(468,1)='N BLACK SEA CROPS1'
+ CNAMES(469,1)='HUNG BULG CAUC CROPS1'
+ CNAMES(470,1)='SOUTH SWEDEN CROPS1'
+ CNAMES(471,1)='SW RUSSIA CROPS1'
+ CNAMES(472,1)='SOUTH RUSSIA CROPS1'
+ CNAMES(473,1)='IRAN N CASPIAN CROPS1'
+ CNAMES(474,1)='FR TEMP SPARSE CROPS1'
+ CNAMES(475,1)='BULGARIAN CROPS1'
+ CNAMES(476,1)='BULGARIAN CROPS2'
+ CNAMES(477,1)='SP TURK SPARSE CROPS1'
+ CNAMES(478,1)='FRENCH CENT EU CROPS1'
+ CNAMES(479,1)='N BLACK SEA CROPS2'
+ CNAMES(480,1)='BULGARIAN CROPS3'
+ CNAMES(481,1)='POLE CROPS1'
+ CNAMES(482,1)='POLE CROPS2'
+ CNAMES(483,1)='N BLACK SEA CROPS3'
+ CNAMES(484,1)='CENT EU SPARSE CROPS1'
+ CNAMES(485,1)='GERMAN CROPS1'
+ CNAMES(486,1)='BEAUCE CROPS1'
+ CNAMES(487,1)='DANE CROPS1'
+ CNAMES(488,1)='DANE CROPS2'
+ CNAMES(489,1)='NEU ATL SPARSE CROPS1'
+ CNAMES(490,1)='SYRIAN CROPS1'
+ CNAMES(491,1)='GERMAN CROPS2'
+ CNAMES(492,1)='CHANNEL CROPS1'
+ CNAMES(493,1)='CHANNEL CROPS2'
+ CNAMES(494,1)='ITALIAN CROPS1'
+ CNAMES(495,1)='TURKISH CROPS1'
+ CNAMES(496,1)='N MEDIT SPARSE CROPS1'
+ CNAMES(497,1)='SPAIN TUR ARAB CROPS1'
+ CNAMES(498,1)='NORTH SPAIN CROPS1'
+ CNAMES(499,1)='MOROCCO TUNIS CROPS1'
+ CNAMES(500,1)='MOROCCO CROPS1'
+ CNAMES(501,1)='MOROCCO CROPS2'
+ CNAMES(502,1)='ALGERIAN CROPS1'
+ CNAMES(503,1)='MOROCCO CROPS3'
+ CNAMES(504,1)='WEST SPAIN CROPS1'
+ CNAMES(505,1)='MOROCCO CROPS4'
+ CNAMES(506,1)='NORTH MEDITER CROPS1'
+ CNAMES(507,1)='SOUTH SPANISH CROPS1'
+ CNAMES(508,1)='SICILIAN CROPS1'
+ CNAMES(509,1)='MAGHREB SPARSE CROPS1'
+ CNAMES(510,1)='N MEDIT SPARSE CROPS2'
+ CNAMES(511,1)='N MEDIT SPARSE CROPS3'
+ CNAMES(512,1)='SP IT WCOAST CROPS1'
+ CNAMES(513,1)='ESTREMADURA CROPS1'
+ CNAMES(514,1)='ESTREMADURA CROPS2'
+ CNAMES(515,1)='SP IT WCOAST CROPS2'
+ CNAMES(516,1)='ESTREMADURA CROPS3'
+ CNAMES(517,1)='MEDIT ISLANDS CROPS1'
+ CNAMES(518,1)='SPAIN W COAST CROPS1'
+ CNAMES(519,1)='ESTREMADURA CROPS4'
+ CNAMES(520,1)='MECOAST SPARSE CROPS1'
+ CNAMES(521,1)='BRITTANY CROPS1'
+ CNAMES(522,1)='SYRIAN CROPS2'
!irrigated crops
- CNAMES(523,1)='NIL VALLEY CROPS1'
- CNAMES(524,1)='NIL VALLEY CROPS2'
- CNAMES(525,1)='NIL VALLEY CROPS3'
- CNAMES(526,1)='NIL VALLEY CROPS4'
- CNAMES(527,1)='SPANISH IRR CROPS1'
- CNAMES(528,1)='NIL VALLEY CROPS5'
- CNAMES(529,1)='EGEE IRR CROPS1'
- CNAMES(530,1)='MEDITER IRR CROPS1'
- CNAMES(531,1)='S SPAIN IRR CROPS1'
- CNAMES(532,1)='NIL VALLEY CROPS6'
+ CNAMES(523,1)='NIL VALLEY CROPS1'
+ CNAMES(524,1)='NIL VALLEY CROPS2'
+ CNAMES(525,1)='NIL VALLEY CROPS3'
+ CNAMES(526,1)='NIL VALLEY CROPS4'
+ CNAMES(527,1)='SPANISH IRR CROPS1'
+ CNAMES(528,1)='NIL VALLEY CROPS5'
+ CNAMES(529,1)='EGEE IRR CROPS1'
+ CNAMES(530,1)='MEDITER IRR CROPS1'
+ CNAMES(531,1)='S SPAIN IRR CROPS1'
+ CNAMES(532,1)='NIL VALLEY CROPS6'
!bare land
- CNAMES(533,1)='BARE ROCK1'
- CNAMES(534,1)='BARE ROCK2'
- CNAMES(535,1)='SANDY DESERT1'
- CNAMES(536,1)='BARE LAND1'
- CNAMES(537,1)='BARE LAND2'
- CNAMES(538,1)='BARE LAND3'
- CNAMES(539,1)='BARE LAND4'
- CNAMES(540,1)='BARE LAND5'
- CNAMES(541,1)='BARE LAND6'
- CNAMES(542,1)='BARE LAND7'
- CNAMES(543,1)='BARE LAND8'
- CNAMES(544,1)='BARE LAND9'
- CNAMES(545,1)='BARE LAND10'
- CNAMES(546,1)='BARE LAND11'
- CNAMES(547,1)='BARE LAND12'
- CNAMES(548,1)='PERMANENT SNOW1'
+ CNAMES(533,1)='BARE ROCK1'
+ CNAMES(534,1)='BARE ROCK2'
+ CNAMES(535,1)='SANDY DESERT1'
+ CNAMES(536,1)='BARE LAND1'
+ CNAMES(537,1)='BARE LAND2'
+ CNAMES(538,1)='BARE LAND3'
+ CNAMES(539,1)='BARE LAND4'
+ CNAMES(540,1)='BARE LAND5'
+ CNAMES(541,1)='BARE LAND6'
+ CNAMES(542,1)='BARE LAND7'
+ CNAMES(543,1)='BARE LAND8'
+ CNAMES(544,1)='BARE LAND9'
+ CNAMES(545,1)='BARE LAND10'
+ CNAMES(546,1)='BARE LAND11'
+ CNAMES(547,1)='BARE LAND12'
+ CNAMES(548,1)='PERMANENT SNOW1'
!Estuaries and swamp areas
- CNAMES(549,1)='WADDEN SEA'
- CNAMES(550,1)='ESTUARY1'
- CNAMES(551,1)='ESTUARY2'
- CNAMES(552,1)='POLAR WETLANDS1'
- CNAMES(553,1)='ESTUARY3'
- CNAMES(554,1)='ESTUARY4'
- CNAMES(555,1)='ESTUARY5'
- CNAMES(556,1)='ESTUARY6'
- CNAMES(557,1)='POLAR WETLANDS2'
- CNAMES(558,1)='SUBPOLAR WETLANDS1'
- CNAMES(559,1)='SUBPOLAR WETLANDS2'
- CNAMES(560,1)='SUBPOLAR WETLANDS3'
+ CNAMES(549,1)='WADDEN SEA'
+ CNAMES(550,1)='ESTUARY1'
+ CNAMES(551,1)='ESTUARY2'
+ CNAMES(552,1)='POLAR WETLANDS1'
+ CNAMES(553,1)='ESTUARY3'
+ CNAMES(554,1)='ESTUARY4'
+ CNAMES(555,1)='ESTUARY5'
+ CNAMES(556,1)='ESTUARY6'
+ CNAMES(557,1)='POLAR WETLANDS2'
+ CNAMES(558,1)='SUBPOLAR WETLANDS1'
+ CNAMES(559,1)='SUBPOLAR WETLANDS2'
+ CNAMES(560,1)='SUBPOLAR WETLANDS3'
!urban
- CNAMES(561,1)='TEMPERATE SUBURBAN1'
- CNAMES(562,1)='TEMPERATE SUBURBAN2'
- CNAMES(563,1)='TEMPERATE SUBURBAN3'
- CNAMES(564,1)='TEMPERATE SUBURBAN4'
- CNAMES(565,1)='TEMPERATE SUBURBAN5'
- CNAMES(566,1)='COLD SUBURBAN1'
- CNAMES(567,1)='WARM SUBURBAN1'
- CNAMES(568,1)='WARM SUBURBAN2'
- CNAMES(569,1)='TEMPERATE SUBURBAN6'
- CNAMES(570,1)='TEMPERATE SUBURBAN7'
- CNAMES(571,1)='WARM SUBURBAN3'
+ CNAMES(561,1)='TEMPERATE SUBURBAN1'
+ CNAMES(562,1)='TEMPERATE SUBURBAN2'
+ CNAMES(563,1)='TEMPERATE SUBURBAN3'
+ CNAMES(564,1)='TEMPERATE SUBURBAN4'
+ CNAMES(565,1)='TEMPERATE SUBURBAN5'
+ CNAMES(566,1)='COLD SUBURBAN1'
+ CNAMES(567,1)='WARM SUBURBAN1'
+ CNAMES(568,1)='WARM SUBURBAN2'
+ CNAMES(569,1)='TEMPERATE SUBURBAN6'
+ CNAMES(570,1)='TEMPERATE SUBURBAN7'
+ CNAMES(571,1)='WARM SUBURBAN3'
!added classes of permanent crops
- CNAMES(572,1)='SPANISH VINEYARDS1'
- CNAMES(573,1)='LANGUEDOC VINEYARDS1'
+ CNAMES(572,1)='SPANISH VINEYARDS1'
+ CNAMES(573,1)='LANGUEDOC VINEYARDS1'
!-------------------------------------------------------------------------------
!
- CNAMES(1,2) = "Mers et oc\'eans"
- CNAMES(2,2) = "Lacs"
- CNAMES(3,2) = "rivi\`eres"
- CNAMES(4,2) = "Sol nu"
- CNAMES(5,2) = "Rochers"
- CNAMES(6,2) = "Neiges perp\'etuelles"
- CNAMES(7,2) = "Ville"
+ CNAMES(1,2) = "Mers et oc\'eans"
+ CNAMES(2,2) = "Lacs"
+ CNAMES(3,2) = "rivi\`eres"
+ CNAMES(4,2) = "Sol nu"
+ CNAMES(5,2) = "Rochers"
+ CNAMES(6,2) = "Neiges perp\'etuelles"
+ CNAMES(7,2) = "Ville"
- CNAMES(8,2) = "\^iles non-d\'efinies (tropicales)"
- CNAMES(9,2) = "\^iles non-d\'efinies (subpolaires)"
-!
- CNAMES(10,2) = "For\^et persistante de Patagonie "
- CNAMES(11,2) = 'Taiga'
- CNAMES(12,2) = "For\^et de conif\`eres d'Extr\^eme-Orient "
- CNAMES(13,2) = "For\^et de conif\`eres continentale am\'ericaine"
- CNAMES(14,2) = "For\^et de conif\`eres subtropicale am\'ericaine"
- CNAMES(15,2) = '"Rain forest"'
+ CNAMES(8,2) = "\^iles non-d\'efinies (tropicales)"
+ CNAMES(9,2) = "\^iles non-d\'efinies (subpolaires)"
+!
+ CNAMES(10,2) = "For\^et persistante de Patagonie "
+ CNAMES(11,2) = 'Taiga'
+ CNAMES(12,2) = "For\^et de conif\`eres d'Extr\^eme-Orient "
+ CNAMES(13,2) = "For\^et de conif\`eres continentale am\'ericaine"
+ CNAMES(14,2) = "For\^et de conif\`eres subtropicale am\'ericaine"
+ CNAMES(15,2) = '"Rain forest"'
- CNAMES(16,2) = "For\^et \'equatoriale africaine"
- CNAMES(17,2) = "For\^et de Madagascar (aliz\'es)"
- CNAMES(18,2) = "For\^et \'equatoriale d'Oc\'eanie"
- CNAMES(19,2) = "For\^et persistante de Mousson"
- CNAMES(20,2) = "For\^et tropicale humide d'Oc\'eanie"
- CNAMES(21,2) = "For\^et amazonienne"
- CNAMES(22,2) = "For\^et primaire de Tasmanie"
- CNAMES(23,2) = "For\^et pan-am\'ericaine"
+ CNAMES(16,2) = "For\^et \'equatoriale africaine"
+ CNAMES(17,2) = "For\^et de Madagascar (aliz\'es)"
+ CNAMES(18,2) = "For\^et \'equatoriale d'Oc\'eanie"
+ CNAMES(19,2) = "For\^et persistante de Mousson"
+ CNAMES(20,2) = "For\^et tropicale humide d'Oc\'eanie"
+ CNAMES(21,2) = "For\^et amazonienne"
+ CNAMES(22,2) = "For\^et primaire de Tasmanie"
+ CNAMES(23,2) = "For\^et pan-am\'ericaine"
- CNAMES(24,2) = "Taiga sib\'erienne caduque"
+ CNAMES(24,2) = "Taiga sib\'erienne caduque"
- CNAMES(25,2) = "For\^et sub-amazonienne"
- CNAMES(26,2) = "For\^et caduque am\'ericaine"
- CNAMES(27,2) = "For\^et du Yucatan"
- CNAMES(28,2) = "For\^et sub-tropicale br\'esilienne"
+ CNAMES(25,2) = "For\^et sub-amazonienne"
+ CNAMES(26,2) = "For\^et caduque am\'ericaine"
+ CNAMES(27,2) = "For\^et du Yucatan"
+ CNAMES(28,2) = "For\^et sub-tropicale br\'esilienne"
- CNAMES(29,2) = "For\^et m\'elang\'ee tropicale s\`eche d'Afrique"
- CNAMES(30,2) = "For\^et m\'elang\'ee caduque de Patagonie"
- CNAMES(31,2) = "For\^et m\'elang\'ee sub-polaire"
- CNAMES(32,2) = "For\^et m\'elang\'ee humide sub-tropicale"
- CNAMES(33,2) = "For\^et m\'elang\'ee continentale"
+ CNAMES(29,2) = "For\^et m\'elang\'ee tropicale s\`eche d'Afrique"
+ CNAMES(30,2) = "For\^et m\'elang\'ee caduque de Patagonie"
+ CNAMES(31,2) = "For\^et m\'elang\'ee sub-polaire"
+ CNAMES(32,2) = "For\^et m\'elang\'ee humide sub-tropicale"
+ CNAMES(33,2) = "For\^et m\'elang\'ee continentale"
- CNAMES(34,2) = "Prairie bois\'ee sah\'elienne"
- CNAMES(35,2) = "Prairie bois\'ee d'Afrique m\'eridionale"
- CNAMES(36,2) = "Prairie bois\'ee \`a feuilles persistante"
- CNAMES(37,2) = "Prairie bois\'ee \'equatoriale d'Oc\'eanie"
- CNAMES(38,2) = "Prairie bois\'ee de Mousson"
- CNAMES(39,2) = "Cerradao"
- CNAMES(40,2) = "Cerradao d'Argentine"
- CNAMES(41,2) = "Prairie bois\'ee polaire"
- CNAMES(42,2) = "Prairie bois\'ee continentale"
- CNAMES(43,2) = "Prairie bois\'ee d'Extr\^eme-Orient"
- CNAMES(44,2) = "Prairie bois\'ee semi-aride"
- CNAMES(45,2) = "Prairie bois\'ee des Rocheuses"
- CNAMES(46,2) = "Prairie bois\'ee de Patagonie"
- CNAMES(47,2) = "Prairie bois\'ee des Etats du Sud"
+ CNAMES(34,2) = "Prairie bois\'ee sah\'elienne"
+ CNAMES(35,2) = "Prairie bois\'ee d'Afrique m\'eridionale"
+ CNAMES(36,2) = "Prairie bois\'ee \`a feuilles persistante"
+ CNAMES(37,2) = "Prairie bois\'ee \'equatoriale d'Oc\'eanie"
+ CNAMES(38,2) = "Prairie bois\'ee de Mousson"
+ CNAMES(39,2) = "Cerradao"
+ CNAMES(40,2) = "Cerradao d'Argentine"
+ CNAMES(41,2) = "Prairie bois\'ee polaire"
+ CNAMES(42,2) = "Prairie bois\'ee continentale"
+ CNAMES(43,2) = "Prairie bois\'ee d'Extr\^eme-Orient"
+ CNAMES(44,2) = "Prairie bois\'ee semi-aride"
+ CNAMES(45,2) = "Prairie bois\'ee des Rocheuses"
+ CNAMES(46,2) = "Prairie bois\'ee de Patagonie"
+ CNAMES(47,2) = "Prairie bois\'ee des Etats du Sud"
- CNAMES(48,2) = "Savane arbor\'ee sub-saharienne"
- CNAMES(49,2) = "Savane arbor\'ee sah\'elienne"
- CNAMES(50,2) = "Prairie arbor\'ee \'equatoriale africaine"
- CNAMES(51,2) = "Prairie arbor\'ee subtropicale africaine"
- CNAMES(52,2) = "Prairie arbor\'ee nord-australienne"
- CNAMES(53,2) = "Savane arbor\'ee australienne aride"
- CNAMES(54,2) = "Prairie arbor\'ee n\'eo-z\'elandaise"
- CNAMES(55,2) = "Prairie arbor\'ee d'Extr\^eme-Orient"
- CNAMES(56,2) = "Cerrado"
- CNAMES(57,2) = "Cerrado c\^otier"
- CNAMES(58,2) = "Sertao"
- CNAMES(59,2) = "Prairie arbor\'ee polaire"
- CNAMES(60,2) = "Prairie arbor\'ee continentale"
- CNAMES(61,2) = "Prairie arbor\'ee de Mousson"
- CNAMES(62,2) = "Prairie arbor\'ee pan-am\'ericaine"
- CNAMES(63,2) = "Prairie arbor\'ee des Etats du sud"
- CNAMES(64,2) = "Prairie arbor\'ee de la cordill\`ere des Andes"
- CNAMES(65,2) = "Prairie arbor\'ee Amazonienne"
- CNAMES(66,2) = "Prairie arbor\'ee du Maghreb"
+ CNAMES(48,2) = "Savane arbor\'ee sub-saharienne"
+ CNAMES(49,2) = "Savane arbor\'ee sah\'elienne"
+ CNAMES(50,2) = "Prairie arbor\'ee \'equatoriale africaine"
+ CNAMES(51,2) = "Prairie arbor\'ee subtropicale africaine"
+ CNAMES(52,2) = "Prairie arbor\'ee nord-australienne"
+ CNAMES(53,2) = "Savane arbor\'ee australienne aride"
+ CNAMES(54,2) = "Prairie arbor\'ee n\'eo-z\'elandaise"
+ CNAMES(55,2) = "Prairie arbor\'ee d'Extr\^eme-Orient"
+ CNAMES(56,2) = "Cerrado"
+ CNAMES(57,2) = "Cerrado c\^otier"
+ CNAMES(58,2) = "Sertao"
+ CNAMES(59,2) = "Prairie arbor\'ee polaire"
+ CNAMES(60,2) = "Prairie arbor\'ee continentale"
+ CNAMES(61,2) = "Prairie arbor\'ee de Mousson"
+ CNAMES(62,2) = "Prairie arbor\'ee pan-am\'ericaine"
+ CNAMES(63,2) = "Prairie arbor\'ee des Etats du sud"
+ CNAMES(64,2) = "Prairie arbor\'ee de la cordill\`ere des Andes"
+ CNAMES(65,2) = "Prairie arbor\'ee Amazonienne"
+ CNAMES(66,2) = "Prairie arbor\'ee du Maghreb"
- CNAMES(67,2) = "Savane arbustive d'Ethiopie"
- CNAMES(68,2) = "Savane arbustive sah\'elienne"
- CNAMES(69,2) = '"Bush" africain'
- CNAMES(70,2) = '"Bush" australien'
- CNAMES(71,2) = "Savane arbustive semi-d\'esertique"
- CNAMES(72,2) = "Savane arbustive dense c\^oti\`ere d'Oc\'eanie"
- CNAMES(73,2) = '"Bush" dense sud-australien'
- CNAMES(74,2) = "Tundra arbustive dense"
- CNAMES(75,2) = "Steppe asiatique arbustive dense"
- CNAMES(76,2) = "Prairie arbustive de Mousson"
- CNAMES(77,2) = "Tundra dense am\'ericaine"
- CNAMES(78,2) = "Prairie arbustive d'altitude (Rocheuses)"
- CNAMES(79,2) = "Prairie arbustive du Maghreb"
+ CNAMES(67,2) = "Savane arbustive d'Ethiopie"
+ CNAMES(68,2) = "Savane arbustive sah\'elienne"
+ CNAMES(69,2) = '"Bush" africain'
+ CNAMES(70,2) = '"Bush" australien'
+ CNAMES(71,2) = "Savane arbustive semi-d\'esertique"
+ CNAMES(72,2) = "Savane arbustive dense c\^oti\`ere d'Oc\'eanie"
+ CNAMES(73,2) = '"Bush" dense sud-australien'
+ CNAMES(74,2) = "Tundra arbustive dense"
+ CNAMES(75,2) = "Steppe asiatique arbustive dense"
+ CNAMES(76,2) = "Prairie arbustive de Mousson"
+ CNAMES(77,2) = "Tundra dense am\'ericaine"
+ CNAMES(78,2) = "Prairie arbustive d'altitude (Rocheuses)"
+ CNAMES(79,2) = "Prairie arbustive du Maghreb"
- CNAMES(80,2) = "Savane \'eparse semi-d\'esertique"
- CNAMES(81,2) = "Savane Sah\'elienne"
- CNAMES(82,2) = "Bush \'epars"
- CNAMES(83,2) = "Pampa"
- CNAMES(84,2) = "Prairie \'eparse de Mousson"
- CNAMES(85,2) = "Tundra polaire"
- CNAMES(86,2) = "Tundra sub-polaire"
- CNAMES(87,2) = "Prairie d'altitude (Rocheuses)"
+ CNAMES(80,2) = "Savane \'eparse semi-d\'esertique"
+ CNAMES(81,2) = "Savane Sah\'elienne"
+ CNAMES(82,2) = "Bush \'epars"
+ CNAMES(83,2) = "Pampa"
+ CNAMES(84,2) = "Prairie \'eparse de Mousson"
+ CNAMES(85,2) = "Tundra polaire"
+ CNAMES(86,2) = "Tundra sub-polaire"
+ CNAMES(87,2) = "Prairie d'altitude (Rocheuses)"
- CNAMES(88,2) = "Prairie tropicale africaine"
- CNAMES(89,2) = "Prairie africaine semi-aride"
- CNAMES(90,2) = "Prairie d'Afrique m\'eridionale"
- CNAMES(91,2) = "Prairie \'equatoriale c\^oti\`ere"
- CNAMES(92,2) = "Prairie semi-d\'esertique"
- CNAMES(93,2) = "Prairie n\'eo-z\'elandaise"
- CNAMES(94,2) = "Prairie de Mousson"
- CNAMES(95,2) = "Prairie v\'en\'ezu\'elienne"
- CNAMES(96,2) = "Prairie sub-amazonienne"
- CNAMES(97,2) = "Pampa et prairie"
- CNAMES(98,2) = "Prairie de Patagonie"
- CNAMES(99,2) = "Steppes"
- CNAMES(100,2) = "Prairie polaire"
- CNAMES(101,2) = "Prairie d'Extr\^eme-Orient"
- CNAMES(102,2) = "Prairie indienne"
- CNAMES(103,2) = "Prairie d'altitude (Rocheuses)"
- CNAMES(104,2) = "Prairie chinoise"
+ CNAMES(88,2) = "Prairie tropicale africaine"
+ CNAMES(89,2) = "Prairie africaine semi-aride"
+ CNAMES(90,2) = "Prairie d'Afrique m\'eridionale"
+ CNAMES(91,2) = "Prairie \'equatoriale c\^oti\`ere"
+ CNAMES(92,2) = "Prairie semi-d\'esertique"
+ CNAMES(93,2) = "Prairie n\'eo-z\'elandaise"
+ CNAMES(94,2) = "Prairie de Mousson"
+ CNAMES(95,2) = "Prairie v\'en\'ezu\'elienne"
+ CNAMES(96,2) = "Prairie sub-amazonienne"
+ CNAMES(97,2) = "Pampa et prairie"
+ CNAMES(98,2) = "Prairie de Patagonie"
+ CNAMES(99,2) = "Steppes"
+ CNAMES(100,2) = "Prairie polaire"
+ CNAMES(101,2) = "Prairie d'Extr\^eme-Orient"
+ CNAMES(102,2) = "Prairie indienne"
+ CNAMES(103,2) = "Prairie d'altitude (Rocheuses)"
+ CNAMES(104,2) = "Prairie chinoise"
- CNAMES(105,2) = "Cultures d\'esertique et le long du Nil"
- CNAMES(106,2) = "Cultures sah\'elienne"
- CNAMES(107,2) = "Cultures tropicales"
- CNAMES(108,2) = "Cultures c\^oti\`eres africaines"
- CNAMES(109,2) = "Cultures sud-australiennes"
- CNAMES(110,2) = "Cultures pan-am\'ericaines"
- CNAMES(111,2) = "Cultures de la plaine du Parana"
- CNAMES(112,2) = "Zones cultiv\'ees sub-amazoniennes"
- CNAMES(113,2) = "Zones cultiv\'ees trans-siberiennes"
- CNAMES(114,2) = "Zones cultiv\'ees de Mandchourie"
- CNAMES(115,2) = "Zones cultiv\'ees de Chine"
- CNAMES(116,2) = "Zones cultiv\'ees sub-polaires"
- CNAMES(117,2) = "Zones cultiv\'ees sub-himalayennes"
- CNAMES(118,2) = "Cultures des Grandes Plaines"
- CNAMES(119,2) = "Cultures des Etats du Sud"
- CNAMES(120,2) = "Cultures californiennes"
- CNAMES(121,2) = "Zones cultiv\'ees du Maghreb"
- CNAMES(122,2) = "Zones cultiv\'ees d'Afrique du Sud"
+ CNAMES(105,2) = "Cultures d\'esertique et le long du Nil"
+ CNAMES(106,2) = "Cultures sah\'elienne"
+ CNAMES(107,2) = "Cultures tropicales"
+ CNAMES(108,2) = "Cultures c\^oti\`eres africaines"
+ CNAMES(109,2) = "Cultures sud-australiennes"
+ CNAMES(110,2) = "Cultures pan-am\'ericaines"
+ CNAMES(111,2) = "Cultures de la plaine du Parana"
+ CNAMES(112,2) = "Zones cultiv\'ees sub-amazoniennes"
+ CNAMES(113,2) = "Zones cultiv\'ees trans-siberiennes"
+ CNAMES(114,2) = "Zones cultiv\'ees de Mandchourie"
+ CNAMES(115,2) = "Zones cultiv\'ees de Chine"
+ CNAMES(116,2) = "Zones cultiv\'ees sub-polaires"
+ CNAMES(117,2) = "Zones cultiv\'ees sub-himalayennes"
+ CNAMES(118,2) = "Cultures des Grandes Plaines"
+ CNAMES(119,2) = "Cultures des Etats du Sud"
+ CNAMES(120,2) = "Cultures californiennes"
+ CNAMES(121,2) = "Zones cultiv\'ees du Maghreb"
+ CNAMES(122,2) = "Zones cultiv\'ees d'Afrique du Sud"
- CNAMES(123,2) = "Tundra \'eparse"
+ CNAMES(123,2) = "Tundra \'eparse"
- CNAMES(124,2) = "Marais tropicaux et sub-tropicaux"
- CNAMES(125,2) = "Marais polaires et sub-polaires"
-!
- CNAMES(151,2) = "Urbain dense"
- CNAMES(152,2) = "Suburbain m\'editerran\'een"
- CNAMES(153,2) = "Suburbain temp\'er\'e"
- CNAMES(154,2) = "Suburbain froid"
- CNAMES(155,2) = "Zones industrielles et commerciales"
- CNAMES(156,2) = "R\'eseaux routiers et ferroviaires"
- CNAMES(157,2) = "Zones portuaires"
- CNAMES(158,2) = "A\'eroports"
- CNAMES(159,2) = "Extraction de mat\'eriaux, sites de construction"
- CNAMES(160,2) = "Parcs urbains"
- CNAMES(161,2) = "Equipements sportifs et de loisirs"
-!
- CNAMES(162,2) = "Cultures espagnoles"
- CNAMES(163,2) = "Cultures d\'Estremadure"
- CNAMES(164,2) = "Cultures m\'editerran\'eennes"
- CNAMES(165,2) = "Cultures de la c\^ote atlantique"
- CNAMES(166,2) = "Cultures temp\'er\'ees"
- CNAMES(167,2) = "Cultures de la plaine du P\^o"
- CNAMES(168,2) = "Cultures temp\'er\'ees chaudes"
- CNAMES(169,2) = "Cultures ukrainiennes"
- CNAMES(170,2) = "Cultures subpolaires"
- CNAMES(171,2) = "Cultures montagneuses"
- CNAMES(172,2) = "Cultures d'Europe Centrale"
- CNAMES(173,2) = "Cultures turques"
-!
- CNAMES(174,2) = "Cultures m\'editerran\'eennes irrigu\'ees"
- CNAMES(175,2) = "Cultures irrigu\'ees"
- CNAMES(176,2) = "Rizi\`eres"
-!
- CNAMES(177,2) = "Vignobles m\'editerran\'eens"
- CNAMES(178,2) = "Vignobles temp\'er\'es"
- CNAMES(179,2) = "Arbres fruitiers m\'editerran\'eens"
- CNAMES(180,2) = "Arbres fruitiers temp\'er\'es"
- CNAMES(181,2) = "Oliveraies"
-!
- CNAMES(182,2) = "P\^atures temp\'er\'ees"
- CNAMES(183,2) = "P\^atures c\^oti\`eres atlantiques"
- CNAMES(184,2) = "P\^atures d'Europe Centrale et orientale"
- CNAMES(185,2) = "P\^atures ukrainiennes"
- CNAMES(186,2) = "P\^atures subpolaires"
-!
- CNAMES(187,2) = "Cultures complexes espagnoles"
- CNAMES(188,2) = "Cultures complexes m\'editerran\'eennes"
- CNAMES(189,2) = "Cultures complexes temp\'er\'ees"
- CNAMES(190,2) = "Cultures complexes françaises"
- CNAMES(191,2) = "Cultures complexes balkaniques"
-!
- CNAMES(192,2) = "Cultures bois\'ees m\'editerran\'eennes"
- CNAMES(193,2) = "Cultures bois\'ees"
- CNAMES(194,2) = "Cultures bois\'ees françaises"
- CNAMES(195,2) = "Cultures bois\'ees m\'editerran\'eennes"
- CNAMES(196,2) = "Cultures bois\'ees espagnoles"
- CNAMES(197,2) = "Cultures bois\'ees des pays baltes"
-!
- CNAMES(198,2) = "Zones agro-foresti\`eres"
-!
- CNAMES(199,2) = "For\^et de feuillus espagnole"
- CNAMES(200,2) = "For\^et de feuillus d\'Estremadure"
- CNAMES(201,2) = "For\^et de feuillus m\'editerran\'eennes"
- CNAMES(202,2) = "For\^et de feuillus de la c\^ote atlantique"
- CNAMES(203,2) = "For\^et de feuillus temp\'er\'ee"
- CNAMES(204,2) = "For\^et de feuillus montagneuses"
- CNAMES(205,2) = "For\^et de feuillus balkanique"
- CNAMES(206,2) = "For\^et de feuillus balkanique"
- CNAMES(207,2) = "For\^et de feuillus de la mer Noire"
-!
- CNAMES(208,2) = "Pins m\'editerran\'eens"
- CNAMES(209,2) = "For\^et des Landes"
- CNAMES(210,2) = "For\^et de conif\`eres montagneuse"
- CNAMES(211,2) = "For\^et de conif\`eres temp\'er\'ee"
- CNAMES(212,2) = "Taiga subpolaire"
- CNAMES(213,2) = "Taiga russe"
- CNAMES(214,2) = "For\^et de conif\`eres turque"
-!
- CNAMES(215,2) = "For\^et mixte m\'editerran\'eenne"
- CNAMES(216,2) = "For\^et mixte française \& c\^oti\`ere atlantique"
- CNAMES(217,2) = "For\^et mixte subpolaire"
- CNAMES(218,2) = "For\^et mixte montagneuses"
- CNAMES(219,2) = "For\^et mixte d'Europe orientale"
-!
- CNAMES(220,2) = "Prairie m\'editerran\'eenne"
- CNAMES(221,2) = "Prairie c\^oti\`ere atlantique"
- CNAMES(222,2) = "Prairie balkanique"
- CNAMES(223,2) = "Prairie d\'Estremadure"
- CNAMES(224,2) = "Prairie subpolaire"
- CNAMES(225,2) = "Tundra"
-!
- CNAMES(226,2) = "Landes turques"
- CNAMES(227,2) = "Landes et broussailles m\'editerran\'eennes"
- CNAMES(228,2) = "Landes et broussailles montagneuses"
- CNAMES(229,2) = "Landes et broussailles c\^oti\`eres atlantiques"
-!
- CNAMES(230,2) = "V\'eg\'etation arbustive turque"
- CNAMES(231,2) = "Maquis m\'editerran\'een"
- CNAMES(232,2) = "Maquis montagneux"
-!
- CNAMES(233,2) = "Zones bois\'ees espagnoles"
- CNAMES(234,2) = "Zones bois\'ees m\'editerran\'eennes"
- CNAMES(235,2) = "Zones bois\'ees temp\'er\'ees"
-!
- CNAMES(236,2) = "V\'eg\'etation clairsem\'ee"
- CNAMES(237,2) = "Zones br\^ul\'ees"
- CNAMES(238,2) = "Zones humides temp\'er\'ees"
- CNAMES(239,2) = "Zones humides subpolaires"
- CNAMES(240,2) = "Tourbi\`eres"
- CNAMES(241,2) = "Marais salants"
+ CNAMES(124,2) = "Marais tropicaux et sub-tropicaux"
+ CNAMES(125,2) = "Marais polaires et sub-polaires"
+!
+ CNAMES(151,2) = "Urbain dense"
+ CNAMES(152,2) = "Suburbain m\'editerran\'een"
+ CNAMES(153,2) = "Suburbain temp\'er\'e"
+ CNAMES(154,2) = "Suburbain froid"
+ CNAMES(155,2) = "Zones industrielles et commerciales"
+ CNAMES(156,2) = "R\'eseaux routiers et ferroviaires"
+ CNAMES(157,2) = "Zones portuaires"
+ CNAMES(158,2) = "A\'eroports"
+ CNAMES(159,2) = "Extraction de mat\'eriaux, sites de construction"
+ CNAMES(160,2) = "Parcs urbains"
+ CNAMES(161,2) = "Equipements sportifs et de loisirs"
+!
+ CNAMES(162,2) = "Cultures espagnoles"
+ CNAMES(163,2) = "Cultures d\'Estremadure"
+ CNAMES(164,2) = "Cultures m\'editerran\'eennes"
+ CNAMES(165,2) = "Cultures de la c\^ote atlantique"
+ CNAMES(166,2) = "Cultures temp\'er\'ees"
+ CNAMES(167,2) = "Cultures de la plaine du P\^o"
+ CNAMES(168,2) = "Cultures temp\'er\'ees chaudes"
+ CNAMES(169,2) = "Cultures ukrainiennes"
+ CNAMES(170,2) = "Cultures subpolaires"
+ CNAMES(171,2) = "Cultures montagneuses"
+ CNAMES(172,2) = "Cultures d'Europe Centrale"
+ CNAMES(173,2) = "Cultures turques"
+!
+ CNAMES(174,2) = "Cultures m\'editerran\'eennes irrigu\'ees"
+ CNAMES(175,2) = "Cultures irrigu\'ees"
+ CNAMES(176,2) = "Rizi\`eres"
+!
+ CNAMES(177,2) = "Vignobles m\'editerran\'eens"
+ CNAMES(178,2) = "Vignobles temp\'er\'es"
+ CNAMES(179,2) = "Arbres fruitiers m\'editerran\'eens"
+ CNAMES(180,2) = "Arbres fruitiers temp\'er\'es"
+ CNAMES(181,2) = "Oliveraies"
+!
+ CNAMES(182,2) = "P\^atures temp\'er\'ees"
+ CNAMES(183,2) = "P\^atures c\^oti\`eres atlantiques"
+ CNAMES(184,2) = "P\^atures d'Europe Centrale et orientale"
+ CNAMES(185,2) = "P\^atures ukrainiennes"
+ CNAMES(186,2) = "P\^atures subpolaires"
+!
+ CNAMES(187,2) = "Cultures complexes espagnoles"
+ CNAMES(188,2) = "Cultures complexes m\'editerran\'eennes"
+ CNAMES(189,2) = "Cultures complexes temp\'er\'ees"
+ CNAMES(190,2) = "Cultures complexes françaises"
+ CNAMES(191,2) = "Cultures complexes balkaniques"
+!
+ CNAMES(192,2) = "Cultures bois\'ees m\'editerran\'eennes"
+ CNAMES(193,2) = "Cultures bois\'ees"
+ CNAMES(194,2) = "Cultures bois\'ees françaises"
+ CNAMES(195,2) = "Cultures bois\'ees m\'editerran\'eennes"
+ CNAMES(196,2) = "Cultures bois\'ees espagnoles"
+ CNAMES(197,2) = "Cultures bois\'ees des pays baltes"
+!
+ CNAMES(198,2) = "Zones agro-foresti\`eres"
+!
+ CNAMES(199,2) = "For\^et de feuillus espagnole"
+ CNAMES(200,2) = "For\^et de feuillus d\'Estremadure"
+ CNAMES(201,2) = "For\^et de feuillus m\'editerran\'eennes"
+ CNAMES(202,2) = "For\^et de feuillus de la c\^ote atlantique"
+ CNAMES(203,2) = "For\^et de feuillus temp\'er\'ee"
+ CNAMES(204,2) = "For\^et de feuillus montagneuses"
+ CNAMES(205,2) = "For\^et de feuillus balkanique"
+ CNAMES(206,2) = "For\^et de feuillus balkanique"
+ CNAMES(207,2) = "For\^et de feuillus de la mer Noire"
+!
+ CNAMES(208,2) = "Pins m\'editerran\'eens"
+ CNAMES(209,2) = "For\^et des Landes"
+ CNAMES(210,2) = "For\^et de conif\`eres montagneuse"
+ CNAMES(211,2) = "For\^et de conif\`eres temp\'er\'ee"
+ CNAMES(212,2) = "Taiga subpolaire"
+ CNAMES(213,2) = "Taiga russe"
+ CNAMES(214,2) = "For\^et de conif\`eres turque"
+!
+ CNAMES(215,2) = "For\^et mixte m\'editerran\'eenne"
+ CNAMES(216,2) = "For\^et mixte française \& c\^oti\`ere atlantique"
+ CNAMES(217,2) = "For\^et mixte subpolaire"
+ CNAMES(218,2) = "For\^et mixte montagneuses"
+ CNAMES(219,2) = "For\^et mixte d'Europe orientale"
+!
+ CNAMES(220,2) = "Prairie m\'editerran\'eenne"
+ CNAMES(221,2) = "Prairie c\^oti\`ere atlantique"
+ CNAMES(222,2) = "Prairie balkanique"
+ CNAMES(223,2) = "Prairie d\'Estremadure"
+ CNAMES(224,2) = "Prairie subpolaire"
+ CNAMES(225,2) = "Tundra"
+!
+ CNAMES(226,2) = "Landes turques"
+ CNAMES(227,2) = "Landes et broussailles m\'editerran\'eennes"
+ CNAMES(228,2) = "Landes et broussailles montagneuses"
+ CNAMES(229,2) = "Landes et broussailles c\^oti\`eres atlantiques"
+!
+ CNAMES(230,2) = "V\'eg\'etation arbustive turque"
+ CNAMES(231,2) = "Maquis m\'editerran\'een"
+ CNAMES(232,2) = "Maquis montagneux"
+!
+ CNAMES(233,2) = "Zones bois\'ees espagnoles"
+ CNAMES(234,2) = "Zones bois\'ees m\'editerran\'eennes"
+ CNAMES(235,2) = "Zones bois\'ees temp\'er\'ees"
+!
+ CNAMES(236,2) = "V\'eg\'etation clairsem\'ee"
+ CNAMES(237,2) = "Zones br\^ul\'ees"
+ CNAMES(238,2) = "Zones humides temp\'er\'ees"
+ CNAMES(239,2) = "Zones humides subpolaires"
+ CNAMES(240,2) = "Tourbi\`eres"
+ CNAMES(241,2) = "Marais salants"
!
- CNAMES(242,2) = "Zones intertidales"
- CNAMES(243,2) = "Lagunes littorales"
-!
- CNAMES(301,2)='N SCANDINAVIA TUNDRA1'
- CNAMES(302,2)='OURAL BF1'
- CNAMES(303,2)='CARELIE BF1'
- CNAMES(304,2)='NORTH RUSSIAN TAIGA1'
- CNAMES(305,2)='NORTH RUSSIAN TAIGA2'
- CNAMES(306,2)='CARELIE BF2'
- CNAMES(307,2)='RUSSIAN TAIGA3'
- CNAMES(308,2)='RUSSIAN BF1'
- CNAMES(309,2)='RUSSIAN TAIGA4'
- CNAMES(310,2)='S SCANDINAVIA TAIGA1'
- CNAMES(311,2)='SOUTH FINLANDIA MF1'
- CNAMES(312,2)='SOUTH NORWAY MF1'
- CNAMES(313,2)='BALTIC BF1'
- CNAMES(314,2)='BALTIC MF1'
- CNAMES(315,2)='SOUTH SWEDEN CF1'
- CNAMES(316,2)='BALTIC MF2'
- CNAMES(317,2)='SOUTH SWEDEN CF2'
- CNAMES(318,2)='SOUTH SWEDEN CF3'
- CNAMES(319,2)='SOUTH SWEDEN MF1'
- CNAMES(320,2)='MOUNTAIN MF1'
- CNAMES(321,2)='MOUNTAIN BF1'
- CNAMES(322,2)='TEMPERATE BF1'
- CNAMES(323,2)='TEMPERATE COMPLEX1'
- CNAMES(324,2)='MOUNTAIN CF1'
- CNAMES(325,2)='TEMP HERBACEOUS CF1'
- CNAMES(326,2)='ATLANTIC COAST BF1'
- CNAMES(327,2)='TURKISH CF1'
- CNAMES(328,2)='BALKAN CF1'
- CNAMES(329,2)='N SPAIN HERBAC MF1'
- CNAMES(330,2)='TEMP SW HERBAC CF1'
- CNAMES(331,2)='ATLANTIC COMPLEX1'
- CNAMES(332,2)='N SPAIN HERBAC MF2'
- CNAMES(333,2)='MEDITER COMPLEX1'
- CNAMES(334,2)='MEDITER COMPLEX2'
- CNAMES(335,2)='MEDITER COMPLEX3'
- CNAMES(336,2)='MEDITER COMPLEX4'
- CNAMES(337,2)='MEDITER COMPLEX5'
- CNAMES(338,2)='BURNT PORT HERBAC CF1'
- CNAMES(339,2)='BURNT PORT HERBAC BF1'
- CNAMES(340,2)='EGEE COAST COMPLEX1'
- CNAMES(341,2)='W MED COAST COMPLEX1'
- CNAMES(342,2)='MAGHR HERBACEOUS MF1'
- CNAMES(343,2)='ESTREM HERBACEOUS MF1'
+ CNAMES(242,2) = "Zones intertidales"
+ CNAMES(243,2) = "Lagunes littorales"
+!
+ CNAMES(301,2)='N SCANDINAVIA TUNDRA1'
+ CNAMES(302,2)='OURAL BF1'
+ CNAMES(303,2)='CARELIE BF1'
+ CNAMES(304,2)='NORTH RUSSIAN TAIGA1'
+ CNAMES(305,2)='NORTH RUSSIAN TAIGA2'
+ CNAMES(306,2)='CARELIE BF2'
+ CNAMES(307,2)='RUSSIAN TAIGA3'
+ CNAMES(308,2)='RUSSIAN BF1'
+ CNAMES(309,2)='RUSSIAN TAIGA4'
+ CNAMES(310,2)='S SCANDINAVIA TAIGA1'
+ CNAMES(311,2)='SOUTH FINLANDIA MF1'
+ CNAMES(312,2)='SOUTH NORWAY MF1'
+ CNAMES(313,2)='BALTIC BF1'
+ CNAMES(314,2)='BALTIC MF1'
+ CNAMES(315,2)='SOUTH SWEDEN CF1'
+ CNAMES(316,2)='BALTIC MF2'
+ CNAMES(317,2)='SOUTH SWEDEN CF2'
+ CNAMES(318,2)='SOUTH SWEDEN CF3'
+ CNAMES(319,2)='SOUTH SWEDEN MF1'
+ CNAMES(320,2)='MOUNTAIN MF1'
+ CNAMES(321,2)='MOUNTAIN BF1'
+ CNAMES(322,2)='TEMPERATE BF1'
+ CNAMES(323,2)='TEMPERATE COMPLEX1'
+ CNAMES(324,2)='MOUNTAIN CF1'
+ CNAMES(325,2)='TEMP HERBACEOUS CF1'
+ CNAMES(326,2)='ATLANTIC COAST BF1'
+ CNAMES(327,2)='TURKISH CF1'
+ CNAMES(328,2)='BALKAN CF1'
+ CNAMES(329,2)='N SPAIN HERBAC MF1'
+ CNAMES(330,2)='TEMP SW HERBAC CF1'
+ CNAMES(331,2)='ATLANTIC COMPLEX1'
+ CNAMES(332,2)='N SPAIN HERBAC MF2'
+ CNAMES(333,2)='MEDITER COMPLEX1'
+ CNAMES(334,2)='MEDITER COMPLEX2'
+ CNAMES(335,2)='MEDITER COMPLEX3'
+ CNAMES(336,2)='MEDITER COMPLEX4'
+ CNAMES(337,2)='MEDITER COMPLEX5'
+ CNAMES(338,2)='BURNT PORT HERBAC CF1'
+ CNAMES(339,2)='BURNT PORT HERBAC BF1'
+ CNAMES(340,2)='EGEE COAST COMPLEX1'
+ CNAMES(341,2)='W MED COAST COMPLEX1'
+ CNAMES(342,2)='MAGHR HERBACEOUS MF1'
+ CNAMES(343,2)='ESTREM HERBACEOUS MF1'
!herbaceous / shrub covers
- CNAMES(344,2)='POLAR MOUNT TUNDRA1'
- CNAMES(345,2)='POLAR MOUNT TUNDRA2'
- CNAMES(346,2)='S SCANDINAVIA TUNDRA1'
- CNAMES(347,2)='NORTH TUNDRA1'
- CNAMES(348,2)='S SCANDINAVIA TUNDRA2'
- CNAMES(349,2)='NORTH RUSSIA TUNDRA1'
- CNAMES(350,2)='ARAL CONTINENTAL GR1'
- CNAMES(351,2)='MOUNTAIN TAIGA MOORS1'
- CNAMES(352,2)='SCOTTISH SWAMP MOORS1'
- CNAMES(353,2)='ATLANTIC COMPLEX2'
- CNAMES(354,2)='ATLANTIC GR1'
- CNAMES(355,2)='IR SCOT SWAMP MOORS1'
- CNAMES(356,2)='ASIAN SPARSE GR1'
- CNAMES(357,2)='AS SPARSE SW COMPLEX1'
- CNAMES(358,2)='N CASPIAN DES OS1'
- CNAMES(359,2)='ATLAS AS SPARSE COMP1'
- CNAMES(360,2)='SPARSE SCO CEN EU GR1'
- CNAMES(361,2)='TEMPERATE COMPLEX2'
- CNAMES(362,2)='ATLANTIC COMPLEX3'
- CNAMES(363,2)='ATLANTIC COMPLEX4'
- CNAMES(364,2)='N ATLANTIC PASTURES1'
- CNAMES(365,2)='SPARSE SCO CEN EU GR2'
- CNAMES(366,2)='SPARSE MOUNT E EU GR1'
- CNAMES(367,2)='TUR N CASP CONT GR1'
- CNAMES(368,2)='N CASPIAN CONT GR1'
- CNAMES(369,2)='IRA N CASP CONT GR1'
- CNAMES(370,2)='TUR IRA MOUNT CONT GR1'
- CNAMES(371,2)='E CASPIAN DES OS1'
- CNAMES(372,2)='N CASPIAN COMPLEX1'
- CNAMES(373,2)='IRAN MOUNT CONT GR1'
- CNAMES(374,2)='ASIAN SPARSE DES OS1'
- CNAMES(375,2)='E CASPIAN DES OS2'
- CNAMES(376,2)='N MEDITER COMPLEX1'
- CNAMES(377,2)='N MEDITER COMPLEX2'
- CNAMES(378,2)='ASIAN MEDIT CONT GR1'
- CNAMES(379,2)='SOUTH RUSSIA CONT GR1'
- CNAMES(380,2)='BLSEA SPARSE CONT GR1'
- CNAMES(381,2)='BLSEA SPARSE CONT GR2'
- CNAMES(382,2)='TURK MOUNT CONT GR1'
- CNAMES(383,2)='TURKISH COMPLEX1'
- CNAMES(384,2)='CAUCASIAN COMPLEX1'
- CNAMES(385,2)='N CASPIAN CONT GR2'
- CNAMES(386,2)='VOLGA VALLEY CONT GR1'
- CNAMES(387,2)='VOLGA VALLEY CONT GR2'
- CNAMES(388,2)='W CASPIAN CONT GR1'
- CNAMES(389,2)='CAUCASIAN COMPLEX2'
- CNAMES(390,2)='CAUCASIAN COMPLEX3'
- CNAMES(391,2)='BLSEA SPARSE CONT GR3'
- CNAMES(392,2)='CENT MASSIF COMPLEX1'
- CNAMES(393,2)='CENT MASSIF COMPLEX2'
- CNAMES(394,2)='TURK COAST COMPLEX1'
- CNAMES(395,2)='MESOPOTAMIA GR1'
- CNAMES(396,2)='TURK CILICIA COMPLEX1'
- CNAMES(397,2)='ASIAN COMPLEX1'
- CNAMES(398,2)='N MED SPARSE COMPLEX1'
- CNAMES(399,2)='MEDITER COMPLEX6'
- CNAMES(400,2)='MEDIT SPARSE COMPLEX1'
- CNAMES(401,2)='MEDIT SPARSE COMPLEX2'
- CNAMES(402,2)='MEDIT SPARSE COMPLEX3'
- CNAMES(403,2)='MEDIT SPARSE COMPLEX4'
- CNAMES(404,2)='N MED HERBACEOUS CF1'
- CNAMES(405,2)='ESTREMADURA GR1'
- CNAMES(406,2)='TUNISIA COMPLEX1'
- CNAMES(407,2)='TUNISIA HERBACEOUS1'
- CNAMES(408,2)='ALGERIA HERBACEOUS1'
- CNAMES(409,2)='DESERTIC HERBACEOUS1'
- CNAMES(410,2)='DESERTIC HERBACEOUS2'
- CNAMES(411,2)='SPAIN DES COMPLEX1'
- CNAMES(412,2)='MED SPARSE COMPLEX5'
- CNAMES(413,2)='MED SPARSE COMPLEX6'
- CNAMES(414,2)='MED SPARSE COMPLEX7'
- CNAMES(415,2)='ME SPARSE DES COMPL1'
- CNAMES(416,2)='NORTH ARABIA GR1'
- CNAMES(417,2)='N ARABIA DES COMPLEX1'
- CNAMES(418,2)='N ARABIA DESERTIC GR1'
- CNAMES(419,2)='MOROCCO HERBACEOUS1'
- CNAMES(420,2)='S MED COAST HERBAC1'
- CNAMES(421,2)='W MEDITER WOODLAND1'
- CNAMES(422,2)='S MED COAST HERBAC2'
- CNAMES(423,2)='MESOP DES HERBACEOUS1'
- CNAMES(424,2)='MAG COAST DES HERBAC1'
- CNAMES(425,2)='TU AR SPARSE HERBAC1'
- CNAMES(426,2)='MEDIT SPARSE COMPLEX8'
- CNAMES(427,2)='MED SPARSE HERBAC1'
- CNAMES(428,2)='MEDIT SPARSE COMPLEX9'
- CNAMES(429,2)='SPAIN SPARSE COMPLEX1'
- CNAMES(430,2)='N MED SPARSE COMPLEX2'
- CNAMES(431,2)='N MED SPARSE COMPLEX3'
- CNAMES(432,2)='MAGHRE DES HERBAC1'
- CNAMES(433,2)='MAGHRE DES HERBAC2'
- CNAMES(434,2)='MAGHRE DES HERBAC3'
- CNAMES(435,2)='N ARAB DES HERBAC1'
- CNAMES(436,2)='MESOPO DES HERBAC2'
- CNAMES(437,2)='TOURAN DES HERBAC1'
- CNAMES(438,2)='MESOPO DES HERBAC2'
- CNAMES(439,2)='TOURAN DES HERBAC2'
- CNAMES(440,2)='NEW ZEMBLE HERBAC1'
- CNAMES(441,2)='NEW ZEMBLE HERBAC2'
+ CNAMES(344,2)='POLAR MOUNT TUNDRA1'
+ CNAMES(345,2)='POLAR MOUNT TUNDRA2'
+ CNAMES(346,2)='S SCANDINAVIA TUNDRA1'
+ CNAMES(347,2)='NORTH TUNDRA1'
+ CNAMES(348,2)='S SCANDINAVIA TUNDRA2'
+ CNAMES(349,2)='NORTH RUSSIA TUNDRA1'
+ CNAMES(350,2)='ARAL CONTINENTAL GR1'
+ CNAMES(351,2)='MOUNTAIN TAIGA MOORS1'
+ CNAMES(352,2)='SCOTTISH SWAMP MOORS1'
+ CNAMES(353,2)='ATLANTIC COMPLEX2'
+ CNAMES(354,2)='ATLANTIC GR1'
+ CNAMES(355,2)='IR SCOT SWAMP MOORS1'
+ CNAMES(356,2)='ASIAN SPARSE GR1'
+ CNAMES(357,2)='AS SPARSE SW COMPLEX1'
+ CNAMES(358,2)='N CASPIAN DES OS1'
+ CNAMES(359,2)='ATLAS AS SPARSE COMP1'
+ CNAMES(360,2)='SPARSE SCO CEN EU GR1'
+ CNAMES(361,2)='TEMPERATE COMPLEX2'
+ CNAMES(362,2)='ATLANTIC COMPLEX3'
+ CNAMES(363,2)='ATLANTIC COMPLEX4'
+ CNAMES(364,2)='N ATLANTIC PASTURES1'
+ CNAMES(365,2)='SPARSE SCO CEN EU GR2'
+ CNAMES(366,2)='SPARSE MOUNT E EU GR1'
+ CNAMES(367,2)='TUR N CASP CONT GR1'
+ CNAMES(368,2)='N CASPIAN CONT GR1'
+ CNAMES(369,2)='IRA N CASP CONT GR1'
+ CNAMES(370,2)='TUR IRA MOUNT CONT GR1'
+ CNAMES(371,2)='E CASPIAN DES OS1'
+ CNAMES(372,2)='N CASPIAN COMPLEX1'
+ CNAMES(373,2)='IRAN MOUNT CONT GR1'
+ CNAMES(374,2)='ASIAN SPARSE DES OS1'
+ CNAMES(375,2)='E CASPIAN DES OS2'
+ CNAMES(376,2)='N MEDITER COMPLEX1'
+ CNAMES(377,2)='N MEDITER COMPLEX2'
+ CNAMES(378,2)='ASIAN MEDIT CONT GR1'
+ CNAMES(379,2)='SOUTH RUSSIA CONT GR1'
+ CNAMES(380,2)='BLSEA SPARSE CONT GR1'
+ CNAMES(381,2)='BLSEA SPARSE CONT GR2'
+ CNAMES(382,2)='TURK MOUNT CONT GR1'
+ CNAMES(383,2)='TURKISH COMPLEX1'
+ CNAMES(384,2)='CAUCASIAN COMPLEX1'
+ CNAMES(385,2)='N CASPIAN CONT GR2'
+ CNAMES(386,2)='VOLGA VALLEY CONT GR1'
+ CNAMES(387,2)='VOLGA VALLEY CONT GR2'
+ CNAMES(388,2)='W CASPIAN CONT GR1'
+ CNAMES(389,2)='CAUCASIAN COMPLEX2'
+ CNAMES(390,2)='CAUCASIAN COMPLEX3'
+ CNAMES(391,2)='BLSEA SPARSE CONT GR3'
+ CNAMES(392,2)='CENT MASSIF COMPLEX1'
+ CNAMES(393,2)='CENT MASSIF COMPLEX2'
+ CNAMES(394,2)='TURK COAST COMPLEX1'
+ CNAMES(395,2)='MESOPOTAMIA GR1'
+ CNAMES(396,2)='TURK CILICIA COMPLEX1'
+ CNAMES(397,2)='ASIAN COMPLEX1'
+ CNAMES(398,2)='N MED SPARSE COMPLEX1'
+ CNAMES(399,2)='MEDITER COMPLEX6'
+ CNAMES(400,2)='MEDIT SPARSE COMPLEX1'
+ CNAMES(401,2)='MEDIT SPARSE COMPLEX2'
+ CNAMES(402,2)='MEDIT SPARSE COMPLEX3'
+ CNAMES(403,2)='MEDIT SPARSE COMPLEX4'
+ CNAMES(404,2)='N MED HERBACEOUS CF1'
+ CNAMES(405,2)='ESTREMADURA GR1'
+ CNAMES(406,2)='TUNISIA COMPLEX1'
+ CNAMES(407,2)='TUNISIA HERBACEOUS1'
+ CNAMES(408,2)='ALGERIA HERBACEOUS1'
+ CNAMES(409,2)='DESERTIC HERBACEOUS1'
+ CNAMES(410,2)='DESERTIC HERBACEOUS2'
+ CNAMES(411,2)='SPAIN DES COMPLEX1'
+ CNAMES(412,2)='MED SPARSE COMPLEX5'
+ CNAMES(413,2)='MED SPARSE COMPLEX6'
+ CNAMES(414,2)='MED SPARSE COMPLEX7'
+ CNAMES(415,2)='ME SPARSE DES COMPL1'
+ CNAMES(416,2)='NORTH ARABIA GR1'
+ CNAMES(417,2)='N ARABIA DES COMPLEX1'
+ CNAMES(418,2)='N ARABIA DESERTIC GR1'
+ CNAMES(419,2)='MOROCCO HERBACEOUS1'
+ CNAMES(420,2)='S MED COAST HERBAC1'
+ CNAMES(421,2)='W MEDITER WOODLAND1'
+ CNAMES(422,2)='S MED COAST HERBAC2'
+ CNAMES(423,2)='MESOP DES HERBACEOUS1'
+ CNAMES(424,2)='MAG COAST DES HERBAC1'
+ CNAMES(425,2)='TU AR SPARSE HERBAC1'
+ CNAMES(426,2)='MEDIT SPARSE COMPLEX8'
+ CNAMES(427,2)='MED SPARSE HERBAC1'
+ CNAMES(428,2)='MEDIT SPARSE COMPLEX9'
+ CNAMES(429,2)='SPAIN SPARSE COMPLEX1'
+ CNAMES(430,2)='N MED SPARSE COMPLEX2'
+ CNAMES(431,2)='N MED SPARSE COMPLEX3'
+ CNAMES(432,2)='MAGHRE DES HERBAC1'
+ CNAMES(433,2)='MAGHRE DES HERBAC2'
+ CNAMES(434,2)='MAGHRE DES HERBAC3'
+ CNAMES(435,2)='N ARAB DES HERBAC1'
+ CNAMES(436,2)='MESOPO DES HERBAC2'
+ CNAMES(437,2)='TOURAN DES HERBAC1'
+ CNAMES(438,2)='MESOPO DES HERBAC2'
+ CNAMES(439,2)='TOURAN DES HERBAC2'
+ CNAMES(440,2)='NEW ZEMBLE HERBAC1'
+ CNAMES(441,2)='NEW ZEMBLE HERBAC2'
!crops
- CNAMES(442,2)='TRANS SIBERIAN CROPS1'
- CNAMES(443,2)='PO PLAIN CROPS1'
- CNAMES(444,2)='PO PLAIN CROPS2'
- CNAMES(445,2)='SPANISH FRENCH CROPS1'
- CNAMES(446,2)='SPANISH FR ITAL CROPS1'
- CNAMES(447,2)='DANUBE PLAIN CROPS1'
- CNAMES(448,2)='N MED SPARSE COMPLEX4'
- CNAMES(449,2)='BALKAN CROPS1'
- CNAMES(450,2)='SPAIN FR ITAL CROPS2'
- CNAMES(451,2)='ATLANTIC CROPS1'
- CNAMES(452,2)='FR MED SPARSE CROPS1'
- CNAMES(453,2)='FR MED SPARSE CROPS2'
- CNAMES(454,2)='ATL MED SPARSE CROPS1'
- CNAMES(455,2)='BENE BLACK SEA CROPS1'
- CNAMES(456,2)='FRENCH ITALIAN CROPS1'
- CNAMES(457,2)='FR MED SPARSE CROPS3'
- CNAMES(458,2)='MEDITER SPARSE CROPS1'
- CNAMES(459,2)='ATLANTIC CROPS2'
- CNAMES(460,2)='NORTH ATLANTIC CROPS1'
- CNAMES(461,2)='SOUTH RUSSIA CROPS1'
- CNAMES(462,2)='S RUSSIA BALTIC CROPS1'
- CNAMES(463,2)='UKRAINIAN CROPS1'
- CNAMES(464,2)='EAST CARPATES CROPS1'
- CNAMES(465,2)='E CENT EUROPE CROPS1'
- CNAMES(466,2)='W CENT EU SW CROPS1'
- CNAMES(467,2)='HUNGARIAN CROPS1'
- CNAMES(468,2)='N BLACK SEA CROPS1'
- CNAMES(469,2)='HUNG BULG CAUC CROPS1'
- CNAMES(470,2)='SOUTH SWEDEN CROPS1'
- CNAMES(471,2)='SW RUSSIA CROPS1'
- CNAMES(472,2)='SOUTH RUSSIA CROPS1'
- CNAMES(473,2)='IRAN N CASPIAN CROPS1'
- CNAMES(474,2)='FR TEMP SPARSE CROPS1'
- CNAMES(475,2)='BULGARIAN CROPS1'
- CNAMES(476,2)='BULGARIAN CROPS2'
- CNAMES(477,2)='SP TURK SPARSE CROPS1'
- CNAMES(478,2)='FRENCH CENT EU CROPS1'
- CNAMES(479,2)='N BLACK SEA CROPS2'
- CNAMES(480,2)='BULGARIAN CROPS3'
- CNAMES(481,2)='POLE CROPS1'
- CNAMES(482,2)='POLE CROPS2'
- CNAMES(483,2)='N BLACK SEA CROPS3'
- CNAMES(484,2)='CENT EU SPARSE CROPS1'
- CNAMES(485,2)='GERMAN CROPS1'
- CNAMES(486,2)='BEAUCE CROPS1'
- CNAMES(487,2)='DANE CROPS1'
- CNAMES(488,2)='DANE CROPS2'
- CNAMES(489,2)='NEU ATL SPARSE CROPS1'
- CNAMES(490,2)='SYRIAN CROPS1'
- CNAMES(491,2)='GERMAN CROPS2'
- CNAMES(492,2)='CHANNEL CROPS1'
- CNAMES(493,2)='CHANNEL CROPS2'
- CNAMES(494,2)='ITALIAN CROPS1'
- CNAMES(495,2)='TURKISH CROPS1'
- CNAMES(496,2)='N MEDIT SPARSE CROPS1'
- CNAMES(497,2)='SPAIN TUR ARAB CROPS1'
- CNAMES(498,2)='NORTH SPAIN CROPS1'
- CNAMES(499,2)='MOROCCO TUNIS CROPS1'
- CNAMES(500,2)='MOROCCO CROPS1'
- CNAMES(501,2)='MOROCCO CROPS2'
- CNAMES(502,2)='ALGERIAN CROPS1'
- CNAMES(503,2)='MOROCCO CROPS3'
- CNAMES(504,2)='WEST SPAIN CROPS1'
- CNAMES(505,2)='MOROCCO CROPS4'
- CNAMES(506,2)='NORTH MEDITER CROPS1'
- CNAMES(507,2)='SOUTH SPANISH CROPS1'
- CNAMES(508,2)='SICILIAN CROPS1'
- CNAMES(509,2)='MAGHREB SPARSE CROPS1'
- CNAMES(510,2)='N MEDIT SPARSE CROPS2'
- CNAMES(511,2)='N MEDIT SPARSE CROPS3'
- CNAMES(512,2)='SP IT WCOAST CROPS1'
- CNAMES(513,2)='ESTREMADURA CROPS1'
- CNAMES(514,2)='ESTREMADURA CROPS2'
- CNAMES(515,2)='SP IT WCOAST CROPS2'
- CNAMES(516,2)='ESTREMADURA CROPS3'
- CNAMES(517,2)='MEDIT ISLANDS CROPS1'
- CNAMES(518,2)='SPAIN W COAST CROPS1'
- CNAMES(519,2)='ESTREMADURA CROPS4'
- CNAMES(520,2)='MECOAST SPARSE CROPS1'
- CNAMES(521,2)='BRITTANY CROPS1'
- CNAMES(522,2)='SYRIAN CROPS2'
+ CNAMES(442,2)='TRANS SIBERIAN CROPS1'
+ CNAMES(443,2)='PO PLAIN CROPS1'
+ CNAMES(444,2)='PO PLAIN CROPS2'
+ CNAMES(445,2)='SPANISH FRENCH CROPS1'
+ CNAMES(446,2)='SPANISH FR ITAL CROPS1'
+ CNAMES(447,2)='DANUBE PLAIN CROPS1'
+ CNAMES(448,2)='N MED SPARSE COMPLEX4'
+ CNAMES(449,2)='BALKAN CROPS1'
+ CNAMES(450,2)='SPAIN FR ITAL CROPS2'
+ CNAMES(451,2)='ATLANTIC CROPS1'
+ CNAMES(452,2)='FR MED SPARSE CROPS1'
+ CNAMES(453,2)='FR MED SPARSE CROPS2'
+ CNAMES(454,2)='ATL MED SPARSE CROPS1'
+ CNAMES(455,2)='BENE BLACK SEA CROPS1'
+ CNAMES(456,2)='FRENCH ITALIAN CROPS1'
+ CNAMES(457,2)='FR MED SPARSE CROPS3'
+ CNAMES(458,2)='MEDITER SPARSE CROPS1'
+ CNAMES(459,2)='ATLANTIC CROPS2'
+ CNAMES(460,2)='NORTH ATLANTIC CROPS1'
+ CNAMES(461,2)='SOUTH RUSSIA CROPS1'
+ CNAMES(462,2)='S RUSSIA BALTIC CROPS1'
+ CNAMES(463,2)='UKRAINIAN CROPS1'
+ CNAMES(464,2)='EAST CARPATES CROPS1'
+ CNAMES(465,2)='E CENT EUROPE CROPS1'
+ CNAMES(466,2)='W CENT EU SW CROPS1'
+ CNAMES(467,2)='HUNGARIAN CROPS1'
+ CNAMES(468,2)='N BLACK SEA CROPS1'
+ CNAMES(469,2)='HUNG BULG CAUC CROPS1'
+ CNAMES(470,2)='SOUTH SWEDEN CROPS1'
+ CNAMES(471,2)='SW RUSSIA CROPS1'
+ CNAMES(472,2)='SOUTH RUSSIA CROPS1'
+ CNAMES(473,2)='IRAN N CASPIAN CROPS1'
+ CNAMES(474,2)='FR TEMP SPARSE CROPS1'
+ CNAMES(475,2)='BULGARIAN CROPS1'
+ CNAMES(476,2)='BULGARIAN CROPS2'
+ CNAMES(477,2)='SP TURK SPARSE CROPS1'
+ CNAMES(478,2)='FRENCH CENT EU CROPS1'
+ CNAMES(479,2)='N BLACK SEA CROPS2'
+ CNAMES(480,2)='BULGARIAN CROPS3'
+ CNAMES(481,2)='POLE CROPS1'
+ CNAMES(482,2)='POLE CROPS2'
+ CNAMES(483,2)='N BLACK SEA CROPS3'
+ CNAMES(484,2)='CENT EU SPARSE CROPS1'
+ CNAMES(485,2)='GERMAN CROPS1'
+ CNAMES(486,2)='BEAUCE CROPS1'
+ CNAMES(487,2)='DANE CROPS1'
+ CNAMES(488,2)='DANE CROPS2'
+ CNAMES(489,2)='NEU ATL SPARSE CROPS1'
+ CNAMES(490,2)='SYRIAN CROPS1'
+ CNAMES(491,2)='GERMAN CROPS2'
+ CNAMES(492,2)='CHANNEL CROPS1'
+ CNAMES(493,2)='CHANNEL CROPS2'
+ CNAMES(494,2)='ITALIAN CROPS1'
+ CNAMES(495,2)='TURKISH CROPS1'
+ CNAMES(496,2)='N MEDIT SPARSE CROPS1'
+ CNAMES(497,2)='SPAIN TUR ARAB CROPS1'
+ CNAMES(498,2)='NORTH SPAIN CROPS1'
+ CNAMES(499,2)='MOROCCO TUNIS CROPS1'
+ CNAMES(500,2)='MOROCCO CROPS1'
+ CNAMES(501,2)='MOROCCO CROPS2'
+ CNAMES(502,2)='ALGERIAN CROPS1'
+ CNAMES(503,2)='MOROCCO CROPS3'
+ CNAMES(504,2)='WEST SPAIN CROPS1'
+ CNAMES(505,2)='MOROCCO CROPS4'
+ CNAMES(506,2)='NORTH MEDITER CROPS1'
+ CNAMES(507,2)='SOUTH SPANISH CROPS1'
+ CNAMES(508,2)='SICILIAN CROPS1'
+ CNAMES(509,2)='MAGHREB SPARSE CROPS1'
+ CNAMES(510,2)='N MEDIT SPARSE CROPS2'
+ CNAMES(511,2)='N MEDIT SPARSE CROPS3'
+ CNAMES(512,2)='SP IT WCOAST CROPS1'
+ CNAMES(513,2)='ESTREMADURA CROPS1'
+ CNAMES(514,2)='ESTREMADURA CROPS2'
+ CNAMES(515,2)='SP IT WCOAST CROPS2'
+ CNAMES(516,2)='ESTREMADURA CROPS3'
+ CNAMES(517,2)='MEDIT ISLANDS CROPS1'
+ CNAMES(518,2)='SPAIN W COAST CROPS1'
+ CNAMES(519,2)='ESTREMADURA CROPS4'
+ CNAMES(520,2)='MECOAST SPARSE CROPS1'
+ CNAMES(521,2)='BRITTANY CROPS1'
+ CNAMES(522,2)='SYRIAN CROPS2'
!irrigated crops
- CNAMES(523,2)='NIL VALLEY CROPS1'
- CNAMES(524,2)='NIL VALLEY CROPS2'
- CNAMES(525,2)='NIL VALLEY CROPS3'
- CNAMES(526,2)='NIL VALLEY CROPS4'
- CNAMES(527,2)='SPANISH IRR CROPS1'
- CNAMES(528,2)='NIL VALLEY CROPS5'
- CNAMES(529,2)='EGEE IRR CROPS1'
- CNAMES(530,2)='MEDITER IRR CROPS1'
- CNAMES(531,2)='S SPAIN IRR CROPS1'
- CNAMES(532,2)='NIL VALLEY CROPS6'
+ CNAMES(523,2)='NIL VALLEY CROPS1'
+ CNAMES(524,2)='NIL VALLEY CROPS2'
+ CNAMES(525,2)='NIL VALLEY CROPS3'
+ CNAMES(526,2)='NIL VALLEY CROPS4'
+ CNAMES(527,2)='SPANISH IRR CROPS1'
+ CNAMES(528,2)='NIL VALLEY CROPS5'
+ CNAMES(529,2)='EGEE IRR CROPS1'
+ CNAMES(530,2)='MEDITER IRR CROPS1'
+ CNAMES(531,2)='S SPAIN IRR CROPS1'
+ CNAMES(532,2)='NIL VALLEY CROPS6'
!bare land
- CNAMES(533,2)='BARE ROCK1'
- CNAMES(534,2)='BARE ROCK2'
- CNAMES(535,2)='SANDY DESERT1'
- CNAMES(536,2)='BARE LAND1'
- CNAMES(537,2)='BARE LAND2'
- CNAMES(538,2)='BARE LAND3'
- CNAMES(539,2)='BARE LAND4'
- CNAMES(540,2)='BARE LAND5'
- CNAMES(541,2)='BARE LAND6'
- CNAMES(542,2)='BARE LAND7'
- CNAMES(543,2)='BARE LAND8'
- CNAMES(544,2)='BARE LAND9'
- CNAMES(545,2)='BARE LAND10'
- CNAMES(546,2)='BARE LAND11'
- CNAMES(547,2)='BARE LAND12'
- CNAMES(548,2)='PERMANENT SNOW1'
+ CNAMES(533,2)='BARE ROCK1'
+ CNAMES(534,2)='BARE ROCK2'
+ CNAMES(535,2)='SANDY DESERT1'
+ CNAMES(536,2)='BARE LAND1'
+ CNAMES(537,2)='BARE LAND2'
+ CNAMES(538,2)='BARE LAND3'
+ CNAMES(539,2)='BARE LAND4'
+ CNAMES(540,2)='BARE LAND5'
+ CNAMES(541,2)='BARE LAND6'
+ CNAMES(542,2)='BARE LAND7'
+ CNAMES(543,2)='BARE LAND8'
+ CNAMES(544,2)='BARE LAND9'
+ CNAMES(545,2)='BARE LAND10'
+ CNAMES(546,2)='BARE LAND11'
+ CNAMES(547,2)='BARE LAND12'
+ CNAMES(548,2)='PERMANENT SNOW1'
!Estuaries and swamp areas
- CNAMES(549,2)='WADDEN SEA'
- CNAMES(550,2)='ESTUARY1'
- CNAMES(551,2)='ESTUARY2'
- CNAMES(552,2)='POLAR WETLANDS1'
- CNAMES(553,2)='ESTUARY3'
- CNAMES(554,2)='ESTUARY4'
- CNAMES(555,2)='ESTUARY5'
- CNAMES(556,2)='ESTUARY6'
- CNAMES(557,2)='POLAR WETLANDS2'
- CNAMES(558,2)='SUBPOLAR WETLANDS1'
- CNAMES(559,2)='SUBPOLAR WETLANDS2'
- CNAMES(560,2)='SUBPOLAR WETLANDS3'
+ CNAMES(549,2)='WADDEN SEA'
+ CNAMES(550,2)='ESTUARY1'
+ CNAMES(551,2)='ESTUARY2'
+ CNAMES(552,2)='POLAR WETLANDS1'
+ CNAMES(553,2)='ESTUARY3'
+ CNAMES(554,2)='ESTUARY4'
+ CNAMES(555,2)='ESTUARY5'
+ CNAMES(556,2)='ESTUARY6'
+ CNAMES(557,2)='POLAR WETLANDS2'
+ CNAMES(558,2)='SUBPOLAR WETLANDS1'
+ CNAMES(559,2)='SUBPOLAR WETLANDS2'
+ CNAMES(560,2)='SUBPOLAR WETLANDS3'
!urban
- CNAMES(561,2)='TEMPERATE SUBURBAN1'
- CNAMES(562,2)='TEMPERATE SUBURBAN2'
- CNAMES(563,2)='TEMPERATE SUBURBAN3'
- CNAMES(564,2)='TEMPERATE SUBURBAN4'
- CNAMES(565,2)='TEMPERATE SUBURBAN5'
- CNAMES(566,2)='COLD SUBURBAN1'
- CNAMES(567,2)='WARM SUBURBAN1'
- CNAMES(568,2)='WARM SUBURBAN2'
- CNAMES(569,2)='TEMPERATE SUBURBAN6'
- CNAMES(570,2)='TEMPERATE SUBURBAN7'
- CNAMES(571,2)='WARM SUBURBAN3'
+ CNAMES(561,2)='TEMPERATE SUBURBAN1'
+ CNAMES(562,2)='TEMPERATE SUBURBAN2'
+ CNAMES(563,2)='TEMPERATE SUBURBAN3'
+ CNAMES(564,2)='TEMPERATE SUBURBAN4'
+ CNAMES(565,2)='TEMPERATE SUBURBAN5'
+ CNAMES(566,2)='COLD SUBURBAN1'
+ CNAMES(567,2)='WARM SUBURBAN1'
+ CNAMES(568,2)='WARM SUBURBAN2'
+ CNAMES(569,2)='TEMPERATE SUBURBAN6'
+ CNAMES(570,2)='TEMPERATE SUBURBAN7'
+ CNAMES(571,2)='WARM SUBURBAN3'
!added classes of permanent crops
- CNAMES(572,2)='SPANISH VINEYARDS1'
- CNAMES(573,2)='LANGUEDOC VINEYARDS1'
-
+ CNAMES(572,2)='SPANISH VINEYARDS1'
+ CNAMES(573,2)='LANGUEDOC VINEYARDS1'
+ENDIF
IF (.NOT. ALLOCATED(CNAME)) ALLOCATE(CNAME(JPCOVER))
IF (CLANG=='EN') THEN
- DO JCOVER=1,JPCOVER
- CNAME(JCOVER) = CNAMES(JCOVER,1)
+ DO JCOV=1,JPCOVER
+ CNAME(JCOV) = CNAMES(JCOV,1)
ENDDO
ELSE
- DO JCOVER=1,JPCOVER
- CNAME(JCOVER) = CNAMES(JCOVER,2)
+ DO JCOV=1,JPCOVER
+ CNAME(JCOV) = CNAMES(JCOV,2)
ENDDO
END IF
!
-!$OMP END SINGLE
-!
ENDIF
!-------------------------------------------------------------------------------
!
!* 9. Arrange cover (optional nam_pgd_arrange_cover & option to use !gardens or not)
! ------------------------------------------------------------------------------
!
- CALL ARRANGE_COVER(DTCO, U, &
+ CALL ARRANGE_COVER(DTCO, U%LWATER_TO_NATURE, U%LTOWN_TO_ROCK, &
XDATA_NATURE,XDATA_TOWN,XDATA_SEA,XDATA_WATER,XDATA_VEGTYPE, &
XDATA_GARDEN,U%LGARDEN, XDATA_BLD, XDATA_WALL_O_HOR )
!
-XDATA_ROOT_DEPTHGV(:,:) = XDATA_ROOT_DEPTH(:,:)
-!
!-------------------------------------------------------------------------------
!
!* 10. LAI for ecoclimap2: climatological or not
! -----------------------------------------
!
- CALL ECOCLIMAP2_LAI(DTCO)
+IF (.NOT.U%LECOSG) CALL ECOCLIMAP2_LAI(DTCO%NYEAR)
!
!-------------------------------------------------------------------------------
!
!* 11. Secondary variables on natural covers
! -------------------------------------
!
- CALL INI_DATA_PARAM(DTCO%XDATA_VEGTYPE, PSURF=DTCO%XDATA_NATURE, PSURF2=DTCO%XDATA_GARDEN, PH_TREE=XDATA_H_TREE,PLAI=XDATA_LAI, &
- PALBNIR_VEG=XDATA_ALBNIR_VEG, PALBVIS_VEG=XDATA_ALBVIS_VEG, &
- PALBUV_VEG=XDATA_ALBUV_VEG, PRSMIN=XDATA_RSMIN, &
- PRGL=XDATA_RGL, PCV=XDATA_CV, PGAMMA=XDATA_GAMMA, &
- PGMES=XDATA_GMES, PGC=XDATA_GC, PBSLAI=XDATA_BSLAI, &
- PSEFOLD=XDATA_SEFOLD, PLAIMIN_OUT=XDATA_LAIMIN, PDMAX=XDATA_DMAX, &
- PSTRESS=XDATA_STRESS, PF2I=XDATA_F2I, PVEG_OUT=XDATA_VEG, &
- PGREEN=XDATA_GREEN, PZ0=XDATA_Z0, PZ0_O_Z0H=XDATA_Z0_O_Z0H, &
- PEMIS_ECO=XDATA_EMIS_ECO, PWRMAX_CF=XDATA_WRMAX_CF, &
- PROOT_LIN=XDATA_ROOT_LIN, PROOT_EXTINCTION=XDATA_ROOT_EXTINCTION, &
- PSOILRC_SO2=XDATA_SOILRC_SO2, PSOILRC_O3=XDATA_SOILRC_O3, PRE25=XDATA_RE25, &
- PCE_NITRO=XDATA_CE_NITRO,PCF_NITRO=XDATA_CF_NITRO,PCNA_NITRO=XDATA_CNA_NITRO, &
- PGMES_ST=XDATA_GMES_ST, PGC_ST=XDATA_GC_ST, PBSLAI_ST=XDATA_BSLAI_ST, &
- PSEFOLD_ST=XDATA_SEFOLD_ST, PDMAX_ST=XDATA_DMAX_ST, &
- PGNDLITTER=XDATA_GNDLITTER, &
- PRGLGV=XDATA_RGLGV,PGAMMAGV=XDATA_GAMMAGV, PRSMINGV=XDATA_RSMINGV, &
- PROOT_EXTINCTIONGV=XDATA_ROOT_EXTINCTIONGV, PWRMAX_CFGV=XDATA_WRMAX_CFGV, &
- PH_VEG=XDATA_H_VEG, PLAIGV_OUT=XDATA_LAIGV, PZ0LITTER=XDATA_Z0LITTER )
+ CALL INI_DATA_PARAM(PH_TREE=XDATA_H_TREE,PLAI=XDATA_LAI, &
+ PALBNIR_VEG=XDATA_ALBNIR_VEG, PALBVIS_VEG=XDATA_ALBVIS_VEG, &
+ PALBUV_VEG=XDATA_ALBUV_VEG, PRSMIN=XDATA_RSMIN, &
+ PRGL=XDATA_RGL, PCV=XDATA_CV, PGAMMA=XDATA_GAMMA, &
+ PGMES=XDATA_GMES, PGC=XDATA_GC, PBSLAI=XDATA_BSLAI, &
+ PSEFOLD=XDATA_SEFOLD, PLAIMIN_OUT=XDATA_LAIMIN, PDMAX=XDATA_DMAX, &
+ PSTRESS=XDATA_STRESS, PF2I=XDATA_F2I, PVEG_OUT=XDATA_VEG, &
+ PGREEN=XDATA_GREEN, PZ0=XDATA_Z0, PZ0_O_Z0H=XDATA_Z0_O_Z0H, &
+ PEMIS_ECO=XDATA_EMIS_ECO, PWRMAX_CF=XDATA_WRMAX_CF, &
+ PROOT_LIN=XDATA_ROOT_LIN, PROOT_EXTINCTION=XDATA_ROOT_EXTINCTION, &
+ PSOILRC_SO2=XDATA_SOILRC_SO2, PSOILRC_O3=XDATA_SOILRC_O3, PRE25=XDATA_RE25, &
+ PCE_NITRO=XDATA_CE_NITRO,PCF_NITRO=XDATA_CF_NITRO,PCNA_NITRO=XDATA_CNA_NITRO, &
+ PGMES_ST=XDATA_GMES_ST, PGC_ST=XDATA_GC_ST, PBSLAI_ST=XDATA_BSLAI_ST, &
+ PSEFOLD_ST=XDATA_SEFOLD_ST, PDMAX_ST=XDATA_DMAX_ST, &
+ PGNDLITTER=XDATA_GNDLITTER, PH_VEG=XDATA_H_VEG, PZ0LITTER=XDATA_Z0LITTER )
!
IDC = 1
!
diff --git a/src/SURFEX/ini_data_param.F90 b/src/SURFEX/ini_data_param.F90
index 0f43bd0e5e6bfccc93b09d381e4ef8b03e8a6c4c..b74a9ea5845dcdeb5d11af5ecd92eee2e23f30ad 100644
--- a/src/SURFEX/ini_data_param.F90
+++ b/src/SURFEX/ini_data_param.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########################
- SUBROUTINE INI_DATA_PARAM(PTYPE,PSURF, PSURF2, PLAI, PH_TREE, &
+ SUBROUTINE INI_DATA_PARAM(PLAI, PH_TREE, &
PALBNIR_VEG, PALBVIS_VEG, PALBUV_VEG, PRSMIN, &
PRGL, PCV, PGAMMA, PGMES, PGC, PBSLAI, PSEFOLD, &
PLAIMIN_IN, PLAIMIN_OUT, PDMAX, PSTRESS, PF2I, &
@@ -12,10 +12,7 @@
PROOT_LIN, PROOT_EXTINCTION, PSOILRC_SO2, &
PSOILRC_O3, PRE25, PCE_NITRO, PCF_NITRO, PCNA_NITRO,&
PGMES_ST, PGC_ST, PBSLAI_ST, PSEFOLD_ST, PDMAX_ST ,&
- PGNDLITTER,PZF_TALLVEG, PRGLGV,PGAMMAGV, &
- PRSMINGV, PROOT_EXTINCTIONGV, PWRMAX_CFGV, &
- PH_VEG, PLAIGV_IN, PLAIGV_OUT, PZ0LITTER, &
- OAGRI_TO_GRASS )
+ PGNDLITTER, PH_VEG, PZ0LITTER, OAGRI_TO_GRASS )
! #########################
!
!!**** *INI_DATA_PARAM* initializes secondary cover-field correspondance arrays
@@ -67,12 +64,13 @@
! -----------
!
USE MODD_CSTS, ONLY : XDAY
-USE MODD_DATA_COVER_PAR, ONLY : NVT_NO, NVT_ROCK, NVT_SNOW, NVT_TEBD, &
- NVT_BONE, NVT_TRBE, NVT_C3, NVT_C4, &
- NVT_IRR, NVT_GRAS, NVT_TROG,NVT_PARK, &
- NVT_TRBD, NVT_TEBE, NVT_TENE, NVT_BOBD, &
- NVT_BOND, NVT_BOGR, NVT_SHRB, &
- NVEGTYPE, JPCOVER
+USE MODD_DATA_COVER_PAR, ONLY : NVT_NO, NVT_ROCK, NVT_SNOW, NVT_TEBD, &
+ NVT_BONE, NVT_TRBE, NVT_C3, NVT_C4, &
+ NVT_IRR, NVT_GRAS, NVT_TROG,NVT_PARK, &
+ NVT_TRBD, NVT_TEBE, NVT_TENE, NVT_BOBD, &
+ NVT_BOND, NVT_BOGR, NVT_SHRB, NVT_C3W, &
+ NVT_C3S, NVT_FLTR, NVT_FLGR, &
+ NVEGTYPE, JPCOVER
!
USE MODD_REPROD_OPER, ONLY : XEVERG_RSMIN
!
@@ -92,9 +90,6 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PTYPE
-REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PSURF
-REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PSURF2
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PLAI
REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PH_TREE
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PALBNIR_VEG
@@ -138,27 +133,18 @@ LOGICAL, OPTIONAL, INTENT(IN) :: OAGRI_TO_GRASS
!
! MEB parameters
! --------------
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PZF_TALLVEG
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PRGLGV
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PGAMMAGV
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PRSMINGV
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PROOT_EXTINCTIONGV
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PWRMAX_CFGV
REAL, DIMENSION(:,:,:), INTENT(OUT), OPTIONAL :: PH_VEG
-REAL, DIMENSION(:,:,:), INTENT(OUT), OPTIONAL :: PLAIGV_OUT
-REAL, DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PLAIGV_IN
REAL, DIMENSION(:,:,:), INTENT(OUT), OPTIONAL :: PZ0LITTER
REAL, DIMENSION(:,:,:), INTENT(OUT), OPTIONAL :: PGNDLITTER
!
!* 0.2 Declaration of local variables
! ------------------------------
!
-REAL, DIMENSION(SIZE(PTYPE,1)) :: ZGARDEN
-LOGICAL :: GSURF, GAGRI_TO_GRASS
-REAL, DIMENSION(SIZE(PTYPE,1),NVEGTYPE) :: ZLAIFRGV
-INTEGER :: JLOOP ! class loop counter
+LOGICAL :: GAGRI_TO_GRASS
+INTEGER :: IVT_C3, IVT_C3W, IVT_C3S, IVT_PARK, IVT_FLTR, IVT_FLGR
+INTEGER :: JC ! class loop counter
!
-INTEGER :: JMONTH ! month loop counter
+INTEGER :: JM ! month loop counter
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
@@ -169,165 +155,205 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('INI_DATA_PARAM',0,ZHOOK_HANDLE)
!
-GSURF = .TRUE.
GAGRI_TO_GRASS = .FALSE.
!
!When set, C3 and C4 crop values are replaced by value for C3 grass
IF(PRESENT(OAGRI_TO_GRASS))GAGRI_TO_GRASS=OAGRI_TO_GRASS
!
-DO JLOOP=1,SIZE(PTYPE,1)
-!
- IF (PRESENT(PSURF2) .AND. PRESENT(PSURF)) THEN
- GSURF=(PSURF(JLOOP)>0. .OR. PSURF2(JLOOP)>0.)
- ELSEIF (PRESENT(PSURF)) THEN
- GSURF=(PSURF(JLOOP)>0.)
- ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* nature exists for this cover type
-!
- IF (GSURF) THEN
-!
!-------------------------------------------------------------------------------
!* 7.5 albnir (veg only)
! ------
- IF (PRESENT(PALBNIR_VEG)) THEN
- PALBNIR_VEG(JLOOP,:)= 0.30
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PALBNIR_VEG(JLOOP,NVT_TEBD)= 0.25
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PALBNIR_VEG(JLOOP,NVT_TRBD)= 0.25
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PALBNIR_VEG(JLOOP,NVT_TEBE)= 0.25
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PALBNIR_VEG(JLOOP,NVT_BOBD)= 0.25
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PALBNIR_VEG(JLOOP,NVT_SHRB)= 0.25
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PALBNIR_VEG(JLOOP,NVT_BONE)= 0.15
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PALBNIR_VEG(JLOOP,NVT_TENE)= 0.15
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PALBNIR_VEG(JLOOP,NVT_BOND)= 0.15
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PALBNIR_VEG(JLOOP,NVT_TRBE)= 0.21
- ENDIF
+IF (PRESENT(PALBNIR_VEG)) THEN
+ PALBNIR_VEG(:,:)= 0.30
+ PALBNIR_VEG(:,NVT_TEBD)= 0.25
+ PALBNIR_VEG(:,NVT_TRBD)= 0.25
+ PALBNIR_VEG(:,NVT_TEBE)= 0.25
+ PALBNIR_VEG(:,NVT_BOBD)= 0.25
+ PALBNIR_VEG(:,NVT_SHRB)= 0.25
+ PALBNIR_VEG(:,NVT_BONE)= 0.15
+ PALBNIR_VEG(:,NVT_TENE)= 0.15
+ PALBNIR_VEG(:,NVT_BOND)= 0.15
+ PALBNIR_VEG(:,NVT_TRBE)= 0.21
+ IF (NVT_FLTR>0) THEN
+ PALBNIR_VEG(:,NVT_FLTR) = 0.25
+ ENDIF
+ENDIF
!-------------------------------------------------------------------------------
!* 7.6 albvis (veg only)
! ------
- IF (PRESENT(PALBVIS_VEG)) THEN
- PALBVIS_VEG(JLOOP,:)= 0.10
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PALBVIS_VEG(JLOOP,NVT_TEBD)= 0.05
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PALBVIS_VEG(JLOOP,NVT_TRBD)= 0.05
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PALBVIS_VEG(JLOOP,NVT_TEBE)= 0.05
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PALBVIS_VEG(JLOOP,NVT_BOBD)= 0.05
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PALBVIS_VEG(JLOOP,NVT_SHRB)= 0.05
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PALBVIS_VEG(JLOOP,NVT_BONE)= 0.05
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PALBVIS_VEG(JLOOP,NVT_TENE)= 0.05
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PALBVIS_VEG(JLOOP,NVT_BOND)= 0.05
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PALBVIS_VEG(JLOOP,NVT_TRBE)= 0.05
- ENDIF
+IF (PRESENT(PALBVIS_VEG)) THEN
+ PALBVIS_VEG(:,:)= 0.10
+ PALBVIS_VEG(:,NVT_TEBD)= 0.05
+ PALBVIS_VEG(:,NVT_TRBD)= 0.05
+ PALBVIS_VEG(:,NVT_TEBE)= 0.05
+ PALBVIS_VEG(:,NVT_BOBD)= 0.05
+ PALBVIS_VEG(:,NVT_SHRB)= 0.05
+ PALBVIS_VEG(:,NVT_BONE)= 0.05
+ PALBVIS_VEG(:,NVT_TENE)= 0.05
+ PALBVIS_VEG(:,NVT_BOND)= 0.05
+ PALBVIS_VEG(:,NVT_TRBE)= 0.05
+ IF (NVT_FLTR>0) THEN
+ PALBVIS_VEG(:,NVT_FLTR) = 0.05
+ ENDIF
+ENDIF
!-------------------------------------------------------------------------------
!* 7.6 albUV (veg only)
! -----
- IF (PRESENT(PALBUV_VEG)) THEN
- PALBUV_VEG(JLOOP,:)= 0.06
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PALBUV_VEG(JLOOP,NVT_TEBD)= 0.0525
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PALBUV_VEG(JLOOP,NVT_TRBD)= 0.0525
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PALBUV_VEG(JLOOP,NVT_TEBE)= 0.0525
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PALBUV_VEG(JLOOP,NVT_BOBD)= 0.0525
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PALBUV_VEG(JLOOP,NVT_SHRB)= 0.0525
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PALBUV_VEG(JLOOP,NVT_BONE)= 0.0425
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PALBUV_VEG(JLOOP,NVT_TENE)= 0.0425
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PALBUV_VEG(JLOOP,NVT_BOND)= 0.0425
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PALBUV_VEG(JLOOP,NVT_TRBE)= 0.038
- IF(PTYPE(JLOOP,NVT_GRAS)>0. ) PALBUV_VEG(JLOOP,NVT_GRAS)= 0.08
- IF(PTYPE(JLOOP,NVT_BOGR)>0. ) PALBUV_VEG(JLOOP,NVT_BOGR)= 0.08
- IF(PTYPE(JLOOP,NVT_TROG)>0. ) PALBUV_VEG(JLOOP,NVT_TROG)= 0.125
- IF(GAGRI_TO_GRASS)THEN
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PALBUV_VEG(JLOOP,NVT_C3 )= 0.08
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PALBUV_VEG(JLOOP,NVT_C4 )= 0.08
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PALBUV_VEG(JLOOP,NVT_IRR )= 0.08
- ELSE
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PALBUV_VEG(JLOOP,NVT_IRR )= 0.045
- ENDIF
- IF(PTYPE(JLOOP,NVT_PARK)>0. ) PALBUV_VEG(JLOOP,NVT_PARK)= 0.08
- ENDIF
+IF (PRESENT(PALBUV_VEG)) THEN
+ !
+ PALBUV_VEG(:,:)= 0.06
+ PALBUV_VEG(:,NVT_TEBD)= 0.0525
+ PALBUV_VEG(:,NVT_TRBD)= 0.0525
+ PALBUV_VEG(:,NVT_TEBE)= 0.0525
+ PALBUV_VEG(:,NVT_BOBD)= 0.0525
+ PALBUV_VEG(:,NVT_SHRB)= 0.0525
+ PALBUV_VEG(:,NVT_BONE)= 0.0425
+ PALBUV_VEG(:,NVT_TENE)= 0.0425
+ PALBUV_VEG(:,NVT_BOND)= 0.0425
+ PALBUV_VEG(:,NVT_TRBE)= 0.038
+ IF (NVT_FLTR>0) THEN
+ PALBUV_VEG(:,NVT_FLTR) = 0.0525
+ ENDIF
+ !
+ PALBUV_VEG(:,NVT_GRAS)= 0.08
+ PALBUV_VEG(:,NVT_BOGR)= 0.08
+ PALBUV_VEG(:,NVT_TROG)= 0.125
+ !
+ IF(GAGRI_TO_GRASS)THEN
+ !
+ IF (NVT_C3/=0) THEN
+ PALBUV_VEG(:,NVT_C3 )= 0.08
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PALBUV_VEG(:,NVT_C3W )= 0.08
+ PALBUV_VEG(:,NVT_C3S )= 0.08
+ ENDIF
+ PALBUV_VEG(:,NVT_C4 )= 0.08
+ IF (NVT_IRR/=0) THEN
+ PALBUV_VEG(:,NVT_IRR )= 0.08
+ ENDIF
+ !
+ ELSE
+ !
+ IF (NVT_IRR/=0) THEN
+ PALBUV_VEG(:,NVT_IRR )= 0.045
+ ENDIF
+ !
+ ENDIF
+ !
+ IF (NVT_PARK/=0) THEN
+ PALBUV_VEG(:,NVT_PARK)= 0.08
+ ELSEIF (NVT_FLGR/=0) THEN
+ PALBUV_VEG(:,NVT_FLGR)= 0.08
+ ENDIF
+ !
+ENDIF
!------------------------------------------------------------------------------
!* 7.7 Rsmin
! -----
- IF (PRESENT(PRSMIN)) THEN
- PRSMIN(JLOOP,:)= 40.
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PRSMIN(JLOOP,NVT_TEBD)= 150.
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PRSMIN(JLOOP,NVT_TRBD)= 150.
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PRSMIN(JLOOP,NVT_TEBE)= 150.
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PRSMIN(JLOOP,NVT_BOBD)= 150.
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PRSMIN(JLOOP,NVT_SHRB)= 150.
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PRSMIN(JLOOP,NVT_BONE)= 150.
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PRSMIN(JLOOP,NVT_TENE)= 150.
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PRSMIN(JLOOP,NVT_BOND)= 150.
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PRSMIN(JLOOP,NVT_TRBE)= XEVERG_RSMIN
- IF(PTYPE(JLOOP,NVT_TROG)>0. ) PRSMIN(JLOOP,NVT_TROG)= 120.
- IF(GAGRI_TO_GRASS)THEN
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PRSMIN(JLOOP,NVT_C4 )= 40.
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PRSMIN(JLOOP,NVT_IRR )= 40.
- ELSE
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PRSMIN(JLOOP,NVT_C4 )= 120.
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PRSMIN(JLOOP,NVT_IRR )= 120.
- ENDIF
+IF (PRESENT(PRSMIN)) THEN
+ !
+ PRSMIN(:,:)= 40.
+ PRSMIN(:,NVT_TEBD)= 150.
+ PRSMIN(:,NVT_TRBD)= 150.
+ PRSMIN(:,NVT_TEBE)= 150.
+ PRSMIN(:,NVT_BOBD)= 150.
+ PRSMIN(:,NVT_SHRB)= 150.
+ PRSMIN(:,NVT_BONE)= 150.
+ PRSMIN(:,NVT_TENE)= 150.
+ PRSMIN(:,NVT_BOND)= 150.
+ !
+ IF (NVT_FLTR>0) THEN
+ PRSMIN(:,NVT_FLTR) = 150.
+ ENDIF
+ !
+ PRSMIN(:,NVT_TRBE)= XEVERG_RSMIN
+ PRSMIN(:,NVT_TROG)= 120.
+ !
+ IF(GAGRI_TO_GRASS)THEN
+ PRSMIN(:,NVT_C4 )= 40.
+ IF (NVT_IRR/=0) THEN
+ PRSMIN(:,NVT_IRR )= 40.
+ ENDIF
+ ELSE
+ PRSMIN(:,NVT_C4 )= 120.
+ IF (NVT_IRR/=0) THEN
+ PRSMIN(:,NVT_IRR )= 120.
ENDIF
+ ENDIF
+ !
+ENDIF
!-------------------------------------------------------------------------------
!* 7.8 Gamma
! -----
- IF (PRESENT(PGAMMA)) THEN
- PGAMMA(JLOOP,:)= 0.
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PGAMMA(JLOOP,NVT_TEBD)= 0.04
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PGAMMA(JLOOP,NVT_TRBD)= 0.04
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PGAMMA(JLOOP,NVT_TEBE)= 0.04
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PGAMMA(JLOOP,NVT_BOBD)= 0.04
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PGAMMA(JLOOP,NVT_SHRB)= 0.04
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PGAMMA(JLOOP,NVT_BONE)= 0.04
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PGAMMA(JLOOP,NVT_TENE)= 0.04
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PGAMMA(JLOOP,NVT_BOND)= 0.04
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PGAMMA(JLOOP,NVT_TRBE)= 0.04
- ENDIF
+IF (PRESENT(PGAMMA)) THEN
+ PGAMMA(:,:)= 0.
+ PGAMMA(:,NVT_TEBD)= 0.04
+ PGAMMA(:,NVT_TRBD)= 0.04
+ PGAMMA(:,NVT_TEBE)= 0.04
+ PGAMMA(:,NVT_BOBD)= 0.04
+ PGAMMA(:,NVT_SHRB)= 0.04
+ PGAMMA(:,NVT_BONE)= 0.04
+ PGAMMA(:,NVT_TENE)= 0.04
+ PGAMMA(:,NVT_BOND)= 0.04
+ PGAMMA(:,NVT_TRBE)= 0.04
+ IF (NVT_FLTR>0) THEN
+ PGAMMA(:,NVT_FLTR) = 0.04
+ ENDIF
+ENDIF
!-------------------------------------------------------------------------------
!* 7.8 Wrmax_cf
! --------
- IF (PRESENT(PWRMAX_CF)) THEN
- PWRMAX_CF(JLOOP,:)= 0.2
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PWRMAX_CF(JLOOP,NVT_TEBD)= 0.1
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PWRMAX_CF(JLOOP,NVT_TRBD)= 0.1
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PWRMAX_CF(JLOOP,NVT_TEBE)= 0.1
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PWRMAX_CF(JLOOP,NVT_BOBD)= 0.1
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PWRMAX_CF(JLOOP,NVT_SHRB)= 0.1
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PWRMAX_CF(JLOOP,NVT_BONE)= 0.1
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PWRMAX_CF(JLOOP,NVT_TENE)= 0.1
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PWRMAX_CF(JLOOP,NVT_BOND)= 0.1
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PWRMAX_CF(JLOOP,NVT_TRBE)= 0.1
- ENDIF
+IF (PRESENT(PWRMAX_CF)) THEN
+ PWRMAX_CF(:,:)= 0.2
+ PWRMAX_CF(:,NVT_TEBD)= 0.1
+ PWRMAX_CF(:,NVT_TRBD)= 0.1
+ PWRMAX_CF(:,NVT_TEBE)= 0.1
+ PWRMAX_CF(:,NVT_BOBD)= 0.1
+ PWRMAX_CF(:,NVT_SHRB)= 0.1
+ PWRMAX_CF(:,NVT_BONE)= 0.1
+ PWRMAX_CF(:,NVT_TENE)= 0.1
+ PWRMAX_CF(:,NVT_BOND)= 0.1
+ PWRMAX_CF(:,NVT_TRBE)= 0.1
+ IF (NVT_FLTR>0) THEN
+ PWRMAX_CF(:,NVT_FLTR) = 0.1
+ ENDIF
+ENDIF
!-------------------------------------------------------------------------------
!* 7.9 Rgl
! ---
- IF (PRESENT(PRGL)) THEN
- PRGL(JLOOP,:)= 100.
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PRGL(JLOOP,NVT_TEBD)= 30.
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PRGL(JLOOP,NVT_TRBD)= 30.
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PRGL(JLOOP,NVT_TEBE)= 30.
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PRGL(JLOOP,NVT_BOBD)= 30.
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PRGL(JLOOP,NVT_SHRB)= 30.
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PRGL(JLOOP,NVT_BONE)= 30.
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PRGL(JLOOP,NVT_TENE)= 30.
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PRGL(JLOOP,NVT_BOND)= 30.
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PRGL(JLOOP,NVT_TRBE)= 30.
- ENDIF
+IF (PRESENT(PRGL)) THEN
+ PRGL(:,:)= 100.
+ PRGL(:,NVT_TEBD)= 30.
+ PRGL(:,NVT_TRBD)= 30.
+ PRGL(:,NVT_TEBE)= 30.
+ PRGL(:,NVT_BOBD)= 30.
+ PRGL(:,NVT_SHRB)= 30.
+ PRGL(:,NVT_BONE)= 30.
+ PRGL(:,NVT_TENE)= 30.
+ PRGL(:,NVT_BOND)= 30.
+ PRGL(:,NVT_TRBE)= 30.
+ IF (NVT_FLTR>0) THEN
+ PRGL(:,NVT_FLTR) = 30.
+ ENDIF
+ENDIF
!-------------------------------------------------------------------------------
!* 7.10 Cv
! --
- IF (PRESENT(PCV)) THEN
- PCV(JLOOP,:)=2.E-5
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PCV(JLOOP,NVT_TEBD)= 1.E-5
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PCV(JLOOP,NVT_TRBD)= 1.E-5
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PCV(JLOOP,NVT_TEBE)= 1.E-5
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PCV(JLOOP,NVT_BOBD)= 1.E-5
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PCV(JLOOP,NVT_SHRB)= 1.E-5
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PCV(JLOOP,NVT_BONE)= 1.E-5
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PCV(JLOOP,NVT_TENE)= 1.E-5
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PCV(JLOOP,NVT_BOND)= 1.E-5
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PCV(JLOOP,NVT_TRBE)= 1.E-5
- ENDIF
+IF (PRESENT(PCV)) THEN
+ PCV(:,:)=2.E-5
+ PCV(:,NVT_TEBD)= 1.E-5
+ PCV(:,NVT_TRBD)= 1.E-5
+ PCV(:,NVT_TEBE)= 1.E-5
+ PCV(:,NVT_BOBD)= 1.E-5
+ PCV(:,NVT_SHRB)= 1.E-5
+ PCV(:,NVT_BONE)= 1.E-5
+ PCV(:,NVT_TENE)= 1.E-5
+ PCV(:,NVT_BOND)= 1.E-5
+ PCV(:,NVT_TRBE)= 1.E-5
+ IF (NVT_FLTR>0) THEN
+ PCV(:,NVT_FLTR) = 1.E-5
+ ENDIF
+ENDIF
!-------------------------------------------------------------------------------
!* 7.11 mesophyll conductance (m s-1)
! -----------------------------
@@ -337,346 +363,493 @@ DO JLOOP=1,SIZE(PTYPE,1)
! gmes = Vcmax / (gamma + Kc*(1 + O2/Ko))
! from Jacobs eq [A8.5] and Farquhar, 1980 eq 42 : gm = dA/dC estimated at Ci=Gamma
! For grasses (C3 and C4): used V7 value
-! crops : used N. Canal's PhD thesis
+! crops : used N. Canal's PhD thesis
! --------------------------------------------------------------------
- IF (PRESENT(PGMES)) THEN
- PGMES(JLOOP,:)=0.020
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PGMES(JLOOP,NVT_TEBD)= 0.001
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PGMES(JLOOP,NVT_TRBD)= 0.001
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PGMES(JLOOP,NVT_TEBE)= 0.001
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PGMES(JLOOP,NVT_BOBD)= 0.001
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PGMES(JLOOP,NVT_SHRB)= 0.001
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PGMES(JLOOP,NVT_BONE)= 0.001
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PGMES(JLOOP,NVT_TENE)= 0.001
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PGMES(JLOOP,NVT_BOND)= 0.001
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PGMES(JLOOP,NVT_TRBE)= 0.001
- IF(GAGRI_TO_GRASS)THEN
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PGMES(JLOOP,NVT_C3 )= 0.020
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PGMES(JLOOP,NVT_C4 )= 0.020
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PGMES(JLOOP,NVT_IRR )= 0.020
- ELSE
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PGMES(JLOOP,NVT_C3 )= 0.003
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PGMES(JLOOP,NVT_C4 )= 0.003
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PGMES(JLOOP,NVT_IRR )= 0.003
- ENDIF
- ENDIF
-!
- IF (PRESENT(PGMES_ST)) THEN
- PGMES_ST(JLOOP,:)=0.003
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PGMES_ST(JLOOP,NVT_TEBD)= 0.0018
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PGMES_ST(JLOOP,NVT_TRBD)= 0.0012
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PGMES_ST(JLOOP,NVT_TEBE)= 0.0019
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PGMES_ST(JLOOP,NVT_BOBD)= 0.0018
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PGMES_ST(JLOOP,NVT_SHRB)= 0.0016
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PGMES_ST(JLOOP,NVT_BONE)= 0.0019
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PGMES_ST(JLOOP,NVT_TENE)= 0.0019
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PGMES_ST(JLOOP,NVT_BOND)= 0.0012
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PGMES_ST(JLOOP,NVT_TRBE)= 0.0012
- IF(GAGRI_TO_GRASS)THEN
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PGMES_ST(JLOOP,NVT_C3 )= 0.001
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PGMES_ST(JLOOP,NVT_C4 )= 0.006
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PGMES_ST(JLOOP,NVT_IRR )= 0.006
- ELSE
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PGMES_ST(JLOOP,NVT_C3 )= 0.00175
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PGMES_ST(JLOOP,NVT_C4 )= 0.0098
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PGMES_ST(JLOOP,NVT_IRR )= 0.0098
- ENDIF
- IF(PTYPE(JLOOP,NVT_GRAS)>0. ) PGMES_ST(JLOOP,NVT_GRAS )= 0.001
- IF(PTYPE(JLOOP,NVT_BOGR)>0. ) PGMES_ST(JLOOP,NVT_BOGR )= 0.001
- IF(PTYPE(JLOOP,NVT_TROG)>0. ) PGMES_ST(JLOOP,NVT_TROG )= 0.006
- IF(PTYPE(JLOOP,NVT_PARK)>0. ) PGMES_ST(JLOOP,NVT_PARK )= 0.001
- ENDIF
+IF (PRESENT(PGMES)) THEN
+ PGMES(:,:)=0.020
+ PGMES(:,NVT_TEBD)= 0.001
+ PGMES(:,NVT_TRBD)= 0.001
+ PGMES(:,NVT_TEBE)= 0.001
+ PGMES(:,NVT_BOBD)= 0.001
+ PGMES(:,NVT_SHRB)= 0.001
+ PGMES(:,NVT_BONE)= 0.001
+ PGMES(:,NVT_TENE)= 0.001
+ PGMES(:,NVT_BOND)= 0.001
+ PGMES(:,NVT_TRBE)= 0.001
+ IF (NVT_FLTR>0) THEN
+ PGMES(:,NVT_FLTR) = 0.001
+ ENDIF
+ !
+ IF(GAGRI_TO_GRASS)THEN
+ !
+ IF (NVT_C3/=0) THEN
+ PGMES(:,NVT_C3 )= 0.020
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PGMES(:,NVT_C3W )= 0.020
+ PGMES(:,NVT_C3S )= 0.020
+ ENDIF
+ PGMES(:,NVT_C4 )= 0.020
+ IF (NVT_IRR/=0) THEN
+ PGMES(:,NVT_IRR )= 0.020
+ ENDIF
+ !
+ ELSE
+ !
+ IF (NVT_C3/=0) THEN
+ PGMES(:,NVT_C3 )= 0.003
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PGMES(:,NVT_C3W )= 0.003
+ PGMES(:,NVT_C3S )= 0.003
+ ENDIF
+ PGMES(:,NVT_C4 )= 0.003
+ IF (NVT_IRR/=0) THEN
+ PGMES(:,NVT_IRR )= 0.003
+ ENDIF
+ !
+ ENDIF
+ENDIF
+!
+IF (PRESENT(PGMES_ST)) THEN
+ !
+ PGMES_ST(:,:)=0.003
+ PGMES_ST(:,NVT_TEBD)= 0.0018
+ PGMES_ST(:,NVT_TRBD)= 0.0012
+ PGMES_ST(:,NVT_TEBE)= 0.0019
+ PGMES_ST(:,NVT_BOBD)= 0.0018
+ PGMES_ST(:,NVT_SHRB)= 0.0016
+ PGMES_ST(:,NVT_BONE)= 0.0019
+ PGMES_ST(:,NVT_TENE)= 0.0019
+ PGMES_ST(:,NVT_BOND)= 0.0012
+ PGMES_ST(:,NVT_TRBE)= 0.0012
+ IF (NVT_FLTR>0) THEN
+ PGMES_ST(:,NVT_FLTR) = 0.0018
+ ENDIF
+ !
+ IF(GAGRI_TO_GRASS)THEN
+ !
+ IF (NVT_C3/=0) THEN
+ PGMES_ST(:,NVT_C3 )= 0.001
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PGMES_ST(:,NVT_C3W )= 0.001
+ PGMES_ST(:,NVT_C3S )= 0.001
+ ENDIF
+ PGMES_ST(:,NVT_C4 )= 0.006
+ IF (NVT_IRR/=0) THEN
+ PGMES_ST(:,NVT_IRR )= 0.006
+ ENDIF
+ !
+ ELSE
+ !
+ IF (NVT_C3/=0) THEN
+ PGMES_ST(:,NVT_C3 )= 0.00175
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PGMES_ST(:,NVT_C3W )= 0.00175
+ PGMES_ST(:,NVT_C3S )= 0.00175
+ ENDIF
+ PGMES_ST(:,NVT_C4 )= 0.0098
+ IF (NVT_IRR/=0) THEN
+ PGMES_ST(:,NVT_IRR )= 0.0098
+ ENDIF
+ !
+ ENDIF
+ !
+ PGMES_ST(:,NVT_GRAS )= 0.001
+ PGMES_ST(:,NVT_BOGR )= 0.001
+ PGMES_ST(:,NVT_TROG )= 0.006
+ !
+ IF (NVT_PARK/=0) THEN
+ PGMES_ST(:,NVT_PARK)= 0.001
+ ELSEIF (NVT_FLGR/=0) THEN
+ PGMES_ST(:,NVT_FLGR)= 0.001
+ ENDIF
+ !
+ENDIF
!-------------------------------------------------------------------------------
!* 7.11 Ecosystem Respiration (kg m-2 s-1)
! -----------------------------------
- IF (PRESENT(PRE25)) THEN
- PRE25(JLOOP,:)= 3.6E-7
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PRE25(JLOOP,NVT_BONE)= 1.8E-7
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PRE25(JLOOP,NVT_TENE)= 1.8E-7
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PRE25(JLOOP,NVT_BOND)= 1.8E-7
- IF(GAGRI_TO_GRASS)THEN
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PRE25(JLOOP,NVT_C3 )= 3.6E-7
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PRE25(JLOOP,NVT_C4 )= 3.6E-7
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PRE25(JLOOP,NVT_IRR )= 3.6E-7
- ELSE
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PRE25(JLOOP,NVT_C3 )= 3.6E-7
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PRE25(JLOOP,NVT_C4 )= 3.0E-7
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PRE25(JLOOP,NVT_IRR )= 3.0E-7
- ENDIF
- !ecosystem respiration only if vegetetation is present
- IF(PTYPE(JLOOP,NVT_NO )>0. ) PRE25(JLOOP,NVT_NO )= 0.
- IF(PTYPE(JLOOP,NVT_ROCK)>0. ) PRE25(JLOOP,NVT_ROCK)= 0.
- IF(PTYPE(JLOOP,NVT_SNOW)>0. ) PRE25(JLOOP,NVT_SNOW)= 0.
+IF (PRESENT(PRE25)) THEN
+ !
+ PRE25(:,:)= 3.6E-7
+ PRE25(:,NVT_BONE)= 1.8E-7
+ PRE25(:,NVT_TENE)= 1.8E-7
+ PRE25(:,NVT_BOND)= 1.8E-7
+ !
+ IF(GAGRI_TO_GRASS)THEN
+ !
+ IF (NVT_C3/=0) THEN
+ PRE25(:,NVT_C3 )= 3.6E-7
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PRE25(:,NVT_C3W )= 3.6E-7
+ PRE25(:,NVT_C3S )= 3.6E-7
ENDIF
+ PRE25(:,NVT_C4 )= 3.6E-7
+ IF (NVT_IRR/=0) THEN
+ PRE25(:,NVT_IRR )= 3.6E-7
+ ENDIF
+ !
+ ELSE
+ !
+ IF (NVT_C3/=0) THEN
+ PRE25(:,NVT_C3 )= 3.6E-7
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PRE25(:,NVT_C3W )= 3.6E-7
+ PRE25(:,NVT_C3S )= 3.6E-7
+ ENDIF
+ PRE25(:,NVT_C4 )= 3.0E-7
+ IF (NVT_IRR/=0) THEN
+ PRE25(:,NVT_IRR )= 3.0E-7
+ ENDIF
+ !
+ ENDIF
+ !
+ !ecosystem respiration only if vegetetation is present
+ PRE25(:,NVT_NO )= 0.
+ PRE25(:,NVT_ROCK)= 0.
+ PRE25(:,NVT_SNOW)= 0.
+ !
+ENDIF
!-------------------------------------------------------------------------------
!* 7.11 cuticular conductance (m s-1)
! -----------------------------
- IF (PRESENT(PGC)) THEN
- PGC(JLOOP,:)=0.00025
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PGC(JLOOP,NVT_TEBD)= 0.00015
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PGC(JLOOP,NVT_TRBD)= 0.00015
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PGC(JLOOP,NVT_TEBE)= 0.00015
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PGC(JLOOP,NVT_BOBD)= 0.00015
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PGC(JLOOP,NVT_SHRB)= 0.00015
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PGC(JLOOP,NVT_BONE)= 0.
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PGC(JLOOP,NVT_TENE)= 0.
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PGC(JLOOP,NVT_BOND)= 0.
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PGC(JLOOP,NVT_TRBE)= 0.00015
- ENDIF
-!
- IF (PRESENT(PGC_ST)) THEN
- PGC_ST(JLOOP,:)=0.00015
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PGC_ST(JLOOP,NVT_BONE)= 0.
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PGC_ST(JLOOP,NVT_TENE)= 0.
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PGC_ST(JLOOP,NVT_BOND)= 0.
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PGC_ST(JLOOP,NVT_C3 )= 0.00025
- IF(PTYPE(JLOOP,NVT_GRAS)>0. ) PGC_ST(JLOOP,NVT_GRAS)= 0.00025
- IF(PTYPE(JLOOP,NVT_BOGR)>0. ) PGC_ST(JLOOP,NVT_BOGR)= 0.00025
- IF(PTYPE(JLOOP,NVT_PARK)>0. ) PGC_ST(JLOOP,NVT_PARK)= 0.001
- IF(GAGRI_TO_GRASS)THEN
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PGC_ST(JLOOP,NVT_C4 )= 0.00025
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PGC_ST(JLOOP,NVT_IRR )= 0.00025
- ENDIF
- ENDIF
+IF (PRESENT(PGC)) THEN
+ PGC(:,:)=0.00025
+ PGC(:,NVT_TEBD)= 0.00015
+ PGC(:,NVT_TRBD)= 0.00015
+ PGC(:,NVT_TEBE)= 0.00015
+ PGC(:,NVT_BOBD)= 0.00015
+ PGC(:,NVT_SHRB)= 0.00015
+ PGC(:,NVT_BONE)= 0.
+ PGC(:,NVT_TENE)= 0.
+ PGC(:,NVT_BOND)= 0.
+ PGC(:,NVT_TRBE)= 0.00015
+ IF (NVT_FLTR>0) THEN
+ PGC(:,NVT_FLTR) = 0.00015
+ ENDIF
+ENDIF
+!
+IF (PRESENT(PGC_ST)) THEN
+ PGC_ST(:,:)=0.00015
+ PGC_ST(:,NVT_BONE)= 0.
+ PGC_ST(:,NVT_TENE)= 0.
+ PGC_ST(:,NVT_BOND)= 0.
+ !
+ IF (NVT_C3/=0) THEN
+ PGC_ST(:,NVT_C3 )= 0.00025
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PGC_ST(:,NVT_C3W )= 0.00025
+ PGC_ST(:,NVT_C3S )= 0.00025
+ ENDIF
+ !
+ IF(GAGRI_TO_GRASS)THEN
+ PGC_ST(:,NVT_C4 )= 0.00025
+ IF (NVT_IRR/=0) THEN
+ PGC_ST(:,NVT_IRR )= 0.00025
+ ENDIF
+ ENDIF
+ !
+ PGC_ST(:,NVT_GRAS)= 0.00025
+ PGC_ST(:,NVT_BOGR)= 0.00025
+ !
+ IF (NVT_PARK/=0) THEN
+ PGC_ST(:,NVT_PARK)= 0.001
+ ELSEIF (NVT_FLGR/=0) THEN
+ PGC_ST(:,NVT_FLGR)= 0.001
+ ENDIF
+ !
+ENDIF
!-------------------------------------------------------------------------------
!* 7.11 critical normilized soil water content for stress parameterisation
! ------------------------------------------------------------------
- IF (PRESENT(PF2I)) PF2I(JLOOP,:)=0.3
+IF (PRESENT(PF2I)) PF2I(:,:)=0.3
!-------------------------------------------------------------------------------
!* 7.12 ratio d(biomass)/d(lai) (kg/m2)
! -----------------------
- IF (PRESENT(PBSLAI)) THEN
- PBSLAI(JLOOP,:)=0.36
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PBSLAI(JLOOP,NVT_TEBD)= 0.25
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PBSLAI(JLOOP,NVT_TRBD)= 0.25
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PBSLAI(JLOOP,NVT_TEBE)= 0.25
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PBSLAI(JLOOP,NVT_BOBD)= 0.25
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PBSLAI(JLOOP,NVT_SHRB)= 0.25
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PBSLAI(JLOOP,NVT_BONE)= 0.25
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PBSLAI(JLOOP,NVT_TENE)= 0.25
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PBSLAI(JLOOP,NVT_BOND)= 0.25
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PBSLAI(JLOOP,NVT_TRBE)= 0.25
- IF(GAGRI_TO_GRASS)THEN
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PBSLAI(JLOOP,NVT_C3 )= 0.36
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PBSLAI(JLOOP,NVT_C4 )= 0.36
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PBSLAI(JLOOP,NVT_IRR )= 0.36
- ELSE
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PBSLAI(JLOOP,NVT_C3 )= 0.06
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PBSLAI(JLOOP,NVT_C4 )= 0.06
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PBSLAI(JLOOP,NVT_IRR )= 0.06
- ENDIF
+IF (PRESENT(PBSLAI)) THEN
+ PBSLAI(:,:)=0.36
+ PBSLAI(:,NVT_TEBD)= 0.25
+ PBSLAI(:,NVT_TRBD)= 0.25
+ PBSLAI(:,NVT_TEBE)= 0.25
+ PBSLAI(:,NVT_BOBD)= 0.25
+ PBSLAI(:,NVT_SHRB)= 0.25
+ PBSLAI(:,NVT_BONE)= 0.25
+ PBSLAI(:,NVT_TENE)= 0.25
+ PBSLAI(:,NVT_BOND)= 0.25
+ PBSLAI(:,NVT_TRBE)= 0.25
+ IF (NVT_FLTR>0) THEN
+ PBSLAI(:,NVT_FLTR) = 0.25
+ ENDIF
+ !
+ IF(GAGRI_TO_GRASS)THEN
+ !
+ IF (NVT_C3/=0) THEN
+ PBSLAI(:,NVT_C3 )= 0.36
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PBSLAI(:,NVT_C3W )= 0.36
+ PBSLAI(:,NVT_C3S )= 0.36
ENDIF
+ PBSLAI(:,NVT_C4 )= 0.36
+ IF (NVT_IRR/=0) THEN
+ PBSLAI(:,NVT_IRR )= 0.36
+ ENDIF
+ !
+ ELSE
+ !
+ IF (NVT_C3/=0) THEN
+ PBSLAI(:,NVT_C3 )= 0.06
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PBSLAI(:,NVT_C3W )= 0.06
+ PBSLAI(:,NVT_C3S )= 0.06
+ ENDIF
+ PBSLAI(:,NVT_C4 )= 0.06
+ IF (NVT_IRR/=0) THEN
+ PBSLAI(:,NVT_IRR )= 0.06
+ ENDIF
+ !
+ ENDIF
+ !
+ENDIF
!
- IF (PRESENT(PBSLAI_ST)) THEN
- PBSLAI_ST(JLOOP,:)=0.08
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PBSLAI_ST(JLOOP,NVT_TEBD)= 0.125
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PBSLAI_ST(JLOOP,NVT_TRBD)= 0.125
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PBSLAI_ST(JLOOP,NVT_TEBE)= 0.125
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PBSLAI_ST(JLOOP,NVT_BOBD)= 0.125
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PBSLAI_ST(JLOOP,NVT_SHRB)= 0.125
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PBSLAI_ST(JLOOP,NVT_BONE)= 0.50
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PBSLAI_ST(JLOOP,NVT_TENE)= 0.50
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PBSLAI_ST(JLOOP,NVT_BOND)= 0.50
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PBSLAI_ST(JLOOP,NVT_TRBE)= 0.25
- IF(GAGRI_TO_GRASS)THEN
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PBSLAI_ST(JLOOP,NVT_C3 )= 0.08
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PBSLAI_ST(JLOOP,NVT_C4 )= 0.08
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PBSLAI_ST(JLOOP,NVT_IRR )= 0.08
- ELSE
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PBSLAI_ST(JLOOP,NVT_C3 )= 0.06
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PBSLAI_ST(JLOOP,NVT_C4 )= 0.06
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PBSLAI_ST(JLOOP,NVT_IRR )= 0.06
- ENDIF
+IF (PRESENT(PBSLAI_ST)) THEN
+ !
+ PBSLAI_ST(:,:)=0.08
+ PBSLAI_ST(:,NVT_TEBD)= 0.125
+ PBSLAI_ST(:,NVT_TRBD)= 0.125
+ PBSLAI_ST(:,NVT_TEBE)= 0.125
+ PBSLAI_ST(:,NVT_BOBD)= 0.125
+ PBSLAI_ST(:,NVT_SHRB)= 0.125
+ PBSLAI_ST(:,NVT_BONE)= 0.50
+ PBSLAI_ST(:,NVT_TENE)= 0.50
+ PBSLAI_ST(:,NVT_BOND)= 0.50
+ PBSLAI_ST(:,NVT_TRBE)= 0.25
+ IF (NVT_FLTR>0) THEN
+ PBSLAI_ST(:,NVT_FLTR) = 0.125
+ ENDIF
+ !
+ IF(GAGRI_TO_GRASS)THEN
+ !
+ IF (NVT_C3/=0) THEN
+ PBSLAI_ST(:,NVT_C3 )= 0.08
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PBSLAI_ST(:,NVT_C3W )= 0.08
+ PBSLAI_ST(:,NVT_C3S )= 0.08
+ ENDIF
+ PBSLAI_ST(:,NVT_C4 )= 0.08
+ IF (NVT_IRR/=0) THEN
+ PBSLAI_ST(:,NVT_IRR )= 0.08
+ ENDIF
+ !
+ ELSE
+ !
+ IF (NVT_C3/=0) THEN
+ PBSLAI_ST(:,NVT_C3 )= 0.06
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PBSLAI_ST(:,NVT_C3W )= 0.06
+ PBSLAI_ST(:,NVT_C3S )= 0.06
+ ENDIF
+ PBSLAI_ST(:,NVT_C4 )= 0.06
+ IF (NVT_IRR/=0) THEN
+ PBSLAI_ST(:,NVT_IRR )= 0.06
ENDIF
+ !
+ ENDIF
+ !
+ENDIF
!
!-------------------------------------------------------------------------------
!* 7.12 maximum air saturation deficit tolerate by vegetation (kg/kg)
! -----------------------------------------------------
- IF (PRESENT(PDMAX)) THEN
- PDMAX(JLOOP,:) = 0.1
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PDMAX(JLOOP,NVT_TEBD)= 0.01
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PDMAX(JLOOP,NVT_TRBD)= 0.01
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PDMAX(JLOOP,NVT_TEBE)= 0.01
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PDMAX(JLOOP,NVT_BOBD)= 0.01
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PDMAX(JLOOP,NVT_SHRB)= 0.01
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PDMAX(JLOOP,NVT_BONE)= 0.01
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PDMAX(JLOOP,NVT_TENE)= 0.01
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PDMAX(JLOOP,NVT_BOND)= 0.01
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PDMAX(JLOOP,NVT_TRBE)= 0.01
- ENDIF
-!
- IF (PRESENT(PDMAX_ST)) THEN
- PDMAX_ST(JLOOP,:) = 0.05
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PDMAX_ST(JLOOP,NVT_TEBD)= 0.109
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PDMAX_ST(JLOOP,NVT_TRBD)= 0.109
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PDMAX_ST(JLOOP,NVT_TEBE)= 0.109
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PDMAX_ST(JLOOP,NVT_BOBD)= 0.109
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PDMAX_ST(JLOOP,NVT_SHRB)= 0.109
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PDMAX_ST(JLOOP,NVT_BONE)= 0.124
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PDMAX_ST(JLOOP,NVT_TENE)= 0.124
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PDMAX_ST(JLOOP,NVT_BOND)= 0.124
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PDMAX_ST(JLOOP,NVT_TRBE)= 0.124
- IF(GAGRI_TO_GRASS)THEN
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PDMAX_ST(JLOOP,NVT_C4 )= 0.05
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PDMAX_ST(JLOOP,NVT_IRR )= 0.05
- ELSE
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PDMAX_ST(JLOOP,NVT_C4 )= 0.033
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PDMAX_ST(JLOOP,NVT_IRR )= 0.033
- ENDIF
- IF(PTYPE(JLOOP,NVT_TROG)>0. ) PDMAX_ST(JLOOP,NVT_TROG)= 0.052
- ENDIF
+IF (PRESENT(PDMAX)) THEN
+ PDMAX(:,:) = 0.1
+ PDMAX(:,NVT_TEBD)= 0.01
+ PDMAX(:,NVT_TRBD)= 0.01
+ PDMAX(:,NVT_TEBE)= 0.01
+ PDMAX(:,NVT_BOBD)= 0.01
+ PDMAX(:,NVT_SHRB)= 0.01
+ PDMAX(:,NVT_BONE)= 0.01
+ PDMAX(:,NVT_TENE)= 0.01
+ PDMAX(:,NVT_BOND)= 0.01
+ PDMAX(:,NVT_TRBE)= 0.01
+ IF (NVT_FLTR>0) THEN
+ PDMAX(:,NVT_FLTR) = 0.01
+ ENDIF
+ENDIF
+!
+IF (PRESENT(PDMAX_ST)) THEN
+ !
+ PDMAX_ST(:,:) = 0.05
+ PDMAX_ST(:,NVT_TEBD)= 0.109
+ PDMAX_ST(:,NVT_TRBD)= 0.109
+ PDMAX_ST(:,NVT_TEBE)= 0.109
+ PDMAX_ST(:,NVT_BOBD)= 0.109
+ PDMAX_ST(:,NVT_SHRB)= 0.109
+ PDMAX_ST(:,NVT_BONE)= 0.124
+ PDMAX_ST(:,NVT_TENE)= 0.124
+ PDMAX_ST(:,NVT_BOND)= 0.124
+ PDMAX_ST(:,NVT_TRBE)= 0.124
+ IF (NVT_FLTR>0) THEN
+ PDMAX_ST(:,NVT_FLTR) = 0.109
+ ENDIF
+ !
+ IF(GAGRI_TO_GRASS)THEN
+ !
+ PDMAX_ST(:,NVT_C4 )= 0.05
+ IF (NVT_IRR/=0) THEN
+ PDMAX_ST(:,NVT_IRR )= 0.05
+ ENDIF
+ !
+ ELSE
+ !
+ PDMAX_ST(:,NVT_C4 )= 0.033
+ IF (NVT_IRR/=0) THEN
+ PDMAX_ST(:,NVT_IRR )= 0.033
+ ENDIF
+ !
+ ENDIF
+ !
+ PDMAX_ST(:,NVT_TROG)= 0.052
+ !
+ENDIF
!-------------------------------------------------------------------------------
!* 7.12 Defensive/offensive strategy (1/0)
! ----------------------------
- IF (PRESENT(PSTRESS)) THEN
- PSTRESS(JLOOP,:) = 1.
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PSTRESS(JLOOP,NVT_TEBD)= 0.
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PSTRESS(JLOOP,NVT_TRBD)= 0.
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PSTRESS(JLOOP,NVT_TEBE)= 0.
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PSTRESS(JLOOP,NVT_BOBD)= 0.
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PSTRESS(JLOOP,NVT_SHRB)= 0.
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PSTRESS(JLOOP,NVT_TRBE)= 0.
- IF(GAGRI_TO_GRASS)THEN
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PSTRESS(JLOOP,NVT_C3 )= 0.
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PSTRESS(JLOOP,NVT_IRR )= 0.
- ENDIF
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PSTRESS(JLOOP,NVT_C4 )= 0.
- IF(PTYPE(JLOOP,NVT_GRAS)>0. ) PSTRESS(JLOOP,NVT_GRAS)= 0.
- IF(PTYPE(JLOOP,NVT_BOGR)>0. ) PSTRESS(JLOOP,NVT_BOGR)= 0.
- IF(PTYPE(JLOOP,NVT_TROG)>0. ) PSTRESS(JLOOP,NVT_TROG)= 0.
- IF(PTYPE(JLOOP,NVT_PARK)>0. ) PSTRESS(JLOOP,NVT_PARK)= 0.
- ENDIF
+IF (PRESENT(PSTRESS)) THEN
+ !
+ PSTRESS(:,:) = 1.
+ PSTRESS(:,NVT_TEBD)= 0.
+ PSTRESS(:,NVT_TRBD)= 0.
+ PSTRESS(:,NVT_TEBE)= 0.
+ PSTRESS(:,NVT_BOBD)= 0.
+ PSTRESS(:,NVT_SHRB)= 0.
+ PSTRESS(:,NVT_TRBE)= 0.
+ IF (NVT_FLTR>0) THEN
+ PSTRESS(:,NVT_FLTR) = 0.
+ ENDIF
+ !
+ IF(GAGRI_TO_GRASS)THEN
+ !
+ IF (NVT_C3/=0) THEN
+ PSTRESS(:,NVT_C3 )= 0.
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PSTRESS(:,NVT_C3W )= 0.
+ PSTRESS(:,NVT_C3S )= 0.
+ ENDIF
+ IF (NVT_IRR/=0) THEN
+ PSTRESS(:,NVT_IRR )= 0.
+ ENDIF
+ !
+ ENDIF
+ !
+ PSTRESS(:,NVT_C4 )= 0.
+ !
+ PSTRESS(:,NVT_GRAS)= 0.
+ PSTRESS(:,NVT_BOGR)= 0.
+ PSTRESS(:,NVT_TROG)= 0.
+ !
+ IF (NVT_PARK/=0) THEN
+ PSTRESS(:,NVT_PARK)= 0.
+ ELSEIF (NVT_FLGR/=0) THEN
+ PSTRESS(:,NVT_FLGR)= 0.
+ ENDIF
+ !
+ENDIF
!-------------------------------------------------------------------------------
!* 7.13 e-folding time for senescence (days)
! ------------------------------------
-! parameters use in case HPHOTO == 'NONE' 'AGS' 'LAI'
- IF (PRESENT(PSEFOLD)) THEN
- PSEFOLD(JLOOP,:)=90. * XDAY
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PSEFOLD(JLOOP,NVT_TEBD)= 365.* XDAY
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PSEFOLD(JLOOP,NVT_TRBD)= 365.* XDAY
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PSEFOLD(JLOOP,NVT_TEBE)= 365.* XDAY
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PSEFOLD(JLOOP,NVT_BOBD)= 365.* XDAY
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PSEFOLD(JLOOP,NVT_SHRB)= 365.* XDAY
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PSEFOLD(JLOOP,NVT_BONE)= 365.* XDAY
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PSEFOLD(JLOOP,NVT_TENE)= 365.* XDAY
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PSEFOLD(JLOOP,NVT_BOND)= 365.* XDAY
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PSEFOLD(JLOOP,NVT_TRBE)= 365.* XDAY
- IF(GAGRI_TO_GRASS)THEN
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PSEFOLD(JLOOP,NVT_C3 )= 90.* XDAY
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PSEFOLD(JLOOP,NVT_C4 )= 90.* XDAY
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PSEFOLD(JLOOP,NVT_IRR )= 90.* XDAY
- ELSE
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PSEFOLD(JLOOP,NVT_C3 )= 60.* XDAY
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PSEFOLD(JLOOP,NVT_C4 )= 60.* XDAY
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PSEFOLD(JLOOP,NVT_IRR )= 60.* XDAY
- ENDIF
- ENDIF
-!
-! parameters use in case HPHOTO == 'AST','LST' 'NIT', 'NCB'
+! parameters use in case HPHOTO == 'NONE'
+IF (PRESENT(PSEFOLD)) THEN
+ !
+ PSEFOLD(:,:)=90. * XDAY
+ PSEFOLD(:,NVT_TEBD)= 365.* XDAY
+ PSEFOLD(:,NVT_TRBD)= 365.* XDAY
+ PSEFOLD(:,NVT_TEBE)= 365.* XDAY
+ PSEFOLD(:,NVT_BOBD)= 365.* XDAY
+ PSEFOLD(:,NVT_SHRB)= 365.* XDAY
+ PSEFOLD(:,NVT_BONE)= 365.* XDAY
+ PSEFOLD(:,NVT_TENE)= 365.* XDAY
+ PSEFOLD(:,NVT_BOND)= 365.* XDAY
+ PSEFOLD(:,NVT_TRBE)= 365.* XDAY
+ IF (NVT_FLTR>0) THEN
+ PSEFOLD(:,NVT_FLTR) = 365.* XDAY
+ ENDIF
+ !
+ IF(GAGRI_TO_GRASS)THEN
+ !
+ IF (NVT_C3/=0) THEN
+ PSEFOLD(:,NVT_C3 )= 90.* XDAY
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PSEFOLD(:,NVT_C3W )= 90.* XDAY
+ PSEFOLD(:,NVT_C3S )= 90.* XDAY
+ ENDIF
+ !
+ PSEFOLD(:,NVT_C4 )= 90.* XDAY
+ IF (NVT_IRR/=0) THEN
+ PSEFOLD(:,NVT_IRR )= 90.* XDAY
+ ENDIF
+ !
+ ELSE
+ !
+ IF (NVT_C3/=0) THEN
+ PSEFOLD(:,NVT_C3 )= 60.* XDAY
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PSEFOLD(:,NVT_C3W )= 60.* XDAY
+ PSEFOLD(:,NVT_C3S )= 60.* XDAY
+ ENDIF
+ !
+ PSEFOLD(:,NVT_C4 )= 60.* XDAY
+ IF (NVT_IRR/=0) THEN
+ PSEFOLD(:,NVT_IRR )= 60.* XDAY
+ ENDIF
+ !
+ ENDIF
+ !
+ENDIF
+!
+! parameters use in case HPHOTO == 'AST', 'NIT', 'NCB'
- IF (PRESENT(PSEFOLD_ST)) THEN
- PSEFOLD_ST(JLOOP,:)=150. * XDAY
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PSEFOLD_ST(JLOOP,NVT_TEBD)= 230.* XDAY
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PSEFOLD_ST(JLOOP,NVT_TRBD)= 230.* XDAY
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PSEFOLD_ST(JLOOP,NVT_TEBE)= 230.* XDAY
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PSEFOLD_ST(JLOOP,NVT_BOBD)= 230.* XDAY
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PSEFOLD_ST(JLOOP,NVT_SHRB)= 230.* XDAY
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PSEFOLD_ST(JLOOP,NVT_BONE)= 365.* XDAY
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PSEFOLD_ST(JLOOP,NVT_TENE)= 365.* XDAY
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PSEFOLD_ST(JLOOP,NVT_BOND)= 365.* XDAY
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PSEFOLD_ST(JLOOP,NVT_TRBE)= 365.* XDAY
- ENDIF
+IF (PRESENT(PSEFOLD_ST)) THEN
+ PSEFOLD_ST(:,:)=150. * XDAY
+ PSEFOLD_ST(:,NVT_TEBD)= 230.* XDAY
+ PSEFOLD_ST(:,NVT_TRBD)= 230.* XDAY
+ PSEFOLD_ST(:,NVT_TEBE)= 230.* XDAY
+ PSEFOLD_ST(:,NVT_BOBD)= 230.* XDAY
+ PSEFOLD_ST(:,NVT_SHRB)= 230.* XDAY
+ PSEFOLD_ST(:,NVT_BONE)= 365.* XDAY
+ PSEFOLD_ST(:,NVT_TENE)= 365.* XDAY
+ PSEFOLD_ST(:,NVT_BOND)= 365.* XDAY
+ PSEFOLD_ST(:,NVT_TRBE)= 365.* XDAY
+ IF (NVT_FLTR>0) THEN
+ PSEFOLD_ST(:,NVT_FLTR) = 365.* XDAY
+ ENDIF
+ENDIF
!-------------------------------------------------------------------------------
!* 7.14 Minimum LAI (m2/m2)
! -------------------
! Modi lai/patch defined
- IF (PRESENT(PLAIMIN_OUT)) THEN
- PLAIMIN_OUT (JLOOP,:) = 0.3
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PLAIMIN_OUT(JLOOP,NVT_BONE)= 1.0
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PLAIMIN_OUT(JLOOP,NVT_TENE)= 1.0
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PLAIMIN_OUT(JLOOP,NVT_BOND)= 1.0
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PLAIMIN_OUT(JLOOP,NVT_TRBE)= 1.0
- ENDIF
+IF (PRESENT(PLAIMIN_OUT)) THEN
+ PLAIMIN_OUT (:,:) = 0.3
+ PLAIMIN_OUT(:,NVT_BONE)= 1.0
+ PLAIMIN_OUT(:,NVT_TENE)= 1.0
+ PLAIMIN_OUT(:,NVT_BOND)= 1.0
+ PLAIMIN_OUT(:,NVT_TRBE)= 1.0
+ENDIF
!--------------------------------------------------------------------
!
-!* 7.16 Thickness of ground litter
-! --------------------------
+!* 7.16 Fraction of ground litter
+! -------------------------
!
- IF (PRESENT(PGNDLITTER)) THEN
- PGNDLITTER (JLOOP,:,:) = 0.
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PGNDLITTER (JLOOP,:,NVT_TEBD) = 0.03
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PGNDLITTER (JLOOP,:,NVT_BONE) = 0.03
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PGNDLITTER (JLOOP,:,NVT_TRBE) = 0.03
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PGNDLITTER (JLOOP,:,NVT_TRBD) = 0.03
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PGNDLITTER (JLOOP,:,NVT_TEBE) = 0.03
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PGNDLITTER (JLOOP,:,NVT_TENE) = 0.03
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PGNDLITTER (JLOOP,:,NVT_BOBD) = 0.03
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PGNDLITTER (JLOOP,:,NVT_BOND) = 0.03
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PGNDLITTER (JLOOP,:,NVT_SHRB) = 0.03
- ENDIF
-!-------------------------------------------------------------------------------
-!* 7.16 Binary for tall vegetation
-! --------------------------------------------------------------------------
-! parameters use in case LMEB == .TRUE.
-!
- IF (PRESENT(PZF_TALLVEG)) THEN
- PZF_TALLVEG (JLOOP,:) = 0.
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PZF_TALLVEG (JLOOP,NVT_TEBD) = 1.0
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PZF_TALLVEG (JLOOP,NVT_BONE) = 1.0
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PZF_TALLVEG (JLOOP,NVT_TRBE) = 1.0
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PZF_TALLVEG (JLOOP,NVT_TRBD) = 1.0
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PZF_TALLVEG (JLOOP,NVT_TEBE) = 1.0
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PZF_TALLVEG (JLOOP,NVT_TENE) = 1.0
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PZF_TALLVEG (JLOOP,NVT_BOBD) = 1.0
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PZF_TALLVEG (JLOOP,NVT_BOND) = 1.0
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PZF_TALLVEG (JLOOP,NVT_SHRB) = 1.0
- ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 7.17 Rgl for understory vegetation
-! ------------------------------
-!
- IF (PRESENT(PRGLGV)) THEN
- PRGLGV (JLOOP,:) = 100.
- ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 7.18 Gamma for understory vegetation
-! -------------------------------
-!
- IF (PRESENT(PGAMMAGV)) THEN
- PGAMMAGV (JLOOP,:) = 0.
- ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 7.19 Rsmin for understory vegetation
-! -------------------------------
-!
- IF (PRESENT(PRSMINGV)) THEN
- PRSMINGV (JLOOP,:) = 40.
- ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 7.20 Jackson (1996) coefficient for cumulative root fraction
-! for understory vegetataion. Assumed equal to grass value
-! -------------------------------------------------------
-!
- IF (PRESENT(PROOT_EXTINCTIONGV)) THEN
- PROOT_EXTINCTIONGV (JLOOP,:) = 0.943
- ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 7.21 Wrmax_cf for understory vegetation
-! ----------------------------------
-!
- IF (PRESENT(PWRMAX_CFGV)) THEN
- PWRMAX_CFGV (JLOOP,:) = 0.2
- ENDIF
+IF (PRESENT(PGNDLITTER)) THEN
+ PGNDLITTER (:,:,:) = 0.
+ PGNDLITTER (:,:,NVT_TEBD) = 0.03
+ PGNDLITTER (:,:,NVT_BONE) = 0.03
+ PGNDLITTER (:,:,NVT_TRBE) = 0.03
+ PGNDLITTER (:,:,NVT_TRBD) = 0.03
+ PGNDLITTER (:,:,NVT_TEBE) = 0.03
+ PGNDLITTER (:,:,NVT_TENE) = 0.03
+ PGNDLITTER (:,:,NVT_BOBD) = 0.03
+ PGNDLITTER (:,:,NVT_BOND) = 0.03
+ PGNDLITTER (:,:,NVT_SHRB) = 0.03
+ENDIF
+!
!------------------------------------------------------------------------
!* 2.20 specific leaf area sensitivity to nitrogen concentration
! -----------------------------
@@ -685,30 +858,60 @@ DO JLOOP=1,SIZE(PTYPE,1)
! kept values from Gibelin et al 2006
! -----------------------------------------------------
!
- IF (PRESENT(PCE_NITRO)) THEN
- PCE_NITRO(JLOOP,:)=7.68
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PCE_NITRO(JLOOP,NVT_TEBD)= 4.83
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PCE_NITRO(JLOOP,NVT_TRBD)= 4.83
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PCE_NITRO(JLOOP,NVT_TEBE)= 4.83
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PCE_NITRO(JLOOP,NVT_BOBD)= 4.83
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PCE_NITRO(JLOOP,NVT_SHRB)= 4.83
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PCE_NITRO(JLOOP,NVT_BONE)= 4.85
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PCE_NITRO(JLOOP,NVT_TENE)= 4.85
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PCE_NITRO(JLOOP,NVT_BOND)= 4.85
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PCE_NITRO(JLOOP,NVT_TRBE)= 4.83
- IF(GAGRI_TO_GRASS)THEN
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PCE_NITRO(JLOOP,NVT_C3 )= 5.56
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PCE_NITRO(JLOOP,NVT_C4 )= 5.56
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PCE_NITRO(JLOOP,NVT_IRR )= 5.56
- ELSE
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PCE_NITRO(JLOOP,NVT_C3 )= 3.79
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PCE_NITRO(JLOOP,NVT_C4 )= 7.68
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PCE_NITRO(JLOOP,NVT_IRR )= 7.68
- ENDIF
- IF(PTYPE(JLOOP,NVT_GRAS)>0. ) PCE_NITRO(JLOOP,NVT_GRAS)= 5.56
- IF(PTYPE(JLOOP,NVT_BOGR)>0. ) PCE_NITRO(JLOOP,NVT_BOGR)= 5.56
- IF(PTYPE(JLOOP,NVT_PARK)>0. ) PCE_NITRO(JLOOP,NVT_PARK)= 5.56
+IF (PRESENT(PCE_NITRO)) THEN
+ !
+ PCE_NITRO(:,:)=7.68
+ PCE_NITRO(:,NVT_TEBD)= 4.83
+ PCE_NITRO(:,NVT_TRBD)= 4.83
+ PCE_NITRO(:,NVT_TEBE)= 4.83
+ PCE_NITRO(:,NVT_BOBD)= 4.83
+ PCE_NITRO(:,NVT_SHRB)= 4.83
+ PCE_NITRO(:,NVT_BONE)= 4.85
+ PCE_NITRO(:,NVT_TENE)= 4.85
+ PCE_NITRO(:,NVT_BOND)= 4.85
+ PCE_NITRO(:,NVT_TRBE)= 4.83
+ IF (NVT_FLTR>0) THEN
+ PCE_NITRO(:,NVT_FLTR) = 4.83
+ ENDIF
+ !
+ IF(GAGRI_TO_GRASS)THEN
+ !
+ IF (NVT_C3/=0) THEN
+ PCE_NITRO(:,NVT_C3 )= 5.56
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PCE_NITRO(:,NVT_C3W )= 5.56
+ PCE_NITRO(:,NVT_C3S )= 5.56
ENDIF
+ PCE_NITRO(:,NVT_C4 )= 5.56
+ IF (NVT_IRR/=0) THEN
+ PCE_NITRO(:,NVT_IRR )= 5.56
+ ENDIF
+ !
+ ELSE
+ !
+ IF (NVT_C3/=0) THEN
+ PCE_NITRO(:,NVT_C3 )= 3.79
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PCE_NITRO(:,NVT_C3W )= 3.79
+ PCE_NITRO(:,NVT_C3S )= 3.79
+ ENDIF
+ PCE_NITRO(:,NVT_C4 )= 7.68
+ IF (NVT_IRR/=0) THEN
+ PCE_NITRO(:,NVT_IRR )= 7.68
+ ENDIF
+ !
+ ENDIF
+ !
+ PCE_NITRO(:,NVT_GRAS)= 5.56
+ PCE_NITRO(:,NVT_BOGR)= 5.56
+ !
+ IF (NVT_PARK/=0) THEN
+ PCE_NITRO(:,NVT_PARK)= 5.56
+ ELSEIF (NVT_FLGR/=0) THEN
+ PCE_NITRO(:,NVT_FLGR)= 5.56
+ ENDIF
+ !
+ENDIF
!
!-------------------------------------------------------------------------------
!* 2.21 lethal minimum value of leaf area ratio
@@ -719,31 +922,61 @@ DO JLOOP=1,SIZE(PTYPE,1)
! with SLA and Nm from TRY and "e" (PCE_NITRO) from Gibelin et al 2006
! used Domingues 2011 for TRBE SLA.
! ------------------------------------------------------
- IF (PRESENT(PCF_NITRO)) THEN
- PCF_NITRO(JLOOP,:)=-4.33
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PCF_NITRO(JLOOP,NVT_TEBD)= 5.11
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PCF_NITRO(JLOOP,NVT_TRBD)= 5.11
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PCF_NITRO(JLOOP,NVT_TEBE)= 0.17
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PCF_NITRO(JLOOP,NVT_BOBD)= 5.11
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PCF_NITRO(JLOOP,NVT_SHRB)= 4.98
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PCF_NITRO(JLOOP,NVT_BONE)= -0.87
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PCF_NITRO(JLOOP,NVT_TENE)= -0.87
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PCF_NITRO(JLOOP,NVT_BOND)= 0.68
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PCF_NITRO(JLOOP,NVT_TRBE)= 0.12 ! obtained using f = SLA - e*Nm
- ! with SLA = 8.33 m2/kg_DM (Domingues 2011), Nm=1.7% (TRY)
- IF(GAGRI_TO_GRASS)THEN
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PCF_NITRO(JLOOP,NVT_C3 )= 6.73
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PCF_NITRO(JLOOP,NVT_C4 )= 6.73
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PCF_NITRO(JLOOP,NVT_IRR )= 6.73
- ELSE
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PCF_NITRO(JLOOP,NVT_C3 )= 9.84
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PCF_NITRO(JLOOP,NVT_C4 )= -4.33
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PCF_NITRO(JLOOP,NVT_IRR )= -4.33
- ENDIF
- IF(PTYPE(JLOOP,NVT_GRAS)>0. ) PCF_NITRO(JLOOP,NVT_GRAS)= 6.73
- IF(PTYPE(JLOOP,NVT_BOGR)>0. ) PCF_NITRO(JLOOP,NVT_BOGR)= 6.73
- IF(PTYPE(JLOOP,NVT_PARK)>0. ) PCF_NITRO(JLOOP,NVT_PARK)= 6.73
- ENDIF
+IF (PRESENT(PCF_NITRO)) THEN
+ !
+ PCF_NITRO(:,:)=-4.33
+ PCF_NITRO(:,NVT_TEBD)= 5.11
+ PCF_NITRO(:,NVT_TRBD)= 5.11
+ PCF_NITRO(:,NVT_TEBE)= 0.17
+ PCF_NITRO(:,NVT_BOBD)= 5.11
+ PCF_NITRO(:,NVT_SHRB)= 4.98
+ PCF_NITRO(:,NVT_BONE)= -0.87
+ PCF_NITRO(:,NVT_TENE)= -0.87
+ PCF_NITRO(:,NVT_BOND)= 0.68
+ PCF_NITRO(:,NVT_TRBE)= 0.12 ! obtained using f = SLA - e*Nm
+ ! with SLA = 8.33 m2/kg_DM (Domingues 2011), Nm=1.7% (TRY)
+ IF (NVT_FLTR>0) THEN
+ PCF_NITRO(:,NVT_FLTR) = 5.11
+ ENDIF
+ !
+ IF(GAGRI_TO_GRASS)THEN
+ !
+ IF (NVT_C3/=0) THEN
+ PCF_NITRO(:,NVT_C3 )= 6.73
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PCF_NITRO(:,NVT_C3W )= 6.73
+ PCF_NITRO(:,NVT_C3S )= 6.73
+ ENDIF
+ PCF_NITRO(:,NVT_C4 )= 6.73
+ IF (NVT_IRR/=0) THEN
+ PCF_NITRO(:,NVT_IRR )= 6.73
+ ENDIF
+ !
+ ELSE
+ !
+ IF (NVT_C3/=0) THEN
+ PCF_NITRO(:,NVT_C3 )= 9.84
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PCF_NITRO(:,NVT_C3W )= 9.84
+ PCF_NITRO(:,NVT_C3S )= 9.84
+ ENDIF
+ PCF_NITRO(:,NVT_C4 )= -4.33
+ IF (NVT_IRR/=0) THEN
+ PCF_NITRO(:,NVT_IRR )= -4.33
+ ENDIF
+ !
+ ENDIF
+ !
+ PCF_NITRO(:,NVT_GRAS)= 6.73
+ PCF_NITRO(:,NVT_BOGR)= 6.73
+ !
+ IF (NVT_PARK/=0) THEN
+ PCF_NITRO(:,NVT_PARK)= 6.73
+ ELSEIF (NVT_FLGR/=0) THEN
+ PCF_NITRO(:,NVT_FLGR)= 6.73
+ ENDIF
+ !
+ENDIF
!-------------------------------------------------------------------------------
!* 2.22 nitrogen concentration of leaf biomass
! ----------
@@ -751,247 +984,316 @@ DO JLOOP=1,SIZE(PTYPE,1)
! Nm from TRY database (Kattge et al. GCB 2011) median values for tree PFTs
! Nm in mg_N/g_DM and PCNA_NITRO in % --> PCNA_NITRO = Nm * 0.1
! --------------------------------------------------
- IF (PRESENT(PCNA_NITRO)) THEN
- PCNA_NITRO(JLOOP,:)=1.3
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PCNA_NITRO(JLOOP,NVT_TEBD)= 2.13
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PCNA_NITRO(JLOOP,NVT_TRBD)= 2.13
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PCNA_NITRO(JLOOP,NVT_TEBE)= 1.69
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PCNA_NITRO(JLOOP,NVT_BOBD)= 2.13
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PCNA_NITRO(JLOOP,NVT_SHRB)= 2.15
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PCNA_NITRO(JLOOP,NVT_BONE)= 1.21
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PCNA_NITRO(JLOOP,NVT_TENE)= 1.21
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PCNA_NITRO(JLOOP,NVT_BOND)= 1.94
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PCNA_NITRO(JLOOP,NVT_TRBE)= 1.7
- IF(GAGRI_TO_GRASS)THEN
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PCNA_NITRO(JLOOP,NVT_C4 )= 1.3
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PCNA_NITRO(JLOOP,NVT_IRR) = 1.3
- ELSE
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PCNA_NITRO(JLOOP,NVT_C4 )= 1.9
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PCNA_NITRO(JLOOP,NVT_IRR) = 1.9
- ENDIF
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PCNA_NITRO(JLOOP,NVT_C3 )= 1.3
- IF(PTYPE(JLOOP,NVT_GRAS)>0. ) PCNA_NITRO(JLOOP,NVT_GRAS)= 1.3
- IF(PTYPE(JLOOP,NVT_BOGR)>0. ) PCNA_NITRO(JLOOP,NVT_BOGR)= 1.3
- IF(PTYPE(JLOOP,NVT_PARK)>0. ) PCNA_NITRO(JLOOP,NVT_PARK)= 1.3
- ENDIF
+IF (PRESENT(PCNA_NITRO)) THEN
+ !
+ PCNA_NITRO(:,:)=1.3
+ PCNA_NITRO(:,NVT_TEBD)= 2.13
+ PCNA_NITRO(:,NVT_TRBD)= 2.13
+ PCNA_NITRO(:,NVT_TEBE)= 1.69
+ PCNA_NITRO(:,NVT_BOBD)= 2.13
+ PCNA_NITRO(:,NVT_SHRB)= 2.15
+ PCNA_NITRO(:,NVT_BONE)= 1.21
+ PCNA_NITRO(:,NVT_TENE)= 1.21
+ PCNA_NITRO(:,NVT_BOND)= 1.94
+ PCNA_NITRO(:,NVT_TRBE)= 1.7
+ IF (NVT_FLTR>0) THEN
+ PCNA_NITRO(:,NVT_FLTR) = 2.13
+ ENDIF
+ !
+ IF(GAGRI_TO_GRASS)THEN
+ PCNA_NITRO(:,NVT_C4 )= 1.3
+ IF (NVT_IRR/=0) THEN
+ PCNA_NITRO(:,NVT_IRR) = 1.3
+ ENDIF
+ ELSE
+ PCNA_NITRO(:,NVT_C4 )= 1.9
+ IF (NVT_IRR/=0) THEN
+ PCNA_NITRO(:,NVT_IRR) = 1.9
+ ENDIF
+ ENDIF
+ !
+ IF (NVT_C3/=0) THEN
+ PCNA_NITRO(:,NVT_C3 )= 1.3
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PCNA_NITRO(:,NVT_C3W )= 1.3
+ PCNA_NITRO(:,NVT_C3S )= 1.3
+ ENDIF
+ !
+ PCNA_NITRO(:,NVT_GRAS)= 1.3
+ PCNA_NITRO(:,NVT_BOGR)= 1.3
+ !
+ IF (NVT_PARK/=0) THEN
+ PCNA_NITRO(:,NVT_PARK)= 1.3
+ ELSEIF (NVT_FLGR/=0) THEN
+ PCNA_NITRO(:,NVT_FLGR)= 1.3
+ ENDIF
+ !
+ENDIF
!-------------------------------------------------------------------------------
!* 7.15 Jackson (1996) coefficient for cumulative root fraction
! -------------------------------------------------------
- IF (PRESENT(PROOT_EXTINCTION)) THEN
- PROOT_EXTINCTION(JLOOP,:)= 0.943 ! (default value)
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PROOT_EXTINCTION(JLOOP,NVT_TEBD)= 0.966
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PROOT_EXTINCTION(JLOOP,NVT_TRBD)= 0.961
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PROOT_EXTINCTION(JLOOP,NVT_TEBE)= 0.966
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PROOT_EXTINCTION(JLOOP,NVT_SHRB)= 0.964
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PROOT_EXTINCTION(JLOOP,NVT_TENE)= 0.976
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PROOT_EXTINCTION(JLOOP,NVT_TRBE)= 0.962
- IF(GAGRI_TO_GRASS)THEN
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PROOT_EXTINCTION(JLOOP,NVT_C3 )= 0.943
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PROOT_EXTINCTION(JLOOP,NVT_C4 )= 0.943
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PROOT_EXTINCTION(JLOOP,NVT_IRR )= 0.943
- ELSE
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PROOT_EXTINCTION(JLOOP,NVT_C3 )= 0.961
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PROOT_EXTINCTION(JLOOP,NVT_C4 )= 0.972
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PROOT_EXTINCTION(JLOOP,NVT_IRR )= 0.972
- ENDIF
- IF(PTYPE(JLOOP,NVT_BOGR)>0. ) PROOT_EXTINCTION(JLOOP,NVT_BOGR)= 0.914
- IF(PTYPE(JLOOP,NVT_TROG)>0. ) PROOT_EXTINCTION(JLOOP,NVT_TROG)= 0.972
+IF (PRESENT(PROOT_EXTINCTION)) THEN
+ !
+ PROOT_EXTINCTION(:,:)= 0.943 ! (default value)
+ PROOT_EXTINCTION(:,NVT_TEBD)= 0.966
+ PROOT_EXTINCTION(:,NVT_TRBD)= 0.961
+ PROOT_EXTINCTION(:,NVT_TEBE)= 0.966
+ PROOT_EXTINCTION(:,NVT_SHRB)= 0.964
+ PROOT_EXTINCTION(:,NVT_TENE)= 0.976
+ PROOT_EXTINCTION(:,NVT_TRBE)= 0.962
+ IF (NVT_FLTR>0) THEN
+ PROOT_EXTINCTION(:,NVT_FLTR) = 0.966
+ ENDIF
+ !
+ IF(GAGRI_TO_GRASS)THEN
+ !
+ IF (NVT_C3/=0) THEN
+ PROOT_EXTINCTION(:,NVT_C3 )= 0.943
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PROOT_EXTINCTION(:,NVT_C3W )= 0.943
+ PROOT_EXTINCTION(:,NVT_C3S )= 0.943
+ ENDIF
+ PROOT_EXTINCTION(:,NVT_C4 )= 0.943
+ IF (NVT_IRR/=0) THEN
+ PROOT_EXTINCTION(:,NVT_IRR )= 0.943
+ ENDIF
+ !
+ ELSE
+ !
+ IF (NVT_C3/=0) THEN
+ PROOT_EXTINCTION(:,NVT_C3 )= 0.961
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PROOT_EXTINCTION(:,NVT_C3W )= 0.961
+ PROOT_EXTINCTION(:,NVT_C3S )= 0.961
+ ENDIF
+ PROOT_EXTINCTION(:,NVT_C4 )= 0.972
+ IF (NVT_IRR/=0) THEN
+ PROOT_EXTINCTION(:,NVT_IRR )= 0.972
ENDIF
+ !
+ ENDIF
+ !
+ PROOT_EXTINCTION(:,NVT_BOGR)= 0.914
+ PROOT_EXTINCTION(:,NVT_TROG)= 0.972
+ !
+ENDIF
!
!-------------------------------------------------------------------------------
!* 7.16 Ponderation coefficient between formulations for cumulative root fraction
! -------------------------------------------------------------------------
!
- IF (PRESENT(PROOT_LIN)) THEN
- PROOT_LIN(JLOOP,:)= 0.05
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PROOT_LIN(JLOOP,NVT_TRBE)= 0.25
- ENDIF
+IF (PRESENT(PROOT_LIN)) THEN
+ PROOT_LIN(:,:)= 0.05
+ PROOT_LIN(:,NVT_TRBE)= 0.25
+ENDIF
!
!-------------------------------------------------------------------------------
!* 7.17 Coefficient for chemistry deposition of SO2
! -------------------------------------------
- IF (PRESENT(PSOILRC_SO2)) THEN
- PSOILRC_SO2(JLOOP,:)= 9999.
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PSOILRC_SO2(JLOOP,NVT_TEBD)= 500.
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PSOILRC_SO2(JLOOP,NVT_TRBD)= 500.
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PSOILRC_SO2(JLOOP,NVT_TEBE)= 500.
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PSOILRC_SO2(JLOOP,NVT_BOBD)= 500.
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PSOILRC_SO2(JLOOP,NVT_SHRB)= 500.
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PSOILRC_SO2(JLOOP,NVT_BONE)= 500.
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PSOILRC_SO2(JLOOP,NVT_TENE)= 500.
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PSOILRC_SO2(JLOOP,NVT_BOND)= 500.
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PSOILRC_SO2(JLOOP,NVT_TRBE)= 200.
- IF(GAGRI_TO_GRASS)THEN
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PSOILRC_SO2(JLOOP,NVT_C3 )= 350.
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PSOILRC_SO2(JLOOP,NVT_C4 )= 350.
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PSOILRC_SO2(JLOOP,NVT_IRR )= 350.
- ELSE
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PSOILRC_SO2(JLOOP,NVT_C3 )= 150.
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PSOILRC_SO2(JLOOP,NVT_C4 )= 150.
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PSOILRC_SO2(JLOOP,NVT_IRR )= 0.001
- ENDIF
- IF(PTYPE(JLOOP,NVT_GRAS)>0. ) PSOILRC_SO2(JLOOP,NVT_GRAS)= 350.
- IF(PTYPE(JLOOP,NVT_BOGR)>0. ) PSOILRC_SO2(JLOOP,NVT_BOGR)= 350.
- IF(PTYPE(JLOOP,NVT_PARK)>0. ) PSOILRC_SO2(JLOOP,NVT_PARK)= 350.
- IF(PTYPE(JLOOP,NVT_TROG)>0. ) PSOILRC_SO2(JLOOP,NVT_TROG)= 350.
- IF(PTYPE(JLOOP,NVT_NO )>0. ) PSOILRC_SO2(JLOOP,NVT_NO )=1000.
- IF(PTYPE(JLOOP,NVT_ROCK)>0. ) PSOILRC_SO2(JLOOP,NVT_ROCK)= 400.
- IF(PTYPE(JLOOP,NVT_SNOW)>0. ) PSOILRC_SO2(JLOOP,NVT_SNOW)= 100.
+IF (PRESENT(PSOILRC_SO2)) THEN
+ !
+ PSOILRC_SO2(:,:)= 9999.
+ PSOILRC_SO2(:,NVT_TEBD)= 500.
+ PSOILRC_SO2(:,NVT_TRBD)= 500.
+ PSOILRC_SO2(:,NVT_TEBE)= 500.
+ PSOILRC_SO2(:,NVT_BOBD)= 500.
+ PSOILRC_SO2(:,NVT_SHRB)= 500.
+ PSOILRC_SO2(:,NVT_BONE)= 500.
+ PSOILRC_SO2(:,NVT_TENE)= 500.
+ PSOILRC_SO2(:,NVT_BOND)= 500.
+ PSOILRC_SO2(:,NVT_TRBE)= 200.
+ IF (NVT_FLTR>0) THEN
+ PSOILRC_SO2(:,NVT_FLTR) = 500.
+ ENDIF
+ !
+ IF(GAGRI_TO_GRASS)THEN
+ !
+ IF (NVT_C3/=0) THEN
+ PSOILRC_SO2(:,NVT_C3 )= 350.
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PSOILRC_SO2(:,NVT_C3W )= 350.
+ PSOILRC_SO2(:,NVT_C3S )= 350.
+ ENDIF
+ PSOILRC_SO2(:,NVT_C4 )= 350.
+ IF (NVT_IRR/=0) THEN
+ PSOILRC_SO2(:,NVT_IRR )= 350.
+ ENDIF
+ !
+ ELSE
+ !
+ IF (NVT_C3/=0) THEN
+ PSOILRC_SO2(:,NVT_C3 )= 150.
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PSOILRC_SO2(:,NVT_C3W )= 150.
+ PSOILRC_SO2(:,NVT_C3S )= 150.
+ ENDIF
+ PSOILRC_SO2(:,NVT_C4 )= 150.
+ IF (NVT_IRR/=0) THEN
+ PSOILRC_SO2(:,NVT_IRR )= 0.001
ENDIF
+ !
+ ENDIF
+ !
+ PSOILRC_SO2(:,NVT_GRAS)= 350.
+ PSOILRC_SO2(:,NVT_BOGR)= 350.
+ !
+ IF (NVT_PARK/=0) THEN
+ PSOILRC_SO2(:,NVT_PARK)= 350.
+ ELSEIF (NVT_FLGR/=0) THEN
+ PSOILRC_SO2(:,NVT_FLGR)= 350.
+ ENDIF
+ !
+ PSOILRC_SO2(:,NVT_TROG)= 350.
+ PSOILRC_SO2(:,NVT_NO )=1000.
+ PSOILRC_SO2(:,NVT_ROCK)= 400.
+ PSOILRC_SO2(:,NVT_SNOW)= 100.
+ !
+ENDIF
!
!------------------------------------------------------------------------------
!* 7.18 Coefficient for chemistry deposition of O3
! ------------------------------------------
- IF (PRESENT(PSOILRC_O3)) THEN
- PSOILRC_O3(JLOOP,:)= 9999.
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) PSOILRC_O3(JLOOP,NVT_TEBD)= 200.
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) PSOILRC_O3(JLOOP,NVT_TRBD)= 200.
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) PSOILRC_O3(JLOOP,NVT_TEBE)= 200.
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) PSOILRC_O3(JLOOP,NVT_BOBD)= 200.
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) PSOILRC_O3(JLOOP,NVT_SHRB)= 200.
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) PSOILRC_O3(JLOOP,NVT_BONE)= 200.
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) PSOILRC_O3(JLOOP,NVT_TENE)= 200.
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) PSOILRC_O3(JLOOP,NVT_BOND)= 200.
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) PSOILRC_O3(JLOOP,NVT_TRBE)= 500.
- IF(GAGRI_TO_GRASS)THEN
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PSOILRC_O3(JLOOP,NVT_C3 )= 200.
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PSOILRC_O3(JLOOP,NVT_C4 )= 200.
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PSOILRC_O3(JLOOP,NVT_IRR )= 200.
- ELSE
- IF(PTYPE(JLOOP,NVT_C3 )>0. ) PSOILRC_O3(JLOOP,NVT_C3 )= 150.
- IF(PTYPE(JLOOP,NVT_C4 )>0. ) PSOILRC_O3(JLOOP,NVT_C4 )= 150.
- IF(PTYPE(JLOOP,NVT_IRR )>0. ) PSOILRC_O3(JLOOP,NVT_IRR )=1000.
- ENDIF
- IF(PTYPE(JLOOP,NVT_GRAS)>0. ) PSOILRC_O3(JLOOP,NVT_GRAS)= 200.
- IF(PTYPE(JLOOP,NVT_BOGR)>0. ) PSOILRC_O3(JLOOP,NVT_BOGR)= 200.
- IF(PTYPE(JLOOP,NVT_PARK)>0. ) PSOILRC_O3(JLOOP,NVT_PARK)= 200.
- IF(PTYPE(JLOOP,NVT_TROG)>0. ) PSOILRC_O3(JLOOP,NVT_TROG)= 200.
- IF(PTYPE(JLOOP,NVT_NO )>0. ) PSOILRC_O3(JLOOP,NVT_NO )= 400.
- IF(PTYPE(JLOOP,NVT_ROCK)>0. ) PSOILRC_O3(JLOOP,NVT_ROCK)= 200.
- IF(PTYPE(JLOOP,NVT_SNOW)>0. ) PSOILRC_O3(JLOOP,NVT_SNOW)=3500.
+IF (PRESENT(PSOILRC_O3)) THEN
+ !
+ PSOILRC_O3(:,:)= 9999.
+ PSOILRC_O3(:,NVT_TEBD)= 200.
+ PSOILRC_O3(:,NVT_TRBD)= 200.
+ PSOILRC_O3(:,NVT_TEBE)= 200.
+ PSOILRC_O3(:,NVT_BOBD)= 200.
+ PSOILRC_O3(:,NVT_SHRB)= 200.
+ PSOILRC_O3(:,NVT_BONE)= 200.
+ PSOILRC_O3(:,NVT_TENE)= 200.
+ PSOILRC_O3(:,NVT_BOND)= 200.
+ PSOILRC_O3(:,NVT_TRBE)= 500.
+ IF (NVT_FLTR>0) THEN
+ PSOILRC_O3(:,NVT_FLTR) = 200.
+ ENDIF
+ !
+ IF(GAGRI_TO_GRASS)THEN
+ !
+ IF (NVT_C3/=0) THEN
+ PSOILRC_O3(:,NVT_C3 )= 200.
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PSOILRC_O3(:,NVT_C3W )= 200.
+ PSOILRC_O3(:,NVT_C3S )= 200.
+ ENDIF
+ PSOILRC_O3(:,NVT_C4 )= 200.
+ IF (NVT_IRR/=0) THEN
+ PSOILRC_O3(:,NVT_IRR )= 200.
+ ENDIF
+ !
+ ELSE
+ !
+ IF (NVT_C3/=0) THEN
+ PSOILRC_O3(:,NVT_C3 )= 150.
+ ELSEIF (NVT_C3W/=0 .AND. NVT_C3S/=0) THEN
+ PSOILRC_O3(:,NVT_C3W )= 150.
+ PSOILRC_O3(:,NVT_C3S )= 150.
ENDIF
+ PSOILRC_O3(:,NVT_C4 )= 150.
+ IF (NVT_IRR/=0) THEN
+ PSOILRC_O3(:,NVT_IRR )=1000.
+ ENDIF
+ !
+ ENDIF
+ !
+ PSOILRC_O3(:,NVT_GRAS)= 200.
+ PSOILRC_O3(:,NVT_BOGR)= 200.
+ !
+ IF (NVT_PARK/=0) THEN
+ PSOILRC_O3(:,NVT_PARK)= 200.
+ ELSEIF (NVT_FLGR/=0) THEN
+ PSOILRC_O3(:,NVT_FLGR)= 200.
+ ENDIF
+ !
+ PSOILRC_O3(:,NVT_TROG)= 200.
+ PSOILRC_O3(:,NVT_NO )= 400.
+ PSOILRC_O3(:,NVT_ROCK)= 200.
+ PSOILRC_O3(:,NVT_SNOW)=3500.
+ !
+ENDIF
!-------------------------------------------------------------------------------
!* 7.15 vegetation and greeness fractions
! ---------------------------------
- IF (PRESENT(PVEG_OUT) .AND. PRESENT(PLAI)) THEN
- DO JMONTH=1,SIZE(PVEG_OUT,2)
- PVEG_OUT(JLOOP,JMONTH,:) = VEG_FROM_LAI(PLAI(JLOOP,JMONTH,:), &
- PTYPE(JLOOP,:),GAGRI_TO_GRASS)
- END DO
- ELSEIF (PRESENT(PVEG_OUT) .AND. .NOT. PRESENT(PLAI)) THEN
- CALL ABOR1_SFX("INI_DATA_PARAM: WHEN CALLING WITH PVEG_OUT, PLAI MUST BE IN ARGUMENTS TOO")
- ENDIF
+IF (PRESENT(PVEG_OUT) .AND. PRESENT(PLAI)) THEN
+ DO JM=1,SIZE(PVEG_OUT,2)
+ DO JC = 1,SIZE(PVEG_OUT,1)
+ PVEG_OUT(JC,JM,:) = VEG_FROM_LAI(PLAI(JC,JM,:),GAGRI_TO_GRASS)
+ ENDDO
+ ENDDO
+ELSEIF (PRESENT(PVEG_OUT) .AND. .NOT. PRESENT(PLAI)) THEN
+ CALL ABOR1_SFX("INI_DATA_PARAM: WHEN CALLING WITH PVEG_OUT, PLAI MUST BE IN ARGUMENTS TOO")
+ENDIF
!
-
- IF (PRESENT(PGREEN) .AND. PRESENT(PLAI)) THEN
- DO JMONTH=1,SIZE(PGREEN,2)
- PGREEN(JLOOP,JMONTH,:) = GREEN_FROM_LAI(PLAI(JLOOP,JMONTH,:), &
- PTYPE(JLOOP,:),GAGRI_TO_GRASS)
- END DO
- ELSEIF (PRESENT(PGREEN) .AND. .NOT. PRESENT(PLAI)) THEN
- CALL ABOR1_SFX("INI_DATA_PARAM: WHEN CALLING WITH PGREEN, PLAI MUST BE IN ARGUMENTS TOO")
- ENDIF
+
+IF (PRESENT(PGREEN) .AND. PRESENT(PLAI)) THEN
+ DO JM=1,SIZE(PGREEN,2)
+ DO JC = 1,SIZE(PGREEN,1)
+ PGREEN(JC,JM,:) = GREEN_FROM_LAI(PLAI(JC,JM,:),GAGRI_TO_GRASS)
+ ENDDO
+ ENDDO
+ELSEIF (PRESENT(PGREEN) .AND. .NOT. PRESENT(PLAI)) THEN
+ CALL ABOR1_SFX("INI_DATA_PARAM: WHEN CALLING WITH PGREEN, PLAI MUST BE IN ARGUMENTS TOO")
+ENDIF
!-------------------------------------------------------------------------------
!* 7.16 z0
! --
- IF (PRESENT(PZ0) .AND. PRESENT(PLAI) .AND. PRESENT(PH_TREE)) THEN
- DO JMONTH=1,SIZE(PZ0,2)
- PZ0(JLOOP,JMONTH,:) = Z0V_FROM_LAI(PLAI(JLOOP,JMONTH,:), &
- PH_TREE(JLOOP,:), &
- PTYPE(JLOOP,:),GAGRI_TO_GRASS)
- END DO
- ELSEIF (PRESENT(PZ0) .AND. (.NOT. PRESENT(PLAI) .OR. .NOT. PRESENT(PH_TREE))) THEN
- CALL ABOR1_SFX("INI_DATA_PARAM: WHEN CALLING WITH PZ0, PLAI AND PH_TREE MUST BE IN ARGUMENTS TOO")
- ENDIF
+IF (PRESENT(PZ0) .AND. PRESENT(PLAI) .AND. PRESENT(PH_TREE)) THEN
+ DO JM=1,SIZE(PZ0,2)
+ DO JC = 1,SIZE(PZ0,1)
+ PZ0(JC,JM,:) = Z0V_FROM_LAI(PLAI(JC,JM,:),PH_TREE(JC,:),GAGRI_TO_GRASS)
+ ENDDO
+ ENDDO
+ELSEIF (PRESENT(PZ0) .AND. (.NOT. PRESENT(PLAI) .OR. .NOT. PRESENT(PH_TREE))) THEN
+ CALL ABOR1_SFX("INI_DATA_PARAM: WHEN CALLING WITH PZ0, PLAI AND PH_TREE MUST BE IN ARGUMENTS TOO")
+ENDIF
!-------------------------------------------------------------------------------
!* 7.17 z0/z0h
! ------
- IF (PRESENT(PZ0_O_Z0H)) PZ0_O_Z0H (JLOOP,:) = 10.
+IF (PRESENT(PZ0_O_Z0H)) PZ0_O_Z0H (:,:) = 10.
!-------------------------------------------------------------------------------
!* 7.18 emissivity
! ----------
- IF (PRESENT(PEMIS_ECO) .AND. (PRESENT(PVEG_IN).OR.PRESENT(PVEG_OUT))) THEN
- DO JMONTH=1,SIZE(PEMIS_ECO,2)
-
- IF (PRESENT(PVEG_OUT)) THEN
- PEMIS_ECO(JLOOP,JMONTH,:) = EMIS_FROM_VEG(PVEG_OUT(JLOOP,JMONTH,:), &
- PTYPE(JLOOP,:))
- ELSEIF (PRESENT(PVEG_IN)) THEN
- PEMIS_ECO(JLOOP,JMONTH,:) = EMIS_FROM_VEG(PVEG_IN(JLOOP,JMONTH,:), &
- PTYPE(JLOOP,:))
- ENDIF
- END DO
- ELSEIF (PRESENT(PEMIS_ECO) .AND. .NOT.PRESENT(PVEG_IN) .AND. .NOT.PRESENT(PVEG_OUT)) THEN
- CALL ABOR1_SFX("INI_DATA_PARAM: WHEN CALLING WITH PEMIS_ECO, PVEG_IN OR PVEG_OUT MUST BE IN ARGUMENTS TOO")
- ENDIF
+IF (PRESENT(PEMIS_ECO) .AND. (PRESENT(PVEG_IN).OR.PRESENT(PVEG_OUT))) THEN
+ DO JM=1,SIZE(PEMIS_ECO,2)
+ DO JC = 1,SIZE(PEMIS_ECO,1)
+ IF (PRESENT(PVEG_OUT)) THEN
+ PEMIS_ECO(JC,JM,:) = EMIS_FROM_VEG(PVEG_OUT(JC,JM,:))
+ ELSEIF (PRESENT(PVEG_IN)) THEN
+ PEMIS_ECO(JC,JM,:) = EMIS_FROM_VEG(PVEG_IN(JC,JM,:))
+ ENDIF
+ ENDDO
+ ENDDO
+ELSEIF (PRESENT(PEMIS_ECO) .AND. .NOT.PRESENT(PVEG_IN) .AND. .NOT.PRESENT(PVEG_OUT)) THEN
+ CALL ABOR1_SFX("INI_DATA_PARAM: WHEN CALLING WITH PEMIS_ECO, PVEG_IN OR PVEG_OUT MUST BE IN ARGUMENTS TOO")
+ENDIF
!
!-------------------------------------------------------------------------------
!
!* 7.19 vegetation height
! -----------------
!
- IF (PRESENT(PH_VEG) .AND. PRESENT(PLAI) .AND. PRESENT(PH_TREE)) THEN
- DO JMONTH=1,SIZE(PH_VEG,2)
- PH_VEG(JLOOP,JMONTH,:) = VEG_HEIGHT_FROM_LAI(PLAI(JLOOP,JMONTH,:), &
- PH_TREE(JLOOP,:), &
- PTYPE(JLOOP,:), GAGRI_TO_GRASS )
- END DO
- ELSEIF (PRESENT(PH_VEG) .AND. (.NOT. PRESENT(PLAI) .OR. .NOT. PRESENT(PH_TREE))) THEN
- CALL ABOR1_SFX("INI_DATA_PARAM: WHEN CALLING WITH PH_VEG, PLAI AND PH_TREE MUST BE IN ARGUMENTS TOO")
- ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 7.20 LAI understory vegetation
-! ----------
-!-------------------------------------------------------------------------------
- IF (PRESENT(PLAIGV_OUT) .AND. PRESENT(PLAI) .AND. ( PRESENT(PLAIMIN_IN) .OR. PRESENT(PLAIMIN_OUT) ) ) THEN
-!
-! LAI understoty vegetation defined as fraction of LAI upperstory vegetation
-! -------------------
- ZLAIFRGV (JLOOP,:) = 0.
- IF(PTYPE(JLOOP,NVT_TEBD)>0. ) ZLAIFRGV (JLOOP,NVT_TEBD) = 0.1
- IF(PTYPE(JLOOP,NVT_BONE)>0. ) ZLAIFRGV (JLOOP,NVT_BONE) = 0.1
- IF(PTYPE(JLOOP,NVT_TRBE)>0. ) ZLAIFRGV (JLOOP,NVT_TRBE) = 0.1
- IF(PTYPE(JLOOP,NVT_GRAS)>0. ) ZLAIFRGV (JLOOP,NVT_GRAS) = 0.1
- IF(PTYPE(JLOOP,NVT_TROG)>0. ) ZLAIFRGV (JLOOP,NVT_TROG) = 0.1
- IF(PTYPE(JLOOP,NVT_TRBD)>0. ) ZLAIFRGV (JLOOP,NVT_TRBD) = 0.1
- IF(PTYPE(JLOOP,NVT_TEBE)>0. ) ZLAIFRGV (JLOOP,NVT_TEBE) = 0.1
- IF(PTYPE(JLOOP,NVT_TENE)>0. ) ZLAIFRGV (JLOOP,NVT_TENE) = 0.1
- IF(PTYPE(JLOOP,NVT_BOBD)>0. ) ZLAIFRGV (JLOOP,NVT_BOBD) = 0.1
- IF(PTYPE(JLOOP,NVT_BOND)>0. ) ZLAIFRGV (JLOOP,NVT_BOND) = 0.1
- IF(PTYPE(JLOOP,NVT_BOGR)>0. ) ZLAIFRGV (JLOOP,NVT_BOGR) = 0.1
- IF(PTYPE(JLOOP,NVT_SHRB)>0. ) ZLAIFRGV (JLOOP,NVT_SHRB) = 0.1
-!
- DO JMONTH=1,SIZE(PLAIGV_OUT,2)
- IF(PRESENT(PLAIMIN_OUT))THEN
- PLAIGV_OUT(JLOOP,JMONTH,:) = MAX( PLAI(JLOOP,JMONTH,:)* &
- ZLAIFRGV(JLOOP,:), PLAIMIN_OUT(JLOOP,:) )
- ELSEIF(PRESENT(PLAIMIN_IN))THEN
- PLAIGV_OUT(JLOOP,JMONTH,:) = MAX( PLAI(JLOOP,JMONTH,:)* &
- ZLAIFRGV(JLOOP,:), PLAIMIN_IN(JLOOP,:) )
- ENDIF
- END DO
- ELSEIF (PRESENT(PLAIGV_OUT) .AND. ( .NOT.PRESENT(PLAI) .OR. &
- (.NOT.PRESENT(PLAIMIN_IN) .AND. .NOT.PRESENT(PLAIMIN_OUT) ) ) ) THEN
- CALL ABOR1_SFX("INI_DATA_PARAM: WHEN CALLING WITH PLAIGV_OUT, PLAI AND PLAIMIN_IN OR PLAIMIN_OUT MUST BE IN ARGUMENTS TOO")
- ENDIF
+IF (PRESENT(PH_VEG) .AND. PRESENT(PLAI) .AND. PRESENT(PH_TREE)) THEN
+ DO JM=1,SIZE(PH_VEG,2)
+ DO JC = 1,SIZE(PH_VEG,1)
+ PH_VEG(JC,JM,:) = VEG_HEIGHT_FROM_LAI(PLAI(JC,JM,:),PH_TREE(JC,:),GAGRI_TO_GRASS )
+ ENDDO
+ ENDDO
+ELSEIF (PRESENT(PH_VEG) .AND. (.NOT. PRESENT(PLAI) .OR. .NOT. PRESENT(PH_TREE))) THEN
+ CALL ABOR1_SFX("INI_DATA_PARAM: WHEN CALLING WITH PH_VEG, PLAI AND PH_TREE MUST BE IN ARGUMENTS TOO")
+ENDIF
!
!-------------------------------------------------------------------------------
!
!* 7.21 z0 understory litter
! --------------------
!
- IF (PRESENT(PZ0LITTER)) THEN
- PZ0LITTER(JLOOP,:,:) = 0.013 ! Roughness for bare soil
- ENDIF
+IF (PRESENT(PZ0LITTER)) THEN
+ PZ0LITTER(:,:,:) = 0.013 ! Roughness for bare soil
+ENDIF
!
!-------------------------------------------------------------------------------
!
- END IF
-!-------------------------------------------------------------------------------
-END DO
-!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('INI_DATA_PARAM',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/ini_data_rootfrac.F90 b/src/SURFEX/ini_data_rootfrac.F90
index 032fc8315b149c94be700a3804ac5e49f4fe6166..cdfb68c1ecccaec0132fbee4a9bb3d1943a85e93 100644
--- a/src/SURFEX/ini_data_rootfrac.F90
+++ b/src/SURFEX/ini_data_rootfrac.F90
@@ -66,13 +66,13 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDG ! depth of base of soil layers (m)
-REAL, DIMENSION(:,:), INTENT(IN) :: PROOTDEPTH ! effective root depth (m)
-REAL, DIMENSION(:,:), INTENT(IN) :: PROOT_EXT
-REAL, DIMENSION(:,:), INTENT(IN) :: PROOT_LIN
+REAL, DIMENSION(:,:), INTENT(IN) :: PDG ! depth of base of soil layers (m)
+REAL, DIMENSION(:), INTENT(IN) :: PROOTDEPTH ! effective root depth (m)
+REAL, DIMENSION(:), INTENT(IN) :: PROOT_EXT
+REAL, DIMENSION(:), INTENT(IN) :: PROOT_LIN
LOGICAL, OPTIONAL, INTENT(IN) :: OGV
!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PROOTFRAC
+REAL, DIMENSION(:,:), INTENT(OUT) :: PROOTFRAC
!
!* 0.2 declarations of local variables
!
@@ -84,8 +84,8 @@ REAL :: ZROOTFRGV ! Fraction of patch root depth given to
! ! =1 for non-understory vegetation
!
-INTEGER :: INI,INL,IPATCH
-INTEGER :: JJ,JL,JPATCH
+INTEGER :: INI,INL
+INTEGER :: JJ,JL
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
@@ -96,35 +96,33 @@ IF (LHOOK) CALL DR_HOOK('INI_DATA_ROOTFRAC',0,ZHOOK_HANDLE)
!
INI = SIZE(PDG,1)
INL = SIZE(PDG,2)
-IPATCH = SIZE(PDG,3)
!
ZROOTFRGV = 1.0
IF (PRESENT(OGV)) THEN
IF(OGV) ZROOTFRGV = 0.5
ENDIF
!
-PROOTFRAC(:,:,:) = XUNDEF
+PROOTFRAC(:,:) = XUNDEF
!
-DO JPATCH=1,IPATCH
DO JJ=1,INI
!
- IF ( PROOTDEPTH(JJ,JPATCH)/=XUNDEF .AND. PROOTDEPTH(JJ,JPATCH)/=0.0 ) THEN
+ IF ( PROOTDEPTH(JJ)/=XUNDEF .AND. PROOTDEPTH(JJ)/=0.0 ) THEN
!
DO JL=1,INL
- ZLOG1 = 100. * LOG(PROOT_EXT(JJ,JPATCH)) * PDG (JJ,JL,JPATCH)
- ZLOG2 = 100. * LOG(PROOT_EXT(JJ,JPATCH)) * ZROOTFRGV * PROOTDEPTH(JJ,JPATCH)
+ ZLOG1 = 100. * LOG(PROOT_EXT(JJ)) * PDG (JJ,JL)
+ ZLOG2 = 100. * LOG(PROOT_EXT(JJ)) * ZROOTFRGV * PROOTDEPTH(JJ)
ZJACKSON = MIN(1.0,(1.0-EXP(ZLOG1))/(1.0-EXP(ZLOG2)))
- ZUNIF = MIN(1.0,(PDG(JJ,JL,JPATCH)/ZROOTFRGV/PROOTDEPTH(JJ,JPATCH)))
- PROOTFRAC(JJ,JL,JPATCH) = PROOT_LIN(JJ,JPATCH) * ZUNIF &
- + (1.0-PROOT_LIN(JJ,JPATCH)) * ZJACKSON
+ ZUNIF = MIN(1.0,(PDG(JJ,JL)/ZROOTFRGV/PROOTDEPTH(JJ)))
+ PROOTFRAC(JJ,JL) = PROOT_LIN(JJ) * ZUNIF &
+ + (1.0-PROOT_LIN(JJ)) * ZJACKSON
ENDDO
! No vegetation case
ELSE
- PROOTFRAC(JJ,:,JPATCH) = 0.0
+ PROOTFRAC(JJ,:) = 0.0
ENDIF
!
ENDDO
-ENDDO
+
!
IF (LHOOK) CALL DR_HOOK('INI_DATA_ROOTFRAC',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/ini_data_soil.F90 b/src/SURFEX/ini_data_soil.F90
index bd76005b4648bf50cc4258b476a527686100387f..58ef0fa15a259d0740b2e03da279220c64829453 100644
--- a/src/SURFEX/ini_data_soil.F90
+++ b/src/SURFEX/ini_data_soil.F90
@@ -54,15 +54,15 @@ IMPLICIT NONE
! ------------------------
!
CHARACTER(LEN=*), INTENT(IN) :: HISBA ! type of soil (Force-Restore OR Diffusion)
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDG_OUT
+REAL, DIMENSION(:,:), INTENT(OUT) :: PDG_OUT
!
REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PSURF
REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PSURF2
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PROOTDEPTH
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSOILDEPTH
+REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PROOTDEPTH
+REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PSOILDEPTH
REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PSOILGRID ! reference soil grid (m)
!
-INTEGER, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: KWG_LAYER ! last layers for soil moisture
+INTEGER, DIMENSION(:), OPTIONAL, INTENT(OUT) :: KWG_LAYER ! last layers for soil moisture
!
!* 0.2 Declaration of local variables
! ------------------------------
@@ -81,7 +81,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('INI_DATA_SOIL',0,ZHOOK_HANDLE)
!
-PDG_OUT(:,:,:) = XUNDEF
+PDG_OUT(:,:) = XUNDEF
!
!-------------------------------------------------------------------------------
!
@@ -107,10 +107,10 @@ IF (HISBA=='2-L') THEN
DO JLOOP = 1,SIZE(LSURF)
IF (LSURF(JLOOP)) CYCLE
- WHERE(PROOTDEPTH(JLOOP,:) /= XUNDEF)
- PDG_OUT(JLOOP,1,:) = 0.01
- PDG_OUT(JLOOP,2,:) = PROOTDEPTH(JLOOP,:)
- END WHERE
+ IF(PROOTDEPTH(JLOOP) /= XUNDEF) THEN
+ PDG_OUT(JLOOP,1) = 0.01
+ PDG_OUT(JLOOP,2) = PROOTDEPTH(JLOOP)
+ ENDIF
ENDDO
!
!
@@ -127,11 +127,11 @@ ELSE
DO JLOOP = 1,SIZE(LSURF)
IF (LSURF(JLOOP)) CYCLE
- WHERE(PSOILDEPTH(JLOOP,:) /= XUNDEF)
- PDG_OUT(JLOOP,1,:) = 0.01
- PDG_OUT(JLOOP,2,:) = PROOTDEPTH(JLOOP,:)
- PDG_OUT(JLOOP,3,:) = PSOILDEPTH(JLOOP,:)
- END WHERE
+ IF(PSOILDEPTH(JLOOP) /= XUNDEF) THEN
+ PDG_OUT(JLOOP,1) = 0.01
+ PDG_OUT(JLOOP,2) = PROOTDEPTH(JLOOP)
+ PDG_OUT(JLOOP,3) = PSOILDEPTH(JLOOP)
+ ENDIF
ENDDO
!
!
diff --git a/src/SURFEX/ini_ssowork.F90 b/src/SURFEX/ini_ssowork.F90
index 28c3251dfc4081b7229ce036411f15de06f15456..d1de5d97055c771b66f125ae1a7a562ba86190b0 100644
--- a/src/SURFEX/ini_ssowork.F90
+++ b/src/SURFEX/ini_ssowork.F90
@@ -35,9 +35,10 @@
!! Original 10/12/97
!!
!
-USE MODD_PGDWORK, ONLY : XSSQO, LSSQO, NSSO
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
+USE MODD_PGDWORK, ONLY : NSSO, NSSO_ALL, XSSO_ALL
USE MODD_SURF_PAR, ONLY : NUNDEF, XUNDEF
-USE MODD_PGD_GRID, ONLY : NL
+USE MODD_SURFEX_MPI, ONLY : NINDEX
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -53,6 +54,8 @@ IMPLICIT NONE
REAL, OPTIONAL, INTENT(IN) :: PMESHLENGTH ! average mesh length in degrees
REAL, OPTIONAL, INTENT(IN) :: PDLAT ! input file mesh size (in latitude, degrees)
REAL, OPTIONAL, INTENT(IN) :: PDLON ! input file mesh size (in longitude, degrees)
+
+INTEGER :: IDIMF
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!----------------------------------------------------------------------------
@@ -62,6 +65,9 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! -------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('INI_SSOWORK',0,ZHOOK_HANDLE)
+!
+IDIMF = SIZE(NINDEX)
+!
IF (PRESENT(PMESHLENGTH) .AND. PRESENT(PDLAT) .AND. PRESENT(PDLON)) THEN
IF (PDLAT/= XUNDEF .AND. PDLON /= XUNDEF) THEN
NSSO = NINT( 2. * PMESHLENGTH / (PDLAT + PDLON) )
@@ -79,13 +85,16 @@ END IF
!* 2. Allocate subgrid arrays
! -----------------------
!
-IF (ALLOCATED(XSSQO)) DEALLOCATE(XSSQO)
-IF (ALLOCATED(LSSQO)) DEALLOCATE(LSSQO)
+IF (ALLOCATED(XSSO_ALL)) DEALLOCATE(XSSO_ALL)
+!
+ALLOCATE(XSSO_ALL(IDIMF,NSSO,NSSO))
+XSSO_ALL(:,:,:) = -XUNDEF
+!
+IF (ALLOCATED(NSSO_ALL)) DEALLOCATE(NSSO_ALL)
+!
+ALLOCATE(NSSO_ALL(IDIMF,NSSO,NSSO))
+NSSO_ALL(:,:,:) = 0
!
-ALLOCATE(XSSQO(NSSO,NSSO,NL))
-ALLOCATE(LSSQO(NSSO,NSSO,NL))
-XSSQO(:,:,:) = -99999.
-LSSQO(:,:,:) = .FALSE.
IF (LHOOK) CALL DR_HOOK('INI_SSOWORK',1,ZHOOK_HANDLE)
!
!----------------------------------------------------------------------------
diff --git a/src/SURFEX/ini_surf_csts.F90 b/src/SURFEX/ini_surf_csts.F90
index f3f7d24abb24194e14db8c6ba26080fb7957e636..e9c18b58d7f12ac8aecb67ae8ee1c3b95f9d61cb 100644
--- a/src/SURFEX/ini_surf_csts.F90
+++ b/src/SURFEX/ini_surf_csts.F90
@@ -251,30 +251,30 @@ XEVERG_VEG = 1.0 !Veg fraction
!
! * Soil depth average
!
- CDGAVG = 'INV'
+CDGAVG = 'INV'
!
! * Soil depth with ISBA-DF
!
- CDGDIF = 'ROOT'
+CDGDIF = 'ROOT'
!
! * wind implicitation option
!
- CIMPLICIT_WIND = 'NEW'
+CIMPLICIT_WIND = 'NEW'
!
! * qsat computation
!
- CQSAT = 'NEW'
+CQSAT = 'NEW'
!
! * Charnock parameter
!
- CCHARNOCK = 'NEW'
+CCHARNOCK = 'NEW'
!
!-------------------------------------------------------------------------------
!* 2. User values
!-------------------------------------------------------------------------------
!
CALL GET_LUOUT(CPROGNAME,ILUOUT)
-!
+!
CALL OPEN_NAMELIST(CPROGNAME,ILUNAM)
!
CALL POSNAM(ILUNAM,'NAM_SURF_CSTS',GFOUND,ILUOUT)
diff --git a/src/SURFEX/ini_var_from_data.F90 b/src/SURFEX/ini_var_from_data.F90
index 4d19e00a221ed3c774b55135c9c4726df4bea290..755b57888ba78c96d104fa660cd1b0c80967befa 100644
--- a/src/SURFEX/ini_var_from_data.F90
+++ b/src/SURFEX/ini_var_from_data.F90
@@ -6,29 +6,52 @@ MODULE MODI_INI_VAR_FROM_DATA
!
INTERFACE INI_VAR_FROM_DATA
!
-SUBROUTINE INI_VAR_FROM_DATA_1D (DTCO, DGU, UG, U, USS, DTI, &
+SUBROUTINE INI_VAR_FROM_DATA_NAT_1D (DTCO, UG, U, USS, PPAR_VEGTYPE, &
HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, HFTYP, PUNIF, PFIELD, OPRESENT)
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_SSO_n, ONLY : SSO_t
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
+TYPE(SSO_t), INTENT(INOUT) :: USS
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PPAR_VEGTYPE
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
CHARACTER(LEN=3), INTENT(IN) :: HATYPE
CHARACTER(LEN=*), INTENT(IN) :: HNAME
CHARACTER(LEN=3), INTENT(IN) :: HTYPE
CHARACTER(LEN=28), DIMENSION(:), INTENT(IN) :: HFNAM
- CHARACTER(LEN=6), DIMENSION(:), INTENT(IN) :: HFTYP
+ CHARACTER(LEN=6), DIMENSION(:), INTENT(INOUT) :: HFTYP
+REAL, DIMENSION(:), INTENT(IN) :: PUNIF
+REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELD
+LOGICAL, DIMENSION(:), INTENT(OUT) :: OPRESENT
+!
+END SUBROUTINE INI_VAR_FROM_DATA_NAT_1D
+!
+SUBROUTINE INI_VAR_FROM_DATA_1D (DTCO, UG, U, USS, &
+ HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, HFTYP, PUNIF, PFIELD, OPRESENT)
+!
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
+!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
+ CHARACTER(LEN=3), INTENT(IN) :: HATYPE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME
+ CHARACTER(LEN=3), INTENT(IN) :: HTYPE
+ CHARACTER(LEN=28), DIMENSION(:), INTENT(IN) :: HFNAM
+ CHARACTER(LEN=6), DIMENSION(:), INTENT(INOUT) :: HFTYP
REAL, DIMENSION(:), INTENT(IN) :: PUNIF
REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELD
LOGICAL, INTENT(OUT) :: OPRESENT
@@ -36,30 +59,53 @@ LOGICAL, INTENT(OUT) :: OPRESENT
END SUBROUTINE INI_VAR_FROM_DATA_1D
!
!
- SUBROUTINE INI_VAR_FROM_DATA_2D (DTCO, DGU, UG, U, USS, DTI, &
+ SUBROUTINE INI_VAR_FROM_DATA_NAT_2D (DTCO, UG, U, USS, PPAR_VEGTYPE, &
HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, HFTYP, PUNIF, PFIELD_TIME, OPRESENT)
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_SSO_n, ONLY : SSO_t
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PPAR_VEGTYPE
+!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
+ CHARACTER(LEN=3), INTENT(IN) :: HATYPE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME
+ CHARACTER(LEN=3), INTENT(IN) :: HTYPE
+ CHARACTER(LEN=28), DIMENSION(:,:), INTENT(IN) :: HFNAM
+ CHARACTER(LEN=6), DIMENSION(:,:), INTENT(INOUT) :: HFTYP
+REAL, DIMENSION(:,:), INTENT(IN) :: PUNIF
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFIELD_TIME
+LOGICAL, DIMENSION(:), INTENT(OUT) :: OPRESENT
!
+END SUBROUTINE INI_VAR_FROM_DATA_NAT_2D
+!
+!
+ SUBROUTINE INI_VAR_FROM_DATA_2D (DTCO, UG, U, USS, &
+ HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, HFTYP, PUNIF, PFIELD_TIME, OPRESENT)
+!
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
CHARACTER(LEN=3), INTENT(IN) :: HATYPE
CHARACTER(LEN=*), INTENT(IN) :: HNAME
CHARACTER(LEN=3), INTENT(IN) :: HTYPE
CHARACTER(LEN=28), DIMENSION(:,:), INTENT(IN) :: HFNAM
- CHARACTER(LEN=6), DIMENSION(:,:), INTENT(IN) :: HFTYP
+ CHARACTER(LEN=6), DIMENSION(:,:), INTENT(INOUT) :: HFTYP
REAL, DIMENSION(:,:), INTENT(IN) :: PUNIF
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFIELD_TIME
LOGICAL, INTENT(OUT) :: OPRESENT
@@ -73,7 +119,120 @@ END MODULE MODI_INI_VAR_FROM_DATA
!
!
! #########
- SUBROUTINE INI_VAR_FROM_DATA_1D (DTCO, DGU, UG, U, USS, DTI, &
+ SUBROUTINE INI_VAR_FROM_DATA_NAT_1D (DTCO, UG, U, USS, PPAR_VEGTYPE, &
+ HPROGRAM, HATYPE, HNAME ,HTYPE, HFNAM, HFTYP, PUNIF, PFIELD, OPRESENT)
+! ##############################################################
+!
+!* 0. DECLARATION
+! -----------
+!
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
+!
+USE MODI_INI_VAR_FROM_DATA_0D
+USE MODI_ABOR1_SFX
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
+REAL, DIMENSION(:,:), INTENT(IN) :: PPAR_VEGTYPE
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
+ CHARACTER(LEN=3), INTENT(IN) :: HATYPE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME
+ CHARACTER(LEN=3), INTENT(IN) :: HTYPE
+ CHARACTER(LEN=28), DIMENSION(:), INTENT(INOUT) :: HFNAM
+ CHARACTER(LEN=6), DIMENSION(:), INTENT(INOUT) :: HFTYP
+REAL, DIMENSION(:), INTENT(INOUT) :: PUNIF
+REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELD
+LOGICAL, DIMENSION(:), INTENT(OUT) :: OPRESENT
+!
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+REAL, DIMENSION(SIZE(PPAR_VEGTYPE,1)) :: ZMASK
+ CHARACTER(LEN=40) :: YNAME
+INTEGER :: JV, JV2 ! loop counter on vegtypes
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+
+!-------------------------------------------------------------------------------
+!
+!* 1. Initializations
+! ---------------
+!
+IF (LHOOK) &
+ CALL DR_HOOK('MODI_INI_VAR_FROM_DATA:INI_VAR_FROM_DATA_NAT_1D',0,ZHOOK_HANDLE)
+!
+OPRESENT(:) = .FALSE.
+!
+YNAME=ADJUSTL(HNAME)
+!
+IF (HFTYP(1)=='DIRTYP') THEN
+
+ CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
+ HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM(1), &
+ HFTYP(1), PUNIF(1), PFIELD, OPRESENT(1), PPAR_VEGTYPE)
+
+ OPRESENT(2:) = OPRESENT(1)
+
+
+ELSE
+
+ IF (.NOT.ALL(LEN_TRIM(HFNAM(:))/=0) .AND. .NOT.ALL(LEN_TRIM(HFNAM(2:))==0)) THEN
+ DO JV=1,SIZE(PFIELD,2)
+ IF (LEN_TRIM(HFNAM(JV))==0) THEN
+ DO JV2=JV-1,1,-1
+ IF (LEN_TRIM(HFNAM(JV2))/=0) THEN
+ HFNAM(JV) = HFNAM(JV2)
+ HFTYP(JV) = HFTYP(JV2)
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+ ENDIF
+
+ DO JV=1,SIZE(PFIELD,2)
+
+ IF (ALL(LEN_TRIM(HFNAM(2:))==0)) THEN
+ ZMASK(:) = 1.
+ ELSE
+ ZMASK(:) = PPAR_VEGTYPE(:,JV)
+ ENDIF
+
+ CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
+ HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM(JV), &
+ HFTYP(JV), PUNIF(JV), PFIELD(:,JV), OPRESENT(JV), ZMASK)
+ ENDDO
+
+ENDIF
+!
+IF (LHOOK) &
+ CALL DR_HOOK('MODI_INI_VAR_FROM_DATA:INI_VAR_FROM_DATA_NAT_1D',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE INI_VAR_FROM_DATA_NAT_1D
+!
+!
+! #########
+ SUBROUTINE INI_VAR_FROM_DATA_1D (DTCO, UG, U, USS, &
HPROGRAM, HATYPE, HNAME ,HTYPE, HFNAM, HFTYP, PUNIF, PFIELD, OPRESENT)
! ##############################################################
!
@@ -110,11 +269,9 @@ END MODULE MODI_INI_VAR_FROM_DATA
! -----------
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
!
@@ -130,18 +287,16 @@ IMPLICIT NONE
! ------------------------
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
CHARACTER(LEN=3), INTENT(IN) :: HATYPE
CHARACTER(LEN=*), INTENT(IN) :: HNAME
CHARACTER(LEN=3), INTENT(IN) :: HTYPE
CHARACTER(LEN=28), DIMENSION(:), INTENT(IN) :: HFNAM
- CHARACTER(LEN=6), DIMENSION(:), INTENT(IN) :: HFTYP
+ CHARACTER(LEN=6), DIMENSION(:), INTENT(INOUT) :: HFTYP
REAL, DIMENSION(:), INTENT(IN) :: PUNIF
REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELD
LOGICAL, INTENT(OUT) :: OPRESENT
@@ -152,7 +307,7 @@ LOGICAL, INTENT(OUT) :: OPRESENT
!
CHARACTER(LEN=40) :: YNAME
LOGICAL, DIMENSION(SIZE(PFIELD,2)) :: LPRESENT
-INTEGER :: JI, JJ ! loop counter on vegtypes
+INTEGER :: JV, JJ ! loop counter on vegtypes
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -168,53 +323,190 @@ IF (LHOOK) &
OPRESENT=.FALSE.
YNAME=ADJUSTL(HNAME)
!
-DO JI=1,SIZE(PFIELD,2)
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
- HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM(JI), &
- HFTYP(JI), PUNIF(JI), PFIELD(:,JI), LPRESENT(JI))
+DO JV=1,SIZE(PFIELD,2)
+ CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
+ HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM(JV), &
+ HFTYP(JV), PUNIF(JV), PFIELD(:,JV), LPRESENT(JV))
ENDDO
!
IF (ANY(LPRESENT(:))) THEN
OPRESENT=.TRUE.
- IF (SIZE(PFIELD,2)==NVEGTYPE .AND. YNAME(1:7).NE.'VEGTYPE') THEN
+ IF (.NOT.ALL(LPRESENT)) THEN
+ CALL ABOR1_SFX("INI_VAR_FROM_DATA_1D: MISSING INPUT DATA FOR "//HNAME)
+ ENDIF
- !if a vegtype are missing, the last present gives it his values
- DO JI=2,SIZE(PFIELD,2)
- IF (.NOT.LPRESENT(JI)) THEN
- DO JJ=JI,1,-1
- IF (LPRESENT(JJ)) THEN
- PFIELD(:,JI)=PFIELD(:,JJ)
- LPRESENT(JI)=.TRUE.
- EXIT
- ENDIF
- ENDDO
+ENDIF
+!
+IF (LHOOK) &
+ CALL DR_HOOK('MODI_INI_VAR_FROM_DATA:INI_VAR_FROM_DATA_1D',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE INI_VAR_FROM_DATA_1D
+!
+!
+! #########
+ SUBROUTINE INI_VAR_FROM_DATA_NAT_2D (DTCO, UG, U, USS, PPAR_VEGTYPE, &
+ HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, HFTYP, PUNIF, PFIELD_TIME, OPRESENT)
+! ##############################################################
+!
+!
+!* 0. DECLARATION
+! -----------
+!
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_PGDWORK, ONLY : NSIZE
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
+!
+USE MODI_ABOR1_SFX
+USE MODI_INI_VAR_FROM_DATA_0D
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PPAR_VEGTYPE
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
+ CHARACTER(LEN=3), INTENT(IN) :: HATYPE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME
+ CHARACTER(LEN=3), INTENT(IN) :: HTYPE
+ CHARACTER(LEN=28), DIMENSION(:,:), INTENT(INOUT) :: HFNAM
+ CHARACTER(LEN=6), DIMENSION(:,:), INTENT(INOUT) :: HFTYP
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PUNIF
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFIELD_TIME
+LOGICAL, DIMENSION(:), INTENT(OUT) :: OPRESENT
+!
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+REAL, DIMENSION(SIZE(PPAR_VEGTYPE,1)) :: ZMASK
+INTEGER :: JV, JJ, JV2 ! loop counter on vegtypes
+INTEGER :: JTIME
+INTEGER :: ITIME, ISIZE_V, IDX
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+
+!-------------------------------------------------------------------------------
+!
+!* 1. Initializations
+! ---------------
+!
+IF (LHOOK) &
+ CALL DR_HOOK('MODI_INI_VAR_FROM_DATA:INI_VAR_FROM_DATA_NAT_2D',0,ZHOOK_HANDLE)
+!
+OPRESENT(:)=.FALSE.
+ITIME=0
+!
+ISIZE_V = SIZE(PFIELD_TIME,3)
+!
+DO JTIME=1,SIZE(PFIELD_TIME,2)
+!
+ IF (HFTYP(1,JTIME)=='DIRTYP') THEN
+
+ IF (SIZE(OPRESENT)>ISIZE_V) THEN
+ IDX = (JTIME-1)*ISIZE_V+1
+ ELSE
+ IDX = 1
+ ENDIF
+ CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
+ HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM(1,JTIME), &
+ HFTYP(1,JTIME), PUNIF(1,JTIME), PFIELD_TIME(:,JTIME,:), &
+ OPRESENT(IDX), PPAR_VEGTYPE)
+ OPRESENT(IDX+1:IDX+ISIZE_V-1) = OPRESENT(IDX)
+
+ ELSE
+
+ IF (.NOT.ALL(LEN_TRIM(HFNAM(:,JTIME))/=0) .AND. &
+ COUNT(LEN_TRIM(HFNAM(:,JTIME))/=0)>1) THEN
+ DO JV=1,SIZE(PFIELD_TIME,3)
+ IF (LEN_TRIM(HFNAM(JV,JTIME))==0) THEN
+ DO JV2=JV-1,1,-1
+ IF (LEN_TRIM(HFNAM(JV2,JTIME))/=0) THEN
+ HFNAM(JV,JTIME) = HFNAM(JV2,JTIME)
+ HFTYP(JV,JTIME) = HFTYP(JV2,JTIME)
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+ ENDIF
+
+ IF (.NOT.ALL(PUNIF(:,JTIME)/=XUNDEF) .AND. &
+ COUNT(PUNIF(:,JTIME)/=XUNDEF)>1) THEN
+ DO JV=1,SIZE(PFIELD_TIME,3)
+ IF (PUNIF(JV,JTIME)==XUNDEF) THEN
+ DO JV2=JV-1,1,-1
+ IF (PUNIF(JV2,JTIME)/=XUNDEF) THEN
+ PUNIF(JV,JTIME) = PUNIF(JV2,JTIME)
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+ ENDIF
+
+ DO JV=1,ISIZE_V
+
+ IF (SIZE(OPRESENT)>ISIZE_V) THEN
+ IDX = (JTIME-1)*ISIZE_V+JV
+ ELSE
+ IDX = JV
ENDIF
- ENDDO
- DO JI=1,SIZE(PFIELD,2)
- IF (LPRESENT(JI)) THEN
- WHERE (DTI%XPAR_VEGTYPE(:,JI).EQ.0.) PFIELD(:,JI)=0.0
+ IF (ALL(LEN_TRIM(HFNAM(2:,JTIME))==0)) THEN
+ ZMASK(:) = 1.
ELSE
- PFIELD(:,JI)=0.
+ ZMASK(:) = PPAR_VEGTYPE(:,JV)
ENDIF
- ENDDO
- ELSEIF (.NOT.ALL(LPRESENT)) THEN
- CALL ABOR1_SFX("INI_VAR_FROM_DATA_1D: MISSING INPUT DATA FOR "//HNAME)
+ CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
+ HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM(JV,JTIME), &
+ HFTYP(JV,JTIME), PUNIF(JV,JTIME), PFIELD_TIME(:,JTIME,JV), &
+ OPRESENT(IDX), ZMASK)
+ ENDDO
+
ENDIF
+
+ENDDO
+!
+!print*,HNAME
+IF (SIZE(OPRESENT)>ISIZE_V) THEN
+ DO JV = 1,ISIZE_V
+ DO JTIME=1,SIZE(PFIELD_TIME,2)-1
+ IF (OPRESENT((JTIME-1)*ISIZE_V+JV).NEQV.OPRESENT(JTIME*ISIZE_V+JV)) THEN
+ CALL ABOR1_SFX("INI_VAR_FROM_DATA: "//TRIM(HNAME)//" - CHECK NTIME AND ADAPT NUMBER OF DATA TO NTIME")
+ ENDIF
+ ENDDO
+ ENDDO
ENDIF
!
-IF (LHOOK) &
- CALL DR_HOOK('MODI_INI_VAR_FROM_DATA:INI_VAR_FROM_DATA_1D',1,ZHOOK_HANDLE)
+
+IF (LHOOK) CALL DR_HOOK('MODI_INI_VAR_FROM_DATA:INI_VAR_FROM_DATA_NAT_2D',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
!
-END SUBROUTINE INI_VAR_FROM_DATA_1D
+END SUBROUTINE INI_VAR_FROM_DATA_NAT_2D
+!
!
! #########
- SUBROUTINE INI_VAR_FROM_DATA_2D (DTCO, DGU, UG, U, USS, DTI, &
+ SUBROUTINE INI_VAR_FROM_DATA_2D (DTCO, UG, U, USS, &
HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, HFTYP, PUNIF, PFIELD_TIME, OPRESENT)
! ##############################################################
!
@@ -241,7 +533,6 @@ END SUBROUTINE INI_VAR_FROM_DATA_1D
!! S. Faroux Meteo-France
!!
!! MODIFICATION
-!! ------------
!!
!! Original 16/11/10
!!
@@ -251,11 +542,9 @@ END SUBROUTINE INI_VAR_FROM_DATA_1D
! -----------
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
!
@@ -273,18 +562,16 @@ IMPLICIT NONE
! ------------------------
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
CHARACTER(LEN=3), INTENT(IN) :: HATYPE
CHARACTER(LEN=*), INTENT(IN) :: HNAME
CHARACTER(LEN=3), INTENT(IN) :: HTYPE
CHARACTER(LEN=28), DIMENSION(:,:), INTENT(IN) :: HFNAM
- CHARACTER(LEN=6), DIMENSION(:,:), INTENT(IN) :: HFTYP
+ CHARACTER(LEN=6), DIMENSION(:,:), INTENT(INOUT) :: HFTYP
REAL, DIMENSION(:,:), INTENT(IN) :: PUNIF
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFIELD_TIME
LOGICAL, INTENT(OUT) :: OPRESENT
@@ -295,7 +582,7 @@ LOGICAL, INTENT(OUT) :: OPRESENT
!
LOGICAL, DIMENSION(SIZE(PFIELD_TIME,3)) :: LPRESENT
LOGICAL, DIMENSION(SIZE(PFIELD_TIME,2)) :: LPRESENT_TIME
-INTEGER :: JI, JJ ! loop counter on vegtypes
+INTEGER :: JV, JJ ! loop counter on vegtypes
INTEGER :: JTIME
INTEGER :: ITIME
!
@@ -316,12 +603,12 @@ ITIME=0
!
DO JTIME=1,SIZE(PFIELD_TIME,2)
- DO JI=1,SIZE(PFIELD_TIME,3)
+ DO JV=1,SIZE(PFIELD_TIME,3)
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
- HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM(JI,JTIME), &
- HFTYP(JI,JTIME), PUNIF(JI,JTIME), PFIELD_TIME(:,JTIME,JI),&
- LPRESENT(JI))
+ CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
+ HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM(JV,JTIME), &
+ HFTYP(JV,JTIME), PUNIF(JV,JTIME), PFIELD_TIME(:,JTIME,JV),&
+ LPRESENT(JV))
ENDDO
@@ -331,29 +618,8 @@ DO JTIME=1,SIZE(PFIELD_TIME,2)
OPRESENT=.TRUE.
ITIME=ITIME+1
- IF (SIZE(PFIELD_TIME,3)==NVEGTYPE) THEN
-
- DO JI=2,SIZE(PFIELD_TIME,3)
- IF (.NOT.LPRESENT(JI)) THEN
- DO JJ=JI,1,-1
- IF (LPRESENT(JJ)) THEN
- PFIELD_TIME(:,JTIME,JI)=PFIELD_TIME(:,JTIME,JJ)
- LPRESENT(JI)=.TRUE.
- EXIT
- ENDIF
- ENDDO
- ENDIF
- ENDDO
- DO JI=1,SIZE(PFIELD_TIME,3)
- IF (LPRESENT(JI)) THEN
- WHERE (DTI%XPAR_VEGTYPE(:,JI).EQ.0.) PFIELD_TIME(:,JTIME,JI)=0.0
- ELSE
- PFIELD_TIME(:,JTIME,JI)=0.
- ENDIF
- ENDDO
-
- ELSEIF (.NOT.ALL(LPRESENT)) THEN
- CALL ABOR1_SFX("INI_VAR_FROM_DATA_1D: MISSING INPUT DATA FOR "//HNAME)
+ IF (.NOT.ALL(LPRESENT)) THEN
+ CALL ABOR1_SFX("INI_VAR_FROM_DATA_2D: MISSING INPUT DATA FOR "//HNAME)
ENDIF
ENDIF
diff --git a/src/SURFEX/ini_var_from_data_0d.F90 b/src/SURFEX/ini_var_from_data_0d.F90
index 3be10481eaa3b0e138847d9bd34e0a0080823e40..0f8ef4dedb87b9dba4970e890a09d26937646d98 100644
--- a/src/SURFEX/ini_var_from_data_0d.F90
+++ b/src/SURFEX/ini_var_from_data_0d.F90
@@ -2,61 +2,104 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
+MODULE MODI_INI_VAR_FROM_DATA_0D
+!
+INTERFACE INI_VAR_FROM_DATA_0D
+!
! #########
- SUBROUTINE INI_VAR_FROM_DATA_0D (DTCO, DGU, UG, U, USS, &
- HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, &
- HFTYP, PUNIF, PFIELD, OPRESENT)
+ SUBROUTINE INI_VAR_FROM_DATA_0D_1D (DTCO, UG, U, USS, &
+ HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, &
+ HFTYP, PUNIF, PFIELD, OPRESENT, &
+ PMASK)
! ##############################################################
!
-!!
-!! PURPOSE
-!! -------
-!!
-!! METHOD
-!! ------
-!!
-!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! S. Faroux Meteo-France
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 16/11/10
-!!
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
+!
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
+ CHARACTER(LEN=3), INTENT(IN) :: HATYPE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME
+ CHARACTER(LEN=3), INTENT(IN) :: HTYPE
+ CHARACTER(LEN=28), INTENT(IN) :: HFNAM
+ CHARACTER(LEN=6), INTENT(INOUT) :: HFTYP
+REAL, INTENT(IN) :: PUNIF
+REAL, DIMENSION(:), INTENT(OUT) :: PFIELD
+LOGICAL, INTENT(OUT) :: OPRESENT
+REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PMASK
+!
!
+END SUBROUTINE INI_VAR_FROM_DATA_0D_1D
!
+! #########
+ SUBROUTINE INI_VAR_FROM_DATA_0D_2D (DTCO, UG, U, USS, &
+ HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, &
+ HFTYP, PUNIF, PFIELD, OPRESENT, &
+ PMASK)
+! ##############################################################
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
+!
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
+ CHARACTER(LEN=3), INTENT(IN) :: HATYPE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME
+ CHARACTER(LEN=3), INTENT(IN) :: HTYPE
+ CHARACTER(LEN=28), INTENT(IN) :: HFNAM
+ CHARACTER(LEN=6), INTENT(INOUT) :: HFTYP
+REAL, INTENT(IN) :: PUNIF
+REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELD
+LOGICAL, INTENT(OUT) :: OPRESENT
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PMASK
+!
+!
+END SUBROUTINE INI_VAR_FROM_DATA_0D_2D
+!
+END INTERFACE INI_VAR_FROM_DATA_0D
!
-USE MODD_SURF_PAR, ONLY : XUNDEF
+END MODULE MODI_INI_VAR_FROM_DATA_0D
!
-USE MODD_PGDWORK, ONLY : CATYPE
+! #########
+ SUBROUTINE INI_VAR_FROM_DATA_0D_1D (DTCO, UG, U, USS, &
+ HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, &
+ HFTYP, PUNIF, PFIELD, OPRESENT, PMASK)
+! ##############################################################
+!
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
!
-USE MODI_PGD_FIELD
-USE MODI_READ_FROM_SURFEX_FILE
+USE MODD_SURF_PAR, ONLY : XUNDEF
!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
+USE MODI_INI_VAR_FROM_DATA_0D_IN
!
IMPLICIT NONE
!
@@ -65,10 +108,9 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
@@ -76,60 +118,78 @@ TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
CHARACTER(LEN=*), INTENT(IN) :: HNAME
CHARACTER(LEN=3), INTENT(IN) :: HTYPE
CHARACTER(LEN=28), INTENT(IN) :: HFNAM
- CHARACTER(LEN=6), INTENT(IN) :: HFTYP
+ CHARACTER(LEN=6), INTENT(INOUT) :: HFTYP
REAL, INTENT(IN) :: PUNIF
REAL, DIMENSION(:), INTENT(OUT) :: PFIELD
LOGICAL, INTENT(OUT) :: OPRESENT
+REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PMASK
+!
+REAL, DIMENSION(SIZE(PFIELD),1) :: ZFIELD
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZMASK
+!
+IF (PRESENT(PMASK)) THEN
+ ALLOCATE(ZMASK(SIZE(PMASK),1))
+ ZMASK(:,1) = PMASK
+ CALL INI_VAR_FROM_DATA_0D_IN(DTCO, UG, U, USS, &
+ HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, &
+ HFTYP, PUNIF, ZFIELD, OPRESENT, ZMASK)
+ DEALLOCATE(ZMASK)
+ELSE
+ CALL INI_VAR_FROM_DATA_0D_IN(DTCO, UG, U, USS, &
+ HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, &
+ HFTYP, PUNIF, ZFIELD, OPRESENT)
+ENDIF
+!
+IF (ANY(ZFIELD(:,1)/=XUNDEF)) PFIELD(:) = ZFIELD(:,1)
+!
+!
+END SUBROUTINE INI_VAR_FROM_DATA_0D_1D
+!
+! #########
+ SUBROUTINE INI_VAR_FROM_DATA_0D_2D (DTCO, UG, U, USS, &
+ HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, &
+ HFTYP, PUNIF, PFIELD, OPRESENT, PMASK)
+! ##############################################################
+!
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
+!
+USE MODI_INI_VAR_FROM_DATA_0D_IN
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-
-!-------------------------------------------------------------------------------
-!
-!* 1. Initializations
-! ---------------
-!
-IF (LHOOK) CALL DR_HOOK('INI_VAR_FROM_DATA_0D',0,ZHOOK_HANDLE)
-!
-PFIELD(:)=XUNDEF
-OPRESENT=.FALSE.
-!
-IF (HFTYP.EQ.'FA ' .OR. HFTYP.EQ.'ASCII ' .OR. HFTYP.EQ.'LFI ') THEN
-
- OPRESENT=.TRUE.
- SELECT CASE (HTYPE)
- CASE ('LAN')
- CALL READ_FROM_SURFEX_FILE(DTCO, DGU, U, &
- HFTYP,HFNAM,'SURF ',' ',PFIELD)
- CASE ('TWN')
- CALL READ_FROM_SURFEX_FILE(DTCO, DGU, U, &
- HFTYP,HFNAM,'TOWN ',' ',PFIELD)
- CASE ('NAT')
- CALL READ_FROM_SURFEX_FILE(DTCO, DGU, U, &
- HFTYP,HFNAM,'NATURE',' ',PFIELD)
- CASE ('SEA')
- CALL READ_FROM_SURFEX_FILE(DTCO, DGU, U, &
- HFTYP,HFNAM,'SEA ',' ',PFIELD)
- CASE ('WAT')
- CALL READ_FROM_SURFEX_FILE(DTCO, DGU, U, &
- HFTYP,HFNAM,'WATER ',' ',PFIELD)
- END SELECT
-
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
+ CHARACTER(LEN=3), INTENT(IN) :: HATYPE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME
+ CHARACTER(LEN=3), INTENT(IN) :: HTYPE
+ CHARACTER(LEN=28), INTENT(IN) :: HFNAM
+ CHARACTER(LEN=6), INTENT(INOUT) :: HFTYP
+REAL, INTENT(IN) :: PUNIF
+REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELD
+LOGICAL, INTENT(OUT) :: OPRESENT
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PMASK
+!
+IF (PRESENT(PMASK)) THEN
+ CALL INI_VAR_FROM_DATA_0D_IN(DTCO, UG, U, USS, &
+ HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, &
+ HFTYP, PUNIF, PFIELD, OPRESENT, PMASK)
ELSE
-
- CATYPE = HATYPE
- CALL PGD_FIELD(DTCO, UG, U, USS, &
- HPROGRAM,HNAME,HTYPE,HFNAM,HFTYP,PUNIF,PFIELD(:),OPRESENT=OPRESENT)
-
+ CALL INI_VAR_FROM_DATA_0D_IN(DTCO, UG, U, USS, &
+ HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, &
+ HFTYP, PUNIF, PFIELD, OPRESENT)
ENDIF
!
-IF (LHOOK) CALL DR_HOOK('INI_VAR_FROM_DATA_0D',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
+END SUBROUTINE INI_VAR_FROM_DATA_0D_2D
!
-END SUBROUTINE INI_VAR_FROM_DATA_0D
-
diff --git a/src/SURFEX/ini_var_from_data_0d_in.F90 b/src/SURFEX/ini_var_from_data_0d_in.F90
new file mode 100644
index 0000000000000000000000000000000000000000..dcdf9c39e2654be5bdb9eee42e0724049269fb42
--- /dev/null
+++ b/src/SURFEX/ini_var_from_data_0d_in.F90
@@ -0,0 +1,130 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE INI_VAR_FROM_DATA_0D_IN (DTCO, UG, U, USS, &
+ HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, &
+ HFTYP, PUNIF, PFIELD, OPRESENT, &
+ PVEGTYPE)
+! ##############################################################
+!
+!!
+!! PURPOSE
+!! -------
+!!
+!! METHOD
+!! ------
+!!
+!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! S. Faroux Meteo-France
+!!
+!! MODIFICATION
+!! ------------
+!!
+!! Original 16/11/10
+!!
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATION
+! -----------
+!
+!
+!
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE MODD_PGDWORK, ONLY : CATYPE
+!
+USE MODI_PGD_FIELD
+USE MODI_READ_FROM_SURFEX_FILE
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
+!
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
+ CHARACTER(LEN=3), INTENT(IN) :: HATYPE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME
+ CHARACTER(LEN=3), INTENT(IN) :: HTYPE
+ CHARACTER(LEN=28), INTENT(IN) :: HFNAM
+ CHARACTER(LEN=6), INTENT(INOUT) :: HFTYP
+REAL, INTENT(IN) :: PUNIF
+REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELD
+LOGICAL, INTENT(OUT) :: OPRESENT
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PVEGTYPE
+!
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+
+!-------------------------------------------------------------------------------
+!
+!* 1. Initializations
+! ---------------
+!
+IF (LHOOK) CALL DR_HOOK('INI_VAR_FROM_DATA_0D_IN',0,ZHOOK_HANDLE)
+!
+IF (HFTYP.EQ.'FA ' .OR. HFTYP.EQ.'ASCII ' .OR. HFTYP.EQ.'LFI'&
+ .OR. HFTYP.EQ.'NC ') THEN
+
+ OPRESENT=.TRUE.
+ SELECT CASE (HTYPE)
+ CASE ('LAN')
+ CALL READ_FROM_SURFEX_FILE(DTCO, U, HFTYP,HFNAM,'SURF ',' ',PFIELD(:,1))
+ CASE ('TWN')
+ CALL READ_FROM_SURFEX_FILE(DTCO, U, HFTYP,HFNAM,'TOWN ',' ',PFIELD(:,1))
+ CASE ('NAT')
+ CALL READ_FROM_SURFEX_FILE(DTCO, U, HFTYP,HFNAM,'NATURE',' ',PFIELD(:,1))
+ CASE ('SEA')
+ CALL READ_FROM_SURFEX_FILE(DTCO, U, HFTYP,HFNAM,'SEA ',' ',PFIELD(:,1))
+ CASE ('WAT')
+ CALL READ_FROM_SURFEX_FILE(DTCO, U, HFTYP,HFNAM,'WATER ',' ',PFIELD(:,1))
+ END SELECT
+
+ELSE
+ !
+ OPRESENT=.FALSE.
+ CATYPE = HATYPE
+ CALL PGD_FIELD(DTCO, UG, U, USS, &
+ HPROGRAM,HNAME,HTYPE,HFNAM,HFTYP,PUNIF,PFIELD,&
+ OPRESENT=OPRESENT,PVEGTYPE=PVEGTYPE)
+ENDIF
+!
+!
+IF (LHOOK) CALL DR_HOOK('INI_VAR_FROM_DATA_0D_IN',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE INI_VAR_FROM_DATA_0D_IN
+
diff --git a/src/SURFEX/ini_var_from_patch.F90 b/src/SURFEX/ini_var_from_patch.F90
index c500ee57c5be4414e8b39a2cc68a43bd499bd22f..dca0e3d8d3f06d1e417ac23fd10894ec7933c5ac 100644
--- a/src/SURFEX/ini_var_from_patch.F90
+++ b/src/SURFEX/ini_var_from_patch.F90
@@ -2,8 +2,8 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
- SUBROUTINE INI_VAR_FROM_PATCH (DTCO, I, UG, U, &
- HPROGRAM,KLUOUT,HNAME,PFIELD,KPTS,PDEF)
+ SUBROUTINE INI_VAR_FROM_PATCH (DTCO, UG, U, NP, NPE, KPATCH,&
+ HPROGRAM,KLUOUT,HNAME,KPTS,KLAYER,KLAYER2,PDEF)
!!
!! PURPOSE
!! -------
@@ -38,14 +38,12 @@
!!* 0. DECLARATION
! -----------
!
-!
-!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_ISBA_n, ONLY : ISBA_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
+USE MODD_ISBA_n, ONLY : ISBA_NP_t, ISBA_NPE_t, ISBA_P_t, ISBA_PE_t
+!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE MODI_GET_SURF_MASK_n
@@ -63,29 +61,40 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(ISBA_t), INTENT(INOUT) :: I
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! host model
-INTEGER, INTENT(IN ) :: KLUOUT
-INTEGER, INTENT(IN ) :: KPTS
- CHARACTER(LEN=*), INTENT(IN ) :: HNAME
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PFIELD
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
!
-REAL, DIMENSION(: ), OPTIONAL, INTENT(IN) :: PDEF
+INTEGER, INTENT(IN) :: KPATCH
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! host model
+INTEGER, INTENT(IN) :: KLUOUT
+INTEGER, INTENT(IN) :: KPTS
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME
+!
+INTEGER, INTENT(IN), OPTIONAL :: KLAYER
+INTEGER, INTENT(IN), OPTIONAL :: KLAYER2
+!
+REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PDEF
!
!* 0.2 Declaration of local variables
! ------------------------------
!
-LOGICAL, DIMENSION(SIZE(I%XLAI,1),SIZE(I%XLAI,2)) :: GVEG
-REAL, DIMENSION(SIZE(PFIELD,1)) :: ZFIELD1_TOT, ZFIELD2_TOT
-INTEGER, DIMENSION(SIZE(PFIELD,1)) :: IMASK ! mask for packing from complete field to nature field
-INTEGER, DIMENSION(SIZE(PFIELD,1)) :: NSIZE
+TYPE(ISBA_P_t), POINTER :: PK
+TYPE(ISBA_PE_t), POINTER :: PEK
+LOGICAL, DIMENSION(U%NSIZE_NATURE,KPATCH) :: GVEG
+REAL, DIMENSION(U%NSIZE_NATURE) :: ZFIELD1_TOT, ZFIELD2_TOT
+INTEGER, DIMENSION(U%NSIZE_NATURE) :: IMASK ! mask for packing from complete field to nature field
+INTEGER, DIMENSION(U%NSIZE_NATURE) :: NSIZE
+INTEGER, DIMENSION(U%NSIZE_NATURE) :: NSIZE_NAT
INTEGER, DIMENSION(U%NSIZE_FULL) :: NSIZE_TOT
REAL, DIMENSION(U%NSIZE_FULL) :: ZFIELD_TOT
-INTEGER :: INI, IPATCH, IFULL, INPTS
-INTEGER :: JPATCH ! loop counter on patch
+REAL, DIMENSION(U%NSIZE_NATURE) :: ZFIELD_NAT
+REAL, DIMENSION(U%NSIZE_NATURE,KPATCH) :: ZFIELD
+INTEGER :: INI, IPATCH, IFULL, INPTS, JI
+INTEGER :: JP, IMASK0 ! loop counter on patch
REAL :: ZRATIO_TOT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -96,28 +105,144 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('INI_VAR_FROM_PATCH',0,ZHOOK_HANDLE)
!
-INI=SIZE(PFIELD,1)
-IPATCH=SIZE(PFIELD,2)
+INI=U%NSIZE_NATURE
!
+IF (TRIM(HNAME)=='WR') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%XWR(:)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='ICE_STO') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%XICE_STO(:)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='TEMP GRO') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%XTG(:,KLAYER)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='ALBSNOW') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%TSNOW%ALB(:)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='EMISSNOW') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%TSNOW%EMIS(:)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='TSSNOW') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%TSNOW%TS(:)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='WSNOW') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%TSNOW%WSNOW(:,KLAYER)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='TEMPSNOW') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%TSNOW%TEMP(:,KLAYER)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='HEATSNOW') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%TSNOW%HEAT(:,KLAYER)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='AGESNOW') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%TSNOW%AGE(:,KLAYER)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='TSNOW') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%TSNOW%T(:,KLAYER)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='GR1SNOW') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%TSNOW%GRAN1(:,KLAYER)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='GR2SNOW') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%TSNOW%GRAN2(:,KLAYER)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='HISTSNOW') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%TSNOW%HIST(:,KLAYER)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='WG') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%XWG(:,KLAYER)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='WGI') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%XWGI(:,KLAYER)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='RESA') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%XRESA(:)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='RHOSNOW') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%TSNOW%RHO(:,KLAYER)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='AN') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%XAN(:)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='ANDAY') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%XANDAY(:)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='ANFM') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%XANFM(:)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='LE') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%XLE(:)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='RESPBIOM') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%XRESP_BIOMASS(:,KLAYER)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='BIOMASS') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%XBIOMASS(:,KLAYER)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='LIGNINST') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%XLIGNIN_STRUC(:,KLAYER)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='LITTER') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%XLITTER(:,KLAYER,KLAYER2)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='SOILCARB') THEN
+ DO JP = 1,KPATCH
+ ZFIELD(:,JP) = NPE%AL(JP)%XSOILCARB(:,KLAYER)
+ ENDDO
+ENDIF
+
IF (KPTS>0)THEN
!
- CALL GET_SURF_MASK_n(DTCO, U, &
- 'NATURE',INI,IMASK,U%NSIZE_FULL,KLUOUT)
+ CALL GET_SURF_MASK_n(DTCO, U, 'NATURE',INI,IMASK,U%NSIZE_FULL,KLUOUT)
!
- DO JPATCH=1,IPATCH
+ DO JP=1,KPATCH
+ !
NSIZE(:)=0
- WHERE (PFIELD(:,JPATCH).NE.XUNDEF) NSIZE(:)=1
- WHERE (I%XPATCH(:,JPATCH)==0.) NSIZE(:)=-1
- CALL UNPACK_SAME_RANK(IMASK,NSIZE,NSIZE_TOT,-1)
- CALL UNPACK_SAME_RANK(IMASK,PFIELD(:,JPATCH),ZFIELD_TOT)
+ WHERE (ZFIELD(:,JP).NE.XUNDEF) NSIZE(:)=1
+ WHERE (NP%AL(JP)%XPATCH(:)==0.) NSIZE(:)=-1
+ !
+ CALL UNPACK_SAME_RANK(NP%AL(JP)%NR_P,NSIZE,NSIZE_NAT,-1)
+ CALL UNPACK_SAME_RANK(IMASK,NSIZE_NAT,NSIZE_TOT,-1)
+ !
+ CALL UNPACK_SAME_RANK(NP%AL(JP)%NR_P,ZFIELD(:,JP),ZFIELD_NAT)
+ CALL UNPACK_SAME_RANK(IMASK,ZFIELD_NAT,ZFIELD_TOT)
+ !
IF(PRESENT(PDEF))THEN
CALL INTERPOL_FIELD(UG, U, &
- HPROGRAM,KLUOUT,NSIZE_TOT,ZFIELD_TOT,HNAME,PDEF=PDEF(JPATCH),KNPTS=KPTS)
+ HPROGRAM,KLUOUT,NSIZE_TOT,ZFIELD_TOT,HNAME,PDEF=PDEF(JP),KNPTS=KPTS)
ELSE
- CALL INTERPOL_FIELD(UG, U, &
- HPROGRAM,KLUOUT,NSIZE_TOT,ZFIELD_TOT,HNAME,KNPTS=KPTS)
+ CALL INTERPOL_FIELD(UG, U, HPROGRAM,KLUOUT,NSIZE_TOT,ZFIELD_TOT,HNAME,KNPTS=KPTS)
ENDIF
- CALL PACK_SAME_RANK(IMASK,ZFIELD_TOT,PFIELD(:,JPATCH))
+ !
+ CALL PACK_SAME_RANK(IMASK,ZFIELD_TOT,ZFIELD_NAT)
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZFIELD_NAT,ZFIELD(:,JP))
+ !
ENDDO
!
ELSE
@@ -135,27 +260,40 @@ ELSE
!
IF (TRIM(HNAME)=='WR')THEN
!no interception over soil(1), roc(2) and glaciers(3)
- DO JPATCH=1,IPATCH
- WHERE(I%XPATCH(:,JPATCH) /=0. .AND. I%XPATCH_OLD(:,JPATCH) ==0..AND.I%XLAI(:,JPATCH)==0.)
- PFIELD(:,JPATCH) = 0.
- GVEG (:,JPATCH) = .FALSE.
+ DO JP=1,KPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+
+ WHERE(PK%XPATCH(:) /=0. .AND. PK%XPATCH_OLD(:) ==0..AND.PEK%XLAI(:)==0.)
+ ZFIELD(:,JP) = 0.
+ GVEG (:,JP) = .FALSE.
ENDWHERE
END DO
END IF
!
!quantity of water before restart in each grid point
- DO JPATCH=1,IPATCH
- ZFIELD1_TOT(:)=ZFIELD1_TOT(:)+ I%XPATCH_OLD(:,JPATCH)*PFIELD(:,JPATCH)
+ ZFIELD1_TOT(:) = 0.0
+ DO JP = 1,KPATCH
+ PK => NP%AL(JP)
+ DO JI = 1,PK%NSIZE_P
+ IMASK0 = PK%NR_P(JI)
+ ZFIELD1_TOT(IMASK0)=ZFIELD1_TOT(IMASK0)+ PK%XPATCH_OLD(JI) * ZFIELD(JI,JP)
+ ENDDO
END DO
!
- DO JPATCH=1,IPATCH
- !if a patch appears in a grid point, it takes the quantity of water in the
- !whole grid point before
- WHERE(I%XPATCH(:,JPATCH) /=0. .AND. I%XPATCH_OLD(:,JPATCH)==0. .AND. GVEG (:,JPATCH))
- PFIELD(:,JPATCH)=ZFIELD1_TOT(:)
- ENDWHERE
- !quantity of water after restart and landuse in each grid point
- ZFIELD2_TOT(:)=ZFIELD2_TOT(:)+ I%XPATCH(:,JPATCH)*PFIELD(:,JPATCH)
+ ZFIELD2_TOT(:) = 0.0
+ DO JP=1,KPATCH
+ PK => NP%AL(JP)
+ DO JI = 1,PK%NSIZE_P
+ IMASK0 = PK%NR_P(JI)
+ !if a patch appears in a grid point, it takes the quantity of water in the
+ !whole grid point before
+ IF(PK%XPATCH(JI) /=0. .AND. PK%XPATCH_OLD(JI)==0. .AND. GVEG (JI,JP)) THEN
+ ZFIELD(JI,JP)=ZFIELD1_TOT(IMASK0)
+ ENDIF
+ !quantity of water after restart and landuse in each grid point
+ ZFIELD2_TOT(IMASK0)=ZFIELD2_TOT(IMASK0)+ PK%XPATCH(JI)*ZFIELD(JI,JP)
+ ENDDO
END DO
!
! Conserve cell mass if not WG and WGI
@@ -163,17 +301,132 @@ ELSE
! is recomanded
!
IF (TRIM(HNAME)/='WG' .AND. TRIM(HNAME)/='WGI') THEN
- DO JPATCH=1,IPATCH
- WHERE(ZFIELD2_TOT(:) > 1.E-12)
- PFIELD(:,JPATCH)=(ZFIELD1_TOT(:)/ZFIELD2_TOT(:))*PFIELD(:,JPATCH)
- ENDWHERE
+ DO JP=1,KPATCH
+ PK => NP%AL(JP)
+ DO JI = 1,PK%NSIZE_P
+ IMASK0 = PK%NR_P(JI)
+ IF (ZFIELD2_TOT(IMASK0) > 1.E-12) THEN
+ ZFIELD(JI,JP)=(ZFIELD1_TOT(IMASK0)/ZFIELD2_TOT(IMASK0))*ZFIELD(JI,JP)
+ ENDIF
+ END DO
END DO
ENDIF
!
- WHERE(I%XPATCH(:,:) ==0.)PFIELD(:,:)=XUNDEF
+ DO JP = 1,KPATCH
+ WHERE(NP%AL(JP)%XPATCH(:) ==0.)ZFIELD(:,JP)=XUNDEF
+ ENDDO
!
ENDIF
!
+IF (TRIM(HNAME)=='WR') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%XWR(:) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='ICE_STO') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%XICE_STO(:) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='TEMP GRO') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%XTG(:,KLAYER) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='ALBSNOW') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%TSNOW%ALB(:) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='EMISSNOW') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%TSNOW%EMIS(:) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='TSSNOW') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%TSNOW%TS(:) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='WSNOW') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%TSNOW%WSNOW(:,KLAYER) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='TEMPSNOW') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%TSNOW%TEMP(:,KLAYER) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='HEATSNOW') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%TSNOW%HEAT(:,KLAYER) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='AGESNOW') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%TSNOW%AGE(:,KLAYER) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='TSNOW') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%TSNOW%T(:,KLAYER) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='GR1SNOW') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%TSNOW%GRAN1(:,KLAYER) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='GR2SNOW') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%TSNOW%GRAN2(:,KLAYER) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='HISTSNOW') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%TSNOW%HIST(:,KLAYER) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='WG') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%XWG(:,KLAYER) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='WGI') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%XWGI(:,KLAYER) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='RESA') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%XRESA(:) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='RHOSNOW') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%TSNOW%RHO(:,KLAYER) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='AN') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%XAN(:) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='ANDAY') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%XANDAY(:) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='ANFM') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%XANFM(:) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='LE') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%XLE(:) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='RESPBIOM') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%XRESP_BIOMASS(:,KLAYER) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='BIOMASS') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%XBIOMASS(:,KLAYER) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='LIGNINST') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%XLIGNIN_STRUC(:,KLAYER) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='LITTER') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%XLITTER(:,KLAYER,KLAYER2) = ZFIELD(:,JP)
+ ENDDO
+ELSEIF (TRIM(HNAME)=='SOILCARB') THEN
+ DO JP = 1,KPATCH
+ NPE%AL(JP)%XSOILCARB(:,KLAYER) = ZFIELD(:,JP)
+ ENDDO
+ENDIF
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('INI_VAR_FROM_PATCH',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/ini_var_from_vegtype_data.F90 b/src/SURFEX/ini_var_from_vegtype_data.F90
index c13af5d5d02bdc6f83aff57884bba262dbdf4591..8734bc7f7104c4bb750a03822d6b12a1c4571b7d 100644
--- a/src/SURFEX/ini_var_from_vegtype_data.F90
+++ b/src/SURFEX/ini_var_from_vegtype_data.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE INI_VAR_FROM_VEGTYPE_DATA (DTCO, DTI, UG, U, &
+ SUBROUTINE INI_VAR_FROM_VEGTYPE_DATA (DTCO, DTV, UG, U, &
HPROGRAM,ILUOUT,HNAME,PFIELD,PDEF)
! ##############################################################
!!
@@ -61,7 +61,7 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
@@ -103,7 +103,7 @@ ALLOCATE(ZFIELD_TOT(U%NSIZE_FULL))
DO JVEGTYPE=1,IVEGTYPE
NSIZE(:)=0
WHERE (PFIELD(:,JVEGTYPE).NE.XUNDEF) NSIZE(:)=1
- WHERE (DTI%XPAR_VEGTYPE(:,JVEGTYPE)==0.) NSIZE(:)=-1
+ WHERE (DTV%XPAR_VEGTYPE(:,JVEGTYPE)==0.) NSIZE(:)=-1
CALL UNPACK_SAME_RANK(IMASK,NSIZE,NSIZE_TOT,-1)
CALL UNPACK_SAME_RANK(IMASK,PFIELD(:,JVEGTYPE),ZFIELD_TOT)
IF(PRESENT(PDEF))THEN
diff --git a/src/SURFEX/init_bemn.F90 b/src/SURFEX/init_bemn.F90
index 71e61373e796634704759633145f793d3dc1c8ee..8d97ff2ca6ce3edea38c60413b39053f55dd07da 100644
--- a/src/SURFEX/init_bemn.F90
+++ b/src/SURFEX/init_bemn.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #############################################################
- SUBROUTINE INIT_BEM_n ( DGU, DTCO, UG, U, TM, &
- KLUOUT)
+ SUBROUTINE INIT_BEM_n ( DTCO, TOP, BOP, DTT, DTB, BDD, G, &
+ T, B, KLUOUT)
! #############################################################
!
!!**** *INIT_BEM_n* - routine to initialize Building Energy Model
@@ -39,11 +39,16 @@
! ------------
!
!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURFEX_n, ONLY : TEB_MODEL_t
+!
+USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
+USE MODD_BEM_OPTION_n, ONLY : BEM_OPTIONS_t
+USE MODD_DATA_TEB_n, ONLY : DATA_TEB_t
+USE MODD_DATA_BEM_n, ONLY : DATA_BEM_t
+USE MODD_BLD_DESCRIPTION_n, ONLY : BLD_DESC_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_TEB_n, ONLY : TEB_t
+USE MODD_BEM_n, ONLY : BEM_t
!
USE MODI_CONVERT_PATCH_TEB
USE MODI_WINDOW_DATA
@@ -62,11 +67,15 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM
+TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+TYPE(BEM_OPTIONS_t), INTENT(INOUT) :: BOP
+TYPE(DATA_TEB_t), INTENT(INOUT) :: DTT
+TYPE(DATA_BEM_t), INTENT(INOUT) :: DTB
+TYPE(BLD_DESC_t), INTENT(INOUT) :: BDD
+TYPE(GRID_t), INTENT(INOUT) :: G
+TYPE(TEB_t), INTENT(INOUT) :: T
+TYPE(BEM_t), INTENT(INOUT) :: B
!
INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
!
@@ -89,146 +98,125 @@ IF (LHOOK) CALL DR_HOOK('INIT_BEM_N',0,ZHOOK_HANDLE)
!* 3. Physiographic data fields from land cover:
! -----------------------------------------
!
-ILU = SIZE(TM%TOP%XCOVER,1)
-IF (TM%TOP%CBEM=='DEF') ILU=0
-!
-ALLOCATE(TM%B%CUR%XHC_FLOOR (ILU,TM%BOP%NFLOOR_LAYER))
-ALLOCATE(TM%B%CUR%XTC_FLOOR (ILU,TM%BOP%NFLOOR_LAYER))
-ALLOCATE(TM%B%CUR%XD_FLOOR (ILU,TM%BOP%NFLOOR_LAYER))
-!
-ALLOCATE(TM%B%CUR%XTCOOL_TARGET(ILU))
-ALLOCATE(TM%B%CUR%XTHEAT_TARGET(ILU))
-ALLOCATE(TM%B%CUR%XEFF_HEAT (ILU))
-ALLOCATE(TM%B%CUR%XSHGC (ILU))
-ALLOCATE(TM%B%CUR%XQIN (ILU))
-ALLOCATE(TM%B%CUR%XQIN_FRAD (ILU))
-ALLOCATE(TM%B%CUR%XSHGC_SH (ILU))
-ALLOCATE(TM%B%CUR%XU_WIN (ILU))
-ALLOCATE(TM%B%CUR%XTRAN_WIN (ILU))
-ALLOCATE(TM%B%CUR%XFLOOR_HEIGHT(ILU))
-ALLOCATE(TM%B%CUR%XINF (ILU))
-!
-ALLOCATE(TM%B%CUR%XQIN_FLAT (ILU))
-ALLOCATE(TM%B%CUR%XHR_TARGET (ILU))
-ALLOCATE(TM%B%CUR%XV_VENT (ILU))
-ALLOCATE(TM%B%CUR%XCAP_SYS_HEAT(ILU))
-ALLOCATE(TM%B%CUR%XCAP_SYS_RAT (ILU))
-ALLOCATE(TM%B%CUR%XT_ADP (ILU))
-ALLOCATE(TM%B%CUR%XM_SYS_RAT (ILU))
-ALLOCATE(TM%B%CUR%XCOP_RAT (ILU))
-ALLOCATE(TM%B%CUR%XT_SIZE_MAX (ILU))
-ALLOCATE(TM%B%CUR%XT_SIZE_MIN (ILU))
-ALLOCATE(TM%B%CUR%XF_WATER_COND(ILU))
-ALLOCATE(TM%B%CUR%CNATVENT (ILU))
-ALLOCATE(TM%B%CUR%XNATVENT (ILU))
-!
-ALLOCATE(TM%B%CUR%XABS_WIN (ILU))
-ALLOCATE(TM%B%CUR%XUGG_WIN (ILU))
-ALLOCATE(TM%B%CUR%LSHADE (ILU))
-ALLOCATE(TM%B%CUR%XSHADE (ILU))
-ALLOCATE(TM%B%CUR%LSHAD_DAY(ILU))
-ALLOCATE(TM%B%CUR%LNATVENT_NIGHT(ILU))
-ALLOCATE(TM%B%CUR%XAUX_MAX (ILU))
-ALLOCATE(TM%B%CUR%XN_FLOOR(ILU))
-ALLOCATE(TM%B%CUR%XGLAZ_O_BLD(ILU))
-ALLOCATE(TM%B%CUR%XMASS_O_BLD(ILU))
-ALLOCATE(TM%B%CUR%XFLOOR_HW_RATIO(ILU))
-ALLOCATE(TM%B%CUR%XF_FLOOR_MASS(ILU))
-ALLOCATE(TM%B%CUR%XF_FLOOR_WALL(ILU))
-ALLOCATE(TM%B%CUR%XF_FLOOR_WIN(ILU))
-ALLOCATE(TM%B%CUR%XF_FLOOR_ROOF(ILU))
-ALLOCATE(TM%B%CUR%XF_WALL_FLOOR(ILU))
-ALLOCATE(TM%B%CUR%XF_WALL_MASS(ILU))
-ALLOCATE(TM%B%CUR%XF_WALL_WIN(ILU))
-ALLOCATE(TM%B%CUR%XF_WIN_FLOOR(ILU))
-ALLOCATE(TM%B%CUR%XF_WIN_MASS(ILU))
-ALLOCATE(TM%B%CUR%XF_WIN_WALL(ILU))
-ALLOCATE(TM%B%CUR%XF_WIN_WIN(ILU))
-ALLOCATE(TM%B%CUR%XF_MASS_FLOOR(ILU))
-ALLOCATE(TM%B%CUR%XF_MASS_WALL(ILU))
-ALLOCATE(TM%B%CUR%XF_MASS_WIN(ILU))
+ILU = SIZE(TOP%XCOVER,1)
+IF (TOP%CBEM=='DEF') ILU=0
+!
+ALLOCATE(B%XHC_FLOOR (ILU,BOP%NFLOOR_LAYER))
+ALLOCATE(B%XTC_FLOOR (ILU,BOP%NFLOOR_LAYER))
+ALLOCATE(B%XD_FLOOR (ILU,BOP%NFLOOR_LAYER))
+!
+ALLOCATE(B%XTCOOL_TARGET(ILU))
+ALLOCATE(B%XTHEAT_TARGET(ILU))
+ALLOCATE(B%XEFF_HEAT (ILU))
+ALLOCATE(B%XSHGC (ILU))
+ALLOCATE(B%XQIN (ILU))
+ALLOCATE(B%XQIN_FRAD (ILU))
+ALLOCATE(B%XSHGC_SH (ILU))
+ALLOCATE(B%XU_WIN (ILU))
+ALLOCATE(B%XTRAN_WIN (ILU))
+ALLOCATE(B%XFLOOR_HEIGHT(ILU))
+ALLOCATE(B%XINF (ILU))
+!
+ALLOCATE(B%XQIN_FLAT (ILU))
+ALLOCATE(B%XHR_TARGET (ILU))
+ALLOCATE(B%XV_VENT (ILU))
+ALLOCATE(B%XCAP_SYS_HEAT(ILU))
+ALLOCATE(B%XCAP_SYS_RAT (ILU))
+ALLOCATE(B%XT_ADP (ILU))
+ALLOCATE(B%XM_SYS_RAT (ILU))
+ALLOCATE(B%XCOP_RAT (ILU))
+ALLOCATE(B%XT_SIZE_MAX (ILU))
+ALLOCATE(B%XT_SIZE_MIN (ILU))
+ALLOCATE(B%XF_WATER_COND(ILU))
+ALLOCATE(B%CNATVENT (ILU))
+ALLOCATE(B%XNATVENT (ILU))
+!
+ALLOCATE(B%XABS_WIN (ILU))
+ALLOCATE(B%XUGG_WIN (ILU))
+ALLOCATE(B%LSHADE (ILU))
+ALLOCATE(B%XSHADE (ILU))
+ALLOCATE(B%LSHAD_DAY(ILU))
+ALLOCATE(B%LNATVENT_NIGHT(ILU))
+ALLOCATE(B%XAUX_MAX (ILU))
+ALLOCATE(B%XN_FLOOR(ILU))
+ALLOCATE(B%XGLAZ_O_BLD(ILU))
+ALLOCATE(B%XMASS_O_BLD(ILU))
+ALLOCATE(B%XFLOOR_HW_RATIO(ILU))
+ALLOCATE(B%XF_FLOOR_MASS(ILU))
+ALLOCATE(B%XF_FLOOR_WALL(ILU))
+ALLOCATE(B%XF_FLOOR_WIN(ILU))
+ALLOCATE(B%XF_FLOOR_ROOF(ILU))
+ALLOCATE(B%XF_WALL_FLOOR(ILU))
+ALLOCATE(B%XF_WALL_MASS(ILU))
+ALLOCATE(B%XF_WALL_WIN(ILU))
+ALLOCATE(B%XF_WIN_FLOOR(ILU))
+ALLOCATE(B%XF_WIN_MASS(ILU))
+ALLOCATE(B%XF_WIN_WALL(ILU))
+ALLOCATE(B%XF_WIN_WIN(ILU))
+ALLOCATE(B%XF_MASS_FLOOR(ILU))
+ALLOCATE(B%XF_MASS_WALL(ILU))
+ALLOCATE(B%XF_MASS_WIN(ILU))
-SELECT CASE(TM%TOP%CBEM)
+SELECT CASE(TOP%CBEM)
!----------
- CASE("DEF")
+CASE("DEF")
!-----------
!parameters that needs to be 0 for calculation
- TM%B%CUR%XGR (:) = 0.
- TM%B%CUR%XF_WASTE_CAN(:) = 0.
+ B%XGR (:) = 0.
+ B%XF_WASTE_CAN(:) = 0.
!----------
- CASE("BEM")
+CASE("BEM")
!----------
- TM%B%CUR%XAUX_MAX(:) = 5.
- CALL CONVERT_PATCH_TEB(TM%BDD, TM%DTB, DTCO, TM%DTT, TM%TOP, &
- TM%TOP%XCOVER,TM%TOP%LCOVER,0., &
- PHC_FLOOR=TM%B%CUR%XHC_FLOOR, PTC_FLOOR=TM%B%CUR%XTC_FLOOR, &
- PD_FLOOR=TM%B%CUR%XD_FLOOR, PTCOOL_TARGET=TM%B%CUR%XTCOOL_TARGET, &
- PTHEAT_TARGET=TM%B%CUR%XTHEAT_TARGET, PF_WASTE_CAN=TM%B%CUR%XF_WASTE_CAN, &
- PEFF_HEAT=TM%B%CUR%XEFF_HEAT, PQIN=TM%B%CUR%XQIN, PQIN_FRAD=TM%B%CUR%XQIN_FRAD, &
- PSHGC=TM%B%CUR%XSHGC, PU_WIN=TM%B%CUR%XU_WIN, PGR=TM%B%CUR%XGR, &
- PSHGC_SH=TM%B%CUR%XSHGC_SH, PFLOOR_HEIGHT=TM%B%CUR%XFLOOR_HEIGHT, &
- PINF=TM%B%CUR%XINF, PF_WATER_COND=TM%B%CUR%XF_WATER_COND, &
- PQIN_FLAT=TM%B%CUR%XQIN_FLAT, PHR_TARGET=TM%B%CUR%XHR_TARGET, &
- PV_VENT=TM%B%CUR%XV_VENT, PCAP_SYS_HEAT=TM%B%CUR%XCAP_SYS_HEAT, &
- PCAP_SYS_RAT=TM%B%CUR%XCAP_SYS_RAT, PT_ADP=TM%B%CUR%XT_ADP, &
- PM_SYS_RAT=TM%B%CUR%XM_SYS_RAT, PCOP_RAT=TM%B%CUR%XCOP_RAT, &
- PT_SIZE_MAX=TM%B%CUR%XT_SIZE_MAX, PT_SIZE_MIN=TM%B%CUR%XT_SIZE_MIN, &
- PSHADE=TM%B%CUR%XSHADE, PNATVENT=TM%B%CUR%XNATVENT)
+ B%XAUX_MAX(:) = 5.
+ CALL CONVERT_PATCH_TEB(BDD, DTB, DTCO, DTT, TOP, 0., B = B )
!
!
! *. indoor relative surf. and view factors
! --------------------------------------
!
- CALL BEM_MORPHO(TM%T%CUR%XBLD, TM%T%CUR%XWALL_O_HOR, TM%T%CUR%XBLD_HEIGHT, &
- TM%B%CUR%XFLOOR_HEIGHT, TM%B%CUR%XGR, TM%B%CUR%XN_FLOOR, TM%T%CUR%XWALL_O_BLD, &
- TM%B%CUR%XGLAZ_O_BLD, TM%B%CUR%XMASS_O_BLD, TM%B%CUR%XFLOOR_HW_RATIO, &
- TM%B%CUR%XF_FLOOR_MASS, TM%B%CUR%XF_FLOOR_WALL, TM%B%CUR%XF_FLOOR_WIN, &
- TM%B%CUR%XF_FLOOR_ROOF, TM%B%CUR%XF_WALL_FLOOR, TM%B%CUR%XF_WALL_MASS, &
- TM%B%CUR%XF_WALL_WIN, TM%B%CUR%XF_WIN_FLOOR, TM%B%CUR%XF_WIN_MASS, &
- TM%B%CUR%XF_WIN_WALL, TM%B%CUR%XF_MASS_FLOOR, TM%B%CUR%XF_MASS_WALL, &
- TM%B%CUR%XF_MASS_WIN, TM%B%CUR%XF_WASTE_CAN, TM%B%CUR%XF_WIN_WIN )
+ CALL BEM_MORPHO(T%XBLD, T%XWALL_O_HOR, T%XBLD_HEIGHT, &
+ T%XWALL_O_BLD, B )
!
! *. Window optical and thermal data
! -------------------------------
!
- CALL WINDOW_DATA(ILU, TM%B%CUR%XSHGC, TM%B%CUR%XU_WIN, TM%B%CUR%XALB_WIN, &
- TM%B%CUR%XABS_WIN, TM%B%CUR%XUGG_WIN, TM%B%CUR%XTRAN_WIN)
+ CALL WINDOW_DATA(ILU, B )
GPRINT = .FALSE.
- DO JJ=1,SIZE(TM%B%CUR%XSHADE)
- IF (TM%B%CUR%XSHADE(JJ) >= 0.0 .AND. TM%B%CUR%XSHADE(JJ) < 0.5) THEN
- TM%B%CUR%LSHADE(JJ) = .FALSE.
- ELSEIF (TM%B%CUR%XSHADE(JJ) >= 0.5 .AND. TM%B%CUR%XSHADE(JJ) <= 1.0) THEN
- TM%B%CUR%LSHADE(JJ) = .TRUE.
+ DO JJ=1,SIZE(B%XSHADE)
+ IF (B%XSHADE(JJ) >= 0.0 .AND. B%XSHADE(JJ) < 0.5) THEN
+ B%LSHADE(JJ) = .FALSE.
+ ELSEIF (B%XSHADE(JJ) >= 0.5 .AND. B%XSHADE(JJ) <= 1.0) THEN
+ B%LSHADE(JJ) = .TRUE.
ELSE
GPRINT = .TRUE.
- TM%B%CUR%LSHADE(JJ) = .FALSE.
+ B%LSHADE(JJ) = .FALSE.
ENDIF
ENDDO
IF (GPRINT) WRITE(KLUOUT,*) &
'TEB-BEM : Error in specifying shading devices for at least one point, no shading device for these points'
- TM%B%CUR%LSHAD_DAY(:) = .FALSE.
+ B%LSHAD_DAY(:) = .FALSE.
!
! *. Nocturnal surventilation
! ------------------------
GPRINT = .FALSE.
- DO JJ=1,SIZE(TM%B%CUR%XNATVENT)
- IF (TM%B%CUR%XNATVENT(JJ) >= 0.0 .AND. TM%B%CUR%XNATVENT(JJ) < 0.5) THEN
- TM%B%CUR%CNATVENT(JJ) = 'NONE'
- ELSEIF (TM%B%CUR%XNATVENT(JJ) >= 0.5 .AND. TM%B%CUR%XNATVENT(JJ) < 1.5) THEN
- TM%B%CUR%CNATVENT(JJ) = 'MANU'
- ELSEIF (TM%B%CUR%XNATVENT(JJ) >= 1.5 .AND. TM%B%CUR%XNATVENT(JJ) <= 2.5) THEN
- TM%B%CUR%CNATVENT(JJ) = 'AUTO'
- ELSEIF (TM%B%CUR%XNATVENT(JJ) >= 2.5 .AND. TM%B%CUR%XNATVENT(JJ) <= 3.5) THEN
- TM%B%CUR%CNATVENT(JJ) = 'MECH'
+ DO JJ=1,SIZE(B%XNATVENT)
+ IF (B%XNATVENT(JJ) >= 0.0 .AND. B%XNATVENT(JJ) < 0.5) THEN
+ B%CNATVENT(JJ) = 'NONE'
+ ELSEIF (B%XNATVENT(JJ) >= 0.5 .AND. B%XNATVENT(JJ) < 1.5) THEN
+ B%CNATVENT(JJ) = 'MANU'
+ ELSEIF (B%XNATVENT(JJ) >= 1.5 .AND. B%XNATVENT(JJ) <= 2.5) THEN
+ B%CNATVENT(JJ) = 'AUTO'
+ ELSEIF (B%XNATVENT(JJ) >= 2.5 .AND. B%XNATVENT(JJ) <= 3.5) THEN
+ B%CNATVENT(JJ) = 'MECH'
ELSE
GPRINT = .TRUE.
- TM%B%CUR%CNATVENT(JJ) = 'NONE'
+ B%CNATVENT(JJ) = 'NONE'
ENDIF
ENDDO
IF (GPRINT) WRITE(KLUOUT,*) 'TEB-BEM : Chosen option for surventilation is not yet implemented; None venting is kept instead'
- TM%B%CUR%LNATVENT_NIGHT(:) = .FALSE.
+ B%LNATVENT_NIGHT(:) = .FALSE.
!
END SELECT
!
@@ -236,12 +224,11 @@ END SELECT
!
!* 8. Building HVAC automatic sizing:
! -------------------------------
-IF (TM%TOP%CBEM=='BEM' .AND. TM%BOP%LAUTOSIZE) THEN
- CALL HVAC_AUTOSIZE(TM%BDD, DTCO, DGU, TM%B, TM%BOP, UG, U, TM%TG, TM%T, TM%TOP, &
- ILU,KLUOUT)
+IF (TOP%CBEM=='BEM' .AND. BOP%LAUTOSIZE) THEN
+ CALL HVAC_AUTOSIZE(B, BOP, G, T, TOP, ILU,KLUOUT)
!* stores the real systems characteristics in physiographic data
! for further use
- CALL STORES_HVAC_AUTOSIZE(TM%B, TM%BOP, TM%DTB)
+ CALL STORES_HVAC_AUTOSIZE(B, BOP, DTB)
ENDIF
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/init_chemicaln.F90 b/src/SURFEX/init_chemicaln.F90
index 58e6a426689f8399838099cbbe64c03dcaa905bc..65351532505f0165568cc7f6c27847cfd487770e 100644
--- a/src/SURFEX/init_chemicaln.F90
+++ b/src/SURFEX/init_chemicaln.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#############################################################
-SUBROUTINE INIT_CHEMICAL_n(KLUOUT, KSV, HSV, YSV, HCH_NAMES, HAER_NAMES, &
+SUBROUTINE INIT_CHEMICAL_n(KLUOUT, KSV, HSV, SV, HCH_NAMES, HAER_NAMES, &
HDSTNAMES, HSLTNAMES )
!#############################################################
!
@@ -60,7 +60,7 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KLUOUT
INTEGER, INTENT(IN) :: KSV ! number of scalars
CHARACTER(LEN=6), DIMENSION(KSV), INTENT(IN) :: HSV ! name of all scalar variables
- TYPE(SV_t), INTENT(INOUT) :: YSV
+ TYPE(SV_t), INTENT(INOUT) :: SV
CHARACTER(LEN=6), DIMENSION(:), POINTER :: HCH_NAMES
CHARACTER(LEN=6), DIMENSION(:), POINTER :: HAER_NAMES
@@ -81,22 +81,19 @@ IF (LHOOK) CALL DR_HOOK('INIT_CHEMICAL_n',0,ZHOOK_HANDLE)
!
IF (KSV /= 0) THEN
!
- ALLOCATE(YSV%CSV(KSV))
- CALL CH_INIT_NAMES(KLUOUT, HSV, YSV%NBEQ, YSV%NAEREQ, YSV%CSV, &
- YSV%NSV_CHSBEG, YSV%NSV_CHSEND, &
- YSV%NSV_AERBEG, YSV%NSV_AEREND, &
- LVARSIGI, LVARSIGJ )
+ ALLOCATE(SV%CSV(KSV))
+ CALL CH_INIT_NAMES(KLUOUT, HSV, SV, LVARSIGI, LVARSIGJ )
- IF (YSV%NBEQ > 0 ) THEN
- ALLOCATE(HCH_NAMES(YSV%NBEQ))
- HCH_NAMES(:) = YSV%CSV(YSV%NSV_CHSBEG:YSV%NSV_CHSEND)
+ IF (SV%NBEQ > 0 ) THEN
+ ALLOCATE(HCH_NAMES(SV%NBEQ))
+ HCH_NAMES(:) = SV%CSV(SV%NSV_CHSBEG:SV%NSV_CHSEND)
ELSE
ALLOCATE(HCH_NAMES(0))
END IF
- IF (YSV%NAEREQ > 0 ) THEN
- ALLOCATE(HAER_NAMES(YSV%NAEREQ))
- HAER_NAMES(:) = YSV%CSV(YSV%NSV_AERBEG:YSV%NSV_AEREND)
+ IF (SV%NAEREQ > 0 ) THEN
+ ALLOCATE(HAER_NAMES(SV%NAEREQ))
+ HAER_NAMES(:) = SV%CSV(SV%NSV_AERBEG:SV%NSV_AEREND)
ELSE
ALLOCATE(HAER_NAMES(0))
END IF
@@ -106,27 +103,27 @@ IF (KSV /= 0) THEN
'DSTM', &
HSV, &!I [char] list of scalar variables
JPMODE_DST, &
- YSV%NDSTEQ, &!O [nbr] number of dust related tracers
- YSV%NSV_DSTBEG, &!O [idx] first dust related scalar variable
- YSV%NSV_DSTEND, &!O [idx] last dust related scalar variable
+ SV%NDSTEQ, &!O [nbr] number of dust related tracers
+ SV%NSV_DSTBEG, &!O [idx] first dust related scalar variable
+ SV%NSV_DSTEND, &!O [idx] last dust related scalar variable
LVARSIG_DST, &!O type of standard deviation (fixed or variable)
LRGFIX_DST &!O type of mean radius (fixed or variable)
)
IF (PRESENT(HDSTNAMES)) THEN
- IF (YSV%NDSTEQ >=1) THEN
+ IF (SV%NDSTEQ >=1) THEN
CALL DSLT_INIT_MODES( &
- YSV%NDSTEQ, &!I [nbr] number of dust related variables in scalar list
- YSV%NSV_DSTBEG, &!I [idx] index of first dust related variable in scalar list
- YSV%NSV_DSTEND, &!I [idx] index of last dust related variable in scalar list
+ SV%NDSTEQ, &!I [nbr] number of dust related variables in scalar list
+ SV%NSV_DSTBEG, &!I [idx] index of first dust related variable in scalar list
+ SV%NSV_DSTEND, &!I [idx] index of last dust related variable in scalar list
LVARSIG_DST, &!I type of standard deviation (fixed or variable)
LRGFIX_DST, &!O type of mean radius (fixed or variable)
NDST_MDEBEG, &!O [idx] index of mass for first mode in scalar list
NDSTMDE &!O [nbr] number of modes to be transported
)
- IF(.NOT. ASSOCIATED(HDSTNAMES)) ALLOCATE (HDSTNAMES(YSV%NDSTEQ))
- HDSTNAMES(:) = YSV%CSV(YSV%NSV_DSTBEG:YSV%NSV_DSTEND)
+ IF(.NOT. ASSOCIATED(HDSTNAMES)) ALLOCATE (HDSTNAMES(SV%NDSTEQ))
+ HDSTNAMES(:) = SV%CSV(SV%NSV_DSTBEG:SV%NSV_DSTEND)
ENDIF
ENDIF
@@ -136,31 +133,31 @@ IF (KSV /= 0) THEN
'SLTM', &
HSV, &!I [char] list of scalar variables
JPMODE_SLT, &
- YSV%NSLTEQ, &!O [nbr] number of sea salt related tracers
- YSV%NSV_SLTBEG, &!O [idx] first sea salt related scalar variable
- YSV%NSV_SLTEND, &!O [idx] last sea salt related scalar variable
+ SV%NSLTEQ, &!O [nbr] number of sea salt related tracers
+ SV%NSV_SLTBEG, &!O [idx] first sea salt related scalar variable
+ SV%NSV_SLTEND, &!O [idx] last sea salt related scalar variable
LVARSIG_SLT, &!O type of standard deviation (fixed or variable)
LRGFIX_SLT &!O type of mean radius (fixed or variable)
)
IF (PRESENT(HSLTNAMES)) THEN
- IF (YSV%NSLTEQ >=1) THEN
+ IF (SV%NSLTEQ >=1) THEN
CALL DSLT_INIT_MODES( &
- YSV%NSLTEQ, &!I [nbr] number of sea salt related variables in scalar list
- YSV%NSV_SLTBEG, &!I [idx] index of first sea salt related variable in scalar list
- YSV%NSV_SLTEND, &!I [idx] index of last sea salt related variable in scalar list
+ SV%NSLTEQ, &!I [nbr] number of sea salt related variables in scalar list
+ SV%NSV_SLTBEG, &!I [idx] index of first sea salt related variable in scalar list
+ SV%NSV_SLTEND, &!I [idx] index of last sea salt related variable in scalar list
LVARSIG_SLT, &!I type of standard deviation (fixed or variable)
LRGFIX_SLT, &!O type of mean radius (fixed or variable)
NSLT_MDEBEG, &!O [idx] index of mass for first mode in scalar list
NSLTMDE &!O [nbr] number of modes to be transported
)
- IF(.NOT. ASSOCIATED(HSLTNAMES)) ALLOCATE (HSLTNAMES(YSV%NSLTEQ))
- HSLTNAMES(:) = YSV%CSV(YSV%NSV_SLTBEG:YSV%NSV_SLTEND)
+ IF(.NOT. ASSOCIATED(HSLTNAMES)) ALLOCATE (HSLTNAMES(SV%NSLTEQ))
+ HSLTNAMES(:) = SV%CSV(SV%NSV_SLTBEG:SV%NSV_SLTEND)
ENDIF
END IF
ELSE
- ALLOCATE(YSV%CSV (0))
+ ALLOCATE(SV%CSV (0))
IF (PRESENT(HDSTNAMES)) ALLOCATE(HDSTNAMES(0))
IF (PRESENT(HSLTNAMES)) ALLOCATE(HSLTNAMES(0))
ENDIF
diff --git a/src/SURFEX/init_cpl_gcmn.F90 b/src/SURFEX/init_cpl_gcmn.F90
index 91f4c9636ccb430bf79d6b9cdfa4621ea47616b7..c770dcedd204ca7d3ca5f606ca6c46574c5b4d34 100644
--- a/src/SURFEX/init_cpl_gcmn.F90
+++ b/src/SURFEX/init_cpl_gcmn.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE INIT_CPL_GCM_n (&
- U, &
- HPROGRAM,HINIT)
+ SUBROUTINE INIT_CPL_GCM_n (U, HPROGRAM,HINIT)
! ########################################
!
!!**** *INIT_CPL_GCM_n* - routine to read physical fields into
@@ -80,7 +78,7 @@ TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
INTEGER :: IRESP ! Error code after redding
!
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
!
INTEGER :: IVERSION ! surface version
!
@@ -119,38 +117,31 @@ ELSE
ENDIF
!
YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
+CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
!
LREAD=(HINIT/='PGD'.AND.HINIT/='PRE'.AND.IVERSION>=8)
!
IF (LREAD) THEN
YRECFM='LCPL_GCM'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,GCPL_GCM,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,GCPL_GCM,IRESP)
ENDIF
!
IF (LREAD.AND.GCPL_GCM) THEN
!
YRECFM='RAIN_GCM'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,U%XRAIN(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,U%XRAIN(:),IRESP)
!
YRECFM='SNOW_GCM'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,U%XSNOW(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,U%XSNOW(:),IRESP)
!
YRECFM='Z0_GCM'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,U%XZ0(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,U%XZ0(:),IRESP)
!
YRECFM='Z0H_GCM'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,U%XZ0H(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,U%XZ0H(:),IRESP)
!
YRECFM='QS_GCM'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,U%XQSURF(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,U%XQSURF(:),IRESP)
!
ENDIF
!
diff --git a/src/SURFEX/init_dst.F90 b/src/SURFEX/init_dst.F90
index 252687f148c6512d85fa3811e744aa3d7c5a2aba..2026311e2590dd0e16b0280d3a0437343ff43de8 100644
--- a/src/SURFEX/init_dst.F90
+++ b/src/SURFEX/init_dst.F90
@@ -2,11 +2,10 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
-SUBROUTINE INIT_DST (DST, U, &
+SUBROUTINE INIT_DST (DSTK, U, &
HPROGRAM, & ! Program calling unit
- KSIZE_NATURE_P, & ! Number of nature points in a patch
- KR_NATURE_P, & ! Mask from patch --> nature vectors
- KPATCH, & ! Maximum number of patches
+ KSIZE_P, & ! Number of nature points in a patch
+ KR_P, & ! Mask from patch --> nature vectors
PVEGTYPE_PATCH ) ! fraction (in a nature point) of a vegtype for a patch
!
@@ -27,15 +26,14 @@ IMPLICIT NONE
!
!PASSED VARIABLES
!
-TYPE(DST_t), INTENT(INOUT) :: DST
+TYPE(DST_t), INTENT(INOUT) :: DSTK
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !Passing unit
!
-INTEGER, DIMENSION(:), POINTER :: KSIZE_NATURE_P
-INTEGER, DIMENSION(:,:), POINTER :: KR_NATURE_P
-INTEGER, INTENT(IN) :: KPATCH
-REAL, DIMENSION(:,:,:), POINTER :: PVEGTYPE_PATCH
+INTEGER, INTENT(IN) :: KSIZE_P
+INTEGER, DIMENSION(:), INTENT(IN) :: KR_P
+REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE_PATCH
!
!LOCAL VARIABLES
CHARACTER(LEN=4) :: CRGUNIT ! type of log-normal geometric mean radius
@@ -53,9 +51,9 @@ IF (LHOOK) CALL DR_HOOK('INIT_DST',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
!Allocate memory for the real values which will be used by the model
-ALLOCATE(DST%XEMISRADIUS_DST(NDSTMDE))
-ALLOCATE(DST%XEMISSIG_DST (NDSTMDE))
-ALLOCATE(DST%XMSS_FRC_SRC (NDSTMDE))
+ALLOCATE(DSTK%XEMISRADIUS_DST(NDSTMDE))
+ALLOCATE(DSTK%XEMISSIG_DST (NDSTMDE))
+ALLOCATE(DSTK%XMSS_FRC_SRC (NDSTMDE))
!
!Get initial size distributions. This is cut and pasted
!from dead routine dstpsd.F90
@@ -106,19 +104,19 @@ ENDIF
DO JMODE=1,NDSTMDE
JMODE_IDX=JORDER_DST(JMODE)
!
- DST%XEMISSIG_DST (JMODE) = XEMISSIG_INI_DST(JMODE_IDX)
- DST%XEMISRADIUS_DST(JMODE) = XEMISRADIUS_INI_DST(JMODE_IDX)
- DST%XMSS_FRC_SRC (JMODE) = XMSS_FRC_SRC_INI(JMODE_IDX)
+ DSTK%XEMISSIG_DST (JMODE) = XEMISSIG_INI_DST(JMODE_IDX)
+ DSTK%XEMISRADIUS_DST(JMODE) = XEMISRADIUS_INI_DST(JMODE_IDX)
+ DSTK%XMSS_FRC_SRC (JMODE) = XMSS_FRC_SRC_INI(JMODE_IDX)
!
!Get emisradius, and at the same time convert to number median radius
IF (CRGUNIT=='MASS') &
- DST%XEMISRADIUS_DST(JMODE) = DST%XEMISRADIUS_DST(JMODE) * EXP(-3.d0 * (LOG(DST%XEMISSIG_DST(JMODE)))**2)
+ DSTK%XEMISRADIUS_DST(JMODE) = DSTK%XEMISRADIUS_DST(JMODE) * EXP(-3.d0 * (LOG(DSTK%XEMISSIG_DST(JMODE)))**2)
!
ENDDO
!
!Normalize the sum of the emissions to 1 so that all dust is
!put in one mode or the other
-IF(SUM(DST%XMSS_FRC_SRC(:)).LT.1.) DST%XMSS_FRC_SRC(:) = DST%XMSS_FRC_SRC(:) / SUM(DST%XMSS_FRC_SRC(:))
+IF(SUM(DSTK%XMSS_FRC_SRC(:)).LT.1.) DSTK%XMSS_FRC_SRC(:) = DSTK%XMSS_FRC_SRC(:) / SUM(DSTK%XMSS_FRC_SRC(:))
!
!Allocate memory
!ALLOCATE(NVEGNO_DST)
@@ -126,76 +124,64 @@ IF(SUM(DST%XMSS_FRC_SRC(:)).LT.1.) DST%XMSS_FRC_SRC(:) = DST%XMSS_FRC_SRC(:) / S
NVEGNO_DST = 2
!
!Allocate memory for the vegtype-translator
-ALLOCATE(DST%NVT_DST(NVEGNO_DST))
+ALLOCATE(DSTK%NVT_DST(NVEGNO_DST))
!
!Set the dust/vegtype translator vector
-DST%NVT_DST(1) = NVT_NO
-DST%NVT_DST(2) = NVT_ROCK
+DSTK%NVT_DST(1) = NVT_NO
+DSTK%NVT_DST(2) = NVT_ROCK
!
!Allocate memory for roughness lengths of erodible surfaces
-ALLOCATE(DST%Z0_EROD_DST(NVEGNO_DST))
+ALLOCATE(DSTK%Z0_EROD_DST(NVEGNO_DST))
!
!Set the roughness lengths corresponding to erodible surfaces
!Smooth roughness length is given to 1.d-5 (dstmbl.f90)
-DST%Z0_EROD_DST(1) = 30.d-6 !m (30 um)
-DST%Z0_EROD_DST(2) = 200.d-6 !m (200 um)
+DSTK%Z0_EROD_DST(1) = 30.d-6 !m (30 um)
+DSTK%Z0_EROD_DST(2) = 200.d-6 !m (200 um)
!
!Allocate memory for dust emitter surface vectors in patch vectors
-IF (.NOT.ASSOCIATED(DST%NSIZE_PATCH_DST)) ALLOCATE(DST%NSIZE_PATCH_DST(NVEGNO_DST,KPATCH))
+IF (.NOT.ASSOCIATED(DSTK%NSIZE_PATCH_DST)) ALLOCATE(DSTK%NSIZE_PATCH_DST(NVEGNO_DST))
!
-DO JPATCH = 1,KPATCH
- DO JVEG = 1,NVEGNO_DST
- !Count all the points in the patch where you have dust emitter vegetation
- DST%NSIZE_PATCH_DST(JVEG,JPATCH) = COUNT(PVEGTYPE_PATCH(:,DST%NVT_DST(JVEG),JPATCH) > 0.)
- ENDDO
+DO JVEG = 1,NVEGNO_DST
+ !Count all the points in the patch where you have dust emitter vegetation
+ DSTK%NSIZE_PATCH_DST(JVEG) = COUNT(PVEGTYPE_PATCH(:,DSTK%NVT_DST(JVEG)) > 0.)
ENDDO
!
!Find the largest dust emitter vector in any patch
!ALLOCATE (NSIZE_LARGEST_DST)
ISIZE_LARGEST_DST = 0
-DO JPATCH=1,KPATCH
- DO JVEG = 1,NVEGNO_DST
- ISIZE_LARGEST_DST = max(ISIZE_LARGEST_DST,DST%NSIZE_PATCH_DST(JVEG,JPATCH))
- ENDDO
+DO JVEG = 1,NVEGNO_DST
+ ISIZE_LARGEST_DST = max(ISIZE_LARGEST_DST,DSTK%NSIZE_PATCH_DST(JVEG))
ENDDO
!
-!Allocate memory for NR_PATCH_DST mask translate from patch vector to dust vector
-ALLOCATE(DST%NR_PATCH_DST(ISIZE_LARGEST_DST,NVEGNO_DST,KPATCH))
+!Allocate memory for KR_PATCH_DST mask translate from patch vector to dust vector
+ALLOCATE(DSTK%NR_PATCH_DST(ISIZE_LARGEST_DST,NVEGNO_DST))
!
!Initialize the mask array
-DST%NR_PATCH_DST(:,:,:)=0
+DSTK%NR_PATCH_DST(:,:)=0
!
!Get values from the dust emitter vegetation mask
-DO JPATCH=1,KPATCH
- DO JVEG=1,NVEGNO_DST
- JVEG_IN = DST%NVT_DST(JVEG) ! Get the real vegtype index
+DO JVEG=1,NVEGNO_DST
+ JVEG_IN = DSTK%NVT_DST(JVEG) ! Get the real vegtype index
#ifdef RJ_OFIX
- CALL GET_VEGTYPE_2_PATCH_MASK(ILUOUT, &
- DST%NSIZE_PATCH_DST(JVEG,JPATCH), &!I Size of dust emitter vector
- KSIZE_NATURE_P(JPATCH), &!I Size of patch vector
- U%NSIZE_NATURE, &!I Size of nature vector
+ CALL GET_VEGTYPE_2_PATCH_MASK(ILUOUT, &
+ DSTK%NSIZE_PATCH_DST(JVEG), &!I Size of dust emitter vector
+ KSIZE_P, &!I Size of patch vector
!RJ: attempt to make this call generic
- KR_NATURE_P(:KSIZE_NATURE_P(JPATCH),JPATCH),&!I Mask from patch to nature
- PVEGTYPE_PATCH, &!I Fraction of vegtype of nature point within jpatch
- DST%NR_PATCH_DST(:DST%NSIZE_PATCH_DST(JVEG,JPATCH),JVEG,JPATCH), &!O Part of mask array to fill with values
- KPATCH, &!I Number of possible patches
- JPATCH, &!I Index of patch in question
- JVEG_IN &!I Index of vegtype in question
+ KR_P,&!I Mask from patch to nature
+ PVEGTYPE_PATCH, &!I Fraction of vegtype of nature point within jpatch
+ DSTK%NR_PATCH_DST(:DSTK%NSIZE_PATCH_DST(JVEG),JVEG), &!O Part of mask array to fill with values
+ JVEG_IN &!I Index of vegtype in question
)
#else
- CALL GET_VEGTYPE_2_PATCH_MASK(ILUOUT, &
- DST%NSIZE_PATCH_DST(JVEG,JPATCH), &!I Size of dust emitter vector
- KSIZE_NATURE_P(JPATCH), &!I Size of patch vector
- U%NSIZE_NATURE, &!I Size of nature vector
- KR_NATURE_P, &!I Mask from patch to nature
- PVEGTYPE_PATCH, &!I Fraction of vegtype of nature point within jpatch
- DST%NR_PATCH_DST(:DST%NSIZE_PATCH_DST(JVEG,JPATCH),JVEG,JPATCH), &!O Part of mask array to fill with values
- KPATCH, &!I Number of possible patches
- JPATCH, &!I Index of patch in question
- JVEG_IN &!I Index of vegtype in question
+ CALL GET_VEGTYPE_2_PATCH_MASK(ILUOUT, &
+ DSTK%NSIZE_PATCH_DST(JVEG), &!I Size of dust emitter vector
+ KSIZE_P, &!I Size of patch vector
+ KR_P, &!I Mask from patch to nature
+ PVEGTYPE_PATCH, &!I Fraction of vegtype of nature point within jpatch
+ DSTK%NR_PATCH_DST(:DSTK%NSIZE_PATCH_DST(JVEG),JVEG), &!O Part of mask array to fill with values
+ JVEG_IN &!I Index of vegtype in question
)
#endif
- ENDDO !Loop on patches
ENDDO !Loop on veg-types
!
IF (LHOOK) CALL DR_HOOK('INIT_DST',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/init_flaken.F90 b/src/SURFEX/init_flaken.F90
index 339e5e8df5458b8199d4109deac7e3f130787741..57102a9840dcd91c19cb1786ec0e70682aca92a6 100644
--- a/src/SURFEX/init_flaken.F90
+++ b/src/SURFEX/init_flaken.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #############################################################
-SUBROUTINE INIT_FLAKE_n ( DTCO, DGU, UG, U, FM, &
+SUBROUTINE INIT_FLAKE_n ( DTCO, OREAD_BUDGETC, UG, U, FM, &
HPROGRAM,HINIT, &
KI,KSV,KSW, &
HSV,PCO2,PRHOA, &
@@ -51,9 +51,7 @@ SUBROUTINE INIT_FLAKE_n ( DTCO, DGU, UG, U, FM, &
!
USE MODD_SURFEX_n, ONLY : FLAKE_MODEL_t
!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
@@ -90,7 +88,7 @@ USE MODI_READ_NAM_PREP_FLAKE_n
USE MODI_INIT_CHEMICAL_n
USE MODI_PREP_CTRL_FLAKE
USE MODI_UPDATE_RAD_FLAKE
-USE MODI_READ_FLAKE_SBL_n
+USE MODI_READ_SBL_n
!
USE MODI_SET_SURFEX_FILEIN
!
@@ -108,7 +106,7 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+LOGICAL, INTENT(IN) :: OREAD_BUDGETC
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(FLAKE_MODEL_t), INTENT(INOUT) :: FM
@@ -163,7 +161,7 @@ IF (HTEST/='OK') THEN
CALL ABOR1_SFX('INIT_FLAKEN: FATAL ERROR DURING ARGUMENT TRANSFER')
END IF
!
-ALLOCATE(FM%DGMF%XZWAT_PROFILE(100))
+ALLOCATE(FM%DMF%XZWAT_PROFILE(100))
!
! Others litlle things
!
@@ -183,23 +181,21 @@ IF (LNAM_READ) THEN
CALL DEFAULT_FLAKE(FM%F%XTSTEP,FM%F%XOUT_TSTEP,FM%F%LSEDIMENTS,FM%F%CSNOW_FLK,FM%F%CFLK_FLUX,FM%F%CFLK_ALB,&
FM%F%LSKINTEMP)
CALL DEFAULT_CH_DEP(FM%CHF%CCH_DRY_DEP)
- CALL DEFAULT_DIAG_FLAKE(FM%DGF%N2M,FM%DGF%LSURF_BUDGET,FM%DGF%L2M_MIN_ZS,FM%DGF%LRAD_BUDGET,&
- FM%DGF%LCOEF,FM%DGF%LSURF_VARS, FM%DGMF%LWATER_PROFILE,FM%DGF%LSURF_BUDGETC,&
- FM%DGF%LRESET_BUDGETC,FM%DGF%XDIAG_TSTEP,FM%DGMF%XZWAT_PROFILE )
+ CALL DEFAULT_DIAG_FLAKE(FM%DFO%N2M,FM%DFO%LSURF_BUDGET,FM%DFO%L2M_MIN_ZS,FM%DFO%LRAD_BUDGET,&
+ FM%DFO%LCOEF,FM%DFO%LSURF_VARS, FM%DMF%LWATER_PROFILE,FM%DFO%LSURF_BUDGETC,&
+ FM%DFO%LRESET_BUDGETC,FM%DFO%XDIAG_TSTEP,FM%DMF%XZWAT_PROFILE )
!
ENDIF
!
! 0.2. Defaults from file header
!
- CALL READ_DEFAULT_FLAKE_n(FM%CHF, FM%DGF, FM%DGMF, FM%F, &
- HPROGRAM)
+ CALL READ_DEFAULT_FLAKE_n(FM%CHF, FM%DFO, FM%DMF, FM%F, HPROGRAM)
!
!* 1.1 Reading of configuration:
! -------------------------
!
- CALL READ_FLAKE_CONF_n(FM%CHF, FM%DGF, FM%DGMF, FM%F, &
- HPROGRAM)
+ CALL READ_FLAKE_CONF_n(FM%CHF, FM%DFO, FM%DMF, FM%F, HPROGRAM)
!
!-------------------------------------------------------------------------------
!
@@ -215,18 +211,13 @@ SELECT CASE (HINIT)
FM%F%TTIME%TIME = XUNDEF
CASE ('PRE')
- CALL PREP_CTRL_FLAKE(FM%DGF%N2M,FM%DGF%LSURF_BUDGET,FM%DGF%L2M_MIN_ZS,FM%DGF%LRAD_BUDGET,&
- FM%DGF%LCOEF,FM%DGF%LSURF_VARS,ILUOUT,&
- FM%DGMF%LWATER_PROFILE,FM%DGF%LSURF_BUDGETC)
+ CALL PREP_CTRL_FLAKE(FM%DFO,ILUOUT,FM%DMF%LWATER_PROFILE)
IF (LNAM_READ) CALL READ_NAM_PREP_FLAKE_n(HPROGRAM)
- CALL READ_FLAKE_DATE(&
- HPROGRAM,HINIT,ILUOUT,HATMFILE,HATMFILETYPE,KYEAR,KMONTH,KDAY,PTIME,FM%F%TTIME)
+ CALL READ_FLAKE_DATE(HPROGRAM,HINIT,ILUOUT,HATMFILE,HATMFILETYPE,KYEAR,KMONTH,KDAY,PTIME,FM%F%TTIME)
CASE DEFAULT
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'WATER ','FLAKE ','READ ')
- CALL READ_SURF(&
- HPROGRAM,'DTCUR',FM%F%TTIME,IRESP)
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'FULL ','SURF ','READ ')
+ CALL READ_SURF(HPROGRAM,'DTCUR',FM%F%TTIME,IRESP)
CALL END_IO_SURF_n(HPROGRAM)
END SELECT
!
@@ -237,13 +228,12 @@ END SELECT
! Initialisation for IO
!
CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ') ! change input file name to pgd name
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'WATER ','FLAKE ','READ ')
+!
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'WATER ','FLAKE ','READ ')
!
! Reading of the fields
!
- CALL READ_PGD_FLAKE_n(DTCO, U, FM%FG, FM%F, &
- HPROGRAM)
+ CALL READ_PGD_FLAKE_n(DTCO, U, UG, FM%G, FM%F, HPROGRAM)
!
CALL END_IO_SURF_n(HPROGRAM)
CALL SET_SURFEX_FILEIN(HPROGRAM,'PREP') ! restore input file name
@@ -264,11 +254,9 @@ END IF
!* 2. Prognostic and cover fields:
! ---------------------------
!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'WATER ','FLAKE ','READ ')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'WATER ','FLAKE ','READ ')
!
- CALL READ_FLAKE_n(DTCO, U, FM%F, &
- HPROGRAM)
+ CALL READ_FLAKE_n(DTCO, U, FM%F, HPROGRAM)
!
ILU = SIZE(FM%F%XCOVER,1)
!
@@ -283,7 +271,7 @@ ALLOCATE(FM%F%XSNOW_ALB (ILU))
ALLOCATE(FM%F%XEXTCOEF_ICE (ILU))
ALLOCATE(FM%F%XEXTCOEF_SNOW (ILU))
!
-FM%F%XCORIO(:) = 2*XOMEGA*SIN(FM%FG%XLAT(:)*XPI/180.)
+FM%F%XCORIO(:) = 2*XOMEGA*SIN(FM%G%XLAT(:)*XPI/180.)
!
FM%F%XICE_ALB = XALBWATICE ! constant, should be improved latter
FM%F%XSNOW_ALB = XALBWATSNOW ! constant, should be improved latter
@@ -302,9 +290,7 @@ FM%F%XDIR_ALB = 0.0
FM%F%XSCA_ALB = 0.0
FM%F%XEMIS = 0.0
!
- CALL UPDATE_RAD_FLAKE(FM%F%CFLK_ALB,FM%F%XTS,PZENITH,FM%F%XH_ICE,FM%F%XH_SNOW,&
- FM%F%XICE_ALB,FM%F%XSNOW_ALB,FM%F%XDIR_ALB,FM%F%XSCA_ALB,&
- FM%F%XEMIS,PDIR_ALB,PSCA_ALB,PEMIS,PTSRAD )
+ CALL UPDATE_RAD_FLAKE(FM%F,PZENITH,PDIR_ALB,PSCA_ALB,PEMIS,PTSRAD )
!
PTSURF(:) = FM%F%XTS(:)
!
@@ -313,8 +299,7 @@ PTSURF(:) = FM%F%XTS(:)
!* 6. SBL air fields:
! --------------
!
- CALL READ_FLAKE_SBL_n(DTCO, U, FM%F, FM%FSB, &
- HPROGRAM)
+ CALL READ_SBL_n(DTCO, U, FM%SB, FM%F%LSBL, HPROGRAM, "WATER ")
!
!-------------------------------------------------------------------------------
!
@@ -339,7 +324,7 @@ END IF
!* 7. diagnostics initialization
! --------------------------
!
- CALL DIAG_FLAKE_INIT_n(DGU, FM%DGF, FM%DGMF, FM%F, &
+ CALL DIAG_FLAKE_INIT_n(OREAD_BUDGETC, FM%DFO, FM%DF, FM%DFC, FM%DMF, FM%F, &
HPROGRAM,ILU,KSW)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/init_from_data_grdnn.F90 b/src/SURFEX/init_from_data_grdnn.F90
deleted file mode 100644
index 9728162ca2e30a42c674cb36397335bd5750ecc2..0000000000000000000000000000000000000000
--- a/src/SURFEX/init_from_data_grdnn.F90
+++ /dev/null
@@ -1,262 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE INIT_FROM_DATA_GRDN_n (DTGD, &
- KDECADE, HPHOTO, &
- PVEG, &
- PLAI,PRSMIN,PGAMMA,PWRMAX_CF, &
- PRGL,PCV,PDG,PD_ICE,PZ0,PZ0_O_Z0H, &
- PALBNIR_VEG,PALBVIS_VEG,PALBUV_VEG, &
- PEMIS, &
- PVEGTYPE,PROOTFRAC, &
- PGMES,PBSLAI,PLAIMIN,PSEFOLD,PGC, &
- PDMAX, PF2I, OSTRESS, &
- PH_TREE, PRE25, &
- PCE_NITRO, PCF_NITRO, PCNA_NITRO, &
- PALBNIR_SOIL,PALBVIS_SOIL,PALBUV_SOIL )
-! ##############################################################
-!
-!!**** *CONVERT_COVER* convert surface cover classes into secondary
-!! physiographic variables for ISBA
-!!
-!! PURPOSE
-!! -------
-!!
-!! METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! V. Masson Meteo-France
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 01/2004
-!
-!! P Le Moigne 09/2005 AGS modifs of L. Jarlan
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
-!
-
-!
-!
-!
-USE MODD_DATA_TEB_GARDEN_n, ONLY : DATA_TEB_GARDEN_t
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-!
-!
-TYPE(DATA_TEB_GARDEN_t), INTENT(INOUT) :: DTGD
-!
-INTEGER, INTENT(IN) :: KDECADE
- CHARACTER(LEN=*), INTENT(IN) :: HPHOTO ! type of photosynthesis
-!
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PVEG
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PLAI
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PRSMIN
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PGAMMA
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PWRMAX_CF
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PRGL
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PCV
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PDG
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PD_ICE
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PROOTFRAC
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PZ0
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PZ0_O_Z0H
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PALBNIR_VEG
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PALBVIS_VEG
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PALBUV_VEG
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PEMIS
-!
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PVEGTYPE
-!
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PGMES
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PRE25
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PBSLAI
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PLAIMIN
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PSEFOLD
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PGC
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PDMAX
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PF2I
-LOGICAL, DIMENSION(:),OPTIONAL, INTENT(OUT) :: OSTRESS
-!
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PH_TREE
-!
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PCE_NITRO
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PCF_NITRO
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PCNA_NITRO
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PALBNIR_SOIL
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PALBVIS_SOIL
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PALBUV_SOIL
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-INTEGER :: ITIME
-INTEGER :: ILUOUT
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-!
-!* 1. TIME INITIALIZATION
-! -------------------
-!
-! data every month
-IF (LHOOK) CALL DR_HOOK('INIT_FROM_DATA_GRDN_N',0,ZHOOK_HANDLE)
-IF (DTGD%NTIME==12) THEN
- ITIME = (KDECADE+2)/3
-ELSEIF (DTGD%NTIME==1) THEN
- ITIME = 1
-ENDIF
-!
-!* 2. SECONDARY VARIABLES
-! -------------------
-!
-!* 2.1 fields on natural surfaces only, taking into account patches/
-! -------------------------------
-!
-!
-IF (PRESENT(PH_TREE)) THEN
- IF (SIZE(PH_TREE)>0) PH_TREE = DTGD%XDATA_H_TREE
-ENDIF
-!
-IF (PRESENT(PVEGTYPE)) PVEGTYPE = DTGD%XDATA_VEGTYPE
-!
-! vegetation fraction
-! -------------------
-!
-IF (PRESENT(PVEG)) PVEG(:) = DTGD%XDATA_VEG (:,ITIME)
-!
-! Leaf Aera Index
-! ---------------
-!
-IF (PRESENT(PLAI)) PLAI(:) = DTGD%XDATA_LAI (:,ITIME)
-!
-! roughness length
-! ----------------
-!
-IF (PRESENT(PZ0)) PZ0(:) = DTGD%XDATA_Z0 (:,ITIME)
-!
-IF (PRESENT(PZ0_O_Z0H)) PZ0_O_Z0H = DTGD%XDATA_Z0_O_Z0H
-!
-!
-!emis-eco
-!--------
-!
-IF (PRESENT(PEMIS)) PEMIS(:) = DTGD%XDATA_EMIS (:,ITIME)
-!
-!---------------------------------------------------------------------------------
-!
-!* 1/Rsmin
-!
-IF (PRESENT(PRSMIN)) THEN
- IF (SIZE(PRSMIN)>0) PRSMIN = DTGD%XDATA_RSMIN
-END IF
-!
-!* other vegetation parameters
-!
-IF (PRESENT(PGAMMA)) PGAMMA = DTGD%XDATA_GAMMA
-IF (PRESENT(PWRMAX_CF)) PWRMAX_CF = DTGD%XDATA_WRMAX_CF
-!
-!
-IF (PRESENT(PRGL)) PRGL = DTGD%XDATA_RGL
-IF (PRESENT(PCV)) PCV = DTGD%XDATA_CV
-!
-!---------------------------------------------------------------------------------
-!
-!* soil layers
-! -----------
-!
-IF (PRESENT(PDG)) PDG = DTGD%XDATA_DG
-!
-!* cumulative root fraction
-!
-IF (PRESENT(PROOTFRAC)) THEN
- IF (SIZE(PROOTFRAC)>0) PROOTFRAC = DTGD%XDATA_ROOTFRAC
-ENDIF
-!
-!* soil ice for runoff
-!
-IF (PRESENT(PD_ICE)) PD_ICE = DTGD%XDATA_DICE
-!
-!---------------------------------------------------------------------------------
-IF (PRESENT(PALBNIR_VEG)) PALBNIR_VEG = DTGD%XDATA_ALBNIR_VEG
-IF (PRESENT(PALBVIS_VEG)) PALBVIS_VEG = DTGD%XDATA_ALBVIS_VEG
-IF (PRESENT(PALBUV_VEG)) PALBUV_VEG = DTGD%XDATA_ALBUV_VEG
-
-IF (PRESENT(PALBNIR_SOIL)) PALBNIR_SOIL(:) = DTGD%XDATA_ALBNIR_SOIL
-IF (PRESENT(PALBVIS_SOIL)) PALBVIS_SOIL(:) = DTGD%XDATA_ALBVIS_SOIL
-IF (PRESENT(PALBUV_SOIL)) PALBUV_SOIL(:) = DTGD%XDATA_ALBUV_SOIL
-
-IF (PRESENT(PGMES)) THEN
- IF (SIZE(PGMES)>0) PGMES = DTGD%XDATA_GMES
-END IF
-
-IF (PRESENT(PBSLAI)) THEN
- IF (SIZE(PBSLAI)>0) PBSLAI = DTGD%XDATA_BSLAI
-END IF
-
-IF (PRESENT(PSEFOLD)) THEN
- IF (SIZE(PSEFOLD)>0) PSEFOLD = DTGD%XDATA_SEFOLD
-END IF
-
-IF (PRESENT(PGC)) THEN
- IF (SIZE(PGC)>0) PGC = DTGD%XDATA_GC
-END IF
-
-IF (PRESENT(PDMAX)) THEN
- IF (SIZE(PDMAX)>0) PDMAX = DTGD%XDATA_DMAX
-END IF
-
-IF (PRESENT(PRE25)) THEN
- IF (SIZE(PRE25)>0) PRE25 = DTGD%XDATA_RE25
-END IF
-
-IF (PRESENT(PLAIMIN)) THEN
- IF (SIZE(PLAIMIN)>0) PLAIMIN = DTGD%XDATA_LAIMIN
-END IF
-
-IF (PRESENT(PCE_NITRO)) THEN
- IF (SIZE(PCE_NITRO)>0) PCE_NITRO = DTGD%XDATA_CE_NITRO
-END IF
-
-IF (PRESENT(PCF_NITRO)) THEN
- IF (SIZE(PCF_NITRO)>0) PCF_NITRO = DTGD%XDATA_CF_NITRO
-END IF
-
-IF (PRESENT(PCNA_NITRO)) THEN
- IF (SIZE(PCNA_NITRO)>0) PCNA_NITRO = DTGD%XDATA_CNA_NITRO
-END IF
-
-IF (PRESENT(PF2I)) THEN
- IF (SIZE(PF2I)>0) PF2I = DTGD%XDATA_F2I
-END IF
-!
-IF (PRESENT(OSTRESS)) THEN
- IF (SIZE(OSTRESS)>0) OSTRESS = DTGD%LDATA_STRESS
-END IF
-IF (LHOOK) CALL DR_HOOK('INIT_FROM_DATA_GRDN_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE INIT_FROM_DATA_GRDN_n
diff --git a/src/SURFEX/init_from_data_greenroofn.F90 b/src/SURFEX/init_from_data_greenroofn.F90
deleted file mode 100644
index 328d5992ff6938439b0c8bf2e1cab3a37c944f79..0000000000000000000000000000000000000000
--- a/src/SURFEX/init_from_data_greenroofn.F90
+++ /dev/null
@@ -1,270 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE INIT_FROM_DATA_GREENROOF_n (DTGR, TGRO, &
- KDECADE, HPHOTO, &
- POM_GR, PSAND_GR, PCLAY_GR, PVEG, &
- PLAI,PRSMIN,PGAMMA,PWRMAX_CF, &
- PRGL,PCV,PDG,PD_ICE,PZ0,PZ0_O_Z0H, &
- PALBNIR_VEG,PALBVIS_VEG,PALBUV_VEG, &
- PEMIS, &
- PVEGTYPE,PROOTFRAC, &
- PGMES,PBSLAI,PLAIMIN,PSEFOLD,PGC, &
- PDMAX, PF2I, OSTRESS, &
- PH_TREE, PRE25, &
- PCE_NITRO, PCF_NITRO, PCNA_NITRO, &
- PALBNIR_SOIL,PALBVIS_SOIL,PALBUV_SOIL )
-! ##############################################################
-!
-!!**** *CONVERT_COVER* convert surface cover classes into secondary
-!! physiographic variables for ISBA
-!!
-!! PURPOSE
-!! -------
-!!
-!! METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!! Based on init_from_data_grdnn
-!!
-!! AUTHOR
-!! ------
-!!
-!! C. de Munck & A. Lemonsu Meteo-France
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 08/2011
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
-!
-
-!
-!
-!
-USE MODD_DATA_TEB_GREENROOF_n, ONLY : DATA_TEB_GREENROOF_t
-USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-!
-!
-TYPE(DATA_TEB_GREENROOF_t), INTENT(INOUT) :: DTGR
-TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: TGRO
-!
-INTEGER, INTENT(IN) :: KDECADE
- CHARACTER(LEN=*), INTENT(IN) :: HPHOTO ! type of photosynthesis
-!
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PSAND_GR
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PCLAY_GR
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: POM_GR
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PVEG
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PLAI
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PRSMIN
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PGAMMA
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PWRMAX_CF
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PRGL
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PCV
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PDG
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PD_ICE
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PROOTFRAC
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PZ0
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PZ0_O_Z0H
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PALBNIR_VEG
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PALBVIS_VEG
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PALBUV_VEG
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PEMIS
-!
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PVEGTYPE
-!
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PGMES
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PRE25
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PBSLAI
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PLAIMIN
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PSEFOLD
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PGC
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PDMAX
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PF2I
-LOGICAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: OSTRESS
-!
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PH_TREE
-!
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PCE_NITRO
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PCF_NITRO
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PCNA_NITRO
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PALBNIR_SOIL
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PALBVIS_SOIL
-REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: PALBUV_SOIL
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-INTEGER :: ITIME
-INTEGER :: ILUOUT
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. TIME INITIALIZATION
-! -------------------
-!
-! data every month
-IF (LHOOK) CALL DR_HOOK('INIT_FROM_DATA_GREENROOF_N',0,ZHOOK_HANDLE)
-IF (TGRO%NTIME_GR==12) THEN
- ITIME = (KDECADE+2)/3
-ELSE
- ITIME = 1
-END IF
-!
-!* 2. SECONDARY VARIABLES
-! -------------------
-!
-!* 2.0 fields for greenroofs
-! ---------------------
-!
-IF (PRESENT(POM_GR)) POM_GR(:,:) = DTGR%XPAR_OM_GR(:,:)
-!
-IF (PRESENT(PSAND_GR)) PSAND_GR(:,:) = DTGR%XPAR_SAND_GR(:,:)
-!
-IF (PRESENT(PCLAY_GR)) PCLAY_GR(:,:) = DTGR%XPAR_CLAY_GR(:,:)
-!
-!
-!* 2.1 fields on natural surfaces only, taking into account patches/
-! -------------------------------
-!
-IF (PRESENT(PVEGTYPE)) PVEGTYPE = DTGR%XPAR_VEGTYPE
-!
-! vegetation fraction
-! -------------------
-!
-IF (PRESENT(PVEG)) PVEG(:) = DTGR%XPAR_VEG (:,ITIME)
-!
-! Leaf Area Index
-! ---------------
-!
-IF (PRESENT(PLAI)) PLAI(:) = DTGR%XPAR_LAI (:,ITIME)
-!
-! roughness length
-! ----------------
-!
-IF (PRESENT(PZ0)) PZ0(:) = DTGR%XPAR_Z0 (:,ITIME)
-!
-IF (PRESENT(PZ0_O_Z0H)) PZ0_O_Z0H = DTGR%XPAR_Z0_O_Z0H
-!
-!
-!emis-eco
-!--------
-!
-IF (PRESENT(PEMIS)) PEMIS(:) = DTGR%XPAR_EMIS (:,ITIME)
-!
-!---------------------------------------------------------------------------------
-!
-!* 1/Rsmin
-!
-IF (PRESENT(PRSMIN)) THEN
- IF (SIZE(PRSMIN)>0) PRSMIN = DTGR%XPAR_RSMIN
-END IF
-!
-!* other vegetation parameters
-!
-IF (PRESENT(PGAMMA)) PGAMMA = DTGR%XPAR_GAMMA
-IF (PRESENT(PWRMAX_CF)) PWRMAX_CF = DTGR%XPAR_WRMAX_CF
-!
-!
-IF (PRESENT(PRGL)) PRGL = DTGR%XPAR_RGL
-IF (PRESENT(PCV)) PCV = DTGR%XPAR_CV
-!
-!---------------------------------------------------------------------------------
-!
-!* soil layers
-! -----------
-!
-IF (PRESENT(PDG)) PDG = DTGR%XPAR_DG
-!
-!* cumulative root fraction
-!
-IF (PRESENT(PROOTFRAC)) PROOTFRAC = DTGR%XPAR_ROOTFRAC
-!
-!* soil ice for runoff
-!
-IF (PRESENT(PD_ICE)) PD_ICE = DTGR%XPAR_DICE
-!
-!---------------------------------------------------------------------------------
-IF (PRESENT(PALBNIR_VEG)) PALBNIR_VEG = DTGR%XPAR_ALBNIR_VEG
-IF (PRESENT(PALBVIS_VEG)) PALBVIS_VEG = DTGR%XPAR_ALBVIS_VEG
-IF (PRESENT(PALBUV_VEG)) PALBUV_VEG = DTGR%XPAR_ALBUV_VEG
-
-IF (PRESENT(PALBNIR_SOIL)) PALBNIR_SOIL(:) = DTGR%XPAR_ALBNIR_SOIL
-IF (PRESENT(PALBVIS_SOIL)) PALBVIS_SOIL(:) = DTGR%XPAR_ALBVIS_SOIL
-IF (PRESENT(PALBUV_SOIL)) PALBUV_SOIL (:) = DTGR%XPAR_ALBUV_SOIL
-
-IF (PRESENT(PGMES)) THEN
- IF (SIZE(PGMES)>0) PGMES = DTGR%XPAR_GMES
-END IF
-
-IF (PRESENT(PBSLAI)) THEN
- IF (SIZE(PBSLAI)>0) PBSLAI = DTGR%XPAR_BSLAI
-END IF
-
-IF (PRESENT(PSEFOLD)) THEN
- IF (SIZE(PSEFOLD)>0) PSEFOLD = DTGR%XPAR_SEFOLD
-END IF
-
-IF (PRESENT(PGC)) THEN
- IF (SIZE(PGC)>0) PGC = DTGR%XPAR_GC
-END IF
-
-IF (PRESENT(PDMAX)) THEN
- IF (SIZE(PDMAX)>0) PDMAX = DTGR%XPAR_DMAX
-END IF
-
-IF (PRESENT(PRE25)) THEN
- IF (SIZE(PRE25)>0) PRE25 = DTGR%XPAR_RE25
-END IF
-
-IF (PRESENT(PLAIMIN)) THEN
- IF (SIZE(PLAIMIN)>0) PLAIMIN = DTGR%XPAR_LAIMIN
-END IF
-
-IF (PRESENT(PCE_NITRO)) THEN
- IF (SIZE(PCE_NITRO)>0) PCE_NITRO = DTGR%XPAR_CE_NITRO
-END IF
-
-IF (PRESENT(PCF_NITRO)) THEN
- IF (SIZE(PCF_NITRO)>0) PCF_NITRO = DTGR%XPAR_CF_NITRO
-END IF
-
-IF (PRESENT(PCNA_NITRO)) THEN
- IF (SIZE(PCNA_NITRO)>0) PCNA_NITRO = DTGR%XPAR_CNA_NITRO
-END IF
-
-IF (PRESENT(PF2I)) THEN
- IF (SIZE(PF2I)>0) PF2I = DTGR%XPAR_F2I
-END IF
-!
-IF (PRESENT(OSTRESS)) THEN
- IF (SIZE(OSTRESS)>0) OSTRESS = DTGR%LDATA_STRESS
-END IF
-IF (LHOOK) CALL DR_HOOK('INIT_FROM_DATA_GREENROOF_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE INIT_FROM_DATA_GREENROOF_n
diff --git a/src/SURFEX/init_from_data_teb_vegn.F90 b/src/SURFEX/init_from_data_teb_vegn.F90
new file mode 100644
index 0000000000000000000000000000000000000000..79966a8100f3213f0a3a17834d6211751f715ee5
--- /dev/null
+++ b/src/SURFEX/init_from_data_teb_vegn.F90
@@ -0,0 +1,207 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE INIT_FROM_DATA_TEB_VEG_n (DTV, K, P, PEK, KDECADE, OUPDATE, OFIX, OTIME, OALB)
+! ##############################################################
+!
+!!**** *CONVERT_COVER* convert surface cover classes into secondary
+!! physiographic variables for ISBA
+!!
+!! PURPOSE
+!! -------
+!!
+!! METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! V. Masson Meteo-France
+!!
+!! MODIFICATION
+!! ------------
+!!
+!! Original 01/2004
+!
+!! P Le Moigne 09/2005 AGS modifs of L. Jarlan
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATION
+! -----------
+!
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+!
+USE MODI_SOIL_ALBEDO
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+!
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+!
+INTEGER, INTENT(IN) :: KDECADE
+!
+LOGICAL, INTENT(IN) :: OUPDATE
+LOGICAL, INTENT(IN) :: OFIX
+LOGICAL, INTENT(IN) :: OTIME
+LOGICAL, INTENT(IN) :: OALB
+!
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_P_t), INTENT(INOUT) :: P
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZWG1
+REAL, DIMENSION(:), ALLOCATABLE :: ZWGSAT
+!
+INTEGER :: ITIME
+INTEGER :: ILUOUT
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+!
+!* 1. TIME INITIALIZATION
+! -------------------
+!
+! data every month
+IF (LHOOK) CALL DR_HOOK('INIT_FROM_DATA_TEB_VEG_N',0,ZHOOK_HANDLE)
+IF (DTV%NTIME==12) THEN
+ ITIME = (KDECADE+2)/3
+ELSEIF (DTV%NTIME==1) THEN
+ ITIME = 1
+ENDIF
+!
+!
+IF (OFIX) THEN
+!
+
+ IF (SIZE(P%XH_TREE)>0) P%XH_TREE(:) = DTV%XPAR_H_TREE(:,1)
+!
+ P%XZ0_O_Z0H(:) = DTV%XPAR_Z0_O_Z0H(:,1)
+!
+!---------------------------------------------------------------------------------
+!
+!* soil layers
+! -----------
+!
+ P%XDG(:,:) = DTV%XPAR_DG(:,:,1)
+!
+!* cumulative root fraction
+!
+ IF (SIZE(P%XROOTFRAC)>0) P%XROOTFRAC(:,:) = DTV%XPAR_ROOTFRAC(:,:,1)
+!
+!* soil ice for runoff
+!
+ P%XD_ICE(:) = DTV%XPAR_DICE(:,1)
+!
+ IF (SIZE(P%XDMAX)>0) P%XDMAX(:) = DTV%XPAR_DMAX(:,1)
+
+ IF (SIZE(P%XRE25)>0) P%XRE25(:) = DTV%XPAR_RE25(:,1)
+
+
+ENDIF
+!
+!
+!* 2. SECONDARY VARIABLES
+! -------------------
+!
+!* 2.1 fields on natural surfaces only, taking into account patches/
+! -------------------------------
+!
+IF (OTIME) THEN
+!
+! vegetation fraction
+! -------------------
+!
+ PEK%XVEG(:) = DTV%XPAR_VEG (:,ITIME,1)
+!
+! Leaf Aera Index
+! ---------------
+!
+ PEK%XLAI(:) = DTV%XPAR_LAI (:,ITIME,1)
+!
+! roughness length
+! ----------------
+!
+ PEK%XZ0(:) = DTV%XPAR_Z0 (:,ITIME,1)
+!
+!emis-eco
+!--------
+!
+ PEK%XEMIS(:) = DTV%XPAR_EMIS (:,ITIME,1)
+!
+ IF (.NOT.OUPDATE) THEN
+!---------------------------------------------------------------------------------
+!
+!* 1/Rsmin
+!
+ PEK%XRSMIN(:) = DTV%XPAR_RSMIN(:,1)
+!
+!* other vegetation parameters
+!
+ PEK%XGAMMA(:) = DTV%XPAR_GAMMA(:,1)
+ PEK%XWRMAX_CF(:) = DTV%XPAR_WRMAX_CF(:,1)
+!
+!
+ PEK%XRGL(:) = DTV%XPAR_RGL(:,1)
+ PEK%XCV(:) = DTV%XPAR_CV(:,1)
+!
+!---------------------------------------------------------------------------------
+ PEK%XALBNIR_VEG(:) = DTV%XPAR_ALBNIR_VEG(:,1,1)
+ PEK%XALBVIS_VEG(:) = DTV%XPAR_ALBVIS_VEG(:,1,1)
+ PEK%XALBUV_VEG(:) = DTV%XPAR_ALBUV_VEG(:,1,1)
+!
+ IF (SIZE(PEK%XGMES)>0) PEK%XGMES(:) = DTV%XPAR_GMES(:,1)
+
+ IF (SIZE(PEK%XBSLAI)>0) PEK%XBSLAI(:) = DTV%XPAR_BSLAI(:,1)
+
+ IF (SIZE(PEK%XSEFOLD)>0) PEK%XSEFOLD(:) = DTV%XPAR_SEFOLD(:,1)
+
+ IF (SIZE(PEK%XGC)>0) PEK%XGC(:) = DTV%XPAR_GC(:,1)
+!
+ IF (SIZE(PEK%XLAIMIN)>0) PEK%XLAIMIN(:) = DTV%XPAR_LAIMIN(:,1)
+!
+ IF (SIZE(PEK%XCE_NITRO)>0) PEK%XCE_NITRO(:) = DTV%XPAR_CE_NITRO(:,1)
+!
+ IF (SIZE(PEK%XCF_NITRO)>0) PEK%XCF_NITRO(:) = DTV%XPAR_CF_NITRO(:,1)
+!
+ IF (SIZE(PEK%XCNA_NITRO)>0) PEK%XCNA_NITRO(:) = DTV%XPAR_CNA_NITRO(:,1)
+!
+ IF (SIZE(PEK%XF2I)>0) PEK%XF2I(:) = DTV%XPAR_F2I(:,1)
+!
+ IF (SIZE(PEK%LSTRESS)>0) PEK%LSTRESS(:) = DTV%LPAR_STRESS(:,1)
+!
+ ENDIF
+ENDIF
+!
+IF (OALB) THEN
+ !
+ ALLOCATE(ZWGSAT(SIZE(K%XALBVIS_DRY)))
+ ALLOCATE(ZWG1(SIZE(K%XALBVIS_DRY)))
+ ZWGSAT(:) = 0.
+ ZWG1 (:) = 0.
+ CALL SOIL_ALBEDO('DRY',ZWGSAT, ZWG1, K, PEK, "ALL" )
+ DEALLOCATE(ZWGSAT,ZWG1)
+ !
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('INIT_FROM_DATA_TEB_VEG_N',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE INIT_FROM_DATA_TEB_VEG_n
diff --git a/src/SURFEX/init_garden_optionsn.F90 b/src/SURFEX/init_garden_optionsn.F90
deleted file mode 100644
index 1dcd429155a0dbcc93dbffd0e6e4dda5847f67e3..0000000000000000000000000000000000000000
--- a/src/SURFEX/init_garden_optionsn.F90
+++ /dev/null
@@ -1,42 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-!#############################################################
-SUBROUTINE INIT_GARDEN_OPTIONS_n
-!#############################################################
-!
-!!**** *INIT_TEB_GARDEN_n* - routine to initialize ISBA
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! A. Lemonsu *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 09/2009
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!***************
-!* NOT USED ANYMORE
-!******************
-END SUBROUTINE INIT_GARDEN_OPTIONS_n
diff --git a/src/SURFEX/init_ideal_flux.F90 b/src/SURFEX/init_ideal_flux.F90
index fde5cbdde5f0320d34f6e5ff59eb543abb38b4db..73fdba235e42d89f9ab1dd55722e0a8000da0266 100644
--- a/src/SURFEX/init_ideal_flux.F90
+++ b/src/SURFEX/init_ideal_flux.F90
@@ -3,13 +3,10 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ############################################################
- SUBROUTINE INIT_IDEAL_FLUX (DGL, OREAD_BUDGETC, &
- HPROGRAM,HINIT, &
- KI,KSV,KSW, &
- HSV,PCO2,PRHOA, &
- PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD,PTSURF, &
- HTEST )
+ SUBROUTINE INIT_IDEAL_FLUX (DGO, D, DC, OREAD_BUDGETC, &
+ HPROGRAM,HINIT,KI,KSV,KSW, &
+ HSV,PDIR_ALB,PSCA_ALB, &
+ PEMIS,PTSRAD,PTSURF, HTEST )
! ############################################################
!
!!**** *INIT_IDEAL_FLUX * - Prescription of the surface fluxes for the temperature,
@@ -54,7 +51,7 @@
! ------------
!
!
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
!
USE MODD_IDEAL_FLUX, ONLY : XSFTS, XALB, XEMIS
USE MODN_IDEAL_FLUX
@@ -63,7 +60,7 @@ USE MODD_READ_NAMELIST, ONLY : LNAM_READ
USE MODI_DIAG_IDEAL_INIT_n
USE MODI_READ_IDEAL_CONF_n
USE MODI_READ_DEFAULT_IDEAL_n
-USE MODI_PREP_CTRL_IDEAL
+USE MODI_PREP_CTRL
USE MODI_DEFAULT_DIAG_IDEAL
USE MODI_ABOR1_SFX
USE MODI_GET_LUOUT
@@ -76,7 +73,9 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
!
LOGICAL, INTENT(IN) :: OREAD_BUDGETC
!
@@ -86,11 +85,6 @@ INTEGER, INTENT(IN) :: KI ! number of points
INTEGER, INTENT(IN) :: KSV ! number of scalars
INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands
CHARACTER(LEN=6), DIMENSION(KSV), INTENT(IN) :: HSV ! name of all scalar variables
-REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration (kg/m3)
-REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density
-REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! solar zenithal angle
-REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! solar azimuthal angle (rad from N, clock)
-REAL, DIMENSION(KSW), INTENT(IN) :: PSW_BANDS ! middle wavelength of each band
REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PDIR_ALB ! direct albedo for each band
REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each band
REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity
@@ -123,8 +117,9 @@ IF (LNAM_READ) THEN
!* 0.1 defaults
! --------
!
- CALL DEFAULT_DIAG_IDEAL(DGL%N2M,DGL%LSURF_BUDGET,DGL%L2M_MIN_ZS,DGL%LRAD_BUDGET,DGL%LCOEF,DGL%LSURF_VARS,&
- DGL%LSURF_BUDGETC,DGL%LRESET_BUDGETC,DGL%XDIAG_TSTEP )
+ CALL DEFAULT_DIAG_IDEAL(DGO%N2M, DGO%LSURF_BUDGET, DGO%L2M_MIN_ZS, DGO%LRAD_BUDGET,&
+ DGO%LCOEF, DGO%LSURF_VARS, DGO%LSURF_BUDGETC, &
+ DGO%LRESET_BUDGETC,DGO%XDIAG_TSTEP )
ENDIF
!----------------------------------------------------------------------------------
@@ -132,14 +127,11 @@ ENDIF
!* 0.2 configuration
! -------------
!
- CALL READ_DEFAULT_IDEAL_n(DGL, &
- HPROGRAM)
- CALL READ_IDEAL_CONF_n(DGL, &
- HPROGRAM)
+ CALL READ_DEFAULT_IDEAL_n(DGO, HPROGRAM)
+ CALL READ_IDEAL_CONF_n(DGO, HPROGRAM)
!
IF (.NOT.ALLOCATED(XTIMEF_f)) THEN
-!$OMP SINGLE
ALLOCATE(XTIMEF_f (NFORCF+1))
ALLOCATE(XSFTH_f (NFORCF+1))
ALLOCATE(XSFTQ_f (NFORCF+1))
@@ -148,7 +140,6 @@ IF (.NOT.ALLOCATED(XTIMEF_f)) THEN
!
ALLOCATE(XTIMET_t (NFORCT+1))
ALLOCATE(XTSRAD_t (NFORCT+1))
-!$OMP END SINGLE
!
XTIMEF_f(1:NFORCF) = XTIMEF(1:NFORCF)
XSFTH_f (1:NFORCF) = XSFTH (1:NFORCF)
@@ -174,12 +165,11 @@ IF (.NOT.ALLOCATED(XTIMEF_f)) THEN
! -------
!
IF (HINIT=='PRE') THEN
- CALL PREP_CTRL_IDEAL(DGL%N2M,DGL%LSURF_BUDGET,DGL%L2M_MIN_ZS,DGL%LRAD_BUDGET,DGL%LCOEF,DGL%LSURF_VARS,&
- ILUOUT,DGL%LSURF_BUDGETC)
+ CALL PREP_CTRL(DGO,ILUOUT)
ENDIF
!
!----------------------------------------------------------------------------------
-!
+!i
!* 3. HOURLY surface scalar mixing ratio fluxes (NFORCF+1 values per scalar from 00UTC to 24UTC)
! -----------------------------------------
!
@@ -191,8 +181,7 @@ IF (.NOT.ALLOCATED(XTIMEF_f)) THEN
!
XSFTS = 0.
!
- CALL DIAG_IDEAL_INIT_n(DGL, HPROGRAM, OREAD_BUDGETC, &
- KI,KSW)
+ CALL DIAG_IDEAL_INIT_n(DGO, D, DC, HPROGRAM, OREAD_BUDGETC, KI, KSW)
!
ENDIF
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/init_inland_watern.F90 b/src/SURFEX/init_inland_watern.F90
index 3d92ce8eac31a464f2bc9612797b39ce84ad5a5f..a89671fe498f8772d1dc4fa44bfca9caf64cf4eb 100644
--- a/src/SURFEX/init_inland_watern.F90
+++ b/src/SURFEX/init_inland_watern.F90
@@ -3,15 +3,12 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #############################################################
- SUBROUTINE INIT_INLAND_WATER_n (DTCO, DGU, UG, U, WM, FM, DGL, &
- HPROGRAM,HINIT, &
- KI,KSV,KSW, &
- HSV,PCO2,PRHOA, &
- PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD,PTSURF, &
- KYEAR, KMONTH,KDAY, PTIME, &
- HATMFILE,HATMFILETYPE, &
- HTEST )
+ SUBROUTINE INIT_INLAND_WATER_n (DTCO, OREAD_BUDGETC, UG, U, WM, FM, &
+ DGO, DL, DLC, HPROGRAM,HINIT, KI, KSV,&
+ KSW, HSV, PCO2, PRHOA, PZENITH, PAZIM, &
+ PSW_BANDS, PDIR_ALB, PSCA_ALB, PEMIS, &
+ PTSRAD, PTSURF, KYEAR, KMONTH, KDAY, &
+ PTIME, HATMFILE, HATMFILETYPE, HTEST )
! #############################################################
!
!!**** *INIT_INLAND_WATER_n* - routine to initialize inland water
@@ -51,10 +48,9 @@ USE MODD_SURFEX_n, ONLY : FLAKE_MODEL_t
USE MODD_SURFEX_n, ONLY : WATFLUX_MODEL_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t, DIAG_t
!
!
USE MODD_CSTS, ONLY : XTT
@@ -76,12 +72,14 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+LOGICAL, INTENT(IN) :: OREAD_BUDGETC
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(WATFLUX_MODEL_t), INTENT(INOUT) :: WM
TYPE(FLAKE_MODEL_t), INTENT(INOUT) :: FM
-TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: DL
+TYPE(DIAG_t), INTENT(INOUT) :: DLC
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize
@@ -126,24 +124,21 @@ IF (U%CWATER=='NONE ') THEN
PTSRAD =XTT
PTSURF =XTT
ELSE IF (U%CWATER=='FLUX ') THEN
- CALL INIT_IDEAL_FLUX(DGL, DGU%LREAD_BUDGETC, &
- HPROGRAM,HINIT,KI,KSV,KSW,HSV,PCO2,PRHOA, &
- PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD,PTSURF,'OK' )
+ CALL INIT_IDEAL_FLUX(DGO, DL, DLC, OREAD_BUDGETC, HPROGRAM, HINIT, &
+ KI, KSV, KSW, HSV, PDIR_ALB, PSCA_ALB, PEMIS, &
+ PTSRAD, PTSURF, 'OK' )
ELSE IF (U%CWATER=='WATFLX') THEN
- CALL INIT_WATFLUX_n(DTCO, DGU, UG, U, WM, &
- HPROGRAM,HINIT,KI,KSV,KSW,HSV,PCO2,PRHOA, &
- PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD,PTSURF, &
- KYEAR,KMONTH,KDAY,PTIME,HATMFILE,HATMFILETYPE,&
- 'OK' )
+ CALL INIT_WATFLUX_n(DTCO, OREAD_BUDGETC, UG, U, WM, &
+ HPROGRAM, HINIT, KI, KSV, KSW, HSV, PCO2, PRHOA,&
+ PZENITH, PAZIM, PSW_BANDS, PDIR_ALB, PSCA_ALB, &
+ PEMIS, PTSRAD, PTSURF, KYEAR, KMONTH, KDAY, &
+ PTIME, HATMFILE, HATMFILETYPE, 'OK' )
ELSE IF (U%CWATER=='FLAKE ') THEN
- CALL INIT_FLAKE_n(DTCO, DGU, UG, U, FM, &
- HPROGRAM,HINIT,KI,KSV,KSW,HSV,PCO2,PRHOA, &
- PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD,PTSURF, &
- KYEAR,KMONTH,KDAY,PTIME,HATMFILE,HATMFILETYPE,&
- 'OK')
+ CALL INIT_FLAKE_n(DTCO, OREAD_BUDGETC, UG, U, FM, &
+ HPROGRAM, HINIT, KI, KSV, KSW, HSV, PCO2, PRHOA, &
+ PZENITH, PAZIM, PSW_BANDS, PDIR_ALB, PSCA_ALB, &
+ PEMIS, PTSRAD, PTSURF, KYEAR, KMONTH, KDAY, &
+ PTIME, HATMFILE, HATMFILETYPE, 'OK')
END IF
IF (LHOOK) CALL DR_HOOK('INIT_INLAND_WATER_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/init_io_surf_ascn.F90 b/src/SURFEX/init_io_surf_ascn.F90
index d9e4a31f183cf8e0998576af6d5eba5085b0f6d9..0c75b619c9f9fa57a0eb98ac0dca5c429e6e8c74 100644
--- a/src/SURFEX/init_io_surf_ascn.F90
+++ b/src/SURFEX/init_io_surf_ascn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE INIT_IO_SURF_ASC_n (DTCO, U, &
- HMASK,HACTION)
+ SUBROUTINE INIT_IO_SURF_ASC_n (DTCO, U, HMASK,HACTION)
! ######################
!
!!**** *INIT_IO_SURF_ASC* Keep in memory the output files
@@ -46,7 +45,7 @@ USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_SURFEX_MPI, ONLY : NRANK, NINDEX, NSIZE, NPIO
!
USE MODD_IO_SURF_ASC,ONLY: NUNIT,CFILEIN,CFILEOUT,NMASK,NLUOUT,NFULL,CMASK, &
- LOPEN, LCREATED
+ LCREATED,CFILE
!
USE MODI_GET_LUOUT
USE MODI_READ_SURF
@@ -74,75 +73,61 @@ IF (LHOOK) CALL DR_HOOK('INIT_IO_SURF_ASC_N',0,ZHOOK_HANDLE)
!
CALL GET_LUOUT('ASCII ',NLUOUT)
!
-!$OMP BARRIER
-!
-IF (NRANK==NPIO) LOPEN=.FALSE.
-!
NUNIT=20
!
IF (HACTION=='GTMSK') THEN
IF (NRANK==NPIO) THEN
-!$OMP SINGLE
OPEN(UNIT=NUNIT,FILE=CFILEIN,FORM='FORMATTED')
-!$OMP END SINGLE
ENDIF
CMASK = HMASK
+ CFILE = CFILEIN
IF (LHOOK) CALL DR_HOOK('INIT_IO_SURF_ASC_N',1,ZHOOK_HANDLE)
RETURN
ENDIF
!
IF (HACTION == 'READ ') THEN
- IF (NRANK==NPIO) THEN
-!$OMP SINGLE
- OPEN(UNIT=NUNIT,FILE=CFILEIN,FORM='FORMATTED')
-!$OMP END SINGLE
- LOPEN=.TRUE.
- ENDIF
+ OPEN(UNIT=NUNIT,FILE=CFILEIN,FORM='FORMATTED')
! NFULL must be known even if HMASK/=FULL because it's no longer
! updated in init_io_surf_maskn.
CMASK = 'FULL '
CALL READ_SURF(&
'ASCII ','DIM_FULL',NFULL,IRET,HDIR='A')
CMASK = HMASK
+ CFILE = CFILEIN
ELSE
IF (NRANK==NPIO) THEN
-!$OMP SINGLE
IF (LCREATED) THEN
OPEN(UNIT=NUNIT,FILE=CFILEOUT,FORM='FORMATTED',POSITION='APPEND')
ELSE
OPEN(UNIT=NUNIT,FILE=CFILEOUT,FORM='FORMATTED')
LCREATED=.TRUE.
ENDIF
- LOPEN=.TRUE.
-!$OMP END SINGLE
ENDIF
! NFULL must be known in every case.
- CALL GET_DIM_FULL_n(U, &
- NFULL)
+ CALL GET_DIM_FULL_n(U%NDIM_FULL, NFULL)
CMASK = HMASK
+ CFILE = CFILEOUT
ENDIF
!
! nindex is needed for call to get_size_full_n. In init_index_mpi,
! it's not initialized for first readings.
-IF (.NOT.ALLOCATED(NINDEX)) THEN
+IF (.NOT.ALLOCATED(NINDEX) .AND. NRANK==NPIO) THEN
ALLOCATE(NINDEX(NFULL))
NINDEX(:) = 0
+ELSE
+ CALL GET_DIM_FULL_n(U%NDIM_FULL,NFULL)
ENDIF
!
!------------------------------------------------------------------------------
!
! MASK is sized according to the mpi task running
- CALL GET_SIZE_FULL_n(U, &
- 'ASCII ',NFULL,ILU)
+ CALL GET_SIZE_FULL_n('ASCII ',NFULL,U%NSIZE_FULL,ILU)
IF (ILU>NSIZE) NSIZE = ILU
!
IL = ILU
- CALL GET_TYPE_DIM_n(DTCO, U, &
- HMASK,IL)
- CALL INIT_IO_SURF_MASK_n(DTCO, U, &
- HMASK, IL, NLUOUT, ILU, NMASK)
+ CALL GET_TYPE_DIM_n(DTCO, U,HMASK,IL)
+ CALL INIT_IO_SURF_MASK_n(DTCO, U, HMASK, IL, NLUOUT, ILU, NMASK)
!
-!$OMP BARRIER
!
!------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('INIT_IO_SURF_ASC_N',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/init_io_surf_fan.F90 b/src/SURFEX/init_io_surf_fan.F90
index 46af5e00c2c5cf5b47185cd79d6b6cfc9246d851..c61e21a42d890b213b4106a15b0bed69e636c40d 100644
--- a/src/SURFEX/init_io_surf_fan.F90
+++ b/src/SURFEX/init_io_surf_fan.F90
@@ -46,13 +46,10 @@ USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODD_SURFEX_MPI, ONLY : NRANK, NINDEX, NPIO, NSIZE
!
-USE MODD_SURFEX_OMP, ONLY : NINDX2SFX, NWORK, NWORK2, XWORK, XWORK2, XWORK3, &
- NWORK_FULL, NWORK2_FULL, XWORK_FULL, XWORK2_FULL
-!
USE MODD_CSTS, ONLY : XPI
!
USE MODD_IO_SURF_FA,ONLY: NUNIT_FA, CFILEIN_FA,CFILEOUT_FA,CDNOMC,IVERBFA, &
- NLUOUT,NFULL,NFULL_EXT, CMASK, LOPEN, &
+ NLUOUT,NFULL,NFULL_EXT, CMASK, LOPEN, CFILE_FA, &
NDGL, NDLON, NDLUX, NDGUX, PERPK, PEBETA, &
PELON0, PELAT0, PEDELX, PEDELY, PELON1, PELAT1
!
@@ -102,32 +99,29 @@ ENDIF
!
CALL GET_LUOUT(HPROGRAM,NLUOUT)
!
-!$OMP BARRIER
+NUNIT_FA = 19
!
-IF (NRANK==NPIO) LOPEN=.FALSE.
+LOPEN=.FALSE.
!
IF (HACTION=='GTMSK') THEN
IF (NRANK==NPIO) THEN
-!$OMP SINGLE
CALL FAITOU(IRET,NUNIT_FA,.TRUE.,CFILEIN_FA,'OLD',.TRUE.,.FALSE.,IVERBFA,0,INB,CDNOMC)
WRITE(NLUOUT,*)'HPROGRAM ',HPROGRAM,' IO_INIT HACTION==GTMSK',NUNIT_FA,CFILEIN_FA
-!$OMP END SINGLE
LOPEN=.TRUE.
ENDIF
CMASK = HMASK
+ CFILE_FA = CFILEIN_FA
IF (LHOOK) CALL DR_HOOK('INIT_IO_SURF_FA_N',1,ZHOOK_HANDLE)
RETURN
ENDIF
!
IF (HACTION == 'READ ') THEN
- IF (NRANK==NPIO) THEN
-!$OMP SINGLE
- CALL FAITOU(IRET,NUNIT_FA,.TRUE.,CFILEIN_FA,'OLD',.TRUE.,.FALSE.,IVERBFA,0,INB,CDNOMC)
- WRITE(NLUOUT,*)'HPROGRAM ',HPROGRAM,' IO_INIT HACTION==READ',NUNIT_FA,CFILEIN_FA
- CALL FACAGE(CDNOMC,.TRUE.)
-!$OMP END SINGLE
- LOPEN=.TRUE.
- ENDIF
+ CALL FAITOU(IRET,NUNIT_FA,.TRUE.,CFILEIN_FA,'OLD',.TRUE.,.FALSE.,IVERBFA,0,INB,CDNOMC)
+ WRITE(NLUOUT,*)'HPROGRAM ',HPROGRAM,' IO_INIT HACTION==READ',NUNIT_FA,CFILEIN_FA
+ CALL FACAGE(CDNOMC,.TRUE.)
+ LOPEN=.TRUE.
+ !
+ CFILE_FA = CFILEIN_FA
!
IF (HMASK /= 'EXTZON') THEN
CMASK = 'FULL '
@@ -142,13 +136,13 @@ IF (HACTION == 'READ ') THEN
!
ELSE
! NFULL must be known in every case.
- CALL GET_DIM_FULL_n(U, &
- NFULL)
+ CALL GET_DIM_FULL_n(U%NDIM_FULL, NFULL)
+ !
+ CFILE_FA = CFILEOUT_FA
ENDIF
!
IF (HMASK == 'EXTZON') THEN
IF (NRANK==NPIO) THEN
-!$OMP SINGLE
CALL FACIES(CDNOMC, ITYPTR, ZSLAPO, ZCLOPO, ZSLOPO, &
ZCODIL, ITRONC, INLATI, INXLON, INLOPA, &
INOZPA, ZSINLA, INIVER, ZREFER, ZAHYBR, &
@@ -167,17 +161,18 @@ IF (HMASK == 'EXTZON') THEN
PEDELY = ZSINLA(8)
PELON1 = ZSINLA(13)*180./XPI
PELAT1 = ZSINLA(14)*180./XPI
-!$OMP END SINGLE
ENDIF
ENDIF
!
-IF (.NOT.ALLOCATED(NINDEX)) THEN
+IF (.NOT.ALLOCATED(NINDEX).AND.NRANK==NPIO) THEN
ALLOCATE(NINDEX(NFULL))
NINDEX(:) = 0
+ELSEIF (HMASK /= 'EXTZON') THEN
+ CALL GET_DIM_FULL_n(U%NDIM_FULL,NFULL)
ENDIF
!
!------------------------------------------------------------------------------
- CMASK=HMASK
+CMASK=HMASK
!------------------------------------------------------------------------------
!
IF (HPROGRAM=='AROME ') THEN
@@ -185,26 +180,8 @@ IF (HPROGRAM=='AROME ') THEN
ILU = NFULL
IL = NFULL
NSIZE = NFULL
- NINDX2SFX = NFULL
- IF(.NOT.ASSOCIATED(NWORK )) ALLOCATE(NWORK(NFULL))
- IF(.NOT.ASSOCIATED(XWORK )) ALLOCATE(XWORK(NFULL))
- IF(.NOT.ASSOCIATED(NWORK2)) ALLOCATE(NWORK2(NFULL,10))
- IF(.NOT.ASSOCIATED(XWORK2)) ALLOCATE(XWORK2(NFULL,10))
- IF(.NOT.ASSOCIATED(XWORK3)) ALLOCATE(XWORK3(NFULL,10,10))
- IF (NRANK==NPIO) THEN
- IF(.NOT.ASSOCIATED(NWORK_FULL )) ALLOCATE(NWORK_FULL(NFULL))
- IF(.NOT.ASSOCIATED(XWORK_FULL )) ALLOCATE(XWORK_FULL(NFULL))
- IF(.NOT.ASSOCIATED(NWORK2_FULL)) ALLOCATE(NWORK2_FULL(NFULL,10))
- IF(.NOT.ASSOCIATED(XWORK2_FULL)) ALLOCATE(XWORK2_FULL(NFULL,10))
- ELSE
- IF(.NOT.ASSOCIATED(NWORK_FULL )) ALLOCATE(NWORK_FULL(0))
- IF(.NOT.ASSOCIATED(XWORK_FULL )) ALLOCATE(XWORK_FULL(0))
- IF(.NOT.ASSOCIATED(NWORK2_FULL)) ALLOCATE(NWORK2_FULL(0,0))
- IF(.NOT.ASSOCIATED(XWORK2_FULL)) ALLOCATE(XWORK2_FULL(0,0))
- ENDIF
ELSE
- CALL GET_SIZE_FULL_n(U, &
- HPROGRAM,NFULL,ILU)
+ CALL GET_SIZE_FULL_n(HPROGRAM,NFULL,U%NSIZE_FULL,ILU)
IF (ILU>NSIZE) NSIZE = ILU
IL = ILU
CALL GET_TYPE_DIM_n(DTCO, U, &
@@ -217,7 +194,7 @@ ENDIF
IF (LHOOK) CALL DR_HOOK('INIT_IO_SURF_FA_N',1,ZHOOK_HANDLE)
!------------------------------------------------------------------------------
!
- CONTAINS
+CONTAINS
!
SUBROUTINE GET_MASK(KLU,KL)
!
diff --git a/src/SURFEX/init_io_surfn.F90 b/src/SURFEX/init_io_surfn.F90
index 4328da38b364454f12bd797ef08e0d9964e0a7ea..af7404da3618da44f0853b03ed0e4a8da0e156fc 100644
--- a/src/SURFEX/init_io_surfn.F90
+++ b/src/SURFEX/init_io_surfn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE INIT_IO_SURF_n (DTCO, DGU, U, &
- HPROGRAM,HMASK,HSCHEME,HACTION)
+ SUBROUTINE INIT_IO_SURF_n (DTCO, U, HPROGRAM,HMASK,HSCHEME,HACTION,HNAME)
! #######################################################
!
!
@@ -36,6 +35,7 @@
!! Original 09/2003
!! Modified 04/2004 by P. LeMoigne: add HACTION if ASCII mode selected
!! Modified 01/2009 by B. Decjharme: add HPROGRAM if FA mode selected
+!! Modified 08/2015 by S. Senesi : handle XIOS output mode
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -44,7 +44,6 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
#ifdef SFX_ASC
@@ -71,29 +70,37 @@ USE MODI_INIT_IO_SURF_TXT_n
#ifdef SFX_MNH
USE MODI_MNHINIT_IO_SURF_n
#endif
+#ifdef SFX_ARO
+USE MODI_AROINIT_IO_SURF_n
+#endif
+!
+#ifdef WXIOS
+USE MODD_XIOS, ONLY : YXIOS_DOMAIN
+#endif
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+!
!* 0.1 Declarations of arguments
! -------------------------
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! main program
CHARACTER(LEN=6), INTENT(IN) :: HMASK
CHARACTER(LEN=6), INTENT(IN) :: HSCHEME ! scheme used
CHARACTER(LEN=5), INTENT(IN) :: HACTION ! action performed ('READ ','WRITE')
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HNAME
!
!* 0.2 Declarations of local variables
! -------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('INIT_IO_SURF_N',0,ZHOOK_HANDLE)
@@ -105,29 +112,29 @@ END IF
!
IF (HPROGRAM=='OFFLIN' ) THEN
#ifdef SFX_OL
- CALL INIT_IO_SURF_OL_n(DTCO, DGU, U, &
- HPROGRAM,HMASK,HSCHEME,HACTION)
+ IF(PRESENT(HNAME)) THEN
+ CALL INIT_IO_SURF_OL_n(DTCO, U, HPROGRAM,HMASK,HSCHEME,HACTION,HNAME)
+ ELSE
+ CALL INIT_IO_SURF_OL_n(DTCO, U, HPROGRAM,HMASK,HSCHEME,HACTION,HNAME)
+ ENDIF
#endif
ENDIF
!
IF (HPROGRAM=='ASCII ' ) THEN
#ifdef SFX_ASC
- CALL INIT_IO_SURF_ASC_n(DTCO, U, &
- HMASK,HACTION)
+ CALL INIT_IO_SURF_ASC_n(DTCO, U, HMASK,HACTION)
#endif
ENDIF
!
IF (HPROGRAM=='TEXTE ' ) THEN
#ifdef SFX_TXT
- CALL INIT_IO_SURF_TXT_n(DTCO, U, &
- HMASK,HACTION)
+ CALL INIT_IO_SURF_TXT_n(DTCO, U, HMASK,HACTION)
#endif
ENDIF
!
IF (HPROGRAM=='BINARY' ) THEN
#ifdef SFX_BIN
- CALL INIT_IO_SURF_BIN_n(DTCO, U, &
- HMASK,HACTION)
+ CALL INIT_IO_SURF_BIN_n(DTCO, U, HMASK,HACTION)
#endif
ENDIF
!
@@ -139,22 +146,25 @@ ENDIF
!
IF (HPROGRAM=='FA ' ) THEN
#ifdef SFX_FA
- CALL INIT_IO_SURF_FA_n(DTCO, U, &
- HPROGRAM,HMASK,HACTION)
+ CALL INIT_IO_SURF_FA_n(DTCO, U, HPROGRAM,HMASK,HACTION)
#endif
ENDIF
!
IF (HPROGRAM=='LFI ' ) THEN
#ifdef SFX_LFI
- CALL INIT_IO_SURF_LFI_n(DTCO, U, &
- HMASK,HACTION)
+ CALL INIT_IO_SURF_LFI_n(DTCO, U, HMASK,HACTION)
#endif
ENDIF
!
IF (HPROGRAM=='NC ' ) THEN
#ifdef SFX_NC
- CALL INIT_IO_SURF_NC_n(DTCO, U, DGU, &
- HMASK,HACTION)
+ CALL INIT_IO_SURF_NC_n(DTCO, U, HMASK,HACTION)
+#endif
+ENDIF
+!
+IF (TRIM(HPROGRAM)=='XIOS' ) THEN
+#ifdef WXIOS
+ YXIOS_DOMAIN = HMASK
#endif
ENDIF
!
diff --git a/src/SURFEX/init_isba_landuse.F90 b/src/SURFEX/init_isba_landuse.F90
index 98c0d424ca88f6f5c2f554bf4dd478566b295627..44fa48977501d0774e5fad61401057faffaeae3b 100644
--- a/src/SURFEX/init_isba_landuse.F90
+++ b/src/SURFEX/init_isba_landuse.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#############################################################
-SUBROUTINE INIT_ISBA_LANDUSE (DTCO, IG, I, UG, U, &
- HPROGRAM)
+SUBROUTINE INIT_ISBA_LANDUSE (DTCO, UG, U, IO, NK, NP, NPE, PMESH_SIZE, HPROGRAM)
!#############################################################
!
!!**** *INIT_ISBA_LANDUSE* - routine to initialize land use for ISBA field
@@ -45,18 +44,17 @@ SUBROUTINE INIT_ISBA_LANDUSE (DTCO, IG, I, UG, U, &
!* 0. DECLARATIONS
! ------------
!
-!
-!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_NK_t, ISBA_NP_t, ISBA_NPE_t, ISBA_P_t, ISBA_PE_t
!
USE MODD_TYPE_SNOW
USE MODD_SURF_PAR,ONLY : XUNDEF
!
+USE MODD_SURFEX_MPI, ONLY : NPROC, NCOMM
+!
USE MODI_GET_LUOUT
USE MODI_INI_VAR_FROM_PATCH
USE MODI_CONSERV_GLOBAL_MASS
@@ -66,15 +64,23 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1 Declarations of arguments
! -------------------------
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_NK_t), INTENT(INOUT) :: NK
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PMESH_SIZE
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
!
@@ -82,14 +88,21 @@ TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!* 0.2 Declarations of local variables
! -------------------------------
!
-REAL, DIMENSION(SIZE(I%XDG,1),SIZE(I%XDG,2),SIZE(I%XDG,3)) :: ZZDG ! Actual layer thicknesses
-REAL, DIMENSION(SIZE(I%XDG,1),SIZE(I%XDG,2),SIZE(I%XDG,3)) :: ZZDG_OLD ! Old layer thicknesses
-REAL, DIMENSION(SIZE(I%XDG,1),SIZE(I%XDG,2),SIZE(I%XDG,3)) :: ZWG_OLD ! Old XWG
-REAL, DIMENSION(SIZE(I%XDG,1),SIZE(I%XDG,2),SIZE(I%XDG,3)) :: ZWGI_OLD ! Old XWGI
-REAL, DIMENSION(SIZE(I%XDG,1),1,SIZE(I%XDG,3)) :: ZTEST
+TYPE(ISBA_PE_t), POINTER :: PEK
+TYPE(ISBA_P_t), POINTER :: PK
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZZDG ! Actual layer thicknesses
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZZDG_OLD ! Old layer thicknesses
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWG_OLD ! Old XWG
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWGI_OLD ! Old XWGI
!
-INTEGER :: ILUOUT
+INTEGER, DIMENSION(IO%NPATCH,0:NPROC-1) :: ICOUNT_ALL
+INTEGER, DIMENSION(IO%NPATCH) :: ICOUNT
+INTEGER :: ILUOUT, ISIZE, JP, ICPT
INTEGER :: JLAYER, JNBIOMASS, JNLITTER, JNLITTLEVS, JNSOILCARB
+#ifdef SFX_MPI
+INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+#endif
+INTEGER :: INFOMPI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
@@ -99,7 +112,32 @@ IF (LHOOK) CALL DR_HOOK('INIT_ISBA_LANDUSE',0,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
!
-IF(ALL(I%XDG(:,I%NGROUND_LAYER,:)==I%XDG_OLD(:,I%NGROUND_LAYER,:)))THEN
+ICOUNT(:) = 0
+DO JP=1,IO%NPATCH
+ PK => NP%AL(JP)
+ IF (PK%NSIZE_P==0) THEN
+ ICOUNT(JP) = 1
+ ELSEIF(ALL(PK%XDG(:,IO%NGROUND_LAYER)==PK%XDG_OLD(:,IO%NGROUND_LAYER))) THEN
+ ICOUNT(JP) = 1
+ ENDIF
+ENDDO
+!
+IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_ALLGATHER(ICOUNT,SIZE(ICOUNT)*KIND(ICOUNT)/4,MPI_INTEGER,&
+ ICOUNT_ALL,KIND(ICOUNT_ALL)/4,MPI_INTEGER,NCOMM,INFOMPI)
+#endif
+ELSE
+ ICOUNT_ALL(:,0) = ICOUNT
+ENDIF
+!
+ICPT = 0
+DO JP = 1,IO%NPATCH
+ ! all the values are the same
+ IF (ALL(ICOUNT_ALL(JP,:)/=0)) ICPT = ICPT + 1
+ENDDO
+!
+IF ( ICPT==IO%NPATCH ) THEN
IF (LHOOK) CALL DR_HOOK('INIT_ISBA_LANDUSE',1,ZHOOK_HANDLE)
RETURN
ENDIF
@@ -108,144 +146,129 @@ ENDIF
! Conserve mass in the cell
!-------------------------------------------------------------------------------
!
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'WR ', I%XWR (:,:),0)
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'WR ', 0)
-IF (I%LGLACIER) CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'ICE_STO ', I%XICE_STO(:,:),0)
+IF (IO%LGLACIER) &
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH, HPROGRAM,ILUOUT,'ICE_STO ', 0)
!
-DO JLAYER=1,SIZE(I%XTG,2)
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'TEMP GRO', I%XTG(:,JLAYER,:),0)
+DO JLAYER=1,SIZE(NPE%AL(1)%XTG,2)
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH, HPROGRAM,ILUOUT,'TEMP GRO', 0, JLAYER)
END DO
!
!
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'ALBSNOW ', I%TSNOW%ALB(:,:),0)
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH, HPROGRAM,ILUOUT,'ALBSNOW ', 0)
!
-IF (I%TSNOW%SCHEME=='1-L' .OR. I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO') THEN
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'EMISSNOW', I%TSNOW%EMIS(:,:),0)
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'TSSNOW ', I%TSNOW%TS (:,:),0)
+IF (NPE%AL(1)%TSNOW%SCHEME=='1-L' .OR. NPE%AL(1)%TSNOW%SCHEME=='3-L' .OR. NPE%AL(1)%TSNOW%SCHEME=='CRO') THEN
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'EMISSNOW', 0)
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'TSSNOW ', 0)
ENDIF
!
-DO JLAYER=1,I%TSNOW%NLAYER
- !
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'WSNOW ', I%TSNOW%WSNOW(:,JLAYER,:),0)
- !
- IF (I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO') THEN
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'TEMPSNOW', I%TSNOW%TEMP(:,JLAYER,:),0)
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'HEATSNOW', I%TSNOW%HEAT(:,JLAYER,:),0)
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'AGESNOW ', I%TSNOW%AGE (:,JLAYER,:),0)
- ENDIF
- !
- IF (I%TSNOW%SCHEME=='1-L') THEN
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'TSNOW ', I%TSNOW%T(:,JLAYER,:),0)
- ENDIF
- !
- IF(I%TSNOW%SCHEME=='CRO') THEN
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'GRANSNOW', I%TSNOW%GRAN1(:,JLAYER,:),0)
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'GRANSNOW', I%TSNOW%GRAN2(:,JLAYER,:),0)
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'HISTSNOW', I%TSNOW%HIST (:,JLAYER,:),0)
- ENDIF
- !
+DO JLAYER=1,NPE%AL(1)%TSNOW%NLAYER
+ !
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'WSNOW ', 0, JLAYER)
+ !
+ IF (NPE%AL(1)%TSNOW%SCHEME=='3-L' .OR. NPE%AL(1)%TSNOW%SCHEME=='CRO') THEN
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'TEMPSNOW',0, JLAYER)
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'HEATSNOW', 0, JLAYER)
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'AGESNOW ', 0, JLAYER)
+ ENDIF
+ !
+ IF (NPE%AL(1)%TSNOW%SCHEME=='1-L') THEN
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'TSNOW ', 0, JLAYER)
+ ENDIF
+ !
+ IF(NPE%AL(1)%TSNOW%SCHEME=='CRO') THEN
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'GR1SNOW', 0, JLAYER)
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'GR2SNOW', 0, JLAYER)
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'HISTSNOW', 0, JLAYER)
+ ENDIF
+ !
ENDDO
!
!-------------------------------------------------------------------------------
! Conserve mass globaly because soil depth change
!-------------------------------------------------------------------------------
!
-ZWG_OLD(:,:,:) =I%XWG (:,:,:)
-ZWGI_OLD(:,:,:)=I%XWGI(:,:,:)
+ALLOCATE(ZZDG (SIZE(NP%AL(1)%XDG,1),SIZE(NP%AL(1)%XDG,2),IO%NPATCH))
+ALLOCATE(ZZDG_OLD(SIZE(NP%AL(1)%XDG,1),SIZE(NP%AL(1)%XDG,2),IO%NPATCH))
+ALLOCATE(ZWG_OLD (SIZE(NP%AL(1)%XDG,1),SIZE(NP%AL(1)%XDG,2),IO%NPATCH))
+ALLOCATE(ZWGI_OLD(SIZE(NP%AL(1)%XDG,1),SIZE(NP%AL(1)%XDG,2),IO%NPATCH))
!
-DO JLAYER=1,I%NGROUND_LAYER
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'WG ', I%XWG (:,JLAYER,:),0)
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'WGI ', I%XWGI(:,JLAYER,:),0)
+DO JP = 1,IO%NPATCH
+ PEK => NPE%AL(JP)
+ PK => NP%AL(JP)
+
+ ISIZE = NP%AL(JP)%NSIZE_P
+ ZWG_OLD (1:ISIZE,:,JP) =PEK%XWG (:,:)
+ ZWGI_OLD(1:ISIZE,:,JP) =PEK%XWGI (:,:)
+ ZZDG (1:ISIZE,1,JP) =PK%XDG (:,1)
+ ZZDG_OLD(1:ISIZE,1,JP) =PK%XDG_OLD(:,1)
+ IF(IO%CISBA=='DIF')THEN
+ DO JLAYER=2,IO%NGROUND_LAYER
+ ZZDG (1:ISIZE,JLAYER,JP) = PK%XDG (:,JLAYER)-PK%XDG (:,JLAYER-1)
+ ZZDG_OLD(1:ISIZE,JLAYER,JP) = PK%XDG_OLD(:,JLAYER)-PK%XDG_OLD(:,JLAYER-1)
+ ENDDO
+ ELSE
+ ZZDG (:,2,JP) = PK%XDG (:,2)
+ ZZDG_OLD(:,2,JP) = PK%XDG_OLD(:,2)
+ IF(IO%CISBA=='3-L' )THEN
+ ZZDG (:,3,JP) = PK%XDG (:,3)-PK%XDG (:,2)
+ ZZDG_OLD(:,3,JP) = PK%XDG_OLD(:,3)-PK%XDG_OLD(:,2)
+ ENDIF
+ ENDIF
ENDDO
!
-ZZDG (:,1,:)=I%XDG (:,1,:)
-ZZDG_OLD(:,1,:)=I%XDG_OLD(:,1,:)
-IF(I%CISBA=='DIF')THEN
- DO JLAYER=2,I%NGROUND_LAYER
- ZZDG (:,JLAYER,:)=I%XDG (:,JLAYER,:)-I%XDG (:,JLAYER-1,:)
- ZZDG_OLD(:,JLAYER,:)=I%XDG_OLD(:,JLAYER,:)-I%XDG_OLD(:,JLAYER-1,:)
- ENDDO
-ELSE
- ZZDG (:,2,:)=I%XDG (:,2,:)
- ZZDG_OLD(:,2,:)=I%XDG_OLD(:,2,:)
- IF(I%CISBA=='3-L' )THEN
- ZZDG (:,3,:)=I%XDG (:,3,:)-I%XDG (:,2,:)
- ZZDG_OLD(:,3,:)=I%XDG_OLD(:,3,:)-I%XDG_OLD(:,2,:)
- ENDIF
-ENDIF
-!
WHERE(ZZDG(:,:,:) >1.E+10)ZZDG (:,:,:)=0.
WHERE(ZZDG_OLD(:,:,:)>1.E+10)ZZDG_OLD(:,:,:)=0.
!
- CALL CONSERV_GLOBAL_MASS(DTCO, IG, I, U, &
- ILUOUT,ZZDG,ZZDG_OLD,I%XWG, ZWG_OLD )
- CALL CONSERV_GLOBAL_MASS(DTCO, IG, I, U, &
- ILUOUT,ZZDG,ZZDG_OLD,I%XWGI,ZWGI_OLD)
+DO JLAYER=1,IO%NGROUND_LAYER
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'WG ', 0, JLAYER)
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'WGI ', 0, JLAYER)
+ENDDO
+!
+!
+ CALL CONSERV_GLOBAL_MASS(DTCO, U, NP, NPE, PMESH_SIZE, IO%NPATCH,ILUOUT,ZZDG,ZZDG_OLD,'WG ',ZWG_OLD)
+ CALL CONSERV_GLOBAL_MASS(DTCO, U, NP, NPE, PMESH_SIZE,IO%NPATCH,ILUOUT,ZZDG,ZZDG_OLD,'WGI',ZWGI_OLD)
+!
+DEALLOCATE(ZWG_OLD,ZZDG,ZZDG_OLD,ZWGI_OLD)
!
!-------------------------------------------------------------------------------
! Extrapolation with 3 pts
!-------------------------------------------------------------------------------
!
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'RESA ', I%XRESA(:,:),3)
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'RESA ', 3, JLAYER)
!
-DO JLAYER=1,I%TSNOW%NLAYER
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'RHOSNOW ', I%TSNOW%RHO (:,JLAYER,:),3)
+DO JLAYER=1,NPE%AL(1)%TSNOW%NLAYER
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'RHOSNOW ', 3, JLAYER)
ENDDO
!
-IF (I%CPHOTO/='NON') THEN
- !
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'AN ', I%XAN (:,:),3)
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'ANDAY ', I%XANDAY(:,:),3)
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'ANFM ', I%XANFM (:,:),3)
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'LE ', I%XLE (:,:),3)
+IF (IO%CPHOTO/='NON') THEN
+ !
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'AN ', 3)
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'ANDAY ', 3)
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'ANFM ', 3)
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'LE ', 3)
+ !
+ DO JNBIOMASS=1,IO%NNBIOMASS
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'RESPBIOM', 3,JNBIOMASS)
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'BIOMASS ', 3,JNBIOMASS)
+ ENDDO
+ !
+ IF (IO%CRESPSL=='CNT') THEN
!
- DO JNBIOMASS=1,I%NNBIOMASS
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'RESPBIOM', I%XRESP_BIOMASS(:,JNBIOMASS,:),3)
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'BIOMASS ', I%XBIOMASS (:,JNBIOMASS,:),3)
+ DO JNLITTLEVS=1,IO%NNLITTLEVS
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'LIGNINST',3,JNLITTLEVS)
+ DO JNLITTER=1,IO%NNLITTER
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'LITTER ',3,JNLITTER,JNLITTLEVS)
+ ENDDO
ENDDO
!
- IF (I%CRESPSL=='CNT') THEN
- !
- DO JNLITTLEVS=1,I%NNLITTLEVS
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'LIGNINST',I%XLIGNIN_STRUC(:,JNLITTLEVS,:),3)
- DO JNLITTER=1,I%NNLITTER
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'LITTER ',I%XLITTER(:,JNLITTER,JNLITTLEVS,:),3)
- ENDDO
- ENDDO
- !
- DO JNSOILCARB=1,I%NNSOILCARB
- CALL INI_VAR_FROM_PATCH(DTCO, I, UG, U, &
- HPROGRAM,ILUOUT,'SOILCARB',I%XSOILCARB(:,JNSOILCARB,:),3)
- ENDDO
- !
- ENDIF
+ DO JNSOILCARB=1,IO%NNSOILCARB
+ CALL INI_VAR_FROM_PATCH(DTCO, UG, U, NP, NPE, IO%NPATCH,HPROGRAM,ILUOUT,'SOILCARB',3,JNSOILCARB)
+ ENDDO
!
+ ENDIF
+ !
ENDIF
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/init_isba_mixpar.F90 b/src/SURFEX/init_isba_mixpar.F90
index 40751595a991750299b2a93d7efc370b9a6f6c35..48ba6a0959612436da6a283369558d67b369a3b9 100644
--- a/src/SURFEX/init_isba_mixpar.F90
+++ b/src/SURFEX/init_isba_mixpar.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE INIT_ISBA_MIXPAR (DTCO, DTI, IG, I, &
- HISBA,KDECADE,KDECADE2,PCOVER,OCOVER,HPHOTO,HSFTYPE)
+ SUBROUTINE INIT_ISBA_MIXPAR (DTCO, DTV, KDIM, IO, &
+ KDECADE,KDECADE2,PCOVER,OCOVER,HSFTYPE)
! ##############################################################
!
!!**** *INIT_ISBA_MIXPAR*
@@ -50,15 +50,16 @@
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
+USE MODD_TYPE_DATE_SURF
USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, NVEGTYPE_OLD, NVEGTYPE_ECOSG
!
!
USE MODD_DATA_COVER, ONLY : XDATA_LAI, XDATA_H_TREE, XDATA_VEG, &
- XDATA_IRRIG, XDATA_WATSUP
+ XDATA_IRRIG, XDATA_WATSUP, TDATA_SEED, &
+ TDATA_REAP
!
USE MODI_INI_DATA_PARAM
USE MODI_AV_PGD
@@ -73,28 +74,27 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+INTEGER, INTENT(IN) :: KDIM
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
!
- CHARACTER(LEN=*), INTENT(IN) :: HISBA
INTEGER, INTENT(IN) :: KDECADE
INTEGER, INTENT(OUT) :: KDECADE2
REAL, DIMENSION(:,:), INTENT(IN) :: PCOVER
LOGICAL, DIMENSION(:), INTENT(IN) :: OCOVER
- CHARACTER(LEN=*), INTENT(IN) :: HPHOTO ! type of photosynthesis
- CHARACTER(LEN=*), INTENT(IN) :: HSFTYPE ! nature / garden
+CHARACTER(LEN=*), INTENT(IN) :: HSFTYPE ! nature / garden
!
!
!* 0.2 Declaration of local variables
! ------------------------------
!
-REAL, DIMENSION(19) :: XSTRESS ! 1. if defensive /0. if offensive
-REAL, DIMENSION(19) :: XSTRESS_NOAGRI ! 1. if defensive /0. if offensive
+TYPE(DATE_TIME), DIMENSION(:,:), ALLOCATABLE :: TPWORK
+REAL, DIMENSION(NVEGTYPE) :: XSTRESS ! 1. if defensive /0. if offensive
+REAL, DIMENSION(NVEGTYPE) :: XSTRESS_NOAGRI ! 1. if defensive /0. if offensive
!
- CHARACTER(LEN=3) :: YTREE, YNAT, YVEG
+CHARACTER(LEN=3) :: YTREE, YNAT, YVEG
!
-INTEGER :: JVEGTYPE
+INTEGER :: JVEG, JT, ji
!
INTEGER :: ISIZE_LMEB_PATCH ! Number of patches with MEB=true
!
@@ -103,8 +103,6 @@ INTEGER :: ISIZE_LMEB_PATCH ! Number of patches with MEB=true
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-DATA XSTRESS /1.,1.,1.,0.,1.,0.,1.,0.,1.,0.,0.,0.,0.,0.,1.,0.,1.,0.,0./
-DATA XSTRESS_NOAGRI /1.,1.,1.,0.,1.,0.,0.,0.,0.,0.,0.,0.,0.,0.,1.,0.,1.,0.,0./
!-------------------------------------------------------------------------------
!
!* 1. Initializations
@@ -112,9 +110,17 @@ DATA XSTRESS_NOAGRI /1.,1.,1.,0.,1.,0.,0.,0.,0.,0.,0.,0.,0.,0.,1.,0.,1.,0.,0./
!
IF (LHOOK) CALL DR_HOOK('INIT_ISBA_MIXPAR',0,ZHOOK_HANDLE)
!
-ISIZE_LMEB_PATCH=COUNT(I%LMEB_PATCH(:))
+IF (NVEGTYPE==NVEGTYPE_ECOSG) THEN
+ XSTRESS = (/1.,1.,1.,0.,0.,0.,0.,0.,1.,1.,1.,0.,0.,0.,0.,1.,1.,0.,0.,0./)
+ XSTRESS_NOAGRI = (/1.,1.,1.,0.,0.,0.,0.,0.,1.,1.,1.,0.,0.,0.,0.,0.,0.,0.,0.,0./)
+ELSE
+ XSTRESS = (/1.,1.,1.,0.,1.,0.,1.,0.,1.,0.,0.,0.,0.,0.,1.,0.,1.,0.,0./)
+ XSTRESS_NOAGRI = (/1.,1.,1.,0.,1.,0.,0.,0.,0.,0.,0.,0.,0.,0.,1.,0.,1.,0.,0./)
+ENDIF
+!
+ISIZE_LMEB_PATCH=COUNT(IO%LMEB_PATCH(:))
!
-IF (.NOT.DTI%LDATA_MIXPAR) THEN
+IF (.NOT.DTV%LDATA_MIXPAR) THEN
IF (LHOOK) CALL DR_HOOK('INIT_ISBA_MIXPAR',1,ZHOOK_HANDLE)
RETURN
ENDIF
@@ -130,84 +136,72 @@ ELSEIF (HSFTYPE=='GRD') THEN
ENDIF
!
KDECADE2 = KDECADE
-IF (DTI%NTIME==2) KDECADE2 = KDECADE2 + 10
-KDECADE2 = (KDECADE2-1) * DTI%NTIME / 36 + 1
-IF (DTI%NTIME==2 .AND. KDECADE2==3) KDECADE2 = 1
+IF (DTV%NTIME==2) KDECADE2 = KDECADE2 + 10
+KDECADE2 = (KDECADE2-1) * DTV%NTIME / 36 + 1
+IF (DTV%NTIME==2 .AND. KDECADE2==3) KDECADE2 = 1
!
! 1. Arrays needed further
! ------------------------
!
!XPAR_VEGTYPE will be needed to use ini_data_param by point
-IF (.NOT.DTI%LDATA_VEGTYPE) THEN
- ALLOCATE(DTI%XPAR_VEGTYPE (IG%NDIM,NVEGTYPE))
- DO JVEGTYPE=1,NVEGTYPE
- CALL AV_PGD(DTCO, &
- DTI%XPAR_VEGTYPE(:,JVEGTYPE),PCOVER ,DTCO%XDATA_VEGTYPE(:,JVEGTYPE),YNAT,'ARI',OCOVER)
+IF (.NOT.DTV%LDATA_VEGTYPE) THEN
+ ALLOCATE(DTV%XPAR_VEGTYPE (KDIM,NVEGTYPE))
+ DO JVEG=1,NVEGTYPE
+ CALL AV_PGD(DTCO,DTV%XPAR_VEGTYPE(:,JVEG),PCOVER ,DTCO%XDATA_VEGTYPE(:,JVEG),YNAT,'ARI',OCOVER)
END DO
+ !DTV%XPAR_VEGTYPE(:,:)=DTV%XPAR_VEGTYPE(:,:)/SPREAD(SUM(DTV%XPAR_VEGTYPE(:,:),2),2,NVEGTYPE)
ENDIF
!
!xpar_lai: needed for av_pgd_param with YLAI
-IF (.NOT.DTI%LDATA_LAI) THEN
- ALLOCATE(DTI%XPAR_LAI(IG%NDIM,DTI%NTIME,NVEGTYPE))
- CALL AV_PGD(DTCO, &
- DTI%XPAR_LAI(:,KDECADE2,:),PCOVER,XDATA_LAI(:,KDECADE,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE2)
+IF (.NOT.ANY(DTV%LDATA_LAI)) THEN
+ ALLOCATE(DTV%XPAR_LAI(KDIM,DTV%NTIME,NVEGTYPE))
+ CALL AV_PGD(DTCO,DTV%XPAR_LAI(:,KDECADE2,:),PCOVER,XDATA_LAI(:,KDECADE,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
ENDIF
+!
!veg
-IF (.NOT.DTI%LDATA_VEG) THEN
- ALLOCATE(DTI%XPAR_VEG(IG%NDIM,DTI%NTIME,NVEGTYPE))
- IF (DTI%LDATA_LAI) THEN
- CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PLAI=DTI%XPAR_LAI,PVEG_OUT=DTI%XPAR_VEG)
- DTI%LDATA_VEG=.TRUE.
+IF (.NOT.ANY(DTV%LDATA_VEG)) THEN
+ ALLOCATE(DTV%XPAR_VEG(KDIM,DTV%NTIME,NVEGTYPE))
+ IF (ANY(DTV%LDATA_LAI)) THEN
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PLAI=DTV%XPAR_LAI,PVEG_OUT=DTV%XPAR_VEG)
+ DTV%LDATA_VEG(:)=.TRUE.
ELSE
- CALL AV_PGD(DTCO, &
- DTI%XPAR_VEG(:,KDECADE2,:),PCOVER,XDATA_VEG(:,KDECADE,:),YNAT,'ARI',OCOVER,KDECADE=KDECADE2)
+ CALL AV_PGD(DTCO,DTV%XPAR_VEG(:,KDECADE2,:),PCOVER,XDATA_VEG(:,KDECADE,:),YNAT,'ARI',OCOVER,KDECADE=KDECADE)
ENDIF
ENDIF
+!
!ht: needed to calculate z0, if not calculated yet during extrapolation
-IF (.NOT.DTI%LDATA_H_TREE .AND. .NOT.DTI%LDATA_Z0 .AND. DTI%LDATA_LAI) THEN
- ALLOCATE(DTI%XPAR_H_TREE(IG%NDIM,NVEGTYPE))
- CALL AV_PGD(DTCO, &
- DTI%XPAR_H_TREE,PCOVER,XDATA_H_TREE,YTREE,'ARI',OCOVER,KDECADE=KDECADE2)
- DTI%LDATA_H_TREE = .TRUE.
+IF (.NOT.ANY(DTV%LDATA_H_TREE) .AND. .NOT.ANY(DTV%LDATA_Z0) .AND. ANY(DTV%LDATA_LAI)) THEN
+ ALLOCATE(DTV%XPAR_H_TREE(KDIM,NVEGTYPE))
+ CALL AV_PGD(DTCO,DTV%XPAR_H_TREE,PCOVER,XDATA_H_TREE,YTREE,'ARI',OCOVER,KDECADE=KDECADE)
+ DTV%LDATA_H_TREE(:) = .TRUE.
ENDIF
!
!dg: initialization for ROOTFRAC
!ROOTFRAC depends on ROOT_DEPTH, DG, ROOT_EXT, ROOT_LIN
-IF (.NOT.DTI%LDATA_ROOTFRAC .AND. HISBA=='DIF' .AND. DTI%LDATA_ROOT_DEPTH) THEN
+IF (.NOT.ANY(DTV%LDATA_ROOTFRAC) .AND. IO%CISBA=='DIF' .AND. ANY(DTV%LDATA_ROOT_DEPTH)) THEN
!
- IF (.NOT.DTI%LDATA_ROOT_EXTINCTION) THEN
- ALLOCATE(DTI%XPAR_ROOT_EXTINCTION(IG%NDIM,NVEGTYPE))
- CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PROOT_EXTINCTION=DTI%XPAR_ROOT_EXTINCTION)
- DTI%LDATA_ROOT_EXTINCTION = .TRUE.
+ IF (.NOT.ANY(DTV%LDATA_ROOT_EXTINCTION)) THEN
+ ALLOCATE(DTV%XPAR_ROOT_EXTINCTION(KDIM,NVEGTYPE))
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PROOT_EXTINCTION=DTV%XPAR_ROOT_EXTINCTION)
+ DTV%LDATA_ROOT_EXTINCTION(:) = .TRUE.
ENDIF
!
- IF (.NOT.DTI%LDATA_ROOT_LIN) THEN
- ALLOCATE(DTI%XPAR_ROOT_LIN(IG%NDIM,NVEGTYPE))
- CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PROOT_LIN=DTI%XPAR_ROOT_LIN)
- DTI%LDATA_ROOT_LIN = .TRUE.
- ENDIF
- !
-ENDIF
-!
-! MEB roots
-IF (.NOT.DTI%LDATA_ROOTFRACGV .AND. HISBA=='DIF' .AND. DTI%LDATA_ROOT_DEPTHGV) THEN
- !
- IF (.NOT.DTI%LDATA_ROOT_EXTINCTIONGV) THEN
- ALLOCATE(DTI%XPAR_ROOT_EXTINCTIONGV(IG%NDIM,NVEGTYPE))
- CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,PROOT_EXTINCTIONGV=DTI%XPAR_ROOT_EXTINCTIONGV)
- DTI%LDATA_ROOT_EXTINCTIONGV = .TRUE.
+ IF (.NOT.ANY(DTV%LDATA_ROOT_LIN)) THEN
+ ALLOCATE(DTV%XPAR_ROOT_LIN(KDIM,NVEGTYPE))
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PROOT_LIN=DTV%XPAR_ROOT_LIN)
+ DTV%LDATA_ROOT_LIN(:) = .TRUE.
ENDIF
!
ENDIF
!
!dice: depth of the soil column for the calculation of the frozen soil fraction (m)
-IF (DTI%LDATA_DG .AND. .NOT.DTI%LDATA_DICE) THEN
+IF (ANY(DTV%LDATA_DG) .AND. .NOT.ANY(DTV%LDATA_DICE)) THEN
!
- ALLOCATE(DTI%XPAR_DICE(IG%NDIM,NVEGTYPE))
+ ALLOCATE(DTV%XPAR_DICE(KDIM,NVEGTYPE))
!
- IF(HISBA/='DIF')THEN
- DTI%XPAR_DICE(:,:)=MAX(0.2,0.8*DTI%XPAR_DG(:,2,:))
- DTI%LDATA_DICE=.TRUE.
+ IF(IO%CISBA/='DIF')THEN
+ DTV%XPAR_DICE(:,:)=MAX(0.2,0.8*DTV%XPAR_DG(:,2,:))
+ DTV%LDATA_DICE(:)=.TRUE.
ENDIF
!
ENDIF
@@ -216,189 +210,224 @@ ENDIF
! -------------------------------------------------
!
!emis
-IF (.NOT.DTI%LDATA_EMIS .AND. DTI%LDATA_VEG) THEN
- ALLOCATE(DTI%XPAR_EMIS(IG%NDIM,DTI%NTIME,NVEGTYPE))
- CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PVEG_IN=DTI%XPAR_VEG,PEMIS_ECO=DTI%XPAR_EMIS)
- DTI%LDATA_EMIS=.TRUE.
+IF (.NOT.ANY(DTV%LDATA_EMIS) .AND. ANY(DTV%LDATA_VEG)) THEN
+ ALLOCATE(DTV%XPAR_EMIS(KDIM,DTV%NTIME,NVEGTYPE))
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PVEG_IN=DTV%XPAR_VEG,PEMIS_ECO=DTV%XPAR_EMIS)
+ DTV%LDATA_EMIS(:)=.TRUE.
ENDIF
-!
!z0
-!
-IF (.NOT.DTI%LDATA_Z0 .AND. (DTI%LDATA_LAI .OR.DTI%LDATA_H_TREE)) THEN
- ALLOCATE(DTI%XPAR_Z0(IG%NDIM,DTI%NTIME,NVEGTYPE))
- CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PLAI=DTI%XPAR_LAI,PH_TREE=DTI%XPAR_H_TREE,PZ0=DTI%XPAR_Z0)
- DTI%LDATA_Z0=.TRUE.
+IF (.NOT.ANY(DTV%LDATA_Z0) .AND. (ANY(DTV%LDATA_LAI) .OR.ANY(DTV%LDATA_H_TREE))) THEN
+ ALLOCATE(DTV%XPAR_Z0(KDIM,DTV%NTIME,NVEGTYPE))
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PLAI=DTV%XPAR_LAI,PH_TREE=DTV%XPAR_H_TREE,PZ0=DTV%XPAR_Z0)
+ DTV%LDATA_Z0(:)=.TRUE.
ENDIF
-!
+
!RSMIN
-IF (DTI%LDATA_LAI) THEN
- IF (.NOT.DTI%LDATA_RSMIN) THEN
- ALLOCATE(DTI%XPAR_RSMIN(IG%NDIM,NVEGTYPE))
- CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PRSMIN=DTI%XPAR_RSMIN)
+IF (ANY(DTV%LDATA_LAI)) THEN
+ IF (.NOT.ANY(DTV%LDATA_RSMIN)) THEN
+ ALLOCATE(DTV%XPAR_RSMIN(KDIM,NVEGTYPE))
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PRSMIN=DTV%XPAR_RSMIN)
ENDIF
- DTI%LDATA_RSMIN=.TRUE.
+ DTV%LDATA_RSMIN(:)=.TRUE.
ENDIF
!parameters calculated on veg fraction
-IF (DTI%LDATA_VEG) THEN
+IF (ANY(DTV%LDATA_VEG)) THEN
!
- IF (.NOT.DTI%LDATA_GAMMA) ALLOCATE(DTI%XPAR_GAMMA (IG%NDIM,NVEGTYPE))
- IF (.NOT.DTI%LDATA_WRMAX_CF) ALLOCATE(DTI%XPAR_WRMAX_CF (IG%NDIM,NVEGTYPE))
- IF (.NOT.DTI%LDATA_RGL) ALLOCATE(DTI%XPAR_RGL (IG%NDIM,NVEGTYPE))
- IF (.NOT.DTI%LDATA_CV) ALLOCATE(DTI%XPAR_CV (IG%NDIM,NVEGTYPE))
- IF (.NOT.DTI%LDATA_ALBNIR_VEG) ALLOCATE(DTI%XPAR_ALBNIR_VEG(IG%NDIM,NVEGTYPE))
- IF (.NOT.DTI%LDATA_ALBVIS_VEG) ALLOCATE(DTI%XPAR_ALBVIS_VEG(IG%NDIM,NVEGTYPE))
- IF (.NOT.DTI%LDATA_ALBUV_VEG) ALLOCATE(DTI%XPAR_ALBUV_VEG (IG%NDIM,NVEGTYPE))
- IF (.NOT.DTI%LDATA_GMES) ALLOCATE(DTI%XPAR_GMES (IG%NDIM,NVEGTYPE))
- IF (.NOT.DTI%LDATA_BSLAI) ALLOCATE(DTI%XPAR_BSLAI (IG%NDIM,NVEGTYPE))
- IF (.NOT.DTI%LDATA_SEFOLD) ALLOCATE(DTI%XPAR_SEFOLD (IG%NDIM,NVEGTYPE))
- IF (.NOT.DTI%LDATA_GC) ALLOCATE(DTI%XPAR_GC (IG%NDIM,NVEGTYPE))
- IF (.NOT.DTI%LDATA_LAIMIN) ALLOCATE(DTI%XPAR_LAIMIN (IG%NDIM,NVEGTYPE))
- IF (.NOT.DTI%LDATA_F2I) ALLOCATE(DTI%XPAR_F2I (IG%NDIM,NVEGTYPE))
- IF (.NOT.DTI%LDATA_CE_NITRO) ALLOCATE(DTI%XPAR_CE_NITRO (IG%NDIM,NVEGTYPE))
- IF (.NOT.DTI%LDATA_CF_NITRO) ALLOCATE(DTI%XPAR_CF_NITRO (IG%NDIM,NVEGTYPE))
- IF (.NOT.DTI%LDATA_CNA_NITRO) ALLOCATE(DTI%XPAR_CNA_NITRO (IG%NDIM,NVEGTYPE))
+ IF (.NOT.ANY(DTV%LDATA_GAMMA)) ALLOCATE(DTV%XPAR_GAMMA (KDIM,NVEGTYPE))
+ IF (.NOT.ANY(DTV%LDATA_WRMAX_CF)) ALLOCATE(DTV%XPAR_WRMAX_CF (KDIM,NVEGTYPE))
+ IF (.NOT.ANY(DTV%LDATA_RGL)) ALLOCATE(DTV%XPAR_RGL (KDIM,NVEGTYPE))
+ IF (.NOT.ANY(DTV%LDATA_CV)) ALLOCATE(DTV%XPAR_CV (KDIM,NVEGTYPE))
+ IF (.NOT.ANY(DTV%LDATA_ALBNIR_VEG)) ALLOCATE(DTV%XPAR_ALBNIR_VEG(KDIM,DTV%NTIME,NVEGTYPE))
+ IF (.NOT.ANY(DTV%LDATA_ALBVIS_VEG)) ALLOCATE(DTV%XPAR_ALBVIS_VEG(KDIM,DTV%NTIME,NVEGTYPE))
+ IF (.NOT.ANY(DTV%LDATA_ALBUV_VEG)) ALLOCATE(DTV%XPAR_ALBUV_VEG (KDIM,DTV%NTIME,NVEGTYPE))
+ IF (.NOT.ANY(DTV%LDATA_GMES)) ALLOCATE(DTV%XPAR_GMES (KDIM,NVEGTYPE))
+ IF (.NOT.ANY(DTV%LDATA_BSLAI)) ALLOCATE(DTV%XPAR_BSLAI (KDIM,NVEGTYPE))
+ IF (.NOT.ANY(DTV%LDATA_SEFOLD)) ALLOCATE(DTV%XPAR_SEFOLD (KDIM,NVEGTYPE))
+ IF (.NOT.ANY(DTV%LDATA_GC)) ALLOCATE(DTV%XPAR_GC (KDIM,NVEGTYPE))
+ IF (.NOT.ANY(DTV%LDATA_LAIMIN)) ALLOCATE(DTV%XPAR_LAIMIN (KDIM,NVEGTYPE))
+ IF (.NOT.ANY(DTV%LDATA_F2I)) ALLOCATE(DTV%XPAR_F2I (KDIM,NVEGTYPE))
+ IF (.NOT.ANY(DTV%LDATA_CE_NITRO)) ALLOCATE(DTV%XPAR_CE_NITRO (KDIM,NVEGTYPE))
+ IF (.NOT.ANY(DTV%LDATA_CF_NITRO)) ALLOCATE(DTV%XPAR_CF_NITRO (KDIM,NVEGTYPE))
+ IF (.NOT.ANY(DTV%LDATA_CNA_NITRO)) ALLOCATE(DTV%XPAR_CNA_NITRO (KDIM,NVEGTYPE))
!
- IF (.NOT.DTI%LDATA_GAMMA) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PGAMMA=DTI%XPAR_GAMMA)
- IF (.NOT.DTI%LDATA_WRMAX_CF) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PWRMAX_CF=DTI%XPAR_WRMAX_CF)
- IF (.NOT.DTI%LDATA_RGL) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PRGL=DTI%XPAR_RGL)
- IF (.NOT.DTI%LDATA_CV) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PCV=DTI%XPAR_CV)
- IF (.NOT.DTI%LDATA_ALBNIR_VEG) &
- CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PALBNIR_VEG=DTI%XPAR_ALBNIR_VEG)
- IF (.NOT.DTI%LDATA_ALBVIS_VEG) &
- CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PALBVIS_VEG=DTI%XPAR_ALBVIS_VEG)
- IF (.NOT.DTI%LDATA_ALBUV_VEG) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PALBUV_VEG=DTI%XPAR_ALBUV_VEG)
+ IF (.NOT.ANY(DTV%LDATA_GAMMA)) &
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PGAMMA=DTV%XPAR_GAMMA)
+ IF (.NOT.ANY(DTV%LDATA_WRMAX_CF)) &
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PWRMAX_CF=DTV%XPAR_WRMAX_CF)
+ IF (.NOT.ANY(DTV%LDATA_RGL)) &
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PRGL=DTV%XPAR_RGL)
+ IF (.NOT.ANY(DTV%LDATA_CV)) &
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PCV=DTV%XPAR_CV)
+ IF (.NOT.ANY(DTV%LDATA_ALBNIR_VEG)) THEN
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PALBNIR_VEG=DTV%XPAR_ALBNIR_VEG(:,1,:))
+ DO JT = 2,DTV%NTIME
+ DTV%XPAR_ALBNIR_VEG(:,JT,:) = DTV%XPAR_ALBNIR_VEG(:,1,:)
+ ENDDO
+ ENDIF
+ IF (.NOT.ANY(DTV%LDATA_ALBVIS_VEG)) THEN
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PALBVIS_VEG=DTV%XPAR_ALBVIS_VEG(:,1,:))
+ DO JT = 2,DTV%NTIME
+ DTV%XPAR_ALBVIS_VEG(:,JT,:) = DTV%XPAR_ALBVIS_VEG(:,1,:)
+ ENDDO
+ ENDIF
+ IF (.NOT.ANY(DTV%LDATA_ALBUV_VEG)) THEN
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PALBUV_VEG=DTV%XPAR_ALBUV_VEG(:,1,:))
+ DO JT = 2,DTV%NTIME
+ DTV%XPAR_ALBUV_VEG(:,JT,:) = DTV%XPAR_ALBUV_VEG(:,1,:)
+ ENDDO
+ ENDIF
IF (ISIZE_LMEB_PATCH>0) THEN
- IF (.NOT.DTI%LDATA_BSLAI) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,PBSLAI=DTI%XPAR_BSLAI)
+ IF (.NOT.ANY(DTV%LDATA_BSLAI)) CALL INI_DATA_PARAM(PBSLAI=DTV%XPAR_BSLAI)
ENDIF
- IF (HPHOTO == 'AST' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT' .OR. HPHOTO=='NCB') THEN
- IF (.NOT.DTI%LDATA_GMES) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PGMES_ST=DTI%XPAR_GMES)
- IF (.NOT.DTI%LDATA_BSLAI) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PBSLAI_ST=DTI%XPAR_BSLAI)
- IF (.NOT.DTI%LDATA_SEFOLD) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PSEFOLD_ST=DTI%XPAR_SEFOLD)
- IF (.NOT.DTI%LDATA_GC) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PGC_ST=DTI%XPAR_GC)
+ IF (IO%CPHOTO /= 'NON') THEN
+ IF (.NOT.ANY(DTV%LDATA_GMES)) &
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PGMES_ST=DTV%XPAR_GMES)
+ IF (.NOT.ANY(DTV%LDATA_BSLAI)) &
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PBSLAI_ST=DTV%XPAR_BSLAI)
+ IF (.NOT.ANY(DTV%LDATA_SEFOLD)) &
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PSEFOLD_ST=DTV%XPAR_SEFOLD)
+ IF (.NOT.ANY(DTV%LDATA_GC)) &
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PGC_ST=DTV%XPAR_GC)
ELSE
- IF (.NOT.DTI%LDATA_GMES) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PGMES=DTI%XPAR_GMES)
- IF (.NOT.DTI%LDATA_BSLAI) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PBSLAI=DTI%XPAR_BSLAI)
- IF (.NOT.DTI%LDATA_SEFOLD) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PSEFOLD=DTI%XPAR_SEFOLD)
- IF (.NOT.DTI%LDATA_GC) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PGC=DTI%XPAR_GC)
+ IF (.NOT.ANY(DTV%LDATA_GMES)) &
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PGMES=DTV%XPAR_GMES)
+ IF (.NOT.ANY(DTV%LDATA_BSLAI)) &
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PBSLAI=DTV%XPAR_BSLAI)
+ IF (.NOT.ANY(DTV%LDATA_SEFOLD)) &
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PSEFOLD=DTV%XPAR_SEFOLD)
+ IF (.NOT.ANY(DTV%LDATA_GC)) &
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PGC=DTV%XPAR_GC)
ENDIF
- IF (.NOT.DTI%LDATA_LAIMIN) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PLAIMIN_OUT=DTI%XPAR_LAIMIN)
- IF (.NOT.DTI%LDATA_F2I) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PF2I=DTI%XPAR_F2I)
- IF (.NOT.DTI%LDATA_CE_NITRO) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PCE_NITRO=DTI%XPAR_CE_NITRO)
- IF (.NOT.DTI%LDATA_CF_NITRO) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PCF_NITRO=DTI%XPAR_CF_NITRO)
- IF (.NOT.DTI%LDATA_CNA_NITRO) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PCNA_NITRO=DTI%XPAR_CNA_NITRO)
+ IF (.NOT.ANY(DTV%LDATA_LAIMIN)) &
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PLAIMIN_OUT=DTV%XPAR_LAIMIN)
+ IF (.NOT.ANY(DTV%LDATA_F2I)) &
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PF2I=DTV%XPAR_F2I)
+ IF (.NOT.ANY(DTV%LDATA_CE_NITRO)) &
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PCE_NITRO=DTV%XPAR_CE_NITRO)
+ IF (.NOT.ANY(DTV%LDATA_CF_NITRO)) &
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PCF_NITRO=DTV%XPAR_CF_NITRO)
+ IF (.NOT.ANY(DTV%LDATA_CNA_NITRO)) &
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PCNA_NITRO=DTV%XPAR_CNA_NITRO)
!
- DTI%LDATA_GAMMA=.TRUE.
- DTI%LDATA_WRMAX_CF=.TRUE.
- DTI%LDATA_RGL=.TRUE.
- DTI%LDATA_CV=.TRUE.
- DTI%LDATA_ALBNIR_VEG=.TRUE.
- DTI%LDATA_ALBVIS_VEG=.TRUE.
- DTI%LDATA_ALBUV_VEG=.TRUE.
- DTI%LDATA_GMES=.TRUE.
- DTI%LDATA_BSLAI=.TRUE.
- DTI%LDATA_SEFOLD=.TRUE.
- DTI%LDATA_GC=.TRUE.
- DTI%LDATA_LAIMIN=.TRUE.
- DTI%LDATA_F2I=.TRUE.
- DTI%LDATA_CE_NITRO=.TRUE.
- DTI%LDATA_CF_NITRO=.TRUE.
- DTI%LDATA_CNA_NITRO=.TRUE.
+ DTV%LDATA_GAMMA(:) =.TRUE.
+ DTV%LDATA_WRMAX_CF(:) =.TRUE.
+ DTV%LDATA_RGL(:) =.TRUE.
+ DTV%LDATA_CV(:) =.TRUE.
+ DTV%LDATA_ALBNIR_VEG(:)=.TRUE.
+ DTV%LDATA_ALBVIS_VEG(:)=.TRUE.
+ DTV%LDATA_ALBUV_VEG(:) =.TRUE.
+ DTV%LDATA_GMES(:) =.TRUE.
+ DTV%LDATA_BSLAI(:) =.TRUE.
+ DTV%LDATA_SEFOLD(:) =.TRUE.
+ DTV%LDATA_GC(:) =.TRUE.
+ DTV%LDATA_LAIMIN(:) =.TRUE.
+ DTV%LDATA_F2I(:) =.TRUE.
+ DTV%LDATA_CE_NITRO(:) =.TRUE.
+ DTV%LDATA_CF_NITRO(:) =.TRUE.
+ DTV%LDATA_CNA_NITRO(:) =.TRUE.
!
- DTI%LDATA_STRESS=.TRUE.
+ DTV%LDATA_STRESS(:) =.TRUE.
!
- ALLOCATE(DTI%LPAR_STRESS (IG%NDIM,NVEGTYPE))
- DTI%LPAR_STRESS(:,:) = .TRUE.
- IF(I%LAGRI_TO_GRASS)THEN
- DO JVEGTYPE=1,NVEGTYPE
- IF(XSTRESS_NOAGRI(JVEGTYPE)<1.) DTI%LPAR_STRESS(:,JVEGTYPE) = .FALSE.
+ ALLOCATE(DTV%LPAR_STRESS(KDIM,NVEGTYPE))
+ DTV%LPAR_STRESS(:,:) = .TRUE.
+ IF(IO%LAGRI_TO_GRASS)THEN
+ DO JVEG=1,NVEGTYPE
+ IF(XSTRESS_NOAGRI(JVEG)<1.) DTV%LPAR_STRESS(:,JVEG) = .FALSE.
ENDDO
ELSE
- DO JVEGTYPE=1,NVEGTYPE
- IF(XSTRESS(JVEGTYPE)<1.) DTI%LPAR_STRESS(:,JVEGTYPE) = .FALSE.
+ DO JVEG=1,NVEGTYPE
+ IF(XSTRESS(JVEG)<1.) DTV%LPAR_STRESS(:,JVEG) = .FALSE.
ENDDO
ENDIF
!
- IF (.NOT.DTI%LDATA_IRRIG) THEN
- ALLOCATE(DTI%XPAR_IRRIG (IG%NDIM,DTI%NTIME,NVEGTYPE))
- CALL AV_PGD(DTCO, &
- DTI%XPAR_IRRIG(:,KDECADE2,:),PCOVER,XDATA_IRRIG(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE2)
- DTI%LDATA_IRRIG=.TRUE.
+ !
+ IF (.NOT.ANY(DTV%LDATA_IRRIG)) THEN
+ ALLOCATE(DTV%XPAR_IRRIG (KDIM,DTV%NTIME,NVEGTYPE))
+ CALL AV_PGD(DTCO, DTV%XPAR_IRRIG(:,KDECADE2,:),PCOVER,XDATA_IRRIG(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ DTV%LDATA_IRRIG(:)=.TRUE.
ENDIF
!
- IF (.NOT.DTI%LDATA_WATSUP) THEN
- ALLOCATE(DTI%XPAR_WATSUP (IG%NDIM,DTI%NTIME,NVEGTYPE))
- CALL AV_PGD(DTCO, &
- DTI%XPAR_WATSUP(:,KDECADE2,:),PCOVER,XDATA_WATSUP(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE2)
- DTI%LDATA_WATSUP=.TRUE.
+ IF (.NOT.ANY(DTV%LDATA_WATSUP)) THEN
+ ALLOCATE(DTV%XPAR_WATSUP (KDIM,DTV%NTIME,NVEGTYPE))
+ CALL AV_PGD(DTCO, DTV%XPAR_WATSUP(:,KDECADE2,:),PCOVER,XDATA_WATSUP(:,:),YVEG,'ARI',OCOVER,KDECADE=KDECADE)
+ DTV%LDATA_WATSUP(:)=.TRUE.
ENDIF
-!
-! MEB stuff
-!
- IF (.NOT.DTI%LDATA_GAMMAGV) ALLOCATE(DTI%XPAR_GAMMAGV (IG%NDIM,NVEGTYPE))
- IF (.NOT.DTI%LDATA_WRMAX_CFGV) ALLOCATE(DTI%XPAR_WRMAX_CFGV (IG%NDIM,NVEGTYPE))
- IF (.NOT.DTI%LDATA_RGLGV) ALLOCATE(DTI%XPAR_RGLGV (IG%NDIM,NVEGTYPE))
- IF (.NOT.DTI%LDATA_RSMINGV) ALLOCATE(DTI%XPAR_RSMINGV (IG%NDIM,NVEGTYPE))
!
- IF (.NOT.DTI%LDATA_GAMMAGV) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,PGAMMAGV=DTI%XPAR_GAMMAGV)
- IF (.NOT.DTI%LDATA_WRMAX_CFGV) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,PWRMAX_CFGV=DTI%XPAR_WRMAX_CFGV)
- IF (.NOT.DTI%LDATA_RGLGV) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,PRGLGV=DTI%XPAR_RGLGV)
- IF (.NOT.DTI%LDATA_RSMINGV) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,PRSMINGV=DTI%XPAR_RSMINGV)
+ ALLOCATE(TPWORK(KDIM,NVEGTYPE))
+ !
+ IF (.NOT.ANY(DTV%LDATA_SEED_M).OR..NOT.ANY(DTV%LDATA_SEED_D)) THEN
+ ALLOCATE(DTV%XPAR_SEED_M(KDIM,NVEGTYPE))
+ ALLOCATE(DTV%XPAR_SEED_D(KDIM,NVEGTYPE))
+ CALL AV_PGD(TPWORK(:,:),PCOVER,TDATA_SEED(:,:),YVEG,'MAJ',OCOVER,KDECADE=KDECADE)
+ DTV%XPAR_SEED_M(:,:) = FLOAT(TPWORK(:,:)%TDATE%MONTH)
+ DTV%XPAR_SEED_D(:,:) = FLOAT(TPWORK(:,:)%TDATE%DAY)
+ DTV%LDATA_SEED_M(:)=.TRUE.
+ DTV%LDATA_SEED_D(:)=.TRUE.
+ ENDIF
!
- DTI%LDATA_GAMMAGV=.TRUE.
- DTI%LDATA_WRMAX_CFGV=.TRUE.
- DTI%LDATA_RGLGV=.TRUE.
- DTI%LDATA_RSMINGV=.TRUE.
-!
-!LAIGV
- IF (.NOT.DTI%LDATA_LAIGV) THEN
- ALLOCATE(DTI%XPAR_LAIGV(IG%NDIM,DTI%NTIME,NVEGTYPE))
- CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,PLAI=DTI%XPAR_LAI,PLAIMIN_IN=DTI%XPAR_LAIMIN,PLAIGV_OUT=DTI%XPAR_LAIGV)
- DTI%LDATA_LAIGV=.TRUE.
+ IF (.NOT.ANY(DTV%LDATA_REAP_M).OR..NOT.ANY(DTV%LDATA_REAP_D)) THEN
+ ALLOCATE(DTV%XPAR_REAP_M(KDIM,NVEGTYPE))
+ ALLOCATE(DTV%XPAR_REAP_D(KDIM,NVEGTYPE))
+ CALL AV_PGD(TPWORK(:,:),PCOVER,TDATA_REAP(:,:),YVEG,'MAJ',OCOVER,KDECADE=KDECADE)
+ DTV%XPAR_REAP_M(:,:) = FLOAT(TPWORK(:,:)%TDATE%MONTH)
+ DTV%XPAR_REAP_D(:,:) = FLOAT(TPWORK(:,:)%TDATE%DAY)
+ DTV%LDATA_REAP_M(:)=.TRUE.
+ DTV%LDATA_REAP_D(:)=.TRUE.
ENDIF
+ !
+ DEALLOCATE(TPWORK)
+!
+! MEB stuff
!
+ IF (ISIZE_LMEB_PATCH>0) THEN
+
!Z0LITTER
- IF (.NOT.DTI%LDATA_Z0LITTER) THEN
- ALLOCATE(DTI%XPAR_Z0LITTER(IG%NDIM,DTI%NTIME,NVEGTYPE))
- CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,PLAI=DTI%XPAR_LAI,PLAIGV_IN=DTI%XPAR_LAIGV, &
- PZ0LITTER=DTI%XPAR_Z0LITTER)
- DTI%LDATA_Z0LITTER=.TRUE.
- ENDIF
+ IF (.NOT.ANY(DTV%LDATA_Z0LITTER)) THEN
+ ALLOCATE(DTV%XPAR_Z0LITTER(KDIM,DTV%NTIME,NVEGTYPE))
+ CALL INI_DATA_PARAM( PZ0LITTER=DTV%XPAR_Z0LITTER)
+ DTV%LDATA_Z0LITTER(:)=.TRUE.
+ ENDIF
!
!H_VEG
- IF (.NOT.DTI%LDATA_H_VEG .AND. DTI%LDATA_LAI .AND. DTI%LDATA_H_TREE) THEN
- ALLOCATE(DTI%XPAR_H_VEG(IG%NDIM,DTI%NTIME,NVEGTYPE))
- CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,PH_VEG=DTI%XPAR_H_VEG,PLAI=DTI%XPAR_LAI, &
- PH_TREE=DTI%XPAR_H_TREE)
- DTI%LDATA_H_VEG=.TRUE.
- ENDIF
+ IF (.NOT.ANY(DTV%LDATA_H_VEG) .AND. ANY(DTV%LDATA_LAI) .AND. ANY(DTV%LDATA_H_TREE)) THEN
+ ALLOCATE(DTV%XPAR_H_VEG(KDIM,DTV%NTIME,NVEGTYPE))
+ CALL INI_DATA_PARAM(PH_VEG=DTV%XPAR_H_VEG,PLAI=DTV%XPAR_LAI, &
+ PH_TREE=DTV%XPAR_H_TREE)
+ DTV%LDATA_H_VEG(:)=.TRUE.
+ ENDIF
!
!GNDLITTER
- IF (.NOT.DTI%LDATA_GNDLITTER .AND. DTI%LDATA_LAIGV) THEN
- ALLOCATE(DTI%XPAR_GNDLITTER(IG%NDIM,DTI%NTIME,NVEGTYPE))
- CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,PLAI=DTI%XPAR_LAI,PLAIGV_IN=DTI%XPAR_LAIGV, &
- PGNDLITTER=DTI%XPAR_GNDLITTER)
- DTI%LDATA_GNDLITTER=.TRUE.
+ IF (.NOT.ANY(DTV%LDATA_GNDLITTER) ) THEN
+ ALLOCATE(DTV%XPAR_GNDLITTER(KDIM,DTV%NTIME,NVEGTYPE))
+ CALL INI_DATA_PARAM(PGNDLITTER=DTV%XPAR_GNDLITTER)
+ DTV%LDATA_GNDLITTER(:)=.TRUE.
+ ENDIF
+ !
ENDIF
!
ENDIF
!
!
-IF (DTI%LDATA_VEGTYPE) THEN
- IF (.NOT.DTI%LDATA_Z0_O_Z0H) ALLOCATE(DTI%XPAR_Z0_O_Z0H (IG%NDIM,NVEGTYPE))
- IF (.NOT.DTI%LDATA_DMAX) ALLOCATE(DTI%XPAR_DMAX (IG%NDIM,NVEGTYPE))
- IF (.NOT.DTI%LDATA_RE25) ALLOCATE(DTI%XPAR_RE25 (IG%NDIM,NVEGTYPE))
- IF (.NOT.DTI%LDATA_Z0_O_Z0H) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PZ0_O_Z0H=DTI%XPAR_Z0_O_Z0H)
- IF (HPHOTO == 'AST' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT' .OR. HPHOTO=='NCB') THEN
- IF (.NOT.DTI%LDATA_DMAX) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PDMAX_ST=DTI%XPAR_DMAX)
+IF (DTV%LDATA_VEGTYPE) THEN
+ IF (.NOT.ANY(DTV%LDATA_Z0_O_Z0H)) ALLOCATE(DTV%XPAR_Z0_O_Z0H (KDIM,NVEGTYPE))
+ IF (.NOT.ANY(DTV%LDATA_DMAX)) ALLOCATE(DTV%XPAR_DMAX (KDIM,NVEGTYPE))
+ IF (.NOT.ANY(DTV%LDATA_RE25)) ALLOCATE(DTV%XPAR_RE25 (KDIM,NVEGTYPE))
+ IF (.NOT.ANY(DTV%LDATA_Z0_O_Z0H)) &
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PZ0_O_Z0H=DTV%XPAR_Z0_O_Z0H)
+ IF (IO%CPHOTO /= 'NON') THEN
+ IF (.NOT.ANY(DTV%LDATA_DMAX)) &
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PDMAX_ST=DTV%XPAR_DMAX)
ELSE
- IF (.NOT.DTI%LDATA_DMAX) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PDMAX=DTI%XPAR_DMAX)
+ IF (.NOT.ANY(DTV%LDATA_DMAX)) &
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PDMAX=DTV%XPAR_DMAX)
ENDIF
- IF (.NOT.DTI%LDATA_RE25) CALL INI_DATA_PARAM(DTI%XPAR_VEGTYPE,OAGRI_TO_GRASS=I%LAGRI_TO_GRASS,PRE25=DTI%XPAR_RE25)
+ IF (.NOT.ANY(DTV%LDATA_RE25)) &
+ CALL INI_DATA_PARAM(OAGRI_TO_GRASS=IO%LAGRI_TO_GRASS,PRE25=DTV%XPAR_RE25)
!
- DTI%LDATA_Z0_O_Z0H=.TRUE.
- DTI%LDATA_DMAX=.TRUE.
- DTI%LDATA_RE25=.TRUE.
+ DTV%LDATA_Z0_O_Z0H(:)=.TRUE.
+ DTV%LDATA_DMAX(:) =.TRUE.
+ DTV%LDATA_RE25(:) =.TRUE.
ENDIF
!
IF (LHOOK) CALL DR_HOOK('INIT_ISBA_MIXPAR',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/init_isba_sbl.F90 b/src/SURFEX/init_isba_sbl.F90
index 4cc452e9dda4a95c6851d0bae6fb6250bd695c06..103b718339995905544e3b10054c713a13039531 100644
--- a/src/SURFEX/init_isba_sbl.F90
+++ b/src/SURFEX/init_isba_sbl.F90
@@ -3,11 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE INIT_ISBA_SBL(HISBA, HCPSURF, KLVL, PTSTEP, PPA, PPS, PTA, PQA, PRHOA, PU, PV, &
- PDIR_SW, PSCA_SW, PSW_BANDS, PRAIN, PSNOW, &
- PZREF, PUREF, PTG, PPATCH, PWG, PWGI, PZ0, PSSO_SLOPE, &
- PRESA, PVEG, PLAI, PWR, PRGL, PRSMIN, PGAMMA, PWRMAX_CF, &
- PZ0_O_Z0H, PWFC, PWSAT, PTSNOW, PZ, PT, PQ, PWIND, PTKE, PP)
+ SUBROUTINE INIT_ISBA_SBL(IO, K, NP, NPE, SB, PTSTEP, PPA, PPS, PTA, PQA, PRHOA, PU, PV, &
+ PDIR_SW, PSCA_SW, PSW_BANDS, PRAIN, PSNOW, PZREF, PUREF, PSSO_SLOPE )
! #################################################################################
!
!!**** *INIT_WATER_SBL* - inits water SBL profiles
@@ -31,8 +28,14 @@
!! Original 03/2010
!!------------------------------------------------------------------
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_NP_t, ISBA_NPE_t, ISBA_P_t, ISBA_PE_t
+USE MODD_CANOPY_n, ONLY : CANOPY_t
+!
USE MODD_TYPE_SNOW
!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
USE MODD_CSTS, ONLY : XCPD, XRD, XP00, XG, XLVTT
USE MODD_SURF_ATM, ONLY : LNOSOF
USE MODD_CANOPY_TURB, ONLY : XALPSBL
@@ -51,10 +54,13 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
- CHARACTER(LEN=*) , INTENT(IN) :: HISBA ! type of ISBA version
- CHARACTER(LEN=*) , INTENT(IN) :: HCPSURF ! specific heat at surface
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
+!
REAL, INTENT(IN) :: PTSTEP ! timestep of the integration
-INTEGER , INTENT(IN) :: KLVL ! number of levels in canopy
REAL, DIMENSION(:), INTENT(IN) :: PPA ! pressure at forcing level (Pa)
REAL, DIMENSION(:), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa)
REAL, DIMENSION(:), INTENT(IN) :: PTA ! air temperature forcing (K)
@@ -71,43 +77,14 @@ REAL, DIMENSION(:), INTENT(IN) :: PSNOW ! snow precipitation
REAL, DIMENSION(:), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s)
REAL, DIMENSION(:), INTENT(IN) :: PZREF ! height of T,q forcing (m)
REAL, DIMENSION(:), INTENT(IN) :: PUREF ! height of wind forcing (m)
-REAL, DIMENSION(:,:), INTENT(IN):: PTG ! surface and sub-surface soil temperature profile (K)
-REAL, DIMENSION(:,:), INTENT(IN):: PPATCH ! fraction of each tile/patch
-REAL, DIMENSION(:,:), INTENT(IN):: PWG ! soil volumetric water content profile (m3/m3)
-REAL, DIMENSION(:,:), INTENT(IN):: PWGI ! soil liquid water equivalent volumetric
-REAL, DIMENSION(:,:), INTENT(IN):: PZ0 ! roughness length
REAL, DIMENSION(:), INTENT(IN) :: PSSO_SLOPE! slope of S.S.O. (-)
-REAL, DIMENSION(:,:), INTENT(IN):: PRESA ! aerodynamic resistance (s/m)
-REAL, DIMENSION(:,:), INTENT(IN):: PVEG ! vegetation cover fraction (-)
-REAL, DIMENSION(:,:), INTENT(IN):: PLAI ! Leaf Area Index (m2/m2)
-REAL, DIMENSION(:,:), INTENT(IN):: PWR ! liquid water retained on the
-! ! foliage of the vegetation
! ! canopy
-REAL, DIMENSION(:,:), INTENT(IN):: PRGL ! maximum solar radiation
-! ! usable in photosynthesis (W/m2)
-REAL, DIMENSION(:,:), INTENT(IN):: PRSMIN ! minimum stomatal resistance (s/m)
-REAL, DIMENSION(:,:), INTENT(IN):: PGAMMA ! coefficient for the calculation
-! ! of the surface stomatal
-! ! resistance
-REAL, DIMENSION(:,:), INTENT(IN):: PWRMAX_CF ! coefficient for maximum water
-! ! interception
-! ! storage capacity on the vegetation (-)
-REAL, DIMENSION(:,:), INTENT(IN):: PZ0_O_Z0H ! ratio of surface roughness lengths
-! ! (momentum to heat) (-)
-REAL, DIMENSION(:,:), INTENT(IN):: PWFC ! field capacity volumetric water content
-! ! profile (m3/m3)
-REAL, DIMENSION(:,:), INTENT(IN):: PWSAT ! porosity profile (m3/m3)
-TYPE(SURF_SNOW) , INTENT(IN):: PTSNOW ! snow state
-REAL, DIMENSION(:,:), INTENT(IN):: PZ ! height of middle of each level grid (m)
-!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PT ! temperature at each level in SBL (m/s)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PQ ! humidity at each level in SBL (kg/m3)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PWIND! wind at each level in SBL (m/s)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTKE ! Tke at each level in SBL (m2/s2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PP ! pressure at each level in SBL (kg/m3)
!
!* 0.2 declarations of local variables
!
+TYPE(ISBA_PE_t), POINTER :: PEK
+TYPE(ISBA_P_t), POINTER :: PK
+!
!* forcing variables
!
REAL, DIMENSION(SIZE(PTA)) :: ZWIND ! lowest atmospheric level wind speed (m/s)
@@ -147,8 +124,6 @@ REAL, DIMENSION(SIZE(PTA)) ::ZPSNV
REAL, DIMENSION(SIZE(PTA)) ::ZPSNV_A
REAL, DIMENSION(SIZE(PTA)) ::ZPSN
REAL, DIMENSION(SIZE(PTA)) ::ZSNOWALB
-REAL, DIMENSION(SIZE(PTA),SIZE(PTSNOW%WSNOW,2)) ::ZSNOWSWE
-REAL, DIMENSION(SIZE(PTA),SIZE(PTSNOW%WSNOW,2)) ::ZSNOWRHO
REAL, DIMENSION(SIZE(PTA)) ::ZFFG
REAL, DIMENSION(SIZE(PTA)) ::ZFFGNOS
REAL, DIMENSION(SIZE(PTA)) ::ZFFV
@@ -166,80 +141,190 @@ REAL, DIMENSION(SIZE(PTA)) ::ZDELTA
REAL, DIMENSION(SIZE(PTA)) ::ZWRMAX
REAL, DIMENSION(SIZE(PTA)) ::ZCLS_WIND_ZON
REAL, DIMENSION(SIZE(PTA)) ::ZCLS_WIND_MER
-REAL, DIMENSION(SIZE(PTA),SIZE(PTSNOW%WSNOW,2)) ::ZSUM_LAYER
REAL, DIMENSION(SIZE(PTA)) ::ZSUM
REAL, DIMENSION(SIZE(PTA)) :: ZLEG_DELTA ! soil evaporation delta fn
REAL, DIMENSION(SIZE(PTA)) :: ZLEGI_DELTA ! soil sublimation delta fn
REAL, DIMENSION(SIZE(PTA)) :: ZLVTT
!
+REAL, DIMENSION(:,:), ALLOCATABLE ::ZSNOWSWE
+REAL, DIMENSION(:,:), ALLOCATABLE ::ZSNOWRHO
+REAL, DIMENSION(:,:), ALLOCATABLE ::ZSUM_LAYER
+!
INTEGER :: JSWB
-INTEGER :: JLAYER
-INTEGER :: JPATCH
+INTEGER :: JL, JI, JP, IMASK
+INTEGER :: ISNOW_LAYER
!
-REAL, DIMENSION(SIZE(PTA),SIZE(PPATCH,2)) ::ZWSNOW
+REAL, DIMENSION(SIZE(PTA),IO%NPATCH) ::ZWSNOW
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('INIT_ISBA_SBL',0,ZHOOK_HANDLE)
-!
+!
+ZTS (:) = 0.
+ZWG (:) = 0.
+ZWGI(:) = 0.
+ZZ0 (:) = 0.
+!
+ZZ0H(:) = 0.
+ZVEG(:) = 0.
+!
+ZRESA(:) = 0.
+!
+ZRGL (:) = 0.
+ZRSMIN(:) = 0.
+ZGAMMA(:) = 0.
+!
!Means over patches
-ZTS = SUM(PTG(:,:)*PPATCH(:,:) ,DIM=2)
-ZWG = SUM(PWG(:,:)*PPATCH(:,:) ,DIM=2)
-ZWGI = SUM(PWGI(:,:)*PPATCH(:,:),DIM=2)
-ZZ0 = SUM(PPATCH(:,:)*PZ0(:,:) ,DIM=2)
+DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+
+ DO JI=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ !
+ ZTS (IMASK) = ZTS (IMASK) + PEK%XTG (JI,1) * PK%XPATCH(JI)
+ ZWG (IMASK) = ZWG (IMASK) + PEK%XWG (JI,1) * PK%XPATCH(JI)
+ ZWGI(IMASK) = ZWGI(IMASK) + PEK%XWGI(JI,1) * PK%XPATCH(JI)
+ ZZ0 (IMASK) = ZZ0 (IMASK) + PEK%XZ0(JI) * PK%XPATCH(JI)
+ !
+ ZZ0H(IMASK) = ZZ0H(IMASK) + PK%XPATCH(JI) * PEK%XZ0 (JI) / PK%XZ0_O_Z0H(JI)
+ ZVEG(IMASK) = ZVEG(IMASK) + PK%XPATCH(JI) * PEK%XVEG(JI)
+ !
+ ZRESA(IMASK) = ZRESA(IMASK) + PK%XPATCH(JI) * PEK%XRESA(JI)
+ !
+ ZRGL (IMASK) = ZRGL (IMASK) + PK%XPATCH(JI) * PEK%XRGL (JI)
+ ZRSMIN(IMASK) = ZRSMIN(IMASK) + PK%XPATCH(JI) * PEK%XRSMIN(JI)
+ ZGAMMA(IMASK) = ZGAMMA(IMASK) + PK%XPATCH(JI) * PEK%XGAMMA(JI)
+ !
+ ENDDO
+ENDDO
!
!We choose to set ZZ0EFF and ZZ0_WITH_SNOW equal to ZZ0
-ZZ0EFF = ZZ0
-ZZ0_WITH_SNOW = ZZ0
-ZZ0H(:) = SUM(PPATCH(:,:) * PZ0(:,:)/PZ0_O_Z0H(:,:),DIM=2)
-ZVEG(:) = SUM(PPATCH(:,:) * PVEG(:,:) ,DIM=2)
-!
-ZP_SLOPE_COS(:) = 1./SQRT(1.+PSSO_SLOPE(:)**2)
-IF (LNOSOF) ZP_SLOPE_COS(:) = 1.0
+ZZ0EFF(:) = ZZ0(:)
+ZZ0_WITH_SNOW(:) = ZZ0(:)
+!
+!
+ZLAI(:) = 0.
+ZWRMAX_CF(:) = 0.
+ZWR(:) = 0.
+!
+DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+
+ DO JI=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ !
+ IF (ZVEG(JI)>0.) THEN
+ ZLAI (IMASK) = ZLAI (IMASK) + PK%XPATCH(JI) * PEK%XVEG(JI) * PEK%XLAI(JI)
+ ZWRMAX_CF(IMASK) = ZWRMAX_CF(IMASK) + PK%XPATCH(JI) * PEK%XVEG(JI) * PEK%XWRMAX_CF(JI)
+ ZWR (IMASK) = ZWR (IMASK) + PK%XPATCH(JI) * PEK%XVEG(JI) * PEK%XWR(JI)
+ ELSEIF (JP==1) THEN
+ ZLAI (IMASK) = PEK%XLAI (JI)
+ ZWRMAX_CF(IMASK) = PEK%XWRMAX_CF(JI)
+ ZWR (IMASK) = PEK%XWR (JI)
+ ENDIF
+ !
+ ENDDO
+ENDDO
!
-ZRESA(:) = SUM(PPATCH(:,:)*PRESA(:,:),DIM=2)
-WHERE(ZVEG(:)>0)
- ZLAI (:)= SUM(PPATCH(:,:)*PVEG(:,:)*PLAI(:,:) ,DIM=2,MASK=PVEG(:,:)>0) / ZVEG(:)
- ZWRMAX_CF(:)= SUM(PPATCH(:,:)*PVEG(:,:)*PWRMAX_CF(:,:),DIM=2,MASK=PVEG(:,:)>0) / ZVEG(:)
- ZWR (:)= SUM(PPATCH(:,:)*PVEG(:,:)*PWR(:,:) ,DIM=2,MASK=PVEG(:,:)>0) / ZVEG(:)
-ELSEWHERE
- ZLAI (:) = PLAI (:,1)
- ZWRMAX_CF(:) = PWRMAX_CF(:,1)
- ZWR (:) = PWR (:,1)
+WHERE (ZVEG(:)>0)
+ ZLAI (:)= ZLAI (:) / ZVEG(:)
+ ZWRMAX_CF(:)= ZWRMAX_CF(:) / ZVEG(:)
+ ZWR (:)= ZWR (:) / ZVEG(:)
ENDWHERE
!
+!
+ISNOW_LAYER = NPE%AL(1)%TSNOW%NLAYER
+ALLOCATE(ZSNOWSWE (SIZE(PTA),ISNOW_LAYER))
+ALLOCATE(ZSUM_LAYER(SIZE(PTA),ISNOW_LAYER))
+ALLOCATE(ZSNOWRHO (SIZE(PTA),ISNOW_LAYER))
+ZSNOWSWE (:,:) = 0.
ZSUM_LAYER(:,:) = 0.
-ZSUM (:) = 0.
-!
-DO JLAYER=1,SIZE(PTSNOW%WSNOW,2)
- ZSNOWSWE (:,JLAYER) = SUM(PPATCH(:,:)*PTSNOW%WSNOW(:,JLAYER,:),DIM=2)
- ZSUM_LAYER(:,JLAYER) = SUM(PPATCH(:,:),DIM=2,MASK=PTSNOW%WSNOW(:,JLAYER,:)>0)
- WHERE(ZSUM_LAYER(:,JLAYER)>0)
- ZSNOWRHO(:,JLAYER)= SUM( PPATCH(:,:)*PTSNOW%RHO(:,JLAYER,:), DIM=2, &
- MASK=PTSNOW%WSNOW(:,JLAYER,:)>0) / ZSUM_LAYER(:,JLAYER)
- ELSEWHERE
- ZSNOWRHO(:,JLAYER)=PTSNOW%RHO(:,JLAYER,1)
- ENDWHERE
+ZSNOWRHO (:,:) = 0.
+!
+DO JL=1,ISNOW_LAYER
+ !
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+
+ DO JI=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ !
+ IF (PEK%TSNOW%WSNOW(JI,JL)>0.) THEN
+ ZSNOWSWE (IMASK,JL) = ZSNOWSWE (IMASK,JL) + PK%XPATCH(JI) * PEK%TSNOW%WSNOW(JI,JL)
+ ZSUM_LAYER(IMASK,JL) = ZSUM_LAYER(IMASK,JL) + PK%XPATCH(JI)
+ ENDIF
+ !
+ ENDDO
+ ENDDO
+ !
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+
+ DO JI=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ !
+ IF (ZSUM_LAYER(IMASK,JL)>0.) THEN
+ ZSNOWRHO(IMASK,JL) = ZSNOWRHO(IMASK,JL) + PK%XPATCH(JI) * PEK%TSNOW%RHO(JI,JL)
+ ELSEIF (JP==1) THEN
+ ZSNOWRHO(IMASK,JL) = PEK%TSNOW%RHO(JI,JL)
+ ENDIF
+ !
+ ENDDO
+ ENDDO
+ !
END DO
!
-ZSUM(:)=SUM(ZSUM_LAYER(:,:),DIM=2)
+WHERE (ZSNOWSWE(:,:)==0.) ZSNOWRHO(:,:) = XUNDEF
+WHERE (ZSUM_LAYER(:,:)>0.)
+ ZSNOWRHO(:,:) = ZSNOWRHO(:,:) / ZSUM_LAYER(:,:)
+END WHERE
!
+ZSUM(:)=SUM(ZSUM_LAYER(:,:),DIM=2)
+DEALLOCATE(ZSUM_LAYER)
+!
ZWSNOW(:,:) = 0.
-DO JPATCH=1,SIZE(PTSNOW%WSNOW,3)
- DO JLAYER=1,SIZE(PTSNOW%WSNOW,2)
- ZWSNOW(:,JPATCH) = ZWSNOW(:,JPATCH) + PTSNOW%WSNOW(:,JLAYER,JPATCH)
+DO JL = 1,ISNOW_LAYER
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+
+ DO JI=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ !
+ ZWSNOW(IMASK,JP) = ZWSNOW(IMASK,JP) + PEK%TSNOW%WSNOW(JI,JL)
+ !
+ ENDDO
ENDDO
ENDDO
!
+ZSNOWALB(:) = 0.
+DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+
+ DO JI=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ !
+
+ IF (ZSUM(IMASK)>0.) THEN
+ IF (ZWSNOW(IMASK,JP)>0.) THEN
+ ZSNOWALB(IMASK) = ZSNOWALB(IMASK) + PK%XPATCH(JI) * PEK%TSNOW%ALB(JI)
+ ENDIF
+ ELSEIF (JP==1) THEN
+ ZSNOWALB(IMASK) = PEK%TSNOW%ALB(JI)
+ ENDIF
+ !
+ ENDDO
+ENDDO
+!
WHERE(ZSUM(:)>0)
- ZSNOWALB(:) = SUM(PPATCH(:,:)*PTSNOW%ALB(:,:),DIM=2,MASK=ZWSNOW(:,:)>0) / ZSUM(:)
-ELSEWHERE
- ZSNOWALB(:) = PTSNOW%ALB(:,1)
+ ZSNOWALB(:) = ZSNOWALB(:) / ZSUM(:)
ENDWHERE
!
-ZRGL (:) = SUM(PPATCH(:,:) * PRGL (:,:),DIM=2)
-ZRSMIN(:) = SUM(PPATCH(:,:) * PRSMIN(:,:),DIM=2)
-ZGAMMA(:) = SUM(PPATCH(:,:) * PGAMMA(:,:),DIM=2)
!
ZEXNA(:) = (PPA(:)/XP00)**(XRD/XCPD)
ZEXNS(:) = (PPS(:)/XP00)**(XRD/XCPD)
@@ -247,10 +332,10 @@ ZQA (:) = PQA(:) / PRHOA(:)
ZWIND(:) = SQRT(PU**2+PV**2)
!
!We compute the snow fractions
- CALL ISBA_SNOW_FRAC(PTSNOW%SCHEME, &
- ZSNOWSWE, ZSNOWRHO, ZSNOWALB, &
- ZVEG, ZLAI, ZZ0, &
- ZPSN, ZPSNV_A, ZPSNG, ZPSNV )
+ CALL ISBA_SNOW_FRAC(PEK%TSNOW%SCHEME, ZSNOWSWE, ZSNOWRHO, ZSNOWALB, &
+ ZVEG, ZLAI, ZZ0, ZPSN, ZPSNV_A, ZPSNG, ZPSNV )
+!
+DEALLOCATE(ZSNOWSWE, ZSNOWRHO)
!
!We compute total shortwave incoming radiation needed by veg
ZP_GLOBAL_SW(:) = 0.
@@ -258,6 +343,7 @@ DO JSWB=1,SIZE(PSW_BANDS)
ZP_GLOBAL_SW(:) = ZP_GLOBAL_SW(:) + (PDIR_SW(:,JSWB) + PSCA_SW(:,JSWB))
END DO
!
+!
!We choose the case HPHOTO=='NON' and a humid soil (ZF2=1) to compute ZRS
ZF2(:)=1.0
CALL VEG(ZP_GLOBAL_SW, PTA, ZQA, PPS, ZRGL, ZLAI, ZRSMIN, ZGAMMA, ZF2, ZRS)
@@ -273,31 +359,33 @@ ZFF (:) = 0.0
!
ZF5 (:) = 1.0
ZLVTT (:) = XLVTT
+!
+ZP_SLOPE_COS(:) = 1./SQRT(1.+PSSO_SLOPE(:)**2)
+IF (LNOSOF) ZP_SLOPE_COS(:) = 1.0
+!
!We compute ZCD, ZCH and ZRI
- CALL DRAG(HISBA, PTSNOW%SCHEME, HCPSURF, PTSTEP, &
- ZTS, ZWG, ZWGI, ZEXNS, ZEXNA, PTA, &
- ZWIND, ZQA, PRAIN, PSNOW, PPS, ZRS, &
- ZVEG, ZZ0, ZZ0EFF, ZZ0H, PWFC(:,1), PWSAT(:,1), &
- ZPSNG, ZPSNV, PZREF, PUREF, ZP_SLOPE_COS, ZDELTA, ZF5, &
- ZRESA, ZCH, ZCD, ZCDN, ZRI, ZHUG, ZHUGI, ZHV, ZHU, ZCPS, &
- ZQS, ZFFG, ZFFV, ZFF, ZFFGNOS, ZFFVNOS, ZLEG_DELTA, ZLEGI_DELTA, &
- ZWR, PRHOA, ZLVTT )
+ CALL DRAG(IO%CISBA, PEK%TSNOW%SCHEME, IO%CCPSURF, PTSTEP, ZTS, ZWG, ZWGI, &
+ ZEXNS, ZEXNA, PTA, ZWIND, ZQA, PRAIN, PSNOW, PPS, ZRS, ZVEG, &
+ ZZ0, ZZ0EFF, ZZ0H, K%XWFC(:,1), K%XWSAT(:,1), ZPSNG, ZPSNV, &
+ PZREF, PUREF, ZP_SLOPE_COS, ZDELTA, ZF5, ZRESA, ZCH, ZCD, ZCDN, &
+ ZRI, ZHUG, ZHUGI, ZHV, ZHU, ZCPS, ZQS, ZFFG, ZFFV, ZFF, ZFFGNOS,&
+ ZFFVNOS, ZLEG_DELTA, ZLEGI_DELTA, ZWR, PRHOA, ZLVTT )
!
!Initialisation of T, Q, Wind and TKE on all canopy levels
-DO JLAYER=1,KLVL
+DO JL=1,SB%NLVL
!
CALL CLS_TQ(PTA, ZQA, PPA, PPS, PZREF, ZCD, ZCH, ZRI, ZTS, ZHU, ZZ0H, &
- PZ(:,JLAYER), ZTNM, ZQNM, ZHUNM )
+ SB%XZ(:,JL), ZTNM, ZQNM, ZHUNM )
!
- PT(:,JLAYER)=ZTNM
- PQ(:,JLAYER)=ZQNM
+ SB%XT(:,JL)=ZTNM
+ SB%XQ(:,JL)=ZQNM
!
- CALL CLS_WIND(PU, PV, PUREF, ZCD, ZCDN, ZRI, PZ(:,JLAYER), &
+ CALL CLS_WIND(PU, PV, PUREF, ZCD, ZCDN, ZRI, SB%XZ(:,JL), &
ZCLS_WIND_ZON, ZCLS_WIND_MER )
!
- PWIND(:,JLAYER) = SQRT( ZCLS_WIND_ZON(:)**2 + ZCLS_WIND_MER(:)**2 )
- PTKE (:,JLAYER) = XALPSBL * ZCD(:) * ( PU(:)**2 + PV(:)**2 )
- PP (:,JLAYER) = PPA(:) + XG * PRHOA(:) * (PZ(:,KLVL) - PZ(:,JLAYER))
+ SB%XU (:,JL) = SQRT( ZCLS_WIND_ZON(:)**2 + ZCLS_WIND_MER(:)**2 )
+ SB%XTKE (:,JL) = XALPSBL * ZCD(:) * ( PU(:)**2 + PV(:)**2 )
+ SB%XP (:,JL) = PPA(:) + XG * PRHOA(:) * (SB%XZ(:,SB%NLVL) - SB%XZ(:,JL))
!
ENDDO
!
diff --git a/src/SURFEX/init_isban.F90 b/src/SURFEX/init_isban.F90
index 467915efc4ab05709f3ef29a98836f8bcd4d676c..4f6d848f80c02839be9d8c423126dc56629c2614 100644
--- a/src/SURFEX/init_isban.F90
+++ b/src/SURFEX/init_isban.F90
@@ -3,15 +3,12 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#############################################################
-SUBROUTINE INIT_ISBA_n (DTCO, DGU, UG, U, IM, DTZ, DST, SLT, SV, GCP,&
- HPROGRAM,HINIT,OLAND_USE, &
- KI,KSV,KSW, &
- HSV,PCO2,PRHOA, &
- PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD, PTSURF, &
- KYEAR, KMONTH,KDAY, PTIME, &
- HATMFILE,HATMFILETYPE, &
- HTEST )
+SUBROUTINE INIT_ISBA_n (DTCO, OREAD_BUDGETC, UG, U, USS, GCP, IM, DTZ,&
+ NDST, SLT, SV, HPROGRAM, HINIT, OLAND_USE, &
+ KI, KSV, KSW, HSV, PCO2, PRHOA, PZENITH, &
+ PAZIM, PSW_BANDS, PDIR_ALB, PSCA_ALB, PEMIS, &
+ PTSRAD, PTSURF, KYEAR, KMONTH, KDAY, PTIME, &
+ TPDATE_END, HATMFILE, HATMFILETYPE, HTEST )
!#############################################################
!
!!**** *INIT_ISBA_n* - routine to initialize ISBA
@@ -65,15 +62,16 @@ SUBROUTINE INIT_ISBA_n (DTCO, DGU, UG, U, IM, DTZ, DST, SLT, SV, GCP,&
USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
USE MODD_DATA_TSZ0_n, ONLY : DATA_TSZ0_t
-USE MODD_DST_n, ONLY : DST_t
+USE MODD_DST_n, ONLY : DST_NP_t
USE MODD_SLT_n, ONLY : SLT_t
USE MODD_SV_n, ONLY : SV_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
!
+USE MODD_TYPE_DATE_SURF, ONLY : DATE
!
USE MODD_DATA_COVER, ONLY : XDATA_LAI, XDATA_H_TREE, &
XDATA_ALBNIR_VEG, XDATA_ALBVIS_VEG, &
@@ -89,8 +87,8 @@ USE MODD_DATA_COVER, ONLY : XDATA_LAI, XDATA_H_TREE,
XDATA_GMES_ST, XDATA_BSLAI_ST, XDATA_SEFOLD_ST, &
XDATA_GC_ST, XDATA_DMAX_ST
!
+USE MODD_WRITE_SURF_ATM, ONLY : LSPLIT_PATCH
USE MODD_SURF_ATM, ONLY : LCPL_GCM
-!
USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
USE MODD_AGRI, ONLY : LAGRIP
!
@@ -122,7 +120,6 @@ USE MODI_READ_PGD_ISBA_n
USE MODI_COMPUTE_ISBA_PARAMETERS
USE MODI_READ_NAM_PREP_ISBA_n
USE MODI_INI_DATA_PARAM
-USE MODI_CONVERT_COVER_ISBA
!
USE MODI_SET_SURFEX_FILEIN
!
@@ -137,16 +134,19 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+LOGICAL, INTENT(IN) :: OREAD_BUDGETC
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
+TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
+TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
+!
TYPE(DATA_TSZ0_t), INTENT(INOUT) :: DTZ
-TYPE(DST_t), INTENT(INOUT) :: DST
+TYPE(DST_NP_t), INTENT(INOUT) :: NDST
TYPE(SLT_t), INTENT(INOUT) :: SLT
TYPE(SV_t), INTENT(INOUT) :: SV
-TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize
@@ -171,6 +171,7 @@ INTEGER, INTENT(IN) :: KMONTH ! current month (UTC)
INTEGER, INTENT(IN) :: KDAY ! current day (UTC)
REAL, INTENT(IN) :: PTIME ! current time since
! midnight (UTC, s)
+TYPE(DATE), INTENT(INOUT) :: TPDATE_END
!
CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! atmospheric file name
CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! atmospheric file type
@@ -188,6 +189,9 @@ INTEGER :: ILUOUT ! unit of output listing file
INTEGER :: IVERSION ! surface version
INTEGER :: IRESP ! return code
INTEGER :: ISIZE_LMEB_PATCH ! Number of patches where multi-energy balance should be applied
+!
+ CHARACTER(LEN=3) :: YSNOW_SCHEME
+INTEGER :: ISNOW_NLAYER, JP
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -212,41 +216,37 @@ IF (LNAM_READ) THEN
! 0.1. Hard defaults
!
- CALL DEFAULT_ISBA(IM%I%XTSTEP, IM%I%XOUT_TSTEP, &
- IM%I%CROUGH,IM%I%CRUNOFF,IM%I%CALBEDO,IM%I%CSCOND, &
- IM%I%CC1DRY, IM%I%CSOILFRZ, IM%I%CDIFSFCOND, IM%I%CSNOWRES, &
- IM%I%CCPSURF, IM%I%XCGMAX, IM%I%XCDRAG, IM%I%CKSAT, IM%I%LSOC, &
- IM%I%CRAIN, IM%I%CHORT, IM%I%LGLACIER, IM%I%LCANOPY_DRAG, &
- IM%I%LVEGUPD, IM%I%LSPINUPCARBS, IM%I%LSPINUPCARBW, &
- IM%I%XSPINMAXS, IM%I%XSPINMAXW, IM%I%XCO2_START, IM%I%XCO2_END, &
- IM%I%NNBYEARSPINS, IM%I%NNBYEARSPINW, IM%I%LNITRO_DILU )
+ CALL DEFAULT_ISBA(IM%O%XTSTEP, IM%O%XOUT_TSTEP, &
+ IM%O%CRUNOFF, IM%O%CSCOND, &
+ IM%O%CC1DRY, IM%O%CSOILFRZ, IM%O%CDIFSFCOND, IM%O%CSNOWRES, &
+ IM%O%CCPSURF, IM%O%XCGMAX, IM%O%XCDRAG, IM%O%CKSAT, IM%O%LSOC, &
+ IM%O%CRAIN, IM%O%CHORT, IM%O%LGLACIER, IM%O%LCANOPY_DRAG, &
+ IM%O%LVEGUPD, IM%O%LSPINUPCARBS, IM%O%LSPINUPCARBW, &
+ IM%O%XSPINMAXS, IM%O%XSPINMAXW, IM%O%XCO2_START, IM%O%XCO2_END, &
+ IM%O%NNBYEARSPINS, IM%O%NNBYEARSPINW, IM%O%LNITRO_DILU )
!
CALL DEFAULT_CH_DEP(IM%CHI%CCH_DRY_DEP)
CALL DEFAULT_CH_BIO_FLUX(IM%CHI%LCH_BIO_FLUX)
- CALL DEFAULT_DIAG_ISBA(IM%DGI%N2M,IM%DGI%LSURF_BUDGET,IM%DGI%L2M_MIN_ZS,IM%DGI%LRAD_BUDGET, &
- IM%DGI%LCOEF,IM%DGI%LSURF_VARS,IM%DGEI%LSURF_EVAP_BUDGET, &
- IM%DGMI%LSURF_MISC_BUDGET,IM%DGMI%LSURF_DIAG_ALBEDO, &
- IM%DGEI%LSURF_BUDGETC,IM%DGMI%LSURF_MISC_DIF,IM%DGI%LPATCH_BUDGET,&
- IM%DGI%LPGD,IM%DGEI%LRESET_BUDGETC,IM%DGEI%LWATER_BUDGET, &
- IM%DGI%XDIAG_TSTEP )
+ CALL DEFAULT_DIAG_ISBA(IM%ID%O%N2M, IM%ID%O%LSURF_BUDGET, IM%ID%O%L2M_MIN_ZS, IM%ID%O%LRAD_BUDGET, &
+ IM%ID%O%LCOEF, IM%ID%O%LSURF_VARS, IM%ID%DE%LSURF_EVAP_BUDGET, &
+ IM%ID%DM%LSURF_MISC_BUDGET, IM%ID%DM%LSURF_DIAG_ALBEDO, &
+ IM%ID%O%LSURF_BUDGETC, IM%ID%DM%LSURF_MISC_DIF, IM%ID%O%LPATCH_BUDGET, &
+ IM%ID%O%LPGD, IM%ID%O%LRESET_BUDGETC, IM%ID%DE%LWATER_BUDGET, &
+ IM%ID%DM%LPROSNOW,IM%ID%DM%LVOLUMETRIC_SNOWLIQ,IM%ID%O%XDIAG_TSTEP )
!
- CALL DEFAULT_CROCUS(IM%I%LSNOWDRIFT,IM%I%LSNOWDRIFT_SUBLIM,IM%I%LSNOW_ABS_ZENITH,&
- IM%I%CSNOWMETAMO,IM%I%CSNOWRAD)
+ CALL DEFAULT_CROCUS(IM%O%LSNOWDRIFT, IM%O%LSNOWDRIFT_SUBLIM, IM%O%LSNOW_ABS_ZENITH, &
+ IM%O%CSNOWMETAMO, IM%O%CSNOWRAD)
!
ENDIF
!
! 0.2. Defaults from file header
!
- CALL READ_DEFAULT_ISBA_n(IM%CHI, IM%DGEI, IM%DGI, IM%DGMI, IM%I, &
- HPROGRAM)
+ CALL READ_DEFAULT_ISBA_n(IM%CHI, IM%ID%DE, IM%ID%O, IM%ID%DM, IM%O, HPROGRAM)
!
- CALL READ_ISBA_CONF_n(IM%CHI, IM%DGEI, IM%DGI, IM%DGMI, IM%I, &
- HPROGRAM)
+ CALL READ_ISBA_CONF_n(IM%CHI, IM%ID%DE, IM%ID%O, IM%ID%DM, IM%O, HPROGRAM)
!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'FULL ','ISBA ','READ ')
- CALL READ_SURF(&
- HPROGRAM,'VERSION',IVERSION,IRESP)
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'FULL ','ISBA ','READ ')
+ CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
CALL END_IO_SURF_n(HPROGRAM)
!
!* 1. Reading of configuration:
@@ -254,53 +254,52 @@ ENDIF
!
!* initialization of snow and carbon schemes
!
-IM%I%NNBYEARSOLD = 1
-IM%I%NSPINS = 1
-IM%I%NSPINW = 1
+IM%O%NNBYEARSOLD = 1
+IM%O%NSPINS = 1
+IM%O%NSPINW = 1
!
IF (HINIT=='PRE') THEN
- CALL READ_PREP_ISBA_SNOW(HPROGRAM,IM%I%TSNOW%SCHEME,IM%I%TSNOW%NLAYER)
+ CALL READ_PREP_ISBA_SNOW(HPROGRAM,YSNOW_SCHEME,ISNOW_NLAYER)
!
!* initialization of soil carbon scheme
!
- CALL READ_PREP_ISBA_CARBON(HPROGRAM,IM%I%CRESPSL)
+ CALL READ_PREP_ISBA_CARBON(HPROGRAM,IM%O%CRESPSL)
!
- IF (IM%I%CRESPSL=='CNT') THEN
- IM%I%NNLITTER = 2
- IM%I%NNLITTLEVS = 2
- IM%I%NNSOILCARB = 3
+ IF (IM%O%CRESPSL=='CNT') THEN
+ IM%O%NNLITTER = 2
+ IM%O%NNLITTLEVS = 2
+ IM%O%NNSOILCARB = 3
ELSE
- IM%I%NNLITTER = 0
- IM%I%NNLITTLEVS = 0
- IM%I%NNSOILCARB = 0
+ IM%O%NNLITTER = 0
+ IM%O%NNLITTLEVS = 0
+ IM%O%NNSOILCARB = 0
ENDIF
ELSEIF (HINIT=='ALL') THEN
-!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'NATURE','ISBA ','READ ')
-!
+ !
+ CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'NATURE','ISBA ','READ ')
+ !
IF (IVERSION<6) THEN
- IM%I%CRESPSL='DEF'
+ IM%O%CRESPSL='DEF'
ELSE
- CALL READ_SURF(&
- HPROGRAM,'RESPSL',IM%I%CRESPSL,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'NLITTER',IM%I%NNLITTER,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'NLITTLEVS',IM%I%NNLITTLEVS,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'NSOILCARB',IM%I%NNSOILCARB,IRESP)
- IF(IVERSION>=7.AND.(IM%I%LSPINUPCARBS.OR.IM%I%LSPINUPCARBW))THEN
- CALL READ_SURF(&
- HPROGRAM,'NBYEARSOLD',IM%I%NNBYEARSOLD,IRESP)
+ CALL READ_SURF(HPROGRAM,'RESPSL',IM%O%CRESPSL,IRESP)
+ CALL READ_SURF(HPROGRAM,'NLITTER',IM%O%NNLITTER,IRESP)
+ CALL READ_SURF(HPROGRAM,'NLITTLEVS',IM%O%NNLITTLEVS,IRESP)
+ CALL READ_SURF(HPROGRAM,'NSOILCARB',IM%O%NNSOILCARB,IRESP)
+ IF(IVERSION>=7.AND.(IM%O%LSPINUPCARBS.OR.IM%O%LSPINUPCARBW))THEN
+ CALL READ_SURF(HPROGRAM,'NBYEARSOLD',IM%O%NNBYEARSOLD,IRESP)
ELSE
- IM%I%NNBYEARSOLD=NUNDEF
+ IM%O%NNBYEARSOLD=NUNDEF
ENDIF
ENDIF
-!
+ !
CALL END_IO_SURF_n(HPROGRAM)
+ !
+ENDIF
!
+IF (IM%O%CISBA/="DIF") THEN
+ IM%O%NLAYER_DUN = 2
+ IM%O%NLAYER_HORT = 2
ENDIF
!
!-------------------------------------------------------------------------------
@@ -313,25 +312,21 @@ ENDIF
!
SELECT CASE (HINIT)
CASE ('PGD')
- IM%I%TTIME%TDATE%YEAR = NUNDEF
- IM%I%TTIME%TDATE%MONTH= NUNDEF
- IM%I%TTIME%TDATE%DAY = NUNDEF
- IM%I%TTIME%TIME = XUNDEF
+ IM%S%TTIME%TDATE%YEAR = NUNDEF
+ IM%S%TTIME%TDATE%MONTH= NUNDEF
+ IM%S%TTIME%TDATE%DAY = NUNDEF
+ IM%S%TTIME%TIME = XUNDEF
CASE ('PRE')
- CALL PREP_CTRL_ISBA(IM%DGI%N2M,IM%DGI%LSURF_BUDGET,IM%DGI%L2M_MIN_ZS,IM%DGI%LRAD_BUDGET,&
- IM%DGI%LCOEF,IM%DGI%LSURF_VARS,&
- IM%DGEI%LSURF_EVAP_BUDGET,IM%DGMI%LSURF_MISC_BUDGET,IM%DGEI%LSURF_BUDGETC, &
- IM%DGI%LPATCH_BUDGET,IM%DGMI%LSURF_MISC_DIF,ILUOUT )
+ CALL PREP_CTRL_ISBA(IM%ID%O, IM%ID%DE%LSURF_EVAP_BUDGET, IM%ID%DM%LSURF_MISC_BUDGET, &
+ IM%ID%DM%LSURF_MISC_DIF, ILUOUT)
IF (LNAM_READ) CALL READ_NAM_PREP_ISBA_n(HPROGRAM)
- CALL READ_ISBA_DATE(&
- HPROGRAM,HINIT,ILUOUT,HATMFILE,HATMFILETYPE,KYEAR,KMONTH,KDAY,PTIME,IM%I%TTIME)
+ CALL READ_ISBA_DATE(HPROGRAM, HINIT, ILUOUT, HATMFILE, HATMFILETYPE, KYEAR, KMONTH, KDAY, PTIME, IM%S%TTIME)
+ TPDATE_END = IM%S%TTIME%TDATE
CASE DEFAULT
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'NATURE','ISBA ','READ ')
- CALL READ_SURF(&
- HPROGRAM,'DTCUR',IM%I%TTIME,IRESP)
+ CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'FULL ','SURF ','READ ')
+ CALL READ_SURF(HPROGRAM,'DTCUR',IM%S%TTIME,IRESP)
CALL END_IO_SURF_n(HPROGRAM)
END SELECT
!
@@ -342,53 +337,58 @@ END SELECT
! initialization for I/O
!
CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ') ! change input file name to pgd name
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'NATURE','ISBA ','READ ')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'NATURE','ISBA ','READ ')
!
!
!* 2.1 Cover, soil and orographic fields:
! ---------------------------------
!
- CALL READ_PGD_ISBA_n(IM%CHI, DTCO, IM%DTI, DTZ, DGU, IM%GB, IM%IG, IM%I, &
- UG, U, SV,GCP, &
- HPROGRAM,OLAND_USE)
+ CALL READ_PGD_ISBA_n(IM%CHI, DTCO, IM%DTV, DTZ, IM%GB, IM%G, IM%ISS, IM%O, IM%S, IM%K, &
+ UG, U, USS, GCP, SV, HPROGRAM, OLAND_USE, TPDATE_END)
+!
+IF (HINIT=='PRE') THEN
+ DO JP = 1,IM%O%NPATCH
+ IM%NPE%AL(JP)%TSNOW%SCHEME = YSNOW_SCHEME
+ IM%NPE%AL(JP)%TSNOW%NLAYER = ISNOW_NLAYER
+ ENDDO
+ENDIF
!
-ISIZE_LMEB_PATCH=COUNT(IM%I%LMEB_PATCH(:))
+ISIZE_LMEB_PATCH=COUNT(IM%O%LMEB_PATCH(:))
!
!
!* 2.2 Check:
! ------
!
-IF ( IM%I%CPHOTO/='NON' .AND. IM%I%NPATCH/=12 .AND. IM%I%NPATCH/=19 )THEN
+IF ( IM%O%CPHOTO/='NON' .AND. IM%O%NPATCH/=12 .AND. IM%O%NPATCH/=19 )THEN
CALL ABOR1_SFX('INIT_ISBAN: INCONSISTENCY BETWEEN CPHOTO AND NPATCH')
ENDIF
!
-IF (HINIT=='PRE' .AND. IM%I%TSNOW%SCHEME.NE.'3-L' .AND. IM%I%TSNOW%SCHEME.NE.'CRO' .AND. IM%I%CISBA=='DIF') THEN
+IF (HINIT=='PRE' .AND. YSNOW_SCHEME.NE.'3-L' .AND. YSNOW_SCHEME.NE.'CRO' .AND. IM%O%CISBA=='DIF') THEN
CALL ABOR1_SFX("INIT_ISBAN: WITH CISBA = DIF, CSNOW MUST BE 3-L OR CRO")
ENDIF
-IF ( IM%I%CPHOTO/='LAI' .AND. IM%I%CPHOTO/='LST' .AND. IM%I%CPHOTO/='NIT' .AND. IM%I%CPHOTO/='NCB' .AND. LAGRIP) THEN
+IF ( IM%O%CPHOTO/='NIT' .AND. IM%O%CPHOTO/='NCB' .AND. LAGRIP) THEN
CALL ABOR1_SFX('INIT_ISBAN: INCONSISTENCY BETWEEN CPHOTO AND LAGRIP')
ENDIF
-IF ( IM%I%CPHOTO/='NCB' .AND. IM%I%CRESPSL=='CNT') THEN
+IF ( IM%O%CPHOTO/='NCB' .AND. IM%O%CRESPSL=='CNT') THEN
CALL ABOR1_SFX('INIT_ISBAN: INCONSISTENCY BETWEEN CPHOTO AND CRESPSL')
ENDIF
-IF (HINIT=='PRE' .AND. ISIZE_LMEB_PATCH>0 .AND. IM%I%TSNOW%SCHEME.NE.'3-L' .AND. IM%I%TSNOW%SCHEME.NE.'CRO') THEN
+IF (HINIT=='PRE' .AND. ISIZE_LMEB_PATCH>0 .AND. YSNOW_SCHEME.NE.'3-L' .AND. YSNOW_SCHEME.NE.'CRO') THEN
CALL ABOR1_SFX("INIT_ISBAN: WITH LMEB_PATCH = TRUE, CSNOW MUST BE 3-L OR CRO")
ENDIF
-IF(IM%I%CPHOTO/='NCB'.AND.IM%I%LSPINUPCARBW)THEN
+IF(IM%O%CPHOTO/='NCB'.AND.IM%O%LSPINUPCARBW)THEN
CALL ABOR1_SFX('INIT_ISBAN: INCONSISTENCY BETWEEN CPHOTO AND LSPINUPCARBW (if not NCB must be false)')
ENDIF
-IF(IM%I%CRESPSL/='CNT'.AND.IM%I%LSPINUPCARBS)THEN
+IF(IM%O%CRESPSL/='CNT'.AND.IM%O%LSPINUPCARBS)THEN
CALL ABOR1_SFX('INIT_ISBAN: INCONSISTENCY BETWEEN CRESPSL AND LSPINUPCARBS (if not CNT must be false)')
ENDIF
-IF(IM%I%LSPINUPCARBW.AND.REAL(IM%I%NNBYEARSPINW)>REAL(IM%I%NNBYEARSPINS)*0.5)THEN
+IF(IM%O%LSPINUPCARBW.AND.REAL(IM%O%NNBYEARSPINW)>REAL(IM%O%NNBYEARSPINS)*0.5)THEN
WRITE(ILUOUT,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
WRITE(ILUOUT,*)'INIT_ISBAN: INCONSISTENCY BETWEEN NNBYEARSPINW AND NNBYEARSPINS'
WRITE(ILUOUT,*)'NNBYEARSPINW MUST BE < TO 0.5 * NNBYEARSPINS'
WRITE(ILUOUT,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
CALL ABOR1_SFX('INIT_ISBAN: INCONSISTENCY BETWEEN NNBYEARSPINW AND NNBYEARSPINS')
ENDIF
-IF(IM%I%LSPINUPCARBS.AND.(IM%I%XCO2_START==XUNDEF.OR.IM%I%XCO2_END==XUNDEF))THEN
+IF(IM%O%LSPINUPCARBS.AND.(IM%O%XCO2_START==XUNDEF.OR.IM%O%XCO2_END==XUNDEF))THEN
WRITE(ILUOUT,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
WRITE(ILUOUT,*)'INIT_ISBAN: INCONSISTENCY BETWEEN LSPINUPCARBS AND XCO2_START OR XCO2_END'
WRITE(ILUOUT,*)'FOR ISBA-CC SPINUP XCO2_START AND XCO2_END MUST BE DEFINED'
@@ -406,35 +406,35 @@ ENDIF
! fixed to Pre-industrial CO2 consentration XCO2_START
! (2) Atmospheric CO2 concentration rampin up from XCO2_START to XCO2_END
!
-ISPINEND=IM%I%NNBYEARSPINS-NINT(IM%I%NNBYEARSPINS*XSPIN_CO2)
+ISPINEND=IM%O%NNBYEARSPINS-NINT(IM%O%NNBYEARSPINS*XSPIN_CO2)
!
-IM%I%LAGRI_TO_GRASS = .FALSE.
+IM%O%LAGRI_TO_GRASS = .FALSE.
!
-IF ( IM%I%LSPINUPCARBS .AND. (IM%I%NNBYEARSOLD <= ISPINEND) ) THEN
+IF ( IM%O%LSPINUPCARBS .AND. (IM%O%NNBYEARSOLD <= ISPINEND) ) THEN
!
- IM%I%LAGRI_TO_GRASS = .TRUE.
+ IM%O%LAGRI_TO_GRASS = .TRUE.
!
- CALL INI_DATA_PARAM(DTCO%XDATA_VEGTYPE, PSURF=DTCO%XDATA_NATURE, PH_TREE=XDATA_H_TREE,PLAI=XDATA_LAI, &
- PALBNIR_VEG=XDATA_ALBNIR_VEG, PALBVIS_VEG=XDATA_ALBVIS_VEG, &
- PALBUV_VEG=XDATA_ALBUV_VEG, PRSMIN=XDATA_RSMIN, &
- PRGL=XDATA_RGL, PCV=XDATA_CV, PGAMMA=XDATA_GAMMA, &
- PGMES=XDATA_GMES, PGC=XDATA_GC, PBSLAI=XDATA_BSLAI, &
- PSEFOLD=XDATA_SEFOLD, PLAIMIN_OUT=XDATA_LAIMIN, PDMAX=XDATA_DMAX, &
- PSTRESS=XDATA_STRESS, PF2I=XDATA_F2I, PVEG_OUT=XDATA_VEG, &
- PGREEN=XDATA_GREEN, PZ0=XDATA_Z0, PZ0_O_Z0H=XDATA_Z0_O_Z0H, &
- PEMIS_ECO=XDATA_EMIS_ECO, PWRMAX_CF=XDATA_WRMAX_CF, &
- PROOT_LIN=XDATA_ROOT_LIN, PROOT_EXTINCTION=XDATA_ROOT_EXTINCTION, &
- PSOILRC_SO2=XDATA_SOILRC_SO2, PSOILRC_O3=XDATA_SOILRC_O3, PRE25=XDATA_RE25, &
- PCE_NITRO=XDATA_CE_NITRO,PCF_NITRO=XDATA_CF_NITRO,PCNA_NITRO=XDATA_CNA_NITRO, &
- PGMES_ST=XDATA_GMES_ST, PGC_ST=XDATA_GC_ST, PBSLAI_ST=XDATA_BSLAI_ST, &
- PSEFOLD_ST=XDATA_SEFOLD_ST, PDMAX_ST=XDATA_DMAX_ST, OAGRI_TO_GRASS=IM%I%LAGRI_TO_GRASS)
+ CALL INI_DATA_PARAM(PH_TREE=XDATA_H_TREE,PLAI=XDATA_LAI, &
+ PALBNIR_VEG=XDATA_ALBNIR_VEG, PALBVIS_VEG=XDATA_ALBVIS_VEG, &
+ PALBUV_VEG=XDATA_ALBUV_VEG, PRSMIN=XDATA_RSMIN, &
+ PRGL=XDATA_RGL, PCV=XDATA_CV, PGAMMA=XDATA_GAMMA, &
+ PGMES=XDATA_GMES, PGC=XDATA_GC, PBSLAI=XDATA_BSLAI, &
+ PSEFOLD=XDATA_SEFOLD, PLAIMIN_OUT=XDATA_LAIMIN, PDMAX=XDATA_DMAX, &
+ PSTRESS=XDATA_STRESS, PF2I=XDATA_F2I, PVEG_OUT=XDATA_VEG, &
+ PGREEN=XDATA_GREEN, PZ0=XDATA_Z0, PZ0_O_Z0H=XDATA_Z0_O_Z0H, &
+ PEMIS_ECO=XDATA_EMIS_ECO, PWRMAX_CF=XDATA_WRMAX_CF, &
+ PROOT_LIN=XDATA_ROOT_LIN, PROOT_EXTINCTION=XDATA_ROOT_EXTINCTION, &
+ PSOILRC_SO2=XDATA_SOILRC_SO2, PSOILRC_O3=XDATA_SOILRC_O3, PRE25=XDATA_RE25, &
+ PCE_NITRO=XDATA_CE_NITRO,PCF_NITRO=XDATA_CF_NITRO,PCNA_NITRO=XDATA_CNA_NITRO, &
+ PGMES_ST=XDATA_GMES_ST, PGC_ST=XDATA_GC_ST, PBSLAI_ST=XDATA_BSLAI_ST, &
+ PSEFOLD_ST=XDATA_SEFOLD_ST, PDMAX_ST=XDATA_DMAX_ST, OAGRI_TO_GRASS=IM%O%LAGRI_TO_GRASS)
!
- ZCO2(:) = PRHOA(:) * IM%I%XCO2_START * 1.E-6 * XMCO2 / XMD
+ ZCO2(:) = PRHOA(:) * IM%O%XCO2_START * 1.E-6 * XMCO2 / XMD
!
-ELSEIF(IM%I%LSPINUPCARBS .AND. (IM%I%NNBYEARSOLD > ISPINEND) .AND. (IM%I%NNBYEARSOLD <= IM%I%NNBYEARSPINS) )THEN
+ELSEIF(IM%O%LSPINUPCARBS .AND. (IM%O%NNBYEARSOLD > ISPINEND) .AND. (IM%O%NNBYEARSOLD <= IM%O%NNBYEARSPINS) )THEN
!
- ZSPINCO2 = IM%I%XCO2_START + (IM%I%XCO2_END-IM%I%XCO2_START) * REAL(IM%I%NNBYEARSOLD - ISPINEND) / &
- REAL(IM%I%NNBYEARSPINS - ISPINEND)
+ ZSPINCO2 = IM%O%XCO2_START + (IM%O%XCO2_END-IM%O%XCO2_START) * REAL(IM%O%NNBYEARSOLD - ISPINEND) / &
+ REAL(IM%O%NNBYEARSPINS - ISPINEND)
!
ZCO2(:) = PRHOA(:) * ZSPINCO2 * 1.E-6 * XMCO2 / XMD
!
@@ -452,47 +452,83 @@ ENDIF
! Make sure some diags are conputed when coupled with atmosphere
!-----------------------------------------------------------------------------------------------------
!
-IF(LCPL_GCM.AND.IM%DGI%LSURF_BUDGET)THEN
- IM%DGEI%LSURF_EVAP_BUDGET=.TRUE.
+IF(LCPL_GCM.AND.IM%ID%O%LSURF_BUDGET) THEN
+ IM%ID%DE%LSURF_EVAP_BUDGET=.TRUE.
ENDIF
!
!-----------------------------------------------------------------------------------------------------
!
IF (OLAND_USE .OR. HINIT=='PGD') THEN
- ! ISBA diagnostic PGD fields to improve efficiency in further PREP steps
- IF (IM%I%LECOCLIMAP) THEN
- ALLOCATE(IM%I%XDG(KI,IM%I%NGROUND_LAYER,IM%I%NPATCH))
- IF (IM%I%CISBA=='DIF') THEN
- ALLOCATE(IM%I%NWG_LAYER(KI,IM%I%NPATCH))
- ELSE
- ALLOCATE(IM%I%NWG_LAYER(0,0))
- END IF
- CALL CONVERT_COVER_ISBA(DTCO,IM%I,IM%I%CISBA,1,IM%I%XCOVER,&
- IM%I%LCOVER,' ','NAT',&
- PSOILGRID=IM%I%XSOILGRID,PDG=IM%I%XDG,&
- KWG_LAYER=IM%I%NWG_LAYER)
- END IF
-! end of initialization
-IF (LHOOK) CALL DR_HOOK('INIT_ISBA_N',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('INIT_ISBA_N',1,ZHOOK_HANDLE)
RETURN
END IF
!
- CALL COMPUTE_ISBA_PARAMETERS(DTCO, DGU, UG, U, IM, DST, SLT, SV, &
- HPROGRAM,HINIT,OLAND_USE, &
- KI,KSV,KSW, &
- HSV,ZCO2,PRHOA, &
+CALL COMPUTE_ISBA_PARAMETERS(DTCO, OREAD_BUDGETC, UG, U, &
+ IM%O, IM%DTV, IM%SB, IM%S, IM%G, IM%K, IM%NK, &
+ IM%NG, IM%NP, IM%NPE, IM%NAG, IM%NISS, IM%ISS, &
+ IM%NCHI, IM%CHI, IM%ID, IM%GB, IM%NGB, &
+ NDST, SLT, SV, HPROGRAM,HINIT,OLAND_USE, &
+ KI,KSV,KSW, HSV,ZCO2,PRHOA, &
PZENITH,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD,PTSURF, &
- HTEST )
+ PEMIS,PTSRAD,PTSURF,HTEST )
!
-IF ( IM%I%CSNOWMETAMO/="B92" ) THEN
+IF ( IM%O%CSNOWMETAMO/="B92" ) THEN
CALL READ_FZ06('drdt_bst_fit_60.nc')
ENDIF
!
-IF ( IM%I%CSNOWRAD=="TAR" .OR. IM%I%CSNOWRAD=="TA1" .OR. IM%I%CSNOWRAD=="TA2" ) THEN
+IF ( IM%O%CSNOWRAD=="TAR" .OR. IM%O%CSNOWRAD=="TA1" .OR. IM%O%CSNOWRAD=="TA2" ) THEN
CALL INIT_TARTES()
END IF
!
+IF (HINIT=='ALL') THEN
+ YSNOW_SCHEME = IM%NPE%AL(1)%TSNOW%SCHEME
+ ISNOW_NLAYER = IM%NPE%AL(1)%TSNOW%NLAYER
+ENDIF
+!
+IF (.NOT.LSPLIT_PATCH) THEN
+
+ ALLOCATE(IM%S%XWORK_WR(KI,IM%O%NPATCH))
+ IM%S%XWORK_WR(:,:) = XUNDEF
+
+ ALLOCATE(IM%S%XWSN_WR(KI,ISNOW_NLAYER,IM%O%NPATCH))
+ ALLOCATE(IM%S%XRHO_WR(KI,ISNOW_NLAYER,IM%O%NPATCH))
+ ALLOCATE(IM%S%XALB_WR(KI,IM%O%NPATCH))
+ IF (YSNOW_SCHEME=='3-L' .OR. YSNOW_SCHEME=='CRO') THEN
+ ALLOCATE(IM%S%XHEA_WR(KI,ISNOW_NLAYER,IM%O%NPATCH))
+ ALLOCATE(IM%S%XAGE_WR(KI,ISNOW_NLAYER,IM%O%NPATCH))
+ IF (YSNOW_SCHEME=='CRO') THEN
+ ALLOCATE(IM%S%XSG1_WR(KI,ISNOW_NLAYER,IM%O%NPATCH))
+ ALLOCATE(IM%S%XSG2_WR(KI,ISNOW_NLAYER,IM%O%NPATCH))
+ ALLOCATE(IM%S%XHIS_WR(KI,ISNOW_NLAYER,IM%O%NPATCH))
+ ELSE
+ ALLOCATE(IM%S%XSG1_WR(0,0,1))
+ ALLOCATE(IM%S%XSG2_WR(0,0,1))
+ ALLOCATE(IM%S%XHIS_WR(0,0,1))
+ ENDIF
+ ELSE
+ ALLOCATE(IM%S%XHEA_WR(0,0,1))
+ ALLOCATE(IM%S%XAGE_WR(0,0,1))
+ ENDIF
+
+ ALLOCATE(IM%S%TDATE_WR(KI,IM%O%NPATCH))
+
+ELSE
+
+ ALLOCATE(IM%S%XWORK_WR(0,1))
+
+ ALLOCATE(IM%S%XWSN_WR(0,0,1))
+ ALLOCATE(IM%S%XRHO_WR(0,0,1))
+ ALLOCATE(IM%S%XALB_WR(0,1))
+ ALLOCATE(IM%S%XHEA_WR(0,0,1))
+ ALLOCATE(IM%S%XAGE_WR(0,0,1))
+ ALLOCATE(IM%S%XSG1_WR(0,0,1))
+ ALLOCATE(IM%S%XSG2_WR(0,0,1))
+ ALLOCATE(IM%S%XHIS_WR(0,0,1))
+
+ ALLOCATE(IM%S%TDATE_WR(0,1))
+
+ENDIF
+!
IF (LHOOK) CALL DR_HOOK('INIT_ISBA_N',1,ZHOOK_HANDLE)
!
END SUBROUTINE INIT_ISBA_n
diff --git a/src/SURFEX/init_naturen.F90 b/src/SURFEX/init_naturen.F90
index 53955aae17c8c1de54da2c07c81f0141cc7dc248..5c0b1aa95260393762dbe125c66ce13eb563d3d7 100644
--- a/src/SURFEX/init_naturen.F90
+++ b/src/SURFEX/init_naturen.F90
@@ -3,16 +3,13 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #############################################################
- SUBROUTINE INIT_NATURE_n (DTCO, DGU, UG, U, IM, DTZ, DGL, &
- DST, SLT, SV,GCP, &
- HPROGRAM,HINIT,OLAND_USE, &
- KI,KSV,KSW, &
- HSV,PCO2,PRHOA, &
- PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD,PTSURF, &
- KYEAR, KMONTH,KDAY, PTIME, &
- HATMFILE,HATMFILETYPE, &
- HTEST )
+ SUBROUTINE INIT_NATURE_n (DTCO, OREAD_BUDGETC, UG, U, USS, GCP, IM, &
+ DTZ, DGO, DL, DLC, NDST, SLT, SV, &
+ HPROGRAM,HINIT,OLAND_USE, KI,KSV,KSW, &
+ HSV,PCO2,PRHOA,PZENITH,PAZIM,PSW_BANDS, &
+ PDIR_ALB,PSCA_ALB,PEMIS,PTSRAD,PTSURF, &
+ KYEAR, KMONTH,KDAY, PTIME, TPDATE_END, &
+ HATMFILE,HATMFILETYPE,HTEST )
! #############################################################
!
!!**** *INIT_NATURE_n* - routine to choose initialization of vegetation scheme
@@ -53,21 +50,21 @@
!
USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t
!
+USE MODD_TYPE_DATE_SURF, ONLY : DATE
+!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
USE MODD_DATA_TSZ0_n, ONLY : DATA_TSZ0_t
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
-USE MODD_DST_n, ONLY : DST_t
+USE MODD_DST_n, ONLY : DST_NP_t
USE MODD_SLT_n, ONLY : SLT_t
USE MODD_SV_n, ONLY : SV_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
!
USE MODD_CSTS, ONLY : XTT
!
-!
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -80,19 +77,20 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-!
TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+LOGICAL, INTENT(IN) :: OREAD_BUDGETC
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
+TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
TYPE(DATA_TSZ0_t), INTENT(INOUT) :: DTZ
-TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
-TYPE(DST_t), INTENT(INOUT) :: DST
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: DL
+TYPE(DIAG_t), INTENT(INOUT) :: DLC
+TYPE(DST_NP_t), INTENT(INOUT) :: NDST
TYPE(SLT_t), INTENT(INOUT) :: SLT
TYPE(SV_t), INTENT(INOUT) :: SV
-TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize
@@ -116,6 +114,7 @@ INTEGER, INTENT(IN) :: KMONTH ! current month (UTC)
INTEGER, INTENT(IN) :: KDAY ! current day (UTC)
REAL, INTENT(IN) :: PTIME ! current time since
! midnight (UTC, s)
+TYPE(DATE), INTENT(INOUT) :: TPDATE_END
!
CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! atmospheric file name
CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! atmospheric file type
@@ -139,17 +138,17 @@ IF (U%CNATURE=='NONE ') THEN
PTSRAD =XTT
PTSURF =XTT
ELSE IF (U%CNATURE=='FLUX ') THEN
- CALL INIT_IDEAL_FLUX(DGL, DGU%LREAD_BUDGETC, &
- HPROGRAM,HINIT,KI,KSV,KSW,HSV,PCO2,PRHOA, &
- PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD,PTSURF,'OK' )
+ CALL INIT_IDEAL_FLUX(DGO, DL, DLC, OREAD_BUDGETC, HPROGRAM, HINIT, &
+ KI, KSV, KSW, HSV, PDIR_ALB, PSCA_ALB, PEMIS, &
+ PTSRAD, PTSURF, 'OK' )
ELSE IF (U%CNATURE=='ISBA ' .OR. U%CNATURE=='TSZ0') THEN
- CALL INIT_ISBA_n(DTCO, DGU, UG, U, IM, DTZ, DST, SLT, SV,GCP, &
- HPROGRAM,HINIT,OLAND_USE,KI,KSV,KSW,HSV,PCO2,PRHOA, &
- PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD,PTSURF, &
- KYEAR,KMONTH,KDAY,PTIME,HATMFILE,HATMFILETYPE,&
- 'OK' )
+ CALL INIT_ISBA_n(DTCO, OREAD_BUDGETC, UG, U, USS, GCP, &
+ IM, DTZ, NDST, SLT, SV, &
+ HPROGRAM, HINIT, OLAND_USE, KI, KSV, KSW, HSV, &
+ PCO2, PRHOA, PZENITH, PAZIM, PSW_BANDS, &
+ PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD, PTSURF, &
+ KYEAR, KMONTH, KDAY, PTIME, TPDATE_END, &
+ HATMFILE, HATMFILETYPE, 'OK' )
END IF
IF (LHOOK) CALL DR_HOOK('INIT_NATURE_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/init_pgd_surf_atm.F90 b/src/SURFEX/init_pgd_surf_atm.F90
index d4158bafa871e747237a42f1ff86dc63d2dcf76f..cb7a58256464476666d4b9da1a66e24288abe986 100644
--- a/src/SURFEX/init_pgd_surf_atm.F90
+++ b/src/SURFEX/init_pgd_surf_atm.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #################################################################################
-SUBROUTINE INIT_PGD_SURF_ATM (YSC, &
- HPROGRAM,HINIT,HATMFILE,HATMFILETYPE, &
+SUBROUTINE INIT_PGD_SURF_ATM (YSC, HPROGRAM,HINIT,HATMFILE,HATMFILETYPE, &
KYEAR, KMONTH, KDAY, PTIME )
! #################################################################################
!
@@ -34,6 +33,7 @@ SUBROUTINE INIT_PGD_SURF_ATM (YSC, &
!
USE MODD_SURFEX_n, ONLY : SURFEX_t
!
+USE MODD_TYPE_DATE_SURF, ONLY : DATE
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -59,6 +59,7 @@ REAL, INTENT(IN) :: PTIME ! time
!
!* 0.2 declarations of local variables
!
+TYPE(DATE) :: TDATE_END
CHARACTER(LEN=6), DIMENSION(0) :: YSV ! name of all scalar variables
REAL, DIMENSION(0) :: ZCO2 ! CO2 concentration (kg/m3)
REAL, DIMENSION(0) :: ZRHOA ! air density (kg/m3)
@@ -76,14 +77,18 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* initialization of PGD fields of output domain
!
IF (LHOOK) CALL DR_HOOK('INIT_PGD_SURF_ATM',0,ZHOOK_HANDLE)
- CALL INIT_SURF_ATM_n(YSC, &
- HPROGRAM,HINIT,.FALSE., &
- 0,0,1, &
- YSV,ZCO2,ZRHOA, &
+!
+TDATE_END%YEAR = KYEAR
+TDATE_END%MONTH = KMONTH
+TDATE_END%DAY = KDAY
+!
+ CALL INIT_SURF_ATM_n(YSC, HPROGRAM,HINIT,.FALSE., &
+ 0,0,1,YSV,ZCO2,ZRHOA, &
ZZENITH,ZAZIM,ZSW_BANDS,ZDIR_ALB,ZSCA_ALB, &
ZEMIS,ZTSRAD,ZTSURF, &
- KYEAR, KMONTH, KDAY, PTIME, &
+ KYEAR, KMONTH, KDAY, PTIME, TDATE_END, &
HATMFILE,HATMFILETYPE, 'OK' )
+!
IF (LHOOK) CALL DR_HOOK('INIT_PGD_SURF_ATM',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/init_seafluxn.F90 b/src/SURFEX/init_seafluxn.F90
index 63e3f2e17a342859912759e0882c3010754c57fe..26920994c1de73b7cba91edd086b77b5a3134faf 100644
--- a/src/SURFEX/init_seafluxn.F90
+++ b/src/SURFEX/init_seafluxn.F90
@@ -3,15 +3,12 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #############################################################
- SUBROUTINE INIT_SEAFLUX_n (DTCO, DGU, UG, U, SM,GCP, &
- HPROGRAM,HINIT, &
- KI,KSV,KSW, &
- HSV,PCO2,PRHOA, &
- PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD,PTSURF, &
- KYEAR, KMONTH,KDAY, PTIME, &
- HATMFILE,HATMFILETYPE, &
- HTEST )
+ SUBROUTINE INIT_SEAFLUX_n (DTCO, OREAD_BUDGETC, UG, U, GCP, SM, &
+ HPROGRAM,HINIT,KI,KSV,KSW, &
+ HSV,PCO2,PRHOA,PZENITH,PAZIM,PSW_BANDS, &
+ PDIR_ALB,PSCA_ALB, PEMIS,PTSRAD,PTSURF, &
+ KYEAR, KMONTH,KDAY,PTIME, &
+ HATMFILE,HATMFILETYPE,HTEST )
! #############################################################
!
!!**** *INIT_SEAFLUX_n* - routine to initialize SEAFLUX
@@ -53,14 +50,12 @@
!* 0. DECLARATIONS
! ------------
!
-!
USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
USE MODD_SFX_OASIS, ONLY : LCPL_SEA, LCPL_SEAICE
!
@@ -88,6 +83,7 @@ USE MODI_READ_SEAICE_n
!
USE MODI_READ_PGD_SEAFLUX_n
USE MODI_DIAG_SEAFLUX_INIT_n
+USE MODI_DIAG_SEAICE_INIT_n
USE MODI_END_IO_SURF_n
USE MODI_GET_LUOUT
USE MODI_READ_SURF
@@ -96,7 +92,7 @@ USE MODI_READ_NAM_PREP_SEAFLUX_n
USE MODI_INIT_CHEMICAL_n
USE MODI_PREP_CTRL_SEAFLUX
USE MODI_UPDATE_RAD_SEA
-USE MODI_READ_SEAFLUX_SBL_n
+USE MODI_READ_SBL_n
USE MODI_ABOR1_SFX
!
USE MODI_SET_SURFEX_FILEIN
@@ -112,18 +108,19 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
- CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize
+LOGICAL, INTENT(IN) :: OREAD_BUDGETC
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize
INTEGER, INTENT(IN) :: KI ! number of points
INTEGER, INTENT(IN) :: KSV ! number of scalars
INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands
- CHARACTER(LEN=6), DIMENSION(KSV), INTENT(IN) :: HSV ! name of all scalar variables
+CHARACTER(LEN=6), DIMENSION(KSV), INTENT(IN) :: HSV ! name of all scalar variables
REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration (kg/m3)
REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density
REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! solar zenithal angle
@@ -140,9 +137,9 @@ INTEGER, INTENT(IN) :: KDAY ! current day (UTC)
REAL, INTENT(IN) :: PTIME ! current time since
! midnight (UTC, s)
!
- CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! atmospheric file name
- CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! atmospheric file type
- CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
+CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! atmospheric file name
+CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! atmospheric file type
+CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
!
!
!* 0.2 Declarations of local variables
@@ -158,6 +155,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! Initialisation for IO
!
IF (LHOOK) CALL DR_HOOK('INIT_SEAFLUX_N',0,ZHOOK_HANDLE)
+!
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
IF (HTEST/='OK') THEN
@@ -184,42 +182,41 @@ IF (LNAM_READ) THEN
! 0.1. Hard defaults
!
- CALL DEFAULT_SEAFLUX(SM%S%XTSTEP,SM%S%XOUT_TSTEP,SM%S%CSEA_ALB,SM%S%CSEA_FLUX,SM%S%LPWG, &
- SM%S%LPRECIP,SM%S%LPWEBB,SM%S%NZ0,SM%S%NGRVWAVES,SM%O%LPROGSST, &
+ CALL DEFAULT_SEAFLUX(SM%S%XTSTEP,SM%S%XOUT_TSTEP,SM%S%CSEA_ALB,SM%S%CSEA_FLUX,SM%S%LPWG, &
+ SM%S%LPRECIP,SM%S%LPWEBB,SM%S%NZ0,SM%S%NGRVWAVES,SM%O%LPROGSST, &
SM%O%NTIME_COUPLING,SM%O%XOCEAN_TSTEP,SM%S%XICHCE,SM%S%CINTERPOL_SST,&
SM%S%CINTERPOL_SSS )
- CALL DEFAULT_SEAICE(HPROGRAM, &
+ CALL DEFAULT_SEAICE(HPROGRAM, &
SM%S%CINTERPOL_SIC,SM%S%CINTERPOL_SIT, SM%S%XFREEZING_SST, &
- SM%S%XSEAICE_TSTEP, SM%S%XSIC_EFOLDING_TIME, &
+ SM%S%XSEAICE_TSTEP, SM%S%XSIC_EFOLDING_TIME, &
SM%S%XSIT_EFOLDING_TIME, SM%S%XCD_ICE_CST, SM%S%XSI_FLX_DRV)
!
CALL DEFAULT_CH_DEP(SM%CHS%CCH_DRY_DEP)
!
- CALL DEFAULT_DIAG_SEAFLUX(SM%DGS%N2M,SM%DGS%LSURF_BUDGET,SM%DGS%L2M_MIN_ZS,&
- SM%DGS%LRAD_BUDGET,SM%DGS%LCOEF,SM%DGS%LSURF_VARS,&
- SM%DGO%LDIAG_OCEAN,SM%DGSI%LDIAG_SEAICE,SM%DGS%LSURF_BUDGETC,&
- SM%DGS%LRESET_BUDGETC,SM%DGS%XDIAG_TSTEP )
+ CALL DEFAULT_DIAG_SEAFLUX(SM%SD%O%N2M,SM%SD%O%LSURF_BUDGET,SM%SD%O%L2M_MIN_ZS,&
+ SM%SD%O%LRAD_BUDGET,SM%SD%O%LCOEF,SM%SD%O%LSURF_VARS,&
+ SM%SD%GO%LDIAG_OCEAN,SM%SD%DMI%LDIAG_MISC_SEAICE,&
+ SM%SD%O%LSURF_BUDGETC,SM%SD%O%LRESET_BUDGETC,SM%SD%O%XDIAG_TSTEP )
ENDIF
!
!
! 0.2. Defaults from file header
!
- CALL READ_DEFAULT_SEAFLUX_n(SM%CHS, SM%DGO, SM%DGS, SM%DGSI, SM%O, SM%S, &
- HPROGRAM)
+ CALL READ_DEFAULT_SEAFLUX_n(SM%CHS, SM%SD%GO, SM%SD%O, SM%SD%DMI, SM%O, SM%S, HPROGRAM)
!
!* 1.1 Reading of configuration:
! -------------------------
!
- CALL READ_SEAFLUX_CONF_n(SM%CHS, SM%DGO, SM%DGS, SM%DGSI, SM%O, SM%S, &
- HPROGRAM)
+ CALL READ_SEAFLUX_CONF_n(SM%CHS, SM%SD%GO, SM%SD%O, SM%SD%DMI, SM%O, SM%S, HPROGRAM)
!
SM%S%LINTERPOL_SST=.FALSE.
SM%S%LINTERPOL_SSS=.FALSE.
SM%S%LINTERPOL_SIC=.FALSE.
SM%S%LINTERPOL_SIT=.FALSE.
+!
IF(LCPL_SEA)THEN
- IF(SM%DGS%N2M<1)THEN
+ IF(SM%SD%O%N2M<1)THEN
CALL ABOR1_SFX('INIT_SEAFLUX_n: N2M must be set >0 in case of LCPL_SEA')
ENDIF
! No STT / SSS interpolation in Earth System Model
@@ -257,19 +254,15 @@ SELECT CASE (HINIT)
!
CASE ('PRE')
!
- CALL PREP_CTRL_SEAFLUX(SM%DGS%N2M,SM%DGS%LSURF_BUDGET,SM%DGS%L2M_MIN_ZS,&
- SM%DGS%LRAD_BUDGET,SM%DGS%LCOEF,SM%DGS%LSURF_VARS,&
- SM%DGO%LDIAG_OCEAN,SM%DGSI%LDIAG_SEAICE,ILUOUT,SM%DGS%LSURF_BUDGETC )
+ CALL PREP_CTRL_SEAFLUX(SM%SD%O,SM%SD%GO%LDIAG_OCEAN,SM%SD%DMI%LDIAG_MISC_SEAICE,ILUOUT )
IF (LNAM_READ) CALL READ_NAM_PREP_SEAFLUX_n(HPROGRAM)
- CALL READ_SEAFLUX_DATE(SM%O, &
- HPROGRAM,HINIT,ILUOUT,HATMFILE,HATMFILETYPE,KYEAR,KMONTH,KDAY,PTIME,SM%S%TTIME)
+ CALL READ_SEAFLUX_DATE(SM%O%LMERCATOR,HPROGRAM,HINIT,ILUOUT,HATMFILE,HATMFILETYPE,&
+ KYEAR,KMONTH,KDAY,PTIME,SM%S%TTIME)
!
CASE DEFAULT
!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'SEA ','SEAFLX','READ ')
- CALL READ_SURF(&
- HPROGRAM,'DTCUR',SM%S%TTIME,IRESP)
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'FULL ','SURF ','READ ')
+ CALL READ_SURF(HPROGRAM,'DTCUR',SM%S%TTIME,IRESP)
CALL END_IO_SURF_n(HPROGRAM)
!
END SELECT
@@ -281,15 +274,15 @@ END SELECT
! Initialisation for IO
!
CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ') ! change input file name to pgd name
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'SEA ','SEAFLX','READ ')
+!
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'SEA ','SEAFLX','READ ')
!
! Reading of the fields
!
- CALL READ_PGD_SEAFLUX_n(DTCO, SM%DTS, SM%SG, SM%S, U,GCP, &
- HPROGRAM)
+ CALL READ_PGD_SEAFLUX_n(DTCO, SM%DTS, SM%G, SM%S, U, UG, GCP, HPROGRAM)
!
CALL END_IO_SURF_n(HPROGRAM)
+!
CALL SET_SURFEX_FILEIN(HPROGRAM,'PREP') ! restore input file name
!-------------------------------------------------------------------------------
!
@@ -304,8 +297,7 @@ END IF
!
! Initialisation for IO
!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'SEA ','SEAFLX','READ ')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'SEA ','SEAFLX','READ ')
!
!* 2. Prognostic fields:
! ----------------
@@ -318,8 +310,7 @@ IF(SM%S%LINTERPOL_SST.OR.SM%S%LINTERPOL_SSS.OR.SM%S%LINTERPOL_SIC.OR.SM%S%LINTER
SM%S%TZTIME%TIME = SM%S%TTIME%TIME
ENDIF
!
- CALL READ_SEAFLUX_n(DTCO, SM%SG, SM%S, U, &
- HPROGRAM,ILUOUT)
+ CALL READ_SEAFLUX_n(DTCO, SM%G, SM%S, U, HPROGRAM,ILUOUT)
!
IF (HINIT/='ALL') THEN
CALL END_IO_SURF_n(HPROGRAM)
@@ -331,8 +322,7 @@ END IF
!* 2.1 Ocean fields:
! -------------
!
- CALL READ_OCEAN_n(DTCO, SM%O, SM%OR, U, &
- HPROGRAM)
+ CALL READ_OCEAN_n(DTCO, SM%O, SM%OR, U, HPROGRAM)
!
!-------------------------------------------------------------------------------
!
@@ -383,9 +373,7 @@ ENDIF
!
!* 4. Seaice prognostic variables and forcings :
!
- CALL READ_SEAICE_n(&
- SM%SG, SM%S, &
- HPROGRAM,ILU,ILUOUT)
+CALL READ_SEAICE_n(SM%G, SM%S, HPROGRAM,ILU,ILUOUT)
!
!-------------------------------------------------------------------------------
!
@@ -395,9 +383,7 @@ ENDIF
ALLOCATE(SM%S%XEMIS (ILU))
SM%S%XEMIS = 0.0
!
- CALL UPDATE_RAD_SEA(SM%S%CSEA_ALB,SM%S%XSST,PZENITH,XTTS,SM%S%XEMIS,SM%S%XDIR_ALB,&
- SM%S%XSCA_ALB,PDIR_ALB,PSCA_ALB,PEMIS,PTSRAD, &
- SM%S%LHANDLE_SIC,SM%S%XTICE,SM%S%XSIC,SM%S%XICE_ALB )
+CALL UPDATE_RAD_SEA(SM%S,PZENITH,XTTS,PDIR_ALB,PSCA_ALB,PEMIS,PTSRAD )
!
IF (SM%S%LHANDLE_SIC) THEN
PTSURF(:) = SM%S%XSST(:) * ( 1 - SM%S%XSIC(:)) + SM%S%XTICE(:) * SM%S%XSIC(:)
@@ -410,15 +396,14 @@ ENDIF
!* 6. SBL air fields:
! --------------
!
- CALL READ_SEAFLUX_SBL_n(DTCO, SM%S, SM%SSB, U, &
- HPROGRAM)
+ CALL READ_SBL_n(DTCO, U, SM%SB, SM%S%LSBL, HPROGRAM, "SEA ")
!
!-------------------------------------------------------------------------------
!
!* 7. Chemistry /dust
! ---------
!
- CALL INIT_CHEMICAL_n(ILUOUT, KSV, HSV, SM%CHS%SVS, &
+ CALL INIT_CHEMICAL_n(ILUOUT, KSV, HSV, SM%CHS%SVS, &
SM%CHS%CCH_NAMES, SM%CHS%CAER_NAMES, &
HDSTNAMES=SM%CHS%CDSTNAMES, HSLTNAMES=SM%CHS%CSLTNAMES )
!
@@ -436,12 +421,15 @@ END IF
! --------------------------
!
IF(.NOT.(SM%S%LHANDLE_SIC.OR.LCPL_SEAICE))THEN
- SM%DGSI%LDIAG_SEAICE=.FALSE.
+ SM%SD%DMI%LDIAG_MISC_SEAICE=.FALSE.
ENDIF
!
- CALL DIAG_SEAFLUX_INIT_n(&
- SM%DGO, SM%DGS, SM%DGSI, DGU, SM%S, &
- HPROGRAM,ILU,KSW)
+ CALL DIAG_SEAFLUX_INIT_n(SM%SD%GO, SM%SD%O, SM%SD%D, SM%SD%DC, OREAD_BUDGETC, SM%S, &
+ HPROGRAM,ILU,KSW)
+IF (SM%S%LHANDLE_SIC.OR.LCPL_SEAICE) &
+ CALL DIAG_SEAICE_INIT_n(SM%SD%O, SM%SD%DI, SM%SD%DIC, SM%SD%DMI, &
+ OREAD_BUDGETC, SM%S, HPROGRAM,ILU,KSW)
+
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/init_sean.F90 b/src/SURFEX/init_sean.F90
index 97554fcd3a7850a37d68223c13a2e03d623734e1..04fd48c0fec3d899fb0900533aa1cf396132fb6b 100644
--- a/src/SURFEX/init_sean.F90
+++ b/src/SURFEX/init_sean.F90
@@ -3,15 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #############################################################
- SUBROUTINE INIT_SEA_n (DTCO, DGU, UG, U, SM, DGL,GCP, &
- HPROGRAM,HINIT, &
- KI,KSV,KSW, &
- HSV,PCO2,PRHOA, &
- PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD,PTSURF, &
- KYEAR, KMONTH,KDAY, PTIME, &
- HATMFILE,HATMFILETYPE, &
- HTEST )
+ SUBROUTINE INIT_SEA_n (DTCO, OREAD_BUDGETC, UG, U, GCP, SM, &
+ DGO, DL, DLC, HPROGRAM,HINIT,KI,KSV,KSW, &
+ HSV,PCO2,PRHOA, &
+ PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
+ PEMIS,PTSRAD,PTSURF, &
+ KYEAR, KMONTH,KDAY, PTIME, &
+ HATMFILE,HATMFILETYPE, &
+ HTEST )
! #############################################################
!
!!**** *INIT_SEA_n* - routine to initialize SEA
@@ -46,16 +45,14 @@
!* 0. DECLARATIONS
! ------------
!
-!
USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
!
USE MODD_CSTS, ONLY : XTT
!
@@ -74,12 +71,14 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+LOGICAL, INTENT(IN) :: OREAD_BUDGETC
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM
-TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: DL
+TYPE(DIAG_t), INTENT(INOUT) :: DLC
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize
@@ -125,17 +124,16 @@ IF (U%CSEA=='NONE ') THEN
PTSRAD =XTT
PTSURF =XTT
ELSE IF (U%CSEA=='FLUX ') THEN
- CALL INIT_IDEAL_FLUX(DGL, DGU%LREAD_BUDGETC, &
- HPROGRAM,HINIT,KI,KSV,KSW,HSV,PCO2,PRHOA, &
- PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD,PTSURF,'OK' )
+ CALL INIT_IDEAL_FLUX(DGO, DL, DLC, OREAD_BUDGETC, &
+ HPROGRAM,HINIT,KI,KSV,KSW,HSV,PDIR_ALB,PSCA_ALB, &
+ PEMIS,PTSRAD,PTSURF,'OK' )
ELSE IF (U%CSEA=='SEAFLX') THEN
- CALL INIT_SEAFLUX_n(DTCO, DGU, UG, U, SM,GCP, &
- HPROGRAM,HINIT,KI,KSV,KSW,HSV,PCO2,PRHOA, &
- PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD,PTSURF, &
- KYEAR,KMONTH,KDAY,PTIME,HATMFILE,HATMFILETYPE,&
- 'OK' )
+ CALL INIT_SEAFLUX_n(DTCO, OREAD_BUDGETC, UG, U, GCP, SM, &
+ HPROGRAM,HINIT,KI,KSV,KSW,HSV,PCO2,PRHOA, &
+ PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
+ PEMIS,PTSRAD,PTSURF, &
+ KYEAR,KMONTH,KDAY,PTIME,HATMFILE,HATMFILETYPE,&
+ 'OK' )
END IF
IF (LHOOK) CALL DR_HOOK('INIT_SEA_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/init_snow_lw.F90 b/src/SURFEX/init_snow_lw.F90
index 0de723f4dfff89b26f546f39a0cedad0bbdb3af6..7c6832d7110cbacaca6b9ccce03dc490a5d1bd12 100644
--- a/src/SURFEX/init_snow_lw.F90
+++ b/src/SURFEX/init_snow_lw.F90
@@ -58,47 +58,42 @@ TYPE(SURF_SNOW), INTENT(INOUT) :: TPSNOW ! snow characteristics
!* 0.2 Declarations of local variables
! -------------------------------
!
-INTEGER :: JPATCH ! loop counter on tiles
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('INIT_SNOW_LW',0,ZHOOK_HANDLE)
-DO JPATCH=1,SIZE(TPSNOW%WSNOW,3)
!
!* 1. Emissivity
! ----------
!
- IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
- WHERE(TPSNOW%WSNOW(:,1,JPATCH)==0. .OR. TPSNOW%WSNOW(:,1,JPATCH)==XUNDEF )
- TPSNOW%EMIS (:,JPATCH)= XUNDEF
- ELSEWHERE
- TPSNOW%EMIS (:,JPATCH)= PEMISSN
- END WHERE
- END IF
+IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
+ WHERE(TPSNOW%WSNOW(:,1)==0. .OR. TPSNOW%WSNOW(:,1)==XUNDEF )
+ TPSNOW%EMIS (:)= XUNDEF
+ ELSEWHERE
+ TPSNOW%EMIS (:)= PEMISSN
+ END WHERE
+END IF
!
!* 2. Surface temperature
! -------------------
!
- IF (TPSNOW%SCHEME=='1-L') THEN
- WHERE(TPSNOW%WSNOW(:,1,JPATCH)==0. .OR. TPSNOW%WSNOW(:,1,JPATCH)==XUNDEF )
- TPSNOW%TS (:,JPATCH)= XUNDEF
- ELSEWHERE
- TPSNOW%TS(:,JPATCH) = TPSNOW%T(:, TPSNOW%NLAYER,JPATCH)
- END WHERE
- END IF
-!
- IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
- WHERE(TPSNOW%WSNOW(:,1,JPATCH)==0. .OR. TPSNOW%WSNOW(:,1,JPATCH)==XUNDEF )
- TPSNOW%TS (:,JPATCH)= XUNDEF
- ELSEWHERE
- TPSNOW%TS(:,JPATCH) = XTT + (TPSNOW%HEAT(:,1,JPATCH) &
- + XLMTT * TPSNOW%RHO(:,1,JPATCH) ) &
- / SNOW3LSCAP(TPSNOW%RHO(:,1,JPATCH))
- TPSNOW%TS(:,JPATCH) = MIN(XTT, TPSNOW%TS(:,JPATCH))
- END WHERE
- END IF
-!
-END DO
+IF (TPSNOW%SCHEME=='1-L') THEN
+ WHERE(TPSNOW%WSNOW(:,1)==0. .OR. TPSNOW%WSNOW(:,1)==XUNDEF )
+ TPSNOW%TS (:)= XUNDEF
+ ELSEWHERE
+ TPSNOW%TS(:) = TPSNOW%T(:, TPSNOW%NLAYER)
+ END WHERE
+END IF
+!
+IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
+ WHERE(TPSNOW%WSNOW(:,1)==0. .OR. TPSNOW%WSNOW(:,1)==XUNDEF )
+ TPSNOW%TS (:)= XUNDEF
+ ELSEWHERE
+ TPSNOW%TS(:) = XTT + (TPSNOW%HEAT(:,1) + XLMTT * TPSNOW%RHO(:,1)) / SNOW3LSCAP(TPSNOW%RHO(:,1))
+ TPSNOW%TS(:) = MIN(XTT, TPSNOW%TS(:))
+ END WHERE
+END IF
+!
IF (LHOOK) CALL DR_HOOK('INIT_SNOW_LW',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/init_surf_atmn.F90 b/src/SURFEX/init_surf_atmn.F90
index 275701088a639e9b6a66a749efbad09cc6bf5cf6..b27a6b3ca737e694fde687c37f5e87bd1f4c6cc8 100644
--- a/src/SURFEX/init_surf_atmn.F90
+++ b/src/SURFEX/init_surf_atmn.F90
@@ -3,15 +3,12 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#############################################################
-SUBROUTINE INIT_SURF_ATM_n (YSC, &
- HPROGRAM,HINIT, OLAND_USE, &
- KI,KSV,KSW, &
- HSV,PCO2,PRHOA, &
+SUBROUTINE INIT_SURF_ATM_n (YSC, HPROGRAM,HINIT, OLAND_USE, &
+ KI,KSV,KSW, HSV,PCO2,PRHOA, &
PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
PEMIS,PTSRAD,PTSURF, &
- KYEAR, KMONTH,KDAY, PTIME, &
- HATMFILE,HATMFILETYPE, &
- HTEST )
+ KYEAR, KMONTH,KDAY, PTIME, TPDATE_END, &
+ HATMFILE,HATMFILETYPE, HTEST )
!#############################################################
!
!!**** *INIT_SURF_ATM_n* - routine to initialize GROUND
@@ -62,6 +59,7 @@ SUBROUTINE INIT_SURF_ATM_n (YSC, &
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TYPE_DATE_SURF, ONLY : DATE
!
USE MODD_SURFEX_n, ONLY : SURFEX_t
!
@@ -82,11 +80,10 @@ USE MODD_WRITE_SURF_ATM, ONLY : LNOWRITE_CANOPY, LNOWRITE_TEXFILE
!
USE MODD_SURFEX_MPI, ONLY : XTIME_INIT_SEA, XTIME_INIT_WATER, XTIME_INIT_NATURE, XTIME_INIT_TOWN, &
NRANK, NPIO, NSIZE
-USE MODD_SURFEX_OMP, ONLY : NINDX2SFX, NWORK, NWORK2, XWORK, XWORK2, XWORK3, &
- NWORK_FULL, NWORK2_FULL, XWORK_FULL, XWORK2_FULL, &
- NBLOCKTOT
+USE MODD_SURFEX_OMP, ONLY : NBLOCKTOT
!
USE MODD_MASK, ONLY: NMASK_FULL
+USE MODN_PREP_SURF_ATM, ONLY : LWRITE_EXTERN
!
USE MODI_INIT_IO_SURF_n
USE MODI_DEFAULT_SSO
@@ -97,7 +94,6 @@ USE MODI_READ_SURF_ATM_CONF_n
USE MODI_READ_SURF_ATM_DATE
USE MODI_READ_NAM_PREP_SURF_n
USE MODI_READ_SURF
-USE MODI_GET_SIZES_PARALLEL
USE MODI_SUNPOS
USE MODI_GET_SIZE_FULL_n
USE MODI_READ_COVER_n
@@ -115,6 +111,8 @@ USE MODI_INIT_CHEMICAL_n
USE MODI_CH_INIT_DEPCONST
USE MODI_CH_INIT_EMISSION_n
USE MODI_CH_INIT_SNAP_n
+USE MODI_OPEN_NAMELIST
+USE MODI_CLOSE_NAMELIST
USE MODI_ABOR1_SFX
USE MODI_ALLOC_DIAG_SURF_ATM_n
USE MODI_GET_1D_MASK
@@ -137,20 +135,12 @@ USE MODI_INIT_CPL_GCM_n
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
-#ifdef AIX64
-!$ USE OMP_LIB
-#endif
-!
IMPLICIT NONE
!
#ifdef SFX_MPI
INCLUDE 'mpif.h'
#endif
!
-#ifndef AIX64
-!$ INCLUDE 'omp_lib.h'
-#endif
-!
!* 0.1 Declarations of arguments
! -------------------------
!
@@ -180,6 +170,7 @@ INTEGER, INTENT(IN) :: KMONTH ! current month (UTC)
INTEGER, INTENT(IN) :: KDAY ! current day (UTC)
REAL, INTENT(IN) :: PTIME ! current time since
! midnight (UTC, s)
+TYPE(DATE), INTENT(INOUT) :: TPDATE_END
!
CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! atmospheric file name
CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! atmospheric file type
@@ -194,6 +185,7 @@ INTEGER :: ISWB ! number of shortwave bands
INTEGER :: JTILE ! loop counter on tiles
INTEGER :: IRESP ! error return code
INTEGER :: ILUOUT ! unit of output listing file
+INTEGER :: ICH ! unit of input chemical file
INTEGER :: IVERSION, IBUGFIX ! surface version
!
INTEGER, DIMENSION(:), ALLOCATABLE :: ISIZE_OMP
@@ -220,8 +212,11 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZP_EMIS ! emissivity
REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSRAD ! radiative temperature
REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSURF ! surface effective temperature
!
+REAL, DIMENSION(:), ALLOCATABLE :: ZZ0VEG
REAL :: XTIME0
!
+INTEGER :: ISIZE_FULL
+!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
@@ -249,28 +244,28 @@ IF (LNAM_READ) THEN
!
! 0.1. Hard defaults
!
- CALL DEFAULT_SSO(YSC%USS%CROUGH,YSC%USS%XFRACZ0,YSC%USS%XCOEFBE)
- CALL DEFAULT_CH_SURF_ATM(YSC%CHU%CCHEM_SURF_FILE,YSC%CHU%LCH_SURF_EMIS)
- CALL DEFAULT_DIAG_SURF_ATM(YSC%DGU%N2M,YSC%DGU%LT2MMW,YSC%DGU%LSURF_BUDGET,YSC%DGU%L2M_MIN_ZS,&
- YSC%DGU%LRAD_BUDGET, &
- YSC%DGU%LCOEF,YSC%DGU%LSURF_VARS,YSC%DGU%LSURF_BUDGETC, &
- YSC%DGU%LRESET_BUDGETC,YSC%DGU%LSELECT, YSC%DGU%LPROVAR_TO_DIAG, &
- YSC%DGU%LDIAG_GRID, YSC%DGU%LFRAC, YSC%DGU%XDIAG_TSTEP )
+ CALL DEFAULT_SSO(YSC%USS%CROUGH, YSC%USS%XFRACZ0, YSC%USS%XCOEFBE)
+ CALL DEFAULT_CH_SURF_ATM(YSC%CHU%CCHEM_SURF_FILE, YSC%CHU%LCH_SURF_EMIS)
+ CALL DEFAULT_DIAG_SURF_ATM(YSC%DUO%N2M, YSC%DUO%LT2MMW, YSC%DUO%LSURF_BUDGET,&
+ YSC%DUO%L2M_MIN_ZS, YSC%DUO%LRAD_BUDGET, YSC%DUO%LCOEF,&
+ YSC%DUO%LSURF_VARS, YSC%DUO%LSURF_BUDGETC, &
+ YSC%DUO%LRESET_BUDGETC, YSC%DUO%LSELECT, &
+ YSC%DUO%LPROVAR_TO_DIAG, YSC%DUO%LDIAG_GRID, &
+ YSC%DUO%LFRAC, YSC%DUO%XDIAG_TSTEP, &
+ YSC%DUO%LSNOWDIMNC, YSC%DUO%LRESETCUMUL )
!
ENDIF
!
! 0.2. Defaults from file header
!
- CALL READ_DEFAULT_SURF_ATM_n(YSC%CHU, YSC%DGU, YSC%USS, &
- HPROGRAM)
+ CALL READ_DEFAULT_SURF_ATM_n(YSC%CHU, YSC%DUO, YSC%USS, HPROGRAM)
!
!* 1. Reading of configuration
! ------------------------
!
! 1.1. general options (diagnostics, etc...)
!
- CALL READ_SURF_ATM_CONF_n(YSC%CHU, YSC%DGU, YSC%USS, &
- HPROGRAM)
+ CALL READ_SURF_ATM_CONF_n(YSC%CHU, YSC%DUO, YSC%USS, HPROGRAM)
!
IF(XCO2UNCPL/=XUNDEF)THEN
WRITE(ILUOUT,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
@@ -295,21 +290,16 @@ SELECT CASE (HINIT)
CASE ('PRE')
! check that diagnostics are off if hinit=='pre'
- CALL PREP_CTRL_SURF_ATM(YSC%DGU%N2M,YSC%DGU%LSURF_BUDGET,YSC%DGU%L2M_MIN_ZS,YSC%DGU%LRAD_BUDGET,&
- YSC%DGU%LCOEF,YSC%DGU%LSURF_VARS, &
- YSC%DGU%LSURF_BUDGETC,YSC%DGU%LRESET_BUDGETC,LNOWRITE_TEXFILE,YSC%DGU%LSELECT,ILUOUT,&
- YSC%DGU%LPROVAR_TO_DIAG)
+ CALL PREP_CTRL_SURF_ATM(YSC%DUO, LNOWRITE_TEXFILE, ILUOUT)
! preparation of fields (date not present in PGD file)
IF (LNAM_READ) CALL READ_NAM_PREP_SURF_n(HPROGRAM)
- CALL READ_SURF_ATM_DATE(&
- HPROGRAM,HINIT,ILUOUT,HATMFILE,HATMFILETYPE,KYEAR,KMONTH,KDAY,PTIME,YSC%U%TTIME)
+ CALL READ_SURF_ATM_DATE(HPROGRAM,HINIT,ILUOUT,HATMFILE,HATMFILETYPE,KYEAR,KMONTH,KDAY,PTIME,YSC%U%TTIME)
CASE DEFAULT
- CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
- HPROGRAM,'FULL ','SURF ','READ ')
- CALL READ_SURF(&
- HPROGRAM,'DTCUR',YSC%U%TTIME,IRESP)
+ CALL INIT_IO_SURF_n(YSC%DTCO, YSC%U, HPROGRAM,'FULL ','SURF ','READ ')
+ CALL READ_SURF(HPROGRAM,'DTCUR',YSC%U%TTIME,IRESP)
CALL END_IO_SURF_n(HPROGRAM)
+ LWRITE_EXTERN = .FALSE.
END SELECT
!
@@ -322,138 +312,81 @@ END SELECT
! Initialisation for IO
!
CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ') ! change input file name to pgd name
- CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
- HPROGRAM,'FULL ','SURF ','READ ')
+ CALL INIT_IO_SURF_n(YSC%DTCO, YSC%U, HPROGRAM,'FULL ','SURF ','READ ')
+ CALL READ_SURF(HPROGRAM,'DIM_FULL ',YSC%U%NDIM_FULL, IRESP)
+ CALL END_IO_SURF_n(HPROGRAM)
+ CALL INIT_IO_SURF_n(YSC%DTCO, YSC%U, HPROGRAM,'FULL ','SURF ','READ ')
+
!
- CALL READ_SURF(&
- HPROGRAM,'VERSION',IVERSION,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'BUG',IBUGFIX,IRESP)
+ CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP)
!
IF (IVERSION>7 .OR. IVERSION==7 .AND.IBUGFIX>=2) THEN
- CALL READ_SURF(&
- HPROGRAM,'STORAGETYPE',YREAD,IRESP)
+ CALL READ_SURF(HPROGRAM,'STORAGETYPE',YREAD,IRESP)
ENDIF
! reading
!
- CALL READ_SURF(&
- HPROGRAM,'SEA ',YSC%U%CSEA ,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'WATER ',YSC%U%CWATER ,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'NATURE',YSC%U%CNATURE,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'TOWN ',YSC%U%CTOWN ,IRESP)
-!
- CALL READ_SURF(&
- HPROGRAM,'DIM_FULL ',YSC%U%NDIM_FULL, IRESP)
-IF (HINIT=='PRE') THEN
- NINDX2SFX = YSC%U%NDIM_FULL
- NSIZE = YSC%U%NDIM_FULL
- CALL END_IO_SURF_n(HPROGRAM)
- !Initialize full mask with good dimension
- IF (ALLOCATED(NMASK_FULL)) DEALLOCATE(NMASK_FULL)
- CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ')
- CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
- HPROGRAM,'FULL ','SURF ','READ ')
- ALLOCATE(NWORK(YSC%U%NDIM_FULL))
- ALLOCATE(XWORK(YSC%U%NDIM_FULL))
- ALLOCATE(NWORK2(YSC%U%NDIM_FULL,10))
- ALLOCATE(XWORK2(YSC%U%NDIM_FULL,10))
- ALLOCATE(XWORK3(YSC%U%NDIM_FULL,10,10))
- IF (NRANK==NPIO) THEN
- ALLOCATE(NWORK_FULL(YSC%U%NDIM_FULL))
- ALLOCATE(XWORK_FULL(YSC%U%NDIM_FULL))
- ALLOCATE(NWORK2_FULL(YSC%U%NDIM_FULL,10))
- ALLOCATE(XWORK2_FULL(YSC%U%NDIM_FULL,10))
- ELSE
- ALLOCATE(NWORK_FULL(0))
- ALLOCATE(XWORK_FULL(0))
- ALLOCATE(NWORK2_FULL(0,0))
- ALLOCATE(XWORK2_FULL(0,0))
- ENDIF
-ENDIF
- CALL READ_SURF(&
- HPROGRAM,'DIM_SEA ',YSC%U%NDIM_SEA, IRESP)
- CALL READ_SURF(&
- HPROGRAM,'DIM_NATURE',YSC%U%NDIM_NATURE,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'DIM_WATER ',YSC%U%NDIM_WATER, IRESP)
- CALL READ_SURF(&
- HPROGRAM,'DIM_TOWN ',YSC%U%NDIM_TOWN, IRESP)
- CALL READ_LECOCLIMAP(&
- HPROGRAM,YSC%U%LECOCLIMAP)
- CALL READ_ARRANGE_COVER(&
- HPROGRAM,YSC%U%LWATER_TO_NATURE,YSC%U%LTOWN_TO_ROCK)
- CALL READ_COVER_GARDEN(&
- HPROGRAM,YSC%U%LGARDEN)
+ CALL READ_SURF(HPROGRAM,'SEA ',YSC%U%CSEA ,IRESP)
+ CALL READ_SURF(HPROGRAM,'WATER ',YSC%U%CWATER ,IRESP)
+ CALL READ_SURF(HPROGRAM,'NATURE',YSC%U%CNATURE,IRESP)
+ CALL READ_SURF(HPROGRAM,'TOWN ',YSC%U%CTOWN ,IRESP)
+!
+!
+ CALL READ_SURF(HPROGRAM,'DIM_SEA ',YSC%U%NDIM_SEA, IRESP)
+ CALL READ_SURF(HPROGRAM,'DIM_NATURE',YSC%U%NDIM_NATURE,IRESP)
+ CALL READ_SURF(HPROGRAM,'DIM_WATER ',YSC%U%NDIM_WATER, IRESP)
+ CALL READ_SURF(HPROGRAM,'DIM_TOWN ',YSC%U%NDIM_TOWN, IRESP)
+!
+ CALL READ_LECOCLIMAP(HPROGRAM,YSC%U%LECOCLIMAP,YSC%U%LECOSG)
+ CALL READ_ARRANGE_COVER(HPROGRAM,YSC%U%LWATER_TO_NATURE,YSC%U%LTOWN_TO_ROCK)
+ CALL READ_COVER_GARDEN(HPROGRAM,YSC%U%LGARDEN)
!
!* reads if climatological LAI is used or not for ecoclimap2. If not, looks for year to be used.
- CALL READ_LCLIM_LAI(&
- HPROGRAM,LCLIM_LAI)
+ CALL READ_LCLIM_LAI(HPROGRAM,LCLIM_LAI)
IF (.NOT. LCLIM_LAI .AND. YSC%U%TTIME%TDATE%YEAR >= NECO2_START_YEAR &
- .AND. YSC%U%TTIME%TDATE%YEAR <= NECO2_END_YEAR ) YSC%DTCO%NYEAR=YSC%U%TTIME%TDATE%YEAR
+ .AND. YSC%U%TTIME%TDATE%YEAR <= NECO2_END_YEAR ) YSC%DTCO%NYEAR=YSC%U%TTIME%TDATE%YEAR
CALL INI_DATA_COVER(YSC%DTCO, YSC%U)
- CALL READ_ECO2_IRRIG(&
- YSC%DTCO, &
- HPROGRAM)
+ CALL READ_ECO2_IRRIG(YSC%DTCO, HPROGRAM)
!
!* 2. Cover fields and grid:
! ---------------------
!
! 2.0. Get number of points on this proc
!
- CALL GET_SIZE_FULL_n(YSC%U, &
- HPROGRAM,YSC%U%NDIM_FULL,YSC%U%NSIZE_FULL)
+ CALL GET_SIZE_FULL_n(HPROGRAM,YSC%U%NDIM_FULL,YSC%U%NSIZE_FULL,ISIZE_FULL)
+ YSC%U%NSIZE_FULL = ISIZE_FULL
!
! 2.1. Read cover
!
- CALL READ_COVER_n(YSC%DTCO, YSC%U, &
- HPROGRAM)
+ CALL READ_COVER_n(YSC%DTCO, YSC%U, HPROGRAM)
!
! 2.2. Read grid
!
-ALLOCATE(YSC%UG%XLAT (YSC%U%NSIZE_FULL))
-ALLOCATE(YSC%UG%XLON (YSC%U%NSIZE_FULL))
-ALLOCATE(YSC%UG%XMESH_SIZE (YSC%U%NSIZE_FULL))
+ALLOCATE(YSC%UG%G%XLAT (YSC%U%NSIZE_FULL))
+ALLOCATE(YSC%UG%G%XLON (YSC%U%NSIZE_FULL))
+ALLOCATE(YSC%UG%G%XMESH_SIZE(YSC%U%NSIZE_FULL))
ALLOCATE(YSC%USS%XZ0EFFJPDIR(YSC%U%NSIZE_FULL))
- CALL READ_GRID(&
- HPROGRAM,YSC%UG%CGRID,YSC%UG%XGRID_PAR,YSC%UG%XLAT,YSC%UG%XLON,YSC%UG%XMESH_SIZE,IRESP,YSC%USS%XZ0EFFJPDIR)
-YSC%UG%NGRID_PAR=SIZE(YSC%UG%XGRID_PAR)
+ CALL READ_GRID(HPROGRAM,YSC%UG%G,IRESP,YSC%USS%XZ0EFFJPDIR)
!
! 2.3. Initialize zenith and azimuth angles if not done yet
!
LZENITH = ALL(PZENITH /= XUNDEF)
-IF (.NOT. LZENITH) THEN
-!$OMP PARALLEL
-!$ NBLOCKTOT = OMP_GET_NUM_THREADS()
-!$OMP END PARALLEL
- ALLOCATE(ISIZE_OMP(0:NBLOCKTOT-1))
- CALL GET_SIZES_PARALLEL(YSC%DTCO, YSC%DGU, YSC%UG, YSC%U, &
- NBLOCKTOT,KI,0,ISIZE_OMP)
- CALL SUNPOS(ISIZE_OMP,KYEAR, KMONTH, KDAY, PTIME, YSC%UG%XLON, YSC%UG%XLAT, ZTSUN, ZZENITH, ZAZIM)
- DEALLOCATE(ISIZE_OMP)
-ENDIF
-
+IF (.NOT. LZENITH) CALL SUNPOS(KYEAR, KMONTH, KDAY, PTIME, YSC%UG%G%XLON, YSC%UG%G%XLAT, ZTSUN, ZZENITH, ZAZIM)
!
IF (HPROGRAM/='AROME '.AND.NRANK==NPIO) THEN
!
IF (.NOT.ASSOCIATED(YSC%UG%XGRID_FULL_PAR)) THEN
#ifdef MNH_PARALLEL
- CALL READ_GRIDTYPE(&
- HPROGRAM,YSC%UG%CGRID,YSC%UG%NGRID_PAR,YSC%U%NSIZE_FULL,.FALSE.,HDIR='H')
- ALLOCATE(YSC%UG%XGRID_FULL_PAR(YSC%UG%NGRID_PAR))
- CALL READ_GRIDTYPE(&
- HPROGRAM,YSC%UG%CGRID,YSC%UG%NGRID_PAR,YSC%U%NSIZE_FULL,.TRUE.,&
+ CALL READ_GRIDTYPE(HPROGRAM,YSC%UG%G%CGRID,YSC%UG%G%NGRID_PAR,YSC%U%NSIZE_FULL,.FALSE.,HDIR='H')
+ ALLOCATE(YSC%UG%XGRID_FULL_PAR(YSC%UG%G%NGRID_PAR))
+ CALL READ_GRIDTYPE(HPROGRAM,YSC%UG%G%CGRID,YSC%UG%G%NGRID_PAR,YSC%U%NSIZE_FULL,.TRUE.,&
YSC%UG%XGRID_FULL_PAR,IRESP,HDIR='H')
-#else
- CALL READ_GRIDTYPE(&
- HPROGRAM,YSC%UG%CGRID,YSC%UG%NGRID_PAR,YSC%U%NDIM_FULL,.FALSE.,HDIR='A')
- ALLOCATE(YSC%UG%XGRID_FULL_PAR(YSC%UG%NGRID_PAR))
- CALL READ_GRIDTYPE(&
- HPROGRAM,YSC%UG%CGRID,YSC%UG%NGRID_PAR,YSC%U%NDIM_FULL,.TRUE.,&
+#else
+ CALL READ_GRIDTYPE(HPROGRAM,YSC%UG%G%CGRID,YSC%UG%NGRID_FULL_PAR,YSC%U%NDIM_FULL,.FALSE.,HDIR='A')
+ ALLOCATE(YSC%UG%XGRID_FULL_PAR(YSC%UG%NGRID_FULL_PAR))
+ CALL READ_GRIDTYPE(HPROGRAM,YSC%UG%G%CGRID,YSC%UG%NGRID_FULL_PAR,YSC%U%NDIM_FULL,.TRUE.,&
YSC%UG%XGRID_FULL_PAR,IRESP,HDIR='A')
-#endif
+#endif
ENDIF
!
ENDIF
@@ -465,46 +398,37 @@ ENDIF
!
! 2.4 Initialize Chemical Emissions
!
- CALL READ_SURF(&
- HPROGRAM,'CH_EMIS',YSC%CHU%LCH_EMIS,IRESP)
+ CALL READ_SURF(HPROGRAM,'CH_EMIS',YSC%CHU%LCH_EMIS,IRESP)
!
IF (YSC%CHU%LCH_EMIS) THEN
!
IF ( IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3 ) THEN
YSC%CHU%CCH_EMIS='AGGR'
ELSE
- CALL READ_SURF(&
- HPROGRAM,'CH_EMIS_OPT',YSC%CHU%CCH_EMIS,IRESP)
+ CALL READ_SURF(HPROGRAM,'CH_EMIS_OPT',YSC%CHU%CCH_EMIS,IRESP)
END IF
!
- !
IF (YSC%CHU%CCH_EMIS=='AGGR') THEN
- CALL CH_INIT_EMISSION_n(&
- YSC%CHE, YSC%CHU, YSC%SV, &
+ CALL CH_INIT_EMISSION_n(YSC%CHE, YSC%CHU%XCONVERSION, YSC%SV%CSV, &
HPROGRAM,YSC%U%NSIZE_FULL,HINIT,PRHOA,YSC%CHU%CCHEM_SURF_FILE)
ELSE
- CALL CH_INIT_SNAP_n(&
- YSC%CHN, YSC%SV, &
- HPROGRAM,YSC%U%NSIZE_FULL,HINIT,PRHOA,YSC%CHU%CCHEM_SURF_FILE)
+ CALL CH_INIT_SNAP_n(YSC%CHN, YSC%SV%CSV, &
+ HPROGRAM,YSC%U%NSIZE_FULL,HINIT,PRHOA,YSC%CHU%CCHEM_SURF_FILE)
END IF
!
-END IF
- !
- !* 2.5 Initialization of dry deposition scheme (chemistry)
- !
+ENDIF
!
-IF (YSC%SV%NBEQ .GT. 0) THEN
+!* 2.5 Initialization of dry deposition scheme (chemistry)
!
- IF (HINIT=='ALL') CALL CH_INIT_DEPCONST(HPROGRAM, YSC%CHU%CCHEM_SURF_FILE,ILUOUT,YSC%SV%CSV(YSC%SV%NSV_CHSBEG:YSC%SV%NSV_CHSEND))
+IF (YSC%SV%NBEQ .GT. 0) THEN
!
+ IF (HINIT=='ALL') CALL CH_INIT_DEPCONST(HPROGRAM,YSC%CHU%CCHEM_SURF_FILE,ILUOUT,YSC%SV%CSV(YSC%SV%NSV_CHSBEG:YSC%SV%NSV_CHSEND))
!
END IF
!
!* 2.5 Subgrid orography
!
- CALL READ_SSO_n(&
- YSC%U, YSC%USS, &
- HPROGRAM)
+ CALL READ_SSO_n(YSC%U%NSIZE_FULL, YSC%U%XSEA, YSC%USS, HPROGRAM)
!
!* 2.6 Orographic roughness length
!
@@ -514,20 +438,21 @@ ALLOCATE(YSC%USS%XZ0EFFJP(YSC%U%NSIZE_FULL))
ALLOCATE(YSC%USS%XZ0EFFJM(YSC%U%NSIZE_FULL))
ALLOCATE(YSC%USS%XZ0REL (YSC%U%NSIZE_FULL))
!
- CALL SUBSCALE_Z0EFF(YSC%USS%XAOSIP,YSC%USS%XAOSIM,YSC%USS%XAOSJP,YSC%USS%XAOSJM, &
- YSC%USS%XHO2IP,YSC%USS%XHO2IM,YSC%USS%XHO2JP,YSC%USS%XHO2JM,0., &
- YSC%USS%XZ0EFFIP,YSC%USS%XZ0EFFIM,YSC%USS%XZ0EFFJP,YSC%USS%XZ0EFFJM, &
- YSC%USS%XZ0REL )
+ALLOCATE(ZZ0VEG(YSC%U%NSIZE_FULL))
+ZZ0VEG(:) = 0.
+!
+ CALL SUBSCALE_Z0EFF(YSC%USS,ZZ0VEG,.TRUE.)
+!
+DEALLOCATE(ZZ0VEG)
!
!* 2.7 Dummy fields
!
- CALL READ_DUMMY_n(&
- YSC%DUU,YSC% U, &
- HPROGRAM)
+ CALL READ_DUMMY_n(YSC%DUU,YSC%U%NSIZE_FULL, HPROGRAM)
!
! End of IO
!
CALL END_IO_SURF_n(HPROGRAM)
+!
CALL SET_SURFEX_FILEIN(HPROGRAM,'PREP') ! restore input file name
!
!-----------------------------------------------------------------------------------------------------
@@ -537,26 +462,24 @@ ALLOCATE(YSC%USS%XZ0REL (YSC%U%NSIZE_FULL))
!
! Initialisation for IO
!
- CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
- HPROGRAM,'FULL ','SURF ','READ ')
+ CALL INIT_IO_SURF_n(YSC%DTCO, YSC%U, HPROGRAM,'FULL ','SURF ','READ ')
!
!* 2.8 Allocations and Initialization of diagnostics
!
-IF (HINIT=='ALL') CALL ALLOC_DIAG_SURF_ATM_n(&
- YSC%DGU, YSC%U, &
- HPROGRAM,KSW)
-!
+IF (HINIT=='ALL') THEN
+ CALL ALLOC_DIAG_SURF_ATM_n(YSC%DUO, YSC%DU, YSC%DUC, YSC%DUP, YSC%DUPC, &
+ YSC%U%NSIZE_FULL, YSC%U%TTIME, HPROGRAM,KSW)
+ENDIF
!
!* Canopy fields if Beljaars et al 2004 parameterization is used
!
-IF (YSC%USS%CROUGH=='BE04') CALL READ_SSO_CANOPY_n(YSC%DTCO, YSC%SSCP, YSC%U, &
- HPROGRAM,HINIT)
+IF (YSC%USS%CROUGH=='BE04') THEN
+ CALL READ_SSO_CANOPY_n(YSC%DTCO, YSC%SB, YSC%U, HPROGRAM, HINIT)
+ENDIF
!
!* Physical fields need for ARPEGE/ALADIN climate run
!
- CALL INIT_CPL_GCM_n(&
- YSC%U, &
- HPROGRAM,HINIT)
+ CALL INIT_CPL_GCM_n(YSC%U, HPROGRAM,HINIT)
!
! End of IO
!
@@ -615,8 +538,8 @@ ZFRAC_TILE(:,JTILE) = YSC%U%XSEA(:)
!
! initialization
IF (YSC%U%NDIM_SEA>0) &
- CALL INIT_SEA_n(YSC%DTCO, YSC%DGU, YSC%UG, YSC%U, &
- YSC%SM, YSC%DGL,YSC%GCP, &
+ CALL INIT_SEA_n(YSC%DTCO, YSC%DUO%LREAD_BUDGETC, YSC%UG, YSC%U, YSC%GCP, &
+ YSC%SM, YSC%DLO, YSC%DL, YSC%DLC, &
HPROGRAM,HINIT,YSC%U%NSIZE_SEA,KSV,KSW, &
HSV,ZP_CO2,ZP_RHOA, &
ZP_ZENITH,ZP_AZIM,PSW_BANDS,ZP_DIR_ALB,ZP_SCA_ALB, &
@@ -644,8 +567,8 @@ ZFRAC_TILE(:,JTILE) = YSC%U%XWATER(:)
!
! initialization
IF (YSC%U%NDIM_WATER>0) &
- CALL INIT_INLAND_WATER_n(YSC%DTCO, YSC%DGU,YSC%UG, &
- YSC%U, YSC%WM, YSC%FM, YSC%DGL, &
+ CALL INIT_INLAND_WATER_n(YSC%DTCO, YSC%DUO%LREAD_BUDGETC, YSC%UG, &
+ YSC%U, YSC%WM, YSC%FM, YSC%DLO, YSC%DL, YSC%DLC, &
HPROGRAM,HINIT,YSC%U%NSIZE_WATER,KSV,KSW, &
HSV,ZP_CO2,ZP_RHOA, &
ZP_ZENITH,ZP_AZIM,PSW_BANDS,ZP_DIR_ALB,ZP_SCA_ALB, &
@@ -672,14 +595,15 @@ ZFRAC_TILE(:,JTILE) = YSC%U%XNATURE(:)
!
! initialization
IF (YSC%U%NDIM_NATURE>0) &
- CALL INIT_NATURE_n(YSC%DTCO, YSC%DGU, YSC%UG, YSC%U, YSC%IM, &
- YSC%DTZ, YSC%DGL, YSC%DST, YSC%SLT, YSC%SV,YSC%GCP, &
- HPROGRAM,HINIT,OLAND_USE,YSC%U%NSIZE_NATURE,KSV,KSW, &
- HSV,ZP_CO2,ZP_RHOA, &
+ CALL INIT_NATURE_n(YSC%DTCO, YSC%DUO%LREAD_BUDGETC, YSC%UG, YSC%U, &
+ YSC%USS, YSC%GCP, YSC%IM, YSC%DTZ, YSC%DLO, YSC%DL,&
+ YSC%DLC, YSC%NDST, YSC%SLT, YSC%SV, &
+ HPROGRAM,HINIT,OLAND_USE,YSC%U%NSIZE_NATURE, &
+ KSV,KSW, HSV,ZP_CO2,ZP_RHOA, &
ZP_ZENITH,ZP_AZIM,PSW_BANDS,ZP_DIR_ALB,ZP_SCA_ALB, &
ZP_EMIS,ZP_TSRAD,ZP_TSURF, &
- KYEAR,KMONTH,KDAY,PTIME, HATMFILE,HATMFILETYPE, &
- 'OK' )
+ KYEAR,KMONTH,KDAY,PTIME,TPDATE_END, &
+ HATMFILE,HATMFILETYPE,'OK' )
!
!
CALL UNPACK_SURF_INIT_ARG(JTILE,YSC%U%NSIZE_NATURE,YSC%U%NR_NATURE)
@@ -700,10 +624,9 @@ ZFRAC_TILE(:,JTILE) = YSC%U%XTOWN(:)
!
! initialization
IF (YSC%U%NDIM_TOWN>0) &
- CALL INIT_TOWN_n(YSC%DTCO, YSC%DGU, YSC%UG, YSC%U, &
- YSC%IM%CHI, YSC%IM%DTI, YSC%IM%I, &
- YSC%TM, YSC%GDM, YSC%GRM, YSC%DGL, YSC%DST, YSC%SLT, &
- YSC%GCP,HPROGRAM,HINIT,YSC%U%NSIZE_TOWN,KSV,KSW, &
+ CALL INIT_TOWN_n(YSC%DTCO, YSC%DUO%LREAD_BUDGETC, YSC%UG, YSC%U, YSC%GCP, &
+ YSC%TM, YSC%GDM, YSC%GRM, YSC%DLO, YSC%DL, YSC%DLC, &
+ HPROGRAM,HINIT,YSC%U%NSIZE_TOWN,KSV,KSW, &
HSV,ZP_CO2,ZP_RHOA, &
ZP_ZENITH,ZP_AZIM,PSW_BANDS,ZP_DIR_ALB,ZP_SCA_ALB, &
ZP_EMIS,ZP_TSRAD,ZP_TSURF, &
diff --git a/src/SURFEX/init_surfconsphy.F90 b/src/SURFEX/init_surfconsphy.F90
deleted file mode 100644
index eafc79301eccc72646cf9fe8acce60e9b99c5634..0000000000000000000000000000000000000000
--- a/src/SURFEX/init_surfconsphy.F90
+++ /dev/null
@@ -1,9 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
- SUBROUTINE INIT_SURFCONSPHY
-
-!RJ: dummy, can be removed
-
- END SUBROUTINE INIT_SURFCONSPHY
diff --git a/src/SURFEX/init_teb_garden_pgdn.F90 b/src/SURFEX/init_teb_garden_pgdn.F90
index 2ddd716ca98e583ca8929eb731bd7bd0bec12956..4b3b1ecc411bf3f734837708a4e54841024edd76 100644
--- a/src/SURFEX/init_teb_garden_pgdn.F90
+++ b/src/SURFEX/init_teb_garden_pgdn.F90
@@ -3,306 +3,274 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#############################################################
- SUBROUTINE INIT_TEB_GARDEN_PGD_n (DTCO, U, CHI, DTI, I, DST, SLT, CHT, TG, T, TOP, GDM, &
- HPROGRAM,HINIT, OREAD_PGD,KI, KSV, HSV, KVERSION, KBUGFIX, &
- PCO2, PRHOA)
- !#############################################################
- !
- !!**** *INIT_TEB_GARDEN_PGD_n* - routine to initialize ISBA
- !!
- !! PURPOSE
- !! -------
- !!
- !!** METHOD
- !! ------
- !!
- !! EXTERNAL
- !! --------
- !!
- !!
- !! IMPLICIT ARGUMENTS
- !! ------------------
- !!
- !! REFERENCE
- !! ---------
- !!
- !!
- !! AUTHOR
- !! ------
- !! A. Lemonsu *Meteo France*
- !!
- !! MODIFICATIONS
- !! -------------
- !! Original 09/2009
- !! 11/2013 (B. Decharme) No exp profile with DIF
- !-------------------------------------------------------------------------------
- !
- !* 0. DECLARATIONS
- ! ------------
- !
- !
- USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
- USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
- USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
- USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
- USE MODD_ISBA_n, ONLY : ISBA_t
- USE MODD_DST_n, ONLY : DST_t
- USE MODD_SLT_n, ONLY : SLT_t
- USE MODD_CH_TEB_n, ONLY : CH_TEB_t
- USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
- USE MODD_TEB_n, ONLY : TEB_t
- USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
- USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t
- !
- USE MODD_TYPE_DATE_SURF
- USE MODD_TYPE_SNOW
- !
-
- USE MODD_DATA_COVER_PAR, ONLY: NVEGTYPE
- USE MODD_SURF_PAR, ONLY: XUNDEF, NUNDEF
+SUBROUTINE INIT_TEB_GARDEN_PGD_n (DTCO, U, OCH_BIO_FLUX, G, PGARDEN, TOP, IO, S, K, P, PEK, DTV, GB, &
+ HPROGRAM, HINIT, OPATCH1, KI, KVERSION, KBUGFIX, PCO2, PRHOA)
+!#############################################################
+!
+!!**** *INIT_TEB_GARDEN_PGD_n* - routine to initialize ISBA
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!&
+!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! A. Lemonsu *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 09/2009
+!! 11/2013 (B. Decharme) No exp profile with DIF
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t, SSO_INIT
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
+!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_P_t, ISBA_PE_t
+!
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t
+!
+USE MODD_AGRI_n, ONLY : AGRI_t
+!
+USE MODD_TYPE_DATE_SURF
+USE MODD_TYPE_SNOW
+!
+USE MODD_DATA_COVER_PAR, ONLY: NVEGTYPE
+USE MODD_SURF_PAR,ONLY: XUNDEF, NUNDEF
- USE MODD_SGH_PAR, ONLY: NDIMTAB, XF_DECAY
- !
- USE MODI_GET_LUOUT
- USE MODI_ALLOCATE_TEB_GARDEN_PGD
- USE MODI_READ_PGD_TEB_GARDEN_n
- USE MODI_CONVERT_PATCH_GARDEN
- USE MODI_INIT_FROM_DATA_GRDN_n
- USE MODI_INIT_VEG_PGD_GARDEN_n
- USE MODI_EXP_DECAY_SOIL_FR
- USE MODI_ABOR1_SFX
- !
- USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
- USE PARKIND1 ,ONLY : JPRB
- !
- IMPLICIT NONE
- !
- !* 0.1 Declarations of arguments
- ! -------------------------
- !
- !
- TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
- TYPE(SURF_ATM_t), INTENT(INOUT) :: U
- TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
- TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
- TYPE(ISBA_t), INTENT(INOUT) :: I
- TYPE(DST_t), INTENT(INOUT) :: DST
- TYPE(SLT_t), INTENT(INOUT) :: SLT
- TYPE(CH_TEB_t), INTENT(INOUT) :: CHT
- TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
- TYPE(TEB_t), INTENT(INOUT) :: T
- TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
- TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
- !
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
- CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize
- LOGICAL, INTENT(IN) :: OREAD_PGD ! flag to read PGD fields in the file
- INTEGER, INTENT(IN) :: KI ! number of points
- INTEGER, INTENT(IN) :: KSV ! number of scalars
- CHARACTER(LEN=6), DIMENSION(KSV), INTENT(IN) :: HSV ! name of all scalar variables
- INTEGER, INTENT(IN) :: KVERSION ! version number of the file being read
- INTEGER, INTENT(IN) :: KBUGFIX
- REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration (kg/m3)
- REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density
- !
- !
- !
- !* 0.2 Declarations of local variables
- ! -------------------------------
- !
- INTEGER :: JILU ! loop increment
- INTEGER :: ILUOUT ! unit of output listing file
- !
- INTEGER :: IDECADE ! decade of simulation
- !
- INTEGER :: JVEGTYPE, JLAYER ! loop counter on vegtypes
- !
- REAL, DIMENSION(KI) :: ZF
- REAL, DIMENSION(KI) :: ZWORK
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
- !
- !-------------------------------------------------------------------------------
- !
- ! Initialisation for IO
- !
- IF (LHOOK) CALL DR_HOOK('INIT_TEB_GARDEN_PGD_n',0,ZHOOK_HANDLE)
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
- !
- !-------------------------------------------------------------------------------
- !
- !* 2. Physiographic fields
- ! --------------------
- !
- !* allocation of urban green area variables
- !
- CALL ALLOCATE_TEB_GARDEN_PGD(GDM%TGDPE, GDM%TGDP, &
- OREAD_PGD, KI, NVEGTYPE, GDM%TGDO%NGROUND_LAYER, NDIMTAB)
- !
- !
- !* 2.1 Cover, soil and orographic fields:
- ! ---------------------------------
- !
- IF (OREAD_PGD) &
- CALL READ_PGD_TEB_GARDEN_n(CHT, DTCO, GDM%DTGD, GDM%GBGD, U, GDM%TGDO, GDM%TGDP, TG, TOP, &
- HPROGRAM,KVERSION,KBUGFIX)
- !
- !
- !* 2.3 Physiographic data fields from land cover:
- ! -----------------------------------------
- !
- IF (TOP%TTIME%TDATE%MONTH /= NUNDEF) THEN
- IDECADE = 3 * ( TOP%TTIME%TDATE%MONTH - 1 ) + MIN(TOP%TTIME%TDATE%DAY-1,29) / 10 + 1
- ELSE
- IDECADE = 1
- END IF
- !
- !
- IF (.NOT. GDM%TGDO%LPAR_GARDEN) THEN
- CALL CONVERT_PATCH_GARDEN(DTCO, DTI, I, GDM%TGDO, GDM%TGDPE, GDM%TGDP, TOP, GDM%TVG, &
- KI,IDECADE)
- ELSE
- CALL INIT_FROM_DATA_GRDN_n(GDM%DTGD, &
- IDECADE,GDM%TVG%CPHOTO, GDM%TGDPE%CUR%XVEG, &
- GDM%TGDPE%CUR%XLAI,GDM%TGDP%XRSMIN,GDM%TGDP%XGAMMA,&
- GDM%TGDP%XWRMAX_CF, GDM%TGDP%XRGL,GDM%TGDP%XCV,GDM%TGDP%XDG,&
- GDM%TGDP%XD_ICE,GDM%TGDPE%CUR%XZ0,GDM%TGDP%XZ0_O_Z0H,&
- GDM%TGDP%XALBNIR_VEG,GDM%TGDP%XALBVIS_VEG, &
- GDM%TGDP%XALBUV_VEG,GDM%TGDPE%CUR%XEMIS, &
- GDM%TGDP%XVEGTYPE,GDM%TGDP%XROOTFRAC,GDM%TGDP%XGMES,&
- GDM%TGDP%XBSLAI,GDM%TGDP%XLAIMIN,GDM%TGDP%XSEFOLD,GDM%TGDP%XGC, &
- GDM%TGDP%XDMAX, GDM%TGDP%XF2I, GDM%TGDP%LSTRESS, GDM%TGDP%XH_TREE,&
- GDM%TGDP%XRE25,GDM%TGDP%XCE_NITRO,GDM%TGDP%XCF_NITRO,GDM%TGDP%XCNA_NITRO )
+USE MODD_SGH_PAR, ONLY: XF_DECAY
+!
+USE MODI_READ_PREP_GARDEN_SNOW
+USE MODI_GET_LUOUT
+USE MODI_ALLOCATE_TEB_VEG_PGD
+USE MODI_READ_PGD_TEB_GARDEN_n
+USE MODI_CONVERT_PATCH_ISBA
+USE MODI_INIT_FROM_DATA_TEB_VEG_n
+USE MODI_INIT_VEG_PGD_n
+USE MODI_EXP_DECAY_SOIL_FR
+USE MODI_ABOR1_SFX
+USE MODI_AV_PGD
+!
+USE MODE_TEB_VEG
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+LOGICAL, INTENT(IN) :: OCH_BIO_FLUX
+TYPE(GRID_t), INTENT(INOUT) :: G
+REAL, DIMENSION(:), INTENT(IN) :: PGARDEN
+TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_P_t), INTENT(INOUT) :: P
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+TYPE(GR_BIOG_t), INTENT(INOUT) :: GB
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+ CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize
+LOGICAL, INTENT(IN) :: OPATCH1 ! flag to read PGD fields in the file
+INTEGER, INTENT(IN) :: KI! number of points
+INTEGER, INTENT(IN) :: KVERSION ! version number of the file being read
+INTEGER, INTENT(IN) :: KBUGFIX
+REAL, DIMENSION(KI), INTENT(IN) :: PCO2! CO2 concentration (kg/m3)
+REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density
+!
+!
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+TYPE(SSO_t) :: YSS
+TYPE(AGRI_t) :: YAG
+!
+INTEGER :: JILU ! loop increment
+INTEGER :: ILUOUT ! unit of output listing file
+!
+INTEGER :: IDECADE ! decade of simulation
+!
+INTEGER :: JVEG, JI ! loop counter on vegtypes
+!
+REAL, DIMENSION(KI) :: ZF
+REAL, DIMENSION(KI) :: ZWORK
+!
+REAL, DIMENSION(0) :: ZTDEEP_CLI, ZGAMMAT_CLI, ZTHRESHOLD
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+!
+! Initialisation for IO
+!
+IF (LHOOK) CALL DR_HOOK('INIT_TEB_GARDEN_PGD_n',0,ZHOOK_HANDLE)
+!
+ CALL GET_LUOUT(HPROGRAM,ILUOUT)
+!
+CALL SSO_INIT(YSS)
+!
+!* 1. Reading of snow configuration:
+! ------------------------------
+!
+!* initialization of snow scheme (TSNOW defined in MODD_TEB_GARDEN_n)
+!
+IF (HINIT=='PRE') THEN
+ CALL READ_PREP_GARDEN_SNOW(HPROGRAM,PEK%TSNOW%SCHEME,PEK%TSNOW%NLAYER)
+!
+ IF (PEK%TSNOW%SCHEME.NE.'3-L' .AND. PEK%TSNOW%SCHEME.NE.'CRO' .AND. IO%CISBA=='DIF') THEN
+ CALL ABOR1_SFX("INIT_TEB_GARDEN_n: WITH CISBA = DIF, CSNOW MUST BE 3-L OR CRO")
+ ENDIF
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. Physiographic fields
+! --------------------
+!
+!* allocation of urban green area variables
+!
+ CALL ALLOCATE_TEB_VEG_PGD(PEK, S, K, P, OPATCH1, KI, NVEGTYPE, IO%NGROUND_LAYER )
+!
+!
+!* 2.1 Cover, soil and orographic fields:
+! ---------------------------------
+!
+IF (TOP%TTIME%TDATE%MONTH /= NUNDEF) THEN
+ IDECADE = 3 * ( TOP%TTIME%TDATE%MONTH - 1 ) + MIN(TOP%TTIME%TDATE%DAY-1,29) / 10 + 1
+ELSE
+ IDECADE = 1
+END IF
+!
+IF (OPATCH1) THEN
+ !
+ CALL READ_PGD_TEB_GARDEN_n(OCH_BIO_FLUX, DTCO, DTV, GB, U, &
+ IO, K, G%NDIM, TOP, HPROGRAM,KVERSION,KBUGFIX)
+ !
+ ALLOCATE(S%XVEGTYPE(KI,NVEGTYPE))
+ IF (IO%LPAR) THEN
+ S%XVEGTYPE = DTV%XPAR_VEGTYPE
+ ELSE
+ !classical ecoclimap case
+ DO JVEG=1,NVEGTYPE
+ CALL AV_PGD(DTCO, S%XVEGTYPE(:,JVEG),TOP%XCOVER ,DTCO%XDATA_VEGTYPE(:,JVEG),'GRD','ARI',TOP%LCOVER)
+ END DO
+ ENDIF
+ DO JVEG=1,NVEGTYPE
+ WHERE (PGARDEN==0)
+ S%XVEGTYPE(:,JVEG) = 0.
+ S%XVEGTYPE(:,1) = 1.
+ END WHERE
+ ENDDO
+ !
+ ALLOCATE(S%XPATCH(KI,1),P%XPATCH(KI))
+ ALLOCATE(S%XVEGTYPE_PATCH(KI,NVEGTYPE,1),P%XVEGTYPE_PATCH(KI,NVEGTYPE))
+ S%XPATCH(:,1) = 1.
+ P%XPATCH(:) = S%XPATCH(:,1)
+ S%XVEGTYPE_PATCH(:,:,1) = S%XVEGTYPE
+ P%XVEGTYPE_PATCH(:,:) = S%XVEGTYPE_PATCH(:,:,1)
+ P%NSIZE_P = KI
+ ALLOCATE(P%NR_P(KI))
+ DO JI = 1,SIZE(P%NR_P)
+ P%NR_P(JI) = JI
+ ENDDO
+ !
+ IF (.NOT. IO%LPAR) THEN
+ CALL CONVERT_PATCH_ISBA(DTCO, DTV, IO, IDECADE, IDECADE, TOP%XCOVER, TOP%LCOVER,&
+ .FALSE.,'GRD', 1, K, P, PEK, &
+ .TRUE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., &
+ PSOILGRID=IO%XSOILGRID )
+ ELSE
+ CALL INIT_FROM_DATA_TEB_VEG_n(DTV, K, P, PEK, IDECADE, .FALSE., .TRUE., .FALSE.,.FALSE.)
+ ENDIF
+ !
+ ALLOCATE(S%XWSN_WR(0,0,1))
+ ALLOCATE(S%XRHO_WR(0,0,1))
+ ALLOCATE(S%XALB_WR(0,1))
+ ALLOCATE(S%XHEA_WR(0,0,1))
+ ALLOCATE(S%XAGE_WR(0,0,1))
+ ALLOCATE(S%XSG1_WR(0,0,1))
+ ALLOCATE(S%XSG2_WR(0,0,1))
+ ALLOCATE(S%XHIS_WR(0,0,1))
+ !
+END IF
- IF (GDM%TVG%CISBA=='DIF') THEN
- WHERE(T%CUR%XGARDEN(:)/=0.)
- GDM%TGDP%NWG_LAYER(:)=GDM%TGDO%NGROUND_LAYER
- GDM%TGDP%XDG2 (:)=0.0
- GDM%TGDP%XDROOT(:)=0.0
- ENDWHERE
- DO JLAYER=GDM%TGDO%NGROUND_LAYER,1,-1
- DO JILU=1,KI
- IF(T%CUR%XGARDEN(JILU)/=0..AND.GDM%TGDP%XROOTFRAC(JILU,JLAYER)>=1.0)THEN
- GDM%TGDP%XDG2 (JILU)=GDM%TGDP%XDG(JILU,JLAYER)
- GDM%TGDP%XDROOT(JILU)=GDM%TGDP%XDG(JILU,JLAYER)
- ENDIF
- ENDDO
- ENDDO
- ENDIF
+!
+!
+!* 2.3 Physiographic data fields from land cover:
+! -----------------------------------------
+!
+!
+!
+!
+IF (.NOT. IO%LPAR) THEN
+ CALL CONVERT_PATCH_ISBA(DTCO, DTV, IO, IDECADE, IDECADE, TOP%XCOVER, TOP%LCOVER,&
+ .FALSE.,'GRD', 1, K, P, PEK, &
+ .FALSE., .TRUE., .FALSE., .FALSE., .FALSE., .FALSE. )
+ELSE
- END IF
- !
+ CALL INIT_FROM_DATA_TEB_VEG_n(DTV, K, P, PEK, IDECADE, .FALSE., .FALSE., .TRUE.,.FALSE.)
- WHERE (T%CUR%XGARDEN(:)==0.)
- GDM%TGDPE%CUR%XVEG(:)=0.
- GDM%TGDPE%CUR%XLAI(:)=0.
- GDM%TGDP%XRSMIN(:)=40.
- GDM%TGDP%XGAMMA(:)=0.
- GDM%TGDP%XWRMAX_CF(:)=0.2
- GDM%TGDP%XRGL(:)=100.
- GDM%TGDP%XCV(:)=2.E-5
- GDM%TGDPE%CUR%XZ0(:)=0.013
- GDM%TGDP%XZ0_O_Z0H(:)=10.
- GDM%TGDP%XALBNIR_VEG(:)=0.30
- GDM%TGDP%XALBVIS_VEG(:)=0.30
- GDM%TGDP%XALBUV_VEG(:)=0.06
- GDM%TGDPE%CUR%XEMIS(:)=0.94
- ENDWHERE
- IF (GDM%TVG%CPHOTO/='NON') THEN
- WHERE (T%CUR%XGARDEN(:)==0.)
- GDM%TGDP%XGMES(:)=0.020
- GDM%TGDP%XBSLAI(:)=0.36
- GDM%TGDP%XLAIMIN(:)=0.3
- GDM%TGDP%XSEFOLD(:)=90*86400.
- GDM%TGDP%XH_TREE(:)=0.
- GDM%TGDP%XRE25(:)=3.6E-7
- GDM%TGDP%XGC(:)=0.00025
- END WHERE
- IF (GDM%TVG%CPHOTO/='AGS' .AND. GDM%TVG%CPHOTO/='LAI') THEN
- WHERE (T%CUR%XGARDEN(:)==0.)
- GDM%TGDP%XDMAX(:)=0.1
- GDM%TGDP%XF2I(:)=0.3
- END WHERE
- IF (GDM%TVG%CPHOTO=='NIT' .OR. GDM%TVG%CPHOTO=='NCB') THEN
- WHERE (T%CUR%XGARDEN(:)==0.)
- GDM%TGDP%XCE_NITRO(:)=7.68
- GDM%TGDP%XCF_NITRO(:)=-4.33
- GDM%TGDP%XCNA_NITRO(:)=1.3
- END WHERE
- ENDIF
- ENDIF
- ENDIF
- IF(GDM%TVG%CISBA/='DIF')THEN
- DO JLAYER=1,GDM%TGDO%NGROUND_LAYER
- WHERE (T%CUR%XGARDEN(:)==0.)
- GDM%TGDP%XDG(:,JLAYER)=0.2*JLAYER
- END WHERE
- ENDDO
- ELSE
- WHERE (T%CUR%XGARDEN(:)==0.)
- GDM%TGDP%XDG(:,1)=0.01
- GDM%TGDP%XDG(:,2)=0.04
- GDM%TGDP%XROOTFRAC(:,1)=0.
- GDM%TGDP%XROOTFRAC(:,2)=0.
- END WHERE
- DO JLAYER=3,GDM%TGDO%NGROUND_LAYER
- WHERE (T%CUR%XGARDEN(:)==0.)
- GDM%TGDP%XDG(:,JLAYER)=0.1*(JLAYER-2)
- GDM%TGDP%XROOTFRAC(:,JLAYER)=0.
- END WHERE
- ENDDO
- WHERE (T%CUR%XGARDEN(:)==0.)
- GDM%TGDP%NWG_LAYER(:)=GDM%TGDO%NGROUND_LAYER
- GDM%TGDP%XDROOT (:)=0.0
- GDM%TGDP%XDG2 (:)=GDM%TGDP%XDG(:,GDM%TGDO%NGROUND_LAYER-1)
- ENDWHERE
- ENDIF
- WHERE (T%CUR%XGARDEN(:)==0.)
- GDM%TGDP%XD_ICE(:)=0.8*GDM%TGDP%XDG(:,2)
- END WHERE
- DO JVEGTYPE=1,NVEGTYPE
- WHERE (T%CUR%XGARDEN(:)==0.)
- GDM%TGDP%XVEGTYPE(:,JVEGTYPE)=0.
- GDM%TGDP%XVEGTYPE(:,1)=1.
- END WHERE
- ENDDO
- !
- CALL INIT_VEG_PGD_GARDEN_n(CHI, DTCO, DST, I, SLT, U, &
- HPROGRAM, ILUOUT, KI, GDM%TGDO%NGROUND_LAYER, TOP%TTIME%TDATE%MONTH, &
- GDM%TGDP%XVEGTYPE, GDM%TGDP%XTDEEP, GDM%TGDP%XGAMMAT, GDM%TVG%CPHOTO, HINIT, &
- GDM%TVG%LTR_ML, GDM%TVG%CRUNOFF, GDM%TVG%NNBIOMASS, PCO2, PRHOA, &
- GDM%TGDP%XABC, GDM%TGDP%XPOI, GDM%TGDP%XGMES, GDM%TGDP%XGC, GDM%TGDP%XDMAX, &
- GDM%TGDP%XANMAX, GDM%TGDP%XFZERO, GDM%TGDP%XEPSO, GDM%TGDP%XGAMM, GDM%TGDP%XQDGAMM, &
- GDM%TGDP%XQDGMES, GDM%TGDP%XT1GMES, GDM%TGDP%XT2GMES, GDM%TGDP%XAMAX, GDM%TGDP%XQDAMAX, &
- GDM%TGDP%XT1AMAX, GDM%TGDP%XT2AMAX,GDM%TGDP%XAH, GDM%TGDP%XBH, &
- KSV, HSV, CHT%SVT, CHT%CCH_NAMES, CHT%CAER_NAMES,CHT%CDSTNAMES, CHT%CSLTNAMES, &
- CHT%CCHEM_SURF_FILE, GDM%TGDP%XCLAY, GDM%TGDP%XSAND, GDM%TVG%CPEDOTF, &
- GDM%TGDP%XCONDSAT, GDM%TGDP%XMPOTSAT, GDM%TGDP%XBCOEF, GDM%TGDP%XWWILT, &
- GDM%TGDP%XWFC, GDM%TGDP%XWSAT, GDM%TGDP%XTAUICE, GDM%TGDP%XCGSAT, GDM%TGDP%XC1SAT, &
- GDM%TGDP%XC2REF, GDM%TGDP%XC3, GDM%TGDP%XC4B, GDM%TGDP%XACOEF, GDM%TGDP%XPCOEF, &
- GDM%TGDP%XC4REF, GDM%TGDP%XPCPS, GDM%TGDP%XPLVTT, GDM%TGDP%XPLSTT, &
- GDM%TVG%CSCOND, GDM%TVG%CISBA, GDM%TGDP%XHCAPSOIL, GDM%TGDP%XCONDDRY, &
- GDM%TGDP%XCONDSLD, GDM%TVG%CCPSURF, GDM%TGDP%XDG, GDM%TGDP%XDROOT, GDM%TGDP%XDG2, &
- GDM%TGDP%XROOTFRAC, GDM%TGDP%XRUNOFFD, GDM%TGDP%XDZG, GDM%TGDP%XDZDIF, &
- GDM%TGDP%XSOILWGHT, GDM%TGDP%NWG_LAYER, GDM%TGDO%NLAYER_HORT, &
- GDM%TGDO%NLAYER_DUN, GDM%TGDP%XD_ICE, &
- GDM%TGDP%XKSAT_ICE, GDM%TGDP%XALBNIR_DRY, GDM%TGDP%XALBVIS_DRY, GDM%TGDP%XALBUV_DRY, &
- GDM%TGDP%XALBNIR_WET, GDM%TGDP%XALBVIS_WET, GDM%TGDP%XALBUV_WET, GDM%TGDP%XBSLAI_NITRO, &
- GDM%TGDP%XCE_NITRO, GDM%TGDP%XCNA_NITRO, GDM%TGDP%XCF_NITRO )
+ IF (IO%CISBA=='DIF') CALL INIT_IF_DIF(IO%NGROUND_LAYER, PGARDEN, P)
+
+END IF
+!
+ CALL INIT_IF_NOVEG(PGARDEN, IO, S, P, PEK)
+!
+ALLOCATE(K%XVEGTYPE(KI,NVEGTYPE))
+K%XVEGTYPE = S%XVEGTYPE
+!
+ALLOCATE(YSS%XAOSIP(0))
+!
+ CALL INIT_VEG_PGD_n(YSS, DTV, IO, S, K, K, P, PEK, YAG, KI, &
+ HPROGRAM, 'TOWN ',ILUOUT, KI, TOP%TTIME%TDATE%MONTH, &
+ .FALSE., .FALSE., ZTDEEP_CLI, ZGAMMAT_CLI, &
+ .FALSE., ZTHRESHOLD, HINIT, PCO2, PRHOA )
!
!-------------------------------------------------------------------------------
!
-IF(GDM%TVG%CISBA=='DIF'.AND.GDM%TVG%LSOC)THEN
+IF(IO%CISBA=='DIF'.AND.IO%LSOC)THEN
CALL ABOR1_SFX('INIT_TEB_GARDEN_PGDn: SUBGRID Soil organic matter'//&
- ' effect (LSOC) NOT YET IMPLEMENTED FOR GARDEN')
-ELSEIF (GDM%TVG%CISBA=='3-L'.AND.GDM%TVG%CKSAT=='EXP') THEN
+ ' effect (LSOC) NOT YET IMPLEMENTED FOR GARDEN')
+ELSEIF (IO%CISBA=='3-L'.AND.IO%CKSAT=='EXP') THEN
CALL ABOR1_SFX('INIT_TEB_GARDEN_PGDn: topmodel exponential decay not implemented for garden')
ENDIF
!
-IF(GDM%TVG%CKSAT=='SGH' .AND. GDM%TVG%CISBA/='DIF' .AND. HINIT/='PRE')THEN
- ZF(:)=MIN(4.0/GDM%TGDP%XDG(:,2),XF_DECAY)
- CALL EXP_DECAY_SOIL_FR(GDM%TVG%CISBA, ZF(:),GDM%TGDP%XC1SAT(:),GDM%TGDP%XC2REF(:),&
- GDM%TGDP%XDG(:,:),GDM%TGDP%XD_ICE(:),GDM%TGDP%XC4REF(:),&
- GDM%TGDP%XC3(:,:),GDM%TGDP%XCONDSAT(:,:),GDM%TGDP%XKSAT_ICE(:))
+IF(IO%CKSAT=='SGH' .AND. IO%CISBA/='DIF' .AND. HINIT/='PRE')THEN
+ ZF(:)=MIN(4.0/P%XDG(:,2),XF_DECAY)
+ CALL EXP_DECAY_SOIL_FR(IO%CISBA, ZF, P)
ENDIF
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/init_teb_gardenn.F90 b/src/SURFEX/init_teb_gardenn.F90
index 25335a2ed61fddf2e212790f799bde86087a007b..9bc1f1acde4054574000e813100f5944338a4db9 100644
--- a/src/SURFEX/init_teb_gardenn.F90
+++ b/src/SURFEX/init_teb_gardenn.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#############################################################
-SUBROUTINE INIT_TEB_GARDEN_n (DTCO, DGU, UG, U, DGMTO, TOP, GDM, &
- HPROGRAM,HINIT,KI,KSW,PSW_BANDS,KPATCH)
+SUBROUTINE INIT_TEB_GARDEN_n (DTCO, UG, U, DMTO, TOP, IO, DTV, K, P, PEK, &
+ DK, DEK, DECK, DMK, HPROGRAM, HINIT, KI, KSW, PSW_BANDS, KPATCH)
!#############################################################
!
!!**** *INIT_TEB_GARDEN_n* - routine to initialize ISBA
@@ -39,31 +39,35 @@ SUBROUTINE INIT_TEB_GARDEN_n (DTCO, DGU, UG, U, DGMTO, TOP, GDM, &
! ------------
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_DIAG_MISC_TEB_OPTION_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
+USE MODD_DIAG_MISC_TEB_OPTIONS_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t
+!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_ISBA_n, ONLY : ISBA_P_t, ISBA_K_t, ISBA_PE_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
!
USE MODD_TYPE_DATE_SURF
USE MODD_TYPE_SNOW
!
-
USE MODD_DATA_COVER_PAR, ONLY: NVEGTYPE
USE MODD_SURF_PAR, ONLY: XUNDEF, NUNDEF
USE MODD_SURF_ATM, ONLY: LCPL_ARP
!
USE MODI_GET_LUOUT
-USE MODI_READ_PREP_GARDEN_SNOW
-USE MODI_ALLOCATE_TEB_GARDEN
+USE MODI_ALLOCATE_TEB_VEG
USE MODI_ABOR1_SFX
USE MODI_READ_TEB_GARDEN_n
-USE MODI_INIT_VEG_GARDEN_n
+USE MODI_INIT_VEG_n
USE MODI_SOIL_ALBEDO
-USE MODI_INIT_FROM_DATA_GRDN_n
-USE MODI_AVG_ALBEDO_EMIS_GARDEN
+USE MODI_INIT_FROM_DATA_TEB_VEG_n
+USE MODI_AVG_ALBEDO_EMIS_TEB_VEG
+USE MODI_DIAG_TEB_VEG_INIT_n
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -75,12 +79,20 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: DGMTO
+TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: DMTO
TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
-TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
+!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_P_t), INTENT(INOUT) :: P
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(DIAG_t), INTENT(INOUT) :: DK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DECK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize
@@ -116,29 +128,15 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('INIT_TEB_GARDEN_N',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
-!* 1. Reading of snow configuration:
-! ------------------------------
-!
-!* initialization of snow scheme (TSNOW defined in MODD_TEB_GARDEN_n)
-!
-IF (HINIT=='PRE') THEN
- CALL READ_PREP_GARDEN_SNOW(HPROGRAM,GDM%TGD%CUR%TSNOW%SCHEME,GDM%TGD%CUR%TSNOW%NLAYER)
+IO%CRAIN = "DEF"
!
- IF (GDM%TGD%CUR%TSNOW%SCHEME.NE.'3-L' .AND. &
- GDM%TGD%CUR%TSNOW%SCHEME.NE.'CRO' .AND. GDM%TVG%CISBA=='DIF') THEN
- CALL ABOR1_SFX("INIT_TEB_GARDEN_n: WITH CISBA = DIF, CSNOW MUST BE 3-L OR CRO")
- ENDIF
- IF (LHOOK) CALL DR_HOOK('INIT_TEB_GARDEN_N',1,ZHOOK_HANDLE)
- RETURN
-ENDIF
!-------------------------------------------------------------------------------
!
- CALL ALLOCATE_TEB_GARDEN(GDM%TGD, GDM%TVG, &
- KI, GDM%TGDO%NGROUND_LAYER)
+ CALL ALLOCATE_TEB_VEG(PEK, KI, IO%NGROUND_LAYER, IO%NNBIOMASS)
!
!-------------------------------------------------------------------------------
!
-IF( GDM%TVG%CCPSURF=='DRY' .AND. LCPL_ARP ) THEN
+IF( IO%CCPSURF=='DRY' .AND. LCPL_ARP ) THEN
CALL ABOR1_SFX('CCPSURF=DRY must not be used with LCPL_ARP')
ENDIF
!
@@ -150,6 +148,27 @@ IF (HINIT/='ALL') THEN
ENDIF
!
!-------------------------------------------------------------------------------
+! Variables needed to run isba
+!
+ALLOCATE(K%XFFLOOD (KI))
+ALLOCATE(K%XFF (KI))
+ALLOCATE(K%XFFG (KI))
+ALLOCATE(K%XFFV (KI))
+ALLOCATE(K%XFFROZEN(KI))
+ALLOCATE(K%XALBF (KI))
+ALLOCATE(K%XEMISF (KI))
+K%XFFLOOD = 0.0
+K%XFF = 0.0
+K%XFFG = 0.0
+K%XFFV = 0.0
+K%XFFROZEN = 0.0
+K%XALBF = 0.0
+K%XEMISF = 0.0
+!
+ALLOCATE(K%XFSAT(KI))
+K%XFSAT(:) = 0.0
+!
+!-------------------------------------------------------------------------------
!
!* 10. Prognostic and semi-prognostic fields
! -------------------------------------
@@ -157,56 +176,42 @@ ENDIF
!* allocation of urban green area variables
!
!
- YPATCH=' '
- IF (TOP%NTEB_PATCH>1) WRITE(YPATCH,FMT='(A,I1,A)') 'T',KPATCH,'_'
+YPATCH=' '
+IF (TOP%NTEB_PATCH>1) WRITE(YPATCH,FMT='(A,I1,A)') 'T',KPATCH,'_'
!
- CALL READ_TEB_GARDEN_n(DTCO, DGU, U, GDM, &
- HPROGRAM,YPATCH)
+ CALL READ_TEB_GARDEN_n(DTCO, U, IO, P, PEK, HPROGRAM,YPATCH)
!
+DTV%LIMP_VEG = .FALSE.
+DTV%LIMP_Z0 = .FALSE.
+DTV%LIMP_EMIS = .FALSE.
!
- CALL INIT_VEG_GARDEN_n(KI, TOP%LCANOPY, GDM%TVG%CROUGH, GDM%TGD%CUR%TSNOW, &
- GDM%TVG%CPHOTO, GDM%TGDP%XLAIMIN, GDM%TGDP%XH_TREE, GDM%TGDP%XVEGTYPE, &
- GDM%TGDPE%CUR%XLAI, GDM%TGDPE%CUR%XZ0, GDM%TGDPE%CUR%XVEG, GDM%TGDPE%CUR%XEMIS, &
- GDM%TVG%LTR_ML, GDM%TGD%CUR%XFAPARC, GDM%TGD%CUR%XFAPIRC, GDM%TGD%CUR%XLAI_EFFC, &
- GDM%TGD%CUR%XMUS, GDM%TGDP%XALBNIR_SOIL, GDM%TGDP%XALBVIS_SOIL, &
- GDM%TGDP%XALBUV_SOIL, GDM%TGDPE%CUR%XALBNIR, GDM%TGDPE%CUR%XALBVIS, &
- GDM%TGDPE%CUR%XALBUV, DGMTO%LSURF_DIAG_ALBEDO, GDM%TGD%CUR%XPSN, &
- GDM%TGD%CUR%XPSNG, GDM%TGD%CUR%XPSNV, GDM%TGD%CUR%XPSNV_A, &
- ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTSRAD )
+P%NSIZE_P = KI
+ CALL INIT_VEG_n(IO, K, P, PEK, DTV, DMTO%LSURF_DIAG_ALBEDO, ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTSRAD )
!
-ZWG1(:) = GDM%TGD%CUR%XWG(:,1)
-ZTG1(:) = GDM%TGD%CUR%XTG(:,1)
+ZWG1(:) = PEK%XWG(:,1)
+ZTG1(:) = PEK%XTG(:,1)
!
-IF (.NOT. GDM%TGDO%LPAR_GARDEN) THEN
- CALL SOIL_ALBEDO(GDM%TVG%CALBEDO, &
- GDM%TGDP%XWSAT(:,1),ZWG1, &
- GDM%TGDP%XALBVIS_DRY,GDM%TGDP%XALBNIR_DRY,GDM%TGDP%XALBUV_DRY, &
- GDM%TGDP%XALBVIS_WET,GDM%TGDP%XALBNIR_WET,GDM%TGDP%XALBUV_WET, &
- GDM%TGDP%XALBVIS_SOIL,GDM%TGDP%XALBNIR_SOIL,GDM%TGDP%XALBUV_SOIL )
+IF (.NOT. IO%LPAR) THEN
+ CALL SOIL_ALBEDO(IO%CALBEDO, K%XWSAT(:,1),ZWG1, K, PEK, "ALL" )
ELSE
IF (TOP%TTIME%TDATE%MONTH /= NUNDEF) THEN
IDECADE = 3 * ( TOP%TTIME%TDATE%MONTH - 1 ) + MIN(TOP%TTIME%TDATE%DAY-1,29) / 10 + 1
ELSE
IDECADE = 1
END IF
- CALL INIT_FROM_DATA_GRDN_n(GDM%DTGD, &
- IDECADE,GDM%TVG%CPHOTO, &
- PALBNIR_SOIL=GDM%TGDP%XALBNIR_SOIL, &
- PALBVIS_SOIL=GDM%TGDP%XALBVIS_SOIL, &
- PALBUV_SOIL=GDM%TGDP%XALBUV_SOIL )
+ CALL INIT_FROM_DATA_TEB_VEG_n(DTV, K, P, PEK, IDECADE, .FALSE., .FALSE., .FALSE., .TRUE. )
END IF
!
- CALL AVG_ALBEDO_EMIS_GARDEN(GDM%TGD, GDM%TVG%CALBEDO, &
- GDM%TGDPE%CUR%XVEG,GDM%TGDPE%CUR%XZ0,GDM%TGDPE%CUR%XLAI,ZTG1, &
- PSW_BANDS, &
- GDM%TGDP%XALBNIR_VEG,GDM%TGDP%XALBVIS_VEG,GDM%TGDP%XALBUV_VEG, &
- GDM%TGDP%XALBNIR_SOIL,GDM%TGDP%XALBVIS_SOIL,GDM%TGDP%XALBUV_SOIL, &
- GDM%TGDPE%CUR%XEMIS, GDM%TGD%CUR%TSNOW, &
- GDM%TGDPE%CUR%XALBNIR,GDM%TGDPE%CUR%XALBVIS,GDM%TGDPE%CUR%XALBUV, &
- ZDIR_ALB, ZSCA_ALB, &
- ZEMIS,ZTSRAD )
+
+WHERE (PEK%XALBNIR_SOIL(:)==XUNDEF)
+ PEK%XALBNIR_SOIL(:)=0.225
+ PEK%XALBVIS_SOIL(:)=0.15
+ PEK%XALBUV_SOIL (:)=0.07965
+ENDWHERE
!
+ CALL AVG_ALBEDO_EMIS_TEB_VEG(PEK, IO%CALBEDO, ZTG1, PSW_BANDS, ZDIR_ALB, ZSCA_ALB, ZEMIS,ZTSRAD )
!
+ CALL DIAG_TEB_VEG_INIT_n(DK, DEK, DECK, DMK, KI, PEK%TSNOW%NLAYER)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/init_teb_greenroof_pgdn.F90 b/src/SURFEX/init_teb_greenroof_pgdn.F90
index f446037b0ca740d9f1209d3940241b9ccbe9a8fb..55624d65b0af92517de609d2421138a20ec0da69 100644
--- a/src/SURFEX/init_teb_greenroof_pgdn.F90
+++ b/src/SURFEX/init_teb_greenroof_pgdn.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#############################################################
-SUBROUTINE INIT_TEB_GREENROOF_PGD_n (DTCO, U, CHI, DTI, I, DST, SLT, CHT, TG, T, TOP, TVG, GRM, &
- HPROGRAM,HINIT,OREAD_PGD, KI, KSV, HSV, KVERSION, PCO2, PRHOA)
+SUBROUTINE INIT_TEB_GREENROOF_PGD_n (DTCO, U, OCH_BIO_FLUX, G, PGREENROOF, TOP, IO, S, K, P, PEK, DTV, GB, &
+ HPROGRAM, HINIT, OPATCH1, KI, KVERSION, PCO2, PRHOA)
!#############################################################
!
!!**** *INIT_TEB_GREENROOF_PGD_n* - routine to initialize ISBA
@@ -39,39 +39,40 @@ SUBROUTINE INIT_TEB_GREENROOF_PGD_n (DTCO, U, CHI, DTI, I, DST, SLT, CHT, TG, T,
!* 0. DECLARATIONS
! ------------
!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_DST_n, ONLY : DST_t
-USE MODD_SLT_n, ONLY : SLT_t
-USE MODD_CH_TEB_n, ONLY : CH_TEB_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
-USE MODD_TEB_n, ONLY : TEB_t
+USE MODD_SSO_n, ONLY : SSO_t, SSO_INIT
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
-USE MODD_SURFEX_n, ONLY : TEB_GREENROOF_MODEL_t
+!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_P_t, ISBA_PE_t
+!
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t
+!
+USE MODD_AGRI_n, ONLY : AGRI_t
!
USE MODD_TYPE_DATE_SURF
USE MODD_TYPE_SNOW
!
-
-
USE MODD_DATA_COVER_PAR, ONLY: NVEGTYPE
USE MODD_SURF_PAR, ONLY: XUNDEF, NUNDEF
-USE MODD_SGH_PAR, ONLY: NDIMTAB, XF_DECAY
+USE MODD_SGH_PAR, ONLY: XF_DECAY
!
+USE MODI_READ_PREP_GREENROOF_SNOW
USE MODI_GET_LUOUT
-USE MODI_ALLOCATE_TEB_GREENROOF_PGD
+USE MODI_ALLOCATE_TEB_VEG_PGD
USE MODI_READ_PGD_TEB_GREENROOF_n
-USE MODI_CONVERT_PATCH_TEB_GREENROOF
-USE MODI_INIT_FROM_DATA_GREENROOF_n
-USE MODI_INIT_VEG_PGD_GARDEN_n
+USE MODI_CONVERT_PATCH_ISBA
+USE MODI_INIT_FROM_DATA_TEB_VEG_n
+USE MODI_INIT_VEG_PGD_n
USE MODI_EXP_DECAY_SOIL_FR
USE MODI_ABOR1_SFX
+USE MODI_AV_PGD
+!
+USE MODE_TEB_VEG
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -84,24 +85,24 @@ IMPLICIT NONE
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(DST_t), INTENT(INOUT) :: DST
-TYPE(SLT_t), INTENT(INOUT) :: SLT
-TYPE(CH_TEB_t), INTENT(INOUT) :: CHT
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
-TYPE(TEB_t), INTENT(INOUT) :: T
+LOGICAL, INTENT(IN) :: OCH_BIO_FLUX
+TYPE(GRID_t), INTENT(INOUT) :: G
+REAL, DIMENSION(:), INTENT(IN) :: PGREENROOF
TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
-TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM
+!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_P_t), INTENT(INOUT) :: P
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+TYPE(GR_BIOG_t), INTENT(INOUT) :: GB
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize
-LOGICAL, INTENT(IN) :: OREAD_PGD ! flag to read PGD fields in the file
+LOGICAL, INTENT(IN) :: OPATCH1 ! flag to read PGD fields in the file
INTEGER, INTENT(IN) :: KI ! number of points
-INTEGER, INTENT(IN) :: KSV ! number of scalars
- CHARACTER(LEN=6), DIMENSION(KSV), INTENT(IN) :: HSV ! name of all scalar variables
INTEGER, INTENT(IN) :: KVERSION ! version number of the file being read
REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration (kg/m3)
REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density
@@ -111,12 +112,15 @@ REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density
!* 0.2 Declarations of local variables
! -------------------------------
!
+TYPE(SSO_t) :: YSS
+TYPE(AGRI_t) :: YAG
+!
INTEGER :: JILU ! loop increment
INTEGER :: ILUOUT ! unit of output listing file
!
INTEGER :: IDECADE ! decade of simulation
!
-INTEGER :: JVEGTYPE, JLAYER ! loop counter on layers
+INTEGER :: JVEG, JL, JI ! loop counter on layers
!
REAL, DIMENSION(KI) :: ZF
REAL, DIMENSION(KI) :: ZWORK
@@ -135,7 +139,8 @@ REAL, PARAMETER :: ZHCAPSOIL_OM = 2.5E+6 ! Soil heat capacity for OM
!
REAL, PARAMETER :: ZMPOT_WWILT = -150. ! Matric potential at wilting point (m)
REAL, PARAMETER :: ZHYDCOND_WFC = 1.157E-9 ! Hydraulic conductivity at field capacity (m/s)
-! ! = 0.1 mm/day
+!
+REAL, DIMENSION(0) :: ZTDEEP_CLI, ZGAMMAT_CLI, ZTHRESHOLD
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -144,29 +149,35 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! Initialisation for IO
!
IF (LHOOK) CALL DR_HOOK('INIT_TEB_GREENROOF_PGD_n',0,ZHOOK_HANDLE)
+!
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
+CALL SSO_INIT(YSS)
!-------------------------------------------------------------------------------
!
-!* 2. Physiographic fields
-! --------------------
+!* 1. Reading of snow configuration:
+! ------------------------------
!
+!* initialization of snow scheme (TSNOW defined in MODD_TEB_GREENROOF_n)
!
-!* 2.1 Cover, soil and orographic fields:
-! ---------------------------------
+IF (HINIT=='PRE') THEN
+ CALL READ_PREP_GREENROOF_SNOW(HPROGRAM,PEK%TSNOW%SCHEME,PEK%TSNOW%NLAYER)
!
-IF (OREAD_PGD) &
- CALL READ_PGD_TEB_GREENROOF_n(CHT, DTCO, GRM%DTGR, GRM%GBGR, U, GRM%TGRO, GRM%TGRP, TG, &
- HPROGRAM,KVERSION)
+ IF (PEK%TSNOW%SCHEME.NE.'3-L' .AND. PEK%TSNOW%SCHEME.NE.'CRO' .AND. IO%CISBA=='DIF') THEN
+ CALL ABOR1_SFX("INIT_TEB_GREENROOF_n: WITH CISBA_GR = DIF, CSNOW MUST BE 3-L OR CRO")
+ ENDIF
+ENDIF
!
+!-------------------------------------------------------------------------------
!
-!* allocation of green roofs variables
+!* 2. Physiographic fields
+! --------------------
!
- CALL ALLOCATE_TEB_GREENROOF_PGD(GRM%TGRPE, GRM%TGRP, &
- OREAD_PGD, KI, NVEGTYPE, GRM%TGRO%NLAYER_GR, NDIMTAB)
!
-!* 2.2 Physiographic data fields from land cover:
-! -----------------------------------------
+!* 2.1 Cover, soil and orographic fields:
+! ---------------------------------
+!
+ CALL ALLOCATE_TEB_VEG_PGD(PEK, S, K, P, OPATCH1, KI, NVEGTYPE, IO%NGROUND_LAYER )
!
IF (TOP%TTIME%TDATE%MONTH /= NUNDEF) THEN
IDECADE = 3 * ( TOP%TTIME%TDATE%MONTH - 1 ) + MIN(TOP%TTIME%TDATE%DAY-1,29) / 10 + 1
@@ -174,235 +185,187 @@ ELSE
IDECADE = 1
END IF
!
-!
-IF (.NOT. GRM%TGRO%LPAR_GREENROOF) THEN
- CALL CONVERT_PATCH_TEB_GREENROOF(DTCO, DTI, I, GRM%TGRO, GRM%TGRPE, GRM%TGRP, TOP, TVG, &
- KI,IDECADE)
-ELSE
- CALL INIT_FROM_DATA_GREENROOF_n(GRM%DTGR, GRM%TGRO, IDECADE,TVG%CPHOTO, &
- GRM%TGRP%XOM_GR, GRM%TGRP%XSAND_GR, GRM%TGRP%XCLAY_GR, &
- GRM%TGRPE%CUR%XVEG, GRM%TGRPE%CUR%XLAI,GRM%TGRP%XRSMIN, &
- GRM%TGRP%XGAMMA,GRM%TGRP%XWRMAX_CF,GRM%TGRP%XRGL,GRM%TGRP%XCV,&
- GRM%TGRP%XDG,GRM%TGRP%XD_ICE,GRM%TGRPE%CUR%XZ0,GRM%TGRP%XZ0_O_Z0H, &
- GRM%TGRP%XALBNIR_VEG,GRM%TGRP%XALBVIS_VEG,GRM%TGRP%XALBUV_VEG,&
- GRM%TGRPE%CUR%XEMIS,GRM%TGRP%XVEGTYPE,GRM%TGRP%XROOTFRAC, &
- GRM%TGRP%XGMES,GRM%TGRP%XBSLAI,GRM%TGRP%XLAIMIN,GRM%TGRP%XSEFOLD,GRM%TGRP%XGC, &
- GRM%TGRP%XDMAX, GRM%TGRP%XF2I, GRM%TGRP%LSTRESS, GRM%TGRP%XH_TREE,GRM%TGRP%XRE25,&
- GRM%TGRP%XCE_NITRO,GRM%TGRP%XCF_NITRO,GRM%TGRP%XCNA_NITRO )
- IF (GRM%TGRO%CISBA_GR=='DIF') THEN
- WHERE(T%CUR%XGREENROOF(:)/=0.)
- GRM%TGRP%NWG_LAYER(:)=GRM%TGRO%NLAYER_GR
- GRM%TGRP%XDG2 (:)=0.0
- GRM%TGRP%XDROOT(:)=0.0
- ENDWHERE
- DO JLAYER=GRM%TGRO%NLAYER_GR,1,-1
- DO JILU=1,KI
- IF(T%CUR%XGREENROOF(JILU)/=0..AND.GRM%TGRP%XROOTFRAC(JILU,JLAYER)>=1.0)THEN
- GRM%TGRP%XDG2 (JILU)=GRM%TGRP%XDG(JILU,JLAYER)
- GRM%TGRP%XDROOT(JILU)=GRM%TGRP%XDG(JILU,JLAYER)
- ENDIF
- ENDDO
- ENDDO
+IF (OPATCH1) THEN
+
+ CALL READ_PGD_TEB_GREENROOF_n(OCH_BIO_FLUX, DTCO, DTV, GB, U, &
+ IO, S, K, G%NDIM, HPROGRAM,KVERSION)
+ !
+ ALLOCATE(S%XVEGTYPE(KI,NVEGTYPE))
+ IF (IO%LPAR) THEN
+ S%XVEGTYPE = DTV%XPAR_VEGTYPE
+ ELSE
+ !classical ecoclimap case
+ DO JVEG=1,NVEGTYPE
+ CALL AV_PGD(DTCO, S%XVEGTYPE(:,JVEG),TOP%XCOVER ,DTCO%XDATA_VEGTYPE(:,JVEG),'GRD','ARI',TOP%LCOVER)
+ END DO
ENDIF
-END IF
-!
-WHERE (T%CUR%XGREENROOF(:)==0.)
- ! GARDEN default values /may need changing for green roofs
- GRM%TGRP%XOM_GR (:,1) = 0.5
- GRM%TGRP%XOM_GR (:,2) = 0.5
- GRM%TGRP%XSAND_GR (:,1) = 0.33
- GRM%TGRP%XSAND_GR (:,2) = 0.33
- GRM%TGRP%XCLAY_GR (:,1) = 0.33
- GRM%TGRP%XCLAY_GR (:,2) = 0.33
- GRM%TGRPE%CUR%XVEG (: ) = 0.
- GRM%TGRPE%CUR%XLAI (: ) = 0.
- GRM%TGRP%XRSMIN (: ) = 40.
- GRM%TGRP%XGAMMA (: ) = 0.
- GRM%TGRP%XWRMAX_CF (: ) = 0.2
- GRM%TGRP%XRGL (: ) = 100.
- GRM%TGRP%XCV (: ) = 2.E-5
- GRM%TGRPE%CUR%XZ0 (: ) = 0.013
- GRM%TGRP%XZ0_O_Z0H (: ) = 10.
- GRM%TGRP%XALBNIR_VEG(: ) = 0.30
- GRM%TGRP%XALBVIS_VEG(: ) = 0.30
- GRM%TGRP%XALBUV_VEG (: ) = 0.06
- GRM%TGRPE%CUR%XEMIS (: ) = 0.94
-END WHERE
-IF (TVG%CPHOTO/='NON') THEN
- WHERE (T%CUR%XGREENROOF(:)==0.)
- GRM%TGRP%XGMES (: ) = 0.020
- GRM%TGRP%XBSLAI (: ) = 0.36
- GRM%TGRP%XLAIMIN (: ) = 0.3
- GRM%TGRP%XSEFOLD (: ) = 90*86400.
- GRM%TGRP%XH_TREE (: ) = 0.
- GRM%TGRP%XRE25 (: ) = 3.6E-7
- GRM%TGRP%XGC (: ) = 0.00025
- END WHERE
- IF (TVG%CPHOTO/='AGS' .AND. TVG%CPHOTO/='LAI') THEN
- WHERE (T%CUR%XGREENROOF(:)==0.)
- GRM%TGRP%XDMAX (: ) = 0.1
- GRM%TGRP%XF2I (: ) = 0.3
+ DO JVEG=1,NVEGTYPE
+ WHERE (PGREENROOF==0)
+ S%XVEGTYPE(:,JVEG) = 0.
+ S%XVEGTYPE(:,1) = 1.
END WHERE
- IF (TVG%CPHOTO=='NIT' .OR. TVG%CPHOTO=='NCB') THEN
- WHERE (T%CUR%XGREENROOF(:)==0.)
- GRM%TGRP%XCE_NITRO (: ) = 7.68
- GRM%TGRP%XCF_NITRO (: ) = -4.33
- GRM%TGRP%XCNA_NITRO (: ) = 1.3
- END WHERE
- ENDIF
+ ENDDO
+ !
+ ALLOCATE(S%XPATCH(KI,1),P%XPATCH(KI))
+ ALLOCATE(S%XVEGTYPE_PATCH(KI,NVEGTYPE,1),P%XVEGTYPE_PATCH(KI,NVEGTYPE))
+ S%XPATCH(:,1) = 1.
+ P%XPATCH(:) = S%XPATCH(:,1)
+ S%XVEGTYPE_PATCH(:,:,1) = S%XVEGTYPE
+ P%XVEGTYPE_PATCH(:,:) = S%XVEGTYPE_PATCH(:,:,1)
+ P%NSIZE_P = KI
+ ALLOCATE(P%NR_P(KI))
+ DO JI = 1,SIZE(P%NR_P)
+ P%NR_P(JI) = JI
+ ENDDO
+ !
+ IF (.NOT. IO%LPAR) THEN
+ CALL CONVERT_PATCH_ISBA(DTCO, DTV, IO, IDECADE, IDECADE, TOP%XCOVER, TOP%LCOVER,&
+ .FALSE.,'GRD', 1, K, P, PEK, &
+ .TRUE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., &
+ PSOILGRID=IO%XSOILGRID )
+ ELSE
+ CALL INIT_FROM_DATA_TEB_VEG_n(DTV, K, P, PEK, IDECADE, .FALSE., .TRUE., .FALSE.,.FALSE.)
ENDIF
-ENDIF
-IF(GRM%TGRO%CISBA_GR/='DIF')THEN
- DO JLAYER=1,GRM%TGRO%NLAYER_GR
- WHERE (T%CUR%XGREENROOF(:)==0.)
- GRM%TGRP%XDG(:,JLAYER)=0.2*JLAYER
- END WHERE
- ENDDO
+ !
+ ALLOCATE(S%XWSN_WR(0,0,1))
+ ALLOCATE(S%XRHO_WR(0,0,1))
+ ALLOCATE(S%XALB_WR(0,1))
+ ALLOCATE(S%XHEA_WR(0,0,1))
+ ALLOCATE(S%XAGE_WR(0,0,1))
+ ALLOCATE(S%XSG1_WR(0,0,1))
+ ALLOCATE(S%XSG2_WR(0,0,1))
+ ALLOCATE(S%XHIS_WR(0,0,1))
+ !
+END IF
+!
+!* 2.2 Physiographic data fields from land cover:
+! -----------------------------------------
+!
+IF (.NOT. IO%LPAR) THEN
+ CALL CONVERT_PATCH_ISBA(DTCO, DTV, IO, IDECADE, IDECADE, TOP%XCOVER, TOP%LCOVER,&
+ .FALSE.,'GRD', 1, K, P, PEK, &
+ .FALSE., .TRUE., .FALSE., .FALSE., .FALSE., .FALSE. )
ELSE
- WHERE (T%CUR%XGREENROOF(:)==0.)
- GRM%TGRP%XDG(:,1)=0.01
- GRM%TGRP%XDG(:,2)=0.04
- GRM%TGRP%XROOTFRAC(:,1)=0.
- GRM%TGRP%XROOTFRAC(:,2)=0.
- END WHERE
- DO JLAYER=3,GRM%TGRO%NLAYER_GR
- WHERE (T%CUR%XGREENROOF(:)==0.)
- GRM%TGRP%XDG(:,JLAYER)=0.1*(JLAYER-2)
- GRM%TGRP%XROOTFRAC(:,JLAYER)=0.
- END WHERE
- ENDDO
- WHERE (T%CUR%XGREENROOF(:)==0.)
- GRM%TGRP%NWG_LAYER(:)=GRM%TGRO%NLAYER_GR
- GRM%TGRP%XDROOT (:)=0.0
- GRM%TGRP%XDG2 (:)=GRM%TGRP%XDG(:,GRM%TGRO%NLAYER_GR-1)
- ENDWHERE
-ENDIF
-WHERE (T%CUR%XGREENROOF(:)==0.)
- GRM%TGRP%XD_ICE(:)=0.8*GRM%TGRP%XDG(:,2)
-END WHERE
-DO JVEGTYPE=1,NVEGTYPE
- WHERE (T%CUR%XGREENROOF(:)==0.)
- GRM%TGRP%XVEGTYPE(:,JVEGTYPE)=0.
- GRM%TGRP%XVEGTYPE(:,1)=1.
- END WHERE
-ENDDO
+
+ CALL INIT_FROM_DATA_TEB_VEG_n(DTV, K, P, PEK, IDECADE, .FALSE., .FALSE., .TRUE.,.FALSE.)
+
+ IF (IO%CISBA=='DIF') CALL INIT_IF_DIF(IO%NGROUND_LAYER, PGREENROOF, P)
+
+END IF
+!
+ CALL INIT_IF_NOVEG(PGREENROOF, IO, S, P, PEK)
+!
+ALLOCATE(K%XVEGTYPE(KI,NVEGTYPE))
+K%XVEGTYPE = S%XVEGTYPE
+!
+ALLOCATE(YSS%XAOSIP(0))
!
- CALL INIT_VEG_PGD_GARDEN_n(CHI, DTCO, DST, I, SLT, U, &
- HPROGRAM, ILUOUT, KI, GRM%TGRO%NLAYER_GR, TOP%TTIME%TDATE%MONTH, &
- GRM%TGRP%XVEGTYPE, GRM%TGRP%XTDEEP, GRM%TGRP%XGAMMAT, TVG%CPHOTO, HINIT, &
- GRM%TGRO%LTR_ML_GR, GRM%TGRO%CRUNOFF_GR, TVG%NNBIOMASS, PCO2, PRHOA, &
- GRM%TGRP%XABC, GRM%TGRP%XPOI, GRM%TGRP%XGMES, GRM%TGRP%XGC, GRM%TGRP%XDMAX, &
- GRM%TGRP%XANMAX, GRM%TGRP%XFZERO, GRM%TGRP%XEPSO, GRM%TGRP%XGAMM, GRM%TGRP%XQDGAMM, &
- GRM%TGRP%XQDGMES, GRM%TGRP%XT1GMES, GRM%TGRP%XT2GMES, GRM%TGRP%XAMAX, GRM%TGRP%XQDAMAX, &
- GRM%TGRP%XT1AMAX, GRM%TGRP%XT2AMAX,GRM%TGRP%XAH, GRM%TGRP%XBH, &
- KSV, HSV, CHT%SVT, CHT%CCH_NAMES, CHT%CAER_NAMES,CHT%CDSTNAMES, CHT%CSLTNAMES, &
- CHT%CCHEM_SURF_FILE, GRM%TGRP%XCLAY_GR, GRM%TGRP%XSAND_GR, TVG%CPEDOTF, &
- GRM%TGRP%XCONDSAT, GRM%TGRP%XMPOTSAT, GRM%TGRP%XBCOEF, GRM%TGRP%XWWILT, &
- GRM%TGRP%XWFC, GRM%TGRP%XWSAT, GRM%TGRP%XTAUICE, GRM%TGRP%XCGSAT, GRM%TGRP%XC1SAT, &
- GRM%TGRP%XC2REF, GRM%TGRP%XC3, GRM%TGRP%XC4B, GRM%TGRP%XACOEF, GRM%TGRP%XPCOEF, &
- GRM%TGRP%XC4REF, GRM%TGRP%XPCPS, GRM%TGRP%XPLVTT, GRM%TGRP%XPLSTT, &
- GRM%TGRO%CSCOND_GR, GRM%TGRO%CISBA_GR, GRM%TGRP%XHCAPSOIL, GRM%TGRP%XCONDDRY, &
- GRM%TGRP%XCONDSLD, TVG%CCPSURF, GRM%TGRP%XDG, GRM%TGRP%XDROOT, GRM%TGRP%XDG2, &
- GRM%TGRP%XROOTFRAC, GRM%TGRP%XRUNOFFD, GRM%TGRP%XDZG, GRM%TGRP%XDZDIF, &
- GRM%TGRP%XSOILWGHT, GRM%TGRP%NWG_LAYER, GRM%TGRO%NLAYER_HORT_GR, &
- GRM%TGRO%NLAYER_DUN_GR, GRM%TGRP%XD_ICE, &
- GRM%TGRP%XKSAT_ICE, GRM%TGRP%XALBNIR_DRY, GRM%TGRP%XALBVIS_DRY, GRM%TGRP%XALBUV_DRY, &
- GRM%TGRP%XALBNIR_WET, GRM%TGRP%XALBVIS_WET, GRM%TGRP%XALBUV_WET, GRM%TGRP%XBSLAI_NITRO, &
- GRM%TGRP%XCE_NITRO, GRM%TGRP%XCNA_NITRO, GRM%TGRP%XCF_NITRO )
+ CALL INIT_VEG_PGD_n(YSS, DTV, IO, S, K, K, P, PEK, YAG, KI, &
+ HPROGRAM, 'TOWN ',ILUOUT, KI, TOP%TTIME%TDATE%MONTH, &
+ .FALSE., .FALSE., ZTDEEP_CLI, ZGAMMAT_CLI, &
+ .FALSE., ZTHRESHOLD, HINIT, PCO2, PRHOA )
!
!-------------------------------------------------------------------------------
!
-!* 5.1 Soil thermal characteristics for greenroofs:
-! ----------------------------------------------
-!
-! WARNING: must be done before soil hydraulic characteristics (because of WSAT)
-! Estimation of WSAT_MI for use in HEATCAPZ and THRMCONDZ for mineral fraction
-! and allow weighted combination with regard to OM & no-OM fractions:
-!
-IF (GRM%TGRO%CSCOND_GR=='PL98' .OR. GRM%TGRO%CISBA_GR=='DIF') THEN
- DO JLAYER=1,GRM%TGRO%NLAYER_GR
- GRM%TGRP%XHCAPSOIL(:,JLAYER) = GRM%TGRP%XOM_GR(:,JLAYER) * ZHCAPSOIL_OM + &
- (1-GRM%TGRP%XOM_GR(:,JLAYER)) * GRM%TGRP%XHCAPSOIL(:,JLAYER)
- GRM%TGRP%XCONDDRY(:,JLAYER) = (ZCONDDRY_OM * GRM%TGRP%XCONDDRY(:,JLAYER)) &
- /( GRM%TGRP%XOM_GR(:,JLAYER) * GRM%TGRP%XCONDDRY(:,JLAYER) + &
- (1-GRM%TGRP%XOM_GR(:,JLAYER)) * ZCONDDRY_OM)
- GRM%TGRP%XCONDSLD(:,JLAYER) = (ZCONDSLD_OM * GRM%TGRP%XCONDSLD(:,JLAYER)) &
- /( GRM%TGRP%XOM_GR(:,JLAYER) * GRM%TGRP%XCONDSLD(:,JLAYER) + &
- (1-GRM%TGRP%XOM_GR(:,JLAYER)) * ZCONDSLD_OM)
+IF (OPATCH1) THEN
+ !
+ !* 5.1 Soil thermal characteristics for greenroofs:
+ ! ----------------------------------------------
+ !
+ ! WARNING: must be done before soil hydraulic characteristics (because of WSAT)
+ ! Estimation of WSAT_MI for use in HEATCAPZ and THRMCONDZ for mineral fraction
+ ! and allow weighted combination with regard to OM & no-OM fractions:
+ !
+ IF (IO%CSCOND=='PL98' .OR. IO%CISBA=='DIF') THEN
+ DO JL=1,IO%NGROUND_LAYER
+ K%XHCAPSOIL(:,JL) = S%XSOC(:,JL) * ZHCAPSOIL_OM + (1-S%XSOC(:,JL)) * K%XHCAPSOIL(:,JL)
+ K%XCONDDRY (:,JL) = (ZCONDDRY_OM * K%XCONDDRY(:,JL)) / &
+ ( S%XSOC(:,JL) * K%XCONDDRY(:,JL) + (1-S%XSOC(:,JL)) * ZCONDDRY_OM )
+ K%XCONDSLD (:,JL) = (ZCONDSLD_OM * K%XCONDSLD(:,JL)) / &
+ ( S%XSOC(:,JL) * K%XCONDSLD(:,JL) + (1-S%XSOC(:,JL)) * ZCONDSLD_OM )
+ ENDDO
+ END IF
+ !
+ ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ ! Validation case : experimental values for Nancy 2011 case
+ ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ ! Substrate layer
+ DO JL=1,4
+ K%XCONDDRY (:,JL) = 0.15
+ K%XHCAPSOIL(:,JL) = 1342000.
ENDDO
-END IF
-!
-! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-! Validation case : experimental values for Nancy 2011 case
-! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-! Substrate layer
-DO JLAYER=1,4
- GRM%TGRP%XCONDDRY (:,JLAYER) = 0.15
- GRM%TGRP%XHCAPSOIL(:,JLAYER) = 1342000.
-ENDDO
-! Drainage layer
-DO JLAYER=5,6
- GRM%TGRP%XCONDDRY (:,JLAYER) = 0.09
- GRM%TGRP%XHCAPSOIL(:,JLAYER) = 331500.
-ENDDO
-! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ ! Drainage layer
+ DO JL=5,6
+ K%XCONDDRY (:,JL) = 0.09
+ K%XHCAPSOIL(:,JL) = 331500.
+ ENDDO
+ ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ !
+ENDIF
!
!* 5.2 Soil thermal characteristics:
! --------------------------------
!
-DO JLAYER=1,GRM%TGRO%NLAYER_GR
- GRM%TGRP%XCONDSAT(:,JLAYER) = GRM%TGRP%XOM_GR(:,JLAYER)* ZCONDSAT_OM &
- +(1-GRM%TGRP%XOM_GR(:,JLAYER))* GRM%TGRP%XCONDSAT(:,JLAYER)
+DO JL=1,IO%NGROUND_LAYER
+ P%XCONDSAT(:,JL) = S%XSOC(:,JL)* ZCONDSAT_OM + (1-S%XSOC(:,JL)) * P%XCONDSAT(:,JL)
END DO
!
-! Note that if ISBA/=DIF, always CDIF = 'BC' and CPEDOTF = 'CH78'
-DO JLAYER=1,GRM%TGRO%NLAYER_GR
- GRM%TGRP%XBCOEF (:,JLAYER) = GRM%TGRP%XOM_GR(:,JLAYER) * ZBCOEF_OM &
- +(1-GRM%TGRP%XOM_GR(:,JLAYER))* GRM%TGRP%XBCOEF(:,JLAYER)
- GRM%TGRP%XMPOTSAT(:,JLAYER) = GRM%TGRP%XOM_GR(:,JLAYER) * ZMPOTSAT_OM &
- +(1-GRM%TGRP%XOM_GR(:,JLAYER))* GRM%TGRP%XMPOTSAT(:,JLAYER)
-END DO
-!
-DO JLAYER=1,GRM%TGRO%NLAYER_GR
- GRM%TGRP%XWSAT (:,JLAYER) = GRM%TGRP%XOM_GR(:,JLAYER)* ZWSAT_OM &
- +(1-GRM%TGRP%XOM_GR(:,JLAYER))* GRM%TGRP%XWSAT(:,JLAYER)
- GRM%TGRP%XWWILT(:,JLAYER) = EXP(((LOG(-1*ZMPOT_WWILT)-LOG(-1*GRM%TGRP%XMPOTSAT(:,JLAYER))) &
- / (-1*GRM%TGRP%XBCOEF(:,JLAYER)))+LOG(GRM%TGRP%XWSAT(:,JLAYER)))
- GRM%TGRP%XWFC (:,JLAYER) = EXP(((LOG(ZHYDCOND_WFC)-LOG(GRM%TGRP%XCONDSAT(:,JLAYER))) &
- / (2*GRM%TGRP%XBCOEF(:,JLAYER)+3))+LOG(GRM%TGRP%XWSAT(:,JLAYER)))
-END DO
!
-! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-! Validation case : experimental values for Nancy 2011 case
-! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+IF (OPATCH1) THEN
+ !
+ ! Note that if ISBA/=DIF, always CDIF = 'BC' and CPEDOTF = 'CH78'
+ DO JL=1,IO%NGROUND_LAYER
+ K%XBCOEF (:,JL) = S%XSOC(:,JL) * ZBCOEF_OM + (1-S%XSOC(:,JL)) * K%XBCOEF(:,JL)
+ K%XMPOTSAT(:,JL) = S%XSOC(:,JL) * ZMPOTSAT_OM + (1-S%XSOC(:,JL)) * K%XMPOTSAT(:,JL)
+ END DO
+ !
+ DO JL=1,IO%NGROUND_LAYER
+ K%XWSAT (:,JL) = S%XSOC(:,JL)* ZWSAT_OM +(1-S%XSOC(:,JL))* K%XWSAT(:,JL)
+ K%XWWILT(:,JL) = EXP(((LOG(-1*ZMPOT_WWILT)-LOG(-1*K%XMPOTSAT(:,JL))) &
+ / (-1*K%XBCOEF(:,JL)))+LOG(K%XWSAT(:,JL)))
+ K%XWFC (:,JL) = EXP(((LOG(ZHYDCOND_WFC)-LOG(P%XCONDSAT(:,JL))) &
+ / (2*K%XBCOEF(:,JL)+3))+LOG(K%XWSAT(:,JL)))
+ END DO
+ !
+ ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ ! Validation case : experimental values for Nancy 2011 case
+ ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ ! Substrate layer
+ DO JL=1,4
+ K%XWSAT (:,JL) = 0.674 ! Value tested
+ K%XMPOTSAT(:,JL) = -0.932 ! Value tested
+ K%XBCOEF (:,JL) = 3.9 ! Value tested
+ K%XWWILT (:,JL) = 0.15 ! from OBS-NANCY
+ K%XWFC (:,JL) = 0.37 ! from OBS-NANCY
+ ENDDO
+ ! Drainage layer
+ DO JL=5,6
+ K%XWSAT (:,JL) = 0.9 ! Value tested
+ K%XMPOTSAT(:,JL) = -0.121 ! Value tested
+ K%XBCOEF (:,JL) = 2.7 ! Value tested
+ K%XWWILT (:,JL) = 0.15 ! sert à initialiser le WG ds la couche
+ K%XWFC (:,JL) = 0.37 ! sert à initialiser le WG ds la couche
+ ENDDO
+ !
+ENDIF
+!
! Substrate layer
-DO JLAYER=1,4
- GRM%TGRP%XWSAT (:,JLAYER) = 0.674 ! Value tested
- GRM%TGRP%XCONDSAT(:,JLAYER) = 2.162E-3 ! Value tested
- GRM%TGRP%XMPOTSAT(:,JLAYER) = -0.932 ! Value tested
- GRM%TGRP%XBCOEF (:,JLAYER) = 3.9 ! Value tested
- GRM%TGRP%XWWILT (:,JLAYER) = 0.15 ! from OBS-NANCY
- GRM%TGRP%XWFC (:,JLAYER) = 0.37 ! from OBS-NANCY
+DO JL=1,4
+ P%XCONDSAT(:,JL) = 2.162E-3 ! Value tested
ENDDO
! Drainage layer
-DO JLAYER=5,6
- GRM%TGRP%XWSAT (:,JLAYER) = 0.9 ! Value tested
- GRM%TGRP%XCONDSAT(:,JLAYER) = 3.32E-3 ! Value tested
- GRM%TGRP%XMPOTSAT(:,JLAYER) = -0.121 ! Value tested
- GRM%TGRP%XBCOEF (:,JLAYER) = 2.7 ! Value tested
- GRM%TGRP%XWWILT (:,JLAYER) = 0.15 ! sert à initialiser le WG ds la couche
- GRM%TGRP%XWFC (:,JLAYER) = 0.37 ! sert à initialiser le WG ds la couche
+DO JL=5,6
+ P%XCONDSAT(:,JL) = 3.32E-3 ! Value tested
ENDDO
+!
!-------------------------------------------------------------------------------
!
!* 6.1 Initialize of the SGH scheme:'
! ------------------------------
!
-IF(GRM%TGRO%CKSAT_GR=='SGH' .AND. GRM%TGRO%CISBA_GR/='DIF' .AND. HINIT/='PRE')THEN
- ZF(:)=MIN(4.0/GRM%TGRP%XDG(:,2),XF_DECAY)
- CALL EXP_DECAY_SOIL_FR(GRM%TGRO%CISBA_GR, ZF(:),GRM%TGRP%XC1SAT(:),GRM%TGRP%XC2REF(:),&
- GRM%TGRP%XDG(:,:),GRM%TGRP%XD_ICE(:),GRM%TGRP%XC4REF(:),&
- GRM%TGRP%XC3(:,:),GRM%TGRP%XCONDSAT(:,:),GRM%TGRP%XKSAT_ICE(:))
+IF(IO%CKSAT=='SGH' .AND. IO%CISBA/='DIF' .AND. HINIT/='PRE')THEN
+ ZF(:)=MIN(4.0/P%XDG(:,2),XF_DECAY)
+ CALL EXP_DECAY_SOIL_FR(IO%CISBA, ZF, P)
ENDIF
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/init_teb_greenroofn.F90 b/src/SURFEX/init_teb_greenroofn.F90
index ee80c192d95f7e4feb8c9dde1b03b6e10722b4e7..1f458bbb16c2e6e1cfbfbabc7225edd3f586f4ba 100644
--- a/src/SURFEX/init_teb_greenroofn.F90
+++ b/src/SURFEX/init_teb_greenroofn.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#############################################################
-SUBROUTINE INIT_TEB_GREENROOF_n (DTCO, U, DGMTO, TOP, TVG, GRM, &
- HPROGRAM,HINIT,KI,KSW,PSW_BANDS,KPATCH)
+SUBROUTINE INIT_TEB_GREENROOF_n (DTCO, U, DMTO, TOP, IO, DTV, K, P, PEK, &
+ DK, DEK, DECK, DMK, HPROGRAM,HINIT,KI,KSW,PSW_BANDS,KPATCH)
!#############################################################
!
!!**** *INIT_TEB_GREENROOF_n* - routine to initialize ISBA
@@ -41,15 +41,18 @@ SUBROUTINE INIT_TEB_GREENROOF_n (DTCO, U, DGMTO, TOP, TVG, GRM, &
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_DIAG_MISC_TEB_OPTION_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
+USE MODD_DIAG_MISC_TEB_OPTIONS_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
-USE MODD_SURFEX_n, ONLY : TEB_GREENROOF_MODEL_t
+!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_ISBA_n, ONLY : ISBA_P_t, ISBA_K_t, ISBA_PE_t
+USE MODD_DIAG_n, ONLY : DIAG_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
!
USE MODD_TYPE_DATE_SURF
USE MODD_TYPE_SNOW
-!
-
!
USE MODD_DATA_COVER_PAR, ONLY: NVEGTYPE
USE MODD_SURF_PAR, ONLY: XUNDEF, NUNDEF
@@ -57,14 +60,14 @@ USE MODD_SURF_PAR, ONLY: XUNDEF, NUNDEF
USE MODD_SURF_ATM, ONLY: LCPL_ARP
!
USE MODI_GET_LUOUT
-USE MODI_READ_PREP_GREENROOF_SNOW
-USE MODI_ALLOCATE_TEB_GREENROOF
+USE MODI_ALLOCATE_TEB_VEG
USE MODI_ABOR1_SFX
USE MODI_READ_TEB_GREENROOF_n
-USE MODI_INIT_VEG_GARDEN_n
+USE MODI_INIT_VEG_n
USE MODI_SOIL_ALBEDO
-USE MODI_INIT_FROM_DATA_GREENROOF_n
-USE MODI_AVG_ALBEDO_EMIS_GREENROOF
+USE MODI_INIT_FROM_DATA_TEB_VEG_n
+USE MODI_AVG_ALBEDO_EMIS_TEB_VEG
+USE MODI_DIAG_TEB_VEG_INIT_n
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -77,10 +80,18 @@ IMPLICIT NONE
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: DGMTO
+TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: DMTO
TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
-TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM
+!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_P_t), INTENT(INOUT) :: P
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(DIAG_t), INTENT(INOUT) :: DK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DECK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize
@@ -116,29 +127,11 @@ IF (LHOOK) CALL DR_HOOK('INIT_TEB_GREENROOF_N',0,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
!
-!* 1. Reading of snow configuration:
-! ------------------------------
+ CALL ALLOCATE_TEB_VEG(PEK, KI, IO%NGROUND_LAYER, IO%NNBIOMASS)
!
-!* initialization of snow scheme (TSNOW defined in MODD_TEB_GREENROOF_n)
-!
-IF (HINIT=='PRE') THEN
- CALL READ_PREP_GREENROOF_SNOW(HPROGRAM,GRM%TGR%CUR%TSNOW%SCHEME,GRM%TGR%CUR%TSNOW%NLAYER)
-!
- IF (GRM%TGR%CUR%TSNOW%SCHEME.NE.'3-L' .AND. GRM%TGR%CUR%TSNOW%SCHEME.NE.'CRO' &
- .AND. GRM%TGRO%CISBA_GR=='DIF') THEN
- CALL ABOR1_SFX("INIT_TEB_GREENROOF_n: WITH CISBA_GR = DIF, CSNOW MUST BE 3-L OR CRO")
- ENDIF
- IF (LHOOK) CALL DR_HOOK('INIT_TEB_GREENROOF_N',1,ZHOOK_HANDLE)
- RETURN
-ENDIF
!-------------------------------------------------------------------------------
!
- CALL ALLOCATE_TEB_GREENROOF(GRM%TGR, TVG, &
- KI, GRM%TGRO%NLAYER_GR)
-!
-!-------------------------------------------------------------------------------
-!
-IF( TVG%CCPSURF=='DRY' .AND. LCPL_ARP ) THEN
+IF( IO%CCPSURF=='DRY' .AND. LCPL_ARP ) THEN
CALL ABOR1_SFX('CCPSURF=DRY must not be used with LCPL_ARP')
ENDIF
!
@@ -150,6 +143,27 @@ IF (HINIT/='ALL') THEN
ENDIF
!
!-------------------------------------------------------------------------------
+! Variables needed to run isba
+!
+ALLOCATE(K%XFFLOOD (KI))
+ALLOCATE(K%XFF (KI))
+ALLOCATE(K%XFFG (KI))
+ALLOCATE(K%XFFV (KI))
+ALLOCATE(K%XFFROZEN(KI))
+ALLOCATE(K%XALBF (KI))
+ALLOCATE(K%XEMISF (KI))
+K%XFFLOOD = 0.0
+K%XFF = 0.0
+K%XFFG = 0.0
+K%XFFV = 0.0
+K%XFFROZEN = 0.0
+K%XALBF = 0.0
+K%XEMISF = 0.0
+!
+ALLOCATE(K%XFSAT(KI))
+K%XFSAT(:) = 0.0
+!
+!-------------------------------------------------------------------------------
!
!* 2. Prognostic and semi-prognostic fields
! -------------------------------------
@@ -157,57 +171,41 @@ ENDIF
!* allocation of urban green area variables
!
!
- YPATCH=' '
- IF (TOP%NTEB_PATCH>1) WRITE(YPATCH,FMT='(A,I1,A)') 'T',KPATCH,'_'
+YPATCH=' '
+IF (TOP%NTEB_PATCH>1) WRITE(YPATCH,FMT='(A,I1,A)') 'T',KPATCH,'_'
!
- CALL READ_TEB_GREENROOF_n(DTCO, U, TVG, GRM, &
- HPROGRAM,YPATCH)
+ CALL READ_TEB_GREENROOF_n(DTCO, U, IO, P, PEK, HPROGRAM,YPATCH)
!
+DTV%LIMP_VEG = .FALSE.
+DTV%LIMP_Z0 = .FALSE.
+DTV%LIMP_EMIS = .FALSE.
!
- CALL INIT_VEG_GARDEN_n(KI, TOP%LCANOPY, TVG%CROUGH, GRM%TGR%CUR%TSNOW, &
- TVG%CPHOTO, GRM%TGRP%XLAIMIN, GRM%TGRP%XH_TREE, GRM%TGRP%XVEGTYPE, &
- GRM%TGRPE%CUR%XLAI, GRM%TGRPE%CUR%XZ0, GRM%TGRPE%CUR%XVEG, &
- GRM%TGRPE%CUR%XEMIS, GRM%TGRO%LTR_ML_GR, GRM%TGR%CUR%XFAPARC, &
- GRM%TGR%CUR%XFAPIRC, GRM%TGR%CUR%XLAI_EFFC, GRM%TGR%CUR%XMUS, &
- GRM%TGRP%XALBNIR_SOIL, GRM%TGRP%XALBVIS_SOIL, GRM%TGRP%XALBUV_SOIL, &
- GRM%TGRPE%CUR%XALBNIR, GRM%TGRPE%CUR%XALBVIS, GRM%TGRPE%CUR%XALBUV, &
- DGMTO%LSURF_DIAG_ALBEDO, GRM%TGR%CUR%XPSN, GRM%TGR%CUR%XPSNG, &
- GRM%TGR%CUR%XPSNV, GRM%TGR%CUR%XPSNV_A, &
- ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTSRAD )
+P%NSIZE_P = KI
+ CALL INIT_VEG_n(IO, K, P, PEK, DTV, DMTO%LSURF_DIAG_ALBEDO, ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTSRAD )
!
-ZWG1(:) = GRM%TGR%CUR%XWG(:,1)
-ZTG1(:) = GRM%TGR%CUR%XTG(:,1)
+ZWG1(:) = PEK%XWG(:,1)
+ZTG1(:) = PEK%XTG(:,1)
!
-IF (.NOT. GRM%TGRO%LPAR_GREENROOF) THEN
- CALL SOIL_ALBEDO(TVG%CALBEDO, &
- GRM%TGRP%XWSAT(:,1),ZWG1, &
- GRM%TGRP%XALBVIS_DRY,GRM%TGRP%XALBNIR_DRY,GRM%TGRP%XALBUV_DRY, &
- GRM%TGRP%XALBVIS_WET,GRM%TGRP%XALBNIR_WET,GRM%TGRP%XALBUV_WET, &
- GRM%TGRP%XALBVIS_SOIL,GRM%TGRP%XALBNIR_SOIL,GRM%TGRP%XALBUV_SOIL )
+IF (.NOT. IO%LPAR) THEN
+ CALL SOIL_ALBEDO(IO%CALBEDO, K%XWSAT(:,1),ZWG1, K, PEK, "ALL" )
ELSE
IF (TOP%TTIME%TDATE%MONTH /= NUNDEF) THEN
IDECADE = 3 * ( TOP%TTIME%TDATE%MONTH - 1 ) + MIN(TOP%TTIME%TDATE%DAY-1,29) / 10 + 1
ELSE
IDECADE = 1
END IF
- CALL INIT_FROM_DATA_GREENROOF_n(GRM%DTGR, GRM%TGRO, &
- IDECADE,TVG%CPHOTO, &
- PALBNIR_SOIL=GRM%TGRP%XALBNIR_SOIL, &
- PALBVIS_SOIL=GRM%TGRP%XALBVIS_SOIL, &
- PALBUV_SOIL=GRM%TGRP%XALBUV_SOIL )
+ CALL INIT_FROM_DATA_TEB_VEG_n(DTV, K, P, PEK, IDECADE, .FALSE., .FALSE., .FALSE., .TRUE. )
END IF
!
-!
- CALL AVG_ALBEDO_EMIS_GREENROOF(GRM%TGR, &
- TVG%CALBEDO, &
- GRM%TGRPE%CUR%XVEG,GRM%TGRPE%CUR%XZ0,GRM%TGRPE%CUR%XLAI,ZTG1, &
- PSW_BANDS, &
- GRM%TGRP%XALBNIR_VEG,GRM%TGRP%XALBVIS_VEG,GRM%TGRP%XALBUV_VEG, &
- GRM%TGRP%XALBNIR_SOIL,GRM%TGRP%XALBVIS_SOIL,GRM%TGRP%XALBUV_SOIL, &
- GRM%TGRPE%CUR%XEMIS, GRM%TGR%CUR%TSNOW, &
- GRM%TGRPE%CUR%XALBNIR,GRM%TGRPE%CUR%XALBVIS,GRM%TGRPE%CUR%XALBUV, &
- ZDIR_ALB, ZSCA_ALB, &
- ZEMIS,ZTSRAD )
+WHERE (PEK%XALBNIR_SOIL(:)==XUNDEF)
+ PEK%XALBNIR_SOIL(:)=0.225
+ PEK%XALBVIS_SOIL(:)=0.15
+ PEK%XALBUV_SOIL (:)=0.07965
+ENDWHERE
+!
+ CALL AVG_ALBEDO_EMIS_TEB_VEG(PEK, IO%CALBEDO, ZTG1, PSW_BANDS, ZDIR_ALB, ZSCA_ALB, ZEMIS,ZTSRAD )
+!
+ CALL DIAG_TEB_VEG_INIT_n(DK, DEK, DECK, DMK, KI, PEK%TSNOW%NLAYER)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/init_teb_veg_optionsn.F90 b/src/SURFEX/init_teb_veg_optionsn.F90
index 22f83d6f5ed1823e7c4408b637974331208aaaa2..6d5addc82f803fbd1797e7742eccb55c493ec2df 100644
--- a/src/SURFEX/init_teb_veg_optionsn.F90
+++ b/src/SURFEX/init_teb_veg_optionsn.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#############################################################
-SUBROUTINE INIT_TEB_VEG_OPTIONS_n (&
- CHT, DGMTO, TGDO, TVG, &
- HPROGRAM)
+SUBROUTINE INIT_TEB_VEG_OPTIONS_n (CHT, OSURF_DIAG_ALBEDO, OGREENROOF, GDO, GRO, HPROGRAM)
!#############################################################
!
!!**** *INIT_TEB_TEB_VEG_n* - routine to initialize ISBA
@@ -46,9 +44,7 @@ SUBROUTINE INIT_TEB_VEG_OPTIONS_n (&
!
!
USE MODD_CH_TEB_n, ONLY : CH_TEB_t
-USE MODD_DIAG_MISC_TEB_OPTION_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
-USE MODD_TEB_GARDEN_OPTION_n, ONLY : TEB_GARDEN_OPTIONS_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
USE MODD_READ_NAMELIST, ONLY : LNAM_READ
!
@@ -65,9 +61,11 @@ USE MODD_ISBA_PAR, ONLY : XOPTIMGRID
!
USE MODN_TEB_n, ONLY : XTSTEP
!
+USE MODI_READ_NAM_PGD_ISBA
USE MODI_DEFAULT_ISBA
USE MODI_DEFAULT_CH_DEP
USE MODI_DEFAULT_CH_BIO_FLUX
+USE MODI_DEFAULT_CROCUS
USE MODI_READ_DEFAULT_TEB_VEG_n
USE MODI_READ_TEB_VEG_CONF_n
USE MODI_GET_LUOUT
@@ -85,27 +83,26 @@ IMPLICIT NONE
!
!
TYPE(CH_TEB_t), INTENT(INOUT) :: CHT
-TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: DGMTO
-TYPE(TEB_GARDEN_OPTIONS_t), INTENT(INOUT) :: TGDO
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
+LOGICAL, INTENT(OUT) :: OSURF_DIAG_ALBEDO
+LOGICAL, INTENT(IN) :: OGREENROOF
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: GDO
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: GRO
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
!
-!
-!
!* 0.2 Declarations of local variables
! -------------------------------
!
INTEGER :: IVERSION, IBUGFIX ! surface version
INTEGER :: ILUOUT ! unit of output listing file
INTEGER :: IRESP ! Error code after redding
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=4 ) :: YLVL
+CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=4 ) :: YLVL
!
INTEGER :: JLAYER ! loop counter on layers
!
REAL :: ZOUT_TSTEP
- CHARACTER(LEN=3) :: YRAIN
+CHARACTER(LEN=3) :: YRAIN
LOGICAL :: GCANOPY_DRAG
LOGICAL :: GGLACIER
LOGICAL :: GFLOOD
@@ -119,6 +116,52 @@ REAL :: ZCO2_START
REAL :: ZCO2_END
INTEGER :: INBYEARSPINS
INTEGER :: INBYEARSPINW
+!
+INTEGER :: IPATCH ! number of patches
+INTEGER :: IGROUND_LAYER ! number of soil layers
+INTEGER :: JVEGTYPE
+CHARACTER(LEN=3) :: YISBA ! ISBA option
+CHARACTER(LEN=4) :: YPEDOTF ! Pedo transfert function for DIF
+CHARACTER(LEN=3) :: YPHOTO ! photosynthesis option
+LOGICAL :: GTR_ML ! new radiative transfert
+CHARACTER(LEN=4) :: YALBEDO
+REAL :: ZRM_PATCH ! threshold to remove little fractions of patches
+CHARACTER(LEN=28) :: YSAND ! file name for sand fraction
+CHARACTER(LEN=28) :: YCLAY ! file name for clay fraction
+CHARACTER(LEN=28) :: YSOC_TOP ! file name for organic carbon top soil
+CHARACTER(LEN=28) :: YSOC_SUB ! file name for organic carbon sub soil
+CHARACTER(LEN=28) :: YCTI ! file name for topographic index
+CHARACTER(LEN=28) :: YRUNOFFB ! file name for runoffb parameter
+CHARACTER(LEN=28) :: YWDRAIN ! file name for wdrain parameter
+CHARACTER(LEN=28) :: YPERM ! file name for permafrost distribution
+CHARACTER(LEN=6) :: YSANDFILETYPE ! sand data file type
+CHARACTER(LEN=6) :: YCLAYFILETYPE ! clay data file type
+CHARACTER(LEN=6) :: YSOCFILETYPE ! organic carbon data file type
+CHARACTER(LEN=6) :: YCTIFILETYPE ! topographic index data file type
+CHARACTER(LEN=6) :: YRUNOFFBFILETYPE ! subgrid runoff data file type
+CHARACTER(LEN=6) :: YWDRAINFILETYPE ! subgrid drainage data file type
+CHARACTER(LEN=6) :: YPERMFILETYPE ! permafrost distribution data file type
+REAL :: XUNIF_SAND ! uniform value of sand fraction (-)
+REAL :: XUNIF_CLAY ! uniform value of clay fraction (-)
+REAL :: XUNIF_SOC_TOP ! uniform value of organic carbon top soil (kg/m2)
+REAL :: XUNIF_SOC_SUB ! uniform value of organic carbon sub soil (kg/m2)
+REAL :: XUNIF_RUNOFFB ! uniform value of subgrid runoff coefficient
+REAL :: XUNIF_WDRAIN ! uniform subgrid drainage parameter
+REAL :: XUNIF_PERM ! uniform permafrost distribution
+LOGICAL :: LIMP_SAND ! Imposed maps of Sand
+LOGICAL :: LIMP_CLAY ! Imposed maps of Clay
+LOGICAL :: LIMP_SOC ! Imposed maps of organic carbon
+LOGICAL :: LIMP_CTI ! Imposed maps of topographic index statistics
+LOGICAL :: LIMP_PERM ! Imposed maps of permafrost distribution
+REAL, DIMENSION(150) :: ZSOILGRID ! Soil grid reference for DIF
+CHARACTER(LEN=28) :: YPH ! file name for pH
+CHARACTER(LEN=28) :: YFERT ! file name for fertilisation rate
+CHARACTER(LEN=6) :: YPHFILETYPE ! pH data file type
+CHARACTER(LEN=6) :: YFERTFILETYPE ! fertilisation data file type
+REAL :: XUNIF_PH ! uniform value of pH
+REAL :: XUNIF_FERT ! uniform value of fertilisation rate
+LOGICAL :: GMEB ! Multi-energy balance (MEB)
+!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
@@ -130,7 +173,7 @@ IF (LHOOK) CALL DR_HOOK('INIT_TEB_VEG_OPTIONS_N',0,ZHOOK_HANDLE)
!
! Other little things
!
-DGMTO%LSURF_DIAG_ALBEDO = .FALSE.
+OSURF_DIAG_ALBEDO = .FALSE.
!
IF (LNAM_READ) THEN
!
@@ -144,28 +187,30 @@ IF (LNAM_READ) THEN
! because they are already in init_teb.f90 (these options are
! forced to the same values for TEB and urban green areas)
!
- CALL DEFAULT_ISBA(XTSTEP, ZOUT_TSTEP, &
- TVG%CROUGH, TVG%CRUNOFF, TVG%CALBEDO, TVG%CSCOND, &
- TVG%CC1DRY, TVG%CSOILFRZ, TVG%CDIFSFCOND, TVG%CSNOWRES, &
- TVG%CCPSURF, TVG%XCGMAX, TVG%XCDRAG, TVG%CKSAT, TVG%LSOC, &
- YRAIN, TVG%CHORT, GGLACIER, GCANOPY_DRAG, &
- GVEGUPD, GSPINUPCARBS, GSPINUPCARBW, &
- ZSPINMAXS, ZSPINMAXW, ZCO2_START, ZCO2_END, &
- INBYEARSPINS, INBYEARSPINW, TVG%LNITRO_DILU )
+ CALL DEFAULT_ISBA(GDO%XTSTEP, GDO%XOUT_TSTEP, GDO%CRUNOFF, &
+ GDO%CSCOND, GDO%CC1DRY, GDO%CSOILFRZ, &
+ GDO%CDIFSFCOND, GDO%CSNOWRES, GDO%CCPSURF, GDO%XCGMAX, &
+ GDO%XCDRAG, GDO%CKSAT, GDO%LSOC, GDO%CRAIN, GDO%CHORT, &
+ GDO%LGLACIER, GDO%LCANOPY_DRAG, GDO%LVEGUPD, GDO%LSPINUPCARBS, &
+ GDO%LSPINUPCARBW, GDO%XSPINMAXS, GDO%XSPINMAXW, GDO%XCO2_START,&
+ GDO%XCO2_END, GDO%NNBYEARSPINS, GDO%NNBYEARSPINW, GDO%LNITRO_DILU )
!
CALL DEFAULT_CH_BIO_FLUX(CHT%LCH_BIO_FLUX)
!
+ CALL DEFAULT_CROCUS(GDO%LSNOWDRIFT,GDO%LSNOWDRIFT_SUBLIM,GDO%LSNOW_ABS_ZENITH,&
+ GDO%CSNOWMETAMO,GDO%CSNOWRAD)
+ !
ENDIF
! 1.2. Defaults from file header
!
- CALL READ_DEFAULT_TEB_VEG_n(CHT, TVG, &
- HPROGRAM)
+ CALL READ_DEFAULT_TEB_VEG_n(CHT, GDO, HPROGRAM)
!
- CALL READ_TEB_VEG_CONF_n(CHT, TVG, &
- HPROGRAM)
+ CALL READ_TEB_VEG_CONF_n(CHT, GDO, HPROGRAM)
!
!-------------------------------------------------------------------------------
-TVG%CRESPSL = 'DEF'
+GDO%NPATCH = 1
+GDO%CRESPSL = 'DEF'
+GDO%LMEB_GNDRES = .FALSE.
!-------------------------------------------------------------------------------
!
! Initialisation for IO
@@ -174,12 +219,10 @@ TVG%CRESPSL = 'DEF'
! ---------------------
!
YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
!
YRECFM='BUG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IBUGFIX,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
!
!* 2. Initialisation of ISBA options
! ------------------------------
@@ -187,29 +230,28 @@ YRECFM='BUG'
!
YRECFM='TWN_ISBA'
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TVG%CISBA,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,GDO%CISBA,IRESP)
!
IF (IVERSION>=7) THEN
!
YRECFM='TWN_PEDOTF'
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_PEDOTF'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TVG%CPEDOTF,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,GDO%CPEDOTF,IRESP)
!
ELSE
- TVG%CPEDOTF = 'CH78'
+ GDO%CPEDOTF = 'CH78'
ENDIF
!
YRECFM='TWN_PHOTO'
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_PHOTO'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TVG%CPHOTO,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,GDO%CPHOTO,IRESP)
!
YRECFM='TWN_LAYER'
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_LAYER'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TGDO%NGROUND_LAYER,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,GDO%NGROUND_LAYER,IRESP)
+!
+ALLOCATE(GDO%LMEB_PATCH(1))
+GDO%LMEB_PATCH(:) = .FALSE.
!
!* new radiative transfert
!
@@ -217,41 +259,122 @@ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN
!
YRECFM='TWN_TR_ML'
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_TR_ML'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TVG%LTR_ML,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,GDO%LTR_ML,IRESP)
!
ELSE
- TVG%LTR_ML = .FALSE.
+ GDO%LTR_ML = .FALSE.
+ENDIF
+!
+IF (IVERSION>8 .OR. IVERSION==8 .AND. IBUGFIX>=1) THEN
+ !
+ YRECFM='GD_ALBEDO'
+ CALL READ_SURF(HPROGRAM,YRECFM,GDO%CALBEDO,IRESP)
+ !
+ELSE
+ !
+ CALL READ_NAM_PGD_ISBA(HPROGRAM, IPATCH, IGROUND_LAYER, &
+ YISBA, YPEDOTF, YPHOTO, GTR_ML, YALBEDO, ZRM_PATCH, &
+ YCLAY, YCLAYFILETYPE, XUNIF_CLAY, LIMP_CLAY, &
+ YSAND, YSANDFILETYPE, XUNIF_SAND, LIMP_SAND, &
+ YSOC_TOP, YSOC_SUB, YSOCFILETYPE, XUNIF_SOC_TOP, &
+ XUNIF_SOC_SUB, LIMP_SOC, YCTI, YCTIFILETYPE, LIMP_CTI, &
+ YPERM, YPERMFILETYPE, XUNIF_PERM, LIMP_PERM, GMEB, &
+ YRUNOFFB, YRUNOFFBFILETYPE, XUNIF_RUNOFFB, &
+ YWDRAIN, YWDRAINFILETYPE , XUNIF_WDRAIN, ZSOILGRID, &
+ YPH, YPHFILETYPE, XUNIF_PH, YFERT, YFERTFILETYPE, &
+ XUNIF_FERT )
+ GDO%CALBEDO = YALBEDO
+ !
ENDIF
!
!* Reference grid for DIF
!
-IF(TVG%CISBA=='DIF') THEN
- ALLOCATE(TGDO%XSOILGRID(TGDO%NGROUND_LAYER))
- TGDO%XSOILGRID=XUNDEF
+IF(GDO%CISBA=='DIF') THEN
+ ALLOCATE(GDO%XSOILGRID(GDO%NGROUND_LAYER))
+ GDO%XSOILGRID=XUNDEF
IF (IVERSION>=8) THEN
- DO JLAYER=1,TGDO%NGROUND_LAYER
+ DO JLAYER=1,GDO%NGROUND_LAYER
WRITE(YLVL,'(I4)') JLAYER
YRECFM='GD_SGRID'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TGDO%XSOILGRID(JLAYER),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,GDO%XSOILGRID(JLAYER),IRESP)
ENDDO
ELSEIF (IVERSION==7 .AND. IBUGFIX>=2) THEN
YRECFM='TWN_SOILGRID'
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_SOILGRID'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TGDO%XSOILGRID,IRESP,HDIR='-')
+ CALL READ_SURF(HPROGRAM,YRECFM,GDO%XSOILGRID,IRESP,HDIR='-')
ELSE
- TGDO%XSOILGRID(1:TGDO%NGROUND_LAYER)=XOPTIMGRID(1:TGDO%NGROUND_LAYER)
+ GDO%XSOILGRID(1:GDO%NGROUND_LAYER)=XOPTIMGRID(1:GDO%NGROUND_LAYER)
ENDIF
ELSE
- ALLOCATE(TGDO%XSOILGRID(0))
+ ALLOCATE(GDO%XSOILGRID(0))
ENDIF
!
!* number of biomass pools
!
-TVG%NNBIOMASS=1
-IF (TVG%CPHOTO=='NIT') TVG%NNBIOMASS=3
+GDO%NNBIOMASS=1
+IF (GDO%CPHOTO=='NIT') GDO%NNBIOMASS=3
+!
+!-------------------------------------------------------------------------------
+!
+IF (OGREENROOF) THEN
+ !
+ GRO%NPATCH = 1
+ ALLOCATE(GRO%LMEB_PATCH(1))
+ GRO%LMEB_PATCH(:) = .FALSE.
+ GRO%CRESPSL = GDO%CRESPSL
+ !
+ YRECFM='GR_ISBA'
+ CALL READ_SURF(HPROGRAM,YRECFM,GRO%CISBA,IRESP)
+ !
+ GRO%CPEDOTF = GDO%CPEDOTF
+ GRO%CPHOTO = GDO%CPHOTO
+ !
+ YRECFM='GR_LAYER'
+ CALL READ_SURF( HPROGRAM,YRECFM,GRO%NGROUND_LAYER,IRESP)
+ !
+ GRO%LTR_ML = .FALSE.
+ !
+ GRO%NNBIOMASS = GDO%NNBIOMASS
+ !
+ YRECFM='GR_SCOND'
+ CALL READ_SURF(HPROGRAM,YRECFM,GRO%CSCOND,IRESP)
+ !
+ GRO%XTSTEP = GDO%XTSTEP
+ GRO%XOUT_TSTEP = GDO%XOUT_TSTEP
+ GRO%CRUNOFF = GDO%CRUNOFF
+ GRO%CALBEDO = GDO%CALBEDO
+ GRO%CC1DRY = GDO%CC1DRY
+ GRO%CSOILFRZ = GDO%CSOILFRZ
+ GRO%CDIFSFCOND = GDO%CDIFSFCOND
+ GRO%CSNOWRES = GDO%CSNOWRES
+ GRO%CCPSURF = GDO%CCPSURF
+ GRO%XCGMAX = GDO%XCGMAX
+ GRO%XCDRAG = GDO%XCDRAG
+ GRO%CKSAT = GDO%CKSAT
+ GRO%LSOC = GDO%LSOC
+ GRO%CRAIN = GDO%CRAIN
+ GRO%CHORT = GDO%CHORT
+ GRO%LGLACIER = GDO%LGLACIER
+ GRO%LCANOPY_DRAG = GDO%LCANOPY_DRAG
+ GRO%LVEGUPD = GDO%LVEGUPD
+ GRO%LSPINUPCARBS = GDO%LSPINUPCARBS
+ GRO%LSPINUPCARBW = GDO%LSPINUPCARBW
+ GRO%XSPINMAXS = GDO%XSPINMAXS
+ GRO%XSPINMAXW = GDO%XSPINMAXW
+ GRO%XCO2_START = GDO%XCO2_START
+ GRO%XCO2_END = GDO%XCO2_END
+ GRO%NNBYEARSPINS = GDO%NNBYEARSPINS
+ GRO%NNBYEARSPINW = GDO%NNBYEARSPINW
+ GRO%LNITRO_DILU = GDO%LNITRO_DILU
+ !
+ GRO%LSNOWDRIFT = GDO%LSNOWDRIFT
+ GRO%LSNOWDRIFT_SUBLIM = GDO%LSNOWDRIFT_SUBLIM
+ GRO%LSNOW_ABS_ZENITH = GDO%LSNOW_ABS_ZENITH
+ GRO%CSNOWMETAMO = GDO%CSNOWMETAMO
+ GRO%CSNOWRAD = GDO%CSNOWRAD
+ !
+ GRO%LMEB_GNDRES = GDO%LMEB_GNDRES
+ENDIF
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/init_tebn.F90 b/src/SURFEX/init_tebn.F90
index 4e4481c9388f4c48cd8d665421af13f75416866d..7f35cc052771be88f84ea4edf10e6fd4fe89ff13 100644
--- a/src/SURFEX/init_tebn.F90
+++ b/src/SURFEX/init_tebn.F90
@@ -3,16 +3,12 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #############################################################
- SUBROUTINE INIT_TEB_n (DTCO, DGU, UG, U, CHI, DTI, I, &
- TM, GDM, GRM, DST, SLT,GCP, &
- HPROGRAM,HINIT, &
- KI,KSV,KSW, &
- HSV,PCO2,PRHOA, &
- PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD,PTSURF, &
- KYEAR, KMONTH,KDAY, PTIME, &
- HATMFILE,HATMFILETYPE, &
- HTEST )
+ SUBROUTINE INIT_TEB_n (DTCO, UG, U, GCP, CHT, DTT, SB, TG, TOP, TPN, &
+ TIR, NT, TD, BDD, BOP, DTB, NB, GDM, GRM, &
+ HPROGRAM, HINIT, KI, KSV, KSW, HSV, PCO2, &
+ PRHOA, PZENITH, PAZIM, PSW_BANDS, PDIR_ALB, &
+ PSCA_ALB, PEMIS, PTSRAD, PTSURF, KYEAR, KMONTH, &
+ KDAY, PTIME, HATMFILE, HATMFILETYPE, HTEST )
! #############################################################
!
!!**** *INIT_TEB_n* - routine to initialize TEB
@@ -44,26 +40,29 @@
!! G. Pigeon 09/2012: add ROUGH_WALL/ROUGH_ROOF/CH_BEM for conv. coef.
!! B. Decharme 04/2013 new coupling variables
!! delete CTOPREG option (never used)
-!! M.Moge 02/2015 MPPDB_CHECK
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_SURFEX_n, ONLY : TEB_MODEL_t
-USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t
-USE MODD_SURFEX_n, ONLY : TEB_GREENROOF_MODEL_t
-USE MODD_DST_n, ONLY : DST_t
-USE MODD_SLT_n, ONLY : SLT_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
+!
+USE MODD_CH_TEB_n, ONLY : CH_TEB_t
+USE MODD_DATA_TEB_n, ONLY : DATA_TEB_t
+USE MODD_CANOPY_n, ONLY: CANOPY_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
+USE MODD_TEB_PANEL_n, ONLY : TEB_PANEL_t
+USE MODD_TEB_IRRIG_n, ONLY : TEB_IRRIG_t
+USE MODD_TEB_n, ONLY : TEB_NP_t
+USE MODD_SURFEX_n, ONLY : TEB_DIAG_t, TEB_VEG_DIAG_t, TEB_GARDEN_MODEL_t, TEB_GREENROOF_MODEL_t
+USE MODD_BLD_DESCRIPTION_n, ONLY : BLD_DESC_t
+USE MODD_BEM_OPTION_n, ONLY : BEM_OPTIONS_t
+USE MODD_DATA_BEM_n, ONLY : DATA_BEM_t
+USE MODD_BEM_n, ONLY : BEM_NP_t
!
USE MODD_IO_SURF_ASC,ONLY: CMASK
USE MODD_SNOW_PAR, ONLY : XEMISSN
@@ -75,6 +74,8 @@ USE MODD_DST_SURF, ONLY: LVARSIG_DST, NDSTMDE, NDST_MDEBEG, LRGFIX_DST
USE MODD_SLT_SURF, ONLY: LVARSIG_SLT, NSLTMDE, NSLT_MDEBEG, LRGFIX_SLT
USE MODD_SURF_PAR, ONLY: XUNDEF, NUNDEF
!
+USE MODN_PREP_TEB, ONLY : CROAD_DIR, CWALL_OPT
+!
USE MODI_INIT_IO_SURF_n
USE MODI_DEFAULT_CH_DEP
USE MODI_DEFAULT_TEB
@@ -98,9 +99,8 @@ USE MODI_READ_PREP_TEB_SNOW
USE MODI_READ_TEB_DATE
USE MODI_READ_NAM_PREP_TEB_n
USE MODI_INIT_CHEMICAL_n
-USE MODI_GARDEN_PROPERTIES
+USE MODI_TEB_VEG_PROPERTIES
USE MODI_HVAC_AUTOSIZE
-USE MODI_GOTO_WRAPPER_TEB_PATCH
!
USE MODI_INIT_TEB_GARDEN_n
USE MODI_INIT_TEB_GARDEN_PGD_n
@@ -109,19 +109,17 @@ USE MODI_TEB_MORPHO
USE MODI_INIT_BEM_n
USE MODI_INIT_TEB_GREENROOF_n
USE MODI_INIT_TEB_GREENROOF_PGD_n
-USE MODI_GREENROOF_PROPERTIES
USE MODI_READ_PGD_TEB_IRRIG_n
!
USE MODI_READ_COVER_GARDEN
USE MODI_ABOR1_SFX
-USE MODI_READ_TEB_CANOPY_n
+USE MODI_READ_SBL_n
USE MODI_SET_SURFEX_FILEIN
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
#ifdef MNH_PARALLEL
-USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
USE MODE_MPPDB
!
#endif
@@ -132,18 +130,28 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM
+TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
+TYPE(CH_TEB_t), INTENT(INOUT) :: CHT
+TYPE(DATA_TEB_t), INTENT(INOUT) :: DTT
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
+TYPE(GRID_t), INTENT(INOUT) :: TG
+TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+TYPE(TEB_PANEL_t), INTENT(INOUT) :: TPN
+TYPE(TEB_IRRIG_t), INTENT(INOUT) :: TIR
+TYPE(TEB_NP_t), INTENT(INOUT) :: NT
+!
+TYPE(TEB_DIAG_t), INTENT(INOUT) :: TD
+!
+TYPE(BLD_DESC_t), INTENT(INOUT) :: BDD
+TYPE(BEM_OPTIONS_t), INTENT(INOUT) :: BOP
+TYPE(DATA_BEM_t), INTENT(INOUT) :: DTB
+TYPE(BEM_NP_t), INTENT(INOUT) :: NB
+!
TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM
-TYPE(DST_t), INTENT(INOUT) :: DST
-TYPE(SLT_t), INTENT(INOUT) :: SLT
-TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize
@@ -197,7 +205,7 @@ REAL, DIMENSION(KI) :: ZEMIS_GREENROOF ! emissivity
REAL, DIMENSION(KI) :: ZALB_GREENROOF ! albedo
REAL, DIMENSION(KI) :: ZTS_GREENROOF ! radiative temperature
!
-INTEGER :: JPATCH
+INTEGER :: JP
INTEGER :: IVERSION, IBUGFIX
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -220,7 +228,7 @@ PEMIS = XUNDEF
PTSRAD = XUNDEF
PTSURF = XUNDEF
!
-TM%DGMTO%LSURF_EVAP_BUDGET = .FALSE.
+TD%MTO%LSURF_EVAP_BUDGET = .FALSE.
!
IF (LNAM_READ) THEN
!
@@ -228,37 +236,31 @@ IF (LNAM_READ) THEN
! --------
!
! 0.1. Hard defaults
- !
- CALL DEFAULT_TEB(TM%TOP%CZ0H,TM%TOP%XTSTEP,TM%TOP%XOUT_TSTEP, TM%TOP%CCH_BEM, &
- TM%T%CUR%XDT_RES, TM%T%CUR%XDT_OFF)
- CALL DEFAULT_CH_DEP(TM%CHT%CCH_DRY_DEP)
- CALL DEFAULT_DIAG_TEB(TM%DGT%N2M,TM%DGT%LSURF_BUDGET,TM%DGT%L2M_MIN_ZS,TM%DGT%LRAD_BUDGET,&
- TM%DGT%LCOEF,TM%DGT%LSURF_VARS,TM%DGMTO%LSURF_MISC_BUDGET,&
- TM%DGMTO%LSURF_DIAG_ALBEDO,TM%DGUT%LUTCI,TM%DGT%LPGD,&
- TM%DGT%LPGD_FIX,TM%DGT%XDIAG_TSTEP)
+ !
+ CALL DEFAULT_TEB(TOP%CZ0H, TOP%XTSTEP, TOP%XOUT_TSTEP, TOP%CCH_BEM, &
+ NT%AL(1)%XDT_RES, NT%AL(1)%XDT_OFF)
+ CALL DEFAULT_CH_DEP(CHT%CCH_DRY_DEP)
+ CALL DEFAULT_DIAG_TEB(TD%O%N2M, TD%O%LSURF_BUDGET, TD%O%L2M_MIN_ZS, TD%O%LRAD_BUDGET,&
+ TD%O%LCOEF, TD%O%LSURF_VARS, TD%MTO%LSURF_MISC_BUDGET, &
+ TD%MTO%LSURF_DIAG_ALBEDO, TD%DUT%LUTCI, TD%O%LPGD, &
+ TD%O%XDIAG_TSTEP)
!
ENDIF
!
! 0.2. Defaults from file header
!
- CALL READ_DEFAULT_TEB_n(TM%CHT, TM%DGMTO, TM%DGT, TM%DGUT, GRM%TGRO, TM%T, TM%TOP, &
- HPROGRAM)
+ CALL READ_DEFAULT_TEB_n(CHT, TD%MTO, TD%O, TD%DUT, GRM%O, NT%AL(1), TOP, HPROGRAM)
!
!* 1. Reading of configuration:
! -------------------------
!
- CALL READ_TEB_CONF_n(TM%CHT, TM%DGMTO, TM%DGT, TM%DGUT, TM%T, TM%TOP, &
- HPROGRAM)
+ CALL READ_TEB_CONF_n(CHT, TD%MTO, TD%O, TD%DUT, NT%AL(1), TOP, HPROGRAM)
!
!* initialization of snow scheme
!
IF (HINIT=='PRE') THEN
- DO JPATCH=1,TM%TOP%NTEB_PATCH
- CALL GOTO_WRAPPER_TEB_PATCH(TM%B, TM%DGCT, TM%DGMT, TM%T, GDM%TGD, GDM%TGDPE, &
- GRM%TGR, GRM%TGRPE, JPATCH)
- CALL READ_PREP_TEB_SNOW(HPROGRAM,TM%T%CUR%TSNOW_ROOF%SCHEME,TM%T%CUR%TSNOW_ROOF%NLAYER, &
- TM%T%CUR%TSNOW_ROAD%SCHEME,TM%T%CUR%TSNOW_ROAD%NLAYER)
- END DO
+ CALL READ_PREP_TEB_SNOW(HPROGRAM, NT%AL(1)%TSNOW_ROOF%SCHEME, NT%AL(1)%TSNOW_ROOF%NLAYER, &
+ NT%AL(1)%TSNOW_ROAD%SCHEME, NT%AL(1)%TSNOW_ROAD%NLAYER)
ENDIF
!
!* 2. Cover fields and grid:
@@ -267,24 +269,19 @@ ENDIF
!
SELECT CASE (HINIT)
CASE ('PGD')
- TM%TOP%TTIME%TDATE%YEAR = NUNDEF
- TM%TOP%TTIME%TDATE%MONTH= NUNDEF
- TM%TOP%TTIME%TDATE%DAY = NUNDEF
- TM%TOP%TTIME%TIME = XUNDEF
+ TOP%TTIME%TDATE%YEAR = NUNDEF
+ TOP%TTIME%TDATE%MONTH= NUNDEF
+ TOP%TTIME%TDATE%DAY = NUNDEF
+ TOP%TTIME%TIME = XUNDEF
CASE ('PRE')
- CALL PREP_CTRL_TEB(TM%DGT%N2M,TM%DGT%LSURF_BUDGET,TM%DGT%L2M_MIN_ZS,TM%DGT%LRAD_BUDGET,&
- TM%DGT%LCOEF,TM%DGT%LSURF_VARS,TM%DGMTO%LSURF_EVAP_BUDGET,&
- TM%DGMTO%LSURF_MISC_BUDGET,TM%DGUT%LUTCI,ILUOUT )
+ CALL PREP_CTRL_TEB(TD%O, TD%MTO%LSURF_EVAP_BUDGET, TD%MTO%LSURF_MISC_BUDGET, TD%DUT%LUTCI,ILUOUT )
IF (LNAM_READ) CALL READ_NAM_PREP_TEB_n(HPROGRAM)
- CALL READ_TEB_DATE(&
- HPROGRAM,HINIT,ILUOUT,HATMFILE,HATMFILETYPE,KYEAR,KMONTH,KDAY,PTIME,TM%TOP%TTIME)
+ CALL READ_TEB_DATE(HPROGRAM,HINIT,ILUOUT,HATMFILE,HATMFILETYPE,KYEAR,KMONTH,KDAY,PTIME,TOP%TTIME)
CASE DEFAULT
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'TOWN ','TEB ','READ ')
- CALL READ_SURF(&
- HPROGRAM,'DTCUR',TM%TOP%TTIME,IRESP)
+ CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'FULL ','SURF ','READ ')
+ CALL READ_SURF(HPROGRAM,'DTCUR',TOP%TTIME,IRESP)
CALL END_IO_SURF_n(HPROGRAM)
END SELECT
!
@@ -295,152 +292,132 @@ END SELECT
! Initialisation for IO
!
CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ') ! change input file name to pgd name
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'TOWN ','TEB ','READ ')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'TOWN ','TEB ','READ ')
!
- CALL READ_SURF(&
- HPROGRAM,'VERSION',IVERSION,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'BUG',IBUGFIX,IRESP)
+ CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP)
!
! Reading of the fields
!
- CALL READ_COVER_GARDEN(&
- HPROGRAM,TM%TOP%LGARDEN)
+ CALL READ_COVER_GARDEN(HPROGRAM,TOP%LGARDEN)
+!
+ CALL READ_PGD_TEB_n(DTCO, U, UG, GCP, TOP, TG, BOP, BDD, DTB, DTT, HPROGRAM)
!
- CALL READ_PGD_TEB_n(DTCO, U, TM,GCP, &
- HPROGRAM)
#ifdef MNH_PARALLEL
- CALL MPPDB_CHECK_SURFEX3D(TM%TOP%XCOVER,"INIT_TEB_n after READ_PGD_TEB_n:XCOVER",PRECISION,ILUOUT, 'TOWN ',SIZE(TM%TOP%XCOVER,2))
+ CALL MPPDB_CHECK_SURFEX3D(TOP%XCOVER,"INIT_TEB_n after READ_PGD_TEB_n:XCOVER",PRECISION,ILUOUT, 'TOWN ',SIZE(TOP%XCOVER,2))
#endif
!
- CALL END_IO_SURF_n(HPROGRAM)
+CALL END_IO_SURF_n(HPROGRAM)
!
!* Fraction of each patch in the grid mesh
!
-ILU = SIZE(TM%TOP%XCOVER,1)
+ILU = SIZE(TOP%XCOVER,1)
+!
+ALLOCATE(TOP%XTEB_PATCH(ILU,TOP%NTEB_PATCH))
+ CALL CONVERT_TEB(TOP%NTEB_PATCH, TOP%XCOVER,TOP%XTEB_PATCH)
!
-ALLOCATE(TM%TOP%XTEB_PATCH(ILU,TM%TOP%NTEB_PATCH))
- CALL CONVERT_TEB(TM%TOP, &
- TM%TOP%XCOVER,TM%TOP%XTEB_PATCH)
#ifdef MNH_PARALLEL
- CALL MPPDB_CHECK_SURFEX3D(TM%TOP%XCOVER,"INIT_TEB_n after CONVERT_TEB:XCOVER",PRECISION,ILUOUT, 'TOWN ',SIZE(TM%TOP%XCOVER,2))
+ CALL MPPDB_CHECK_SURFEX3D(TOP%XCOVER,"INIT_TEB_n after CONVERT_TEB:XCOVER",PRECISION,ILUOUT, 'TOWN ',SIZE(TOP%XCOVER,2))
#endif
-!
- CALL SET_SURFEX_FILEIN(HPROGRAM,'PREP') ! restore input file name
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'TOWN ','TEB ','READ ')
-!
- CALL READ_SURF(&
- HPROGRAM,'VERSION',IVERSION,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'BUG',IBUGFIX,IRESP)
!
!* reads what is the option defined for road orientations & walls
!
IF (HINIT=='ALL') THEN
- TM%TOP%CROAD_DIR='UNIF'
- TM%TOP%CWALL_OPT='UNIF'
+ !
+ CALL SET_SURFEX_FILEIN(HPROGRAM,'PREP') ! restore input file name
+ CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'TOWN ','TEB ','READ ')
+!
+ CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP)
+!
+ TOP%CROAD_DIR='UNIF'
+ TOP%CWALL_OPT='UNIF'
IF (IVERSION>7 .OR. (IVERSION==7 .AND. IBUGFIX>=3)) THEN
- CALL READ_SURF(&
- HPROGRAM,'ROAD_DIR',TM%TOP%CROAD_DIR,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'WALL_OPT',TM%TOP%CWALL_OPT,IRESP)
+ CALL READ_SURF(HPROGRAM,'ROAD_DIR',TOP%CROAD_DIR,IRESP)
+ CALL READ_SURF(HPROGRAM,'WALL_OPT',TOP%CWALL_OPT,IRESP)
END IF
-END IF
- CALL END_IO_SURF_n(HPROGRAM)
+ CALL END_IO_SURF_n(HPROGRAM)
+ !
+ELSE
+ !
+ TOP%CROAD_DIR = CROAD_DIR
+ TOP%CWALL_OPT = CWALL_OPT
+ !
+ENDIF
+!
!-----------------------------------------------------------------------------------
!
!* LOOP ON TEB PATCHES
! -------------------
!
-DO JPATCH=1,TM%TOP%NTEB_PATCH
-
- CALL GOTO_WRAPPER_TEB_PATCH(TM%B, TM%DGCT, TM%DGMT, TM%T, &
- GDM%TGD, GDM%TGDPE, GRM%TGR, GRM%TGRPE, JPATCH)
+DO JP=1,TOP%NTEB_PATCH
+ !
!-----------------------------------------------------------------------------------
!
!* 3. Physiographic data fields from land cover:
! -----------------------------------------
!
- ALLOCATE(TM%T%CUR%XZ0_TOWN (ILU))
- ALLOCATE(TM%T%CUR%XALB_ROOF (ILU))
- ALLOCATE(TM%T%CUR%XEMIS_ROOF (ILU))
- ALLOCATE(TM%T%CUR%XALB_ROAD (ILU))
- ALLOCATE(TM%T%CUR%XEMIS_ROAD (ILU))
- ALLOCATE(TM%T%CUR%XALB_WALL (ILU))
- ALLOCATE(TM%T%CUR%XEMIS_WALL (ILU))
- ALLOCATE(TM%T%CUR%XBLD (ILU))
- ALLOCATE(TM%T%CUR%XROAD_DIR (ILU))
- ALLOCATE(TM%T%CUR%XROAD (ILU))
- ALLOCATE(TM%T%CUR%XBLD_HEIGHT (ILU))
- ALLOCATE(TM%T%CUR%XWALL_O_HOR (ILU))
- ALLOCATE(TM%T%CUR%XCAN_HW_RATIO(ILU))
- ALLOCATE(TM%T%CUR%XROAD_O_GRND(ILU))
- ALLOCATE(TM%T%CUR%XGARDEN_O_GRND(ILU))
- ALLOCATE(TM%T%CUR%XWALL_O_GRND(ILU))
- ALLOCATE(TM%T%CUR%XWALL_O_BLD(ILU))
- ALLOCATE(TM%T%CUR%XH_TRAFFIC (ILU))
- ALLOCATE(TM%T%CUR%XLE_TRAFFIC (ILU))
- ALLOCATE(TM%T%CUR%XH_INDUSTRY (ILU))
- ALLOCATE(TM%T%CUR%XLE_INDUSTRY (ILU))
- ALLOCATE(TM%T%CUR%XHC_ROOF (ILU,TM%TOP%NROOF_LAYER))
- ALLOCATE(TM%T%CUR%XTC_ROOF (ILU,TM%TOP%NROOF_LAYER))
- ALLOCATE(TM%T%CUR%XD_ROOF (ILU,TM%TOP%NROOF_LAYER))
- ALLOCATE(TM%T%CUR%XHC_ROAD (ILU,TM%TOP%NROAD_LAYER))
- ALLOCATE(TM%T%CUR%XTC_ROAD (ILU,TM%TOP%NROAD_LAYER))
- ALLOCATE(TM%T%CUR%XD_ROAD (ILU,TM%TOP%NROAD_LAYER))
- ALLOCATE(TM%T%CUR%XHC_WALL (ILU,TM%TOP%NWALL_LAYER))
- ALLOCATE(TM%T%CUR%XTC_WALL (ILU,TM%TOP%NWALL_LAYER))
- ALLOCATE(TM%T%CUR%XD_WALL (ILU,TM%TOP%NWALL_LAYER))
- ALLOCATE(TM%T%CUR%XROUGH_ROOF (ILU))
- ALLOCATE(TM%T%CUR%XROUGH_WALL (ILU))
- ALLOCATE(TM%T%CUR%XRESIDENTIAL (ILU))
- ALLOCATE(TM%T%CUR%XGREENROOF (ILU))
- ALLOCATE(TM%T%CUR%XGARDEN (ILU))
- ALLOCATE(TM%TPN%XEMIS_PANEL (ILU))
- ALLOCATE(TM%TPN%XALB_PANEL (ILU))
- ALLOCATE(TM%TPN%XEFF_PANEL (ILU))
- ALLOCATE(TM%TPN%XFRAC_PANEL (ILU))
+ ALLOCATE(NT%AL(JP)%XZ0_TOWN (ILU))
+ ALLOCATE(NT%AL(JP)%XALB_ROOF (ILU))
+ ALLOCATE(NT%AL(JP)%XEMIS_ROOF (ILU))
+ ALLOCATE(NT%AL(JP)%XALB_ROAD (ILU))
+ ALLOCATE(NT%AL(JP)%XEMIS_ROAD (ILU))
+ ALLOCATE(NT%AL(JP)%XALB_WALL (ILU))
+ ALLOCATE(NT%AL(JP)%XEMIS_WALL (ILU))
+ ALLOCATE(NT%AL(JP)%XBLD (ILU))
+ ALLOCATE(NT%AL(JP)%XROAD_DIR (ILU))
+ ALLOCATE(NT%AL(JP)%XROAD (ILU))
+ ALLOCATE(NT%AL(JP)%XBLD_HEIGHT (ILU))
+ ALLOCATE(NT%AL(JP)%XWALL_O_HOR (ILU))
+ ALLOCATE(NT%AL(JP)%XCAN_HW_RATIO(ILU))
+ ALLOCATE(NT%AL(JP)%XROAD_O_GRND (ILU))
+ ALLOCATE(NT%AL(JP)%XGARDEN_O_GRND(ILU))
+ ALLOCATE(NT%AL(JP)%XWALL_O_GRND (ILU))
+ ALLOCATE(NT%AL(JP)%XWALL_O_BLD( ILU))
+ ALLOCATE(NT%AL(JP)%XH_TRAFFIC (ILU))
+ ALLOCATE(NT%AL(JP)%XLE_TRAFFIC (ILU))
+ ALLOCATE(NT%AL(JP)%XH_INDUSTRY (ILU))
+ ALLOCATE(NT%AL(JP)%XLE_INDUSTRY (ILU))
+ ALLOCATE(NT%AL(JP)%XHC_ROOF (ILU,TOP%NROOF_LAYER))
+ ALLOCATE(NT%AL(JP)%XTC_ROOF (ILU,TOP%NROOF_LAYER))
+ ALLOCATE(NT%AL(JP)%XD_ROOF (ILU,TOP%NROOF_LAYER))
+ ALLOCATE(NT%AL(JP)%XHC_ROAD (ILU,TOP%NROAD_LAYER))
+ ALLOCATE(NT%AL(JP)%XTC_ROAD (ILU,TOP%NROAD_LAYER))
+ ALLOCATE(NT%AL(JP)%XD_ROAD (ILU,TOP%NROAD_LAYER))
+ ALLOCATE(NT%AL(JP)%XHC_WALL (ILU,TOP%NWALL_LAYER))
+ ALLOCATE(NT%AL(JP)%XTC_WALL (ILU,TOP%NWALL_LAYER))
+ ALLOCATE(NT%AL(JP)%XD_WALL (ILU,TOP%NWALL_LAYER))
+ ALLOCATE(NT%AL(JP)%XROUGH_ROOF (ILU))
+ ALLOCATE(NT%AL(JP)%XROUGH_WALL (ILU))
+ ALLOCATE(NT%AL(JP)%XRESIDENTIAL (ILU))
+ ALLOCATE(NT%AL(JP)%XGREENROOF (ILU))
+ ALLOCATE(NT%AL(JP)%XGARDEN (ILU))
+ ALLOCATE(TPN%XEMIS_PANEL (ILU))
+ ALLOCATE(TPN%XALB_PANEL (ILU))
+ ALLOCATE(TPN%XEFF_PANEL (ILU))
+ ALLOCATE(TPN%XFRAC_PANEL (ILU))
!
- TM%T%CUR%XROAD_DIR(:) = 0.
- TM%T%CUR%XROAD (:) = 0.
+ NT%AL(JP)%XROAD_DIR(:) = 0.
+ NT%AL(JP)%XROAD (:) = 0.
!
ZDEF_ROAD_DIR = 0.
- IF (TM%TOP%CROAD_DIR/='UNIF') THEN
+ IF (TOP%CROAD_DIR/='UNIF') THEN
!* road direction if not specified by the user depends on patch number
! First patch has a Notrh-South road. Other patches have roads spaced by
! regular angles
- ZDEF_ROAD_DIR = 180. * FLOAT(JPATCH-1) / FLOAT(TM%TOP%NTEB_PATCH)
+ ZDEF_ROAD_DIR = 180. * FLOAT(JP-1) / FLOAT(TOP%NTEB_PATCH)
END IF
!
- CALL CONVERT_PATCH_TEB(TM%BDD, TM%DTB, DTCO, TM%DTT, TM%TOP, &
- TM%TOP%XCOVER, TM%TOP%LCOVER, ZDEF_ROAD_DIR, &
- PZ0_TOWN=TM%T%CUR%XZ0_TOWN, PALB_ROOF=TM%T%CUR%XALB_ROOF, &
- PEMIS_ROOF=TM%T%CUR%XEMIS_ROOF,PHC_ROOF=TM%T%CUR%XHC_ROOF,PTC_ROOF=TM%T%CUR%XTC_ROOF, &
- PD_ROOF=TM%T%CUR%XD_ROOF, PALB_ROAD=TM%T%CUR%XALB_ROAD, &
- PEMIS_ROAD=TM%T%CUR%XEMIS_ROAD,PHC_ROAD=TM%T%CUR%XHC_ROAD,PTC_ROAD=TM%T%CUR%XTC_ROAD, &
- PD_ROAD=TM%T%CUR%XD_ROAD, PALB_WALL=TM%T%CUR%XALB_WALL, &
- PEMIS_WALL=TM%T%CUR%XEMIS_WALL,PHC_WALL=TM%T%CUR%XHC_WALL,PTC_WALL=TM%T%CUR%XTC_WALL, &
- PD_WALL=TM%T%CUR%XD_WALL, PBLD_HEIGHT=TM%T%CUR%XBLD_HEIGHT, &
- PWALL_O_HOR=TM%T%CUR%XWALL_O_HOR,PBLD=TM%T%CUR%XBLD, PROAD_DIR=TM%T%CUR%XROAD_DIR, &
- PGARDEN=TM%T%CUR%XGARDEN, &
- PH_TRAFFIC=TM%T%CUR%XH_TRAFFIC, PLE_TRAFFIC=TM%T%CUR%XLE_TRAFFIC, &
- PH_INDUSTRY=TM%T%CUR%XH_INDUSTRY, PLE_INDUSTRY=TM%T%CUR%XLE_INDUSTRY, &
- PROUGH_ROOF = TM%T%CUR%XROUGH_ROOF, PROUGH_WALL = TM%T%CUR%XROUGH_WALL, &
- PRESIDENTIAL = TM%T%CUR%XRESIDENTIAL, &
- PGREENROOF = TM%T%CUR%XGREENROOF, &
- PEMIS_PANEL=TM%TPN%XEMIS_PANEL, PALB_PANEL=TM%TPN%XALB_PANEL, &
- PEFF_PANEL=TM%TPN%XEFF_PANEL, PFRAC_PANEL=TM%TPN%XFRAC_PANEL )
+ CALL CONVERT_PATCH_TEB(BDD, DTB, DTCO, DTT, TOP, ZDEF_ROAD_DIR, T=NT%AL(JP), TPN=TPN )
!
- IF (.NOT. TM%TOP%LGREENROOF .AND. MAXVAL(TM%T%CUR%XGREENROOF)>0. ) THEN !<== A paralleliser pour un stop propre
+ IF (.NOT. TOP%LGREENROOF .AND. MAXVAL(NT%AL(JP)%XGREENROOF)>0. ) THEN !<== A paralleliser pour un stop propre
WRITE(ILUOUT,*) 'You choose NOT to have greenroofs, BUT your greenroof fraction is not zero'
WRITE(ILUOUT,*) 'Please activate the greenroof option (and rerun the SURFEX suite from the PGD step)'
WRITE(ILUOUT,*) 'Or be sure NOT to have any greenroofs in your area'
CALL ABOR1_SFX('INIT_TEBN: GREENROOF OPTION NOT ACTIVATED WHILE GREENROOFS ARE PRESENT')
ENDIF
!
- IF (.NOT. TM%TOP%LSOLAR_PANEL .AND. MAXVAL(TM%TPN%XFRAC_PANEL)>0. ) THEN !<== A paralleliser pour un stop propre
+ IF (.NOT. TOP%LSOLAR_PANEL .AND. MAXVAL(TPN%XFRAC_PANEL)>0. ) THEN !<== A paralleliser pour un stop propre
WRITE(ILUOUT,*) 'You choose NOT to have solar panels, BUT your solar panel fraction is not zero'
WRITE(ILUOUT,*) 'Please activate the solar panel option (and rerun the SURFEX suite from the PGD step)'
WRITE(ILUOUT,*) 'Or be sure NOT to have any solar panel in your area'
@@ -452,47 +429,43 @@ DO JPATCH=1,TM%TOP%NTEB_PATCH
!* 5. Sky-view-factors:
! ----------------
!
- ALLOCATE(TM%T%CUR%XSVF_ROAD (ILU))
- ALLOCATE(TM%T%CUR%XSVF_GARDEN(ILU))
- ALLOCATE(TM%T%CUR%XSVF_WALL (ILU))
+ ALLOCATE(NT%AL(JP)%XSVF_ROAD (ILU))
+ ALLOCATE(NT%AL(JP)%XSVF_GARDEN(ILU))
+ ALLOCATE(NT%AL(JP)%XSVF_WALL (ILU))
!
- ALLOCATE(TM%B%CUR%XGR (ILU))
- ALLOCATE(TM%B%CUR%XALB_WIN (ILU))
- ALLOCATE(TM%B%CUR%XF_WASTE_CAN (ILU))
+ ALLOCATE(NB%AL(JP)%XGR (ILU))
+ ALLOCATE(NB%AL(JP)%XALB_WIN (ILU))
+ ALLOCATE(NB%AL(JP)%XF_WASTE_CAN (ILU))
!
!
- CALL TEB_MORPHO(HPROGRAM, TM%T%CUR%XBLD, TM%T%CUR%XWALL_O_HOR, TM%T%CUR%XGARDEN, TM%T%CUR%XBLD_HEIGHT, &
- TM%T%CUR%XROAD, TM%T%CUR%XROAD_O_GRND, TM%T%CUR%XGARDEN_O_GRND, TM%T%CUR%XWALL_O_GRND, &
- TM%T%CUR%XCAN_HW_RATIO, TM%T%CUR%XSVF_ROAD, TM%T%CUR%XSVF_GARDEN, TM%T%CUR%XSVF_WALL, &
- TM%T%CUR%XZ0_TOWN, TM%T%CUR%XWALL_O_BLD, TM%T%CUR%XH_TRAFFIC, TM%T%CUR%XLE_TRAFFIC )
+ CALL TEB_MORPHO(HPROGRAM, NT%AL(JP) )
!
!-------------------------------------------------------------------------------
!
!* 6. Building Energy Model
! ---------------------
!
- CALL INIT_BEM_n(DGU, DTCO, UG, U, TM, &
- ILUOUT)
+ CALL INIT_BEM_n(DTCO, TOP, BOP, DTT, DTB, BDD, TG, NT%AL(JP), NB%AL(JP), ILUOUT)
!
!-------------------------------------------------------------------------------
!
!* 7. Case of urban green areas
! -------------------------
!
- IF (TM%TOP%LGARDEN) THEN
+ IF (TOP%LGARDEN) THEN
!
CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ') ! change input file name to pgd name
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'TOWN ','TEB ','READ ')
- IF (JPATCH==1) CALL INIT_TEB_VEG_OPTIONS_n(&
- TM%CHT, TM%DGMTO, GDM%TGDO, GDM%TVG, &
- HPROGRAM)
- CALL INIT_TEB_GARDEN_PGD_n(DTCO, U, CHI, DTI, I, DST, SLT, TM%CHT, TM%TG, TM%T, TM%TOP, GDM, &
- HPROGRAM,HINIT,(JPATCH==1),KI,KSV,HSV,IVERSION,IBUGFIX,PCO2,PRHOA)
+ CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'TOWN ','TEB ','READ ')
+ IF (JP==1) CALL INIT_TEB_VEG_OPTIONS_n(CHT, TD%MTO%LSURF_DIAG_ALBEDO, TOP%LGREENROOF, GDM%O, GRM%O, HPROGRAM)
+ CALL INIT_TEB_GARDEN_PGD_n(DTCO, U, CHT%LCH_BIO_FLUX, TG, NT%AL(JP)%XGARDEN, TOP, &
+ GDM%O, GDM%S, GDM%K, GDM%P, GDM%NPE%AL(JP), GDM%DTV, GDM%GB, &
+ HPROGRAM,HINIT,(JP==1),KI,IVERSION,IBUGFIX,PCO2,PRHOA)
! Case of urban green roofs
- IF (TM%TOP%LGREENROOF) CALL INIT_TEB_GREENROOF_PGD_n(DTCO, U, CHI, DTI, I, DST, SLT, &
- TM%CHT, TM%TG, TM%T, TM%TOP, GDM%TVG, GRM, &
- HPROGRAM,HINIT,(JPATCH==1),KI,KSV,HSV,IVERSION,PCO2,PRHOA)
+ IF (TOP%LGREENROOF) THEN
+ CALL INIT_TEB_GREENROOF_PGD_n(DTCO, U, CHT%LCH_BIO_FLUX, TG, NT%AL(JP)%XGREENROOF, TOP, &
+ GRM%O, GRM%S, GRM%K, GRM%P, GRM%NPE%AL(JP), GRM%DTV, GRM%GB, &
+ HPROGRAM,HINIT,(JP==1),KI,IVERSION,PCO2,PRHOA)
+ ENDIF
CALL END_IO_SURF_n(HPROGRAM)
!
ENDIF
@@ -503,11 +476,8 @@ END DO ! end of loop on TEB patches
!* Read irrigation parameters for TEB
!
CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ') ! change input file name to pgd name
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'TOWN ','TEB ','READ ')
- CALL READ_PGD_TEB_IRRIG_n(&
- TM%TG, GDM%TIR, &
- HPROGRAM)
+ CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'TOWN ','TEB ','READ ')
+ CALL READ_PGD_TEB_IRRIG_n(TG, TIR, HPROGRAM)
CALL END_IO_SURF_n(HPROGRAM)
!
!-------------------------------------------------------------------------------
@@ -524,48 +494,41 @@ END IF
! Initialisation for IO
!
CALL SET_SURFEX_FILEIN(HPROGRAM,'PREP') ! restore input file name
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'TOWN ','TEB ','READ ')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'TOWN ','TEB ','READ ')
!
!* 9. Prognostic fields:
! -----------------
-!
-! -------------------------
-!
-
!
!* LOOP ON TEB PATCHES
! -------------------
!
-DO JPATCH=1,TM%TOP%NTEB_PATCH
- CALL GOTO_WRAPPER_TEB_PATCH(TM%B, TM%DGCT, TM%DGMT, TM%T, &
- GDM%TGD, GDM%TGDPE, GRM%TGR, GRM%TGRPE, JPATCH)
+DO JP=1,TOP%NTEB_PATCH
!
!* TEB fields
- CALL READ_TEB_n(TM%B, TM%BOP, DTCO, DGU, U, TM%T, TM%TOP, TM%TPN, &
- HPROGRAM,JPATCH)
-!
- ALLOCATE(TM%T%CUR%XAC_ROOF (ILU))
- ALLOCATE(TM%T%CUR%XAC_ROAD (ILU))
- ALLOCATE(TM%T%CUR%XAC_WALL (ILU))
- ALLOCATE(TM%T%CUR%XAC_TOP (ILU))
- ALLOCATE(TM%T%CUR%XAC_ROOF_WAT(ILU))
- ALLOCATE(TM%T%CUR%XAC_ROAD_WAT(ILU))
- ALLOCATE(TM%T%CUR%XQSAT_ROOF (ILU))
- ALLOCATE(TM%T%CUR%XQSAT_ROAD (ILU))
- ALLOCATE(TM%T%CUR%XDELT_ROOF (ILU))
- ALLOCATE(TM%T%CUR%XDELT_ROAD (ILU))
+ CALL READ_TEB_n(NB%AL(JP), BOP, DTCO, U, NT%AL(JP), TOP, TPN, HPROGRAM,JP)
+!
+ ALLOCATE(NT%AL(JP)%XAC_ROOF (ILU))
+ ALLOCATE(NT%AL(JP)%XAC_ROAD (ILU))
+ ALLOCATE(NT%AL(JP)%XAC_WALL (ILU))
+ ALLOCATE(NT%AL(JP)%XAC_TOP (ILU))
+ ALLOCATE(NT%AL(JP)%XAC_ROOF_WAT(ILU))
+ ALLOCATE(NT%AL(JP)%XAC_ROAD_WAT(ILU))
+ ALLOCATE(NT%AL(JP)%XQSAT_ROOF (ILU))
+ ALLOCATE(NT%AL(JP)%XQSAT_ROAD (ILU))
+ ALLOCATE(NT%AL(JP)%XDELT_ROOF (ILU))
+ ALLOCATE(NT%AL(JP)%XDELT_ROAD (ILU))
!
!* Case of urban green areas
- IF (TM%TOP%LGARDEN) THEN
-! CALL SET_SURFEX_FILEIN(HPROGRAM,'PREP') ! change input file name to pgd name
-! CALL INIT_IO_SURF_n(HPROGRAM,'TOWN ','TEB ','READ ')
- CALL INIT_TEB_GARDEN_n(DTCO, DGU, UG, U, TM%DGMTO, TM%TOP, GDM, &
- HPROGRAM,HINIT,KI,KSW,PSW_BANDS,JPATCH)
- ! Case of urban green roofs
- IF (TM%TOP%LGREENROOF) CALL INIT_TEB_GREENROOF_n(DTCO, U, TM%DGMTO, TM%TOP, GDM%TVG, GRM, &
- HPROGRAM,HINIT,KI,KSV,PSW_BANDS,JPATCH)
-! CALL END_IO_SURF_n(HPROGRAM)
+ IF (TOP%LGARDEN) THEN
+ !
+ CALL INIT_TEB_GARDEN_n(DTCO, UG, U, TD%MTO, TOP, GDM%O, GDM%DTV, GDM%K, GDM%P, &
+ GDM%NPE%AL(JP), GDM%VD%ND%AL(JP), GDM%VD%NDE%AL(JP), GDM%VD%NDEC%AL(JP), GDM%VD%NDM%AL(JP), &
+ HPROGRAM, HINIT, KI, KSW, PSW_BANDS, JP)
+ ! Case of urban green roofs
+ IF (TOP%LGREENROOF) CALL INIT_TEB_GREENROOF_n(DTCO, U, TD%MTO, TOP, GRM%O, GRM%DTV, GRM%K, GRM%P, &
+ GRM%NPE%AL(JP), GRM%VD%ND%AL(JP), GRM%VD%NDE%AL(JP), GRM%VD%NDEC%AL(JP), GRM%VD%NDM%AL(JP), &
+ HPROGRAM, HINIT, KI, KSV, PSW_BANDS, JP)
+ !
ENDIF
!-------------------------------------------------------------------------------
!
@@ -574,14 +537,14 @@ DO JPATCH=1,TM%TOP%NTEB_PATCH
!
!* snow long-wave properties (not initialized in read_gr_snow)
!
- CALL INIT_SNOW_LW(XEMISSN,TM%T%CUR%TSNOW_ROOF)
- CALL INIT_SNOW_LW(XEMISSN,TM%T%CUR%TSNOW_ROAD)
+ CALL INIT_SNOW_LW(XEMISSN,NT%AL(JP)%TSNOW_ROOF)
+ CALL INIT_SNOW_LW(XEMISSN,NT%AL(JP)%TSNOW_ROAD)
!
- IF (TM%TOP%LGARDEN) THEN
+ IF (TOP%LGARDEN) THEN
ZDIR_SW=0. ! night as first guess for albedo computation
ZSCA_SW=0. !
- CALL GARDEN_PROPERTIES(TM%T, GDM, &
- ZDIR_SW, ZSCA_SW, PSW_BANDS, KSW, &
+ CALL TEB_VEG_PROPERTIES(NT%AL(JP)%XGARDEN, GDM%O, GDM%NPE%AL(JP), &
+ ZDIR_SW, ZSCA_SW, PSW_BANDS, KSW, &
ZTS_GARDEN, ZEMIS_GARDEN, ZALB_GARDEN )
ELSE
ZALB_GARDEN = XUNDEF
@@ -589,10 +552,10 @@ DO JPATCH=1,TM%TOP%NTEB_PATCH
ZTS_GARDEN = XUNDEF
END IF
!
- IF (TM%TOP%LGREENROOF) THEN
+ IF (TOP%LGREENROOF) THEN
ZDIR_SW=0. ! night as first guess for albedo computation
ZSCA_SW=0. !
- CALL GREENROOF_PROPERTIES(TM%T, GDM%TVG, GRM, &
+ CALL TEB_VEG_PROPERTIES(NT%AL(JP)%XGREENROOF, GRM%O, GRM%NPE%AL(JP), &
ZDIR_SW, ZSCA_SW, PSW_BANDS, KSW, &
ZTS_GREENROOF, ZEMIS_GREENROOF, ZALB_GREENROOF )
ELSE
@@ -603,20 +566,8 @@ DO JPATCH=1,TM%TOP%NTEB_PATCH
!
!* averaged albedo, emissivity and radiative temperature
!
- CALL AVERAGED_TSRAD_TEB(TM%T%CUR%XEMIS_ROOF,TM%T%CUR%XT_ROOF(:,1), &
- TM%T%CUR%XEMIS_ROAD,TM%T%CUR%XT_ROAD(:,1), &
- TM%T%CUR%XEMIS_WALL, &
- TM%T%CUR%XT_WALL_A(:,1), &
- TM%T%CUR%XT_WALL_B(:,1), &
- ZEMIS_GARDEN, ZTS_GARDEN, &
- ZEMIS_GREENROOF, ZTS_GREENROOF,&
- TM%T%CUR%TSNOW_ROOF,TM%T%CUR%TSNOW_ROAD, &
- TM%T%CUR%XROAD, TM%T%CUR%XGREENROOF, TM%T%CUR%XGARDEN, &
- TM%T%CUR%XBLD,TM%T%CUR%XWALL_O_HOR, &
- TM%T%CUR%XSVF_ROAD,TM%T%CUR%XSVF_WALL, &
- TM%T%CUR%XSVF_GARDEN, &
- PEMIS,PTSRAD, TM%B%CUR%XT_WIN1, &
- TM%B%CUR%XGR )
+ CALL AVERAGED_TSRAD_TEB(NT%AL(JP), NB%AL(JP), ZEMIS_GARDEN, ZTS_GARDEN, &
+ ZEMIS_GREENROOF, ZTS_GREENROOF, PEMIS, PTSRAD )
!
!
!* 9. Visible and near-infra-red Radiative fields:
@@ -625,18 +576,8 @@ DO JPATCH=1,TM%TOP%NTEB_PATCH
ALLOCATE(ZDIR_ALB(ILU))
ALLOCATE(ZSCA_ALB(ILU))
!
- CALL AVERAGED_ALBEDO_TEB(TM%TOP%CBEM,TM%TOP%CROAD_DIR,TM%TOP%CWALL_OPT,PZENITH,PAZIM, &
- TM%T%CUR%XBLD, TM%T%CUR%XGARDEN, TM%T%CUR%XROAD_DIR, TM%T%CUR%XROAD, &
- TM%T%CUR%XGREENROOF, TM%TPN%XFRAC_PANEL, TM%TPN%XALB_PANEL, &
- TM%T%CUR%XWALL_O_HOR, TM%T%CUR%XCAN_HW_RATIO, &
- TM%T%CUR%XALB_ROOF, TM%T%CUR%XALB_ROAD, TM%T%CUR%XSVF_ROAD, &
- TM%T%CUR%XALB_WALL, TM%T%CUR%XSVF_WALL, &
- ZALB_GARDEN, TM%T%CUR%XSVF_GARDEN, ZALB_GREENROOF, &
- TM%T%CUR%TSNOW_ROOF, TM%T%CUR%TSNOW_ROAD, &
- TM%B%CUR%XGR, TM%B%CUR%XSHGC, TM%B%CUR%XSHGC_SH, &
- TM%B%CUR%XABS_WIN, TM%B%CUR%XALB_WIN, &
- TM%B%CUR%LSHAD_DAY, &
- ZDIR_ALB, ZSCA_ALB, TM%B%CUR%XTRAN_WIN )
+ CALL AVERAGED_ALBEDO_TEB(TOP,NT%AL(JP),TPN,NB%AL(JP),PZENITH,PAZIM, &
+ ZALB_GARDEN, ZALB_GREENROOF,ZDIR_ALB, ZSCA_ALB)
ISWB=SIZE(PSW_BANDS)
DO JSWB=1,ISWB
@@ -651,16 +592,16 @@ DO JPATCH=1,TM%TOP%NTEB_PATCH
!* 10. Chemistry /dust
! ---------------
!
- CALL INIT_CHEMICAL_n(ILUOUT, KSV, HSV, TM%CHT%SVT, &
- TM%CHT%CCH_NAMES, TM%CHT%CAER_NAMES, &
- HDSTNAMES=TM%CHT%CDSTNAMES, HSLTNAMES=TM%CHT%CSLTNAMES )
+ CALL INIT_CHEMICAL_n(ILUOUT, KSV, HSV, CHT%SVT, &
+ CHT%CCH_NAMES, CHT%CAER_NAMES, &
+ HDSTNAMES=CHT%CDSTNAMES, HSLTNAMES=CHT%CSLTNAMES )
!
!* Initialization of dry deposition scheme (chemistry)
!
- IF (TM%CHT%SVT%NBEQ>0 .AND. TM%CHT%CCH_DRY_DEP=='WES89') THEN
- ALLOCATE(TM%CHT%XDEP(ILU,TM%CHT%SVT%NBEQ))
+ IF (CHT%SVT%NBEQ>0 .AND. CHT%CCH_DRY_DEP=='WES89') THEN
+ ALLOCATE(CHT%XDEP(ILU,CHT%SVT%NBEQ))
ELSE
- ALLOCATE(TM%CHT%XDEP(0,0))
+ ALLOCATE(CHT%XDEP(0,0))
END IF
!
!-------------------------------------------------------------------------------
@@ -676,26 +617,24 @@ END IF
!* 7. Canopy air fields:
! ------------------
!
- CALL READ_TEB_CANOPY_n(DTCO, U, TM%TCP, TM%TOP, &
- HPROGRAM)
+ CALL READ_SBL_n(DTCO, U, SB, TOP%LCANOPY, HPROGRAM, "TOWN ")
!
!-------------------------------------------------------------------------------
!
!* 11. Diagnostics:
! -----------
!
- CALL DIAG_TEB_INIT_n(TM%DGT, TM%DGUT, &
- HPROGRAM,ILU,ISWB)
-DO JPATCH=1,TM%TOP%NTEB_PATCH
- CALL GOTO_WRAPPER_TEB_PATCH(TM%B, TM%DGCT, TM%DGMT, TM%T, &
- GDM%TGD, GDM%TGDPE, GRM%TGR, GRM%TGRPE, JPATCH)
- CALL DIAG_MISC_TEB_INIT_n(TM%DGCT, TM%DGMT, TM%DGMTO, TM%TOP, &
- HPROGRAM,ILU,ISWB)
+ CALL DIAG_TEB_INIT_n(TD%O, TD%D, TD%DUT, HPROGRAM,ILU,ISWB)
+!
+DO JP=1,TOP%NTEB_PATCH
+ CALL DIAG_MISC_TEB_INIT_n(TD%NDMTC%AL(JP), TD%NDMT%AL(JP), TD%MTO, TOP, ILU, ISWB)
END DO ! end of loop on patches
+!
+!-------------------------------------------------------------------------------
+!
#ifdef MNH_PARALLEL
- CALL MPPDB_CHECK_SURFEX3D(TM%TOP%XCOVER,"INIT_TEB_n end:XCOVER",PRECISION,ILUOUT, 'TOWN ',SIZE(TM%TOP%XCOVER,2))
+ CALL MPPDB_CHECK_SURFEX3D(TOP%XCOVER,"INIT_TEB_n end:XCOVER",PRECISION,ILUOUT, 'TOWN ',SIZE(TOP%XCOVER,2))
#endif
-!
!-------------------------------------------------------------------------------
!
! End of IO
diff --git a/src/SURFEX/init_top.F90 b/src/SURFEX/init_top.F90
index 7de18f0f5508b6cbcd4bddaeaf5614ef111c7d9b..8230b1acf64404d40f803541addce3467f5fa011 100644
--- a/src/SURFEX/init_top.F90
+++ b/src/SURFEX/init_top.F90
@@ -3,12 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ######spl
- SUBROUTINE INIT_TOP (I, &
- HISBA, KLUOUT, PPATCH, PRUNOFFD, &
- PWD0, PWSAT, PTI_MIN, &
- PTI_MAX, PTI_MEAN, PTI_STD, PTI_SKEW, &
- PSOILWGHT, PTAB_FSAT, PTAB_WTOP, &
- PTAB_QTOP, PM )
+ SUBROUTINE INIT_TOP (IO, S, K, NK, NP, KLUOUT, PM )
!
! #####################################################################
!
@@ -40,7 +35,8 @@
!-------------------------------------------------------------------------------
!
!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY: ISBA_S_t, ISBA_NP_t, ISBA_NK_t, ISBA_P_t, ISBA_K_t
!
USE MODD_SURF_PAR,ONLY : XUNDEF
!
@@ -62,46 +58,22 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(ISBA_t), INTENT(INOUT) :: I
-!
- CHARACTER(LEN=*), INTENT(IN) :: HISBA ! type of ISBA version:
-! ! '2-L' (default)
-! ! '3-L'
-! ! 'DIF'
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_NK_t), INTENT(INOUT) :: NK
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
!
INTEGER, INTENT(IN) :: KLUOUT
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PPATCH
-!
-REAL, DIMENSION(:,:,:),INTENT(IN) :: PSOILWGHT ! ISBA-DIF: weights for vertical
-! ! integration of soil water and properties
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PRUNOFFD ! depth over which sub-grid runoff is computed
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PWD0, PWSAT
-! PWD0 = water content equivalent to
-! D0 maximum deficit (m3 m-3)
-! PWSAT = saturation volumetric water content
-! of the soil (m3 m-3)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTI_MIN, PTI_MAX, PTI_STD, &
- PTI_SKEW, PTI_MEAN
-! PTI_MEAN = ti mean
-! PTI_MIN = ti min
-! PTI_MAX = ti max
-! PTI_STD = ti standard deviation
-! PTI_SKEW = ti skewness
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTAB_FSAT, PTAB_WTOP, PTAB_QTOP
-! PTAB_FSAT = Satured fraction array
-! PTAB_WTOP = Active TOPMODEL-layer array
-! PTAB_QTOP = Subsurface flow TOPMODEL array
-!
REAL, DIMENSION(:), INTENT(INOUT) :: PM
! PM = exponential decay factor of the local deficit
!
!* 0.2 declarations of local variables
!
+TYPE(ISBA_K_t), POINTER :: KK
+TYPE(ISBA_P_t), POINTER :: PK
+!
REAL, DIMENSION(SIZE(PM)) :: ZD_TOP, ZWSAT_AVG, ZWD0_AVG
! ZD_TOP = Topmodel active layer
!
@@ -149,7 +121,7 @@ REAL :: ZFUP, ZFDOWN, ZQUP, ZQDOWN, ZSLOPEQ, ZWUP, ZWDOWN, ZSLO
INTEGER, DIMENSION (1):: ID
!
INTEGER :: INI, JI, IND, JSI_MIN, JSI_MAX, IPAS, &
- JL, INL, JPATCH
+ JL, INL, JP, IMASK
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
@@ -163,9 +135,10 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! Grid cells number
!
IF (LHOOK) CALL DR_HOOK('INIT_TOP',0,ZHOOK_HANDLE)
+!
INI = SIZE(PM(:))
-INL = SIZE(PWSAT,2)
-IPAS = SIZE(PTAB_FSAT,2)
+INL = IO%NGROUND_LAYER
+IPAS = SIZE(S%XTAB_FSAT,2)
!
! GAM result (not use here !)
!
@@ -177,36 +150,55 @@ ZWD0_AVG(:) = 0.0
!
! soil properties for runoff (m)
!
-IF (HISBA == 'DIF') THEN
+IF (IO%CISBA == 'DIF') THEN
!
- DO JPATCH=1,I%NPATCH
- IF (I%NSIZE_NATURE_P(JPATCH) == 0 ) CYCLE
+ DO JP=1,IO%NPATCH
+
+ PK => NP%AL(JP)
+ KK => NK%AL(JP)
+
+ IF (PK%NSIZE_P == 0 ) CYCLE
+
DO JL=1,INL
- DO JI=1,INI
- ZD_TOP (JI) = ZD_TOP (JI) + PPATCH(JI,JPATCH)*PSOILWGHT(JI,JL,JPATCH)
- ZWSAT_AVG(JI) = ZWSAT_AVG(JI) + PPATCH(JI,JPATCH)*PSOILWGHT(JI,JL,JPATCH)*PWSAT(JI,JL)
- ZWD0_AVG (JI) = ZWD0_AVG (JI) + PPATCH(JI,JPATCH)*PSOILWGHT(JI,JL,JPATCH)*PWD0 (JI,JL)
- ENDDO
+ DO JI=1,PK%NSIZE_P
+ !
+ IMASK = PK%NR_P(JI)
+ !
+ ZD_TOP (IMASK) = ZD_TOP (IMASK) + PK%XPATCH(JI) * PK%XSOILWGHT(JI,JL)
+ ZWSAT_AVG(IMASK) = ZWSAT_AVG(IMASK) + PK%XPATCH(JI) * PK%XSOILWGHT(JI,JL) * K%XWSAT(IMASK,JL)
+ ZWD0_AVG (IMASK) = ZWD0_AVG (IMASK) + PK%XPATCH(JI) * PK%XSOILWGHT(JI,JL) * K%XWD0 (IMASK,JL)
+ !
+ ENDDO
ENDDO
ENDDO
!
WHERE(ZD_TOP(:)>0.0)
- ZWSAT_AVG(:)=ZWSAT_AVG(:)/ZD_TOP(:)
- ZWD0_AVG (:)=ZWD0_AVG (:)/ZD_TOP(:)
+ ZWSAT_AVG(:)=ZWSAT_AVG(:)/ZD_TOP(:)
+ ZWD0_AVG (:)=ZWD0_AVG (:)/ZD_TOP(:)
ENDWHERE
!
ELSE
!
- DO JPATCH=1,I%NPATCH
- IF (I%NSIZE_NATURE_P(JPATCH) == 0 ) CYCLE
- DO JI=1,INI
- ZD_TOP(JI)=ZD_TOP(JI)+PRUNOFFD(JI,JPATCH)*PPATCH(JI,JPATCH)
+ DO JP=1,IO%NPATCH
+ !
+ PK => NP%AL(JP)
+ KK => NK%AL(JP)
+ !
+ IF (PK%NSIZE_P == 0 ) CYCLE
+ !
+ DO JI=1,PK%NSIZE_P
+ !
+ IMASK = PK%NR_P(JI)
+ !
+ ZD_TOP(IMASK)=ZD_TOP(IMASK) + PK%XRUNOFFD(JI) * PK%XPATCH(JI)
+ !
ENDDO
+ !
ENDDO
-!
- ZWSAT_AVG(:) = PWSAT(:,1)
- ZWD0_AVG (:) = PWD0 (:,1)
-!
+ !
+ ZWSAT_AVG(:) = K%XWSAT(:,1)
+ ZWD0_AVG (:) = K%XWD0 (:,1)
+ !
ENDIF
!
!
@@ -221,14 +213,14 @@ ZNO = 0.0
!
DO JI=1,INI
!
- IF(PTI_MEAN(JI)==XUNDEF)THEN
+ IF(S%XTI_MEAN(JI)==XUNDEF)THEN
!
! *Case where the Topographics index are not defined.
! --------------------------------------------------------
ZNO=ZNO+1.0
- PTAB_FSAT(JI,:)=0.0
- PTAB_WTOP(JI,:)=XUNDEF
- PTAB_QTOP(JI,:)=0.0
+ S%XTAB_FSAT(JI,:)=0.0
+ S%XTAB_WTOP(JI,:)=XUNDEF
+ S%XTAB_QTOP(JI,:)=0.0
!
PM(JI) =XUNDEF
!
@@ -246,11 +238,11 @@ DO JI=1,INI
! New version : Regressions directly in the pgd
! 1000 meter DEM to 2m DEM (PAN AND KING 2012)
!
- ZTI_MEAN=PTI_MEAN(JI)
- ZTI_MIN =PTI_MIN (JI)
- ZTI_MAX =PTI_MAX (JI)
- ZTI_STD =PTI_STD (JI)
- ZTI_SKEW=PTI_SKEW(JI)
+ ZTI_MEAN=S%XTI_MEAN(JI)
+ ZTI_MIN =S%XTI_MIN (JI)
+ ZTI_MAX =S%XTI_MAX (JI)
+ ZTI_STD =S%XTI_STD (JI)
+ ZTI_SKEW=S%XTI_SKEW(JI)
!
! Calculate topographic index pdf parameters
!
@@ -347,13 +339,13 @@ DO JI=1,INI
!
! initialization water content and fraction
!
- PTAB_WTOP(JI,1) = ZWSAT_AVG(JI)
- PTAB_FSAT(JI,1) = 1.0
- PTAB_QTOP(JI,1) = 0.0
+ S%XTAB_WTOP(JI,1) = ZWSAT_AVG(JI)
+ S%XTAB_FSAT(JI,1) = 1.0
+ S%XTAB_QTOP(JI,1) = 0.0
!
- PTAB_WTOP(JI,IPAS) = ZWD0_AVG(JI)
- PTAB_FSAT(JI,IPAS) = 0.0
- PTAB_QTOP(JI,IPAS) = 0.0
+ S%XTAB_WTOP(JI,IPAS) = ZWD0_AVG(JI)
+ S%XTAB_FSAT(JI,IPAS) = 0.0
+ S%XTAB_QTOP(JI,IPAS) = 0.0
!
! Define the new limits for the satured index loop
!
@@ -400,7 +392,7 @@ DO JI=1,INI
!
! call incomplete gamma function for xsat
!
- CALL DGAM(ZPHI,ZYSAT,10.,ZG,ZGYSAT,IFLG,IFLGST)
+ CALL DGAM(ZPHI,ZYSAT,10.,ZG,ZGYSAT,IFLG,IFLGST)
!
! if the incomplete gamma function don't works, print why
!
@@ -422,7 +414,7 @@ DO JI=1,INI
!
! compute satured fraction as FSAT = F(0 --> ymax) - F(0 --> ysat)
!
- PTAB_FSAT(JI,IND)=MAX(0.0,(ZGYMAX-ZGYSAT)/ZFTOT)
+ S%XTAB_FSAT(JI,IND)=MAX(0.0,(ZGYMAX-ZGYSAT)/ZFTOT)
!
! Compute driest fraction
!
@@ -430,7 +422,7 @@ DO JI=1,INI
!
! Calculate FMED
!
- ZFMED=(1.0-PTAB_FSAT(JI,IND)-ZF0)
+ ZFMED=(1.0-S%XTAB_FSAT(JI,IND)-ZF0)
!
IF (ZFMED/=0.0) THEN
!
@@ -455,11 +447,11 @@ DO JI=1,INI
!
! Solves Dbar = (Wsat-WT)*d_top with Dbar/M (=ZDMOY) = (Wsat-WT)*d_top/M
!
- PTAB_WTOP(JI,IND) = ZWSAT_AVG(JI)-(PM(JI)*ZDMOY/ZD_TOP(JI))
-!
+ S%XTAB_WTOP(JI,IND) = ZWSAT_AVG(JI)-(PM(JI)*ZDMOY/ZD_TOP(JI))
+
! Solves Qs = FMED * M * Ks * exp(-Xsat) / Ks (dimentionless)
!
- PTAB_QTOP(JI,IND) = ZFMED*PM(JI)*EXP(-ZXSAT_IND)
+ S%XTAB_QTOP(JI,IND) = ZFMED*PM(JI)*EXP(-ZXSAT_IND)
!
ENDDO
!
@@ -473,38 +465,37 @@ DO JI=1,INI
!
! Upper boundary
!
- IF(PTAB_WTOP(JI,2)==ZWSAT_AVG(JI))THEN
+ IF(S%XTAB_WTOP(JI,2)==ZWSAT_AVG(JI))THEN
!
- ZFUP=PTAB_FSAT(JI,1)
- ZWUP=PTAB_WTOP(JI,1)
- ZQUP=PTAB_QTOP(JI,1)
-!
-
- ID(:)=MAXLOC(PTAB_WTOP(JI,:),PTAB_WTOP(JI,:)<ZWSAT_AVG(JI))
+ ZFUP=S%XTAB_FSAT(JI,1)
+ ZWUP=S%XTAB_WTOP(JI,1)
+ ZQUP=S%XTAB_QTOP(JI,1)
+!
+ ID(:)=MAXLOC(S%XTAB_WTOP(JI,:),S%XTAB_WTOP(JI,:)<ZWSAT_AVG(JI))
!
- ZFDOWN=PTAB_FSAT(JI,ID(1))
- ZWDOWN=PTAB_WTOP(JI,ID(1))
- ZQDOWN=PTAB_QTOP(JI,ID(1))
+ ZFDOWN=S%XTAB_FSAT(JI,ID(1))
+ ZWDOWN=S%XTAB_WTOP(JI,ID(1))
+ ZQDOWN=S%XTAB_QTOP(JI,ID(1))
!
ZSLOPEW=(ZWUP-ZWDOWN)/(ZFUP-ZFDOWN)
ZSLOPEQ=(ZQUP-ZQDOWN)/(ZFUP-ZFDOWN)
!
DO IND=2,ID(1)-1
- PTAB_WTOP(JI,IND)=ZWDOWN+(PTAB_FSAT(JI,IND)-ZFDOWN)*ZSLOPEW
- PTAB_QTOP(JI,IND)=ZQDOWN+(PTAB_FSAT(JI,IND)-ZFDOWN)*ZSLOPEQ
+ S%XTAB_WTOP(JI,IND)=ZWDOWN+(S%XTAB_FSAT(JI,IND)-ZFDOWN)*ZSLOPEW
+ S%XTAB_QTOP(JI,IND)=ZQDOWN+(S%XTAB_FSAT(JI,IND)-ZFDOWN)*ZSLOPEQ
ENDDO
!
ENDIF
!
! Lower boundary
!
- WHERE(PTAB_FSAT(JI,:)<=0.0 )
- PTAB_WTOP(JI,:)=ZWD0_AVG(JI)
- PTAB_QTOP(JI,:)=0.0
+ WHERE(S%XTAB_FSAT(JI,:)<=0.0 )
+ S%XTAB_WTOP(JI,:)=ZWD0_AVG(JI)
+ S%XTAB_QTOP(JI,:)=0.0
ENDWHERE
- WHERE(PTAB_WTOP(JI,:)<=ZWD0_AVG(JI))
- PTAB_FSAT(JI,:)=0.0
- PTAB_QTOP(JI,:)=0.0
+ WHERE(S%XTAB_WTOP(JI,:)<=ZWD0_AVG(JI))
+ S%XTAB_FSAT(JI,:)=0.0
+ S%XTAB_QTOP(JI,:)=0.0
ENDWHERE
!
ENDDO
diff --git a/src/SURFEX/init_townn.F90 b/src/SURFEX/init_townn.F90
index e83540c62b429f3b9170e346fb3a3ec993118632..d8a5a7adf285e09d0c8e786b636b0977a02d7af0 100644
--- a/src/SURFEX/init_townn.F90
+++ b/src/SURFEX/init_townn.F90
@@ -3,16 +3,11 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #############################################################
- SUBROUTINE INIT_TOWN_n (DTCO, DGU, UG, U, CHI, DTI, I, &
- TM, GDM, GRM, DGL, DST, SLT,GCP, &
- HPROGRAM,HINIT, &
- KI,KSV,KSW, &
- HSV,PCO2,PRHOA, &
- PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD,PTSURF, &
- KYEAR, KMONTH,KDAY, PTIME, &
- HATMFILE,HATMFILETYPE, &
- HTEST )
+ SUBROUTINE INIT_TOWN_n (DTCO, OREAD_BUDGETC, UG, U, GCP, TM, GDM, GRM, DGO, DL, DLC, &
+ HPROGRAM,HINIT,KI,KSV,KSW, HSV,PCO2,PRHOA, &
+ PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
+ PEMIS,PTSRAD,PTSURF,KYEAR,KMONTH,KDAY,PTIME, &
+ HATMFILE,HATMFILETYPE,HTEST )
! #############################################################
!
!!**** *INIT_TOWN_n* - chooses initialization routine for towns
@@ -52,19 +47,13 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
USE MODD_SURFEX_n, ONLY : TEB_MODEL_t
USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t
USE MODD_SURFEX_n, ONLY : TEB_GREENROOF_MODEL_t
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
-USE MODD_DST_n, ONLY : DST_t
-USE MODD_SLT_n, ONLY : SLT_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t, DIAG_t
!
USE MODD_CSTS, ONLY : XTT
!
@@ -80,21 +69,18 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
+LOGICAL, INTENT(IN) :: OREAD_BUDGETC
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM
TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM
-TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
-TYPE(DST_t), INTENT(INOUT) :: DST
-TYPE(SLT_t), INTENT(INOUT) :: SLT
-TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: DL
+TYPE(DIAG_t), INTENT(INOUT) :: DLC
!
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
@@ -142,19 +128,16 @@ IF (U%CTOWN=='NONE ') THEN
PTSRAD =XTT
PTSURF =XTT
ELSE IF (U%CTOWN=='FLUX ') THEN
- CALL INIT_IDEAL_FLUX(DGL, DGU%LREAD_BUDGETC, &
- HPROGRAM,HINIT,KI,KSV,KSW,HSV,PCO2,PRHOA, &
- PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD,PTSURF,'OK' )
+ CALL INIT_IDEAL_FLUX(DGO, DL, DLC, OREAD_BUDGETC, &
+ HPROGRAM,HINIT,KI,KSV,KSW,HSV,PDIR_ALB,PSCA_ALB, &
+ PEMIS,PTSRAD,PTSURF,'OK' )
ELSE IF (U%CTOWN=='TEB ') THEN
- CALL INIT_TEB_n(DTCO, DGU, UG, U, CHI, DTI, I, &
- TM, GDM, GRM, DST, SLT,GCP, &
- HPROGRAM,HINIT, &
- KI,KSV,KSW,HSV,PCO2,PRHOA, &
- PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, &
- PEMIS,PTSRAD,PTSURF, &
- KYEAR,KMONTH,KDAY,PTIME,HATMFILE,HATMFILETYPE,&
- 'OK' )
+ CALL INIT_TEB_n(DTCO, UG, U, GCP, TM%CHT, TM%DTT, TM%SB, TM%G, TM%TOP, &
+ TM%TPN, TM%TIR, TM%NT, TM%TD, TM%BDD, TM%BOP, TM%DTB, TM%NB, &
+ GDM, GRM, HPROGRAM, HINIT, KI, KSV, KSW, HSV, PCO2, &
+ PRHOA, PZENITH, PAZIM, PSW_BANDS, PDIR_ALB, &
+ PSCA_ALB, PEMIS, PTSRAD, PTSURF, KYEAR, KMONTH, &
+ KDAY, PTIME, HATMFILE, HATMFILETYPE, 'OK' )
END IF
IF (LHOOK) CALL DR_HOOK('INIT_TOWN_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/init_types_param.F90 b/src/SURFEX/init_types_param.F90
new file mode 100644
index 0000000000000000000000000000000000000000..d297f7ff76bbab25708cab65062529c702cad3cb
--- /dev/null
+++ b/src/SURFEX/init_types_param.F90
@@ -0,0 +1,207 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! ############################
+ SUBROUTINE INIT_TYPES_PARAM
+! ############################
+!
+!!**** *INIT_TYPES_PARAM* initializes cover-field correspondance arrays
+!!
+!! PURPOSE
+!! -------
+!!
+!! METHOD
+!! ------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! S.Faroux Meteo-France
+!!
+!! MODIFICATION
+!! ------------
+!!
+!! Original 23/03/11
+!!
+!! R. Alkama 05/2012 : read 19 vegtypes rather than 12
+! 10/2014 : add status='old' for ecoclimap.bin files E. Martin
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATION
+! -----------
+
+USE MODD_TYPE_DATE_SURF
+!
+USE MODD_DATA_COVER, ONLY : XDATA_TOWN, XDATA_NATURE, XDATA_SEA, XDATA_WATER, &
+ XDATA_VEGTYPE, XDATA_GARDEN, XDATA_Z0_TOWN, &
+ XDATA_BLD, XDATA_BLD_HEIGHT, XDATA_WALL_O_HOR, &
+ XDATA_H_TRAFFIC, XDATA_H_INDUSTRY
+!
+USE MODD_DATA_COVER_PAR, ONLY : NTYPE, NUT_CPHR, NUT_CPMR, NUT_CPLR, NUT_OPHR, &
+ NUT_OPMR, NUT_OPLR, NUT_LWLR, NUT_LALR, NUT_SPAR, &
+ NUT_INDU, NVT_NO, NVT_TEBD, NVT_BOBD, NVT_GRAS
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+INTEGER :: JTYPE
+!
+!* 0.3 Declaration of namelists
+! ------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('INIT_TYPES_PARAM',0,ZHOOK_HANDLE)
+!
+! SEA
+!
+XDATA_SEA(1:NTYPE(1)) = 1.
+!
+! WATER
+!
+XDATA_WATER(NTYPE(1)+1:SUM(NTYPE(1:2))) = 1.
+!
+! NATURE
+!
+DO JTYPE = 1,NTYPE(3)
+ XDATA_NATURE (SUM(NTYPE(1:2))+JTYPE) = 1.
+ XDATA_VEGTYPE(SUM(NTYPE(1:2))+JTYPE,JTYPE) = 1.
+ENDDO
+!
+! TOWN
+!
+XDATA_TOWN(SUM(NTYPE(1:3))+1:SUM(NTYPE(1:4))) = 1.
+!
+XDATA_GARDEN(NUT_CPHR) = 0.10
+XDATA_GARDEN(NUT_CPMR) = 0.10
+XDATA_GARDEN(NUT_CPLR) = 0.10
+XDATA_GARDEN(NUT_OPHR) = 0.30
+XDATA_GARDEN(NUT_OPMR) = 0.30
+XDATA_GARDEN(NUT_OPLR) = 0.40
+XDATA_GARDEN(NUT_LWLR) = 0.10
+XDATA_GARDEN(NUT_LALR) = 0.10
+XDATA_GARDEN(NUT_SPAR) = 0.70
+XDATA_GARDEN(NUT_INDU) = 0.40
+!
+XDATA_Z0_TOWN(NUT_CPHR) = 3.
+XDATA_Z0_TOWN(NUT_CPMR) = 1.
+XDATA_Z0_TOWN(NUT_CPLR) = 0.5
+XDATA_Z0_TOWN(NUT_OPHR) = 2.0
+XDATA_Z0_TOWN(NUT_OPMR) = 0.5
+XDATA_Z0_TOWN(NUT_OPLR) = 0.5
+XDATA_Z0_TOWN(NUT_LWLR) = 0.25
+XDATA_Z0_TOWN(NUT_LALR) = 0.25
+XDATA_Z0_TOWN(NUT_SPAR) = 0.5
+XDATA_Z0_TOWN(NUT_INDU) = 0.5
+!
+XDATA_BLD(NUT_CPHR) = 0.5
+XDATA_BLD(NUT_CPMR) = 0.55
+XDATA_BLD(NUT_CPLR) = 0.55
+XDATA_BLD(NUT_OPHR) = 0.30
+XDATA_BLD(NUT_OPMR) = 0.30
+XDATA_BLD(NUT_OPLR) = 0.30
+XDATA_BLD(NUT_LWLR) = 0.75
+XDATA_BLD(NUT_LALR) = 0.40
+XDATA_BLD(NUT_SPAR) = 0.10
+XDATA_BLD(NUT_INDU) = 0.25
+!
+XDATA_BLD_HEIGHT(NUT_CPHR) = 75
+XDATA_BLD_HEIGHT(NUT_CPMR) = 20
+XDATA_BLD_HEIGHT(NUT_CPLR) = 5
+XDATA_BLD_HEIGHT(NUT_OPHR) = 75
+XDATA_BLD_HEIGHT(NUT_OPMR) = 20
+XDATA_BLD_HEIGHT(NUT_OPLR) = 5
+XDATA_BLD_HEIGHT(NUT_LWLR) = 3
+XDATA_BLD_HEIGHT(NUT_LALR) = 5
+XDATA_BLD_HEIGHT(NUT_SPAR) = 5
+XDATA_BLD_HEIGHT(NUT_INDU) = 10
+!
+XDATA_WALL_O_HOR(NUT_CPHR) = 4.0
+XDATA_WALL_O_HOR(NUT_CPMR) = 1.3
+XDATA_WALL_O_HOR(NUT_CPLR) = 0.9
+XDATA_WALL_O_HOR(NUT_OPHR) = 1.4
+XDATA_WALL_O_HOR(NUT_OPMR) = 0.7
+XDATA_WALL_O_HOR(NUT_OPLR) = 0.7
+XDATA_WALL_O_HOR(NUT_LWLR) = 0.75
+XDATA_WALL_O_HOR(NUT_LALR) = 0.24
+XDATA_WALL_O_HOR(NUT_SPAR) = 0.36
+XDATA_WALL_O_HOR(NUT_INDU) = 0.45
+!
+XDATA_H_TRAFFIC(NUT_CPHR) = 20
+XDATA_H_TRAFFIC(NUT_CPMR) = 10
+XDATA_H_TRAFFIC(NUT_CPLR) = 5
+XDATA_H_TRAFFIC(NUT_OPHR) = 20
+XDATA_H_TRAFFIC(NUT_OPMR) = 10
+XDATA_H_TRAFFIC(NUT_OPLR) = 5
+XDATA_H_TRAFFIC(NUT_LWLR) = 5
+XDATA_H_TRAFFIC(NUT_LALR) = 5
+XDATA_H_TRAFFIC(NUT_SPAR) = 5
+XDATA_H_TRAFFIC(NUT_INDU) = 5
+!
+XDATA_H_INDUSTRY(NUT_CPHR) = 0.
+XDATA_H_INDUSTRY(NUT_CPMR) = 0.
+XDATA_H_INDUSTRY(NUT_CPLR) = 0.
+XDATA_H_INDUSTRY(NUT_OPHR) = 0.
+XDATA_H_INDUSTRY(NUT_OPMR) = 0.
+XDATA_H_INDUSTRY(NUT_OPLR) = 0.
+XDATA_H_INDUSTRY(NUT_LWLR) = 0.
+XDATA_H_INDUSTRY(NUT_LALR) = 50.
+XDATA_H_INDUSTRY(NUT_SPAR) = 0.
+XDATA_H_INDUSTRY(NUT_INDU) = 100.
+!
+XDATA_VEGTYPE(NUT_CPHR,NVT_GRAS) = 0.0
+XDATA_VEGTYPE(NUT_CPMR,NVT_GRAS) = 0.0
+XDATA_VEGTYPE(NUT_CPLR,NVT_GRAS) = 0.0
+XDATA_VEGTYPE(NUT_OPHR,NVT_GRAS) = 0.4
+XDATA_VEGTYPE(NUT_OPMR,NVT_GRAS) = 0.4
+XDATA_VEGTYPE(NUT_OPLR,NVT_GRAS) = 0.4
+XDATA_VEGTYPE(NUT_LWLR,NVT_GRAS) = 0.5
+XDATA_VEGTYPE(NUT_LALR,NVT_GRAS) = 0.5
+XDATA_VEGTYPE(NUT_SPAR,NVT_GRAS) = 0.5
+XDATA_VEGTYPE(NUT_INDU,NVT_GRAS) = 0.4
+!
+XDATA_VEGTYPE(NUT_CPHR,NVT_NO) = 0.0
+XDATA_VEGTYPE(NUT_CPMR,NVT_NO) = 0.0
+XDATA_VEGTYPE(NUT_CPLR,NVT_NO) = 0.0
+XDATA_VEGTYPE(NUT_OPHR,NVT_NO) = 0.2
+XDATA_VEGTYPE(NUT_OPMR,NVT_NO) = 0.2
+XDATA_VEGTYPE(NUT_OPLR,NVT_NO) = 0.2
+XDATA_VEGTYPE(NUT_LWLR,NVT_NO) = 0.5
+XDATA_VEGTYPE(NUT_LALR,NVT_NO) = 0.5
+XDATA_VEGTYPE(NUT_SPAR,NVT_NO) = 0.2
+XDATA_VEGTYPE(NUT_INDU,NVT_NO) = 0.6
+!
+XDATA_VEGTYPE(NUT_CPHR,NVT_TEBD) = 1.0
+XDATA_VEGTYPE(NUT_CPMR,NVT_TEBD) = 1.0
+XDATA_VEGTYPE(NUT_CPLR,NVT_TEBD) = 1.0
+XDATA_VEGTYPE(NUT_OPHR,NVT_TEBD) = 0.4
+XDATA_VEGTYPE(NUT_OPMR,NVT_TEBD) = 0.4
+XDATA_VEGTYPE(NUT_OPLR,NVT_TEBD) = 0.4
+XDATA_VEGTYPE(NUT_LWLR,NVT_TEBD) = 0.0
+XDATA_VEGTYPE(NUT_LALR,NVT_TEBD) = 0.0
+XDATA_VEGTYPE(NUT_SPAR,NVT_TEBD) = 0.3
+XDATA_VEGTYPE(NUT_INDU,NVT_TEBD) = 0.0
+
+!
+IF (LHOOK) CALL DR_HOOK('INIT_TYPES_PARAM',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE INIT_TYPES_PARAM
diff --git a/src/SURFEX/init_veg_gardenn.F90 b/src/SURFEX/init_veg_gardenn.F90
deleted file mode 100644
index a01e4dab7367892ce89d729ed6fcefa8a8160d13..0000000000000000000000000000000000000000
--- a/src/SURFEX/init_veg_gardenn.F90
+++ /dev/null
@@ -1,224 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-!#############################################################
-SUBROUTINE INIT_VEG_GARDEN_n(KI, OCANOPY, HROUGH, TPSNOW, &
- HPHOTO, PLAIMIN, PH_TREE, PVEGTYPE, PLAI, PZ0, PVEG, PEMIS, &
- OTR_ML, PFAPARC, PFAPIRC, PLAI_EFFC, PMUS, &
- PALBNIR_SOIL, PALBVIS_SOIL, PALBUV_SOIL, PALBNIR, PALBVIS, PALBUV, &
- OSURF_DIAG_ALBEDO, PPSN, PPSNG, PPSNV, PPSNV_A, &
- PDIR_ALB, PSCA_ALB, PEMIS_OUT, PTSRAD )
-!#############################################################
-!
-!!**** *INIT_VEG_GARDEN_n* - routine to initialize ISBA
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_TYPE_SNOW
-USE MODD_DATA_COVER_PAR, ONLY: NVEGTYPE
-!
-USE MODI_INIT_VEG_n
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
-INTEGER, INTENT(IN) :: KI
-LOGICAL, INTENT(IN) :: OCANOPY
- CHARACTER(LEN=4), INTENT(INOUT) :: HROUGH
-TYPE(SURF_SNOW), INTENT(INOUT) :: TPSNOW ! snow characteristics
-!
- CHARACTER(LEN=3), INTENT(IN) :: HPHOTO
-REAL, DIMENSION(:), INTENT(IN) :: PLAIMIN
-REAL, DIMENSION(:), INTENT(IN) :: PH_TREE
-REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE
-REAL, DIMENSION(:), INTENT(INOUT) :: PLAI
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0
-REAL, DIMENSION(:), INTENT(INOUT) :: PVEG
-REAL, DIMENSION(:), INTENT(INOUT) :: PEMIS
-!
-LOGICAL, INTENT(IN) :: OTR_ML
-REAL, DIMENSION(:), POINTER :: PFAPARC
-REAL, DIMENSION(:), POINTER :: PFAPIRC
-REAL, DIMENSION(:), POINTER :: PLAI_EFFC
-REAL, DIMENSION(:), POINTER :: PMUS
-!
-REAL, DIMENSION(:), POINTER :: PALBNIR_SOIL
-REAL, DIMENSION(:), POINTER :: PALBVIS_SOIL
-REAL, DIMENSION(:), POINTER :: PALBUV_SOIL
-REAL, DIMENSION(:), POINTER :: PALBNIR
-REAL, DIMENSION(:), POINTER :: PALBVIS
-REAL, DIMENSION(:), POINTER :: PALBUV
-!
-LOGICAL, INTENT(OUT) :: OSURF_DIAG_ALBEDO
-!
-REAL, DIMENSION(:), POINTER :: PPSN
-REAL, DIMENSION(:), POINTER :: PPSNG
-REAL, DIMENSION(:), POINTER :: PPSNV
-REAL, DIMENSION(:), POINTER :: PPSNV_A
-!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PDIR_ALB
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSCA_ALB
-REAL, DIMENSION(:), INTENT(OUT) :: PEMIS_OUT
-REAL, DIMENSION(:), INTENT(OUT) :: PTSRAD
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-REAL, DIMENSION(:,:), POINTER :: ZFAPARC
-REAL, DIMENSION(:,:), POINTER :: ZFAPIRC
-REAL, DIMENSION(:,:), POINTER :: ZLAI_EFFC
-REAL, DIMENSION(:,:), POINTER :: ZMUS
-!
-REAL, DIMENSION(:,:), POINTER :: ZALBNIR_SOIL
-REAL, DIMENSION(:,:), POINTER :: ZALBVIS_SOIL
-REAL, DIMENSION(:,:), POINTER :: ZALBUV_SOIL
-REAL, DIMENSION(:,:), POINTER :: ZALBNIR
-REAL, DIMENSION(:,:), POINTER :: ZALBVIS
-REAL, DIMENSION(:,:), POINTER :: ZALBUV
-!
-REAL, DIMENSION(:,:), POINTER :: ZPSN
-REAL, DIMENSION(:,:), POINTER :: ZPSNG
-REAL, DIMENSION(:,:), POINTER :: ZPSNV
-REAL, DIMENSION(:,:), POINTER :: ZPSNV_A
-!
-REAL, DIMENSION(KI,NVEGTYPE,1) :: ZVEGTYPE_PATCH
-!
-REAL, DIMENSION(SIZE(PLAIMIN),1) :: ZLAIMIN
-REAL, DIMENSION(SIZE(PH_TREE),1) :: ZH_TREE
-REAL, DIMENSION(SIZE(PLAI),1) :: ZLAI
-REAL, DIMENSION(SIZE(PZ0),1) :: ZZ0
-REAL, DIMENSION(SIZE(PVEG),1) :: ZVEG
-REAL, DIMENSION(SIZE(PEMIS),1) :: ZEMIS
-!
-LOGICAL :: LAGRI_TO_GRASS
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-! Initialisation for IO
-!
-IF (LHOOK) CALL DR_HOOK('INIT_VEG_GARDEN_n',0,ZHOOK_HANDLE)
-!
-NULLIFY(ZFAPARC)
-NULLIFY(ZFAPIRC)
-NULLIFY(ZLAI_EFFC)
-NULLIFY(ZMUS)
-!
-NULLIFY(ZALBNIR_SOIL)
-NULLIFY(ZALBVIS_SOIL)
-NULLIFY(ZALBUV_SOIL)
-NULLIFY(ZALBNIR)
-NULLIFY(ZALBVIS)
-NULLIFY(ZALBUV)
-!
-NULLIFY(ZPSN)
-NULLIFY(ZPSNG)
-NULLIFY(ZPSNV)
-NULLIFY(ZPSNV_A)
-!
-ZLAIMIN(:,1) = PLAIMIN(:)
-ZH_TREE(:,1) = PH_TREE(:)
-ZLAI(:,1) = PLAI(:)
-ZZ0(:,1) = PZ0(:)
-ZVEG(:,1) = PVEG(:)
-ZEMIS(:,1) = PEMIS(:)
-!
-LAGRI_TO_GRASS = .FALSE.
-!
-ZVEGTYPE_PATCH(:,:,1) = PVEGTYPE(:,:)
-!-------------------------------------------------------------------------------
-!
- CALL INIT_VEG_n(1, KI, OCANOPY, HROUGH, LAGRI_TO_GRASS, TPSNOW, &
- HPHOTO, .FALSE., .FALSE., .FALSE., &
- ZLAIMIN, ZH_TREE, ZVEGTYPE_PATCH, ZLAI, ZZ0, ZVEG, ZEMIS, &
- OTR_ML, ZFAPARC, ZFAPIRC, ZLAI_EFFC, ZMUS, &
- ZALBNIR_SOIL, ZALBVIS_SOIL, ZALBUV_SOIL, ZALBNIR, ZALBVIS, ZALBUV, &
- OSURF_DIAG_ALBEDO, ZPSN, ZPSNG, ZPSNV, ZPSNV_A, &
- PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD )
-!
-PLAI(:) = ZLAI(:,1)
-PZ0(:) = ZZ0(:,1)
-PVEG(:) = ZVEG(:,1)
-PEMIS(:) = ZEMIS(:,1)
-!
-ALLOCATE(PFAPARC(SIZE(ZFAPARC,1)))
-IF (SIZE(ZFAPARC)>0) &
-PFAPARC(:)=ZFAPARC(:,1)
-
-ALLOCATE(PFAPIRC(SIZE(ZFAPIRC,1)))
-IF (SIZE(ZFAPIRC)>0) &
-PFAPIRC(:)=ZFAPIRC(:,1)
-
-ALLOCATE(PLAI_EFFC(SIZE(ZLAI_EFFC,1)))
-IF (SIZE(ZLAI_EFFC)>0) &
-PLAI_EFFC(:)=ZLAI_EFFC(:,1)
-
-ALLOCATE(PMUS(SIZE(ZMUS,1)))
-IF (SIZE(ZMUS)>0) &
-PMUS(:)=ZMUS(:,1)
-!
-ALLOCATE(PALBNIR_SOIL(SIZE(ZALBNIR_SOIL,1)))
-PALBNIR_SOIL(:)=ZALBNIR_SOIL(:,1)
-ALLOCATE(PALBVIS_SOIL(SIZE(ZALBVIS_SOIL,1)))
-PALBVIS_SOIL(:)=ZALBVIS_SOIL(:,1)
-ALLOCATE(PALBUV_SOIL(SIZE(ZALBUV_SOIL,1)))
-PALBUV_SOIL(:)=ZALBUV_SOIL(:,1)
-ALLOCATE(PALBNIR(SIZE(ZALBNIR,1)))
-PALBNIR(:)=ZALBNIR(:,1)
-ALLOCATE(PALBVIS(SIZE(ZALBVIS,1)))
-PALBVIS(:)=ZALBVIS(:,1)
-ALLOCATE(PALBUV(SIZE(ZALBUV,1)))
-PALBUV(:)=ZALBUV(:,1)
-!
-ALLOCATE(PPSN(SIZE(ZPSN,1)))
-IF (SIZE(ZPSN)>0) &
-PPSN(:)=ZPSN(:,1)
-
-ALLOCATE(PPSNG(SIZE(ZPSNG,1)))
-IF (SIZE(ZPSNG)>0) &
-PPSNG(:)=ZPSNG(:,1)
-
-ALLOCATE(PPSNV(SIZE(ZPSNV,1)))
-IF (SIZE(ZPSNV)>0) &
-PPSNV(:)=ZPSNV(:,1)
-
-ALLOCATE(PPSNV_A(SIZE(ZPSNV_A,1)))
-IF (SIZE(ZPSNV_A)>0) &
-PPSNV_A(:)=ZPSNV_A(:,1)
-!
-IF (LHOOK) CALL DR_HOOK('INIT_VEG_GARDEN_n',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE INIT_VEG_GARDEN_n
diff --git a/src/SURFEX/init_veg_pgd_gardenn.F90 b/src/SURFEX/init_veg_pgd_gardenn.F90
deleted file mode 100644
index a146b2945306c7f9af81c64c73c6724518c79fff..0000000000000000000000000000000000000000
--- a/src/SURFEX/init_veg_pgd_gardenn.F90
+++ /dev/null
@@ -1,491 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-!#############################################################
-SUBROUTINE INIT_VEG_PGD_GARDEN_n (CHI, DTCO, DST, I, SLT, U, &
- HPROGRAM, KLUOUT, KI, KGROUND_LAYER, KMONTH, &
- PVEGTYPE, PTDEEP, PGAMMAT, HPHOTO, HINIT, OTR_ML, HRUNOFF, &
- KNBIOMASS, PCO2, PRHOA, PABC, PPOI, &
- PGMES, PGC, PDMAX, PANMAX, PFZERO, PEPSO, PGAMM, PQDGAMM, &
- PQDGMES, PT1GMES, PT2GMES, PAMAX, PQDAMAX, PT1AMAX, PT2AMAX,&
- PAH, PBH, &
- KSV, HSV, YSV, HCH_NAMES, HAER_NAMES, HDSTNAMES, HSLTNAMES, &
- HCHEM_SURF_FILE, &
- PCLAY, PSAND, HPEDOTF, &
- PCONDSAT, PMPOTSAT, PBCOEF, PWWILT, PWFC, PWSAT, &
- PTAUICE, PCGSAT, PC1SAT, PC2REF, PC3, PC4B, PACOEF, PPCOEF, &
- PC4REF, PPCPS, PPLVTT, PPLSTT, &
- HSCOND, HISBA, PHCAPSOIL, PCONDDRY, PCONDSLD, HCPSURF, &
- PDG, PDROOT, PDG2, PROOTFRAC, PRUNOFFD, PDZG, PDZDIF, &
- PSOILWGHT, KWG_LAYER, KLAYER_HORT, KLAYER_DUN, PD_ICE, &
- PKSAT_ICE, PALBNIR_DRY, PALBVIS_DRY, PALBUV_DRY, &
- PALBNIR_WET, PALBVIS_WET, PALBUV_WET, PBSLAI_NITRO, &
- PCE_NITRO, PCNA_NITRO, PCF_NITRO )
-!#############################################################
-!
-!!**** *INIT_VEG_PGD_GARDEN_n* - routine to initialize ISBA
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-! B. decharme 04/2013 : dummy for water table / surface coupling
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE MODD_SV_n, ONLY : SV_t
-!
-USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DST_n, ONLY : DST_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_SLT_n, ONLY : SLT_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
-USE MODI_INIT_VEG_PGD_n
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
-!
-TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DST_t), INTENT(INOUT) :: DST
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(SLT_t), INTENT(INOUT) :: SLT
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-INTEGER, INTENT(IN) :: KLUOUT
-!
-INTEGER, INTENT(IN) :: KI
-INTEGER, INTENT(IN) :: KGROUND_LAYER
-INTEGER, INTENT(IN) :: KMONTH
-!
-REAL, DIMENSION(:,:), POINTER :: PVEGTYPE
-!
-REAL, DIMENSION(:), POINTER :: PTDEEP
-REAL, DIMENSION(:), POINTER :: PGAMMAT
-!
-!
- CHARACTER(LEN=3), INTENT(IN) :: HPHOTO
- CHARACTER(LEN=3), INTENT(IN) :: HINIT
-LOGICAL, INTENT(IN) :: OTR_ML
- CHARACTER(LEN=4), INTENT(IN) :: HRUNOFF
-INTEGER, INTENT(IN) :: KNBIOMASS
-REAL, DIMENSION(:), INTENT(IN) :: PCO2
-REAL, DIMENSION(:), INTENT(IN) :: PRHOA
-REAL, DIMENSION(:), POINTER :: PABC
-REAL, DIMENSION(:), POINTER :: PPOI
-REAL, DIMENSION(:), POINTER :: PGMES
-REAL, DIMENSION(:), POINTER :: PGC
-REAL, DIMENSION(:), POINTER :: PDMAX
-REAL, DIMENSION(:), POINTER :: PANMAX
-REAL, DIMENSION(:), POINTER :: PFZERO
-REAL, DIMENSION(:), POINTER :: PEPSO
-REAL, DIMENSION(:), POINTER :: PGAMM
-REAL, DIMENSION(:), POINTER :: PQDGAMM
-REAL, DIMENSION(:), POINTER :: PQDGMES
-REAL, DIMENSION(:), POINTER :: PT1GMES
-REAL, DIMENSION(:), POINTER :: PT2GMES
-REAL, DIMENSION(:), POINTER :: PAMAX
-REAL, DIMENSION(:), POINTER :: PQDAMAX
-REAL, DIMENSION(:), POINTER :: PT1AMAX
-REAL, DIMENSION(:), POINTER :: PT2AMAX
-REAL, DIMENSION(:), POINTER :: PAH
-REAL, DIMENSION(:), POINTER :: PBH
-!
-INTEGER, INTENT(IN) :: KSV ! number of scalars
- CHARACTER(LEN=6), DIMENSION(KSV), INTENT(IN) :: HSV ! name of all scalar variables
-TYPE(SV_t), INTENT(INOUT) :: YSV
- CHARACTER(LEN=6), DIMENSION(:), POINTER :: HCH_NAMES
- CHARACTER(LEN=6), DIMENSION(:), POINTER :: HAER_NAMES
- CHARACTER(LEN=6), DIMENSION(:), POINTER, OPTIONAL :: HDSTNAMES
- CHARACTER(LEN=6), DIMENSION(:), POINTER, OPTIONAL :: HSLTNAMES
-!
- CHARACTER(LEN=28), INTENT(OUT) :: HCHEM_SURF_FILE
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PCLAY
-REAL, DIMENSION(:,:), INTENT(IN) :: PSAND
- CHARACTER(LEN=4), INTENT(IN) :: HPEDOTF
-REAL, DIMENSION(:,:), POINTER :: PCONDSAT
-REAL, DIMENSION(:,:), POINTER :: PMPOTSAT
-REAL, DIMENSION(:,:), POINTER :: PBCOEF
-REAL, DIMENSION(:,:), POINTER :: PWWILT
-REAL, DIMENSION(:,:), POINTER :: PWFC
-REAL, DIMENSION(:,:), POINTER :: PWSAT
-REAL, DIMENSION(:), POINTER :: PTAUICE
-REAL, DIMENSION(:), POINTER :: PCGSAT
-REAL, DIMENSION(:), POINTER :: PC1SAT
-REAL, DIMENSION(:), POINTER :: PC2REF
-REAL, DIMENSION(:,:), POINTER :: PC3
-REAL, DIMENSION(:), POINTER :: PC4B
-REAL, DIMENSION(:), POINTER :: PACOEF
-REAL, DIMENSION(:), POINTER :: PPCOEF
-REAL, DIMENSION(:), POINTER :: PC4REF
-!
-REAL, DIMENSION(:), POINTER :: PPCPS
-REAL, DIMENSION(:), POINTER :: PPLVTT
-REAL, DIMENSION(:), POINTER :: PPLSTT
-!
- CHARACTER(LEN=4), INTENT(IN) :: HSCOND
- CHARACTER(LEN=3), INTENT(IN) :: HISBA
-REAL, DIMENSION(:,:), POINTER :: PHCAPSOIL
-REAL, DIMENSION(:,:), POINTER :: PCONDDRY
-REAL, DIMENSION(:,:), POINTER :: PCONDSLD
- CHARACTER(LEN=3), INTENT(IN) :: HCPSURF
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PDG
-REAL, DIMENSION(:), INTENT(IN) :: PDROOT
-REAL, DIMENSION(:), INTENT(IN) :: PDG2
-REAL, DIMENSION(:,:), INTENT(IN) :: PROOTFRAC
-REAL, DIMENSION(:), POINTER :: PRUNOFFD
-REAL, DIMENSION(:,:), POINTER :: PDZG
-REAL, DIMENSION(:,:), POINTER :: PDZDIF
-REAL, DIMENSION(:,:), POINTER :: PSOILWGHT
-INTEGER, DIMENSION(:), INTENT(IN) :: KWG_LAYER
-INTEGER, INTENT(OUT) :: KLAYER_HORT
-INTEGER, INTENT(OUT) :: KLAYER_DUN
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PD_ICE
-REAL, DIMENSION(:), POINTER :: PKSAT_ICE
-!
-REAL, DIMENSION(:), POINTER :: PALBNIR_DRY
-REAL, DIMENSION(:), POINTER :: PALBVIS_DRY
-REAL, DIMENSION(:), POINTER :: PALBUV_DRY
-REAL, DIMENSION(:), POINTER :: PALBNIR_WET
-REAL, DIMENSION(:), POINTER :: PALBVIS_WET
-REAL, DIMENSION(:), POINTER :: PALBUV_WET
-!
-REAL, DIMENSION(:), POINTER :: PBSLAI_NITRO
-REAL, DIMENSION(:), INTENT(IN) :: PCE_NITRO
-REAL, DIMENSION(:), INTENT(IN) :: PCNA_NITRO
-REAL, DIMENSION(:), INTENT(IN) :: PCF_NITRO
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-REAL, DIMENSION(:,:), POINTER :: ZPATCH
-REAL, DIMENSION(:,:,:), POINTER :: ZVEGTYPE_PATCH
-INTEGER, DIMENSION(:), POINTER :: ISIZE_NATURE_P
-INTEGER, DIMENSION(:,:), POINTER :: IR_NATURE_P
-REAL, DIMENSION(0) :: ZTDEEP_CLI, ZGAMMAT_CLI, ZTHRESHOLD
-INTEGER, DIMENSION(:,:), POINTER :: IIRRINUM
-LOGICAL, DIMENSION(:,:), POINTER :: GIRRIDAY
-LOGICAL, DIMENSION(:,:), POINTER :: GIRRIGATE
-REAL, DIMENSION(:,:), POINTER :: ZTHRESHOLDSPT
-REAL, DIMENSION(:,:,:), POINTER :: ZINCREASE
-REAL, DIMENSION(:,:,:), POINTER :: ZTURNOVER
-REAL, DIMENSION(:,:,:), POINTER :: ZSFDST
-REAL, DIMENSION(:,:,:), POINTER :: ZSFDSTM
-REAL, DIMENSION(:,:,:), POINTER :: ZSFSLT
-REAL, DIMENSION(0) :: ZAOSIP, ZAOSIM, ZAOSJP, ZAOSJM
-REAL, DIMENSION(0) :: ZHO2IP, ZHO2IM, ZHO2JP, ZHO2JM
-REAL, DIMENSION(0,0) :: ZZ0
-REAL, DIMENSION(:,:), POINTER :: ZZ0EFFIP
-REAL, DIMENSION(:,:), POINTER :: ZZ0EFFIM
-REAL, DIMENSION(:,:), POINTER :: ZZ0EFFJP
-REAL, DIMENSION(:,:), POINTER :: ZZ0EFFJM
-REAL, DIMENSION(:), POINTER :: ZZ0REL
-!
-REAL, DIMENSION(:,:), POINTER :: ZC1SAT
-REAL, DIMENSION(:,:), POINTER :: ZC2REF
-REAL, DIMENSION(:,:), POINTER :: ZC4REF
-REAL, DIMENSION(:,:,:), POINTER :: ZC3
-!
-REAL, DIMENSION(:,:), POINTER :: ZPCPS
-REAL, DIMENSION(:,:), POINTER :: ZPLVTT
-REAL, DIMENSION(:,:), POINTER :: ZPLSTT
-!
-REAL, DIMENSION(:,:), POINTER :: ZKSAT_ICE
-REAL, DIMENSION(:,:,:), POINTER :: ZDZG
-REAL, DIMENSION(:,:,:), POINTER :: ZDZDIF
-REAL, DIMENSION(:,:,:), POINTER :: ZSOILWGHT
-REAL, DIMENSION(:,:,:), POINTER :: ZCONDSAT
-REAL, DIMENSION(:,:), POINTER :: ZRUNOFFD
-REAL, DIMENSION(:,:), POINTER :: ZBSLAI_NITRO
-REAL, DIMENSION(:,:), POINTER :: ZANMAX
-REAL, DIMENSION(:,:), POINTER :: ZFZERO
-REAL, DIMENSION(:,:), POINTER :: ZEPSO
-REAL, DIMENSION(:,:), POINTER :: ZGAMM
-REAL, DIMENSION(:,:), POINTER :: ZQDGAMM
-REAL, DIMENSION(:,:), POINTER :: ZQDGMES
-REAL, DIMENSION(:,:), POINTER :: ZT1GMES
-REAL, DIMENSION(:,:), POINTER :: ZT2GMES
-REAL, DIMENSION(:,:), POINTER :: ZAMAX
-REAL, DIMENSION(:,:), POINTER :: ZQDAMAX
-REAL, DIMENSION(:,:), POINTER :: ZT1AMAX
-REAL, DIMENSION(:,:), POINTER :: ZT2AMAX
-REAL, DIMENSION(:,:), POINTER :: ZAH
-REAL, DIMENSION(:,:), POINTER :: ZBH
-REAL, DIMENSION(:,:), POINTER :: ZTAU_WOOD
-REAL, DIMENSION(:,:), POINTER :: ZKANISO
-REAL, DIMENSION(:,:), POINTER :: ZWD0
-!
-REAL, DIMENSION(:), POINTER :: ZFWTD ! grid-cell fraction of water table to rise
-REAL, DIMENSION(:), POINTER :: ZWTD ! water table depth from Obs, TRIP or MODCOU
-!
-REAL, DIMENSION(SIZE(PDG,1),SIZE(PDG,2),1) :: ZDG
-REAL, DIMENSION(SIZE(PDROOT),1) :: ZDROOT
-REAL, DIMENSION(SIZE(PDG2),1) :: ZDG2
-REAL, DIMENSION(SIZE(PD_ICE),1) :: ZD_ICE
-REAL, DIMENSION(SIZE(PROOTFRAC,1),SIZE(PROOTFRAC,2),1) :: ZROOTFRAC
-REAL, DIMENSION(SIZE(PCE_NITRO),1) :: ZCE_NITRO
-REAL, DIMENSION(SIZE(PCNA_NITRO),1) :: ZCNA_NITRO
-REAL, DIMENSION(SIZE(PCF_NITRO),1) :: ZCF_NITRO
-REAL, DIMENSION(SIZE(PGMES),1) :: ZGMES
-REAL, DIMENSION(SIZE(PGC),1) :: ZGC
-REAL, DIMENSION(SIZE(PDMAX),1) :: ZDMAX
-INTEGER, DIMENSION(SIZE(KWG_LAYER),1) :: IWG_LAYER
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-! Initialisation for IO
-!
-IF (LHOOK) CALL DR_HOOK('INIT_VEG_PGD_GARDEN_n',0,ZHOOK_HANDLE)
-!
-!* 2.4 Fraction of each tile
-! ---------------------
-!
-NULLIFY(ZPATCH)
-NULLIFY(ZVEGTYPE_PATCH)
-NULLIFY(ISIZE_NATURE_P)
-NULLIFY(IR_NATURE_P)
-NULLIFY(IIRRINUM)
-NULLIFY(GIRRIDAY)
-NULLIFY(GIRRIGATE)
-NULLIFY(ZTHRESHOLDSPT)
-NULLIFY(ZINCREASE)
-NULLIFY(ZTURNOVER)
-NULLIFY(ZSFDST)
-NULLIFY(ZSFDSTM)
-NULLIFY(ZSFSLT)
-NULLIFY(ZZ0EFFIP)
-NULLIFY(ZZ0EFFIM)
-NULLIFY(ZZ0EFFJP)
-NULLIFY(ZZ0EFFJM)
-NULLIFY(ZZ0REL)
-!
-NULLIFY(ZC1SAT)
-NULLIFY(ZC2REF)
-NULLIFY(ZC4REF)
-NULLIFY(ZC3)
-!
-NULLIFY(ZPCPS)
-NULLIFY(ZPLVTT)
-NULLIFY(ZPLSTT)
-!
-NULLIFY(ZKSAT_ICE)
-NULLIFY(ZDZG)
-NULLIFY(ZDZDIF)
-NULLIFY(ZSOILWGHT)
-NULLIFY(ZCONDSAT)
-NULLIFY(ZRUNOFFD)
-NULLIFY(ZBSLAI_NITRO)
-NULLIFY(ZANMAX)
-NULLIFY(ZFZERO)
-NULLIFY(ZEPSO)
-NULLIFY(ZGAMM)
-NULLIFY(ZQDGAMM)
-NULLIFY(ZQDGMES)
-NULLIFY(ZT1GMES)
-NULLIFY(ZT2GMES)
-NULLIFY(ZAMAX)
-NULLIFY(ZT1AMAX)
-NULLIFY(ZT2AMAX)
-NULLIFY(ZAH)
-NULLIFY(ZBH)
-NULLIFY(ZTAU_WOOD)
-NULLIFY(ZFWTD)
-NULLIFY(ZWTD)
-NULLIFY(ZWD0)
-NULLIFY(ZKANISO)
-!
-ZDG(:,:,1) = PDG(:,:)
-ZROOTFRAC(:,:,1) = PROOTFRAC(:,:)
-ZDROOT(:,1) = PDROOT(:)
-ZDG2(:,1) = PDG2(:)
-ZD_ICE(:,1) = PD_ICE(:)
-IWG_LAYER(:,1) = KWG_LAYER(:)
-ZCE_NITRO(:,1) = PCE_NITRO(:)
-ZCNA_NITRO(:,1) = PCNA_NITRO(:)
-ZCF_NITRO(:,1) = PCF_NITRO(:)
-ZGMES(:,1) = PGMES(:)
-ZGC(:,1) = PGC(:)
-ZDMAX(:,1) = PDMAX(:)
-!
- CALL INIT_VEG_PGD_n(CHI, DTCO, DST, I, SLT, U, &
- HPROGRAM, 'TOWN ',KLUOUT, KI, 1, KGROUND_LAYER, KMONTH, &
- PVEGTYPE, ZPATCH, ZVEGTYPE_PATCH, ISIZE_NATURE_P, IR_NATURE_P, &
- 0.0, &
- .FALSE., .FALSE., ZTDEEP_CLI, ZGAMMAT_CLI, PTDEEP, PGAMMAT, &
- .FALSE., ZTHRESHOLD, IIRRINUM, GIRRIDAY, GIRRIGATE, ZTHRESHOLDSPT, &
- HPHOTO, HINIT, OTR_ML, KNBIOMASS, PCO2, PRHOA, PABC, PPOI, &
- ZGMES, ZGC, ZDMAX, ZANMAX, ZFZERO, ZEPSO, ZGAMM, ZQDGAMM, &
- ZQDGMES, ZT1GMES, ZT2GMES, ZAMAX, ZQDAMAX, ZT1AMAX, ZT2AMAX,&
- ZAH, ZBH, ZTAU_WOOD, ZINCREASE, ZTURNOVER, &
- KSV, HSV, YSV, HCH_NAMES, HAER_NAMES, HDSTNAMES, HSLTNAMES, &
- HCHEM_SURF_FILE, &
- ZSFDST, ZSFDSTM, ZSFSLT, &
- ZAOSIP, ZAOSIM, ZAOSJP, ZAOSJM, ZHO2IP, ZHO2IM, ZHO2JP, &
- ZHO2JM, ZZ0, ZZ0EFFIP, ZZ0EFFIM, ZZ0EFFJP, ZZ0EFFJM, ZZ0REL,&
- PCLAY, PSAND, HPEDOTF, &
- ZCONDSAT, PMPOTSAT, PBCOEF, PWWILT, PWFC, PWSAT, ZWD0, &
- ZKANISO, HRUNOFF, &
- PTAUICE, PCGSAT, ZC1SAT, ZC2REF, ZC3, PC4B, PACOEF, PPCOEF, &
- ZC4REF, ZPCPS, ZPLVTT, ZPLSTT, &
- HSCOND, HISBA, PHCAPSOIL, PCONDDRY, PCONDSLD, HCPSURF, &
- ZDG, ZDROOT, ZDG2, ZROOTFRAC, ZRUNOFFD, ZDZG, ZDZDIF, &
- ZSOILWGHT, IWG_LAYER, KLAYER_HORT, KLAYER_DUN, ZD_ICE, &
- ZKSAT_ICE, PALBNIR_DRY, PALBVIS_DRY, PALBUV_DRY, &
- PALBNIR_WET, PALBVIS_WET, PALBUV_WET, ZBSLAI_NITRO, &
- ZCE_NITRO, ZCNA_NITRO, ZCF_NITRO, ZFWTD, ZWTD )
-!
-ALLOCATE(PPCPS(SIZE(ZPCPS,1)))
-IF (SIZE(ZPCPS)>0) &
-PPCPS(:) = ZPCPS(:,1)
-
-ALLOCATE(PPLVTT(SIZE(ZPLVTT,1)))
-IF (SIZE(ZPLVTT)>0) &
-PPLVTT(:) = ZPLVTT(:,1)
-
-ALLOCATE(PPLSTT(SIZE(ZPLSTT,1)))
-IF (SIZE(ZPLSTT)>0) &
-PPLSTT(:) = ZPLSTT(:,1)
-
-IF (SIZE(ZD_ICE)>0) &
-PD_ICE(:) = ZD_ICE(:,1)
-
-ALLOCATE(PKSAT_ICE(SIZE(ZKSAT_ICE,1)))
-IF (SIZE(ZKSAT_ICE)>0) &
-PKSAT_ICE(:) = ZKSAT_ICE(:,1)
-
-ALLOCATE(PDZG(SIZE(ZDZG,1),SIZE(ZDZG,2)))
-IF (SIZE(ZDZG)>0) &
-PDZG(:,:) = ZDZG(:,:,1)
-
-ALLOCATE(PDZDIF(SIZE(ZDZDIF,1),SIZE(ZDZDIF,2)))
-IF (SIZE(ZDZDIF)>0) &
-PDZDIF(:,:) = ZDZDIF(:,:,1)
-
-ALLOCATE(PSOILWGHT(SIZE(ZSOILWGHT,1),SIZE(ZSOILWGHT,2)))
-IF (SIZE(ZSOILWGHT)>0) &
-PSOILWGHT(:,:) = ZSOILWGHT(:,:,1)
-
-ALLOCATE(PCONDSAT(SIZE(ZCONDSAT,1),SIZE(ZCONDSAT,2)))
-IF (SIZE(ZCONDSAT)>0) &
-PCONDSAT(:,:) = ZCONDSAT(:,:,1)
-
-ALLOCATE(PC1SAT(SIZE(ZC1SAT,1)))
-IF (SIZE(ZC1SAT)>0) &
-PC1SAT(:) = ZC1SAT(:,1)
-
-ALLOCATE(PC2REF(SIZE(ZC2REF,1)))
-IF (SIZE(ZC2REF)>0) &
-PC2REF(:) = ZC2REF(:,1)
-
-ALLOCATE(PC4REF(SIZE(ZC4REF,1)))
-IF (SIZE(ZC4REF)>0) &
-PC4REF(:) = ZC4REF(:,1)
-
-ALLOCATE(PC3(SIZE(ZC3,1),SIZE(ZC3,2)))
-IF (SIZE(ZC3)>0) &
-PC3(:,:) = ZC3(:,:,1)
-
-ALLOCATE(PRUNOFFD(SIZE(ZRUNOFFD,1)))
-IF (SIZE(ZRUNOFFD)>0) &
-PRUNOFFD(:) = ZRUNOFFD(:,1)
-
-ALLOCATE(PBSLAI_NITRO(SIZE(ZBSLAI_NITRO,1)))
-IF (SIZE(ZBSLAI_NITRO)>0) &
-PBSLAI_NITRO(:) = ZBSLAI_NITRO(:,1)
-
-ALLOCATE(PANMAX(SIZE(ZANMAX,1)))
-IF (SIZE(PANMAX)>0) &
-PANMAX(:) = ZANMAX(:,1)
-
-ALLOCATE(PFZERO(SIZE(ZFZERO,1)))
-IF (SIZE(ZFZERO)>0) &
-PFZERO(:) = ZFZERO(:,1)
-
-ALLOCATE(PEPSO(SIZE(ZEPSO,1)))
-IF (SIZE(ZEPSO)>0) &
-PEPSO(:) = ZEPSO(:,1)
-
-ALLOCATE(PGAMM(SIZE(ZGAMM,1)))
-IF (SIZE(ZGAMM)>0) &
-PGAMM(:) = ZGAMM(:,1)
-
-ALLOCATE(PQDGAMM(SIZE(ZQDGAMM,1)))
-IF (SIZE(ZQDGAMM)>0) &
-PQDGAMM(:) = ZQDGAMM(:,1)
-
-ALLOCATE(PQDGMES(SIZE(ZQDGMES,1)))
-IF (SIZE(ZQDGMES)>0) &
-PQDGMES(:) = ZQDGMES(:,1)
-
-ALLOCATE(PT1GMES(SIZE(ZT1GMES,1)))
-IF (SIZE(ZT1GMES)>0) &
-PT1GMES(:) = ZT1GMES(:,1)
-
-ALLOCATE(PT2GMES(SIZE(ZT2GMES,1)))
-IF (SIZE(ZT2GMES)>0) &
-PT2GMES(:) = ZT2GMES(:,1)
-
-ALLOCATE(PAMAX(SIZE(ZAMAX,1)))
-IF (SIZE(ZAMAX)>0) &
-PAMAX(:) = ZAMAX(:,1)
-
-ALLOCATE(PQDAMAX(SIZE(ZQDAMAX,1)))
-IF (SIZE(ZQDAMAX)>0) &
-PQDAMAX(:) = ZQDAMAX(:,1)
-
-ALLOCATE(PT1AMAX(SIZE(ZT1AMAX,1)))
-IF (SIZE(ZT1AMAX)>0) &
-PT1AMAX(:) = ZT1AMAX(:,1)
-
-ALLOCATE(PT2AMAX(SIZE(ZT2AMAX,1)))
-IF (SIZE(ZT2AMAX)>0) &
-PT2AMAX(:) = ZT2AMAX(:,1)
-
-ALLOCATE(PAH(SIZE(ZAH,1)))
-IF (SIZE(ZAH)>0) &
-PAH(:) = ZAH(:,1)
-
-ALLOCATE(PBH(SIZE(ZBH,1)))
-IF (SIZE(ZBH)>0) &
-PBH(:) = ZBH(:,1)
-!
-IF (LHOOK) CALL DR_HOOK('INIT_VEG_PGD_GARDEN_n',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE INIT_VEG_PGD_GARDEN_n
diff --git a/src/SURFEX/init_veg_pgdn.F90 b/src/SURFEX/init_veg_pgdn.F90
index 2dc20bee3ca7b80d1c3a51e66eea24a700dc7e05..9a12d07d159e3f0bf6e01d46de075fd803599b36 100644
--- a/src/SURFEX/init_veg_pgdn.F90
+++ b/src/SURFEX/init_veg_pgdn.F90
@@ -3,33 +3,10 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#############################################################
-SUBROUTINE INIT_VEG_PGD_n (CHI, DTCO, DST, I, SLT, U, &
- HPROGRAM, HSURF, KLUOUT, KI, KPATCH, KGROUND_LAYER, KMONTH, &
- PVEGTYPE, PPATCH, PVEGTYPE_PATCH, KSIZE_NATURE_P, &
- KR_NATURE_P, PRM_PATCH, &
- ODEEPSOIL, OPHYSDOMC, PTDEEP_CLI, PGAMMAT_CLI, PTDEEP, &
- PGAMMAT, OAGRIP, PTHRESHOLD, KIRRINUM, OIRRIDAY, OIRRIGATE, &
- PTHRESHOLDSPT, &
- HPHOTO, HINIT, OTR_ML, KNBIOMASS, PCO2, PRHOA, PABC, PPOI, &
- PGMES, PGC, PDMAX, PANMAX, PFZERO, PEPSO, PGAMM, PQDGAMM, &
- PQDGMES, PT1GMES, PT2GMES, PAMAX, PQDAMAX, PT1AMAX, PT2AMAX,&
- PAH, PBH, PTAU_WOOD, PINCREASE, PTURNOVER, &
- KSV, HSV, YSV, HCH_NAMES, HAER_NAMES, HDSTNAMES, HSLTNAMES, &
- HCHEM_SURF_FILE, &
- PSFDST, PSFDSTM, PSFSLT, &
- PAOSIP, PAOSIM, PAOSJP, PAOSJM, PHO2IP, PHO2IM, PHO2JP, &
- PHO2JM, PZ0, PZ0EFFIP, PZ0EFFIM, PZ0EFFJP, PZ0EFFJM, PZ0REL,&
- PCLAY, PSAND, HPEDOTF, &
- PCONDSAT, PMPOTSAT, PBCOEF, PWWILT, PWFC, PWSAT, PWD0, &
- PKANISO, HRUNOFF, &
- PTAUICE, PCGSAT, PC1SAT, PC2REF, PC3, PC4B, PACOEF, PPCOEF, &
- PC4REF, PPCPS, PPLVTT, PPLSTT, &
- HSCOND, HISBA, PHCAPSOIL, PCONDDRY, PCONDSLD, HCPSURF, &
- PDG, PDROOT, PDG2, PROOTFRAC, PRUNOFFD, PDZG, PDZDIF, &
- PSOILWGHT, KWG_LAYER, KLAYER_HORT, KLAYER_DUN, PD_ICE, &
- PKSAT_ICE, PALBNIR_DRY, PALBVIS_DRY, PALBUV_DRY, &
- PALBNIR_WET, PALBVIS_WET, PALBUV_WET, PBSLAI_NITRO, &
- PCE_NITRO, PCNA_NITRO, PCF_NITRO, PFWTD, PWTD )
+SUBROUTINE INIT_VEG_PGD_n (ISSK, DTI, IO, S, K, KK, PK, PEK, AGK, KI, &
+ HPROGRAM, HSURF, KLUOUT, KSIZE, KMONTH, &
+ ODEEPSOIL, OPHYSDOMC, PTDEEP_CLI, PGAMMAT_CLI, &
+ OAGRIP, PTHRESHOLD, HINIT, PCO2, PRHOA )
!#############################################################
!
!!**** *INIT_VEG_PGD_n_n* - routine to initialize ISBA
@@ -64,18 +41,15 @@ SUBROUTINE INIT_VEG_PGD_n (CHI, DTCO, DST, I, SLT, U, &
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SURFEX_MPI, ONLY : NRANK
!
+USE MODD_SSO_n, ONLY : SSO_t
!
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
!
-USE MODD_SV_n, ONLY : SV_t
-!
-!
-USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DST_n, ONLY : DST_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_SLT_n, ONLY : SLT_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_AGRI_n, ONLY : AGRI_t
!
USE MODD_SURF_ATM, ONLY : LCPL_ARP
USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
@@ -91,12 +65,6 @@ USE MODE_COTWO, ONLY : GAULEG
USE MODI_SURF_PATCH
USE MODI_GET_1D_MASK
USE MODI_CO2_INIT_n
-USE MODI_INIT_CHEMICAL_n
-USE MODI_OPEN_NAMELIST
-USE MODI_CH_INIT_DEP_ISBA_n
-USE MODI_CLOSE_NAMELIST
-USE MODI_INIT_DST
-USE MODI_INIT_SLT
USE MODI_SUBSCALE_Z0EFF
!
USE MODE_SOIL
@@ -106,6 +74,7 @@ USE MODI_THRMCONDZ
USE MODI_ABOR1_SFX
USE MODI_DIF_LAYER
USE MODI_DRY_WET_SOIL_ALBEDOS
+USE MODI_PACK_SAME_RANK
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -113,178 +82,51 @@ USE PARKIND1 ,ONLY : JPRB
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
-! -------------------------
+! --²-----------------------
+!
+!
+TYPE(SSO_t), INTENT(INOUT) :: ISSK
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(AGRI_t), INTENT(INOUT) :: AGK
!
-TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DST_t), INTENT(INOUT) :: DST
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(SLT_t), INTENT(INOUT) :: SLT
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+INTEGER, INTENT(IN) :: KI
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=6), INTENT(IN) :: HSURF ! Type of surface
INTEGER, INTENT(IN) :: KLUOUT
!
-INTEGER, INTENT(IN) :: KI
-INTEGER, INTENT(IN) :: KPATCH
-INTEGER, INTENT(IN) :: KGROUND_LAYER
-INTEGER, INTENT(IN) :: KMONTH
-!
-REAL, DIMENSION(:,:), POINTER :: PVEGTYPE
-REAL, DIMENSION(:,:), POINTER :: PPATCH
-REAL, DIMENSION(:,:,:), POINTER :: PVEGTYPE_PATCH
-INTEGER, DIMENSION(:), POINTER :: KSIZE_NATURE_P
-INTEGER, DIMENSION(:,:), POINTER :: KR_NATURE_P
+INTEGER, INTENT(IN) :: KSIZE
!
-REAL, INTENT(IN) :: PRM_PATCH
+INTEGER, INTENT(IN) :: KMONTH
!
LOGICAL, INTENT(IN) :: ODEEPSOIL
LOGICAL, INTENT(IN) :: OPHYSDOMC
REAL, DIMENSION(:), INTENT(IN) :: PTDEEP_CLI
REAL, DIMENSION(:), INTENT(IN) :: PGAMMAT_CLI
-REAL, DIMENSION(:), POINTER :: PTDEEP
-REAL, DIMENSION(:), POINTER :: PGAMMAT
!
LOGICAL, INTENT(IN) :: OAGRIP
REAL, DIMENSION(:), INTENT(IN) :: PTHRESHOLD
-INTEGER, DIMENSION(:,:), POINTER :: KIRRINUM
-LOGICAL, DIMENSION(:,:), POINTER :: OIRRIDAY
-LOGICAL, DIMENSION(:,:), POINTER :: OIRRIGATE
-REAL, DIMENSION(:,:), POINTER :: PTHRESHOLDSPT
!
- CHARACTER(LEN=3), INTENT(IN) :: HPHOTO
CHARACTER(LEN=3), INTENT(IN) :: HINIT
-LOGICAL, INTENT(IN) :: OTR_ML
-INTEGER, INTENT(IN) :: KNBIOMASS
+ !
REAL, DIMENSION(:), INTENT(IN) :: PCO2
REAL, DIMENSION(:), INTENT(IN) :: PRHOA
-REAL, DIMENSION(:), POINTER :: PABC
-REAL, DIMENSION(:), POINTER :: PPOI
-REAL, DIMENSION(:,:), INTENT(IN) :: PGMES
-REAL, DIMENSION(:,:), INTENT(IN) :: PGC
-REAL, DIMENSION(:,:), INTENT(IN):: PDMAX
-REAL, DIMENSION(:,:), POINTER :: PANMAX
-REAL, DIMENSION(:,:), POINTER :: PFZERO
-REAL, DIMENSION(:,:), POINTER :: PEPSO
-REAL, DIMENSION(:,:), POINTER :: PGAMM
-REAL, DIMENSION(:,:), POINTER :: PQDGAMM
-REAL, DIMENSION(:,:), POINTER :: PQDGMES
-REAL, DIMENSION(:,:), POINTER :: PT1GMES
-REAL, DIMENSION(:,:), POINTER :: PT2GMES
-REAL, DIMENSION(:,:), POINTER :: PAMAX
-REAL, DIMENSION(:,:), POINTER :: PQDAMAX
-REAL, DIMENSION(:,:), POINTER :: PT1AMAX
-REAL, DIMENSION(:,:), POINTER :: PT2AMAX
-REAL, DIMENSION(:,:), POINTER :: PAH
-REAL, DIMENSION(:,:), POINTER :: PBH
-REAL, DIMENSION(:,:), POINTER :: PTAU_WOOD
-REAL, DIMENSION(:,:,:), POINTER :: PINCREASE
-REAL, DIMENSION(:,:,:), POINTER :: PTURNOVER
-!
-INTEGER, INTENT(IN) :: KSV ! number of scalars
- CHARACTER(LEN=6), DIMENSION(KSV), INTENT(IN) :: HSV ! name of all scalar variables
-TYPE(SV_t), INTENT(INOUT) :: YSV
- CHARACTER(LEN=6), DIMENSION(:), POINTER :: HCH_NAMES
- CHARACTER(LEN=6), DIMENSION(:), POINTER :: HAER_NAMES
- CHARACTER(LEN=6), DIMENSION(:), POINTER, OPTIONAL :: HDSTNAMES
- CHARACTER(LEN=6), DIMENSION(:), POINTER, OPTIONAL :: HSLTNAMES
-!
- CHARACTER(LEN=28), INTENT(OUT) :: HCHEM_SURF_FILE
-!
-REAL, DIMENSION(:,:,:), POINTER :: PSFDST
-REAL, DIMENSION(:,:,:), POINTER :: PSFDSTM
-REAL, DIMENSION(:,:,:), POINTER :: PSFSLT
-!
-REAL, DIMENSION(:), INTENT(IN) :: PAOSIP
-REAL, DIMENSION(:), INTENT(IN) :: PAOSIM
-REAL, DIMENSION(:), INTENT(IN) :: PAOSJP
-REAL, DIMENSION(:), INTENT(IN) :: PAOSJM
-REAL, DIMENSION(:), INTENT(IN) :: PHO2IP
-REAL, DIMENSION(:), INTENT(IN) :: PHO2IM
-REAL, DIMENSION(:), INTENT(IN) :: PHO2JP
-REAL, DIMENSION(:), INTENT(IN) :: PHO2JM
-REAL, DIMENSION(:,:), INTENT(IN) :: PZ0
-REAL, DIMENSION(:,:), POINTER :: PZ0EFFIP
-REAL, DIMENSION(:,:), POINTER :: PZ0EFFIM
-REAL, DIMENSION(:,:), POINTER :: PZ0EFFJP
-REAL, DIMENSION(:,:), POINTER :: PZ0EFFJM
-REAL, DIMENSION(:), POINTER :: PZ0REL
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PCLAY
-REAL, DIMENSION(:,:), INTENT(IN) :: PSAND
- CHARACTER(LEN=4), INTENT(IN) :: HPEDOTF
-REAL, DIMENSION(:,:,:), POINTER :: PCONDSAT
-REAL, DIMENSION(:,:), POINTER :: PMPOTSAT
-REAL, DIMENSION(:,:), POINTER :: PBCOEF
-REAL, DIMENSION(:,:), POINTER :: PWWILT
-REAL, DIMENSION(:,:), POINTER :: PWFC
-REAL, DIMENSION(:,:), POINTER :: PWSAT
-REAL, DIMENSION(:,:), POINTER :: PWD0
-REAL, DIMENSION(:,:), POINTER :: PKANISO
-!
-REAL, DIMENSION(:), POINTER :: PTAUICE
-REAL, DIMENSION(:), POINTER :: PCGSAT
-REAL, DIMENSION(:,:), POINTER :: PC1SAT
-REAL, DIMENSION(:,:), POINTER :: PC2REF
-REAL, DIMENSION(:,:,:), POINTER :: PC3
-REAL, DIMENSION(:), POINTER :: PC4B
-REAL, DIMENSION(:), POINTER :: PACOEF
-REAL, DIMENSION(:), POINTER :: PPCOEF
-REAL, DIMENSION(:,:), POINTER :: PC4REF
-!
-REAL, DIMENSION(:,:), POINTER :: PPCPS
-REAL, DIMENSION(:,:), POINTER :: PPLVTT
-REAL, DIMENSION(:,:), POINTER :: PPLSTT
-!
- CHARACTER(LEN=4), INTENT(IN) :: HSCOND
- CHARACTER(LEN=3), INTENT(IN) :: HISBA
- CHARACTER(LEN=4), INTENT(IN) :: HRUNOFF
-REAL, DIMENSION(:,:), POINTER :: PHCAPSOIL
-REAL, DIMENSION(:,:), POINTER :: PCONDDRY
-REAL, DIMENSION(:,:), POINTER :: PCONDSLD
- CHARACTER(LEN=3), INTENT(IN) :: HCPSURF
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDG
-REAL, DIMENSION(:,:), INTENT(IN) :: PDROOT
-REAL, DIMENSION(:,:), INTENT(IN) :: PDG2
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PROOTFRAC
-REAL, DIMENSION(:,:), POINTER :: PRUNOFFD
-REAL, DIMENSION(:,:,:), POINTER :: PDZG
-REAL, DIMENSION(:,:,:), POINTER :: PDZDIF
-REAL, DIMENSION(:,:,:), POINTER :: PSOILWGHT
-INTEGER, DIMENSION(:,:), INTENT(IN) :: KWG_LAYER
-INTEGER, INTENT(OUT) :: KLAYER_HORT
-INTEGER, INTENT(OUT) :: KLAYER_DUN
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PD_ICE
-REAL, DIMENSION(:,:), POINTER :: PKSAT_ICE
-!
-REAL, DIMENSION(:), POINTER :: PALBNIR_DRY
-REAL, DIMENSION(:), POINTER :: PALBVIS_DRY
-REAL, DIMENSION(:), POINTER :: PALBUV_DRY
-REAL, DIMENSION(:), POINTER :: PALBNIR_WET
-REAL, DIMENSION(:), POINTER :: PALBVIS_WET
-REAL, DIMENSION(:), POINTER :: PALBUV_WET
-!
-REAL, DIMENSION(:,:), POINTER :: PBSLAI_NITRO
-REAL, DIMENSION(:,:), INTENT(IN) :: PCE_NITRO
-REAL, DIMENSION(:,:), INTENT(IN) :: PCNA_NITRO
-REAL, DIMENSION(:,:), INTENT(IN) :: PCF_NITRO
-!
-REAL, DIMENSION(:), POINTER :: PFWTD
-REAL, DIMENSION(:), POINTER :: PWTD
!
!* 0.2 Declarations of local variables
! -------------------------------
!
INTEGER :: JPATCH ! loop counter on tiles
INTEGER :: JILU,JP, JMAXLOC ! loop increment
-INTEGER :: JLAYER ! loop counter on layers
+INTEGER :: JL ! loop counter on layers
!
-INTEGER :: ICH ! unit of input chemistry file
-INTEGER :: ISIZE
+INTEGER :: IABC
!
REAL, DIMENSION(SIZE(PCO2)) :: ZCO2 ! CO2 concentration (kg/kg)
!
@@ -298,459 +140,430 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('INIT_VEG_PGD_n',0,ZHOOK_HANDLE)
!
-!* 2.4 Fraction of each tile
-! ---------------------
-!
-ALLOCATE(PPATCH (KI,KPATCH))
-ALLOCATE(PVEGTYPE_PATCH (KI,NVEGTYPE,KPATCH))
-ALLOCATE(KSIZE_NATURE_P (KPATCH))
-ALLOCATE(KR_NATURE_P (KI,KPATCH))
+!------------------------------------------------------------------------------------
+!------------------------------------------------------------------------------------
!
- CALL SURF_PATCH(KPATCH,PVEGTYPE,PPATCH,PVEGTYPE_PATCH)
+! PART 1: fields that are needed unpacked and packed: defined unpacked
+! -------------------------------------------------------------------
!
-!* 2.5 Masks for tiles
-! ---------------
+!* Soil hydraulic characteristics:
+! -------------------------------
!
-IF (PRM_PATCH/=0.) THEN
+IF (.NOT.ASSOCIATED(K%XMPOTSAT)) THEN
!
- WRITE(KLUOUT,*) " REMOVE PATCH below 5 % add to dominant patch "
- ! remove small fraction of PATCHES and add to MAIN PATCH
- DO JP = 1,KI
- !1) find most present patch maximum value
- JMAXLOC = MAXVAL(MAXLOC(PPATCH(JP,:)))
- !2) FIND small value of cover
- DO JPATCH = 1,KPATCH
- IF ( PPATCH(JP,JPATCH)<PRM_PATCH ) THEN
- PPATCH(JP,JMAXLOC) = PPATCH(JP,JMAXLOC) + PPATCH(JP,JPATCH)
- PPATCH(JP,JPATCH) = 0.0
- ENDIF
- ENDDO
- ENDDO
+ ALLOCATE(K%XMPOTSAT (KI,IO%NGROUND_LAYER))
+ ALLOCATE(K%XBCOEF (KI,IO%NGROUND_LAYER))
+ ALLOCATE(K%XWWILT (KI,IO%NGROUND_LAYER)) ! wilting point
+ ALLOCATE(K%XWFC (KI,IO%NGROUND_LAYER)) ! field capacity
+ ALLOCATE(K%XWSAT (KI,IO%NGROUND_LAYER)) ! saturation
+ !
+ DO JL=1,IO%NGROUND_LAYER
+ IF (DTI%LDATA_BCOEF) THEN
+ K%XBCOEF (:,JL) = DTI%XPAR_BCOEF (:,JL)
+ ELSE
+ K%XBCOEF (:,JL) = BCOEF_FUNC (K%XCLAY(:,JL),K%XSAND(:,JL),IO%CPEDOTF)
+ ENDIF
+ IF (DTI%LDATA_MPOTSAT) THEN
+ K%XMPOTSAT(:,JL) = DTI%XPAR_MPOTSAT(:,JL)
+ ELSE
+ K%XMPOTSAT(:,JL) = MATPOTSAT_FUNC (K%XCLAY(:,JL),K%XSAND(:,JL),IO%CPEDOTF)
+ ENDIF
+ IF (DTI%LDATA_WSAT) THEN
+ K%XWSAT (:,JL) = DTI%XPAR_WSAT (:,JL)
+ ELSE
+ K%XWSAT (:,JL) = WSAT_FUNC (K%XCLAY(:,JL),K%XSAND(:,JL),IO%CPEDOTF)
+ ENDIF
+ IF (DTI%LDATA_WWILT) THEN
+ K%XWWILT (:,JL) = DTI%XPAR_WWILT (:,JL)
+ ELSE
+ K%XWWILT (:,JL) = WWILT_FUNC (K%XCLAY(:,JL),K%XSAND(:,JL),IO%CPEDOTF)
+ ENDIF
+ END DO
+ IF (DTI%LDATA_BCOEF ) DEALLOCATE(DTI%XPAR_BCOEF)
+ IF (DTI%LDATA_MPOTSAT) DEALLOCATE(DTI%XPAR_MPOTSAT)
+ IF (DTI%LDATA_WSAT ) DEALLOCATE(DTI%XPAR_WSAT)
+ IF (DTI%LDATA_WWILT ) DEALLOCATE(DTI%XPAR_WWILT)
+ !
+ IF (DTI%LDATA_WFC) THEN
+ K%XWFC(:,:) = DTI%XPAR_WFC(:,:)
+ DEALLOCATE(DTI%XPAR_WFC)
+ ELSEIF (IO%CISBA=='2-L' .OR. IO%CISBA=='3-L') THEN
+ ! field capacity at hydraulic conductivity = 0.1mm/day
+ K%XWFC(:,:) = WFC_FUNC(K%XCLAY(:,:),K%XSAND(:,:),IO%CPEDOTF)
+ ELSE IF (IO%CISBA=='DIF') THEN
+ ! field capacity at water potential = 0.33bar
+ K%XWFC(:,:) = W33_FUNC(K%XCLAY(:,:),K%XSAND(:,:),IO%CPEDOTF)
+ END IF
+ !
+ IF (IO%CISBA=='2-L' .OR. IO%CISBA=='3-L') THEN
+ ALLOCATE(K%XCGSAT (KI))
+ ALLOCATE(K%XC4B (KI))
+ ALLOCATE(K%XACOEF (KI))
+ ALLOCATE(K%XPCOEF (KI))
+ K%XCGSAT(:) = CGSAT_FUNC(K%XCLAY(:,1),K%XSAND(:,1))
+ K%XC4B (:) = C4B_FUNC (K%XCLAY(:,1))
+ K%XACOEF(:) = ACOEF_FUNC(K%XCLAY(:,1))
+ K%XPCOEF(:) = PCOEF_FUNC(K%XCLAY(:,1))
+ ELSE IF (IO%CISBA=='DIF') THEN
+ ALLOCATE(K%XCGSAT (0))
+ ALLOCATE(K%XC4B (0))
+ ALLOCATE(K%XACOEF (0))
+ ALLOCATE(K%XPCOEF (0))
+ ENDIF
+ !
+ IF(IO%CRUNOFF=='SGH')THEN
+ !
+ ALLOCATE(K%XWD0 (KI,IO%NGROUND_LAYER))
+ ALLOCATE(K%XKANISO(KI,IO%NGROUND_LAYER))
+ !
+ IF(IO%CISBA=='DIF')THEN
+ K%XWD0(:,:) = WFC_FUNC(K%XCLAY(:,:),K%XSAND(:,:),IO%CPEDOTF)
+ ELSE
+ K%XWD0(:,:) = K%XWWILT(:,:)
+ ENDIF
+ K%XKANISO(:,:) = ANISO_FUNC(K%XCLAY(:,:))
+ !
+ ELSE
+ !
+ ALLOCATE(K%XWD0 (0,0))
+ ALLOCATE(K%XKANISO(0,0))
+ !
+ ENDIF
+ !
+ IF (IO%CSCOND=='PL98'.OR.IO%CISBA=='DIF') THEN
+ ALLOCATE(K%XHCAPSOIL(KI,IO%NGROUND_LAYER))
+ ALLOCATE(K%XCONDDRY (KI,IO%NGROUND_LAYER))
+ ALLOCATE(K%XCONDSLD (KI,IO%NGROUND_LAYER))
+ !
+ CALL HEATCAPZ(K%XSAND,K%XHCAPSOIL)
+ CALL THRMCONDZ(K%XSAND,K%XWSAT,K%XCONDDRY,K%XCONDSLD)
+ ELSE
+ ALLOCATE(K%XHCAPSOIL(0,0))
+ ALLOCATE(K%XCONDDRY (0,0))
+ ALLOCATE(K%XCONDSLD (0,0))
+ END IF
!
ENDIF
!
-DO JPATCH=1,KPATCH
- KSIZE_NATURE_P(JPATCH) = COUNT(PPATCH(:,JPATCH) > 0.0)
-ENDDO
+!CSCOND used in soil.F90 and soildif.F90
!
-KR_NATURE_P(:,:) = 0
-DO JPATCH=1,KPATCH
- ALLOCATE(IR_NATURE_P(KSIZE_NATURE_P(JPATCH)))
- CALL GET_1D_MASK(KSIZE_NATURE_P(JPATCH),KI,PPATCH(:,JPATCH),IR_NATURE_P)
- KR_NATURE_P(:KSIZE_NATURE_P(JPATCH),JPATCH) = IR_NATURE_P(:)
- DEALLOCATE(IR_NATURE_P)
-ENDDO
+IF (IO%CSCOND=='NP89'.AND.IO%CISBA=='DIF') THEN
+ WRITE(KLUOUT,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ WRITE(KLUOUT,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ WRITE(KLUOUT,*)'IF CISBA=DIF, CSCOND=NP89 is not available'
+ WRITE(KLUOUT,*)'because not physic. CSCOND is put to PL98 '
+ WRITE(KLUOUT,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ WRITE(KLUOUT,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ENDIF
!
+!CPSURF used in drag.F90
+!CPL_ARP used in drag.F90 and e_budget.F90
+IF(IO%CCPSURF=='DRY'.AND.LCPL_ARP) THEN
+ CALL ABOR1_SFX('CCPSURF=DRY must not be used with LCPL_ARP')
+ENDIF
!
-!* 2.6 Miscellaneous fields for ISBA:
-! -----------------------------
+!------------------------------------------------------------------------------------
+!------------------------------------------------------------------------------------
+!
+! PART 2: fields that are needed only packed: defined packed directly
+! -------------------------------------------------------------------
+!
+! PART 2: A: fields that don't depend on patches: KK, AGK, ISSK
+! -------------------------------------------------------------
+!
+!* 2.A.1. Miscellaneous fields for ISBA:
+! ----------------------------------------
!
!* default value for:
! lateral water flux, deep soil temperature climatology and its relaxation time-scale
!
-ALLOCATE(PTDEEP (KI))
-ALLOCATE(PGAMMAT(KI))
-PTDEEP (:) = XUNDEF
-PGAMMAT(:) = XUNDEF
+!these arrays are used only packed: we define them directly packed
+ALLOCATE(KK%XTDEEP (KSIZE))
+ALLOCATE(KK%XGAMMAT(KSIZE))
+KK%XTDEEP (:) = XUNDEF
+KK%XGAMMAT(:) = XUNDEF
!
IF (ODEEPSOIL) THEN
- DO JILU = 1, KI
- PTDEEP (JILU) = PTDEEP_CLI (KMONTH)
- PGAMMAT(JILU) = 1. / PGAMMAT_CLI(KMONTH)
- END DO
- !
- WRITE(KLUOUT,*)' LDEEPSOIL = ',ODEEPSOIL,' LPHYSDOMC = ',OPHYSDOMC
- WRITE(KLUOUT,*)' XTDEEP = ',MINVAL(PTDEEP(:)),MAXVAL(PTDEEP(:))
- WRITE(KLUOUT,*)' XGAMMAT = ',MINVAL(PGAMMAT(:)),MAXVAL(PGAMMAT(:))
+ DO JILU = 1, KSIZE
+ KK%XTDEEP (JILU) = PTDEEP_CLI (KMONTH)
+ KK%XGAMMAT(JILU) = 1. / PGAMMAT_CLI(KMONTH)
+ END DO
+ !
+ WRITE(KLUOUT,*)' LDEEPSOIL = ',ODEEPSOIL,' LPHYSDOMC = ',OPHYSDOMC
+ WRITE(KLUOUT,*)' XTDEEP = ',MINVAL(KK%XTDEEP(:)) ,MAXVAL(KK%XTDEEP(:))
+ WRITE(KLUOUT,*)' XGAMMAT = ',MINVAL(KK%XGAMMAT(:)),MAXVAL(KK%XGAMMAT(:))
ENDIF
!
!
-!* 2.7 Irrigation
-! ----------
+!* 2.A.2. Initialize hydrology
+! ---------------------------
!
-IF (OAGRIP) THEN
- ALLOCATE(KIRRINUM(KI,KPATCH))
- ALLOCATE(OIRRIDAY(KI,KPATCH))
- ALLOCATE(OIRRIGATE(KI,KPATCH))
- ALLOCATE(PTHRESHOLDSPT(KI,KPATCH))
- !
- KIRRINUM (:,:) = 1
- OIRRIDAY (:,:) = .FALSE.
- OIRRIGATE(:,:) = .FALSE.
- !
- DO JILU = 1, KI
- DO JPATCH = 1, KPATCH
- PTHRESHOLDSPT(JILU,JPATCH) = PTHRESHOLD(KIRRINUM(JILU,JPATCH))
- END DO
- END DO
+IF (IO%CISBA == 'DIF') THEN
+ !
+ ALLOCATE(KK%XFWTD(KSIZE))
+ ALLOCATE(KK%XWTD (KSIZE))
+ KK%XFWTD(:) = 0.0
+ KK%XWTD (:) = XUNDEF
+ !
ELSE
- ALLOCATE(KIRRINUM(0,0))
- ALLOCATE(OIRRIDAY(0,0))
- ALLOCATE(OIRRIGATE(0,0))
- ALLOCATE(PTHRESHOLDSPT(0,0))
+ !
+ ALLOCATE(KK%XFWTD(0))
+ ALLOCATE(KK%XWTD (0))
+ !
ENDIF
!
!
-!* 2.8 Additional fields for ISBA-AGS:
-! ------------------------------
+!* Physiographic Radiative fields:
+! ------------------------------
!
-IF(HPHOTO /= 'NON' .AND. HINIT == 'ALL') THEN
- IF (OTR_ML) THEN
- ISIZE = 10
- ELSE
- ISIZE = 3
- ENDIF
- ALLOCATE(PABC(ISIZE))
- ALLOCATE(PPOI(ISIZE))
- PABC(:) = 0.
- PPOI(:) = 0.
- ZCO2(:) = PCO2(:) / PRHOA(:)
- ALLOCATE(PANMAX (KI,KPATCH))
- ALLOCATE(PFZERO (KI,KPATCH))
- ALLOCATE(PEPSO (KI,KPATCH))
- ALLOCATE(PGAMM (KI,KPATCH))
- ALLOCATE(PQDGAMM (KI,KPATCH))
- ALLOCATE(PQDGMES (KI,KPATCH))
- ALLOCATE(PT1GMES (KI,KPATCH))
- ALLOCATE(PT2GMES (KI,KPATCH))
- ALLOCATE(PAMAX (KI,KPATCH))
- ALLOCATE(PQDAMAX (KI,KPATCH))
- ALLOCATE(PT1AMAX (KI,KPATCH))
- ALLOCATE(PT2AMAX (KI,KPATCH))
- ALLOCATE(PAH (KI,KPATCH))
- ALLOCATE(PBH (KI,KPATCH))
- ALLOCATE(PTAU_WOOD (KI,KPATCH))
- ALLOCATE(PINCREASE (KI,KNBIOMASS,KPATCH))
- ALLOCATE(PTURNOVER (KI,KNBIOMASS,KPATCH))
- CALL CO2_INIT_n(I, &
- HPHOTO, KSIZE_NATURE_P, KR_NATURE_P, PVEGTYPE_PATCH, &
- ZCO2, PGMES, PGC, PDMAX, PABC, PPOI, PANMAX, &
- PFZERO, PEPSO, PGAMM, PQDGAMM, PQDGMES, &
- PT1GMES, PT2GMES, PAMAX, PQDAMAX, &
- PT1AMAX, PT2AMAX, PAH, PBH, PTAU_WOOD, &
- PINCREASE, PTURNOVER )
-
-ELSEIF(HPHOTO == 'NON' .AND. OTR_ML)THEN ! Case for MEB
- ISIZE = 10
- ALLOCATE (PABC(ISIZE))
- ALLOCATE (PPOI(ISIZE)) ! Working
- PABC(:) = 0.
- PPOI(:) = 0.
- CALL GAULEG(0.0,1.0,PABC,PPOI,SIZE(PABC))
- DEALLOCATE (PPOI)
- ALLOCATE (PPOI(0))
-ELSE
- ALLOCATE(PABC(0))
- ALLOCATE(PPOI(0))
- ALLOCATE(PANMAX (0,0))
- ALLOCATE(PFZERO (0,0))
- ALLOCATE(PEPSO (0,0))
- ALLOCATE(PGAMM (0,0))
- ALLOCATE(PQDGAMM (0,0))
- ALLOCATE(PQDGMES (0,0))
- ALLOCATE(PT1GMES (0,0))
- ALLOCATE(PT2GMES (0,0))
- ALLOCATE(PAMAX (0,0))
- ALLOCATE(PQDAMAX (0,0))
- ALLOCATE(PT1AMAX (0,0))
- ALLOCATE(PT2AMAX (0,0))
- ALLOCATE(PAH (0,0))
- ALLOCATE(PBH (0,0))
- ALLOCATE(PTAU_WOOD (0,0))
- ALLOCATE(PINCREASE (0,0,0))
- ALLOCATE(PTURNOVER (0,0,0))
-END IF
!
-!-------------------------------------------------------------------------------
+!* 2.A.3. dry and wet bare soil albedos
+! ------------------------------------
!
-! 3. Initialize Chemical Deposition
-! ------------------------------
+ALLOCATE(KK%XALBNIR_DRY (KSIZE))
+ALLOCATE(KK%XALBVIS_DRY (KSIZE))
+ALLOCATE(KK%XALBUV_DRY (KSIZE))
+ALLOCATE(KK%XALBNIR_WET (KSIZE))
+ALLOCATE(KK%XALBVIS_WET (KSIZE))
+ALLOCATE(KK%XALBUV_WET (KSIZE))
!
-! 3.1 Chemical gazes
-! --------------
+ CALL DRY_WET_SOIL_ALBEDOS(KK )
!
- !* for the time being, chemistry on vegetation works only for
- ! ISBA on nature tile (not for gardens), because subroutine INIT_CHEMICAL_n
- ! contains explicitely modules from ISBAn. It should be cleaned in a future
- ! version.
-IF (HSURF=='NATURE') THEN
- CALL INIT_CHEMICAL_n(KLUOUT, KSV, HSV, YSV, HCH_NAMES, HAER_NAMES, &
- HDSTNAMES=HDSTNAMES, HSLTNAMES=HSLTNAMES )
-END IF
+
!
-IF (KSV /= 0) THEN
- !
- IF (HSURF=='NATURE' .AND. YSV%NBEQ > 0) THEN
- !* for the time being, chemistry deposition on vegetation works only for
- ! ISBA on nature tile (not for gardens), because subroutine CH_INIT_DEP_ISBA_n
- ! contains explicitely modules from ISBAn. It should be cleaned in a future
- ! version.
- CALL OPEN_NAMELIST(HPROGRAM, ICH, HFILE=HCHEM_SURF_FILE)
- CALL CH_INIT_DEP_ISBA_n(CHI, DTCO, I, &
- ICH, KLUOUT, KI)
- CALL CLOSE_NAMELIST(HPROGRAM, ICH)
- END IF
+!* 2.A.4. Irrigation
+! -----------------
+!
+IF (OAGRIP) THEN
!
- IF (YSV%NDSTEQ >=1) THEN
- ALLOCATE (PSFDST (KI, YSV%NDSTEQ, KPATCH)) !Output array
- ALLOCATE (PSFDSTM(KI, YSV%NDSTEQ, KPATCH)) !Output array
- PSFDST(:,:,:) = 0.
- PSFDSTM(:,:,:) = 0.
- CALL INIT_DST(DST, U, &
- HPROGRAM,KSIZE_NATURE_P,KR_NATURE_P, &
- KPATCH,PVEGTYPE_PATCH)
- ELSE
- ALLOCATE(PSFDST (0,0,0))
- ALLOCATE(PSFDSTM(0,0,0))
- END IF
+ ALLOCATE(AGK%NIRRINUM (KSIZE))
+ ALLOCATE(AGK%LIRRIDAY (KSIZE))
+ ALLOCATE(AGK%LIRRIGATE (KSIZE))
+ ALLOCATE(AGK%XTHRESHOLDSPT(KSIZE))
!
- IF (YSV%NSLTEQ >=1) THEN
- ALLOCATE (PSFSLT(KI,YSV%NSLTEQ,KPATCH)) !Output array
- CALL INIT_SLT(SLT, &
- HPROGRAM)
- ELSE
- ALLOCATE(PSFSLT(0,0,0))
- END IF
+ AGK%NIRRINUM (:) = 1
+ AGK%LIRRIDAY (:) = .FALSE.
+ AGK%LIRRIGATE(:) = .FALSE.
!
+ DO JILU = 1, KSIZE
+ AGK%XTHRESHOLDSPT(JILU) = PTHRESHOLD(AGK%NIRRINUM(JILU))
+ END DO
+ELSE
+ ALLOCATE(AGK%NIRRINUM (0))
+ ALLOCATE(AGK%LIRRIDAY (0))
+ ALLOCATE(AGK%LIRRIGATE (0))
+ ALLOCATE(AGK%XTHRESHOLDSPT(0))
ENDIF
!
-!-------------------------------------------------------------------------------
+!* 2.A.5. Orographic roughness length
+! ----------------------------------
!
-!* 4. Orographic roughness length
-! ---------------------------
+ALLOCATE(ISSK%XZ0EFFIP(KSIZE))
+ALLOCATE(ISSK%XZ0EFFIM(KSIZE))
+ALLOCATE(ISSK%XZ0EFFJP(KSIZE))
+ALLOCATE(ISSK%XZ0EFFJM(KSIZE))
!
-ALLOCATE(PZ0EFFIP(KI,KPATCH))
-ALLOCATE(PZ0EFFIM(KI,KPATCH))
-ALLOCATE(PZ0EFFJP(KI,KPATCH))
-ALLOCATE(PZ0EFFJM(KI,KPATCH))
-ALLOCATE(PZ0REL (KI))
+ISSK%XZ0EFFIP(:) = XUNDEF
+ISSK%XZ0EFFIM(:) = XUNDEF
+ISSK%XZ0EFFJP(:) = XUNDEF
+ISSK%XZ0EFFJM(:) = XUNDEF
!
-IF (SIZE(PAOSIP)>0) &
- CALL SUBSCALE_Z0EFF(PAOSIP,PAOSIM,PAOSJP,PAOSJM, &
- PHO2IP,PHO2IM,PHO2JP,PHO2JM,PZ0, &
- PZ0EFFIP,PZ0EFFIM,PZ0EFFJP,PZ0EFFJM, &
- PZ0REL )
+IF (SIZE(ISSK%XAOSIP)>0) CALL SUBSCALE_Z0EFF(ISSK,PEK%XZ0,.FALSE.)
!
-!-------------------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+! PART 2: B: fields that depend on patches: PK, PEK
+! -------------------------------------------------
!
-!* 5.1 Soil hydraulic characteristics:
-! -------------------------------
-!
-ALLOCATE(PCONDSAT (KI,KGROUND_LAYER,KPATCH))
-ALLOCATE(PMPOTSAT (KI,KGROUND_LAYER))
-ALLOCATE(PBCOEF (KI,KGROUND_LAYER))
-ALLOCATE(PWWILT (KI,KGROUND_LAYER)) ! wilting point
-ALLOCATE(PWFC (KI,KGROUND_LAYER)) ! field capacity
-ALLOCATE(PWSAT (KI,KGROUND_LAYER)) ! saturation
-ALLOCATE(PTAUICE (KI))
-!
-DO JLAYER=1,KGROUND_LAYER
- PBCOEF (:,JLAYER) = BCOEF_FUNC (PCLAY(:,JLAYER),PSAND(:,JLAYER),HPEDOTF)
- PMPOTSAT(:,JLAYER) = MATPOTSAT_FUNC (PCLAY(:,JLAYER),PSAND(:,JLAYER),HPEDOTF)
- DO JPATCH=1,KPATCH
- PCONDSAT(:,JLAYER,JPATCH) = HYDCONDSAT_FUNC(PCLAY(:,JLAYER),PSAND(:,JLAYER),HPEDOTF)
- ENDDO
- PWSAT (:,JLAYER) = WSAT_FUNC (PCLAY(:,JLAYER),PSAND(:,JLAYER),HPEDOTF)
- PWWILT(:,JLAYER) = WWILT_FUNC(PCLAY(:,JLAYER),PSAND(:,JLAYER),HPEDOTF)
-END DO
-!
-IF (HISBA=='2-L' .OR. HISBA=='3-L') THEN
- ! field capacity at hydraulic conductivity = 0.1mm/day
- PWFC(:,:) = WFC_FUNC(PCLAY(:,:),PSAND(:,:),HPEDOTF)
-ELSE IF (HISBA=='DIF') THEN
- ! field capacity at water potential = 0.33bar
- PWFC(:,:) = W33_FUNC(PCLAY(:,:),PSAND(:,:),HPEDOTF)
-END IF
!
-PTAUICE(:) = XTAU_ICE
-!
-IF (HISBA=='2-L' .OR. HISBA=='3-L') THEN
- ALLOCATE(PCGSAT (KI))
- ALLOCATE(PC1SAT (KI,KPATCH))
- ALLOCATE(PC2REF (KI,KPATCH))
- ALLOCATE(PC3 (KI,2,KPATCH))
- ALLOCATE(PC4B (KI))
- ALLOCATE(PACOEF (KI))
- ALLOCATE(PPCOEF (KI))
- ALLOCATE(PC4REF (KI,KPATCH))
- PCGSAT(:) = CGSAT_FUNC(PCLAY(:,1),PSAND(:,1))
- PC4B(:) = C4B_FUNC(PCLAY(:,1))
+!* 2.B.1. Additional fields for ISBA-AGS:
+! --------------------------------------
+!
+IF(IO%CPHOTO /= 'NON' .AND. HINIT == 'ALL') THEN
!
- PACOEF(:) = ACOEF_FUNC(PCLAY(:,1))
- PPCOEF(:) = PCOEF_FUNC(PCLAY(:,1))
+ IF (.NOT.ASSOCIATED(S%XABC)) THEN
+ IF (IO%LTR_ML) THEN
+ IABC = 10
+ ELSE
+ IABC = 3
+ ENDIF
+ ALLOCATE(S%XABC(IABC))
+ ALLOCATE(S%XPOI(IABC))
+ S%XABC(:) = 0.
+ S%XPOI(:) = 0.
+ CALL GAULEG(0.0,1.0,S%XABC,S%XPOI,IABC)
+ ENDIF
!
- DO JPATCH=1,KPATCH
- PC1SAT(:,JPATCH) = C1SAT_FUNC(PCLAY(:,1))
- PC2REF(:,JPATCH) = C2REF_FUNC(PCLAY(:,1))
- PC4REF(:,JPATCH) = C4REF_FUNC(PCLAY(:,1),PSAND(:,1), &
- PDG(:,2, JPATCH), &
- PDG(:,KGROUND_LAYER,JPATCH) )
- PC3 (:,1,JPATCH) = C3_FUNC(PCLAY(:,1))
- PC3 (:,2,JPATCH) = C3_FUNC(PCLAY(:,2))
-
- END DO
+ ZCO2(:) = PCO2(:) / PRHOA(:)
+ ALLOCATE(PK%XANMAX (KSIZE))
+ ALLOCATE(PK%XFZERO (KSIZE))
+ ALLOCATE(PK%XEPSO (KSIZE))
+ ALLOCATE(PK%XGAMM (KSIZE))
+ ALLOCATE(PK%XQDGAMM (KSIZE))
+ ALLOCATE(PK%XQDGMES (KSIZE))
+ ALLOCATE(PK%XT1GMES (KSIZE))
+ ALLOCATE(PK%XT2GMES (KSIZE))
+ ALLOCATE(PK%XAMAX (KSIZE))
+ ALLOCATE(PK%XQDAMAX (KSIZE))
+ ALLOCATE(PK%XT1AMAX (KSIZE))
+ ALLOCATE(PK%XT2AMAX (KSIZE))
+ ALLOCATE(PK%XAH (KSIZE))
+ ALLOCATE(PK%XBH (KSIZE))
+ ALLOCATE(PK%XTAU_WOOD (KSIZE))
+ ALLOCATE(PK%XINCREASE (KSIZE,IO%NNBIOMASS))
+ ALLOCATE(PK%XTURNOVER (KSIZE,IO%NNBIOMASS))
+ CALL CO2_INIT_n(IO, S, PK, PEK, KSIZE, ZCO2 )
+ !
+ELSEIF(IO%CPHOTO == 'NON' .AND. IO%LTR_ML) THEN ! Case for MEB
+ !
+ IF (.NOT.ASSOCIATED(S%XABC)) THEN
+ IABC = 10
+ ALLOCATE (S%XABC(IABC))
+ ALLOCATE (S%XPOI(IABC)) ! Working
+ S%XABC(:) = 0.
+ S%XPOI(:) = 0.
+ CALL GAULEG(0.0,1.0,S%XABC,S%XPOI,IABC)
+ DEALLOCATE (S%XPOI)
+ ALLOCATE (S%XPOI(0))
+ ENDIF
+ !
+ELSE
!
-ELSE IF (HISBA=='DIF') THEN
+ IF (.NOT.ASSOCIATED(S%XABC)) THEN
+ ALLOCATE(S%XABC(0))
+ ALLOCATE(S%XPOI(0))
+ ENDIF
!
- ALLOCATE(PCGSAT (0))
- ALLOCATE(PC1SAT (0,0))
- ALLOCATE(PC2REF (0,0))
- ALLOCATE(PC3 (0,0,0))
- ALLOCATE(PC4B (0))
- ALLOCATE(PC4REF (0,0))
- ALLOCATE(PACOEF (0))
- ALLOCATE(PPCOEF (0))
+ ALLOCATE(PK%XANMAX (0))
+ ALLOCATE(PK%XFZERO (0))
+ ALLOCATE(PK%XEPSO (0))
+ ALLOCATE(PK%XGAMM (0))
+ ALLOCATE(PK%XQDGAMM (0))
+ ALLOCATE(PK%XQDGMES (0))
+ ALLOCATE(PK%XT1GMES (0))
+ ALLOCATE(PK%XT2GMES (0))
+ ALLOCATE(PK%XAMAX (0))
+ ALLOCATE(PK%XQDAMAX (0))
+ ALLOCATE(PK%XT1AMAX (0))
+ ALLOCATE(PK%XT2AMAX (0))
+ ALLOCATE(PK%XAH (0))
+ ALLOCATE(PK%XBH (0))
+ ALLOCATE(PK%XTAU_WOOD (0))
+ ALLOCATE(PK%XINCREASE (0,0))
+ ALLOCATE(PK%XTURNOVER (0,0))
!
END IF
!
-IF(HRUNOFF=='SGH')THEN
-!
- ALLOCATE(PWD0 (KI,KGROUND_LAYER))
- ALLOCATE(PKANISO(KI,KGROUND_LAYER))
-!
- IF(HISBA=='DIF')THEN
- PWD0(:,:) = WFC_FUNC(PCLAY(:,:),PSAND(:,:),HPEDOTF)
- ELSE
- PWD0(:,:) = PWWILT(:,:)
- ENDIF
- PKANISO(:,:) = ANISO_FUNC(PCLAY(:,:))
-!
-ELSE
!
- ALLOCATE(PWD0 (0,0))
- ALLOCATE(PKANISO(0,0))
+!* 2.B.2. Soil hydraulic characteristics (rest) :
+! --------------------------------------------
!
-ENDIF
!
-!* 5.2 Soil thermal characteristics:
-! --------------------------------
+ALLOCATE(PK%XCONDSAT (KSIZE,IO%NGROUND_LAYER))
+ALLOCATE(PK%XTAUICE (KSIZE))
!
-ALLOCATE(PPCPS (KI,KPATCH))
-ALLOCATE(PPLVTT(KI,KPATCH))
-ALLOCATE(PPLSTT(KI,KPATCH))
-PPCPS (:,:) = XCPD
-PPLVTT(:,:) = XLVTT
-PPLSTT(:,:) = XLSTT
-!
-!CSCOND used in soil.F90 and soildif.F90
-!
-IF (HSCOND=='NP89'.AND.HISBA=='DIF') THEN
- WRITE(KLUOUT,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- WRITE(KLUOUT,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- WRITE(KLUOUT,*)'IF CISBA=DIF, CSCOND=NP89 is not available'
- WRITE(KLUOUT,*)'because not physic. CSCOND is put to PL98 '
- WRITE(KLUOUT,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- WRITE(KLUOUT,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+IF (DTI%LDATA_CONDSAT) THEN
+ CALL PACK_SAME_RANK(PK%NR_P,DTI%XPAR_CONDSAT(:,:),PK%XCONDSAT(:,:))
+ELSE
+ DO JL=1,IO%NGROUND_LAYER
+ PK%XCONDSAT(:,JL) = HYDCONDSAT_FUNC(KK%XCLAY(:,JL),KK%XSAND(:,JL),IO%CPEDOTF)
+ END DO
ENDIF
+PK%XTAUICE(:) = XTAU_ICE
!
-IF (HSCOND=='PL98'.OR.HISBA=='DIF') THEN
- ALLOCATE(PHCAPSOIL(KI,KGROUND_LAYER))
- ALLOCATE(PCONDDRY (KI,KGROUND_LAYER))
- ALLOCATE(PCONDSLD (KI,KGROUND_LAYER))
- !
- CALL HEATCAPZ(PSAND,PHCAPSOIL)
- CALL THRMCONDZ(PSAND,PWSAT,PCONDDRY,PCONDSLD)
+IF (IO%CISBA=='2-L' .OR. IO%CISBA=='3-L') THEN
+ !
+ ALLOCATE(PK%XC1SAT (KSIZE))
+ ALLOCATE(PK%XC2REF (KSIZE))
+ ALLOCATE(PK%XC3 (KSIZE,2))
+ ALLOCATE(PK%XC4REF (KSIZE))
+ PK%XC1SAT(:) = C1SAT_FUNC(KK%XCLAY(:,1))
+ PK%XC2REF(:) = C2REF_FUNC(KK%XCLAY(:,1))
+ PK%XC3 (:,1) = C3_FUNC (KK%XCLAY(:,1))
+ PK%XC3 (:,2) = C3_FUNC (KK%XCLAY(:,2))
+ !
+ PK%XC4REF(:) = C4REF_FUNC(KK%XCLAY(:,1),KK%XSAND(:,1),PK%XDG(:,2), &
+ PK%XDG(:,IO%NGROUND_LAYER) )
+ !
+ELSE IF (IO%CISBA=='DIF') THEN
+ !
+ ALLOCATE(PK%XC1SAT (0))
+ ALLOCATE(PK%XC2REF (0))
+ ALLOCATE(PK%XC3 (0,0))
+ ALLOCATE(PK%XC4REF (0))
!
-ELSE
- ALLOCATE(PHCAPSOIL(0,0))
- ALLOCATE(PCONDDRY (0,0))
- ALLOCATE(PCONDSLD (0,0))
END IF
!
-!-------------------------------------------------------------------------------
-!CPSURF used in drag.F90
-!CPL_ARP used in drag.F90 and e_budget.F90
-IF(HCPSURF=='DRY'.AND.LCPL_ARP) THEN
- CALL ABOR1_SFX('CCPSURF=DRY must not be used with LCPL_ARP')
-ENDIF
+ALLOCATE(PK%XCPS (KSIZE))
+ALLOCATE(PK%XLVTT(KSIZE))
+ALLOCATE(PK%XLSTT(KSIZE))
+PK%XCPS (:) = XCPD
+PK%XLVTT(:) = XLVTT
+PK%XLSTT(:) = XLSTT
!
-!* 6.1 Initialize hydrology
-! --------------------
!
-ALLOCATE(PRUNOFFD (KI,KPATCH))
-PRUNOFFD(:,:)=XUNDEF
+!* 2.B.3. Initialize hydrology
+! ----------------------------
!
-IF (HISBA == 'DIF') THEN
-!
- ALLOCATE(PDZG (KI,KGROUND_LAYER,KPATCH))
- ALLOCATE(PDZDIF (KI,KGROUND_LAYER,KPATCH))
- ALLOCATE(PSOILWGHT (KI,KGROUND_LAYER,KPATCH))
- CALL DIF_LAYER(KI, KGROUND_LAYER, KPATCH, KSIZE_NATURE_P, &
- PPATCH, PDG, PDROOT, PDG2, PROOTFRAC, &
- KWG_LAYER, PDZG, PDZDIF, PSOILWGHT, &
- PRUNOFFD, KLAYER_HORT, KLAYER_DUN )
-!
- ALLOCATE(PFWTD(KI))
- ALLOCATE(PWTD (KI))
- PFWTD(:) = 0.0
- PWTD (:) = XUNDEF
+ALLOCATE(PK%XRUNOFFD (KSIZE))
+PK%XRUNOFFD(:)=XUNDEF
!
-ELSE
-!
- ALLOCATE(PDZG (0,0,0))
- ALLOCATE(PDZDIF (0,0,0))
- ALLOCATE(PSOILWGHT (0,0,0))
- DO JPATCH=1,KPATCH
- WHERE(PPATCH(:,JPATCH)>0.0)
- PRUNOFFD(:,JPATCH) = PDG(:,2,JPATCH)
- ENDWHERE
- END DO
+IF (IO%CISBA == 'DIF') THEN
!
- KLAYER_DUN=2
- KLAYER_HORT=2
+ ALLOCATE(PK%XDZG (KSIZE,IO%NGROUND_LAYER))
+ ALLOCATE(PK%XDZDIF (KSIZE,IO%NGROUND_LAYER))
+ ALLOCATE(PK%XSOILWGHT (KSIZE,IO%NGROUND_LAYER))
+ CALL DIF_LAYER(KSIZE, IO, PK )
+!
+ELSEIF (COUNT(IO%LMEB_PATCH(:))/=0) THEN
+!
+ ALLOCATE(PK%XDZG (KSIZE,IO%NGROUND_LAYER))
+ CALL DIF_LAYER(KSIZE, IO, PK, OMEB_3L = .TRUE.)
!
- ALLOCATE(PFWTD(0))
- ALLOCATE(PWTD (0))
+ELSE
+!
+ ALLOCATE(PK%XDZG (0,0))
+ ALLOCATE(PK%XDZDIF (0,0))
+ ALLOCATE(PK%XSOILWGHT (0,0))
+ !
+ WHERE(PK%XPATCH(:)>0.0)
+ PK%XRUNOFFD(:) = PK%XDG(:,2)
+ ENDWHERE
!
ENDIF
!
!Horton (also used by the flooding sheme)
!
-ALLOCATE(PKSAT_ICE(KI,KPATCH))
+ALLOCATE(PK%XKSAT_ICE(KSIZE))
!
-IF(HISBA/='DIF')THEN
- PD_ICE (:,:)=MIN(PDG(:,2,:),PD_ICE(:,:))
- PD_ICE (:,:)=MAX(XICE_DEPH_MAX,PD_ICE(:,:))
- PKSAT_ICE(:,:)=PCONDSAT(:,1,:)
+IF(IO%CISBA/='DIF')THEN
+ PK%XD_ICE (:) = MIN(PK%XDG(:,2),PK%XD_ICE(:))
+ PK%XD_ICE (:) = MAX(XICE_DEPH_MAX,PK%XD_ICE(:))
+ PK%XKSAT_ICE(:) = PK%XCONDSAT(:,1)
ELSE
- PD_ICE (:,:)=0.0
- PKSAT_ICE(:,:)=0.0
+ PK%XD_ICE (:) = 0.0
+ PK%XKSAT_ICE(:) = 0.0
ENDIF
!
!-------------------------------------------------------------------------------
!
-!* 8. Physiographic Radiative fields:
-! ------------------------------
-!
-!
-!* dry and wet bare soil albedos
-!
-ALLOCATE(PALBNIR_DRY (KI))
-ALLOCATE(PALBVIS_DRY (KI))
-ALLOCATE(PALBUV_DRY (KI))
-ALLOCATE(PALBNIR_WET (KI))
-ALLOCATE(PALBVIS_WET (KI))
-ALLOCATE(PALBUV_WET (KI))
-!
- CALL DRY_WET_SOIL_ALBEDOS(PSAND(:,1),PCLAY(:,1), &
- PVEGTYPE, &
- PALBNIR_DRY,PALBVIS_DRY,PALBUV_DRY, &
- PALBNIR_WET,PALBVIS_WET,PALBUV_WET )
-!
+!* Physiographic Radiative fields:
+! ------------------------------
!
+
!
-!* 2.9 Nitrogen version for isbaAgs
-! ------------------------------
+!* 2.B.4. Nitrogen version for isbaAgs
+! ------------------------------------
!
-IF (HPHOTO=='NIT' .OR. HPHOTO=='NCB') THEN
- ALLOCATE(PBSLAI_NITRO (KI,KPATCH ))
- WHERE ((PCE_NITRO (:,:)*PCNA_NITRO(:,:)+PCF_NITRO (:,:)) /= 0. )
- PBSLAI_NITRO(:,:) = 1. / (PCE_NITRO (:,:)*PCNA_NITRO(:,:)+PCF_NITRO (:,:))
+IF (IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') THEN
+ ALLOCATE(PK%XBSLAI_NITRO (KSIZE ))
+ WHERE ((PEK%XCE_NITRO(:) * PEK%XCNA_NITRO(:) + PEK%XCF_NITRO (:)) /= 0. )
+ PK%XBSLAI_NITRO(:) = 1. / (PEK%XCE_NITRO (:)*PEK%XCNA_NITRO(:)+PEK%XCF_NITRO (:))
ELSEWHERE
- PBSLAI_NITRO(:,:) = XUNDEF
+ PK%XBSLAI_NITRO(:) = XUNDEF
ENDWHERE
ELSE
- ALLOCATE(PBSLAI_NITRO (0,0))
+ ALLOCATE(PK%XBSLAI_NITRO (0))
ENDIF
!
IF (LHOOK) CALL DR_HOOK('INIT_VEG_PGD_n',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/init_vegn.F90 b/src/SURFEX/init_vegn.F90
index d329bb462e1befe6eb46aa9f52c93d7696c49303..6ac370778adddc9040a22e08e67a7395131570b1 100644
--- a/src/SURFEX/init_vegn.F90
+++ b/src/SURFEX/init_vegn.F90
@@ -3,13 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#############################################################
-SUBROUTINE INIT_VEG_n(KPATCH, KI, OCANOPY, HROUGH, OAGRI_TO_GRASS, TPSNOW, &
- HPHOTO, OIMP_VEG, OIMP_Z0, OIMP_EMIS, &
- PLAIMIN, PH_TREE, PVEGTYPE_PATCH, PLAI, PZ0, PVEG, PEMIS, &
- OTR_ML, PFAPARC, PFAPIRC, PLAI_EFFC, PMUS, &
- PALBNIR_SOIL, PALBVIS_SOIL, PALBUV_SOIL, PALBNIR, PALBVIS, PALBUV, &
- OSURF_DIAG_ALBEDO, PPSN, PPSNG, PPSNV, PPSNV_A, &
- PDIR_ALB, PSCA_ALB, PEMIS_OUT, PTSRAD )
+SUBROUTINE INIT_VEG_n(IO, KK, PK, PEK, DTV, &
+ OSURF_DIAG_ALBEDO, PDIR_ALB, PSCA_ALB, PEMIS_OUT, PTSRAD )
!#############################################################
!
!!**** *INIT_VEG_n* - routine to initialize ISBA
@@ -38,17 +33,19 @@ SUBROUTINE INIT_VEG_n(KPATCH, KI, OCANOPY, HROUGH, OAGRI_TO_GRASS, TPSNOW, &
!! MODIFICATIONS
!!
!! B. Decharme 01/16 : Bug when vegetation veg, z0 and emis are imposed whith interactive vegetation
-!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+!
USE MODD_TYPE_SNOW
USE MODD_SNOW_PAR, ONLY : XEMISSN
USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
!
-USE MODI_SET_ROUGH
USE MODI_INIT_SNOW_LW
USE MODI_Z0V_FROM_LAI
USE MODI_VEG_FROM_LAI
@@ -62,47 +59,14 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-INTEGER, INTENT(IN) :: KPATCH
-INTEGER, INTENT(IN) :: KI
-LOGICAL, INTENT(IN) :: OCANOPY
- CHARACTER(LEN=4), INTENT(INOUT) :: HROUGH
-LOGICAL, INTENT(IN) :: OAGRI_TO_GRASS
-TYPE(SURF_SNOW), INTENT(INOUT) :: TPSNOW ! snow characteristics
-!
- CHARACTER(LEN=3), INTENT(IN) :: HPHOTO
-!
-LOGICAL, INTENT(IN) :: OIMP_VEG
-LOGICAL, INTENT(IN) :: OIMP_Z0
-LOGICAL, INTENT(IN) :: OIMP_EMIS
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PLAIMIN
-REAL, DIMENSION(:,:), INTENT(IN) :: PH_TREE
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVEGTYPE_PATCH
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PLAI
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZ0
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PVEG
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PEMIS
-!
-LOGICAL, INTENT(IN) :: OTR_ML
-REAL, DIMENSION(:,:), POINTER :: PFAPARC
-REAL, DIMENSION(:,:), POINTER :: PFAPIRC
-REAL, DIMENSION(:,:), POINTER :: PLAI_EFFC
-REAL, DIMENSION(:,:), POINTER :: PMUS
-!
-REAL, DIMENSION(:,:), POINTER :: PALBNIR_SOIL
-REAL, DIMENSION(:,:), POINTER :: PALBVIS_SOIL
-REAL, DIMENSION(:,:), POINTER :: PALBUV_SOIL
-REAL, DIMENSION(:,:), POINTER :: PALBNIR
-REAL, DIMENSION(:,:), POINTER :: PALBVIS
-REAL, DIMENSION(:,:), POINTER :: PALBUV
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
!
LOGICAL, INTENT(OUT) :: OSURF_DIAG_ALBEDO
!
-REAL, DIMENSION(:,:), POINTER :: PPSN
-REAL, DIMENSION(:,:), POINTER :: PPSNG
-REAL, DIMENSION(:,:), POINTER :: PPSNV
-REAL, DIMENSION(:,:), POINTER :: PPSNV_A
-!
REAL, DIMENSION(:,:), INTENT(OUT) :: PDIR_ALB
REAL, DIMENSION(:,:), INTENT(OUT) :: PSCA_ALB
REAL, DIMENSION(:), INTENT(OUT) :: PEMIS_OUT
@@ -111,8 +75,7 @@ REAL, DIMENSION(:), INTENT(OUT) :: PTSRAD
!* 0.2 Declarations of local variables
! -------------------------------
!
-INTEGER :: JPATCH ! loop counter on tiles
-INTEGER :: JILU ! loop increment
+INTEGER :: JI ! loop increment
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -124,93 +87,81 @@ IF (LHOOK) CALL DR_HOOK('INIT_VEG_n',0,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
!
-!* 1. Roughness length option
-! -----------------------
-!
- CALL SET_ROUGH(OCANOPY,HROUGH)
-!
-!-------------------------------------------------------------------------------
-!
!* 2. Radiative fields and snow/flood fracion initialization:
! -------------------------------------------------------
!
!* snow long-wave properties (not initialized in read_gr_snow)
!
- CALL INIT_SNOW_LW(XEMISSN,TPSNOW)
+ CALL INIT_SNOW_LW(XEMISSN,PEK%TSNOW)
!
!-------------------------------------------------------------------------------
!
!* z0 and vegetation fraction estimated from LAI if not imposed
-IF (HPHOTO=='LAI' .OR. HPHOTO=='LST' .OR. HPHOTO=='NIT' .OR. HPHOTO=='NCB') THEN
- DO JPATCH=1,KPATCH
- DO JILU=1,KI
- IF(PLAI(JILU,JPATCH)/=XUNDEF) THEN
- PLAI (JILU,JPATCH) = MAX(PLAIMIN(JILU,JPATCH),PLAI(JILU,JPATCH))
- END IF
- IF(.NOT.OIMP_Z0.AND.PLAI(JILU,JPATCH)/=XUNDEF) THEN
- PZ0 (JILU,JPATCH) = Z0V_FROM_LAI(PLAI(JILU,JPATCH),PH_TREE(JILU,JPATCH),PVEGTYPE_PATCH(JILU,:,JPATCH),OAGRI_TO_GRASS)
- END IF
- IF(.NOT.OIMP_VEG.AND.PLAI(JILU,JPATCH)/=XUNDEF) THEN
- PVEG (JILU,JPATCH) = VEG_FROM_LAI(PLAI(JILU,JPATCH),PVEGTYPE_PATCH(JILU,:,JPATCH),OAGRI_TO_GRASS)
- END IF
- IF(.NOT.OIMP_EMIS.AND.PLAI(JILU,JPATCH)/=XUNDEF) THEN
- PEMIS(JILU,JPATCH) = EMIS_FROM_VEG(PVEG(JILU,JPATCH),PVEGTYPE_PATCH(JILU,:,JPATCH))
- END IF
- END DO
+IF (IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') THEN
+ DO JI=1,PK%NSIZE_P
+ IF(PEK%XLAI(JI)/=XUNDEF) THEN
+ PEK%XLAI (JI) = MAX(PEK%XLAIMIN(JI),PEK%XLAI(JI))
+ IF (.NOT.DTV%LIMP_Z0) &
+ PEK%XZ0 (JI) = Z0V_FROM_LAI(PEK%XLAI(JI),PK%XH_TREE(JI),PK%XVEGTYPE_PATCH(JI,:),IO%LAGRI_TO_GRASS)
+ IF (.NOT.DTV%LIMP_VEG) &
+ PEK%XVEG (JI) = VEG_FROM_LAI(PEK%XLAI(JI),PK%XVEGTYPE_PATCH(JI,:),IO%LAGRI_TO_GRASS)
+ IF (.NOT.DTV%LIMP_EMIS) &
+ PEK%XEMIS(JI) = EMIS_FROM_VEG(PEK%XVEG(JI),PK%XVEGTYPE_PATCH(JI,:))
+ END IF
END DO
END IF
!
!-------------------------------------------------------------------------------
!
-IF (OTR_ML) THEN
- ALLOCATE(PFAPARC (KI, KPATCH))
- ALLOCATE(PFAPIRC (KI, KPATCH))
- ALLOCATE(PLAI_EFFC (KI, KPATCH))
- ALLOCATE(PMUS (KI, KPATCH))
- PFAPARC (:,:) = 0.
- PFAPIRC (:,:) = 0.
- PLAI_EFFC (:,:) = 0.
- PMUS (:,:) = 0.
+IF (IO%LTR_ML) THEN
+ ALLOCATE(PEK%XFAPARC (PK%NSIZE_P))
+ ALLOCATE(PEK%XFAPIRC (PK%NSIZE_P))
+ ALLOCATE(PEK%XLAI_EFFC (PK%NSIZE_P))
+ ALLOCATE(PEK%XMUS (PK%NSIZE_P))
+ PEK%XFAPARC (:) = 0.
+ PEK%XFAPIRC (:) = 0.
+ PEK%XLAI_EFFC (:) = 0.
+ PEK%XMUS (:) = 0.
ELSE
- ALLOCATE(PFAPARC (0,0))
- ALLOCATE(PFAPIRC (0,0))
- ALLOCATE(PLAI_EFFC (0,0))
- ALLOCATE(PMUS (0,0))
+ ALLOCATE(PEK%XFAPARC (0))
+ ALLOCATE(PEK%XFAPIRC (0))
+ ALLOCATE(PEK%XLAI_EFFC (0))
+ ALLOCATE(PEK%XMUS (0))
ENDIF
!
!-------------------------------------------------------------------------------
!
!* albedo per tile and averaged albedo, emissivity and radiative temperature
!
-ALLOCATE(PALBNIR_SOIL(KI,KPATCH))
-ALLOCATE(PALBVIS_SOIL(KI,KPATCH))
-ALLOCATE(PALBUV_SOIL (KI,KPATCH))
-ALLOCATE(PALBNIR (KI,KPATCH))
-ALLOCATE(PALBVIS (KI,KPATCH))
-ALLOCATE(PALBUV (KI,KPATCH))
-PALBNIR_SOIL(:,:) = XUNDEF
-PALBVIS_SOIL(:,:) = XUNDEF
-PALBUV_SOIL (:,:) = XUNDEF
-PALBNIR (:,:) = XUNDEF
-PALBVIS (:,:) = XUNDEF
-PALBUV (:,:) = XUNDEF
+ALLOCATE(PEK%XALBNIR_SOIL(PK%NSIZE_P))
+ALLOCATE(PEK%XALBVIS_SOIL(PK%NSIZE_P))
+ALLOCATE(PEK%XALBUV_SOIL (PK%NSIZE_P))
+ALLOCATE(PEK%XALBNIR (PK%NSIZE_P))
+ALLOCATE(PEK%XALBVIS (PK%NSIZE_P))
+ALLOCATE(PEK%XALBUV (PK%NSIZE_P))
+PEK%XALBNIR_SOIL(:) = XUNDEF
+PEK%XALBVIS_SOIL(:) = XUNDEF
+PEK%XALBUV_SOIL (:) = XUNDEF
+PEK%XALBNIR (:) = XUNDEF
+PEK%XALBVIS (:) = XUNDEF
+PEK%XALBUV (:) = XUNDEF
!
OSURF_DIAG_ALBEDO = .TRUE.
!
!* Initialization of total albedo, emissivity and snow/flood fractions
!
-ALLOCATE(PPSN (KI,KPATCH))
-ALLOCATE(PPSNG(KI,KPATCH))
-ALLOCATE(PPSNV(KI,KPATCH))
-PPSN = 0.0
-PPSNG = 0.0
-PPSNV = 0.0
+ALLOCATE(PEK%XPSN (PK%NSIZE_P))
+ALLOCATE(PEK%XPSNG(PK%NSIZE_P))
+ALLOCATE(PEK%XPSNV(PK%NSIZE_P))
+PEK%XPSN = 0.0
+PEK%XPSNG = 0.0
+PEK%XPSNV = 0.0
!
-IF(TPSNOW%SCHEME=='EBA')THEN
- ALLOCATE(PPSNV_A(KI,KPATCH))
- PPSNV_A = 0.0
+IF(PEK%TSNOW%SCHEME=='EBA')THEN
+ ALLOCATE(PEK%XPSNV_A(PK%NSIZE_P))
+ PEK%XPSNV_A = 0.0
ELSE
- ALLOCATE(PPSNV_A(0,0))
+ ALLOCATE(PEK%XPSNV_A(0))
ENDIF
!
PDIR_ALB = XUNDEF
diff --git a/src/SURFEX/init_water_sbl.F90 b/src/SURFEX/init_water_sbl.F90
index bb1bdf5316d9e1d4bae26648a66b439cee9a8041..61d0fe2ecece765aaca27ea71e495cdf08673217 100644
--- a/src/SURFEX/init_water_sbl.F90
+++ b/src/SURFEX/init_water_sbl.F90
@@ -3,9 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE INIT_WATER_SBL(KLVL, PPA, PPS, PTA, PQA, PRHOA, PU, PV, PRAIN, PSNOW, &
- PSFTH, PSFTQ, PZREF, PUREF, PTS, PZ0, PZ, &
- PT, PQ, PWIND, PTKE, PP)
+ SUBROUTINE INIT_WATER_SBL(SB, PPA, PPS, PTA, PQA, PRHOA, PU, PV, PRAIN, PSNOW, &
+ PSFTH, PSFTQ, PZREF, PUREF, PTS, PZ0 )
! #################################################################################
!
!!**** *INIT_WATER_SBL* - inits water SBL profiles
@@ -29,6 +28,8 @@
!! Original 03/2010
!!------------------------------------------------------------------
!
+USE MODD_CANOPY_n, ONLY : CANOPY_t
+!
USE MODD_CSTS, ONLY : XCPD, XRD, XP00, XTT, XG
USE MODD_CANOPY_TURB, ONLY : XALPSBL
!
@@ -43,7 +44,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-INTEGER , INTENT(IN) :: KLVL ! number of levels in canopy
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
+!
REAL, DIMENSION(:), INTENT(IN) :: PPA ! pressure at forcing level (Pa)
REAL, DIMENSION(:), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa)
REAL, DIMENSION(:), INTENT(IN) :: PTA ! air temperature forcing (K)
@@ -56,17 +58,11 @@ REAL, DIMENSION(:), INTENT(IN) :: PRAIN ! liquid precipitation
REAL, DIMENSION(:), INTENT(IN) :: PZREF ! height of T,q forcing (m)
REAL, DIMENSION(:), INTENT(IN) :: PUREF ! height of wind forcing (m)
REAL, DIMENSION(:), INTENT(IN) :: PTS ! surface temperature
-REAL, DIMENSION(:,:), INTENT(IN):: PZ ! height of middle of each level grid (m)
+!
REAL, DIMENSION(:), INTENT(INOUT) :: PZ0 ! roughness length
REAL, DIMENSION(:), INTENT(OUT) :: PSFTH ! flux of heat (W/m2)
REAL, DIMENSION(:), INTENT(OUT) :: PSFTQ ! flux of water vapor (kg/m2/s)
!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PT ! temperature at each level in SBL (m/s)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PQ ! humidity at each level in SBL (kg/m3)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PWIND! wind at each level in SBL (m/s)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTKE ! Tke at each level in SBL (m2/s2)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PP ! pressure at each level in SBL (kg/m3)
-!
!* 0.2 declarations of local variables
!
!* forcing variables
@@ -112,8 +108,7 @@ ZWIND(:) = SQRT(PU**2+PV**2)
!We choose the case CSEA_FLUX=DIRECT to compute CD, CDN, CH, RI and ZZ0H
!Iterative computation of PZ0 / CD, CDN, CH, ZH0
DO J=1,5
- CALL WATER_FLUX(PZ0, &
- PTA, ZEXNA, PRHOA, PTS, ZEXNS, ZQA, PRAIN, &
+ CALL WATER_FLUX(PZ0, PTA, ZEXNA, PRHOA, PTS, ZEXNS, ZQA, PRAIN, &
PSNOW, XTT, ZWIND, PZREF, PUREF, &
PPS, GHANDLE_SIC, ZQSAT, PSFTH, PSFTQ, ZUSTAR, &
ZCD, ZCDN, ZCH, ZRI, ZRESA_SEA, ZZ0H )
@@ -121,20 +116,20 @@ ENDDO
!
!Initialisation of T, Q, Wind and TKE on all canopy levels
ZHU(:)=1.
-DO JLAYER=1,KLVL
+DO JLAYER=1,SB%NLVL
!
CALL CLS_TQ(PTA, ZQA, PPA, PPS, PZREF, ZCD, ZCH, ZRI, PTS, ZHU, ZZ0H, &
- PZ(:,JLAYER), ZTNM, ZQNM, ZHUNM )
+ SB%XZ(:,JLAYER), ZTNM, ZQNM, ZHUNM )
!
- PT(:,JLAYER)=ZTNM
- PQ(:,JLAYER)=ZQNM
+ SB%XT(:,JLAYER)=ZTNM
+ SB%XQ(:,JLAYER)=ZQNM
!
- CALL CLS_WIND(PU, PV, PUREF, ZCD, ZCDN, ZRI, PZ(:,JLAYER), &
+ CALL CLS_WIND(PU, PV, PUREF, ZCD, ZCDN, ZRI, SB%XZ(:,JLAYER), &
ZCLS_WIND_ZON, ZCLS_WIND_MER )
!
- PWIND(:,JLAYER) = SQRT( ZCLS_WIND_ZON(:)**2 + ZCLS_WIND_MER(:)**2 )
- PTKE (:,JLAYER) = XALPSBL * ZCD(:) * ( PU(:)**2 + PV(:)**2 )
- PP (:,JLAYER) = PPA(:) + XG * PRHOA(:) * ( PZ(:,KLVL) - PZ(:,JLAYER) )
+ SB%XU (:,JLAYER) = SQRT( ZCLS_WIND_ZON(:)**2 + ZCLS_WIND_MER(:)**2 )
+ SB%XTKE (:,JLAYER) = XALPSBL * ZCD(:) * ( PU(:)**2 + PV(:)**2 )
+ SB%XP (:,JLAYER) = PPA(:) + XG * PRHOA(:) * ( SB%XZ(:,SB%NLVL) - SB%XZ(:,JLAYER) )
!
ENDDO
!
diff --git a/src/SURFEX/init_watfluxn.F90 b/src/SURFEX/init_watfluxn.F90
index 8cf8ee90c2d2dbf810cc4bbf154929b4f3516b49..cf54026e30e9d117e775bb156f466c1cf83cd8d7 100644
--- a/src/SURFEX/init_watfluxn.F90
+++ b/src/SURFEX/init_watfluxn.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #############################################################
- SUBROUTINE INIT_WATFLUX_n (DTCO, DGU, UG, U, WM, &
+ SUBROUTINE INIT_WATFLUX_n (DTCO, OREAD_BUDGETC, UG, U, WM, &
HPROGRAM,HINIT, &
KI,KSV,KSW, &
HSV,PCO2,PRHOA, &
@@ -51,7 +51,6 @@
USE MODD_SURFEX_n, ONLY : WATFLUX_MODEL_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
@@ -79,10 +78,10 @@ USE MODI_READ_SURF
USE MODI_READ_WATFLUX_DATE
USE MODI_READ_NAM_PREP_WATFLUX_n
USE MODI_INIT_CHEMICAL_n
-USE MODI_PREP_CTRL_WATFLUX
+USE MODI_PREP_CTRL
USE MODI_UPDATE_RAD_WATER
!
-USE MODI_READ_WATFLUX_SBL_n
+USE MODI_READ_SBL_n
USE MODI_SET_SURFEX_FILEIN
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -97,7 +96,7 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+LOGICAL, INTENT(IN) :: OREAD_BUDGETC
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(WATFLUX_MODEL_t), INTENT(INOUT) :: WM
@@ -143,6 +142,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! Initialisation for IO
!
IF (LHOOK) CALL DR_HOOK('INIT_WATFLUX_N',0,ZHOOK_HANDLE)
+!
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
IF (HTEST/='OK') THEN
@@ -167,23 +167,21 @@ IF (LNAM_READ) THEN
!
CALL DEFAULT_WATFLUX(WM%W%XTSTEP,WM%W%XOUT_TSTEP,WM%W%CWAT_ALB,WM%W%CINTERPOL_TS)
CALL DEFAULT_CH_DEP(WM%CHW%CCH_DRY_DEP)
- CALL DEFAULT_DIAG_WATFLUX(WM%DGW%N2M,WM%DGW%LSURF_BUDGET,WM%DGW%L2M_MIN_ZS,WM%DGW%LRAD_BUDGET,&
- WM%DGW%LCOEF,WM%DGW%LSURF_VARS, &
- WM%DGW%LSURF_BUDGETC,WM%DGW%LRESET_BUDGETC,WM%DGW%XDIAG_TSTEP )
+ CALL DEFAULT_DIAG_WATFLUX(WM%DWO%N2M,WM%DWO%LSURF_BUDGET,WM%DWO%L2M_MIN_ZS,WM%DWO%LRAD_BUDGET,&
+ WM%DWO%LCOEF,WM%DWO%LSURF_VARS, &
+ WM%DWO%LSURF_BUDGETC,WM%DWO%LRESET_BUDGETC,WM%DWO%XDIAG_TSTEP )
!
ENDIF
!
! 0.2. Defaults from file header
!
- CALL READ_DEFAULT_WATFLUX_n(WM%CHW, WM%DGW, WM%W, &
- HPROGRAM)
+ CALL READ_DEFAULT_WATFLUX_n(WM%CHW, WM%DWO, WM%W, HPROGRAM)
!
!* 1.1 Reading of configuration:
! -------------------------
!
!
- CALL READ_WATFLUX_CONF_n(WM%CHW, WM%DGW, WM%W, &
- HPROGRAM)
+ CALL READ_WATFLUX_CONF_n(WM%CHW, WM%DWO, WM%W, HPROGRAM)
!
WM%W%LINTERPOL_TS=.FALSE.
IF(LCPL_SEA)THEN
@@ -208,18 +206,13 @@ SELECT CASE (HINIT)
WM%W%TTIME%TIME = XUNDEF
CASE ('PRE')
- CALL PREP_CTRL_WATFLUX(WM%DGW%N2M,WM%DGW%LSURF_BUDGET,WM%DGW%L2M_MIN_ZS,&
- WM%DGW%LRAD_BUDGET,WM%DGW%LCOEF,WM%DGW%LSURF_VARS,&
- ILUOUT,WM%DGW%LSURF_BUDGETC )
+ CALL PREP_CTRL(WM%DWO,ILUOUT )
IF (LNAM_READ) CALL READ_NAM_PREP_WATFLUX_n(HPROGRAM)
- CALL READ_WATFLUX_DATE(&
- HPROGRAM,HINIT,ILUOUT,HATMFILE,HATMFILETYPE,KYEAR,KMONTH,KDAY,PTIME,WM%W%TTIME)
+ CALL READ_WATFLUX_DATE(HPROGRAM,HINIT,ILUOUT,HATMFILE,HATMFILETYPE,KYEAR,KMONTH,KDAY,PTIME,WM%W%TTIME)
CASE DEFAULT
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'WATER ','WATFLX','READ ')
- CALL READ_SURF(&
- HPROGRAM,'DTCUR',WM%W%TTIME,IRESP)
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'FULL ','SURF ','READ ')
+ CALL READ_SURF(HPROGRAM,'DTCUR',WM%W%TTIME,IRESP)
CALL END_IO_SURF_n(HPROGRAM)
END SELECT
!
@@ -232,13 +225,11 @@ END SELECT
! Initialisation for IO
!
CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ') ! change input file name to pgd name
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'WATER ','WATFLX','READ ')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'WATER ','WATFLX','READ ')
!
! Reading of the fields
!
- CALL READ_PGD_WATFLUX_n(DTCO, U, WM%WG, WM%W, &
- HPROGRAM)
+ CALL READ_PGD_WATFLUX_n(DTCO, U, UG, WM%G, WM%W, HPROGRAM)
!
!-------------------------------------------------------------------------------
!
@@ -262,15 +253,13 @@ END IF
!
! Initialisation for IO
!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'WATER ','WATFLX','READ ')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'WATER ','WATFLX','READ ')
!
!
!* 2. Prognostic and cover fields:
! ---------------------------
!
- CALL READ_WATFLUX_n(DTCO, U, WM%W, &
- HPROGRAM)
+ CALL READ_WATFLUX_n(DTCO, U, WM%W, HPROGRAM)
!
IF (HINIT/='ALL') THEN
CALL END_IO_SURF_n(HPROGRAM)
@@ -304,8 +293,7 @@ WM%W%XDIR_ALB = 0.0
WM%W%XSCA_ALB = 0.0
WM%W%XEMIS = 0.0
!
- CALL UPDATE_RAD_WATER(WM%W%CWAT_ALB,WM%W%XTS,PZENITH,XTT,WM%W%XEMIS,WM%W%XDIR_ALB,&
- WM%W%XSCA_ALB,PDIR_ALB,PSCA_ALB,PEMIS,PTSRAD )
+ CALL UPDATE_RAD_WATER(WM%W,PZENITH,XTT,PDIR_ALB,PSCA_ALB,PEMIS,PTSRAD )
!
PTSURF(:) = WM%W%XTS(:)
!
@@ -314,8 +302,7 @@ PTSURF(:) = WM%W%XTS(:)
!* 5. SBL air fields:
! --------------
!
- CALL READ_WATFLUX_SBL_n(DTCO, U, WM%W, WM%WSB, &
- HPROGRAM)
+ CALL READ_SBL_n(DTCO, U, WM%SB, WM%W%LSBL, HPROGRAM, "WATER ")
!
!-------------------------------------------------------------------------------
!
@@ -340,8 +327,7 @@ END IF
!* 7. diagnostics initialization
! --------------------------
!
- CALL DIAG_WATFLUX_INIT_n(&
- DGU, WM%DGW, WM%W, &
+ CALL DIAG_WATFLUX_INIT_n(OREAD_BUDGETC, WM%DWO, WM%DW, WM%DWC, WM%W, &
HPROGRAM,ILU,KSW)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/interp_grid.F90 b/src/SURFEX/interp_grid.F90
index 24362680c7e3c17bc99f8c7b84c0a101d01edf88..5e2feeb792cb4a3623bae75e7b61ce43c87d5907 100644
--- a/src/SURFEX/interp_grid.F90
+++ b/src/SURFEX/interp_grid.F90
@@ -59,8 +59,6 @@ END MODULE MODI_INTERP_GRID
!!------------------------------------------------------------------
!
USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODI_COEF_VER_INTERP_LIN_SURF
-USE MODI_VER_INTERP_LIN_SURF
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -76,33 +74,76 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PT2 ! output temperatures
!
!* 0.2 Declaration of local variables
!
-INTEGER :: JL, JI ! loop counter
-REAL, DIMENSION(SIZE(PZ1,1),SIZE(PZ2)) :: ZZ2 ! output grid
-REAL, DIMENSION(SIZE(PZ1,1),SIZE(PZ2)) :: ZCOEFLIN ! interpolation coefficients
-INTEGER, DIMENSION(SIZE(PZ1,1),SIZE(PZ2)) :: IKLIN ! lower interpolating level of
+REAL, DIMENSION(SIZE(PZ1,2)-1) :: ZDIZ1
+INTEGER :: JL, JI, JK, JK2 ! loop counter
+REAL :: ZTHR
+REAL :: ZEPS ! a small number
+REAL :: ZCOEFLIN ! interpolation coefficients
+INTEGER :: IKLIN ! lower interpolating level of
+INTEGER :: ILEVEL, IS1
! ! grid 1 for each level of grid 2
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!-----------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('MODI_INTERP_GRID:INTERP_GRID_1D',0,ZHOOK_HANDLE)
-DO JL=1,SIZE(PZ2)
- ZZ2(:,JL) = PZ2(JL)
-END DO
+IF (LHOOK) CALL DR_HOOK('MODI_INTERP_GRID:INTERP_GRID_1D_1',0,ZHOOK_HANDLE)
+!
+IS1 = SIZE(PZ1,2)
+!
+ZEPS=1.E-12
+!
+IF (LHOOK) CALL DR_HOOK('MODI_INTERP_GRID:INTERP_GRID_1D_1',1,ZHOOK_HANDLE)
+!
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('MODI_INTERP_GRID:INTERP_GRID_1D_2',0,ZHOOK_HANDLE_OMP)
+!$OMP DO PRIVATE(JI,JK,ZDIZ1,JK2,ZTHR,ILEVEL,IKLIN,ZCOEFLIN)
+DO JI = 1,SIZE(PZ1,1)
+ !
+ IF (ANY(PT1(JI,:)==XUNDEF)) THEN
+ !
+ PT2(JI,:)=XUNDEF
+ !
+ ELSE
+ !
+ DO JK = 1,SIZE(PZ1,2)-1
+ IF (PZ1(JI,JK)==PZ1(JI,JK+1)) THEN
+ ZDIZ1(JK) = 0.
+ ELSE
+ ZDIZ1(JK) = 1./(PZ1(JI,JK)-PZ1(JI,JK+1))
+ ENDIF
+ ENDDO
+ !
+ DO JK2 = 1,SIZE(PZ2)
+ !
+ ZTHR = PZ2(JK2) * (1.-ZEPS)
+ ILEVEL = COUNT(PZ1(JI,:)<=ZTHR)
+ !
+ IF (ILEVEL < 1 ) THEN ! no extrapolation
+ !
+ IKLIN = 1
+ ZCOEFLIN = 1.
+ !
+ ELSE
+ !
+ !* linear extrapolation
+ ILEVEL = MIN(ILEVEL,IS1-1)
+ !
+ IKLIN = ILEVEL
+ !
+ ZCOEFLIN = ( PZ2(JK2)-PZ1(JI,ILEVEL+1) ) * ZDIZ1(ILEVEL)
+ IF (ILEVEL==IS1-1) ZCOEFLIN = MAX(ZCOEFLIN,0.) ! no extrapolation
+ !
+ ENDIF
+ !
+ PT2(JI,JK2) = ZCOEFLIN * PT1(JI,IKLIN) + (1.-ZCOEFLIN) * PT1(JI,IKLIN+1)
+ !
+ END DO
+ !
+ ENDIF
+!-------------------------------------------------------------------------------
+ENDDO
+!$OMP ENDDO
+IF (LHOOK) CALL DR_HOOK('MODI_INTERP_GRID:INTERP_GRID_1D_2',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
!
- CALL COEF_VER_INTERP_LIN_SURF(PZ1,ZZ2,KKLIN=IKLIN,PCOEFLIN=ZCOEFLIN)
-!
-!
-PT2= VER_INTERP_LIN_SURF(PT1,IKLIN,ZCOEFLIN)
-!
-! On reporte le mask sur tous les niveaux
-!
-DO JL=1,SIZE(PT1,2)
- DO JI=1,SIZE(PT1,1)
- IF (PT1(JI,JL)==XUNDEF) THEN
- PT2(JI,:)=XUNDEF
- ENDIF
- END DO
-END DO
-IF (LHOOK) CALL DR_HOOK('MODI_INTERP_GRID:INTERP_GRID_1D',1,ZHOOK_HANDLE)
!-----------------------------------------------------------------------------
END SUBROUTINE INTERP_GRID_1D
!
@@ -111,8 +152,6 @@ END SUBROUTINE INTERP_GRID_1D
! ##########################################
!
USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODI_COEF_VER_INTERP_LIN_SURF
-USE MODI_VER_INTERP_LIN_SURF
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -128,26 +167,74 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PT2 ! output temperatures
!
!* 0.2 Declaration of local variables
!
-INTEGER :: JL, JI ! loop counter
-REAL, DIMENSION(SIZE(PZ1,1),SIZE(PZ2,2)) :: ZCOEFLIN ! interpolation coefficients
-INTEGER, DIMENSION(SIZE(PZ1,1),SIZE(PZ2,2)) :: IKLIN ! lower interpolating level of
- ! grid 1 for each level of grid 2
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL, DIMENSION(SIZE(PZ1,2)-1) :: ZDIZ1
+REAL :: ZTHR
+REAL :: ZEPS ! a small number
+REAL :: ZCOEFLIN ! interpolation coefficients
+INTEGER :: JI, JK, JK2 ! loop counter
+INTEGER :: IKLIN ! lower interpolating level of
+INTEGER :: ILEVEL, IS1
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!-----------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('MODI_INTERP_GRID:INTERP_GRID_2D',0,ZHOOK_HANDLE)
- CALL COEF_VER_INTERP_LIN_SURF(PZ1,PZ2,IKLIN,ZCOEFLIN)
+IF (LHOOK) CALL DR_HOOK('MODI_INTERP_GRID:INTERP_GRID_2D_1',0,ZHOOK_HANDLE)
+!
+IS1 = SIZE(PZ1,2)
+!
+ZEPS=1.E-12
+!
+IF (LHOOK) CALL DR_HOOK('MODI_INTERP_GRID:INTERP_GRID_2D_1',1,ZHOOK_HANDLE)
+!
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('MODI_INTERP_GRID:INTERP_GRID_2D_2',0,ZHOOK_HANDLE_OMP)
+!$OMP DO PRIVATE(JI,JK,ZDIZ1,JK2,ZTHR,ILEVEL,IKLIN,ZCOEFLIN)
+DO JI = 1,SIZE(PZ1,1)
+ !
+ IF (ANY(PT1(JI,:)==XUNDEF)) THEN
+ !
+ PT2(JI,:)=XUNDEF
+ !
+ ELSE
+ !
+ DO JK = 1,SIZE(PZ1,2)-1
+ IF (PZ1(JI,JK)==PZ1(JI,JK+1)) THEN
+ ZDIZ1(JK) = 0.
+ ELSE
+ ZDIZ1(JK) = 1./(PZ1(JI,JK)-PZ1(JI,JK+1))
+ ENDIF
+ ENDDO
+ !
+ DO JK2 = 1,SIZE(PZ2,2)
+ !
+ ZTHR = PZ2(JI,JK2) * (1.-ZEPS)
+ ILEVEL = COUNT(PZ1(JI,:)<=ZTHR)
+ !
+ IF (ILEVEL < 1 ) THEN
+ !
+ IKLIN = 1
+ ZCOEFLIN = 1. ! no extrapolation
+ !
+ ELSE
+ !
+ !* linear extrapolation
+ ILEVEL = MIN(ILEVEL,IS1-1)
+ IKLIN = ILEVEL
+ !
+ ZCOEFLIN = ( PZ2(JI,JK2)-PZ1(JI,ILEVEL+1) ) * ZDIZ1(ILEVEL)
+ IF (ILEVEL==IS1-1) ZCOEFLIN = MAX(ZCOEFLIN,0.) ! no extrapolation
+ !
+ ENDIF
+ !
+ PT2(JI,JK2) = ZCOEFLIN * PT1(JI,IKLIN) + (1.-ZCOEFLIN) * PT1(JI,IKLIN+1)
+ !
+ END DO
+ !
+ ENDIF
+!-------------------------------------------------------------------------------
+ENDDO
+!$OMP ENDDO
+IF (LHOOK) CALL DR_HOOK('MODI_INTERP_GRID:INTERP_GRID_2D_2',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
!
-PT2= VER_INTERP_LIN_SURF(PT1,IKLIN,ZCOEFLIN)
-!
-! On reporte le mask sur tous les niveaux
-!
-DO JL=1,SIZE(PT1,2)
- DO JI=1,SIZE(PT1,1)
- IF (PT1(JI,JL)==XUNDEF) THEN
- PT2(JI,:)=XUNDEF
- ENDIF
- END DO
-END DO
-IF (LHOOK) CALL DR_HOOK('MODI_INTERP_GRID:INTERP_GRID_2D',1,ZHOOK_HANDLE)
!-----------------------------------------------------------------------------
END SUBROUTINE INTERP_GRID_2D
+!
diff --git a/src/SURFEX/interp_grid_nat.F90 b/src/SURFEX/interp_grid_nat.F90
index d7738381f4c47471fbd7cb5edbd2585c4549b64d..640d173555f71c3faa9c03405f186e37f3a09d58 100644
--- a/src/SURFEX/interp_grid_nat.F90
+++ b/src/SURFEX/interp_grid_nat.F90
@@ -62,7 +62,7 @@ DO JL=1,SIZE(PT2,2)
ZDG2(:,JL) = PDG2(JL)
ENDDO
!
- CALL VERTICAL_GRID_NAT(PDG1,PT1,ZDG2,PT2)
+CALL VERTICAL_GRID_NAT(PDG1,PT1,ZDG2,PT2)
!
IF (LHOOK) CALL DR_HOOK('MODI_INTERP_GRID_NAT:INTERP_GRID_NAT_1D',1,ZHOOK_HANDLE)
!-----------------------------------------------------------------------------
@@ -93,7 +93,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-----------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('MODI_INTERP_GRID_NAT:INTERP_GRID_NAT_2D',0,ZHOOK_HANDLE)
!
- CALL VERTICAL_GRID_NAT(PDG1,PT1,PDG2,PT2)
+CALL VERTICAL_GRID_NAT(PDG1,PT1,PDG2,PT2)
!
IF (LHOOK) CALL DR_HOOK('MODI_INTERP_GRID_NAT:INTERP_GRID_NAT_2D',1,ZHOOK_HANDLE)
!-----------------------------------------------------------------------------
diff --git a/src/SURFEX/interpol_field2d.F90 b/src/SURFEX/interpol_field2d.F90
index 96d8b668abed0a607b7f4ccfd07fe2b969985006..dd62f65ef5e94668635c7b5ec69cc5b74a95f0ce 100644
--- a/src/SURFEX/interpol_field2d.F90
+++ b/src/SURFEX/interpol_field2d.F90
@@ -32,14 +32,13 @@
!! Original 01/2004
!! Modification
!! A. Alias 07/2013 add MODI_ABOR1_SFX
-!! A. Alias 05/2016 add MODI_GET_INTERP_HALO
!! J. Escobar 09/2017 differencied error message :: SFX / NAM_IO_OFFLINE <=> MNH / NAM_PGDFILE
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
! -----------
!
-!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
!
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
@@ -47,10 +46,10 @@ USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE MODI_GET_GRID_COORD
-USE MODI_GET_INTERP_HALO
USE MODI_INTERPOL_NPTS
USE MODI_SUM_ON_ALL_PROCS
USE MODI_ABOR1_SFX
+USE MODI_GET_INTERP_HALO
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -82,12 +81,11 @@ INTEGER, OPTIONAL, INTENT(IN) :: KNPTS ! number of points to interpol
!* 0.2 Declaration of local variables
! ------------------------------
!
-REAL, DIMENSION(SIZE(KCODE)) :: ZX ! coordinate used for
-REAL, DIMENSION(SIZE(KCODE)) :: ZY ! splines interpolation
+REAL, DIMENSION(U%NDIM_FULL) :: ZX ! coordinate used for
+REAL, DIMENSION(U%NDIM_FULL) :: ZY ! splines interpolation
REAL, DIMENSION(SIZE(PFIELD,2)):: ZDEF ! default value for field
-INTEGER :: INPTS ! number of points to interpolate with
+INTEGER :: INPTS ! number of points to interpolate with
INTEGER :: IHALO, INEAR_NBR
-
!
INTEGER :: JLOOP ! loop counter
!
@@ -109,17 +107,18 @@ IF (PRESENT(PDEF)) ZDEF = PDEF
!* 2. Miscellaneous Initializations
! -----------------------------
!
- CALL GET_GRID_COORD(UG, U, &
- KLUOUT,PX=ZX,PY=ZY)
+ CALL GET_GRID_COORD(UG%G%CGRID, UG%G%NGRID_PAR, UG%G%XGRID_PAR, U%NSIZE_FULL, &
+ KLUOUT,KL=U%NDIM_FULL,HGRID=UG%G%CGRID,PGRID_PAR=UG%XGRID_FULL_PAR,&
+ PX=ZX,PY=ZY)
!
!-------------------------------------------------------------------------------
!
!* 5. Interpolation with 3 nearest points
! -----------------------------------
!
-IERR0 = SUM_ON_ALL_PROCS(HPROGRAM,UG%CGRID,KCODE(:)==0)
+IERR0 = SUM_ON_ALL_PROCS(HPROGRAM,UG%G%CGRID,KCODE(:)==0)
!
- CALL GET_INTERP_HALO(HPROGRAM,UG%CGRID,IHALO)
+ CALL GET_INTERP_HALO(HPROGRAM,UG%G%CGRID,IHALO)
!
IF (IHALO/=0) THEN
INEAR_NBR = (2*IHALO+1)**2
@@ -135,22 +134,25 @@ ENDIF
!* 6. Final check
! -----------
!
-IERR1 = SUM_ON_ALL_PROCS(HPROGRAM,UG%CGRID,KCODE(:)==0)
-IERR2 = SUM_ON_ALL_PROCS(HPROGRAM,UG%CGRID,KCODE(:)==-4)
+IERR1 = SUM_ON_ALL_PROCS(HPROGRAM,UG%G%CGRID,KCODE(:)==0)
+IERR2 = SUM_ON_ALL_PROCS(HPROGRAM,UG%G%CGRID,KCODE(:)==-4)
!
-IF (IERR1>0 .OR. IERR2>0) THEN
- !
- WRITE(KLUOUT,*) ' '
- WRITE(KLUOUT,*) ' Interpolation of field : ',HFIELD
- WRITE(KLUOUT,*) ' ----------------------'
- WRITE(KLUOUT,*) ' '
- WRITE(KLUOUT,*) ' Number of points interpolated with ',INPTS,' nearest points: ', &
- IERR1,' Total=',U%NDIM_FULL
+IF (NRANK==NPIO) THEN
!
- !
- IF (IERR2>0) THEN
- WRITE(KLUOUT,*) ' Number of points that could not be interpolated : ', &
- IERR2
+ IF (IERR1>0 .OR. IERR2>0) THEN
+ !
+ WRITE(KLUOUT,*) ' '
+ WRITE(KLUOUT,*) ' Interpolation of field : ',HFIELD
+ WRITE(KLUOUT,*) ' ----------------------'
+ WRITE(KLUOUT,*) ' '
+ WRITE(KLUOUT,*) ' Number of points interpolated with ',INPTS,' nearest points: ', &
+ IERR1
+ !
+ !
+ IF (IERR2>0) THEN
+ WRITE(KLUOUT,*) ' Number of points that could not be interpolated : ', &
+ IERR2
+ !if all points were scanned or if no point could be interpolated
IF (PRESENT(PDEF) .AND. (INEAR_NBR>=U%NDIM_FULL .OR. IERR2==IERR0)) THEN
DO JLOOP=1,SIZE(PFIELD,2)
WRITE(KLUOUT,*) ' For these points, the default value (',ZDEF(JLOOP),') is set.'
@@ -159,13 +161,15 @@ IF (IERR1>0 .OR. IERR2>0) THEN
WRITE(KLUOUT,*) ' Please provide data with better resolution'
WRITE(KLUOUT,*) ' Or define a higher halo value '
END IF
+ END IF
+ !
END IF
-!
+ !
END IF
!
IF (IERR2>0) THEN
!
- IF (.NOT.PRESENT(PDEF) .OR. (INEAR_NBR<U%NDIM_FULL .AND. IERR2/=IERR0)) THEN
+ IF (.NOT.PRESENT(PDEF) .OR. (INEAR_NBR<U%NDIM_FULL .AND. IERR2/=IERR0)) THEN
#ifdef MNH
WRITE(KLUOUT,*) 'NDIM_FULL=',U%NDIM_FULL,',NHALO=',IHALO,',Pts to interpol=',IERR0 &
,',Pts interpolated=',IERR1,',Pts missing=',IERR2
@@ -175,8 +179,7 @@ IF (IERR2>0) THEN
CALL ABOR1_SFX('Some points lack data and are too far away from other points. &
Please define a higher halo value in NAM_IO_OFFLINE.')
#endif
- ENDIF
- !
+ ENDIF
ENDIF
!
IF (COUNT(KCODE(:)==-4)>0) THEN
diff --git a/src/SURFEX/interpol_npts.F90 b/src/SURFEX/interpol_npts.F90
index bc63cedc9d9018f0e945a1df3ce3a0989cbb62af..9d3f170189e376b152023d99970697e5af1b4ff0 100644
--- a/src/SURFEX/interpol_npts.F90
+++ b/src/SURFEX/interpol_npts.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE INTERPOL_NPTS (UG, U, &
- HPROGRAM,KLUOUT,KNPTS,KCODE,PX,PY,PFIELD,KNEAR_NBR)
+ SUBROUTINE INTERPOL_NPTS (UG, U, HPROGRAM,KLUOUT,KNPTS,KCODE,PX,PY,PFIELD,KNEAR_NBR)
! #########################################################
!
!!**** *INTERPOL_NPTS* interpolates with ###ine f77 programs a 2D field
@@ -56,17 +55,34 @@
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
+USE MODD_SURFEX_OMP, ONLY : NBLOCK
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC, IDX_I, NINDEX,NNUM
USE MODD_SURF_PAR, ONLY : XUNDEF
!
-USE MODI_GET_INTERP_HALO
+USE MODI_GATHER_AND_WRITE_MPI
+USE MODI_READ_AND_SEND_MPI
USE MODI_GET_NEAR_MESHES
USE MODI_SUM_ON_ALL_PROCS
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
+#ifdef SFX_MNH
+USE MODD_IO_ll, ONLY : ISIOP, ISP, ISNPROC
+USE MODD_VAR_ll, ONLY : NMNH_COMM_WORLD
+USE MODE_GATHER_ll
+USE MODE_TOOLS_ll, ONLY : GET_GLOBALDIMS_ll
+USE MODD_PARAMETERS_ll,ONLY : JPHEXT
+!
+USE MODD_IO_SURF_MNH, ONLY : NIU, NJU
+#endif
+!
IMPLICIT NONE
!
+#if defined(SFX_MPI) || defined(SFX_MNH)
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1 Declaration of arguments
! ------------------------
!
@@ -92,129 +108,312 @@ INTEGER, INTENT(IN) :: KNEAR_NBR
!* 0.2 Declaration of local variables
! ------------------------------
!
-INTEGER :: IL ! number of points
-INTEGER :: JD ! data point index
-INTEGER :: JS ! loop counter on data points
-INTEGER :: JL ! loop counter on points to initialize
-INTEGER :: JP, JPP ! loops counter on KNPTS
-REAL :: ZDIST ! square distance between two interpolating and interpolated points
-REAL, DIMENSION(0:KNPTS) :: ZNDIST ! 3 nearest square distances
-REAL, DIMENSION(0:KNPTS,SIZE(PFIELD,2)) :: ZNVAL ! 3 corresponding field values
-REAL, DIMENSION(SIZE(PFIELD,2)) :: ZSUM
-!
-INTEGER :: IHALO
-INTEGER :: JLIST ! loop counter on points to interpolate
-INTEGER :: ICOUNT ! counter
-INTEGER :: INPTS
-INTEGER :: ISCAN ! number of points to scan
-INTEGER :: ISCAN_ALL ! number of data points
-INTEGER, DIMENSION(SIZE(PFIELD,1)) :: IINDEX ! list of index to scan
-INTEGER, DIMENSION(SIZE(PFIELD,1)) :: IINDEX_ALL ! list of all data points
-INTEGER, DIMENSION(SIZE(KCODE)) :: ISIZE
-INTEGER :: ISIZE0
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZFIELD, ZFIELD2
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFIELD3
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNDIST ! 3 nearest square distances
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNVAL ! 3 corresponding field values
+REAL, DIMENSION(:), ALLOCATABLE :: ZX, ZY
+REAL, DIMENSION(:), ALLOCATABLE :: ZDIST ! square distance between two interpolating and interpolated points
+!
+INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: ININD0, ININD_ALL ! 3 corresponding field values
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: ININD
+INTEGER, DIMENSION(:), ALLOCATABLE :: IINDEX ! list of index to scan
+INTEGER, DIMENSION(:), ALLOCATABLE :: ISIZE, ISIZE_TOT
+!
+REAL :: ZSUM
+INTEGER :: IP, ICPT, IL1, JL, JP, JK, JKK
+!
+INTEGER :: ICOUNT, IL2 ! counter
+INTEGER :: INPTS
+INTEGER :: INFOMPI, IDIM_FULL, INEAR_NBR, IOLD
+!
+#if defined(SFX_MPI) || defined(SFX_MNH)
+INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+#endif
+!
+#ifdef SFX_MNH
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOORD_2D, ZCOORD_2D_ALL
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: ISIZE_2D, ISIZE_2D_ALL, INUM_2D, INUM_2D_ALL, IINDEX_2D, IINDEX_2D_ALL
+INTEGER, DIMENSION(:), ALLOCATABLE :: INUM_1D, IINDEX_1D, INUM_TOT, IINDEX_TOT
+INTEGER :: IIMAX, IJMAX, IIU, IJU, JI
+INTEGER :: IRANK_SAVE, IPROC_SAVE, IPIO_SAVE, ICOMM_SAVE
+#endif
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
-IF (LHOOK) CALL DR_HOOK('INTERPOL_NPTS',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('INTERPOL_NPTS_1',0,ZHOOK_HANDLE)
!
-IL = SIZE(PFIELD,1)
+IOLD = 0
+!NHALO /= 0
+IF ( KNEAR_NBR/=U%NDIM_FULL ) THEN
+ IOLD = 1
+ELSE
+! case mesonh and NHALO = 0
+#ifdef SFX_MNH
+ IOLD = 2
+! case NHALO = 0
+#else
+ IOLD = 1
+#endif
+ENDIF
!
-IINDEX (:) = 0
+IF (IOLD==2) THEN
+ !
+#ifdef SFX_MNH
+ !physical dimensions of the task
+ CALL GET_DIM_PHYS_ll('B',IIU,IJU)
+ ! total dimensions
+ CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ IDIM_FULL = (IIMAX) * (IJMAX)
+ INEAR_NBR = IDIM_FULL
+ !
+ ! on sauve les infos de bases
+ IRANK_SAVE = NRANK
+ IPROC_SAVE = NPROC
+ IPIO_SAVE = NPIO
+ ICOMM_SAVE = NCOMM
+ !
+ ! on met les infos de mésonh
+ NRANK = ISP-1
+ NPROC = ISNPROC
+ NPIO = ISIOP-1
+ NCOMM = NMNH_COMM_WORLD
+ !
+ !KCODE to 2D
+ ALLOCATE(ISIZE_2D(IIU+2*JPHEXT,IJU+2*JPHEXT))
+ ISIZE_2D(:,:) = -1
+ ISIZE_2D(1+JPHEXT:IIU+JPHEXT,1+JPHEXT:IJU+JPHEXT) = RESHAPE(KCODE, (/ IIU,IJU /) )
+ ! tasks to whole domaine
+ ALLOCATE(ISIZE_2D_ALL(IIMAX+2*JPHEXT,IJMAX+2*JPHEXT))
+ CALL GATHER_XYFIELD(ISIZE_2D,ISIZE_2D_ALL,ISIOP,NMNH_COMM_WORLD)
+ DEALLOCATE(ISIZE_2D)
+ ALLOCATE(ISIZE_TOT(IDIM_FULL))
+ ISIZE_TOT = RESHAPE(ISIZE_2D_ALL(1+JPHEXT:IIMAX+JPHEXT,1+JPHEXT:IJMAX+JPHEXT),(/IDIM_FULL/))
+ DEALLOCATE(ISIZE_2D_ALL)
+#endif
+ !
+ELSEIF (IOLD==1) THEN
+ !
+ IDIM_FULL = U%NDIM_FULL
+ INEAR_NBR = KNEAR_NBR
+ !
+ ALLOCATE(ISIZE_TOT(IDIM_FULL))
+ CALL GATHER_AND_WRITE_MPI(KCODE,ISIZE_TOT)
+ !
+ENDIF
!
- CALL GET_INTERP_HALO(HPROGRAM,UG%CGRID,IHALO)
+!...known by all tasks
+IF (NPROC>1) THEN
+#if defined(SFX_MPI) || defined(SFX_MNH)
+ CALL MPI_BCAST(ISIZE_TOT,IDIM_FULL*KIND(ISIZE_TOT)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ENDIF
!
-IF(UG%CGRID=='GAUSS'.OR.IHALO==0)THEN
+IF (ALL(ISIZE_TOT/=0)) THEN
+ IF (IOLD==2) THEN
+#ifdef SFX_MNH
+ NRANK = IRANK_SAVE
+ NPROC = IPROC_SAVE
+ NPIO = IPIO_SAVE
+ NCOMM = ICOMM_SAVE
+#endif
+ ENDIF
+ DEALLOCATE(ISIZE_TOT)
+ CALL DR_HOOK('INTERPOL_NPTS_1',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
!
- ISIZE(:) = 1.
- ISIZE0 = SUM_ON_ALL_PROCS(HPROGRAM,UG%CGRID,ISIZE(:)==1)
!
- IINDEX_ALL(:) = 0
-!
- ISCAN_ALL = COUNT(KCODE(:)>0)
+IP = COUNT(KCODE(:)==0)
!
- JS = 0
- DO JD=1,IL
- IF (KCODE(JD)>0) THEN
- JS = JS+1
- IINDEX_ALL(JS) = JD
- END IF
- END DO
+IL1 = SIZE(PFIELD,1)
+IL2 = SIZE(PFIELD,2)
+!
+IF (IOLD==2) THEN
+ !
+#ifdef SFX_MNH
+!
+ ! NNUM
+ ALLOCATE(INUM_1D(U%NDIM_FULL))
+ DO JI = 1,U%NDIM_FULL
+ INUM_1D(JI) = JI
+ ENDDO
+ ! INUM_1D to 2D
+ ALLOCATE(INUM_2D(IIU+2*JPHEXT,IJU+2*JPHEXT))
+ INUM_2D = 0
+ INUM_2D(1+JPHEXT:IIU+JPHEXT,1+JPHEXT:IJU+JPHEXT) = RESHAPE(INUM_1D, (/ IIU,IJU /) )
+ DEALLOCATE(INUM_1D)
+ ! tasks to whole domaine
+ ALLOCATE(INUM_2D_ALL(IIMAX+2*JPHEXT,IJMAX+2*JPHEXT))
+ CALL GATHER_XYFIELD(INUM_2D,INUM_2D_ALL,ISIOP,NMNH_COMM_WORLD)
+ DEALLOCATE(INUM_2D)
+ ALLOCATE(INUM_TOT(IDIM_FULL))
+ INUM_TOT = RESHAPE(INUM_2D_ALL(1+JPHEXT:IIMAX+JPHEXT,1+JPHEXT:IJMAX+JPHEXT),(/IDIM_FULL/))
+ DEALLOCATE(INUM_2D_ALL)
+ !
+ ! NINDEX
+ ALLOCATE(IINDEX_1D(U%NDIM_FULL))
+ IINDEX_1D(:) = ISP - 1
+ ! INDEX_1D to 2D
+ ALLOCATE(IINDEX_2D(IIU+2*JPHEXT,IJU+2*JPHEXT))
+ IINDEX_2D(:,:) = 0
+ IINDEX_2D(1+JPHEXT:IIU+JPHEXT,1+JPHEXT:IJU+JPHEXT) = RESHAPE(IINDEX_1D, (/ IIU,IJU /) )
+ DEALLOCATE(IINDEX_1D)
+ ! tasks to whole domaine
+ ALLOCATE(IINDEX_2D_ALL(IIMAX+2*JPHEXT,IJMAX+2*JPHEXT))
+ CALL GATHER_XYFIELD(IINDEX_2D,IINDEX_2D_ALL,ISIOP,NMNH_COMM_WORLD)
+ DEALLOCATE(IINDEX_2D)
+ ALLOCATE(IINDEX_TOT(IDIM_FULL))
+ IINDEX_TOT = RESHAPE(IINDEX_2D_ALL(1+JPHEXT:IIMAX+JPHEXT,1+JPHEXT:IJMAX+JPHEXT),(/IDIM_FULL/))
+ DEALLOCATE(IINDEX_2D_ALL)
+ !
+ !PX, PY: coordinates of all the points
+ !ZX, ZY: coordinates of the points in this task
+ ALLOCATE(ZCOORD_2D(IIU+2*JPHEXT,IJU+2*JPHEXT))
+ ALLOCATE(ZCOORD_2D_ALL(IIMAX+2*JPHEXT,IJMAX+2*JPHEXT))
+ !
+ ZCOORD_2D = 0.
+ ZCOORD_2D(1+JPHEXT:IIU+JPHEXT,1+JPHEXT:IJU+JPHEXT) = RESHAPE(PX, (/ IIU,IJU /) )
+ CALL GATHER_XYFIELD(ZCOORD_2D,ZCOORD_2D_ALL,ISIOP,NMNH_COMM_WORLD)
+ ALLOCATE(ZX(IDIM_FULL))
+ ZX = RESHAPE(ZCOORD_2D_ALL(1+JPHEXT:IIMAX+JPHEXT,1+JPHEXT:IJMAX+JPHEXT),(/IDIM_FULL/))
+ !
+ ZCOORD_2D = 0.
+ ZCOORD_2D(1+JPHEXT:IIU+JPHEXT,1+JPHEXT:IJU+JPHEXT) = RESHAPE(PY, (/ IIU,IJU /) )
+ CALL GATHER_XYFIELD(ZCOORD_2D,ZCOORD_2D_ALL,ISIOP,NMNH_COMM_WORLD)
+ ALLOCATE(ZY(IDIM_FULL))
+ ZY = RESHAPE(ZCOORD_2D_ALL(1+JPHEXT:IIMAX+JPHEXT,1+JPHEXT:IJMAX+JPHEXT),(/IDIM_FULL/))
+ !
+ DEALLOCATE(ZCOORD_2D,ZCOORD_2D_ALL)
+ !
+ IF (NPROC>1) THEN
+ CALL MPI_BCAST(INUM_TOT,IDIM_FULL*KIND(INUM_TOT)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(IINDEX_TOT,IDIM_FULL*KIND(IINDEX_TOT)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(ZX,IDIM_FULL*KIND(ZX)/4,MPI_FLOAT,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(ZY,IDIM_FULL*KIND(ZY)/4,MPI_FLOAT,NPIO,NCOMM,INFOMPI)
+ ENDIF
!
-ELSEIF (.NOT.ASSOCIATED(UG%NNEAR)) THEN
- ALLOCATE(UG%NNEAR(IL,KNEAR_NBR))
- UG%NNEAR(:,:) = 0
- CALL GET_NEAR_MESHES(UG%CGRID,UG%NGRID_PAR,U%NSIZE_FULL,UG%XGRID_PAR,KNEAR_NBR,UG%NNEAR)
+#endif
+ !
+ELSEIF (IOLD==1) THEN
+ !
+ !PX, PY: coordinates of all the points
+ !ZX, ZY: coordinates of the points in this task
+ ALLOCATE(ZX(IL1),ZY(IL1))
+ CALL READ_AND_SEND_MPI(PX,ZX)
+ CALL READ_AND_SEND_MPI(PY,ZY)
+ !
ENDIF
!
-DO JL=1,IL
-
- IF (KCODE(JL)/=0) CYCLE
+IF (INEAR_NBR/=IDIM_FULL) THEN
+ IF (.NOT.ASSOCIATED(UG%NNEAR)) THEN
+ ALLOCATE(UG%NNEAR(IL1,INEAR_NBR))
+ !seach near meshes in the complete grid (xgrid_full_par) for this task
+ CALL GET_NEAR_MESHES(UG%G%CGRID,UG%NGRID_FULL_PAR,IDIM_FULL,UG%XGRID_FULL_PAR,INEAR_NBR,UG%NNEAR)
+ ENDIF
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('INTERPOL_NPTS_1',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('INTERPOL_NPTS_2',0,ZHOOK_HANDLE)
+!
+ALLOCATE(IINDEX(INEAR_NBR))
+IINDEX (:) = 0
+!
+IF (INEAR_NBR==IDIM_FULL) THEN
- ZNDIST (1:KNPTS) = 1.E20
- ZNDIST (0) = 0.
- ZNVAL(0:KNPTS,:) = 0.
- !
- IF(UG%CGRID=='GAUSS'.OR.IHALO==0)THEN
- !
- IF (U%NDIM_FULL/=ISIZE0) THEN
- ! point can not be interpolated further than halo in multiprocessor run
- KCODE(JL) = -4
- CYCLE
+ ICOUNT = 0
+ DO JL=1,IDIM_FULL
+ !is the neareast point available to interpolation
+ IF (ISIZE_TOT(JL)>0) THEN
+ ICOUNT = ICOUNT+1
+ IINDEX(ICOUNT) = JL
END IF
- INPTS = KNPTS
- ISCAN = ISCAN_ALL
- ICOUNT = ISCAN
- IINDEX(:) = IINDEX_ALL(:)
- !
+ END DO
+
+ !did we found enough points for interpolate
+ IF (ICOUNT>=1) THEN
+ INPTS = MIN(KNPTS,ICOUNT)
ELSE
- !
+ WHERE(KCODE(:)==0) KCODE(:) = -4
+ END IF
+ ALLOCATE(ZDIST (ICOUNT))
+ELSE
+ ALLOCATE(ZDIST (INEAR_NBR))
+ENDIF
+!
+ZDIST (:) = 0.
+!
+IF (LHOOK) CALL DR_HOOK('INTERPOL_NPTS_2',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('INTERPOL_NPTS_3',0,ZHOOK_HANDLE)
+!
+!indexes of points used for interpolation, for each point to interpolate
+ALLOCATE(ININD (IP,KNPTS))
+ININD(:,:) = 0
+!distances of the points used for interpolation
+ALLOCATE(ZNDIST(IP,0:KNPTS))
+ZNDIST (:,1:KNPTS) = 1.E20
+ZNDIST (:,0) = 0.
+!
+ICPT=0
+!loop on points for this task
+DO JL=1,IL1
+ !
+ !does this point need to be interpolated?
+ IF (KCODE(JL)/=0) CYCLE
+ !
+ IF (INEAR_NBR/=IDIM_FULL) THEN
+
ICOUNT = 0
- DO JD=1,KNEAR_NBR
- IF (UG%NNEAR(JL,JD)>0) THEN
- IF (KCODE(UG%NNEAR(JL,JD))>0) THEN
+ DO JK=1,INEAR_NBR
+ IF (UG%NNEAR(JL,JK)>0) THEN
+ !is the neareast point available to interpolation
+ IF (ISIZE_TOT(UG%NNEAR(JL,JK))>0) THEN
ICOUNT = ICOUNT+1
- IINDEX(ICOUNT) = UG%NNEAR(JL,JD)
+ IINDEX(ICOUNT) = UG%NNEAR(JL,JK)
END IF
END IF
END DO
!
+ !did we found enough points for interpolate
+ IF (ICOUNT>=KNPTS) THEN
+ INPTS = KNPTS
+ ELSE
+ KCODE(JL) = -4
+ CYCLE
+ END IF
+ !
ENDIF
!
- !IF (ICOUNT>=1) THEN
- IF (ICOUNT>=KNPTS) THEN
- ISCAN = ICOUNT
- !INPTS = MIN(ICOUNT,KNPTS)
- INPTS = KNPTS
- ELSEIF (KNEAR_NBR>=U%NDIM_FULL .AND. ICOUNT>=1) THEN
- ISCAN = ICOUNT
- INPTS = ICOUNT
+ !one point more to interpolate
+ ICPT = ICPT + 1
+ !
+ IF (IOLD==2) THEN
+#ifdef SFX_MNH
+ ZDIST(1:ICOUNT) = (ZX(IINDEX(1:ICOUNT))-PX(JL))**2 + (ZY(IINDEX(1:ICOUNT))-PY(JL))**2
+#endif
ELSE
- KCODE(JL) = -4
- CYCLE
- END IF
+ ZDIST(1:ICOUNT) = (PX(IINDEX(1:ICOUNT))-ZX(JL))**2 + (PY(IINDEX(1:ICOUNT))-ZY(JL))**2
+ ENDIF
!
- DO JS=1,ISCAN
- !
- JD = IINDEX(JS)
+ DO JP = 1,ICOUNT
!
- ZDIST= ( ( PX(JD)-PX(JL) ) ** 2 ) + ( ( PY(JD)-PY(JL) ) ** 2 )
+ IF (ZDIST(JP)>ZNDIST(ICPT,INPTS)) CYCLE
!
- IF ( ZDIST>ZNDIST(INPTS) ) CYCLE
- !
- DO JP = INPTS,1,-1
+ DO JK = INPTS,1,-1
!
- IF ( ZDIST>ZNDIST(JP-1) ) THEN
+ IF ( ZDIST(JP)>ZNDIST(ICPT,JK-1) ) THEN
!
- IF ( JP<INPTS ) THEN
- DO JPP = INPTS,JP+1,-1
- ZNDIST(JPP) = ZNDIST(JPP-1)
- ZNVAL(JPP,:) = ZNVAL(JPP-1,:)
+ IF ( JK<INPTS ) THEN
+ DO JKK = INPTS,JK+1,-1
+ ZNDIST(ICPT,JKK) = ZNDIST(ICPT,JKK-1)
+ ININD (ICPT,JKK) = ININD (ICPT,JKK-1)
ENDDO
ENDIF
!
- ZNDIST(JP) = ZDIST
- ZNVAL(JP,:) = PFIELD(JD,:)
+ !distances and indexes of points used to interpolate are saved
+ ZNDIST(ICPT,JK) = ZDIST (JP)
+ ININD (ICPT,JK) = IINDEX(JP)
!
EXIT
!
@@ -224,19 +423,163 @@ DO JL=1,IL
!
ENDDO
!
- ZNDIST(:) = SQRT(ZNDIST(:))
- !
- PFIELD(JL,:) = 0.
- ZSUM(:) = 0.
- DO JP = 1, INPTS
- PFIELD(JL,:) = PFIELD(JL,:) + ZNVAL(JP,:)/ZNDIST(JP)
- ZSUM(:) = ZSUM(:) + 1./ZNDIST(JP)
+ENDDO
+!
+IF (LHOOK) CALL DR_HOOK('INTERPOL_NPTS_3',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('INTERPOL_NPTS_4',0,ZHOOK_HANDLE)
+!
+DEALLOCATE(IINDEX,ZX,ZY,ISIZE_TOT,ZDIST)
+!
+ZNDIST(:,:) = SQRT(ZNDIST(:,:))
+!
+ALLOCATE(ISIZE(0:NPROC-1))
+
+!numbers of points to interpolated are gathered
+IF (NPROC>1) THEN
+#if defined(SFX_MPI) || defined(SFX_MNH)
+ CALL MPI_ALLGATHER(ICPT,KIND(ICPT)/4,MPI_INTEGER,&
+ ISIZE,KIND(ISIZE)/4,MPI_INTEGER,NCOMM,INFOMPI)
+#endif
+ELSE
+ ISIZE(:) = ICPT
+ENDIF
+!
+!this array contains, for each point to interpolate,
+!the correspondance between the task where is the point to use for interpolation
+!(NINDEX) and its index in this task (NNUM)
+ALLOCATE(ININD0(MAXVAL(ISIZE),KNPTS,0:NPROC-1))
+ININD0(:,:,:) = 0
+!
+!number of points needed to interpolated
+DO JL=1,KNPTS
+ !number of points to interpolated
+ DO JP=1,ICPT
+ !index of the point needed in the whole grid
+ JK = ININD(JP,JL)
+ !inind0 contains the task and the index in this task for this point
+ IF (IOLD==2) THEN
+#ifdef SFX_MNH
+ IF (JK/=0) ININD0(JP,JL,IINDEX_TOT(JK)) = INUM_TOT(JK)
+#endif
+ ELSEIF (IOLD==1) THEN
+ IF (JK/=0) ININD0(JP,JL,NINDEX(JK)) = NNUM(JK)
+ ENDIF
+ ENDDO
+ENDDO
+!
+!for each task, points needed and located in this task are gathered
+ALLOCATE(ININD_ALL(MAXVAL(ISIZE),KNPTS,0:NPROC-1))
+!
+IF (NPROC>1) THEN
+ !for each task
+ DO JP=0,NPROC-1
+#if defined(SFX_MPI) || defined(SFX_MNH)
+ !inind_all receives from all tasks the points they need that are
+ !located in it
+ CALL MPI_GATHER(ININD0(:,:,JP),MAXVAL(ISIZE)*KNPTS*KIND(ININD0)/4,MPI_INTEGER,&
+ ININD_ALL,MAXVAL(ISIZE)*KNPTS*KIND(ININD_ALL)/4,MPI_INTEGER,&
+ JP,NCOMM,INFOMPI)
+#endif
ENDDO
- PFIELD(JL,:) = PFIELD(JL,:) / ZSUM(:)
!
-END DO
+ELSE
+ ININD_ALL(:,:,:) = ININD0(:,:,:)
+ENDIF
+!
+DEALLOCATE(ININD0)
+!
+IF (LHOOK) CALL DR_HOOK('INTERPOL_NPTS_4',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('INTERPOL_NPTS_5',0,ZHOOK_HANDLE)
+!
+!zfield contains the values of the points needed located in this task
+!(ie values for indexes of ININD_ALL)
+ALLOCATE(ZFIELD(MAXVAL(ISIZE),KNPTS,SIZE(PFIELD,2),0:NPROC-1))
+ZFIELD(:,:,:,:) = XUNDEF
+DO JP=0,NPROC-1
+ DO JK=1,MAXVAL(ISIZE)
+ DO JL=1,KNPTS
+ IF (ININD_ALL(JK,JL,JP)/=0) THEN
+ !pfield in only on this task
+ ZFIELD(JK,JL,:,JP) = PFIELD(ININD_ALL(JK,JL,JP),:)
+ ENDIF
+ ENDDO
+ ENDDO
+ENDDO
+!
+DEALLOCATE(ININD_ALL)
+!
+!ZFIELD2 gathers values needed for this task from all other tasks
+!(inverse operation than before)
+ALLOCATE(ZFIELD2(ICPT,KNPTS,SIZE(PFIELD,2),0:NPROC-1))
+IF (NPROC>1) THEN
+ DO JP=0,NPROC-1
+#if defined(SFX_MPI) || defined(SFX_MNH)
+ CALL MPI_GATHER(ZFIELD(1:ISIZE(JP),:,:,JP),SIZE(ZFIELD(1:ISIZE(JP),:,:,JP))*KIND(ZFIELD)/4,MPI_REAL,&
+ ZFIELD2,ISIZE(JP)*KNPTS*SIZE(PFIELD,2)*KIND(ZFIELD2)/4,MPI_REAL,JP,NCOMM,INFOMPI)
+#endif
+ ENDDO
+ELSE
+ ZFIELD2(:,:,:,:) = ZFIELD(:,:,:,:)
+ENDIF
+!
+DEALLOCATE(ZFIELD)
+!
+!zfield3 contains the values of the points needed for interpolation, gathered from all tasks
+ALLOCATE(ZFIELD3(ICPT,KNPTS,SIZE(PFIELD,2)))
+DO JP=0,NPROC-1
+ WHERE (ZFIELD2(:,:,:,JP)/=XUNDEF) ZFIELD3(:,:,:) = ZFIELD2(:,:,:,JP)
+ENDDO
+DEALLOCATE(ZFIELD2)
+!
+IF (LHOOK) CALL DR_HOOK('INTERPOL_NPTS_5',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('INTERPOL_NPTS_6',0,ZHOOK_HANDLE)
+!
+!values of the points used for interpolation
+ALLOCATE(ZNVAL(IP,IL2))
+ZNVAL(:,:) = XUNDEF
+!
+!znval contains the averaged values for the knpts points
+ZNVAL(:,:) = 0.
+DO JL=1,ICPT
+ ZSUM = 0.
+ DO JP=1,KNPTS
+ IF (ININD(JL,JP)/=0) THEN
+ ZNVAL(JL,:) = ZNVAL(JL,:) + ZFIELD3(JL,JP,:)/ZNDIST(JL,JP)
+ ZSUM = ZSUM + 1./ZNDIST(JL,JP)
+ ENDIF
+ ENDDO
+ IF (ZSUM/=0.) ZNVAL(JL,:) = ZNVAL(JL,:) / ZSUM
+ENDDO
+!
+DEALLOCATE(ININD, ZNDIST, ZFIELD3)
+!
+!
+!finally, pfield contains the interpolated values!
+ICPT=0
+DO JL=1,IL1
+
+ IF (KCODE(JL)/=0) CYCLE
+
+ ICPT = ICPT + 1
+ PFIELD(JL,:) = ZNVAL(ICPT,:)
+
+ENDDO
+!
+DEALLOCATE(ZNVAL)
+!
+DEALLOCATE(ISIZE)
+!
+IF (IOLD==2) THEN
+#ifdef SFX_MNH
+ NRANK = IRANK_SAVE
+ NPROC = IPROC_SAVE
+ NPIO = IPIO_SAVE
+ NCOMM = ICOMM_SAVE
+ DEALLOCATE(IINDEX_TOT,INUM_TOT)
+#endif
+ENDIF
!
-IF (LHOOK) CALL DR_HOOK('INTERPOL_NPTS',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('INTERPOL_NPTS_6',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
END SUBROUTINE INTERPOL_NPTS
diff --git a/src/SURFEX/interpol_sst_mth.F90 b/src/SURFEX/interpol_sst_mth.F90
index 70e42eae96db4005c49e460bc722c00e8d51e172..9f46699c151cc3399ad58f60882ff5f402db35a3 100644
--- a/src/SURFEX/interpol_sst_mth.F90
+++ b/src/SURFEX/interpol_sst_mth.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE INTERPOL_SST_MTH (S, &
- KYEAR,KMONTH,KDAY,HFLAG,POUT)
+ SUBROUTINE INTERPOL_SST_MTH (S,HFLAG)
! #######################################################
!
!!**** *INTERPOL_SST_MTH* - Interpolation of monthly SST, SSS, SIT or SIC
@@ -56,12 +55,8 @@ IMPLICIT NONE
!
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
!
-INTEGER, INTENT(IN) :: KYEAR ! year of date
-INTEGER, INTENT(IN) :: KMONTH ! month of date
-INTEGER, INTENT(IN) :: KDAY ! day of date
- CHARACTER(LEN=1), INTENT(IN) :: HFLAG ! 'T' for SST, 'S' for SSS, 'H' for SIT, 'C' for SIC
-!
-REAL, DIMENSION(:), INTENT(OUT) :: POUT ! Sea surface temperature or salinity, or SIC or SIT at time t
+CHARACTER(LEN=1), INTENT(IN) :: HFLAG ! 'T' for SST, 'S' for SSS, 'H' for SIT, 'C' for SIC
+
!
!* 0.2 Declaration of local variables
! ------------------------------
@@ -85,13 +80,14 @@ IF (LHOOK) CALL DR_HOOK('INTERPOL_SST_MTH',0,ZHOOK_HANDLE)
IF ( (HFLAG/='S') .AND. (HFLAG/='T') .AND. (HFLAG/='H') .AND. (HFLAG/='C') )THEN
CALL ABOR1_SFX('FATAL ERROR in INTERPOL_SST_MTH : HFLAG not S nor T nor C nor H. !')
ENDIF
-SELECT CASE (KMONTH)
+SELECT CASE (S%TTIME%TDATE%MONTH)
CASE(4,6,9,11)
INDAYS=30
CASE(1,3,5,7:8,10,12)
INDAYS=31
CASE(2)
- IF( ((MOD(KYEAR,4)==0).AND.(MOD(KYEAR,100)/=0)) .OR. (MOD(KYEAR,400)==0))THEN
+ IF( ((MOD(S%TTIME%TDATE%YEAR,4)==0).AND.(MOD(S%TTIME%TDATE%YEAR,100)/=0)) &
+ .OR. (MOD(S%TTIME%TDATE%YEAR,400)==0))THEN
INDAYS=29
ELSE
INDAYS=28
@@ -104,12 +100,12 @@ END SELECT
!* 2. SST or SSS Interpolation using previous, current and next month
! --------------------------------------------------------
!
-ZDAT = REAL(KDAY)
+ZDAT = REAL(S%TTIME%TDATE%DAY)
ZNDAT= REAL(INDAYS)
!
! The current month correspond to the indice 2 (or 3 if next month)
!
-IF (KMONTH==S%TZTIME%TDATE%MONTH) THEN
+IF (S%TTIME%TDATE%MONTH==S%TZTIME%TDATE%MONTH) THEN
IDELTA=0
ELSE
IDELTA=1
@@ -120,37 +116,38 @@ IMTH1=2+IDELTA
IMTH2=3+IDELTA
!
IF (HFLAG =='T') THEN
- CALL INTERPOL_LOCAL(S%CINTERPOL_SST,S%XSST_MTH(:,IMTH0),S%XSST_MTH(:,IMTH1),S%XSST_MTH(:,IMTH2))
+ CALL INTERPOL_LOCAL(S%CINTERPOL_SST,S%XSST_MTH(:,IMTH0),S%XSST_MTH(:,IMTH1),S%XSST_MTH(:,IMTH2),S%XSST)
ELSEIF (HFLAG =='S') THEN
- CALL INTERPOL_LOCAL(S%CINTERPOL_SSS,S%XSSS_MTH(:,IMTH0),S%XSSS_MTH(:,IMTH1),S%XSSS_MTH(:,IMTH2))
- POUT(:) = MAX(0.0,POUT(:))
+ CALL INTERPOL_LOCAL(S%CINTERPOL_SSS,S%XSSS_MTH(:,IMTH0),S%XSSS_MTH(:,IMTH1),S%XSSS_MTH(:,IMTH2),S%XSSS)
+ S%XSSS(:) = MAX(0.0,S%XSSS(:))
ELSEIF (HFLAG =='H') THEN
- CALL INTERPOL_LOCAL(S%CINTERPOL_SIT,S%XSIT_MTH(:,IMTH0),S%XSIT_MTH(:,IMTH1),S%XSIT_MTH(:,IMTH2))
- POUT(:) = MAX(0.0,POUT(:))
+ CALL INTERPOL_LOCAL(S%CINTERPOL_SIT,S%XSIT_MTH(:,IMTH0),S%XSIT_MTH(:,IMTH1),S%XSIT_MTH(:,IMTH2),S%XFSIT)
+ S%XFSIT(:) = MAX(0.0,S%XFSIT(:))
ELSEIF (HFLAG =='C') THEN
- CALL INTERPOL_LOCAL(S%CINTERPOL_SIC,S%XSIC_MTH(:,IMTH0),S%XSIC_MTH(:,IMTH1),S%XSIC_MTH(:,IMTH2))
- POUT(:) = MAX(0.0,MIN(1.0,POUT(:)))
+ CALL INTERPOL_LOCAL(S%CINTERPOL_SIC,S%XSIC_MTH(:,IMTH0),S%XSIC_MTH(:,IMTH1),S%XSIC_MTH(:,IMTH2),S%XFSIC)
+ S%XFSIC(:) = MAX(0.0,MIN(1.0,S%XFSIC(:)))
ENDIF
!
IF (LHOOK) CALL DR_HOOK('INTERPOL_SST_MTH',1,ZHOOK_HANDLE)
!
!=======================================================================================
!
- CONTAINS
+CONTAINS
!
!=======================================================================================
!
-SUBROUTINE INTERPOL_LOCAL(HMETHOD,PMTH0,PMTH1,PMTH2)
+SUBROUTINE INTERPOL_LOCAL(HMETHOD,PMTH0,PMTH1,PMTH2,POUT)
!
USE MODI_INTERPOL_QUADRA
USE MODI_INTERPOL_LINEAR
!
IMPLICIT NONE
!
- CHARACTER(LEN=6), INTENT(IN) :: HMETHOD
+CHARACTER(LEN=6), INTENT(IN) :: HMETHOD
REAL, DIMENSION(:) , INTENT(IN) :: PMTH0
REAL, DIMENSION(:) , INTENT(IN) :: PMTH1
REAL, DIMENSION(:) , INTENT(IN) :: PMTH2
+REAL, DIMENSION(:), INTENT(OUT) :: POUT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
diff --git a/src/SURFEX/interpol_ts_water_mth.F90 b/src/SURFEX/interpol_ts_water_mth.F90
index b5a6485f35262b89045fe52fd0294836558ba841..520d3d06b5a94d28cb8d7fa3ece2019b52f3c04a 100644
--- a/src/SURFEX/interpol_ts_water_mth.F90
+++ b/src/SURFEX/interpol_ts_water_mth.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE INTERPOL_TS_WATER_MTH (W, &
- KYEAR,KMONTH,KDAY,PTS)
+ SUBROUTINE INTERPOL_TS_WATER_MTH (W)
! #######################################################
!
!!**** *INTERPOL_TS_WATER_MTH* - Interpolation of monthly TS water
@@ -60,12 +59,6 @@ IMPLICIT NONE
!
TYPE(WATFLUX_t), INTENT(INOUT) :: W
!
-INTEGER, INTENT(IN ) :: KYEAR ! year of date
-INTEGER, INTENT(IN ) :: KMONTH ! month of date
-INTEGER, INTENT(IN ) :: KDAY ! day of date
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PTS ! Water surface temperature at time t
-!
!* 0.2 Declaration of local variables
! ------------------------------
!
@@ -85,13 +78,13 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! -------------------------
!
IF (LHOOK) CALL DR_HOOK('INTERPOL_TS_WATER_MTH',0,ZHOOK_HANDLE)
-SELECT CASE (KMONTH)
+SELECT CASE (W%TTIME%TDATE%MONTH)
CASE(4,6,9,11)
INDAYS=30
CASE(1,3,5,7:8,10,12)
INDAYS=31
CASE(2)
- IF( ((MOD(KYEAR,4)==0).AND.(MOD(KYEAR,100)/=0)) .OR. (MOD(KYEAR,400)==0))THEN
+ IF( ((MOD(W%TTIME%TDATE%YEAR,4)==0).AND.(MOD(W%TTIME%TDATE%YEAR,100)/=0)) .OR. (MOD(W%TTIME%TDATE%YEAR,400)==0))THEN
INDAYS=29
ELSE
INDAYS=28
@@ -104,12 +97,12 @@ END SELECT
!* 2. TS water Interpolation using previous, current and next month
! -------------------------------------------------------------
!
-ZDAT = REAL(KDAY)
+ZDAT = REAL(W%TTIME%TDATE%DAY)
ZNDAT= REAL(INDAYS)
!
! The current month correspond to the indice 2 (or 3 if next month))
!
-IF (KMONTH==W%TZTIME%TDATE%MONTH) THEN
+IF (W%TTIME%TDATE%MONTH==W%TZTIME%TDATE%MONTH) THEN
IDELTA=0
ELSE
IDELTA=1
@@ -120,11 +113,11 @@ IMTH1=2+IDELTA
IMTH2=3+IDELTA
!
IF(W%CINTERPOL_TS=='QUADRA')THEN
- CALL INTERPOL_QUADRA(ZDAT,ZNDAT,W%XTS_MTH(:,IMTH0),W%XTS_MTH(:,IMTH1),W%XTS_MTH(:,IMTH2),PTS)
+ CALL INTERPOL_QUADRA(ZDAT,ZNDAT,W%XTS_MTH(:,IMTH0),W%XTS_MTH(:,IMTH1),W%XTS_MTH(:,IMTH2),W%XTS)
ELSEIF(W%CINTERPOL_TS=='LINEAR')THEN
- CALL INTERPOL_LINEAR(ZDAT,ZNDAT,W%XTS_MTH(:,IMTH0),W%XTS_MTH(:,IMTH1),W%XTS_MTH(:,IMTH2),PTS)
+ CALL INTERPOL_LINEAR(ZDAT,ZNDAT,W%XTS_MTH(:,IMTH0),W%XTS_MTH(:,IMTH1),W%XTS_MTH(:,IMTH2),W%XTS)
ELSEIF(W%CINTERPOL_TS=='UNIF')THEN
- PTS(:) = W%XTS_MTH(:,IMTH1)
+ W%XTS(:) = W%XTS_MTH(:,IMTH1)
ELSE
CALL ABOR1_SFX('INTERPOL_TS_WATER_MTH: interpolation method not supported')
ENDIF
diff --git a/src/SURFEX/inverse_matrix.F90 b/src/SURFEX/inverse_matrix.F90
deleted file mode 100644
index 34a156bba59f00d5af3555e7f7ac8a4fd76a971c..0000000000000000000000000000000000000000
--- a/src/SURFEX/inverse_matrix.F90
+++ /dev/null
@@ -1,42 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE INVERSE_MATRIX(N,A,P)
-!--------------------------------------------------------
-!
-! Explicit inversed matrix after Cholesky decomposition
-!
-!--------------------------------------------------------
- USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
- USE PARKIND1 ,ONLY : JPRB
-!
- IMPLICIT NONE
- INTEGER, INTENT(IN) :: N
- REAL, DIMENSION (N,N), INTENT(INOUT) :: A
- REAL, DIMENSION (N), INTENT(IN) :: P
- REAL ZSUM
- INTEGER :: I, J, K
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
- IF (LHOOK) CALL DR_HOOK('INVERSE_MATRIX',0,ZHOOK_HANDLE)
- DO I=1,N
- A(I,I)=1./P(I)
- DO J=I+1,N
- ZSUM = 0.
- DO K=I,J-1
- ZSUM = ZSUM - A(J,K)*A(K,I)
- ENDDO
- A(J,I) = ZSUM/P(J)
- ENDDO
- ENDDO
- DO I=1,N
- DO J=I+1,N
- A(I,J) =0.0
- ENDDO
- ENDDO
- A = MATMUL(TRANSPOSE(A),A)
-
- IF (LHOOK) CALL DR_HOOK('INVERSE_MATRIX',1,ZHOOK_HANDLE)
-
-END SUBROUTINE INVERSE_MATRIX
diff --git a/src/SURFEX/io_buff_clean.F90 b/src/SURFEX/io_buff_clean.F90
index e91acb63a721a067d5d58507014a05b9428e6287..76432b7596e1733cc157aabbc80f751b2e6b89c1 100644
--- a/src/SURFEX/io_buff_clean.F90
+++ b/src/SURFEX/io_buff_clean.F90
@@ -60,7 +60,7 @@ IMPLICIT NONE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('IO_BUFF_CLEAN',0,ZHOOK_HANDLE)
- CREC=' '
+CREC=' '
NREC=0
IF (LHOOK) CALL DR_HOOK('IO_BUFF_CLEAN',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/io_buff_cleann.F90 b/src/SURFEX/io_buff_cleann.F90
deleted file mode 100644
index 22b94fc6b7d192d6f91409446c3e3be8dc12d418..0000000000000000000000000000000000000000
--- a/src/SURFEX/io_buff_cleann.F90
+++ /dev/null
@@ -1,9 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #######################################################
- SUBROUTINE IO_BUFF_CLEAN_n
-! #######################################################
-!
-END SUBROUTINE IO_BUFF_CLEAN_n
diff --git a/src/SURFEX/io_buffn.F90 b/src/SURFEX/io_buffn.F90
deleted file mode 100644
index 4913064ea756514982008f063eb1086f412a12a4..0000000000000000000000000000000000000000
--- a/src/SURFEX/io_buffn.F90
+++ /dev/null
@@ -1,11 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #######################################################
- SUBROUTINE IO_BUFF_n
-! #######################################################
-!
-
-!
-END SUBROUTINE IO_BUFF_n
diff --git a/src/SURFEX/irrigation_update.F90 b/src/SURFEX/irrigation_update.F90
index c3bbcf2f33774fb3fddc7a7b343a8808d81b3417..517e6e7c2d09c7da80d80b38ae0a6af4ce7f8b69 100644
--- a/src/SURFEX/irrigation_update.F90
+++ b/src/SURFEX/irrigation_update.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE IRRIGATION_UPDATE (AG, &
- PIRRIG, PTSTEP, KMONTH, KDAY, &
- PTIME,TSEEDMONTH,TSEEDDAY,TREAPMONTH,TREAPDAY)
+ SUBROUTINE IRRIGATION_UPDATE (NAG, NPE, KPATCH, PTSTEP, KMONTH, KDAY, PTIME)
! ####################################################################
!
!!**** *IRRIGATION_UPDATE* - routine to update irrigation fields
@@ -39,8 +37,8 @@
!* 0. DECLARATIONS
! ------------
!
-!
-USE MODD_AGRI_n, ONLY : AGRI_t
+USE MODD_ISBA_n, ONLY : ISBA_NPE_t
+USE MODD_AGRI_n, ONLY : AGRI_NP_t
!
USE MODD_AGRI, ONLY : JPSTAGE, XTHRESHOLD
!
@@ -49,16 +47,14 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
-TYPE(AGRI_t), INTENT(INOUT) :: AG
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
+TYPE(AGRI_NP_t), INTENT(INOUT) :: NAG
!
-INTEGER, DIMENSION(:,:), INTENT(IN) :: TSEEDMONTH
-INTEGER, DIMENSION(:,:), INTENT(IN) :: TSEEDDAY
-INTEGER, DIMENSION(:,:), INTENT(IN) :: TREAPMONTH
-INTEGER, DIMENSION(:,:), INTENT(IN) :: TREAPDAY
-REAL , DIMENSION(:,:), INTENT(IN) :: PIRRIG
+INTEGER, INTENT(IN) :: KPATCH
REAL, INTENT(IN) :: PTSTEP, PTIME
INTEGER, INTENT(IN) :: KMONTH, KDAY
-INTEGER :: IL, JL
+!
+INTEGER :: JI, JP
LOGICAL :: GMASK
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -70,50 +66,50 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODI_IRRIGATION_UPDATE:IRRIGATION_UPDATE',0,ZHOOK_HANDLE)
GMASK = ( PTIME - PTSTEP < 0. ) .AND. ( PTIME >= 0. )
!
-IF (GMASK) THEN
-
- WHERE( (PIRRIG(:,:).GT.0.).AND.(AG%LIRRIDAY(:,:)) .AND.(AG%NIRRINUM(:,:).LT.JPSTAGE))
- AG%NIRRINUM (:,:) = AG%NIRRINUM(:,:) + 1
- AG%LIRRIDAY (:,:) = .FALSE.
- ENDWHERE
-!
- DO IL=1,SIZE(PIRRIG,1)
- DO JL=1,SIZE(PIRRIG,2)
- AG%XTHRESHOLDSPT(IL,JL)=XTHRESHOLD(AG%NIRRINUM(IL,JL))
- ENDDO
- ENDDO
-!
-END IF
-!
-! Reinitialization of irrigation stage (necessary for runs from August to August)
-!
-IF((KMONTH==1).AND.(KDAY==1)) THEN
- AG%NIRRINUM(:,:) = 1
-ENDIF
-!
-AG%LIRRIGATE(:,:) = .FALSE.
-DO IL=1,SIZE(PIRRIG,1)
- DO JL=1,SIZE(PIRRIG,2)
- !
- ! Activate irrigation after seeding date
- !
- IF (KMONTH == TSEEDMONTH(IL,JL) .AND. KDAY .GE. TSEEDDAY(IL,JL)) THEN
- AG%LIRRIGATE(IL,JL) = .TRUE.
- END IF
- IF (KMONTH > TSEEDMONTH(IL,JL)) THEN
- AG%LIRRIGATE(IL,JL) = .TRUE.
- END IF
- !
- ! Stop irrigation after reaping date
- !
- IF (KMONTH == TREAPMONTH(IL,JL) .AND. KDAY .GT. TREAPDAY(IL,JL)) THEN
- AG%LIRRIGATE(IL,JL) = .FALSE.
- END IF
- IF (KMONTH > TREAPMONTH(IL,JL)) THEN
- AG%LIRRIGATE(IL,JL) = .FALSE.
- END IF
- ENDDO
+DO JP = 1,KPATCH
+ !
+ IF (GMASK) THEN
+ !
+ WHERE( (NPE%AL(JP)%XIRRIG(:).GT.0.).AND.(NAG%AL(JP)%LIRRIDAY(:)) .AND.(NAG%AL(JP)%NIRRINUM(:).LT.JPSTAGE))
+ NAG%AL(JP)%NIRRINUM (:) = NAG%AL(JP)%NIRRINUM(:) + 1
+ NAG%AL(JP)%LIRRIDAY (:) = .FALSE.
+ ENDWHERE
+ !
+ DO JI = 1,SIZE(NPE%AL(JP)%XIRRIG,1)
+ NAG%AL(JP)%XTHRESHOLDSPT(JI)= XTHRESHOLD(NAG%AL(JP)%NIRRINUM(JI))
+ ENDDO
+ !
+ END IF
+ !
+ ! Reinitialization of irrigation stage (necessary for runs from August to August)
+ !
+ IF((KMONTH==1).AND.(KDAY==1)) NAG%AL(JP)%NIRRINUM(:) = 1
+ !
+ NAG%AL(JP)%LIRRIGATE(:) = .FALSE.
+ !
+ DO JI = 1,SIZE(NPE%AL(JP)%XIRRIG,1)
+ !
+ ! Activate irrigation after seeding date
+ !
+ IF (KMONTH == NPE%AL(JP)%TSEED(JI)%TDATE%MONTH .AND. KDAY .GE. NPE%AL(JP)%TSEED(JI)%TDATE%DAY) THEN
+ NAG%AL(JP)%LIRRIGATE(JI) = .TRUE.
+ END IF
+ IF (KMONTH > NPE%AL(JP)%TSEED(JI)%TDATE%MONTH) THEN
+ NAG%AL(JP)%LIRRIGATE(JI) = .TRUE.
+ END IF
+ !
+ ! Stop irrigation after reaping date
+ !
+ IF (KMONTH == NPE%AL(JP)%TREAP(JI)%TDATE%MONTH .AND. KDAY .GT. NPE%AL(JP)%TREAP(JI)%TDATE%DAY) THEN
+ NAG%AL(JP)%LIRRIGATE(JI) = .FALSE.
+ END IF
+ IF (KMONTH > NPE%AL(JP)%TREAP(JI)%TDATE%MONTH) THEN
+ NAG%AL(JP)%LIRRIGATE(JI) = .FALSE.
+ END IF
+ ENDDO
+ !
ENDDO
+!
IF (LHOOK) CALL DR_HOOK('MODI_IRRIGATION_UPDATE:IRRIGATION_UPDATE',1,ZHOOK_HANDLE)
!
END SUBROUTINE IRRIGATION_UPDATE
diff --git a/src/SURFEX/isba.F90 b/src/SURFEX/isba.F90
index 53ad9f4c1e033a08e01dd6d170e3300fb52e518f..68d30f1851f2d46ea7472747164ef91a77a5ce0e 100644
--- a/src/SURFEX/isba.F90
+++ b/src/SURFEX/isba.F90
@@ -3,71 +3,16 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE ISBA(HISBA, HPHOTO, OTR_ML, HRUNOFF, HKSAT, HRAIN, HHORT, &
- HC1DRY, HSCOND, HSNOW_ISBA, HSNOWRES, HCPSURF, HSOILFRZ, &
- HDIFSFCOND, TPTIME, OFLOOD, OTEMP_ARP, OGLACIER, &
- OMEB, OFORC_MEASURE, OMEB_LITTER, OMEB_GNDRES, &
- PTSTEP, HIMPLICIT_WIND, OAGRI_TO_GRASS, OSNOWDRIFT, &
- OSNOWDRIFT_SUBLIM, OSNOW_ABS_ZENITH,HSNOWMETAMO,HSNOWRAD, &
- PCGMAX, PZREF, PUREF, PDIRCOSZW, &
+ SUBROUTINE ISBA(IO, KK, PK, PEK, G, AG, DK, DEK, DMK, TPTIME, PPOI, PABC, PIACAN, &
+ OMEB, PTSTEP, HIMPLICIT_WIND, PZREF, PUREF, PDIRCOSZW, &
PTA, PQA, PEXNA, PRHOA, PPS, PEXNS, PRR, PSR, PZENITH, &
PSCA_SW, PSW_RAD, PLW_RAD, PVMOD, PPEW_A_COEF, PPEW_B_COEF,&
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, PRSMIN,&
- PRGL, PGAMMA, PCV, PRUNOFFD, PSOILWGHT, KLAYER_HORT, &
- KLAYER_DUN, PALBNIR_TVEG, PALBVIS_TVEG, PALBNIR_TSOIL, &
- PALBVIS_TSOIL, PALB, PWRMAX_CF, PVEG, PLAI, PEMIS, &
- PZ0_WITH_SNOW, PZ0H_WITH_SNOW, PVEGTYPE, PZ0EFF, &
- PRGLCV, PGAMMACV, PRSMINCV, &
- PROOTFRACCV, PWRMAX_CFCV, PLAIV, &
- PBSLAI,PLAIMIN,PH_VEG,PPALPHAN, &
- PZ0G_WITHOUT_SNOW, &
- PZ0_MEBV,PZ0H_MEBV,PZ0EFF_MEBV, &
- PZ0_MEBN,PZ0H_MEBN,PZ0EFF_MEBN, &
- PGNDLITTER, PRUNOFFB, &
- PCGSAT, PC1SAT, PC2REF, PC3, PC4B, PC4REF, PACOEF, PPCOEF, &
- PTAUICE, PWDRAIN, PTDEEP_A, PTDEEP_B, PGAMMAT, &
- PPSN, PPSNG, PPSNV, &
- PPSNV_A, PSNOWFREE_ALB_VEG, PSNOWFREE_ALB_SOIL, PIRRIG, &
- PWATSUP, PTHRESHOLD, LIRRIGATE, LIRRIDAY, OSTRESSDEF, PGC, &
- PF2I, PDMAX, PAH, PBH, PCSP, PGMES, PPOI, PFZERO, PEPSO, &
- PGAMM, PQDGAMM, PQDGMES, PT1GMES, PT2GMES, PAMAX, PQDAMAX, &
- PT1AMAX, PT2AMAX, PABC, PD_G, PDZG, PDZDIF, KWG_LAYER, &
- PROOTFRAC, PWFC, PWWILT, PWSAT, PBCOEF, PCONDSAT, &
- PMPOTSAT, PHCAPSOIL, PCONDDRY, PCONDSLD, PD_ICE, PKSAT_ICE,&
- PMUF, PFF, PFFG, PFFV, PFFG_NOSNOW, PFFV_NOSNOW, PFFROZEN, &
- PFALB, PFEMIS, PFFLOOD, PPIFLOOD, PIFLOOD, PPFLOOD, &
- PLE_FLOOD, PLEI_FLOOD, PSODELX, PLAT, PLON, PTG, PWG, &
- PWGI, PCPS, PLVTT, PLSTT, PWR, &
- PWRL,PWRLI,PWRVN,PTV, PTL, &
- PRESA, PANFM, PFSAT, &
- PSNOWALB, PSNOWALBVIS, PSNOWALBNIR, PSNOWALBFIR, &
- PSNOWSWE, PSNOWHEAT, PSNOWRHO, PSNOWGRAN1, &
- PSNOWGRAN2, PSNOWHIST, PSNOWAGE, PGRNDFLUX, PHPSNOW, &
- PSNOWHMASS, PRNSNOW, PHSNOW, PGFLUXSNOW, &
- PUSTARSNOW, PSRSFC, PRRSFC, PLESL, PEMISNOW, PCDSNOW, &
- PCHSNOW, PTS_RAD, PTS, PHV, PQS, PSNOWTEMP, PSNOWLIQ, &
- PSNOWDZ, PCG, PC1, PC2, PWGEQ, PCT, PCH, PCD, PCDN, PRI, &
- PHU, PHUG, PEMIST, PALBT, PRS, PLE, PRN, PH, PLEI, PLEGI, &
- PLEG, PLEV, PLES, PLER, PLETR, PEVAP, PGFLUX, PRESTORE, &
- PUSTAR, PDRAIN, PRUNOFF, PMELT, PMELTADV, &
- PTC, PQC, PRN_ISBA, &
- PH_ISBA, PLEG_ISBA, PLEGI_ISBA, PLEV_ISBA, PLETR_ISBA, &
- PUSTAR_ISBA, PLER_ISBA, PLE_ISBA, PLEI_ISBA, PGFLUX_ISBA, &
- PHORT, PDRIP, PRRVEG, PAC_AGG, PHU_AGG, PFAPARC, PFAPIRC, &
- PMUS, PLAI_EFFC, PAN, PANDAY, PRESP_BIOMASS_INST, PIACAN, &
- PANF, PGPP, PFAPAR, PFAPIR, PFAPAR_BS, PFAPIR_BS, &
- PIRRIG_FLUX, PDEEP_FLUX, &
- PSWNET_V, PSWNET_G, PSWNET_N, PSWNET_NS, &
- PLWNET_V, PLWNET_G, PLWNET_N, &
- PLEV_V_C, PLES_V_C, PH_V_C, PH_G_C, &
- PLETR_G_C, PLETR_V_C, PLER_G_C, PLELITTER,PLELITTERI, &
- PDRIPLIT,PRRLIT, PLER_V_C, PH_C_A, PH_N_C, &
- PLE_C_A, PLE_V_C, PLE_G_C, PLE_N_C, &
- PEVAP_N_C, PEVAP_G_C, &
- PSR_GN, PMELTCV, PFRZCV, &
- PSWDOWN_GN, PLWDOWN_GN, &
- PIRRIG_GR, PTOPQS, PQSB, PSUBL, &
- PFWTD, PWTD, PSNDRIFT )
+ PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
+ PALBNIR_TVEG, PALBVIS_TVEG, PALBNIR_TSOIL, PALBVIS_TSOIL, &
+ PPALPHAN, PZ0G_WITHOUT_SNOW, PZ0_MEBV, PZ0H_MEBV, &
+ PZ0EFF_MEBV, PZ0_MEBN, PZ0H_MEBN, PZ0EFF_MEBN, PTDEEP_A, &
+ PCSP, PFFG_NOSNOW, PFFV_NOSNOW, PEMIST, PUSTAR, PAC_AGG, &
+ PHU_AGG, PRESP_BIOMASS_INST, PDEEP_FLUX, PIRRIG_GR )
! ##########################################################################
!
!
@@ -119,7 +64,7 @@
!! New variables WGI1, WGI2
!! (A.Boone) 18/01/00 ISBA-ES (3-layer explicit snow scheme option)
!! (Boone and Etchevers 2000)
-!! New variable PSNOWHEAT
+!! New variable IPEK%TSNOW%HEAT(:,:,1)
!! (V. Masson) 01/2004 wet leaves fraction computed in separate routine
!! all vegetation stress (ISBA, AGS, AST) routines
!! called at the same point
@@ -152,12 +97,21 @@
!! Routines drag, e_budget and isba_fluxes now in isba_ceb
!! (A. Boone & P. Samuelsson) (10/2014) Added MEB v1
!! (P. LeMoigne) 12/2014 EBA scheme update
-!! (A. Boone) 02/2015 Consider spectral band dependence of snow for OTR_ML radiation option
+!! (A. Boone) 02/2015 Consider spectral band dependence of snow for IO%LTR_ML radiation option
!! B. Decharme 01/16 : Bug with flood budget
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
+!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_AGRI_n, ONLY : AGRI_t
+USE MODD_DIAG_n, ONLY : DIAG_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
+!
USE MODD_CO2V_PAR, ONLY : XMC, XMCO2, XPCCO2
USE MODD_SURF_PAR, ONLY : XUNDEF
!
@@ -199,99 +153,29 @@ IMPLICIT NONE
!* general variables
! -----------------
!
- CHARACTER(LEN=*), INTENT(IN) :: HISBA ! type of ISBA version:
-! ! '2-L' (default)
-! ! '3-L'
-! ! 'DIF'
- CHARACTER(LEN=*), INTENT(IN) :: HPHOTO ! Kind of photosynthesis
-! ! 'NON'
-! ! 'AGS'
-! ! 'LAI'
-! ! 'AST'
-! ! 'LST'
-LOGICAL, INTENT(IN) :: OTR_ML ! new TR
- CHARACTER(LEN=*), INTENT(IN) :: HRUNOFF ! surface runoff formulation
-! ! 'WSAT'
-! ! 'DT92'
-! ! 'SGH ' Topmodel
- CHARACTER(LEN=*), INTENT(IN) :: HKSAT ! soil hydraulic profil option
-! ! 'DEF' = ISBA homogenous soil
-! ! 'SGH' = ksat exponential decay
- CHARACTER(LEN=*), INTENT(IN) :: HRAIN ! Rainfall spatial distribution
- ! 'DEF' = No rainfall spatial distribution
- ! 'SGH' = Rainfall exponential spatial distribution
- CHARACTER(LEN=*), INTENT(IN) :: HHORT ! Horton runoff
- ! 'DEF' = no Horton runoff
- ! 'SGH' = Horton runoff
- CHARACTER(LEN=*), INTENT(IN) :: HC1DRY ! C1 for dry soil formulation
-! ! 'DEF' Default: Giard and Bazile
-! ! 'GB93' Giordani 1993, Braud 1993
-! ! (discontinuous at WILT)
- CHARACTER(LEN=*), INTENT(IN) :: HSCOND ! Thermal conductivity
-! ! 'NP89' = NP89 implicit method
-! ! 'PL98' = Peters-Lidard et al. 1998 used
-! ! for explicit computation of CG
- CHARACTER(LEN=*), INTENT(IN) :: HSNOW_ISBA ! 'DEF' = Default F-R snow scheme
-! ! (Douville et al. 1995)
-! ! '3-L' = 3-L snow scheme (option)
-! ! (Boone and Etchevers 2000)
- CHARACTER(LEN=*), INTENT(IN) :: HSNOWRES ! 'DEF' = Default: Louis (ISBA)
-! ! 'RIL' = CROCUS (Martin) method
-! ! ISBA-SNOW3L turbulant exchange option
- CHARACTER(LEN=*), INTENT(IN) :: HCPSURF ! Specific heat
-! ! 'DRY' = dry Cp
-! ! 'HUM' = humid Cp fct of qs
- CHARACTER(LEN=*), INTENT(IN) :: HSOILFRZ ! soil freezing-physics option
-! ! 'DEF' Default (Boone et al. 2000; Giard and Bazile 2000)
-! ! 'LWT' phase changes as above, but relation between unfrozen
-! water and temperature considered
- CHARACTER(LEN=*), INTENT(IN) :: HDIFSFCOND ! NOTE: Only used when HISBA = DIF
-! ! MLCH' = include the insulating effect of leaf
-! ! litter/mulch on the surface thermal cond.
-! ! 'DEF' = no mulch effect
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(GRID_t), INTENT(INOUT) :: G
+TYPE(AGRI_t), INTENT(INOUT) :: AG
+TYPE(DIAG_t), INTENT(INOUT) :: DK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK
!
TYPE(DATE_TIME), INTENT(IN) :: TPTIME ! current date and time
!
-LOGICAL, INTENT(IN) :: OFLOOD ! Activation of the flooding scheme
-LOGICAL, INTENT(IN) :: OTEMP_ARP ! True = time-varying force-restore soil temperature (as in ARPEGE)
- ! False = No time-varying force-restore soil temperature (Default)
-LOGICAL, INTENT(IN) :: OGLACIER ! True = Over permanent snow and ice,
-! initialise WGI=WSAT,
-! Hsnow>=10m and allow 0.8<SNOALB<0.85
- ! False = No specific treatment
-LOGICAL, INTENT(IN) :: OMEB ! True = patch with multi-energy balance
+REAL, DIMENSION(:), INTENT(IN) :: PPOI ! Gaussian weights (as above)
+REAL, DIMENSION(:), INTENT(INOUT) :: PABC ! abscissa needed for integration
+! ! of net assimilation and stomatal
+! ! conductance over canopy depth
+REAL, DIMENSION(:,:), INTENT(OUT) :: PIACAN ! PAR in the canopy at different gauss level
+LOGICAL, INTENT(IN) :: OMEB ! True = patch with multi-energy balance
! ! False = patch with classical ISBA
-LOGICAL, INTENT(IN) :: OMEB_LITTER ! explicit litter layer (MEB option)
-LOGICAL, INTENT(IN) :: OMEB_GNDRES ! ground resistance (MEB option)
-LOGICAL, INTENT(IN) :: OFORC_MEASURE
-!
- CHARACTER(LEN=*), INTENT(IN) :: HIMPLICIT_WIND ! wind implicitation option
+REAL, INTENT(IN) :: PTSTEP ! timestep of the integration
+CHARACTER(LEN=*), INTENT(IN) :: HIMPLICIT_WIND ! wind implicitation option
! ! 'OLD' = direct
! ! 'NEW' = Taylor serie, order 1
-!
-LOGICAL, INTENT(IN) :: OAGRI_TO_GRASS
-LOGICAL, INTENT(IN) :: OSNOWDRIFT ! activate snowdrift
-LOGICAL, INTENT(IN) :: OSNOWDRIFT_SUBLIM ! activate sublimation during drift
-LOGICAL, INTENT(IN) :: OSNOW_ABS_ZENITH ! activate parametrization of solar absorption for polar regions
- CHARACTER(3), INTENT(IN) :: HSNOWMETAMO
- !-----------------------
- ! Crocus metamorphism scheme
- ! HSNOWMETAMO=B92 Brun et al 1992
- ! HSNOWMETAMO=C13 Carmagnola et al 2014
- ! HSNOWMETAMO=T07 Taillandier et al 2007
- ! HSNOWMETAMO=F06 Flanner et al 2006
- CHARACTER(3), INTENT(IN) :: HSNOWRAD
- !-----------------------
- ! Crocus radiative transfer scheme
- ! HSNOWRAD=B92 Brun et al 1992
- ! HSNOWRAD=TAR TARTES (Libois et al 2013)
- ! HSNOWRAD=TA1 TARTES with constant impurities
- ! HSNOWRAD=TA2 TARTES with constant impurities as function of ageing
-!
-REAL, INTENT(IN) :: PTSTEP ! timestep of the integration
-!
-REAL, INTENT(IN) :: PCGMAX ! maximum soil heat capacity
-!
REAL, DIMENSION(:), INTENT(IN) :: PZREF ! normal distance of the first
! ! atmospheric level to the
! ! orography
@@ -302,9 +186,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PUREF ! reference height of the wind
REAL, DIMENSION(:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus along z
! ! directions at surface w-point
!
-REAL, DIMENSION(:), INTENT(IN) :: PLAT ! Latitude
-REAL, DIMENSION(:), INTENT(IN) :: PLON ! Longitude
-!
!* atmospheric variables
! ---------------------
!
@@ -345,57 +226,13 @@ REAL, DIMENSION(:), INTENT(IN) :: PPEW_A_COEF, PPEW_B_COEF, &
!* vegetation parameters
! ---------------------
!
-REAL, DIMENSION(:), INTENT(IN) :: PRSMIN ! minimum stomatal resistance
-REAL, DIMENSION(:), INTENT(IN) :: PRGL ! maximum solar radiation
-! ! usable in photosynthesis
-REAL, DIMENSION(:), INTENT(IN) :: PGAMMA ! coefficient for the calculation
-! ! of the surface stomatal
-! ! resistance
-REAL, DIMENSION(:), INTENT(IN) :: PCV ! 2*sqrt(pi/day)/sqrt(Cveg*hveg)
-! ! where Cveg and hveg are the
-! ! heat capacity and conductivity
-! ! of the vegetation
-REAL, DIMENSION(:), INTENT(IN) :: PRUNOFFD ! depth over which sub-grid runoff computed (m)
-REAL, DIMENSION(:,:),INTENT(IN) :: PSOILWGHT ! ISBA-DIF: weights for vertical
-! ! integration of soil water and properties
-INTEGER, INTENT(IN) :: KLAYER_HORT! DIF optimization
-INTEGER, INTENT(IN) :: KLAYER_DUN ! DIF optimization
-!
REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_TVEG ! tot albedo of vegetation in NIR (needed for LM_TR)
REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_TVEG ! tot albedo of vegetation in VIS
REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_TSOIL ! tot albedo of bare soil in NIR
REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_TSOIL ! tot albedo of bare soil in VIS
-REAL, DIMENSION(:), INTENT(IN) :: PALB ! albedo of vegetation
-REAL, DIMENSION(:), INTENT(IN) :: PWRMAX_CF ! coefficient for maximum water interception
-! ! storage capacity on the vegetation (-)
-REAL, DIMENSION(:), INTENT(IN) :: PVEG ! fraction of vegetation of the
-! ! mesh covered by natural or
-! ! agricultural areas
-! ! 1-PVEG --> bare soil
-REAL, DIMENSION(:), INTENT(IN) :: PGNDLITTER ! litter thickness, MEB option (m)
-REAL, DIMENSION(:), INTENT(IN) :: PLAI ! LAI as a function of time:
-! ! as a function of growth,
-! ! decay, assimilation.
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS ! emissivity of natural surfaces
-! ! (without prognostic snow)
-REAL, DIMENSION(:), INTENT(IN) :: PZ0_WITH_SNOW ! roughness length for momentum
-! ! (with snow taken into account)
-REAL, DIMENSION(:), INTENT(IN) :: PZ0H_WITH_SNOW ! roughness length for heat
-! ! (with snow taken into account)
-!
!
! For multi-energy balance
-REAL, DIMENSION(:,:), INTENT(IN) :: PROOTFRACCV
-REAL, DIMENSION(:), INTENT(IN) :: PRGLCV
-REAL, DIMENSION(:), INTENT(IN) :: PGAMMACV
-REAL, DIMENSION(:), INTENT(IN) :: PRSMINCV
-REAL, DIMENSION(:), INTENT(IN) :: PWRMAX_CFCV
-REAL, DIMENSION(:), INTENT(IN) :: PLAIV ! explicit canopy overstory LAI..."PLAI" is the composite surface LAI
-! ! (when MEB is ON, "PLAI" corresponds to understory LAI (possibly zero),
-! ! while "PLAV" is the overstory LAI)
-REAL, DIMENSION(:), INTENT(IN) :: PH_VEG ! height of vegetation
-REAL, DIMENSION(:), INTENT(IN) :: PBSLAI ! ratio of biomass to LAI (kg m-2)
-REAL, DIMENSION(:), INTENT(IN) :: PLAIMIN ! Minimum LAI (m2 m-2)
+!
REAL, DIMENSION(:), INTENT(IN) :: PPALPHAN ! snow/canopy transition coefficient
REAL, DIMENSION(:), INTENT(IN) :: PZ0G_WITHOUT_SNOW ! roughness length for momentum at snow-free canopy floor
REAL, DIMENSION(:), INTENT(IN) :: PZ0_MEBV ! roughness length for momentum over MEB vegetation part of patch
@@ -405,471 +242,113 @@ REAL, DIMENSION(:), INTENT(IN) :: PZ0_MEBN ! roughness length for m
REAL, DIMENSION(:), INTENT(IN) :: PZ0H_MEBN ! roughness length for heat over MEB snow part of path
REAL, DIMENSION(:), INTENT(IN) :: PZ0EFF_MEBN ! roughness length for momentum over MEB snow part of patch
!
-!* ISBA-Ags (with LAI evolution) parameters
-! ----------------------------------------
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE ! fraction of each vegetation
-!
-!* subgrid-scale orography parameters
-! ----------------------------------
-!
-REAL, DIMENSION(:), INTENT(IN) :: PZ0EFF ! roughness length for momentum
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRUNOFFB ! slope of the runoff curve
-!
!* soil parameters
! ---------------
!
-REAL, DIMENSION(:), INTENT(IN) :: PCGSAT ! thermal coefficient at
-! ! saturation
-REAL, DIMENSION(:), INTENT(IN) :: PC1SAT ! C1 coefficient at saturation
-REAL, DIMENSION(:), INTENT(IN) :: PC2REF ! reference value of C2
-REAL, DIMENSION(:,:), INTENT(IN):: PC3 ! C3 coefficient
-REAL, DIMENSION(:), INTENT(IN) :: PC4B ! fiiting soil paramater for vertical diffusion (C4)
-REAL, DIMENSION(:), INTENT(IN) :: PC4REF ! "
-REAL, DIMENSION(:), INTENT(IN) :: PACOEF ! a and p coefficients for
-REAL, DIMENSION(:), INTENT(IN) :: PPCOEF ! the wgeq calculations.
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTAUICE ! characteristic time scale for phase change
-! ! within the soil
-!
-REAL, DIMENSION(:), INTENT(IN) :: PWDRAIN ! minimum Wg for drainage (m3/m3)
-!
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTDEEP_A, PTDEEP_B
- ! Deep soil temperature (prescribed)
-! PTDEEP_A = Deep soil temperature
+REAL, DIMENSION(:), INTENT(IN) :: PTDEEP_A ! Deep soil temperature (prescribed)
+! PTDEEP_A = Deep soil temperature
! coefficient depending on flux
-! PTDEEP_B = Deep soil temperature (prescribed)
-! which models heating/cooling from
-! below the diurnal wave penetration
-! (surface temperature) depth. If it
-! is FLAGGED as undefined, then the zero
-! flux lower BC is applied.
-! Tdeep = PTDEEP_B + PTDEEP_A * PDEEP_FLUX
-! (with PDEEP_FLUX in W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PGAMMAT ! Deep soil heat transfer coefficient:
-! ! assuming homogeneous soil so that
-! ! this can be prescribed in units of
-! ! (1/days): associated time scale with
-! ! PTDEEP.
-!
-REAL, DIMENSION(:), INTENT(IN) :: PPSN ! fraction of the grid covered
-! ! by snow
-REAL, DIMENSION(:), INTENT(IN) :: PPSNG ! fraction of the the bare
-! ! ground covered by snow
-REAL, DIMENSION(:), INTENT(IN) :: PPSNV ! fraction of the the veg.
-! ! covered by snow
-REAL, DIMENSION(:), INTENT(IN) :: PPSNV_A ! snow free albedo of vegetation
- ! for EBA
-REAL, DIMENSION(:), INTENT(IN) :: PSNOWFREE_ALB_VEG ! snow free albedo of vegetation
-REAL, DIMENSION(:), INTENT(IN) :: PSNOWFREE_ALB_SOIL ! snow free albedo of soil
-!
-REAL ,DIMENSION(:),INTENT(IN) :: PIRRIG
-REAL ,DIMENSION(:),INTENT(IN) :: PWATSUP
-REAL ,DIMENSION(:),INTENT(IN) :: PTHRESHOLD
-LOGICAL,DIMENSION(:),INTENT(IN) :: LIRRIGATE
-LOGICAL,DIMENSION(:),INTENT(INOUT) :: LIRRIDAY
-REAL ,DIMENSION(:),INTENT(IN) :: PIRRIG_GR ! ground irrigation rate (kg/m2/s)
-!
!* ISBA-Ags parameters
! -------------------
!
-LOGICAL, DIMENSION(:), INTENT(IN) :: OSTRESSDEF ! vegetation response type to water
-! ! stress (true:defensive false:offensive)
-REAL, DIMENSION(:), INTENT(IN) :: PGC ! cuticular conductance (m s-1)
-REAL, DIMENSION(:), INTENT(IN) :: PF2I ! critical normilized soil water
-! ! content for stress parameterisation
-REAL, DIMENSION(:), INTENT(IN) :: PDMAX ! maximum air saturation deficit
-! ! tolerate by vegetation
-REAL, DIMENSION(:), INTENT(IN) :: PAH,PBH ! coefficients for herbaceous water stress
-! ! response (offensive or defensive)
-!
REAL, DIMENSION(:), INTENT(IN) :: PCSP ! atmospheric CO2 concentration
! [ppmm]=[kg CO2 / kg air]
-REAL, DIMENSION(:), INTENT(IN) :: PGMES ! mesophyll conductance (m s-1)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PPOI ! Gaussian weights (as above)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PFZERO ! ideal value of F, no photo-
-! ! respiration or saturation deficit
-REAL, DIMENSION(:), INTENT(IN) :: PEPSO ! maximum initial quantum use
-! ! efficiency (mg J-1 PAR)
-REAL, DIMENSION(:), INTENT(IN) :: PGAMM ! CO2 conpensation concentration (ppmv)
-REAL, DIMENSION(:), INTENT(IN) :: PQDGAMM ! Log of Q10 function for CO2 conpensation
-! ! concentration
-REAL, DIMENSION(:), INTENT(IN) :: PQDGMES ! Log of Q10 function for mesophyll conductance
-REAL, DIMENSION(:), INTENT(IN) :: PT1GMES ! reference temperature for computing
-! ! compensation concentration function for
-! ! mesophyll conductance: minimum
-! ! temperature
-REAL, DIMENSION(:), INTENT(IN) :: PT2GMES ! reference temperature for computing
-! ! compensation concentration function for
-! ! mesophyll conductance: maximum
-! ! temperature
-REAL, DIMENSION(:), INTENT(IN) :: PAMAX ! leaf photosynthetic capacity (kgCO2 m-2 s-1)
-REAL, DIMENSION(:), INTENT(IN) :: PQDAMAX ! Log of Q10 function for leaf photosynthetic capacity
-REAL, DIMENSION(:), INTENT(IN) :: PT1AMAX ! reference temperature for computing
-! ! compensation concentration function for leaf
-! ! photosynthetic capacity: minimum
-! ! temperature
-REAL, DIMENSION(:), INTENT(IN) :: PT2AMAX ! reference temperature for computing
-! ! compensation concentration function for leaf
-! ! photosynthetic capacity: maximum
-! ! temperature
-REAL, DIMENSION(:), INTENT(INOUT) :: PABC ! abscissa needed for integration
-! ! of net assimilation and stomatal
-! ! conductance over canopy depth
-!
-!* Multi-energy balance variables:
-! ---------------------------------
-!
-! diagnostic variables
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PTC ! Canopy air temperature
-REAL, DIMENSION(:), INTENT(INOUT) :: PQC ! Canopy air specific humidity
-!
-! Prognostic variables:
!
!* ISBA-DF variables/parameters:
! ------------------------------
-! Parameters:
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_G ! Depth of Bottom of Soil layers (m)
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZG ! soil layers thicknesses (DIF option) (m)
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZDIF ! distance between consecuative layer mid-points (DIF option) (m)
-INTEGER, DIMENSION(:),INTENT(IN) :: KWG_LAYER ! Number of soil moisture layers (DIF option)
-REAL, DIMENSION(:,:), INTENT(IN) :: PROOTFRAC ! root fraction (-)
-REAL, DIMENSION(:,:), INTENT(IN) :: PWFC ! field capacity profile (m3/m3)
-REAL, DIMENSION(:,:), INTENT(IN) :: PWWILT ! wilting point profile (m3/m3)
-REAL, DIMENSION(:,:), INTENT(IN) :: PWSAT ! porosity profile (m3/m3)
-REAL, DIMENSION(:,:), INTENT(IN) :: PBCOEF ! soil water CH78 b-parameter (-)
-REAL, DIMENSION(:,:), INTENT(IN) :: PCONDSAT ! hydraulic conductivity at saturation (m/s)
-REAL, DIMENSION(:,:), INTENT(IN) :: PMPOTSAT ! matric potential at saturation (m)
-REAL, DIMENSION(:,:), INTENT(IN) :: PHCAPSOIL ! soil heat capacity [J/(K m3)]
-REAL, DIMENSION(:,:), INTENT(IN) :: PCONDDRY ! soil dry thermal conductivity [W/(m K)]
-REAL, DIMENSION(:,:), INTENT(IN) :: PCONDSLD ! soil solids thermal conductivity [W/(m K)]
-!
-REAL, DIMENSION(:), INTENT(IN) :: PD_ICE !depth of the soil column for the calculation
-! of the frozen soil fraction (m)
-REAL, DIMENSION(:), INTENT(IN) :: PKSAT_ICE !hydraulic conductivity at saturation (m/s)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PMUF !fraction of the grid cell reached by the rainfall
-!
-REAL, DIMENSION(:), INTENT(IN) :: PFF !Floodplain fraction at the surface
-REAL, DIMENSION(:), INTENT(IN) :: PFFG !Floodplain fraction over the ground
-REAL, DIMENSION(:), INTENT(IN) :: PFFV !Floodplain fraction over vegetation
+!
REAL, DIMENSION(:), INTENT(IN) :: PFFG_NOSNOW ! Without snow (ES)
REAL, DIMENSION(:), INTENT(IN) :: PFFV_NOSNOW ! Without snow (ES)
-REAL, DIMENSION(:), INTENT(IN) :: PFFROZEN !Fraction of frozen flood
-REAL, DIMENSION(:), INTENT(IN) :: PFALB !Floodplain albedo
-REAL, DIMENSION(:), INTENT(IN) :: PFEMIS !Floodplain emis
-REAL, DIMENSION(:), INTENT(IN) :: PFFLOOD !Efective floodplain fraction
-REAL, DIMENSION(:), INTENT(IN) :: PPIFLOOD !Floodplains potential infiltration [kg/m²/s]
-REAL, DIMENSION(:), INTENT(INOUT):: PIFLOOD !Floodplains infiltration [kg/m²/s]
-REAL, DIMENSION(:), INTENT(INOUT):: PPFLOOD !Floodplains direct precipitation [kg/m²/s]
-REAL, DIMENSION(:), INTENT(INOUT):: PLE_FLOOD, PLEI_FLOOD !Floodplains latent heat flux [W/m²]
-!
-REAL, DIMENSION(:), INTENT(IN) :: PSODELX ! Pulsation for each layer (Only used if LTEMP_ARP=True)
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PTOPQS !Topmodel (HRUNOFF=SGH) subsurface flow by layer for DIF (m/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PQSB !Topmodel (HRUNOFF=SGH) Lateral subsurface flow for DIF [kg/m²/s]
-!
-REAL, DIMENSION(:), INTENT(IN) :: PFWTD ! grid-cell fraction of water table rises
-REAL, DIMENSION(:), INTENT(IN) :: PWTD ! water table depth from hydrological model (m)
-! ! negative below the soil surface
-!
-!* prognostic variables
-! --------------------
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTG, PWG, PWGI
-! PTG ! soil layer average temperatures (K)
-! PWG ! soil liquid volumetric water content (m3/m3)
-! PWGI ! soil frozen volumetric water content (m3/m3)
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PCPS, PLVTT, PLSTT
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PWR ! liquid water retained on the
-! ! foliage of the comosite vegetation
-! ! canopy (understory in the case of MEB)
-! For multi-energy balance
-REAL, DIMENSION(:), INTENT(INOUT) :: PWRL
-! PWRL = litter reservoir for water
-REAL, DIMENSION(:), INTENT(INOUT) :: PWRLI
-! PWRLI = litter reservoir for ice
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PWRVN, PTV, PTL
-! PWRVN = snow retained on the foliage
-! of the canopy vegetation
-! PTV = canopy vegetation temperature
-! PTL = litter temperature
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PRESA ! aerodynamic resistance
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PANFM ! maximum leaf assimilation
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PFSAT ! Topmodel saturated fraction
-!
-!* ISBA-SNOW3L variables/parameters:
-! ---------------------------------
-!
-! Prognostic variables:
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PSNOWALB ! Snow albedo
-REAL, DIMENSION(:), INTENT(INOUT) :: PSNOWALBVIS ! Snow VIS albedo
-REAL, DIMENSION(:), INTENT(INOUT) :: PSNOWALBNIR ! Snow NIR albedo
-REAL, DIMENSION(:), INTENT(INOUT) :: PSNOWALBFIR ! Snow FIR albedo
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWSWE ! Snow model layer liquid water equivalent or SWE (kg m-2)
-! ! NOTE for 'DEF' snow option, only uppermost element
-! ! of this array is non-zero (as it's a one layer scheme)
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWHEAT ! Snow layer heat content (J/m3)
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWRHO ! Snow layer average density (kg/m3)
-! ! NOTE for 'DEF' snow option, only uppermost element
-! ! of this array is used (as it's a one layer scheme)
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWGRAN1 ! Snow grain parameter 1
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWGRAN2 ! Snow grain parameter 2
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWHIST ! Snow grain historical parameter
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWAGE ! Snow grain age
-! NOTE : methamorphism is only activated if the flag
-! OSNOW_METAMO=TRUE
-!
-! Diagnostics:
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PGRNDFLUX ! snow/soil-biomass interface flux (W/m2)
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PHPSNOW ! heat release from rainfall (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSNOWHMASS ! snow heat content change from mass changes (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PRNSNOW ! net radiative flux from snow (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PHSNOW ! sensible heat flux from snow (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUXSNOW ! net heat flux from snow (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PUSTARSNOW ! friction velocity
-REAL, DIMENSION(:), INTENT(OUT) :: PSRSFC ! Snow rate falling outside of snow
-! covered grid area [kg/(m2 s)]
-REAL, DIMENSION(:), INTENT(OUT) :: PRRSFC ! Rain rate falling outside of snow and flood
-! covered grid area [kg/(m2 s)]
-REAL, DIMENSION(:), INTENT(OUT) :: PLESL ! Evaporation (liquid) from wet snow (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PEMISNOW ! snow surface emissivity
-REAL, DIMENSION(:), INTENT(OUT) :: PCDSNOW ! drag coefficient for momentum over snow
-REAL, DIMENSION(:), INTENT(OUT) :: PCHSNOW ! drag coefficient for heat over snow
-REAL, DIMENSION(:), INTENT(OUT) :: PTS_RAD ! effective radiative temperature
-! of the natural surface (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PTS ! effective surface temperature (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PHV ! Halstead coefficient
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSNOWTEMP ! snow layer temperatures (K)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSNOWLIQ ! snow layer liquid water content (m)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSNOWDZ ! snow layer thickness (m)
-!
-!
-!* output soil parameters
-! ----------------------
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PCG ! heat capacity of the ground
-REAL, DIMENSION(:), INTENT(OUT) :: PC1 ! coefficients for the moisure
-REAL, DIMENSION(:), INTENT(OUT) :: PC2 ! equation.
-REAL, DIMENSION(:), INTENT(OUT) :: PWGEQ ! equilibrium volumetric water
-! ! content
-REAL, DIMENSION(:), INTENT(OUT) :: PCT ! area-averaged heat capacity
-!
!
!* diagnostic variables
! --------------------
!
-REAL, DIMENSION(:), INTENT(OUT) :: PCH ! grid-area drag coefficient for heat
-REAL, DIMENSION(:), INTENT(OUT) :: PCD ! grid-area drag coefficient for momentum
-REAL, DIMENSION(:), INTENT(OUT) :: PCDN ! grid-area neutral drag coefficient for momentum
-REAL, DIMENSION(:), INTENT(OUT) :: PRI ! grid-area Richardson number
-REAL, DIMENSION(:), INTENT(OUT) :: PQS ! grid-area surface humidity (kg/kg)
-REAL, DIMENSION(:), INTENT(OUT) :: PHU ! grid-area humidity of the soil
REAL, DIMENSION(:), INTENT(OUT) :: PEMIST ! grid-area surface emissivity
-REAL, DIMENSION(:), INTENT(OUT) :: PALBT ! grid-area surface albedo
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PHUG ! ground relative humidity
-REAL, DIMENSION(:), INTENT(OUT) :: PRS ! surface stomatal resistance
!
!* surface fluxes
! --------------
!
-REAL, DIMENSION(:), INTENT(INOUT) :: PLE ! total latent heat flux
-REAL, DIMENSION(:), INTENT(OUT) :: PRN ! net radiation
-REAL, DIMENSION(:), INTENT(OUT) :: PH ! sensible heat flux
-REAL, DIMENSION(:), INTENT(OUT) :: PLEI ! sublimation latent heat flux
-REAL, DIMENSION(:), INTENT(OUT) :: PLEGI ! latent heat of sublimation over frozen soil
-REAL, DIMENSION(:), INTENT(OUT) :: PLELITTER ! evapaporation of litter in litter reservoir
-REAL, DIMENSION(:), INTENT(OUT) :: PLELITTERI ! sublimation of water in litter reservoir
-REAL, DIMENSION(:), INTENT(OUT) :: PDRIPLIT !
-REAL, DIMENSION(:), INTENT(OUT) :: PRRLIT !
-REAL, DIMENSION(:), INTENT(OUT) :: PLEG ! latent heat of evaporation
-! ! over the ground
-REAL, DIMENSION(:), INTENT(OUT) :: PLEV ! latent heat of evaporation
-! ! over the vegetation
-REAL, DIMENSION(:), INTENT(OUT) :: PLES ! latent heat of sublimation
-! ! over the snow
-REAL, DIMENSION(:), INTENT(OUT) :: PLER ! latent heat of the fraction
-! ! delta of water retained on the
-! ! foliage of the vegetation
-REAL, DIMENSION(:), INTENT(OUT) :: PLETR ! evapotranspiration of the rest
-! ! of the vegetation
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAP ! total evaporative flux (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PSUBL ! sublimation flux (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX ! flux through the ground
-REAL, DIMENSION(:), INTENT(OUT) :: PRESTORE ! surface restore flux (W m-2)
REAL, DIMENSION(:), INTENT(OUT) :: PUSTAR ! friction velocity
-REAL, DIMENSION(:), INTENT(OUT) :: PDRAIN ! drainage
-REAL, DIMENSION(:), INTENT(OUT) :: PRUNOFF ! runoff
-REAL, DIMENSION(:), INTENT(OUT) :: PMELT ! melting rate of the snow (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PMELTADV ! advection heat flux from snowmelt (W/m2)
-REAL ,DIMENSION(:), INTENT(OUT) :: PIRRIG_FLUX! irrigation rate (kg/m2/s)
-REAL ,DIMENSION(:), INTENT(OUT) :: PSNDRIFT ! blowing snow sublimation (kg/m2/s)
!
! The following surface fluxes are from snow-free portion of grid
! box when the ISBA-ES option is ON. Otherwise, they are equal
! to the same variables without the _ISBA extension.
!
-REAL, DIMENSION(:), INTENT(OUT) :: PRN_ISBA ! net radiation
-REAL, DIMENSION(:), INTENT(OUT) :: PH_ISBA ! sensible heat flux
-REAL, DIMENSION(:), INTENT(OUT) :: PLEG_ISBA ! latent heat of evaporation (ground)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEGI_ISBA ! latent heat of sublimation (ground)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEV_ISBA ! latent heat of evaporation (vegetation)
-REAL, DIMENSION(:), INTENT(OUT) :: PLETR_ISBA ! latent heat of evaporation (transpiration)
-REAL, DIMENSION(:), INTENT(OUT) :: PUSTAR_ISBA! friction velocity
-REAL, DIMENSION(:), INTENT(OUT) :: PLER_ISBA ! latent heat of evaporation (plant interception)
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_ISBA ! total latent heat flux
-REAL, DIMENSION(:), INTENT(OUT) :: PLEI_ISBA ! sublimation latent heat flux
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX_ISBA! flux through the ground
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PHORT !Horton runoff (kg/m2/s)
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PDRIP !Dripping from the vegetation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PRRVEG !Precip. intercepted by vegetation (kg/m2/s)
-!
REAL, DIMENSION(:), INTENT(OUT) :: PAC_AGG ! aggregated aerodynamic conductance
! for evaporative flux calculations
REAL, DIMENSION(:), INTENT(OUT) :: PHU_AGG ! aggregated relative humidity
! for evaporative flux calculations
!
-!
!* diagnostic variables for Carbon assimilation
! --------------------------------------------
!
-REAL, DIMENSION(:), INTENT(INOUT) :: PAN ! net CO2 assimilation ( kgCO2/kgair * m/s)
-REAL, DIMENSION(:), INTENT(INOUT) :: PANDAY ! daily net CO2 assimilation (kgCO2/m2/day)
REAL, DIMENSION(:,:), INTENT(OUT) :: PRESP_BIOMASS_INST ! instantaneous biomass respiration (kgCO2/kgair m/s)
-REAL, DIMENSION(:), INTENT(INOUT) :: PFAPARC ! Fapar of vegetation (cumul)
-REAL, DIMENSION(:), INTENT(INOUT) :: PFAPIRC ! Fapir of vegetation (cumul)
-REAL, DIMENSION(:), INTENT(INOUT) :: PMUS
-REAL, DIMENSION(:), INTENT(INOUT) :: PLAI_EFFC ! Effective LAI (cumul)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PIACAN ! PAR in the canopy at different gauss level
-REAL, DIMENSION(:), INTENT(OUT) :: PANF ! total assimilation over canopy
-REAL, DIMENSION(:), INTENT(OUT) :: PGPP ! Gross Primary Production
-REAL, DIMENSION(:), INTENT(OUT) :: PFAPAR ! Fapar of vegetation
-REAL, DIMENSION(:), INTENT(OUT) :: PFAPIR ! Fapir of vegetation
-REAL, DIMENSION(:), INTENT(OUT) :: PFAPAR_BS ! Fapar of bare soil
-REAL, DIMENSION(:), INTENT(OUT) :: PFAPIR_BS ! Fapir of bare soil
!
!* diagnostic variables for multi-energy balance (MEB)
! ---------------------------------------------------
!
-REAL, DIMENSION(:), INTENT(OUT) :: PSWNET_V ! MEB: net vegetation canopy shortwave radiation [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PSWNET_G ! MEB: net ground shortwave radiation [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PSWNET_N ! MEB: net snow shortwave radiation [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PSWNET_NS ! MEB: net snow shortwave radiation for *surface* layer
- ! (i.e. net snow shortwave radiation less absorbed radiation) [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PLWNET_V ! MEB: net vegetation canopy longwave radiation [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PLWNET_G ! MEB: net ground longwave radiation [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PLWNET_N ! MEB: net snow longwave radiation [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PLEV_V_C ! MEB: total evapotranspiration (no sublim) from vegetation canopy overstory [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PLES_V_C ! MEB: total snow sublimation from vegetation canopy overstory [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PH_V_C ! MEB: sensible heat flux from vegetation canopy overstory [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PH_G_C ! MEB: sensible heat flux from understory [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PLETR_G_C ! MEB: transpiration from understory vegetation [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PLETR_V_C ! MEB: transpiration from overstory canopy vegetation [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PLER_G_C ! MEB: interception evaporation from understory vegetation [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PLER_V_C ! MEB: interception evaporation from overstory canopy vegetation [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PH_C_A ! MEB: sensible heat flux from canopy air space to the atmosphere [W/m2]
- ! NOTE total sensible heat flux to the atmosphere also possibly
- ! includes a contribution from snow covering the canopy
-REAL, DIMENSION(:), INTENT(OUT) :: PH_N_C ! MEB: sensible heat flux from the snow on the ground [W/m2]
- ! NOTE total sensible heat flux from the snowpack
- ! possibly includes a contribution from snow covering the canopy
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_V_C ! MEB: latent heat flux from vegetation canopy overstory [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_G_C ! MEB: latent heat flux from understory [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_C_A ! MEB: latent heat flux from canopy air space to the atmosphere [W/m2]
- ! NOTE total latent heat flux to the atmosphere also possibly
- ! includes a contribution from snow covering the canopy
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_N_C ! MEB: latent heat flux from the snow on the ground [W/m2]
- ! NOTE total latent heat flux from the snowpack
- ! possibly includes a contribution from snow covering the canopy
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAP_N_C ! MEB: Total evap from snow on the ground to canopy air space [kg/m2/s]
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAP_G_C ! MEB: Total evap from ground to canopy air space [kg/m2/s]
-REAL, DIMENSION(:), INTENT(OUT) :: PSR_GN ! MEB: total snow reaching the ground snow [kg/m2/s]
-REAL, DIMENSION(:), INTENT(OUT) :: PMELTCV ! MEB: snow melt rate from the overstory snow reservoir [kg/m2/s]
-REAL, DIMENSION(:), INTENT(OUT) :: PFRZCV ! MEB: snow refreeze rate from the overstory snow reservoir [kg/m2/s]
-REAL, DIMENSION(:), INTENT(OUT) :: PSWDOWN_GN ! MEB: total shortwave radiation transmitted through the canopy
- ! reaching the snowpack/ground understory [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PLWDOWN_GN ! MEB: total shortwave radiation transmitted through and emitted by the canopy
- ! reaching the snowpack/ground understory (explicit part) [W/m2]
+REAL, DIMENSION(:), INTENT(OUT) :: PDEEP_FLUX ! Heat flux at bottom of ISBA (W/m2)
!
+REAL ,DIMENSION(:),INTENT(IN) :: PIRRIG_GR ! ground irrigation rate (kg/m2/s)
!
-REAL, DIMENSION(:), INTENT(OUT) :: PDEEP_FLUX ! Heat flux at bottom of ISBA (W/m2)
-
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(SIZE(PWR)) :: ZCS ! heat capacity of the snow
-REAL, DIMENSION(SIZE(PWR)) :: ZFROZEN1 ! ice fraction in superficial soil
-REAL, DIMENSION(SIZE(PWR)) :: ZDELTA ! fraction of the foliage
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZCS ! heat capacity of the snow
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZFROZEN1 ! ice fraction in superficial soil
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZDELTA ! fraction of the foliage
! ! covered with intercepted
! ! water
-REAL, DIMENSION(SIZE(PWR)) :: ZQSAT ! expression for the saturation
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZQSAT ! expression for the saturation
! ! specific humidity
!
-REAL, DIMENSION(SIZE(PWR)) :: ZWRMAX ! maximum canopy water interception
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZWRMAX ! maximum canopy water interception
!
-REAL, DIMENSION(SIZE(PWR)) :: ZF2 ! water stress coefficient
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZF2 ! water stress coefficient
!
-REAL, DIMENSION(SIZE(PWR)) :: ZF5 ! water stress coefficient (based on F2)
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZF5 ! water stress coefficient (based on F2)
! ! to enforce Etv=>0 as F2=>0
!
-REAL, DIMENSION(SIZE(PWR)) :: ZHUGI ! humidity over frozen bare ground
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZHUGI ! humidity over frozen bare ground
!
-REAL, DIMENSION(SIZE(PWR)) :: ZEVAPCOR ! evaporation correction as last traces of snow
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZEVAPCOR ! evaporation correction as last traces of snow
! ! cover ablate
-REAL, DIMENSION(SIZE(PWR)) :: ZLES3L ! sublimation from ISBA-ES(3L)
-REAL, DIMENSION(SIZE(PWR)) :: ZLEL3L ! evaporation heat flux of water in the snow (W/m2)
-REAL, DIMENSION(SIZE(PWR)) :: ZEVAP3L ! evaporation flux over snow from ISBA-ES (kg/m2/s)
-REAL, DIMENSION(SIZE(PWR)) :: ZSNOW_THRUFAL !rate that liquid water leaves snow pack:
-! ISBA-ES [kg/(m2 s)]
-REAL, DIMENSION(SIZE(PWR)) :: ZSNOW_THRUFAL_SOIL !liquid water leaving the snowpack directly to the
-! !soil, ISBA-ES: [kg/(m2 s)] (equal to ZSNOW_THRUFAL
-! !if OMEB_LITTER=False and zero if OMEB_LITTER=True)
-REAL, DIMENSION(SIZE(PWR)) :: ZALB3L !Snow albedo at t-dt for total albedo calculation (ES/CROCUS)
-REAL, DIMENSION(SIZE(PWR)) :: ZRI3L !Snow Ridcharson number (ES/CROCUS)
-REAL, DIMENSION(SIZE(PWR)) :: ZQS3L ! surface humidity (kg/kg) (ES/CROCUS)
-!
-REAL, DIMENSION(SIZE(PWR)) :: ZVEG
-!
-REAL, DIMENSION(SIZE(PWR),SIZE(PABC)) :: ZIACAN_SHADE, ZIACAN_SUNLIT
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZLES3L ! sublimation from ISBA-ES(3L)
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZLEL3L ! evaporation heat flux of water in the snow (W/m2)
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZEVAP3L ! evaporation flux over snow from ISBA-ES (kg/m2/s)
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZSNOW_THRUFAL ! rate that liquid water leaves snow pack:
+! ! ISBA-ES [kg/(m2 s)]
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZSNOW_THRUFAL_SOIL !liquid water leaving the snowpack directly to the
+! !soil, ISBA-ES: [kg/(m2 s)] (equal to ZSNOW_THRUFAL
+! !if OMEB_LITTER=False and zero if OMEB_LITTER=True)
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZALB3L !Snow albedo at t-dt for total albedo calculation (ES/CROCUS)
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZRI3L !Snow Ridcharson number (ES/CROCUS)
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZQS3L ! surface humidity (kg/kg) (ES/CROCUS)
+!
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZVEG
+!
+REAL, DIMENSION(SIZE(PEK%XWR),SIZE(PABC)) :: ZIACAN_SHADE, ZIACAN_SUNLIT
! ! absorbed PAR of each level within the
! ! canopy - Split into shaded and SUNLIT
-REAL, DIMENSION(SIZE(PWR),SIZE(PABC)) :: ZFRAC_SUN ! fraction of sunlit leaves
+REAL, DIMENSION(SIZE(PEK%XWR),SIZE(PABC)) :: ZFRAC_SUN ! fraction of sunlit leaves
!
! ISBA-DF:
!
-REAL, DIMENSION(SIZE(PWG,1),SIZE(PWG,2)) :: ZSOILHCAPZ ! ISBA-DF Soil heat capacity
+REAL, DIMENSION(SIZE(PEK%XWG,1),SIZE(PEK%XWG,2)) :: ZSOILHCAPZ ! ISBA-DF Soil heat capacity
! ! profile [J/(m3 K)]
-REAL, DIMENSION(SIZE(PWG,1),SIZE(PWG,2)) :: ZSOILCONDZ ! ISBA-DF Soil conductivity
+REAL, DIMENSION(SIZE(PEK%XWG,1),SIZE(PEK%XWG,2)) :: ZSOILCONDZ ! ISBA-DF Soil conductivity
! ! profile [W/(m K)]
!
-REAL, DIMENSION(SIZE(PWG,1),SIZE(PWG,2)) :: ZF2WGHT ! water stress factor
+REAL, DIMENSION(SIZE(PEK%XWG,1),SIZE(PEK%XWG,2)) :: ZF2WGHT ! water stress factor
!
-REAL, DIMENSION(SIZE(PWR)) :: ZGRNDFLUX ! snow/soil-biomass interface flux (W/m2)
-REAL, DIMENSION(SIZE(PWR)) :: ZFLSN_COR ! snow/soil-biomass correction flux (W/m2)
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZGRNDFLUX ! snow/soil-biomass interface flux (W/m2)
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZFLSN_COR ! snow/soil-biomass correction flux (W/m2)
!
! MEB:
!
-REAL, DIMENSION(SIZE(PWR)) :: ZSUBVCOR ! A possible snow (intercepted by the canopy) mass correction
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZSUBVCOR ! A possible snow (intercepted by the canopy) mass correction
! (to be potentially removed from soil) when MEB activated (kg/m2/s)
-REAL, DIMENSION(SIZE(PWR)) :: ZLITCOR ! A possible ice (in litter layer) mass correction
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZLITCOR ! A possible ice (in litter layer) mass correction
! (to be potentially removed from soil) when litter activated (kg/m2/s)
!
! Misc :
@@ -877,26 +356,26 @@ REAL, DIMENSION(SIZE(PWR)) :: ZLITCOR ! A possible ice (in litte
! -----------------------------------------------------------------------------------------------------------------------------------------------------
! Budget: Add to arguments, diags
-REAL, DIMENSION(SIZE(PWR)) :: ZDELHEATV_SFC ! Change in heat storage of the explicit vegetation (MEB) layer over the current time step (W m-2)
-REAL, DIMENSION(SIZE(PWR)) :: ZDELHEATG ! change in heat storage of the entire soil column over the current time step (W m-2)
-REAL, DIMENSION(SIZE(PWR)) :: ZDELHEATG_SFC ! change in heat storage of the surface soil layer over the current time step (W m-2)
-REAL, DIMENSION(SIZE(PWR)) :: ZDELPHASEG ! latent heating due to soil freeze-thaw in the entire soil column (W m-2)
-REAL, DIMENSION(SIZE(PWR)) :: ZDELPHASEG_SFC ! latent heating due to soil freeze-thaw in the surface soil layer (W m-2)
-REAL, DIMENSION(SIZE(PWR)) :: ZDELHEATN ! change in heat storage of the entire snow column over the current time step (W m-2)
-REAL, DIMENSION(SIZE(PWR)) :: ZDELHEATN_SFC ! change in heat storage of the surface snow layer over the current time step (W m-2)
-REAL, DIMENSION(SIZE(PWR)) :: ZSNOWSFCH ! snow surface layer pseudo-heating term owing to
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZDELHEATV_SFC ! Change in heat storage of the explicit vegetation (MEB) layer over the current time step (W m-2)
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZDELHEATG ! change in heat storage of the entire soil column over the current time step (W m-2)
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZDELHEATG_SFC ! change in heat storage of the surface soil layer over the current time step (W m-2)
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZDELPHASEG ! latent heating due to soil freeze-thaw in the entire soil column (W m-2)
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZDELPHASEG_SFC ! latent heating due to soil freeze-thaw in the surface soil layer (W m-2)
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZDELHEATN ! change in heat storage of the entire snow column over the current time step (W m-2)
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZDELHEATN_SFC ! change in heat storage of the surface snow layer over the current time step (W m-2)
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZSNOWSFCH ! snow surface layer pseudo-heating term owing to
! ! changes in grid thickness (W m-2)
-REAL, DIMENSION(SIZE(PWR)) :: ZGSFCSNOW ! conductive heat flux between the surface and sub-surface soil layers
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZGSFCSNOW ! conductive heat flux between the surface and sub-surface soil layers
! ! for the multi-layer snow schemes..for composite snow, it is
-! ! equal to PRESTORE (W m-2)
+! ! equal to DEK%XRESTORE (W m-2)
!
!
! Necessary to close the energy budget between surfex and the atmosphere:
!
-REAL, DIMENSION(SIZE(PWR)) :: ZEMIST, ZZHV
-REAL, DIMENSION(SIZE(PWR)) :: ZALBT, ZEV, ZETR, ZER
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZEMIST, ZZHV
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZALBT, ZEV, ZETR, ZER
!
-LOGICAL, DIMENSION(SIZE(PTG,1)) :: GSHADE ! mask where evolution occurs
+LOGICAL, DIMENSION(SIZE(PEK%XTG,1)) :: GSHADE ! mask where evolution occurs
!
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -908,9 +387,9 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('ISBA',0,ZHOOK_HANDLE)
!
-PC1(:) = XUNDEF
-PC2(:) = XUNDEF
-PWGEQ(:) = XUNDEF
+DMK%XC1(:) = XUNDEF
+DMK%XC2(:) = XUNDEF
+DMK%XWGEQ(:) = XUNDEF
ZCS(:) = XUNDEF
!
ZEMIST (:) = XUNDEF
@@ -922,11 +401,11 @@ ZSOILCONDZ(:,:) = XUNDEF
ZF2WGHT (:,:) = XUNDEF
ZEVAP3L(:) = XUNDEF
!
-PRS (:) = 0.0
+DMK%XRS (:) = 0.0
PAC_AGG (:) = 0.0
PHU_AGG (:) = 0.0
-PSNOWTEMP (:,:) = XTT
-PMELT (:) = 0.0
+DMK%XSNOWTEMP (:,:) = XTT
+DEK%XMELT (:) = 0.0
!
!
!
@@ -941,7 +420,6 @@ ZDELHEATN (:) = 0.0
ZDELHEATN_SFC (:) = 0.0
ZSNOWSFCH (:) = 0.0
ZGSFCSNOW (:) = 0.0
-ZSNOW_THRUFAL (:) = 0.0
!
ZSUBVCOR(:) = 0.0
ZLITCOR(:) = 0.0
@@ -949,40 +427,31 @@ ZLES3L = 0.0
ZLEL3L = 0.0
!
IF(OMEB)THEN
- ZVEG(:) = 0.0
- PLEG(:) = 0.0
- PLEGI(:) = 0.0
- PLELITTER(:) = 0.0
- PLELITTERI(:) = 0.0
+ ZVEG(:) = 0.0
+ DEK%XLEG(:) = 0.0
+ DEK%XLEGI(:) = 0.0
+ DEK%XLELITTER(:) = 0.0
+ DEK%XLELITTERI(:) = 0.0
ELSE
- ZVEG(:) = PVEG(:)
- PLES_V_C(:) = 0.0
- PWRVN (:) = 0.0
+ ZVEG (:) = PEK%XVEG(:)
ENDIF
!
! Save snow albedo values at beginning of time step for total albedo calculation
!
-ZALB3L(:)=PSNOWALB(:)
+ZALB3L(:)=PEK%TSNOW%ALB(:)
!
!-------------------------------------------------------------------------------
!
!* 2.0 Soil parameters
! ---------------
!
-IF(HISBA =='2-L' .OR. HISBA == '3-L')THEN
+IF(IO%CISBA =='2-L' .OR. IO%CISBA == '3-L')THEN
!
- CALL SOIL (HC1DRY, HSCOND, HSNOW_ISBA, OGLACIER, PSNOWRHO(:,1), ZVEG, PCGSAT,&
- PCGMAX, PC1SAT, PC2REF, PACOEF, PPCOEF, PCV, PPSN, PPSNG, PPSNV, PFFG, &
- PFFV, PFF, PCG, PC1, PC2, PWGEQ, PCT, ZCS, ZFROZEN1, PTG(:,1), PWG, PWGI, &
- PHCAPSOIL(:,1), PCONDDRY(:,1), PCONDSLD(:,1), PBCOEF(:,1), PWSAT(:,1), &
- PWWILT(:,1), HKSAT,PCONDSAT,PFFG_NOSNOW,PFFV_NOSNOW )
+ CALL SOIL (IO, KK, PK, PEK, DMK, ZVEG, ZCS, ZFROZEN1, PFFG_NOSNOW, PFFV_NOSNOW )
!
ELSE
!
- CALL SOILDIF (HDIFSFCOND, OFLOOD, ZVEG, PCV, PFFG_NOSNOW, PFFV_NOSNOW, &
- PCG, PCT, ZFROZEN1, PD_G, PDZG, PTG, PWG, PWGI, KWG_LAYER, &
- PHCAPSOIL, PCONDDRY, PCONDSLD, PBCOEF, PWSAT, PMPOTSAT, ZSOILCONDZ, &
- ZSOILHCAPZ, PFWTD, PWTD, PWR )
+ CALL SOILDIF (IO, KK, PK, PEK, DMK, ZVEG, ZFROZEN1, PFFG_NOSNOW, PFFV_NOSNOW, ZSOILCONDZ, ZSOILHCAPZ )
!
ENDIF
!
@@ -991,9 +460,7 @@ ENDIF
!* 3.0 Plant stress due to soil water deficit
! --------------------------------------
!
- CALL SOILSTRESS(HISBA, ZF2, &
- PROOTFRAC, PWSAT, PWFC, PWWILT, &
- PWG, PWGI, KWG_LAYER, ZF2WGHT, ZF5 )
+CALL SOILSTRESS(IO%CISBA, ZF2, KK, PK, PEK, ZF2WGHT, ZF5 )
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
@@ -1001,56 +468,22 @@ ENDIF
! ---------------------------------
!
IF(OMEB)THEN
- CALL ISBA_MEB(TPTIME, OMEB, OMEB_LITTER, OMEB_GNDRES,PGNDLITTER, &
- OFORC_MEASURE, OGLACIER,&
- OTR_ML, OAGRI_TO_GRASS, GSHADE, OSTRESSDEF, &
- OSNOWDRIFT, OSNOWDRIFT_SUBLIM, OSNOW_ABS_ZENITH, LIRRIGATE, LIRRIDAY, &
- HSNOWMETAMO, HSNOWRAD, HPHOTO, &
- HISBA, HCPSURF, HRAIN, HSNOW_ISBA, HSNOWRES, HIMPLICIT_WIND, &
- KWG_LAYER, PTSTEP, PVEGTYPE, PLAT, PLON, &
- PTHRESHOLD, PWATSUP, PIRRIG, PIRRIG_FLUX, &
- ZSOILHCAPZ, ZSOILCONDZ, ZFROZEN1, &
- PPS, PZENITH, PSCA_SW, PSW_RAD, PVMOD, PRR, PSR, PRHOA, PTA, PQA, &
- PH_VEG, PDIRCOSZW, &
- PEXNS, PEXNA, PPET_A_COEF, PPET_B_COEF, PPEQ_A_COEF, PPEQ_B_COEF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PZREF, PUREF, PCH, PCD, PCDN, PRI, PRESA, PHUG, PHV, PHU, PQS, &
- PZ0G_WITHOUT_SNOW, &
- PZ0_MEBV, PZ0H_MEBV, PZ0EFF_MEBV, &
- PZ0_MEBN, PZ0H_MEBN, PZ0EFF_MEBN, &
- PZ0_WITH_SNOW, PZ0H_WITH_SNOW, PZ0EFF, &
- PTV, PTL, PTG, PTC, PQC, PWR, PWRL,PWRLI, PWRVN, PWG, PWGI, &
- PWRMAX_CF, PRGL, PRSMIN, PGAMMA, PRS, &
- PALBNIR_TVEG, PALBVIS_TVEG,PALBNIR_TSOIL, PALBVIS_TSOIL, PFALB, &
- PSNOWALB, PSNOWALBVIS, PSNOWALBNIR, PSNOWALBFIR, &
- PABC, PFAPARC, PFAPIRC, PMUS, PLAI_EFFC, &
- PIACAN, PFAPAR, PFAPIR, PFAPAR_BS, PFAPIR_BS, &
- PAH, PBH, PF2I, PDMAX, PPOI, PCSP, PFZERO, PEPSO, &
- PGAMM, PQDGAMM, PGMES, PGC, PQDGMES, PT1GMES, PT2GMES, &
- PAMAX, PQDAMAX, PT1AMAX, PT2AMAX, &
- PAN, PANDAY, PANFM, PGPP, PANF, PRESP_BIOMASS_INST, &
- PFF, PPSN, PPALPHAN, PLAI, ZF2, &
- PWSAT, PWFC, &
- PSNOWGRAN1, PSNOWGRAN2, PSNOWHIST,PSNOWAGE, &
- PSNOWRHO, PSNOWSWE, PSNOWHEAT, PSNOWTEMP, PSNOWDZ, PSNOWLIQ, PFEMIS, &
- PSWNET_N, PSWNET_V, PSWNET_G, PSWNET_NS, PALBT, PSWDOWN_GN, &
- PLW_RAD, PLWNET_N, PLWNET_V, PLWNET_G, PLWDOWN_GN, &
- PLEV_V_C, PLES_V_C, PH_V_C, PH_G_C, PLETR_V_C, PLER_V_C, PH_C_A, &
- PH_N_C, PLE_V_C, PLE_G_C, PLE_C_A, PLE_N_C, PEVAP_N_C, PEVAP_G_C, &
- PSR_GN, PMELTCV, PFRZCV, PMELTADV, &
- PLE_FLOOD, PLEI_FLOOD, &
- PLE, PH, PRN, PLEI, PLEGI, PLEG,PLELITTERI,PLELITTER,PDRIPLIT,PRRLIT, &
- PLEV, PLER, PLETR, PEVAP, PLES, PLESL, &
- PSUBL, PRESTORE, ZGRNDFLUX, ZFLSN_COR, PUSTAR, &
- PHPSNOW, PSNOWHMASS, PRNSNOW, PHSNOW, PGFLUXSNOW, &
- PUSTARSNOW, PSRSFC, PRRSFC, PEMISNOW, PCDSNOW, PCHSNOW, &
- ZEMIST, PTS_RAD, PHU_AGG, PAC_AGG, &
- ZDELHEATV_SFC, ZDELHEATG_SFC, ZDELHEATG, &
- ZDELHEATN, ZDELHEATN_SFC, ZGSFCSNOW, &
- PD_G, PDZG, PCPS, PLVTT, PLSTT, PCT, PCV, PCG, PFFROZEN, &
- PTDEEP_A, PTDEEP_B, PDEEP_FLUX, PMUF, PDRIP, PRRVEG, &
- ZRI3L, ZSNOW_THRUFAL,ZSNOW_THRUFAL_SOIL, ZEVAPCOR, ZSUBVCOR,ZLITCOR, &
- ZSNOWSFCH, PSNDRIFT, ZQS3L )
+ CALL ISBA_MEB(IO, KK, PK, PEK, DK, DEK, DMK, G, AG, &
+ TPTIME, OMEB, GSHADE, HIMPLICIT_WIND, PTSTEP, &
+ ZSOILHCAPZ, ZSOILCONDZ, ZFROZEN1, PPS, PZENITH, &
+ PSCA_SW, PSW_RAD, PVMOD, PRR, PSR, PRHOA, PTA, PQA, &
+ PDIRCOSZW, PEXNS, PEXNA, PPET_A_COEF, PPET_B_COEF, &
+ PPEQ_A_COEF, PPEQ_B_COEF, PPEW_A_COEF, PPEW_B_COEF, &
+ PZREF, PUREF, PZ0G_WITHOUT_SNOW, PZ0_MEBV, PZ0H_MEBV,&
+ PZ0EFF_MEBV, PZ0_MEBN, PZ0H_MEBN, PZ0EFF_MEBN, &
+ PALBNIR_TVEG, PALBVIS_TVEG,PALBNIR_TSOIL, PALBVIS_TSOIL, &
+ PABC, PIACAN, PPOI, PCSP, PRESP_BIOMASS_INST, PPALPHAN, &
+ ZF2, PLW_RAD, ZGRNDFLUX, ZFLSN_COR, PUSTAR, ZEMIST, &
+ PHU_AGG, PAC_AGG, ZDELHEATV_SFC, ZDELHEATG_SFC, ZDELHEATG, &
+ ZDELHEATN, ZDELHEATN_SFC, ZGSFCSNOW, PTDEEP_A, PDEEP_FLUX, &
+ ZRI3L, ZSNOW_THRUFAL, ZSNOW_THRUFAL_SOIL, ZEVAPCOR, ZSUBVCOR, &
+ ZLITCOR, ZSNOWSFCH, ZQS3L )
+
ELSE
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -1058,13 +491,13 @@ ELSE
!* 5.0 Radiative transfert
! -------------------
!
- IF (OTR_ML) THEN
- CALL RADIATIVE_TRANSFERT(OAGRI_TO_GRASS, PVEGTYPE, &
- PALBVIS_TVEG, PALBVIS_TSOIL, PALBNIR_TVEG, PALBNIR_TSOIL, &
- PSW_RAD, PLAI, PZENITH, PABC, &
- PFAPARC, PFAPIRC, PMUS, PLAI_EFFC, GSHADE, PIACAN, &
- ZIACAN_SUNLIT, ZIACAN_SHADE, ZFRAC_SUN, &
- PFAPAR, PFAPIR, PFAPAR_BS, PFAPIR_BS )
+ IF (IO%LTR_ML) THEN
+ CALL RADIATIVE_TRANSFERT(IO%LAGRI_TO_GRASS, PK%XVEGTYPE_PATCH, PALBVIS_TVEG, &
+ PALBVIS_TSOIL, PALBNIR_TVEG, PALBNIR_TSOIL, PSW_RAD, &
+ PEK%XLAI, PZENITH, PABC, PEK%XFAPARC, PEK%XFAPIRC, &
+ PEK%XMUS, PEK%XLAI_EFFC, GSHADE, PIACAN, ZIACAN_SUNLIT,&
+ ZIACAN_SHADE, ZFRAC_SUN, DMK%XFAPAR, DMK%XFAPIR, &
+ DMK%XFAPAR_BS, DMK%XFAPIR_BS )
ENDIF
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -1072,79 +505,53 @@ ELSE
!* 6.0 Fraction of leaves occupied by intercepted water
! ------------------------------------------------
!
- CALL WET_LEAVES_FRAC(PWR, PVEG, PWRMAX_CF, PZ0_WITH_SNOW, PLAI, ZWRMAX, ZDELTA)
+ CALL WET_LEAVES_FRAC(PEK%XWR, PEK%XVEG, PEK%XWRMAX_CF, DK%XZ0, PEK%XLAI, ZWRMAX, ZDELTA)
!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
!* 7.0 Explicit snow scheme
! --------------------
!
- CALL SNOW3L_ISBA(HISBA, HSNOW_ISBA, HSNOWRES, OMEB, OGLACIER, HIMPLICIT_WIND,&
- TPTIME, PTSTEP, PVEGTYPE, &
- PSNOWSWE, PSNOWHEAT, PSNOWRHO, PSNOWALB, &
- PSNOWGRAN1, PSNOWGRAN2, PSNOWHIST,PSNOWAGE, &
- PTG, PCG, PCT, ZSOILHCAPZ, ZSOILCONDZ(:,1), &
- PPS, PTA, PSW_RAD, PQA, PVMOD, PLW_RAD, PRR, PSR, &
- PRHOA, PUREF, PEXNS, PEXNA, PDIRCOSZW, PLVTT, PLSTT, &
- PZREF, PZ0_WITH_SNOW, PZ0EFF, PZ0H_WITH_SNOW, PALB, PD_G, PDZG, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- ZSNOW_THRUFAL_SOIL, ZGRNDFLUX, ZFLSN_COR, ZGSFCSNOW, ZEVAPCOR, &
- PSWNET_N, PSWNET_NS, PLWNET_N, &
- PRNSNOW, PHSNOW, PGFLUXSNOW, PHPSNOW, ZLES3L, ZLEL3L, ZEVAP3L, &
- PSNDRIFT, PUSTARSNOW, PPSN, PSRSFC, PRRSFC, ZSNOWSFCH, &
- ZDELHEATN, ZDELHEATN_SFC, &
- PEMISNOW, PCDSNOW, PCHSNOW, PSNOWTEMP, PSNOWLIQ, PSNOWDZ, &
- PSNOWHMASS, ZRI3L, PZENITH, ZDELHEATG, ZDELHEATG_SFC, &
- PLAT, PLON, ZQS3L, &
- OSNOWDRIFT,OSNOWDRIFT_SUBLIM,OSNOW_ABS_ZENITH, &
- HSNOWMETAMO,HSNOWRAD )
-
+ CALL SNOW3L_ISBA(IO, G, PK, PEK, DK, DEK, DMK, OMEB, HIMPLICIT_WIND, &
+ TPTIME, PTSTEP, PK%XVEGTYPE_PATCH, PEK%XTG, DMK%XCT, ZSOILHCAPZ, &
+ ZSOILCONDZ(:,1), PPS, PTA, PSW_RAD, PQA, PVMOD, PLW_RAD, PRR, &
+ PSR, PRHOA, PUREF, PEXNS, PEXNA, PDIRCOSZW, PZREF, PEK%XSNOWFREE_ALB, &
+ PK%XDG, PK%XDZG, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, &
+ PPET_B_COEF, PPEQ_B_COEF, ZSNOW_THRUFAL_SOIL, ZGRNDFLUX, ZFLSN_COR, &
+ ZGSFCSNOW, ZEVAPCOR, ZLES3L, ZLEL3L, ZEVAP3L, ZSNOWSFCH, ZDELHEATN, &
+ ZDELHEATN_SFC, ZRI3L, PZENITH, ZDELHEATG, ZDELHEATG_SFC, ZQS3L )
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
!* 8.0 Plant stress, stomatal resistance and, possibly, CO2 assimilation
! --------------------------------------------------------------------
!
- IF (HPHOTO=='NON') THEN
- CALL VEG(PSW_RAD, PTA, PQA, PPS, PRGL, PLAI, PRSMIN, PGAMMA, ZF2, PRS)
- ELSE IF (MAXVAL(PGMES).NE.XUNDEF .OR. MINVAL(PGMES).NE.XUNDEF) THEN
- ZQSAT(:)=QSAT(PTG(:,1),PPS(:))
- CALL COTWORES(PTSTEP, HPHOTO, OTR_ML, GSHADE, &
- PVEGTYPE, OSTRESSDEF, PAH, PBH, PF2I, PDMAX, &
- PPOI, PCSP, PTG(:,1), ZF2, PSW_RAD, PRESA, PQA, ZQSAT, PLE, &
- PPSNV, ZDELTA, PLAI, PRHOA, PZENITH, PFZERO, PEPSO, &
- PGAMM, PQDGAMM, PGMES, PGC, PQDGMES, PT1GMES, PT2GMES, &
- PAMAX, PQDAMAX, PT1AMAX, PT2AMAX, PFFV, &
- ZIACAN_SUNLIT, ZIACAN_SHADE, ZFRAC_SUN, PIACAN, &
- PABC, PAN, PANDAY, PRS, PANFM, PGPP, PANF, PRESP_BIOMASS_INST(:,1))
+ IF (IO%CPHOTO=='NON') THEN
+ CALL VEG(PSW_RAD, PTA, PQA, PPS, PEK%XRGL, PEK%XLAI, PEK%XRSMIN, PEK%XGAMMA, ZF2, DMK%XRS)
+ ELSE IF (MAXVAL(PEK%XGMES(:)).NE.XUNDEF .OR. MINVAL(PEK%XGMES(:)).NE.XUNDEF) THEN
+ ZQSAT(:)=QSAT(PEK%XTG(:,1),PPS(:))
+ CALL COTWORES(PTSTEP, IO, GSHADE, PK, PEK, PK%XDMAX, PPOI, PCSP, PEK%XTG(:,1), &
+ ZF2, PSW_RAD, PQA, ZQSAT, PEK%XPSNV, ZDELTA, PRHOA, PZENITH, &
+ KK%XFFV, ZIACAN_SUNLIT, ZIACAN_SHADE, ZFRAC_SUN, PIACAN, PABC, &
+ DMK%XRS, DEK%XGPP, PRESP_BIOMASS_INST(:,1))
ELSE
PRESP_BIOMASS_INST(:,1) = 0.0
- PGPP(:) = 0.0
+ DEK%XGPP(:) = 0.0
ENDIF
!
-!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
!* 9.0 ISBA Composit Energy Budget
! -----------------------------------------------
!
- CALL ISBA_CEB(HISBA, HSNOW_ISBA, HCPSURF, OFLOOD, OTEMP_ARP, HIMPLICIT_WIND, &
- PTSTEP, PSODELX, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, &
- PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, PSNOWALB, &
- PSW_RAD, PLW_RAD, PWG, PWGI, PEXNS, PEXNA, PTA, PVMOD, &
- PQA, PRR, PSR, PPS, PRS, PVEG, PZ0_WITH_SNOW, PZ0EFF, &
- PZ0H_WITH_SNOW, PWFC, PWSAT, PPSN, PPSNG, PPSNV, PZREF, &
- PUREF, PDIRCOSZW, ZF5, PFFG, PFFV, PFF, PFFG_NOSNOW, &
- PFFV_NOSNOW, PWR, PRHOA, PEMIS, PALB, PCT, ZCS, PCG, &
- PD_G, PDZG, PDZDIF, ZSOILCONDZ, ZSOILHCAPZ, ZFROZEN1, &
- PTDEEP_A, PTDEEP_B, PGAMMAT, PPSNV_A, PSNOWFREE_ALB_VEG, &
- PSNOWFREE_ALB_SOIL, ZGRNDFLUX, ZFLSN_COR, ZSNOW_THRUFAL_SOIL, &
- PFFROZEN, PFALB, PFEMIS, PSNOWSWE(:,1), PSRSFC, &
- PTG, PRESA, PLVTT, PLSTT, PCPS, ZDELTA, PCH, PCD, PCDN, &
- PRI, PHUG, ZHUGI, PHV, PHU, PQS, ZALBT, ZEMIST, PDEEP_FLUX, &
- PRN, PH, PLE, PLEG, PLEGI, PLEV, PLES, PLER, PLETR, PEVAP, &
- PGFLUX, PMELTADV, PMELT, PRESTORE, PUSTAR, PLE_FLOOD, &
- PLEI_FLOOD, PSNOWTEMP(:,1), PAC_AGG, PHU_AGG )
+ CALL ISBA_CEB(IO, KK, PK, PEK, DK, DEK, DMK, &
+ HIMPLICIT_WIND, PTSTEP, PPEW_A_COEF, &
+ PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
+ PPEQ_B_COEF, PSW_RAD, PLW_RAD, PEXNS, PEXNA, PTA, &
+ PVMOD, PQA, PRR, PSR, PPS, PZREF, PUREF, PDIRCOSZW, &
+ ZF5, PFFG_NOSNOW, PFFV_NOSNOW, PRHOA, ZCS, &
+ ZSOILCONDZ, ZSOILHCAPZ, ZFROZEN1, PTDEEP_A, &
+ ZGRNDFLUX, ZFLSN_COR, ZSNOW_THRUFAL_SOIL, ZDELTA, ZHUGI, &
+ ZALBT, ZEMIST, PDEEP_FLUX, PUSTAR, PAC_AGG, PHU_AGG )
!
ENDIF
!
@@ -1154,29 +561,18 @@ ENDIF
! 'D95' : they represent aggregated (snow + flood + snow-flood-free) fluxes
! '3-L' : they represent flood + snow-flood-free fluxes
!
-! The variables concerned by this are: PRN, PH, PLE, PLEI, PLEG, PLEGI, PLEV, PLES,
-! PLER, PLETR, PEVAP, PUSTAR, PGFLUX
+! The variables concerned by this are: PRN, PH, PLE, PLEI, DEK%XLEG, DEK%XLEGI, DEK%XLEV, DEK%XLES,
+! DEK%XLER, DEK%XLETR, PEVAP, PUSTAR, PGFLUX
!*******************************************************************************
!
!* 12.0 Water transfers and phase change in the soil
! --------------------------------------------
!
- CALL HYDRO(HISBA, HSNOW_ISBA, HRUNOFF, HSOILFRZ, OMEB, OGLACIER, &
- OFLOOD, PTSTEP, PVEGTYPE, &
- PRRSFC, PSRSFC, PLEV, PLETR, PLEG, PLES, PRUNOFFB, PWDRAIN, &
- PC1, PC2, PC3, PC4B, PC4REF, PWGEQ, PCG, PCT, ZVEG, PLAI, ZWRMAX, PMELT, &
- PTAUICE, PLEGI, PRUNOFFD, PSOILWGHT, KLAYER_HORT, KLAYER_DUN, &
- PPSNV, PPSNG, ZSNOW_THRUFAL_SOIL, ZEVAPCOR, ZSUBVCOR, PWR, ZSOILHCAPZ, &
- PSNOWSWE(:,1), PSNOWALB, PSNOWRHO(:,1), PBCOEF, PWSAT, PCONDSAT, PMPOTSAT, &
- PWFC, PWWILT, ZF2WGHT, ZF2, PD_G, PDZG, PDZDIF, PPS, &
- PWG, PWGI, PTG, KWG_LAYER, PDRAIN, PRUNOFF, PTOPQS, &
- PIRRIG, PWATSUP, PTHRESHOLD, LIRRIDAY, LIRRIGATE, &
- HKSAT, HRAIN, HHORT, PMUF, PFSAT, PKSAT_ICE, PD_ICE, PHORT, PDRIP, &
- PFFG, PFFV, PFFLOOD, PPIFLOOD, PIFLOOD, PPFLOOD, PRRVEG, PIRRIG_FLUX, &
- PIRRIG_GR, PQSB, PFWTD, PWTD, &
- ZDELHEATG, ZDELHEATG_SFC, &
- ZDELPHASEG, ZDELPHASEG_SFC, PLVTT, PLSTT )
-
+CALL HYDRO(IO, KK, PK, PEK, AG, DEK, DMK, &
+ OMEB, PTSTEP, ZVEG, ZWRMAX, ZSNOW_THRUFAL_SOIL, &
+ ZEVAPCOR, ZSUBVCOR, ZSOILHCAPZ, ZF2WGHT, ZF2, PPS, &
+ PIRRIG_GR, ZDELHEATG, ZDELHEATG_SFC, ZDELPHASEG, &
+ ZDELPHASEG_SFC )
!-------------------------------------------------------------------------------
!
!* 13.0 Aggregated output fluxes and diagnostics
@@ -1185,30 +581,12 @@ ENDIF
!* add snow component to output radiative parameters and fluxes in case
! of ES or CROCUS snow schemes
!
- CALL ISBA_SNOW_AGR( HSNOW_ISBA, OMEB, &
- PEXNS, PEXNA, PTA, PQA, PZREF, PUREF, PDIRCOSZW, PVMOD, &
- PZ0EFF, PZ0_WITH_SNOW, PZ0H_WITH_SNOW, PRR, PSR, &
- ZEMIST, ZALBT, PPSN, PPSNG, PPSNV, &
- PRN, PH, PLE, PLEI, PLEG, PLEGI, PLEV, PLES, PLER, &
- PLETR, PEVAP, PSUBL, PGFLUX, PLVTT, PLSTT, &
- PUSTAR, &
- ZLES3L, ZLEL3L, ZEVAP3L, &
- PSWNET_V, PSWNET_G, PLWNET_V, PLWNET_G, PH_V_C, PH_G_C, &
- PLEV_V_C, PLETR_V_C, PLES_V_C, &
- ZQS3L, ZALB3L, &
- PRNSNOW, PHSNOW, PHPSNOW, &
- PSWNET_N, PSWNET_NS, PLWNET_N, &
- PGFLUXSNOW, ZGSFCSNOW, PUSTARSNOW, &
- ZGRNDFLUX, ZFLSN_COR, PGRNDFLUX, PLESL, &
- PEMISNOW, &
- PSNOWTEMP(:,1), PTS_RAD, PTS, PRI, PQS, PHU, &
- PCD, PCDN, PCH, PSNOWHMASS, &
- PRN_ISBA, PH_ISBA, PLEG_ISBA, PLEGI_ISBA, PLEV_ISBA, &
- PLETR_ISBA, PUSTAR_ISBA, PLER_ISBA, PLE_ISBA, &
- PLEI_ISBA, PGFLUX_ISBA, PMELTADV, PTG(:,1), &
- PEMIST, PALBT, PLE_FLOOD, PLEI_FLOOD, &
- PFFG, PFFV, PFF, PPALPHAN, PTC, OMEB_LITTER, PLELITTER, &
- PLELITTERI)
+CALL ISBA_SNOW_AGR(KK, PK, PEK, DMK, DK, DEK, &
+ OMEB, IO%LMEB_LITTER, PEXNS, PEXNA, PTA, PQA, &
+ PZREF, PUREF, PDIRCOSZW, PVMOD, PRR, PSR, &
+ ZEMIST, ZALBT, PUSTAR, ZLES3L, ZLEL3L, &
+ ZEVAP3L, ZQS3L, ZALB3L, ZGSFCSNOW, &
+ ZGRNDFLUX, ZFLSN_COR, PEMIST, PPALPHAN )
!
!***************************************************************************
! All output fluxes and radiative variables have recovered the same physical
diff --git a/src/SURFEX/isba_albedo.F90 b/src/SURFEX/isba_albedo.F90
index d858ca59b88f9da4e9cda2e3634107636a25d3ef..e259adb8048e84a087380dc5ed7ccfd053ad683f 100644
--- a/src/SURFEX/isba_albedo.F90
+++ b/src/SURFEX/isba_albedo.F90
@@ -3,17 +3,10 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE ISBA_ALBEDO(HSNOW, OTR_ML, OMEB, &
- PDIR_SW, PSCA_SW, PSW_BANDS, KSW, &
- PALBNIR, PALBVIS, PALBUV, &
- PALBNIR_VEG, PALBVIS_VEG, PALBUV_VEG, &
- PALBNIR_SOIL, PALBVIS_SOIL, PALBUV_SOIL, &
- PFALB, PFFV, PFFG, &
- PGLOBAL_SW, PSNOWFREE_ALB, &
- PSNOWFREE_ALB_VEG, PSNOWFREE_ALB_SOIL, &
- PMEB_SCA_SW, &
- PALBNIR_TVEG, PALBVIS_TVEG, &
- PALBNIR_TSOIL, PALBVIS_TSOIL )
+ SUBROUTINE ISBA_ALBEDO(PEK, OTR_ML, OMEB, PDIR_SW, PSCA_SW, PSW_BANDS, KSW, &
+ PFALB, PFFV, PFFG, PGLOBAL_SW, &
+ PMEB_SCA_SW, PALBNIR_TVEG, PALBVIS_TVEG, &
+ PALBNIR_TSOIL, PALBVIS_TSOIL )
! ##########################################################################
!
!!**** *ISBA_ALBEDO*
@@ -46,6 +39,7 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_n, ONLY : ISBA_PE_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
@@ -59,7 +53,6 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
- CHARACTER(LEN=*) , INTENT(IN) :: HSNOW ! ISBA snow scheme
LOGICAL, INTENT(IN) :: OTR_ML
LOGICAL, INTENT(IN) :: OMEB ! True = patch with multi-energy balance
! ! False = patch with classical ISBA
@@ -68,24 +61,15 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PDIR_SW ! direct incoming solar
REAL, DIMENSION(:,:), INTENT(IN) :: PSCA_SW ! diffus incoming solar radiation
REAL, DIMENSION(:) , INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m)
INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands
-REAL, DIMENSION(:) , INTENT(IN) :: PALBNIR ! nearIR total albedo
-REAL, DIMENSION(:) , INTENT(IN) :: PALBVIS ! visible total albedo
-REAL, DIMENSION(:) , INTENT(IN) :: PALBUV ! UV total albedo
-REAL, DIMENSION(:) , INTENT(IN) :: PALBNIR_VEG ! nearIR veg albedo
-REAL, DIMENSION(:) , INTENT(IN) :: PALBVIS_VEG ! visible veg albedo
-REAL, DIMENSION(:) , INTENT(IN) :: PALBUV_VEG ! UV veg albedo
-REAL, DIMENSION(:) , INTENT(IN) :: PALBNIR_SOIL ! nearIR soil albedo
-REAL, DIMENSION(:) , INTENT(IN) :: PALBVIS_SOIL ! visible soil albedo
-REAL, DIMENSION(:) , INTENT(IN) :: PALBUV_SOIL ! UV soil albedo
+!
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
REAL, DIMENSION(:) , INTENT(IN) :: PFALB ! Floodplain albedo
REAL, DIMENSION(:) , INTENT(IN) :: PFFV ! Floodplain fraction over vegetation
REAL, DIMENSION(:) , INTENT(IN) :: PFFG ! Floodplain fraction over the ground
!
REAL, DIMENSION(:) , INTENT(OUT) :: PGLOBAL_SW ! global incoming SW rad.
REAL, DIMENSION(:) , INTENT(OUT) :: PMEB_SCA_SW ! diffuse incoming SW rad.
-REAL, DIMENSION(:) , INTENT(OUT) :: PSNOWFREE_ALB !snow free albedo
-REAL, DIMENSION(:) , INTENT(OUT) :: PSNOWFREE_ALB_VEG !snow free albedo of vegetation for EBA
-REAL, DIMENSION(:) , INTENT(OUT) :: PSNOWFREE_ALB_SOIL !snow free albedo of soil for EBA option
REAL, DIMENSION(:) , INTENT(OUT) :: PALBNIR_TVEG ! nearIR veg tot albedo
REAL, DIMENSION(:) , INTENT(OUT) :: PALBVIS_TVEG ! visible veg tot albedo
REAL, DIMENSION(:) , INTENT(OUT) :: PALBNIR_TSOIL ! nearIR soil tot albedo
@@ -98,13 +82,13 @@ REAL, DIMENSION(:) , INTENT(OUT) :: PALBVIS_TSOIL ! visible soil tot albe
!
INTEGER :: JLAYER
INTEGER :: JSWB
-REAL, DIMENSION(SIZE(PALBNIR)) :: ZSW_UP
-REAL, DIMENSION(SIZE(PALBNIR),KSW) :: ZDIR_ALB_WITHOUT_SNOW
-REAL, DIMENSION(SIZE(PALBNIR),KSW) :: ZSCA_ALB_WITHOUT_SNOW
-REAL, DIMENSION(SIZE(PALBNIR),KSW) :: ZDIR_ALB_VEG_WITHOUT_SNOW
-REAL, DIMENSION(SIZE(PALBNIR),KSW) :: ZSCA_ALB_VEG_WITHOUT_SNOW
-REAL, DIMENSION(SIZE(PALBNIR),KSW) :: ZDIR_ALB_SOIL_WITHOUT_SNOW
-REAL, DIMENSION(SIZE(PALBNIR),KSW) :: ZSCA_ALB_SOIL_WITHOUT_SNOW
+REAL, DIMENSION(SIZE(PEK%XALBNIR)) :: ZSW_UP
+REAL, DIMENSION(SIZE(PEK%XALBNIR),KSW) :: ZDIR_ALB_WITHOUT_SNOW
+REAL, DIMENSION(SIZE(PEK%XALBNIR),KSW) :: ZSCA_ALB_WITHOUT_SNOW
+REAL, DIMENSION(SIZE(PEK%XALBNIR),KSW) :: ZDIR_ALB_VEG_WITHOUT_SNOW
+REAL, DIMENSION(SIZE(PEK%XALBNIR),KSW) :: ZSCA_ALB_VEG_WITHOUT_SNOW
+REAL, DIMENSION(SIZE(PEK%XALBNIR),KSW) :: ZDIR_ALB_SOIL_WITHOUT_SNOW
+REAL, DIMENSION(SIZE(PEK%XALBNIR),KSW) :: ZSCA_ALB_SOIL_WITHOUT_SNOW
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
@@ -117,17 +101,17 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('ISBA_ALBEDO',0,ZHOOK_HANDLE)
!
IF (OTR_ML )THEN
- IF (OMEB) THEN
- PALBNIR_TVEG (:) = PALBNIR_VEG(:)
- PALBNIR_TSOIL(:) = ( 1.-PFFG(:))*PALBNIR_SOIL(:) + PFFG(:)*PFALB(:)
- PALBVIS_TVEG (:) = PALBVIS_VEG(:)
- PALBVIS_TSOIL(:) = ( 1.-PFFG(:))*PALBVIS_SOIL(:) + PFFG(:)*PFALB(:)
- ELSE
- PALBNIR_TVEG (:) = PALBNIR_VEG(:)
- PALBNIR_TSOIL(:) = PALBNIR_SOIL(:)
- PALBVIS_TVEG (:) = PALBVIS_VEG(:)
- PALBVIS_TSOIL(:) = PALBVIS_SOIL(:)
- ENDIF
+ IF (OMEB) THEN
+ PALBNIR_TVEG (:) = PEK%XALBNIR_VEG(:)
+ PALBNIR_TSOIL(:) = ( 1.-PFFG(:))*PEK%XALBNIR_SOIL(:) + PFFG(:)*PFALB(:)
+ PALBVIS_TVEG (:) = PEK%XALBVIS_VEG(:)
+ PALBVIS_TSOIL(:) = ( 1.-PFFG(:))*PEK%XALBVIS_SOIL(:) + PFFG(:)*PFALB(:)
+ ELSE
+ PALBNIR_TVEG (:) = PEK%XALBNIR_VEG(:)
+ PALBNIR_TSOIL(:) = PEK%XALBNIR_SOIL(:)
+ PALBVIS_TVEG (:) = PEK%XALBVIS_VEG(:)
+ PALBVIS_TSOIL(:) = PEK%XALBVIS_SOIL(:)
+ ENDIF
ELSE
PALBNIR_TVEG (:) = XUNDEF
PALBNIR_TSOIL(:) = XUNDEF
@@ -135,60 +119,59 @@ ELSE
PALBVIS_TSOIL(:) = XUNDEF
ENDIF
!
- CALL ALBEDO_FROM_NIR_VIS(PSW_BANDS, PALBNIR, PALBVIS, PALBUV, &
+ CALL ALBEDO_FROM_NIR_VIS(PSW_BANDS, PEK%XALBNIR(:), PEK%XALBVIS(:), PEK%XALBUV(:), &
ZDIR_ALB_WITHOUT_SNOW, ZSCA_ALB_WITHOUT_SNOW )
!
!* total shortwave incoming radiation
!
- PGLOBAL_SW(:) = 0.
- PMEB_SCA_SW(:) = 0.
- DO JSWB=1,KSW
- PGLOBAL_SW(:) = PGLOBAL_SW(:) + (PDIR_SW(:,JSWB) + PSCA_SW(:,JSWB))
- PMEB_SCA_SW(:) = PMEB_SCA_SW(:) + (PSCA_SW(:,JSWB))
- END DO
+PGLOBAL_SW (:) = 0.
+PMEB_SCA_SW(:) = 0.
+DO JSWB=1,KSW
+ PGLOBAL_SW (:) = PGLOBAL_SW(:) + (PDIR_SW(:,JSWB) + PSCA_SW(:,JSWB))
+ PMEB_SCA_SW(:) = PMEB_SCA_SW(:) + (PSCA_SW(:,JSWB))
+END DO
!
!* snow-free global albedo (needed by ISBA)
!
- ZSW_UP(:) = 0.
+ZSW_UP(:) = 0.
+DO JSWB=1,KSW
+ ZSW_UP(:) = ZSW_UP(:) &
+ + ZDIR_ALB_WITHOUT_SNOW(:,JSWB) * PDIR_SW(:,JSWB) &
+ + ZSCA_ALB_WITHOUT_SNOW(:,JSWB) * PSCA_SW(:,JSWB)
+END DO
+PEK%XSNOWFREE_ALB(:) = XUNDEF
+WHERE(PGLOBAL_SW(:)>0.)
+ PEK%XSNOWFREE_ALB(:) = ZSW_UP(:) / PGLOBAL_SW(:)
+ELSEWHERE
+ PEK%XSNOWFREE_ALB(:) = ZDIR_ALB_WITHOUT_SNOW(:,1)
+END WHERE
+!
+IF(PEK%TSNOW%SCHEME == 'EBA') THEN
+ CALL ALBEDO_FROM_NIR_VIS(PSW_BANDS, &
+ PEK%XALBNIR_VEG(:), PEK%XALBVIS_VEG(:), PEK%XALBUV_VEG(:), &
+ ZDIR_ALB_VEG_WITHOUT_SNOW, ZSCA_ALB_VEG_WITHOUT_SNOW )
+ ZSW_UP(:) = 0.
DO JSWB=1,KSW
- ZSW_UP(:) = ZSW_UP(:) &
- + ZDIR_ALB_WITHOUT_SNOW(:,JSWB) * PDIR_SW(:,JSWB) &
- + ZSCA_ALB_WITHOUT_SNOW(:,JSWB) * PSCA_SW(:,JSWB)
+ ZSW_UP(:) = ZSW_UP(:) &
+ + ZDIR_ALB_VEG_WITHOUT_SNOW(:,JSWB) * PDIR_SW(:,JSWB) &
+ + ZSCA_ALB_VEG_WITHOUT_SNOW(:,JSWB) * PSCA_SW(:,JSWB)
END DO
- PSNOWFREE_ALB(:) = XUNDEF
- WHERE(PGLOBAL_SW(:)>0.)
- PSNOWFREE_ALB(:) = ZSW_UP(:) / PGLOBAL_SW(:)
- ELSEWHERE
- PSNOWFREE_ALB(:) = ZDIR_ALB_WITHOUT_SNOW(:,1)
- END WHERE
-!
- IF(HSNOW == 'EBA') THEN
- CALL ALBEDO_FROM_NIR_VIS(PSW_BANDS, &
- PALBNIR_VEG, PALBVIS_VEG, PALBUV_VEG, &
- ZDIR_ALB_VEG_WITHOUT_SNOW, &
- ZSCA_ALB_VEG_WITHOUT_SNOW )
- ZSW_UP(:) = 0.
- DO JSWB=1,KSW
- ZSW_UP(:) = ZSW_UP(:) &
- + ZDIR_ALB_VEG_WITHOUT_SNOW(:,JSWB) * PDIR_SW(:,JSWB) &
- + ZSCA_ALB_VEG_WITHOUT_SNOW(:,JSWB) * PSCA_SW(:,JSWB)
- END DO
- PSNOWFREE_ALB_VEG(:) = XUNDEF
- WHERE(PGLOBAL_SW(:)>0.) PSNOWFREE_ALB_VEG(:) = ZSW_UP(:) / PGLOBAL_SW(:)
-!
- CALL ALBEDO_FROM_NIR_VIS(PSW_BANDS, &
- PALBNIR_SOIL, PALBVIS_SOIL, PALBUV_SOIL, &
- ZDIR_ALB_SOIL_WITHOUT_SNOW, &
- ZSCA_ALB_SOIL_WITHOUT_SNOW )
- ZSW_UP(:) = 0.
- DO JSWB=1,KSW
- ZSW_UP(:) = ZSW_UP(:) &
- + ZDIR_ALB_SOIL_WITHOUT_SNOW(:,JSWB) * PDIR_SW(:,JSWB) &
- + ZSCA_ALB_SOIL_WITHOUT_SNOW(:,JSWB) * PSCA_SW(:,JSWB)
- END DO
- PSNOWFREE_ALB_SOIL(:) = XUNDEF
- WHERE(PGLOBAL_SW(:)>0.) PSNOWFREE_ALB_SOIL(:) = ZSW_UP(:) / PGLOBAL_SW(:)
- ENDIF
+ PEK%XSNOWFREE_ALB_VEG(:) = XUNDEF
+ WHERE(PGLOBAL_SW(:)>0.) PEK%XSNOWFREE_ALB_VEG(:) = ZSW_UP(:) / PGLOBAL_SW(:)
+!
+ CALL ALBEDO_FROM_NIR_VIS(PSW_BANDS, &
+ PEK%XALBNIR_SOIL(:), PEK%XALBVIS_SOIL(:), PEK%XALBUV_SOIL(:), &
+ ZDIR_ALB_SOIL_WITHOUT_SNOW, ZSCA_ALB_SOIL_WITHOUT_SNOW )
+ ZSW_UP(:) = 0.
+ DO JSWB=1,KSW
+ ZSW_UP(:) = ZSW_UP(:) &
+ + ZDIR_ALB_SOIL_WITHOUT_SNOW(:,JSWB) * PDIR_SW(:,JSWB) &
+ + ZSCA_ALB_SOIL_WITHOUT_SNOW(:,JSWB) * PSCA_SW(:,JSWB)
+ END DO
+ PEK%XSNOWFREE_ALB_SOIL(:) = XUNDEF
+ WHERE(PGLOBAL_SW(:)>0.) PEK%XSNOWFREE_ALB_SOIL(:) = ZSW_UP(:) / PGLOBAL_SW(:)
+ENDIF
+!
IF (LHOOK) CALL DR_HOOK('ISBA_ALBEDO',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/isba_budget.F90 b/src/SURFEX/isba_budget.F90
index f03b6844c46cf0cdbd4c4e7cac861ffd3a97fb8f..9fc8b9926ddaeec708f70ee04fb68766cf1f0a84 100644
--- a/src/SURFEX/isba_budget.F90
+++ b/src/SURFEX/isba_budget.F90
@@ -3,15 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE ISBA_BUDGET (DGEI, &
- HISBA, HSNOW_ISBA, OGLACIER, PTSTEP, &
- PWG, PWGI, PWR, PSNOWSWE, PDG, PDZG, &
- PWG_INI, PWGI_INI, PWR_INI, PSWE_INI, &
- PRAIN, PSNOW, PEVAP, PDRAIN, PRUNOFF, &
- PIFLOOD, PPFLOOD, PLE_FLOOD, PLEI_FLOOD,&
- PICEFLUX, PIRRIG_FLUX, PSNDRIFT, &
- PLVTT, PLSTT, &
- PDWG, PDWGI, PDWR, PDSWE, PWATBUD )
+SUBROUTINE ISBA_BUDGET (IO, PK, PEK, DEK, OWATER_BUDGET, PTSTEP,&
+ PWG_INI, PWGI_INI, PWR_INI, PSWE_INI, PRAIN, PSNOW, PEVAP )
! ###############################################################################
!
!!**** *ISBA_BUDGET * - water and energy budget for ISBA
@@ -33,11 +26,11 @@ SUBROUTINE ISBA_BUDGET (DGEI, &
!! MODIFICATIONS
!! -------------
!! Original 07/2012
-!!
!! B. Decharme 01/16 : Bug with flood budget
!!------------------------------------------------------------------
!
-!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_P_t, ISBA_PE_t
USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -51,29 +44,15 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK
!
-TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DGEI
+LOGICAL, INTENT(IN) :: OWATER_BUDGET
!
- CHARACTER(LEN=*), INTENT(IN) :: HISBA ! type of ISBA version:
-! ! '2-L' (default)
-! ! '3-L'
-! ! 'DIF'
- CHARACTER(LEN=*), INTENT(IN) :: HSNOW_ISBA ! 'DEF' = Default F-R snow scheme
-! ! (Douville et al. 1995)
-! ! '3-L' = 3-L snow scheme (option)
-! ! (Boone and Etchevers 2000)
-! ! 'CRO' = Crocus snow scheme
-LOGICAL, INTENT(IN) :: OGLACIER ! True = glacier over permanent snow and ice
- ! False = No specific treatment
REAL, INTENT(IN) :: PTSTEP ! timestep of the integration (s)
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PWG ! liquid water content by layer (m3/m3)
-REAL, DIMENSION(:,:), INTENT(IN) :: PWGI ! ice content by layer (m3/m3)
-REAL, DIMENSION(:), INTENT(IN) :: PWR ! liquid water on veg canopy (kg m-2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWSWE ! snow water equivalent by layer (kg m-2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PDG ! soil layer depth (m)
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZG ! soil layer thickness (m)
-!
REAL, DIMENSION(:), INTENT(IN) :: PWG_INI ! total wg at t-1 (kg m-2)
REAL, DIMENSION(:), INTENT(IN) :: PWGI_INI ! total wgi at t-1 (kg m-2)
REAL, DIMENSION(:), INTENT(IN) :: PWR_INI ! total wr at t-1 (kg m-2)
@@ -82,34 +61,18 @@ REAL, DIMENSION(:), INTENT(IN) :: PSWE_INI ! total swe at t-1
REAL, DIMENSION(:), INTENT(IN) :: PRAIN ! Rain rate (kg/m2/s)
REAL, DIMENSION(:), INTENT(IN) :: PSNOW ! Snow rate (kg/m2/s)
REAL, DIMENSION(:), INTENT(IN) :: PEVAP ! total evaporative flux (kg/m2/s)
-REAL, DIMENSION(:), INTENT(IN) :: PDRAIN ! drainage (kg/m2/s)
-REAL, DIMENSION(:), INTENT(IN) :: PRUNOFF ! surface runoff (kg/m2/s)
-REAL, DIMENSION(:), INTENT(IN) :: PIFLOOD ! Floodplain infiltration (kg/m2/s)
-REAL, DIMENSION(:), INTENT(IN) :: PPFLOOD ! Floodplain direct precip runoff(kg/m2/s)
-REAL, DIMENSION(:), INTENT(IN) :: PLE_FLOOD ! Floodplain latent heat (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PLEI_FLOOD! Floodplain sublimation heat (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PICEFLUX ! Ice flux from Snow reservoir (kg/m2/s)
-REAL ,DIMENSION(:), INTENT(IN) :: PIRRIG_FLUX! additional water flux from irrigation (kg/m2/s)
-REAL ,DIMENSION(:), INTENT(IN) :: PSNDRIFT ! blowing snow sublimation (kg/m2/s)
-REAL, DIMENSION(:), INTENT(IN) :: PLVTT, PLSTT
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PDWG
-REAL, DIMENSION(:), INTENT(OUT) :: PDWGI
-REAL, DIMENSION(:), INTENT(OUT) :: PDWR
-REAL, DIMENSION(:), INTENT(OUT) :: PDSWE
-REAL, DIMENSION(:), INTENT(OUT) :: PWATBUD ! ISBA water budget (kg/m2/s)
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(SIZE(PWR)) :: ZINPUT
-REAL, DIMENSION(SIZE(PWR)) :: ZOUTPUT
-REAL, DIMENSION(SIZE(PWR)) :: ZTENDENCY
-REAL, DIMENSION(SIZE(PWR)) :: ZICEFLUX
-REAL, DIMENSION(SIZE(PWR)) :: ZSWE_T
-REAL, DIMENSION(SIZE(PWR)) :: ZWG_T
-REAL, DIMENSION(SIZE(PWR)) :: ZWGI_T
-REAL, DIMENSION(SIZE(PWR)) :: ZSNDRIFT
-REAL, DIMENSION(SIZE(PWR)) :: ZEFLOOD
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZINPUT
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZOUTPUT
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZTENDENCY
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZICEFLUX
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZSWE_T
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZWG_T
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZWGI_T
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZSNDRIFT
+REAL, DIMENSION(SIZE(PEK%XWR)) :: ZEFLOOD
!
INTEGER :: INI, INL, INLS
INTEGER :: JI, JL
@@ -122,83 +85,82 @@ IF (LHOOK) CALL DR_HOOK('ISBA_BUDGET',0,ZHOOK_HANDLE)
!* 1.0 Init
! -----------
!
-INI =SIZE(PWG,1)
-INL =SIZE(PWG,2)
-INLS=SIZE(PSNOWSWE,2)
+INI =SIZE(PEK%XWG,1)
+INL =SIZE(PEK%XWG,2)
+INLS=SIZE(PEK%TSNOW%WSNOW,2)
!
-PDWG (:) = XUNDEF
-PDWGI(:) = XUNDEF
-PDWR (:) = XUNDEF
-PDSWE(:) = XUNDEF
+DEK%XDWG (:) = XUNDEF
+DEK%XDWGI(:) = XUNDEF
+DEK%XDWR (:) = XUNDEF
+DEK%XDSWE(:) = XUNDEF
!
-IF (HSNOW_ISBA=='3-L'.OR.HSNOW_ISBA=='CRO') THEN
- ZSNDRIFT(:)=PSNDRIFT(:)
+IF (PEK%TSNOW%SCHEME=='3-L'.OR.PEK%TSNOW%SCHEME=='CRO') THEN
+ ZSNDRIFT(:) = DEK%XSNDRIFT(:)
ELSE
- ZSNDRIFT(:)=0.0
+ ZSNDRIFT(:) = 0.0
ENDIF
!
!* 2.0 Comptut isba water budget in kg/m2/s
! -------------------------------------------
!
-IF(DGEI%LWATER_BUDGET)THEN
+IF(OWATER_BUDGET)THEN
!
! total swe at t in kg/m2
ZSWE_T(:)=0.0
DO JL=1,INLS
- DO JI=1,INI
- ZSWE_T(JI)=ZSWE_T(JI)+PSNOWSWE(JI,JL)
- ENDDO
+ DO JI=1,INI
+ ZSWE_T(JI) = ZSWE_T(JI)+PEK%TSNOW%WSNOW(JI,JL)
+ ENDDO
ENDDO
!
! total wg and wgi at t in kg/m2
ZWG_T (:)= 0.0
ZWGI_T(:)= 0.0
- IF(HISBA=='DIF')THEN
+ IF(IO%CISBA=='DIF')THEN
DO JL=1,INL
- DO JI=1,INI
- IF(PWG(JI,JL)/=XUNDEF)THEN
- ZWG_T (JI)=ZWG_T (JI)+PWG (JI,JL)*PDZG(JI,JL)*XRHOLW
- ZWGI_T(JI)=ZWGI_T(JI)+PWGI(JI,JL)*PDZG(JI,JL)*XRHOLW
- ENDIF
- ENDDO
+ DO JI=1,INI
+ IF(PEK%XWG(JI,JL)/=XUNDEF)THEN
+ ZWG_T (JI) = ZWG_T (JI)+PEK%XWG(JI,JL) *PK%XDZG(JI,JL)*XRHOLW
+ ZWGI_T(JI) = ZWGI_T(JI)+PEK%XWGI(JI,JL)*PK%XDZG(JI,JL)*XRHOLW
+ ENDIF
+ ENDDO
ENDDO
ELSE
- ZWG_T (:)=PWG (:,2)*PDG(:,2)*XRHOLW
- ZWGI_T(:)=PWGI(:,2)*PDG(:,2)*XRHOLW
- IF(HISBA=='3-L')THEN
- ZWG_T(:)=ZWG_T(:)+PWG(:,3)*(PDG(:,3)-PDG(:,2))*XRHOLW
+ ZWG_T (:) = PEK%XWG (:,2)*PK%XDG(:,2)*XRHOLW
+ ZWGI_T(:) = PEK%XWGI(:,2)*PK%XDG(:,2)*XRHOLW
+ IF(IO%CISBA=='3-L')THEN
+ ZWG_T(:)=ZWG_T(:)+PEK%XWG(:,3)*(PK%XDG(:,3)-PK%XDG(:,2))*XRHOLW
ENDIF
ENDIF
!
! Comptut reservoir time tendencies in kg/m2/s
- PDWG (:) = (ZWG_T (:)-PWG_INI (:))/PTSTEP
- PDWGI(:) = (ZWGI_T(:)-PWGI_INI(:))/PTSTEP
- PDWR (:) = (PWR (:)-PWR_INI (:))/PTSTEP
- PDSWE(:) = (ZSWE_T(:)-PSWE_INI(:))/PTSTEP
+ DEK%XDWG (:) = (ZWG_T (:)-PWG_INI (:))/PTSTEP
+ DEK%XDWGI(:) = (ZWGI_T (:)-PWGI_INI(:))/PTSTEP
+ DEK%XDWR (:) = (PEK%XWR(:)-PWR_INI (:))/PTSTEP
+ DEK%XDSWE(:) = (ZSWE_T (:)-PSWE_INI(:))/PTSTEP
!
! ice calving flux if used
- IF(OGLACIER)THEN
- ZICEFLUX(:)=PICEFLUX(:)
+ IF(IO%LGLACIER)THEN
+ ZICEFLUX(:)=DEK%XICEFLUX(:)
ELSE
ZICEFLUX(:)=0.0
ENDIF
!
! Floodplains evaporation (kg/m2/s)
- ZEFLOOD(:)=PLE_FLOOD(:)/PLVTT(:)+PLEI_FLOOD(:)/PLSTT(:)
+ ZEFLOOD(:) = DEK%XLE_FLOOD(:)/PK%XLVTT(:)+DEK%XLEI_FLOOD(:)/PK%XLSTT(:)
!
! total input water in the system at t
- ZINPUT(:)=PRAIN(:)+PSNOW(:)+PIFLOOD(:)+PIRRIG_FLUX(:)
+ ZINPUT(:)=PRAIN(:)+PSNOW(:)+DEK%XIFLOOD(:)+DEK%XIRRIG_FLUX(:)
!
! total output water in the system at t
- ZOUTPUT(:) = PEVAP (:)+PDRAIN (:)+PRUNOFF (:) &
- + PPFLOOD(:)+ZICEFLUX(:)+ZSNDRIFT(:) &
- - ZEFLOOD(:)
+ ZOUTPUT(:) = PEVAP (:)+DEK%XDRAIN (:)+DEK%XRUNOFF (:) &
+ + DEK%XPFLOOD(:)+ZICEFLUX(:)+ZSNDRIFT(:) - ZEFLOOD(:)
!
! total reservoir time tendencies at "t - (t-1)"
- ZTENDENCY(:) = PDWG(:)+PDWGI(:)+PDWR(:)+PDSWE(:)
+ ZTENDENCY(:) = DEK%XDWG(:)+DEK%XDWGI(:)+DEK%XDWR(:)+DEK%XDSWE(:)
!
! isba water budget (dw/dt=in-out) in kg/m2/s
- PWATBUD(:)=ZTENDENCY(:)-(ZINPUT(:)-ZOUTPUT(:))
+ DEK%XWATBUD(:)=ZTENDENCY(:)-(ZINPUT(:)-ZOUTPUT(:))
!
ENDIF
!
diff --git a/src/SURFEX/isba_budget_init.F90 b/src/SURFEX/isba_budget_init.F90
index 368ca5d98fc5dc06dce7656e9ea32de44842fc82..b66794200b40347d1776eaca66d6a2c8dd2fa8eb 100644
--- a/src/SURFEX/isba_budget_init.F90
+++ b/src/SURFEX/isba_budget_init.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE ISBA_BUDGET_INIT (DGEI, &
- HISBA, HSNOW_ISBA, &
- PWG, PWGI, PWR, PSNOWSWE, PDG, PDZG, &
+SUBROUTINE ISBA_BUDGET_INIT (OWATER_BUDGET, HISBA, PEK, PDG, PDZG, &
PWG_INI, PWGI_INI, PWR_INI, PSWE_INI )
! ###############################################################################
!
@@ -33,6 +31,7 @@ SUBROUTINE ISBA_BUDGET_INIT (DGEI, &
!
!
USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+USE MODD_ISBA_n, ONLY : ISBA_PE_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_CSTS, ONLY : XRHOLW
@@ -46,22 +45,14 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DGEI
+LOGICAL, INTENT(IN) :: OWATER_BUDGET
!
CHARACTER(LEN=*), INTENT(IN) :: HISBA ! type of ISBA version:
! ! '2-L' (default)
! ! '3-L'
! ! 'DIF'
- CHARACTER(LEN=*), INTENT(IN) :: HSNOW_ISBA ! 'DEF' = Default F-R snow scheme
-! ! (Douville et al. 1995)
-! ! '3-L' = 3-L snow scheme (option)
-! ! (Boone and Etchevers 2000)
-! ! 'CRO' = Crocus snow scheme
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PWG ! liquid water content by layer (m3/m3)
-REAL, DIMENSION(:,:), INTENT(IN) :: PWGI ! ice content by layer (m3/m3)
-REAL, DIMENSION(:), INTENT(IN) :: PWR ! liquid water on veg canopy (kg m-2)
-REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWSWE ! snow water equivalent by layer (kg m-2)
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
REAL, DIMENSION(:,:), INTENT(IN) :: PDG ! soil layer depth (m)
REAL, DIMENSION(:,:), INTENT(IN) :: PDZG ! soil layer thickness (m)
!
@@ -80,9 +71,9 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('ISBA_BUDGET_INIT',0,ZHOOK_HANDLE)
!
-INI =SIZE(PWG,1)
-INL =SIZE(PWG,2)
-INLS=SIZE(PSNOWSWE,2)
+INI =SIZE(PEK%XWG,1)
+INL =SIZE(PEK%XWG,2)
+INLS=SIZE(PEK%TSNOW%WSNOW,2)
!
PWG_INI (:) = XUNDEF
PWGI_INI(:) = XUNDEF
@@ -93,16 +84,16 @@ PWR_INI (:) = XUNDEF
! * Water budget
! ------------
!
-IF(DGEI%LWATER_BUDGET)THEN
+IF(OWATER_BUDGET)THEN
!
! total wr at t-1
- PWR_INI(:)=PWR(:)
+ PWR_INI(:)=PEK%XWR(:)
!
! total swe at t-1
PSWE_INI(:)=0.0
DO JL=1,INLS
DO JI=1,INI
- PSWE_INI(JI)=PSWE_INI(JI)+PSNOWSWE(JI,JL)
+ PSWE_INI(JI)=PSWE_INI(JI)+PEK%TSNOW%WSNOW(JI,JL)
ENDDO
ENDDO
!
@@ -112,17 +103,17 @@ IF(DGEI%LWATER_BUDGET)THEN
IF(HISBA=='DIF')THEN
DO JL=1,INL
DO JI=1,INI
- IF(PWG(JI,JL)/=XUNDEF)THEN
- PWG_INI (JI)=PWG_INI (JI)+PWG (JI,JL)*PDZG(JI,JL)*XRHOLW
- PWGI_INI(JI)=PWGI_INI(JI)+PWGI(JI,JL)*PDZG(JI,JL)*XRHOLW
+ IF(PEK%XWG(JI,JL)/=XUNDEF)THEN
+ PWG_INI (JI)=PWG_INI (JI)+PEK%XWG (JI,JL)*PDZG(JI,JL)*XRHOLW
+ PWGI_INI(JI)=PWGI_INI(JI)+PEK%XWGI(JI,JL)*PDZG(JI,JL)*XRHOLW
ENDIF
ENDDO
ENDDO
ELSE
- PWG_INI (:)=PWG (:,2)*PDG(:,2)*XRHOLW
- PWGI_INI(:)=PWGI(:,2)*PDG(:,2)*XRHOLW
+ PWG_INI (:)=PEK%XWG (:,2)*PDG(:,2)*XRHOLW
+ PWGI_INI(:)=PEK%XWGI(:,2)*PDG(:,2)*XRHOLW
IF(HISBA=='3-L')THEN
- PWG_INI(:)=PWG_INI(:)+PWG(:,3)*(PDG(:,3)-PDG(:,2))*XRHOLW
+ PWG_INI(:)=PWG_INI(:)+PEK%XWG(:,3)*(PDG(:,3)-PDG(:,2))*XRHOLW
ENDIF
ENDIF
!
diff --git a/src/SURFEX/isba_canopy.F90 b/src/SURFEX/isba_canopy.F90
index e86159837eafb2fe3d550b53f47e3c0adad7cfe0..7933f99b5f60881e81614bb059c5c1dac61f8e56 100644
--- a/src/SURFEX/isba_canopy.F90
+++ b/src/SURFEX/isba_canopy.F90
@@ -3,10 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE ISBA_CANOPY (I, &
- KI,KLVL,PZ,PZF,PDZ,PDZF,PHEIGHT,PCANOPY_DENSITY,PU,PTKE, &
- PUW_GROUND, PDUWDU_GROUND, &
- PFORC_U,PDFORC_UDU,PFORC_E,PDFORC_EDE)
+SUBROUTINE ISBA_CANOPY (PCDRAG, KI, SB, PHEIGHT, PCANOPY_DENSITY, PUW_GROUND, PDUWDU_GROUND, &
+ PFORC_U, PDFORC_UDU, PFORC_E, PDFORC_EDE)
! ###############################################################################
!
!!**** *ISBA_CANOPY_n * - prepares forcing for canopy air model
@@ -30,8 +28,7 @@ SUBROUTINE ISBA_CANOPY (I, &
!! Original 07/2006
!!---------------------------------------------------------------
!
-!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_CANOPY_n, ONLY : CANOPY_t
!
USE MODD_CSTS, ONLY : XRD, XCPD, XP00, XG
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -46,39 +43,32 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(ISBA_t), INTENT(INOUT) :: I
+REAL, INTENT(IN) :: PCDRAG
!
INTEGER, INTENT(IN) :: KI ! number of points
-INTEGER, INTENT(IN) :: KLVL ! number of levels in canopy
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PZ ! heights of canopy levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PZF ! heights of bottom of canopy levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDZ ! depth of canopy levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDZF ! depth between canopy levels (m)
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
REAL, DIMENSION(KI), INTENT(IN) :: PHEIGHT ! canopy height (m)
REAL, DIMENSION(KI), INTENT(IN) :: PCANOPY_DENSITY ! canopy density (-)
-
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PU ! wind for each canopy layer (m/s)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PTKE ! Tke for each canopy layer (m2/s2)
!
REAL, DIMENSION(KI), INTENT(IN) :: PUW_GROUND ! friction flux for ground surface (m2/s2)
REAL, DIMENSION(KI), INTENT(IN) :: PDUWDU_GROUND ! derivative of ground friction flux (m/s)
!
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PFORC_U ! tendency of wind due to canopy drag (m/s2)
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PDFORC_UDU! formal derivative of the tendency of
+REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PFORC_U ! tendency of wind due to canopy drag (m/s2)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PDFORC_UDU! formal derivative of the tendency of
! ! wind due to canopy drag (1/s)
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PFORC_E ! tendency of TKE due to canopy drag (m2/s3)
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PDFORC_EDE! formal derivative of the tendency of
+REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PFORC_E ! tendency of TKE due to canopy drag (m2/s3)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PDFORC_EDE! formal derivative of the tendency of
! ! TKE due to canopy drag (1/s)
!
!* 0.2 declarations of local variables
!
INTEGER :: JLAYER, JJ ! loop counter on canopy heights
!
-REAL, DIMENSION(KI,KLVL) :: ZCDRAG ! drag coefficient in canopy
-REAL, DIMENSION(KI,KLVL) :: ZDENSITY ! vegetation density for each canopy level
-REAL, DIMENSION(KI,KLVL) :: ZSV ! vertical surface for each canopy level
-REAL, DIMENSION(KI,KLVL) :: ZFORC
-REAL, DIMENSION(KI,KLVL) :: ZAIRVOL ! Fraction of air for each canopy level total volume
+REAL, DIMENSION(KI,SB%NLVL) :: ZCDRAG ! drag coefficient in canopy
+REAL, DIMENSION(KI,SB%NLVL) :: ZDENSITY ! vegetation density for each canopy level
+REAL, DIMENSION(KI,SB%NLVL) :: ZSV ! vertical surface for each canopy level
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC
+REAL, DIMENSION(KI,SB%NLVL) :: ZAIRVOL ! Fraction of air for each canopy level total volume
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
@@ -93,11 +83,11 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('ISBA_CANOPY',0,ZHOOK_HANDLE)
ZDENSITY(:,:) = 0.
-DO JLAYER = 1,KLVL
+DO JLAYER = 1,SB%NLVL
DO JJ = 1,KI
IF (PHEIGHT(JJ)>0.) THEN
ZDENSITY(JJ,JLAYER) = 1.5 * &
- MAX( PCANOPY_DENSITY(JJ)*4.*PZ(JJ,JLAYER)*(PHEIGHT(JJ)-PZ(JJ,JLAYER))/PHEIGHT(JJ)**2, 0.)
+ MAX(PCANOPY_DENSITY(JJ)*4.*SB%XZ(JJ,JLAYER)*(PHEIGHT(JJ)-SB%XZ(JJ,JLAYER))/PHEIGHT(JJ)**2, 0.)
ENDIF
ENDDO
END DO
@@ -105,7 +95,7 @@ END DO
!* 2.1 Drag coefficient by vegetation (Patton et al 2001)
! ------------------------------
!
-ZCDRAG(:,:) = I%XCDRAG
+ZCDRAG(:,:) = PCDRAG
!
!* 1.4 No building volume
!
@@ -119,15 +109,15 @@ ZAIRVOL(:,:) = 1.
!
!* 1.2 Discretization on each canopy level
!
- CALL CANOPY(KI, KLVL, PZF, PDZ, PHEIGHT, ZDENSITY, ZCDRAG, PU, ZAIRVOL, &
- ZSV, ZFORC, PFORC_U, PDFORC_UDU, PFORC_E, PDFORC_EDE )
+ CALL CANOPY(KI, SB, PHEIGHT, ZDENSITY, ZCDRAG, ZAIRVOL, ZSV, &
+ ZFORC, PFORC_U, PDFORC_UDU, PFORC_E, PDFORC_EDE )
!
!
!* 2.4 Drag force by ground surface
! ----------------------------
!
-PFORC_U (:,1) = PUW_GROUND(:) / PDZ(:,1)
-PDFORC_UDU(:,1) = PDFORC_UDU(:,1) + PDUWDU_GROUND(:) / PDZ(:,1)
+PFORC_U (:,1) = PUW_GROUND(:) / SB%XDZ(:,1)
+PDFORC_UDU(:,1) = PDFORC_UDU(:,1) + PDUWDU_GROUND(:) / SB%XDZ(:,1)
!-------------------------------------------------------------------------------------
!
@@ -138,7 +128,7 @@ PDFORC_UDU(:,1) = PDFORC_UDU(:,1) + PDUWDU_GROUND(:) / PDZ(:,1)
!
! Ext = - Cd * e * u * Sv trees
!
-PFORC_E (:,:) = PFORC_E - 2.*PTKE(:,:)*ZFORC(:,:)
+PFORC_E (:,:) = PFORC_E - 2.*SB%XTKE(:,:)*ZFORC(:,:)
PDFORC_EDE(:,:) = PDFORC_EDE - 2.*ZFORC(:,:)
!
IF (LHOOK) CALL DR_HOOK('ISBA_CANOPY',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/isba_ceb.F90 b/src/SURFEX/isba_ceb.F90
index b10d9ae8f7531c88e29984b97a64842ec5c79595..8a8df43831baf5702c2de6855b77b503f53eabf1 100644
--- a/src/SURFEX/isba_ceb.F90
+++ b/src/SURFEX/isba_ceb.F90
@@ -3,23 +3,15 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#########
-SUBROUTINE ISBA_CEB(HISBA, HSNOW_ISBA, HCPSURF, OFLOOD, OTEMP_ARP, HIMPLICIT_WIND, &
- PTSTEP, PSODELX, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, &
- PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, PSNOWALB, &
- PSW_RAD, PLW_RAD, PWG, PWGI, PEXNS, PEXNA, PTA, PVMOD, &
- PQA, PRR, PSR, PPS, PRS, PVEG, PZ0_WITH_SNOW, PZ0EFF, &
- PZ0H_WITH_SNOW, PWFC, PWSAT, PPSN, PPSNG, PPSNV, PZREF, &
- PUREF, PDIRCOSZW, PF5, PFFG, PFFV, PFF, PFFG_NOSNOW, &
- PFFV_NOSNOW, PWR, PRHOA, PEMIS, PALB, PCT, PCS, PCG, &
- PD_G, PDZG, PDZDIF, PSOILCONDZ, PSOILHCAPZ, PFROZEN1, &
- PTDEEP_A, PTDEEP_B, PGAMMAT, PPSNV_A, PSNOWFREE_ALB_VEG, &
- PSNOWFREE_ALB_SOIL, PGRNDFLUX, PFLSN_COR, &
- PSNOW_THRUFAL, PFFROZEN, PFALB, PFEMIS, PSNOWSWE, PSRSFC, &
- PTG, PRESA, PLVTT, PLSTT, PCPS, PDELTA, PCH, PCD, PCDN, &
- PRI, PHUG, PHUGI, PHV, PHU, PQS, PALBT, PEMIST, PDEEP_FLUX, &
- PRN, PH, PLE, PLEG, PLEGI, PLEV, PLES, PLER, PLETR, PEVAP, &
- PGFLUX, PMELTADV, PMELT, PRESTORE, PUSTAR, PLE_FLOOD, &
- PLEI_FLOOD, PSNOWTEMP, PAC_AGG, PHU_AGG )
+SUBROUTINE ISBA_CEB(IO, KK, PK, PEK, DK, DEK, DMK, &
+ HIMPLICIT_WIND, PTSTEP, PPEW_A_COEF, &
+ PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF,&
+ PPEQ_B_COEF, PSW_RAD, PLW_RAD, PEXNS, PEXNA, PTA, &
+ PVMOD, PQA, PRR, PSR, PPS, PZREF, PUREF, PDIRCOSZW,&
+ PF5, PFFG_NOSNOW, PFFV_NOSNOW, PRHOA, PCS, &
+ PSOILCONDZ, PSOILHCAPZ, PFROZEN1, PTDEEP_A, &
+ PGRNDFLUX, PFLSN_COR, PSNOW_THRUFAL, PDELTA, PHUGI,&
+ PALBT, PEMIST, PDEEP_FLUX, PUSTAR, PAC_AGG, PHU_AGG )
! ##########################################################################
!
!
@@ -52,13 +44,19 @@ SUBROUTINE ISBA_CEB(HISBA, HSNOW_ISBA, HCPSURF, OFLOOD, OTEMP_ARP, HIMPLICIT_WIN
!! MODIFICATIONS
!! -------------
!! Original 10/03/95
-!!
!! (B. Decharme) 03/16 Bug : limitation of Er for Interception reservoir
!! PTSTEP insted of ZTSTEP in drag.F90
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
+!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_DIAG_n, ONLY : DIAG_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
+!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE MODD_SURF_ATM, ONLY : LCPL_ARP
@@ -77,33 +75,18 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
! -------------------------
!
-! in
-!
-!
- CHARACTER(LEN=*), INTENT(IN) :: HISBA ! type of ISBA version:
-! ! '2-L' (default)
-! ! '3-L'
-! ! 'DIF'
- CHARACTER(LEN=*), INTENT(IN) :: HSNOW_ISBA ! 'DEF' = Default F-R snow scheme
-! ! (Douville et al. 1995)
-! ! '3-L' = 3-L snow scheme (option)
-! ! (Boone and Etchevers 2000)
- CHARACTER(LEN=*), INTENT(IN) :: HCPSURF ! option for specific heat Cp:
-! ! 'DRY' = dry Cp
-! ! 'HUM' = Cp as a function of qs
-!
-LOGICAL, INTENT(IN) :: OFLOOD ! Activation of the flooding scheme
-LOGICAL, INTENT(IN) :: OTEMP_ARP ! True = time-varying force-restore soil temperature (as in ARPEGE)
- ! False = No time-varying force-restore soil temperature (Default)
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(DIAG_t), INTENT(INOUT) :: DK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK
!
CHARACTER(LEN=*), INTENT(IN) :: HIMPLICIT_WIND ! wind implicitation option
! ! 'OLD' = direct
! ! 'NEW' = Taylor serie, order 1
-!
REAL, INTENT(IN) :: PTSTEP ! timestep of the integration
-!
-REAL, DIMENSION(:), INTENT(IN) :: PSODELX ! Pulsation for each layer (Only used if LTEMP_ARP=True)
-!
REAL, DIMENSION(:), INTENT(IN) :: PPEW_A_COEF, PPEW_B_COEF, &
PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
PPEQ_B_COEF
@@ -114,16 +97,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PPEW_A_COEF, PPEW_B_COEF,
! PPEQ_A_COEF = A-air specific humidity coefficient
! PPEQ_B_COEF = B-air specific humidity coefficient
!
-REAL, DIMENSION(:), INTENT(IN) :: PSNOWALB
-! prognostic variables at time 't-dt'
-! PSNOWALB = albedo of the snow
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PWG, PWGI, PWFC, PWSAT
-! PWG = near-surface volumetric water content
-! PWGI = near-surface frozen volumetric water content
-! PWFC = field capacity volumetric water content
-! PWSAT = volumetric water content at saturation
-!
REAL, DIMENSION(:), INTENT(IN) :: PSW_RAD, PLW_RAD
! PSW_RAD = incoming solar radiation
! PLW_RAD = atmospheric infrared radiation
@@ -139,15 +112,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PEXNA, PEXNS, PTA, PVMOD, PQA, PRR, PSR, PPS
! PRR = rain rate
! PSR = snow rate
!
-REAL, DIMENSION(:), INTENT(IN) :: PRS, PVEG
-! PRS = stomatal resistance
-! PVEG = vegetation fraction
-REAL, DIMENSION(:), INTENT(IN) :: PPSN, PPSNG, PPSNV
-! PPSN = grid fraction covered by snow
-! PPSNG = fraction of the bare ground covered
-! by snow
-! PPSNV = fraction of the vegetation covered
-! by snow
REAL, DIMENSION(:), INTENT(IN) :: PZREF, PUREF
! PZREF = reference height of the first
! atmospheric level
@@ -156,32 +120,19 @@ REAL, DIMENSION(:), INTENT(IN) :: PZREF, PUREF
! ONLY in stand-alone/forced mode,
! NOT when coupled to a model (MesoNH)
!
-REAL, DIMENSION(:), INTENT(IN) :: PZ0EFF ! roughness length for momentum
-REAL, DIMENSION(:), INTENT(IN) :: PZ0_WITH_SNOW ! roughness length for momentum
-! ! (with snow taken into account)
-REAL, DIMENSION(:), INTENT(IN) :: PZ0H_WITH_SNOW ! roughness length for heat
-! ! (with snow taken into account)
-!
REAL, DIMENSION(:), INTENT(IN) :: PF5
! PF5 = water stress function for Hv
REAL, DIMENSION(:), INTENT(IN) :: PDIRCOSZW
! PDIRCOSZW = Cosinus of the angle between the normal to the surface and the vertical
!
-REAL, DIMENSION(:), INTENT(IN) :: PFFV, PFF, PFFG, PFFG_NOSNOW, PFFV_NOSNOW
-! PFFG = Floodplain fraction over ground
-! PFFV = Floodplain fraction over vegetation
-! PFF = Floodplain fraction at the surface
+REAL, DIMENSION(:), INTENT(IN) :: PFFG_NOSNOW, PFFV_NOSNOW
!
-REAL, DIMENSION(:), INTENT(IN) :: PWR, PRHOA
-! PWR = liquid water retained on the foliage
+REAL, DIMENSION(:), INTENT(IN) :: PRHOA
! PRHOA = near-ground air density
!
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS, PALB, PCT, PCS, PCG
+REAL, DIMENSION(:), INTENT(IN) :: PCS
! PEMIS = emissivity
-! PALB = albedo
-! PCT = area-averaged heat capacity
! PCS = heat capacity of the snow (K m2 J-1)
-! PCG = heat capacity of the soil (K m2 J-1)
REAL, DIMENSION(:), INTENT(IN) :: PGRNDFLUX, PFLSN_COR, PSNOW_THRUFAL
! PGRNDFLUX = soil/snow interface flux (W/m2) using
! ISBA-SNOW3L option
@@ -189,79 +140,25 @@ REAL, DIMENSION(:), INTENT(IN) :: PGRNDFLUX, PFLSN_COR, PSNOW_THRUFAL
! PSNOW_THRUFAL = snow runoff/melt leaving pack and available
! at the surface for runoff or infiltration
! [kg/(m2 s)]
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_G, PSOILCONDZ, PSOILHCAPZ
-! PD_G = Depth of bottom of Soil layers (m)
+REAL, DIMENSION(:,:), INTENT(IN) :: PSOILCONDZ, PSOILHCAPZ
! PSOILCONDZ= ISBA-DF Soil conductivity profile [W/(m K)]
! PSOILHCAPZ=ISBA-DF Soil heat capacity profile [J/(m3 K)]
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZG ! soil layers thicknesses (DIF option) (m)
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZDIF ! distance between consecuative layer mid-points (DIF option) (m)
-!
REAL, DIMENSION(:), INTENT(IN) :: PFROZEN1
! PFROZEN1 = ice fraction in supurficial soil
!
-REAL, DIMENSION(:), INTENT(IN) :: PTDEEP_A, PTDEEP_B, PGAMMAT
+REAL, DIMENSION(:), INTENT(IN) :: PTDEEP_A
! PTDEEP_A = Deep soil temperature
! coefficient depending on flux
-! PTDEEP_B = Deep soil temperature (prescribed)
-! which models heating/cooling from
-! below the diurnal wave penetration
-! (surface temperature) depth. If it
-! is FLAGGED as undefined, then the zero
-! flux lower BC is applied.
-! Tdeep = PTDEEP_B + PTDEEP_A * PDEEP_FLUX
-! (with PDEEP_FLUX in W/m2)
-! PGAMMAT = Deep soil heat transfer coefficient:
-! assuming homogeneous soil so that
-! this can be prescribed in units of
-! (1/days): associated time scale with
-! PTDEEP.
-!
-REAL, DIMENSION(:), INTENT(IN) :: PSNOWFREE_ALB_VEG !snow free albedo of vegetation for EBA
-REAL, DIMENSION(:), INTENT(IN) :: PSNOWFREE_ALB_SOIL !snow free albedo of soil for EBA option
-REAL, DIMENSION(:), INTENT(IN) :: PPSNV_A !fraction of the the vegetation covered by snow for EBA scheme
-!
-REAL, DIMENSION(:), INTENT(IN) :: PFALB, PFEMIS, PFFROZEN
-! PFALB = Floodplain albedo
-! PFEMIS= Floodplain emis
-!
-REAL, DIMENSION(:), INTENT(IN) :: PSNOWSWE
-! PSNOWSWE = equivalent water content of
-! the D95 snow reservoir (kg m-2)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PSRSFC ! Snow rate falling outside of snow
-! covered grid area [kg/(m2 s)]
-!
!inout
!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTG
-! surface temperature
-REAL, DIMENSION(:), INTENT(INOUT) :: PRESA
-! aerodynamic surface resistance
-REAL, DIMENSION(:), INTENT(INOUT) :: PLVTT
-! PLVTT=Vaporization heat
-REAL, DIMENSION(:), INTENT(INOUT) :: PLSTT
-! PLSTT=Sublimation heat
-REAL, DIMENSION(:), INTENT(INOUT) :: PCPS
-! PCPS=specific heat at surface
REAL, DIMENSION(:), INTENT(INOUT) :: PDELTA
! PDELTA = fraction of the foliage covered
! by intercepted water
-!
!out
!
-REAL, DIMENSION(:), INTENT(OUT) :: PCH, PCD, PCDN, PRI
-! PCH = drag coefficient for heat
-! PCD = drag coefficient for momentum
-! PCDN= neutral drag coefficient for momentum
-! PRI = Richardson number
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PHUG, PHUGI, PHV, PHU, PQS
-! PHUG = ground relative humidity
+REAL, DIMENSION(:), INTENT(OUT) :: PHUGI
! PHUGI = ground (ice) relative humidity
-! PHV = Halstead coefficient
-! PHU = relative humidity at the surface
-! PQS = humidity at surface
!
REAL, DIMENSION(:), INTENT(OUT) :: PALBT, PEMIST
! PALBT = averaged albedo
@@ -269,34 +166,9 @@ REAL, DIMENSION(:), INTENT(OUT) :: PALBT, PEMIST
!
REAL, DIMENSION(:), INTENT(OUT) :: PDEEP_FLUX ! Heat flux at bottom of ISBA (W/m2)
!
-REAL, DIMENSION(:), INTENT(OUT) :: PRN, PH, PLE, PLEG, PLEV, PLES
-REAL, DIMENSION(:), INTENT(OUT) :: PLER, PLETR, PEVAP, PGFLUX, PMELTADV, PMELT, PRESTORE
-! PRN = net radiation at the surface
-! PH = sensible heat flux
-! PLE = latent heat flux
-! PLEG = latent heat flux from the soil surface
-! PLEV = latent heat flux from the vegetation
-! PLES = latent heat flux from the snow
-! PLER = direct evaporation from the fraction
-! delta of the foliage
-! PLETR = transpiration of the remaining
-! part of the leaves
-! PEVAP = total evaporative flux (kg/m2/s)
-! PGFLUX = ground flux
-! PMELTADV = heat advection by melting snow
-! (acts to restore temperature to
-! melting point) (W/m2)
-! PMELT = melting rate of snow (kg m-2 s-1)
-! PRESTORE = surface restore flux (W m-2)
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PLEGI, PUSTAR
-! PLEGI = sublimation component of the
-! latent heat flux from the soil surface
+REAL, DIMENSION(:), INTENT(OUT) :: PUSTAR
! PUSTAR = friction velocity
!
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_FLOOD, PLEI_FLOOD !Floodplains latent heat flux [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PSNOWTEMP ! snow layer temperatures (K)
-!
REAL, DIMENSION(:), INTENT(OUT) :: PAC_AGG ! aggregated aerodynamic conductance
! for evaporative flux calculations
REAL, DIMENSION(:), INTENT(OUT) :: PHU_AGG ! aggregated relative humidity
@@ -305,8 +177,8 @@ REAL, DIMENSION(:), INTENT(OUT) :: PHU_AGG ! aggregated relative humidity
!
!* 0.2 declarations of local parameters
!
-REAL, PARAMETER :: ZDEPTH_COR = 0.6
-! ZDEPTH_COR = depth over which the correction flux is applied
+REAL, PARAMETER :: ZDEKTH_COR = 0.6
+! ZDEKTH_COR = depth over which the correction flux is applied
!
REAL, PARAMETER :: ZDTG1_COR = 10.0
! ZDTG1_COR = Delta temperature limit to comput the correction flux (K)
@@ -327,12 +199,12 @@ REAL, DIMENSION(SIZE(PTA)) :: ZLEGI_DELTA ! soil sublimation delta fn
REAL, DIMENSION(SIZE(PTA)) :: ZT2M ! restore temperature before time integration (K)
REAL, DIMENSION(SIZE(PTA)) :: ZTSM ! surface temperature before time integration (K)
!
-REAL, DIMENSION(SIZE(PTG,1),SIZE(PTG,2)) :: ZFLUX_COR, ZLAYERHCAP
+REAL, DIMENSION(SIZE(PEK%XTG,1),SIZE(PEK%XTG,2)) :: ZFLUX_COR, ZLAYERHCAP
! ZFLUX_COR = correction flux by layer to conserve energy (W/m2)
!
REAL, DIMENSION(SIZE(PTA)) :: ZGRNDFLUX, ZTOTALHCAP, ZWORK
!
-INTEGER :: INI, INL, JI, JL
+INTEGER :: INJ, INL, JI, JL
LOGICAL :: LEXPLICIT_SNOW
!
!* 0.4 declarations of local time spliting variables
@@ -368,8 +240,8 @@ IF (LHOOK) CALL DR_HOOK('ISBA_CEB',0,ZHOOK_HANDLE)
!* 1.0 Preliminaries
! -------------
!
-INI=SIZE(PTG,1)
-INL=SIZE(PTG,2)
+INJ=SIZE(PEK%XTG,1)
+INL=SIZE(PEK%XTG,2)
!
!local init
!
@@ -436,37 +308,38 @@ ZFLUX_COR(:,:) = 0.0
!* 2.0 Correction flux to conserv energy budget
! ----------------------------------------
!
-LEXPLICIT_SNOW=(HSNOW_ISBA == '3-L' .OR. HSNOW_ISBA == 'CRO')
+LEXPLICIT_SNOW=(PEK%TSNOW%SCHEME == '3-L' .OR. PEK%TSNOW%SCHEME == 'CRO')
!
-IF(LEXPLICIT_SNOW.AND.HISBA/='DIF')THEN
+IF(LEXPLICIT_SNOW.AND.IO%CISBA/='DIF')THEN
!
- ZFLUX_COR(:,1)=PPSN(:)*PFLSN_COR(:)
+ ZFLUX_COR(:,1)=PEK%XPSN(:)*PFLSN_COR(:)
!
-ELSEIF(LEXPLICIT_SNOW.AND.HISBA=='DIF')THEN
+ELSEIF(LEXPLICIT_SNOW.AND.IO%CISBA=='DIF')THEN
!
ZLAYERHCAP (:,:) = 0.0
ZTOTALHCAP (:) = 0.0
!
! To conserv energy, the correction flux is distributed at least
-! over the first layers of the soil, ZDEPTH_COR. This method prevent
+! over the first layers of the soil, ZDEKTH_COR. This method prevent
! numerical oscillations especially when explicit snow vanishes
!
- ZWORK(:)=MIN(PD_G(:,INL),ZDEPTH_COR)
+ ZWORK(:) = MIN(PK%XDG(:,INL),ZDEKTH_COR)
!
- ZLAYERHCAP(:,1)= 1.0/PCT(:)
- ZTOTALHCAP(: )= 1.0/PCT(:)
+ ZLAYERHCAP(:,1)= 1.0/DMK%XCT(:)
+ ZTOTALHCAP(: )= 1.0/DMK%XCT(:)
DO JL=2,INL
- DO JI=1,INI
- ZLAYERHCAP(JI,JL)=PSOILHCAPZ(JI,JL)*MIN(PDZG(JI,JL),MAX(0.0,ZWORK(JI)-PD_G(JI,JL)+PDZG(JI,JL)))
- ZTOTALHCAP(JI )=ZTOTALHCAP(JI)+ZLAYERHCAP(JI,JL)
- ENDDO
+ DO JI=1,INJ
+ ZLAYERHCAP(JI,JL) = PSOILHCAPZ(JI,JL) * MIN( PK%XDZG(JI,JL), &
+ MAX(0.0,ZWORK(JI)-PK%XDG(JI,JL) +PK%XDZG(JI,JL)) )
+ ZTOTALHCAP(JI ) = ZTOTALHCAP(JI) + ZLAYERHCAP(JI,JL)
+ ENDDO
ENDDO
!
DO JL=1,INL
- DO JI=1,INI
- IF(ZTOTALHCAP(JI)>0.0)THEN
- ZFLUX_COR(JI,JL)=PPSN(JI)*PFLSN_COR(JI)*ZLAYERHCAP(JI,JL)/ZTOTALHCAP(JI)
- ENDIF
+ DO JI=1,INJ
+ IF(ZTOTALHCAP(JI)>0.0)THEN
+ ZFLUX_COR(JI,JL) = PEK%XPSN(JI)*PFLSN_COR(JI)*ZLAYERHCAP(JI,JL)/ZTOTALHCAP(JI)
+ ENDIF
ENDDO
ENDDO
!
@@ -474,19 +347,19 @@ ELSEIF(LEXPLICIT_SNOW.AND.HISBA=='DIF')THEN
! due to snow/soil ground flux is superior to ZDTG1_COR (K)
! Especially relevant when PPSN ~ 1 over vegetated area
!
- ZWORK(:)=PTSTEP*PCT(:)*PPSN(:)*ABS(PGRNDFLUX(:))
+ ZWORK(:)=PTSTEP*DMK%XCT(:)*PEK%XPSN(:)*ABS(PGRNDFLUX(:))
!
WHERE(ZTOTALHCAP(:)>0.0.AND.ZWORK(:)>=ZDTG1_COR)
- ZGRNDFLUX(:) = PGRNDFLUX(:)*ZLAYERHCAP(:,1)/ZTOTALHCAP(:)
+ ZGRNDFLUX(:) = PGRNDFLUX(:)*ZLAYERHCAP(:,1)/ZTOTALHCAP(:)
ENDWHERE
!
DO JL=2,INL
- DO JI=1,INI
- IF(ZTOTALHCAP(JI)>0.0.AND.ZWORK(JI)>=ZDTG1_COR)THEN
- ZFLUX_COR(JI,JL)=ZFLUX_COR(JI,JL)+PPSN(JI)*PGRNDFLUX(JI) &
- *ZLAYERHCAP(JI,JL)/ZTOTALHCAP(JI)
- ENDIF
- ENDDO
+ DO JI=1,INJ
+ IF(ZTOTALHCAP(JI)>0.0.AND.ZWORK(JI)>=ZDTG1_COR)THEN
+ ZFLUX_COR(JI,JL)=ZFLUX_COR(JI,JL)+PEK%XPSN(JI)*PGRNDFLUX(JI) &
+ *ZLAYERHCAP(JI,JL)/ZTOTALHCAP(JI)
+ ENDIF
+ ENDDO
ENDDO
!
ENDIF
@@ -510,43 +383,36 @@ DO JSPLIT=1,ITSPLIT
! Save surface and sub-surface temperature values at beginning of time step for
! budget and flux calculations:
!
- ZTSM(:) = PTG(:,1)
- ZT2M(:) = PTG(:,2)
+ ZTSM(:) = PEK%XTG(:,1)
+ ZT2M(:) = PEK%XTG(:,2)
!
!
!* 3.0 Aerodynamic drag and heat transfer coefficients
! -----------------------------------------------
-!
+!
! In DRAG, we use the timestep of ISBA (PTSTEP) and not the split time step (ZTSTEP)
! because diagnostic canopy evaporation (Er) must be consistent with PWR water
! mass to limit negative dripping in hydro_veg
!
- CALL DRAG(HISBA, HSNOW_ISBA, HCPSURF, PTSTEP, &
- PTG(:,1), PWG(:,1), PWGI(:,1), PEXNS, PEXNA, PTA, PVMOD, PQA, PRR, PSR, &
- PPS, PRS, PVEG, PZ0_WITH_SNOW, PZ0EFF, PZ0H_WITH_SNOW, &
- PWFC(:,1), PWSAT(:,1), PPSNG, PPSNV, PZREF, PUREF, &
- PDIRCOSZW, PDELTA, PF5, PRESA, PCH, PCD, PCDN, PRI, PHUG, PHUGI, &
- PHV, PHU, PCPS, PQS, PFFG, PFFV, PFF, PFFG_NOSNOW, PFFV_NOSNOW, &
- ZLEG_DELTA, ZLEGI_DELTA, PWR, PRHOA, PLVTT, PQSAT=ZQSAT )
-!
-!
+ CALL DRAG(IO%CISBA, PEK%TSNOW%SCHEME, IO%CCPSURF, PTSTEP, PEK%XTG(:,1), PEK%XWG(:,1), &
+ PEK%XWGI(:,1), PEXNS, PEXNA, PTA, PVMOD, PQA, PRR, PSR, PPS, DMK%XRS, &
+ PEK%XVEG, DK%XZ0, DK%XZ0EFF, DK%XZ0H, KK%XWFC(:,1), KK%XWSAT(:,1), &
+ PEK%XPSNG, PEK%XPSNV, PZREF, PUREF, PDIRCOSZW, PDELTA, PF5, PEK%XRESA,&
+ DK%XCH, DK%XCD, DK%XCDN, DK%XRI, DK%XHUG, PHUGI, DMK%XHV, DK%XHU, &
+ PK%XCPS, DK%XQS, KK%XFFG, KK%XFFV, KK%XFF, PFFG_NOSNOW, PFFV_NOSNOW, &
+ ZLEG_DELTA, ZLEGI_DELTA, PEK%XWR, PRHOA, PK%XLVTT, PQSAT=ZQSAT )
!
!* 4.0 Resolution of the surface and soil energy budget
! ------------------------------------------------
!
- CALL E_BUDGET(HISBA, HSNOW_ISBA, OFLOOD, OTEMP_ARP, HIMPLICIT_WIND, &
- ZTSTEP, PSODELX, PUREF, &
- PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
- PPEQ_B_COEF, PVMOD, PCD, PTG, ZTSM, ZT2M, PSNOWALB, PSW_RAD, PLW_RAD, &
- PTA, PQA, PPS, PRHOA, PEXNS, PEXNA, PCPS, PLVTT, PLSTT, PVEG, &
- PHUG, PHUGI, PHV, ZLEG_DELTA, ZLEGI_DELTA, PEMIS, PALB, PRESA, &
- PCT, PCG, PPSN, PPSNV, PPSNG, ZGRNDFLUX, ZFLUX_COR, &
- PD_G, PDZG, PDZDIF, PSOILCONDZ, PSOILHCAPZ, PALBT, PEMIST, &
- ZQSAT, ZDQSAT, PFROZEN1, PTDEEP_A, PTDEEP_B, PGAMMAT, &
- ZTA_IC, ZQA_IC, ZUSTAR2_IC, &
- PSNOWFREE_ALB_VEG, PPSNV_A, PSNOWFREE_ALB_SOIL, &
- PFFG, PFFV, PFF, PFFROZEN, PFALB, PFEMIS, ZDEEP_FLUX, ZRESTORE )
-!
+ CALL E_BUDGET(IO, KK, PK, PEK, DK, DMK, HIMPLICIT_WIND, &
+ ZTSTEP, PUREF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, &
+ PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, PVMOD, ZTSM, ZT2M, &
+ PSW_RAD, PLW_RAD, PTA, PQA, PPS, PRHOA, PEXNS, PEXNA, &
+ PHUGI, ZLEG_DELTA, ZLEGI_DELTA, ZGRNDFLUX, ZFLUX_COR, &
+ PSOILCONDZ, PSOILHCAPZ, PALBT, PEMIST, ZQSAT, ZDQSAT, &
+ PFROZEN1, PTDEEP_A, ZTA_IC, ZQA_IC, ZUSTAR2_IC, ZDEEP_FLUX, &
+ ZRESTORE )
!
!* 5.0 Energy and momentum fluxes
! --------------------------
@@ -558,18 +424,13 @@ DO JSPLIT=1,ITSPLIT
! '3-L' : they represent flood + snow-flood-free albedo and emissivity
!*******************************************************************************
!
- CALL ISBA_FLUXES(HISBA, HSNOW_ISBA, OTEMP_ARP, ZTSTEP, PSODELX, &
- PSW_RAD, PLW_RAD, ZTA_IC, ZQA_IC, &
- PRHOA, PEXNS, PEXNA, PCPS, PLVTT, PLSTT, &
- PVEG, PHUG, PHUGI, PHV, ZLEG_DELTA, ZLEGI_DELTA, PDELTA, PRESA, &
- PF5, PRS, PCS, PCG, PCT, PSNOWSWE, ZTSM, ZT2M, &
- PPSN, PPSNV, PPSNG, PFROZEN1, &
- PALBT, PEMIST, ZQSAT, ZDQSAT, PSNOW_THRUFAL, &
- ZRN, ZH, ZLE, ZLEG, ZLEGI, ZLEV, ZLES, ZLER, ZLETR, ZEVAP, ZGFLUX, &
- ZMELTADV, ZMELT, &
- PSOILCONDZ, PD_G, PDZG, PTG, &
- PSRSFC, PPSNV_A, PFFG, PFFV, PFF, PFFROZEN, &
- ZLE_FLOOD, ZLEI_FLOOD, PSNOWTEMP )
+ CALL ISBA_FLUXES(IO, KK, PK, PEK, DMK, ZTSTEP, &
+ PSW_RAD, PLW_RAD, ZTA_IC, ZQA_IC, PRHOA, PEXNS, PEXNA, &
+ DK%XHUG, PHUGI, ZLEG_DELTA, ZLEGI_DELTA, PDELTA, PF5, &
+ PCS, ZTSM, ZT2M, PFROZEN1, PALBT, PEMIST, ZQSAT, ZDQSAT, &
+ PSNOW_THRUFAL, ZRN, ZH, ZLE, ZLEG, ZLEGI, ZLEV, ZLES, &
+ ZLER, ZLETR, ZEVAP, ZGFLUX, ZMELTADV, ZMELT, PSOILCONDZ, &
+ ZLE_FLOOD, ZLEI_FLOOD )
!
!
!* 6.0 Aggregated coefficients
@@ -578,18 +439,18 @@ DO JSPLIT=1,ITSPLIT
! Compute aggregated coefficients for evaporation
! Sum(LEV+LEG+LEGI+LES) = ACagg * Lv * RHOA * (HUagg.Qsat - Qa)
!
- ZAC_AGG(:) = 1. / PRESA(:) / PLVTT(:) &
- * ( PLVTT(:)* PVEG(:) *(1.-PPSNV(:)) *PHV(:) &
- + PLVTT(:)*(1.-PVEG(:))*(1.-PPSNG(:))*(1.-PFROZEN1(:)) &
- + PLSTT(:)*(1.-PVEG(:))*(1.-PPSNG(:))* PFROZEN1(:) &
- + PLSTT(:)* PPSN (:) )
+ ZAC_AGG(:) = 1. / PEK%XRESA(:) / PK%XLVTT(:) &
+ * ( PK%XLVTT(:) * PEK%XVEG(:) * (1.-PEK%XPSNV(:)) * DMK%XHV(:) &
+ + PK%XLVTT(:) *(1.-PEK%XVEG(:))* (1.-PEK%XPSNG(:)) * (1.-PFROZEN1(:)) &
+ + PK%XLSTT(:) *(1.-PEK%XVEG(:))* (1.-PEK%XPSNG(:)) * PFROZEN1(:) &
+ + PK%XLSTT(:) * PEK%XPSN (:) )
!
WHERE(ZAC_AGG(:)>0.0)
- ZHU_AGG(:) = 1. / (PRESA(:) * ZAC_AGG(:)) / PLVTT(:) &
- * ( PLVTT(:)* PVEG(:) *(1.-PPSNV(:)) *PHV(:) &
- + PLVTT(:)*(1.-PVEG(:))*(1.-PPSNG(:))*(1.-PFROZEN1(:))*PHUG(:) &
- + PLSTT(:)*(1.-PVEG(:))*(1.-PPSNG(:))* PFROZEN1(:) *PHUGI(:) &
- + PLSTT(:)* PPSN (:) )
+ ZHU_AGG(:) = 1. / (PEK%XRESA(:) * ZAC_AGG(:)) / PK%XLVTT(:) &
+ * ( PK%XLVTT(:)* PEK%XVEG(:) *(1.-PEK%XPSNV(:)) *DMK%XHV(:) &
+ + PK%XLVTT(:)*(1.-PEK%XVEG(:))*(1.-PEK%XPSNG(:))*(1.-PFROZEN1(:))*DK%XHUG(:) &
+ + PK%XLSTT(:)*(1.-PEK%XVEG(:))*(1.-PEK%XPSNG(:))* PFROZEN1(:) *PHUGI(:) &
+ + PK%XLSTT(:)* PEK%XPSN (:) )
ENDWHERE
!
ZUSTAR2_SUM (:) = ZUSTAR2_SUM (:) + ZUSTAR2_IC(:)
@@ -623,26 +484,26 @@ ENDDO
!
PUSTAR (:) = SQRT(ZUSTAR2_SUM(:)/ZNSPLIT)
!
-PEVAP (:) = ZEVAP_SUM (:) / ZNSPLIT
+DK%XEVAP (:) = ZEVAP_SUM (:) / ZNSPLIT
!
-PRN (:) = ZRN_SUM (:) / ZNSPLIT
-PH (:) = ZH_SUM (:) / ZNSPLIT
-PGFLUX (:) = ZGFLUX_SUM (:) / ZNSPLIT
-PLE (:) = ZLE_SUM (:) / ZNSPLIT
+DK%XRN (:) = ZRN_SUM (:) / ZNSPLIT
+DK%XH (:) = ZH_SUM (:) / ZNSPLIT
+DK%XGFLUX (:) = ZGFLUX_SUM (:) / ZNSPLIT
+PEK%XLE (:) = ZLE_SUM (:) / ZNSPLIT
!
-PLEG (:) = ZLEG_SUM (:) / ZNSPLIT
-PLEGI (:) = ZLEGI_SUM (:) / ZNSPLIT
-PLEV (:) = ZLEV_SUM (:) / ZNSPLIT
-PLES (:) = ZLES_SUM (:) / ZNSPLIT
-PLER (:) = ZLER_SUM (:) / ZNSPLIT
-PLETR (:) = ZLETR_SUM (:) / ZNSPLIT
-PLE_FLOOD (:) = ZLE_FLOOD_SUM (:) / ZNSPLIT
-PLEI_FLOOD(:) = ZLEI_FLOOD_SUM(:) / ZNSPLIT
+DEK%XLEG (:) = ZLEG_SUM (:) / ZNSPLIT
+DEK%XLEGI (:) = ZLEGI_SUM (:) / ZNSPLIT
+DEK%XLEV (:) = ZLEV_SUM (:) / ZNSPLIT
+DEK%XLES (:) = ZLES_SUM (:) / ZNSPLIT
+DEK%XLER (:) = ZLER_SUM (:) / ZNSPLIT
+DEK%XLETR (:) = ZLETR_SUM (:) / ZNSPLIT
+DEK%XLE_FLOOD (:) = ZLE_FLOOD_SUM (:) / ZNSPLIT
+DEK%XLEI_FLOOD(:) = ZLEI_FLOOD_SUM(:) / ZNSPLIT
!
PDEEP_FLUX(:) = ZDEEP_FLUX_SUM(:) / ZNSPLIT
-PMELTADV (:) = ZMELTADV_SUM (:) / ZNSPLIT
-PMELT (:) = ZMELT_SUM (:) / ZNSPLIT
-PRESTORE (:) = ZRESTORE_SUM (:) / ZNSPLIT
+DEK%XMELTADV (:) = ZMELTADV_SUM (:) / ZNSPLIT
+DEK%XMELT (:) = ZMELT_SUM (:) / ZNSPLIT
+DEK%XRESTORE (:) = ZRESTORE_SUM (:) / ZNSPLIT
PAC_AGG (:) = ZAC_AGG_SUM (:) / ZNSPLIT
PHU_AGG (:) = ZHU_AGG_SUM (:) / ZNSPLIT
!
diff --git a/src/SURFEX/isba_fluxes.F90 b/src/SURFEX/isba_fluxes.F90
index 955a3252d6096b92bdf052c89d747da1c504aa68..deea82fe377eff68d90e6e7680ca86339657a6f8 100644
--- a/src/SURFEX/isba_fluxes.F90
+++ b/src/SURFEX/isba_fluxes.F90
@@ -3,22 +3,12 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ######spl
- SUBROUTINE ISBA_FLUXES(HISBA, HSNOW_ISBA, OTEMP_ARP, &
- PTSTEP, PSODELX, &
- PSW_RAD, PLW_RAD, PTA, PQA, &
- PRHOA, PEXNS, PEXNA, PCPS, PLVTT, PLSTT, &
- PVEG, PHUG, PHUI, PHV, &
- PLEG_DELTA, PLEGI_DELTA, PDELTA, PRA, &
- PF5, PRS, PCS, PCG, PCT, PSNOWSWE, PTSM, PT2M, &
- PPSN, PPSNV, PPSNG, PFROZEN1, &
- PALBT, PEMIST, PQSAT, PDQSAT, PSNOW_THRUFAL, &
- PRN, PH, PLE, PLEG, PLEGI, PLEV, &
- PLES, PLER, PLETR, PEVAP, &
- PGFLUX, PMELTADV, PMELT, &
- PSOILCONDZ, PD_G, PDZG, PTG, &
- PSR, PPSNV_A, &
- PFFG, PFFV, PFF, PFFROZEN, &
- PLE_FLOOD, PLEI_FLOOD, PSNOWTEMP )
+ SUBROUTINE ISBA_FLUXES(IO, KK, PK, PEK, DMK, PTSTEP, &
+ PSW_RAD, PLW_RAD, PTA, PQA, PRHOA, PEXNS, PEXNA, &
+ PHUG, PHUI, PLEG_DELTA, PLEGI_DELTA, PDELTA, PF5, PCS, PTSM, PT2M, &
+ PFROZEN1, PALBT, PEMIST, PQSAT, PDQSAT, PSNOW_THRUFAL, &
+ PRN, PH, PLE, PLEG, PLEGI, PLEV, PLES, PLER, PLETR, PEVAP, &
+ PGFLUX, PMELTADV, PMELT, PSOILCONDZ, PLE_FLOOD, PLEI_FLOOD)
! ##########################################################################
!
!!**** *ISBA_FLUXES*
@@ -90,6 +80,10 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
+!
USE MODD_CSTS, ONLY : XSTEFAN, XCPD, XLSTT, XLVTT, XCL, XTT, XPI, XDAY, &
XCI, XRHOLI, XLMTT, XRHOLW, XG, XCL, XCONDI
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -107,25 +101,14 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
- CHARACTER(LEN=*), INTENT(IN) :: HISBA ! type of soil (Force-Restore OR Diffusion)
-! ! '2-L'
-! ! '3-L'
-! ! 'DIF' ISBA-DF
-!
- CHARACTER(LEN=*), INTENT(IN) :: HSNOW_ISBA ! 'DEF' = Default F-R snow scheme
-! ! (Douville et al. 1995)
-! ! '3-L' = 3-L snow scheme (option)
-! ! (Boone and Etchevers 2001)
-!
-LOGICAL, INTENT(IN) :: OTEMP_ARP ! True = time-varying force-restore soil temperature (as in ARPEGE)
- ! False = No time-varying force-restore soil temperature (Default)
-!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK
!
REAL, INTENT (IN) :: PTSTEP ! model time step (s)
!
-!
-REAL, DIMENSION(:), INTENT(IN) :: PSODELX ! Pulsation for each layer (Only used if LTEMP_ARP=True)
-!
REAL, DIMENSION(:), INTENT (IN) :: PSW_RAD, PLW_RAD, PTA, PQA, PRHOA
! PSW_RAD = incoming solar radiation
! PLW_RAD = atmospheric infrared radiation
@@ -134,26 +117,15 @@ REAL, DIMENSION(:), INTENT (IN) :: PSW_RAD, PLW_RAD, PTA, PQA, PRHOA
! PRHOA = near-ground air density
!
REAL, DIMENSION(:), INTENT(IN) :: PEXNS, PEXNA
-REAL, DIMENSION(:), INTENT(IN) :: PVEG
-REAL, DIMENSION(:), INTENT(IN) :: PHUG, PHUI, PHV, PDELTA, PRA, PRS, PF5
-REAL, DIMENSION(:), INTENT(IN) :: PPSN, PPSNV, PPSNG, PFROZEN1
+REAL, DIMENSION(:), INTENT(IN) :: PHUG, PHUI, PDELTA, PF5
+REAL, DIMENSION(:), INTENT(IN) :: PFROZEN1
REAL, DIMENSION(:), INTENT(IN) :: PALBT, PEMIST
REAL, DIMENSION(:), INTENT(IN) :: PQSAT, PDQSAT
REAL, DIMENSION(:), INTENT(IN) :: PLEG_DELTA, PLEGI_DELTA
-! PVEG = fraction of vegetation
! PHUG = relative humidity of the soil
-! PHV = Halstead coefficient
! PF5 = water stress numerical correction factor (based on F2)
! PDELTA = fraction of the foliage covered
! by intercepted water
-! PRA = aerodynamic surface resistance for
-! heat transfers
-! PRS = surface stomatal resistance
-! PPSN = grid fraction covered by snow
-! PPSNV = fraction of the vegetation covered
-! by snow
-! PPSNG = fraction of the ground covered by
-! snow
! PFROZEN1 = fraction of ice in near-surface
! ground
! PALBT = area averaged albedo
@@ -163,45 +135,19 @@ REAL, DIMENSION(:), INTENT(IN) :: PLEG_DELTA, PLEGI_DELTA
! PLEG_DELTA = soil evaporation delta fn
! PLEGI_DELTA = soil evaporation delta fn
!
-REAL, DIMENSION(:), INTENT (IN) :: PCS, PCG, PCT, PT2M, PTSM, PSNOWSWE
-! PCT = area-averaged heat capacity (K m2 J-1)
+REAL, DIMENSION(:), INTENT (IN) :: PCS, PT2M, PTSM
! PCS = heat capacity of the snow (K m2 J-1)
-! PCG = heat capacity of the soil (K m2 J-1)
! PT2M = mean surface (or restore) temperature at start
! of time step (K)
! PTSM = surface temperature at start
! of time step (K)
-! PSNOWSWE = equivalent water content of
-! the snow reservoir (kg m-2)
-!
REAL, DIMENSION(:), INTENT(IN) :: PSNOW_THRUFAL
! PSNOW_THRUFAL = rate that liquid water leaves snow pack:
! ISBA-ES [kg/(m2 s)]
-REAL, DIMENSION(:), INTENT(IN) :: PSR
-! PSR = snow precipitation rate [kg/(m2 s)]
-REAL, DIMENSION(:), INTENT(IN) :: PPSNV_A
-! PPSNV_A = vegetation covered by snow EBA scheme
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_G, PSOILCONDZ
-! PD_G = Depth of bottom of Soil layers (m)
+REAL, DIMENSION(:,:), INTENT(IN) :: PSOILCONDZ
! PSOILCONDZ= ISBA-DF Soil conductivity profile [W/(m K)]
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZG
-! PDZG = Layer thickness (DIF option)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PCPS, PLVTT, PLSTT
-! PCPS = heat capacity at surface
-!
-REAL, DIMENSION(:), INTENT(IN) :: PFFV !Floodplain fraction over vegetation
-REAL, DIMENSION(:), INTENT(IN) :: PFF !Floodplain fraction at the surface
-REAL, DIMENSION(:), INTENT(IN) :: PFFG !Efective floodplain fraction
-REAL, DIMENSION(:), INTENT(IN) :: PFFROZEN !fraction of frozen flood
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTG
-! PTG = soil temperature profile (K)
-!
REAL, DIMENSION(:), INTENT(OUT) :: PLE_FLOOD, PLEI_FLOOD !Floodplains latent heat flux [W/m²]
-REAL, DIMENSION(:), INTENT(OUT) :: PSNOWTEMP ! snow layer temperatures (K)
!
REAL, DIMENSION(:), INTENT(OUT) :: PRN, PH, PLE, PLEG, PLEV, PLES
REAL, DIMENSION(:), INTENT(OUT) :: PLER, PLETR, PEVAP, PGFLUX, PMELTADV, PMELT
@@ -240,13 +186,13 @@ REAL, DIMENSION(SIZE(PTA)) :: ZZHV, ZTN, ZDT
!
REAL, DIMENSION(SIZE(PTA)) :: ZPSN, ZPSNV, ZPSNG, ZFRAC
! ZPSN, ZPSNV, ZPSNG = snow fractions corresponding to
-! dummy arguments PPSN, PPSNG, PPSNV
-! if HSNOW_ISBA = 'DEF' (composite
+! dummy arguments PEK%XPSN(:), PEK%XPSNG(:), PEK%XPSNV(:)
+! if PEK%TSNOW%SCHEME = 'DEF' (composite
! or Force-Restore snow scheme), else
! they are zero for explicit snow case
! as snow fluxes calculated outside of
! this routine using the
-! HSNOW_ISBA = '3-L' option.
+! PEK%TSNOW%SCHEME = '3-L' option.
!
REAL, DIMENSION(SIZE(PTA)) :: ZNEXTSNOW
! ZNEXTSNOW = Future snow reservoir to close the
@@ -276,7 +222,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! --------------
IF (LHOOK) CALL DR_HOOK('ISBA_FLUXES',0,ZHOOK_HANDLE)
!
-IF (HSNOW_ISBA == 'EBA') ZEPS1=1.0E-8
+IF (PEK%TSNOW%SCHEME == 'EBA') ZEPS1=1.0E-8
!
PMELT(:) = 0.0
PLER(:) = 0.0
@@ -288,15 +234,15 @@ ZDT(:) = 0.0
! fluxes calculated outside of this routine, so set
! the local snow fractions here to zero:
!
-IF(HSNOW_ISBA == '3-L' .OR. HSNOW_ISBA == 'CRO' .OR. HISBA == 'DIF')THEN
+IF(PEK%TSNOW%SCHEME == '3-L' .OR. PEK%TSNOW%SCHEME == 'CRO' .OR. IO%CISBA == 'DIF')THEN
ZPSN(:) = 0.0
ZPSNG(:) = 0.0
ZPSNV(:) = 0.0
ELSE
- ZPSN(:) = PPSN(:)
- ZPSNG(:) = PPSNG(:)+PFFG(:)
- ZPSNV(:) = PPSNV(:)+PFFV(:)
- ZFRAC(:) = PPSNG(:)
+ ZPSN(:) = PEK%XPSN(:)
+ ZPSNG(:) = PEK%XPSNG(:)+KK%XFFG(:)
+ ZPSNV(:) = PEK%XPSNV(:)+KK%XFFV(:)
+ ZFRAC(:) = PEK%XPSNG(:)
ENDIF
!
!-------------------------------------------------------------------------------
@@ -304,58 +250,58 @@ ENDIF
!* 1. FLUX CALCULATIONS
! -----------------
!
-DO JJ=1,SIZE(PTG,1)
+DO JJ=1,SIZE(PEK%XTG,1)
! temperature change
- ZDT(JJ) = PTG(JJ,1) - PTSM(JJ)
+ ZDT(JJ) = PEK%XTG(JJ,1) - PTSM(JJ)
!
! net radiation
!
- PRN(JJ) = (1. - PALBT(JJ)) * PSW_RAD(JJ) + PEMIST(JJ) * &
- (PLW_RAD(JJ) - XSTEFAN * (PTSM(JJ)** 3)*(4.*PTG(JJ,1) - 3.*PTSM(JJ)))
+ PRN(JJ) = (1. - PALBT(JJ)) * PSW_RAD(JJ) + PEMIST(JJ) * &
+ (PLW_RAD(JJ) - XSTEFAN * (PTSM(JJ)** 3)*(4.*PEK%XTG(JJ,1) - 3.*PTSM(JJ)))
!
! sensible heat flux
!
- PH(JJ) = PRHOA(JJ) * PCPS(JJ) * (PTG(JJ,1) - PTA(JJ)*PEXNS(JJ)/PEXNA(JJ)) &
- / PRA(JJ) / PEXNS(JJ)
+ PH(JJ) = PRHOA(JJ) * PK%XCPS(JJ) * (PEK%XTG(JJ,1) - PTA(JJ)*PEXNS(JJ)/PEXNA(JJ)) &
+ / PEK%XRESA(JJ) / PEXNS(JJ)
!
- ZWORK1(JJ) = PRHOA(JJ) * (1.-PVEG(JJ))*(1.-ZPSNG(JJ)) / PRA(JJ)
+ ZWORK1(JJ) = PRHOA(JJ) * (1.-PEK%XVEG(JJ))*(1.-ZPSNG(JJ)) / PEK%XRESA(JJ)
ZWORK2(JJ) = PQSAT(JJ)+PDQSAT(JJ)*ZDT(JJ)
! latent heat of sublimation from
! the ground
!
- PLEGI(JJ) = ZWORK1(JJ) * PLSTT(JJ) * ( PHUI(JJ) * ZWORK2(JJ) - PQA(JJ)) * PFROZEN1(JJ) * PLEGI_DELTA(JJ)
+ PLEGI(JJ) = ZWORK1(JJ) * PK%XLSTT(JJ) * ( PHUI(JJ) * ZWORK2(JJ) - PQA(JJ)) * PFROZEN1(JJ) * PLEGI_DELTA(JJ)
!
! total latent heat of evaporation from
! the ground
!
- PLEG(JJ) = ZWORK1(JJ) * PLVTT(JJ) * ( PHUG(JJ) * ZWORK2(JJ) - PQA(JJ)) * (1.-PFROZEN1(JJ)) * PLEG_DELTA(JJ)
+ PLEG(JJ) = ZWORK1(JJ) * PK%XLVTT(JJ) * ( PHUG(JJ) * ZWORK2(JJ) - PQA(JJ)) * (1.-PFROZEN1(JJ)) * PLEG_DELTA(JJ)
!
ZWORK2(JJ) = PRHOA(JJ) * (ZWORK2(JJ) - PQA(JJ))
- ZWORK3(JJ) = ZWORK2(JJ) / PRA(JJ)
+ ZWORK3(JJ) = ZWORK2(JJ) / PEK%XRESA(JJ)
! latent heat of evaporation from
! the snow canopy
!
- PLES(JJ) = PLSTT(JJ) * ZPSN(JJ) * ZWORK3(JJ)
+ PLES(JJ) = PK%XLSTT(JJ) * ZPSN(JJ) * ZWORK3(JJ)
!
! latent heat of evaporation from
! evaporation
!
- PLEV(JJ) = PLVTT(JJ) * PVEG(JJ)*(1.-ZPSNV(JJ)) * PHV(JJ) * ZWORK3(JJ)
+ PLEV(JJ) = PK%XLVTT(JJ) * PEK%XVEG(JJ)*(1.-ZPSNV(JJ)) * DMK%XHV(JJ) * ZWORK3(JJ)
!
! latent heat of evapotranspiration
!
- ZZHV(JJ) = MAX(0., SIGN(1.,PQSAT(JJ) - PQA(JJ)))
- PLETR(JJ) = ZZHV(JJ) * (1. - PDELTA(JJ)) * PLVTT(JJ) * PVEG(JJ)*(1-ZPSNV(JJ)) &
- * ZWORK2(JJ) *( (1/(PRA(JJ) + PRS(JJ))) - ((1.-PF5(JJ))/(PRA(JJ) + XRS_MAX)) )
+ ZZHV (JJ) = MAX(0., SIGN(1.,PQSAT(JJ) - PQA(JJ)))
+ PLETR(JJ) = ZZHV(JJ) * (1. - PDELTA(JJ)) * PK%XLVTT(JJ) * PEK%XVEG(JJ)*(1-ZPSNV(JJ)) &
+ * ZWORK2(JJ) *( (1/(PEK%XRESA(JJ) + DMK%XRS(JJ))) - ((1.-PF5(JJ))/(PEK%XRESA(JJ) + XRS_MAX)) )
!
!
PLER(JJ) = PLEV(JJ) - PLETR(JJ)
!
! latent heat of free water (floodplains)
!
- PLE_FLOOD(JJ) = PLVTT(JJ) * (1.-PFFROZEN(JJ)) * PFF(JJ) * ZWORK3(JJ)
+ PLE_FLOOD(JJ) = PK%XLVTT(JJ) * (1.-KK%XFFROZEN(JJ)) * KK%XFF(JJ) * ZWORK3(JJ)
!
- PLEI_FLOOD(JJ) = PLSTT(JJ) * PFFROZEN(JJ) * PFF(JJ) * ZWORK3(JJ)
+ PLEI_FLOOD(JJ) = PK%XLSTT(JJ) * KK%XFFROZEN(JJ) * KK%XFF(JJ) * ZWORK3(JJ)
!
! total latent heat of evaporation
! without flood
@@ -370,14 +316,14 @@ DO JJ=1,SIZE(PTG,1)
! heat flux due to snow melt
! (ISBA-ES/SNOW3L)
!
- PMELTADV(JJ) = PSNOW_THRUFAL(JJ)*XCL*(XTT - PTG(JJ,1))
+ PMELTADV(JJ) = PSNOW_THRUFAL(JJ)*XCL*(XTT - PEK%XTG(JJ,1))
!
! restore heat flux in FR mode,
! or surface to sub-surface heat
! flux using the DIF mode.
!
!
- PEVAP(JJ) = ((PLEV(JJ) + PLEG(JJ))/PLVTT(JJ)) + ((PLEGI(JJ) + PLES(JJ))/PLSTT(JJ))
+ PEVAP(JJ) = ((PLEV(JJ) + PLEG(JJ))/PK%XLVTT(JJ)) + ((PLEGI(JJ) + PLES(JJ))/PK%XLSTT(JJ))
! total evaporative flux (kg/m2/s)
! without flood
!
@@ -385,11 +331,11 @@ ENDDO
!
!-------------------------------------------------------------------------------
!
-IF(HSNOW_ISBA == 'D95')THEN
- DO JJ=1,SIZE(PTG,1)
+IF(PEK%TSNOW%SCHEME == 'D95')THEN
+ DO JJ=1,SIZE(PEK%XTG,1)
PLE (JJ) = PLE (JJ) + PLE_FLOOD(JJ) + PLEI_FLOOD(JJ)
PGFLUX (JJ) = PGFLUX (JJ) - PLE_FLOOD(JJ) - PLEI_FLOOD(JJ)
- PEVAP (JJ) = PEVAP (JJ) + PLE_FLOOD(JJ)/PLVTT(JJ) + PLEI_FLOOD(JJ)/PLSTT(JJ)
+ PEVAP (JJ) = PEVAP (JJ) + PLE_FLOOD(JJ)/PK%XLVTT(JJ) + PLEI_FLOOD(JJ)/PK%XLSTT(JJ)
ENDDO
ENDIF
!
@@ -398,29 +344,29 @@ ENDIF
!* 3. SNOWMELT LATENT HEATING EFFECTS ('DEF' option)
! ----------------------------------------------
!
-IF( (HSNOW_ISBA == 'D95' .OR. HSNOW_ISBA == 'EBA') .AND. HISBA /= 'DIF' )THEN
+IF( (PEK%TSNOW%SCHEME == 'D95' .OR. PEK%TSNOW%SCHEME == 'EBA') .AND. IO%CISBA /= 'DIF' )THEN
! temperature tn
!
- IF (HSNOW_ISBA == 'D95') THEN
+ IF (PEK%TSNOW%SCHEME == 'D95') THEN
!
- ZTN (:) = (1.-PVEG(:))*PTG(:,1) + PVEG(:)*PT2M(:)
+ ZTN(:) = (1.-PEK%XVEG(:))*PEK%XTG(:,1) + PEK%XVEG(:)*PT2M(:)
!
! Only diag
- PSNOWTEMP (:) = ZTN (:)
+ DMK%XSNOWTEMP(:,1) = ZTN (:)
!
!
! melting rate
! there is melting only if T > T0 and
! of course when SNOWSWE > 0.
!
- WHERE ( ZTN(:) > XTT .AND. PSNOWSWE(:) > 0.0 )
+ WHERE ( ZTN(:) > XTT .AND. PEK%TSNOW%WSNOW(:,1) > 0.0 )
PMELT(:) = ZPSN(:)*(ZTN(:)-XTT) / (PCS(:)*XLMTT*MAX(XTAU_SMELT,PTSTEP))
END WHERE
!
! close the energy budget: cannot melt
! more than the futur available snow
!
- ZNEXTSNOW(:) = PSNOWSWE(:) + PTSTEP * (PSR(:) - PLES(:) / PLSTT(:))
+ ZNEXTSNOW(:) = PEK%TSNOW%WSNOW(:,1) + PTSTEP * (DMK%XSRSFC(:) - PLES(:) / PK%XLSTT(:))
!
WHERE ( PMELT(:) > 0.0 )
!
@@ -435,10 +381,10 @@ IF( (HSNOW_ISBA == 'D95' .OR. HSNOW_ISBA == 'EBA') .AND. HISBA /= 'DIF' )THEN
!
ENDWHERE
!
- ELSEIF (HSNOW_ISBA == 'EBA') THEN
+ ELSEIF (PEK%TSNOW%SCHEME == 'EBA') THEN
!
- PMELT(:)=MIN( PSNOWSWE(:)/PTSTEP + PSR(:) - PLES(:)/PLSTT(:) , &
- MAX(0.0,(PTG(:,1)-XTT)) / MAX(ZEPS1,PCT*PTSTEP) / XLMTT )
+ PMELT(:)=MIN( PEK%TSNOW%WSNOW(:,1)/PTSTEP + DMK%XSRSFC(:) - PLES(:)/ PK%XLSTT(:) , &
+ MAX(0.0,(PEK%XTG(:,1)-XTT)) / MAX(ZEPS1,DMK%XCT*PTSTEP) / XLMTT )
!
ENDIF
!
@@ -446,7 +392,7 @@ IF( (HSNOW_ISBA == 'D95' .OR. HSNOW_ISBA == 'EBA') .AND. HISBA /= 'DIF' )THEN
! (cooling due to the melting of the
! snow)
!
- PTG(:,1) = PTG(:,1) - PCT(:)*XLMTT*PMELT(:)*PTSTEP
+ PEK%XTG(:,1) = PEK%XTG(:,1) - DMK%XCT(:)*XLMTT*PMELT(:)*PTSTEP
!
ENDIF
!
diff --git a/src/SURFEX/isba_fluxes_meb.F90 b/src/SURFEX/isba_fluxes_meb.F90
index 15995935f5c2734cb791111c87c2f1c7b602b4d5..8b77afbbe62641634858545e106983ad43060bcb 100644
--- a/src/SURFEX/isba_fluxes_meb.F90
+++ b/src/SURFEX/isba_fluxes_meb.F90
@@ -3,36 +3,20 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ##########################################################################
- SUBROUTINE ISBA_FLUXES_MEB( &
- PRHOA, &
- PSIGMA_F,PSIGMA_FN, &
- PEMIS_N, &
- PRNET_V,PRNET_G,PRNET_N, &
- PSWNET_V,PSWNET_G,PSWNET_N, &
- PLWNET_V,PLWNET_G,PLWNET_N, &
- PLWNET_V_DTV,PLWNET_V_DTG,PLWNET_V_DTN, &
- PLWNET_G_DTV,PLWNET_G_DTG,PLWNET_G_DTN, &
- PLWNET_N_DTV,PLWNET_N_DTG,PLWNET_N_DTN, &
- PTHRMA_TA,PTHRMB_TA,PTHRMA_TC,PTHRMB_TC, &
- PTHRMA_TG,PTHRMB_TG,PTHRMA_TV,PTHRMB_TV,PTHRMA_TN,PTHRMB_TN, &
- PQSAT_G,PQSAT_V,PQSATI_N, &
- PFF,PPSN,PPSNA,PPSNCV,PFROZEN1,PFFROZEN, &
- PLEG_DELTA,PLEGI_DELTA,PHUG,PHUGI,PHVG,PHVN, &
- PFLXC_C_A,PFLXC_G_C,PFLXC_VG_C,PFLXC_VN_C,PFLXC_N_C,PFLXC_N_A, &
- PFLXC_MOM,PFLXC_V_C,PHVGS,PHVNS, &
- PTG,PTV,PTN, &
- PDQSAT_G,PDQSAT_V,PDQSATI_N, &
- PTC,PQC,PTA_IC,PQA_IC, &
- PDELTA_V, &
- PDELTAT_G,PDELTAT_V,PDELTAT_N, &
- PSW_UP,PSW_RAD,PLW_RAD, &
- PRNET,PLW_UP, &
- PH_C_A,PH_V_C,PH_G_C,PH_N_C,PH_N_A,PH_N,PH, &
- PLE_C_A,PLE_V_C,PLE_G_C,PLE_N_C, &
- PEVAP_C_A,PLEV_V_C,PEVAP_G_C,PEVAP_N_C,PEVAP_N_A, &
- PEVAP,PSUBL,PLETR_V_C,PLER_V_C,PLEG,PLEGI, &
- PLE_FLOOD,PLEI_FLOOD,PLES,PLEL, &
- PEVAPN,PLES_V_C,PLETR,PLER,PLEV,PLE,PLEI,PTS_RAD,PEMIS,PLSTT )
+ SUBROUTINE ISBA_FLUXES_MEB(KK, PK, PEK, DK, DEK, DMK, PRHOA, PLTT, PSIGMA_F,PSIGMA_FN, &
+ PRN_V, PRN_G, PLWNET_V_DTV, PLWNET_V_DTG, PLWNET_V_DTN, &
+ PLWNET_G_DTV, PLWNET_G_DTG, PLWNET_G_DTN, PLWNET_N_DTV, &
+ PLWNET_N_DTG, PLWNET_N_DTN, PTHRMA_TA, PTHRMB_TA, &
+ PTHRMA_TC, PTHRMB_TC, PTHRMA_TG, PTHRMB_TG, PTHRMA_TV, &
+ PTHRMB_TV, PTHRMA_TN, PTHRMB_TN, PQSAT_G, PQSAT_V, &
+ PQSATI_N, PPSNA, PPSNCV, PFROZEN1,PLEG_DELTA, &
+ PLEGI_DELTA, PHUGI, PHVG, PHVN, PFLXC_CA, PFLXC_GV, &
+ PFLXC_VG_C, PFLXC_VN_C, PFLXC_GN, PFLXC_N_A, PFLXC_MOM, &
+ PFLXC_CV, PHVGS, PHVNS, PTG, PDQSAT_G, PDQSAT_V, &
+ PDQSATI_N, PTA_IC, PQA_IC, PDELTA_V, PDELTAT_G, &
+ PDELTAT_V, PDELTAT_N, PSW_UP, PSW_RAD, PLW_RAD, PLW_UP, &
+ PH_N_A, PEVAP_C_A, PEVAP_N_A, PLEG, PLEGI, PLES, PLEL, &
+ PEVAPN, PEMIS )
! ##########################################################################
!
!!**** *ISBA_FLXUES_MEB*
@@ -81,6 +65,11 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_PE_t, ISBA_P_t
+USE MODD_DIAG_n, ONLY : DIAG_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
+!
USE MODD_ISBA_PAR, ONLY : XEMISSOIL, XEMISVEG
USE MODD_CSTS, ONLY : XLVTT, XLSTT, XSTEFAN
!
@@ -91,17 +80,20 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(DIAG_t), INTENT(INOUT) :: DK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK
+!
!* 0.1 declarations of arguments
!
-REAL, DIMENSION(:), INTENT(IN) :: PRHOA
+REAL, DIMENSION(:), INTENT(IN) :: PRHOA, PLTT
! PRHOA = reference level air density (kg m-3)
+! PLTT = latent heat normalization factor (J kg-1)
!
-REAL, DIMENSION(:), INTENT(IN) :: PSWNET_V, PSWNET_G, PSWNET_N
-! PSWNET_G = Understory-ground net SW radiation explicit term (W m-2)
-! PSWNET_V = Vegetation canopy net SW radiation explicit term (W m-2)
-! PSWNET_N = Ground-based snow net SW radiation explicit term (W m-2)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PSIGMA_F, PSIGMA_FN, PEMIS_N
+REAL, DIMENSION(:), INTENT(IN) :: PSIGMA_F, PSIGMA_FN
!
REAL, DIMENSION(:), INTENT(IN) :: PLWNET_V_DTV, PLWNET_V_DTG, PLWNET_V_DTN
! PLWNET_V_DTV, PLWNET_V_DTG, PLWNET_V_DTN = Vegetation canopy net LW radiation
@@ -135,39 +127,29 @@ REAL, DIMENSION(:), INTENT(IN) :: PQSAT_G, PQSAT_V, PQSATI_N
! PQSAT_V = saturation specific humidity for the vegetation canopy (kg kg-1)
! PQSATI_N = saturation specific humidity over ice for the snowpack (kg kg-1)
!
-REAL, DIMENSION(:), INTENT(IN) :: PFF, PPSN, PPSNA, PPSNCV, PFROZEN1, PFFROZEN, PLSTT
-! PFF = total flooded fraction (-)
-! PPSN = fraction of snow on ground and understory vegetation (-)
+REAL, DIMENSION(:), INTENT(IN) :: PPSNA, PPSNCV, PFROZEN1
! PPSNA = fraction of vegetation canopy buried by ground-based snowpack (-)
! PPSNCV = fraction of vegetation canopy covered by intercepted snow (-)
! PFROZEN1 = frozen fraction of surface ground layer (-)
-! PFFROZEN = frozen fraction of flooded zone (-)
-! PLSTT = effecitve latent heat of sublimation (J/kg)
!
!
-REAL, DIMENSION(:), INTENT(IN) :: PLEG_DELTA, PLEGI_DELTA, PHUGI, PHUG, PHVG, PHVN
-! PHUG = relative humidity of the soil (-)
+REAL, DIMENSION(:), INTENT(IN) :: PLEG_DELTA, PLEGI_DELTA, PHUGI, PHVG, PHVN
+!
! PHVG = Halstead coefficient of non-buried (snow) canopy vegetation (-)
! PHVN = Halstead coefficient of paritally-buried (snow) canopy vegetation (-)
!
-REAL, DIMENSION(:), INTENT(IN) :: PFLXC_C_A, PFLXC_G_C, PFLXC_VG_C, PFLXC_VN_C, PFLXC_N_C, PFLXC_N_A, &
- PFLXC_V_C, PFLXC_MOM
-! PFLXC_C_A = Flux form heat transfer coefficient: canopy air to atmosphere (kg m-2 s-1)
-! PFLXC_G_C = As above, but for : ground-understory to canopy air (kg m-2 s-1)
+REAL, DIMENSION(:), INTENT(IN) :: PFLXC_CA, PFLXC_GV, PFLXC_VG_C, PFLXC_VN_C, PFLXC_GN, PFLXC_N_A, &
+ PFLXC_CV, PFLXC_MOM
+! PFLXC_CA = Flux form heat transfer coefficient: canopy air to atmosphere (kg m-2 s-1)
+! PFLXC_GV = As above, but for : ground-understory to canopy air (kg m-2 s-1)
! PFLXC_VG_C = As above, but for : non-snow buried canopy to canopy air (kg m-2 s-1)
! PFLXC_VN_C = As above, but for : partially snow-buried canopy air to canopy
! air (kg m-2 s-1)
-! PFLXC_V_C = As above, but for : bulk vegetation canopy to canopy air (kg m-2 s-1)
-! PFLXC_N_C = As above, but for : ground-based snow to atmosphere (kg m-2 s-1)
+! PFLXC_CV = As above, but for : bulk vegetation canopy to canopy air (kg m-2 s-1)
+! PFLXC_GN = As above, but for : ground-based snow to atmosphere (kg m-2 s-1)
! PFLXC_N_A = As above, but for : ground-based snow to canopy air (kg m-2 s-1)
! PFLXC_MOM = flux form drag transfer coefficient: canopy air to atmosphere (kg m-2 s-1)
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PTN
-! PTN = Ground-based snow temperature profile (K)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTV
-! PTV = Vegetation canopy temperature (K)
-!
REAL, DIMENSION(:,:), INTENT(IN) :: PTG
! PTG = Soil temperature profile (K)
!
@@ -185,9 +167,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PHVGS, PHVNS
! PHVNS = Dimensionless pseudo humidity factor for computing vapor
! fluxes from the partly-buried part of the canopy to the canopy air (-)
!
-REAL, DIMENSION(:), INTENT(IN) :: PTC, PQC, PTA_IC, PQA_IC
-! PTC = Canopy air space temperature (K)
-! PQC = Canopy air space specific humidity (kg kg-1)
+REAL, DIMENSION(:), INTENT(IN) :: PTA_IC, PQA_IC
! PTA_IC = Near-ground air temperature (K)
! PQA_IC = Near-ground air specific humidity (kg kg-1)
!
@@ -204,84 +184,45 @@ REAL, DIMENSION(:), INTENT(IN) :: PDELTAT_V, PDELTAT_N, PDELTAT_G
! PDELTAT_N = Time change in snowpack surface temperature (K)
! PDELTAT_G = Time change in soil surface temperature (K)
!
-REAL, DIMENSION(:), INTENT(INOUT):: PLWNET_V, PLWNET_G, PLWNET_N
-! PLWNET_G = Understory-ground net LW radiation implicit term output (W m-2)
-! PLWNET_V = Vegetation canopy net LW radiation implicit term output (W m-2)
-! PLWNET_N = Ground-based snow net LW radiation implicit term output (W m-2)
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PRNET_V, PRNET_G, PRNET_N
-! PRNET_G = Understory-ground net radiation (W m-2)
-! PRNET_V = Vegetation canopy net radiation (W m-2)
-! PRNET_N = Ground-based snow net radiation (W m-2)
+REAL, DIMENSION(:), INTENT(OUT) :: PRN_V, PRN_G
+! PRN_G = Understory-ground net radiation (W m-2)
+! PRN_V = Vegetation canopy net radiation (W m-2)
!
-REAL, DIMENSION(:), INTENT(OUT) :: PRNET, PLW_UP
-! PRNET = total net radiation of snow, understory and canopy (W m-2)
+REAL, DIMENSION(:), INTENT(OUT) :: PLW_UP
! PLW_UP = total net longwave upwelling radiation to the atmosphere (W m-2)
!
-REAL, DIMENSION(:), INTENT(OUT) :: PH_C_A, PH_V_C, PH_G_C, PH_N_C, PH_N, PH, PH_N_A
-! PH_C_A = Sensible heat flux: canopy air space to overlying atmosphere (W m-2)
-! PH_V_C = Sensible heat flux: vegetation canopy to canopy air space (W m-2)
-! PH_G_C = Sensible heat flux: understory (soil & vegetation) to canopy air space (W m-2)
-! PH_N_C = Sensible heat flux: ground based snowpack to canopy air space (W m-2)
-! PH_N = Sensible heat flux: ground based snowpack to both canopy air space and overlying atmosphere (W m-2)
-! PH = Sensible heat flux: total net sensible heat flux from surface to atmosphere (W m-2)
+REAL, DIMENSION(:), INTENT(OUT) :: PH_N_A
! PH_N_A = Sensible heat flux: ground based snowpack to overlying atmosphere (W m-2)
!
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_C_A, PLE_V_C, PLE_G_C, PLE_N_C
-! PLE_C_A = Latent heat flux: canopy air space to overlying atmosphere (W m-2)
-! PLE_V_C = Latent heat flux: vegetation canopy to canopy air space (W m-2)
-! PLE_G_C = Latent heat flux: understory (soil & vegetation) to canopy air space (W m-2)
-! PLE_N_C = Latent heat flux: ground based snowpack to canopy air space (W m-2)
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAP_C_A, PLEV_V_C, PEVAP_G_C, PEVAP_N_C, PEVAP_N_A, &
- PEVAP, PSUBL, PEVAPN
+REAL, DIMENSION(:), INTENT(OUT) :: PEVAP_C_A, PEVAP_N_A, PEVAPN
! PEVAP_C_A = Water flux: canopy air space to overlying atmosphere (kg m-2 s-1)
-! PLEV_V_C = Water flux: vegetation canopy to canopy air space (kg m-2 s-1)
-! PEVAP_G_C = Water flux: understory (soil & vegetation) to canopy air space (kg m-2 s-1)
-! PEVAP_N_C = Water flux: ground based snowpack to canopy air space (kg m-2 s-1)
! PEVAP_N_A = Water flux: ground based snowpack to overlying atmosphere (kg m-2 s-1)
-! PEVAP = Water flux: total net water flux from surface to atmosphere (kg m-2 s-1)
-! PSUBL = Water flux: total sublimation flux (kg/m2/s)
! PEVAPN = Water flux: ground based snowpack to both canopy air space and overlying atmosphere (kg m-2 s-1)
!
-REAL, DIMENSION(:), INTENT(OUT) :: PLETR_V_C, PLER_V_C, PLEG, PLEGI, PLE_FLOOD, &
- PLEI_FLOOD, PLES, PLEL, PLES_V_C, PLETR, PLEV, PLE, PLEI, PLER
-! PLETR_V_C = Latent heat flux: transpiration from the canopy (overstory) vegetation to canopy air (W m-2)
-! PLER_V_C = Latent heat flux: evaporation of intercepted water from the canopy (overstory) vegetation to canopy air (W m-2)
-! PLES_V_C = Latent heat flux: sublimation of canopy intercepted snowpack to canopy air (W m-2)
+REAL, DIMENSION(:), INTENT(OUT) :: PLEG, PLEGI, PLES, PLEL
! PLEG = Latent heat flux: baresoil evaporation (W m-2)
! PLEGI = Latent heat flux: baresoil sublimation (W m-2)
-! PLE_FLOOD = Latent heat flux: evaporation from flooded areas (W m-2)
-! PLEI_FLOOD = Latent heat flux: sublimation from ice-covered flooded areas (W m-2)
-! PLEL = Latent heat flux: net evaporation from ground-based snowpack to canopy air and overlying atmosphere (W m-2)
! PLES = Latent heat flux: net sublimation from ground-based snowpack to canopy air and overlying atmosphere (W m-2)
-! PLETR = Latent heat flux: net transpiration from understory and overstory (canopy) (W m-2)
-! PLEV = Latent heat flux: net evapotranspiration from understory and canopy vegetation (W m-2)
-! PLE = Latent heat flux: net evapotranspiration (W m-2)
-! PLEI = Latent heat flux: net sublimation (W m-2)
-! PLER = Latent heat flux: net evaporation from intercepted water from understory and canopy vegetation (W m-2)
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PTS_RAD, PEMIS
-! PTS_RAD = Net surface radiative temperature: computed using aggregated effective sfc emissivity
-! backed out from LWup: this is done to ensure cosistency between LWup, Ts_rad and effective sfc Emis (K)
+! PLEL = Latent heat flux: net evaporation from ground-based snowpack to canopy air and overlying atmosphere (W m-2)
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PEMIS
! PEMIS = effective (aggregated) net surface emissivity (-)
!
!
!* 0.2 declarations of local variables
!
!
-REAL, DIMENSION(SIZE(PTV)) :: ZFFF, ZWORK
-! ZFFF = working variables to help distinguish between soil and snow hydrolology and intercepted water reservoirs (-)
+REAL, DIMENSION(SIZE(PEK%XTV(:))) :: ZWORK
! ZWORK = working array
!
-REAL, DIMENSION(SIZE(PTV)) :: ZSAIR, ZSAIRC
+REAL, DIMENSION(SIZE(PEK%XTV(:))) :: ZSAIR, ZSAIRC
! ZSAIR = atmospheric value of the therodynamic variable
! ZSAIRC = canopy air value of the therodynamic variable
!
-REAL, DIMENSION(SIZE(PTV)) :: ZEVAP_V_C
-! ZEVAP_V_C = Water flux: Evapotranspiration vapor flux from the vegetation canopy (kg m-2 s-1)
+REAL, DIMENSION(SIZE(PEK%XTV(:))) :: ZEVAP_CV
+! ZEVAP_CV = Water flux: Evapotranspiration vapor flux from the vegetation canopy (kg m-2 s-1)
!
-REAL, DIMENSION(SIZE(PTV)) :: ZQSATN_V, ZQSATIN_N, ZQSATN_G
+REAL, DIMENSION(SIZE(PEK%XTV(:))) :: ZQSATN_V, ZQSATIN_N, ZQSATN_G
! ZQSATN_V = saturation specific humidity (over water) for the vegetation canopy (kg kg-1)
! ZQSATIN_N = saturation specific humidity (over ice) for the snow (kg kg-1)
! NOTE that liquid water can only exist when the snowpack T=XTT in the model,
@@ -303,27 +244,26 @@ IF (LHOOK) CALL DR_HOOK('ISBA_FLUXES_MEB',0,ZHOOK_HANDLE)
!
! LWnet: transform from explicit to implicit (i.e. at time t+dt)
!
-PLWNET_V(:) = PLWNET_V(:) + PLWNET_V_DTV(:)*PDELTAT_V(:) &
- + PLWNET_V_DTG(:)*PDELTAT_G(:) &
- + PLWNET_V_DTN(:)*PDELTAT_N(:)
+DEK%XLWNET_V(:) = DEK%XLWNET_V(:) + PLWNET_V_DTV(:)*PDELTAT_V(:) &
+ + PLWNET_V_DTG(:)*PDELTAT_G(:) &
+ + PLWNET_V_DTN(:)*PDELTAT_N(:)
-PLWNET_G(:) = PLWNET_G(:) + PLWNET_G_DTV(:)*PDELTAT_V(:) &
- + PLWNET_G_DTG(:)*PDELTAT_G(:) &
- + PLWNET_G_DTN(:)*PDELTAT_N(:)
+DEK%XLWNET_G(:) = DEK%XLWNET_G(:) + PLWNET_G_DTV(:)*PDELTAT_V(:) &
+ + PLWNET_G_DTG(:)*PDELTAT_G(:) &
+ + PLWNET_G_DTN(:)*PDELTAT_N(:)
-PLWNET_N(:) = PLWNET_N(:) + PLWNET_N_DTV(:)*PDELTAT_V(:) &
- + PLWNET_N_DTG(:)*PDELTAT_G(:) &
- + PLWNET_N_DTN(:)*PDELTAT_N(:)
+DEK%XLWNET_N(:) = DEK%XLWNET_N(:) + PLWNET_N_DTV(:)*PDELTAT_V(:) &
+ + PLWNET_N_DTG(:)*PDELTAT_G(:) &
+ + PLWNET_N_DTN(:)*PDELTAT_N(:)
!
! LWup at t+dt
!
-PLW_UP(:) = PLW_RAD(:) - (PLWNET_V(:) + PLWNET_G(:) + PLWNET_N(:))
+PLW_UP(:) = PLW_RAD(:) - (DEK%XLWNET_V(:) + DEK%XLWNET_G(:) + DEK%XLWNET_N(:))
!
!
! Effective emissivity:
!
- CALL ISBA_EMIS_MEB(PPSN, PPSNA, PSIGMA_F, PSIGMA_FN, &
- PEMIS_N, PEMIS )
+ CALL ISBA_EMIS_MEB(PEK%XPSN, PPSNA, PSIGMA_F, PSIGMA_FN, PEK%TSNOW%EMIS, PEMIS )
!
! Now compute the effective radiative temperature while
! imposing the constraint:
@@ -336,21 +276,21 @@ PLW_UP(:) = PLW_RAD(:) - (PLWNET_V(:) + PLWNET_G(:) + PLWNET_N(:))
! the surface to the atmosphere. Solving the above equation for
! the radiative T gives:
!
-PTS_RAD(:) = ((PLW_UP(:) - PLW_RAD(:)*(1.0-PEMIS(:)))/(XSTEFAN*PEMIS(:)))**0.25
+DK%XTSRAD(:) = ((PLW_UP(:) - PLW_RAD(:)*(1.0-PEMIS(:)))/(XSTEFAN*PEMIS(:)))**0.25
!
!
! Rnet (t+dt)
!
-PRNET_V(:) = PSWNET_V(:) + PLWNET_V(:)
+PRN_V(:) = DEK%XSWNET_V(:) + DEK%XLWNET_V(:)
!
-PRNET_G(:) = PSWNET_G(:) + PLWNET_G(:)
+PRN_G(:) = DEK%XSWNET_G(:) + DEK%XLWNET_G(:)
!
-PRNET_N(:) = PSWNET_N(:) + PLWNET_N(:)
+DMK%XRNSNOW(:) = DEK%XSWNET_N(:) + DEK%XLWNET_N(:)
!
!
! total Rnet (t+dt):
!
-PRNET(:) = PRNET_G(:) + PRNET_V(:) + PRNET_N(:)
+DK%XRN(:) = PRN_G(:) + PRN_V(:) + DMK%XRNSNOW(:)
!
!
!* 2.a Implicit (Turbulent) Sensible Heat Fluxes
@@ -358,28 +298,28 @@ PRNET(:) = PRNET_G(:) + PRNET_V(:) + PRNET_N(:)
! First get input thermo variable (could be enthalpy (air heat capacity x potential temperature or dry static energy)
-ZSAIR(:) = PTHRMB_TA(:) + PTHRMA_TA(:) *PTA_IC(:)
-ZSAIRC(:) = PTHRMB_TC(:) + PTHRMA_TC(:) *PTC(:)
+ZSAIR(:) = PTHRMB_TA(:) + PTHRMA_TA(:)*PTA_IC(:)
+ZSAIRC(:) = PTHRMB_TC(:) + PTHRMA_TC(:)*PEK%XTC(:)
! Sensible heat fluxes (W m-2):
! - Canopy air to atmosphere, vegetation canopy to canopy air (implicitly includes from canopy intercepted snow),
! understory-ground to canopy air,
! ground-based snow to canopy air, ground-based snow to atmosphere:
-PH_C_A(:) = PFLXC_C_A(:) *( ZSAIRC(:) - ZSAIR(:) )*(1.0 - PPSN(:)*PPSNA(:))
-PH_V_C(:) = PFLXC_V_C(:) *( PTHRMB_TV(:) + PTHRMA_TV(:)*PTV(:) - ZSAIRC(:) )
-PH_G_C(:) = PFLXC_G_C(:) *( PTHRMB_TG(:) + PTHRMA_TG(:)*PTG(:,1) - ZSAIRC(:) )*(1.0-PPSN(:))
-PH_N_C(:) = PFLXC_N_C(:) *( PTHRMB_TN(:) + PTHRMA_TN(:)*PTN(:,1) - ZSAIRC(:) )* PPSN(:) *(1.0-PPSNA(:))
-PH_N_A(:) = PFLXC_N_A(:) *( PTHRMB_TN(:) + PTHRMA_TN(:)*PTN(:,1) - ZSAIR(:) )* PPSN(:) * PPSNA(:)
+DEK%XH_CA(:) = PFLXC_CA (:) *( ZSAIRC(:) - ZSAIR (:))*(1.0 - PEK%XPSN(:)*PPSNA(:))
+DEK%XH_CV(:) = PFLXC_CV (:) *( PTHRMB_TV(:) + PTHRMA_TV(:)*PEK%XTV(:) - ZSAIRC(:))
+DEK%XH_GV(:) = PFLXC_GV (:) *( PTHRMB_TG(:) + PTHRMA_TG(:)*PTG(:,1) - ZSAIRC(:))*(1.0 - PEK%XPSN(:))
+DEK%XH_GN(:) = PFLXC_GN (:) *( PTHRMB_TN(:) + PTHRMA_TN(:)*DMK%XSNOWTEMP(:,1) - ZSAIRC(:))* PEK%XPSN(:) *(1.0-PPSNA(:))
+PH_N_A (:) = PFLXC_N_A(:) *( PTHRMB_TN(:) + PTHRMA_TN(:)*DMK%XSNOWTEMP(:,1) - ZSAIR (:))* PEK%XPSN(:) * PPSNA(:)
! - Net sensible heat flux from ground-based snow (to the canopy and the atmosphere (from
! the buried-vegetation canopy fraction)) (W m-2)
-PH_N(:) = PH_N_C(:) + PH_N_A(:)
+DMK%XHSNOW(:) = DEK%XH_GN(:) + PH_N_A(:)
! FINAL sensible heat flux to the atmosphere (W m-2):
-PH(:) = PH_C_A(:) + PH_N_A(:)
+DK%XH(:) = DEK%XH_CA(:) + PH_N_A(:)
!
!* 2.b Implicit (Turbulent) Vapor and Latent Heat Fluxes
@@ -393,120 +333,113 @@ ZQSATN_G(:) = PQSAT_G(:) + PDQSAT_G(:) * PDELTAT_G(:)
ZQSATN_V(:) = PQSAT_V(:) + PDQSAT_V(:) * PDELTAT_V(:)
ZQSATIN_N(:) = PQSATI_N(:) + PDQSATI_N(:) * PDELTAT_N(:)
-! additional sfc diagnostics needed for soil and snow hydrolology and intercepted water reservoirs:
-
-ZFFF(:) = PFF(:)*( 1.0 - PFFROZEN(:)*(1.0 - (XLSTT/XLVTT)) )
-
! - Evaporation and Sublimation latent heat fluxes from the soil, respectively:
-! (kg m-2 s-1)
+! (W m-2)
-ZWORK(:) = (1.-PPSN(:)-ZFFF(:)) * PFLXC_G_C(:)
-
-PLEG(:) = ZWORK(:)*PLEG_DELTA(:) *( PHUG(:) *ZQSATN_G(:) - PQC(:) )*(1.-PFROZEN1(:))*XLVTT
-
-PLEGI(:) = ZWORK(:)*PLEGI_DELTA(:)*( PHUGI(:)*ZQSATN_G(:) - PQC(:) )* PFROZEN1(:) *XLSTT
+ZWORK(:) = (1.-PEK%XPSN(:)-KK%XFF(:)) * PFLXC_GV(:)
+PLEG(:) = ZWORK(:)*PLEG_DELTA(:) *( DK%XHUG(:) *ZQSATN_G(:) - PEK%XQC(:) )*(1.-PFROZEN1(:))*XLVTT
+PLEGI(:) = ZWORK(:)*PLEGI_DELTA(:)*( PHUGI(:) *ZQSATN_G(:) - PEK%XQC(:) )* PFROZEN1(:) *XLSTT
! - Latent heat flux from frozen and unfrozen flooded zones (W m-2)
-ZWORK(:) = PFF(:) * PFLXC_G_C(:)*( ZQSATN_G(:) - PQC(:) )
-PLE_FLOOD(:) = ZWORK(:) * (1.-PFFROZEN(:))* XLVTT
-PLEI_FLOOD(:) = ZWORK(:) * PFFROZEN(:) * XLSTT
+ZWORK(:) = KK%XFF(:) * PFLXC_GV(:)*( ZQSATN_G(:) - PEK%XQC(:) )
+DEK%XLE_FLOOD(:) = ZWORK(:) * (1.-KK%XFFROZEN(:))* XLVTT
+DEK%XLEI_FLOOD(:) = ZWORK(:) * KK%XFFROZEN(:) * XLSTT
! - Evapotranspiration vapor flux from the vegetation canopy (kg m-2 s-1)
-ZEVAP_V_C(:) = (1.-PPSNCV(:)) * PHVGS(:) * PFLXC_V_C(:)*( ZQSATN_V(:) - PQC(:) )
+ZEVAP_CV(:) = (1.-PPSNCV(:)) * PHVGS(:) * PFLXC_CV(:)*( ZQSATN_V(:) - PEK%XQC(:) ) * (XLVTT/PLTT(:))
! - Latent heat flux from the canopy (liquid) water interception reservoir (W m-2)
-PLER_V_C(:) = ( (1.-PPSNA(:))*PPSN(:) * PFLXC_VN_C(:) + &
- (1.-PPSN(:))* PFLXC_VG_C(:) ) * &
- XLVTT * (1.-PPSNCV(:))* PDELTA_V(:) * ( ZQSATN_V(:) - PQC(:) )
+DEK%XLER_CV(:) = ( (1.-PPSNA(:))*PEK%XPSN(:) * PFLXC_VN_C(:) + &
+ (1.-PEK%XPSN(:))* PFLXC_VG_C(:) ) * &
+ XLVTT * (1.-PPSNCV(:))* PDELTA_V(:) * ( ZQSATN_V(:) - PEK%XQC(:) )
+!
+! - Total latent heat flux (evapotranspiration) from the vegetation to the canopy air space (W m-2)
+! *without* sublimation (for TOTAL evapotranspiration and sublimation, add PLESC here)
+DEK%XLEV_CV(:) = PLTT(:) * ZEVAP_CV(:)
+!
! - latent heat flux from transpiration from the canopy (W m-2)
-PLETR_V_C(:) = ZEVAP_V_C(:) * XLVTT - PLER_V_C(:)
+DEK%XLETR_CV(:) = DEK%XLEV_CV(:) - DEK%XLER_CV(:)
! Snow sublimation and evaporation latent heat flux from canopy-intercepted snow (W m-2)
-PLES_V_C(:) = PPSNCV(:) * XLSTT * PHVNS(:) * PFLXC_V_C(:)*( ZQSATN_V(:) - PQC(:) )
-
-! - Total latent heat flux (evapotranspiration) from the vegetation to the canopy air space (W m-2)
-! *without* sublimation (for TOTAL evapotranspiration and sublimation, add PLESC here)
-
-PLEV_V_C(:) = XLVTT*ZEVAP_V_C(:)
+DEK%XLES_CV(:) = PPSNCV(:) * XLSTT * PHVNS(:) * PFLXC_CV(:)*( ZQSATN_V(:) - PEK%XQC(:) )
! - Total latent heat flux from vegetation canopy overstory to canopy air space
! (including transpiration, liquid water store, canopy snow sublimation):
-PLE_V_C(:) = PLEV_V_C(:) + PLES_V_C(:)
+DEK%XLE_CV(:) = DEK%XLEV_CV(:) + DEK%XLES_CV(:)
! - Vapor flux from the ground-based snowpack to the canopy air (kg m-2 s-1):
-PEVAP_N_C(:) = PFLXC_N_C(:)*(ZQSATIN_N(:) - PQC(:))*PPSN(:)*(1.0-PPSNA(:))*(XLSTT/XLVTT)
-
-PLE_N_C(:) = XLVTT*PEVAP_N_C(:) ! W m-2
+ZWORK(:) = PFLXC_GN(:)*(ZQSATIN_N(:) - PEK%XQC(:))*PEK%XPSN(:)*(1.0-PPSNA(:))
+DEK%XEVAP_GN(:) = ZWORK(:)*(XLSTT/PLTT(:))
+DEK%XLE_GN(:) = ZWORK(:)* XLSTT ! W m-2
! - latent heat flux from transpiration from canopy veg (evapotranspiration)
-PLETR(:) = PLETR_V_C(:)
+DEK%XLETR(:) = DEK%XLETR_CV(:)
! Total latent heat flux from transpiration from understory veg and canopy veg (evapotranspiration and sublimation)
! and intercepted water on both reservoirs (W m-2)
-PLEV(:) = PLETR(:) + PLER_V_C(:)
+DEK%XLEV(:) = DEK%XLETR(:) + DEK%XLER_CV(:)
! Total latent heat flux from intercepted water (canopy and understory vegetation):
! (does not include intercepted snow sublimation): W m-2
-PLER(:) = PLER_V_C(:)
+DEK%XLER(:) = DEK%XLER_CV(:)
! - Vapor flux from the ground-based snowpack (part burying the canopy vegetation) to the atmosphere (kg m-2 s-1):
-PEVAP_N_A(:) = PFLXC_N_A(:) *( ZQSATIN_N(:) - PQA_IC(:))* PPSN(:)* PPSNA(:) *(XLSTT/XLVTT)
+ZWORK(:) = PFLXC_N_A(:) *( ZQSATIN_N(:) - PQA_IC(:))* PEK%XPSN(:)* PPSNA(:)
+PEVAP_N_A(:) = ZWORK(:) *(XLSTT/PLTT)
! - Net Snow (groud-based) sublimation latent heat flux (W m-2) to the canopy air space and the overlying atmosphere:
-
-PLES(:) = ( PFLXC_N_C(:) *( ZQSATIN_N(:) - PQC(:) )* PPSN(:)*(1.0-PPSNA(:)) + &
- PFLXC_N_A(:) *( ZQSATIN_N(:) - PQA_IC(:))* PPSN(:)* PPSNA(:) ) * XLSTT
+PLES(:) = ( PFLXC_GN(:) *( ZQSATIN_N(:) - PEK%XQC(:))* PEK%XPSN(:)*(1.0-PPSNA(:)) + ZWORK(:) ) * XLSTT
! - Net Snow evaporation (liquid water) latent heat flux (W m-2)
-PLEL(:) = XLVTT*(PEVAP_N_C(:) + PEVAP_N_A(:)) - PLES(:)
+PLEL(:) = PLTT(:)*(DEK%XEVAP_GN(:) + PEVAP_N_A(:)) - PLES(:)
! - Total mass flux from ground-based snowpack (kg m-2 s-1)
-PEVAPN(:) = (PLEL(:) + PLES(:))/XLVTT
+PEVAPN(:) = (PLEL(:) + PLES(:))/PLTT(:)
! - Total snow-free vapor flux from the understory (flooded areas, baresoil and understory vegetation)
! to the canopy air space (W m-2 and kg m-2 s-1, respectively):
-PLE_G_C(:) = PLE_FLOOD(:) + PLEI_FLOOD(:) + PLEGI(:) + PLEG(:)
+DEK%XLE_GV(:) = DEK%XLE_FLOOD(:) + DEK%XLEI_FLOOD(:) + PLEGI(:) + PLEG(:)
-PEVAP_G_C(:) = PLE_G_C(:)/XLVTT
+DEK%XEVAP_G(:) = DEK%XLE_GV(:)/PLTT(:)
! - Net vapor flux from canopy air to the atmosphere (kg m-2 s-1)
-PEVAP_C_A(:) = PFLXC_C_A(:) *( PQC(:) - PQA_IC(:))*(1.0 - PPSN(:)*PPSNA(:))
+PEVAP_C_A(:) = PFLXC_CA(:) *( PEK%XQC(:) - PQA_IC(:))*(1.0 - PEK%XPSN(:)*PPSNA(:))
-PLE_C_A(:) = XLVTT * PEVAP_C_A(:) ! W m-2
+DEK%XLE_CA(:) = PLTT(:) * PEVAP_C_A(:) ! W m-2
! FINAL net vapor flux from the surface to the Atmosphere:
! - Net vapor flux from canopy air and exposed ground based snow (from part of snow
! burying the vegetation canopy) to the atmosphere (kg m-2 s-1)
!
-PEVAP(:) = PEVAP_C_A(:) + PEVAP_N_A(:)
+DK%XEVAP(:) = PEVAP_C_A(:) + PEVAP_N_A(:)
!
! Total latent heat flux of surface/snow/vegetation: W m-2
!
-PLE(:) = PEVAP(:)*XLVTT
+PEK%XLE(:) = DK%XEVAP(:)*PLTT(:)
!
! Total sublimation from the surface/snow/vegetation: W m-2
!
-PLEI(:) = PLES(:) + PLEGI(:) + PLEI_FLOOD(:)
+DK%XLEI(:) = PLES(:) + PLEGI(:) + DEK%XLEI_FLOOD(:)
!
! Total sublimation from the surface/snow/vegetation: kg m-2 s-1
!
-PSUBL(:) = PLEI(:)/PLSTT(:)
+DK%XSUBL(:) = DK%XLEI(:)/ PLTT(:)
!
IF (LHOOK) CALL DR_HOOK('ISBA_FLUXES_MEB',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/isba_lwnet_meb.F90 b/src/SURFEX/isba_lwnet_meb.F90
index 01beb4c97251cec6e07a25780cae1318c08b27df..be4f0c9327108944fbd307f826fda9eee2c76dcd 100644
--- a/src/SURFEX/isba_lwnet_meb.F90
+++ b/src/SURFEX/isba_lwnet_meb.F90
@@ -51,6 +51,8 @@
!! MODIFICATIONS
!! -------------
!! Original 22/01/11
+!! A. Boone 04/03/17 add factor to dLWnet_n/dT_n term to cause it to vanish
+!! under some extreme circumstances.
!!
!-------------------------------------------------------------------------------
!
@@ -111,6 +113,13 @@ REAL, DIMENSION(SIZE(PLAI)) :: ZLW_N_A, ZLW_N_B, ZLW_N_C, &
!
REAL, DIMENSION(SIZE(PEMIS_N)) :: ZEMIS_G
!
+!* 0.3 declarations of local parameters
+!
+REAL, PARAMETER :: ZTGRAD_MAX = 60. ! K When Tn-Tv approaches this difference, the derrivative term
+ ! dLWnet_n/dTn vanishes. See below for details.
+REAL, PARAMETER :: ZTGRAD_DIF = 10. ! K This is the range in Tn-Tv over which dLWnet_n/dTn
+ ! linearly vanishes. See below for details.
+!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
@@ -139,7 +148,7 @@ ZFRAC(:) = 1.-PPSN(:)
ZPN(:) = PPSN(:)*(1.-PPSNA(:))
ZSIGMA_FA(: ) = (1.-ZPN(:))*PSIGMA_F(:) + ZPN(:)*PSIGMA_FN(:)
- CALL LW_FLUX_COMP(ZPN,PLW_RAD,ZFRAC,PSIGMA_F,ZSIGMA_FA, &
+CALL LW_FLUX_COMP(ZPN,PLW_RAD,ZFRAC,PSIGMA_F,ZSIGMA_FA, &
ZEMIS_G,PTV,PTG, &
ZLW_G_A,ZLW_G_B,ZLW_G_C,ZLW_G_D,ZLW_G_E,ZLW_G_F, &
ZLW_G_G,ZLW_G_H,ZLW_G_I,ZLW_G_J,ZLW_G_K,ZLW_G_L )
@@ -150,7 +159,7 @@ ZFRAC(:) = PPSN(:)
ZPN(:) = PPSN(:) + PPSNA(:)*(1.-PPSN(:))
ZSIGMA_FA(: ) = (1.-ZPN(:))*PSIGMA_F(:) + ZPN(:)*PSIGMA_FN(:)
- CALL LW_FLUX_COMP(ZPN,PLW_RAD,ZFRAC,PSIGMA_FN,ZSIGMA_FA, &
+CALL LW_FLUX_COMP(ZPN,PLW_RAD,ZFRAC,PSIGMA_FN,ZSIGMA_FA, &
PEMIS_N,PTV,PTN, &
ZLW_N_A,ZLW_N_B,ZLW_N_C,ZLW_N_D,ZLW_N_E,ZLW_N_F, &
ZLW_N_G,ZLW_N_H,ZLW_N_I,ZLW_N_J,ZLW_N_K,ZLW_N_L )
@@ -182,7 +191,20 @@ PLWNET_G_DTN(:) = ZLW_N_J(:) *4/PTN(:)
PLWNET_N_DTV(:) = ( ZLW_N_F(:) - ZLW_N_G(:) )*4/PTV(:)
PLWNET_N_DTG(:) = ZLW_G_K(:) *4/PTG(:)
-PLWNET_N_DTN(:) = ( ZLW_N_J(:) - ZLW_N_I(:) )*4/PTN(:)
+PLWNET_N_DTN(:) = ( ZLW_N_K(:) - ZLW_N_I(:) )*4/PTN(:)
+!
+! Note that for very thin snow combined with extremely cold
+! conditions, very weak LWdown forcing and strong Tn-Tc differences,
+! the derrivative of Lwnet_n/dT_n can pose problems (i.e. the assumption of
+! a linear change over the given time step is a poor approximation),
+! thus in these rare instances, this derrivative is forced
+! to vanish (over some small temperature difference range). This has no impact
+! on numerical stability (since the LW linerization has no effect on this) and has
+! no impact on results in the general sense (since it is temporary and the assumed gradieints
+! are so large that they are rarely, if ever during a run, encountered).
+! Use PTV as a proxy for air T (under these conditions, it should be close to PTC for example)
+
+PLWNET_N_DTN(:) = PLWNET_N_DTN(:)*MIN(1., MAX(0., ZTGRAD_MAX-MAX(0.,PTN(:)-PTV(:)))/ZTGRAD_DIF)
!------------------------------------------------------------------
! - Compute *explicit* net budgets (at time t): W m-2
@@ -207,7 +229,7 @@ PLWNET_V(:) = PLW_RAD(:) - ZLWUP(:) - PLWNET_G(:) - PLWNET_N(:)
IF (LHOOK) CALL DR_HOOK('ISBA_LWNET_MEB',1,ZHOOK_HANDLE)
- CONTAINS
+CONTAINS
!=========================================================
SUBROUTINE LW_FLUX_COMP(PPN,PLW_RAD,PFRAC,PSIGMA_F,PSIGMA_FA, &
PEMIS_S,PTV,PTEMP_S, &
diff --git a/src/SURFEX/isba_meb.F90 b/src/SURFEX/isba_meb.F90
index 3323079521ada806b348ff31d588e5380f911e97..b65e812144403fe76033fc35e46dfddd504b5937 100644
--- a/src/SURFEX/isba_meb.F90
+++ b/src/SURFEX/isba_meb.F90
@@ -3,56 +3,21 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE ISBA_MEB(TPTIME, OMEB, OMEB_LITTER, OMEB_GNDRES, PGNDLITTER, &
- OFORC_MEASURE, OGLACIER, &
- OTR_ML, OAGRI_TO_GRASS, OSHADE, OSTRESSDEF, &
- OSNOWDRIFT, OSNOWDRIFT_SUBLIM, OSNOW_ABS_ZENITH, OIRRIGATE, OIRRIDAY, &
- HSNOWMETAMO, HSNOWRAD, HPHOTO, &
- HISBA, HCPSURF, HRAIN, HSNOW_ISBA, HSNOWRES, HIMPLICIT_WIND, &
- KWG_LAYER, PTSTEP, PVEGTYPE, PLAT, PLON, &
- PTHRESHOLD, PWATSUP, PIRRIG, PIRRIG_FLUX, &
- PSOILHCAPZ, PSOILCONDZ, PFROZEN1, &
- PPS, PZENITH, PSCA_SW, PSW_RAD, PVMOD, PRR, PSR, PRHOA, PTA, PQA, &
- PH_VEG, PDIRCOSZW, &
- PEXNS, PEXNA, PPET_A_COEF, PPET_B_COEF, PPEQ_A_COEF, PPEQ_B_COEF, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PZREF, PUREF, PCH, PCD, PCDN, PRI, PRESA, PHUG, PHV, PHU, PQS, &
- PZ0G_WITHOUT_SNOW, &
- PZ0_MEBV, PZ0H_MEBV, PZ0EFF_MEBV, &
- PZ0_MEBN, PZ0H_MEBN, PZ0EFF_MEBN, &
- PZ0_WITH_SNOW, PZ0H_WITH_SNOW, PZ0EFF, &
- PTV, PTL, PTG, PTC, PQC, PWR, PWRL, PWRLI, PWRVN, PWG, PWGI, &
- PWRMAX_CF, PRGL, PRSMIN, PGAMMA, PRS, &
- PALBNIR_TVEG, PALBVIS_TVEG,PALBNIR_TSOIL, PALBVIS_TSOIL, PFALB, &
- PSNOWALB, PSNOWALBVIS, PSNOWALBNIR, PSNOWALBFIR, &
- PABC, PFAPARC, PFAPIRC, PMUS, PLAI_EFFC, &
- PIACAN, PFAPAR, PFAPIR, PFAPAR_BS, PFAPIR_BS, &
- PAH, PBH, PF2I, PDMAX, PPOI, PCSP, PFZERO, PEPSO, &
- PGAMM, PQDGAMM, PGMES, PGC, PQDGMES, PT1GMES, PT2GMES, &
- PAMAX, PQDAMAX, PT1AMAX, PT2AMAX, &
- PAN, PANDAY, PANFM, PGPP, PANF, PRESP_BIOMASS_INST, &
- PFF, PPSN, PPALPHAN, PLAI, PF2, &
- PWSAT, PWFC, &
- PSNOWGRAN1, PSNOWGRAN2, PSNOWHIST,PSNOWAGE, &
- PSNOWRHO, PSNOWSWE, PSNOWHEAT, PSNOWTEMP, PSNOWDZ, PSNOWLIQ, PFEMIS, &
- PSWNET_N, PSWNET_V, PSWNET_G, PSWNET_NS, PALBT, PSWDOWN_GN, &
- PLW_RAD, PLWNET_N, PLWNET_V, PLWNET_G, PLWDOWN_GN, &
- PLEV_V_C, PLES_V_C, PH_V_C, PH_G_C, PLETR_V_C, PLER_V_C, PH_C_A, &
- PH_N_C, PLE_V_C, PLE_G_C, PLE_C_A, PLE_N_C, PEVAP_N_C, PEVAP_G_C, &
- PSR_GN, PMELTCV, PFRZCV, PMELTADV, &
- PLE_FLOOD, PLEI_FLOOD, &
- PLE, PH, PRN, PLEI, PLEGI, PLEG,PLELITTERI,PLELITTER,PDRIPLIT,PRRLIT, &
- PLEV, PLER, PLETR, PEVAP, PLES, PLESL, &
- PSUBL, PRESTORE, PGRNDFLUX, PFLSN_COR, PUSTAR, &
- PHPSNOW, PSNOWHMASS, PRNSNOW, PHSNOW, PGFLUXSNOW, &
- PUSTARSNOW, PSRSFC, PRRSFC, PEMISNOW, PCDSNOW, PCHSNOW, &
- PEMIST, PTS_RAD, PHU_AGG, PAC_AGG, &
- PDELHEATV_SFC, PDELHEATG_SFC, PDELHEATG, &
- PDELHEATN, PDELHEATN_SFC, PRESTOREN, &
- PD_G, PDZG, PCPS, PLVTT, PLSTT, PCT, PCV, PCG, PFFROZEN, &
- PTDEEP_A, PTDEEP_B, PDEEP_FLUX, PMUF, PDRIP, PRRVEG, &
- PRISNOW, PSNOW_THRUFAL, PSNOW_THRUFAL_SOIL, PEVAPCOR, PSUBVCOR,PLITCOR,&
- PSNOWSFCH, PSNDRIFT, PQSNOW )
+ SUBROUTINE ISBA_MEB(IO, KK, PK, PEK, DK, DEK, DMK, G, AG, &
+ TPTIME, OMEB, OSHADE, HIMPLICIT_WIND, PTSTEP, &
+ PSOILHCAPZ, PSOILCONDZ, PFROZEN1, PPS, PZENITH, &
+ PSCA_SW, PSW_RAD, PVMOD, PRR, PSR, PRHOA, PTA, PQA, &
+ PDIRCOSZW, PEXNS, PEXNA, PPET_A_COEF, PPET_B_COEF, &
+ PPEQ_A_COEF, PPEQ_B_COEF, PPEW_A_COEF, PPEW_B_COEF, &
+ PZREF, PUREF, PZ0G_WITHOUT_SNOW, PZ0_MEBV, PZ0H_MEBV, &
+ PZ0EFF_MEBV, PZ0_MEBN, PZ0H_MEBN, PZ0EFF_MEBN, &
+ PALBNIR_TVEG, PALBVIS_TVEG, PALBNIR_TSOIL, PALBVIS_TSOIL, &
+ PABC, PIACAN, PPOI, PCSP, PRESP_BIOMASS_INST, PPALPHAN, &
+ PF2, PLW_RAD, PGRNDFLUX, PFLSN_COR, PUSTAR, PEMIST, &
+ PHU_AGG, PAC_AGG, PDELHEATV_SFC, PDELHEATG_SFC, PDELHEATG,&
+ PDELHEATN, PDELHEATN_SFC, PRESTOREN, PTDEEP_A, PDEEP_FLUX,&
+ PRISNOW, PSNOW_THRUFAL, PSNOW_THRUFAL_SOIL, PEVAPCOR, &
+ PSUBVCOR, PLITCOR, PSNOWSFCH, PQSNOW)
! ##########################################################################
!
!
@@ -65,9 +30,9 @@
! with an explicit vegetation layer
!
! NOTE...currently MEB can be coupled with
-! HISBA='DIF' or '3-L' soil options
+! IO%CISBA='DIF' or '3-L' soil options
! HSNOW='3-L' snow scheme
-! Soon, HSNOW=CRO and HPHOTO/=NON (i.e. Ags will be added)
+! Soon, HSNOW=CRO and IO%CPHOTO/=NON (i.e. Ags will be added)
!
!!** METHOD
!! ------
@@ -93,16 +58,27 @@
!! -------------
!! Original 10/2014
!! (A. Napoly) 09/2015 Add Litter layer option code
+!! (A. Boone) 02/2017 Owing to fix to FAPAIR.F90 routine (called by
+!! RAIDATIVE_TRANSFERT.F90 herein), edited slightly
+!! SWnet computations to be compatible.
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_AGRI_n, ONLY : AGRI_t
+USE MODD_DIAG_n, ONLY : DIAG_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
+!
USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_CSTS, ONLY : XCPD, XDAY, XRHOLW
+USE MODD_CSTS, ONLY : XCPD, XDAY, XRHOLW, XLVTT, XLSTT
USE MODD_MEB_PAR, ONLY : XSW_WGHT_VIS, XSW_WGHT_NIR
-USE MODD_ISBA_PAR, ONLY : XRS_MAX
+USE MODD_ISBA_PAR, ONLY : XRS_MAX, XLIMH
USE MODD_DATA_COVER_PAR, ONLY : NVT_SNOW
!
USE MODD_TYPE_DATE_SURF, ONLY : DATE_TIME
@@ -137,73 +113,26 @@ IMPLICIT NONE
!* general variables
! -----------------
!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(GRID_t), INTENT(INOUT) :: G
+TYPE(AGRI_t), INTENT(INOUT) :: AG
+TYPE(DIAG_t), INTENT(INOUT) :: DK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK
+!
TYPE(DATE_TIME), INTENT(IN) :: TPTIME ! current date and time
!
LOGICAL, INTENT(IN) :: OMEB ! True = patch with multi-energy balance
! ! False = patch with classical ISBA
-LOGICAL, INTENT(IN) :: OMEB_LITTER ! Flag for litter
-LOGICAL, INTENT(IN) :: OMEB_GNDRES ! Flag for ground resistance
-LOGICAL, INTENT(IN) :: OFORC_MEASURE ! switch for using measured data (drag scheme)
-LOGICAL, INTENT(IN) :: OGLACIER ! True = Over permanent snow and ice,
-! ! initialise WGI=WSAT,
-! ! Hsnow>=10m and allow 0.8<SNOALB<0.85
-! ! False = No specific treatment
-LOGICAL, INTENT(IN) :: OSNOWDRIFT ! if=T, activate snowdrift
-LOGICAL, INTENT(IN) :: OSNOWDRIFT_SUBLIM ! if=T, activate snowdrift sublimation
-LOGICAL, INTENT(IN) :: OSNOW_ABS_ZENITH ! if=T, activate parametrization of solar absorption
-! ! for polar regions
-LOGICAL, INTENT(IN) :: OTR_ML ! Multi-layer SW radiative transfer option (NOTE =T for MEB)
-LOGICAL, INTENT(IN) :: OAGRI_TO_GRASS! Used in Multi-layer SW radiative transfer option
-LOGICAL, DIMENSION(:),INTENT(IN) :: OIRRIGATE ! Irrigation FLAG
-LOGICAL, DIMENSION(:),INTENT(IN) :: OSTRESSDEF ! Ags: vegetation response type to water
-! ! stress (true:defensive false:offensive)
LOGICAL, DIMENSION(:),INTENT(INOUT) :: OSHADE ! where vegetation evolution occurs
-LOGICAL, DIMENSION(:),INTENT(INOUT) :: OIRRIDAY ! Irrigation time
-!
- CHARACTER(LEN=*), INTENT(IN) :: HISBA ! type of ISBA version:
-! ! '2-L' (default)
-! ! '3-L'
-! ! 'DIF'
- CHARACTER(LEN=*), INTENT(IN) :: HCPSURF ! Specific heat
-! ! 'DRY' = dry Cp
-! ! 'HUM' = humid Cp fct of qs
- CHARACTER(LEN=*), INTENT(IN) :: HRAIN ! Rainfall spatial distribution
- ! 'DEF' = No rainfall spatial distribution
- ! 'SGH' = Rainfall exponential spatial distribution
- CHARACTER(LEN=*), INTENT(IN) :: HSNOW_ISBA ! 'DEF' = Default F-R snow scheme
-! ! (Douville et al. 1995)
-! ! '3-L' = 3-L snow scheme (option)
-! ! (Boone and Etchevers 2000)
- CHARACTER(LEN=*), INTENT(IN) :: HSNOWRES ! 'DEF' = Default: Louis (ISBA)
-! ! 'RIL' = CROCUS (Martin) method
-! ! ISBA-SNOW3L turbulant exchange option
- CHARACTER(LEN=*), INTENT(IN) :: HIMPLICIT_WIND! wind implicitation option
+CHARACTER(LEN=*), INTENT(IN) :: HIMPLICIT_WIND! wind implicitation option
! ! 'OLD' = direct
! ! 'NEW' = Taylor serie, order 1
- CHARACTER(LEN=*), INTENT(IN) :: HSNOWMETAMO ! Crocus metamorphism scheme:
-! ! HSNOWMETAMO = B92 Brun et al 1992
-! ! HSNOWMETAMO = C13 Carmagnola et al 2014
-! ! HSNOWMETAMO = T07 Taillandier et al 2007
-! ! HSNOWMETAMO = F06 Flanner et al 2006
- CHARACTER(LEN=*), INTENT(IN) :: HSNOWRAD ! Crocus radiative transfer scheme:
-! ! HSNOWMETAMO = B92 Brun et al 1992
-! ! HSNOWMETAMO = TAR TARTES (Libois et al 2013)
-! ! HSNOWMETAMO = TA1 TARTES with constant impurities
-! ! HSNOWMETAMO = TA2 TARTES with constant impurities as a
-! ! function of ageing
- CHARACTER(LEN=*), INTENT(IN) :: HPHOTO ! Kind of photosynthesis;
-! ! 'NON' NOTE: this option currently supported (Jarvis)
-! ! 'AGS'
-! ! 'LAI'
-! ! 'AST' NOTE: this option currently supported (ISBA-Ags)
-! ! 'LST'
-!
-INTEGER, DIMENSION(:),INTENT(IN) :: KWG_LAYER ! Number of soil moisture layers (DIF option)
-!
REAL, INTENT(IN) :: PTSTEP ! Model time step (s)
-REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE ! fraction of each vegetation (-)
-REAL, DIMENSION(:), INTENT(IN) :: PLAT ! Latitude (degrees North)
-REAL, DIMENSION(:), INTENT(IN) :: PLON ! Longitude (degrees East)
+!
REAL, DIMENSION(:), INTENT(IN) :: PPS ! Pressure [Pa]
REAL, DIMENSION(:), INTENT(IN) :: PZENITH ! solar zenith angle
REAL, DIMENSION(:), INTENT(IN) :: PSW_RAD ! solar (shortwave) incoming radiation [W/m2]
@@ -218,7 +147,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PVMOD ! modulus of the wind
! ! parallel to the orography (m/s)
REAL, DIMENSION(:), INTENT(IN) :: PTA ! Temperature of atmosphere (K)
REAL, DIMENSION(:), INTENT(IN) :: PQA ! specific humidity of atmosphere (kg/kg)
-REAL, DIMENSION(:), INTENT(IN) :: PH_VEG ! height of vegetation
REAL, DIMENSION(:), INTENT(IN) :: PZREF ! normal distance of the first
! ! atmospheric level to the
! ! orography (m)
@@ -233,18 +161,8 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PSOILHCAPZ ! ISBA-DF Soil heat capacit
REAL, DIMENSION(:,:), INTENT(IN) :: PSOILCONDZ ! ISBA-DF Soil conductivity
! ! profile [W/(m K)]
REAL, DIMENSION(:), INTENT(IN) :: PFROZEN1 ! surface frozen fraction (-)
-REAL, DIMENSION(:), INTENT(IN) :: PLAI ! vegetation Leaf Area Index (m2/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PGNDLITTER ! litter thickness (MEB option) (m).
-REAL, DIMENSION(:), INTENT(IN) :: PRGL ! maximum solar radiation
-! ! usable in photosynthesis
-REAL, DIMENSION(:), INTENT(IN) :: PRSMIN ! minimum stomatal resistance (s/m)
-REAL, DIMENSION(:), INTENT(IN) :: PGAMMA ! coefficient for the calculation
-! ! of the surface stomatal resistance
-REAL, DIMENSION(:), INTENT(IN) :: PFF ! Floodplain fraction at the surface
-REAL, DIMENSION(:), INTENT(IN) :: PPSN ! fraction of the grid covered
-! ! by snow
+!
REAL, DIMENSION(:), INTENT(IN) :: PPALPHAN ! snow/canopy transition coefficient
-REAL, DIMENSION(:), INTENT(IN) :: PFALB ! Floodplain albedo
REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_TVEG ! albedo of vegetation in NIR
! ! (needed for LM_TR or MEB)
REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_TVEG ! albedo of vegetation in VIS
@@ -252,13 +170,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_TVEG ! albedo of vegetation in V
REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_TSOIL ! albedo of bare soil in NIR
! ! (needed for LM_TR or MEB)
REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_TSOIL ! albedo of bare soil in VIS
-REAL, DIMENSION(:), INTENT(IN) :: PWRMAX_CF ! maximum vegetation interception storage (kg/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PFEMIS ! Floodplain emissivity (-)
REAL, DIMENSION(:), INTENT(IN) :: PF2 ! Soil water stress factor for transpiration (-)
-REAL, DIMENSION(:,:), INTENT(IN) :: PWFC ! field capacity profile (m3/m3)
-REAL, DIMENSION(:,:), INTENT(IN) :: PWSAT ! porosity profile (m3/m3)
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PWG, PWGI ! PWG = soil liquid volumetric water content (m3/m3)
-! ! PWGI = soil frozen volumetric water content (m3/m3)
REAL, DIMENSION(:), INTENT(IN) :: PZ0G_WITHOUT_SNOW ! roughness length for momentum at snow-free canopy floor (m)
REAL, DIMENSION(:), INTENT(IN) :: PZ0_MEBV ! roughness length for momentum over MEB vegetation part of patch (m)
REAL, DIMENSION(:), INTENT(IN) :: PZ0H_MEBV ! roughness length for heat over MEB vegetation part of path (m)
@@ -266,18 +178,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PZ0EFF_MEBV ! roughness length for mome
REAL, DIMENSION(:), INTENT(IN) :: PZ0_MEBN ! roughness length for momentum over MEB snow part of patch (m)
REAL, DIMENSION(:), INTENT(IN) :: PZ0H_MEBN ! roughness length for heat over MEB snow part of path (m)
REAL, DIMENSION(:), INTENT(IN) :: PZ0EFF_MEBN ! roughness length for momentum over MEB snow part of patch (m)
-REAL, DIMENSION(:), INTENT(IN) :: PZ0_WITH_SNOW ! roughness length for momentum
-! ! (with snow taken into account) (m)
-REAL, DIMENSION(:), INTENT(IN) :: PZ0H_WITH_SNOW ! roughness length for heat
-! ! (with snow taken into account) (m)
-REAL, DIMENSION(:), INTENT(IN) :: PZ0EFF ! roughness length for momentum (m)
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_G ! Depth of Bottom of Soil layers (m)
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZG ! Thickness of Soil layers (m)
-REAL, DIMENSION(:), INTENT(IN) :: PCT ! area-averaged effective inverse heat capacity [(K m2)/J]
-REAL, DIMENSION(:), INTENT(IN) :: PCV ! vegetation inverse heat capacity [(K m2)/J]
-REAL, DIMENSION(:), INTENT(IN) :: PCG ! soil inverse heat capacity [(K m2)/J]
-REAL, DIMENSION(:), INTENT(IN) :: PFFROZEN ! Fraction of frozen flood (-)
-REAL, DIMENSION(:), INTENT(IN) :: PMUF ! fraction of the grid cell reached by the rainfall (-)
!
! implicit atmospheric coupling coefficients:
!
@@ -290,220 +190,30 @@ REAL, DIMENSION(:), INTENT(IN) :: PPET_A_COEF, PPET_B_COEF, &
! ! PPET_B_COEF B-air temperature coefficient
! ! PPEQ_A_COEF A-air specific humidity coefficient
! ! PPEQ_B_COEF B-air specific humidity coefficient
-REAL, DIMENSION(:), INTENT(IN) :: PTDEEP_A, PTDEEP_B ! Deep soil temperature boundary condition
+REAL, DIMENSION(:), INTENT(IN) :: PTDEEP_A ! Deep soil temperature boundary condition
! ! (prescribed)
! PTDEEP_A = Deep soil temperature
! coefficient depending on flux
-! PTDEEP_B = Deep soil temperature (prescribed)
-! which models heating/cooling from
-! below the diurnal wave penetration
-! (surface temperature) depth. If it
-! is FLAGGED as undefined, then the zero
-! flux lower BC is applied.
-! Tdeep = PTDEEP_B + PTDEEP_A * PDEEP_FLUX
-! (with PDEEP_FLUX in W/m2)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTHRESHOLD, PWATSUP, PIRRIG
-! PTHRESHOLD = threshold water level for irrigation (-)
-! PWATSUP = irrigation water need to maintain a given moisture thresold (kg/m2)
-! PIRRIG = irrigation mask (-)
!
! ISBA-Ags parameters
! (see also parameters with 'Ags:' in comments)
!
-REAL, DIMENSION(:), INTENT(IN) :: PGC ! cuticular conductance (m s-1)
-REAL, DIMENSION(:), INTENT(IN) :: PF2I ! critical normilized soil water
-! ! content for stress parameterisation
-REAL, DIMENSION(:), INTENT(IN) :: PDMAX ! maximum air saturation deficit
-! ! tolerate by vegetation
-REAL, DIMENSION(:), INTENT(IN) :: PAH,PBH ! coefficients for herbaceous water stress
-! ! response (offensive or defensive)
-!
REAL, DIMENSION(:), INTENT(IN) :: PCSP ! atmospheric CO2 concentration
! [ppmm]=[kg CO2 / kg air]
-REAL, DIMENSION(:), INTENT(IN) :: PGMES ! mesophyll conductance (m s-1)
-!
REAL, DIMENSION(:), INTENT(IN) :: PPOI ! Gaussian weights (as above)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PFZERO ! ideal value of F, no photo-
-! ! respiration or saturation deficit
-REAL, DIMENSION(:), INTENT(IN) :: PEPSO ! maximum initial quantum use
-! ! efficiency (mg J-1 PAR)
-REAL, DIMENSION(:), INTENT(IN) :: PGAMM ! CO2 conpensation concentration (ppmv)
-REAL, DIMENSION(:), INTENT(IN) :: PQDGAMM ! Log of Q10 function for CO2 conpensation
-! ! concentration
-REAL, DIMENSION(:), INTENT(IN) :: PQDGMES ! Log of Q10 function for mesophyll conductance
-REAL, DIMENSION(:), INTENT(IN) :: PT1GMES ! reference temperature for computing
-! ! compensation concentration function for
-! ! mesophyll conductance: minimum
-! ! temperature
-REAL, DIMENSION(:), INTENT(IN) :: PT2GMES ! reference temperature for computing
-! ! compensation concentration function for
-! ! mesophyll conductance: maximum
! ! temperature
-REAL, DIMENSION(:), INTENT(IN) :: PAMAX ! leaf photosynthetic capacity (kgCO2 m-2 s-1)
-REAL, DIMENSION(:), INTENT(IN) :: PQDAMAX ! Log of Q10 function for leaf photosynthetic capacity
-REAL, DIMENSION(:), INTENT(IN) :: PT1AMAX ! reference temperature for computing
-! ! compensation concentration function for leaf
-! ! photosynthetic capacity: minimum
-! ! temperature
-REAL, DIMENSION(:), INTENT(IN) :: PT2AMAX ! reference temperature for computing
-! ! compensation concentration function for leaf
-! ! photosynthetic capacity: maximum
-! ! temperature
-!
! - - - - - - - - - - - - - - - - - - - -
!
-REAL, DIMENSION(:), INTENT(INOUT) :: PSNOWALB ! Snow albedo
-REAL, DIMENSION(:), INTENT(INOUT) :: PSNOWALBVIS ! Snow VIS albedo
-REAL, DIMENSION(:), INTENT(INOUT) :: PSNOWALBNIR ! Snow NIR albedo
-REAL, DIMENSION(:), INTENT(INOUT) :: PSNOWALBFIR ! Snow FIR albedo
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWSWE ! Snow model layer liquid water equivalent or
-! ! SWE (kg m-2)
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWHEAT ! Snow layer heat content (J/m3)
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWRHO ! Snow layer average density (kg/m3)
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWGRAN1 ! Snow grain parameter 1
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWGRAN2 ! Snow grain parameter 2
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWHIST ! Snow grain historical parameter
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWAGE ! Snow grain age
-! ! NOTE : methamorphism is only activated if the flag
-! ! OSNOW_METAMO=TRUE
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTG ! Soil layer average temperature (K)
-REAL, DIMENSION(:), INTENT(INOUT) :: PTV ! Canopy vegetation temperature (K)
-REAL, DIMENSION(:), INTENT(INOUT) :: PTL ! Litter temperature (K)
-REAL, DIMENSION(:), INTENT(INOUT) :: PTC ! Canopy air temperature [K]
-REAL, DIMENSION(:), INTENT(INOUT) :: PQC ! Canopy air specific humidity [kg/kg]
-REAL, DIMENSION(:), INTENT(INOUT) :: PWR ! liquid water retained on the foliage
-! ! of the canopy vegetation [kg/m2]
-REAL, DIMENSION(:), INTENT(INOUT) :: PWRL ! liquid water retained on the litter
-REAL, DIMENSION(:), INTENT(INOUT) :: PWRLI ! ice retained on the litter
-REAL, DIMENSION(:), INTENT(INOUT) :: PWRVN ! liquid water equiv of snow retained on the foliage
-! ! of the canopy vegetation [kg/m2]
-REAL, DIMENSION(:), INTENT(INOUT) :: PRESA ! aerodynamic resistance (s/m)
-REAL, DIMENSION(:), INTENT(INOUT) :: PLE ! total latent heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(INOUT) :: PLE_FLOOD ! Floodplains latent heat flux: liquid part [W/m2]
-REAL, DIMENSION(:), INTENT(INOUT) :: PLEI_FLOOD ! Floodplains latent heat flux: frozen part [W/m2]
-!
REAL, DIMENSION(:), INTENT(INOUT) :: PABC ! Ags: abscissa needed for integration
! ! of net assimilation and stomatal
! ! conductance over canopy depth
-REAL, DIMENSION(:), INTENT(INOUT) :: PFAPARC ! Fapar of vegetation (cumul)
-REAL, DIMENSION(:), INTENT(INOUT) :: PFAPIRC ! Fapir of vegetation (cumul)
-REAL, DIMENSION(:), INTENT(INOUT) :: PMUS
-REAL, DIMENSION(:), INTENT(INOUT) :: PLAI_EFFC ! Effective LAI (cumul)
-!
-! diagnostic variables for Carbon assimilation
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PANFM ! Ags: maximum leaf assimilation
-REAL, DIMENSION(:), INTENT(INOUT) :: PAN ! net CO2 assimilation
-REAL, DIMENSION(:), INTENT(INOUT) :: PANDAY ! daily net CO2 assimilation
-!
-! - - - - - - - - - - - - - - - - - - - -
-!
REAL, DIMENSION(:,:), INTENT(OUT) :: PIACAN ! PAR in the canopy at different gauss levels
-REAL, DIMENSION(:), INTENT(OUT) :: PFAPAR ! Fapar of vegetation
-REAL, DIMENSION(:), INTENT(OUT) :: PFAPIR ! Fapir of vegetation
-REAL, DIMENSION(:), INTENT(OUT) :: PFAPAR_BS ! Fapar of bare soil
-REAL, DIMENSION(:), INTENT(OUT) :: PFAPIR_BS ! Fapir of bare soil
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSNOWTEMP ! Snow layer average temperature (K)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSNOWDZ ! Snow layer thickness (m)
-REAL, DIMENSION(:), INTENT(OUT) :: PEMISNOW ! Snow surface emissivity (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PSWNET_N ! net snow shortwave radiation [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PSWNET_NS ! net snow shortwave radiation for
-! ! the *surface* snow layer
-REAL, DIMENSION(:), INTENT(OUT) :: PSWNET_V ! net vegetation canopy shortwave radiation
-! ! [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PSWNET_G ! net surface (ground) shortwave radiation [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PALBT ! total surface albedo
-REAL, DIMENSION(:), INTENT(OUT) :: PSWDOWN_GN ! total shortwave radiation transmitted through
- ! the vegetation canopy
-REAL, DIMENSION(:), INTENT(OUT) :: PLWNET_V ! net vegetation canopy longwave radiation [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PLWNET_G ! net ground longwave radiation [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PLWNET_N ! net snow longwave radiation [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PLWDOWN_GN ! total shortwave radiation transmitted through and emitted by
-! ! the canopy reaching the snowpack/ground (explicit part) [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PRS ! surface stomatal resistance (s/m)
-REAL, DIMENSION(:), INTENT(OUT) :: PCH ! drag coefficient for heat
-REAL, DIMENSION(:), INTENT(OUT) :: PCD ! drag coefficient for momentum
-REAL, DIMENSION(:), INTENT(OUT) :: PCDN ! neutral drag coefficient for momentum
-REAL, DIMENSION(:), INTENT(OUT) :: PRI ! Richardson number
-REAL, DIMENSION(:), INTENT(OUT) :: PHV ! Total effective Halstead coefficient
-REAL, DIMENSION(:), INTENT(OUT) :: PHU ! grid-area humidity of the soil
-REAL, DIMENSION(:), INTENT(OUT) :: PHUG ! ground relative humidity
-REAL, DIMENSION(:), INTENT(OUT) :: PQS ! surface humidity (kg/kg)
-REAL, DIMENSION(:), INTENT(OUT) :: PRN ! net radiation
-REAL, DIMENSION(:), INTENT(OUT) :: PH ! sensible heat flux
-REAL, DIMENSION(:), INTENT(OUT) :: PLEI ! sublimation latent heat flux
-REAL, DIMENSION(:), INTENT(OUT) :: PLEGI ! latent heat of sublimation over frozen soil
-REAL, DIMENSION(:), INTENT(OUT) :: PLEG ! latent heat of evaporation
-REAL, DIMENSION(:), INTENT(OUT) :: PLELITTERI ! litter evaporation of ice
-REAL, DIMENSION(:), INTENT(OUT) :: PLELITTER ! litter sublimation of liquid water
-REAL, DIMENSION(:), INTENT(OUT) :: PDRIPLIT ! drip from litter
-REAL, DIMENSION(:), INTENT(OUT) :: PRRLIT !
-! ! over the ground
-REAL, DIMENSION(:), INTENT(OUT) :: PLEV ! latent heat of evaporation
-! ! over the vegetation
-REAL, DIMENSION(:), INTENT(OUT) :: PLER ! latent heat of the fraction
-! ! delta of water retained on the
-! ! foliage of the vegetation
-REAL, DIMENSION(:), INTENT(OUT) :: PLETR ! evapotranspiration of the rest
-! ! of the vegetation
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAP ! total evaporative flux (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PLES ! sublimation from ground-based snowpack [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PLESL ! evaporation from ground-based snowpack [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PSUBL ! total sublimation flux soil/snow/vegtation interception (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PRESTORE ! surface restore flux for Force-Restore, diffusive flux between uppermost and second soil layers
! ! when using the DIF soil option (W/m2)
REAL, DIMENSION(:), INTENT(OUT) :: PUSTAR ! friction velocity
-REAL, DIMENSION(:), INTENT(OUT) :: PMELTADV ! advection heat flux from snowmelt (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PCPS ! heat capacity of air (J/kg/K)
-REAL, DIMENSION(:), INTENT(OUT) :: PLVTT ! latent heat of vaporization (J/kg)
-REAL, DIMENSION(:), INTENT(OUT) :: PLSTT ! latent heat of sublimation (J/kg)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEV_V_C ! MEB: total evapotranspiration (no sublim) from vegetation canopy overstory [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PLES_V_C ! MEB: total snow sublimation from vegetation canopy overstory [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PH_V_C ! MEB: sensible heat flux from vegetation canopy overstory [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PH_G_C ! MEB: sensible heat flux from ground [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PLETR_V_C ! MEB: transpiration from overstory canopy vegetation [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PLER_V_C ! MEB: interception evaporation from overstory canopy vegetation [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PH_C_A ! MEB: sensible heat flux from canopy air space to the atmosphere [W/m2]
- ! NOTE total sensible heat flux to the atmosphere also possibly
- ! includes a contribution from snow covering the canopy
-REAL, DIMENSION(:), INTENT(OUT) :: PH_N_C ! MEB: sensible heat flux from the snow on the ground [W/m2]
- ! NOTE total sensible heat flux from the snowpack
- ! possibly includes a contribution from snow covering the canopy
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_V_C ! MEB: latent heat flux from vegetation canopy overstory [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_G_C ! MEB: latent heat flux from ground [W/m2]
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_C_A ! MEB: latent heat flux from canopy air space to the atmosphere [W/m2]
- ! NOTE total latent heat flux to the atmosphere also possibly
- ! includes a contribution from snow covering the canopy
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_N_C ! MEB: latent heat flux from the snow on the ground [W/m2]
- ! NOTE total latent heat flux from the snowpack
- ! possibly includes a contribution from snow covering the canopy
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAP_N_C ! MEB: Total evap from snow on the ground to canopy air space [kg/m2/s]
-REAL, DIMENSION(:), INTENT(OUT) :: PEVAP_G_C ! MEB: Total evap from ground to canopy air space [kg/m2/s]
-REAL, DIMENSION(:), INTENT(OUT) :: PSR_GN ! MEB: total snow reaching the ground snow [kg/m2/s]
-REAL, DIMENSION(:), INTENT(OUT) :: PMELTCV ! MEB: snow melt rate from the overstory snow reservoir [kg/m2/s]
-REAL, DIMENSION(:), INTENT(OUT) :: PFRZCV ! MEB: snow refreeze rate from the overstory snow reservoir [kg/m2/s]
+!
REAL, DIMENSION(:), INTENT(OUT) :: PGRNDFLUX ! snow/soil-biomass interface flux (W/m2)
REAL, DIMENSION(:), INTENT(OUT) :: PFLSN_COR ! soil/snow interface correction flux to conserve energy (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PHPSNOW ! heat release from rainfall (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSNOWHMASS ! snow heat content change from mass changes (J/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PRNSNOW ! net radiative flux from snow (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PHSNOW ! sensible heat flux from snow (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUXSNOW ! net heat flux from snow (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PUSTARSNOW ! friction velocity
-REAL, DIMENSION(:), INTENT(OUT) :: PSRSFC ! Snow rate falling outside of snow
-! ! covered grid area [kg/(m2 s)]
-REAL, DIMENSION(:), INTENT(OUT) :: PRRSFC ! Rain rate falling outside of snow and flood
-! ! covered grid area [kg/(m2 s)]
-REAL, DIMENSION(:), INTENT(OUT) :: PCDSNOW ! drag coefficient for momentum over snow
-REAL, DIMENSION(:), INTENT(OUT) :: PCHSNOW ! drag coefficient for heat over snow
REAL, DIMENSION(:), INTENT(OUT) :: PEMIST ! total effective surface emissivity...LWUP = EMIST*TS_RAD**4 (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PTS_RAD ! effective radiative temperature
-! ! of the natural surface (K)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSNOWLIQ ! snow layer liquid water content (m)
REAL, DIMENSION(:), INTENT(OUT) :: PAC_AGG ! aggregated aerodynamic conductance
! for evaporative flux calculations
REAL, DIMENSION(:), INTENT(OUT) :: PHU_AGG ! aggregated relative humidity
@@ -513,12 +223,10 @@ REAL, DIMENSION(:), INTENT(OUT) :: PDELHEATG_SFC ! change in heat storage of
REAL, DIMENSION(:), INTENT(OUT) :: PDELHEATG ! change in heat storage of the entire soil column over the current time step (W/m2)
REAL, DIMENSION(:), INTENT(OUT) :: PRESTOREN ! conductive heat flux between the surface and sub-surface soil layers
! ! for the multi-layer snow schemes..for composite snow, it is
-! ! equal to PRESTORE (W/m2)
+! ! equal to DEK%XRESTORE (W/m2)
REAL, DIMENSION(:), INTENT(OUT) :: PDELHEATN ! change in heat storage of the entire snow column over the current time step (W/m2)
REAL, DIMENSION(:), INTENT(OUT) :: PDELHEATN_SFC ! change in heat storage of the surface snow layer over the current time step (W/m2)
REAL, DIMENSION(:), INTENT(OUT) :: PDEEP_FLUX ! Heat flux at bottom of ISBA (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PDRIP ! Water dripping from the vegetation canopy (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PRRVEG ! Water intercepted by the vegetation canopy (kg/m2/s)
REAL, DIMENSION(:), INTENT(OUT) :: PRISNOW ! Richarson number over ground-based snowpack (-)
REAL, DIMENSION(:), INTENT(OUT) :: PSNOW_THRUFAL ! rate that liquid water leaves (explicit) snow pack:
! ! ISBA-ES or CROCUS [kg/(m2 s)]
@@ -536,35 +244,34 @@ REAL, DIMENSION(:), INTENT(OUT) :: PLITCOR ! A possible ice mass corre
! ! removed from soil) (kg/m2/s)
REAL, DIMENSION(:), INTENT(OUT) :: PSNOWSFCH ! snow surface layer pseudo-heating term owing to
! ! changes in grid thickness (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PSNDRIFT ! blowing snow sublimation (kg/m2/s)
REAL, DIMENSION(:), INTENT(OUT) :: PQSNOW ! snow surface specific humidity (kg/kg)
-REAL, DIMENSION(:), INTENT(OUT) :: PIRRIG_FLUX ! (kg/m2/s) irrigation flux (water need)
!
! diagnostic variables for Carbon assimilation:
!
-REAL, DIMENSION(:), INTENT(OUT) :: PANF ! total assimilation over canopy
-REAL, DIMENSION(:), INTENT(OUT) :: PGPP ! Gross Primary Production
REAL, DIMENSION(:,:), INTENT(OUT) :: PRESP_BIOMASS_INST ! instantaneous biomass respiration (kgCO2/kgair m/s)
!
-!
!* 0.2 declarations of local variables
!
!
REAL, PARAMETER :: ZTSTEP_EB = 300. ! s Minimum time tstep required
! ! to time-split MEB energy budget
+REAL, PARAMETER :: ZSWRAD_MIN = 1.E-6! W/m2 Threshold SWdown for which Sun is up...approx
+ ! (No need to do nonsense SW computations during the night)
+!
INTEGER :: JTSPLIT_EB ! number of time splits
INTEGER :: JDT ! time split loop index
!
REAL :: ZTSTEP ! Local time split timestep (s)
REAL, DIMENSION(SIZE(PPS)) :: ZWORK,ZWORK2,ZWORK3,ZWORK4 ! Working variables [*]
-REAL, DIMENSION(SIZE(PSNOWSWE,1),SIZE(PSNOWSWE,2)) :: ZSNOWCOND ! snow thermal conductivity [W/(m K)]
-REAL, DIMENSION(SIZE(PSNOWSWE,1),SIZE(PSNOWSWE,2)) :: ZSNOWHCAP ! snow heat capacity [J/(m3 K)]
-REAL, DIMENSION(SIZE(PSNOWSWE,1),SIZE(PSNOWSWE,2)) :: ZSNOWRHO ! snow layer density (kg/m3)
-REAL, DIMENSION(SIZE(PSNOWSWE,1),SIZE(PSNOWSWE,2)) :: ZSNOWAGE ! snow layer grain age
-REAL, DIMENSION(SIZE(PSNOWSWE,1),SIZE(PSNOWSWE,2)) :: ZSNOWSWE ! snow layer liquid water equivalent (kg/m2)
-REAL, DIMENSION(SIZE(PSNOWSWE,1),SIZE(PSNOWSWE,2)) :: ZTAU_N ! snow rad transmission coef at layer base (-)
+REAL, DIMENSION(SIZE(PEK%TSNOW%WSNOW,1),SIZE(PEK%TSNOW%WSNOW,2)) :: ZSNOWCOND ! snow thermal conductivity [W/(m K)]
+REAL, DIMENSION(SIZE(PEK%TSNOW%WSNOW,1),SIZE(PEK%TSNOW%WSNOW,2)) :: ZSNOWHCAP ! snow heat capacity [J/(m3 K)]
+REAL, DIMENSION(SIZE(PEK%TSNOW%WSNOW,1),SIZE(PEK%TSNOW%WSNOW,2)) :: ZSNOWRHO ! snow layer density (kg/m3)
+REAL, DIMENSION(SIZE(PEK%TSNOW%WSNOW,1),SIZE(PEK%TSNOW%WSNOW,2)) :: ZSNOWAGE ! snow layer grain age
+REAL, DIMENSION(SIZE(PEK%TSNOW%WSNOW,1),SIZE(PEK%TSNOW%WSNOW,2)) :: ZSNOWSWE ! snow layer liquid water equivalent (kg/m2)
+REAL, DIMENSION(SIZE(PEK%TSNOW%WSNOW,1),SIZE(PEK%TSNOW%WSNOW,2)) :: ZSNOWLIQ ! snow layer liquid water (m)
+REAL, DIMENSION(SIZE(PEK%TSNOW%WSNOW,1),SIZE(PEK%TSNOW%WSNOW,2)) :: ZTAU_N ! snow rad transmission coef at layer base (-)
REAL, DIMENSION(SIZE(PPS)) :: ZCHIP !
-REAL, DIMENSION(SIZE(PPS)) :: ZALBG ! Effective ground albedo
+REAL, DIMENSION(SIZE(PPS)) :: ZALBS ! Effective surface (ground) albedo
REAL, DIMENSION(SIZE(PPS)) :: ZSIGMA_F ! LW transmission factor
REAL, DIMENSION(SIZE(PPS)) :: ZSIGMA_FN ! LW transmission factor - including buried (snow)
! ! vegetation effect
@@ -610,18 +317,18 @@ REAL, DIMENSION(SIZE(PPS)) :: ZLEG_DELTA ! soi
REAL, DIMENSION(SIZE(PPS)) :: ZLEGI_DELTA ! soil sublimation delta fn (-)
REAL, DIMENSION(SIZE(PPS)) :: ZHSGL ! surface halstead cofficient for bare soil (-)
REAL, DIMENSION(SIZE(PPS)) :: ZHSGF ! surface halstead cofficient for bare soil ice (-)
-REAL, DIMENSION(SIZE(PPS)) :: ZFLXC_C_A ! turb transfer coef between vegetation canopy air and atmosphere (kg/m2/s)
+REAL, DIMENSION(SIZE(PPS)) :: ZFLXC_CA ! turb transfer coef between vegetation canopy air and atmosphere (kg/m2/s)
REAL, DIMENSION(SIZE(PPS)) :: ZFLXC_N_A ! ...between the snow on the ground and atmosphere (kg/m2/s)
-REAL, DIMENSION(SIZE(PPS)) :: ZFLXC_G_C ! ...between snow-free ground and canopy air (kg/m2/s)
-REAL, DIMENSION(SIZE(PPS)) :: ZFLXC_N_C ! ...between snow on the ground and canopy air (kg/m2/s)
+REAL, DIMENSION(SIZE(PPS)) :: ZFLXC_GV ! ...between snow-free ground and canopy air (kg/m2/s)
+REAL, DIMENSION(SIZE(PPS)) :: ZFLXC_GN ! ...between snow on the ground and canopy air (kg/m2/s)
REAL, DIMENSION(SIZE(PPS)) :: ZFLXC_VG_C ! ...between vegetation canopy over snow-free ground and canopy air (kg/m2/s)
REAL, DIMENSION(SIZE(PPS)) :: ZFLXC_VN_C ! ...between vegetation canopy over the snow on the ground and canopy air (kg/m2/s)
-REAL, DIMENSION(SIZE(PPS)) :: ZFLXC_V_C ! ...between vegetation canopy and canopy air (kg/m2/s)
+REAL, DIMENSION(SIZE(PPS)) :: ZFLXC_CV ! ...between vegetation canopy and canopy air (kg/m2/s)
REAL, DIMENSION(SIZE(PPS)) :: ZFLXC_MOM ! Effective drag coefficient for momentum [kg/(m2 s)]
-REAL, DIMENSION(SIZE(PPS)) :: ZQSATG ! saturation specific humidity for PTG (ground surface: kg kg-1)
-REAL, DIMENSION(SIZE(PPS)) :: ZQSATV ! saturation specific humidity for PTV (vegetation canopy: kg kg-1)
-REAL, DIMENSION(SIZE(PPS)) :: ZQSATC ! saturation specific humidity for PTC (canopy air: kg kg-1)
-REAL, DIMENSION(SIZE(PPS)) :: ZQSATN ! saturation specific humidity for PSNOWTEMP (snow surface: kg kg-1)
+REAL, DIMENSION(SIZE(PPS)) :: ZQSATG ! saturation specific humidity for PEK%XTG (ground surface: kg kg-1)
+REAL, DIMENSION(SIZE(PPS)) :: ZQSATV ! saturation specific humidity for PEK%XTV (vegetation canopy: kg kg-1)
+REAL, DIMENSION(SIZE(PPS)) :: ZQSATC ! saturation specific humidity for PEK%XTC (canopy air: kg kg-1)
+REAL, DIMENSION(SIZE(PPS)) :: ZQSATN ! saturation specific humidity for DMK%XSNOWTEMP (snow surface: kg kg-1)
REAL, DIMENSION(SIZE(PPS)) :: ZDELTAVK ! canopy interception capacity fraction including K-factor (-)
REAL, DIMENSION(SIZE(PPS)) :: ZCHEATV ! Vegetation canopy *effective surface* heat capacity (J m-2 K-1)
REAL, DIMENSION(SIZE(PPS)) :: ZCHEATG ! Understory-ground *effective surface* heat capacity (J m-2 K-1)
@@ -657,8 +364,7 @@ REAL, DIMENSION(SIZE(PPS)) :: ZH_N_A ! Sen
REAL, DIMENSION(SIZE(PPS)) :: ZVEGFACT ! Fraction of canopy vegetation possibly receiving
! ! rainfall (-)
REAL, DIMENSION(SIZE(PPS)) :: ZRRSFC ! The sum of all non-intercepted rain and canopy drip (kg/m2/s)
-REAL, DIMENSION(SIZE(PPS)) :: ZRRSFCL ! The sum of all non-intercepted rain and drip from (kg/m2/s)
- ! litter
+REAL, DIMENSION(SIZE(PPS)) :: ZRRSFCL ! The sum of all non-intercepted rain and drip from litter (kg/m2/s)
REAL, DIMENSION(SIZE(PPS)) :: ZLES3L ! latent heat flux - sublimation of ice from the ground
! ! based snowpack (W/m2)
REAL, DIMENSION(SIZE(PPS)) :: ZLEL3L ! latent heat flux - evaporation of liquid water from the
@@ -689,6 +395,11 @@ REAL, DIMENSION(SIZE(PPS)) :: ZLAI ! Pot
REAL, DIMENSION(SIZE(PPS)) :: ZALBVIS_TSOIL ! average snow-free ground VIS albedo (soil plus flooded fraction)
REAL, DIMENSION(SIZE(PPS)) :: ZALBNIR_TSOIL ! average snow-free ground NIR albedo (soil plus flooded fraction)
REAL, DIMENSION(SIZE(PPS)) :: ZSWNET_S ! Net SW radiation at the surface (below canopy snow/ground/flooded zone)
+REAL, DIMENSION(SIZE(PPS)) :: ZLTT ! Average latent heat (normalization factor) (J/kg)
+REAL, DIMENSION(SIZE(PPS)) :: ZLSTTC ! Working coefficient to compute ZLTT: frozen part (-)
+REAL, DIMENSION(SIZE(PPS)) :: ZLVTTC ! Working coefficient to compute ZLTT: non-frozen part (-)
+REAL, DIMENSION(SIZE(PPS)) :: ZZREF
+REAL, DIMENSION(SIZE(PPS)) :: ZUREF
!
!
! - CPHOTO/=NON (Ags Option(s)):
@@ -708,15 +419,14 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZWSAT ! Tem
!
! Working sums for flux averaging over MEB time split
!
-REAL, DIMENSION(SIZE(PPS)) :: ZH_SUM, ZH_C_A_SUM, ZH_N_A_SUM, ZH_V_C_SUM, ZH_G_C_SUM, &
- ZH_N_C_SUM, ZHSNOW_SUM, ZHPSNOW_SUM
+REAL, DIMENSION(SIZE(PPS)) :: ZH_SUM, ZH_CA_SUM, ZH_N_A_SUM, ZH_CV_SUM, ZH_GV_SUM, &
+ ZH_GN_SUM, ZHSNOW_SUM, ZHPSNOW_SUM
REAL, DIMENSION(SIZE(PPS)) :: ZHU_AGG_SUM, ZAC_AGG_SUM
-REAL, DIMENSION(SIZE(PPS)) :: ZLE_SUM, ZLE_C_A_SUM, ZLE_V_C_SUM, ZLE_G_C_SUM, &
- ZLE_N_C_SUM, ZLETR_V_C_SUM, ZLEG_SUM,ZLEGI_SUM,ZLESFC_SUM,&
- ZLESFCI_SUM, &
- ZLER_V_C_SUM, ZLE_FLOOD_SUM, ZLEI_FLOOD_SUM, &
- ZLES_V_C_SUM, ZLETR_SUM, ZLER_SUM, ZLEV_SUM, &
+REAL, DIMENSION(SIZE(PPS)) :: ZLE_SUM, ZLE_CA_SUM, ZLE_CV_SUM, ZLE_GV_SUM, &
+ ZLE_GN_SUM, ZLETR_CV_SUM, ZLEG_SUM,ZLEGI_SUM,ZLESFC_SUM, &
+ ZLESFCI_SUM, ZLER_CV_SUM, ZLE_FLOOD_SUM, ZLEI_FLOOD_SUM, &
+ ZLES_CV_SUM, ZLETR_SUM, ZLER_SUM, ZLEV_SUM, &
ZLEI_SUM, ZLES3L_SUM, ZLEL3L_SUM, ZEVAP3L_SUM, &
ZUSTAR2_SUM, ZUSTAR2SNOW_SUM, ZCDSNOW_SUM, &
ZCHSNOW_SUM, ZRISNOW_SUM, ZEVAP_SUM
@@ -728,12 +438,15 @@ REAL, DIMENSION(SIZE(PPS)) :: ZSWNET_V_SUM, ZSWNET_G_SUM, ZSWNET_N_SUM, ZLWNET
ZLWUP_SUM
REAL, DIMENSION(SIZE(PPS)) :: ZDELHEATG_SFC_SUM, ZDELHEATV_SFC_SUM, ZDELHEATG_SUM
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL, DIMENSION(SIZE(PPS)) :: ZALBV, ZALBG, ZTR
+!
+REAL, DIMENSION(SIZE(PEK%XWR,1)) :: ZPHASEL ! Phase changement in litter (W/m2)
+REAL, DIMENSION(SIZE(PEK%XWR,1)) :: ZCTSFC
+REAL, DIMENSION(SIZE(PEK%XWR,1)) :: ZFROZEN1SFC
!
-INTEGER :: INI, INL, JJ, JL
-REAL, DIMENSION(SIZE(PWR)) :: ZPHASEL ! Phase changement in litter (W/m2)
-REAL, DIMENSION(SIZE(PWR)) :: ZCTSFC
-REAL, DIMENSION(SIZE(PFROZEN1)) :: ZFROZEN1SFC
+INTEGER :: INJ, INL, JJ, JL
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
!* 1.0 Preliminaries
@@ -741,38 +454,43 @@ REAL, DIMENSION(SIZE(PFROZEN1)) :: ZFROZEN1SFC
!
IF (LHOOK) CALL DR_HOOK('ISBA_MEB',0,ZHOOK_HANDLE)
!
+PIACAN(:,:) = 0.0
!
-PIACAN(:,:) = 0.
-PFAPAR(:) = 0.
-PFAPIR(:) = 0.
-PFAPAR_BS(:) = 0.
-PFAPIR_BS(:) = 0.
-PRRLIT(:) =0.0
-PDRIPLIT(:) =0.0
+DMK%XFAPAR(:) = 0.0
+DMK%XFAPIR(:) = 0.0
+DMK%XFAPAR_BS(:) = 0.0
+DMK%XFAPIR_BS(:) = 0.0
!
-PLEGI(:) = 0.
-PLEG(:) = 0.
-ZLESFCI(:)= 0.
-ZLESFC(:) = 0.
+DEK%XRRLIT(:) = 0.0
+DEK%XDRIPLIT(:) = 0.0
+!
+DEK%XLEGI(:) = 0.0
+DEK%XLEG(:) = 0.0
+!
+ZLESFCI(:) = 0.0
+ZLESFC(:) = 0.0
!
ZIACAN_SUNLIT(:,:) = XUNDEF
ZIACAN_SHADE(:,:) = XUNDEF
-ZFRAC_SUN (:,:) = XUNDEF
-ZLAI (:) = XUNDEF
+ZFRAC_SUN(:,:) = XUNDEF
+ZLAI(:) = XUNDEF
ZALBVIS_TSOIL(:) = XUNDEF
ZALBNIR_TSOIL(:) = XUNDEF
ZSWNET_S(:) = XUNDEF
ZQSAT(:) = XUNDEF
+!
ZWORK(:) = XUNDEF
ZWORK2(:) = XUNDEF
ZWORK3(:) = XUNDEF
ZWORK4(:) = XUNDEF
!
+ZTR(:) = 0.0
+!
!* 1.1 Preliminaries for litter parameters
! -----------------------------------
!
-INI=SIZE(PWG,1)
-INL=SIZE(PWG,2)
+INJ=SIZE(PEK%XWG,1)
+INL=SIZE(PEK%XWG,2)
!
CALL ALLOCATE_LOCAL_VARS_PREP_GRID_SOIL
!
@@ -781,32 +499,31 @@ INL=SIZE(PWG,2)
!* 1.2 Preliminaries for litter temperature
! ------------------------------------
!
-! Concatenate PTL and PTG and the parameters linked to heat transfer into the soil
+! Concatenate PEK%XTL and PEK%XTG and the parameters linked to heat transfer into the soil
!
- CALL PREP_MEB_SOIL(OMEB_LITTER,PSOILHCAPZ,PSOILCONDZ,PWSAT,PWFC,PD_G,PDZG,PTG, &
- PWG(:,1),PWGI(:,1),PWRL,PWRLI,PTL,PGNDLITTER,ZD_G,ZDZG,ZTGL, &
- ZSOILHCAPZ,ZSOILCONDZ,ZWSAT,ZWFC,ZWSFC,ZWISFC,ZCTSFC,PCT, &
- PFROZEN1,ZFROZEN1SFC )
+
+CALL PREP_MEB_SOIL(IO%LMEB_LITTER, PSOILHCAPZ, PSOILCONDZ, KK, PK, PEK, &
+ ZD_G, ZDZG,ZTGL, ZSOILHCAPZ, ZSOILCONDZ, ZWSAT, ZWFC,&
+ ZWSFC, ZWISFC, ZCTSFC, DMK%XCT, PFROZEN1, ZFROZEN1SFC )
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
!* 2.0 Preliminaries for energy and radiation budget
! ---------------------------------------------
!
-ZPERMSNOWFRAC(:) = PVEGTYPE(:,NVT_SNOW)
+ZPERMSNOWFRAC(:) = PK%XVEGTYPE_PATCH(:,NVT_SNOW)
!
! Local working:
! - possibly adjust these prognostic variables locally, but do not save
!
-ZSNOWRHO(:,:) = PSNOWRHO(:,:)
-ZSNOWAGE(:,:) = PSNOWAGE(:,:)
-ZSNOWSWE(:,:) = PSNOWSWE(:,:)
+ZSNOWRHO(:,:) = PEK%TSNOW%RHO (:,:)
+ZSNOWAGE(:,:) = PEK%TSNOW%AGE (:,:)
+ZSNOWSWE(:,:) = PEK%TSNOW%WSNOW(:,:)
!
- CALL PREPS_FOR_MEB_EBUD_RAD(PPS, &
- PLAI,ZSNOWRHO,ZSNOWSWE,PSNOWHEAT, &
- PSNOWTEMP,PSNOWDZ,ZSNOWCOND,ZSNOWHCAP,PEMISNOW, &
- ZSIGMA_F,ZCHIP, &
- PTSTEP,PSR,PTA,PVMOD,ZSNOWAGE,ZPERMSNOWFRAC )
+CALL PREPS_FOR_MEB_EBUD_RAD(PPS, PEK%XLAI, ZSNOWRHO, ZSNOWSWE, PEK%TSNOW%HEAT, ZSNOWLIQ, &
+ DMK%XSNOWTEMP, DMK%XSNOWDZ, ZSNOWCOND, ZSNOWHCAP, &
+ PEK%TSNOW%EMIS, ZSIGMA_F, ZCHIP, PTSTEP, PSR, PTA, &
+ PVMOD, ZSNOWAGE, ZPERMSNOWFRAC )
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
@@ -815,80 +532,110 @@ ZSNOWSWE(:,:) = PSNOWSWE(:,:)
!
! Calculate snow albedo: split into spectral bands:
!
- CALL SNOWALB_SPECTRAL_BANDS_MEB(PVEGTYPE,PSNOWALB,ZSNOWRHO,ZSNOWAGE,PPS, &
- PPSN,PSNOWDZ,PZENITH, &
- PSNOWALBVIS,PSNOWALBNIR,PSNOWALBFIR,ZTAU_N)
+CALL SNOWALB_SPECTRAL_BANDS_MEB(PK%XVEGTYPE_PATCH, PEK, ZSNOWRHO, ZSNOWAGE, PPS,&
+ DMK%XSNOWDZ,PZENITH, ZTAU_N)
!
!
! NOTE, currently MEB only uses 2 of 3 potential snow albedo spectral bands
!
!
-WHERE(PSNOWALB(:) /= XUNDEF)
- ZLAI(:) = PLAI(:)*(1.0-PPALPHAN(:))
- ZALBVIS_TSOIL(:) = PALBVIS_TSOIL(:)*(1.-PPSN(:)) + PPSN(:)*PSNOWALBVIS(:)
- ZALBNIR_TSOIL(:) = PALBNIR_TSOIL(:)*(1.-PPSN(:)) + PPSN(:)*PSNOWALBNIR(:)
+WHERE(PEK%TSNOW%ALB(:) /= XUNDEF)
+ ZLAI(:) = PEK%XLAI(:)*(1.0-PPALPHAN(:))
+ ZALBVIS_TSOIL(:) = PALBVIS_TSOIL(:)*(1.-PEK%XPSN(:)) + PEK%XPSN(:)*PEK%TSNOW%ALBVIS(:)
+ ZALBNIR_TSOIL(:) = PALBNIR_TSOIL(:)*(1.-PEK%XPSN(:)) + PEK%XPSN(:)*PEK%TSNOW%ALBNIR(:)
ELSEWHERE
- ZLAI(:) = PLAI(:)
+ ZLAI(:) = PEK%XLAI(:)
ZALBVIS_TSOIL(:) = PALBVIS_TSOIL(:)
ZALBNIR_TSOIL(:) = PALBNIR_TSOIL(:)
END WHERE
!
- CALL RADIATIVE_TRANSFERT(OAGRI_TO_GRASS, PVEGTYPE, &
- PALBVIS_TVEG, ZALBVIS_TSOIL, PALBNIR_TVEG, ZALBNIR_TSOIL, &
- PSW_RAD, ZLAI, PZENITH, PABC, &
- PFAPARC, PFAPIRC, PMUS, PLAI_EFFC, OSHADE, ZIACAN, &
- ZIACAN_SUNLIT, ZIACAN_SHADE, ZFRAC_SUN, &
- PFAPAR, PFAPIR, PFAPAR_BS, PFAPIR_BS )
+ CALL RADIATIVE_TRANSFERT(IO%LAGRI_TO_GRASS, PK%XVEGTYPE_PATCH, &
+ PALBVIS_TVEG, ZALBVIS_TSOIL, PALBNIR_TVEG, ZALBNIR_TSOIL, &
+ PSW_RAD, ZLAI, PZENITH, PABC, PEK%XFAPARC, PEK%XFAPIRC, &
+ PEK%XMUS, PEK%XLAI_EFFC, OSHADE, ZIACAN, ZIACAN_SUNLIT, &
+ ZIACAN_SHADE, ZFRAC_SUN, DMK%XFAPAR, DMK%XFAPIR, &
+ DMK%XFAPAR_BS, DMK%XFAPIR_BS )
+
+! Compute all-wavelength effective ground (soil+snow) surface,
+! soil and veg albedos, respectively:
+
+ZALBS(:) = XSW_WGHT_NIR*ZALBNIR_TSOIL(:) + XSW_WGHT_VIS*ZALBVIS_TSOIL(:)
+ZALBG(:) = XSW_WGHT_NIR*PALBNIR_TSOIL(:) + XSW_WGHT_VIS*PALBVIS_TSOIL(:)
+
+ZALBV(:) = XSW_WGHT_NIR*PALBNIR_TVEG(:) + XSW_WGHT_VIS*PALBVIS_TVEG(:)
+!
+WHERE(PSW_RAD(:) > ZSWRAD_MIN) ! Sun is up...approx
+!
! Total effective surface (canopy, ground/flooded zone, snow) all-wavelength
! albedo: diagnosed from shortwave energy budget closure
-PALBT(:) = 1. - (XSW_WGHT_VIS*(PFAPAR(:)+PFAPAR_BS(:)) + &
- XSW_WGHT_NIR*(PFAPIR(:)+PFAPIR_BS(:)))
-ZSWUP(:) = PSW_RAD(:)*PALBT(:)
-PALBT(:) = ZSWUP(:)/MAX(1.E-5, PSW_RAD(:))
+ DK%XALBT(:) = 1. - (XSW_WGHT_VIS*(DMK%XFAPAR(:)+DMK%XFAPAR_BS(:)) + &
+ XSW_WGHT_NIR*(DMK%XFAPIR(:)+DMK%XFAPIR_BS(:)))
+ ZSWUP (:) = PSW_RAD(:)*DK%XALBT(:)
+ DK%XALBT(:) = ZSWUP(:)/MAX(1.E-5, PSW_RAD(:))
+
+! Diagnose all-wavelength SW radiative budget
+! for the canopy and below canopy (surface) components;
-! Diagnose all-wavelength SW radiative budget components:
+ DEK%XSWNET_V(:) = PSW_RAD(:)*(XSW_WGHT_VIS*DMK%XFAPAR (:) + XSW_WGHT_NIR*DMK%XFAPIR (:))
+ ZSWNET_S(:) = PSW_RAD(:)*(XSW_WGHT_VIS*DMK%XFAPAR_BS(:) + XSW_WGHT_NIR*DMK%XFAPIR_BS(:))
+!
+! Compute total all wavelength SW transmission:
+! A solution of a quadradic equation based on ground energy budget Eq in FAPAIR.F90
+! Tr = [ -b - sqrt(b^2 - 4ac) ]/(2a) (this is good root for this computation)
+! Here we derrive Eq so that a=1
-PSWNET_V(:) = PSW_RAD(:)*(XSW_WGHT_VIS*PFAPAR(:) + &
- XSW_WGHT_NIR*PFAPIR(:) )
-ZSWNET_S(:) = PSW_RAD(:)*(XSW_WGHT_VIS*PFAPAR_BS(:) + &
- XSW_WGHT_NIR*PFAPIR_BS(:))
-PSWNET_N(:) = ZSWNET_S(:)* PPSN(:)
-PSWNET_G(:) = ZSWNET_S(:)*(1.-PPSN(:))
+ ZWORK4(:) = ZALBS(:)*ZALBV(:)
+ ZWORK2(:) = -(1.-ZALBS(:)*(1.-ZALBV(:)))/ZWORK4(:) ! b
+ ZWORK3(:) = ZSWNET_S(:)/(PSW_RAD(:)*ZWORK4(:)) ! c
+ ZWORK(:) = SQRT(MAX(0.0, ZWORK2(:)**2 - 4*ZWORK3(:))) ! sqrt(b**2 - 4c)
+ ZTR(:) = 0.5*(-ZWORK2(:) - ZWORK(:)) ! -b - sqrt(b^2 - 4c) ]/2
+ ZTR(:) = MIN(1.,MAX(0., ZTR(:) ))
+!
+! Downwelling SW radiation arriving at ground/snow surface
-! Quantity of net shortwave radiation absorbed in surface snow layer
+ DEK%XSWDOWN_GN(:) = PSW_RAD(:)*ZTR(:)
-PSWNET_NS(:) = PSWNET_N(:)*(1.0 - ZTAU_N(:,1))
+! Get snow and ground components:
-! Compute all-wavelength effective ground albedo
+ DEK%XSWNET_G(:) = (1.-PEK%XPSN(:))*DEK%XSWDOWN_GN(:)*(1.-ZALBG(:)+ZALBS(:)*(1.-ZTR(:))*ZALBV(:))
+ DEK%XSWNET_N(:) = ZSWNET_S(:)-DEK%XSWNET_G(:) ! conservative computation
-ZALBG(:) = XSW_WGHT_NIR*ZALBNIR_TSOIL(:) + &
- XSW_WGHT_VIS*ZALBVIS_TSOIL(:)
+! Quantity of net shortwave radiation absorbed in surface snow layer
+ DEK%XSWNET_NS(:) = DEK%XSWNET_N(:)*(1.0 - ZTAU_N(:,1))
+!
! Any SW radiation reaching the base of the lowest snow layer can pass
! into the soil:
-ZTAU_N(:,SIZE(PSNOWSWE,2)) = ZTAU_N(:,SIZE(PSNOWSWE,2))*(1.-ZALBG(:))
+ ZTAU_N(:,SIZE(PEK%TSNOW%WSNOW,2)) = ZTAU_N(:,SIZE(PEK%TSNOW%WSNOW,2))*(1.-ZALBG(:))
+!
+ELSEWHERE
-! Downwelling SW radiation arriving at ground/snow surface
+! Sun is down:
+
+ DK%XALBT(:) = 1.0
+ ZSWUP(:) = PSW_RAD(:)
+ DEK%XSWDOWN_GN(:) = 0.
+ DEK%XSWNET_G(:) = 0.
+ DEK%XSWNET_V(:) = 0.
+ DEK%XSWNET_N(:) = 0.
+ DEK%XSWNET_NS(:) = 0.
+ ZTAU_N(:,SIZE(PEK%TSNOW%WSNOW,2)) = 0.
-PSWDOWN_GN(:) = ZSWNET_S(:)/(1.-ZALBG(:))
-!
+END WHERE
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
!* 4.0 Longwave radiative transfer
! ---------------------------
!
- CALL ISBA_LWNET_MEB(PLAI,PPSN,PPALPHAN, &
- PEMISNOW,PFEMIS,PFF, &
- PTV,ZTGL(:,1),PSNOWTEMP(:,1), &
- PLW_RAD,PLWNET_N,PLWNET_V,PLWNET_G, &
- ZDLWNET_V_DTV,ZDLWNET_V_DTG,ZDLWNET_V_DTN, &
- ZDLWNET_G_DTV,ZDLWNET_G_DTG,ZDLWNET_G_DTN, &
- ZDLWNET_N_DTV,ZDLWNET_N_DTG,ZDLWNET_N_DTN, &
- ZSIGMA_F,ZSIGMA_FN,PLWDOWN_GN )
+CALL ISBA_LWNET_MEB(PEK%XLAI, PEK%XPSN, PPALPHAN,PEK%TSNOW%EMIS, KK%XEMISF, KK%XFF, &
+ PEK%XTV, ZTGL(:,1), DMK%XSNOWTEMP(:,1), PLW_RAD, DEK%XLWNET_N, &
+ DEK%XLWNET_V, DEK%XLWNET_G, ZDLWNET_V_DTV, ZDLWNET_V_DTG, ZDLWNET_V_DTN, &
+ ZDLWNET_G_DTV, ZDLWNET_G_DTG, ZDLWNET_G_DTN, ZDLWNET_N_DTV, &
+ ZDLWNET_N_DTG, ZDLWNET_N_DTN, ZSIGMA_F, ZSIGMA_FN, DEK%XLWDOWN_GN )
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
@@ -899,26 +646,27 @@ PSWDOWN_GN(:) = ZSWNET_S(:)/(1.-ZALBG(:))
!
! First, compute an effective veg fraction: it can only be < unity if vegetation is buried by snowpack...
!
-ZWORK(:) = (1.0 - PPSN(:) + PPSN(:)*(1.0 - PPALPHAN(:)))
+ZWORK(:) = (1.0 - PEK%XPSN(:) + PEK%XPSN(:)*(1.0 - PPALPHAN(:)))
!
- CALL WET_LEAVES_FRAC(PWR, ZWORK, PWRMAX_CF, PZ0_MEBV, PLAI, ZWRMAX, ZDELTA)
+CALL WET_LEAVES_FRAC(PEK%XWR(:), ZWORK, PEK%XWRMAX_CF(:), PZ0_MEBV, PEK%XLAI(:), ZWRMAX, ZDELTA)
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-!* 6.0 Plant stress, stomatal resistance and, possibly, CO2 assimilation
+!* 6.0 Plant stress, stomatal resistance and, possibly, CO2 assimilatio
! --------------------------------------------------------------------
!
-! MEB-NOTE here assumed HPHOTO=='DEF' or 'AST' for now
+! MEB-NOTE here assumed IO%CPHOTO=='DEF' or 'AST' for now
! More Ags options to be added later
!
-IF (HPHOTO=='NON') THEN
+IF (IO%CPHOTO=='NON') THEN
!
! Canopy vegetation (no snow, or snow below the main part of the canopy):
!
- CALL VEG(PSW_RAD, PTC, PQC, PPS, PRGL, PLAI, PRSMIN, PGAMMA, PF2, ZRS)
+ CALL VEG(PSW_RAD, PEK%XTC(:), PEK%XQC(:), PPS, PEK%XRGL(:), PEK%XLAI(:), &
+ PEK%XRSMIN(:), PEK%XGAMMA(:), PF2, ZRS)
!
!
-ELSE IF (MAXVAL(PGMES) /= XUNDEF .OR. MINVAL(PGMES) /= XUNDEF) THEN
+ELSE IF (MAXVAL(PEK%XGMES) /= XUNDEF .OR. MINVAL(PEK%XGMES) /= XUNDEF) THEN
!
! NOTE: For now we assume that forest canopy can be flooded.
! However, we need to likely compute a fraction like PALPHAN (for snow vertical extent)
@@ -926,21 +674,22 @@ ELSE IF (MAXVAL(PGMES) /= XUNDEF .OR. MINVAL(PGMES) /= XUNDEF) THEN
ZFFV(:) = 0.0
- ZQSAT(:) = QSAT(PTV,PPS)
- CALL COTWORES(PTSTEP, HPHOTO, OTR_ML, OSHADE, &
- PVEGTYPE, OSTRESSDEF, PAH, PBH, PF2I, PDMAX, &
- PPOI, PCSP, PTV, PF2, PSW_RAD, PRESA, PQC, ZQSAT, PLE, &
- PPALPHAN, ZDELTA, PLAI, PRHOA, PZENITH, PFZERO, PEPSO, &
- PGAMM, PQDGAMM, PGMES, PGC, PQDGMES, PT1GMES, PT2GMES, &
- PAMAX, PQDAMAX, PT1AMAX, PT2AMAX, ZFFV, &
- ZIACAN_SUNLIT, ZIACAN_SHADE, ZFRAC_SUN, ZIACAN, &
- PABC, PAN, PANDAY, ZRS, PANFM, PGPP, PANF, PRESP_BIOMASS_INST(:,1))
-!
- PIACAN(:,:) = ZIACAN(:,:)
+ ZQSAT(:) = QSAT(PEK%XTV(:),PPS)
+
+ ZWORK(:) = PEK%XLE(:) ! passed in as LE: Since Qc corresponds to the effective
+ PEK%XLE(:) = 0. ! surface specific humidity in ISBA-MEB,
+ ! so no need for LE correction (only required for composite ISBA)
+ CALL COTWORES(PTSTEP, IO, OSHADE, PK, PEK, PK%XDMAX, PPOI, PCSP, PEK%XTV, &
+ PF2, PSW_RAD, PEK%XQC, ZQSAT, PPALPHAN, ZDELTA, PRHOA, &
+ PZENITH, ZFFV, ZIACAN_SUNLIT, ZIACAN_SHADE, ZFRAC_SUN, &
+ ZIACAN, PABC, ZRS, DEK%XGPP, PRESP_BIOMASS_INST(:,1))
+ PEK%XLE(:) = ZWORK(:)
+!
+ PIACAN(:,:) = ZIACAN(:,:)
!
ELSE
PRESP_BIOMASS_INST(:,1) = 0.0
- PGPP(:) = 0.0
+ DEK%XGPP(:) = 0.0
ENDIF
!
! Additional resistance for possibly snow-buried canopy vegetation:
@@ -952,8 +701,8 @@ ZRSN(:) = ZRS(:)/( 1.0 - MIN(PPALPHAN(:), 1.0 - (ZRS(:)/XRS_MAX)) )
!* 6.0 Canopy snow (intercepted) needed diagnostics:
! ---------------------------------------------
!
- CALL SNOW_LEAVES_FRAC_MEB(PPSN,PPALPHAN,PWRVN,PTV,ZCHIP,PLAI, &
- ZWRVNMAX,ZPSNCV,ZMELTVN)
+CALL SNOW_LEAVES_FRAC_MEB(PEK%XPSN, PPALPHAN, PEK%XWRVN, PEK%XTV, ZCHIP, &
+ PEK%XLAI, ZWRVNMAX, ZPSNCV, ZMELTVN)
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
@@ -963,20 +712,50 @@ ZRSN(:) = ZRS(:)/( 1.0 - MIN(PPALPHAN(:), 1.0 - (ZRS(:)/XRS_MAX)) )
!
! NOTE, this assumes thermodynamic variable herein is potential T
-ZPET_A_COEF(:) = -PPET_A_COEF(:)*XCPD
-ZPET_B_COEF(:) = PPET_B_COEF(:)*XCPD
-ZTHRMA_TA(:) = XCPD/PEXNA(:)
-ZTHRMB_TA(:) = 0.0
-ZWORK(:) = XCPD/PEXNS(:)
-ZTHRMA_TC(:) = ZWORK(:)
-ZTHRMB_TC(:) = 0.0
-ZTHRMA_TN(:) = ZWORK(:)
-ZTHRMB_TN(:) = 0.0
-ZTHRMA_TG(:) = ZWORK(:)
-ZTHRMB_TG(:) = 0.0
-ZTHRMA_TV(:) = ZWORK(:)
-ZTHRMB_TV(:) = 0.0
+ZPET_A_COEF(:) = -PPET_A_COEF(:)*XCPD
+ZPET_B_COEF(:) = PPET_B_COEF(:)*XCPD
+ZTHRMA_TA(:) = XCPD/PEXNA(:)
+ZTHRMB_TA(:) = 0.0
+ZWORK(:) = XCPD/PEXNS(:)
+ZTHRMA_TC(:) = ZWORK(:)
+ZTHRMB_TC(:) = 0.0
+ZTHRMA_TN(:) = ZWORK(:)
+ZTHRMB_TN(:) = 0.0
+ZTHRMA_TG(:) = ZWORK(:)
+ZTHRMB_TG(:) = 0.0
+ZTHRMA_TV(:) = ZWORK(:)
+ZTHRMB_TV(:) = 0.0
+!
+!
+! For turbulence computations:
+! Adjust (shift upward) local reference heights "seen by the turbulence scheme"
+! if they are below the canopy:
+! NOTE, this approach is an alternative to LFORC_MEASURE=F, which shifts
+! vegetation downward by the displacement height. Both approaches essentially
+! conceptually assume that the vegetation is part of the terrain.
+! Also, here, conserve any UREF and ZREF differences.
+!
+ZZREF(:) = PZREF(:)
+ZUREF(:) = PUREF(:)
+IF(IO%LFORC_MEASURE)THEN
+ WHERE(PZREF(:) - PEK%XH_VEG(:) < XLIMH)
+ ZZREF(:) = PEK%XH_VEG(:) + XLIMH
+ ZUREF(:) = PEK%XH_VEG(:) + XLIMH + MAX(0.,PUREF(:)-PZREF(:))
+ END WHERE
+ENDIF
!
+! Compute the average latent heat (normalization factor) (J kg-1):
+! NOTE that we could use a function which depends on the different resistances,
+! but this can make the average latent heat relatively noisy(leading to a slightly less
+! tightly closed budgets owing to numerical noise): here we opt for a more
+! temporally smooth approximation based on fractional coverage:
+!
+ZLVTTC(:) = ( ZSIGMA_F(:)*(1.-ZPSNCV(:)) + (1.0-PEK%XPSN(:)-KK%XFF(:))*(1.0-ZFROZEN1SFC(:)) )* &
+ (1.0 - PEK%XPSN(:)*PPALPHAN(:))
+ZLSTTC(:) = ( ZSIGMA_F(:)* ZPSNCV(:) + (1.0-PEK%XPSN(:)-KK%XFF(:))* ZFROZEN1SFC(:) + PEK%XPSN(:) )* &
+ (1.0 - PEK%XPSN(:)*PPALPHAN(:)) + PEK%XPSN(:)*PPALPHAN(:)
+ZLTT(:) = (ZLVTTC(:)*XLVTT + ZLSTTC(:)*XLSTT)/MAX(1.E-12, ZLVTTC(:) + ZLSTTC(:))
+ZLTT(:) = MIN(XLSTT, MAX(ZLTT(:), XLVTT)) ! numerical check
!
! Possibly split time step if large:
! Although the energy budget is fully implicit, a very small canopy heat capacity
@@ -989,12 +768,12 @@ ZTHRMB_TV(:) = 0.0
! Finally, for *very* small time steps (such as those for high res runs), no split is performed.
! Fluxes are averaged over the time split for conservation.
!
-JTSPLIT_EB = 1 + INT(PTSTEP/ZTSTEP_EB) ! number of split-time steps
-ZTSTEP = PTSTEP/JTSPLIT_EB ! split time step...for relatively small time steps, no split
+JTSPLIT_EB = 1 + INT(PTSTEP/ZTSTEP_EB) ! number of split-time steps
+ZTSTEP = PTSTEP/JTSPLIT_EB ! split time step...for relatively small time steps, no split
!
! initialize time split sums for fluxes:
!
- CALL INIT_SUM_FLUXES_MEB_TSPLIT
+CALL INIT_SUM_FLUXES_MEB_TSPLIT
!
!
! Note, when implicitly coupled to the atmosphere, these
@@ -1012,98 +791,67 @@ LOOP_TIME_SPLIT_EB: DO JDT=1,JTSPLIT_EB
!* 7.1 Aerodynamic drag and heat transfer coefficients
! -----------------------------------------------
!
- CALL DRAG_MEB(OFORC_MEASURE, &
- ZTGL(:,1), PTC, PTV, PSNOWTEMP(:,1), &
- ZTA_IC, PQC, ZQA_IC, ZVMOD, &
- ZWSFC, ZWISFC, ZWSAT(:,1), ZWFC(:,1), &
- PEXNS, PEXNA, PPS, &
- PRR, PSR, PRHOA, PZ0G_WITHOUT_SNOW, &
- PZ0_MEBV, PZ0H_MEBV, PZ0EFF_MEBV, &
- PZ0_MEBN, PZ0H_MEBN, PZ0EFF_MEBN, &
- PZ0_WITH_SNOW, PZ0H_WITH_SNOW, PZ0EFF, &
- ZSNOWSWE(:,1), &
- PWR, ZCHIP, ZTSTEP, ZRS, ZRSN, &
- PPSN, PPALPHAN, PZREF, PUREF, PH_VEG, PDIRCOSZW, &
- ZPSNCV, ZDELTA, PLAI, OMEB_GNDRES, &
- PCH, PCD, PCDN, PRI, PRESA, ZVELC, &
- PCDSNOW, PCHSNOW, PRISNOW, ZUSTAR2SNOW, &
- PHUG, ZHUGI, PHV, ZHVG, ZHVN, PHU, PQS, PRS, &
- ZLEG_DELTA, ZLEGI_DELTA, ZHSGL, ZHSGF, &
- ZFLXC_C_A, ZFLXC_N_A, ZFLXC_G_C, ZFLXC_N_C, &
- ZFLXC_VG_C, ZFLXC_VN_C, ZFLXC_MOM, &
- ZQSATG, ZQSATV, ZQSATC, ZQSATN, ZDELTAVK )
+ CALL DRAG_MEB(IO, PEK, DMK, DK, &
+ ZTGL(:,1), ZTA_IC, ZQA_IC, ZVMOD, ZWSFC, ZWISFC, &
+ ZWSAT(:,1), ZWFC(:,1), PEXNS, PEXNA, PPS, PRR, PSR, &
+ PRHOA, PZ0G_WITHOUT_SNOW, PZ0_MEBV, PZ0H_MEBV, &
+ PZ0EFF_MEBV, PZ0_MEBN, PZ0H_MEBN, PZ0EFF_MEBN, &
+ ZSNOWSWE(:,1), ZCHIP, ZTSTEP, ZRS, ZRSN, PPALPHAN, &
+ ZZREF, ZUREF, PDIRCOSZW, ZPSNCV, ZDELTA, ZVELC, &
+ PRISNOW, ZUSTAR2SNOW, ZHUGI, ZHVG, &
+ ZHVN, ZLEG_DELTA, ZLEGI_DELTA, ZHSGL, ZHSGF, &
+ ZFLXC_CA, ZFLXC_N_A, ZFLXC_GV, ZFLXC_GN, &
+ ZFLXC_VG_C, ZFLXC_VN_C, ZFLXC_MOM, ZQSATG, ZQSATV, &
+ ZQSATC, ZQSATN, ZDELTAVK )
!
ZKVN(:) = SNOW_INTERCEPT_EFF(ZCHIP,ZVELC,ZWRVNMAX)
!* 7.2 Resolution of the surface energy budgets
! ----------------------------------------
!
- CALL E_BUDGET_MEB(HISBA,HCPSURF,ZTSTEP, &
- PPS,PCG,ZCTSFC,PCV,PWRVN,PWR, &
- PTDEEP_A,PTDEEP_B,ZD_G,ZSOILCONDZ,ZSOILHCAPZ, &
- PSNOWDZ,ZSNOWCOND,ZSNOWHCAP, &
- PSWNET_V,PSWNET_G,PSWNET_NS,ZTAU_N, &
- PLWNET_V,PLWNET_G,PLWNET_N, &
- ZDLWNET_V_DTV,ZDLWNET_V_DTG,ZDLWNET_V_DTN, &
- ZDLWNET_G_DTV,ZDLWNET_G_DTG,ZDLWNET_G_DTN, &
- ZDLWNET_N_DTV,ZDLWNET_N_DTG,ZDLWNET_N_DTN, &
- PPEW_A_COEF,PPEW_B_COEF,ZPET_A_COEF,PPEQ_A_COEF,ZPET_B_COEF,PPEQ_B_COEF, &
- ZTHRMA_TA,ZTHRMB_TA,ZTHRMA_TC,ZTHRMB_TC, &
- ZTHRMA_TG,ZTHRMB_TG,ZTHRMA_TV,ZTHRMB_TV,ZTHRMA_TN,ZTHRMB_TN, &
- ZQSATG,ZQSATV,ZQSATN, &
- PFF,PFFROZEN,PPSN,PPALPHAN,ZPSNCV, &
- ZCHEATV,ZCHEATG,ZCHEATN, &
- ZLEG_DELTA,ZLEGI_DELTA,PHUG,ZHUGI,ZHVG,ZHVN,ZFROZEN1SFC, &
- ZFLXC_C_A,ZFLXC_G_C,ZFLXC_VG_C,ZFLXC_VN_C,ZFLXC_N_C,ZFLXC_N_A, &
- ZFLXC_MOM, &
- ZTGL,PTV,PSNOWTEMP, &
- ZFLXC_V_C,ZHVGS,ZHVNS, &
- ZDQSAT_G,ZDQSAT_V,ZDQSATI_N, &
- PTC,PQC,ZTA_IC,ZQA_IC,ZUSTAR2_IC,ZVMOD, &
- ZDELTAT_G,ZDELTAT_V,ZDELTAT_N,PGRNDFLUX,PCPS,PLVTT,PLSTT, &
- PHPSNOW,PMELTADV,PRESTORE,PDEEP_FLUX, &
- PDELHEATV_SFC,PDELHEATG_SFC,PDELHEATG )
+ CALL E_BUDGET_MEB(IO, KK, PK, PEK, DK, DEK, DMK, &
+ ZTSTEP, ZLTT, PPS, ZCTSFC, PTDEEP_A, ZD_G, ZSOILCONDZ, ZSOILHCAPZ,&
+ ZSNOWRHO, ZSNOWCOND, ZSNOWHCAP, ZTAU_N, ZDLWNET_V_DTV, ZDLWNET_V_DTG, &
+ ZDLWNET_V_DTN, ZDLWNET_G_DTV, ZDLWNET_G_DTG, ZDLWNET_G_DTN, &
+ ZDLWNET_N_DTV, ZDLWNET_N_DTG, ZDLWNET_N_DTN, PPEW_A_COEF, &
+ PPEW_B_COEF, ZPET_A_COEF, PPEQ_A_COEF, ZPET_B_COEF, &
+ PPEQ_B_COEF, ZTHRMA_TA, ZTHRMB_TA, ZTHRMA_TC, ZTHRMB_TC, &
+ ZTHRMA_TG, ZTHRMB_TG, ZTHRMA_TV, ZTHRMB_TV, ZTHRMA_TN, &
+ ZTHRMB_TN, ZQSATG, ZQSATV, ZQSATN, PPALPHAN, ZPSNCV, &
+ ZCHEATV, ZCHEATG, ZCHEATN, ZLEG_DELTA, ZLEGI_DELTA, ZHUGI, &
+ ZHVG, ZHVN, ZFROZEN1SFC, ZFLXC_CA, ZFLXC_GV, ZFLXC_VG_C, &
+ ZFLXC_VN_C, ZFLXC_GN, ZFLXC_N_A, ZFLXC_MOM, ZTGL, ZSNOWLIQ, &
+ ZFLXC_CV, ZHVGS, ZHVNS, ZDQSAT_G,ZDQSAT_V,ZDQSATI_N, &
+ ZTA_IC, ZQA_IC, ZUSTAR2_IC, ZVMOD, ZDELTAT_G, ZDELTAT_V, &
+ ZDELTAT_N, PGRNDFLUX, PDEEP_FLUX, PDELHEATV_SFC, &
+ PDELHEATG_SFC, PDELHEATG )
!
!* 7.3 Energy and momentum fluxes and radiative temperature and emissivity
! -------------------------------------------------------------------
!
- CALL ISBA_FLUXES_MEB(PRHOA, &
- ZSIGMA_F,ZSIGMA_FN,PEMISNOW, &
- ZRNET_V,ZRNET_G,PRNSNOW, &
- PSWNET_V,PSWNET_G,PSWNET_N, &
- PLWNET_V,PLWNET_G,PLWNET_N, &
- ZDLWNET_V_DTV,ZDLWNET_V_DTG,ZDLWNET_V_DTN, &
- ZDLWNET_G_DTV,ZDLWNET_G_DTG,ZDLWNET_G_DTN, &
- ZDLWNET_N_DTV,ZDLWNET_N_DTG,ZDLWNET_N_DTN, &
- ZTHRMA_TA,ZTHRMB_TA,ZTHRMA_TC,ZTHRMB_TC, &
- ZTHRMA_TG,ZTHRMB_TG,ZTHRMA_TV,ZTHRMB_TV,ZTHRMA_TN,ZTHRMB_TN, &
- ZQSATG,ZQSATV,ZQSATN, &
- PFF,PPSN,PPALPHAN,ZPSNCV,ZFROZEN1SFC,PFFROZEN, &
- ZLEG_DELTA,ZLEGI_DELTA,PHUG,ZHUGI,ZHVG,ZHVN, &
- ZFLXC_C_A,ZFLXC_G_C,ZFLXC_VG_C,ZFLXC_VN_C,ZFLXC_N_C,ZFLXC_N_A, &
- ZFLXC_MOM,ZFLXC_V_C,ZHVGS,ZHVNS, &
- ZTGL,PTV,PSNOWTEMP, &
- ZDQSAT_G,ZDQSAT_V,ZDQSATI_N, &
- PTC,PQC,ZTA_IC,ZQA_IC, &
- ZDELTAVK, &
- ZDELTAT_G,ZDELTAT_V,ZDELTAT_N, &
- ZSWUP,PSW_RAD,PLW_RAD, &
- PRN,ZLWUP, &
- PH_C_A,PH_V_C,PH_G_C,PH_N_C,ZH_N_A,PHSNOW,PH, &
- PLE_C_A,PLE_V_C,PLE_G_C,PLE_N_C, &
- ZEVAP_C_A,PLEV_V_C,PEVAP_G_C,PEVAP_N_C,ZEVAP_N_A, &
- PEVAP,PSUBL,PLETR_V_C,PLER_V_C,ZLESFC,ZLESFCI, &
- PLE_FLOOD,PLEI_FLOOD,ZLES3L,ZLEL3L, &
- ZEVAP3L,PLES_V_C,PLETR,PLER,PLEV,PLE,PLEI, &
- PTS_RAD,PEMIST,PLSTT )
+ CALL ISBA_FLUXES_MEB(KK, PK, PEK, DK, DEK, DMK, PRHOA, ZLTT, ZSIGMA_F, ZSIGMA_FN, &
+ ZRNET_V, ZRNET_G, ZDLWNET_V_DTV, ZDLWNET_V_DTG, &
+ ZDLWNET_V_DTN, ZDLWNET_G_DTV, ZDLWNET_G_DTG, &
+ ZDLWNET_G_DTN, ZDLWNET_N_DTV, ZDLWNET_N_DTG, &
+ ZDLWNET_N_DTN, ZTHRMA_TA, ZTHRMB_TA, ZTHRMA_TC, &
+ ZTHRMB_TC, ZTHRMA_TG, ZTHRMB_TG, ZTHRMA_TV, ZTHRMB_TV, &
+ ZTHRMA_TN, ZTHRMB_TN, ZQSATG, ZQSATV, ZQSATN, PPALPHAN, &
+ ZPSNCV, ZFROZEN1SFC, ZLEG_DELTA, ZLEGI_DELTA, ZHUGI, &
+ ZHVG, ZHVN, ZFLXC_CA, ZFLXC_GV, ZFLXC_VG_C, ZFLXC_VN_C, &
+ ZFLXC_GN, ZFLXC_N_A, ZFLXC_MOM, ZFLXC_CV, ZHVGS, &
+ ZHVNS, ZTGL, ZDQSAT_G, ZDQSAT_V, ZDQSATI_N, ZTA_IC, &
+ ZQA_IC, ZDELTAVK, ZDELTAT_G, ZDELTAT_V, ZDELTAT_N, &
+ ZSWUP, PSW_RAD, PLW_RAD, ZLWUP, ZH_N_A, ZEVAP_C_A, &
+ ZEVAP_N_A, ZLESFC, ZLESFCI, ZLES3L, ZLEL3L, ZEVAP3L, &
+ PEMIST )
!
! Compute aggregated coefficients for evaporation
! Sum(LEC+LES+LEL) = ACagg * Lv * RHOA * (HUagg.Qsat - Qa)
!
- ZFLXC_C_A_F(:) = ZFLXC_C_A(:)*(1.0-PPSN(:)*PPALPHAN(:))
- ZFLXC_N_A_F(:) = ZFLXC_N_A(:)* PPSN(:)*PPALPHAN(:)
+ ZFLXC_C_A_F(:) = ZFLXC_CA (:)*(1.0-PEK%XPSN(:)*PPALPHAN(:))
+ ZFLXC_N_A_F(:) = ZFLXC_N_A(:)* PEK%XPSN(:)*PPALPHAN(:)
- PHU_AGG(:) = (ZFLXC_C_A_F(:)*PQC(:) + ZFLXC_N_A_F(:)*ZQSATN(:))/ &
+ PHU_AGG(:) = (ZFLXC_C_A_F(:)*PEK%XQC(:)+ ZFLXC_N_A_F(:)*ZQSATN(:))/ &
(ZFLXC_C_A_F(:)*ZQSATC(:) + ZFLXC_N_A_F(:)*ZQSATN(:))
PAC_AGG(:) = ZFLXC_C_A_F(:) + ZFLXC_N_A_F(:) ! kg/m2/s
@@ -1114,33 +862,34 @@ LOOP_TIME_SPLIT_EB: DO JDT=1,JTSPLIT_EB
ENDDO LOOP_TIME_SPLIT_EB
!
- CALL AVG_FLUXES_MEB_TSPLIT ! average fluxes over time split
+CALL AVG_FLUXES_MEB_TSPLIT ! average fluxes over time split
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
!* 8.0 Snow explicit canopy loading/interception
! ------------------------------------------
!
- CALL SNOW_LOAD_MEB(PTSTEP,PSR,PTV,ZWRVNMAX,ZKVN,ZCHEATV,PLER_V_C,PLES_V_C,ZMELTVN, &
- ZVELC,PMELTCV,PFRZCV,PSR_GN,PWR,PWRVN,PSUBVCOR,PLVTT,PLSTT)
+CALL SNOW_LOAD_MEB(PK, PEK, DEK, PTSTEP, PSR, ZWRVNMAX, ZKVN, ZCHEATV, ZMELTVN, &
+ ZVELC, PSUBVCOR)
!
+
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
!* 9.0 Snow explicit canopy loading/interception
! ------------------------------------------
!
ZRR(:) = PRR(:)
-PIRRIG_FLUX(:) = 0.0
+DEK%XIRRIG_FLUX(:) = 0.0
!
!* add irrigation over vegetation to liquid precipitation (rr)
! Water "need" treated as if sprayed from above (over vegetation and soil):
!
-IF (SIZE(OIRRIGATE)>0) THEN
- WHERE (OIRRIGATE(:) .AND. PIRRIG(:)>0. .AND. PIRRIG(:) /= XUNDEF .AND. (PF2(:)<PTHRESHOLD(:)) )
- PIRRIG_FLUX(:) = PWATSUP(:) / XDAY
- ZRR (:) = PRR(:) + PWATSUP(:)/XDAY
- OIRRIDAY (:) = .TRUE.
- END WHERE
+IF (SIZE(AG%LIRRIGATE,1)>0) THEN
+ WHERE (AG%LIRRIGATE(:) .AND. PEK%XIRRIG(:)>0. .AND. PEK%XIRRIG(:) /= XUNDEF .AND. (PF2(:)<AG%XTHRESHOLDSPT(:)) )
+ DEK%XIRRIG_FLUX(:) = PEK%XWATSUP(:) / XDAY
+ ZRR (:) = PRR(:) + PEK%XWATSUP(:)/XDAY
+ AG%LIRRIDAY (:) = .TRUE.
+ END WHERE
ENDIF
!
! Call canopy interception...here because meltwater should be allowed to fall
@@ -1148,84 +897,72 @@ ENDIF
!
! Fraction of canopy vegetation possibly receiving rainfall/irrigation
!
-ZVEGFACT(:) = ZSIGMA_F(:)*(1.0-PPALPHAN(:)*PPSN(:))
+ZVEGFACT(:) = ZSIGMA_F(:)*(1.0-PPALPHAN(:)*PEK%XPSN(:))
!
! The sum of all non-intercepted rain and drip is "ZRRSFC" (kg/m2/s):
! this is then partitioned by snow scheme into part falling on
! snowpack and part falling onto snow-free understory.
!
!
- CALL HYDRO_VEG(HRAIN, PTSTEP, PMUF, &
- ZRR, PLEV_V_C, PLETR_V_C, ZVEGFACT, ZPSNCV, &
- PWR, ZWRMAX, ZRRSFC, PDRIP, PRRVEG, PLVTT )
+ CALL HYDRO_VEG(IO%CRAIN, PTSTEP, KK%XMUF, ZRR, DEK%XLEV_CV, DEK%XLETR_CV, &
+ ZVEGFACT, ZPSNCV, PEK%XWR, ZWRMAX, ZRRSFC, DEK%XDRIP, DEK%XRRVEG, &
+ PK%XLVTT )
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
!* 10.0 Explicit snow scheme (MEB: impose surface fluxes as upper BC)
! ----------------------------------------------------------------
!
- CALL SNOW3L_ISBA(HISBA, HSNOW_ISBA, HSNOWRES, OMEB, OGLACIER, HIMPLICIT_WIND, &
- TPTIME, PTSTEP, PVEGTYPE, &
- PSNOWSWE, PSNOWHEAT, PSNOWRHO, PSNOWALB, &
- PSNOWGRAN1, PSNOWGRAN2, PSNOWHIST,PSNOWAGE, &
- ZTGL, PCG, ZCTSFC, ZSOILHCAPZ, ZSOILCONDZ(:,1), &
- PPS, PTA, PSW_RAD, PQA, PVMOD, PLW_RAD, ZRRSFC, PSR_GN, &
- PRHOA, PUREF, PEXNS, PEXNA, PDIRCOSZW, PLVTT, PLSTT, &
- PZREF, PZ0_WITH_SNOW, PZ0EFF, PZ0H_WITH_SNOW, ZALBG, ZD_G, ZDZG, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- PSNOW_THRUFAL, PGRNDFLUX, PFLSN_COR, PRESTOREN, PEVAPCOR, &
- PSWNET_N, PSWNET_NS, PLWNET_N, &
- PRNSNOW, PHSNOW, PGFLUXSNOW, PHPSNOW, PLES, PLESL, ZEVAP3L, &
- PSNDRIFT, PUSTARSNOW, &
- PPSN, PSRSFC, PRRSFC, PSNOWSFCH, PDELHEATN, PDELHEATN_SFC, &
- PEMISNOW, PCDSNOW, PCHSNOW, PSNOWTEMP, PSNOWLIQ, PSNOWDZ, &
- PSNOWHMASS, PRISNOW, PZENITH, PDELHEATG, PDELHEATG_SFC, PLAT, PLON, PQSNOW, &
- OSNOWDRIFT, OSNOWDRIFT_SUBLIM, OSNOW_ABS_ZENITH, &
- HSNOWMETAMO, HSNOWRAD )
-!
-! If a litter layer exists, compute hydrology:
-!
-IF(OMEB_LITTER)THEN
+ CALL SNOW3L_ISBA(IO, G, PK, PEK, DK, DEK, DMK, OMEB, HIMPLICIT_WIND, &
+ TPTIME, PTSTEP, PK%XVEGTYPE_PATCH, ZTGL, ZCTSFC, &
+ ZSOILHCAPZ, ZSOILCONDZ(:,1), PPS, PTA, PSW_RAD, PQA, &
+ PVMOD, PLW_RAD, ZRRSFC, DEK%XSR_GN, PRHOA, ZUREF, PEXNS, &
+ PEXNA, PDIRCOSZW, ZZREF, ZALBG, ZD_G, ZDZG, PPEW_A_COEF, &
+ PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
+ PPEQ_B_COEF, PSNOW_THRUFAL, PGRNDFLUX, PFLSN_COR, &
+ PRESTOREN, PEVAPCOR, DEK%XLES, DEK%XLESL, ZEVAP3L, PSNOWSFCH, &
+ PDELHEATN, PDELHEATN_SFC, PRISNOW, PZENITH, PDELHEATG, &
+ PDELHEATG_SFC, PQSNOW )
!
- ZWORK(:) = 0.
- ZWORK2(:) = PWRL(:)
- ZWORK3(:) = 1.
- ZWORK4(:) = PSNOW_THRUFAL(:) + ZRRSFC(:)*(1-PPSN)
- ZWRLMAX(:) = PGNDLITTER(:)*ZWFC(:,1)*XRHOLW
-
- CALL HYDRO_VEG(HRAIN, PTSTEP, PMUF, &
- ZWORK4(:), ZLESFC,ZWORK, ZWORK3, ZWORK,&
- PWRL , ZWRLMAX, ZRRSFCL, PDRIPLIT, PRRLIT, PLVTT)
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+!* 11.0 Litter layer hydrology:
+! -----------------------
!
- PRRSFC(:) = ZRRSFCL(:)
- PSNOW_THRUFAL_SOIL(:) = 0.0
+IF(IO%LMEB_LITTER)THEN
!
+ ZWORK(:) = 0.
+ ZWORK2(:) = PEK%XWRL(:)
+ ZWORK3(:) = 1.
+ ZWORK4(:) = PSNOW_THRUFAL(:) + ZRRSFC(:)*(1-PEK%XPSN)
+ ZWRLMAX(:) = PEK%XGNDLITTER(:)*ZWFC(:,1)*XRHOLW
+
+ CALL HYDRO_VEG(IO%CRAIN, PTSTEP, KK%XMUF, ZWORK4(:), ZLESFC, ZWORK, ZWORK3, ZWORK, &
+ PEK%XWRL, ZWRLMAX, ZRRSFCL, DEK%XDRIPLIT, DEK%XRRLIT, PK%XLVTT )
+
+ DMK%XRRSFC(:) = ZRRSFCL(:)
+ PSNOW_THRUFAL_SOIL(:) = 0.0
+
ELSE
-!
- PSNOW_THRUFAL_SOIL(:) = PSNOW_THRUFAL(:)
-!
+
+ PSNOW_THRUFAL_SOIL(:) = PSNOW_THRUFAL(:)
+
ENDIF
!
!* 11.0 Separate litter and soil temperature
! ------------------------------------
!
-
- CALL RESHIFT_MEB_SOIL(OMEB_LITTER,ZTGL,PTL,PTG,ZLESFC,ZLESFCI, &
- PLEG,PLEGI,PLELITTER,PLELITTERI)
+ CALL RESHIFT_MEB_SOIL(IO%LMEB_LITTER, ZTGL, ZLESFC, ZLESFCI, PEK, DEK)
!
+CALL DEALLOCATE_LOCAL_VARS_PREP_GRID_SOIL
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+!* 13.0 Ice litter effect
+! ------------------
!
- CALL DEALLOCATE_LOCAL_VARS_PREP_GRID_SOIL
-!
-IF(OMEB_LITTER)THEN
+IF(IO%LMEB_LITTER)THEN
!
- CALL ICE_LITTER(PTSTEP, PLELITTERI, &
- PSOILHCAPZ, &
- PTG, PTL, PWGI, PWG, KWG_LAYER, &
- PDZG,PWRL,PWRLI,PGNDLITTER,ZPHASEL, &
- ZCTSFC,PLSTT,PLITCOR)
+ CALL ICE_LITTER(PTSTEP, DEK%XLELITTERI, PSOILHCAPZ, PEK, PK%NWG_LAYER, &
+ PK%XDZG, ZPHASEL,ZCTSFC,PK%XLSTT,PLITCOR )
!
ENDIF
!
@@ -1233,7 +970,7 @@ IF (LHOOK) CALL DR_HOOK('ISBA_MEB',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
!
- CONTAINS
+CONTAINS
!
!===============================================================================
!
@@ -1252,30 +989,33 @@ IF (LHOOK) CALL DR_HOOK('ISBA_MEB:INIT_SUM_FLUXES_MEB_TSPLIT ',0,ZHOOK_HANDLE)
!
! sensible heat fluxes:
!
-ZH_SUM(:) = 0.0
-ZH_C_A_SUM(:) = 0.0
-ZH_N_A_SUM(:) = 0.0
-ZH_V_C_SUM(:) = 0.0
-ZH_G_C_SUM(:) = 0.0
-ZH_N_C_SUM(:) = 0.0
-ZHSNOW_SUM(:) = 0.0
+ZH_SUM(:) = 0.0
+ZH_N_A_SUM(:) = 0.0
+ZH_CA_SUM(:) = 0.0
+ZH_CV_SUM(:) = 0.0
+ZH_GV_SUM(:) = 0.0
+ZH_GN_SUM(:) = 0.0
+ZHSNOW_SUM(:) = 0.0
!
! latent heat/water vapor fluxes:
!
ZLE_SUM(:) = 0.0
-ZLE_C_A_SUM(:) = 0.0
-ZLE_V_C_SUM(:) = 0.0
-ZLE_G_C_SUM(:) = 0.0
-ZLE_N_C_SUM(:) = 0.0
-ZLETR_V_C_SUM(:) = 0.0
+!
+ZLE_CA_SUM(:) = 0.0
+ZLE_CV_SUM(:) = 0.0
+ZLE_GV_SUM(:) = 0.0
+ZLE_GN_SUM(:) = 0.0
+!
+ZLETR_CV_SUM(:) = 0.0
+ZLER_CV_SUM(:) = 0.0
+ZLES_CV_SUM(:) = 0.0
+!
ZLEG_SUM(:) = 0.0
ZLEGI_SUM(:) = 0.0
ZLESFC_SUM(:) = 0.0
ZLESFCI_SUM(:) = 0.0
-ZLER_V_C_SUM(:) = 0.0
ZLE_FLOOD_SUM(:) = 0.0
ZLEI_FLOOD_SUM(:)= 0.0
-ZLES_V_C_SUM(:) = 0.0
ZLETR_SUM(:) = 0.0
ZLER_SUM(:) = 0.0
ZLEV_SUM(:) = 0.0
@@ -1339,65 +1079,80 @@ IF (LHOOK) CALL DR_HOOK('ISBA_MEB:SUM_FLUXES_MEB_TSPLIT ',0,ZHOOK_HANDLE)
! Sum fluxes over MEB TIME SPLIT:
!
! sensible heat fluxes:
-
-ZH_SUM(:) = ZH_SUM(:) + PH(:)
-ZH_C_A_SUM(:) = ZH_C_A_SUM(:) + PH_C_A(:)
-ZH_N_A_SUM(:) = ZH_N_A_SUM(:) + ZH_N_A(:)
-ZH_V_C_SUM(:) = ZH_V_C_SUM(:) + PH_V_C(:)
-ZH_G_C_SUM(:) = ZH_G_C_SUM(:) + PH_G_C(:)
-ZH_N_C_SUM(:) = ZH_N_C_SUM(:) + PH_N_C(:)
-ZHSNOW_SUM(:) = ZHSNOW_SUM(:) + PHSNOW(:)
+!
+ZH_N_A_SUM(:) = ZH_N_A_SUM(:) + ZH_N_A(:)
+!
+ZH_SUM(:) = ZH_SUM(:) + DK%XH(:)
+!
+ZH_CA_SUM(:) = ZH_CA_SUM(:) + DEK%XH_CA(:)
+ZH_CV_SUM(:) = ZH_CV_SUM(:) + DEK%XH_CV(:)
+ZH_GV_SUM(:) = ZH_GV_SUM(:) + DEK%XH_GV(:)
+ZH_GN_SUM(:) = ZH_GN_SUM(:) + DEK%XH_GN(:)
+!
+ZHSNOW_SUM(:) = ZHSNOW_SUM(:) + DMK%XHSNOW(:)
!
! latent heat/water vapor fluxes:
!
-ZLE_SUM(:) = ZLE_SUM(:) + PLE(:)
-ZLE_C_A_SUM(:) = ZLE_C_A_SUM(:) + PLE_C_A(:)
-ZLE_V_C_SUM(:) = ZLE_V_C_SUM(:) + PLE_V_C(:)
-ZLE_G_C_SUM(:) = ZLE_G_C_SUM(:) + PLE_G_C(:)
-ZLE_N_C_SUM(:) = ZLE_N_C_SUM(:) + PLE_N_C(:)
-ZLETR_V_C_SUM(:) = ZLETR_V_C_SUM(:) + PLETR_V_C(:)
-ZLEG_SUM(:) = ZLEG_SUM(:) + PLEG(:)
-ZLEGI_SUM(:) = ZLEGI_SUM(:) + PLEGI(:)
+ZLE_SUM(:) = ZLE_SUM(:) + PEK%XLE(:)
+!
+ZLEI_SUM(:) = ZLEI_SUM(:) + DK%XLEI(:)
+ZEVAP_SUM(:) = ZEVAP_SUM(:) + DK%XEVAP(:)
+!
+ZLE_CA_SUM(:) = ZLE_CA_SUM(:) + DEK%XLE_CA(:)
+ZLE_CV_SUM(:) = ZLE_CV_SUM(:) + DEK%XLE_CV(:)
+ZLE_GV_SUM(:) = ZLE_GV_SUM(:) + DEK%XLE_GV(:)
+ZLE_GN_SUM(:) = ZLE_GN_SUM(:) + DEK%XLE_GN(:)
+!
+ZLETR_CV_SUM(:) = ZLETR_CV_SUM(:) + DEK%XLETR_CV(:)
+ZLER_CV_SUM(:) = ZLER_CV_SUM(:) + DEK%XLER_CV(:)
+ZLES_CV_SUM(:) = ZLES_CV_SUM(:) + DEK%XLES_CV(:)
+!
+ZLETR_SUM(:) = ZLETR_SUM(:) + DEK%XLETR(:)
+ZLER_SUM(:) = ZLER_SUM(:) + DEK%XLER(:)
+ZLEV_SUM(:) = ZLEV_SUM(:) + DEK%XLEV(:)
+!
+ZLEG_SUM(:) = ZLEG_SUM(:) + DEK%XLEG(:)
+ZLEGI_SUM(:) = ZLEGI_SUM(:) + DEK%XLEGI(:)
+
+ZLE_FLOOD_SUM(:) = ZLE_FLOOD_SUM(:) + DEK%XLE_FLOOD(:)
+ZLEI_FLOOD_SUM(:) = ZLEI_FLOOD_SUM(:) + DEK%XLEI_FLOOD(:)
+!
ZLESFC_SUM(:) = ZLESFC_SUM(:) + ZLESFC(:)
ZLESFCI_SUM(:) = ZLESFCI_SUM(:) + ZLESFCI(:)
-ZLER_V_C_SUM(:) = ZLER_V_C_SUM(:) + PLER_V_C(:)
-ZLE_FLOOD_SUM(:) = ZLE_FLOOD_SUM(:) + PLE_FLOOD(:)
-ZLEI_FLOOD_SUM(:)= ZLEI_FLOOD_SUM(:)+ PLEI_FLOOD(:)
-ZLES_V_C_SUM(:) = ZLES_V_C_SUM(:) + PLES_V_C(:)
-ZLETR_SUM(:) = ZLETR_SUM(:) + PLETR(:)
-ZLER_SUM(:) = ZLER_SUM(:) + PLER(:)
-ZLEV_SUM(:) = ZLEV_SUM(:) + PLEV(:)
-ZLEI_SUM(:) = ZLEI_SUM(:) + PLEI(:)
+!
ZLES3L_SUM(:) = ZLES3L_SUM(:) + ZLES3L(:)
ZLEL3L_SUM(:) = ZLEL3L_SUM(:) + ZLEL3L(:)
-ZEVAP3L_SUM(:) = ZEVAP3L_SUM(:) + ZEVAP3L(:)
-ZEVAP_SUM(:) = ZEVAP_SUM(:) + PEVAP(:)
+ZEVAP3L_SUM(:) = ZEVAP3L_SUM(:) + ZEVAP3L(:)
!
ZHU_AGG_SUM(:) = ZHU_AGG_SUM(:) + PHU_AGG(:)
ZAC_AGG_SUM(:) = ZAC_AGG_SUM(:) + PAC_AGG(:)
!
! momentum/turb:
!
+ZCDSNOW_SUM(:) = ZCDSNOW_SUM(:) + DMK%XCDSNOW(:)
+ZCHSNOW_SUM(:) = ZCHSNOW_SUM(:) + DMK%XCHSNOW(:)
+!
ZUSTAR2_SUM(:) = ZUSTAR2_SUM(:) + ZUSTAR2_IC(:)
ZUSTAR2SNOW_SUM(:) = ZUSTAR2SNOW_SUM(:) + ZUSTAR2SNOW(:)
-ZCDSNOW_SUM(:) = ZCDSNOW_SUM(:) + PCDSNOW(:)
-ZCHSNOW_SUM(:) = ZCHSNOW_SUM(:) + PCHSNOW(:)
ZRISNOW_SUM(:) = ZRISNOW_SUM(:) + PRISNOW(:)
!
! surface interfacial/sub-surface heat fluxes:
!
ZGRNDFLUX_SUM(:) = ZGRNDFLUX_SUM(:) + PGRNDFLUX(:)
-ZRESTORE_SUM(:) = ZRESTORE_SUM(:) + PRESTORE(:)
-ZHPSNOW_SUM(:) = ZHPSNOW_SUM(:) + PHPSNOW(:)
+!
+ZRESTORE_SUM(:) = ZRESTORE_SUM(:) + DEK%XRESTORE(:)
+!
+ZHPSNOW_SUM(:) = ZHPSNOW_SUM(:) + DMK%XHPSNOW(:)
!
! radiative fluxes:
!
-ZSWNET_V_SUM(:) = ZSWNET_V_SUM(:) + PSWNET_V(:)
-ZSWNET_G_SUM(:) = ZSWNET_G_SUM(:) + PSWNET_G(:)
-ZSWNET_N_SUM(:) = ZSWNET_N_SUM(:) + PSWNET_N(:)
-ZLWNET_V_SUM(:) = ZLWNET_V_SUM(:) + PLWNET_V(:)
-ZLWNET_G_SUM(:) = ZLWNET_G_SUM(:) + PLWNET_G(:)
-ZLWNET_N_SUM(:) = ZLWNET_N_SUM(:) + PLWNET_N(:)
+ZSWNET_V_SUM(:) = ZSWNET_V_SUM(:) + DEK%XSWNET_V(:)
+ZSWNET_G_SUM(:) = ZSWNET_G_SUM(:) + DEK%XSWNET_G(:)
+ZSWNET_N_SUM(:) = ZSWNET_N_SUM(:) + DEK%XSWNET_N(:)
+ZLWNET_V_SUM(:) = ZLWNET_V_SUM(:) + DEK%XLWNET_V(:)
+ZLWNET_G_SUM(:) = ZLWNET_G_SUM(:) + DEK%XLWNET_G(:)
+ZLWNET_N_SUM(:) = ZLWNET_N_SUM(:) + DEK%XLWNET_N(:)
+!
ZEMIST_SUM(:) = ZEMIST_SUM(:) + PEMIST(:)
ZSWUP_SUM(:) = ZSWUP_SUM(:) + ZSWUP(:)
ZLWUP_SUM(:) = ZLWUP_SUM(:) + ZLWUP(:)
@@ -1430,64 +1185,77 @@ IF (LHOOK) CALL DR_HOOK('ISBA_MEB:AVG_FLUXES_MEB_TSPLIT ',0,ZHOOK_HANDLE)
!
! sensible heat fluxes:
!
-PH(:) = ZH_SUM(:) /JTSPLIT_EB
-PH_C_A(:) = ZH_C_A_SUM(:) /JTSPLIT_EB
-ZH_N_A(:) = ZH_N_A_SUM(:) /JTSPLIT_EB
-PH_V_C(:) = ZH_V_C_SUM(:) /JTSPLIT_EB
-PH_G_C(:) = ZH_G_C_SUM(:) /JTSPLIT_EB
-PH_N_C(:) = ZH_N_C_SUM(:) /JTSPLIT_EB
-PHSNOW(:) = ZHSNOW_SUM(:) /JTSPLIT_EB
+ZH_N_A(:) = ZH_N_A_SUM(:) /JTSPLIT_EB
+!
+DK%XH(:) = ZH_SUM(:) /JTSPLIT_EB
+!
+DEK%XH_CA(:) = ZH_CA_SUM(:) /JTSPLIT_EB
+DEK%XH_CV(:) = ZH_CV_SUM(:) /JTSPLIT_EB
+DEK%XH_GV(:) = ZH_GV_SUM(:) /JTSPLIT_EB
+DEK%XH_GN(:) = ZH_GN_SUM(:) /JTSPLIT_EB
+!
+DMK%XHSNOW(:) = ZHSNOW_SUM(:) /JTSPLIT_EB
!
! latent heat/water vapor fluxes:
!
-PLE(:) = ZLE_SUM(:) /JTSPLIT_EB
-PLE_C_A(:) = ZLE_C_A_SUM(:) /JTSPLIT_EB
-PLE_V_C(:) = ZLE_V_C_SUM(:) /JTSPLIT_EB
-PLE_G_C(:) = ZLE_G_C_SUM(:) /JTSPLIT_EB
-PLE_N_C(:) = ZLE_N_C_SUM(:) /JTSPLIT_EB
-PLETR_V_C(:) = ZLETR_V_C_SUM(:) /JTSPLIT_EB
-PLEG(:) = ZLEG_SUM(:) /JTSPLIT_EB
-PLEGI(:) = ZLEGI_SUM(:) /JTSPLIT_EB
-ZLESFC(:) = ZLESFC_SUM(:) /JTSPLIT_EB
-ZLESFCI(:) = ZLESFCI_SUM(:) /JTSPLIT_EB
-PLER_V_C(:) = ZLER_V_C_SUM(:) /JTSPLIT_EB
-PLE_FLOOD(:) = ZLE_FLOOD_SUM(:) /JTSPLIT_EB
-PLEI_FLOOD(:)= ZLEI_FLOOD_SUM(:)/JTSPLIT_EB
-PLES_V_C(:) = ZLES_V_C_SUM(:) /JTSPLIT_EB
-PLETR(:) = ZLETR_SUM(:) /JTSPLIT_EB
-PLER(:) = ZLER_SUM(:) /JTSPLIT_EB
-PLEV(:) = ZLEV_SUM(:) /JTSPLIT_EB
-PLEI(:) = ZLEI_SUM(:) /JTSPLIT_EB
-PLES(:) = ZLES3L_SUM(:) /JTSPLIT_EB
-PLESL(:) = ZLEL3L_SUM(:) /JTSPLIT_EB
-ZEVAP3L(:) = ZEVAP3L_SUM(:) /JTSPLIT_EB
-PEVAP(:) = ZEVAP_SUM(:) /JTSPLIT_EB
+ZLESFC(:) = ZLESFC_SUM(:) /JTSPLIT_EB
+ZLESFCI(:) = ZLESFCI_SUM(:) /JTSPLIT_EB
+!
+DK%XLEI(:) = ZLEI_SUM(:) /JTSPLIT_EB
+DK%XEVAP(:) = ZEVAP_SUM(:) /JTSPLIT_EB
+!
+PEK%XLE(:) = ZLE_SUM(:) /JTSPLIT_EB
+!
+DEK%XLE_CA(:) = ZLE_CA_SUM(:) /JTSPLIT_EB
+DEK%XLE_CV(:) = ZLE_CV_SUM(:) /JTSPLIT_EB
+DEK%XLE_GV(:) = ZLE_GV_SUM(:) /JTSPLIT_EB
+DEK%XLE_GN(:) = ZLE_GN_SUM(:) /JTSPLIT_EB
+!
+DEK%XLETR_CV(:) = ZLETR_CV_SUM(:) /JTSPLIT_EB
+DEK%XLER_CV(:) = ZLER_CV_SUM(:) /JTSPLIT_EB
+DEK%XLES_CV(:) = ZLES_CV_SUM(:) /JTSPLIT_EB
+!
+DEK%XLETR(:) = ZLETR_SUM(:) /JTSPLIT_EB
+DEK%XLER(:) = ZLER_SUM(:) /JTSPLIT_EB
+DEK%XLEV(:) = ZLEV_SUM(:) /JTSPLIT_EB
+!
+DEK%XLEG(:) = ZLEG_SUM(:) /JTSPLIT_EB
+DEK%XLEGI(:) = ZLEGI_SUM(:) /JTSPLIT_EB
+DEK%XLE_FLOOD(:) = ZLE_FLOOD_SUM(:) /JTSPLIT_EB
+DEK%XLEI_FLOOD(:) = ZLEI_FLOOD_SUM(:)/JTSPLIT_EB
+DEK%XLES(:) = ZLES3L_SUM(:) /JTSPLIT_EB
+DEK%XLESL(:) = ZLEL3L_SUM(:) /JTSPLIT_EB
+!
+ZEVAP3L(:) = ZEVAP3L_SUM(:) /JTSPLIT_EB
!
PHU_AGG(:) = ZHU_AGG_SUM(:) /JTSPLIT_EB
PAC_AGG(:) = ZAC_AGG_SUM(:) /JTSPLIT_EB
!
! momentum/turb:
!
-PUSTAR(:) = SQRT( ZUSTAR2_SUM(:) /JTSPLIT_EB )
-PUSTARSNOW(:) = SQRT( ZUSTAR2SNOW_SUM(:)/JTSPLIT_EB )
-PCDSNOW(:) = ZCDSNOW_SUM(:) /JTSPLIT_EB
-PCHSNOW(:) = ZCHSNOW_SUM(:) /JTSPLIT_EB
-PRISNOW(:) = ZRISNOW_SUM(:) /JTSPLIT_EB
+PUSTAR(:) = SQRT( ZUSTAR2_SUM(:) /JTSPLIT_EB )
+PRISNOW(:) = ZRISNOW_SUM(:) /JTSPLIT_EB
+!
+DMK%XUSTARSNOW(:) = SQRT( ZUSTAR2SNOW_SUM(:)/JTSPLIT_EB )
+DMK%XCDSNOW(:) = ZCDSNOW_SUM(:) /JTSPLIT_EB
+DMK%XCHSNOW(:) = ZCHSNOW_SUM(:) /JTSPLIT_EB
!
! surface interfacial/sub-surface heat fluxes:
!
-PGRNDFLUX(:) = ZGRNDFLUX_SUM(:) /JTSPLIT_EB
-PRESTORE(:) = ZRESTORE_SUM(:) /JTSPLIT_EB
-PHPSNOW(:) = ZHPSNOW_SUM(:) /JTSPLIT_EB
+PGRNDFLUX(:) = ZGRNDFLUX_SUM(:) /JTSPLIT_EB
+!
+DEK%XRESTORE(:) = ZRESTORE_SUM(:) /JTSPLIT_EB
+DMK%XHPSNOW(:) = ZHPSNOW_SUM(:) /JTSPLIT_EB
!
! radiative fluxes:
!
-PSWNET_V(:) = ZSWNET_V_SUM(:) /JTSPLIT_EB
-PSWNET_G(:) = ZSWNET_G_SUM(:) /JTSPLIT_EB
-PSWNET_N(:) = ZSWNET_N_SUM(:) /JTSPLIT_EB
-PLWNET_V(:) = ZLWNET_V_SUM(:) /JTSPLIT_EB
-PLWNET_G(:) = ZLWNET_G_SUM(:) /JTSPLIT_EB
-PLWNET_N(:) = ZLWNET_N_SUM(:) /JTSPLIT_EB
+DEK%XSWNET_V(:) = ZSWNET_V_SUM(:) /JTSPLIT_EB
+DEK%XSWNET_G(:) = ZSWNET_G_SUM(:) /JTSPLIT_EB
+DEK%XSWNET_N(:) = ZSWNET_N_SUM(:) /JTSPLIT_EB
+DEK%XLWNET_V(:) = ZLWNET_V_SUM(:) /JTSPLIT_EB
+DEK%XLWNET_G(:) = ZLWNET_G_SUM(:) /JTSPLIT_EB
+DEK%XLWNET_N(:) = ZLWNET_N_SUM(:) /JTSPLIT_EB
+!
PEMIST(:) = ZEMIST_SUM(:) /JTSPLIT_EB
ZSWUP(:) = ZSWUP_SUM(:) /JTSPLIT_EB
ZLWUP(:) = ZLWUP_SUM(:) /JTSPLIT_EB
@@ -1498,27 +1266,25 @@ PDELHEATG(:) = ZDELHEATG_SUM(:) /JTSPLIT_EB
!
! Additional diagnostics depending on AVG quantities:
!
-PTS_RAD(:) = ((ZLWUP(:) - PLW_RAD(:)*(1.0-PEMIST(:)))/(XSTEFAN*PEMIST(:)))**0.25
+DK%XTSRAD(:) = ((ZLWUP(:) - PLW_RAD(:)*(1.0-PEMIST(:)))/(XSTEFAN*PEMIST(:)))**0.25
!
-ZRNET_V(:) = PSWNET_V(:) + PLWNET_V(:)
+ZRNET_V(:) = DEK%XSWNET_V(:) + DEK%XLWNET_V(:)
!
-ZRNET_G(:) = PSWNET_G(:) + PLWNET_G(:)
+ZRNET_G(:) = DEK%XSWNET_G(:) + DEK%XLWNET_G(:)
!
-PRNSNOW(:) = PSWNET_N(:) + PLWNET_N(:)
+DMK%XRNSNOW(:) = DEK%XSWNET_N(:) + DEK%XLWNET_N(:)
!
-PRN(:) = ZRNET_V(:) + ZRNET_G(:) + PRNSNOW(:)
+DK%XRN(:) = ZRNET_V(:) + ZRNET_G(:) + DMK%XRNSNOW(:)
!
-PLEV_V_C(:) = PLE_V_C(:) - PLES_V_C(:)
+DEK%XLEV_CV(:) = DEK%XLE_CV(:) - DEK%XLES_CV(:)
!
IF (LHOOK) CALL DR_HOOK('ISBA_MEB:AVG_FLUXES_MEB_TSPLIT ',1,ZHOOK_HANDLE)
!
END SUBROUTINE AVG_FLUXES_MEB_TSPLIT
!
!===============================================================================
-SUBROUTINE SNOWALB_SPECTRAL_BANDS_MEB(PVEGTYPE,PSNOWALB,PSNOWRHO,PSNOWAGE,PPS, &
- PPSN,PSNOWDZ,PZENITH, &
- PSNOWALBVIS,PSNOWALBNIR,PSNOWALBFIR, &
- PTAU_N)
+SUBROUTINE SNOWALB_SPECTRAL_BANDS_MEB(PVEGTYPE,PEK,PSNOWRHO,PSNOWAGE,PPS, &
+ PSNOWDZ,PZENITH,PTAU_N)
!
! Split Total snow albedo into N-spectral bands
! NOTE currently MEB only uses 2 bands of the 3 possible.
@@ -1535,22 +1301,18 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE ! fraction of each vegetation (-)
-REAL, DIMENSION(:), INTENT(IN) :: PSNOWALB ! Snow albedo (total)
REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWRHO ! Snow layer average density (kg/m3)
REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWDZ ! Snow layer thickness (m)
REAL, DIMENSION(:), INTENT(IN) :: PZENITH ! Zenith angle (rad)
-REAL, DIMENSION(:), INTENT(IN) :: PPSN ! snow fraction (-)
REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWAGE ! Snow grain age
REAL, DIMENSION(:), INTENT(IN) :: PPS ! Pressure [Pa]
-REAL, DIMENSION(:), INTENT(OUT) :: PSNOWALBVIS ! Snow VIS albedo
-REAL, DIMENSION(:), INTENT(OUT) :: PSNOWALBNIR ! Snow NIR albedo
-REAL, DIMENSION(:), INTENT(OUT) :: PSNOWALBFIR ! Snow FIR (UV) albedo
REAL, DIMENSION(:,:), INTENT(OUT) :: PTAU_N ! SW absorption (coef) in uppermost snow layer (-)
!
!* 0.2 declarations of local variables
!
-INTEGER :: JJ, JI, INI, INLVLS
+INTEGER :: JJ, JI, INJ, INLVLS
REAL, DIMENSION(SIZE(PPS)) :: ZWORK, ZWORKA, ZAGE
REAL, DIMENSION(SIZE(PPS)) :: ZPROJLAT, ZDSGRAIN, ZBETA1, ZBETA2, ZBETA3, &
ZOPTICALPATH1, ZOPTICALPATH2, ZOPTICALPATH3
@@ -1567,45 +1329,45 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('ISBA_MEB:SNOWALB_SPECTRAL_BANDS_MEB',0,ZHOOK_HANDLE)
!
-INI = SIZE(PSNOWDZ,1)
+INJ = SIZE(PSNOWDZ,1)
INLVLS = SIZE(PSNOWDZ,2)
!
! 1) Spectral albedo
! ------------------
!
ZWORK(:) = 0.0
-ZWORKA(:) = PSNOWALB(:)
+ZWORKA(:) = PEK%TSNOW%ALB(:)
ZPERMSNOWFRAC(:) = PVEGTYPE(:,NVT_SNOW)
!
- CALL SNOW3LALB(ZWORKA,ZSPECTRALALBEDO,PSNOWRHO(:,1),PSNOWAGE(:,1),ZPERMSNOWFRAC,PPS)
+CALL SNOW3LALB(ZWORKA,ZSPECTRALALBEDO,PSNOWRHO(:,1),PSNOWAGE(:,1),ZPERMSNOWFRAC,PPS)
!
! Since we only consider VIS and NIR bands for soil and veg in MEB currently:
! (also note, here PSNOWALB doesn't evolve...we just diagnose spectral components).
!
-WHERE(PSNOWALB(:)/=XUNDEF)
+WHERE(PEK%TSNOW%ALB(:)/=XUNDEF)
!
- PSNOWALBVIS(:) = ZSPECTRALALBEDO(:,1)
+ PEK%TSNOW%ALBVIS(:) = ZSPECTRALALBEDO(:,1)
!
! We diagnose NIR albedo such that total albedo is conserved
! (using just 2 spectral bands in MEB)
!
- PSNOWALBNIR(:) = (PSNOWALB(:) - XSW_WGHT_VIS*PSNOWALBVIS(:))/XSW_WGHT_NIR
+ PEK%TSNOW%ALBNIR(:) = (PEK%TSNOW%ALB(:) - XSW_WGHT_VIS*PEK%TSNOW%ALBVIS(:))/XSW_WGHT_NIR
!
! currently NOT used by MEB
!
- PSNOWALBFIR(:) = XUNDEF
+ PEK%TSNOW%ALBFIR(:) = XUNDEF
!
! For the surface layer absorbtion computation:
!
- ZSPECTRALALBEDO(:,1) = PSNOWALBVIS(:)
- ZSPECTRALALBEDO(:,2) = PSNOWALBNIR(:)
- ZSPECTRALALBEDO(:,3) = PSNOWALBFIR(:)
+ ZSPECTRALALBEDO(:,1) = PEK%TSNOW%ALBVIS(:)
+ ZSPECTRALALBEDO(:,2) = PEK%TSNOW%ALBNIR(:)
+ ZSPECTRALALBEDO(:,3) = PEK%TSNOW%ALBFIR(:)
!
ELSEWHERE
!
- PSNOWALBVIS(:) = XUNDEF
- PSNOWALBNIR(:) = XUNDEF
- PSNOWALBFIR(:) = XUNDEF
+ PEK%TSNOW%ALBVIS(:) = XUNDEF
+ PEK%TSNOW%ALBNIR(:) = XUNDEF
+ PEK%TSNOW%ALBFIR(:) = XUNDEF
!
END WHERE
!
@@ -1619,26 +1381,32 @@ ZDSGRAIN(:) = SNOW3LDOPT(PSNOWRHO(:,1),ZAGE)
! ----------------------------------------
! For now, consider just 2 bands with MEB, so renormalize:
-ZSPECTRALALBEDO(:,1) = ZSPECTRALALBEDO(:,1)
-ZSPECTRALALBEDO(:,2) = (PSNOWALB(:) - XSW_WGHT_VIS*ZSPECTRALALBEDO(:,1))/XSW_WGHT_NIR
+ZSPECTRALALBEDO(:,2) = (PEK%TSNOW%ALB(:) - XSW_WGHT_VIS*ZSPECTRALALBEDO(:,1))/XSW_WGHT_NIR
+ZSPECTRALALBEDO(:,3) = XUNDEF
!
! Adjust thickness to be as in snow computations:
!
DO JJ=1,INLVLS
- DO JI=1,INI
- ZSNOWDZ(JI,JJ) = PSNOWDZ(JI,JJ)/MAX(1.E-4,PPSN(JI))
+ DO JI=1,INJ
+ ZSNOWDZ(JI,JJ) = PSNOWDZ(JI,JJ)/MAX(1.E-4,PEK%XPSN(JI))
ENDDO
ENDDO
!
- CALL SNOW3LRADTRANS(XSNOWDZMIN, ZSPECTRALALBEDO, ZSNOWDZ, PSNOWRHO, &
+CALL SNOW3LRADTRANS(XSNOWDZMIN, ZSPECTRALALBEDO, ZSNOWDZ, PSNOWRHO, &
ZPERMSNOWFRAC, PZENITH, PSNOWAGE, PTAU_N)
!
+! Note that because we force a snow thickness to compute tramission,
+! a bogus value ( < 0) can be computed despite the non-estance of snow.
+! To check/prevent any problems, simply make a simple check:
+!
+PTAU_N(:,:) = MAX(0., PTAU_N(:,:))
+!
IF (LHOOK) CALL DR_HOOK('ISBA_MEB:SNOWALB_SPECTRAL_BANDS_MEB',1,ZHOOK_HANDLE)
!
END SUBROUTINE SNOWALB_SPECTRAL_BANDS_MEB
!===============================================================================
SUBROUTINE SNOW3LRADTRANS(PSNOWDZMIN, PSPECTRALALBEDO, PSNOWDZ, PSNOWRHO, &
- PPERMSNOWFRAC, PZENITH, PSNOWAGE, PRADTRANS)
+ PPERMSNOWFRAC, PZENITH, PSNOWAGE, PRADTRANS)
!
!! PURPOSE
!! -------
@@ -1647,11 +1415,9 @@ END SUBROUTINE SNOWALB_SPECTRAL_BANDS_MEB
! decay of radiation with increasing snow depth).
!
USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_SNOW_PAR, ONLY : XVSPEC1,XVSPEC2,XVSPEC3,XVBETA1,XVBETA2, &
- XVBETA4,XVBETA3,XVBETA5, XMINCOSZEN
USE MODD_MEB_PAR, ONLY : XSW_WGHT_VIS, XSW_WGHT_NIR
!
-USE MODE_SNOW3L, ONLY : SNOW3LDOPT
+USE MODE_SNOW3L, ONLY : SNOW3LDOPT, SNOW3LRADABS_SFC
!
IMPLICIT NONE
!
@@ -1671,14 +1437,10 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PRADTRANS
!
INTEGER :: JJ, JI
!
-INTEGER :: INI
+INTEGER :: INJ
INTEGER :: INLVLS
!
-REAL, DIMENSION(SIZE(PSNOWRHO,1)) :: ZRADTOT, ZPROJLAT, ZCOSZEN
-REAL, DIMENSION(SIZE(PSNOWRHO,1)) :: ZOPTICALPATH1, ZOPTICALPATH2, ZOPTICALPATH3
-!
REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZDSGRAIN, ZCOEF, ZSNOWDZ, ZAGE
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZBETA1, ZBETA2, ZBETA3, ZWORK
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
@@ -1688,7 +1450,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('SNOW3LRADTRANS',0,ZHOOK_HANDLE)
!
-INI = SIZE(PSNOWDZ(:,:),1)
+INJ = SIZE(PSNOWDZ(:,:),1)
INLVLS = SIZE(PSNOWDZ(:,:),2)
!
!
@@ -1709,22 +1471,11 @@ ZSNOWDZ(:,:) = MAX(PSNOWDZMIN, PSNOWDZ(:,:))
! SNOWCVEXT => from Bohren and Barkstrom 1974
! SNOWAGRAIN and SNOWBGRAIN=> from Jordan 1976)
!
-! Coefficient for taking into account the increase of path length of rays
-! in snow due to zenithal angle
-!
-ZCOSZEN(:)=MAX(XMINCOSZEN,COS(PZENITH(:)))
-!
-! This formulation is incorrect but it compensate partly the fact that
-! the albedo formulation does not account for zenithal angle.
-! Only for polar or glacier regions
-!
-ZPROJLAT(:)=(1.0-PPERMSNOWFRAC(:))+PPERMSNOWFRAC(:)/ZCOSZEN(:)
-!
! Snow optical grain diameter (no age dependency over polar regions):
!
ZAGE(:,:) = 0.
DO JJ=1,INLVLS
- DO JI=1,INI
+ DO JI=1,INJ
IF(PSNOWAGE(JI,JJ)/=XUNDEF)THEN
ZAGE(JI,JJ) = (1.0-PPERMSNOWFRAC(JI))*PSNOWAGE(JI,JJ)
ENDIF
@@ -1733,29 +1484,8 @@ ENDDO
!
ZDSGRAIN(:,:) = SNOW3LDOPT(PSNOWRHO,ZAGE)
!
-! Extinction coefficient from Brun et al. (1989):
-!
-ZWORK(:,:)=SQRT(ZDSGRAIN(:,:))
-!
-ZBETA1(:,:)=MAX(XVBETA1*PSNOWRHO(:,:)/ZWORK(:,:),XVBETA2)
-ZBETA2(:,:)=MAX(XVBETA3*PSNOWRHO(:,:)/ZWORK(:,:),XVBETA4)
-ZBETA3(:,:)=XVBETA5
-!
-ZOPTICALPATH1(:) = 0.0
-ZOPTICALPATH2(:) = 0.0
-ZOPTICALPATH3(:) = 0.0
-!
-DO JJ=1,INLVLS
- DO JI=1,INI
- !
- ZOPTICALPATH1(JI) = ZOPTICALPATH1(JI) + ZBETA1(JI,JJ)*ZSNOWDZ(JI,JJ)
- ZOPTICALPATH2(JI) = ZOPTICALPATH2(JI) + ZBETA2(JI,JJ)*ZSNOWDZ(JI,JJ)
-
- ZCOEF (JI,JJ) = XSW_WGHT_VIS*(1.0-PSPECTRALALBEDO(JI,1))*EXP(-ZOPTICALPATH1(JI)*ZPROJLAT(JI)) &
- + XSW_WGHT_NIR*(1.0-PSPECTRALALBEDO(JI,2))*EXP(-ZOPTICALPATH2(JI)*ZPROJLAT(JI))
-
- ENDDO
-ENDDO
+ZCOEF(:,:) = SNOW3LRADABS_SFC(PSNOWRHO,ZSNOWDZ,PSPECTRALALBEDO, &
+ PZENITH,PPERMSNOWFRAC,ZDSGRAIN)
!
! 3. Radiation trans at base of each layer
! ----------------------------------
@@ -1769,6 +1499,7 @@ IF (LHOOK) CALL DR_HOOK('SNOW3LRADTRANS',1,ZHOOK_HANDLE)
!
END SUBROUTINE SNOW3LRADTRANS
!===============================================================================
+
SUBROUTINE ALLOCATE_LOCAL_VARS_PREP_GRID_SOIL
!
IMPLICIT NONE
@@ -1784,15 +1515,15 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('ISBA_MEB:ALLOCATE_LOCAL_VARS_PREP_GRID_SOIL ',0,ZHOOK_HANDLE)
INLL = INL
-IF(OMEB_LITTER)INLL = INL + 1
+IF(IO%LMEB_LITTER)INLL = INL + 1
-ALLOCATE ( ZTGL (INI, INLL ))
-ALLOCATE ( ZSOILHCAPZ (INI, INLL ))
-ALLOCATE ( ZSOILCONDZ (INI, INLL ))
-ALLOCATE ( ZD_G (INI, INLL ))
-ALLOCATE ( ZDZG (INI, INLL ))
-ALLOCATE ( ZWFC (INI, INLL ))
-ALLOCATE ( ZWSAT (INI, INLL ))
+ALLOCATE ( ZTGL (INJ, INLL ))
+ALLOCATE ( ZSOILHCAPZ (INJ, INLL ))
+ALLOCATE ( ZSOILCONDZ (INJ, INLL ))
+ALLOCATE ( ZD_G (INJ, INLL ))
+ALLOCATE ( ZDZG (INJ, INLL ))
+ALLOCATE ( ZWFC (INJ, INLL ))
+ALLOCATE ( ZWSAT (INJ, INLL ))
IF (LHOOK) CALL DR_HOOK('ISBA_MEB:ALLOCATE_LOCAL_VARS_PREP_GRID_SOIL ',1,ZHOOK_HANDLE)
@@ -1810,20 +1541,19 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('ISBA_MEB:DEALLOCATE_LOCAL_VARS_PREP_GRID_SOIL ',0,ZHOOK_HANDLE)
-DEALLOCATE ( ZTGL )
+DEALLOCATE ( ZTGL )
DEALLOCATE ( ZSOILHCAPZ )
DEALLOCATE ( ZSOILCONDZ )
DEALLOCATE ( ZD_G )
DEALLOCATE ( ZDZG )
-DEALLOCATE ( ZWSAT )
+DEALLOCATE ( ZWSAT )
DEALLOCATE ( ZWFC )
IF (LHOOK) CALL DR_HOOK('ISBA_MEB:DEALLOCATE_LOCAL_VARS_PREP_GRID_SOIL ',1,ZHOOK_HANDLE)
END SUBROUTINE DEALLOCATE_LOCAL_VARS_PREP_GRID_SOIL
!===============================================================================
-SUBROUTINE RESHIFT_MEB_SOIL(OMEB_LITTER,PTGL,PTL,PTG,PLESFC,PLESFCI, &
- PLEG,PLEGI,PLELITTER,PLELITTERI)
+SUBROUTINE RESHIFT_MEB_SOIL(OMEB_LITTER,PTGL,PLESFC,PLESFCI,PEK,DEK)
!
IMPLICIT NONE
!
@@ -1833,12 +1563,8 @@ LOGICAL, INTENT(IN) :: OMEB_LITTER
REAL, DIMENSION(:,:), INTENT(IN) :: PTGL
REAL, DIMENSION(:), INTENT(IN) :: PLESFC
REAL, DIMENSION(:), INTENT(IN) :: PLESFCI
-REAL, DIMENSION(:), INTENT(OUT) :: PLEG
-REAL, DIMENSION(:), INTENT(OUT) :: PLEGI
-REAL, DIMENSION(:), INTENT(OUT) :: PLELITTER
-REAL, DIMENSION(:), INTENT(OUT) :: PLELITTERI
-REAL, DIMENSION(:), INTENT(OUT) :: PTL
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTG
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK
!
!* 0.2 declarations of local variables
!
@@ -1848,33 +1574,33 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
-INI = SIZE(PTG,1)
-INL = SIZE(PTG,2)
+INJ = SIZE(PEK%XTG(:,:),1)
+INL = SIZE(PEK%XTG(:,:),2)
IF (LHOOK) CALL DR_HOOK('ISBA_MEB:FINISH_MEB_SOIL ',0,ZHOOK_HANDLE)
IF (OMEB_LITTER)THEN
- PTL(:) = PTGL(:,1)
+ PEK%XTL(:) = PTGL(:,1)
DO JL=1,INL
- DO JJ=1,INI
- PTG(JJ,JL) = PTGL(JJ,JL+1)
+ DO JJ=1,INJ
+ PEK%XTG(JJ,JL) = PTGL(JJ,JL+1)
ENDDO
ENDDO
- PLEG(:) = 0.0
- PLEGI(:) = 0.0
- PLELITTER(:) = PLESFC(:)
- PLELITTERI(:) = PLESFCI(:)
+ DEK%XLEG(:) = 0.0
+ DEK%XLEGI(:) = 0.0
+ DEK%XLELITTER(:) = PLESFC(:)
+ DEK%XLELITTERI(:) = PLESFCI(:)
ELSE
- PTG(:,:) = PTGL(:,:)
+ PEK%XTG(:,:) = PTGL(:,:)
- PLEG(:) = PLESFC(:)
- PLEGI(:) = PLESFCI(:)
- PLELITTER(:) = 0.
- PLELITTERI(:) = 0.
+ DEK%XLEG(:) = PLESFC(:)
+ DEK%XLEGI(:) = PLESFCI(:)
+ DEK%XLELITTER(:) = 0.
+ DEK%XLELITTERI(:) = 0.
ENDIF
@@ -1883,33 +1609,26 @@ IF (LHOOK) CALL DR_HOOK('ISBA_MEB:FINISH_MEB_SOIL ',1,ZHOOK_HANDLE)
END SUBROUTINE RESHIFT_MEB_SOIL
!===============================================================================
-SUBROUTINE PREP_MEB_SOIL(OMEB_LITTER,PSOILHCAPZ,PSOILCONDZ,PWSAT,PWFC,PD_G,PDZG,PTG,PWG,PWGI,PWRL,PWRLI, &
- PTL,PGNDLITTER,PD_GL,PDZGL,PTGL,PSOILHCAPL,PSOILCONDL,PWSATL,PWFCL,PWSFC,PWISFC,&
- PCTSFC,PCT,PFROZEN1,PFROZEN1SFC )
+SUBROUTINE PREP_MEB_SOIL(OMEB_LITTER,PSOILHCAPZ,PSOILCONDZ,KK,PK,PEK,PD_GL,&
+ PDZGL,PTGL,PSOILHCAPL,PSOILCONDL,PWSATL,PWFCL,PWSFC,&
+ PWISFC,PCTSFC,PCT,PFROZEN1,PFROZEN1SFC)
!
USE MODD_CSTS, ONLY : XRHOLW,XRHOLI, XCL, XCI
-USE MODD_ISBA_PAR, ONLY : XWGMIN, XOMSPH
+USE MODD_ISBA_PAR, ONLY : XWGMIN, XOMSPH
!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
LOGICAL, INTENT(IN) :: OMEB_LITTER
REAL, DIMENSION(:,:), INTENT(IN) :: PSOILHCAPZ
REAL, DIMENSION(:,:), INTENT(IN) :: PSOILCONDZ
-REAL, DIMENSION(:,:), INTENT(IN) :: PWSAT
-REAL, DIMENSION(:,:), INTENT(IN) :: PWFC
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_G
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZG
-REAL, DIMENSION(:,:), INTENT(IN) :: PTG
-REAL, DIMENSION(:), INTENT(IN) :: PWG
-REAL, DIMENSION(:), INTENT(IN) :: PWGI
+!
REAL, DIMENSION(:), INTENT(IN) :: PCT
-REAL, DIMENSION(:), INTENT(IN) :: PWRL
-REAL, DIMENSION(:), INTENT(IN) :: PWRLI
-REAL, DIMENSION(:), INTENT(IN) :: PTL
REAL, DIMENSION(:), INTENT(IN) :: PFROZEN1
-REAL, DIMENSION(:), INTENT(IN) :: PGNDLITTER
REAL, DIMENSION(:,:), INTENT(OUT) :: PD_GL
REAL, DIMENSION(:,:), INTENT(OUT) :: PDZGL
REAL, DIMENSION(:,:), INTENT(OUT) :: PTGL
@@ -1924,76 +1643,73 @@ REAL, DIMENSION(:), INTENT(OUT) :: PFROZEN1SFC
!
!* 0.2 declarations of local variables
!
-INTEGER :: INI, INL, JJ, JL
+INTEGER :: INJ, INL, JJ, JL
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.3 declarations of local parameters
!
REAL, PARAMETER :: Z1 = 45.0 !litter bulk density (kg/m3)
-REAL, PARAMETER :: Z2 = 0.1 !coeff for litter conductivity (K/m)
+REAL, PARAMETER :: Z2 = 0.1 !coeff for litter conductivity (W/(mK))
REAL, PARAMETER :: Z3 = 0.03 !coeff for litter conductivity
REAL, PARAMETER :: Z4 = 0.95 !litter porosity (m3/m3)
REAL, PARAMETER :: Z5 = 0.12 !litter field capacity (m3/m3)
!
-REAL, DIMENSION(SIZE(PWG)) :: ZWORK
+REAL, DIMENSION(SIZE(PEK%XWG,1)) :: ZWORK
!
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('ISBA_MEB:PREP_MEB_SOIL',0,ZHOOK_HANDLE)
!
-INI = SIZE(PTG,1)
-INL = SIZE(PTG,2)
+INJ = SIZE(PK%XDG,1)
+INL = SIZE(PK%XDG,2)
!
ZWORK(:) = 0.0
IF(OMEB_LITTER)THEN
- PTGL(:,1) = PTL(:)
- ZWORK(:) = PWRL(:)/(XRHOLW*PGNDLITTER(:))
- PSOILHCAPL(:,1) = XOMSPH*Z1 + (XCL*XRHOLW)*ZWORK(:) + (XCI*XRHOLI/XRHOLW)*PWRLI(:)/PGNDLITTER(:)
+ PTGL(:,1) = PEK%XTL(:)
+ ZWORK(:) = PEK%XWRL(:)/(XRHOLW*PEK%XGNDLITTER(:))
+ PSOILHCAPL(:,1) = XOMSPH*Z1 + (XCL*XRHOLW)*ZWORK(:) + (XCI*XRHOLI/XRHOLW)*PEK%XWRLI(:)/PEK%XGNDLITTER(:)
PSOILCONDL(:,1) = Z2 + Z3 * ZWORK(:)
PWSATL(:,1) = Z4
PWFCL(:,1) = Z5
- PD_GL(:,1) = PGNDLITTER(:)
- PDZGL(:,1) = PGNDLITTER(:)
- PCTSFC(:) = 1. / (PSOILHCAPL(:,1) * PGNDLITTER(:))
- PFROZEN1SFC(:) = PWRLI(:) / ( PWRLI(:) + MAX(PWRL(:), (XWGMIN*XRHOLW)*PGNDLITTER(:) ))
+ PD_GL(:,1) = PEK%XGNDLITTER(:)
+ PDZGL(:,1) = PEK%XGNDLITTER(:)
+ PCTSFC(:) = 1. / (PSOILHCAPL(:,1) * PEK%XGNDLITTER(:))
+ PFROZEN1SFC(:) = PEK%XWRLI(:) / ( PEK%XWRLI(:) + MAX(PEK%XWRL(:), (XWGMIN*XRHOLW)*PEK%XGNDLITTER(:) ))
DO JL=1,INL
- DO JJ=1,INI
- PTGL(JJ,JL+1) = PTG(JJ,JL)
+ DO JJ=1,INJ
+ PTGL(JJ,JL+1) = PEK%XTG(JJ,MIN(JL,SIZE(PEK%XTG,2)))
PSOILHCAPL(JJ,JL+1) = PSOILHCAPZ(JJ,JL)
PSOILCONDL(JJ,JL+1) = PSOILCONDZ(JJ,JL)
- PWSATL(JJ,JL+1) = PWSAT(JJ,JL)
- PWFCL(JJ,JL+1) = PWFC(JJ,JL)
- PD_GL(JJ,JL+1) = PGNDLITTER(JJ) + PD_G(JJ,JL)
- PDZGL(JJ,JL+1) = PDZG(JJ,JL)
+ PWSATL(JJ,JL+1) = KK%XWSAT(JJ,JL)
+ PWFCL(JJ,JL+1) = KK%XWFC(JJ,JL)
+ PD_GL(JJ,JL+1) = PEK%XGNDLITTER(JJ) + PK%XDG(JJ,JL)
+ PDZGL(JJ,JL+1) = PK%XDZG(JJ,JL)
ENDDO
ENDDO
- PWSFC(:) = PWRL(:) /(XRHOLW*PGNDLITTER(:)) ! (m3/m3)
- PWISFC(:) = PWRLI(:)/(XRHOLW*PGNDLITTER(:)) ! (m3/m3)
+ PWSFC(:) = PEK%XWRL(:) /(XRHOLW*PEK%XGNDLITTER(:)) ! (m3/m3)
+ PWISFC(:) = PEK%XWRLI(:)/(XRHOLW*PEK%XGNDLITTER(:)) ! (m3/m3)
ELSE
- PTGL(:,:) = PTG(:,:)
+ PTGL(:,:) = PEK%XTG(:,:)
PSOILHCAPL(:,:) = PSOILHCAPZ(:,:)
PSOILCONDL(:,:) = PSOILCONDZ(:,:)
- PWSATL(:,:) = PWSAT(:,:)
- PWFCL(:,:) = PWFC(:,:)
- PD_GL(:,:) = PD_G(:,:)
- PDZGL(:,:) = PDZG(:,:)
+ PWSATL(:,:) = KK%XWSAT(:,:)
+ PWFCL(:,:) = KK%XWFC(:,:)
+ PD_GL(:,:) = PK%XDG(:,:)
+ PDZGL(:,:) = PK%XDZG(:,:)
PCTSFC(:) = PCT(:)
- PWSFC(:) = PWG(:)
- PWISFC(:) = PWGI(:)
- PFROZEN1SFC(:) = PFROZEN1(:)
+ PWSFC(:) = PEK%XWG(:,1)
+ PWISFC(:) = PEK%XWGI(:,1)
+ PFROZEN1SFC(:) = PFROZEN1(:)
ENDIF
IF (LHOOK) CALL DR_HOOK('ISBA_MEB:PREP_MEB_SOIL',1,ZHOOK_HANDLE)
END SUBROUTINE PREP_MEB_SOIL
!===============================================================================
-SUBROUTINE ICE_LITTER(PTSTEP, PLELITTERI, &
- PSOILHCAPZ, &
- PTG, PTL, PWGI, PWG, KWG_LAYER, &
- PDZG,PWRL,PWRLI,PGNDLITTER,PPHASEL, &
- PCTSFC,PLSTT,PLITCOR)
+SUBROUTINE ICE_LITTER(PTSTEP, PLELITTERI, PSOILHCAPZ, PEK, &
+ KWG_LAYER, PDZG, PPHASEL, PCTSFC, PLSTT, PLITCOR )
!
USE MODD_CSTS, ONLY : XLMTT, XTT, XCI, XRHOLI, XRHOLW
!
@@ -2001,6 +1717,7 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
REAL, INTENT(IN) :: PTSTEP
! PTSTEP = Model time step (s)
!
@@ -2009,20 +1726,10 @@ REAL, DIMENSION(:), INTENT(IN) :: PLELITTERI
REAL, DIMENSION(:), INTENT(IN) :: PCTSFC
REAL, DIMENSION(:), INTENT(IN) :: PLSTT
!
-REAL, DIMENSION(:), INTENT(INOUT) :: PTL, PWRL, PWRLI
-! PTL = litter temperature (K)
-! PWRL = litter water content (kg/m2)
-! PWRLI = litter ice content (kg/m2)
REAL, DIMENSION(:,:), INTENT(IN) :: PSOILHCAPZ
! PSOILHCAPZ = soil heat capacity [J/(m3 K)]
REAL, DIMENSION(:,:), INTENT(IN) :: PDZG
! PDZG = Layer thickness (DIF option)
-REAL, DIMENSION(:), INTENT(IN) :: PGNDLITTER
-! PGNDLITTER = Litter thickness (m)
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTG, PWGI, PWG
-! PTG = soil temperature (K)
-! PWGI = soil volumetric ice content (m3/m3)
-! PWG = soil volumetric liquid water content (m3/m3)
!
INTEGER, DIMENSION(:), INTENT(IN) :: KWG_LAYER
! KWG_LAYER = Number of soil moisture layers (DIF option)
@@ -2039,7 +1746,7 @@ INTEGER :: JL ! loop control
!
INTEGER :: INL ! Number of explicit soil layers
!
-REAL, DIMENSION(SIZE(PTG,1)) :: ZEXCESS, ZK, ZHCAPL,ZELITTERI, &
+REAL, DIMENSION(SIZE(PEK%XTG,1)) :: ZEXCESS, ZK, ZHCAPL,ZELITTERI, &
ZDELTAT,ZPHASE,ZPHASEM,ZPHASEF,ZPHASEX, &
ZWRL,ZWRLI,Z0,ZPHASEC
!
@@ -2055,19 +1762,22 @@ REAL, PARAMETER :: ZWRLSAT = 0.85 ! (m3/m3) litter poros
!
!-------------------------------------------------------------------------------
!
-IF (LHOOK) CALL DR_HOOK('ISBA_MEB:ICE_LITTER',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('ISBA_MEB:ICE_LITTER',0,ZHOOK_HANDLE)
!
! Initialization:
! ---------------
!
-!
-INL = MAXVAL(KWG_LAYER(:))
+IF (SIZE(KWG_LAYER)>0) THEN
+ INL = MAXVAL(KWG_LAYER(:))
+ELSE
+ INL = SIZE(PEK%XWG,2)
+ENDIF
!
ZEXCESS(:) = 0.0
ZPHASEC(:) = 0.0
-PLITCOR (:) = 0.0
+PLITCOR(:) = 0.0
!
-ZHCAPL(:) = 1/(PCTSFC(:)*PGNDLITTER(:))
+ZHCAPL(:) = 1/(PCTSFC(:)*PEK%XGNDLITTER(:))
!
!-------------------------------------------------------------------------------
!
@@ -2077,33 +1787,30 @@ ZHCAPL(:) = 1/(PCTSFC(:)*PGNDLITTER(:))
! 1.1 Convert to m3/m3
! -----------------
!
-ZWRL(:) = PWRL(:) /(XRHOLW*PGNDLITTER(:))
-ZWRLI(:) = PWRLI(:)/(XRHOLW*PGNDLITTER(:))
+ZWRL(:)= PEK%XWRL(:) /(XRHOLW*PEK%XGNDLITTER(:))
+ZWRLI(:)=PEK%XWRLI(:)/(XRHOLW*PEK%XGNDLITTER(:))
!
! 2. Litter ice evolution computation:
! --------------------------------
!
-ZDELTAT(:) = PTL(:) - XTT
+ZDELTAT(:) = PEK%XTL(:) - XTT
!
!
! *Melt* ice if energy and ice available:
-!
-ZPHASEM(:) = (PTSTEP/ZTAUICE)*MIN((XCI*XRHOLI)*MAX(0.0,ZDELTAT(:)),ZWRLI(:)*(XLMTT*XRHOLW))
+ZPHASEM(:) = (PTSTEP/ZTAUICE)*MIN((XCI*XRHOLI)*MAX(0.0,ZDELTAT),ZWRLI(:)*(XLMTT*XRHOLW))
!
! *Freeze* liquid water if energy and water available and do not exceed porosity:
+ZPHASEF(:) = (PTSTEP/ZTAUICE)*MIN((XCI*XRHOLI)*MAX(0.0,-ZDELTAT),ZWRL(:)*(XLMTT*XRHOLW))
+ZPHASEF(:) = min(ZPHASEF(:) , (ZWRLSAT - ZWRLI(:)) * (XLMTT*XRHOLW) ) !!!!! LOOK!!!!!!!!
!
-ZPHASEF(:) = (PTSTEP/ZTAUICE)*MIN((XCI*XRHOLI)*MAX(0.0,-ZDELTAT(:)),ZWRL(:)*(XLMTT*XRHOLW))
-ZPHASEF(:) = min(ZPHASEF(:) , (ZWRLSAT - ZWRLI(:)) * (XLMTT*XRHOLW) )
-!
-ZPHASE(:) = ZPHASEF(:) - ZPHASEM(:)
+ZPHASE(:) = ZPHASEF(:) - ZPHASEM(:)
! Update heat content if melting or freezing
-!
-PTL(:) = PTL(:) + ZPHASE(:)/ZHCAPL(:)
+PEK%XTL(:) = PEK%XTL(:) + ZPHASE(:)/ZHCAPL(:)
!
! Get estimate of actual total phase change (J/m3) for equivalent litter water changes:
-ZPHASEX(:) = ZPHASE(:)
+ZPHASEX(:) = ZPHASE(:)
!
! Adjust ice and liquid water conents (m3/m3) accordingly :
!
@@ -2113,52 +1820,51 @@ ZWRLI(:) = ZWRLI(:) + ZPHASEX/(XLMTT*XRHOLW)
! 2.1 Convert to Kg/m2
! -----------------
!
-PWRL(:) = ZWRL(:) * PGNDLITTER(:) * XRHOLW
-PWRLI(:)= ZWRLI(:) * PGNDLITTER(:) * XRHOLW
+PEK%XWRL(:) = ZWRL(:) * PEK%XGNDLITTER(:) * XRHOLW
+PEK%XWRLI(:)= ZWRLI(:) * PEK%XGNDLITTER(:) * XRHOLW
!
! 3. Adjust litter ice content for sublimation
! -----------------------------------------
-!
-!
-ZELITTERI(:) = PLELITTERI(:) * (PTSTEP/PLSTT)
-ZEXCESS(:) = MAX( 0.0 , ZELITTERI(:) - PWRLI(:) )
-PLITCOR=ZEXCESS/PTSTEP
-PWRLI (:) = PWRLI(:) - ( ZELITTERI(:) - ZEXCESS(:) )
+!
+ZELITTERI = PLELITTERI(:) * (PTSTEP/PLSTT(:))
+ZEXCESS(:) = MAX( 0.0 , ZELITTERI - PEK%XWRLI(:) )
+PLITCOR = ZEXCESS / PTSTEP
+PEK%XWRLI(:) = PEK%XWRLI(:) - ( ZELITTERI - ZEXCESS )
!
! 4. Prevent some possible problems
! ------------------------------
!
-PWGI (:,1) = PWGI(:,1)- ZEXCESS(:) / (XRHOLW * PDZG(:,1))
+PEK%XWGI (:,1) = PEK%XWGI(:,1)- ZEXCESS / (XRHOLW * PDZG(:,1))
!
-ZEXCESS(:) = MAX( 0.0, - PWGI(:,1) )
-PWGI(:,1) = PWGI(:,1) + ZEXCESS(:)
-PWG (:,1) = PWG (:,1) - ZEXCESS(:)
-PTG (:,1) = PTG (:,1) + ZEXCESS(:) * (XLMTT*XRHOLW)/PSOILHCAPZ(:,1)
+ZEXCESS(:) = MAX( 0.0, - PEK%XWGI(:,1) )
+PEK%XWGI(:,1) = PEK%XWGI(:,1) + ZEXCESS(:)
+PEK%XWG (:,1) = PEK%XWG (:,1) - ZEXCESS(:)
+PEK%XTG (:,1) = PEK%XTG (:,1) + ZEXCESS(:) * (XLMTT*XRHOLW)/PSOILHCAPZ(:,1)
!
DO JL=1,INL-1
- ZEXCESS(:) = MAX(0.0,-PWG(:,JL))
- PWG(:,JL+1) = PWG(:,JL+1) - ZEXCESS(:)*PDZG(:,JL)/PDZG(:,JL+1)
- PWG(:,JL) = PWG(:,JL) + ZEXCESS(:)
+ ZEXCESS = MAX(0.0,-PEK%XWG(:,JL))
+ PEK%XWG(:,JL+1) = PEK%XWG(:,JL+1) - ZEXCESS*PDZG(:,JL)/PDZG(:,JL+1)
+ PEK%XWG(:,JL) = PEK%XWG(:,JL) + ZEXCESS
ENDDO
!
! 5. Prevent from keeping track of ice in litter
! -------------------------------------------
!
-WHERE (PWRLI(:) < ZERTOL )
- PWRL(:) = PWRL(:) + PWRLI(:)
- PTL(:) = PTL(:) + PWRLI(:) * XLMTT / PGNDLITTER(:) / ZHCAPL(:)
- ZPHASEC(:) = PWRLI(:) * XLMTT / PGNDLITTER(:)
- PWRLI(:) = 0.0
+WHERE (PEK%XWRLI(:) < ZERTOL )
+ PEK%XWRL (:) = PEK%XWRL(:) + PEK%XWRLI(:)
+ PEK%XTL (:) = PEK%XTL(:) + PEK%XWRLI(:) * XLMTT / PEK%XGNDLITTER(:) / ZHCAPL(:)
+ ZPHASEC (:) = PEK%XWRLI(:) * XLMTT / PEK%XGNDLITTER(:)
+ PEK%XWRLI(:) = 0.0
ELSEWHERE
ZPHASEC(:) = 0.0
END WHERE
!
-PPHASEL(:)=(ZPHASE(:) + ZPHASEC(:))/PTSTEP*PGNDLITTER(:)
+PPHASEL(:)=(ZPHASE(:) + ZPHASEC(:))/PTSTEP*PEK%XGNDLITTER
!
-!
-IF (LHOOK) CALL DR_HOOK('ISBA_MEB:ICE_LITTER',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('ISBA_MEB:ICE_LITTER',1,ZHOOK_HANDLE)
!
END SUBROUTINE ICE_LITTER
+
!===============================================================================
END SUBROUTINE ISBA_MEB
diff --git a/src/SURFEX/isba_properties.F90 b/src/SURFEX/isba_properties.F90
index a32424f74191876771612ca98ef1b0d430259b56..a36335e6bf179de13b9b9add2b9c381b2c59efe3 100644
--- a/src/SURFEX/isba_properties.F90
+++ b/src/SURFEX/isba_properties.F90
@@ -3,18 +3,10 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE ISBA_PROPERTIES(HISBA, OTR_ML, TPSNOW, KPATCH, &
- PDIR_SW, PSCA_SW, PSW_BANDS, KSW, &
- PALBNIR, PALBVIS, PALBUV, &
- PALBNIR_VEG, PALBVIS_VEG, PALBUV_VEG, &
- PALBNIR_SOIL, PALBVIS_SOIL, PALBUV_SOIL, &
- PVEG, PLAI, PZ0, PEMIS, PTG, &
- PASNOW, PANOSNOW, PESNOW, PENOSNOW, &
- PTSSNOW, PTSNOSNOW, &
- PSNOWFREE_ALB_VEG, PSNOWFREE_ALB_SOIL, &
- PALBNIR_TVEG, PALBVIS_TVEG, &
- PALBNIR_TSOIL, PALBVIS_TSOIL, &
- PPSN, PPSNV_A, PPSNG, PPSNV )
+ SUBROUTINE ISBA_PROPERTIES(IO, PEK, PDIR_SW, PSCA_SW, PSW_BANDS, KSW, &
+ PASNOW, PANOSNOW, PESNOW, PENOSNOW, &
+ PTSSNOW, PTSNOSNOW, &
+ PALBNIR_TVEG, PALBVIS_TVEG, PALBNIR_TSOIL, PALBVIS_TSOIL )
! ##########################################################################
!
!!**** *ISBA_PROPERTIES*
@@ -47,6 +39,9 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_PE_t
+!
USE MODD_TYPE_SNOW
USE MODD_SNOW_PAR , ONLY : XEMISSN, XEMCRIN, XSNOWDMIN, &
XRHOSMAX_ES, XRHOSMIN_ES
@@ -63,30 +58,13 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
- CHARACTER(LEN=*) , INTENT(IN) :: HISBA ! ISBA scheme
-LOGICAL , INTENT(IN) :: OTR_ML ! new radiative transfert
-TYPE(SURF_SNOW), INTENT(IN) :: TPSNOW ! ISBA snow scheme
-INTEGER, INTENT(IN) :: KPATCH ! patch being treated
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
!
REAL, DIMENSION(:,:), INTENT(IN) :: PDIR_SW ! direct incoming solar radiation
REAL, DIMENSION(:,:), INTENT(IN) :: PSCA_SW ! diffus incoming solar radiation
REAL, DIMENSION(:) , INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m)
-INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands
-REAL, DIMENSION(:) , INTENT(IN) :: PALBNIR ! nearIR total albedo
-REAL, DIMENSION(:) , INTENT(IN) :: PALBVIS ! visible total albedo
-REAL, DIMENSION(:) , INTENT(IN) :: PALBUV ! UV total albedo
-REAL, DIMENSION(:) , INTENT(IN) :: PALBNIR_VEG ! nearIR veg albedo
-REAL, DIMENSION(:) , INTENT(IN) :: PALBVIS_VEG ! visible veg albedo
-REAL, DIMENSION(:) , INTENT(IN) :: PALBUV_VEG ! UV veg albedo
-REAL, DIMENSION(:) , INTENT(IN) :: PALBNIR_SOIL ! nearIR soil albedo
-REAL, DIMENSION(:) , INTENT(IN) :: PALBVIS_SOIL ! visible soil albedo
-REAL, DIMENSION(:) , INTENT(IN) :: PALBUV_SOIL ! UV soil albedo
-!
-REAL, DIMENSION(:) , INTENT(IN) :: PVEG ! PVEG = fraction of vegetation
-REAL, DIMENSION(:) , INTENT(IN) :: PLAI ! PLAI = leaf area index
-REAL, DIMENSION(:) , INTENT(IN) :: PZ0 ! PZ0 = roughness length for momentum
-REAL, DIMENSION(:) , INTENT(IN) :: PEMIS ! PEMIS = emissivity
-REAL, DIMENSION(:) , INTENT(IN) :: PTG !
+INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands
!
REAL, DIMENSION(:) , INTENT(OUT) :: PASNOW ! = snow albedo
REAL, DIMENSION(:) , INTENT(OUT) :: PANOSNOW ! = snow free albedo
@@ -94,24 +72,18 @@ REAL, DIMENSION(:) , INTENT(OUT) :: PESNOW ! = snow emissivity
REAL, DIMENSION(:) , INTENT(OUT) :: PENOSNOW ! = snow free emissivity
REAL, DIMENSION(:) , INTENT(OUT) :: PTSSNOW ! = snow radiative temperature
REAL, DIMENSION(:) , INTENT(OUT) :: PTSNOSNOW ! = snow free radiative temperature
-REAL, DIMENSION(:) , INTENT(OUT) :: PSNOWFREE_ALB_VEG !snow free albedo of vegetation for EBA
-REAL, DIMENSION(:) , INTENT(OUT) :: PSNOWFREE_ALB_SOIL !snow free albedo of soil for EBA option
+!
REAL, DIMENSION(:) , INTENT(OUT) :: PALBNIR_TVEG ! nearIR veg tot albedo
REAL, DIMENSION(:) , INTENT(OUT) :: PALBVIS_TVEG ! visible veg tot albedo
REAL, DIMENSION(:) , INTENT(OUT) :: PALBNIR_TSOIL ! nearIR soil tot albedo
REAL, DIMENSION(:) , INTENT(OUT) :: PALBVIS_TSOIL ! visible soil tot albedo
!
-REAL, DIMENSION(:) , INTENT(OUT):: PPSN ! PPSN = grid fraction covered by snow
-REAL, DIMENSION(:) , INTENT(OUT):: PPSNG ! PPSNG = fraction of the ground covered by snow
-REAL, DIMENSION(:) , INTENT(OUT):: PPSNV ! PPSNV = fraction of the veg covered by snow
-REAL, DIMENSION(:) , INTENT(OUT):: PPSNV_A !fraction of the the vegetation covered by snow for EBA scheme
-!
!* 0.2 declarations of local variables
!
REAL, DIMENSION(SIZE(PDIR_SW,1)) :: ZGLOBAL_SW ! global incoming SW rad.
-REAL, DIMENSION(SIZE(PALBNIR)) :: ZALBF
-REAL, DIMENSION(SIZE(PALBNIR)) :: ZFFV
-REAL, DIMENSION(SIZE(PALBNIR)) :: ZFFG
+REAL, DIMENSION(SIZE(PEK%XALBNIR)) :: ZALBF
+REAL, DIMENSION(SIZE(PEK%XALBNIR)) :: ZFFV
+REAL, DIMENSION(SIZE(PEK%XALBNIR)) :: ZFFG
!
LOGICAL, PARAMETER :: GMEB=.FALSE.
REAL, DIMENSION(SIZE(PDIR_SW,1)) :: ZP_MEB_SCA_SW, ZALBNIR_TSNOW, ZALBVIS_TSNOW
@@ -119,10 +91,10 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('ISBA_PROPERTIES',0,ZHOOK_HANDLE)
- CALL ISBA_SNOW_FRAC(TPSNOW%SCHEME, &
- TPSNOW%WSNOW(:,:,KPATCH), TPSNOW%RHO(:,:,KPATCH), &
- TPSNOW%ALB (:,KPATCH), PVEG, PLAI, PZ0, &
- PPSN, PPSNV_A, PPSNG, PPSNV )
+!
+ CALL ISBA_SNOW_FRAC(PEK%TSNOW%SCHEME, PEK%TSNOW%WSNOW, PEK%TSNOW%RHO, PEK%TSNOW%ALB, &
+ PEK%XVEG, PEK%XLAI, PEK%XZ0, &
+ PEK%XPSN, PEK%XPSNV_A, PEK%XPSNG, PEK%XPSNV )
!
!-------------------------------------------------------------------------------
!* 2. Compute snow-free albedo
@@ -134,57 +106,50 @@ ZALBF = 0.
ZFFV = 0.
ZFFG = 0.
!
- CALL ISBA_ALBEDO(TPSNOW%SCHEME, OTR_ML, GMEB, &
- PDIR_SW, PSCA_SW, PSW_BANDS, KSW, &
- PALBNIR, PALBVIS, PALBUV, &
- PALBNIR_VEG, PALBVIS_VEG, PALBUV_VEG, &
- PALBNIR_SOIL, PALBVIS_SOIL, PALBUV_SOIL, &
- ZALBF, ZFFV, ZFFG, &
- ZGLOBAL_SW, PANOSNOW, &
- PSNOWFREE_ALB_VEG, PSNOWFREE_ALB_SOIL, &
- ZP_MEB_SCA_SW, &
- PALBNIR_TVEG, PALBVIS_TVEG, PALBNIR_TSOIL, PALBVIS_TSOIL)
+ CALL ISBA_ALBEDO(PEK, IO%LTR_ML, GMEB, PDIR_SW, PSCA_SW, PSW_BANDS, KSW, &
+ ZALBF, ZFFV, ZFFG, ZGLOBAL_SW, ZP_MEB_SCA_SW, &
+ PALBNIR_TVEG, PALBVIS_TVEG, PALBNIR_TSOIL, PALBVIS_TSOIL)
+PANOSNOW(:) = PEK%XSNOWFREE_ALB(:)
!-------------------------------------------------------------------------------
!
!* 3. Compute aggeragted albedo and emissivity
! ----------------------------------------
!
-IF(TPSNOW%SCHEME == '3-L' .OR. TPSNOW%SCHEME == 'CRO' .OR. HISBA == 'DIF')THEN
+IF(PEK%TSNOW%SCHEME == '3-L' .OR. PEK%TSNOW%SCHEME == 'CRO' .OR. IO%CISBA == 'DIF')THEN
!
! NON-SNOW covered Grid averaged albedo and emissivity for explicit snow scheme:
!
- PASNOW(:) = TPSNOW%ALB(:,KPATCH)
- PESNOW(:) = TPSNOW%EMIS(:,KPATCH)
- PENOSNOW(:) = PEMIS(:)
+ PASNOW (:) = PEK%TSNOW%ALB(:)
+ PESNOW (:) = PEK%TSNOW%EMIS(:)
+ PENOSNOW(:) = PEK%XEMIS(:)
- PTSSNOW(:) = TPSNOW%TS(:,KPATCH)
- PTSNOSNOW(:) = PTG(:)
+ PTSSNOW(:) = PEK%TSNOW%TS(:)
+ PTSNOSNOW(:) = PEK%XTG(:,1)
ELSE
!
! Grid averaged albedo and emissivity for composite snow scheme:
!
- IF(TPSNOW%SCHEME =='EBA') THEN
+ IF(PEK%TSNOW%SCHEME =='EBA') THEN
!
- PASNOW(:) = TPSNOW%ALB(:,KPATCH)
- PESNOW(:) = XEMCRIN
- PENOSNOW(:) = PEMIS(:)
-
- PTSSNOW(:) = PTG(:)
- PTSNOSNOW(:) = PTG(:)
+ PASNOW (:) = PEK%TSNOW%ALB(:)
+ PESNOW (:) = XEMCRIN
+ PENOSNOW(:) = PEK%XEMIS(:)
+ PTSSNOW (:) = PEK%XTG(:,1)
+ PTSNOSNOW(:) = PEK%XTG(:,1)
- ELSE
+ ELSE
- PASNOW(:) = TPSNOW%ALB(:,KPATCH)
- PESNOW(:) = XEMISSN
- PENOSNOW(:) = PEMIS(:)
+ PASNOW (:) = PEK%TSNOW%ALB(:)
+ PESNOW (:) = XEMISSN
+ PENOSNOW(:) = PEK%XEMIS(:)
- PTSSNOW(:) = PTG(:)
- PTSNOSNOW(:) = PTG(:)
+ PTSSNOW (:) = PEK%XTG(:,1)
+ PTSNOSNOW(:) = PEK%XTG(:,1)
- ENDIF
+ ENDIF
!
ENDIF
IF (LHOOK) CALL DR_HOOK('ISBA_PROPERTIES',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/isba_sgh_update.F90 b/src/SURFEX/isba_sgh_update.F90
index da6e670823e4b634fa46aa0f8cb4693f06ce4494..824f9be5d9dcf77a70c96045d8236dee60fa4e0b 100644
--- a/src/SURFEX/isba_sgh_update.F90
+++ b/src/SURFEX/isba_sgh_update.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #######################################################################
- SUBROUTINE ISBA_SGH_UPDATE (IG, I, &
- HISBA,HRUNOFF,HRAIN,PRAIN,PMUF,PFSAT,PTOPQS)
+ SUBROUTINE ISBA_SGH_UPDATE (PMESH_SIZE, IO, S, K, NK, NP, NPE, PRAIN )
! #######################################################################
!
!!**** *SGH_UPDATE*
@@ -49,13 +48,11 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_NK_t, ISBA_NP_t, ISBA_NPE_t, &
+ ISBA_P_t, ISBA_PE_t
!
-!
-!
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-!
-USE MODD_SGH_PAR, ONLY : NDIMTAB, XMTOKM, XSTOHR, X001, &
+USE MODD_SGH_PAR, ONLY : NDIMTAB, XMTOKM, XSTOHR, X001, &
XMUREGP, XMUREGA
!
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -68,48 +65,30 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
-!
- CHARACTER(LEN=*), INTENT(IN) :: HISBA ! type of ISBA version:
-! ! '2-L' (default)
-! ! '3-L'
-! ! 'DIF'
-!
- CHARACTER(LEN=*), INTENT(IN) :: HRUNOFF! surface runoff formulation
-! ! 'WSAT'
-! ! 'DT92'
-! ! 'SGH ' Topmodel
-!
-!
- CHARACTER(LEN=*), INTENT(IN) :: HRAIN ! Rainfall spatial distribution
- ! 'DEF' = No rainfall spatial distribution
- ! 'SGH' = Rainfall exponential spatial distribution
+REAL, DIMENSION(:), INTENT(IN) :: PMESH_SIZE
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_NK_t), INTENT(INOUT) :: NK
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
+
!
REAL, DIMENSION(:), INTENT(IN) :: PRAIN
! PRAIN = rain rate (kg/m2/s)
!
-REAL, DIMENSION(:), INTENT(OUT) :: PMUF
-! PMUF = fraction of the grid cell reached by the precipitation
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PFSAT
-! PFSAT = Topmodel satured fraction
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PTOPQS
-! PTOPQS = Topmodel subsurface flow by layer (m/s)
-!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(SIZE(PRAIN)) :: ZDIST, ZBETA ! HRAIN = SGH
+REAL, DIMENSION(SIZE(PRAIN)) :: ZDIST, ZBETA, ZFSAT ! IO%CRAIN = SGH
! ZDIST = the cell scale (in km)
! ZBETA = cell scale dependency parameter
!
-REAL, DIMENSION(SIZE(PRAIN)) :: ZD_TOP, ZW_TOP, ZQTOP ! HRUNOFF = SGH
+REAL, DIMENSION(SIZE(PRAIN)) :: ZD_TOP, ZW_TOP, ZQTOP ! IO%CRUNOFF = SGH
! ZW_TOP = ative TOPMODEL-soil moisture at 't' (m3 m-3)
! ZD_TOP = Topmodel active layer
! ZQTOP = Topmodel lateral sub-surface flow (-)
!
-INTEGER, DIMENSION(SIZE(PRAIN)) :: IUP,IDOWN ! HRUNOFF = SGH
+INTEGER, DIMENSION(SIZE(PRAIN)) :: IUP,IDOWN ! IO%CRUNOFF = SGH
! change in xsat (or fsat) index
!
INTEGER, DIMENSION(SIZE(PRAIN)) :: NMASK ! indices correspondance between arrays
@@ -117,77 +96,100 @@ INTEGER, DIMENSION(SIZE(PRAIN)) :: NMASK ! indices correspondance bet
REAL, DIMENSION(SIZE(PRAIN)) :: ZWSAT_AVG, ZWWILT_AVG
! Average soil properties content
!
+TYPE(ISBA_P_t), POINTER :: PK
+TYPE(ISBA_K_t), POINTER :: KK
+TYPE(ISBA_PE_t), POINTER :: PEK
+!
REAL :: ZW_UP, ZW_DOWN
REAL :: ZF_UP, ZF_DOWN, ZSLOPEF
REAL :: ZQ_UP, ZQ_DOWN, ZSLOPEQ
!
-INTEGER :: INI, JJ, JI, JPATCH, JTAB, ICOUNT, &
- JL
+INTEGER :: INJ, JJ, JI, JP, JTAB, ICOUNT, &
+ JL, IMASK
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('ISBA_SGH_UPDATE',0,ZHOOK_HANDLE)
!
-INI=SIZE(PRAIN,1)
-PFSAT(:) = 0.0
+INJ=SIZE(PRAIN,1)
+!
+ZFSAT(:) = 0.0
!
!* 1.0 Spatial distribution of precipitation
! ---------------------------------------------
!
-IF(HRAIN=='SGH')THEN
+IF(IO%CRAIN=='SGH')THEN
!
WHERE(PRAIN(:)>0.0)
- PMUF (:) =1.0
+ K%XMUF (:) =1.0
ELSEWHERE
- PMUF (:) =0.0
+ K%XMUF (:) =0.0
ENDWHERE
!
! calculate the cell scale (in km)
!
- ZDIST(:) = SQRT(IG%XMESH_SIZE(:))/XMTOKM
+ ZDIST(:) = SQRT(PMESH_SIZE(:))/XMTOKM
!
WHERE(ZDIST(:)>=15.0)
!
! calculate beta for the mu calculation
!
- ZBETA (:) = XMUREGA + XMUREGP * EXP(-X001*ZDIST(:))
+ ZBETA (:) = XMUREGA + XMUREGP * EXP(-X001*ZDIST(:))
!
! calculate mu, precip is in mm/hr
-!
- PMUF (:) = 1.0 - EXP(-ZBETA(:)*(PRAIN(:)*XSTOHR))
+!
+ K%XMUF (:) = 1.0 - EXP(-ZBETA(:)*(PRAIN(:)*XSTOHR))
!
ENDWHERE
!
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ KK => NK%AL(JP)
+ IF (PK%NSIZE_P>0 )THEN
+ DO JI = 1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ KK%XMUF(JI) = K%XMUF(IMASK)
+ ENDDO
+ ENDIF
+ ENDDO
+
ENDIF
!
!* 2.0 Computation of the saturated fraction given by TOPMODEL
! -----------------------------------------------------------
!
-IF(HRUNOFF=='SGH')THEN
+IF(IO%CRUNOFF=='SGH')THEN
!
! Calculation of the ative TOPMODEL-soil moisture at 't' (m)
! ---------------------------------------------------------------
!
- ZQTOP (:) = 0.0
- ZW_TOP (:) = 0.0
ZD_TOP (:) = 0.0
ZWSAT_AVG (:) = 0.0
ZWWILT_AVG(:) = 0.0
+ ZW_TOP (:) = 0.0
!
- IF(HISBA=='DIF')THEN
+ IF(IO%CISBA=='DIF')THEN
!
- DO JPATCH=1,I%NPATCH
- IF (I%NSIZE_NATURE_P(JPATCH)>0 )THEN
- DO JL=1,I%NLAYER_DUN
- DO JJ=1,INI
- ZD_TOP (JJ) = ZD_TOP (JJ) + I%XPATCH(JJ,JPATCH)*I%XSOILWGHT(JJ,JL,JPATCH)
- ZWSAT_AVG (JJ) = ZWSAT_AVG (JJ) + I%XPATCH(JJ,JPATCH)*I%XSOILWGHT(JJ,JL,JPATCH)*I%XWSAT(JJ,JL)
- ZWWILT_AVG(JJ) = ZWWILT_AVG(JJ) + I%XPATCH(JJ,JPATCH)*I%XSOILWGHT(JJ,JL,JPATCH)*I%XWD0 (JJ,JL)
- ZW_TOP (JJ) = ZW_TOP (JJ) + I%XPATCH(JJ,JPATCH)*I%XSOILWGHT(JJ,JL,JPATCH)*I%XWG(JJ,JL,JPATCH)
+ DO JP = 1,IO%NPATCH
+ KK => NK%AL(JP)
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+
+ IF (PK%NSIZE_P>0 )THEN
+
+ DO JL = 1,IO%NLAYER_DUN
+ DO JI = 1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ !
+ ZD_TOP (IMASK) = ZD_TOP (IMASK) + PK%XPATCH(JI)*PK%XSOILWGHT(JI,JL)
+ ZWSAT_AVG (IMASK) = ZWSAT_AVG (IMASK) + PK%XPATCH(JI)*PK%XSOILWGHT(JI,JL)*K%XWSAT(IMASK,JL)
+ ZWWILT_AVG(IMASK) = ZWWILT_AVG(IMASK) + PK%XPATCH(JI)*PK%XSOILWGHT(JI,JL)*K%XWD0 (IMASK,JL)
+ ZW_TOP (IMASK) = ZW_TOP (IMASK) + PK%XPATCH(JI)*PK%XSOILWGHT(JI,JL)*PEK%XWG (JI,JL)
+ !
+ ENDDO
ENDDO
- ENDDO
ENDIF
ENDDO
!
@@ -199,21 +201,27 @@ IF(HRUNOFF=='SGH')THEN
!
ELSE
!
- DO JPATCH=1,I%NPATCH
- IF (I%NSIZE_NATURE_P(JPATCH)>0 )THEN
- DO JJ=1,INI
- ZD_TOP(JJ) = ZD_TOP(JJ)+I%XRUNOFFD(JJ,JPATCH)*I%XPATCH(JJ,JPATCH)
- ZW_TOP(JJ) = ZW_TOP(JJ)+I%XRUNOFFD(JJ,JPATCH)*I%XPATCH(JJ,JPATCH)*I%XWG(JJ,2,JPATCH)
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+
+ IF (PK%NSIZE_P>0 )THEN
+ DO JI = 1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ !
+ ZD_TOP(IMASK) = ZD_TOP(IMASK)+PK%XRUNOFFD(JI)*PK%XPATCH(JI)
+ ZW_TOP(IMASK) = ZW_TOP(IMASK)+PK%XRUNOFFD(JI)*PK%XPATCH(JI)*PEK%XWG(JI,2)
+ !
ENDDO
ENDIF
ENDDO
!
WHERE(ZD_TOP(:)>0.0)
- ZW_TOP(:) = ZW_TOP(:) / ZD_TOP(:)
+ ZW_TOP(:) = ZW_TOP(:) / ZD_TOP(:)
ENDWHERE
!
- ZWSAT_AVG (:) = I%XWSAT(:,1)
- ZWWILT_AVG(:) = I%XWD0 (:,1)
+ ZWSAT_AVG (:) = K%XWSAT(:,1)
+ ZWWILT_AVG(:) = K%XWD0 (:,1)
!
ENDIF
!
@@ -222,13 +230,13 @@ IF(HRUNOFF=='SGH')THEN
!
NMASK(:)=0
ICOUNT=0
- DO JJ=1,INI
- IF((I%XTI_MEAN(JJ)/=XUNDEF.AND.ZW_TOP(JJ)<ZWSAT_AVG(JJ).AND.ZW_TOP(JJ)>ZWWILT_AVG(JJ)))THEN
+ DO JI=1,INJ
+ IF((S%XTI_MEAN(JI)/=XUNDEF.AND.ZW_TOP(JI)<ZWSAT_AVG(JI).AND.ZW_TOP(JI)>ZWWILT_AVG(JI))) THEN
ICOUNT=ICOUNT+1
- NMASK(ICOUNT)=JJ
+ NMASK(ICOUNT)=JI
ENDIF
- IF(ZW_TOP(JJ)>=ZWSAT_AVG(JJ))THEN
- PFSAT (JJ) = 1.0
+ IF(ZW_TOP(JI)>=ZWSAT_AVG(JI))THEN
+ ZFSAT (JI) = 1.0
ENDIF
ENDDO
!
@@ -238,10 +246,10 @@ IF(HRUNOFF=='SGH')THEN
DO JTAB=1,NDIMTAB
DO JJ=1,ICOUNT
JI = NMASK(JJ)
- IF(I%XTAB_WTOP(JI,JTAB)>ZW_TOP(JI))THEN
+ IF(S%XTAB_WTOP(JI,JTAB)>ZW_TOP(JI))THEN
IUP(JJ)=JTAB
IDOWN(JJ)=JTAB+1
- ELSEIF(I%XTAB_WTOP(JI,JTAB)==ZW_TOP(JI))THEN
+ ELSEIF(S%XTAB_WTOP(JI,JTAB)==ZW_TOP(JI))THEN
IUP(JJ)=JTAB
IDOWN(JJ)=JTAB
ENDIF
@@ -250,18 +258,20 @@ IF(HRUNOFF=='SGH')THEN
!
! calculate fsat
! --------------
-!
+!
+ ZQTOP (:) = 0.0
+!
DO JJ=1,ICOUNT
!
JI = NMASK(JJ)
!
! new range
- ZF_UP = I%XTAB_FSAT(JI,IUP (JJ))
- ZF_DOWN = I%XTAB_FSAT(JI,IDOWN(JJ))
- ZQ_UP = I%XTAB_QTOP(JI,IUP (JJ))
- ZQ_DOWN = I%XTAB_QTOP(JI,IDOWN(JJ))
- ZW_UP = I%XTAB_WTOP(JI,IUP (JJ))
- ZW_DOWN = I%XTAB_WTOP(JI,IDOWN(JJ))
+ ZF_UP = S%XTAB_FSAT(JI,IUP (JJ))
+ ZF_DOWN = S%XTAB_FSAT(JI,IDOWN(JJ))
+ ZQ_UP = S%XTAB_QTOP(JI,IUP (JJ))
+ ZQ_DOWN = S%XTAB_QTOP(JI,IDOWN(JJ))
+ ZW_UP = S%XTAB_WTOP(JI,IUP (JJ))
+ ZW_DOWN = S%XTAB_WTOP(JI,IDOWN(JJ))
!
! Calculate new FSAT
ZSLOPEF = 0.0
@@ -271,21 +281,36 @@ IF(HRUNOFF=='SGH')THEN
ZSLOPEQ = (ZQ_UP-ZQ_DOWN)/(ZW_UP-ZW_DOWN)
ENDIF
!
- PFSAT(JI) = ZF_DOWN+(ZW_TOP(JI)-ZW_DOWN)*ZSLOPEF
+ ZFSAT(JI) = ZF_DOWN+(ZW_TOP(JI)-ZW_DOWN)*ZSLOPEF
ZQTOP(JI) = ZQ_DOWN+(ZW_TOP(JI)-ZW_DOWN)*ZSLOPEQ
!
ENDDO
+!
+ DO JP=1,IO%NPATCH
+ KK => NK%AL(JP)
+ PK => NP%AL(JP)
+ IF(PK%NSIZE_P>0)THEN
+ DO JI=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ KK%XFSAT(JI) = ZFSAT(IMASK)
+ ENDDO
+ ENDIF
+ ENDDO
!
! Subsurface flow by layer (m/s)
! ------------------------------
!
- IF(HISBA=='DIF')THEN
-!
- DO JPATCH=1,I%NPATCH
- IF(I%NSIZE_NATURE_P(JPATCH)>0)THEN
- DO JL=1,I%NLAYER_DUN
- DO JJ=1,INI
- PTOPQS(JJ,JL,JPATCH)=I%XKANISO(JJ,JL)*I%XCONDSAT(JJ,1,JPATCH)*ZQTOP(JJ)*I%XSOILWGHT(JJ,JL,JPATCH)/I%XRUNOFFD(JJ,JPATCH)
+ IF(IO%CISBA=='DIF')THEN
+!
+ DO JP=1,IO%NPATCH
+ KK => NK%AL(JP)
+ PK => NP%AL(JP)
+ IF(PK%NSIZE_P>0)THEN
+ DO JL=1,IO%NLAYER_DUN
+ DO JI=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ PK%XTOPQS(JI,JL) = K%XKANISO(IMASK,JL) * PK%XCONDSAT(JI,1) * ZQTOP(IMASK) * &
+ PK%XSOILWGHT(JI,JL) / PK%XRUNOFFD(JI)
ENDDO
ENDDO
ENDIF
diff --git a/src/SURFEX/isba_snow_agr.F90 b/src/SURFEX/isba_snow_agr.F90
index d472df5ef5b7a2ecf9d010b94e4cbd9b768dc42d..99b9a5c96e6453393a38cd819b2590eab968767a 100644
--- a/src/SURFEX/isba_snow_agr.F90
+++ b/src/SURFEX/isba_snow_agr.F90
@@ -3,30 +3,12 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE ISBA_SNOW_AGR( HSNOW_ISBA, OMEB, &
- PEXNS, PEXNA, PTA, PQA, PZREF, PUREF, PDIRCOSZW, PVMOD, &
- PZ0EFF, PZ0, PZ0H, PRR, PSR, &
- PEMIS, PALB, PPSN, PPSNG, PPSNV, &
- PRN, PH, PLE, PLEI, PLEG, PLEGI, PLEV, PLES, PLER, &
- PLETR, PEVAP, PSUBL, PGFLUX, PLVTT, PLSTT, &
- PUSTAR, &
- PLES3L, PLEL3L, PEVAP3L, &
- PSWNET_V, PSWNET_G, PLWNET_V, PLWNET_G, PH_V, PH_G, &
- PLEV_V_C, PLETR_V_C, PLES_V_C, &
- PQS3L, PALB3L, &
- PRNSNOW, PHSNOW, PHPSNOW, &
- PSWNETSNOW, PSWNETSNOWS, PLWNETSNOW, &
- PGFLUXSNOW, PGSFCSNOW, PUSTARSNOW, &
- PZGRNDFLUX, PFLSN_COR, PGRNDFLUX, PLESL, &
- PEMISNOW, &
- PSNOWTEMP, PTS_RAD, PTS, PRI, PQS, PHU, &
- PCD, PCDN, PCH, PSNOWHMASS, &
- PRN_ISBA, PH_ISBA, PLEG_ISBA, PLEGI_ISBA, PLEV_ISBA, &
- PLETR_ISBA, PUSTAR_ISBA, PLER_ISBA, PLE_ISBA, &
- PLEI_ISBA, PGFLUX_ISBA, PMELTADV, PTG, &
- PEMIST, PALBT, PLE_FLOOD, PLEI_FLOOD, &
- PFFG, PFFV, PFF, PPALPHAN, PTC, OMEB_LITTER, PLELITTER, &
- PLELITTERI )
+ SUBROUTINE ISBA_SNOW_AGR(KK, PK, PEK, DMK, DK, DEK, &
+ OMEB, OMEB_LITTER, PEXNS, PEXNA, PTA, PQA, &
+ PZREF, PUREF, PDIRCOSZW, PVMOD, PRR, PSR, &
+ PEMIS, PALB, PUSTAR, PLES3L, PLEL3L, &
+ PEVAP3L, PQS3L, PALB3L, PGSFCSNOW, &
+ PZGRNDFLUX, PFLSN_COR, PEMIST, PPALPHAN )
! ##########################################################################
!
!
@@ -60,7 +42,7 @@
!! Original 10/03/95
!! B. Decharme 01/2009 Floodplains
!! B. Decharme 01/2010 Effective surface temperature (for diag)
-!! B. Decharme 09/2012 Bug total sublimation flux: no PLESL
+!! B. Decharme 09/2012 Bug total sublimation flux: no DEK%XLESL
!! B. Decharme 04/2013 Bug wrong radiative temperature
!! Sublimation diag flux
!! Qs for 3l or crocus (needed for coupling with atm)
@@ -69,8 +51,12 @@
!
!* 0. DECLARATIONS
! ------------
-USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_DIAG_n, ONLY : DIAG_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
!
+USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -84,13 +70,17 @@ IMPLICIT NONE
!* general variables
! -----------------
!
- CHARACTER(LEN=*), INTENT(IN) :: HSNOW_ISBA ! 'DEF' = Default F-R snow scheme
-! ! (Douville et al. 1995)
-! ! '3-L' = 3-L snow scheme (option)
-! ! (Boone and Etchevers 2000)
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(DIAG_t), INTENT(INOUT) :: DK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK
!
LOGICAL, INTENT(IN) :: OMEB ! True = patch with multi-energy balance
-! ! False = patch with classical ISBA
+! ! False = patch with classical ISBA
+LOGICAL, INTENT(IN) :: OMEB_LITTER !True = litter option activated
+! ! over the ground
!
!* surface and atmospheric parameters
! ----------------------------------
@@ -103,9 +93,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PZREF ! reference height of the first atm
REAL, DIMENSION(:), INTENT(IN) :: PUREF ! reference height of the wind
REAL, DIMENSION(:), INTENT(IN) :: PDIRCOSZW ! Cosinus of the angle between the normal to the surface and the vertical
REAL, DIMENSION(:), INTENT(IN) :: PVMOD ! module of the horizontal wind
-REAL, DIMENSION(:), INTENT(IN) :: PZ0EFF ! effective roughness length
-REAL, DIMENSION(:), INTENT(IN) :: PZ0 ! roughness length for momentum
-REAL, DIMENSION(:), INTENT(IN) :: PZ0H ! roughness length for heat
REAL, DIMENSION(:), INTENT(IN) :: PRR ! Rain rate (in kg/m2/s)
REAL, DIMENSION(:), INTENT(IN) :: PSR ! Snow rate (in kg/m2/s)
!
@@ -122,16 +109,9 @@ REAL, DIMENSION(:), INTENT(IN) :: PEMIS ! emissivity
!* snow fractions
! --------------
!
-REAL, DIMENSION(:), INTENT(IN) :: PPSN ! fraction of the grid covered
-! ! by snow
-REAL, DIMENSION(:), INTENT(IN) :: PPSNG ! fraction of the the bare
-! ! ground covered by snow
-REAL, DIMENSION(:), INTENT(IN) :: PPSNV ! fraction of the the veg.
-! ! covered by snow
REAL, DIMENSION(:), INTENT(IN) :: PPALPHAN ! fraction of the the explicit veg.
! ! canopy buried by snow
!
-!
!* ISBA-SNOW3L variables/parameters:
! ---------------------------------
!
@@ -145,108 +125,20 @@ REAL, DIMENSION(:), INTENT(IN) :: PQS3L ! Surface humidity
REAL, DIMENSION(:), INTENT(IN) :: PZGRNDFLUX ! snow/soil-biomass interface flux (W/m2)
REAL, DIMENSION(:), INTENT(IN) :: PFLSN_COR ! snow/soil-biomass correction flux (W/m2)
!
-REAL, DIMENSION(:), INTENT(INOUT) :: PGRNDFLUX ! snow/soil-biomass interface flux (W/m2)
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PHPSNOW ! heat release from rainfall (W/m2)
-REAL, DIMENSION(:), INTENT(INOUT) :: PSNOWHMASS ! snow heat content change from mass changes (J/m2)
-REAL, DIMENSION(:), INTENT(INOUT) :: PRNSNOW ! net radiative flux from snow (W/m2)
-REAL, DIMENSION(:), INTENT(INOUT) :: PSWNETSNOW ! net shortwave snow radiative flux (W/m2)
-REAL, DIMENSION(:), INTENT(INOUT) :: PSWNETSNOWS! net shortwave snow radiative flux in sfc layer (W/m2)
-REAL, DIMENSION(:), INTENT(INOUT) :: PLWNETSNOW ! net longwave snow radiative flux (W/m2)
-REAL, DIMENSION(:), INTENT(INOUT) :: PHSNOW ! sensible heat flux from snow (W/m2)
-REAL, DIMENSION(:), INTENT(INOUT) :: PGFLUXSNOW ! net heat flux from snow (W/m2)
REAL, DIMENSION(:), INTENT(INOUT) :: PGSFCSNOW ! heat flux from snow sfc to sub sfc layers (W/m2)
-REAL, DIMENSION(:), INTENT(INOUT) :: PSWNET_V ! net shortwave radiation of vegetation canopy
-REAL, DIMENSION(:), INTENT(INOUT) :: PSWNET_G ! net shortwave radiation of (below snow) surface
-REAL, DIMENSION(:), INTENT(INOUT) :: PLWNET_V ! net longwave radiation of vegetation canopy
-REAL, DIMENSION(:), INTENT(INOUT) :: PLWNET_G ! net longwave radiation of (below snow) surface
-REAL, DIMENSION(:), INTENT(IN) :: PUSTARSNOW ! friction velocity
-REAL, DIMENSION(:), INTENT(OUT) :: PLESL ! Evaporation (liquid) from wet snow (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PEMISNOW ! snow surface emissivity
-REAL, DIMENSION(:), INTENT(OUT) :: PTS_RAD ! effective radiative temperature
-! of the natural surface (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PTS ! effective surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PSNOWTEMP ! snow layer sfc temperature (K)
REAL, DIMENSION(:), INTENT(IN) :: PLES3L ! sublimation from ISBA-ES(3L)
REAL, DIMENSION(:), INTENT(IN) :: PLEL3L ! evaporation heat flux of water in the snow (W/m2)
REAL, DIMENSION(:), INTENT(INOUT) :: PEVAP3L ! evaporation flux over snow from ISBA-ES (kg/m2/s)
-REAL, DIMENSION(:), INTENT(IN) :: PLVTT, PLSTT
-!
-!
-! Prognostic variables:
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTG ! soil sfc layer average temperatures (K)
-REAL, DIMENSION(:), INTENT(IN) :: PTC ! canopy air temperature (K)
-!
!
!* diagnostic variables
! --------------------
!
REAL, DIMENSION(:), INTENT(INOUT) :: PEMIST ! total surface emissivity
-REAL, DIMENSION(:), INTENT(INOUT) :: PALBT ! total surface albedo
!
!* surface fluxes
! --------------
!
-REAL, DIMENSION(:), INTENT(IN) :: PLEV_V_C ! MEB: total evapotranspiration (no snow) from
-! ! vegetation canopy overstory [W/m2]
-REAL, DIMENSION(:), INTENT(IN) :: PLES_V_C ! MEB: total (intercepted) snow sublimation from
-! ! vegetation canopy overstory [W/m2]
-REAL, DIMENSION(:), INTENT(IN) :: PLETR_V_C! MEB: transpiration from overstory canopy
-! ! vegetation [W/m2]
-REAL, DIMENSION(:), INTENT(INOUT) :: PRN ! net radiation
-REAL, DIMENSION(:), INTENT(INOUT) :: PH ! sensible heat flux
-REAL, DIMENSION(:), INTENT(INOUT) :: PH_V ! sensible heat flux from explicit veg canopy
-REAL, DIMENSION(:), INTENT(INOUT) :: PH_G ! sensible heat flux from surface (below snow)
-REAL, DIMENSION(:), INTENT(INOUT) :: PLE ! total latent heat flux
-REAL, DIMENSION(:), INTENT(OUT) :: PLEI ! sublimation latent heat flux
-REAL, DIMENSION(:), INTENT(INOUT) :: PLEGI ! latent heat of sublimation over frozen soil
-REAL, DIMENSION(:), INTENT(INOUT) :: PLEG ! latent heat of evaporation
-REAL, DIMENSION(:), INTENT(IN) :: PLELITTERI! sublimation of water in litter reservoir
-REAL, DIMENSION(:), INTENT(IN) :: PLELITTER !sublimation of water in litter reservoir
-LOGICAL, INTENT(IN) :: OMEB_LITTER !True = litter option activated
-! ! over the ground
-REAL, DIMENSION(:), INTENT(INOUT) :: PLEV ! latent heat of evaporation
-! ! over the vegetation
-REAL, DIMENSION(:), INTENT(INOUT) :: PLES ! latent heat of sublimation
-! ! over the snow
-REAL, DIMENSION(:), INTENT(INOUT) :: PLER ! latent heat of the fraction
-! ! delta of water retained on the
-! ! foliage of the vegetation
-REAL, DIMENSION(:), INTENT(INOUT) :: PLETR ! evapotranspiration of the rest
-! ! of the vegetation
-REAL, DIMENSION(:), INTENT(INOUT) :: PEVAP ! total evaporative flux (kg/m2/s)
-REAL, DIMENSION(:), INTENT(INOUT) :: PSUBL ! sublimation flux (kg/m2/s)
-REAL, DIMENSION(:), INTENT(INOUT) :: PGFLUX ! flux through the ground
REAL, DIMENSION(:), INTENT(INOUT) :: PUSTAR ! friction velocity
-REAL, DIMENSION(:), INTENT(INOUT) :: PMELTADV ! advection heat flux from snowmelt (W/m2)
-!
-! The following surface fluxes are from snow-free portion of grid
-! box when the ISBA-ES option is ON. Otherwise, they are equal
-! to the same variables without the _ISBA extension.
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PRN_ISBA ! net radiation
-REAL, DIMENSION(:), INTENT(OUT) :: PH_ISBA ! sensible heat flux
-REAL, DIMENSION(:), INTENT(OUT) :: PLEG_ISBA ! latent heat of evaporation (ground)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEGI_ISBA ! latent heat of sublimation (ground)
-REAL, DIMENSION(:), INTENT(OUT) :: PLEV_ISBA ! latent heat of evaporation (vegetation)
-REAL, DIMENSION(:), INTENT(OUT) :: PLETR_ISBA ! latent heat of evaporation (transpiration)
-REAL, DIMENSION(:), INTENT(OUT) :: PUSTAR_ISBA! friction velocity
-REAL, DIMENSION(:), INTENT(OUT) :: PLER_ISBA ! latent heat of evaporation (plant interception)
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_ISBA ! total latent heat flux
-REAL, DIMENSION(:), INTENT(OUT) :: PLEI_ISBA ! sublimation latent heat flux
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX_ISBA! flux through the ground
-!
-REAL, DIMENSION(:), INTENT(IN) :: PFFG,PFFV,PFF
-REAL, DIMENSION(:), INTENT(INOUT) :: PLE_FLOOD, PLEI_FLOOD ! Flood evaporation
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PRI ! grid-area Ridcharson number
-REAL, DIMENSION(:), INTENT(INOUT) :: PQS ! grid-area Surface humidity
-REAL, DIMENSION(:), INTENT(INOUT) :: PHU ! grid-area near surface humidity
-REAL, DIMENSION(:), INTENT(INOUT) :: PCH ! grid-area drag coefficient for heat
-REAL, DIMENSION(:), INTENT(INOUT) :: PCD ! grid-area drag coefficient for momentum
-REAL, DIMENSION(:), INTENT(INOUT) :: PCDN ! grid-area neutral drag coefficient for momentum
-!
!
!* 0.2 declarations of local variables
!
@@ -261,77 +153,82 @@ IF (LHOOK) CALL DR_HOOK('ISBA_SNOW_AGR',0,ZHOOK_HANDLE)
ZWORK(:) = 0.
!
IF(OMEB)THEN
-!
-! Snow free (ground-based snow) diagnostics: canopy and ground blended (W m-2):
-! NOTE that the effects of snow cover *fraction* are implicitly *included* in these fluxes
-! so do NOT multiply by snow fraction.
+ !
+ ! Snow free (ground-based snow) diagnostics: canopy and ground blended (W m-2):
+ ! NOTE that the effects of snow cover *fraction* are implicitly *included* in these fluxes
+ ! so do NOT multiply by snow fraction.
+ !
+ DEK%XRN_SN_FR (:) = DEK%XSWNET_V(:) + DEK%XSWNET_G(:) + DEK%XLWNET_V(:) + DEK%XLWNET_G(:)
+ DEK%XH_SN_FR (:) = DEK%XH_CV(:) + DEK%XH_GN(:)
+ IF (OMEB_LITTER) THEN
+ DEK%XLEG_SN_FR (:) = DEK%XLELITTER (:)
+ DEK%XLEGI_SN_FR(:) = DEK%XLELITTERI(:)
+ DEK%XLEG (:) = DEK%XLELITTER (:)
+ DEK%XLEGI(:) = DEK%XLELITTERI(:)
+ ELSE
+ DEK%XLEG_SN_FR (:) = DEK%XLEG (:)
+ DEK%XLEGI_SN_FR(:) = DEK%XLEGI(:)
+ ENDIF
- PRN_ISBA(:) = PSWNET_V(:) + PSWNET_G(:) + PLWNET_V(:) + PLWNET_G(:)
- PH_ISBA(:) = PH_V(:) + PH_G(:)
- IF (OMEB_LITTER) THEN
- PLEG_ISBA(:) = PLELITTER(:)
- PLEGI_ISBA(:) = PLELITTERI(:)
- PLEG(:) = PLELITTER(:)
- PLEGI(:) = PLELITTERI(:)
- ELSE
- PLEG_ISBA(:) = PLEG(:)
- PLEGI_ISBA(:) = PLEGI(:)
- ENDIF
- PLEI_ISBA(:) = PLEGI(:) + PLEI_FLOOD(:) + PLES(:) + PLES_V_C(:)
- PLEV_ISBA(:) = PLEV_V_C(:)
- PLETR_ISBA(:) = PLETR_V_C(:)
- PUSTAR_ISBA(:) = PUSTAR(:) ! NOTE for now, this is same as total Ustar (includes snow)
-! LER does not include intercepted snow sublimation
- PLER_ISBA(:) = PLEV_V_C(:) - PLETR_V_C(:)
-! LE includes intercepted snow sublimation
- PLE_ISBA(:) = PLEG_ISBA(:) + PLEGI_ISBA(:) + PLEV_ISBA(:) + PLE_FLOOD(:) + PLES_V_C(:) + PLEI_FLOOD(:)
- PGFLUX_ISBA(:) = PRN_ISBA(:) - PH_ISBA(:) - PLE_ISBA(:)
-!
- PEMIST(:) = PEMIS(:)
-!
-! Effective surface temperature (for diag): for MEB:
+ DEK%XLEV_SN_FR (:) = DEK%XLEV_CV (:)
+ DEK%XLETR_SN_FR(:) = DEK%XLETR_CV(:)
+ ! NOTE for now, this is same as total Ustar (includes snow)
+ DEK%XUSTAR_SN_FR(:) = PUSTAR (:)
+ ! LER does not include intercepted snow sublimation
+ DEK%XLER_SN_FR (:) = DEK%XLEV_CV(:) - DEK%XLETR_CV(:)
- ZWORK(:) = PPALPHAN(:)*PPSN(:)
- PTS(:) = (1.0 - ZWORK(:))*PTC(:) + ZWORK(:)*PSNOWTEMP(:)
-!
-! Total heat FLUX into snow/soil/vegetation surface:
-!
- PGFLUX(:) = PRN(:) - PH(:) - PLE(:) + PHPSNOW(:)
-!
+ DEK%XLEI_SN_FR (:) = DEK%XLEGI(:) + DEK%XLEI_FLOOD(:) + DEK%XLES(:) + DEK%XLES_CV(:)
+ ! LE includes intercepted snow sublimation
+ DEK%XLE_SN_FR (:) = DEK%XLEG_SN_FR(:) + DEK%XLEGI_SN_FR(:) + DEK%XLEV_SN_FR(:) + &
+ DEK%XLES_CV(:) + DEK%XLE_FLOOD(:) + DEK%XLEI_FLOOD(:)
+ DEK%XGFLUX_SN_FR(:) = DEK%XRN_SN_FR(:) - DEK%XH_SN_FR(:) - DEK%XLE_SN_FR(:)
+ !
+ PEMIST(:) = PEMIS(:)
+ !
+ ! Effective surface temperature (for diag): for MEB:
+
+ ZWORK (:) = PPALPHAN(:)*PEK%XPSN(:)
+ DK%XTS(:) = (1.0 - ZWORK(:))*PEK%XTC(:) + ZWORK(:)*DMK%XSNOWTEMP(:,1)
+ !
+ ! Total heat FLUX into snow/soil/vegetation surface:
+ !
+ DK%XGFLUX(:) = DK%XRN(:) - DK%XH(:) - PEK%XLE(:) + DMK%XHPSNOW(:)
+ !
ELSE
!
! * 2. Using an explicit snow scheme option with composite soil/veg ISBA:
! ------------------------------------------------------------------
!
- IF(HSNOW_ISBA == '3-L' .OR. HSNOW_ISBA == 'CRO')THEN
+ IF(PEK%TSNOW%SCHEME == '3-L' .OR. PEK%TSNOW%SCHEME == 'CRO')THEN
!
! Save fluxes from Force-Restore snow/explicit snow-free
! portion of grid box (vegetation/soil):
!
- PRN_ISBA(:) = PRN(:)
- PH_ISBA(:) = PH(:)
- PLEG_ISBA(:) = PLEG(:)
- PLEGI_ISBA(:) = PLEGI(:)
- PLEV_ISBA(:) = PLEV(:)
- PLETR_ISBA(:) = PLETR(:)
- PUSTAR_ISBA(:) = PUSTAR(:)
- PLER_ISBA(:) = PLER(:)
- PLE_ISBA(:) = PLE(:)
- PGFLUX_ISBA(:) = PGFLUX(:)
+ DEK%XLEG_SN_FR (:) = DEK%XLEG (:)
+ DEK%XLEGI_SN_FR (:) = DEK%XLEGI(:)
+ DEK%XLEV_SN_FR (:) = DEK%XLEV (:)
+ DEK%XLETR_SN_FR (:) = DEK%XLETR(:)
+ DEK%XLER_SN_FR (:) = DEK%XLER (:)
+ DEK%XRN_SN_FR (:) = DK%XRN (:)
+ DEK%XH_SN_FR (:) = DK%XH (:)
+ DEK%XUSTAR_SN_FR(:) = PUSTAR (:)
+
+ DEK%XLE_SN_FR (:) = PEK%XLE(:)
+ DEK%XGFLUX_SN_FR(:) = DK%XGFLUX(:)
!
- PLEI_ISBA(:) = PLEGI(:)+PLEI_FLOOD(:)+PLES(:)
+ DEK%XLEI_SN_FR (:)= DEK%XLEGI(:) + DEK%XLEI_FLOOD(:) + DEK%XLES(:)
!
! Effective surface temperature (for diag):
!
- PTS(:) = (1.-PPSN(:))*PTG(:)+PPSN(:)*PSNOWTEMP(:)
+ DK%XTS(:) = (1.-PEK%XPSN(:))*PEK%XTG(:,1)+PEK%XPSN(:)*DMK%XSNOWTEMP(:,1)
!
! Effective surface radiating temperature:
!
- PALBT (:) = PALB (:)*(1.-PPSN(:)) + PPSN(:)*PALB3L (:)
- PEMIST(:) = PEMIS(:)*(1.-PPSN(:)) + PPSN(:)*PEMISNOW(:)
+ DK%XALBT (:) = PALB (:)*(1.-PEK%XPSN(:)) + PEK%XPSN(:)*PALB3L(:)
+ PEMIST (:) = PEMIS(:)*(1.-PEK%XPSN(:)) + PEK%XPSN(:)*PEK%TSNOW%EMIS(:)
!
- PTS_RAD(:) = ( ((1.-PPSN(:))*PEMIS (:)*PTG (:)**4 + &
- PPSN(:) *PEMISNOW(:)*PSNOWTEMP(:)**4 &
+ DK%XTSRAD(:) = ( ((1.-PEK%XPSN(:))*PEMIS(:)*PEK%XTG(:,1)**4 + &
+ PEK%XPSN(:) *PEK%TSNOW%EMIS(:)*DMK%XSNOWTEMP(:,1)**4 &
)/PEMIST(:) )**(0.25)
!
! Calculate actual fluxes from snow-free natural
@@ -340,66 +237,67 @@ ELSE
! of natural portion of grid box when *ISBA-ES* in force.
! when NOT in use, then these fluxes equal those above.
!
- PRN(:) = (1.-PPSN(:)) * PRN(:) + PPSN(:) * PRNSNOW(:)
- PH(:) = (1.-PPSN(:)) * PH(:) + PPSN(:) * PHSNOW(:)
+ DK%XRN (:) = (1.-PEK%XPSN(:)) * DK%XRN(:) + PEK%XPSN(:) * DMK%XRNSNOW(:)
+ DK%XH (:) = (1.-PEK%XPSN(:)) * DK%XH (:) + PEK%XPSN(:) * DMK%XHSNOW(:)
!
- PLEG(:) = (1.-PPSNG(:)-PFFG(:)) * PLEG(:)
- PLEGI(:) = (1.-PPSNG(:)-PFFG(:)) * PLEGI(:)
- PLEV(:) = (1.-PPSNV(:)-PFFV(:)) * PLEV(:)
- PLETR(:) = (1.-PPSNV(:)-PFFV(:)) * PLETR(:)
- PLER(:) = (1.-PPSNV(:)-PFFV(:)) * PLER(:)
+ DEK%XLEG (:) = (1.-PEK%XPSNG(:)-KK%XFFG(:)) * DEK%XLEG(:)
+ DEK%XLEGI(:) = (1.-PEK%XPSNG(:)-KK%XFFG(:)) * DEK%XLEGI(:)
+ DEK%XLEV (:) = (1.-PEK%XPSNV(:)-KK%XFFV(:)) * DEK%XLEV(:)
+ DEK%XLETR(:) = (1.-PEK%XPSNV(:)-KK%XFFV(:)) * DEK%XLETR(:)
+ DEK%XLER (:) = (1.-PEK%XPSNV(:)-KK%XFFV(:)) * DEK%XLER(:)
!
! Total evapotranspiration flux (kg/m2/s):
!
- PEVAP(:) = (PLEV(:) + PLEG(:))/PLVTT(:) + PLEGI(:)/PLSTT(:) + PLE_FLOOD(:)/PLVTT(:) + &
- PLEI_FLOOD(:)/PLSTT(:) + PPSN(:) * PEVAP3L(:)
+ DK%XEVAP(:) = (DEK%XLEV(:) + DEK%XLEG(:))/PK%XLVTT(:) + DEK%XLEGI(:)/PK%XLSTT(:) + &
+ DEK%XLE_FLOOD(:)/PK%XLVTT(:) + DEK%XLEI_FLOOD(:)/PK%XLSTT(:) + &
+ PEK%XPSN(:) * PEVAP3L(:)
!
! ISBA-ES/SNOW3L fluxes:
!
- PLES(:) = PPSN(:) * PLES3L(:)
- PLESL(:) = PPSN(:) * PLEL3L(:)
- PRNSNOW(:) = PPSN(:) * PRNSNOW(:)
- PHSNOW(:) = PPSN(:) * PHSNOW(:)
- PGFLUXSNOW(:) = PPSN(:) * PGFLUXSNOW(:)
- PSNOWHMASS(:) = PPSN(:) * PSNOWHMASS(:) ! (J m-2)
- PHPSNOW(:) = PPSN(:) * PHPSNOW(:)
- PGSFCSNOW(:) = PPSN(:) * PGSFCSNOW(:)
- PSWNETSNOW(:) = PPSN(:) * PSWNETSNOW(:)
- PSWNETSNOWS(:)= PPSN(:) * PSWNETSNOWS(:)
- PEVAP3L(:) = PPSN(:) * PEVAP3L(:)
+ DEK%XLES (:) = PEK%XPSN(:) * PLES3L(:)
+ DEK%XLESL (:) = PEK%XPSN(:) * PLEL3L(:)
+ DMK%XRNSNOW (:) = PEK%XPSN(:) * DMK%XRNSNOW (:)
+ DMK%XHSNOW (:) = PEK%XPSN(:) * DMK%XHSNOW (:)
+ DMK%XGFLUXSNOW(:) = PEK%XPSN(:) * DMK%XGFLUXSNOW(:)
+ DMK%XSNOWHMASS(:) = PEK%XPSN(:) * DMK%XSNOWHMASS(:) ! (J m-2)
+ DMK%XHPSNOW (:) = PEK%XPSN(:) * DMK%XHPSNOW (:)
+ PGSFCSNOW (:) = PEK%XPSN(:) * PGSFCSNOW(:)
+ PEVAP3L (:) = PEK%XPSN(:) * PEVAP3L (:)
!
! Total heat flux between snow and soil
!
- PGRNDFLUX(:) = PPSN(:) * (PZGRNDFLUX(:)+PFLSN_COR(:))
- PMELTADV(:) = PPSN(:) * PMELTADV(:)
+ DMK%XGRNDFLUX(:) = PEK%XPSN(:) * (PZGRNDFLUX(:)+PFLSN_COR(:))
+ DEK%XMELTADV(:) = PEK%XPSN(:) * DEK%XMELTADV(:)
!
! Total evaporative flux (W/m2) :
!
- PLE(:) = PLEG(:) + PLEV(:) + PLES(:) + PLESL(:) + PLEGI(:) + PLE_FLOOD(:) + PLEI_FLOOD(:)
+ PEK%XLE(:) = DEK%XLEG(:) + DEK%XLEV(:) + DEK%XLES(:) + DEK%XLESL(:) + &
+ DEK%XLEGI(:) + DEK%XLE_FLOOD(:) + DEK%XLEI_FLOOD(:)
!
! Total sublimation flux (W/m2) :
!
- PLEI(:) = PLES(:) + PLEGI(:) + PLEI_FLOOD(:)
+ DK%XLEI (:) = DEK%XLES(:) + DEK%XLEGI(:) + DEK%XLEI_FLOOD(:)
!
! Total sublimation flux (kg/m2/s):
!
- PSUBL(:) = PLEI(:)/PLSTT(:)
+ DK%XSUBL (:) = DK%XLEI(:)/PK%XLSTT(:)
!
! Total FLUX into snow/soil/vegetation surface:
!
- PGFLUX(:) = PRN(:) - PH(:) - PLE(:) + PHPSNOW(:)
+ DK%XGFLUX(:) = DK%XRN(:) - DK%XH(:) - PEK%XLE(:) + DMK%XHPSNOW(:)
!
! surface humidity:
!
- PQS(:) = (1.-PPSN(:)) * PQS(:) + PPSN(:) * PQS3L(:)
+ DK%XQS (:) = (1.-PEK%XPSN(:)) * DK%XQS(:) + PEK%XPSN(:) * PQS3L(:)
!
! near-surface humidity :
!
- PHU(:) = (1.-PPSN(:)) * PHU(:) + PPSN(:)
+ DK%XHU (:) = (1.-PEK%XPSN(:)) * DK%XHU(:) + PEK%XPSN(:)
!
! Momentum fluxes:
!
- PUSTAR(:) = SQRT( (1.-PPSN(:)) * PUSTAR(:)**2 + PPSN(:) * PUSTARSNOW(:)**2 )
+ PUSTAR (:) = SQRT( (1.-PEK%XPSN(:)) * PUSTAR(:)**2 + &
+ PEK%XPSN(:) * DMK%XUSTARSNOW(:)**2 )
!
! Richardson number and Drag coeff:
!
@@ -407,16 +305,16 @@ ELSE
!
ELSE
!
- PTS (:) = PTG (:)
- PTS_RAD(:) = PTG (:)
- PALBT (:) = PALB (:)
- PEMIST (:) = PEMIS(:)
+ DK%XTS (:) = PEK%XTG(:,1)
+ DK%XTSRAD (:) = PEK%XTG(:,1)
+ DK%XALBT (:) = PALB (:)
+ PEMIST (:) = PEMIS(:)
!
! Total sublimation flux (W/m2) :
- PLEI (:) = PLES(:) + PLEGI(:) + PLEI_FLOOD(:)
+ DK%XLEI (:) = DEK%XLES(:) + DEK%XLEGI(:) + DEK%XLEI_FLOOD(:)
!
! Total sublimation flux (kg/m2/s):
- PSUBL (:) = PLEI(:)/PLSTT(:)
+ DK%XSUBL (:) = DK%XLEI(:)/PK%XLSTT(:)
!
ENDIF
!
@@ -425,7 +323,7 @@ ENDIF
IF (LHOOK) CALL DR_HOOK('ISBA_SNOW_AGR',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
!
SUBROUTINE COMPUT_RI_DRAG
@@ -451,8 +349,8 @@ IF (LHOOK) CALL DR_HOOK('ISBA_SNOW_AGR:COMPUT_RI_DRAG',0,ZHOOK_HANDLE)
!
! * Richardson number
!
- CALL SURFACE_RI(PTS, PQS, PEXNS, PEXNA, PTA, PQA, &
- PZREF, PUREF, PDIRCOSZW, PVMOD, PRI)
+CALL SURFACE_RI(DK%XTS, DK%XQS, PEXNS, PEXNA, PTA, PQA, &
+ PZREF, PUREF, PDIRCOSZW, PVMOD, DK%XRI)
!
! * Wind check
!
@@ -461,20 +359,20 @@ ZVMOD = WIND_THRESHOLD(PVMOD,PUREF)
! * Drag coefficient for heat and momentum
!
IF (LDRAG_COEF_ARP) THEN
- CALL SURFACE_CDCH_1DARP(PZREF, PZ0EFF, PZ0H, ZVMOD, PTA, PTG, &
- PQA, PQS, PCD, PCDN, PCH )
+ CALL SURFACE_CDCH_1DARP(PZREF, DK%XZ0EFF, DK%XZ0H, ZVMOD, PTA, PEK%XTG(:,1), &
+ PQA, DK%XQS, DK%XCD, DK%XCDN, DK%XCH )
ELSE
- CALL SURFACE_AERO_COND(PRI, PZREF, PUREF, ZVMOD, PZ0, PZ0H, ZAC, ZRA, PCH)
- CALL SURFACE_CD(PRI, PZREF, PUREF, PZ0EFF, PZ0H, PCD, PCDN)
+ CALL SURFACE_AERO_COND(DK%XRI, PZREF, PUREF, ZVMOD, DK%XZ0, DK%XZ0H, ZAC, ZRA, DK%XCH)
+ CALL SURFACE_CD(DK%XRI, PZREF, PUREF, DK%XZ0EFF, DK%XZ0H, DK%XCD, DK%XCDN)
ENDIF
!
IF (LRRGUST_ARP) THEN
ZFP(:)=MAX(0.0,PRR(:)+PSR(:))
ZRRCOR(:)=SQRT(1.0+((((ZFP(:)/(ZFP(:)+XRRSCALE))**XRRGAMMA)*XUTILGUST)**2) &
- /(PCD(:)*ZVMOD(:)**2))
- PCD = PCD * ZRRCOR
- PCH = PCH * ZRRCOR
- PCDN = PCDN * ZRRCOR
+ /(DK%XCD(:)*ZVMOD(:)**2))
+ DK%XCD = DK%XCD * ZRRCOR
+ DK%XCH = DK%XCH * ZRRCOR
+ DK%XCDN = DK%XCDN * ZRRCOR
ENDIF
!
IF (LHOOK) CALL DR_HOOK('ISBA_SNOW_AGR:COMPUT_RI_DRAG',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/isba_snow_frac.F90 b/src/SURFEX/isba_snow_frac.F90
index 05afd80300b0f82df748910a55aab7b32878a995..abef61315d4c4de22b3d44282ed2e53193c868ba 100644
--- a/src/SURFEX/isba_snow_frac.F90
+++ b/src/SURFEX/isba_snow_frac.F90
@@ -3,10 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE ISBA_SNOW_FRAC(HSNOW, &
- PWSNOW, PRSNOW, PASNOW, &
- PVEG, PLAI, PZ0, &
- PPSN, PPSNV_A, PPSNG, PPSNV )
+ SUBROUTINE ISBA_SNOW_FRAC(HSNOW, PWSNOW, PRSNOW, PASNOW, &
+ PVEG, PLAI, PZ0, PPSN, PPSNV_A, PPSNG, PPSNV )
! ##########################################################################
!
!!**** *ISBA_SNOW_FRAC*
diff --git a/src/SURFEX/isba_soc_parameters.F90 b/src/SURFEX/isba_soc_parameters.F90
index a0435249ebf63225f92218dfb9b2aa6bc687dea6..acbfaaf4850754cba7813a6b859386b51209c1f6 100644
--- a/src/SURFEX/isba_soc_parameters.F90
+++ b/src/SURFEX/isba_soc_parameters.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########################
-SUBROUTINE ISBA_SOC_PARAMETERS (HRUNOFF,PPATCH,PDG,PSOC,PBCOEF,PMPOTSAT, &
- PCONDSAT,PWSAT,PHCAPSOIL,PCONDDRY,PCONDSLD,&
- PWFC,PWWILT,PWD0,PANISO,PFRACSOC )
+SUBROUTINE ISBA_SOC_PARAMETERS (HRUNOFF,PSOC,K,NP,PFRACSOC,PWSAT,PWFC,PWWILT,KPATCH)
! ########################################################################
!
!!**** *ISBA_SOC_PARAMETERS*
@@ -46,6 +44,8 @@ SUBROUTINE ISBA_SOC_PARAMETERS (HRUNOFF,PPATCH,PDG,PSOC,PBCOEF,PMPOTSAT, &
!! (B. Decharme) 04/2013 ksat anisotropy factor
!-------------------------------------------------------------------------------
!
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_NP_t
+!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_CSTS, ONLY : XDAY
USE MODD_ISBA_PAR, ONLY : XOMRHO, XOMSPH, XOMCONDDRY, XOMCONDSLD
@@ -58,28 +58,24 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
- CHARACTER(LEN=4), INTENT(IN) :: HRUNOFF
-!
-REAL, DIMENSION(:,:,:),INTENT(IN) :: PDG
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PPATCH
+CHARACTER(LEN=4), INTENT(IN) :: HRUNOFF
!
REAL, DIMENSION(:,:), INTENT(IN) :: PSOC
!
-REAL, DIMENSION(:,:,:),INTENT(INOUT) :: PCONDSAT
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBCOEF,PMPOTSAT, &
- PHCAPSOIL,PCONDDRY, &
- PCONDSLD
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PWSAT,PWFC,PWWILT,PWD0
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PANISO
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
!
REAL, DIMENSION(:,:), INTENT(OUT) :: PFRACSOC
+INTEGER, INTENT(IN) :: KPATCH
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PWSAT
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PWFC
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PWWILT
!
!* 0.2 declarations of local parameter
!
+TYPE(ISBA_P_t), POINTER :: PK
+!
REAL, DIMENSION(2), PARAMETER :: ZCONDSAT = (/24.192,0.00864/) !Peatland hydraulic conductivity (m/day)
!from Letts et al. (2000)
!
@@ -115,20 +111,20 @@ REAL, PARAMETER :: ZDGHWSD_INF = 1000.
!
!* 0.3 declarations of local variables
!
-REAL, DIMENSION(SIZE(PDG,1)) :: ZPEAT_PROFILE, ZMOSS_DEPTH
+REAL, DIMENSION(SIZE(PWSAT,1)) :: ZPEAT_PROFILE, ZMOSS_DEPTH
!
-REAL, DIMENSION(SIZE(PDG,1)) :: ZMASK, ZRHO_TOP, ZRHO_SUB, ZRHO_INF
+REAL, DIMENSION(SIZE(PWSAT,1)) :: ZMASK, ZRHO_TOP, ZRHO_SUB, ZRHO_INF
!
-REAL, DIMENSION(SIZE(PDG,1),SIZE(PDG,2)) :: ZDG_SOIL, ZDZG_SOIL, ZRHO_SOC, ZMID_SOIL
+REAL, DIMENSION(SIZE(PWSAT,1),SIZE(NP%AL(1)%XDG,2)) :: ZDG_SOIL, ZDZG_SOIL, ZRHO_SOC, ZMID_SOIL
!
-REAL, DIMENSION(SIZE(PDG,1),SIZE(PDG,2)) :: ZPEAT_BCOEF,ZPEAT_MPOTSAT,&
+REAL, DIMENSION(SIZE(PWSAT,1),SIZE(NP%AL(1)%XDG,2)) :: ZPEAT_BCOEF,ZPEAT_MPOTSAT,&
ZPEAT_WSAT,ZPEAT_WFC, &
ZPEAT_WWILT,ZPEAT_WD0, &
ZPEAT_ANISO, ZPEAT_RHO
!
-REAL, DIMENSION(SIZE(PDG,1),SIZE(PDG,2),SIZE(PDG,3)) :: ZPEAT_CONDSAT, ZMID_CONDSAT
+REAL, DIMENSION(SIZE(PWSAT,1),SIZE(NP%AL(1)%XDG,2),KPATCH) :: ZPEAT_CONDSAT, ZMID_CONDSAT
!
-REAL, DIMENSION(SIZE(PDG,1)) :: ZREFDEPTH,ZF_BCOEF,ZF_MPOTSAT, &
+REAL, DIMENSION(SIZE(PWSAT,1)) :: ZREFDEPTH,ZF_BCOEF,ZF_MPOTSAT, &
ZLOG_MOSS,ZLOG_PEAT_DEPTH , &
ZF_WSAT,ZF_CONDSAT,ZF_WFC, &
ZF_WWILT, ZF_WD0, ZF_ANISO
@@ -140,7 +136,7 @@ REAL, DIMENSION(2) :: ZLOG_CONDSAT,ZLOG_BCOEF,ZLOG_MPOTSAT, &
ZLOG_WSAT,ZLOG_WFC,ZLOG_WWILT,ZLOG_WD0,&
ZLOG_ANISO
!
-INTEGER :: INI, INL, INP, JI, JL, JP
+INTEGER :: INI, INL, INP, JI, JL, JP, IMASK
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -148,16 +144,15 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('ISBA_SOC_PARAMETERS',0,ZHOOK_HANDLE)
!
-INI=SIZE(PDG,1)
-INL=SIZE(PDG,2)
-INP=SIZE(PDG,3)
+INI = SIZE(PWSAT,1)
+INL = SIZE(NP%AL(1)%XDG,2)
+INP = KPATCH
!
ZMASK (:) = 0.0
ZRHO_TOP(:) = 0.0
ZRHO_SUB(:) = 0.0
ZRHO_INF(:) = 0.0
!
-ZDG_SOIL(:,:) = 0.0
ZRHO_SOC(:,:) = 0.0
!
ZPEAT_RHO (:,: )=0.0
@@ -174,19 +169,22 @@ PFRACSOC (:,:)=XUNDEF
!
!-------------------------------------------------------------------------------
!
-DO JP=1,INP
- DO JI=1,INI
- ZMASK(JI)=ZMASK(JI)+PPATCH(JI,JP)
+ZDG_SOIL(:,:) = 0.0
+DO JP = 1,INP
+ PK => NP%AL(JP)
+ DO JI=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ IF(PK%XPATCH(JI)>0.0)THEN
+ ZMASK(IMASK)=ZMASK(IMASK)+PK%XPATCH(JI)
+ DO JL=1,INL
+ ZDG_SOIL(IMASK,JL)= ZDG_SOIL(IMASK,JL) + PK%XDG(JI,JL)*PK%XPATCH(JI)
+ ENDDO
+ ENDIF
ENDDO
ENDDO
-!
-DO JL=1,INL
- DO JI=1,INI
- IF(ZMASK(JI)>0.0)THEN
- ZDG_SOIL (JI,JL)=SUM(PDG(JI,JL,:)*PPATCH(JI,:),PPATCH(JI,:)>0.0) &
- /SUM(PPATCH(JI,:),PPATCH(JI,:)>0.0)
- ENDIF
- ENDDO
+!
+DO JL = 1,INL
+ WHERE (ZMASK(:)/=0.) ZDG_SOIL(:,JL) = ZDG_SOIL(:,JL)/ZMASK(:)
ENDDO
!
ZDZG_SOIL(:,1)=ZDG_SOIL(:,1)
@@ -204,12 +202,14 @@ DO JL=2,INL
ENDDO
!
DO JP=1,INP
+ PK => NP%AL(JP)
DO JL=1,INL
- DO JI=1,INI
- IF(PPATCH(JI,JP)/=XUNDEF)THEN
- ZMID_CONDSAT(JI,JL,JP)=ZMID_SOIL(JI,JL)
- ENDIF
- ENDDO
+ DO JI=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ IF(PK%XPATCH(JI)/=XUNDEF)THEN
+ ZMID_CONDSAT(IMASK,JL,JP)=ZMID_SOIL(IMASK,JL)
+ ENDIF
+ ENDDO
ENDDO
ENDDO
!
@@ -320,11 +320,13 @@ DO JL=1,INL
ZPEAT_RHO (JI,JL)=(1.0-ZPEAT_WSAT(JI,JL))*XOMRHO
!
DO JP=1,INP
- IF(PPATCH(JI,JP)/=XUNDEF)THEN
- ZREFDEPTH(JI)=MIN(ZPEAT_PROFILE(JI),MAX(ZMOSS_DEPTH(JI),ZMID_CONDSAT(JI,JL,JP)))
- ZREFDEPTH(JI)=LOG(ZREFDEPTH(JI))-ZLOG_MOSS(JI)
- ZPEAT_CONDSAT(JI,JL,JP)=ZCONDSAT(1)*EXP(ZF_CONDSAT(JI)*ZREFDEPTH(JI))/XDAY
- ENDIF
+ IF (JI>NP%AL(JP)%NSIZE_P) CYCLE
+ IMASK = NP%AL(JP)%NR_P(JI)
+ IF(NP%AL(JP)%XPATCH(JI)/=XUNDEF)THEN
+ ZREFDEPTH(IMASK)=MIN(ZPEAT_PROFILE(IMASK),MAX(ZMOSS_DEPTH(IMASK),ZMID_CONDSAT(IMASK,JL,JP)))
+ ZREFDEPTH(IMASK)=LOG(ZREFDEPTH(IMASK))-ZLOG_MOSS(IMASK)
+ ZPEAT_CONDSAT(IMASK,JL,JP)=ZCONDSAT(1)*EXP(ZF_CONDSAT(IMASK)*ZREFDEPTH(IMASK))/XDAY
+ ENDIF
ENDDO
!
ENDIF
@@ -334,35 +336,43 @@ ENDDO
!-------------------------------------------------------------------------------
!
DO JL=1,INL
- DO JI=1,INI
- IF(ZMASK(JI)>0.0)THEN
-! Soil organic carbon fraction
- PFRACSOC (JI,JL ) = MIN(1.0,ZRHO_SOC(JI,JL)/ZPEAT_RHO(JI,JL))
-! New soil thermal properties
- PHCAPSOIL(JI,JL ) = (1.0-PFRACSOC(JI,JL))*PHCAPSOIL(JI,JL) + PFRACSOC(JI,JL)*XOMRHO*XOMSPH
- PCONDDRY (JI,JL ) = (PCONDDRY(JI,JL)**(1.0-PFRACSOC(JI,JL))) * (XOMCONDDRY**PFRACSOC(JI,JL))
- PCONDSLD (JI,JL ) = (PCONDSLD(JI,JL)**(1.0-PFRACSOC(JI,JL))) * (XOMCONDSLD**PFRACSOC(JI,JL))
-! New soil hydraulic properties
- PBCOEF (JI,JL ) = (1.0-PFRACSOC(JI,JL))*PBCOEF (JI,JL) + PFRACSOC(JI,JL)*ZPEAT_BCOEF (JI,JL)
- PMPOTSAT (JI,JL ) = (1.0-PFRACSOC(JI,JL))*PMPOTSAT (JI,JL) + PFRACSOC(JI,JL)*ZPEAT_MPOTSAT(JI,JL)
- PWSAT (JI,JL ) = (1.0-PFRACSOC(JI,JL))*PWSAT (JI,JL) + PFRACSOC(JI,JL)*ZPEAT_WSAT (JI,JL)
- PWFC (JI,JL ) = (1.0-PFRACSOC(JI,JL))*PWFC (JI,JL) + PFRACSOC(JI,JL)*ZPEAT_WFC (JI,JL)
- PWWILT (JI,JL ) = (1.0-PFRACSOC(JI,JL))*PWWILT (JI,JL) + PFRACSOC(JI,JL)*ZPEAT_WWILT (JI,JL)
- DO JP=1,INP
- IF(PPATCH(JI,JP)/=XUNDEF)THEN
- PCONDSAT (JI,JL,JP) = PCONDSAT(JI,JL,JP)**(1.0-PFRACSOC(JI,JL))*ZPEAT_CONDSAT(JI,JL,JP)**PFRACSOC(JI,JL)
- ENDIF
- ENDDO
- ENDIF
- ENDDO
+ DO JI=1,INI
+ IF(ZMASK(JI)>0.0)THEN
+! Soil organic carbon fraction
+ PFRACSOC (JI,JL) = MIN(1.0,ZRHO_SOC(JI,JL)/ZPEAT_RHO(JI,JL))
+! New soil thermal properties
+ K%XHCAPSOIL(JI,JL) = (1.0-PFRACSOC(JI,JL))*K%XHCAPSOIL(JI,JL) + PFRACSOC(JI,JL)*XOMRHO*XOMSPH
+ K%XCONDDRY (JI,JL) = (K%XCONDDRY(JI,JL)**(1.0-PFRACSOC(JI,JL))) * (XOMCONDDRY**PFRACSOC(JI,JL))
+ K%XCONDSLD (JI,JL) = (K%XCONDSLD(JI,JL)**(1.0-PFRACSOC(JI,JL))) * (XOMCONDSLD**PFRACSOC(JI,JL))
+! New soil hydraulic properties
+ K%XBCOEF (JI,JL) = (1.0-PFRACSOC(JI,JL))*K%XBCOEF (JI,JL) + PFRACSOC(JI,JL)*ZPEAT_BCOEF (JI,JL)
+ K%XMPOTSAT(JI,JL) = (1.0-PFRACSOC(JI,JL))*K%XMPOTSAT(JI,JL) + PFRACSOC(JI,JL)*ZPEAT_MPOTSAT(JI,JL)
+ PWSAT (JI,JL) = (1.0-PFRACSOC(JI,JL))*PWSAT (JI,JL) + PFRACSOC(JI,JL)*ZPEAT_WSAT (JI,JL)
+ PWFC (JI,JL) = (1.0-PFRACSOC(JI,JL))*PWFC (JI,JL) + PFRACSOC(JI,JL)*ZPEAT_WFC (JI,JL)
+ PWWILT (JI,JL) = (1.0-PFRACSOC(JI,JL))*PWWILT (JI,JL) + PFRACSOC(JI,JL)*ZPEAT_WWILT (JI,JL)
+ ENDIF
+ ENDDO
+ENDDO
+!
+DO JP=1,INP
+ PK => NP%AL(JP)
+ DO JL=1,INL
+ DO JI=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ IF(PK%XPATCH(JI)/=XUNDEF .AND. ZMASK(IMASK)>0.0)THEN
+ PK%XCONDSAT (JI,JL) = PK%XCONDSAT(JI,JL)**(1.0-PFRACSOC(IMASK,JL)) * &
+ ZPEAT_CONDSAT(IMASK,JL,JP)**PFRACSOC(IMASK,JL)
+ ENDIF
+ ENDDO
+ ENDDO
ENDDO
!
IF(HRUNOFF=='SGH')THEN
DO JL=1,INL
DO JI=1,INI
IF(ZMASK(JI)>0.0)THEN
- PWD0 (JI,JL) = (1.0-PFRACSOC(JI,JL))*PWD0 (JI,JL) + PFRACSOC(JI,JL)*ZPEAT_WD0 (JI,JL)
- PANISO(JI,JL) = (1.0-PFRACSOC(JI,JL))*PANISO(JI,JL) + PFRACSOC(JI,JL)*ZPEAT_ANISO(JI,JL)
+ K%XWD0 (JI,JL) = (1.0-PFRACSOC(JI,JL))*K%XWD0 (JI,JL) + PFRACSOC(JI,JL)*ZPEAT_WD0 (JI,JL)
+ K%XKANISO(JI,JL) = (1.0-PFRACSOC(JI,JL))*K%XKANISO(JI,JL) + PFRACSOC(JI,JL)*ZPEAT_ANISO(JI,JL)
ENDIF
ENDDO
ENDDO
diff --git a/src/SURFEX/isba_swnet_meb.F90 b/src/SURFEX/isba_swnet_meb.F90
deleted file mode 100644
index 15fc827cf6b529ba5a68d8c2e22d50cd5cf8cd3e..0000000000000000000000000000000000000000
--- a/src/SURFEX/isba_swnet_meb.F90
+++ /dev/null
@@ -1,9 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ##########################################################################
- SUBROUTINE ISBA_SWNET_MEB
-!
-
-end SUBROUTINE ISBA_SWNET_MEB
diff --git a/src/SURFEX/laigain.F90 b/src/SURFEX/laigain.F90
index fb80f5065ac348bc5e7578f0c734e2c765a8704b..89c2c22217572d175db6e31bcb85f4b17e0b3677 100644
--- a/src/SURFEX/laigain.F90
+++ b/src/SURFEX/laigain.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE LAIGAIN(PBSLAI, PLAIMIN, PVEG, PBIOMASS, PLAI, PANDAY)
+ SUBROUTINE LAIGAIN(PBSLAI, PEK, PBIOMASS)
! ######################################################################
!!**** *LAIGAIN*
!!
@@ -42,14 +42,15 @@
!! Original 27/10/97
!! V. Masson 01/03/03 daily assimilation.
!! P Le Moigne 09/2005 AGS modifs of L. Jarlan
-!! S Lafont 03/2011 PANDAY calcul move to lailoss, nitro_decline
+!! S Lafont 03/2011 R%XANDAY(:,1) calcul move to lailoss, nitro_decline
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CO2V_PAR, ONLY : XMC, XMCO2, XPCCO2
+USE MODD_ISBA_n, ONLY : ISBA_PE_t
!
+USE MODD_CO2V_PAR, ONLY : XMC, XMCO2, XPCCO2
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -58,14 +59,10 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-REAL,DIMENSION(:),INTENT(IN) :: PBSLAI ! ratio of biomass to LAI
-REAL,DIMENSION(:),INTENT(IN) :: PLAIMIN ! minimum LAI
-REAL,DIMENSION(:),INTENT(IN) :: PVEG ! vegetation fraction
+REAL, DIMENSION(:), INTENT(IN) :: PBSLAI
+!
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
!
-REAL,DIMENSION(:),INTENT(INOUT):: PANDAY ! daily net CO2 assimilation (kgCO2 m-2)
-REAL,DIMENSION(:),INTENT(INOUT):: PLAI ! LAI as a function of time:
-! ! as a function of growth,
-! ! decay, assimilation.
REAL,DIMENSION(:),INTENT(INOUT):: PBIOMASS ! total dry canopy biomass (kgDM m-2)
!
!* 0.2 declarations of local variables
@@ -77,30 +74,30 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-----------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('LAIGAIN',0,ZHOOK_HANDLE)
-ZBMCOEF = XMC/(XMCO2*XPCCO2)
!
+ZBMCOEF = XMC/(XMCO2*XPCCO2)
!
! Once a day (at midnight), adjust biomass:
! ----------------------------------------
!
-WHERE( (PVEG(:)>0.) )
+WHERE( (PEK%XVEG(:)>0.) )
!
! change biomass in time due to assimilation of CO2:
! 2011 :this computation have been move to lailoss and nitro_decline
!
-! PBIOMASS(:) = PBIOMASS(:) + PANDAY(:)*ZBMCOEF
+! PBIOMASS(:) = PBIOMASS(:) + R%XANDAY(:,1)(:)*ZBMCOEF
!
! make sure biomass doesn't fall below minimum threshold:
!
- PBIOMASS(:) = MAX(PLAIMIN(:)*PBSLAI(:),PBIOMASS(:))
+ PBIOMASS(:) = MAX(PEK%XLAIMIN(:)*PBSLAI(:),PBIOMASS(:))
!
! change in LAI in time due to biomass changes:
!
- PLAI(:) = PBIOMASS(:)/PBSLAI(:)
+ PEK%XLAI(:) = PBIOMASS(:)/PBSLAI(:)
!
! reset to zero the daily net assimilation for next day:
!
- PANDAY(:) = 0.
+ PEK%XANDAY(:) = 0.
!
END WHERE
IF (LHOOK) CALL DR_HOOK('LAIGAIN',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/lailoss.F90 b/src/SURFEX/lailoss.F90
index a1d33b2884874a3bdf3c1b8c168dc9cf301f2096..05ba8f46bf0192a47d83030eaa76a42059225ab0 100644
--- a/src/SURFEX/lailoss.F90
+++ b/src/SURFEX/lailoss.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE LAILOSS(PVEG, PSEFOLD, PANMAX, PANDAY, PANFM, PBIOMASS)
+ SUBROUTINE LAILOSS(PK, PEK, PBIOMASS)
! ###############################################################
!!**** *LAILOSS*
!!
@@ -42,21 +42,21 @@
!! -------------
!! Original 27/10/97
!! Modified 12/03/04 by P LeMoigne: ZXSEFOLD in days
-!! L. Jarlan 27/10/04 add RHOA as input to express PANMAX in
+!! L. Jarlan 27/10/04 add RHOA as input to express IP%XANMAX(:,1) in
!! kgCO2 m-2s-1 instead of kgCO2 kgAir-1 m s-1
!! P Le Moigne 09/2005 AGS modifs of L. Jarlan
!! S. Lafont 03/2011 modification for consistency with nitro_decline
!!
!-------------------------------------------------------------------------------
!
+USE MODD_ISBA_n, ONLY : ISBA_P_t, ISBA_PE_t
+!
USE MODD_CSTS, ONLY : XDAY
USE MODD_CO2V_PAR, ONLY: XMC, XMCO2, XPCCO2
!
!* 0. DECLARATIONS
! ------------
!
-!
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -64,18 +64,14 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
!
-REAL, DIMENSION(:),INTENT(IN) :: PVEG ! vegetation fraction
-REAL, DIMENSION(:), INTENT(IN) :: PSEFOLD ! e-folding time for senescence (s)
-REAL, DIMENSION(:), INTENT(IN) :: PANMAX ! maximum photosynthesis rate
-REAL, DIMENSION(:), INTENT(IN) :: PANDAY ! daily net CO2 accumulation
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PANFM ! maximum leaf assimilation
REAL, DIMENSION(:), INTENT(INOUT) :: PBIOMASS ! total dry canopy biomass
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(SIZE(PSEFOLD)) :: ZXSEFOLD, ZXM
+REAL, DIMENSION(SIZE(PEK%XSEFOLD,1)) :: ZXSEFOLD, ZXM
REAL :: ZBMCOEF
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -87,11 +83,11 @@ ZBMCOEF = XMC/(XMCO2*XPCCO2)
! Once a day (at midnight), adjust biomass:
! ----------------------------------------
!
-WHERE((PVEG(:)>0) )
+WHERE((PEK%XVEG(:)>0) )
!
! leaf life expectancy
!
- ZXSEFOLD(:) = PSEFOLD(:)*MIN(1.0, PANFM(:)/PANMAX(:))/XDAY
+ ZXSEFOLD(:) = PEK%XSEFOLD(:)*MIN(1.0, PEK%XANFM(:)/PK%XANMAX(:))/XDAY
!
! avoid possible but unlikely division by zero
!
@@ -112,11 +108,11 @@ WHERE((PVEG(:)>0) )
! same modification than nitro_decline.f90
! now the assimilation is added here
! in that way laigain.f90 is consistant between the different carbon options.
- PBIOMASS(:) = PBIOMASS(:) + PANDAY(:)*ZBMCOEF
+ PBIOMASS(:) = PBIOMASS(:) + PEK%XANDAY(:)*ZBMCOEF
!
! maximum leaf assimilation (kgCO2 kgAir-1 m s-1):
!
- PANFM(:) = 0.0
+ PEK%XANFM(:) = 0.0
!
END WHERE
!
diff --git a/src/SURFEX/latlon_grid.F90 b/src/SURFEX/latlon_grid.F90
index 38d2f2dfbe2403dfe77ee51963da2fac03d3455f..66a9f7af367de82963d7102a05c03fd28b9d6cf2 100644
--- a/src/SURFEX/latlon_grid.F90
+++ b/src/SURFEX/latlon_grid.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE LATLON_GRID(HGRID,KGRID_PAR,KL,KLUOUT,PGRID_PAR,PLAT,PLON,PMESH_SIZE,PDIR)
+ SUBROUTINE LATLON_GRID(G,KL,PDIR)
! #########################################################################
!
!!**** *LATLON_GRID* - routine to compute the horizontal geographic fields
@@ -39,6 +39,7 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SFX_GRID_n, ONLY : GRID_t
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -63,14 +64,8 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
- CHARACTER(LEN=10), INTENT(IN) :: HGRID ! grid type
-INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
+TYPE(GRID_t), INTENT(INOUT) :: G
INTEGER, INTENT(IN) :: KL ! number of points
-INTEGER, INTENT(IN) :: KLUOUT ! output listing logical unit
-REAL, DIMENSION(:), INTENT(IN) :: PGRID_PAR ! parameters defining this grid
-REAL, DIMENSION(:), INTENT(OUT) :: PLAT ! latitude (degrees)
-REAL, DIMENSION(:), INTENT(OUT) :: PLON ! longitude (degrees)
-REAL, DIMENSION(:), INTENT(OUT) :: PMESH_SIZE ! mesh size (m2)
REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PDIR ! direction of main grid Y axis (deg. from N, clockwise)
!
!* 0.2 Declarations of local variables
@@ -81,13 +76,13 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!---------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('LATLON_GRID',0,ZHOOK_HANDLE)
-SELECT CASE (HGRID)
+SELECT CASE (G%CGRID)
!
!* 1. Conformal projection grid
! -------------------------
!
CASE ('CONF PROJ ')
- CALL LATLON_GRIDTYPE_CONF_PROJ(KGRID_PAR,KL,PGRID_PAR,PLAT,PLON,PMESH_SIZE,ZDIR)
+ CALL LATLON_GRIDTYPE_CONF_PROJ(G,KL,ZDIR)
IF (PRESENT(PDIR)) PDIR = ZDIR
! note that all points of the grid will be kept, whatever the surface
! type under consideration (e.g. sea points will be kept even for
@@ -98,7 +93,7 @@ SELECT CASE (HGRID)
! -----------------------
!
CASE ('LONLAT REG')
- CALL LATLON_GRIDTYPE_LONLAT_REG(KGRID_PAR,KL,PGRID_PAR,PLAT,PLON,PMESH_SIZE,ZDIR)
+ CALL LATLON_GRIDTYPE_LONLAT_REG(G,KL,ZDIR)
IF (PRESENT(PDIR)) PDIR = ZDIR
!
@@ -106,7 +101,7 @@ SELECT CASE (HGRID)
! --------------
!
CASE ('CARTESIAN ')
- CALL LATLON_GRIDTYPE_CARTESIAN(KGRID_PAR,KL,PGRID_PAR,PLAT,PLON,PMESH_SIZE,ZDIR)
+ CALL LATLON_GRIDTYPE_CARTESIAN(G,KL,ZDIR)
IF (PRESENT(PDIR)) PDIR = ZDIR
! note that all points of the grid will be kept, whatever the surface
! type under consideration (e.g. sea points will be kept even for
@@ -116,33 +111,33 @@ SELECT CASE (HGRID)
! -------------
!
CASE ('GAUSS ')
- CALL LATLON_GRIDTYPE_GAUSS(KGRID_PAR,KL,PGRID_PAR,PLAT,PLON,PMESH_SIZE,ZDIR)
+ CALL LATLON_GRIDTYPE_GAUSS(G,KL,ZDIR)
IF (PRESENT(PDIR)) PDIR = ZDIR
!
!* 5. IGN grid
! --------
!
CASE ('IGN ')
- CALL LATLON_GRIDTYPE_IGN(KGRID_PAR,KL,PGRID_PAR,PLAT,PLON,PMESH_SIZE,ZDIR)
+ CALL LATLON_GRIDTYPE_IGN(G,KL,ZDIR)
IF (PRESENT(PDIR)) PDIR = ZDIR
!
!* 6. lonlatval grid
! --------
!
CASE ('LONLATVAL ')
- CALL LATLON_GRIDTYPE_LONLATVAL(KGRID_PAR,KL,PGRID_PAR,PLAT,PLON,PMESH_SIZE,ZDIR)
+ CALL LATLON_GRIDTYPE_LONLATVAL(G,KL,ZDIR)
IF (PRESENT(PDIR)) PDIR = ZDIR
!
!* 7. Rotated lonlat grid
! -------------------
!
CASE ('LONLAT ROT')
- CALL LATLON_GRIDTYPE_LONLAT_ROT(KGRID_PAR,KL,PGRID_PAR,PLAT,PLON,PMESH_SIZE,ZDIR)
+ CALL LATLON_GRIDTYPE_LONLAT_ROT(G,KL,ZDIR)
IF (PRESENT(PDIR)) PDIR = ZDIR
!
!
CASE DEFAULT
- CALL ABOR1_SFX('LATLON_GRID: GRID TYPE NOT SUPPORTED '//HGRID)
+ CALL ABOR1_SFX('LATLON_GRID: GRID TYPE NOT SUPPORTED '//G%CGRID)
END SELECT
IF (LHOOK) CALL DR_HOOK('LATLON_GRID',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/latlon_gridtype_cartesian.F90 b/src/SURFEX/latlon_gridtype_cartesian.F90
index 1aa73511ce06eecfdec88d6e47222847c33df9c7..50b4df9a7c9d119e0e2a761dd4b4f5c6fb762251 100644
--- a/src/SURFEX/latlon_gridtype_cartesian.F90
+++ b/src/SURFEX/latlon_gridtype_cartesian.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########################################################################
- SUBROUTINE LATLON_GRIDTYPE_CARTESIAN(KGRID_PAR,KL,PGRID_PAR,PLAT,PLON,PMESH_SIZE,PDIR)
+ SUBROUTINE LATLON_GRIDTYPE_CARTESIAN(G,KL,PDIR)
! #########################################################################
!
!!**** *LATLON_GRIDTYPE_CARTESIAN* - routine to compute the horizontal geographic fields
@@ -37,6 +37,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+!
USE MODD_CSTS, ONLY : XPI
!
USE MODE_GRIDTYPE_CARTESIAN
@@ -51,12 +53,9 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
+TYPE(GRID_t), INTENT(INOUT) :: G
+!
INTEGER, INTENT(IN) :: KL ! number of points
-REAL, DIMENSION(KGRID_PAR), INTENT(IN) :: PGRID_PAR ! parameters defining this grid
-REAL, DIMENSION(KL), INTENT(OUT) :: PLAT ! latitude (degrees)
-REAL, DIMENSION(KL), INTENT(OUT) :: PLON ! longitude (degrees)
-REAL, DIMENSION(KL), INTENT(OUT) :: PMESH_SIZE ! mesh size (m2)
REAL, DIMENSION(KL), INTENT(OUT) :: PDIR ! direction of main grid Y axis (deg. from N, clockwise)
!
!* 0.2 Declarations of local variables
@@ -74,10 +73,10 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ---------------------------------
!
IF (LHOOK) CALL DR_HOOK('LATLON_GRIDTYPE_CARTESIAN',0,ZHOOK_HANDLE)
-ALLOCATE(ZDX(SIZE(PLAT)))
-ALLOCATE(ZDY(SIZE(PLAT)))
+ALLOCATE(ZDX(SIZE(G%XLAT)))
+ALLOCATE(ZDY(SIZE(G%XLAT)))
!
- CALL GET_GRIDTYPE_CARTESIAN(PGRID_PAR,ZLAT0,ZLON0, &
+ CALL GET_GRIDTYPE_CARTESIAN(G%XGRID_PAR,ZLAT0,ZLON0, &
PDX=ZDX,PDY=ZDY )
!
!---------------------------------------------------------------------------
@@ -85,14 +84,14 @@ ALLOCATE(ZDY(SIZE(PLAT)))
!* 2. Computation of latitude and longitude
! -------------------------------------
!
- CALL LATLON_CARTESIAN(ZLAT0,ZLON0,PLAT,PLON)
+ CALL LATLON_CARTESIAN(ZLAT0,ZLON0,G%XLAT,G%XLON)
!
!-----------------------------------------------------------------------------
!
!* 3. Compute grid size (2D array)
! -----------------
!
-PMESH_SIZE(:) = ZDX(:) * ZDY(:)
+G%XMESH_SIZE(:) = ZDX(:) * ZDY(:)
!
!-----------------------------------------------------------------------------
!
diff --git a/src/SURFEX/latlon_gridtype_conf_proj.F90 b/src/SURFEX/latlon_gridtype_conf_proj.F90
index acec9a0f9abbe4349a8f39c3bf7266c33329839d..86aef282e24248e64cadb8cb9c1d2e8e6841def6 100644
--- a/src/SURFEX/latlon_gridtype_conf_proj.F90
+++ b/src/SURFEX/latlon_gridtype_conf_proj.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########################################################################
- SUBROUTINE LATLON_GRIDTYPE_CONF_PROJ(KGRID_PAR,KL,PGRID_PAR,PLAT,PLON,PMESH_SIZE,PDIR)
+ SUBROUTINE LATLON_GRIDTYPE_CONF_PROJ(G,KL,PDIR)
! #########################################################################
!
!!**** *LATLON_GRIDTYPE_CONF_PROJ* - routine to compute the horizontal geographic fields
@@ -37,6 +37,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+!
USE MODD_CSTS, ONLY : XPI
!
USE MODE_GRIDTYPE_CONF_PROJ
@@ -51,12 +53,9 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
+TYPE(GRID_t), INTENT(INOUT) :: G
+!
INTEGER, INTENT(IN) :: KL ! number of points
-REAL, DIMENSION(KGRID_PAR), INTENT(IN) :: PGRID_PAR ! parameters defining this grid
-REAL, DIMENSION(KL), INTENT(OUT) :: PLAT ! latitude (degrees)
-REAL, DIMENSION(KL), INTENT(OUT) :: PLON ! longitude (degrees)
-REAL, DIMENSION(KL), INTENT(OUT) :: PMESH_SIZE ! mesh size (m2)
REAL, DIMENSION(KL), INTENT(OUT) :: PDIR ! direction of main grid Y axis (deg. from N, clockwise)
!
!* 0.2 Declarations of local variables
@@ -86,12 +85,12 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ---------------------------------
!
IF (LHOOK) CALL DR_HOOK('LATLON_GRIDTYPE_CONF_PROJ',0,ZHOOK_HANDLE)
-ALLOCATE(ZX (SIZE(PLAT)))
-ALLOCATE(ZY (SIZE(PLAT)))
-ALLOCATE(ZDX(SIZE(PLAT)))
-ALLOCATE(ZDY(SIZE(PLAT)))
+ALLOCATE(ZX (SIZE(G%XLAT)))
+ALLOCATE(ZY (SIZE(G%XLAT)))
+ALLOCATE(ZDX(SIZE(G%XLAT)))
+ALLOCATE(ZDY(SIZE(G%XLAT)))
!
- CALL GET_GRIDTYPE_CONF_PROJ(PGRID_PAR,ZLAT0,ZLON0,ZRPK,ZBETA,&
+ CALL GET_GRIDTYPE_CONF_PROJ(G%XGRID_PAR,ZLAT0,ZLON0,ZRPK,ZBETA,&
ZLATOR,ZLONOR, &
PX=ZX,PY=ZY,PDX=ZDX,PDY=ZDY )
!
@@ -100,7 +99,7 @@ ALLOCATE(ZDY(SIZE(PLAT)))
!* 2. Computation of latitude and longitude
! -------------------------------------
!
- CALL LATLON_CONF_PROJ(ZLAT0,ZLON0,ZRPK,ZBETA,ZLATOR,ZLONOR,ZX,ZY,PLAT,PLON)
+ CALL LATLON_CONF_PROJ(ZLAT0,ZLON0,ZRPK,ZBETA,ZLATOR,ZLONOR,ZX,ZY,G%XLAT,G%XLON)
!
!-----------------------------------------------------------------------------
!
@@ -110,14 +109,14 @@ ALLOCATE(ZDY(SIZE(PLAT)))
! 3.1 Map factor
! ----------
!
-ALLOCATE(ZMAP(SIZE(PLAT)))
+ALLOCATE(ZMAP(SIZE(G%XLAT)))
!
- CALL MAP_FACTOR_CONF_PROJ(ZLAT0,ZRPK,PLAT,ZMAP)
+ CALL MAP_FACTOR_CONF_PROJ(ZLAT0,ZRPK,G%XLAT,ZMAP)
!
! 3.2 Grid size
! ---------
!
-PMESH_SIZE(:) = ZDX(:) * ZDY(:) / ZMAP(:)**2
+G%XMESH_SIZE(:) = ZDX(:) * ZDY(:) / ZMAP(:)**2
!
!-----------------------------------------------------------------------------
!
@@ -125,7 +124,7 @@ PMESH_SIZE(:) = ZDX(:) * ZDY(:) / ZMAP(:)**2
! ----------------------------------------------------
!
!* the following formulae is given for clockwise angles.
-PDIR(:) = ZRPK * (PLON(:) - ZLON0) - ZBETA
+PDIR(:) = ZRPK * (G%XLON(:) - ZLON0) - ZBETA
!
WHERE (PDIR(:) <0.) PDIR = PDIR + 360.
WHERE (PDIR(:) >=360.) PDIR = PDIR - 360.
diff --git a/src/SURFEX/latlon_gridtype_gauss.F90 b/src/SURFEX/latlon_gridtype_gauss.F90
index 3072d04122cceecee98f52abdf6a66756e29ee9a..99cdc38c5ce5a927cb3dbf34fd7ff704317764f0 100644
--- a/src/SURFEX/latlon_gridtype_gauss.F90
+++ b/src/SURFEX/latlon_gridtype_gauss.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#########################################################################
-SUBROUTINE LATLON_GRIDTYPE_GAUSS(KGRID_PAR,KL,PGRID_PAR,PLAT,PLON,PMESH_SIZE,PDIR)
+SUBROUTINE LATLON_GRIDTYPE_GAUSS(G,KL,PDIR)
!#########################################################################
!
!!**** *LATLON_GRIDTYPE_GAUSS* - routine to get the horizontal geographic fields
@@ -37,6 +37,8 @@ SUBROUTINE LATLON_GRIDTYPE_GAUSS(KGRID_PAR,KL,PGRID_PAR,PLAT,PLON,PMESH_SIZE,PDI
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+!
USE MODE_GRIDTYPE_GAUSS
!
USE MODD_CSTS, ONLY : XRADIUS, XPI
@@ -50,12 +52,9 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
+TYPE(GRID_t), INTENT(INOUT) :: G
+!
INTEGER, INTENT(IN) :: KL ! number of points
-REAL, DIMENSION(KGRID_PAR), INTENT(IN) :: PGRID_PAR ! parameters defining this grid
-REAL, DIMENSION(KL), INTENT(OUT) :: PLAT ! latitude (degrees)
-REAL, DIMENSION(KL), INTENT(OUT) :: PLON ! longitude (degrees)
-REAL, DIMENSION(KL), INTENT(OUT) :: PMESH_SIZE ! mesh size (m2)
REAL, DIMENSION(KL), INTENT(OUT) :: PDIR ! direction of main grid Y axis (deg. from N, clockwise)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -68,7 +67,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ------------------
!
IF (LHOOK) CALL DR_HOOK('LATLON_GRIDTYPE_GAUSS',0,ZHOOK_HANDLE)
- CALL GET_GRIDTYPE_GAUSS(PGRID_PAR,PLAT=PLAT,PLON=PLON,PMESH_SIZE=PMESH_SIZE)
+ CALL GET_GRIDTYPE_GAUSS(G%XGRID_PAR,PLAT=G%XLAT,PLON=G%XLON,PMESH_SIZE=G%XMESH_SIZE)
!
!-----------------------------------------------------------------------------
!
diff --git a/src/SURFEX/latlon_gridtype_ign.F90 b/src/SURFEX/latlon_gridtype_ign.F90
index 096afa354037bcc678341a9b0dee14b9a89ca46b..703addcabbc72d1699ebdc3b8ada5318b7a58fe7 100644
--- a/src/SURFEX/latlon_gridtype_ign.F90
+++ b/src/SURFEX/latlon_gridtype_ign.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########################################################################
- SUBROUTINE LATLON_GRIDTYPE_IGN(KGRID_PAR,KL,PGRID_PAR,PLAT,PLON,PMESH_SIZE,PDIR)
+ SUBROUTINE LATLON_GRIDTYPE_IGN(G,KL,PDIR)
! #########################################################################
!
!!**** *LATLON_GRIDTYPE_IGN* - routine to compute the horizontal geographic fields
@@ -37,6 +37,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+!
USE MODD_CSTS, ONLY : XPI
USE MODD_IGN, ONLY : XA, XDELTY
!
@@ -52,12 +54,9 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
+TYPE(GRID_t), INTENT(INOUT) :: G
+!
INTEGER, INTENT(IN) :: KL ! number of points
-REAL, DIMENSION(KGRID_PAR), INTENT(IN) :: PGRID_PAR ! parameters defining this grid
-REAL, DIMENSION(KL), INTENT(OUT) :: PLAT ! latitude (degrees)
-REAL, DIMENSION(KL), INTENT(OUT) :: PLON ! longitude (degrees)
-REAL, DIMENSION(KL), INTENT(OUT) :: PMESH_SIZE ! mesh size (m2)
REAL, DIMENSION(KL), INTENT(OUT) :: PDIR ! direction of main grid Y axis (deg. from N, clockwise)
!
!* 0.2 Declarations of local variables
@@ -80,19 +79,19 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ---------------------------------
!
IF (LHOOK) CALL DR_HOOK('LATLON_GRIDTYPE_IGN',0,ZHOOK_HANDLE)
-ALLOCATE(ZX (SIZE(PLAT)))
-ALLOCATE(ZY (SIZE(PLAT)))
-ALLOCATE(ZDX(SIZE(PLAT)))
-ALLOCATE(ZDY(SIZE(PLAT)))
+ALLOCATE(ZX (SIZE(G%XLAT)))
+ALLOCATE(ZY (SIZE(G%XLAT)))
+ALLOCATE(ZDX(SIZE(G%XLAT)))
+ALLOCATE(ZDY(SIZE(G%XLAT)))
!
- CALL GET_GRIDTYPE_IGN(PGRID_PAR,KLAMBERT=ILAMBERT,PX=ZX,PY=ZY,PDX=ZDX,PDY=ZDY )
+ CALL GET_GRIDTYPE_IGN(G%XGRID_PAR,KLAMBERT=ILAMBERT,PX=ZX,PY=ZY,PDX=ZDX,PDY=ZDY )
!
!---------------------------------------------------------------------------
!
!* 2. Computation of latitude and longitude
! -------------------------------------
!
- CALL LATLON_IGN(ILAMBERT,ZX,ZY,PLAT,PLON)
+ CALL LATLON_IGN(ILAMBERT,ZX,ZY,G%XLAT,G%XLON)
!
!-----------------------------------------------------------------------------
!
@@ -102,14 +101,14 @@ ALLOCATE(ZDY(SIZE(PLAT)))
! 3.1 Map factor
! ----------
!
-ALLOCATE(ZMAP(SIZE(PLAT)))
+ALLOCATE(ZMAP(SIZE(G%XLAT)))
!
CALL MAP_FACTOR_IGN(ILAMBERT,ZX,ZY,ZMAP)
!
! 3.2 Grid size
! ---------
!
-PMESH_SIZE(:) = ZDX(:) * ZDY(:) / ZMAP(:)**2
+G%XMESH_SIZE(:) = ZDX(:) * ZDY(:) / ZMAP(:)**2
!
!-----------------------------------------------------------------------------
!
@@ -117,13 +116,13 @@ PMESH_SIZE(:) = ZDX(:) * ZDY(:) / ZMAP(:)**2
! ----------------------------------------------------
!
!* the following formulae is given for clockwise angles.
-ALLOCATE(ZYDELTY(SIZE(PLAT)))
-ALLOCATE(ZLATDY (SIZE(PLAT)))
-ALLOCATE(ZLONDY (SIZE(PLAT)))
+ALLOCATE(ZYDELTY(SIZE(G%XLAT)))
+ALLOCATE(ZLATDY (SIZE(G%XLAT)))
+ALLOCATE(ZLONDY (SIZE(G%XLAT)))
ZYDELTY=ZY+XDELTY
CALL LATLON_IGN(ILAMBERT,ZX,ZYDELTY,ZLATDY,ZLONDY)
!
-PDIR(:)= ATAN( (XA(ILAMBERT)*(ZLONDY(:)-PLON(:))*XPI/180.) / XDELTY) * XPI/180.
+PDIR(:)= ATAN( (XA(ILAMBERT)*(ZLONDY(:)-G%XLON(:))*XPI/180.) / XDELTY) * XPI/180.
!
!---------------------------------------------------------------------------
DEALLOCATE(ZX)
diff --git a/src/SURFEX/latlon_gridtype_lonlat_reg.F90 b/src/SURFEX/latlon_gridtype_lonlat_reg.F90
index 340679110b4655525328f27ecb495f7d9a2006a2..e5205b5fbffc8a8ae8d944509503ced1eaad4184 100644
--- a/src/SURFEX/latlon_gridtype_lonlat_reg.F90
+++ b/src/SURFEX/latlon_gridtype_lonlat_reg.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########################################################################
- SUBROUTINE LATLON_GRIDTYPE_LONLAT_REG(KGRID_PAR,KL,PGRID_PAR,PLAT,PLON,PMESH_SIZE,PDIR)
+ SUBROUTINE LATLON_GRIDTYPE_LONLAT_REG(G,KL,PDIR)
! #########################################################################
!
!!**** *LATLON_GRIDTYPE_LONLAT_REG* - routine to compute the horizontal geographic fields
@@ -37,6 +37,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+!
USE MODD_CSTS, ONLY : XPI, XRADIUS
!
USE MODE_GRIDTYPE_LONLAT_REG
@@ -51,12 +53,9 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
+TYPE(GRID_t), INTENT(INOUT) :: G
+!
INTEGER, INTENT(IN) :: KL ! number of points
-REAL, DIMENSION(KGRID_PAR), INTENT(IN) :: PGRID_PAR ! parameters defining this grid
-REAL, DIMENSION(KL), INTENT(OUT) :: PLAT ! latitude (degrees)
-REAL, DIMENSION(KL), INTENT(OUT) :: PLON ! longitude (degrees)
-REAL, DIMENSION(KL), INTENT(OUT) :: PMESH_SIZE ! mesh size (m2)
REAL, DIMENSION(KL), INTENT(OUT) :: PDIR ! direction of main grid Y axis (deg. from N, clockwise)
!
!* 0.2 Declarations of local variables
@@ -78,8 +77,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ---------------
!
IF (LHOOK) CALL DR_HOOK('LATLON_GRIDTYPE_LONLAT_REG',0,ZHOOK_HANDLE)
- CALL GET_GRIDTYPE_LONLAT_REG(PGRID_PAR,ZLONMIN,ZLONMAX, &
- ZLATMIN,ZLATMAX,ILON,ILAT,PLON=PLON,PLAT=PLAT )
+ CALL GET_GRIDTYPE_LONLAT_REG(G%XGRID_PAR,ZLONMIN,ZLONMAX, &
+ ZLATMIN,ZLATMAX,ILON,ILAT,PLON=G%XLON,PLAT=G%XLAT )
!
!-----------------------------------------------------------------------------
!
@@ -89,8 +88,8 @@ IF (LHOOK) CALL DR_HOOK('LATLON_GRIDTYPE_LONLAT_REG',0,ZHOOK_HANDLE)
ZDLAT = (ZLATMAX-ZLATMIN)/FLOAT(ILAT)
ZDLON = (ZLONMAX-ZLONMIN)/FLOAT(ILON)
!
-PMESH_SIZE(:) = XRADIUS**2 * XPI/180.*(ZDLON) &
- * (SIN((PLAT(:)+ZDLAT/2.)*XPI/180.)-SIN((PLAT(:)-ZDLAT/2.)*XPI/180.))
+G%XMESH_SIZE(:) = XRADIUS**2 * XPI/180.*(ZDLON) &
+ * (SIN((G%XLAT(:)+ZDLAT/2.)*XPI/180.)-SIN((G%XLAT(:)-ZDLAT/2.)*XPI/180.))
!
!-----------------------------------------------------------------------------
!
diff --git a/src/SURFEX/latlon_gridtype_lonlat_rot.F90 b/src/SURFEX/latlon_gridtype_lonlat_rot.F90
index 70c2ac3d28fe31951c432db4757f8a3f8bfb0d09..fcb7ad7727cd813497ba1b331c2134b510ec839f 100644
--- a/src/SURFEX/latlon_gridtype_lonlat_rot.F90
+++ b/src/SURFEX/latlon_gridtype_lonlat_rot.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########################################################################
- SUBROUTINE LATLON_GRIDTYPE_LONLAT_ROT(KGRID_PAR,KL,PGRID_PAR,PLAT,PLON,PMESH_SIZE,PDIR)
+ SUBROUTINE LATLON_GRIDTYPE_LONLAT_ROT(G,KL,PDIR)
! #########################################################################
!
!!**** *LATLON_GRIDTYPE_LONLAT_ROT* - routine to compute the horizontal geographic fields
@@ -37,6 +37,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+!
USE MODD_CSTS, ONLY : XPI, XRADIUS
!
USE MODE_GRIDTYPE_LONLAT_ROT
@@ -53,12 +55,9 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
+TYPE(GRID_t), INTENT(INOUT) :: G
+!
INTEGER, INTENT(IN) :: KL ! number of points
-REAL, DIMENSION(KGRID_PAR), INTENT(IN) :: PGRID_PAR ! parameters defining this grid
-REAL, DIMENSION(KL), INTENT(OUT) :: PLAT ! latitude (degrees)
-REAL, DIMENSION(KL), INTENT(OUT) :: PLON ! longitude (degrees)
-REAL, DIMENSION(KL), INTENT(OUT) :: PMESH_SIZE ! mesh size (m2)
REAL, DIMENSION(KL), INTENT(OUT) :: PDIR ! direction of main grid Y axis (deg. from N, clockwise)
!
!* 0.2 Declarations of local variables
@@ -84,20 +83,20 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('LATLON_GRIDTYPE_LONLAT_ROT',0,ZHOOK_HANDLE)
!
- CALL GET_GRIDTYPE_LONLAT_ROT(PGRID_PAR, &
+ CALL GET_GRIDTYPE_LONLAT_ROT(G%XGRID_PAR, &
ZWEST,ZSOUTH,ZDLON,ZDLAT,ZPOLON,ZPOLAT, &
- ILON,ILAT,PLON=PLON,PLAT=PLAT )
+ ILON,ILAT,PLON=G%XLON,PLAT=G%XLAT )
!
!-----------------------------------------------------------------------------
!
!* 2. Compute grid size
! -----------------
!
- CALL REGROT_LONLAT_ROT(PLON,PLAT,ZLON,ZLAT, &
+ CALL REGROT_LONLAT_ROT(G%XLON,G%XLAT,ZLON,ZLAT, &
KL,1,KL,1, &
ZPOLON,ZPOLAT,1 )
!
-PMESH_SIZE(:) = ( XPI * XRADIUS /180. )**2 * ZDLAT * ZDLON * COS(ZLAT(:)*XPI/180.)
+G%XMESH_SIZE(:) = ( XPI * XRADIUS /180. )**2 * ZDLAT * ZDLON * COS(ZLAT(:)*XPI/180.)
!
!-----------------------------------------------------------------------------
!
diff --git a/src/SURFEX/latlon_gridtype_lonlatval.F90 b/src/SURFEX/latlon_gridtype_lonlatval.F90
index adadf4a2f013247535a800a0b3d829a4a59f81cd..49c9da5ad0975330105e5c843a1a39c32aaac16e 100644
--- a/src/SURFEX/latlon_gridtype_lonlatval.F90
+++ b/src/SURFEX/latlon_gridtype_lonlatval.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########################################################################
- SUBROUTINE LATLON_GRIDTYPE_LONLATVAL(KGRID_PAR,KL,PGRID_PAR,PLAT,PLON,PMESH_SIZE,PDIR)
+ SUBROUTINE LATLON_GRIDTYPE_LONLATVAL(G,KL,PDIR)
! #########################################################################
!
!!**** *LATLON_GRIDTYPE_IGN* - routine to compute the horizontal geographic fields
@@ -37,6 +37,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+!
USE MODD_CSTS, ONLY : XPI, XRADIUS
!
USE MODE_GRIDTYPE_LONLATVAL
@@ -51,12 +53,9 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
+TYPE(GRID_t), INTENT(INOUT) :: G
+!
INTEGER, INTENT(IN) :: KL ! number of points
-REAL, DIMENSION(KGRID_PAR), INTENT(IN) :: PGRID_PAR ! parameters defining this grid
-REAL, DIMENSION(KL), INTENT(OUT) :: PLAT ! latitude (degrees)
-REAL, DIMENSION(KL), INTENT(OUT) :: PLON ! longitude (degrees)
-REAL, DIMENSION(KL), INTENT(OUT) :: PMESH_SIZE ! mesh size (m2)
REAL, DIMENSION(KL), INTENT(OUT) :: PDIR ! direction of main grid Y axis (deg. from N, clockwise)
!
!* 0.2 Declarations of local variables
@@ -75,22 +74,22 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ---------------------------------
!
IF (LHOOK) CALL DR_HOOK('LATLON_GRIDTYPE_LONLATVAL',0,ZHOOK_HANDLE)
-ALLOCATE(ZX (SIZE(PLAT)))
-ALLOCATE(ZY (SIZE(PLAT)))
-ALLOCATE(ZDX(SIZE(PLAT)))
-ALLOCATE(ZDY(SIZE(PLAT)))
-ALLOCATE(ZDLON(SIZE(PLAT)))
-ALLOCATE(ZDLAT(SIZE(PLAT)))
+ALLOCATE(ZX (SIZE(G%XLAT)))
+ALLOCATE(ZY (SIZE(G%XLAT)))
+ALLOCATE(ZDX(SIZE(G%XLAT)))
+ALLOCATE(ZDY(SIZE(G%XLAT)))
+ALLOCATE(ZDLON(SIZE(G%XLAT)))
+ALLOCATE(ZDLAT(SIZE(G%XLAT)))
!
- CALL GET_GRIDTYPE_LONLATVAL(PGRID_PAR,PX=ZX,PY=ZY,PDX=ZDX,PDY=ZDY )
+ CALL GET_GRIDTYPE_LONLATVAL(G%XGRID_PAR,PX=ZX,PY=ZY,PDX=ZDX,PDY=ZDY )
!
!---------------------------------------------------------------------------
!
!* 2. Computation of latitude and longitude
! -------------------------------------
!
- CALL LATLON_LONLATVAL(ZX,ZY,PLAT,PLON)
+ CALL LATLON_LONLATVAL(ZX,ZY,G%XLAT,G%XLON)
!
!-----------------------------------------------------------------------------
!
@@ -101,8 +100,8 @@ ALLOCATE(ZDLAT(SIZE(PLAT)))
ZDLAT = ZDY
ZDLON = ZDX
!
-PMESH_SIZE(:) = XRADIUS**2 * XPI/180.*(ZDLON(:)) &
- * (SIN((PLAT(:)+ZDLAT(:)/2.)*XPI/180.)-SIN((PLAT(:)-ZDLAT(:)/2.)*XPI/180.))
+G%XMESH_SIZE(:) = XRADIUS**2 * XPI/180.*(ZDLON(:)) &
+ * (SIN((G%XLAT(:)+ZDLAT(:)/2.)*XPI/180.)-SIN((G%XLAT(:)-ZDLAT(:)/2.)*XPI/180.))
!
!-----------------------------------------------------------------------------
!
diff --git a/src/SURFEX/lib_mpp.F90 b/src/SURFEX/lib_mpp.F90
index 242ac46b5080a8e664526a48eeb3737d62cc93d7..254409eac7ceb6532457ea2c8801ef5d9269add1 100644
--- a/src/SURFEX/lib_mpp.F90
+++ b/src/SURFEX/lib_mpp.F90
@@ -257,7 +257,7 @@ MODULE lib_mpp
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
#endif
- CONTAINS
+CONTAINS
#if ! defined in_surfex
INTEGER FUNCTION lib_mpp_alloc( kumout )
!!----------------------------------------------------------------------
@@ -2862,7 +2862,7 @@ MODULE lib_mpp
LOGICAL, PUBLIC :: ln_nnogather = .FALSE. !: namelist control of northfold comms (needed here in case "key_mpp_mpi" is not used)
INTEGER :: ncomm_ice
!!----------------------------------------------------------------------
- CONTAINS
+CONTAINS
INTEGER FUNCTION lib_mpp_alloc(kumout) ! Dummy function
INTEGER, INTENT(in) :: kumout
diff --git a/src/SURFEX/liste_emis b/src/SURFEX/liste_emis
new file mode 100644
index 0000000000000000000000000000000000000000..f906462327b3d63578f470ebb288a28480351655
--- /dev/null
+++ b/src/SURFEX/liste_emis
@@ -0,0 +1,421 @@
+allocate_physio.F90:ALLOCATE(PEK%XEMIS (ISIZE ))
+allocate_teb_veg_pgd.F90:ALLOCATE(PEK%XEMIS (KLU))
+alloc_diag_surf_atmn.F90:ALLOCATE(D%XEMIS (KSIZE_FULL))
+alloc_diag_surf_atmn.F90:D%XEMIS = XUNDEF
+averaged_albedo_emis_isba.F90: ZEMISF(1:ISIZE) = KK%XEMISF(:)
+averaged_albedo_emis_isba.F90: ZEMIS(1:ISIZE) = PEK%XEMIS(:)
+averaged_albedo_emis_isba.F90: WHERE(PEK%XPSN(:)<1.0.AND.PEK%XEMIS(:)/=XUNDEF)
+averaged_albedo_emis_isba.F90: ZEMIS(1:ISIZE) = ((1.-KK%XFF(:)-PEK%XPSN(:))*PEK%XEMIS(:) + KK%XFF(:)*KK%XEMISF(:)) /(1.-PEK%XPSN(:))
+averaged_albedo_emis_isba.F90: IF (PEK%XEMIS(JI)/=XUNDEF .AND. ZEMIS_PATCH(IMASK,JP)/=0.) THEN
+averaged_tsrad_teb.F90:REAL, DIMENSION(SIZE(T%XEMIS_ROOF)) :: ZDN_ROOF ! snow fraction
+averaged_tsrad_teb.F90:REAL, DIMENSION(SIZE(T%XEMIS_ROOF)) :: ZDN_ROAD ! on the surface
+averaged_tsrad_teb.F90:ZABS_LW_ROOF(:) = T%XEMIS_ROOF(:) * (ZLW_RAD(:) - XSTEFAN * T%XT_ROOF(:,1)**4)
+averaged_tsrad_teb.F90:PEMIS(:) = T%XBLD(:) * (1.-T%XGREENROOF(:)) * (ZDF_ROOF(:)*T%XEMIS_ROOF (:) &
+averaged_tsrad_teb.F90: + T%XROAD(:)*T%XSVF_ROAD(:)* (ZDF_ROAD(:)* T%XEMIS_ROAD(:) &
+averaged_tsrad_teb.F90: + T%XWALL_O_HOR(:) * T%XSVF_WALL(:) * T%XEMIS_WALL(:) &
+avg_albedo_emis_teb_veg.F90:USE MODD_SNOW_PAR, ONLY : XEMISSN
+avg_albedo_emis_teb_veg.F90:WHERE (PEK%XEMIS/=XUNDEF)
+avg_albedo_emis_teb_veg.F90: PEMIS(:) = (1.-PEK%XPSN)*PEK%XEMIS + PEK%XPSN *XEMISSN
+avg_albedo_emis_teb_veg.F90: WHERE (PEK%XEMIS/=XUNDEF)
+avg_urban_fluxes.F90: PEMIS_TWN(JJ) = T%XBLD (JJ) * (1.-T%XGREENROOF(JJ)) * PDF_RF(JJ) * T%XEMIS_ROOF(JJ) * (1.-TPN%XFRAC_PANEL(JJ)) &
+avg_urban_fluxes.F90: + T%XBLD (JJ) * TPN%XEMIS_PANEL(JJ) * TPN%XFRAC_PANEL(JJ) &
+avg_urban_fluxes.F90: + T%XROAD (JJ) * ( T%XSVF_ROAD(JJ) * PDF_RD(JJ) * T%XEMIS_ROAD(JJ) &
+avg_urban_fluxes.F90: + T%XWALL_O_HOR(JJ) * T%XSVF_WALL (JJ) * T%XEMIS_WALL(JJ)
+build_emisstabn.F90:! Update %NWS, %NDX, %NTX, %LREAD, %XEMISDATA
+build_emisstabn.F90: ALLOCATE(TPEMISS(JSPEC)%XEMISDATA(KSIZE,INBTS))
+build_emisstabn.F90: CALL READ_SURF_FIELD2D(HPROGRAM,TPEMISS(JSPEC)%XEMISDATA(:,:),YRECFM)
+build_emisstabn.F90: WHERE(TPEMISS(JSPEC)%XEMISDATA(:,:) == 999.)
+build_emisstabn.F90: TPEMISS(JSPEC)%XEMISDATA(:,:) = 0.
+build_emisstabn.F90: WHERE(TPEMISS(JSPEC)%XEMISDATA(:,:) == 1.E20)
+build_emisstabn.F90: TPEMISS(JSPEC)%XEMISDATA(:,:) = 0.
+build_emisstabn.F90: TPEMISS(JSPEC)%XEMISDATA(:,ITIME) = TPEMISS(JSPEC)%XEMISDATA(:,ITIME) * PCONVERSION(:)
+build_emisstabn.F90: !TPEMISS(JSPEC)%XEMISDATA(:,ITIME) = TPEMISS(JSPEC)%XEMISDATA(:,ITIME)
+build_emisstabn.F90: ALLOCATE(TPEMISS(JSPEC)%XEMISDATA(KSIZE,IWS_DEFAULT))
+build_emisstabn.F90: TPEMISS(JSPEC)%XFWORK=>TPEMISS(JSPEC)%XEMISDATA(:,1)
+ch_aer_emission.F90:ZEMISRADIUSI = XEMISRADIUSI * EXP(-3.*(LOG(XEMISSIGI))**2)
+ch_aer_emission.F90:ZEMISRADIUSJ = XEMISRADIUSJ * EXP(-3.*(LOG(XEMISSIGJ))**2)
+ch_aer_emission.F90:ZEMISRADIUSI = XEMISRADIUSI
+ch_aer_emission.F90:ZEMISRADIUSJ = XEMISRADIUSJ
+ch_aer_emission.F90:ZFM(:,1)= ZFM(:,2) / ((ZEMISRADIUSI**3)*EXP(4.5 * (LOG(XEMISSIGI))**2))
+ch_aer_emission.F90:ZFM(:,4)= ZFM(:,5) / ((ZEMISRADIUSJ**3)*EXP(4.5 * (LOG(XEMISSIGJ))**2))
+ch_aer_emission.F90:ZFM(:,3) = ZFM(:,1) * (ZEMISRADIUSI**6) *EXP(18 *(LOG(XEMISSIGI))**2)
+ch_aer_emission.F90:ZFM(:,6) = ZFM(:,4) * (ZEMISRADIUSJ**6) *EXP(18 *(LOG(XEMISSIGJ))**2)
+ch_emission_fluxn.F90:! Check availability of data within memory Window (XEMISDATA(:,1:IWS))
+ch_emission_fluxn.F90:! File must be read to update XEMISDATA array for this species
+ch_emission_fluxn.F90: CHE%TSEMISS(JI)%XEMISDATA(:,1:INBTS-CHE%TSEMISS(JI)%NTX+1) = &
+ch_emission_fluxn.F90: CHE%TSEMISS(JI)%XEMISDATA(:,INBTS-CHE%TSEMISS(JI)%NTX+2:IWS) = &
+ch_emission_fluxn.F90: CHE%TSEMISS(JI)%XEMISDATA(:,1:IWS) = ZWORK(:,CHE%TSEMISS(JI)%NPX:INBTS)
+ch_emission_fluxn.F90: CHE%TSEMISS(JI)%XEMISDATA(:,1:IWS) = ZWORK(:,CHE%TSEMISS(JI)%NTX:CHE%TSEMISS(JI)%NTX+IWS-1)
+ch_emission_fluxn.F90: CHE%TSEMISS(JI)%XFWORK(:) = ZALPHA*CHE%TSEMISS(JI)%XEMISDATA(:,INDX2) +&
+ch_emission_fluxn.F90: (1.-ZALPHA)*CHE%TSEMISS(JI)%XEMISDATA(:,INDX1)
+ch_emission_snapn.F90: CHN%XEMIS_FIELDS(:,:)=0.
+ch_emission_snapn.F90: ZE(JI,JT) = ZE(JI,JT) + CHN%XEMIS_FIELDS_SNAP(JI,JSNAP,JSPEC) &
+ch_emission_snapn.F90: CHN%XEMIS_FIELDS(:,JSPEC) = ZE(:,1) + (ZE(:,2)-ZE(:,1))/3600.*(ZTIME0(:)-IHOUR(:,1)*3600.)
+ch_emission_to_atmn.F90: CURPRONOS%XCOEFF(JSPEC)*CHN%XEMIS_FIELDS(:,CURPRONOS%NEFINDEX(JSPEC))
+ch_init_emissionn.F90: ALLOCATE(CHE%XEMIS_FIELDS(KLU,CHE%NEMIS_NBR))
+ch_init_emissionn.F90: CHE%XEMIS_FIELDS(:,IIND1:IIND2) = ZWORK2D(:,:)
+ch_init_snapn.F90:ALLOCATE(CHN%XEMIS_FIELDS_SNAP(KLU,CHN%NEMIS_SNAP,CHN%NEMIS_NBR))
+ch_init_snapn.F90:ALLOCATE(CHN%XEMIS_FIELDS (KLU, CHN%NEMIS_NBR))
+ch_init_snapn.F90: CALL READ_SURF(HPROGRAM,YRECFM,CHN%XEMIS_FIELDS_SNAP(:,JSNAP,JSPEC),IRESP,YCOMMENT)
+compute_isba_parameters.F90:USE MODD_SNOW_PAR, ONLY : XEMISSN
+compute_isba_parameters.F90: ALLOCATE(KK%XEMISF (PK%NSIZE_P))
+compute_isba_parameters.F90: KK%XEMISF = 0.0
+compute_isba_parameters.F90:ALLOCATE(S%XEMIS_NAT (KI))
+compute_isba_parameters.F90:S%XEMIS_NAT (:) = XUNDEF
+compute_isba_parameters.F90: S%XEMIS_NAT, ZTSRAD_NAT, ZTSURF_NAT )
+compute_isba_parameters.F90:PEMIS = S%XEMIS_NAT
+convert_patch_isba.F90: PEK%XEMIS ,DTV%XPAR_VEGTYPE,DTV%XPAR_EMIS(:,KDEC2,:),YNAT,'ARI',&
+convert_patch_isba.F90: CALL AV_PGD_1P(DTCO, PEK%XEMIS ,PCOVER ,XDATA_EMIS_ECO (:,KDEC,:),YNAT,'ARI',OCOVER,&
+convert_patch_teb.F90: T%XEMIS_ROOF=DTT%XPAR_EMIS_ROOF
+convert_patch_teb.F90: CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PEMIS_ROOF=T%XEMIS_ROOF)
+convert_patch_teb.F90: CALL AV_PGD(DTCO, T%XEMIS_ROOF ,TOP%XCOVER ,XDATA_EMIS_ROOF (:),YAREA,YAVG,TOP%LCOVER)
+convert_patch_teb.F90: T%XEMIS_ROAD=DTT%XPAR_EMIS_ROAD
+convert_patch_teb.F90: CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PEMIS_ROAD=T%XEMIS_ROAD)
+convert_patch_teb.F90: T%XEMIS_ROAD ,TOP%XCOVER ,XDATA_EMIS_ROAD (:),'STR','ARI',TOP%LCOVER)
+convert_patch_teb.F90: T%XEMIS_WALL=DTT%XPAR_EMIS_WALL
+convert_patch_teb.F90: CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PEMIS_WALL=T%XEMIS_WALL)
+convert_patch_teb.F90: CALL AV_PGD(DTCO, T%XEMIS_WALL ,TOP%XCOVER ,XDATA_EMIS_WALL (:),YAREA,YAVG,TOP%LCOVER)
+convert_patch_teb.F90: TPN%XEMIS_PANEL=DTT%XPAR_EMIS_PANEL
+convert_patch_teb.F90: CALL INI_DATA_PARAM_TEB(BDD, DTT%NPAR_BLDCODE,PEMIS_PANEL=TPN%XEMIS_PANEL)
+convert_patch_teb.F90: CALL AV_PGD(DTCO, TPN%XEMIS_PANEL ,TOP%XCOVER ,XDATA_EMIS_PANEL(:),'BLD','ARI',TOP%LCOVER)
+coupling_flaken.F90: DST%XEMISSIG_DST, DST%XEMISRADIUS_DST, JPMODE_DST, XDENSITY_DST, &
+coupling_flaken.F90: DST%XEMISRADIUS_DST, &!I [um] emitted radius for the modes (max 3)
+coupling_flaken.F90: DST%XEMISSIG_DST, &!I [-] emitted sigma for the different modes (max 3)
+coupling_flaken.F90: SLT%XEMISSIG_SLT, SLT%XEMISRADIUS_SLT, JPMODE_SLT, XDENSITY_SLT, &
+coupling_flaken.F90: SLT%XEMISRADIUS_SLT, &!I [um] emitted radius for the modes (max 3)
+coupling_flaken.F90: SLT%XEMISSIG_SLT, &!I [-] emitted sigma for the different modes (max 3)
+coupling_ideal_flux.F90: CUSTARTYPE, XUSTAR, XZ0, XALB, XEMIS, XTSRAD, &
+coupling_ideal_flux.F90:PEMIS = XEMIS
+coupling_isban.F90: ZTRAD_TILE, PDIR_ALB, PSCA_ALB, S%XEMIS_NAT, S%XTSRAD_NAT )
+coupling_isban.F90:PEMIS = S%XEMIS_NAT
+coupling_isban.F90: ZP_TA, ZP_RHOA, DSTK%XEMISSIG_DST, DSTK%XEMISRADIUS_DST, JPMODE_DST, &
+coupling_isban.F90: DSTK%XEMISRADIUS_DST, & !I [um] emitted radius for the modes (max 3)
+coupling_isban.F90: DSTK%XEMISSIG_DST, & !I [-] emitted sigma for the different modes (max 3)
+coupling_isban.F90: ZP_TA, ZP_RHOA, SLT%XEMISSIG_SLT, SLT%XEMISRADIUS_SLT, JPMODE_SLT, &
+coupling_isban.F90: SLT%XEMISRADIUS_SLT, & !I [um] emitted radius for the modes (max 3)
+coupling_isban.F90: SLT%XEMISSIG_SLT, & !I [-] emitted sigma for the different modes (max 3)
+coupling_isba_orographyn.F90: + XSTEFAN*S%XEMIS_NAT(:)*S%XTSRAD_NAT(:)**4 * (1.-Z3D_TOT_SURF_INV(:))
+coupling_seafluxn.F90:USE MODD_WATER_PAR, ONLY : XEMISWAT, XEMISWATICE
+coupling_seafluxn.F90:ZEMIS(:) = (1 - S%XSIC(:)) * XEMISWAT + S%XSIC(:) * XEMISWATICE
+coupling_seafluxn.F90:ZTRAD(:) = (((1 - S%XSIC(:)) * XEMISWAT * S%XSST (:)**4 + &
+coupling_seafluxn.F90: S%XSIC(:) * XEMISWATICE * S%XTICE(:)**4)/ ZEMIS(:)) ** 0.25
+coupling_seafluxn.F90:ZEMIS(:) = S%XEMIS(:)
+coupling_seafluxn.F90: PRHOA, DST%XEMISSIG_DST, DST%XEMISRADIUS_DST, JPMODE_DST, &
+coupling_seafluxn.F90: DST%XEMISRADIUS_DST, &!I [um] emitted radius for the modes (max 3)
+coupling_seafluxn.F90: DST%XEMISSIG_DST, &!I [-] emitted sigma for the different modes (max 3)
+coupling_seafluxn.F90: PRHOA, SLT%XEMISSIG_SLT, SLT%XEMISRADIUS_SLT, JPMODE_SLT, &
+coupling_seafluxn.F90: SLT%XEMISRADIUS_SLT, &!I [um] emitted radius for the modes (max 3)
+coupling_seafluxn.F90: SLT%XEMISSIG_SLT, &!I [-] emitted sigma for the different modes (max 3)
+coupling_sltn.F90: PSFSLT(:,2+(JN-1)*3) = PSFSLT(:,1+(JN-1)*3) * (SLT%XEMISRADIUS_SLT(JN)**3)*EXP(4.5 * LOG(SLT%XEMISSIG_SLT(JN))**2)
+coupling_sltn.F90: PSFSLT(:,3+(JN-1)*3) = PSFSLT(:,1+(JN-1)*3) * (SLT%XEMISRADIUS_SLT(JN)**6)*EXP(18. * LOG(SLT%XEMISSIG_SLT(JN))**2)
+coupling_sltn.F90: PSFSLT(:,JN) = ZSFSLT_MDE(:,JORDER_SLT(JN)) * (SLT%XEMISRADIUS_SLT(JN)**3)*EXP(4.5 * LOG(SLT%XEMISSIG_SLT(JN))**2)
+coupling_sltn.F90: PSFSLT(:,2+(JN-1)*2) = PSFSLT(:,1+(JN-1)*2) * (SLT%XEMISRADIUS_SLT(JN)**3)*EXP(4.5 * LOG(SLT%XEMISSIG_SLT(JN))**2)
+coupling_tebn.F90: DST%XEMISSIG_DST, DST%XEMISRADIUS_DST, JPMODE_DST, XDENSITY_DST, &
+coupling_tebn.F90: DST%XEMISRADIUS_DST, &!I [um] emitted radius for the modes (max 3)
+coupling_tebn.F90: DST%XEMISSIG_DST, &!I [-] emitted sigma for the different modes (max 3)
+coupling_tebn.F90: SLT%XEMISSIG_SLT, SLT%XEMISRADIUS_SLT, JPMODE_SLT, XDENSITY_SLT, &
+coupling_tebn.F90: SLT%XEMISRADIUS_SLT, &!I [um] emitted radius for the modes (max 3)
+coupling_tebn.F90: SLT%XEMISSIG_SLT, &!I [-] emitted sigma for the different modes (max 3)
+coupling_watfluxn.F90:ZEMIS = W%XEMIS
+coupling_watfluxn.F90: DST%XEMISSIG_DST, DST%XEMISRADIUS_DST, JPMODE_DST, XDENSITY_DST, &
+coupling_watfluxn.F90: DST%XEMISRADIUS_DST, &!I [um] emitted radius for the modes (max 3)
+coupling_watfluxn.F90: DST%XEMISSIG_DST, &!I [-] emitted sigma for the different modes (max 3)
+coupling_watfluxn.F90: SLT%XEMISSIG_SLT, SLT%XEMISRADIUS_SLT, JPMODE_SLT, XDENSITY_SLT, &
+coupling_watfluxn.F90: SLT%XEMISRADIUS_SLT, &!I [um] emitted radius for the modes (max 3)
+coupling_watfluxn.F90: SLT%XEMISSIG_SLT, &!I [-] emitted sigma for the different modes (max 3)
+dealloc_diag_surf_atmn.F90:DEALLOCATE(D%XEMIS )
+diag_cpl_esm_sea.F90:USE MODD_WATER_PAR, ONLY : XEMISWATICE
+diag_cpl_esm_sea.F90: S%XCPL_SEAICE_HEAT(:) = S%XCPL_SEAICE_HEAT(:) + PTSTEP * ( XEMISWATICE*(PLW(:)-XSTEFAN*ZTICE4(:)) &
+diag_cpl_esm_water.F90:USE MODD_WATER_PAR, ONLY : XEMISWATICE
+diag_cpl_esm_water.F90: W%XCPL_WATERICE_HEAT(:) = W%XCPL_WATERICE_HEAT(:) + PTSTEP * ( XEMISWATICE*(PLW(:)-XSTEFAN*ZTICE4(:)) &
+diag_inline_surf_atmn.F90:D%XEMIS = PEMIS
+diag_surf_budget_sea.F90:USE MODD_WATER_PAR, ONLY : XEMISWATICE, XALBSEAICE
+diag_surf_budget_sea.F90: DI%XLWU(:)=XEMISWATICE*XSTEFAN*S%XTICE(:)**4 + (1.-XEMISWATICE)*PLW(:)
+e_budget.F90:USE MODD_SNOW_PAR, ONLY : XEMISSN, XEMCRIN
+e_budget.F90: PEMIST(:) = PEK%XEMIS(:)
+e_budget.F90: PEMIST(:) = ((1.-KK%XFF(:)-PEK%XPSN(:))*PEK%XEMIS(:) + KK%XFF(:)*KK%XEMISF(:))/(1.-PEK%XPSN(:))
+e_budget.F90: PEMIST(:) = PEK%XEMIS(:)
+e_budget.F90: PEMIST(:) = PEK%XEMIS(:)-PEK%XPSN(:)*(PEK%XEMIS(:)-XEMCRIN)
+e_budget.F90: PEMIST(:) = ( 1.-PEK%XPSN(:)-KK%XFF(:))* PEK%XEMIS(:) + &
+e_budget.F90: PEK%XPSN(:) * XEMISSN + KK%XFF(:)*KK%XEMISF(:)
+emis_from_veg.F90:USE MODD_ISBA_PAR, ONLY : XEMISSOIL, XEMISVEG
+emis_from_veg.F90:USE MODD_SNOW_PAR, ONLY : XEMISSN
+emis_from_veg.F90:ZEMISSOIL = XEMISSN * PVEGTYPE(NVT_SNOW) &
+emis_from_veg.F90: + XEMISSOIL * (1.-PVEGTYPE(NVT_SNOW))
+emis_from_veg.F90:PEMIS = XEMISVEG * PVEG &
+emis_from_veg.F90:USE MODD_ISBA_PAR, ONLY : XEMISSOIL, XEMISVEG
+emis_from_veg.F90:USE MODD_SNOW_PAR, ONLY : XEMISSN
+emis_from_veg.F90:ZEMISSOIL(:) = XEMISSN * PVEGTYPE(:,NVT_SNOW) &
+emis_from_veg.F90: + XEMISSOIL * (1.-PVEGTYPE(:,NVT_SNOW))
+emis_from_veg.F90:PEMIS(:) = XEMISVEG * PVEG(:) &
+emis_from_veg.F90:USE MODD_ISBA_PAR, ONLY : XEMISSOIL, XEMISVEG
+emis_from_veg.F90:USE MODD_SNOW_PAR, ONLY : XEMISSN
+emis_from_veg.F90:ZEMISSOIL(:,:) = XEMISSN * PVEGTYPE(:,:,NVT_SNOW) &
+emis_from_veg.F90: + XEMISSOIL * (1.-PVEGTYPE(:,:,NVT_SNOW))
+emis_from_veg.F90:PEMIS(:,:) = XEMISVEG * PVEG(:,:) &
+emis_from_veg.F90:USE MODD_ISBA_PAR, ONLY : XEMISSOIL, XEMISVEG
+emis_from_veg.F90:USE MODD_SNOW_PAR, ONLY : XEMISSN
+emis_from_veg.F90: PEMIS(JJ) = XEMISVEG * PVEG(JJ) + XEMISSOIL * (1.-PVEG(JJ))
+emis_from_veg.F90: PEMIS(JJ) = XEMISSN
+flake_interface.F90: Q_w_flk = F%XEMIS(JL)*Q_atm_lw_in(JL) - sfcflx_lwradwsfc(F%XEMIS(JL),F%XTS(JL))
+ini_surf_csts.F90:USE MODD_SNOW_PAR, ONLY : XEMISSN, XANSMIN, XANSMAX, &
+ini_surf_csts.F90:NAMELIST/NAM_SURF_CSTS/ XEMISSN, XANSMIN, XANSMAX, XAGLAMIN, XAGLAMAX, &
+ini_surf_csts.F90: XALBWAT, XALBCOEF_TA96, XALBSCA_WAT, XEMISWAT, &
+ini_surf_csts.F90: XALBWATICE, XEMISWATICE, XHGLA, XWSNV, XCFFV, &
+ini_surf_csts.F90:XEMISWAT = XUNDEF
+ini_surf_csts.F90:XEMISWATICE = XUNDEF
+ini_surf_csts.F90:XEMISSN = XUNDEF
+ini_surf_csts.F90:IF(XEMISWAT==XUNDEF)THEN
+ini_surf_csts.F90: XEMISWAT = 0.98
+ini_surf_csts.F90: XEMISWAT = 0.96
+ini_surf_csts.F90:IF(XEMISWATICE==XUNDEF)THEN
+ini_surf_csts.F90: XEMISWATICE = 1.0
+ini_surf_csts.F90: XEMISWATICE = 0.97
+ini_surf_csts.F90:IF(XEMISSN==XUNDEF)THEN
+ini_surf_csts.F90: XEMISSN = 1.0
+ini_surf_csts.F90: XEMISSN = 0.99
+init_dst.F90:ALLOCATE(DSTK%XEMISRADIUS_DST(NDSTMDE))
+init_dst.F90:ALLOCATE(DSTK%XEMISSIG_DST (NDSTMDE))
+init_dst.F90: XEMISRADIUS_INI_DST(:) = 0.5d6 * (/ 0.0111e-6, 2.524e-6, 42.10e-6 /) ! [um] Mass median radius She84 p. 75 Table 1
+init_dst.F90: XEMISSIG_INI_DST (:) = (/ 1.89 , 2.0 , 2.13 /) ! [frc] Geometric standard deviation She84 p. 75 Table 1
+init_dst.F90: XEMISRADIUS_INI_DST(:) = 0.5d6 * (/0.27e-6 , 5.6e-6 , 57.6e-6 /) ! [um] Mass median radius PaG77 p. 2080 Table 1
+init_dst.F90: XEMISSIG_INI_DST (:) = (/ 1.88, 2.2 , 1.62 /) ! [frc] Geometric standard deviation PaG77 p. 2080 Table 1
+init_dst.F90: XEMISRADIUS_INI_DST(:) = 0.5d6 * (/ 0.832e-6 , 4.82e-6 , 19.38e-6 /) ! [um] Mass median radius BSM96 p. 73 Table 2
+init_dst.F90: XEMISSIG_INI_DST (:) = (/ 2.10, 1.90 , 1.60 /) ! [frc] Geometric standard deviation BSM96 p. 73 Table 2
+init_dst.F90: XEMISRADIUS_INI_DST(:) = 0.5*(/ 1.5, 6.7, 14.2 /) ! [um] Mass median radius BSM96 p. 73 Table 2
+init_dst.F90: XEMISSIG_INI_DST (:) = (/1.70, 1.60, 1.50/) ! [frc] Geometric standard deviation BSM96 p. 73 Table 2
+init_dst.F90: XEMISRADIUS_INI_DST(:) = 0.5*(/ 0.078, 0.641, 5.00 /) ! [um] Number median radius
+init_dst.F90: XEMISSIG_INI_DST (:) = (/ 1.75, 1.76, 1.70/) ! [frc] Geometric standard deviation
+init_dst.F90: XEMISRADIUS_INI_DST(:) = 0.5*(/ 0.078, 0.641, 5.00 /) ! [um] Number median radius
+init_dst.F90: XEMISSIG_INI_DST (:) = (/ 1.75, 1.76, 1.70 /) ! [frc] Geometric standard deviation
+init_dst.F90: DSTK%XEMISSIG_DST (JMODE) = XEMISSIG_INI_DST(JMODE_IDX)
+init_dst.F90: DSTK%XEMISRADIUS_DST(JMODE) = XEMISRADIUS_INI_DST(JMODE_IDX)
+init_dst.F90: DSTK%XEMISRADIUS_DST(JMODE) = DSTK%XEMISRADIUS_DST(JMODE) * EXP(-3.d0 * (LOG(DSTK%XEMISSIG_DST(JMODE)))**2)
+init_flaken.F90:ALLOCATE(FM%F%XEMIS (ILU))
+init_flaken.F90:FM%F%XEMIS = 0.0
+init_from_data_teb_vegn.F90: PEK%XEMIS(:) = DTV%XPAR_EMIS (:,ITIME,1)
+init_ideal_flux.F90:USE MODD_IDEAL_FLUX, ONLY : XSFTS, XALB, XEMIS
+init_ideal_flux.F90:PEMIS = XEMIS
+init_seafluxn.F90:ALLOCATE(SM%S%XEMIS (ILU))
+init_seafluxn.F90:SM%S%XEMIS = 0.0
+init_slt.F90:ALLOCATE(SLT%XEMISRADIUS_SLT(NSLTMDE))
+init_slt.F90:ALLOCATE(SLT%XEMISSIG_SLT (NSLTMDE))
+init_slt.F90: XEMISRADIUS_INI_SLT(:) = (/ 0.2, 2.0, 12. /) ! [um] Number median radius She84 p. 75 Table 1
+init_slt.F90: XEMISSIG_INI_SLT (:) = (/ 1.9, 2.0, 3.00 /) ! [frc] Geometric standard deviation She84 p. 75 Table 1
+init_slt.F90: XEMISRADIUS_INI_SLT(:) = 0.5*(/0.28, 2.25, 15.32/) ! [um] Mass median radius
+init_slt.F90: XEMISSIG_INI_SLT (:) = (/1.59, 2.00, 2.00 /) ! [frc] Geometric standard deviation
+init_slt.F90: SLT%XEMISSIG_SLT (JMODE) = XEMISSIG_INI_SLT (JMODE_IDX)
+init_slt.F90: SLT%XEMISRADIUS_SLT(JMODE) = XEMISRADIUS_INI_SLT(JMODE_IDX)
+init_slt.F90: SLT%XEMISRADIUS_SLT(JMODE) = SLT%XEMISRADIUS_SLT(JMODE) * EXP(-3.d0 * (LOG(SLT%XEMISSIG_SLT(JMODE)))**2)
+init_teb_gardenn.F90:ALLOCATE(K%XEMISF (KI))
+init_teb_gardenn.F90:K%XEMISF = 0.0
+init_teb_greenroofn.F90:ALLOCATE(K%XEMISF (KI))
+init_teb_greenroofn.F90:K%XEMISF = 0.0
+init_tebn.F90:USE MODD_SNOW_PAR, ONLY : XEMISSN
+init_tebn.F90: ALLOCATE(NT%AL(JP)%XEMIS_ROOF (ILU))
+init_tebn.F90: ALLOCATE(NT%AL(JP)%XEMIS_ROAD (ILU))
+init_tebn.F90: ALLOCATE(NT%AL(JP)%XEMIS_WALL (ILU))
+init_tebn.F90: ALLOCATE(TPN%XEMIS_PANEL (ILU))
+init_tebn.F90: CALL INIT_SNOW_LW(XEMISSN,NT%AL(JP)%TSNOW_ROOF)
+init_tebn.F90: CALL INIT_SNOW_LW(XEMISSN,NT%AL(JP)%TSNOW_ROAD)
+init_vegn.F90:USE MODD_SNOW_PAR, ONLY : XEMISSN
+init_vegn.F90: CALL INIT_SNOW_LW(XEMISSN,PEK%TSNOW)
+init_vegn.F90: PEK%XEMIS(JI) = EMIS_FROM_VEG(PEK%XVEG(JI),PK%XVEGTYPE_PATCH(JI,:))
+init_veg_pgdn.F90:USE MODD_SNOW_PAR, ONLY : XEMISSN
+init_watfluxn.F90:ALLOCATE(WM%W%XEMIS (ILU))
+init_watfluxn.F90:WM%W%XEMIS = 0.0
+isba_emis_meb.F90:USE MODD_ISBA_PAR, ONLY : XEMISSOIL, XEMISVEG
+isba_emis_meb.F90:ZEMISG(:) = ZSIGMA_FA(:)*XEMISVEG + (1.0-ZSIGMA_FA(:))*XEMISSOIL
+isba_emis_meb.F90:ZEMISN(:) = ZSIGMA_FA(:)*XEMISVEG + (1.0-ZSIGMA_FA(:))*PEMIS_N(:)
+isba_fluxes_meb.F90:USE MODD_ISBA_PAR, ONLY : XEMISSOIL, XEMISVEG
+isba_lwnet_meb.F90:USE MODD_ISBA_PAR, ONLY : XEMISSOIL, XEMISVEG
+isba_lwnet_meb.F90:ZEMIS_G(:) = XEMISSOIL*(1.-PFF(:)) + PFF(:)*PEMIS_F(:)
+isba_lwnet_meb.F90:PLW_B(:) = PLW_A(:)* PSIGMA_F(:) *(1.-XEMISVEG)
+isba_lwnet_meb.F90:PLW_F(:) = PSIGMA_FA(:) * XEMISVEG * PFRAC(:) *XSTEFAN*(PTV(:)**4)
+isba_lwnet_meb.F90:ZWORK(:) = (1.-XEMISVEG)*PSIGMA_FA(:)
+isba_meb.F90:CALL ISBA_LWNET_MEB(PEK%XLAI, PEK%XPSN, PPALPHAN,PEK%TSNOW%EMIS, KK%XEMISF, KK%XFF, &
+isba_properties.F90:USE MODD_SNOW_PAR , ONLY : XEMISSN, XEMCRIN, XSNOWDMIN, &
+isba_properties.F90:USE MODD_WATER_PAR , ONLY : XEMISWAT
+isba_properties.F90: PENOSNOW(:) = PEK%XEMIS(:)
+isba_properties.F90: PENOSNOW(:) = PEK%XEMIS(:)
+isba_properties.F90: PESNOW (:) = XEMISSN
+isba_properties.F90: PENOSNOW(:) = PEK%XEMIS(:)
+isba_snow_frac.F90:USE MODD_SNOW_PAR , ONLY : XEMISSN, XEMCRIN, XSNOWDMIN, &
+modd_ch_emis_fieldn.F90: REAL, DIMENSION(:,:), POINTER:: XEMIS_FIELDS ! emission pgd fields values
+modd_ch_emis_fieldn.F90: NULLIFY(YCH_EMIS_FIELD%XEMIS_FIELDS)
+modd_chs_aerosol.F90:REAL :: XEMISRADIUSI = 0.036 ! mean radius of primary aerosol
+modd_chs_aerosol.F90:REAL :: XEMISRADIUSJ = 0.385 ! mean radius of primary aerosol
+modd_chs_aerosol.F90:REAL :: XEMISSIGI = 1.86 ! dispersion of primary aerosol
+modd_chs_aerosol.F90:REAL :: XEMISSIGJ = 1.29 ! dispersion of primary aerosol
+modd_ch_snapn.F90: REAL, DIMENSION(:,:,:), POINTER:: XEMIS_FIELDS_SNAP ! Emission factor for
+modd_ch_snapn.F90: REAL, DIMENSION(:,:), POINTER:: XEMIS_FIELDS ! Emission for each specie
+modd_ch_snapn.F90: NULLIFY(YCH_EMIS_SNAP%XEMIS_FIELDS)
+modd_ch_snapn.F90: NULLIFY(YCH_EMIS_SNAP%XEMIS_FIELDS_SNAP)
+modd_diagn.F90: REAL, POINTER, DIMENSION(:) :: XEMIS ! surface emissivity at t (-)
+modd_diagn.F90: NULLIFY(D%XEMIS)
+modd_dstn.F90: REAL,DIMENSION(:), POINTER :: XEMISRADIUS_DST !Number median radius for each source mode
+modd_dstn.F90: REAL,DIMENSION(:), POINTER :: XEMISSIG_DST !sigma for each source mode
+modd_dstn.F90: NULLIFY(YDST%XEMISRADIUS_DST)
+modd_dstn.F90: NULLIFY(YDST%XEMISSIG_DST)
+modd_dst_surf.F90:REAL,DIMENSION(NEMISMODES_MAX) :: XEMISRADIUS_INI_DST ! number madian radius initialization for sea salt mode (um)
+modd_dst_surf.F90:REAL,DIMENSION(NEMISMODES_MAX) :: XEMISSIG_INI_DST ! dispersion initialization for sea salt mode
+modd_emis_gr_fieldn.F90: REAL, DIMENSION(:,:,:), POINTER:: XEMIS_GR_FIELDS ! emission pgd fields values
+modd_emis_gr_fieldn.F90: NULLIFY(YEMIS_GR_FIELD%XEMIS_GR_FIELDS)
+modd_flaken.F90: REAL, POINTER, DIMENSION(:) :: XEMIS ! water surface emissivity (NOT USED BY FLAKE)
+modd_flaken.F90: NULLIFY(YFLAKE%XEMIS)
+modd_forc_atm.F90:REAL, DIMENSION(:), ALLOCATABLE :: XEMIS ! emissivity
+modd_ideal_flux.F90:REAL :: XEMIS ! emissivity (-)
+modd_isban.F90:REAL, POINTER, DIMENSION(:) :: XEMIS_NAT ! patch averaged emissivity (-)
+modd_isban.F90:REAL, POINTER, DIMENSION(:) :: XEMISF ! Flood emissivity
+modd_isban.F90:REAL, POINTER, DIMENSION(:) :: XEMIS ! surface emissivity (-)
+modd_isban.F90:NULLIFY(YISBA_S%XEMIS_NAT)
+modd_isban.F90:NULLIFY(YISBA_K%XEMISF)
+modd_isban.F90:NULLIFY(YISBA_PE%XEMIS)
+modd_isba_par.F90:REAL, PARAMETER :: XEMISVEG = 0.97
+modd_isba_par.F90:REAL, PARAMETER :: XEMISSOIL = 0.94
+modd_seafluxn.F90: REAL, POINTER, DIMENSION(:) :: XEMIS ! emissivity
+modd_seafluxn.F90: NULLIFY(YSEAFLUX%XEMIS)
+modd_sltn.F90: REAL,DIMENSION(:), POINTER :: XEMISRADIUS_SLT ! Number median radius for each source mode
+modd_sltn.F90: REAL,DIMENSION(:), POINTER :: XEMISSIG_SLT ! sigma for each source mode
+modd_sltn.F90: NULLIFY(YSLT%XEMISRADIUS_SLT)
+modd_sltn.F90: NULLIFY(YSLT%XEMISSIG_SLT)
+modd_slt_surf.F90:REAL,DIMENSION(NEMISMODES_MAX) :: XEMISRADIUS_INI_SLT ! number madian radius initialization for sea salt mode (um)
+modd_slt_surf.F90:REAL,DIMENSION(NEMISMODES_MAX) :: XEMISSIG_INI_SLT ! dispersion initialization for sea salt mode
+modd_snow_par.F90:REAL, SAVE :: XEMISSN
+modd_tebn.F90: REAL, POINTER, DIMENSION(:) :: XEMIS_ROOF ! roof emissivity (-)
+modd_tebn.F90: REAL, POINTER, DIMENSION(:) :: XEMIS_ROAD ! road emissivity (-)
+modd_tebn.F90: REAL, POINTER, DIMENSION(:) :: XEMIS_WALL ! wall emissivity (-)
+modd_tebn.F90: NULLIFY(YTEB%XEMIS_ROOF)
+modd_tebn.F90: NULLIFY(YTEB%XEMIS_ROAD)
+modd_tebn.F90: NULLIFY(YTEB%XEMIS_WALL)
+modd_teb_paneln.F90: REAL, POINTER, DIMENSION(:) :: XEMIS_PANEL ! emissivity of solar panels (-)
+modd_teb_paneln.F90: NULLIFY(YTEB_PANEL%XEMIS_PANEL)
+modd_type_efutil.F90: INTEGER :: NDX ! Current index on array XEMISDATA
+modd_type_efutil.F90: REAL,DIMENSION(:,:), POINTER :: XEMISDATA ! Emission data array
+modd_water_par.F90:REAL, SAVE :: XEMISWAT
+modd_water_par.F90:REAL, SAVE :: XEMISWATICE
+modd_watfluxn.F90: REAL, POINTER, DIMENSION(:) :: XEMIS ! water surface emissivity (-)
+modd_watfluxn.F90: NULLIFY(YWATFLUX%XEMIS)
+mode_aer_surf.F90: * exp(-(3./2.)*log(XEMISSIGI)**2))**6 &
+mode_aer_surf.F90: * exp(18.*log(XEMISSIGI)**2)
+mode_aer_surf.F90: IF(PRESENT(PSIG1D)) PSIG1D(:,1) = XEMISSIGI
+mode_aer_surf.F90: * exp(-(3./2.)*log(XEMISSIGJ)**2))**6 &
+mode_aer_surf.F90: * exp(18.*log(XEMISSIGJ)**2)
+mode_aer_surf.F90: IF(PRESENT(PSIG1D)) PSIG1D(:,2) = XEMISSIGJ
+mode_teb_veg.F90: PEK%XEMIS(:)=0.94
+modn_chs_orilam.F90:USE MODD_CHS_AEROSOL, ONLY: LCH_AERO_FLUX, XEMISSIGI, XEMISSIGJ, &
+modn_chs_orilam.F90: XEMISRADIUSI, XEMISRADIUSJ, CRGUNIT,&
+modn_chs_orilam.F90:NAMELIST /NAM_CHS_ORILAM/ LCH_AERO_FLUX, XEMISSIGI, XEMISSIGJ, &
+modn_chs_orilam.F90: XEMISRADIUSI, XEMISRADIUSJ, CRGUNIT,&
+modn_ideal_flux.F90: XEMIS, XTSRAD_t=>XTSRAD, XTIMEF_f=>XTIMEF, XTIMET_t=>XTIMET
+modn_ideal_flux.F90: CUSTARTYPE, XUSTAR, XZ0, XALB, XEMIS, XTSRAD
+pgd_chemistry.F90:ALLOCATE(CHE%XEMIS_FIELDS (NL,CHE%NEMIS_NBR))
+pgd_chemistry.F90: CHE%XEMIS_FIELDS(:,JNBR) = (U%XNATURE(:)+U%XTOWN(:))*ZEMIS_FIELDS(:)
+pgd_chemistry.F90: CHE%XEMIS_FIELDS(:,JNBR) = U%XSEA*ZEMIS_FIELDS(:)
+pgd_chemistry.F90: CHE%XEMIS_FIELDS(:,JNBR) = ZEMIS_FIELDS(:)
+pgd_chemistry_snap.F90:ALLOCATE(CHN%XEMIS_FIELDS_SNAP(NL,NEMIS_SNAP,NEMIS_NBR))
+pgd_chemistry_snap.F90: CHN%XEMIS_FIELDS_SNAP(:,JSNAP,JSPEC) )
+prep_isba.F90:USE MODD_SNOW_PAR, ONLY : XEMISSN
+prep_isba.F90: CALL INIT_SNOW_LW(XEMISSN,NPE%AL(JP)%TSNOW)
+preps_for_meb_ebud_rad.F90:USE MODD_SNOW_PAR, ONLY : XRHOSMAX_ES, XRHOSMIN_ES, XEMISSN, XSNOWDMIN, &
+preps_for_meb_ebud_rad.F90:PEMISNOW(:) = XEMISSN
+read_namelists_ideal.F90: CUSTARTYPE, XUSTAR, XZ0, XALB, XEMIS, XTSRAD
+read_namelists_ideal.F90: CUSTARTYPE, XUSTAR, XZ0, XALB, XEMIS, XTSRAD)
+road_layer_e_budget.F90: (1 - T%XEMIS_ROAD(JJ))/T%XEMIS_ROAD(JJ) * PABS_LW_ROAD(JJ)
+roof_layer_e_budget.F90: + XSTEFAN * T%XEMIS_ROOF(JJ) * 4.*ZTS_ROOF(JJ)**3 &
+roof_layer_e_budget.F90: + T%XEMIS_ROOF(JJ)*PLW_RAD(JJ) &
+roof_layer_e_budget.F90: + XSTEFAN * T%XEMIS_ROOF(JJ) * ZTS_ROOF(JJ)**4 * ( 3.*ZIMPL-ZEXPL ) &
+roof_layer_e_budget.F90: PABS_LW_ROOF(JJ) = T%XEMIS_ROOF(JJ) * (PLW_RAD(JJ) - XSTEFAN * ZTRAD_ROOF(JJ)** 4)
+snow3l.F90:USE MODD_SNOW_PAR, ONLY : X_RI_MAX, XEMISSN
+snow3l.F90:PEMIST(:) = XEMISSN
+snow3L_isba.F90:USE MODD_SNOW_PAR, ONLY : XRHOSMAX_ES, XSNOWDMIN, XRHOSMIN_ES, XEMISSN
+snow3L_isba.F90: PEK%TSNOW%EMIS(:) = XEMISSN
+snow_cover_1layer.F90:USE MODD_SNOW_PAR, ONLY : XEMISSN
+snow_cover_1layer.F90: TPSNOW%EMIS (JJ) = XEMISSN
+snowcro.F90:USE MODD_SNOW_PAR, ONLY : X_RI_MAX, XEMISSN
+snowcro.F90:PEMIST(:) = XEMISSN
+solar_panel.F90: ZLWU_PANEL (:) = TPN%XEMIS_PANEL(:) * XSTEFAN * ZTS_PANEL(:)**4 &
+solar_panel.F90: + (1.-TPN%XEMIS_PANEL(:)) * PLW_RAD(:)
+teb.F90:USE MODD_SNOW_PAR, ONLY : XEMISSN, XANSMAX_ROOF, &
+teb_garden.F90:USE MODD_SNOW_PAR, ONLY: XEMISSN, XANSMAX
+teb_garden.F90: T%TSNOW_ROAD%EMIS(:) = XEMISSN
+teb_garden.F90: T%TSNOW_ROOF%EMIS(:) = XEMISSN
+update_esm_isban.F90: ZEMIS (IMASK,JP) = PEK%XEMIS(JI)
+update_esm_isban.F90: IF (PEK%XPSN(JI)<1.0.AND.PEK%XEMIS(JI)/=XUNDEF) THEN
+update_esm_isban.F90: ZEMIS(IMASK,JP) = ((1.-KK%XFF(JI)-PEK%XPSN(JI))*PEK%XEMIS(JI) + &
+update_esm_isban.F90: KK%XFF(JI)*KK%XEMISF(JI)) / (1.-PEK%XPSN(JI))
+update_esm_isban.F90: IF(PEK%XEMIS(JI)/=XUNDEF.AND.ZEMIS_PATCH(IMASK,JP)/=0.) THEN
+update_esm_isban.F90: PDIR_ALB, PSCA_ALB, S%XEMIS_NAT, S%XTSRAD_NAT )
+update_esm_isban.F90:PEMIS = S%XEMIS_NAT
+update_rad_flake.F90:USE MODD_WATER_PAR, ONLY : XALBSCA_WAT, XALBWAT, XEMISWAT, XEMISWATICE
+update_rad_flake.F90:USE MODD_SNOW_PAR, ONLY : XEMISSN
+update_rad_flake.F90: F%XEMIS (:) = XEMISSN
+update_rad_flake.F90: F%XEMIS (:) = XEMISWATICE
+update_rad_flake.F90: F%XEMIS (:) = XEMISWAT
+update_rad_flake.F90:PEMIS_ATMOS(:) = F%XEMIS(:)
+update_rad_isban.F90:USE MODD_SNOW_PAR, ONLY : XRHOSMIN_ES,XRHOSMAX_ES,XSNOWDMIN,XEMISSN
+update_rad_isban.F90:USE MODD_WATER_PAR, ONLY : XALBSCA_WAT, XEMISWAT, XALBWATICE, XEMISWATICE
+update_rad_isban.F90: KK%XEMISF (:) = XUNDEF
+update_rad_isban.F90: KK%XEMISF (:) = XEMISWAT
+update_rad_isban.F90: KK%XEMISF (:) = XEMISWATICE
+update_rad_isban.F90: ZEMISF(:) = KK%XEMISF(:)
+update_rad_isban.F90: ZEMISSN(:) = XEMISSN
+update_rad_isban.F90: ZEMIST(:) = (1.-PEK%XPSN(:)-ZFF(:))*PEK%XEMIS(:) + PEK%XPSN(:) * XEMISSN + ZFF(:)*ZEMISF(:)
+update_rad_sea.F90:USE MODD_WATER_PAR, ONLY : XEMISWAT, XEMISWATICE, &
+update_rad_sea.F90: S%XEMIS (:) = XEMISWAT
+update_rad_sea.F90: S%XEMIS (:) = XEMISWATICE
+update_rad_sea.F90: S%XEMIS (:) = ( 1 - S%XSIC(:)) * XEMISWAT + S%XSIC(:) * XEMISWATICE
+update_rad_sea.F90: S%XEMIS (:) = XEMISWAT
+update_rad_sea.F90: S%XEMIS (:) = XEMISWATICE
+update_rad_sea.F90: S%XEMIS (:) = XEMISWAT
+update_rad_sea.F90: S%XEMIS (:) = XEMISWATICE
+update_rad_sea.F90:PEMIS_ATMOS(:) = S%XEMIS(:)
+update_rad_sea.F90: PTRAD(:) = (((1 - S%XSIC(:)) * XEMISWAT * S%XSST (:)**4 + &
+update_rad_sea.F90: S%XSIC(:) * XEMISWATICE * S%XTICE(:)**4)/ &
+update_rad_sea.F90: S%XEMIS(:)) ** 0.25
+update_rad_water.F90:USE MODD_WATER_PAR, ONLY : XEMISWAT, XEMISWATICE, &
+update_rad_water.F90: W%XEMIS (:) = XEMISWAT
+update_rad_water.F90: W%XEMIS (:) = XEMISWATICE
+update_rad_water.F90: W%XEMIS (:) = XEMISWAT
+update_rad_water.F90: W%XEMIS (:) = XEMISWATICE
+update_rad_water.F90: W%XEMIS (:) = XEMISWAT
+update_rad_water.F90: W%XEMIS (:) = XEMISWATICE
+update_rad_water.F90:PEMIS_ATMOS(:) = W%XEMIS(:)
+urban_lw_coef.F90: PLW_WA_TO_WB(JJ)=ZLW(T%XEMIS_WALL(JJ),T%XEMIS_WALL(JJ),ZF_W_W(JJ),T%XT_WALL_A(JJ,1),T%XT_WALL_B(JJ,1))
+urban_lw_coef.F90: PLW_WA_TO_R(JJ) = ZLW(T%XEMIS_WALL(JJ),T%XEMIS_ROAD(JJ),ZF_R_W(JJ),T%XT_WALL_A(JJ,1),T%XT_ROAD(JJ,1))
+urban_lw_coef.F90: PLW_WB_TO_R(JJ) = ZLW(T%XEMIS_WALL(JJ),T%XEMIS_ROAD(JJ),ZF_R_W(JJ),T%XT_WALL_B(JJ,1),T%XT_ROAD(JJ,1))
+urban_lw_coef.F90: PLW_R_TO_WA(JJ) = ZLW(T%XEMIS_ROAD(JJ),T%XEMIS_WALL(JJ),ZF_W_R(JJ),T%XT_ROAD(JJ,1),T%XT_WALL_A(JJ,1))
+urban_lw_coef.F90: PLW_R_TO_WB(JJ) = ZLW(T%XEMIS_ROAD(JJ),T%XEMIS_WALL(JJ),ZF_W_R(JJ),T%XT_ROAD(JJ,1),T%XT_WALL_B(JJ,1))
+urban_lw_coef.F90: PLW_WA_TO_G(JJ) = ZLW(T%XEMIS_WALL(JJ),PEMIS_G(JJ),ZF_G_W(JJ),T%XT_WALL_A(JJ,1),PTS_G(JJ))
+urban_lw_coef.F90: PLW_WB_TO_G(JJ) = ZLW(T%XEMIS_WALL(JJ),PEMIS_G(JJ),ZF_G_W(JJ),T%XT_WALL_B(JJ,1),PTS_G(JJ))
+urban_lw_coef.F90: PLW_G_TO_WA(JJ) = ZLW(PEMIS_G(JJ),T%XEMIS_WALL(JJ),ZF_W_G(JJ),PTS_G(JJ),T%XT_WALL_A(JJ,1))
+urban_lw_coef.F90: PLW_G_TO_WB(JJ) = ZLW(PEMIS_G(JJ),T%XEMIS_WALL(JJ),ZF_W_G(JJ),PTS_G(JJ),T%XT_WALL_B(JJ,1))
+urban_lw_coef.F90: PLW_WA_TO_NR(JJ) = ZLW(T%XEMIS_WALL(JJ),T%TSNOW_ROAD%EMIS(JJ),ZF_R_W(JJ),T%XT_WALL_A(JJ,1),PTS_SR(JJ))
+urban_lw_coef.F90: PLW_WB_TO_NR(JJ) = ZLW(T%XEMIS_WALL(JJ),T%TSNOW_ROAD%EMIS(JJ),ZF_R_W(JJ),T%XT_WALL_B(JJ,1),PTS_SR(JJ))
+urban_lw_coef.F90: PLW_NR_TO_WA(JJ) = ZLW(T%TSNOW_ROAD%EMIS(JJ),T%XEMIS_WALL(JJ),ZF_W_NR(JJ),PTS_SR(JJ),T%XT_WALL_A(JJ,1))
+urban_lw_coef.F90: PLW_NR_TO_WB(JJ) = ZLW(T%TSNOW_ROAD%EMIS(JJ),T%XEMIS_WALL(JJ),ZF_W_NR(JJ),PTS_SR(JJ),T%XT_WALL_B(JJ,1))
+urban_lw_coef.F90: PLW_WIN_TO_R(JJ)= ZLW(ZEMIS_WIN(JJ),T%XEMIS_ROAD(JJ),ZF_R_WIN(JJ),B%XT_WIN1(JJ),T%XT_ROAD(JJ,1))
+urban_lw_coef.F90: PLW_R_TO_WIN(JJ)= ZLW(T%XEMIS_ROAD(JJ),ZEMIS_WIN(JJ),ZF_WIN_R(JJ),T%XT_ROAD(JJ,1),B%XT_WIN1(JJ))
+urban_lw_coef.F90: PLW_WIN_TO_WA(JJ) = ZLW(ZEMIS_WIN(JJ),T%XEMIS_WALL(JJ),ZF_W_WIN(JJ),B%XT_WIN1(JJ),T%XT_WALL_A(JJ,1))
+urban_lw_coef.F90: PLW_WIN_TO_WB(JJ) = ZLW(ZEMIS_WIN(JJ),T%XEMIS_WALL(JJ),ZF_W_WIN(JJ),B%XT_WIN1(JJ),T%XT_WALL_B(JJ,1))
+urban_lw_coef.F90: PLW_WA_TO_WIN(JJ) = ZLW(T%XEMIS_WALL(JJ),ZEMIS_WIN(JJ),ZF_WIN_W(JJ),T%XT_WALL_A(JJ,1),B%XT_WIN1(JJ))
+urban_lw_coef.F90: PLW_WB_TO_WIN(JJ) = ZLW(T%XEMIS_WALL(JJ),ZEMIS_WIN(JJ),ZF_WIN_W(JJ),T%XT_WALL_B(JJ,1),B%XT_WIN1(JJ))
+urban_lw_coef.F90: PLW_S_TO_WA(JJ) = ZLW(1.,T%XEMIS_WALL(JJ),T%XSVF_WALL(JJ),ZT_S(JJ),T%XT_WALL_A(JJ,1))
+urban_lw_coef.F90: PLW_S_TO_WB(JJ) = ZLW(1.,T%XEMIS_WALL(JJ),T%XSVF_WALL(JJ),ZT_S(JJ),T%XT_WALL_B(JJ,1))
+urban_lw_coef.F90: PLW_S_TO_R(JJ) = ZLW(1.,T%XEMIS_ROAD(JJ),T%XSVF_ROAD(JJ),ZT_S(JJ),T%XT_ROAD(JJ,1))
+vegetation_evol.F90: WHERE( PEK%XVEG(:) > 0. ) PEK%XEMIS(:)= EMIS_FROM_VEG(PEK%XVEG(:),PK%XVEGTYPE_PATCH(:,:))
+vegetation_update.F90: PEK%XEMIS (:) = 0.94
+wall_layer_e_budget.F90: (1 - T%XEMIS_WALL(:))/T%XEMIS_WALL(:) * PABS_LW_WL(:)
+write_cover_tex_water.F90:USE MODD_WATER_PAR, ONLY : XALBWAT, XALBSCA_WAT, XEMISWAT
+write_cover_tex_water.F90: WRITE(YSTRING6, FMT='(F4.2)') XEMISWAT
+write_diag_ch_aggr.F90: CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,CHE%TSEMISS(JSPEC)%XEMISDATA,IRESP,HCOMMENT=YCOMMENT,&
+write_diag_ch_snapn.F90: CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,CHN%XEMIS_FIELDS(:,JSPEC),IRESP,HCOMMENT=YCOMMENT)
+write_diag_pgd_grdnn.F90: CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,PEK%XEMIS(:),IRESP,HCOMMENT=YCOMMENT)
+write_diag_pgd_isban.F90: NP%AL(JP)%NR_P,NPE%AL(JP)%XEMIS(:),ILU,S%XWORK_WR)
+write_diag_pgd_tebn.F90: CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XEMIS_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
+write_diag_pgd_tebn.F90: CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XEMIS_WALL(:),IRESP,HCOMMENT=YCOMMENT)
+write_diag_pgd_tebn.F90: CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XEMIS_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
+write_diag_seb_surf_atmn.F90: CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XEMIS(:),IRESP,HCOMMENT=YCOMMENT)
+writesurf_ch_emisn.F90:REAL,DIMENSION(SIZE(CHE%XEMIS_FIELDS,1),KSIZE) :: ZWORK2D
+writesurf_ch_emisn.F90:ZWORK2D(:,:) = CHE%XEMIS_FIELDS(:,IINDEX(:))
+writesurf_snapn.F90: HPROGRAM,YRECFM,CHN%XEMIS_FIELDS_SNAP(:,JSNAP,JSPEC),IRESP,YCOMMENT)
diff --git a/src/SURFEX/liste_oasis b/src/SURFEX/liste_oasis
new file mode 100644
index 0000000000000000000000000000000000000000..3d27fc910c54f4cf3e147e7b9fb6b5df6a5f07a3
--- /dev/null
+++ b/src/SURFEX/liste_oasis
@@ -0,0 +1,10 @@
+modd_sfx_oasis.F90
+modn_sfx_oasis.F90
+sfx_oasis_check.F90
+sfx_oasis_define.F90
+sfx_oasis_end.F90
+sfx_oasis_init.F90
+sfx_oasis_prep.F90
+sfx_oasis_read_nam.F90
+sfx_oasis_recv.F90
+sfx_oasis_send.F90
diff --git a/src/SURFEX/make_choice_array.F90 b/src/SURFEX/make_choice_array.F90
new file mode 100644
index 0000000000000000000000000000000000000000..afa1c55d5d127f6c69168d68b4d866023c1d7f7c
--- /dev/null
+++ b/src/SURFEX/make_choice_array.F90
@@ -0,0 +1,55 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+SUBROUTINE MAKE_CHOICE_ARRAY(HPROGRAM, KNPATCH, ODIM, HRECFM, PWORK, HDIR, KPATCH)
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODI_READ_SURF
+!
+IMPLICIT NONE
+!
+ CHARACTER(LEN=*), INTENT(IN) :: HPROGRAM
+INTEGER, INTENT(IN) :: KNPATCH
+LOGICAL, INTENT(IN) :: ODIM
+ CHARACTER(LEN=*), INTENT(IN) :: HRECFM
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PWORK
+!
+ CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HDIR
+INTEGER, INTENT(IN), OPTIONAL :: KPATCH
+!
+ CHARACTER(LEN=LEN_HREC) :: YRECFM
+INTEGER :: JP, IRESP, IPATCH
+ CHARACTER(LEN=1) :: YDIR
+ CHARACTER(LEN=2) :: YPAT
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MAKE_CHOICE_ARRAY',0,ZHOOK_HANDLE)
+!
+YDIR = 'H'
+IF (PRESENT(HDIR)) YDIR = HDIR
+!
+IPATCH = -1
+IF (KNPATCH==1.AND.PRESENT(KPATCH)) IPATCH = KPATCH
+!
+IF (ODIM) THEN
+ DO JP=1,KNPATCH
+ IF (IPATCH==-1) THEN
+ WRITE(YPAT,'(I2)') JP
+ ELSEIF (IPATCH/=0) THEN
+ WRITE(YPAT,'(I2)') IPATCH
+ ENDIF
+ YRECFM=ADJUSTL(HRECFM(:LEN_TRIM(HRECFM)))
+ IF (IPATCH/=0) YRECFM=TRIM(YRECFM)//'P'//ADJUSTL(YPAT(:LEN_TRIM(YPAT)))
+ CALL READ_SURF(HPROGRAM,YRECFM,PWORK(:,JP),IRESP,HDIR=YDIR)
+ ENDDO
+ELSE
+ CALL READ_SURF(HPROGRAM,HRECFM,PWORK(:,:),IRESP,HDIR=YDIR)
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('MAKE_CHOICE_ARRAY',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE MAKE_CHOICE_ARRAY
+
diff --git a/src/SURFEX/make_lcover.F90 b/src/SURFEX/make_lcover.F90
new file mode 100644
index 0000000000000000000000000000000000000000..e7b8a655cf6eceb71d4c8e55ae52620d67f55111
--- /dev/null
+++ b/src/SURFEX/make_lcover.F90
@@ -0,0 +1,132 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+
+! #########
+ SUBROUTINE MAKE_LCOVER(OCOVER)
+! ##############################################################
+!
+!!**** *PGD_COVER* monitor for averaging and interpolations of cover fractions
+!!
+!! PURPOSE
+!! -------
+!!
+!! METHOD
+!! ------
+!!
+!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!!
+!! MODIFICATION
+!! ------------
+!!
+!! Original 10/12/97
+!!
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATION
+! -----------
+!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NPROC, NCOMM
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+#ifdef SFX_MNH
+USE MODD_IO_ll, ONLY : ISIOP, ISP, ISNPROC
+USE MODD_VAR_ll, ONLY : NMNH_COMM_WORLD
+#endif
+!
+IMPLICIT NONE
+!
+#if defined(SFX_MPI) || defined(SFX_MNH)
+INCLUDE "mpif.h"
+#endif
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+LOGICAL, DIMENSION(:), INTENT(INOUT) :: OCOVER
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+INTEGER :: INFOMPI, JPROC, JCOVER
+!
+INTEGER :: IRANK_SAVE, IPROC_SAVE, IPIO_SAVE, ICOMM_SAVE
+!
+LOGICAL, DIMENSION(:,:), ALLOCATABLE :: GCOVER_ALL
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!---------------------------------------------------------------
+!
+!* 1. Initializations
+! ---------------
+!
+IF (LHOOK) CALL DR_HOOK('MAKE_LCOVER',0,ZHOOK_HANDLE)
+!
+#ifdef SFX_MNH
+IRANK_SAVE = NRANK
+IPROC_SAVE = NPROC
+IPIO_SAVE = NPIO
+ICOMM_SAVE = NCOMM
+!
+! on met les infos de mésonh
+NRANK = ISP-1
+NPROC = ISNPROC
+NPIO = ISIOP-1
+NCOMM = NMNH_COMM_WORLD
+#endif
+!
+ALLOCATE(GCOVER_ALL(SIZE(OCOVER),0:NPROC-1))
+!
+!
+IF (NPROC>1) THEN
+#if defined(SFX_MPI) || defined(SFX_MNH)
+ CALL MPI_ALLGATHER(OCOVER,SIZE(OCOVER),MPI_LOGICAL,GCOVER_ALL,SIZE(OCOVER),&
+ MPI_LOGICAL,NCOMM,INFOMPI)
+#endif
+ELSE
+ GCOVER_ALL(:,0) = OCOVER(:)
+ENDIF
+!
+!
+OCOVER(:) = .FALSE.
+DO JPROC = 0,NPROC-1
+ DO JCOVER=1,SIZE(OCOVER)
+ IF (GCOVER_ALL(JCOVER,JPROC)) OCOVER(JCOVER) = .TRUE.
+ ENDDO
+ENDDO
+!
+DEALLOCATE(GCOVER_ALL)
+!
+!
+IF (NPROC>1) THEN
+#if defined(SFX_MPI) || defined(SFX_MNH)
+ CALL MPI_BCAST(OCOVER,SIZE(OCOVER),MPI_LOGICAL,NPIO,NCOMM,INFOMPI)
+#endif
+ENDIF
+!
+#ifdef SFX_MNH
+NRANK = IRANK_SAVE
+NPROC = IPROC_SAVE
+NPIO = IPIO_SAVE
+NCOMM = ICOMM_SAVE
+#endif
+!
+IF (LHOOK) CALL DR_HOOK('MAKE_LCOVER',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE MAKE_LCOVER
diff --git a/src/SURFEX/mass_layer_e_budget.F90 b/src/SURFEX/mass_layer_e_budget.F90
index 2f8eed90a64a9ffa6ab4f3052975d6e6058bd9c6..55b32fd2d748126fa70779d0108ab6372a8ec1f6 100644
--- a/src/SURFEX/mass_layer_e_budget.F90
+++ b/src/SURFEX/mass_layer_e_budget.F90
@@ -3,13 +3,9 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ##########################################################################
- SUBROUTINE MASS_LAYER_E_BUDGET(PT_MASS, PTSTEP, PHC_MASS, PTC_MASS, PD_MASS, &
- PFLX_BLD_MASS, PDQS_MASS, PIMB_MASS, &
- PF_MASS_WALL, PF_MASS_WIN, &
- PF_MASS_FLOOR, PRADHT_IN, &
- PRAD_WALL_MASS, PRAD_ROOF_MASS, &
- PRAD_WIN_MASS, PLOAD_MASS, PTI_BLD, &
- PRAD_FLOOR_MASS, PCONV_MASS_BLD )
+ SUBROUTINE MASS_LAYER_E_BUDGET(B, PTSTEP, PFLX_BLD_MA, PDQS_MA, PIMB_MA, PRADHT_IN, &
+ PRAD_WL_MA, PRAD_RF_MA, PRAD_WIN_MA, PLOAD_MA, &
+ PRAD_FL_MA, PCONV_MA_BLD )
! ##########################################################################
!
!!**** *MASS_LAYER_E_BUDGET*
@@ -73,6 +69,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_BEM_n, ONLY : BEM_t
+!
USE MODI_LAYER_E_BUDGET_GET_COEF
USE MODI_LAYER_E_BUDGET
USE MODE_CONV_DOE
@@ -84,27 +82,20 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PT_MASS ! floor layers temperatures
+TYPE(BEM_t), INTENT(INOUT) :: B
+!
REAL, INTENT(IN) :: PTSTEP ! time step
-REAL, DIMENSION(:,:), INTENT(IN) :: PHC_MASS ! heat capacity for road layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PTC_MASS ! thermal conductivity for
- !road layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_MASS ! depth of road layers
-REAL, DIMENSION(:), INTENT(OUT) :: PFLX_BLD_MASS !flux from building to floor
-REAL, DIMENSION(:), INTENT(OUT) :: PDQS_MASS !heat storage inside the floor
-REAL, DIMENSION(:), INTENT(OUT) :: PIMB_MASS !floor energy residual imbalance for verification
-REAL, DIMENSION(:), INTENT(IN) :: PF_MASS_WALL ! View factor mass-wall
-REAL, DIMENSION(:), INTENT(IN) :: PF_MASS_WIN ! View factor mass-window
-REAL, DIMENSION(:), INTENT(IN) :: PF_MASS_FLOOR ! View factor mass-floor
+REAL, DIMENSION(:), INTENT(OUT) :: PFLX_BLD_MA !flux from building to floor
+REAL, DIMENSION(:), INTENT(OUT) :: PDQS_MA !heat storage inside the floor
+REAL, DIMENSION(:), INTENT(OUT) :: PIMB_MA !floor energy residual imbalance for verification
REAL, DIMENSION(:), INTENT(IN) :: PRADHT_IN ! Indoor radiant heat transfer coefficient
! [W K-1 m-2]
-REAL, DIMENSION(:), INTENT(IN) :: PRAD_ROOF_MASS ! rad. fluxes from roof to floor[W m-2(roof)]
-REAL, DIMENSION(:), INTENT(IN) :: PRAD_WALL_MASS ! rad. fluxes from wall to floor[W m-2(wall)]
-REAL, DIMENSION(:), INTENT(IN) :: PRAD_WIN_MASS ! rad. fluxes from win to floor[W m-2(win)]
-REAL, DIMENSION(:), INTENT(IN) :: PTI_BLD ! indoor air temp.
-REAL, DIMENSION(:), INTENT(IN) :: PLOAD_MASS ! solar and internal load to the floor
-REAL, DIMENSION(:), INTENT(IN) :: PRAD_FLOOR_MASS ! rad. fluxes from floor to mass [W m-2(floor)]
-REAL, DIMENSION(:), INTENT(OUT) :: PCONV_MASS_BLD ! conv. fluxes from floor to bld [W m-2(floor)]
+REAL, DIMENSION(:), INTENT(IN) :: PRAD_RF_MA ! rad. fluxes from roof to floor[W m-2(roof)]
+REAL, DIMENSION(:), INTENT(IN) :: PRAD_WL_MA ! rad. fluxes from wall to floor[W m-2(wall)]
+REAL, DIMENSION(:), INTENT(IN) :: PRAD_WIN_MA ! rad. fluxes from win to floor[W m-2(win)]
+REAL, DIMENSION(:), INTENT(IN) :: PLOAD_MA ! solar and internal load to the floor
+REAL, DIMENSION(:), INTENT(IN) :: PRAD_FL_MA ! rad. fluxes from floor to mass [W m-2(floor)]
+REAL, DIMENSION(:), INTENT(OUT) :: PCONV_MA_BLD ! conv. fluxes from floor to bld [W m-2(floor)]
!
!* 0.2 declarations of local variables
!
@@ -112,15 +103,15 @@ REAL, DIMENSION(:), INTENT(OUT) :: PCONV_MASS_BLD ! conv. fluxes from floor t
REAL :: ZIMPL=1.0 ! implicit coefficient
REAL :: ZEXPL=0.0 ! explicit coefficient
!
-REAL, DIMENSION(SIZE(PT_MASS,1),SIZE(PT_MASS,2)) :: ZA,& ! lower diag.
+REAL, DIMENSION(SIZE(B%XT_MASS,1),SIZE(B%XT_MASS,2)) :: ZA,& ! lower diag.
ZB,& ! main diag.
ZC,& ! upper diag.
ZY ! r.h.s.
!
-REAL, DIMENSION(SIZE(PT_MASS,1)) :: ZTS_MASS ! surf. mass temp.
+REAL, DIMENSION(SIZE(B%XT_MASS,1)) :: ZTS_MA ! surf. mass temp.
! used during calculation
-REAL, DIMENSION(SIZE(PT_MASS,1)) :: ZTS_MASS_CONV ! surf. mass temp. used for conv flux
-REAL, DIMENSION(SIZE(PT_MASS,1)) :: ZCHTC_IN_MASS ! Indoor floor convec heat transfer coefficient
+REAL, DIMENSION(SIZE(B%XT_MASS,1)) :: ZTS_MA_CONV ! surf. mass temp. used for conv flux
+REAL, DIMENSION(SIZE(B%XT_MASS,1)) :: ZCHTC_IN_MA ! Indoor floor convec heat transfer coefficient
! [W K-1 m-2(bld)]
INTEGER :: JJ
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -129,53 +120,49 @@ IF (LHOOK) CALL DR_HOOK('MASS_LAYER_E_BUDGET',0,ZHOOK_HANDLE)
!
! *Convection heat transfer coefficients [W m-2 K-1] from EP Engineering Reference
!
-ZCHTC_IN_MASS(:) = CHTC_VERT_DOE(PT_MASS(:,1), PTI_BLD(:))
-DO JJ=1,SIZE(ZCHTC_IN_MASS)
- ZCHTC_IN_MASS(JJ) = MAX(1., ZCHTC_IN_MASS(JJ))
+ZCHTC_IN_MA(:) = CHTC_VERT_DOE(B%XT_MASS(:,1), B%XTI_BLD(:))
+DO JJ=1,SIZE(ZCHTC_IN_MA)
+ ZCHTC_IN_MA(JJ) = MAX(1., ZCHTC_IN_MA(JJ))
ENDDO
!
- CALL LAYER_E_BUDGET_GET_COEF( PT_MASS, PTSTEP, ZIMPL, PHC_MASS, PTC_MASS, PD_MASS, &
+ CALL LAYER_E_BUDGET_GET_COEF( B%XT_MASS, PTSTEP, ZIMPL, B%XHC_FLOOR, B%XTC_FLOOR, B%XD_FLOOR/2., &
ZA, ZB, ZC, ZY )
!
-ZTS_MASS(:) = PT_MASS(:,1)
+ZTS_MA(:) = B%XT_MASS(:,1)
-ZB(:,1) = ZB(:,1) + ZIMPL * 4./3. * ZCHTC_IN_MASS(:)
+ZB(:,1) = ZB(:,1) + ZIMPL * 4./3. * ZCHTC_IN_MA(:)
ZY(:,1) = ZY(:,1) &
- + ZCHTC_IN_MASS(:) * (PTI_BLD(:) - 1./3. * PT_MASS(:, 1) * (4 * ZEXPL -1.)) &
- + PF_MASS_WIN (:) * PRAD_WIN_MASS(:) &
- + PF_MASS_WALL (:) * PRAD_WALL_MASS(:) &
- + PF_MASS_FLOOR (:) * (PRAD_ROOF_MASS(:) +PRAD_FLOOR_MASS(:)) &
- + PLOAD_MASS(:)
+ + ZCHTC_IN_MA(:) * (B%XTI_BLD(:) - 1./3. * B%XT_MASS(:, 1) * (4 * ZEXPL -1.)) &
+ + B%XF_MASS_WIN (:) * PRAD_WIN_MA(:) + B%XF_MASS_WALL (:) * PRAD_WL_MA(:) &
+ + B%XF_MASS_FLOOR (:) * (PRAD_RF_MA(:) +PRAD_FL_MA(:)) + PLOAD_MA(:)
!
- CALL LAYER_E_BUDGET( PT_MASS, PTSTEP, ZIMPL, PHC_MASS, PTC_MASS, PD_MASS, &
- ZA, ZB, ZC, ZY, PDQS_MASS )
+ CALL LAYER_E_BUDGET( B%XT_MASS, PTSTEP, ZIMPL, B%XHC_FLOOR, B%XTC_FLOOR, B%XD_FLOOR/2., &
+ ZA, ZB, ZC, ZY, PDQS_MA )
!
!* calculation of temperature used in energy balance calculation
! -------------------------------------------------------------
!
-ZTS_MASS_CONV(:) = ZIMPL * 4./3. * PT_MASS(:,1) +1./3 * ZTS_MASS(:) * (4 * ZEXPL -1.)
-ZTS_MASS(:) = ZEXPL * ZTS_MASS(:) + ZIMPL * PT_MASS(:,1)
+ZTS_MA_CONV(:) = ZIMPL * 4./3. * B%XT_MASS(:,1) +1./3 * ZTS_MA(:) * (4 * ZEXPL -1.)
+ZTS_MA(:) = ZEXPL * ZTS_MA(:) + ZIMPL * B%XT_MASS(:,1)
!
!* calculation of convection flux between mass and building air
! ------------------------------------------------------------
!
-PCONV_MASS_BLD(:) = ZCHTC_IN_MASS(:) * (ZTS_MASS_CONV(:) - PTI_BLD(:))
+PCONV_MA_BLD(:) = ZCHTC_IN_MA(:) * (ZTS_MA_CONV(:) - B%XTI_BLD(:))
!
!* For diagnostics calculation of flux exchanged between the mass and the
! indoor
! ------------------------------------------------
!
-PFLX_BLD_MASS(:) = - PCONV_MASS_BLD(:) &
- + PF_MASS_WIN (:) * PRAD_WIN_MASS(:) &
- + PF_MASS_WALL (:) * PRAD_WALL_MASS(:) &
- + PF_MASS_FLOOR (:) * (PRAD_ROOF_MASS(:) + PRAD_FLOOR_MASS(:)) &
- + PLOAD_MASS(:)
+PFLX_BLD_MA(:) = - PCONV_MA_BLD(:) + B%XF_MASS_WIN (:) * PRAD_WIN_MA(:) &
+ + B%XF_MASS_WALL (:) * PRAD_WL_MA(:) &
+ + B%XF_MASS_FLOOR (:) * (PRAD_RF_MA(:) + PRAD_FL_MA(:)) + PLOAD_MA(:)
!
!* Floor residual energy imbalance for verification
! ------------------------------------------------
!
-PIMB_MASS(:) = PFLX_BLD_MASS(:) - PDQS_MASS(:)
+PIMB_MA(:) = PFLX_BLD_MA(:) - PDQS_MA(:)
!
IF (LHOOK) CALL DR_HOOK('MASS_LAYER_E_BUDGET',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/minzs_vert_shift.F90 b/src/SURFEX/minzs_vert_shift.F90
index 839327a45f8c9cf81409fb36376aa13780fdac4d..1a74807f8cef4d5bfc5e574836fdc7c254a099a9 100644
--- a/src/SURFEX/minzs_vert_shift.F90
+++ b/src/SURFEX/minzs_vert_shift.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE MINZS_VERT_SHIFT(PZS_MOY,PZS_MIN,PTA_2M,PQA_2M,PPA_2M,PRHOA_2M, &
- PTA_2M_MIN,PQA_2M_MIN,PPA_2M_MIN,PRHOA_2M_MIN )
+ SUBROUTINE MINZS_VERT_SHIFT(D, PZS_MOY, PZS_MIN, PPS_MIN, PRHOA_2M_MIN )
! #########################################
!
!
@@ -42,6 +41,8 @@
!
!* 0. DECLARATIONS
!
+USE MODD_DIAG_n, ONLY : DIAG_t
+!
USE MODD_CSTS, ONLY : XRD, XG, XRV
USE MODD_ATM_CST, ONLY : XCLIM_T_GRAD
!
@@ -56,24 +57,20 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(DIAG_t), INTENT(INOUT) :: D
+!
REAL, DIMENSION(:), INTENT(IN) :: PZS_MOY ! mean orography of atmospheric grid
REAL, DIMENSION(:), INTENT(IN) :: PZS_MIN ! min orography of atmospheric grid
-REAL, DIMENSION(:), INTENT(IN) :: PTA_2M ! temperature at 2m
-REAL, DIMENSION(:), INTENT(IN) :: PQA_2M ! humidity at 2m (kg/m3)
-REAL, DIMENSION(:), INTENT(IN) :: PPA_2M ! pressure at 2m
-REAL, DIMENSION(:), INTENT(IN) :: PRHOA_2M ! density at 2m
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PTA_2M_MIN ! temperature at surface altitude
-REAL, DIMENSION(:), INTENT(OUT) :: PQA_2M_MIN ! humidity at surface altitude (kg/m3)
-REAL, DIMENSION(:), INTENT(OUT) :: PPA_2M_MIN ! pressure at surface altitude
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PPS_MIN ! pressure at surface altitude
REAL, DIMENSION(:), INTENT(OUT) :: PRHOA_2M_MIN ! density at surface altitude
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(SIZE(PQA_2M )) :: ZQA_2M ! air humidity (kg/kg)
-REAL, DIMENSION(SIZE(PQA_2M )) :: ZQA_2M_MIN ! air humidity (kg/kg)
-REAL, DIMENSION(SIZE(PRHOA_2M)) :: ZRHOA_2M ! approximated density
-REAL, DIMENSION(SIZE(PRHOA_2M)) :: ZRHOA_2M_MIN ! approximated density
+REAL, DIMENSION(SIZE(D%XQ2M )) :: ZQA_2M ! air humidity (kg/kg)
+REAL, DIMENSION(SIZE(D%XQ2M )) :: ZQA_2M_MIN ! air humidity (kg/kg)
+REAL, DIMENSION(SIZE(D%XRHOA)) :: ZRHOA_2M ! approximated density
+REAL, DIMENSION(SIZE(D%XRHOA)) :: ZRHOA_2M_MIN ! approximated density
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -81,19 +78,19 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MINZS_VERT_SHIFT',0,ZHOOK_HANDLE)
!
-ZQA_2M = PQA_2M / PRHOA_2M
+ZQA_2M = D%XQ2M / D%XRHOA
!
!* 1. climatological gradient for temperature
! ---------------------------------------
!
-PTA_2M_MIN = PTA_2M + XCLIM_T_GRAD * (PZS_MIN - PZS_MOY)
+D%XT2M_MIN_ZS = D%XT2M + XCLIM_T_GRAD * (PZS_MIN - PZS_MOY)
!
!-------------------------------------------------------------------------------
!
!* 2. hydrostatism for pressure
! -------------------------
!
-PPA_2M_MIN = PPA_2M * EXP ( - XG/XRD/(0.5*(PTA_2M+PTA_2M_MIN)*( 1.+((XRV/XRD)-1.)*ZQA_2M(:) )) &
+PPS_MIN = D%XPS * EXP ( - XG/XRD/(0.5*(D%XT2M+D%XT2M_MIN_ZS)*( 1.+((XRV/XRD)-1.)*ZQA_2M(:) )) &
* (PZS_MIN-PZS_MOY) )
!
!-------------------------------------------------------------------------------
@@ -101,24 +98,24 @@ PPA_2M_MIN = PPA_2M * EXP ( - XG/XRD/(0.5*(PTA_2M+PTA_2M_MIN)*( 1.+((XRV/XRD)-1.
!* 3. conservation of relative humidity for humidity
! ----------------------------------------------
!
-ZQA_2M_MIN = ZQA_2M / QSAT(PTA_2M, PPA_2M) * QSAT(PTA_2M_MIN,PPA_2M_MIN)
+ZQA_2M_MIN = ZQA_2M / QSAT(D%XT2M, D%XPS) * QSAT(D%XT2M_MIN_ZS,PPS_MIN)
!
!-------------------------------------------------------------------------------
!
!* 4. estimation of air density from temperature and humidity
! -------------------------------------------------------
!
-ZRHOA_2M (:) = PPA_2M (:) / XRD / PTA_2M (:) / ( 1.+((XRV/XRD)-1.)*ZQA_2M (:) )
-ZRHOA_2M_MIN(:) = PPA_2M_MIN(:) / XRD / PTA_2M_MIN(:) / ( 1.+((XRV/XRD)-1.)*ZQA_2M_MIN(:) )
+ZRHOA_2M (:) = D%XPS (:) / XRD / D%XT2M (:) / ( 1.+((XRV/XRD)-1.)*ZQA_2M(:) )
+ZRHOA_2M_MIN(:) = PPS_MIN(:) / XRD / D%XT2M_MIN_ZS(:) / ( 1.+((XRV/XRD)-1.)*ZQA_2M_MIN(:) )
!
-PRHOA_2M_MIN(:) = PRHOA_2M(:) * ZRHOA_2M_MIN(:) / ZRHOA_2M (:)
+PRHOA_2M_MIN(:) = D%XRHOA(:) * ZRHOA_2M_MIN(:) / ZRHOA_2M (:)
!
!-------------------------------------------------------------------------------
!
!* 5. new humidity in kg/m3
! ---------------------
!
-PQA_2M_MIN = ZQA_2M_MIN * PRHOA_2M_MIN
+D%XQ2M_MIN_ZS = ZQA_2M_MIN * PRHOA_2M_MIN
!
IF (LHOOK) CALL DR_HOOK('MINZS_VERT_SHIFT',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/mixtln.F90 b/src/SURFEX/mixtln.F90
index 177a1b0efa41d75ec6644b099d8578f9bd00e4f8..4dd4dff743bd700dc7cea5dcd8e416b2ec75529e 100644
--- a/src/SURFEX/mixtln.F90
+++ b/src/SURFEX/mixtln.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE MIXTL_n (O, OR, SG, &
- PFSOL,PFNSOL,PSFTEAU,PSFU,PSFV,PSEATEMP)
+ SUBROUTINE MIXTL_n (O, OR, PLAT, PFSOL,PFNSOL,PSFTEAU,PSFU,PSFV,PSEATEMP)
! #######################################################################
!
!!**** *MIXTLN (1D MODEL)*
@@ -46,6 +45,7 @@
!! richardson nb in diapycnal mixing,
!! remove threshold value for mixing tendency
!! 07/2012, P. Le Moigne : CMO1D phasing
+!! 09/2016, C. Lebeaupin Brossier: XSEATEND and initialization
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -54,7 +54,6 @@
!
USE MODD_OCEAN_n, ONLY : OCEAN_t
USE MODD_OCEAN_REL_n, ONLY : OCEAN_REL_t
-USE MODD_SEAFLUX_GRID_n, ONLY : SEAFLUX_GRID_t
!
USE MODD_CSTS
USE MODD_OCEAN_CSTS
@@ -76,7 +75,8 @@ IMPLICIT NONE
!
TYPE(OCEAN_t), INTENT(INOUT) :: O
TYPE(OCEAN_REL_t), INTENT(INOUT) :: OR
-TYPE(SEAFLUX_GRID_t), INTENT(INOUT) :: SG
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLAT
!
REAL, DIMENSION(:) ,INTENT(IN) :: PFSOL ! solar flux (W/m2)
REAL, DIMENSION(:) ,INTENT(IN) :: PFNSOL ! non solar flux (W/m2)
@@ -234,7 +234,7 @@ DO JPT=1,SIZE(PFSOL)
IKHML=1
!
!simplified variables inside this loop
- ZLAT = SG%XLAT (JPT)
+ ZLAT = PLAT (JPT)
ZFSOL = PFSOL (JPT)
ZFNSOL = PFNSOL (JPT)
ZSFTEAU = PSFTEAU(JPT)
@@ -243,42 +243,41 @@ DO JPT=1,SIZE(PFSOL)
ZEWS = SQRT(ZSFU**2+ZSFV**2)/XRHOSW
ZF = 4.*XPI*SIN(ZLAT*XPI/180.)/86400.
- ZSEAHMO=0.
+ ZSEAT(:) = O%XSEAT(JPT,:)
+ ZSEAS(:) = O%XSEAS(JPT,:)
+ ZSEAU(:) = O%XSEAU(JPT,:)
+ ZSEAV(:) = O%XSEAV(JPT,:)
+ ZSEAE(:) = O%XSEAE(JPT,:)
+ !
+ ZSEAU_REL(:) = OR%XSEAU_REL(JPT,:)
+ ZSEAV_REL(:) = OR%XSEAV_REL(JPT,:)
+ ZSEAT_REL(:) = OR%XSEAT_REL(JPT,:)
+ ZSEAS_REL(:) = OR%XSEAS_REL(JPT,:)
+ !
+ ZSEAHMO = 0.
DO J=IUP-1,IBOT
- ZSEAT(J) = O%XSEAT(JPT,J)
- ZSEAS(J) = O%XSEAS(JPT,J)
- ZSEAU(J) = O%XSEAU(JPT,J)
- ZSEAV(J) = O%XSEAV(JPT,J)
- ZSEAE(J) = O%XSEAE(JPT,J)
- !
- ZSEAU_REL(J) = OR%XSEAU_REL(JPT,J)
- ZSEAV_REL(J) = OR%XSEAV_REL(JPT,J)
- ZSEAT_REL(J) = OR%XSEAT_REL(JPT,J)
- ZSEAS_REL(J) = OR%XSEAS_REL(JPT,J)
- !
IF (J>=IUP .AND. ZSEAE(J)>=(ZEMIN*SQRT(2.))) ZSEAHMO = ZSEAHMO-XDZ1(J)
ENDDO
O%XSEAHMO(JPT) = ZSEAHMO
-
- !precalculation of DRHO
- DO J=IUP-1,IBOT
- ZU(J)=0.
- ZV(J)=0.
- ZT(J)=0.
- ZS(J)=0.
- ZE(J)=0.
- ADVT(J)=0.
- ADVS(J)=0.
- ADVU(J)=0.
- ADVV(J)=0.
- ADVE(J)=0.
- ZZDRHO(J)=(ZSEAT(J)-ZT1)*(ZT2+ZT3*(ZSEAT(J)-ZT1)) + ZS2*(ZSEAS(J)-ZS1)
- ZUDTREL(J)=0.
- ZVDTREL(J)=0.
- ZTDTREL(J)=0.
- ZSDTREL(J)=0.
- ZDTFSOL(J)=0.
- ENDDO
+ !
+ !precalculation of DRHO
+ ZU (:) = 0.
+ ZV (:) = 0.
+ ZT (:) = 0.
+ ZS (:) = 0.
+ ZE (:) = 0.
+ ADVT (:) = 0.
+ ADVS (:) = 0.
+ ADVU (:) = 0.
+ ADVV (:) = 0.
+ ADVE (:) = 0.
+ ZZDRHO (:) = (ZSEAT(:)-ZT1)*(ZT2+ZT3*(ZSEAT(:)-ZT1)) + ZS2*(ZSEAS(:)-ZS1)
+ ZUDTREL(:) = 0.
+ ZVDTREL(:) = 0.
+ ZTDTREL(:) = 0.
+ ZSDTREL(:) = 0.
+ ZDTFSOL(:) = 0.
+ !
ZDTFNSOL=0.
!
! Control print
@@ -405,11 +404,14 @@ DO JPT=1,SIZE(PFSOL)
!! 2.c Numerical resolution of evolution equations
!! -------------------------------------------
!
- DO J=IUP,IBOT
- IF (OR%LREL_CUR) THEN
+ IF (OR%LREL_CUR) THEN
+ DO J=IUP,IBOT
ZUDTREL(J) = - (ZSEAU(J)-ZSEAU_REL(J)) / OR%XTAU_REL
ZVDTREL(J) = - (ZSEAV(J)-ZSEAV_REL(J)) / OR%XTAU_REL
- ENDIF
+ ENDDO
+ ENDIF
+ !
+ DO J=IUP,IBOT
! flux solaire
ZDTFSOL(J) = XRAY(J)*ZFSOL/XDZ2(J)
ENDDO
@@ -549,7 +551,7 @@ DO JPT=1,SIZE(PFSOL)
!! 3. New oceanic profiles
!! --------------------
!!
- IF (O%LPROGSST) O%XSEATEND(JPT) = (ZT(IUP)-ZSEAT(IUP)) / O%XOCEAN_TSTEP
+ IF (O%LPROGSST) O%XSEATEND(JPT) = (ZT(IUP)-O%XSEAT(JPT,IUP)) / O%XOCEAN_TSTEP
ZSEAT(NOCKMIN) = ZT(IUP)
ZSEAS(NOCKMIN) = ZS(IUP)
ZSEAU(NOCKMIN) = ZU(IUP)
diff --git a/src/SURFEX/mkflag_snow.F90 b/src/SURFEX/mkflag_snow.F90
index 022ad8fd0534f25378a7be9df4695bef4f646c8c..75c658db90eea5aa61ba476f8fb926faef957abc 100644
--- a/src/SURFEX/mkflag_snow.F90
+++ b/src/SURFEX/mkflag_snow.F90
@@ -42,7 +42,6 @@ IMPLICIT NONE
TYPE(SURF_SNOW) :: TPSNOW ! snow state vector
!
INTEGER :: JLAYER
-INTEGER :: JPATCH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!--------------------------------------------------
@@ -50,22 +49,20 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MKFLAG_SNOW',0,ZHOOK_HANDLE)
IF (TPSNOW%SCHEME=='NON' .AND. LHOOK) CALL DR_HOOK('MKFLAG_SNOW',1,ZHOOK_HANDLE)
IF (TPSNOW%SCHEME=='NON') RETURN
-!
-DO JPATCH =1,SIZE(TPSNOW%WSNOW,3)
!
IF (TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='3-L' &
.OR. TPSNOW%SCHEME=='CRO') THEN
DO JLAYER=1,TPSNOW%NLAYER
- WHERE ( TPSNOW%RHO(:,1,JPATCH)== XUNDEF .AND. TPSNOW%WSNOW(:,JLAYER,JPATCH) > 0.0 .AND. TPSNOW%WSNOW(:,1,JPATCH)/= XUNDEF )
- TPSNOW%WSNOW(:,JLAYER,JPATCH) = 0.0
+ WHERE ( TPSNOW%RHO(:,1)== XUNDEF .AND. TPSNOW%WSNOW(:,JLAYER) > 0.0 .AND. TPSNOW%WSNOW(:,1)/= XUNDEF )
+ TPSNOW%WSNOW(:,JLAYER) = 0.0
END WHERE
END DO
END IF
!
IF (TPSNOW%SCHEME=='1-L') THEN
DO JLAYER=1,TPSNOW%NLAYER
- WHERE ( TPSNOW%WSNOW(:,1,JPATCH)==0. .OR. TPSNOW%WSNOW(:,1,JPATCH)== XUNDEF )
- TPSNOW%T(:,JLAYER,JPATCH) = XUNDEF
+ WHERE ( TPSNOW%WSNOW(:,1)==0. .OR. TPSNOW%WSNOW(:,1)== XUNDEF )
+ TPSNOW%T(:,JLAYER) = XUNDEF
END WHERE
END DO
END IF
@@ -73,54 +70,53 @@ DO JPATCH =1,SIZE(TPSNOW%WSNOW,3)
IF (TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='3-L' &
.OR. TPSNOW%SCHEME=='CRO') THEN
DO JLAYER=1,TPSNOW%NLAYER
- WHERE ( TPSNOW%WSNOW(:,1,JPATCH)==0. .OR. TPSNOW%WSNOW(:,1,JPATCH)== XUNDEF )
- TPSNOW%RHO(:,JLAYER,JPATCH) = XUNDEF
+ WHERE ( TPSNOW%WSNOW(:,1)==0. .OR. TPSNOW%WSNOW(:,1)== XUNDEF )
+ TPSNOW%RHO(:,JLAYER) = XUNDEF
END WHERE
END DO
END IF
!
IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
DO JLAYER=1,TPSNOW%NLAYER
- WHERE ( TPSNOW%WSNOW(:,1,JPATCH)==0. .OR. TPSNOW%WSNOW(:,1,JPATCH)== XUNDEF )
- TPSNOW%HEAT(:,JLAYER,JPATCH) = XUNDEF
- TPSNOW%AGE (:,JLAYER,JPATCH) = XUNDEF
+ WHERE ( TPSNOW%WSNOW(:,1)==0. .OR. TPSNOW%WSNOW(:,1)== XUNDEF )
+ TPSNOW%HEAT(:,JLAYER) = XUNDEF
+ TPSNOW%AGE (:,JLAYER) = XUNDEF
END WHERE
END DO
END IF
!
IF (TPSNOW%SCHEME=='CRO') THEN
DO JLAYER=1,TPSNOW%NLAYER
- WHERE ( TPSNOW%WSNOW(:,1,JPATCH)==0. .OR. TPSNOW%WSNOW(:,1,JPATCH)== XUNDEF )
- TPSNOW%GRAN1(:,JLAYER,JPATCH) = XUNDEF
- TPSNOW%GRAN2(:,JLAYER,JPATCH) = XUNDEF
- TPSNOW%HIST(:,JLAYER,JPATCH) = XUNDEF
+ WHERE ( TPSNOW%WSNOW(:,1)==0. .OR. TPSNOW%WSNOW(:,1)== XUNDEF )
+ TPSNOW%GRAN1(:,JLAYER) = XUNDEF
+ TPSNOW%GRAN2(:,JLAYER) = XUNDEF
+ TPSNOW%HIST(:,JLAYER) = XUNDEF
END WHERE
END DO
END IF
!
IF (TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='3-L' &
.OR. TPSNOW%SCHEME=='CRO') THEN
- WHERE ( TPSNOW%WSNOW(:,1,JPATCH)==0. .OR. TPSNOW%WSNOW(:,1,JPATCH)== XUNDEF )
- TPSNOW%ALB(:,JPATCH) = XUNDEF
- TPSNOW%ALBVIS(:,JPATCH) = XUNDEF
- TPSNOW%ALBNIR(:,JPATCH) = XUNDEF
- TPSNOW%ALBFIR(:,JPATCH) = XUNDEF
+ WHERE ( TPSNOW%WSNOW(:,1)==0. .OR. TPSNOW%WSNOW(:,1)== XUNDEF )
+ TPSNOW%ALB(:) = XUNDEF
+ TPSNOW%ALBVIS(:) = XUNDEF
+ TPSNOW%ALBNIR(:) = XUNDEF
+ TPSNOW%ALBFIR(:) = XUNDEF
END WHERE
END IF
!
IF (TPSNOW%SCHEME=='1-L') THEN
- WHERE ( TPSNOW%WSNOW(:,1,JPATCH)==0. .OR. TPSNOW%WSNOW(:,1,JPATCH)== XUNDEF )
- TPSNOW%EMIS(:,JPATCH) = XUNDEF
+ WHERE ( TPSNOW%WSNOW(:,1)==0. .OR. TPSNOW%WSNOW(:,1)== XUNDEF )
+ TPSNOW%EMIS(:) = XUNDEF
END WHERE
END IF
!
IF (TPSNOW%SCHEME=='1-L') THEN
- WHERE ( TPSNOW%WSNOW(:,1,JPATCH)==0. .OR. TPSNOW%WSNOW(:,1,JPATCH)== XUNDEF )
- TPSNOW%TS(:,JPATCH) = XUNDEF
+ WHERE ( TPSNOW%WSNOW(:,1)==0. .OR. TPSNOW%WSNOW(:,1)== XUNDEF )
+ TPSNOW%TS(:) = XUNDEF
END WHERE
END IF
-END DO
IF (LHOOK) CALL DR_HOOK('MKFLAG_SNOW',1,ZHOOK_HANDLE)
!
!--------------------------------------------------
diff --git a/src/SURFEX/mod1dn.F90 b/src/SURFEX/mod1dn.F90
index ce0f9c3e909a4ec44151e1cc818c168e08a8e27c..1e89098fe42bbe728ede3c20dc216c50dd120d2b 100644
--- a/src/SURFEX/mod1dn.F90
+++ b/src/SURFEX/mod1dn.F90
@@ -3,9 +3,9 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE MOD1D_n (DGO, O, OR, SG, S, &
- HPROGRAM,PTIME,PEMIS,PDIR_ALB,PSCA_ALB,PLW,PSCA_SW,&
- PDIR_SW, PSFTH,PSFTQ,PSFU,PSFV,PRAIN,PSST )
+ SUBROUTINE MOD1D_n (DGO, O, OR, PLAT, S, &
+ HPROGRAM, PTIME, PEMIS, PDIR_ALB, PSCA_ALB, &
+ PLW, PSCA_SW, PDIR_SW, PSFTH, PSFTQ, PSFU, PSFV, PRAIN )
! #######################################################################
!
!!**** *MOD1D_n*
@@ -50,7 +50,7 @@
USE MODD_DIAG_OCEAN_n, ONLY : DIAG_OCEAN_t
USE MODD_OCEAN_n, ONLY : OCEAN_t
USE MODD_OCEAN_REL_n, ONLY : OCEAN_REL_t
-USE MODD_SEAFLUX_GRID_n, ONLY : SEAFLUX_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
!
USE MODD_CSTS
@@ -75,7 +75,7 @@ IMPLICIT NONE
TYPE(DIAG_OCEAN_t), INTENT(INOUT) :: DGO
TYPE(OCEAN_t), INTENT(INOUT) :: O
TYPE(OCEAN_REL_t), INTENT(INOUT) :: OR
-TYPE(SEAFLUX_GRID_t), INTENT(INOUT) :: SG
+REAL, DIMENSION(:), INTENT(IN) :: PLAT
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
@@ -92,8 +92,6 @@ REAL, DIMENSION(:) ,INTENT(IN) :: PSFU ! zonal stress (Pa)
REAL, DIMENSION(:) ,INTENT(IN) :: PSFV ! meridian stress (Pa)
REAL, DIMENSION(:) ,INTENT(IN) :: PRAIN ! liquid precipitation (kg/s/m2)
!
-REAL, DIMENSION(:) ,INTENT(INOUT) :: PSST ! sea surface temperature (K)
-!
!* 0.2 declarations of local variables
!
INTEGER :: JPT
@@ -137,13 +135,13 @@ IF (GCALLMIXT) THEN
!Net solar flux
ZFSOL(JPT)=(SUM(PDIR_SW(JPT,:))+SUM(PSCA_SW(JPT,:))-SUM(ZSWU(JPT,:)))/(XRHOSW*XCPSW)
!Calcul flux LW UP
- ZLWU(JPT)= PEMIS(JPT)*XSTEFAN*PSST(JPT)**4 + (1-PEMIS(JPT))*PLW(JPT)
+ ZLWU(JPT)= PEMIS(JPT)*XSTEFAN*S%XSST(JPT)**4 + (1-PEMIS(JPT))*PLW(JPT)
- IF (PSST(JPT)<=(XTT-2)) THEN
+ IF (S%XSST(JPT)<=(XTT-2)) THEN
ZFNSOL(JPT)=(PLW(JPT)-ZLWU(JPT)-PSFTH(JPT)-(XLSTT*PSFTQ(JPT)))/(XRHOSW*XCPSW)
ZSFTEAU(JPT)=PSFTQ(JPT)/XRHOSWREF
ELSE
- ZLV(JPT)=XLVTT+(XCPV-XCL)*(PSST(JPT)-XTT)
+ ZLV(JPT)=XLVTT+(XCPV-XCL)*(S%XSST(JPT)-XTT)
ZFNSOL(JPT)=(PLW(JPT)-ZLWU(JPT)-PSFTH(JPT)-(ZLV(JPT)*PSFTQ(JPT)))/(XRHOSW*XCPSW)
ZSFTEAU(JPT)=(PSFTQ(JPT)-PRAIN(JPT))/XRHOSWREF
ENDIF
@@ -160,22 +158,21 @@ IF (GCALLMIXT) THEN
ZSFTEAU(:) = 0.
END IF
- CALL MIXTL_n(O, OR, SG, &
- ZFSOL,ZFNSOL,ZSFTEAU,PSFU,PSFV,ZSEATEMP)
+ CALL MIXTL_n(O, OR, PLAT, ZFSOL,ZFNSOL,ZSFTEAU,PSFU,PSFV,ZSEATEMP)
!
!---------------------------------------------------------------------------
! 3. Coupling with SURFEX by SST (and relative wind) evolution
!
IF (O%LPROGSST) THEN
- PSST(:)=ZSEATEMP(:)
+ S%XSST(:)=ZSEATEMP(:)
!WRITE(ILUOUT,*) '**SST CHANGED FOR THE ',NOCTCOUNT,'TIME BY FIRST LEVEL OCEANIC MODEL TEMPERATURE AT ', ITIME,' s **'
ENDIF
!
ENDIF
!
IF (GTIMEOK) THEN
- CALL DIAG_INLINE_OCEAN_n(DGO, O, S)
- O%NOCTCOUNT=O%NOCTCOUNT+1
+ CALL DIAG_INLINE_OCEAN_n(DGO, O, S%XSEABATHY)
+ O%NOCTCOUNT = O%NOCTCOUNT+1
ENDIF
!
IF (LHOOK) CALL DR_HOOK('MOD1D_N',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/modd_agrin.F90 b/src/SURFEX/modd_agrin.F90
index 7f4dddf0447c7e8418b5e56ab05e77b09c7a0534..a5d2329ac0477e08cc322f76851810ead057f6a4 100644
--- a/src/SURFEX/modd_agrin.F90
+++ b/src/SURFEX/modd_agrin.F90
@@ -39,42 +39,63 @@ IMPLICIT NONE
!-------------------------------------------------------------------------------
TYPE AGRI_t
!
-INTEGER, POINTER, DIMENSION (:,:) :: NIRRINUM
+INTEGER, POINTER, DIMENSION (:) :: NIRRINUM
! Stage for Irrigation (4 stages)
!
-LOGICAL, POINTER,DIMENSION(:,:) :: LIRRIGATE
+LOGICAL, POINTER,DIMENSION(:) :: LIRRIGATE
! True if irrigation performed
!
-LOGICAL, POINTER,DIMENSION(:,:) :: LIRRIDAY
+LOGICAL, POINTER,DIMENSION(:) :: LIRRIDAY
! True if irrigation occurs during present day
!
-REAL, POINTER, DIMENSION(:,:) :: XTHRESHOLDSPT
+REAL, POINTER, DIMENSION(:) :: XTHRESHOLDSPT
! Spatialized threshold
END TYPE AGRI_t
!-------------------------------------------------------------------------------
-
-
-
- CONTAINS
-
!
+TYPE AGRI_NP_t
!
-
-
-
-
-SUBROUTINE AGRI_INIT(YAGRI)
-TYPE(AGRI_t), INTENT(INOUT) :: YAGRI
+TYPE(AGRI_t), DIMENSION(:), POINTER :: AL=>NULL()
+!
+END TYPE AGRI_NP_t
+!
+CONTAINS
+!
+!
+SUBROUTINE AGRI_INIT(AG)
+TYPE(AGRI_t), INTENT(INOUT) :: AG
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK("MODD_AGRI_N:AGRI_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YAGRI%NIRRINUM)
- NULLIFY(YAGRI%LIRRIGATE)
- NULLIFY(YAGRI%LIRRIDAY)
- NULLIFY(YAGRI%XTHRESHOLDSPT)
+ NULLIFY(AG%NIRRINUM)
+ NULLIFY(AG%LIRRIGATE)
+ NULLIFY(AG%LIRRIDAY)
+ NULLIFY(AG%XTHRESHOLDSPT)
IF (LHOOK) CALL DR_HOOK("MODD_AGRI_N:AGRI_INIT",1,ZHOOK_HANDLE)
END SUBROUTINE AGRI_INIT
-
+!
+SUBROUTINE AGRI_NP_INIT(YNAG,KPATCH)
+TYPE(AGRI_NP_t), INTENT(INOUT) :: YNAG
+INTEGER, INTENT(IN) :: KPATCH
+INTEGER :: JP
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_AGRI_N:AGRI_NP_INIT",0,ZHOOK_HANDLE)
+!
+IF (ASSOCIATED(YNAG%AL)) THEN
+ DO JP = 1,KPATCH
+ CALL AGRI_INIT(YNAG%AL(JP))
+ ENDDO
+ DEALLOCATE(YNAG%AL)
+ELSE
+ ALLOCATE(YNAG%AL(KPATCH))
+ DO JP = 1,KPATCH
+ CALL AGRI_INIT(YNAG%AL(JP))
+ ENDDO
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK("MODD_AGRI_N:AGRI_NP_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE AGRI_NP_INIT
+!
!-------------------------------------------------------------------------------
!
END MODULE MODD_AGRI_n
diff --git a/src/SURFEX/modd_assim.F90 b/src/SURFEX/modd_assim.F90
index 5b1b19f25c84f3949580ef06240029a07a496da9..f752a713085beba3bd9a3ff0fbdebffedf2e5e0f 100644
--- a/src/SURFEX/modd_assim.F90
+++ b/src/SURFEX/modd_assim.F90
@@ -65,8 +65,8 @@ IMPLICIT NONE
LOGICAL :: LOBSHEADER
LOGICAL :: LOBSNAT
- INTEGER, PARAMETER :: NOBSMAX = 5
- INTEGER, PARAMETER :: NVARMAX = 5
+ INTEGER, PARAMETER :: NOBSMAX = 5 ! Maximum number of observations
+ INTEGER, PARAMETER :: NVARMAX = 9 ! Maximum number of control variables
INTEGER,DIMENSION(NOBSMAX) :: NNCO ! Select the type of observations to be assimilated
INTEGER,DIMENSION(NVARMAX) :: NNCV ! Select the control variables to be used
INTEGER :: NOBSTYPE
@@ -78,6 +78,7 @@ IMPLICIT NONE
INTEGER :: NBOUTPUT
INTEGER :: NPRINTLEV ! Verbosity
+ CHARACTER(LEN=10),DIMENSION(NOBSMAX) :: COBS_M ! Observation variable name
CHARACTER(LEN=3),DIMENSION(NVARMAX) :: CVAR_M ! X is ctrl
! 'PLUS ' (default)
! 'AVERA'
diff --git a/src/SURFEX/modd_bem_optionn.F90 b/src/SURFEX/modd_bem_optionn.F90
index f2c34fa65276c1bdfae7bc6f258a68033be13808..d3757142f297ebac99a6d249b86a3133b538f41f 100644
--- a/src/SURFEX/modd_bem_optionn.F90
+++ b/src/SURFEX/modd_bem_optionn.F90
@@ -57,7 +57,7 @@ END TYPE BEM_OPTIONS_t
!
- CONTAINS
+CONTAINS
!
diff --git a/src/SURFEX/modd_bemn.F90 b/src/SURFEX/modd_bemn.F90
index 6396704bdf7ca607410b65d42f637b48d067263c..1768b6c8f2d2bb6d001b6ed42a5ccdf9064d38a8 100644
--- a/src/SURFEX/modd_bemn.F90
+++ b/src/SURFEX/modd_bemn.F90
@@ -45,7 +45,7 @@ IMPLICIT NONE
!
!--------------------------------------------------------------------------
!
-TYPE BEM_1P_t
+TYPE BEM_t
!
! Floor parameters
!
@@ -132,108 +132,105 @@ TYPE BEM_1P_t
!
-END TYPE BEM_1P_t
+END TYPE BEM_t
!
-TYPE BEM_t
+TYPE BEM_NP_t
!
- TYPE(BEM_1P_t), POINTER :: ALP(:) => NULL()
- TYPE(BEM_1P_t), POINTER :: CUR => NULL()
+ TYPE(BEM_t), POINTER :: AL(:) => NULL()
!
-END TYPE BEM_t
+END TYPE BEM_NP_t
!
- CONTAINS
+CONTAINS
!----------------------------------------------------------------------------
!
-!
-SUBROUTINE BEM_GOTO_PATCH(YBEM,KTO_PATCH)
+SUBROUTINE BEM_INIT(YBEM)
TYPE(BEM_t), INTENT(INOUT) :: YBEM
-INTEGER, INTENT(IN) :: KTO_PATCH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_BEM_N:BEM_INIT",0,ZHOOK_HANDLE)
+ NULLIFY(YBEM%XF_WATER_COND)
+ NULLIFY(YBEM%XHC_FLOOR)
+ NULLIFY(YBEM%XTC_FLOOR)
+ NULLIFY(YBEM%XD_FLOOR)
+ NULLIFY(YBEM%XTCOOL_TARGET)
+ NULLIFY(YBEM%XTHEAT_TARGET)
+ NULLIFY(YBEM%XTI_BLD)
+ NULLIFY(YBEM%XT_FLOOR)
+ NULLIFY(YBEM%XT_MASS)
+ NULLIFY(YBEM%XQIN)
+ NULLIFY(YBEM%XQIN_FRAD)
+ NULLIFY(YBEM%XSHGC)
+ NULLIFY(YBEM%XSHGC_SH)
+ NULLIFY(YBEM%XU_WIN)
+ NULLIFY(YBEM%XTRAN_WIN)
+ NULLIFY(YBEM%XGR)
+ NULLIFY(YBEM%XFLOOR_HEIGHT)
+ NULLIFY(YBEM%XEFF_HEAT)
+ NULLIFY(YBEM%XINF)
+ NULLIFY(YBEM%XF_WASTE_CAN)
+ NULLIFY(YBEM%XAUX_MAX)
+ NULLIFY(YBEM%XQIN_FLAT)
+ NULLIFY(YBEM%XHR_TARGET)
+ NULLIFY(YBEM%XT_WIN2)
+ NULLIFY(YBEM%XQI_BLD)
+ NULLIFY(YBEM%XV_VENT)
+ NULLIFY(YBEM%XCAP_SYS_HEAT)
+ NULLIFY(YBEM%XCAP_SYS_RAT)
+ NULLIFY(YBEM%XT_ADP)
+ NULLIFY(YBEM%XM_SYS_RAT)
+ NULLIFY(YBEM%XCOP_RAT)
+ NULLIFY(YBEM%XT_WIN1)
+ NULLIFY(YBEM%XALB_WIN)
+ NULLIFY(YBEM%XABS_WIN)
+ NULLIFY(YBEM%XT_SIZE_MAX)
+ NULLIFY(YBEM%XT_SIZE_MIN)
+ NULLIFY(YBEM%XUGG_WIN)
+ NULLIFY(YBEM%LSHAD_DAY)
+ NULLIFY(YBEM%LNATVENT_NIGHT)
+ NULLIFY(YBEM%LSHADE)
+ NULLIFY(YBEM%XSHADE)
+ NULLIFY(YBEM%CNATVENT)
+ NULLIFY(YBEM%XNATVENT)
+ NULLIFY(YBEM%XN_FLOOR)
+ NULLIFY(YBEM%XGLAZ_O_BLD)
+ NULLIFY(YBEM%XMASS_O_BLD)
+ NULLIFY(YBEM%XFLOOR_HW_RATIO)
+ NULLIFY(YBEM%XF_FLOOR_MASS)
+ NULLIFY(YBEM%XF_FLOOR_WALL)
+ NULLIFY(YBEM%XF_FLOOR_WIN)
+ NULLIFY(YBEM%XF_FLOOR_ROOF)
+ NULLIFY(YBEM%XF_WALL_FLOOR)
+ NULLIFY(YBEM%XF_WALL_MASS)
+ NULLIFY(YBEM%XF_WALL_WIN)
+ NULLIFY(YBEM%XF_WIN_FLOOR)
+ NULLIFY(YBEM%XF_WIN_MASS)
+ NULLIFY(YBEM%XF_WIN_WALL)
+ NULLIFY(YBEM%XF_WIN_WIN)
+ NULLIFY(YBEM%XF_MASS_FLOOR)
+ NULLIFY(YBEM%XF_MASS_WALL)
+ NULLIFY(YBEM%XF_MASS_WIN)
+IF (LHOOK) CALL DR_HOOK("MODD_BEM_N:BEM_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE BEM_INIT
!
-! Current patch is set to patch KTO_PATCH
-IF (LHOOK) CALL DR_HOOK('MODD_BEM_N:BEM_GOTO_PATCH',0,ZHOOK_HANDLE)
-
-YBEM%CUR => YBEM%ALP(KTO_PATCH)
-
-IF (LHOOK) CALL DR_HOOK('MODD_BEM_N:BEM_GOTO_PATCH',1,ZHOOK_HANDLE)
-
-END SUBROUTINE BEM_GOTO_PATCH
-!
-!
-SUBROUTINE BEM_INIT(YBEM,KPATCH)
-TYPE(BEM_t), INTENT(INOUT) :: YBEM
+SUBROUTINE BEM_NP_INIT(YNBEM,KPATCH)
+TYPE(BEM_NP_t), INTENT(INOUT) :: YNBEM
INTEGER, INTENT(IN) :: KPATCH
INTEGER :: JP
REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_BEM_N:BEM_INIT",0,ZHOOK_HANDLE)
- ALLOCATE(YBEM%ALP(KPATCH))
- YBEM%CUR => YBEM%ALP(1)
-DO JP=1,KPATCH
- NULLIFY(YBEM%ALP(JP)%XF_WATER_COND)
- NULLIFY(YBEM%ALP(JP)%XHC_FLOOR)
- NULLIFY(YBEM%ALP(JP)%XTC_FLOOR)
- NULLIFY(YBEM%ALP(JP)%XD_FLOOR)
- NULLIFY(YBEM%ALP(JP)%XTCOOL_TARGET)
- NULLIFY(YBEM%ALP(JP)%XTHEAT_TARGET)
- NULLIFY(YBEM%ALP(JP)%XTI_BLD)
- NULLIFY(YBEM%ALP(JP)%XT_FLOOR)
- NULLIFY(YBEM%ALP(JP)%XT_MASS)
- NULLIFY(YBEM%ALP(JP)%XQIN)
- NULLIFY(YBEM%ALP(JP)%XQIN_FRAD)
- NULLIFY(YBEM%ALP(JP)%XSHGC)
- NULLIFY(YBEM%ALP(JP)%XSHGC_SH)
- NULLIFY(YBEM%ALP(JP)%XU_WIN)
- NULLIFY(YBEM%ALP(JP)%XTRAN_WIN)
- NULLIFY(YBEM%ALP(JP)%XGR)
- NULLIFY(YBEM%ALP(JP)%XFLOOR_HEIGHT)
- NULLIFY(YBEM%ALP(JP)%XEFF_HEAT)
- NULLIFY(YBEM%ALP(JP)%XINF)
- NULLIFY(YBEM%ALP(JP)%XF_WASTE_CAN)
- NULLIFY(YBEM%ALP(JP)%XAUX_MAX)
- NULLIFY(YBEM%ALP(JP)%XQIN_FLAT)
- NULLIFY(YBEM%ALP(JP)%XHR_TARGET)
- NULLIFY(YBEM%ALP(JP)%XT_WIN2)
- NULLIFY(YBEM%ALP(JP)%XQI_BLD)
- NULLIFY(YBEM%ALP(JP)%XV_VENT)
- NULLIFY(YBEM%ALP(JP)%XCAP_SYS_HEAT)
- NULLIFY(YBEM%ALP(JP)%XCAP_SYS_RAT)
- NULLIFY(YBEM%ALP(JP)%XT_ADP)
- NULLIFY(YBEM%ALP(JP)%XM_SYS_RAT)
- NULLIFY(YBEM%ALP(JP)%XCOP_RAT)
- NULLIFY(YBEM%ALP(JP)%XT_WIN1)
- NULLIFY(YBEM%ALP(JP)%XALB_WIN)
- NULLIFY(YBEM%ALP(JP)%XABS_WIN)
- NULLIFY(YBEM%ALP(JP)%XT_SIZE_MAX)
- NULLIFY(YBEM%ALP(JP)%XT_SIZE_MIN)
- NULLIFY(YBEM%ALP(JP)%XUGG_WIN)
- NULLIFY(YBEM%ALP(JP)%LSHAD_DAY)
- NULLIFY(YBEM%ALP(JP)%LNATVENT_NIGHT)
- NULLIFY(YBEM%ALP(JP)%LSHADE)
- NULLIFY(YBEM%ALP(JP)%XSHADE)
- NULLIFY(YBEM%ALP(JP)%CNATVENT)
- NULLIFY(YBEM%ALP(JP)%XNATVENT)
- NULLIFY(YBEM%ALP(JP)%XN_FLOOR)
- NULLIFY(YBEM%ALP(JP)%XGLAZ_O_BLD)
- NULLIFY(YBEM%ALP(JP)%XMASS_O_BLD)
- NULLIFY(YBEM%ALP(JP)%XFLOOR_HW_RATIO)
- NULLIFY(YBEM%ALP(JP)%XF_FLOOR_MASS)
- NULLIFY(YBEM%ALP(JP)%XF_FLOOR_WALL)
- NULLIFY(YBEM%ALP(JP)%XF_FLOOR_WIN)
- NULLIFY(YBEM%ALP(JP)%XF_FLOOR_ROOF)
- NULLIFY(YBEM%ALP(JP)%XF_WALL_FLOOR)
- NULLIFY(YBEM%ALP(JP)%XF_WALL_MASS)
- NULLIFY(YBEM%ALP(JP)%XF_WALL_WIN)
- NULLIFY(YBEM%ALP(JP)%XF_WIN_FLOOR)
- NULLIFY(YBEM%ALP(JP)%XF_WIN_MASS)
- NULLIFY(YBEM%ALP(JP)%XF_WIN_WALL)
- NULLIFY(YBEM%ALP(JP)%XF_WIN_WIN)
- NULLIFY(YBEM%ALP(JP)%XF_MASS_FLOOR)
- NULLIFY(YBEM%ALP(JP)%XF_MASS_WALL)
- NULLIFY(YBEM%ALP(JP)%XF_MASS_WIN)
-ENDDO
-IF (LHOOK) CALL DR_HOOK("MODD_BEM_N:BEM_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE BEM_INIT
+IF (LHOOK) CALL DR_HOOK("MODD_BEM_N:BEM_NP_INIT",0,ZHOOK_HANDLE)
+IF (.NOT.ASSOCIATED(YNBEM%AL)) THEN
+ ALLOCATE(YNBEM%AL(KPATCH))
+ DO JP=1,KPATCH
+ CALL BEM_INIT(YNBEM%AL(JP))
+ ENDDO
+ELSE
+ DO JP=1,KPATCH
+ CALL BEM_INIT(YNBEM%AL(JP))
+ ENDDO
+ DEALLOCATE(YNBEM%AL)
+ENDIF
+IF (LHOOK) CALL DR_HOOK("MODD_BEM_N:BEM_NP_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE BEM_NP_INIT
!
!
END MODULE MODD_BEM_n
diff --git a/src/SURFEX/modd_bld_descriptionn.F90 b/src/SURFEX/modd_bld_descriptionn.F90
index 1601fa0eef5640de03799cb06ea0283c5c193225..fb1979ffb5705d821c5e03dc5a1ab6b0170e2f16 100644
--- a/src/SURFEX/modd_bld_descriptionn.F90
+++ b/src/SURFEX/modd_bld_descriptionn.F90
@@ -107,7 +107,7 @@ END TYPE BLD_DESC_t
- CONTAINS
+CONTAINS
!
!
diff --git a/src/SURFEX/modd_teb_canopyn.F90 b/src/SURFEX/modd_canopyn.F90
similarity index 70%
rename from src/SURFEX/modd_teb_canopyn.F90
rename to src/SURFEX/modd_canopyn.F90
index 44069efb3a0b9e05a47d8f17be66d55a49c24adb..0338174ec75e7e673ffa61549022bd89ffcdd6fe 100644
--- a/src/SURFEX/modd_teb_canopyn.F90
+++ b/src/SURFEX/modd_canopyn.F90
@@ -3,10 +3,10 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ################
- MODULE MODD_TEB_CANOPY_n
+ MODULE MODD_CANOPY_n
! ################
!
-!!**** *MODD_TEB_CANOPY_n - declaration of surface parameters for urban canopy
+!!**** *MODD_CANOPY_n - declaration of surface parameters for urban canopy
!!
!! PURPOSE
!! -------
@@ -37,7 +37,7 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
-TYPE TEB_CANOPY_t
+TYPE CANOPY_t
!
INTEGER :: NLVL ! number of levels in canopy
REAL, POINTER, DIMENSION(:,:) :: XZ ! height of middle of each level grid (m)
@@ -54,36 +54,29 @@ TYPE TEB_CANOPY_t
REAL, POINTER, DIMENSION(:,:) :: XZF ! height of bottom of each level grid (m)
REAL, POINTER, DIMENSION(:,:) :: XDZF ! depth between each level in canopy (m)
!
-END TYPE TEB_CANOPY_t
-
-
-
- CONTAINS
-
+END TYPE CANOPY_t
!
-
-
-
-
-SUBROUTINE TEB_CANOPY_INIT(YTEB_CANOPY)
-TYPE(TEB_CANOPY_t), INTENT(INOUT) :: YTEB_CANOPY
+CONTAINS
+!
+SUBROUTINE CANOPY_INIT(SB)
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_CANOPY_N:TEB_CANOPY_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YTEB_CANOPY%XZ)
- NULLIFY(YTEB_CANOPY%XU)
- NULLIFY(YTEB_CANOPY%XT)
- NULLIFY(YTEB_CANOPY%XQ)
- NULLIFY(YTEB_CANOPY%XTKE)
- NULLIFY(YTEB_CANOPY%XLMO)
- NULLIFY(YTEB_CANOPY%XLM)
- NULLIFY(YTEB_CANOPY%XLEPS)
- NULLIFY(YTEB_CANOPY%XP)
- NULLIFY(YTEB_CANOPY%XDZ)
- NULLIFY(YTEB_CANOPY%XZF)
- NULLIFY(YTEB_CANOPY%XDZF)
-YTEB_CANOPY%NLVL=0
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_CANOPY_N:TEB_CANOPY_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE TEB_CANOPY_INIT
+IF (LHOOK) CALL DR_HOOK("MODD_CANOPY_N:CANOPY_INIT",0,ZHOOK_HANDLE)
+ NULLIFY(SB%XZ)
+ NULLIFY(SB%XU)
+ NULLIFY(SB%XT)
+ NULLIFY(SB%XQ)
+ NULLIFY(SB%XTKE)
+ NULLIFY(SB%XLMO)
+ NULLIFY(SB%XLM)
+ NULLIFY(SB%XLEPS)
+ NULLIFY(SB%XP)
+ NULLIFY(SB%XDZ)
+ NULLIFY(SB%XZF)
+ NULLIFY(SB%XDZF)
+SB%NLVL=0
+IF (LHOOK) CALL DR_HOOK("MODD_CANOPY_N:CANOPY_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE CANOPY_INIT
-END MODULE MODD_TEB_CANOPY_n
+END MODULE MODD_CANOPY_n
diff --git a/src/SURFEX/modd_ch_flaken.F90 b/src/SURFEX/modd_ch_flaken.F90
index d35b64357226ef02a5ddbf3bea9e13397b402854..da058239e3680a942adba2989781130bd3f433ee 100644
--- a/src/SURFEX/modd_ch_flaken.F90
+++ b/src/SURFEX/modd_ch_flaken.F90
@@ -56,7 +56,7 @@ END TYPE CH_FLAKE_t
- CONTAINS
+CONTAINS
!
SUBROUTINE CH_FLAKE_INIT(YCH_FLAKE)
@@ -69,7 +69,7 @@ NULLIFY(YCH_FLAKE%CAER_NAMES)
NULLIFY(YCH_FLAKE%CDSTNAMES)
NULLIFY(YCH_FLAKE%CSLTNAMES)
YCH_FLAKE%CCH_DRY_DEP=' '
- CALL SV_INIT(YCH_FLAKE%SVF)
+CALL SV_INIT(YCH_FLAKE%SVF)
IF (LHOOK) CALL DR_HOOK("MODD_CH_FLAKE_N:CH_FLAKE_INIT",1,ZHOOK_HANDLE)
END SUBROUTINE CH_FLAKE_INIT
diff --git a/src/SURFEX/modd_ch_isban.F90 b/src/SURFEX/modd_ch_isban.F90
index a22ae614edf2058ec82c7df94db2c0c15315f17b..7db03a80abcf88d43f56e7cc3207d6b1afd2c296 100644
--- a/src/SURFEX/modd_ch_isban.F90
+++ b/src/SURFEX/modd_ch_isban.F90
@@ -41,10 +41,10 @@ TYPE CH_ISBA_t
!
CHARACTER(LEN=28) :: CCHEM_SURF_FILE ! name of general (chemical) purpose ASCII input file
CHARACTER(LEN=6) :: CCH_DRY_DEP ! deposition scheme
- REAL, DIMENSION(:,:,:), POINTER :: XDEP ! final dry deposition
+ REAL, DIMENSION(:,:), POINTER :: XDEP ! final dry deposition
! velocity for nature
- REAL, DIMENSION(:,:), POINTER :: XSOILRC_SO2 ! for SO2
- REAL, DIMENSION(:,:), POINTER :: XSOILRC_O3 ! for O3
+ REAL, DIMENSION(:), POINTER :: XSOILRC_SO2 ! for SO2
+ REAL, DIMENSION(:), POINTER :: XSOILRC_O3 ! for O3
LOGICAL :: LCH_BIO_FLUX ! flag for the calculation of
! biogenic fluxes
LOGICAL :: LCH_NO_FLUX ! flag for the calculation of
@@ -58,17 +58,15 @@ TYPE CH_ISBA_t
CHARACTER(LEN=6), DIMENSION(:), POINTER :: CSLTNAMES ! NAME OF CHEMICAL SPECIES
!
END TYPE CH_ISBA_t
-
-
-
- CONTAINS
-
!
-
-
-
-
-
+TYPE CH_ISBA_NP_t
+!
+TYPE(CH_ISBA_t), DIMENSION(:), POINTER :: AL=>NULL()
+!
+END TYPE CH_ISBA_NP_t
+!
+CONTAINS
+!
SUBROUTINE CH_ISBA_INIT(YCH_ISBA)
TYPE(CH_ISBA_t), INTENT(INOUT) :: YCH_ISBA
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -84,9 +82,30 @@ YCH_ISBA%CCHEM_SURF_FILE=' '
YCH_ISBA%CCH_DRY_DEP=' '
YCH_ISBA%LCH_BIO_FLUX=.FALSE.
YCH_ISBA%LCH_NO_FLUX=.FALSE.
- CALL SV_INIT(YCH_ISBA%SVI)
+CALL SV_INIT(YCH_ISBA%SVI)
IF (LHOOK) CALL DR_HOOK("MODD_CH_ISBA_N:CH_ISBA_INIT",1,ZHOOK_HANDLE)
END SUBROUTINE CH_ISBA_INIT
-
-
+!
+SUBROUTINE CH_ISBA_NP_INIT(YCH_ISBA_NP,KPATCH)
+TYPE(CH_ISBA_NP_t), INTENT(INOUT) :: YCH_ISBA_NP
+INTEGER, INTENT(IN) :: KPATCH
+INTEGER :: JP
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_CH_ISBA_N:CH_ISBA_NP_INIT",0,ZHOOK_HANDLE)
+!
+IF (ASSOCIATED(YCH_ISBA_NP%AL)) THEN
+ DO JP = 1,KPATCH
+ CALL CH_ISBA_INIT(YCH_ISBA_NP%AL(JP))
+ ENDDO
+ DEALLOCATE(YCH_ISBA_NP%AL)
+ELSE
+ ALLOCATE(YCH_ISBA_NP%AL(KPATCH))
+ DO JP = 1,KPATCH
+ CALL CH_ISBA_INIT(YCH_ISBA_NP%AL(JP))
+ ENDDO
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK("MODD_CH_ISBA_N:CH_ISBA_NP_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE CH_ISBA_NP_INIT
+!
END MODULE MODD_CH_ISBA_n
diff --git a/src/SURFEX/modd_ch_seafluxn.F90 b/src/SURFEX/modd_ch_seafluxn.F90
index 6ab6f0216d59cb549b54b4e44e432b04217e5b6e..8df308f63b8f425eafa7bd397c6bd047e814cf03 100644
--- a/src/SURFEX/modd_ch_seafluxn.F90
+++ b/src/SURFEX/modd_ch_seafluxn.F90
@@ -54,7 +54,7 @@ END TYPE CH_SEAFLUX_t
- CONTAINS
+CONTAINS
!
@@ -71,7 +71,7 @@ NULLIFY(YCH_SEAFLUX%CAER_NAMES)
NULLIFY(YCH_SEAFLUX%CDSTNAMES)
NULLIFY(YCH_SEAFLUX%CSLTNAMES)
YCH_SEAFLUX%CCH_DRY_DEP=' '
- CALL SV_INIT(YCH_SEAFLUX%SVS)
+CALL SV_INIT(YCH_SEAFLUX%SVS)
IF (LHOOK) CALL DR_HOOK("MODD_CH_SEAFLUX_N:CH_SEAFLUX_INIT",1,ZHOOK_HANDLE)
END SUBROUTINE CH_SEAFLUX_INIT
diff --git a/src/SURFEX/modd_ch_snapn.F90 b/src/SURFEX/modd_ch_snapn.F90
index b6a9c2e0aba9b69041e5273f5f6000186adb9e0a..51a1cf64db974f3bbcf06bcba6ed5758d4e4eee0 100644
--- a/src/SURFEX/modd_ch_snapn.F90
+++ b/src/SURFEX/modd_ch_snapn.F90
@@ -86,7 +86,7 @@ END TYPE CH_EMIS_SNAP_t
- CONTAINS
+CONTAINS
!
diff --git a/src/SURFEX/modd_ch_surfn.F90 b/src/SURFEX/modd_ch_surfn.F90
index 2d443e29f43677d3ae286499086b2b6b4a8a483c..30649582ffd944595c715747fb0907697128a28d 100644
--- a/src/SURFEX/modd_ch_surfn.F90
+++ b/src/SURFEX/modd_ch_surfn.F90
@@ -61,10 +61,14 @@ TYPE CH_SURF_t
END TYPE CH_SURF_t
- CONTAINS
+
+CONTAINS
!
+
+
+
SUBROUTINE CH_SURF_INIT(YCH_SURF)
TYPE(CH_SURF_t), INTENT(INOUT) :: YCH_SURF
REAL(KIND=JPRB) :: ZHOOK_HANDLE
diff --git a/src/SURFEX/modd_ch_tebn.F90 b/src/SURFEX/modd_ch_tebn.F90
index b7fcabdf9b79c523d4b950061693cb4725341149..aa6171f0915fd2823b70266f869569ec32304405 100644
--- a/src/SURFEX/modd_ch_tebn.F90
+++ b/src/SURFEX/modd_ch_tebn.F90
@@ -61,7 +61,7 @@ END TYPE CH_TEB_t
- CONTAINS
+CONTAINS
!
@@ -84,7 +84,7 @@ YCH_TEB%CCHEM_SURF_FILE=' '
YCH_TEB%CCH_DRY_DEP=' '
YCH_TEB%LCH_BIO_FLUX=.FALSE.
YCH_TEB%LCH_NO_FLUX=.FALSE.
- CALL SV_INIT(YCH_TEB%SVT)
+CALL SV_INIT(YCH_TEB%SVT)
IF (LHOOK) CALL DR_HOOK("MODD_CH_TEB_N:CH_TEB_INIT",1,ZHOOK_HANDLE)
END SUBROUTINE CH_TEB_INIT
diff --git a/src/SURFEX/modd_ch_watfluxn.F90 b/src/SURFEX/modd_ch_watfluxn.F90
index 95228a0bf87a5fe0f9a9e1cb73438179c702db61..cfb2777d0ade96b80c8dedd017203fd5d9888b9c 100644
--- a/src/SURFEX/modd_ch_watfluxn.F90
+++ b/src/SURFEX/modd_ch_watfluxn.F90
@@ -52,7 +52,7 @@ TYPE CH_WATFLUX_t
!
END TYPE CH_WATFLUX_t
!
- CONTAINS
+CONTAINS
!
SUBROUTINE CH_WATFLUX_INIT(YCH_WATFLUX)
TYPE(CH_WATFLUX_t), INTENT(INOUT) :: YCH_WATFLUX
@@ -64,7 +64,7 @@ NULLIFY(YCH_WATFLUX%CAER_NAMES)
NULLIFY(YCH_WATFLUX%CDSTNAMES)
NULLIFY(YCH_WATFLUX%CSLTNAMES)
YCH_WATFLUX%CCH_DRY_DEP=' '
- CALL SV_INIT(YCH_WATFLUX%SVW)
+CALL SV_INIT(YCH_WATFLUX%SVW)
IF (LHOOK) CALL DR_HOOK("MODD_CH_WATFLUX_N:CH_WATFLUX_INIT",1,ZHOOK_HANDLE)
END SUBROUTINE CH_WATFLUX_INIT
diff --git a/src/SURFEX/modd_co2v_par.F90 b/src/SURFEX/modd_co2v_par.F90
index 388f87d1640f371c64e96983a0b21927ed683d58..7d501c483aabe337f51282e94ba4ccc921eaee5c 100644
--- a/src/SURFEX/modd_co2v_par.F90
+++ b/src/SURFEX/modd_co2v_par.F90
@@ -51,6 +51,8 @@
! *** First, CO2 parameters ***
! ---------------------
!
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE_OLD, NVEGTYPE_ECOSG
+!
IMPLICIT NONE
!
REAL, PARAMETER :: XSPIN_CO2 = 0.1
@@ -62,10 +64,6 @@ REAL, PARAMETER :: XMCO2 = 44.0E-3, XMC = 12.0E-3
! and C (Carbon), respectively
! (used for conversions in kg)
!
-REAL, PARAMETER :: XDMAX_AGS = 0.045
-! maximum specific humidity deficit (kg kg-1)
-! for standard ISBA AGS (CPHOTO = 'AGS' or 'LAI')
-!
REAL, PARAMETER :: XPARCF = 0.48
! coefficient: PAR fraction of incoming solar radiation
!
@@ -209,7 +207,7 @@ REAL, PARAMETER :: XCOEFF_MAINT_RESP_ZERO = 1.19E-4/86400.
REAL, PARAMETER :: XSLOPE_MAINT_RESP = 0.16
! slope for maintenance respiration for temperature dependance (1/C)
!
-REAL, PARAMETER, DIMENSION(19) :: XTAU_WOOD = &
+REAL, PARAMETER, DIMENSION(NVEGTYPE_OLD) :: XTAU_WOOD = &
(/ 0., 0., 0., 40.*365.*86400., 50.*365.*86400., 30.*365.*86400., 0., 0., 0., 0., &
0., 0., 40.*365.*86400., 40.*365.*86400., 50.*365.*86400., 40.*365.*86400., &
50.*365.*86400., 0., 40.*365.*86400. /)
@@ -253,20 +251,20 @@ REAL, PARAMETER :: XXSI_SUP = 2. ! hight/diameter ratio of
REAL, PARAMETER :: XK_INF = 1. ! k_sup = 2*tan(zc); where zc is the crown angle
REAL, PARAMETER :: XXSI_INF = 7. ! height/diameter ratio of the crown
!
-REAL, PARAMETER, DIMENSION(19) :: XLAI_SHADE = & ! above this value shading is activated
+REAL, PARAMETER, DIMENSION(NVEGTYPE_OLD) :: XLAI_SHADE = & ! above this value shading is activated
(/ 0., 0., 0., 2., 3., 6., 2., 2., 2., 2., 2., 2., 2., 2., 3., 2., 3., 2., 2. /)
-REAL, PARAMETER, DIMENSION(19) :: XXB_SUP = & ! b_sup = 1/omega_sup(zs=0) -1 calibration avec omega_sup(zs=0)=0.5
+REAL, PARAMETER, DIMENSION(NVEGTYPE_OLD) :: XXB_SUP = & ! b_sup = 1/omega_sup(zs=0) -1 calibration avec omega_sup(zs=0)=0.5
(/ 1., 1., 1., 1., 2., 3., 2., 2., 2., 2., 2., 2., 1., 1., 2., 1., 2., 2., 1. /)
-REAL, PARAMETER, DIMENSION(19) :: XXB_INF = & ! b_sup = 1/omega_sup(zs=0) -1 calibration avec omega_sup(zs=0)=0.5
+REAL, PARAMETER, DIMENSION(NVEGTYPE_OLD) :: XXB_INF = & ! b_sup = 1/omega_sup(zs=0) -1 calibration avec omega_sup(zs=0)=0.5
(/ 1., 1., 1., 4., 2., 4., 1., 1.5, 1.5, 1., 1., 1., 4., 4., 2., 4., 2., 1., 4. /)
!
! (Calvet et al. 2008) coefs for ratio of biomass to LAI with representation of nitrogen dilution fct of CO2
-REAL, PARAMETER, DIMENSION(19) :: XPARAM = &
-(/ 0., 0., 0., 2.56, 1.81, 1.81, 1.48, 1.48, 1.48, 1.81, 1.81, 1.81, 2.56, 2.56, 1.81, 2.56, &
- 1.81, 1.81, 2.56 /)
+!REAL, PARAMETER, DIMENSION(NVEGTYPE_OLD) :: XPARAM = &
+!(/ 0., 0., 0., 2.56, 1.81, 1.81, 1.48, 1.48, 1.48, 1.81, 1.81, 1.81, 2.56, 2.56, 1.81, 2.56, &
+! 1.81, 1.81, 2.56 /)
!
! Kronecker flag for nitrogen dilution hypothesis (based on Yin et al., 2002)
-REAL, PARAMETER, DIMENSION(19) :: XDILUDEC = &
+REAL, PARAMETER, DIMENSION(NVEGTYPE_OLD) :: XDILUDEC = &
(/ 0., 0., 0., 1., 0., 0., 1., 1., 1., 1., 1., 0., 1., 0., 0., 1., 1., 0., 1. /)
!
! Maximum Leaf photosynthetic capacity (kgCO2 m-2 s-1)
@@ -274,10 +272,13 @@ REAL, PARAMETER, DIMENSION(19) :: XDILUDEC = &
! For C3 PFTs : Ammax = Vcmax / 2. (Jacobs, p 150)
! For C4 PFTs : Ammax = Vcmax
! Units : [Vcmax]=micromols_CO2 m-2 s-1, [Ammax]=kgCO2 m-2 s-1 --> [Ammax] = [Vcmax] * 44e-3 * 1e-6
-REAL, PARAMETER, DIMENSION(19) :: XAMAX = &
+REAL, PARAMETER, DIMENSION(NVEGTYPE_OLD) :: XAMAX = &
(/ 1., 1., 1., 1.3E-6, 1.4E-6, 0.484E-6, 2.2E-6, 1.7E-6, 1.7E-6, 1.7E-6, 1.7E-6, 1.7E-6, &
0.9E-6, 1.3E-6, 1.4E-6, 1.3E-6, 0.9E-6, 1.7E-6, 1.2E-6/)
-!
+!
+INTEGER, PARAMETER, DIMENSION(NVEGTYPE_ECOSG) :: ITRANSFERT_ESG = &
+ (/1,2,3,16,4,13,14,6,5,15,17,19,18,10,11,7,7,8,4,12/)
+
END MODULE MODD_CO2V_PAR
diff --git a/src/SURFEX/modd_data_bemn.F90 b/src/SURFEX/modd_data_bemn.F90
index 9eab6576474b713a46daa85b2864c02034ee7f98..160eea3bf6bb6253c69dc461891abde17f130567 100644
--- a/src/SURFEX/modd_data_bemn.F90
+++ b/src/SURFEX/modd_data_bemn.F90
@@ -112,7 +112,7 @@ END TYPE DATA_BEM_t
- CONTAINS
+CONTAINS
!
!
diff --git a/src/SURFEX/modd_data_cover.F90 b/src/SURFEX/modd_data_cover.F90
index 86583d1c9db1c1ef867603e6f2804e381d916e5a..61c66763ec4df41326ccaabec65851fdb5f353d4 100644
--- a/src/SURFEX/modd_data_cover.F90
+++ b/src/SURFEX/modd_data_cover.F90
@@ -100,22 +100,11 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_ROOT_LIN ! ponderation coeffi
!
!-------------------------------------------------------------------------------
!
-! - vegetation: Ags parameters ('AGS', 'LAI', 'AST', 'LST', 'NIT', 'NCB' options)
+! - vegetation: Ags parameters ('AST', 'NIT', 'NCB' options)
!
REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_BSLAI ! ratio d(biomass)/d(lai)
-REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_LAIMIN ! minimum LAI
REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_SEFOLD ! e-folding time for senescence (s)
-REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_H_TREE ! height of vegetation
REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_GMES ! mesophyll conductance (m s-1)
-REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_RE25 ! Ecosystem Respiration parameter (kg.m2.s-1)
-!
-!-------------------------------------------------------------------------------
-!
-! - vegetation: Ags Stress parameters ('AST', 'LST', 'NIT', 'NCB' options)
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_STRESS ! defensive/offensive strategy (1/0)
-REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_F2I ! critical normilized soil water
-! ! content for stress parameterisation
REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_GC ! cuticular conductance (m/s)
REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_DMAX ! maximum air saturation deficit
! ! tolerate by vegetation (kg/kg)
@@ -128,6 +117,18 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_DMAX_ST ! maximum air saturation
! ! tolerate by vegetation (kg/kg)
!-------------------------------------------------------------------------------
!
+! - vegetation: Ags Stress parameters ('AST', 'NIT', 'NCB' options)
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_LAIMIN ! minimum LAI
+REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_H_TREE ! height of vegetation
+REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_RE25 ! Ecosystem Respiration parameter (kg.m2.s-1)
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_STRESS ! defensive/offensive strategy (1/0)
+REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_F2I ! critical normilized soil water
+! ! content for stress parameterisation
+!
+!-------------------------------------------------------------------------------
+!
! - vegetation: Ags Nitrogen-model parameters ('NIT', 'NCB' option)
!
REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_CE_NITRO! leaf aera ratio sensitivity
@@ -143,7 +144,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_GROUND_DEPTH ! total soil depth
REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_ROOT_DEPTH ! root depth
!-------------------------------------------------------------------------------
!
-! - Vegetation: Ags Prognostic (YPHOTO = ('LAI', 'LST', 'NIT', or 'NCB') or prescribed (YPHOTO='NON', 'AGS' or 'AST')
+! - Vegetation: Ags Prognostic (YPHOTO = ('NIT', or 'NCB') or prescribed (YPHOTO='NON' or 'AST')
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: XDATA_LAI ! leaf area index (monthly)
REAL, DIMENSION(:,:,:), ALLOCATABLE :: XDATA_LAI_ALL_YEARS ! leaf area index fromm 2002 to 2007
@@ -224,16 +225,8 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_TC_FLOOR ! thermal conductivity o
REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_D_FLOOR ! thickness of floor layers [m]
!
! For multi-energy balance (MEB)
-REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_RGLGV !
-REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_GAMMAGV !
-REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_RSMINGV ! Understory minimum
-! ! stomatal resistance
-REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_ROOT_EXTINCTIONGV ! Understory Jackson coefficient
-REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_WRMAX_CFGV
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: XDATA_LAIGV ! Understory LAI
REAL, DIMENSION(:,:,:), ALLOCATABLE :: XDATA_GNDLITTER ! Ground litter coverage
REAL, DIMENSION(:,:,:), ALLOCATABLE :: XDATA_Z0LITTER ! Ground litter roughness length
-REAL, DIMENSION(:,:), ALLOCATABLE :: XDATA_ROOT_DEPTHGV ! Understory root depth
REAL, DIMENSION(:,:,:), ALLOCATABLE :: XDATA_H_VEG ! Height of canopy vegetation
!
REAL, DIMENSION(:), ALLOCATABLE :: XDATA_TCOOL_TARGET ! cooling setpoint of indoor air
diff --git a/src/SURFEX/modd_data_cover_par.F90 b/src/SURFEX/modd_data_cover_par.F90
index 2d64460862c31abfbd45c09549be91b5d24ae760..044071630e0012607f62b79153d08985964de06b 100644
--- a/src/SURFEX/modd_data_cover_par.F90
+++ b/src/SURFEX/modd_data_cover_par.F90
@@ -44,13 +44,26 @@ IMPLICIT NONE
!------------------------------------------------------------------------------
!
! Maximum number of cover classes
-INTEGER, PARAMETER :: JPCOVER = 573
+INTEGER :: JPCOVER
!last class number of EUROPE
INTEGER, PARAMETER :: NCOVER_ECO1_END = 255
!firt class number of EUROPE
INTEGER, PARAMETER :: NCOVER_ECO2_START = 301
!
-INTEGER :: NVEGTYPE
+INTEGER, PARAMETER :: NVEGTYPE_OLD = 19
+INTEGER, PARAMETER :: NVEGTYPE_ECOSG = 20
+!
+INTEGER, PARAMETER :: NWATTYPE = 2
+INTEGER, PARAMETER :: NSEATYPE = 1
+INTEGER, PARAMETER :: NTWNTYPE = 10
+INTEGER, DIMENSION(4) :: NTYPE = (/NSEATYPE,NWATTYPE,NVEGTYPE_ECOSG,NTWNTYPE/)
+!
+LOGICAL, DIMENSION(NVEGTYPE_ECOSG) :: LVEG_PRES
+!
+INTEGER, PARAMETER :: NCOVER = 573
+!
+INTEGER :: NVEGTYPE
+!
! number of vegetation types
!
INTEGER :: NVT_C4 ! C4 cultures types
@@ -72,11 +85,28 @@ INTEGER :: NVT_ROCK ! ROCKs
INTEGER :: NVT_SNOW ! Ice-cap ice-sheet
INTEGER :: NVT_IRR ! IRRigated crops
INTEGER :: NVT_PARK ! irrigated PARKs gardens or peat bogs
+!
+INTEGER :: NVT_C3W ! winter C3 crops
+INTEGER :: NVT_C3S ! summer C3 crops
+INTEGER :: NVT_FLTR ! flooded trees
+INTEGER :: NVT_FLGR ! flooded grassland
+!
! indexes of these types (C4 cultures types, Broadleaf TREEs, CONIferous trees,
! EVERgreen broadleaf trees, GRASsland, TROpical Grass,
! C3 CULTures types, NO vegetation, ROCKs,
! IRRigated crops, irrigated PARKs gardens or peat bogs)
!
+INTEGER :: NUT_CPHR
+INTEGER :: NUT_CPMR
+INTEGER :: NUT_CPLR
+INTEGER :: NUT_OPHR
+INTEGER :: NUT_OPMR
+INTEGER :: NUT_OPLR
+INTEGER :: NUT_LWLR
+INTEGER :: NUT_LALR
+INTEGER :: NUT_SPAR
+INTEGER :: NUT_INDU
+!
!---------------------------------------------------------------------------------
!
! Ecosystem corresponding to bare soil or permanent snow
@@ -88,8 +118,8 @@ INTEGER :: NPERMSNOW
!
! Free water bodies
!
-INTEGER, DIMENSION(3) :: NSEA
-INTEGER, DIMENSION(2) :: NWATER
+INTEGER, DIMENSION(:), ALLOCATABLE :: NSEA
+INTEGER, DIMENSION(:), ALLOCATABLE :: NWATER
!
!---------------------------------------------------------------------------------
!
@@ -109,7 +139,7 @@ INTEGER :: NDATA_FLOOR_LAYER
!---------------------------------------------------------------------------------
!* names of all ecosystems
!
- CHARACTER(LEN=60), DIMENSION(JPCOVER,2) :: CNAMES
+ CHARACTER(LEN=60), DIMENSION(:,:), ALLOCATABLE :: CNAMES
!---------------------------------------------------------------------------------
!
! reference height for CDN averaging
diff --git a/src/SURFEX/modd_data_covern.F90 b/src/SURFEX/modd_data_covern.F90
index 2dcbbf7e7388bfca83efb81778fab8d140bd4829..24422e7e4f388a78ec77e937c92b77543d5695ec 100644
--- a/src/SURFEX/modd_data_covern.F90
+++ b/src/SURFEX/modd_data_covern.F90
@@ -68,7 +68,7 @@ END TYPE DATA_COVER_t
- CONTAINS
+CONTAINS
!
diff --git a/src/SURFEX/modd_data_isban.F90 b/src/SURFEX/modd_data_isban.F90
index 8fb6da2097774142606be47b039407a9197897d5..218decf1c0b7f39a6cdbd0d827fcf0848dcd2e24 100644
--- a/src/SURFEX/modd_data_isban.F90
+++ b/src/SURFEX/modd_data_isban.F90
@@ -32,7 +32,7 @@
!* 0. DECLARATIONS
! ------------
!
-!
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE_ECOSG, NVEGTYPE_OLD
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -44,71 +44,78 @@ TYPE DATA_ISBA_t
!
! Mask and number of grid elements containing patches/tiles:
!
- REAL, POINTER, DIMENSION(:,:) :: XPAR_VEGTYPE ! fraction of each vegetation type for
+ REAL, POINTER, DIMENSION(:,:) :: XPAR_VEGTYPE ! fraction of each vegetation type for
! ! each grid mesh (-)
!
!-------------------------------------------------------------------------------
+!
+ INTEGER :: NVEGTYPE
!
INTEGER :: NTIME ! number of time data
! ! for VEG, LAI, EMIS, Z0
LOGICAL :: LDATA_MIXPAR
!
LOGICAL :: LDATA_VEGTYPE
- LOGICAL :: LDATA_LAI
- LOGICAL :: LDATA_H_TREE
- LOGICAL :: LDATA_DG
- LOGICAL :: LDATA_DICE
- LOGICAL :: LDATA_ROOTFRAC
- LOGICAL :: LDATA_GROUND_DEPTH
- LOGICAL :: LDATA_ROOT_DEPTH
- LOGICAL :: LDATA_ROOT_EXTINCTION
- LOGICAL :: LDATA_ROOT_LIN
- LOGICAL :: LDATA_VEG
- LOGICAL :: LDATA_Z0
- LOGICAL :: LDATA_EMIS
- LOGICAL :: LDATA_ALBNIR_VEG
- LOGICAL :: LDATA_ALBVIS_VEG
- LOGICAL :: LDATA_ALBUV_VEG
- LOGICAL :: LDATA_RSMIN
- LOGICAL :: LDATA_GAMMA
- LOGICAL :: LDATA_WRMAX_CF
- LOGICAL :: LDATA_CV
- LOGICAL :: LDATA_Z0_O_Z0H
- LOGICAL :: LDATA_RGL
- LOGICAL :: LDATA_BSLAI
- LOGICAL :: LDATA_LAIMIN
- LOGICAL :: LDATA_SEFOLD
- LOGICAL :: LDATA_GMES
- LOGICAL :: LDATA_RE25
- LOGICAL :: LDATA_STRESS
- LOGICAL :: LDATA_F2I
- LOGICAL :: LDATA_GC
- LOGICAL :: LDATA_DMAX
- LOGICAL :: LDATA_CE_NITRO
- LOGICAL :: LDATA_CF_NITRO
- LOGICAL :: LDATA_CNA_NITRO
- LOGICAL :: LDATA_ALBNIR_SOIL
- LOGICAL :: LDATA_ALBVIS_SOIL
- LOGICAL :: LDATA_ALBUV_SOIL
- LOGICAL :: LDATA_IRRIG
- LOGICAL :: LDATA_WATSUP
+!
+ LOGICAL, POINTER, DIMENSION(:) :: LDATA_LAI
+ LOGICAL, POINTER, DIMENSION(:) :: LDATA_VEG
+ LOGICAL, POINTER, DIMENSION(:) :: LDATA_Z0
+ LOGICAL, POINTER, DIMENSION(:) :: LDATA_EMIS
+ LOGICAL, POINTER, DIMENSION(:) :: LDATA_ALBNIR_VEG
+ LOGICAL, POINTER, DIMENSION(:) :: LDATA_ALBVIS_VEG
+ LOGICAL, POINTER, DIMENSION(:) :: LDATA_ALBUV_VEG
+ LOGICAL, POINTER, DIMENSION(:) :: LDATA_IRRIG
+ LOGICAL, POINTER, DIMENSION(:) :: LDATA_WATSUP
+ LOGICAL, POINTER, DIMENSION(:) :: LDATA_ALBNIR_SOIL
+ LOGICAL, POINTER, DIMENSION(:) :: LDATA_ALBVIS_SOIL
+ LOGICAL, POINTER, DIMENSION(:) :: LDATA_ALBUV_SOIL
! - For multi-energy balance (MEB)
!
- LOGICAL :: LDATA_GNDLITTER
- LOGICAL :: LDATA_LAIGV
- LOGICAL :: LDATA_Z0LITTER
- LOGICAL :: LDATA_RSMINGV
- LOGICAL :: LDATA_GAMMAGV
- LOGICAL :: LDATA_WRMAX_CFGV
- LOGICAL :: LDATA_RGLGV
- LOGICAL :: LDATA_ROOTFRACGV
- LOGICAL :: LDATA_ROOT_DEPTHGV
- LOGICAL :: LDATA_ROOT_EXTINCTIONGV
- LOGICAL :: LDATA_H_VEG
-!
- LOGICAL :: LIMP_VEG
- LOGICAL :: LIMP_Z0
- LOGICAL :: LIMP_EMIS
+ LOGICAL, POINTER, DIMENSION(:) :: LDATA_GNDLITTER
+ LOGICAL, POINTER, DIMENSION(:) :: LDATA_Z0LITTER
+ LOGICAL, POINTER, DIMENSION(:) :: LDATA_H_VEG
+ !
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_DG
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_ROOTFRAC
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_H_TREE
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_DICE
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_GROUND_DEPTH
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_ROOT_DEPTH
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_ROOT_EXTINCTION
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_ROOT_LIN
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_RSMIN
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_GAMMA
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_WRMAX_CF
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_CV
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_Z0_O_Z0H
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_RGL
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_BSLAI
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_LAIMIN
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_SEFOLD
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_GMES
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_RE25
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_STRESS
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_F2I
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_GC
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_DMAX
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_CE_NITRO
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_CF_NITRO
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_CNA_NITRO
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_SEED_M
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_SEED_D
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_REAP_M
+ LOGICAL, DIMENSION(MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)) :: LDATA_REAP_D
+!
+ LOGICAL :: LDATA_CONDSAT
+ LOGICAL :: LDATA_MPOTSAT
+ LOGICAL :: LDATA_BCOEF
+ LOGICAL :: LDATA_WWILT
+ LOGICAL :: LDATA_WFC
+ LOGICAL :: LDATA_WSAT
+!
+ LOGICAL :: LIMP_VEG
+ LOGICAL :: LIMP_Z0
+ LOGICAL :: LIMP_EMIS
!
! Input Parameters, per patch:
!
@@ -121,9 +128,9 @@ TYPE DATA_ISBA_t
!
! - vegetation:
!
- REAL, POINTER, DIMENSION(:,:) :: XPAR_ALBNIR_VEG ! vegetation near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:,:) :: XPAR_ALBVIS_VEG ! vegetation visible albedo (-)
- REAL, POINTER, DIMENSION(:,:) :: XPAR_ALBUV_VEG ! vegetation UV albedo (-)
+ REAL, POINTER, DIMENSION(:,:,:) :: XPAR_ALBNIR_VEG ! vegetation near-infra-red albedo (-)
+ REAL, POINTER, DIMENSION(:,:,:) :: XPAR_ALBVIS_VEG ! vegetation visible albedo (-)
+ REAL, POINTER, DIMENSION(:,:,:) :: XPAR_ALBUV_VEG ! vegetation UV albedo (-)
!
! - vegetation: default option (Jarvis) and general parameters:
!
@@ -147,17 +154,8 @@ TYPE DATA_ISBA_t
! - For multi-energy balance (MEB)
!
REAL, POINTER, DIMENSION(:,:,:) :: XPAR_GNDLITTER ! ground litter fraction
- REAL, POINTER, DIMENSION(:,:,:) :: XPAR_LAIGV ! understory LAI
REAL, POINTER, DIMENSION(:,:,:) :: XPAR_Z0LITTER ! ground litter roughness length
- REAL, POINTER, DIMENSION(:,:) :: XPAR_RSMINGV ! understory minimum surface resistance
- REAL, POINTER, DIMENSION(:,:) :: XPAR_GAMMAGV !
- REAL, POINTER, DIMENSION(:,:) :: XPAR_WRMAX_CFGV !
- REAL, POINTER, DIMENSION(:,:) :: XPAR_RGLGV !
- REAL, POINTER, DIMENSION(:,:,:) :: XPAR_ROOTFRACGV ! understory root fraction profile
REAL, POINTER, DIMENSION(:,:,:) :: XPAR_H_VEG ! height of canopy vegetation
- REAL, POINTER, DIMENSION(:,:) :: XPAR_ROOT_DEPTHGV ! root depth ('DIF' option)
- REAL, POINTER, DIMENSION(:,:) :: XPAR_ROOT_EXTINCTIONGV ! root extinction parameter ('DIF' option)
-!
!
!-------------------------------------------------------------------------------
!
@@ -210,27 +208,44 @@ TYPE DATA_ISBA_t
!
! - bare soil albedo
!
- REAL, POINTER, DIMENSION(:,:) :: XPAR_ALBNIR_SOIL ! soil near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:,:) :: XPAR_ALBVIS_SOIL ! soil visible albedo (-)
- REAL, POINTER, DIMENSION(:,:) :: XPAR_ALBUV_SOIL ! soil UV albedo (-)
+ REAL, POINTER, DIMENSION(:,:,:) :: XPAR_ALBNIR_SOIL ! soil near-infra-red albedo (-)
+ REAL, POINTER, DIMENSION(:,:,:) :: XPAR_ALBVIS_SOIL ! soil visible albedo (-)
+ REAL, POINTER, DIMENSION(:,:,:) :: XPAR_ALBUV_SOIL ! soil UV albedo (-)
+!
+ REAL, POINTER, DIMENSION(:,:) :: XPAR_CONDSAT
+ REAL, POINTER, DIMENSION(:,:) :: XPAR_MPOTSAT
+ REAL, POINTER, DIMENSION(:,:) :: XPAR_BCOEF
+ REAL, POINTER, DIMENSION(:,:) :: XPAR_WWILT
+ REAL, POINTER, DIMENSION(:,:) :: XPAR_WFC
+ REAL, POINTER, DIMENSION(:,:) :: XPAR_WSAT
!
!-------------------------------------------------------------------------------
!
-! - Vegetation: Ags Prognostic (YPHOTO = ('LAI', 'LST', 'NIT', or 'NCB') or prescribed (YPHOTO='NON', 'AGS' or 'AST')
+! - Vegetation: Ags Prognostic (YPHOTO = ('NIT' or 'NCB') or prescribed (YPHOTO='NON' or 'AST')
!
REAL, POINTER, DIMENSION(:,:,:) :: XPAR_LAI ! Leaf Area Index (m2/m2)
!
REAL, POINTER, DIMENSION(:,:,:) :: XPAR_IRRIG
REAL, POINTER, DIMENSION(:,:,:) :: XPAR_WATSUP
+ REAL, POINTER, DIMENSION(:,:) :: XPAR_SEED_M
+ REAL, POINTER, DIMENSION(:,:) :: XPAR_SEED_D
+ REAL, POINTER, DIMENSION(:,:) :: XPAR_REAP_M
+ REAL, POINTER, DIMENSION(:,:) :: XPAR_REAP_D
!
!-------------------------------------------------------------------------------
!
-
+ REAL, POINTER, DIMENSION(:) :: XPAR_FRAC_HVEG ! fraction of high vegetation
+ REAL, POINTER, DIMENSION(:) :: XPAR_FRAC_LVEG ! fraction of low vegetation
+ REAL, POINTER, DIMENSION(:) :: XPAR_FRAC_NVEG ! fraction of bare soil
+ REAL, POINTER, DIMENSION(:,:) :: XPAR_LAI_HVEG ! LAI of high vegetation
+ REAL, POINTER, DIMENSION(:,:) :: XPAR_LAI_LVEG ! LAI of low vegetation
+ REAL, POINTER, DIMENSION(:) :: XPAR_H_HVEG ! height of trees
+!
END TYPE DATA_ISBA_t
- CONTAINS
+CONTAINS
!
@@ -279,70 +294,84 @@ IF (LHOOK) CALL DR_HOOK("MODD_DATA_ISBA_N:DATA_ISBA_INIT",0,ZHOOK_HANDLE)
NULLIFY(YDATA_ISBA%XPAR_ALBUV_SOIL)
NULLIFY(YDATA_ISBA%XPAR_LAI)
NULLIFY(YDATA_ISBA%XPAR_IRRIG)
- NULLIFY(YDATA_ISBA%XPAR_WATSUP)
+ NULLIFY(YDATA_ISBA%XPAR_WATSUP)
+ NULLIFY(YDATA_ISBA%XPAR_SEED_M)
+ NULLIFY(YDATA_ISBA%XPAR_SEED_D)
+ NULLIFY(YDATA_ISBA%XPAR_REAP_M)
+ NULLIFY(YDATA_ISBA%XPAR_REAP_D)
NULLIFY(YDATA_ISBA%XPAR_GNDLITTER)
- NULLIFY(YDATA_ISBA%XPAR_LAIGV)
NULLIFY(YDATA_ISBA%XPAR_Z0LITTER)
- NULLIFY(YDATA_ISBA%XPAR_RSMINGV)
- NULLIFY(YDATA_ISBA%XPAR_GAMMAGV)
- NULLIFY(YDATA_ISBA%XPAR_WRMAX_CFGV)
- NULLIFY(YDATA_ISBA%XPAR_RGLGV)
- NULLIFY(YDATA_ISBA%XPAR_ROOTFRACGV)
- NULLIFY(YDATA_ISBA%XPAR_ROOT_DEPTHGV)
- NULLIFY(YDATA_ISBA%XPAR_ROOT_EXTINCTIONGV)
NULLIFY(YDATA_ISBA%XPAR_H_VEG)
+ NULLIFY(YDATA_ISBA%XPAR_FRAC_HVEG)
+ NULLIFY(YDATA_ISBA%XPAR_FRAC_LVEG)
+ NULLIFY(YDATA_ISBA%XPAR_FRAC_NVEG)
+ NULLIFY(YDATA_ISBA%XPAR_LAI_HVEG)
+ NULLIFY(YDATA_ISBA%XPAR_LAI_LVEG)
+ NULLIFY(YDATA_ISBA%XPAR_H_HVEG)
+ NULLIFY(YDATA_ISBA%XPAR_CONDSAT)
+ NULLIFY(YDATA_ISBA%XPAR_MPOTSAT)
+ NULLIFY(YDATA_ISBA%XPAR_BCOEF)
+ NULLIFY(YDATA_ISBA%XPAR_WWILT)
+ NULLIFY(YDATA_ISBA%XPAR_WFC)
+ NULLIFY(YDATA_ISBA%XPAR_WSAT)
+!
YDATA_ISBA%NTIME=0
YDATA_ISBA%LDATA_MIXPAR=.FALSE.
-YDATA_ISBA%LDATA_VEGTYPE=.FALSE.
-YDATA_ISBA%LDATA_LAI=.FALSE.
-YDATA_ISBA%LDATA_H_TREE=.FALSE.
-YDATA_ISBA%LDATA_DG=.FALSE.
-YDATA_ISBA%LDATA_DICE=.FALSE.
-YDATA_ISBA%LDATA_GROUND_DEPTH=.FALSE.
-YDATA_ISBA%LDATA_ROOT_DEPTH=.FALSE.
-YDATA_ISBA%LDATA_ROOT_EXTINCTION=.FALSE.
-YDATA_ISBA%LDATA_ROOT_LIN=.FALSE.
-YDATA_ISBA%LDATA_ROOTFRAC=.FALSE.
-YDATA_ISBA%LDATA_VEG=.FALSE.
-YDATA_ISBA%LDATA_Z0=.FALSE.
-YDATA_ISBA%LDATA_EMIS=.FALSE.
-YDATA_ISBA%LDATA_ALBNIR_VEG=.FALSE.
-YDATA_ISBA%LDATA_ALBVIS_VEG=.FALSE.
-YDATA_ISBA%LDATA_ALBUV_VEG=.FALSE.
-YDATA_ISBA%LDATA_RSMIN=.FALSE.
-YDATA_ISBA%LDATA_GAMMA=.FALSE.
-YDATA_ISBA%LDATA_WRMAX_CF=.FALSE.
-YDATA_ISBA%LDATA_CV=.FALSE.
-YDATA_ISBA%LDATA_RGL=.FALSE.
-YDATA_ISBA%LDATA_Z0_O_Z0H=.FALSE.
-YDATA_ISBA%LDATA_BSLAI=.FALSE.
-YDATA_ISBA%LDATA_LAIMIN=.FALSE.
-YDATA_ISBA%LDATA_SEFOLD=.FALSE.
-YDATA_ISBA%LDATA_GMES=.FALSE.
-YDATA_ISBA%LDATA_RE25=.FALSE.
-YDATA_ISBA%LDATA_STRESS=.FALSE.
-YDATA_ISBA%LDATA_F2I=.FALSE.
-YDATA_ISBA%LDATA_GC=.FALSE.
-YDATA_ISBA%LDATA_DMAX=.FALSE.
-YDATA_ISBA%LDATA_CE_NITRO=.FALSE.
-YDATA_ISBA%LDATA_CF_NITRO=.FALSE.
-YDATA_ISBA%LDATA_CNA_NITRO=.FALSE.
-YDATA_ISBA%LDATA_ALBNIR_SOIL=.FALSE.
-YDATA_ISBA%LDATA_ALBVIS_SOIL=.FALSE.
-YDATA_ISBA%LDATA_ALBUV_SOIL=.FALSE.
-YDATA_ISBA%LDATA_IRRIG=.FALSE.
-YDATA_ISBA%LDATA_WATSUP=.FALSE.
-YDATA_ISBA%LDATA_GNDLITTER=.FALSE.
-YDATA_ISBA%LDATA_LAIGV=.FALSE.
-YDATA_ISBA%LDATA_Z0LITTER=.FALSE.
-YDATA_ISBA%LDATA_RSMINGV=.FALSE.
-YDATA_ISBA%LDATA_GAMMAGV=.FALSE.
-YDATA_ISBA%LDATA_WRMAX_CFGV=.FALSE.
-YDATA_ISBA%LDATA_RGLGV=.FALSE.
-YDATA_ISBA%LDATA_ROOTFRACGV=.FALSE.
-YDATA_ISBA%LDATA_ROOT_DEPTHGV=.FALSE.
-YDATA_ISBA%LDATA_ROOT_EXTINCTIONGV=.FALSE.
-YDATA_ISBA%LDATA_H_VEG=.FALSE.
+YDATA_ISBA%LDATA_VEGTYPE=.FALSE.
+!
+NULLIFY(YDATA_ISBA%LDATA_LAI)
+NULLIFY(YDATA_ISBA%LDATA_VEG)
+NULLIFY(YDATA_ISBA%LDATA_Z0)
+NULLIFY(YDATA_ISBA%LDATA_EMIS)
+NULLIFY(YDATA_ISBA%LDATA_ALBNIR_VEG)
+NULLIFY(YDATA_ISBA%LDATA_ALBVIS_VEG)
+NULLIFY(YDATA_ISBA%LDATA_ALBUV_VEG)
+NULLIFY(YDATA_ISBA%LDATA_ALBNIR_SOIL)
+NULLIFY(YDATA_ISBA%LDATA_ALBVIS_SOIL)
+NULLIFY(YDATA_ISBA%LDATA_ALBUV_SOIL)
+NULLIFY(YDATA_ISBA%LDATA_GNDLITTER)
+NULLIFY(YDATA_ISBA%LDATA_Z0LITTER)
+NULLIFY(YDATA_ISBA%LDATA_H_VEG)
+NULLIFY(YDATA_ISBA%LDATA_IRRIG)
+NULLIFY(YDATA_ISBA%LDATA_WATSUP)
+!
+YDATA_ISBA%LDATA_DG(:) = .FALSE.
+YDATA_ISBA%LDATA_ROOTFRAC(:) = .FALSE.
+YDATA_ISBA%LDATA_H_TREE(:) = .FALSE.
+YDATA_ISBA%LDATA_DICE(:) = .FALSE.
+YDATA_ISBA%LDATA_GROUND_DEPTH(:) = .FALSE.
+YDATA_ISBA%LDATA_ROOT_DEPTH(:) = .FALSE.
+YDATA_ISBA%LDATA_ROOT_EXTINCTION(:) = .FALSE.
+YDATA_ISBA%LDATA_ROOT_LIN(:) = .FALSE.
+YDATA_ISBA%LDATA_RSMIN(:) = .FALSE.
+YDATA_ISBA%LDATA_GAMMA(:) = .FALSE.
+YDATA_ISBA%LDATA_WRMAX_CF(:) = .FALSE.
+YDATA_ISBA%LDATA_CV(:) = .FALSE.
+YDATA_ISBA%LDATA_RGL(:) = .FALSE.
+YDATA_ISBA%LDATA_Z0_O_Z0H(:) = .FALSE.
+YDATA_ISBA%LDATA_BSLAI(:) = .FALSE.
+YDATA_ISBA%LDATA_LAIMIN(:) = .FALSE.
+YDATA_ISBA%LDATA_SEFOLD(:) = .FALSE.
+YDATA_ISBA%LDATA_GMES(:) = .FALSE.
+YDATA_ISBA%LDATA_RE25(:) = .FALSE.
+YDATA_ISBA%LDATA_STRESS(:) = .FALSE.
+YDATA_ISBA%LDATA_F2I(:) = .FALSE.
+YDATA_ISBA%LDATA_GC(:) = .FALSE.
+YDATA_ISBA%LDATA_DMAX(:) = .FALSE.
+YDATA_ISBA%LDATA_CE_NITRO(:) = .FALSE.
+YDATA_ISBA%LDATA_CF_NITRO(:) = .FALSE.
+YDATA_ISBA%LDATA_CNA_NITRO(:) = .FALSE.
+YDATA_ISBA%LDATA_SEED_M(:) = .FALSE.
+YDATA_ISBA%LDATA_SEED_D(:) = .FALSE.
+YDATA_ISBA%LDATA_REAP_M(:) = .FALSE.
+YDATA_ISBA%LDATA_REAP_D(:) = .FALSE.
+!
+YDATA_ISBA%LDATA_CONDSAT = .FALSE.
+YDATA_ISBA%LDATA_MPOTSAT = .FALSE.
+YDATA_ISBA%LDATA_BCOEF = .FALSE.
+YDATA_ISBA%LDATA_WWILT = .FALSE.
+YDATA_ISBA%LDATA_WFC = .FALSE.
+YDATA_ISBA%LDATA_WSAT = .FALSE.
!
YDATA_ISBA%LIMP_VEG=.FALSE.
YDATA_ISBA%LIMP_Z0=.FALSE.
diff --git a/src/SURFEX/modd_data_seafluxn.F90 b/src/SURFEX/modd_data_seafluxn.F90
index cbf56c40ee0d52833bd4d92d41af48c2201ad013..49889be7778c5470e80b67ae9bf31cbdaadd12cd 100644
--- a/src/SURFEX/modd_data_seafluxn.F90
+++ b/src/SURFEX/modd_data_seafluxn.F90
@@ -62,7 +62,7 @@ END TYPE DATA_SEAFLUX_t
- CONTAINS
+CONTAINS
!
diff --git a/src/SURFEX/modd_data_teb_gardenn.F90 b/src/SURFEX/modd_data_teb_gardenn.F90
deleted file mode 100644
index 6acf397975094f2d3f7cdb5b168f3c1b6f1031b3..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_data_teb_gardenn.F90
+++ /dev/null
@@ -1,234 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ##################
- MODULE MODD_DATA_TEB_GARDEN_n
-! ##################
-!
-!!**** *MODD_DATA_ISBA - declaration of DATA surface parameters for ISBA scheme
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 05/2005
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE DATA_TEB_GARDEN_t
-!-------------------------------------------------------------------------------
-!
- REAL, POINTER, DIMENSION(:) :: XDATA_FRAC_HVEG ! fraction of high vegetation
- REAL, POINTER, DIMENSION(:) :: XDATA_FRAC_LVEG ! fraction of low vegetation
- REAL, POINTER, DIMENSION(:) :: XDATA_FRAC_NVEG ! fraction of bare soil
- REAL, POINTER, DIMENSION(:,:) :: XDATA_LAI_HVEG ! LAI of high vegetation
- REAL, POINTER, DIMENSION(:,:) :: XDATA_LAI_LVEG ! LAI of low vegetation
- REAL, POINTER, DIMENSION(:) :: XDATA_H_HVEG ! height of trees
-!
-!
-! Mask and number of grid elements containing patches/tiles:
-!
- REAL, POINTER, DIMENSION(:,:) :: XDATA_VEGTYPE ! fraction of each vegetation type for
-! ! each grid mesh (-)
-!
-!-------------------------------------------------------------------------------
-!
- INTEGER :: NTIME ! number of time data
-! ! for VEG, LAI, EMIS, Z0
-!
-! Input Parameters:
-!
-! - vegetation + bare soil:
-!
- REAL, POINTER, DIMENSION(:) :: XDATA_Z0_O_Z0H ! ratio of surface roughness lengths
-! ! (momentum to heat) (-)
- REAL, POINTER, DIMENSION(:,:) :: XDATA_EMIS ! surface emissivity (-)
- REAL, POINTER, DIMENSION(:,:) :: XDATA_Z0 ! surface roughness length (m)
-!
-! - vegetation:
-!
- REAL, POINTER, DIMENSION(:) :: XDATA_ALBNIR_VEG ! vegetation near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:) :: XDATA_ALBVIS_VEG ! vegetation visible albedo (-)
- REAL, POINTER, DIMENSION(:) :: XDATA_ALBUV_VEG ! vegetation UV albedo (-)
-!
-! - vegetation: default option (Jarvis) and general parameters:
-!
- REAL, POINTER, DIMENSION(:,:) :: XDATA_VEG ! vegetation cover fraction (-)
- REAL, POINTER, DIMENSION(:) :: XDATA_WRMAX_CF ! coefficient for maximum water
-! ! interception
-! ! storage capacity on the vegetation (-)
- REAL, POINTER, DIMENSION(:) :: XDATA_RSMIN ! minimum stomatal resistance (s/m)
- REAL, POINTER, DIMENSION(:) :: XDATA_GAMMA ! coefficient for the calculation
-! ! of the surface stomatal
-! ! resistance
- REAL, POINTER, DIMENSION(:) :: XDATA_CV ! vegetation thermal inertia coefficient (K m2/J)
- REAL, POINTER, DIMENSION(:) :: XDATA_RGL ! maximum solar radiation
-! ! usable in photosynthesis (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XDATA_ROOTFRAC ! root fraction profile ('DIF' option)
-!
-!-------------------------------------------------------------------------------
-!
-! - vegetation: Ags parameters ('AGS', 'LAI', 'AST', 'LST', 'NIT', 'NCB' options)
-!
- REAL, POINTER, DIMENSION(:) :: XDATA_BSLAI ! ratio d(biomass)/d(lai) (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XDATA_LAIMIN ! minimum LAI (Leaf Area Index) (m2/m2)
- REAL, POINTER, DIMENSION(:) :: XDATA_SEFOLD ! e-folding time for senescence (s)
- REAL, POINTER, DIMENSION(:) :: XDATA_H_TREE ! height of trees (m)
- REAL, POINTER, DIMENSION(:) :: XDATA_GMES ! mesophyll conductance (m s-1)
- REAL, POINTER, DIMENSION(:) :: XDATA_RE25 ! Ecosystem respiration parameter (kg m2 s-1)
-!
-!-------------------------------------------------------------------------------
-!
-! - vegetation: Ags Stress parameters ('AST', 'LST', 'NIT', 'NCB' options)
-!
- LOGICAL, POINTER, DIMENSION(:) :: LDATA_STRESS ! vegetation response type to water
-! ! stress (true:defensive false:offensive) (-)
- REAL, POINTER, DIMENSION(:) :: XDATA_F2I ! critical normilized soil water
-! ! content for stress parameterisation
- REAL, POINTER, DIMENSION(:) :: XDATA_GC ! cuticular conductance (m s-1)
- REAL, POINTER, DIMENSION(:) :: XDATA_DMAX ! maximum air saturation deficit
-! ! tolerate by vegetation (kg/kg)
-!
- REAL, POINTER, DIMENSION(:) :: XDATA_BSLAI_ST ! ratio d(biomass)/d(lai) (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XDATA_SEFOLD_ST ! e-folding time for senescence (s)
- REAL, POINTER, DIMENSION(:) :: XDATA_GMES_ST ! mesophyll conductance (m s-1)
- REAL, POINTER, DIMENSION(:) :: XDATA_GC_ST ! cuticular conductance (m s-1)
- REAL, POINTER, DIMENSION(:) :: XDATA_DMAX_ST ! maximum air saturation deficit
-!-------------------------------------------------------------------------------
-!
-! - vegetation: Ags Nitrogen-model parameters ('NIT', 'NCB' option)
-!
- REAL, POINTER, DIMENSION(:) :: XDATA_CE_NITRO ! leaf aera ratio sensitivity to
-! ! nitrogen concentration (m2/kg)
- REAL, POINTER, DIMENSION(:) :: XDATA_CF_NITRO ! lethal minimum value of leaf area
-! ! ratio (m2/kg)
- REAL, POINTER, DIMENSION(:) :: XDATA_CNA_NITRO ! nitrogen concentration of active
-! ! biomass (kg/kg)
-!
-!-------------------------------------------------------------------------------
-!
-! - soil: primary parameters
-!
- REAL, POINTER, DIMENSION(:,:) :: XDATA_DG ! soil layer thicknesses (m)
-! ! NOTE: in Force-Restore mode, the
-! ! uppermost layer thickness is superficial
-! ! and is only explicitly used for soil
-! ! water phase changes (m)
-!
- REAL, POINTER,DIMENSION(:) :: XDATA_DICE ! depth of the soil column for the calculation
-! of the frozen soil fraction (m)
-!
-! - bare soil albedo
-!
- REAL, POINTER, DIMENSION(:) :: XDATA_ALBNIR_SOIL ! soil near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:) :: XDATA_ALBVIS_SOIL ! soil visible albedo (-)
- REAL, POINTER, DIMENSION(:) :: XDATA_ALBUV_SOIL ! soil UV albedo (-)
- REAL, POINTER, DIMENSION(:) :: XDATA_ALBNIR_DRY ! dry soil near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:) :: XDATA_ALBVIS_DRY ! dry soil visible albedo (-)
- REAL, POINTER, DIMENSION(:) :: XDATA_ALBUV_DRY ! dry soil UV albedo (-)
- REAL, POINTER, DIMENSION(:) :: XDATA_ALBNIR_WET ! wet soil near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:) :: XDATA_ALBVIS_WET ! wet soil visible albedo (-)
- REAL, POINTER, DIMENSION(:) :: XDATA_ALBUV_WET ! wet soil UV albedo (-)
-!
-!-------------------------------------------------------------------------------
-!
-!- Vegetation: Ags Prognostic (YPHOTO = ('LAI', 'LST', 'NIT', or 'NCB') or prescribed (YPHOTO='NON', 'AGS' or 'AST')
-!
- REAL, POINTER, DIMENSION(:,:) :: XDATA_LAI ! Leaf Area Index (m2/m2)
-!
-!-------------------------------------------------------------------------------
-!
-
-END TYPE DATA_TEB_GARDEN_t
-
-
-
- CONTAINS
-
-!
-
-
-
-
-SUBROUTINE DATA_TEB_GARDEN_INIT(YDATA_TEB_GARDEN)
-TYPE(DATA_TEB_GARDEN_t), INTENT(INOUT) :: YDATA_TEB_GARDEN
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_DATA_TEB_GARDEN_N:DATA_TEB_GARDEN_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_FRAC_HVEG)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_FRAC_LVEG)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_FRAC_NVEG)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_LAI_HVEG)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_LAI_LVEG)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_H_HVEG)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_VEGTYPE)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_Z0_O_Z0H)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_EMIS)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_Z0)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_ALBNIR_VEG)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_ALBVIS_VEG)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_ALBUV_VEG)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_VEG)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_WRMAX_CF)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_RSMIN)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_GAMMA)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_CV)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_RGL)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_ROOTFRAC)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_BSLAI)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_LAIMIN)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_SEFOLD)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_H_TREE)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_GMES)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_RE25)
- NULLIFY(YDATA_TEB_GARDEN%LDATA_STRESS)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_F2I)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_GC)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_DMAX)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_BSLAI_ST)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_SEFOLD_ST)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_GMES_ST)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_GC_ST)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_DMAX_ST)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_CE_NITRO)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_CF_NITRO)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_CNA_NITRO)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_DG)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_DICE)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_ALBNIR_SOIL)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_ALBVIS_SOIL)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_ALBUV_SOIL)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_ALBNIR_DRY)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_ALBVIS_DRY)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_ALBUV_DRY)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_ALBNIR_WET)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_ALBVIS_WET)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_ALBUV_WET)
- NULLIFY(YDATA_TEB_GARDEN%XDATA_LAI)
-YDATA_TEB_GARDEN%NTIME=0
-IF (LHOOK) CALL DR_HOOK("MODD_DATA_TEB_GARDEN_N:DATA_TEB_GARDEN_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE DATA_TEB_GARDEN_INIT
-
-
-END MODULE MODD_DATA_TEB_GARDEN_n
diff --git a/src/SURFEX/modd_data_teb_greenroofn.F90 b/src/SURFEX/modd_data_teb_greenroofn.F90
deleted file mode 100644
index b69737fe0263835ade173ddb1f908ca82dcfe6a7..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_data_teb_greenroofn.F90
+++ /dev/null
@@ -1,227 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ##################
- MODULE MODD_DATA_TEB_GREENROOF_n
-! ##################
-!
-!!**** *MODD_DATA_ISBA - declaration of DATA surface parameters for ISBA scheme
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 05/2005
-!! A. Lemonsu / C. de Munck 04/2011 : TEB GreenRoof
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE DATA_TEB_GREENROOF_t
-!-------------------------------------------------------------------------------
-!
-
- REAL, POINTER, DIMENSION(:,:) :: XPAR_OM_GR ! fraction of organic matter (OM) in green roof layer
- REAL, POINTER, DIMENSION(:,:) :: XPAR_CLAY_GR ! fraction of clay for the non-OM part of the green roof layer
- REAL, POINTER, DIMENSION(:,:) :: XPAR_SAND_GR ! fraction of sand for the non-OM part of the green roof layer
- REAL, POINTER, DIMENSION(:,:) :: XPAR_LAI_GR ! LAI of green roof vegetation
-!
-!
-! Mask and number of grid elements containing patches/tiles:
-!
- REAL, POINTER, DIMENSION(:,:) :: XPAR_VEGTYPE ! fraction of each vegetation type for
- ! each grid mesh (-)
-!
-!-------------------------------------------------------------------------------
-!
-! Input Parameters, per patch:
-!
-! - vegetation + bare soil:
-!
- REAL, POINTER, DIMENSION(:) :: XPAR_Z0_O_Z0H ! ratio of surface roughness lengths
- ! (momentum to heat) (-)
- REAL, POINTER, DIMENSION(:,:) :: XPAR_EMIS ! surface emissivity (-)
- REAL, POINTER, DIMENSION(:,:) :: XPAR_Z0 ! surface roughness length (m)
-!
-! - vegetation:
-!
- REAL, POINTER, DIMENSION(:) :: XPAR_ALBNIR_VEG ! vegetation near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:) :: XPAR_ALBVIS_VEG ! vegetation visible albedo (-)
- REAL, POINTER, DIMENSION(:) :: XPAR_ALBUV_VEG ! vegetation UV albedo (-)
-!
-! - vegetation: default option (Jarvis) and general parameters:
-!
- REAL, POINTER, DIMENSION(:,:) :: XPAR_VEG ! vegetation cover fraction (-)
- REAL, POINTER, DIMENSION(:) :: XPAR_WRMAX_CF ! coefficient for maximum water
- ! interception
- ! storage capacity on the vegetation (-)
- REAL, POINTER, DIMENSION(:) :: XPAR_RSMIN ! minimum stomatal resistance (s/m)
- REAL, POINTER, DIMENSION(:) :: XPAR_GAMMA ! coefficient for the calculation
- ! of the surface stomatal
- ! resistance
- REAL, POINTER, DIMENSION(:) :: XPAR_CV ! vegetation thermal inertia coefficient (K m2/J)
- REAL, POINTER, DIMENSION(:) :: XPAR_RGL ! maximum solar radiation
- ! usable in photosynthesis (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XPAR_ROOTFRAC ! root fraction profile ('DIF' option)
-!
-!-------------------------------------------------------------------------------
-!
-! - vegetation: Ags parameters ('AGS', 'LAI', 'AST', 'LST', 'NIT', 'NCB' options)
-!
- REAL, POINTER, DIMENSION(:) :: XPAR_BSLAI ! ratio d(biomass)/d(lai) (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XPAR_LAIMIN ! minimum LAI (Leaf Area Index) (m2/m2)
- REAL, POINTER, DIMENSION(:) :: XPAR_SEFOLD ! e-folding time for senescence (s)
- REAL, POINTER, DIMENSION(:) :: XPAR_H_TREE ! height of trees (m)
- REAL, POINTER, DIMENSION(:) :: XPAR_GMES ! mesophyll conductance (m s-1)
- REAL, POINTER, DIMENSION(:) :: XPAR_RE25 ! Ecosystem respiration parameter (kg m2 s-1)
-!
-!-------------------------------------------------------------------------------
-!
-! - vegetation: Ags Stress parameters ('AST', 'LST', 'NIT', 'NCB' options)
-!
- LOGICAL, POINTER, DIMENSION(:) :: LDATA_STRESS ! vegetation response type to water
- ! stress (true:defensive false:offensive) (-)
- REAL, POINTER, DIMENSION(:) :: XPAR_F2I ! critical normilized soil water
- ! content for stress parameterisation
- REAL, POINTER, DIMENSION(:) :: XPAR_GC ! cuticular conductance (m s-1)
- REAL, POINTER, DIMENSION(:) :: XPAR_DMAX ! maximum air saturation deficit
- ! tolerate by vegetation (kg/kg)
-!
- REAL, POINTER, DIMENSION(:) :: XPAR_BSLAI_ST ! ratio d(biomass)/d(lai) (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XPAR_SEFOLD_ST ! e-folding time for senescence (s)
- REAL, POINTER, DIMENSION(:) :: XPAR_GMES_ST ! mesophyll conductance (m s-1)
- REAL, POINTER, DIMENSION(:) :: XPAR_GC_ST ! cuticular conductance (m s-1)
- REAL, POINTER, DIMENSION(:) :: XPAR_DMAX_ST ! maximum air saturation deficit
-!-------------------------------------------------------------------------------
-!
-! - vegetation: Ags Nitrogen-model parameters ('NIT', 'NCB' option)
-!
- REAL, POINTER, DIMENSION(:) :: XPAR_CE_NITRO ! leaf aera ratio sensitivity to
- ! nitrogen concentration (m2/kg)
- REAL, POINTER, DIMENSION(:) :: XPAR_CF_NITRO ! lethal minimum value of leaf area
- ! ratio (m2/kg)
- REAL, POINTER, DIMENSION(:) :: XPAR_CNA_NITRO ! nitrogen concentration of active
- ! biomass (kg/kg)
-!
-!-------------------------------------------------------------------------------
-!
-! - soil: primary parameters
-!
- REAL, POINTER, DIMENSION(:,:) :: XPAR_DG ! soil layer thicknesses (m)
- ! NOTE: in Force-Restore mode, the
- ! uppermost layer thickness is superficial
- ! and is only explicitly used for soil
- ! water phase changes (m)
-!
- REAL, POINTER,DIMENSION(:) :: XPAR_DICE ! depth of the soil column for the calculation
- ! of the frozen soil fraction (m)
-!
-! - bare soil albedo
-!
- REAL, POINTER, DIMENSION(:) :: XPAR_ALBNIR_SOIL ! soil near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:) :: XPAR_ALBVIS_SOIL ! soil visible albedo (-)
- REAL, POINTER, DIMENSION(:) :: XPAR_ALBUV_SOIL ! soil UV albedo (-)
- REAL, POINTER, DIMENSION(:) :: XPAR_ALBNIR_DRY ! dry soil near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:) :: XPAR_ALBVIS_DRY ! dry soil visible albedo (-)
- REAL, POINTER, DIMENSION(:) :: XPAR_ALBUV_DRY ! dry soil UV albedo (-)
- REAL, POINTER, DIMENSION(:) :: XPAR_ALBNIR_WET ! wet soil near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:) :: XPAR_ALBVIS_WET ! wet soil visible albedo (-)
- REAL, POINTER, DIMENSION(:) :: XPAR_ALBUV_WET ! wet soil UV albedo (-)
-!
-!-------------------------------------------------------------------------------
-!
-!- Vegetation: Ags Prognostic (YPHOTO = ('LAI', 'LST', 'NIT', or 'NCB') or prescribed (YPHOTO='NON', 'AGS' or 'AST')
-!
- REAL, POINTER, DIMENSION(:,:) :: XPAR_LAI ! Leaf Area Index (m2/m2)
-!
-!-------------------------------------------------------------------------------
-!
-
-END TYPE DATA_TEB_GREENROOF_t
-
-
-
- CONTAINS
-
-!
-
-
-
-
-SUBROUTINE DATA_TEB_GREENROOF_INIT(YDATA_TEB_GREENROOF)
-TYPE(DATA_TEB_GREENROOF_t), INTENT(INOUT) :: YDATA_TEB_GREENROOF
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_DATA_TEB_GREENROOF_N:DATA_TEB_GREENROOF_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_OM_GR)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_CLAY_GR)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_SAND_GR)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_LAI_GR)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_VEGTYPE)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_Z0_O_Z0H)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_EMIS)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_Z0)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_ALBNIR_VEG)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_ALBVIS_VEG)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_ALBUV_VEG)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_VEG)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_WRMAX_CF)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_RSMIN)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_GAMMA)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_CV)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_RGL)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_ROOTFRAC)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_BSLAI)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_LAIMIN)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_SEFOLD)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_H_TREE)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_GMES)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_RE25)
- NULLIFY(YDATA_TEB_GREENROOF%LDATA_STRESS)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_F2I)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_GC)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_DMAX)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_BSLAI_ST)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_SEFOLD_ST)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_GMES_ST)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_GC_ST)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_DMAX_ST)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_CE_NITRO)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_CF_NITRO)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_CNA_NITRO)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_DG)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_DICE)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_ALBNIR_SOIL)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_ALBVIS_SOIL)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_ALBUV_SOIL)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_ALBNIR_DRY)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_ALBVIS_DRY)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_ALBUV_DRY)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_ALBNIR_WET)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_ALBVIS_WET)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_ALBUV_WET)
- NULLIFY(YDATA_TEB_GREENROOF%XPAR_LAI)
-IF (LHOOK) CALL DR_HOOK("MODD_DATA_TEB_GREENROOF_N:DATA_TEB_GREENROOF_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE DATA_TEB_GREENROOF_INIT
-
-
-END MODULE MODD_DATA_TEB_GREENROOF_n
diff --git a/src/SURFEX/modd_data_tebn.F90 b/src/SURFEX/modd_data_tebn.F90
index 8ca2c21857f21f44aea29ac44023e9c537eb99e2..61447a5790f80bcc4755e4176476e09e9c181286 100644
--- a/src/SURFEX/modd_data_tebn.F90
+++ b/src/SURFEX/modd_data_tebn.F90
@@ -150,7 +150,7 @@ END TYPE DATA_TEB_t
- CONTAINS
+CONTAINS
!
diff --git a/src/SURFEX/modd_data_tsz0n.F90 b/src/SURFEX/modd_data_tsz0n.F90
index 01748fa859b1a8420db66997165335837d926238..c9dff0644ee7a17e31dc60fd1d6c0f474eea60a5 100644
--- a/src/SURFEX/modd_data_tsz0n.F90
+++ b/src/SURFEX/modd_data_tsz0n.F90
@@ -47,7 +47,7 @@ END TYPE DATA_TSZ0_t
- CONTAINS
+CONTAINS
!
diff --git a/src/SURFEX/modd_diag_cumul_tebn.F90 b/src/SURFEX/modd_diag_cumul_tebn.F90
deleted file mode 100644
index f26e430b86d4fe1d57f4d7e8ef1878083c0a374f..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_diag_cumul_tebn.F90
+++ /dev/null
@@ -1,143 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ############################
- MODULE MODD_DIAG_CUMUL_TEB_n
-! ############################
-!
-!!**** *MODD_DIAG_CUMUL_TEB - declaration of cumulated surface parameters for TEB scheme
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! C de Munck *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 19/02/2013
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-!TYPE DIAG_CUMUL_TEB_OPTIONS_t
-!------------------------------------------------------------------------------
-!
-! LOGICAL :: LTEB_CUM ! flag for cumulated terms of teb scheme
-!
-!------------------------------------------------------------------------------
-!END TYPE DIAG_CUMUL_TEB_OPTIONS_t
-!
-TYPE DIAG_CUMUL_TEB_1P_t
-!------------------------------------------------------------------------------
-!* miscellaneous variables
-!
- REAL, POINTER, DIMENSION(:) :: XRUNOFFC_TOWN ! cumulateda ggregated water runoff for town (kg/m2 town/s)
- REAL, POINTER, DIMENSION(:) :: XRUNOFFC_GARDEN ! cumulated water runoff for green areas (kg/m2 garden/s)
- REAL, POINTER, DIMENSION(:) :: XRUNOFFC_ROAD ! cumulated water runoff for roads (kg/m2 road/s)
- REAL, POINTER, DIMENSION(:) :: XRUNOFFC_ROOF ! cumulated aggregated water runoff for roofs (kg/m2 roof/s)
- REAL, POINTER, DIMENSION(:) :: XRUNOFFC_STRLROOF ! cumulated water runoff for structural roofs (kg/m2 structural roof/s)
- REAL, POINTER, DIMENSION(:) :: XRUNOFFC_GREENROOF ! cumulated water runoff for greenroof (kg/m2 greenroof/s)
- REAL, POINTER, DIMENSION(:) :: XDRAINC_GREENROOF ! cumulated water vertical drainage for greenroof (kg/m2 greenroof/s)
- REAL, POINTER, DIMENSION(:) :: XDRAINC_GARDEN ! cumulated water vertical drainage for gardens (kg/m2 garden/s)
- REAL, POINTER, DIMENSION(:) :: XIRRIGC_GREENROOF ! cumulated water supply from summer irrigation (kg/m2 greenroof/s)
- REAL, POINTER, DIMENSION(:) :: XIRRIGC_GARDEN ! cumulated water supply from summer irrigation (kg/m2 garden/s)
- REAL, POINTER, DIMENSION(:) :: XIRRIGC_ROAD ! cumulated water supply from summer irrigation (kg/m2 road/s)
- !
- REAL, POINTER, DIMENSION(:) :: XHVACC_COOL ! cumulated en. consump. of the cooling system [W m-2(bld)]
- REAL, POINTER, DIMENSION(:) :: XHVACC_HEAT ! cumulated en. consump. of the heating system [W m-2(bld)]
- REAL, POINTER, DIMENSION(:) :: XTHER_PROD_BLDC ! cumulated en. product. of thermal solar panels [W m-2(bld)]
- REAL, POINTER, DIMENSION(:) :: XPHOT_PROD_BLDC ! cumulated en. product. of photovoltaic solar panels [W m-2(bld)]
-!
-!------------------------------------------------------------------------------
-END TYPE DIAG_CUMUL_TEB_1P_t
-
-TYPE DIAG_CUMUL_TEB_t
- !
- TYPE(DIAG_CUMUL_TEB_1P_t), POINTER :: ALP(:) => NULL()
- TYPE(DIAG_CUMUL_TEB_1P_t), POINTER :: CUR => NULL()
- !
-END TYPE DIAG_CUMUL_TEB_t
-
-
-
-
- CONTAINS
-!
-!------------------------------------------------------------------------------
-!
-!------------------------------------------------------------------------------
-!
-!
-
-
-
-!
-SUBROUTINE DIAG_CUMUL_TEB_GOTO_PATCH(YDIAG_CUMUL_TEB,KTO_PATCH)
-TYPE(DIAG_CUMUL_TEB_t), INTENT(INOUT) :: YDIAG_CUMUL_TEB
-INTEGER, INTENT(IN) :: KTO_PATCH
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-! Current patch is set to patch KTO_PATCH
-IF (LHOOK) CALL DR_HOOK('MODD_DIAG_CUMUL_TEB_N:DIAG_CUMUL_TEB_GOTO_PATCH',0,ZHOOK_HANDLE)
-
-YDIAG_CUMUL_TEB%CUR => YDIAG_CUMUL_TEB%ALP(KTO_PATCH)
-
-IF (LHOOK) CALL DR_HOOK('MODD_DIAG_CUMUL_TEB_N:DIAG_CUMUL_TEB_GOTO_PATCH',1,ZHOOK_HANDLE)
-
-END SUBROUTINE DIAG_CUMUL_TEB_GOTO_PATCH
-!
-!------------------------------------------------------------------------------
-!
-SUBROUTINE DIAG_CUMUL_TEB_INIT(YDIAG_CUMUL_TEB,KPATCH)
-TYPE(DIAG_CUMUL_TEB_t), INTENT(INOUT) :: YDIAG_CUMUL_TEB
-INTEGER, INTENT(IN) :: KPATCH
-INTEGER :: JP
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_CUMUL_TEB_N:DIAG_CUMUL_TEB_INIT",0,ZHOOK_HANDLE)
- ALLOCATE(YDIAG_CUMUL_TEB%ALP(KPATCH))
- YDIAG_CUMUL_TEB%CUR => YDIAG_CUMUL_TEB%ALP(1)
-DO JP=1,KPATCH
- NULLIFY(YDIAG_CUMUL_TEB%ALP(JP)%XRUNOFFC_TOWN)
- NULLIFY(YDIAG_CUMUL_TEB%ALP(JP)%XRUNOFFC_GARDEN)
- NULLIFY(YDIAG_CUMUL_TEB%ALP(JP)%XRUNOFFC_ROAD)
- NULLIFY(YDIAG_CUMUL_TEB%ALP(JP)%XRUNOFFC_ROOF)
- NULLIFY(YDIAG_CUMUL_TEB%ALP(JP)%XRUNOFFC_STRLROOF)
- NULLIFY(YDIAG_CUMUL_TEB%ALP(JP)%XRUNOFFC_GREENROOF)
- NULLIFY(YDIAG_CUMUL_TEB%ALP(JP)%XDRAINC_GREENROOF)
- NULLIFY(YDIAG_CUMUL_TEB%ALP(JP)%XDRAINC_GARDEN)
- NULLIFY(YDIAG_CUMUL_TEB%ALP(JP)%XIRRIGC_GREENROOF)
- NULLIFY(YDIAG_CUMUL_TEB%ALP(JP)%XIRRIGC_GARDEN)
- NULLIFY(YDIAG_CUMUL_TEB%ALP(JP)%XIRRIGC_ROAD)
- NULLIFY(YDIAG_CUMUL_TEB%ALP(JP)%XHVACC_COOL)
- NULLIFY(YDIAG_CUMUL_TEB%ALP(JP)%XHVACC_HEAT)
- NULLIFY(YDIAG_CUMUL_TEB%ALP(JP)%XTHER_PROD_BLDC)
- NULLIFY(YDIAG_CUMUL_TEB%ALP(JP)%XPHOT_PROD_BLDC)
-ENDDO
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_CUMUL_TEB_N:DIAG_CUMUL_TEB_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE DIAG_CUMUL_TEB_INIT
-!
-!------------------------------------------------------------------------------
-!
-!
-!------------------------------------------------------------------------------
-
-END MODULE MODD_DIAG_CUMUL_TEB_n
diff --git a/src/SURFEX/modd_diag_evap_isban.F90 b/src/SURFEX/modd_diag_evap_isban.F90
index 4fc83ca1b7953333951b0d08d4598159b9e8a880..7a29849b8d8ba890daf29081cc351220766b9ceb 100644
--- a/src/SURFEX/modd_diag_evap_isban.F90
+++ b/src/SURFEX/modd_diag_evap_isban.F90
@@ -6,7 +6,7 @@
MODULE MODD_DIAG_EVAP_ISBA_n
!########################
!
-!!**** *MODD_DIAG_ISBA - declaration of packed surface parameters for ISBA scheme
+!!**** *MODD_DIAG_NAT - declaration of packed surface parameters for NAT scheme
!!
!! PURPOSE
!! -------
@@ -41,610 +41,252 @@ TYPE DIAG_EVAP_ISBA_t
!------------------------------------------------------------------------------
!
LOGICAL :: LSURF_EVAP_BUDGET ! flag for all terms of evaporation
- LOGICAL :: LSURF_BUDGETC ! flag for surface cumulated energy budget
- LOGICAL :: LRESET_BUDGETC ! flag for surface cumulated energy budget
LOGICAL :: LWATER_BUDGET ! flag for isba water budget including input
! fluxes (rain and snow) and reservoir tendencies
!
!* variables for each patch
!
- REAL, POINTER, DIMENSION(:,:) :: XLEG ! latent heat of evaporation over the ground (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLEGI ! surface soil ice sublimation (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLEV ! latent heat of evaporation over vegetation (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLES ! latent heat of sublimation over the snow (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLESL ! latent heat of evaporation over the snow (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLER ! evaporation from canopy water interception (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLETR ! evapotranspiration of the vegetation (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XEVAP ! evapotranspiration (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XSUBL ! sublimation (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XSNDRIFT ! blowing snow sublimation (ES or Crocus) (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XDRAIN ! soil drainage flux (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XQSB ! lateral subsurface flux (dif option) (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XRUNOFF ! sub-grid and supersaturation runoff (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XHORT ! sub-grid Horton runoff from the SGH scheme (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XRRVEG ! precipitation intercepted by the vegetation (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XMELT ! snow melt (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XIFLOOD ! Floodplains infiltration (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XPFLOOD ! Precipitation intercepted by the floodplains (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XLE_FLOOD ! Floodplains evapotration (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLEI_FLOOD ! Floodplains evapotration (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XDRIP ! dripping from the vegetation reservoir (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XIRRIG_FLUX ! irrigation rate (as soil input) (kg/m2/s)
+ REAL, POINTER, DIMENSION(:) :: XLEG ! latent heat of evaporation over the ground (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XLEGI ! surface soil ice sublimation (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XLEV ! latent heat of evaporation over vegetation (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XLES ! latent heat of sublimation over the snow (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XLESL ! latent heat of evaporation over the snow (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XLER ! evaporation from canopy water interception (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XLETR ! evapotranspiration of the vegetation (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XUSTAR ! friction velocity from snow-free
+! ! surface (ISBA-ES:3-L) (m/s
+ REAL, POINTER, DIMENSION(:) :: XSNDRIFT ! blowing snow sublimation (ES or Crocus) (kg/m2/s)
+ REAL, POINTER, DIMENSION(:) :: XRESTORE ! surface energy budget restore term (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XDRAIN ! soil drainage flux (kg/m2/s)
+ REAL, POINTER, DIMENSION(:) :: XQSB ! lateral subsurface flux (dif option) (kg/m2/s)
+ REAL, POINTER, DIMENSION(:) :: XRUNOFF ! sub-grid and supersaturation runoff (kg/m2/s)
+ REAL, POINTER, DIMENSION(:) :: XHORT ! sub-grid Horton runoff from the SGH scheme (kg/m2/s)
+ REAL, POINTER, DIMENSION(:) :: XRRVEG ! precipitation intercepted by the vegetation (kg/m2/s)
+ REAL, POINTER, DIMENSION(:) :: XMELT ! snow melt (kg/m2/s)
+ REAL, POINTER, DIMENSION(:) :: XMELTADV ! advective energy from snow melt water
+! ! (ISBA-ES:3-L) (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XIFLOOD ! Floodplains infiltration (kg/m2/s)
+ REAL, POINTER, DIMENSION(:) :: XPFLOOD ! Precipitation intercepted by the floodplains (kg/m2/s)
+ REAL, POINTER, DIMENSION(:) :: XLE_FLOOD ! Floodplains evapotration (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XLEI_FLOOD ! Floodplains evapotration (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XICEFLUX ! ice calving flux (kg/m2)
+ REAL, POINTER, DIMENSION(:) :: XDRIP ! dripping from the vegetation reservoir (kg/m2/s)
+ REAL, POINTER, DIMENSION(:) :: XIRRIG_FLUX ! irrigation rate (as soil input) (kg/m2/s)
!
- REAL, POINTER, DIMENSION(:,:) :: XGPP ! Gross Primary Production (kgCO2/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XRESP_AUTO ! Autotrophic respiration (kgCO2/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XRESP_ECO ! Ecosystem respiration (kgCO2/m2/s)
-!
- REAL, POINTER, DIMENSION(:,:) :: XLEVCV ! MEB: total evapotranspiration from vegetation canopy overstory [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLESC ! MEB: total snow sublimation from vegetation canopy overstory [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLETRGV ! MEB: transpiration from understory vegetation [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLETRCV ! MEB: transpiration from overstory canopy vegetation [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLERGV ! MEB: interception evaporation from understory vegetation [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLELITTER ! MEB: interception evaporation from understory vegetation [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLELITTERI ! MEB: interception evaporation from understory vegetation [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XDRIPLIT !
- REAL, POINTER, DIMENSION(:,:) :: XRRLIT !
- REAL, POINTER, DIMENSION(:,:) :: XLERCV ! MEB: interception evaporation from overstory canopy vegetation [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLE_V_C ! MEB: latent heat flux from vegetation canopy overstory [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLE_G_C ! MEB: latent heat flux from understory [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLE_C_A ! MEB: latent heat flux from canopy air space to the atmosphere [W/m2]
- ! NOTE total latent heat flux to the atmosphere also possibly
- ! includes a contribution from snow covering the canopy
- REAL, POINTER, DIMENSION(:,:) :: XLE_N_C ! MEB: latent heat flux from the snow on the ground [W/m2]
- ! NOTE total latent heat flux from the snowpack
- ! possibly includes a contribution from snow covering the canopy
- REAL, POINTER, DIMENSION(:,:) :: XSWNET_V ! MEB: net vegetation canopy shortwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XSWNET_G ! MEB: net ground shortwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XSWNET_N ! MEB: net snow shortwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XSWNET_NS ! MEB: net snow shortwave radiation for *surface* layer
- ! (i.e. net snow shortwave radiation less absorbed radiation) [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLWNET_V ! MEB: net vegetation canopy longwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLWNET_G ! MEB: net ground longwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLWNET_N ! MEB: net snow longwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XH_V_C ! MEB: sensible heat flux from vegetation canopy overstory [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XH_G_C ! MEB: sensible heat flux from understory [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XH_C_A ! MEB: sensible heat flux from canopy air space to the atmosphere [W/m2]
- ! NOTE total sensible heat flux to the atmosphere also possibly
- ! includes a contribution from snow covering the canopy
- REAL, POINTER, DIMENSION(:,:) :: XH_N_C ! MEB: sensible heat flux from the snow on the ground [W/m2]
- ! NOTE total sensible heat flux from the snowpack
- ! possibly includes a contribution from snow covering the canopy
- REAL, POINTER, DIMENSION(:,:) :: XSR_GN ! MEB: snow unloading rate from the overstory reservoir [kg/m2/s]
- REAL, POINTER, DIMENSION(:,:) :: XMELTCV ! MEB: snow melt rate from the overstory snow reservoir [kg/m2/s]
- REAL, POINTER, DIMENSION(:,:) :: XFRZCV ! MEB: snow refreeze rate from the overstory snow reservoir [kg/m2/s]
- REAL, POINTER, DIMENSION(:,:) :: XSWDOWN_GN ! MEB: total shortwave radiation transmitted through the canopy
- ! reaching the snowpack/ground understory [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLWDOWN_GN ! MEB: total shortwave radiation transmitted through and emitted by the canopy
- ! reaching the snowpack/ground understory (explicit part) [W/m2]
-!
- REAL, POINTER, DIMENSION(:,:) :: XDWG ! liquid soil moisture time tendencies (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XDWGI ! solid soil moisture time tendencies (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XDWR ! canopy water time tendencies (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XDSWE ! snow water equivalent time tendencies (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XWATBUD ! ISBA water budget (kg/m2/s)
-!
-!* average variables
-!
- REAL, POINTER, DIMENSION(:) :: XAVG_LEG ! latent heat of evaporation over the ground (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LEGI ! surface soil ice sublimation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LEV ! latent heat of evaporation over vegetation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LES ! latent heat of sublimation over the snow (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LESL ! latent heat of evaporation over the snow (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LER ! evaporation from canopy water interception (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LETR ! evapotranspiration of the vegetation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_EVAP ! evapotranspiration (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_SUBL ! sublimation (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_SNDRIFT ! blowing snow sublimation (ES or Crocus) (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_DRAIN ! soil drainage flux (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_QSB ! lateral subsurface flux (dif option) (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_RUNOFF ! sub-grid and supersaturation runoff (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_HORT ! sub-grid Horton runoff from the SGH scheme (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_DRIP ! dripping from the vegetation reservoir (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_MELT ! snow melt (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_IFLOOD ! Floodplains infiltration (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_PFLOOD ! Precipitation intercepted by the floodplains (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_LE_FLOOD ! Floodplains evapotration (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LEI_FLOOD! Floodplains evapotration (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_RRVEG ! precipitation intercepted by the vegetation (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_IRRIG_FLUX! irrigation rate (as soil input) (kg/m2/s)
-!
- REAL, POINTER, DIMENSION(:) :: XAVG_GPP ! Gross Primary Production (kgCO2/m2/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_RESP_AUTO! Autotrophic respiration (kgCO2/m2/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_RESP_ECO ! Ecosystem respiration (kgCO2/m2/s)
-!
- REAL, POINTER, DIMENSION(:) :: XAVG_LEVCV ! MEB: total evapotranspiration from vegetation canopy overstory [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LESC ! MEB: total snow sublimation from vegetation canopy overstory [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LETRGV ! MEB: transpiration from understory vegetation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LETRCV ! MEB: transpiration from overstory canopy vegetation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LERGV ! MEB: interception evaporation from understory vegetation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LELITTER ! MEB: interception evaporation from understory vegetation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LELITTERI ! MEB: interception evaporation from understory vegetation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_DRIPLIT !
- REAL, POINTER, DIMENSION(:) :: XAVG_RRLIT !
- REAL, POINTER, DIMENSION(:) :: XAVG_LERCV ! MEB: interception evaporation from overstory canopy vegetation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LE_V_C ! MEB: latent heat flux from vegetation canopy overstory [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LE_G_C ! MEB: latent heat flux from understory [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LE_C_A ! MEB: latent heat flux from canopy air space to the atmosphere [W/m2]
- ! NOTE total latent heat flux to the atmosphere also possibly
- ! includes a contribution from snow covering the canopy
- REAL, POINTER, DIMENSION(:) :: XAVG_LE_N_C ! MEB: latent heat flux from the snow on the ground [W/m2]
- ! NOTE total latent heat flux from the snowpack
- ! possibly includes a contribution from snow covering the canopy
- REAL, POINTER, DIMENSION(:) :: XAVG_SWNET_V ! MEB: net vegetation canopy shortwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_SWNET_G ! MEB: net ground shortwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_SWNET_N ! MEB: net snow shortwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_SWNET_NS ! MEB: net snow shortwave radiation for *surface* layer
- ! (i.e. net snow shortwave radiation less absorbed radiation) [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LWNET_V ! MEB: net vegetation canopy longwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LWNET_G ! MEB: net ground longwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LWNET_N ! MEB: net snow longwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_H_V_C ! MEB: sensible heat flux from vegetation canopy overstory [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_H_G_C ! MEB: sensible heat flux from understory [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_H_C_A ! MEB: sensible heat flux from canopy air space to the atmosphere [W/m2]
- ! NOTE total sensible heat flux to the atmosphere also possibly
- ! includes a contribution from snow covering the canopy
- REAL, POINTER, DIMENSION(:) :: XAVG_H_N_C ! MEB: sensible heat flux from the snow on the ground [W/m2]
- ! NOTE total sensible heat flux from the snowpack
- ! possibly includes a contribution from snow covering the canopy
- REAL, POINTER, DIMENSION(:) :: XAVG_SR_GN ! MEB: snow unloading rate from the overstory reservoir [kg/m2/s]
- REAL, POINTER, DIMENSION(:) :: XAVG_MELTCV ! MEB: snow melt rate from the overstory snow reservoir [kg/m2/s]
- REAL, POINTER, DIMENSION(:) :: XAVG_FRZCV ! MEB: snow refreeze rate from the overstory snow reservoir [kg/m2/s]
- REAL, POINTER, DIMENSION(:) :: XAVG_SWDOWN_GN ! MEB: total shortwave radiation transmitted through the canopy
- ! reaching the snowpack/ground understory [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LWDOWN_GN ! MEB: total shortwave radiation transmitted through and emitted by the canopy
- ! reaching the snowpack/ground understory (explicit part) [W/m2]
+ REAL, POINTER, DIMENSION(:) :: XGPP ! Gross Primary Production (kgCO2/m2/s)
+ REAL, POINTER, DIMENSION(:) :: XRESP_AUTO ! Autotrophic respiration (kgCO2/m2/s)
+ REAL, POINTER, DIMENSION(:) :: XRESP_ECO ! Ecosystem respiration (kgCO2/m2/s)
+!
+!
+ REAL, POINTER, DIMENSION(:) :: XLELITTER ! MEB: interception evaporation from understory vegetation [W/m2]
+ REAL, POINTER, DIMENSION(:) :: XLELITTERI ! MEB: interception evaporation from understory vegetation [W/m2]
+ REAL, POINTER, DIMENSION(:) :: XDRIPLIT !
+ REAL, POINTER, DIMENSION(:) :: XRRLIT !
+!
+ REAL, POINTER, DIMENSION(:) :: XLEV_CV ! MEB: total evapotranspiration from vegetation canopy overstory [W/m2]
+ REAL, POINTER, DIMENSION(:) :: XLES_CV ! XLESC MEB: total snow sublimation from vegetation canopy overstory [W/m2]
+ REAL, POINTER, DIMENSION(:) :: XLETR_CV ! MEB: transpiration from overstory canopy vegetation [W/m2]
+ REAL, POINTER, DIMENSION(:) :: XLER_CV ! MEB: interception evaporation from overstory canopy vegetation [W/m2]
+ REAL, POINTER, DIMENSION(:) :: XLE_CV ! XLE_V_C MEB: latent heat flux from vegetation canopy overstory [W/m2]
+ REAL, POINTER, DIMENSION(:) :: XH_CV ! H_V_C MEB: sensible heat flux from vegetation canopy overstory [W/m2]
+ REAL, POINTER, DIMENSION(:) :: XMELT_CV ! MEB: snow melt rate from the overstory snow reservoir [kg/m2/s]
+ REAL, POINTER, DIMENSION(:) :: XFRZ_CV ! MEB: snow refreeze rate from the overstory snow reservoir [kg/m2/s]
+!
+ REAL, POINTER, DIMENSION(:) :: XLETR_GV ! MEB: transpiration from understory vegetation [W/m2]
+ REAL, POINTER, DIMENSION(:) :: XLER_GV ! MEB: interception evaporation from understory vegetation [W/m2]
+ REAL, POINTER, DIMENSION(:) :: XLE_GV ! LEG_C MEB: latent heat flux from understory [W/m2]
+ REAL, POINTER, DIMENSION(:) :: XH_GV ! H_G_C MEB: sensible heat flux from understory [W/m2]
+!
+ REAL, POINTER, DIMENSION(:) :: XLE_GN ! LE_N_C MEB: latent heat flux from the snow on the ground [W/m2]
+ ! NOTE total latent heat flux from the snowpack
+ ! possibly includes a contribution from snow covering the canopy
+ REAL, POINTER, DIMENSION(:) :: XEVAP_GN ! EVAP_N_C MEB: Total evap from snow on the ground to canopy air space [kg/m2/s]
+ REAL, POINTER, DIMENSION(:) :: XH_GN ! H_N_C MEB: sensible heat flux from the snow on the ground [W/m2]
+ ! NOTE total sensible heat flux from the snowpack
+ ! possibly includes a contribution from snow covering the canopy
+ REAL, POINTER, DIMENSION(:) :: XSR_GN ! MEB: snow unloading rate from the overstory reservoir [kg/m2/s]
+ REAL, POINTER, DIMENSION(:) :: XSWDOWN_GN ! MEB: total shortwave radiation transmitted through the canopy
+ ! reaching the snowpack/ground understory [W/m2]
+ REAL, POINTER, DIMENSION(:) :: XLWDOWN_GN ! MEB: total shortwave radiation transmitted through and emitted by the canopy
+ ! reaching the snowpack/ground understory (explicit part) [W/m2]
+!
+ REAL, POINTER, DIMENSION(:) :: XEVAP_G ! EVAP_G_C MEB: Total evap from ground to canopy air space [kg/m2/s]
+ REAL, POINTER, DIMENSION(:) :: XLE_CA ! LE_C_A MEB: latent heat flux from canopy air space to the atmosphere [W/m2]
+ ! NOTE total latent heat flux to the atmosphere also possibly
+ ! includes a contribution from snow covering the canopy
+ REAL, POINTER, DIMENSION(:) :: XH_CA ! H_C_A MEB: sensible heat flux from canopy air space to the atmosphere [W/m2]
+ ! NOTE total sensible heat flux to the atmosphere also possibly
+ ! includes a contribution from snow covering the canopy
+
+!
+ REAL, POINTER, DIMENSION(:) :: XSWUP ! MEB: net *total* (surface) upwelling shortwave radiation to atmosphere [W/m2]
+ REAL, POINTER, DIMENSION(:) :: XLWUP ! MEB: net *total* (surface) upwelling longwave radiation to atmosphere [W/m2]
+
+ REAL, POINTER, DIMENSION(:) :: XSWNET_V ! MEB: net vegetation canopy shortwave radiation [W/m2]
+ REAL, POINTER, DIMENSION(:) :: XSWNET_G ! MEB: net ground shortwave radiation [W/m2]
+ REAL, POINTER, DIMENSION(:) :: XSWNET_N ! MEB: net snow shortwave radiation [W/m2]
+ REAL, POINTER, DIMENSION(:) :: XSWNET_NS ! MEB: net snow shortwave radiation for *surface* layer
+ ! (i.e. net snow shortwave radiation less absorbed radiation) [W/m2]
+ REAL, POINTER, DIMENSION(:) :: XLWNET_V ! MEB: net vegetation canopy longwave radiation [W/m2]
+ REAL, POINTER, DIMENSION(:) :: XLWNET_G ! MEB: net ground longwave radiation [W/m2]
+ REAL, POINTER, DIMENSION(:) :: XLWNET_N ! MEB: net snow longwave radiation [W/m2]
+!
+!
+ REAL, POINTER, DIMENSION(:) :: XDWG ! liquid soil moisture time tendencies (kg/m2/s)
+ REAL, POINTER, DIMENSION(:) :: XDWGI ! solid soil moisture time tendencies (kg/m2/s)
+ REAL, POINTER, DIMENSION(:) :: XDWR ! canopy water time tendencies (kg/m2/s)
+ REAL, POINTER, DIMENSION(:) :: XDSWE ! snow water equivalent time tendencies (kg/m2/s)
+ REAL, POINTER, DIMENSION(:) :: XWATBUD ! ISBA water budget (kg/m2/s)
!
REAL, POINTER, DIMENSION(:) :: XRAINFALL ! input rainfall rate for LWATER_BUDGET (kg/m2/s)
REAL, POINTER, DIMENSION(:) :: XSNOWFALL ! input snowfall rate for LWATER_BUDGET (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_DWG ! liquid soil moisture time tendencies (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_DWGI ! solid soil moisture time tendencies (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_DWR ! canopy water time tendencies (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_DSWE ! snow water equivalent time tendencies (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_WATBUD ! ISBA water budget (kg/m2/s)
-!
-!* budget summation variables for each patch
-!
- REAL, POINTER, DIMENSION(:,:) :: XRNC ! net radiation at surface (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XHC ! sensible heat flux (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLEC ! total latent heat flux (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLEIC ! sublimation latent heat flux (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XGFLUXC ! net soil-vegetation flux (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLEGC ! latent heat of evaporation over the ground (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLEGIC ! surface soil ice sublimation (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLEVC ! latent heat of evaporation over vegetation (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLESAC ! latent heat of sublimation over the snow (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLESLC ! latent heat of evaporation over the snow (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLERC ! evaporation from canopy water interception (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLETRC ! evapotranspiration of the vegetation (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XEVAPC ! evapotranspiration (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSUBLC ! sublimation (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSNDRIFTC ! blowing snow sublimation (ES or Crocus) (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XDRAINC ! soil drainage flux (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XQSBC ! lateral subsurface flux (dif option) (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XRUNOFFC ! sub-grid and supersaturation runoff (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XHORTC ! sub-grid Horton runoff from the SGH scheme (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XDRIPC ! dripping from the vegetation reservoir (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XMELTC ! snow melt (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XIFLOODC ! Floodplains infiltration (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XPFLOODC ! Precipitation intercepted by the floodplains (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLE_FLOODC ! Floodplains evapotration (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLEI_FLOODC ! Floodplains evapotration (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XICEFLUXC ! ice calving flux (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XRRVEGC ! precipitation intercepted by the vegetation (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XIRRIG_FLUXC ! irrigation rate (as soil input) (kg/m2)
-!
- REAL, POINTER, DIMENSION(:,:) :: XGPPC ! Gross Primary Production (kgCO2/m2)
- REAL, POINTER, DIMENSION(:,:) :: XRESPC_AUTO ! Autotrophic respiration (kgCO2/m2)
- REAL, POINTER, DIMENSION(:,:) :: XRESPC_ECO ! Ecosystem respiration (kgCO2/m2)
-!
- REAL, POINTER, DIMENSION(:,:) :: XLEVCVC ! MEB: total evapotranspiration from vegetation canopy overstory [J/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLESCC ! MEB: total snow sublimation from vegetation canopy overstory [J/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLETRGVC ! MEB: transpiration from understory vegetation [J/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLETRCVC ! MEB: transpiration from overstory canopy vegetation [J/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLERGVC ! MEB: interception evaporation from understory vegetation [J/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLERCVC ! MEB: interception evaporation from overstory canopy vegetation [J/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLE_V_CC ! MEB: latent heat flux from vegetation canopy overstory [J/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLE_G_CC ! MEB: latent heat flux from understory [J/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLE_C_AC ! MEB: latent heat flux from canopy air space to the atmosphere [J/m2]
- ! NOTE total latent heat flux to the atmosphere also possibly
- ! includes a contribution from snow covering the canopy
- REAL, POINTER, DIMENSION(:,:) :: XLE_N_CC ! MEB: latent heat flux from the snow on the ground [J/m2]
- ! NOTE total latent heat flux from the snowpack
- ! possibly includes a contribution from snow covering the canopy
- REAL, POINTER, DIMENSION(:,:) :: XSWNET_VC ! MEB: net vegetation canopy shortwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XSWNET_GC ! MEB: net ground shortwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XSWNET_NC ! MEB: net snow shortwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XSWNET_NSC ! MEB: net snow shortwave radiation for *surface* layer
- ! (i.e. net snow shortwave radiation less absorbed radiation) [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLWNET_VC ! MEB: net vegetation canopy longwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLWNET_GC ! MEB: net ground longwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLWNET_NC ! MEB: net snow longwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XH_V_CC ! MEB: sensible heat flux from vegetation canopy overstory [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XH_G_CC ! MEB: sensible heat flux from understory [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XH_C_AC ! MEB: sensible heat flux from canopy air space to the atmosphere [W/m2]
- ! NOTE total sensible heat flux to the atmosphere also possibly
- ! includes a contribution from snow covering the canopy
- REAL, POINTER, DIMENSION(:,:) :: XH_N_CC ! MEB: sensible heat flux from the snow on the ground [W/m2]
- ! NOTE total sensible heat flux from the snowpack
- ! possibly includes a contribution from snow covering the canopy
- REAL, POINTER, DIMENSION(:,:) :: XSR_GNC ! MEB: snow unloading rate from the overstory reservoir [kg/m2/s]
- REAL, POINTER, DIMENSION(:,:) :: XMELTCVC ! MEB: snow melt rate from the overstory snow reservoir [kg/m2/s]
- REAL, POINTER, DIMENSION(:,:) :: XFRZCVC ! MEB: snow refreeze rate from the overstory snow reservoir [kg/m2/s]
- REAL, POINTER, DIMENSION(:,:) :: XSWDOWN_GNC ! MEB: total shortwave radiation transmitted through the canopy
- ! reaching the snowpack/ground understory [W/m2]
- REAL, POINTER, DIMENSION(:,:) :: XLWDOWN_GNC ! MEB: total shortwave radiation transmitted through and emitted by the canopy
- ! reaching the snowpack/ground understory (explicit part) [W/m2]
-!
- REAL, POINTER, DIMENSION(:,:) :: XDWGC ! liquid soil moisture time tendencies (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XDWGIC ! solid soil moisture time tendencies (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XDWRC ! canopy water time tendencies (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XDSWEC ! snow water equivalent time tendencies (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XWATBUDC ! ISBA water budget (kg/m2)
-!
-!* average budget summation variables
-!
- REAL, POINTER, DIMENSION(:) :: XAVG_RNC ! net radiation at surface (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_HC ! sensible heat flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LEC ! total latent heat flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LEIC ! sublimation latent heat flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_GFLUXC ! net soil-vegetation flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LEGC ! latent heat of evaporation over the ground (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LEGIC ! surface soil ice sublimation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LEVC ! latent heat of evaporation over vegetation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LESAC ! latent heat of sublimation over the snow (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LESLC ! latent heat of evaporation over the snow (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LERC ! evaporation from canopy water interception (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LETRC ! evapotranspiration of the vegetation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_EVAPC ! evapotranspiration (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_SUBLC ! sublimation (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_SNDRIFTC ! blowing snow sublimation (ES or Crocus) (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_DRAINC ! soil drainage flux (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_QSBC ! lateral subsurface flux (dif option) (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_RUNOFFC ! sub-grid and supersaturation runoff (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_HORTC ! sub-grid Horton runoff from the SGH scheme (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_DRIPC ! dripping from the vegetation reservoir (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_MELTC ! snow melt (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_IFLOODC ! Floodplains infiltration (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_PFLOODC ! Precipitation intercepted by the floodplains (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LE_FLOODC ! Floodplains evapotration (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LEI_FLOODC! Floodplains evapotration (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_ICEFLUXC ! ice calving flux (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_RRVEGC ! precipitation intercepted by the vegetation (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_IRRIG_FLUXC! irrigation rate (as soil input) (kg/m2)
-!
- REAL, POINTER, DIMENSION(:) :: XAVG_GPPC ! Gross Primary Production (kgCO2/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_RESPC_AUTO! Autotrophic respiration (kgCO2/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_RESPC_ECO ! Ecosystem respiration (kgCO2/m2)
-!
- REAL, POINTER, DIMENSION(:) :: XAVG_LEVCVC ! MEB: total evapotranspiration from vegetation canopy overstory [J/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LESCC ! MEB: total snow sublimation from vegetation canopy overstory [J/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LETRGVC ! MEB: transpiration from understory vegetation [J/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LETRCVC ! MEB: transpiration from overstory canopy vegetation [J/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LERGVC ! MEB: interception evaporation from understory vegetation [J/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LERCVC ! MEB: interception evaporation from overstory canopy vegetation [J/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LE_V_CC ! MEB: latent heat flux from vegetation canopy overstory [J/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LE_G_CC ! MEB: latent heat flux from understory [J/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LE_C_AC ! MEB: latent heat flux from canopy air space to the atmosphere [J/m2]
- ! NOTE total latent heat flux to the atmosphere also possibly
- ! includes a contribution from snow covering the canopy
- REAL, POINTER, DIMENSION(:) :: XAVG_LE_N_CC ! MEB: latent heat flux from the snow on the ground [J/m2]
- ! NOTE total latent heat flux from the snowpack
- ! possibly includes a contribution from snow covering the canopy
- REAL, POINTER, DIMENSION(:) :: XAVG_SWNET_VC ! MEB: net vegetation canopy shortwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_SWNET_GC ! MEB: net ground shortwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_SWNET_NC ! MEB: net snow shortwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_SWNET_NSC ! MEB: net snow shortwave radiation for *surface* layer
- ! (i.e. net snow shortwave radiation less absorbed radiation) [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LWNET_VC ! MEB: net vegetation canopy longwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LWNET_GC ! MEB: net ground longwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LWNET_NC ! MEB: net snow longwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_H_V_CC ! MEB: sensible heat flux from vegetation canopy overstory [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_H_G_CC ! MEB: sensible heat flux from understory [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_H_C_AC ! MEB: sensible heat flux from canopy air space to the atmosphere [W/m2]
- ! NOTE total sensible heat flux to the atmosphere also possibly
- ! includes a contribution from snow covering the canopy
- REAL, POINTER, DIMENSION(:) :: XAVG_H_N_CC ! MEB: sensible heat flux from the snow on the ground [W/m2]
- ! NOTE total sensible heat flux from the snowpack
- ! possibly includes a contribution from snow covering the canopy
- REAL, POINTER, DIMENSION(:) :: XAVG_SR_GNC ! MEB: snow unloading rate from the overstory reservoir [kg/m2/s]
- REAL, POINTER, DIMENSION(:) :: XAVG_MELTCVC ! MEB: snow melt rate from the overstory snow reservoir [kg/m2/s]
- REAL, POINTER, DIMENSION(:) :: XAVG_FRZCVC ! MEB: snow refreeze rate from the overstory snow reservoir [kg/m2/s]
- REAL, POINTER, DIMENSION(:) :: XAVG_SWDOWN_GNC ! MEB: total shortwave radiation transmitted through the canopy
- ! reaching the snowpack/ground understory [W/m2]
- REAL, POINTER, DIMENSION(:) :: XAVG_LWDOWN_GNC ! MEB: total shortwave radiation transmitted through and emitted by the canopy
- ! reaching the snowpack/ground understory (explicit part) [W/m2]
-!
- REAL, POINTER, DIMENSION(:) :: XRAINFALLC ! input rainfall rate for LWATER_BUDGET (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XSNOWFALLC ! input snowfall rate for LWATER_BUDGET (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_DWGC ! liquid soil moisture time tendencies (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_DWGIC ! solid soil moisture time tendencies (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_DWRC ! canopy water time tendencies (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_DSWEC ! snow water equivalent time tendencies (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_WATBUDC ! ISBA water budget (kg/m2)
!
+! Snowfree diagnostics
+!
+ REAL, POINTER, DIMENSION(:) :: XRN_SN_FR
+ REAL, POINTER, DIMENSION(:) :: XH_SN_FR
+ REAL, POINTER, DIMENSION(:) :: XLEI_SN_FR
+ REAL, POINTER, DIMENSION(:) :: XLE_SN_FR
+ REAL, POINTER, DIMENSION(:) :: XGFLUX_SN_FR
+!
+ REAL, POINTER, DIMENSION(:) :: XLEG_SN_FR
+ REAL, POINTER, DIMENSION(:) :: XLEGI_SN_FR
+ REAL, POINTER, DIMENSION(:) :: XLEV_SN_FR
+ REAL, POINTER, DIMENSION(:) :: XLETR_SN_FR
+ REAL, POINTER, DIMENSION(:) :: XUSTAR_SN_FR
+ REAL, POINTER, DIMENSION(:) :: XLER_SN_FR
+!
!------------------------------------------------------------------------------
!
END TYPE DIAG_EVAP_ISBA_t
-
-
-
- CONTAINS
!
+TYPE DIAG_EVAP_ISBA_NP_t
+!
+TYPE(DIAG_EVAP_ISBA_t), POINTER :: AL(:)=>NULL()
+!
+END TYPE DIAG_EVAP_ISBA_NP_t
+!
+CONTAINS
+!
+SUBROUTINE DIAG_EVAP_ISBA_NP_INIT(YNDIAG_EVAP_ISBA,KPATCH)
+TYPE(DIAG_EVAP_ISBA_NP_t), INTENT(INOUT) :: YNDIAG_EVAP_ISBA
+INTEGER, INTENT(IN) :: KPATCH
+INTEGER :: JP
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_DIAG_EVAP_ISBA_N:DIAG_EVAP_ISBA_NP_INIT",0,ZHOOK_HANDLE)
+IF (.NOT.ASSOCIATED(YNDIAG_EVAP_ISBA%AL)) THEN
+ ALLOCATE(YNDIAG_EVAP_ISBA%AL(KPATCH))
+ DO JP=1,KPATCH
+ CALL DIAG_EVAP_ISBA_INIT(YNDIAG_EVAP_ISBA%AL(JP))
+ ENDDO
+ELSE
+ DO JP=1,KPATCH
+ CALL DIAG_EVAP_ISBA_INIT(YNDIAG_EVAP_ISBA%AL(JP))
+ ENDDO
+ DEALLOCATE(YNDIAG_EVAP_ISBA%AL)
+ENDIF
+IF (LHOOK) CALL DR_HOOK("MODD_DIAG_EVAP_ISBA_N:DIAG_EVAP_ISBA_NP_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE DIAG_EVAP_ISBA_NP_INIT
+!
+SUBROUTINE DIAG_EVAP_ISBA_INIT(DE)
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_DIAG_EVAP_ISBA_N:DIAG_EVAP_ISBA_INIT",0,ZHOOK_HANDLE)
+ NULLIFY(DE%XLEG)
+ NULLIFY(DE%XLEGI)
+ NULLIFY(DE%XLEV)
+ NULLIFY(DE%XLES)
+ NULLIFY(DE%XLESL)
+ NULLIFY(DE%XLER)
+ NULLIFY(DE%XLETR)
+ NULLIFY(DE%XUSTAR)
+ NULLIFY(DE%XSNDRIFT)
+ NULLIFY(DE%XRESTORE)
+ NULLIFY(DE%XDRAIN)
+ NULLIFY(DE%XQSB)
+ NULLIFY(DE%XRUNOFF)
+ NULLIFY(DE%XHORT)
+ NULLIFY(DE%XRRVEG)
+ NULLIFY(DE%XMELT)
+ NULLIFY(DE%XMELTADV)
+ NULLIFY(DE%XIFLOOD)
+ NULLIFY(DE%XPFLOOD)
+ NULLIFY(DE%XLE_FLOOD)
+ NULLIFY(DE%XLEI_FLOOD)
+!
+ NULLIFY(DE%XICEFLUX)
+!
+ NULLIFY(DE%XLELITTER)
+ NULLIFY(DE%XLELITTERI)
+ NULLIFY(DE%XDRIPLIT)
+ NULLIFY(DE%XRRLIT)
+ NULLIFY(DE%XLEV_CV)
+ NULLIFY(DE%XLES_CV)
+ NULLIFY(DE%XLETR_CV)
+ NULLIFY(DE%XLER_CV)
+ NULLIFY(DE%XLE_CV)
+ NULLIFY(DE%XH_CV)
+ NULLIFY(DE%XMELT_CV)
+ NULLIFY(DE%XFRZ_CV)
+ NULLIFY(DE%XLETR_GV)
+ NULLIFY(DE%XLER_GV)
+ NULLIFY(DE%XLE_GV)
+ NULLIFY(DE%XH_GV)
+ NULLIFY(DE%XLE_GN)
+ NULLIFY(DE%XEVAP_GN)
+ NULLIFY(DE%XH_GN)
+ NULLIFY(DE%XSR_GN)
+ NULLIFY(DE%XSWDOWN_GN)
+ NULLIFY(DE%XLWDOWN_GN)
-SUBROUTINE DIAG_EVAP_ISBA_INIT(YDIAG_EVAP_ISBA)
-TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: YDIAG_EVAP_ISBA
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_EVAP_ISBA_N:DIAG_EVAP_ISBA_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YDIAG_EVAP_ISBA%XLEG)
- NULLIFY(YDIAG_EVAP_ISBA%XLEGI)
- NULLIFY(YDIAG_EVAP_ISBA%XLEV)
- NULLIFY(YDIAG_EVAP_ISBA%XLES)
- NULLIFY(YDIAG_EVAP_ISBA%XLESL)
- NULLIFY(YDIAG_EVAP_ISBA%XLER)
- NULLIFY(YDIAG_EVAP_ISBA%XLETR)
- NULLIFY(YDIAG_EVAP_ISBA%XEVAP)
- NULLIFY(YDIAG_EVAP_ISBA%XSUBL)
- NULLIFY(YDIAG_EVAP_ISBA%XSNDRIFT)
- NULLIFY(YDIAG_EVAP_ISBA%XDRAIN)
- NULLIFY(YDIAG_EVAP_ISBA%XQSB)
- NULLIFY(YDIAG_EVAP_ISBA%XRUNOFF)
- NULLIFY(YDIAG_EVAP_ISBA%XHORT)
- NULLIFY(YDIAG_EVAP_ISBA%XRRVEG)
- NULLIFY(YDIAG_EVAP_ISBA%XMELT)
- NULLIFY(YDIAG_EVAP_ISBA%XIFLOOD)
- NULLIFY(YDIAG_EVAP_ISBA%XPFLOOD)
- NULLIFY(YDIAG_EVAP_ISBA%XLE_FLOOD)
- NULLIFY(YDIAG_EVAP_ISBA%XLEI_FLOOD)
-!
- NULLIFY(YDIAG_EVAP_ISBA%XLEVCV)
- NULLIFY(YDIAG_EVAP_ISBA%XLESC)
- NULLIFY(YDIAG_EVAP_ISBA%XLETRGV)
- NULLIFY(YDIAG_EVAP_ISBA%XLETRCV)
- NULLIFY(YDIAG_EVAP_ISBA%XLERGV)
- NULLIFY(YDIAG_EVAP_ISBA%XLELITTER)
- NULLIFY(YDIAG_EVAP_ISBA%XLELITTERI)
- NULLIFY(YDIAG_EVAP_ISBA%XDRIPLIT)
- NULLIFY(YDIAG_EVAP_ISBA%XRRLIT)
- NULLIFY(YDIAG_EVAP_ISBA%XLERCV)
- NULLIFY(YDIAG_EVAP_ISBA%XLE_V_C)
- NULLIFY(YDIAG_EVAP_ISBA%XLE_G_C)
- NULLIFY(YDIAG_EVAP_ISBA%XLE_C_A)
- NULLIFY(YDIAG_EVAP_ISBA%XLE_N_C)
-!
- NULLIFY(YDIAG_EVAP_ISBA%XSWNET_V)
- NULLIFY(YDIAG_EVAP_ISBA%XSWNET_G)
- NULLIFY(YDIAG_EVAP_ISBA%XSWNET_N)
- NULLIFY(YDIAG_EVAP_ISBA%XSWNET_NS)
- NULLIFY(YDIAG_EVAP_ISBA%XLWNET_V)
- NULLIFY(YDIAG_EVAP_ISBA%XLWNET_G)
- NULLIFY(YDIAG_EVAP_ISBA%XLWNET_N)
- NULLIFY(YDIAG_EVAP_ISBA%XSWDOWN_GN)
- NULLIFY(YDIAG_EVAP_ISBA%XLWDOWN_GN)
- NULLIFY(YDIAG_EVAP_ISBA%XH_V_C)
- NULLIFY(YDIAG_EVAP_ISBA%XH_G_C)
- NULLIFY(YDIAG_EVAP_ISBA%XH_C_A)
- NULLIFY(YDIAG_EVAP_ISBA%XH_N_C)
- NULLIFY(YDIAG_EVAP_ISBA%XSR_GN)
- NULLIFY(YDIAG_EVAP_ISBA%XMELTCV)
- NULLIFY(YDIAG_EVAP_ISBA%XFRZCV)
-!
- NULLIFY(YDIAG_EVAP_ISBA%XDRIP)
- NULLIFY(YDIAG_EVAP_ISBA%XIRRIG_FLUX)
- NULLIFY(YDIAG_EVAP_ISBA%XGPP)
- NULLIFY(YDIAG_EVAP_ISBA%XRESP_AUTO)
- NULLIFY(YDIAG_EVAP_ISBA%XRESP_ECO)
- NULLIFY(YDIAG_EVAP_ISBA%XDWG)
- NULLIFY(YDIAG_EVAP_ISBA%XDWGI)
- NULLIFY(YDIAG_EVAP_ISBA%XDWR)
- NULLIFY(YDIAG_EVAP_ISBA%XDSWE)
- NULLIFY(YDIAG_EVAP_ISBA%XWATBUD)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LEG)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LEGI)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LEV)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LES)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LESL)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LER)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LETR)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_EVAP)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_SUBL)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_SNDRIFT)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_DRAIN)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_QSB)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_RUNOFF)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_HORT)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_DRIP)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_MELT)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_IFLOOD)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_PFLOOD)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LE_FLOOD)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LEI_FLOOD)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_RRVEG)
-!
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LEVCV)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LESC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LETRGV)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LETRCV)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LERGV)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LELITTER)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LELITTERI)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_DRIPLIT)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_RRLIT)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LERCV)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LE_V_C)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LE_G_C)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LE_C_A)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LE_N_C)
-!
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_SWNET_V)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_SWNET_G)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_SWNET_N)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_SWNET_NS)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LWNET_V)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LWNET_G)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LWNET_N)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_SWDOWN_GN)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LWDOWN_GN)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_H_V_C)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_H_G_C)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_H_C_A)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_H_N_C)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_SR_GN)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_MELTCV)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_FRZCV)
-!
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_IRRIG_FLUX)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_GPP)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_RESP_AUTO)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_RESP_ECO)
- NULLIFY(YDIAG_EVAP_ISBA%XRAINFALL)
- NULLIFY(YDIAG_EVAP_ISBA%XSNOWFALL)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_DWG)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_DWGI)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_DWR)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_DSWE)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_WATBUD)
- NULLIFY(YDIAG_EVAP_ISBA%XRNC)
- NULLIFY(YDIAG_EVAP_ISBA%XHC)
- NULLIFY(YDIAG_EVAP_ISBA%XLEC)
- NULLIFY(YDIAG_EVAP_ISBA%XLEIC)
- NULLIFY(YDIAG_EVAP_ISBA%XGFLUXC)
- NULLIFY(YDIAG_EVAP_ISBA%XLEGC)
- NULLIFY(YDIAG_EVAP_ISBA%XLEGIC)
- NULLIFY(YDIAG_EVAP_ISBA%XLEVC)
- NULLIFY(YDIAG_EVAP_ISBA%XLESAC)
- NULLIFY(YDIAG_EVAP_ISBA%XLESLC)
- NULLIFY(YDIAG_EVAP_ISBA%XLERC)
- NULLIFY(YDIAG_EVAP_ISBA%XLETRC)
- NULLIFY(YDIAG_EVAP_ISBA%XEVAPC)
- NULLIFY(YDIAG_EVAP_ISBA%XSUBLC)
- NULLIFY(YDIAG_EVAP_ISBA%XSNDRIFTC)
- NULLIFY(YDIAG_EVAP_ISBA%XDRAINC)
- NULLIFY(YDIAG_EVAP_ISBA%XQSBC)
- NULLIFY(YDIAG_EVAP_ISBA%XRUNOFFC)
- NULLIFY(YDIAG_EVAP_ISBA%XHORTC)
- NULLIFY(YDIAG_EVAP_ISBA%XDRIPC)
- NULLIFY(YDIAG_EVAP_ISBA%XMELTC)
- NULLIFY(YDIAG_EVAP_ISBA%XIFLOODC)
- NULLIFY(YDIAG_EVAP_ISBA%XPFLOODC)
- NULLIFY(YDIAG_EVAP_ISBA%XLE_FLOODC)
- NULLIFY(YDIAG_EVAP_ISBA%XLEI_FLOODC)
- NULLIFY(YDIAG_EVAP_ISBA%XICEFLUXC)
- NULLIFY(YDIAG_EVAP_ISBA%XRRVEGC)
-!
- NULLIFY(YDIAG_EVAP_ISBA%XLEVCVC)
- NULLIFY(YDIAG_EVAP_ISBA%XLESCC)
- NULLIFY(YDIAG_EVAP_ISBA%XLETRGVC)
- NULLIFY(YDIAG_EVAP_ISBA%XLETRCVC)
- NULLIFY(YDIAG_EVAP_ISBA%XLERGVC)
- NULLIFY(YDIAG_EVAP_ISBA%XLERCVC)
- NULLIFY(YDIAG_EVAP_ISBA%XLE_V_CC)
- NULLIFY(YDIAG_EVAP_ISBA%XLE_G_CC)
- NULLIFY(YDIAG_EVAP_ISBA%XLE_C_AC)
- NULLIFY(YDIAG_EVAP_ISBA%XLE_N_CC)
-!
- NULLIFY(YDIAG_EVAP_ISBA%XSWNET_VC)
- NULLIFY(YDIAG_EVAP_ISBA%XSWNET_GC)
- NULLIFY(YDIAG_EVAP_ISBA%XSWNET_NC)
- NULLIFY(YDIAG_EVAP_ISBA%XSWNET_NSC)
- NULLIFY(YDIAG_EVAP_ISBA%XLWNET_VC)
- NULLIFY(YDIAG_EVAP_ISBA%XLWNET_GC)
- NULLIFY(YDIAG_EVAP_ISBA%XLWNET_NC)
- NULLIFY(YDIAG_EVAP_ISBA%XSWDOWN_GNC)
- NULLIFY(YDIAG_EVAP_ISBA%XLWDOWN_GNC)
- NULLIFY(YDIAG_EVAP_ISBA%XH_V_CC)
- NULLIFY(YDIAG_EVAP_ISBA%XH_G_CC)
- NULLIFY(YDIAG_EVAP_ISBA%XH_C_AC)
- NULLIFY(YDIAG_EVAP_ISBA%XH_N_CC)
- NULLIFY(YDIAG_EVAP_ISBA%XSR_GNC)
- NULLIFY(YDIAG_EVAP_ISBA%XMELTCVC)
- NULLIFY(YDIAG_EVAP_ISBA%XFRZCVC)
-!
- NULLIFY(YDIAG_EVAP_ISBA%XIRRIG_FLUXC)
- NULLIFY(YDIAG_EVAP_ISBA%XGPPC)
- NULLIFY(YDIAG_EVAP_ISBA%XRESPC_AUTO)
- NULLIFY(YDIAG_EVAP_ISBA%XRESPC_ECO)
- NULLIFY(YDIAG_EVAP_ISBA%XDWGC)
- NULLIFY(YDIAG_EVAP_ISBA%XDWGIC)
- NULLIFY(YDIAG_EVAP_ISBA%XDWRC)
- NULLIFY(YDIAG_EVAP_ISBA%XDSWEC)
- NULLIFY(YDIAG_EVAP_ISBA%XWATBUDC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_RNC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_HC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LEC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LEIC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_GFLUXC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LEGC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LEGIC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LEVC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LESAC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LESLC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LERC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LETRC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_EVAPC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_SUBLC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_SNDRIFTC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_DRAINC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_QSBC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_RUNOFFC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_HORTC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_DRIPC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_MELTC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_IFLOODC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_PFLOODC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LE_FLOODC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LEI_FLOODC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_ICEFLUXC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_RRVEGC)
-!
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LEVCVC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LESCC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LETRGVC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LETRCVC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LERGVC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LERCVC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LE_V_CC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LE_G_CC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LE_C_AC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LE_N_CC)
-!
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_SWNET_VC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_SWNET_GC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_SWNET_NC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_SWNET_NSC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LWNET_VC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LWNET_GC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LWNET_NC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_SWDOWN_GNC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_LWDOWN_GNC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_H_V_CC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_H_G_CC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_H_C_AC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_H_N_CC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_SR_GNC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_MELTCVC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_FRZCVC)
-!
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_IRRIG_FLUXC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_GPPC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_RESPC_AUTO)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_RESPC_ECO)
- NULLIFY(YDIAG_EVAP_ISBA%XRAINFALLC)
- NULLIFY(YDIAG_EVAP_ISBA%XSNOWFALLC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_DWGC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_DWGIC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_DWRC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_DSWEC)
- NULLIFY(YDIAG_EVAP_ISBA%XAVG_WATBUDC)
-YDIAG_EVAP_ISBA%LSURF_EVAP_BUDGET=.FALSE.
-YDIAG_EVAP_ISBA%LSURF_BUDGETC=.FALSE.
-YDIAG_EVAP_ISBA%LRESET_BUDGETC=.FALSE.
-YDIAG_EVAP_ISBA%LWATER_BUDGET=.FALSE.
+ NULLIFY(DE%XEVAP_G)
+ NULLIFY(DE%XLE_CA)
+ NULLIFY(DE%XH_CA)
+
+ NULLIFY(DE%XSWUP)
+ NULLIFY(DE%XLWUP)
+
+ NULLIFY(DE%XSWNET_V)
+ NULLIFY(DE%XSWNET_G)
+ NULLIFY(DE%XSWNET_N)
+ NULLIFY(DE%XSWNET_NS)
+ NULLIFY(DE%XLWNET_V)
+ NULLIFY(DE%XLWNET_G)
+ NULLIFY(DE%XLWNET_N)
+!
+ NULLIFY(DE%XDRIP)
+ NULLIFY(DE%XIRRIG_FLUX)
+ NULLIFY(DE%XGPP)
+ NULLIFY(DE%XRESP_AUTO)
+ NULLIFY(DE%XRESP_ECO)
+ NULLIFY(DE%XDWG)
+ NULLIFY(DE%XDWGI)
+ NULLIFY(DE%XDWR)
+ NULLIFY(DE%XDSWE)
+ NULLIFY(DE%XWATBUD)
+!
+ NULLIFY(DE%XRAINFALL)
+ NULLIFY(DE%XSNOWFALL)
+!
+ NULLIFY(DE%XRN_SN_FR)
+ NULLIFY(DE%XH_SN_FR)
+ NULLIFY(DE%XLEI_SN_FR)
+ NULLIFY(DE%XLE_SN_FR)
+ NULLIFY(DE%XGFLUX_SN_FR)
+ NULLIFY(DE%XLEG_SN_FR)
+ NULLIFY(DE%XLEGI_SN_FR)
+ NULLIFY(DE%XLEV_SN_FR)
+ NULLIFY(DE%XLETR_SN_FR)
+ NULLIFY(DE%XUSTAR_SN_FR)
+ NULLIFY(DE%XLER_SN_FR)
+
+DE%LSURF_EVAP_BUDGET=.FALSE.
+DE%LWATER_BUDGET=.FALSE.
IF (LHOOK) CALL DR_HOOK("MODD_DIAG_EVAP_ISBA_N:DIAG_EVAP_ISBA_INIT",1,ZHOOK_HANDLE)
END SUBROUTINE DIAG_EVAP_ISBA_INIT
-
-
+!
END MODULE MODD_DIAG_EVAP_ISBA_n
diff --git a/src/SURFEX/modd_diag_flaken.F90 b/src/SURFEX/modd_diag_flaken.F90
deleted file mode 100644
index 8434134fd2b4cbd482d5a48dfa7a012661cc416c..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_diag_flaken.F90
+++ /dev/null
@@ -1,192 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ######################
-MODULE MODD_DIAG_FLAKE_n
-! ######################
-!
-!!**** *MODD_DIAG_FLAKE - declaration of diagnostics for FLake model
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! Modified 01/2006 : sea flux parameterization.
-!! V.Masson 10/2013 Adds min and max 2m parameters
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE DIAG_FLAKE_t
-!------------------------------------------------------------------------------
-!
- REAL :: XDIAG_TSTEP ! time step for diagnostics writing
-!
- INTEGER :: N2M ! flag for 2 meters (and 10 meters) quantities
- LOGICAL :: L2M_MIN_ZS ! flag for 2 meters quantities evaluated on
-! ! the minimum orographyy of the grid
- LOGICAL :: LSURF_BUDGET ! flag for surface energy budget
- LOGICAL :: LRAD_BUDGET ! flag for radiative energy budget
- LOGICAL :: LCOEF ! flag for transfer coefficients
- LOGICAL :: LSURF_VARS ! flag for surface variables
- LOGICAL :: LSURF_BUDGETC ! flag for surface cumulated energy budget
- LOGICAL :: LRESET_BUDGETC ! flag for surface cumulated energy budget
-!
-!* averaged variables
-!
- REAL, POINTER, DIMENSION(:) :: XRI ! Bulk-Richardson number (-)
- REAL, POINTER, DIMENSION(:) :: XCD ! drag coefficient for wind (W/s2)
- REAL, POINTER, DIMENSION(:) :: XCH ! drag coefficient for heat (W/s)
- REAL, POINTER, DIMENSION(:) :: XCE ! drag coefficient for vapor (W/s/K)
- REAL, POINTER, DIMENSION(:) :: XZ0 ! roughness length for momentum (m)
- REAL, POINTER, DIMENSION(:) :: XZ0H ! roughness length for heat (m)
- REAL, POINTER, DIMENSION(:) :: XRN ! net radiation at surface (W/m2)
- REAL, POINTER, DIMENSION(:) :: XH ! sensible heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLE ! total latent heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLEI ! sublimation latent heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XGFLUX ! net soil-vegetation flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XEVAP ! total evaporation (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XSUBL ! sublimation (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XT2M ! air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XT2M_MIN ! Minimum air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XT2M_MAX ! Maximum air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XQ2M ! air humidity at 2 meters (kg/kg)
- REAL, POINTER, DIMENSION(:) :: XHU2M ! air relative humidity at 2 meters(-)
- REAL, POINTER, DIMENSION(:) :: XHU2M_MIN! Minimum relative humidity at 2 meters (-)
- REAL, POINTER, DIMENSION(:) :: XHU2M_MAX! Maximum relative humidity at 2 meters (-)
- REAL, POINTER, DIMENSION(:) :: XQS ! air humidity at surface (kg/kg)
- REAL, POINTER, DIMENSION(:) :: XZON10M ! zonal wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XMER10M ! meridian wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XWIND10M ! wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XWIND10M_MAX! Maximum wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XLWD ! downward long wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLWU ! upward long wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XSWD ! downward short wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XSWU ! upward short wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSWBD ! downward short wave radiation by spectral band (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSWBU ! upward short wave radiation by spectral band (W/m2)
- REAL, POINTER, DIMENSION(:) :: XFMU ! horizontal momentum flux zonal (kg/ms2)
- REAL, POINTER, DIMENSION(:) :: XFMV ! horizontal momentum flux meridian (kg/ms2)
- REAL, POINTER, DIMENSION(:) :: XDIAG_TS ! water surface temperature (K)
- REAL, POINTER, DIMENSION(:) :: XALBT ! Total Albedo
- REAL, POINTER, DIMENSION(:) :: XSWE ! snow water equivalent (kg/m2)
-!
-!* cumulated averaged variables
-!
- REAL, POINTER, DIMENSION(:) :: XRNC ! net radiation at surface (J/m2)
- REAL, POINTER, DIMENSION(:) :: XHC ! sensible heat flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XLEC ! total latent heat flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XLEIC ! sublimation latent heat flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XGFLUXC ! net soil-vegetation flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XEVAPC ! total evaporation (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XSUBLC ! sublimation (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XLWDC ! downward long wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XLWUC ! upward long wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XSWDC ! downward short wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XSWUC ! upward short wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XFMUC ! horizontal momentum flux zonal (kg/ms)
- REAL, POINTER, DIMENSION(:) :: XFMVC ! horizontal momentum flux meridian (kg/ms)
-!
-!------------------------------------------------------------------------------
-!
-
-END TYPE DIAG_FLAKE_t
-
-
-
- CONTAINS
-
-!
-
-
-
-
-SUBROUTINE DIAG_FLAKE_INIT(YDIAG_FLAKE)
-TYPE(DIAG_FLAKE_t), INTENT(INOUT) :: YDIAG_FLAKE
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_FLAKE_N:DIAG_FLAKE_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YDIAG_FLAKE%XRI)
- NULLIFY(YDIAG_FLAKE%XCD)
- NULLIFY(YDIAG_FLAKE%XCH)
- NULLIFY(YDIAG_FLAKE%XCE)
- NULLIFY(YDIAG_FLAKE%XZ0)
- NULLIFY(YDIAG_FLAKE%XZ0H)
- NULLIFY(YDIAG_FLAKE%XRN)
- NULLIFY(YDIAG_FLAKE%XH)
- NULLIFY(YDIAG_FLAKE%XLE)
- NULLIFY(YDIAG_FLAKE%XLEI)
- NULLIFY(YDIAG_FLAKE%XGFLUX)
- NULLIFY(YDIAG_FLAKE%XEVAP)
- NULLIFY(YDIAG_FLAKE%XSUBL)
- NULLIFY(YDIAG_FLAKE%XT2M)
- NULLIFY(YDIAG_FLAKE%XT2M_MIN)
- NULLIFY(YDIAG_FLAKE%XT2M_MAX)
- NULLIFY(YDIAG_FLAKE%XQ2M)
- NULLIFY(YDIAG_FLAKE%XHU2M)
- NULLIFY(YDIAG_FLAKE%XHU2M_MIN)
- NULLIFY(YDIAG_FLAKE%XHU2M_MAX)
- NULLIFY(YDIAG_FLAKE%XQS)
- NULLIFY(YDIAG_FLAKE%XZON10M)
- NULLIFY(YDIAG_FLAKE%XMER10M)
- NULLIFY(YDIAG_FLAKE%XWIND10M)
- NULLIFY(YDIAG_FLAKE%XWIND10M_MAX)
- NULLIFY(YDIAG_FLAKE%XLWD)
- NULLIFY(YDIAG_FLAKE%XLWU)
- NULLIFY(YDIAG_FLAKE%XSWD)
- NULLIFY(YDIAG_FLAKE%XSWU)
- NULLIFY(YDIAG_FLAKE%XSWBD)
- NULLIFY(YDIAG_FLAKE%XSWBU)
- NULLIFY(YDIAG_FLAKE%XFMU)
- NULLIFY(YDIAG_FLAKE%XFMV)
- NULLIFY(YDIAG_FLAKE%XDIAG_TS)
- NULLIFY(YDIAG_FLAKE%XALBT)
- NULLIFY(YDIAG_FLAKE%XSWE)
- NULLIFY(YDIAG_FLAKE%XRNC)
- NULLIFY(YDIAG_FLAKE%XHC)
- NULLIFY(YDIAG_FLAKE%XLEC)
- NULLIFY(YDIAG_FLAKE%XLEIC)
- NULLIFY(YDIAG_FLAKE%XGFLUXC)
- NULLIFY(YDIAG_FLAKE%XEVAPC)
- NULLIFY(YDIAG_FLAKE%XSUBLC)
- NULLIFY(YDIAG_FLAKE%XLWDC)
- NULLIFY(YDIAG_FLAKE%XLWUC)
- NULLIFY(YDIAG_FLAKE%XSWDC)
- NULLIFY(YDIAG_FLAKE%XSWUC)
- NULLIFY(YDIAG_FLAKE%XFMUC)
- NULLIFY(YDIAG_FLAKE%XFMVC)
-YDIAG_FLAKE%XDIAG_TSTEP=0.
-YDIAG_FLAKE%N2M=0
-YDIAG_FLAKE%L2M_MIN_ZS=.FALSE.
-YDIAG_FLAKE%LSURF_BUDGET=.FALSE.
-YDIAG_FLAKE%LRAD_BUDGET=.FALSE.
-YDIAG_FLAKE%LCOEF=.FALSE.
-YDIAG_FLAKE%LSURF_VARS=.FALSE.
-YDIAG_FLAKE%LSURF_BUDGETC=.FALSE.
-YDIAG_FLAKE%LRESET_BUDGETC=.FALSE.
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_FLAKE_N:DIAG_FLAKE_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE DIAG_FLAKE_INIT
-
-
-END MODULE MODD_DIAG_FLAKE_n
diff --git a/src/SURFEX/modd_diag_idealn.F90 b/src/SURFEX/modd_diag_idealn.F90
deleted file mode 100644
index dcb93460f0aa0ef4e667ebcafd6d7b6350ddfbec..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_diag_idealn.F90
+++ /dev/null
@@ -1,191 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ######################
- MODULE MODD_DIAG_IDEAL_n
-! ######################
-!
-!!**** *MODD_DIAG_IDEAL - declaration of diagnostics for IDEAL scheme
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! P. Le Moigne *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 04/2009
-!! P. Le Moigne 03/2015: add diagnostics IDEAL case
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE DIAG_IDEAL_t
-!------------------------------------------------------------------------------
-!
- REAL :: XDIAG_TSTEP ! time step for diagnostics writing
-!
- INTEGER :: N2M ! flag for 2 meters (and 10 meters) quantities
- LOGICAL :: L2M_MIN_ZS ! flag for 2 meters quantities evaluated on
-! ! the minimum orographyy of the grid
- LOGICAL :: LSURF_BUDGET ! flag for surface energy budget
- LOGICAL :: LRAD_BUDGET ! flag for radiative energy budget
- LOGICAL :: LCOEF ! flag for transfer coefficients
- LOGICAL :: LSURF_VARS ! flag for surface variables
- LOGICAL :: LSURF_BUDGETC ! flag for surface cumulated energy budget
- LOGICAL :: LRESET_BUDGETC ! flag for surface cumulated energy budget
-
-!* averaged variables
-!
- REAL, POINTER, DIMENSION(:) :: XRI ! Bulk-Richardson number (-)
- REAL, POINTER, DIMENSION(:) :: XCD ! drag coefficient for wind (W/s2)
- REAL, POINTER, DIMENSION(:) :: XCH ! drag coefficient for heat (W/s)
- REAL, POINTER, DIMENSION(:) :: XCE ! drag coefficient for vapor (W/s/K)
- REAL, POINTER, DIMENSION(:) :: XZ0 ! roughness length for momentum (m)
- REAL, POINTER, DIMENSION(:) :: XZ0H ! roughness length for heat (m)
- REAL, POINTER, DIMENSION(:) :: XRN ! net radiation at surface (W/m2)
- REAL, POINTER, DIMENSION(:) :: XH ! sensible heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLE ! latent heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLEI ! sublimation latent heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XGFLUX ! net soil-vegetation flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XEVAP ! total evaporation (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XSUBL ! sublimation (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XT2M ! air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XT2M_MIN ! Minimum air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XT2M_MAX ! Maximum air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XQ2M ! air humidity at 2 meters (kg/kg)
- REAL, POINTER, DIMENSION(:) :: XHU2M ! relative humidity at 2 meters (-)
- REAL, POINTER, DIMENSION(:) :: XHU2M_MIN! Minimum relative humidity at 2 meters (-)
- REAL, POINTER, DIMENSION(:) :: XHU2M_MAX! Maximum relative humidity at 2 meters (-)
- REAL, POINTER, DIMENSION(:) :: XQS ! humidity at surface (kg/kg)
- REAL, POINTER, DIMENSION(:) :: XZON10M ! zonal wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XMER10M ! meridian wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XWIND10M ! wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XWIND10M_MAX! Maximum wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XLWD ! downward long wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLWU ! upward long wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XSWD ! downward short wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XSWU ! upward short wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSWBD ! downward short wave radiation by spectral band (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSWBU ! upward short wave radiation by spectral band (W/m2)
- REAL, POINTER, DIMENSION(:) :: XFMU ! horizontal momentum flux zonal (m2/s2)
- REAL, POINTER, DIMENSION(:) :: XFMV ! horizontal momentum flux meridian (m2/s2)
- REAL, POINTER, DIMENSION(:) :: XDIAG_TS ! water surface temperature (K)
- REAL, POINTER, DIMENSION(:) :: XALBT ! Total Albedo
- REAL, POINTER, DIMENSION(:) :: XSWE ! snow water equivalent (kg/m2)
-!
-!* cumulated averaged variables
-!
- REAL, POINTER, DIMENSION(:) :: XRNC ! net radiation at surface (J/m2)
- REAL, POINTER, DIMENSION(:) :: XHC ! sensible heat flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XLEC ! total latent heat flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XLEIC ! sublimation latent heat flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XGFLUXC ! net soil-vegetation flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XEVAPC ! total evaporation (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XSUBLC ! sublimation (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XLWDC ! downward long wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XLWUC ! upward long wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XSWDC ! downward short wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XSWUC ! upward short wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XFMUC ! horizontal momentum flux zonal (kg/ms)
- REAL, POINTER, DIMENSION(:) :: XFMVC ! horizontal momentum flux meridian (kg/ms)
-!
-!------------------------------------------------------------------------------
-!
-
-END TYPE DIAG_IDEAL_t
-
-
-
- CONTAINS
-
-!
-
-
-
-
-SUBROUTINE DIAG_IDEAL_INIT(YDIAG_IDEAL)
-TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: YDIAG_IDEAL
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_IDEAL_N:DIAG_IDEAL_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YDIAG_IDEAL%XRI)
- NULLIFY(YDIAG_IDEAL%XCD)
- NULLIFY(YDIAG_IDEAL%XCH)
- NULLIFY(YDIAG_IDEAL%XCE)
- NULLIFY(YDIAG_IDEAL%XZ0)
- NULLIFY(YDIAG_IDEAL%XZ0H)
- NULLIFY(YDIAG_IDEAL%XRN)
- NULLIFY(YDIAG_IDEAL%XH)
- NULLIFY(YDIAG_IDEAL%XLE)
- NULLIFY(YDIAG_IDEAL%XLEI)
- NULLIFY(YDIAG_IDEAL%XGFLUX)
- NULLIFY(YDIAG_IDEAL%XEVAP)
- NULLIFY(YDIAG_IDEAL%XSUBL)
- NULLIFY(YDIAG_IDEAL%XT2M)
- NULLIFY(YDIAG_IDEAL%XT2M_MIN)
- NULLIFY(YDIAG_IDEAL%XT2M_MAX)
- NULLIFY(YDIAG_IDEAL%XQ2M)
- NULLIFY(YDIAG_IDEAL%XHU2M)
- NULLIFY(YDIAG_IDEAL%XHU2M_MIN)
- NULLIFY(YDIAG_IDEAL%XHU2M_MAX)
- NULLIFY(YDIAG_IDEAL%XQS)
- NULLIFY(YDIAG_IDEAL%XZON10M)
- NULLIFY(YDIAG_IDEAL%XMER10M)
- NULLIFY(YDIAG_IDEAL%XWIND10M)
- NULLIFY(YDIAG_IDEAL%XWIND10M_MAX)
- NULLIFY(YDIAG_IDEAL%XLWD)
- NULLIFY(YDIAG_IDEAL%XLWU)
- NULLIFY(YDIAG_IDEAL%XSWD)
- NULLIFY(YDIAG_IDEAL%XSWU)
- NULLIFY(YDIAG_IDEAL%XSWBD)
- NULLIFY(YDIAG_IDEAL%XSWBU)
- NULLIFY(YDIAG_IDEAL%XFMU)
- NULLIFY(YDIAG_IDEAL%XFMV)
- NULLIFY(YDIAG_IDEAL%XDIAG_TS)
- NULLIFY(YDIAG_IDEAL%XALBT)
- NULLIFY(YDIAG_IDEAL%XSWE)
- NULLIFY(YDIAG_IDEAL%XRNC)
- NULLIFY(YDIAG_IDEAL%XHC)
- NULLIFY(YDIAG_IDEAL%XLEC)
- NULLIFY(YDIAG_IDEAL%XLEIC)
- NULLIFY(YDIAG_IDEAL%XGFLUXC)
- NULLIFY(YDIAG_IDEAL%XEVAPC)
- NULLIFY(YDIAG_IDEAL%XSUBLC)
- NULLIFY(YDIAG_IDEAL%XLWDC)
- NULLIFY(YDIAG_IDEAL%XLWUC)
- NULLIFY(YDIAG_IDEAL%XSWDC)
- NULLIFY(YDIAG_IDEAL%XSWUC)
- NULLIFY(YDIAG_IDEAL%XFMUC)
- NULLIFY(YDIAG_IDEAL%XFMVC)
-YDIAG_IDEAL%XDIAG_TSTEP=0.
-YDIAG_IDEAL%N2M=0
-YDIAG_IDEAL%L2M_MIN_ZS=.FALSE.
-YDIAG_IDEAL%LSURF_BUDGET=.FALSE.
-YDIAG_IDEAL%LRAD_BUDGET=.FALSE.
-YDIAG_IDEAL%LCOEF=.FALSE.
-YDIAG_IDEAL%LSURF_VARS=.FALSE.
-YDIAG_IDEAL%LSURF_BUDGETC=.FALSE.
-YDIAG_IDEAL%LRESET_BUDGETC=.FALSE.
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_IDEAL_N:DIAG_IDEAL_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE DIAG_IDEAL_INIT
-
-
-END MODULE MODD_DIAG_IDEAL_n
diff --git a/src/SURFEX/modd_diag_isban.F90 b/src/SURFEX/modd_diag_isban.F90
deleted file mode 100644
index dad04a96cda4fea0970593ec2ccef2890fc7d682..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_diag_isban.F90
+++ /dev/null
@@ -1,260 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-!######################
-MODULE MODD_DIAG_ISBA_n
-!######################
-!
-!!**** *MODD_DIAG_ISBA - declaration of diagnostics for ISBA scheme
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! Modified 01/2006 : sea flux parameterization.
-!! P. Samuelsson 10/2014 : added min max for XT2M
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE DIAG_ISBA_t
-!------------------------------------------------------------------------------
-!
- REAL :: XDIAG_TSTEP ! time step for diagnostics writing
-!
- INTEGER :: N2M ! flag for 2 meters (and 10 meters) quantities
- LOGICAL :: L2M_MIN_ZS ! flag for 2 meters quantities evaluated on
-! ! the minimum orographyy of the grid
- LOGICAL :: LSURF_BUDGET ! flag for surface energy budget
- LOGICAL :: LRAD_BUDGET ! flag for radiative energy budget
-!
- LOGICAL :: LCOEF ! flag for transfer coefficients
- LOGICAL :: LSURF_VARS ! flag for surface variables
-!
- LOGICAL :: LPGD ! flag for writing of PGD files
- LOGICAL :: LPATCH_BUDGET ! flag for patch output
-!
-!* variables for each patch
-!
- REAL, POINTER, DIMENSION(:,:) :: XRI ! Bulk-Richardson number (-)
- REAL, POINTER, DIMENSION(:,:) :: XCD ! drag coefficient for wind (W/s2)
- REAL, POINTER, DIMENSION(:,:) :: XCH ! drag coefficient for heat (W/s)
- REAL, POINTER, DIMENSION(:,:) :: XCE ! drag coefficient for vapor (W/s/K)
- REAL, POINTER, DIMENSION(:,:) :: XRN ! net radiation at surface (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XH ! sensible heat flux (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLE ! total latent heat flux (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLEI ! sublimation latent heat flux (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XGFLUX ! net soil-vegetation flux (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XTS ! surface temperature (K)
- REAL, POINTER, DIMENSION(:,:) :: XTSRAD ! surface radiative temperature (K)
- REAL, POINTER, DIMENSION(:,:) :: XT2M ! temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:,:) :: XT2M_MIN! min temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:,:) :: XT2M_MAX! max temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:,:) :: XQ2M ! humidity at 2 meters (kg/kg)
- REAL, POINTER, DIMENSION(:,:) :: XHU2M ! relative humidity at 2 meters (-)
- REAL, POINTER, DIMENSION(:,:) :: XQS ! humidity at surface (kg/kg)
- REAL, POINTER, DIMENSION(:,:) :: XZON10M ! zonal wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:,:) :: XMER10M ! meridian wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:,:) :: XWIND10M! wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:,:) :: XLWD ! downward long wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLWU ! upward long wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSWD ! downward short wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSWU ! upward short wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:,:,:) :: XSWBD ! downward short wave radiation by spectral band (W/m2)
- REAL, POINTER, DIMENSION(:,:,:) :: XSWBU ! upward short wave radiation by spectral band (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XFMU ! horizontal momentum flux zonal (Pa)
- REAL, POINTER, DIMENSION(:,:) :: XFMV ! horizontal momentum flux meridian (Pa)
- !
- REAL, POINTER, DIMENSION(:,:) :: XSWDC ! downward short wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSWUC ! upward short wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLWDC ! downward long wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLWUC ! upward long wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XFMUC ! horizontal momentum flux zonal (Pa.s)
- REAL, POINTER, DIMENSION(:,:) :: XFMVC ! horizontal momentum flux meridian (Pa.s)
- !
- REAL, POINTER, DIMENSION(:,:) :: XZ0_WITH_SNOW ! roughness length for momentum
- ! for vegetation and snow (m)
- REAL, POINTER, DIMENSION(:,:) :: XZ0H_WITH_SNOW ! roughness length for heat
- ! for vegetation and snow (m)
- REAL, POINTER, DIMENSION(:,:) :: XZ0EFF ! effective roughness length for heat
- ! for vegetation and snow (m)
-!
-!* averaged variables
-!
- REAL, POINTER, DIMENSION(:) :: XAVG_RI ! Bulk-Richardson number (-)
- REAL, POINTER, DIMENSION(:) :: XAVG_CD ! drag coefficient for wind (W/s2)
- REAL, POINTER, DIMENSION(:) :: XAVG_CH ! drag coefficient for heat (W/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_CE ! drag coefficient for vapor (W/s/K)
- REAL, POINTER, DIMENSION(:) :: XAVG_RN ! net radiation at surface (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_H ! sensible heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LE ! total latent heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LEI ! sublimation latent heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_GFLUX ! net soil-vegetation flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_TS ! surface temperature (K)
- REAL, POINTER, DIMENSION(:) :: XAVG_T2M ! temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XAVG_T2M_MIN ! Minimum temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XAVG_T2M_MAX ! Maximum temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XAVG_Q2M ! humidity at 2 meters (kg/kg)
- REAL, POINTER, DIMENSION(:) :: XAVG_HU2M ! relative humidity at 2 meters (-)
- REAL, POINTER, DIMENSION(:) :: XAVG_HU2M_MIN ! Minimum relative humidity at 2 meters (-)
- REAL, POINTER, DIMENSION(:) :: XAVG_HU2M_MAX ! Maximum relative humidity at 2 meters (-)
- REAL, POINTER, DIMENSION(:) :: XAVG_QS ! humidity at surface (kg/kg)
- REAL, POINTER, DIMENSION(:) :: XAVG_ZON10M ! zonal wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_MER10M ! meridian wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_WIND10M ! wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_WIND10M_MAX ! Maximum wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_SFCO2 ! CO2 flux (m/s*kg_CO2/kg_air)
- REAL, POINTER, DIMENSION(:) :: XAVG_LWD ! downward long wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LWU ! upward long wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_SWD ! downward short wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_SWU ! upward short wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XAVG_SWBD ! downward short wave radiation by spectral band (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XAVG_SWBU ! upward short wave radiation by spectral band (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_FMU ! horizontal momentum flux zonal (m2/s2)
- REAL, POINTER, DIMENSION(:) :: XAVG_FMV ! horizontal momentum flux meridian (m2/s2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LWDC ! downward long wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LWUC ! upward long wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_SWDC ! downward short wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_SWUC ! upward short wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_FMUC ! horizontal momentum flux zonal (Pa.s)
- REAL, POINTER, DIMENSION(:) :: XAVG_FMVC ! horizontal momentum flux meridian (Pa.s)
-
- !
- REAL, POINTER, DIMENSION(:) :: XAVG_Z0 ! roughness length for momentum
- ! for vegetation and snow (m)
- REAL, POINTER, DIMENSION(:) :: XAVG_Z0H ! roughness length for heat
- ! for vegetation and snow (m)
- REAL, POINTER, DIMENSION(:) :: XAVG_Z0EFF ! effective roughness length for heat
- ! for vegetation and snow (m)
-!------------------------------------------------------------------------------
-!
-
-END TYPE DIAG_ISBA_t
-
-
-
- CONTAINS
-
-!
-
-
-
-
-
-SUBROUTINE DIAG_ISBA_INIT(YDIAG_ISBA)
-TYPE(DIAG_ISBA_t), INTENT(INOUT) :: YDIAG_ISBA
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_ISBA_N:DIAG_ISBA_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YDIAG_ISBA%XRI)
- NULLIFY(YDIAG_ISBA%XCD)
- NULLIFY(YDIAG_ISBA%XCH)
- NULLIFY(YDIAG_ISBA%XCE)
- NULLIFY(YDIAG_ISBA%XRN)
- NULLIFY(YDIAG_ISBA%XH)
- NULLIFY(YDIAG_ISBA%XLE)
- NULLIFY(YDIAG_ISBA%XLEI)
- NULLIFY(YDIAG_ISBA%XGFLUX)
- NULLIFY(YDIAG_ISBA%XTS)
- NULLIFY(YDIAG_ISBA%XTSRAD)
- NULLIFY(YDIAG_ISBA%XT2M)
- NULLIFY(YDIAG_ISBA%XT2M_MIN)
- NULLIFY(YDIAG_ISBA%XT2M_MAX)
- NULLIFY(YDIAG_ISBA%XQ2M)
- NULLIFY(YDIAG_ISBA%XHU2M)
- NULLIFY(YDIAG_ISBA%XQS)
- NULLIFY(YDIAG_ISBA%XZON10M)
- NULLIFY(YDIAG_ISBA%XMER10M)
- NULLIFY(YDIAG_ISBA%XWIND10M)
- NULLIFY(YDIAG_ISBA%XLWD)
- NULLIFY(YDIAG_ISBA%XLWU)
- NULLIFY(YDIAG_ISBA%XSWD)
- NULLIFY(YDIAG_ISBA%XSWU)
- NULLIFY(YDIAG_ISBA%XSWBD)
- NULLIFY(YDIAG_ISBA%XSWBU)
- NULLIFY(YDIAG_ISBA%XFMU)
- NULLIFY(YDIAG_ISBA%XFMV)
- NULLIFY(YDIAG_ISBA%XSWDC)
- NULLIFY(YDIAG_ISBA%XSWUC)
- NULLIFY(YDIAG_ISBA%XLWDC)
- NULLIFY(YDIAG_ISBA%XLWUC)
- NULLIFY(YDIAG_ISBA%XFMUC)
- NULLIFY(YDIAG_ISBA%XFMVC)
- NULLIFY(YDIAG_ISBA%XZ0_WITH_SNOW)
- NULLIFY(YDIAG_ISBA%XZ0H_WITH_SNOW)
- NULLIFY(YDIAG_ISBA%XZ0EFF)
- NULLIFY(YDIAG_ISBA%XAVG_RI)
- NULLIFY(YDIAG_ISBA%XAVG_CD)
- NULLIFY(YDIAG_ISBA%XAVG_CH)
- NULLIFY(YDIAG_ISBA%XAVG_CE)
- NULLIFY(YDIAG_ISBA%XAVG_RN)
- NULLIFY(YDIAG_ISBA%XAVG_H)
- NULLIFY(YDIAG_ISBA%XAVG_LE)
- NULLIFY(YDIAG_ISBA%XAVG_LEI)
- NULLIFY(YDIAG_ISBA%XAVG_GFLUX)
- NULLIFY(YDIAG_ISBA%XAVG_TS)
- NULLIFY(YDIAG_ISBA%XAVG_T2M)
- NULLIFY(YDIAG_ISBA%XAVG_T2M_MIN)
- NULLIFY(YDIAG_ISBA%XAVG_T2M_MAX)
- NULLIFY(YDIAG_ISBA%XAVG_Q2M)
- NULLIFY(YDIAG_ISBA%XAVG_HU2M)
- NULLIFY(YDIAG_ISBA%XAVG_HU2M_MIN)
- NULLIFY(YDIAG_ISBA%XAVG_HU2M_MAX)
- NULLIFY(YDIAG_ISBA%XAVG_QS)
- NULLIFY(YDIAG_ISBA%XAVG_ZON10M)
- NULLIFY(YDIAG_ISBA%XAVG_MER10M)
- NULLIFY(YDIAG_ISBA%XAVG_WIND10M)
- NULLIFY(YDIAG_ISBA%XAVG_WIND10M_MAX)
- NULLIFY(YDIAG_ISBA%XAVG_SFCO2)
- NULLIFY(YDIAG_ISBA%XAVG_LWD)
- NULLIFY(YDIAG_ISBA%XAVG_LWU)
- NULLIFY(YDIAG_ISBA%XAVG_SWD)
- NULLIFY(YDIAG_ISBA%XAVG_SWU)
- NULLIFY(YDIAG_ISBA%XAVG_SWBD)
- NULLIFY(YDIAG_ISBA%XAVG_SWBU)
- NULLIFY(YDIAG_ISBA%XAVG_FMU)
- NULLIFY(YDIAG_ISBA%XAVG_FMV)
- NULLIFY(YDIAG_ISBA%XAVG_LWDC)
- NULLIFY(YDIAG_ISBA%XAVG_LWUC)
- NULLIFY(YDIAG_ISBA%XAVG_SWDC)
- NULLIFY(YDIAG_ISBA%XAVG_SWUC)
- NULLIFY(YDIAG_ISBA%XAVG_FMUC)
- NULLIFY(YDIAG_ISBA%XAVG_FMVC)
- NULLIFY(YDIAG_ISBA%XAVG_Z0)
- NULLIFY(YDIAG_ISBA%XAVG_Z0H)
- NULLIFY(YDIAG_ISBA%XAVG_Z0EFF)
-YDIAG_ISBA%XDIAG_TSTEP=0.
-YDIAG_ISBA%N2M=0
-YDIAG_ISBA%L2M_MIN_ZS=.FALSE.
-YDIAG_ISBA%LSURF_BUDGET=.FALSE.
-YDIAG_ISBA%LRAD_BUDGET=.FALSE.
-YDIAG_ISBA%LCOEF=.FALSE.
-YDIAG_ISBA%LSURF_VARS=.FALSE.
-YDIAG_ISBA%LPGD=.FALSE.
-YDIAG_ISBA%LPATCH_BUDGET=.FALSE.
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_ISBA_N:DIAG_ISBA_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE DIAG_ISBA_INIT
-
-
-END MODULE MODD_DIAG_ISBA_n
diff --git a/src/SURFEX/modd_diag_misc_flaken.F90 b/src/SURFEX/modd_diag_misc_flaken.F90
index e2fafa2cbc19e438c75ac3eef890735c6862c0ed..676d9813a9e8df1be33636ebbf97ed31abe4decb 100644
--- a/src/SURFEX/modd_diag_misc_flaken.F90
+++ b/src/SURFEX/modd_diag_misc_flaken.F90
@@ -57,21 +57,21 @@ END TYPE DIAG_MISC_FLAKE_t
- CONTAINS
+CONTAINS
!
-SUBROUTINE DIAG_MISC_FLAKE_INIT(YDIAG_MISC_FLAKE)
-TYPE(DIAG_MISC_FLAKE_t), INTENT(INOUT) :: YDIAG_MISC_FLAKE
+SUBROUTINE DIAG_MISC_FLAKE_INIT(DMF)
+TYPE(DIAG_MISC_FLAKE_t), INTENT(INOUT) :: DMF
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK("MODD_DIAG_MISC_FLAKE_N:DIAG_MISC_FLAKE_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YDIAG_MISC_FLAKE%XZWAT_PROFILE)
- NULLIFY(YDIAG_MISC_FLAKE%XZW_PROFILE)
- NULLIFY(YDIAG_MISC_FLAKE%XTW_PROFILE)
-YDIAG_MISC_FLAKE%LWATER_PROFILE=.FALSE.
+ NULLIFY(DMF%XZWAT_PROFILE)
+ NULLIFY(DMF%XZW_PROFILE)
+ NULLIFY(DMF%XTW_PROFILE)
+DMF%LWATER_PROFILE=.FALSE.
IF (LHOOK) CALL DR_HOOK("MODD_DIAG_MISC_FLAKE_N:DIAG_MISC_FLAKE_INIT",1,ZHOOK_HANDLE)
END SUBROUTINE DIAG_MISC_FLAKE_INIT
diff --git a/src/SURFEX/modd_diag_misc_isban.F90 b/src/SURFEX/modd_diag_misc_isban.F90
index 76ca54bac2c97ff11f40e7bce053576a9996a923..0a4c8b272ca20a824f865251cf4876b3072ab3c6 100644
--- a/src/SURFEX/modd_diag_misc_isban.F90
+++ b/src/SURFEX/modd_diag_misc_isban.F90
@@ -37,7 +37,7 @@
!! B. Decharme 10/2012 : New diag for DIF
!! active layer thickness over permafrost area
!! frozen layer thickness over non-permafrost area
-!!
+!! M. Lafaysse 09/2015 : new Crocus-MEPRA outputs
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -56,77 +56,23 @@ TYPE DIAG_MISC_ISBA_t
LOGICAL :: LSURF_MISC_BUDGET ! flag for miscellaneous terms of isba scheme
LOGICAL :: LSURF_DIAG_ALBEDO ! flag to write out diagnostic albedo
LOGICAL :: LSURF_MISC_DIF ! flag for miscellaneous terms of isba-dif scheme
+ LOGICAL :: LPROSNOW ! flag for Crocus-MEPRA outputs
+ LOGICAL :: LVOLUMETRIC_SNOWLIQ ! volumetric snow liquid water content (kg m-3)
!
!* variables for each patch
!
- REAL, POINTER, DIMENSION(:,:) :: XHV ! Halstead coefficient
+ REAL, POINTER, DIMENSION(:) :: XHV ! Halstead coefficient
+ REAL, POINTER, DIMENSION(:) :: XLAI ! leaf average index
!
- REAL, POINTER, DIMENSION(:,:,:) :: XSWI ! Soil wetness index
- REAL, POINTER, DIMENSION(:,:,:) :: XTSWI ! Total soil wetness index
-!
- REAL, POINTER, DIMENSION(:,:) :: XALT ! Active layer thickness in permafrost area
- REAL, POINTER, DIMENSION(:,:) :: XFLT ! Frozen layer thickness in non-permmafrost area
-!
- REAL, POINTER, DIMENSION(:,:,:) :: XSNOWLIQ ! snow liquid water profile (ISBA-ES:3-L)
- REAL, POINTER, DIMENSION(:,:,:) :: XSNOWTEMP ! snow temperature profile (ISBA-ES:3-L)
-!
- REAL, POINTER, DIMENSION(:,:) :: XTWSNOW ! Total snow reservoir
- REAL, POINTER, DIMENSION(:,:) :: XTDSNOW ! Total snow height
- REAL, POINTER, DIMENSION(:,:) :: XTTSNOW ! Total snow temperature
-!
- REAL, POINTER, DIMENSION(:,:) :: XDPSNG ! Snow fraction over ground, diag at time t
- REAL, POINTER, DIMENSION(:,:) :: XDPSNV ! Snow fraction over vegetation, diag at time t
- REAL, POINTER, DIMENSION(:,:) :: XDPSN ! Total Snow fraction, diag at time t
- REAL, POINTER, DIMENSION(:,:) :: XALBT ! Total Albedo
-!
- REAL, POINTER, DIMENSION(:,:) :: XDFSAT ! Topmodel/dt92 saturated fraction
-!
- REAL, POINTER, DIMENSION(:,:) :: XDFFG ! Flood fraction over ground, diag at time t
- REAL, POINTER, DIMENSION(:,:) :: XDFFV ! Flood fraction over vegetation, diag at time t
- REAL, POINTER, DIMENSION(:,:) :: XDFF ! Total Flood fraction, diag at time t
-!
- REAL, POINTER, DIMENSION(:,:) :: XSEUIL ! Irrigation threshold
-!
- REAL, POINTER, DIMENSION(:,:) :: XFAPAR ! Fapar of vegetation
- REAL, POINTER, DIMENSION(:,:) :: XFAPIR ! Fapir of vegetation
- REAL, POINTER, DIMENSION(:,:) :: XDFAPARC ! Fapar of vegetation (cumul)
- REAL, POINTER, DIMENSION(:,:) :: XDFAPIRC ! Fapir of vegetation (cumul)
- REAL, POINTER, DIMENSION(:,:) :: XFAPAR_BS ! Fapar of bare soil
- REAL, POINTER, DIMENSION(:,:) :: XFAPIR_BS ! Fapir of bare soil
- REAL, POINTER, DIMENSION(:,:) :: XDLAI_EFFC ! Effective LAI (cumul)
-!
-!* average variables
-!
- REAL, POINTER, DIMENSION(:) :: XAVG_HV ! Halstead coefficient
- REAL, POINTER, DIMENSION(:) :: XAVG_LAI ! leaf average index
+ REAL, POINTER, DIMENSION(:,:) :: XSWI ! Soil wetness index
+ REAL, POINTER, DIMENSION(:,:) :: XTSWI ! Total soil wetness index
+ REAL, POINTER, DIMENSION(:) :: XSOIL_SWI ! Soil wetness index
+ REAL, POINTER, DIMENSION(:) :: XSOIL_TSWI ! Total Soil wetness index
+ REAL, POINTER, DIMENSION(:) :: XSOIL_TWG ! Soil water content (liquid+ice) (kg.m-2)
+ REAL, POINTER, DIMENSION(:) :: XSOIL_TWGI ! Soil ice content (kg.m-2)
+ REAL, POINTER, DIMENSION(:) :: XSOIL_WG ! Soil water content (liquid+ice) (m3.m-3)
+ REAL, POINTER, DIMENSION(:) :: XSOIL_WGI ! Soil ice content (m3.m-3)
!
- REAL, POINTER, DIMENSION(:,:) :: XAVG_SWI ! Liquid Soil wetness index by layer
- REAL, POINTER, DIMENSION(:,:) :: XAVG_TSWI ! Total soil wetness index by layer
- REAL, POINTER, DIMENSION(:) :: XSOIL_SWI ! Soil wetness index
- REAL, POINTER, DIMENSION(:) :: XSOIL_TSWI ! Total Soil wetness index
- REAL, POINTER, DIMENSION(:) :: XSOIL_TWG ! Soil water content (liquid+ice) (kg.m-2)
- REAL, POINTER, DIMENSION(:) :: XSOIL_TWGI ! Soil ice content (kg.m-2)
- REAL, POINTER, DIMENSION(:) :: XSOIL_WG ! Soil water content (liquid+ice) (m3.m-3)
- REAL, POINTER, DIMENSION(:) :: XSOIL_WGI ! Soil ice content (m3.m-3)
-!
- REAL, POINTER, DIMENSION(:) :: XAVG_ALT ! Active layer thickness in permafrost area
- REAL, POINTER, DIMENSION(:) :: XAVG_FLT ! Frozen layer thickness in non-permmafrost area
-!
- REAL, POINTER, DIMENSION(:) :: XAVG_TWSNOW ! Snow total reservoir
- REAL, POINTER, DIMENSION(:) :: XAVG_TDSNOW ! Snow total height
- REAL, POINTER, DIMENSION(:) :: XAVG_TTSNOW ! Snow total temperature
-!
- REAL, POINTER, DIMENSION(:) :: XAVG_PSNG ! Snow fraction over ground
- REAL, POINTER, DIMENSION(:) :: XAVG_PSNV ! Snow fraction over vegetation
- REAL, POINTER, DIMENSION(:) :: XAVG_PSN ! Total Snow fraction
- REAL, POINTER, DIMENSION(:) :: XAVG_ALBT ! Total Albedo
-!
- REAL, POINTER, DIMENSION(:) :: XAVG_FSAT ! Topmodel/dt92 saturated fraction
-!
- REAL, POINTER, DIMENSION(:) :: XAVG_FFG ! Flood fraction over ground
- REAL, POINTER, DIMENSION(:) :: XAVG_FFV ! Flood fraction over vegetation
- REAL, POINTER, DIMENSION(:) :: XAVG_FF ! Total Flood fraction
-!
REAL, POINTER, DIMENSION(:) :: XFRD2_TSWI ! ISBA-FR-DG2 comparable soil wetness index (DIF option)
REAL, POINTER, DIMENSION(:) :: XFRD2_TWG ! ISBA-FR-DG2 comparable soil water content (liquid+ice) (DIF option)
REAL, POINTER, DIMENSION(:) :: XFRD2_TWGI ! ISBA-FR-DG2 comparable soil ice content (DIF option)
@@ -134,82 +80,185 @@ TYPE DIAG_MISC_ISBA_t
REAL, POINTER, DIMENSION(:) :: XFRD3_TWG ! ISBA-FR-Deep comparable soil water content (liquid+ice) (DIF option)
REAL, POINTER, DIMENSION(:) :: XFRD3_TWGI ! ISBA-FR-Deep comparable soil ice content (DIF option)
!
-!------------------------------------------------------------------------------
+ REAL, POINTER, DIMENSION(:) :: XALT ! Active layer thickness in permafrost area
+ REAL, POINTER, DIMENSION(:) :: XFLT ! Frozen layer thickness in non-permmafrost area
!
+ REAL, POINTER, DIMENSION(:) :: XRNSNOW ! net radiative flux from snow (ISBA-ES:3-L) (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XHSNOW ! sensible heat flux from snow (ISBA-ES:3-L) (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XHPSNOW ! heat release from rainfall (ISBA-ES:3-L) (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XGFLUXSNOW ! net surface energy flux into snowpack
+! ! (ISBA-ES:3-L) (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XUSTARSNOW ! friction velocity over snow
+! ! (ISBA-ES:3-L) (m/s)
+ REAL, POINTER, DIMENSION(:) :: XGRNDFLUX ! soil/snow interface heat flux (ISBA-ES:3-L) (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XSRSFC ! snowfall over snowpack (ISBA-ES:3-L) (kg/m2/s)
+ REAL, POINTER, DIMENSION(:) :: XRRSFC ! rainfall over snowpack (ISBA-ES:3-L) (kg/m2/s)
+ REAL, POINTER, DIMENSION(:) :: XCDSNOW ! snow drag coefficient (ISBA-ES:3-L) (-)
+ REAL, POINTER, DIMENSION(:) :: XCHSNOW ! heat turbulent transfer coefficient
+! ! (ISBA-ES:3-L) (-)
+ REAL, POINTER, DIMENSION(:,:) :: XSNOWDZ ! snow layer thicknesses (m)
+ REAL, POINTER, DIMENSION(:,:) :: XSNOWDEND ! dendricity (Crocus)
+ REAL, POINTER, DIMENSION(:,:) :: XSNOWSPHER ! sphericity (Crocus)
+ REAL, POINTER, DIMENSION(:,:) :: XSNOWSIZE ! grain size (Crocus)
+ REAL, POINTER, DIMENSION(:,:) :: XSNOWSSA ! snow specific surface area (Crocus)
+ REAL, POINTER, DIMENSION(:,:) :: XSNOWTYPEMEPRA ! snow grain type (Crocus-MEPRA)
+ REAL, POINTER, DIMENSION(:,:) :: XSNOWRAM ! snow ram resistance (Crocus-MEPRA)
+ REAL, POINTER, DIMENSION(:,:) :: XSNOWSHEAR ! snow shear resistance (Crocus-MEPRA)
+!
+ REAL, POINTER, DIMENSION(:) :: XSNOWHMASS ! heat content change due to mass
+! ! changes in snowpack: for budget
+ REAL, POINTER, DIMENSION(:,:) :: XSNOWLIQ ! snow liquid water profile (ISBA-ES:3-L)
+ REAL, POINTER, DIMENSION(:,:) :: XSNOWTEMP ! snow temperature profile (ISBA-ES:3-L)
+!
+ REAL, POINTER, DIMENSION(:) :: XTWSNOW ! Total snow reservoir
+ REAL, POINTER, DIMENSION(:) :: XTDSNOW ! Total snow height
+ REAL, POINTER, DIMENSION(:) :: XTTSNOW ! Total snow temperature
+!
+ REAL, POINTER, DIMENSION(:) :: XSNDPT_1DY, XSNDPT_3DY, XSNDPT_5DY, XSNDPT_7DY ! fresh snow depth in 1, 3, 5, 7 days
+ REAL, POINTER, DIMENSION(:) :: XSNSWE_1DY, XSNSWE_3DY, XSNSWE_5DY, XSNSWE_7DY! fresh snow water equivalent in 1, 3, 5, 7 days
+ REAL, POINTER, DIMENSION(:) :: XSNRAM_SONDE ! penetration depth of the ram resistance sensor (2 DaN)
+ REAL, POINTER, DIMENSION(:) :: XSN_WETTHCKN ! Thickness of wet snow at the top of the snowpack
+ REAL, POINTER, DIMENSION(:) :: XSN_REFRZNTHCKN ! Thickness of refrozen snow at the top of the snowpack
+ REAL, POINTER, DIMENSION(:) :: XPSNG ! Snow fraction over ground, diag at time t
+ REAL, POINTER, DIMENSION(:) :: XPSNV ! Snow fraction over vegetation, diag at time t
+ REAL, POINTER, DIMENSION(:) :: XPSN ! Total Snow fraction, diag at time t
+!
+ REAL, POINTER, DIMENSION(:) :: XFSAT ! Topmodel/dt92 saturated fraction
+!
+ REAL, POINTER, DIMENSION(:) :: XFFG ! Flood fraction over ground, diag at time t
+ REAL, POINTER, DIMENSION(:) :: XFFV ! Flood fraction over vegetation, diag at time t
+ REAL, POINTER, DIMENSION(:) :: XFF ! Total Flood fraction, diag at time t
+!
+ REAL, POINTER, DIMENSION(:) :: XSEUIL ! Irrigation threshold
+!
+ REAL, POINTER, DIMENSION(:) :: XFAPAR ! Fapar of vegetation
+ REAL, POINTER, DIMENSION(:) :: XFAPIR ! Fapir of vegetation
+ REAL, POINTER, DIMENSION(:) :: XDFAPARC ! Fapar of vegetation (cumul)
+ REAL, POINTER, DIMENSION(:) :: XDFAPIRC ! Fapir of vegetation (cumul)
+ REAL, POINTER, DIMENSION(:) :: XFAPAR_BS ! Fapar of bare soil
+ REAL, POINTER, DIMENSION(:) :: XFAPIR_BS ! Fapir of bare soil
+ REAL, POINTER, DIMENSION(:) :: XDLAI_EFFC ! Effective LAI (cumul)
+!
+ REAL, POINTER, DIMENSION(:) :: XCG ! heat capacity of the ground
+ REAL, POINTER, DIMENSION(:) :: XC1 ! coefficients for the moisure
+ REAL, POINTER, DIMENSION(:) :: XC2 ! equation.
+ REAL, POINTER, DIMENSION(:) :: XWGEQ ! equilibrium volumetric water
+! ! content
+ REAL, POINTER, DIMENSION(:) :: XCT ! area-averaged heat capacity
+ REAL, POINTER, DIMENSION(:) :: XRS ! stomatal resistance (s/m)
+!
+!------------------------------------------------------------------------------
+!
END TYPE DIAG_MISC_ISBA_t
-
-
-
- CONTAINS
-
!
+TYPE DIAG_MISC_ISBA_NP_t
!
-
-
+TYPE(DIAG_MISC_ISBA_t), POINTER :: AL(:)=>NULL()
!
-
-
-SUBROUTINE DIAG_MISC_ISBA_INIT(YDIAG_MISC_ISBA)
-TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: YDIAG_MISC_ISBA
+END TYPE DIAG_MISC_ISBA_NP_t
+!
+CONTAINS
+!
+SUBROUTINE DIAG_MISC_ISBA_NP_INIT(YNDIAG_MISC_ISBA,KPATCH)
+TYPE(DIAG_MISC_ISBA_NP_t), INTENT(INOUT) :: YNDIAG_MISC_ISBA
+INTEGER, INTENT(IN) :: KPATCH
+INTEGER :: JP
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_DIAG_MISC_ISBA_N:DIAG_MISC_ISBA_NP_INIT",0,ZHOOK_HANDLE)
+IF (.NOT.ASSOCIATED(YNDIAG_MISC_ISBA%AL)) THEN
+ ALLOCATE(YNDIAG_MISC_ISBA%AL(KPATCH))
+ DO JP=1,KPATCH
+ CALL DIAG_MISC_ISBA_INIT(YNDIAG_MISC_ISBA%AL(JP))
+ ENDDO
+ELSE
+ DO JP=1,KPATCH
+ CALL DIAG_MISC_ISBA_INIT(YNDIAG_MISC_ISBA%AL(JP))
+ ENDDO
+ DEALLOCATE(YNDIAG_MISC_ISBA%AL)
+ENDIF
+IF (LHOOK) CALL DR_HOOK("MODD_DIAG_MISC_ISBA_N:DIAG_MISC_ISBA_NP_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE DIAG_MISC_ISBA_NP_INIT
+!
+SUBROUTINE DIAG_MISC_ISBA_INIT(DMI)
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK("MODD_DIAG_MISC_ISBA_N:DIAG_MISC_ISBA_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YDIAG_MISC_ISBA%XHV)
- NULLIFY(YDIAG_MISC_ISBA%XSWI)
- NULLIFY(YDIAG_MISC_ISBA%XTSWI)
- NULLIFY(YDIAG_MISC_ISBA%XALT)
- NULLIFY(YDIAG_MISC_ISBA%XFLT)
- NULLIFY(YDIAG_MISC_ISBA%XSNOWLIQ)
- NULLIFY(YDIAG_MISC_ISBA%XSNOWTEMP)
- NULLIFY(YDIAG_MISC_ISBA%XTWSNOW)
- NULLIFY(YDIAG_MISC_ISBA%XTDSNOW)
- NULLIFY(YDIAG_MISC_ISBA%XTTSNOW)
- NULLIFY(YDIAG_MISC_ISBA%XDPSNG)
- NULLIFY(YDIAG_MISC_ISBA%XDPSNV)
- NULLIFY(YDIAG_MISC_ISBA%XDPSN)
- NULLIFY(YDIAG_MISC_ISBA%XALBT)
- NULLIFY(YDIAG_MISC_ISBA%XDFFG)
- NULLIFY(YDIAG_MISC_ISBA%XDFFV)
- NULLIFY(YDIAG_MISC_ISBA%XDFF)
- NULLIFY(YDIAG_MISC_ISBA%XSEUIL)
- NULLIFY(YDIAG_MISC_ISBA%XFAPAR)
- NULLIFY(YDIAG_MISC_ISBA%XFAPIR)
- NULLIFY(YDIAG_MISC_ISBA%XDFAPARC)
- NULLIFY(YDIAG_MISC_ISBA%XDFAPIRC)
- NULLIFY(YDIAG_MISC_ISBA%XFAPAR_BS)
- NULLIFY(YDIAG_MISC_ISBA%XFAPIR_BS)
- NULLIFY(YDIAG_MISC_ISBA%XDLAI_EFFC)
- NULLIFY(YDIAG_MISC_ISBA%XAVG_HV)
- NULLIFY(YDIAG_MISC_ISBA%XAVG_LAI)
- NULLIFY(YDIAG_MISC_ISBA%XAVG_SWI)
- NULLIFY(YDIAG_MISC_ISBA%XAVG_TSWI)
- NULLIFY(YDIAG_MISC_ISBA%XSOIL_SWI)
- NULLIFY(YDIAG_MISC_ISBA%XSOIL_TSWI)
- NULLIFY(YDIAG_MISC_ISBA%XSOIL_TWG)
- NULLIFY(YDIAG_MISC_ISBA%XSOIL_TWGI)
- NULLIFY(YDIAG_MISC_ISBA%XSOIL_WG)
- NULLIFY(YDIAG_MISC_ISBA%XSOIL_WGI)
- NULLIFY(YDIAG_MISC_ISBA%XAVG_ALT)
- NULLIFY(YDIAG_MISC_ISBA%XAVG_FLT)
- NULLIFY(YDIAG_MISC_ISBA%XAVG_TWSNOW)
- NULLIFY(YDIAG_MISC_ISBA%XAVG_TDSNOW)
- NULLIFY(YDIAG_MISC_ISBA%XAVG_TTSNOW)
- NULLIFY(YDIAG_MISC_ISBA%XAVG_PSNG)
- NULLIFY(YDIAG_MISC_ISBA%XAVG_PSNV)
- NULLIFY(YDIAG_MISC_ISBA%XAVG_PSN)
- NULLIFY(YDIAG_MISC_ISBA%XAVG_ALBT)
- NULLIFY(YDIAG_MISC_ISBA%XAVG_FFG)
- NULLIFY(YDIAG_MISC_ISBA%XAVG_FFV)
- NULLIFY(YDIAG_MISC_ISBA%XAVG_FF)
- NULLIFY(YDIAG_MISC_ISBA%XFRD2_TSWI)
- NULLIFY(YDIAG_MISC_ISBA%XFRD2_TWG)
- NULLIFY(YDIAG_MISC_ISBA%XFRD2_TWGI)
- NULLIFY(YDIAG_MISC_ISBA%XFRD3_TSWI)
- NULLIFY(YDIAG_MISC_ISBA%XFRD3_TWG)
- NULLIFY(YDIAG_MISC_ISBA%XFRD3_TWGI)
-YDIAG_MISC_ISBA%LSURF_MISC_BUDGET=.FALSE.
-YDIAG_MISC_ISBA%LSURF_DIAG_ALBEDO=.FALSE.
-YDIAG_MISC_ISBA%LSURF_MISC_DIF=.FALSE.
+ NULLIFY(DMI%XHV)
+ NULLIFY(DMI%XLAI)
+ NULLIFY(DMI%XSWI)
+ NULLIFY(DMI%XTSWI)
+ NULLIFY(DMI%XSOIL_SWI)
+ NULLIFY(DMI%XSOIL_TSWI)
+ NULLIFY(DMI%XSOIL_TWG)
+ NULLIFY(DMI%XSOIL_TWGI)
+ NULLIFY(DMI%XSOIL_WG)
+ NULLIFY(DMI%XSOIL_WGI)
+ NULLIFY(DMI%XFRD2_TWG)
+ NULLIFY(DMI%XFRD2_TWGI)
+ NULLIFY(DMI%XFRD3_TSWI)
+ NULLIFY(DMI%XFRD3_TWG)
+ NULLIFY(DMI%XFRD3_TWGI)
+ NULLIFY(DMI%XALT)
+ NULLIFY(DMI%XFLT)
+ NULLIFY(DMI%XRNSNOW)
+ NULLIFY(DMI%XHSNOW)
+ NULLIFY(DMI%XHPSNOW)
+ NULLIFY(DMI%XGFLUXSNOW)
+ NULLIFY(DMI%XUSTARSNOW)
+ NULLIFY(DMI%XGRNDFLUX)
+ NULLIFY(DMI%XSRSFC)
+ NULLIFY(DMI%XRRSFC)
+ NULLIFY(DMI%XCDSNOW)
+ NULLIFY(DMI%XCHSNOW)
+ NULLIFY(DMI%XSNOWDZ)
+ NULLIFY(DMI%XSNOWDEND)
+ NULLIFY(DMI%XSNOWSPHER)
+ NULLIFY(DMI%XSNOWSIZE)
+ NULLIFY(DMI%XSNOWTYPEMEPRA)
+ NULLIFY(DMI%XSNOWSSA)
+ NULLIFY(DMI%XSNOWRAM)
+ NULLIFY(DMI%XSNOWSHEAR)
+ NULLIFY(DMI%XSNDPT_1DY)
+ NULLIFY(DMI%XSNDPT_3DY)
+ NULLIFY(DMI%XSNDPT_5DY)
+ NULLIFY(DMI%XSNDPT_7DY)
+ NULLIFY(DMI%XSNSWE_1DY)
+ NULLIFY(DMI%XSNSWE_3DY)
+ NULLIFY(DMI%XSNSWE_5DY)
+ NULLIFY(DMI%XSNSWE_7DY)
+ NULLIFY(DMI%XSNRAM_SONDE)
+ NULLIFY(DMI%XSN_REFRZNTHCKN)
+ NULLIFY(DMI%XSN_WETTHCKN)
+ NULLIFY(DMI%XSNOWHMASS)
+ NULLIFY(DMI%XSNOWLIQ)
+ NULLIFY(DMI%XSNOWTEMP)
+ NULLIFY(DMI%XTWSNOW)
+ NULLIFY(DMI%XTDSNOW)
+ NULLIFY(DMI%XTTSNOW)
+ NULLIFY(DMI%XPSNG)
+ NULLIFY(DMI%XPSNV)
+ NULLIFY(DMI%XPSN)
+ NULLIFY(DMI%XFFG)
+ NULLIFY(DMI%XFFV)
+ NULLIFY(DMI%XFF)
+ NULLIFY(DMI%XSEUIL)
+ NULLIFY(DMI%XFAPAR)
+ NULLIFY(DMI%XFAPIR)
+ NULLIFY(DMI%XDFAPARC)
+ NULLIFY(DMI%XDFAPIRC)
+ NULLIFY(DMI%XFAPAR_BS)
+ NULLIFY(DMI%XFAPIR_BS)
+ NULLIFY(DMI%XDLAI_EFFC)
+ NULLIFY(DMI%XCG)
+ NULLIFY(DMI%XC1)
+ NULLIFY(DMI%XC2)
+ NULLIFY(DMI%XWGEQ)
+ NULLIFY(DMI%XCT)
+ NULLIFY(DMI%XRS)
+DMI%LSURF_MISC_BUDGET=.FALSE.
+DMI%LSURF_DIAG_ALBEDO=.FALSE.
+DMI%LSURF_MISC_DIF=.FALSE.
IF (LHOOK) CALL DR_HOOK("MODD_DIAG_MISC_ISBA_N:DIAG_MISC_ISBA_INIT",1,ZHOOK_HANDLE)
END SUBROUTINE DIAG_MISC_ISBA_INIT
diff --git a/src/SURFEX/modd_diag_seaicen.F90 b/src/SURFEX/modd_diag_misc_seaicen.F90
similarity index 64%
rename from src/SURFEX/modd_diag_seaicen.F90
rename to src/SURFEX/modd_diag_misc_seaicen.F90
index 5a29077da4afd504a2080a595952a623637cd170..8778540dad6125e769194e7a08f5a8a32ea110d4 100644
--- a/src/SURFEX/modd_diag_seaicen.F90
+++ b/src/SURFEX/modd_diag_misc_seaicen.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ######################
- MODULE MODD_DIAG_SEAICE_n
+ MODULE MODD_DIAG_MISC_SEAICE_n
! ######################
!
!!**** *MODD_DIAG_SEAICE - declaration of diagnostics for sea ice model
@@ -37,10 +37,10 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
-TYPE DIAG_SEAICE_t
+TYPE DIAG_MISC_SEAICE_t
!------------------------------------------------------------------------------
!
- LOGICAL :: LDIAG_SEAICE ! flag for SeaIce variables
+ LOGICAL :: LDIAG_MISC_SEAICE ! flag for SeaIce variables
!
!* averaged variables
!
@@ -50,11 +50,9 @@ TYPE DIAG_SEAICE_t
!------------------------------------------------------------------------------
!
-END TYPE DIAG_SEAICE_t
+END TYPE DIAG_MISC_SEAICE_t
-
-
- CONTAINS
+CONTAINS
!
@@ -62,16 +60,16 @@ END TYPE DIAG_SEAICE_t
-SUBROUTINE DIAG_SEAICE_INIT(YDIAG_SEAICE)
-TYPE(DIAG_SEAICE_t), INTENT(INOUT) :: YDIAG_SEAICE
+SUBROUTINE DIAG_MISC_SEAICE_INIT(YDIAG_MISC_SEAICE)
+TYPE(DIAG_MISC_SEAICE_t), INTENT(INOUT) :: YDIAG_MISC_SEAICE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_SEAICE_N:DIAG_SEAICE_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YDIAG_SEAICE%XSIT)
- NULLIFY(YDIAG_SEAICE%XSND)
- NULLIFY(YDIAG_SEAICE%XMLT)
-YDIAG_SEAICE%LDIAG_SEAICE=.FALSE.
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_SEAICE_N:DIAG_SEAICE_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE DIAG_SEAICE_INIT
+IF (LHOOK) CALL DR_HOOK("MODD_DIAG_MISC_SEAICE_N:DIAG_MISC_SEAICE_INIT",0,ZHOOK_HANDLE)
+ NULLIFY(YDIAG_MISC_SEAICE%XSIT)
+ NULLIFY(YDIAG_MISC_SEAICE%XSND)
+ NULLIFY(YDIAG_MISC_SEAICE%XMLT)
+YDIAG_MISC_SEAICE%LDIAG_MISC_SEAICE=.FALSE.
+IF (LHOOK) CALL DR_HOOK("MODD_DIAG_MISC_SEAICE_N:DIAG_MISC_SEAICE_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE DIAG_MISC_SEAICE_INIT
-END MODULE MODD_DIAG_SEAICE_n
+END MODULE MODD_DIAG_MISC_SEAICE_n
diff --git a/src/SURFEX/modd_diag_misc_teb_optionn.F90 b/src/SURFEX/modd_diag_misc_teb_optionsn.F90
similarity index 94%
rename from src/SURFEX/modd_diag_misc_teb_optionn.F90
rename to src/SURFEX/modd_diag_misc_teb_optionsn.F90
index cd650a8c06a8e9fa9e17222336aec4d90be4f777..3da2b11ca0b8e6c9c02b6d44c11ffa5dc676ce6f 100644
--- a/src/SURFEX/modd_diag_misc_teb_optionn.F90
+++ b/src/SURFEX/modd_diag_misc_teb_optionsn.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ############################
- MODULE MODD_DIAG_MISC_TEB_OPTION_n
+ MODULE MODD_DIAG_MISC_TEB_OPTIONS_n
! ############################
!
!!**** *MODD_DIAG_MISC_TEB - declaration of packed surface parameters for TEB scheme
@@ -45,20 +45,12 @@ TYPE DIAG_MISC_TEB_OPTIONS_t
!
LOGICAL :: LSURF_MISC_BUDGET ! flag for miscellaneous terms of teb scheme
LOGICAL :: LSURF_EVAP_BUDGET ! flag for all terms of evaporation
- LOGICAL :: LSURF_DIAG_ALBEDO ! flag to write out diagnostic albedo
+ LOGICAL :: LSURF_DIAG_ALBEDO ! flag to write out diagnostic albedo
!
END TYPE DIAG_MISC_TEB_OPTIONS_t
!
-
-
-
- CONTAINS
-
+CONTAINS
!
-
-
-
-
SUBROUTINE DIAG_MISC_TEB_OPTIONS_INIT(YDIAG_MISC_TEB_OPTIONS)
TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: YDIAG_MISC_TEB_OPTIONS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -70,4 +62,4 @@ IF (LHOOK) CALL DR_HOOK("MODD_DIAG_MISC_TEB_N:DIAG_MISC_TEB_OPTIONS_INIT",1,ZHOO
END SUBROUTINE DIAG_MISC_TEB_OPTIONS_INIT
-END MODULE MODD_DIAG_MISC_TEB_OPTION_n
+END MODULE MODD_DIAG_MISC_TEB_OPTIONS_n
diff --git a/src/SURFEX/modd_diag_misc_tebn.F90 b/src/SURFEX/modd_diag_misc_tebn.F90
index 45db8412b4b5d936609b18c0a2fc146fe1eca080..e678768884fe266daab1a8940493a29e30830149 100644
--- a/src/SURFEX/modd_diag_misc_tebn.F90
+++ b/src/SURFEX/modd_diag_misc_tebn.F90
@@ -40,7 +40,7 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
-TYPE DIAG_MISC_TEB_1P_t
+TYPE DIAG_MISC_TEB_t
!
!* miscellaneous variables
!
@@ -54,43 +54,31 @@ TYPE DIAG_MISC_TEB_1P_t
REAL, POINTER, DIMENSION(:) :: XH_WALL_B ! wall sensible heat flux (W/m2)
REAL, POINTER, DIMENSION(:) :: XH_ROOF ! roof sensible heat flux (W/m2)
REAL, POINTER, DIMENSION(:) :: XH_ROAD ! road sensible heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XH_GARDEN ! green area sensible heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XH_GREENROOF! green roof sensible heat flux (W/m2)
REAL, POINTER, DIMENSION(:) :: XH_STRLROOF ! structural roof sens. heat flux (W/m2)
REAL, POINTER, DIMENSION(:) :: XH_BLT ! built surf sensible heat flux (W/m2)
REAL, POINTER, DIMENSION(:) :: XRN_WALL_A ! net radiation at wall (W/m2)
REAL, POINTER, DIMENSION(:) :: XRN_WALL_B ! net radiation at wall (W/m2)
REAL, POINTER, DIMENSION(:) :: XRN_ROOF ! net radiation at roof (W/m2)
REAL, POINTER, DIMENSION(:) :: XRN_ROAD ! net radiation at road (W/m2)
- REAL, POINTER, DIMENSION(:) :: XRN_GARDEN ! net radiation at green areas (W/m2)
- REAL, POINTER, DIMENSION(:) :: XRN_GREENROOF!net radiation at green roofs (W/m2)
REAL, POINTER, DIMENSION(:) :: XRN_STRLROOF !net radiation at structural roofs(W/m2)
REAL, POINTER, DIMENSION(:) :: XRN_BLT ! net radiation at built surf (W/m2)
REAL, POINTER, DIMENSION(:) :: XGFLUX_WALL_A !net wall conduction flux (W/m2)
REAL, POINTER, DIMENSION(:) :: XGFLUX_WALL_B !net wall conduction flux (W/m2)
REAL, POINTER, DIMENSION(:) :: XGFLUX_ROOF ! net roof conduction flux (W/m2)
REAL, POINTER, DIMENSION(:) :: XGFLUX_ROAD ! net road conduction flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XGFLUX_GARDEN!net green area conduction flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XGFLUX_GREENROOF!net green roof conduction flux(W/m2)
REAL, POINTER, DIMENSION(:) :: XGFLUX_STRLROOF !net structural roof cond flux (W/m2)
REAL, POINTER, DIMENSION(:) :: XGFLUX_BLT ! net built surf conduction flux (W/m2)
REAL, POINTER, DIMENSION(:) :: XLE_ROOF ! roof latent heat flux (W/m2)
REAL, POINTER, DIMENSION(:) :: XLE_ROAD ! road latent heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLE_GARDEN ! green area latent heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLE_GREENROOF!green roof latent heat flux (W/m2)
REAL, POINTER, DIMENSION(:) :: XLE_STRLROOF !structural roof latent heat flux (W/m2)
REAL, POINTER, DIMENSION(:) :: XLE_BLT ! built surf latent heat flux (W/m2)
!
REAL, POINTER, DIMENSION(:) :: XRUNOFF_TOWN ! aggregated water runoff for town (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XRUNOFF_GARDEN ! water runoff for green areas (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XDRAIN_GARDEN ! water vertical drainage for gardens (kg/m2/s)
REAL, POINTER, DIMENSION(:) :: XIRRIG_GARDEN ! summer ground irrigation rate (kg/m2/s)
REAL, POINTER, DIMENSION(:) :: XRUNOFF_ROAD ! water runoff for roads (kg/m2/s)
REAL, POINTER, DIMENSION(:) :: XIRRIG_ROAD ! road man-made watering rate (kg/m2/s)
REAL, POINTER, DIMENSION(:) :: XRUNOFF_ROOF ! aggregated water runoff for roofs (kg/m2/s)
REAL, POINTER, DIMENSION(:) :: XRUNOFF_STRLROOF ! water runoff for structural roofs (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XRUNOFF_GREENROOF ! water runoff for greenroof (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XDRAIN_GREENROOF ! water vertical drainage for greenroof (kg/m2/s)
REAL, POINTER, DIMENSION(:) :: XIRRIG_GREENROOF ! summer ground irrigation rate (kg/m2/s)
!
REAL, POINTER, DIMENSION(:) :: XABS_SW_ROOF ! absorbed shortwave radiation over roofs
@@ -159,157 +147,121 @@ TYPE DIAG_MISC_TEB_1P_t
REAL, POINTER, DIMENSION(:) :: XREF_SW_FAC ! total solar rad reflected by facade
REAL, POINTER, DIMENSION(:) :: XHU_BLD !Indoor relative humidity
!
- REAL, POINTER, DIMENSION(:) :: XTCOOL_CUR_TARGET ! current cooling setpoint of indoor air
- REAL, POINTER, DIMENSION(:) :: XTHEAT_CUR_TARGET ! current heating setpoint of indoor air
- REAL, POINTER, DIMENSION(:) :: XCUR_QIN ! current internal heat gains [W m-2(floor)]
+ REAL, POINTER, DIMENSION(:) :: XTCOOL_TARGET ! current cooling setpoint of indoor air
+ REAL, POINTER, DIMENSION(:) :: XTHEAT_TARGET ! current heating setpoint of indoor air
+ REAL, POINTER, DIMENSION(:) :: XQIN ! current internal heat gains [W m-2(floor)]
!------------------------------------------------------------------------------
!
-END TYPE DIAG_MISC_TEB_1P_t
+END TYPE DIAG_MISC_TEB_t
-TYPE DIAG_MISC_TEB_t
+TYPE DIAG_MISC_TEB_NP_t
!
- TYPE(DIAG_MISC_TEB_1P_t), POINTER :: ALP(:) => NULL()
- TYPE(DIAG_MISC_TEB_1P_t), POINTER :: CUR => NULL()
+ TYPE(DIAG_MISC_TEB_t), POINTER :: AL(:) => NULL()
!
-END TYPE DIAG_MISC_TEB_t
-!
-!
+END TYPE DIAG_MISC_TEB_NP_t
!
- CONTAINS
-
-
+CONTAINS
!
-
-
-
-
-SUBROUTINE DIAG_MISC_TEB_GOTO_PATCH(YDIAG_MISC_TEB,KTO_PATCH)
+SUBROUTINE DIAG_MISC_TEB_INIT(YDIAG_MISC_TEB)
TYPE(DIAG_MISC_TEB_t), INTENT(INOUT) :: YDIAG_MISC_TEB
-INTEGER, INTENT(IN) :: KTO_PATCH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_DIAG_MISC_TEB_N:DIAG_MISC_TEB_INIT",0,ZHOOK_HANDLE)
+ NULLIFY(YDIAG_MISC_TEB%XZ0_TOWN)
+ NULLIFY(YDIAG_MISC_TEB%XQF_BLD)
+ NULLIFY(YDIAG_MISC_TEB%XFLX_BLD)
+ NULLIFY(YDIAG_MISC_TEB%XQF_TOWN)
+ NULLIFY(YDIAG_MISC_TEB%XDQS_TOWN)
+ NULLIFY(YDIAG_MISC_TEB%XH_WALL_A)
+ NULLIFY(YDIAG_MISC_TEB%XH_WALL_B)
+ NULLIFY(YDIAG_MISC_TEB%XH_ROOF)
+ NULLIFY(YDIAG_MISC_TEB%XH_ROAD)
+ NULLIFY(YDIAG_MISC_TEB%XH_STRLROOF)
+ NULLIFY(YDIAG_MISC_TEB%XH_BLT)
+ NULLIFY(YDIAG_MISC_TEB%XRN_WALL_A)
+ NULLIFY(YDIAG_MISC_TEB%XRN_WALL_B)
+ NULLIFY(YDIAG_MISC_TEB%XRN_ROOF)
+ NULLIFY(YDIAG_MISC_TEB%XRN_ROAD)
+ NULLIFY(YDIAG_MISC_TEB%XRN_STRLROOF)
+ NULLIFY(YDIAG_MISC_TEB%XRN_BLT)
+ NULLIFY(YDIAG_MISC_TEB%XGFLUX_WALL_A)
+ NULLIFY(YDIAG_MISC_TEB%XGFLUX_WALL_B)
+ NULLIFY(YDIAG_MISC_TEB%XGFLUX_ROOF)
+ NULLIFY(YDIAG_MISC_TEB%XGFLUX_ROAD)
+ NULLIFY(YDIAG_MISC_TEB%XGFLUX_STRLROOF)
+ NULLIFY(YDIAG_MISC_TEB%XGFLUX_BLT)
+ NULLIFY(YDIAG_MISC_TEB%XLE_ROOF)
+ NULLIFY(YDIAG_MISC_TEB%XLE_ROAD)
+ NULLIFY(YDIAG_MISC_TEB%XLE_STRLROOF)
+ NULLIFY(YDIAG_MISC_TEB%XLE_BLT)
+ NULLIFY(YDIAG_MISC_TEB%XRUNOFF_TOWN)
+ NULLIFY(YDIAG_MISC_TEB%XIRRIG_GARDEN)
+ NULLIFY(YDIAG_MISC_TEB%XRUNOFF_ROAD)
+ NULLIFY(YDIAG_MISC_TEB%XIRRIG_ROAD)
+ NULLIFY(YDIAG_MISC_TEB%XRUNOFF_ROOF)
+ NULLIFY(YDIAG_MISC_TEB%XRUNOFF_STRLROOF)
+ NULLIFY(YDIAG_MISC_TEB%XIRRIG_GREENROOF)
+ NULLIFY(YDIAG_MISC_TEB%XABS_LW_GREENROOF)
+ NULLIFY(YDIAG_MISC_TEB%XG_GREENROOF_ROOF)
+ NULLIFY(YDIAG_MISC_TEB%XABS_SW_PANEL)
+ NULLIFY(YDIAG_MISC_TEB%XABS_LW_PANEL)
+ NULLIFY(YDIAG_MISC_TEB%XRN_PANEL)
+ NULLIFY(YDIAG_MISC_TEB%XH_PANEL)
+ NULLIFY(YDIAG_MISC_TEB%XTHER_PROD_PANEL)
+ NULLIFY(YDIAG_MISC_TEB%XPHOT_PROD_PANEL)
+ NULLIFY(YDIAG_MISC_TEB%XPROD_PANEL)
+ NULLIFY(YDIAG_MISC_TEB%XTHER_PROD_BLD)
+ NULLIFY(YDIAG_MISC_TEB%XPHOT_PROD_BLD)
+ NULLIFY(YDIAG_MISC_TEB%XT_BLD_COOL)
+ NULLIFY(YDIAG_MISC_TEB%XH_BLD_COOL)
+ NULLIFY(YDIAG_MISC_TEB%XH_BLD_HEAT)
+ NULLIFY(YDIAG_MISC_TEB%XLE_BLD_COOL)
+ NULLIFY(YDIAG_MISC_TEB%XLE_BLD_HEAT)
+ NULLIFY(YDIAG_MISC_TEB%XHVAC_COOL)
+ NULLIFY(YDIAG_MISC_TEB%XHVAC_HEAT)
+ NULLIFY(YDIAG_MISC_TEB%XH_WASTE)
+ NULLIFY(YDIAG_MISC_TEB%XLE_WASTE)
+ NULLIFY(YDIAG_MISC_TEB%XCAP_SYS)
+ NULLIFY(YDIAG_MISC_TEB%XM_SYS)
+ NULLIFY(YDIAG_MISC_TEB%XCOP)
+ NULLIFY(YDIAG_MISC_TEB%XQ_SYS)
+ NULLIFY(YDIAG_MISC_TEB%XT_SYS)
+ NULLIFY(YDIAG_MISC_TEB%XTR_SW_WIN)
+ NULLIFY(YDIAG_MISC_TEB%XFAN_POWER)
+ NULLIFY(YDIAG_MISC_TEB%XABS_SW_WIN)
+ NULLIFY(YDIAG_MISC_TEB%XABS_LW_WIN)
+ NULLIFY(YDIAG_MISC_TEB%XEMIT_LW_GRND)
+ NULLIFY(YDIAG_MISC_TEB%XEMIT_LW_FAC)
+ NULLIFY(YDIAG_MISC_TEB%XT_RAD_IND)
+ NULLIFY(YDIAG_MISC_TEB%XREF_SW_GRND)
+ NULLIFY(YDIAG_MISC_TEB%XREF_SW_FAC)
+ NULLIFY(YDIAG_MISC_TEB%XHU_BLD)
+ NULLIFY(YDIAG_MISC_TEB%XTCOOL_TARGET)
+ NULLIFY(YDIAG_MISC_TEB%XTHEAT_TARGET)
+ NULLIFY(YDIAG_MISC_TEB%XQIN)
+IF (LHOOK) CALL DR_HOOK("MODD_DIAG_MISC_TEB_N:DIAG_MISC_TEB_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE DIAG_MISC_TEB_INIT
!
-IF (LHOOK) CALL DR_HOOK('MODD_DIAG_MISC_TEB_N:DIAG_MISC_TEB_GOTO_PATCH',0,ZHOOK_HANDLE)
-
-YDIAG_MISC_TEB%CUR => YDIAG_MISC_TEB%ALP(KTO_PATCH)
-
-IF (LHOOK) CALL DR_HOOK('MODD_DIAG_MISC_TEB_N:DIAG_MISC_TEB_GOTO_PATCH',1,ZHOOK_HANDLE)
-
-END SUBROUTINE DIAG_MISC_TEB_GOTO_PATCH
-
-
-SUBROUTINE DIAG_MISC_TEB_INIT(YDIAG_MISC_TEB,KPATCH)
-TYPE(DIAG_MISC_TEB_t), INTENT(INOUT) :: YDIAG_MISC_TEB
+SUBROUTINE DIAG_MISC_TEB_NP_INIT(YNDIAG_MISC_TEB,KPATCH)
+TYPE(DIAG_MISC_TEB_NP_t), INTENT(INOUT) :: YNDIAG_MISC_TEB
INTEGER, INTENT(IN) :: KPATCH
INTEGER :: JP
REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_MISC_TEB_N:DIAG_MISC_TEB_INIT",0,ZHOOK_HANDLE)
- ALLOCATE(YDIAG_MISC_TEB%ALP(KPATCH))
- YDIAG_MISC_TEB%CUR => YDIAG_MISC_TEB%ALP(1)
-DO JP=1,KPATCH
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XZ0_TOWN)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XQF_BLD)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XFLX_BLD)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XQF_TOWN)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XDQS_TOWN)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XH_WALL_A)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XH_WALL_B)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XH_ROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XH_ROAD)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XH_GARDEN)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XH_GREENROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XH_STRLROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XH_BLT)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XRN_WALL_A)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XRN_WALL_B)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XRN_ROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XRN_ROAD)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XRN_GARDEN)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XRN_GREENROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XRN_STRLROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XRN_BLT)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XGFLUX_WALL_A)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XGFLUX_WALL_B)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XGFLUX_ROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XGFLUX_ROAD)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XGFLUX_GARDEN)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XGFLUX_GREENROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XGFLUX_STRLROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XGFLUX_BLT)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XLE_ROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XLE_ROAD)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XLE_GARDEN)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XLE_GREENROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XLE_STRLROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XLE_BLT)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XRUNOFF_TOWN)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XRUNOFF_GARDEN)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XDRAIN_GARDEN)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XIRRIG_GARDEN)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XRUNOFF_ROAD)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XIRRIG_ROAD)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XRUNOFF_ROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XRUNOFF_STRLROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XRUNOFF_GREENROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XDRAIN_GREENROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XIRRIG_GREENROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XABS_SW_ROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XABS_SW_SNOW_ROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XABS_LW_ROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XABS_LW_SNOW_ROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XABS_SW_ROAD)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XABS_SW_SNOW_ROAD)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XABS_LW_ROAD)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XABS_LW_SNOW_ROAD)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XABS_SW_WALL_A)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XABS_SW_WALL_B)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XABS_LW_WALL_A)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XABS_LW_WALL_B)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XABS_SW_GARDEN)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XABS_LW_GARDEN)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XABS_SW_GREENROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XABS_LW_GREENROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XG_GREENROOF_ROOF)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XABS_SW_PANEL)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XABS_LW_PANEL)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XRN_PANEL)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XH_PANEL)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XTHER_PROD_PANEL)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XPHOT_PROD_PANEL)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XPROD_PANEL)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XTHER_PROD_BLD)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XPHOT_PROD_BLD)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XT_BLD_COOL)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XH_BLD_COOL)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XH_BLD_HEAT)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XLE_BLD_COOL)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XLE_BLD_HEAT)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XHVAC_COOL)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XHVAC_HEAT)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XH_WASTE)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XLE_WASTE)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XCAP_SYS)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XM_SYS)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XCOP)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XQ_SYS)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XT_SYS)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XTR_SW_WIN)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XFAN_POWER)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XABS_SW_WIN)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XABS_LW_WIN)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XEMIT_LW_GRND)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XEMIT_LW_FAC)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XT_RAD_IND)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XREF_SW_GRND)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XREF_SW_FAC)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XHU_BLD)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XTCOOL_CUR_TARGET)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XTHEAT_CUR_TARGET)
- NULLIFY(YDIAG_MISC_TEB%ALP(JP)%XCUR_QIN)
-ENDDO
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_MISC_TEB_N:DIAG_MISC_TEB_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE DIAG_MISC_TEB_INIT
+IF (LHOOK) CALL DR_HOOK("MODD_DIAG_MISC_TEB_N:DIAG_MISC_TEB_NP_INIT",0,ZHOOK_HANDLE)
+IF (.NOT.ASSOCIATED(YNDIAG_MISC_TEB%AL)) THEN
+ ALLOCATE(YNDIAG_MISC_TEB%AL(KPATCH))
+ DO JP=1,KPATCH
+ CALL DIAG_MISC_TEB_INIT(YNDIAG_MISC_TEB%AL(JP))
+ ENDDO
+ELSE
+ DO JP=1,KPATCH
+ CALL DIAG_MISC_TEB_INIT(YNDIAG_MISC_TEB%AL(JP))
+ ENDDO
+ DEALLOCATE(YNDIAG_MISC_TEB%AL)
+ENDIF
+IF (LHOOK) CALL DR_HOOK("MODD_DIAG_MISC_TEB_N:DIAG_MISC_TEB_NP_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE DIAG_MISC_TEB_NP_INIT
diff --git a/src/SURFEX/modd_diag_oceann.F90 b/src/SURFEX/modd_diag_oceann.F90
index 0f61331a7f965d24133a7c5693dc1743ea77bd66..9a8082b180a3e77c0fa463d8db72dc54b3081e79 100644
--- a/src/SURFEX/modd_diag_oceann.F90
+++ b/src/SURFEX/modd_diag_oceann.F90
@@ -56,7 +56,7 @@ END TYPE DIAG_OCEAN_t
- CONTAINS
+CONTAINS
!
diff --git a/src/SURFEX/modd_diag_seafluxn.F90 b/src/SURFEX/modd_diag_seafluxn.F90
deleted file mode 100644
index 70b2b77d76eaf021f3cb997c69fd9e7058fdf2b7..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_diag_seafluxn.F90
+++ /dev/null
@@ -1,247 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ######################
- MODULE MODD_DIAG_SEAFLUX_n
-! ######################
-!
-!!**** *MODD_DIAG_SEAFLUX - declaration of diagnostics for SEAFLUX scheme
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! Modified 01/2006 : sea flux parameterization.
-!! S.Senesi 01/2014 : add diags on seaice
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE DIAG_SEAFLUX_t
-!------------------------------------------------------------------------------
-!
- REAL :: XDIAG_TSTEP ! time step for diagnostics writing
-!
- INTEGER :: N2M ! flag for 2 meters (and 10 meters) quantities
- LOGICAL :: L2M_MIN_ZS ! flag for 2 meters quantities evaluated on
-! ! the minimum orographyy of the grid
- LOGICAL :: LSURF_BUDGET ! flag for surface energy budget
- LOGICAL :: LRAD_BUDGET ! flag for radiative energy budget
- LOGICAL :: LCOEF ! flag for transfer coefficients
- LOGICAL :: LSURF_VARS ! flag for surface variables
- LOGICAL :: LSURF_BUDGETC ! flag for surface cumulated energy budget
- LOGICAL :: LRESET_BUDGETC ! flag for surface cumulated energy budget
-!
-!* averaged variables
-!
- REAL, POINTER, DIMENSION(:) :: XRI ! Bulk-Richardson number (-)
- REAL, POINTER, DIMENSION(:) :: XRI_ICE ! Seaice Bulk-Richardson number (-)
- REAL, POINTER, DIMENSION(:) :: XCD ! drag coefficient for wind (W/s2)
- REAL, POINTER, DIMENSION(:) :: XCD_ICE ! Seaice drag coefficient for wind (W/s2)
- REAL, POINTER, DIMENSION(:) :: XCH ! drag coefficient for heat (W/s)
- REAL, POINTER, DIMENSION(:) :: XCH_ICE ! Seaice drag coefficient for heat (W/s)
- REAL, POINTER, DIMENSION(:) :: XCE ! drag coefficient for vapor (W/s/K)
- REAL, POINTER, DIMENSION(:) :: XZ0 ! roughness length for momentum (m)
- REAL, POINTER, DIMENSION(:) :: XZ0_ICE ! Seaice roughness length for momentum (m)
- REAL, POINTER, DIMENSION(:) :: XZ0H ! roughness length for heat (m)
- REAL, POINTER, DIMENSION(:) :: XZ0H_ICE ! Seaice roughness length for heat (m)
- REAL, POINTER, DIMENSION(:) :: XRN ! net radiation at surface (W/m2)
- REAL, POINTER, DIMENSION(:) :: XRN_ICE ! Seaice net radiation at surface (W/m2)
- REAL, POINTER, DIMENSION(:) :: XH ! sensible heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XH_ICE ! Seaice sensible heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLE ! total latent heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLE_ICE ! sublimation latent heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XGFLUX ! net soil-vegetation flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XGFLUX_ICE ! net soil-vegetation flux (seaice) (W/m2)
- REAL, POINTER, DIMENSION(:) :: XEVAP ! total evaporation (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XSUBL ! sublimation (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XT2M ! air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XT2M_ICE ! Seaice air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XT2M_MIN ! Minimum air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XT2M_MAX ! Maximum air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XQ2M ! air humidity at 2 meters (kg/kg)
- REAL, POINTER, DIMENSION(:) :: XQ2M_ICE ! Seaice air humidity at 2 meters (kg/kg)
- REAL, POINTER, DIMENSION(:) :: XHU2M ! air relative humidity at 2 meters(-)
- REAL, POINTER, DIMENSION(:) :: XHU2M_ICE! Seaice air relative humidity at 2 meters(-)
- REAL, POINTER, DIMENSION(:) :: XHU2M_MIN! Minimum relative humidity at 2 meters (-)
- REAL, POINTER, DIMENSION(:) :: XHU2M_MAX! Maximum relative humidity at 2 meters (-)
- REAL, POINTER, DIMENSION(:) :: XQS ! air humidity at surface (kg/kg)
- REAL, POINTER, DIMENSION(:) :: XQS_ICE ! Seaice air humidity at surface (kg/kg)
- REAL, POINTER, DIMENSION(:) :: XZON10M ! zonal wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XZON10M_ICE ! Seaice zonal wind at 10 meters(m/s)
- REAL, POINTER, DIMENSION(:) :: XMER10M ! meridian wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XMER10M_ICE ! Seaice meridian wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XWIND10M ! wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XWIND10M_ICE ! Seaice wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XWIND10M_MAX! Maximum wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XLWD ! downward long wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLWU ! upward long wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLWU_ICE ! Seaice upward long wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XSWD ! downward short wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XSWU ! upward short wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XSWU_ICE ! Seaice upward short wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSWBD ! downward short wave radiation by spectral band (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSWBU ! upward short wave radiation by spectral band (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSWBU_ICE! Seaice upward short wave radiation by spectral band (W/m2)
- REAL, POINTER, DIMENSION(:) :: XFMU ! horizontal momentum flux zonal (kg/ms2)
- REAL, POINTER, DIMENSION(:) :: XFMU_ICE ! Seaice horizontal momentum flux zonal (kg/ms2)
- REAL, POINTER, DIMENSION(:) :: XFMV ! horizontal momentum flux meridian (kg/ms2)
- REAL, POINTER, DIMENSION(:) :: XFMV_ICE ! Seaice horizontal momentum flux meridian (kg/ms2)
-!
- REAL, POINTER, DIMENSION(:) :: XTS ! surface temperature (K)
- REAL, POINTER, DIMENSION(:) :: XTSRAD ! surface radiative temperature (K)
- REAL, POINTER, DIMENSION(:) :: XALBT ! Total Albedo
-!
-!* cumulated averaged variables
-!
- REAL, POINTER, DIMENSION(:) :: XRNC ! net radiation at surface (J/m2)
- REAL, POINTER, DIMENSION(:) :: XRNC_ICE ! Seaice net radiation at surface (J/m2)
- REAL, POINTER, DIMENSION(:) :: XHC ! sensible heat flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XHC_ICE ! Seaice sensible heat flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XLEC ! total latent heat flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XLEC_ICE ! sublimation latent heat flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XGFLUXC ! net soil-vegetation flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XGFLUXC_ICE !Seaice net soil-vegetation flux(J/m2)
- REAL, POINTER, DIMENSION(:) :: XEVAPC ! total evaporation (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XSUBLC ! sublimation (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XLWDC ! downward long wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XLWUC ! upward long wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XLWUC_ICE! Seaice upward long wave radiation(J/m2)
- REAL, POINTER, DIMENSION(:) :: XSWDC ! downward short wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XSWUC ! upward short wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XSWUC_ICE! Seaice upward short wave radiation(J/m2)
- REAL, POINTER, DIMENSION(:) :: XFMUC ! horizontal momentum flux zonal (kg/ms)
- REAL, POINTER, DIMENSION(:) :: XFMUC_ICE! Seaice horizontal momentum flux zonal (kg/ms)
- REAL, POINTER, DIMENSION(:) :: XFMVC ! horizontal momentum flux meridian (kg/ms)
- REAL, POINTER, DIMENSION(:) :: XFMVC_ICE! Seaice horizontal momentum flux meridian (kg/ms)
-!
-!------------------------------------------------------------------------------
-!
-END TYPE DIAG_SEAFLUX_t
-
-
-
- CONTAINS
-
-!
-
-
-
-
-
-SUBROUTINE DIAG_SEAFLUX_INIT(YDIAG_SEAFLUX)
-TYPE(DIAG_SEAFLUX_t), INTENT(INOUT) :: YDIAG_SEAFLUX
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_SEAFLUX_N:DIAG_SEAFLUX_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YDIAG_SEAFLUX%XRI)
- NULLIFY(YDIAG_SEAFLUX%XRI_ICE)
- NULLIFY(YDIAG_SEAFLUX%XCD)
- NULLIFY(YDIAG_SEAFLUX%XCD_ICE)
- NULLIFY(YDIAG_SEAFLUX%XCH)
- NULLIFY(YDIAG_SEAFLUX%XCH_ICE)
- NULLIFY(YDIAG_SEAFLUX%XCE)
- NULLIFY(YDIAG_SEAFLUX%XZ0)
- NULLIFY(YDIAG_SEAFLUX%XZ0_ICE)
- NULLIFY(YDIAG_SEAFLUX%XZ0H)
- NULLIFY(YDIAG_SEAFLUX%XZ0H_ICE)
- NULLIFY(YDIAG_SEAFLUX%XRN)
- NULLIFY(YDIAG_SEAFLUX%XRN_ICE)
- NULLIFY(YDIAG_SEAFLUX%XH)
- NULLIFY(YDIAG_SEAFLUX%XH_ICE)
- NULLIFY(YDIAG_SEAFLUX%XLE)
- NULLIFY(YDIAG_SEAFLUX%XLE_ICE)
- NULLIFY(YDIAG_SEAFLUX%XGFLUX)
- NULLIFY(YDIAG_SEAFLUX%XGFLUX_ICE)
- NULLIFY(YDIAG_SEAFLUX%XEVAP)
- NULLIFY(YDIAG_SEAFLUX%XSUBL)
- NULLIFY(YDIAG_SEAFLUX%XT2M)
- NULLIFY(YDIAG_SEAFLUX%XT2M_ICE)
- NULLIFY(YDIAG_SEAFLUX%XT2M_MIN)
- NULLIFY(YDIAG_SEAFLUX%XT2M_MAX)
- NULLIFY(YDIAG_SEAFLUX%XQ2M)
- NULLIFY(YDIAG_SEAFLUX%XQ2M_ICE)
- NULLIFY(YDIAG_SEAFLUX%XHU2M)
- NULLIFY(YDIAG_SEAFLUX%XHU2M_ICE)
- NULLIFY(YDIAG_SEAFLUX%XHU2M_MIN)
- NULLIFY(YDIAG_SEAFLUX%XHU2M_MAX)
- NULLIFY(YDIAG_SEAFLUX%XQS)
- NULLIFY(YDIAG_SEAFLUX%XQS_ICE)
- NULLIFY(YDIAG_SEAFLUX%XZON10M)
- NULLIFY(YDIAG_SEAFLUX%XZON10M_ICE)
- NULLIFY(YDIAG_SEAFLUX%XMER10M)
- NULLIFY(YDIAG_SEAFLUX%XMER10M_ICE)
- NULLIFY(YDIAG_SEAFLUX%XWIND10M)
- NULLIFY(YDIAG_SEAFLUX%XWIND10M_ICE)
- NULLIFY(YDIAG_SEAFLUX%XWIND10M_MAX)
- NULLIFY(YDIAG_SEAFLUX%XLWD)
- NULLIFY(YDIAG_SEAFLUX%XLWU)
- NULLIFY(YDIAG_SEAFLUX%XLWU_ICE)
- NULLIFY(YDIAG_SEAFLUX%XSWD)
- NULLIFY(YDIAG_SEAFLUX%XSWU)
- NULLIFY(YDIAG_SEAFLUX%XSWU_ICE)
- NULLIFY(YDIAG_SEAFLUX%XSWBD)
- NULLIFY(YDIAG_SEAFLUX%XSWBU)
- NULLIFY(YDIAG_SEAFLUX%XSWBU_ICE)
- NULLIFY(YDIAG_SEAFLUX%XFMU)
- NULLIFY(YDIAG_SEAFLUX%XFMU_ICE)
- NULLIFY(YDIAG_SEAFLUX%XFMV)
- NULLIFY(YDIAG_SEAFLUX%XFMV_ICE)
- NULLIFY(YDIAG_SEAFLUX%XTS)
- NULLIFY(YDIAG_SEAFLUX%XTSRAD)
- NULLIFY(YDIAG_SEAFLUX%XALBT)
- NULLIFY(YDIAG_SEAFLUX%XRNC)
- NULLIFY(YDIAG_SEAFLUX%XRNC_ICE)
- NULLIFY(YDIAG_SEAFLUX%XHC)
- NULLIFY(YDIAG_SEAFLUX%XHC_ICE)
- NULLIFY(YDIAG_SEAFLUX%XLEC)
- NULLIFY(YDIAG_SEAFLUX%XLEC_ICE)
- NULLIFY(YDIAG_SEAFLUX%XGFLUXC)
- NULLIFY(YDIAG_SEAFLUX%XGFLUXC_ICE)
- NULLIFY(YDIAG_SEAFLUX%XEVAPC)
- NULLIFY(YDIAG_SEAFLUX%XSUBLC)
- NULLIFY(YDIAG_SEAFLUX%XLWDC)
- NULLIFY(YDIAG_SEAFLUX%XLWUC)
- NULLIFY(YDIAG_SEAFLUX%XLWUC_ICE)
- NULLIFY(YDIAG_SEAFLUX%XSWDC)
- NULLIFY(YDIAG_SEAFLUX%XSWUC)
- NULLIFY(YDIAG_SEAFLUX%XSWUC_ICE)
- NULLIFY(YDIAG_SEAFLUX%XFMUC)
- NULLIFY(YDIAG_SEAFLUX%XFMUC_ICE)
- NULLIFY(YDIAG_SEAFLUX%XFMVC)
- NULLIFY(YDIAG_SEAFLUX%XFMVC_ICE)
-YDIAG_SEAFLUX%XDIAG_TSTEP=0.
-YDIAG_SEAFLUX%N2M=0
-YDIAG_SEAFLUX%L2M_MIN_ZS=.FALSE.
-YDIAG_SEAFLUX%LSURF_BUDGET=.FALSE.
-YDIAG_SEAFLUX%LRAD_BUDGET=.FALSE.
-YDIAG_SEAFLUX%LCOEF=.FALSE.
-YDIAG_SEAFLUX%LSURF_VARS=.FALSE.
-YDIAG_SEAFLUX%LSURF_BUDGETC=.FALSE.
-YDIAG_SEAFLUX%LRESET_BUDGETC=.FALSE.
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_SEAFLUX_N:DIAG_SEAFLUX_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE DIAG_SEAFLUX_INIT
-
-
-END MODULE MODD_DIAG_SEAFLUX_n
diff --git a/src/SURFEX/modd_diag_surf_atmn.F90 b/src/SURFEX/modd_diag_surf_atmn.F90
deleted file mode 100644
index 36826fecadc101ac2655337863698ff7e10a2ac9..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_diag_surf_atmn.F90
+++ /dev/null
@@ -1,335 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ######################
- MODULE MODD_DIAG_SURF_ATM_n
-! ######################
-!
-!!**** *MODD_DIAG_SURF_ATM - declaration of diagnostics for the surface
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! Modified 01/2006 : sea flux parameterization.
-!! Modified 04/2009 : precip for/from restart file.
-!! Modified 08/2009 : BUDGETC for all tiles
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_TYPE_DATE_SURF
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE DIAG_SURF_ATM_t
-!------------------------------------------------------------------------------
-!
- REAL :: XDIAG_TSTEP ! time step for diagnostics writing
-!
- INTEGER :: N2M ! flag for 2 meters (and 10 meters) quantities
- LOGICAL :: LT2MMW ! flag to perform modified weighting of 2m temperature
- LOGICAL :: L2M_MIN_ZS ! flag for 2 meters quantities evaluated on
-! ! the minimum orographyy of the grid
- LOGICAL :: LSURF_BUDGET ! flag for surface energy budget
- LOGICAL :: LRAD_BUDGET ! flag for radiative energy budget
- LOGICAL :: LCOEF ! flag for transfer coefficients
- LOGICAL :: LSURF_VARS ! flag for surface variables
- LOGICAL :: LFRAC ! flag for writing fractions of each four tiles
- LOGICAL :: LDIAG_GRID ! flag for mean grid diag
- LOGICAL :: LSURF_BUDGETC ! flag for surface cumulated energy budget
- LOGICAL :: LRESET_BUDGETC ! flag for surface cumulated energy budget
- LOGICAL :: LREAD_BUDGETC ! flag for surface cumulated energy budget
- LOGICAL :: LPROVAR_TO_DIAG ! switch to write (or not) prognostic variable
- ! and allows puting field in diagnostics
- LOGICAL :: LSELECT ! switch to control which fields are written
- ! (only those whose naem appears in in text array)
-!
- TYPE(DATE_TIME):: TIME_BUDGETC
-!
- CHARACTER(LEN=LEN_HREC), POINTER, DIMENSION(:) :: CSELECT ! Name of ouput fields if LSELECT=true
-!
-!* variables for each tile
-!
- REAL, POINTER, DIMENSION(:,:) :: XRI_TILE ! Bulk-Richardson number (-)
- REAL, POINTER, DIMENSION(:,:) :: XCD_TILE ! drag coefficient for wind (W/s2)
- REAL, POINTER, DIMENSION(:,:) :: XCH_TILE ! drag coefficient for heat (W/s)
- REAL, POINTER, DIMENSION(:,:) :: XCE_TILE ! drag coefficient for vapor (W/s/K)
- REAL, POINTER, DIMENSION(:,:) :: XRN_TILE ! net radiation at surface (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XH_TILE ! sensible heat flux (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLE_TILE ! total latent heat flux (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLEI_TILE ! sublimation latent heat flux (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XGFLUX_TILE ! net soil-vegetation flux (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XEVAP_TILE ! total evapotranspiration (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XSUBL_TILE ! sublimation (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XTS_TILE ! surface temperature (K)
- REAL, POINTER, DIMENSION(:,:) :: XT2M_TILE ! air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:,:) :: XT2M_MIN_TILE! Minimum air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:,:) :: XT2M_MAX_TILE! Maximum air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:,:) :: XQ2M_TILE ! air humidity at 2 meters (kg/kg)
- REAL, POINTER, DIMENSION(:,:) :: XHU2M_TILE ! air relative humidity at 2 meters(-)
- REAL, POINTER, DIMENSION(:,:) :: XHU2M_MIN_TILE! Minimum air relative humidity at 2 meters(-)
- REAL, POINTER, DIMENSION(:,:) :: XHU2M_MAX_TILE! Maximum air relative humidity at 2 meters(-)
- REAL, POINTER, DIMENSION(:,:) :: XZON10M_TILE ! zonal wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:,:) :: XMER10M_TILE ! meridian wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:,:) :: XWIND10M_TILE! wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:,:) :: XWIND10M_MAX_TILE ! Maximumwind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:,:) :: XQS_TILE
- REAL, POINTER, DIMENSION(:,:) :: XZ0_TILE ! roughness length for momentum (m)
- REAL, POINTER, DIMENSION(:,:) :: XZ0H_TILE ! roughness length for heat (m)
- REAL, POINTER, DIMENSION(:,:) :: XSWD_TILE ! short wave downward radiation (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSWU_TILE ! short wave upward radiation (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLWD_TILE ! longt wave downward radiation (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLWU_TILE ! longt wave upward radiation (W/m2)
- REAL, POINTER, DIMENSION(:,:,:) :: XSWBD_TILE ! short wave downward radiation by spectral band(W/m2)
- REAL, POINTER, DIMENSION(:,:,:) :: XSWBU_TILE ! short wave upward radiation by spectral band(W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XFMU_TILE ! zonal friction
- REAL, POINTER, DIMENSION(:,:) :: XFMV_TILE ! meridian friction
-!
-!* Cumulated variables for each tile
-!
- REAL, POINTER, DIMENSION(:,:) :: XRNC_TILE ! net radiation at surface (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XHC_TILE ! sensible heat flux (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLEC_TILE ! total latent heat flux (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLEIC_TILE ! sublimation latent heat flux (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XGFLUXC_TILE ! net soil-vegetation flux (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XEVAPC_TILE ! total evapotranspiration (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSUBLC_TILE ! sublimation (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSWDC_TILE ! short wave downward radiation (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSWUC_TILE ! short wave upward radiation (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLWDC_TILE ! longt wave downward radiation (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLWUC_TILE ! longt wave upward radiation (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XFMUC_TILE ! zonal friction
- REAL, POINTER, DIMENSION(:,:) :: XFMVC_TILE ! meridian friction
-!
-!* averaged variables
-!
- REAL, POINTER, DIMENSION(:) :: XAVG_RI ! Bulk-Richardson number (-)
- REAL, POINTER, DIMENSION(:) :: XAVG_CD ! drag coefficient for wind (W/s2)
- REAL, POINTER, DIMENSION(:) :: XAVG_CH ! drag coefficient for heat (W/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_CE ! drag coefficient for vapor (W/s/K)
- REAL, POINTER, DIMENSION(:) :: XAVG_RN ! net radiation at surface (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_H ! sensible heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LE ! total latent heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LEI ! sublimation latent heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_GFLUX ! net soil-vegetation flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_EVAP ! total evapotranspiration (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_SUBL ! sublimation (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_TS ! surface temperature (K)
- REAL, POINTER, DIMENSION(:) :: XAVG_T2M ! air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XAVG_Q2M ! air humidity at 2 meters (kg/kg)
- REAL, POINTER, DIMENSION(:) :: XAVG_HU2M ! air relative humidity at 2 meters(-)
- REAL, POINTER, DIMENSION(:) :: XAVG_ZON10M ! zonal wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_MER10M ! meridian wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_SFCO2 ! CO2 flux (m/s*kg_CO2/kg_air)
- REAL, POINTER, DIMENSION(:) :: XAVG_T2M_MIN_ZS ! air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XAVG_Q2M_MIN_ZS ! air humidity at 2 meters (kg/kg)
- REAL, POINTER, DIMENSION(:) :: XAVG_HU2M_MIN_ZS! air relative humidity at 2 m (-)
- REAL, POINTER, DIMENSION(:) :: XPS ! air pressure at the surface (Pa)
- REAL, POINTER, DIMENSION(:) :: XRHOA ! air density at the surface (kg/m3)
- REAL, POINTER, DIMENSION(:) :: XAVG_QS
- REAL, POINTER, DIMENSION(:) :: XAVG_Z0 ! roughness length for momentum (m)
- REAL, POINTER, DIMENSION(:) :: XAVG_Z0H ! roughness length for heat (m)
- REAL, POINTER, DIMENSION(:) :: XAVG_SWD ! short wave downward radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_SWU ! short wave upward radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LWD ! longt wave downward radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LWU ! longt wave upward radiation (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XAVG_SWBD ! short wave downward radiation by spectral band(W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XAVG_SWBU ! short wave upward radiation by spectral band(W/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_FMU ! zonal friction
- REAL, POINTER, DIMENSION(:) :: XAVG_FMV ! meridian friction
- REAL, POINTER, DIMENSION(:) :: XSSO_FMU ! zonal friction (with SSO) (Pa)
- REAL, POINTER, DIMENSION(:) :: XSSO_FMV ! meridian friction (with SSO) (Pa)
-!
- REAL, POINTER, DIMENSION(:) :: XDIAG_UREF ! reference height for momentum (m)
- REAL, POINTER, DIMENSION(:) :: XDIAG_ZREF ! reference height for heat (m)
- REAL, POINTER, DIMENSION(:) :: XDIAG_TRAD ! radiative temperature at t (K)
- REAL, POINTER, DIMENSION(:) :: XDIAG_EMIS ! surface emissivity at t (-)
-!
- REAL, POINTER, DIMENSION(:) :: XAVG_T2M_MIN ! Minimun air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XAVG_T2M_MAX ! Maximum air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XAVG_HU2M_MIN! Minimun air relative humidity at 2 meters(-)
- REAL, POINTER, DIMENSION(:) :: XAVG_HU2M_MAX! Maximum air relative humidity at 2 meters(-)
- REAL, POINTER, DIMENSION(:) :: XAVG_WIND10M ! wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XAVG_WIND10M_MAX ! Maximum wind at 10 meters (m/s)
-!
-!* cumulated averaged variables
-!
- REAL, POINTER, DIMENSION(:) :: XAVG_RNC ! net radiation at surface (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_HC ! sensible heat flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LEC ! total latent heat flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LEIC ! sublimation latent heat flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_GFLUXC ! net soil-vegetation flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_EVAPC ! total evapotranspiration (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_SUBLC ! sublimation (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_SWDC ! short wave downward radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_SWUC ! short wave upward radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LWDC ! longt wave downward radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_LWUC ! longt wave upward radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XAVG_FMUC ! zonal friction
- REAL, POINTER, DIMENSION(:) :: XAVG_FMVC ! meridian friction
-!
-!------------------------------------------------------------------------------
-!
-
-END TYPE DIAG_SURF_ATM_t
-
-
-
- CONTAINS
-
-!
-
-
-!
-
-SUBROUTINE DIAG_SURF_ATM_INIT(YDIAG_SURF_ATM)
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: YDIAG_SURF_ATM
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_SURF_ATM_N:DIAG_SURF_ATM_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YDIAG_SURF_ATM%XRI_TILE)
- NULLIFY(YDIAG_SURF_ATM%XCD_TILE)
- NULLIFY(YDIAG_SURF_ATM%XCH_TILE)
- NULLIFY(YDIAG_SURF_ATM%XCE_TILE)
- NULLIFY(YDIAG_SURF_ATM%XRN_TILE)
- NULLIFY(YDIAG_SURF_ATM%XH_TILE)
- NULLIFY(YDIAG_SURF_ATM%XLE_TILE)
- NULLIFY(YDIAG_SURF_ATM%XLEI_TILE)
- NULLIFY(YDIAG_SURF_ATM%XGFLUX_TILE)
- NULLIFY(YDIAG_SURF_ATM%XEVAP_TILE)
- NULLIFY(YDIAG_SURF_ATM%XSUBL_TILE)
- NULLIFY(YDIAG_SURF_ATM%XTS_TILE)
- NULLIFY(YDIAG_SURF_ATM%XT2M_TILE)
- NULLIFY(YDIAG_SURF_ATM%XT2M_MIN_TILE)
- NULLIFY(YDIAG_SURF_ATM%XT2M_MAX_TILE)
- NULLIFY(YDIAG_SURF_ATM%XQ2M_TILE)
- NULLIFY(YDIAG_SURF_ATM%XHU2M_TILE)
- NULLIFY(YDIAG_SURF_ATM%XHU2M_MIN_TILE)
- NULLIFY(YDIAG_SURF_ATM%XHU2M_MAX_TILE)
- NULLIFY(YDIAG_SURF_ATM%XZON10M_TILE)
- NULLIFY(YDIAG_SURF_ATM%XMER10M_TILE)
- NULLIFY(YDIAG_SURF_ATM%XWIND10M_TILE)
- NULLIFY(YDIAG_SURF_ATM%XWIND10M_MAX_TILE)
- NULLIFY(YDIAG_SURF_ATM%XQS_TILE)
- NULLIFY(YDIAG_SURF_ATM%XZ0_TILE)
- NULLIFY(YDIAG_SURF_ATM%XZ0H_TILE)
- NULLIFY(YDIAG_SURF_ATM%XSWD_TILE)
- NULLIFY(YDIAG_SURF_ATM%XSWU_TILE)
- NULLIFY(YDIAG_SURF_ATM%XLWD_TILE)
- NULLIFY(YDIAG_SURF_ATM%XLWU_TILE)
- NULLIFY(YDIAG_SURF_ATM%XSWBD_TILE)
- NULLIFY(YDIAG_SURF_ATM%XSWBU_TILE)
- NULLIFY(YDIAG_SURF_ATM%XFMU_TILE)
- NULLIFY(YDIAG_SURF_ATM%XFMV_TILE)
- NULLIFY(YDIAG_SURF_ATM%XRNC_TILE)
- NULLIFY(YDIAG_SURF_ATM%XHC_TILE)
- NULLIFY(YDIAG_SURF_ATM%XLEC_TILE)
- NULLIFY(YDIAG_SURF_ATM%XLEIC_TILE)
- NULLIFY(YDIAG_SURF_ATM%XGFLUXC_TILE)
- NULLIFY(YDIAG_SURF_ATM%XEVAPC_TILE)
- NULLIFY(YDIAG_SURF_ATM%XSUBLC_TILE)
- NULLIFY(YDIAG_SURF_ATM%XSWDC_TILE)
- NULLIFY(YDIAG_SURF_ATM%XSWUC_TILE)
- NULLIFY(YDIAG_SURF_ATM%XLWDC_TILE)
- NULLIFY(YDIAG_SURF_ATM%XLWUC_TILE)
- NULLIFY(YDIAG_SURF_ATM%XFMUC_TILE)
- NULLIFY(YDIAG_SURF_ATM%XFMVC_TILE)
- NULLIFY(YDIAG_SURF_ATM%XAVG_RI)
- NULLIFY(YDIAG_SURF_ATM%XAVG_CD)
- NULLIFY(YDIAG_SURF_ATM%XAVG_CH)
- NULLIFY(YDIAG_SURF_ATM%XAVG_CE)
- NULLIFY(YDIAG_SURF_ATM%XAVG_RN)
- NULLIFY(YDIAG_SURF_ATM%XAVG_H)
- NULLIFY(YDIAG_SURF_ATM%XAVG_LE)
- NULLIFY(YDIAG_SURF_ATM%XAVG_LEI)
- NULLIFY(YDIAG_SURF_ATM%XAVG_GFLUX)
- NULLIFY(YDIAG_SURF_ATM%XAVG_EVAP)
- NULLIFY(YDIAG_SURF_ATM%XAVG_SUBL)
- NULLIFY(YDIAG_SURF_ATM%XAVG_TS)
- NULLIFY(YDIAG_SURF_ATM%XAVG_T2M)
- NULLIFY(YDIAG_SURF_ATM%XAVG_Q2M)
- NULLIFY(YDIAG_SURF_ATM%XAVG_HU2M)
- NULLIFY(YDIAG_SURF_ATM%XAVG_ZON10M)
- NULLIFY(YDIAG_SURF_ATM%XAVG_MER10M)
- NULLIFY(YDIAG_SURF_ATM%XAVG_SFCO2)
- NULLIFY(YDIAG_SURF_ATM%XAVG_T2M_MIN_ZS)
- NULLIFY(YDIAG_SURF_ATM%XAVG_Q2M_MIN_ZS)
- NULLIFY(YDIAG_SURF_ATM%XAVG_HU2M_MIN_ZS)
- NULLIFY(YDIAG_SURF_ATM%XPS)
- NULLIFY(YDIAG_SURF_ATM%XRHOA)
- NULLIFY(YDIAG_SURF_ATM%XAVG_QS)
- NULLIFY(YDIAG_SURF_ATM%XAVG_Z0)
- NULLIFY(YDIAG_SURF_ATM%XAVG_Z0H)
- NULLIFY(YDIAG_SURF_ATM%XAVG_SWD)
- NULLIFY(YDIAG_SURF_ATM%XAVG_SWU)
- NULLIFY(YDIAG_SURF_ATM%XAVG_LWD)
- NULLIFY(YDIAG_SURF_ATM%XAVG_LWU)
- NULLIFY(YDIAG_SURF_ATM%XAVG_SWBD)
- NULLIFY(YDIAG_SURF_ATM%XAVG_SWBU)
- NULLIFY(YDIAG_SURF_ATM%XAVG_FMU)
- NULLIFY(YDIAG_SURF_ATM%XAVG_FMV)
- NULLIFY(YDIAG_SURF_ATM%XSSO_FMU)
- NULLIFY(YDIAG_SURF_ATM%XSSO_FMV)
- NULLIFY(YDIAG_SURF_ATM%XDIAG_UREF)
- NULLIFY(YDIAG_SURF_ATM%XDIAG_ZREF)
- NULLIFY(YDIAG_SURF_ATM%XDIAG_TRAD)
- NULLIFY(YDIAG_SURF_ATM%XDIAG_EMIS)
- NULLIFY(YDIAG_SURF_ATM%XAVG_T2M_MIN)
- NULLIFY(YDIAG_SURF_ATM%XAVG_T2M_MAX)
- NULLIFY(YDIAG_SURF_ATM%XAVG_HU2M_MIN)
- NULLIFY(YDIAG_SURF_ATM%XAVG_HU2M_MAX)
- NULLIFY(YDIAG_SURF_ATM%XAVG_WIND10M)
- NULLIFY(YDIAG_SURF_ATM%XAVG_WIND10M_MAX)
- NULLIFY(YDIAG_SURF_ATM%XAVG_RNC)
- NULLIFY(YDIAG_SURF_ATM%XAVG_HC)
- NULLIFY(YDIAG_SURF_ATM%XAVG_LEC)
- NULLIFY(YDIAG_SURF_ATM%XAVG_LEIC)
- NULLIFY(YDIAG_SURF_ATM%XAVG_GFLUXC)
- NULLIFY(YDIAG_SURF_ATM%XAVG_EVAPC)
- NULLIFY(YDIAG_SURF_ATM%XAVG_SUBLC)
- NULLIFY(YDIAG_SURF_ATM%XAVG_SWDC)
- NULLIFY(YDIAG_SURF_ATM%XAVG_SWUC)
- NULLIFY(YDIAG_SURF_ATM%XAVG_LWDC)
- NULLIFY(YDIAG_SURF_ATM%XAVG_LWUC)
- NULLIFY(YDIAG_SURF_ATM%XAVG_FMUC)
- NULLIFY(YDIAG_SURF_ATM%XAVG_FMVC)
- NULLIFY(YDIAG_SURF_ATM%CSELECT)
-YDIAG_SURF_ATM%XDIAG_TSTEP=0.
-YDIAG_SURF_ATM%N2M=0
-YDIAG_SURF_ATM%LT2MMW=.FALSE.
-YDIAG_SURF_ATM%L2M_MIN_ZS=.FALSE.
-YDIAG_SURF_ATM%LSURF_BUDGET=.FALSE.
-YDIAG_SURF_ATM%LRAD_BUDGET=.FALSE.
-YDIAG_SURF_ATM%LCOEF=.FALSE.
-YDIAG_SURF_ATM%LSURF_VARS=.FALSE.
-YDIAG_SURF_ATM%LFRAC=.FALSE.
-YDIAG_SURF_ATM%LDIAG_GRID=.FALSE.
-YDIAG_SURF_ATM%LSURF_BUDGETC=.FALSE.
-YDIAG_SURF_ATM%LRESET_BUDGETC=.FALSE.
-YDIAG_SURF_ATM%LREAD_BUDGETC=.FALSE.
-YDIAG_SURF_ATM%LPROVAR_TO_DIAG=.FALSE.
-YDIAG_SURF_ATM%LSELECT=.FALSE.
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_SURF_ATM_N:DIAG_SURF_ATM_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE DIAG_SURF_ATM_INIT
-
-
-END MODULE MODD_DIAG_SURF_ATM_n
diff --git a/src/SURFEX/modd_diag_teb_gardenn.F90 b/src/SURFEX/modd_diag_teb_gardenn.F90
deleted file mode 100644
index 0fa77e30e84ad4924bae5bdbc0f622582603b5b2..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_diag_teb_gardenn.F90
+++ /dev/null
@@ -1,231 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-!######################
-MODULE MODD_DIAG_TEB_GARDEN_n
-!######################
-!
-!!**** *MODD_DIAG_TEB_GARDEN - declaration of diagnostics for ISBA scheme
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! Modified 01/2006 : sea flux parameterization.
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE DIAG_TEB_GARDEN_t
-!------------------------------------------------------------------------------
-!
-!* variables for one patch
-!
- REAL, POINTER, DIMENSION(:) :: XRI ! Bulk-Richardson number (-)
- REAL, POINTER, DIMENSION(:) :: XCD ! drag coefficient for wind (W/s2)
- REAL, POINTER, DIMENSION(:) :: XCH ! drag coefficient for heat (W/s)
- REAL, POINTER, DIMENSION(:) :: XCE ! drag coefficient for vapor (W/s/K)
- REAL, POINTER, DIMENSION(:) :: XRN ! net radiation at surface (W/m2)
- REAL, POINTER, DIMENSION(:) :: XH ! sensible heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XGFLUX ! net soil-vegetation flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XTS ! surface temperature (K)
- REAL, POINTER, DIMENSION(:) :: XTSRAD ! radiative surface temperature (K)
- REAL, POINTER, DIMENSION(:) :: XQS ! humidity at surface (kg/kg)
- REAL, POINTER, DIMENSION(:) :: XLWD ! downward long wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLWU ! upward long wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XSWD ! downward short wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XSWU ! upward short wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSWBD ! downward short wave radiation by spectral band (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSWBU ! upward short wave radiation by spectral band (W/m2)
- REAL, POINTER, DIMENSION(:) :: XFMU ! horizontal momentum flux zonal (m2/s2)
- REAL, POINTER, DIMENSION(:) :: XFMV ! horizontal momentum flux meridian (m2/s2)
- !
- REAL, POINTER, DIMENSION(:) :: XZ0_WITH_SNOW ! roughness length for momentum
- ! for vegetation and snow (m)
- REAL, POINTER, DIMENSION(:) :: XZ0H_WITH_SNOW ! roughness length for heat
- ! for vegetation and snow (m)
- REAL, POINTER, DIMENSION(:) :: XZ0EFF ! effective roughness length for heat
- ! for vegetation and snow (m)
-!
- REAL, POINTER, DIMENSION(:) :: XLEI ! sublimation latent heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLEG ! latent heat of evaporation over the ground (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLEGI ! surface soil ice sublimation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLEV ! latent heat of evaporation over vegetation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLES ! latent heat of evaporation over the snow (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLER ! evaporation from canopy water interception (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLETR ! evapotranspiration of the vegetation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XEVAP ! evapotranspiration (W/m2)
- REAL, POINTER, DIMENSION(:) :: XDRAIN ! soil drainage flux (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XRUNOFF ! sub-grid and supersaturation runoff (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XHORT ! sub-grid Horton runoff from the SGH scheme (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XRRVEG ! precipitation intercepted by the vegetation (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XMELT ! snow melt (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XDRIP ! dripping from the vegetation reservoir (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XIRRIG_FLUX ! irrigation rate (as soil input) (kg/m2/s)
-
-!
-!* pack diag
-!
- REAL, POINTER, DIMENSION(:) :: XCG ! heat capacity of the ground
- REAL, POINTER, DIMENSION(:) :: XC1 ! coefficients for the moisure
- REAL, POINTER, DIMENSION(:) :: XC2 ! equation.
- REAL, POINTER, DIMENSION(:) :: XWGEQ ! equilibrium volumetric water content
- REAL, POINTER, DIMENSION(:) :: XCT ! area-averaged heat capacity
- REAL, POINTER, DIMENSION(:) :: XRS ! stomatal resistance (s/m)
- REAL, POINTER, DIMENSION(:) :: XCDN ! neutral drag coefficient (-)
- REAL, POINTER, DIMENSION(:) :: XHU ! area averaged surface humidity coefficient (-)
- REAL, POINTER, DIMENSION(:) :: XHUG ! baresoil surface humidity coefficient (-)
- REAL, POINTER, DIMENSION(:) :: XRESTORE ! surface energy budget restore term (W/m2)
- REAL, POINTER, DIMENSION(:) :: XUSTAR ! friction velocity (m/s)
- REAL, POINTER, DIMENSION(:,:) :: XIACAN ! PAR in the canopy at different gauss level (micmolphot/m2/s)
-!
-! for ISBA-ES:3-L
- REAL, POINTER, DIMENSION(:,:) :: XSNOWTEMP ! snow temperature profile (ISBA-ES:3-L) (K)
- REAL, POINTER, DIMENSION(:,:) :: XSNOWLIQ ! snow liquid water profile (ISBA-ES:3-L) (m)
- REAL, POINTER, DIMENSION(:,:) :: XSNOWDZ ! snow layer thicknesses (m)
- REAL, POINTER, DIMENSION(:) :: XSNOWHMASS ! heat content change due to mass changes in snowpack (J/m2)
- REAL, POINTER, DIMENSION(:) :: XMELTADV ! advective energy from snow melt water!
-!
-!* budget summation variables for one patch
-!
-!
- REAL, POINTER, DIMENSION(:) :: XHV ! Halstead coefficient
-!
- REAL, POINTER, DIMENSION(:,:) :: XSWI ! Soil wetness index
- REAL, POINTER, DIMENSION(:,:) :: XTSWI ! Total soil wetness index
-!
- REAL, POINTER, DIMENSION(:) :: XTWSNOW ! Total snow reservoir
- REAL, POINTER, DIMENSION(:) :: XTDSNOW ! Total snow height
-!
- REAL, POINTER, DIMENSION(:) :: XALBT ! Total Albedo
- REAL, POINTER, DIMENSION(:) :: XEMIST ! averaged emissivity (-)
-!
- REAL, POINTER, DIMENSION(:) :: XSEUIL ! Irrigation threshold
-!
- REAL, POINTER, DIMENSION(:) :: XGPP ! Gross Primary Production
- REAL, POINTER, DIMENSION(:) :: XRESP_AUTO ! Autotrophic respiration
- REAL, POINTER, DIMENSION(:) :: XRESP_ECO ! Ecosystem respiration
- REAL, POINTER, DIMENSION(:) :: XFAPAR ! Fapar of vegetation
- REAL, POINTER, DIMENSION(:) :: XFAPIR ! Fapir of vegetation
- REAL, POINTER, DIMENSION(:) :: XDFAPARC ! Fapar of vegetation (cumul)
- REAL, POINTER, DIMENSION(:) :: XDFAPIRC ! Fapir of vegetation (cumul)
- REAL, POINTER, DIMENSION(:) :: XFAPAR_BS ! Fapar of bare soil
- REAL, POINTER, DIMENSION(:) :: XFAPIR_BS ! Fapir of bare soil
- REAL, POINTER, DIMENSION(:) :: XDLAI_EFFC ! Effective LAI (cumul)
-!
-!------------------------------------------------------------------------------
-!
-
-END TYPE DIAG_TEB_GARDEN_t
-
-
-
- CONTAINS
-
-!
-
-
-
-
-SUBROUTINE DIAG_TEB_GARDEN_INIT(YDIAG_TEB_GARDEN)
-TYPE(DIAG_TEB_GARDEN_t), INTENT(INOUT) :: YDIAG_TEB_GARDEN
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_TEB_GARDEN_N:DIAG_TEB_GARDEN_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YDIAG_TEB_GARDEN%XRI)
- NULLIFY(YDIAG_TEB_GARDEN%XCD)
- NULLIFY(YDIAG_TEB_GARDEN%XCH)
- NULLIFY(YDIAG_TEB_GARDEN%XCE)
- NULLIFY(YDIAG_TEB_GARDEN%XRN)
- NULLIFY(YDIAG_TEB_GARDEN%XH)
- NULLIFY(YDIAG_TEB_GARDEN%XGFLUX)
- NULLIFY(YDIAG_TEB_GARDEN%XTS)
- NULLIFY(YDIAG_TEB_GARDEN%XTSRAD)
- NULLIFY(YDIAG_TEB_GARDEN%XQS)
- NULLIFY(YDIAG_TEB_GARDEN%XLWD)
- NULLIFY(YDIAG_TEB_GARDEN%XLWU)
- NULLIFY(YDIAG_TEB_GARDEN%XSWD)
- NULLIFY(YDIAG_TEB_GARDEN%XSWU)
- NULLIFY(YDIAG_TEB_GARDEN%XSWBD)
- NULLIFY(YDIAG_TEB_GARDEN%XSWBU)
- NULLIFY(YDIAG_TEB_GARDEN%XFMU)
- NULLIFY(YDIAG_TEB_GARDEN%XFMV)
- NULLIFY(YDIAG_TEB_GARDEN%XZ0_WITH_SNOW)
- NULLIFY(YDIAG_TEB_GARDEN%XZ0H_WITH_SNOW)
- NULLIFY(YDIAG_TEB_GARDEN%XZ0EFF)
- NULLIFY(YDIAG_TEB_GARDEN%XLEI)
- NULLIFY(YDIAG_TEB_GARDEN%XLEG)
- NULLIFY(YDIAG_TEB_GARDEN%XLEGI)
- NULLIFY(YDIAG_TEB_GARDEN%XLEV)
- NULLIFY(YDIAG_TEB_GARDEN%XLES)
- NULLIFY(YDIAG_TEB_GARDEN%XLER)
- NULLIFY(YDIAG_TEB_GARDEN%XLETR)
- NULLIFY(YDIAG_TEB_GARDEN%XEVAP)
- NULLIFY(YDIAG_TEB_GARDEN%XDRAIN)
- NULLIFY(YDIAG_TEB_GARDEN%XRUNOFF)
- NULLIFY(YDIAG_TEB_GARDEN%XHORT)
- NULLIFY(YDIAG_TEB_GARDEN%XRRVEG)
- NULLIFY(YDIAG_TEB_GARDEN%XMELT)
- NULLIFY(YDIAG_TEB_GARDEN%XDRIP)
- NULLIFY(YDIAG_TEB_GARDEN%XIRRIG_FLUX)
- NULLIFY(YDIAG_TEB_GARDEN%XCG)
- NULLIFY(YDIAG_TEB_GARDEN%XC1)
- NULLIFY(YDIAG_TEB_GARDEN%XC2)
- NULLIFY(YDIAG_TEB_GARDEN%XWGEQ)
- NULLIFY(YDIAG_TEB_GARDEN%XCT)
- NULLIFY(YDIAG_TEB_GARDEN%XRS)
- NULLIFY(YDIAG_TEB_GARDEN%XCDN)
- NULLIFY(YDIAG_TEB_GARDEN%XHU)
- NULLIFY(YDIAG_TEB_GARDEN%XHUG)
- NULLIFY(YDIAG_TEB_GARDEN%XRESTORE)
- NULLIFY(YDIAG_TEB_GARDEN%XUSTAR)
- NULLIFY(YDIAG_TEB_GARDEN%XIACAN)
- NULLIFY(YDIAG_TEB_GARDEN%XSNOWTEMP)
- NULLIFY(YDIAG_TEB_GARDEN%XSNOWLIQ)
- NULLIFY(YDIAG_TEB_GARDEN%XSNOWDZ)
- NULLIFY(YDIAG_TEB_GARDEN%XSNOWHMASS)
- NULLIFY(YDIAG_TEB_GARDEN%XMELTADV)
- NULLIFY(YDIAG_TEB_GARDEN%XHV)
- NULLIFY(YDIAG_TEB_GARDEN%XSWI)
- NULLIFY(YDIAG_TEB_GARDEN%XTSWI)
- NULLIFY(YDIAG_TEB_GARDEN%XTWSNOW)
- NULLIFY(YDIAG_TEB_GARDEN%XTDSNOW)
- NULLIFY(YDIAG_TEB_GARDEN%XALBT)
- NULLIFY(YDIAG_TEB_GARDEN%XEMIST)
- NULLIFY(YDIAG_TEB_GARDEN%XSEUIL)
- NULLIFY(YDIAG_TEB_GARDEN%XGPP)
- NULLIFY(YDIAG_TEB_GARDEN%XRESP_AUTO)
- NULLIFY(YDIAG_TEB_GARDEN%XRESP_ECO)
- NULLIFY(YDIAG_TEB_GARDEN%XFAPAR)
- NULLIFY(YDIAG_TEB_GARDEN%XFAPIR)
- NULLIFY(YDIAG_TEB_GARDEN%XDFAPARC)
- NULLIFY(YDIAG_TEB_GARDEN%XDFAPIRC)
- NULLIFY(YDIAG_TEB_GARDEN%XFAPAR_BS)
- NULLIFY(YDIAG_TEB_GARDEN%XFAPIR_BS)
- NULLIFY(YDIAG_TEB_GARDEN%XDLAI_EFFC)
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_TEB_GARDEN_N:DIAG_TEB_GARDEN_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE DIAG_TEB_GARDEN_INIT
-
-
-END MODULE MODD_DIAG_TEB_GARDEN_n
diff --git a/src/SURFEX/modd_diag_teb_greenroofn.F90 b/src/SURFEX/modd_diag_teb_greenroofn.F90
deleted file mode 100644
index dc42a753d74f1f7e028b8a8b25edece028dfc6ef..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_diag_teb_greenroofn.F90
+++ /dev/null
@@ -1,212 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-!######################
-MODULE MODD_DIAG_TEB_GREENROOF_n
-!######################
-!
-!!**** *MODD_DIAG_TEB_GREENROOF - declaration of diagnostics for ISBA scheme
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!! Based on modd_diag_teb_gardenn
-!!
-!! AUTHOR
-!! ------
-!! C. de Munck & A. Lemonsu *Meteo France
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/2011
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE DIAG_TEB_GREENROOF_t
-!------------------------------------------------------------------------------
-!
-!* variables for one patch
-!
- REAL, POINTER, DIMENSION(:) :: XRI ! Bulk-Richardson number (-)
- REAL, POINTER, DIMENSION(:) :: XCD ! drag coefficient for wind (W/s2)
- REAL, POINTER, DIMENSION(:) :: XCH ! drag coefficient for heat (W/s)
- REAL, POINTER, DIMENSION(:) :: XCE ! drag coefficient for vapor (W/s/K)
- REAL, POINTER, DIMENSION(:) :: XRN ! net radiation at surface (W/m2)
- REAL, POINTER, DIMENSION(:) :: XH ! sensible heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XGFLUX ! net soil-vegetation flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XTS ! surface temperature (K)
- REAL, POINTER, DIMENSION(:) :: XTSRAD ! radiative surface temperature (K)
- REAL, POINTER, DIMENSION(:) :: XQS ! humidity at surface (kg/kg)
- REAL, POINTER, DIMENSION(:) :: XLWD ! downward long wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLWU ! upward long wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XSWD ! downward short wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XSWU ! upward short wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSWBD ! downward short wave radiation by spectral band (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSWBU ! upward short wave radiation by spectral band (W/m2)
- REAL, POINTER, DIMENSION(:) :: XFMU ! horizontal momentum flux zonal (m2/s2)
- REAL, POINTER, DIMENSION(:) :: XFMV ! horizontal momentum flux meridian (m2/s2)
- !
- REAL, POINTER, DIMENSION(:) :: XZ0_WITH_SNOW ! roughness length for momentum
- ! for vegetation and snow (m)
- REAL, POINTER, DIMENSION(:) :: XZ0H_WITH_SNOW ! roughness length for heat
- ! for vegetation and snow (m)
- REAL, POINTER, DIMENSION(:) :: XZ0EFF ! effective roughness length for heat
- ! for vegetation and snow (m)
-!
- REAL, POINTER, DIMENSION(:) :: XLEI ! sublimation latent heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLEG ! latent heat of evaporation over the ground (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLEGI ! surface soil ice sublimation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLEV ! latent heat of evaporation over vegetation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLES ! latent heat of evaporation over the snow (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLER ! evaporation from canopy water interception (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLETR ! evapotranspiration of the vegetation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XEVAP ! evapotranspiration (W/m2)
- REAL, POINTER, DIMENSION(:) :: XDRAIN ! soil drainage flux (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XRUNOFF ! sub-grid and supersaturation runoff (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XHORT ! sub-grid Horton runoff from the SGH scheme (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XRRVEG ! precipitation intercepted by the vegetation (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XMELT ! snow melt (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XDRIP ! dripping from the vegetation reservoir (kg/m2/s)
-!
-!* pack diag
-!
- REAL, POINTER, DIMENSION(:) :: XCG ! heat capacity of the ground
- REAL, POINTER, DIMENSION(:) :: XC1 ! coefficients for the moisure
- REAL, POINTER, DIMENSION(:) :: XC2 ! equation.
- REAL, POINTER, DIMENSION(:) :: XWGEQ ! equilibrium volumetric water content
- REAL, POINTER, DIMENSION(:) :: XCT ! area-averaged heat capacity
- REAL, POINTER, DIMENSION(:) :: XRS ! stomatal resistance (s/m)
- REAL, POINTER, DIMENSION(:) :: XCDN ! neutral drag coefficient (-)
- REAL, POINTER, DIMENSION(:) :: XHU ! area averaged surface humidity coefficient (-)
- REAL, POINTER, DIMENSION(:) :: XHUG ! baresoil surface humidity coefficient (-)
- REAL, POINTER, DIMENSION(:) :: XRESTORE ! surface energy budget restore term (W/m2)
- REAL, POINTER, DIMENSION(:) :: XUSTAR ! friction velocity (m/s)
- REAL, POINTER, DIMENSION(:,:) :: XIACAN ! PAR in the canopy at different gauss level (micmolphot/m2/s)
-!
-! for ISBA-ES:3-L
- REAL, POINTER, DIMENSION(:,:) :: XSNOWTEMP ! snow temperature profile (ISBA-ES:3-L) (K)
- REAL, POINTER, DIMENSION(:,:) :: XSNOWLIQ ! snow liquid water profile (ISBA-ES:3-L) (m)
- REAL, POINTER, DIMENSION(:,:) :: XSNOWDZ ! snow layer thicknesses (m)
- REAL, POINTER, DIMENSION(:) :: XSNOWHMASS ! heat content change due to mass changes in snowpack (J/m2)
- REAL, POINTER, DIMENSION(:) :: XMELTADV ! advective energy from snow melt water!
-!
-!* budget summation variables for one patch
-!
-!
- REAL, POINTER, DIMENSION(:) :: XHV ! Halstead coefficient
-!
- REAL, POINTER, DIMENSION(:,:) :: XSWI ! Soil wetness index
- REAL, POINTER, DIMENSION(:,:) :: XTSWI ! Total soil wetness index
-!
- REAL, POINTER, DIMENSION(:) :: XTWSNOW ! Total snow reservoir
- REAL, POINTER, DIMENSION(:) :: XTDSNOW ! Total snow height
-!
- REAL, POINTER, DIMENSION(:) :: XALBT ! Total Albedo
- REAL, POINTER, DIMENSION(:) :: XEMIST ! averaged emissivity (-)
-!
- REAL, POINTER, DIMENSION(:) :: XSEUIL ! Irrigation threshold
-!
- REAL, POINTER, DIMENSION(:) :: XGPP ! Gross Primary Production
- REAL, POINTER, DIMENSION(:) :: XRESP_AUTO ! Autotrophic respiration
- REAL, POINTER, DIMENSION(:) :: XRESP_ECO ! Ecosystem respiration
-!
-!------------------------------------------------------------------------------
-!
-
-END TYPE DIAG_TEB_GREENROOF_t
-
-
-
- CONTAINS
-
-!
-
-
-
-
-SUBROUTINE DIAG_TEB_GREENROOF_INIT(YDIAG_TEB_GREENROOF)
-TYPE(DIAG_TEB_GREENROOF_t), INTENT(INOUT) :: YDIAG_TEB_GREENROOF
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_TEB_GREENROOF_N:DIAG_TEB_GREENROOF_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YDIAG_TEB_GREENROOF%XRI)
- NULLIFY(YDIAG_TEB_GREENROOF%XCD)
- NULLIFY(YDIAG_TEB_GREENROOF%XCH)
- NULLIFY(YDIAG_TEB_GREENROOF%XCE)
- NULLIFY(YDIAG_TEB_GREENROOF%XRN)
- NULLIFY(YDIAG_TEB_GREENROOF%XH)
- NULLIFY(YDIAG_TEB_GREENROOF%XGFLUX)
- NULLIFY(YDIAG_TEB_GREENROOF%XTS)
- NULLIFY(YDIAG_TEB_GREENROOF%XTSRAD)
- NULLIFY(YDIAG_TEB_GREENROOF%XQS)
- NULLIFY(YDIAG_TEB_GREENROOF%XLWD)
- NULLIFY(YDIAG_TEB_GREENROOF%XLWU)
- NULLIFY(YDIAG_TEB_GREENROOF%XSWD)
- NULLIFY(YDIAG_TEB_GREENROOF%XSWU)
- NULLIFY(YDIAG_TEB_GREENROOF%XSWBD)
- NULLIFY(YDIAG_TEB_GREENROOF%XSWBU)
- NULLIFY(YDIAG_TEB_GREENROOF%XFMU)
- NULLIFY(YDIAG_TEB_GREENROOF%XFMV)
- NULLIFY(YDIAG_TEB_GREENROOF%XZ0_WITH_SNOW)
- NULLIFY(YDIAG_TEB_GREENROOF%XZ0H_WITH_SNOW)
- NULLIFY(YDIAG_TEB_GREENROOF%XZ0EFF)
- NULLIFY(YDIAG_TEB_GREENROOF%XLEI)
- NULLIFY(YDIAG_TEB_GREENROOF%XLEG)
- NULLIFY(YDIAG_TEB_GREENROOF%XLEGI)
- NULLIFY(YDIAG_TEB_GREENROOF%XLEV)
- NULLIFY(YDIAG_TEB_GREENROOF%XLES)
- NULLIFY(YDIAG_TEB_GREENROOF%XLER)
- NULLIFY(YDIAG_TEB_GREENROOF%XLETR)
- NULLIFY(YDIAG_TEB_GREENROOF%XEVAP)
- NULLIFY(YDIAG_TEB_GREENROOF%XDRAIN)
- NULLIFY(YDIAG_TEB_GREENROOF%XRUNOFF)
- NULLIFY(YDIAG_TEB_GREENROOF%XHORT)
- NULLIFY(YDIAG_TEB_GREENROOF%XRRVEG)
- NULLIFY(YDIAG_TEB_GREENROOF%XMELT)
- NULLIFY(YDIAG_TEB_GREENROOF%XDRIP)
- NULLIFY(YDIAG_TEB_GREENROOF%XCG)
- NULLIFY(YDIAG_TEB_GREENROOF%XC1)
- NULLIFY(YDIAG_TEB_GREENROOF%XC2)
- NULLIFY(YDIAG_TEB_GREENROOF%XWGEQ)
- NULLIFY(YDIAG_TEB_GREENROOF%XCT)
- NULLIFY(YDIAG_TEB_GREENROOF%XRS)
- NULLIFY(YDIAG_TEB_GREENROOF%XCDN)
- NULLIFY(YDIAG_TEB_GREENROOF%XHU)
- NULLIFY(YDIAG_TEB_GREENROOF%XHUG)
- NULLIFY(YDIAG_TEB_GREENROOF%XRESTORE)
- NULLIFY(YDIAG_TEB_GREENROOF%XUSTAR)
- NULLIFY(YDIAG_TEB_GREENROOF%XIACAN)
- NULLIFY(YDIAG_TEB_GREENROOF%XSNOWTEMP)
- NULLIFY(YDIAG_TEB_GREENROOF%XSNOWLIQ)
- NULLIFY(YDIAG_TEB_GREENROOF%XSNOWDZ)
- NULLIFY(YDIAG_TEB_GREENROOF%XSNOWHMASS)
- NULLIFY(YDIAG_TEB_GREENROOF%XMELTADV)
- NULLIFY(YDIAG_TEB_GREENROOF%XHV)
- NULLIFY(YDIAG_TEB_GREENROOF%XSWI)
- NULLIFY(YDIAG_TEB_GREENROOF%XTSWI)
- NULLIFY(YDIAG_TEB_GREENROOF%XTWSNOW)
- NULLIFY(YDIAG_TEB_GREENROOF%XTDSNOW)
- NULLIFY(YDIAG_TEB_GREENROOF%XALBT)
- NULLIFY(YDIAG_TEB_GREENROOF%XEMIST)
- NULLIFY(YDIAG_TEB_GREENROOF%XSEUIL)
- NULLIFY(YDIAG_TEB_GREENROOF%XGPP)
- NULLIFY(YDIAG_TEB_GREENROOF%XRESP_AUTO)
- NULLIFY(YDIAG_TEB_GREENROOF%XRESP_ECO)
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_TEB_GREENROOF_N:DIAG_TEB_GREENROOF_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE DIAG_TEB_GREENROOF_INIT
-
-
-END MODULE MODD_DIAG_TEB_GREENROOF_n
diff --git a/src/SURFEX/modd_diag_tebn.F90 b/src/SURFEX/modd_diag_tebn.F90
deleted file mode 100644
index 18636515f673a4cda8939f078b60b3ebaadca17e..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_diag_tebn.F90
+++ /dev/null
@@ -1,155 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ######################
- MODULE MODD_DIAG_TEB_n
-! ######################
-!
-!!**** *MODD_DIAG_TEB - declaration of diagnostics for TEB scheme
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! Modified 01/2006 : sea flux parameterization.
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE DIAG_TEB_t
-!------------------------------------------------------------------------------
-!
- REAL :: XDIAG_TSTEP ! time step for diagnostics writing
-!
- INTEGER :: N2M ! flag for 2 meters (and 10 meters) quantities
- LOGICAL :: L2M_MIN_ZS ! flag for 2 meters quantities evaluated on
-! ! the minimum orographyy of the grid
- LOGICAL :: LSURF_BUDGET ! flag for surface energy budget
- LOGICAL :: LRAD_BUDGET ! flag for radiative energy budget
- LOGICAL :: LCOEF ! flag for transfer coefficients
- LOGICAL :: LSURF_VARS ! flag for surface variables
-!
- LOGICAL :: LPGD ! flag for writing of PGD files
- LOGICAL :: LPGD_FIX ! flag for writing of PGD files for time
-! invariant field
-!
-!* averaged variables
-!
- REAL, POINTER, DIMENSION(:) :: XRI ! Bulk-Richardson number (-)
- REAL, POINTER, DIMENSION(:) :: XCD ! drag coefficient for wind (W/s2)
- REAL, POINTER, DIMENSION(:) :: XCH ! drag coefficient for heat (W/s)
- REAL, POINTER, DIMENSION(:) :: XCE ! drag coefficient for vapor (W/s/K)
- REAL, POINTER, DIMENSION(:) :: XZ0 ! roughness length for momentum (m)
- REAL, POINTER, DIMENSION(:) :: XZ0H ! roughness length for heat (m)
- REAL, POINTER, DIMENSION(:) :: XRN ! net radiation at surface (W/m2)
- REAL, POINTER, DIMENSION(:) :: XH ! sensible heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLE ! latent heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XGFLUX ! net soil-vegetation flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XT2M ! air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XT2M_MIN ! Minimum air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XT2M_MAX ! Maximum air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XQ2M ! air humidity at 2 meters (kg/kg)
- REAL, POINTER, DIMENSION(:) :: XHU2M ! air relative humidity at 2 meters(-)
- REAL, POINTER, DIMENSION(:) :: XHU2M_MIN! Minimum relative humidity at 2 meters (-)
- REAL, POINTER, DIMENSION(:) :: XHU2M_MAX! Maximum relative humidity at 2 meters (-)
- REAL, POINTER, DIMENSION(:) :: XQS ! air humidity at surface (kg/kg)
- REAL, POINTER, DIMENSION(:) :: XZON10M ! zonal wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XMER10M ! meridian wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XWIND10M ! wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XWIND10M_MAX! Maximum wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XSFCO2 ! CO2 flux (m/s*kg_CO2/kg_air)
- REAL, POINTER, DIMENSION(:) :: XLWD ! downward long wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLWU ! upward long wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XSWD ! downward short wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XSWU ! upward short wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSWBD ! downward short wave radiation by spectral band (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSWBU ! upward short wave radiation by spectral band (W/m2)
- REAL, POINTER, DIMENSION(:) :: XFMU ! horizontal momentum flux zonal (m2/s2)
- REAL, POINTER, DIMENSION(:) :: XFMV ! horizontal momentum flux meridian (m2/s2)
- REAL, POINTER, DIMENSION(:) :: XDIAG_TS ! arithmetic mean of surface temperature (K)
-!------------------------------------------------------------------------------
-!
-
-END TYPE DIAG_TEB_t
-
-
-
- CONTAINS
-
-!
-
-
-
-
-SUBROUTINE DIAG_TEB_INIT(YDIAG_TEB)
-TYPE(DIAG_TEB_t), INTENT(INOUT) :: YDIAG_TEB
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_TEB_N:DIAG_TEB_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YDIAG_TEB%XRI)
- NULLIFY(YDIAG_TEB%XCD)
- NULLIFY(YDIAG_TEB%XCH)
- NULLIFY(YDIAG_TEB%XCE)
- NULLIFY(YDIAG_TEB%XZ0)
- NULLIFY(YDIAG_TEB%XZ0H)
- NULLIFY(YDIAG_TEB%XRN)
- NULLIFY(YDIAG_TEB%XH)
- NULLIFY(YDIAG_TEB%XLE)
- NULLIFY(YDIAG_TEB%XGFLUX)
- NULLIFY(YDIAG_TEB%XT2M)
- NULLIFY(YDIAG_TEB%XT2M_MIN)
- NULLIFY(YDIAG_TEB%XT2M_MAX)
- NULLIFY(YDIAG_TEB%XQ2M)
- NULLIFY(YDIAG_TEB%XHU2M)
- NULLIFY(YDIAG_TEB%XHU2M_MIN)
- NULLIFY(YDIAG_TEB%XHU2M_MAX)
- NULLIFY(YDIAG_TEB%XQS)
- NULLIFY(YDIAG_TEB%XZON10M)
- NULLIFY(YDIAG_TEB%XMER10M)
- NULLIFY(YDIAG_TEB%XWIND10M)
- NULLIFY(YDIAG_TEB%XWIND10M_MAX)
- NULLIFY(YDIAG_TEB%XSFCO2)
- NULLIFY(YDIAG_TEB%XLWD)
- NULLIFY(YDIAG_TEB%XLWU)
- NULLIFY(YDIAG_TEB%XSWD)
- NULLIFY(YDIAG_TEB%XSWU)
- NULLIFY(YDIAG_TEB%XSWBD)
- NULLIFY(YDIAG_TEB%XSWBU)
- NULLIFY(YDIAG_TEB%XFMU)
- NULLIFY(YDIAG_TEB%XFMV)
- NULLIFY(YDIAG_TEB%XDIAG_TS)
-YDIAG_TEB%XDIAG_TSTEP=0.
-YDIAG_TEB%N2M=0
-YDIAG_TEB%L2M_MIN_ZS=.FALSE.
-YDIAG_TEB%LSURF_BUDGET=.FALSE.
-YDIAG_TEB%LRAD_BUDGET=.FALSE.
-YDIAG_TEB%LCOEF=.FALSE.
-YDIAG_TEB%LSURF_VARS=.FALSE.
-YDIAG_TEB%LPGD=.FALSE.
-YDIAG_TEB%LPGD_FIX=.FALSE.
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_TEB_N:DIAG_TEB_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE DIAG_TEB_INIT
-
-
-END MODULE MODD_DIAG_TEB_n
diff --git a/src/SURFEX/modd_diag_utci_tebn.F90 b/src/SURFEX/modd_diag_utci_tebn.F90
index bda6f401945b2e359db6ea31d485cc78e35c45b7..8b30239b59748596a0b935f3b8b811caccec8d4c 100644
--- a/src/SURFEX/modd_diag_utci_tebn.F90
+++ b/src/SURFEX/modd_diag_utci_tebn.F90
@@ -56,7 +56,7 @@ END TYPE DIAG_UTCI_TEB_t
- CONTAINS
+CONTAINS
!
diff --git a/src/SURFEX/modd_diag_watfluxn.F90 b/src/SURFEX/modd_diag_watfluxn.F90
deleted file mode 100644
index 95c116b1cb0b60631cf30cbc12dbbe00472cfc67..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_diag_watfluxn.F90
+++ /dev/null
@@ -1,187 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ######################
- MODULE MODD_DIAG_WATFLUX_n
-! ######################
-!
-!!**** *MODD_DIAG_WATFLUX - declaration of diagnostics for WATFLUX scheme
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! Modified 01/2006 : sea flux parameterization.
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE DIAG_WATFLUX_t
-!------------------------------------------------------------------------------
-!
- REAL :: XDIAG_TSTEP ! time step for diagnostics writing
-!
- INTEGER :: N2M ! flag for 2 meters (and 10 meters) quantities
- LOGICAL :: L2M_MIN_ZS ! flag for 2 meters quantities evaluated on
-! ! the minimum orographyy of the grid
- LOGICAL :: LSURF_BUDGET ! flag for surface energy budget
- LOGICAL :: LRAD_BUDGET ! flag for radiative energy budget
- LOGICAL :: LCOEF ! flag for transfer coefficients
- LOGICAL :: LSURF_VARS ! flag for surface variables
- LOGICAL :: LSURF_BUDGETC ! flag for surface cumulated energy budget
- LOGICAL :: LRESET_BUDGETC ! flag for surface cumulated energy budget
-!
-!* averaged variables
-!
- REAL, POINTER, DIMENSION(:) :: XRI ! Bulk-Richardson number (-)
- REAL, POINTER, DIMENSION(:) :: XCD ! drag coefficient for wind (W/s2)
- REAL, POINTER, DIMENSION(:) :: XCH ! drag coefficient for heat (W/s)
- REAL, POINTER, DIMENSION(:) :: XCE ! drag coefficient for vapor (W/s/K)
- REAL, POINTER, DIMENSION(:) :: XZ0 ! roughness length for momentum (m)
- REAL, POINTER, DIMENSION(:) :: XZ0H ! roughness length for heat (m)
- REAL, POINTER, DIMENSION(:) :: XRN ! net radiation at surface (W/m2)
- REAL, POINTER, DIMENSION(:) :: XH ! sensible heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLE ! total latent heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLEI ! sublimation latent heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XGFLUX ! net soil-vegetation flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XEVAP ! total evaporation (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XSUBL ! sublimation (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XT2M ! air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XT2M_MIN ! Minimum air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XT2M_MAX ! Maximum air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XQ2M ! air humidity at 2 meters (kg/kg)
- REAL, POINTER, DIMENSION(:) :: XHU2M ! air relative humidity at 2 meters(-)
- REAL, POINTER, DIMENSION(:) :: XHU2M_MIN! Minimum relative humidity at 2 meters (-)
- REAL, POINTER, DIMENSION(:) :: XHU2M_MAX! Maximum relative humidity at 2 meters (-)
- REAL, POINTER, DIMENSION(:) :: XQS ! air humidity at surface (kg/kg)
- REAL, POINTER, DIMENSION(:) :: XZON10M ! zonal wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XMER10M ! meridian wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XWIND10M ! wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XWIND10M_MAX! Maximum wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XLWD ! downward long wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XLWU ! upward long wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XSWD ! downward short wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XSWU ! upward short wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSWBD ! downward short wave radiation by spectral band (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSWBU ! upward short wave radiation by spectral band (W/m2)
- REAL, POINTER, DIMENSION(:) :: XFMU ! horizontal momentum flux zonal (kg/ms2)
- REAL, POINTER, DIMENSION(:) :: XFMV ! horizontal momentum flux meridian (kg/ms2)
- REAL, POINTER, DIMENSION(:) :: XDIAG_TS ! water surface temperature (K)
-!
-!* cumulated averaged variables
-!
- REAL, POINTER, DIMENSION(:) :: XRNC ! net radiation at surface (J/m2)
- REAL, POINTER, DIMENSION(:) :: XHC ! sensible heat flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XLEC ! total latent heat flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XLEIC ! sublimation latent heat flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XGFLUXC ! net soil-vegetation flux (J/m2)
- REAL, POINTER, DIMENSION(:) :: XEVAPC ! total evaporation (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XSUBLC ! sublimation (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XLWDC ! downward long wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XLWUC ! upward long wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XSWDC ! downward short wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XSWUC ! upward short wave radiation (J/m2)
- REAL, POINTER, DIMENSION(:) :: XFMUC ! horizontal momentum flux zonal (kg/ms)
- REAL, POINTER, DIMENSION(:) :: XFMVC ! horizontal momentum flux meridian (kg/ms)
-!
-!------------------------------------------------------------------------------
-!
-
-END TYPE DIAG_WATFLUX_t
-
-
-
- CONTAINS
-
-!
-
-
-
-
-SUBROUTINE DIAG_WATFLUX_INIT(YDIAG_WATFLUX)
-TYPE(DIAG_WATFLUX_t), INTENT(INOUT) :: YDIAG_WATFLUX
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_WATFLUX_N:DIAG_WATFLUX_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YDIAG_WATFLUX%XRI)
- NULLIFY(YDIAG_WATFLUX%XCD)
- NULLIFY(YDIAG_WATFLUX%XCH)
- NULLIFY(YDIAG_WATFLUX%XCE)
- NULLIFY(YDIAG_WATFLUX%XZ0)
- NULLIFY(YDIAG_WATFLUX%XZ0H)
- NULLIFY(YDIAG_WATFLUX%XRN)
- NULLIFY(YDIAG_WATFLUX%XH)
- NULLIFY(YDIAG_WATFLUX%XLE)
- NULLIFY(YDIAG_WATFLUX%XLEI)
- NULLIFY(YDIAG_WATFLUX%XGFLUX)
- NULLIFY(YDIAG_WATFLUX%XEVAP)
- NULLIFY(YDIAG_WATFLUX%XSUBL)
- NULLIFY(YDIAG_WATFLUX%XT2M)
- NULLIFY(YDIAG_WATFLUX%XT2M_MIN)
- NULLIFY(YDIAG_WATFLUX%XT2M_MAX)
- NULLIFY(YDIAG_WATFLUX%XQ2M)
- NULLIFY(YDIAG_WATFLUX%XHU2M)
- NULLIFY(YDIAG_WATFLUX%XHU2M_MIN)
- NULLIFY(YDIAG_WATFLUX%XHU2M_MAX)
- NULLIFY(YDIAG_WATFLUX%XQS)
- NULLIFY(YDIAG_WATFLUX%XZON10M)
- NULLIFY(YDIAG_WATFLUX%XMER10M)
- NULLIFY(YDIAG_WATFLUX%XWIND10M)
- NULLIFY(YDIAG_WATFLUX%XWIND10M_MAX)
- NULLIFY(YDIAG_WATFLUX%XLWD)
- NULLIFY(YDIAG_WATFLUX%XLWU)
- NULLIFY(YDIAG_WATFLUX%XSWD)
- NULLIFY(YDIAG_WATFLUX%XSWU)
- NULLIFY(YDIAG_WATFLUX%XSWBD)
- NULLIFY(YDIAG_WATFLUX%XSWBU)
- NULLIFY(YDIAG_WATFLUX%XFMU)
- NULLIFY(YDIAG_WATFLUX%XFMV)
- NULLIFY(YDIAG_WATFLUX%XDIAG_TS)
- NULLIFY(YDIAG_WATFLUX%XRNC)
- NULLIFY(YDIAG_WATFLUX%XHC)
- NULLIFY(YDIAG_WATFLUX%XLEC)
- NULLIFY(YDIAG_WATFLUX%XLEIC)
- NULLIFY(YDIAG_WATFLUX%XGFLUXC)
- NULLIFY(YDIAG_WATFLUX%XEVAPC)
- NULLIFY(YDIAG_WATFLUX%XSUBLC)
- NULLIFY(YDIAG_WATFLUX%XLWDC)
- NULLIFY(YDIAG_WATFLUX%XLWUC)
- NULLIFY(YDIAG_WATFLUX%XSWDC)
- NULLIFY(YDIAG_WATFLUX%XSWUC)
- NULLIFY(YDIAG_WATFLUX%XFMUC)
- NULLIFY(YDIAG_WATFLUX%XFMVC)
-YDIAG_WATFLUX%XDIAG_TSTEP=0.
-YDIAG_WATFLUX%N2M=0
-YDIAG_WATFLUX%L2M_MIN_ZS=.FALSE.
-YDIAG_WATFLUX%LSURF_BUDGET=.FALSE.
-YDIAG_WATFLUX%LRAD_BUDGET=.FALSE.
-YDIAG_WATFLUX%LCOEF=.FALSE.
-YDIAG_WATFLUX%LSURF_VARS=.FALSE.
-YDIAG_WATFLUX%LSURF_BUDGETC=.FALSE.
-YDIAG_WATFLUX%LRESET_BUDGETC=.FALSE.
-IF (LHOOK) CALL DR_HOOK("MODD_DIAG_WATFLUX_N:DIAG_WATFLUX_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE DIAG_WATFLUX_INIT
-
-
-END MODULE MODD_DIAG_WATFLUX_n
diff --git a/src/SURFEX/modd_diagn.F90 b/src/SURFEX/modd_diagn.F90
new file mode 100644
index 0000000000000000000000000000000000000000..0c89aaf73d8bd3d1a350b531b2327147e6f146f2
--- /dev/null
+++ b/src/SURFEX/modd_diagn.F90
@@ -0,0 +1,282 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+!######################
+MODULE MODD_DIAG_n
+!######################
+!
+!!**** *MODD_DIAG - declaration of diagnostics for ISBA scheme
+!!
+!! PURPOSE
+!! -------
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. Masson *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2004
+!! Modified 01/2006 : sea flux parameterization.
+!! Modified 04/2009 : precip for/from restart file.
+!! Modified 08/2009 : BUDGETC for all tiles
+!! P. Samuelsson 10/2014 : added min max for XT2M
+!! Modified 09/2015 : M Lafaysse LSNOWDIMNC
+!! Modified 06/2016 : M Lafaysse LRESETCUMUL
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_TYPE_DATE_SURF
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+TYPE DIAG_OPTIONS_t
+!
+ REAL :: XDIAG_TSTEP ! time step for diagnostics writing
+!
+ INTEGER :: N2M ! flag for 2 meters (and 10 meters) quantities
+ LOGICAL :: LT2MMW ! flag to perform modified weighting of 2m temperature
+ LOGICAL :: L2M_MIN_ZS ! flag for 2 meters quantities evaluated on
+! ! the minimum orographyy of the grid
+ LOGICAL :: LSURF_BUDGET ! flag for surface energy budget
+ LOGICAL :: LRAD_BUDGET ! flag for radiative energy budget
+!
+ LOGICAL :: LCOEF ! flag for transfer coefficients
+ LOGICAL :: LSURF_VARS ! flag for surface variables
+ LOGICAL :: LFRAC ! flag for writing fractions of each four tiles
+ LOGICAL :: LDIAG_GRID ! flag for mean grid diag
+!
+ LOGICAL :: LSURF_BUDGETC ! flag for surface cumulated energy budget
+ LOGICAL :: LRESET_BUDGETC ! flag for surface cumulated energy budget
+ LOGICAL :: LREAD_BUDGETC ! flag for surface cumulated energy budget
+ LOGICAL :: LPROVAR_TO_DIAG ! switch to write (or not) prognostic variable
+ ! and allows puting field in diagnostics
+ LOGICAL :: LSNOWDIMNC ! if true create a snow layer dimension in nc files
+ LOGICAL :: LRESETCUMUL ! reset cumulated variables at 0 at each output timestep
+ LOGICAL :: LSELECT ! switch to control which fields are written
+ ! (only those whose naem appears in in text array)
+!
+ TYPE(DATE_TIME):: TIME_BUDGETC
+!
+ CHARACTER(LEN=LEN_HREC), POINTER, DIMENSION(:) :: CSELECT ! Name of ouput fields if LSELECT=true
+!
+ LOGICAL :: LPGD ! flag for writing of PGD files
+ LOGICAL :: LPATCH_BUDGET ! flag for patch output
+!
+END TYPE DIAG_OPTIONS_t
+!
+TYPE DIAG_t
+!------------------------------------------------------------------------------
+!
+!* variables for each patch
+!
+!* averaged variables
+!
+ REAL, POINTER, DIMENSION(:) :: XRI ! Bulk-Richardson number (-)
+ REAL, POINTER, DIMENSION(:) :: XCD ! drag coefficient for wind (W/s2)
+ REAL, POINTER, DIMENSION(:) :: XCDN ! neutral drag coefficient (-)
+ REAL, POINTER, DIMENSION(:) :: XCH ! drag coefficient for heat (W/s)
+ REAL, POINTER, DIMENSION(:) :: XCE ! drag coefficient for vapor (W/s/K)
+!
+ REAL, POINTER, DIMENSION(:) :: XHU ! area averaged surface humidity coefficient (-)
+ REAL, POINTER, DIMENSION(:) :: XHUG ! baresoil surface humidity coefficient (-)
+ REAL, POINTER, DIMENSION(:) :: XHV ! Halstead coefficient (-)
+!
+ REAL, POINTER, DIMENSION(:) :: XRN ! net radiation at surface (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XH ! sensible heat flux (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XLE ! total latent heat flux (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XLEI ! sublimation latent heat flux (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XGFLUX ! net soil-vegetation flux (W/m2)
+!
+ REAL, POINTER, DIMENSION(:) :: XEVAP ! total evaporation (kg/m2/s)
+ REAL, POINTER, DIMENSION(:) :: XSUBL ! sublimation (kg/m2/s)
+!
+ REAL, POINTER, DIMENSION(:) :: XTS ! surface temperature (K)
+ REAL, POINTER, DIMENSION(:) :: XTSRAD ! surface temperature (K)
+ REAL, POINTER, DIMENSION(:) :: XALBT ! Total Albedo
+ REAL, POINTER, DIMENSION(:) :: XSWE ! snow water equivalent (kg/m2)
+!
+ REAL, POINTER, DIMENSION(:) :: XT2M ! temperature at 2 meters (K)
+ REAL, POINTER, DIMENSION(:) :: XT2M_MIN ! Minimum temperature at 2 meters (K)
+ REAL, POINTER, DIMENSION(:) :: XT2M_MAX ! Maximum temperature at 2 meters (K)
+ REAL, POINTER, DIMENSION(:) :: XQ2M ! humidity at 2 meters (kg/kg)
+ REAL, POINTER, DIMENSION(:) :: XHU2M ! relative humidity at 2 meters (-)
+ REAL, POINTER, DIMENSION(:) :: XHU2M_MIN ! Minimum relative humidity at 2 meters (-)
+ REAL, POINTER, DIMENSION(:) :: XHU2M_MAX ! Maximum relative humidity at 2 meters (-)
+ REAL, POINTER, DIMENSION(:) :: XQS ! humidity at surface (kg/kg)
+ REAL, POINTER, DIMENSION(:) :: XZON10M ! zonal wind at 10 meters (m/s)
+ REAL, POINTER, DIMENSION(:) :: XMER10M ! meridian wind at 10 meters (m/s)
+ REAL, POINTER, DIMENSION(:) :: XWIND10M ! wind at 10 meters (m/s)
+ REAL, POINTER, DIMENSION(:) :: XWIND10M_MAX ! Maximum wind at 10 meters (m/s)
+!
+ REAL, POINTER, DIMENSION(:) :: XSFCO2 ! CO2 flux (m/s*kg_CO2/kg_air)
+!
+ REAL, POINTER, DIMENSION(:,:) :: XSWBD ! downward short wave radiation by spectral band (W/m2)
+ REAL, POINTER, DIMENSION(:,:) :: XSWBU ! upward short wave radiation by spectral band (W/m2)
+!
+ REAL, POINTER, DIMENSION(:) :: XLWD ! downward long wave radiation (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XLWU ! upward long wave radiation (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XSWD ! downward short wave radiation (W/m2)
+ REAL, POINTER, DIMENSION(:) :: XSWU ! upward short wave radiation (W/m2)
+!
+ REAL, POINTER, DIMENSION(:) :: XFMU ! horizontal momentum flux zonal (m2/s2)
+ REAL, POINTER, DIMENSION(:) :: XFMV ! horizontal momentum flux meridian (m2/s2)
+ !
+ REAL, POINTER, DIMENSION(:) :: XZ0 ! roughness length for momentum
+ ! for vegetation and snow (m)
+ REAL, POINTER, DIMENSION(:) :: XZ0H ! roughness length for heat
+ ! for vegetation and snow (m)
+ REAL, POINTER, DIMENSION(:) :: XZ0EFF ! effective roughness length for heat
+ ! for vegetation and snow (m)
+!
+ REAL, POINTER, DIMENSION(:) :: XT2M_MIN_ZS ! air temperature at 2 meters (K)
+ REAL, POINTER, DIMENSION(:) :: XQ2M_MIN_ZS ! air humidity at 2 meters (kg/kg)
+ REAL, POINTER, DIMENSION(:) :: XHU2M_MIN_ZS! air relative humidity at 2 m (-)
+
+
+
+ REAL, POINTER, DIMENSION(:) :: XPS ! air pressure at the surface (Pa)
+ REAL, POINTER, DIMENSION(:) :: XRHOA ! air density at the surface (kg/m3)
+
+ REAL, POINTER, DIMENSION(:) :: XSSO_FMU ! zonal friction (with SSO) (Pa)
+ REAL, POINTER, DIMENSION(:) :: XSSO_FMV ! meridian friction (with SSO) (Pa)
+!
+
+ REAL, POINTER, DIMENSION(:) :: XUREF ! reference height for momentum (m)
+ REAL, POINTER, DIMENSION(:) :: XZREF ! reference height for heat (m)
+ REAL, POINTER, DIMENSION(:) :: XTRAD ! radiative temperature at t (K)
+ REAL, POINTER, DIMENSION(:) :: XEMIS ! surface emissivity at t (-)
+
+!------------------------------------------------------------------------------
+!
+END TYPE DIAG_t
+!
+TYPE DIAG_NP_t
+!
+TYPE(DIAG_t), POINTER :: AL(:)=>NULL()
+!
+END TYPE DIAG_NP_t
+!
+CONTAINS
+!
+SUBROUTINE DIAG_OPTIONS_INIT(DGO)
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_DIAG_N:DIAG_OPTIONS_INIT",0,ZHOOK_HANDLE)
+ NULLIFY(DGO%CSELECT)
+DGO%XDIAG_TSTEP=0.
+DGO%N2M=0
+DGO%LT2MMW=.FALSE.
+DGO%L2M_MIN_ZS=.FALSE.
+DGO%LSURF_BUDGET=.FALSE.
+DGO%LRAD_BUDGET=.FALSE.
+DGO%LCOEF=.FALSE.
+DGO%LSURF_VARS=.FALSE.
+DGO%LFRAC=.FALSE.
+DGO%LDIAG_GRID=.FALSE.
+DGO%LPGD=.FALSE.
+DGO%LPATCH_BUDGET=.FALSE.
+DGO%LSURF_BUDGETC=.FALSE.
+DGO%LRESET_BUDGETC=.FALSE.
+DGO%LREAD_BUDGETC=.FALSE.
+DGO%LPROVAR_TO_DIAG=.FALSE.
+DGO%LSNOWDIMNC=.FALSE.
+DGO%LRESETCUMUL=.FALSE.
+DGO%LSELECT=.FALSE.
+IF (LHOOK) CALL DR_HOOK("MODD_DIAG_N:DIAG_OPTIONS_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE DIAG_OPTIONS_INIT
+!
+SUBROUTINE DIAG_NP_INIT(ND,KPATCH)
+TYPE(DIAG_NP_t), INTENT(INOUT) :: ND
+INTEGER, INTENT(IN) :: KPATCH
+INTEGER :: JP
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_DIAG_N:DIAG_NP_INIT",0,ZHOOK_HANDLE)
+IF (.NOT.ASSOCIATED(ND%AL)) THEN
+ ALLOCATE(ND%AL(KPATCH))
+ DO JP=1,KPATCH
+ CALL DIAG_INIT(ND%AL(JP))
+ ENDDO
+ELSE
+ DO JP=1,KPATCH
+ CALL DIAG_INIT(ND%AL(JP))
+ ENDDO
+ DEALLOCATE(ND%AL)
+ENDIF
+IF (LHOOK) CALL DR_HOOK("MODD_DIAG_N:DIAG_NP_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE DIAG_NP_INIT
+!
+!
+SUBROUTINE DIAG_INIT(D)
+TYPE(DIAG_t), INTENT(INOUT) :: D
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_DIAG_N:DIAG_INIT",0,ZHOOK_HANDLE)
+ NULLIFY(D%XRI)
+ NULLIFY(D%XCD)
+ NULLIFY(D%XCDN)
+ NULLIFY(D%XCH)
+ NULLIFY(D%XCE)
+ NULLIFY(D%XHU)
+ NULLIFY(D%XHUG)
+ NULLIFY(D%XHV)
+ NULLIFY(D%XRN)
+ NULLIFY(D%XH)
+ NULLIFY(D%XLE)
+ NULLIFY(D%XLEI)
+ NULLIFY(D%XGFLUX)
+ NULLIFY(D%XEVAP)
+ NULLIFY(D%XSUBL)
+ NULLIFY(D%XTS)
+ NULLIFY(D%XTSRAD)
+ NULLIFY(D%XALBT)
+ NULLIFY(D%XSWE)
+ NULLIFY(D%XT2M)
+ NULLIFY(D%XT2M_MIN)
+ NULLIFY(D%XT2M_MAX)
+ NULLIFY(D%XQ2M)
+ NULLIFY(D%XHU2M)
+ NULLIFY(D%XQS)
+ NULLIFY(D%XZON10M)
+ NULLIFY(D%XMER10M)
+ NULLIFY(D%XWIND10M)
+ NULLIFY(D%XWIND10M_MAX)
+ NULLIFY(D%XLWD)
+ NULLIFY(D%XLWU)
+ NULLIFY(D%XSWD)
+ NULLIFY(D%XSWU)
+ NULLIFY(D%XSWBD)
+ NULLIFY(D%XSWBU)
+ NULLIFY(D%XFMU)
+ NULLIFY(D%XFMV)
+ NULLIFY(D%XZ0)
+ NULLIFY(D%XZ0H)
+ NULLIFY(D%XZ0EFF)
+ NULLIFY(D%XT2M_MIN_ZS)
+ NULLIFY(D%XQ2M_MIN_ZS)
+ NULLIFY(D%XHU2M_MIN_ZS)
+ NULLIFY(D%XPS)
+ NULLIFY(D%XRHOA)
+ NULLIFY(D%XSSO_FMU)
+ NULLIFY(D%XSSO_FMV)
+ NULLIFY(D%XUREF)
+ NULLIFY(D%XZREF)
+ NULLIFY(D%XTRAD)
+ NULLIFY(D%XEMIS)
+IF (LHOOK) CALL DR_HOOK("MODD_DIAG_N:DIAG_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE DIAG_INIT
+
+
+END MODULE MODD_DIAG_n
diff --git a/src/SURFEX/modd_dstn.F90 b/src/SURFEX/modd_dstn.F90
index 3aa394b1f4b072e505baec18670fcad01a4b6472..52677fe74c9d014def6f2e597ecef07132169922 100644
--- a/src/SURFEX/modd_dstn.F90
+++ b/src/SURFEX/modd_dstn.F90
@@ -19,27 +19,26 @@ IMPLICIT NONE
TYPE DST_t
!
INTEGER, DIMENSION(:), POINTER :: NVT_DST !MASK: dust vegetation number to vegetation number
- INTEGER, DIMENSION(:,:), POINTER :: NSIZE_PATCH_DST !Number of points for a patch and a vegetation class
- INTEGER, DIMENSION(:,:,:), POINTER :: NR_PATCH_DST !Mask from patch-points to dust-points
+ INTEGER, DIMENSION(:), POINTER :: NSIZE_PATCH_DST !Number of points for a patch and a vegetation class
+ INTEGER, DIMENSION(:,:), POINTER :: NR_PATCH_DST !Mask from patch-points to dust-points
REAL,DIMENSION(:), POINTER :: Z0_EROD_DST !Roughness length momentum over erodible dust emitter sfc
CHARACTER(LEN=6), DIMENSION(:), POINTER :: CSV_DST !Name of scalar variables
- REAL, DIMENSION(:,:,:),POINTER :: XSFDST !Dust variables to be send to output
- REAL, DIMENSION(:,:,:),POINTER :: XSFDSTM !Dust variables to be send to output
+ REAL, DIMENSION(:,:),POINTER :: XSFDST !Dust variables to be send to output
+ REAL, DIMENSION(:,:),POINTER :: XSFDSTM !Dust variables to be send to output
REAL,DIMENSION(:), POINTER :: XEMISRADIUS_DST !Number median radius for each source mode
REAL,DIMENSION(:), POINTER :: XEMISSIG_DST !sigma for each source mode
REAL,DIMENSION(:), POINTER :: XMSS_FRC_SRC !Mass fraction of each source mode
!
END TYPE DST_t
-
-
-
- CONTAINS
-
!
-
-
-
-
+TYPE DST_NP_t
+!
+TYPE(DST_t), DIMENSION(:), POINTER :: AL=>NULL()
+!
+END TYPE DST_NP_t
+!
+CONTAINS
+!
SUBROUTINE DST_INIT(YDST)
TYPE(DST_t), INTENT(INOUT) :: YDST
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -56,6 +55,29 @@ IF (LHOOK) CALL DR_HOOK("MODD_DST_N:DST_INIT",0,ZHOOK_HANDLE)
NULLIFY(YDST%XMSS_FRC_SRC)
IF (LHOOK) CALL DR_HOOK("MODD_DST_N:DST_INIT",1,ZHOOK_HANDLE)
END SUBROUTINE DST_INIT
-
-
+!
+SUBROUTINE DST_NP_INIT(YDST_NP,KPATCH)
+TYPE(DST_NP_t), INTENT(INOUT) :: YDST_NP
+INTEGER, INTENT(IN) :: KPATCH
+INTEGER :: JP
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK("MODD_DST_N:DST_NP_INIT",0,ZHOOK_HANDLE)
+!
+IF (ASSOCIATED(YDST_NP%AL)) THEN
+ DO JP = 1,KPATCH
+ CALL DST_INIT(YDST_NP%AL(JP))
+ ENDDO
+ DEALLOCATE(YDST_NP%AL)
+ELSE
+ ALLOCATE(YDST_NP%AL(KPATCH))
+ DO JP = 1,KPATCH
+ CALL DST_INIT(YDST_NP%AL(JP))
+ ENDDO
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK("MODD_DST_N:DST_NP_INIT",1,ZHOOK_HANDLE)
+!
+END SUBROUTINE DST_NP_INIT
+!
END MODULE MODD_DST_n
diff --git a/src/SURFEX/modd_dummy_surf_fieldsn.F90 b/src/SURFEX/modd_dummy_surf_fieldsn.F90
index b318984c9ee054f685c540bb7362e7ef0afd42bc..f847168d2cfdccbb15dfb4c05b1a21b6d7302d0e 100644
--- a/src/SURFEX/modd_dummy_surf_fieldsn.F90
+++ b/src/SURFEX/modd_dummy_surf_fieldsn.F90
@@ -56,7 +56,7 @@ TYPE DUMMY_SURF_FIELDS_t
!
END TYPE DUMMY_SURF_FIELDS_t
- CONTAINS
+CONTAINS
!
!
SUBROUTINE DUMMY_SURF_FIELDS_INIT(YDUMMY_SURF_FIELDS)
diff --git a/src/SURFEX/modd_emis_gr_fieldn.F90 b/src/SURFEX/modd_emis_gr_fieldn.F90
index aaaa175a93800b357f5234c8e20de23142b53001..769b808bf3ecca79a795ecdd5e67bc1005f2d247 100644
--- a/src/SURFEX/modd_emis_gr_fieldn.F90
+++ b/src/SURFEX/modd_emis_gr_fieldn.F90
@@ -79,7 +79,7 @@ END TYPE EMIS_GR_FIELD_t
- CONTAINS
+CONTAINS
!
diff --git a/src/SURFEX/modd_flake_albedo_ref.F90 b/src/SURFEX/modd_flake_albedo_ref.F90
deleted file mode 100644
index 4881eadc35a1cb2b90ae5fb46df00a820fb89cad..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_flake_albedo_ref.F90
+++ /dev/null
@@ -1,11 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-!------------------------------------------------------------------------------
-
-MODULE modd_flake_albedo_ref
-!
-! a supprimer
-!
-END MODULE modd_flake_albedo_ref
diff --git a/src/SURFEX/modd_flake_gridn.F90 b/src/SURFEX/modd_flake_gridn.F90
deleted file mode 100644
index bb2bd22ea637c6117ef368e5c41d135f2979a373..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_flake_gridn.F90
+++ /dev/null
@@ -1,88 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ##################
-MODULE MODD_FLAKE_GRID_n
-! ##################
-!
-!!**** *MODD_FLAKE_GRID - declaration of FLAKE grid
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE FLAKE_GRID_t
-!-------------------------------------------------------------------------------
-!
-! Grid definition
-!
- INTEGER :: NDIM ! number of points
- CHARACTER(LEN=10) :: CGRID ! grid type
-! ! "NONE " : no grid computations
-! ! "CONF PROJ " : conformal projection
-! ! "SURF ATM " : water points of surf. atm. grid
-!
- REAL, POINTER, DIMENSION(:) :: XGRID_PAR ! lits of parameters used to define the grid
-! ! (depends on value of CGRID)
-!
-!-------------------------------------------------------------------------------
-!
-! General surface parameters:
-!
- REAL, POINTER, DIMENSION(:) :: XLAT ! latitude (degrees +North) (-)
- REAL, POINTER, DIMENSION(:) :: XLON ! longitude (degrees +East) (-)
- REAL, POINTER, DIMENSION(:) :: XMESH_SIZE ! mesh size (m2)
-!-------------------------------------------------------------------------------
-!
-
-END TYPE FLAKE_GRID_t
-
-
-
- CONTAINS
-
-!
-
-
-
-
-SUBROUTINE FLAKE_GRID_INIT(YFLAKE_GRID)
-TYPE(FLAKE_GRID_t), INTENT(INOUT) :: YFLAKE_GRID
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_FLAKE_GRID_N:FLAKE_GRID_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YFLAKE_GRID%XGRID_PAR)
- NULLIFY(YFLAKE_GRID%XLAT)
- NULLIFY(YFLAKE_GRID%XLON)
- NULLIFY(YFLAKE_GRID%XMESH_SIZE)
-YFLAKE_GRID%NDIM=0
-YFLAKE_GRID%CGRID=' '
-IF (LHOOK) CALL DR_HOOK("MODD_FLAKE_GRID_N:FLAKE_GRID_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE FLAKE_GRID_INIT
-
-
-END MODULE MODD_FLAKE_GRID_n
diff --git a/src/SURFEX/modd_flake_sbln.F90 b/src/SURFEX/modd_flake_sbln.F90
deleted file mode 100644
index 22ef51218ca2ac174f90f176424862f2032fb9ef..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_flake_sbln.F90
+++ /dev/null
@@ -1,85 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ################
- MODULE MODD_FLAKE_SBL_n
-! ################
-!
-!!**** *MODD_FLAKE_SBL_n - declaration of surface parameters for SBL
-!!
-!! PURPOSE
-!! -------
-! Declaration of surface parameters
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/2006
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE FLAKE_SBL_t
-!
- INTEGER :: NLVL ! number of levels in SBL
- REAL, POINTER, DIMENSION(:,:) :: XZ ! height of middle of each level grid(m)
- REAL, POINTER, DIMENSION(:,:) :: XU ! wind at each level in SBL (m/s)
- REAL, POINTER, DIMENSION(:,:) :: XT ! temperature at each level in SBL (m/s)
- REAL, POINTER, DIMENSION(:,:) :: XQ ! humidity at each level in SBL (kg/m3)
- REAL, POINTER, DIMENSION(:,:) :: XTKE ! Tke at each level in SBL (m2/s2)
- REAL, POINTER, DIMENSION(:) :: XLMO ! Monin-Obhukov length (m)
- REAL, POINTER, DIMENSION(:,:) :: XP ! pressure at each level in SBL (kg/m3)
-!
- REAL, POINTER, DIMENSION(:,:) :: XDZ ! depth of each level in SBL (m)
- REAL, POINTER, DIMENSION(:,:) :: XZF ! height of bottom of each level grid(m)
- REAL, POINTER, DIMENSION(:,:) :: XDZF ! depth between each level in SBL (m)
-!
-END TYPE FLAKE_SBL_t
-
-
-
- CONTAINS
-
-!
-
-
-
-
-SUBROUTINE FLAKE_SBL_INIT(YFLAKE_SBL)
-TYPE(FLAKE_SBL_t), INTENT(INOUT) :: YFLAKE_SBL
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_FLAKE_SBL_N:FLAKE_SBL_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YFLAKE_SBL%XZ)
- NULLIFY(YFLAKE_SBL%XU)
- NULLIFY(YFLAKE_SBL%XT)
- NULLIFY(YFLAKE_SBL%XQ)
- NULLIFY(YFLAKE_SBL%XTKE)
- NULLIFY(YFLAKE_SBL%XLMO)
- NULLIFY(YFLAKE_SBL%XP)
- NULLIFY(YFLAKE_SBL%XDZ)
- NULLIFY(YFLAKE_SBL%XZF)
- NULLIFY(YFLAKE_SBL%XDZF)
-YFLAKE_SBL%NLVL=0
-IF (LHOOK) CALL DR_HOOK("MODD_FLAKE_SBL_N:FLAKE_SBL_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE FLAKE_SBL_INIT
-
-
-END MODULE MODD_FLAKE_SBL_n
diff --git a/src/SURFEX/modd_flaken.F90 b/src/SURFEX/modd_flaken.F90
index 6e95ab2711552f0eb1520f047ea33a942c52d654..675f74484abe19c23105accbc1224b854dcb492a 100644
--- a/src/SURFEX/modd_flaken.F90
+++ b/src/SURFEX/modd_flaken.F90
@@ -126,7 +126,7 @@ END TYPE FLAKE_t
!
- CONTAINS
+CONTAINS
!
!-------------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/modd_full_grid.F90 b/src/SURFEX/modd_full_grid.F90
new file mode 100644
index 0000000000000000000000000000000000000000..7fb4e26a11f36138b6475723bff88a1d13add173
--- /dev/null
+++ b/src/SURFEX/modd_full_grid.F90
@@ -0,0 +1,42 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! ##################
+ MODULE MODD_FULL_GRID
+! ##################
+!
+!!**** *MODD_FULL_GRID - declaration of SURF_ATM grid
+!!
+!! PURPOSE
+!! -------
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. Masson *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2004
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+ CHARACTER(LEN=10) :: CGRID ! grid type
+! ! "NONE " : no grid computations
+! ! "CONF PROJ " : conformal projection
+ REAL, POINTER, DIMENSION(:) :: XGRID_FULL_PAR ! lits of parameters used to define the grid
+! ! (depends on value of CGRID)
+ INTEGER :: NGRID_PAR ! size of XGRID_PAR
+!
+!
+END MODULE MODD_FULL_GRID
diff --git a/src/SURFEX/modd_get_mesh_index_lonlat_reg.F90 b/src/SURFEX/modd_get_mesh_index_lonlat_reg.F90
index e7cc70c156a727e04a8716c9ac2cbdf36d0437f9..31c0ee2119e04d6d223c9fdc135750da53fa4d54 100644
--- a/src/SURFEX/modd_get_mesh_index_lonlat_reg.F90
+++ b/src/SURFEX/modd_get_mesh_index_lonlat_reg.F90
@@ -36,6 +36,9 @@ IMPLICIT NONE
REAL, DIMENSION(:), ALLOCATABLE :: XLONLIM ! longitude left limit of grid mesh (dim ILON+1)
REAL, DIMENSION(:), ALLOCATABLE :: XLATLIM ! latitude bottom limit of grid mesh (dim ILAT+1)
!
+INTEGER, DIMENSION(:), ALLOCATABLE :: NFRACDLON
+INTEGER, DIMENSION(:), ALLOCATABLE :: NFRACDLAT
+!
INTEGER :: NLON ! number of points in longitude
INTEGER :: NLAT ! number of points in latitude
REAL :: XLON0 ! centre longitude of the grid
diff --git a/src/SURFEX/modd_glt_param.F90 b/src/SURFEX/modd_glt_param.F90
index 586ec41c498100c17b65ec43e5f6e5a2d67c3b3b..1c82c3c8f66088f1192a6ac5eaee103906d50162 100644
--- a/src/SURFEX/modd_glt_param.F90
+++ b/src/SURFEX/modd_glt_param.F90
@@ -131,7 +131,7 @@ INTEGER :: &
nmkinit, nrstout, nrstgl4, nthermo, ndynami, nadvect, &
ntimers, ndyncor, ncdlssh, niceage, nicesal, nmponds, &
nsnwrad, nleviti, nsalflx, nextqoc, nicesub
- CHARACTER(10) :: &
+CHARACTER(10) :: &
cnflxin
!
!
@@ -152,7 +152,7 @@ INTEGER :: &
! chsidmp='PRESCRIBE' --> prescribe
! - xhsidmpeft : sea ice thickness damping e-folding time (in days)
!
- CHARACTER(20) :: &
+CHARACTER(20) :: &
cfsidmp, chsidmp
REAL :: &
xfsidmpeft, xhsidmpeft
@@ -218,9 +218,9 @@ REAL :: &
! cinsfld = sic
! ...
!
- CHARACTER(8) :: &
+CHARACTER(8) :: &
cdiafmt,cdialev
- CHARACTER(80), DIMENSION(:), ALLOCATABLE :: &
+CHARACTER(80), DIMENSION(:), ALLOCATABLE :: &
cinsfld
REAL :: &
dttave
@@ -352,7 +352,7 @@ INTEGER :: &
!
! - ciopath : path for input/output fields to glt_gelato routine
!
- CHARACTER(80) :: &
+CHARACTER(80) :: &
ciopath
!
!
@@ -368,7 +368,7 @@ INTEGER :: &
! - nn_perio : grid periodicity
! - rn_htopoc : ocean uppermost grid cell thickness
!
- CHARACTER(80) :: &
+CHARACTER(80) :: &
cn_grdname
INTEGER :: &
nn_readf, nn_first, nn_final, nn_step, nn_iglo, nn_jglo, nn_perio
@@ -544,7 +544,7 @@ INTEGER :: &
ntimnum
REAL :: &
xtime
- CHARACTER(80) :: &
+CHARACTER(80) :: &
clabel
!
END MODULE modd_glt_param
diff --git a/src/SURFEX/modd_gr_biog_gardenn.F90 b/src/SURFEX/modd_gr_biog_gardenn.F90
index 5768e91b19e187f04f6c7a34d1fc3627c3f3045c..1849ecf631f149accf16225a5a965bef1d7cefbd 100644
--- a/src/SURFEX/modd_gr_biog_gardenn.F90
+++ b/src/SURFEX/modd_gr_biog_gardenn.F90
@@ -53,7 +53,7 @@ END TYPE GR_BIOG_GARDEN_t
- CONTAINS
+CONTAINS
!
diff --git a/src/SURFEX/modd_gr_biog_greenroofn.F90 b/src/SURFEX/modd_gr_biog_greenroofn.F90
index 010b038f3e1b644be8c1953ef32d982ba6298f19..4f861e10e9044d568beb0d13f9eb7dd19a8232c8 100644
--- a/src/SURFEX/modd_gr_biog_greenroofn.F90
+++ b/src/SURFEX/modd_gr_biog_greenroofn.F90
@@ -54,7 +54,7 @@ END TYPE GR_BIOG_GREENROOF_t
- CONTAINS
+CONTAINS
!
diff --git a/src/SURFEX/modd_gr_biogn.F90 b/src/SURFEX/modd_gr_biogn.F90
index c4fcb59763280cfde1b329ed1d65bab40fd1c38e..9090cc3f7f2b6108d597a5a04b1b00f992ed7dd5 100644
--- a/src/SURFEX/modd_gr_biogn.F90
+++ b/src/SURFEX/modd_gr_biogn.F90
@@ -42,7 +42,7 @@ TYPE GR_BIOG_t
REAL, DIMENSION(:), POINTER :: XMONOPOT
!
!* Radiation at different level(cf Gauss) in the canopy
- REAL, DIMENSION(:,:,:),POINTER ::XIACAN ! PAR at 3 gauss level for each patch
+ REAL, DIMENSION(:,:),POINTER ::XIACAN ! PAR at 3 gauss level for each patch
!
!* XFISO = isoprene emission flux (ppp.m.s-1)
! XFMONO = monoterpenes emission flux (ppp m s-1)
@@ -52,10 +52,14 @@ TYPE GR_BIOG_t
!
!
END TYPE GR_BIOG_t
-
-
-
- CONTAINS
+!
+TYPE GR_BIOG_NP_t
+!
+TYPE(GR_BIOG_t), DIMENSION(:), POINTER :: AL=>NULL()
+!
+END TYPE GR_BIOG_NP_t
+!
+CONTAINS
!
@@ -75,5 +79,26 @@ IF (LHOOK) CALL DR_HOOK("MODD_GR_BIOG_N:GR_BIOG_INIT",0,ZHOOK_HANDLE)
IF (LHOOK) CALL DR_HOOK("MODD_GR_BIOG_N:GR_BIOG_INIT",1,ZHOOK_HANDLE)
END SUBROUTINE GR_BIOG_INIT
-
+SUBROUTINE GR_BIOG_NP_INIT(YGR_BIOG_NP,KPATCH)
+TYPE(GR_BIOG_NP_t), INTENT(INOUT) :: YGR_BIOG_NP
+INTEGER, INTENT(IN) :: KPATCH
+INTEGER :: JP
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_GR_BIOG_N:GR_BIOG_NP_INIT",0,ZHOOK_HANDLE)
+!
+IF (ASSOCIATED(YGR_BIOG_NP%AL)) THEN
+ DO JP = 1,KPATCH
+ CALL GR_BIOG_INIT(YGR_BIOG_NP%AL(JP))
+ ENDDO
+ DEALLOCATE(YGR_BIOG_NP%AL)
+ELSE
+ ALLOCATE(YGR_BIOG_NP%AL(KPATCH))
+ DO JP = 1,KPATCH
+ CALL GR_BIOG_INIT(YGR_BIOG_NP%AL(JP))
+ ENDDO
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK("MODD_GR_BIOG_N:GR_BIOG_NP_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE GR_BIOG_NP_INIT
+!
END MODULE MODD_GR_BIOG_n
diff --git a/src/SURFEX/modd_grid_arome.F90 b/src/SURFEX/modd_grid_arome.F90
index 5f7f19316b8064be733c363735024af3ed0ac9c7..3c7bb117be0b145a59366ead45d4d3c0e01970d7 100644
--- a/src/SURFEX/modd_grid_arome.F90
+++ b/src/SURFEX/modd_grid_arome.F90
@@ -45,4 +45,8 @@ REAL :: XLONOR ! origin longitude
REAL :: XRPK ! projection parameter for the conformal projection
REAL :: XBETA ! rotation parameter for the conformal projection
!
+REAL, DIMENSION(:), ALLOCATABLE :: XZX ! X coordinate
+REAL, DIMENSION(:), ALLOCATABLE :: XZY ! Y coordinate
+INTEGER, DIMENSION(:), ALLOCATABLE :: NIX ! number of points on each line
+!
END MODULE MODD_GRID_AROME
diff --git a/src/SURFEX/modd_grid_cartesian.F90 b/src/SURFEX/modd_grid_cartesian.F90
index 1ac6cda3a18e3e0e4a861dca88be51e21ff05d15..fe60bd850706313745754903ad17b01fee103417 100644
--- a/src/SURFEX/modd_grid_cartesian.F90
+++ b/src/SURFEX/modd_grid_cartesian.F90
@@ -35,6 +35,9 @@ IMPLICIT NONE
!
REAL, DIMENSION(:), ALLOCATABLE :: XX ! X coordinate (meters)
REAL, DIMENSION(:), ALLOCATABLE :: XY ! Y coordinate (meters)
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCX
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCY
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: NCIJ
INTEGER :: NX ! number of points in X direction
INTEGER :: NY ! number of points in Y direction
!
diff --git a/src/SURFEX/modd_grid_conf_proj.F90 b/src/SURFEX/modd_grid_conf_projn.F90
similarity index 70%
rename from src/SURFEX/modd_grid_conf_proj.F90
rename to src/SURFEX/modd_grid_conf_projn.F90
index d22a3186a0df9ff4a1c12a808f659b8a2cca1684..f3398c519e31febe0629a9b7abb6cb55c3b1a08a 100644
--- a/src/SURFEX/modd_grid_conf_proj.F90
+++ b/src/SURFEX/modd_grid_conf_projn.F90
@@ -3,10 +3,10 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ################
- MODULE MODD_GRID_CONF_PROJ
+ MODULE MODD_GRID_CONF_PROJ_n
! ################
!
-!!**** *MODD_GRID_CONF_PROJ - declaration of Arome gris characteristics
+!!**** *MODD_GRID_CONF_PROJ_n - declaration of Arome gris characteristics
!!
!! PURPOSE
!! -------
@@ -30,18 +30,21 @@
!
!* 0. DECLARATIONS
! ------------
-USE MODD_TYPE_DATE_SURF
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
-!!
+!
IMPLICIT NONE
!
REAL, DIMENSION(:), ALLOCATABLE :: XX ! X coordinate (meters)
REAL, DIMENSION(:), ALLOCATABLE :: XY ! Y coordinate (meters)
-
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCX
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCY
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: NCIJ
+!
TYPE GRID_CONF_PROJ_t
-
+!
INTEGER :: NX ! number of points in X direction
INTEGER :: NY ! number of points in Y direction
!
@@ -53,24 +56,27 @@ REAL :: XRPK ! projection parameter for the conformal projection
REAL :: XBETA ! rotation parameter for the conformal projection
REAL :: XLATC ! centre latitude
REAL :: XLONC ! centre longitude
+!
END TYPE GRID_CONF_PROJ_t
!
CONTAINS
-
+!
SUBROUTINE GRID_CONF_PROJ_INIT(YGRIDCONF)
TYPE(GRID_CONF_PROJ_t), INTENT(INOUT) :: YGRIDCONF
REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_GRID_CONF_PROJ:GRID_CONF_PROJ_INIT",0,ZHOOK_HANDLE)
- YGRIDCONF%NX = 0
- YGRIDCONF%NY = 0
- YGRIDCONF%XLAT0 = 0.
- YGRIDCONF%XLON0 = 0.
- YGRIDCONF%XLATORI = 0.
- YGRIDCONF%XLONORI = 0.
- YGRIDCONF%XRPK = 0.
- YGRIDCONF%XBETA = 0.
- YGRIDCONF%XLATC = 0.
- YGRIDCONF%XLONC = 0.
-IF (LHOOK) CALL DR_HOOK("MODD_GRID_CONF_PROJ:GRID_CONF_PROJ_INIT",1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK("MODD_GRID_CONF_PROJ_n:GRID_CONF_PROJ_INIT",0,ZHOOK_HANDLE)
+YGRIDCONF%NX = 0
+YGRIDCONF%NY = 0
+YGRIDCONF%XLAT0 = 0.
+YGRIDCONF%XLON0 = 0.
+YGRIDCONF%XLATORI = 0.
+YGRIDCONF%XLONORI = 0.
+YGRIDCONF%XRPK = 0.
+YGRIDCONF%XBETA = 0.
+YGRIDCONF%XLATC = 0.
+YGRIDCONF%XLONC = 0.
+IF (LHOOK) CALL DR_HOOK("MODD_GRID_CONF_PROJ_n:GRID_CONF_PROJ_INIT",1,ZHOOK_HANDLE)
END SUBROUTINE GRID_CONF_PROJ_INIT
-END MODULE MODD_GRID_CONF_PROJ
+!
+!
+END MODULE MODD_GRID_CONF_PROJ_n
diff --git a/src/SURFEX/modd_grid_gauss.F90 b/src/SURFEX/modd_grid_gauss.F90
index 0d66587322c37e5ba62ee1d3a9012924e01743a7..e46fb1274b40056563dec60253f4bfa5a7da09c1 100644
--- a/src/SURFEX/modd_grid_gauss.F90
+++ b/src/SURFEX/modd_grid_gauss.F90
@@ -46,5 +46,8 @@ REAL :: XLAP ! Latitude of stretching pole
REAL :: XLOP ! Longitude of stretching pole
REAL :: XCOEF ! Stretching coefficient
!
+REAL, DIMENSION(:), ALLOCATABLE :: XILATARRAY! latitudes values array
+REAL, DIMENSION(:), ALLOCATABLE :: XLAT, XLON
+!
END MODULE MODD_GRID_GAUSS
diff --git a/src/SURFEX/modd_grid_grib.F90 b/src/SURFEX/modd_grid_grib.F90
index 5fe039aa5625b8c1cd844e52147dfdb34c81ce66..9ae078577cfa550f3be06be9e9ec9ac8ad93e753 100644
--- a/src/SURFEX/modd_grid_grib.F90
+++ b/src/SURFEX/modd_grid_grib.F90
@@ -37,6 +37,7 @@ IMPLICIT NONE
!
INTEGER :: NNI ! total number of physical points
!
+ CHARACTER(LEN=6) :: CINMODEL!
CHARACTER(LEN=28) :: CGRIB_FILE
INTEGER(KIND=kindOfInt) :: NIDX
!
diff --git a/src/SURFEX/modd_horibl.F90 b/src/SURFEX/modd_horibl.F90
new file mode 100644
index 0000000000000000000000000000000000000000..30e1a53f2523496b17177e470ee1faa8486111f2
--- /dev/null
+++ b/src/SURFEX/modd_horibl.F90
@@ -0,0 +1,45 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! ################
+ MODULE MODD_HORIBL
+! ################
+!
+!!**** *MODD_HORIBL - declaration for field interpolations
+!!
+!! PURPOSE
+!! -------
+! Declaration of surface parameters
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2004
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+LOGICAL :: LGLOBLON=.FALSE., LGLOBS=.FALSE., LGLOBN=.FALSE.
+REAL :: XILO1H=0., XILO2H=0.
+
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: NO
+INTEGER, DIMENSION(:), ALLOCATABLE :: NINLOH
+REAL, DIMENSION(:,:), ALLOCATABLE :: XLA
+REAL, DIMENSION(:), ALLOCATABLE :: XOLA, XOLO
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: NP
+REAL, DIMENSION(:,:), ALLOCATABLE :: XLOPH
+!
+END MODULE MODD_HORIBL
diff --git a/src/SURFEX/modd_idealn.F90 b/src/SURFEX/modd_idealn.F90
index 49c5a593dcc7329289a86c3366196a51eb52fe23..2d01632106d031e0df4c8e1796f4e20cfb80ab84 100644
--- a/src/SURFEX/modd_idealn.F90
+++ b/src/SURFEX/modd_idealn.F90
@@ -53,7 +53,7 @@ END TYPE IDEAL_t
- CONTAINS
+CONTAINS
!
diff --git a/src/SURFEX/modd_ign.F90 b/src/SURFEX/modd_ign.F90
index 5f0a92b05b480753da8ce4ae1ba988a1278327d4..d2a768452ff03e1ea318f37032c348abd1e36de7 100644
--- a/src/SURFEX/modd_ign.F90
+++ b/src/SURFEX/modd_ign.F90
@@ -2,6 +2,10 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
! ###############
MODULE MODD_IGN
! ###############
diff --git a/src/SURFEX/modd_io_buff.F90 b/src/SURFEX/modd_io_buff.F90
index 41bc6a8e8015ca27906e227a67dcf7f4175bccd1..3ea88644f491f0a5495fdd2c02838782bbca77d9 100644
--- a/src/SURFEX/modd_io_buff.F90
+++ b/src/SURFEX/modd_io_buff.F90
@@ -32,7 +32,7 @@
!
IMPLICIT NONE
- CHARACTER(LEN=LEN_HREC), DIMENSION(3000) :: CREC ! list of records already read/written
+ CHARACTER(LEN=LEN_HREC), DIMENSION(50000) :: CREC ! list of records already read/written
INTEGER :: NREC ! number of records read/written
!
diff --git a/src/SURFEX/modd_io_buffn.F90 b/src/SURFEX/modd_io_buffn.F90
deleted file mode 100644
index f233b6873fe1e26968047bf14ab621e3d56df3b0..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_io_buffn.F90
+++ /dev/null
@@ -1,9 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ##################
- MODULE MODD_IO_BUFF_n
-!
-!
-END MODULE MODD_IO_BUFF_n
diff --git a/src/SURFEX/modd_io_surf_asc.F90 b/src/SURFEX/modd_io_surf_asc.F90
index 7486459507fe008a637b7fc8eb6f9620678fadb1..81207ed32f2a4bf7e04068b26d95cb7fc0057e4f 100644
--- a/src/SURFEX/modd_io_surf_asc.F90
+++ b/src/SURFEX/modd_io_surf_asc.F90
@@ -31,20 +31,17 @@
!* 0. DECLARATIONS
!
IMPLICIT NONE
+ CHARACTER(LEN=28),SAVE :: CFILE = 'SURFIN.txt'
CHARACTER(LEN=28),SAVE :: CFILEIN ='SURFIN.txt' ! Name of the input
CHARACTER(LEN=28),SAVE :: CFILEIN_SAVE ='SURFIN.txt' ! Name of the input
CHARACTER(LEN=28),SAVE :: CFILEOUT='SURFOUT.txt'! Name of the output
CHARACTER(LEN=28),SAVE :: CFILEPGD ='PGD.txt' ! Name of the pgd file
INTEGER :: NUNIT ! logical unit of surface file
INTEGER :: NLUOUT ! logical unit of output file
-INTEGER, DIMENSION(:), POINTER :: NMASK ! 1D mask to read only interesting
-!$OMP THREADPRIVATE(NMASK)
+INTEGER, DIMENSION(:), POINTER :: NMASK=>NULL() ! 1D mask to read only interesting
CHARACTER(LEN=6) :: CMASK ! surface mask type
-!$OMP THREADPRIVATE(CMASK)
INTEGER :: NFULL ! total number fo points of surface
-!$OMP THREADPRIVATE(NFULL)
LOGICAL, SAVE :: LCREATED=.FALSE. ! flag to know if the output file was created
-LOGICAL :: LOPEN ! flag to know if the file has been openned during the surface call and is to be read
INTEGER :: NNI_FORC ! number of points in forcing files.
!
END MODULE MODD_IO_SURF_ASC
diff --git a/src/SURFEX/modd_io_surf_fa.F90 b/src/SURFEX/modd_io_surf_fa.F90
index dd231303aae37547f131dfb48d6dbe612616a1aa..707fa28fced7e394acfa2224a42b6d94f7ecc854 100644
--- a/src/SURFEX/modd_io_surf_fa.F90
+++ b/src/SURFEX/modd_io_surf_fa.F90
@@ -31,16 +31,16 @@
!
IMPLICIT NONE
!
- CHARACTER(LEN=6), SAVE :: CDNOMC ='header' ! Name of the header
- CHARACTER(LEN=28),SAVE :: CFILEIN_FA ='SURFIN.fa' ! Name of the input
- CHARACTER(LEN=28),SAVE :: CFILEIN_FA_SAVE ='SURFIN.fa' ! Name of the input
- CHARACTER(LEN=28),SAVE :: CFILEOUT_FA ='SURFOUT.fa' ! Name of the input
- CHARACTER(LEN=28),SAVE :: CFILEPGD_FA ='PGD.fa' ! Name of the pgd file
- CHARACTER(LEN=4), SAVE :: CPREFIX1D ='SFX.' ! Prefix name in fa file
- CHARACTER(LEN=1), SAVE :: CPREFIX2D ='X' ! Prefix name in fa file
+CHARACTER(LEN=6), SAVE :: CDNOMC ='header' ! Name of the header
+CHARACTER(LEN=28),SAVE :: CFILE_FA ='SURFIN.fa' ! Name of the input
+CHARACTER(LEN=28),SAVE :: CFILEIN_FA ='SURFIN.fa' ! Name of the input
+CHARACTER(LEN=28),SAVE :: CFILEIN_FA_SAVE ='SURFIN.fa' ! Name of the input
+CHARACTER(LEN=28),SAVE :: CFILEOUT_FA ='SURFOUT.fa' ! Name of the input
+CHARACTER(LEN=28),SAVE :: CFILEPGD_FA ='PGD.fa' ! Name of the pgd file
+CHARACTER(LEN=4), SAVE :: CPREFIX1D ='SFX.' ! Prefix name in fa file
+CHARACTER(LEN=1), SAVE :: CPREFIX2D ='X' ! Prefix name in fa file
!
- CHARACTER(LEN=6) :: CMASK ! surface mask type
-!$OMP THREADPRIVATE(CMASK)
+CHARACTER(LEN=6) :: CMASK ! surface mask type
!
INTEGER :: NUNIT_FA =19 ! logical unit of surface file (FA part)
INTEGER :: NLUOUT ! logical unit of output file
@@ -50,10 +50,8 @@ LOGICAL, SAVE :: LFANOCOMPACT=.FALSE.
LOGICAL, SAVE :: LPREP =.FALSE.
LOGICAL :: LOPEN ! flag to know if the file has been openned during the surface call
!
-INTEGER, DIMENSION(:), POINTER :: NMASK ! 1D mask to read only interesting
-!$OMP THREADPRIVATE(NMASK)
+INTEGER, DIMENSION(:), POINTER :: NMASK=>NULL() ! 1D mask to read only interesting
INTEGER :: NFULL ! total number of points of surface
-!$OMP THREADPRIVATE(NFULL)
INTEGER :: NFULL_EXT ! total number of points including the extension zone (ALADIN)
INTEGER :: NDGL,NDLON,NDLUX,NDGUX ! dimensions of ALADIN domain
!
diff --git a/src/SURFEX/modd_isba_canopyn.F90 b/src/SURFEX/modd_isba_canopyn.F90
deleted file mode 100644
index 3d64577813c32f67426ee171fcb677afb0ecf58f..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_isba_canopyn.F90
+++ /dev/null
@@ -1,85 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ################
- MODULE MODD_ISBA_CANOPY_n
-! ################
-!
-!!**** *MODD_ISBA_CANOPY_n - declaration of surface parameters for urban canopy
-!!
-!! PURPOSE
-!! -------
-! Declaration of surface parameters
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/2006
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE ISBA_CANOPY_t
-!
- INTEGER :: NLVL ! number of levels in canopy
- REAL, POINTER, DIMENSION(:,:) :: XZ ! height of middle of each level grid (m)
- REAL, POINTER, DIMENSION(:,:) :: XU ! wind at each level in canopy (m/s)
- REAL, POINTER, DIMENSION(:,:) :: XT ! temperature at each level in canopy (m/s)
- REAL, POINTER, DIMENSION(:,:) :: XQ ! humidity at each level in canopy (kg/m3)
- REAL, POINTER, DIMENSION(:,:) :: XTKE ! Tke at each level in canopy (m2/s2)
- REAL, POINTER, DIMENSION(:) :: XLMO ! Monin-Obhukov length (m)
- REAL, POINTER, DIMENSION(:,:) :: XP ! pressure at each level in canopy (kg/m3)
-!
- REAL, POINTER, DIMENSION(:,:) :: XDZ ! depth of each level in canopy (m)
- REAL, POINTER, DIMENSION(:,:) :: XZF ! height of bottom of each level grid (m)
- REAL, POINTER, DIMENSION(:,:) :: XDZF ! depth between each level in canopy (m)
-!
-END TYPE ISBA_CANOPY_t
-
-
-
- CONTAINS
-
-!
-
-
-
-
-SUBROUTINE ISBA_CANOPY_INIT(YISBA_CANOPY)
-TYPE(ISBA_CANOPY_t), INTENT(INOUT) :: YISBA_CANOPY
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_ISBA_CANOPY_N:ISBA_CANOPY_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YISBA_CANOPY%XZ)
- NULLIFY(YISBA_CANOPY%XU)
- NULLIFY(YISBA_CANOPY%XT)
- NULLIFY(YISBA_CANOPY%XQ)
- NULLIFY(YISBA_CANOPY%XTKE)
- NULLIFY(YISBA_CANOPY%XLMO)
- NULLIFY(YISBA_CANOPY%XP)
- NULLIFY(YISBA_CANOPY%XDZ)
- NULLIFY(YISBA_CANOPY%XZF)
- NULLIFY(YISBA_CANOPY%XDZF)
-YISBA_CANOPY%NLVL=0
-IF (LHOOK) CALL DR_HOOK("MODD_ISBA_CANOPY_N:ISBA_CANOPY_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE ISBA_CANOPY_INIT
-
-
-END MODULE MODD_ISBA_CANOPY_n
diff --git a/src/SURFEX/modd_isba_optionsn.F90 b/src/SURFEX/modd_isba_optionsn.F90
new file mode 100644
index 0000000000000000000000000000000000000000..c2e68ad1d8cf9eb0f4ee3fa6f2595fb86f7d8639
--- /dev/null
+++ b/src/SURFEX/modd_isba_optionsn.F90
@@ -0,0 +1,346 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+!##################
+MODULE MODD_ISBA_OPTIONS_n
+!##################
+!
+!!**** *MODD_ISBA - declaration of packed surface parameters for ISBA scheme
+!!
+!! PURPOSE
+!! -------
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! A. Boone *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/09/02
+!! A.L. Gibelin 04/2009 : BIOMASS and RESP_BIOMASS arrays
+!! A.L. Gibelin 04/2009 : TAU_WOOD for NCB option
+!! A.L. Gibelin 05/2009 : Add carbon spinup
+!! A.L. Gibelin 06/2009 : Soil carbon variables for CNT option
+!! A.L. Gibelin 07/2009 : Suppress RDK and transform GPP as a diagnostic
+!! A.L. Gibelin 07/2009 : Suppress PPST and PPSTF as outputs
+!! P. Samuelsson 02/2012 : MEB
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+TYPE ISBA_OPTIONS_t
+!
+! * General PGD options
+!
+LOGICAL :: LECOCLIMAP ! T: parameters computed from ecoclimap
+! ! F: they are read in the file
+!
+LOGICAL :: LPAR ! T: parameters computed from ecoclimap
+! ! F: they are read in the file
+!
+INTEGER :: NPATCH ! maximum number of sub-tiles (patches)
+! ! used at any grid point within a
+! ! natural surface fraction
+INTEGER :: NGROUND_LAYER ! number of ground layers
+!
+ CHARACTER(LEN=3) :: CISBA ! type of ISBA version:
+! ! '2-L' (default)
+! ! '3-L'
+! ! 'DIF'
+ CHARACTER(LEN=4) :: CPEDOTF ! NOTE: Only used when HISBA = DIF
+! ! 'CH78' = Clapp and Hornberger 1978 for BC (Default)
+! ! 'CO84' = Cosby et al. 1988 for BC
+ CHARACTER(LEN=3) :: CPHOTO ! type of photosynthesis
+! ! 'NON'
+! ! 'AST'
+! ! 'NIT'
+! ! 'NCB'
+!
+REAL, POINTER, DIMENSION(:) :: XSOILGRID ! Soil layer grid as reference for DIF
+!
+LOGICAL :: LTR_ML ! new radiative transfert
+!
+REAL :: XRM_PATCH ! threshold to remove little fractions of patches
+!
+LOGICAL :: LSOCP ! Soil organic carbon profile data
+LOGICAL :: LCTI ! Topographic index data
+LOGICAL :: LPERM ! Permafrost distribution data
+LOGICAL :: LNOF
+!
+! Type of vegetation (simplification of vegetation charaterization)
+!
+CHARACTER(LEN=4) :: CTYPE_HVEG ! type of high vegetation
+CHARACTER(LEN=4) :: CTYPE_LVEG ! type of low vegetation
+CHARACTER(LEN=4) :: CTYPE_NVEG ! type of bare soil (no vegetation)
+CHARACTER(LEN=5) :: CTYP_COV ! type of green roof
+!
+! * AGS and Carbon PGD options
+!
+INTEGER :: NNBIOMASS ! number of biomass pools
+INTEGER :: NNLITTER ! number of litter pools
+INTEGER :: NNLITTLEVS ! number of litter levels
+INTEGER :: NNSOILCARB ! number of soil carbon pools
+!
+! * PGD MEB OPTIONS
+!
+LOGICAL, POINTER, DIMENSION(:) :: LMEB_PATCH ! Vector with T/F values
+ ! True = treat patch with multi-energy balance
+ ! False = treat patch with classical ISBA
+LOGICAL :: LFORC_MEASURE ! True = Forcing data from observations
+! ! False = Forcing data from atmospheric model (default)
+LOGICAL :: LMEB_LITTER ! Activate Litter
+LOGICAL :: LMEB_GNDRES ! Activate Ground Resistance
+!
+! * General PREP options
+!
+LOGICAL :: LCANOPY ! T: SBL scheme within the canopy
+! ! F: no atmospheric layers below forcing level
+!
+! * Carbon PREP options
+ CHARACTER(LEN=3) :: CRESPSL ! Soil respiration
+! ! 'DEF' = Default: Norman (1992)
+! ! 'PRM' = New Parameterization
+! ! 'CNT' = CENTURY model (Gibelin 2007)
+!
+!
+! * General MODEL options
+!
+ CHARACTER(LEN=4) :: CC1DRY ! C1 formulation for dry soils
+! ! 'DEF ' = DEFault: Giard-Bazile formulation
+! ! 'GB93' = Giordani 1993, Braud 1993
+! ! discontinuous at WILT
+ CHARACTER(LEN=4) :: CSCOND ! Thermal conductivity
+! ! 'DEF ' = DEFault: NP89 implicit method
+! ! 'PL98' = Peters-Lidard et al. 1998 used
+! ! for explicit computation of CG
+ CHARACTER(LEN=3) :: CSOILFRZ ! soil freezing-physics option
+! ! 'DEF' = Default (Boone et al. 2000;
+! ! Giard and Bazile 2000)
+! ! 'LWT' = Phase changes as above,
+! ! but relation between unfrozen
+! ! water and temperature considered
+ CHARACTER(LEN=4) :: CDIFSFCOND ! Mulch effects
+! ! 'MLCH' = include the insulating effect of
+! ! leaf litter/mulch on the surf. thermal cond.
+! ! 'DEF ' = no mulch effect
+! NOTE: Only used when YISBA = DIF
+ CHARACTER(LEN=3) :: CSNOWRES ! Turbulent exchanges over snow
+! ! 'DEF' = Default: Louis (ISBA)
+! ! 'RIL' = Maximum Richardson number limit
+! ! for stable conditions ISBA-SNOW3L
+! ! turbulent exchange option
+ CHARACTER(LEN=4) :: CALBEDO ! albedo type
+! ! 'DRY '
+! ! 'EVOL'
+! ! 'WET '
+! ! 'USER'
+! NOTE that when using the YISBA='DIF' multi-layer soil option,
+! the 'LWT' method is used. It is only an option
+! when using the force-restore soil method ('2-L' or '3-L')
+ CHARACTER(LEN=3) :: CCPSURF ! specific heat at surface
+! ! 'DRY' = default value (dry Cp)
+! ! 'HUM' = Cp as a fct of specific humidity
+!
+REAL :: XOUT_TSTEP ! ISBA output writing time step
+REAL :: XTSTEP ! ISBA time step
+REAL :: XCGMAX ! maximum soil heat capacity
+REAL :: XCDRAG ! drag coefficient in canopy
+!
+LOGICAL :: LGLACIER ! True = Over permanent snow and ice,
+! initialise WGI=WSAT,
+! Hsnow>=10m and allow 0.8<SNOALB<0.85
+ ! False = No specific treatment
+LOGICAL :: LCANOPY_DRAG ! T: drag activated in SBL scheme within the canopy
+! ! F: no drag activated in SBL atmospheric layers
+LOGICAL :: LVEGUPD ! True = update vegetation parameters every decade
+LOGICAL :: LPERTSURF ! True = apply random perturbations for ensemble prediction
+ ! False = no random perturbation (default)
+!
+!
+! * SGH model options
+!
+! - Adjustable physical parameters
+!
+INTEGER :: NLAYER_HORT
+INTEGER :: NLAYER_DUN
+!
+! - Sub-grid hydrology and vertical hydrology
+!
+ CHARACTER(LEN=4) :: CRUNOFF ! surface runoff formulation
+! ! 'WSAT'
+! ! 'DT92'
+! ! 'SGH ' Topmodel
+!
+ CHARACTER(LEN=3) :: CKSAT ! ksat
+! ! 'DEF' = default value
+! ! 'SGH' = profil exponentiel
+!
+LOGICAL :: LSOC ! soil organic carbon effect
+! ! False = default value
+! ! True = soil SOC profil
+!
+ CHARACTER(LEN=3) :: CRAIN ! Rainfall spatial distribution
+ ! 'DEF' = No rainfall spatial distribution
+ ! 'SGH' = Rainfall exponential spatial distribution
+ !
+!
+ CHARACTER(LEN=3) :: CHORT ! Horton runoff
+ ! 'DEF' = no Horton runoff
+ ! 'SGH' = Horton runoff
+!
+! * AGS and carbon options
+!
+LOGICAL :: LNITRO_DILU ! nitrogen dilution fct of CO2 (Calvet et al. 2008)
+ ! False = keep vegetation parameters constant in time
+!
+LOGICAL :: LSPINUPCARBS ! T: do the soil carb spinup, F: no
+LOGICAL :: LSPINUPCARBW ! T: do the wood carb spinup, F: no
+REAL :: XSPINMAXS ! max number of times CARBON_SOIL subroutine is
+ ! called for each timestep in simulation during
+ ! acceleration procedure number
+REAL :: XSPINMAXW ! max number of times the wood is accelerated
+REAL :: XCO2_START ! Pre-industrial CO2 concentration
+REAL :: XCO2_END ! Begin-transient CO2 concentration
+INTEGER :: NNBYEARSPINS ! nbr years needed to reaches soil equilibrium
+INTEGER :: NNBYEARSPINW ! nbr years needed to reaches wood equilibrium
+INTEGER :: NNBYEARSOLD ! nbr years executed at curent time step
+INTEGER :: NSPINS ! number of times the soil is accelerated
+INTEGER :: NSPINW ! number of times the wood is accelerated
+!
+LOGICAL :: LAGRI_TO_GRASS ! During soil carbon spinup with ISBA-CC,
+ ! grass parameters are attributed to all agricultural PFT
+!
+! * Snow model options
+!
+LOGICAL :: LSNOWDRIFT, LSNOWDRIFT_SUBLIM ! Logicals for snowdrift and sublimation
+
+LOGICAL :: LSNOW_ABS_ZENITH ! if True modify solar absorption as a function of solar zenithal angle
+ ! (physically wrong but better results in polar regions when CSNOWRAD=B92)
+! Scheme of snow metamorphism (Crocus)
+ CHARACTER(3) :: CSNOWMETAMO ! B92 (historical version, Brun et al 92), C13, T07, F06 (see Carmagnola et al 2014)
+!
+! radiative transfer scheme in snow (Crocus)
+ CHARACTER(3) :: CSNOWRAD ! B92 (historical version, Brun et al 92), TAR, TA1, TA2 (see Libois et al 2013)
+!
+! * Other options
+!
+LOGICAL :: LFLOOD ! Activation of the flooding scheme
+LOGICAL :: LWTD ! Activation of Water table depth coupling
+LOGICAL :: LCPL_RRM ! Activation of the coupling
+!
+LOGICAL :: LTEMP_ARP ! True = time-varying force-restore soil temperature (as in ARPEGE)
+ ! False = No time-varying force-restore soil temperature (Default
+INTEGER :: NTEMPLAYER_ARP ! Number of force-restore soil temperature layer, including Ts (Default = 4)
+ ! Only used if LTEMP_ARP=True
+REAL, POINTER, DIMENSION(:) :: XSODELX ! Pulsation for each layer (Only used if LTEMP_ARP=True)
+!
+END TYPE ISBA_OPTIONS_t
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+CONTAINS
+
+SUBROUTINE ISBA_OPTIONS_INIT(IO)
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_OPTIONS_N:ISBA_OPTIONS_INIT",0,ZHOOK_HANDLE)
+!
+NULLIFY(IO%XSOILGRID)
+NULLIFY(IO%LMEB_PATCH)
+!
+IO%CTYPE_HVEG=' '
+IO%CTYPE_LVEG=' '
+IO%CTYPE_NVEG=' '
+IO%CTYP_COV=' '
+IO%LPAR=.FALSE.
+IO%LECOCLIMAP=.FALSE.
+IO%NPATCH=0
+IO%NGROUND_LAYER=0
+IO%CISBA=' '
+IO%CPEDOTF=' '
+IO%CPHOTO=' '
+IO%LTR_ML=.FALSE.
+IO%XRM_PATCH=0.0
+IO%LSOCP=.FALSE.
+IO%LCTI=.FALSE.
+IO%LPERM=.FALSE.
+IO%LNOF=.FALSE.
+IO%NNBIOMASS=0
+IO%NNLITTER=0
+IO%NNLITTLEVS=0
+IO%NNSOILCARB=0
+IO%LFORC_MEASURE=.FALSE.
+IO%LMEB_LITTER=.FALSE.
+IO%LMEB_GNDRES=.FALSE.
+!
+IO%LCANOPY=.FALSE.
+IO%CRESPSL=' '
+!
+IO%CC1DRY=' '
+IO%CSCOND=' '
+IO%CSOILFRZ=' '
+IO%CDIFSFCOND=' '
+IO%CSNOWRES=' '
+IO%CALBEDO=' '
+IO%CCPSURF=' '
+IO%XOUT_TSTEP=0.
+IO%XTSTEP=0.
+IO%XCGMAX=0.
+IO%XCDRAG=0.
+IO%LGLACIER=.FALSE.
+IO%LCANOPY_DRAG=.FALSE.
+IO%LVEGUPD=.FALSE.
+IO%LPERTSURF=.FALSE.
+IO%NLAYER_HORT=0
+IO%NLAYER_DUN=0
+IO%CRUNOFF=' '
+IO%CKSAT=' '
+IO%CRAIN=' '
+IO%CHORT=' '
+IO%LSOC=.FALSE.
+IO%LNITRO_DILU=.FALSE.
+IO%LSPINUPCARBS=.FALSE.
+IO%LSPINUPCARBW=.FALSE.
+IO%XSPINMAXS=0.
+IO%XSPINMAXW=0.
+IO%XCO2_START=0.
+IO%XCO2_END=0.
+IO%NNBYEARSPINS=0
+IO%NNBYEARSPINW=0
+IO%NNBYEARSOLD=0
+IO%NSPINS=1
+IO%NSPINW=1
+IO%LAGRI_TO_GRASS=.FALSE.
+IO%LSNOWDRIFT=.TRUE.
+IO%LSNOWDRIFT_SUBLIM=.FALSE.
+IO%LSNOW_ABS_ZENITH=.FALSE.
+IO%CSNOWMETAMO='B92'
+IO%CSNOWRAD='B92'
+IO%LFLOOD=.FALSE.
+IO%LWTD=.FALSE.
+IO%LCPL_RRM=.FALSE.
+IO%LTEMP_ARP=.FALSE.
+IO%NTEMPLAYER_ARP=0
+!
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_OPTIONS_N:ISBA_OPTIONS_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE ISBA_OPTIONS_INIT
+
+END MODULE MODD_ISBA_OPTIONS_n
diff --git a/src/SURFEX/modd_isban.F90 b/src/SURFEX/modd_isban.F90
index 9a1c67e46a7b5673f742a2f196091d7042b62d77..ebab9b6f08f714acbb63206ddda07246e696f363 100644
--- a/src/SURFEX/modd_isban.F90
+++ b/src/SURFEX/modd_isban.F90
@@ -33,962 +33,786 @@ MODULE MODD_ISBA_n
!! A.L. Gibelin 07/2009 : Suppress RDK and transform GPP as a diagnostic
!! A.L. Gibelin 07/2009 : Suppress PPST and PPSTF as outputs
!! P. Samuelsson 02/2012 : MEB
+!! B. Decharme 10/2016 bug surface/groundwater coupling
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_TYPE_DATE_SURF
USE MODD_TYPE_SNOW
-!
+USE MODD_TYPE_DATE_SURF
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
-
-TYPE ISBA_t
-!-------------------------------------------------------------------------------
!
-! ISBA Scheme Options:
-!
- CHARACTER(LEN=4) :: CROUGH ! type of roughness length
- ! 'Z01D'
- ! 'Z04D'
- CHARACTER(LEN=3) :: CISBA ! type of ISBA version:
-! ! '2-L' (default)
-! ! '3-L'
-! ! 'DIF'
-!
- CHARACTER(LEN=4) :: CPEDOTF! NOTE: Only used when HISBA = DIF
-! ! 'CH78' = Clapp and Hornberger 1978 for BC (Default)
-! ! 'CO84' = Cosby et al. 1988 for BC
-!
- CHARACTER(LEN=3) :: CPHOTO ! type of photosynthesis
-! ! 'NON'
-! ! 'AGS'
-! ! 'LAI'
-! ! 'LST'
-! ! 'AST'
-! ! 'NIT'
-! ! 'NCB'
- LOGICAL :: LTR_ML ! new radiative transfert
- REAL :: XRM_PATCH ! threshold to remove little fractions of patches
- CHARACTER(LEN=4) :: CALBEDO ! albedo type
-! ! 'DRY '
-! ! 'EVOL'
-! ! 'WET '
-! ! 'USER'
- CHARACTER(LEN=4) :: CSCOND ! Thermal conductivity
-! ! 'DEF ' = DEFault: NP89 implicit method
-! ! 'PL98' = Peters-Lidard et al. 1998 used
-! ! for explicit computation of CG
- CHARACTER(LEN=4) :: CC1DRY ! C1 formulation for dry soils
-! ! 'DEF ' = DEFault: Giard-Bazile formulation
-! ! 'GB93' = Giordani 1993, Braud 1993
-! !discontinuous at WILT
- CHARACTER(LEN=3) :: CSOILFRZ ! soil freezing-physics option
-! ! 'DEF' = Default (Boone et al. 2000;
-! ! Giard and Bazile 2000)
-! ! 'LWT' = Phase changes as above,
-! ! but relation between unfrozen
-! ! water and temperature considered
-! NOTE that when using the YISBA='DIF' multi-layer soil option,
-! the 'LWT' method is used. It is only an option
-! when using the force-restore soil method ('2-L' or '3-L')
-!
- CHARACTER(LEN=4) :: CDIFSFCOND ! Mulch effects
-! ! 'MLCH' = include the insulating effect of
-! ! leaf litter/mulch on the surf. thermal cond.
-! ! 'DEF ' = no mulch effect
-! NOTE: Only used when YISBA = DIF
-!
- CHARACTER(LEN=3) :: CSNOWRES ! Turbulent exchanges over snow
-! ! 'DEF' = Default: Louis (ISBA)
-! ! 'RIL' = Maximum Richardson number limit
-! ! for stable conditions ISBA-SNOW3L
-! ! turbulent exchange option
-!
- CHARACTER(LEN=3) :: CRESPSL ! Soil respiration
-! ! 'DEF' = Default: Norman (1992)
-! ! 'PRM' = New Parameterization
-! ! 'CNT' = CENTURY model (Gibelin 2007)
-!
- CHARACTER(LEN=3) :: CCPSURF! specific heat at surface
-! ! 'DRY' = default value (dry Cp)
-! ! 'HUM' = Cp as a fct of specific humidity
-!
- LOGICAL :: LTEMP_ARP ! True = time-varying force-restore soil temperature (as in ARPEGE)
- ! False = No time-varying force-restore soil temperature (Default)
-!
- LOGICAL :: LGLACIER ! True = Over permanent snow and ice,
-! initialise WGI=WSAT,
-! Hsnow>=10m and allow 0.8<SNOALB<0.85
- ! False = No specific treatment
- LOGICAL, POINTER, DIMENSION(:) :: LMEB_PATCH ! Vector with T/F values
- ! True = treat patch with multi-energy balance
-! ! False = treat patch with classical ISBA
- LOGICAL :: LFORC_MEASURE ! True = Forcing data from observations
-! ! False = Forcing data from atmospheric model (default)
-!
- LOGICAL :: LMEB_LITTER ! Activate Litter
- LOGICAL :: LMEB_GNDRES ! Activate Ground Resistance
-!
- LOGICAL :: LVEGUPD ! True = update vegetation parameters every decade
- ! False = keep vegetation parameters constant in time
-!
- LOGICAL :: LNITRO_DILU ! nitrogen dilution fct of CO2 (Calvet et al. 2008)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
- LOGICAL :: LPERTSURF ! True = apply random perturbations for ensemble prediction
- ! False = no random perturbation (default)
-!-------------------------------------------------------------------------------
-! Snow options
- LOGICAL :: LSNOWDRIFT, LSNOWDRIFT_SUBLIM ! Logicals for snowdrift and sublimation
+TYPE ISBA_S_t
!
- LOGICAL :: LSNOW_ABS_ZENITH ! if True modify solar absorption as a function of solar zenithal angle
- ! (physically wrong but better results in polar regions when CSNOWRAD=B92)
-! Scheme of snow metamorphism (Crocus)
- CHARACTER(3) :: CSNOWMETAMO ! B92 (historical version, Brun et al 92), C13, T07, F06 (see Carmagnola et al 2014)
+! General surface parameters:
!
-! radiative transfer scheme in snow (Crocus)
- CHARACTER(3) :: CSNOWRAD ! B92 (historical version, Brun et al 92), TAR, TA1, TA2 (see Libois et al 2013)
-!-------------------------------------------------------------------------------
+REAL, POINTER, DIMENSION(:) :: XZS ! relief (m)
+REAL, POINTER, DIMENSION(:,:) :: XCOVER ! fraction of each ecosystem (-)
+LOGICAL, POINTER, DIMENSION(:):: LCOVER ! GCOVER(i)=T --> ith cover field is not 0.
!
- LOGICAL :: LCANOPY ! T: SBL scheme within the canopy
-! ! F: no atmospheric layers below forcing level
- LOGICAL :: LCANOPY_DRAG ! T: drag activated in SBL scheme within the canopy
-! ! F: no drag activated in SBL atmospheric layers
-!-------------------------------------------------------------------------------
+! Topmodel statistics
!
-! type of initialization of vegetation: from cover types (ecoclimap) or parameters prescribed
+REAL, POINTER, DIMENSION(:) :: XTI_MIN,XTI_MAX,XTI_MEAN,XTI_STD,XTI_SKEW
!
- LOGICAL :: LECOCLIMAP ! T: parameters computed from ecoclimap
-! ! F: they are read in the file
+REAL, POINTER, DIMENSION(:,:) :: XSOC ! soil organic carbon content (kg/m2)
+REAL, POINTER, DIMENSION(:) :: XPH ! soil pH
+REAL, POINTER, DIMENSION(:) :: XFERT ! soil fertilisation rate (kgN/ha/h)
!
- LOGICAL :: LCTI ! Topographic index data
- LOGICAL :: LSOCP ! Soil organic carbon profile data
- LOGICAL :: LPERM ! Permafrost distribution data
- LOGICAL :: LGW ! Groudwater distribution data
- LOGICAL :: LNOF
-!-------------------------------------------------------------------------------
!
-! Soil and wood carbon spin up
+REAL, POINTER, DIMENSION(:) :: XABC ! abscissa needed for integration
+! ! of net assimilation and stomatal
+! ! conductance over canopy depth (-)
+REAL, POINTER, DIMENSION(:) :: XPOI ! Gaussian weights for integration
+! ! of net assimilation and stomatal
+! ! conductance over canopy depth (-)
!
- LOGICAL :: LSPINUPCARBS ! T: do the soil carb spinup, F: no
- LOGICAL :: LSPINUPCARBW ! T: do the wood carb spinup, F: no
- LOGICAL :: LAGRI_TO_GRASS! During soil carbon spinup with ISBA-CC,
- ! grass parameters are attributed to all agricultural PFT
-!
- REAL :: XSPINMAXS ! max number of times CARBON_SOIL subroutine is
- ! called for each timestep in simulation during
- ! acceleration procedure number
- REAL :: XSPINMAXW ! max number of times the wood is accelerated
- REAL :: XCO2_START ! Pre-industrial CO2 concentration
- REAL :: XCO2_END ! Begin-transient CO2 concentration
- INTEGER :: NNBYEARSPINS ! nbr years needed to reaches soil equilibrium
- INTEGER :: NNBYEARSPINW ! nbr years needed to reaches wood equilibrium
- INTEGER :: NNBYEARSOLD ! nbr years executed at curent time step
- INTEGER :: NSPINS ! number of times the soil is accelerated
- INTEGER :: NSPINW ! number of times the wood is accelerated
+TYPE (DATE_TIME) :: TTIME
!
-!-------------------------------------------------------------------------------
+REAL, POINTER, DIMENSION(:,:) :: XTAB_FSAT !Satured fraction array
+REAL, POINTER, DIMENSION(:,:) :: XTAB_WTOP !Active TOPMODEL-layer array
+REAL, POINTER, DIMENSION(:,:) :: XTAB_QTOP !Subsurface flow TOPMODEL array
!
-! Mask and number of grid elements containing patches/tiles:
+REAL, POINTER, DIMENSION(:) :: XF_PARAM
+REAL, POINTER, DIMENSION(:) :: XC_DEPTH_RATIO
!
- INTEGER, POINTER, DIMENSION(:) :: NSIZE_NATURE_P ! number of sub-patchs/tiles (-)
- INTEGER, POINTER, DIMENSION(:,:) :: NR_NATURE_P ! patch/tile mask (-)
- REAL, POINTER, DIMENSION(:,:) :: XPATCH ! fraction of each tile/patch (-)
- REAL, POINTER, DIMENSION(:,:) :: XPATCH_OLD ! fraction of each tile/patch for land use
- REAL, POINTER, DIMENSION(:,:) :: XVEGTYPE ! fraction of each vegetation type for
-! ! each grid mesh (-)
- REAL, POINTER, DIMENSION(:,:,:) :: XVEGTYPE_PATCH ! fraction of each vegetation type for
-! ! each vegetation unit/patch (-)
- INTEGER :: NPATCH ! maximum number of sub-tiles (patches)
-! ! used at any grid point within a
-! ! natural surface fraction
- INTEGER :: NGROUND_LAYER ! number of ground layers
+! - Coupling with river routing model
+!
+REAL, POINTER, DIMENSION(:) :: XCPL_DRAIN ! Surface runoff
+REAL, POINTER, DIMENSION(:) :: XCPL_RUNOFF ! Deep drainage or gourdwater recharge
+REAL, POINTER, DIMENSION(:) :: XCPL_ICEFLUX ! Calving flux
+REAL, POINTER, DIMENSION(:) :: XCPL_EFLOOD ! floodplains evaporation
+REAL, POINTER, DIMENSION(:) :: XCPL_PFLOOD ! floodplains precipitation interception
+REAL, POINTER, DIMENSION(:) :: XCPL_IFLOOD ! floodplains infiltration
!
- REAL, POINTER, DIMENSION(:) :: XSOILGRID ! Soil layer grid as reference for DIF
+! - Random perturbations
!
- INTEGER :: NTEMPLAYER_ARP ! Number of force-restore soil temperature layer, including Ts (Default = 4)
- ! Only used if LTEMP_ARP=True
+REAL, POINTER, DIMENSION(:) :: XPERTVEG
+REAL, POINTER, DIMENSION(:) :: XPERTLAI
+REAL, POINTER, DIMENSION(:) :: XPERTCV
+REAL, POINTER, DIMENSION(:) :: XPERTALB
+REAL, POINTER, DIMENSION(:) :: XPERTZ0
!
- REAL, POINTER, DIMENSION(:) :: XSODELX ! Pulsation for each layer (Only used if LTEMP_ARP=True)
+REAL, POINTER, DIMENSION(:) :: XTSRAD_NAT ! patch averaged radiative temperature (K)
!
- INTEGER :: NNBIOMASS ! number of biomass pools
- INTEGER :: NNLITTER ! number of litter pools
- INTEGER :: NNLITTLEVS ! number of litter levels
- INTEGER :: NNSOILCARB ! number of soil carbon pools
+REAL, POINTER, DIMENSION(:) :: XEMIS_NAT ! patch averaged emissivity (-)
!
-!-------------------------------------------------------------------------------
+! - Assimilation: ENKF
!
-! General surface parameters:
+REAL, POINTER, DIMENSION(:,:) :: XFRACSOC ! Fraction of organic carbon in each soil layer
!
- REAL, POINTER, DIMENSION(:) :: XZS ! relief (m)
- REAL, POINTER, DIMENSION(:,:) :: XCOVER ! fraction of each ecosystem (-)
- LOGICAL, POINTER, DIMENSION(:):: LCOVER ! GCOVER(i)=T --> ith cover field is not 0.
+REAL, POINTER, DIMENSION(:,:) :: XVEGTYPE
!
-! Averaged Surface radiative parameters:
+REAL, POINTER, DIMENSION(:,:) :: XPATCH ! fraction of each tile/patch (-)
!
- REAL, POINTER, DIMENSION(:) :: XALBNIR_DRY ! dry soil near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBVIS_DRY ! dry soil visible albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBUV_DRY ! dry soil UV albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBNIR_WET ! wet soil near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBVIS_WET ! wet soil visible albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBUV_WET ! wet soil UV albedo (-)
- REAL, POINTER, DIMENSION(:,:) :: XALBNIR_SOIL ! soil near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:,:) :: XALBVIS_SOIL ! soil visible albedo (-)
- REAL, POINTER, DIMENSION(:,:) :: XALBUV_SOIL ! soil UV albedo (-)
- REAL, POINTER, DIMENSION(:) :: XEMIS_NAT ! patch averaged emissivity (-)
- REAL, POINTER, DIMENSION(:) :: XTSRAD_NAT ! patch averaged radiative temperature (K)
+! Mask and number of grid elements containing patches/tiles:
!
-! Subgrid orography parameters
+REAL, POINTER, DIMENSION(:,:,:) :: XVEGTYPE_PATCH ! fraction of each vegetation type for
!
- REAL, DIMENSION(:), POINTER :: XAOSIP,XAOSIM,XAOSJP,XAOSJM
-! directional A/S quantities in 4 coordinate directions
-! (IP: i index up; IM: i index down; JP: j index up; JM: j index down)
-! They are used in soil routines to compute effective roughness length
+REAL, POINTER, DIMENSION(:,:) :: XINNOV
+REAL, POINTER, DIMENSION(:,:) :: XRESID
!
- REAL, DIMENSION(:), POINTER :: XHO2IP,XHO2IM,XHO2JP,XHO2JM
-! directional h/2 quantities in 4 coordinate directions
-! (IP: i index up; IM: i index down; JP: j index up; JM: j index down)
-! They are used in soil routines to compute effective roughness length
+REAL, POINTER, DIMENSION(:,:) :: XWORK_WR
!
- REAL, DIMENSION(:,:), POINTER :: XZ0EFFIP,XZ0EFFIM,XZ0EFFJP,XZ0EFFJM
-! directional total roughness lenghts in 4 coordinate directions
-! (IP: i index up; IM: i index down; JP: j index up; JM: j index down)
+REAL, POINTER, DIMENSION(:,:,:) :: XWSN_WR
+REAL, POINTER, DIMENSION(:,:,:) :: XRHO_WR
+REAL, POINTER, DIMENSION(:,:,:) :: XHEA_WR
+REAL, POINTER, DIMENSION(:,:,:) :: XAGE_WR
+REAL, POINTER, DIMENSION(:,:,:) :: XSG1_WR
+REAL, POINTER, DIMENSION(:,:,:) :: XSG2_WR
+REAL, POINTER, DIMENSION(:,:,:) :: XHIS_WR
+REAL, POINTER, DIMENSION(:,:,:) :: XT_WR
+REAL, POINTER, DIMENSION(:,:) :: XALB_WR
!
- REAL, DIMENSION(:), POINTER :: XZ0EFFJPDIR ! heading of J direction (deg from N clockwise)
+TYPE(DATE_TIME), POINTER, DIMENSION(:,:) :: TDATE_WR
!
- REAL, DIMENSION(:), POINTER :: XZ0REL ! relief roughness length (m)
+END TYPE ISBA_S_t
!
- REAL, DIMENSION(:), POINTER :: XSSO_SLOPE ! slope of S.S.O. (-)
- REAL, DIMENSION(:), POINTER :: XSSO_STDEV ! relief standard deviation (m)
-!-------------------------------------------------------------------------------
!
-! Input Parameters, per patch:
-!
-! - vegetation + bare soil:
-!
- REAL, POINTER, DIMENSION(:,:) :: XZ0_O_Z0H ! ratio of surface roughness lengths
-! ! (momentum to heat) (-)
- REAL, POINTER, DIMENSION(:,:) :: XALBNIR ! near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:,:) :: XALBVIS ! visible albedo (-)
- REAL, POINTER, DIMENSION(:,:) :: XALBUV ! UV albedo (-)
- REAL, POINTER, DIMENSION(:,:) :: XEMIS ! surface emissivity (-)
- REAL, POINTER, DIMENSION(:,:) :: XZ0 ! surface roughness length (m)
-!
-! - vegetation:
-!
- REAL, POINTER, DIMENSION(:,:) :: XALBNIR_VEG ! vegetation near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:,:) :: XALBVIS_VEG ! vegetation visible albedo (-)
- REAL, POINTER, DIMENSION(:,:) :: XALBUV_VEG ! vegetation UV albedo (-)
-!
-! - vegetation: default option (Jarvis) and general parameters:
-!
- REAL, POINTER, DIMENSION(:,:) :: XVEG ! vegetation cover fraction (-)
- REAL, POINTER, DIMENSION(:,:) :: XWRMAX_CF ! coefficient for maximum water
-! ! interception
-! ! storage capacity on the vegetation (-)
- REAL, POINTER, DIMENSION(:,:) :: XRSMIN ! minimum stomatal resistance (s/m)
- REAL, POINTER, DIMENSION(:,:) :: XGAMMA ! coefficient for the calculation
-! ! of the surface stomatal
-! ! resistance
- REAL, POINTER, DIMENSION(:,:) :: XCV ! vegetation thermal inertia coefficient (K m2/J)
- REAL, POINTER, DIMENSION(:,:) :: XRGL ! maximum solar radiation
-! ! usable in photosynthesis (W/m2)
- REAL, POINTER, DIMENSION(:,:,:) :: XROOTFRAC ! root fraction profile ('DIF' option)
-!
-! - Multi-energy balance (MEB) parameters.
-! - Postfix GV denotes understory ground vegetation
-!
- REAL, POINTER, DIMENSION(:,:) :: XGNDLITTER ! ground litter fraction (-)
- REAL, POINTER, DIMENSION(:,:) :: XRGLGV ! understory veg maximum solar radiation
-! ! usable in photosynthesis (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XGAMMAGV ! understory veg coefficient for the calculation
-! ! of the surface stomatal resistance
- REAL, POINTER, DIMENSION(:,:) :: XRSMINGV ! understory veg minimum stomatal resistance (s/m)
- REAL, POINTER, DIMENSION(:,:,:) :: XROOTFRACGV ! understory veg root fraction profile
- REAL, POINTER, DIMENSION(:,:) :: XWRMAX_CFGV ! understory veg coefficient for maximum water
-! ! interception
- REAL, POINTER, DIMENSION(:,:) :: XLAIGV ! understory veg Leaf Area Index (m2/m2)
- REAL, POINTER, DIMENSION(:,:) :: XZ0LITTER ! ground litter roughness length (m)
-!
- REAL, POINTER, DIMENSION(:,:) :: XH_VEG ! height of vegetation (m)
+TYPE ISBA_K_t
!
-!-------------------------------------------------------------------------------
+REAL, POINTER, DIMENSION(:,:) :: XSAND ! sand fraction (-)
+REAL, POINTER, DIMENSION(:,:) :: XCLAY ! clay fraction (-)
!
-! - vegetation: Ags parameters ('AGS', 'LAI', 'AST', 'LST', 'NIT', 'NCB' options)
-!
- REAL, POINTER, DIMENSION(:) :: XABC ! abscissa needed for integration
-! ! of net assimilation and stomatal
-! ! conductance over canopy depth (-)
- REAL, POINTER, DIMENSION(:) :: XPOI ! Gaussian weights for integration
-! ! of net assimilation and stomatal
-! ! conductance over canopy depth (-)
- REAL, POINTER, DIMENSION(:,:) :: XBSLAI ! ratio d(biomass)/d(lai) (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XLAIMIN ! minimum LAI (Leaf Area Index) (m2/m2)
- REAL, POINTER, DIMENSION(:,:) :: XSEFOLD ! e-folding time for senescence (s)
- REAL, POINTER, DIMENSION(:,:) :: XTAU_WOOD ! residence time in woody biomass (s)
- REAL, POINTER, DIMENSION(:,:) :: XH_TREE ! height of trees (m)
- REAL, POINTER, DIMENSION(:,:) :: XANF ! total assimilation over canopy (
- REAL, POINTER, DIMENSION(:,:) :: XANMAX ! maximum photosynthesis rate (
- REAL, POINTER, DIMENSION(:,:) :: XFZERO ! ideal value of F, no photo-
-! ! respiration or saturation deficit (
- REAL, POINTER, DIMENSION(:,:) :: XEPSO ! maximum initial quantum use
-! ! efficiency (mg J-1 PAR)
- REAL, POINTER, DIMENSION(:,:) :: XGAMM ! CO2 conpensation concentration (ppm)
- REAL, POINTER, DIMENSION(:,:) :: XQDGAMM ! Log of Q10 function for CO2 conpensation
-! ! concentration (-)
- REAL, POINTER, DIMENSION(:,:) :: XGMES ! mesophyll conductance (m s-1)
- REAL, POINTER, DIMENSION(:,:) :: XRE25 ! Ecosystem respiration parameter (kg/kg.m.s-1)
- REAL, POINTER, DIMENSION(:,:) :: XQDGMES ! Log of Q10 function for mesophyll conductance (-)
- REAL, POINTER, DIMENSION(:,:) :: XT1GMES ! reference temperature for computing
-! ! compensation concentration function for
-! ! mesophyll conductance: minimum
-! ! temperature (K)
- REAL, POINTER, DIMENSION(:,:) :: XT2GMES ! reference temperature for computing
-! ! compensation concentration function for
-! ! mesophyll conductance: maximum
-! ! temperature (K)
- REAL, POINTER, DIMENSION(:,:) :: XAMAX ! leaf photosynthetic capacity (mg m-2 s-1)
- REAL, POINTER, DIMENSION(:,:) :: XQDAMAX ! Log of Q10 function for leaf photosynthetic
-! ! capacity (-)
- REAL, POINTER, DIMENSION(:,:) :: XT1AMAX ! reference temperature for computing
-! ! compensation concentration function for
-! ! leaf photosynthetic capacity: minimum
-! ! temperature (K)
- REAL, POINTER, DIMENSION(:,:) :: XT2AMAX ! reference temperature for computing
-! ! compensation concentration function for
-! ! leaf photosynthetic capacity: maximum
-! ! temperature (K)
+REAL, POINTER, DIMENSION(:) :: XPERM ! permafrost distribution (-)
!
-!-------------------------------------------------------------------------------
+REAL, POINTER, DIMENSION(:) :: XRUNOFFB ! sub-grid dt92 surface runoff slope parameter (-)
+REAL, POINTER, DIMENSION(:) :: XWDRAIN ! continuous drainage parameter (-)
!
-! - vegetation: Ags Stress parameters ('AST', 'LST', 'NIT', 'NCB' options)
!
- LOGICAL, POINTER, DIMENSION(:,:) :: LSTRESS ! vegetation response type to water
-! ! stress (true:defensive false:offensive) (-)
- REAL, POINTER, DIMENSION(:,:) :: XF2I ! critical normilized soil water
-! ! content for stress parameterisation
- REAL, POINTER, DIMENSION(:,:) :: XGC ! cuticular conductance (m s-1)
- REAL, POINTER, DIMENSION(:,:) :: XAH ! coefficients for herbaceous water stress
-! ! response (offensive or defensive) (log(mm/s))
- REAL, POINTER, DIMENSION(:,:) :: XBH ! coefficients for herbaceous water stress
-! ! response (offensive or defensive) (-)
- REAL, POINTER, DIMENSION(:,:) :: XDMAX ! maximum air saturation deficit
-! ! tolerate by vegetation (kg/kg)
+REAL, POINTER, DIMENSION(:) :: XTDEEP ! prescribed deep soil temperature
+! ! (optional)
+REAL, POINTER, DIMENSION(:) :: XGAMMAT ! 'Force-Restore' timescale when using a
+! ! prescribed lower boundary temperature (1/days)
!
-!-------------------------------------------------------------------------------
+REAL, POINTER, DIMENSION(:,:) :: XMPOTSAT ! matric potential at saturation (m)
+REAL, POINTER, DIMENSION(:,:) :: XBCOEF ! soil water CH78 b-parameter (-)
+REAL, POINTER, DIMENSION(:,:) :: XWWILT ! wilting point volumetric water content
+! ! profile (m3/m3)
+REAL, POINTER, DIMENSION(:,:) :: XWFC ! field capacity volumetric water content
+! ! profile (m3/m3)
+REAL, POINTER, DIMENSION(:,:) :: XWSAT ! porosity profile (m3/m3)
!
-! - vegetation: Ags Nitrogen-model parameters ('NIT', 'NCB' option)
+REAL, POINTER, DIMENSION(:) :: XCGSAT ! soil thermal inertia coefficient at
+! ! saturation
+REAL, POINTER, DIMENSION(:) :: XC4B ! 'Force-Restore' sub-surface vertical
+! ! diffusion coefficient (slope parameter) (-)
+REAL, POINTER, DIMENSION(:) :: XACOEF ! 'Force-Restore' surface vertical
+! ! diffusion coefficient (-)
+REAL, POINTER, DIMENSION(:) :: XPCOEF ! 'Force-Restore' surface vertical
+! ! diffusion coefficient (-)
+REAL, POINTER, DIMENSION(:,:) :: XHCAPSOIL ! soil heat capacity (J/K/m3)
+REAL, POINTER, DIMENSION(:,:) :: XCONDDRY ! soil dry thermal conductivity (W/m/K)
+REAL, POINTER, DIMENSION(:,:) :: XCONDSLD ! soil solids thermal conductivity (W/m/K)
!
- REAL, POINTER, DIMENSION(:,:) :: XCE_NITRO ! leaf aera ratio sensitivity to
-! ! nitrogen concentration (m2/kg)
- REAL, POINTER, DIMENSION(:,:) :: XCF_NITRO ! lethal minimum value of leaf area
-! ! ratio (m2/kg)
- REAL, POINTER, DIMENSION(:,:) :: XCNA_NITRO ! nitrogen concentration of active
-! ! biomass (kg/kg)
- REAL, POINTER, DIMENSION(:,:) :: XBSLAI_NITRO ! biomass/LAI ratio from nitrogen
-! ! decline theory (kg/m2)
+! - Water table depth coupling
+!
+REAL, POINTER, DIMENSION(:) :: XFWTD ! grid-cell fraction of water table rise
+REAL, POINTER, DIMENSION(:) :: XWTD ! water table depth (negative below soil surface) (m)
!
-!-------------------------------------------------------------------------------
+! * Physiographic radiative fields
!
-! - soil: primary parameters
+REAL, POINTER, DIMENSION(:) :: XALBNIR_DRY ! dry soil near-infra-red albedo (-)
+REAL, POINTER, DIMENSION(:) :: XALBVIS_DRY ! dry soil visible albedo (-)
+REAL, POINTER, DIMENSION(:) :: XALBUV_DRY ! dry soil UV albedo (-)
+REAL, POINTER, DIMENSION(:) :: XALBNIR_WET ! wet soil near-infra-red albedo (-)
+REAL, POINTER, DIMENSION(:) :: XALBVIS_WET ! wet soil visible albedo (-)
+REAL, POINTER, DIMENSION(:) :: XALBUV_WET ! wet soil UV albedo (-)
!
- REAL, POINTER, DIMENSION(:,:) :: XSAND ! sand fraction (-)
- REAL, POINTER, DIMENSION(:,:) :: XCLAY ! clay fraction (-)
- REAL, POINTER, DIMENSION(:,:) :: XSOC ! soil organic carbon content (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XPERM ! permafrost distribution (-)
- REAL, POINTER, DIMENSION(:) :: XGW ! groundwater distribution (-)
-
- REAL, POINTER, DIMENSION(:) :: XWDRAIN ! continuous drainage parameter (-)
- REAL, POINTER, DIMENSION(:) :: XTAUICE ! soil freezing characteristic timescale (s)
- REAL, POINTER, DIMENSION(:) :: XGAMMAT ! 'Force-Restore' timescale when using a
-! ! prescribed lower boundary temperature (1/days)
- REAL, POINTER, DIMENSION(:,:,:) :: XDG ! soil layer depth (m)
-! ! NOTE: in Force-Restore mode, the
-! ! uppermost layer depth is superficial
-! ! and is only explicitly used for soil
-! ! water phase changes (m)
- REAL, POINTER, DIMENSION(:,:,:) :: XDG_OLD ! For land use
-!
- REAL, POINTER, DIMENSION(:,:,:) :: XDZG ! soil layers thicknesses (DIF option)
- REAL, POINTER, DIMENSION(:,:,:) :: XDZDIF ! distance between consecuative layer mid-points (DIF option)
-!
- INTEGER, POINTER, DIMENSION(:,:) :: NWG_LAYER ! Number of soil moisture layers for DIF
- REAL, POINTER, DIMENSION(:,:) :: XDROOT ! effective root depth for DIF (m)
- REAL, POINTER, DIMENSION(:,:) :: XDG2 ! root depth for DIF as 3-L (m)
-!
- REAL, POINTER, DIMENSION(:) :: XPH ! soil pH
- REAL, POINTER, DIMENSION(:) :: XFERT ! soil fertilisation rate (kgN/ha/h)
+! * SGH initializations
!
-!-------------------------------------------------------------------------------
+REAL, POINTER, DIMENSION(:,:) :: XWD0 ! water content equivalent to TOPMODEL maximum deficit
+REAL, POINTER, DIMENSION(:,:) :: XKANISO ! Anisotropy coeficient for hydraulic conductivity
!
-! - soil: Secondary parameters: hydrology
-!
- REAL, POINTER, DIMENSION(:,:) :: XC1SAT ! 'Force-Restore' C1 coefficient at
-! ! saturation (-)
- REAL, POINTER, DIMENSION(:,:) :: XC2REF ! 'Force-Restore' reference value of C2 (-)
- REAL, POINTER, DIMENSION(:,:,:) :: XC3 ! 'Force-Restore' C3 drainage coefficient (m)
- REAL, POINTER, DIMENSION(:) :: XC4B ! 'Force-Restore' sub-surface vertical
-! ! diffusion coefficient (slope parameter) (-)
- REAL, POINTER, DIMENSION(:,:) :: XC4REF ! 'Force-Restore' sub-surface vertical
-! ! diffusion coefficient (-)
- REAL, POINTER, DIMENSION(:) :: XACOEF ! 'Force-Restore' surface vertical
-! ! diffusion coefficient (-)
- REAL, POINTER, DIMENSION(:) :: XPCOEF ! 'Force-Restore' surface vertical
-! ! diffusion coefficient (-)
- REAL, POINTER, DIMENSION(:,:) :: XWFC ! field capacity volumetric water content
-! ! profile (m3/m3)
- REAL, POINTER, DIMENSION(:,:) :: XWWILT ! wilting point volumetric water content
-! ! profile (m3/m3)
- REAL, POINTER, DIMENSION(:,:) :: XWSAT ! porosity profile (m3/m3)
- REAL, POINTER, DIMENSION(:,:) :: XBCOEF ! soil water CH78 b-parameter (-)
- REAL, POINTER, DIMENSION(:,:,:) :: XCONDSAT ! hydraulic conductivity at saturation (m/s)
- REAL, POINTER, DIMENSION(:,:) :: XMPOTSAT ! matric potential at saturation (m)
+REAL, POINTER, DIMENSION(:) :: XMUF ! fraction of the grid cell reached by the rainfall
+REAL, POINTER, DIMENSION(:) :: XFSAT ! Topmodel or dt92 saturated fracti
!
-REAL, POINTER, DIMENSION(:) :: XF_PARAM
-REAL, POINTER, DIMENSION(:) :: XC_DEPTH_RATIO
-!-------------------------------------------------------------------------------
+REAL, POINTER, DIMENSION(:) :: XFFLOOD ! Grid-cell flood fraction
+REAL, POINTER, DIMENSION(:) :: XPIFLOOD ! flood potential infiltration (kg/m2/s)
!
-! - soil: Secondary parameters: thermal
+! - Flood scheme
!
- REAL, POINTER, DIMENSION(:) :: XCGSAT ! soil thermal inertia coefficient at
-! ! saturation (K m2/J)
- REAL, POINTER, DIMENSION(:,:) :: XHCAPSOIL ! soil heat capacity (J/K/m3)
- REAL, POINTER, DIMENSION(:,:) :: XCONDDRY ! soil dry thermal conductivity (W/m/K)
- REAL, POINTER, DIMENSION(:,:) :: XCONDSLD ! soil solids thermal conductivity (W/m/K)
- REAL, POINTER, DIMENSION(:) :: XTDEEP ! prescribed deep soil temperature
-! ! (optional) (K)
-!-------------------------------------------------------------------------------
+REAL, POINTER, DIMENSION(:) :: XFF ! Total Flood fraction
+REAL, POINTER, DIMENSION(:) :: XFFG ! Flood fraction over ground
+REAL, POINTER, DIMENSION(:) :: XFFV ! Flood fraction over vegetation
+REAL, POINTER, DIMENSION(:) :: XFFROZEN ! Fraction of frozen floodplains
+REAL, POINTER, DIMENSION(:) :: XALBF ! Flood albedo
+REAL, POINTER, DIMENSION(:) :: XEMISF ! Flood emissivity
!
-! Prognostic variables:
+! - Snow and flood fractions and total albedo at time t: (-)
!
-! - Snow Cover:
+REAL, POINTER, DIMENSION(:,:) :: XDIR_ALB_WITH_SNOW ! total direct albedo by bands
+REAL, POINTER, DIMENSION(:,:) :: XSCA_ALB_WITH_SNOW ! total diffuse albedo by bands
!
- TYPE(SURF_SNOW) :: TSNOW ! snow state:
-! ! scheme type/option (-)
-! ! number of layers (-)
-! ! snow (& liq. water) content (kg/m2)
-! ! heat content (J/m2)
-! ! temperature (K)
-! ! density (kg m-3)
+REAL, POINTER, DIMENSION(:,:) :: XVEGTYPE
!
-!-------------------------------------------------------------------------------
+END TYPE ISBA_K_t
!
-! - Soil and vegetation heat and water:
!
- REAL, POINTER, DIMENSION(:,:) :: XWR ! liquid water retained on the
-! ! foliage of the vegetation
-! ! canopy (kg/m2)
- REAL, POINTER, DIMENSION(:,:,:) :: XTG ! surface and sub-surface soil
-! ! temperature profile (K)
- REAL, POINTER, DIMENSION(:,:,:) :: XWG ! soil volumetric water content profile (m3/m3)
- REAL, POINTER, DIMENSION(:,:,:) :: XWGI ! soil liquid water equivalent volumetric
-! ! ice content profile (m3/m3)
- REAL, POINTER, DIMENSION(:,:) :: XRESA ! aerodynamic resistance (s/m)
-
- REAL, POINTER, DIMENSION(:,:) :: XPCPS
- REAL, POINTER, DIMENSION(:,:) :: XPLVTT
- REAL, POINTER, DIMENSION(:,:) :: XPLSTT
+TYPE ISBA_P_t
!
-! - For multi-energy balance:
+INTEGER :: NSIZE_P ! number of sub-patchs/tiles (-)
!
- REAL, POINTER, DIMENSION(:,:) :: XWRL ! liquid water retained on litter (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XWRLI ! ice retained on litter (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XWRVN ! snow retained on the foliage
-! ! of the canopy vegetation (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XTV ! canopy vegetation temperature (K)
- REAL, POINTER, DIMENSION(:,:) :: XTL ! litter temperature (K)
- REAL, POINTER, DIMENSION(:,:) :: XTC ! canopy air temperature (K)
- REAL, POINTER, DIMENSION(:,:) :: XQC ! canopy air specific humidity (kg/kg)
+REAL, POINTER, DIMENSION(:) :: XPATCH ! fraction of each tile/patch (-)
!
-!-------------------------------------------------------------------------------
+! Mask and number of grid elements containing patches/tiles:
!
-! - Vegetation: Ags Prognostic (YPHOTO = ('LAI', 'LST', or 'NIT') or prescribed (YPHOTO='NON', 'AGS' or 'LST')
+REAL, POINTER, DIMENSION(:,:) :: XVEGTYPE_PATCH ! fraction of each vegetation type for
+!
+INTEGER, POINTER, DIMENSION(:) :: NR_P ! patch/tile mask
+!
+REAL, POINTER, DIMENSION(:) :: XPATCH_OLD ! fraction of each tile/patchfor land use (-)
+!
+!
+REAL, POINTER, DIMENSION(:) :: XANMAX ! maximum photosynthesis rate (
+REAL, POINTER, DIMENSION(:) :: XFZERO ! ideal value of F, no photo-
+! ! respiration or saturation deficit
+REAL, POINTER, DIMENSION(:) :: XEPSO ! maximum initial quantum use
+! ! efficiency (mg J-1 PAR)
+REAL, POINTER, DIMENSION(:) :: XGAMM ! CO2 conpensation concentration (ppm)
+REAL, POINTER, DIMENSION(:) :: XQDGAMM ! Log of Q10 function for CO2 conpensation
+! ! concentration (-)
+REAL, POINTER, DIMENSION(:) :: XQDGMES ! Log of Q10 function for mesophyll conductance (-)
+REAL, POINTER, DIMENSION(:) :: XT1GMES ! reference temperature for computing
+! ! compensation concentration function for
+! ! mesophyll conductance: minimum
+! ! temperature (K)
+REAL, POINTER, DIMENSION(:) :: XT2GMES ! reference temperature for computing
+! ! compensation concentration function for
+! ! mesophyll conductance: maximum
+! ! temperature (K)
+REAL, POINTER, DIMENSION(:) :: XAMAX ! leaf photosynthetic capacity (mg m-2 s-1)
+REAL, POINTER, DIMENSION(:) :: XQDAMAX ! Log of Q10 function for leaf photosynthetic
+! ! capacity (-)
+REAL, POINTER, DIMENSION(:) :: XT1AMAX ! reference temperature for computing
+! ! compensation concentration function for
+! ! leaf photosynthetic capacity: minimum
+! ! temperature (K)
+REAL, POINTER, DIMENSION(:) :: XT2AMAX ! reference temperature for computing
+! ! compensation concentration function for
+! ! leaf photosynthetic capacity: maximum
+! ! temperature (K)
+REAL, POINTER, DIMENSION(:) :: XAH ! coefficients for herbaceous water stress
+! ! response (offensive or defensive) (log(mm/s))
+REAL, POINTER, DIMENSION(:) :: XBH ! coefficients for herbaceous water stress
+! ! response (offensive or defensive)
+REAL, POINTER, DIMENSION(:) :: XTAU_WOOD ! residence time in woody biomass (s)
+REAL, POINTER, DIMENSION(:,:) :: XINCREASE ! biomass increase (kg/m2/day)
+REAL, POINTER, DIMENSION(:,:) :: XTURNOVER ! turnover rates from biomass to litter (gC/m2/s)
+!
+! *Soil hydraulic characteristics
+!
+REAL, POINTER, DIMENSION(:,:) :: XCONDSAT ! hydraulic conductivity at saturation (m/s)
+!
+REAL, POINTER, DIMENSION(:) :: XTAUICE ! soil freezing characteristic timescale (s)
+!
+REAL, POINTER, DIMENSION(:) :: XC1SAT ! 'Force-Restore' C1 coefficient at
+! ! saturation (-)
+REAL, POINTER, DIMENSION(:) :: XC2REF ! 'Force-Restore' reference value of C2 (-)
+REAL, POINTER, DIMENSION(:,:) :: XC3 ! 'Force-Restore' C3 drainage coefficient (m)
+REAL, POINTER, DIMENSION(:) :: XC4REF ! 'Force-Restore' sub-surface vertical
+! ! for lateral drainage ('DIF' option)
+!
+REAL, POINTER, DIMENSION(:) :: XBSLAI_NITRO ! biomass/LAI ratio from nitrogen
+! ! decline theory (kg/m2)
+! * Soil thermal characteristics
+!
+REAL, POINTER, DIMENSION(:) :: XCPS
+REAL, POINTER, DIMENSION(:) :: XLVTT
+REAL, POINTER, DIMENSION(:) :: XLSTT
+!
+! * Initialize hydrology
+!
+ REAL, POINTER, DIMENSION(:) :: XRUNOFFD ! depth over which sub-grid runoff is
+! ! computed: in Force-Restore this is the
+! ! total soil column ('2-L'), or root zone
+! ! ('3-L'). For the 'DIF' option, it can
+! ! be any depth within soil column (m)
+!
+REAL, POINTER, DIMENSION(:,:) :: XDZG ! soil layers thicknesses (DIF option)
+REAL, POINTER, DIMENSION(:,:) :: XDZDIF ! distance between consecuative layer mid-points (DIF option)
+REAL, POINTER, DIMENSION(:,:) :: XSOILWGHT ! VEG-DIF: weights for vertical
+! ! integration of soil water and properties
+!
+REAL, POINTER, DIMENSION(:) :: XKSAT_ICE ! hydraulic conductivity at saturation
+! over frozen area (m s-1)
+!
+REAL, POINTER, DIMENSION(:,:) :: XTOPQS ! Topmodel subsurface flow by layer (m/s)
+!
+REAL, POINTER, DIMENSION(:,:) :: XDG ! soil layer depth (m)
+! ! NOTE: in Force-Restore mode, the
+! ! uppermost layer depth is superficial
+! ! and is only explicitly used for soil
+! ! water phase changes (m)
+!
+REAL, POINTER, DIMENSION(:,:) :: XDG_OLD ! For land use
+REAL, POINTER, DIMENSION(:) :: XDG2
+INTEGER, POINTER, DIMENSION(:) :: NWG_LAYER ! Number of soil moisture layers for DIF
+REAL, POINTER, DIMENSION(:) :: XDROOT ! effective root depth for DIF (m)
+REAL, POINTER, DIMENSION(:,:) :: XROOTFRAC ! root fraction profile ('DIF' option)
+!
+REAL, POINTER, DIMENSION(:) :: XD_ICE ! depth of the soil column for the calculation
+! of the frozen soil fraction (m)
+!
+REAL, POINTER, DIMENSION(:) :: XH_TREE ! height of trees (m)
+!
+REAL, POINTER, DIMENSION(:) :: XZ0_O_Z0H ! ratio of surface roughness lengths
+! ! (momentum to heat) (-)
+!
+REAL, POINTER, DIMENSION(:) :: XRE25 ! Ecosystem respiration parameter (kg/kg.m.s-1)
+!
+REAL, POINTER, DIMENSION(:) :: XDMAX ! maximum air saturation deficit
+! ! tolerate by vegetation
+! (kg/kg)
+!
+REAL, POINTER, DIMENSION(:,:) :: XRED_NOISE
+REAL, POINTER, DIMENSION(:,:) :: XINCR
+REAL, POINTER, DIMENSION(:,:,:) :: XHO
+!
+END TYPE ISBA_P_t
+!
+TYPE ISBA_PE_t
!
- REAL, POINTER, DIMENSION(:,:) :: XLAI ! Leaf Area Index (m2/m2)
+! Prognostic variables:
!
-!-------------------------------------------------------------------------------
+! - Soil and vegetation heat and water:
!
-! - Vegetation: Ags Prognostic (YPHOTO = 'AGS', 'LAI', 'AST', 'LST', 'NIT', 'NCB')
+REAL, POINTER, DIMENSION(:,:) :: XWG ! soil volumetric water content profile (m3/m3)
+REAL, POINTER, DIMENSION(:,:) :: XWGI ! soil liquid water equivalent volumetric
+! ! ice content profile (m3/m3)
+REAL, POINTER, DIMENSION(:) :: XWR ! liquid water retained on the
+! ! foliage of the vegetation
+! ! canopy (kg/m2)
+REAL, POINTER, DIMENSION(:,:) :: XTG ! surface and sub-surface soil
+! ! temperature profile (K)
!
- REAL, POINTER, DIMENSION(:,:) :: XAN ! net CO2 assimilation (mg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XANDAY ! daily net CO2 assimilation (mg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XANFM ! maximum leaf assimilation (mg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XLE ! evapotranspiration (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XFAPARC ! Fapar of vegetation (cumul)
- REAL, POINTER, DIMENSION(:,:) :: XFAPIRC ! Fapir of vegetation (cumul)
- REAL, POINTER, DIMENSION(:,:) :: XLAI_EFFC ! Effective LAI (cumul)
- REAL, POINTER, DIMENSION(:,:) :: XMUS ! cos zenithal angle (cumul)
+! - Snow Cover:
!
-!-------------------------------------------------------------------------------
+TYPE(SURF_SNOW) :: TSNOW ! snow state:
+! ! scheme type/option (-)
+! ! number of layers (-)
+! ! snow (& liq. water) content (kg/m2)
+! ! heat content (J/m2)
+! ! temperature (K)
+! ! density (kg m-3)
!
-! - Vegetation: Ags Prognostic (YPHOTO = 'NIT', 'NCB')
+REAL, POINTER, DIMENSION(:) :: XICE_STO ! Glacier ice storage reservoir
!
- REAL, POINTER, DIMENSION(:,:,:) :: XRESP_BIOMASS ! daily cumulated respiration of
-! ! biomass (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:,:) :: XBIOMASS ! biomass of previous day (kg/m2)
- REAL, POINTER, DIMENSION(:,:,:) :: XINCREASE ! biomass increase (kg/m2/day)
+! - For multi-energy balance:
!
+REAL, POINTER, DIMENSION(:) :: XWRL ! liquid water retained on litter (kg/m2)
+REAL, POINTER, DIMENSION(:) :: XWRLI ! ice retained on litter (kg/m2)
+REAL, POINTER, DIMENSION(:) :: XWRVN ! snow retained on the foliage
+! ! of the canopy vegetation (kg/m2)
+REAL, POINTER, DIMENSION(:) :: XTV ! canopy vegetation temperature (K)
+REAL, POINTER, DIMENSION(:) :: XTL ! litter temperature (K)
+REAL, POINTER, DIMENSION(:) :: XTC ! canopy air temperature (K)
+REAL, POINTER, DIMENSION(:) :: XQC ! canopy air specific humidity (kg/kg)
!
-!-------------------------------------------------------------------------------
+! * Half prognostic fields
!
-! - Soil carbon (ISBA-CC, YRESPSL = 'CNT')
+REAL, POINTER, DIMENSION(:) :: XRESA ! aerodynamic resistance (s/m)
!
- REAL, POINTER, DIMENSION(:,:,:,:) :: XLITTER ! litter pools (gC/m2)
- REAL, POINTER, DIMENSION(:,:,:) :: XSOILCARB ! soil carbon pools (gC/m2)
- REAL, POINTER, DIMENSION(:,:,:) :: XLIGNIN_STRUC ! ratio Lignin/Carbon in structural
-! litter (gC/m2)
+! - Vegetation: Ags Prognostic (YPHOTO = 'AST', 'NIT', 'NCB')
!
- REAL, POINTER, DIMENSION(:,:,:) :: XTURNOVER ! turnover rates from biomass to litter (gC/m2/s)
+REAL, POINTER, DIMENSION(:) :: XAN ! net CO2 assimilation (mg/m2/s)
+REAL, POINTER, DIMENSION(:) :: XANDAY ! daily net CO2 assimilation (mg/m2)
+REAL, POINTER, DIMENSION(:) :: XANFM ! maximum leaf assimilation (mg/m2/s)
+REAL, POINTER, DIMENSION(:) :: XLE ! evapotranspiration (W/m2)
!
-!-------------------------------------------------------------------------------
+REAL, POINTER, DIMENSION(:) :: XFAPARC ! Fapar of vegetation (cumul)
+REAL, POINTER, DIMENSION(:) :: XFAPIRC ! Fapir of vegetation (cumul)
+REAL, POINTER, DIMENSION(:) :: XLAI_EFFC ! Effective LAI (cumul)
+REAL, POINTER, DIMENSION(:) :: XMUS ! cos zenithal angle (cumul)
!
- TYPE (DATE_TIME) :: TTIME ! current date and time
+REAL, POINTER, DIMENSION(:,:) :: XRESP_BIOMASS ! daily cumulated respiration of
+! ! biomass (kg/m2/s)
+REAL, POINTER, DIMENSION(:,:) :: XBIOMASS ! biomass of previous day (kg/m2)
!
- REAL :: XTSTEP ! ISBA time step
+! - Soil carbon (ISBA-CC, YRESPSL = 'CNT')
!
- REAL :: XOUT_TSTEP ! ISBA output writing time step
-!-------------------------------------------------------------------------------
+REAL, POINTER, DIMENSION(:,:,:) :: XLITTER ! litter pools (gC/m2)
+REAL, POINTER, DIMENSION(:,:) :: XSOILCARB ! soil carbon pools (gC/m2)
+REAL, POINTER, DIMENSION(:,:) :: XLIGNIN_STRUC ! ratio Lignin/Carbon in structural
+! litter (gC/m2)
!
-! - Irrigation, seeding and reaping
+REAL, POINTER, DIMENSION(:) :: XPSNG ! Snow fraction over ground
+REAL, POINTER, DIMENSION(:) :: XPSNV ! Snow fraction over vegetation
+REAL, POINTER, DIMENSION(:) :: XPSNV_A ! Snow fraction over vegetation
+REAL, POINTER, DIMENSION(:) :: XPSN
!
- TYPE (DATE_TIME), POINTER, DIMENSION(:,:) :: TSEED ! date of seeding
- TYPE (DATE_TIME), POINTER, DIMENSION(:,:) :: TREAP ! date of reaping
- REAL, POINTER, DIMENSION(:,:) :: XWATSUP ! water supply during irrigation process (mm)
- REAL, POINTER, DIMENSION(:,:) :: XIRRIG ! flag for irrigation (irrigation if >0.)
-!-------------------------------------------------------------------------------
+REAL, POINTER, DIMENSION(:) :: XSNOWFREE_ALB ! snow free albedo (-)
+REAL, POINTER, DIMENSION(:) :: XSNOWFREE_ALB_VEG ! snow free albedo for vegetation (-)
+REAL, POINTER, DIMENSION(:) :: XSNOWFREE_ALB_SOIL! snow free albedo for soil
!
-! - Adjustable physical parameters
+REAL, POINTER, DIMENSION(:) :: XVEG ! vegetation cover fraction (-)
!
- REAL :: XCGMAX ! maximum soil heat capacity
+REAL, POINTER, DIMENSION(:) :: XLAI ! Leaf Area Index (m2/m2)
!
- REAL :: XCDRAG ! drag coefficient in canopy
-!-------------------------------------------------------------------------------
+REAL, POINTER, DIMENSION(:) :: XEMIS ! surface emissivity (-)
+REAL, POINTER, DIMENSION(:) :: XZ0 ! surface roughness length (m)
!
-! - Sub-grid hydrology and vertical hydrology
-!
- CHARACTER(LEN=4) :: CRUNOFF! surface runoff formulation
-! ! 'WSAT'
-! ! 'DT92'
-! ! 'SGH ' Topmodel
-!
- CHARACTER(LEN=3) :: CKSAT ! ksat
-! ! 'DEF' = default value
-! ! 'SGH' = profil exponentiel
-!
- LOGICAL :: LSOC ! soil organic carbon effect
-! ! False = default value
-! ! True = soil SOC profil
-!
- CHARACTER(LEN=3) :: CRAIN ! Rainfall spatial distribution
- ! 'DEF' = No rainfall spatial distribution
- ! 'SGH' = Rainfall exponential spatial distribution
- !
-!
- CHARACTER(LEN=3) :: CHORT ! Horton runoff
- ! 'DEF' = no Horton runoff
- ! 'SGH' = Horton runoff
-!
- INTEGER :: NLAYER_HORT
- INTEGER :: NLAYER_DUN
-!
- REAL, POINTER, DIMENSION(:) :: XRUNOFFB ! sub-grid dt92 surface runoff slope parameter (-)
- REAL, POINTER, DIMENSION(:,:) :: XRUNOFFD ! depth over which sub-grid runoff is
-! ! computed: in Force-Restore this is the
-! ! total soil column ('2-L'), or root zone
-! ! ('3-L'). For the 'DIF' option, it can
-! ! be any depth within soil column (m)
-!
- REAL, POINTER, DIMENSION(:,:,:) :: XSOILWGHT ! ISBA-DIF: weights for vertical
-! ! integration of soil water and properties
-!
- REAL, POINTER, DIMENSION(:,:) :: XTAB_FSAT !Satured fraction array
- REAL, POINTER, DIMENSION(:,:) :: XTAB_WTOP !Active TOPMODEL-layer array
- REAL, POINTER, DIMENSION(:,:) :: XTAB_QTOP !Subsurface flow TOPMODEL array
-!
- REAL, POINTER, DIMENSION(:,:) :: XD_ICE !depth of the soil column for the calculation
-! of the frozen soil fraction (m)
- REAL, POINTER, DIMENSION(:,:) :: XKSAT_ICE !hydraulic conductivity at saturation
-! over frozen area (m s-1)
-!
- REAL, POINTER, DIMENSION(:) :: XTI_MIN,XTI_MAX,XTI_MEAN,XTI_STD,XTI_SKEW
-! Topmodel statistics
-!
- REAL, POINTER, DIMENSION(:) :: XMUF ! fraction of the grid cell reached by the rainfall
- REAL, POINTER, DIMENSION(:) :: XFSAT ! Topmodel or dt92 saturated fraction
- REAL, POINTER, DIMENSION(:,:,:):: XTOPQS! Topmodel subsurface flow by layer (m/s)
-!
- REAL, POINTER, DIMENSION(:,:) :: XFRACSOC ! Fraction of organic carbon in each soil layer
-!
- REAL, POINTER, DIMENSION(:,:) :: XKANISO ! Anisotropy coeficient for hydraulic conductivity
-! ! for lateral drainage ('DIF' option)
- REAL, POINTER, DIMENSION(:,:) :: XWD0 ! water content equivalent to TOPMODEL maximum deficit
+REAL, POINTER, DIMENSION(:) :: XRSMIN ! minimum stomatal resistance (s/m)
+REAL, POINTER, DIMENSION(:) :: XGAMMA ! coefficient for the calculation
+! ! of the surface stomatal
+! ! resistance
+REAL, POINTER, DIMENSION(:) :: XWRMAX_CF ! coefficient for maximum water
+! ! interception
+! ! storage capacity on the vegetation (-)
+REAL, POINTER, DIMENSION(:) :: XRGL ! maximum solar radiation
+! ! usable in photosynthesis
+REAL, POINTER, DIMENSION(:) :: XCV ! vegetation thermal inertia coefficient (K m2/J)
+REAL, POINTER, DIMENSION(:) :: XLAIMIN ! minimum LAI (Leaf Area Index) (m2/m2)
+REAL, POINTER, DIMENSION(:) :: XSEFOLD ! e-folding time for senescence (s)
+REAL, POINTER, DIMENSION(:) :: XGMES ! mesophyll conductance (m s-1)
+REAL, POINTER, DIMENSION(:) :: XGC ! cuticular conductance (m s-1)
+REAL, POINTER, DIMENSION(:) :: XF2I ! critical normilized soil water
+! ! content for stress parameterisation
+REAL, POINTER, DIMENSION(:) :: XBSLAI ! ratio d(biomass)/d(lai) (kg/m2)
!
-!-------------------------------------------------------------------------------
+REAL, POINTER, DIMENSION(:) :: XCE_NITRO ! leaf aera ratio sensitivity to
+! ! nitrogen concentration (m2/kg)
+REAL, POINTER, DIMENSION(:) :: XCF_NITRO ! lethal minimum value of leaf area
+! ! ratio (m2/kg)
+REAL, POINTER, DIMENSION(:) :: XCNA_NITRO ! nitrogen concentration of active
+! ! biomass
+LOGICAL, POINTER, DIMENSION(:) :: LSTRESS ! vegetation response type to water
+! ! stress (true:defensive false:offensive) (-)
!
-! - Snow and flood fractions and total albedo at time t:
+REAL, POINTER, DIMENSION(:) :: XALBNIR_VEG ! vegetation near-infra-red albedo (-)
+REAL, POINTER, DIMENSION(:) :: XALBVIS_VEG ! vegetation visible albedo (-)
+REAL, POINTER, DIMENSION(:) :: XALBUV_VEG ! vegetation UV albedo (-)
!
- REAL, POINTER, DIMENSION(:,:) :: XPSNG ! Snow fraction over ground
- REAL, POINTER, DIMENSION(:,:) :: XPSNV ! Snow fraction over vegetation
- REAL, POINTER, DIMENSION(:,:) :: XPSNV_A ! Snow fraction over vegetation
- REAL, POINTER, DIMENSION(:,:) :: XPSN ! Total Snow fraction
-!
- REAL, POINTER, DIMENSION(:,:,:) :: XDIR_ALB_WITH_SNOW ! total direct albedo by bands
- REAL, POINTER, DIMENSION(:,:,:) :: XSCA_ALB_WITH_SNOW ! total diffuse albedo by bands
+REAL, POINTER, DIMENSION(:) :: XALBNIR ! near-infra-red albedo (-)
+REAL, POINTER, DIMENSION(:) :: XALBVIS ! visible albedo (-)
+REAL, POINTER, DIMENSION(:) :: XALBUV ! UV albedo
!
- REAL, POINTER, DIMENSION(:,:) :: XFFG ! Flood fraction over ground
- REAL, POINTER, DIMENSION(:,:) :: XFFV ! Flood fraction over vegetation
- REAL, POINTER, DIMENSION(:,:) :: XFFROZEN ! Fraction of frozen floodplains
- REAL, POINTER, DIMENSION(:,:) :: XFF ! Total Flood fraction
- REAL, POINTER, DIMENSION(:,:) :: XALBF ! Flood albedo
- REAL, POINTER, DIMENSION(:,:) :: XEMISF ! Flood emissivity
+REAL, POINTER, DIMENSION(:) :: XGNDLITTER ! ground litter fraction (-)
+REAL, POINTER, DIMENSION(:) :: XH_VEG ! height of vegetation (m)
+REAL, POINTER, DIMENSION(:) :: XZ0LITTER ! ground litter roughness length (m)
!
- REAL, POINTER, DIMENSION(:,:) :: XICE_STO ! Glacier ice storage reservoir
+REAL, POINTER, DIMENSION(:) :: XALBNIR_SOIL ! soil near-infra-red albedo (-)
+REAL, POINTER, DIMENSION(:) :: XALBVIS_SOIL ! soil visible albedo (-)
+REAL, POINTER, DIMENSION(:) :: XALBUV_SOIL ! soil UV albedo
!
-!-------------------------------------------------------------------------------
+TYPE (DATE_TIME), POINTER, DIMENSION(:) :: TSEED ! date of seeding
+TYPE (DATE_TIME), POINTER, DIMENSION(:) :: TREAP ! date of reaping
+REAL, POINTER, DIMENSION(:) :: XWATSUP ! water supply during irrigation process (mm)
+REAL, POINTER, DIMENSION(:) :: XIRRIG ! flag for irrigation (irrigation if >0.)
!
-! - Flood scheme
!
- LOGICAL :: LFLOOD ! Activation of the flooding scheme
- REAL, POINTER, DIMENSION(:) :: XFFLOOD ! Grid-cell flood fraction
- REAL, POINTER, DIMENSION(:) :: XPIFLOOD ! flood potential infiltration (kg/m2/s)
+END TYPE ISBA_PE_t
!
-!-------------------------------------------------------------------------------
+TYPE ISBA_NK_t
!
-! - Water table depth coupling
-!
- LOGICAL :: LWTD ! Activation of Water table depth coupling
- REAL, POINTER, DIMENSION(:) :: XFWTD ! grid-cell fraction of water table rise
- REAL, POINTER, DIMENSION(:) :: XWTD ! water table depth (negative below soil surface) (m)
+TYPE(ISBA_K_t), DIMENSION(:), POINTER :: AL=>NULL()
!
-!-------------------------------------------------------------------------------
+END TYPE ISBA_NK_t
!
-! - Coupling with river routing model
-!
- LOGICAL :: LCPL_RRM ! Activation of the coupling
- REAL, POINTER, DIMENSION(:) :: XCPL_DRAIN ! Surface runoff
- REAL, POINTER, DIMENSION(:) :: XCPL_RUNOFF ! Deep drainage or gourdwater recharge
- REAL, POINTER, DIMENSION(:) :: XCPL_ICEFLUX ! Calving flux
- REAL, POINTER, DIMENSION(:) :: XCPL_RECHARGE! Groundwater recharge
- REAL, POINTER, DIMENSION(:) :: XCPL_EFLOOD ! floodplains evaporation
- REAL, POINTER, DIMENSION(:) :: XCPL_PFLOOD ! floodplains precipitation interception
- REAL, POINTER, DIMENSION(:) :: XCPL_IFLOOD ! floodplains infiltration
+TYPE ISBA_NP_t
!
-!-------------------------------------------------------------------------------
+TYPE(ISBA_P_t), DIMENSION(:), POINTER :: AL=>NULL()
!
-! - Random perturbations
+END TYPE ISBA_NP_t
!
- REAL, POINTER, DIMENSION(:) :: XPERTVEG
- REAL, POINTER, DIMENSION(:) :: XPERTLAI
- REAL, POINTER, DIMENSION(:) :: XPERTCV
- REAL, POINTER, DIMENSION(:) :: XPERTALB
- REAL, POINTER, DIMENSION(:) :: XPERTZ0
+TYPE ISBA_NPE_t
!
-!-------------------------------------------------------------------------------
+TYPE(ISBA_PE_t), DIMENSION(:), POINTER :: AL=>NULL()
!
-! - Assimilation: ENKF
+END TYPE ISBA_NPE_t
!
- REAL, POINTER, DIMENSION(:,:,:) :: XRED_NOISE
- REAL, POINTER, DIMENSION(:,:) :: XINCR
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
-!-------------------------------------------------------------------------------
+CONTAINS
!
-END TYPE ISBA_t
-
- CONTAINS
-
-SUBROUTINE ISBA_INIT(YISBA)
-TYPE(ISBA_t), INTENT(INOUT) :: YISBA
+SUBROUTINE ISBA_S_INIT(YISBA_S)
+TYPE(ISBA_S_t), INTENT(INOUT) :: YISBA_S
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_S_INIT",0,ZHOOK_HANDLE)
+!
+NULLIFY(YISBA_S%XZS)
+NULLIFY(YISBA_S%XCOVER)
+NULLIFY(YISBA_S%LCOVER)
+!
+NULLIFY(YISBA_S%XTI_MIN)
+NULLIFY(YISBA_S%XTI_MAX)
+NULLIFY(YISBA_S%XTI_MEAN)
+NULLIFY(YISBA_S%XTI_STD)
+NULLIFY(YISBA_S%XTI_SKEW)
+!
+NULLIFY(YISBA_S%XSOC)
+NULLIFY(YISBA_S%XPH)
+NULLIFY(YISBA_S%XFERT)
+!
+NULLIFY(YISBA_S%XABC)
+NULLIFY(YISBA_S%XPOI)
+!
+NULLIFY(YISBA_S%XFRACSOC)
+NULLIFY(YISBA_S%XTAB_FSAT)
+NULLIFY(YISBA_S%XTAB_WTOP)
+NULLIFY(YISBA_S%XTAB_QTOP)
+NULLIFY(YISBA_S%XF_PARAM)
+NULLIFY(YISBA_S%XC_DEPTH_RATIO)
+NULLIFY(YISBA_S%XCPL_DRAIN)
+NULLIFY(YISBA_S%XCPL_RUNOFF)
+NULLIFY(YISBA_S%XCPL_ICEFLUX)
+NULLIFY(YISBA_S%XCPL_EFLOOD)
+NULLIFY(YISBA_S%XCPL_PFLOOD)
+NULLIFY(YISBA_S%XCPL_IFLOOD)
+NULLIFY(YISBA_S%XPERTVEG)
+NULLIFY(YISBA_S%XPERTLAI)
+NULLIFY(YISBA_S%XPERTCV)
+NULLIFY(YISBA_S%XPERTALB)
+NULLIFY(YISBA_S%XPERTZ0)
+NULLIFY(YISBA_S%XEMIS_NAT)
+!
+NULLIFY(YISBA_S%XTSRAD_NAT)
+!
+NULLIFY(YISBA_S%XINNOV)
+NULLIFY(YISBA_S%XRESID)
+!
+NULLIFY(YISBA_S%XWORK_WR)
+!
+NULLIFY(YISBA_S%XWSN_WR)
+NULLIFY(YISBA_S%XRHO_WR)
+NULLIFY(YISBA_S%XALB_WR)
+NULLIFY(YISBA_S%XHEA_WR)
+NULLIFY(YISBA_S%XAGE_WR)
+NULLIFY(YISBA_S%XSG1_WR)
+NULLIFY(YISBA_S%XSG2_WR)
+NULLIFY(YISBA_S%XHIS_WR)
+!
+NULLIFY(YISBA_S%TDATE_WR)
+!
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_S_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE ISBA_S_INIT
+!
+SUBROUTINE ISBA_K_INIT(YISBA_K)
+TYPE(ISBA_K_t), INTENT(INOUT) :: YISBA_K
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_K_INIT",0,ZHOOK_HANDLE)
+!
+NULLIFY(YISBA_K%XSAND)
+NULLIFY(YISBA_K%XCLAY)
+NULLIFY(YISBA_K%XPERM)
+NULLIFY(YISBA_K%XRUNOFFB)
+NULLIFY(YISBA_K%XWDRAIN)
+!
+NULLIFY(YISBA_K%XTDEEP)
+NULLIFY(YISBA_K%XGAMMAT)
+NULLIFY(YISBA_K%XMPOTSAT)
+NULLIFY(YISBA_K%XBCOEF)
+NULLIFY(YISBA_K%XWWILT)
+NULLIFY(YISBA_K%XWFC)
+NULLIFY(YISBA_K%XWSAT)
+NULLIFY(YISBA_K%XCGSAT)
+NULLIFY(YISBA_K%XC4B)
+NULLIFY(YISBA_K%XACOEF)
+NULLIFY(YISBA_K%XPCOEF)
+NULLIFY(YISBA_K%XHCAPSOIL)
+NULLIFY(YISBA_K%XCONDDRY)
+NULLIFY(YISBA_K%XCONDSLD)
+NULLIFY(YISBA_K%XFWTD)
+NULLIFY(YISBA_K%XWTD)
+NULLIFY(YISBA_K%XALBNIR_DRY)
+NULLIFY(YISBA_K%XALBVIS_DRY)
+NULLIFY(YISBA_K%XALBUV_DRY)
+NULLIFY(YISBA_K%XALBNIR_WET)
+NULLIFY(YISBA_K%XALBVIS_WET)
+NULLIFY(YISBA_K%XALBUV_WET)
+NULLIFY(YISBA_K%XWD0)
+NULLIFY(YISBA_K%XKANISO)
+NULLIFY(YISBA_K%XMUF)
+NULLIFY(YISBA_K%XFSAT)
+NULLIFY(YISBA_K%XFFLOOD)
+NULLIFY(YISBA_K%XPIFLOOD)
+NULLIFY(YISBA_K%XFF)
+NULLIFY(YISBA_K%XFFG)
+NULLIFY(YISBA_K%XFFV)
+NULLIFY(YISBA_K%XFFROZEN)
+NULLIFY(YISBA_K%XALBF)
+NULLIFY(YISBA_K%XEMISF)
+NULLIFY(YISBA_K%XDIR_ALB_WITH_SNOW)
+NULLIFY(YISBA_K%XSCA_ALB_WITH_SNOW)
+!
+NULLIFY(YISBA_K%XVEGTYPE)
+!
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_K_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE ISBA_K_INIT
+!
+SUBROUTINE ISBA_P_INIT(YISBA_P)
+TYPE(ISBA_P_t), INTENT(INOUT) :: YISBA_P
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_P_INIT",0,ZHOOK_HANDLE)
+!
+YISBA_P%NSIZE_P = 0
+NULLIFY(YISBA_P%XPATCH)
+NULLIFY(YISBA_P%XVEGTYPE_PATCH)
+NULLIFY(YISBA_P%NR_P)
+NULLIFY(YISBA_P%XPATCH_OLD)
+NULLIFY(YISBA_P%XANMAX)
+NULLIFY(YISBA_P%XFZERO)
+NULLIFY(YISBA_P%XEPSO)
+NULLIFY(YISBA_P%XGAMM)
+NULLIFY(YISBA_P%XQDGAMM)
+NULLIFY(YISBA_P%XQDGMES)
+NULLIFY(YISBA_P%XT1GMES)
+NULLIFY(YISBA_P%XT2GMES)
+NULLIFY(YISBA_P%XAMAX)
+NULLIFY(YISBA_P%XQDAMAX)
+NULLIFY(YISBA_P%XT1AMAX)
+NULLIFY(YISBA_P%XT2AMAX)
+NULLIFY(YISBA_P%XAH)
+NULLIFY(YISBA_P%XBH)
+NULLIFY(YISBA_P%XTAU_WOOD)
+NULLIFY(YISBA_P%XINCREASE)
+NULLIFY(YISBA_P%XTURNOVER)
+NULLIFY(YISBA_P%XCONDSAT)
+NULLIFY(YISBA_P%XTAUICE)
+NULLIFY(YISBA_P%XC1SAT)
+NULLIFY(YISBA_P%XC2REF)
+NULLIFY(YISBA_P%XC3)
+NULLIFY(YISBA_P%XC4REF)
+NULLIFY(YISBA_P%XCPS)
+NULLIFY(YISBA_P%XLVTT)
+NULLIFY(YISBA_P%XLSTT)
+NULLIFY(YISBA_P%XRUNOFFD)
+NULLIFY(YISBA_P%XDZG)
+NULLIFY(YISBA_P%XDZDIF)
+NULLIFY(YISBA_P%XSOILWGHT)
+NULLIFY(YISBA_P%XKSAT_ICE)
+NULLIFY(YISBA_P%XBSLAI_NITRO)
+NULLIFY(YISBA_P%XTOPQS)
+!
+NULLIFY(YISBA_P%XDG)
+NULLIFY(YISBA_P%XDG_OLD)
+NULLIFY(YISBA_P%NWG_LAYER)
+NULLIFY(YISBA_P%XDROOT)
+NULLIFY(YISBA_P%XDG2)
+NULLIFY(YISBA_P%XROOTFRAC)
+NULLIFY(YISBA_P%XD_ICE)
+NULLIFY(YISBA_P%XH_TREE)
+NULLIFY(YISBA_P%XZ0_O_Z0H)
+NULLIFY(YISBA_P%XRE25)
+NULLIFY(YISBA_P%XDMAX)
+!
+NULLIFY(YISBA_P%XRED_NOISE)
+NULLIFY(YISBA_P%XINCR)
+NULLIFY(YISBA_P%XHO)
+!
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_P_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE ISBA_P_INIT
+!
+SUBROUTINE ISBA_PE_INIT(YISBA_PE)
+TYPE(ISBA_PE_t), INTENT(INOUT) :: YISBA_PE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_PE_INIT",0,ZHOOK_HANDLE)
+!
+NULLIFY(YISBA_PE%XLAI)
+NULLIFY(YISBA_PE%XVEG)
+NULLIFY(YISBA_PE%XEMIS)
+NULLIFY(YISBA_PE%XZ0)
+NULLIFY(YISBA_PE%XRSMIN)
+NULLIFY(YISBA_PE%XGAMMA)
+NULLIFY(YISBA_PE%XWRMAX_CF)
+NULLIFY(YISBA_PE%XRGL)
+NULLIFY(YISBA_PE%XCV)
+NULLIFY(YISBA_PE%XLAIMIN)
+NULLIFY(YISBA_PE%XSEFOLD)
+NULLIFY(YISBA_PE%XGMES)
+NULLIFY(YISBA_PE%XGC)
+NULLIFY(YISBA_PE%XF2I)
+NULLIFY(YISBA_PE%XBSLAI)
+NULLIFY(YISBA_PE%XCE_NITRO)
+NULLIFY(YISBA_PE%XCF_NITRO)
+NULLIFY(YISBA_PE%XCNA_NITRO)
+NULLIFY(YISBA_PE%LSTRESS)
+NULLIFY(YISBA_PE%XALBNIR_VEG)
+NULLIFY(YISBA_PE%XALBVIS_VEG)
+NULLIFY(YISBA_PE%XALBUV_VEG)
+NULLIFY(YISBA_PE%XALBNIR)
+NULLIFY(YISBA_PE%XALBVIS)
+NULLIFY(YISBA_PE%XALBUV)
+!
+NULLIFY(YISBA_PE%XGNDLITTER)
+NULLIFY(YISBA_PE%XH_VEG)
+NULLIFY(YISBA_PE%XZ0LITTER)
+!
+NULLIFY(YISBA_PE%XALBNIR_SOIL)
+NULLIFY(YISBA_PE%XALBVIS_SOIL)
+NULLIFY(YISBA_PE%XALBUV_SOIL)
+!
+NULLIFY(YISBA_PE%XWATSUP)
+NULLIFY(YISBA_PE%XIRRIG)
+!
+NULLIFY(YISBA_PE%XWG)
+NULLIFY(YISBA_PE%XWGI)
+NULLIFY(YISBA_PE%XWR)
+NULLIFY(YISBA_PE%XTG)
+NULLIFY(YISBA_PE%XICE_STO)
+NULLIFY(YISBA_PE%XWRL)
+NULLIFY(YISBA_PE%XWRLI)
+NULLIFY(YISBA_PE%XWRVN)
+NULLIFY(YISBA_PE%XTV)
+NULLIFY(YISBA_PE%XTL)
+NULLIFY(YISBA_PE%XTC)
+NULLIFY(YISBA_PE%XQC)
+NULLIFY(YISBA_PE%XRESA)
+NULLIFY(YISBA_PE%XAN)
+NULLIFY(YISBA_PE%XANDAY)
+NULLIFY(YISBA_PE%XANFM)
+NULLIFY(YISBA_PE%XLE)
+NULLIFY(YISBA_PE%XFAPARC)
+NULLIFY(YISBA_PE%XFAPIRC)
+NULLIFY(YISBA_PE%XLAI_EFFC)
+NULLIFY(YISBA_PE%XMUS)
+NULLIFY(YISBA_PE%XRESP_BIOMASS)
+NULLIFY(YISBA_PE%XBIOMASS)
+NULLIFY(YISBA_PE%XLITTER)
+NULLIFY(YISBA_PE%XSOILCARB)
+NULLIFY(YISBA_PE%XLIGNIN_STRUC)
+NULLIFY(YISBA_PE%XPSNG)
+NULLIFY(YISBA_PE%XPSNV)
+NULLIFY(YISBA_PE%XPSNV_A)
+NULLIFY(YISBA_PE%XSNOWFREE_ALB)
+NULLIFY(YISBA_PE%XSNOWFREE_ALB_VEG)
+NULLIFY(YISBA_PE%XSNOWFREE_ALB_SOIL)
+NULLIFY(YISBA_PE%XPSN)
+!
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_PE_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE ISBA_PE_INIT
+!
+SUBROUTINE ISBA_NK_INIT(YISBA_NK,KPATCH)
+TYPE(ISBA_NK_t), INTENT(INOUT) :: YISBA_NK
+INTEGER, INTENT(IN) :: KPATCH
+INTEGER :: JP
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_NK_INIT",0,ZHOOK_HANDLE)
+!
+IF (ASSOCIATED(YISBA_NK%AL)) THEN
+ DO JP = 1,KPATCH
+ CALL ISBA_K_INIT(YISBA_NK%AL(JP))
+ ENDDO
+ DEALLOCATE(YISBA_NK%AL)
+ELSE
+ ALLOCATE(YISBA_NK%AL(KPATCH))
+ DO JP = 1,KPATCH
+ CALL ISBA_K_INIT(YISBA_NK%AL(JP))
+ ENDDO
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_NK_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE ISBA_NK_INIT
+!
+SUBROUTINE ISBA_NP_INIT(YISBA_NP,KPATCH)
+TYPE(ISBA_NP_t), INTENT(INOUT) :: YISBA_NP
+INTEGER, INTENT(IN) :: KPATCH
+INTEGER :: JP
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_NP_INIT",0,ZHOOK_HANDLE)
+!
+IF (ASSOCIATED(YISBA_NP%AL)) THEN
+ DO JP = 1,KPATCH
+ CALL ISBA_P_INIT(YISBA_NP%AL(JP))
+ ENDDO
+ DEALLOCATE(YISBA_NP%AL)
+ELSE
+ ALLOCATE(YISBA_NP%AL(KPATCH))
+ DO JP = 1,KPATCH
+ CALL ISBA_P_INIT(YISBA_NP%AL(JP))
+ ENDDO
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_NP_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE ISBA_NP_INIT
+!
+SUBROUTINE ISBA_NPE_INIT(YISBA_NPE,KPATCH)
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: YISBA_NPE
+INTEGER, INTENT(IN) :: KPATCH
+INTEGER :: JP
REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YISBA%NSIZE_NATURE_P)
- NULLIFY(YISBA%NR_NATURE_P)
- NULLIFY(YISBA%XPATCH)
- NULLIFY(YISBA%XPATCH_OLD)
- NULLIFY(YISBA%XVEGTYPE)
- NULLIFY(YISBA%XVEGTYPE_PATCH)
- NULLIFY(YISBA%XSODELX)
- NULLIFY(YISBA%XSOILGRID)
- NULLIFY(YISBA%XZS)
- NULLIFY(YISBA%XCOVER)
- NULLIFY(YISBA%LCOVER)
- NULLIFY(YISBA%LMEB_PATCH)
- NULLIFY(YISBA%XALBNIR_DRY)
- NULLIFY(YISBA%XALBVIS_DRY)
- NULLIFY(YISBA%XALBUV_DRY)
- NULLIFY(YISBA%XALBNIR_WET)
- NULLIFY(YISBA%XALBVIS_WET)
- NULLIFY(YISBA%XALBUV_WET)
- NULLIFY(YISBA%XALBNIR_SOIL)
- NULLIFY(YISBA%XALBVIS_SOIL)
- NULLIFY(YISBA%XALBUV_SOIL)
- NULLIFY(YISBA%XEMIS_NAT)
- NULLIFY(YISBA%XTSRAD_NAT)
- NULLIFY(YISBA%XAOSIP)
- NULLIFY(YISBA%XAOSIM)
- NULLIFY(YISBA%XAOSJP)
- NULLIFY(YISBA%XAOSJM)
- NULLIFY(YISBA%XHO2IP)
- NULLIFY(YISBA%XHO2IM)
- NULLIFY(YISBA%XHO2JP)
- NULLIFY(YISBA%XHO2JM)
- NULLIFY(YISBA%XZ0EFFIP)
- NULLIFY(YISBA%XZ0EFFIM)
- NULLIFY(YISBA%XZ0EFFJP)
- NULLIFY(YISBA%XZ0EFFJM)
- NULLIFY(YISBA%XZ0EFFJPDIR)
- NULLIFY(YISBA%XZ0REL)
- NULLIFY(YISBA%XSSO_SLOPE)
- NULLIFY(YISBA%XSSO_STDEV)
- NULLIFY(YISBA%XZ0_O_Z0H)
- NULLIFY(YISBA%XALBNIR)
- NULLIFY(YISBA%XALBVIS)
- NULLIFY(YISBA%XALBUV)
- NULLIFY(YISBA%XEMIS)
- NULLIFY(YISBA%XZ0)
- NULLIFY(YISBA%XALBNIR_VEG)
- NULLIFY(YISBA%XALBVIS_VEG)
- NULLIFY(YISBA%XALBUV_VEG)
- NULLIFY(YISBA%XVEG)
- NULLIFY(YISBA%XWRMAX_CF)
- NULLIFY(YISBA%XRSMIN)
- NULLIFY(YISBA%XGAMMA)
- NULLIFY(YISBA%XCV)
- NULLIFY(YISBA%XRGL)
- NULLIFY(YISBA%XROOTFRAC)
- NULLIFY(YISBA%XABC)
- NULLIFY(YISBA%XPOI)
- NULLIFY(YISBA%XBSLAI)
- NULLIFY(YISBA%XLAIMIN)
- NULLIFY(YISBA%XSEFOLD)
- NULLIFY(YISBA%XTAU_WOOD)
- NULLIFY(YISBA%XH_TREE)
- NULLIFY(YISBA%XANF)
- NULLIFY(YISBA%XANMAX)
- NULLIFY(YISBA%XFZERO)
- NULLIFY(YISBA%XEPSO)
- NULLIFY(YISBA%XGAMM)
- NULLIFY(YISBA%XQDGAMM)
- NULLIFY(YISBA%XGMES)
- NULLIFY(YISBA%XRE25)
- NULLIFY(YISBA%XQDGMES)
- NULLIFY(YISBA%XT1GMES)
- NULLIFY(YISBA%XT2GMES)
- NULLIFY(YISBA%XAMAX)
- NULLIFY(YISBA%XQDAMAX)
- NULLIFY(YISBA%XT1AMAX)
- NULLIFY(YISBA%XT2AMAX)
- NULLIFY(YISBA%LSTRESS)
- NULLIFY(YISBA%XF2I)
- NULLIFY(YISBA%XGC)
- NULLIFY(YISBA%XAH)
- NULLIFY(YISBA%XBH)
- NULLIFY(YISBA%XDMAX)
- NULLIFY(YISBA%XCE_NITRO)
- NULLIFY(YISBA%XCF_NITRO)
- NULLIFY(YISBA%XCNA_NITRO)
- NULLIFY(YISBA%XBSLAI_NITRO)
- NULLIFY(YISBA%XSAND)
- NULLIFY(YISBA%XCLAY)
- NULLIFY(YISBA%XRUNOFFB)
- NULLIFY(YISBA%XWDRAIN)
- NULLIFY(YISBA%XTAUICE)
- NULLIFY(YISBA%XGAMMAT)
- NULLIFY(YISBA%XDG_OLD)
- NULLIFY(YISBA%XDG)
- NULLIFY(YISBA%XDZG)
- NULLIFY(YISBA%XDZDIF)
- NULLIFY(YISBA%NWG_LAYER)
- NULLIFY(YISBA%XDROOT)
- NULLIFY(YISBA%XDG2)
- NULLIFY(YISBA%XPH)
- NULLIFY(YISBA%XFERT)
- NULLIFY(YISBA%XRUNOFFD)
- NULLIFY(YISBA%XSOILWGHT)
- NULLIFY(YISBA%XC1SAT)
- NULLIFY(YISBA%XC2REF)
- NULLIFY(YISBA%XC3)
- NULLIFY(YISBA%XC4B)
- NULLIFY(YISBA%XC4REF)
- NULLIFY(YISBA%XACOEF)
- NULLIFY(YISBA%XPCOEF)
- NULLIFY(YISBA%XWFC)
- NULLIFY(YISBA%XWD0)
- NULLIFY(YISBA%XWWILT)
- NULLIFY(YISBA%XWSAT)
- NULLIFY(YISBA%XBCOEF)
- NULLIFY(YISBA%XCONDSAT)
- NULLIFY(YISBA%XMPOTSAT)
- NULLIFY(YISBA%XF_PARAM)
- NULLIFY(YISBA%XC_DEPTH_RATIO)
- NULLIFY(YISBA%XCGSAT)
- NULLIFY(YISBA%XHCAPSOIL)
- NULLIFY(YISBA%XCONDDRY)
- NULLIFY(YISBA%XCONDSLD)
- NULLIFY(YISBA%XTDEEP)
- NULLIFY(YISBA%XWR)
- NULLIFY(YISBA%XTG)
- NULLIFY(YISBA%XWG)
- NULLIFY(YISBA%XWGI)
- NULLIFY(YISBA%XRESA)
- NULLIFY(YISBA%XPCPS)
- NULLIFY(YISBA%XPLVTT)
- NULLIFY(YISBA%XPLSTT)
- NULLIFY(YISBA%XLAI)
- NULLIFY(YISBA%XAN)
- NULLIFY(YISBA%XANDAY)
- NULLIFY(YISBA%XANFM)
- NULLIFY(YISBA%XLE)
- NULLIFY(YISBA%XFAPARC)
- NULLIFY(YISBA%XFAPIRC)
- NULLIFY(YISBA%XLAI_EFFC)
- NULLIFY(YISBA%XMUS)
- NULLIFY(YISBA%XRESP_BIOMASS)
- NULLIFY(YISBA%XBIOMASS)
- NULLIFY(YISBA%XINCREASE)
- NULLIFY(YISBA%XLITTER)
- NULLIFY(YISBA%XSOILCARB)
- NULLIFY(YISBA%XLIGNIN_STRUC)
- NULLIFY(YISBA%XTURNOVER)
- NULLIFY(YISBA%XWATSUP)
- NULLIFY(YISBA%XIRRIG)
- NULLIFY(YISBA%XTAB_FSAT)
- NULLIFY(YISBA%XTAB_WTOP)
- NULLIFY(YISBA%XTAB_QTOP)
- NULLIFY(YISBA%XD_ICE)
- NULLIFY(YISBA%XKSAT_ICE)
- NULLIFY(YISBA%XFRACSOC)
- NULLIFY(YISBA%XKANISO)
- NULLIFY(YISBA%XTI_MIN)
- NULLIFY(YISBA%XTI_MAX)
- NULLIFY(YISBA%XTI_MEAN)
- NULLIFY(YISBA%XTI_STD)
- NULLIFY(YISBA%XTI_SKEW)
- NULLIFY(YISBA%XMUF)
- NULLIFY(YISBA%XFSAT)
- NULLIFY(YISBA%XTOPQS)
- NULLIFY(YISBA%XPSNG)
- NULLIFY(YISBA%XPSNV)
- NULLIFY(YISBA%XPSNV_A)
- NULLIFY(YISBA%XPSN)
- NULLIFY(YISBA%XDIR_ALB_WITH_SNOW)
- NULLIFY(YISBA%XSCA_ALB_WITH_SNOW)
- NULLIFY(YISBA%XFFG)
- NULLIFY(YISBA%XFFV)
- NULLIFY(YISBA%XFFROZEN)
- NULLIFY(YISBA%XFF)
- NULLIFY(YISBA%XALBF)
- NULLIFY(YISBA%XEMISF)
- NULLIFY(YISBA%XICE_STO)
- NULLIFY(YISBA%XFFLOOD)
- NULLIFY(YISBA%XPIFLOOD)
- NULLIFY(YISBA%XFWTD)
- NULLIFY(YISBA%XWTD)
- NULLIFY(YISBA%XCPL_DRAIN)
- NULLIFY(YISBA%XCPL_RUNOFF)
- NULLIFY(YISBA%XCPL_ICEFLUX)
- NULLIFY(YISBA%XCPL_RECHARGE)
- NULLIFY(YISBA%XCPL_EFLOOD)
- NULLIFY(YISBA%XCPL_PFLOOD)
- NULLIFY(YISBA%XCPL_IFLOOD)
- NULLIFY(YISBA%XPERTVEG)
- NULLIFY(YISBA%XPERTLAI)
- NULLIFY(YISBA%XPERTCV)
- NULLIFY(YISBA%XPERTALB)
- NULLIFY(YISBA%XPERTZ0)
- NULLIFY(YISBA%XRED_NOISE)
- NULLIFY(YISBA%XINCR)
- !
- NULLIFY(YISBA%XGNDLITTER)
- NULLIFY(YISBA%XRGLGV)
- NULLIFY(YISBA%XGAMMAGV)
- NULLIFY(YISBA%XRSMINGV)
- NULLIFY(YISBA%XROOTFRACGV)
- NULLIFY(YISBA%XWRMAX_CFGV)
- NULLIFY(YISBA%XLAIGV)
- NULLIFY(YISBA%XZ0LITTER)
- NULLIFY(YISBA%XH_VEG)
- NULLIFY(YISBA%XWRL)
- NULLIFY(YISBA%XWRLI)
- NULLIFY(YISBA%XWRVN)
- NULLIFY(YISBA%XTV)
- NULLIFY(YISBA%XTL)
- NULLIFY(YISBA%XTC)
- NULLIFY(YISBA%XQC)
- !
-YISBA%CROUGH=' '
-YISBA%CISBA=' '
-YISBA%CPEDOTF=' '
-YISBA%CPHOTO=' '
-YISBA%LTR_ML=.FALSE.
-YISBA%XRM_PATCH=0.0
-YISBA%CALBEDO=' '
-YISBA%CSCOND=' '
-YISBA%CC1DRY=' '
-YISBA%CSOILFRZ=' '
-YISBA%CDIFSFCOND=' '
-YISBA%CSNOWRES=' '
-YISBA%CRESPSL=' '
-YISBA%CCPSURF=' '
-YISBA%LTEMP_ARP=.FALSE.
-YISBA%LGLACIER=.FALSE.
-YISBA%LFORC_MEASURE=.FALSE.
-YISBA%LMEB_LITTER=.FALSE.
-YISBA%LMEB_GNDRES=.FALSE.
-YISBA%LVEGUPD=.FALSE.
-YISBA%LNITRO_DILU=.FALSE.
-YISBA%LCANOPY=.FALSE.
-YISBA%LCANOPY_DRAG=.FALSE.
-YISBA%LPERTSURF=.FALSE.
-YISBA%LSNOWDRIFT=.TRUE.
-YISBA%LSNOWDRIFT_SUBLIM=.FALSE.
-YISBA%LSNOW_ABS_ZENITH=.FALSE.
-YISBA%CSNOWMETAMO='B92'
-YISBA%CSNOWRAD='B92'
-YISBA%LECOCLIMAP=.FALSE.
-YISBA%LCTI=.FALSE.
-YISBA%LSOCP=.FALSE.
-YISBA%LPERM=.FALSE.
-YISBA%LGW=.FALSE.
-YISBA%LSPINUPCARBS=.FALSE.
-YISBA%LSPINUPCARBW=.FALSE.
-YISBA%LAGRI_TO_GRASS=.FALSE.
-YISBA%XSPINMAXS=0.
-YISBA%XSPINMAXW=0.
-YISBA%XCO2_START=0.
-YISBA%XCO2_END=0.
-YISBA%NNBYEARSPINS=0
-YISBA%NNBYEARSPINW=0
-YISBA%NNBYEARSOLD=0
-YISBA%NSPINS=1
-YISBA%NSPINW=1
-YISBA%LNOF=.FALSE.
-YISBA%NPATCH=0
-YISBA%NGROUND_LAYER=0
-YISBA%NTEMPLAYER_ARP=0
-YISBA%NNBIOMASS=0
-YISBA%NNLITTER=0
-YISBA%NNLITTLEVS=0
-YISBA%NNSOILCARB=0
-YISBA%XTSTEP=0.
-YISBA%XOUT_TSTEP=0.
-YISBA%XCGMAX=0.
-YISBA%XCDRAG=0.
-YISBA%CRUNOFF=' '
-YISBA%CKSAT=' '
-YISBA%LSOC=.FALSE.
-YISBA%CRAIN=' '
-YISBA%CHORT=' '
-YISBA%NLAYER_HORT=0
-YISBA%NLAYER_DUN=0
-YISBA%LFLOOD=.FALSE.
-YISBA%LWTD=.FALSE.
-YISBA%LCPL_RRM=.FALSE.
-IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE ISBA_INIT
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_NPE_INIT",0,ZHOOK_HANDLE)
+!
+IF (ASSOCIATED(YISBA_NPE%AL)) THEN
+ DO JP = 1,KPATCH
+ CALL ISBA_PE_INIT(YISBA_NPE%AL(JP))
+ ENDDO
+ DEALLOCATE(YISBA_NPE%AL)
+ELSE
+ ALLOCATE(YISBA_NPE%AL(KPATCH))
+ DO JP = 1,KPATCH
+ CALL ISBA_PE_INIT(YISBA_NPE%AL(JP))
+ ENDDO
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_NPE_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE ISBA_NPE_INIT
END MODULE MODD_ISBA_n
diff --git a/src/SURFEX/modd_mask.F90 b/src/SURFEX/modd_mask.F90
index 9a6bbfeb75955083d7992e90e7e3dad6899d41a9..5b4c4b4a539077b2c0395716df3dbeb082af9e14 100644
--- a/src/SURFEX/modd_mask.F90
+++ b/src/SURFEX/modd_mask.F90
@@ -35,7 +35,6 @@ IMPLICIT NONE
!-------------------------------------------------------------------------------
!
INTEGER, ALLOCATABLE, DIMENSION(:), TARGET :: NMASK_FULL
-!$OMP THREADPRIVATE(NMASK_FULL)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/modd_ocean_gridn.F90 b/src/SURFEX/modd_ocean_gridn.F90
deleted file mode 100644
index bdc21c688671091f4442ec9140d1add3d61b484d..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_ocean_gridn.F90
+++ /dev/null
@@ -1,11 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ##################
- MODULE MODD_OCEAN_GRID_n
-! ##################
-!
-!
-
-END MODULE MODD_OCEAN_GRID_n
diff --git a/src/SURFEX/modd_ocean_reln.F90 b/src/SURFEX/modd_ocean_reln.F90
index 34217dcb9b3d48190a31c4b3840ade1e55bf4694..ae14315b57b18a82e327bfe7c6a830dbbcd882ca 100644
--- a/src/SURFEX/modd_ocean_reln.F90
+++ b/src/SURFEX/modd_ocean_reln.F90
@@ -38,7 +38,7 @@ END TYPE OCEAN_REL_t
!
- CONTAINS
+CONTAINS
!
!
diff --git a/src/SURFEX/modd_oceann.F90 b/src/SURFEX/modd_oceann.F90
index 9c5e3915e15a41e5c7833833b58050135d625b3e..f94114b83370843d341b6caa134f839e304a4289 100644
--- a/src/SURFEX/modd_oceann.F90
+++ b/src/SURFEX/modd_oceann.F90
@@ -74,7 +74,7 @@ END TYPE OCEAN_t
!
- CONTAINS
+CONTAINS
!
diff --git a/src/SURFEX/modd_pack_ch_isba.F90 b/src/SURFEX/modd_pack_ch_isba.F90
deleted file mode 100644
index bc466c73560ee2d3dd1e477c6519ecb90bbf0b8b..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_pack_ch_isba.F90
+++ /dev/null
@@ -1,73 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ######################
- MODULE MODD_PACK_CH_ISBA
-! ######################
-!
-!!**** *MODD_PACK_CH_ISBA - declaration of packed surface parameters for chemistry
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! A. Boone *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 20/09/02
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!-------------------------------------------------------------------------------
-!
-TYPE PACK_CH_ISBA_t
-
- REAL, POINTER, DIMENSION(:,:) :: XBLOCK_SIMPLE
- REAL, POINTER, DIMENSION(:) :: XP_SOILRC_SO2 ! for SO2 deposition
- REAL, POINTER, DIMENSION(:) :: XP_SOILRC_O3 ! for SO2 deposition
- REAL, POINTER, DIMENSION(:,:) :: XP_DEP ! deposition velocity
-
-END TYPE PACK_CH_ISBA_t
-!
-!-------------------------------------------------------------------------------
-!
-
-
- CONTAINS
-
-!
-!
-
-
-
-
-SUBROUTINE PACK_CH_ISBA_INIT(YPACK_CH_ISBA)
-TYPE(PACK_CH_ISBA_t), INTENT(INOUT) :: YPACK_CH_ISBA
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_PACK_CH_ISBA_N:PACK_CH_ISBA_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YPACK_CH_ISBA%XBLOCK_SIMPLE)
- NULLIFY(YPACK_CH_ISBA%XP_SOILRC_SO2)
- NULLIFY(YPACK_CH_ISBA%XP_SOILRC_O3)
- NULLIFY(YPACK_CH_ISBA%XP_DEP)
-IF (LHOOK) CALL DR_HOOK("MODD_PACK_CH_ISBA_N:PACK_CH_ISBA_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE PACK_CH_ISBA_INIT
-
-
-END MODULE MODD_PACK_CH_ISBA
diff --git a/src/SURFEX/modd_pack_diag_isba.F90 b/src/SURFEX/modd_pack_diag_isba.F90
deleted file mode 100644
index 0d3eacde54a134cd669b59ff04906a177f7ec02a..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_pack_diag_isba.F90
+++ /dev/null
@@ -1,433 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-!######################
-MODULE MODD_PACK_DIAG_ISBA
-!######################
-!
-!!**** *MODD_PACK_DIAG_ISBA - declaration of packed diagnostics for ISBA scheme
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! Modified 10/2004 by P. Le Moigne: add Halstead coefficient
-!! Modified 11/2009 by S. Senesi: add precipitation intercepted by the vegetation (XP_RRVEG)
-!! Modified 04-09 by A.L. Gibelin : Add carbon diagnostics
-!! Modified 10-14 by P. Samuelsson: MEB
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!------------------------------------------------------------------------------
-!
-TYPE PACK_DIAG_ISBA_t
-
- INTEGER :: NSIZE_SIMPLE
- INTEGER :: NSIZE_GROUND
- INTEGER :: NSIZE_SNOW
- INTEGER :: NSIZE_KSW
- INTEGER :: NSIZE_ABC
- INTEGER :: NSIZE_0
- INTEGER :: NSIZE_00
- REAL, POINTER, DIMENSION(:,:) :: XBLOCK_SIMPLE
- REAL, POINTER, DIMENSION(:,:,:) :: XBLOCK_GROUND
- REAL, POINTER, DIMENSION(:,:,:) :: XBLOCK_SNOW
- REAL, POINTER, DIMENSION(:,:,:) :: XBLOCK_KSW
- REAL, POINTER, DIMENSION(:,:,:) :: XBLOCK_ABC
- REAL, POINTER, DIMENSION(:,:) :: XBLOCK_0
- REAL, POINTER, DIMENSION(:,:,:) :: XBLOCK_00
-!
- REAL, POINTER, DIMENSION(:) :: XP_RNSNOW ! net radiative flux from snow (ISBA-ES:3-L) (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_HSNOW ! sensible heat flux from snow (ISBA-ES:3-L) (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_HPSNOW ! heat release from rainfall (ISBA-ES:3-L) (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_GFLUXSNOW ! net surface energy flux into snowpack
-! ! (ISBA-ES:3-L) (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_USTARSNOW ! friction velocity over snow
-! ! (ISBA-ES:3-L) (m/s)
- REAL, POINTER, DIMENSION(:) :: XP_GRNDFLUX ! soil/snow interface heat flux (ISBA-ES:3-L) (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_SRSFC ! snowfall over snowpack (ISBA-ES:3-L) (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_RRSFC ! rainfall over snowpack (ISBA-ES:3-L) (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_LESL ! snowpack evaporation (ISBA-ES:3-L) (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_CDSNOW ! snow drag coefficient (ISBA-ES:3-L) (-)
- REAL, POINTER, DIMENSION(:) :: XP_CHSNOW ! heat turbulent transfer coefficient
-! ! (ISBA-ES:3-L) (-)
- REAL, POINTER, DIMENSION(:,:)::XP_SNOWTEMP ! snow temperature profile (ISBA-ES:3-L) (K)
- REAL, POINTER, DIMENSION(:,:)::XP_SNOWLIQ ! snow liquid water profile (ISBA-ES:3-L) (m)
- REAL, POINTER, DIMENSION(:,:)::XP_SNOWDZ ! snow layer thicknesses (m)
- REAL, POINTER, DIMENSION(:) :: XP_SNOWHMASS ! heat content change due to mass
-! ! changes in snowpack: for budget
-! ! calculations only. (ISBA-ES:3-L) (J/m2)
- REAL, POINTER, DIMENSION(:) :: XP_RN_ISBA ! net radiative flux from snow-free surface
-! ! (ISBA-ES:3-L) (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_H_ISBA ! sensible heat flux from snow-free surface
-! ! (ISBA-ES:3-L) (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_LEG_ISBA ! baresoil evaporation from snow-free surface
-! ! (ISBA-ES:3-L) (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_LEGI_ISBA ! baresoil sublimation from snow-free surface
-! ! (ISBA-ES:3-L) (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_LEV_ISBA ! total evapotranspiration from vegetation over
-! ! snow-free surface (ISBA-ES:3-L) (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_LETR_ISBA ! transpiration from snow-free surface
-! ! (ISBA-ES:3-L) (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_USTAR_ISBA! friction velocity from snow-free
-! ! surface (ISBA-ES:3-L) (m/s)
- REAL, POINTER, DIMENSION(:) :: XP_LER_ISBA ! evaporation from canopy water interception
-! ! store over snow-free surface (ISBA-ES:3-L) (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_LE_ISBA ! total latent heat flux from snow-free surface
- REAL, POINTER, DIMENSION(:) :: XP_LEI_ISBA ! sublimation latent heat flux from snow-free surface
-! ! (ISBA-ES:3-L) (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_GFLUX_ISBA! net energy flux into the snow-free surface
-! ! (ISBA-ES:3-L) (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_MELTADV ! advective energy from snow melt water
-! ! (ISBA-ES:3-L) (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_CH ! thermal diffusion coefficient (W/s)
- REAL, POINTER, DIMENSION(:) :: XP_CE ! transfer coefficient for vapor (W/s/K)
- REAL, POINTER, DIMENSION(:) :: XP_CD ! drag coefficient (-)
- REAL, POINTER, DIMENSION(:) :: XP_CDN ! neutral drag coefficient (-)
- REAL, POINTER, DIMENSION(:) :: XP_RI ! Bulk-Richardson number (-)
- REAL, POINTER, DIMENSION(:) :: XP_HU ! area averaged surface humidity coefficient (-)
- REAL, POINTER, DIMENSION(:) :: XP_HUG ! baresoil surface humidity coefficient (-)
- REAL, POINTER, DIMENSION(:) :: XP_HV ! Halstead coefficient (-)
-!
- REAL, POINTER, DIMENSION(:) :: XP_ALBT ! Total Albedo (-)
-!
- REAL, POINTER, DIMENSION(:) :: XP_RN ! net radiation at surface (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_H ! sensible heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_LEG ! baresoil evaporation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_LEGI ! baresoil sublimation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_LEV ! total evapotranspiration from vegetation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_LES ! snow sublimation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_LER ! evaporation from canopy water interception
-! ! store (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_LETR ! transpiration (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_EVAP ! evapotranspiration (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_SUBL ! sublimation (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_SNDRIFT ! blowing snow sublimation (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_LEI ! sublimation latent heat flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_GFLUX ! net soil-vegetation flux (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_RESTORE ! surface energy budget restore term (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_DRAIN ! soil drainage flux (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_QSB ! lateral subsurface flux (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_RUNOFF ! sub-grid and supersaturation runoff (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_MELT ! melting rate of the snow (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_SNOWFREE_ALB ! snow-free global albedo (-)
- REAL, POINTER, DIMENSION(:) :: XP_SNOWFREE_ALB_VEG ! snow-free global albedo of vegetation
- REAL, POINTER, DIMENSION(:) :: XP_SNOWFREE_ALB_SOIL! snow-free soil albedo
- REAL, POINTER, DIMENSION(:) :: XP_Z0_WITH_SNOW ! total roughness length (including snow) (m)
- REAL, POINTER, DIMENSION(:) :: XP_Z0H_WITH_SNOW! roughness length for heat (including snow) (m)
- REAL, POINTER, DIMENSION(:) :: XP_Z0EFF ! effective roughness length (with relief added)(m)
-!
- REAL, POINTER, DIMENSION(:,:)::XP_IACAN ! PAR in the canopy at different gauss level (micmolphot/m2/s)
-!
- REAL, POINTER, DIMENSION(:) :: XP_CG ! heat capacity of the ground
- REAL, POINTER, DIMENSION(:) :: XP_C1 ! coefficients for the moisure
- REAL, POINTER, DIMENSION(:) :: XP_C2 ! equation.
- REAL, POINTER, DIMENSION(:) :: XP_WGEQ ! equilibrium volumetric water
-! ! content
- REAL, POINTER, DIMENSION(:) :: XP_CT ! area-averaged heat capacity
- REAL, POINTER, DIMENSION(:) :: XP_RS ! stomatal resistance (s/m)
-!
-!------------------------------------------------------------------------------
-!
- REAL, POINTER, DIMENSION(:) :: XP_TS ! Surface temperature (K)
- REAL, POINTER, DIMENSION(:) :: XP_TSRAD ! Radiative surface temperature (K)
- REAL, POINTER, DIMENSION(:) :: XP_T2M ! Air temperature at 2 meters (K)
- REAL, POINTER, DIMENSION(:) :: XP_Q2M ! Air spec. humidity at 2 meters (kg/kg)
- REAL, POINTER, DIMENSION(:) :: XP_HU2M ! Air rela. humidity at 2 meters (-)
- REAL, POINTER, DIMENSION(:) :: XP_ZON10M ! zonal Wind at 10 meters (m/s)
- REAL, POINTER, DIMENSION(:) :: XP_MER10M ! meridian Wind at 10 meters (m/s)
-!
-!------------------------------------------------------------------------------
-!
- REAL, POINTER, DIMENSION(:) :: XP_QS ! humidity at surface (Kg/kg)
- REAL, POINTER, DIMENSION(:,:) :: XP_SWI ! soil wetness index profile (-)
- REAL, POINTER, DIMENSION(:,:) :: XP_TSWI ! total soil wetness index profile (-)
-!
-!------------------------------------------------------------------------------
-!
- REAL, POINTER, DIMENSION(:) :: XP_TWSNOW ! total snow reservoir (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XP_TDSNOW ! total snow height (m)
-!
-!------------------------------------------------------------------------------
-!
- REAL, POINTER, DIMENSION(:) :: XP_SWD ! downward short wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_SWU ! upward short wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XP_SWBD ! downward short wave radiation by spectral band (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XP_SWBU ! upward short wave radiation by spectral band (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_LWD ! downward long wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_LWU ! upward long wave radiation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_FMU ! horizontal momentum flux zonal (m2/s2)
- REAL, POINTER, DIMENSION(:) :: XP_FMV ! horizontal momentum flux meridian (m2/s2)
-!
-!------------------------------------------------------------------------------
-!
- REAL, POINTER, DIMENSION(:) :: XP_HORT ! sub-grid Horton runoff from the SGH scheme (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_DRIP ! dripping from the vegetation reservoir (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_IFLOOD ! flood infiltration (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_PFLOOD ! precipitation intercepted by the floodplains (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_LE_FLOOD ! flood evaporation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_LEI_FLOOD ! frozen flood evaporation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_ICEFLUX
- REAL, POINTER, DIMENSION(:) :: XP_RRVEG ! precipitation intercepted by the vegetation (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_IRRIG_FLUX! irrigation rate (kg/m2/s)
-!
-!------------------------------------------------------------------------------
-!
- REAL, POINTER, DIMENSION(:) :: XP_GPP ! Gross primary production (kgCO2/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_RESP_AUTO ! Autotrophic respiration (kgCO2/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_RESP_ECO ! Ecosystem respiration (kgCO2/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_FAPAR ! Fapar of vegetation
- REAL, POINTER, DIMENSION(:) :: XP_FAPIR ! Fapir of vegetation
- REAL, POINTER, DIMENSION(:) :: XP_FAPAR_BS ! Fapar of bare soil
- REAL, POINTER, DIMENSION(:) :: XP_FAPIR_BS ! Fapir of bare soil
-!
-!------------------------------------------------------------------------------
-!
-!* diagnostic variables for multi-energy balance (MEB)
-! ---------------------------------------------------
-!
- REAL, POINTER, DIMENSION(:) :: XP_SWUP ! MEB: net *total* (surface) upwelling shortwave radiation to atmosphere [W/m2]
- REAL, POINTER, DIMENSION(:) :: XP_SWNET_V ! MEB: net vegetation canopy shortwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XP_SWNET_G ! MEB: net ground shortwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XP_SWNET_N ! MEB: net snow shortwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XP_SWNET_NS ! MEB: net snow shortwave radiation for *surface* layer
- ! (i.e. net snow shortwave radiation less absorbed radiation) [W/m2]
- REAL, POINTER, DIMENSION(:) :: XP_LWUP ! MEB: net *total* (surface) upwelling longwave radiation to atmosphere [W/m2]
- REAL, POINTER, DIMENSION(:) :: XP_LWNET_V ! MEB: net vegetation canopy longwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XP_LWNET_G ! MEB: net ground longwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XP_LWNET_N ! MEB: net snow longwave radiation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XP_LEVCV ! MEB: total evapotranspiration from vegetation canopy overstory [W/m2]
- REAL, POINTER, DIMENSION(:) :: XP_LESC ! MEB: total snow sublimation from vegetation canopy overstory [W/m2]
- REAL, POINTER, DIMENSION(:) :: XP_H_V_C ! MEB: sensible heat flux from vegetation canopy overstory [W/m2]
- REAL, POINTER, DIMENSION(:) :: XP_H_G_C ! MEB: sensible heat flux from understory [W/m2]
- REAL, POINTER, DIMENSION(:) :: XP_LETRGV ! MEB: transpiration from understory vegetation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XP_LETRCV ! MEB: transpiration from overstory canopy vegetation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XP_LERGV ! MEB: interception evaporation from understory vegetation [W/m2
- REAL, POINTER, DIMENSION(:) :: XP_LELITTER ! MEB: water evaporation from litter[W/m2]
- REAL, POINTER, DIMENSION(:) :: XP_LELITTERI ! MEB: ice sublimation from litter [W/m2]
- REAL, POINTER, DIMENSION(:) :: XP_DRIPLIT !
- REAL, POINTER, DIMENSION(:) :: XP_RRLIT !
- REAL, POINTER, DIMENSION(:) :: XP_LERCV ! MEB: interception evaporation from overstory canopy vegetation [W/m2]
- REAL, POINTER, DIMENSION(:) :: XP_H_C_A ! MEB: sensible heat flux from canopy air space to the atmosphere [W/m2]
- REAL, POINTER, DIMENSION(:) :: XP_H_N_C ! MEB: sensible heat flux from the snow on the ground [W/m2]
- ! NOTE total sensible heat flux to the atmosphere also possibly
- ! includes a contribution from snow covering the canopy
- REAL, POINTER, DIMENSION(:) :: XP_LE_V_C ! MEB: latent heat flux from vegetation canopy overstory [W/m2]
- REAL, POINTER, DIMENSION(:) :: XP_LE_G_C ! MEB: latent heat flux from understory [W/m2]
- REAL, POINTER, DIMENSION(:) :: XP_LE_C_A ! MEB: latent heat flux from canopy air space to the atmosphere [W/m2]
- ! NOTE total latent heat flux to the atmosphere also possibly
- ! includes a contribution from snow covering the canopy
- REAL, POINTER, DIMENSION(:) :: XP_LE_N_C ! MEB: latent heat flux from the snow on the ground [W/m2]
- ! NOTE total latent heat flux from the snowpack
- ! possibly includes a contribution from snow covering the canopy
- REAL, POINTER, DIMENSION(:) :: XP_EVAP_N_C ! MEB: Total evap from snow on the ground to canopy air space [kg/m2/s]
- REAL, POINTER, DIMENSION(:) :: XP_EVAP_G_C ! MEB: Total evap from ground to canopy air space [kg/m2/s]
- REAL, POINTER, DIMENSION(:) :: XP_SR_GN ! MEB: total snow reacing the ground snow [kg/m2/s]
- REAL, POINTER, DIMENSION(:) :: XP_MELTCV ! MEB: snow melt rate from the overstory snow reservoir [kg/m2/s]
- REAL, POINTER, DIMENSION(:) :: XP_FRZCV ! MEB: snow refreeze rate from the overstory snow reservoir [kg/m2/s]
- REAL, POINTER, DIMENSION(:) :: XP_SWDOWN_GN ! MEB: total shortwave radiation transmitted through the canopy
- ! reaching the snowpack/ground understory [W/m2]
- REAL, POINTER, DIMENSION(:) :: XP_LWDOWN_GN ! MEB: total shortwave radiation transmitted through and emitted by the canopy
-! ! reaching the snowpack/ground understory (explicit part) [W/m2]
-!
-!------------------------------------------------------------------------------
-!
- REAL, POINTER, DIMENSION(:) :: XP_DWG ! liquid soil moisture time tendencies (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_DWGI ! solid soil moisture time tendencies (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_DWR ! canopy water time tendencies (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_DSWE ! snow water equivalent time tendencies (kg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_WATBUD ! ISBA water budget (kg/m2/s)
-
-END TYPE PACK_DIAG_ISBA_t
-!
-!-------------------------------------------------------------------------------
-!
-
-
- CONTAINS
-
-!
-!
-
-
-
-
-SUBROUTINE PACK_DIAG_ISBA_INIT(YPACK_DIAG_ISBA)
-TYPE(PACK_DIAG_ISBA_t), INTENT(INOUT) :: YPACK_DIAG_ISBA
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_PACK_DIAG_ISBA_N:PACK_DIAG_ISBA_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YPACK_DIAG_ISBA%XBLOCK_SIMPLE)
- NULLIFY(YPACK_DIAG_ISBA%XBLOCK_GROUND)
- NULLIFY(YPACK_DIAG_ISBA%XBLOCK_SNOW)
- NULLIFY(YPACK_DIAG_ISBA%XBLOCK_KSW)
- NULLIFY(YPACK_DIAG_ISBA%XBLOCK_ABC)
- NULLIFY(YPACK_DIAG_ISBA%XBLOCK_0)
- NULLIFY(YPACK_DIAG_ISBA%XBLOCK_00)
- NULLIFY(YPACK_DIAG_ISBA%XP_RNSNOW)
- NULLIFY(YPACK_DIAG_ISBA%XP_HSNOW)
- NULLIFY(YPACK_DIAG_ISBA%XP_HPSNOW)
- NULLIFY(YPACK_DIAG_ISBA%XP_GFLUXSNOW)
- NULLIFY(YPACK_DIAG_ISBA%XP_USTARSNOW)
- NULLIFY(YPACK_DIAG_ISBA%XP_GRNDFLUX)
- NULLIFY(YPACK_DIAG_ISBA%XP_SRSFC)
- NULLIFY(YPACK_DIAG_ISBA%XP_RRSFC)
- NULLIFY(YPACK_DIAG_ISBA%XP_LESL)
- NULLIFY(YPACK_DIAG_ISBA%XP_CDSNOW)
- NULLIFY(YPACK_DIAG_ISBA%XP_CHSNOW)
- NULLIFY(YPACK_DIAG_ISBA%XP_SNOWTEMP)
- NULLIFY(YPACK_DIAG_ISBA%XP_SNOWLIQ)
- NULLIFY(YPACK_DIAG_ISBA%XP_SNOWDZ)
- NULLIFY(YPACK_DIAG_ISBA%XP_SNOWHMASS)
- NULLIFY(YPACK_DIAG_ISBA%XP_RN_ISBA)
- NULLIFY(YPACK_DIAG_ISBA%XP_H_ISBA)
- NULLIFY(YPACK_DIAG_ISBA%XP_LEG_ISBA)
- NULLIFY(YPACK_DIAG_ISBA%XP_LEGI_ISBA)
- NULLIFY(YPACK_DIAG_ISBA%XP_LEV_ISBA)
- NULLIFY(YPACK_DIAG_ISBA%XP_LETR_ISBA)
- NULLIFY(YPACK_DIAG_ISBA%XP_USTAR_ISBA)
- NULLIFY(YPACK_DIAG_ISBA%XP_LER_ISBA)
- NULLIFY(YPACK_DIAG_ISBA%XP_LE_ISBA)
- NULLIFY(YPACK_DIAG_ISBA%XP_LEI_ISBA)
- NULLIFY(YPACK_DIAG_ISBA%XP_GFLUX_ISBA)
- NULLIFY(YPACK_DIAG_ISBA%XP_MELTADV)
- NULLIFY(YPACK_DIAG_ISBA%XP_CH)
- NULLIFY(YPACK_DIAG_ISBA%XP_CE)
- NULLIFY(YPACK_DIAG_ISBA%XP_CD)
- NULLIFY(YPACK_DIAG_ISBA%XP_CDN)
- NULLIFY(YPACK_DIAG_ISBA%XP_RI)
- NULLIFY(YPACK_DIAG_ISBA%XP_HU)
- NULLIFY(YPACK_DIAG_ISBA%XP_HUG)
- NULLIFY(YPACK_DIAG_ISBA%XP_HV)
- NULLIFY(YPACK_DIAG_ISBA%XP_ALBT)
- NULLIFY(YPACK_DIAG_ISBA%XP_RN)
- NULLIFY(YPACK_DIAG_ISBA%XP_H)
- NULLIFY(YPACK_DIAG_ISBA%XP_LEG)
- NULLIFY(YPACK_DIAG_ISBA%XP_LEGI)
- NULLIFY(YPACK_DIAG_ISBA%XP_LEV)
- NULLIFY(YPACK_DIAG_ISBA%XP_LES)
- NULLIFY(YPACK_DIAG_ISBA%XP_LER)
- NULLIFY(YPACK_DIAG_ISBA%XP_LETR)
- NULLIFY(YPACK_DIAG_ISBA%XP_EVAP)
- NULLIFY(YPACK_DIAG_ISBA%XP_SUBL)
- NULLIFY(YPACK_DIAG_ISBA%XP_SNDRIFT)
- NULLIFY(YPACK_DIAG_ISBA%XP_LEI)
- NULLIFY(YPACK_DIAG_ISBA%XP_GFLUX)
- NULLIFY(YPACK_DIAG_ISBA%XP_RESTORE)
- NULLIFY(YPACK_DIAG_ISBA%XP_DRAIN)
- NULLIFY(YPACK_DIAG_ISBA%XP_QSB)
- NULLIFY(YPACK_DIAG_ISBA%XP_RUNOFF)
- NULLIFY(YPACK_DIAG_ISBA%XP_MELT)
- NULLIFY(YPACK_DIAG_ISBA%XP_SNOWFREE_ALB)
- NULLIFY(YPACK_DIAG_ISBA%XP_SNOWFREE_ALB_VEG)
- NULLIFY(YPACK_DIAG_ISBA%XP_SNOWFREE_ALB_SOIL)
- NULLIFY(YPACK_DIAG_ISBA%XP_Z0_WITH_SNOW)
- NULLIFY(YPACK_DIAG_ISBA%XP_Z0H_WITH_SNOW)
- NULLIFY(YPACK_DIAG_ISBA%XP_Z0EFF)
- NULLIFY(YPACK_DIAG_ISBA%XP_IACAN)
- NULLIFY(YPACK_DIAG_ISBA%XP_CG)
- NULLIFY(YPACK_DIAG_ISBA%XP_C1)
- NULLIFY(YPACK_DIAG_ISBA%XP_C2)
- NULLIFY(YPACK_DIAG_ISBA%XP_WGEQ)
- NULLIFY(YPACK_DIAG_ISBA%XP_CT)
- NULLIFY(YPACK_DIAG_ISBA%XP_RS)
- NULLIFY(YPACK_DIAG_ISBA%XP_TS)
- NULLIFY(YPACK_DIAG_ISBA%XP_TSRAD)
- NULLIFY(YPACK_DIAG_ISBA%XP_T2M)
- NULLIFY(YPACK_DIAG_ISBA%XP_Q2M)
- NULLIFY(YPACK_DIAG_ISBA%XP_HU2M)
- NULLIFY(YPACK_DIAG_ISBA%XP_ZON10M)
- NULLIFY(YPACK_DIAG_ISBA%XP_MER10M)
- NULLIFY(YPACK_DIAG_ISBA%XP_QS)
- NULLIFY(YPACK_DIAG_ISBA%XP_SWI)
- NULLIFY(YPACK_DIAG_ISBA%XP_TSWI)
- NULLIFY(YPACK_DIAG_ISBA%XP_TWSNOW)
- NULLIFY(YPACK_DIAG_ISBA%XP_TDSNOW)
- NULLIFY(YPACK_DIAG_ISBA%XP_SWD)
- NULLIFY(YPACK_DIAG_ISBA%XP_SWU)
- NULLIFY(YPACK_DIAG_ISBA%XP_SWBD)
- NULLIFY(YPACK_DIAG_ISBA%XP_SWBU)
- NULLIFY(YPACK_DIAG_ISBA%XP_LWD)
- NULLIFY(YPACK_DIAG_ISBA%XP_LWU)
- NULLIFY(YPACK_DIAG_ISBA%XP_FMU)
- NULLIFY(YPACK_DIAG_ISBA%XP_FMV)
- NULLIFY(YPACK_DIAG_ISBA%XP_HORT)
- NULLIFY(YPACK_DIAG_ISBA%XP_DRIP)
- NULLIFY(YPACK_DIAG_ISBA%XP_IFLOOD)
- NULLIFY(YPACK_DIAG_ISBA%XP_PFLOOD)
- NULLIFY(YPACK_DIAG_ISBA%XP_LE_FLOOD)
- NULLIFY(YPACK_DIAG_ISBA%XP_LEI_FLOOD)
- NULLIFY(YPACK_DIAG_ISBA%XP_ICEFLUX)
- NULLIFY(YPACK_DIAG_ISBA%XP_RRVEG)
- NULLIFY(YPACK_DIAG_ISBA%XP_IRRIG_FLUX)
- NULLIFY(YPACK_DIAG_ISBA%XP_GPP)
- NULLIFY(YPACK_DIAG_ISBA%XP_RESP_AUTO)
- NULLIFY(YPACK_DIAG_ISBA%XP_RESP_ECO)
- NULLIFY(YPACK_DIAG_ISBA%XP_FAPAR)
- NULLIFY(YPACK_DIAG_ISBA%XP_FAPIR)
- NULLIFY(YPACK_DIAG_ISBA%XP_FAPAR_BS)
- NULLIFY(YPACK_DIAG_ISBA%XP_FAPIR_BS)
- NULLIFY(YPACK_DIAG_ISBA%XP_SWUP)
- NULLIFY(YPACK_DIAG_ISBA%XP_SWNET_V)
- NULLIFY(YPACK_DIAG_ISBA%XP_SWNET_G)
- NULLIFY(YPACK_DIAG_ISBA%XP_SWNET_N)
- NULLIFY(YPACK_DIAG_ISBA%XP_SWNET_NS)
- NULLIFY(YPACK_DIAG_ISBA%XP_LWUP)
- NULLIFY(YPACK_DIAG_ISBA%XP_LWNET_V)
- NULLIFY(YPACK_DIAG_ISBA%XP_LWNET_G)
- NULLIFY(YPACK_DIAG_ISBA%XP_LWNET_N)
- NULLIFY(YPACK_DIAG_ISBA%XP_LEVCV)
- NULLIFY(YPACK_DIAG_ISBA%XP_LESC)
- NULLIFY(YPACK_DIAG_ISBA%XP_H_V_C)
- NULLIFY(YPACK_DIAG_ISBA%XP_H_G_C)
- NULLIFY(YPACK_DIAG_ISBA%XP_LETRGV)
- NULLIFY(YPACK_DIAG_ISBA%XP_LETRCV)
- NULLIFY(YPACK_DIAG_ISBA%XP_LERGV)
- NULLIFY(YPACK_DIAG_ISBA%XP_LELITTER)
- NULLIFY(YPACK_DIAG_ISBA%XP_LELITTERI)
- NULLIFY(YPACK_DIAG_ISBA%XP_DRIPLIT)
- NULLIFY(YPACK_DIAG_ISBA%XP_RRLIT)
- NULLIFY(YPACK_DIAG_ISBA%XP_LERCV)
- NULLIFY(YPACK_DIAG_ISBA%XP_H_C_A)
- NULLIFY(YPACK_DIAG_ISBA%XP_H_N_C)
- NULLIFY(YPACK_DIAG_ISBA%XP_LE_V_C)
- NULLIFY(YPACK_DIAG_ISBA%XP_LE_G_C)
- NULLIFY(YPACK_DIAG_ISBA%XP_LE_C_A)
- NULLIFY(YPACK_DIAG_ISBA%XP_LE_N_C)
- NULLIFY(YPACK_DIAG_ISBA%XP_EVAP_N_C)
- NULLIFY(YPACK_DIAG_ISBA%XP_EVAP_G_C)
- NULLIFY(YPACK_DIAG_ISBA%XP_SR_GN)
- NULLIFY(YPACK_DIAG_ISBA%XP_MELTCV)
- NULLIFY(YPACK_DIAG_ISBA%XP_FRZCV)
- NULLIFY(YPACK_DIAG_ISBA%XP_SWDOWN_GN)
- NULLIFY(YPACK_DIAG_ISBA%XP_LWDOWN_GN)
- NULLIFY(YPACK_DIAG_ISBA%XP_DWG)
- NULLIFY(YPACK_DIAG_ISBA%XP_DWGI)
- NULLIFY(YPACK_DIAG_ISBA%XP_DWR)
- NULLIFY(YPACK_DIAG_ISBA%XP_DSWE)
- NULLIFY(YPACK_DIAG_ISBA%XP_WATBUD)
-IF (LHOOK) CALL DR_HOOK("MODD_PACK_DIAG_ISBA_N:PACK_DIAG_ISBA_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE PACK_DIAG_ISBA_INIT
-
-
-END MODULE MODD_PACK_DIAG_ISBA
diff --git a/src/SURFEX/modd_pack_isba.F90 b/src/SURFEX/modd_pack_isba.F90
deleted file mode 100644
index ee963b96fea2898e326891a4e7288af06ed63d63..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_pack_isba.F90
+++ /dev/null
@@ -1,658 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-!######################
-MODULE MODD_PACK_ISBA
-!######################
-!
-!!**** *MODD_PACK_ISBA - declaration of packed surface parameters for ISBA scheme
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! A. Boone *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 20/09/02
-!! A.L. Gibelin 04/2009 : BIOMASS and RESP_BIOMASS arrays
-!! A.L. Gibelin 04/2009 : TAU_WOOD for NCB option
-!! A.L. Gibelin 05/2009 : Add carbon spinup
-!! A.L. Gibelin 06/2009 : Soil carbon variables for CNT option
-!! A.L. Gibelin 07/2009 : Suppress RDK and transform GPP as a diagnostic
-!! A.L. Gibelin 07/2009 : Suppress PPST and PPSTF as outputs
-!! P. Samuelsson 10/2014 : MEB and additional snow albedos
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_TYPE_DATE_SURF
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!-------------------------------------------------------------------------------
-!
-TYPE PACK_ISBA_t
-
- INTEGER :: NSIZE_LSIMPLE
- INTEGER :: NSIZE_L0
- INTEGER :: NSIZE_NSIMPLE
- INTEGER :: NSIZE_N0
- INTEGER :: NSIZE_TSIMPLE
- INTEGER :: NSIZE_T0
- INTEGER :: NSIZE_SIMPLE
- INTEGER :: NSIZE_GROUND
- INTEGER :: NSIZE_VEGTYPE
- INTEGER :: NSIZE_TG
- INTEGER :: NSIZE_SNOW
- INTEGER :: NSIZE_ALB
- INTEGER :: NSIZE_2
- INTEGER :: NSIZE_BIOMASS
- INTEGER :: NSIZE_SOILCARB
- INTEGER :: NSIZE_LITTLEVS
- INTEGER :: NSIZE_LITTER
- INTEGER :: NSIZE_0
- INTEGER :: NSIZE_00
- INTEGER :: NSIZE_000
- INTEGER :: NSIZE_01
- LOGICAL, POINTER, DIMENSION(:,:) :: LBLOCK_SIMPLE
- LOGICAL, POINTER, DIMENSION(:,:) :: LBLOCK_0
- INTEGER, POINTER, DIMENSION(:,:) :: NBLOCK_SIMPLE
- INTEGER, POINTER, DIMENSION(:,:) :: NBLOCK_0
- TYPE(DATE_TIME), POINTER, DIMENSION(:,:) :: TBLOCK_SIMPLE
- TYPE(DATE_TIME), POINTER, DIMENSION(:,:) :: TBLOCK_0
- REAL, POINTER, DIMENSION(:,:) :: XBLOCK_SIMPLE
- REAL, POINTER, DIMENSION(:,:,:) :: XBLOCK_GROUND
- REAL, POINTER, DIMENSION(:,:,:) :: XBLOCK_VEGTYPE
- REAL, POINTER, DIMENSION(:,:,:) :: XBLOCK_TG
- REAL, POINTER, DIMENSION(:,:,:) :: XBLOCK_SNOW
- REAL, POINTER, DIMENSION(:,:,:) :: XBLOCK_ALB
- REAL, POINTER, DIMENSION(:,:,:) :: XBLOCK_2
- REAL, POINTER, DIMENSION(:,:,:) :: XBLOCK_BIOMASS
- REAL, POINTER, DIMENSION(:,:,:) :: XBLOCK_SOILCARB
- REAL, POINTER, DIMENSION(:,:,:) :: XBLOCK_LITTLEVS
- REAL, POINTER, DIMENSION(:,:,:,:) :: XBLOCK_LITTER
- REAL, POINTER, DIMENSION(:,:) :: XBLOCK_0
- REAL, POINTER, DIMENSION(:,:,:) :: XBLOCK_00
- REAL, POINTER, DIMENSION(:,:,:,:) :: XBLOCK_000
- REAL, POINTER, DIMENSION(:,:,:) :: XBLOCK_01
-!
-! Mask and number of grid elements containing patches/tiles:
-!
- REAL, POINTER, DIMENSION(:,:) :: XP_VEGTYPE_PATCH ! fraction of each vegetation type for
-! ! each vegetation unit/patch (-)
-!
-! General surface parameters:
-!
- REAL, POINTER, DIMENSION(:) :: XP_SSO_SLOPE ! orography slope within the grid mesh (-)
- REAL, POINTER, DIMENSION(:) :: XP_LAT ! latitude (-)
- REAL, POINTER, DIMENSION(:) :: XP_LON ! latitude (-)
-!
-! Subgrid orography parameters
-!
- REAL, DIMENSION(:), POINTER :: XP_AOSIP,XP_AOSIM,XP_AOSJP,XP_AOSJM
-! directional A/S quantities in 4 coordinate directions
-! (IP: i index up; IM: i index down; JP: j index up; JM: j index down)
-! They are used in soil routines to compute effective roughness length
-!
- REAL, DIMENSION(:), POINTER :: XP_HO2IP,XP_HO2IM,XP_HO2JP,XP_HO2JM
-! directional h/2 quantities in 4 coordinate directions
-! (IP: i index up; IM: i index down; JP: j index up; JM: j index down)
-! They are used in soil routines to compute effective roughness length
-!
- REAL, DIMENSION(:), POINTER :: XP_Z0EFFIP,XP_Z0EFFIM,XP_Z0EFFJP,XP_Z0EFFJM
-! directional total roughness lenghts in 4 coordinate directions
-! (IP: i index up; IM: i index down; JP: j index up; JM: j index down)
-!
- REAL, POINTER, DIMENSION(:) :: XP_Z0REL ! relief roughness length (m)
-
-!
-! Input Parameters:
-!
-! - bare soil:
-!
- REAL, POINTER, DIMENSION(:,:) :: XP_CLAY ! clay fraction profile (-)
- REAL, POINTER, DIMENSION(:,:) :: XP_SAND ! sand fraction profile (-)
-
- REAL, POINTER, DIMENSION(:) :: XP_ALBNIR_DRY ! near-infra-red albedo of dry soil (-)
- REAL, POINTER, DIMENSION(:) :: XP_ALBVIS_DRY ! visible albedo of dry soil (-)
- REAL, POINTER, DIMENSION(:) :: XP_ALBUV_DRY ! UV albedo of dry soil (-)
- REAL, POINTER, DIMENSION(:) :: XP_ALBNIR_WET ! near-infra-red albedo of wet soil (-)
- REAL, POINTER, DIMENSION(:) :: XP_ALBVIS_WET ! visible albedo of wet soil (-)
- REAL, POINTER, DIMENSION(:) :: XP_ALBUV_WET ! UV albedo of wet soil (-)
- REAL, POINTER, DIMENSION(:) :: XP_ALBNIR_SOIL ! near-infra-red albedo of wet soil (-)
- REAL, POINTER, DIMENSION(:) :: XP_ALBVIS_SOIL ! visible albedo of soil (-)
- REAL, POINTER, DIMENSION(:) :: XP_ALBUV_SOIL ! UV albedo of soil (-)
-!
-! - vegetation + bare soil:
-!
- REAL, POINTER, DIMENSION(:) :: XP_Z0_O_Z0H ! ratio of surface roughness lengths
-! ! (momentum to heat) (-)
- REAL, POINTER, DIMENSION(:) :: XP_ALBNIR ! near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:) :: XP_ALBVIS ! visible albedo (-)
- REAL, POINTER, DIMENSION(:) :: XP_ALBUV ! UV albedo (-)
- REAL, POINTER, DIMENSION(:) :: XP_EMIS ! snow-free surface emissivity (-)
- REAL, POINTER, DIMENSION(:) :: XP_Z0 ! snow-free surface roughness length (m)
-!
-! - vegetation :
-!
- REAL, POINTER, DIMENSION(:) :: XP_ALBNIR_VEG ! near-infra-red albedo of vegetation (-)
- REAL, POINTER, DIMENSION(:) :: XP_ALBVIS_VEG ! visible albedo of vegetation (-)
- REAL, POINTER, DIMENSION(:) :: XP_ALBUV_VEG ! UV albedo of vegetation (-)
-!
-!
-! - vegetation: default option (Jarvis) and general parameters:
-!
- REAL, POINTER, DIMENSION(:) :: XP_VEG ! vegetation cover fraction (-)
- REAL, POINTER, DIMENSION(:) :: XP_WRMAX_CF ! coefficient for maximum water
-! ! interception
-! ! storage capacity on the vegetation (-)
- REAL, POINTER, DIMENSION(:) :: XP_RSMIN ! minimum stomatal resistance (s/m)
- REAL, POINTER, DIMENSION(:) :: XP_GAMMA ! coefficient for the calculation
-! ! of the surface stomatal
-! ! resistance
- REAL, POINTER, DIMENSION(:) :: XP_CV ! vegetation thermal inertia coefficient (K m2/J)
- REAL, POINTER, DIMENSION(:) :: XP_RGL ! maximum solar radiation
-! ! usable in photosynthesis (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XP_ROOTFRAC ! root fraction profile ('DIF' option)
-!
-! - vegetation: Ags parameters ('AGS', 'LAI', 'AST', 'LST', 'NIT', 'NCB' options)
-!
- REAL, POINTER, DIMENSION(:) :: XP_BSLAI ! ratio d(biomass)/d(lai) (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XP_LAIMIN ! minimum LAI (Leaf Area Index) (m2/m2)
- REAL, POINTER, DIMENSION(:) :: XP_SEFOLD ! e-folding time for senescence (s)
- REAL, POINTER, DIMENSION(:) :: XP_H_TREE ! height of trees (m)
- REAL, POINTER, DIMENSION(:) :: XP_ANF ! total assimilation over canopy (
- REAL, POINTER, DIMENSION(:) :: XP_ANMAX ! maximum photosynthesis rate (
- REAL, POINTER, DIMENSION(:) :: XP_FZERO ! ideal value of F, no photo-
-! ! respiration or saturation deficit (
- REAL, POINTER, DIMENSION(:) :: XP_EPSO ! maximum initial quantum use
-! ! efficiency (mg J-1 PAR)
- REAL, POINTER, DIMENSION(:) :: XP_GAMM ! CO2 conpensation concentration (ppmv)
- REAL, POINTER, DIMENSION(:) :: XP_QDGAMM ! Log of Q10 function for CO2 conpensation
-! ! concentration (-)
- REAL, POINTER, DIMENSION(:) :: XP_GMES ! mesophyll conductance (m s-1)
- REAL, POINTER, DIMENSION(:) :: XP_RE25 ! Ecosystem respiration parameter (kg m-2 s-1)
- REAL, POINTER, DIMENSION(:) :: XP_QDGMES ! Log of Q10 function for mesophyll conductance (-)
- REAL, POINTER, DIMENSION(:) :: XP_T1GMES ! reference temperature for computing
-! ! compensation concentration function for
-! ! mesophyll conductance: minimum
-! ! temperature (K)
- REAL, POINTER, DIMENSION(:) :: XP_T2GMES ! reference temperature for computing
-! ! compensation concentration function for
-! ! mesophyll conductance: maximum
-! ! temperature (K)
- REAL, POINTER, DIMENSION(:) :: XP_AMAX ! leaf photosynthetic capacity (kg m-2 s-1)
- REAL, POINTER, DIMENSION(:) :: XP_QDAMAX ! Log of Q10 function for leaf photosynthetic
-! ! capacity (-)
- REAL, POINTER, DIMENSION(:) :: XP_T1AMAX ! reference temperature for computing
-! ! compensation concentration function for
-! ! leaf photosynthetic capacity: minimum
-! ! temperature (K)
- REAL, POINTER, DIMENSION(:) :: XP_T2AMAX ! reference temperature for computing
-! ! compensation concentration function for
-! ! leaf photosynthetic capacity: maximum
-! ! temperature (K)
-!
-! - vegetation: Ags Stress parameters ('AST', 'LST', 'NIT', 'NCB' options)
-!
- LOGICAL, POINTER, DIMENSION(:) :: LP_STRESS ! vegetation response type to water
-! ! stress (true:defensive false:offensive) (-)
- REAL, POINTER, DIMENSION(:) :: XP_F2I ! critical normilized soil water
-! ! content for stress parameterisation
- REAL, POINTER, DIMENSION(:) :: XP_GC ! cuticular conductance (m s-1)
- REAL, POINTER, DIMENSION(:) :: XP_AH ! coefficients for herbaceous water stress
-! ! response (offensive or defensive) (log(mm/s))
- REAL, POINTER, DIMENSION(:) :: XP_BH ! coefficients for herbaceous water stress
-! ! response (offensive or defensive) (-)
- REAL, POINTER, DIMENSION(:) :: XP_TAU_WOOD ! residence time in woody biomass (s)
- REAL, POINTER, DIMENSION(:) :: XP_DMAX ! maximum air saturation deficit
-! ! tolerate by vegetation (kg/kg)
-!
-! - vegetation: Ags Nitrogen-model parameters ('NIT', 'NCB' option)
-!
- REAL, POINTER, DIMENSION(:) :: XP_CE_NITRO ! leaf aera ratio sensitivity to
-! ! nitrogen concentration (m2/kg)
- REAL, POINTER, DIMENSION(:) :: XP_CF_NITRO ! lethal minimum value of leaf area
-! ! ratio (m2/kg)
- REAL, POINTER, DIMENSION(:) :: XP_CNA_NITRO ! nitrogen concentration of active
-! ! biomass (kg/kg)
- REAL, POINTER, DIMENSION(:) :: XP_BSLAI_NITRO! biomass/LAI ratio from nitrogen
-! ! decline theory (kg/m2)
-!
-! - soil: primary parameters
-!
- REAL, POINTER, DIMENSION(:) :: XP_RUNOFFB ! sub-grid surface runoff slope parameter (-)
- REAL, POINTER, DIMENSION(:) :: XP_WDRAIN ! continuous drainage parameter (-)
- REAL, POINTER, DIMENSION(:) :: XP_TAUICE ! soil freezing characteristic timescale (s)
- REAL, POINTER, DIMENSION(:) :: XP_GAMMAT ! 'Force-Restore' timescale when using a
-! ! prescribed lower boundary temperature (1/days)
- REAL, POINTER, DIMENSION(:,:) :: XP_DG ! soil layer depth (m)
-! ! NOTE: in Force-Restore mode, the
-! ! uppermost layer thickness is superficial
-! ! and is only explicitly used for soil
-! ! water phase changes (m)
- REAL, POINTER, DIMENSION(:,:) :: XP_DZG ! soil layer thicknesses (m)
- REAL, POINTER, DIMENSION(:,:) :: XP_DZDIF ! distance between consecuative layer mid-points(m)
- INTEGER, POINTER, DIMENSION(:) :: NK_WG_LAYER ! Number of soil moisture layers for DIF
-
- REAL, POINTER, DIMENSION(:) :: XP_RUNOFFD ! depth over which sub-grid runoff is
-! ! computed: in Force-Restore this is the
-! ! total soil column ('2-L'), or root zone
-! ! ('3-L'). For the 'DIF' option, it can
-! ! be any depth within soil column (m)
-!
- REAL, POINTER, DIMENSION(:,:) :: XP_SOILWGHT ! ISBA-DIF: weights for vertical
-! ! integration of soil water and properties
-!
-! - soil: Secondary parameters: hydrology
-!
- REAL, POINTER, DIMENSION(:) :: XP_C1SAT ! 'Force-Restore' C1 coefficient at
-! ! saturation (-)
- REAL, POINTER, DIMENSION(:) :: XP_C2REF ! 'Force-Restore' reference value of C2 (-)
- REAL, POINTER, DIMENSION(:,:) :: XP_C3 ! 'Force-Restore' C3 drainage coefficient (m)
- REAL, POINTER, DIMENSION(:) :: XP_C4B ! 'Force-Restore' sub-surface vertical
-! ! diffusion coefficient (slope parameter) (-)
- REAL, POINTER, DIMENSION(:) :: XP_C4REF ! 'Force-Restore' sub-surface vertical
-! ! diffusion coefficient (-)
- REAL, POINTER, DIMENSION(:) :: XP_ACOEF ! 'Force-Restore' surface vertical
-! ! diffusion coefficient (-)
- REAL, POINTER, DIMENSION(:) :: XP_PCOEF ! 'Force-Restore' surface vertical
-! ! diffusion coefficient (-)
- REAL, POINTER, DIMENSION(:,:) :: XP_WFC ! field capacity volumetric water content
-! ! profile (m3/m3)
- REAL, POINTER, DIMENSION(:,:) :: XP_WWILT ! wilting point volumetric water content
-! ! profile (m3/m3)
- REAL, POINTER, DIMENSION(:,:) :: XP_WSAT ! porosity profile (m3/m3)
- REAL, POINTER, DIMENSION(:,:) :: XP_BCOEF ! soil water CH78 b-parameter (-)
- REAL, POINTER, DIMENSION(:,:) :: XP_CONDSAT ! hydraulic conductivity at saturation (m/s)
- REAL, POINTER, DIMENSION(:,:) :: XP_MPOTSAT ! matric potential at saturation (m)
-!
-! - soil: Secondary parameters: thermal
-!
- REAL, POINTER, DIMENSION(:) :: XP_CGSAT ! soil thermal inertia coefficient at
-! ! saturation (K m2/J)
- REAL, POINTER, DIMENSION(:,:) :: XP_HCAPSOIL ! soil heat capacity (J/K/m3)
- REAL, POINTER, DIMENSION(:,:) :: XP_CONDDRY ! soil dry thermal conductivity (W/m/K)
- REAL, POINTER, DIMENSION(:,:) :: XP_CONDSLD ! soil solids thermal conductivity (W/m/K)
- REAL, POINTER, DIMENSION(:) :: XP_TDEEP ! prescribed deep soil temperature
-! ! (optional) (K)
-! Prognostic variables:
-!
-! - Snow Cover:
-!
- REAL, POINTER, DIMENSION(:,:) :: XP_SNOWSWE ! snow (& liq. water) content (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XP_SNOWHEAT ! heat content (J/m2)
- REAL, POINTER, DIMENSION(:,:) :: XP_SNOWRHO ! density (kg m-3)
- REAL, POINTER, DIMENSION(:,:) :: XP_SNOWGRAN1 ! grain parameter 1 (-)
- REAL, POINTER, DIMENSION(:,:) :: XP_SNOWGRAN2 ! grain parameter 2 (-)
- REAL, POINTER, DIMENSION(:,:) :: XP_SNOWHIST ! historical parameter (-)
- REAL, POINTER, DIMENSION(:,:) :: XP_SNOWAGE ! Snow grain age (days)
- REAL, POINTER, DIMENSION(:) :: XP_SNOWALB ! snow tot albedo (-)
- REAL, POINTER, DIMENSION(:) :: XP_SNOWALBVIS ! snow VIS albedo (-)
- REAL, POINTER, DIMENSION(:) :: XP_SNOWALBNIR ! snow NIR albedo (-)
- REAL, POINTER, DIMENSION(:) :: XP_SNOWALBFIR ! snow FIR albedo (-)
- REAL, POINTER, DIMENSION(:) :: XP_SNOWEMIS ! snow emissivity (ISBA-ES:3-L) (-)
-!
- REAL, POINTER, DIMENSION(:) :: XP_ICE_STO
-!
-! - Soil and vegetation heat and water:
-!
- REAL, POINTER, DIMENSION(:) :: XP_WR ! liquid water retained on the
-! ! foliage of the vegetation
-! ! canopy (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XP_TG ! surface and sub-surface soil
-! ! temperature profile (K)
- REAL, POINTER, DIMENSION(:,:) :: XP_WG ! soil volumetric water content profile (m3/m3)
- REAL, POINTER, DIMENSION(:,:) :: XP_WGI ! soil liquid water equivalent volumetric
-! ! ice content profile (m3/m3)
- REAL, POINTER, DIMENSION(:) :: XP_RESA ! aerodynamic resistance (s/m)
-! - For multi-energy balance:
-!
- REAL, POINTER, DIMENSION(:) :: XP_WRL ! liquid water retained on the litter
-! ! of the canopy vegetation (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XP_WRLI ! solid water retained on the litter
- REAL, POINTER, DIMENSION(:) :: XP_WRVN ! snow retained on the foliage
-! ! of the canopy vegetation (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XP_TV ! canopy vegetation temperature (K)
- REAL, POINTER, DIMENSION(:) :: XP_TL ! litter temperature (K)
- REAL, POINTER, DIMENSION(:) :: XP_TC ! canopy air temperature (K)
- REAL, POINTER, DIMENSION(:) :: XP_QC ! canopy air specific humidity (kg/kg)
-!
- REAL, POINTER, DIMENSION(:) :: XP_RGLV ! canopy veg maximum solar radiation
- REAL, POINTER, DIMENSION(:) :: XP_GAMMAV ! coefficient for the calculation
-! ! of the canopy veg surface stomatal
- REAL, POINTER, DIMENSION(:) :: XP_RSMINV ! canopy veg minimum stomatal resistance (s/m)
- REAL, POINTER, DIMENSION(:,:) :: XP_ROOTFRACV ! canopy veg root fraction profile ('DIF' option)
- REAL, POINTER, DIMENSION(:) :: XP_WRMAX_CFV ! canopy veg coefficient for maximum water
-! ! interception
- REAL, POINTER, DIMENSION(:) :: XP_LAIV ! canopy veg Leaf Area Index (m2/m2)
- REAL, POINTER, DIMENSION(:) :: XP_Z0V ! canopy veg roughness length (m)
- REAL, POINTER, DIMENSION(:) :: XP_H_VEG ! vegetation height (m)
- REAL, POINTER, DIMENSION(:) :: XP_GNDLITTER ! ground litter cover (-)
- REAL, POINTER, DIMENSION(:) :: XP_Z0LITTER ! ground litter roughness length (m)
-!
-! - Vegetation: Ags Prognos
-!
- REAL, POINTER, DIMENSION(:) :: XP_FWTD ! grid-cell fraction of water table to rise
- REAL, POINTER, DIMENSION(:) :: XP_WTD ! water table depth (m)
-!
-! - Vegetation: Ags Prognostic (YPHOTO = 'LAI', 'LST', 'NIT', 'NCB') or prescribed (YPHOTO = 'NON', 'AGS', 'AST')
-!
- REAL, POINTER, DIMENSION(:) :: XP_LAI ! Leaf Area Index (m2/m2)
-!
-! - Vegetation: Ags Prognostic (YPHOTO = 'AGS', 'LAI', 'AST', 'LST', 'NIT', 'NCB')
-!
- REAL, POINTER, DIMENSION(:) :: XP_AN ! net CO2 assimilation (mg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_ANDAY ! daily net CO2 assimilation (mg/m2)
- REAL, POINTER, DIMENSION(:) :: XP_ANFM ! maximum leaf assimilation (mg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XP_LE ! evapotranspiration (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_LEI ! sublimation (W/m2)
- REAL, POINTER, DIMENSION(:) :: XP_FAPARC ! FAPAR of vegetation (cumul)
- REAL, POINTER, DIMENSION(:) :: XP_FAPIRC ! FAPIR of vegetation (cumul)
- REAL, POINTER, DIMENSION(:) :: XP_LAI_EFFC ! effective LAI (cumul)
- REAL, POINTER, DIMENSION(:) :: XP_MUS !
-!
-! - Vegetation: Ags Prognostic (YPHOTO = 'NIT', 'NCB')
-!
- REAL, POINTER, DIMENSION(:,:) :: XP_RESP_BIOMASS ! daily cumulated respiration of
-! ! biomass (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XP_BIOMASS ! biomass of previous day (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XP_INCREASE ! biomass increase (kg/m2/day)
-!
-! - Soil carbon (ISBA-CC, YRESPSL = 'CNT')
-!
- REAL, POINTER, DIMENSION(:,:,:) :: XP_LITTER ! litter pools (gC/m2)
- REAL, POINTER, DIMENSION(:,:) :: XP_SOILCARB ! soil carbon pools (gC/m2)
- REAL, POINTER, DIMENSION(:,:) :: XP_LIGNIN_STRUC ! ratio Lignin/Carbon in structural
-! litter (gC/m2)
-!
- REAL, POINTER, DIMENSION(:,:) :: XP_TURNOVER ! turnover rates from biomass to litter (gC/m2/s)
-!
-! - Irrigation
-!
- LOGICAL, POINTER, DIMENSION(:) :: XP_LIRRIGATE ! high level switch for irrigation
- LOGICAL, POINTER, DIMENSION(:) :: XP_LIRRIDAY ! flag used for daily irrigation stage
- REAL, POINTER, DIMENSION(:) :: XP_THRESHOLD ! threshold for stages
- REAL, POINTER, DIMENSION(:) :: XP_WATSUP ! water supply
- REAL, POINTER, DIMENSION(:) :: XP_IRRIG ! fraction of irrigated vegetation
- TYPE(DATE_TIME), DIMENSION(:), POINTER :: TP_SEED ! seeding date
- TYPE(DATE_TIME), DIMENSION(:), POINTER :: TP_REAP ! reaping date
-! ! previous day (kg/m2)
-! - SGH scheme
-!
- REAL, POINTER, DIMENSION(:) :: XP_D_ICE !depth of the soil column for the calculation
-! of the frozen soil fraction (m)
- REAL, POINTER, DIMENSION(:) :: XP_KSAT_ICE !hydraulic conductivity at saturation
-! over frozen area (m s-1)
- REAL, POINTER, DIMENSION(:) :: XP_FSAT !Topmodel saturated fraction
- REAL, POINTER, DIMENSION(:) :: XP_MUF !Rainfall surface fraction
- REAL, POINTER, DIMENSION(:,:) :: XP_TOPQS !Topmodel baseflow by layer (m s-1)
-!
-! - Courant time step properties
-!
- REAL, POINTER, DIMENSION(:) :: XP_PSN ! fraction of the grid covered by snow (-)
- REAL, POINTER, DIMENSION(:) :: XP_PSNG ! fraction of the the bare ground covered by snow (-)
- REAL, POINTER, DIMENSION(:) :: XP_PSNV ! fraction of the the vegetation covered by snow(-)
- REAL, POINTER, DIMENSION(:) :: XP_PSNV_A ! fraction of the the vegetation covered by snow for EBA scheme(-)
- REAL, POINTER, DIMENSION(:,:) :: XP_DIR_ALB_WITH_SNOW ! Total direct albedo
- REAL, POINTER, DIMENSION(:,:) :: XP_SCA_ALB_WITH_SNOW ! Total diffuse albedo
-!
-! - Flood scheme
-!
- REAL, POINTER, DIMENSION(:) :: XP_ALBF
- REAL, POINTER, DIMENSION(:) :: XP_EMISF
-!
- REAL, POINTER, DIMENSION(:) :: XP_FF ! flood fraction over the surface
- REAL, POINTER, DIMENSION(:) :: XP_FFG ! flood fraction over the ground
- REAL, POINTER, DIMENSION(:) :: XP_FFV ! flood fraction over the vegetation
- REAL, POINTER, DIMENSION(:) :: XP_FFROZEN ! fraction of frozen flood
- REAL, POINTER, DIMENSION(:) :: XP_FFLOOD ! Grdi-cell flood fraction (-)
- REAL, POINTER, DIMENSION(:) :: XP_PIFLOOD ! Floodplains potential infiltration (kg/m2/s)
-!
- REAL, POINTER, DIMENSION(:) :: XP_CPS, XP_LVTT, XP_LSTT
-
-END TYPE PACK_ISBA_t
-!
-!-------------------------------------------------------------------------------
-!
-
-
- CONTAINS
-
-!
-!
-
-
-
-
-SUBROUTINE PACK_ISBA_INIT(YPACK_ISBA)
-TYPE(PACK_ISBA_t), INTENT(INOUT) :: YPACK_ISBA
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_PACK_ISBA_N:PACK_ISBA_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YPACK_ISBA%LBLOCK_SIMPLE)
- NULLIFY(YPACK_ISBA%LBLOCK_0)
- NULLIFY(YPACK_ISBA%NBLOCK_SIMPLE)
- NULLIFY(YPACK_ISBA%NBLOCK_0)
- NULLIFY(YPACK_ISBA%TBLOCK_SIMPLE)
- NULLIFY(YPACK_ISBA%TBLOCK_0)
- NULLIFY(YPACK_ISBA%XBLOCK_SIMPLE)
- NULLIFY(YPACK_ISBA%XBLOCK_GROUND)
- NULLIFY(YPACK_ISBA%XBLOCK_VEGTYPE)
- NULLIFY(YPACK_ISBA%XBLOCK_TG)
- NULLIFY(YPACK_ISBA%XBLOCK_SNOW)
- NULLIFY(YPACK_ISBA%XBLOCK_ALB)
- NULLIFY(YPACK_ISBA%XBLOCK_2)
- NULLIFY(YPACK_ISBA%XBLOCK_BIOMASS)
- NULLIFY(YPACK_ISBA%XBLOCK_SOILCARB)
- NULLIFY(YPACK_ISBA%XBLOCK_LITTLEVS)
- NULLIFY(YPACK_ISBA%XBLOCK_LITTER)
- NULLIFY(YPACK_ISBA%XBLOCK_0)
- NULLIFY(YPACK_ISBA%XBLOCK_00)
- NULLIFY(YPACK_ISBA%XBLOCK_000)
- NULLIFY(YPACK_ISBA%XBLOCK_01)
- NULLIFY(YPACK_ISBA%XP_VEGTYPE_PATCH)
- NULLIFY(YPACK_ISBA%XP_SSO_SLOPE)
- NULLIFY(YPACK_ISBA%XP_LAT)
- NULLIFY(YPACK_ISBA%XP_LON)
- NULLIFY(YPACK_ISBA%XP_AOSIP)
- NULLIFY(YPACK_ISBA%XP_AOSIM)
- NULLIFY(YPACK_ISBA%XP_AOSJP)
- NULLIFY(YPACK_ISBA%XP_AOSJM)
- NULLIFY(YPACK_ISBA%XP_HO2IP)
- NULLIFY(YPACK_ISBA%XP_HO2IM)
- NULLIFY(YPACK_ISBA%XP_HO2JP)
- NULLIFY(YPACK_ISBA%XP_HO2JM)
- NULLIFY(YPACK_ISBA%XP_Z0EFFIP)
- NULLIFY(YPACK_ISBA%XP_Z0EFFIM)
- NULLIFY(YPACK_ISBA%XP_Z0EFFJP)
- NULLIFY(YPACK_ISBA%XP_Z0EFFJM)
- NULLIFY(YPACK_ISBA%XP_Z0REL)
- NULLIFY(YPACK_ISBA%XP_CLAY)
- NULLIFY(YPACK_ISBA%XP_SAND)
- NULLIFY(YPACK_ISBA%XP_ALBNIR_DRY)
- NULLIFY(YPACK_ISBA%XP_ALBVIS_DRY)
- NULLIFY(YPACK_ISBA%XP_ALBUV_DRY)
- NULLIFY(YPACK_ISBA%XP_ALBNIR_WET)
- NULLIFY(YPACK_ISBA%XP_ALBVIS_WET)
- NULLIFY(YPACK_ISBA%XP_ALBUV_WET)
- NULLIFY(YPACK_ISBA%XP_ALBNIR_SOIL)
- NULLIFY(YPACK_ISBA%XP_ALBVIS_SOIL)
- NULLIFY(YPACK_ISBA%XP_ALBUV_SOIL)
- NULLIFY(YPACK_ISBA%XP_Z0_O_Z0H)
- NULLIFY(YPACK_ISBA%XP_ALBNIR)
- NULLIFY(YPACK_ISBA%XP_ALBVIS)
- NULLIFY(YPACK_ISBA%XP_ALBUV)
- NULLIFY(YPACK_ISBA%XP_EMIS)
- NULLIFY(YPACK_ISBA%XP_Z0)
- NULLIFY(YPACK_ISBA%XP_ALBNIR_VEG)
- NULLIFY(YPACK_ISBA%XP_ALBVIS_VEG)
- NULLIFY(YPACK_ISBA%XP_ALBUV_VEG)
- NULLIFY(YPACK_ISBA%XP_VEG)
- NULLIFY(YPACK_ISBA%XP_WRMAX_CF)
- NULLIFY(YPACK_ISBA%XP_RSMIN)
- NULLIFY(YPACK_ISBA%XP_GAMMA)
- NULLIFY(YPACK_ISBA%XP_CV)
- NULLIFY(YPACK_ISBA%XP_RGL)
- NULLIFY(YPACK_ISBA%XP_ROOTFRAC)
- NULLIFY(YPACK_ISBA%XP_BSLAI)
- NULLIFY(YPACK_ISBA%XP_LAIMIN)
- NULLIFY(YPACK_ISBA%XP_SEFOLD)
- NULLIFY(YPACK_ISBA%XP_H_TREE)
- NULLIFY(YPACK_ISBA%XP_ANF)
- NULLIFY(YPACK_ISBA%XP_ANMAX)
- NULLIFY(YPACK_ISBA%XP_FZERO)
- NULLIFY(YPACK_ISBA%XP_EPSO)
- NULLIFY(YPACK_ISBA%XP_GAMM)
- NULLIFY(YPACK_ISBA%XP_QDGAMM)
- NULLIFY(YPACK_ISBA%XP_GMES)
- NULLIFY(YPACK_ISBA%XP_RE25)
- NULLIFY(YPACK_ISBA%XP_QDGMES)
- NULLIFY(YPACK_ISBA%XP_T1GMES)
- NULLIFY(YPACK_ISBA%XP_T2GMES)
- NULLIFY(YPACK_ISBA%XP_AMAX)
- NULLIFY(YPACK_ISBA%XP_QDAMAX)
- NULLIFY(YPACK_ISBA%XP_T1AMAX)
- NULLIFY(YPACK_ISBA%XP_T2AMAX)
- NULLIFY(YPACK_ISBA%LP_STRESS)
- NULLIFY(YPACK_ISBA%XP_F2I)
- NULLIFY(YPACK_ISBA%XP_GC)
- NULLIFY(YPACK_ISBA%XP_AH)
- NULLIFY(YPACK_ISBA%XP_BH)
- NULLIFY(YPACK_ISBA%XP_TAU_WOOD)
- NULLIFY(YPACK_ISBA%XP_DMAX)
- NULLIFY(YPACK_ISBA%XP_CE_NITRO)
- NULLIFY(YPACK_ISBA%XP_CF_NITRO)
- NULLIFY(YPACK_ISBA%XP_CNA_NITRO)
- NULLIFY(YPACK_ISBA%XP_BSLAI_NITRO)
- NULLIFY(YPACK_ISBA%XP_RUNOFFB)
- NULLIFY(YPACK_ISBA%XP_WDRAIN)
- NULLIFY(YPACK_ISBA%XP_TAUICE)
- NULLIFY(YPACK_ISBA%XP_GAMMAT)
- NULLIFY(YPACK_ISBA%XP_DG)
- NULLIFY(YPACK_ISBA%XP_DZG)
- NULLIFY(YPACK_ISBA%XP_DZDIF)
- NULLIFY(YPACK_ISBA%NK_WG_LAYER)
- NULLIFY(YPACK_ISBA%XP_RUNOFFD)
- NULLIFY(YPACK_ISBA%XP_SOILWGHT)
- NULLIFY(YPACK_ISBA%XP_C1SAT)
- NULLIFY(YPACK_ISBA%XP_C2REF)
- NULLIFY(YPACK_ISBA%XP_C3)
- NULLIFY(YPACK_ISBA%XP_C4B)
- NULLIFY(YPACK_ISBA%XP_C4REF)
- NULLIFY(YPACK_ISBA%XP_ACOEF)
- NULLIFY(YPACK_ISBA%XP_PCOEF)
- NULLIFY(YPACK_ISBA%XP_WFC)
- NULLIFY(YPACK_ISBA%XP_WWILT)
- NULLIFY(YPACK_ISBA%XP_WSAT)
- NULLIFY(YPACK_ISBA%XP_BCOEF)
- NULLIFY(YPACK_ISBA%XP_CONDSAT)
- NULLIFY(YPACK_ISBA%XP_MPOTSAT)
- NULLIFY(YPACK_ISBA%XP_CGSAT)
- NULLIFY(YPACK_ISBA%XP_HCAPSOIL)
- NULLIFY(YPACK_ISBA%XP_CONDDRY)
- NULLIFY(YPACK_ISBA%XP_CONDSLD)
- NULLIFY(YPACK_ISBA%XP_TDEEP)
- NULLIFY(YPACK_ISBA%XP_SNOWSWE)
- NULLIFY(YPACK_ISBA%XP_SNOWHEAT)
- NULLIFY(YPACK_ISBA%XP_SNOWRHO)
- NULLIFY(YPACK_ISBA%XP_SNOWGRAN1)
- NULLIFY(YPACK_ISBA%XP_SNOWGRAN2)
- NULLIFY(YPACK_ISBA%XP_SNOWHIST)
- NULLIFY(YPACK_ISBA%XP_SNOWAGE)
- NULLIFY(YPACK_ISBA%XP_SNOWALB)
- NULLIFY(YPACK_ISBA%XP_SNOWALBVIS)
- NULLIFY(YPACK_ISBA%XP_SNOWALBNIR)
- NULLIFY(YPACK_ISBA%XP_SNOWALBFIR)
- NULLIFY(YPACK_ISBA%XP_SNOWEMIS)
- NULLIFY(YPACK_ISBA%XP_ICE_STO)
- NULLIFY(YPACK_ISBA%XP_WR)
- NULLIFY(YPACK_ISBA%XP_TG)
- NULLIFY(YPACK_ISBA%XP_WG)
- NULLIFY(YPACK_ISBA%XP_WGI)
- NULLIFY(YPACK_ISBA%XP_RESA)
- NULLIFY(YPACK_ISBA%XP_WRL)
- NULLIFY(YPACK_ISBA%XP_WRLI)
- NULLIFY(YPACK_ISBA%XP_WRVN)
- NULLIFY(YPACK_ISBA%XP_TV)
- NULLIFY(YPACK_ISBA%XP_TL)
- NULLIFY(YPACK_ISBA%XP_TC)
- NULLIFY(YPACK_ISBA%XP_QC)
- NULLIFY(YPACK_ISBA%XP_RGLV)
- NULLIFY(YPACK_ISBA%XP_GAMMAV)
- NULLIFY(YPACK_ISBA%XP_RSMINV)
- NULLIFY(YPACK_ISBA%XP_ROOTFRACV)
- NULLIFY(YPACK_ISBA%XP_WRMAX_CFV)
- NULLIFY(YPACK_ISBA%XP_LAIV)
- NULLIFY(YPACK_ISBA%XP_Z0V)
- NULLIFY(YPACK_ISBA%XP_H_VEG)
- NULLIFY(YPACK_ISBA%XP_GNDLITTER)
- NULLIFY(YPACK_ISBA%XP_Z0LITTER)
- NULLIFY(YPACK_ISBA%XP_FWTD)
- NULLIFY(YPACK_ISBA%XP_WTD)
- NULLIFY(YPACK_ISBA%XP_LAI)
- NULLIFY(YPACK_ISBA%XP_AN)
- NULLIFY(YPACK_ISBA%XP_ANDAY)
- NULLIFY(YPACK_ISBA%XP_ANFM)
- NULLIFY(YPACK_ISBA%XP_LE)
- NULLIFY(YPACK_ISBA%XP_LEI)
- NULLIFY(YPACK_ISBA%XP_FAPARC)
- NULLIFY(YPACK_ISBA%XP_FAPIRC)
- NULLIFY(YPACK_ISBA%XP_LAI_EFFC)
- NULLIFY(YPACK_ISBA%XP_MUS)
- NULLIFY(YPACK_ISBA%XP_RESP_BIOMASS)
- NULLIFY(YPACK_ISBA%XP_BIOMASS)
- NULLIFY(YPACK_ISBA%XP_INCREASE)
- NULLIFY(YPACK_ISBA%XP_LITTER)
- NULLIFY(YPACK_ISBA%XP_SOILCARB)
- NULLIFY(YPACK_ISBA%XP_LIGNIN_STRUC)
- NULLIFY(YPACK_ISBA%XP_TURNOVER)
- NULLIFY(YPACK_ISBA%XP_LIRRIGATE)
- NULLIFY(YPACK_ISBA%XP_LIRRIDAY)
- NULLIFY(YPACK_ISBA%XP_THRESHOLD)
- NULLIFY(YPACK_ISBA%XP_WATSUP)
- NULLIFY(YPACK_ISBA%XP_IRRIG)
- NULLIFY(YPACK_ISBA%TP_SEED)
- NULLIFY(YPACK_ISBA%TP_REAP)
- NULLIFY(YPACK_ISBA%XP_D_ICE)
- NULLIFY(YPACK_ISBA%XP_KSAT_ICE)
- NULLIFY(YPACK_ISBA%XP_FSAT)
- NULLIFY(YPACK_ISBA%XP_MUF)
- NULLIFY(YPACK_ISBA%XP_TOPQS)
- NULLIFY(YPACK_ISBA%XP_PSN)
- NULLIFY(YPACK_ISBA%XP_PSNG)
- NULLIFY(YPACK_ISBA%XP_PSNV)
- NULLIFY(YPACK_ISBA%XP_PSNV_A)
- NULLIFY(YPACK_ISBA%XP_DIR_ALB_WITH_SNOW)
- NULLIFY(YPACK_ISBA%XP_SCA_ALB_WITH_SNOW)
- NULLIFY(YPACK_ISBA%XP_ALBF)
- NULLIFY(YPACK_ISBA%XP_EMISF)
- NULLIFY(YPACK_ISBA%XP_FF)
- NULLIFY(YPACK_ISBA%XP_FFG)
- NULLIFY(YPACK_ISBA%XP_FFV)
- NULLIFY(YPACK_ISBA%XP_FFROZEN)
- NULLIFY(YPACK_ISBA%XP_FFLOOD)
- NULLIFY(YPACK_ISBA%XP_PIFLOOD)
- NULLIFY(YPACK_ISBA%XP_CPS)
- NULLIFY(YPACK_ISBA%XP_LVTT)
- NULLIFY(YPACK_ISBA%XP_LSTT)
-IF (LHOOK) CALL DR_HOOK("MODD_PACK_ISBA_N:PACK_ISBA_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE PACK_ISBA_INIT
-
-
-END MODULE MODD_PACK_ISBA
diff --git a/src/SURFEX/modd_pgdwork.F90 b/src/SURFEX/modd_pgdwork.F90
index 8957cf84f14f1d062885f29f4eb08f86bebdaf54..c6ad6f7dd6bbe37d02140d829fa8187369e99f27 100644
--- a/src/SURFEX/modd_pgdwork.F90
+++ b/src/SURFEX/modd_pgdwork.F90
@@ -38,20 +38,31 @@
!
IMPLICIT NONE
!
+! to get same results in parallel mode (if results differ, change XPREC to a
+! lower value)
+REAL, PARAMETER :: XPREC = 1.0E+8
+!
!* 0.1 summation variables
! -------------------
!
-REAL, DIMENSION(:), ALLOCATABLE :: XSUMVAL
+REAL, DIMENSION(:,:), ALLOCATABLE :: XSUMVAL
! Sum of data in each mesh
-REAL, DIMENSION(:), ALLOCATABLE :: XSUMVAL2
- ! Sum of square data in each mesh
-REAL, DIMENSION(:), ALLOCATABLE :: XSUMVAL3
- ! Sum of cube data in each mesh
-REAL, DIMENSION(:,:), ALLOCATABLE :: XSUMCOVER
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: XEXT_ALL
+ ! Sum of square data in each mesh
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XALL
+ ! Sum of each cover type data in each mesh
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XSSO_ALL
! Sum of each cover type data in each mesh
-REAL, DIMENSION(:,:), ALLOCATABLE :: XTNG
- ! for flake
-INTEGER, DIMENSION(:), ALLOCATABLE:: NSIZE
+!
+INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: NSSO_ALL
+ ! Sum of each cover type data in each mesh
+!
+INTEGER, DIMENSION(:,:), ALLOCATABLE:: NSIZE
+! ! Number of points inside each mesh of the domain
+INTEGER, DIMENSION(:,:), ALLOCATABLE:: NSIZE_ALL
! ! Number of points inside each mesh of the domain
!
CHARACTER(LEN=3) :: CATYPE = 'ARI'
@@ -89,13 +100,13 @@ REAL, DIMENSION(:), ALLOCATABLE :: XSKEW_WORK
!
INTEGER, PARAMETER :: JPVALMAX=20 ! Maximum number of different values
! ! in each grid mesh
-INTEGER, DIMENSION(:), ALLOCATABLE :: NVALNBR
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: NVALNBR
! ! number of different values
! ! in each grid mesh
-INTEGER, DIMENSION(:,:), ALLOCATABLE :: NVALCOUNT
+INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: NVALCOUNT
! ! Number of times each value has been
! ! counted in each grid mesh
-REAL, DIMENSION(:,:), ALLOCATABLE :: XVALLIST
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XVALLIST
! ! List of Values encountered in each grid mesh
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/modd_prep.F90 b/src/SURFEX/modd_prep.F90
index 8f0a844e1a8f11ebe48e6e7a1d0074ea86905bf6..b69cf3e35f32f2d9b52057b74d7adcc68f818228 100644
--- a/src/SURFEX/modd_prep.F90
+++ b/src/SURFEX/modd_prep.F90
@@ -36,9 +36,9 @@ IMPLICIT NONE
!
!--------------------------------------------------------------------------
!
- CHARACTER(LEN=10) :: CINGRID_TYPE ! type of input grid
- CHARACTER(LEN=6) :: CINTERP_TYPE ! type of interpolation
- CHARACTER(LEN=6) :: CMASK ! type of surface
+ CHARACTER(LEN=10) :: CINGRID_TYPE = " " ! type of input grid
+ CHARACTER(LEN=6) :: CINTERP_TYPE = " " ! type of interpolation
+ CHARACTER(LEN=6) :: CMASK = " " ! type of surface
!
LOGICAL, DIMENSION(:), ALLOCATABLE :: LINTERP ! .true. where interpolation must be done
!
diff --git a/src/SURFEX/modd_reprod_oper.F90 b/src/SURFEX/modd_reprod_oper.F90
index f52f58d9beb63bd19c7d15c9defc0d952279f4aa..12641bf36b0141b2135868d35b30b32b4655927b 100644
--- a/src/SURFEX/modd_reprod_oper.F90
+++ b/src/SURFEX/modd_reprod_oper.F90
@@ -56,30 +56,30 @@ REAL :: XEVERG_VEG
!CDGAVG : old = 'ARI' Arithmetic average for all depths
! recommended = 'INV' Harmonic average for all depths
!
- CHARACTER(LEN=3) :: CDGAVG
+CHARACTER(LEN=3) :: CDGAVG
!
! * Soil depth with ISBA-DF
!
!CDGDIF : old = 'SOIL' Total soil depth (d3) in Ecoclimap
! recommended = 'ROOT' Root depth (d2) in Ecoclimap
!
- CHARACTER(LEN=4) :: CDGDIF
+CHARACTER(LEN=4) :: CDGDIF
!
! * wind implicitation
!
- CHARACTER(LEN=3) :: CIMPLICIT_WIND ! wind implicitation option
+CHARACTER(LEN=3) :: CIMPLICIT_WIND ! wind implicitation option
! ! 'OLD' = direct
! ! 'NEW' = Taylor serie, order 1 (recommended)
!
! * qsat computation
!
- CHARACTER(LEN=3) :: CQSAT ! qsat computation option
+CHARACTER(LEN=3) :: CQSAT ! qsat computation option
! ! 'OLD' = do not depend on temperature
! ! 'NEW' = qsat and qsati merged (recommended)
!
! * Charnock parameter
!
- CHARACTER(LEN=3) :: CCHARNOCK ! Charnock parameter option
+CHARACTER(LEN=3) :: CCHARNOCK ! Charnock parameter option
! ! 'OLD' = constant equal to XVCHRNK
! ! 'NEW' = vary between 0.011 et 0.018 according
! ! to Chris Fairall's data as in coare3.0
diff --git a/src/SURFEX/modd_seaflux_gridn.F90 b/src/SURFEX/modd_seaflux_gridn.F90
deleted file mode 100644
index e9f0f17aa8504aaf75f14e43de10d4e9a74de1d7..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_seaflux_gridn.F90
+++ /dev/null
@@ -1,88 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ##################
- MODULE MODD_SEAFLUX_GRID_n
-! ##################
-!
-!!**** *MODD_SEAFLUX_GRID - declaration of SEAFLUX grid
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE SEAFLUX_GRID_t
-!-------------------------------------------------------------------------------
-!
-! Grid definition
-!
- INTEGER :: NDIM ! number of points
- CHARACTER(LEN=10) :: CGRID ! grid type
-! ! "NONE " : no grid computations
-! ! "CONF PROJ " : conformal projection
-! ! "SURF ATM " : SEA points of surf. atm. grid
-!
- REAL, POINTER, DIMENSION(:) :: XGRID_PAR ! lits of parameters used to define the grid
-! ! (depends on value of CGRID)
-!
-!-------------------------------------------------------------------------------
-!
-! General surface parameters:
-!
- REAL, POINTER, DIMENSION(:) :: XLAT ! latitude (degrees +North) (-)
- REAL, POINTER, DIMENSION(:) :: XLON ! longitude (degrees +East) (-)
- REAL, POINTER, DIMENSION(:) :: XMESH_SIZE ! mesh size (m2)
-!-------------------------------------------------------------------------------
-!
-
-END TYPE SEAFLUX_GRID_t
-
-
-
- CONTAINS
-
-!
-
-
-
-
-SUBROUTINE SEAFLUX_GRID_INIT(YSEAFLUX_GRID)
-TYPE(SEAFLUX_GRID_t), INTENT(INOUT) :: YSEAFLUX_GRID
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_SEAFLUX_GRID_N:SEAFLUX_GRID_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YSEAFLUX_GRID%XGRID_PAR)
- NULLIFY(YSEAFLUX_GRID%XLAT)
- NULLIFY(YSEAFLUX_GRID%XLON)
- NULLIFY(YSEAFLUX_GRID%XMESH_SIZE)
-YSEAFLUX_GRID%NDIM=0
-YSEAFLUX_GRID%CGRID=' '
-IF (LHOOK) CALL DR_HOOK("MODD_SEAFLUX_GRID_N:SEAFLUX_GRID_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE SEAFLUX_GRID_INIT
-
-
-END MODULE MODD_SEAFLUX_GRID_n
diff --git a/src/SURFEX/modd_seaflux_sbln.F90 b/src/SURFEX/modd_seaflux_sbln.F90
deleted file mode 100644
index d12a4e1d42c1a600ec1a47055e8646e306dd8b81..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_seaflux_sbln.F90
+++ /dev/null
@@ -1,85 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ################
- MODULE MODD_SEAFLUX_SBL_n
-! ################
-!
-!!**** *MODD_SEAFLUX_SBL_n - declaration of surface parameters for SBL scheme
-!!
-!! PURPOSE
-!! -------
-! Declaration of surface parameters
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/2006
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE SEAFLUX_SBL_t
-!
- INTEGER :: NLVL ! number of levels in SBL
- REAL, POINTER, DIMENSION(:,:) :: XZ ! height of middle of each level grid (m)
- REAL, POINTER, DIMENSION(:,:) :: XU ! wind at each level in SBL (m/s)
- REAL, POINTER, DIMENSION(:,:) :: XT ! temperature at each level in SBL (m/s)
- REAL, POINTER, DIMENSION(:,:) :: XQ ! humidity at each level in SBL (kg/m3)
- REAL, POINTER, DIMENSION(:,:) :: XTKE ! Tke at each level in SBL (m2/s2)
- REAL, POINTER, DIMENSION(:) :: XLMO ! Monin-Obhukov length (m)
- REAL, POINTER, DIMENSION(:,:) :: XP ! pressure at each level in SBL (kg/m3)
-!
- REAL, POINTER, DIMENSION(:,:) :: XDZ ! depth of each level in SBL (m)
- REAL, POINTER, DIMENSION(:,:) :: XZF ! height of bottom of each level grid (m)
- REAL, POINTER, DIMENSION(:,:) :: XDZF ! depth between each level in SBL (m)
-!
-END TYPE SEAFLUX_SBL_t
-
-
-
- CONTAINS
-
-!
-
-
-
-
-SUBROUTINE SEAFLUX_SBL_INIT(YSEAFLUX_SBL)
-TYPE(SEAFLUX_SBL_t), INTENT(INOUT) :: YSEAFLUX_SBL
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_SEAFLUX_SBL_N:SEAFLUX_SBL_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YSEAFLUX_SBL%XZ)
- NULLIFY(YSEAFLUX_SBL%XU)
- NULLIFY(YSEAFLUX_SBL%XT)
- NULLIFY(YSEAFLUX_SBL%XQ)
- NULLIFY(YSEAFLUX_SBL%XTKE)
- NULLIFY(YSEAFLUX_SBL%XLMO)
- NULLIFY(YSEAFLUX_SBL%XP)
- NULLIFY(YSEAFLUX_SBL%XDZ)
- NULLIFY(YSEAFLUX_SBL%XZF)
- NULLIFY(YSEAFLUX_SBL%XDZF)
-YSEAFLUX_SBL%NLVL=0
-IF (LHOOK) CALL DR_HOOK("MODD_SEAFLUX_SBL_N:SEAFLUX_SBL_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE SEAFLUX_SBL_INIT
-
-
-END MODULE MODD_SEAFLUX_SBL_n
diff --git a/src/SURFEX/modd_seafluxn.F90 b/src/SURFEX/modd_seafluxn.F90
index 2e43a07377eca3520d3368bd48c2857f29d9e88d..14b77ef10899d55a5a92071b414b49948773a051 100644
--- a/src/SURFEX/modd_seafluxn.F90
+++ b/src/SURFEX/modd_seafluxn.F90
@@ -150,7 +150,7 @@ END TYPE SEAFLUX_t
- CONTAINS
+CONTAINS
!
diff --git a/src/SURFEX/modd_isba_gridn.F90 b/src/SURFEX/modd_sfx_gridn.F90
similarity index 64%
rename from src/SURFEX/modd_isba_gridn.F90
rename to src/SURFEX/modd_sfx_gridn.F90
index d569619741809ab8a34c85ae59ee1290f6fcc0f2..70db93008889791a21dd8af46fa94b8391d2875f 100644
--- a/src/SURFEX/modd_isba_gridn.F90
+++ b/src/SURFEX/modd_sfx_gridn.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ##################
- MODULE MODD_ISBA_GRID_n
+ MODULE MODD_SFX_GRID_n
! ##################
!
!!**** *MODD_ISBA - declaration of grid for ISBA scheme
@@ -36,7 +36,7 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
-TYPE ISBA_GRID_t
+TYPE GRID_t
!-------------------------------------------------------------------------------
!
! Grid definition
@@ -47,6 +47,7 @@ TYPE ISBA_GRID_t
! ! "CONF PROJ " : conformal projection
! ! "SURF ATM " : nature points of surf. atm. grid
!
+ INTEGER :: NGRID_PAR ! size of XGRID_PAR
REAL, POINTER, DIMENSION(:) :: XGRID_PAR ! lits of parameters used to define the grid
! ! (depends on value of CGRID)
!
@@ -59,30 +60,49 @@ TYPE ISBA_GRID_t
REAL, POINTER, DIMENSION(:) :: XMESH_SIZE ! mesh size (m2)
!-------------------------------------------------------------------------------
!
-
-END TYPE ISBA_GRID_t
-
-
-
- CONTAINS
-
+END TYPE GRID_t
!
-
-
-
-
-SUBROUTINE ISBA_GRID_INIT(YISBA_GRID)
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: YISBA_GRID
+TYPE GRID_NP_t
+!
+TYPE(GRID_t), DIMENSION(:), POINTER :: AL=>NULL()
+!
+END TYPE GRID_NP_t
+!
+CONTAINS
+!
+SUBROUTINE GRID_INIT(G)
+TYPE(GRID_t), INTENT(INOUT) :: G
REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_ISBA_GRID_N:ISBA_GRID_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YISBA_GRID%XGRID_PAR)
- NULLIFY(YISBA_GRID%XLAT)
- NULLIFY(YISBA_GRID%XLON)
- NULLIFY(YISBA_GRID%XMESH_SIZE)
-YISBA_GRID%NDIM=0
-YISBA_GRID%CGRID=' '
-IF (LHOOK) CALL DR_HOOK("MODD_ISBA_GRID_N:ISBA_GRID_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE ISBA_GRID_INIT
-
+IF (LHOOK) CALL DR_HOOK("MODD_SFX_GRID_N:IGRID_INIT",0,ZHOOK_HANDLE)
+ NULLIFY(G%XGRID_PAR)
+ NULLIFY(G%XLAT)
+ NULLIFY(G%XLON)
+ NULLIFY(G%XMESH_SIZE)
+G%NDIM=0
+G%CGRID=' '
+IF (LHOOK) CALL DR_HOOK("MODD_SFX_GRID_N:GRID_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE GRID_INIT
+!
+SUBROUTINE GRID_NP_INIT(GP,KPATCH)
+TYPE(GRID_NP_t), INTENT(INOUT) :: GP
+INTEGER, INTENT(IN) :: KPATCH
+INTEGER :: JP
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_SFX_GRID_N:GRID_NP_INIT",0,ZHOOK_HANDLE)
-END MODULE MODD_ISBA_GRID_n
+IF (ASSOCIATED(GP%AL)) THEN
+ DO JP=1,KPATCH
+ CALL GRID_INIT(GP%AL(JP))
+ ENDDO
+ DEALLOCATE(GP%AL)
+ELSE
+ ALLOCATE(GP%AL(KPATCH))
+ DO JP=1,KPATCH
+ CALL GRID_INIT(GP%AL(JP))
+ ENDDO
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK("MODD_SFX_GRID_N:GRID_NP_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE GRID_NP_INIT
+!
+END MODULE MODD_SFX_GRID_n
diff --git a/src/SURFEX/modd_sfx_oasis.F90 b/src/SURFEX/modd_sfx_oasis.F90
index 58248bb7e0d5a05ce53013e0f4ea178118068a84..89807f8ea16933996ae8c6eca610a5e442b7fdd8 100644
--- a/src/SURFEX/modd_sfx_oasis.F90
+++ b/src/SURFEX/modd_sfx_oasis.F90
@@ -26,6 +26,8 @@ MODULE MODD_SFX_OASIS
!! MODIFICATIONS
!! -------------
!! Original 10/13
+!! S.Senesi 08/2015 : add CMODEL_NAME
+!! 10/2016 B. Decharme : bug surface/groundwater coupling
!
!* 0. DECLARATIONS
! ------------
@@ -40,6 +42,9 @@ IMPLICIT NONE
!
LOGICAL :: LOASIS = .FALSE. ! To use oasis coupler or not
!
+CHARACTER(LEN=6) :: CMODEL_NAME ! component model name (i.e. name under which
+! ! Surfex is declared to Oasis)
+!
REAL :: XRUNTIME = 0.0 ! Total simulated time in oasis namcouple (s)
!
!-------------------------------------------------------------------------------
@@ -58,7 +63,6 @@ LOGICAL :: LCPL_FLOOD = .FALSE. ! Fields to/from surfex land area
INTEGER :: NRUNOFF_ID ! Surface runoff id
INTEGER :: NDRAIN_ID ! Drainage id
INTEGER :: NCALVING_ID ! Calving flux id
-INTEGER :: NRECHARGE_ID ! Groundwater recharge id
INTEGER :: NSRCFLOOD_ID ! Floodplains freshwater flux id
!
! Input variables
diff --git a/src/SURFEX/modd_sltn.F90 b/src/SURFEX/modd_sltn.F90
index 67293e59a79874f18ad5e12c0318bdd15c554bca..84a48d74c4c7c20da51619e79970ec1ebc6e72ad 100644
--- a/src/SURFEX/modd_sltn.F90
+++ b/src/SURFEX/modd_sltn.F90
@@ -14,31 +14,21 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
-
+!
TYPE SLT_t
- REAL, DIMENSION(:,:,:),POINTER :: XSFSLT ! Sea Salt variables to be send to output
REAL,DIMENSION(:), POINTER :: XEMISRADIUS_SLT ! Number median radius for each source mode
REAL,DIMENSION(:), POINTER :: XEMISSIG_SLT ! sigma for each source mode
END TYPE SLT_t
-
-
-
- CONTAINS
-
!
-
-
-
-
+CONTAINS
+!
SUBROUTINE SLT_INIT(YSLT)
TYPE(SLT_t), INTENT(INOUT) :: YSLT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK("MODD_SLT_N:SLT_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YSLT%XSFSLT)
NULLIFY(YSLT%XEMISRADIUS_SLT)
NULLIFY(YSLT%XEMISSIG_SLT)
IF (LHOOK) CALL DR_HOOK("MODD_SLT_N:SLT_INIT",1,ZHOOK_HANDLE)
END SUBROUTINE SLT_INIT
-
-
+!
END MODULE MODD_SLT_n
diff --git a/src/SURFEX/modd_snow_par.F90 b/src/SURFEX/modd_snow_par.F90
index 688c616fcad1dd49269cbc361053231a645dedd3..c19e6ccde0c2a5584badd6730935c376d1e58039 100644
--- a/src/SURFEX/modd_snow_par.F90
+++ b/src/SURFEX/modd_snow_par.F90
@@ -346,6 +346,59 @@ REAL, PARAMETER :: XSNOWTRANS5 = 1.4493 ! (m)
!
!------------------------------------------------------------------------------
!
+!Parameters for MEPRA grain type
+INTEGER, PARAMETER :: IFR = 0
+INTEGER, PARAMETER :: IFR_LB = 1
+INTEGER, PARAMETER :: ILB = 2
+INTEGER, PARAMETER :: ILB_FIN = 3
+INTEGER, PARAMETER :: ILB_ANG = 4
+INTEGER, PARAMETER :: IROUL = 5
+INTEGER, PARAMETER :: IFIN = 6
+INTEGER, PARAMETER :: IFIN_AR = 7
+INTEGER, PARAMETER :: IFIN_ANG = 8
+INTEGER, PARAMETER :: IPL = 9
+INTEGER, PARAMETER :: IPL_GOB = 10
+INTEGER, PARAMETER :: IGOB = 11
+INTEGER, PARAMETER :: IGEL = 12
+INTEGER, PARAMETER :: IGOB_FON = 13
+INTEGER, PARAMETER :: IRON_ANG = 14
+!
+!------------------------------------------------------------------------------
+!
+! array which describes dendritic grain as a function of dendricity and sphericity
+! these 2 variables are discretised in an 10*10 array ( between 0 and 1 by 0.1 step)
+INTEGER,DIMENSION(100),PARAMETER :: ICRIS_DEND1D=(/&
+ ILB_ANG,ILB_ANG,ILB_ANG,ILB,ILB,ILB,IFR_LB,IFR_LB,IFR,IFR,&
+ ILB_ANG,ILB_ANG,ILB_ANG,ILB,ILB,ILB,IFR_LB,IFR_LB,IFR,IFR,&
+ ILB_ANG,ILB_ANG,ILB_ANG,ILB,ILB,ILB,IFR_LB,IFR_LB,IFR,IFR,&
+ ILB_ANG,ILB_ANG,ILB_ANG,ILB,ILB,ILB,IFR_LB,IFR_LB,IFR,IFR,&
+ ILB_ANG,ILB_ANG,ILB_ANG,ILB,ILB,ILB,IFR_LB,IFR_LB,IFR,IFR,&
+ ILB_FIN,ILB_FIN,ILB_FIN,ILB,ILB,ILB,IFR_LB,IFR_LB,IFR,IFR,&
+ ILB_FIN,ILB_FIN,ILB_FIN,ILB,ILB,ILB,IFR_LB,IFR_LB,IFR,IFR,&
+ ILB_FIN,ILB_FIN,ILB_FIN,ILB,ILB,ILB,IFR_LB,IFR_LB,IFR,IFR,&
+ ILB_FIN,ILB_FIN,ILB_FIN,ILB,ILB,ILB,IFR_LB,IFR_LB,IFR,IFR,&
+ ILB_FIN,ILB_FIN,ILB_FIN,ILB,ILB,ILB,IFR_LB,IFR_LB,IFR,IFR/)
+
+INTEGER,DIMENSION(180),PARAMETER :: ICRIS_NONDEND1D=(/&
+ IPL,IPL,IFIN_ANG,IFIN_ANG,IFIN_ANG,IFIN_ANG,IFIN_ANG,IFIN_ANG,IFIN,IFIN,&
+ IPL,IPL,IFIN_ANG,IFIN_ANG,IFIN_ANG,IFIN_ANG,IFIN_ANG,IFIN_ANG,IFIN,IFIN,&
+ IPL,IPL,IFIN_ANG,IFIN_ANG,IFIN_ANG,IFIN_ANG,IFIN_ANG,IFIN_ANG,IFIN,IFIN,&
+ IPL,IPL,IFIN_ANG,IFIN_ANG,IFIN_ANG,IFIN_ANG,IFIN_ANG,IFIN_ANG,IFIN,IFIN,&
+ IPL_GOB,IPL_GOB,IPL_GOB,IPL_GOB,IPL_GOB,IGOB_FON,IGOB_FON,IGOB_FON,IGOB_FON,IGOB_FON,&
+ IGOB,IGOB,IGOB,IGOB,IGOB,IGOB_FON,IGOB_FON,IGOB_FON,IGOB_FON,IGOB_FON,&
+ IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IFIN_AR,IFIN_AR,IFIN_AR,IFIN_AR,IFIN_AR,&
+ IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IGEL,IGEL,IGEL,IGEL,IGEL,&
+ IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IGEL,IGEL,IGEL,IGEL,IGEL,&
+ IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IGOB_FON,IGOB_FON,IGOB_FON,IGOB_FON,IGOB_FON,&
+ IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IGOB_FON,IGOB_FON,IGOB_FON,IGOB_FON,IGOB_FON,&
+ IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IGOB_FON,IGOB_FON,IGOB_FON,IGOB_FON,IGOB_FON,&
+ IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IFIN_AR,IFIN_AR,IFIN_AR,IFIN_AR,IFIN_AR,&
+ IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IGEL,IGEL,IGEL,IGEL,IGEL,&
+ IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IGEL,IGEL,IGEL,IGEL,IGEL,&
+ IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IGOB_FON,IGOB_FON,IGOB_FON,IGOB_FON,IGOB_FON,&
+ IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IGOB_FON,IGOB_FON,IGOB_FON,IGOB_FON,IGOB_FON,&
+ IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IRON_ANG,IGOB_FON,IGOB_FON,IGOB_FON,IGOB_FON,IGOB_FON/)
+!
END MODULE MODD_SNOW_PAR
diff --git a/src/SURFEX/modd_sso_canopyn.F90 b/src/SURFEX/modd_sso_canopyn.F90
deleted file mode 100644
index 103e74e6fcb550db5c9d9fdb8b4eda0d06cf834d..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_sso_canopyn.F90
+++ /dev/null
@@ -1,80 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ################
- MODULE MODD_SSO_CANOPY_n
-! ################
-!
-!!**** *MODD_SSO_CANOPY_n - declaration of surface parameters for
-! orographic canopy
-!!
-!! PURPOSE
-!! -------
-! Declaration of surface parameters
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/2006
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE SSO_CANOPY_t
-!
-INTEGER :: NLVL ! number of levels in canopy
-REAL, POINTER, DIMENSION(:,:) :: XZ ! height of middle of each level grid (m)
-REAL, POINTER, DIMENSION(:,:) :: XU ! wind at each level in canopy (m/s)
-REAL, POINTER, DIMENSION(:,:) :: XTKE ! Tke at each level in canopy (m2/s2)
-!
-REAL, POINTER, DIMENSION(:,:) :: XDZ ! depth of each level in canopy (m)
-REAL, POINTER, DIMENSION(:,:) :: XZF ! height of bottom of each level grid (m)
-
-REAL, POINTER, DIMENSION(:,:) :: XDZF ! depth between each level in canopy (m)
-!
-END TYPE SSO_CANOPY_t
-
-
-
- CONTAINS
-
-!
-
-
-
-
-
-SUBROUTINE SSO_CANOPY_INIT(YSSO_CANOPY)
-TYPE(SSO_CANOPY_t), INTENT(INOUT) :: YSSO_CANOPY
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_SSO_CANOPY_N:SSO_CANOPY_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YSSO_CANOPY%XZ)
- NULLIFY(YSSO_CANOPY%XU)
- NULLIFY(YSSO_CANOPY%XTKE)
- NULLIFY(YSSO_CANOPY%XDZ)
- NULLIFY(YSSO_CANOPY%XZF)
- NULLIFY(YSSO_CANOPY%XDZF)
-YSSO_CANOPY%NLVL=0
-IF (LHOOK) CALL DR_HOOK("MODD_SSO_CANOPY_N:SSO_CANOPY_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE SSO_CANOPY_INIT
-
-
-
-END MODULE MODD_SSO_CANOPY_n
diff --git a/src/SURFEX/modd_surf_atm_sson.F90 b/src/SURFEX/modd_sson.F90
similarity index 60%
rename from src/SURFEX/modd_surf_atm_sson.F90
rename to src/SURFEX/modd_sson.F90
index ed72a8b614bb874c7d885cb26fca791f507a974f..d7b7dda478b9ad6ea07605327727e0e86dd08b0a 100644
--- a/src/SURFEX/modd_surf_atm_sson.F90
+++ b/src/SURFEX/modd_sson.F90
@@ -3,10 +3,10 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ####################
- MODULE MODD_SURF_ATM_SSO_n
+ MODULE MODD_SSO_n
! ######################
!
-!!**** *MODD_SURF_ATM_SSO - declaration of surface parameters related to orography
+!!**** *MODD_SSO - declaration of surface parameters related to orography
!!
!! PURPOSE
!! -------
@@ -36,8 +36,9 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
-
-TYPE SURF_ATM_SSO_t
+!
+! utilisé uniquement tel quel.
+TYPE SSO_t
!
!-----------------------------------------------------------------------------------------------------
!
@@ -48,89 +49,110 @@ TYPE SURF_ATM_SSO_t
! 'Z01D'
! 'Z04D'
! 'BE04'
-
+!
+ REAL, DIMENSION(:), POINTER :: XZ0EFFJPDIR ! heading of J direction (deg from N clockwise)
+!
+ REAL, DIMENSION(:), POINTER :: XSSO_SLOPE ! slope of S.S.O.
+ REAL, DIMENSION(:), POINTER :: XSSO_ANIS ! anisotropy of S.S.O.
+ REAL, DIMENSION(:), POINTER :: XSSO_DIR ! direction of S.S.O. (deg from N clockwise)
+ REAL, DIMENSION(:), POINTER :: XSSO_STDEV ! S.S.O. standard deviation (m)
+!
+ REAL, DIMENSION(:), POINTER :: XAVG_ZS ! averaged orography (m)
+ REAL, DIMENSION(:), POINTER :: XSIL_ZS ! silhouette orography (m)
+ REAL, DIMENSION(:), POINTER :: XMAX_ZS ! maximum subgrid orography (m)
+ REAL, DIMENSION(:), POINTER :: XMIN_ZS ! minimum subgrid orography (m)
+! Zo threshold
+ REAL :: XFRACZ0 ! Z0=Min(Z0, Href/XFRACZ0)
+ REAL :: XCOEFBE ! Beljaars coefficient
+!
!-----------------------------------------------------------------------------------------------------
!
! Subgrid orography parameters
!
- REAL, DIMENSION(:), POINTER :: XAOSIP,XAOSIM,XAOSJP,XAOSJM
+ REAL, DIMENSION(:), POINTER :: XAOSIP, XAOSIM, XAOSJP, XAOSJM
! directional A/S quantities in 4 coordinate directions
! (IP: i index up; IM: i index down; JP: j index up; JM: j index down)
! They are used in soil routines to compute effective roughness length
!
- REAL, DIMENSION(:), POINTER :: XHO2IP,XHO2IM,XHO2JP,XHO2JM
+ REAL, DIMENSION(:), POINTER :: XHO2IP, XHO2IM, XHO2JP, XHO2JM
! directional h/2 quantities in 4 coordinate directions
! (IP: i index up; IM: i index down; JP: j index up; JM: j index down)
! They are used in soil routines to compute effective roughness length
!
- REAL, DIMENSION(:), POINTER :: XZ0EFFIP,XZ0EFFIM,XZ0EFFJP,XZ0EFFJM
+ REAL, DIMENSION(:), POINTER :: XZ0REL ! relief roughness length (m)
+!
+! utilisé par l'atmosphère
+!
+ REAL, DIMENSION(:), POINTER :: XZ0EFFIP, XZ0EFFIM, XZ0EFFJP, XZ0EFFJM
! directional total roughness lenghts in 4 coordinate directions
! (IP: i index up; IM: i index down; JP: j index up; JM: j index down)
!
- REAL, DIMENSION(:), POINTER :: XZ0EFFJPDIR ! heading of J direction (deg from N clockwise)
-
- REAL, DIMENSION(:), POINTER :: XZ0REL ! relief roughness length (m)
+END TYPE SSO_t
!
- REAL, DIMENSION(:), POINTER :: XSSO_SLOPE ! slope of S.S.O.
- REAL, DIMENSION(:), POINTER :: XSSO_ANIS ! anisotropy of S.S.O.
- REAL, DIMENSION(:), POINTER :: XSSO_DIR ! direction of S.S.O. (deg from N clockwise)
- REAL, DIMENSION(:), POINTER :: XSSO_STDEV ! S.S.O. standard deviation (m)
+! utilisé par isba
!
+TYPE SSO_NP_t
!
- REAL, DIMENSION(:), POINTER :: XAVG_ZS ! averaged orography (m)
- REAL, DIMENSION(:), POINTER :: XSIL_ZS ! silhouette orography (m)
- REAL, DIMENSION(:), POINTER :: XMAX_ZS ! maximum subgrid orography (m)
- REAL, DIMENSION(:), POINTER :: XMIN_ZS ! minimum subgrid orography (m)
-! Zo threshold
- REAL :: XFRACZ0 ! Z0=Min(Z0, Href/XFRACZ0)
- REAL :: XCOEFBE ! Beljaars coefficient
-!-----------------------------------------------------------------------------------------------------
+TYPE(SSO_t), DIMENSION(:), POINTER :: AL=>NULL()
!
+END TYPE SSO_NP_t
!
-
-
-END TYPE SURF_ATM_SSO_t
-
-
-
- CONTAINS
-
+CONTAINS
!
-
-
-
-
-SUBROUTINE SURF_ATM_SSO_INIT(YSURF_ATM_SSO)
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: YSURF_ATM_SSO
+SUBROUTINE SSO_INIT(YSSO)
+TYPE(SSO_t), INTENT(INOUT) :: YSSO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_SURF_ATM_SSO_N:SURF_ATM_SSO_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YSURF_ATM_SSO%XAOSIP)
- NULLIFY(YSURF_ATM_SSO%XAOSIM)
- NULLIFY(YSURF_ATM_SSO%XAOSJP)
- NULLIFY(YSURF_ATM_SSO%XAOSJM)
- NULLIFY(YSURF_ATM_SSO%XHO2IP)
- NULLIFY(YSURF_ATM_SSO%XHO2IM)
- NULLIFY(YSURF_ATM_SSO%XHO2JP)
- NULLIFY(YSURF_ATM_SSO%XHO2JM)
- NULLIFY(YSURF_ATM_SSO%XZ0EFFIP)
- NULLIFY(YSURF_ATM_SSO%XZ0EFFIM)
- NULLIFY(YSURF_ATM_SSO%XZ0EFFJP)
- NULLIFY(YSURF_ATM_SSO%XZ0EFFJM)
- NULLIFY(YSURF_ATM_SSO%XZ0EFFJPDIR)
- NULLIFY(YSURF_ATM_SSO%XZ0REL)
- NULLIFY(YSURF_ATM_SSO%XSSO_SLOPE)
- NULLIFY(YSURF_ATM_SSO%XSSO_ANIS)
- NULLIFY(YSURF_ATM_SSO%XSSO_DIR)
- NULLIFY(YSURF_ATM_SSO%XSSO_STDEV)
- NULLIFY(YSURF_ATM_SSO%XAVG_ZS)
- NULLIFY(YSURF_ATM_SSO%XSIL_ZS)
- NULLIFY(YSURF_ATM_SSO%XMAX_ZS)
- NULLIFY(YSURF_ATM_SSO%XMIN_ZS)
-YSURF_ATM_SSO%CROUGH=' '
-YSURF_ATM_SSO%XFRACZ0=2.
-YSURF_ATM_SSO%XCOEFBE=2.
-IF (LHOOK) CALL DR_HOOK("MODD_SURF_ATM_SSO_N:SURF_ATM_SSO_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE SURF_ATM_SSO_INIT
+IF (LHOOK) CALL DR_HOOK("MODD_SSO_N:SSO_INIT",0,ZHOOK_HANDLE)
+ NULLIFY(YSSO%XZ0EFFJPDIR)
+ NULLIFY(YSSO%XSSO_SLOPE)
+ NULLIFY(YSSO%XSSO_ANIS)
+ NULLIFY(YSSO%XSSO_DIR)
+ NULLIFY(YSSO%XSSO_STDEV)
+ NULLIFY(YSSO%XAVG_ZS)
+ NULLIFY(YSSO%XSIL_ZS)
+ NULLIFY(YSSO%XMAX_ZS)
+ NULLIFY(YSSO%XMIN_ZS)
+ NULLIFY(YSSO%XAOSIP)
+ NULLIFY(YSSO%XAOSIM)
+ NULLIFY(YSSO%XAOSJP)
+ NULLIFY(YSSO%XAOSJM)
+ NULLIFY(YSSO%XHO2IP)
+ NULLIFY(YSSO%XHO2IM)
+ NULLIFY(YSSO%XHO2JP)
+ NULLIFY(YSSO%XHO2JM)
+ NULLIFY(YSSO%XZ0REL)
-
-END MODULE MODD_SURF_ATM_SSO_n
+ NULLIFY(YSSO%XZ0EFFIP)
+ NULLIFY(YSSO%XZ0EFFIM)
+ NULLIFY(YSSO%XZ0EFFJP)
+ NULLIFY(YSSO%XZ0EFFJM)
+
+YSSO%CROUGH=' '
+YSSO%XFRACZ0=2.
+YSSO%XCOEFBE=2.
+IF (LHOOK) CALL DR_HOOK("MODD_SSO_N:SSO_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE SSO_INIT
+!
+SUBROUTINE SSO_NP_INIT(YSSO_NP,KPATCH)
+TYPE(SSO_NP_t), INTENT(INOUT) :: YSSO_NP
+INTEGER, INTENT(IN) :: KPATCH
+INTEGER :: JP
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_SSO_N:SSO_NP_INIT",0,ZHOOK_HANDLE)
+!
+IF (ASSOCIATED(YSSO_NP%AL)) THEN
+ DO JP = 1,KPATCH
+ CALL SSO_INIT(YSSO_NP%AL(JP))
+ ENDDO
+ DEALLOCATE(YSSO_NP%AL)
+ELSE
+ ALLOCATE(YSSO_NP%AL(KPATCH))
+ DO JP = 1,KPATCH
+ CALL SSO_INIT(YSSO_NP%AL(JP))
+ ENDDO
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK("MODD_SSO_N:SSO_NP_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE SSO_NP_INIT
+!
+END MODULE MODD_SSO_n
diff --git a/src/SURFEX/modd_surf_atm_gridn.F90 b/src/SURFEX/modd_surf_atm_gridn.F90
index 3bc880e5f4becf00310b5e14e516c026c2ffd2ed..af2cf72433e6eb63be014fccf4909fa1bcca197a 100644
--- a/src/SURFEX/modd_surf_atm_gridn.F90
+++ b/src/SURFEX/modd_surf_atm_gridn.F90
@@ -30,6 +30,7 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SFX_GRID_n, ONLY : GRID_t, GRID_INIT
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -41,55 +42,34 @@ TYPE SURF_ATM_GRID_t
!
! Grid definition
!
- CHARACTER(LEN=10) :: CGRID ! grid type
-! ! "NONE " : no grid computations
-! ! "CONF PROJ " : conformal projection
-!
- REAL, POINTER, DIMENSION(:) :: XGRID_PAR ! lits of parameters used to define the grid
+TYPE(GRID_t) :: G
! ! (depends on value of CGRID)
REAL, POINTER, DIMENSION(:) :: XGRID_FULL_PAR ! lits of parameters used to define the grid
! ! (depends on value of CGRID)
- INTEGER :: NGRID_PAR ! size of XGRID_PAR
+ INTEGER :: NGRID_FULL_PAR ! size of XGRID_FULL_PAR
!
INTEGER, POINTER, DIMENSION(:,:) :: NNEAR
!-------------------------------------------------------------------------------
!
! General surface parameters:
!
- REAL, POINTER, DIMENSION(:) :: XLAT ! latitude (degrees +North) (-)
- REAL, POINTER, DIMENSION(:) :: XLON ! longitude (degrees +East) (-)
- REAL, POINTER, DIMENSION(:) :: XMESH_SIZE ! mesh size (m2)
REAL, POINTER, DIMENSION(:) :: XJPDIR ! heading of J direction (deg from N clockwise)
!-------------------------------------------------------------------------------
!
-
END TYPE SURF_ATM_GRID_t
-
-
-
+!
CONTAINS
-
!
-
-
-
-
SUBROUTINE SURF_ATM_GRID_INIT(YSURF_ATM_GRID)
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: YSURF_ATM_GRID
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK("MODD_SURF_ATM_GRID_N:SURF_ATM_GRID_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YSURF_ATM_GRID%XGRID_PAR)
+ CALL GRID_INIT(YSURF_ATM_GRID%G)
NULLIFY(YSURF_ATM_GRID%NNEAR)
NULLIFY(YSURF_ATM_GRID%XGRID_FULL_PAR)
- NULLIFY(YSURF_ATM_GRID%XLAT)
- NULLIFY(YSURF_ATM_GRID%XLON)
- NULLIFY(YSURF_ATM_GRID%XMESH_SIZE)
- NULLIFY(YSURF_ATM_GRID%XJPDIR)
-YSURF_ATM_GRID%CGRID=' '
-YSURF_ATM_GRID%NGRID_PAR=0
+ NULLIFY(YSURF_ATM_GRID%XJPDIR)
+YSURF_ATM_GRID%NGRID_FULL_PAR=0
IF (LHOOK) CALL DR_HOOK("MODD_SURF_ATM_GRID_N:SURF_ATM_GRID_INIT",1,ZHOOK_HANDLE)
END SUBROUTINE SURF_ATM_GRID_INIT
-
-
-
+!
END MODULE MODD_SURF_ATM_GRID_n
diff --git a/src/SURFEX/modd_surf_atmn.F90 b/src/SURFEX/modd_surf_atmn.F90
index e09b4f1678e88e19f9b3b9f9457211602cd4cf22..aa31ad01c7f40d6bd55bcc8cc3a5e3f97a1bc344 100644
--- a/src/SURFEX/modd_surf_atmn.F90
+++ b/src/SURFEX/modd_surf_atmn.F90
@@ -66,6 +66,7 @@ TYPE SURF_ATM_t
LOGICAL :: LECOCLIMAP ! T: parameters computed from ecoclimap
! ! F: they are read in the file
!
+ LOGICAL :: LECOSG ! T: parameters computed from ecosg
!-------------------------------------------------------------------------------
!
! change water (not lake) to nature and/or town to rock : arrange cover properly
@@ -162,7 +163,7 @@ END TYPE SURF_ATM_t
!
- CONTAINS
+CONTAINS
!
@@ -195,6 +196,7 @@ YSURF_ATM%CNATURE=' '
YSURF_ATM%CWATER=' '
YSURF_ATM%CSEA=' '
YSURF_ATM%LECOCLIMAP=.FALSE.
+YSURF_ATM%LECOSG=.FALSE.
YSURF_ATM%LWATER_TO_NATURE=.FALSE.
YSURF_ATM%LTOWN_TO_ROCK=.FALSE.
YSURF_ATM%LGARDEN=.FALSE.
diff --git a/src/SURFEX/modd_surf_reprod_oper.F90 b/src/SURFEX/modd_surf_reprod_oper.F90
deleted file mode 100644
index 4d321c57abe69c4d8f445b4e081921ad699a7b35..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_surf_reprod_oper.F90
+++ /dev/null
@@ -1,12 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ######################
- MODULE MODD_SURF_REPROD_OPER
-! ######################
-!
-! Ã supprimer
-!--------------------------------------------------------------------------------
-!
-END MODULE MODD_SURF_REPROD_OPER
diff --git a/src/SURFEX/modd_surfex_mpi.F90 b/src/SURFEX/modd_surfex_mpi.F90
index cdba862ca839305a5417639e3b49b99f8b69c5d5..297ac766d3b72f6604ac823e675beb15b799486c 100644
--- a/src/SURFEX/modd_surfex_mpi.F90
+++ b/src/SURFEX/modd_surfex_mpi.F90
@@ -42,9 +42,18 @@ USE PARKIND1 ,ONLY : JPRB
IMPLICIT NONE
!-------------------------------------------------------------------------------
!
+REAL, DIMENSION(:,:), ALLOCATABLE :: XWORKS
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XWORK2S
+!
+INTEGER, DIMENSION(:), ALLOCATABLE :: NREQ
INTEGER, DIMENSION(:), ALLOCATABLE :: NINDEX
+INTEGER, DIMENSION(:), ALLOCATABLE :: NNUM
+INTEGER, DIMENSION(:), ALLOCATABLE :: NINDEX_MNH
+INTEGER, DIMENSION(:), ALLOCATABLE :: NNUM_MNH
INTEGER, DIMENSION(:), ALLOCATABLE :: NSIZE_TASK
!
+INTEGER :: NDIM_FULL_INIT
+!
INTEGER :: NPROC = 1
INTEGER :: NRANK = 0
INTEGER :: NCOMM = -1
@@ -54,45 +63,29 @@ INTEGER :: MYPROC = 0
!
INTEGER :: IDX_R = 0
INTEGER :: IDX_W = 0
+INTEGER :: IDX_I = 0
!
REAL, DIMENSION(5) :: XTIME_WRITE
-!$OMP THREADPRIVATE(XTIME_WRITE)
REAL, DIMENSION(6) :: XTIME_CALC
-!$OMP THREADPRIVATE(XTIME_CALC)
+!
REAL :: XTIME_NPIO_READ=0
-!$OMP THREADPRIVATE(XTIME_NPIO_READ)
REAL :: XTIME_NPIO_WRITE=0
-!$OMP THREADPRIVATE(XTIME_NPIO_WRITE)
REAL :: XTIME_COMM_READ=0
-!$OMP THREADPRIVATE(XTIME_COMM_READ)
REAL :: XTIME_CALC_READ=0
-!$OMP THREADPRIVATE(XTIME_CALC_READ)
REAL :: XTIME_COMM_WRITE=0
-!$OMP THREADPRIVATE(XTIME_COMM_WRITE)
REAL :: XTIME_CALC_WRITE=0
-!$OMP THREADPRIVATE(XTIME_CALC_WRITE)
-REAL :: XTIME_OMP_BARR=0
-!$OMP THREADPRIVATE(XTIME_OMP_BARR)
!
REAL :: XTIME_INIT_SEA=0
-!$OMP THREADPRIVATE(XTIME_INIT_SEA)
REAL :: XTIME_INIT_WATER=0
-!$OMP THREADPRIVATE(XTIME_INIT_WATER)
REAL :: XTIME_INIT_NATURE=0
-!$OMP THREADPRIVATE(XTIME_INIT_NATURE)
REAL :: XTIME_INIT_TOWN=0
-!$OMP THREADPRIVATE(XTIME_INIT_TOWN)
!
REAL :: XTIME_SEA=0
-!$OMP THREADPRIVATE(XTIME_SEA)
REAL :: XTIME_WATER=0
-!$OMP THREADPRIVATE(XTIME_WATER)
REAL :: XTIME_NATURE=0
-!$OMP THREADPRIVATE(XTIME_NATURE)
REAL :: XTIME_TOWN=0
-!$OMP THREADPRIVATE(XTIME_TOWN)
!
- CONTAINS
+CONTAINS
!
SUBROUTINE WLOG_MPI(HLOG,PLOG,KLOG,KLOG2,OLOG)
!
@@ -112,8 +105,6 @@ IF (LHOOK) CALL DR_HOOK('MODD_SURFEX_MPI:WLOG_MPI',0,ZHOOK_HANDLE)
!
IUNIT=100000+NRANK
!
-!$OMP CRITICAL
-!
IF (PRESENT(OLOG)) THEN
IF (PRESENT(PLOG)) THEN
IF (PRESENT(KLOG)) THEN
@@ -154,16 +145,14 @@ ELSE
WRITE(IUNIT,*) NBLOCK, HLOG
ENDIF
!
-!$OMP END CRITICAL
-!
IF (LHOOK) CALL DR_HOOK('MODD_SURFEX_MPI:WLOG_MPI',1,ZHOOK_HANDLE)
!
END SUBROUTINE WLOG_MPI
!
SUBROUTINE PREP_LOG_MPI
!
- CHARACTER(LEN=100) :: YNAME
- CHARACTER(LEN=10) :: YRANK
+CHARACTER(LEN=100) :: YNAME
+CHARACTER(LEN=10) :: YRANK
INTEGER :: IUNIT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -175,10 +164,8 @@ YNAME='log'//ADJUSTL(YRANK)
!
IUNIT=100000+NRANK
!
-!$OMP SINGLE
OPEN(UNIT=IUNIT,FILE=TRIM(YNAME),FORM='FORMATTED')
WRITE(IUNIT,*) "Log offline pour proc ",NRANK
-!$OMP END SINGLE
!
IF (LHOOK) CALL DR_HOOK('MODD_SURFEX_MPI:PREP_LOG_MPI',1,ZHOOK_HANDLE)
!
@@ -194,10 +181,8 @@ IF (LHOOK) CALL DR_HOOK('MODD_SURFEX_MPI:END_LOG_MPI',0,ZHOOK_HANDLE)
!
IUNIT=100000+NRANK
!
-!$OMP SINGLE
WRITE(IUNIT,*) "End log offline pour proc ",NRANK
- CLOSE(UNIT=IUNIT)
-!$OMP END SINGLE
+CLOSE(UNIT=IUNIT)
!
IF (LHOOK) CALL DR_HOOK('MODD_SURFEX_MPI:END_LOG_MPI',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/modd_surfex_omp.F90 b/src/SURFEX/modd_surfex_omp.F90
index 41f9e6149a9a94ba18f9332b6a8ac82439c272f9..506baa3dfb9ae7a4fffeb3066d3586ac770f6cb4 100644
--- a/src/SURFEX/modd_surfex_omp.F90
+++ b/src/SURFEX/modd_surfex_omp.F90
@@ -36,13 +36,13 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
#ifdef AIX64
-!$ USE OMP_LIB
+ USE OMP_LIB
#endif
!
IMPLICIT NONE
!
#ifndef AIX64
-!$ INCLUDE 'omp_lib.h'
+ INCLUDE 'omp_lib.h'
#endif
!
!RJ: this broke non openmp version before
@@ -56,151 +56,7 @@ INTEGER :: NBLOCKTOT = 1
INTEGER :: NBLOCK = 1
#endif
!$OMP THREADPRIVATE(NBLOCK)
-INTEGER :: NINDX1SFX = 1
-!$OMP THREADPRIVATE(NINDX1SFX)
-INTEGER :: NINDX2SFX = 1
-!$OMP THREADPRIVATE(NINDX2SFX)
INTEGER :: IDC = 0
-!
- CHARACTER(LEN=100) :: CWORK0, CWORKB
-LOGICAL :: LWORK0
-LOGICAL, DIMENSION(:), POINTER :: LWORKD
-INTEGER :: NWORK0, NWORKVAR, NWORKB, NWORKDIMS
-INTEGER, DIMENSION(4) :: NWORKLEN
-INTEGER, DIMENSION(4) :: NWORKIDS
-INTEGER, DIMENSION(:), POINTER :: NWORK_FULL
-INTEGER, DIMENSION(:), POINTER :: NWORKD
-INTEGER, DIMENSION(:), POINTER :: NWORK
-INTEGER, DIMENSION(:,:), POINTER :: NWORK2_FULL
-INTEGER, DIMENSION(:,:), POINTER :: NWORKD2
-INTEGER, DIMENSION(:,:), POINTER :: NWORK2
-INTEGER, DIMENSION(:,:,:), POINTER :: NWORKD3
-REAL :: XWORK0
-REAL, DIMENSION(:), POINTER :: XWORK_FULL
-REAL, DIMENSION(:), POINTER :: XWORKD
-REAL, DIMENSION(:), POINTER :: XWORK
-REAL, DIMENSION(:,:), POINTER :: XWORK2_FULL
-REAL, DIMENSION(:,:), POINTER :: XWORKD2
-REAL, DIMENSION(:,:), POINTER :: XWORK2
-REAL, DIMENSION(:,:,:), POINTER :: XWORKD3
-REAL, DIMENSION(:,:,:), POINTER :: XWORK3
-!
- CONTAINS
-!
-!*********************************************************
-!
-SUBROUTINE INIT_DIM(KSIZE_OMP,KBLOCK,KKPROMA,KINDX1,KINDX2)
-!
-!RJ: work around to detect serial regions
-!RJ INTEGER, DIMENSION(0:NBLOCKTOT-1), INTENT(IN) :: KSIZE_OMP
-INTEGER, DIMENSION(0:), INTENT(IN) :: KSIZE_OMP
-INTEGER, INTENT(IN) :: KBLOCK
-INTEGER, INTENT(OUT) :: KKPROMA
-INTEGER, INTENT(OUT) :: KINDX1
-INTEGER, INTENT(OUT) :: KINDX2
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-IF (LHOOK) CALL DR_HOOK('MODD_SURFEX_OMP:INIT_DIM',0,ZHOOK_HANDLE)
-!
-IF((KBLOCK<SIZE(KSIZE_OMP)).AND.(KBLOCK<NBLOCKTOT)) THEN
-KKPROMA = KSIZE_OMP(KBLOCK)
-KINDX2 = SUM(KSIZE_OMP(0:KBLOCK))
-KINDX1 = KINDX2 - KKPROMA + 1
-ELSE
-write(0,*) "Warning[OMP]: dummy dim init for KBLOCK=",KBLOCK
-KKPROMA=0
-KINDX2=-666
-KINDX1=-666
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('MODD_SURFEX_OMP:INIT_DIM',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE INIT_DIM
-!
-!*********************************************************
-!
-SUBROUTINE RESET_DIM(KNI,KKPROMA,KINDX1,KINDX2)
-!
-INTEGER, INTENT(IN) :: KNI
-INTEGER, INTENT(OUT) :: KKPROMA
-INTEGER, INTENT(OUT) :: KINDX1
-INTEGER, INTENT(OUT) :: KINDX2
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-IF (LHOOK) CALL DR_HOOK('MODD_SURFEX_OMP:RESET_DIM',0,ZHOOK_HANDLE)
-!
-KKPROMA = KNI
-KINDX2 = KNI
-KINDX1 = 1
-!
-IF (LHOOK) CALL DR_HOOK('MODD_SURFEX_OMP:RESET_DIM',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE RESET_DIM
-!
-!*********************************************************
-!
-SUBROUTINE PLOG_OMP(HLOG,RLOG,KLOG,KLOG2,OLOG)
-!
- CHARACTER(LEN=*), INTENT(IN) :: HLOG
-REAL, INTENT(IN),OPTIONAL :: RLOG
-INTEGER, INTENT(IN), OPTIONAL :: KLOG
-INTEGER, INTENT(IN), OPTIONAL :: KLOG2
-LOGICAL, INTENT(IN), OPTIONAL :: OLOG
-!
-INTEGER :: ME
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-IF (LHOOK) CALL DR_HOOK('MODD_SURFEX_OMP:PLOG_OMP',0,ZHOOK_HANDLE)
-!
-!$ ME = OMP_GET_THREAD_NUM()
-!
-IF (PRESENT(OLOG)) THEN
- IF (PRESENT(RLOG)) THEN
- IF (PRESENT(KLOG)) THEN
- IF (PRESENT(KLOG2)) THEN
- PRINT*,ME, HLOG, KLOG, KLOG2, RLOG, OLOG
- ELSE
- PRINT*,ME, HLOG, KLOG, RLOG, OLOG
- ENDIF
- ELSE
- PRINT*,ME, HLOG, RLOG, OLOG
- ENDIF
- ELSEIF (PRESENT(KLOG)) THEN
- IF (PRESENT(KLOG2)) THEN
- PRINT*,ME, HLOG, KLOG, KLOG2, OLOG
- ELSE
- PRINT*,ME, HLOG, KLOG, OLOG
- ENDIF
- ELSE
- PRINT*,ME, HLOG, OLOG
- ENDIF
-ELSEIF (PRESENT(RLOG)) THEN
- IF (PRESENT(KLOG)) THEN
- IF (PRESENT(KLOG2)) THEN
- PRINT*,ME, HLOG, KLOG, KLOG2, RLOG
- ELSE
- PRINT*,ME, HLOG, KLOG, RLOG
- ENDIF
- ELSE
- PRINT*,ME, HLOG, RLOG
- ENDIF
-ELSEIF (PRESENT(KLOG)) THEN
- IF (PRESENT(KLOG2)) THEN
- PRINT*,ME, HLOG, KLOG, KLOG2
- ELSE
- PRINT*,ME, HLOG, KLOG
- ENDIF
-ELSE
- PRINT*,ME, HLOG
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('MODD_SURFEX_OMP:PLOG_OMP',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE PLOG_OMP
-!
-!*********************************************************
!
END MODULE MODD_SURFEX_OMP
diff --git a/src/SURFEX/modd_surfexn.F90 b/src/SURFEX/modd_surfexn.F90
index a1bcca7f0e409f48f22ee634baa3d8f607c02532..56b37e74f4e090abfe54764a89e56d8c0917c80b 100644
--- a/src/SURFEX/modd_surfexn.F90
+++ b/src/SURFEX/modd_surfexn.F90
@@ -4,12 +4,12 @@
!SFX_LIC for details. version 1.
MODULE MODD_SURFEX_n
!
-USE MODD_AGRI_n, ONLY : AGRI_t
+USE MODD_AGRI_n, ONLY : AGRI_NP_t
USE MODD_BEM_OPTION_n, ONLY : BEM_OPTIONS_t
USE MODD_BLD_DESCRIPTION_n, ONLY : BLD_DESC_t
USE MODD_CH_EMIS_FIELD_n, ONLY : CH_EMIS_FIELD_t
USE MODD_CH_FLAKE_n, ONLY : CH_FLAKE_t
-USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
+USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t, CH_ISBA_NP_t
USE MODD_CH_SEAFLUX_n, ONLY : CH_SEAFLUX_t
USE MODD_CH_SNAP_n, ONLY : CH_EMIS_SNAP_t
USE MODD_CH_SURF_n, ONLY : CH_SURF_t
@@ -19,195 +19,237 @@ USE MODD_DATA_BEM_n, ONLY : DATA_BEM_t
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_t
-USE MODD_DATA_TEB_GARDEN_n, ONLY : DATA_TEB_GARDEN_t
-USE MODD_DATA_TEB_GREENROOF_n, ONLY : DATA_TEB_GREENROOF_t
USE MODD_DATA_TEB_n, ONLY : DATA_TEB_t
USE MODD_DATA_TSZ0_n, ONLY : DATA_TSZ0_t
-USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
-USE MODD_DIAG_FLAKE_n, ONLY : DIAG_FLAKE_t
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
-USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t, DIAG_EVAP_ISBA_NP_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_NP_t, DIAG_OPTIONS_t
USE MODD_DIAG_MISC_FLAKE_n, ONLY : DIAG_MISC_FLAKE_t
-USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
-USE MODD_DIAG_MISC_TEB_OPTION_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t, DIAG_MISC_ISBA_NP_t
+USE MODD_DIAG_MISC_TEB_OPTIONS_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
USE MODD_DIAG_OCEAN_n, ONLY : DIAG_OCEAN_t
-USE MODD_DIAG_SEAFLUX_n, ONLY : DIAG_SEAFLUX_t
-USE MODD_DIAG_SEAICE_n, ONLY : DIAG_SEAICE_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_DIAG_TEB_GARDEN_n, ONLY : DIAG_TEB_GARDEN_t
-USE MODD_DIAG_TEB_GREENROOF_n, ONLY : DIAG_TEB_GREENROOF_t
-USE MODD_DIAG_TEB_n, ONLY : DIAG_TEB_t
+USE MODD_DIAG_MISC_SEAICE_n, ONLY : DIAG_MISC_SEAICE_t
USE MODD_DIAG_UTCI_TEB_n, ONLY : DIAG_UTCI_TEB_t
-USE MODD_DIAG_WATFLUX_n, ONLY : DIAG_WATFLUX_t
-USE MODD_DST_n, ONLY : DST_t
+USE MODD_DST_n, ONLY : DST_NP_t
USE MODD_DUMMY_SURF_FIELDS_n, ONLY : DUMMY_SURF_FIELDS_t
USE MODD_EMIS_GR_FIELD_n, ONLY : EMIS_GR_FIELD_t
-USE MODD_FLAKE_GRID_n, ONLY : FLAKE_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t, GRID_NP_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
USE MODD_FLAKE_n, ONLY : FLAKE_t
-USE MODD_FLAKE_SBL_n, ONLY : FLAKE_SBL_t
-USE MODD_GR_BIOG_GARDEN_n, ONLY : GR_BIOG_GARDEN_t
-USE MODD_GR_BIOG_GREENROOF_n, ONLY : GR_BIOG_GREENROOF_t
-USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t
+USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t, GR_BIOG_NP_t
USE MODD_IDEAL_n, ONLY : IDEAL_t
-USE MODD_ISBA_CANOPY_n, ONLY : ISBA_CANOPY_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_CANOPY_n, ONLY : CANOPY_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_NK_t, ISBA_P_t, ISBA_NP_t, &
+ ISBA_PE_t, ISBA_NPE_t
USE MODD_OCEAN_n, ONLY : OCEAN_t
USE MODD_OCEAN_REL_n, ONLY : OCEAN_REL_t
-USE MODD_PACK_CH_ISBA, ONLY : PACK_CH_ISBA_t
-USE MODD_PACK_DIAG_ISBA, ONLY : PACK_DIAG_ISBA_t
-USE MODD_PACK_ISBA, ONLY : PACK_ISBA_t
-USE MODD_SEAFLUX_GRID_n, ONLY : SEAFLUX_GRID_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
-USE MODD_SEAFLUX_SBL_n, ONLY : SEAFLUX_SBL_t
USE MODD_SLT_n, ONLY : SLT_t
-USE MODD_SSO_CANOPY_n, ONLY : SSO_CANOPY_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t, SSO_NP_t
USE MODD_SV_n, ONLY : SV_t
-USE MODD_TEB_CANOPY_n, ONLY : TEB_CANOPY_t
-USE MODD_TEB_GARDEN_OPTION_n, ONLY : TEB_GARDEN_OPTIONS_t
-USE MODD_TEB_GARDEN_PGD_n, ONLY : TEB_GARDEN_PGD_t
-USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
-USE MODD_TEB_GREENROOF_PGD_n, ONLY : TEB_GREENROOF_PGD_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
USE MODD_TEB_IRRIG_n, ONLY : TEB_IRRIG_t
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
USE MODD_TEB_PANEL_n, ONLY : TEB_PANEL_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
-USE MODD_WATFLUX_GRID_n, ONLY : WATFLUX_GRID_t
USE MODD_WATFLUX_n, ONLY : WATFLUX_t
-USE MODD_WATFLUX_SBL_n, ONLY : WATFLUX_SBL_t
!
-USE MODD_BEM_n, ONLY : BEM_t
-USE MODD_DIAG_CUMUL_TEB_n, ONLY : DIAG_CUMUL_TEB_t
-USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_t
-USE MODD_TEB_GARDEN_n, ONLY : TEB_GARDEN_t
-USE MODD_TEB_GARDEN_PGD_EVOL_n, ONLY : TEB_GARDEN_PGD_EVOL_t
-USE MODD_TEB_GREENROOF_n, ONLY : TEB_GREENROOF_t
-USE MODD_TEB_GREENROOF_PGD_EVOL_n, ONLY : TEB_GREENROOF_PGD_EVOL_t
-USE MODD_TEB_n, ONLY : TEB_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_BEM_n, ONLY : BEM_NP_t
+USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_NP_t
+USE MODD_TEB_n, ONLY : TEB_NP_t
!
!
!---------------------------------------------------------------------------
!
TYPE FLAKE_MODEL_t
!
+TYPE(DIAG_OPTIONS_t) :: DFO
+TYPE(DIAG_t) :: DF
+TYPE(DIAG_t) :: DFC
+TYPE(DIAG_MISC_FLAKE_t) :: DMF
+!
+TYPE(GRID_t) :: G
+TYPE(CANOPY_t) :: SB
TYPE(CH_FLAKE_t) :: CHF
-TYPE(DIAG_FLAKE_t) :: DGF
-TYPE(DIAG_MISC_FLAKE_t) :: DGMF
TYPE(FLAKE_t) :: F
-TYPE(FLAKE_GRID_t) :: FG
-TYPE(FLAKE_SBL_t) :: FSB
!
END TYPE FLAKE_MODEL_t
!
+!
TYPE WATFLUX_MODEL_t
!
+TYPE(DIAG_OPTIONS_t) :: DWO
+TYPE(DIAG_t) :: DW
+TYPE(DIAG_t) :: DWC
+!
+TYPE(GRID_t) :: G
+TYPE(CANOPY_t) :: SB
TYPE(CH_WATFLUX_t) :: CHW
-TYPE(DIAG_WATFLUX_t) :: DGW
-TYPE(WATFLUX_GRID_t) :: WG
TYPE(WATFLUX_t) :: W
-TYPE(WATFLUX_SBL_t) :: WSB
!
END TYPE WATFLUX_MODEL_t
!
+!------------------------------------------------------
+!
+TYPE SEAFLUX_DIAG_t
+!
+TYPE(DIAG_OPTIONS_t) :: O
+TYPE(DIAG_t) :: D
+TYPE(DIAG_t) :: DC
+TYPE(DIAG_t) :: DI
+TYPE(DIAG_t) :: DIC
+TYPE(DIAG_OCEAN_t) :: GO
+TYPE(DIAG_MISC_SEAICE_t) :: DMI
+!
+END TYPE SEAFLUX_DIAG_t
+!
+!
TYPE SEAFLUX_MODEL_t
!
-TYPE(CH_SEAFLUX_t) :: CHS
+TYPE(SEAFLUX_DIAG_t) :: SD
+!
TYPE(DATA_SEAFLUX_t) :: DTS
-TYPE(DIAG_SEAFLUX_t) :: DGS
-TYPE(DIAG_OCEAN_t) :: DGO
-TYPE(DIAG_SEAICE_t) :: DGSI
+TYPE(GRID_t) :: G
+TYPE(CANOPY_t) :: SB
+TYPE(CH_SEAFLUX_t) :: CHS
+TYPE(SEAFLUX_t) :: S
+!
TYPE(OCEAN_t) :: O
TYPE(OCEAN_REL_t) :: OR
-TYPE(SEAFLUX_GRID_t) :: SG
-TYPE(SEAFLUX_t) :: S
-TYPE(SEAFLUX_SBL_t) :: SSB
!
END TYPE SEAFLUX_MODEL_t
!
+!--------------------------------------------------
+!
+TYPE ISBA_DIAG_t
+!
+TYPE(DIAG_OPTIONS_t) :: O
+TYPE(DIAG_t) :: D
+TYPE(DIAG_t) :: DC
+TYPE(DIAG_NP_t) :: ND
+TYPE(DIAG_NP_t) :: NDC
+TYPE(DIAG_EVAP_ISBA_t) :: DE
+TYPE(DIAG_EVAP_ISBA_t) :: DEC
+TYPE(DIAG_EVAP_ISBA_NP_t) :: NDE
+TYPE(DIAG_EVAP_ISBA_NP_t) :: NDEC
+TYPE(DIAG_MISC_ISBA_t) :: DM
+TYPE(DIAG_MISC_ISBA_NP_t) :: NDM
+!
+END TYPE ISBA_DIAG_t
+!
TYPE ISBA_MODEL_t
!
-TYPE(AGRI_t) :: AG
+TYPE(ISBA_DIAG_t) :: ID
+TYPE(DATA_ISBA_t) :: DTV
+TYPE(CANOPY_t) :: SB
+TYPE(ISBA_OPTIONS_t) :: O
+TYPE(ISBA_S_t) :: S
TYPE(CH_ISBA_t) :: CHI
-TYPE(DATA_ISBA_t) :: DTI
-TYPE(DIAG_EVAP_ISBA_t) :: DGEI
-TYPE(DIAG_ISBA_t) :: DGI
-TYPE(DIAG_MISC_ISBA_t) :: DGMI
+TYPE(CH_ISBA_NP_t) :: NCHI
TYPE(GR_BIOG_t) :: GB
-TYPE(ISBA_CANOPY_t) :: ICP
-TYPE(ISBA_GRID_t) :: IG
-TYPE(ISBA_t) :: I
-TYPE(PACK_CH_ISBA_t) :: PKCI
-TYPE(PACK_DIAG_ISBA_t) :: PKDI
-TYPE(PACK_ISBA_t) :: PKI
+TYPE(GR_BIOG_NP_t) :: NGB
+TYPE(SSO_t) :: ISS
+TYPE(SSO_NP_t) :: NISS
+TYPE(GRID_t) :: G
+TYPE(GRID_NP_t) :: NG
+TYPE(ISBA_K_t) :: K
+TYPE(ISBA_NK_t) :: NK
+TYPE(ISBA_NP_t) :: NP
+TYPE(ISBA_NPE_t) :: NPE
+TYPE(AGRI_NP_t) :: NAG
!
END TYPE ISBA_MODEL_t
!
+!---------------------------------------
+!
+TYPE TEB_VEG_DIAG_t
+!
+TYPE(DIAG_NP_t) :: ND
+TYPE(DIAG_EVAP_ISBA_NP_t) :: NDE
+TYPE(DIAG_EVAP_ISBA_NP_t) :: NDEC
+TYPE(DIAG_MISC_ISBA_NP_t) :: NDM
+!
+END TYPE TEB_VEG_DIAG_t
+!
TYPE TEB_GARDEN_MODEL_t
!
-TYPE(TEB_VEG_OPTIONS_t) :: TVG
-TYPE(DATA_TEB_GARDEN_t) :: DTGD
-TYPE(DIAG_TEB_GARDEN_t) :: DGTGD
-TYPE(GR_BIOG_GARDEN_t) :: GBGD
-TYPE(TEB_GARDEN_OPTIONS_t) :: TGDO
-TYPE(TEB_GARDEN_PGD_t) :: TGDP
-TYPE(TEB_GARDEN_t) :: TGD
-TYPE(TEB_GARDEN_PGD_EVOL_t) :: TGDPE
-TYPE(TEB_IRRIG_t) :: TIR
+TYPE(TEB_VEG_DIAG_t) :: VD
+TYPE(DATA_ISBA_t) :: DTV
+TYPE(ISBA_OPTIONS_t) :: O
+TYPE(ISBA_S_t) :: S
+TYPE(GR_BIOG_t) :: GB
+TYPE(ISBA_K_t) :: K
+TYPE(ISBA_P_t) :: P
+TYPE(ISBA_NPE_t) :: NPE
!
END TYPE TEB_GARDEN_MODEL_t
!
TYPE TEB_GREENROOF_MODEL_t
!
-TYPE(DATA_TEB_GREENROOF_t) :: DTGR
-TYPE(DIAG_TEB_GREENROOF_t) :: DGTGR
-TYPE(GR_BIOG_GREENROOF_t) :: GBGR
-TYPE(TEB_GREENROOF_OPTIONS_t) :: TGRO
-TYPE(TEB_GREENROOF_PGD_t) :: TGRP
-TYPE(TEB_GREENROOF_t) :: TGR
-TYPE(TEB_GREENROOF_PGD_EVOL_t) :: TGRPE
+TYPE(TEB_VEG_DIAG_t) :: VD
+TYPE(DATA_ISBA_t) :: DTV
+TYPE(ISBA_OPTIONS_t) :: O
+TYPE(ISBA_S_t) :: S
+TYPE(GR_BIOG_t) :: GB
+TYPE(ISBA_K_t) :: K
+TYPE(ISBA_P_t) :: P
+TYPE(ISBA_NPE_t) :: NPE
!
END TYPE TEB_GREENROOF_MODEL_t
!
+TYPE TEB_DIAG_t
+!
+TYPE(DIAG_OPTIONS_t) :: O
+TYPE(DIAG_t) :: D
+TYPE(DIAG_MISC_TEB_OPTIONS_t) :: MTO
+TYPE(DIAG_MISC_TEB_NP_t) :: NDMT
+TYPE(DIAG_MISC_TEB_NP_t) :: NDMTC
+TYPE(DIAG_UTCI_TEB_t) :: DUT
+!
+END TYPE TEB_DIAG_t
+!
TYPE TEB_MODEL_t
!
-TYPE(CH_TEB_t) :: CHT
TYPE(DATA_TEB_t) :: DTT
-TYPE(DIAG_MISC_TEB_OPTIONS_t) :: DGMTO
-TYPE(DIAG_TEB_t) :: DGT
-TYPE(DIAG_UTCI_TEB_t) :: DGUT
-TYPE(TEB_CANOPY_t) :: TCP
-TYPE(TEB_GRID_t) :: TG
TYPE(TEB_OPTIONS_t) :: TOP
+TYPE(CANOPY_t) :: SB
+TYPE(GRID_t) :: G
+TYPE(CH_TEB_t) :: CHT
TYPE(TEB_PANEL_t) :: TPN
-TYPE(DIAG_CUMUL_TEB_t) :: DGCT
-TYPE(DIAG_MISC_TEB_t) :: DGMT
-TYPE(TEB_t) :: T
+TYPE(TEB_IRRIG_t) :: TIR
+TYPE(TEB_NP_t) :: NT
+!
+TYPE(TEB_DIAG_t) :: TD
!
-TYPE(BLD_DESC_t) :: BDD
-TYPE(BEM_OPTIONS_t) :: BOP
TYPE(DATA_BEM_t) :: DTB
-TYPE(BEM_t) :: B
+TYPE(BEM_OPTIONS_t) :: BOP
+TYPE(BLD_DESC_t) :: BDD
+TYPE(BEM_NP_t) :: NB
!
END TYPE TEB_MODEL_t
!
+!----------------------------------------------------------
+!
TYPE SURFEX_t
!
TYPE(DATA_COVER_t) :: DTCO
TYPE(DATA_TSZ0_t) :: DTZ
TYPE(DUMMY_SURF_FIELDS_t) :: DUU
!
+TYPE(GRID_CONF_PROJ_t) :: GCP
TYPE(SURF_ATM_GRID_t) :: UG
TYPE(SURF_ATM_t) :: U
-TYPE(DIAG_SURF_ATM_t) :: DGU
-TYPE(SURF_ATM_SSO_t) :: USS
-TYPE(SSO_CANOPY_t) :: SSCP
-!
-TYPE(DIAG_IDEAL_t) :: DGL
+TYPE(DIAG_OPTIONS_t) :: DUO
+TYPE(DIAG_t) :: DU
+TYPE(DIAG_t) :: DUC
+TYPE(DIAG_NP_t) :: DUP
+TYPE(DIAG_NP_t) :: DUPC
+TYPE(SSO_t) :: USS
+TYPE(CANOPY_t) :: SB
+!
+TYPE(DIAG_OPTIONS_t) :: DLO
+TYPE(DIAG_t) :: DL
+TYPE(DIAG_t) :: DLC
TYPE(IDEAL_t) :: L
!
TYPE(SV_t) :: SV
@@ -215,7 +257,7 @@ TYPE(CH_SURF_t) :: CHU
TYPE(CH_EMIS_FIELD_t) :: CHE
TYPE(CH_EMIS_SNAP_t) :: CHN
TYPE(EMIS_GR_FIELD_t) :: EGF
-TYPE(DST_t) :: DST
+TYPE(DST_NP_t) :: NDST
TYPE(SLT_t) :: SLT
!
TYPE(FLAKE_MODEL_t) :: FM
@@ -226,7 +268,6 @@ TYPE(TEB_MODEL_t) :: TM
TYPE(TEB_GARDEN_MODEL_t) :: GDM
TYPE(TEB_GREENROOF_MODEL_t) :: GRM
!
-TYPE(GRID_CONF_PROJ_t) :: GCP
END TYPE SURFEX_t
!
END MODULE MODD_SURFEX_n
diff --git a/src/SURFEX/modd_svn.F90 b/src/SURFEX/modd_svn.F90
index 3ac2b0e44857fa7dad2f79d6d1453e4f1ea87fcd..ab64b2e34d09b44720599215ce1c2b3ee363d663 100644
--- a/src/SURFEX/modd_svn.F90
+++ b/src/SURFEX/modd_svn.F90
@@ -54,7 +54,7 @@ END TYPE SV_t
- CONTAINS
+CONTAINS
!
diff --git a/src/SURFEX/modd_teb_garden_optionn.F90 b/src/SURFEX/modd_teb_garden_optionn.F90
deleted file mode 100644
index ee8ffc6fb330b47a133aaa6d9b95648e6198340a..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_teb_garden_optionn.F90
+++ /dev/null
@@ -1,87 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-!##################
-MODULE MODD_TEB_GARDEN_OPTION_n
-!##################
-!
-!!**** *MODD_TEB_GARDEN - declaration of packed surface parameters for ISBA scheme
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! A. Lemonsu *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2011
-!! V. Masson 06/2013 splits module in two
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_TYPE_SNOW
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE TEB_GARDEN_OPTIONS_t
-!-------------------------------------------------------------------------------
-!
-! type of initialization of vegetation: from cover types (ecoclimap) or parameters prescribed
-!
- LOGICAL :: LPAR_GARDEN ! T: parameters computed from ecoclimap
-! ! F: they are read in the file
-!
-! Number of inside garden vegetation (not TEB) patches and of layers
-!
-!
- INTEGER :: NGROUND_LAYER ! number of ground layers
-!
- INTEGER :: NLAYER_HORT
- INTEGER :: NLAYER_DUN
-!
- REAL, POINTER, DIMENSION(:) :: XSOILGRID ! Soil layer grid as reference for DIF
-!
-END TYPE TEB_GARDEN_OPTIONS_t
-!-------------------------------------------------------------------------------
-
-
-
- CONTAINS
-
-!
-
-
-!
-
-SUBROUTINE TEB_GARDEN_OPTIONS_INIT(YTEB_GARDEN_OPTIONS)
-TYPE(TEB_GARDEN_OPTIONS_t), INTENT(INOUT) :: YTEB_GARDEN_OPTIONS
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_N:TEB_GARDEN_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YTEB_GARDEN_OPTIONS%XSOILGRID)
-YTEB_GARDEN_OPTIONS%LPAR_GARDEN=.TRUE.
-YTEB_GARDEN_OPTIONS%NGROUND_LAYER=0
-YTEB_GARDEN_OPTIONS%NLAYER_HORT=0
-YTEB_GARDEN_OPTIONS%NLAYER_DUN=0
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_N:TEB_GARDEN_OPTIONS_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE TEB_GARDEN_OPTIONS_INIT
-
-
-END MODULE MODD_TEB_GARDEN_OPTION_n
diff --git a/src/SURFEX/modd_teb_garden_pgd_evoln.F90 b/src/SURFEX/modd_teb_garden_pgd_evoln.F90
deleted file mode 100644
index 199b786a74db7d2a719fb945de3a9062b5e1ddf1..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_teb_garden_pgd_evoln.F90
+++ /dev/null
@@ -1,108 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-!##################
-MODULE MODD_TEB_GARDEN_PGD_EVOL_n
-!##################
-!
-!!**** *MODD_TEB_GARDEN - declaration of packed surface parameters for ISBA scheme
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! A. Lemonsu *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2011
-!! V. Masson 06/2013 splits module in 4
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-!-------------------------------------------------------------------------------
-TYPE TEB_GARDEN_PGD_EVOL_1P_t
-!!-------------------------------------------------------------------------------
-!
-! - Vegetation: Ags Prognostic (YPHOTO = ('LAI', 'LST', or 'NIT') or prescribed (YPHOTO='NON', 'AGS' or 'LST')
-!
- REAL, POINTER, DIMENSION(:) :: XLAI ! Leaf Area Index (m2/m2)
- REAL, POINTER, DIMENSION(:) :: XVEG ! vegetation cover fraction (-)
- REAL, POINTER, DIMENSION(:) :: XALBNIR ! near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBVIS ! visible albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBUV ! UV albedo (-)
- REAL, POINTER, DIMENSION(:) :: XEMIS ! surface emissivity (-)
- REAL, POINTER, DIMENSION(:) :: XZ0 ! surface roughness length (m)
-!
-!-------------------------------------------------------------------------------
-END TYPE TEB_GARDEN_PGD_EVOL_1P_t
-!
-TYPE TEB_GARDEN_PGD_EVOL_t
- !
- TYPE(TEB_GARDEN_PGD_EVOL_1P_t), POINTER :: ALP(:) => NULL()
- TYPE(TEB_GARDEN_PGD_EVOL_1P_t), POINTER :: CUR => NULL()
- !
-END TYPE TEB_GARDEN_PGD_EVOL_t
-!
-
-
- CONTAINS
-!
-!
-SUBROUTINE TEB_GARDEN_PGD_EVOL_GOTO_PATCH(YTEB_GARDEN_PGD_EVOL,KTO_PATCH)
-TYPE(TEB_GARDEN_PGD_EVOL_t), INTENT(INOUT) :: YTEB_GARDEN_PGD_EVOL
-INTEGER, INTENT(IN) :: KTO_PATCH
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-! Current patch is set to patch KTO_PATCH
-IF (LHOOK) CALL DR_HOOK('MODD_TEB_GARDEN_PGD_EVOL_N:TEB_GARDEN_PGD_EVOL_GOTO_PATCH',0,ZHOOK_HANDLE)
-
-YTEB_GARDEN_PGD_EVOL%CUR => YTEB_GARDEN_PGD_EVOL%ALP(KTO_PATCH)
-
-IF (LHOOK) CALL DR_HOOK('MODD_TEB_GARDEN_PGD_EVOL_N:TEB_GARDEN_PGD_EVOL_GOTO_PATCH',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE TEB_GARDEN_PGD_EVOL_GOTO_PATCH
-!
-SUBROUTINE TEB_GARDEN_PGD_EVOL_INIT(YTEB_GARDEN_PGD_EVOL,KPATCH)
-TYPE(TEB_GARDEN_PGD_EVOL_t), INTENT(INOUT) :: YTEB_GARDEN_PGD_EVOL
-INTEGER, INTENT(IN) :: KPATCH
-INTEGER :: JP
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_PGD_EVOL_N:TEB_GARDEN_PGD_EVOL_INIT",0,ZHOOK_HANDLE)
- ALLOCATE(YTEB_GARDEN_PGD_EVOL%ALP(KPATCH))
- YTEB_GARDEN_PGD_EVOL%CUR => YTEB_GARDEN_PGD_EVOL%ALP(1)
-DO JP=1,KPATCH
- NULLIFY(YTEB_GARDEN_PGD_EVOL%ALP(JP)%XALBNIR)
- NULLIFY(YTEB_GARDEN_PGD_EVOL%ALP(JP)%XALBVIS)
- NULLIFY(YTEB_GARDEN_PGD_EVOL%ALP(JP)%XALBUV)
- NULLIFY(YTEB_GARDEN_PGD_EVOL%ALP(JP)%XEMIS)
- NULLIFY(YTEB_GARDEN_PGD_EVOL%ALP(JP)%XZ0)
- NULLIFY(YTEB_GARDEN_PGD_EVOL%ALP(JP)%XVEG)
- NULLIFY(YTEB_GARDEN_PGD_EVOL%ALP(JP)%XLAI)
-ENDDO
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_PGD_EVOL_N:TEB_GARDEN_PGD_EVOL_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE TEB_GARDEN_PGD_EVOL_INIT
-
-
-
-
-END MODULE MODD_TEB_GARDEN_PGD_EVOL_n
diff --git a/src/SURFEX/modd_teb_garden_pgdn.F90 b/src/SURFEX/modd_teb_garden_pgdn.F90
deleted file mode 100644
index 03cb56deb857fa3a012fb6b93ea8dc864b1d82b3..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_teb_garden_pgdn.F90
+++ /dev/null
@@ -1,366 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-!##################
-MODULE MODD_TEB_GARDEN_PGD_n
-!##################
-!
-!!**** *MODD_TEB_GARDEN - declaration of packed surface parameters for ISBA scheme
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! A. Lemonsu *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2011
-!! V. Masson 06/2013 splits module in 4
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-!-------------------------------------------------------------------------------
-TYPE TEB_GARDEN_PGD_t
-!-------------------------------------------------------------------------------
-!
-! Mask and number of grid elements containing patches/tiles:
-!
- REAL, POINTER, DIMENSION(:,:) :: XVEGTYPE ! fraction of each vegetation type for
-! ! each grid mesh (-)
-!-------------------------------------------------------------------------------
-!
-! Averaged Surface radiative parameters:
-!
- REAL, POINTER, DIMENSION(:) :: XALBNIR_DRY ! dry soil near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBVIS_DRY ! dry soil visible albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBUV_DRY ! dry soil UV albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBNIR_WET ! wet soil near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBVIS_WET ! wet soil visible albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBUV_WET ! wet soil UV albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBNIR_SOIL ! soil near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBVIS_SOIL ! soil visible albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBUV_SOIL ! soil UV albedo (-)
-!
-!-------------------------------------------------------------------------------
-!
-! Input Parameters, per patch:
-!
-! - vegetation + bare soil:
-!
- REAL, POINTER, DIMENSION(:) :: XZ0_O_Z0H ! ratio of surface roughness lengths
-! ! (momentum to heat) (-)
-!
-! - vegetation:
-!
- REAL, POINTER, DIMENSION(:) :: XALBNIR_VEG ! vegetation near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBVIS_VEG ! vegetation visible albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBUV_VEG ! vegetation UV albedo (-)
-!
-! - vegetation: default option (Jarvis) and general parameters:
-!
- REAL, POINTER, DIMENSION(:) :: XWRMAX_CF ! coefficient for maximum water
-! ! interception
-! ! storage capacity on the vegetation (-)
- REAL, POINTER, DIMENSION(:) :: XRSMIN ! minimum stomatal resistance (s/m)
- REAL, POINTER, DIMENSION(:) :: XGAMMA ! coefficient for the calculation
-! ! of the surface stomatal
-! ! resistance
- REAL, POINTER, DIMENSION(:) :: XCV ! vegetation thermal inertia coefficient (K m2/J)
- REAL, POINTER, DIMENSION(:) :: XRGL ! maximum solar radiation
-! ! usable in photosynthesis (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XROOTFRAC ! root fraction profile ('DIF' option)
-!
-!-------------------------------------------------------------------------------
-!
-! - vegetation: Ags parameters ('AGS', 'LAI', 'AST', 'LST', 'NIT', 'NCB' options)
-!
-! REAL, DIMENSION(3) :: XABC ! abscissa needed for integration
- REAL, POINTER, DIMENSION(:) :: XABC ! abscissa needed for integration
-! ! of net assimilation and stomatal
-! ! conductance over canopy depth (-)
-! REAL, DIMENSION(3) :: XPOI ! Gaussian weights for integration
- REAL, POINTER, DIMENSION(:) :: XPOI ! Gaussian weights for integration
-! ! of net assimilation and stomatal
-! ! conductance over canopy depth (-)
- REAL, POINTER, DIMENSION(:) :: XBSLAI ! ratio d(biomass)/d(lai) (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XLAIMIN ! minimum LAI (Leaf Area Index) (m2/m2)
- REAL, POINTER, DIMENSION(:) :: XSEFOLD ! e-folding time for senescence (s)
- REAL, POINTER, DIMENSION(:) :: XH_TREE ! height of trees (m)
- REAL, POINTER, DIMENSION(:) :: XANF ! total assimilation over canopy (
- REAL, POINTER, DIMENSION(:) :: XANMAX ! maximum photosynthesis rate (
- REAL, POINTER, DIMENSION(:) :: XFZERO ! ideal value of F, no photo-
-! ! respiration or saturation deficit (
- REAL, POINTER, DIMENSION(:) :: XEPSO ! maximum initial quantum use
-! ! efficiency (mg J-1 PAR)
- REAL, POINTER, DIMENSION(:) :: XGAMM ! CO2 conpensation concentration (ppm)
- REAL, POINTER, DIMENSION(:) :: XQDGAMM ! Log of Q10 function for CO2 conpensation
-! ! concentration (-)
- REAL, POINTER, DIMENSION(:) :: XGMES ! mesophyll conductance (m s-1)
- REAL, POINTER, DIMENSION(:) :: XRE25 ! Ecosystem respiration parameter (kg/kg.m.s-1)
- REAL, POINTER, DIMENSION(:) :: XQDGMES ! Log of Q10 function for mesophyll conductance (-)
- REAL, POINTER, DIMENSION(:) :: XT1GMES ! reference temperature for computing
-! ! compensation concentration function for
-! ! mesophyll conductance: minimum
-! ! temperature (K)
- REAL, POINTER, DIMENSION(:) :: XT2GMES ! reference temperature for computing
-! ! compensation concentration function for
-! ! mesophyll conductance: maximum
-! ! temperature (K)
- REAL, POINTER, DIMENSION(:) :: XAMAX ! leaf photosynthetic capacity (mg m-2 s-1)
- REAL, POINTER, DIMENSION(:) :: XQDAMAX ! Log of Q10 function for leaf photosynthetic
-! ! capacity (-)
- REAL, POINTER, DIMENSION(:) :: XT1AMAX ! reference temperature for computing
-! ! compensation concentration function for
-! ! leaf photosynthetic capacity: minimum
-! ! temperature (K)
- REAL, POINTER, DIMENSION(:) :: XT2AMAX ! reference temperature for computing
-! ! compensation concentration function for
-! ! leaf photosynthetic capacity: maximum
-! ! temperature (K)
-!
-
-!-------------------------------------------------------------------------------
-!
-! - vegetation: Ags Stress parameters ('AST', 'LST', 'NIT', 'NCB' options)
-!
- LOGICAL, POINTER, DIMENSION(:) :: LSTRESS ! vegetation response type to water
-! ! stress (true:defensive false:offensive) (-)
- REAL, POINTER, DIMENSION(:) :: XF2I ! critical normilized soil water
-! ! content for stress parameterisation
- REAL, POINTER, DIMENSION(:) :: XGC ! cuticular conductance (m s-1)
- REAL, POINTER, DIMENSION(:) :: XAH ! coefficients for herbaceous water stress
-! ! response (offensive or defensive) (log(mm/s))
- REAL, POINTER, DIMENSION(:) :: XBH ! coefficients for herbaceous water stress
-! ! response (offensive or defensive) (-)
- REAL, POINTER, DIMENSION(:) :: XDMAX ! maximum air saturation deficit
-! ! tolerate by vegetation (kg/kg)
-!
-!-------------------------------------------------------------------------------
-!
-! - vegetation: Ags Nitrogen-model parameters ('NIT', 'NCB' option)
-!
- REAL, POINTER, DIMENSION(:) :: XCE_NITRO ! leaf aera ratio sensitivity to
-! ! nitrogen concentration (m2/kg)
- REAL, POINTER, DIMENSION(:) :: XCF_NITRO ! lethal minimum value of leaf area
-! ! ratio (m2/kg)
- REAL, POINTER, DIMENSION(:) :: XCNA_NITRO ! nitrogen concentration of active
-! ! biomass (kg/kg)
- REAL, POINTER, DIMENSION(:) :: XBSLAI_NITRO ! biomass/LAI ratio from nitrogen
-! ! decline theory (kg/m2)
-!
-!-------------------------------------------------------------------------------
-!
-! - soil: primary parameters
-!
- REAL, POINTER, DIMENSION(:,:) :: XSAND ! sand fraction (-)
- REAL, POINTER, DIMENSION(:,:) :: XCLAY ! clay fraction (-)
- REAL, POINTER, DIMENSION(:) :: XRUNOFFB ! sub-grid surface runoff slope parameter (-)
- REAL, POINTER, DIMENSION(:) :: XWDRAIN ! continuous drainage parameter (-)
- REAL, POINTER, DIMENSION(:) :: XTAUICE ! soil freezing characteristic timescale (s)
- REAL, POINTER, DIMENSION(:) :: XGAMMAT ! 'Force-Restore' timescale when using a
-! ! prescribed lower boundary temperature (1/days)
- REAL, POINTER, DIMENSION(:,:) :: XDG ! soil layer thicknesses (m)
-! ! NOTE: in Force-Restore mode, the
-! ! uppermost layer thickness is superficial
-! ! and is only explicitly used for soil
-! ! water phase changes (m)
- REAL, POINTER, DIMENSION(:) :: XRUNOFFD ! depth over which sub-grid runoff is
-! ! computed: in Force-Restore this is the
-! ! total soil column ('2-L'), or root zone
-! ! ('3-L'). For the 'DIF' option, it can
-! ! be any depth within soil column (m)
-!
- REAL, POINTER, DIMENSION(:,:) :: XSOILWGHT ! ISBA-DIF: weights for vertical
- REAL, POINTER, DIMENSION(:,:) :: XDZG ! soil layers thicknesses (DIF option)
- REAL, POINTER, DIMENSION(:,:) :: XDZDIF ! distance between consecuative layer mid-points (DIF option)
-!
- INTEGER, POINTER, DIMENSION(:) :: NWG_LAYER ! Number of soil moisture layers for DIF
- REAL, POINTER, DIMENSION(:) :: XDROOT ! effective root depth for DIF (m)
- REAL, POINTER, DIMENSION(:) :: XDG2 ! root depth for DIF as 3-L (m)
-!-------------------------------------------------------------------------------
-!
-! - soil: Secondary parameters: hydrology
-!
- REAL, POINTER, DIMENSION(:) :: XC1SAT ! 'Force-Restore' C1 coefficient at
-! ! saturation (-)
- REAL, POINTER, DIMENSION(:) :: XC2REF ! 'Force-Restore' reference value of C2 (-)
- REAL, POINTER, DIMENSION(:,:) :: XC3 ! 'Force-Restore' C3 drainage coefficient (m)
- REAL, POINTER, DIMENSION(:) :: XC4B ! 'Force-Restore' sub-surface vertical
-! ! diffusion coefficient (slope parameter) (-)
- REAL, POINTER, DIMENSION(:) :: XC4REF ! 'Force-Restore' sub-surface vertical
-! ! diffusion coefficient (-)
- REAL, POINTER, DIMENSION(:) :: XACOEF ! 'Force-Restore' surface vertical
-! ! diffusion coefficient (-)
- REAL, POINTER, DIMENSION(:) :: XPCOEF ! 'Force-Restore' surface vertical
-! ! diffusion coefficient (-)
- REAL, POINTER, DIMENSION(:,:) :: XWFC ! field capacity volumetric water content
-! ! profile (m3/m3)
- REAL, POINTER, DIMENSION(:,:) :: XWWILT ! wilting point volumetric water content
-! ! profile (m3/m3)
- REAL, POINTER, DIMENSION(:,:) :: XWSAT ! porosity profile (m3/m3)
- REAL, POINTER, DIMENSION(:,:) :: XBCOEF ! soil water CH78 b-parameter (-)
- REAL, POINTER, DIMENSION(:,:) :: XCONDSAT ! hydraulic conductivity at saturation (m/s)
- REAL, POINTER, DIMENSION(:,:) :: XMPOTSAT ! matric potential at saturation (m)
-!
-!-------------------------------------------------------------------------------
-!
-! - soil: Secondary parameters: thermal
-!
- REAL, POINTER, DIMENSION(:) :: XCGSAT ! soil thermal inertia coefficient at
-! ! saturation (K m2/J)
- REAL, POINTER, DIMENSION(:,:) :: XHCAPSOIL ! soil heat capacity (J/K/m3)
- REAL, POINTER, DIMENSION(:,:) :: XCONDDRY ! soil dry thermal conductivity (W/m/K)
- REAL, POINTER, DIMENSION(:,:) :: XCONDSLD ! soil solids thermal conductivity (W/m/K)
- REAL, POINTER, DIMENSION(:) :: XTDEEP ! prescribed deep soil temperature
-! ! (optional) (K)
- REAL, POINTER, DIMENSION(:) :: XPCPS
- REAL, POINTER, DIMENSION(:) :: XPLVTT
- REAL, POINTER, DIMENSION(:) :: XPLSTT
-!-------------------------------------------------------------------------------
-!
-! - SGH scheme
-!
- REAL, POINTER, DIMENSION(:) :: XD_ICE !depth of the soil column for the calculation
-! of the frozen soil fraction (m)
- REAL, POINTER, DIMENSION(:) :: XKSAT_ICE !hydraulic conductivity at saturation
-! over frozen area (m s-1)
-!-------------------------------------------------------------------------------
-!
-! Type of vegetation (simplification of vegetation charaterization)
- CHARACTER(LEN=4) :: CTYPE_HVEG ! type of high vegetation
- CHARACTER(LEN=4) :: CTYPE_LVEG ! type of low vegetation
- CHARACTER(LEN=4) :: CTYPE_NVEG ! type of bare soil (no vegetation)
-!-------------------------------------------------------------------------------
-!
-END TYPE TEB_GARDEN_PGD_t
-!
-
-
-
- CONTAINS
-
-!
-
-
-!
-
-SUBROUTINE TEB_GARDEN_PGD_INIT(YTEB_GARDEN_PGD)
-TYPE(TEB_GARDEN_PGD_t), INTENT(INOUT) :: YTEB_GARDEN_PGD
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_PGD_N:TEB_GARDEN_PGD_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YTEB_GARDEN_PGD%XVEGTYPE)
- NULLIFY(YTEB_GARDEN_PGD%XALBNIR_DRY)
- NULLIFY(YTEB_GARDEN_PGD%XALBVIS_DRY)
- NULLIFY(YTEB_GARDEN_PGD%XALBUV_DRY)
- NULLIFY(YTEB_GARDEN_PGD%XALBNIR_WET)
- NULLIFY(YTEB_GARDEN_PGD%XALBVIS_WET)
- NULLIFY(YTEB_GARDEN_PGD%XALBUV_WET)
- NULLIFY(YTEB_GARDEN_PGD%XALBNIR_SOIL)
- NULLIFY(YTEB_GARDEN_PGD%XALBVIS_SOIL)
- NULLIFY(YTEB_GARDEN_PGD%XALBUV_SOIL)
- NULLIFY(YTEB_GARDEN_PGD%XZ0_O_Z0H)
- NULLIFY(YTEB_GARDEN_PGD%XALBNIR_VEG)
- NULLIFY(YTEB_GARDEN_PGD%XALBVIS_VEG)
- NULLIFY(YTEB_GARDEN_PGD%XALBUV_VEG)
- NULLIFY(YTEB_GARDEN_PGD%XWRMAX_CF)
- NULLIFY(YTEB_GARDEN_PGD%XRSMIN)
- NULLIFY(YTEB_GARDEN_PGD%XGAMMA)
- NULLIFY(YTEB_GARDEN_PGD%XCV)
- NULLIFY(YTEB_GARDEN_PGD%XRGL)
- NULLIFY(YTEB_GARDEN_PGD%XROOTFRAC)
- NULLIFY(YTEB_GARDEN_PGD%XBSLAI)
- NULLIFY(YTEB_GARDEN_PGD%XLAIMIN)
- NULLIFY(YTEB_GARDEN_PGD%XSEFOLD)
- NULLIFY(YTEB_GARDEN_PGD%XH_TREE)
- NULLIFY(YTEB_GARDEN_PGD%XANF)
- NULLIFY(YTEB_GARDEN_PGD%XANMAX)
- NULLIFY(YTEB_GARDEN_PGD%XFZERO)
- NULLIFY(YTEB_GARDEN_PGD%XEPSO)
- NULLIFY(YTEB_GARDEN_PGD%XGAMM)
- NULLIFY(YTEB_GARDEN_PGD%XQDGAMM)
- NULLIFY(YTEB_GARDEN_PGD%XGMES)
- NULLIFY(YTEB_GARDEN_PGD%XRE25)
- NULLIFY(YTEB_GARDEN_PGD%XQDGMES)
- NULLIFY(YTEB_GARDEN_PGD%XT1GMES)
- NULLIFY(YTEB_GARDEN_PGD%XT2GMES)
- NULLIFY(YTEB_GARDEN_PGD%XAMAX)
- NULLIFY(YTEB_GARDEN_PGD%XQDAMAX)
- NULLIFY(YTEB_GARDEN_PGD%XT1AMAX)
- NULLIFY(YTEB_GARDEN_PGD%XT2AMAX)
- NULLIFY(YTEB_GARDEN_PGD%LSTRESS)
- NULLIFY(YTEB_GARDEN_PGD%XF2I)
- NULLIFY(YTEB_GARDEN_PGD%XGC)
- NULLIFY(YTEB_GARDEN_PGD%XAH)
- NULLIFY(YTEB_GARDEN_PGD%XBH)
- NULLIFY(YTEB_GARDEN_PGD%XDMAX)
- NULLIFY(YTEB_GARDEN_PGD%XCE_NITRO)
- NULLIFY(YTEB_GARDEN_PGD%XCF_NITRO)
- NULLIFY(YTEB_GARDEN_PGD%XCNA_NITRO)
- NULLIFY(YTEB_GARDEN_PGD%XBSLAI_NITRO)
- NULLIFY(YTEB_GARDEN_PGD%XSAND)
- NULLIFY(YTEB_GARDEN_PGD%XCLAY)
- NULLIFY(YTEB_GARDEN_PGD%XRUNOFFB)
- NULLIFY(YTEB_GARDEN_PGD%XWDRAIN)
- NULLIFY(YTEB_GARDEN_PGD%XTAUICE)
- NULLIFY(YTEB_GARDEN_PGD%XGAMMAT)
- NULLIFY(YTEB_GARDEN_PGD%XDG)
- NULLIFY(YTEB_GARDEN_PGD%XRUNOFFD)
- NULLIFY(YTEB_GARDEN_PGD%XSOILWGHT)
- NULLIFY(YTEB_GARDEN_PGD%XDZG)
- NULLIFY(YTEB_GARDEN_PGD%XDZDIF)
- NULLIFY(YTEB_GARDEN_PGD%NWG_LAYER)
- NULLIFY(YTEB_GARDEN_PGD%XDROOT)
- NULLIFY(YTEB_GARDEN_PGD%XDG2)
- NULLIFY(YTEB_GARDEN_PGD%XPCPS)
- NULLIFY(YTEB_GARDEN_PGD%XPLVTT)
- NULLIFY(YTEB_GARDEN_PGD%XPLSTT)
- NULLIFY(YTEB_GARDEN_PGD%XC1SAT)
- NULLIFY(YTEB_GARDEN_PGD%XC2REF)
- NULLIFY(YTEB_GARDEN_PGD%XC3)
- NULLIFY(YTEB_GARDEN_PGD%XC4B)
- NULLIFY(YTEB_GARDEN_PGD%XC4REF)
- NULLIFY(YTEB_GARDEN_PGD%XACOEF)
- NULLIFY(YTEB_GARDEN_PGD%XPCOEF)
- NULLIFY(YTEB_GARDEN_PGD%XWFC)
- NULLIFY(YTEB_GARDEN_PGD%XWWILT)
- NULLIFY(YTEB_GARDEN_PGD%XWSAT)
- NULLIFY(YTEB_GARDEN_PGD%XBCOEF)
- NULLIFY(YTEB_GARDEN_PGD%XCONDSAT)
- NULLIFY(YTEB_GARDEN_PGD%XMPOTSAT)
- NULLIFY(YTEB_GARDEN_PGD%XCGSAT)
- NULLIFY(YTEB_GARDEN_PGD%XHCAPSOIL)
- NULLIFY(YTEB_GARDEN_PGD%XCONDDRY)
- NULLIFY(YTEB_GARDEN_PGD%XCONDSLD)
- NULLIFY(YTEB_GARDEN_PGD%XTDEEP)
- NULLIFY(YTEB_GARDEN_PGD%XD_ICE)
- NULLIFY(YTEB_GARDEN_PGD%XKSAT_ICE)
- NULLIFY(YTEB_GARDEN_PGD%XABC)
- NULLIFY(YTEB_GARDEN_PGD%XPOI)
-YTEB_GARDEN_PGD%CTYPE_HVEG=' '
-YTEB_GARDEN_PGD%CTYPE_LVEG=' '
-YTEB_GARDEN_PGD%CTYPE_NVEG=' '
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_PGD_N:TEB_GARDEN_PGD_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE TEB_GARDEN_PGD_INIT
-
-
-END MODULE MODD_TEB_GARDEN_PGD_n
diff --git a/src/SURFEX/modd_teb_gardenn.F90 b/src/SURFEX/modd_teb_gardenn.F90
deleted file mode 100644
index de205e560359a60e3d093e93d49399d3fd7a5e39..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_teb_gardenn.F90
+++ /dev/null
@@ -1,180 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-!##################
-MODULE MODD_TEB_GARDEN_n
-!##################
-!
-!!**** *MODD_TEB_GARDEN - declaration of packed surface parameters for ISBA scheme
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! A. Lemonsu *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2011
-!! V. Masson 06/2013 splits module in 4
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_TYPE_SNOW
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-!-------------------------------------------------------------------------------
-TYPE TEB_GARDEN_1P_t
-!-------------------------------------------------------------------------------
-!
-! Prognostic variables:
-!
-! - Snow Cover:
-!
- TYPE(SURF_SNOW) :: TSNOW ! snow state:
-! ! scheme type/option (-)
-! ! number of layers (-)
-! ! snow (& liq. water) content (kg/m2)
-! ! heat content (J/m2)
-! ! temperature (K)
-! ! density (kg m-3)
-!
-!-------------------------------------------------------------------------------
-!
-! - Soil and vegetation heat and water:
-!
- REAL, POINTER, DIMENSION(:) :: XWR ! liquid water retained on the
-! ! foliage of the vegetation
-! ! canopy (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XTG ! surface and sub-surface soil
-! ! temperature profile (K)
- REAL, POINTER, DIMENSION(:,:) :: XWG ! soil volumetric water content profile (m3/m3)
- REAL, POINTER, DIMENSION(:,:) :: XWGI ! soil liquid water equivalent volumetric
-! ! ice content profile (m3/m3)
- REAL, POINTER, DIMENSION(:) :: XRESA ! aerodynamic resistance (s/m)
-!
-!-------------------------------------------------------------------------------
-!
-! - Vegetation: Ags Prognostic (YPHOTO = 'AGS', 'LAI', 'AST', 'LST', 'NIT', 'NCB')
-!
- REAL, POINTER, DIMENSION(:) :: XAN ! net CO2 assimilation (mg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XANDAY ! daily net CO2 assimilation (mg/m2)
- REAL, POINTER, DIMENSION(:) :: XANFM ! maximum leaf assimilation (mg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XLE ! evapotranspiration (W/m2)
- REAL, POINTER, DIMENSION(:) :: XFAPARC ! Fapar of vegetation (cumul)
- REAL, POINTER, DIMENSION(:) :: XFAPIRC ! Fapir of vegetation (cumul)
- REAL, POINTER, DIMENSION(:) :: XLAI_EFFC ! Effective LAI (cumul)
- REAL, POINTER, DIMENSION(:) :: XMUS ! cos zenithal angle (cumul)
-!
-!-------------------------------------------------------------------------------
-!
-! - Vegetation: Ags Prognostic (YPHOTO = 'NIT', 'NCB')
-!
- REAL, POINTER, DIMENSION(:,:) :: XRESP_BIOMASS ! daily cumulated respiration of
-! ! biomass (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XBIOMASS ! biomass of previous day (kg/m2)
-!
-!
-!-------------------------------------------------------------------------------
-!
-! - Snow and flood fractions and total albedo at time t:
-!
- REAL, POINTER, DIMENSION(:) :: XPSNG ! Snow fraction over ground
- REAL, POINTER, DIMENSION(:) :: XPSNV ! Snow fraction over vegetation
- REAL, POINTER, DIMENSION(:) :: XPSNV_A ! Snow fraction over vegetation
- REAL, POINTER, DIMENSION(:) :: XPSN ! Total Snow fraction
-!
- REAL, POINTER, DIMENSION(:) :: XSNOWFREE_ALB ! snow free albedo (-)
- REAL, POINTER, DIMENSION(:) :: XSNOWFREE_ALB_VEG ! snow free albedo for vegetation (-)
- REAL, POINTER, DIMENSION(:) :: XSNOWFREE_ALB_SOIL! snow free albedo for soil
-!-------------------------------------------------------------------------------
-!
-END TYPE TEB_GARDEN_1P_t
-!
-TYPE TEB_GARDEN_t
- !
- TYPE(TEB_GARDEN_1P_t), POINTER :: ALP(:) => NULL()
- TYPE(TEB_GARDEN_1P_t), POINTER :: CUR => NULL()
- !
-END TYPE TEB_GARDEN_t
-!
-
-
- CONTAINS
-
-
-!
-
-
-!
-
-SUBROUTINE TEB_GARDEN_GOTO_PATCH(YTEB_GARDEN,KTO_PATCH)
-TYPE(TEB_GARDEN_t), INTENT(INOUT) :: YTEB_GARDEN
-INTEGER, INTENT(IN) :: KTO_PATCH
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-! Current patch is set to patch KTO_PATCH
-IF (LHOOK) CALL DR_HOOK('MODD_TEB_GARDEN_N:TEB_GARDEN_GOTO_PATCH',0,ZHOOK_HANDLE)
-
-YTEB_GARDEN%CUR => YTEB_GARDEN%ALP(KTO_PATCH)
-
-IF (LHOOK) CALL DR_HOOK('MODD_TEB_GARDEN_N:TEB_GARDEN_GOTO_PATCH',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE TEB_GARDEN_GOTO_PATCH
-
-SUBROUTINE TEB_GARDEN_INIT(YTEB_GARDEN,KPATCH)
-TYPE(TEB_GARDEN_t), INTENT(INOUT) :: YTEB_GARDEN
-INTEGER, INTENT(IN) :: KPATCH
-INTEGER :: JP
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_N:TEB_GARDEN_INIT",0,ZHOOK_HANDLE)
- ALLOCATE(YTEB_GARDEN%ALP(KPATCH))
- YTEB_GARDEN%CUR => YTEB_GARDEN%ALP(1)
-DO JP=1,KPATCH
- NULLIFY(YTEB_GARDEN%ALP(JP)%XWR)
- NULLIFY(YTEB_GARDEN%ALP(JP)%XTG)
- NULLIFY(YTEB_GARDEN%ALP(JP)%XWG)
- NULLIFY(YTEB_GARDEN%ALP(JP)%XWGI)
- NULLIFY(YTEB_GARDEN%ALP(JP)%XRESA)
- NULLIFY(YTEB_GARDEN%ALP(JP)%XAN)
- NULLIFY(YTEB_GARDEN%ALP(JP)%XANDAY)
- NULLIFY(YTEB_GARDEN%ALP(JP)%XANFM)
- NULLIFY(YTEB_GARDEN%ALP(JP)%XLE)
- NULLIFY(YTEB_GARDEN%ALP(JP)%XFAPARC)
- NULLIFY(YTEB_GARDEN%ALP(JP)%XFAPIRC)
- NULLIFY(YTEB_GARDEN%ALP(JP)%XLAI_EFFC)
- NULLIFY(YTEB_GARDEN%ALP(JP)%XMUS)
- NULLIFY(YTEB_GARDEN%ALP(JP)%XRESP_BIOMASS)
- NULLIFY(YTEB_GARDEN%ALP(JP)%XBIOMASS)
- NULLIFY(YTEB_GARDEN%ALP(JP)%XPSNG)
- NULLIFY(YTEB_GARDEN%ALP(JP)%XPSNV)
- NULLIFY(YTEB_GARDEN%ALP(JP)%XPSNV_A)
- NULLIFY(YTEB_GARDEN%ALP(JP)%XPSN)
- NULLIFY(YTEB_GARDEN%ALP(JP)%XSNOWFREE_ALB)
- NULLIFY(YTEB_GARDEN%ALP(JP)%XSNOWFREE_ALB_VEG)
- NULLIFY(YTEB_GARDEN%ALP(JP)%XSNOWFREE_ALB_SOIL)
-ENDDO
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_GARDEN_N:TEB_GARDEN_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE TEB_GARDEN_INIT
-
-
-
-END MODULE MODD_TEB_GARDEN_n
diff --git a/src/SURFEX/modd_teb_greenroof_optionn.F90 b/src/SURFEX/modd_teb_greenroof_optionn.F90
deleted file mode 100644
index 9a1e17e0e19ad5670f21daf691c2717974f0017c..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_teb_greenroof_optionn.F90
+++ /dev/null
@@ -1,136 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-!##################
-MODULE MODD_TEB_GREENROOF_OPTION_n
-!##################
-!
-!!**** *MODD_TEB_GREENROOF - declaration of ISBA scheme packed surface parameters for urban green roofs
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! A. Lemonsu *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 09/2009
-!! C. de Munck 06/2011
-!! V. Masson 06/2013 splits module in 4
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_TYPE_SNOW
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-
-
-
-TYPE TEB_GREENROOF_OPTIONS_t
-!-------------------------------------------------------------------------------
-!
-! type of initialization : from cover types (ecoclimap) or parameters prescribed
-!
- LOGICAL :: LPAR_GREENROOF ! T: parameters computed from ecoclimap
-! ! F: they are read in the file
-!
-! ISBA Scheme Options specific to urban green roofs:
-!
- CHARACTER(LEN=3) :: CISBA_GR ! type of ISBA version ('2-L' = default, '3-L', 'DIF')
- CHARACTER(LEN=4) :: CSCOND_GR ! Thermal conductivity ('DEF '= NP89 implicit method ,
- ! 'PL98' = Peters-Lidard et al. 1998 used for explicit computation of CG)
-!
- LOGICAL :: LTR_ML_GR
-!-------------------------------------------------------------------------------
-!
-! type of initialization of vegetation: from cover types (ecoclimap) or parameters prescribed
-!
- INTEGER :: NLAYER_GR ! number of ground layers
- INTEGER :: NTIME_GR ! number of time data : for VEG, LAI, EMIS, Z0
-!
- INTEGER :: NLAYER_HORT_GR
- INTEGER :: NLAYER_DUN_GR
-!
- REAL, POINTER, DIMENSION(:) :: XSOILGRID_GR ! Soil layer grid as reference for DIF
-!-------------------------------------------------------------------------------
-!
-! - SGH scheme
-!
- CHARACTER(LEN=4) :: CRUNOFF_GR ! surface runoff formulation for green roofs
-! ! 'WSAT'
-! ! 'DT92'
-! ! 'SGH ' Topmodel
-!
-!SGH scheme and vertical hydrology
-!
- CHARACTER(LEN=3) :: CKSAT_GR ! ksat
-! ! 'DEF' = default value
-! ! 'SGH' = profil exponentiel
- CHARACTER(LEN=3) :: CHORT_GR ! Horton runoff
-! ! 'DEF' = no Horton runoff
-! ! 'SGH' = Horton runoff
- LOGICAL :: LSOC_GR ! soil organic carbon effect
-! ! False = default value
-! ! True = SOC profil
-!
-!-------------------------------------------------------------------------------
-!
-! Type of green roof (characterization of green roof structure based on GR vegetation)
-!
- CHARACTER(LEN=5) :: CTYP_GR ! type of green roof
-!
-!-------------------------------------------------------------------------------
-!
-END TYPE TEB_GREENROOF_OPTIONS_t
-
-
-
- CONTAINS
-
-!
-
-
-!
-
-SUBROUTINE TEB_GREENROOF_OPTIONS_INIT(YTEB_GREENROOF_OPTIONS)
-TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: YTEB_GREENROOF_OPTIONS
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_GREENROOF_N:TEB_GREENROOF_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YTEB_GREENROOF_OPTIONS%XSOILGRID_GR)
-YTEB_GREENROOF_OPTIONS%LPAR_GREENROOF=.TRUE.
-YTEB_GREENROOF_OPTIONS%CISBA_GR=' '
-YTEB_GREENROOF_OPTIONS%LTR_ML_GR=.FALSE.
-YTEB_GREENROOF_OPTIONS%LSOC_GR=.FALSE.
-YTEB_GREENROOF_OPTIONS%CRUNOFF_GR=' '
-YTEB_GREENROOF_OPTIONS%CSCOND_GR=' '
-YTEB_GREENROOF_OPTIONS%CKSAT_GR=' '
-YTEB_GREENROOF_OPTIONS%CHORT_GR=' '
-YTEB_GREENROOF_OPTIONS%CTYP_GR=' '
-YTEB_GREENROOF_OPTIONS%NLAYER_GR=0
-YTEB_GREENROOF_OPTIONS%NLAYER_HORT_GR=0
-YTEB_GREENROOF_OPTIONS%NLAYER_DUN_GR=0
-YTEB_GREENROOF_OPTIONS%NTIME_GR=0
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_GREENROOF_N:TEB_GREENROOF_OPTIONS_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE TEB_GREENROOF_OPTIONS_INIT
-
-
-END MODULE MODD_TEB_GREENROOF_OPTION_n
diff --git a/src/SURFEX/modd_teb_greenroof_pgd_evoln.F90 b/src/SURFEX/modd_teb_greenroof_pgd_evoln.F90
deleted file mode 100644
index 6812954b7ee84ed62465d2f2754a8a8c4da3f4c5..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_teb_greenroof_pgd_evoln.F90
+++ /dev/null
@@ -1,107 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-!##################
-MODULE MODD_TEB_GREENROOF_PGD_EVOL_n
-!##################
-!
-!!**** *MODD_TEB_GREENROOF - declaration of ISBA scheme packed surface parameters for urban green roofs
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! A. Lemonsu *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 09/2009
-!! C. de Munck 06/2011
-!! V. Masson 06/2013 splits module in 4
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE TEB_GREENROOF_PGD_EVOL_1P_t
-! - Vegetation: Ags Prognostic (YPHOTO = ('LAI', 'LST', or 'NIT') or prescribed (YPHOTO='NON', 'AGS' or 'LST')
-!
- REAL, POINTER, DIMENSION(:) :: XLAI ! Leaf Area Index (m2/m2)
- REAL, POINTER, DIMENSION(:) :: XVEG ! vegetation cover fraction (-)
- REAL, POINTER, DIMENSION(:) :: XALBNIR ! near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBVIS ! visible albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBUV ! UV albedo (-)
- REAL, POINTER, DIMENSION(:) :: XEMIS ! surface emissivity (-)
- REAL, POINTER, DIMENSION(:) :: XZ0 ! surface roughness length (m)
-!
-END TYPE TEB_GREENROOF_PGD_EVOL_1P_t
-
-TYPE TEB_GREENROOF_PGD_EVOL_t
- !
- TYPE(TEB_GREENROOF_PGD_EVOL_1P_t), POINTER :: ALP(:) => NULL()
- TYPE(TEB_GREENROOF_PGD_EVOL_1P_t), POINTER :: CUR => NULL()
- !
-END TYPE TEB_GREENROOF_PGD_EVOL_t
-
-
-
- CONTAINS
-
-!
-
-
-!
-
-SUBROUTINE TEB_GREENROOF_PGD_EVOL_GOTO_PATCH(YTEB_GREENROOF_PGD_EVOL,KTO_PATCH)
-TYPE(TEB_GREENROOF_PGD_EVOL_t), INTENT(INOUT) :: YTEB_GREENROOF_PGD_EVOL
-INTEGER, INTENT(IN) :: KTO_PATCH
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-! Current patch is set to patch KTO_PATCH
-IF (LHOOK) CALL DR_HOOK('MODD_TEB_GREENROOF_PGD_EVOL_N:TEB_GREENROOF_PGD_EVOL_GOTO_PATCH',0,ZHOOK_HANDLE)
-
-YTEB_GREENROOF_PGD_EVOL%CUR => YTEB_GREENROOF_PGD_EVOL%ALP(KTO_PATCH)
-
-IF (LHOOK) CALL DR_HOOK('MODD_TEB_GREENROOF_PGD_EVOL_N:TEB_GREENROOF_PGD_EVOL_GOTO_PATCH',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE TEB_GREENROOF_PGD_EVOL_GOTO_PATCH
-
-SUBROUTINE TEB_GREENROOF_PGD_EVOL_INIT(YTEB_GREENROOF_PGD_EVOL,KPATCH)
-TYPE(TEB_GREENROOF_PGD_EVOL_t), INTENT(INOUT) :: YTEB_GREENROOF_PGD_EVOL
-INTEGER, INTENT(IN) :: KPATCH
-INTEGER :: JP
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_GREENROOF_N:TEB_GREENROOF_PGD_EVOL_INIT",0,ZHOOK_HANDLE)
- ALLOCATE(YTEB_GREENROOF_PGD_EVOL%ALP(KPATCH))
-YTEB_GREENROOF_PGD_EVOL%CUR => YTEB_GREENROOF_PGD_EVOL%ALP(1)
-DO JP=1,KPATCH
-NULLIFY(YTEB_GREENROOF_PGD_EVOL%ALP(JP)%XALBNIR)
-NULLIFY(YTEB_GREENROOF_PGD_EVOL%ALP(JP)%XALBVIS)
-NULLIFY(YTEB_GREENROOF_PGD_EVOL%ALP(JP)%XALBUV)
-NULLIFY(YTEB_GREENROOF_PGD_EVOL%ALP(JP)%XEMIS)
-NULLIFY(YTEB_GREENROOF_PGD_EVOL%ALP(JP)%XZ0)
-NULLIFY(YTEB_GREENROOF_PGD_EVOL%ALP(JP)%XVEG)
-NULLIFY(YTEB_GREENROOF_PGD_EVOL%ALP(JP)%XLAI)
-ENDDO
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_GREENROOF_N:TEB_GREENROOF_PGD_EVOL_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE TEB_GREENROOF_PGD_EVOL_INIT
-
-
-END MODULE MODD_TEB_GREENROOF_PGD_EVOL_n
diff --git a/src/SURFEX/modd_teb_greenroof_pgdn.F90 b/src/SURFEX/modd_teb_greenroof_pgdn.F90
deleted file mode 100644
index 2866d001b1faadb013b72a0712c9b869081f3e6a..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_teb_greenroof_pgdn.F90
+++ /dev/null
@@ -1,359 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-!##################
-MODULE MODD_TEB_GREENROOF_PGD_n
-!##################
-!
-!!**** *MODD_TEB_GREENROOF - declaration of ISBA scheme packed surface parameters for urban green roofs
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! A. Lemonsu *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 09/2009
-!! C. de Munck 06/2011
-!! V. Masson 06/2013 splits module in 4
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-
-TYPE TEB_GREENROOF_PGD_t
-!-------------------------------------------------------------------------------
-!
-! Mask and number of grid elements containing patches/tiles:
-!
- REAL, POINTER, DIMENSION(:,:) :: XVEGTYPE ! fraction of each vegetation type for
-! ! each grid mesh (-)
-!
-!-------------------------------------------------------------------------------
-!
-! Averaged Surface radiative parameters:
-!
- REAL, POINTER, DIMENSION(:) :: XALBNIR_DRY ! dry soil near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBVIS_DRY ! dry soil visible albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBUV_DRY ! dry soil UV albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBNIR_WET ! wet soil near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBVIS_WET ! wet soil visible albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBUV_WET ! wet soil UV albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBNIR_SOIL ! soil near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBVIS_SOIL ! soil visible albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBUV_SOIL ! soil UV albedo (-)
-!
-!-------------------------------------------------------------------------------
-!
-! Input Parameters, per patch:
-!
-! - vegetation + bare soil:
-!
- REAL, POINTER, DIMENSION(:) :: XZ0_O_Z0H ! ratio of surface roughness lengths
-! ! (momentum to heat) (-)
-
-!
-! - vegetation:
-!
- REAL, POINTER, DIMENSION(:) :: XALBNIR_VEG ! vegetation near-infra-red albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBVIS_VEG ! vegetation visible albedo (-)
- REAL, POINTER, DIMENSION(:) :: XALBUV_VEG ! vegetation UV albedo (-)
-!
-! - vegetation: default option (Jarvis) and general parameters:
-!
- REAL, POINTER, DIMENSION(:) :: XWRMAX_CF ! coefficient for maximum water
- ! interception
- ! storage capacity on the vegetation (-)
- REAL, POINTER, DIMENSION(:) :: XRSMIN ! minimum stomatal resistance (s/m)
- REAL, POINTER, DIMENSION(:) :: XGAMMA ! coefficient for the calculation
- ! of the surface stomatal
- ! resistance
- REAL, POINTER, DIMENSION(:) :: XCV ! vegetation thermal inertia coefficient (K m2/J)
- REAL, POINTER, DIMENSION(:) :: XRGL ! maximum solar radiation
- ! usable in photosynthesis (W/m2)
- REAL, POINTER, DIMENSION(:,:) :: XROOTFRAC ! root fraction profile ('DIF' option)
-!
-!-------------------------------------------------------------------------------
-!
-! - vegetation: Ags parameters ('AGS', 'LAI', 'AST', 'LST', 'NIT', 'NCB' options)
-!
- REAL, POINTER, DIMENSION(:) :: XABC ! abscissa needed for integration
- ! of net assimilation and stomatal
- ! conductance over canopy depth (-)
- REAL, POINTER, DIMENSION(:) :: XPOI ! Gaussian weights for integration
- ! of net assimilation and stomatal
- ! conductance over canopy depth (-)
- REAL, POINTER, DIMENSION(:) :: XBSLAI ! ratio d(biomass)/d(lai) (kg/m2)
- REAL, POINTER, DIMENSION(:) :: XLAIMIN ! minimum LAI (Leaf Area Index) (m2/m2)
- REAL, POINTER, DIMENSION(:) :: XSEFOLD ! e-folding time for senescence (s)
- REAL, POINTER, DIMENSION(:) :: XH_TREE ! height of trees (m)
- REAL, POINTER, DIMENSION(:) :: XANF ! total assimilation over canopy (
- REAL, POINTER, DIMENSION(:) :: XANMAX ! maximum photosynthesis rate (
- REAL, POINTER, DIMENSION(:) :: XFZERO ! ideal value of F, no photo-
- ! respiration or saturation deficit (
- REAL, POINTER, DIMENSION(:) :: XEPSO ! maximum initial quantum use
- ! efficiency (mg J-1 PAR)
- REAL, POINTER, DIMENSION(:) :: XGAMM ! CO2 conpensation concentration (ppm)
- REAL, POINTER, DIMENSION(:) :: XQDGAMM ! Q10 function for CO2 conpensation
- ! concentration (-)
- REAL, POINTER, DIMENSION(:) :: XGMES ! mesophyll conductance (m s-1)
- REAL, POINTER, DIMENSION(:) :: XRE25 ! Ecosystem respiration parameter (kg/kg.m.s-1)
- REAL, POINTER, DIMENSION(:) :: XQDGMES ! Q10 function for mesophyll conductance (-)
- REAL, POINTER, DIMENSION(:) :: XT1GMES ! reference temperature for computing
- ! compensation concentration function for
- ! mesophyll conductance: minimum
- ! temperature (K)
- REAL, POINTER, DIMENSION(:) :: XT2GMES ! reference temperature for computing
- ! compensation concentration function for
- ! mesophyll conductance: maximum
- ! temperature (K)
- REAL, POINTER, DIMENSION(:) :: XAMAX ! leaf photosynthetic capacity (mg m-2 s-1)
- REAL, POINTER, DIMENSION(:) :: XQDAMAX ! Q10 function for leaf photosynthetic
- ! capacity (-)
- REAL, POINTER, DIMENSION(:) :: XT1AMAX ! reference temperature for computing
- ! compensation concentration function for
- ! leaf photosynthetic capacity: minimum
- ! temperature (K)
- REAL, POINTER, DIMENSION(:) :: XT2AMAX ! reference temperature for computing
- ! compensation concentration function for
- ! leaf photosynthetic capacity: maximum
- ! temperature (K)
-!
-!-------------------------------------------------------------------------------
-!
-! - vegetation: Ags Stress parameters ('AST', 'LST', 'NIT', 'NCB' options)
-!
- LOGICAL, POINTER, DIMENSION(:):: LSTRESS ! vegetation response (offensive/defensive)
- REAL, POINTER, DIMENSION(:) :: XF2I ! critical normilized soil water
- ! content for stress parameterisation
- REAL, POINTER, DIMENSION(:) :: XGC ! cuticular conductance (m s-1)
- REAL, POINTER, DIMENSION(:) :: XAH ! coefficients for herbaceous water stress
- ! response (offensive or defensive) (log(mm/s))
- REAL, POINTER, DIMENSION(:) :: XBH ! coefficients for herbaceous water stress
- ! response (offensive or defensive) (-)
- REAL, POINTER, DIMENSION(:) :: XDMAX ! maximum air saturation deficit
- ! tolerate by vegetation (kg/kg)
-!
-!-------------------------------------------------------------------------------
-!
-! - vegetation: Ags Nitrogen-model parameters ('NIT', 'NCB' option)
-!
- REAL, POINTER, DIMENSION(:) :: XCE_NITRO ! leaf aera ratio sensitivity to
- ! nitrogen concentration (m2/kg)
- REAL, POINTER, DIMENSION(:) :: XCF_NITRO ! lethal minimum value of leaf area
- ! ratio (m2/kg)
- REAL, POINTER, DIMENSION(:) :: XCNA_NITRO ! nitrogen concentration of active
- ! biomass (kg/kg)
- REAL, POINTER, DIMENSION(:) :: XBSLAI_NITRO ! biomass/LAI ratio from nitrogen
- ! decline theory (kg/m2)
-!
-!-------------------------------------------------------------------------------
-!
-! - soil: primary parameters
-!
- REAL, POINTER, DIMENSION(:,:) :: XOM_GR ! green roof OM fraction (-)
- REAL, POINTER, DIMENSION(:,:) :: XSAND_GR ! green roof sand fraction of the non-OM part (-)
- REAL, POINTER, DIMENSION(:,:) :: XCLAY_GR ! green roof clay fraction of the non-OM part (-)
- REAL, POINTER, DIMENSION(:) :: XRUNOFFB_GR ! green roof sub-grid surface runoff slope parameter (-)
- REAL, POINTER, DIMENSION(:) :: XWDRAIN_GR ! green roof continuous drainage parameter (-)
- REAL, POINTER, DIMENSION(:) :: XTAUICE ! soil freezing characteristic timescale (s)
- REAL, POINTER, DIMENSION(:) :: XGAMMAT ! 'Force-Restore' timescale when using a
- ! prescribed lower boundary temperature (1/days)
- REAL, POINTER, DIMENSION(:,:) :: XDG ! soil layer thicknesses (m)
- ! NOTE: in Force-Restore mode, the
- ! uppermost layer thickness is superficial
- ! and is only explicitly used for soil
- ! water phase changes (m)
- REAL, POINTER, DIMENSION(:) :: XRUNOFFD ! depth over which sub-grid runoff is
- ! computed: in Force-Restore this is the
- ! total soil column ('2-L'), or root zone
- ! ('3-L'). For the 'DIF' option, it can
- ! be any depth within soil column (m)
-!
- REAL, POINTER, DIMENSION(:,:) :: XSOILWGHT ! ISBA-DIF: weights for vertical
- REAL, POINTER, DIMENSION(:,:) :: XDZG ! soil layers thicknesses (DIF option)
- REAL, POINTER, DIMENSION(:,:) :: XDZDIF ! distance between consecuative layer mid-points (DIF option)
-!
- INTEGER, POINTER, DIMENSION(:) :: NWG_LAYER ! Number of soil moisture layers for DIF
- REAL, POINTER, DIMENSION(:) :: XDROOT ! effective root depth for DIF (m)
- REAL, POINTER, DIMENSION(:) :: XDG2 ! root depth for DIF as 3-L (m)
-!-------------------------------------------------------------------------------
-!
-! - soil: Secondary parameters: hydrology
-!
- REAL, POINTER, DIMENSION(:) :: XC1SAT ! 'Force-Restore' C1 coefficient at
- ! saturation (-)
- REAL, POINTER, DIMENSION(:) :: XC2REF ! 'Force-Restore' reference value of C2 (-)
- REAL, POINTER, DIMENSION(:,:) :: XC3 ! 'Force-Restore' C3 drainage coefficient (m)
- REAL, POINTER, DIMENSION(:) :: XC4B ! 'Force-Restore' sub-surface vertical
- ! diffusion coefficient (slope parameter) (-)
- REAL, POINTER, DIMENSION(:) :: XC4REF ! 'Force-Restore' sub-surface vertical
- ! diffusion coefficient (-)
- REAL, POINTER, DIMENSION(:) :: XACOEF ! 'Force-Restore' surface vertical
- ! diffusion coefficient (-)
- REAL, POINTER, DIMENSION(:) :: XPCOEF ! 'Force-Restore' surface vertical
- ! diffusion coefficient (-)
- REAL, POINTER, DIMENSION(:,:) :: XWFC ! field capacity volumetric water content
- ! profile (m3/m3)
- REAL, POINTER, DIMENSION(:,:) :: XWWILT ! wilting point volumetric water content
- ! profile
- REAL, POINTER, DIMENSION(:,:) :: XWSAT ! porosity profile (m3/m3)
- REAL, POINTER, DIMENSION(:,:) :: XBCOEF ! soil water CH78 b-parameter (-)
- REAL, POINTER, DIMENSION(:,:) :: XCONDSAT ! hydraulic conductivity at saturation (m/s)
- REAL, POINTER, DIMENSION(:,:) :: XMPOTSAT ! matric potential at saturation (m)
-!
- REAL, POINTER, DIMENSION(:) :: XPCPS
- REAL, POINTER, DIMENSION(:) :: XPLVTT
- REAL, POINTER, DIMENSION(:) :: XPLSTT
-!
-!-------------------------------------------------------------------------------
-!
-! - soil: Secondary parameters: thermal
-!
- REAL, POINTER, DIMENSION(:) :: XCGSAT ! soil thermal inertia coefficient at
- ! saturation (K m2/J)
- REAL, POINTER, DIMENSION(:,:) :: XHCAPSOIL ! soil heat capacity (J/K/m3)
- REAL, POINTER, DIMENSION(:,:) :: XCONDDRY ! soil dry thermal conductivity (W/m/K)
- REAL, POINTER, DIMENSION(:,:) :: XCONDSLD ! soil solids thermal conductivity (W/m/K)
- REAL, POINTER, DIMENSION(:) :: XTDEEP ! prescribed deep soil temperature
- ! (optional) (K)
-!
-! - SGH scheme
-!
- REAL, POINTER, DIMENSION(:) :: XD_ICE ! depth of the soil column for the calculation
- ! of the frozen soil fraction (m)
- REAL, POINTER, DIMENSION(:) :: XKSAT_ICE ! hydraulic conductivity at saturation
- ! over frozen area (m s-1)
-!-------------------------------------------------------------------------------
-!
-END TYPE TEB_GREENROOF_PGD_t
-
-
-
-
- CONTAINS
-
-
-
-!
-
-
-!
-
-SUBROUTINE TEB_GREENROOF_PGD_INIT(YTEB_GREENROOF_PGD)
-TYPE(TEB_GREENROOF_PGD_t), INTENT(INOUT) :: YTEB_GREENROOF_PGD
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_GREENROOF_N:TEB_GREENROOF_PGD_INIT",0,ZHOOK_HANDLE)
-NULLIFY(YTEB_GREENROOF_PGD%XVEGTYPE)
-NULLIFY(YTEB_GREENROOF_PGD%XALBNIR_DRY)
-NULLIFY(YTEB_GREENROOF_PGD%XALBVIS_DRY)
-NULLIFY(YTEB_GREENROOF_PGD%XALBUV_DRY)
-NULLIFY(YTEB_GREENROOF_PGD%XALBNIR_WET)
-NULLIFY(YTEB_GREENROOF_PGD%XALBVIS_WET)
-NULLIFY(YTEB_GREENROOF_PGD%XALBUV_WET)
-NULLIFY(YTEB_GREENROOF_PGD%XALBNIR_SOIL)
-NULLIFY(YTEB_GREENROOF_PGD%XALBVIS_SOIL)
-NULLIFY(YTEB_GREENROOF_PGD%XALBUV_SOIL)
-NULLIFY(YTEB_GREENROOF_PGD%XZ0_O_Z0H)
-NULLIFY(YTEB_GREENROOF_PGD%XALBNIR_VEG)
-NULLIFY(YTEB_GREENROOF_PGD%XALBVIS_VEG)
-NULLIFY(YTEB_GREENROOF_PGD%XALBUV_VEG)
-NULLIFY(YTEB_GREENROOF_PGD%XWRMAX_CF)
-NULLIFY(YTEB_GREENROOF_PGD%XRSMIN)
-NULLIFY(YTEB_GREENROOF_PGD%XGAMMA)
-NULLIFY(YTEB_GREENROOF_PGD%XCV)
-NULLIFY(YTEB_GREENROOF_PGD%XRGL)
-NULLIFY(YTEB_GREENROOF_PGD%XROOTFRAC)
-NULLIFY(YTEB_GREENROOF_PGD%XABC)
-NULLIFY(YTEB_GREENROOF_PGD%XPOI)
-NULLIFY(YTEB_GREENROOF_PGD%XBSLAI)
-NULLIFY(YTEB_GREENROOF_PGD%XLAIMIN)
-NULLIFY(YTEB_GREENROOF_PGD%XSEFOLD)
-NULLIFY(YTEB_GREENROOF_PGD%XH_TREE)
-NULLIFY(YTEB_GREENROOF_PGD%XANF)
-NULLIFY(YTEB_GREENROOF_PGD%XANMAX)
-NULLIFY(YTEB_GREENROOF_PGD%XFZERO)
-NULLIFY(YTEB_GREENROOF_PGD%XEPSO)
-NULLIFY(YTEB_GREENROOF_PGD%XGAMM)
-NULLIFY(YTEB_GREENROOF_PGD%XQDGAMM)
-NULLIFY(YTEB_GREENROOF_PGD%XGMES)
-NULLIFY(YTEB_GREENROOF_PGD%XRE25)
-NULLIFY(YTEB_GREENROOF_PGD%XQDGMES)
-NULLIFY(YTEB_GREENROOF_PGD%XT1GMES)
-NULLIFY(YTEB_GREENROOF_PGD%XT2GMES)
-NULLIFY(YTEB_GREENROOF_PGD%XAMAX)
-NULLIFY(YTEB_GREENROOF_PGD%XQDAMAX)
-NULLIFY(YTEB_GREENROOF_PGD%XT1AMAX)
-NULLIFY(YTEB_GREENROOF_PGD%XT2AMAX)
-NULLIFY(YTEB_GREENROOF_PGD%LSTRESS)
-NULLIFY(YTEB_GREENROOF_PGD%XF2I)
-NULLIFY(YTEB_GREENROOF_PGD%XGC)
-NULLIFY(YTEB_GREENROOF_PGD%XAH)
-NULLIFY(YTEB_GREENROOF_PGD%XBH)
-NULLIFY(YTEB_GREENROOF_PGD%XDMAX)
-NULLIFY(YTEB_GREENROOF_PGD%XCE_NITRO)
-NULLIFY(YTEB_GREENROOF_PGD%XCF_NITRO)
-NULLIFY(YTEB_GREENROOF_PGD%XCNA_NITRO)
-NULLIFY(YTEB_GREENROOF_PGD%XBSLAI_NITRO)
-NULLIFY(YTEB_GREENROOF_PGD%XOM_GR)
-NULLIFY(YTEB_GREENROOF_PGD%XSAND_GR)
-NULLIFY(YTEB_GREENROOF_PGD%XCLAY_GR)
-NULLIFY(YTEB_GREENROOF_PGD%XRUNOFFB_GR)
-NULLIFY(YTEB_GREENROOF_PGD%XWDRAIN_GR)
-NULLIFY(YTEB_GREENROOF_PGD%XTAUICE)
-NULLIFY(YTEB_GREENROOF_PGD%XGAMMAT)
-NULLIFY(YTEB_GREENROOF_PGD%XDG)
-NULLIFY(YTEB_GREENROOF_PGD%XRUNOFFD)
-NULLIFY(YTEB_GREENROOF_PGD%XSOILWGHT)
-NULLIFY(YTEB_GREENROOF_PGD%XDZG)
-NULLIFY(YTEB_GREENROOF_PGD%XDZDIF)
-NULLIFY(YTEB_GREENROOF_PGD%NWG_LAYER)
-NULLIFY(YTEB_GREENROOF_PGD%XDROOT)
-NULLIFY(YTEB_GREENROOF_PGD%XDG2)
-NULLIFY(YTEB_GREENROOF_PGD%XPCPS)
-NULLIFY(YTEB_GREENROOF_PGD%XPLVTT)
-NULLIFY(YTEB_GREENROOF_PGD%XPLSTT)
-NULLIFY(YTEB_GREENROOF_PGD%XC1SAT)
-NULLIFY(YTEB_GREENROOF_PGD%XC2REF)
-NULLIFY(YTEB_GREENROOF_PGD%XC3)
-NULLIFY(YTEB_GREENROOF_PGD%XC4B)
-NULLIFY(YTEB_GREENROOF_PGD%XC4REF)
-NULLIFY(YTEB_GREENROOF_PGD%XACOEF)
-NULLIFY(YTEB_GREENROOF_PGD%XPCOEF)
-NULLIFY(YTEB_GREENROOF_PGD%XWFC)
-NULLIFY(YTEB_GREENROOF_PGD%XWWILT)
-NULLIFY(YTEB_GREENROOF_PGD%XWSAT)
-NULLIFY(YTEB_GREENROOF_PGD%XBCOEF)
-NULLIFY(YTEB_GREENROOF_PGD%XCONDSAT)
-NULLIFY(YTEB_GREENROOF_PGD%XMPOTSAT)
-NULLIFY(YTEB_GREENROOF_PGD%XCGSAT)
-NULLIFY(YTEB_GREENROOF_PGD%XHCAPSOIL)
-NULLIFY(YTEB_GREENROOF_PGD%XCONDDRY)
-NULLIFY(YTEB_GREENROOF_PGD%XCONDSLD)
-NULLIFY(YTEB_GREENROOF_PGD%XTDEEP)
-NULLIFY(YTEB_GREENROOF_PGD%XD_ICE)
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_GREENROOF_N:TEB_GREENROOF_PGD_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE TEB_GREENROOF_PGD_INIT
-
-
-END MODULE MODD_TEB_GREENROOF_PGD_n
diff --git a/src/SURFEX/modd_teb_greenroofn.F90 b/src/SURFEX/modd_teb_greenroofn.F90
deleted file mode 100644
index 289ca229c0ef5c9e9d440eabd1ad5561a38c1130..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_teb_greenroofn.F90
+++ /dev/null
@@ -1,172 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-!##################
-MODULE MODD_TEB_GREENROOF_n
-!##################
-!
-!!**** *MODD_TEB_GREENROOF - declaration of ISBA scheme packed surface parameters for urban green roofs
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! A. Lemonsu *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 09/2009
-!! C. de Munck 06/2011
-!! V. Masson 06/2013 splits module in 4
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_TYPE_SNOW
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE TEB_GREENROOF_1P_t
-!-------------------------------------------------------------------------------
-!
-! Prognostic variables:
-!
-! - Snow Cover:
-!
- TYPE(SURF_SNOW) :: TSNOW ! snow state:
- ! scheme type/option (-)
- ! number of layers (-)
- ! snow (& liq. water) content (kg/m2)
- ! heat content (J/m2)
- ! temperature (K)
- ! density (kg m-3)
-!
-! - Soil and vegetation heat and water:
-!
- REAL, POINTER, DIMENSION(:) :: XWR ! liquid water retained on the
- ! foliage of the vegetation
- ! canopy (kg/m2)
- REAL, POINTER, DIMENSION(:,:) :: XTG ! surface and sub-surface soil
- ! temperature profile (K)
- REAL, POINTER, DIMENSION(:,:) :: XWG ! soil volumetric water content profile (m3/m3)
- REAL, POINTER, DIMENSION(:,:) :: XWGI ! soil liquid water equivalent volumetric
- ! ice content profile (m3/m3)
- REAL, POINTER, DIMENSION(:) :: XRESA ! aerodynamic resistance (s/m)
-!
-
-! - Vegetation: Ags Prognostic (YPHOTO = 'AGS', 'LAI', 'AST', 'LST', 'NIT', 'NCB')
-!
- REAL, POINTER, DIMENSION(:) :: XAN ! net CO2 assimilation (mg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XANDAY ! daily net CO2 assimilation (mg/m2)
- REAL, POINTER, DIMENSION(:) :: XANFM ! maximum leaf assimilation (mg/m2/s)
- REAL, POINTER, DIMENSION(:) :: XLE ! evapotranspiration (W/m2)
- REAL, POINTER, DIMENSION(:) :: XFAPARC ! Fapar of vegetation (cumul)
- REAL, POINTER, DIMENSION(:) :: XFAPIRC ! Fapir of vegetation (cumul)
- REAL, POINTER, DIMENSION(:) :: XLAI_EFFC ! Effective LAI (cumul)
- REAL, POINTER, DIMENSION(:) :: XMUS ! cos zenithal angle (cumul)
-!
-! - Vegetation: Ags Prognostic (YPHOTO = 'NIT', 'NCB')
-!
- REAL, POINTER, DIMENSION(:,:) :: XRESP_BIOMASS ! daily cumulated respiration of
- ! biomass (kg/m2/s)
- REAL, POINTER, DIMENSION(:,:) :: XBIOMASS ! biomass of previous day (kg/m2)
-!
-! - SGH scheme
-!
- REAL, POINTER, DIMENSION(:) :: XKSAT_ICE ! hydraulic conductivity at saturation
- ! over frozen area (m s-1)
-!-------------------------------------------------------------------------------
-!
-! - Snow and flood fractions and total albedo at time t:
-!
- REAL, POINTER, DIMENSION(:) :: XPSNG ! Snow fraction over ground
- REAL, POINTER, DIMENSION(:) :: XPSNV ! Snow fraction over vegetation
- REAL, POINTER, DIMENSION(:) :: XPSNV_A ! Snow fraction over vegetation
- REAL, POINTER, DIMENSION(:) :: XPSN ! Total Snow fraction
-!
- REAL, POINTER, DIMENSION(:) :: XSNOWFREE_ALB ! snow free albedo (-)
- REAL, POINTER, DIMENSION(:) :: XSNOWFREE_ALB_VEG ! snow free albedo for vegetation (-)
- REAL, POINTER, DIMENSION(:) :: XSNOWFREE_ALB_SOIL ! snow free albedo for soil (-)
-!
-!-------------------------------------------------------------------------------
-!
-END TYPE TEB_GREENROOF_1P_t
-!
-TYPE TEB_GREENROOF_t
- !
- TYPE(TEB_GREENROOF_1P_t), POINTER :: ALP(:) => NULL()
- TYPE(TEB_GREENROOF_1P_t), POINTER :: CUR => NULL()
- !
-END TYPE TEB_GREENROOF_t
-!
- CONTAINS
-!
-!
-SUBROUTINE TEB_GREENROOF_GOTO_PATCH(YTEB_GREENROOF,KTO_PATCH)
- TYPE(TEB_GREENROOF_t), INTENT(INOUT) :: YTEB_GREENROOF
-INTEGER, INTENT(IN) :: KTO_PATCH
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-! Current patch is set to patch KTO_PATCH
-IF (LHOOK) CALL DR_HOOK('MODD_TEB_GREENROOF_N:TEB_GREENROOF_GOTO_PATCH',0,ZHOOK_HANDLE)
-
-YTEB_GREENROOF%CUR => YTEB_GREENROOF%ALP(KTO_PATCH)
-
-IF (LHOOK) CALL DR_HOOK('MODD_TEB_GREENROOF_N:TEB_GREENROOF_GOTO_PATCH',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE TEB_GREENROOF_GOTO_PATCH
-!
-SUBROUTINE TEB_GREENROOF_INIT(YTEB_GREENROOF,KPATCH)
-TYPE(TEB_GREENROOF_t), INTENT(INOUT) :: YTEB_GREENROOF
-INTEGER, INTENT(IN) :: KPATCH
-INTEGER :: JP
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_GREENROOF_N:TEB_GREENROOF_INIT",0,ZHOOK_HANDLE)
- ALLOCATE(YTEB_GREENROOF%ALP(KPATCH))
- YTEB_GREENROOF%CUR => YTEB_GREENROOF%ALP(1)
-DO JP=1,KPATCH
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XWR)
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XTG)
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XWG)
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XWGI)
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XRESA)
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XAN)
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XANDAY)
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XANFM)
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XLE)
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XFAPARC)
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XFAPIRC)
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XLAI_EFFC)
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XMUS)
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XRESP_BIOMASS)
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XBIOMASS)
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XKSAT_ICE)
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XPSNG)
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XPSNV)
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XPSNV_A)
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XPSN)
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XSNOWFREE_ALB)
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XSNOWFREE_ALB_VEG)
- NULLIFY(YTEB_GREENROOF%ALP(JP)%XSNOWFREE_ALB_SOIL)
-ENDDO
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_GREENROOF_N:TEB_GREENROOF_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE TEB_GREENROOF_INIT
-
-
-END MODULE MODD_TEB_GREENROOF_n
diff --git a/src/SURFEX/modd_teb_gridn.F90 b/src/SURFEX/modd_teb_gridn.F90
deleted file mode 100644
index 1a584ff7e3ce432ae36ddc5bd240584e452aa0c3..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_teb_gridn.F90
+++ /dev/null
@@ -1,88 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ##################
- MODULE MODD_TEB_GRID_n
-! ##################
-!
-!!**** *MODD_TEB_GRID - declaration of TEB grid
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE TEB_GRID_t
-!-------------------------------------------------------------------------------
-!
-! Grid definition
-!
- INTEGER :: NDIM ! number of points
- CHARACTER(LEN=10) :: CGRID ! grid type
-! ! "NONE " : no grid computations
-! ! "CONF PROJ " : conformal projection
-! ! "SURF ATM " : town points of surf. atm. grid
-!
- REAL, POINTER, DIMENSION(:) :: XGRID_PAR ! lits of parameters used to define the grid
-! ! (depends on value of CGRID)
-!
-!-------------------------------------------------------------------------------
-!
-! General surface parameters:
-!
- REAL, POINTER, DIMENSION(:) :: XLAT ! latitude (degrees +North) (-)
- REAL, POINTER, DIMENSION(:) :: XLON ! longitude (degrees +East) (-)
- REAL, POINTER, DIMENSION(:) :: XMESH_SIZE ! mesh size (m2)
-!-------------------------------------------------------------------------------
-!
-
-END TYPE TEB_GRID_t
-
-
-
- CONTAINS
-
-!
-
-
-
-
-SUBROUTINE TEB_GRID_INIT(YTEB_GRID)
-TYPE(TEB_GRID_t), INTENT(INOUT) :: YTEB_GRID
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_GRID_N:TEB_GRID_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YTEB_GRID%XGRID_PAR)
- NULLIFY(YTEB_GRID%XLAT)
- NULLIFY(YTEB_GRID%XLON)
- NULLIFY(YTEB_GRID%XMESH_SIZE)
-YTEB_GRID%NDIM=0
-YTEB_GRID%CGRID=' '
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_GRID_N:TEB_GRID_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE TEB_GRID_INIT
-
-
-END MODULE MODD_TEB_GRID_n
diff --git a/src/SURFEX/modd_teb_irrign.F90 b/src/SURFEX/modd_teb_irrign.F90
index da5f476388fc3982a2ef4ee2c9af3bbefc0eaa20..f31a19c02d181e032a6cec7a4a6c8f3b2c2a2cc7 100644
--- a/src/SURFEX/modd_teb_irrign.F90
+++ b/src/SURFEX/modd_teb_irrign.F90
@@ -63,7 +63,7 @@ END TYPE TEB_IRRIG_t
- CONTAINS
+CONTAINS
!
diff --git a/src/SURFEX/modd_teb_optionn.F90 b/src/SURFEX/modd_teb_optionn.F90
index 223499235f7494a4bb01da0549e5769c5b3ac7f8..41f86b2ae788b18fd1300ca3a3e04796d2717ec9 100644
--- a/src/SURFEX/modd_teb_optionn.F90
+++ b/src/SURFEX/modd_teb_optionn.F90
@@ -114,7 +114,7 @@ END TYPE TEB_OPTIONS_t
- CONTAINS
+CONTAINS
!----------------------------------------------------------------------------
!
diff --git a/src/SURFEX/modd_teb_paneln.F90 b/src/SURFEX/modd_teb_paneln.F90
index bbf4ad907ffafa5c35bc2bbdf2d542d7dd49a318..699f8ad6fd8db8961b9a6d0eeed3cef30f038756 100644
--- a/src/SURFEX/modd_teb_paneln.F90
+++ b/src/SURFEX/modd_teb_paneln.F90
@@ -49,7 +49,7 @@ END TYPE TEB_PANEL_t
- CONTAINS
+CONTAINS
!
diff --git a/src/SURFEX/modd_teb_vegn.F90 b/src/SURFEX/modd_teb_vegn.F90
deleted file mode 100644
index a7f5a01c6b775aff3a12967cfc1f65b1e8394690..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_teb_vegn.F90
+++ /dev/null
@@ -1,204 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ################
- MODULE MODD_TEB_VEG_n
-! ################
-!
-!!**** *MODD_TEB_VEG_n - declaration of options and parameters for urban vegetation
-!! (for parameters common to all types of urban vegetation)
-!!
-!! PURPOSE
-!! -------
-! Declaration of options and surface parameters
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! C. de Munck & A. Lemonsu *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/2012
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-
-TYPE TEB_VEG_OPTIONS_t
-! ISBA options common of all types of urban vegetation
-!
-!
- LOGICAL :: LCANOPY_DRAG ! T: drag activated in SBL scheme within the canopy
- ! F: no drag activated in SBL atmospheric layers
-!
- LOGICAL :: LVEGUPD ! T = update vegetation parameters every decade
- ! F = keep vegetation parameters constant in time
-!
- LOGICAL :: LTR_ML
-!
- LOGICAL :: LNITRO_DILU ! nitrogen dilution fct of CO2 (Calvet et al. 2008)
-!-------------------------------------------------------------------------------
-!
- CHARACTER(LEN=3) :: CISBA ! type of ISBA version:
- ! '2-L' (default)
- ! '3-L'
- ! 'DIF'
-!
- CHARACTER(LEN=4) :: CROUGH ! type of roughness length
- ! 'Z01D'
- ! 'Z04D'
-!
- CHARACTER(LEN=4) :: CPEDOTF ! NOTE: Only used when HISBA = DIF
- ! 'CH78' = Clapp and Hornberger 1978 for BC (Default)
- ! 'CO84' = Cosby et al. 1988 for BC
- ! 'CP88' = Carsel and Parrish 1988 for VG
- ! 'WO99' = Wosten et al. 1999 for VG
-!
- CHARACTER(LEN=3) :: CPHOTO ! type of photosynthesis
- ! 'NON'
- ! 'AGS'
- ! 'LAI'
- ! 'LST'
- ! 'AST'
- ! 'NIT'
- ! 'NCB'
-!
- CHARACTER(LEN=4) :: CALBEDO ! albedo type
- ! 'DRY '
- ! 'EVOL'
- ! 'WET '
- ! 'USER'
-!
- CHARACTER(LEN=4) :: CSCOND ! Thermal conductivity
- ! 'DEF ' = DEFault: NP89 implicit method
- ! 'PL98' = Peters-Lidard et al. 1998 used
- ! for explicit computation of CG
-!
- CHARACTER(LEN=4) :: CC1DRY ! C1 formulation for dry soils
- ! 'DEF ' = DEFault: Giard-Bazile formulation
- ! 'GB93' = Giordani 1993, Braud 1993
- !discontinuous at WILT
-!
- CHARACTER(LEN=3) :: CSOILFRZ ! soil freezing-physics option
- ! 'DEF' = Default (Boone et al. 2000;
- ! Giard and Bazile 2000)
- ! 'LWT' = Phase changes as above,
- ! but relation between unfrozen
- ! water and temperature considered
-! NOTE that when using the YISBA='DIF' multi-layer soil option,
-! the 'LWT' method is used. It is only an option
-! when using the force-restore soil method ('2-L' or '3-L')
-!
- CHARACTER(LEN=4) :: CDIFSFCOND ! Mulch effects
- ! 'MLCH' = include the insulating effect of
- ! leaf litter/mulch on the surf. thermal cond.
- ! 'DEF ' = no mulch effect
-! NOTE: Only used when YISBA = DIF
-!
- CHARACTER(LEN=3) :: CSNOWRES ! Turbulent exchanges over snow
- ! 'DEF' = Default: Louis (ISBA)
- ! 'RIL' = Maximum Richardson number limit
- ! for stable conditions ISBA-SNOW3L
- ! turbulent exchange option
-!
- CHARACTER(LEN=3) :: CRESPSL ! Soil respiration
- ! 'DEF' = Default: Norman (1992)
- ! 'PRM' = New Parameterization
- ! 'CNT' = CENTURY model (Gibelin 2007)
-!
- CHARACTER(LEN=3) :: CCPSURF ! specific heat at surface
- ! 'DRY' = default value (dry Cp)
- ! 'HUM' = Cp as a fct of specific humidity
-! - SGH scheme and vertical hydrology
-!
- CHARACTER(LEN=4) :: CRUNOFF ! surface runoff formulation
- ! 'WSAT'
- ! 'DT92'
- ! 'SGH ' Topmodel
-!
- CHARACTER(LEN=3) :: CKSAT ! ksat
- ! 'DEF' = default value
- ! 'SGH' = profil exponentiel
-!
- LOGICAL :: LSOC ! soil organic carbon effect
-! ! FALSE = default value
-! ! TRUE = SOC profil
-!
- CHARACTER(LEN=3) :: CRAIN ! Rainfall spatial distribution
- ! 'DEF' = No rainfall spatial distribution
- ! 'SGH' = Rainfall exponential spatial distribution
-!
- CHARACTER(LEN=3) :: CHORT ! Horton runoff
- ! 'DEF' = no Horton runoff
- ! 'SGH' = Horton runoff
-!
-! -----------------------------------------------------------------------------------------------------------
-!
- INTEGER :: NNBIOMASS ! number of biomass pools
- REAL :: XCGMAX ! maximum soil heat capacity (=2.E-5)
- REAL :: XCDRAG ! drag coefficient in canopy
- REAL :: XTSTEP ! time step
-!
-END TYPE TEB_VEG_OPTIONS_t
-
-
-
- CONTAINS
-!----------------------------------------------------------------------------
-
-!
-
-
-
-
-SUBROUTINE TEB_VEG_OPTIONS_INIT(YTEB_VEG_OPTIONS)
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: YTEB_VEG_OPTIONS
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_VEG_N:TEB_VEG_OPTIONS_INIT",0,ZHOOK_HANDLE)
-YTEB_VEG_OPTIONS%LCANOPY_DRAG=.FALSE.
-YTEB_VEG_OPTIONS%LVEGUPD=.FALSE.
-YTEB_VEG_OPTIONS%LNITRO_DILU=.FALSE.
-YTEB_VEG_OPTIONS%LTR_ML=.FALSE.
-YTEB_VEG_OPTIONS%CISBA=' '
-YTEB_VEG_OPTIONS%CROUGH=' '
-YTEB_VEG_OPTIONS%CSCOND=' '
-YTEB_VEG_OPTIONS%CPEDOTF=' '
-YTEB_VEG_OPTIONS%CPHOTO=' '
-YTEB_VEG_OPTIONS%CALBEDO=' '
-YTEB_VEG_OPTIONS%CC1DRY=' '
-YTEB_VEG_OPTIONS%CSOILFRZ=' '
-YTEB_VEG_OPTIONS%CDIFSFCOND=' '
-YTEB_VEG_OPTIONS%CSNOWRES=' '
-YTEB_VEG_OPTIONS%CRESPSL=' '
-YTEB_VEG_OPTIONS%CCPSURF=' '
-YTEB_VEG_OPTIONS%CRUNOFF=' '
-YTEB_VEG_OPTIONS%CKSAT=' '
-YTEB_VEG_OPTIONS%LSOC=.FALSE.
-YTEB_VEG_OPTIONS%CRAIN=' '
-YTEB_VEG_OPTIONS%CHORT=' '
-YTEB_VEG_OPTIONS%NNBIOMASS=0
-YTEB_VEG_OPTIONS%XCGMAX=0.
-YTEB_VEG_OPTIONS%XCDRAG=0.
-YTEB_VEG_OPTIONS%XTSTEP=0.
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_VEG_N:TEB_VEG_OPTIONS_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE TEB_VEG_OPTIONS_INIT
-
-
-!----------------------------------------------------------------------------
-
-END MODULE MODD_TEB_VEG_n
diff --git a/src/SURFEX/modd_tebn.F90 b/src/SURFEX/modd_tebn.F90
index f7e25f3791f44e2d3d98abb1fc8b3bc8416b4207..62cd4aaa0d580bc83cc7528de7ca35c7ed3d7a91 100644
--- a/src/SURFEX/modd_tebn.F90
+++ b/src/SURFEX/modd_tebn.F90
@@ -43,7 +43,7 @@ USE PARKIND1 ,ONLY : JPRB
IMPLICIT NONE
!--------------------------------------------------------------------------
-TYPE TEB_1P_t
+TYPE TEB_t
! TEB scheme option
!
! Geometric Parameters:
@@ -167,110 +167,102 @@ TYPE TEB_1P_t
! ! temperature (K)
! ! density (kg m-3)
!
-END TYPE TEB_1P_t
+END TYPE TEB_t
-TYPE TEB_t
+TYPE TEB_NP_t
!
- TYPE(TEB_1P_t), POINTER :: ALP(:) => NULL()
- TYPE(TEB_1P_t), POINTER :: CUR => NULL()
+ TYPE(TEB_t), POINTER :: AL(:) => NULL()
!
-END TYPE TEB_t
+END TYPE TEB_NP_t
!
-
-
- CONTAINS
+CONTAINS
!----------------------------------------------------------------------------
!
-!
-
-
-!
-!
-SUBROUTINE TEB_GOTO_PATCH(YTEB,KTO_PATCH)
+SUBROUTINE TEB_INIT(YTEB)
TYPE(TEB_t), INTENT(INOUT) :: YTEB
-INTEGER, INTENT(IN) :: KTO_PATCH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_TEB_N:TEB_INIT",0,ZHOOK_HANDLE)
+ NULLIFY(YTEB%XROAD_DIR)
+ NULLIFY(YTEB%XGARDEN)
+ NULLIFY(YTEB%XGREENROOF)
+ NULLIFY(YTEB%XBLD)
+ NULLIFY(YTEB%XROAD)
+ NULLIFY(YTEB%XCAN_HW_RATIO)
+ NULLIFY(YTEB%XBLD_HEIGHT)
+ NULLIFY(YTEB%XWALL_O_HOR)
+ NULLIFY(YTEB%XROAD_O_GRND)
+ NULLIFY(YTEB%XGARDEN_O_GRND)
+ NULLIFY(YTEB%XWALL_O_GRND)
+ NULLIFY(YTEB%XWALL_O_BLD)
+ NULLIFY(YTEB%XZ0_TOWN)
+ NULLIFY(YTEB%XSVF_ROAD)
+ NULLIFY(YTEB%XSVF_GARDEN)
+ NULLIFY(YTEB%XSVF_WALL)
+ NULLIFY(YTEB%XALB_ROOF)
+ NULLIFY(YTEB%XEMIS_ROOF)
+ NULLIFY(YTEB%XHC_ROOF)
+ NULLIFY(YTEB%XTC_ROOF)
+ NULLIFY(YTEB%XD_ROOF)
+ NULLIFY(YTEB%XALB_ROAD)
+ NULLIFY(YTEB%XEMIS_ROAD)
+ NULLIFY(YTEB%XHC_ROAD)
+ NULLIFY(YTEB%XTC_ROAD)
+ NULLIFY(YTEB%XD_ROAD)
+ NULLIFY(YTEB%XALB_WALL)
+ NULLIFY(YTEB%XEMIS_WALL)
+ NULLIFY(YTEB%XHC_WALL)
+ NULLIFY(YTEB%XTC_WALL)
+ NULLIFY(YTEB%XD_WALL)
+ NULLIFY(YTEB%XH_TRAFFIC)
+ NULLIFY(YTEB%XLE_TRAFFIC)
+ NULLIFY(YTEB%XH_INDUSTRY)
+ NULLIFY(YTEB%XLE_INDUSTRY)
+ NULLIFY(YTEB%XTI_ROAD)
+ NULLIFY(YTEB%XWS_ROOF)
+ NULLIFY(YTEB%XWS_ROAD)
+ NULLIFY(YTEB%XT_ROOF)
+ NULLIFY(YTEB%XT_ROAD)
+ NULLIFY(YTEB%XT_WALL_A)
+ NULLIFY(YTEB%XT_WALL_B)
+ NULLIFY(YTEB%XAC_ROOF)
+ NULLIFY(YTEB%XAC_ROAD)
+ NULLIFY(YTEB%XAC_WALL)
+ NULLIFY(YTEB%XAC_TOP)
+ NULLIFY(YTEB%XAC_ROOF_WAT)
+ NULLIFY(YTEB%XAC_ROAD_WAT)
+ NULLIFY(YTEB%XQSAT_ROOF)
+ NULLIFY(YTEB%XQSAT_ROAD)
+ NULLIFY(YTEB%XDELT_ROOF)
+ NULLIFY(YTEB%XDELT_ROAD)
+ NULLIFY(YTEB%XT_CANYON)
+ NULLIFY(YTEB%XQ_CANYON)
+ NULLIFY(YTEB%XROUGH_ROOF)
+ NULLIFY(YTEB%XROUGH_WALL)
+ NULLIFY(YTEB%XRESIDENTIAL)
+YTEB%XDT_RES=0.
+YTEB%XDT_OFF=0.
+IF (LHOOK) CALL DR_HOOK("MODD_TEB_N:TEB_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE TEB_INIT
!
-! Current patch is set to patch KTO_PATCH
-IF (LHOOK) CALL DR_HOOK('MODD_TEB_N:TEB_GOTO_PATCH',0,ZHOOK_HANDLE)
-
-YTEB%CUR => YTEB%ALP(KTO_PATCH)
-
-IF (LHOOK) CALL DR_HOOK('MODD_TEB_N:TEB_GOTO_PATCH',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE TEB_GOTO_PATCH
-!
-SUBROUTINE TEB_INIT(YTEB,KPATCH)
-TYPE(TEB_t), INTENT(INOUT) :: YTEB
+SUBROUTINE TEB_NP_INIT(YNTEB,KPATCH)
+TYPE(TEB_NP_t), INTENT(INOUT) :: YNTEB
INTEGER, INTENT(IN) :: KPATCH
INTEGER :: JP
REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_N:TEB_INIT",0,ZHOOK_HANDLE)
- ALLOCATE(YTEB%ALP(KPATCH))
- YTEB%CUR => YTEB%ALP(1)
-DO JP=1,KPATCH
- NULLIFY(YTEB%ALP(JP)%XROAD_DIR)
- NULLIFY(YTEB%ALP(JP)%XGARDEN)
- NULLIFY(YTEB%ALP(JP)%XGREENROOF)
- NULLIFY(YTEB%ALP(JP)%XBLD)
- NULLIFY(YTEB%ALP(JP)%XROAD)
- NULLIFY(YTEB%ALP(JP)%XCAN_HW_RATIO)
- NULLIFY(YTEB%ALP(JP)%XBLD_HEIGHT)
- NULLIFY(YTEB%ALP(JP)%XWALL_O_HOR)
- NULLIFY(YTEB%ALP(JP)%XROAD_O_GRND)
- NULLIFY(YTEB%ALP(JP)%XGARDEN_O_GRND)
- NULLIFY(YTEB%ALP(JP)%XWALL_O_GRND)
- NULLIFY(YTEB%ALP(JP)%XWALL_O_BLD)
- NULLIFY(YTEB%ALP(JP)%XZ0_TOWN)
- NULLIFY(YTEB%ALP(JP)%XSVF_ROAD)
- NULLIFY(YTEB%ALP(JP)%XSVF_GARDEN)
- NULLIFY(YTEB%ALP(JP)%XSVF_WALL)
- NULLIFY(YTEB%ALP(JP)%XALB_ROOF)
- NULLIFY(YTEB%ALP(JP)%XEMIS_ROOF)
- NULLIFY(YTEB%ALP(JP)%XHC_ROOF)
- NULLIFY(YTEB%ALP(JP)%XTC_ROOF)
- NULLIFY(YTEB%ALP(JP)%XD_ROOF)
- NULLIFY(YTEB%ALP(JP)%XALB_ROAD)
- NULLIFY(YTEB%ALP(JP)%XEMIS_ROAD)
- NULLIFY(YTEB%ALP(JP)%XHC_ROAD)
- NULLIFY(YTEB%ALP(JP)%XTC_ROAD)
- NULLIFY(YTEB%ALP(JP)%XD_ROAD)
- NULLIFY(YTEB%ALP(JP)%XALB_WALL)
- NULLIFY(YTEB%ALP(JP)%XEMIS_WALL)
- NULLIFY(YTEB%ALP(JP)%XHC_WALL)
- NULLIFY(YTEB%ALP(JP)%XTC_WALL)
- NULLIFY(YTEB%ALP(JP)%XD_WALL)
- NULLIFY(YTEB%ALP(JP)%XH_TRAFFIC)
- NULLIFY(YTEB%ALP(JP)%XLE_TRAFFIC)
- NULLIFY(YTEB%ALP(JP)%XH_INDUSTRY)
- NULLIFY(YTEB%ALP(JP)%XLE_INDUSTRY)
- NULLIFY(YTEB%ALP(JP)%XTI_ROAD)
- NULLIFY(YTEB%ALP(JP)%XWS_ROOF)
- NULLIFY(YTEB%ALP(JP)%XWS_ROAD)
- NULLIFY(YTEB%ALP(JP)%XT_ROOF)
- NULLIFY(YTEB%ALP(JP)%XT_ROAD)
- NULLIFY(YTEB%ALP(JP)%XT_WALL_A)
- NULLIFY(YTEB%ALP(JP)%XT_WALL_B)
- NULLIFY(YTEB%ALP(JP)%XAC_ROOF)
- NULLIFY(YTEB%ALP(JP)%XAC_ROAD)
- NULLIFY(YTEB%ALP(JP)%XAC_WALL)
- NULLIFY(YTEB%ALP(JP)%XAC_TOP)
- NULLIFY(YTEB%ALP(JP)%XAC_ROOF_WAT)
- NULLIFY(YTEB%ALP(JP)%XAC_ROAD_WAT)
- NULLIFY(YTEB%ALP(JP)%XQSAT_ROOF)
- NULLIFY(YTEB%ALP(JP)%XQSAT_ROAD)
- NULLIFY(YTEB%ALP(JP)%XDELT_ROOF)
- NULLIFY(YTEB%ALP(JP)%XDELT_ROAD)
- NULLIFY(YTEB%ALP(JP)%XT_CANYON)
- NULLIFY(YTEB%ALP(JP)%XQ_CANYON)
- NULLIFY(YTEB%ALP(JP)%XROUGH_ROOF)
- NULLIFY(YTEB%ALP(JP)%XROUGH_WALL)
- NULLIFY(YTEB%ALP(JP)%XRESIDENTIAL)
-YTEB%ALP(:)%XDT_RES=0.
-YTEB%ALP(:)%XDT_OFF=0.
-ENDDO
-IF (LHOOK) CALL DR_HOOK("MODD_TEB_N:TEB_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE TEB_INIT
+IF (LHOOK) CALL DR_HOOK("MODD_TEB_N:TEB_NP_INIT",0,ZHOOK_HANDLE)
+IF (.NOT.ASSOCIATED(YNTEB%AL)) THEN
+ ALLOCATE(YNTEB%AL(KPATCH))
+ DO JP=1,KPATCH
+ CALL TEB_INIT(YNTEB%AL(JP))
+ ENDDO
+ELSE
+ DO JP=1,KPATCH
+ CALL TEB_INIT(YNTEB%AL(JP))
+ ENDDO
+ DEALLOCATE(YNTEB%AL)
+ENDIF
+IF (LHOOK) CALL DR_HOOK("MODD_TEB_N:TEB_NP_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE TEB_NP_INIT
END MODULE MODD_TEB_n
diff --git a/src/SURFEX/modd_type_snow.F90 b/src/SURFEX/modd_type_snow.F90
index 9a284fa8b1a770d70b51a9e7fd39a2b9a4969015..614ca32a724708cdc4785e1f6a4b84d775247c08 100644
--- a/src/SURFEX/modd_type_snow.F90
+++ b/src/SURFEX/modd_type_snow.F90
@@ -40,26 +40,59 @@
IMPLICIT NONE
!
TYPE SURF_SNOW
- CHARACTER(LEN=3) :: SCHEME ! snow scheme used
+!
+CHARACTER(LEN=3) :: SCHEME ! snow scheme used
INTEGER :: NLAYER ! number of layers
-REAL, DIMENSION(:,:,:), POINTER :: WSNOW ! snow (& liq. water) content (kg/m2)
-REAL, DIMENSION(:,:,:), POINTER :: HEAT ! heat content (J/m2)
-REAL, DIMENSION(:,:,:), POINTER :: T ! temperature '1-L'
-REAL, DIMENSION(:,:,:), POINTER :: TEMP ! temperature '3-L' (K)
-REAL, DIMENSION(:,:,:), POINTER :: RHO ! density
-REAL, DIMENSION(:,:), POINTER :: ALB ! snow surface albedo
-REAL, DIMENSION(:,:), POINTER :: ALBVIS ! snow surface visible albedo
-REAL, DIMENSION(:,:), POINTER :: ALBNIR ! snow surface near-infrared albedo
-REAL, DIMENSION(:,:), POINTER :: ALBFIR ! snow surface far-infrared albedo
-REAL, DIMENSION(:,:), POINTER :: EMIS ! snow surface emissivity
-REAL, DIMENSION(:,:), POINTER :: TS ! snow surface temperature
-REAL, DIMENSION(:,:,:), POINTER :: GRAN1 ! snow grain parameter 1
-REAL, DIMENSION(:,:,:), POINTER :: GRAN2 ! snow grain parameter 2
-REAL, DIMENSION(:,:,:), POINTER :: HIST ! snow historical variable
+!
+REAL, DIMENSION(:,:), POINTER :: DEPTH
+REAL, DIMENSION(:,:), POINTER :: WSNOW ! snow (& liq. water) content (kg/m2)
+REAL, DIMENSION(:,:), POINTER :: HEAT ! heat content (J/m2)
+REAL, DIMENSION(:,:), POINTER :: T ! temperature '1-L'
+REAL, DIMENSION(:,:), POINTER :: TEMP ! temperature '3-L' (K)
+REAL, DIMENSION(:,:), POINTER :: RHO ! density
+REAL, DIMENSION(:), POINTER :: ALB ! snow surface albedo
+REAL, DIMENSION(:), POINTER :: ALBVIS ! snow surface visible albedo
+REAL, DIMENSION(:), POINTER :: ALBNIR ! snow surface near-infrared albedo
+REAL, DIMENSION(:), POINTER :: ALBFIR ! snow surface far-infrared albedo
+REAL, DIMENSION(:), POINTER :: EMIS ! snow surface emissivity
+REAL, DIMENSION(:), POINTER :: TS ! snow surface temperature
+REAL, DIMENSION(:,:), POINTER :: GRAN1 ! snow grain parameter 1
+REAL, DIMENSION(:,:), POINTER :: GRAN2 ! snow grain parameter 2
+REAL, DIMENSION(:,:), POINTER :: HIST ! snow historical variable
! (non dendritic case)
-REAL, DIMENSION(:,:,:), POINTER :: AGE ! snow grain age
+REAL, DIMENSION(:,:), POINTER :: AGE ! snow grain age
END TYPE SURF_SNOW
!
+TYPE NSURF_SNOW
+!
+TYPE(SURF_SNOW), DIMENSION(:), POINTER :: AL
+!
+END TYPE NSURF_SNOW
+!
+CONTAINS
+!
+SUBROUTINE TYPE_SNOW_INIT(YSURF_SNOW)
+!
+TYPE(SURF_SNOW), INTENT(INOUT) :: YSURF_SNOW
+!
+YSURF_SNOW%DEPTH => NULL()
+YSURF_SNOW%WSNOW => NULL()
+YSURF_SNOW%HEAT => NULL()
+YSURF_SNOW%T => NULL()
+YSURF_SNOW%TEMP => NULL()
+YSURF_SNOW%RHO => NULL()
+YSURF_SNOW%ALB => NULL()
+YSURF_SNOW%ALBVIS => NULL()
+YSURF_SNOW%ALBNIR => NULL()
+YSURF_SNOW%ALBFIR => NULL()
+YSURF_SNOW%EMIS => NULL()
+YSURF_SNOW%TS => NULL()
+YSURF_SNOW%GRAN1 => NULL()
+YSURF_SNOW%GRAN2 => NULL()
+YSURF_SNOW%HIST => NULL()
+YSURF_SNOW%AGE => NULL()
+!
+END SUBROUTINE TYPE_SNOW_INIT
+!
END MODULE MODD_TYPE_SNOW
-
diff --git a/src/SURFEX/modd_utci.F90 b/src/SURFEX/modd_utci.F90
index ca8c2d4ea74d49cf00a82103410746eb14d77155..e63ef7543da20d3bb722bb3961d0694c5f572d09 100644
--- a/src/SURFEX/modd_utci.F90
+++ b/src/SURFEX/modd_utci.F90
@@ -39,7 +39,7 @@ INTEGER, PARAMETER :: NUTCI_STRESS = 10 ! number of stress ranges
!
REAL, PARAMETER, DIMENSION(0:NUTCI_STRESS) :: XUTCI_STRESS_LIMITS = &
(/ -999., -40., -28., -12., 0., 9., 26., 32., 38., 46., 999. /)
- CHARACTER(LEN=3), PARAMETER, DIMENSION(NUTCI_STRESS) :: CUTCI_STRESS_NAMES = &
+CHARACTER(LEN=3), PARAMETER, DIMENSION(NUTCI_STRESS) :: CUTCI_STRESS_NAMES = &
(/ 'ECS', 'VCS', 'SCS', 'MCS', 'LCS', 'NHS', 'MHS', 'SHS', 'VHS', 'EHS' /)
!-----------------------------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/modd_watflux_gridn.F90 b/src/SURFEX/modd_watflux_gridn.F90
deleted file mode 100644
index d363e53bbcbd0a04836e3c3210da4da1d217581c..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_watflux_gridn.F90
+++ /dev/null
@@ -1,88 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ##################
- MODULE MODD_WATFLUX_GRID_n
-! ##################
-!
-!!**** *MODD_WATFLUX_GRID - declaration of WATFLUX grid
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE WATFLUX_GRID_t
-!-------------------------------------------------------------------------------
-!
-! Grid definition
-!
- INTEGER :: NDIM ! number of points
- CHARACTER(LEN=10) :: CGRID ! grid type
-! ! "NONE " : no grid computations
-! ! "CONF PROJ " : conformal projection
-! ! "SURF ATM " : water points of surf. atm. grid
-!
- REAL, POINTER, DIMENSION(:) :: XGRID_PAR ! lits of parameters used to define the grid
-! ! (depends on value of CGRID)
-!
-!-------------------------------------------------------------------------------
-!
-! General surface parameters:
-!
- REAL, POINTER, DIMENSION(:) :: XLAT ! latitude (degrees +North) (-)
- REAL, POINTER, DIMENSION(:) :: XLON ! longitude (degrees +East) (-)
- REAL, POINTER, DIMENSION(:) :: XMESH_SIZE ! mesh size (m2)
-!-------------------------------------------------------------------------------
-!
-
-END TYPE WATFLUX_GRID_t
-
-
-
- CONTAINS
-
-!
-
-
-
-
-SUBROUTINE WATFLUX_GRID_INIT(YWATFLUX_GRID)
-TYPE(WATFLUX_GRID_t), INTENT(INOUT) :: YWATFLUX_GRID
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_WATFLUX_GRID_N:WATFLUX_GRID_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YWATFLUX_GRID%XGRID_PAR)
- NULLIFY(YWATFLUX_GRID%XLAT)
- NULLIFY(YWATFLUX_GRID%XLON)
- NULLIFY(YWATFLUX_GRID%XMESH_SIZE)
-YWATFLUX_GRID%NDIM=0
-YWATFLUX_GRID%CGRID=' '
-IF (LHOOK) CALL DR_HOOK("MODD_WATFLUX_GRID_N:WATFLUX_GRID_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE WATFLUX_GRID_INIT
-
-
-END MODULE MODD_WATFLUX_GRID_n
diff --git a/src/SURFEX/modd_watflux_sbln.F90 b/src/SURFEX/modd_watflux_sbln.F90
deleted file mode 100644
index 12e46e12035b268533a92be13ea968ab35f305da..0000000000000000000000000000000000000000
--- a/src/SURFEX/modd_watflux_sbln.F90
+++ /dev/null
@@ -1,85 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ################
- MODULE MODD_WATFLUX_SBL_n
-! ################
-!
-!!**** *MODD_WATFLUX_SBL_n - declaration of surface parameters for SBL
-!!
-!! PURPOSE
-!! -------
-! Declaration of surface parameters
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/2006
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-
-TYPE WATFLUX_SBL_t
-!
- INTEGER :: NLVL ! number of levels in SBL
- REAL, POINTER, DIMENSION(:,:) :: XZ ! height of middle of each level grid(m)
- REAL, POINTER, DIMENSION(:,:) :: XU ! wind at each level in SBL (m/s)
- REAL, POINTER, DIMENSION(:,:) :: XT ! temperature at each level in SBL (m/s)
- REAL, POINTER, DIMENSION(:,:) :: XQ ! humidity at each level in SBL (kg/m3)
- REAL, POINTER, DIMENSION(:,:) :: XTKE ! Tke at each level in SBL (m2/s2)
- REAL, POINTER, DIMENSION(:) :: XLMO ! Monin-Obhukov length (m)
- REAL, POINTER, DIMENSION(:,:) :: XP ! pressure at each level in SBL (kg/m3)
-!
- REAL, POINTER, DIMENSION(:,:) :: XDZ ! depth of each level in SBL (m)
- REAL, POINTER, DIMENSION(:,:) :: XZF ! height of bottom of each level grid(m)
- REAL, POINTER, DIMENSION(:,:) :: XDZF ! depth between each level in SBL (m)
-!
-END TYPE WATFLUX_SBL_t
-
-
-
- CONTAINS
-
-!
-
-
-
-
-SUBROUTINE WATFLUX_SBL_INIT(YWATFLUX_SBL)
-TYPE(WATFLUX_SBL_t), INTENT(INOUT) :: YWATFLUX_SBL
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK("MODD_WATFLUX_SBL_N:WATFLUX_SBL_INIT",0,ZHOOK_HANDLE)
- NULLIFY(YWATFLUX_SBL%XZ)
- NULLIFY(YWATFLUX_SBL%XU)
- NULLIFY(YWATFLUX_SBL%XT)
- NULLIFY(YWATFLUX_SBL%XQ)
- NULLIFY(YWATFLUX_SBL%XTKE)
- NULLIFY(YWATFLUX_SBL%XLMO)
- NULLIFY(YWATFLUX_SBL%XP)
- NULLIFY(YWATFLUX_SBL%XDZ)
- NULLIFY(YWATFLUX_SBL%XZF)
- NULLIFY(YWATFLUX_SBL%XDZF)
-YWATFLUX_SBL%NLVL=0
-IF (LHOOK) CALL DR_HOOK("MODD_WATFLUX_SBL_N:WATFLUX_SBL_INIT",1,ZHOOK_HANDLE)
-END SUBROUTINE WATFLUX_SBL_INIT
-
-
-END MODULE MODD_WATFLUX_SBL_n
diff --git a/src/SURFEX/modd_watfluxn.F90 b/src/SURFEX/modd_watfluxn.F90
index ba6289aec020badbe14812af9ff788a4e595099a..dc9da47a318fac6d375c7fcfe6776b58f4e7796c 100644
--- a/src/SURFEX/modd_watfluxn.F90
+++ b/src/SURFEX/modd_watfluxn.F90
@@ -95,7 +95,7 @@ END TYPE WATFLUX_t
- CONTAINS
+CONTAINS
!
diff --git a/src/SURFEX/modd_write_surf_atm.F90 b/src/SURFEX/modd_write_surf_atm.F90
index 7a263c9cb6eac11d67fe055e8583295c4859a1ba..31c48a452edf32f0e75a88fb76b5d413d5323377 100644
--- a/src/SURFEX/modd_write_surf_atm.F90
+++ b/src/SURFEX/modd_write_surf_atm.F90
@@ -38,7 +38,19 @@ IMPLICIT NONE
LOGICAL :: LNOWRITE_CANOPY ! flag used to avoid writing of canopy fields in OUTPUT file
LOGICAL :: LNOWRITE_TEXFILE ! flag used to avoid writing of tex file describing parameters
!
-LOGICAL :: LNAM_WRITTEN = .TRUE.
+LOGICAL :: LNAM_ATM_WRITTEN = .TRUE.
+LOGICAL :: LNAM_FLAKE_WRITTEN = .TRUE.
+LOGICAL :: LNAM_ISBA_WRITTEN = .TRUE.
+LOGICAL :: LNAM_SEAFLUX_WRITTEN = .TRUE.
+LOGICAL :: LNAM_TEB_WRITTEN = .TRUE.
+LOGICAL :: LNAM_WATFLUX_WRITTEN = .TRUE.
+!
+LOGICAL :: LFIRST_WRITE = .TRUE.
+LOGICAL, DIMENSION(50000) :: LNOWRITE
+INTEGER :: NCPT_WRITE = 0
+!
+LOGICAL :: LSPLIT_PATCH = .TRUE.
+!
!-----------------------------------------------------------------------------------------------------
!
END MODULE MODD_WRITE_SURF_ATM
diff --git a/src/SURFEX/modd_xios.F90 b/src/SURFEX/modd_xios.F90
new file mode 100644
index 0000000000000000000000000000000000000000..5ad25b6bad3a8cccead38f4f72498e92841b3090
--- /dev/null
+++ b/src/SURFEX/modd_xios.F90
@@ -0,0 +1,73 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! ######################
+ MODULE MODD_XIOS
+! ######################
+!
+!!**** *MODD_XIOS - nest for variables used in interfacing XIOS to Surfex / Arpege
+!!
+!! PURPOSE
+!! -------
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! S.Sénési *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 08/2015
+!
+!* 0. DECLARATIONS
+! ------------
+#ifdef WXIOS
+USE XIOS , ONLY : XIOS_CONTEXT
+TYPE(xios_context) :: TXIOS_CONTEXT ! Xios context handle
+#else
+INTEGER :: TXIOS_CONTEXT ! Fake Xios context handle
+#endif
+!
+!
+! Basic toggle
+!
+LOGICAL :: LXIOS=.FALSE. ! Do we use XIOS for outputing diags
+!
+!
+! Setup variables
+!
+CHARACTER(LEN=6) :: YXIOS_CONTEXT= "surfex" ! Context name known to Xios (must match a context declared in xml file)
+CHARACTER(LEN=14) :: COUTPUT_DEFAULT="surfex_cselect" ! XIOS id for the file receiving all Surfex variables selected
+ ! by CSELECT (could/should exist in xml configuration file)
+LOGICAL :: LALLOW_ADD_DIM=.FALSE. ! allow multi-dimensional output ?
+INTEGER :: NBASE_XIOS_FREQ=1 ! Base frequency for calling XIOS (unit=timestep)
+!
+! Evolving variables
+!
+LOGICAL :: LXIOS_DEF_CLOSED ! Has the Surfex context definition already been closed ?
+CHARACTER(LEN=6) :: YXIOS_DOMAIN ! When writing diags using write_diag_surf, name of the current tile
+INTEGER :: NTIMESTEP=-1 ! Last value of timestep sent to XIOS (should be useless, now..)
+INTEGER :: NBLOCK=1 ! Number of blocks in the MPI-task (NPROMA blocks when in
+ ! Arpege). For xios_send_block
+!
+! Names for various dimensions (this section could be move elsewhere when more
+! output schemes will handle dimension names)
+!
+CHARACTER(LEN=30) :: YPATCH_DIM_NAME ="patch"
+CHARACTER(LEN=30) :: YGROUND_LAYER_DIM_NAME ="ground_layer"
+CHARACTER(LEN=30) :: YWGROUND_LAYER_DIM_NAME ="ground_water_layer"
+CHARACTER(LEN=30) :: YWIGROUND_LAYER_DIM_NAME ="ground_ice_layer"
+CHARACTER(LEN=30) :: YSNOW_PATCH_DIM_NAME ="snow_patch"
+CHARACTER(LEN=30) :: YSEAICE_LAYER_DIM_NAME ="seaice_layer"
+CHARACTER(LEN=30) :: YSWBAND_DIM_NAME ="swband"
+CHARACTER(LEN=30) :: YATM_VAXIS_NAME ="klev"
+
+!
+END MODULE MODD_XIOS
diff --git a/src/SURFEX/mode_aer_surf.F90 b/src/SURFEX/mode_aer_surf.F90
index a76ab3c565a417d565aef2d5e6ee996c2e9db8fd..e38f84a6480ea33bc163205106b8a4411443b125 100644
--- a/src/SURFEX/mode_aer_surf.F90
+++ b/src/SURFEX/mode_aer_surf.F90
@@ -9,14 +9,12 @@ MODULE MODE_AER_SURF
!! MODULE DUST PSD (Particle Size Distribution)
!! Purpose: Contains subroutines to convert from transported variables (ppp)
!! to understandable aerosol variables, e.g. #/m3, kg/m3, sigma, R_{n}
-!!
-!! Modifications
-!! M.Leriche 2015 : masse molaire Black carbon à 12 g/mol
!-------------------------------------------------------------------------------
!! MODIFICATIONS
!! -------------
!!
!! J.Escobar 06/2013 for REAL4/8 add EPSILON management
+!! M.Leriche 2015 : masse molaire Black carbon à 12 g/mol
!!
!-------------------------------------------------------------------------------
USE MODD_CHS_AEROSOL
@@ -28,7 +26,7 @@ MODULE MODE_AER_SURF
!
IMPLICIT NONE
!!
- CONTAINS
+CONTAINS
!!
SUBROUTINE INIT_VAR(PSV,PFAC,PCTOTA)
!
@@ -69,7 +67,7 @@ ZMI(JP_AER_SO4) = 98.
ZMI(JP_AER_NO3) = 63.
ZMI(JP_AER_NH3) = 17.
ZMI(JP_AER_H2O) = 18.
-ZMI(JP_AER_BC) = 12.
+ZMI(JP_AER_BC) = 12.
ZMI(JP_AER_DST) = 100.
IF (NSOA .EQ. 10) THEN
ZMI(JP_AER_SOA1) = 88.
diff --git a/src/SURFEX/mode_av_pgd.F90 b/src/SURFEX/mode_av_pgd.F90
new file mode 100644
index 0000000000000000000000000000000000000000..fbb6324da4b986ff2f207d656810f7024299a1fc
--- /dev/null
+++ b/src/SURFEX/mode_av_pgd.F90
@@ -0,0 +1,317 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+MODULE MODE_AV_PGD
+!
+USE MODD_SURF_PAR, ONLY : NUNDEF
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+CONTAINS
+!
+SUBROUTINE DATE2DOY(TPDATA, OCOVER, KDOY)
+USE MODD_TYPE_DATE_SURF
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
+!
+TYPE (DATE_TIME), DIMENSION(:,:), INTENT(IN) :: TPDATA
+LOGICAL, DIMENSION(:), INTENT(IN) :: OCOVER
+INTEGER, DIMENSION(:,:), INTENT(OUT) :: KDOY
+INTEGER, DIMENSION(SIZE(OCOVER),NVEGTYPE) :: IMONTH, IDAY
+INTEGER, PARAMETER, DIMENSION(12) :: TAB=(/1,32,60,91,121,152,182,213,244,274,305,335/)
+INTEGER :: JCOV, JJ, JVEG
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+IF (LHOOK) CALL DR_HOOK('MODE_AV_PGD:DATE2DOY',0,ZHOOK_HANDLE)
+!
+IMONTH(:,:) = TPDATA(:,:)%TDATE%MONTH
+IDAY(:,:) = TPDATA(:,:)%TDATE%DAY
+!
+KDOY(:,:) = NUNDEF
+!
+JCOV = 0
+DO JJ = 1, SIZE(OCOVER)
+ IF (.NOT.OCOVER(JJ)) CYCLE
+ JCOV = JCOV + 1
+ DO JVEG = 1, NVEGTYPE
+ IF (IMONTH(JJ,JVEG)/=NUNDEF .AND. IDAY(JJ,JVEG) /= NUNDEF) THEN
+ KDOY(JCOV,JVEG) = TAB(IMONTH(JJ,JVEG)) + IDAY(JJ,JVEG) - 1
+ ENDIF
+ END DO
+END DO
+IF (LHOOK) CALL DR_HOOK('MODE_AV_PGD:DATE2DOY',1,ZHOOK_HANDLE)
+
+END SUBROUTINE DATE2DOY
+!
+SUBROUTINE DOY2DATE(KDOY,KMONTH,KDAY)
+!
+INTEGER, INTENT(IN) :: KDOY
+INTEGER, INTENT(OUT) :: KMONTH, KDAY
+REAL :: ZWORK(12)
+INTEGER, PARAMETER, DIMENSION(12) :: ZTAB=(/31.,59.,90.,120.,151.,181.,212.,243.,273.,304.,334.,365./)
+INTEGER :: J
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+IF (LHOOK) CALL DR_HOOK('MODE_AV_PGD:DOY2DATE',0,ZHOOK_HANDLE)
+!
+KMONTH = NUNDEF
+KDAY = NUNDEF
+!
+ZWORK(1) = REAL(KDOY) / ZTAB(1)
+IF ( INT(ZWORK(1))==0 .AND. ZWORK(1)/=0.) THEN
+ KMONTH = 1
+ KDAY = KDOY
+ENDIF
+!
+DO J = 2, 12
+ ZWORK(J) = REAL(KDOY) / ZTAB(J)
+ IF ( INT(ZWORK(J))==0 .AND. INT(ZWORK(J-1))==1 ) THEN
+ KMONTH = J
+ KDAY = KDOY - INT(ZTAB(J-1))
+ ENDIF
+END DO
+IF (LHOOK) CALL DR_HOOK('MODE_AV_PGD:DOY2DATE',1,ZHOOK_HANDLE)
+
+END SUBROUTINE DOY2DATE
+!
+SUBROUTINE GET_WEIGHT(DTCO,KCOVER,KMASK,HSFTYPE,PWEIGHT)
+!
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+!
+USE MODD_DATA_COVER, ONLY : XDATA_BLD_HEIGHT
+USE MODD_DATA_COVER_PAR, ONLY : NVT_TEBD, NVT_BONE, NVT_TRBE, NVT_TRBD, &
+ NVT_TEBE, NVT_TENE, NVT_BOBD, NVT_BOND, NVT_SHRB
+!
+USE MODI_ABOR1_SFX
+!
+IMPLICIT NONE
+!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+INTEGER, INTENT(IN) :: KCOVER
+INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
+ CHARACTER(LEN=3), INTENT(IN) :: HSFTYPE
+REAL, DIMENSION(:), INTENT(OUT) :: PWEIGHT
+!
+INTEGER :: JCOV,JJ
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_AV_PGD:GET_WEIGHT',0,ZHOOK_HANDLE)
+!
+DO JCOV=1,KCOVER
+ !
+ JJ = KMASK(JCOV)
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !* 2. Selection of the weighting function
+ ! -----------------------------------
+ !
+ SELECT CASE (HSFTYPE)
+ CASE('ALL')
+ PWEIGHT(JCOV)=1.
+
+ CASE('NAT')
+ PWEIGHT(JCOV)=DTCO%XDATA_NATURE(JJ)
+
+ CASE('GRD')
+ PWEIGHT(JCOV)=DTCO%XDATA_TOWN (JJ) * DTCO%XDATA_GARDEN(JJ)
+
+ CASE('TWN')
+ PWEIGHT(JCOV)=DTCO%XDATA_TOWN (JJ)
+
+ CASE('WAT')
+ PWEIGHT(JCOV)=DTCO%XDATA_WATER (JJ)
+
+ CASE('SEA')
+ PWEIGHT(JCOV)=DTCO%XDATA_SEA (JJ)
+
+ CASE('BLD')
+ PWEIGHT(JCOV)=DTCO%XDATA_TOWN (JJ) * DTCO%XDATA_BLD(JJ)
+
+ CASE('BLV') !* building Volume
+ PWEIGHT(JCOV)=DTCO%XDATA_TOWN (JJ) * DTCO%XDATA_BLD(JJ) &
+ * XDATA_BLD_HEIGHT(JJ)
+
+ CASE('STR')
+ PWEIGHT(JCOV)=DTCO%XDATA_TOWN (JJ) * ( 1. - DTCO%XDATA_BLD(JJ) )
+
+ CASE('TRE')
+ PWEIGHT(JCOV)=DTCO%XDATA_NATURE(JJ) * ( DTCO%XDATA_VEGTYPE(JJ,NVT_TEBD) &
+ + DTCO%XDATA_VEGTYPE(JJ,NVT_TRBE) &
+ + DTCO%XDATA_VEGTYPE(JJ,NVT_TRBD) &
+ + DTCO%XDATA_VEGTYPE(JJ,NVT_TEBE) &
+ + DTCO%XDATA_VEGTYPE(JJ,NVT_TENE) &
+ + DTCO%XDATA_VEGTYPE(JJ,NVT_BOBD) &
+ + DTCO%XDATA_VEGTYPE(JJ,NVT_BOND) &
+ + DTCO%XDATA_VEGTYPE(JJ,NVT_SHRB) &
+ + DTCO%XDATA_VEGTYPE(JJ,NVT_BONE) )
+
+ CASE('GRT')
+ PWEIGHT(JCOV)=DTCO%XDATA_TOWN(JJ) * DTCO%XDATA_GARDEN(JJ) &
+ * ( DTCO%XDATA_VEGTYPE(JJ,NVT_TEBD) &
+ + DTCO%XDATA_VEGTYPE(JJ,NVT_TRBE) &
+ + DTCO%XDATA_VEGTYPE(JJ,NVT_TRBD) &
+ + DTCO%XDATA_VEGTYPE(JJ,NVT_TEBE) &
+ + DTCO%XDATA_VEGTYPE(JJ,NVT_TENE) &
+ + DTCO%XDATA_VEGTYPE(JJ,NVT_BOBD) &
+ + DTCO%XDATA_VEGTYPE(JJ,NVT_BOND) &
+ + DTCO%XDATA_VEGTYPE(JJ,NVT_SHRB) &
+ + DTCO%XDATA_VEGTYPE(JJ,NVT_BONE) )
+
+ CASE DEFAULT
+ CALL ABOR1_SFX('AV_1PGD_1D: WEIGHTING FUNCTION NOT ALLOWED '//HSFTYPE)
+ END SELECT
+!
+ENDDO
+!
+IF (LHOOK) CALL DR_HOOK('MODE_AV_PGD:GET_WEIGHT',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE GET_WEIGHT
+!
+SUBROUTINE GET_WEIGHT_PATCH(DTCO,KCOVER,KMASK,KDECADE,HSFTYPE,PWEIGHT)
+!
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+!
+USE MODD_DATA_COVER, ONLY : XDATA_VEG, XDATA_LAI
+USE MODD_DATA_COVER_PAR, ONLY : NVT_TEBD, NVT_BONE, NVT_TRBE, NVT_TRBD, &
+ NVT_TEBE, NVT_TENE, NVT_BOBD, NVT_BOND, NVT_SHRB, &
+ NVEGTYPE
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODI_ABOR1_SFX
+!
+IMPLICIT NONE
+!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+INTEGER, INTENT(IN) :: KCOVER
+INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
+INTEGER, INTEnt(IN) :: KDECADE
+ CHARACTER(LEN=3), INTENT(IN) :: HSFTYPE
+REAL, DIMENSION(:,:), INTENT(OUT) :: PWEIGHT
+!
+INTEGER :: JCOV,JJ, JVEG
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_AV_PGD:GET_WEIGHT_PATCH',0,ZHOOK_HANDLE)
+!
+IF (.NOT.ASSOCIATED(DTCO%XDATA_WEIGHT)) THEN
+ !
+ ALLOCATE(DTCO%XDATA_WEIGHT(KCOVER,NVEGTYPE,12))
+ DTCO%XDATA_WEIGHT(:,:,:) = 0.
+ !
+ DO JCOV=1,KCOVER
+ !
+ JJ = KMASK(JCOV)
+ !
+ DO JVEG=1,NVEGTYPE
+ ! CASE('NAT')
+ IF (DTCO%XDATA_VEGTYPE(JJ,JVEG)==0.) CYCLE
+ !
+ DTCO%XDATA_WEIGHT(JCOV,JVEG,1)= DTCO%XDATA_NATURE(JJ) * DTCO%XDATA_VEGTYPE(JJ,JVEG)
+ !CASE('GRD')
+ DTCO%XDATA_WEIGHT(JCOV,JVEG,2)= DTCO%XDATA_TOWN(JJ)*DTCO%XDATA_GARDEN(JJ) * DTCO%XDATA_VEGTYPE(JJ,JVEG)
+ !CASE('VEG')
+ DTCO%XDATA_WEIGHT(JCOV,JVEG,3)= DTCO%XDATA_WEIGHT(JCOV,JVEG,1) * XDATA_VEG(JJ,KDECADE,JVEG)
+ !CASE('BAR')
+ DTCO%XDATA_WEIGHT(JCOV,JVEG,4)= DTCO%XDATA_WEIGHT(JCOV,JVEG,1) * (1.-XDATA_VEG(JJ,KDECADE,JVEG))
+ !CASE('GRV')
+ DTCO%XDATA_WEIGHT(JCOV,JVEG,5)= DTCO%XDATA_WEIGHT(JCOV,JVEG,2) * XDATA_VEG(JJ,KDECADE,JVEG)
+ !CASE('GRB')
+ DTCO%XDATA_WEIGHT(JCOV,JVEG,6)= DTCO%XDATA_WEIGHT(JCOV,JVEG,2) * (1.-XDATA_VEG(JJ,KDECADE,JVEG))
+ IF ( SUM(XDATA_LAI(JJ,:,JVEG)) .GT. 0.0) THEN
+ !CASE('DVG') ! for diffusion scheme only
+ DTCO%XDATA_WEIGHT(JCOV,JVEG,7)= DTCO%XDATA_WEIGHT(JCOV,JVEG,1)
+ !CASE('GDV') ! for diffusion scheme only
+ DTCO%XDATA_WEIGHT(JCOV,JVEG,8)= DTCO%XDATA_WEIGHT(JCOV,JVEG,2)
+ ENDIF
+ !CASE('LAI')
+ DTCO%XDATA_WEIGHT(JCOV,JVEG,9)= DTCO%XDATA_WEIGHT(JCOV,JVEG,1) * XDATA_LAI(JJ,KDECADE,JVEG)
+ !CASE('GRL')
+ DTCO%XDATA_WEIGHT(JCOV,JVEG,10)= DTCO%XDATA_WEIGHT(JCOV,JVEG,2) * XDATA_LAI(JJ,KDECADE,JVEG)
+ !
+ !Tree vegtype
+ !
+ !CASE('TRE')
+ !CASE('GRT')
+ IF (JVEG==NVT_TEBD) THEN
+ DTCO%XDATA_WEIGHT(JCOV,NVT_TEBD,11)= DTCO%XDATA_WEIGHT(JCOV,NVT_TEBD,1)
+ DTCO%XDATA_WEIGHT(JCOV,NVT_TEBD,12)= DTCO%XDATA_WEIGHT(JCOV,NVT_TEBD,2)
+ ENDIF
+ IF (JVEG==NVT_BONE) THEN
+ DTCO%XDATA_WEIGHT(JCOV,NVT_BONE,11)= DTCO%XDATA_WEIGHT(JCOV,NVT_BONE,1)
+ DTCO%XDATA_WEIGHT(JCOV,NVT_BONE,12)= DTCO%XDATA_WEIGHT(JCOV,NVT_BONE,2)
+ ENDIF
+ IF (JVEG==NVT_TRBE) THEN
+ DTCO%XDATA_WEIGHT(JCOV,NVT_TRBE,11)= DTCO%XDATA_WEIGHT(JCOV,NVT_TRBE,1)
+ DTCO%XDATA_WEIGHT(JCOV,NVT_TRBE,12)= DTCO%XDATA_WEIGHT(JCOV,NVT_TRBE,2)
+ ENDIF
+ IF (JVEG==NVT_TRBD) THEN
+ DTCO%XDATA_WEIGHT(JCOV,NVT_TRBD,11)= DTCO%XDATA_WEIGHT(JCOV,NVT_TRBD,1)
+ DTCO%XDATA_WEIGHT(JCOV,NVT_TRBD,12)= DTCO%XDATA_WEIGHT(JCOV,NVT_TRBD,2)
+ ENDIF
+ IF (JVEG==NVT_TEBE) THEN
+ DTCO%XDATA_WEIGHT(JCOV,NVT_TEBE,11)= DTCO%XDATA_WEIGHT(JCOV,NVT_TEBE,1)
+ DTCO%XDATA_WEIGHT(JCOV,NVT_TEBE,12)= DTCO%XDATA_WEIGHT(JCOV,NVT_TEBE,2)
+ ENDIF
+ IF (JVEG==NVT_TENE) THEN
+ DTCO%XDATA_WEIGHT(JCOV,NVT_TENE,11)= DTCO%XDATA_WEIGHT(JCOV,NVT_TENE,1)
+ DTCO%XDATA_WEIGHT(JCOV,NVT_TENE,12)= DTCO%XDATA_WEIGHT(JCOV,NVT_TENE,2)
+ ENDIF
+ IF (JVEG==NVT_BOBD) THEN
+ DTCO%XDATA_WEIGHT(JCOV,NVT_BOBD,11)= DTCO%XDATA_WEIGHT(JCOV,NVT_BOBD,1)
+ DTCO%XDATA_WEIGHT(JCOV,NVT_BOBD,12)= DTCO%XDATA_WEIGHT(JCOV,NVT_BOBD,2)
+ ENDIF
+ IF (JVEG==NVT_BOND) THEN
+ DTCO%XDATA_WEIGHT(JCOV,NVT_BOND,11)= DTCO%XDATA_WEIGHT(JCOV,NVT_BOND,1)
+ DTCO%XDATA_WEIGHT(JCOV,NVT_BOND,12)= DTCO%XDATA_WEIGHT(JCOV,NVT_BOND,2)
+ ENDIF
+ IF (JVEG==NVT_SHRB) THEN
+ DTCO%XDATA_WEIGHT(JCOV,NVT_SHRB,11)= DTCO%XDATA_WEIGHT(JCOV,NVT_SHRB,1)
+ DTCO%XDATA_WEIGHT(JCOV,NVT_SHRB,12)= DTCO%XDATA_WEIGHT(JCOV,NVT_SHRB,2)
+ ENDIF
+ !
+ ENDDO
+ !
+ ENDDO
+ !
+ENDIF
+!
+SELECT CASE (HSFTYPE)
+ CASE('NAT')
+ PWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,1)
+ CASE('GRD')
+ PWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,2)
+ CASE('VEG')
+ PWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,3)
+ CASE('BAR')
+ PWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,4)
+ CASE('GRV')
+ PWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,5)
+ CASE('GRB')
+ PWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,6)
+ CASE('DVG')
+ PWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,7)
+ CASE('GDV')
+ PWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,8)
+ CASE('LAI')
+ PWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,9)
+ CASE('GRL')
+ PWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,10)
+ CASE('TRE')
+ PWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,11)
+ CASE('GRT')
+ PWEIGHT(:,:) = DTCO%XDATA_WEIGHT(:,:,12)
+ CASE DEFAULT
+ CALL ABOR1_SFX('AV_1PATCH_PGD_1D: WEIGHTING FUNCTION FOR VEGTYPE NOT ALLOWED')
+END SELECT
+!
+IF (LHOOK) CALL DR_HOOK('MODE_AV_PGD:GET_WEIGHT_PATCH',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE GET_WEIGHT_PATCH
+!
+ END MODULE MODE_AV_PGD
diff --git a/src/SURFEX/mode_char2real.F90 b/src/SURFEX/mode_char2real.F90
index 4b809a14929c77d1c40aee0c25e6e9ac6601d54b..f53d305c84385822b14a2d7a257f0629c9c03d02 100644
--- a/src/SURFEX/mode_char2real.F90
+++ b/src/SURFEX/mode_char2real.F90
@@ -13,7 +13,7 @@ INTERFACE ASSIGNMENT (=)
MODULE PROCEDURE CHAR_TO_REAL
END INTERFACE
!
- CONTAINS
+CONTAINS
!
SUBROUTINE CHAR_TO_REAL(KOUT,HSTR)
USE MODD_ARCH, ONLY : LITTLE_ENDIAN_ARCH
@@ -27,7 +27,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_CHAR2REAL:CHAR_TO_REAL',0,ZHOOK_HANDLE)
SELECT CASE(LEN(HSTR(1)))
- CASE (8)
+CASE (8)
ISIZE = SIZE(HSTR)
IF (LITTLE_ENDIAN_ARCH) THEN! must swap 8 bytes
ALLOCATE(YTEMP(ISIZE))
@@ -46,7 +46,7 @@ SELECT CASE(LEN(HSTR(1)))
ELSE
KOUT = TRANSFER(HSTR,1.0_8,ISIZE)
END IF
- CASE (4)
+CASE (4)
! EMULATE a 32 bits REAL
ISIZE = SIZE(HSTR)
IF (LITTLE_ENDIAN_ARCH) THEN
@@ -62,7 +62,7 @@ SELECT CASE(LEN(HSTR(1)))
ELSE
KOUT = TRANSFER(HSTR,1.0_4,ISIZE)
END IF
- CASE (2)
+CASE (2)
! EMULATE a 16 bits signed INTEGER
IF (LITTLE_ENDIAN_ARCH) THEN! must swap 2 bytes
KOUT = ICHAR(HSTR(:)(2:2))+256*ICHAR(HSTR(:)(1:1))
@@ -73,14 +73,14 @@ SELECT CASE(LEN(HSTR(1)))
KOUT = KOUT - 65536.
END WHERE
- CASE(1)
+CASE(1)
! EMULATE an 8 bits signed INTEGER
KOUT(:) = ICHAR(HSTR(:))
WHERE (KOUT > 127)
KOUT = KOUT - 256.
END WHERE
- CASE default
+CASE default
CALL ABOR1_SFX('MODE_CHAR2REAL: CONVERSION ERROR IN READ_DIRECT SUBROUTINE')
END SELECT
IF (LHOOK) CALL DR_HOOK('MODE_CHAR2REAL:CHAR_TO_REAL',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/mode_coare30_psi.F90 b/src/SURFEX/mode_coare30_psi.F90
index 68eaa1102c74561e98f55a8e46fb1565ec3d6b3c..6e1c24115311067115221580b40d3252930391de 100644
--- a/src/SURFEX/mode_coare30_psi.F90
+++ b/src/SURFEX/mode_coare30_psi.F90
@@ -15,7 +15,7 @@ USE PARKIND1 ,ONLY : JPRB
MODULE PROCEDURE PSIFUNCTT
END INTERFACE
!
- CONTAINS
+CONTAINS
!
!---------------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/mode_conv_DOE.F90 b/src/SURFEX/mode_conv_DOE.F90
index 8f30190299aa7f64e37e37c892ea305f5f706ef8..db09823a52e161b25a8b2bd3527a529b73a65dda 100644
--- a/src/SURFEX/mode_conv_DOE.F90
+++ b/src/SURFEX/mode_conv_DOE.F90
@@ -58,7 +58,7 @@ INTERFACE CHTC_ROUGH_DOE
MODULE PROCEDURE CHTC_ROUGH_DOE_1D
END INTERFACE
!
- CONTAINS
+CONTAINS
!----------------------------
!#############################################
FUNCTION CHTC_VERT_DOE_0D(PTS, PTA) RESULT(PCHTC)
diff --git a/src/SURFEX/mode_cotwo.F90 b/src/SURFEX/mode_cotwo.F90
index ac5498fd2cf0335dd0dd1d24ac3fda0ba512e11f..60b38eeb51d4ce5deefea0adf1746abf96964c97 100644
--- a/src/SURFEX/mode_cotwo.F90
+++ b/src/SURFEX/mode_cotwo.F90
@@ -41,7 +41,7 @@ END INTERFACE
!
!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!
!####################################################################
!####################################################################
diff --git a/src/SURFEX/mode_coupling_canopy.F90 b/src/SURFEX/mode_coupling_canopy.F90
index 500eae47f40952e5d1323d981f0707071b2d0e8e..31861fc29045a06b0852b755fd553d1976b11605 100644
--- a/src/SURFEX/mode_coupling_canopy.F90
+++ b/src/SURFEX/mode_coupling_canopy.F90
@@ -9,7 +9,7 @@
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
- CONTAINS
+CONTAINS
!
! ###############################################################################
SUBROUTINE INIT_FORC( PFORC_U, PDFORC_UDU, PFORC_E, PDFORC_EDE, &
@@ -48,7 +48,7 @@ END SUBROUTINE INIT_FORC
! ###############################################################################
!
! ###############################################################################
-SUBROUTINE INIT_COUPLING_CANOPY( PP, PPA, PT, PQ, PU, PV, PZ, PXU, &
+SUBROUTINE INIT_COUPLING_CANOPY( SB, PPA, PU, PV, &
PRHOA, PALFAU, PBETAU, PALFATH, &
PBETATH, PALFAQ, PBETAQ, &
PPPA, PTTA, PQQA, PUU, PVV, &
@@ -57,20 +57,19 @@ SUBROUTINE INIT_COUPLING_CANOPY( PP, PPA, PT, PQ, PU, PV, PZ, PXU, &
PPET_AA_COEF, PPET_BB_COEF, &
PPEQ_AA_COEF, PPEQ_BB_COEF )
!
+USE MODD_CANOPY_n, ONLY : CANOPY_t
+!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_CSTS, ONLY : XCPD, XRD, XP00
USE MODD_SURF_ATM, ONLY : XWINDMIN
!
IMPLICIT NONE
!
-REAL, DIMENSION(:), INTENT(IN) :: PP
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
+!
REAL, DIMENSION(:), INTENT(IN) :: PPA
-REAL, DIMENSION(:), INTENT(IN) :: PT
-REAL, DIMENSION(:), INTENT(IN) :: PQ
REAL, DIMENSION(:), INTENT(IN) :: PU
REAL, DIMENSION(:), INTENT(IN) :: PV
-REAL, DIMENSION(:), INTENT(IN) :: PZ
-REAL, DIMENSION(:), INTENT(IN) :: PXU
REAL, DIMENSION(:), INTENT(IN) :: PRHOA
REAL, DIMENSION(:), INTENT(IN) :: PALFAU
REAL, DIMENSION(:), INTENT(IN) :: PBETAU
@@ -97,16 +96,16 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_COUPLING_CANOPY:INIT_COUPLING_CANOPY',0,ZHOOK_HANDLE)
!
-PPPA = PP(:)
-PTTA = PT(:)
-PQQA = PQ(:)
-PUU = PU / MAX(SQRT(PU**2+PV**2),XWINDMIN) * PXU(:)
-PVV = PV / MAX(SQRT(PU**2+PV**2),XWINDMIN) * PXU(:)
-PUUREF = PZ(:)
-PZZREF = PZ(:)
+PPPA = SB%XP(:,1)
+PTTA = SB%XT(:,1)
+PQQA = SB%XQ(:,1)
+PUU = PU / MAX(SQRT(PU**2+PV**2),XWINDMIN) * SB%XU(:,1)
+PVV = PV / MAX(SQRT(PU**2+PV**2),XWINDMIN) * SB%XU(:,1)
+PUUREF = SB%XZ(:,1)
+PZZREF = SB%XZ(:,1)
!
-PEXNA(:) = (PP(:)/XP00)**(XRD/XCPD)
-WHERE (PP(:)==XUNDEF) !* security at first time-step
+PEXNA(:) = (SB%XP(:,1)/XP00)**(XRD/XCPD)
+WHERE (SB%XP(:,1)==XUNDEF) !* security at first time-step
PEXNA = (PPA/XP00)**(XRD/XCPD)
PPPA = PPA
END WHERE
@@ -207,10 +206,10 @@ END SUBROUTINE INIT_COUPLING
! ###############################################################################
!
! ###############################################################################
-SUBROUTINE INIT_2M_10M( PP, PT, PQ, PXU, PXZ, PU, PV, PWIND, PRHOA, &
- PT2M, PQ2M, PHU2M, PZON10M, PMER10M, &
- PWIND10M, PWIND10M_MAX, PT2M_MIN, PT2M_MAX, &
- PHU2M_MIN, PHU2M_MAX )
+SUBROUTINE INIT_2M_10M( SB, D, PU, PV, PWIND, PRHOA )
+!
+USE MODD_CANOPY_n, ONLY : CANOPY_t
+USE MODD_DIAG_n, ONLY : DIAG_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
@@ -220,57 +219,44 @@ USE MODI_INTERPOL_SBL
!
IMPLICIT NONE
!
-REAL, DIMENSION(:), INTENT(IN) :: PP
-REAL, DIMENSION(:), INTENT(IN) :: PT
-REAL, DIMENSION(:), INTENT(IN) :: PQ
-REAL, DIMENSION(:,:), INTENT(IN) :: PXU
-REAL, DIMENSION(:,:), INTENT(IN) :: PXZ
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
+TYPE(DIAG_t), INTENT(INOUT) :: D
+!
REAL, DIMENSION(:), INTENT(IN) :: PU
REAL, DIMENSION(:), INTENT(IN) :: PV
REAL, DIMENSION(:), INTENT(IN) :: PWIND
REAL, DIMENSION(:), INTENT(IN) :: PRHOA
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M
-REAL, DIMENSION(:), INTENT(OUT) :: PQ2M
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M
-REAL, DIMENSION(:), INTENT(OUT) :: PZON10M
-REAL, DIMENSION(:), INTENT(OUT) :: PMER10M
-REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M
-REAL, DIMENSION(:), INTENT(INOUT) :: PWIND10M_MAX
-REAL, DIMENSION(:), INTENT(INOUT) :: PT2M_MIN
-REAL, DIMENSION(:), INTENT(INOUT) :: PT2M_MAX
-REAL, DIMENSION(:), INTENT(INOUT) :: PHU2M_MIN
-REAL, DIMENSION(:), INTENT(INOUT) :: PHU2M_MAX
-!
-REAL, DIMENSION(SIZE(PT)) :: ZU10
+!
+REAL, DIMENSION(SIZE(SB%XT,1)) :: ZU10
INTEGER :: JJ
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_COUPLING_CANOPY:INIT_2M_10M',0,ZHOOK_HANDLE)
!
-PT2M(:) = PT(:)
-PT2M_MIN(:) = MIN(PT2M(:),PT2M_MIN(:))
-PT2M_MAX(:) = MAX(PT2M(:),PT2M_MAX(:))
-PQ2M(:) = PQ(:) / PRHOA(:)
-PHU2M(:)= MIN( PQ2M(:) / QSAT(PT2M(:),PP(:)) , 1.)
-PHU2M_MIN(:) = MIN(PHU2M(:),PHU2M_MIN(:))
-PHU2M_MAX(:) = MAX(PHU2M(:),PHU2M_MAX(:))
- CALL INTERPOL_SBL(PXZ(:,:),PXU(:,:),10.,ZU10(:))
-DO JJ=1,SIZE(PT)
+D%XT2M(:) = SB%XT(:,2)
+D%XT2M_MIN(:) = MIN(D%XT2M(:),D%XT2M_MIN(:))
+D%XT2M_MAX(:) = MAX(D%XT2M(:),D%XT2M_MAX(:))
+D%XQ2M(:) = SB%XQ(:,2) / PRHOA(:)
+D%XHU2M(:)= MIN( D%XQ2M(:) / QSAT(D%XT2M(:),SB%XP(:,2)) , 1.)
+D%XHU2M_MIN(:) = MIN(D%XHU2M(:),D%XHU2M_MIN(:))
+D%XHU2M_MAX(:) = MAX(D%XHU2M(:),D%XHU2M_MAX(:))
+ CALL INTERPOL_SBL(SB%XZ(:,:),SB%XU(:,:),10.,ZU10(:))
+DO JJ=1,SIZE(SB%XT(:,2))
IF (ZU10(JJ)/=XUNDEF) THEN
IF (PWIND(JJ)>0.) THEN
- PZON10M(JJ) = ZU10(JJ) * PU(JJ)/PWIND(JJ)
- PMER10M(JJ) = ZU10(JJ) * PV(JJ)/PWIND(JJ)
+ D%XZON10M(JJ) = ZU10(JJ) * PU(JJ)/PWIND(JJ)
+ D%XMER10M(JJ) = ZU10(JJ) * PV(JJ)/PWIND(JJ)
ELSE
- PZON10M(JJ) = 0.
- PMER10M(JJ) = 0.
+ D%XZON10M(JJ) = 0.
+ D%XMER10M(JJ) = 0.
END IF
- PWIND10M(JJ) = SQRT(PZON10M(JJ)**2+PMER10M(JJ)**2)
- PWIND10M_MAX(JJ) = MAX(PWIND10M(JJ),PWIND10M_MAX(JJ))
+ D%XWIND10M(JJ) = SQRT(D%XZON10M(JJ)**2+D%XMER10M(JJ)**2)
+ D%XWIND10M_MAX(JJ) = MAX(D%XWIND10M(JJ),D%XWIND10M_MAX(JJ))
ELSE
- PZON10M(JJ) = XUNDEF
- PMER10M(JJ) = XUNDEF
- PWIND10M(JJ) = XUNDEF
- PWIND10M_MAX(JJ) = XUNDEF
+ D%XZON10M(JJ) = XUNDEF
+ D%XMER10M(JJ) = XUNDEF
+ D%XWIND10M(JJ) = XUNDEF
+ D%XWIND10M_MAX(JJ) = XUNDEF
END IF
END DO
!
diff --git a/src/SURFEX/mode_crodebug.F90 b/src/SURFEX/mode_crodebug.F90
index 22026e9c431af3480d0c2f5410b9ff1e38ed14de..7bcad4d537dc5f87b16c6524135181c8eaadc05c 100644
--- a/src/SURFEX/mode_crodebug.F90
+++ b/src/SURFEX/mode_crodebug.F90
@@ -53,17 +53,14 @@ REAL :: XLONCRODEBUG = -999.
REAL :: XWARNING_MASSBALANCE=1.E-4
REAL :: XWARNING_ENERGYBALANCE=1.E-4
!
- CONTAINS
+CONTAINS
!
-SUBROUTINE INIT_CRODEBUG (I)
+SUBROUTINE INIT_CRODEBUG (HSNOW_SCHEME)
! Check environment variables to activate crocus debugging mode if required
!
!
+ CHARACTER(LEN=*), INTENT(IN) :: HSNOW_SCHEME
!
-USE MODD_ISBA_n, ONLY : ISBA_t
-!
-!
-TYPE(ISBA_t), INTENT(INOUT) :: I
!
CHARACTER(1) :: YCROCUS_INFO,YCROCUS_DEBUG,YCROCUS_BALANCE
CHARACTER(8) :: YCROCUS_DEBUG_TIME
@@ -71,7 +68,7 @@ TYPE(ISBA_t), INTENT(INOUT) :: I
CHARACTER(6) :: YCROCUS_DEBUG_POINT
CHARACTER(12) :: YCROCUS_DEBUG_LAT,YCROCUS_DEBUG_LON
!
-IF (I%TSNOW%SCHEME=='CRO') THEN
+IF (HSNOW_SCHEME=='CRO') THEN
!
CALL GETENV("CROCUS_INFO",YCROCUS_INFO)
SELECT CASE (YCROCUS_INFO)
diff --git a/src/SURFEX/mode_diag.F90 b/src/SURFEX/mode_diag.F90
new file mode 100644
index 0000000000000000000000000000000000000000..88fc34b1a0990ecdb64f38e8956aeefe64d5f1c3
--- /dev/null
+++ b/src/SURFEX/mode_diag.F90
@@ -0,0 +1,641 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+MODULE MODE_DIAG
+! #####################
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+!
+IMPLICIT NONE
+!
+CONTAINS
+!
+SUBROUTINE ALLOC_SURF_BUD(DA,KLUA,KLUAC,KSWA)
+!
+TYPE(DIAG_t), INTENT(INOUT) :: DA
+INTEGER, INTENT(IN) :: KLUA
+INTEGER, INTENT(IN) :: KLUAC
+INTEGER, INTENT(IN) :: KSWA
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:ALLOC_SURF_BUD',0,ZHOOK_HANDLE)
+!
+ALLOCATE(DA%XRN (KLUAC))
+ALLOCATE(DA%XH (KLUAC))
+ALLOCATE(DA%XLE (KLUAC))
+ALLOCATE(DA%XLEI (KLUAC))
+ALLOCATE(DA%XGFLUX (KLUAC))
+!
+ALLOCATE(DA%XSWD (KLUAC))
+ALLOCATE(DA%XSWU (KLUAC))
+ALLOCATE(DA%XLWD (KLUAC))
+ALLOCATE(DA%XLWU (KLUAC))
+ALLOCATE(DA%XFMU (KLUAC))
+ALLOCATE(DA%XFMV (KLUAC))
+!
+IF (KLUAC>0) THEN
+ DA%XRN = XUNDEF
+ DA%XH = XUNDEF
+ DA%XLE = XUNDEF
+ DA%XLEI = XUNDEF
+ DA%XGFLUX = XUNDEF
+
+ DA%XSWD = XUNDEF
+ DA%XSWU = XUNDEF
+ DA%XLWD = XUNDEF
+ DA%XLWU = XUNDEF
+ DA%XFMU = XUNDEF
+ DA%XFMV = XUNDEF
+ENDIF
+!
+ALLOCATE(DA%XSWBD (KLUA,KSWA))
+ALLOCATE(DA%XSWBU (KLUA,KSWA))
+!
+IF (KLUA>0) THEN
+ DA%XSWBD = XUNDEF
+ DA%XSWBU = XUNDEF
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:ALLOC_SURF_BUD',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE ALLOC_SURF_BUD
+!
+SUBROUTINE ALLOC_N2M_BUD(DA,KLUA)
+!
+TYPE(DIAG_t), INTENT(INOUT) :: DA
+INTEGER, INTENT(IN) :: KLUA
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:ALLOC_N2M_BUD',0,ZHOOK_HANDLE)
+!
+ALLOCATE(DA%XRI (KLUA))
+ALLOCATE(DA%XT2M (KLUA))
+ALLOCATE(DA%XT2M_MIN (KLUA))
+ALLOCATE(DA%XT2M_MAX (KLUA))
+ALLOCATE(DA%XQ2M (KLUA))
+ALLOCATE(DA%XHU2M (KLUA))
+ALLOCATE(DA%XHU2M_MIN (KLUA))
+ALLOCATE(DA%XHU2M_MAX (KLUA))
+ALLOCATE(DA%XZON10M (KLUA))
+ALLOCATE(DA%XMER10M (KLUA))
+ALLOCATE(DA%XWIND10M (KLUA))
+ALLOCATE(DA%XWIND10M_MAX (KLUA))
+!
+IF (KLUA>0) THEN
+ DA%XRI = XUNDEF
+ DA%XT2M = XUNDEF
+ DA%XT2M_MIN = XUNDEF
+ DA%XT2M_MAX = -XUNDEF
+ DA%XQ2M = XUNDEF
+ DA%XHU2M = XUNDEF
+ DA%XHU2M_MIN= XUNDEF
+ DA%XHU2M_MAX= -XUNDEF
+ DA%XZON10M = XUNDEF
+ DA%XMER10M = XUNDEF
+ DA%XWIND10M = XUNDEF
+ DA%XWIND10M_MAX = 0.0
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:ALLOC_N2M_BUD',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE ALLOC_N2M_BUD
+!
+SUBROUTINE ALLOC_COEF_BUD(DA,KLUA)
+!
+TYPE(DIAG_t), INTENT(INOUT) :: DA
+INTEGER, INTENT(IN) :: KLUA
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:ALLOC_COEF_BUD',0,ZHOOK_HANDLE)
+!
+ALLOCATE(DA%XCD (KLUA))
+ALLOCATE(DA%XCH (KLUA))
+ALLOCATE(DA%XCE (KLUA))
+ALLOCATE(DA%XZ0 (KLUA))
+ALLOCATE(DA%XZ0H (KLUA))
+!
+IF (KLUA>0) THEN
+ DA%XCD = XUNDEF
+ DA%XCH = XUNDEF
+ DA%XCE = XUNDEF
+ DA%XZ0 = XUNDEF
+ DA%XZ0H = XUNDEF
+ENDIF
+
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:ALLOC_COEF_BUD',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE ALLOC_COEF_BUD
+!
+SUBROUTINE ALLOC_BUD(DGO,DA,KLU,KSW)
+!
+TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: DA
+INTEGER, INTENT(IN) :: KLU
+INTEGER, INTENT(IN) :: KSW
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:ALLOC_BUD',0,ZHOOK_HANDLE)
+!
+IF (DGO%LSURF_BUDGET .OR. DGO%LSURF_BUDGETC) THEN
+ CALL ALLOC_SURF_BUD(DA,KLU,KLU,KSW)
+ELSE
+ CALL ALLOC_SURF_BUD(DA,0,0,0)
+END IF
+!
+!* parameters at 2m
+!
+IF (DGO%N2M>=1) THEN
+ CALL ALLOC_N2M_BUD(DA,KLU)
+ELSE
+ CALL ALLOC_N2M_BUD(DA,0)
+END IF
+!
+!* transfer coefficients
+!
+IF (DGO%LCOEF) THEN
+ CALL ALLOC_COEF_BUD(DA,KLU)
+ELSE
+ CALL ALLOC_COEF_BUD(DA,0)
+END IF
+!
+!* surface humidity
+!
+IF (DGO%LSURF_VARS) THEN
+ ALLOCATE(DA%XQS (KLU))
+ DA%XQS = XUNDEF
+ELSE
+ ALLOCATE(DA%XQS (0))
+END IF
+!
+ALLOCATE(DA%XTS(KLU))
+DA%XTS = XUNDEF
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:ALLOC_BUD',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE ALLOC_BUD
+!
+SUBROUTINE INIT_BUD(DGO,DA,DAC,PVAL)
+!
+TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: DA
+TYPE(DIAG_t), INTENT(INOUT) :: DAC
+REAL, INTENT(IN) :: PVAL
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:INIT_BUD',0,ZHOOK_HANDLE)
+!
+IF (DGO%LSURF_BUDGET) THEN
+ CALL INIT_SURF_BUD(DA,PVAL)
+ DA%XEVAP = PVAL
+ DA%XSUBL = PVAL
+ENDIF
+IF (DGO%LSURF_BUDGETC) THEN
+ CALL INIT_SURF_BUD(DAC,PVAL)
+ DAC%XEVAP = PVAL
+ DAC%XSUBL = PVAL
+ENDIF
+IF (DGO%N2M>=1) CALL INIT_N2M_BUD(DA,PVAL)
+IF (DGO%LCOEF) CALL INIT_COEF_BUD(DA,PVAL)
+DA%XTS = PVAL
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:INIT_BUD',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE INIT_BUD
+!
+SUBROUTINE INIT_SURF_BUD(DA,PVAL)
+!
+TYPE(DIAG_t), INTENT(INOUT) :: DA
+REAL, INTENT(IN) :: PVAL
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:INIT_SURF_BUD',0,ZHOOK_HANDLE)
+!
+DA%XRN = PVAL
+DA%XH = PVAL
+DA%XLE = PVAL
+DA%XLEI = PVAL
+DA%XGFLUX = PVAL
+!
+DA%XSWD = PVAL
+DA%XSWU = PVAL
+DA%XLWD = PVAL
+DA%XLWU = PVAL
+DA%XFMU = PVAL
+DA%XFMV = PVAL
+!
+IF (SIZE(DA%XSWBD)>0) THEN
+ DA%XSWBD = PVAL
+ DA%XSWBU = PVAL
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:INIT_SURF_BUD',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE INIT_SURF_BUD
+!
+SUBROUTINE INIT_N2M_BUD(DA,PVAL)
+!
+TYPE(DIAG_t), INTENT(INOUT) :: DA
+REAL, INTENT(IN) :: PVAL
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:INIT_N2M_BUD',0,ZHOOK_HANDLE)
+!
+DA%XRI = PVAL
+DA%XT2M = PVAL
+DA%XT2M_MIN = PVAL
+DA%XT2M_MAX = PVAL
+DA%XQ2M = PVAL
+DA%XHU2M = PVAL
+DA%XHU2M_MIN= PVAL
+DA%XHU2M_MAX= PVAL
+DA%XZON10M = PVAL
+DA%XMER10M = PVAL
+DA%XWIND10M = PVAL
+DA%XWIND10M_MAX = PVAL
+DA%XSFCO2 = PVAL
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:INIT_N2M_BUD',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE INIT_N2M_BUD
+!
+SUBROUTINE INIT_COEF_BUD(DA,PVAL)
+!
+TYPE(DIAG_t), INTENT(INOUT) :: DA
+REAL, INTENT(IN) :: PVAL
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:INIT_COEF_BUD',0,ZHOOK_HANDLE)
+!
+DA%XCD = PVAL
+DA%XCH = PVAL
+DA%XCE = PVAL
+DA%XZ0 = PVAL
+DA%XZ0H = PVAL
+DA%XZ0EFF = PVAL
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:INIT_COEF_BUD',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE INIT_COEF_BUD
+!
+SUBROUTINE DIAG_EVAP(DGO, DA, DAC, HPROGRAM, DAUP, DAUPC, KMASK )
+!
+IMPLICIT NONE
+!
+TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: DA
+TYPE(DIAG_t), INTENT(INOUT) :: DAC
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+TYPE(DIAG_t), INTENT(INOUT) :: DAUP
+TYPE(DIAG_t), INTENT(INOUT) :: DAUPC
+INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
+!
+INTEGER :: JJ, ISIZE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:DIAG_EVAP',0,ZHOOK_HANDLE)
+!
+ISIZE = SIZE(KMASK)
+!
+ CALL DIAG_CUMUL(DGO, DA, DAC, HPROGRAM, DAUP, DAUPC, KMASK)
+!
+IF (DGO%LSURF_BUDGET) THEN
+ DO JJ=1,ISIZE
+ DAUP%XEVAP (KMASK(JJ)) = DA%XEVAP (JJ)
+ DAUP%XSUBL (KMASK(JJ)) = DA%XSUBL (JJ)
+ ENDDO
+END IF
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:DIAG_EVAP',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE DIAG_EVAP
+!
+SUBROUTINE DIAG_CUMUL(DGO, DA, DAC, HPROGRAM, DAUP, DAUPC, KMASK )
+!
+IMPLICIT NONE
+!
+TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: DA
+TYPE(DIAG_t), INTENT(INOUT) :: DAC
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+TYPE(DIAG_t), INTENT(INOUT) :: DAUP
+TYPE(DIAG_t), INTENT(INOUT) :: DAUPC
+INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
+!
+INTEGER :: JJ, ISIZE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:DIAG_CUMUL',0,ZHOOK_HANDLE)
+!
+ISIZE = SIZE(KMASK)
+!
+ CALL DIAG(DGO, DA, HPROGRAM, DAUP, KMASK)
+!
+IF (DGO%LSURF_BUDGETC) THEN
+ DO JJ=1,ISIZE
+ DAUPC%XRN (KMASK(JJ)) = DAC%XRN (JJ)
+ DAUPC%XH (KMASK(JJ)) = DAC%XH (JJ)
+ DAUPC%XLE (KMASK(JJ)) = DAC%XLE (JJ)
+ DAUPC%XLEI (KMASK(JJ)) = DAC%XLEI (JJ)
+ DAUPC%XGFLUX (KMASK(JJ)) = DAC%XGFLUX (JJ)
+ DAUPC%XEVAP (KMASK(JJ)) = DAC%XEVAP (JJ)
+ DAUPC%XSUBL (KMASK(JJ)) = DAC%XSUBL (JJ)
+ DAUPC%XSWD (KMASK(JJ)) = DAC%XSWD (JJ)
+ DAUPC%XSWU (KMASK(JJ)) = DAC%XSWU (JJ)
+ DAUPC%XLWD (KMASK(JJ)) = DAC%XLWD (JJ)
+ DAUPC%XLWU (KMASK(JJ)) = DAC%XLWU (JJ)
+ DAUPC%XFMU (KMASK(JJ)) = DAC%XFMU (JJ)
+ DAUPC%XFMV (KMASK(JJ)) = DAC%XFMV (JJ)
+ ENDDO
+END IF
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:DIAG_CUMUL',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE DIAG_CUMUL
+!
+SUBROUTINE DIAG(DGO, DA, HPROGRAM, DAUP, KMASK )
+!
+IMPLICIT NONE
+!
+TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: DA
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+TYPE(DIAG_t), INTENT(INOUT) :: DAUP
+INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
+!
+INTEGER :: JJ, ISIZE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:DIAG',0,ZHOOK_HANDLE)
+!
+ISIZE = SIZE(KMASK)
+!
+IF (DGO%LSURF_BUDGET) THEN
+ DO JJ=1,ISIZE
+ DAUP%XRN (KMASK(JJ)) = DA%XRN (JJ)
+ DAUP%XH (KMASK(JJ)) = DA%XH (JJ)
+ DAUP%XLE (KMASK(JJ)) = DA%XLE (JJ)
+ DAUP%XLEI (KMASK(JJ)) = DA%XLEI (JJ)
+ DAUP%XGFLUX (KMASK(JJ)) = DA%XGFLUX (JJ)
+ DAUP%XSWD (KMASK(JJ)) = DA%XSWD (JJ)
+ DAUP%XSWU (KMASK(JJ)) = DA%XSWU (JJ)
+ DAUP%XLWD (KMASK(JJ)) = DA%XLWD (JJ)
+ DAUP%XLWU (KMASK(JJ)) = DA%XLWU (JJ)
+ DAUP%XFMU (KMASK(JJ)) = DA%XFMU (JJ)
+ DAUP%XFMV (KMASK(JJ)) = DA%XFMV (JJ)
+ DAUP%XSWBD (KMASK(JJ),:) = DA%XSWBD (JJ,:)
+ DAUP%XSWBU (KMASK(JJ),:) = DA%XSWBU (JJ,:)
+ ENDDO
+END IF
+!
+IF (DGO%N2M>=1 .OR. DGO%LSURF_BUDGET) THEN
+ DO JJ=1,ISIZE
+ DAUP%XTS (KMASK(JJ)) = DA%XTS (JJ)
+ ENDDO
+ENDIF
+!
+IF (DGO%N2M>=1) THEN
+ DO JJ=1,ISIZE
+ DAUP%XRI (KMASK(JJ)) = DA%XRI (JJ)
+ DAUP%XT2M (KMASK(JJ)) = DA%XT2M (JJ)
+ DAUP%XT2M_MIN (KMASK(JJ)) = DA%XT2M_MIN (JJ)
+ DAUP%XT2M_MAX (KMASK(JJ)) = DA%XT2M_MAX (JJ)
+ DAUP%XQ2M (KMASK(JJ)) = DA%XQ2M (JJ)
+ DAUP%XHU2M (KMASK(JJ)) = DA%XHU2M (JJ)
+ DAUP%XHU2M_MIN(KMASK(JJ)) = DA%XHU2M_MIN (JJ)
+ DAUP%XHU2M_MAX(KMASK(JJ)) = DA%XHU2M_MAX (JJ)
+ DAUP%XZON10M (KMASK(JJ)) = DA%XZON10M (JJ)
+ DAUP%XMER10M (KMASK(JJ)) = DA%XMER10M (JJ)
+ DAUP%XWIND10M (KMASK(JJ)) = DA%XWIND10M (JJ)
+ DAUP%XWIND10M_MAX (KMASK(JJ)) = DA%XWIND10M_MAX (JJ)
+ ENDDO
+END IF
+!
+IF (DGO%LCOEF) THEN
+ DO JJ=1,ISIZE
+ DAUP%XCD (KMASK(JJ)) = DA%XCD (JJ)
+ DAUP%XCH (KMASK(JJ)) = DA%XCH (JJ)
+ DAUP%XCE (KMASK(JJ)) = DA%XCE (JJ)
+ DAUP%XZ0 (KMASK(JJ)) = DA%XZ0 (JJ)
+ DAUP%XZ0H (KMASK(JJ)) = DA%XZ0H (JJ)
+ ENDDO
+END IF
+!
+IF (DGO%LSURF_VARS) THEN
+ DO JJ=1,ISIZE
+ DAUP%XQS (KMASK(JJ)) = DA%XQS (JJ)
+ ENDDO
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:DIAG',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE DIAG
+!
+SUBROUTINE INIT_EVAP_BUD(DEA)
+!
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEA
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:INIT_EVAP_BUD',0,ZHOOK_HANDLE)
+!
+DEA%XLEG = 0.0
+DEA%XLEGI = 0.0
+DEA%XLEV = 0.0
+DEA%XLES = 0.0
+!
+DEA%XLESL = 0.0
+DEA%XSNDRIFT = 0.0
+!
+DEA%XLER = 0.0
+DEA%XLETR = 0.0
+!
+DEA%XDRAIN = 0.0
+DEA%XRUNOFF = 0.0
+DEA%XDRIP = 0.0
+DEA%XRRVEG = 0.0
+DEA%XMELT = 0.0
+!
+DEA%XIRRIG_FLUX = 0.0
+!
+DEA%XGPP = 0.0
+DEA%XRESP_AUTO = 0.0
+DEA%XRESP_ECO = 0.0
+!
+DEA%XQSB = 0.0
+DEA%XHORT = 0.0
+!
+DEA%XIFLOOD = 0.0
+DEA%XPFLOOD = 0.0
+DEA%XLE_FLOOD = 0.0
+DEA%XLEI_FLOOD = 0.0
+!
+DEA%XRN_SN_FR = 0.0
+DEA%XH_SN_FR = 0.0
+DEA%XLEI_SN_FR = 0.0
+DEA%XLE_SN_FR = 0.0
+DEA%XGFLUX_SN_FR = 0.0
+DEA%XLEG_SN_FR = 0.0
+DEA%XLEGI_SN_FR = 0.0
+DEA%XLEV_SN_FR = 0.0
+DEA%XLETR_SN_FR = 0.0
+DEA%XUSTAR_SN_FR = 0.0
+DEA%XLER_SN_FR = 0.0
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:INIT_EVAP_BUD',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE INIT_EVAP_BUD
+!
+SUBROUTINE INIT_MEB_BUD(DEA)
+!
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEA
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:INIT_MEB_BUD',0,ZHOOK_HANDLE)
+!
+DEA%XLELITTER = 0.0
+DEA%XLELITTERI = 0.0
+DEA%XDRIPLIT = 0.0
+DEA%XRRLIT = 0.0
+!
+DEA%XLEV_CV = 0.0
+DEA%XLES_CV = 0.0
+DEA%XLETR_CV = 0.0
+DEA%XLE_CV = 0.0
+DEA%XH_CV = 0.0
+DEA%XMELT_CV = 0.0
+DEA%XFRZ_CV = 0.0
+!
+DEA%XLETR_GV = 0.0
+DEA%XLER_GV = 0.0
+DEA%XLE_GV = 0.0
+DEA%XH_GV = 0.0
+!
+DEA%XLE_GN = 0.0
+DEA%XEVAP_GN = 0.0
+DEA%XH_GN = 0.0
+DEA%XSR_GN = 0.0
+DEA%XSWDOWN_GN = 0.0
+DEA%XLWDOWN_GN = 0.0
+!
+DEA%XEVAP_G = 0.0
+DEA%XLE_CA = 0.0
+DEA%XH_CA = 0.0
+!
+DEA%XSWUP = 0.0
+DEA%XLWUP = 0.0
+!
+DEA%XSWNET_V = 0.0
+DEA%XSWNET_G = 0.0
+DEA%XSWNET_N = 0.0
+DEA%XSWNET_NS = 0.0
+DEA%XLWNET_V = 0.0
+DEA%XLWNET_G = 0.0
+DEA%XLWNET_N = 0.0
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:INIT_MEB_BUD',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE INIT_MEB_BUD
+!
+SUBROUTINE INIT_WATER_BUD(DEA)
+!
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEA
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:INIT_WATER_BUD',0,ZHOOK_HANDLE)
+!
+DEA%XDWG = 0.0
+DEA%XDWGI = 0.0
+DEA%XDWR = 0.0
+DEA%XDSWE = 0.0
+DEA%XWATBUD = 0.0
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:INIT_WATER_BUD',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE INIT_WATER_BUD
+!
+SUBROUTINE AVG_DIAG_TSTEP_EVAP(PTSTEP, DEAC, DEA)
+!
+REAL, INTENT(IN) :: PTSTEP
+TYPE(DIAG_EVAP_ISBA_t), INTENT(IN) :: DEAC
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEA
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:AVG_DIAG_TSTEP_EVAP',0,ZHOOK_HANDLE)
+!
+DEA%XLEG (:) = DEAC%XLEG (:)/PTSTEP
+DEA%XLEGI (:) = DEAC%XLEGI (:)/PTSTEP
+DEA%XLEV (:) = DEAC%XLEV (:)/PTSTEP
+DEA%XLES (:) = DEAC%XLES (:)/PTSTEP
+!
+DEA%XLESL (:) = DEAC%XLESL (:)/PTSTEP
+DEA%XSNDRIFT(:) = DEAC%XSNDRIFT(:)/PTSTEP
+!
+DEA%XLER (:) = DEAC%XLER (:)/PTSTEP
+DEA%XLETR (:) = DEAC%XLETR (:)/PTSTEP
+DEA%XDRAIN (:) = DEAC%XDRAIN (:)/PTSTEP
+DEA%XQSB (:) = DEAC%XQSB (:)/PTSTEP
+DEA%XRUNOFF (:) = DEAC%XRUNOFF (:)/PTSTEP
+DEA%XHORT (:) = DEAC%XHORT (:)/PTSTEP
+DEA%XDRIP (:) = DEAC%XDRIP (:)/PTSTEP
+DEA%XRRVEG (:) = DEAC%XRRVEG (:)/PTSTEP
+DEA%XMELT (:) = DEAC%XMELT (:)/PTSTEP
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:AVG_DIAG_TSTEP_EVAP',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE AVG_DIAG_TSTEP_EVAP
+!
+SUBROUTINE AVG_DIAG_TSTEP_WATER(PTSTEP, DEAC, DEA)
+!
+REAL, INTENT(IN) :: PTSTEP
+TYPE(DIAG_EVAP_ISBA_t), INTENT(IN) :: DEAC
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEA
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:AVG_DIAG_TSTEP_WATER',0,ZHOOK_HANDLE)
+!
+DEA%XDWG (:) = DEAC%XDWG (:)/PTSTEP
+DEA%XDWGI (:) = DEAC%XDWGI (:)/PTSTEP
+DEA%XDWR (:) = DEAC%XDWR (:)/PTSTEP
+DEA%XDSWE (:) = DEAC%XDSWE (:)/PTSTEP
+DEA%XWATBUD(:) = DEAC%XWATBUD(:)/PTSTEP
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:AVG_DIAG_TSTEP_WATER',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE AVG_DIAG_TSTEP_WATER
+!
+SUBROUTINE AVG_DIAG_TSTEP_SURF(PTSTEP, DAC, DA)
+!
+REAL, INTENT(IN) :: PTSTEP
+TYPE(DIAG_t), INTENT(IN) :: DAC
+TYPE(DIAG_t), INTENT(INOUT) :: DA
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:AVG_DIAG_TSTEP_SURF',0,ZHOOK_HANDLE)
+!
+DA%XRN (:) = DAC%XRN (:)/PTSTEP
+DA%XH (:) = DAC%XH (:)/PTSTEP
+DA%XLE (:) = DAC%XLE (:)/PTSTEP
+DA%XLEI (:) = DAC%XLEI (:)/PTSTEP
+DA%XGFLUX(:) = DAC%XGFLUX(:)/PTSTEP
+!
+DA%XEVAP (:) = DAC%XEVAP (:)/PTSTEP
+DA%XSUBL (:) = DAC%XSUBL (:)/PTSTEP
+!
+DA%XSWD(:) = DAC%XSWD(:)/PTSTEP
+DA%XSWU(:) = DAC%XSWU(:)/PTSTEP
+DA%XLWD(:) = DAC%XLWD(:)/PTSTEP
+DA%XLWU(:) = DAC%XLWU(:)/PTSTEP
+!
+IF (LHOOK) CALL DR_HOOK('MODE_DIAG:AVG_DIAG_TSTEP_SURF',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE AVG_DIAG_TSTEP_SURF
+!
+!-------------------------------------------------------------------------------
+!
+END MODULE MODE_DIAG
diff --git a/src/SURFEX/mode_dslt_surf.F90 b/src/SURFEX/mode_dslt_surf.F90
index d4a04c45e1201a2d495e32075f2f42fbce2b013a..c5e6d2fab1f7f7ac0145f4115f16d9f1a321e119 100644
--- a/src/SURFEX/mode_dslt_surf.F90
+++ b/src/SURFEX/mode_dslt_surf.F90
@@ -12,7 +12,7 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
- CONTAINS
+CONTAINS
!!
!! ############################################################
SUBROUTINE MASSFLUX2MOMENTFLUX( &
diff --git a/src/SURFEX/mode_dstmblutl.F90 b/src/SURFEX/mode_dstmblutl.F90
index 862fef2023c64b17488779d611003e93aa79ff8f..5a0e746c410ef10a4cdb79211f7f44c7a8fabac1 100644
--- a/src/SURFEX/mode_dstmblutl.F90
+++ b/src/SURFEX/mode_dstmblutl.F90
@@ -10,7 +10,7 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
- CONTAINS
+CONTAINS
!
!----------------------------------------------------------------------------------------
SUBROUTINE WND_FRC_THR_SLT_GET(PDNS_MDP, PDP, PWND_FRC_THR_SLT)
diff --git a/src/SURFEX/mode_ekf.F90 b/src/SURFEX/mode_ekf.F90
index cbc2885e20c85e6adcc4d039ceee4ad6cf852b30..62bc21b3b5050c6b12111b309729baf181262052 100644
--- a/src/SURFEX/mode_ekf.F90
+++ b/src/SURFEX/mode_ekf.F90
@@ -29,7 +29,7 @@ INTERFACE SET_FILEIN
MODULE PROCEDURE SET_FILEIN
END INTERFACE
!
- CONTAINS
+CONTAINS
!
SUBROUTINE GET_FILE_NAME(KYEAR,KMONTH,KDAY,KHOUR,HMFILE)
!
@@ -62,21 +62,21 @@ IF (LHOOK) CALL DR_HOOK('MODE_EKF:GET_FILE_NAME',1,ZHOOK_HANDLE)
END SUBROUTINE GET_FILE_NAME
!
!
-SUBROUTINE B_BIG_LOOP (I, &
+SUBROUTINE B_BIG_LOOP (IO, &
HACTION,HFILE,PTAB,PTAB_IN)
!
!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
USE MODD_ASSIM, ONLY : NVAR
!
IMPLICIT NONE
!
!
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
!
- CHARACTER(LEN=4), INTENT(IN) :: HACTION
- CHARACTER(LEN=*), INTENT(IN) :: HFILE
+CHARACTER(LEN=4), INTENT(IN) :: HACTION
+CHARACTER(LEN=*), INTENT(IN) :: HFILE
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTAB
REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: PTAB_IN
INTEGER :: JI,JJ,JK,JL,JJJ,L1,K1
@@ -98,11 +98,11 @@ IKI = SIZE(PTAB,1)
DO JL = 1,NVAR ! control variable (x at previous time step)
DO JK = 1,NVAR
DO JI = 1,IKI
- DO JJ = 1,I%NPATCH
- DO JJJ = 1,I%NPATCH
+ DO JJ = 1,IO%NPATCH
+ DO JJJ = 1,IO%NPATCH
!
- L1 = JJ+I%NPATCH*(JL-1)
- K1 = JJJ+I%NPATCH*(JK-1)
+ L1 = JJ+IO%NPATCH*(JL-1)
+ K1 = JJJ+IO%NPATCH*(JK-1)
!
IF ( HACTION=="READ" ) THEN
READ (111) PTAB(JI,L1,K1)
diff --git a/src/SURFEX/mode_fasurfex.F90 b/src/SURFEX/mode_fasurfex.F90
index 28899f006f2bf95d120becfc7b4399ce8efbd257..ae3c45c169d181d8a7bc302c536c678cb61875a5 100644
--- a/src/SURFEX/mode_fasurfex.F90
+++ b/src/SURFEX/mode_fasurfex.F90
@@ -24,7 +24,7 @@ MODULE MODE_FASURFEX
MODULE PROCEDURE FALIT_L_D
END INTERFACE
!
- CONTAINS
+CONTAINS
!
! #############################################################
SUBROUTINE FAECR_I(KREP,KN,CNOMC,KDATA)
diff --git a/src/SURFEX/mode_flake.F90 b/src/SURFEX/mode_flake.F90
index b5ffcf15f2d58e6820a8a5fbc324b104826358cd..b55d92e3077691285dcbdf3db2481e3e8bc367da 100644
--- a/src/SURFEX/mode_flake.F90
+++ b/src/SURFEX/mode_flake.F90
@@ -131,95 +131,60 @@ REAL,PARAMETER,PRIVATE :: Z_=-HUGE(0.0)
! Temperatures at the previous time step ("p") and the updated temperatures ("n")
REAL :: T_mnw_p_flk=Z_, T_mnw_n_flk=Z_ ! Mean temperature of the water column [K]
-!$OMP THREADPRIVATE(T_mnw_p_flk, T_mnw_n_flk)
REAL :: T_snow_p_flk=Z_, T_snow_n_flk=Z_ ! Temperature at the air-snow interface [K]
-!$OMP THREADPRIVATE(T_snow_p_flk, T_snow_n_flk)
REAL :: T_ice_p_flk=Z_, T_ice_n_flk=Z_ ! Temperature at the snow-ice or air-ice interface [K]
-!$OMP THREADPRIVATE(T_ice_p_flk, T_ice_n_flk)
REAL :: T_wML_p_flk=Z_, T_wML_n_flk=Z_ ! Mixed-layer temperature [K]
-!$OMP THREADPRIVATE(T_wML_p_flk, T_wML_n_flk)
REAL :: T_bot_p_flk=Z_, T_bot_n_flk=Z_ ! Temperature at the water-bottom sediment interface [K]
-!$OMP THREADPRIVATE(T_bot_p_flk, T_bot_n_flk)
REAL :: T_B1_p_flk=Z_, T_B1_n_flk=Z_ ! Temperature at the bottom of the upper layer of the sediments [K]
-!$OMP THREADPRIVATE(T_B1_p_flk, T_B1_n_flk)
! Thickness of various layers at the previous time step ("p") and the updated values ("n")
REAL :: h_snow_p_flk=Z_, h_snow_n_flk=Z_ ! Snow thickness [m]*
-!$OMP THREADPRIVATE(h_snow_p_flk, h_snow_n_flk)
REAL :: h_ice_p_flk=Z_, h_ice_n_flk=Z_ ! Ice thickness [m]
-!$OMP THREADPRIVATE(h_ice_p_flk, h_ice_n_flk)
REAL :: h_ML_p_flk=Z_, h_ML_n_flk=Z_ ! Thickness of the mixed-layer [m]
-!$OMP THREADPRIVATE(h_ML_p_flk, h_ML_n_flk)
REAL :: H_B1_p_flk=Z_, H_B1_n_flk=Z_ ! Thickness of the upper layer of bottom sediments [m]
-!$OMP THREADPRIVATE(H_B1_p_flk, H_B1_n_flk)
! The shape factor(s) at the previous time step ("p") and the updated value(s) ("n")
REAL :: C_T_p_flk=Z_, C_T_n_flk=Z_ ! Shape factor (thermocline)
-!$OMP THREADPRIVATE(C_T_p_flk, C_T_n_flk)
REAL :: C_TT_flk=Z_ ! Dimensionless parameter (thermocline)
-!$OMP THREADPRIVATE(C_TT_flk)
REAL :: C_Q_flk=Z_ ! Shape factor with respect to the heat flux (thermocline)
-!$OMP THREADPRIVATE(C_Q_flk)
REAL :: C_I_flk=Z_ ! Shape factor (ice)
-!$OMP THREADPRIVATE(C_I_flk)
REAL :: C_S_flk=Z_ ! Shape factor (snow)
-!$OMP THREADPRIVATE(C_S_flk)
! Derivatives of the shape functions
REAL :: Phi_T_pr0_flk=Z_ ! d\Phi_T(0)/d\zeta (thermocline)
-!$OMP THREADPRIVATE(Phi_T_pr0_flk)
REAL :: Phi_I_pr0_flk=Z_ ! d\Phi_I(0)/d\zeta_I (ice)
-!$OMP THREADPRIVATE(Phi_I_pr0_flk)
REAL :: Phi_I_pr1_flk=Z_ ! d\Phi_I(1)/d\zeta_I (ice)
-!$OMP THREADPRIVATE(Phi_I_pr1_flk)
REAL :: Phi_S_pr0_flk=Z_ ! d\Phi_S(0)/d\zeta_S (snow)
-!$OMP THREADPRIVATE(Phi_S_pr0_flk)
! Heat and radiation fluxes
REAL :: Q_snow_flk=Z_ ! Heat flux through the air-snow interface [W m^{-2}]
-!$OMP THREADPRIVATE(Q_snow_flk)
REAL :: Q_ice_flk=Z_ ! Heat flux through the snow-ice or air-ice interface [W m^{-2}]
-!$OMP THREADPRIVATE(Q_ice_flk)
REAL :: Q_w_flk=Z_ ! Heat flux through the ice-water or air-water interface [W m^{-2}]
-!$OMP THREADPRIVATE(Q_w_flk)
REAL :: Q_bot_flk=Z_ ! Heat flux through the water-bottom sediment interface [W m^{-2}]
-!$OMP THREADPRIVATE(Q_bot_flk)
REAL :: I_atm_flk=Z_ ! Radiation flux at the lower boundary of the atmosphere [W m^{-2}],
! i.e. the incident radiation flux with no regard for the surface albedo.
-!$OMP THREADPRIVATE(I_atm_flk)
REAL :: I_snow_flk=Z_ ! Radiation flux through the air-snow interface [W m^{-2}]
-!$OMP THREADPRIVATE(I_snow_flk)
REAL :: I_ice_flk=Z_ ! Radiation flux through the snow-ice or air-ice interface [W m^{-2}]
-!$OMP THREADPRIVATE(I_ice_flk)
REAL :: I_w_flk=Z_ ! Radiation flux through the ice-water or air-water interface [W m^{-2}]
-!$OMP THREADPRIVATE(I_w_flk)
REAL :: I_h_flk=Z_ ! Radiation flux through the mixed-layer-thermocline interface [W m^{-2}]
-!$OMP THREADPRIVATE(I_h_flk)
REAL :: I_bot_flk=Z_ ! Radiation flux through the water-bottom sediment interface [W m^{-2}]
-!$OMP THREADPRIVATE(I_bot_flk)
REAL :: I_intm_0_h_flk=Z_ ! Mean radiation flux over the mixed layer [W m^{-1}]
-!$OMP THREADPRIVATE(I_intm_0_h_flk)
REAL :: I_intm_h_D_flk=Z_ ! Mean radiation flux over the thermocline [W m^{-1}]
-!$OMP THREADPRIVATE(I_intm_h_D_flk)
REAL :: Q_star_flk=Z_ ! A generalized heat flux scale [W m^{-2}]
-!$OMP THREADPRIVATE(Q_star_flk)
! Velocity scales
REAL :: u_star_w_flk=Z_ ! Friction velocity in the surface layer of lake water [m s^{-1}]
-!$OMP THREADPRIVATE(u_star_w_flk)
REAL :: w_star_sfc_flk=Z_ ! Convective velocity scale,
! using a generalized heat flux scale [m s^{-1}]
-!$OMP THREADPRIVATE(w_star_sfc_flk)
! The rate of snow accumulation
REAL :: dMsnowdt_flk=Z_ ! The rate of snow accumulation [kg m^{-2} s^{-1}]
-!$OMP THREADPRIVATE(dMsnowdt_flk)
!==============================================================================
! Procedures
!==============================================================================
- CONTAINS
+CONTAINS
!==============================================================================
! The codes of the FLake procedures are stored in separate "*.incf" files
@@ -555,7 +520,7 @@ h_snow_n_flk = h_snow_p_flk
h_ice_n_flk = h_ice_p_flk
h_ML_n_flk = h_ML_p_flk
H_B1_n_flk = H_B1_p_flk
- C_T_n_flk = C_T_p_flk
+C_T_n_flk = C_T_p_flk
!------------------------------------------------------------------------------
! Compute fluxes, using variables from the previous time step.
diff --git a/src/SURFEX/mode_gauss_index.F90 b/src/SURFEX/mode_gauss_index.F90
deleted file mode 100644
index 788ad3984626a7db19f53c6f006b7a2183dc68c3..0000000000000000000000000000000000000000
--- a/src/SURFEX/mode_gauss_index.F90
+++ /dev/null
@@ -1,16 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-!##########################
-MODULE MODE_GAUSS_INDEX
-!##########################
-!
-!
-!!!! to be suppressed
-!
-!############################################################################
-!
-!
-END MODULE MODE_GAUSS_INDEX
-
diff --git a/src/SURFEX/mode_geo_gauss.F90 b/src/SURFEX/mode_geo_gauss.F90
index 9dcb2b0422f3388a6753d70d6b65289eaf6e43f2..f148bcd5e4983d10f859aec6264476c82ed49df2 100644
--- a/src/SURFEX/mode_geo_gauss.F90
+++ b/src/SURFEX/mode_geo_gauss.F90
@@ -11,7 +11,6 @@ MODULE MODE_GEO_GAUSS
!! MODIFICATION
!! ------------
!! Original 10/2005
- !! J.Escobar 30/03/2017 : Management of compilation of ECMWF_RAD in REAL*8 with MNH_REAL=R4
!!
!---------------------------------------------------------------------------
USE EGGANGLES, ONLY : LOLA
@@ -50,7 +49,7 @@ MODULE MODE_GEO_GAUSS
MODULE PROCEDURE MAP_FAC_V, MAP_FAC_S
END INTERFACE
!
- CONTAINS
+CONTAINS
!==========================GAUSS_TR=========================================
TYPE(LOLA) FUNCTION GAUSS_TR_S (PT_REEL,PT_POLE,PCODIL) RESULT (PT_G)
TYPE (LOLA), INTENT(IN) :: PT_REEL
@@ -107,7 +106,7 @@ MODULE MODE_GEO_GAUSS
TYPE (LOLA), INTENT(IN) :: PT_TR
TYPE (LOLA), INTENT(IN) :: PT_POLE
- REAL :: ZSIN, ZCOS
+ REAL(KIND=JPRB) :: ZSIN, ZCOS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ROTATE_G_S',0,ZHOOK_HANDLE)
@@ -130,7 +129,7 @@ MODULE MODE_GEO_GAUSS
TYPE (LOLA), INTENT(IN) :: PT_POLE
TYPE (LOLA), DIMENSION(SIZE(PT_TR)) :: PT_REEL
- REAL, DIMENSION(SIZE(PT_TR)) :: ZSIN, ZCOS
+ REAL(KIND=JPRB), DIMENSION(SIZE(PT_TR)) :: ZSIN, ZCOS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ROTATE_G_V',0,ZHOOK_HANDLE)
@@ -156,7 +155,7 @@ MODULE MODE_GEO_GAUSS
TYPE (LOLA), INTENT(IN) :: PT_REEL
TYPE (LOLA), INTENT(IN) :: PT_POLE
- REAL :: ZSIN, ZCOS
+ REAL(KIND=JPRB) :: ZSIN, ZCOS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ANTI_ROTATE_G_S',0,ZHOOK_HANDLE)
@@ -178,7 +177,7 @@ MODULE MODE_GEO_GAUSS
TYPE (LOLA), INTENT(IN) :: PT_POLE
TYPE (LOLA), DIMENSION(SIZE(PT_REEL)) :: PT_TR
- REAL, DIMENSION(SIZE(PT_REEL)) :: ZSIN, ZCOS
+ REAL(KIND=JPRB), DIMENSION(SIZE(PT_REEL)) :: ZSIN, ZCOS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ANTI_ROTATE_G_V',0,ZHOOK_HANDLE)
@@ -203,7 +202,7 @@ MODULE MODE_GEO_GAUSS
TYPE (LOLA), INTENT(IN) :: PT_COORD
REAL, INTENT(IN) :: PCODIL
- REAL :: ZPC2, ZSIN, ZCOS
+ REAL(KIND=JPRB) :: ZPC2, ZSIN, ZCOS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ETIR_S',0,ZHOOK_HANDLE)
@@ -223,7 +222,7 @@ MODULE MODE_GEO_GAUSS
REAL, INTENT(IN) :: PCODIL
TYPE (LOLA), DIMENSION(SIZE(PT_COORD)) :: PT_ET
- REAL, DIMENSION(SIZE(PT_COORD)) :: ZPC2, ZSIN, ZCOS
+ REAL(KIND=JPRB), DIMENSION(SIZE(PT_COORD)) :: ZPC2, ZSIN, ZCOS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ETIR_V',0,ZHOOK_HANDLE)
@@ -242,7 +241,7 @@ MODULE MODE_GEO_GAUSS
TYPE (LOLA), INTENT(IN) :: PT_COORD
REAL, INTENT(IN) :: PCODIL
- REAL :: ZPC2, ZSIN, ZCOS
+ REAL(KIND=JPRB) :: ZPC2, ZSIN, ZCOS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:RETRE_S',0,ZHOOK_HANDLE)
@@ -262,7 +261,7 @@ MODULE MODE_GEO_GAUSS
REAL, INTENT(IN) :: PCODIL
TYPE (LOLA), DIMENSION(SIZE(PT_COORD)) :: PT_RE
- REAL, DIMENSION(SIZE(PT_COORD)) :: ZPC2, ZSIN, ZCOS
+ REAL(KIND=JPRB), DIMENSION(SIZE(PT_COORD)) :: ZPC2, ZSIN, ZCOS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:RETRE_V',0,ZHOOK_HANDLE)
@@ -284,7 +283,7 @@ MODULE MODE_GEO_GAUSS
TYPE (LOLA), INTENT(IN) :: POLE, PT_COORD
REAL, INTENT(IN) :: PCODIL
- REAL :: ZPC2
+ REAL(KIND=JPRB) :: ZPC2
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:MAP_FAC_S',0,ZHOOK_HANDLE)
ZPC2 = PCODIL*PCODIL
@@ -300,7 +299,7 @@ MODULE MODE_GEO_GAUSS
REAL, INTENT(IN) :: PCODIL
REAL, DIMENSION(SIZE(PT_COORD)) :: PMF
- REAL, DIMENSION(SIZE(PT_COORD)) :: ZPC2
+ REAL(KIND=JPRB), DIMENSION(SIZE(PT_COORD)) :: ZPC2
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:MAP_FAC_V',0,ZHOOK_HANDLE)
diff --git a/src/SURFEX/mode_glt_dia_ar5.F90 b/src/SURFEX/mode_glt_dia_ar5.F90
index 10109acd7a896de962a6a0d60ac6aa87530a4e0f..fe224b501171494df2ff9b0b234af4d2314f8089 100644
--- a/src/SURFEX/mode_glt_dia_ar5.F90
+++ b/src/SURFEX/mode_glt_dia_ar5.F90
@@ -46,7 +46,7 @@
! --------------------- BEGIN MODULE mode_glt_dia_ar5 -----------------------
MODULE mode_glt_dia_ar5
- CONTAINS
+CONTAINS
!
!
! -----------------------------------------------------------------------
diff --git a/src/SURFEX/mode_glt_dia_glt.F90 b/src/SURFEX/mode_glt_dia_glt.F90
index a932c7d25ced8c30132955ec4ba41089995bfae1..1ebc09264e3edeae8873e71cdf1445b119526c23 100644
--- a/src/SURFEX/mode_glt_dia_glt.F90
+++ b/src/SURFEX/mode_glt_dia_glt.F90
@@ -76,7 +76,7 @@ MODULE mode_glt_dia_glt
! !
! END INTERFACE
- CONTAINS
+CONTAINS
!
! ---------------------- END MODULE modi_glt_dia_glt ------------------------
!
diff --git a/src/SURFEX/mode_glt_dia_lu.F90 b/src/SURFEX/mode_glt_dia_lu.F90
index 4725bb6f87e0a53364a9c28c754ec1cfe6d89f38..79edccafb2e647c1bfc3cf10f45c9d183a0fa29a 100644
--- a/src/SURFEX/mode_glt_dia_lu.F90
+++ b/src/SURFEX/mode_glt_dia_lu.F90
@@ -48,7 +48,7 @@ MODULE mode_glt_dia_lu
!END INTERFACE
!END MODULE mode_glt_dia_lu
!
- CONTAINS
+CONTAINS
!
!
!
diff --git a/src/SURFEX/mode_glt_nemo_bound.F90 b/src/SURFEX/mode_glt_nemo_bound.F90
index 0da9f0672bdda17ad08cf66c96104797053348dd..ebc3d0bd6ffaf1cec42e278851814c1b893a5b38 100644
--- a/src/SURFEX/mode_glt_nemo_bound.F90
+++ b/src/SURFEX/mode_glt_nemo_bound.F90
@@ -140,7 +140,7 @@ MODULE mode_glt_nemo_bound
!!----------------------------------------------------------------------
#endif
- CONTAINS
+CONTAINS
#if ! defined in_surfex
diff --git a/src/SURFEX/mode_gltools_strlast.F90 b/src/SURFEX/mode_gltools_strlast.F90
index dba9e2a580dcf8f8957072125c2705260969c8ec..3a73ef8fb046e2642c5003355ca8733adcc11cc2 100644
--- a/src/SURFEX/mode_gltools_strlast.F90
+++ b/src/SURFEX/mode_gltools_strlast.F90
@@ -72,16 +72,16 @@ FUNCTION glt_strlast( hval,kn )
!
IMPLICIT NONE
!
- CHARACTER(*), INTENT(in) :: &
+CHARACTER(*), INTENT(in) :: &
hval
INTEGER, INTENT(in) :: &
kn
- CHARACTER(LEN=kn) :: &
+CHARACTER(LEN=kn) :: &
glt_strlast
!
INTEGER :: &
ilen
- CHARACTER(LEN=LEN(TRIM(hval))) :: &
+CHARACTER(LEN=LEN(TRIM(hval))) :: &
ystr
!
ilen = LEN(TRIM(hval))
diff --git a/src/SURFEX/mode_gltools_wrivais.F90 b/src/SURFEX/mode_gltools_wrivais.F90
index 4a8f62561042fb103d8bd0838e2042cb36def62d..4af35f5785012853eae3fbc3cf957198c6761436 100644
--- a/src/SURFEX/mode_gltools_wrivais.F90
+++ b/src/SURFEX/mode_gltools_wrivais.F90
@@ -59,7 +59,7 @@ INTERFACE gltools_wrivai
MODULE PROCEDURE gltools_wrivai_3d
END INTERFACE
!
- CONTAINS
+CONTAINS
!
! -----------------------------------------------------------------------
! ------------------- SUBROUTINE gltools_wrivai_2d ----------------------
diff --git a/src/SURFEX/mode_gridtype_cartesian.F90 b/src/SURFEX/mode_gridtype_cartesian.F90
index c0351b2cfa2d98b11a6a7091edcaa4826458fc81..52884e714fb8dc6ec668a04d55c3d803567618f5 100644
--- a/src/SURFEX/mode_gridtype_cartesian.F90
+++ b/src/SURFEX/mode_gridtype_cartesian.F90
@@ -13,7 +13,7 @@
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
- CONTAINS
+CONTAINS
!############################################################################
!############################################################################
!############################################################################
diff --git a/src/SURFEX/mode_gridtype_conf_proj.F90 b/src/SURFEX/mode_gridtype_conf_proj.F90
index d083f55756da3e5e55caff95de2aeb7c9f07f410..d80d633d66b4fb21dd627b974fadca32ec6a31da 100644
--- a/src/SURFEX/mode_gridtype_conf_proj.F90
+++ b/src/SURFEX/mode_gridtype_conf_proj.F90
@@ -13,7 +13,7 @@
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
- CONTAINS
+CONTAINS
!############################################################################
!############################################################################
!############################################################################
@@ -27,11 +27,11 @@ USE PARKIND1 ,ONLY : JPRB
!!
!! AUTHOR
!! ------
-!! V. Masson *Meteo France*
+!! V. Masson *Meteo France*
!!
!! MODIFICATIONS
!! -------------
-!! Original 01/2004
+!! Original 01/2004
!! M.Moge 06/2015 broadcast the space step to all MPI processes (necessary for reproductibility)
!-------------------------------------------------------------------------------
!
@@ -78,13 +78,15 @@ REAL, DIMENSION(:), POINTER :: PGRID_PAR! parameters defining this grid
LOGICAL :: GFULL ! T : entire grid is stored
INTEGER :: IL ! number of points
INTEGER :: JJ ! loop counter
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
#ifdef SFX_MNH
INTEGER :: IINFO_ll
INTEGER :: IXOR, IYOR
INTEGER :: IXORMIN, IYORMIN
INTEGER :: IROOT, IROOTPROC
#endif
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:PUT_GRIDTYPE_CONF_PROJ',0,ZHOOK_HANDLE)
!
@@ -111,7 +113,8 @@ PGRID_PAR(8) = FLOAT(KJMAX)
IF (IL>0) THEN
PGRID_PAR(9) = PDX(1)
PGRID_PAR(10)= PDY(1)
-END IF
+ENDIF
+!
#ifdef MNH_PARALLEL
!get the index of the process with IL>0 that own the southmost and the westmost point
!then broadcast the value of PDX and PDY at these points
@@ -146,6 +149,7 @@ IF ( NPROC > 1 .AND. LINI_PARAZ) THEN
CALL MPI_BCAST(PGRID_PAR(10), 1, MPI_PRECISION, IROOTPROC, NMNH_COMM_WORLD, IINFO_ll)
ENDIF
#endif
+!
IF (IL<=0) THEN
PGRID_PAR(9) = XUNDEF
PGRID_PAR(10)= XUNDEF
@@ -184,7 +188,7 @@ END SUBROUTINE PUT_GRIDTYPE_CONF_PROJ
!!
!! AUTHOR
!! ------
-!! V. Masson *Meteo France*
+!! V. Masson *Meteo France*
!!
!! MODIFICATIONS
!! -------------
@@ -261,7 +265,6 @@ IF (PRESENT(PX)) THEN
PX(:) = PGRID_PAR(12+1:12+IL)
END IF
END IF
-
IF (PRESENT(PY)) THEN
IF (GFULL) THEN
DO JJ=1,IJMAX
@@ -342,6 +345,7 @@ END SUBROUTINE GET_GRIDTYPE_CONF_PROJ
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SURFEX_OMP, ONLY : NBLOCKTOT
USE MODD_CSTS,ONLY : XPI, XRADIUS
!
IMPLICIT NONE
@@ -368,22 +372,23 @@ REAL, DIMENSION(:), INTENT(OUT):: PLAT,PLON
! (degrees).
!
!* 0.2 Declarations of local variables
-!
+!
+INTEGER :: JI, ISIZE_OMP
REAL, DIMENSION(SIZE(PX)) :: ZY
REAL :: ZRPK,ZBETA,ZLAT0,ZLON0,ZLATOR,ZLONOR
REAL :: ZRDSDG,ZCLAT0,ZSLAT0,ZCLATOR,ZSLATOR
REAL :: ZXBM0,ZYBM0,ZRO0,ZGA0
REAL :: ZXP,ZYP,ZEPSI,ZT1,ZCGAM,ZSGAM,ZRACLAT0
!
-REAL, DIMENSION(SIZE(PX)) :: ZATA,ZRO2,ZT2,ZXMI0,ZYMI0
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL :: ZATA,ZRO2,ZT2,ZXMI0,ZYMI0, ZXI, ZYI, ZIRDSDG
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!
!--------------------------------------------------------------------------------
!
!* 1. Preliminary calculations for all projections
! --------------------------------------------
!
-IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:LATLON_CONF_PROJ',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:LATLON_CONF_PROJ_1',0,ZHOOK_HANDLE)
ZRDSDG = XPI/180. ! Degree to radian conversion factor
ZEPSI = 10.*EPSILON(1.) ! A small number
!
@@ -435,28 +440,47 @@ IF(PRPK /= 0.) THEN
!
!* 2.2 Longitude
!
- WHERE (ABS(ZY(:)-ZYP) < ZEPSI &
- .AND.ABS(PX(:)-ZXP) < ZEPSI)
- ZATA(:) = 0.
- ELSEWHERE
- ZATA(:) = ATAN2(-(ZXP-PX(:)),(ZYP-ZY(:)))/ZRDSDG
- END WHERE
- !
- PLON(:) = (ZBETA+ZATA(:))/ZRPK+ZLON0
+ZT1 = (XRADIUS*(ABS(ZCLAT0))**(1.-ZRPK))**(2./ZRPK) * (1+ZSLAT0)**2
!
-!* 2.3 Latitude
+ZIRDSDG = 1./ZRDSDG
!
- ZRO2(:) = (PX(:)-ZXP)**2+(ZY(:)-ZYP)**2
- ZT1 = (XRADIUS*(ABS(ZCLAT0))**(1.-ZRPK))**(2./ZRPK) &
- * (1+ZSLAT0)**2
- ZT2(:) = (ZRPK**2*ZRO2(:))**(1./ZRPK)
- !
- PLAT(:) = (XPI/2.-ACOS((ZT1-ZT2(:))/(ZT1+ZT2(:))))/ZRDSDG
+ISIZE_OMP = MAX(1,SIZE(ZY)/NBLOCKTOT)
!
- IF (PRPK<0.) THEN ! projection from north pole
- PLAT(:)=-PLAT(:)
- PLON(:)=PLON(:)+180.
- ENDIF
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:LATLON_CONF_PROJ_1',1,ZHOOK_HANDLE)
+!
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:LATLON_CONF_PROJ_21',0,ZHOOK_HANDLE_OMP)
+!$OMP DO SCHEDULE(STATIC,ISIZE_OMP) PRIVATE(JI,ZXI,ZYI,ZATA,ZRO2,ZT2)
+ DO JI = 1,SIZE(ZY)
+
+ ZXI = PX(JI)-ZXP
+ ZYI = ZY(JI)-ZYP
+
+ IF (ABS(ZYI) < ZEPSI .AND.ABS(ZXI) < ZEPSI) THEN
+ ZATA = 0.
+ ELSE
+ ZATA = ATAN2(ZXI,-ZYI)*ZIRDSDG
+ ENDIF
+ !
+ PLON(JI) = (ZBETA+ZATA)/ZRPK+ZLON0
+ !
+ !* 2.3 Latitude
+ !
+ ZRO2 = ZXI**2+ZYI**2
+ !
+ ZT2 = (ZRPK**2*ZRO2)**(1./ZRPK)
+ !
+ PLAT(JI) = (XPI/2.-ACOS((ZT1-ZT2)/(ZT1+ZT2)))*ZIRDSDG
+ !
+ IF (PRPK<0.) THEN ! projection from north pole
+ PLAT(JI)=-PLAT(JI)
+ PLON(JI)=PLON(JI)+180.
+ ENDIF
+ !
+ ENDDO
+!$OMP END DO
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:LATLON_CONF_PROJ_21',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
!
!-------------------------------------------------------------------------------
!
@@ -474,27 +498,39 @@ ELSE
!
!* 3.2 Longitude
!
- ZXMI0(:) = PX(:)-ZXBM0
- ZYMI0(:) = PY(:)-ZYBM0
+ ZT1 = ALOG(TAN(XPI/4.+PLATOR*ZRDSDG/2.))
!
- PLON(:) = (ZXMI0(:)*ZCGAM+ZYMI0(:)*ZSGAM) &
- / (ZRACLAT0*ZRDSDG)+PLONOR
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:LATLON_CONF_PROJ_1',1,ZHOOK_HANDLE)
+
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:LATLON_CONF_PROJ_22',0,ZHOOK_HANDLE_OMP)
+!$OMP DO SCHEDULE(DYNAMIC,1) PRIVATE(JI,ZXMI0,ZYMI0,ZT2)
+ DO JI = 1,SIZE(PX)
+
+ ZXMI0 = PX(JI)-ZXBM0
+ ZYMI0 = PY(JI)-ZYBM0
+ !
+ PLON(JI) = (ZXMI0*ZCGAM+ZYMI0*ZSGAM) / (ZRACLAT0*ZRDSDG)+PLONOR
!
!* 3.3 Latitude
!
- ZT1 = ALOG(TAN(XPI/4.+PLATOR*ZRDSDG/2.))
- ZT2(:) = (-ZXMI0(:)*ZSGAM+ZYMI0(:)*ZCGAM)/ZRACLAT0
- !
- PLAT(:) = (-XPI/2.+2.*ATAN(EXP(ZT1+ZT2(:))))/ZRDSDG
-!
+ ZT2 = (-ZXMI0*ZSGAM+ZYMI0*ZCGAM)/ZRACLAT0
+ !
+ PLAT(JI) = (-XPI/2.+2.*ATAN(EXP(ZT1+ZT2)))/ZRDSDG
+ !
+ ENDDO
+!$OMP END DO
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:LATLON_CONF_PROJ_22',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
!---------------------------------------------------------------------------------
!
!* 4. EXIT
! ----
!
END IF
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:LATLON_CONF_PROJ_3',0,ZHOOK_HANDLE)
PLON(:)=PLON(:)+NINT((PLON0-PLON(:))/360.)*360.
-IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:LATLON_CONF_PROJ',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:LATLON_CONF_PROJ_3',1,ZHOOK_HANDLE)
!---------------------------------------------------------------------------------
END SUBROUTINE LATLON_CONF_PROJ
!---------------------------------------------------------------------------------
@@ -564,6 +600,7 @@ END SUBROUTINE LATLON_CONF_PROJ
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SURFEX_OMP, ONLY : NBLOCKTOT
USE MODD_CSTS, ONLY : XPI, XRADIUS
!
IMPLICIT NONE
@@ -591,14 +628,17 @@ REAL, DIMENSION(:), INTENT(IN) :: PLAT,PLON
!
!* 0.2 Declarations of local variables
!
-REAL,DIMENSION(SIZE(PLAT)) :: ZLAT,ZLON
+REAL :: ZLAT,ZLON
REAL :: ZRPK,ZBETA,ZLAT0,ZLON0,ZLATOR,ZLONOR
REAL :: ZRDSDG,ZCLAT0,ZSLAT0,ZCLATOR,ZSLATOR
REAL :: ZXBM0,ZYBM0,ZRO0,ZGA0
REAL :: ZXP,ZYP,ZCGAM,ZSGAM,ZRACLAT0,ZXE,ZYE
!
-REAL,DIMENSION(SIZE(PLAT)) :: ZCLAT,ZSLAT,ZRO,ZGA,ZXPR,ZYPR
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL :: ZCLAT,ZSLAT,ZRO,ZGA,ZXPR,ZYPR
+!
+INTEGER :: J, ISIZE_OMP
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!
!
!-------------------------------------------------------------------------------
@@ -606,7 +646,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* 1. PRELIMINARY CALCULATION FOR ALL PROJECTIONS
! -------------------------------------------
!
-IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:XY_CONF_PROJ',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:XY_CONF_PROJ_1',0,ZHOOK_HANDLE)
ZRDSDG = XPI/180. ! Degree to radian conversion factor
!
! By definition, (PLONOR,PLATOR) are the geographical
@@ -616,9 +656,6 @@ ZRDSDG = XPI/180. ! Degree to radian conversion factor
ZXBM0 = 0.
ZYBM0 = 0.
!
-ZLON(:)=PLON(:)
-ZLON(:)=ZLON(:)+NINT((PLON0-ZLON(:))/360.)*360.
-!
ZLONOR=PLONOR
ZLONOR=ZLONOR+NINT((PLON0-ZLONOR)/360.)*360.
!------------------------------------------------------------------------------
@@ -627,6 +664,11 @@ ZLONOR=ZLONOR+NINT((PLON0-ZLONOR)/360.)*360.
! ----------------------------------------------
! (PRPK=1 P-stereo, 0<PRPK<1 Lambert)
!
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:XY_CONF_PROJ_1',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:XY_CONF_PROJ_2',0,ZHOOK_HANDLE)
+!
+ISIZE_OMP = MAX(1,SIZE(PLAT)/NBLOCKTOT)
+!
IF(PRPK /= 0.) THEN
!
IF (PRPK<0.) THEN ! projection from north pole
@@ -636,8 +678,6 @@ IF(PRPK /= 0.) THEN
ZLON0=PLON0+180.
ZLATOR=-PLATOR
ZLONOR=ZLONOR+180.
- ZLAT(:)=-PLAT(:)
- ZLON(:)=ZLON(:)+180.
ZYBM0=-ZYBM0
ELSE ! projection from south pole
ZRPK=PRPK
@@ -646,8 +686,6 @@ IF(PRPK /= 0.) THEN
ZLON0=PLON0
ZLATOR=PLATOR
ZLONOR=ZLONOR
- ZLAT(:)=PLAT(:)
- ZLON(:)=ZLON(:)
ENDIF
!
!* 2.1 Preliminary calculations
@@ -664,19 +702,40 @@ IF(PRPK /= 0.) THEN
!
!* 2.2 Conformal coordinates in meters
!
- ZCLAT(:) = COS(ZRDSDG*ZLAT(:))
- ZSLAT(:) = SIN(ZRDSDG*ZLAT(:))
- ZRO(:) = (XRADIUS/ZRPK)*(ABS(ZCLAT0))**(1.-ZRPK) &
- * ((1.+ZSLAT0)*ABS(ZCLAT(:))/(1.+ZSLAT(:)))**ZRPK
- ZGA(:) = (ZRPK*(ZLON(:)-ZLON0)-ZBETA)*ZRDSDG
-!
- PX(:) = ZXP+ZRO(:)*SIN(ZGA(:))
- PY(:) = ZYP-ZRO(:)*COS(ZGA(:))
-!
- IF (PRPK<0.) THEN ! projection from north pole
- PY(:)=-PY(:)
- ENDIF
-!
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:XY_CONF_PROJ_2',1,ZHOOK_HANDLE)
+!
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:XY_CONF_PROJ_3',0,ZHOOK_HANDLE_OMP)
+!$OMP DO SCHEDULE(STATIC,ISIZE_OMP) PRIVATE(J,ZLON,ZLAT,ZCLAT,ZSLAT,ZRO,ZGA)
+ DO J=1,SIZE(PLAT)
+ !
+ ZLON = PLON(J)+NINT((PLON0-PLON(J))/360.)*360.
+ !
+ IF (PRPK<0.) THEN ! projection from north pole
+ ZLAT =-PLAT(J)
+ ZLON = ZLON+180.
+ ELSE ! projection from south pole
+ ZLAT = PLAT(J)
+ ENDIF
+ !
+ ZCLAT = COS(ZRDSDG*ZLAT)
+ ZSLAT = SIN(ZRDSDG*ZLAT)
+ ZRO = (XRADIUS/ZRPK)*(ABS(ZCLAT0))**(1.-ZRPK) &
+ * ((1.+ZSLAT0)*ABS(ZCLAT)/(1.+ZSLAT))**ZRPK
+ ZGA = (ZRPK*(ZLON-ZLON0)-ZBETA)*ZRDSDG
+ !
+ PX(J) = ZXP+ZRO*SIN(ZGA)
+ PY(J) = ZYP-ZRO*COS(ZGA)
+ !
+ IF (PRPK<0.) THEN ! projection from north pole
+ PY(J)=-PY(J)
+ ENDIF
+ !
+ ENDDO
+!$OMP ENDDO
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:XY_CONF_PROJ_3',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
+ !
!-------------------------------------------------------------------------------
!
!* 3. MERCATOR PROJECTION WITH ROTATION
@@ -697,19 +756,32 @@ ELSE
!
!* 3.2 Conformal coordinates
!
- ZXPR(:) = ZRACLAT0*(ZLON(:)-PLON0)*ZRDSDG+ZXE
- ZYPR(:) = ZRACLAT0*LOG(TAN(XPI/4.+PLAT(:)*ZRDSDG/2.))+ZYE
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:XY_CONF_PROJ_2',1,ZHOOK_HANDLE)
+!
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:XY_CONF_PROJ_31',0,ZHOOK_HANDLE_OMP)
+!$OMP DO SCHEDULE(STATIC,ISIZE_OMP) PRIVATE(J,ZLON,ZXPR,ZYPR)
+ DO J=1,SIZE(PLAT)
+ !
+ ZLON = PLON(J)+NINT((PLON0-PLON(J))/360.)*360.
+ !
+ ZXPR = ZRACLAT0*(ZLON-PLON0)*ZRDSDG+ZXE
+ ZYPR = ZRACLAT0*LOG(TAN(XPI/4.+PLAT(J)*ZRDSDG/2.))+ZYE
+ !
+ PX(J) = ZXPR*ZCGAM-ZYPR*ZSGAM
+ PY(J) = ZXPR*ZSGAM+ZYPR*ZCGAM
+ !
+ ENDDO
+!$OMP ENDDO
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:XY_CONF_PROJ_31',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
!
- PX(:) = ZXPR(:)*ZCGAM-ZYPR(:)*ZSGAM
- PY(:) = ZXPR(:)*ZSGAM+ZYPR(:)*ZCGAM
-!
!-------------------------------------------------------------------------------
!
!* 4. EXIT
! ----
!
END IF
-IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:XY_CONF_PROJ',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
END SUBROUTINE XY_CONF_PROJ
!-------------------------------------------------------------------------------
@@ -758,6 +830,7 @@ END SUBROUTINE XY_CONF_PROJ
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SURFEX_OMP, ONLY : NBLOCKTOT
USE MODD_CSTS, ONLY : XPI, XRADIUS
!
IMPLICIT NONE
@@ -791,14 +864,15 @@ REAL :: ZCLAT0 ! cos(lat0)
REAL :: ZSLAT0 ! sin(lat0)
REAL :: ZRDSDG ! pi/180
LOGICAL :: GNORTHPROJ! T: projection from north pole
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
+INTEGER :: J, ISIZE_OMP
!
!-------------------------------------------------------------------------------
!
!* 1. PRELIMINARY CALCULATION FOR ALL PROJECTIONS
! -------------------------------------------
!
-IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:MAP_FACTOR_CONF_PROJ',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:MAP_FACTOR_CONF_PROJ_1',0,ZHOOK_HANDLE)
ZRDSDG = XPI/180. ! Degree to radian conversion factor
!
GNORTHPROJ = PRPK < 0.
@@ -816,17 +890,36 @@ ZRDSDG = XPI/180.
ZCLAT0 = COS(ZRDSDG*ZLAT0)
ZSLAT0 = SIN(ZRDSDG*ZLAT0)
!
+ISIZE_OMP = MAX(1,SIZE(PMAP)/NBLOCKTOT)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:MAP_FACTOR_CONF_PROJ_1',1,ZHOOK_HANDLE)
+!
IF (ABS(ZCLAT0)<1.E-10 .AND. (ABS(ZRPK-1.)<1.E-10)) THEN
- PMAP(:) = (1.+ZSLAT0)/(1.+SIN(ZRDSDG*ZLAT(:)))
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:MAP_FACTOR_CONF_PROJ_2a',0,ZHOOK_HANDLE_OMP)
+!$OMP DO SCHEDULE(STATIC,ISIZE_OMP) PRIVATE(J)
+ DO J=1,SIZE(PMAP)
+ PMAP(J) = (1.+ZSLAT0)/(1.+SIN(ZRDSDG*ZLAT(J)))
+ ENDDO
+!$OMP ENDDO
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:MAP_FACTOR_CONF_PROJ_2a',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
ELSE
- WHERE (ABS(COS(ZRDSDG*ZLAT(:)))>1.E-10)
- PMAP(:) = ((ZCLAT0/COS(ZRDSDG*ZLAT(:)))**(1.-ZRPK)) &
- * ((1.+ZSLAT0)/(1.+SIN(ZRDSDG*ZLAT(:))))**ZRPK
- ELSEWHERE
- PMAP(:) = (1.+ZSLAT0)/(1.+SIN(ZRDSDG*ZLAT(:)))
- ENDWHERE
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:MAP_FACTOR_CONF_PROJ_2b',0,ZHOOK_HANDLE_OMP)
+!$OMP DO SCHEDULE(STATIC,ISIZE_OMP) PRIVATE(J)
+ DO J=1,SIZE(PMAP)
+ IF (ABS(COS(ZRDSDG*ZLAT(J)))>1.E-10) THEN
+ PMAP(J) = ((ZCLAT0/COS(ZRDSDG*ZLAT(J)))**(1.-ZRPK)) &
+ * ((1.+ZSLAT0)/(1.+SIN(ZRDSDG*ZLAT(J))))**ZRPK
+ ELSE
+ PMAP(J) = (1.+ZSLAT0)/(1.+SIN(ZRDSDG*ZLAT(J)))
+ ENDIF
+ ENDDO
+!$OMP ENDDO
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:MAP_FACTOR_CONF_PROJ_2b',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
END IF
-IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_CONF_PROJ:MAP_FACTOR_CONF_PROJ',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
END SUBROUTINE MAP_FACTOR_CONF_PROJ
diff --git a/src/SURFEX/mode_gridtype_gauss.F90 b/src/SURFEX/mode_gridtype_gauss.F90
index 783f2357e24e3bbc2888c2f96728c1524edf8ec6..4dce635f1b4c1e7647c3c1593cb637af6f671a1d 100644
--- a/src/SURFEX/mode_gridtype_gauss.F90
+++ b/src/SURFEX/mode_gridtype_gauss.F90
@@ -17,7 +17,7 @@ USE MODI_ABOR1_SFX
!
IMPLICIT NONE
!
- CONTAINS
+CONTAINS
!
!############################################################################
!############################################################################
@@ -548,7 +548,7 @@ END SUBROUTINE GAUSS_GRID_LIMITS
!############################################################################
!############################################################################
! ####################################################################
-SUBROUTINE XY_GAUSS(PCODIL,KSIZE,PNODATA,PVALUE,PLAT_XY,PLON_XY)
+SUBROUTINE XY_GAUSS(PCODIL,KSIZE_DLAT,KSIZE_LON,PNODATA,PVALUE,PLAT_XY,PLON_XY)
! ####################################################################
!
!!**** *LATLON_GAUSS * - Routine to compute coordinates on a transform sphere
@@ -597,7 +597,8 @@ SUBROUTINE XY_GAUSS(PCODIL,KSIZE,PNODATA,PVALUE,PLAT_XY,PLON_XY)
!* 0.1 Declarations of arguments and results
!
REAL, INTENT(IN) :: PCODIL
- INTEGER, INTENT(IN) :: KSIZE
+ INTEGER, INTENT(IN) :: KSIZE_DLAT
+ INTEGER, INTENT(IN) :: KSIZE_LON
REAL, INTENT(IN) :: PNODATA
REAL, DIMENSION(:), INTENT(IN) :: PVALUE ! value of the point to add
REAL, DIMENSION(:), INTENT(OUT):: PLAT_XY,PLON_XY
@@ -609,24 +610,25 @@ SUBROUTINE XY_GAUSS(PCODIL,KSIZE,PNODATA,PVALUE,PLAT_XY,PLON_XY)
!
INTEGER :: JJ, IDN, IDT
!
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE_OMP
!--------------------------------------------------------------------------------
!
!* 1. Preliminary calculations
! ------------------------
!
- IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_GAUSS:XY_GAUSS',0,ZHOOK_HANDLE)
!
!
-!$OMP PARALLEL DO PRIVATE(IDN,IDT,ZCOS1, ZV1, ZLAT1, ZCOS2, ZLON1, ZINVC, &
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_GAUSS:XY_GAUSS',0,ZHOOK_HANDLE_OMP)
+!$OMP DO PRIVATE(IDN,IDT,ZCOS1, ZV1, ZLAT1, ZCOS2, ZLON1, ZINVC, &
!$OMP ZSINN, ZV2, ZINVS, ZSINT, ZCOST, ZV3, ZLAT2, ZM, ZLON2)
DO JJ=1,SIZE(PVALUE)
!
IF (PVALUE(JJ)==PNODATA) CYCLE
!
- IDN = MOD(JJ,KSIZE)
- IF (IDN==0) IDN=KSIZE
- IDT = CEILING(1.*JJ/KSIZE)
+ IDN = MOD(JJ,KSIZE_LON)
+ IF (IDN==0) IDN=KSIZE_LON
+ IDT = CEILING(1.*JJ/KSIZE_DLAT)
!
ZCOS1 = XCOSN(IDN)*XCOST(IDT)
!ZCOS1 = COS(XLAT(IDT))*COS(XLON(IDN)-XLONP)
@@ -672,10 +674,10 @@ SUBROUTINE XY_GAUSS(PCODIL,KSIZE,PNODATA,PVALUE,PLAT_XY,PLON_XY)
IF (ABS(PLON_XY(JJ)-360.)<1.E-4) PLON_XY(JJ) = 0.
!
ENDDO
-!$OMP END PARALLEL DO
-!
- IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_GAUSS:XY_GAUSS',1,ZHOOK_HANDLE)
- !---------------------------------------------------------------------------------
+!$OMP END DO
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_GAUSS:XY_GAUSS',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
+!---------------------------------------------------------------------------------
END SUBROUTINE XY_GAUSS
!---------------------------------------------------------------------------------
!############################################################################
diff --git a/src/SURFEX/mode_gridtype_ign.F90 b/src/SURFEX/mode_gridtype_ign.F90
index df04af1db4c0e595e6afc34b2d572df53837fb52..41dadde820cebd64f733132067cdcdd82d042e28 100644
--- a/src/SURFEX/mode_gridtype_ign.F90
+++ b/src/SURFEX/mode_gridtype_ign.F90
@@ -13,7 +13,7 @@
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
- CONTAINS
+CONTAINS
!############################################################################
!############################################################################
!############################################################################
@@ -238,7 +238,7 @@ REAL, DIMENSION(:), INTENT(OUT):: PLAT,PLON
REAL, DIMENSION(SIZE(PX)) :: ZGAMMA
REAL, DIMENSION(SIZE(PX)) :: ZR ! length of arc meridian line projection
REAL, DIMENSION(SIZE(PX)) :: ZLATISO ! Isometric latitude
-REAL :: ZLAT0 ! For iteration
+REAL :: ZLAT0 ! For iteration
!
INTEGER :: J, JJ
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -258,7 +258,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* 3. LATITUDE
! --------
ZLATISO(:)=-1./XN(KLAMBERT) * ALOG(ABS(ZR(:)/XC(KLAMBERT)))
-!
+!
!$OMP PARALLEL DO PRIVATE(JJ,J,ZLAT0)
DO JJ=1,SIZE(PLAT)
ZLAT0 =2. * ATAN (EXP(ZLATISO(JJ))) - XPI/2.
@@ -271,10 +271,9 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
ZLAT0=PLAT(JJ)
ENDDO
ENDDO
-!$OMP END PARALLEL DO
+!$OMP END PARALLEL DO
!
PLAT(:)=PLAT(:) *180./XPI
-!
IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_IGN:LATLON_IGN',1,ZHOOK_HANDLE)
!---------------------------------------------------------------------------------
END SUBROUTINE LATLON_IGN
@@ -350,7 +349,7 @@ REAL :: ZGAMMA
REAL :: ZLATFI ! Isometric latitude
REAL :: ZR ! length of arc meridian line projection
INTEGER :: JJ
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!
!
!-------------------------------------------------------------------------------
@@ -358,13 +357,17 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* 1. Latitude /Longitude in radian :
! -------------------------------
!
-IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_IGN:XY_IGN',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_IGN:XY_IGN_1',0,ZHOOK_HANDLE)
!
ZPI180 = XPI / 180.
ZPI4 = XPI / 4.
-ZECC2 = XECC(KLAMBERT) / 2.
+ZECC2 = XECC(KLAMBERT) / 2.
+!
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_IGN:XY_IGN_1',1,ZHOOK_HANDLE)
!
-!$OMP PARALLEL DO PRIVATE(JJ,ZLONRAD,ZLATRAD,ZWRK,ZLATFI,ZGAMMA,ZR)
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_IGN:XY_IGN_2',0,ZHOOK_HANDLE_OMP)
+!$OMP DO PRIVATE(JJ,ZLONRAD,ZLATRAD,ZWRK,ZLATFI,ZGAMMA,ZR)
DO JJ=1,SIZE(PLON)
!
IF (PLON(JJ) > 180.) THEN
@@ -378,7 +381,7 @@ DO JJ=1,SIZE(PLON)
!* 2. Calcul of the isometric latitude :
! ----------------------------------
!
- ZWRK = SIN(ZLATRAD) * XECC(KLAMBERT)
+ ZWRK = SIN(ZLATRAD) * XECC(KLAMBERT)
!
ZLATFI = LOG(TAN(ZPI4 + ZLATRAD / 2.)) + ( (LOG(1-ZWRK)-LOG(1+ZWRK)) * ZECC2)
!
@@ -393,9 +396,10 @@ DO JJ=1,SIZE(PLON)
PY(JJ) = XYS(KLAMBERT) - COS(ZGAMMA) * ZR
!
ENDDO
-!$OMP END PARALLEL DO
+!$OMP END DO
+IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_IGN:XY_IGN_2',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
!
-IF (LHOOK) CALL DR_HOOK('MODE_GRIDTYPE_IGN:XY_IGN',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
END SUBROUTINE XY_IGN
!-------------------------------------------------------------------------------
@@ -471,7 +475,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
DO J=1, 100
ZLAT(:) = 2. * ATAN( &
- ( (1+XECC(KLAMBERT)*SIN(ZLAT0(:)))/(1-XECC(KLAMBERT)*SIN(ZLAT0(:))) )**(XECC(KLAMBERT)/2.) &
+ ( (1+XECC(KLAMBERT)*SIN(ZLAT0(:))) / (1-XECC(KLAMBERT)*SIN(ZLAT0(:))) )**(XECC(KLAMBERT)/2.) &
*EXP(ZLATISO(:)) ) -XPI/2.
!
IF (MAXVAL(ABS(ZLAT(:) - ZLAT0(:))) < XCVGLAT ) EXIT
diff --git a/src/SURFEX/mode_gridtype_lonlat_reg.F90 b/src/SURFEX/mode_gridtype_lonlat_reg.F90
index fe5ef515bb15be19c5a91fd9ff7b157fbc0757ac..e49d3043fe761565a57c4ae38fafcbc388d6974e 100644
--- a/src/SURFEX/mode_gridtype_lonlat_reg.F90
+++ b/src/SURFEX/mode_gridtype_lonlat_reg.F90
@@ -13,7 +13,7 @@
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
- CONTAINS
+CONTAINS
!############################################################################
!############################################################################
!############################################################################
diff --git a/src/SURFEX/mode_gridtype_lonlat_rot.F90 b/src/SURFEX/mode_gridtype_lonlat_rot.F90
index 9828b3737a0b123f59ab94ba0e5cbc6b0cc0601a..4a311058fe0e9d97ee38f207f533417f6a41716c 100644
--- a/src/SURFEX/mode_gridtype_lonlat_rot.F90
+++ b/src/SURFEX/mode_gridtype_lonlat_rot.F90
@@ -13,7 +13,7 @@
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
- CONTAINS
+CONTAINS
!############################################################################
!############################################################################
!############################################################################
diff --git a/src/SURFEX/mode_gridtype_lonlatval.F90 b/src/SURFEX/mode_gridtype_lonlatval.F90
index 277569bf73e3d11b18fab9f1c38a54466a5fb3de..d051cc5852e4098262a0a2c7e005a377714bc78d 100644
--- a/src/SURFEX/mode_gridtype_lonlatval.F90
+++ b/src/SURFEX/mode_gridtype_lonlatval.F90
@@ -13,7 +13,7 @@
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
- CONTAINS
+CONTAINS
!############################################################################
!############################################################################
!############################################################################
diff --git a/src/SURFEX/mode_hydro_dif.F90 b/src/SURFEX/mode_hydro_dif.F90
index 6e2cc06e2165455ed34567f1d64586fa0d3f3f24..b4f6f7a0bf7976ffbb45bf6df92e90a5478c9d9f 100644
--- a/src/SURFEX/mode_hydro_dif.F90
+++ b/src/SURFEX/mode_hydro_dif.F90
@@ -50,7 +50,7 @@ INTERFACE TRIDIAG_DIF
END INTERFACE
!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/mode_meb.F90 b/src/SURFEX/mode_meb.F90
index dd6a7703481c77ddf28bd2b38892c7c7edc14e21..8665dd58adc64845058437da69ace5fc47b5db6f 100644
--- a/src/SURFEX/mode_meb.F90
+++ b/src/SURFEX/mode_meb.F90
@@ -69,7 +69,7 @@ INTERFACE MEB_SHIELD_FACTOR
END INTERFACE
!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!
!####################################################################
!####################################################################
diff --git a/src/SURFEX/mode_modeln_surfex_handler.F90 b/src/SURFEX/mode_modeln_surfex_handler.F90
index 362e60ab39c99a213f5110bfd4a6a2c132934ba7..ad2a92d629e78fb10fa2a6d9d8b8092221571794 100644
--- a/src/SURFEX/mode_modeln_surfex_handler.F90
+++ b/src/SURFEX/mode_modeln_surfex_handler.F90
@@ -12,7 +12,7 @@ IMPLICIT NONE
INTEGER :: ICURRENT_MODEL = -1
!$OMP THREADPRIVATE(ICURRENT_MODEL)
- CONTAINS
+CONTAINS
!
SUBROUTINE INIT_CURRENT_MODEL_INDEX_SURFEX()
!
diff --git a/src/SURFEX/mode_modeln_teb_handler.F90 b/src/SURFEX/mode_modeln_teb_handler.F90
deleted file mode 100644
index 61621346a422941ac27d555a62395f9e8c2349e0..0000000000000000000000000000000000000000
--- a/src/SURFEX/mode_modeln_teb_handler.F90
+++ /dev/null
@@ -1,9 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-MODULE MODE_MODELN_TEB_HANDLER
-!
-
-END MODULE MODE_MODELN_TEB_HANDLER
-
diff --git a/src/SURFEX/mode_pos_surf.F90 b/src/SURFEX/mode_pos_surf.F90
index e029d9e88f512bff3267895a76e7b4fdc8492490..4f199ec59472960cd6d348961edf95f294f9ea20 100644
--- a/src/SURFEX/mode_pos_surf.F90
+++ b/src/SURFEX/mode_pos_surf.F90
@@ -92,14 +92,17 @@ DO JFILE=1,2
search_nam : DO
YLINE=' '
READ(UNIT=KULNAM,FMT='(A)',IOSTAT=IRET,END=100) YLINE
+
! If file does not exist, most compilers would just create it and jump
! to the END label ; but a few of them would report an error:
IF (IRET /=0 ) THEN
INQUIRE(KULNAM,OPENED=LLOPENED)
IF (LLOPENED) THEN
- IF (PRESENT(KLUOUT)) &
+ IF (PRESENT(KLUOUT)) THEN
WRITE(KLUOUT,FMT=*) 'MODE_POS_SURF : error reading from unit ',&
- KULNAM,' file ',HDNAML,' line ',YLINE
+ KULNAM,' file ',HDNAML,' line ',YLINE
+ CALL FLUSH(KLUOUT)
+ ENDIF
CALL ABOR1_SFX('MODE_POS_SURF: read error in namelist file')
ELSE
EXIT search_nam
diff --git a/src/SURFEX/mode_prep_ctl.F90 b/src/SURFEX/mode_prep_ctl.F90
new file mode 100644
index 0000000000000000000000000000000000000000..b3b2f56339de84bcdf245874802cf8306aaa8e10
--- /dev/null
+++ b/src/SURFEX/mode_prep_ctl.F90
@@ -0,0 +1,271 @@
+MODULE MODE_PREP_CTL
+
+!**** *MODE_PREP_CTL* - Control PREP structure
+
+! Author.
+! -------
+! Philippe Marguinaud *METEO FRANCE*
+! Original : 01-10-2014
+
+! Description.
+! ------------
+! This module implements a structure and methods to control PREP execution,
+! retrieve fields to be interpolated so that an external program may
+! interpol the fields itself (Fullpos), and pass back interpolated fields to
+! PREP.
+
+USE MODI_ABOR1_SFX
+
+IMPLICIT NONE
+
+TYPE PREP_CTL_FLD
+ CHARACTER (LEN=32) :: CLNAME = '', CLTYPE = '', CLMASK = ''
+ REAL, POINTER :: ZFLD2 (:,:) => NULL ()
+ REAL, POINTER :: ZFLD3 (:,:,:) => NULL ()
+ TYPE (PREP_CTL_FLD), POINTER :: NEXT => NULL ()
+ TYPE (PREP_CTL_FLD), POINTER :: PREV => NULL ()
+END TYPE PREP_CTL_FLD
+
+TYPE PREP_CTL
+ LOGICAL :: LSTEP0 = .FALSE. ! PREP step 0 (count fields to be interpolated)
+ LOGICAL :: LSTEP1 = .FALSE. ! PREP step 1 (retrieve fields to be interpolated)
+ LOGICAL :: LSTEP2 = .FALSE. ! PREP step 2 (pass interpolated fields to PREP and finish)
+
+ LOGICAL :: LPART1 = .TRUE. ! Invoke PREP_*_EXTERN routines
+ LOGICAL :: LPART2 = .FALSE. ! Retrieve or pass back interpolated fields from/to PREP
+ LOGICAL :: LPART3 = .TRUE. ! Do interpolations
+ LOGICAL :: LPART4 = .FALSE. ! Unused for now
+ LOGICAL :: LPART5 = .TRUE. ! Post-processing after interpolations
+ LOGICAL :: LPART6 = .TRUE. ! Post-processing after interpolations (higher level)
+ TYPE (PREP_CTL_FLD), POINTER :: HEAD => NULL (), TAIL => NULL ()
+END TYPE
+
+INTERFACE PREP_CTL_INT_PART2
+ MODULE PROCEDURE PREP_CTL_INT_PART2_2, PREP_CTL_INT_PART2_3
+END INTERFACE
+
+INTERFACE PREP_CTL_INT_PART4
+ MODULE PROCEDURE PREP_CTL_INT_PART4_2, PREP_CTL_INT_PART4_3
+END INTERFACE
+
+CONTAINS
+
+LOGICAL FUNCTION PREP_CTL_CAN (YDCTL)
+
+! Returns true if we are not in a 2-part PREP
+
+TYPE (PREP_CTL), INTENT (INOUT) :: YDCTL
+
+TYPE (PREP_CTL) :: YLCTL
+
+PREP_CTL_CAN = (YDCTL%LSTEP0 .EQV. YLCTL%LSTEP0) .AND. (YDCTL%LSTEP1 .EQV. YLCTL%LSTEP1) .AND. &
+ & (YDCTL%LSTEP2 .EQV. YLCTL%LSTEP2) .AND. (YDCTL%LPART1 .EQV. YLCTL%LPART1) .AND. &
+ & (YDCTL%LPART1 .EQV. YLCTL%LPART1) .AND. (YDCTL%LPART2 .EQV. YLCTL%LPART2) .AND. &
+ & (YDCTL%LPART3 .EQV. YLCTL%LPART3) .AND. (YDCTL%LPART4 .EQV. YLCTL%LPART4) .AND. &
+ & (YDCTL%LPART5 .EQV. YLCTL%LPART5) .AND. (YDCTL%LPART6 .EQV. YLCTL%LPART6)
+
+
+END FUNCTION PREP_CTL_CAN
+
+SUBROUTINE PREP_CTL_COUNT (YDCTL, KCOUNT)
+
+! Reckon the number of 2D fields in YDCTL
+
+TYPE (PREP_CTL), INTENT (INOUT) :: YDCTL
+INTEGER, INTENT (OUT) :: KCOUNT
+
+TYPE (PREP_CTL_FLD), POINTER :: YLCFL
+
+KCOUNT = 0
+
+YLCFL => YDCTL%HEAD
+DO WHILE (ASSOCIATED (YLCFL))
+ IF (ASSOCIATED (YLCFL%ZFLD2)) THEN
+ KCOUNT = KCOUNT + SIZE (YLCFL%ZFLD2, 2)
+ ELSEIF (ASSOCIATED (YLCFL%ZFLD3)) THEN
+ KCOUNT = KCOUNT + SIZE (YLCFL%ZFLD3, 2) * SIZE (YLCFL%ZFLD3, 3)
+ ENDIF
+ YLCFL => YLCFL%NEXT
+ENDDO
+
+END SUBROUTINE PREP_CTL_COUNT
+
+SUBROUTINE PREP_CTL_FREE (YDCTL)
+
+! Free a whole PREP_CTL structure
+
+TYPE (PREP_CTL), INTENT (INOUT) :: YDCTL
+
+TYPE (PREP_CTL_FLD), POINTER :: YLCFL
+
+YLCFL => YDCTL%HEAD
+DO WHILE (ASSOCIATED (YLCFL))
+ IF (ASSOCIATED (YLCFL%ZFLD2)) THEN
+ DEALLOCATE (YLCFL%ZFLD2)
+ ELSEIF (ASSOCIATED (YLCFL%ZFLD3)) THEN
+ DEALLOCATE (YLCFL%ZFLD3)
+ ENDIF
+ YLCFL => YLCFL%NEXT
+ DEALLOCATE (YDCTL%HEAD)
+ YDCTL%HEAD => YLCFL
+ENDDO
+
+NULLIFY (YDCTL%HEAD, YDCTL%TAIL)
+
+END SUBROUTINE PREP_CTL_FREE
+
+SUBROUTINE PREP_CTL_PUSH (YDCTL, YDCFL)
+
+! Add a new set of fields
+
+TYPE (PREP_CTL), INTENT (INOUT) :: YDCTL
+TYPE (PREP_CTL_FLD), POINTER :: YDCFL
+
+IF (ASSOCIATED (YDCTL%TAIL)) THEN
+ YDCTL%TAIL%NEXT => YDCFL
+ YDCFL%PREV => YDCTL%TAIL
+ YDCTL%TAIL => YDCFL
+ELSE
+ YDCTL%HEAD => YDCFL
+ YDCTL%TAIL => YDCFL
+ENDIF
+
+NULLIFY (YDCFL)
+
+END SUBROUTINE PREP_CTL_PUSH
+
+SUBROUTINE PREP_CTL_SHIFT (YDCTL, YDCFL)
+
+! Get back a set of fields
+
+TYPE (PREP_CTL), INTENT (INOUT) :: YDCTL
+TYPE (PREP_CTL_FLD), POINTER :: YDCFL
+
+YDCFL => YDCTL%HEAD
+
+IF (.NOT. ASSOCIATED (YDCFL)) THEN
+ CALL ABOR1_SFX ('PREP_CTL_SHIFT: ATTEMPT TO SHIFT EMPTY FIELD LIST')
+ENDIF
+
+YDCTL%HEAD => YDCFL%NEXT
+
+IF (ASSOCIATED (YDCTL%HEAD)) THEN
+ YDCTL%HEAD%PREV => NULL ()
+ENDIF
+
+END SUBROUTINE PREP_CTL_SHIFT
+
+SUBROUTINE PREP_CTL_INT_PART2_2 (YDCTL, CDSURF, CDTYPE, CDMASK, PFIELDIN)
+
+! Retrieve/pass back fields
+
+TYPE (PREP_CTL), INTENT (INOUT) :: YDCTL
+CHARACTER (LEN=*), INTENT (IN) :: CDSURF
+CHARACTER (LEN=*), INTENT (IN) :: CDTYPE
+CHARACTER (LEN=*), INTENT (IN) :: CDMASK
+REAL, POINTER :: PFIELDIN (:,:)
+
+TYPE (PREP_CTL_FLD), POINTER :: YLCFL
+
+INTEGER :: IREP
+
+IF (YDCTL%LPART2) THEN
+ IF (YDCTL%LSTEP0 .OR. YDCTL%LSTEP1) THEN
+ ALLOCATE (YLCFL)
+ YLCFL%CLTYPE = CDTYPE
+ YLCFL%CLNAME = CDSURF
+ YLCFL%CLMASK = CDMASK
+ YLCFL%ZFLD2 => PFIELDIN
+ NULLIFY (PFIELDIN)
+ CALL PREP_CTL_PUSH (YDCTL, YLCFL)
+ ELSEIF (YDCTL%LSTEP2) THEN
+ CALL PREP_CTL_SHIFT (YDCTL, YLCFL)
+ IF (YLCFL%CLNAME /= CDSURF .OR. YLCFL%CLTYPE /= CDTYPE) THEN
+ CALL ABOR1_SFX ('PREP_CTL_INT_PART2: FIELD MISMATCH: EXPECTED '&
+ &//TRIM (CDSURF)//'/'//TRIM (CDTYPE)//', GOT '// &
+ &TRIM (YLCFL%CLNAME)//'/'//TRIM (YLCFL%CLTYPE))
+ ENDIF
+ PFIELDIN => YLCFL%ZFLD2
+ NULLIFY (YLCFL%ZFLD2)
+ DEALLOCATE (YLCFL)
+ ENDIF
+ENDIF
+
+END SUBROUTINE PREP_CTL_INT_PART2_2
+
+SUBROUTINE PREP_CTL_INT_PART4_2 (YDCTL, CDSURF, CDTYPE, CDMASK, PFIELDIN, PFIELDOUT)
+
+TYPE (PREP_CTL), INTENT (INOUT) :: YDCTL
+CHARACTER (LEN=*), INTENT (IN) :: CDSURF
+CHARACTER (LEN=*), INTENT (IN) :: CDTYPE
+CHARACTER (LEN=*), INTENT (IN) :: CDMASK
+REAL, POINTER :: PFIELDIN (:,:)
+REAL, POINTER :: PFIELDOUT (:,:)
+
+TYPE (PREP_CTL_FLD), POINTER :: YLCFL
+INTEGER :: IREP, ILONG, IPOSEX
+INTEGER (8) :: JDIM (2)
+
+IF (YDCTL%LPART4) THEN
+ENDIF
+
+END SUBROUTINE PREP_CTL_INT_PART4_2
+
+SUBROUTINE PREP_CTL_INT_PART2_3 (YDCTL, CDSURF, CDTYPE, CDMASK, PFIELDIN)
+
+! Retrieve/pass back fields
+
+TYPE (PREP_CTL), INTENT (INOUT) :: YDCTL
+CHARACTER (LEN=*), INTENT (IN) :: CDSURF
+CHARACTER (LEN=*), INTENT (IN) :: CDTYPE
+CHARACTER (LEN=*), INTENT (IN) :: CDMASK
+REAL, POINTER :: PFIELDIN (:,:,:)
+
+TYPE (PREP_CTL_FLD), POINTER :: YLCFL
+
+INTEGER :: IREP
+
+IF (YDCTL%LPART2) THEN
+ IF (YDCTL%LSTEP0 .OR. YDCTL%LSTEP1) THEN
+ ALLOCATE (YLCFL)
+ YLCFL%CLTYPE = CDTYPE
+ YLCFL%CLNAME = CDSURF
+ YLCFL%CLMASK = CDMASK
+ YLCFL%ZFLD3 => PFIELDIN
+ NULLIFY (PFIELDIN)
+ CALL PREP_CTL_PUSH (YDCTL, YLCFL)
+ ELSEIF (YDCTL%LSTEP2) THEN
+ CALL PREP_CTL_SHIFT (YDCTL, YLCFL)
+ IF (YLCFL%CLNAME /= CDSURF .OR. YLCFL%CLTYPE /= CDTYPE) THEN
+ CALL ABOR1_SFX ('PREP_CTL_INT_PART2: FIELD MISMATCH: EXPECTED '&
+ &//TRIM (CDSURF)//'/'//TRIM (CDTYPE)//', GOT '// &
+ &TRIM (YLCFL%CLNAME)//'/'//TRIM (YLCFL%CLTYPE))
+ ENDIF
+ PFIELDIN => YLCFL%ZFLD3
+ NULLIFY (YLCFL%ZFLD3)
+ DEALLOCATE (YLCFL)
+ ENDIF
+ENDIF
+
+END SUBROUTINE PREP_CTL_INT_PART2_3
+
+SUBROUTINE PREP_CTL_INT_PART4_3 (YDCTL, CDSURF, CDTYPE, CDMASK, PFIELDIN, PFIELDOUT)
+
+TYPE (PREP_CTL), INTENT (INOUT) :: YDCTL
+CHARACTER (LEN=*), INTENT (IN) :: CDSURF
+CHARACTER (LEN=*), INTENT (IN) :: CDTYPE
+CHARACTER (LEN=*), INTENT (IN) :: CDMASK
+REAL, POINTER :: PFIELDIN (:,:,:)
+REAL, POINTER :: PFIELDOUT (:,:,:)
+
+INTEGER :: IREP, ILONG, IPOSEX
+INTEGER (8) :: JDIM (3)
+TYPE (PREP_CTL_FLD), POINTER :: YLCFL
+
+IF (YDCTL%LPART4) THEN
+ENDIF
+
+END SUBROUTINE PREP_CTL_INT_PART4_3
+
+END MODULE
+
diff --git a/src/SURFEX/mode_random.F90 b/src/SURFEX/mode_random.F90
index d72c6e4af52727a6cf510b2b6f10013a0d799ce4..cc246afa91f46ccd5b91fa4c38cf3ed7440ec269 100644
--- a/src/SURFEX/mode_random.F90
+++ b/src/SURFEX/mode_random.F90
@@ -107,7 +107,7 @@ REAL :: XHALF = 0.5
! XVSMALL = TINY(1.0), XVLARGE = HUGE(1.0)
!INTEGER, PARAMETER :: IDP = SELECTED_REAL_KIND(12, 60)
!
- CONTAINS
+CONTAINS
!
!
SUBROUTINE INIT_RANDOM_SEED()
@@ -118,14 +118,14 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_RANDOM_NUMBER:INIT_RANDOM_SEED',0,ZHOOK_HANDLE)
!
- CALL RANDOM_SEED(size = IIN)
+CALL RANDOM_SEED(size = IIN)
ALLOCATE(ISEED(IIN))
!
- CALL SYSTEM_CLOCK(COUNT=ICLOCK)
+CALL SYSTEM_CLOCK(COUNT=ICLOCK)
!
ISEED(:) = ICLOCK + 37 * (/ (I - 1, I = 1, IIN) /)
!
- CALL RANDOM_SEED(PUT = ISEED)
+CALL RANDOM_SEED(PUT = ISEED)
!
DEALLOCATE(ISEED)
!
diff --git a/src/SURFEX/mode_read_buffer.F90 b/src/SURFEX/mode_read_buffer.F90
index ef61c5393fb3effdc8e3dcacc6de7b6e7d781feb..82112d89bdaade7136711b70182635661851d466 100644
--- a/src/SURFEX/mode_read_buffer.F90
+++ b/src/SURFEX/mode_read_buffer.F90
@@ -11,7 +11,7 @@ USE MODI_ABOR1_SFX
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------
! ####################
SUBROUTINE READ_BUFFER_LAND_MASK(KLUOUT,HINMODEL,PMASK)
@@ -33,7 +33,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_READ_BUFFER:READ_BUFFER_LAND_MASK',0,ZHOOK_HANDLE)
WRITE (KLUOUT,'(A)') ' | Reading land mask'
SELECT CASE (HINMODEL)
- CASE ('ALADIN')
+CASE ('ALADIN')
ALLOCATE (ZFIELD(NNI))
CALL READ_BUFFER('LSM ',ZFIELD,IRET)
END SELECT
@@ -75,7 +75,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_READ_BUFFER:READ_BUFFER_ZS_LAND',0,ZHOOK_HANDLE)
WRITE (KLUOUT,'(A)') ' | Reading land orography'
SELECT CASE (HINMODEL)
- CASE ('ALADIN')
+CASE ('ALADIN')
ALLOCATE (PFIELD(NNI))
CALL READ_BUFFER('LPHIS ',PFIELD,IRET)
END SELECT
@@ -114,7 +114,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_READ_BUFFER:READ_BUFFER_ZS_SEA',0,ZHOOK_HANDLE)
WRITE (KLUOUT,'(A)') ' | Reading sea orography in buffer'
SELECT CASE (HINMODEL)
- CASE ('ALADIN')
+CASE ('ALADIN')
ALLOCATE (PFIELD(NNI))
CALL READ_BUFFER('SPHIS ',PFIELD,IRET)
END SELECT
@@ -154,7 +154,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_READ_BUFFER:READ_BUFFER_ZS',0,ZHOOK_HANDLE)
WRITE (KLUOUT,'(A)') ' | Reading orography'
SELECT CASE (HINMODEL)
- CASE ('ALADIN')
+CASE ('ALADIN')
ALLOCATE (PFIELD(NNI))
CALL READ_BUFFER('PHIS ',PFIELD,IRET)
END SELECT
@@ -192,7 +192,7 @@ IF (LHOOK) CALL DR_HOOK('MODE_READ_BUFFER:READ_BUFFER_TS',0,ZHOOK_HANDLE)
WRITE (KLUOUT,'(A)') ' | Reading surface temperature'
!
SELECT CASE (HINMODEL)
- CASE ('ALADIN')
+CASE ('ALADIN')
ALLOCATE (PFIELD(NNI))
CALL READ_BUFFER('TG1 ',PFIELD,IRET)
END SELECT
@@ -227,7 +227,7 @@ IF (LHOOK) CALL DR_HOOK('MODE_READ_BUFFER:READ_BUFFER_SST',0,ZHOOK_HANDLE)
WRITE (KLUOUT,'(A)') ' | Reading sea surface temperature'
!
SELECT CASE (HINMODEL)
- CASE ('ALADIN')
+CASE ('ALADIN')
ALLOCATE (PFIELD(NNI))
CALL READ_BUFFER('SST ',PFIELD,IRET)
!
@@ -265,7 +265,7 @@ WRITE (KLUOUT,'(A)') ' | Reading deep soil temperature'
!
SELECT CASE (HINMODEL)
- CASE ('ALADIN')
+CASE ('ALADIN')
ALLOCATE (PFIELD(NNI))
CALL READ_BUFFER('TG2 ',PFIELD,IRET)
END SELECT
@@ -899,7 +899,7 @@ IMPLICIT NONE
! ---------------
!
INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
- CHARACTER(LEN=6), INTENT(IN) :: HINMODEL ! Grib originating model
+CHARACTER(LEN=6), INTENT(IN) :: HINMODEL ! Grib originating model
REAL, INTENT(IN) :: PTI ! internal temperature
REAL, DIMENSION(:,:), POINTER :: PFIELD ! field to initialize
REAL, DIMENSION(:,:), POINTER :: PD ! normalized grid
diff --git a/src/SURFEX/mode_read_cdf.F90 b/src/SURFEX/mode_read_cdf.F90
index c854b54ed39fd454dfce0e90e3642106a6b05cb0..ce5e4a05a1f722e1f6101cb4fa8b8a658556b76e 100644
--- a/src/SURFEX/mode_read_cdf.F90
+++ b/src/SURFEX/mode_read_cdf.F90
@@ -11,21 +11,22 @@ USE MODI_ABOR1_SFX
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------
!-------------------------------------------------------------------
! ####################
SUBROUTINE HANDLE_ERR_CDF(status,line)
! ####################
+USE NETCDF
+!
IMPLICIT NONE
INTEGER, INTENT(IN) :: status
CHARACTER(*), INTENT(IN) :: line
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_CDF:HANDLE_ERR_CDF',0,ZHOOK_HANDLE)
-IF (status /= NF_NOERR) THEN
+IF (status /= NF90_NOERR) THEN
CALL ABOR1_SFX('MODE_READ_NETCDF: HANDLE_ERR_CDF:'//TRIM(line))
END IF
IF (LHOOK) CALL DR_HOOK('MODE_READ_CDF:HANDLE_ERR_CDF',1,ZHOOK_HANDLE)
@@ -36,6 +37,8 @@ END SUBROUTINE HANDLE_ERR_CDF
SUBROUTINE GET1DCDF(KCDF_ID,IDVAR,PMISSVALUE,PVALU1D)
! ####################
!
+USE NETCDF
+!
IMPLICIT NONE
!
INTEGER,INTENT(IN) :: KCDF_ID !netcdf file identifiant
@@ -55,7 +58,6 @@ character(len=80),DIMENSION(:),ALLOCATABLE :: HNAME
REAL,DIMENSION(:),ALLOCATABLE :: ZVALU1D !value array
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_CDF:GET1DCDF',0,ZHOOK_HANDLE)
PMISSVALUE=-9999.9
@@ -67,41 +69,41 @@ NVARDIMLEN(:)=0
NVARDIMNAM(:)=' '
!
HACTION='get variable type'
-status=nf_inq_vartype(KCDF_ID,IDVAR,KVARTYPE)
-if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+status=nf90_inquire_variable(KCDF_ID,IDVAR,XTYPE=KVARTYPE)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
!write(0,*) 'variable type = ',KVARTYPE
!
HACTION='get variable dimensions identifiant'
-status=nf_inq_vardimid(KCDF_ID,IDVAR,NVARDIMID(NDIMS))
-if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+status=nf90_inquire_variable(KCDF_ID,IDVAR,DIMIDS=NVARDIMID)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
!write(0,*) 'variable dimension ',NDIMS,' identifiant ',NVARDIMID(NDIMS)
!
HACTION='get variable dimensions name'
-status=nf_inq_dimname(KCDF_ID,NVARDIMID(NDIMS),NVARDIMNAM(NDIMS))
-if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+status=nf90_inquire_dimension(KCDF_ID,NVARDIMID(NDIMS),NAME=NVARDIMNAM(NDIMS))
+if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
!
HACTION='get variable dimensions length'
-status=nf_inq_dimlen(KCDF_ID,NVARDIMID(NDIMS),NVARDIMLEN(NDIMS))
-if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+status=nf90_inquire_dimension(KCDF_ID,NVARDIMID(NDIMS),LEN=NVARDIMLEN(NDIMS))
+if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
!write(0,*) 'variable dimension ',NDIMS,' named ',NVARDIMNAM(NDIMS),&
! &'has a length of',NVARDIMLEN(NDIMS)
!
HACTION='get attributs'
-!status=nf_inq_natts(KCDF_ID,NGATTS)
-status=nf_inq_varnatts(KCDF_ID,IDVAR,NGATTS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+!status=nf90_inq_natts(KCDF_ID,NGATTS)
+status=nf90_inquire_variable(KCDF_ID,IDVAR,NATTS=NGATTS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
!write(0,*) 'number of attributes = ',NGATTS
allocate(hname(1:NGATTS))
!
DO JLOOP=1,NGATTS
- status=nf_inq_attname(KCDF_ID,IDVAR,JLOOP,hname(JLOOP))
- if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+ status=nf90_inq_attname(KCDF_ID,IDVAR,JLOOP,hname(JLOOP))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
!write(0,*) 'attributes names = ', hname(JLOOP)
if (TRIM(hname(JLOOP))=='missing_value') then
!write(0,*) 'missing value search '
HACTION='get missing value'
- status=nf_get_att_double(KCDF_ID,IDVAR,"missing_value",PMISSVALUE)
- if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+ status=nf90_get_att(KCDF_ID,IDVAR,"missing_value",PMISSVALUE)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
!write(0,*) 'missing value = ',PMISSVALUE
endif
ENDDO
@@ -111,8 +113,8 @@ ZVALU1D=0.
!
IF (KVARTYPE>=5) then
HACTION='get variable values (1D)'
- status=nf_get_var_double(KCDF_ID,IDVAR,ZVALU1D(:))
- if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+ status=nf90_get_var(KCDF_ID,IDVAR,ZVALU1D(:))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
ENDIF
PVALU1D(:)=ZVALU1D(:)
IF (ALLOCATED(ZVALU1D )) DEALLOCATE(ZVALU1D)
@@ -126,6 +128,8 @@ END SUBROUTINE GET1DCDF
PMISSVALUE,PVALU2D)
! ####################
!
+USE NETCDF
+!
IMPLICIT NONE
!
INTEGER,INTENT(IN) :: KCDF_ID !netcdf file identifiant
@@ -141,14 +145,13 @@ integer,save :: NDIMS=2
integer :: KVARTYPE
integer,DIMENSION(:),ALLOCATABLE :: NVARDIMID,NVARDIMLEN
character(len=80),DIMENSION(:),ALLOCATABLE :: NVARDIMNAM
-integer :: JLOOP2, JLOOP
+integer :: JLOOP
integer :: NGATTS
character(len=80),DIMENSION(:),ALLOCATABLE :: HNAME
real :: ZMISS1,ZMISS2
REAL,DIMENSION(:,:),ALLOCATABLE :: ZVALU2D !value array
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_CDF:GET2DCDF',0,ZHOOK_HANDLE)
PMISSVALUE=-9999.9
@@ -160,52 +163,52 @@ NVARDIMLEN(:)=0
NVARDIMNAM(:)=' '
!
HACTION='get variable type'
-status=nf_inq_vartype(KCDF_ID,IDVAR,KVARTYPE)
-if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+status=nf90_inquire_variable(KCDF_ID,IDVAR,XTYPE=KVARTYPE)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
!write(0,*) 'variable type = ',KVARTYPE
!
HACTION='get variable dimensions identifiant'
-status=nf_inq_vardimid(KCDF_ID,IDVAR,NVARDIMID)
-if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+status=nf90_inquire_variable(KCDF_ID,IDVAR,DIMIDS=NVARDIMID)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
!
HACTION='get attributs'
-!status=nf_inq_natts(KCDF_ID,NGATTS)
-status=nf_inq_varnatts(KCDF_ID,IDVAR,NGATTS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+!status=nf90_inq_natts(KCDF_ID,NGATTS)
+status=nf90_inquire_variable(KCDF_ID,IDVAR,NATTS=NGATTS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
!write(0,*) 'number of attributes = ',NGATTS
allocate(hname(1:NGATTS))
!
DO JLOOP=1,NGATTS
- status=nf_inq_attname(KCDF_ID,IDVAR,JLOOP,hname(JLOOP))
- if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+ status=nf90_inq_attname(KCDF_ID,IDVAR,JLOOP,hname(JLOOP))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
!write(0,*) 'attributes names = ', hname(JLOOP)
if (TRIM(hname(JLOOP))=='missing_value') then
!write(0,*) 'missing value search '
HACTION='get missing value'
- status=nf_get_att_double(KCDF_ID,IDVAR,"missing_value",PMISSVALUE)
- if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+ status=nf90_get_att(KCDF_ID,IDVAR,"missing_value",PMISSVALUE)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
!write(0,*) 'missing value = ',PMISSVALUE
endif
ENDDO
!
!
-DO JLOOP2=1,NDIMS
+DO JLOOP=1,NDIMS
HACTION='get variable dimensions name'
- status=nf_inq_dimname(KCDF_ID,JLOOP2,NVARDIMNAM(JLOOP2))
- if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+ status=nf90_inquire_dimension(KCDF_ID,NVARDIMID(JLOOP),NAME=NVARDIMNAM(JLOOP))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(KCDF_ID,JLOOP2,NVARDIMLEN(JLOOP2))
- if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
- !write(0,*) 'variable dimension ',JLOOP2,' named ',NVARDIMNAM(JLOOP2),&
- ! &'has a length of',NVARDIMLEN(JLOOP2)
+ status=nf90_inquire_dimension(KCDF_ID,NVARDIMID(JLOOP),LEN=NVARDIMLEN(JLOOP))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+ !write(0,*) 'variable dimension ',JLOOP,' named ',NVARDIMNAM(JLOOP),&
+ ! &'has a length of',NVARDIMLEN(JLOOP)
ENDDO
!
ALLOCATE(ZVALU2D(1:NVARDIMLEN(1),1:NVARDIMLEN(2)))
ZVALU2D=0.
IF (KVARTYPE>=5) then
HACTION='get variable values (2D)'
- status=nf_get_var_double(KCDF_ID,IDVAR,ZVALU2D(:,:))
- if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+ status=nf90_get_var(KCDF_ID,IDVAR,ZVALU2D(:,:))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
ENDIF
PVALU2D(:,:)=ZVALU2D(:,:)
!
@@ -223,6 +226,8 @@ END SUBROUTINE GET2DCDF
SUBROUTINE READ_LATLONVAL_CDF(HFILENAME,HNCVARNAME,PLON,PLAT,PVAL)
! ####################
!
+USE NETCDF
+!
IMPLICIT NONE
!
CHARACTER(LEN=28), INTENT(IN) :: HFILENAME ! Name of the field file.
@@ -239,7 +244,8 @@ integer ::JLOOP1,JDIM1,JDIM2,JLOOP
integer ::ID_VARTOGET,ID_VARTOGET1,ID_VARTOGET2
integer ::NVARDIMS
integer ::NLEN
-integer,DIMENSION(1:2) :: NLEN2D
+integer,dimension(1) :: IDIMID
+integer,DIMENSION(1:2) :: NLEN2D,IDIMID2D
integer,DIMENSION(:),ALLOCATABLE :: NVARDIMID,NVARDIMLEN
character(len=80),DIMENSION(:),ALLOCATABLE :: NVARDIMNAM
real,DIMENSION(:),ALLOCATABLE :: ZVALU
@@ -251,7 +257,6 @@ character(len=80) :: YDIM1NAME,YDIM2NAME
integer :: ILONFOUND,ILATFOUND, IARG
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
!* 1. Open the netcdf file
! --------------------
@@ -259,10 +264,10 @@ IF (LHOOK) CALL DR_HOOK('MODE_READ_CDF:READ_LATLONVAL_CDF',0,ZHOOK_HANDLE)
status=-9999
kcdf_id=-9999
HACTION='open netcdf'
-status=NF_OPEN(HFILENAME,nf_nowrite,kcdf_id)
+status=NF90_OPEN(HFILENAME,nf90_nowrite,kcdf_id)
!write(0,*) 'status=',status
!write(0,*) 'identifiant de ',HFILENAME,'=',kcdf_id
-if (status/=NF_NOERR) then
+if (status/=NF90_NOERR) then
CALL HANDLE_ERR_CDF(status,HACTION)
!else
! write(0,*) 'netcdf file opened: ',HFILENAME
@@ -273,8 +278,8 @@ endif
!* 2. get the number of variables in netcdf file
! ------------------------------------------
HACTION='get number of variables'
-status=NF_INQ_NVARS(kcdf_id,NBVARS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+status=NF90_INQUIRE(kcdf_id,NVARIABLES=NBVARS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
!write(0,*) 'nb vars', NBVARS
ALLOCATE(VARNAME(NBVARS))
!
@@ -286,8 +291,8 @@ ID_VARTOGET1=0
ID_VARTOGET2=0
DO JLOOP1=1,NBVARS
HACTION='get variables names'
- status=NF_INQ_VARNAME(kcdf_id,JLOOP1,VARNAME(JLOOP1))
- if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+ status=NF90_INQUIRE_VARIABLE(kcdf_id,JLOOP1,NAME=VARNAME(JLOOP1))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
!write(0,*) 'var',JLOOP1,' name: ',VARNAME(JLOOP1)
if (VARNAME(JLOOP1)==HNCVARNAME) then
!write(0,*) 'var',JLOOP1,' corresponding to variable required'
@@ -309,8 +314,8 @@ else
endif
if (ID_VARTOGET==0) then
HACTION='close netcdf'
- status=nf_close(kcdf_id)
- if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+ status=nf90_close(kcdf_id)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
CALL ABOR1_SFX('MODE_READ_NETCDF: READ_LATLONVAL_CDF')
endif
!-----------
@@ -322,8 +327,8 @@ endif
! -----------------------------------
!
HACTION='get variable dimensions number'
-status=nf_inq_varndims(kcdf_id,ID_VARTOGET,NVARDIMS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,NDIMS=NVARDIMS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
!
! 4.2 get the variable dimensions length and values
! ----------------------------------------------
@@ -332,8 +337,9 @@ SELECT CASE (NVARDIMS)
CASE (1)
!write(0,*) 'variable dimensions number = ',NVARDIMS
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(kcdf_id,NVARDIMS,NLEN)
- if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+ status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,DIMIDS=IDIMID)
+ status=nf90_inquire_dimension(kcdf_id,IDIMID(1),LEN=NLEN)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
ALLOCATE(ZVALU(NLEN))
!write(0,*) 'call GET1DCDF'
CALL GET1DCDF(kcdf_id,ID_VARTOGET,ZMISS,ZVALU)
@@ -341,10 +347,11 @@ SELECT CASE (NVARDIMS)
!CAS 2D
CASE (2)
!write(0,*) 'variable dimensions number = ',NVARDIMS
+ status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,DIMIDS=IDIMID2D)
DO JLOOP=1,NVARDIMS
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(kcdf_id,JLOOP,NLEN2D(JLOOP))
- if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+ status=nf90_inquire_dimension(kcdf_id,IDIMID2D(JLOOP),LEN=NLEN2D(JLOOP))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
ENDDO
ALLOCATE(ZVALU2D(NLEN2D(1),NLEN2D(2)))
ALLOCATE(ZDIM1(NLEN2D(1)))
@@ -393,8 +400,8 @@ END SELECT
!* 10. Close the netcdf file
! ---------------------
HACTION='close netcdf'
-status=nf_close(kcdf_id)
-if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+status=nf90_close(kcdf_id)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
!write(0,*) 'OK: netcdf file closed: ',HFILENAME
!
!-----------
@@ -417,6 +424,8 @@ END SUBROUTINE READ_LATLONVAL_CDF
SUBROUTINE READ_DIM_CDF(HFILENAME,HNCVARNAME,KDIM)
! ####################
!
+USE NETCDF
+!
IMPLICIT NONE
!
CHARACTER(LEN=28), INTENT(IN) :: HFILENAME ! Name of the field file.
@@ -431,17 +440,17 @@ character(len=80),DIMENSION(:),ALLOCATABLE :: VARNAME
integer ::JLOOP1,JLOOP
integer ::ID_VARTOGET,ID_VARTOGET1,ID_VARTOGET2
integer ::NVARDIMS
-integer,DIMENSION(2) ::NLEN2D
+integer, dimension(1) :: NDIMID
+integer,DIMENSION(2) ::NLEN2D, NDIMID2D
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
!* 1. Open the netcdf file
! --------------------
IF (LHOOK) CALL DR_HOOK('MODE_READ_CDF:READ_DIM_CDF',0,ZHOOK_HANDLE)
HACTION='open netcdf'
-status=NF_OPEN(HFILENAME,nf_nowrite,kcdf_id)
-if (status/=NF_NOERR) then
+status=NF90_OPEN(HFILENAME,nf90_nowrite,kcdf_id)
+if (status/=NF90_NOERR) then
CALL HANDLE_ERR_CDF(status,HACTION)
!else
endif
@@ -451,8 +460,8 @@ endif
!* 2. get the number of variables in netcdf file
! ------------------------------------------
HACTION='get number of variables'
-status=NF_INQ_NVARS(kcdf_id,NBVARS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+status=NF90_INQUIRE(kcdf_id,NVARIABLES=NBVARS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
!write(0,*) 'nb vars', NBVARS
ALLOCATE(VARNAME(NBVARS))
!
@@ -464,8 +473,8 @@ ID_VARTOGET1=0
ID_VARTOGET2=0
DO JLOOP1=1,NBVARS
HACTION='get variables names'
- status=NF_INQ_VARNAME(kcdf_id,JLOOP1,VARNAME(JLOOP1))
- if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+ status=NF90_INQUIRE_VARIABLE(kcdf_id,JLOOP1,NAME=VARNAME(JLOOP1))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
!write(0,*) 'var',JLOOP1,' name: ',VARNAME(JLOOP1)
if (VARNAME(JLOOP1)==HNCVARNAME) then
!write(0,*) 'var',JLOOP1,' corresponding to variable required'
@@ -487,8 +496,8 @@ else
endif
if (ID_VARTOGET==0) then
HACTION='close netcdf'
- status=nf_close(kcdf_id)
- if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+ status=nf90_close(kcdf_id)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
CALL ABOR1_SFX('MODE_READ_CDF: READ_DIM_CDF')
endif
!-----------
@@ -500,8 +509,8 @@ endif
! -----------------------------------
!
HACTION='get variable dimensions number'
-status=nf_inq_varndims(kcdf_id,ID_VARTOGET,NVARDIMS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,ndims=NVARDIMS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
!write(0,*) 'variable dimensions number = ',NVARDIMS
!
! 4.2 get the variable dimensions length
@@ -510,16 +519,18 @@ SELECT CASE (NVARDIMS)
!CAS 1D
CASE (1)
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(kcdf_id,NVARDIMS,KDIM)
- if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+ status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,dimids=NDIMID)
+ status=nf90_inquire_dimension(kcdf_id,NDIMID(1),LEN=KDIM)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
!
!CAS 2D
CASE (2)
KDIM=1
+ status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,dimids=NDIMID2D)
DO JLOOP=1,NVARDIMS
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(kcdf_id,JLOOP,NLEN2D(JLOOP))
- if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+ status=nf90_inquire_dimension(kcdf_id,NDIMID2D(JLOOP),LEN=NLEN2D(JLOOP))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
KDIM=KDIM*NLEN2D(JLOOP)
ENDDO
END SELECT
@@ -527,8 +538,8 @@ END SELECT
!* 10. Close the netcdf file
! ---------------------
HACTION='close netcdf'
-status=nf_close(kcdf_id)
-if (status/=NF_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
+status=nf90_close(kcdf_id)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_CDF(status,HACTION)
!write(0,*) 'OK: netcdf file closed: ',HFILENAME
!
!-----------
diff --git a/src/SURFEX/mode_read_extern.F90 b/src/SURFEX/mode_read_extern.F90
index 223a60cb29281fdfd8fe136085f9ca5250366bc1..96f488f92b293dc2127eb037b111ced0552b50f2 100644
--- a/src/SURFEX/mode_read_extern.F90
+++ b/src/SURFEX/mode_read_extern.F90
@@ -8,7 +8,7 @@ MODULE MODE_READ_EXTERN
!-------------------------------------------------------------------
!
USE MODD_SURF_PAR, ONLY : NUNDEF, XUNDEF
-USE MODD_DATA_COVER_PAR, ONLY : JPCOVER, NVEGTYPE
+USE MODD_DATA_COVER_PAR, ONLY : NCOVER, NTYPE, NVEGTYPE, JPCOVER, NVEGTYPE_OLD, NVEGTYPE_ECOSG
!
USE MODE_READ_SURF_COV, ONLY : READ_SURF_COV
!
@@ -18,64 +18,64 @@ USE MODI_OLD_NAME
USE MODI_OPEN_AUX_IO_SURF
USE MODI_CLOSE_AUX_IO_SURF
USE MODI_READ_SURF
+USE MODI_MAKE_CHOICE_ARRAY
USE MODI_ABOR1_SFX
+USE MODI_READ_PGD_COVER_GARDEN
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
- CONTAINS
+CONTAINS
!
!---------------------------------------------------------------------------------------
!
! #######################
- SUBROUTINE READ_EXTERN_DEPTH (U, &
- DTCO, I,GCP, &
- HFILE,HPROGRAM,KLUOUT,HISBA,HNAT,HFIELD,KNI,KLAYER, &
+ SUBROUTINE READ_EXTERN_DEPTH (U, DTCO, GCP, IO, &
+ HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,&
+ KLUOUT,HISBA,HNAT,HFIELD,KNI,KLAYER, &
KPATCH,PSOILGRID,PDEPTH,KVERSION,KWG_LAYER )
! #######################
!
-!
-!
-!
-!
-!
-!
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+!
+USE MODD_SURFEX_MPI, ONLY : NRANK,NPIO
+!
+USE MODD_PREP_TEB_GREENROOF, ONLY : NGRID_LEVEL, XGRID_SOIL
!
+USE MODI_OPEN_AUX_IO_SURF
+USE MODI_CLOSE_AUX_IO_SURF
USE MODI_READ_SURF_ISBA_PAR_n
-USE MODI_READ_SURF_FIELD3D
-USE MODI_READ_SURF_FIELD2D
USE MODI_CONVERT_COVER_ISBA
USE MODI_GARDEN_SOIL_DEPTH
+USE MODI_READ_ARRANGE_COVER
!
! Modifications :
! P.Marguinaud : 11-09-2012 : shorten field name
! G.Delautier : 24-06-2015 : bug for arome compressed files
-! M.Moge 01/2016 using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads
!
IMPLICIT NONE
!
!* dummy arguments
! ---------------
!
-!
-!
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
!
- CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! type of input file
+ CHARACTER(LEN=28), INTENT(IN) :: HFILE ! type of input file
+ CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! type of input file
+ CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! type of input file
+ CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! type of input file
INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
- CHARACTER(LEN=3), INTENT(IN) :: HISBA ! type of ISBA soil scheme
- CHARACTER(LEN=3), INTENT(IN) :: HNAT ! type of surface (nature, gardens)
- CHARACTER(LEN=7), INTENT(IN) :: HFIELD ! field name
+CHARACTER(LEN=3), INTENT(IN) :: HISBA ! type of ISBA soil scheme
+CHARACTER(LEN=3), INTENT(IN) :: HNAT ! type of surface (nature, gardens)
+CHARACTER(LEN=7), INTENT(IN) :: HFIELD ! field name
INTEGER, INTENT(IN) :: KNI ! number of points
INTEGER, INTENT(IN) :: KLAYER ! number of layers
INTEGER, INTENT(IN) :: KPATCH ! number of patch
@@ -89,32 +89,37 @@ INTEGER, DIMENSION(:,:), INTENT(OUT):: KWG_LAYER
!
CHARACTER(LEN=4 ) :: YLVL
CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+ CHARACTER(LEN=LEN_HREC) :: YRECFMOLD ! Name of the article to be read
CHARACTER(LEN=LEN_HREC) :: YRECFM2
CHARACTER(LEN=100):: YCOMMENT ! Comment string
+ CHARACTER(LEN=6) :: YSURF
INTEGER :: IRESP ! reading return code
-INTEGER :: JLAYER ! loop counter
-INTEGER :: JPATCH ! loop counter
-INTEGER :: JJ
+INTEGER :: JL ! loop counter
+INTEGER :: JP ! loop counter
+INTEGER :: JJ, JI, IEND
INTEGER :: IVERSION
INTEGER :: IBUGFIX
!
-LOGICAL, DIMENSION(JPCOVER) :: GCOVER ! flag to read the covers
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GCOVER ! flag to read the covers
REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOVER ! cover fractions
REAL, DIMENSION(:,:), ALLOCATABLE :: ZGROUND_DEPTH ! cover fractions
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK ! work array
-INTEGER, DIMENSION(:), ALLOCATABLE :: ZSOILGRID
+REAL, DIMENSION(:), ALLOCATABLE :: ZSOILGRID
REAL, DIMENSION(KNI) :: ZHVEG ! high vegetation fraction
REAL, DIMENSION(KNI) :: ZLVEG ! low vegetation fraction
REAL, DIMENSION(KNI) :: ZNVEG ! no vegetation fraction
REAL, DIMENSION(KNI) :: ZPERM ! permafrost distribution
- CHARACTER(LEN=4) :: YHVEG ! type of high vegetation
- CHARACTER(LEN=4) :: YLVEG ! type of low vegetation
- CHARACTER(LEN=4) :: YNVEG ! type of no vegetation
+ CHARACTER(LEN=4) :: YHVEG ! type of high vegetation
+ CHARACTER(LEN=4) :: YLVEG ! type of low vegetation
+ CHARACTER(LEN=4) :: YNVEG ! type of no vegetation
+INTEGER :: INVEGTYPE_SAVE, IJPCOVER_SAVE
LOGICAL :: GECOCLIMAP ! T if ecoclimap is used
+LOGICAL :: GECOSG
LOGICAL :: GPAR_GARDEN! T if garden data are used
-LOGICAL :: GDATA_DG
-LOGICAL :: GDATA_GROUND_DEPTH, GDATA_ROOT_DEPTH
+LOGICAL, DIMENSION(NVEGTYPE_ECOSG) :: GDATA_DG
+LOGICAL, DIMENSION(NVEGTYPE_ECOSG) :: GDATA_GROUND_DEPTH, GDATA_ROOT_DEPTH
LOGICAL :: GPERM
+LOGICAL :: GREAD_EXT
+LOGICAL :: GREAD_OK, GDIM, GDIM2, GWATER_TO_NATURE, GTOWN_TO_ROCK, GGARDEN
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
@@ -122,152 +127,84 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_EXTERN:READ_EXTERN_DEPTH',0,ZHOOK_HANDLE)
!
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HPROGRAM,'FULL ')
-YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'FULL ')
+
+ YRECFM='VERSION'
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,IVERSION,IRESP,HDIR='-')
+!
YRECFM='BUG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IBUGFIX,IRESP)
- CALL CLOSE_AUX_IO_SURF(HFILE,HPROGRAM)
-!
-IF (HNAT=='NAT') THEN
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HPROGRAM,'FULL ')
- CALL READ_LECOCLIMAP(&
- HPROGRAM,GECOCLIMAP)
- CALL CLOSE_AUX_IO_SURF(HFILE,HPROGRAM)
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,IBUGFIX,IRESP,HDIR='-')
+!
+GDIM = (IVERSION>8 .OR. IVERSION==8 .AND. IBUGFIX>0)
+GDIM2 = GDIM
+IF (GDIM) CALL READ_SURF(HFILEPGDTYPE,'SPLIT_PATCH',GDIM2,IRESP)
+!
+ CALL READ_LECOCLIMAP(HFILEPGDTYPE,GECOCLIMAP,GECOSG,HDIR='-')
+IF (HNAT=='NAT') THEN
+ YSURF = "NATURE"
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
ELSE
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HPROGRAM,'TOWN ')
- CALL READ_SURF(&
- HPROGRAM,'PAR_GARDEN',GPAR_GARDEN,IRESP)
- CALL CLOSE_AUX_IO_SURF(HFILE,HPROGRAM)
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ')
+ CALL READ_SURF(HFILEPGDTYPE,'PAR_GARDEN',GPAR_GARDEN,IRESP,HDIR='-')
GECOCLIMAP = .NOT. GPAR_GARDEN
+ IF (.NOT.GECOCLIMAP) GECOSG = .FALSE.
+ YSURF = "TOWN "
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
END IF
!
-!------------------------------------------------------------------------------
-!
-!* permafrost distribution for soil depth
-!
-GPERM =.FALSE.
-ZPERM(:)=0.0
-!
-IF (HNAT=='NAT'.AND.(IVERSION>7 .OR. (IVERSION==7 .AND. IBUGFIX>3)))THEN
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HPROGRAM,'NATURE')
- YRECFM='PERMAFROST'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,GPERM,IRESP)
- IF(GPERM)THEN
- YRECFM='PERM'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ZPERM(:),IRESP,HDIR='A')
- ENDIF
- CALL CLOSE_AUX_IO_SURF(HFILE,HPROGRAM)
+INVEGTYPE_SAVE = NVEGTYPE
+IJPCOVER_SAVE = JPCOVER
+IF (GECOSG) THEN
+ NVEGTYPE = NVEGTYPE_ECOSG
+ JPCOVER = SUM(NTYPE)
+ELSE
+ NVEGTYPE = NVEGTYPE_OLD
+ JPCOVER = NCOVER
ENDIF
!
+!------------------------------------------------------------------------------
+!
ALLOCATE(PDEPTH(KNI,KLAYER,KPATCH))
PDEPTH(:,:,:) = XUNDEF
!
KWG_LAYER(:,:) = NUNDEF
!
-IF (GECOCLIMAP) THEN
- !
- IF (IVERSION<8 .OR. IVERSION==8 .AND. IBUGFIX<=1) THEN !
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HPROGRAM,'FULL ')
- !
- !* reading of the cover to obtain the depth of inter-layers
- !
- CALL OLD_NAME(&
- HPROGRAM,'COVER_LIST ',YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,GCOVER(:),IRESP,HDIR='-')
- !
- ALLOCATE(ZCOVER(KNI,COUNT(GCOVER)))
- YRECFM='COVER'
- CALL READ_SURF_COV(&
- HPROGRAM,YRECFM,ZCOVER(:,:),GCOVER(:),IRESP,HDIR='A')
- !
- !* computes soil layers
- !
- CALL CONVERT_COVER_ISBA(DTCO, I, &
- HISBA,1,ZCOVER,GCOVER,' ',HNAT,PSOILGRID=PSOILGRID, &
- PPERM=ZPERM,PDG=PDEPTH,KWG_LAYER=KWG_LAYER )
- !
- DEALLOCATE(ZCOVER)
-ELSE
-print*, '-----------------------------------------------'
-print*, '-----------------------------------------------'
-print*, '-----------------------------------------------'
-print*, '-----------------------------------------------'
-print*, 'MODE_READ_EXTERN : ==> ON NE LIT PAS LES COVERS'
-print*, '-----------------------------------------------'
-print*, '-----------------------------------------------'
-print*, '-----------------------------------------------'
-print*, '-----------------------------------------------'
- IF (HNAT=='NAT') THEN
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HPROGRAM,'NATURE')
- YRECFM='ECO_DG'
- ELSE
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HPROGRAM,'TOWN ')
- YRECFM='GD_ECO_DG'
- END IF
- CALL READ_SURF_FIELD3D(HPROGRAM,PDEPTH,1,SIZE(PDEPTH,2),YRECFM,HDIR='A')
- !
- IF (HISBA=='DIF') THEN
- YRECFM='ECO_WG_L'
- IF (HNAT=='GRD') YRECFM='GD_ECO_WG_L'
- ALLOCATE(ZWORK(KNI,KPATCH))
- CALL READ_SURF_FIELD2D(HPROGRAM,ZWORK(:,:),YRECFM,HDIR='A')
- WHERE (ZWORK==XUNDEF) ZWORK=NUNDEF
- KWG_LAYER=NINT(ZWORK)
- DEALLOCATE(ZWORK)
- END IF
- END IF
- !
- CALL CLOSE_AUX_IO_SURF(HFILE,HPROGRAM)
- !
-ENDIF
-!
-IF (HNAT=='GRD') THEN
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HPROGRAM,'TOWN ')
-ELSE
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HPROGRAM,'NATURE')
-ENDIF
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,YSURF)
!
!-------------------------------------------------------------------
+!
+GREAD_OK = .FALSE.
+!
+!
+IEND = 1
+IF (GDIM) IEND = NVEGTYPE_ECOSG
+!
IF (HNAT=='NAT' .AND. (IVERSION>=7 .OR. .NOT.GECOCLIMAP)) THEN
!
!* directly read soil layers in the file for nature ISBA soil layers
!
- GDATA_DG = .TRUE.
+ GDATA_DG(:) = .FALSE.
+ IF (.NOT.GECOCLIMAP) GDATA_DG(:) = .TRUE.
IF (IVERSION>=7) THEN
YRECFM='L_DG'
YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,GDATA_DG,IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,GDATA_DG(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
ENDIF
!
- IF (GDATA_DG) THEN
- !
- ALLOCATE(ZWORK(KNI,KPATCH))
- DO JLAYER=1,KLAYER
- IF (JLAYER<10) WRITE(YRECFM,FMT='(A4,I1.1)') 'D_DG',JLAYER
- IF (JLAYER>=10) WRITE(YRECFM,FMT='(A4,I2.2)') 'D_DG',JLAYER
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,KLUOUT,KNI,ZWORK,IRESP,IVERSION,HDIR='A')
- DO JPATCH=1,KPATCH
- PDEPTH(:,JLAYER,JPATCH) = ZWORK(:,JPATCH)
- END DO
+ IF (ANY(GDATA_DG(1:IEND))) THEN
+ !
+ DO JL=1,KLAYER
+ IF (GDIM) THEN
+ WRITE(YRECFM,FMT='(A6,I2.2)') 'D_DG_L',JL
+ ELSE
+ IF (JL<10) WRITE(YRECFM,FMT='(A4,I1.1)') 'D_DG',JL
+ IF (JL>=10) WRITE(YRECFM,FMT='(A4,I2.2)') 'D_DG',JL
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, KPATCH, HFILEPGDTYPE, YRECFM, KLUOUT, KNI, &
+ IVERSION, IBUGFIX, GDATA_DG, PDEPTH(:,JL,:),IRESP,HDIR='E')
END DO
- DEALLOCATE(ZWORK)
+ GREAD_OK = .TRUE.
!
ENDIF
!
@@ -275,16 +212,20 @@ IF (HNAT=='NAT' .AND. (IVERSION>=7 .OR. .NOT.GECOCLIMAP)) THEN
!
!cas when root_depth and ground_depth were extrapolated in extrapol_field
!during pgd step
- IF (.NOT.GDATA_DG .AND. HISBA=="3-L") THEN
+ IF (.NOT.ANY(GDATA_DG(1:IEND)) .AND. HISBA=="3-L") THEN
!
YRECFM2='L_ROOT_DEPTH'
YCOMMENT=YRECFM2
- CALL READ_SURF(HPROGRAM,YRECFM2,GDATA_ROOT_DEPTH,IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM2,GDATA_ROOT_DEPTH(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
!
- IF (GDATA_ROOT_DEPTH) THEN
- YRECFM2='D_ROOT_DEPTH'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM2,KLUOUT,KNI,PDEPTH(:,2,:),IRESP,IVERSION,HDIR='A')
+ IF (ANY(GDATA_ROOT_DEPTH(1:IEND))) THEN
+ IF (GDIM) THEN
+ YRECFM2='D_RTDPT_'
+ ELSE
+ YRECFM2='D_ROOT_DEPTH'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, KPATCH, HFILEPGDTYPE, YRECFM2, KLUOUT, KNI, &
+ IVERSION, IBUGFIX, GDATA_ROOT_DEPTH, PDEPTH(:,2,:),IRESP,HDIR='E')
ENDIF
!
ENDIF
@@ -292,58 +233,63 @@ IF (HNAT=='NAT' .AND. (IVERSION>=7 .OR. .NOT.GECOCLIMAP)) THEN
YRECFM2='L_GROUND_DEPTH'
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM2='L_GROUND_DPT'
YCOMMENT=YRECFM2
- CALL READ_SURF(&
- HPROGRAM,YRECFM2,GDATA_GROUND_DEPTH,IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM2,GDATA_GROUND_DEPTH(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
IF (IRESP/=0 .AND. YRECFM2=='L_GROUND_DEPTH' ) THEN
- WRITE (KLUOUT,*) ' | ERROR Reading L_GROUND_DEPTH try with L_GROUND_DPT'
+ WRITE (KLUOUT,*) ' | ERROR Reading L_GROUND_DEPTH try with L_GROUND_DPT'
YRECFM2='L_GROUND_DPT'
YCOMMENT=YRECFM2
- CALL READ_SURF(&
- HPROGRAM,YRECFM2,GDATA_GROUND_DEPTH,IRESP,HCOMMENT=YCOMMENT)
- ENDIF
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM2,GDATA_GROUND_DEPTH(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ ENDIF
!
- IF (GDATA_GROUND_DEPTH) THEN
+ IF (ANY(GDATA_GROUND_DEPTH(1:IEND))) THEN
!
- YRECFM2='D_GROUND_DETPH'
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM2='D_GROUND_DPT'
ALLOCATE(ZGROUND_DEPTH(KNI,KPATCH))
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM2,KLUOUT,KNI,ZGROUND_DEPTH(:,:),IRESP,IVERSION,HDIR='A')
+ IF (GDIM) THEN
+ YRECFM2='D_GRDPT_'
+ ELSE
+ YRECFM2='D_GROUND_DEPTH'
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM2='D_GROUND_DPT'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, KPATCH, HFILEPGDTYPE, YRECFM2, KLUOUT, KNI, &
+ IVERSION, IBUGFIX, GDATA_GROUND_DEPTH, ZGROUND_DEPTH(:,:),IRESP,HDIR='E')
!
- IF (.NOT.GDATA_DG) THEN
+ IF (.NOT.ANY(GDATA_DG(1:IEND))) THEN
!
IF (HISBA=="2-L") THEN
!
PDEPTH(:,2,:) = ZGROUND_DEPTH(:,:)
PDEPTH(:,1,:) = XUNDEF
WHERE (ZGROUND_DEPTH(:,:)/=XUNDEF) PDEPTH(:,1,:) = 0.01
+ GREAD_OK = .TRUE.
!
ELSEIF (HISBA=="3-L") THEN
!
PDEPTH(:,3,:) = ZGROUND_DEPTH(:,:)
PDEPTH(:,1,:) = XUNDEF
WHERE (ZGROUND_DEPTH(:,:)/=XUNDEF) PDEPTH(:,1,:) = 0.01
+ IF (ANY(GDATA_ROOT_DEPTH(1:IEND))) GREAD_OK = .TRUE.
!
ELSEIF (HISBA=="DIF") THEN
!
ALLOCATE(ZSOILGRID(KLAYER))
- DO JLAYER=1,KLAYER
- WRITE(YLVL,'(I4)') JLAYER
+ DO JL=1,KLAYER
+ WRITE(YLVL,'(I4)') JL
YRECFM2='SOILGRID'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(HPROGRAM,YRECFM,ZSOILGRID(JLAYER),IRESP)
- PDEPTH(:,JLAYER,:) = ZSOILGRID(JLAYER)
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZSOILGRID(JL),IRESP)
+ PDEPTH(:,JL,:) = ZSOILGRID(JL)
ENDDO
DEALLOCATE(ZSOILGRID)
+ GREAD_OK = .TRUE.
!
ENDIF
ENDIF
- !
- DO JPATCH=1,KPATCH
+ !
+ DO JP=1,KPATCH
DO JJ=1,KNI
- DO JLAYER=1,KLAYER
- IF ( PDEPTH(JJ,JLAYER,JPATCH) <= ZGROUND_DEPTH(JJ,JPATCH) .AND. ZGROUND_DEPTH(JJ,JPATCH) < XUNDEF ) &
- KWG_LAYER(JJ,JPATCH) = JLAYER
+ DO JL=1,KLAYER
+ IF ( PDEPTH(JJ,JL,JP) <= ZGROUND_DEPTH(JJ,JP) .AND. ZGROUND_DEPTH(JJ,JP) < XUNDEF ) &
+ KWG_LAYER(JJ,JP) = JL
ENDDO
ENDDO
ENDDO
@@ -353,28 +299,129 @@ IF (HNAT=='NAT' .AND. (IVERSION>=7 .OR. .NOT.GECOCLIMAP)) THEN
!
ENDIF
!
-ELSE IF (HNAT=='GRD' .AND. .NOT.GECOCLIMAP) THEN
+ELSE IF (HNAT=='GD' .AND. .NOT.GECOCLIMAP ) THEN
!
!* computes soil layers from vegetation fractions read in the file
!
- CALL READ_SURF(&
- HPROGRAM,'D_TYPE_HVEG',YHVEG,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'D_TYPE_LVEG',YLVEG,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'D_TYPE_NVEG',YNVEG,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'D_FRAC_HVEG',ZHVEG,IRESP,HDIR='A')
- CALL READ_SURF(&
- HPROGRAM,'D_FRAC_LVEG',ZLVEG,IRESP,HDIR='A')
- CALL READ_SURF(&
- HPROGRAM,'D_FRAC_NVEG',ZNVEG,IRESP,HDIR='A')
+ CALL READ_SURF(HFILEPGDTYPE,'D_TYPE_HVEG',YHVEG,IRESP,HDIR='E')
+ CALL READ_SURF(HFILEPGDTYPE,'D_TYPE_LVEG',YLVEG,IRESP,HDIR='E')
+ CALL READ_SURF(HFILEPGDTYPE,'D_TYPE_NVEG',YNVEG,IRESP,HDIR='E')
+ CALL READ_SURF(HFILEPGDTYPE,'D_FRAC_HVEG',ZHVEG,IRESP,HDIR='E')
+ CALL READ_SURF(HFILEPGDTYPE,'D_FRAC_LVEG',ZLVEG,IRESP,HDIR='E')
+ CALL READ_SURF(HFILEPGDTYPE,'D_FRAC_NVEG',ZNVEG,IRESP,HDIR='E')
! Ground layers
CALL GARDEN_SOIL_DEPTH(YNVEG,YLVEG,YHVEG,ZNVEG,ZLVEG,ZHVEG,PDEPTH)
!
+ELSEIF (HNAT=='GR' .AND. .NOT.GECOCLIMAP ) THEN
+! Depth of greenroof ground layers
+ PDEPTH(:, 1,:) = XGRID_SOIL(NGRID_LEVEL - 5)
+ PDEPTH(:, 2,:) = XGRID_SOIL(NGRID_LEVEL - 4)
+ PDEPTH(:, 3,:) = XGRID_SOIL(NGRID_LEVEL - 3)
+ PDEPTH(:, 4,:) = XGRID_SOIL(NGRID_LEVEL - 2)
+ PDEPTH(:, 5,:) = XGRID_SOIL(NGRID_LEVEL - 1)
+ PDEPTH(:, 6,:) = XGRID_SOIL(NGRID_LEVEL - 0)
END IF
!
- CALL CLOSE_AUX_IO_SURF(HFILE,HPROGRAM)
+CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+!
+IF (GECOCLIMAP .AND. .NOT.GREAD_OK ) THEN
+ !
+ IF (IVERSION>8 .OR. (IVERSION==8 .AND. IBUGFIX>=1)) THEN
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'FULL ')
+ CALL READ_SURF(HFILETYPE,'WRITE_EXT ',GREAD_EXT,IRESP,HDIR='-')
+ CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
+ ELSE
+ GREAD_EXT = .FALSE.
+ ENDIF
+ !
+ IF (GREAD_EXT) THEN
+ !
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,YSURF)
+ YRECFM='VERSION'
+ CALL READ_SURF(HFILETYPE,YRECFM,IVERSION,IRESP)
+ YRECFM='BUG'
+ CALL READ_SURF(HFILETYPE,YRECFM,IBUGFIX,IRESP)
+ GDIM = (IVERSION>8 .OR. IVERSION==8 .AND. IBUGFIX>0)
+ GDIM2 = GDIM
+ IF (GDIM) CALL READ_SURF(HFILETYPE,'SPLIT_PATCH',GDIM2,IRESP)
+ DO JL=1,KLAYER
+ WRITE(YLVL,'(I4)') JL
+ YRECFM='DG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ CALL MAKE_CHOICE_ARRAY(HFILETYPE, KPATCH, GDIM2, YRECFM, PDEPTH(:,JL,:),HDIR='E')
+ END DO
+ CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
+ !
+ ELSE
+ !
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'FULL ')
+ !
+ !* reading of the cover to obtain the depth of inter-layers
+ !
+ IF (GDIM.AND.GECOSG) THEN
+ ALLOCATE(GCOVER(SUM(NTYPE)))
+ ELSE
+ ALLOCATE(GCOVER(NCOVER))
+ ENDIF
+ !
+ YRECFMOLD='COVER_LIST'
+ CALL OLD_NAME(HFILEPGDTYPE,YRECFMOLD,YRECFM,HDIR='-')
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,GCOVER(:),IRESP,HDIR='-')
+ !
+ IF (NRANK==NPIO) THEN
+ ALLOCATE(ZCOVER(KNI,COUNT(GCOVER)))
+ ELSE
+ ALLOCATE(ZCOVER(0,0))
+ ENDIF
+ YRECFM='COVER'
+ CALL READ_SURF_COV(HFILEPGDTYPE,YRECFM,ZCOVER(:,:),GCOVER(:),IRESP,HDIR='E')
+ !
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ !
+ !* computes soil layers
+ !
+ !* permafrost distribution for soil depth
+ !
+ GPERM =.FALSE.
+ ZPERM(:)=0.0
+ !
+ IF (HNAT=='NAT'.AND.(IVERSION>7 .OR. (IVERSION==7 .AND. IBUGFIX>3)))THEN
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
+ YRECFM='PERMAFROST'
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,GPERM,IRESP,HDIR='-')
+ IF(GPERM)THEN
+ YRECFM='PERM'
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZPERM(:),IRESP,HDIR='E')
+ ENDIF
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ ENDIF
+ !
+ IF (SIZE(GCOVER)/=JPCOVER) THEN
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
+ CALL READ_PGD_COVER_GARDEN(HFILEPGDTYPE,GGARDEN)
+ CALL READ_ARRANGE_COVER(HFILEPGDTYPE,GWATER_TO_NATURE,GTOWN_TO_ROCK,'A')
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ ELSE
+ GGARDEN = .FALSE.
+ GWATER_TO_NATURE = .FALSE.
+ GTOWN_TO_ROCK = .FALSE.
+ ENDIF
+ !
+ IF (NRANK==NPIO) THEN
+ CALL CONVERT_COVER_ISBA(DTCO, IO%CALBEDO, &
+ HISBA,IO%LTR_ML,1,ZCOVER,GCOVER,' ',HNAT,PSOILGRID=PSOILGRID, &
+ PPERM=ZPERM,PDG=PDEPTH,KWG_LAYER=KWG_LAYER, &
+ OWATER_TO_NATURE=GWATER_TO_NATURE, OTOWN_TO_ROCK=GTOWN_TO_ROCK, &
+ OGARDEN=GGARDEN )
+ ENDIF
+ !
+ DEALLOCATE(GCOVER,ZCOVER)
+ !
+ ENDIF
+ !
+ENDIF
+!
+NVEGTYPE = INVEGTYPE_SAVE
+JPCOVER = IJPCOVER_SAVE
!-------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_EXTERN:READ_EXTERN_DEPTH',1,ZHOOK_HANDLE)
@@ -387,52 +434,46 @@ END SUBROUTINE READ_EXTERN_DEPTH
!---------------------------------------------------------------------------------------
!
! #######################
- SUBROUTINE READ_EXTERN_ISBA (U, &
- DTCO, I,GCP, &
+ SUBROUTINE READ_EXTERN_ISBA (U, DTCO, GCP, IO, &
HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,&
KLUOUT,KNI,HFIELD,HNAME,PFIELD,PDEPTH,OKEY)
! #######################
!
!
-!
-!
-!
-!
-!
+USE MODD_ISBA_n, ONLY : ISBA_NP_t, ISBA_K_t, ISBA_P_t, ISBA_NP_INIT, ISBA_K_INIT
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
+USE MODD_SURFEX_MPI, ONLY : NRANK
USE MODD_ISBA_PAR, ONLY : XOPTIMGRID
!
USE MODE_SOIL
-USE MODI_ISBA_SOC_PARAMETERS
USE MODI_READ_SURF
-USE MODI_READ_SURF_FIELD3D
+USE MODI_ISBA_SOC_PARAMETERS
+USE MODI_PACK_SAME_RANK
!
IMPLICIT NONE
!
!* dummy arguments
! ---------------
!
-!
-!
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(ISBA_t), INTENT(INOUT) :: I
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
- CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file
- CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! type of input file
- CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! name of file
- CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! type of input file
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+!
+CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file
+CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! type of input file
+CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! name of file
+CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! type of input file
INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
INTEGER, INTENT(IN) :: KNI ! number of points
- CHARACTER(LEN=7), INTENT(IN) :: HFIELD ! field name
- CHARACTER(LEN=*), INTENT(IN) :: HNAME ! field name in the file
+CHARACTER(LEN=7), INTENT(IN) :: HFIELD ! field name
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! field name in the file
REAL, DIMENSION(:,:,:), POINTER :: PFIELD ! field to initialize
REAL, DIMENSION(:,:,:), POINTER :: PDEPTH ! depth of each inter-layer
LOGICAL, OPTIONAL, INTENT(INOUT) :: OKEY
@@ -440,30 +481,37 @@ LOGICAL, OPTIONAL, INTENT(INOUT) :: OKEY
!
!* local variables
! ---------------
+!
+TYPE(ISBA_K_t) :: YK
+TYPE(ISBA_NP_t) :: YNP
+TYPE(ISBA_P_t), POINTER :: PK
!
CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=4) :: YLVL
- CHARACTER(LEN=3) :: YISBA ! type of ISBA soil scheme
#ifdef MNH_PARALLEL
CHARACTER(LEN=8) :: YPATCH
-#endif
- CHARACTER(LEN=3) :: YNAT ! type of surface (nature, garden)
+#endif
+ CHARACTER(LEN=4) :: YLVL
CHARACTER(LEN=4) :: YPEDOTF ! type of pedo-transfert function
+ CHARACTER(LEN=3) :: YISBA ! type of ISBA soil scheme
+ CHARACTER(LEN=3) :: YNAT ! type of surface (nature, garden)
+!
INTEGER :: IRESP ! reading return code
-INTEGER :: ILAYER ! number of layers
-INTEGER :: JLAYER ! loop counter
+INTEGER :: ILAYER, ILAYER_SAVE ! number of layers
+INTEGER :: JL ! loop counter
INTEGER :: IPATCH ! number of patch
-INTEGER :: JPATCH ! loop counter
+INTEGER :: JP ! loop counter
INTEGER :: JVEGTYPE ! loop counter
LOGICAL :: GTEB ! TEB field
+LOGICAL :: GGD
INTEGER :: IWORK ! work integer
INTEGER :: JI
!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK ! field read, one level, all patches
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZVAR ! profile of physical variable
-REAL, DIMENSION(:), ALLOCATABLE :: ZCLAY ! clay fraction
-REAL, DIMENSION(:), ALLOCATABLE :: ZSAND ! sand fraction
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCLAY ! clay fraction
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSAND ! sand fraction
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCONDSAT ! sand fraction
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZMPOTSAT ! sand fraction
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZBCOEF ! sand fraction
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSOC_GR ! sand fraction
REAL, DIMENSION(:), ALLOCATABLE :: ZSOILGRID
REAL, DIMENSION(:), ALLOCATABLE :: ZNAT ! natural surface fraction
!
@@ -471,26 +519,24 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZWWILT ! wilting point
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWFC ! field capacity
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWSAT ! saturation
REAL, DIMENSION(:,:), ALLOCATABLE :: ZPATCH
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZBCOEF
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZMPOTSAT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZHCAPSOIL
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZCONDDRY
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZCONDSLD
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZWD0
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZANISO
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZFRACSOC
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCONDSAT
!
REAL, DIMENSION(KNI,2) :: ZSOC
!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK, ZFRACSOC
INTEGER, DIMENSION(:,:), ALLOCATABLE :: IWG_LAYER
!
LOGICAL :: GTEMP_ARP ! Arpege soil temperature profile
LOGICAL :: GSOC_DATA ! Soil organic carbon (data in pgd)
LOGICAL :: GSOC ! Soil organic carbon (physical option)
!
+REAL, PARAMETER :: ZWSAT_OM = 0.9 ! Porosity of OM (m3/m3)
+REAL, PARAMETER :: ZMPOT_WWILT = -150. ! Matric potential at wilting point (m)
+REAL, PARAMETER :: ZHYDCOND_WFC = 1.157E-9 ! Hydraulic conductivity at field capacity (m/s)
+!
INTEGER :: IVERSION ! surface version
-INTEGER :: IBUGFIX
+INTEGER :: IBUGFIX, ISIZE
+LOGICAL :: GDIM, GDIM2
+LOGICAL :: GDATA_WSAT, GDATA_WWILT, GDATA_WFC, GDATA_CONDSAT, GDATA_MPOTSAT, GDATA_BCOEF, GCALC
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
@@ -502,6 +548,8 @@ WRITE (KLUOUT,*) ' | Reading ',HFIELD,' in externalized file'
!
GTEB = (HNAME(1:3)=='TWN' .OR. HNAME(1:3)=='GD_' .OR. HNAME(1:3)=='GR_' &
.OR. HNAME(4:6)=='GD_' .OR. HNAME(4:6)=='GR_')
+GGD = .FALSE.
+IF (GTEB) GGD = (HNAME(1:3)=='TWN' .OR. HNAME(1:3)=='GD_' .OR. HNAME(4:6)=='GD_')
!
GTEMP_ARP = .FALSE.
GSOC = .FALSE.
@@ -509,22 +557,19 @@ GSOC_DATA = .FALSE.
!
!------------------------------------------------------------------------------
!
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'FULL ')
+CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'FULL ')
YRECFM='VERSION'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,IVERSION,IRESP)
+CALL READ_SURF(HFILEPGDTYPE,YRECFM,IVERSION,IRESP,HDIR='-')
YRECFM='BUG'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,IBUGFIX,IRESP)
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+CALL READ_SURF(HFILEPGDTYPE,YRECFM,IBUGFIX,IRESP,HDIR='-')
+CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+GDIM = (IVERSION>8 .OR. IVERSION==8 .AND. IBUGFIX>0)
+
!
IF (GTEB) THEN
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'TOWN ')
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ')
ELSE
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'NATURE')
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
ENDIF
!
!* Read number of soil layers
@@ -532,18 +577,22 @@ ENDIF
YRECFM='GROUND_LAYER'
IF (GTEB) THEN
YRECFM='TWN_LAYER'
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_LAYER'
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
+ IF (GGD) THEN
+ YRECFM='GD_LAYER'
+ ELSE
+ YRECFM='GR_LAYER'
+ ENDIF
+ ENDIF
ENDIF
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,ILAYER,IRESP)
+CALL READ_SURF(HFILEPGDTYPE,YRECFM,ILAYER,IRESP,HDIR='-')
!
!* number of tiles
!
IPATCH=1
IF (.NOT. GTEB) THEN
YRECFM='PATCH_NUMBER'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,IPATCH,IRESP)
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP,HDIR='-')
END IF
!
!* soil scheme
@@ -551,10 +600,15 @@ END IF
YRECFM='ISBA'
IF (GTEB) THEN
YRECFM='TWN_ISBA'
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_ISBA'
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
+ IF (GGD) THEN
+ YRECFM='GD_ISBA'
+ ELSE
+ YRECFM='GR_ISBA'
+ ENDIF
+ ENDIF
ENDIF
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,YISBA,IRESP)
+CALL READ_SURF(HFILEPGDTYPE,YRECFM,YISBA,IRESP,HDIR='-')
IF(YISBA=='DIF'.AND.PRESENT(OKEY))THEN
OKEY=.FALSE.
ENDIF
@@ -568,8 +622,7 @@ IF (IVERSION>=7) THEN
YRECFM='TWN_PEDOTF'
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_PEDOTF'
ENDIF
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,YPEDOTF,IRESP)
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,YPEDOTF,IRESP,HDIR='-')
!
ELSE
YPEDOTF = 'CH78'
@@ -580,34 +633,141 @@ IF(YISBA/='DIF')THEN
YPEDOTF='CH78'
ENDIF
!
-!-------------------------------------------------------------------------------
-!
-! *. Read clay fraction
-! ------------------
-!
-ALLOCATE(ZCLAY(KNI))
-YRECFM='CLAY'
-IF (GTEB) THEN
- YRECFM='TWN_CLAY'
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_CLAY'
-ENDIF
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,ZCLAY(:),IRESP,HDIR='A')
-!
-!-------------------------------------------------------------------------------
-!
-! *. Read sand fraction
-! ------------------
-!
-ALLOCATE(ZSAND(KNI))
-YRECFM='SAND'
-IF (GTEB) THEN
- YRECFM='TWN_SAND'
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_SAND'
+IF (HFIELD=='WG ' .OR. HFIELD=='WGI ') THEN
+ !
+ ALLOCATE (ZWFC (KNI,ILAYER))
+ ALLOCATE (ZWWILT(KNI,ILAYER))
+ ALLOCATE (ZWSAT (KNI,ILAYER))
+ IF (GTEB.AND..NOT.GGD) THEN
+ ALLOCATE(ZBCOEF (KNI,ILAYER))
+ ALLOCATE(ZMPOTSAT(KNI,ILAYER))
+ ALLOCATE(ZCONDSAT(KNI,ILAYER))
+ ENDIF
+ !
+ IF (GDIM) THEN
+ YRECFM='L_WFC'
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,GDATA_WFC,IRESP,HDIR='E')
+ IF (GDATA_WFC) THEN
+ DO JL=1,ILAYER
+ WRITE(YRECFM,FMT='(A9,I2.2)') 'D_WFC_L',JL
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZWFC(:,JL),IRESP,HDIR='E')
+ ENDDO
+ ENDIF
+ YRECFM='L_WWILT'
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,GDATA_WWILT,IRESP,HDIR='E')
+ IF (GDATA_WWILT) THEN
+ DO JL=1,ILAYER
+ WRITE(YRECFM,FMT='(A9,I2.2)') 'D_WWILT_L',JL
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZWWILT(:,JL),IRESP,HDIR='E')
+ ENDDO
+ ENDIF
+ YRECFM='L_WSAT'
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,GDATA_WSAT,IRESP,HDIR='E')
+ IF (GDATA_WSAT) THEN
+ DO JL=1,ILAYER
+ WRITE(YRECFM,FMT='(A9,I2.2)') 'D_WSAT_L',JL
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZWSAT(:,JL),IRESP,HDIR='E')
+ ENDDO
+ ENDIF
+ IF (GTEB.AND..NOT.GGD) THEN
+ YRECFM='L_CONDSAT'
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,GDATA_CONDSAT,IRESP,HDIR='E')
+ IF (GDATA_CONDSAT) THEN
+ DO JL=1,ILAYER
+ WRITE(YRECFM,FMT='(A9,I2.2)') 'D_CNDSAT_L',JL
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZCONDSAT(:,JL),IRESP,HDIR='E')
+ ENDDO
+ ENDIF
+ YRECFM='L_MPOTSAT'
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,GDATA_MPOTSAT,IRESP,HDIR='E')
+ IF (GDATA_MPOTSAT) THEN
+ DO JL=1,ILAYER
+ WRITE(YRECFM,FMT='(A9,I2.2)') 'D_MPTSAT_L',JL
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZMPOTSAT(:,JL),IRESP,HDIR='E')
+ ENDDO
+ ENDIF
+ YRECFM='L_BCOEF'
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,GDATA_BCOEF,IRESP,HDIR='E')
+ IF (GDATA_BCOEF) THEN
+ DO JL=1,ILAYER
+ WRITE(YRECFM,FMT='(A9,I2.2)') 'D_BCOEF_L',JL
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZBCOEF(:,JL),IRESP,HDIR='E')
+ ENDDO
+ ENDIF
+ ENDIF
+ ELSE
+ GDATA_WWILT = .FALSE.
+ GDATA_WFC = .FALSE.
+ GDATA_WSAT = .FALSE.
+ GDATA_CONDSAT = .FALSE.
+ GDATA_MPOTSAT = .FALSE.
+ GDATA_BCOEF = .FALSE.
+ ENDIF
+ !
+ GCALC = .FALSE.
+ IF (.NOT.(GDATA_WWILT.AND.GDATA_WFC.AND.GDATA_WSAT)) THEN
+ IF ((.NOT.GTEB.OR.GGD).OR..NOT.(GDATA_CONDSAT.AND.GDATA_MPOTSAT.AND.GDATA_BCOEF)) GCALC = .TRUE.
+ ENDIF
+ !
+ IF (GCALC) THEN
+ !
+ !-------------------------------------------------------------------------------
+ !
+ ! *. Read clay fraction
+ ! ------------------
+ !
+ ALLOCATE(ZCLAY(KNI,ILAYER))
+ YRECFM='CLAY'
+ IF (GTEB) THEN
+ YRECFM='TWN_CLAY'
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_CLAY'
+ ENDIF
+ IF (.NOT.GTEB.OR.GGD) THEN
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZCLAY(:,1),IRESP,HDIR='E')
+ DO JL=2,ILAYER
+ ZCLAY(:,JL) = ZCLAY(:,1)
+ ENDDO
+ ELSE
+ DO JL=1,ILAYER
+ WRITE(YRECFM,FMT='(A9,I2.2)') 'D_CLAY_GR',JL
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZCLAY(:,JL),IRESP,HDIR='E')
+ ENDDO
+ ENDIF
+ !
+ !-------------------------------------------------------------------------------
+ !
+ ! *. Read sand fraction
+ ! ------------------
+ !
+ ALLOCATE(ZSAND(KNI,ILAYER))
+ YRECFM='SAND'
+ IF (GTEB) THEN
+ YRECFM='TWN_SAND'
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_SAND'
+ ENDIF
+ IF (.NOT.GTEB.OR.GGD) THEN
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZSAND(:,1),IRESP,HDIR='E')
+ DO JL=2,ILAYER
+ ZSAND(:,JL) = ZSAND(:,1)
+ ENDDO
+ ELSE
+ DO JL=1,ILAYER
+ WRITE(YRECFM,FMT='(A9,I2.2)') 'D_SAND_GR',JL
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZSAND(:,JL),IRESP,HDIR='E')
+ ENDDO
+ ENDIF
+ !
+ IF (GTEB.AND..NOT.GGD) THEN
+ ALLOCATE(ZSOC_GR(KNI,ILAYER))
+ DO JL=1,ILAYER
+ WRITE(YRECFM,FMT='(A7,I2.2)') 'D_OM_GR',JL
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZSOC_GR(:,JL),IRESP,HDIR='E')
+ ENDDO
+ ENDIF
+ !
+ ENDIF
+ !
ENDIF
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,ZSAND(:),IRESP,HDIR='A')
-!
!-------------------------------------------------------------------------------
!
!
@@ -617,15 +777,12 @@ ENDIF
IF ( (.NOT.GTEB).AND.(IVERSION>7.OR.(IVERSION==7.AND.IBUGFIX>3)) &
.AND.(YISBA=='DIF').AND.(HFIELD=='WG '.OR.HFIELD=='WGI ') ) THEN
YRECFM='SOCP'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,GSOC_DATA,IRESP)
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,GSOC_DATA,IRESP)
IF(GSOC_DATA)THEN
YRECFM='SOC_TOP'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,ZSOC(:,1),IRESP,HDIR='A')
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZSOC(:,1),IRESP,HDIR='E')
YRECFM='SOC_SUB'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,ZSOC(:,2),IRESP,HDIR='A')
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZSOC(:,2),IRESP,HDIR='E')
WHERE(ZSOC(:,:)==XUNDEF)ZSOC(:,:)=0.0
ENDIF
ENDIF
@@ -640,24 +797,26 @@ ENDIF
IF(YISBA=='DIF') THEN
ALLOCATE(ZSOILGRID(ILAYER))
ZSOILGRID=XUNDEF
- IF (IVERSION>=8) THEN
- DO JLAYER=1,ILAYER
- WRITE(YLVL,'(I4)') JLAYER
+ IF (.NOT.GTEB.OR.GGD) THEN
+ IF (IVERSION>=8) THEN
+ DO JL=1,ILAYER
+ WRITE(YLVL,'(I4)') JL
YRECFM='SOILGRID'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
IF (GTEB) THEN
- YRECFM='GD_SGRID'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YRECFM='GD_SGRID'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
ENDIF
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,ZSOILGRID(JLAYER),IRESP)
- ENDDO
- ELSEIF (IVERSION==7 .AND. IBUGFIX>=2) THEN
- YRECFM='SOILGRID'
- IF (GTEB) THEN
- YRECFM='TWN_SOILGRID'
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_SOILGRID'
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZSOILGRID(JL),IRESP,HDIR='A')
+ ENDDO
+ ELSEIF (IVERSION==7 .AND. IBUGFIX>=2.AND.GGD) THEN
+ YRECFM='SOILGRID'
+ IF (GTEB) THEN
+ YRECFM='TWN_SOILGRID'
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_SOILGRID'
+ ENDIF
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZSOILGRID,IRESP,HDIR='A')
+ ELSE
+ ZSOILGRID(1:ILAYER) = XOPTIMGRID(1:ILAYER)
ENDIF
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,ZSOILGRID,IRESP,HDIR='-')
ELSE
ZSOILGRID(1:ILAYER) = XOPTIMGRID(1:ILAYER)
ENDIF
@@ -674,32 +833,32 @@ IWG_LAYER(:,:) = NUNDEF
ALLOCATE(ZNAT(KNI))
IF (IVERSION>=7) THEN
IF (GTEB) THEN
- CALL READ_SURF(HFILEPGDTYPE,'FRAC_TOWN',ZNAT,IRESP,HDIR='A')
+ CALL READ_SURF(HFILEPGDTYPE,'FRAC_TOWN',ZNAT,IRESP,HDIR='E')
ELSE
- CALL READ_SURF(HFILEPGDTYPE,'FRAC_NATURE',ZNAT,IRESP,HDIR='A')
+ CALL READ_SURF(HFILEPGDTYPE,'FRAC_NATURE',ZNAT,IRESP,HDIR='E')
ENDIF
ELSE
ZNAT=1.0
ENDIF
!
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+!
+CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+!
!
IF (.NOT.GTEB .AND. HFIELD=='TG ' .AND. (YISBA=='2-L' .OR. YISBA=='3-L') ) THEN
- IF (IVERSION>7) THEN
+ IF (IVERSION>7) THEN
YRECFM='TEMPARP'
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'NATURE')
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,GTEMP_ARP,IRESP)
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
+ CALL READ_SURF(HFILETYPE,YRECFM,GTEMP_ARP,IRESP,HDIR='-')
IF(GTEMP_ARP)THEN
YRECFM = 'NTEMPLARP'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,ILAYER,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,ILAYER,IRESP,HDIR='-')
ENDIF
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
ENDIF
ENDIF
!
+!
IF ((HFIELD=='TG ') .AND. (YISBA=='2-L' .OR. YISBA=='3-L')) THEN
ALLOCATE(PDEPTH (KNI,ILAYER,NVEGTYPE))
DO JVEGTYPE=1,NVEGTYPE
@@ -709,196 +868,241 @@ IF ((HFIELD=='TG ') .AND. (YISBA=='2-L' .OR. YISBA=='3-L')) THEN
! GTEMP_ARP case
IF (GTEMP_ARP) THEN
PDEPTH(:,3,JVEGTYPE) = 1.0
- DO JLAYER=4,ILAYER
- PDEPTH(:,JLAYER,JVEGTYPE) = PDEPTH(:,JLAYER-1,JVEGTYPE)+1.
+ DO JL=4,ILAYER
+ PDEPTH(:,JL,JVEGTYPE) = PDEPTH(:,JL-1,JVEGTYPE)+1.
ENDDO
ENDIF
END DO
ELSE
YNAT='NAT'
- IF (GTEB) YNAT='GRD'
- CALL READ_EXTERN_DEPTH(U, &
- DTCO, I,GCP, &
- HFILEPGD,HFILEPGDTYPE,KLUOUT,YISBA,YNAT,HFIELD,KNI, &
+ IF (GTEB) THEN
+ IF (GGD) THEN
+ YNAT='GD'
+ ELSE
+ YNAT='GR'
+ ENDIF
+ ENDIF
+ !
+ CALL READ_EXTERN_DEPTH(U, DTCO, GCP, IO, &
+ HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE, &
+ KLUOUT,YISBA,YNAT,HFIELD,KNI, &
ILAYER,IPATCH,ZSOILGRID,PDEPTH,IVERSION,IWG_LAYER)
+ !
END IF
!
DEALLOCATE(ZSOILGRID)
!
!
-!* Allocate soil variable profile
-! ------------------------------
-!
-!
-ALLOCATE(ZVAR(KNI,ILAYER,IPATCH))
-ALLOCATE(ZWORK(KNI,IPATCH))
-ZWORK(:,: ) = XUNDEF
-ZVAR (:,:,:) = 0.0
-!
! *. Read soil variable profile
! --------------------------
!
IF (GTEB) THEN
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'TOWN ')
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ')
ELSE
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'NATURE')
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
ENDIF
!
+YRECFM='VERSION'
+ CALL READ_SURF(HFILETYPE,YRECFM,IVERSION,IRESP)
+YRECFM='BUG'
+ CALL READ_SURF(HFILETYPE,YRECFM,IBUGFIX,IRESP)
+GDIM = (IVERSION>8 .OR. IVERSION==8 .AND. IBUGFIX>0)
+GDIM2 = GDIM
+IF (GDIM) CALL READ_SURF(HFILETYPE,'SPLIT_PATCH',GDIM2,IRESP)
+!
IWORK=ILAYER
IF(YISBA=='2-L'.OR.YISBA=='3-L') THEN
SELECT CASE(HFIELD)
- CASE('TG ')
- IF(GTEMP_ARP)THEN
- IWORK=ILAYER
- ELSE
- IWORK=2
- ENDIF
- CASE('WGI ')
- IWORK=2
+ CASE('TG ')
+ IF(GTEMP_ARP)THEN
+ IWORK=ILAYER
+ ELSE
+ IWORK=2
+ ENDIF
+ CASE('WGI ')
+ IWORK=2
END SELECT
ENDIF
!
-YRECFM=TRIM(HNAME)
- CALL READ_SURF_FIELD3D(HFILETYPE,ZVAR,1,IWORK,YRECFM,HDIR='A')
-DO JI=1,KNI
- IF (ZNAT(JI)==0.) ZVAR(JI,:,:) = XUNDEF
+ALLOCATE(PFIELD(KNI,ILAYER,IPATCH))
+!
+DO JL=1,IWORK
+ WRITE(YLVL,'(I4)') JL
+ YRECFM=TRIM(HNAME)//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ IF (GTEB) THEN
+ CALL MAKE_CHOICE_ARRAY(HFILETYPE, IPATCH, GDIM2, YRECFM, PFIELD(:,JL,:),HDIR='E',KPATCH=0)
+ ELSE
+ CALL MAKE_CHOICE_ARRAY(HFILETYPE, IPATCH, GDIM2, YRECFM, PFIELD(:,JL,:),HDIR='E')
+ ENDIF
+END DO
+!
+DO JP=1,IPATCH
+ DO JL=1,IWORK
+ WHERE (ZNAT(:)==0.) PFIELD(:,JL,JP) = XUNDEF
+ ENDDO
END DO
!
DEALLOCATE (ZNAT)
!
IF(YISBA=='3-L') THEN
SELECT CASE(HFIELD)
- CASE('TG ')
- IF(.NOT.GTEMP_ARP)ZVAR(:,3,:)=ZVAR(:,2,:)
- CASE('WGI ')
- ZVAR(:,3,:)=ZVAR(:,2,:)
+ CASE('TG ')
+ IF(.NOT.GTEMP_ARP)PFIELD(:,3,:)=PFIELD(:,2,:)
+ CASE('WGI ')
+ PFIELD(:,3,:)=PFIELD(:,2,:)
END SELECT
ENDIF
!
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
!
-DEALLOCATE(ZWORK)
-!
!
! *. Compute relative humidity from units kg/m^2 (SWI)
! ------------------------------------------------
!
-ALLOCATE(PFIELD(KNI,ILAYER,IPATCH))
-!
-PFIELD(:,:,:) = ZVAR(:,:,:)
-!
IF (HFIELD=='WG ' .OR. HFIELD=='WGI ') THEN
!
- ! Compute ISBA model constants
- !
- ALLOCATE (ZWFC (KNI,ILAYER))
- ALLOCATE (ZWWILT(KNI,ILAYER))
- ALLOCATE (ZWSAT (KNI,ILAYER))
- !
- ZWSAT (:,1) = WSAT_FUNC (ZCLAY(:),ZSAND(:),YPEDOTF)
- ZWWILT(:,1) = WWILT_FUNC(ZCLAY(:),ZSAND(:),YPEDOTF)
- IF(YISBA=='DIF')THEN
- ZWFC(:,1) = W33_FUNC(ZCLAY(:),ZSAND(:),YPEDOTF)
- ELSE
- ZWFC(:,1) = WFC_FUNC(ZCLAY(:),ZSAND(:),YPEDOTF)
- ENDIF
- DO JLAYER=2,ILAYER
- ZWSAT (:,JLAYER) = ZWSAT (:,1)
- ZWFC (:,JLAYER) = ZWFC (:,1)
- ZWWILT(:,JLAYER) = ZWWILT(:,1)
- ENDDO
- !
- DEALLOCATE (ZSAND)
- DEALLOCATE (ZCLAY)
- !
- IF(GSOC_DATA)THEN
- !
- ALLOCATE(ZPATCH(KNI,IPATCH))
- !
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'NATURE')
- YRECFM='SOC'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,GSOC,IRESP)
- YRECFM='PATCH'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,ZPATCH(:,:),IRESP,HDIR='A')
- WHERE(ZPATCH(:,:)==XUNDEF)ZPATCH(:,:)=0.0
- CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
- !
- IF(GSOC)THEN
- ALLOCATE(ZBCOEF (KNI,ILAYER))
- ALLOCATE(ZMPOTSAT (KNI,ILAYER))
- ALLOCATE(ZHCAPSOIL(KNI,ILAYER))
- ALLOCATE(ZCONDDRY (KNI,ILAYER))
- ALLOCATE(ZCONDSLD (KNI,ILAYER))
- ALLOCATE(ZWD0 (KNI,ILAYER))
- ALLOCATE(ZANISO (KNI,ILAYER))
- ALLOCATE(ZFRACSOC (KNI,ILAYER))
- ALLOCATE(ZCONDSAT (KNI,ILAYER,IPATCH))
- ZBCOEF (:,:)=0.0
- ZMPOTSAT (:,:)=0.0
- ZHCAPSOIL(:,:)=0.0
- ZCONDDRY (:,:)=XUNDEF
- ZCONDSLD (:,:)=XUNDEF
- ZWD0 (:,:)=0.0
- ZANISO (:,:)=0.0
- ZFRACSOC (:,:)=0.0
- ZCONDSAT (:,:,:)=0.0
- CALL ISBA_SOC_PARAMETERS ('NONE' ,ZPATCH,PDEPTH,ZSOC,ZBCOEF,ZMPOTSAT,&
- ZCONDSAT,ZWSAT,ZHCAPSOIL,ZCONDDRY,ZCONDSLD,&
- ZWFC,ZWWILT,ZWD0,ZANISO,ZFRACSOC )
- DEALLOCATE(ZBCOEF)
- DEALLOCATE(ZMPOTSAT)
- DEALLOCATE(ZCONDSAT)
- DEALLOCATE(ZHCAPSOIL)
- DEALLOCATE(ZCONDDRY)
- DEALLOCATE(ZCONDSLD)
- DEALLOCATE(ZWD0)
- DEALLOCATE(ZANISO)
- DEALLOCATE(ZFRACSOC)
+ IF (GCALC) THEN
+ !
+ ! Compute ISBA model constants
+ !
+ DO JL=1,ILAYER
+ ZWSAT (:,JL) = WSAT_FUNC (ZCLAY(:,JL),ZSAND(:,JL),YPEDOTF)
+ ZWWILT(:,JL) = WWILT_FUNC(ZCLAY(:,JL),ZSAND(:,JL),YPEDOTF)
+ IF(YISBA=='DIF')THEN
+ ZWFC(:,JL) = W33_FUNC(ZCLAY(:,JL),ZSAND(:,JL),YPEDOTF)
+ ELSE
+ ZWFC(:,JL) = WFC_FUNC(ZCLAY(:,JL),ZSAND(:,JL),YPEDOTF)
+ ENDIF
+ ENDDO
+ !
+ IF (GTEB.AND..NOT.GGD) THEN
+ !
+ DO JL=1,ILAYER
+ ZBCOEF (:,JL) = BCOEF_FUNC (ZCLAY(:,JL),ZSAND(:,JL),YPEDOTF)
+ ZCONDSAT(:,JL) = HYDCONDSAT_FUNC(ZCLAY(:,JL),ZSAND(:,JL),YPEDOTF)
+ ZMPOTSAT(:,JL) = MATPOTSAT_FUNC (ZCLAY(:,JL),ZSAND(:,JL),YPEDOTF)
+
+ WHERE (ZWSAT(:,JL)/=XUNDEF)
+ ZWSAT (:,JL) = ZSOC_GR(:,JL)* ZWSAT_OM +(1-ZSOC_GR(:,JL))* ZWSAT(:,JL)
+ ZWWILT(:,JL) = EXP(((LOG(-1*ZMPOT_WWILT)-LOG(-1*ZMPOTSAT(:,JL))) &
+ / (-1*ZBCOEF(:,JL)))+LOG(ZWSAT(:,JL)))
+ ZWFC (:,JL) = EXP(((LOG(ZHYDCOND_WFC)-LOG(ZCONDSAT(:,JL))) &
+ / (2*ZBCOEF(:,JL)+3))+LOG(ZWSAT(:,JL)))
+ END WHERE
+ END DO
+ DEALLOCATE(ZBCOEF,ZMPOTSAT,ZCONDSAT)
+ !
+ ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ ! Validation case : experimental values for Nancy 2011 case
+ ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ ! Substrate layer
+ DO JL=1,4
+ ZWSAT (:,JL) = 0.674 ! Value tested
+ ZWWILT (:,JL) = 0.15 ! from OBS-NANCY
+ ZWFC (:,JL) = 0.37 ! from OBS-NANCY
+ ENDDO
+ ! Drainage layer
+ DO JL=5,6
+ ZWSAT (:,JL) = 0.9 ! Value tested
+ ZWWILT (:,JL) = 0.15 ! sert à initialiser le WG ds la couche
+ ZWFC (:,JL) = 0.37 ! sert à initialiser le WG ds la couche
+ ENDDO
+
ENDIF
!
- DEALLOCATE(ZPATCH)
+ DEALLOCATE (ZSAND)
+ DEALLOCATE (ZCLAY)
+ !
+ IF(GSOC_DATA)THEN
+ !
+ ALLOCATE(ZWORK(KNI,IPATCH))
+ !
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
+ !
+ YRECFM='SOC'
+ CALL READ_SURF(HFILETYPE,YRECFM,GSOC,IRESP,HDIR='-')
+ YRECFM='PATCH'
+ CALL MAKE_CHOICE_ARRAY(HFILETYPE, IPATCH, GDIM2, YRECFM, ZWORK,HDIR='E')
+ WHERE(ZWORK(:,:)==XUNDEF)ZWORK(:,:)=0.0
+ CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
+ !
+ IF(GSOC)THEN
+ !
+ ALLOCATE(YNP%AL(IPATCH))
+ DO JP = 1,IPATCH
+ PK => YNP%AL(JP)
+ PK%NSIZE_P = KNI
+ ALLOCATE(PK%NR_P(KNI))
+ DO JI = 1,KNI
+ PK%NR_P(JI) = JI
+ ENDDO
+ ALLOCATE(PK%XPATCH(KNI))
+ PK%XPATCH = ZWORK(:,JP)
+ ALLOCATE(PK%XDG(KNI,ILAYER))
+ PK%XDG(:,:) = PDEPTH(:,:,JP)
+ ALLOCATE(PK%XCONDSAT(KNI,ILAYER))
+ PK%XCONDSAT(:,:) = 0.0
+ ENDDO
+ ALLOCATE(YK%XBCOEF (KNI,ILAYER))
+ ALLOCATE(YK%XMPOTSAT (KNI,ILAYER))
+ ALLOCATE(YK%XHCAPSOIL(KNI,ILAYER))
+ ALLOCATE(YK%XCONDDRY (KNI,ILAYER))
+ ALLOCATE(YK%XCONDSLD (KNI,ILAYER))
+ ALLOCATE(YK%XWD0 (KNI,ILAYER))
+ ALLOCATE(YK%XKANISO (KNI,ILAYER))
+ ALLOCATE(ZFRACSOC (KNI,ILAYER))
+ YK%XBCOEF (:,:)=0.0
+ YK%XMPOTSAT (:,:)=0.0
+ YK%XHCAPSOIL(:,:)=0.0
+ YK%XCONDDRY (:,:)=XUNDEF
+ YK%XCONDSLD (:,:)=XUNDEF
+ YK%XWD0 (:,:)=0.0
+ YK%XKANISO (:,:)=0.0
+ ZFRACSOC (:,:)=0.0
+ CALL ISBA_SOC_PARAMETERS ('NONE', ZSOC, YK, YNP, ZFRACSOC, &
+ ZWSAT, ZWFC, ZWWILT, IPATCH)
+ CALL ISBA_K_INIT(YK)
+ CALL ISBA_NP_INIT(YNP,IPATCH)
+ !
+ ENDIF
+ !
+ ENDIF
!
ENDIF
!
- PFIELD(:,:,:) = XUNDEF
- !
IF(YISBA=='DIF')THEN
- !
- ! extrapolation of deep layers
- DO JPATCH=1,IPATCH
- DO JI=1,KNI
- IWORK=IWG_LAYER(JI,JPATCH)
- IF(IWORK<ILAYER)THEN
- DO JLAYER=IWORK+1,ILAYER
- ZVAR(JI,JLAYER,JPATCH)=ZVAR(JI,IWORK,JPATCH)
- ENDDO
- ENDIF
+ !
+ ! extrapolation of deep layers
+ DO JP=1,IPATCH
+ DO JI=1,KNI
+ IWORK=IWG_LAYER(JI,JP)
+ IF(IWORK<ILAYER)THEN
+ DO JL=IWORK+1,ILAYER
+ PFIELD(JI,JL,JP)=PFIELD(JI,IWORK,JP)
+ ENDDO
+ ENDIF
ENDDO
ENDDO
ENDIF
!
IF (HFIELD=='WG ') THEN
- DO JPATCH=1,IPATCH
- DO JLAYER=1,ILAYER
- DO JI=1,KNI
- IF(ZVAR(JI,JLAYER,JPATCH)/=XUNDEF)THEN
- ZVAR(JI,JLAYER,JPATCH) = MAX(MIN(ZVAR(JI,JLAYER,JPATCH),ZWSAT(JI,JLAYER)),0.)
- !
- PFIELD(JI,JLAYER,JPATCH) = (ZVAR(JI,JLAYER,JPATCH) - ZWWILT(JI,JLAYER)) / (ZWFC(JI,JLAYER) - ZWWILT(JI,JLAYER))
- ENDIF
- END DO
+ DO JP=1,IPATCH
+ DO JL=1,ILAYER
+ DO JI=1,KNI
+ IF(PFIELD(JI,JL,JP)/=XUNDEF)THEN
+ PFIELD(JI,JL,JP) = MAX(MIN(PFIELD(JI,JL,JP),ZWSAT(JI,JL)),0.)
+ !
+ PFIELD(JI,JL,JP) = (PFIELD(JI,JL,JP) - ZWWILT(JI,JL)) / &
+ (ZWFC(JI,JL) - ZWWILT(JI,JL))
+ ENDIF
+ END DO
END DO
END DO
ELSE IF (HFIELD=='WGI ') THEN
- DO JPATCH=1,IPATCH
- DO JLAYER=1,ILAYER
- WHERE(ZVAR(:,JLAYER,JPATCH)/=XUNDEF)
- PFIELD(:,JLAYER,JPATCH) = ZVAR(:,JLAYER,JPATCH) / ZWSAT(:,JLAYER)
+ DO JP=1,IPATCH
+ DO JL=1,ILAYER
+ WHERE(PFIELD(:,JL,JP)/=XUNDEF)
+ PFIELD(:,JL,JP) = PFIELD(:,JL,JP) / ZWSAT(:,JL)
END WHERE
END DO
END DO
@@ -910,7 +1114,6 @@ IF (HFIELD=='WG ' .OR. HFIELD=='WGI ') THEN
!
END IF
!
-DEALLOCATE(ZVAR)
DEALLOCATE(IWG_LAYER)
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/mode_read_grib.F90 b/src/SURFEX/mode_read_grib.F90
index 99a2bacd4b7abf9f6eb26fa4ad6245a43743e435..7594cbfc1e5d516243e7e3fcac82a8896e8c977d 100644
--- a/src/SURFEX/mode_read_grib.F90
+++ b/src/SURFEX/mode_read_grib.F90
@@ -13,7 +13,7 @@ USE GRIB_API
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------
! ####################
SUBROUTINE MAKE_GRIB_INDEX(HGRIB)
@@ -33,7 +33,7 @@ IF (LHOOK) CALL DR_HOOK('MODE_READ_GRIB:MAKE_GRIB_INDEX',0,ZHOOK_HANDLE)
IF (CGRIB_FILE==HGRIB) CALL DR_HOOK('MODE_READ_GRIB:MAKE_GRIB_INDEX',1,ZHOOK_HANDLE)
IF (CGRIB_FILE==HGRIB) RETURN
!
- CGRIB_FILE=HGRIB
+CGRIB_FILE=HGRIB
!
CALL GRIB_INDEX_CREATE(NIDX,HGRIB,'indicatorOfParameter',IRET)
IF (IRET/=0) CALL ABOR1_SFX("MODE_READ_GRIB:MAKE_GRIB_INDEX: error while creating the grib index")
@@ -136,7 +136,7 @@ ENDDO
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_GRIB:GET_GRIB_MESSAGE',1,ZHOOK_HANDLE)
!
- CONTAINS
+CONTAINS
!
! ##############
SUBROUTINE TEST_IRET(KLUOUT,VAL1,VAL0,KRET)
@@ -259,9 +259,9 @@ END SUBROUTINE READ_GRIB
!
IMPLICIT NONE
!
- CHARACTER(LEN=*), INTENT(IN) :: HGRIB ! Grib file name
+CHARACTER(LEN=*), INTENT(IN) :: HGRIB ! Grib file name
INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
- CHARACTER(LEN=6), INTENT(IN) :: HINMODEL ! Grib originating model
+CHARACTER(LEN=6), INTENT(IN) :: HINMODEL ! Grib originating model
REAL, DIMENSION(:), POINTER :: PMASK ! Land mask
!
INTEGER(KIND=kindOfInt) :: IRET ! return code
@@ -379,11 +379,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('MODE_READ_GRIB:READ_GRIB_ZS_SEA',0,ZHOOK_HANDLE)
!
-IF (HINMODEL=='HIRLAM') THEN
- CALL ABOR1_SFX('MODE_READ_GRIB:READ_GRIB_ZS_SEA:OPTION NOT SUPPORTED '//HINMODEL)
-ELSE
CALL READ_GRIB_ZS(HGRIB,KLUOUT,HINMODEL,PZSS)
-ENDIF
!
IF (SIZE(PMASK)==SIZE(PZSS)) &
WHERE (PMASK(:)/=0.) PZSS = 0.
@@ -465,8 +461,7 @@ IF (LHOOK) CALL DR_HOOK('MODE_READ_GRIB:READ_GRIB_TS',0,ZHOOK_HANDLE)
!
CALL READ_GRIB_T(HGRIB,KLUOUT,HINMODEL,PTS)
!
-IF (SIZE(PMASK)==SIZE(PTS)) &
- WHERE (PMASK(:)/=1.) PTS = XUNDEF
+IF (SIZE(PMASK)==SIZE(PTS)) WHERE (PMASK(:)/=1.) PTS = XUNDEF
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_GRIB:READ_GRIB_TS',1,ZHOOK_HANDLE)
END SUBROUTINE READ_GRIB_TS
@@ -485,22 +480,60 @@ INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
REAL, DIMENSION(:), INTENT(IN) :: PMASK ! grib land mask
REAL, DIMENSION(:), POINTER :: PSST !
!
+INTEGER :: IRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('MODE_READ_GRIB:READ_GRIB_SST',0,ZHOOK_HANDLE)
!
-IF (HINMODEL=='HIRLAM') THEN
- CALL ABOR1_SFX('MODE_READ_GRIB:READ_GRIB_SST:OPTION NOT SUPPORTED '//HINMODEL)
-ELSE
- CALL READ_GRIB_T(HGRIB,KLUOUT,HINMODEL,PSST)
-ENDIF
+SELECT CASE (HINMODEL)
+ CASE ('ECMWF ')
+ CALL READ_GRIB(HGRIB,KLUOUT,34,IRET,PSST)
+ IF (IRET /= 0) CALL READ_GRIB_T(HGRIB,KLUOUT,HINMODEL,PSST)
+ CASE ('ARPEGE','ALADIN','MOCAGE','HIRLAM')
+ CALL READ_GRIB_T(HGRIB,KLUOUT,HINMODEL,PSST)
+ CASE DEFAULT
+ CALL ABOR1_SFX('MODE_READ_GRIB:READ_GRIB_SST:OPTION NOT SUPPORTED '//HINMODEL)
+END SELECT
!
-IF (SIZE(PMASK)==SIZE(PSST)) &
- WHERE (PMASK(:)/=0.) PSST = XUNDEF
+IF (SIZE(PMASK)==SIZE(PSST)) WHERE (PMASK(:)/=0.) PSST = XUNDEF
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_GRIB:READ_GRIB_SST',1,ZHOOK_HANDLE)
END SUBROUTINE READ_GRIB_SST
!-------------------------------------------------------------------
+! ###########################
+ SUBROUTINE READ_GRIB_TSWATER(HGRIB,KLUOUT,HINMODEL,PMASK,PTS)
+! ###########################
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+IMPLICIT NONE
+!
+ CHARACTER(LEN=*), INTENT(IN) :: HGRIB ! Grib file name
+INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
+ CHARACTER(LEN=6), INTENT(IN) :: HINMODEL ! Grib originating model
+REAL, DIMENSION(:), INTENT(IN) :: PMASK ! grib land mask
+REAL, DIMENSION(:), POINTER :: PTS !
+!
+INTEGER :: IRET
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('MODE_READ_GRIB:READ_GRIB_TSWATER',0,ZHOOK_HANDLE)
+!
+SELECT CASE (HINMODEL)
+ CASE ('ECMWF ')
+ CALL READ_GRIB(HGRIB,KLUOUT,3080,IRET,PTS)
+ IF (IRET /= 0) CALL READ_GRIB_T2(HGRIB,KLUOUT,HINMODEL,PMASK,PTS)
+ CASE ('ARPEGE','ALADIN','MOCAGE','HIRLAM')
+ CALL READ_GRIB_T2(HGRIB,KLUOUT,HINMODEL,PMASK,PTS)
+ CASE DEFAULT
+ CALL ABOR1_SFX('MODE_READ_GRIB:READ_GRIB_TSWATER:OPTION NOT SUPPORTED '//HINMODEL)
+END SELECT
+!
+IF (SIZE(PMASK)==SIZE(PTS)) WHERE (PMASK(:)/=0.) PTS = XUNDEF
+!
+IF (LHOOK) CALL DR_HOOK('MODE_READ_GRIB:READ_GRIB_TSWATER',1,ZHOOK_HANDLE)
+END SUBROUTINE READ_GRIB_TSWATER
+!-------------------------------------------------------------------
! ###########################
SUBROUTINE READ_GRIB_T2(HGRIB,KLUOUT,HINMODEL,PMASK,PT2)
! ###########################
@@ -516,7 +549,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PMASK ! grib land mask
REAL, DIMENSION(:), POINTER :: PT2 !
!
INTEGER(KIND=kindOfInt) :: IRET
-INTEGER :: ILTYPE ! type of level (Grib code table 3)
+INTEGER :: ILTYPE, ILEV ! type of level (Grib code table 3)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------
!* Read deep soil temperature
@@ -532,7 +565,11 @@ SELECT CASE (HINMODEL)
IF (IRET /= 0) THEN
ILTYPE=105
CALL READ_GRIB(HGRIB,KLUOUT,11,IRET,PT2,KLTYPE=ILTYPE)
- ENDIF
+ ENDIF
+ CASE ('HIRLAM ')
+ ILTYPE=105
+ ILEV=954
+ CALL READ_GRIB(HGRIB,KLUOUT,11,IRET,PT2,KLTYPE=ILTYPE,KLEV1=ILEV)
CASE DEFAULT
CALL ABOR1_SFX('MODE_READ_GRIB:READ_GRIB_T2:OPTION NOT SUPPORTED '//HINMODEL)
END SELECT
@@ -541,13 +578,37 @@ IF (IRET /= 0) THEN
CALL ABOR1_SFX('MODE_READ_GRIB: DEEP SOIL TEMPERATURE MISSING (READ_GRIB_T2)')
END IF
!
-IF (SIZE(PMASK)==SIZE(PT2)) &
- WHERE (PMASK(:)/=1.) PT2 = XUNDEF
-!
IF (LHOOK) CALL DR_HOOK('MODE_READ_GRIB:READ_GRIB_T2',1,ZHOOK_HANDLE)
END SUBROUTINE READ_GRIB_T2
!-------------------------------------------------------------------
!-------------------------------------------------------------------
+! ###########################
+ SUBROUTINE READ_GRIB_T2_LAND(HGRIB,KLUOUT,HINMODEL,PMASK,ZFIELD)
+! ###########################
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+IMPLICIT NONE
+!
+ CHARACTER(LEN=*), INTENT(IN) :: HGRIB ! Grib file name
+INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
+ CHARACTER(LEN=6), INTENT(IN) :: HINMODEL ! Grib originating model
+REAL, DIMENSION(:), INTENT(IN) :: PMASK ! grib land mask
+REAL, DIMENSION(:), POINTER :: ZFIELD !
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------
+!* Read deep soil temperature
+IF (LHOOK) CALL DR_HOOK('MODE_READ_GRIB:READ_GRIB_T2_LAND',0,ZHOOK_HANDLE)
+!
+ CALL READ_GRIB_T2(HGRIB,KLUOUT,HINMODEL,PMASK,ZFIELD)
+!
+IF (SIZE(PMASK)==SIZE(ZFIELD)) WHERE (PMASK(:)/=1.) ZFIELD = XUNDEF
+!
+IF (LHOOK) CALL DR_HOOK('MODE_READ_GRIB:READ_GRIB_T2_LAND',1,ZHOOK_HANDLE)
+END SUBROUTINE READ_GRIB_T2_LAND
+!-------------------------------------------------------------------
+!-------------------------------------------------------------------
SUBROUTINE PUT_LAYER_DEPTH(KLUOUT,KLEV,HROUT,KLTYPE,KLEV1,KLEV2,KNLAYERDEEP,PV4,PV,PD)
!
IMPLICIT NONE
@@ -1215,7 +1276,7 @@ PDT(:,1) = 0.01
!--------------------------------------------------------------------------------
! 3. Deep soil temperature
! ---------------------
- CALL READ_GRIB_T2(HGRIB,KLUOUT,HINMODEL,PMASK,ZFIELD)
+ CALL READ_GRIB_T2_LAND(HGRIB,KLUOUT,HINMODEL,PMASK,ZFIELD)
!
PTG(:,2) = ZFIELD(:)
PDT(:,2) = 0.4 ! deep temperature layer depth assumed equal to 0.4m
@@ -1830,7 +1891,7 @@ IF (IRET /= 0 ) THEN
CALL ABOR1_SFX('MODE_READ_GRIB: SNOW AND VEG DEPTH MISSING (READ_GRIB_SNOW_VEG_AND_DEPTH)')
END IF
!
- CALL READ_GRIB_SNOW_DEN(HGRIB,KLUOUT,HINMODEL,PMASK,ZRHO)
+CALL READ_GRIB_SNOW_DEN(HGRIB,KLUOUT,HINMODEL,PMASK,ZRHO)
!
IF (PRESENT(PSNV)) THEN
ALLOCATE(PSNV(SIZE(ZFIELD)))
@@ -1874,9 +1935,9 @@ IMPLICIT NONE
!
!* dummy arguments
! ---------------
- CHARACTER(LEN=*), INTENT(IN) :: HGRIB ! Grib file name
+CHARACTER(LEN=*), INTENT(IN) :: HGRIB ! Grib file name
INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
- CHARACTER(LEN=6), INTENT(IN) :: HINMODEL ! Grib originating model
+CHARACTER(LEN=6), INTENT(IN) :: HINMODEL ! Grib originating model
REAL, DIMENSION(:), INTENT(IN) :: PMASK ! grib land mask
REAL, DIMENSION(:), POINTER :: PSNVA ! field to initialize
!
@@ -1922,9 +1983,9 @@ IMPLICIT NONE
!
!* dummy arguments
! ---------------
- CHARACTER(LEN=*), INTENT(IN) :: HGRIB ! Grib file name
+CHARACTER(LEN=*), INTENT(IN) :: HGRIB ! Grib file name
INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
- CHARACTER(LEN=6), INTENT(IN) :: HINMODEL ! Grib originating model
+CHARACTER(LEN=6), INTENT(IN) :: HINMODEL ! Grib originating model
REAL, DIMENSION(:), INTENT(IN) :: PMASK ! grib land mask
REAL, DIMENSION(:), POINTER :: PSNV ! field to initialize
!
@@ -2041,7 +2102,7 @@ WRITE (KLUOUT,'(A)') 'MODE_READ_GRIB:READ_GRIB_TF_TEB: | Reading temperature fo
!
WRITE (KLUOUT,'(A)') 'MODE_READ_GRIB:READ_GRIB_TF_TEB: | Reading deep soil temperature'
!
- CALL READ_GRIB_T2(HGRIB,KLUOUT,HINMODEL,PMASK,ZFIELD)
+ CALL READ_GRIB_T2_LAND(HGRIB,KLUOUT,HINMODEL,PMASK,ZFIELD)
!
ALLOCATE(PTF(SIZE(ZFIELD),3))
ALLOCATE(PD (SIZE(ZFIELD),3))
diff --git a/src/SURFEX/mode_read_netcdf_mercator.F90 b/src/SURFEX/mode_read_netcdf_mercator.F90
index 2420dc2b4a82fe2b571510912c3f9148e14f73e3..b1469fd3bdc29fb6fb2fdd8ba4abec4dde145526 100644
--- a/src/SURFEX/mode_read_netcdf_mercator.F90
+++ b/src/SURFEX/mode_read_netcdf_mercator.F90
@@ -15,21 +15,22 @@ USE MODI_ABOR1_SFX
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------
!-------------------------------------------------------------------
! ####################
SUBROUTINE HANDLE_ERR_MER(status,line)
! ####################
+USE NETCDF
+!
IMPLICIT NONE
INTEGER, INTENT(IN) :: status
CHARACTER(LEN=80), INTENT(IN) :: line
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:HANDLE_ERR_MER',0,ZHOOK_HANDLE)
-IF (status /= NF_NOERR) THEN
+IF (status /= NF90_NOERR) THEN
CALL ABOR1_SFX('MODE_READ_NETCDF_MERCATOR: HANDLE_ERR_MER')
END IF
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:HANDLE_ERR_MER',1,ZHOOK_HANDLE)
@@ -40,6 +41,8 @@ END SUBROUTINE HANDLE_ERR_MER
SUBROUTINE GET1DCDF(KCDF_ID,IDVAR,PMISSVALUE,PVALU1D)
! ####################
!
+USE NETCDF
+!
IMPLICIT NONE
!
INTEGER,INTENT(IN) :: KCDF_ID !netcdf file identifiant
@@ -55,11 +58,11 @@ integer,DIMENSION(:),ALLOCATABLE :: NVARDIMID,NVARDIMLEN
character(len=80),DIMENSION(:),ALLOCATABLE :: NVARDIMNAM
integer :: JLOOP
integer :: NGATTS
+integer, dimension(1) :: NDIMID
character(len=80),DIMENSION(:),ALLOCATABLE :: HNAME
REAL,DIMENSION(:),ALLOCATABLE :: ZVALU1D !value array
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:GET1DCDF',0,ZHOOK_HANDLE)
PMISSVALUE=-9999.9
@@ -71,23 +74,24 @@ NVARDIMLEN(:)=0
NVARDIMNAM(:)=' '
!
HACTION='get variable type'
-status=nf_inq_vartype(KCDF_ID,IDVAR,KVARTYPE)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_inquire_variable(KCDF_ID,IDVAR,XTYPE=KVARTYPE)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'variable type = ',KVARTYPE
!
+status=nf90_inquire_variable(KCDF_ID,IDVAR,DIMIDS=NDIMID)
HACTION='get variable dimensions name'
-status=nf_inq_dimname(KCDF_ID,IDVAR,NVARDIMNAM(NDIMS))
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_inquire_dimension(KCDF_ID,NDIMID(NDIMS),NAME=NVARDIMNAM(NDIMS))
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!
HACTION='get variable dimensions length'
-status=nf_inq_dimlen(KCDF_ID,IDVAR,NVARDIMLEN(NDIMS))
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_inquire_dimension(KCDF_ID,NDIMID(NDIMS),LEN=NVARDIMLEN(NDIMS))
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'variable dimension ',NDIMS,' named ',NVARDIMNAM(NDIMS),&
! &'has a length of',NVARDIMLEN(NDIMS)
!!
HACTION='get attributs'
-status=nf_inq_varnatts(KCDF_ID,IDVAR,NGATTS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_inquire_variable(KCDF_ID,IDVAR,NATTS=NGATTS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'number of attributes = ',NGATTS
allocate(hname(1:NGATTS))
!
@@ -96,8 +100,8 @@ ZVALU1D=0.
!
IF (KVARTYPE>=5) then
HACTION='get variable values (1D)'
- status=nf_get_var_double(KCDF_ID,IDVAR,ZVALU1D(:))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_get_var(KCDF_ID,IDVAR,ZVALU1D(:))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
ENDIF
!
PVALU1D(:)=ZVALU1D(:)
@@ -114,6 +118,8 @@ END SUBROUTINE GET1DCDF
! ####################
USE MODD_SURF_PAR, ONLY : XUNDEF
!
+USE NETCDF
+!
IMPLICIT NONE
!
INTEGER,INTENT(IN) :: KCDF_ID !netcdf file identifiant
@@ -138,7 +144,6 @@ REAL,DIMENSION(:,:),ALLOCATABLE :: ZVALU2D !value array
INTEGER,DIMENSION(:,:),ALLOCATABLE :: IVALU2D
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:GET2DCDF',0,ZHOOK_HANDLE)
PMISSVALUE=-9999.9
@@ -150,53 +155,53 @@ NVARDIMLEN(:)=0
NVARDIMNAM(:)=' '
!
HACTION='get variable type'
-status=nf_inq_vartype(KCDF_ID,IDVAR,KVARTYPE)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_inquire_variable(KCDF_ID,IDVAR,XTYPE=KVARTYPE)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'variable type = ',KVARTYPE
!
HACTION='get variable dimensions identifiant'
-status=nf_inq_vardimid(KCDF_ID,IDVAR,NVARDIMID)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_inquire_variable(KCDF_ID,IDVAR,DIMIDS=NVARDIMID)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!
HACTION='get attributs'
-status=nf_inq_varnatts(KCDF_ID,IDVAR,NGATTS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_inquire_variable(KCDF_ID,IDVAR,NATTS=NGATTS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'number of attributes = ',NGATTS
allocate(hname(1:NGATTS))
!
ZSCFA=1.
ZOFFS=0.
DO JLOOP=1,NGATTS
- status=nf_inq_attname(KCDF_ID,IDVAR,JLOOP,hname(JLOOP))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_inq_attname(KCDF_ID,IDVAR,JLOOP,hname(JLOOP))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'attributes names = ', hname(JLOOP)
if (TRIM(hname(JLOOP))=='missing_value') then
!write(0,*) 'missing value search '
HACTION='get missing value'
- status=nf_get_att_double(KCDF_ID,IDVAR,"missing_value",PMISSVALUE)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_get_att(KCDF_ID,IDVAR,"missing_value",PMISSVALUE)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'missing value = ',PMISSVALUE
else
if (TRIM(hname(JLOOP))=='_FillValue') then
!write(0,*) 'missing value found '
HACTION='get _FillValue'
- status=nf_get_att_double(KCDF_ID,IDVAR,"_FillValue",PMISSVALUE)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_get_att(KCDF_ID,IDVAR,"_FillValue",PMISSVALUE)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'missing value = ',PMISSVALUE
endif
endif
if (TRIM(hname(JLOOP))=='scale_factor') then
!write(0,*) 'missing value found '
HACTION='get scale factor'
- status=nf_get_att_double(KCDF_ID,IDVAR,"scale_factor",ZSCFA)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_get_att(KCDF_ID,IDVAR,"scale_factor",ZSCFA)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'missing value = ',PMISSVALUE
endif
if (TRIM(hname(JLOOP))=='add_offset') then
!write(0,*) 'missing value found '
HACTION='get offset'
- status=nf_get_att_double(KCDF_ID,IDVAR,"add_offset",ZOFFS)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_get_att(KCDF_ID,IDVAR,"add_offset",ZOFFS)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'missing value = ',PMISSVALUE
endif
ENDDO
@@ -204,11 +209,11 @@ ENDDO
!
DO JLOOP2=1,NDIMS
HACTION='get variable dimensions name'
- status=nf_inq_dimname(KCDF_ID,NVARDIMID(JLOOP2),NVARDIMNAM(JLOOP2))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_inquire_dimension(KCDF_ID,NVARDIMID(JLOOP2),NAME=NVARDIMNAM(JLOOP2))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(KCDF_ID,NVARDIMID(JLOOP2),NVARDIMLEN(JLOOP2))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_inquire_dimension(KCDF_ID,NVARDIMID(JLOOP2),LEN=NVARDIMLEN(JLOOP2))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'variable dimension ',JLOOP2,' named ',NVARDIMNAM(JLOOP2),&
! &'has a length of',NVARDIMLEN(JLOOP2)
ENDDO
@@ -217,14 +222,14 @@ IF (KVARTYPE>=5) then
ALLOCATE(ZVALU2D(1:NVARDIMLEN(1),1:NVARDIMLEN(2)))
ZVALU2D=0.
HACTION='get variable values (2D)'
- status=nf_get_var_double(KCDF_ID,IDVAR,ZVALU2D(:,:))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_get_var(KCDF_ID,IDVAR,ZVALU2D(:,:))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
ELSE
ALLOCATE(IVALU2D(1:NVARDIMLEN(1),1:NVARDIMLEN(2)))
IVALU2D=0.
HACTION='get variable values (2D)'
- status=nf_get_var_int(KCDF_ID,IDVAR,IVALU2D(:,:))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_get_var(KCDF_ID,IDVAR,IVALU2D(:,:))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
ENDIF
PVALU2D(:,:)=XUNDEF
DO J1=1,NVARDIMLEN(1)
@@ -253,6 +258,8 @@ END SUBROUTINE GET2DCDF
! ####################
USE MODD_SURF_PAR, ONLY : XUNDEF
!
+USE NETCDF
+!
IMPLICIT NONE
!
INTEGER,INTENT(IN) :: KCDF_ID !netcdf file identifiant
@@ -278,7 +285,6 @@ REAL,DIMENSION(:,:,:),ALLOCATABLE :: ZVALU3D !value array
INTEGER,DIMENSION(:,:,:),ALLOCATABLE :: IVALU3D
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:GET3DCDF',0,ZHOOK_HANDLE)
PMISSVALUE=-9999.9
@@ -290,54 +296,54 @@ NVARDIMLEN(:)=0
NVARDIMNAM(:)=' '
!
HACTION='get variable type'
-status=nf_inq_vartype(KCDF_ID,IDVAR,KVARTYPE)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_inquire_variable(KCDF_ID,IDVAR,XTYPE=KVARTYPE)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'variable type = ',KVARTYPE
!
HACTION='get variable dimensions identifiant'
-status=nf_inq_vardimid(KCDF_ID,IDVAR,NVARDIMID)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_inquire_variable(KCDF_ID,IDVAR,DIMIDS=NVARDIMID)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'variable dimension identifiant ',NVARDIMID
!
HACTION='get attributs'
-status=nf_inq_varnatts(KCDF_ID,IDVAR,NGATTS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_inquire_variable(KCDF_ID,IDVAR,NATTS=NGATTS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'number of attributes = ',NGATTS
allocate(hname(1:NGATTS))
!
ZSCFA=1.
ZOFFS=0.
DO JLOOP=1,NGATTS
- status=nf_inq_attname(KCDF_ID,IDVAR,JLOOP,hname(JLOOP))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_inq_attname(KCDF_ID,IDVAR,JLOOP,hname(JLOOP))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'attributes names = ', hname(JLOOP)
if (TRIM(hname(JLOOP))=='missing_value') then
!write(0,*) 'missing value found '
HACTION='get missing value'
- status=nf_get_att_double(KCDF_ID,IDVAR,"missing_value",PMISSVALUE)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_get_att(KCDF_ID,IDVAR,"missing_value",PMISSVALUE)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'missing value = ',PMISSVALUE
else
if (TRIM(hname(JLOOP))=='_FillValue') then
!write(0,*) 'missing value found '
HACTION='get _FillValue'
- status=nf_get_att_double(KCDF_ID,IDVAR,"_FillValue",PMISSVALUE)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_get_att(KCDF_ID,IDVAR,"_FillValue",PMISSVALUE)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'missing value = ',PMISSVALUE
endif
endif
if (TRIM(hname(JLOOP))=='scale_factor') then
!write(0,*) 'missing value found '
HACTION='get scale factor'
- status=nf_get_att_double(KCDF_ID,IDVAR,"scale_factor",ZSCFA)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_get_att(KCDF_ID,IDVAR,"scale_factor",ZSCFA)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'missing value = ',PMISSVALUE
endif
if (TRIM(hname(JLOOP))=='add_offset') then
!write(0,*) 'missing value found '
HACTION='get offset'
- status=nf_get_att_double(KCDF_ID,IDVAR,"add_offset",ZOFFS)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_get_att(KCDF_ID,IDVAR,"add_offset",ZOFFS)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'missing value = ',PMISSVALUE
endif
ENDDO
@@ -345,11 +351,11 @@ ENDDO
!
DO JLOOP2=1,NDIMS
HACTION='get variable dimensions name'
- status=nf_inq_dimname(KCDF_ID,NVARDIMID(JLOOP2),NVARDIMNAM(JLOOP2))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_inquire_dimension(KCDF_ID,NVARDIMID(JLOOP2),NAME=NVARDIMNAM(JLOOP2))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(KCDF_ID,NVARDIMID(JLOOP2),NVARDIMLEN(JLOOP2))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_inquire_dimension(KCDF_ID,NVARDIMID(JLOOP2),LEN=NVARDIMLEN(JLOOP2))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'variable dimension ',JLOOP2,' named ',NVARDIMNAM(JLOOP2),&
! &'has a length of',NVARDIMLEN(JLOOP2)
ENDDO
@@ -358,14 +364,14 @@ IF (KVARTYPE>=5) then
ALLOCATE(ZVALU3D(1:NVARDIMLEN(1),1:NVARDIMLEN(2),1:NVARDIMLEN(3)))
ZVALU3D=0.
HACTION='get variable values (3D)'
- status=nf_get_var_double(KCDF_ID,IDVAR,ZVALU3D(:,:,:))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_get_var(KCDF_ID,IDVAR,ZVALU3D(:,:,:))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
ELSE
ALLOCATE(IVALU3D(1:NVARDIMLEN(1),1:NVARDIMLEN(2),1:NVARDIMLEN(3)))
IVALU3D=0.
HACTION='get variable values (3D)'
- status=nf_get_var_int(KCDF_ID,IDVAR,IVALU3D(:,:,:))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_get_var(KCDF_ID,IDVAR,IVALU3D(:,:,:))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
ENDIF
!
PVALU3D(:,:,:)=XUNDEF
@@ -399,6 +405,8 @@ END SUBROUTINE GET3DCDF
SUBROUTINE READ_DIM_CDF(HFILENAME,HNCVARNAME,KDIM)
! ####################
!
+USE NETCDF
+!
IMPLICIT NONE
!
CHARACTER(LEN=28), INTENT(IN) :: HFILENAME ! Name of the field file.
@@ -409,22 +417,22 @@ integer :: status
integer :: kcdf_id
integer :: NBVARS
character(len=80) :: HACTION
-character(len=80),DIMENSION(:),ALLOCATABLE :: VARNAME
+character(len=80),DIMENSION(:),ALLOCATABLE :: YVARNAME
integer ::JLOOP1,JLOOP
integer ::ID_VARTOGET,ID_VARTOGET1,ID_VARTOGET2
integer ::NVARDIMS
-integer,DIMENSION(2) ::NLEN2D
+INTEGER, DIMENSION(1) :: NDIMID
+integer,DIMENSION(2) ::NLEN2D, NDIMID2D
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
!* 1. Open the netcdf file
! --------------------
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:READ_DIM_CDF',0,ZHOOK_HANDLE)
HACTION='open netcdf'
-status=NF_OPEN(HFILENAME,nf_nowrite,kcdf_id)
+status=NF90_OPEN(HFILENAME,nf90_nowrite,kcdf_id)
!write(0,*) 'identifiant de ',HFILENAME,'=',kcdf_id
-if (status/=NF_NOERR) then
+if (status/=NF90_NOERR) then
CALL HANDLE_ERR_MER(status,HACTION)
!else
! write(0,*) 'netcdf file opened: ',HFILENAME
@@ -435,10 +443,10 @@ endif
!* 2. get the number of variables in netcdf file
! ------------------------------------------
HACTION='get number of variables'
-status=NF_INQ_NVARS(kcdf_id,NBVARS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=NF90_INQUIRE(kcdf_id,NVARIABLES=NBVARS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'nb vars', NBVARS
-ALLOCATE(VARNAME(NBVARS))
+ALLOCATE(YVARNAME(NBVARS))
!
!-----------
!
@@ -448,18 +456,18 @@ ID_VARTOGET1=0
ID_VARTOGET2=0
DO JLOOP1=1,NBVARS
HACTION='get variables names'
- status=NF_INQ_VARNAME(kcdf_id,JLOOP1,VARNAME(JLOOP1))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
- !write(0,*) 'var',JLOOP1,' name: ',VARNAME(JLOOP1)
- if (VARNAME(JLOOP1)==HNCVARNAME) then
+ status=NF90_INQUIRE_VARIABLE(kcdf_id,JLOOP1,NAME=YVARNAME(JLOOP1))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ !write(0,*) 'var',JLOOP1,' name: ',YVARNAME(JLOOP1)
+ if (YVARNAME(JLOOP1)==HNCVARNAME) then
!write(0,*) 'var',JLOOP1,' corresponding to variable required'
ID_VARTOGET1=JLOOP1
endif
- if (VARNAME(JLOOP1)/=HNCVARNAME) then
- if((LGT(TRIM(VARNAME(JLOOP1)),TRIM(HNCVARNAME))).AND.&
- (SCAN(TRIM(VARNAME(JLOOP1)),TRIM(HNCVARNAME))==1)) then
- !write(0,*) 'var',JLOOP1,VARNAME(JLOOP1),' could correspond to variable required ?'
- !write(0,*) HNCVARNAME,' is variable required; only ',VARNAME(JLOOP1),' found'
+ if (YVARNAME(JLOOP1)/=HNCVARNAME) then
+ if((LGT(TRIM(YVARNAME(JLOOP1)),TRIM(HNCVARNAME))).AND.&
+ (SCAN(TRIM(YVARNAME(JLOOP1)),TRIM(HNCVARNAME))==1)) then
+ !write(0,*) 'var',JLOOP1,YVARNAME(JLOOP1),' could correspond to variable required ?'
+ !write(0,*) HNCVARNAME,' is variable required; only ',YVARNAME(JLOOP1),' found'
ID_VARTOGET2=JLOOP1
endif
endif
@@ -471,8 +479,8 @@ else
endif
if (ID_VARTOGET==0) then
HACTION='close netcdf'
- status=nf_close(kcdf_id)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_close(kcdf_id)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
CALL ABOR1_SFX('MODE_READ_NETCDF_MERCATOR: READ_DIM_CDF')
endif
!-----------
@@ -484,8 +492,8 @@ endif
! -----------------------------------
!
HACTION='get variable dimensions number'
-status=nf_inq_varndims(kcdf_id,ID_VARTOGET,NVARDIMS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,NDIMS=NVARDIMS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'variable dimensions number = ',NVARDIMS
!
! 4.2 get the variable dimensions length
@@ -494,16 +502,18 @@ SELECT CASE (NVARDIMS)
!CAS 1D
CASE (1)
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(kcdf_id,ID_VARTOGET,KDIM)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,DIMIDS=NDIMID)
+ status=nf90_inquire_dimension(kcdf_id,NDIMID(1),LEN=KDIM)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!
!CAS 2D
CASE (2)
KDIM=1
+ status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,DIMIDS=NDIMID2D)
DO JLOOP=1,NVARDIMS
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(kcdf_id,ID_VARTOGET,NLEN2D(JLOOP))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_inquire_dimension(kcdf_id,NDIMID2D(JLOOP),LEN=NLEN2D(JLOOP))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
KDIM=KDIM*NLEN2D(JLOOP)
ENDDO
END SELECT
@@ -511,14 +521,14 @@ END SELECT
!* 10. Close the netcdf file
! ---------------------
HACTION='close netcdf'
-status=nf_close(kcdf_id)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_close(kcdf_id)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'OK: netcdf file closed: ',HFILENAME
!
!-----------
!* 11. Deallocate
! ----------
-IF (ALLOCATED(VARNAME )) DEALLOCATE(VARNAME)
+IF (ALLOCATED(YVARNAME )) DEALLOCATE(YVARNAME)
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:READ_DIM_CDF',1,ZHOOK_HANDLE)
!
END SUBROUTINE READ_DIM_CDF
@@ -528,31 +538,46 @@ END SUBROUTINE READ_DIM_CDF
SUBROUTINE PREP_NETCDF_GRID(HFILENAME,HNCVARNAME)
! ####################
!
+USE MODD_SURFEX_MPI, ONLY : WLOG_MPI, NRANK, NPIO, NPROC, NCOMM
+USE MODD_HORIBL, ONLY : LGLOBLON, LGLOBS, LGLOBN, XILO1H, XILO2H, NINLOH, &
+ XLA, XOLA, XOLO, NP, XLOPH, NO
+USE MODD_PREP, ONLY : XLAT_OUT, XLON_OUT, LINTERP
+!
USE MODD_GRID_LATLONREGUL
USE MODD_SURF_PAR
!
+USE MODI_HORIBL_SURF_INIT
+USE MODI_HORIBL_SURF_COEF
+!
+USE NETCDF
+!
IMPLICIT NONE
+!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
!
CHARACTER(LEN=28), INTENT(IN) :: HFILENAME ! Name of the field file.
CHARACTER(LEN=28), INTENT(IN) :: HNCVARNAME ! Name of variable to read in netcdf file
!
integer :: status
integer :: kcdf_id
-integer :: NBVARS
+integer :: INBVARS
character(len=80) :: HACTION
-character(len=80),DIMENSION(:),ALLOCATABLE :: VARNAME
+character(len=80),DIMENSION(:),ALLOCATABLE :: YVARNAME
integer,DIMENSION(:),ALLOCATABLE :: NVARDIMID
integer ::JLOOP1,JLOOP
integer ::ID_VARTOGET,ID_VARTOGET1,ID_VARTOGET2
-integer ::NVARDIMS
-integer,DIMENSION(3) ::NDIMLEN
+integer ::INVARDIMS
+integer,DIMENSION(3) ::INDIMLEN
character(LEN=80),DIMENSION(3) :: NDIMNAM
integer :: IDIM
integer :: INLON
+INTEGER :: IINLA, INO
real :: ZZLAMISS,ZZLOMISS
+INTEGER :: INFOMPI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:PREP_NETCDF_GRID',0,ZHOOK_HANDLE)
NINLAT =-NUNDEF
@@ -565,122 +590,159 @@ XILAT2=XUNDEF
XILON2=XUNDEF
!* 1. Open the netcdf file
! --------------------
-HACTION='open netcdf'
-status=NF_OPEN(HFILENAME,nf_nowrite,kcdf_id)
-!write(0,*) 'identifiant de ',HFILENAME,'=',kcdf_id
-if (status/=NF_NOERR) then
- CALL HANDLE_ERR_MER(status,HACTION)
-!else
-! write(0,*) 'netcdf file opened: ',HFILENAME
-endif
-!
-!-----------
-!
-!* 2. get the number of variables in netcdf file
-! ------------------------------------------
-HACTION='get number of variables'
-status=NF_INQ_NVARS(kcdf_id,NBVARS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
-!write(0,*) 'nb vars', NBVARS
-ALLOCATE(VARNAME(NBVARS))
-!
-!-----------
-!
-!* 3. get the variables names in netcdf file
-! --------------------------------------
-ID_VARTOGET1=0
-ID_VARTOGET2=0
-DO JLOOP1=1,NBVARS
- HACTION='get variables names'
- status=NF_INQ_VARNAME(kcdf_id,JLOOP1,VARNAME(JLOOP1))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
- !write(0,*) 'var',JLOOP1,' name: ',VARNAME(JLOOP1)
- if (VARNAME(JLOOP1)==HNCVARNAME) then
- !write(0,*) 'var',JLOOP1,' corresponding to variable required'
- ID_VARTOGET1=JLOOP1
+IF (NRANK==NPIO) THEN
+
+ HACTION='open netcdf'
+ status=NF90_OPEN(HFILENAME,nf90_nowrite,kcdf_id)
+ !write(0,*) 'identifiant de ',HFILENAME,'=',kcdf_id
+ if (status/=NF90_NOERR) then
+ CALL HANDLE_ERR_MER(status,HACTION)
+ !else
+ ! write(0,*) 'netcdf file opened: ',HFILENAME
endif
- if (VARNAME(JLOOP1)/=HNCVARNAME) then
- if((LGT(TRIM(VARNAME(JLOOP1)),TRIM(HNCVARNAME))).AND.&
- (SCAN(TRIM(VARNAME(JLOOP1)),TRIM(HNCVARNAME))==1)) then
- !write(0,*) 'var',JLOOP1,VARNAME(JLOOP1),' could correspond to variable required ?'
- !write(0,*) HNCVARNAME,' is variable required; only ',VARNAME(JLOOP1),' found'
- ID_VARTOGET2=JLOOP1
+ !
+ !-----------
+ !
+ !* 2. get the number of variables in netcdf file
+ ! ------------------------------------------
+ HACTION='get number of variables'
+ status=NF90_INQUIRE(kcdf_id,NVARIABLES=INBVARS)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ !write(0,*) 'nb vars', INBVARS
+ ALLOCATE(YVARNAME(INBVARS))
+ !
+ !-----------
+ !
+ !* 3. get the variables names in netcdf file
+ ! --------------------------------------
+ ID_VARTOGET1=0
+ ID_VARTOGET2=0
+ DO JLOOP1=1,INBVARS
+ HACTION='get variables names'
+ status=NF90_INQUIRE_VARIABLE(kcdf_id,JLOOP1,NAME=YVARNAME(JLOOP1))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ !write(0,*) 'var',JLOOP1,' name: ',YVARNAME(JLOOP1)
+ if (YVARNAME(JLOOP1)==HNCVARNAME) then
+ !write(0,*) 'var',JLOOP1,' corresponding to variable required'
+ ID_VARTOGET1=JLOOP1
endif
+ if (YVARNAME(JLOOP1)/=HNCVARNAME) then
+ if((LGT(TRIM(YVARNAME(JLOOP1)),TRIM(HNCVARNAME))).AND.&
+ (SCAN(TRIM(YVARNAME(JLOOP1)),TRIM(HNCVARNAME))==1)) then
+ !write(0,*) 'var',JLOOP1,YVARNAME(JLOOP1),' could correspond to variable required ?'
+ !write(0,*) HNCVARNAME,' is variable required; only ',YVARNAME(JLOOP1),' found'
+ ID_VARTOGET2=JLOOP1
+ endif
+ endif
+ ENDDO
+ DEALLOCATE(YVARNAME)
+ if (ID_VARTOGET1/=0) then
+ ID_VARTOGET=ID_VARTOGET1
+ else
+ ID_VARTOGET=ID_VARTOGET2
endif
-ENDDO
-if (ID_VARTOGET1/=0) then
- ID_VARTOGET=ID_VARTOGET1
-else
- ID_VARTOGET=ID_VARTOGET2
-endif
+ !
+ if (ID_VARTOGET==0) then
+ HACTION='close netcdf'
+ status=nf90_close(kcdf_id)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ endif
+ !
+ENDIF
+!
+IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(ID_VARTOGET,KIND(ID_VARTOGET)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ENDIF
+!
if (ID_VARTOGET==0) then
- HACTION='close netcdf'
- status=nf_close(kcdf_id)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:PREP_NETCDF_GRID',1,ZHOOK_HANDLE)
RETURN
endif
-NILENGTH=0
-!-----------
!
-!* 4. get the total dimension of HNCVARNAME
-! -------------------------------------
-!
-! 4.1 get the variable dimensions number
-! -----------------------------------
-!
-HACTION='get variable dimensions number'
-status=nf_inq_varndims(kcdf_id,ID_VARTOGET,NVARDIMS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
-!write(0,*) 'variable dimensions number = ',NVARDIMS
-ALLOCATE(NVARDIMID(NVARDIMS))
-HACTION='get variable dimensions identifiant'
-status=nf_inq_vardimid(kcdf_id,ID_VARTOGET,NVARDIMID)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
-!
-! 4.2 get the variable dimensions length
-! ----------------------------------
-SELECT CASE (NVARDIMS)
-!CAS 1D
- CASE (1)
- HACTION='get variable dimensions length'
- status=nf_inq_dimlen(kcdf_id,ID_VARTOGET,IDIM)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+NILENGTH=0
!
-!CAS 2D,3D
- CASE (2,3)
- DO JLOOP=1,NVARDIMS
+IF (NRANK==NPIO) THEN
+ !
+ !-----------
+ !
+ !* 4. get the total dimension of HNCVARNAME
+ ! -------------------------------------
+ !
+ ! 4.1 get the variable dimensions number
+ ! -----------------------------------
+ !
+ HACTION='get variable dimensions number'
+ status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,NDIMS=INVARDIMS)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ !write(0,*) 'variable dimensions number = ',INVARDIMS
+ ALLOCATE(NVARDIMID(INVARDIMS))
+ HACTION='get variable dimensions identifiant'
+ status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,DIMIDS=NVARDIMID)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ !
+ ! 4.2 get the variable dimensions length
+ ! ----------------------------------
+ SELECT CASE (INVARDIMS)
+ !CAS 1D
+ CASE (1)
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(kcdf_id,NVARDIMID(JLOOP),NDIMLEN(JLOOP))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
- HACTION='get variable dimensions names'
- status=nf_inq_dimname(kcdf_id,NVARDIMID(JLOOP),NDIMNAM(JLOOP))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
- if ((NDIMNAM(JLOOP)=='lat').OR.(NDIMNAM(JLOOP)=='latitude')) then
- NINLAT=NDIMLEN(JLOOP)
- if (.not.allocated(XILATARRAY)) allocate(XILATARRAY(NDIMLEN(JLOOP)))
- if (.not.allocated(NINLON)) allocate(NINLON(NINLAT))
- CALL GET1DCDF(kcdf_id,NVARDIMID(JLOOP),ZZLAMISS,XILATARRAY(:))
- endif
- if ((NDIMNAM(JLOOP)=='lon').OR.(NDIMNAM(JLOOP)=='longitude')) then
- INLON=NDIMLEN(JLOOP)
- if (.not.allocated(XILONARRAY)) allocate(XILONARRAY(NDIMLEN(JLOOP)))
- CALL GET1DCDF(kcdf_id,NVARDIMID(JLOOP),ZZLOMISS,XILONARRAY(:))
- endif
- if (NDIMNAM(JLOOP)=='depth') NINDEPTH=NDIMLEN(JLOOP)
- ENDDO
- NINLON(:)=INLON
-END SELECT
-!-----------
-!* 10. Close the netcdf file
-! ---------------------
-HACTION='close netcdf'
-status=nf_close(kcdf_id)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
-!write(0,*) 'OK: netcdf file closed: ',HFILENAME
+ status=nf90_inquire_dimension(kcdf_id,NVARDIMID(1),LEN=IDIM)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ !
+ !CAS 2D,3D
+ CASE (2,3)
+ DO JLOOP=1,INVARDIMS
+ HACTION='get variable dimensions length'
+ status=nf90_inquire_dimension(kcdf_id,NVARDIMID(JLOOP),LEN=INDIMLEN(JLOOP))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ HACTION='get variable dimensions names'
+ status=nf90_inquire_dimension(kcdf_id,NVARDIMID(JLOOP),NAME=NDIMNAM(JLOOP))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ if ((NDIMNAM(JLOOP)=='lat').OR.(NDIMNAM(JLOOP)=='latitude')) then
+ NINLAT=INDIMLEN(JLOOP)
+ if (.not.allocated(XILATARRAY)) allocate(XILATARRAY(INDIMLEN(JLOOP)))
+ if (.not.allocated(NINLON)) allocate(NINLON(NINLAT))
+ CALL GET1DCDF(kcdf_id,NVARDIMID(JLOOP),ZZLAMISS,XILATARRAY(:))
+ endif
+ if ((NDIMNAM(JLOOP)=='lon').OR.(NDIMNAM(JLOOP)=='longitude')) then
+ INLON=INDIMLEN(JLOOP)
+ if (.not.allocated(XILONARRAY)) allocate(XILONARRAY(INDIMLEN(JLOOP)))
+ CALL GET1DCDF(kcdf_id,NVARDIMID(JLOOP),ZZLOMISS,XILONARRAY(:))
+ endif
+ if (NDIMNAM(JLOOP)=='depth') NINDEPTH=INDIMLEN(JLOOP)
+ ENDDO
+ NINLON(:)=INLON
+ END SELECT
+ !-----------
+ !* 10. Close the netcdf file
+ ! ---------------------
+ HACTION='close netcdf'
+ status=nf90_close(kcdf_id)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ !write(0,*) 'OK: netcdf file closed: ',HFILENAME
+ !
+ENDIF
+!
+IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(NINLAT,KIND(NINLAT)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(INLON,KIND(INLON)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ IF (NRANK/=NPIO) THEN
+ ALLOCATE(NINLON(NINLAT))
+ ALLOCATE(XILATARRAY(NINLAT))
+ ALLOCATE(XILONARRAY(INLON))
+ ENDIF
+ CALL MPI_BCAST(NINLON,SIZE(NINLON)*KIND(NINLON)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XILATARRAY,SIZE(XILATARRAY)*KIND(XILATARRAY)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XILONARRAY,SIZE(XILONARRAY)*KIND(XILONARRAY)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+#endif
+ENDIF
!
!-----------
!GRID PARAM FOR HORIBL_SURF
+NILENGTH=0
DO JLOOP1=1,NINLAT
NILENGTH = NILENGTH + NINLON(JLOOP1)
ENDDO
@@ -691,7 +753,40 @@ XILON2=XILONARRAY(SIZE(XILONARRAY))
!
!* 11. Deallocate
! ----------
-IF (ALLOCATED(VARNAME )) DEALLOCATE(VARNAME)
+!
+IF (ALLOCATED(XLAT_OUT)) THEN
+ !
+ INO = SIZE(XLAT_OUT)
+ !
+ IF (ALLOCATED(NO)) DEALLOCATE(NO)
+ IF (ALLOCATED(XLA)) DEALLOCATE(XLA)
+ IF (ALLOCATED(XOLA)) DEALLOCATE(XOLA)
+ IF (ALLOCATED(XOLO)) DEALLOCATE(XOLO)
+ IF (ALLOCATED(NINLOH)) DEALLOCATE(NINLOH)
+
+ ALLOCATE(NO(INO,4))
+ ALLOCATE(XOLA(INO),XOLO(INO))
+ ALLOCATE(XLA(INO,4))
+ !
+ IINLA = NINLAT
+ ALLOCATE(NINLOH(IINLA+4))
+ CALL HORIBL_SURF_INIT(XILAT1,XILON1,XILAT2,XILON2,NINLAT,NINLON, &
+ INO,XLON_OUT,XLAT_OUT,LINTERP,LGLOBLON,&
+ LGLOBN,LGLOBS,NO,NINLOH,XOLA,XOLO,XILO1H,&
+ XILO2H,XLA,XILATARRAY)
+ !
+ IF (ALLOCATED(NP)) DEALLOCATE(NP)
+ IF (ALLOCATED(XLOPH)) DEALLOCATE(XLOPH)
+ ALLOCATE(NP(INO,12))
+ ALLOCATE(XLOPH(INO,12))
+
+ IF (LGLOBS) IINLA = IINLA + 2
+ IF (LGLOBN) IINLA = IINLA + 2
+ CALL HORIBL_SURF_COEF(INO,LINTERP,LGLOBLON,XILO1H,XILO2H,XOLO,&
+ NO,NINLOH(1:IINLA),NP,XLOPH)
+ !
+ENDIF
+!
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:PREP_NETCDF_GRID',1,ZHOOK_HANDLE)
!
END SUBROUTINE PREP_NETCDF_GRID
@@ -701,6 +796,8 @@ END SUBROUTINE PREP_NETCDF_GRID
SUBROUTINE READ_Z1D_CDF(HFILENAME,HNCVARNAME,PVAL)
! ####################
!
+USE NETCDF
+!
IMPLICIT NONE
!
CHARACTER(LEN=28), INTENT(IN) :: HFILENAME ! Name of the field file.
@@ -715,12 +812,12 @@ character(len=80),DIMENSION(:),ALLOCATABLE :: VARNAME
integer ::JLOOP1
integer ::ID_VARTOGET,ID_VARTOGET1,ID_VARTOGET2
integer ::NVARDIMS
+INTEGER, DIMENSION(1) :: NDIMID
integer ::NLEN
real,DIMENSION(:),ALLOCATABLE :: ZVALU
real :: ZMISS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
!* 1. Open the netcdf file
! --------------------
@@ -728,16 +825,16 @@ IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:READ_Z1D_CDF',0,ZHOOK_HANDLE)
status=-9999
kcdf_id=-9999
HACTION='open netcdf'
-status=NF_OPEN(HFILENAME,nf_nowrite,kcdf_id)
-if (status/=NF_NOERR) then
+status=NF90_OPEN(HFILENAME,nf90_nowrite,kcdf_id)
+if (status/=NF90_NOERR) then
CALL HANDLE_ERR_MER(status,HACTION)
endif
!-----------
!* 2. get the number of variables in netcdf file
! ------------------------------------------
HACTION='get number of variables'
-status=NF_INQ_NVARS(kcdf_id,NBVARS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=NF90_INQUIRE(kcdf_id,NVARIABLES=NBVARS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'nb vars', NBVARS
ALLOCATE(VARNAME(NBVARS))
!-----------
@@ -747,8 +844,8 @@ ID_VARTOGET1=0
ID_VARTOGET2=0
DO JLOOP1=1,NBVARS
HACTION='get variables names'
- status=NF_INQ_VARNAME(kcdf_id,JLOOP1,VARNAME(JLOOP1))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=NF90_INQUIRE_VARIABLE(kcdf_id,JLOOP1,NAME=VARNAME(JLOOP1))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
if (VARNAME(JLOOP1)==HNCVARNAME) then
ID_VARTOGET1=JLOOP1
endif
@@ -766,8 +863,8 @@ else
endif
if (ID_VARTOGET==0) then
HACTION='close netcdf'
- status=nf_close(kcdf_id)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_close(kcdf_id)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
CALL ABOR1_SFX('MODE_READ_NETCDF_MERCATOR: READ_Z1D_CDF')
endif
!-----------
@@ -776,8 +873,8 @@ endif
! 4.1 get the variable dimensions number
! -----------------------------------
HACTION='get variable dimensions number'
-status=nf_inq_varndims(kcdf_id,ID_VARTOGET,NVARDIMS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,NDIMS=NVARDIMS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!
! 4.2 get the variable dimensions length and values
! ----------------------------------------------
@@ -785,8 +882,9 @@ SELECT CASE (NVARDIMS)
!CAS 1D
CASE (1)
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(kcdf_id,ID_VARTOGET,NLEN)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,DIMIDS=NDIMID)
+ status=nf90_inquire_dimension(kcdf_id,NDIMID(1),LEN=NLEN)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
ALLOCATE(ZVALU(NLEN))
!write(0,*) 'call GET1DCDF'
CALL GET1DCDF(kcdf_id,ID_VARTOGET,ZMISS,ZVALU)
@@ -800,8 +898,8 @@ END SELECT
!* 5. Close the netcdf file
! ---------------------
HACTION='close netcdf'
-status=nf_close(kcdf_id)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_close(kcdf_id)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!-----------
!* 6. Deallocate
! ----------
@@ -816,6 +914,8 @@ END SUBROUTINE READ_Z1D_CDF
SUBROUTINE READ_LATLONVAL_CDF(HFILENAME,HNCVARNAME,PLON,PLAT,PVAL)
! ####################
!
+USE NETCDF
+!
IMPLICIT NONE
!
CHARACTER(LEN=28), INTENT(IN) :: HFILENAME ! Name of the field file.
@@ -832,7 +932,8 @@ integer ::JLOOP1,JDIM1,JDIM2,JLOOP
integer ::ID_VARTOGET,ID_VARTOGET1,ID_VARTOGET2
integer ::NVARDIMS
integer ::NLEN
-integer,DIMENSION(2) ::NLEN2D
+integer, dimension(1) :: NDIMID
+integer,DIMENSION(2) ::NLEN2D, NDIMID2D
integer,DIMENSION(:),ALLOCATABLE :: NVARDIMID,NVARDIMLEN
character(len=80),DIMENSION(:),ALLOCATABLE :: NVARDIMNAM
real,DIMENSION(:),ALLOCATABLE :: ZVALU
@@ -844,7 +945,6 @@ character(len=80) :: YDIM1NAME,YDIM2NAME
integer :: ILONFOUND,ILATFOUND, IARG
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
!
!
@@ -854,10 +954,10 @@ IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:READ_LATLONVAL_CDF',0,ZHOOK_H
status=-9999
kcdf_id=-9999
HACTION='open netcdf'
-status=NF_OPEN(HFILENAME,nf_nowrite,kcdf_id)
+status=NF90_OPEN(HFILENAME,nf90_nowrite,kcdf_id)
!write(0,*) 'status=',status
!write(0,*) 'identifiant de ',HFILENAME,'=',kcdf_id
-if (status/=NF_NOERR) then
+if (status/=NF90_NOERR) then
CALL HANDLE_ERR_MER(status,HACTION)
!else
! write(0,*) 'netcdf file opened: ',HFILENAME
@@ -868,8 +968,8 @@ endif
!* 2. get the number of variables in netcdf file
! ------------------------------------------
HACTION='get number of variables'
-status=NF_INQ_NVARS(kcdf_id,NBVARS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=NF90_INQUIRE(kcdf_id,NVARIABLES=NBVARS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'nb vars', NBVARS
ALLOCATE(VARNAME(NBVARS))
!
@@ -881,8 +981,8 @@ ID_VARTOGET1=0
ID_VARTOGET2=0
DO JLOOP1=1,NBVARS
HACTION='get variables names'
- status=NF_INQ_VARNAME(kcdf_id,JLOOP1,VARNAME(JLOOP1))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=NF90_INQUIRE_VARIABLE(kcdf_id,JLOOP1,NAME=VARNAME(JLOOP1))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'var',JLOOP1,' name: ',VARNAME(JLOOP1)
if (VARNAME(JLOOP1)==HNCVARNAME) then
!write(0,*) 'var',JLOOP1,' corresponding to variable required'
@@ -904,8 +1004,8 @@ else
endif
if (ID_VARTOGET==0) then
HACTION='close netcdf'
- status=nf_close(kcdf_id)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_close(kcdf_id)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
CALL ABOR1_SFX('MODE_READ_NETCDF_MERCATOR: READ_LATLONVAL_CDF')
endif
!-----------
@@ -917,8 +1017,8 @@ endif
! -----------------------------------
!
HACTION='get variable dimensions number'
-status=nf_inq_varndims(kcdf_id,ID_VARTOGET,NVARDIMS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,NDIMS=NVARDIMS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'variable dimensions number = ',NVARDIMS
!
! 4.2 get the variable dimensions length and values
@@ -927,18 +1027,20 @@ SELECT CASE (NVARDIMS)
!CAS 1D
CASE (1)
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(kcdf_id,ID_VARTOGET,NLEN)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,DIMIDS=NDIMID)
+ status=nf90_inquire_dimension(kcdf_id,NDIMID(1),LEN=NLEN)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
ALLOCATE(ZVALU(NLEN))
!write(0,*) 'call GET1DCDF'
CALL GET1DCDF(kcdf_id,ID_VARTOGET,ZMISS,ZVALU)
PVAL(:)=ZVALU(:)
!CAS 2D
CASE (2)
+ status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,DIMIDS=NDIMID2D)
DO JLOOP=1,NVARDIMS
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(kcdf_id,ID_VARTOGET,NLEN2D(JLOOP))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_inquire_dimension(kcdf_id,NDIMID2D(JLOOP),LEN=NLEN2D(JLOOP))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
ENDDO
ALLOCATE(ZVALU2D(NLEN2D(1),NLEN2D(2)))
ALLOCATE(ZDIM1(NLEN2D(1)))
@@ -987,8 +1089,8 @@ END SELECT
!* 10. Close the netcdf file
! ---------------------
HACTION='close netcdf'
-status=nf_close(kcdf_id)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_close(kcdf_id)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'OK: netcdf file closed: ',HFILENAME
!
!-----------
@@ -1012,6 +1114,8 @@ END SUBROUTINE READ_LATLONVAL_CDF
SUBROUTINE READ_LATLONDEPVAL_CDF(HFILENAME,HNCVARNAME,PLON,PLAT,PDEP,PVAL)
! ####################
!
+USE NETCDF
+!
IMPLICIT NONE
!
CHARACTER(LEN=28), INTENT(IN) :: HFILENAME ! Name of the field file.
@@ -1042,7 +1146,6 @@ integer :: ILONFOUND,ILATFOUND,IDEPFOUND
integer :: IARG
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-include 'netcdf.inc'
!
!
!
@@ -1050,8 +1153,8 @@ include 'netcdf.inc'
! --------------------
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:READ_LATLONDEPVAL_CDF',0,ZHOOK_HANDLE)
HACTION='open netcdf'
-status=NF_OPEN(HFILENAME,nf_nowrite,kcdf_id)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=NF90_OPEN(HFILENAME,nf90_nowrite,kcdf_id)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'netcdf file opened: ',HFILENAME
!
!-----------
@@ -1059,8 +1162,8 @@ if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!* 2. get the number of variables in netcdf file
! ------------------------------------------
HACTION='get number of variables'
-status=NF_INQ_NVARS(kcdf_id,NBVARS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=NF90_INQUIRE(kcdf_id,NVARIABLES=NBVARS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'nb vars', NBVARS
ALLOCATE(VARNAME(NBVARS))
!
@@ -1072,8 +1175,8 @@ ID_VARTOGET1=0
ID_VARTOGET2=0
DO JLOOP1=1,NBVARS
HACTION='get variables names'
- status=NF_INQ_VARNAME(kcdf_id,JLOOP1,VARNAME(JLOOP1))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=NF90_INQUIRE_VARIABLE(kcdf_id,JLOOP1,NAME=VARNAME(JLOOP1))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'var',JLOOP1,' name: ',VARNAME(JLOOP1)
if (VARNAME(JLOOP1)==HNCVARNAME) then
!write(0,*) 'var',JLOOP1,' corresponding to variable required'
@@ -1095,8 +1198,8 @@ else
endif
if (ID_VARTOGET==0) then
HACTION='close netcdf'
- status=nf_close(kcdf_id)
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_close(kcdf_id)
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
CALL ABOR1_SFX('MODE_READ_NETCDF_MERCATOR: READ_LATLONDEPVAL_CDF')
endif
!-----------
@@ -1108,13 +1211,13 @@ endif
! -----------------------------------
!
HACTION='get variable dimensions number'
-status=nf_inq_varndims(kcdf_id,ID_VARTOGET,NVARDIMS)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,NDIMS=NVARDIMS)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'variable dimensions number = ',NVARDIMS
ALLOCATE(NVARDIMID(NVARDIMS))
HACTION='get variable dimensions identifiant'
-status=nf_inq_vardimid(kcdf_id,ID_VARTOGET,NVARDIMID)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_inquire_variable(kcdf_id,ID_VARTOGET,DIMIDS=NVARDIMID)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!
!
! 4.2 get the variable dimensions length and values
@@ -1130,8 +1233,8 @@ SELECT CASE (NVARDIMS)
CASE (3)
DO JLOOP=1,NVARDIMS
HACTION='get variable dimensions length'
- status=nf_inq_dimlen(kcdf_id,NVARDIMID(JLOOP),NLEN3D(JLOOP))
- if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+ status=nf90_inquire_dimension(kcdf_id,NVARDIMID(JLOOP),LEN=NLEN3D(JLOOP))
+ if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
ENDDO
ALLOCATE(ZVALU3D(NLEN3D(1),NLEN3D(2),NLEN3D(3)))
ALLOCATE(ZDIM1(NLEN3D(1)))
@@ -1249,8 +1352,8 @@ END SELECT
! ---------------------
HACTION='close netcdf'
!write(0,*) HACTION
-status=nf_close(kcdf_id)
-if (status/=NF_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
+status=nf90_close(kcdf_id)
+if (status/=NF90_NOERR) CALL HANDLE_ERR_MER(status,HACTION)
!write(0,*) 'OK: netcdf file closed: ',HFILENAME
!
!-----------
@@ -1280,6 +1383,8 @@ USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_CSTS, ONLY : XTT
USE MODD_PREP, ONLY : CINTERP_TYPE
!
+USE NETCDF
+!
IMPLICIT NONE
!
CHARACTER(LEN=28), INTENT(IN) :: HFILENAME ! Name of the field file.
@@ -1297,7 +1402,6 @@ REAL :: ZUNDEF=999.
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
-include 'netcdf.inc'
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:READ_NETCDF_SST',0,ZHOOK_HANDLE)
IF (NILENGTH<0) then
@@ -1356,6 +1460,8 @@ END SUBROUTINE READ_NETCDF_SST
USE MODD_GRID_LATLONREGUL, ONLY : NINLAT,NINLON,NINDEPTH,NILENGTH
USE MODD_PREP, ONLY : CINTERP_TYPE
!
+USE NETCDF
+!
IMPLICIT NONE
!
CHARACTER(LEN=28), INTENT(IN) :: HFILENAME ! Name of the field file.
@@ -1369,7 +1475,6 @@ integer :: jloop
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
-include 'netcdf.inc'
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_NETCDF_MERCATOR:READ_NETCDF_ZS_SEA',0,ZHOOK_HANDLE)
if(NINDEPTH>0) then
diff --git a/src/SURFEX/mode_read_surf_asc.F90 b/src/SURFEX/mode_read_surf_asc.F90
index 3f2d717bf4b01cdedee465dc2ef0186aafce635a..98cd7b8ead1a747ae5e721709d9d17518e955215 100644
--- a/src/SURFEX/mode_read_surf_asc.F90
+++ b/src/SURFEX/mode_read_surf_asc.F90
@@ -55,7 +55,7 @@ INTERFACE READ_SURFT_ASC
MODULE PROCEDURE READ_SURFT2_ASC
END INTERFACE
!
- CONTAINS
+CONTAINS
!
! #############################################################
SUBROUTINE READ_SURFX0_ASC (&
@@ -63,10 +63,6 @@ END INTERFACE
! #############################################################
!
!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0
-!
USE MODD_IO_SURF_ASC, ONLY : NUNIT, NLUOUT, CMASK
!
USE MODE_POS_SURF
@@ -101,8 +97,8 @@ KRESP=0
!
YMASK=CMASK
CALL IO_BUFF(&
- HREC,'R',LWORK0)
-IF (LWORK0) YMASK='FULL '
+ HREC,'R',GFOUND)
+IF (GFOUND) YMASK='FULL '
!
CALL POSNAM(NUNIT,YMASK//' '//HREC,GFOUND,NLUOUT)
IF (.NOT. GFOUND) CALL POSNAM(NUNIT,'FULL '//' '//HREC,GFOUND,NLUOUT) ! used for auxilliary files
@@ -129,16 +125,13 @@ END SUBROUTINE READ_SURFX0_ASC
!!**** *READX1* - routine to fill a real 1D array for the externalised surface
!
!
-!
-!
-USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC, NCOMM, NPIO, XTIME_NPIO_READ, XTIME_COMM_READ
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0, XWORKD, NWORKB, CWORK0, NBLOCK
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC, NCOMM, NPIO, XTIME_NPIO_READ, XTIME_COMM_READ, NREQ
!
USE MODD_IO_SURF_ASC, ONLY : NUNIT, NLUOUT, NMASK, NFULL, CMASK
!
USE MODE_POS_SURF
!
+USE MODI_PACK_SAME_RANK
USE MODI_IO_BUFF
USE MODI_ERROR_READ_SURF_ASC
USE MODI_READ_AND_SEND_MPI
@@ -168,10 +161,12 @@ INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem
!
CHARACTER(LEN=6) :: YMASK
INTEGER :: IL1, INFOMPI
+LOGICAL :: GFOUND
!
+REAL, DIMENSION(:), ALLOCATABLE :: ZWORK
REAL :: XTIME0
#ifdef SFX_MPI
-INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+INTEGER, DIMENSION(MPI_STATUS_SIZE,NPROC-1) :: ISTATUS
#endif
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -179,92 +174,80 @@ IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_ASC:READ_SURFX1_ASC',0,ZHOOK_HANDLE)
!
IL1 = SIZE(PFIELD)
!
-!$OMP SINGLE
-NWORKB=0
-!$OMP END SINGLE
+KRESP=0
!
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
#endif
!
IF (HDIR=='-') THEN
-!$OMP SINGLE
- ALLOCATE(XWORKD(IL1))
-!$OMP END SINGLE
+ ALLOCATE(ZWORK(IL1))
ENDIF
!
IF (NRANK==NPIO) THEN
!
-!$OMP SINGLE
- !
IF (HDIR=='A') THEN
- ALLOCATE(XWORKD(IL1))
+ ALLOCATE(ZWORK(IL1))
ELSEIF (HDIR/='-') THEN
- ALLOCATE(XWORKD(NFULL))
+ ALLOCATE(ZWORK(NFULL))
END IF
!
- IF (HDIR=='A') THEN
- CALL POSNAM(NUNIT,CMASK//' '//HREC,LWORK0,NLUOUT)
- IF (.NOT. LWORK0) CALL POSNAM(NUNIT,'FULL '//' '//HREC,LWORK0,NLUOUT)
+ IF (HDIR=='A' .OR. HDIR=='-' .OR. HDIR=='E') THEN
+ CALL POSNAM(NUNIT,CMASK//' '//HREC,GFOUND,NLUOUT)
+ IF (.NOT. GFOUND) CALL POSNAM(NUNIT,'FULL '//' '//HREC,GFOUND,NLUOUT)
ELSE
YMASK=CMASK
CALL IO_BUFF(&
- HREC,'R',LWORK0)
- IF (LWORK0) YMASK='FULL '
- CALL POSNAM(NUNIT,YMASK//' '//HREC,LWORK0,NLUOUT)
+ HREC,'R',GFOUND)
+ IF (GFOUND) YMASK='FULL '
+ CALL POSNAM(NUNIT,YMASK//' '//HREC,GFOUND,NLUOUT)
ENDIF
!
- READ(NUNIT,FMT=*,IOSTAT=NWORKB)
- READ(NUNIT,FMT='(A50)',IOSTAT=NWORKB) CWORK0
- READ(NUNIT,FMT=*,IOSTAT=NWORKB) XWORKD
- !
-!$OMP END SINGLE
+ READ(NUNIT,FMT=*,IOSTAT=KRESP)
+ READ(NUNIT,FMT='(A50)',IOSTAT=KRESP) HCOMMENT
+ READ(NUNIT,FMT=*,IOSTAT=KRESP) ZWORK
!
ELSEIF (HDIR/='-') THEN
-!$OMP SINGLE
- ALLOCATE(XWORKD(0))
-!$OMP END SINGLE
+ ALLOCATE(ZWORK(0))
ENDIF
!
-KRESP = NWORKB
-HCOMMENT = CWORK0
-!
#ifdef SFX_MPI
XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
#endif
!
IF (KRESP/=0) CALL ERROR_READ_SURF_ASC(HREC,KRESP)
!
-IF (HDIR=='A') THEN ! no distribution on other tasks
+IF (HDIR=='E') THEN
+ IF ( NRANK==NPIO ) THEN
+ CALL PACK_SAME_RANK(NMASK,ZWORK(:),PFIELD(:))
+ ENDIF
+ELSEIF (HDIR=='A') THEN ! no distribution on other tasks
IF ( NRANK==NPIO ) THEN
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
#endif
- PFIELD(:) = XWORKD(1:IL1)
+ PFIELD(:) = ZWORK(1:IL1)
#ifdef SFX_MPI
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
#endif
ENDIF
ELSEIF (HDIR=='-') THEN ! distribution of the total field on other tasks
-!$OMP SINGLE
#ifdef SFX_MPI
IF (NPROC>1) THEN
XTIME0 = MPI_WTIME()
- CALL MPI_BCAST(XWORKD,IL1*KIND(XWORKD)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(ZWORK,IL1*KIND(ZWORK)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
ENDIF
#endif
-!$OMP END SINGLE
- PFIELD(:) = XWORKD(1:IL1)
+ PFIELD(:) = ZWORK(1:IL1)
ELSE
- CALL READ_AND_SEND_MPI(XWORKD,PFIELD,NMASK)
+ CALL READ_AND_SEND_MPI(ZWORK,PFIELD,NMASK)
+ !IF (NRANK==NPIO) THEN
+ ! CALL MPI_WAITALL(NPROC-1,NREQ,ISTATUS,INFOMPI)
+ !ENDIF
ENDIF
!
-!$OMP BARRIER
-!
-!$OMP SINGLE
-DEALLOCATE(XWORKD)
-!$OMP END SINGLE
+DEALLOCATE(ZWORK)
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_ASC:READ_SURFX1_ASC',1,ZHOOK_HANDLE)
!
@@ -277,18 +260,13 @@ END SUBROUTINE READ_SURFX1_ASC
!
!!**** *READX2* - routine to fill a real 2D array for the externalised surface
!
-
-!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0, XWORKD2, NWORKB, CWORK0, LWORK0
-!
-USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC, NCOMM, NPIO, XTIME_NPIO_READ, XTIME_COMM_READ
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC, NCOMM, NPIO, XTIME_NPIO_READ, XTIME_COMM_READ, NREQ
!
USE MODD_IO_SURF_ASC, ONLY : NUNIT, NLUOUT, NMASK, NFULL, CMASK
!
USE MODE_POS_SURF
!
+USE MODI_PACK_SAME_RANK
USE MODI_IO_BUFF
USE MODI_ERROR_READ_SURF_ASC
USE MODI_READ_AND_SEND_MPI
@@ -316,12 +294,14 @@ INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a pr
! '-' : no horizontal dim.
!* 0.2 Declarations of local variables
!
+LOGICAL :: GFOUND
CHARACTER(LEN=6) :: YMASK
INTEGER :: IL1, IL2, INFOMPI
!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK2
REAL :: XTIME0
#ifdef SFX_MPI
-INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+INTEGER, DIMENSION(MPI_STATUS_SIZE,NPROC-1) :: ISTATUS
#endif
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -330,92 +310,80 @@ IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_ASC:READ_SURFX2_ASC',0,ZHOOK_HANDLE)
IL1 = SIZE(PFIELD,1)
IL2 = SIZE(PFIELD,2)
!
-!$OMP SINGLE
-NWORKB=0
-!$OMP END SINGLE
+KRESP=0
!
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
#endif
!
IF (HDIR=='-') THEN
-!$OMP SINGLE
- ALLOCATE(XWORKD2(IL1,IL2))
-!$OMP END SINGLE
+ ALLOCATE(ZWORK2(IL1,IL2))
ENDIF
!
IF (NRANK==NPIO) THEN
!
-!$OMP SINGLE
- !
IF (HDIR=='A') THEN
- ALLOCATE(XWORKD2(IL1,IL2))
+ ALLOCATE(ZWORK2(IL1,IL2))
ELSEIF (HDIR/='-') THEN
- ALLOCATE(XWORKD2(NFULL,IL2))
+ ALLOCATE(ZWORK2(NFULL,IL2))
END IF
!
- IF (HDIR=='A') THEN
- CALL POSNAM(NUNIT,CMASK//' '//HREC,LWORK0,NLUOUT)
- IF (.NOT. LWORK0) CALL POSNAM(NUNIT,'FULL '//' '//HREC,LWORK0,NLUOUT)
+ IF (HDIR=='A' .OR. HDIR=='-'.OR.HDIR=='E') THEN
+ CALL POSNAM(NUNIT,CMASK//' '//HREC,GFOUND,NLUOUT)
+ IF (.NOT. GFOUND) CALL POSNAM(NUNIT,'FULL '//' '//HREC,GFOUND,NLUOUT)
ELSE
YMASK=CMASK
CALL IO_BUFF(&
- HREC,'R',LWORK0)
- IF (LWORK0) YMASK='FULL '
- CALL POSNAM(NUNIT,YMASK//' '//HREC,LWORK0,NLUOUT)
+ HREC,'R',GFOUND)
+ IF (GFOUND) YMASK='FULL '
+ CALL POSNAM(NUNIT,YMASK//' '//HREC,GFOUND,NLUOUT)
ENDIF
!
- READ(NUNIT,FMT=*,IOSTAT=NWORKB)
- READ(NUNIT,FMT='(A50)',IOSTAT=NWORKB) CWORK0
- READ(NUNIT,FMT=*,IOSTAT=NWORKB) XWORKD2
- !
-!$OMP END SINGLE
+ READ(NUNIT,FMT=*,IOSTAT=KRESP)
+ READ(NUNIT,FMT='(A50)',IOSTAT=KRESP) HCOMMENT
+ READ(NUNIT,FMT=*,IOSTAT=KRESP) ZWORK2
!
ELSEIF (HDIR/='-') THEN
-!$OMP SINGLE
- ALLOCATE(XWORKD2(0,0))
-!$OMP END SINGLE
+ ALLOCATE(ZWORK2(0,0))
ENDIF
!
-KRESP = NWORKB
-HCOMMENT = CWORK0
-!
#ifdef SFX_MPI
XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
#endif
!
IF (KRESP/=0) CALL ERROR_READ_SURF_ASC(HREC,KRESP)
!
-IF (HDIR=='A') THEN
+IF (HDIR=='E') THEN
+ IF ( NRANK==NPIO ) THEN
+ CALL PACK_SAME_RANK(NMASK,ZWORK2(:,:),PFIELD(:,:))
+ ENDIF
+ELSEIF (HDIR=='A') THEN
IF ( NRANK==NPIO ) THEN
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
#endif
- PFIELD(:,:) = XWORKD2(1:IL1,:)
+ PFIELD(:,:) = ZWORK2(1:IL1,:)
#ifdef SFX_MPI
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
#endif
ENDIF
ELSEIF (HDIR=='-') THEN
-!$OMP SINGLE
#ifdef SFX_MPI
IF (NPROC>1) THEN
XTIME0 = MPI_WTIME()
- CALL MPI_BCAST(XWORKD2,IL1*IL2*KIND(XWORKD2)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(ZWORK2,IL1*IL2*KIND(ZWORK2)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
ENDIF
#endif
-!$OMP END SINGLE
- IF (NRANK==NPIO) PFIELD(:,:) = XWORKD2(1:IL1,:)
+ IF (NRANK==NPIO) PFIELD(:,:) = ZWORK2(1:IL1,:)
ELSE
- CALL READ_AND_SEND_MPI(XWORKD2,PFIELD,NMASK)
+ CALL READ_AND_SEND_MPI(ZWORK2,PFIELD,NMASK)
+ !IF (NRANK==NPIO) THEN
+ ! CALL MPI_WAITALL(NPROC-1,NREQ,ISTATUS,INFOMPI)
+ !ENDIF
ENDIF
!
-!$OMP BARRIER
-!
-!$OMP SINGLE
-DEALLOCATE(XWORKD2)
-!$OMP END SINGLE
+DEALLOCATE(ZWORK2)
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_ASC:READ_SURFX2_ASC',1,ZHOOK_HANDLE)
!
@@ -429,10 +397,6 @@ END SUBROUTINE READ_SURFX2_ASC
!!**** *READN0* - routine to read an integer
!
!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0
-!
USE MODD_IO_SURF_ASC, ONLY : NUNIT, NLUOUT, NMASK, CMASK
!
USE MODE_POS_SURF
@@ -467,8 +431,8 @@ KRESP=0
!
YMASK=CMASK
CALL IO_BUFF(&
- HREC,'R',LWORK0)
-IF (LWORK0) YMASK='FULL '
+ HREC,'R',GFOUND)
+IF (GFOUND) YMASK='FULL '
!
CALL POSNAM(NUNIT,YMASK//' '//HREC,GFOUND,NLUOUT)
IF (.NOT. GFOUND) CALL POSNAM(NUNIT,'FULL '//' '//HREC,GFOUND,NLUOUT) ! used for auxilliary files
@@ -499,8 +463,6 @@ END SUBROUTINE READ_SURFN0_ASC
!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC, NCOMM, NPIO, XTIME_NPIO_READ, XTIME_COMM_READ
!
-USE MODD_SURFEx_OMP, ONLY : LWORK0, CWORK0, NWORKD, NWORKB
-!
USE MODD_IO_SURF_ASC, ONLY : NUNIT, NLUOUT, NMASK, NFULL, CMASK
!
USE MODE_POS_SURF
@@ -535,66 +497,57 @@ INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a prob
CHARACTER(LEN=6) :: YMASK
INTEGER :: IL1, INFOMPI
!
+INTEGER, DIMENSION(:), ALLOCATABLE :: IWORK
#ifdef SFX_MPI
INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
#endif
REAL :: XTIME0
+LOGICAL :: GFOUND
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_ASC:READ_SURFN1_ASC',0,ZHOOK_HANDLE)
!
IL1 = SIZE(KFIELD)
!
-!$OMP SINGLE
-NWORKB = 0
-!$OMP END SINGLE
+KRESP = 0
!
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
#endif
!
IF (HDIR=='-') THEN
-!$OMP SINGLE
- ALLOCATE(NWORKD(IL1))
-!$OMP END SINGLE
+ ALLOCATE(IWORK(IL1))
ENDIF
!
IF (NRANK==NPIO) THEN
!
-!$OMP SINGLE
!
IF (HDIR=='A') THEN
- ALLOCATE(NWORKD(IL1))
+ ALLOCATE(IWORK(IL1))
ELSEIF (HDIR/='-') THEN
- ALLOCATE(NWORKD(NFULL))
+ ALLOCATE(IWORK(NFULL))
END IF
!
- IF (HDIR=='A') THEN
- CALL POSNAM(NUNIT,CMASK//' '//HREC,LWORK0,NLUOUT)
- IF (.NOT. LWORK0) CALL POSNAM(NUNIT,'FULL '//' '//HREC,LWORK0,NLUOUT)
+ IF (HDIR=='A' .OR. HDIR=='-') THEN
+ CALL POSNAM(NUNIT,CMASK//' '//HREC,GFOUND,NLUOUT)
+ IF (.NOT. GFOUND) CALL POSNAM(NUNIT,'FULL '//' '//HREC,GFOUND,NLUOUT)
ELSE
YMASK=CMASK
CALL IO_BUFF(&
- HREC,'R',LWORK0)
- IF (LWORK0) YMASK='FULL '
- CALL POSNAM(NUNIT,YMASK//' '//HREC,LWORK0,NLUOUT)
+ HREC,'R',GFOUND)
+ IF (GFOUND) YMASK='FULL '
+ CALL POSNAM(NUNIT,YMASK//' '//HREC,GFOUND,NLUOUT)
ENDIF
!
- READ(NUNIT,FMT=*,IOSTAT=NWORKB)
- READ(NUNIT,FMT='(A50)',IOSTAT=NWORKB) CWORK0
- READ(NUNIT,FMT=*,IOSTAT=NWORKB) NWORKD
+ READ(NUNIT,FMT=*,IOSTAT=KRESP)
+ READ(NUNIT,FMT='(A50)',IOSTAT=KRESP) HCOMMENT
+ READ(NUNIT,FMT=*,IOSTAT=KRESP) IWORK
!
-!$OMP END SINGLE
!
ELSEIF (HDIR/='-') THEN
-!$OMP SINGLE
- ALLOCATE(NWORKD(0))
-!$OMP END SINGLE
+ ALLOCATE(IWORK(0))
ENDIF
!
-KRESP = NWORKB
-HCOMMENT = CWORK0
-!
#ifdef SFX_MPI
XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
#endif
@@ -606,31 +559,25 @@ IF (HDIR=='A') THEN
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
#endif
- KFIELD(:) = NWORKD(1:IL1)
+ KFIELD(:) = IWORK(1:IL1)
#ifdef SFX_MPI
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
#endif
ENDIF
ELSEIF (HDIR=='-') THEN
-!$OMP SINGLE
#ifdef SFX_MPI
IF (NPROC>1) THEN
XTIME0 = MPI_WTIME()
- CALL MPI_BCAST(NWORKD,IL1*KIND(NWORKD)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(IWORK,IL1*KIND(IWORK)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
ENDIF
#endif
-!$OMP END SINGLE
- KFIELD(:) = NWORKD(1:IL1)
+ KFIELD(:) = IWORK(1:IL1)
ELSE
- CALL READ_AND_SEND_MPI(NWORKD,KFIELD,NMASK)
+ CALL READ_AND_SEND_MPI(IWORK,KFIELD,NMASK)
ENDIF
!
-!$OMP BARRIER
-!
-!$OMP SINGLE
-DEALLOCATE(NWORKD)
-!$OMP END SINGLE
+DEALLOCATE(IWORK)
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_ASC:READ_SURFN1_ASC',1,ZHOOK_HANDLE)
!
@@ -643,11 +590,6 @@ END SUBROUTINE READ_SURFN1_ASC
!
!!**** *READC0* - routine to read a character
!
-!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0
-!
USE MODD_IO_SURF_ASC, ONLY : NUNIT, NLUOUT, CMASK
!
USE MODE_POS_SURF
@@ -683,8 +625,8 @@ KRESP=0
!
YMASK=CMASK
CALL IO_BUFF(&
- HREC,'R',LWORK0)
-IF (LWORK0) YMASK='FULL '
+ HREC,'R',GFOUND)
+IF (GFOUND) YMASK='FULL '
!
CALL POSNAM(NUNIT,YMASK//' '//HREC,GFOUND,NLUOUT)
IF (.NOT. GFOUND) CALL POSNAM(NUNIT,'FULL '//' '//HREC,GFOUND,NLUOUT) ! used for auxilliary files
@@ -708,11 +650,6 @@ END SUBROUTINE READ_SURFC0_ASC
!
!!**** *READL0* - routine to read a logical
!
-!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0
-!
USE MODD_IO_SURF_ASC, ONLY : NUNIT, NLUOUT, CMASK
!
USE MODE_POS_SURF
@@ -746,8 +683,8 @@ KRESP=0
!
YMASK=CMASK
CALL IO_BUFF(&
- HREC,'R',LWORK0)
-IF (LWORK0) YMASK='FULL '
+ HREC,'R',GFOUND)
+IF (GFOUND) YMASK='FULL '
!
CALL POSNAM(NUNIT,YMASK//' '//HREC,GFOUND,NLUOUT)
IF (.NOT. GFOUND) CALL POSNAM(NUNIT,'FULL '//' '//HREC,GFOUND,NLUOUT) ! used for auxilliary files
@@ -773,11 +710,6 @@ END SUBROUTINE READ_SURFL0_ASC
!
!!**** *READL1* - routine to read a logical array
!
-!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0, LWORKD, NWORKB, CWORK0
-!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC, NCOMM, NPIO, XTIME_NPIO_READ, XTIME_COMM_READ
!
USE MODD_IO_SURF_ASC, ONLY : NUNIT, NLUOUT, CMASK
@@ -813,47 +745,38 @@ INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a prob
CHARACTER(LEN=6) :: YMASK
INTEGER :: INFOMPI, IL1
REAL :: XTIME0
+LOGICAL :: GFOUND
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_ASC:READ_SURFL1_ASC',0,ZHOOK_HANDLE)
!
IL1 = SIZE(OFIELD)
!
-NWORKB = 0
+KRESP = 0
!
-!$OMP BARRIER
!
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP SINGLE
-ALLOCATE(LWORKD(IL1))
-!$OMP END SINGLE
-!
IF (NRANK==NPIO) THEN
!
-!$OMP SINGLE
!
YMASK=CMASK
CALL IO_BUFF(&
- HREC,'R',LWORK0)
- IF (LWORK0) YMASK='FULL '
+ HREC,'R',GFOUND)
+ IF (GFOUND) YMASK='FULL '
!
- CALL POSNAM(NUNIT,YMASK//' '//HREC,LWORK0,NLUOUT)
- IF (.NOT. LWORK0) CALL POSNAM(NUNIT,'FULL '//' '//HREC,LWORK0,NLUOUT) ! used for auxilliary files
+ CALL POSNAM(NUNIT,YMASK//' '//HREC,GFOUND,NLUOUT)
+ IF (.NOT. GFOUND) CALL POSNAM(NUNIT,'FULL '//' '//HREC,GFOUND,NLUOUT) ! used for auxilliary files
!
- READ(NUNIT,FMT=*,IOSTAT=NWORKB)
- READ(NUNIT,FMT='(A50)',IOSTAT=NWORKB) CWORK0
- READ(NUNIT,FMT=*,IOSTAT=NWORKB) LWORKD
+ READ(NUNIT,FMT=*,IOSTAT=KRESP)
+ READ(NUNIT,FMT='(A50)',IOSTAT=KRESP) HCOMMENT
+ READ(NUNIT,FMT=*,IOSTAT=KRESP) OFIELD
!
-!$OMP END SINGLE
!
ENDIF
!
-KRESP = NWORKB
-HCOMMENT = CWORK0
-!
#ifdef SFX_MPI
XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
#endif
@@ -862,16 +785,12 @@ IF (KRESP/=0) CALL ERROR_READ_SURF_ASC(HREC,KRESP)
!
#ifdef SFX_MPI
IF (NPROC>1 .AND. HDIR/='A') THEN
-!$OMP SINGLE
XTIME0 = MPI_WTIME()
- CALL MPI_BCAST(LWORKD,IL1,MPI_LOGICAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(OFIELD,IL1,MPI_LOGICAL,NPIO,NCOMM,INFOMPI)
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
-!$OMP END SINGLE
ENDIF
#endif
!
-OFIELD = LWORKD
-!
IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_ASC:READ_SURFL1_ASC',1,ZHOOK_HANDLE)
!
END SUBROUTINE READ_SURFL1_ASC
@@ -888,7 +807,6 @@ END SUBROUTINE READ_SURFL1_ASC
!
!
USE MODD_SURFEX_MPI, ONLY : NRANK
-USE MODD_SURFEX_OMP, ONLY : LWORK0, NBLOCK
!
USE MODD_IO_SURF_ASC, ONLY : NUNIT, NLUOUT, CMASK
!
@@ -927,8 +845,8 @@ KRESP=0
!
YMASK=CMASK
CALL IO_BUFF(&
- HREC,'R',LWORK0)
-IF (LWORK0) YMASK='FULL '
+ HREC,'R',GFOUND)
+IF (GFOUND) YMASK='FULL '
!
CALL POSNAM(NUNIT,YMASK//' '//TRIM(HREC)//'%TDATE',GFOUND,NLUOUT)
!IF (.NOT. GFOUND) CALL POSNAM(NUNIT,'FULL '//' '//HREC,GFOUND,NLUOUT) ! used for auxilliary files
@@ -970,7 +888,6 @@ END SUBROUTINE READ_SURFT0_ASC
!
!
USE MODD_SURFEX_MPI, ONLY : NRANK
-USE MODD_SURFEX_OMP, ONLY : LWORK0, NBLOCK
!
USE MODD_IO_SURF_ASC, ONLY : NUNIT, NLUOUT, CMASK
!
@@ -1010,8 +927,8 @@ KRESP=0
!
YMASK=CMASK
CALL IO_BUFF(&
- HREC,'R',LWORK0)
-IF (LWORK0) YMASK='FULL '
+ HREC,'R',GFOUND)
+IF (GFOUND) YMASK='FULL '
!
CALL POSNAM(NUNIT,YMASK//' '//TRIM(HREC)//'%TDATE',GFOUND,NLUOUT)
!
@@ -1047,10 +964,6 @@ END SUBROUTINE READ_SURFT1_ASC
!!**** *READT2* - routine to read a date
!
!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0
-!
USE MODD_IO_SURF_ASC, ONLY : NUNIT, NLUOUT, CMASK
!
USE MODE_POS_SURF
@@ -1089,8 +1002,8 @@ KRESP=0
!
YMASK=CMASK
CALL IO_BUFF(&
- HREC,'R',LWORK0)
-IF (LWORK0) YMASK='FULL '
+ HREC,'R',GFOUND)
+IF (GFOUND) YMASK='FULL '
!
CALL POSNAM(NUNIT,YMASK//' '//TRIM(HREC)//'%TDATE',GFOUND,NLUOUT)
!
diff --git a/src/SURFEX/mode_read_surf_cov.F90 b/src/SURFEX/mode_read_surf_cov.F90
index 311fe54e8a5e881c17b89ba417346da6fb66f39d..1a745624a059d80653d6c67a443f2f8b17c5be26 100644
--- a/src/SURFEX/mode_read_surf_cov.F90
+++ b/src/SURFEX/mode_read_surf_cov.F90
@@ -4,33 +4,55 @@
!SFX_LIC for details. version 1.
MODULE MODE_READ_SURF_COV
-
-!RJ: split cover from read_surf.F90 to avoid compiler bugs
-!RJ: all safety compatibility checks should be done here
-PUBLIC :: READ_SURF_COV
-
- CONTAINS
+!
+INTERFACE WRITE_READ_COV
+ MODULE PROCEDURE READ_SURF_COV
+END INTERFACE
+!
+CONTAINS
! #############################################################
- SUBROUTINE READ_SURF_COV (&
- HPROGRAM,HREC,PFIELD,OFLAG,KRESP,HCOMMENT,HDIR)
+ SUBROUTINE READ_SURF_COV (HPROGRAM,HREC,PFIELD,OFLAG,KRESP,HCOMMENT,HDIR)
! #############################################################
!
!
!
-!
+USE MODD_SURFEX_MPI, ONLY : NPROC, NPIO, NRANK, IDX_R, NREQ, NCOMM, NSIZE, NINDEX
USE MODD_SURF_PAR, ONLY : XUNDEF
!
-USE MODI_READ_SURF
+#ifdef SFX_LFI
+USE MODD_IO_SURF_LFI, ONLY : NMASK_lfi=>NMASK, NFULL_lfi=>NFULL
+#endif
+#ifdef SFX_NC
+USE MODD_IO_SURF_NC, ONLY : NMASK_nc=>NMASK, NFULL_nc=>NFULL
+#endif
+#ifdef SFX_ASC
+USE MODD_IO_SURF_ASC, ONLY : NMASK_asc=>NMASK, NFULL_asc=>NFULL
+#endif
+#ifdef SFX_FA
+USE MODD_IO_SURF_FA, ONLY : NMASK_fa=>NMASK, NFULL_fa=>NFULL
+#endif
#ifdef SFX_MNH
USE MODI_READ_SURFX2COV_MNH
#endif
!
+USE MODI_READ_SURF
+USE MODI_PACK_SAME_RANK
+USE MODI_READ_AND_SEND_MPI
+USE MODI_ABOR1_SFX
+#ifdef SFX_ARO
+USE MODI_READ_SURFX1_ARO
+#endif
+!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1 Declarations of arguments
!
!
@@ -47,54 +69,286 @@ INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem
! ! '-' : no horizontal dim.
!* 0.2 Declarations of local variables
!
+#ifdef SFX_MPI
+INTEGER, DIMENSION(MPI_STATUS_SIZE,NPROC-1) :: ISTATUS
+#endif
+!INTEGER, DIMENSION(NPROC) :: ITREQ
+REAL, DIMENSION(:),ALLOCATABLE :: ZWORKR
+REAL, DIMENSION(:),ALLOCATABLE :: ZFIELD
+INTEGER, DIMENSION(:), POINTER :: IMASKF
+INTEGER, DIMENSION(COUNT(OFLAG)) :: IMASK
CHARACTER(LEN=100) :: YCOMMENT
- CHARACTER(LEN=LEN_HREC) :: YREC
+ CHARACTER(LEN=LEN_HREC) :: YREC
+ CHARACTER(LEN=LEN_HREC) :: YREC2
CHARACTER(LEN=1) :: YDIR
-INTEGER :: JJ
-INTEGER :: JCOVER
-INTEGER :: IL1, IL2
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ CHARACTER(LEN=4) :: YLVL
+INTEGER :: IFLAG
+INTEGER :: IPIO_SAVE, IPAS, JP, IDEB, IFIN, JJ
+INTEGER :: JCOVER, JPROC, IPROC
+INTEGER :: IL1, IL2, IDX_SAVE, IDX, IVAL
+INTEGER :: INFOMPI, IREQ, JPROC2, IFULL
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!
-IF (LHOOK) CALL DR_HOOK('READ_SURF_COV',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('READ_SURF_COV_1',0,ZHOOK_HANDLE)
!
+IDX_SAVE = IDX_R
YREC = HREC
YCOMMENT="empty"
YDIR = 'H'
IF (PRESENT(HDIR)) YDIR = HDIR
!
IL1 = SIZE(PFIELD,1)
-IL2 = SIZE(PFIELD,2)
+IL2 = COUNT(OFLAG)
!
-PFIELD(:,:)=XUNDEF
+IF (LHOOK) CALL DR_HOOK('READ_SURF_COV_1',1,ZHOOK_HANDLE)
!
IF (HPROGRAM=='MESONH') THEN
#ifdef SFX_MNH
- CALL READ_SURFX2COV_MNH(YREC,IL1,IL2,PFIELD,OFLAG,KRESP,YCOMMENT,YDIR)
+ YREC2 = YREC
+ CALL READ_SURFX2COV_MNH(YREC2,IL1,IL2,PFIELD,OFLAG,KRESP,YCOMMENT,YDIR)
#endif
ELSE
!
+ IF (LHOOK) CALL DR_HOOK('READ_SURF_COV_2',0,ZHOOK_HANDLE)
+ !
+ !mask associating the index of the cover in xcover to its real number
JCOVER = 0
- DO JJ=1,SIZE(OFLAG)
+ DO JJ = 1,SIZE(OFLAG)
+ IF (OFLAG(JJ)) THEN
+ JCOVER=JCOVER+1
+ IMASK(JCOVER) = JJ
+ ENDIF
+ ENDDO
+ !
+ !the mask to call read_and_send_mpi depends on the I/O type
+ IF (HPROGRAM=='LFI ') THEN
+#ifdef SFX_LFI
+ IFULL = NFULL_lfi
+ ALLOCATE(ZFIELD(NFULL_lfi))
+ IMASKF=>NMASK_lfi
+#endif
+ ELSEIF (HPROGRAM=='ASCII ') THEN
+#ifdef SFX_ASC
+ IFULL = NFULL_asc
+ ALLOCATE(ZFIELD(NFULL_asc))
+ IMASKF=>NMASK_asc
+#endif
+ ELSEIF (HPROGRAM=='FA ') THEN
+#ifdef SFX_FA
+ IFULL = NFULL_fa
+ ALLOCATE(ZFIELD(NFULL_fa))
+ IMASKF=>NMASK_fa
+#endif
+ ELSEIF (HPROGRAM=='NC ') THEN
+#ifdef SFX_NC
+ IFULL = NFULL_nc
+ ALLOCATE(ZFIELD(NFULL_nc))
+ IMASKF=>NMASK_nc
+#endif
+ ENDIF
+ !
+ !if we want to get covers for the current task or for the whole domain
+ IF (YDIR=='H') THEN
+ !second dimension because the reading of covers is parallelized with MPI
+ ALLOCATE(ZWORKR(NSIZE))
+ ELSEIF (NRANK==NPIO) THEN
+ ALLOCATE(ZWORKR(IFULL))
+ ELSE
+ ALLOCATE(ZWORKR(0))
+ ENDIF
+ ZWORKR(:) = 0.
+ !
+ IF (NPROC>1 .AND. YDIR=='H') THEN
+ IFLAG = 0
+ !for the parallelization of reading, NINDEX must be known by all tasks
+ IF (NRANK/=NPIO) THEN
+ IF (ALLOCATED(NINDEX)) THEN
+ IF (SIZE(NINDEX)==IFULL) IFLAG=1
+ DEALLOCATE(NINDEX)
+ ENDIF
+ ALLOCATE(NINDEX(IFULL))
+ ENDIF
+#ifdef SFX_MPI
+ CALL MPI_BCAST(NINDEX,SIZE(NINDEX)*KIND(NINDEX)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ ENDIF
+ !
+ IPIO_SAVE = NPIO
+ !number of covers read by each task
+ IPAS = CEILING(IL2*1./NPROC)
+ !
+ PFIELD(:,:) = 0.
+ !
+ !first cover number read by the current task
+ IDEB = IPAS*NRANK
+ !
+ IF (LHOOK) CALL DR_HOOK('READ_SURF_COV_2',1,ZHOOK_HANDLE)
+ !
+ DO JP = 1,IPAS
!
- IF (.NOT. OFLAG(JJ)) CYCLE
+ IF (LHOOK) CALL DR_HOOK('READ_SURF_COV_3',0,ZHOOK_HANDLE)
!
- JCOVER = JCOVER + 1
+ !index of the cover read by this task at this loop index
+ JCOVER = IDEB + JP
!
- WRITE(YREC,'(A5,I3.3)') 'COVER',JJ
- YCOMMENT='X_Y_'//YREC
-!RJ: xundef is done for whole array above, to ensure status INTENT(OUT)
-!RJ PFIELD(:,JCOVER)=0.
+ IF (JCOVER<=IL2) THEN
+ !
+ !real number of the cover
+ JJ = IMASK(JCOVER)
+ !
+ IF (TRIM(HREC)=='COVER') THEN
+ WRITE(YREC,'(A5,I3.3)') TRIM(HREC),JJ
+ ELSE
+ WRITE(YLVL,'(I4)') JJ
+ YREC = TRIM(HREC)//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ ENDIF
+ YCOMMENT='X_Y_'//YREC
+ !
+ !
+ IF (HPROGRAM=='AROME ') THEN
+#ifdef ARO
+ CALL READ_SURFX1_ARO(YREC,IL1,PFIELD(:,JCOVER),KRESP,YCOMMENT,YDIR)
+#endif
+ ELSE
+ !
+ !reads one cover by task
+ !
+ !number of the I/O task for this read
+ NPIO = NRANK
+ !
+ !reading of the whol cover (HDIR='A')
+ CALL READ_SURF(HPROGRAM,YREC,ZFIELD,KRESP,YCOMMENT,'A')
+ !
+ !NPIO rebecomes the I/O task
+ NPIO = IPIO_SAVE
+ !
+ IDX = IDX_SAVE + JP
+ IF (YDIR=='H') THEN
+ !
+ !send covers to other tasks
+ CALL READ_AND_SEND_MPI(ZFIELD,PFIELD(:,JCOVER),IMASKF,NRANK,IDX)
+ !
+ ELSEIF (YDIR=='A' .OR. YDIR=='E') THEN
+ !
+ !NPIO needs to know all covers read
+ IF (NRANK/=NPIO) THEN
+ IDX = IDX + 1
+#ifdef SFX_MPI
+ CALL MPI_SEND(ZFIELD,SIZE(ZFIELD)*KIND(ZFIELD)/4,MPI_REAL,NPIO,IDX,NCOMM,INFOMPI)
+#endif
+ ELSE
+ CALL PACK_SAME_RANK(IMASKF,ZFIELD,PFIELD(:,JCOVER))
+ ENDIF
+ !
+ ELSE
+ CALL ABOR1_SFX("READ_SURFX2COV:HDIR MUST BE H OR A OR E")
+ ENDIF
+ !
+ ENDIF
+ !
+ ENDIF
!
- CALL READ_SURF(HPROGRAM,YREC,PFIELD(:,JCOVER),KRESP,YCOMMENT,YDIR)
+ IF (LHOOK) CALL DR_HOOK('READ_SURF_COV_3',1,ZHOOK_HANDLE)
!
- END DO
+ IF (NRANK==NPIO .OR. YDIR=='H') THEN
+ !
+ !receives pieces of cover fields
+ !ITREQ(:) = 0
+ !
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('READ_SURF_COV_4',0,ZHOOK_HANDLE_OMP)
+#ifdef SFX_MPI
+!$OMP DO SCHEDULE(DYNAMIC,1) PRIVATE(JPROC,IDX,ISTATUS,INFOMPI) FIRSTPRIVATE(ZWORKR)
+#endif
+ DO JPROC=0,NPROC-1
+ !
+ !the cover exists and was read
+ IF (IPAS*JPROC + JP<=IL2) THEN
+ !
+ !IF (JPROC<NRANK) THEN
+ ! ITREQ(JPROC+1) = JPROC+1
+ !ELSE
+ ! ITREQ(JPROC+1) = JPROC
+ !ENDIF
+ !
+ IF (JPROC/=NRANK) THEN
+ IDX = IDX_SAVE + JP + 1
+ !each task receives the part of the cover read that concerns it
+ !only NPIO in cas of HDIR/=H
+#ifdef SFX_MPI
+ CALL MPI_RECV(ZWORKR(:),SIZE(ZWORKR)*KIND(ZWORKR)/4,&
+ MPI_REAL,JPROC,IDX,NCOMM,ISTATUS,INFOMPI)
+#endif
+ IVAL = IPAS*JPROC + JP
+ CALL PACK_SAME_RANK(IMASKF,ZWORKR(:),PFIELD(:,IVAL))
+ !
+ ENDIF
+ !
+ ENDIF
+ !
+ ENDDO
+#ifdef SFX_MPI
+!$OMP END DO
+#endif
+IF (LHOOK) CALL DR_HOOK('READ_SURF_COV_4',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
+
+!
+ IF (LHOOK) CALL DR_HOOK('READ_SURF_COV_5',0,ZHOOK_HANDLE)
+ !
+ !waits that all cover pieces are sent
+#ifdef SFX_MPI
+ IF (YDIR=='H' .AND. IPAS*NRANK+JP<=IL2 .AND. NPROC>1) THEN
+ CALL MPI_WAITALL(NPROC-1,NREQ(1:NPROC-1),ISTATUS,INFOMPI)
+ ENDIF
+#endif
+ !
+ IF (LHOOK) CALL DR_HOOK('READ_SURF_COV_5',1,ZHOOK_HANDLE)
+ !
+! IF (YDIR=='H' .OR. NRANK==NPIO) THEN
+! !packs data
+! IREQ = MAXVAL(ITREQ)
+!!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+!IF (LHOOK) CALL DR_HOOK('READ_SURF_COV_6',0,ZHOOK_HANDLE_OMP)
+!!$OMP DO SCHEDULE(DYNAMIC,1) PRIVATE(JPROC,IVAL)
+! DO JPROC=0,IREQ-1
+! IVAL = IPAS*JPROC + JP
+! IF (JPROC>=NRANK ) IVAL = IVAL + IPAS
+! CALL PACK_SAME_RANK(IMASKF,ZWORKR(:,JPROC+1),PFIELD(:,IVAL))
+! ENDDO
+!!$OMP END DO
+!IF (LHOOK) CALL DR_HOOK('READ_SURF_COV_6',1,ZHOOK_HANDLE_OMP)
+!!$OMP END PARALLEL
+! ENDIF
+ !
+ ENDIF
+ !
+ ENDDO
+ !
+ IF (LHOOK) CALL DR_HOOK('READ_SURF_COV_7',0,ZHOOK_HANDLE)
+ !
+ IF (NRANK/=NPIO .AND. YDIR=='H' .AND. IFLAG==0) THEN
+ DEALLOCATE(NINDEX)
+ ALLOCATE(NINDEX(0))
+ ENDIF
+ !
+ IDX_R = IDX_R + IPAS + 1
+ DEALLOCATE(ZWORKR)
+ IF (HPROGRAM /= 'AROME ') THEN
+ DEALLOCATE(ZFIELD)
+ ENDIF
+ IMASKF=>NULL()
+ !
+ IF (LHOOK) CALL DR_HOOK('READ_SURF_COV_7',1,ZHOOK_HANDLE)
!
ENDIF
!
+IF (LHOOK) CALL DR_HOOK('READ_SURF_COV_8',0,ZHOOK_HANDLE)
+!
!RJ: what is a point of comment here? last field comment? Should be 'COVER_PACKED' status?
IF (PRESENT(HCOMMENT)) HCOMMENT = YCOMMENT
!
-IF (LHOOK) CALL DR_HOOK('READ_SURF_COV',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('READ_SURF_COV_8',1,ZHOOK_HANDLE)
!
END SUBROUTINE READ_SURF_COV
diff --git a/src/SURFEX/mode_read_surf_fa.F90 b/src/SURFEX/mode_read_surf_fa.F90
index 81addfc63827a5c36d7fd998d2df75d5ab969dbe..ae8bf8f51703144281b4185f3780270558fcea01 100644
--- a/src/SURFEX/mode_read_surf_fa.F90
+++ b/src/SURFEX/mode_read_surf_fa.F90
@@ -58,7 +58,7 @@ END INTERFACE
!
!----------------------------------------------------------------------------
!
- CONTAINS
+CONTAINS
!
!----------------------------------------------------------------------------
!
@@ -89,7 +89,7 @@ IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:SFX_FA_VERSION',0,ZHOOK_HANDLE)
!
IRESP=0
!
- CALL FANION(IRESP,NUNIT_FA,CPREFIX1D,0,'VERSION',ONEW,GWORK,INGRIB,INBITS,ISTRON,IPUILA)
+CALL FANION(IRESP,NUNIT_FA,CPREFIX1D,0,'VERSION',ONEW,GWORK,INGRIB,INBITS,ISTRON,IPUILA)
IF (IRESP/=0) CALL ERROR_READ_SURF_FA('FULLVERSION',IRESP)
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:SFX_FA_VERSION',1,ZHOOK_HANDLE)
@@ -105,11 +105,6 @@ END SUBROUTINE SFX_FA_VERSION
!
!!**** *READX0* - routine to read a real scalar
!
-!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0
-!
USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, NLUOUT, CMASK, CPREFIX1D
!
USE MODE_FASURFEX
@@ -126,17 +121,17 @@ IMPLICIT NONE
!
!
!
- CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
+CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
REAL, INTENT(OUT) :: PFIELD ! the real scalar to be read
INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
- CHARACTER(LEN=100),INTENT(OUT) :: HCOMMENT ! comment
+CHARACTER(LEN=100),INTENT(OUT) :: HCOMMENT ! comment
!
!* 0.2 Declarations of local variables
!
- CHARACTER(LEN=50) :: YCOMMENT
- CHARACTER(LEN=6) :: YMASK
- CHARACTER(LEN=18) :: YNAME ! Field Name
-LOGICAL :: GV8
+CHARACTER(LEN=50) :: YCOMMENT
+CHARACTER(LEN=6) :: YMASK
+CHARACTER(LEN=18) :: YNAME ! Field Name
+LOGICAL :: GV8, GFOUND
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -144,19 +139,19 @@ IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFX0_FA',0,ZHOOK_HANDLE)
!
KRESP=0
!
- CALL IO_BUFF(&
- HREC,'R',LWORK0)
+CALL IO_BUFF(&
+ HREC,'R',GFOUND)
!
- CALL SFX_FA_VERSION(GV8)
+CALL SFX_FA_VERSION(GV8)
IF(GV8)THEN
YNAME=CPREFIX1D//TRIM(HREC)
ELSE
YMASK=CMASK
- IF (LWORK0) YMASK='FULL '
+ IF (GFOUND) YMASK='FULL '
YNAME=TRIM(YMASK)//TRIM(HREC)
ENDIF
!
- CALL FALIT_R(KRESP,NUNIT_FA,YNAME,PFIELD)
+CALL FALIT_R(KRESP,NUNIT_FA,YNAME,PFIELD)
IF (KRESP/=0) CALL ERROR_READ_SURF_FA(HREC,KRESP)
!
YCOMMENT = TRIM(YNAME)
@@ -174,16 +169,15 @@ END SUBROUTINE READ_SURFX0_FA
!
!!**** *READX1* - routine to fill a real 1D array for the externalised surface
!
-USE MODD_SURFEX_OMP, ONLY : XWORKD, NWORKB, CWORK0
-!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC, NCOMM, NPIO, XTIME_NPIO_READ, XTIME_COMM_READ, &
- WLOG_MPI
+ WLOG_MPI, NREQ
!
USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, NLUOUT, NMASK, NFULL, NFULL_EXT, &
NDGL, NDLON, NDGUX, NDLUX, CPREFIX1D
!
USE MODE_FASURFEX
!
+USE MODI_PACK_SAME_RANK
USE MODI_ERROR_READ_SURF_FA
USE MODI_READ_AND_SEND_MPI
!
@@ -198,37 +192,34 @@ INCLUDE "mpif.h"
!
!* 0.1 Declarations of arguments
!
- CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
+CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
INTEGER, INTENT(IN) :: KL ! number of points
REAL, DIMENSION(:), INTENT(OUT) :: PFIELD ! array containing the data field
INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
- CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
- CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field :
+CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
+CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field :
! 'H' : field with
! horizontal spatial dim.
! '-' : no horizontal dim.
!* 0.2 Declarations of local variables
!
- CHARACTER(LEN=4) :: YPREFIX
- CHARACTER(LEN=3) :: YPREF
+CHARACTER(LEN=4) :: YPREFIX
+CHARACTER(LEN=3) :: YPREF
LOGICAL :: GV8
!
INTEGER :: I, J, INFOMPI
#ifdef SFX_MPI
-INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+INTEGER, DIMENSION(MPI_STATUS_SIZE,NPROC-1) :: ISTATUS
#endif
!
-REAL, DIMENSION(:), ALLOCATABLE :: ZWORK2
+REAL, DIMENSION(:), ALLOCATABLE :: ZWORK2, ZWORK
REAL :: XTIME0
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFX1_FA',0,ZHOOK_HANDLE)
!
-!$OMP BARRIER
!
-!$OMP SINGLE
-NWORKB=0
-!$OMP END SINGLE
+KRESP=0
!
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
@@ -236,23 +227,21 @@ XTIME0 = MPI_WTIME()
!
IF (NRANK==NPIO) THEN
!
-!$OMP SINGLE
- !
- ALLOCATE(XWORKD(NFULL))
+ ALLOCATE(ZWORK(NFULL))
!
YPREF=HREC(1:3)
!
IF (YPREF=='CLS' .OR. YPREF=='SUR' .OR. YPREF=='PRO' .OR. YPREF=='ATM') THEN
ALLOCATE(ZWORK2(NFULL_EXT))
CALL FACILE(KRESP,NUNIT_FA,HREC(1:4),0,HREC(5:16),ZWORK2,.FALSE.)
- IF (KRESP/=0) CALL ERROR_READ_SURF_FA(HREC,NWORKB)
+ IF (KRESP/=0) CALL ERROR_READ_SURF_FA(HREC,KRESP)
DO J=1,NDGUX
DO I=1,NDLUX
- XWORKD((J-1)*NDLUX + I) = ZWORK2((J-1)*NDLON + I)
+ ZWORK((J-1)*NDLUX + I) = ZWORK2((J-1)*NDLON + I)
ENDDO
ENDDO
DEALLOCATE(ZWORK2)
- CWORK0 = TRIM(HREC)
+ HCOMMENT = TRIM(HREC)
ELSE
CALL SFX_FA_VERSION(GV8)
IF(GV8)THEN
@@ -260,32 +249,29 @@ IF (NRANK==NPIO) THEN
ELSE
YPREFIX='S1D_'
ENDIF
- CALL FACILE(NWORKB,NUNIT_FA,YPREFIX,0,HREC,XWORKD,.FALSE.)
- IF (NWORKB/=0) CALL ERROR_READ_SURF_FA(HREC,NWORKB)
- CWORK0 = YPREFIX//TRIM(HREC)
+ CALL FACILE(KRESP,NUNIT_FA,YPREFIX,0,HREC,ZWORK,.FALSE.)
+ IF (KRESP/=0) CALL ERROR_READ_SURF_FA(HREC,KRESP)
+ HCOMMENT = YPREFIX//TRIM(HREC)
ENDIF
!
-!$OMP END SINGLE
- !
ELSEIF (HDIR/='-') THEN
-!$OMP SINGLE
- ALLOCATE(XWORKD(0))
-!$OMP END SINGLE
+ ALLOCATE(ZWORK(0))
ENDIF
!
-KRESP = NWORKB
-HCOMMENT = CWORK0
-!
#ifdef SFX_MPI
XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
#endif
!
-IF (HDIR=='A') THEN ! no distribution on other tasks
+IF (HDIR=='E') THEN
+ IF ( NRANK==NPIO ) THEN
+ CALL PACK_SAME_RANK(NMASK,ZWORK(:),PFIELD(:))
+ ENDIF
+ELSEIF (HDIR=='A') THEN ! no distribution on other tasks
IF ( NRANK==NPIO ) THEN
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
#endif
- PFIELD(:) = XWORKD(1:KL)
+ PFIELD(:) = ZWORK(1:KL)
#ifdef SFX_MPI
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
#endif
@@ -293,25 +279,22 @@ IF (HDIR=='A') THEN ! no distribution on other tasks
ELSEIF (HDIR=='-') THEN ! distribution of the total field on other tasks
#ifdef SFX_MPI
IF (NPROC>1) THEN
-!$OMP SINGLE
XTIME0 = MPI_WTIME()
CALL MPI_BCAST(NFULL,KIND(NFULL)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
- IF ( NRANK/=NPIO ) ALLOCATE(XWORKD(NFULL))
- CALL MPI_BCAST(XWORKD(1:KL),KL*KIND(XWORKD)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ IF ( NRANK/=NPIO ) ALLOCATE(ZWORK(NFULL))
+ CALL MPI_BCAST(ZWORK(1:KL),KL*KIND(ZWORK)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
-!$OMP END SINGLE
ENDIF
#endif
- PFIELD(:) = XWORKD(1:KL)
+ PFIELD(:) = ZWORK(1:KL)
ELSE
- CALL READ_AND_SEND_MPI(XWORKD,PFIELD,NMASK)
+ CALL READ_AND_SEND_MPI(ZWORK,PFIELD,NMASK)
+ !IF (NRANK==NPIO) THEN
+ ! CALL MPI_WAITALL(NPROC-1,NREQ,ISTATUS,INFOMPI)
+ !ENDIF
ENDIF
!
-!$OMP BARRIER
-!
-!$OMP SINGLE
-DEALLOCATE(XWORKD)
-!$OMP END SINGLE
+DEALLOCATE(ZWORK)
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFX1_FA',1,ZHOOK_HANDLE)
!
@@ -325,15 +308,14 @@ END SUBROUTINE READ_SURFX1_FA
!
!!**** *READX2* - routine to fill a real 2D array for the externalised surface
!
-USE MODD_SURFEX_OMP, ONLY : XWORKD2, NWORKB, CWORK0
-!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC, NCOMM, NPIO, XTIME_NPIO_READ, XTIME_COMM_READ, &
- WLOG_MPI
+ WLOG_MPI, NREQ
!
USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, NLUOUT, NMASK, NFULL, CPREFIX2D
!
USE MODE_FASURFEX
!
+USE MODI_PACK_SAME_RANK
USE MODI_ERROR_READ_SURF_FA
USE MODI_READ_AND_SEND_MPI
!
@@ -348,39 +330,36 @@ INCLUDE "mpif.h"
!
!* 0.1 Declarations of arguments
!
- CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
+CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
INTEGER, INTENT(IN) :: KL1 ! number of points
INTEGER, INTENT(IN) :: KL2 ! 2nd dimension
REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELD ! array containing the data field
INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
- CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
- CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field :
+CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
+CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field :
! 'H' : field with
! horizontal spatial dim.
! '-' : no horizontal dim.
!* 0.2 Declarations of local variables
!
- CHARACTER(LEN=4) :: YPREFIX
- CHARACTER(LEN=2) :: YPATCH
- CHARACTER(LEN=3) :: YNUM
+CHARACTER(LEN=4) :: YPREFIX
+CHARACTER(LEN=2) :: YPATCH
+CHARACTER(LEN=3) :: YNUM
LOGICAL :: GV8
!
INTEGER :: JL, I, INFOMPI ! loop counter
!
#ifdef SFX_MPI
-INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+INTEGER, DIMENSION(MPI_STATUS_SIZE,NPROC-1) :: ISTATUS
#endif
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK ! work array read in the file
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK2 ! work array read in the file
REAL:: XTIME0
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFX2_FA',0,ZHOOK_HANDLE)
!
-!$OMP BARRIER
!
-!$OMP SINGLE
-NWORKB=0
-!$OMP END SINGLE
+KRESP=0
!
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
@@ -388,9 +367,7 @@ XTIME0 = MPI_WTIME()
!
IF (NRANK==NPIO) THEN
!
-!$OMP SINGLE
- !
- ALLOCATE(XWORKD2(NFULL,KL2))
+ ALLOCATE(ZWORK2(NFULL,KL2))
!
CALL SFX_FA_VERSION(GV8)
!
@@ -402,62 +379,56 @@ IF (NRANK==NPIO) THEN
WRITE(YPATCH,'(I2.2)')JL
YPREFIX='S'//YPATCH//'_'
ENDIF
- CALL FACILE(NWORKB,NUNIT_FA,YPREFIX,JL,HREC,XWORKD2(:,JL),.FALSE.)
- IF (NWORKB/=0) THEN
- CWORK0 = YPREFIX//TRIM(HREC)
- CALL ERROR_READ_SURF_FA(CWORK0,NWORKB)
+ CALL FACILE(KRESP,NUNIT_FA,YPREFIX,JL,HREC,ZWORK2(:,JL),.FALSE.)
+ IF (KRESP/=0) THEN
+ HCOMMENT = YPREFIX//TRIM(HREC)
+ CALL ERROR_READ_SURF_FA(HCOMMENT,KRESP)
ENDIF
END DO
!
- CWORK0 = 'PATCH_'//TRIM(HREC)
- !
-!$OMP END SINGLE
+ HCOMMENT = 'PATCH_'//TRIM(HREC)
!
ELSEIF (HDIR/='-') THEN
-!$OMP SINGLE
- ALLOCATE(XWORKD2(0,0))
-!$OMP END SINGLE
+ ALLOCATE(ZWORK2(0,0))
ENDIF
!
-KRESP = NWORKB
-HCOMMENT = CWORK0
-!
#ifdef SFX_MPI
XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
#endif
!
-IF (HDIR=='A') THEN ! no distribution on other tasks
+IF (HDIR=='E') THEN
+ IF ( NRANK==NPIO ) THEN
+ CALL PACK_SAME_RANK(NMASK,ZWORK2(:,:),PFIELD(:,:))
+ ENDIF
+ELSEIF (HDIR=='A') THEN ! no distribution on other tasks
IF ( NRANK==NPIO ) THEN
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
#endif
- PFIELD(:,:) = XWORKD2(1:KL1,1:KL2)
+ PFIELD(:,:) = ZWORK2(1:KL1,1:KL2)
#ifdef SFX_MPI
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
#endif
ENDIF
ELSEIF (HDIR=='-') THEN ! distribution of the total field on other tasks
-!$OMP SINGLE
#ifdef SFX_MPI
IF (NPROC>1) THEN
XTIME0 = MPI_WTIME()
CALL MPI_BCAST(NFULL,KIND(NFULL)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
- IF ( NRANK/=NPIO ) ALLOCATE(XWORKD2(NFULL,KL2))
- CALL MPI_BCAST(XWORKD2(1:KL1,1:KL2),KL1*KL2*KIND(XWORKD2)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ IF ( NRANK/=NPIO ) ALLOCATE(ZWORK2(NFULL,KL2))
+ CALL MPI_BCAST(ZWORK2(1:KL1,1:KL2),KL1*KL2*KIND(ZWORK2)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
ENDIF
#endif
-!$OMP END SINGLE
- PFIELD(:,:) = XWORKD2(1:KL1,1:KL2)
+ PFIELD(:,:) = ZWORK2(1:KL1,1:KL2)
ELSE
- CALL READ_AND_SEND_MPI(XWORKD2,PFIELD,NMASK)
+ CALL READ_AND_SEND_MPI(ZWORK2,PFIELD,NMASK)
+ !IF (NRANK==NPIO) THEN
+ ! CALL MPI_WAITALL(NPROC-1,NREQ,ISTATUS,INFOMPI)
+ !ENDIF
ENDIF
!
-!$OMP BARRIER
-!
-!$OMP SINGLE
-DEALLOCATE(XWORKD2)
-!$OMP END SINGLE
+DEALLOCATE(ZWORK2)
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFX2_FA',1,ZHOOK_HANDLE)
!
@@ -472,11 +443,6 @@ END SUBROUTINE READ_SURFX2_FA
!
!!**** *READN0* - routine to read an integer
!
-!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0
-!
USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, NLUOUT, NMASK, CMASK, CPREFIX1D
!
USE MODE_FASURFEX
@@ -493,17 +459,17 @@ IMPLICIT NONE
!
!
!
- CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
+CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
INTEGER, INTENT(OUT) :: KFIELD ! the integer to be read
INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
- CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
+CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
!
!* 0.2 Declarations of local variables
!
- CHARACTER(LEN=50) :: YCOMMENT
- CHARACTER(LEN=6) :: YMASK
- CHARACTER(LEN=18) :: YNAME ! Field Name
-LOGICAL :: GV8
+CHARACTER(LEN=50) :: YCOMMENT
+CHARACTER(LEN=6) :: YMASK
+CHARACTER(LEN=18) :: YNAME ! Field Name
+LOGICAL :: GV8, GFOUND
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -511,19 +477,19 @@ IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFN0_FA',0,ZHOOK_HANDLE)
!
KRESP=0
!
- CALL IO_BUFF(&
- HREC,'R',LWORK0)
+CALL IO_BUFF(&
+ HREC,'R',GFOUND)
!
- CALL SFX_FA_VERSION(GV8)
+CALL SFX_FA_VERSION(GV8)
IF(GV8)THEN
YNAME=CPREFIX1D//TRIM(HREC)
ELSE
YMASK=CMASK
- IF (LWORK0) YMASK='FULL '
+ IF (GFOUND) YMASK='FULL '
YNAME=TRIM(YMASK)//TRIM(HREC)
ENDIF
!
- CALL FALIT_I(KRESP,NUNIT_FA,YNAME,KFIELD)
+CALL FALIT_I(KRESP,NUNIT_FA,YNAME,KFIELD)
IF (KRESP/=0) CALL ERROR_READ_SURF_FA(HREC,KRESP)
!
YCOMMENT = YNAME
@@ -547,8 +513,6 @@ END SUBROUTINE READ_SURFN0_FA
USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC, NCOMM, NPIO, XTIME_NPIO_READ, XTIME_COMM_READ, &
WLOG_MPI
!
-USE MODD_SURFEx_OMP, ONLY : LWORK0, CWORK0, NWORKD, NWORKB
-!
USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, NLUOUT, NMASK, NFULL, CMASK, CPREFIX1D
!
USE MODE_FASURFEX
@@ -570,21 +534,22 @@ INCLUDE "mpif.h"
!
!
!
- CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
+CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
INTEGER, INTENT(IN) :: KL ! number of points
INTEGER, DIMENSION(:), INTENT(OUT) :: KFIELD ! the integer to be read
INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
- CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
- CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field :
+CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
+CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field :
! 'H' : field with
! horizontal spatial dim.
! '-' : no horizontal dim.
!* 0.2 Declarations of local variables
!
- CHARACTER(LEN=6) :: YMASK
- CHARACTER(LEN=18) :: YNAME ! Field Name
-LOGICAL :: GV8
+CHARACTER(LEN=6) :: YMASK
+CHARACTER(LEN=18) :: YNAME ! Field Name
+LOGICAL :: GV8, GFOUND
!
+INTEGER, DIMENSION(:), ALLOCATABLE :: IWORK
INTEGER :: I, INFOMPI
#ifdef SFX_MPI
INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
@@ -595,58 +560,45 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFN1_FA',0,ZHOOK_HANDLE)
!
-!$OMP SINGLE
-NWORKB = 0
-!$OMP END SINGLE
+KRESP = 0
!
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
#endif
!
IF (HDIR=='-') THEN
-!$OMP SINGLE
- ALLOCATE(NWORKD(KL))
-!$OMP END SINGLE
+ ALLOCATE(IWORK(KL))
ENDIF
!
IF (NRANK==NPIO) THEN
!
-!$OMP SINGLE
- !
CALL IO_BUFF(&
- HREC,'R',LWORK0)
+ HREC,'R',GFOUND)
!
CALL SFX_FA_VERSION(GV8)
IF(GV8)THEN
YNAME=CPREFIX1D//TRIM(HREC)
ELSE
YMASK=CMASK
- IF (LWORK0) YMASK='FULL '
+ IF (GFOUND) YMASK='FULL '
YNAME=TRIM(YMASK)//TRIM(HREC)
ENDIF
!
IF (HDIR=='A') THEN
- ALLOCATE(NWORKD(KL))
+ ALLOCATE(IWORK(KL))
ELSEIF (HDIR/='-') THEN
- ALLOCATE(NWORKD(NFULL))
+ ALLOCATE(IWORK(NFULL))
END IF
!
- CALL FALIT_I_D(NWORKB,NUNIT_FA,YNAME,SIZE(NWORKD),NWORKD)
- IF (NWORKB/=0) CALL ERROR_READ_SURF_FA(HREC,NWORKB)
+ CALL FALIT_I_D(KRESP,NUNIT_FA,YNAME,SIZE(IWORK),IWORK)
+ IF (KRESP/=0) CALL ERROR_READ_SURF_FA(HREC,KRESP)
!
- CWORK0 = YNAME
- !
-!$OMP END SINGLE
+ HCOMMENT = YNAME
!
ELSEIF (HDIR/='-') THEN
-!$OMP SINGLE
- ALLOCATE(NWORKD(0))
-!$OMP END SINGLE
+ ALLOCATE(IWORK(0))
ENDIF
!
-KRESP = NWORKB
-HCOMMENT = CWORK0
-!
#ifdef SFX_MPI
XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
#endif
@@ -656,33 +608,26 @@ IF (HDIR=='A') THEN ! no distribution on other tasks
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
#endif
- KFIELD(:) = NWORKD(1:KL)
+ KFIELD(:) = IWORK(1:KL)
#ifdef SFX_MPI
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
#endif
ENDIF
ELSEIF (HDIR=='-') THEN ! distribution of the total field on other tasks
-!$OMP SINGLE
#ifdef SFX_MPI
IF (NPROC>1) THEN
XTIME0 = MPI_WTIME()
- CALL MPI_BCAST(NFULL,KIND(NFULL)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
- IF ( NRANK/=NPIO ) ALLOCATE(NWORKD(NFULL))
- CALL MPI_BCAST(NWORKD(1:KL),KL*KIND(NWORKD)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(NFULL,KIND(NFULL)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(IWORK(1:KL),KL*KIND(IWORK)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
ENDIF
#endif
-!$OMP END SINGLE
- KFIELD(:) = NWORKD(1:KL)
+ KFIELD(:) = IWORK(1:KL)
ELSE
- CALL READ_AND_SEND_MPI(NWORKD,KFIELD,NMASK)
+ CALL READ_AND_SEND_MPI(IWORK,KFIELD,NMASK)
ENDIF
!
-!$OMP BARRIER
-!
-!$OMP SINGLE
-DEALLOCATE(NWORKD)
-!$OMP END SINGLE
+DEALLOCATE(IWORK)
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFN1_FA',1,ZHOOK_HANDLE)
!
@@ -697,11 +642,6 @@ END SUBROUTINE READ_SURFN1_FA
!
!!**** *READC0* - routine to read a character
!
-!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0
-!
USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, NLUOUT, CMASK, CPREFIX1D
!
USE MODE_FASURFEX
@@ -718,18 +658,18 @@ IMPLICIT NONE
!
!
!
- CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
- CHARACTER(LEN=40), INTENT(OUT) :: HFIELD ! the integer to be read
+CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
+CHARACTER(LEN=40), INTENT(OUT) :: HFIELD ! the integer to be read
INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
- CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
+CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
!
!* 0.2 Declarations of local variables
!
- CHARACTER(LEN=50) :: YCOMMENT
- CHARACTER(LEN=6) :: YMASK
- CHARACTER(LEN=18) :: YNAME ! Field Name
- CHARACTER,DIMENSION(40) :: YFIELD
-LOGICAL :: GV8
+CHARACTER(LEN=50) :: YCOMMENT
+CHARACTER(LEN=6) :: YMASK
+CHARACTER(LEN=18) :: YNAME ! Field Name
+CHARACTER,DIMENSION(40) :: YFIELD
+LOGICAL :: GV8, GFOUND
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
@@ -738,19 +678,19 @@ IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFC0_FA',0,ZHOOK_HANDLE)
!
KRESP=0
!
- CALL IO_BUFF(&
- HREC,'R',LWORK0)
+CALL IO_BUFF(&
+ HREC,'R',GFOUND)
!
- CALL SFX_FA_VERSION(GV8)
+CALL SFX_FA_VERSION(GV8)
IF(GV8)THEN
YNAME=CPREFIX1D//TRIM(HREC)
ELSE
YMASK=CMASK
- IF (LWORK0) YMASK='FULL '
+ IF (GFOUND) YMASK='FULL '
YNAME=TRIM(YMASK)//TRIM(HREC)
ENDIF
!
- CALL FALIT_C(KRESP,NUNIT_FA,YNAME,40,YFIELD)
+CALL FALIT_C(KRESP,NUNIT_FA,YNAME,40,YFIELD)
IF (KRESP/=0) CALL ERROR_READ_SURF_FA(HREC,KRESP)
WRITE(HFIELD,'(40A1)') YFIELD(:)
!
@@ -768,11 +708,6 @@ END SUBROUTINE READ_SURFC0_FA
!
!!**** *READL0* - routine to read a logical
!
-!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0
-!
USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, NLUOUT, CMASK, CPREFIX1D
!
USE MODE_FASURFEX
@@ -789,17 +724,17 @@ IMPLICIT NONE
!
!
!
- CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
+CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
LOGICAL, INTENT(OUT) :: OFIELD ! array containing the data field
INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
- CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
+CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
!
!* 0.2 Declarations of local variables
!
- CHARACTER(LEN=50) :: YCOMMENT
- CHARACTER(LEN=6) :: YMASK
- CHARACTER(LEN=18) :: YNAME ! Field Name
-LOGICAL :: GV8
+CHARACTER(LEN=50) :: YCOMMENT
+CHARACTER(LEN=6) :: YMASK
+CHARACTER(LEN=18) :: YNAME ! Field Name
+LOGICAL :: GV8, GFOUND
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -807,19 +742,19 @@ IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFL0_FA',0,ZHOOK_HANDLE)
!
KRESP=0
!
- CALL IO_BUFF(&
- HREC,'R',LWORK0)
+CALL IO_BUFF(&
+ HREC,'R',GFOUND)
!
- CALL SFX_FA_VERSION(GV8)
+CALL SFX_FA_VERSION(GV8)
IF(GV8)THEN
YNAME=CPREFIX1D//TRIM(HREC)
ELSE
YMASK=CMASK
- IF (LWORK0) YMASK='FULL '
+ IF (GFOUND) YMASK='FULL '
YNAME=TRIM(YMASK)//TRIM(HREC)
ENDIF
!
- CALL FALIT_L(KRESP,NUNIT_FA,YNAME,OFIELD)
+CALL FALIT_L(KRESP,NUNIT_FA,YNAME,OFIELD)
IF (KRESP/=0)CALL ERROR_READ_SURF_FA(HREC,KRESP)
!
YCOMMENT = YNAME
@@ -837,11 +772,6 @@ END SUBROUTINE READ_SURFL0_FA
!
!!**** *READL1* - routine to read a logical array
!
-!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0, LWORKD, NWORKB, CWORK0
-!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC, NCOMM, NPIO, XTIME_NPIO_READ, XTIME_COMM_READ, &
WLOG_MPI
!
@@ -865,20 +795,20 @@ INCLUDE "mpif.h"
!
!
!
- CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
+CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
INTEGER, INTENT(IN) :: KL ! number of points
LOGICAL, DIMENSION(:), INTENT(OUT) :: OFIELD ! array containing the data field
INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
- CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
- CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field :
+CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
+CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field :
! 'H' : field with
! horizontal spatial dim.
! '-' : no horizontal dim.
!* 0.2 Declarations of local variables
!
- CHARACTER(LEN=6) :: YMASK
- CHARACTER(LEN=18) :: YNAME ! Field Name
-LOGICAL :: GV8
+CHARACTER(LEN=6) :: YMASK
+CHARACTER(LEN=18) :: YNAME ! Field Name
+LOGICAL :: GV8, GFOUND
!
INTEGER :: INFOMPI
REAL :: XTIME0
@@ -890,56 +820,43 @@ IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFL1_FA',0,ZHOOK_HANDLE)
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP SINGLE
-NWORKB = 0
-!
-ALLOCATE(LWORKD(KL))
-!$OMP END SINGLE
+KRESP = 0
!
IF (NRANK==NPIO) THEN
!
-!$OMP SINGLE
!
CALL IO_BUFF(&
- HREC,'R',LWORK0)
+ HREC,'R',GFOUND)
!
CALL SFX_FA_VERSION(GV8)
IF(GV8)THEN
YNAME=CPREFIX1D//TRIM(HREC)
ELSE
YMASK=CMASK
- IF (LWORK0) YMASK='FULL '
+ IF (GFOUND) YMASK='FULL '
YNAME=TRIM(YMASK)//TRIM(HREC)
ENDIF
!
- CALL FALIT_L_D(NWORKB,NUNIT_FA,YNAME,KL,LWORKD)
- IF (NWORKB/=0) CALL ERROR_READ_SURF_FA(HREC,NWORKB)
+ CALL FALIT_L_D(KRESP,NUNIT_FA,YNAME,KL,OFIELD)
+ IF (KRESP/=0) CALL ERROR_READ_SURF_FA(HREC,KRESP)
!
- CWORK0 = YNAME
+ HCOMMENT = YNAME
!
-!$OMP END SINGLE
!
ENDIF
!
-KRESP = NWORKB
-HCOMMENT = CWORK0
-!
#ifdef SFX_MPI
XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
#endif
!
#ifdef SFX_MPI
IF (NPROC>1 .AND. HDIR/='A') THEN
-!$OMP SINGLE
XTIME0 = MPI_WTIME()
- CALL MPI_BCAST(LWORKD,KL,MPI_LOGICAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(OFIELD,KL,MPI_LOGICAL,NPIO,NCOMM,INFOMPI)
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
-!$OMP END SINGLE
ENDIF
#endif
!
-OFIELD = LWORKD
-!
IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFL1_FA',1,ZHOOK_HANDLE)
!
END SUBROUTINE READ_SURFL1_FA
@@ -953,11 +870,6 @@ END SUBROUTINE READ_SURFL1_FA
!
!!**** *READT0* - routine to read a date
!
-!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0
-!
USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, NLUOUT, CMASK, CPREFIX1D
!
USE MODE_FASURFEX
@@ -974,20 +886,20 @@ IMPLICIT NONE
!
!
!
- CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
+CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
INTEGER, INTENT(OUT) :: KYEAR ! year
INTEGER, INTENT(OUT) :: KMONTH ! month
INTEGER, INTENT(OUT) :: KDAY ! day
REAL, INTENT(OUT) :: PTIME ! year
INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
- CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
+CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
!* 0.2 Declarations of local variables
!
- CHARACTER(LEN=50) :: YCOMMENT
- CHARACTER(LEN=6) :: YMASK
- CHARACTER(LEN=18) :: YNAME ! Field Name
-LOGICAL :: GV8
+CHARACTER(LEN=50) :: YCOMMENT
+CHARACTER(LEN=6) :: YMASK
+CHARACTER(LEN=18) :: YNAME ! Field Name
+LOGICAL :: GV8, GFOUND
!
INTEGER, DIMENSION(3) :: ITDATE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -996,35 +908,35 @@ IF (LHOOK) CALL DR_HOOK('MODE_READ_SURF_FA:READ_SURFT0_FA',0,ZHOOK_HANDLE)
!
KRESP=0
!
- CALL IO_BUFF(&
- HREC,'R',LWORK0)
+CALL IO_BUFF(&
+ HREC,'R',GFOUND)
!
- CALL SFX_FA_VERSION(GV8)
+CALL SFX_FA_VERSION(GV8)
IF(GV8)THEN
YNAME=CPREFIX1D//TRIM(HREC)//'%TDATE'
ELSE
YMASK=CMASK
- IF (LWORK0) YMASK='FULL '
+ IF (GFOUND) YMASK='FULL '
YNAME=TRIM(YMASK)//TRIM(HREC)//'%TDATE'
ENDIF
!
- CALL FALIT_I_D(KRESP,NUNIT_FA,YNAME,3,ITDATE)
+CALL FALIT_I_D(KRESP,NUNIT_FA,YNAME,3,ITDATE)
IF (KRESP/=0) CALL ERROR_READ_SURF_FA(HREC,KRESP)
!
KYEAR = ITDATE(1)
KMONTH = ITDATE(2)
KDAY = ITDATE(3)
!
- CALL SFX_FA_VERSION(GV8)
+CALL SFX_FA_VERSION(GV8)
IF(GV8)THEN
YNAME=CPREFIX1D//TRIM(HREC)//'%TIME'
ELSE
YMASK=CMASK
- IF (LWORK0) YMASK='FULL '
+ IF (GFOUND) YMASK='FULL '
YNAME=TRIM(YMASK)//TRIM(HREC)//'%TIME'
ENDIF
!
- CALL FALIT_R(KRESP,NUNIT_FA,YNAME,PTIME)
+CALL FALIT_R(KRESP,NUNIT_FA,YNAME,PTIME)
IF (KRESP/=0) CALL ERROR_READ_SURF_FA(HREC,KRESP)
!
YCOMMENT = TRIM(HREC)
@@ -1043,11 +955,6 @@ END SUBROUTINE READ_SURFT0_FA
!
!!**** *READT2* - routine to read a date
!
-!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0
-!
USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, NLUOUT, CMASK, CPREFIX1D
!
USE MODE_FASURFEX
@@ -1065,21 +972,21 @@ IMPLICIT NONE
!
!
!
- CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
+CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
INTEGER :: KL1, KL2
INTEGER, DIMENSION(:,:), INTENT(OUT) :: KYEAR ! year
INTEGER, DIMENSION(:,:), INTENT(OUT) :: KMONTH ! month
INTEGER, DIMENSION(:,:), INTENT(OUT) :: KDAY ! day
REAL, DIMENSION(:,:), INTENT(OUT) :: PTIME ! year
INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
- CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
+CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
!* 0.2 Declarations of local variables
!
- CHARACTER(LEN=50) :: YCOMMENT
- CHARACTER(LEN=6) :: YMASK
- CHARACTER(LEN=18) :: YNAME ! Field Name
-LOGICAL :: GV8
+CHARACTER(LEN=50) :: YCOMMENT
+CHARACTER(LEN=6) :: YMASK
+CHARACTER(LEN=18) :: YNAME ! Field Name
+LOGICAL :: GV8, GFOUND
!
INTEGER, DIMENSION(3,SIZE(KYEAR,1),SIZE(KYEAR,2)) :: ITDATE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -1095,15 +1002,15 @@ PTIME=0.
!
HCOMMENT=""
!
- CALL IO_BUFF(&
- HREC,'R',LWORK0)
+CALL IO_BUFF(&
+ HREC,'R',GFOUND)
!
- CALL SFX_FA_VERSION(GV8)
+CALL SFX_FA_VERSION(GV8)
IF(GV8)THEN
YNAME=CPREFIX1D//TRIM(HREC)
ELSE
YMASK=CMASK
- IF (LWORK0) YMASK='FULL '
+ IF (GFOUND) YMASK='FULL '
YNAME=TRIM(YMASK)//TRIM(HREC)
ENDIF
!
diff --git a/src/SURFEX/mode_read_surf_layers.F90 b/src/SURFEX/mode_read_surf_layers.F90
new file mode 100644
index 0000000000000000000000000000000000000000..c1f6d78d65faf81cb1136a7f9a8c6ae6a428b121
--- /dev/null
+++ b/src/SURFEX/mode_read_surf_layers.F90
@@ -0,0 +1,343 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+
+MODULE MODE_READ_SURF_LAYERS
+!
+INTERFACE WRITE_READ_LAYERS
+ MODULE PROCEDURE READ_SURF_LAYERS
+END INTERFACE
+!
+CONTAINS
+!
+! #############################################################
+ SUBROUTINE READ_SURF_LAYERS (HPROGRAM,HREC,ODIM,PFIELD,KRESP,HCOMMENT,HDIR,KPATCH)
+! #############################################################
+!
+!
+!
+USE MODD_SURFEX_MPI, ONLY : NPROC, NPIO, NRANK, IDX_R, NREQ, NCOMM, NSIZE, NINDEX
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+#ifdef SFX_LFI
+USE MODD_IO_SURF_LFI, ONLY : NMASK_lfi=>NMASK, NFULL_lfi=>NFULL
+#endif
+#ifdef SFX_NC
+USE MODD_IO_SURF_NC, ONLY : NMASK_nc=>NMASK, NFULL_nc=>NFULL
+#endif
+#ifdef SFX_ASC
+USE MODD_IO_SURF_ASC, ONLY : NMASK_asc=>NMASK, NFULL_asc=>NFULL
+#endif
+#ifdef SFX_FA
+USE MODD_IO_SURF_FA, ONLY : NMASK_fa=>NMASK, NFULL_fa=>NFULL
+#endif
+#ifdef SFX_MNH
+USE MODI_READ_SURF
+#endif
+!
+USE MODI_ABOR1_SFX
+USE MODI_PACK_SAME_RANK
+USE MODI_READ_AND_SEND_MPI
+USE MODI_MAKE_CHOICE_ARRAY
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
+!* 0.1 Declarations of arguments
+!
+!
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
+ CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
+LOGICAL, INTENT(IN) :: ODIM
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFIELD ! array containing the data field
+INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
+ CHARACTER(LEN=*), OPTIONAL, INTENT(OUT) :: HCOMMENT ! name of the article to be read
+ CHARACTER(LEN=1), OPTIONAL, INTENT(IN) :: HDIR ! type of field :
+! ! 'H' : field with
+! ! horizontal spatial dim.
+! ! '-' : no horizontal dim.
+INTEGER, OPTIONAL, INTENT(IN) :: KPATCH
+!
+!* 0.2 Declarations of local variables
+!
+#ifdef SFX_MPI
+INTEGER, DIMENSION(MPI_STATUS_SIZE,NPROC-1) :: ISTATUS
+#endif
+!INTEGER, DIMENSION(NPROC) :: ITREQ
+REAL, DIMENSION(:,:),ALLOCATABLE :: ZWORKR
+REAL, DIMENSION(:,:),ALLOCATABLE :: ZFIELD
+INTEGER, DIMENSION(:), POINTER :: IMASKF
+ CHARACTER(LEN=100) :: YCOMMENT
+ CHARACTER(LEN=LEN_HREC) :: YREC
+ CHARACTER(LEN=1) :: YDIR
+ CHARACTER(LEN=4) :: YLVL
+INTEGER :: IFLAG, IPATCH, INPATCH
+INTEGER :: IPIO_SAVE, IPAS, JP, IDEB, IFIN, JJ, JL
+INTEGER :: JLAYER, JPROC, IPROC, IRESP
+INTEGER :: IL1, IL2, IL3, IDX_SAVE, IDX, IVAL
+INTEGER :: INFOMPI, IREQ, JPROC2, IFULL
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
+!
+IF (LHOOK) CALL DR_HOOK('READ_SURF_LAYERS_1',0,ZHOOK_HANDLE)
+!
+IDX_SAVE = IDX_R
+YREC = HREC
+YCOMMENT="empty"
+YDIR = 'H'
+IF (PRESENT(HDIR)) YDIR = HDIR
+INPATCH = SIZE(PFIELD,3)
+IPATCH = -1
+IF (PRESENT(KPATCH).AND.INPATCH==1) IPATCH = KPATCH
+!
+IL1 = SIZE(PFIELD,1)
+IL2 = SIZE(PFIELD,2)
+IL3 = SIZE(PFIELD,3)
+!
+IF (LHOOK) CALL DR_HOOK('READ_SURF_LAYERS_1',1,ZHOOK_HANDLE)
+!
+IF (HPROGRAM=='MESONH') THEN
+#ifdef SFX_MNH
+ DO JL=1,IL2
+ WRITE(YLVL,'(I4)') JL
+ YREC=TRIM(HREC)//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, INPATCH, ODIM, YREC, PFIELD(:,JL,:), HDIR=YDIR, KPATCH=IPATCH)
+ END DO
+#endif
+ELSE
+ !
+ IF (LHOOK) CALL DR_HOOK('READ_SURF_LAYERS_2',0,ZHOOK_HANDLE)
+ !
+ !the mask to call read_and_send_mpi depends on the I/O type
+ IF (HPROGRAM=='LFI ') THEN
+#ifdef SFX_LFI
+ IFULL = NFULL_lfi
+ ALLOCATE(ZFIELD(NFULL_lfi,IL3))
+ IMASKF=>NMASK_lfi
+#endif
+ ELSEIF (HPROGRAM=='ASCII ') THEN
+#ifdef SFX_ASC
+ IFULL = NFULL_asc
+ ALLOCATE(ZFIELD(NFULL_asc,IL3))
+ IMASKF=>NMASK_asc
+#endif
+ ELSEIF (HPROGRAM=='FA ') THEN
+#ifdef SFX_FA
+ IFULL = NFULL_fa
+ ALLOCATE(ZFIELD(NFULL_fa,IL3))
+ IMASKF=>NMASK_fa
+#endif
+ ELSEIF (HPROGRAM=='NC ') THEN
+#ifdef SFX_NC
+ IFULL = NFULL_nc
+ ALLOCATE(ZFIELD(NFULL_nc,IL3))
+ IMASKF=>NMASK_nc
+#endif
+ ELSE
+ ALLOCATE(ZFIELD(0,0))
+ ENDIF
+ !
+ !if we want to get covers for the current task or for the whole domain
+ IF (YDIR=='H') THEN
+ !second dimension because the reading of covers is parallelized with MPI
+ ALLOCATE(ZWORKR(NSIZE,IL3))
+ ELSEIF (NRANK==NPIO) THEN
+ ALLOCATE(ZWORKR(IFULL,IL3))
+ ELSE
+ ALLOCATE(ZWORKR(0,0))
+ ENDIF
+ ZWORKR(:,:) = 0.
+ !
+ IF (NPROC>1 .AND. YDIR=='H') THEN
+ IFLAG = 0
+ !for the parallelization of reading, NINDEX must be known by all tasks
+ IF (NRANK/=NPIO) THEN
+ IF (ALLOCATED(NINDEX)) THEN
+ IF (SIZE(NINDEX)==IFULL) IFLAG=1
+ DEALLOCATE(NINDEX)
+ ENDIF
+ ALLOCATE(NINDEX(IFULL))
+ ENDIF
+#ifdef SFX_MPI
+ CALL MPI_BCAST(NINDEX,SIZE(NINDEX)*KIND(NINDEX)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ ENDIF
+ !
+ IPIO_SAVE = NPIO
+ !number of covers read by each task
+ IPAS = CEILING(IL2*1./NPROC)
+ !
+ PFIELD(:,:,:) = 0.
+ !
+ !first cover number read by the current task
+ IDEB = IPAS*NRANK
+ !
+ IF (LHOOK) CALL DR_HOOK('READ_SURF_LAYERS_2',1,ZHOOK_HANDLE)
+ !
+ DO JP = 1,IPAS
+ !
+ IF (LHOOK) CALL DR_HOOK('READ_SURF_LAYERS_3',0,ZHOOK_HANDLE)
+ !
+ !index of the cover read by this task at this loop index
+ JLAYER = IDEB + JP
+ !
+ IF (JLAYER<=IL2) THEN
+ !
+ WRITE(YLVL,'(I4)') JLAYER
+ YREC = TRIM(HREC)//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YCOMMENT='X_Y_'//YREC
+ !
+ !
+ IF (HPROGRAM=='AROME ') THEN
+#ifdef ARO
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, INPATCH, ODIM, YREC, PFIELD(:,JLAYER,:), HDIR=YDIR, KPATCH=IPATCH)
+#endif
+ ELSE
+ !
+ !reads one cover by task
+ !
+ !number of the I/O task for this read
+ NPIO = NRANK
+ !
+ !reading of the whol cover (HDIR='A')
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, INPATCH, ODIM, YREC, ZFIELD, HDIR='A', KPATCH=IPATCH)
+ !
+ !NPIO rebecomes the I/O task
+ NPIO = IPIO_SAVE
+ !
+ IDX = IDX_SAVE + JP
+ IF (YDIR=='H') THEN
+ !
+ !send covers to other tasks
+ CALL READ_AND_SEND_MPI(ZFIELD,PFIELD(:,JLAYER,:),IMASKF,NRANK,IDX)
+ !
+ ELSEIF (YDIR=='A' .OR. YDIR=='E') THEN
+ !
+ !NPIO needs to know all covers read
+ IF (NRANK/=NPIO) THEN
+ IDX = IDX + 1
+#ifdef SFX_MPI
+ CALL MPI_SEND(ZFIELD,SIZE(ZFIELD)*KIND(ZFIELD)/4,MPI_REAL,NPIO,IDX,NCOMM,INFOMPI)
+#endif
+ ELSE
+ CALL PACK_SAME_RANK(IMASKF,ZFIELD,PFIELD(:,JLAYER,:))
+ ENDIF
+ !
+ ELSE
+ CALL ABOR1_SFX("READ_SURF_LAYERS:HDIR MUST BE H OR A OR E")
+ ENDIF
+ !
+ ENDIF
+ !
+ ENDIF
+ !
+ IF (LHOOK) CALL DR_HOOK('READ_SURF_LAYERS_3',1,ZHOOK_HANDLE)
+ !
+ IF (NRANK==NPIO .OR. YDIR=='H') THEN
+ !
+ !receives pieces of cover fields
+ !ITREQ(:) = 0
+ !
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('READ_SURF_LAYERS_4',0,ZHOOK_HANDLE_OMP)
+#ifdef SFX_MPI
+!$OMP DO SCHEDULE(DYNAMIC,1) PRIVATE(JPROC,IDX,ISTATUS,INFOMPI)
+#endif
+ DO JPROC=0,NPROC-1
+ !
+ !the cover exists and was read
+ IF (IPAS*JPROC + JP<=IL2) THEN
+ !
+ !IF (JPROC<NRANK) THEN
+ ! ITREQ(JPROC+1) = JPROC+1
+ !ELSE
+ ! ITREQ(JPROC+1) = JPROC
+ !ENDIF
+ !
+ IF (JPROC/=NRANK) THEN
+ IDX = IDX_SAVE + JP + 1
+ !each task receives the part of the cover read that concerns it
+ !only NPIO in cas of HDIR/=H
+#ifdef SFX_MPI
+ CALL MPI_RECV(ZWORKR(:,:),SIZE(ZWORKR)*KIND(ZWORKR)/4,&
+ MPI_REAL,JPROC,IDX,NCOMM,ISTATUS,INFOMPI)
+#endif
+ IVAL = IPAS*JPROC + JP
+ CALL PACK_SAME_RANK(IMASKF,ZWORKR(:,:),PFIELD(:,IVAL,:))
+ !
+ ENDIF
+ !
+ ENDIF
+ !
+ ENDDO
+#ifdef SFX_MPI
+!$OMP END DO
+#endif
+IF (LHOOK) CALL DR_HOOK('READ_SURF_LAYERS_4',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
+
+!
+ IF (LHOOK) CALL DR_HOOK('READ_SURF_LAYERS_5',0,ZHOOK_HANDLE)
+ !
+ !waits that all cover pieces are sent
+#ifdef SFX_MPI
+ IF (YDIR=='H' .AND. IPAS*NRANK+JP<=IL2 .AND. NPROC>1) THEN
+ CALL MPI_WAITALL(NPROC-1,NREQ(1:NPROC-1),ISTATUS,INFOMPI)
+ ENDIF
+#endif
+ !
+ IF (LHOOK) CALL DR_HOOK('READ_SURF_LAYERS_5',1,ZHOOK_HANDLE)
+ !
+! IF (YDIR=='H' .OR. NRANK==NPIO) THEN
+! !packs data
+! IREQ = MAXVAL(ITREQ)
+!!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+!IF (LHOOK) CALL DR_HOOK('READ_SURF_LAYERS_6',0,ZHOOK_HANDLE_OMP)
+!!$OMP DO SCHEDULE(DYNAMIC,1) PRIVATE(JPROC,IVAL)
+! DO JPROC=0,IREQ-1
+! IVAL = IPAS*JPROC + JP
+! IF (JPROC>=NRANK ) IVAL = IVAL + IPAS
+! CALL PACK_SAME_RANK(IMASKF,ZWORKR(:,:,JPROC+1),PFIELD(:,IVAL,:))
+! ENDDO
+!!$OMP END DO
+!IF (LHOOK) CALL DR_HOOK('READ_SURF_LAYERS_6',1,ZHOOK_HANDLE_OMP)
+!!$OMP END PARALLEL
+! ENDIF
+ !
+ ENDIF
+ !
+ ENDDO
+ !
+ IF (LHOOK) CALL DR_HOOK('READ_SURF_LAYERS_7',0,ZHOOK_HANDLE)
+ !
+ IF (NRANK/=NPIO .AND. YDIR=='H' .AND. IFLAG==0) THEN
+ DEALLOCATE(NINDEX)
+ ALLOCATE(NINDEX(0))
+ ENDIF
+ !
+ IDX_R = IDX_R + IPAS + 1
+ DEALLOCATE(ZWORKR)
+ IF (HPROGRAM/="AROME ") DEALLOCATE(ZFIELD)
+ IMASKF=>NULL()
+ !
+ IF (LHOOK) CALL DR_HOOK('READ_SURF_LAYERS_7',1,ZHOOK_HANDLE)
+ !
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('READ_SURF_LAYERS_8',0,ZHOOK_HANDLE)
+!
+!RJ: what is a point of comment here? last field comment? Should be 'COVER_PACKED' status?
+IF (PRESENT(HCOMMENT)) HCOMMENT = YCOMMENT
+!
+IF (LHOOK) CALL DR_HOOK('READ_SURF_LAYERS_8',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE READ_SURF_LAYERS
+
+END MODULE MODE_READ_SURF_LAYERS
diff --git a/src/SURFEX/mode_sbls.F90 b/src/SURFEX/mode_sbls.F90
index fb31c3fd726589a4be65e850fbdaaf7afa62b1ac..e26b827ba07b609cbcbf5932cb50d9d233c89532 100644
--- a/src/SURFEX/mode_sbls.F90
+++ b/src/SURFEX/mode_sbls.F90
@@ -88,7 +88,7 @@ INTERFACE USTAR
END INTERFACE
!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
!
FUNCTION BUSINGER_PHIM_3D(PZ_O_LMO)
diff --git a/src/SURFEX/mode_sfcflx.F90 b/src/SURFEX/mode_sfcflx.F90
index 4f2e0434d569f0f817d8cf7539311ec832af55df..d90638aff4051a35057da0585c8e1c54d93cdb52 100644
--- a/src/SURFEX/mode_sfcflx.F90
+++ b/src/SURFEX/mode_sfcflx.F90
@@ -181,7 +181,6 @@ REAL :: &
z0u_sf=Z_ , &! Roughness length with respect to wind velocity [m]
z0t_sf=Z_ , &! Roughness length with respect to potential temperature [m]
z0q_sf=Z_ ! Roughness length with respect to specific humidity [m]
-!$OMP THREADPRIVATE(z0u_sf,z0t_sf,z0q_sf)
! Security constants
REAL , PARAMETER :: &
u_wind_min_sf = 1.0E-02 , &! Minimum wind speed [m s^{-1}]
@@ -198,7 +197,7 @@ REAL , PARAMETER :: &
! Procedures
!==============================================================================
- CONTAINS
+CONTAINS
!==============================================================================
! The codes of the sfcflx procedures are stored in separate "*.incf" files
diff --git a/src/SURFEX/mode_snow3l.F90 b/src/SURFEX/mode_snow3l.F90
index 81f3dadb9af0af2938d368ae5b15abcaca499deb..85a55f9a6f979e9f6bf9366174e9c9da654e2ca6 100644
--- a/src/SURFEX/mode_snow3l.F90
+++ b/src/SURFEX/mode_snow3l.F90
@@ -117,7 +117,11 @@ INTERFACE SNOW3LRADABS
MODULE PROCEDURE SNOW3LRADABS_2D
MODULE PROCEDURE SNOW3LRADABS_1D
MODULE PROCEDURE SNOW3LRADABS_0D
-END INTERFACE
+END INTERFACE
+!
+INTERFACE SNOW3LRADABS_SFC
+ MODULE PROCEDURE SNOW3LRADABS_SFC
+END INTERFACE
!
INTERFACE SNOW3LTHRM
MODULE PROCEDURE SNOW3LTHRM
@@ -133,8 +137,20 @@ INTERFACE SNOW3LALB
MODULE PROCEDURE SNOW3LALB
END INTERFACE
!
+INTERFACE SNOW3LFALL
+ MODULE PROCEDURE SNOW3LFALL
+END INTERFACE
+!
+INTERFACE SNOW3LTRANSF
+ MODULE PROCEDURE SNOW3LTRANSF
+END INTERFACE
+!
+INTERFACE SNOW3LCOMPACTN
+ MODULE PROCEDURE SNOW3LCOMPACTN
+END INTERFACE
+!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!
!####################################################################
FUNCTION SNOW3LWLIQMAX_3D(PSNOWRHO) RESULT(PWLIQMAX)
@@ -1647,7 +1663,7 @@ IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LAGREG',1,ZHOOK_HANDLE)
! PSNOWGRAN1(KL1)=ZSNOWGRAN1(KL1)
! PSNOWGRAN2(KL1)=ZSNOWGRAN2(KL1)
!
- CONTAINS
+CONTAINS
!
SUBROUTINE GET_AGREG(KID1,KID2,PFIELD1,PFIELD2,PFIELD)
!
@@ -1693,7 +1709,7 @@ REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWGRAN1N,PSNOWGRAN2N,PSNOWHISTN
!
REAL, DIMENSION(:), INTENT(IN) :: PNDENT, PNVIEU
!
- CHARACTER(3), INTENT(IN) :: HSNOWMETAMO
+CHARACTER(3), INTENT(IN) :: HSNOWMETAMO
! 0.2 declaration of local variables
!
REAL, DIMENSION(SIZE(PSNOWGRAN1,1)) :: ZGRAN1, ZGRAN2, ZHIST
@@ -1791,7 +1807,7 @@ USE PARKIND1 ,ONLY : JPRB
IMPLICIT NONE
!* 0.1 declarations of arguments
REAL, INTENT(IN) :: PGRAIN1, PGRAIN2, PGRAIN3, PGRAIN4
- CHARACTER(3), INTENT(IN) :: HSNOWMETAMO
+CHARACTER(3), INTENT(IN) :: HSNOWMETAMO
REAL :: ZDIFTYPE, ZCOEF3, ZCOEF4
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -1851,7 +1867,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PSNOWZTOP_NEW, PSNOWZBOT_NEW
REAL, DIMENSION(:), INTENT(IN) :: PSNOWRHOO, PSNOWDZO, PSNOWGRAN1O, PSNOWGRAN2O, &
PSNOWHISTO, PSNOWAGEO, PSNOWHEATO
REAL, DIMENSION(:), INTENT(IN) :: PSNOWDZN
- CHARACTER(3), INTENT(IN) :: HSNOWMETAMO
+CHARACTER(3), INTENT(IN) :: HSNOWMETAMO
REAL, DIMENSION(:), INTENT(OUT) :: PSNOWRHON, PSNOWGRAN1N, PSNOWGRAN2N, &
PSNOWHISTN, PSNOWAGEN, PSNOWHEATN
!
@@ -2019,7 +2035,7 @@ REAL, INTENT(IN) :: PSNOWGRAN1
REAL, INTENT(IN) :: PSNOWGRAN2
REAL, INTENT(OUT) :: PDIAM
!
- CHARACTER(3), INTENT(IN) :: HSNOWMETAMO
+CHARACTER(3), INTENT(IN) :: HSNOWMETAMO
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -2278,6 +2294,99 @@ IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LRADABS_2D',1,ZHOOK_HANDLE)
END FUNCTION SNOW3LRADABS_2D
!####################################################################
!####################################################################
+!####################################################################
+FUNCTION SNOW3LRADABS_SFC(PSNOWRHO,PSNOWDZ,PSPECTRALALBEDO,PZENITH,PPERMSNOWFRAC,PDSGRAIN) RESULT(PCOEF)
+!
+!! PURPOSE
+!! -------
+! Calculate the transmission of shortwave radiation within the snowpack
+! (with depth) for 3 spectral bands
+! A. Boone 02/2011
+! A. Boone 11/2014 Updated to use spectral dependence
+! NOTE, assumes 3 spectral bands
+! A. Boone 06/2017 ONLY considers albedo of uppermost layer
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_SNOW_PAR, ONLY : XVSPEC1,XVSPEC2,XVSPEC3,XVBETA1,XVBETA2, &
+ XVBETA4,XVBETA3,XVBETA5, XMINCOSZEN
+USE MODD_MEB_PAR, ONLY : XSW_WGHT_VIS, XSW_WGHT_NIR
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWRHO ! snow density (kg m-3)
+REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWDZ ! layer thickness (m)
+REAL, DIMENSION(:), INTENT(IN) :: PZENITH ! zenith angle (rad)
+REAL, DIMENSION(:), INTENT(IN) :: PPERMSNOWFRAC ! permanent snow fraction (-)
+REAL, DIMENSION(:,:), INTENT(IN) :: PSPECTRALALBEDO ! spectral albedo (-)
+REAL, DIMENSION(:,:), INTENT(IN) :: PDSGRAIN ! Snow optical grain diameter (m)
+!
+REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: PCOEF ! -
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: JJ, JI, INLVLS, INI
+REAL, DIMENSION(SIZE(PSNOWRHO,1)) :: ZPROJLAT, ZOPTICALPATH1, &
+ ZOPTICALPATH2, ZOPTICALPATH3
+REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZWORK, ZBETA1, ZBETA2, ZBETA3
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LRADABS_SFC',0,ZHOOK_HANDLE)
+!
+INI = SIZE(PSNOWDZ(:,:),1)
+INLVLS = SIZE(PSNOWDZ(:,:),2)
+!
+! Coefficient for taking into account the increase of path length of rays
+! in snow due to zenithal angle
+!
+ZPROJLAT(:) = (1.0-PPERMSNOWFRAC(:))+PPERMSNOWFRAC(:)/ &
+ MAX(XMINCOSZEN,COS(PZENITH(:)))
+!
+! Extinction coefficient:
+!
+ZWORK(:,:) = SQRT(PDSGRAIN(:,:))
+ZBETA1(:,:) = MAX(XVBETA1*PSNOWRHO(:,:)/ZWORK(:,:),XVBETA2)
+ZBETA2(:,:) = MAX(XVBETA3*PSNOWRHO(:,:)/ZWORK(:,:),XVBETA4)
+ZBETA3(:,:) = XVBETA5
+!
+ZOPTICALPATH1(:) = 0.0
+ZOPTICALPATH2(:) = 0.0
+ZOPTICALPATH3(:) = 0.0
+!
+DO JJ=1,INLVLS
+ DO JI=1,INI
+ ZOPTICALPATH1(JI) = ZOPTICALPATH1(JI) + ZBETA1(JI,JJ)*PSNOWDZ(JI,JJ)
+ ZOPTICALPATH2(JI) = ZOPTICALPATH2(JI) + ZBETA2(JI,JJ)*PSNOWDZ(JI,JJ)
+
+ IF(PSPECTRALALBEDO(JI,3)==XUNDEF)THEN
+
+ PCOEF (JI,JJ) = XSW_WGHT_VIS*(1.0-PSPECTRALALBEDO(JI,1))*EXP(-ZOPTICALPATH1(JI)*ZPROJLAT(JI)) &
+ + XSW_WGHT_NIR*(1.0-PSPECTRALALBEDO(JI,2))*EXP(-ZOPTICALPATH2(JI)*ZPROJLAT(JI))
+ ELSE
+
+ ZOPTICALPATH3(JI) = ZOPTICALPATH3(JI) + ZBETA3(JI,JJ)*PSNOWDZ(JI,JJ)
+
+ PCOEF (JI,JJ) = XVSPEC1*(1.0-PSPECTRALALBEDO(JI,1))*EXP(-ZOPTICALPATH1(JI)*ZPROJLAT(JI)) &
+ + XVSPEC2*(1.0-PSPECTRALALBEDO(JI,2))*EXP(-ZOPTICALPATH2(JI)*ZPROJLAT(JI)) &
+ + XVSPEC3*(1.0-PSPECTRALALBEDO(JI,3))*EXP(-ZOPTICALPATH3(JI)*ZPROJLAT(JI))
+
+ ENDIF
+
+ ENDDO
+ENDDO
+!
+IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LRADABS_SFC',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------
+!
+END FUNCTION SNOW3LRADABS_SFC
+!####################################################################
+!####################################################################
!####################################################################
SUBROUTINE SNOW3LTHRM(PSNOWRHO,PSCOND,PSNOWTEMP,PPS)
!
@@ -2318,7 +2427,7 @@ INTEGER :: JJ, JI
INTEGER :: INI
INTEGER :: INLVLS
!
- CHARACTER(LEN=5) :: YSNOWCOND !should be in namelist
+CHARACTER(LEN=5) :: YSNOWCOND !should be in namelist
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
@@ -2575,5 +2684,517 @@ END SUBROUTINE SNOW3LALB
!####################################################################
!####################################################################
!####################################################################
+SUBROUTINE SNOW3LFALL(PTSTEP,PSR,PTA,PVMOD,PSNOW,PSNOWRHO,PSNOWDZ, &
+ PSNOWHEAT,PSNOWHMASS,PSNOWAGE,PPERMSNOWFRAC)
+!
+!! PURPOSE
+!! -------
+! Calculate changes to snowpack resulting from snowfall.
+! Update mass and heat content of uppermost layer.
+!
+!
+USE MODD_CSTS, ONLY : XLMTT, XTT, XCI
+USE MODD_SNOW_PAR, ONLY : XRHOSMIN_ES, XSNOWDMIN, &
+ XSNOWFALL_A_SN, &
+ XSNOWFALL_B_SN, &
+ XSNOWFALL_C_SN
+!
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE PARKIND1 , ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+REAL, INTENT(IN) :: PTSTEP
+!
+REAL, DIMENSION(:), INTENT(IN) :: PSR, PTA, PVMOD, PPERMSNOWFRAC
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PSNOW
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWRHO, PSNOWDZ, PSNOWHEAT, PSNOWAGE
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PSNOWHMASS
+!
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: JJ, JI
+!
+INTEGER :: INI
+INTEGER :: INLVLS
+!
+REAL, DIMENSION(SIZE(PTA)) :: ZSNOWFALL, ZRHOSNEW, &
+ ZSNOW, ZSNOWTEMP, &
+ ZSNOWFALL_DELTA, ZSCAP, &
+ ZAGENEW
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+!
+! 0. Initialize:
+! ------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LFALL',0,ZHOOK_HANDLE)
+!
+INI = SIZE(PSNOWDZ(:,:),1)
+INLVLS = SIZE(PSNOWDZ(:,:),2)
+!
+ZRHOSNEW(:) = XRHOSMIN_ES
+ZAGENEW (:) = 0.0
+ZSNOWFALL(:) = 0.0
+ZSCAP(:) = 0.0
+ZSNOW(:) = PSNOW(:)
+!
+PSNOWHMASS(:) = 0.0
+!
+! 1. Incorporate snowfall into snowpack:
+! --------------------------------------
+!
+!
+! Heat content of newly fallen snow (J/m2):
+! NOTE for now we assume the snowfall has
+! the temperature of the snow surface upon reaching the snow.
+! This is done as opposed to using the air temperature since
+! this flux is quite small and has little to no impact
+! on the time scales of interest. If we use the above assumption
+! then, then the snowfall advective heat flux is zero.
+!
+ZSNOWTEMP(:) = XTT
+ZSCAP (:) = SNOW3LSCAP(PSNOWRHO(:,1))
+!
+WHERE (PSR(:) > 0.0 .AND. PSNOWDZ(:,1)>0.)
+ ZSNOWTEMP(:) = XTT + (PSNOWHEAT(:,1) + &
+ XLMTT*PSNOWRHO(:,1)*PSNOWDZ(:,1))/ &
+ (ZSCAP(:)*MAX(XSNOWDMIN/INLVLS,PSNOWDZ(:,1)))
+ ZSNOWTEMP(:) = MIN(XTT, ZSNOWTEMP(:))
+END WHERE
+!
+WHERE (PSR(:) > 0.0)
+!
+ PSNOWHMASS(:) = PSR(:)*(XCI*(ZSNOWTEMP(:)-XTT)-XLMTT)*PTSTEP
+!
+! Snowfall density: Following CROCUS (Pahaut 1976)
+!
+ ZRHOSNEW(:) = MAX(XRHOSMIN_ES, XSNOWFALL_A_SN + XSNOWFALL_B_SN*(PTA(:)-XTT)+ &
+ XSNOWFALL_C_SN*SQRT(PVMOD(:)))
+!
+!
+! Fresh snowfall changes the snowpack age,
+! decreasing in uppermost snow layer (mass weighted average):
+!
+ PSNOWAGE(:,1) = (PSNOWAGE(:,1)*PSNOWDZ(:,1)*PSNOWRHO(:,1)+ZAGENEW(:)*PSR(:)*PTSTEP) / &
+ (PSNOWDZ(:,1)*PSNOWRHO(:,1)+PSR(:)*PTSTEP)
+!
+! Augment total pack depth:
+!
+ ZSNOWFALL(:) = PSR(:)*PTSTEP/ZRHOSNEW(:) ! snowfall thickness (m)
+!
+ PSNOW(:) = PSNOW(:) + ZSNOWFALL(:)
+!
+! Fresh snowfall changes the snowpack
+! density, increases the total liquid water
+! equivalent: in uppermost snow layer:
+!
+ PSNOWRHO(:,1) = (PSNOWDZ(:,1)*PSNOWRHO(:,1) + ZSNOWFALL(:)*ZRHOSNEW(:))/ &
+ (PSNOWDZ(:,1)+ZSNOWFALL(:))
+!
+ PSNOWDZ(:,1) = PSNOWDZ(:,1) + ZSNOWFALL(:)
+!
+! Add energy of snowfall to snowpack:
+! Update heat content (J/m2) (therefore the snow temperature
+! and liquid content):
+!
+ PSNOWHEAT(:,1) = PSNOWHEAT(:,1) + PSNOWHMASS(:)
+!
+END WHERE
+!
+!
+! 2. Case of new snowfall on a previously snow-free surface:
+! ----------------------------------------------------------
+!
+! When snow first falls on a surface devoid of snow,
+! redistribute the snow mass throughout the 3 layers:
+! (temperature already set in the calling routine
+! for this case)
+!
+ZSNOWFALL_DELTA(:) = 0.0
+WHERE(ZSNOW(:) == 0.0 .AND. PSR(:) > 0.0)
+ ZSNOWFALL_DELTA(:) = 1.0
+END WHERE
+!
+DO JJ=1,INLVLS
+ DO JI=1,INI
+!
+ PSNOWDZ(JI,JJ) = ZSNOWFALL_DELTA(JI)*(ZSNOWFALL(JI) /INLVLS) + &
+ (1.0-ZSNOWFALL_DELTA(JI))*PSNOWDZ(JI,JJ)
+!
+ PSNOWHEAT(JI,JJ) = ZSNOWFALL_DELTA(JI)*(PSNOWHMASS(JI)/INLVLS) + &
+ (1.0-ZSNOWFALL_DELTA(JI))*PSNOWHEAT(JI,JJ)
+!
+ PSNOWRHO(JI,JJ) = ZSNOWFALL_DELTA(JI)*ZRHOSNEW(JI) + &
+ (1.0-ZSNOWFALL_DELTA(JI))*PSNOWRHO(JI,JJ)
+!
+ PSNOWAGE(JI,JJ) = ZSNOWFALL_DELTA(JI)*(ZAGENEW(JI)/INLVLS) + &
+ (1.0-ZSNOWFALL_DELTA(JI))*PSNOWAGE(JI,JJ)
+!
+ ENDDO
+ENDDO
+!
+IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LFALL',1,ZHOOK_HANDLE)
+!
+!
+END SUBROUTINE SNOW3LFALL
+!####################################################################
+!####################################################################
+!####################################################################
+SUBROUTINE SNOW3LCOMPACTN(PTSTEP,PSNOWDZMIN,PSNOWRHO,PSNOWDZ,PSNOWTEMP,PSNOW,PSNOWLIQ)
+!
+!! PURPOSE
+!! -------
+! Snow compaction due to overburden and settling.
+! Mass is unchanged: layer thickness is reduced
+! in proportion to density increases. Method
+! of Brun et al (1989) and Vionnet et al. (2012)
+!
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE MODD_CSTS, ONLY : XTT, XG
+USE MODD_SNOW_PAR, ONLY : XRHOSMAX_ES
+!
+USE MODD_SNOW_METAMO, ONLY : XVVISC1,XVVISC3,XVVISC4, &
+ XVVISC5,XVVISC6,XVRO11
+!
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE PARKIND1 , ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+REAL, INTENT(IN) :: PTSTEP
+REAL, INTENT(IN) :: PSNOWDZMIN
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWTEMP, PSNOWLIQ
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWRHO, PSNOWDZ
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PSNOW
+!
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: JJ, JI
+!
+INTEGER :: INI
+INTEGER :: INLVLS
+!
+REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWRHO2, ZVISCOCITY, ZF1, &
+ ZTEMP, ZSMASS, ZSNOWDZ, &
+ ZWSNOWDZ, ZWHOLDMAX
+!
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+!
+! 0. Initialization:
+! ------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LCOMPACTN',0,ZHOOK_HANDLE)
+!
+INI = SIZE(PSNOWDZ(:,:),1)
+INLVLS = SIZE(PSNOWDZ(:,:),2)
+!
+ZSNOWRHO2 (:,:) = PSNOWRHO(:,:)
+ZSNOWDZ (:,:) = MAX(PSNOWDZMIN,PSNOWDZ(:,:))
+ZVISCOCITY(:,:) = 0.0
+ZTEMP (:,:) = 0.0
+!
+! 1. Cumulative snow mass (kg/m2):
+! --------------------------------
+!
+ZSMASS(:,:) = 0.0
+DO JJ=2,INLVLS
+ DO JI=1,INI
+ ZSMASS(JI,JJ) = ZSMASS(JI,JJ-1) + PSNOWDZ(JI,JJ-1)*PSNOWRHO(JI,JJ-1)
+ ENDDO
+ENDDO
+! overburden of half the mass of the uppermost layer applied to itself
+ZSMASS(:,1) = 0.5 * PSNOWDZ(:,1) * PSNOWRHO(:,1)
+!
+! 2. Compaction
+! -------------
+!
+!Liquid water effect
+!
+ZWHOLDMAX(:,:) = SNOW3LHOLD(PSNOWRHO,PSNOWDZ)
+ZWHOLDMAX(:,:) = MAX(1.E-10, ZWHOLDMAX(:,:))
+ZF1(:,:) = 1.0/(XVVISC5+10.*MIN(1.0,PSNOWLIQ(:,:)/ZWHOLDMAX(:,:)))
+!
+!Snow viscocity, density and grid thicknesses
+!
+DO JJ=1,INLVLS
+ DO JI=1,INI
+!
+ IF(PSNOWRHO(JI,JJ) < XRHOSMAX_ES)THEN
+!
+! temperature dependence limited to 5K: Schleef et al. (2014)
+ ZTEMP (JI,JJ) = XVVISC4*MIN(5.0,ABS(XTT-PSNOWTEMP(JI,JJ)))
+!
+! Calculate snow viscocity: Brun et al. (1989), Vionnet et al. (2012)
+ ZVISCOCITY(JI,JJ) = XVVISC1*ZF1(JI,JJ)*EXP(XVVISC3*PSNOWRHO(JI,JJ)+ZTEMP(JI,JJ))*PSNOWRHO(JI,JJ)/XVRO11
+!
+! Calculate snow density:
+ ZSNOWRHO2(JI,JJ) = PSNOWRHO(JI,JJ) + PSNOWRHO(JI,JJ)*PTSTEP &
+ * ( (XG*ZSMASS(JI,JJ)/ZVISCOCITY(JI,JJ)) )
+!
+! Conserve mass by decreasing grid thicknesses in response to density increases
+ PSNOWDZ(JI,JJ) = PSNOWDZ(JI,JJ)*(PSNOWRHO(JI,JJ)/ZSNOWRHO2(JI,JJ))
+!
+ ENDIF
+!
+ ENDDO
+ENDDO
+!
+! 3. Update total snow depth and density profile:
+! -----------------------------------------------
+!
+! Compaction/augmentation of total snowpack depth
+!
+PSNOW(:) = 0.
+DO JJ=1,INLVLS
+ DO JI=1,INI
+ PSNOW(JI) = PSNOW(JI) + PSNOWDZ(JI,JJ)
+ ENDDO
+ENDDO
+!
+! Update density (kg m-3):
+!
+PSNOWRHO(:,:) = ZSNOWRHO2(:,:)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LCOMPACTN',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE SNOW3LCOMPACTN
+!####################################################################
+!####################################################################
+!####################################################################
+ SUBROUTINE SNOW3LTRANSF(PSNOW,PSNOWDZ,PSNOWDZN, &
+ PSNOWRHO,PSNOWHEAT,PSNOWAGE)
+!
+!! PURPOSE
+!! -------
+! Snow mass,heat and characteristics redistibution in case of
+! grid resizing. Total mass and heat content of the overall snowpack
+! unchanged/conserved within this routine.
+! Same method as in Crocus
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_SNOW_PAR, ONLY : XSNOWCRITD
+!
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE PARKIND1 , ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+REAL, DIMENSION(: ), INTENT(IN) :: PSNOW
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWDZN
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWHEAT
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWRHO
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWDZ
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWAGE
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: JI, JL, JLO
+!
+INTEGER :: INI
+INTEGER :: INLVLS
+!
+REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWRHON
+REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWHEATN
+REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWAGEN
+REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWZTOP_NEW
+REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWZBOT_NEW
+REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWRHOO
+REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWHEATO
+REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWAGEO
+REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWDZO
+REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWZTOP_OLD
+REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWZBOT_OLD
+REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWHEAN
+REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWAGN
+REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZMASTOTN
+REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZMASSDZO
+!
+REAL, DIMENSION(SIZE(PSNOW)) :: ZPSNOW_OLD, ZPSNOW_NEW
+REAL, DIMENSION(SIZE(PSNOW)) :: ZSUMHEAT, ZSUMSWE, ZSUMAGE, ZSNOWMIX_DELTA
+!
+REAL :: ZPROPOR
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+!
+! 0. Initialization:
+! ------------------
+!
+!
+IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LTRANSF',0,ZHOOK_HANDLE)
+!
+INI = SIZE(PSNOWRHO,1)
+INLVLS = SIZE(PSNOWRHO,2)
+!
+ZPSNOW_NEW(:) = 0.0
+ZPSNOW_OLD(:) = PSNOW(:)
+!
+DO JL=1,INLVLS
+ DO JI=1,INI
+ ZPSNOW_NEW(JI)=ZPSNOW_NEW(JI)+PSNOWDZN(JI,JL)
+ ENDDO
+ENDDO
+!
+! initialization of variables describing the initial snowpack
+!
+ZSNOWDZO (:,:) = PSNOWDZ (:,:)
+ZSNOWRHOO (:,:) = PSNOWRHO (:,:)
+ZSNOWHEATO(:,:) = PSNOWHEAT(:,:)
+ZSNOWAGEO (:,:) = PSNOWAGE (:,:)
+ZMASSDZO (:,:) = XUNDEF
+!
+! 1. Calculate vertical grid limits (m):
+! --------------------------------------
+!
+ZSNOWZTOP_OLD(:,1) = ZPSNOW_OLD(:)
+ZSNOWZTOP_NEW(:,1) = ZPSNOW_NEW(:)
+ZSNOWZBOT_OLD(:,1) = ZSNOWZTOP_OLD(:,1)-ZSNOWDZO(:,1)
+ZSNOWZBOT_NEW(:,1) = ZSNOWZTOP_NEW(:,1)-PSNOWDZN(:,1)
+!
+DO JL=2,INLVLS
+ DO JI=1,INI
+ ZSNOWZTOP_OLD(JI,JL) = ZSNOWZBOT_OLD(JI,JL-1)
+ ZSNOWZTOP_NEW(JI,JL) = ZSNOWZBOT_NEW(JI,JL-1)
+ ZSNOWZBOT_OLD(JI,JL) = ZSNOWZTOP_OLD(JI,JL )-ZSNOWDZO(JI,JL)
+ ZSNOWZBOT_NEW(JI,JL) = ZSNOWZTOP_NEW(JI,JL )-PSNOWDZN(JI,JL)
+ ENDDO
+ENDDO
+ZSNOWZBOT_OLD(:,INLVLS)=0.0
+ZSNOWZBOT_NEW(:,INLVLS)=0.0
+!
+! 3. Calculate mass, heat, charcateristics mixing due to vertical grid resizing:
+! --------------------------------------------------------------------
+!
+! loop over the new snow layers
+! Summ or avergage of the constituting quantities of the old snow layers
+! which are totally or partially inserted in the new snow layer
+! For snow age, mass weighted average is used.
+!
+ZSNOWHEAN(:,:)=0.0
+ZMASTOTN (:,:)=0.0
+ZSNOWAGN (:,:)=0.0
+!
+DO JL=1,INLVLS
+ DO JLO=1, INLVLS
+ DO JI=1,INI
+ IF((ZSNOWZTOP_OLD(JI,JLO)>ZSNOWZBOT_NEW(JI,JL)).AND.(ZSNOWZBOT_OLD(JI,JLO)<ZSNOWZTOP_NEW(JI,JL)))THEN
+!
+ ZPROPOR = (MIN(ZSNOWZTOP_OLD(JI,JLO), ZSNOWZTOP_NEW(JI,JL)) &
+ - MAX(ZSNOWZBOT_OLD(JI,JLO), ZSNOWZBOT_NEW(JI,JL)))&
+ / ZSNOWDZO(JI,JLO)
+!
+ ZMASSDZO (JI,JLO)=ZSNOWRHOO(JI,JLO)*ZSNOWDZO(JI,JLO)*ZPROPOR
+!
+ ZMASTOTN (JI,JL)=ZMASTOTN (JI,JL)+ZMASSDZO (JI,JLO)
+ ZSNOWAGN (JI,JL)=ZSNOWAGN (JI,JL)+ZSNOWAGEO (JI,JLO)*ZMASSDZO(JI,JLO)
+!
+ ZSNOWHEAN(JI,JL)=ZSNOWHEAN(JI,JL)+ZSNOWHEATO(JI,JLO)*ZPROPOR
+!
+ ENDIF
+ ENDDO
+ ENDDO
+ENDDO
+!
+! the new layer inherits from the weighted average properties of the old ones
+! heat and mass
+!
+ZSNOWHEATN(:,:)= ZSNOWHEAN(:,:)
+ZSNOWAGEN (:,:)= ZSNOWAGN (:,:)/ZMASTOTN(:,:)
+ZSNOWRHON (:,:)= ZMASTOTN (:,:)/PSNOWDZN(:,:)
+!
+!
+! 4. Vanishing or very thin snowpack check:
+! -----------------------------------------
+!
+! NOTE: ONLY for very shallow snowpacks, mix properties (homogeneous):
+! this avoids problems related to heat and mass exchange for
+! thin layers during heavy snowfall or signifigant melt: one
+! new/old layer can exceed the thickness of several old/new layers.
+! Therefore, mix (conservative):
+!
+ZSUMHEAT(:) = 0.0
+ZSUMSWE(:) = 0.0
+ZSUMAGE(:) = 0.0
+ZSNOWMIX_DELTA(:) = 0.0
+!
+DO JL=1,INLVLS
+ DO JI=1,INI
+ IF(PSNOW(JI) < XSNOWCRITD)THEN
+ ZSUMHEAT (JI) = ZSUMHEAT(JI) + PSNOWHEAT(JI,JL)
+ ZSUMSWE (JI) = ZSUMSWE (JI) + PSNOWRHO (JI,JL)*PSNOWDZ(JI,JL)
+ ZSUMAGE (JI) = ZSUMAGE (JI) + PSNOWAGE (JI,JL)
+ ZSNOWMIX_DELTA(JI) = 1.0
+ ENDIF
+ ENDDO
+ENDDO
+!
+! Heat and mass are evenly distributed vertically:
+! heat and mass (density and thickness) are constant
+! in profile:
+!
+DO JL=1,INLVLS
+ DO JI=1,INI
+!
+ ZSNOWHEATN(JI,JL) = ZSNOWMIX_DELTA(JI)*(ZSUMHEAT(JI)/INLVLS) + &
+ (1.0-ZSNOWMIX_DELTA(JI))*ZSNOWHEATN(JI,JL)
+!
+ PSNOWDZN(JI,JL) = ZSNOWMIX_DELTA(JI)*(PSNOW(JI)/INLVLS) + &
+ (1.0-ZSNOWMIX_DELTA(JI))*PSNOWDZN(JI,JL)
+!
+ ZSNOWRHON(JI,JL) = ZSNOWMIX_DELTA(JI)*(ZSUMSWE(JI)/PSNOW(JI)) + &
+ (1.0-ZSNOWMIX_DELTA(JI))*ZSNOWRHON(JI,JL)
+!
+ ZSNOWAGEN(JI,JL) = ZSNOWMIX_DELTA(JI)*(ZSUMAGE(JI)/INLVLS) + &
+ (1.0-ZSNOWMIX_DELTA(JI))*ZSNOWAGEN(JI,JL)
+!
+ ENDDO
+ENDDO
+!
+! 5. Update mass (density and thickness) and heat:
+! ------------------------------------------------
+!
+PSNOWDZ (:,:) = PSNOWDZN (:,:)
+PSNOWRHO (:,:) = ZSNOWRHON (:,:)
+PSNOWHEAT(:,:) = ZSNOWHEATN(:,:)
+PSNOWAGE (:,:) = ZSNOWAGEN (:,:)
+!
+IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LTRANSF',1,ZHOOK_HANDLE)
+!
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE SNOW3LTRANSF
+!####################################################################
+!####################################################################
+!####################################################################
+
+
END MODULE MODE_SNOW3L
diff --git a/src/SURFEX/mode_snowcro_flanner.F90 b/src/SURFEX/mode_snowcro_flanner.F90
index d7fd8ffba8ffd3e98d0909506d4a5a34b0bf10ce..afa89445276a1ea7d3d79c86b83dd14669b5a9d8 100644
--- a/src/SURFEX/mode_snowcro_flanner.F90
+++ b/src/SURFEX/mode_snowcro_flanner.F90
@@ -39,9 +39,10 @@ USE PARKIND1 ,ONLY : JPRB
!$ USE OMP_LIB
#endif
!
+USE NETCDF
+!
IMPLICIT NONE
!
-INCLUDE 'netcdf.inc'
!
#ifdef SFX_MPI
INCLUDE 'mpif.h'
@@ -51,7 +52,7 @@ INCLUDE 'mpif.h'
!$ INCLUDE 'omp_lib.h'
#endif
!
- CONTAINS
+CONTAINS
!
!------------------------------------------------------------------
!
@@ -59,6 +60,8 @@ SUBROUTINE READ_FZ06(HFILE)
!
USE MODD_SNOW_METAMO, ONLY : NID_FILE, XDRDT0, XTAU, XKAPPA
!
+USE NETCDF
+!
IMPLICIT NONE
!
!* 1. declarations of arguments
@@ -80,29 +83,23 @@ IF (LHOOK) CALL DR_HOOK('SNOWCRO_FLANNER',0,ZHOOK_HANDLE)
! Open netcdf file
!
IF (NRANK==NPIO) THEN
-!$OMP SINGLE
- IERROR = NF_OPEN(HFILE,NF_NOWRITE,NID_FILE)
+ IERROR = NF90_OPEN(HFILE,NF90_NOWRITE,NID_FILE)
CALL HANDLE_ERR_CDF(IERROR,"can't open file "//TRIM(HFILE))
-!$OMP END SINGLE
ENDIF
!
IF (NPROC>1) THEN
#ifdef SFX_MPI
-!$OMP SINGLE
CALL MPI_BCAST(NID_FILE,KIND(NID_FILE)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
-!$OMP END SINGLE
#endif
ENDIF
!
- CALL READ_VAR_FZ06(NID_FILE,HVARNAME(1),XDRDT0)
- CALL READ_VAR_FZ06(NID_FILE,HVARNAME(2),XTAU)
- CALL READ_VAR_FZ06(NID_FILE,HVARNAME(3),XKAPPA)
+CALL READ_VAR_FZ06(NID_FILE,HVARNAME(1),XDRDT0)
+CALL READ_VAR_FZ06(NID_FILE,HVARNAME(2),XTAU)
+CALL READ_VAR_FZ06(NID_FILE,HVARNAME(3),XKAPPA)
!
IF (NRANK==NPIO) THEN
-!$OMP SINGLE
! Close netcdf file
- IERROR=NF_CLOSE(NID_FILE)
-!$OMP END SINGLE
+ IERROR=NF90_CLOSE(NID_FILE)
ENDIF
!
IF (LHOOK) CALL DR_HOOK('SNOWCRO_FLANNER',1,ZHOOK_HANDLE)
@@ -114,6 +111,8 @@ SUBROUTINE READ_VAR_FZ06(ID_FILE,HSURF,PVAR)
USE MODD_SNOW_METAMO, ONLY : NVARDIMS, NLENDIM1, NLENDIM2, &
NLENDIM3, NID_VAR
!
+USE NETCDF
+!
IMPLICIT NONE
!
INTEGER,INTENT(IN) :: ID_FILE
@@ -126,64 +125,54 @@ INTEGER, DIMENSION(:), ALLOCATABLE :: IVARDIMSID
INTEGER :: IERROR !error status
!
IF (NRANK==NPIO) THEN
-!$OMP SINGLE
! Look for variable ID
- IERROR = NF_INQ_VARID(ID_FILE,TRIM(HSURF),NID_VAR)
+ IERROR = NF90_INQ_VARID(ID_FILE,TRIM(HSURF),NID_VAR)
CALL HANDLE_ERR_CDF(IERROR,"can't find variable "//TRIM(HSURF))
!
! Number of dimensions
- IERROR = NF_INQ_VARNDIMS(ID_FILE,NID_VAR,NVARDIMS)
- IF ( IERROR/=NF_NOERR ) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions number")
+ IERROR = NF90_INQUIRE_VARIABLE(ID_FILE,NID_VAR,NDIMS=NVARDIMS)
+ IF ( IERROR/=NF90_NOERR ) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions number")
!
! Id of dimensions
ALLOCATE(IVARDIMSID(NVARDIMS))
- IERROR = NF_INQ_VARDIMID(ID_FILE,NID_VAR,IVARDIMSID)
- IF ( IERROR/=NF_NOERR ) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions ids")
+ IERROR = NF90_INQUIRE_VARIABLE(ID_FILE,NID_VAR,DIMIDS=IVARDIMSID)
+ IF ( IERROR/=NF90_NOERR ) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions ids")
!
SELECT CASE (NVARDIMS)
!
CASE (3)
- IERROR = NF_INQ_DIMLEN(ID_FILE,IVARDIMSID(1),NLENDIM1)
- IF ( IERROR/=NF_NOERR ) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions lengths")
- IERROR = NF_INQ_DIMLEN(ID_FILE,IVARDIMSID(2),NLENDIM2)
- IF ( IERROR/=NF_NOERR ) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions lengths")
- IERROR = NF_INQ_DIMLEN(ID_FILE,IVARDIMSID(3),NLENDIM3)
- IF ( IERROR/=NF_NOERR ) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions lengths")
+ IERROR = NF90_INQUIRE_DIMENSION(ID_FILE,IVARDIMSID(1),LEN=NLENDIM1)
+ IF ( IERROR/=NF90_NOERR ) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions lengths")
+ IERROR = NF90_INQUIRE_DIMENSION(ID_FILE,IVARDIMSID(2),LEN=NLENDIM2)
+ IF ( IERROR/=NF90_NOERR ) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions lengths")
+ IERROR = NF90_INQUIRE_DIMENSION(ID_FILE,IVARDIMSID(3),LEN=NLENDIM3)
+ IF ( IERROR/=NF90_NOERR ) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions lengths")
!
CASE DEFAULT
CALL ABOR1_SFX('SNOWCRO_FLANNER: incorrect number of dimensions for variable '//TRIM(HSURF))
!
END SELECT
-!$OMP END SINGLE
ENDIF
!
IF (NPROC>1) THEN
#ifdef SFX_MPI
-!$OMP SINGLE
CALL MPI_BCAST(NLENDIM1,KIND(NLENDIM1)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
CALL MPI_BCAST(NLENDIM2,KIND(NLENDIM2)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
CALL MPI_BCAST(NLENDIM3,KIND(NLENDIM3)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
-!$OMP END SINGLE
#endif
ENDIF
!
-!$OMP SINGLE
ALLOCATE(PVAR(NLENDIM1,NLENDIM2,NLENDIM3))
-!$OMP END SINGLE
!
IF (NRANK==NPIO) THEN
-!$OMP SINGLE
! Read 3D variable
- IERROR = NF_GET_VAR_DOUBLE(ID_FILE,NID_VAR,PVAR)
+ IERROR = NF90_GET_VAR(ID_FILE,NID_VAR,PVAR)
CALL HANDLE_ERR_CDF(IERROR,"can't read variable "//TRIM(HSURF))
-!$OMP END SINGLE
ENDIF
!
IF (NPROC>1) THEN
#ifdef SFX_MPI
-!$OMP SINGLE
CALL MPI_BCAST(PVAR,KIND(PVAR)*SIZE(PVAR)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
-!$OMP END SINGLE
#endif
ENDIF
!
diff --git a/src/SURFEX/mode_soil.F90 b/src/SURFEX/mode_soil.F90
index 3a88f07ff72e8eac2363b15750cc519fd2ae4f80..6bd59547a3a367262e13c02034ab75b59ee91821 100644
--- a/src/SURFEX/mode_soil.F90
+++ b/src/SURFEX/mode_soil.F90
@@ -114,7 +114,7 @@ INTERFACE ANISO_FUNC
END INTERFACE
!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!
FUNCTION WSAT_FUNC_2D(PCLAY,PSAND,HPEDOTF)
USE MODD_SURF_PAR, ONLY : XUNDEF
diff --git a/src/SURFEX/mode_splines.F90 b/src/SURFEX/mode_splines.F90
index a2e67560e61734f9b2908c76af10bb0397fc07a3..2e64fc0f58e2ef83a94fd9e6325fc0293a884da2 100644
--- a/src/SURFEX/mode_splines.F90
+++ b/src/SURFEX/mode_splines.F90
@@ -148,7 +148,7 @@ INTERFACE SPLB2C
MODULE PROCEDURE SPLB2C
END INTERFACE
- CONTAINS
+CONTAINS
!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
@@ -1871,7 +1871,7 @@ M=SIZE(IW,2)
DO J=1,N
C(J,J)=C(J,J)-1.
ENDDO
- C(:,:)=-C(:,:)
+C(:,:)=-C(:,:)
!-----------------------------------------------------------
! Calcul des vecteurs propres de I - Tm c ((Tm'*Tm)-1) c Tm'
CALL EISRS1(C,VP,R1,WORK,IREP)
diff --git a/src/SURFEX/mode_split_grid_parameter.F90 b/src/SURFEX/mode_split_grid_parameter.F90
index 4da701cfc390e50ee4f06d689ec121830b904d72..975fa78bf29bcd2bc75b9e04fbfd8fe911657967 100644
--- a/src/SURFEX/mode_split_grid_parameter.F90
+++ b/src/SURFEX/mode_split_grid_parameter.F90
@@ -6,14 +6,10 @@
MODULE MODE_SPLIT_GRID_PARAMETER
!##################
!
- CONTAINS
+CONTAINS
!
! #############################################################
-#ifdef MNH_PARALLEL
- SUBROUTINE SPLIT_GRID_PARAMETERX1(HPROGRAM,HGRID,HREC,KDIM,KSIZE,KIMAX_ll,KJMAX_ll,KHALO,PFIELD,PFIELD_SPLIT)
-#else
- SUBROUTINE SPLIT_GRID_PARAMETERX1(HPROGRAM,HGRID,HREC,KDIM,KSIZE,PFIELD,PFIELD_SPLIT)
-#endif
+ SUBROUTINE SPLIT_GRID_PARAMETERX1(HPROGRAM,HGRID,HREC,KDIM,KSIZE,PFIELD,PFIELD_SPLIT,KIMAX_ll,KJMAX_ll,KHALO)
! #############################################################
!
!!**** * - routine to split a real array on the splitted grid
@@ -37,14 +33,13 @@ IMPLICIT NONE
CHARACTER(LEN=6), INTENT(IN) :: HREC ! name of the parameter
INTEGER, INTENT(IN) :: KDIM ! size of PFIELD
INTEGER, INTENT(IN) :: KSIZE ! size of PFIELD_SPLIT
-#ifdef MNH_PARALLEL
-INTEGER, INTENT(IN) :: KIMAX_ll !(global) dimension of the domain - X direction
-INTEGER, INTENT(IN) :: KJMAX_ll !(global) dimension of the domain - Y direction
-INTEGER, INTENT(IN) :: KHALO ! size of the Halo
-#endif
REAL, DIMENSION(KDIM ), INTENT(IN) :: PFIELD ! real field for complete grid
REAL, DIMENSION(KSIZE), INTENT(OUT):: PFIELD_SPLIT! real field for splitted grid
!
+INTEGER, OPTIONAL, INTENT(IN) :: KIMAX_ll !(global) dimension of the domain - X direction
+INTEGER, OPTIONAL, INTENT(IN) :: KJMAX_ll !(global) dimension of the domain - Y direction
+INTEGER, OPTIONAL, INTENT(IN) :: KHALO ! size of the Halo
+!
!* 0.2 Declarations of local variables
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -52,13 +47,17 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_SPLIT_GRID_PARAMETER:SPLIT_GRID_PARAMETERX1',0,ZHOOK_HANDLE)
!
IF (HPROGRAM=='MESONH') THEN
+ IF (PRESENT(KIMAX_ll).AND.PRESENT(KJMAX_ll).AND.PRESENT(KHALO)) THEN
#ifdef MNH_PARALLEL
- CALL SPLIT_GRID_PARAMETERX1_MNH(HGRID,HREC,KDIM,KSIZE,KIMAX_ll,KJMAX_ll,KHALO,PFIELD,PFIELD_SPLIT)
-#else
+ CALL SPLIT_GRID_PARAMETERX1_MNH(HGRID,HREC,KDIM,KSIZE,KIMAX_ll,KJMAX_ll,KHALO,PFIELD,PFIELD_SPLIT)
+#endif
+ ELSE
+#ifndef MNH_PARALLEL
#ifdef SFX_MNH
- CALL SPLIT_GRID_PARAMETERX1_MNH(HGRID,HREC,KDIM,KSIZE,PFIELD,PFIELD_SPLIT)
+ CALL SPLIT_GRID_PARAMETERX1_MNH(HGRID,HREC,KDIM,KSIZE,PFIELD,PFIELD_SPLIT)
#endif
#endif
+ ENDIF
ENDIF
!
!
@@ -75,11 +74,7 @@ END SUBROUTINE SPLIT_GRID_PARAMETERX1
!
!
! #############################################################
-#ifdef MNH_PARALLEL
- SUBROUTINE SPLIT_GRID_PARAMETERN0(HPROGRAM,HGRID,HREC,KHALO,KFIELD,KFIELD_SPLIT)
-#else
- SUBROUTINE SPLIT_GRID_PARAMETERN0(HPROGRAM,HGRID,HREC,KFIELD,KFIELD_SPLIT)
-#endif
+ SUBROUTINE SPLIT_GRID_PARAMETERN0(HPROGRAM,HGRID,HREC,KFIELD,KFIELD_SPLIT,KHALO)
! #############################################################
!
!!**** * - routine to define an integer related to splitted grid
@@ -101,11 +96,12 @@ IMPLICIT NONE
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
CHARACTER(LEN=10), INTENT(IN) :: HGRID ! grid type
CHARACTER(LEN=6), INTENT(IN) :: HREC ! name of the parameter
-#ifdef MNH_PARALLEL
-INTEGER, INTENT(IN) :: KHALO ! size of the Halo
-#endif
-INTEGER, INTENT(IN) :: KFIELD ! integer scalar for complete grid
-INTEGER, INTENT(OUT):: KFIELD_SPLIT ! integer scalar for splitted grid
+INTEGER, INTENT(IN) :: KFIELD ! integer scalar for complete grid
+INTEGER, INTENT(OUT):: KFIELD_SPLIT ! integer scalar for splitted grid
+!
+INTEGER, OPTIONAL, INTENT(IN) :: KHALO ! size of the Halo
+
+!
!* 0.2 Declarations of local variables
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -115,13 +111,17 @@ IF (LHOOK) CALL DR_HOOK('MODE_SPLIT_GRID_PARAMETER:SPLIT_GRID_PARAMETERN0',0,ZHO
!-------------------------------------------------------------------------------
!
IF (HPROGRAM=='MESONH') THEN
+ IF (PRESENT(KHALO)) THEN
#ifdef MNH_PARALLEL
- CALL SPLIT_GRID_PARAMETERN0_MNH(HGRID,HREC,KHALO,KFIELD,KFIELD_SPLIT)
-#else
+ CALL SPLIT_GRID_PARAMETERN0_MNH(HGRID,HREC,KHALO,KFIELD,KFIELD_SPLIT)
+#endif
+ ELSE
+#ifndef MNH_PARALLEL
#ifdef SFX_MNH
- CALL SPLIT_GRID_PARAMETERN0_MNH(HGRID,HREC,KFIELD,KFIELD_SPLIT)
+ CALL SPLIT_GRID_PARAMETERN0_MNH(HGRID,HREC,KFIELD,KFIELD_SPLIT)
#endif
#endif
+ ENDIF
ENDIF
!
IF (HPROGRAM=='OFFLIN') THEN
diff --git a/src/SURFEX/mode_surf_flood_frac.F90 b/src/SURFEX/mode_surf_flood_frac.F90
index 4abddc3c17579cc8303a6cf250117f3152ef72a1..1e35351881497347077480dec51ef4b69da02a8d 100644
--- a/src/SURFEX/mode_surf_flood_frac.F90
+++ b/src/SURFEX/mode_surf_flood_frac.F90
@@ -43,7 +43,7 @@ MODULE MODE_SURF_FLOOD_FRAC
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
!
! ######################################################
diff --git a/src/SURFEX/mode_surf_snow_frac.F90 b/src/SURFEX/mode_surf_snow_frac.F90
index 2c708d9e850ac4922822001630f2f86a6e9c1dd2..4bb068f055c3e57d5d700ae655dab107c301c889 100644
--- a/src/SURFEX/mode_surf_snow_frac.F90
+++ b/src/SURFEX/mode_surf_snow_frac.F90
@@ -45,7 +45,7 @@
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
!
! ###############################################
diff --git a/src/SURFEX/mode_tartes.F90 b/src/SURFEX/mode_tartes.F90
index 8b19388521a24a9182750beed2f6b458eaed7027..6d0650e9eae7af4ba7708509c455fcb49c3e1640 100644
--- a/src/SURFEX/mode_tartes.F90
+++ b/src/SURFEX/mode_tartes.F90
@@ -1029,6 +1029,7 @@ INTEGER, DIMENSION(:,:), INTENT(IN) :: KNLVLS_EFF !number of effective layers (n
INTEGER, DIMENSION(:), INTENT(IN) :: KMAX_EFF !maximum number of effective layers over the domain (nbands)
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEPROFILE ! energy absorbed by each layer (W/m^2) npoints,nlayer,nbands)
!
+REAL :: ZINT1, ZINT2, ZINT3, ZINT4, ZINT5
REAL :: ZDEXP, ZFDU, ZFDD, ZSTAR
!
INTEGER::JB,JL,JJ !loop counter
@@ -1041,36 +1042,45 @@ DO JB = 1,NPNBANDS
!
DO JJ =1,SIZE(PEPROFILE,1)
!
- ZSTAR = PKESTAR(JJ,1,JB) * PDTAUSTAR(JJ,1,JB)
- !
- !surface layer doc equation 64
- PEPROFILE(JJ,1,JB) = ( PCOSZEN(JJ) - ( PXC(JJ,1,JB)+PXD(JJ,1,JB)+PGP(JJ,1,JB) ) ) + &
- ( PXC(JJ,1,JB) * EXP(-ZSTAR) + PXD(JJ,1,JB) * EXP(ZSTAR) + &
- PGP(JJ,1,JB) * EXP( -PDTAUSTAR(JJ,1,JB)/PCOSZEN(JJ)) ) - &
- ( PXA(JJ,1,JB) * EXP(-ZSTAR) + PXB(JJ,1,JB) * EXP(ZSTAR) + &
- PGM(JJ,1,JB) * EXP( -PDTAUSTAR(JJ,1,JB)/PCOSZEN(JJ)) + &
- PCOSZEN(JJ) * EXP( -PTAUSTAR (JJ,1,JB)/PCOSZEN(JJ)) )
- !
- !internal layers
- !
- DO JL = 2,KMAX_EFF(JB)
- !
- ZSTAR = PKESTAR(JJ,JL,JB) * PDTAUSTAR(JJ,JL,JB)
+ DO JL = 1,KMAX_EFF(JB)
!
- IF ( JL<=KNLVLS_EFF(JJ,JB) ) THEN
+ IF (JL==1.OR.JL<=KNLVLS_EFF(JJ,JB)) THEN
!
- !last factor in equations 62 and 63
- ZDEXP = EXP( -PTAUSTAR(JJ,JL ,JB)/PCOSZEN(JJ) ) - EXP( -PTAUSTAR(JJ,JL-1,JB)/PCOSZEN(JJ) )
+ ZSTAR = PKESTAR(JJ,JL,JB) * PDTAUSTAR(JJ,JL,JB)
+ ZINT1 = EXP(-ZSTAR)
+ ZINT2 = EXP( ZSTAR)
!
- !doc equation 62
- ZFDU = PXC(JJ,JL,JB) * ( EXP(-ZSTAR) -1. ) + &
- PXD(JJ,JL,JB) * ( EXP( ZSTAR) -1. ) + PGP(JJ,JL,JB) * ZDEXP
- !
- !doc equation 63
- ZFDD = PXA(JJ,JL,JB) * ( EXP(-ZSTAR) -1. ) + &
- PXB(JJ,JL,JB) * ( EXP( ZSTAR) -1. ) + ( PGM(JJ,JL,JB) + PCOSZEN(JJ) ) * ZDEXP
- !
- PEPROFILE(JJ,JL,JB) = ZFDU - ZFDD !doc equation 61
+ IF (JL==1) THEN
+ !
+ ZINT3 = EXP( -PDTAUSTAR(JJ,JL,JB)/PCOSZEN(JJ))
+ ZINT4 = EXP( -PTAUSTAR (JJ,JL,JB)/PCOSZEN(JJ))
+ !
+ !surface layer doc equation 64
+ PEPROFILE(JJ,1,JB) = ( PCOSZEN(JJ) - ( PXC(JJ,1,JB)+PXD(JJ,1,JB)+PGP(JJ,1,JB) ) ) + &
+ ( PXC(JJ,1,JB) * ZINT1 + PXD(JJ,1,JB) * ZINT2 + &
+ PGP(JJ,1,JB) * ZINT3 ) - &
+ ( PXA(JJ,1,JB) * ZINT1 + PXB(JJ,1,JB) * ZINT2 + &
+ PGM(JJ,1,JB) * ZINT3 + &
+ PCOSZEN(JJ) * ZINT4 )
+ !
+ ELSE
+ !
+ ZINT5 = EXP( -PTAUSTAR(JJ,JL ,JB)/PCOSZEN(JJ) )
+ !last factor in equations 62 and 63
+ ZDEXP = ZINT5 - ZINT4
+ ZINT4 = ZINT5
+ !
+ !doc equation 62
+ ZFDU = PXC(JJ,JL,JB) * ( ZINT1 -1. ) + &
+ PXD(JJ,JL,JB) * ( ZINT2 -1. ) + PGP(JJ,JL,JB) * ZDEXP
+ !
+ !doc equation 63
+ ZFDD = PXA(JJ,JL,JB) * ( ZINT1 -1. ) + &
+ PXB(JJ,JL,JB) * ( ZINT2 -1. ) + ( PGM(JJ,JL,JB) + PCOSZEN(JJ) ) * ZDEXP
+ !
+ PEPROFILE(JJ,JL,JB) = ZFDU - ZFDD !doc equation 61
+ !
+ ENDIF
!
ELSE
!
diff --git a/src/SURFEX/mode_teb_veg.F90 b/src/SURFEX/mode_teb_veg.F90
new file mode 100644
index 0000000000000000000000000000000000000000..e2905a514b50423a06ee0c9f1fa3ba79c8410fa5
--- /dev/null
+++ b/src/SURFEX/mode_teb_veg.F90
@@ -0,0 +1,129 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+MODULE MODE_TEB_VEG
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_P_t, ISBA_PE_t, ISBA_S_t
+!
+IMPLICIT NONE
+!
+CONTAINS
+!
+SUBROUTINE INIT_IF_DIF(KGROUND_LAYER, PMASK, P)
+!
+INTEGER, INTENT(IN) :: KGROUND_LAYER
+REAL, DIMENSION(:), INTENT(IN) :: PMASK
+TYPE(ISBA_P_t), INTENT(INOUT) :: P
+!
+INTEGER :: JI, JL
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_TEB_VEG:INIT_IF_DIF',0,ZHOOK_HANDLE)
+!
+WHERE(PMASK(:)/=0.)
+ P%NWG_LAYER(:)=KGROUND_LAYER
+ P%XDG2 (:)=0.0
+ P%XDROOT(:)=0.0
+ENDWHERE
+DO JL=KGROUND_LAYER,1,-1
+ DO JI=1,SIZE(PMASK)
+ IF(PMASK(JI)/=0..AND.P%XROOTFRAC(JI,JL)>=1.0)THEN
+ P%XDG2 (JI)=P%XDG(JI,JL)
+ P%XDROOT(JI)=P%XDG(JI,JL)
+ ENDIF
+ ENDDO
+ENDDO
+!
+IF (LHOOK) CALL DR_HOOK('MODE_TEB_VEG:INIT_IF_DIF',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE INIT_IF_DIF
+!
+SUBROUTINE INIT_IF_NOVEG(PMASK, IO, S, P, PEK)
+!
+REAL, DIMENSION(:), INTENT(IN) :: PMASK
+TYPE(ISBA_OPTIONS_t), INTENT(IN) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_P_t), INTENT(INOUT) :: P
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
+INTEGER :: JL, JV
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_TEB_VEG:INIT_IF_NOVEG',0,ZHOOK_HANDLE)
+!
+WHERE (PMASK(:)==0.)
+ PEK%XVEG(:)=0.
+ PEK%XLAI(:)=0.
+ PEK%XRSMIN(:)=40.
+ PEK%XGAMMA(:)=0.
+ PEK%XWRMAX_CF(:)=0.2
+ PEK%XRGL(:)=100.
+ PEK%XCV(:)=2.E-5
+ PEK%XZ0(:)=0.013
+ P%XZ0_O_Z0H(:)=10.
+ PEK%XALBNIR_VEG(:)=0.30
+ PEK%XALBVIS_VEG(:)=0.30
+ PEK%XALBUV_VEG(:)=0.06
+ PEK%XEMIS(:)=0.94
+ENDWHERE
+IF (IO%CPHOTO/='NON') THEN
+ WHERE (PMASK(:)==0.)
+ PEK%XGMES(:)=0.020
+ PEK%XBSLAI(:)=0.36
+ PEK%XLAIMIN(:)=0.3
+ PEK%XSEFOLD(:)=90*86400.
+ P%XH_TREE(:)=0.
+ P%XRE25(:)=3.6E-7
+ PEK%XGC(:)=0.00025
+ END WHERE
+ WHERE (PMASK(:)==0.)
+ P%XDMAX(:)=0.1
+ PEK%XF2I(:)=0.3
+ END WHERE
+ IF (IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') THEN
+ WHERE (PMASK(:)==0.)
+ PEK%XCE_NITRO(:)=7.68
+ PEK%XCF_NITRO(:)=-4.33
+ PEK%XCNA_NITRO(:)=1.3
+ END WHERE
+ ENDIF
+ENDIF
+IF(IO%CISBA/='DIF')THEN
+ DO JL=1,IO%NGROUND_LAYER
+ WHERE (PMASK(:)==0.)
+ P%XDG(:,JL)=0.2*JL
+ END WHERE
+ ENDDO
+ELSE
+ WHERE (PMASK(:)==0.)
+ P%XDG(:,1)=0.01
+ P%XDG(:,2)=0.04
+ P%XROOTFRAC(:,1)=0.
+ P%XROOTFRAC(:,2)=0.
+ END WHERE
+ DO JL=3,IO%NGROUND_LAYER
+ WHERE (PMASK(:)==0.)
+ P%XDG(:,JL)=0.1*(JL-2)
+ P%XROOTFRAC(:,JL)=0.
+ END WHERE
+ ENDDO
+ WHERE (PMASK(:)==0.)
+ P%NWG_LAYER(:)=IO%NGROUND_LAYER
+ P%XDROOT (:)=0.0
+ P%XDG2 (:)=P%XDG(:,IO%NGROUND_LAYER-1)
+ ENDWHERE
+ENDIF
+WHERE (PMASK(:)==0.)
+ P%XD_ICE(:)=0.8*P%XDG(:,2)
+END WHERE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_TEB_VEG:INIT_IF_NOVEG',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE INIT_IF_NOVEG
+!
+END MODULE MODE_TEB_VEG
diff --git a/src/SURFEX/mode_thermos.F90 b/src/SURFEX/mode_thermos.F90
index a075b7c658bad6139b4c129ac75e9f9cd13c6270..8a27bb6f6382a16d867506404f4edab3f2867514 100644
--- a/src/SURFEX/mode_thermos.F90
+++ b/src/SURFEX/mode_thermos.F90
@@ -75,7 +75,7 @@ END INTERFACE
INTERFACE DQSATI
MODULE PROCEDURE DQSATI_O_DT_1D
END INTERFACE
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
! ######################################
FUNCTION PSAT_0D(PT) RESULT(PPSAT)
diff --git a/src/SURFEX/mode_write_cover_tex.F90 b/src/SURFEX/mode_write_cover_tex.F90
index fbd640babe6881f2c8db4dcab82c2dcf84718a48..6fd8c6dc227704fbd2138f6d3db3fd17e6334a00 100644
--- a/src/SURFEX/mode_write_cover_tex.F90
+++ b/src/SURFEX/mode_write_cover_tex.F90
@@ -12,7 +12,7 @@
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
- CONTAINS
+CONTAINS
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/mode_write_surf_asc.F90 b/src/SURFEX/mode_write_surf_asc.F90
index 2b5f60056e736c51e2322fdc3e23a0386feb4877..a9cbc6d08ed82f4dca9fad2bc19118618ab5fbdc 100644
--- a/src/SURFEX/mode_write_surf_asc.F90
+++ b/src/SURFEX/mode_write_surf_asc.F90
@@ -15,6 +15,7 @@ INTERFACE WRITE_SURFN_ASC
MODULE PROCEDURE WRITE_SURFN1_ASC
MODULE PROCEDURE WRITE_SURFL1_ASC
MODULE PROCEDURE WRITE_SURFX2_ASC
+ MODULE PROCEDURE WRITE_SURFX3_ASC
END INTERFACE
INTERFACE WRITE_SURFT_ASC
MODULE PROCEDURE WRITE_SURFT0_ASC
@@ -22,7 +23,7 @@ INTERFACE WRITE_SURFT_ASC
MODULE PROCEDURE WRITE_SURFT2_ASC
END INTERFACE
!
- CONTAINS
+CONTAINS
!
! #############################################################
SUBROUTINE WRITE_SURFX0_ASC (&
@@ -32,10 +33,6 @@ END INTERFACE
!!**** * - routine to write a real scalar
!
!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0
-!
USE MODD_IO_SURF_ASC, ONLY : NUNIT, CMASK
!
USE MODI_IO_BUFF
@@ -57,6 +54,7 @@ INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem a
!
!* 0.2 Declarations of local variables
!
+LOGICAL :: GFOUND
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX0_ASC',0,ZHOOK_HANDLE)
@@ -64,9 +62,9 @@ IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX0_ASC',0,ZHOOK_HANDLE)
KRESP=0
!
CALL IO_BUFF(&
- HREC,'W',LWORK0)
-IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX0_ASC',1,ZHOOK_HANDLE)
-IF (LWORK0) RETURN
+ HREC,'W',GFOUND)
+IF (GFOUND .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX0_ASC',1,ZHOOK_HANDLE)
+IF (GFOUND) RETURN
!
WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//HREC
WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50)
@@ -82,17 +80,11 @@ IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX0_ASC',1,ZHOOK_HANDLE)
END SUBROUTINE WRITE_SURFX0_ASC
!
! #############################################################
- SUBROUTINE WRITE_SURFN0_ASC (&
- HREC,KFIELD,KRESP,HCOMMENT)
+ SUBROUTINE WRITE_SURFN0_ASC (HREC,KFIELD,KRESP,HCOMMENT)
! #############################################################
!
!!**** * - routine to write an integer
!
-!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0
-!
USE MODD_IO_SURF_ASC, ONLY : NUNIT, NMASK, CMASK
!
USE MODI_IO_BUFF
@@ -114,16 +106,16 @@ INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem a
!
!* 0.2 Declarations of local variables
!
+LOGICAL :: GFOUND
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFN0_ASC',0,ZHOOK_HANDLE)
!
KRESP=0
!
- CALL IO_BUFF(&
- HREC,'W',LWORK0)
-IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFN0_ASC',1,ZHOOK_HANDLE)
-IF (LWORK0) RETURN
+ CALL IO_BUFF(HREC,'W',GFOUND)
+IF (GFOUND .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFN0_ASC',1,ZHOOK_HANDLE)
+IF (GFOUND) RETURN
!
WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//HREC
WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50)
@@ -145,11 +137,6 @@ END SUBROUTINE WRITE_SURFN0_ASC
!
!!**** * - routine to write a logical
!
-!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0
-!
USE MODD_IO_SURF_ASC, ONLY : NUNIT, CMASK
!
USE MODI_IO_BUFF
@@ -171,6 +158,7 @@ INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem a
!
!* 0.2 Declarations of local variables
!
+LOGICAL :: GFOUND
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFL0_ASC',0,ZHOOK_HANDLE)
@@ -178,9 +166,9 @@ IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFL0_ASC',0,ZHOOK_HANDLE)
KRESP=0
!
CALL IO_BUFF(&
- HREC,'W',LWORK0)
-IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFL0_ASC',1,ZHOOK_HANDLE)
-IF (LWORK0) RETURN
+ HREC,'W',GFOUND)
+IF (GFOUND .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFL0_ASC',1,ZHOOK_HANDLE)
+IF (GFOUND) RETURN
!
WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//HREC
WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50)
@@ -203,10 +191,6 @@ END SUBROUTINE WRITE_SURFL0_ASC
!!**** * - routine to write a character
!
!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0
-!
USE MODD_IO_SURF_ASC, ONLY : NUNIT, CMASK
!
USE MODI_IO_BUFF
@@ -228,6 +212,7 @@ INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem
!
!* 0.2 Declarations of local variables
!
+LOGICAL :: GFOUND
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFC0_ASC',0,ZHOOK_HANDLE)
@@ -235,9 +220,9 @@ IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFC0_ASC',0,ZHOOK_HANDLE)
KRESP=0
!
CALL IO_BUFF(&
- HREC,'W',LWORK0)
-IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFC0_ASC',1,ZHOOK_HANDLE)
-IF (LWORK0) RETURN
+ HREC,'W',GFOUND)
+IF (GFOUND .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFC0_ASC',1,ZHOOK_HANDLE)
+IF (GFOUND) RETURN
!
WRITE(NUNIT,FMT=*,ERR=100) '&'//CMASK//' '//HREC
WRITE(NUNIT,FMT='(A50)',ERR=100) HCOMMENT(1:50)
@@ -264,8 +249,6 @@ END SUBROUTINE WRITE_SURFC0_ASC
!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE, WLOG_MPI
!
-USE MODD_SURFEX_OMP, ONLY : LWORK0, NWORKB, NBLOCK
-!
USE MODD_IO_SURF_ASC, ONLY : NUNIT, NMASK, NFULL, CMASK
!
USE MODI_IO_BUFF
@@ -295,6 +278,7 @@ INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem
! '-' : no horizontal dim.
!* 0.2 Declarations of local variables
!
+LOGICAL :: GFOUND
INTEGER :: ISIZE, J
REAL :: XTIME0
REAL, DIMENSION(MAX(NFULL,SIZE(PFIELD))) :: ZWORK ! work array read in the file
@@ -302,19 +286,12 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX1_ASC',0,ZHOOK_HANDLE)
!
-!$OMP BARRIER
-!
-!$OMP SINGLE
-!
-NWORKB=0
+KRESP=0
!
- CALL IO_BUFF(&
- HREC,'W',LWORK0)
+ CALL IO_BUFF(HREC,'W',GFOUND)
!
-!$OMP END SINGLE
-!
-IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX1_ASC',1,ZHOOK_HANDLE)
-IF (LWORK0) RETURN
+IF (GFOUND .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX1_ASC',1,ZHOOK_HANDLE)
+IF (GFOUND) RETURN
!
IF (HDIR=='-') THEN
ISIZE = SIZE(PFIELD)
@@ -330,15 +307,11 @@ IF (NRANK==NPIO) THEN
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP SINGLE
- !
- WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) '&'//CMASK//' '//HREC
- WRITE(NUNIT,FMT='(A50)',IOSTAT=NWORKB) HCOMMENT(1:50)
- WRITE(NUNIT,FMT='(50D20.8)',IOSTAT=NWORKB) ZWORK(1:ISIZE)
+ WRITE(NUNIT,FMT=*,IOSTAT=KRESP) '&'//CMASK//' '//HREC
+ WRITE(NUNIT,FMT='(A50)',IOSTAT=KRESP) HCOMMENT(1:50)
+ WRITE(NUNIT,FMT='(50D20.8)',IOSTAT=KRESP) ZWORK(1:ISIZE)
!
-!$OMP END SINGLE
- !
- IF (NWORKB/=0) CALL ERROR_WRITE_SURF_ASC(HREC,NWORKB)
+ IF (KRESP/=0) CALL ERROR_WRITE_SURF_ASC(HREC,KRESP)
!
#ifdef SFX_MPI
XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0)
@@ -346,15 +319,12 @@ IF (NRANK==NPIO) THEN
!
ENDIF
!
-KRESP = NWORKB
-!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX1_ASC',1,ZHOOK_HANDLE)
!
END SUBROUTINE WRITE_SURFX1_ASC
!
! #############################################################
- SUBROUTINE WRITE_SURFX2_ASC (&
- HREC,PFIELD,KRESP,HCOMMENT,HDIR)
+ SUBROUTINE WRITE_SURFX2_ASC (HREC,PFIELD,KRESP,HCOMMENT,HDIR)
! #############################################################
!
!!**** * - routine to fill a write 2D array for the externalised surface
@@ -364,8 +334,6 @@ END SUBROUTINE WRITE_SURFX1_ASC
!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE, WLOG_MPI
!
-USE MODD_SURFEX_OMP, ONLY : LWORK0, NWORKB
-!
USE MODD_IO_SURF_ASC, ONLY : NUNIT, NMASK, NFULL, CMASK
!
USE MODI_IO_BUFF
@@ -395,6 +363,7 @@ INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a pro
! '-' : no horizontal dim.
!* 0.2 Declarations of local variables
!
+LOGICAL :: GFOUND
INTEGER :: ISIZE
REAL :: XTIME0
REAL, DIMENSION(MAX(NFULL,SIZE(PFIELD,1)),SIZE(PFIELD,2)) :: ZWORK ! work array read in the file
@@ -402,19 +371,13 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX2_ASC',0,ZHOOK_HANDLE)
!
-!$OMP BARRIER
-!
-!$OMP SINGLE
-!
-NWORKB=0
+KRESP=0
!
CALL IO_BUFF(&
- HREC,'W',LWORK0)
-!
-!$OMP END SINGLE
+ HREC,'W',GFOUND)
!
-IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX2_ASC',1,ZHOOK_HANDLE)
-IF (LWORK0) RETURN
+IF (GFOUND .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX2_ASC',1,ZHOOK_HANDLE)
+IF (GFOUND) RETURN
!
IF (HDIR=='-') THEN
ISIZE = SIZE(PFIELD,1)
@@ -430,15 +393,11 @@ IF (NRANK==NPIO) THEN
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP SINGLE
+ WRITE(NUNIT,FMT=*,IOSTAT=KRESP) '&'//CMASK//' '//HREC
+ WRITE(NUNIT,FMT='(A50)',IOSTAT=KRESP) HCOMMENT(1:50)
+ WRITE(NUNIT,FMT='(50D20.8)',IOSTAT=KRESP) ZWORK(1:ISIZE,:)
!
- WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) '&'//CMASK//' '//HREC
- WRITE(NUNIT,FMT='(A50)',IOSTAT=NWORKB) HCOMMENT(1:50)
- WRITE(NUNIT,FMT='(50D20.8)',IOSTAT=NWORKB) ZWORK(1:ISIZE,:)
- !
-!$OMP END SINGLE
- !
- IF (NWORKB/=0) CALL ERROR_WRITE_SURF_ASC(HREC,NWORKB)
+ IF (KRESP/=0) CALL ERROR_WRITE_SURF_ASC(HREC,KRESP)
!
#ifdef SFX_MPI
XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0)
@@ -446,12 +405,96 @@ IF (NRANK==NPIO) THEN
!
ENDIF
!
-KRESP = NWORKB
-!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX2_ASC',1,ZHOOK_HANDLE)
!
END SUBROUTINE WRITE_SURFX2_ASC
!
+! #############################################################
+ SUBROUTINE WRITE_SURFX3_ASC (HREC,PFIELD,KRESP,HCOMMENT,HDIR)
+! #############################################################
+!
+!!**** * - routine to fill a write 2D array for the externalised surface
+!
+!
+!
+!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE, WLOG_MPI
+!
+USE MODD_IO_SURF_ASC, ONLY : NUNIT, NMASK, NFULL, CMASK
+!
+USE MODI_IO_BUFF
+USE MODI_ERROR_WRITE_SURF_ASC
+USE MODI_GATHER_AND_WRITE_MPI
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
+!* 0.1 Declarations of arguments
+!
+!
+!
+ CHARACTER(LEN=LEN_HREC), INTENT(IN) :: HREC ! name of the article to be read
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELD ! array containing the data field
+INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears
+ CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string
+ CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field :
+ ! 'H' : field with
+ ! horizontal spatial dim.
+ ! '-' : no horizontal dim.
+!* 0.2 Declarations of local variables
+!
+LOGICAL :: GFOUND
+INTEGER :: ISIZE
+REAL :: XTIME0
+REAL, DIMENSION(MAX(NFULL,SIZE(PFIELD,1)),SIZE(PFIELD,2),SIZE(PFIELD,3)) :: ZWORK ! work array read in the file
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX3_ASC',0,ZHOOK_HANDLE)
+!
+KRESP=0
+!
+ CALL IO_BUFF(&
+ HREC,'W',GFOUND)
+!
+IF (GFOUND .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX3_ASC',1,ZHOOK_HANDLE)
+IF (GFOUND) RETURN
+!
+IF (HDIR=='-') THEN
+ ISIZE = SIZE(PFIELD,1)
+ ZWORK(1:ISIZE,:,:) = PFIELD(:,:,:)
+ELSE
+ ISIZE = SIZE(ZWORK,1)
+ CALL GATHER_AND_WRITE_MPI(PFIELD,ZWORK,NMASK)
+ENDIF
+!
+IF (NRANK==NPIO) THEN
+ !
+#ifdef SFX_MPI
+ XTIME0 = MPI_WTIME()
+#endif
+ !
+ WRITE(NUNIT,FMT=*,IOSTAT=KRESP) '&'//CMASK//' '//HREC
+ WRITE(NUNIT,FMT='(A50)',IOSTAT=KRESP) HCOMMENT(1:50)
+ WRITE(NUNIT,FMT='(50D20.8)',IOSTAT=KRESP) ZWORK(1:ISIZE,:,:)
+ !
+ IF (KRESP/=0) CALL ERROR_WRITE_SURF_ASC(HREC,KRESP)
+ !
+#ifdef SFX_MPI
+ XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0)
+#endif
+ !
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFX3_ASC',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE WRITE_SURFX3_ASC
+!
! #############################################################
SUBROUTINE WRITE_SURFN1_ASC (&
HREC,KFIELD,KRESP,HCOMMENT,HDIR)
@@ -464,8 +507,6 @@ END SUBROUTINE WRITE_SURFX2_ASC
!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE
!
-USE MODD_SURFEX_OMP, ONLY : LWORK0, NWORKB
-!
USE MODD_IO_SURF_ASC, ONLY : NUNIT, NMASK, NFULL, CMASK
!
USE MODI_IO_BUFF
@@ -495,6 +536,7 @@ INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a probl
! '-' : no horizontal dim.
!* 0.2 Declarations of local variables
!
+LOGICAL :: GFOUND
INTEGER :: ISIZE
INTEGER, DIMENSION(MAX(NFULL,SIZE(KFIELD))) :: IWORK ! work array read in the file
REAL :: XTIME0
@@ -502,17 +544,13 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFN1_ASC',0,ZHOOK_HANDLE)
!
-!$OMP SINGLE
-!
-NWORKB = 0
+KRESP = 0
!
CALL IO_BUFF(&
- HREC,'W',LWORK0)
+ HREC,'W',GFOUND)
!
-!$OMP END SINGLE
-!
-IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFN1_ASC',1,ZHOOK_HANDLE)
-IF (LWORK0) RETURN
+IF (GFOUND .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFN1_ASC',1,ZHOOK_HANDLE)
+IF (GFOUND) RETURN
!
IF (HDIR=='-' .OR. HREC=='-') THEN
ISIZE = SIZE(KFIELD)
@@ -528,15 +566,11 @@ IF (NRANK==NPIO) THEN
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP SINGLE
- !
- WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) '&'//CMASK//' '//HREC
- WRITE(NUNIT,FMT='(A50)',IOSTAT=NWORKB) HCOMMENT(1:50)
- WRITE(NUNIT,FMT='(100I8)',IOSTAT=NWORKB) IWORK(1:ISIZE)
- !
-!$OMP END SINGLE
+ WRITE(NUNIT,FMT=*,IOSTAT=KRESP) '&'//CMASK//' '//HREC
+ WRITE(NUNIT,FMT='(A50)',IOSTAT=KRESP) HCOMMENT(1:50)
+ WRITE(NUNIT,FMT='(100I8)',IOSTAT=KRESP) IWORK(1:ISIZE)
!
- IF (NWORKB/=0) CALL ERROR_WRITE_SURF_ASC(HREC,NWORKB)
+ IF (KRESP/=0) CALL ERROR_WRITE_SURF_ASC(HREC,KRESP)
!
#ifdef SFX_MPI
XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0)
@@ -544,8 +578,6 @@ IF (NRANK==NPIO) THEN
!
ENDIF
!
-KRESP = NWORKB
-!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFN1_ASC',1,ZHOOK_HANDLE)
!
END SUBROUTINE WRITE_SURFN1_ASC
@@ -562,8 +594,6 @@ END SUBROUTINE WRITE_SURFN1_ASC
!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE
!
-USE MODD_SURFEX_OMP, ONLY : LWORK0, NWORKB
-!
USE MODD_IO_SURF_ASC, ONLY : NUNIT, CMASK
!
USE MODI_IO_BUFF
@@ -592,22 +622,19 @@ INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a probl
! '-' : no horizontal dim.
!* 0.2 Declarations of local variables
!
+LOGICAL :: GFOUND
REAL :: XTIME0
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFL1_ASC',0,ZHOOK_HANDLE)
!
-!$OMP SINGLE
-!
-NWORKB = 0
+KRESP = 0
!
CALL IO_BUFF(&
- HREC,'W',LWORK0)
-!
-!$OMP END SINGLE
+ HREC,'W',GFOUND)
!
-IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFL1_ASC',1,ZHOOK_HANDLE)
-IF (LWORK0) RETURN
+IF (GFOUND .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFL1_ASC',1,ZHOOK_HANDLE)
+IF (GFOUND) RETURN
!
IF (NRANK==NPIO) THEN
!
@@ -615,15 +642,11 @@ IF (NRANK==NPIO) THEN
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP SINGLE
- !
- WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) '&'//CMASK//' '//HREC
- WRITE(NUNIT,FMT='(A50)',IOSTAT=NWORKB) HCOMMENT(1:50)
- WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) OFIELD
- !
-!$OMP END SINGLE
+ WRITE(NUNIT,FMT=*,IOSTAT=KRESP) '&'//CMASK//' '//HREC
+ WRITE(NUNIT,FMT='(A50)',IOSTAT=KRESP) HCOMMENT(1:50)
+ WRITE(NUNIT,FMT=*,IOSTAT=KRESP) OFIELD
!
- IF (NWORKB/=0) CALL ERROR_WRITE_SURF_ASC(HREC,NWORKB)
+ IF (KRESP/=0) CALL ERROR_WRITE_SURF_ASC(HREC,KRESP)
!
#ifdef SFX_MPI
XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0)
@@ -631,8 +654,6 @@ IF (NRANK==NPIO) THEN
!
ENDIF
!
-KRESP = NWORKB
-!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFL1_ASC',1,ZHOOK_HANDLE)
!
END SUBROUTINE WRITE_SURFL1_ASC
@@ -645,10 +666,6 @@ END SUBROUTINE WRITE_SURFL1_ASC
!!**** * - routine to write a date
!
!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0
-!
USE MODD_IO_SURF_ASC, ONLY : NUNIT, CMASK
!
USE MODI_IO_BUFF
@@ -673,6 +690,7 @@ INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem
!* 0.2 Declarations of local variables
!
+LOGICAL :: GFOUND
INTEGER, DIMENSION(3) :: ITDATE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -681,9 +699,9 @@ IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT0_ASC',0,ZHOOK_HANDLE)
KRESP=0
!
CALL IO_BUFF(&
- HREC,'W',LWORK0)
-IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT0_ASC',1,ZHOOK_HANDLE)
-IF (LWORK0) RETURN
+ HREC,'W',GFOUND)
+IF (GFOUND .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT0_ASC',1,ZHOOK_HANDLE)
+IF (GFOUND) RETURN
!
ITDATE(1) = KYEAR
ITDATE(2) = KMONTH
@@ -718,8 +736,6 @@ END SUBROUTINE WRITE_SURFT0_ASC
!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE
!
-USE MODD_SURFEX_OMP, ONLY : LWORK0, NWORKB
-!
USE MODD_IO_SURF_ASC, ONLY : NUNIT, CMASK
!
USE MODI_IO_BUFF
@@ -750,21 +766,18 @@ INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a proble
!
INTEGER, DIMENSION(3,SIZE(KYEAR)) :: ITDATE
REAL :: XTIME0
+LOGICAL :: GFOUND
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT1_ASC',0,ZHOOK_HANDLE)
!
-!$OMP SINGLE
-!
-NWORKB = 0
+KRESP = 0
!
CALL IO_BUFF(&
- HREC,'W',LWORK0)
+ HREC,'W',GFOUND)
!
-!$OMP END SINGLE
-!
-IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT1_ASC',1,ZHOOK_HANDLE)
-IF (LWORK0) RETURN
+IF (GFOUND .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT1_ASC',1,ZHOOK_HANDLE)
+IF (GFOUND) RETURN
!
IF (NRANK==NPIO) THEN
!
@@ -772,23 +785,19 @@ IF (NRANK==NPIO) THEN
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP SINGLE
- !
ITDATE(1,:) = KYEAR (:)
ITDATE(2,:) = KMONTH (:)
ITDATE(3,:) = KDAY (:)
!
- WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) '&'//CMASK//' '//TRIM(HREC)//'%TDATE'
- WRITE(NUNIT,FMT='(A50)',IOSTAT=NWORKB) HCOMMENT(1:50)
- WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) ITDATE(:,:)
+ WRITE(NUNIT,FMT=*,IOSTAT=KRESP) '&'//CMASK//' '//TRIM(HREC)//'%TDATE'
+ WRITE(NUNIT,FMT='(A50)',IOSTAT=KRESP) HCOMMENT(1:50)
+ WRITE(NUNIT,FMT=*,IOSTAT=KRESP) ITDATE(:,:)
!
- WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) '&'//CMASK//' '//TRIM(HREC)//'%TIME'
- WRITE(NUNIT,FMT='(A50)',IOSTAT=NWORKB) HCOMMENT(1:50)
- WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) PTIME
+ WRITE(NUNIT,FMT=*,IOSTAT=KRESP) '&'//CMASK//' '//TRIM(HREC)//'%TIME'
+ WRITE(NUNIT,FMT='(A50)',IOSTAT=KRESP) HCOMMENT(1:50)
+ WRITE(NUNIT,FMT=*,IOSTAT=KRESP) PTIME
!
-!$OMP END SINGLE
- !
- IF (NWORKB/=0) CALL ERROR_WRITE_SURF_ASC(HREC,NWORKB)
+ IF (KRESP/=0) CALL ERROR_WRITE_SURF_ASC(HREC,KRESP)
!
#ifdef SFX_MPI
XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0)
@@ -796,8 +805,6 @@ IF (NRANK==NPIO) THEN
!
ENDIF
!
-KRESP = NWORKB
-!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT1_ASC',1,ZHOOK_HANDLE)
!
END SUBROUTINE WRITE_SURFT1_ASC
@@ -814,8 +821,6 @@ END SUBROUTINE WRITE_SURFT1_ASC
!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE
!
-USE MODD_SURFEX_OMP, ONLY : LWORK0, NWORKB
-!
USE MODD_IO_SURF_ASC, ONLY : NUNIT, CMASK
!
USE MODI_IO_BUFF
@@ -846,19 +851,18 @@ INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a pro
!
INTEGER, DIMENSION(3,SIZE(KYEAR,1),SIZE(KYEAR,2)) :: ITDATE
REAL :: XTIME0
+LOGICAL :: GFOUND
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT2_ASC',0,ZHOOK_HANDLE)
!
-!$OMP SINGLE
-NWORKB = 0
+KRESP = 0
!
- CALL IO_BUFF(&
- HREC,'W',LWORK0)
-!$OMP END SINGLE
+CALL IO_BUFF(&
+ HREC,'W',GFOUND)
!
-IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT2_ASC',1,ZHOOK_HANDLE)
-IF (LWORK0) RETURN
+IF (GFOUND .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT2_ASC',1,ZHOOK_HANDLE)
+IF (GFOUND) RETURN
!
IF (NRANK==NPIO) THEN
!
@@ -866,23 +870,19 @@ IF (NRANK==NPIO) THEN
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP SINGLE
- !
ITDATE(1,:,:) = KYEAR (:,:)
ITDATE(2,:,:) = KMONTH (:,:)
ITDATE(3,:,:) = KDAY (:,:)
!
- WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) '&'//CMASK//' '//TRIM(HREC)//'%TDATE'
- WRITE(NUNIT,FMT='(A50)',IOSTAT=NWORKB) HCOMMENT(1:50)
- WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) ITDATE(:,:,:)
- !
- WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) '&'//CMASK//' '//TRIM(HREC)//'%TIME'
- WRITE(NUNIT,FMT='(A50)',IOSTAT=NWORKB) HCOMMENT(1:50)
- WRITE(NUNIT,FMT=*,IOSTAT=NWORKB) PTIME
+ WRITE(NUNIT,FMT=*,IOSTAT=KRESP) '&'//CMASK//' '//TRIM(HREC)//'%TDATE'
+ WRITE(NUNIT,FMT='(A50)',IOSTAT=KRESP) HCOMMENT(1:50)
+ WRITE(NUNIT,FMT=*,IOSTAT=KRESP) ITDATE(:,:,:)
!
-!$OMP END SINGLE
+ WRITE(NUNIT,FMT=*,IOSTAT=KRESP) '&'//CMASK//' '//TRIM(HREC)//'%TIME'
+ WRITE(NUNIT,FMT='(A50)',IOSTAT=KRESP) HCOMMENT(1:50)
+ WRITE(NUNIT,FMT=*,IOSTAT=KRESP) PTIME
!
- IF (NWORKB/=0) CALL ERROR_WRITE_SURF_ASC(HREC,NWORKB)
+ IF (KRESP/=0) CALL ERROR_WRITE_SURF_ASC(HREC,KRESP)
!
#ifdef SFX_MPI
XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0)
@@ -890,8 +890,6 @@ IF (NRANK==NPIO) THEN
!
ENDIF
!
-KRESP = NWORKB
-!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_ASC:WRITE_SURFT2_ASC',1,ZHOOK_HANDLE)
!
END SUBROUTINE WRITE_SURFT2_ASC
diff --git a/src/SURFEX/mode_write_surf_cov.F90 b/src/SURFEX/mode_write_surf_cov.F90
index 71166fb00cf9ef236306879b636a522ef93b41eb..4eb7957557486e7cc0836efc9baaba3cb2a23b8f 100644
--- a/src/SURFEX/mode_write_surf_cov.F90
+++ b/src/SURFEX/mode_write_surf_cov.F90
@@ -4,26 +4,23 @@
!SFX_LIC for details. version 1.
MODULE MODE_WRITE_SURF_COV
-
-!RJ: split cover from read_surf.F90 to avoid compiler bugs
-!RJ: all safety compatibility checks should be done here
-PUBLIC :: WRITE_SURF_COV
-
- CONTAINS
-
+!
+INTERFACE WRITE_SURF_COV
+ MODULE PROCEDURE WRITE_SURF_COV
+END INTERFACE
+!
+CONTAINS
+!
! #############################################################
- SUBROUTINE WRITE_SURF_COV (DGU, U, &
+ SUBROUTINE WRITE_SURF_COV (HSELECT, &
HPROGRAM,HREC,PFIELD,OFLAG,KRESP,HCOMMENT,HDIR)
! #############################################################
!
!
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
!
-!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
-USE MODI_WRITE_SURF, ONLY: WRITE_SURF
+USE MODI_WRITE_SURF
#ifdef SFX_MNH
USE MODI_WRITE_SURFX2COV_MNH
#endif
@@ -36,8 +33,7 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
!
!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
@@ -52,6 +48,7 @@ INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a proble
!* 0.2 Declarations of local variables
!
CHARACTER(LEN=LEN_HREC) :: YREC
+ CHARACTER(LEN=LEN_HREC) :: YREC2
CHARACTER(LEN=100) :: YCOMMENT
INTEGER :: IL1
INTEGER :: IL2
@@ -65,33 +62,34 @@ YREC = HREC
YDIR = 'H'
IF (PRESENT(HDIR)) YDIR = HDIR
IL1 = SIZE(PFIELD,1)
-IL2 = SIZE(OFLAG)
+IL2 = SIZE(PFIELD,2)
!
IF (HPROGRAM=='MESONH') THEN
#ifdef SFX_MNH
- CALL WRITE_SURFX2COV_MNH(YREC,IL1,IL2,PFIELD,OFLAG,KRESP,HCOMMENT,YDIR)
+ YREC2 = YREC
+ CALL WRITE_SURFX2COV_MNH(YREC2,IL1,IL2,PFIELD,OFLAG,KRESP,HCOMMENT,YDIR)
#endif
ELSE
!
!RJ: could be generalized for all
- IF (HPROGRAM=='LFI ') THEN
- YREC = 'COVER_PACKED'
- YCOMMENT='-'
+ IF (NRANK==NPIO) THEN
+ IF (HPROGRAM=='LFI ') THEN
+ YREC = 'COVER_PACKED'
+ YCOMMENT='-'
!! YCOMMENT=HCOMMENT
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YREC,.FALSE.,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YREC,.FALSE.,KRESP,YCOMMENT)
+ ENDIF
ENDIF
!
ICOVER=0
- DO JCOVER=1,IL2
+ DO JCOVER=1,SIZE(OFLAG)
!
WRITE(YREC,'(A5,I3.3)') 'COVER',JCOVER
YCOMMENT='X_Y_'//YREC
IF (.NOT. OFLAG(JCOVER)) CYCLE
ICOVER = ICOVER+1
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YREC,PFIELD(:,ICOVER),KRESP,YCOMMENT,YDIR)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YREC,PFIELD(:,ICOVER),KRESP,YCOMMENT,YDIR)
!
END DO
END IF
diff --git a/src/SURFEX/mode_write_surf_fa.F90 b/src/SURFEX/mode_write_surf_fa.F90
index 8b1386d58471726ecb6ff9b41dac5bc334b4b0c5..94940e18fbbe518b1bef8640788a88f42ac8b435 100644
--- a/src/SURFEX/mode_write_surf_fa.F90
+++ b/src/SURFEX/mode_write_surf_fa.F90
@@ -15,13 +15,14 @@ INTERFACE WRITE_SURFN_FA
MODULE PROCEDURE WRITE_SURFN1_FA
MODULE PROCEDURE WRITE_SURFL1_FA
MODULE PROCEDURE WRITE_SURFX2_FA
+ MODULE PROCEDURE WRITE_SURFX3_FA
END INTERFACE
INTERFACE WRITE_SURFT_FA
MODULE PROCEDURE WRITE_SURFT0_FA
MODULE PROCEDURE WRITE_SURFT2_FA
END INTERFACE
!
- CONTAINS
+CONTAINS
!
! #############################################################
SUBROUTINE WRITE_SURFX0_FA (&
@@ -31,10 +32,6 @@ END INTERFACE
!!**** * - routine to write a real scalar
!
!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0
-!
USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, CPREFIX1D, LFANOCOMPACT
!
USE MODE_FASURFEX
@@ -58,6 +55,7 @@ INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem a
!
!* 0.2 Declarations of local variables
!
+LOGICAL :: GFOUND
CHARACTER(LEN=18):: YNAME ! Field Name
INTEGER :: INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -67,9 +65,9 @@ IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:ERROR_WRITE_SURF_FA:WRITE_SURFX0_FA'
KRESP=0
!
CALL IO_BUFF(&
- HREC,'W',LWORK0)
-IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFX0_FA',1,ZHOOK_HANDLE)
-IF (LWORK0) RETURN
+ HREC,'W',GFOUND)
+IF (GFOUND .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFX0_FA',1,ZHOOK_HANDLE)
+IF (GFOUND) RETURN
!
IF(LFANOCOMPACT)THEN
CALL FAVEUR(KRESP,NUNIT_FA,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
@@ -99,11 +97,6 @@ END SUBROUTINE WRITE_SURFX0_FA
!
!!**** * - routine to write an integer
!
-!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0
-!
USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, NMASK, CPREFIX1D, LFANOCOMPACT
!
USE MODE_FASURFEX
@@ -127,6 +120,7 @@ INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem a
!
!* 0.2 Declarations of local variables
!
+LOGICAL :: GFOUND
CHARACTER(LEN=18):: YNAME ! Field Name
INTEGER :: INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -136,9 +130,9 @@ IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFN0_FA',0,ZHOOK_HANDLE)
KRESP=0
!
CALL IO_BUFF(&
- HREC,'W',LWORK0)
-IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFN0_FA',1,ZHOOK_HANDLE)
-IF (LWORK0) RETURN
+ HREC,'W',GFOUND)
+IF (GFOUND .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFN0_FA',1,ZHOOK_HANDLE)
+IF (GFOUND) RETURN
!
IF(LFANOCOMPACT)THEN
CALL FAVEUR(KRESP,NUNIT_FA,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
@@ -168,11 +162,6 @@ END SUBROUTINE WRITE_SURFN0_FA
!
!!**** * - routine to write a logical
!
-!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0
-!
USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, CPREFIX1D, LFANOCOMPACT
!
USE MODE_FASURFEX
@@ -196,6 +185,7 @@ INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem a
!
!* 0.2 Declarations of local variables
!
+LOGICAL :: GFOUND
CHARACTER(LEN=18):: YNAME ! Field Name
INTEGER :: INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -205,9 +195,9 @@ IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFL0_FA',0,ZHOOK_HANDLE)
KRESP=0
!
CALL IO_BUFF(&
- HREC,'W',LWORK0)
-IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFL0_FA',1,ZHOOK_HANDLE)
-IF (LWORK0) RETURN
+ HREC,'W',GFOUND)
+IF (GFOUND .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFL0_FA',1,ZHOOK_HANDLE)
+IF (GFOUND) RETURN
!
IF(LFANOCOMPACT)THEN
CALL FAVEUR(KRESP,NUNIT_FA,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
@@ -238,10 +228,6 @@ END SUBROUTINE WRITE_SURFL0_FA
!!**** * - routine to write a character
!
!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0
-!
USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, CPREFIX1D, LFANOCOMPACT
!
USE MODE_FASURFEX
@@ -265,6 +251,7 @@ INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem
!
!* 0.2 Declarations of local variables
!
+LOGICAL :: GFOUND
CHARACTER,DIMENSION(40) :: YFIELD
CHARACTER(LEN=18) :: YNAME ! Field Name
INTEGER :: INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL
@@ -275,9 +262,9 @@ IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFC0_FA',0,ZHOOK_HANDLE)
KRESP=0
!
CALL IO_BUFF(&
- HREC,'W',LWORK0)
-IF (LWORK0.AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFC0_FA',1,ZHOOK_HANDLE)
-IF (LWORK0) RETURN
+ HREC,'W',GFOUND)
+IF (GFOUND.AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFC0_FA',1,ZHOOK_HANDLE)
+IF (GFOUND) RETURN
!
IF(LFANOCOMPACT)THEN
CALL FAVEUR(KRESP,NUNIT_FA,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
@@ -313,8 +300,6 @@ END SUBROUTINE WRITE_SURFC0_FA
!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE, WLOG_MPI
!
-USE MODD_SURFEX_OMP, ONLY : LWORK0, NWORKB
-!
USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, NMASK, NFULL, CPREFIX1D, &
LFANOCOMPACT
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -347,6 +332,7 @@ INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem
! '-' : no horizontal dim.
!* 0.2 Declarations of local variables
!
+LOGICAL :: GFOUND
INTEGER :: I,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL
REAL :: ZMEAN, ZCOUNT
REAL :: XTIME0
@@ -355,17 +341,13 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFX1_FA',0,ZHOOK_HANDLE)
!
-!$OMP BARRIER
-!
-!$OMP SINGLE
-NWORKB=0
+KRESP=0
!
CALL IO_BUFF(&
- HREC,'W',LWORK0)
-!$OMP END SINGLE
+ HREC,'W',GFOUND)
!
-IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFX1_FA',1,ZHOOK_HANDLE)
-IF (LWORK0) RETURN
+IF (GFOUND .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFX1_FA',1,ZHOOK_HANDLE)
+IF (GFOUND) RETURN
!
IF(HDIR=='H')THEN
CALL GATHER_AND_WRITE_MPI(PFIELD,ZWORK,NMASK)
@@ -380,16 +362,14 @@ IF (NRANK==NPIO) THEN
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP SINGLE
- !
IF(LFANOCOMPACT)THEN
- CALL FAVEUR(NWORKB,NUNIT_FA,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
+ CALL FAVEUR(KRESP,NUNIT_FA,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
! -- Pour ecrire sans compactage
- CALL FAGOTE(NWORKB,NUNIT_FA,-1,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
- CALL FAIENC(NWORKB,NUNIT_FA,CPREFIX1D,0,HREC,ZWORK,.FALSE.)
- IF (NWORKB/=0) CALL ERROR_WRITE_SURF_FA(HREC,NWORKB)
+ CALL FAGOTE(KRESP,NUNIT_FA,-1,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
+ CALL FAIENC(KRESP,NUNIT_FA,CPREFIX1D,0,HREC,ZWORK,.FALSE.)
+ IF (KRESP/=0) CALL ERROR_WRITE_SURF_FA(HREC,KRESP)
! On remet la valeur par defaut
- CALL FAGOTE(NWORKB,NUNIT_FA,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
+ CALL FAGOTE(KRESP,NUNIT_FA,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
ELSE
ZMEAN =0.0
ZCOUNT=0.0
@@ -401,27 +381,22 @@ IF (NRANK==NPIO) THEN
ENDDO
IF (ZCOUNT.GT.0.0) ZMEAN=ZMEAN/ZCOUNT
WHERE(ZWORK(:)==XUNDEF)ZWORK(:)=ZMEAN
- CALL FAIENC(NWORKB,NUNIT_FA,CPREFIX1D,0,HREC,ZWORK,.FALSE.)
- IF (NWORKB/=0) CALL ERROR_WRITE_SURF_FA(HREC,NWORKB)
+ CALL FAIENC(KRESP,NUNIT_FA,CPREFIX1D,0,HREC,ZWORK,.FALSE.)
+ IF (KRESP/=0) CALL ERROR_WRITE_SURF_FA(HREC,KRESP)
ENDIF
!
-!$OMP END SINGLE
- !
#ifdef SFX_MPI
XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0)
#endif
!
ENDIF
!
-KRESP = NWORKB
-!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFX1_FA',1,ZHOOK_HANDLE)
!
END SUBROUTINE WRITE_SURFX1_FA
!
! #############################################################
- SUBROUTINE WRITE_SURFX2_FA (&
- HREC,KL1,KL2,PFIELD,KRESP,HCOMMENT,HDIR)
+ SUBROUTINE WRITE_SURFX2_FA (HREC,KL1,KL2,PFIELD,KRESP,HCOMMENT,HDIR)
! #############################################################
!
!!**** * - routine to fill a write 2D array for the externalised surface
@@ -431,8 +406,6 @@ END SUBROUTINE WRITE_SURFX1_FA
!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE
!
-USE MODD_SURFEX_OMP, ONLY : LWORK0, NWORKB
-!
USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, NMASK, NFULL, &
CPREFIX2D, LFANOCOMPACT
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -466,8 +439,9 @@ INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a pro
! '-' : no horizontal dim.
!* 0.2 Declarations of local variables
!
- CHARACTER(LEN=4) :: YPREFIX
- CHARACTER(LEN=3) :: YPATCH
+LOGICAL :: GFOUND
+CHARACTER(LEN=4) :: YPREFIX
+CHARACTER(LEN=3) :: YPATCH
INTEGER :: I, JL ! loop counter
INTEGER :: INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL
REAL :: XTIME0
@@ -477,17 +451,13 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFX2_FA',0,ZHOOK_HANDLE)
!
-!$OMP BARRIER
-!
-!$OMP SINGLE
-NWORKB=0
+KRESP=0
!
CALL IO_BUFF(&
- HREC,'W',LWORK0)
-!$OMP END SINGLE
+ HREC,'W',GFOUND)
!
-IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFX2_FA',1,ZHOOK_HANDLE)
-IF (LWORK0) RETURN
+IF (GFOUND .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFX2_FA',1,ZHOOK_HANDLE)
+IF (GFOUND) RETURN
!
CALL GATHER_AND_WRITE_MPI(PFIELD,ZWORK,NMASK)
!
@@ -497,20 +467,18 @@ IF (NRANK==NPIO) THEN
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP SINGLE
- !
IF(LFANOCOMPACT)THEN
- CALL FAVEUR(NWORKB,NUNIT_FA,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
+ CALL FAVEUR(KRESP,NUNIT_FA,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
! -- Pour ecrire sans compactage
- CALL FAGOTE(NWORKB,NUNIT_FA,-1,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
+ CALL FAGOTE(KRESP,NUNIT_FA,-1,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
DO JL=1,SIZE(ZWORK,2)
WRITE(YPATCH,'(I3.3)')JL
YPREFIX=CPREFIX2D//YPATCH//'_'
- CALL FAIENC(NWORKB,NUNIT_FA,YPREFIX,0,HREC,ZWORK(:,JL),.FALSE.)
- IF (NWORKB/=0) CALL ERROR_WRITE_SURF_FA(HREC,NWORKB)
+ CALL FAIENC(KRESP,NUNIT_FA,YPREFIX,0,HREC,ZWORK(:,JL),.FALSE.)
+ IF (KRESP/=0) CALL ERROR_WRITE_SURF_FA(HREC,KRESP)
END DO
! On remet la valeur par defaut
- CALL FAGOTE(NWORKB,NUNIT_FA,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
+ CALL FAGOTE(KRESP,NUNIT_FA,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
ELSE
ZMEAN (:)=0.0
ZCOUNT(:)=0.0
@@ -527,25 +495,142 @@ IF (NRANK==NPIO) THEN
WHERE(ZWORK(:,JL)==XUNDEF)ZWORK(:,JL)=ZMEAN(JL)
WRITE(YPATCH,'(I3.3)')JL
YPREFIX=CPREFIX2D//YPATCH//'_'
- CALL FAIENC(NWORKB,NUNIT_FA,YPREFIX,0,HREC,ZWORK(:,JL),.FALSE.)
- IF (NWORKB/=0) CALL ERROR_WRITE_SURF_FA(HREC,NWORKB)
+ CALL FAIENC(KRESP,NUNIT_FA,YPREFIX,0,HREC,ZWORK(:,JL),.FALSE.)
+ IF (KRESP/=0) CALL ERROR_WRITE_SURF_FA(HREC,KRESP)
END DO
ENDIF
!
-!$OMP END SINGLE
- !
#ifdef SFX_MPI
XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0)
#endif
!
ENDIF
!
-KRESP = NWORKB
-!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFX2_FA',1,ZHOOK_HANDLE)
!
END SUBROUTINE WRITE_SURFX2_FA
!
+! #############################################################
+ SUBROUTINE WRITE_SURFX3_FA (HREC,KL1,KL2,KL3,PFIELD,KRESP,HCOMMENT,HDIR)
+! #############################################################
+!
+!!**** * - routine to fill a write 2D array for the externalised surface
+!
+!
+!
+!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE
+!
+USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, NMASK, NFULL, &
+ CPREFIX2D, LFANOCOMPACT
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE MODI_IO_BUFF
+USE MODI_ERROR_WRITE_SURF_FA
+USE MODI_GATHER_AND_WRITE_MPI
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
+!* 0.1 Declarations of arguments
+!
+!
+!
+ CHARACTER(LEN=LEN_HREC), INTENT(IN) :: HREC ! name of the article to be read
+INTEGER, INTENT(IN) :: KL1 ! number of points
+INTEGER, INTENT(IN) :: KL2 ! 2nd dimension
+INTEGER, INTENT(IN) :: KL3 ! 2nd dimension
+REAL, DIMENSION(KL1,KL2,KL3), INTENT(IN) :: PFIELD ! array containing the data field
+INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears
+ CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! comment string
+ CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field :
+ ! 'H' : field with
+ ! horizontal spatial dim.
+ ! '-' : no horizontal dim.
+!* 0.2 Declarations of local variables
+!
+LOGICAL :: GFOUND
+CHARACTER(LEN=4) :: YPREFIX
+CHARACTER(LEN=3) :: YPATCH
+INTEGER :: I, JL, JP ! loop counter
+INTEGER :: INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL
+REAL :: XTIME0
+REAL, DIMENSION(MAX(NFULL,SIZE(PFIELD,1)),SIZE(PFIELD,2),SIZE(PFIELD,3)) :: ZWORK ! work array read in the file
+REAL, DIMENSION(SIZE(PFIELD,2),SIZE(PFIELD,3)) :: ZMEAN, ZCOUNT
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFX2_FA',0,ZHOOK_HANDLE)
+!
+KRESP=0
+!
+ CALL IO_BUFF(HREC,'W',GFOUND)
+!
+IF (GFOUND .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFX2_FA',1,ZHOOK_HANDLE)
+IF (GFOUND) RETURN
+!
+ CALL GATHER_AND_WRITE_MPI(PFIELD,ZWORK,NMASK)
+!
+IF (NRANK==NPIO) THEN
+ !
+#ifdef SFX_MPI
+ XTIME0 = MPI_WTIME()
+#endif
+ !
+ IF(LFANOCOMPACT)THEN
+ CALL FAVEUR(KRESP,NUNIT_FA,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
+ ! -- Pour ecrire sans compactage
+ CALL FAGOTE(KRESP,NUNIT_FA,-1,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
+ DO JP=1,SIZE(ZWORK,3)
+ DO JL=1,SIZE(ZWORK,2)
+ WRITE(YPATCH,'(I3.3)')JL
+ YPREFIX=CPREFIX2D//YPATCH//'_'
+ CALL FAIENC(KRESP,NUNIT_FA,YPREFIX,0,HREC,ZWORK(:,JL,JP),.FALSE.)
+ IF (KRESP/=0) CALL ERROR_WRITE_SURF_FA(HREC,KRESP)
+ ENDDO
+ END DO
+ ! On remet la valeur par defaut
+ CALL FAGOTE(KRESP,NUNIT_FA,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
+ ELSE
+ ZMEAN (:,:)=0.0
+ ZCOUNT(:,:)=0.0
+ DO I=1,NFULL
+ DO JP=1,SIZE(ZWORK,3)
+ DO JL=1,SIZE(ZWORK,2)
+ IF(ZWORK(I,JL,JP)/=XUNDEF) THEN
+ ZMEAN (JL,JP)=ZMEAN(JL,JP)+ZWORK(I,JL,JP)
+ ZCOUNT(JL,JP)=ZCOUNT(JL,JP)+1.0
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ WHERE(ZCOUNT(:,:)>0.0)ZMEAN(:,:)=ZMEAN(:,:)/ZCOUNT(:,:)
+ DO JP=1,SIZE(ZWORK,3)
+ DO JL=1,SIZE(ZWORK,2)
+ WHERE(ZWORK(:,JL,JP)==XUNDEF)ZWORK(:,JL,JP)=ZMEAN(JL,JP)
+ WRITE(YPATCH,'(I3.3)')JL
+ YPREFIX=CPREFIX2D//YPATCH//'_'
+ CALL FAIENC(KRESP,NUNIT_FA,YPREFIX,0,HREC,ZWORK(:,JL,JP),.FALSE.)
+ IF (KRESP/=0) CALL ERROR_WRITE_SURF_FA(HREC,KRESP)
+ ENDDO
+ END DO
+ ENDIF
+ !
+#ifdef SFX_MPI
+ XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0)
+#endif
+ !
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFX3_FA',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE WRITE_SURFX3_FA
+!
! #############################################################
SUBROUTINE WRITE_SURFN1_FA (&
HREC,KL,KFIELD,KRESP,HCOMMENT,HDIR)
@@ -558,8 +643,6 @@ END SUBROUTINE WRITE_SURFX2_FA
!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE
!
-USE MODD_SURFEX_OMP, ONLY : LWORK0, NWORKB
-!
USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, NMASK, NFULL, CPREFIX1D, LFANOCOMPACT
!
USE MODE_FASURFEX
@@ -592,6 +675,7 @@ INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a probl
! '-' : no horizontal dim.
!* 0.2 Declarations of local variables
!
+LOGICAL :: GFOUND
CHARACTER(LEN=18) :: YNAME! Field Nam
INTEGER :: INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL
INTEGER, DIMENSION(MAX(NFULL,SIZE(KFIELD))) :: IWORK ! work array read in the file
@@ -600,15 +684,13 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFN1_FA',0,ZHOOK_HANDLE)
!
-!$OMP SINGLE
-NWORKB = 0
+KRESP = 0
!
CALL IO_BUFF(&
- HREC,'W',LWORK0)
-!$OMP END SINGLE
+ HREC,'W',GFOUND)
!
-IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFN1_FA',1,ZHOOK_HANDLE)
-IF (LWORK0) RETURN
+IF (GFOUND .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFN1_FA',1,ZHOOK_HANDLE)
+IF (GFOUND) RETURN
!
IF (HDIR/='H' .OR. HREC=="-") THEN
IWORK(1:KL) = KFIELD
@@ -622,34 +704,28 @@ IF (NRANK==NPIO) THEN
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP SINGLE
- !
IF(LFANOCOMPACT)THEN
- CALL FAVEUR(NWORKB,NUNIT_FA,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
+ CALL FAVEUR(KRESP,NUNIT_FA,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
! -- Pour ecrire sans compactage
- CALL FAGOTE(NWORKB,NUNIT_FA,-1,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
+ CALL FAGOTE(KRESP,NUNIT_FA,-1,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
ENDIF
!
YNAME=TRIM(CPREFIX1D)//TRIM(HREC)
!
- CALL FAECR_I_D(NWORKB,NUNIT_FA,YNAME,KL,IWORK(1:KL))
- IF (NWORKB/=0) CALL ERROR_WRITE_SURF_FA(HREC,NWORKB)
+ CALL FAECR_I_D(KRESP,NUNIT_FA,YNAME,KL,IWORK(1:KL))
+ IF (KRESP/=0) CALL ERROR_WRITE_SURF_FA(HREC,KRESP)
!
IF(LFANOCOMPACT)THEN
! On remet la valeur par defaut
- CALL FAGOTE(NWORKB,NUNIT_FA,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
+ CALL FAGOTE(KRESP,NUNIT_FA,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
ENDIF
!
-!$OMP END SINGLE
- !
#ifdef SFX_MPI
XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0)
#endif
!
ENDIF
!
-KRESP = NWORKB
-!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFN1_FA',1,ZHOOK_HANDLE)
RETURN
!
@@ -667,8 +743,6 @@ END SUBROUTINE WRITE_SURFN1_FA
!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE
!
-USE MODD_SURFEX_OMP, ONLY : LWORK0, NWORKB
-!
USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, CPREFIX1D, LFANOCOMPACT
!
USE MODE_FASURFEX
@@ -700,6 +774,7 @@ INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a probl
! '-' : no horizontal dim.
!* 0.2 Declarations of local variables
!
+LOGICAL :: GFOUND
CHARACTER(LEN=18):: YNAME ! Field Name
INTEGER :: INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL
REAL :: XTIME0
@@ -707,15 +782,13 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFL1_FA',0,ZHOOK_HANDLE)
!
-!$OMP SINGLE
-NWORKB=0
+KRESP=0
!
CALL IO_BUFF(&
- HREC,'W',LWORK0)
-!$OMP END SINGLE
+ HREC,'W',GFOUND)
!
-IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFL1_FA',1,ZHOOK_HANDLE)
-IF (LWORK0) RETURN
+IF (GFOUND .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFL1_FA',1,ZHOOK_HANDLE)
+IF (GFOUND) RETURN
!
IF (NRANK==NPIO) THEN
!
@@ -723,33 +796,27 @@ IF (NRANK==NPIO) THEN
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP SINGLE
- !
IF(LFANOCOMPACT)THEN
- CALL FAVEUR(NWORKB,NUNIT_FA,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
+ CALL FAVEUR(KRESP,NUNIT_FA,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
! -- Pour ecrire sans compactage
- CALL FAGOTE(NWORKB,NUNIT_FA,-1,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
+ CALL FAGOTE(KRESP,NUNIT_FA,-1,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
ENDIF
!
YNAME=TRIM(CPREFIX1D)//TRIM(HREC)
- CALL FAECR_L_D(NWORKB,NUNIT_FA,YNAME,KL,OFIELD)
- IF (NWORKB/=0) CALL ERROR_WRITE_SURF_FA(HREC,NWORKB)
+ CALL FAECR_L_D(KRESP,NUNIT_FA,YNAME,KL,OFIELD)
+ IF (KRESP/=0) CALL ERROR_WRITE_SURF_FA(HREC,KRESP)
!
IF(LFANOCOMPACT)THEN
! On remet la valeur par defaut
- CALL FAGOTE(NWORKB,NUNIT_FA,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
+ CALL FAGOTE(KRESP,NUNIT_FA,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
ENDIF
!
-!$OMP END SINGLE
- !
#ifdef SFX_MPI
XTIME_NPIO_WRITE = XTIME_NPIO_WRITE + (MPI_WTIME() - XTIME0)
#endif
!
ENDIF
!
-KRESP = NWORKB
-!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFL1_FA',1,ZHOOK_HANDLE)
!
END SUBROUTINE WRITE_SURFL1_FA
@@ -762,10 +829,6 @@ END SUBROUTINE WRITE_SURFL1_FA
!!**** * - routine to write a date
!
!
-!
-!
-USE MODD_SURFEX_OMP, ONLY : LWORK0
-!
USE MODD_IO_SURF_FA, ONLY : CPREFIX1D, NUNIT_FA, LFANOCOMPACT
!
USE MODE_FASURFEX
@@ -792,6 +855,7 @@ INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem
!* 0.2 Declarations of local variables
!
+LOGICAL :: GFOUND
CHARACTER(LEN=18) :: YNAME ! Field Name
INTEGER :: IRET
INTEGER :: IHOUR, IMIN, ISEC
@@ -813,9 +877,9 @@ IF (HREC=='DTCUR') THEN
ELSE
!
CALL IO_BUFF(&
- HREC,'W',LWORK0)
- IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFT0_FA',1,ZHOOK_HANDLE)
- IF (LWORK0) RETURN
+ HREC,'W',GFOUND)
+ IF (GFOUND .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFT0_FA',1,ZHOOK_HANDLE)
+ IF (GFOUND) RETURN
!
END IF
!
@@ -862,8 +926,6 @@ END SUBROUTINE WRITE_SURFT0_FA
!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, XTIME_NPIO_WRITE
!
-USE MODD_SURFEX_OMP, ONLY : LWORK0, NWORKB
-!
USE MODD_IO_SURF_FA, ONLY : NUNIT_FA, CPREFIX1D, NLUOUT
!
USE MODE_FASURFEX
@@ -897,6 +959,7 @@ INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem
!* 0.2 Declarations of local variables
!
+LOGICAL :: GFOUND
CHARACTER(LEN=18):: YNAME ! Field Name
INTEGER, DIMENSION(3,SIZE(KYEAR,1),SIZE(KYEAR,2)) :: ITDATE
REAL :: XTIME0
@@ -904,15 +967,13 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFT2_FA',0,ZHOOK_HANDLE)
!
-!$OMP SINGLE
-NWORKB = 0
+KRESP = 0
!
- CALL IO_BUFF(&
- HREC,'W',LWORK0)
-!$OMP END SINGLE
+CALL IO_BUFF(&
+ HREC,'W',GFOUND)
!
-IF (LWORK0 .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFT2_FA',1,ZHOOK_HANDLE)
-IF (LWORK0) RETURN
+IF (GFOUND .AND. LHOOK) CALL DR_HOOK('MODE_WRITE_SURF_FA:WRITE_SURFT2_FA',1,ZHOOK_HANDLE)
+IF (GFOUND) RETURN
!
IF (NRANK==NPIO) THEN
!
@@ -920,14 +981,10 @@ IF (NRANK==NPIO) THEN
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP SINGLE
- !
ITDATE(1,:,:) = KYEAR (:,:)
ITDATE(2,:,:) = KMONTH (:,:)
ITDATE(3,:,:) = KDAY (:,:)
!
-!$OMP END SINGLE
- !
YNAME=TRIM(CPREFIX1D)//TRIM(HREC)
WRITE(NLUOUT,*) ' WRITE_SURFT2_FA : time in 2 dimensions not yet implemented : YNAME=',YNAME,'ITDATE=',ITDATE
CALL ABOR1_SFX('MODE_WRITE_SURF_FA:WRITE_SURFT2_FA: time in 2 dimensions not yet implemented')
diff --git a/src/SURFEX/modi_glt_gelato.F90 b/src/SURFEX/modi_glt_gelato.F90
index f7cc8eedca7127b9b0da4e185e27717dce3dea66..d570f4fe14096f773b740ef6345f6c8db77bb7b3 100644
--- a/src/SURFEX/modi_glt_gelato.F90
+++ b/src/SURFEX/modi_glt_gelato.F90
@@ -157,23 +157,23 @@ ENDIF
! 2.2. Initialize lead temperature and sea ice-ocean fluxes
! ----------------------------------------------------------
!
- CALL initfl( tpglt%tfl )
+CALL initfl( tpglt%tfl )
!
!
! 2.3. Initialize diagnostics
! ----------------------------
!
- CALL inidia( tpglt%ind,tpglt%dia,tpglt%cdia0,tpglt%cdia )
- CALL gltools_timers('end inidia')
+CALL inidia( tpglt%ind,tpglt%dia,tpglt%cdia0,tpglt%cdia )
+CALL gltools_timers('end inidia')
!
!
! 2.4. Budgets initialization
! ----------------------------
!
- CALL glt_inibud( tpglt%bud )
+CALL glt_inibud( tpglt%bud )
!
- CALL glt_info_si( 'Initial conditions:',tpglt%dom,tpsit=tpglt%sit )
- CALL gltools_timers('end inibud')
+CALL glt_info_si( 'Initial conditions:',tpglt%dom,tpsit=tpglt%sit )
+CALL gltools_timers('end inibud')
!
!
!
@@ -207,7 +207,7 @@ IF ( tpglt%ind%cur==tpglt%ind%beg ) CALL inisal( tpglt%dom,tpglt%tml,tpglt%sit )
! .. This is done even if glt_updbud flag is off, to allow the computation
! of certain diagnostics if wished by the user.
!
- CALL glt_updbud( 1,'Initial conditions:', &
+CALL glt_updbud( 1,'Initial conditions:', &
tpglt%dom,tpglt%tml,tpglt%tfl,tpglt%atm_all,tpglt%blkw,tpglt%blki, &
tpglt%sit,tpglt%sil,tpglt%bud )
!
@@ -232,7 +232,7 @@ ELSE
tpglt%bud,tpglt%dia,tpglt%tfl,tpglt%sit,tpglt%sil,tpsit_d=tpglt%sit_d )
ENDIF
!
- CALL gltools_timers('end thermo')
+CALL gltools_timers('end thermo')
!
!
IF (lp1) THEN
diff --git a/src/SURFEX/modi_glt_thermo.F90 b/src/SURFEX/modi_glt_thermo.F90
index 31259633592cf633d9398d051029f637c1fe4687..2e1ac679818c2f6c85d0f96aaf399f2e79eb2396 100644
--- a/src/SURFEX/modi_glt_thermo.F90
+++ b/src/SURFEX/modi_glt_thermo.F90
@@ -243,7 +243,7 @@ SUBROUTINE glt_thermo &
! purely 1d...)
!
WHERE( tpdom(:,:)%tmk==1 .AND. &
- (tpmxl(:,:)%tml <= 1. .OR. zfsit(:,:)>epsil1) )
+ (tpmxl(:,:)%tml <= 1. .OR. zfsit(:,:)>0.0) )
isel(:,:) = 1
ENDWHERE
!
diff --git a/src/SURFEX/modi_glt_updasn_r.F90 b/src/SURFEX/modi_glt_updasn_r.F90
index ed4fd6ab9605789281af0b0444d3540126212b28..727c3468e03d4c823b25d577c6cbfaa572496ae1 100644
--- a/src/SURFEX/modi_glt_updasn_r.F90
+++ b/src/SURFEX/modi_glt_updasn_r.F90
@@ -1,327 +1,328 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-!GLT_LIC The GELATO model is a seaice model used in stand-alone or embedded mode.
-!GLT_LIC It has been developed by Meteo-France. The holder of GELATO is Meteo-France.
-!GLT_LIC
-!GLT_LIC This software is governed by the CeCILL-C license under French law and biding
-!GLT_LIC by the rules of distribution of free software. See the CeCILL-C_V1-en.txt
-!GLT_LIC (English) and CeCILL-C_V1-fr.txt (French) for details. The CeCILL is a free
-!GLT_LIC software license, explicitly compatible with the GNU GPL
-!GLT_LIC (see http://www.gnu.org/licenses/license-list.en.html#CeCILL)
-!GLT_LIC
-!GLT_LIC The CeCILL-C licence agreement grants users the right to modify and re-use the
-!GLT_LIC software governed by this free software license. The exercising of this right
-!GLT_LIC is conditional upon the obligation to make available to the community the
-!GLT_LIC modifications made to the source code of the software so as to contribute to
-!GLT_LIC its evolution.
-!GLT_LIC
-!GLT_LIC In consideration of access to the source code and the rights to copy, modify
-!GLT_LIC and redistribute granted by the license, users are provided only with a limited
-!GLT_LIC warranty and the software's author, the holder of the economic rights, and the
-!GLT_LIC successive licensors only have limited liability. In this respect, the risks
-!GLT_LIC associated with loading, using, modifying and/or developing or reproducing the
-!GLT_LIC software by the user are brought to the user's attention, given its Free
-!GLT_LIC Software status, which may make it complicated to use, with the result that its
-!GLT_LIC use is reserved for developers and experienced professionals having in-depth
-!GLT_LIC computer knowledge. Users are therefore encouraged to load and test the
-!GLT_LIC suitability of the software as regards their requirements in conditions enabling
-!GLT_LIC the security of their systems and/or data to be ensured and, more generally, to
-!GLT_LIC use and operate it in the same conditions of security.
-!GLT_LIC
-!GLT_LIC The GELATO sofware is cureently distibuted with the SURFEX software, available at
-!GLT_LIC http://www.cnrm.meteo.fr/surfex. The fact that you download the software deemed that
-!GLT_LIC you had knowledge of the CeCILL-C license and that you accept its terms.
-!GLT_LIC Attempts to use this software in a way not complying with CeCILL-C license
-!GLT_LIC may lead to prosecution.
-!GLT_LIC
-! =======================================================================
-! ======================== MODULE modi_glt_updasn_r =========================
-! =======================================================================
-!
-! Goal:
-! -----
-! This module contains a subroutine that is used to update snow
-! albedo, depending on wheather conditions.
-!
-! IMPORTANT NOTICE: this routine should be placed just after the
-! vertical heat diffusion, before a correction on snow temperature
-! MAX( T_melt, T_snow) was applied.
-!
-! Created : 2001/08 (D. Salas y Melia)
-! Taken out from thermo_ice, which used to do this job.
-! Modified: 2009/06 (D. Salas y Melia)
-! Reduced grid
-! Modified: 2010/02 (D. Salas y Melia)
-! - Rain is no longer considered here.
-! - bare thin ice albedo coefficients are adapted from
-! Flato and Brown (1996) - see also Curry et. al (2001)
-! - Douville et al. (1995) snow ageing parameterisations are
-! removed
-! Modified: 2012/01 (M. Chevallier & D. Salas y Melia)
-! A melt pond parameterization is included (updaponds_r).
-!
-! IF THE MELT POND PARAMETERIZATION IS DISABLED:
-!
-! *************** (3) snow cover: asn=asnow if hsnow>val else asi
-!
-! ----___------__ (2.1 + 2.3) bare ice+melt ponds: asi=albimlt if
-! ice surface is melting, else asi=asi(hi)
-!
-! IF THE MELT POND PARAMETERIZATION IS ENABLED:
-!
-! *************** (3) snow cover: asn=asnow if hsnow>val else asi
-!
-! ________ ___ (2.2) melt ponds: asi=fmp*abi + (1-fmp)*amp
-! --------------- (2.1) bare ice: asi=abi if ice surface is melting,
-! else asi=asi(hi)
-!
-! --------------------- BEGIN MODULE modi_glt_updasn_r ----------------------
-!
-!THXS_SFX!MODULE modi_glt_updasn_r
-!THXS_SFX!INTERFACE
-!THXS_SFX!!
-!THXS_SFX!SUBROUTINE glt_updasn_r( gsmelt,tpatm,tpblki,pvsp,tpsit,tpdia )
-!THXS_SFX! USE modd_types_glt
-!THXS_SFX! USE modd_glt_param
-!THXS_SFX! LOGICAL, DIMENSION(nt,np), INTENT(in) :: &
-!THXS_SFX! gsmelt
-!THXS_SFX! TYPE(t_atm), DIMENSION(np), INTENT(in) :: &
-!THXS_SFX! tpatm
-!THXS_SFX! TYPE(t_blk), DIMENSION(nt,np), INTENT(in) :: &
-!THXS_SFX! tpblki
-!THXS_SFX! REAL, DIMENSION(nl,nt,np), INTENT(in) :: &
-!THXS_SFX! pvsp
-!THXS_SFX! TYPE(t_sit), DIMENSION(nt,np), INTENT(inout) :: &
-!THXS_SFX! tpsit
-!THXS_SFX! TYPE(t_dia), DIMENSION(np), INTENT(inout) :: &
-!THXS_SFX! tpdia
-!THXS_SFX!END SUBROUTINE glt_updasn_r
-!THXS_SFX!!
-!THXS_SFX!END INTERFACE
-!THXS_SFX!END MODULE modi_glt_updasn_r
-!
-! ---------------------- END MODULE modi_glt_updasn_r -----------------------
-!
-!
-!
-! -----------------------------------------------------------------------
-! ------------------------- SUBROUTINE glt_updasn_r -------------------------
-!
-! * Subroutine used to update snow albedo (takes into account snow or
-! thermodynamic surface melting).
-! * (ASN = Albedo SNow)
-!
-SUBROUTINE glt_updasn_r( gsmelt,tpatm,tpblki,pvsp,tpsit,tpdia )
-!
- USE modd_glt_const_thm
- USE modd_types_glt
- USE modd_glt_param
- USE modi_gltools_updaponds_r
-!
- IMPLICIT NONE
-!
- LOGICAL, DIMENSION(nt,np), INTENT(in) :: &
- gsmelt
- TYPE(t_atm), DIMENSION(np), INTENT(in) :: &
- tpatm
- TYPE(t_blk), DIMENSION(nt,np), INTENT(in) :: &
- tpblki
- REAL, DIMENSION(nl,nt,np), INTENT(in) :: &
- pvsp
- TYPE(t_sit), DIMENSION(nt,np), INTENT(inout) :: &
- tpsit
- TYPE(t_dia), DIMENSION(np), INTENT(inout) :: &
- tpdia
-!
- LOGICAL, DIMENSION(nt,np) :: &
- gsnmelt,gsimelt
- REAL :: &
- zhsicr
- REAL, DIMENSION(np) :: &
- zfsit
- REAL, DIMENSION(nt,np) :: &
- zpcps,zpcpr,zasi,zasn,zent0,zalf,zt
-!
-!
-!
-! 1. Initializations
-! ==================
-!
-! .. Compute critical thickness (where albedo parameterization for thin ice
-! reaches standard sea ice albedo)
-!
- zhsicr = ( ( albi-albw )/xalf1 )**( 1./xpow )
-!
-! .. Initialize ancillary real arrays
-!
-! Sea ice and snow albedo
- zasi(:,:) = 0.
- zasn(:,:) = 0.
-!
-! Melting point gltools_enthalpy
- zent0 = -cpsw*mu*pvsp(nilay,:,:)
-!
-! .. Initialize sea ice and snow melting flags (criterion: as this routine is
-! placed just after the heat diffusion scheme, without any correction
-! on snow temperature, all slabs with T_snow > tice_m are melting)
-!
- gsnmelt = .FALSE.
- WHERE( tpsit(:,:)%hsn>=epsil1 .AND. gsmelt(:,:) )
- gsnmelt(:,:) = .TRUE.
- ENDWHERE
-!
- gsimelt(:,:) = .FALSE.
- WHERE( tpsit(:,:)%hsi > 0.1 .AND. tpsit(:,:)%hsn < epsil1 .AND. gsmelt(:,:) )
- gsimelt(:,:) = .TRUE.
- ENDWHERE
-!
-! .. Compute the amount of fallen precipitation.
-!
- zpcps(:,:) = SPREAD( tpatm(:)%sop,1,nt )
- zpcpr(:,:) = SPREAD( tpatm(:)%lip,1,nt )
-!
-!
-!
-! 2. Compute the albedo of snow-free ice
-! ======================================
-!
-! 2.1. Albedo of bare, non-melting sea ice (without ponds)
-! ---------------------------------------------------------
-!
-! The ice-thickness dependence of bare sea ice albedo was eliminated in this version
-! While based on physical grounds for young sea ice, this thickness dependence is
-! clearly not valid for old, thinning sea ice.
-! The lower albedo of young sea ice is due to the fact this ice tends to be
-! rather translucid. However, the SW radiation transmission coefficient though
-! sea ice does not take into account the fact sea ice is more or less translucid.
-! Actually, this parameterization probably caused the sea ice to absorb too much
-! SW radiation.
-! So here we prefer simply assuming the albedo of melting sea ice is just equal to
-! a standard value (albi)
-!
-! IF ( niceage==1 ) THEN
-! zalf(:,:) = EXP( - MAX( tpsit(:,:)%age/xmonth2sec-6.,0. ) )
-! ELSE
-! zalf(:,:) = 1.
-! ENDIF
-! zalf(:,:) = albyngi * zalf(:,:)
-!!
-! WHERE( tpsit(:,:)%hsi<zhsicr )
-! zt(:,:) = tpsit(:,:)%hsi
-! zasi(:,:) = zalf(:,:) * ( xalf1*AMAX1( zt(:,:),0. )**xpow + albw ) + &
-! ( 1.-zalf(:,:) ) * albi
-!!
-!! .. No thermodynamic surface melting on thick ice without snow.
-!! The albedo is set to bare ice albedo.
-!!
-! ELSEWHERE
-! zasi(:,:) = albi
-!!
-! ENDWHERE
-!
- zasi(:,:) = albi
-!
-!
-! 2.2. Albedo of bare, melting sea ice (pond parameterization is enabled)
-! ------------------------------------------------------------------------
-!
-! .. Thermodynamic surface melting on ice without snow.
-! The albedo is set to melting ice albedo.
-!
- IF ( nmponds==1) THEN
-! .. Melt pond case: melting bare ice albedo is considered as a physical
-! constant (=0.65).
-!
- WHERE( gsimelt(:,:) )
- zasi(:,:) = AMIN1( zasi(:,:),xalbareimlt )
- ENDWHERE
-! .. Invoke the pond parameterization. The melting ice surface consists in a fraction (fmp)
-! covered with meltwater ponds, and in melting bare ice (1-fmp). This parameterization
-! updates the global melting ice albedo.
-!
- CALL gltools_updaponds_r(gsmelt,tpatm,tpblki,tpdia,tpsit,zasi)
- ELSE
-!
-!
-! 2.3. Albedo of bare, melting sea ice (pond parameterization is disabled)
-! -------------------------------------------------------------------------
-!
-! .. In this case, melting ice surface is a mix of melting bare ice and melt ponds.
-! Melting ice albedo is prescribed as a "tuning" parameter.
- WHERE( gsimelt(:,:) )
- zasi(:,:) = AMIN1( zasi(:,:),albimlt )
- ENDWHERE
-!
- ENDIF
-!
-!
-!
-! 3. Compute the albedo of the snow covered part of the ice
-! =========================================================
-!
-! 3.1. Determine the initial snow albedo
-! --------------------------------------
-!
-! .. Now compute albedo of the snow covered part of the ice slab from:
-! - initial averaged snow+bare ice albedo, tpsit%asn
-! - computed bare ice albedo, zasi
-! - snow thickness, tpsit%hsn
-!
- zt(:,:) = tpsit(:,:)%rsn*tpsit(:,:)%hsn / rhofw
- zalf(:,:) = AMIN1( zt(:,:)/wnew,1. )
-!
-! .. Snow cover albedo: melting and dry snow cases
-!
- WHERE( gsnmelt(:,:) )
- zasn(:,:) = albsmlt
- ELSEWHERE
- zasn(:,:) = albsdry
- ENDWHERE
-!
-!
-! 3.2. Case of new snow falls
-! ----------------------------
-!
-! .. Snow accumulation : albedo is refreshed to its maximum value if
-! snow amount reaches a threshold wnew. If new snow thickness is less
-! than wnew, a linear combination of initial snow surface albedo and
-! maximum snow albedo gives new albedo.
-!
- WHERE ( zpcps(:,:)>zpcpr(:,:) )
- zasn(:,:) = albsdry
- ENDWHERE
-!
-!
-!
-! 4. Weighted surface albedo (snow covered + bare ice parts of the slab)
-! =======================================================================
-!
-! .. Now that albedos were computed both on a sea ice slab with and
-! without snow, the global surface albedo will be recomposed to take
-! into account the fact that a thin snow cover does not actually cover
-! the entire slab.
-!
- tpsit(:,:)%asn = &
- zalf(:,:)*zasn(:,:) + (1.-zalf(:,:))*zasi(:,:)
-!
-! .. For AR5 diagnostics: weighted bare sea ice albedo
-! Weights for final computation of the average bare ice albedo
-! [i.e. SUM(ftot)] must be incremented here, not where diagnostics
-! are writtenSUM(ftot))
-! The reason for this is that tpsit%fsi in the present routine would
-! not be consistent with total sea ice fraction in the diagnostics.
-!
-!* Accumulate sea ice fraction
- zfsit(:) = SUM( tpsit(:,:)%fsi, DIM=1 )
- tpdia(:)%aiw = tpdia(:)%aiw + zfsit(:)
-!* Ice surface albedo (bare ice + melt ponds)
- tpdia(:)%asi = SUM( tpsit(:,:)%fsi*zasi(:,:),DIM=1 )
-!* Snow albedo: approximation (suppose zalf is generally close to 1)
- tpdia(:)%asn = SUM( tpsit(:,:)%fsi*zasn(:,:),DIM=1 )
-!
-END SUBROUTINE glt_updasn_r
-!
-! ---------------------- END SUBROUTINE glt_updasn_r ------------------------
-! -----------------------------------------------------------------------
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+!GLT_LIC The GELATO model is a seaice model used in stand-alone or embedded mode.
+!GLT_LIC It has been developed by Meteo-France. The holder of GELATO is Meteo-France.
+!GLT_LIC
+!GLT_LIC This software is governed by the CeCILL-C license under French law and biding
+!GLT_LIC by the rules of distribution of free software. See the CeCILL-C_V1-en.txt
+!GLT_LIC (English) and CeCILL-C_V1-fr.txt (French) for details. The CeCILL is a free
+!GLT_LIC software license, explicitly compatible with the GNU GPL
+!GLT_LIC (see http://www.gnu.org/licenses/license-list.en.html#CeCILL)
+!GLT_LIC
+!GLT_LIC The CeCILL-C licence agreement grants users the right to modify and re-use the
+!GLT_LIC software governed by this free software license. The exercising of this right
+!GLT_LIC is conditional upon the obligation to make available to the community the
+!GLT_LIC modifications made to the source code of the software so as to contribute to
+!GLT_LIC its evolution.
+!GLT_LIC
+!GLT_LIC In consideration of access to the source code and the rights to copy, modify
+!GLT_LIC and redistribute granted by the license, users are provided only with a limited
+!GLT_LIC warranty and the software's author, the holder of the economic rights, and the
+!GLT_LIC successive licensors only have limited liability. In this respect, the risks
+!GLT_LIC associated with loading, using, modifying and/or developing or reproducing the
+!GLT_LIC software by the user are brought to the user's attention, given its Free
+!GLT_LIC Software status, which may make it complicated to use, with the result that its
+!GLT_LIC use is reserved for developers and experienced professionals having in-depth
+!GLT_LIC computer knowledge. Users are therefore encouraged to load and test the
+!GLT_LIC suitability of the software as regards their requirements in conditions enabling
+!GLT_LIC the security of their systems and/or data to be ensured and, more generally, to
+!GLT_LIC use and operate it in the same conditions of security.
+!GLT_LIC
+!GLT_LIC The GELATO sofware is cureently distibuted with the SURFEX software, available at
+!GLT_LIC http://www.cnrm.meteo.fr/surfex. The fact that you download the software deemed that
+!GLT_LIC you had knowledge of the CeCILL-C license and that you accept its terms.
+!GLT_LIC Attempts to use this software in a way not complying with CeCILL-C license
+!GLT_LIC may lead to prosecution.
+!GLT_LIC
+! =======================================================================
+! ======================== MODULE modi_glt_updasn_r =========================
+! =======================================================================
+!
+! Goal:
+! -----
+! This module contains a subroutine that is used to update snow
+! albedo, depending on wheather conditions.
+!
+! IMPORTANT NOTICE: this routine should be placed just after the
+! vertical heat diffusion, before a correction on snow temperature
+! MAX( T_melt, T_snow) was applied.
+!
+! Created : 2001/08 (D. Salas y Melia)
+! Taken out from thermo_ice, which used to do this job.
+! Modified: 2009/06 (D. Salas y Melia)
+! Reduced grid
+! Modified: 2010/02 (D. Salas y Melia)
+! - Rain is no longer considered here.
+! - bare thin ice albedo coefficients are adapted from
+! Flato and Brown (1996) - see also Curry et. al (2001)
+! - Douville et al. (1995) snow ageing parameterisations are
+! removed
+! Modified: 2012/01 (M. Chevallier & D. Salas y Melia)
+! A melt pond parameterization is included (updaponds_r).
+!
+! IF THE MELT POND PARAMETERIZATION IS DISABLED:
+!
+! *************** (3) snow cover: asn=asnow if hsnow>val else asi
+!
+! ----___------__ (2.1 + 2.3) bare ice+melt ponds: asi=albimlt if
+! ice surface is melting, else asi=asi(hi)
+!
+! IF THE MELT POND PARAMETERIZATION IS ENABLED:
+!
+! *************** (3) snow cover: asn=asnow if hsnow>val else asi
+!
+! ________ ___ (2.2) melt ponds: asi=fmp*abi + (1-fmp)*amp
+! --------------- (2.1) bare ice: asi=abi if ice surface is melting,
+! else asi=asi(hi)
+!
+! --------------------- BEGIN MODULE modi_glt_updasn_r ----------------------
+!
+!THXS_SFX!MODULE modi_glt_updasn_r
+!THXS_SFX!INTERFACE
+!THXS_SFX!!
+!THXS_SFX!SUBROUTINE glt_updasn_r( gsmelt,tpatm,tpblki,pvsp,tpsit,tpdia )
+!THXS_SFX! USE modd_types_glt
+!THXS_SFX! USE modd_glt_param
+!THXS_SFX! LOGICAL, DIMENSION(nt,np), INTENT(in) :: &
+!THXS_SFX! gsmelt
+!THXS_SFX! TYPE(t_atm), DIMENSION(np), INTENT(in) :: &
+!THXS_SFX! tpatm
+!THXS_SFX! TYPE(t_blk), DIMENSION(nt,np), INTENT(in) :: &
+!THXS_SFX! tpblki
+!THXS_SFX! REAL, DIMENSION(nl,nt,np), INTENT(in) :: &
+!THXS_SFX! pvsp
+!THXS_SFX! TYPE(t_sit), DIMENSION(nt,np), INTENT(inout) :: &
+!THXS_SFX! tpsit
+!THXS_SFX! TYPE(t_dia), DIMENSION(np), INTENT(inout) :: &
+!THXS_SFX! tpdia
+!THXS_SFX!END SUBROUTINE glt_updasn_r
+!THXS_SFX!!
+!THXS_SFX!END INTERFACE
+!THXS_SFX!END MODULE modi_glt_updasn_r
+!
+! ---------------------- END MODULE modi_glt_updasn_r -----------------------
+!
+!
+!
+! -----------------------------------------------------------------------
+! ------------------------- SUBROUTINE glt_updasn_r -------------------------
+!
+! * Subroutine used to update snow albedo (takes into account snow or
+! thermodynamic surface melting).
+! * (ASN = Albedo SNow)
+!
+SUBROUTINE glt_updasn_r( gsmelt,tpatm,tpblki,pvsp,tpsit,tpdia )
+!
+ USE modd_glt_const_thm
+ USE modd_types_glt
+ USE modd_glt_param
+!
+ USE modi_gltools_updaponds_r
+!
+ IMPLICIT NONE
+!
+ LOGICAL, DIMENSION(nt,np), INTENT(in) :: &
+ gsmelt
+ TYPE(t_atm), DIMENSION(np), INTENT(in) :: &
+ tpatm
+ TYPE(t_blk), DIMENSION(nt,np), INTENT(in) :: &
+ tpblki
+ REAL, DIMENSION(nl,nt,np), INTENT(in) :: &
+ pvsp
+ TYPE(t_sit), DIMENSION(nt,np), INTENT(inout) :: &
+ tpsit
+ TYPE(t_dia), DIMENSION(np), INTENT(inout) :: &
+ tpdia
+!
+ LOGICAL, DIMENSION(nt,np) :: &
+ gsnmelt,gsimelt
+ REAL :: &
+ zhsicr
+ REAL, DIMENSION(np) :: &
+ zfsit
+ REAL, DIMENSION(nt,np) :: &
+ zpcps,zpcpr,zasi,zasn,zent0,zalf,zt
+!
+!
+!
+! 1. Initializations
+! ==================
+!
+! .. Compute critical thickness (where albedo parameterization for thin ice
+! reaches standard sea ice albedo)
+!
+ zhsicr = ( ( albi-albw )/xalf1 )**( 1./xpow )
+!
+! .. Initialize ancillary real arrays
+!
+! Sea ice and snow albedo
+ zasi(:,:) = 0.
+ zasn(:,:) = 0.
+!
+! Melting point gltools_enthalpy
+ zent0 = -cpsw*mu*pvsp(nilay,:,:)
+!
+! .. Initialize sea ice and snow melting flags (criterion: as this routine is
+! placed just after the heat diffusion scheme, without any correction
+! on snow temperature, all slabs with T_snow > tice_m are melting)
+!
+ gsnmelt = .FALSE.
+ WHERE( tpsit(:,:)%hsn>=epsil1 .AND. gsmelt(:,:) )
+ gsnmelt(:,:) = .TRUE.
+ ENDWHERE
+!
+ gsimelt(:,:) = .FALSE.
+ WHERE( tpsit(:,:)%hsi > 0.1 .AND. tpsit(:,:)%hsn < epsil1 .AND. gsmelt(:,:) )
+ gsimelt(:,:) = .TRUE.
+ ENDWHERE
+!
+! .. Compute the amount of fallen precipitation.
+!
+ zpcps(:,:) = SPREAD( tpatm(:)%sop,1,nt )
+ zpcpr(:,:) = SPREAD( tpatm(:)%lip,1,nt )
+!
+!
+!
+! 2. Compute the albedo of snow-free ice
+! ======================================
+!
+! 2.1. Albedo of bare, non-melting sea ice (without ponds)
+! ---------------------------------------------------------
+!
+! The ice-thickness dependence of bare sea ice albedo was eliminated in this version
+! While based on physical grounds for young sea ice, this thickness dependence is
+! clearly not valid for old, thinning sea ice.
+! The lower albedo of young sea ice is due to the fact this ice tends to be
+! rather translucid. However, the SW radiation transmission coefficient though
+! sea ice does not take into account the fact sea ice is more or less translucid.
+! Actually, this parameterization probably caused the sea ice to absorb too much
+! SW radiation.
+! So here we prefer simply assuming the albedo of melting sea ice is just equal to
+! a standard value (albi)
+!
+! IF ( niceage==1 ) THEN
+! zalf(:,:) = EXP( - MAX( tpsit(:,:)%age/xmonth2sec-6.,0. ) )
+! ELSE
+! zalf(:,:) = 1.
+! ENDIF
+! zalf(:,:) = albyngi * zalf(:,:)
+!!
+! WHERE( tpsit(:,:)%hsi<zhsicr )
+! zt(:,:) = tpsit(:,:)%hsi
+! zasi(:,:) = zalf(:,:) * ( xalf1*AMAX1( zt(:,:),0. )**xpow + albw ) + &
+! ( 1.-zalf(:,:) ) * albi
+!!
+!! .. No thermodynamic surface melting on thick ice without snow.
+!! The albedo is set to bare ice albedo.
+!!
+! ELSEWHERE
+! zasi(:,:) = albi
+!!
+! ENDWHERE
+!
+ zasi(:,:) = albi
+!
+!
+! 2.2. Albedo of bare, melting sea ice (pond parameterization is enabled)
+! ------------------------------------------------------------------------
+!
+! .. Thermodynamic surface melting on ice without snow.
+! The albedo is set to melting ice albedo.
+!
+ IF ( nmponds==1) THEN
+! .. Melt pond case: melting bare ice albedo is considered as a physical
+! constant (=0.65).
+!
+ WHERE( gsimelt(:,:) )
+ zasi(:,:) = AMIN1( zasi(:,:),xalbareimlt )
+ ENDWHERE
+! .. Invoke the pond parameterization. The melting ice surface consists in a fraction (fmp)
+! covered with meltwater ponds, and in melting bare ice (1-fmp). This parameterization
+! updates the global melting ice albedo.
+!
+ CALL gltools_updaponds_r(gsmelt,tpatm,tpblki,tpdia,tpsit,zasi)
+ ELSE
+!
+!
+! 2.3. Albedo of bare, melting sea ice (pond parameterization is disabled)
+! -------------------------------------------------------------------------
+!
+! .. In this case, melting ice surface is a mix of melting bare ice and melt ponds.
+! Melting ice albedo is prescribed as a "tuning" parameter.
+ WHERE( gsimelt(:,:) )
+ zasi(:,:) = AMIN1( zasi(:,:),albimlt )
+ ENDWHERE
+!
+ ENDIF
+!
+!
+!
+! 3. Compute the albedo of the snow covered part of the ice
+! =========================================================
+!
+! 3.1. Determine the initial snow albedo
+! --------------------------------------
+!
+! .. Now compute albedo of the snow covered part of the ice slab from:
+! - initial averaged snow+bare ice albedo, tpsit%asn
+! - computed bare ice albedo, zasi
+! - snow thickness, tpsit%hsn
+!
+ zt(:,:) = tpsit(:,:)%rsn*tpsit(:,:)%hsn / rhofw
+ zalf(:,:) = AMIN1( zt(:,:)/wnew,1. )
+!
+! .. Snow cover albedo: melting and dry snow cases
+!
+ WHERE( gsnmelt(:,:) )
+ zasn(:,:) = albsmlt
+ ELSEWHERE
+ zasn(:,:) = albsdry
+ ENDWHERE
+!
+!
+! 3.2. Case of new snow falls
+! ----------------------------
+!
+! .. Snow accumulation : albedo is refreshed to its maximum value if
+! snow amount reaches a threshold wnew. If new snow thickness is less
+! than wnew, a linear combination of initial snow surface albedo and
+! maximum snow albedo gives new albedo.
+!
+ WHERE ( zpcps(:,:)>zpcpr(:,:) )
+ zasn(:,:) = albsdry
+ ENDWHERE
+!
+!
+!
+! 4. Weighted surface albedo (snow covered + bare ice parts of the slab)
+! =======================================================================
+!
+! .. Now that albedos were computed both on a sea ice slab with and
+! without snow, the global surface albedo will be recomposed to take
+! into account the fact that a thin snow cover does not actually cover
+! the entire slab.
+!
+ tpsit(:,:)%asn = &
+ zalf(:,:)*zasn(:,:) + (1.-zalf(:,:))*zasi(:,:)
+!
+! .. For AR5 diagnostics: weighted bare sea ice albedo
+! Weights for final computation of the average bare ice albedo
+! [i.e. SUM(ftot)] must be incremented here, not where diagnostics
+! are writtenSUM(ftot))
+! The reason for this is that tpsit%fsi in the present routine would
+! not be consistent with total sea ice fraction in the diagnostics.
+!
+!* Accumulate sea ice fraction
+ zfsit(:) = SUM( tpsit(:,:)%fsi, DIM=1 )
+ tpdia(:)%aiw = tpdia(:)%aiw + zfsit(:)
+!* Ice surface albedo (bare ice + melt ponds)
+ tpdia(:)%asi = SUM( tpsit(:,:)%fsi*zasi(:,:),DIM=1 )
+!* Snow albedo: approximation (suppose zalf is generally close to 1)
+ tpdia(:)%asn = SUM( tpsit(:,:)%fsi*zasn(:,:),DIM=1 )
+!
+END SUBROUTINE glt_updasn_r
+!
+! ---------------------- END SUBROUTINE glt_updasn_r ------------------------
+! -----------------------------------------------------------------------
diff --git a/src/SURFEX/modi_glt_vhdiff_r.F90 b/src/SURFEX/modi_glt_vhdiff_r.F90
index 2d0f7a13e28b3bd95c10bd3970321faea800fcf4..665dec71ab0205b56b3572acab6f5de71508a311 100644
--- a/src/SURFEX/modi_glt_vhdiff_r.F90
+++ b/src/SURFEX/modi_glt_vhdiff_r.F90
@@ -729,25 +729,25 @@ zdhmelt0 = sum(pdhmelt,dim=1)/dtt
END DO ! End of loop on grid cells
!
! .. Change sign of pcondb
- IF (lp1) THEN
+ IF (lwg) THEN
ztot_ice_snow= np*nt+SUM(icv,MASK=icv<0)
- WRITE(noutlu,*)
- WRITE(noutlu,*) ' ** WARNING **'
- WRITE(noutlu,*) &
- ' Total number of cases with ice/snow : ', &
- ztot_ice_snow
- WRITE(noutlu,*) &
- ' Convergence failed on # of points : ', &
- np*nt-SUM(ABS(icv))
- IF ( ztot_ice_snow > 0) THEN
- zfailures=100.*FLOAT(np*nt-SUM(ABS(icv)))/ztot_ice_snow
- ELSE
- zfailures=0.
- ENDIF
- WRITE(noutlu,FMT='(A,F6.2)') &
- ' % of failure : ', &
- zfailures
- WRITE(noutlu,*)
+! WRITE(noutlu,*)
+! WRITE(noutlu,*) ' ** WARNING **'
+! WRITE(noutlu,*) &
+! ' Total number of cases with ice/snow : ', &
+! ztot_ice_snow
+! WRITE(noutlu,*) &
+! ' Convergence failed on # of points : ', &
+! np*nt-SUM(ABS(icv))
+! IF ( ztot_ice_snow > 0) THEN
+! zfailures=100.*FLOAT(np*nt-SUM(ABS(icv)))/ztot_ice_snow
+! ELSE
+! zfailures=0.
+! ENDIF
+! WRITE(noutlu,FMT='(A,F6.2)') &
+! ' % of failure : ', &
+! zfailures
+! WRITE(noutlu,*)
ENDIF
!
pcondb(:,:) = -pcondb(:,:)
diff --git a/src/SURFEX/modi_gltools_nextline.F90 b/src/SURFEX/modi_gltools_nextline.F90
index d49aa3a1e0d6bc5ce3f449c49708376d73f5ce26..21d6fb26c2d8cab273546b59299dbd84d9aa58f2 100644
--- a/src/SURFEX/modi_gltools_nextline.F90
+++ b/src/SURFEX/modi_gltools_nextline.F90
@@ -77,14 +77,14 @@ INTEGER, INTENT(in) :: &
klun
INTEGER, INTENT(out) :: &
kend
- CHARACTER(80), INTENT(out) :: &
+CHARACTER(80), INTENT(out) :: &
hpar,hval
- CHARACTER(1), OPTIONAL, INTENT(in) :: &
+CHARACTER(1), OPTIONAL, INTENT(in) :: &
hcomment
!
INTEGER :: ji,iostat
- CHARACTER(1) :: ychar,ycomment
- CHARACTER(80) :: yline
+CHARACTER(1) :: ychar,ycomment
+CHARACTER(80) :: yline
!
!
!
diff --git a/src/SURFEX/modi_gltools_nextval.F90 b/src/SURFEX/modi_gltools_nextval.F90
index 6cb710bc5efd6241e60cc3a578986d11d97535a4..9326249b2c462a2afaa91c7cd11f07c0ee37a28a 100644
--- a/src/SURFEX/modi_gltools_nextval.F90
+++ b/src/SURFEX/modi_gltools_nextval.F90
@@ -110,7 +110,7 @@ ENDIF
! 2. Get the first informative line
! ==================================
!
- CALL gltools_nextline( klun,iend,hpar,hval,hcomment=ycomment )
+CALL gltools_nextline( klun,iend,hpar,hval,hcomment=ycomment )
!
!
! 3. Controls
diff --git a/src/SURFEX/modi_gltools_nwords.F90 b/src/SURFEX/modi_gltools_nwords.F90
index 2151f6b3d0d5d0f6bbf9148268f0c2774bc42f01..493b5622218442cfdb0c253e6d7556a9bac8f5f6 100644
--- a/src/SURFEX/modi_gltools_nwords.F90
+++ b/src/SURFEX/modi_gltools_nwords.F90
@@ -69,16 +69,16 @@ FUNCTION gltools_nwords( hval ) RESULT(nwords)
!
IMPLICIT NONE
!
- CHARACTER(*), INTENT(in) :: &
+CHARACTER(*), INTENT(in) :: &
hval
INTEGER :: &
nwords
!
INTEGER :: &
inum
- CHARACTER(1), PARAMETER :: &
+CHARACTER(1), PARAMETER :: &
ysep=' '
- CHARACTER(LEN=LEN(hval)) :: &
+CHARACTER(LEN=LEN(hval)) :: &
ystr
!
!
diff --git a/src/SURFEX/modi_gltools_readnam.F90 b/src/SURFEX/modi_gltools_readnam.F90
index 9de3d38ee7352698285a1926e2e8f53ea5a5641e..5b2d671f63ec971d323681c05c6d5a9da7ef0c69 100644
--- a/src/SURFEX/modi_gltools_readnam.F90
+++ b/src/SURFEX/modi_gltools_readnam.F90
@@ -84,15 +84,15 @@ LOGICAL, INTENT(IN),OPTIONAL :: &
INTEGER, INTENT(IN),OPTIONAL :: &
kluout ! imposed output logical unit ?
- CHARACTER(1) :: &
+CHARACTER(1) :: &
ytag
- CHARACTER(6), PARAMETER :: &
+CHARACTER(6), PARAMETER :: &
ypinpfile='gltpar'
- CHARACTER(80) :: &
+CHARACTER(80) :: &
ypar,yval,yinsfld
- CHARACTER(80), DIMENSION(:), ALLOCATABLE :: &
+CHARACTER(80), DIMENSION(:), ALLOCATABLE :: &
ylistfld
- CHARACTER(1000) :: &
+CHARACTER(1000) :: &
yfldin
INTEGER :: &
iparlu,iok,infld,jl,icount, ierr
@@ -377,13 +377,13 @@ ENDIF
!
SELECT CASE ( TRIM(cnflxin) )
!
- CASE('mixed') ; nnflxin = 0
+CASE('mixed') ; nnflxin = 0
if (lp1) WRITE(*,*) 'We are using single physics (one input flux)'
- CASE('double') ; nnflxin = 1
+CASE('double') ; nnflxin = 1
IF (lp1) WRITE(*,*) 'We are using double physics (two input fluxes)'
- CASE('multi') ; nnflxin = nt
+CASE('multi') ; nnflxin = nt
IF (lp1) WRITE(*,*) 'We are using multiple physics (one flux per ice cat + water)'
- CASE DEFAULT
+CASE DEFAULT
IF (lp1) WRITE(*,*) 'We stop. Invalid parameter cnflxin = ' // TRIM(cnflxin) ; STOP
!
END SELECT
diff --git a/src/SURFEX/modi_gltools_strsplit.F90 b/src/SURFEX/modi_gltools_strsplit.F90
index 2933e1597103fc27ebb490d81ffb536c5a77ec1d..1fe8b835b6ac75d968aa3dc8981f70a5c9348d31 100644
--- a/src/SURFEX/modi_gltools_strsplit.F90
+++ b/src/SURFEX/modi_gltools_strsplit.F90
@@ -75,18 +75,18 @@ FUNCTION gltools_strsplit( hval,knword ) RESULT(hresult)
!
IMPLICIT NONE
!
- CHARACTER(*), INTENT(in) :: &
+CHARACTER(*), INTENT(in) :: &
hval
INTEGER, INTENT(in) :: &
knword
- CHARACTER(80), DIMENSION(knword) :: &
+CHARACTER(80), DIMENSION(knword) :: &
hresult
!
INTEGER :: &
inum,inwords
- CHARACTER(1), PARAMETER :: &
+CHARACTER(1), PARAMETER :: &
ysep=' '
- CHARACTER(LEN=LEN(hval)) :: &
+CHARACTER(LEN=LEN(hval)) :: &
ystr
!
!
diff --git a/src/SURFEX/modn_assim.F90 b/src/SURFEX/modn_assim.F90
index 5d7feac3c7bbbecbfc9c3b361f49d4b1ae9232e4..1b0321e24b56e905ccf27fc4cbe73a9f32cceb9d 100644
--- a/src/SURFEX/modn_assim.F90
+++ b/src/SURFEX/modn_assim.F90
@@ -35,8 +35,8 @@ USE MODD_ASSIM, ONLY: LASSIM,CASSIM,CASSIM_ISBA,NPRINTLEV,LAROME,LECSST,LAESST,
LALADSURF,LREAD_SST_FROM_FILE,CFILE_FORMAT_SST,LEXTRAP_SEA,LEXTRAP_WATER, &
LEXTRAP_NATURE,NECHGU,XRCLIMCA,XRCLISST,XSIGH2MO,XSIGT2MO,XSIGWGO,XSIGWGB, &
XSIGW2B,LOBSWG,LOBS2M,LIMVEG,XSPRECIP2,XRTHR_QC,XSIGWGO_MAX,XRSCAL_JAC, &
- CBIO,LPRT,LBEV,LBFIXED,NOBSTYPE,XERROBS_M,NNCO,NIVAR,NVAR,CVAR_M,LSIM, &
- XSIGMA_M,XTPRT_M,NNCV,XSCALE_Q,XSCALE_QLAI,XALPH,LOBSHEADER,LOBSNAT, &
+ CBIO,LPRT,LBEV,LBFIXED,NOBSTYPE,COBS_M,XERROBS_M,NNCO,NIVAR,NVAR,CVAR_M, &
+ LSIM,XSIGMA_M,XTPRT_M,NNCV,XSCALE_Q,XSCALE_QLAI,XALPH,LOBSHEADER,LOBSNAT, &
CFILE_FORMAT_OBS,CFILE_FORMAT_LSM,CFILE_FORMAT_CLIM,CFILE_FORMAT_FG, &
NBOUTPUT,CPREFIX_M,CPREFIX_BIO,LENKF,LDENKF,XASSIM_WINH,NENS,NIE,XINFL_M, &
XADDINFL_M,XADDTIMECORR_M,LENS_GEN,LPB_CORRELATIONS,LPERTURBATION_RUN, &
@@ -50,7 +50,7 @@ NAMELIST/NAM_ASSIM/LASSIM,CASSIM,CASSIM_ISBA,NPRINTLEV,LAROME,LECSST,LAESST,LAES
NAMELIST/NAM_NACVEG/NECHGU,XRCLIMCA,XRCLISST,XSIGH2MO,XSIGT2MO,XSIGWGO,XSIGWGB,XSIGW2B, &
LOBSWG,LOBS2M,LIMVEG,XSPRECIP2,XRTHR_QC,XSIGWGO_MAX,XRSCAL_JAC
NAMELIST/NAM_IO_VARASSIM/LPRT, LSIM, LBEV, LBFIXED
-NAMELIST/NAM_OBS/NOBSTYPE,LOBSHEADER,CFILE_FORMAT_OBS, LOBSNAT, XERROBS_M, NNCO
+NAMELIST/NAM_OBS/NOBSTYPE,LOBSHEADER,CFILE_FORMAT_OBS, LOBSNAT, COBS_M, XERROBS_M, NNCO
NAMELIST/NAM_VAR/NIVAR, NVAR, CVAR_M, CPREFIX_M, XSIGMA_M, XTPRT_M, NNCV, XSCALE_Q, XSCALE_QLAI, &
CBIO, CPREFIX_BIO, XALPH
NAMELIST/NAM_ENS/NENS, NIE, XASSIM_WINH, XINFL_M, XADDINFL_M, XADDTIMECORR_M, &
diff --git a/src/SURFEX/modn_flaken.F90 b/src/SURFEX/modn_flaken.F90
index eb684b354d7e22d7cf317152d7b6d33ac192ebfd..30e6e97657e5495e9b6265c7aa7a14a5623fa91b 100644
--- a/src/SURFEX/modn_flaken.F90
+++ b/src/SURFEX/modn_flaken.F90
@@ -71,7 +71,7 @@ NAMELIST/NAM_DIAG_SURFn/N2M,L2M_MIN_ZS,LSURF_BUDGET,LRAD_BUDGET, &
LSURF_BUDGETC,LRESET_BUDGETC,LCOEF,LSURF_VARS
NAMELIST/NAM_CH_FLAKEn/CCH_DRY_DEP
!
- CONTAINS
+CONTAINS
!
SUBROUTINE INIT_NAM_FLAKEn (F)
!
@@ -115,81 +115,81 @@ SUBROUTINE UPDATE_NAM_FLAKEn (F)
IF (LHOOK) CALL DR_HOOK('MODN_FLAKE_N:UPDATE_NAM_FLAKEN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_FLAKEn
!
-SUBROUTINE INIT_NAM_DIAG_SURFn (DGF)
+SUBROUTINE INIT_NAM_DIAG_SURFn (DGO)
!
- USE MODD_DIAG_FLAKE_n, ONLY : DIAG_FLAKE_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(DIAG_FLAKE_t), INTENT(INOUT) :: DGF
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_FLAKE_N:INIT_NAM_DIAG_SURFN',0,ZHOOK_HANDLE)
- XDIAG_TSTEP = DGF%XDIAG_TSTEP
- N2M = DGF%N2M
- L2M_MIN_ZS = DGF%L2M_MIN_ZS
- LSURF_BUDGET = DGF%LSURF_BUDGET
- LRAD_BUDGET = DGF%LRAD_BUDGET
- LSURF_BUDGETC = DGF%LSURF_BUDGETC
- LRESET_BUDGETC = DGF%LRESET_BUDGETC
- LCOEF = DGF%LCOEF
- LSURF_VARS = DGF%LSURF_VARS
+ XDIAG_TSTEP = DGO%XDIAG_TSTEP
+ N2M = DGO%N2M
+ L2M_MIN_ZS = DGO%L2M_MIN_ZS
+ LSURF_BUDGET = DGO%LSURF_BUDGET
+ LRAD_BUDGET = DGO%LRAD_BUDGET
+ LSURF_BUDGETC = DGO%LSURF_BUDGETC
+ LRESET_BUDGETC = DGO%LRESET_BUDGETC
+ LCOEF = DGO%LCOEF
+ LSURF_VARS = DGO%LSURF_VARS
IF (LHOOK) CALL DR_HOOK('MODN_FLAKE_N:INIT_NAM_DIAG_SURFN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_DIAG_SURFn
-SUBROUTINE UPDATE_NAM_DIAG_SURFn (DGF)
+SUBROUTINE UPDATE_NAM_DIAG_SURFn (DGO)
!
- USE MODD_DIAG_FLAKE_n, ONLY : DIAG_FLAKE_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(DIAG_FLAKE_t), INTENT(INOUT) :: DGF
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_FLAKE_N:UPDATE_NAM_DIAG_SURFN',0,ZHOOK_HANDLE)
- DGF%XDIAG_TSTEP = XDIAG_TSTEP
- DGF%N2M = N2M
- DGF%L2M_MIN_ZS = L2M_MIN_ZS
- DGF%LSURF_BUDGET = LSURF_BUDGET
- DGF%LRAD_BUDGET = LRAD_BUDGET
- DGF%LSURF_BUDGETC = LSURF_BUDGETC
- DGF%LRESET_BUDGETC = LRESET_BUDGETC
- DGF%LCOEF = LCOEF
- DGF%LSURF_VARS = LSURF_VARS
+ DGO%XDIAG_TSTEP = XDIAG_TSTEP
+ DGO%N2M = N2M
+ DGO%L2M_MIN_ZS = L2M_MIN_ZS
+ DGO%LSURF_BUDGET = LSURF_BUDGET
+ DGO%LRAD_BUDGET = LRAD_BUDGET
+ DGO%LSURF_BUDGETC = LSURF_BUDGETC
+ DGO%LRESET_BUDGETC = LRESET_BUDGETC
+ DGO%LCOEF = LCOEF
+ DGO%LSURF_VARS = LSURF_VARS
IF (LHOOK) CALL DR_HOOK('MODN_FLAKE_N:UPDATE_NAM_DIAG_SURFN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_DIAG_SURFn
!
-SUBROUTINE INIT_NAM_DIAG_FLAKEn (DGMF)
+SUBROUTINE INIT_NAM_DIAG_FLAKEn (DMF)
!
USE MODD_DIAG_MISC_FLAKE_n, ONLY : DIAG_MISC_FLAKE_t
!
IMPLICIT NONE
!
- TYPE(DIAG_MISC_FLAKE_t), INTENT(INOUT) :: DGMF
+ TYPE(DIAG_MISC_FLAKE_t), INTENT(INOUT) :: DMF
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_FLAKE_N:INIT_NAM_DIAG_FLAKEN',0,ZHOOK_HANDLE)
- LWATER_PROFILE = DGMF%LWATER_PROFILE
- XZWAT_PROFILE = DGMF%XZWAT_PROFILE
+ LWATER_PROFILE = DMF%LWATER_PROFILE
+ XZWAT_PROFILE = DMF%XZWAT_PROFILE
IF (LHOOK) CALL DR_HOOK('MODN_FLAKE_N:INIT_NAM_DIAG_FLAKEN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_DIAG_FLAKEn
-SUBROUTINE UPDATE_NAM_DIAG_FLAKEn (DGMF)
+SUBROUTINE UPDATE_NAM_DIAG_FLAKEn (DMF)
!
USE MODD_DIAG_MISC_FLAKE_n, ONLY : DIAG_MISC_FLAKE_t
!
IMPLICIT NONE
!
- TYPE(DIAG_MISC_FLAKE_t), INTENT(INOUT) :: DGMF
+ TYPE(DIAG_MISC_FLAKE_t), INTENT(INOUT) :: DMF
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_FLAKE_N:UPDATE_NAM_DIAG_FLAKEN',0,ZHOOK_HANDLE)
- DGMF%LWATER_PROFILE = LWATER_PROFILE
- DGMF%XZWAT_PROFILE = XZWAT_PROFILE
+ DMF%LWATER_PROFILE = LWATER_PROFILE
+ DMF%XZWAT_PROFILE = XZWAT_PROFILE
IF (LHOOK) CALL DR_HOOK('MODN_FLAKE_N:UPDATE_NAM_DIAG_FLAKEN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_DIAG_FLAKEn
diff --git a/src/SURFEX/modn_idealn.F90 b/src/SURFEX/modn_idealn.F90
index 158fc289801bd44f2d441dfef7e8d2a705027724..2023d8c3e720967d9151b6e6d5494e8dc41a5d06 100644
--- a/src/SURFEX/modn_idealn.F90
+++ b/src/SURFEX/modn_idealn.F90
@@ -53,51 +53,51 @@ LOGICAL :: LSURF_VARS
NAMELIST/NAM_DIAG_SURFn/N2M,L2M_MIN_ZS,LSURF_BUDGET,LRAD_BUDGET, &
LSURF_BUDGETC,LRESET_BUDGETC,LCOEF,LSURF_VARS
!
- CONTAINS
+CONTAINS
!
-SUBROUTINE INIT_NAM_DIAG_SURFn (DGL)
+SUBROUTINE INIT_NAM_DIAG_SURFn (DGO)
!
- USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_IDEAL_N:INIT_NAM_DIAG_SURFN',0,ZHOOK_HANDLE)
- XDIAG_TSTEP = DGL%XDIAG_TSTEP
- N2M = DGL%N2M
- L2M_MIN_ZS = DGL%L2M_MIN_ZS
- LSURF_BUDGET = DGL%LSURF_BUDGET
- LRAD_BUDGET = DGL%LRAD_BUDGET
- LSURF_BUDGETC = DGL%LSURF_BUDGETC
- LRESET_BUDGETC = DGL%LRESET_BUDGETC
- LCOEF = DGL%LCOEF
- LSURF_VARS = DGL%LSURF_VARS
+ XDIAG_TSTEP = DGO%XDIAG_TSTEP
+ N2M = DGO%N2M
+ L2M_MIN_ZS = DGO%L2M_MIN_ZS
+ LSURF_BUDGET = DGO%LSURF_BUDGET
+ LRAD_BUDGET = DGO%LRAD_BUDGET
+ LSURF_BUDGETC = DGO%LSURF_BUDGETC
+ LRESET_BUDGETC = DGO%LRESET_BUDGETC
+ LCOEF = DGO%LCOEF
+ LSURF_VARS = DGO%LSURF_VARS
IF (LHOOK) CALL DR_HOOK('MODN_IDEAL_N:INIT_NAM_DIAG_SURFN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_DIAG_SURFn
-SUBROUTINE UPDATE_NAM_DIAG_SURFn (DGL)
+SUBROUTINE UPDATE_NAM_DIAG_SURFn (DGO)
!
- USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_IDEAL_N:UPDATE_NAM_DIAG_SURFN',0,ZHOOK_HANDLE)
- DGL%XDIAG_TSTEP = XDIAG_TSTEP
- DGL%N2M = N2M
- DGL%L2M_MIN_ZS = L2M_MIN_ZS
- DGL%LSURF_BUDGET = LSURF_BUDGET
- DGL%LRAD_BUDGET = LRAD_BUDGET
- DGL%LSURF_BUDGETC = LSURF_BUDGETC
- DGL%LRESET_BUDGETC = LRESET_BUDGETC
- DGL%LCOEF = LCOEF
- DGL%LSURF_VARS = LSURF_VARS
+ DGO%XDIAG_TSTEP = XDIAG_TSTEP
+ DGO%N2M = N2M
+ DGO%L2M_MIN_ZS = L2M_MIN_ZS
+ DGO%LSURF_BUDGET = LSURF_BUDGET
+ DGO%LRAD_BUDGET = LRAD_BUDGET
+ DGO%LSURF_BUDGETC = LSURF_BUDGETC
+ DGO%LRESET_BUDGETC = LRESET_BUDGETC
+ DGO%LCOEF = LCOEF
+ DGO%LSURF_VARS = LSURF_VARS
IF (LHOOK) CALL DR_HOOK('MODN_IDEAL_N:UPDATE_NAM_DIAG_SURFN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_DIAG_SURFn
!
diff --git a/src/SURFEX/modn_io_offline.F90 b/src/SURFEX/modn_io_offline.F90
index ba236be2a49dbf8ce508e486c8f62a215e9eb67e..fd5d2e456079b57bab908763e04e7a55ced3128c 100644
--- a/src/SURFEX/modn_io_offline.F90
+++ b/src/SURFEX/modn_io_offline.F90
@@ -56,7 +56,6 @@ IMPLICIT NONE
CHARACTER(LEN=6) :: CFORCING_FILETYPE = 'NETCDF' ! type of atmospheric FORCING files
! ! 'NETDF', 'BINARY', or 'ASCII '
!
-!
!* Names of files
! --------------
!
@@ -80,12 +79,15 @@ LOGICAL :: LOUT_TIMENAME = .FALSE.! change the name of output file at t
! (ex: 19860502_00h00 -> 19860501_24h00)
!
LOGICAL :: LDIAG_FA_NOCOMPACT = .FALSE. ! fa compaction for diagnostic files
+!
+ LOGICAL :: LALLOW_ADD_DIM = .FALSE. ! allow multi-dimensional output
+ ! if IO scheme can deal with- e.g. XIOS
!
!* Variables
! ---------
!
INTEGER :: NSCAL = 0 ! Number of scalar species
-INTEGER :: NHALO = 2
+INTEGER :: NHALO = 0
!
!* Time steps
! ----------
@@ -94,6 +96,11 @@ REAL :: XTSTEP_SURF = 300. ! time step of the surface
REAL :: XTSTEP_OUTPUT = 1800. ! time step of the output time-series
INTEGER :: NB_READ_FORC = 0 ! subdivisions of the reading of forcings
!
+!* Allow the simulation to start from a different time step than the first record of a netcdf file
+! ----------
+LOGICAL :: LDELAYEDSTART_NC = .FALSE.
+INTEGER,DIMENSION(4) :: NDATESTOP=(/0,0,0,0/) ! Year month day time (sec) to stop the simulation before the end of the netcdf forcing file
+!
!* General flag for coherence between forcing file orography and surface file orography
! ----------
!
@@ -122,6 +129,7 @@ LOGICAL :: LLAND_USE = .FALSE.
! ----------
!
LOGICAL :: LADAPT_SW = .FALSE.
+LOGICAL :: LINTERP_SW = .FALSE.
!
!* General flag to modify direct solar radiation due to slopes and shadows.
! ----------
@@ -129,13 +137,15 @@ LOGICAL :: LADAPT_SW = .FALSE.
LOGICAL :: LSHADOWS_SLOPE = .FALSE.
LOGICAL :: LSHADOWS_OTHER = .FALSE.
!
+LOGICAL :: LWR_VEGTYPE = .FALSE.
+!
! * For offline driver with openMP
INTEGER :: NPROMA ! Size of openMP packets
INTEGER :: NI,NJ ! Domain size
!
REAL :: XIO_FRAC = 1. ! fraction of ISIZE deduced to I/O
!
- CHARACTER(LEN=4) :: YALG_MPI = "LIN " ! type of distribution algorithm for MPI
+CHARACTER(LEN=4) :: YALG_MPI = "LIN " ! type of distribution algorithm for MPI
!
!-------------------------------------------------------------------------------
!
@@ -147,9 +157,10 @@ NAMELIST/NAM_IO_OFFLINE/CSURF_FILETYPE, CTIMESERIES_FILETYPE, CFORCING_FILETYPE,
LPRINT, LRESTART, LINQUIRE, NSCAL, NHALO, &
XTSTEP_SURF, XTSTEP_OUTPUT, LDIAG_FA_NOCOMPACT, &
LSET_FORC_ZS, LWRITE_COORD, LOUT_TIMENAME, LLIMIT_QAIR, &
- LSHADOWS_SLOPE,LSHADOWS_OTHER, &
+ LSHADOWS_SLOPE,LSHADOWS_OTHER, LWR_VEGTYPE, &
NB_READ_FORC, LLAND_USE, NPROMA, NI, NJ, XIO_FRAC, &
- YALG_MPI, XDELTA_OROG, LADAPT_SW
+ YALG_MPI, XDELTA_OROG, LADAPT_SW, LINTERP_SW, &
+ LALLOW_ADD_DIM, LDELAYEDSTART_NC, NDATESTOP
!
!-------------------------------------------------------------------------------
END MODULE MODN_IO_OFFLINE
diff --git a/src/SURFEX/modn_isban.F90 b/src/SURFEX/modn_isban.F90
index d580f7c0814d5bdb31c6ab5d56df50fdbccfff4f..e5fa3337079dcff3bf8ae1bbe2e16a80f2510332 100644
--- a/src/SURFEX/modn_isban.F90
+++ b/src/SURFEX/modn_isban.F90
@@ -42,19 +42,17 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
- CHARACTER(LEN=4) :: CC1DRY
- CHARACTER(LEN=4) :: CSCOND
- CHARACTER(LEN=3) :: CSOILFRZ
- CHARACTER(LEN=4) :: CDIFSFCOND
- CHARACTER(LEN=3) :: CSNOWRES
- CHARACTER(LEN=4) :: CALBEDO
- CHARACTER(LEN=4) :: CROUGH
- CHARACTER(LEN=3) :: CCPSURF
- CHARACTER(LEN=4) :: CRUNOFF
- CHARACTER(LEN=3) :: CKSAT
+CHARACTER(LEN=4) :: CC1DRY
+CHARACTER(LEN=4) :: CSCOND
+CHARACTER(LEN=3) :: CSOILFRZ
+CHARACTER(LEN=4) :: CDIFSFCOND
+CHARACTER(LEN=3) :: CSNOWRES
+CHARACTER(LEN=3) :: CCPSURF
+CHARACTER(LEN=4) :: CRUNOFF
+CHARACTER(LEN=3) :: CKSAT
LOGICAL :: LSOC
- CHARACTER(LEN=3) :: CRAIN
- CHARACTER(LEN=3) :: CHORT
+CHARACTER(LEN=3) :: CRAIN
+CHARACTER(LEN=3) :: CHORT
REAL :: XTSTEP
REAL :: XOUT_TSTEP
REAL :: XCGMAX
@@ -76,6 +74,8 @@ LOGICAL :: LSURF_MISC_BUDGET
LOGICAL :: LSURF_DIAG_ALBEDO
LOGICAL :: LSURF_MISC_DIF
LOGICAL :: LWATER_BUDGET
+LOGICAL :: LPROSNOW
+LOGICAL :: LVOLUMETRIC_SNOWLIQ
REAL :: XDIAG_TSTEP
REAL :: XALBICE1, XALBICE2,XALBICE3
REAL :: XRHOTHRESHOLD_ICE
@@ -103,12 +103,12 @@ LOGICAL :: LSNOW_ABS_ZENITH
CHARACTER(LEN=6) :: CCH_DRY_DEP
CHARACTER(LEN=28) :: CCHEM_SURF_FILE
!
-NAMELIST/NAM_ISBAn/CC1DRY,CSCOND,CSOILFRZ,CDIFSFCOND,CSNOWRES,CALBEDO,CROUGH,CCPSURF, &
+NAMELIST/NAM_ISBAn/CC1DRY,CSCOND,CSOILFRZ,CDIFSFCOND,CSNOWRES,CCPSURF, &
XTSTEP,XCGMAX,XCDRAG,LGLACIER,LCANOPY_DRAG,LVEGUPD,LPERTSURF
NAMELIST/NAM_ISBA_AGSn/LNITRO_DILU
NAMELIST/NAM_SGH_ISBAn/CRUNOFF,CKSAT,LSOC,CRAIN,CHORT
NAMELIST/NAM_DIAG_ISBAn/LPGD,LSURF_EVAP_BUDGET,LSURF_MISC_BUDGET,LSURF_DIAG_ALBEDO,LPATCH_BUDGET, &
- LSURF_MISC_DIF, LWATER_BUDGET
+ LSURF_MISC_DIF, LWATER_BUDGET, LPROSNOW, LVOLUMETRIC_SNOWLIQ
NAMELIST/NAM_DIAG_SURFn/N2M,L2M_MIN_ZS,LSURF_BUDGET,LRAD_BUDGET, &
LSURF_BUDGETC,LRESET_BUDGETC,LCOEF,LSURF_VARS
NAMELIST/NAM_CH_CONTROLn/CCHEM_SURF_FILE
@@ -117,233 +117,231 @@ NAMELIST/NAM_SPINUP_CARBn/LSPINUPCARBS,LSPINUPCARBW,XSPINMAXS,XSPINMAXW,NNBYEARS
NNBYEARSPINW, XCO2_START, XCO2_END
NAMELIST/NAM_ISBA_SNOWn/LSNOWDRIFT,LSNOWDRIFT_SUBLIM, LSNOW_ABS_ZENITH, CSNOWMETAMO, CSNOWRAD
!
- CONTAINS
+CONTAINS
!
-SUBROUTINE INIT_NAM_ISBAn (I)
+SUBROUTINE INIT_NAM_ISBAn (IO)
!
- USE MODD_ISBA_n, ONLY : ISBA_t
+ USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(ISBA_t), INTENT(INOUT) :: I
+ TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:INIT_NAM_ISBAN',0,ZHOOK_HANDLE)
- CC1DRY = I%CC1DRY
- CSCOND = I%CSCOND
- CSOILFRZ = I%CSOILFRZ
- CDIFSFCOND = I%CDIFSFCOND
- CSNOWRES = I%CSNOWRES
- CALBEDO = I%CALBEDO
- CROUGH = I%CROUGH
- CCPSURF = I%CCPSURF
- XTSTEP = I%XTSTEP
- XOUT_TSTEP = I%XOUT_TSTEP
- XCGMAX = I%XCGMAX
- XCDRAG = I%XCDRAG
- LGLACIER = I%LGLACIER
- LVEGUPD = I%LVEGUPD
- LCANOPY_DRAG = I%LCANOPY_DRAG
- LPERTSURF = I%LPERTSURF
+ CC1DRY = IO%CC1DRY
+ CSCOND = IO%CSCOND
+ CSOILFRZ = IO%CSOILFRZ
+ CDIFSFCOND = IO%CDIFSFCOND
+ CSNOWRES = IO%CSNOWRES
+ CCPSURF = IO%CCPSURF
+ XTSTEP = IO%XTSTEP
+ XOUT_TSTEP = IO%XOUT_TSTEP
+ XCGMAX = IO%XCGMAX
+ XCDRAG = IO%XCDRAG
+ LGLACIER = IO%LGLACIER
+ LVEGUPD = IO%LVEGUPD
+ LCANOPY_DRAG = IO%LCANOPY_DRAG
+ LPERTSURF = IO%LPERTSURF
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:INIT_NAM_ISBAN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_ISBAn
-SUBROUTINE INIT_NAM_ISBA_AGSn (I)
+SUBROUTINE INIT_NAM_ISBA_AGSn (IO)
!
- USE MODD_ISBA_n, ONLY : ISBA_t
+ USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(ISBA_t), INTENT(INOUT) :: I
+ TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:INIT_NAM_ISBA_AGSN',0,ZHOOK_HANDLE)
- LNITRO_DILU = I%LNITRO_DILU
+ LNITRO_DILU = IO%LNITRO_DILU
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:INIT_NAM_ISBA_AGSN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_ISBA_AGSn
-SUBROUTINE INIT_NAM_SGH_ISBAn (I)
+SUBROUTINE INIT_NAM_SGH_ISBAn (IO)
!
- USE MODD_ISBA_n, ONLY : ISBA_t
+ USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(ISBA_t), INTENT(INOUT) :: I
+ TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:INIT_NAM_SGH_ISBAN',0,ZHOOK_HANDLE)
- CRUNOFF = I%CRUNOFF
- CKSAT=I%CKSAT
- LSOC=I%LSOC
- CRAIN=I%CRAIN
- CHORT=I%CHORT
+ CRUNOFF = IO%CRUNOFF
+ CKSAT=IO%CKSAT
+ LSOC=IO%LSOC
+ CRAIN=IO%CRAIN
+ CHORT=IO%CHORT
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:INIT_NAM_SGH_ISBAN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_SGH_ISBAn
-SUBROUTINE UPDATE_NAM_ISBAn (I)
+SUBROUTINE UPDATE_NAM_ISBAn (IO)
!
- USE MODD_ISBA_n, ONLY : ISBA_t
+ USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(ISBA_t), INTENT(INOUT) :: I
+ TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:UPDATE_NAM_ISBAN',0,ZHOOK_HANDLE)
- I%CC1DRY = CC1DRY
- I%CSCOND = CSCOND
- I%CSOILFRZ = CSOILFRZ
- I%CDIFSFCOND = CDIFSFCOND
- I%CSNOWRES = CSNOWRES
- I%CALBEDO = CALBEDO
- I%CROUGH = CROUGH
- I%CCPSURF = CCPSURF
- I%XTSTEP = XTSTEP
- I%XOUT_TSTEP = XOUT_TSTEP
- I%XCGMAX = XCGMAX
- I%XCDRAG = XCDRAG
- I%LGLACIER = LGLACIER
- I%LVEGUPD = LVEGUPD
- I%LCANOPY_DRAG = LCANOPY_DRAG
- I%LPERTSURF = LPERTSURF
+ IO%CC1DRY = CC1DRY
+ IO%CSCOND = CSCOND
+ IO%CSOILFRZ = CSOILFRZ
+ IO%CDIFSFCOND = CDIFSFCOND
+ IO%CSNOWRES = CSNOWRES
+ IO%CCPSURF = CCPSURF
+ IO%XTSTEP = XTSTEP
+ IO%XOUT_TSTEP = XOUT_TSTEP
+ IO%XCGMAX = XCGMAX
+ IO%XCDRAG = XCDRAG
+ IO%LGLACIER = LGLACIER
+ IO%LVEGUPD = LVEGUPD
+ IO%LCANOPY_DRAG = LCANOPY_DRAG
+ IO%LPERTSURF = LPERTSURF
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:UPDATE_NAM_ISBAN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_ISBAn
-SUBROUTINE UPDATE_NAM_ISBA_AGSn (I)
+SUBROUTINE UPDATE_NAM_ISBA_AGSn (IO)
!
- USE MODD_ISBA_n, ONLY : ISBA_t
+ USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(ISBA_t), INTENT(INOUT) :: I
+ TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:UPDATE_NAM_ISBA_AGSN',0,ZHOOK_HANDLE)
- I%LNITRO_DILU = LNITRO_DILU
+ IO%LNITRO_DILU = LNITRO_DILU
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:UPDATE_NAM_ISBA_AGSN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_ISBA_AGSn
-SUBROUTINE UPDATE_NAM_SGH_ISBAn (I)
+SUBROUTINE UPDATE_NAM_SGH_ISBAn (IO)
!
- USE MODD_ISBA_n, ONLY : ISBA_t
+ USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(ISBA_t), INTENT(INOUT) :: I
+ TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:UPDATE_NAM_SGH_ISBAN',0,ZHOOK_HANDLE)
- I%CRUNOFF=CRUNOFF
- I%CKSAT=CKSAT
- I%LSOC=LSOC
- I%CRAIN=CRAIN
- I%CHORT=CHORT
+ IO%CRUNOFF=CRUNOFF
+ IO%CKSAT=CKSAT
+ IO%LSOC=LSOC
+ IO%CRAIN=CRAIN
+ IO%CHORT=CHORT
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:UPDATE_NAM_SGH_ISBAN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_SGH_ISBAn
-SUBROUTINE INIT_NAM_DIAG_ISBAn (DGEI, DGI, DGMI)
+SUBROUTINE INIT_NAM_DIAG_ISBAn (DE, DGO, DMI)
!
USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
- USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
!
IMPLICIT NONE
!
- TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DGEI
- TYPE(DIAG_ISBA_t), INTENT(INOUT) :: DGI
- TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DGMI
+ TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DE
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+ TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:INIT_NAM_DIAG_ISBAN',0,ZHOOK_HANDLE)
- LPGD = DGI%LPGD
- LSURF_EVAP_BUDGET = DGEI%LSURF_EVAP_BUDGET
- LWATER_BUDGET = DGEI%LWATER_BUDGET
- LSURF_MISC_BUDGET = DGMI%LSURF_MISC_BUDGET
- LSURF_DIAG_ALBEDO = DGMI%LSURF_DIAG_ALBEDO
- LSURF_MISC_DIF = DGMI%LSURF_MISC_DIF
- LPATCH_BUDGET = DGI%LPATCH_BUDGET
+ LPGD = DGO%LPGD
+ LSURF_EVAP_BUDGET = DE%LSURF_EVAP_BUDGET
+ LWATER_BUDGET = DE%LWATER_BUDGET
+ LSURF_MISC_BUDGET = DMI%LSURF_MISC_BUDGET
+ LSURF_DIAG_ALBEDO = DMI%LSURF_DIAG_ALBEDO
+ LSURF_MISC_DIF = DMI%LSURF_MISC_DIF
+ LPATCH_BUDGET = DGO%LPATCH_BUDGET
+ LPROSNOW = DMI%LPROSNOW
+ LVOLUMETRIC_SNOWLIQ = DMI%LPROSNOW
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:INIT_NAM_DIAG_ISBAN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_DIAG_ISBAn
-SUBROUTINE UPDATE_NAM_DIAG_ISBAn (DGEI, DGI, DGMI)
+SUBROUTINE UPDATE_NAM_DIAG_ISBAn (DE, DGO, DMI)
!
USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
- USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
!
IMPLICIT NONE
!
- TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DGEI
- TYPE(DIAG_ISBA_t), INTENT(INOUT) :: DGI
- TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DGMI
+ TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DE
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+ TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:UPDATE_NAM_DIAG_ISBAN',0,ZHOOK_HANDLE)
- DGI%LPGD = LPGD
- DGEI%LSURF_EVAP_BUDGET = LSURF_EVAP_BUDGET
- DGEI%LWATER_BUDGET = LWATER_BUDGET
- DGMI%LSURF_MISC_BUDGET = LSURF_MISC_BUDGET
- DGMI%LSURF_DIAG_ALBEDO = LSURF_DIAG_ALBEDO
- DGMI%LSURF_MISC_DIF = LSURF_MISC_DIF
- DGI%LPATCH_BUDGET = LPATCH_BUDGET
+ DGO%LPGD = LPGD
+ DE%LSURF_EVAP_BUDGET = LSURF_EVAP_BUDGET
+ DE%LWATER_BUDGET = LWATER_BUDGET
+ DMI%LSURF_MISC_BUDGET = LSURF_MISC_BUDGET
+ DMI%LSURF_DIAG_ALBEDO = LSURF_DIAG_ALBEDO
+ DMI%LSURF_MISC_DIF = LSURF_MISC_DIF
+ DGO%LPATCH_BUDGET = LPATCH_BUDGET
+ DMI%LPROSNOW = LPROSNOW
+ DMI%LVOLUMETRIC_SNOWLIQ = LVOLUMETRIC_SNOWLIQ
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:UPDATE_NAM_DIAG_ISBAN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_DIAG_ISBAn
-SUBROUTINE INIT_NAM_DIAG_SURFn (DGEI, DGI)
+SUBROUTINE INIT_NAM_DIAG_SURFn (DGO)
!
USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
- USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DGEI
- TYPE(DIAG_ISBA_t), INTENT(INOUT) :: DGI
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:INIT_NAM_DIAG_SURFN',0,ZHOOK_HANDLE)
- XDIAG_TSTEP = DGI%XDIAG_TSTEP
- N2M = DGI%N2M
- L2M_MIN_ZS = DGI%L2M_MIN_ZS
- LSURF_BUDGET = DGI%LSURF_BUDGET
- LRAD_BUDGET = DGI%LRAD_BUDGET
- LSURF_BUDGETC = DGEI%LSURF_BUDGETC
- LRESET_BUDGETC = DGEI%LRESET_BUDGETC
- LCOEF = DGI%LCOEF
- LSURF_VARS = DGI%LSURF_VARS
+ XDIAG_TSTEP = DGO%XDIAG_TSTEP
+ N2M = DGO%N2M
+ L2M_MIN_ZS = DGO%L2M_MIN_ZS
+ LSURF_BUDGET = DGO%LSURF_BUDGET
+ LRAD_BUDGET = DGO%LRAD_BUDGET
+ LSURF_BUDGETC = DGO%LSURF_BUDGETC
+ LRESET_BUDGETC = DGO%LRESET_BUDGETC
+ LCOEF = DGO%LCOEF
+ LSURF_VARS = DGO%LSURF_VARS
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:INIT_NAM_DIAG_SURFN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_DIAG_SURFn
-SUBROUTINE UPDATE_NAM_DIAG_SURFn (DGEI, DGI)
+SUBROUTINE UPDATE_NAM_DIAG_SURFn (DGO)
!
USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
- USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DGEI
- TYPE(DIAG_ISBA_t), INTENT(INOUT) :: DGI
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:UPDATE_NAM_DIAG_SURFN',0,ZHOOK_HANDLE)
- DGI%XDIAG_TSTEP = XDIAG_TSTEP
- DGI%N2M = N2M
- DGI%L2M_MIN_ZS = L2M_MIN_ZS
- DGI%LSURF_BUDGET = LSURF_BUDGET
- DGI%LRAD_BUDGET = LRAD_BUDGET
- DGEI%LSURF_BUDGETC = LSURF_BUDGETC
- DGEI%LRESET_BUDGETC = LRESET_BUDGETC
- DGI%LCOEF = LCOEF
- DGI%LSURF_VARS = LSURF_VARS
+ DGO%XDIAG_TSTEP = XDIAG_TSTEP
+ DGO%N2M = N2M
+ DGO%L2M_MIN_ZS = L2M_MIN_ZS
+ DGO%LSURF_BUDGET = LSURF_BUDGET
+ DGO%LRAD_BUDGET = LRAD_BUDGET
+ DGO%LSURF_BUDGETC = LSURF_BUDGETC
+ DGO%LRESET_BUDGETC = LRESET_BUDGETC
+ DGO%LCOEF = LCOEF
+ DGO%LSURF_VARS = LSURF_VARS
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:UPDATE_NAM_DIAG_SURFN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_DIAG_SURFn
@@ -411,86 +409,86 @@ SUBROUTINE UPDATE_NAM_CH_ISBAn (CHI)
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:UPDATE_NAM_CH_ISBAN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_CH_ISBAn
-SUBROUTINE INIT_NAM_SPINUP_CARB_ISBAn (I)
+SUBROUTINE INIT_NAM_SPINUP_CARB_ISBAn (IO)
!
- USE MODD_ISBA_n, ONLY : ISBA_t
+ USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(ISBA_t), INTENT(INOUT) :: I
+ TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:INIT_NAM_SPINUP_CARB_ISBAN',0,ZHOOK_HANDLE)
- LSPINUPCARBS = I%LSPINUPCARBS
- LSPINUPCARBW = I%LSPINUPCARBW
- XSPINMAXS = I%XSPINMAXS
- XSPINMAXW = I%XSPINMAXW
- NNBYEARSPINS = I%NNBYEARSPINS
- NNBYEARSPINW = I%NNBYEARSPINW
- XCO2_START = I%XCO2_START
- XCO2_END = I%XCO2_END
+ LSPINUPCARBS = IO%LSPINUPCARBS
+ LSPINUPCARBW = IO%LSPINUPCARBW
+ XSPINMAXS = IO%XSPINMAXS
+ XSPINMAXW = IO%XSPINMAXW
+ NNBYEARSPINS = IO%NNBYEARSPINS
+ NNBYEARSPINW = IO%NNBYEARSPINW
+ XCO2_START = IO%XCO2_START
+ XCO2_END = IO%XCO2_END
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:INIT_NAM_SPINUP_CARB_ISBAN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_SPINUP_CARB_ISBAn
-SUBROUTINE UPDATE_NAM_SPINUP_CARB_ISBAn (I)
+SUBROUTINE UPDATE_NAM_SPINUP_CARB_ISBAn (IO)
!
- USE MODD_ISBA_n, ONLY : ISBA_t
+ USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(ISBA_t), INTENT(INOUT) :: I
+ TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:UPDATE_NAM_SPINUP_CARB_ISBAN',0,ZHOOK_HANDLE)
- I%LSPINUPCARBS = LSPINUPCARBS
- I%LSPINUPCARBW = LSPINUPCARBW
- I%XSPINMAXS = XSPINMAXS
- I%XSPINMAXW = XSPINMAXW
- I%NNBYEARSPINS = NNBYEARSPINS
- I%NNBYEARSPINW = NNBYEARSPINW
- I%XCO2_START = XCO2_START
- I%XCO2_END = XCO2_END
+ IO%LSPINUPCARBS = LSPINUPCARBS
+ IO%LSPINUPCARBW = LSPINUPCARBW
+ IO%XSPINMAXS = XSPINMAXS
+ IO%XSPINMAXW = XSPINMAXW
+ IO%NNBYEARSPINS = NNBYEARSPINS
+ IO%NNBYEARSPINW = NNBYEARSPINW
+ IO%XCO2_START = XCO2_START
+ IO%XCO2_END = XCO2_END
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:UPDATE_NAM_SPINUP_CARB_ISBAN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_SPINUP_CARB_ISBAn
-SUBROUTINE INIT_NAM_ISBA_SNOWn (I)
+SUBROUTINE INIT_NAM_ISBA_SNOWn (IO)
!
- USE MODD_ISBA_n, ONLY : ISBA_t
+ USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(ISBA_t), INTENT(INOUT) :: I
+ TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:INIT_NAM_ISBA_SNOWn',0,ZHOOK_HANDLE)
- LSNOWDRIFT = I%LSNOWDRIFT
- LSNOWDRIFT_SUBLIM = I%LSNOWDRIFT_SUBLIM
- LSNOW_ABS_ZENITH = I%LSNOW_ABS_ZENITH
- CSNOWMETAMO = I%CSNOWMETAMO
- CSNOWRAD = I%CSNOWRAD
+ LSNOWDRIFT = IO%LSNOWDRIFT
+ LSNOWDRIFT_SUBLIM = IO%LSNOWDRIFT_SUBLIM
+ LSNOW_ABS_ZENITH = IO%LSNOW_ABS_ZENITH
+ CSNOWMETAMO = IO%CSNOWMETAMO
+ CSNOWRAD = IO%CSNOWRAD
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:INIT_NAM_ISBA_SNOWn',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_ISBA_SNOWn
-SUBROUTINE UPDATE_NAM_ISBA_SNOWn (I)
+SUBROUTINE UPDATE_NAM_ISBA_SNOWn (IO)
!
- USE MODD_ISBA_n, ONLY : ISBA_t
+ USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(ISBA_t), INTENT(INOUT) :: I
+ TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:INIT_NAM_ISBA_SNOWn',0,ZHOOK_HANDLE)
- I%LSNOWDRIFT = LSNOWDRIFT
- I%LSNOWDRIFT_SUBLIM = LSNOWDRIFT_SUBLIM
- I%LSNOW_ABS_ZENITH = LSNOW_ABS_ZENITH
- I%CSNOWMETAMO = CSNOWMETAMO
- I%CSNOWRAD=CSNOWRAD
+ IO%LSNOWDRIFT = LSNOWDRIFT
+ IO%LSNOWDRIFT_SUBLIM = LSNOWDRIFT_SUBLIM
+ IO%LSNOW_ABS_ZENITH = LSNOW_ABS_ZENITH
+ IO%CSNOWMETAMO = CSNOWMETAMO
+ IO%CSNOWRAD=CSNOWRAD
IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:INIT_NAM_ISBA_SNOWn',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_ISBA_SNOWn
diff --git a/src/SURFEX/modn_prep_isba_snow.F90 b/src/SURFEX/modn_prep_isba_snow.F90
index 789cf95cddadc2e4c2f8b44e272ab13c257c25fb..252d3508abd8ff0439b4ea7d82caa43c5fafdd1b 100644
--- a/src/SURFEX/modn_prep_isba_snow.F90
+++ b/src/SURFEX/modn_prep_isba_snow.F90
@@ -34,7 +34,7 @@
!
IMPLICIT NONE
!
- CHARACTER(LEN=3) :: CSNOW ! snow scheme
+CHARACTER(LEN=3) :: CSNOW ! snow scheme
INTEGER :: NSNOW_LAYER ! number of snow layers
LOGICAL :: LSWEMAX ! logical switch to set an upper limit on initial snow water equivalent
REAL :: XSWEMAX ! upper limit of initial snow water equivalent
diff --git a/src/SURFEX/modn_prep_seaflux.F90 b/src/SURFEX/modn_prep_seaflux.F90
index 8318f8f23138e03f8ef39a7fa33f54b7aa70849e..362549929926f65aed33e98fcb6a242a5d1e5333 100644
--- a/src/SURFEX/modn_prep_seaflux.F90
+++ b/src/SURFEX/modn_prep_seaflux.F90
@@ -46,7 +46,7 @@ INTEGER :: NMONTH ! MONTH for surface
INTEGER :: NDAY ! DAY for surface
REAL :: XTIME ! TIME for surface
LOGICAL :: LSEA_SBL ! flag to use air layers inside the SBL
- CHARACTER(LEN=6) :: CSEAICE_SCHEME ! name of the seaice scheme
+CHARACTER(LEN=6) :: CSEAICE_SCHEME ! name of the seaice scheme
LOGICAL :: LOCEAN_MERCATOR ! oceanic variables initialized from
! MERCATOR if true
LOGICAL :: LOCEAN_CURRENT ! initial ocean state with current
diff --git a/src/SURFEX/modn_prep_surf_atm.F90 b/src/SURFEX/modn_prep_surf_atm.F90
index 10f24718ed3f33b1977fc9f56263fe7ddecd6e44..fc75c3327db63cdc10f98f7f31d7310619a884fa 100644
--- a/src/SURFEX/modn_prep_surf_atm.F90
+++ b/src/SURFEX/modn_prep_surf_atm.F90
@@ -43,10 +43,10 @@ INTEGER :: NYEAR ! YEAR for surface
INTEGER :: NMONTH ! MONTH for surface
INTEGER :: NDAY ! DAY for surface
REAL :: XTIME ! TIME for surface
-
+LOGICAL :: LWRITE_EXTERN
!
NAMELIST/NAM_PREP_SURF_ATM/CFILE, CFILETYPE, CFILEPGD, CFILEPGDTYPE, NHALO_PREP, &
- NYEAR, NMONTH, NDAY, XTIME
+ NYEAR, NMONTH, NDAY, XTIME, LWRITE_EXTERN
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/modn_seafluxn.F90 b/src/SURFEX/modn_seafluxn.F90
index 1415a740973ded7e1daa03ee09e598997ca5c1bf..43fa0d24616fd63247b0b4ddd2d26bbd84f4307b 100644
--- a/src/SURFEX/modn_seafluxn.F90
+++ b/src/SURFEX/modn_seafluxn.F90
@@ -61,19 +61,19 @@ LOGICAL :: LPWG
LOGICAL :: LPRECIP
LOGICAL :: LPWEBB
LOGICAL :: LDIAG_OCEAN
-LOGICAL :: LDIAG_SEAICE
+LOGICAL :: LDIAG_MISC_SEAICE
INTEGER :: NZ0
INTEGER :: NGRVWAVES
REAL :: XICHCE
- CHARACTER(LEN=6) :: CCH_DRY_DEP
+CHARACTER(LEN=6) :: CCH_DRY_DEP
LOGICAL :: LPROGSST
LOGICAL :: LPERTFLUX ! True = stochastic flux perturbation (default:False)
INTEGER :: NTIME_COUPLING
REAL :: XOCEAN_TSTEP
- CHARACTER(LEN=6) :: CINTERPOL_SST
- CHARACTER(LEN=6) :: CINTERPOL_SSS
- CHARACTER(LEN=6) :: CINTERPOL_SIC
- CHARACTER(LEN=6) :: CINTERPOL_SIT
+CHARACTER(LEN=6) :: CINTERPOL_SST
+CHARACTER(LEN=6) :: CINTERPOL_SSS
+CHARACTER(LEN=6) :: CINTERPOL_SIC
+CHARACTER(LEN=6) :: CINTERPOL_SIT
REAL :: XFREEZING_SST
REAL :: XSIC_EFOLDING_TIME
REAL :: XSIT_EFOLDING_TIME
@@ -88,11 +88,11 @@ NAMELIST/NAM_DIAG_SURFn/N2M,L2M_MIN_ZS,LSURF_BUDGET,LRAD_BUDGET, &
LSURF_BUDGETC,LRESET_BUDGETC,LCOEF,LSURF_VARS
NAMELIST/NAM_CH_SEAFLUXn/CCH_DRY_DEP
NAMELIST/NAM_DIAG_OCEANn/LDIAG_OCEAN
-NAMELIST/NAM_SEAICEn/LDIAG_SEAICE, CINTERPOL_SIC, CINTERPOL_SIT, &
+NAMELIST/NAM_SEAICEn/LDIAG_MISC_SEAICE, CINTERPOL_SIC, CINTERPOL_SIT, &
XFREEZING_SST, XSIC_EFOLDING_TIME, XSIT_EFOLDING_TIME,&
XSEAICE_TSTEP, XCD_ICE_CST, XSI_FLX_DRV
!
- CONTAINS
+CONTAINS
!
SUBROUTINE INIT_NAM_SEAFLUXn (O, S)
!
@@ -158,49 +158,49 @@ SUBROUTINE UPDATE_NAM_SEAFLUXn (O, S)
IF (LHOOK) CALL DR_HOOK('MODN_SEAFLUX_N:UPDATE_NAM_SEAFLUXN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_SEAFLUXn
!
-SUBROUTINE INIT_NAM_DIAG_SURFn (DGS)
+SUBROUTINE INIT_NAM_DIAG_SURFn (DGO)
!
- USE MODD_DIAG_SEAFLUX_n, ONLY : DIAG_SEAFLUX_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(DIAG_SEAFLUX_t), INTENT(INOUT) :: DGS
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_SEAFLUX_N:INIT_NAM_DIAG_SURFN',0,ZHOOK_HANDLE)
- XDIAG_TSTEP = DGS%XDIAG_TSTEP
- N2M = DGS%N2M
- L2M_MIN_ZS = DGS%L2M_MIN_ZS
- LSURF_BUDGET = DGS%LSURF_BUDGET
- LRAD_BUDGET = DGS%LRAD_BUDGET
- LSURF_BUDGETC = DGS%LSURF_BUDGETC
- LRESET_BUDGETC = DGS%LRESET_BUDGETC
- LCOEF = DGS%LCOEF
- LSURF_VARS = DGS%LSURF_VARS
+ XDIAG_TSTEP = DGO%XDIAG_TSTEP
+ N2M = DGO%N2M
+ L2M_MIN_ZS = DGO%L2M_MIN_ZS
+ LSURF_BUDGET = DGO%LSURF_BUDGET
+ LRAD_BUDGET = DGO%LRAD_BUDGET
+ LSURF_BUDGETC = DGO%LSURF_BUDGETC
+ LRESET_BUDGETC = DGO%LRESET_BUDGETC
+ LCOEF = DGO%LCOEF
+ LSURF_VARS = DGO%LSURF_VARS
IF (LHOOK) CALL DR_HOOK('MODN_SEAFLUX_N:INIT_NAM_DIAG_SURFN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_DIAG_SURFn
-SUBROUTINE UPDATE_NAM_DIAG_SURFn (DGS)
+SUBROUTINE UPDATE_NAM_DIAG_SURFn (DGO)
!
- USE MODD_DIAG_SEAFLUX_n, ONLY : DIAG_SEAFLUX_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(DIAG_SEAFLUX_t), INTENT(INOUT) :: DGS
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_SEAFLUX_N:UPDATE_NAM_DIAG_SURFN',0,ZHOOK_HANDLE)
- DGS%XDIAG_TSTEP = XDIAG_TSTEP
- DGS%N2M = N2M
- DGS%L2M_MIN_ZS = L2M_MIN_ZS
- DGS%LSURF_BUDGET = LSURF_BUDGET
- DGS%LRAD_BUDGET = LRAD_BUDGET
- DGS%LSURF_BUDGETC = LSURF_BUDGETC
- DGS%LRESET_BUDGETC = LRESET_BUDGETC
- DGS%LCOEF = LCOEF
- DGS%LSURF_VARS = LSURF_VARS
+ DGO%XDIAG_TSTEP = XDIAG_TSTEP
+ DGO%N2M = N2M
+ DGO%L2M_MIN_ZS = L2M_MIN_ZS
+ DGO%LSURF_BUDGET = LSURF_BUDGET
+ DGO%LRAD_BUDGET = LRAD_BUDGET
+ DGO%LSURF_BUDGETC = LSURF_BUDGETC
+ DGO%LRESET_BUDGETC = LRESET_BUDGETC
+ DGO%LCOEF = LCOEF
+ DGO%LSURF_VARS = LSURF_VARS
IF (LHOOK) CALL DR_HOOK('MODN_SEAFLUX_N:UPDATE_NAM_DIAG_SURFN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_DIAG_SURFn
!
@@ -264,20 +264,20 @@ SUBROUTINE UPDATE_NAM_DIAG_OCEANn (DGO)
IF (LHOOK) CALL DR_HOOK('MODN_SEAFLUX_N:UPDATE_NAM_DIAG_OCEANN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_DIAG_OCEANn
-SUBROUTINE INIT_NAM_SEAICEn (DGSI, S)
+SUBROUTINE INIT_NAM_SEAICEn (DGMSI, S)
!
- USE MODD_DIAG_SEAICE_n, ONLY : DIAG_SEAICE_t
+ USE MODD_DIAG_MISC_SEAICE_n, ONLY : DIAG_MISC_SEAICE_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
!
IMPLICIT NONE
!
- TYPE(DIAG_SEAICE_t), INTENT(INOUT) :: DGSI
+ TYPE(DIAG_MISC_SEAICE_t), INTENT(INOUT) :: DGMSI
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_SEAFLUX_N:INIT_NAM_SEAICEN',0,ZHOOK_HANDLE)
- LDIAG_SEAICE = DGSI%LDIAG_SEAICE
+ LDIAG_MISC_SEAICE = DGMSI%LDIAG_MISC_SEAICE
CINTERPOL_SIC = S%CINTERPOL_SIC
CINTERPOL_SIT = S%CINTERPOL_SIT
XSIC_EFOLDING_TIME=S%XSIC_EFOLDING_TIME
@@ -289,20 +289,19 @@ SUBROUTINE INIT_NAM_SEAICEn (DGSI, S)
IF (LHOOK) CALL DR_HOOK('MODN_SEAFLUX_N:INIT_NAM_SEAICEN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_SEAICEn
-SUBROUTINE UPDATE_NAM_SEAICEn (DGSI, S)
+SUBROUTINE UPDATE_NAM_SEAICEn (DGMSI, S)
!
- USE MODD_DIAG_SEAICE_n, ONLY : DIAG_SEAICE_t
+ USE MODD_DIAG_MISC_SEAICE_n, ONLY : DIAG_MISC_SEAICE_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
!
IMPLICIT NONE
-
!
- TYPE(DIAG_SEAICE_t), INTENT(INOUT) :: DGSI
+ TYPE(DIAG_MISC_SEAICE_t), INTENT(INOUT) :: DGMSI
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_SEAFLUX_N:UPDATE_NAM_SEAICEN',0,ZHOOK_HANDLE)
- DGSI%LDIAG_SEAICE = LDIAG_SEAICE
+ DGMSI%LDIAG_MISC_SEAICE = LDIAG_MISC_SEAICE
S%CINTERPOL_SIC = CINTERPOL_SIC
S%CINTERPOL_SIT = CINTERPOL_SIT
S%XSIC_EFOLDING_TIME = XSIC_EFOLDING_TIME
diff --git a/src/SURFEX/modn_sfx_oasis.F90 b/src/SURFEX/modn_sfx_oasis.F90
index b6f1919ed0caa5248f0d97b4543202ce83569125..017fd42f26c424c78a93ccf3e7ea43d3a58e452a 100644
--- a/src/SURFEX/modn_sfx_oasis.F90
+++ b/src/SURFEX/modn_sfx_oasis.F90
@@ -26,6 +26,7 @@ MODULE MODN_SFX_OASIS
!! MODIFICATIONS
!! -------------
!! Original 10/13
+!! 10/2016 B. Decharme : bug surface/groundwater coupling
!
!* 0. DECLARATIONS
! ------------
@@ -45,18 +46,19 @@ REAL :: XTSTEP_CPL_LAKE = -1.0 ! Coupling time step for lake
!
! Output variables
!
- CHARACTER(LEN=8) :: CRUNOFF = ' ' ! Surface runoff
- CHARACTER(LEN=8) :: CDRAIN = ' ' ! Deep drainage
- CHARACTER(LEN=8) :: CCALVING = ' ' ! Calving flux
- CHARACTER(LEN=8) :: CRECHARGE = ' ' ! groundwater recharge
- CHARACTER(LEN=8) :: CSRCFLOOD = ' ' ! Floodplains freshwater flux
+CHARACTER(LEN=8) :: CRUNOFF = ' ' ! Surface runoff
+CHARACTER(LEN=8) :: CDRAIN = ' ' ! Deep drainage
+CHARACTER(LEN=8) :: CCALVING = ' ' ! Calving flux
+CHARACTER(LEN=8) :: CSRCFLOOD = ' ' ! Floodplains freshwater flux
!
! Input variables
!
- CHARACTER(LEN=8) :: CWTD = ' ' ! water table depth
- CHARACTER(LEN=8) :: CFWTD = ' ' ! grid-cell fraction of water table rise
- CHARACTER(LEN=8) :: CFFLOOD = ' ' ! Floodplains fraction
- CHARACTER(LEN=8) :: CPIFLOOD = ' ' ! Flood potential infiltartion
+CHARACTER(LEN=8) :: CWTD = ' ' ! water table depth
+CHARACTER(LEN=8) :: CFWTD = ' ' ! grid-cell fraction of water table rise
+CHARACTER(LEN=8) :: CFFLOOD = ' ' ! Floodplains fraction
+CHARACTER(LEN=8) :: CPIFLOOD = ' ' ! Flood potential infiltartion
+!
+REAL :: XFLOOD_LIM = 0.01
!
!-------------------------------------------------------------------------------
!
@@ -66,10 +68,10 @@ REAL :: XTSTEP_CPL_LAKE = -1.0 ! Coupling time step for lake
!
! Input variables
!
- CHARACTER(LEN=8) :: CLAKE_EVAP = ' ' ! Evaporation over lake area
- CHARACTER(LEN=8) :: CLAKE_RAIN = ' ' ! Rainfall over lake area
- CHARACTER(LEN=8) :: CLAKE_SNOW = ' ' ! Snowfall over lake area
- CHARACTER(LEN=8) :: CLAKE_WATF = ' ' ! Net freshwater flux
+CHARACTER(LEN=8) :: CLAKE_EVAP = ' ' ! Evaporation over lake area
+CHARACTER(LEN=8) :: CLAKE_RAIN = ' ' ! Rainfall over lake area
+CHARACTER(LEN=8) :: CLAKE_SNOW = ' ' ! Snowfall over lake area
+CHARACTER(LEN=8) :: CLAKE_WATF = ' ' ! Net freshwater flux
!
!-------------------------------------------------------------------------------
!
@@ -79,34 +81,34 @@ REAL :: XTSTEP_CPL_LAKE = -1.0 ! Coupling time step for lake
!
! Sea Output variables
!
- CHARACTER(LEN=8) :: CSEA_FWSU = ' ' ! zonal wind stress
- CHARACTER(LEN=8) :: CSEA_FWSV = ' ' ! meridian wind stress
- CHARACTER(LEN=8) :: CSEA_HEAT = ' ' ! Non solar net heat flux
- CHARACTER(LEN=8) :: CSEA_SNET = ' ' ! Solar net heat flux
- CHARACTER(LEN=8) :: CSEA_WIND = ' ' ! module of 10m wind speed
- CHARACTER(LEN=8) :: CSEA_FWSM = ' ' ! module of wind stress
- CHARACTER(LEN=8) :: CSEA_EVAP = ' ' ! Evaporation
- CHARACTER(LEN=8) :: CSEA_RAIN = ' ' ! Rainfall
- CHARACTER(LEN=8) :: CSEA_SNOW = ' ' ! Snowfall
- CHARACTER(LEN=8) :: CSEA_WATF = ' ' ! Net freshwater flux
+CHARACTER(LEN=8) :: CSEA_FWSU = ' ' ! zonal wind stress
+CHARACTER(LEN=8) :: CSEA_FWSV = ' ' ! meridian wind stress
+CHARACTER(LEN=8) :: CSEA_HEAT = ' ' ! Non solar net heat flux
+CHARACTER(LEN=8) :: CSEA_SNET = ' ' ! Solar net heat flux
+CHARACTER(LEN=8) :: CSEA_WIND = ' ' ! module of 10m wind speed
+CHARACTER(LEN=8) :: CSEA_FWSM = ' ' ! module of wind stress
+CHARACTER(LEN=8) :: CSEA_EVAP = ' ' ! Evaporation
+CHARACTER(LEN=8) :: CSEA_RAIN = ' ' ! Rainfall
+CHARACTER(LEN=8) :: CSEA_SNOW = ' ' ! Snowfall
+CHARACTER(LEN=8) :: CSEA_WATF = ' ' ! Net freshwater flux
!
! Sea-ice Output variables
!
- CHARACTER(LEN=8) :: CSEAICE_HEAT = ' ' ! Sea-ice non solar net heat flux
- CHARACTER(LEN=8) :: CSEAICE_SNET = ' ' ! Sea-ice solar net heat flux
- CHARACTER(LEN=8) :: CSEAICE_EVAP = ' ' ! Sea-ice sublimation
+CHARACTER(LEN=8) :: CSEAICE_HEAT = ' ' ! Sea-ice non solar net heat flux
+CHARACTER(LEN=8) :: CSEAICE_SNET = ' ' ! Sea-ice solar net heat flux
+CHARACTER(LEN=8) :: CSEAICE_EVAP = ' ' ! Sea-ice sublimation
!
! Sea Input variables
!
- CHARACTER(LEN=8) :: CSEA_SST = ' ' ! Sea surface temperature
- CHARACTER(LEN=8) :: CSEA_UCU = ' ' ! Sea u-current stress
- CHARACTER(LEN=8) :: CSEA_VCU = ' ' ! Sea v-current stress
+CHARACTER(LEN=8) :: CSEA_SST = ' ' ! Sea surface temperature
+CHARACTER(LEN=8) :: CSEA_UCU = ' ' ! Sea u-current stress
+CHARACTER(LEN=8) :: CSEA_VCU = ' ' ! Sea v-current stress
!
! Sea-ice Input variables
!
- CHARACTER(LEN=8) :: CSEAICE_SIT = ' ' ! Sea-ice temperature
- CHARACTER(LEN=8) :: CSEAICE_CVR = ' ' ! Sea-ice cover
- CHARACTER(LEN=8) :: CSEAICE_ALB = ' ' ! Sea-ice albedo
+CHARACTER(LEN=8) :: CSEAICE_SIT = ' ' ! Sea-ice temperature
+CHARACTER(LEN=8) :: CSEAICE_CVR = ' ' ! Sea-ice cover
+CHARACTER(LEN=8) :: CSEAICE_ALB = ' ' ! Sea-ice albedo
!
! Switch to add water into sea oasis mask
!
@@ -116,8 +118,8 @@ LOGICAL :: LWATER = .FALSE.
!* 1. NAMELISTS FOR LAND SURFACE FIELD
! ------------------------------------------------
!
-NAMELIST/NAM_SFX_LAND_CPL/XTSTEP_CPL_LAND, &
- CRUNOFF,CDRAIN,CCALVING,CRECHARGE,CWTD,CFWTD, &
+NAMELIST/NAM_SFX_LAND_CPL/XTSTEP_CPL_LAND, XFLOOD_LIM, &
+ CRUNOFF,CDRAIN,CCALVING,CWTD,CFWTD, &
CFFLOOD,CPIFLOOD,CSRCFLOOD
!
!
diff --git a/src/SURFEX/modn_sson.F90 b/src/SURFEX/modn_sson.F90
index c20781226314ee8d648c6d7bb8aaa23c5de4a002..1e3325aaf2c81820a927e1d2d2e53acee96669e3 100644
--- a/src/SURFEX/modn_sson.F90
+++ b/src/SURFEX/modn_sson.F90
@@ -46,15 +46,15 @@ REAL :: XCOEFBE
!
NAMELIST/NAM_SSOn/CROUGH, XFRACZ0, XCOEFBE
!
- CONTAINS
+CONTAINS
!
SUBROUTINE INIT_NAM_SSOn (USS)
!
- USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+ USE MODD_SSO_n, ONLY : SSO_t
!
IMPLICIT NONE
!
- TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+ TYPE(SSO_t), INTENT(INOUT) :: USS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_SSO_N:INIT_NAM_SSON',0,ZHOOK_HANDLE)
@@ -66,11 +66,11 @@ END SUBROUTINE INIT_NAM_SSOn
SUBROUTINE UPDATE_NAM_SSOn (USS)
!
- USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+ USE MODD_SSO_n, ONLY : SSO_t
!
IMPLICIT NONE
!
- TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+ TYPE(SSO_t), INTENT(INOUT) :: USS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_SSO_N:UPDATE_NAM_SSON',0,ZHOOK_HANDLE)
diff --git a/src/SURFEX/modn_surf_atmn.F90 b/src/SURFEX/modn_surf_atmn.F90
index 39464032b4e9721b497c3d0fe395f0f28ef36ffe..2f5a43c7dba2847bf2d935a4f7f38d236310ca7a 100644
--- a/src/SURFEX/modn_surf_atmn.F90
+++ b/src/SURFEX/modn_surf_atmn.F90
@@ -43,7 +43,7 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
- CHARACTER(LEN=28), SAVE :: CCHEM_SURF_FILE
+CHARACTER(LEN=28), SAVE :: CCHEM_SURF_FILE
LOGICAL, SAVE :: LCH_SURF_EMIS
LOGICAL :: LFRAC
REAL :: XDIAG_TSTEP
@@ -59,7 +59,9 @@ LOGICAL :: LSURF_VARS
LOGICAL :: LDIAG_GRID
LOGICAL :: LPROVAR_TO_DIAG
LOGICAL :: LSELECT
- CHARACTER(LEN=LEN_HREC), DIMENSION(500) :: CSELECT
+LOGICAL :: LSNOWDIMNC
+LOGICAL :: LRESETCUMUL
+CHARACTER(LEN=LEN_HREC), DIMENSION(4000) :: CSELECT
!
NAMELIST/NAM_CH_CONTROLn/CCHEM_SURF_FILE
NAMELIST/NAM_CH_SURFn/LCH_SURF_EMIS
@@ -67,9 +69,9 @@ NAMELIST/NAM_DIAG_SURF_ATMn/LFRAC, LDIAG_GRID, LT2MMW
NAMELIST/NAM_DIAG_SURFn/N2M, L2M_MIN_ZS, LSURF_BUDGET, LRAD_BUDGET, LSURF_BUDGETC, &
LRESET_BUDGETC, LCOEF, LSURF_VARS
!
-NAMELIST/NAM_WRITE_DIAG_SURFn/LPROVAR_TO_DIAG,LSELECT,CSELECT
+NAMELIST/NAM_WRITE_DIAG_SURFn/LPROVAR_TO_DIAG,LSNOWDIMNC,LRESETCUMUL,LSELECT,CSELECT
!
- CONTAINS
+CONTAINS
!
SUBROUTINE INIT_NAM_CH_CONTROLn (CHU)
!
@@ -131,126 +133,132 @@ SUBROUTINE UPDATE_NAM_CH_SURFn (CHU)
IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:UPDATE_NAM_CH_SURFN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_CH_SURFn
-SUBROUTINE INIT_NAM_DIAG_SURF_ATMn (DGU)
+SUBROUTINE INIT_NAM_DIAG_SURF_ATMn (DGO)
!
- USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:INIT_NAM_DIAG_SURF_ATMN',0,ZHOOK_HANDLE)
- LFRAC = DGU%LFRAC
- LT2MMW = DGU%LT2MMW
+ LFRAC = DGO%LFRAC
+ LT2MMW = DGO%LT2MMW
IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:INIT_NAM_DIAG_SURF_ATMN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_DIAG_SURF_ATMn
-SUBROUTINE UPDATE_NAM_DIAG_SURF_ATMn (DGU)
+SUBROUTINE UPDATE_NAM_DIAG_SURF_ATMn (DGO)
!
- USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:UPDATE_NAM_DIAG_SURF_ATMN',0,ZHOOK_HANDLE)
- DGU%LFRAC = LFRAC
- DGU%LT2MMW = LT2MMW
+ DGO%LFRAC = LFRAC
+ DGO%LT2MMW = LT2MMW
IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:UPDATE_NAM_DIAG_SURF_ATMN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_DIAG_SURF_ATMn
-SUBROUTINE INIT_NAM_DIAG_SURFn (DGU)
+SUBROUTINE INIT_NAM_DIAG_SURFn (DGO)
!
- USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:INIT_NAM_DIAG_SURFN',0,ZHOOK_HANDLE)
- XDIAG_TSTEP = DGU%XDIAG_TSTEP
- N2M = DGU%N2M
- L2M_MIN_ZS = DGU%L2M_MIN_ZS
- LSURF_BUDGET = DGU%LSURF_BUDGET
- LRAD_BUDGET = DGU%LRAD_BUDGET
- LSURF_BUDGETC = DGU%LSURF_BUDGETC
- LRESET_BUDGETC = DGU%LRESET_BUDGETC
- LCOEF = DGU%LCOEF
- LSURF_VARS = DGU%LSURF_VARS
- LDIAG_GRID = DGU%LDIAG_GRID
+ XDIAG_TSTEP = DGO%XDIAG_TSTEP
+ N2M = DGO%N2M
+ L2M_MIN_ZS = DGO%L2M_MIN_ZS
+ LSURF_BUDGET = DGO%LSURF_BUDGET
+ LRAD_BUDGET = DGO%LRAD_BUDGET
+ LSURF_BUDGETC = DGO%LSURF_BUDGETC
+ LRESET_BUDGETC = DGO%LRESET_BUDGETC
+ LCOEF = DGO%LCOEF
+ LSURF_VARS = DGO%LSURF_VARS
+ LDIAG_GRID = DGO%LDIAG_GRID
IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:INIT_NAM_DIAG_SURFN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_DIAG_SURFn
-SUBROUTINE UPDATE_NAM_DIAG_SURFn (DGU)
+SUBROUTINE UPDATE_NAM_DIAG_SURFn (DGO)
!
- USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:UPDATE_NAM_DIAG_SURFN',0,ZHOOK_HANDLE)
- DGU%XDIAG_TSTEP = XDIAG_TSTEP
- DGU%N2M = N2M
- DGU%L2M_MIN_ZS = L2M_MIN_ZS
- DGU%LSURF_BUDGET = LSURF_BUDGET
- DGU%LRAD_BUDGET = LRAD_BUDGET
- DGU%LSURF_BUDGETC = LSURF_BUDGETC
- DGU%LRESET_BUDGETC = LRESET_BUDGETC
- DGU%LCOEF = LCOEF
- DGU%LSURF_VARS = LSURF_VARS
- DGU%LDIAG_GRID = LDIAG_GRID
+ DGO%XDIAG_TSTEP = XDIAG_TSTEP
+ DGO%N2M = N2M
+ DGO%L2M_MIN_ZS = L2M_MIN_ZS
+ DGO%LSURF_BUDGET = LSURF_BUDGET
+ DGO%LRAD_BUDGET = LRAD_BUDGET
+ DGO%LSURF_BUDGETC = LSURF_BUDGETC
+ DGO%LRESET_BUDGETC = LRESET_BUDGETC
+ DGO%LCOEF = LCOEF
+ DGO%LSURF_VARS = LSURF_VARS
+ DGO%LDIAG_GRID = LDIAG_GRID
IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:UPDATE_NAM_DIAG_SURFN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_DIAG_SURFn
-SUBROUTINE INIT_NAM_WRITE_DIAG_SURFn (DGU)
+SUBROUTINE INIT_NAM_WRITE_DIAG_SURFn (DGO)
!
- USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:INIT_NAM_WRITE_DIAG_SURFN',0,ZHOOK_HANDLE)
- LPROVAR_TO_DIAG = DGU%LPROVAR_TO_DIAG
- LSELECT = DGU%LSELECT
+ LPROVAR_TO_DIAG = DGO%LPROVAR_TO_DIAG
+ LSNOWDIMNC = DGO%LSNOWDIMNC
+ LRESETCUMUL = DGO%LRESETCUMUL
+ LSELECT = DGO%LSELECT
CSELECT(:) = ' '
IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:INIT_NAM_WRITE_DIAG_SURFN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_WRITE_DIAG_SURFn
-SUBROUTINE UPDATE_NAM_WRITE_DIAG_SURFn (DGU)
+SUBROUTINE UPDATE_NAM_WRITE_DIAG_SURFn (DGO)
!
- USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
INTEGER :: ICOUNT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:UPDATE_NAM_WRITE_DIAG_SURFN',0,ZHOOK_HANDLE)
- DGU%LPROVAR_TO_DIAG = LPROVAR_TO_DIAG
+ DGO%LPROVAR_TO_DIAG = LPROVAR_TO_DIAG
+ DGO%LSNOWDIMNC = LSNOWDIMNC
+ DGO%LRESETCUMUL = LRESETCUMUL
!
- DGU%LSELECT = LSELECT
+ DGO%LSELECT = LSELECT
IF (LSELECT) THEN
ICOUNT = COUNT(CSELECT /= ' ')
- IF(.NOT.ASSOCIATED(DGU%CSELECT))THEN
- ALLOCATE(DGU%CSELECT(ICOUNT))
- DGU%CSELECT(:) = ' '
+ IF(.NOT.ASSOCIATED(DGO%CSELECT))THEN
+ ALLOCATE(DGO%CSELECT(ICOUNT+1))
+ DGO%CSELECT(:) = ' '
ENDIF
- DGU%CSELECT = CSELECT(1:ICOUNT)
+ DGO%CSELECT(1:ICOUNT) = CSELECT(1:ICOUNT)
+ ELSE
+ IF (.NOT.ASSOCIATED(DGO%CSELECT)) ALLOCATE(DGO%CSELECT(0))
ENDIF
IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:UPDATE_NAM_WRITE_DIAG_SURFN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_WRITE_DIAG_SURFn
diff --git a/src/SURFEX/modn_teb_greenroofn.F90 b/src/SURFEX/modn_teb_greenroofn.F90
index 78ed59e38cd0f4b471573cb3a28cd761347e3137..79e4cb4e182ff45bae95845d621ce2b7ed3ff5cd 100644
--- a/src/SURFEX/modn_teb_greenroofn.F90
+++ b/src/SURFEX/modn_teb_greenroofn.F90
@@ -38,53 +38,53 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
- CHARACTER(LEN=4) :: CSCOND_GR
- CHARACTER(LEN=4) :: CRUNOFF_GR
- CHARACTER(LEN=3) :: CKSAT_GR
+CHARACTER(LEN=4) :: CSCOND_GR
+CHARACTER(LEN=4) :: CRUNOFF_GR
+CHARACTER(LEN=3) :: CKSAT_GR
LOGICAL :: LSOC_GR
- CHARACTER(LEN=3) :: CHORT_GR
+CHARACTER(LEN=3) :: CHORT_GR
!
NAMELIST/NAM_TEB_GREENROOFn/CRUNOFF_GR,CSCOND_GR,CKSAT_GR,LSOC_GR,CHORT_GR
!
- CONTAINS
+CONTAINS
!
! subroutine INIT !
SUBROUTINE INIT_NAM_TEB_GREENROOFn (TGRO)
!
- USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
+ USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: TGRO
+ TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: TGRO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_TEB_GREENROOF_N:INIT_NAM_TEB_GREENROOFN',0,ZHOOK_HANDLE)
- CSCOND_GR = TGRO%CSCOND_GR
- CRUNOFF_GR = TGRO%CRUNOFF_GR
- CKSAT_GR = TGRO%CKSAT_GR
- LSOC_GR = TGRO%LSOC_GR
- CHORT_GR = TGRO%CHORT_GR
+ CSCOND_GR = TGRO%CSCOND
+ CRUNOFF_GR = TGRO%CRUNOFF
+ CKSAT_GR = TGRO%CKSAT
+ LSOC_GR = TGRO%LSOC
+ CHORT_GR = TGRO%CHORT
IF (LHOOK) CALL DR_HOOK('MODN_TEB_GREENROOF_N:INIT_NAM_TEB_GREENROOFN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_TEB_GREENROOFn
! subroutine UPDATE !
SUBROUTINE UPDATE_NAM_TEB_GREENROOFn (TGRO)
!
- USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
+ USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: TGRO
+ TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: TGRO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_TEB_GREENROOF_N:UPDATE_NAM_TEB_GREENROOFN',0,ZHOOK_HANDLE)
- TGRO%CSCOND_GR = CSCOND_GR
- TGRO%CRUNOFF_GR = CRUNOFF_GR
- TGRO%CKSAT_GR = CKSAT_GR
- TGRO%LSOC_GR = LSOC_GR
- TGRO%CHORT_GR = CHORT_GR
+ TGRO%CSCOND = CSCOND_GR
+ TGRO%CRUNOFF = CRUNOFF_GR
+ TGRO%CKSAT = CKSAT_GR
+ TGRO%LSOC = LSOC_GR
+ TGRO%CHORT = CHORT_GR
IF (LHOOK) CALL DR_HOOK('MODN_TEB_GREENROOF_N:UPDATE_NAM_TEB_GREENROOFN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_TEB_GREENROOFn
diff --git a/src/SURFEX/modn_teb_vegn.F90 b/src/SURFEX/modn_teb_vegn.F90
index 9b56bf98fa560633c0d93d022120c9c67e592d8e..1c8bd31e7d31d89e41675357c91a62e688ebbdfe 100644
--- a/src/SURFEX/modn_teb_vegn.F90
+++ b/src/SURFEX/modn_teb_vegn.F90
@@ -48,155 +48,149 @@ LOGICAL :: LVEGUPD
LOGICAL :: LNITRO_DILU
LOGICAL :: LCANOPY_DRAG
!
- CHARACTER(LEN=4) :: CC1DRY
- CHARACTER(LEN=4) :: CSCOND
- CHARACTER(LEN=3) :: CSOILFRZ
- CHARACTER(LEN=4) :: CDIFSFCOND
- CHARACTER(LEN=3) :: CSNOWRES
- CHARACTER(LEN=4) :: CALBEDO
- CHARACTER(LEN=4) :: CROUGH
- CHARACTER(LEN=3) :: CCPSURF
- CHARACTER(LEN=4) :: CRUNOFF
- CHARACTER(LEN=3) :: CKSAT
+CHARACTER(LEN=4) :: CC1DRY
+CHARACTER(LEN=4) :: CSCOND
+CHARACTER(LEN=3) :: CSOILFRZ
+CHARACTER(LEN=4) :: CDIFSFCOND
+CHARACTER(LEN=3) :: CSNOWRES
+CHARACTER(LEN=3) :: CCPSURF
+CHARACTER(LEN=4) :: CRUNOFF
+CHARACTER(LEN=3) :: CKSAT
LOGICAL :: LSOC
- CHARACTER(LEN=3) :: CRAIN
- CHARACTER(LEN=3) :: CHORT
- CHARACTER(LEN=28) :: CCHEM_SURF_FILE
- CHARACTER(LEN=6) :: CCH_DRY_DEP
+CHARACTER(LEN=3) :: CRAIN
+CHARACTER(LEN=3) :: CHORT
+CHARACTER(LEN=28) :: CCHEM_SURF_FILE
+CHARACTER(LEN=6) :: CCH_DRY_DEP
!
REAL :: XCGMAX
REAL :: XTSTEP
REAL :: XCDRAG
!
-NAMELIST/NAM_ISBAn/CC1DRY,CSCOND,CSOILFRZ,CDIFSFCOND,CSNOWRES,CALBEDO,CROUGH,CCPSURF, &
+NAMELIST/NAM_ISBAn/CC1DRY,CSCOND,CSOILFRZ,CDIFSFCOND,CSNOWRES,CCPSURF, &
XTSTEP,XCGMAX,XCDRAG,LGLACIER, LCANOPY_DRAG, LVEGUPD, LPERTSURF
NAMELIST/NAM_ISBA_AGSn/LNITRO_DILU
NAMELIST/NAM_SGH_ISBAn/CRUNOFF,CKSAT,LSOC,CRAIN,CHORT
NAMELIST/NAM_CH_CONTROLn/CCHEM_SURF_FILE
NAMELIST/NAM_CH_ISBAn/LCH_BIO_FLUX,CCH_DRY_DEP,LCH_NO_FLUX
!
- CONTAINS
+CONTAINS
!
-SUBROUTINE INIT_NAM_TEB_VEGn (TVG)
+SUBROUTINE INIT_NAM_TEB_VEGn (TGDO)
!
- USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
+ USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
+ TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: TGDO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_TEB_VEG_N:INIT_NAM_TEB_VEGN',0,ZHOOK_HANDLE)
- CC1DRY = TVG%CC1DRY
- CSCOND = TVG%CSCOND
- CSOILFRZ = TVG%CSOILFRZ
- CDIFSFCOND = TVG%CDIFSFCOND
- CSNOWRES = TVG%CSNOWRES
- CALBEDO = TVG%CALBEDO
- CROUGH = TVG%CROUGH
- CCPSURF = TVG%CCPSURF
- XTSTEP = TVG%XTSTEP
- XCGMAX = TVG%XCGMAX
- XCDRAG = TVG%XCDRAG
- LVEGUPD = TVG%LVEGUPD
- LCANOPY_DRAG = TVG%LCANOPY_DRAG
+ CC1DRY = TGDO%CC1DRY
+ CSCOND = TGDO%CSCOND
+ CSOILFRZ = TGDO%CSOILFRZ
+ CDIFSFCOND = TGDO%CDIFSFCOND
+ CSNOWRES = TGDO%CSNOWRES
+ CCPSURF = TGDO%CCPSURF
+ XTSTEP = TGDO%XTSTEP
+ XCGMAX = TGDO%XCGMAX
+ XCDRAG = TGDO%XCDRAG
+ LVEGUPD = TGDO%LVEGUPD
+ LCANOPY_DRAG = TGDO%LCANOPY_DRAG
IF (LHOOK) CALL DR_HOOK('MODN_TEB_VEG_N:INIT_NAM_TEB_VEGN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_TEB_VEGn
-SUBROUTINE INIT_NAM_TEB_VEG_AGSn (TVG)
+SUBROUTINE INIT_NAM_TEB_VEG_AGSn (TGDO)
!
- USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
+ USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
+ TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: TGDO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_TEB_VEG_N:INIT_NAM_TEB_VEG_AGSN',0,ZHOOK_HANDLE)
- LNITRO_DILU = TVG%LNITRO_DILU
+ LNITRO_DILU = TGDO%LNITRO_DILU
IF (LHOOK) CALL DR_HOOK('MODN_TEB_VEG_N:INIT_NAM_TEB_VEG_AGSN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_TEB_VEG_AGSn
-SUBROUTINE UPDATE_NAM_TEB_VEGn (TVG)
+SUBROUTINE UPDATE_NAM_TEB_VEGn (TGDO)
!
- USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
+ USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
+ TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: TGDO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_TEB_VEG_N:UPDATE_NAM_TEB_VEGN',0,ZHOOK_HANDLE)
- TVG%CC1DRY = CC1DRY
- TVG%CSCOND = CSCOND
- TVG%CSOILFRZ = CSOILFRZ
- TVG%CDIFSFCOND = CDIFSFCOND
- TVG%CSNOWRES = CSNOWRES
- TVG%CALBEDO = CALBEDO
- TVG%CROUGH = CROUGH
- TVG%CCPSURF = CCPSURF
- TVG%XTSTEP = XTSTEP
- TVG%XCGMAX = XCGMAX
- TVG%XCDRAG = XCDRAG
- TVG%LVEGUPD = LVEGUPD
- TVG%LCANOPY_DRAG = LCANOPY_DRAG
+ TGDO%CC1DRY = CC1DRY
+ TGDO%CSCOND = CSCOND
+ TGDO%CSOILFRZ = CSOILFRZ
+ TGDO%CDIFSFCOND = CDIFSFCOND
+ TGDO%CSNOWRES = CSNOWRES
+ TGDO%CCPSURF = CCPSURF
+ TGDO%XTSTEP = XTSTEP
+ TGDO%XCGMAX = XCGMAX
+ TGDO%XCDRAG = XCDRAG
+ TGDO%LVEGUPD = LVEGUPD
+ TGDO%LCANOPY_DRAG = LCANOPY_DRAG
IF (LHOOK) CALL DR_HOOK('MODN_TEB_VEG_N:UPDATE_NAM_TEB_VEGN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_TEB_VEGn
-SUBROUTINE UPDATE_NAM_TEB_VEG_AGSn (TVG)
+SUBROUTINE UPDATE_NAM_TEB_VEG_AGSn (TGDO)
!
- USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
+ USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
+ TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: TGDO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_TEB_VEG_N:UPDATE_NAM_TEB_VEG_AGSN',0,ZHOOK_HANDLE)
- TVG%LNITRO_DILU = LNITRO_DILU
+ TGDO%LNITRO_DILU = LNITRO_DILU
IF (LHOOK) CALL DR_HOOK('MODN_TEB_VEG_N:UPDATE_NAM_TEB_VEG_AGSN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_TEB_VEG_AGSn
-SUBROUTINE INIT_NAM_SGH_TEB_VEGn (TVG)
+SUBROUTINE INIT_NAM_SGH_TEB_VEGn (TGDO)
!
- USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
+ USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
+ TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: TGDO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_TEB_TEB_VEG_N:INIT_NAM_SGH_TEB_VEGN',0,ZHOOK_HANDLE)
- CRUNOFF = TVG%CRUNOFF
- CKSAT = TVG%CKSAT
- LSOC = TVG%LSOC
- CRAIN = TVG%CRAIN
- CHORT = TVG%CHORT
+ CRUNOFF = TGDO%CRUNOFF
+ CKSAT = TGDO%CKSAT
+ LSOC = TGDO%LSOC
+ CRAIN = TGDO%CRAIN
+ CHORT = TGDO%CHORT
IF (LHOOK) CALL DR_HOOK('MODN_TEB_VEG_N:INIT_NAM_SGH_TEB_VEGN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_SGH_TEB_VEGn
-SUBROUTINE UPDATE_NAM_SGH_TEB_VEGn (TVG)
+SUBROUTINE UPDATE_NAM_SGH_TEB_VEGn (TGDO)
!
- USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
+ USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
+ TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: TGDO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_TEB_VEG_N:UPDATE_NAM_SGH_TEB_VEGN',0,ZHOOK_HANDLE)
- TVG%CRUNOFF = CRUNOFF
- TVG%CKSAT = CKSAT
- TVG%LSOC = LSOC
- TVG%CRAIN = CRAIN
- TVG%CHORT = CHORT
+ TGDO%CRUNOFF = CRUNOFF
+ TGDO%CKSAT = CKSAT
+ TGDO%LSOC = LSOC
+ TGDO%CRAIN = CRAIN
+ TGDO%CHORT = CHORT
IF (LHOOK) CALL DR_HOOK('MODN_TEB_VEG_N:UPDATE_NAM_SGH_TEB_VEGN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_SGH_TEB_VEGn
diff --git a/src/SURFEX/modn_tebn.F90 b/src/SURFEX/modn_tebn.F90
index e2539f51caf383bc964188532abe399eec7b6fe2..820216219e85d57d759a755e9497f0beebfd4f1e 100644
--- a/src/SURFEX/modn_tebn.F90
+++ b/src/SURFEX/modn_tebn.F90
@@ -44,7 +44,6 @@ USE PARKIND1 ,ONLY : JPRB
IMPLICIT NONE
!
LOGICAL :: LPGD
-LOGICAL :: LPGD_FIX
LOGICAL :: L2M_MIN_ZS
LOGICAL :: LSURF_BUDGET
LOGICAL :: LRAD_BUDGET
@@ -72,54 +71,54 @@ NAMELIST/NAM_DIAG_SURFn/N2M,L2M_MIN_ZS,LSURF_BUDGET,LRAD_BUDGET, &
LCOEF,LSURF_VARS, LSURF_BUDGETC, LRESET_BUDGETC
!
NAMELIST/NAM_CH_TEBn/CCH_DRY_DEP
-NAMELIST/NAM_DIAG_TEBn/LPGD,LPGD_FIX,LSURF_MISC_BUDGET,LSURF_DIAG_ALBEDO,LUTCI
+NAMELIST/NAM_DIAG_TEBn/LPGD,LSURF_MISC_BUDGET,LSURF_DIAG_ALBEDO,LUTCI
NAMELIST/NAM_TEBn/CZ0H,CCH_BEM,XDT_RES,XDT_OFF
!
- CONTAINS
+CONTAINS
!
-SUBROUTINE INIT_NAM_DIAG_SURFn (DGT, TOP)
+SUBROUTINE INIT_NAM_DIAG_SURFn (DGO, TOP)
!
- USE MODD_DIAG_TEB_n, ONLY : DIAG_TEB_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(DIAG_TEB_t), INTENT(INOUT) :: DGT
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_TEB_N:INIT_NAM_DIAG_SURFN',0,ZHOOK_HANDLE)
XTSTEP = TOP%XTSTEP
XOUT_TSTEP = TOP%XOUT_TSTEP
- XDIAG_TSTEP = DGT%XDIAG_TSTEP
- N2M = DGT%N2M
- L2M_MIN_ZS = DGT%L2M_MIN_ZS
- LSURF_BUDGET = DGT%LSURF_BUDGET
- LRAD_BUDGET = DGT%LRAD_BUDGET
- LCOEF = DGT%LCOEF
- LSURF_VARS = DGT%LSURF_VARS
+ XDIAG_TSTEP = DGO%XDIAG_TSTEP
+ N2M = DGO%N2M
+ L2M_MIN_ZS = DGO%L2M_MIN_ZS
+ LSURF_BUDGET = DGO%LSURF_BUDGET
+ LRAD_BUDGET = DGO%LRAD_BUDGET
+ LCOEF = DGO%LCOEF
+ LSURF_VARS = DGO%LSURF_VARS
IF (LHOOK) CALL DR_HOOK('MODN_TEB_N:INIT_NAM_DIAG_SURFN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_DIAG_SURFn
-SUBROUTINE UPDATE_NAM_DIAG_SURFn (DGT)
+SUBROUTINE UPDATE_NAM_DIAG_SURFn (DGO)
!
- USE MODD_DIAG_TEB_n, ONLY : DIAG_TEB_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(DIAG_TEB_t), INTENT(INOUT) :: DGT
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_TEB_N:UPDATE_NAM_DIAG_SURFN',0,ZHOOK_HANDLE)
- DGT%XDIAG_TSTEP = XDIAG_TSTEP
- DGT%N2M = N2M
- DGT%L2M_MIN_ZS = L2M_MIN_ZS
- DGT%LSURF_BUDGET = LSURF_BUDGET
- DGT%LRAD_BUDGET = LRAD_BUDGET
- DGT%LCOEF = LCOEF
- DGT%LSURF_VARS = LSURF_VARS
+ DGO%XDIAG_TSTEP = XDIAG_TSTEP
+ DGO%N2M = N2M
+ DGO%L2M_MIN_ZS = L2M_MIN_ZS
+ DGO%LSURF_BUDGET = LSURF_BUDGET
+ DGO%LRAD_BUDGET = LRAD_BUDGET
+ DGO%LCOEF = LCOEF
+ DGO%LSURF_VARS = LSURF_VARS
IF (LHOOK) CALL DR_HOOK('MODN_TEB_N:UPDATE_NAM_DIAG_SURFN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_DIAG_SURFn
!
@@ -138,8 +137,8 @@ SUBROUTINE INIT_NAM_TEBn (T, TOP)
IF (LHOOK) CALL DR_HOOK('MODN_TEB_N:INIT_NAM_TEBN',0,ZHOOK_HANDLE)
CZ0H = TOP%CZ0H
CCH_BEM = TOP%CCH_BEM
- XDT_RES = T%CUR%XDT_RES
- XDT_OFF = T%CUR%XDT_OFF
+ XDT_RES = T%XDT_RES
+ XDT_OFF = T%XDT_OFF
IF (LHOOK) CALL DR_HOOK('MODN_TEB_N:INIT_NAM_TEBN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_TEBn
@@ -160,8 +159,8 @@ SUBROUTINE UPDATE_NAM_TEBn (T, TOP)
TOP%XOUT_TSTEP = XOUT_TSTEP
TOP%CZ0H = CZ0H
TOP%CCH_BEM = CCH_BEM
- T%CUR%XDT_RES = XDT_RES
- T%CUR%XDT_OFF = XDT_OFF
+ T%XDT_RES = XDT_RES
+ T%XDT_OFF = XDT_OFF
IF (LHOOK) CALL DR_HOOK('MODN_TEB_N:UPDATE_NAM_TEBN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_TEBn
@@ -195,49 +194,47 @@ SUBROUTINE UPDATE_NAM_CH_TEBn (CHT)
IF (LHOOK) CALL DR_HOOK('MODN_TEB_N:UPDATE_NAM_CH_TEBN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_CH_TEBn
-SUBROUTINE INIT_NAM_DIAG_TEBn (DGMTO, DGT, DGUT)
+SUBROUTINE INIT_NAM_DIAG_TEBn (DMTO, DGO, DUT)
!
- USE MODD_DIAG_MISC_TEB_OPTION_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
- USE MODD_DIAG_TEB_n, ONLY : DIAG_TEB_t
+ USE MODD_DIAG_MISC_TEB_OPTIONS_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
USE MODD_DIAG_UTCI_TEB_n, ONLY : DIAG_UTCI_TEB_t
!
IMPLICIT NONE
!
- TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: DGMTO
- TYPE(DIAG_TEB_t), INTENT(INOUT) :: DGT
- TYPE(DIAG_UTCI_TEB_t), INTENT(INOUT) :: DGUT
+ TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: DMTO
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+ TYPE(DIAG_UTCI_TEB_t), INTENT(INOUT) :: DUT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_TEB_N:INIT_NAM_DIAG_TEBN',0,ZHOOK_HANDLE)
- LPGD = DGT%LPGD
- LPGD_FIX = DGT%LPGD_FIX
- LSURF_MISC_BUDGET = DGMTO%LSURF_MISC_BUDGET
- LSURF_DIAG_ALBEDO = DGMTO%LSURF_DIAG_ALBEDO
- LUTCI = DGUT%LUTCI
+ LPGD = DGO%LPGD
+ LSURF_MISC_BUDGET = DMTO%LSURF_MISC_BUDGET
+ LSURF_DIAG_ALBEDO = DMTO%LSURF_DIAG_ALBEDO
+ LUTCI = DUT%LUTCI
IF (LHOOK) CALL DR_HOOK('MODN_TEB_N:INIT_NAM_DIAG_TEBN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_DIAG_TEBn
-SUBROUTINE UPDATE_NAM_DIAG_TEBn (DGMTO, DGT, DGUT)
+SUBROUTINE UPDATE_NAM_DIAG_TEBn (DMTO, DGO, DUT)
!
- USE MODD_DIAG_MISC_TEB_OPTION_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
- USE MODD_DIAG_TEB_n, ONLY : DIAG_TEB_t
+ USE MODD_DIAG_MISC_TEB_OPTIONS_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
USE MODD_DIAG_UTCI_TEB_n, ONLY : DIAG_UTCI_TEB_t
!
IMPLICIT NONE
!
- TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: DGMTO
- TYPE(DIAG_TEB_t), INTENT(INOUT) :: DGT
- TYPE(DIAG_UTCI_TEB_t), INTENT(INOUT) :: DGUT
+ TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: DMTO
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+ TYPE(DIAG_UTCI_TEB_t), INTENT(INOUT) :: DUT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_TEB_N:UPDATE_NAM_DIAG_TEBN',0,ZHOOK_HANDLE)
- DGT%LPGD = LPGD
- DGT%LPGD_FIX = LPGD_FIX
- DGMTO%LSURF_MISC_BUDGET = LSURF_MISC_BUDGET
- DGMTO%LSURF_DIAG_ALBEDO = LSURF_DIAG_ALBEDO
- DGUT%LUTCI = LUTCI
+ DGO%LPGD = LPGD
+ DMTO%LSURF_MISC_BUDGET = LSURF_MISC_BUDGET
+ DMTO%LSURF_DIAG_ALBEDO = LSURF_DIAG_ALBEDO
+ DUT%LUTCI = LUTCI
IF (LHOOK) CALL DR_HOOK('MODN_TEB_N:UPDATE_NAM_DIAG_TEBN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_DIAG_TEBn
diff --git a/src/SURFEX/modn_watfluxn.F90 b/src/SURFEX/modn_watfluxn.F90
index e4c3218ddc56a0098a8d29c2d69e5ceecd520984..851ca06f05df5967456a86458d5063efb440ce3d 100644
--- a/src/SURFEX/modn_watfluxn.F90
+++ b/src/SURFEX/modn_watfluxn.F90
@@ -62,7 +62,7 @@ NAMELIST/NAM_DIAG_SURFn/N2M,L2M_MIN_ZS,LSURF_BUDGET,LRAD_BUDGET, &
LSURF_BUDGETC,LRESET_BUDGETC,LCOEF,LSURF_VARS
NAMELIST/NAM_CH_WATFLUXn/CCH_DRY_DEP
!
- CONTAINS
+CONTAINS
!
SUBROUTINE INIT_NAM_WATFLUXn (W)
!
@@ -100,49 +100,49 @@ SUBROUTINE UPDATE_NAM_WATFLUXn (W)
IF (LHOOK) CALL DR_HOOK('MODN_WATFLUX_N:UPDATE_NAM_WATFLUXN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_WATFLUXn
!
-SUBROUTINE INIT_NAM_DIAG_SURFn (DGW)
+SUBROUTINE INIT_NAM_DIAG_SURFn (DGO)
!
- USE MODD_DIAG_WATFLUX_n, ONLY : DIAG_WATFLUX_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(DIAG_WATFLUX_t), INTENT(INOUT) :: DGW
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_WATFLUX_N:INIT_NAM_DIAG_SURFN',0,ZHOOK_HANDLE)
- XDIAG_TSTEP = DGW%XDIAG_TSTEP
- N2M = DGW%N2M
- L2M_MIN_ZS = DGW%L2M_MIN_ZS
- LSURF_BUDGET = DGW%LSURF_BUDGET
- LRAD_BUDGET = DGW%LRAD_BUDGET
- LSURF_BUDGETC = DGW%LSURF_BUDGETC
- LRESET_BUDGETC = DGW%LRESET_BUDGETC
- LCOEF = DGW%LCOEF
- LSURF_VARS = DGW%LSURF_VARS
+ XDIAG_TSTEP = DGO%XDIAG_TSTEP
+ N2M = DGO%N2M
+ L2M_MIN_ZS = DGO%L2M_MIN_ZS
+ LSURF_BUDGET = DGO%LSURF_BUDGET
+ LRAD_BUDGET = DGO%LRAD_BUDGET
+ LSURF_BUDGETC = DGO%LSURF_BUDGETC
+ LRESET_BUDGETC = DGO%LRESET_BUDGETC
+ LCOEF = DGO%LCOEF
+ LSURF_VARS = DGO%LSURF_VARS
IF (LHOOK) CALL DR_HOOK('MODN_WATFLUX_N:INIT_NAM_DIAG_SURFN',1,ZHOOK_HANDLE)
END SUBROUTINE INIT_NAM_DIAG_SURFn
-SUBROUTINE UPDATE_NAM_DIAG_SURFn (DGW)
+SUBROUTINE UPDATE_NAM_DIAG_SURFn (DGO)
!
- USE MODD_DIAG_WATFLUX_n, ONLY : DIAG_WATFLUX_t
+ USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
IMPLICIT NONE
!
- TYPE(DIAG_WATFLUX_t), INTENT(INOUT) :: DGW
+ TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODN_WATFLUX_N:UPDATE_NAM_DIAG_SURFN',0,ZHOOK_HANDLE)
- DGW%XDIAG_TSTEP = XDIAG_TSTEP
- DGW%N2M = N2M
- DGW%L2M_MIN_ZS = L2M_MIN_ZS
- DGW%LSURF_BUDGET = LSURF_BUDGET
- DGW%LRAD_BUDGET = LRAD_BUDGET
- DGW%LSURF_BUDGETC = LSURF_BUDGETC
- DGW%LRESET_BUDGETC = LRESET_BUDGETC
- DGW%LCOEF = LCOEF
- DGW%LSURF_VARS = LSURF_VARS
+ DGO%XDIAG_TSTEP = XDIAG_TSTEP
+ DGO%N2M = N2M
+ DGO%L2M_MIN_ZS = L2M_MIN_ZS
+ DGO%LSURF_BUDGET = LSURF_BUDGET
+ DGO%LRAD_BUDGET = LRAD_BUDGET
+ DGO%LSURF_BUDGETC = LSURF_BUDGETC
+ DGO%LRESET_BUDGETC = LRESET_BUDGETC
+ DGO%LCOEF = LCOEF
+ DGO%LSURF_VARS = LSURF_VARS
IF (LHOOK) CALL DR_HOOK('MODN_WATFLUX_N:UPDATE_NAM_DIAG_SURFN',1,ZHOOK_HANDLE)
END SUBROUTINE UPDATE_NAM_DIAG_SURFn
diff --git a/src/SURFEX/modn_write_surf_atm.F90 b/src/SURFEX/modn_write_surf_atm.F90
index dc215076a1a52d0cb39d5dd501cc7fe69c077e7f..b02ef3b43a7487a03f241093710555ff0bc0cdf2 100644
--- a/src/SURFEX/modn_write_surf_atm.F90
+++ b/src/SURFEX/modn_write_surf_atm.F90
@@ -23,7 +23,7 @@
!!
!! IMPLICIT ARGUMENTS
!! ------------------
-USE MODD_WRITE_SURF_ATM, ONLY : LNOWRITE_CANOPY, LNOWRITE_TEXFILE
+USE MODD_WRITE_SURF_ATM, ONLY : LNOWRITE_CANOPY, LNOWRITE_TEXFILE, LSPLIT_PATCH
!!
!-----------------------------------------------------------------------------
!
@@ -31,6 +31,6 @@ USE MODD_WRITE_SURF_ATM, ONLY : LNOWRITE_CANOPY, LNOWRITE_TEXFILE
! -----------------
IMPLICIT NONE
SAVE
-NAMELIST /NAM_WRITE_SURF_ATM/LNOWRITE_CANOPY, LNOWRITE_TEXFILE
+NAMELIST /NAM_WRITE_SURF_ATM/LNOWRITE_CANOPY, LNOWRITE_TEXFILE, LSPLIT_PATCH
!
END MODULE MODN_WRITE_SURF_ATM
diff --git a/src/SURFEX/nitro_decline.F90 b/src/SURFEX/nitro_decline.F90
index 4e8d03ba7f8ed332f0ccd2c7f0e31a85a55074bf..d296e728407b373ca09d888e8be52d378fc772ff 100644
--- a/src/SURFEX/nitro_decline.F90
+++ b/src/SURFEX/nitro_decline.F90
@@ -3,11 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE NITRO_DECLINE(HPHOTO, HRESPSL, OTR_ML, KSPINW , &
- PBSLAI_NITRO, PSEFOLD, PGMES, PANMAX, PANDAY, &
- PLAT, PLAIMIN, PVEGTYPE, PTAU_WOOD, &
- PANFM, PLAI, PBIOMASS, PRESP_BIOMASS, PBIOMASS_LEAF, &
- PINCREASE ,PTURNOVER )
+SUBROUTINE NITRO_DECLINE(IO, PK, PEK, OWOOD, PBSLAI_NITRO, PLAT, PBIOMASS_LEAF )
!
! ###############################################################
!!** NITRO_DECLINE
@@ -68,6 +64,9 @@ SUBROUTINE NITRO_DECLINE(HPHOTO, HRESPSL, OTR_ML, KSPINW , &
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_P_t, ISBA_PE_t
+!
USE MODD_CSTS, ONLY : XPI, XDAY
USE MODD_CO2V_PAR, ONLY : XPCCO2, XCC_NIT, XCA_NIT, XMC, &
XMCO2, XCC_NITRO, XBIOMASST_LIM
@@ -80,57 +79,35 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
!* 0.1 declarations of arguments
!
- CHARACTER(LEN=*), INTENT(IN) :: HPHOTO ! Kind of photosynthesis
-! ! 'NON'
-! ! 'AGS'
-! ! 'LAI'
-! ! 'AST'
-! ! 'LST'
- CHARACTER(LEN=3), INTENT(IN) :: HRESPSL ! Soil Respiration
-! ! 'DEF' = Norman 1992
-! ! 'PRM' = Rivalland PhD Thesis (2003)
-! ! 'CNT' = CENTURY model (Gibelin 2008)
-LOGICAL, INTENT(IN) :: OTR_ML ! new TR
-INTEGER, INTENT(IN) :: KSPINW ! wood spinup
+LOGICAL, DIMENSION(:), INTENT(IN) :: OWOOD
!
REAL, DIMENSION(:), INTENT(IN) :: PBSLAI_NITRO ! ratio of biomass to LAI
-REAL, DIMENSION(:), INTENT(IN) :: PSEFOLD ! e-folding time for senescence (s)
-REAL, DIMENSION(:), INTENT(IN) :: PGMES ! mesophyll conductance (m s-1)
-REAL, DIMENSION(:), INTENT(IN) :: PANMAX ! maximum photosynthesis rate
-REAL, DIMENSION(:), INTENT(IN) :: PANDAY ! daily net CO2 accumulation
REAL, DIMENSION(:), INTENT(IN) :: PLAT ! latitude of each grid point
-REAL, DIMENSION(:), INTENT(IN) :: PLAIMIN ! minimum LAI
-REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE ! fraction of each vegetation
-REAL, DIMENSION(:), INTENT(IN) :: PTAU_WOOD ! residence time in wood (s)
-REAL, DIMENSION(:), INTENT(IN) :: PLAI ! leaf area index (LAI)
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PANFM ! maximum leaf assimilation
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBIOMASS ! biomass reservoirs
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRESP_BIOMASS ! cumulated daily biomass respiration (kgDM m-2 day-1)
!
REAL, DIMENSION(:), INTENT(OUT) :: PBIOMASS_LEAF ! temporary leaf biomass
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINCREASE ! increment of biomass
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTURNOVER ! biomass turnover going into litter (gC m-2 s-1)
!
!* 0.2 declarations of local variables
!
REAL :: ZBMCOEF
-REAL, DIMENSION(SIZE(PLAI)) :: ZXSEFOLD ! e-folding time for senescence corrected (days)
-REAL, DIMENSION(SIZE(PLAI)) :: ZLAIB_NITRO ! LAI correction parameter used in sefold calculation
-REAL, DIMENSION(SIZE(PLAI)) :: ZASSIM ! assimilation
-REAL, DIMENSION(SIZE(PLAI)) :: ZBIOMASST ! leaf + active structural biomass
+REAL, DIMENSION(SIZE(PEK%XLAI,1)) :: ZXSEFOLD ! e-folding time for senescence corrected (days)
+REAL, DIMENSION(SIZE(PEK%XLAI,1)) :: ZLAIB_NITRO ! LAI correction parameter used in sefold calculation
+REAL, DIMENSION(SIZE(PEK%XLAI,1)) :: ZASSIM ! assimilation
+REAL, DIMENSION(SIZE(PEK%XLAI,1)) :: ZBIOMASST ! leaf + active structural biomass
!
-REAL, DIMENSION(SIZE(PLAI),SIZE(PBIOMASS,2)) :: ZINCREASE
-REAL, DIMENSION(SIZE(PLAI),SIZE(PBIOMASS,2)) :: ZBIOMASS ! temporary biomass reservoirs
-REAL, DIMENSION(SIZE(PLAI),SIZE(PBIOMASS,2)) :: ZDECLINE ! biomass decline (storage+mortality) (kgDM m-2 day-1)
-REAL, DIMENSION(SIZE(PLAI),SIZE(PBIOMASS,2)) :: ZSTORAGE ! storage (part of decline kgDM m-2 day-1)
-REAL, DIMENSION(SIZE(PLAI)) :: ZMORT_LEAF ! leaf mortality
+REAL, DIMENSION(SIZE(PEK%XLAI,1),SIZE(PEK%XBIOMASS,2)) :: ZINCREASE
+REAL, DIMENSION(SIZE(PEK%XLAI,1),SIZE(PEK%XBIOMASS,2)) :: ZBIOMASS ! temporary biomass reservoirs
+REAL, DIMENSION(SIZE(PEK%XLAI,1),SIZE(PEK%XBIOMASS,2)) :: ZDECLINE ! biomass decline (storage+mortality) (kgDM m-2 day-1)
+REAL, DIMENSION(SIZE(PEK%XLAI,1),SIZE(PEK%XBIOMASS,2)) :: ZSTORAGE ! storage (part of decline kgDM m-2 day-1)
+REAL, DIMENSION(SIZE(PEK%XLAI,1)) :: ZMORT_LEAF ! leaf mortality
!
-REAL, DIMENSION(SIZE(PLAI)) :: ZWORK,ZRESP
-LOGICAL, DIMENSION(SIZE(PLAI)) :: GMASK_ASSIM
-LOGICAL, DIMENSION(SIZE(PLAI)) :: GWOODY
+REAL, DIMENSION(SIZE(PEK%XLAI,1)) :: ZWORK,ZRESP
+LOGICAL, DIMENSION(SIZE(PEK%XLAI,1)) :: GMASK_ASSIM
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -151,7 +128,7 @@ INTEGER :: JSPIN, JI, INI
!
IF (LHOOK) CALL DR_HOOK('NITRO_DECLINE',0,ZHOOK_HANDLE)
!
-INI = SIZE(PLAI)
+INI = SIZE(PEK%XLAI,1)
!
ZXSEFOLD(:) = 0.0
ZLAIB_NITRO(:) = 0.0
@@ -169,11 +146,11 @@ ZBMCOEF = XMC/(XMCO2*XPCCO2)
!-----------------------------------------------------------------
!avoid possible but unlikely negative values for biomass:
!
-PBIOMASS(:,1) = MAX(PBIOMASS(:,1),0.0)
+PEK%XBIOMASS(:,1) = MAX(PEK%XBIOMASS(:,1),0.0)
!
! current leaf biomass value:
!
-PBIOMASS_LEAF(:) = PBIOMASS(:,1)
+PBIOMASS_LEAF(:) = PEK%XBIOMASS(:,1)
!
!-------------------------------------------------------------------------------
!
@@ -186,7 +163,7 @@ PBIOMASS_LEAF(:) = PBIOMASS(:,1)
! coef c for biomass in kg/m2 now in modd_co2v_par.F90 (XCC_NITRO)
!
! LAI correction for shadow effect
-IF (OTR_ML) THEN
+IF (IO%LTR_ML) THEN
ZLAIB_NITRO(:) = 5.30
ELSE
ZLAIB_NITRO(:) = MAX( 5.76-0.64*ATAN(ABS(PLAT(:))*XPI/180.),3.8 )
@@ -196,13 +173,13 @@ ENDIF
! leaf life expectancy
!
ZWORK(:) = 0.0
-WHERE(PGMES(:)>0.0)
- ZWORK(:) = 0.321*LOG(PGMES(:)*1000.)
- ZWORK(:) = EXP(ZWORK(:))*PLAI(:)/ZLAIB_NITRO(:)
+WHERE(PEK%XGMES(:)>0.0)
+ ZWORK(:) = 0.321*LOG(PEK%XGMES(:)*1000.)
+ ZWORK(:) = EXP(ZWORK(:))*PEK%XLAI(:)/ZLAIB_NITRO(:)
ENDWHERE
! before optimization
-!ZXSEFOLD(:)= PSEFOLD(:) * MAX(((PGMES(:)*1000.)**0.321)*PLAI(:)/ZLAIB_NITRO(:), 1.) * ...
-ZXSEFOLD(:) = PSEFOLD(:) * MAX(1.0,ZWORK(:)) * MIN(1.0,PANFM(:)/PANMAX(:)) / XDAY
+!ZXSEFOLD(:)= PEK%XSEFOLD(:) * MAX(((PEK%XGMES(:)*1000.)**0.321)*PEK%XLAI(:)/ZLAIB_NITRO(:), 1.) * ...
+ZXSEFOLD(:) = PEK%XSEFOLD(:) * MAX(1.0,ZWORK(:)) * MIN(1.0,PEK%XANFM(:)/PK%XANMAX(:)) / XDAY
!
! avoid possible but unlikely division by zero
!
@@ -212,11 +189,11 @@ ZXSEFOLD(:) = MAX(1.0E-8,ZXSEFOLD(:))
!
! OLD ZXSEFOLD(:) = MAX(5.,ZXSEFOLD(:))
! Following Marita's work limitation of the senesence
-ZXSEFOLD(:) = MAX(PSEFOLD(:)/XDAY/10.0,ZXSEFOLD(:))
+ZXSEFOLD(:) = MAX(PEK%XSEFOLD(:)/XDAY/10.0,ZXSEFOLD(:))
!
! senesence of active biomass
!
-ZDECLINE(:,1) = MIN(PBIOMASS_LEAF(:)-PLAIMIN(:)*PBSLAI_NITRO(:), &
+ZDECLINE(:,1) = MIN(PBIOMASS_LEAF(:)-PEK%XLAIMIN(:)*PBSLAI_NITRO(:), &
PBIOMASS_LEAF(:)*(1.0-EXP(-1.0/ZXSEFOLD(:))))
!
! avoid negative values due to computation precision
@@ -229,7 +206,7 @@ PBIOMASS_LEAF(:) = PBIOMASS_LEAF(:) - ZDECLINE(:,1)
!
! daily active biomass assimilation
!
-ZASSIM(:) = PANDAY(:)*ZBMCOEF
+ZASSIM(:) = PEK%XANDAY(:)*ZBMCOEF
!
!-------------------------------------------------------------------------------
!
@@ -256,8 +233,8 @@ WHERE (ZASSIM(:) >= ZDECLINE(:,1))
! active structural biomass increment and storage
!
ZBIOMASS(:,2) = ZBIOMASST(:) - PBIOMASS_LEAF(:)
- ZDECLINE(:,2) = ZBIOMASS(:,2) * (1.0-EXP(-1.0*XDAY/PSEFOLD(:)))
- ZSTORAGE(:,1) = ZBIOMASS(:,2) - PBIOMASS(:,2) + ZDECLINE(:,2) + PRESP_BIOMASS(:,2)
+ ZDECLINE(:,2) = ZBIOMASS(:,2) * (1.0-EXP(-1.0*XDAY/PEK%XSEFOLD(:)))
+ ZSTORAGE(:,1) = ZBIOMASS(:,2) - PEK%XBIOMASS(:,2) + ZDECLINE(:,2) + PEK%XRESP_BIOMASS(:,2)
!
ELSE WHERE
!
@@ -266,12 +243,12 @@ ELSE WHERE
! the active structural biomass dies exponentially at the lowest rate
!
ZSTORAGE(:,1) = 0.0
- ZDECLINE(:,2) = PBIOMASS(:,2) * (1.0-EXP(-1.0*XDAY/PSEFOLD(:)))
- ZBIOMASS(:,2) = PBIOMASS(:,2) - ZDECLINE(:,2) - PRESP_BIOMASS(:,2)
+ ZDECLINE(:,2) = PEK%XBIOMASS(:,2) * (1.0-EXP(-1.0*XDAY/PEK%XSEFOLD(:)))
+ ZBIOMASS(:,2) = PEK%XBIOMASS(:,2) - ZDECLINE(:,2) - PEK%XRESP_BIOMASS(:,2)
!
! Avoid negative values of biomass
! No test on ZDECLINE(:,2) as it is not used after, or recalculated
- ! No test on PRESP_BIOMASS(:,2) as it should be smaller than PBIOMASS(:,2)
+ ! No test on PEK%XRESP_BIOMASS(:,2,1) as it should be smaller than PEK%XBIOMASS(:,2,1)
! otherwise there are irrealistic values of temperature
!
ZBIOMASS(:,2) = MAX(ZBIOMASS(:,2),0.0)
@@ -292,8 +269,8 @@ ZSTORAGE (:,1) = MAX(0.0,ZSTORAGE(:,1))
! 3.4 - Mass conservation : leaf biomass sensecence must be >= structural storage
!
WHERE( ZSTORAGE(:,1) > ZDECLINE(:,1))
- ZDECLINE(:,2) = PBIOMASS(:,2) * (1.0 - EXP(-1.0*XDAY/PSEFOLD(:)))
- ZBIOMASST(:) = PBIOMASS(:,1) + PBIOMASS(:,2) - ZDECLINE(:,2) - PRESP_BIOMASS(:,2)
+ ZDECLINE(:,2) = PEK%XBIOMASS(:,2) * (1.0 - EXP(-1.0*XDAY/PEK%XSEFOLD(:)))
+ ZBIOMASST(:) = PEK%XBIOMASS(:,1) + PEK%XBIOMASS(:,2) - ZDECLINE(:,2) - PEK%XRESP_BIOMASS(:,2)
END WHERE
!
ZWORK(:) = 0.0
@@ -308,8 +285,8 @@ WHERE( ZSTORAGE(:,1) > ZDECLINE(:,1))
!PBIOMASS_LEAF(:)= ZCC_NITRO * (ZBIOMASST(:)**(1.0-XCA_NIT))
PBIOMASS_LEAF(:) = XCC_NITRO * ZWORK(:)
ZBIOMASS(:,2) = ZBIOMASST(:) - PBIOMASS_LEAF(:)
- ZDECLINE(:,1) = PBIOMASS(:,1) - PBIOMASS_LEAF(:)
- ZSTORAGE(:,1) = ZBIOMASS(:,2) - PBIOMASS(:,2) + ZDECLINE(:,2) + PRESP_BIOMASS(:,2)
+ ZDECLINE(:,1) = PEK%XBIOMASS(:,1) - PBIOMASS_LEAF(:)
+ ZSTORAGE(:,1) = ZBIOMASS(:,2) - PEK%XBIOMASS(:,2) + ZDECLINE(:,2) + PEK%XRESP_BIOMASS(:,2)
!
ZINCREASE(:,2) = ZSTORAGE(:,1)
!
@@ -324,13 +301,13 @@ END WHERE
!
ZMORT_LEAF(:) = MAX(0.0, ZDECLINE(:,1) - ZSTORAGE(:,1))
!
-ZBIOMASS(:,3) = PBIOMASS(:,3)
+ZBIOMASS(:,3) = PEK%XBIOMASS(:,3)
!
-IF (HPHOTO=='NIT') THEN
+IF (IO%CPHOTO=='NIT') THEN
!
! senesence of deep-structural biomass
!
- ZDECLINE(:,3) = ZBIOMASS(:,3)*(1.0-EXP(-1.0*XDAY/PSEFOLD(:)))
+ ZDECLINE(:,3) = ZBIOMASS(:,3)*(1.0-EXP(-1.0*XDAY/PEK%XSEFOLD(:)))
!
! threshold value for leaf biomass and total above ground biomass in nitrogen
! dilution theory now in modd_co2v_par.F90 (XBIOMASST_LIM)
@@ -340,25 +317,21 @@ IF (HPHOTO=='NIT') THEN
ZBIOMASS(:,3) = ZBIOMASS(:,3) + ZMORT_LEAF(:)
END WHERE
!
-ELSEIF (HPHOTO=='NCB') THEN
- !
- GWOODY = (PVEGTYPE(:,NVT_TEBD)+PVEGTYPE(:,NVT_BONE)+PVEGTYPE(:,NVT_TRBE)+ &
- PVEGTYPE(:,NVT_TRBD)+PVEGTYPE(:,NVT_TEBE)+PVEGTYPE(:,NVT_TENE)+ &
- PVEGTYPE(:,NVT_BOBD)+PVEGTYPE(:,NVT_BOND)+PVEGTYPE(:,NVT_SHRB) >= 0.5)
+ELSEIF (IO%CPHOTO=='NCB') THEN
!
! 4.2 - Evolution of the other reservoirs
! 4.2.1 - senesence, avoiding negative values of biomass
!
- ZDECLINE(:,3) = MIN(PBIOMASS(:,3)*(1.0-EXP(-1.0*XDAY/(PSEFOLD(:)/4.))), &
- PBIOMASS(:,3)-PRESP_BIOMASS(:,3))
- ZDECLINE(:,4) = MIN(PBIOMASS(:,4)*(1.0-EXP(-1.0*XDAY/PSEFOLD(:))), &
- PBIOMASS(:,4)-PRESP_BIOMASS(:,4))
+ ZDECLINE(:,3) = MIN(PEK%XBIOMASS(:,3)*(1.0-EXP(-1.0*XDAY/(PEK%XSEFOLD(:)/4.))), &
+ PEK%XBIOMASS(:,3)-PEK%XRESP_BIOMASS(:,3))
+ ZDECLINE(:,4) = MIN(PEK%XBIOMASS(:,4)*(1.0-EXP(-1.0*XDAY/PEK%XSEFOLD(:))), &
+ PEK%XBIOMASS(:,4)-PEK%XRESP_BIOMASS(:,4))
!
- WHERE (GWOODY(:))
+ WHERE (OWOOD(:))
! Woody
- ZDECLINE(:,5) = MIN(PBIOMASS(:,5)*(1.0-EXP(-1.0*XDAY/PTAU_WOOD(:))), &
- PBIOMASS(:,5)-PRESP_BIOMASS(:,5))
- ZDECLINE(:,6) = PBIOMASS(:,6)*(1.0-EXP(-1.0*XDAY/PTAU_WOOD(:)))
+ ZDECLINE(:,5) = MIN(PEK%XBIOMASS(:,5)*(1.0-EXP(-1.0*XDAY/PK%XTAU_WOOD(:))), &
+ PEK%XBIOMASS(:,5)-PEK%XRESP_BIOMASS(:,5))
+ ZDECLINE(:,6) = PEK%XBIOMASS(:,6)*(1.0-EXP(-1.0*XDAY/PK%XTAU_WOOD(:)))
ELSEWHERE
! Herbaceous
ZDECLINE(:,5) = 0.
@@ -391,7 +364,7 @@ ELSEIF (HPHOTO=='NCB') THEN
!
END WHERE
!
- WHERE(GMASK_ASSIM(:).AND.GWOODY(:))
+ WHERE(GMASK_ASSIM(:).AND.OWOOD(:))
! Woody
ZSTORAGE(:,4) = ZDECLINE(:,4)
!
@@ -399,7 +372,7 @@ ELSEIF (HPHOTO=='NCB') THEN
ZINCREASE(:,5) = 0.7* (ZSTORAGE(:,2) + ZSTORAGE(:,3))
ZINCREASE(:,6) = ZSTORAGE(:,4)
!
- ELSEWHERE(GMASK_ASSIM(:).AND..NOT.GWOODY(:))
+ ELSEWHERE(GMASK_ASSIM(:).AND..NOT.OWOOD(:))
! Herbaceous
ZSTORAGE(:,4) = 0.
!
@@ -407,7 +380,7 @@ ELSEIF (HPHOTO=='NCB') THEN
!
END WHERE
!
- WHERE (.NOT.GMASK_ASSIM(:).AND.GWOODY(:))
+ WHERE (.NOT.GMASK_ASSIM(:).AND.OWOOD(:))
! Woody
! Senescence, only a part of decline is used as storage
ZSTORAGE(:,2) = 0.5*ZDECLINE(:,2)
@@ -417,7 +390,7 @@ ELSEIF (HPHOTO=='NCB') THEN
ZINCREASE(:,5) = ZSTORAGE(:,2) + ZSTORAGE(:,3)
ZINCREASE(:,6) = ZSTORAGE(:,4)
!
- ELSEWHERE(.NOT.GMASK_ASSIM(:).AND..NOT.GWOODY(:))
+ ELSEWHERE(.NOT.GMASK_ASSIM(:).AND..NOT.OWOOD(:))
! Herbaceous
! Senescence, no storage
ZSTORAGE(:,2) = 0.
@@ -431,13 +404,13 @@ ELSEIF (HPHOTO=='NCB') THEN
!
! 4.2.3 - mortality (senescence - storage) and turnover
!
- IF (HRESPSL=='CNT') THEN
- PTURNOVER(:,1) = ZMORT_LEAF(:)*1000.*XPCCO2/XDAY
- PTURNOVER(:,2) = (ZDECLINE(:,2) - ZSTORAGE(:,2))*1000.*XPCCO2/XDAY
- PTURNOVER(:,3) = (ZDECLINE(:,3) - ZSTORAGE(:,3))*1000.*XPCCO2/XDAY
- PTURNOVER(:,4) = (ZDECLINE(:,4) - ZSTORAGE(:,4))*1000.*XPCCO2/XDAY
- PTURNOVER(:,5) = (ZDECLINE(:,5) - ZSTORAGE(:,5))*1000.*XPCCO2/XDAY
- PTURNOVER(:,6) = (ZDECLINE(:,6) - ZSTORAGE(:,6))*1000.*XPCCO2/XDAY
+ IF (IO%CRESPSL=='CNT') THEN
+ PK%XTURNOVER(:,1) = ZMORT_LEAF(:)*1000.*XPCCO2/XDAY
+ PK%XTURNOVER(:,2) = (ZDECLINE(:,2) - ZSTORAGE(:,2))*1000.*XPCCO2/XDAY
+ PK%XTURNOVER(:,3) = (ZDECLINE(:,3) - ZSTORAGE(:,3))*1000.*XPCCO2/XDAY
+ PK%XTURNOVER(:,4) = (ZDECLINE(:,4) - ZSTORAGE(:,4))*1000.*XPCCO2/XDAY
+ PK%XTURNOVER(:,5) = (ZDECLINE(:,5) - ZSTORAGE(:,5))*1000.*XPCCO2/XDAY
+ PK%XTURNOVER(:,6) = (ZDECLINE(:,6) - ZSTORAGE(:,6))*1000.*XPCCO2/XDAY
ENDIF
!
ENDIF
@@ -445,46 +418,47 @@ ENDIF
!
! 4.3 - Re-initialisations for next time step
!
-ZBIOMASS(:,3) = ZBIOMASS(:,3) + ZINCREASE(:,3) - ZDECLINE(:,3) - PRESP_BIOMASS(:,3)
+ZBIOMASS(:,3) = ZBIOMASS(:,3) + ZINCREASE(:,3) - ZDECLINE(:,3) - PEK%XRESP_BIOMASS(:,3)
!
! Add net accumulated CO2 assimilation
PBIOMASS_LEAF(:) = PBIOMASS_LEAF(:) + ZASSIM(:)
!
! re-initialisation of biomass compartments values: X(day) <-- X(day-1)
-PBIOMASS(:,1) = PBIOMASS_LEAF(:)
-PBIOMASS(:,2) = ZBIOMASS(:,2)
-PBIOMASS(:,3) = ZBIOMASS(:,3)
+PEK%XBIOMASS(:,1) = PBIOMASS_LEAF(:)
+PEK%XBIOMASS(:,2) = ZBIOMASS(:,2)
+PEK%XBIOMASS(:,3) = ZBIOMASS(:,3)
!
! re-initialisation of respiration and assimilation terms
-PRESP_BIOMASS(:,2) = 0.0
-PRESP_BIOMASS(:,3) = 0.0
-PANFM(:) = 0.0
+PEK%XRESP_BIOMASS(:,2) = 0.0
+PEK%XRESP_BIOMASS(:,3) = 0.0
+PEK%XANFM(:) = 0.0
!
!
! 4.2.4 - evolution of reservoirs
!
-IF (HPHOTO=='NIT') THEN
+IF (IO%CPHOTO=='NIT') THEN
!
- PBIOMASS(:,3) = MAX(PBIOMASS(:,3),0.0)
+ PEK%XBIOMASS(:,3) = MAX(PEK%XBIOMASS(:,3),0.0)
!
-ELSEIF (HPHOTO=='NCB') THEN
+ELSEIF (IO%CPHOTO=='NCB') THEN
!
- ZBIOMASS(:,4) = PBIOMASS(:,4) + ZINCREASE(:,4) - ZDECLINE(:,4) - PRESP_BIOMASS(:,4)
+ ZBIOMASS(:,4) = PEK%XBIOMASS(:,4) + ZINCREASE(:,4) - ZDECLINE(:,4) - PEK%XRESP_BIOMASS(:,4)
!
!
- ZBIOMASS(:,5) = PBIOMASS(:,5)
- ZBIOMASS(:,6) = PBIOMASS(:,6)
- ZRESP(:) = PRESP_BIOMASS(:,5)
+ ZBIOMASS(:,5) = PEK%XBIOMASS(:,5)
+ ZBIOMASS(:,6) = PEK%XBIOMASS(:,6)
+ ZRESP(:) = PEK%XRESP_BIOMASS(:,5)
!
- DO JSPIN = 1, KSPINW
+ DO JSPIN = 1, IO%NSPINW
DO JI = 1,INI
- IF(GWOODY(JI))THEN
+ IF(OWOOD(JI))THEN
!Woody
ZBIOMASS(JI,5) = ZBIOMASS(JI,5) + ZINCREASE(JI,5) - ZDECLINE(JI,5) - ZRESP(JI)
ZBIOMASS(JI,6) = ZBIOMASS(JI,6) + ZINCREASE(JI,6) - ZDECLINE(JI,6)
- ZDECLINE(JI,5) = ZBIOMASS(JI,5)*(1.0-EXP((-1.0*XDAY)/PTAU_WOOD(JI)))
- ZDECLINE(JI,6) = ZBIOMASS(JI,6)*(1.0-EXP((-1.0*XDAY)/PTAU_WOOD(JI)))
- IF (PBIOMASS(JI,5) .gt. 0.0) ZRESP(JI) = PRESP_BIOMASS(JI,5)/PBIOMASS(JI,5) * ZBIOMASS(JI,5)
+ ZDECLINE(JI,5) = ZBIOMASS(JI,5)*(1.0-EXP((-1.0*XDAY)/PK%XTAU_WOOD(JI)))
+ ZDECLINE(JI,6) = ZBIOMASS(JI,6)*(1.0-EXP((-1.0*XDAY)/PK%XTAU_WOOD(JI)))
+ IF (PEK%XBIOMASS(JI,5).GT.0.0) &
+ ZRESP(JI) = PEK%XRESP_BIOMASS(JI,5)/PEK%XBIOMASS(JI,5) * ZBIOMASS(JI,5)
ELSE
!Herbaceous
ZBIOMASS(JI,5) = 0.
@@ -493,15 +467,15 @@ ELSEIF (HPHOTO=='NCB') THEN
ENDDO
ENDDO
!
- PBIOMASS(:,4) = ZBIOMASS(:,4)
- PBIOMASS(:,5) = ZBIOMASS(:,5)
- PBIOMASS(:,6) = ZBIOMASS(:,6)
+ PEK%XBIOMASS(:,4) = ZBIOMASS(:,4)
+ PEK%XBIOMASS(:,5) = ZBIOMASS(:,5)
+ PEK%XBIOMASS(:,6) = ZBIOMASS(:,6)
!
- PRESP_BIOMASS(:,4) = 0.0
- PRESP_BIOMASS(:,5) = 0.0
+ PEK%XRESP_BIOMASS(:,4) = 0.0
+ PEK%XRESP_BIOMASS(:,5) = 0.0
!
- PINCREASE(:,:) = ZINCREASE(:,:)
-!
+ PK%XINCREASE(:,:) = ZINCREASE(:,:)
+
ENDIF
!
IF (LHOOK) CALL DR_HOOK('NITRO_DECLINE',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/ocean_mercatorvergrid.F90 b/src/SURFEX/ocean_mercatorvergrid.F90
index 3561a0e257689983fc960b6d3ce97265f262a2bb..4fff9c1e803d8b6ced40a031587964d4afb2b960 100644
--- a/src/SURFEX/ocean_mercatorvergrid.F90
+++ b/src/SURFEX/ocean_mercatorvergrid.F90
@@ -44,6 +44,7 @@
!! Original 01/2008
! D.BARBARY 11/2014 : HPROGRAM,OUNIF in Calling OCEAN_MERCATORVERGRID
! Reading oceanic level and depth
+!! C. Lebeaupin Brossier, G. Faure 09/2016 : indice loop NOCKMIN+1 for XRAY
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -77,8 +78,6 @@ IF (LHOOK) CALL DR_HOOK('OCEAN_MERCATORVERGRID',0,ZHOOK_HANDLE)
! 2. Ocean Secondary Grids
! ---------------------
!
-!$OMP SINGLE
-!
ALLOCATE(XK1 (NOCKMIN:NOCKMAX))
ALLOCATE(XK2 (NOCKMIN:NOCKMAX))
ALLOCATE(XK3 (NOCKMIN:NOCKMAX))
@@ -107,13 +106,14 @@ ENDDO
!! ---------------
!
XK1(NOCKMIN) = 0.
+XK4(NOCKMIN) = 1. / ( XDZ1(NOCKMIN) * XDZ1(NOCKMIN) )
DO JLOOP = NOCKMIN+1,NOCKMAX
XK1(JLOOP) = -1. / (XDZ2(JLOOP)*XDZ1(JLOOP-1))
+ XK4(JLOOP) = 1. / (XDZ1(JLOOP)*XDZ1(JLOOP))
ENDDO
!
ZUP=1.
-DO JLOOP = NOCKMIN,NOCKMAX
- XK4(JLOOP) = 1. / ( XDZ1(JLOOP) * XDZ1(JLOOP) )
+DO JLOOP = NOCKMIN+1,NOCKMAX
ZDOWN = RAYO(XZ2(JLOOP))
XRAY(JLOOP) = ZUP - ZDOWN
ZUP = ZDOWN
@@ -127,11 +127,9 @@ ENDDO
XK2(NOCKMAX) = XK2(NOCKMAX-1)
XK3(NOCKMAX) = 0.
!
-!$OMP END SINGLE
-!
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('OCEAN_MERCATORVERGRID',1,ZHOOK_HANDLE)
- CONTAINS
+CONTAINS
!rayo
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/oi_acsolw.F90 b/src/SURFEX/oi_acsolw.F90
deleted file mode 100644
index e9b6ede6f1926afd20c64b31c255626a2df68357..0000000000000000000000000000000000000000
--- a/src/SURFEX/oi_acsolw.F90
+++ /dev/null
@@ -1,196 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE OI_ACSOLW (KST,KNBPT,&
-!-----------------------------------------------------------------------
-! - INPUT 1D
- PARG,PD2,PWS,PIVEG,PSAB,&
-! - INPUT LOGIQUE
- ODHMT,&
-! - OUTPUT 1D .
- PWFC,PWPMX,PWSAT,PWSMX,PWWILT)
-
-
-!**** *ACSOLW * - DETERMINATION DES CONTENUS EN EAU CARACTERISTIQUES DU SOL
-
-! Sujet.
-! ------
-
-! - ROUTINE DE CALCUL INTERMEDIAIRE.
-! DETERMINATION DES CONTENUS EN EAU CARACTERISTIQUES DU SOL.
-
-! SUR MER (PITM=0. , PIVEG=NTVMER )
-! wwilt=0. wfc=1. wsat=1.
-! SUR BANQUISE (PITM=1. , PIVEG=NTVGLA*1.1) (MODE CLIMAT SEULEMENT)
-! wwilt=0. wfc=1. wsat=1.
-! SUR GLACIER (PITM=1. , PIVEG=NTVGLA )
-! wwilt=f1(arg) wfc=f2(arg) wsat=wfc
-! SUR TERRE (PITM=1. , AUTRES PIVEG )
-! wwilt=f1(arg) wfc=f2(arg) wsat=f3(sab)
-
-!** Interface.
-! ----------
-! *CALL* *ACSOLW*
-
-!-----------------------------------------------------------------------
-! WARNING: THE ENGLISH VERSION OF VARIABLES' NAMES IS TO BE READ IN THE
-! "APLPAR" CODE.
-!-----------------------------------------------------------------------
-
-! - ARGUMENTS D'ENTREE.
-! -------------------
-
-! - NOM DES PARAMETRES DE DIMENSIONNEMENT DE LA PHYSIQUE.
-
-! KST : INDICE DE DEPART DES BOUCLES VECTORISEES SUR L'HORIZONT..
-! KNBPT : INDICE DE FIN DES BOUCLES VECTORISEES SUR L'HORIZONTALE.
-
-
-! - NOM DES CLES LOGIQUES
-
-! LDHMT : CALCULS REDUITS (POUR L'ANALYSE OU FULL-POS)
-! SEULS LES TABLEAUX (*) SONT UTILISES/CALCULES EN E/S
-
-! - NOM DES VARIABLES DE LA PHYSIQUE (PAR ORDRE ALPHABETIQUE DANS CHAQUE
-! CATEGORIE).
-
-! - 1D (GEOGRAPHIQUE) .
-
-! PARG (*) : POURCENTAGE D'ARGILE DANS LA MAILLE.
-! PD2 : EPAISSEUR DU RESERVOIR PROFOND.
-! PWS (*) : CONTENU EN EAU SUPERFICIEL (pour identification NATURE)
-! PIVEG : TYPE DE SURFACE (MER, BANQUISE OU GLACIER, TERRE).
-! PSAB : POURCENTAGE DE SABLE DANS LA MAILLE.
-
-!-----------------------------------------------------------------------
-
-! - ARGUMENTS DE SORTIE.
-! --------------------
-
-! - NOM DES VARIABLES DE LA PHYSIQUE (PAR ORDRE ALPHABETIQUE DANS CHAQUE
-! CATEGORIE).
-
-! - 1D (DIAGNOSTIQUE) .
-
-! PWFC (*) : TENEUR EN EAU A LA CAPACITE AUX CHAMPS.
-! PWPMX : TENEUR EN EAU MAXIMALE DU RESERVOIR PROFOND.
-! PWSAT : TENEUR EN EAU A LA SATURATION
-! PWSMX : TENEUR EN EAU MAXIMALE DU RESERVOIR DE SURFACE.
-! PWWILT (*) : TENEUR EN EAU CORRESPONDANT AU POINT DE FLETRISSEMENT.
-
-!-----------------------------------------------------------------------
-
-! - ARGUMENTS IMPLICITES.
-! ---------------------
-
-! COMMON/YOMPHY1/
-! the common that contains the parameters for the land surface part of the
-! physics of the model
-!-----------------------------------------------------------------------
-
-! Externes.
-! ---------
-
-! Methode.
-! --------
-
-! Auteur.
-! -------
-! 99-02, D. Giard, d'apres ACSOL
-
-! Modifications.
-! --------------
-!-----------------------------------------------------------------------
-!
-!
-USE MODD_ASSIM, ONLY : NTVGLA, XG1WSAT, XG2WSAT, XEWFC, XGWFC, XEWWILT, XGWWILT, XRD1, XREPS2
-USE MODD_CSTS, ONLY : XRHOLW
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-REAL ,INTENT(IN) :: PARG(KNBPT)
-REAL ,INTENT(IN) :: PD2(KNBPT)
-REAL ,INTENT(IN) :: PWS(KNBPT)
-REAL ,INTENT(IN) :: PIVEG(KNBPT)
-REAL ,INTENT(IN) :: PSAB(KNBPT)
-!
-LOGICAL, INTENT(IN) :: ODHMT
-!
-REAL ,INTENT(OUT) :: PWFC(KNBPT)
-REAL ,INTENT(OUT) :: PWPMX(KNBPT)
-REAL ,INTENT(OUT) :: PWSAT(KNBPT)
-REAL ,INTENT(OUT) :: PWSMX(KNBPT)
-REAL ,INTENT(OUT) :: PWWILT(KNBPT)
-!
-REAL :: ZARG, ZSAB
-INTEGER :: KNBPT, KST
-INTEGER :: JROF
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-! ** initialization of the parameters of the land surface part of
-! ** the physics of the model
-!
-! ------------------------------------------------------------------
-! I - CALCULS REDUITS DANS LE CAS LDHMT=.TRUE.
-! ----------------------------------------
-! REDUCED COMPUTATIONS IN CASE LDHMT=.T.
-! --------------------------------------
-!
-! ** WFC , WWILT **
-!
-IF (LHOOK) CALL DR_HOOK('OI_ACSOLW',0,ZHOOK_HANDLE)
-!
-DO JROF=KST,KNBPT
- IF ( PWS(JROF) == XUNDEF ) THEN
- PWWILT(JROF) = 0.0
- PWFC (JROF) = 1.0
- ELSE
- ZARG = MAX(XREPS2,PARG(JROF))
- PWWILT(JROF) = XGWWILT*(ZARG**XEWWILT)
- PWFC (JROF) = XGWFC *(ZARG**XEWFC)
- ENDIF
-ENDDO
-!
-IF (ODHMT .AND. LHOOK) CALL DR_HOOK('OI_ACSOLW',1,ZHOOK_HANDLE)
-IF (ODHMT) RETURN
-!
-! ------------------------------------------------------------------
-! II - CALCUL DES AUTRES CHAMPS
-! ------------------------
-! COMPUTING OTHER FIELDS
-! ----------------------
-!
-DO JROF=KST,KNBPT
-!
-! ** CAS DE LA BANQUISE EN MODE CLIMAT - SEA-ICE - (CLIMAT) **
-!
- IF ( NINT(10.*PIVEG(JROF))==(10*NTVGLA+1) ) THEN
- PWWILT(JROF) = 0.0
- PWFC (JROF) = 1.0
- ENDIF
-!
-! ** WSAT **
-!
- IF ( PWS(JROF)==XUNDEF .OR. NINT(PIVEG(JROF))==NTVGLA ) THEN
- PWSAT(JROF) = PWFC(JROF)
- ELSE
- ZSAB = MAX(XREPS2,PSAB(JROF))
- PWSAT(JROF) = XG1WSAT*ZSAB + XG2WSAT
- ENDIF
-!
-! ** WSMX , WPMX **
-!
- PWPMX(JROF) = PWSAT(JROF)*PD2(JROF)*XRHOLW
- PWSMX(JROF) = PWSAT(JROF)*XRD1*XRHOLW
-!
-ENDDO
-!
-IF (LHOOK) CALL DR_HOOK('OI_ACSOLW',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE OI_ACSOLW
diff --git a/src/SURFEX/oi_bc_soil_moisture.F90 b/src/SURFEX/oi_bc_soil_moisture.F90
deleted file mode 100644
index 7868d68699123f069af3ea21fea1050e48f6f357..0000000000000000000000000000000000000000
--- a/src/SURFEX/oi_bc_soil_moisture.F90
+++ /dev/null
@@ -1,88 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE OI_BC_SOIL_MOISTURE (KNBPT,&
-!---------------------------------------------------------------------------------
-! - INPUT 1D
- PSM_O,PSAB,&
-! - OUTPUT 1D .
- PWS_O)
-!
-!**** * BC_SOIL_MOISTURE * - BIAS CORRECTION OF ASCAT SUPERFICIAL SOIL MOISTURE
-
-! Purpose.
-! --------
-
-! - Use of CDF matching technique (Koster and Reichle, 2004)
-!
-
-!** Interface.
-! ----------
-! *CALL* *BC_SOIL_MOISTURE*
-
-!----------------------------------------------------------------------------------
-
-! Externals.
-! ---------
-
-! Method. 5th other polynomial correction
-! -------
-
-! Author.
-! -------
-! 09-06, J.-F. Mahfouf
-
-!-----------------------------------------------------------------------
-!
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-INTEGER, INTENT(IN) :: KNBPT
-!
-REAL ,INTENT(IN) :: PSM_O(KNBPT)
-REAL ,INTENT(IN) :: PSAB(KNBPT)
-!
-REAL ,INTENT(OUT) :: PWS_O(KNBPT)
-!
-REAL :: ZWSAT, ZA0, ZA1, ZA2, ZA3, ZA4, ZA5
-INTEGER :: JROF
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-! Coefficient for 5th order polynomial fit
-!
-IF (LHOOK) CALL DR_HOOK('OI_BC_SOIL_MOISTURE',0,ZHOOK_HANDLE)
-!
-ZA0 = 8.80461E-08
-ZA1 = -2.21598E-05
-ZA2 = 0.00188043
-ZA3 = -0.0575883
-ZA4 = 0.0249301
-ZA5 = 15.7502
-!
-! Perform the bias correction when observation available
-!
-DO JROF = 1,KNBPT
- !
- IF (PSM_O(JROF) /= 999.0) THEN
- !
- ZWSAT = -0.108*PSAB(JROF) + 0.494305
- !
- PWS_O(JROF) = ZA0*PSM_O(JROF)**5 + ZA1*PSM_O(JROF)**4 + ZA2*PSM_O(JROF)**3 + &
- ZA3*PSM_O(JROF)**2 + (1.+ZA4)*PSM_O(JROF) + ZA5
- !
- PWS_O(JROF) = PWS_O(JROF)*ZWSAT*0.01
- !
- ELSE
- PWS_O(JROF) = 999.0
- ENDIF
- !
-ENDDO
-!
-IF (LHOOK) CALL DR_HOOK('OI_BC_SOIL_MOISTURE',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE OI_BC_SOIL_MOISTURE
diff --git a/src/SURFEX/oi_cacsts.F90 b/src/SURFEX/oi_cacsts.F90
deleted file mode 100644
index a29845c0ae082f03ddee1ee2f9eb6484d0d5d64c..0000000000000000000000000000000000000000
--- a/src/SURFEX/oi_cacsts.F90
+++ /dev/null
@@ -1,523 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-!option! -O nomove
-!****---------------------------------------------------------------------------
-!**** CACSTS : INITIALIZES THE SURFACE FIELDS
-!**** ------
-!**** Auteurs : CB 01/91, BU 05/92, VC 05/93, DG 03/94, PA 09/95, DG 05/96
-!**** Mod : E. Bazile 01/97 Subtraction of the mean temperature and/or
-!**** humidity bias for the increments used for the
-!**** analysis of the soil water
-!**** Mod : D. Giard 03/99 ACSOL -> ACSOLW
-!**** E. Bazile , F. Bouyssel : logical LLLACW is replaced by a
-!**** continuous function ZDACW (LSOLV).
-!**** Mod : F. Taillefer 09/02 : update of surface constants according to SST
-!**** Mod : F. Bouyssel 02/04 : threshold using the solar zenithal angle
-!**** Mod : E. Bazile 01/2007 : Parameter for the correction PSNS and WPI
-! M.Hamrud 01-Jul-2006 Revised surface fields
-! A.Trojakova 27-Jun-2007 bugfixing ZV10M (surface pointers)
-! F. Bouyssel 27-Mar-2011 Use of REPS2 instead of REPS3 for ZNEI
-!****---------------------------------------------------------------------------
-!
-SUBROUTINE OI_CACSTS(KNBPT,PT2INC,PH2INC,PWGINC,PWS_O, &
- KDAT,KSSSSS, &
- PTP,PWP,PTL,PSNS,PTS,PWS, &
- PTCLS,PHCLS,PUCLS,PVCLS,PSSTC,PWPINC1,PWPINC2,PWPINC3, &
- PT2MBIAS,PH2MBIAS, &
- PRRCL,PRRSL,PRRCN,PRRSN,PATMNEB,PEVAP,PEVAPTR, &
- PITM,PVEG,PALBF,PEMISF,PZ0F, &
- PIVEG,PARG,PD2,PSAB,PLAI,PRSMIN,PZ0H, &
- PTSC,PTPC,PWSC,PWPC,PSNC,PGELAT,PGELAM,PGEMU)
-!
-!****---------------------------------------------------------------------------
-!** AIM : INITIALIZES THE PRONOSTIC SURFACE FIELDS
-!** ---
-!** SEQUENCE D'APPEL :
-!** ----------------
-!** CALL CACSTS(....)
-
-!** INPUT ARGUMENTS :
-!** ------------------
-!**
-!** - EXPLICIT -
-!** KNBPT : real number of treated points
-!** PT2INC : analysis increment of T2m
-!** PH2INC : analysis increment of Hu2m
-!** PSP_SB,PSP_SG,PSP_RR,PSD_VF,PSD_VV,PSD_VX,PSP_CI,PSP_X2 :
-!** buffer of pgd analysis fields
-!** PGELAM, PGELAT, PGEMU : geographical coordinates
-
-!** OUTPUT ARGUMENTS :
-!** -------------------
-!** EXTERN : CAVEGI (FCTVEG) - ACSOLW - TSL
-!** --------
-
-!** ALGORITHM : - INITIALIZES THE SURFACE TEMPERATURE.
-!** ---------- - INITIALIZES THE DEEP TEMPERATURE.
-!** - INITIALIZES THE SURFACE WATER TANK.
-!** - INITIALIZES THE DEEP WATER TANK.
-!** - CORRECTS THE SNOW AMOUNT.
-!***-----------------------------------------------------------------
-!
-USE MODD_CSTS, ONLY : XG, XTT, XRHOLW, XDAY
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_ASSIM
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODI_OI_CAVEGI
-USE MODI_OI_ACSOLW
-USE MODI_OI_JACOBIANS
-USE MODI_OI_TSL
-USE MODI_OI_FCTVEG
-USE MODI_OI_KALMAN_GAIN
-!
-IMPLICIT NONE
-!
-INTEGER,INTENT(IN) :: KNBPT, KDAT, KSSSSS
-!
-REAL ,INTENT(IN) :: PT2INC(KNBPT)
-REAL ,INTENT(IN) :: PH2INC(KNBPT)
-REAL ,INTENT(IN) :: PWGINC(KNBPT)
-REAL ,INTENT(IN) :: PWS_O(KNBPT)
-REAL ,INTENT(INOUT) :: PTP(KNBPT)
-REAL ,INTENT(INOUT) :: PWP(KNBPT)
-REAL ,INTENT(INOUT) :: PTL(KNBPT)
-REAL ,INTENT(INOUT) :: PSNS(KNBPT)
-REAL ,INTENT(INOUT) :: PTS(KNBPT)
-REAL ,INTENT(INOUT) :: PWS(KNBPT)
-REAL ,INTENT(INOUT) :: PTCLS(KNBPT)
-REAL ,INTENT(INOUT) :: PHCLS(KNBPT)
-REAL ,INTENT(INOUT) :: PUCLS(KNBPT)
-REAL ,INTENT(INOUT) :: PVCLS(KNBPT)
-REAL ,INTENT(INOUT) :: PSSTC(KNBPT)
-REAL ,INTENT(INOUT) :: PWPINC1(KNBPT)
-REAL ,INTENT(INOUT) :: PWPINC2(KNBPT)
-REAL ,INTENT(INOUT) :: PWPINC3(KNBPT)
-REAL ,INTENT(INOUT) :: PT2MBIAS(KNBPT)
-REAL ,INTENT(INOUT) :: PH2MBIAS(KNBPT)
-REAL ,INTENT(IN) :: PRRCL(KNBPT)
-REAL ,INTENT(IN) :: PRRSL(KNBPT)
-REAL ,INTENT(IN) :: PRRCN(KNBPT)
-REAL ,INTENT(IN) :: PRRSN(KNBPT)
-REAL ,INTENT(IN) :: PATMNEB(KNBPT)
-REAL ,INTENT(IN) :: PEVAP(KNBPT)
-REAL ,INTENT(IN) :: PEVAPTR(KNBPT)
-REAL ,INTENT(IN) :: PITM(KNBPT)
-REAL ,INTENT(IN) :: PVEG(KNBPT)
-REAL ,INTENT(INOUT) :: PALBF(KNBPT)
-REAL ,INTENT(INOUT) :: PEMISF(KNBPT)
-REAL ,INTENT(INOUT) :: PZ0F(KNBPT)
-REAL ,INTENT(INOUT) :: PIVEG(KNBPT)
-REAL ,INTENT(INOUT) :: PARG(KNBPT)
-REAL ,INTENT(INOUT) :: PD2(KNBPT)
-REAL ,INTENT(INOUT) :: PSAB(KNBPT)
-REAL ,INTENT(INOUT) :: PLAI(KNBPT)
-REAL ,INTENT(INOUT) :: PRSMIN(KNBPT)
-REAL ,INTENT(INOUT) :: PZ0H(KNBPT)
-REAL ,INTENT(IN) :: PTSC(KNBPT)
-REAL ,INTENT(IN) :: PTPC(KNBPT)
-REAL ,INTENT(IN) :: PWSC(KNBPT)
-REAL ,INTENT(IN) :: PWPC(KNBPT)
-REAL ,INTENT(IN) :: PSNC(KNBPT)
-REAL ,INTENT(IN) :: PGELAT(KNBPT)
-REAL ,INTENT(IN) :: PGELAM(KNBPT)
-REAL ,INTENT(IN) :: PGEMU(KNBPT)
-!
-REAL, DIMENSION(24) :: ZVGAT1,ZVGAT2,ZVGAT3,ZVGBT1,ZVGBT2,ZVGBT3,ZVGCT1,ZVGCT2
-REAL, DIMENSION(24) :: ZVGAH1,ZVGAH2,ZVGAH3,ZVGBH1,ZVGBH2,ZVGBH3,ZVGCH1,ZVGCH2
-REAL, DIMENSION(24) :: ZSIGT2MP,ZSIGHP2
-!
-REAL, DIMENSION(KNBPT) :: ZIVEG
-REAL, DIMENSION(KNBPT) :: ZWFC, ZWPMX, ZWSAT, ZWSMX, ZWWILT
-REAL, DIMENSION(KNBPT) :: ZDWG_DWG, ZDWG_DW2
-!
-REAL :: ZECHGU, ZNEI, ZCLI, ZPD, ZCLIMCA
-REAL :: ZTSC, ZTPC, ZWSC, ZWPC, ZSNC
-REAL :: ZV10M, ZPRECIP, ZWPI, ZDACW, ZDACW2, ZMU0, ZMU0M
-!
-REAL :: ZVGST,ZVGSH,ZVGPT1,ZVGPH1,ZVGPT2,ZVGPH2,ZG1,ZG2,ZG3,ZG4
-!
-REAL :: ZZT, ZZH, ZLAISRS, ZTEFF, ZHEFF
-REAL :: ZCWPH, ZCWPT, ZT2D, ZH2D
-REAL :: ZWSD, ZWPD, ZWPDX
-!
-REAL :: ZWSA, ZWSMIN, ZWPA, ZWPMIN
-REAL :: ZGEL, ZSNA, ZMSN, ZK1, ZK2
-!
-INTEGER :: IH, JROF
-LOGICAL :: GSGOBS
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!--------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('OI_CACSTS',0,ZHOOK_HANDLE)
-!
-ZECHGU = REAL(NECHGU) * 3600.
-!
-!** 1.1 Initialization of raw polynomials and reference fields.
-!
- CALL OI_CAVEGI(ZVGAT1,ZVGAT2,ZVGAT3,ZVGBT1,ZVGBT2,ZVGBT3,ZVGCT1,ZVGCT2, &
- ZVGAH1,ZVGAH2,ZVGAH3,ZVGBH1,ZVGBH2,ZVGBH3,ZVGCH1,ZVGCH2, &
- ZSIGT2MP,ZSIGHP2,GSGOBS)
-!
-!
-!* 1.2 Initialization of intermediate variables
-!
-DO JROF = 1,KNBPT
- ZIVEG(JROF) = ANINT(PIVEG(JROF))
-ENDDO
-!
- CALL OI_ACSOLW (1, KNBPT, &
- PARG, PD2, PWS, ZIVEG, PSAB, &
- LLDHMT, &
- ZWFC, ZWPMX, ZWSAT, ZWSMX, ZWWILT)
-!
-!* 1.3. Analytical Jacobians for WG assimilation
-!
- CALL OI_JACOBIANS (KNBPT,PWS_O,PSAB,PARG,PD2,PWP,ZDWG_DWG,ZDWG_DW2)
-!
-!**---------------------------------------------------------------------
-!** - 2 - Calculation of analysed fields.
-
-DO JROF = 1,KNBPT
-
-! surface analysis or de surface ou call back to climatology, on earth
-! IF (PITM(JROF) > 0.5.AND.(RCLIMCA >= 0.0).AND.PWS(JROF)/=XUNDEF) THEN
- IF ( PWS(JROF)/=XUNDEF ) THEN
-!
-! storage of forecast fields
- ZNEI = MAX(0.0,PSNS(JROF)/(PSNS(JROF)+XWCRIN))
-! update of climatological fields
- ZCLI = XRCLIMCA /(1.0+XRCLIMN*ZNEI)
-
- IF ( .NOT. LCLIM ) THEN
- ZTSC = PTS (JROF)
- ZTPC = PTP (JROF)
- ZWSC = PWS (JROF)
- ZWPC = PWP (JROF)
- ZSNC = PSNS(JROF)
- ELSE
- ZTSC = PTSC(JROF)
- ZTPC = PTPC(JROF)
- ZWSC = PWSC(JROF) * ZWSMX(JROF)
- ZWPC = PWPC(JROF) * ZWPMX(JROF)
- ZSNC = PSNC(JROF)
- ENDIF
-
-!-----------------------------------------------------------------------------------
-!
-!* 2.1 Temperature analysis
-!
-! transfer of 2m temperature increment on Ts and Tp with damping
-!
- IF ( NNEIGT<=0 .OR. ZNEI<XREPS2 ) THEN
- ZPD = 1.0
- ELSEIF ( XSNEIGT<XREPS3 ) THEN
- ZPD = 0.0
- ELSE
- ZPD = (1.0-MIN(ZNEI,XSNEIGT)/XSNEIGT)**NNEIGT
- ENDIF
-
- PTS(JROF) = PTS(JROF) + PT2INC(JROF)*ZPD
- PTP(JROF) = PTP(JROF) + PT2INC(JROF)*ZPD/(XSODELX(1)/XSODELX(0))
-
-! Call back of Ts
- ZCLIMCA = XRCLIMTS * ZCLI
- PTS(JROF) = (1.0-ZCLIMCA)*PTS(JROF) + ZCLIMCA*ZTSC
-
-! Call back of Tp
- ZCLIMCA = XRCLIMTP * XRCLIMCA
- PTP(JROF) = (1.0-ZCLIMCA)*PTP(JROF )+ ZCLIMCA*ZTPC
-
-!-----------------------------------------------------------------------------------
-!
-!* 2.2 Initializations for the surface analysis
-!
-! local conditions for the effective analysis of surface fields
-! calculation of the useful local solar time
-!
- CALL OI_TSL(KDAT,KSSSSS,PGELAT(JROF),PGELAM(JROF),ZMU0,ZMU0M,IH)
-!
- ZV10M = SQRT(PUCLS(JROF)**2+PVCLS(JROF)**2)
-!
- ZPRECIP = MAX(0.,PRRCL(JROF))+ MAX(0.,PRRSL(JROF)) &
- + MAX(0.,PRRCN(JROF))+ MAX(0.,PRRSN(JROF))
-!
- IF (LFGEL) THEN
- ZWPI = PTL(JROF)
- ELSE
- ZWPI = 0.0
- ENDIF
-!
-! Surface water forcing to the superficial reservoir
-!
- ZDACW = MIN(1.0,MAX(0.0,ABS(REAL(NINT(ZIVEG(JROF))-NTVGLA))) ) &
- * MIN(1.0,MAX(0.0,REAL(IH))) &
- * MIN(1.0,MAX(0.0,REAL(NIDJ)/REAL(NMINDJ))) &
- * MIN(1.0,MAX(0.0,1.0-ZV10M/(XV10MX+XREPS3))) &
- * MIN(1.0,MAX(0.0,1.0-ZPRECIP/(XSPRECIP+XREPS3))) &
- * MIN(1.0,MAX(0.0,1.0-ZWPI/XSICE))
-!
-! coefficients : depend on the solar zenithal angle
-!
- IF ( XSMU0>XREPS3 ) THEN
- ZPD = 0.5 * (1.0+TANH(XSMU0*(ZMU0M-0.5)))
- ELSE
- ZPD = 1.0
- ENDIF
- ZDACW = ZDACW * ZPD
-!
-! coefficients : depend on the surface evaporation
-!
-!* Threshold of min. evaporation for W analysis (SEVAP en mm/day)
- IF ( XSEVAP>XREPS3 ) THEN
- ZPD = MIN(1.0,MAX(0.0,PEVAP(JROF)/(-XSEVAP/XDAY)))
- ELSE
- ZPD = 1.0
- ENDIF
- ZDACW = ZDACW * ZPD
-!
-! coefficients : depend on the nebulosity
-!
- IF ( XANEBUL>XREPS3 ) THEN
- ZPD = 1.0 - XANEBUL*(PATMNEB(JROF)/ZECHGU)**NNEBUL
- ELSE
- ZPD = 1.0
- ENDIF
- ZDACW = ZDACW * ZPD
-!
-! coefficients : depend on the snow cover
-
- IF ( NNEIGW<=0 .OR. ZNEI<XREPS2 ) THEN
- ZPD = 1.0
- ELSEIF ( XSNEIGW<XREPS3 ) THEN
- ZPD = 0.0
- ELSE
- ZPD = ( 1.0 - MIN(ZNEI,XSNEIGW)/XSNEIGW)**NNEIGW
- ENDIF
- ZDACW = ZDACW * ZPD
-!
- ZDACW2 = MIN(1.0,MAX(0.0,1.0-(ZPRECIP+ABS(PEVAP(JROF)))/(XSPRECIP2+XREPS3))) &
- * MIN(1.0,MAX(0.0,1.0-ZWPI/XSICE))
-!
- ZDACW2 = ZDACW2 * ZPD
-
-
-!* 2.3 Humidity analysis by optimal interpolation for ISBA
-
-
-! coefficients : mainly depend on vegetation
-!
-! fctveg.h
-!****---------------Calculation of ZWSD and ZWPD------------------------------------
-!
- CALL OI_FCTVEG(IH,PVEG(JROF), &
- ZVGAT1,ZVGAT2,ZVGAT3,ZVGBT1,ZVGBT2,ZVGBT3,ZVGCT1,ZVGCT2, &
- ZVGAH1,ZVGAH2,ZVGAH3,ZVGBH1,ZVGBH2,ZVGBH3,ZVGCH1,ZVGCH2, &
- ZSIGT2MP,ZSIGHP2, &
- ZG1,ZG2,ZG3,ZG4, &
- ZVGST,ZVGSH,ZVGPT1,ZVGPH1,ZVGPT2,ZVGPH2)
-!
-! coefficients : depend on the observation errors
-! nb - in our case GSGOBS=.F.
-!
- IF ( GSGOBS ) THEN
- ZZT = ZG1 / ZG2
- ZZH = ZG3 / ZG4
- ELSE
- ZZT = 1.0
- ZZH = 1.0
- ENDIF
-
-! coefficients : depend on the texture
-!
- ZPD = (ZWFC(JROF)-ZWWILT(JROF))/XADWR
-
-! calculation of raw increments for ws=Ws/ds/ro, wp=Wp/dp/ro
-! final coefficients
-!
- ZZT = ZZT * ZPD * ZDACW
- ZZH = ZZH * ZPD * ZDACW
-!
- ZVGST = ZVGST * ZZT
- ZVGSH = ZVGSH * ZZH
-
- ZLAISRS = PLAI(JROF)/MAX(1.0,PRSMIN(JROF))
- ZCWPT = ( ZVGPT1 + ZLAISRS*ZVGPT2 ) * ZZT
- ZCWPH = ( ZVGPH1 + ZLAISRS*ZVGPH2 ) * ZZH
-!
-! possible limitation of increments for T2m and H2m
-! limitation of the absolute value of the increments
-!
- ZT2D = PT2INC(JROF)
- ZH2D = PH2INC(JROF)
- IF (XSIGT2MO < 0.0) ZT2D=MAX(XSIGT2MO,MIN(-XSIGT2MO,ZT2D))
- IF (XSIGH2MO < 0.0) ZH2D=MAX(XSIGH2MO,MIN(-XSIGH2MO,ZH2D))
-
-! removal of the mean bias
-! subtraction of mean biais if SCOEF(T/H) <> 1
-!
- PT2MBIAS(JROF) = PT2MBIAS(JROF)*(1.0-XSCOEFT) + ZT2D*XSCOEFT
- PH2MBIAS(JROF) = PH2MBIAS(JROF)*(1.0-XSCOEFH) + ZH2D*XSCOEFH
-
-! if the current bias is lower than the mean bias, it's set to zero
-! IF (ABS(ZT2D).LT.ABS(PSP_CI(JROF,YSP_CI%YCI(12)%MP0)) ZTEFF = 0.
-! IF (ABS(ZH2D).LT.ABS(PSP_CI(JROF,YSP_CI%YCI(13)%MP0)) ZHEFF = 0.
-! if the current bias is lower than the effective bias, it's kept
-!
- IF ( XSCOEFT/= 0.0 .OR. XSCOEFH/=0.0 ) THEN
- ZTEFF = ZT2D - PT2MBIAS(JROF)
- ZHEFF = ZH2D - PH2MBIAS(JROF)
- IF (ABS(ZT2D) < ABS(ZTEFF)) ZTEFF = ZT2D
- IF (ABS(ZH2D) < ABS(ZHEFF)) ZHEFF = ZH2D
- ZT2D = ZTEFF
- ZH2D = ZHEFF
- ENDIF
-
-! raw increments
-!
- IF ( LOBS2M .AND. (.NOT.LOBSWG .OR. PWGINC(JROF)==0.0) ) THEN
- ZWSD = XRSCALDW * (ZVGST*ZT2D + ZVGSH*ZH2D)
- ZWPD = XRSCALDW * (ZCWPT*ZT2D + ZCWPH*ZH2D)
- ELSEIF ( LOBSWG ) THEN
- CALL OI_KALMAN_GAIN(ZDWG_DWG(JROF),ZDWG_DW2(JROF),PD2(JROF),ZK1,ZK2)
- ZWSD = ZK1*ZDACW2*PWGINC(JROF)
- ZWPD = ZK2*ZDACW2*PWGINC(JROF)
- ELSE
- ZWSD = 0.0
- ZWPD = 0.0
- ENDIF
-
-! limitations on the corrections
-! no ws analysis if no evaporation on bare soil
-!
- IF (PEVAP(JROF)-PEVAPTR(JROF)>= 0.0 .AND. .NOT.LOBSWG) ZWSD = 0.0
-
-!===============================================================
-! Lower limit for Wp set to Wwilt instead of veg*Wwilt
-!===============================================================
-! ZZVEG = 1.0
-!=========================WS et WP================================
-
-! analysis of wp limited to assure veg*wwilt <= wp <= SWFC*wfc
- IF ( LIMVEG ) CALL GET_ZW(ZWPD,PWP(JROF),PD2(JROF))
-
- ! smoothing of analysis increments of wp
- IF ( LISSEW ) THEN
- ZWPDX = ZWPD
- IF ( NLISSEW >= 3 ) THEN
- ZWPD = 0.25*(PWPINC3(JROF)+PWPINC2(JROF)+PWPINC1(JROF)+ZWPDX)
- ELSE
- ZWPD = 0.0
- ENDIF
- IF ( NLISSEW >= 2 ) PWPINC3(JROF) = PWPINC2(JROF)
- IF ( NLISSEW >= 1 ) PWPINC2(JROF) = PWPINC1(JROF)
- PWPINC1(JROF) = ZWPDX
- ENDIF
-
-! analysis of ws limited to assure veg*wwilt <= ws <= SWFC*wfc
- IF ( LIMVEG ) CALL GET_ZW(ZWSD,PWS(JROF),XRD1)
-
-! transfer of the increments on Ws, Wp
-!
- ZWSA = PWS(JROF) + ZWSD * XRD1 * XRHOLW
- ZWSMIN = XREPS1 * XRD1 * XRHOLW
- PWS(JROF) = MAX(ZWSMIN,MIN(ZWSMX(JROF),ZWSA))
-
-! minimal total water contents
-!
- ZWPA = PWP(JROF) + ZWPD * PD2(JROF) * XRHOLW
- ZWPMIN = MAX(PWS(JROF), XREPS1 * PD2(JROF) * XRHOLW)
- PWP(JROF) = MAX(ZWPMIN,MIN(ZWPMX(JROF),ZWPA))
-
-! Call back of Ws
- ZCLIMCA = XRCLIMWS * ZCLI
- ZCLIMCA = ZCLIMCA*PVEG(JROF) + MIN(1.0,XRCLIMV*ZCLIMCA)*(1.0-PVEG(JROF))
- PWS(JROF) = (1.0-ZCLIMCA)*PWS(JROF) + ZCLIMCA*ZWSC
-
-! Call back of Wp
- ZCLIMCA = XRCLIMWP * ZCLI
- ZCLIMCA = ZCLIMCA*PVEG(JROF) + MIN(1.0,XRCLIMV*ZCLIMCA)*(1.0-PVEG(JROF))
- IF ( LFGEL ) THEN
- ZGEL = ZWPI / MAX(PWP(JROF)+ZWPI,XREPS3)
- ZWPC = ZWPC * (1.0 - MAX(0.0,MIN(1.0,ZGEL)))
- ZWPC = MAX(ZWPMIN,ZWPC)
- ENDIF
- PWP(JROF) = (1.0-ZCLIMCA)*PWP(JROF) + ZCLIMCA*ZWPC
-
-! call back of Sn with a possible correction for melting
-!
- ZSNA = (1.0-XRCLIMCA)*PSNS(JROF) + XRCLIMCA*ZSNC
- ZMSN = MAX(0.0, XRSNSA/21600.*ZECHGU*(PTCLS(JROF)-XTT))**XRSNSB
- PSNS(JROF) = MAX (ZSNA-ZMSN,0.0)
-
- IF (LFGEL) THEN
- ZMSN = MAX(0.0, XRWPIA/21600. * ZECHGU*(PTCLS(JROF)-XTT))**XRWPIB
- PTL(JROF)=MAX (ZWPI-ZMSN ,0.0)
- PWP(JROF)=PWP(JROF)-PTL(JROF)+ZWPI
- ENDIF
-
-!* 2.5 Call back of SST, on sea
-
-! ELSEIF ( PITM(JROF) <= 0.5 .AND. RCLISST /= 0. .AND. LCLIM ) THEN
-! PTS(JROF) = (1.0-RCLISST)*PTS(JROF) + RCLISST *PSSTC(JROF)
-! PTP(JROF) = PTS(JROF)
-! PWS(JROF) = XUNDEF
-! PWP(JROF) = XUNDEF
-! PTL(JROF) = 0.0
- ENDIF
-
-!* 2.6 Update of surface constants on sea, functions of ice field
-
- IF ( PITM(JROF) <= 0.5 ) THEN
- IF ( PTS(JROF) <= XTMERGL ) THEN
- PALBF (JROF) = XSALBB
- PEMISF(JROF) = XSEMIB
- PZ0F (JROF) = XSZZ0B*XG
- PZ0H (JROF) = XRZHZ0G * XSZZ0B*XG
- ELSE
- PALBF (JROF) = XSALBM
- PEMISF(JROF) = XSEMIM
- ENDIF
- ENDIF
-
-ENDDO
-
-IF (LHOOK) CALL DR_HOOK('OI_CACSTS',1,ZHOOK_HANDLE)
-
- CONTAINS
-
-SUBROUTINE GET_ZW(PWD,PIW,PD)
-!
-REAL, INTENT(INOUT) :: PWD
-REAL, INTENT(IN) :: PIW, PD
-REAL :: ZWR, ZWD1, ZWD2
-!
-ZWR = PIW / (PD*XRHOLW)
-!
-IF ( ZWR > ZWFC(JROF)*XSWFC ) THEN
- IF ( LHUMID ) THEN
- PWD = MIN(0.0,PWD)
- ELSE
- PWD = 0.0
- ENDIF
-ELSEIF ( ZWR < ZWWILT(JROF)*PVEG(JROF)) THEN
- IF (LHUMID) THEN
- PWD = MAX(0.0,PWD)
- ELSE
- PWD = 0.0
- ENDIF
-ELSE
- ZWD1 = ZWWILT(JROF)*PVEG(JROF) - ZWR
- ZWD2 = ZWFC(JROF)*XSWFC - ZWR
- PWD = MAX(ZWD1,MIN(ZWD2,PWD))
-ENDIF
-
-END SUBROUTINE
-!
-!**---------------------------------------------------------------------
-END SUBROUTINE OI_CACSTS
diff --git a/src/SURFEX/oi_cavegi.F90 b/src/SURFEX/oi_cavegi.F90
deleted file mode 100644
index 46bc08e3d7613bdd70a20d947481f0ae4bd5ff48..0000000000000000000000000000000000000000
--- a/src/SURFEX/oi_cavegi.F90
+++ /dev/null
@@ -1,73 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE OI_CAVEGI(PVGAT1,PVGAT2,PVGAT3,PVGBT1,PVGBT2,PVGBT3,PVGCT1,PVGCT2, &
- PVGAH1,PVGAH2,PVGAH3,PVGBH1,PVGBH2,PVGBH3,PVGCH1,PVGCH2, &
- PSIGT2MP,PSIGHP2,OSGOBS)
-!****------------------------------------------------------------------------
-USE MODD_ASSIM, ONLY : XSIGHP1, XSIGT2MR, XSIGH2MR, XSIGT2MO, XSIGH2MO, XREPS3
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-INTEGER :: J
-!
-REAL ,INTENT(OUT) :: PVGAT1(24),PVGAT2(24),PVGAT3(24)
-REAL ,INTENT(OUT) :: PVGBT1(24),PVGBT2(24),PVGBT3(24)
-REAL ,INTENT(OUT) :: PVGCT1(24),PVGCT2(24)
-REAL ,INTENT(OUT) :: PVGAH1(24),PVGAH2(24),PVGAH3(24)
-REAL ,INTENT(OUT) :: PVGBH1(24),PVGBH2(24),PVGBH3(24)
-REAL ,INTENT(OUT) :: PVGCH1(24),PVGCH2(24)
-REAL ,INTENT(OUT) :: PSIGT2MP(24),PSIGHP2(24)
-!
-LOGICAL :: OSGOBS
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!**---------------------------------------------------------------------
-!** 1. Initialisation des polynomes bruts et des champs de reference.
-!** -------------------------------------------------------------
-!
-! lecture des coefficients polynomiaux
-!
-IF (LHOOK) CALL DR_HOOK('OI_CAVEGI',0,ZHOOK_HANDLE)
-!
-DO J=1,24
-
- READ(61,'(6X,8F10.4)') PVGAT1(J),PVGAT2(J),PVGAT3(J),&
- PVGBT1(J),PVGBT2(J),PVGBT3(J),&
- PVGCT1(J),PVGCT2(J)
-
-ENDDO
-!
-DO J=1,24
-
- READ(61,'(6X,8F10.4)') PVGAH1(J),PVGAH2(J),PVGAH3(J),&
- PVGBH1(J),PVGBH2(J),PVGBH3(J),&
- PVGCH1(J),PVGCH2(J)
-
-ENDDO
-!
-DO J = 1,24
-
- PSIGT2MP(J) = MAX(.3 , 2.7*(1.0 - ((REAL(J)-15.)/9.)**2))
- PSIGHP2 (J) = (REAL(J)*2.0/3. - 15.)*1.E-2
-
-ENDDO
-!
-!**---------------------------------------------------------------------
-!** 3. Initialisation des variables internes.
-!** -------------------------------------
-!
-OSGOBS = XSIGT2MO > 0.0 .AND. XSIGH2MO > 0.0 .AND. &
- (ABS(XSIGH2MO-XSIGH2MR) > XREPS3 .OR. ABS(XSIGT2MO-XSIGT2MR) > XREPS3)
-
-IF (LHOOK) CALL DR_HOOK('OI_CAVEGI',1,ZHOOK_HANDLE)
-!
-!**---------------------------------------------------------------------
-END SUBROUTINE OI_CAVEGI
-
-
diff --git a/src/SURFEX/oi_control.F90 b/src/SURFEX/oi_control.F90
deleted file mode 100644
index 3917e90ca1f679aaceabaf47ee36a4f761a14a1f..0000000000000000000000000000000000000000
--- a/src/SURFEX/oi_control.F90
+++ /dev/null
@@ -1,1202 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE OI_CONTROL (YSC, &
- & LDINLINE, &
- & P__SURFTEMPERATURE, &
- & P__SURFPREC_EAU_CON, &
- & P__SURFPREC_EAU_GEC, &
- & P__SURFPREC_NEI_CON, &
- & P__SURFPREC_NEI_GEC, &
- & P__ATMONEBUL_BASSE, &
- & P__SURFXEVAPOTRANSP, &
- & P__SURFFLU_LAT_MEVA, &
- & P__SURFACCPLUIE, &
- & P__SURFACCNEIGE, &
- & P__SURFACCGRAUPEL, &
- & P__CLSTEMPERATURE, &
- & P__CLSHUMI_RELATIVE, &
- & P__CLSVENT_ZONAL, &
- & P__CLSVENT_MERIDIEN, &
- & P__SURFIND_TERREMER, &
- & P__SURFRESERV_NEIGE, &
- & P__LON, &
- & P__LAT, &
- & LD_MASKEXT)
-
-! ------------------------------------------------------------------------------------------
-! *****************************************************************************************
-!
-! Program to perform within SURFEX
-! a soil analysis for water content and temperature
-! using the Meteo-France optimum interpolation technique of Giard and Bazile (2000)
-!
-! Derived from CANARI subroutines externalized by Lora Taseva (Dec. 2007)
-!
-! Author : Jean-Francois Mahfouf (01/2008)
-!
-! Modifications :
-! (05/2008) : The I/O of this version follow the newly available LFI format in SURFEX
-! (01/2009) : Read directly atmospheric FA files using XRD library instead of using "edf"
-! (06/2009) : Modifications to allow the assimilation of ASCAT superficial soil moisture
-! (09/2010) : More parameters to goto_surfex
-! (03/2011) : Initialization of ZEVAPTR (F.Bouyssel)
-! (03/2013) : Use 10m wind from upperair instead surfex one (F.Taillefer)
-!
-! ******************************************************************************************
-! ------------------------------------------------------------------------------------------
-!
-!
-!
-!
-USE MODD_SURFEX_n, ONLY : SURFEX_t
-USE MODE_MODELN_SURFEX_HANDLER
-!
-USE MODD_TYPE_DATE_SURF
-USE MODD_CSTS, ONLY : XDAY, XPI, XRHOLW, XLVTT, NDAYSEC
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_ASSIM
-USE MODD_OL_FILEID
-
-USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
-USE MODD_SURFEX_OMP, ONLY : NINDX2SFX, NWORK, NWORK2, XWORK, XWORK2, XWORK3, &
- NWORK_FULL, NWORK2_FULL, XWORK_FULL, XWORK2_FULL
-
-USE MODN_IO_OFFLINE, ONLY : NAM_IO_OFFLINE, CNAMELIST, CSURF_FILETYPE
-
-
-#ifdef SFX_LFI
-USE MODD_IO_SURF_LFI,ONLY : CFILEIN_LFI, CFILEOUT_LFI, CFILEPGD_LFI, CFILEIN_LFI_SAVE
-#endif
-#ifdef SFX_FA
-USE MODD_IO_SURF_FA, ONLY : CFILEIN_FA, CFILEIN_FA_SAVE, CDNOMC, &
- NDGUX, NDLUX, PERPK, PELON0, PELAT0, &
- PEDELX, PEDELY, PELON1, PELAT1, PEBETA
-#endif
-#ifdef SFX_ARO
-USE MODD_IO_SURF_ARO,ONLY : NGPTOT, NGPTOT_CAP, NPROMA, NINDX1, NINDX2, NBLOCK, NKPROMA, &
- YSURFEX_CACHE_OUT, &
- SURFEX_FIELD_BUF_PREALLOC, SURFEX_FIELD_BUF_SET_RECORD
-USE MODD_SURFEX_ARO, ONLY : YSURFEX_ARO_ALL, YSURFEX_ARO_CUR
-#endif
-
-USE MODE_POS_SURF, ONLY : POSNAM
-
-USE MODI_OPEN_NAMELIST
-USE MODI_CLOSE_NAMELIST
-USE MODI_READ_ALL_NAMELISTS
-USE MODI_INI_DATA_COVER
-USE MODI_INIT_IO_SURF_n
-USE MODI_READ_SURF
-USE MODI_SET_SURFEX_FILEIN
-USE MODI_GET_SIZE_FULL_n
-USE MODI_READ_COVER_n
-USE MODI_CONVERT_COVER_FRAC
-USE MODI_GET_1D_MASK
-USE MODI_END_IO_SURF_n
-USE MODI_IO_BUFF_CLEAN
-USE MODI_OI_BC_SOIL_MOISTURE
-USE MODI_OI_LATLON_CONF_PROJ
-USE MODI_OI_CACSTS
-USE MODI_OI_HOR_EXTRAPOL_SURF
-USE MODI_FLAG_UPDATE
-USE MODI_WRITE_SURF
-
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-
-IMPLICIT NONE
-!
-TYPE(SURFEX_t), INTENT(INOUT) :: YSC
-!
-LOGICAL, INTENT (IN) :: LDINLINE
-REAL(KIND=JPRB), OPTIONAL, DIMENSION (:) :: P__SURFTEMPERATURE
-REAL(KIND=JPRB), OPTIONAL, DIMENSION (:) :: P__SURFPREC_EAU_CON
-REAL(KIND=JPRB), OPTIONAL, DIMENSION (:) :: P__SURFPREC_EAU_GEC
-REAL(KIND=JPRB), OPTIONAL, DIMENSION (:) :: P__SURFPREC_NEI_CON
-REAL(KIND=JPRB), OPTIONAL, DIMENSION (:) :: P__SURFPREC_NEI_GEC
-REAL(KIND=JPRB), OPTIONAL, DIMENSION (:) :: P__ATMONEBUL_BASSE
-REAL(KIND=JPRB), OPTIONAL, DIMENSION (:) :: P__SURFXEVAPOTRANSP
-REAL(KIND=JPRB), OPTIONAL, DIMENSION (:) :: P__SURFFLU_LAT_MEVA
-REAL(KIND=JPRB), OPTIONAL, DIMENSION (:) :: P__SURFACCPLUIE
-REAL(KIND=JPRB), OPTIONAL, DIMENSION (:) :: P__SURFACCNEIGE
-REAL(KIND=JPRB), OPTIONAL, DIMENSION (:) :: P__SURFACCGRAUPEL
-REAL(KIND=JPRB), OPTIONAL, DIMENSION (:) :: P__CLSTEMPERATURE
-REAL(KIND=JPRB), OPTIONAL, DIMENSION (:) :: P__CLSHUMI_RELATIVE
-REAL(KIND=JPRB), OPTIONAL, DIMENSION (:) :: P__CLSVENT_ZONAL
-REAL(KIND=JPRB), OPTIONAL, DIMENSION (:) :: P__CLSVENT_MERIDIEN
-REAL(KIND=JPRB), OPTIONAL, DIMENSION (:) :: P__SURFIND_TERREMER
-REAL(KIND=JPRB), OPTIONAL, DIMENSION (:) :: P__SURFRESERV_NEIGE
-REAL(KIND=JPRB), OPTIONAL, DIMENSION (:) :: P__LON
-REAL(KIND=JPRB), OPTIONAL, DIMENSION (:) :: P__LAT
-LOGICAL, OPTIONAL, DIMENSION (:) :: LD_MASKEXT
-
-INTEGER :: IGPCOMP
-INTEGER :: IDAT
-
- CHARACTER(LEN=28) :: YNAMELIST = 'OPTIONS.nam '
-
-! Declarations of local variables
-
- CHARACTER(LEN=6) :: YPROGRAM
- CHARACTER(LEN=6), PARAMETER :: YPROGRAM2 = 'FA '
- CHARACTER(LEN=2) :: CMONTH
-INTEGER :: IYEAR ! current year (UTC)
-INTEGER :: IMONTH ! current month (UTC)
-INTEGER :: IDAY ! current day (UTC)
-INTEGER :: NSSSSS ! current time since start of the run (s)
-INTEGER :: IRESP ! return code
-TYPE (DATE_TIME) :: TTIME ! Current date and time
-INTEGER :: ISIZE
-INTEGER :: ISIZE1
-LOGICAL :: LLKEEPEXTZONE
-
-! Arrays for soil OI analysis
-REAL, DIMENSION (:,:), ALLOCATABLE :: PWS, PWP, PTS, PTP, PTL, PSNS, PRSMIN, PD2, PLAI, PVEG
-REAL, DIMENSION (:), ALLOCATABLE :: PSST, PSAB, PARG, PLAT, PLON, PTCLS, PHCLS, PUCLS, PVCLS, &
- & PEVAP, PEVAPTR, PT2M_O, PHU2M_O, PTS_O, ZT2INC, ZH2INC, &
- & ZWS, ZWP, ZTL, ZTS, ZTP, ZTCLS, ZHCLS, ZUCLS, ZVCLS, &
- & PSSTC, PWPINC1, PWPINC2, PWPINC3, PT2MBIAS, PH2MBIAS, &
- & PRRCN, PRRCL, PRRSN, PRRSL, PATMNEB, PITM, PALBF, PEMISF, &
- & PZ0F, PIVEG, PZ0H, PTSC, PTPC, PWSC, PWPC, PSNC, ZEVAP, &
- & ZEVAPTR, PGELAT, PGELAM, PGEMU, ZWSINC, ZWPINC, ZTSINC, &
- & ZTPINC, ZTLINC, ZSNINC, ZSNS, ZPX, ZPY, PSM_O, PSIG_SMO, &
- & PLSM_O, PWS_O, ZWGINC, PLST, PTRD3, ZSST, ZLST, ZALT
-REAL, DIMENSION (:), ALLOCATABLE :: ZSST1, ZLST1, PSST1, PLST1, PLAT1, PLON1, ZALT1
-
-INTEGER :: IVERSION, IBUGFIX
-INTEGER :: JJ,J1
- CHARACTER(LEN=10) :: YVAR ! Name of the prognostic variable (in LFI file)
- CHARACTER(LEN=100) :: YPREFIX ! Prefix of the prognostic variable (in LFI file)
-INTEGER :: ILUOUT ! ascii output unit number
-INTEGER :: INOBS ! number of observations
-INTEGER :: ILUNAM
-LOGICAL :: GFOUND
-
-REAL :: PLAT0,PLON0,PRPK,PLATOR,PLONOR,DELX,DELY,PBETA,ZTHRES
-REAL(KIND=JPRB) :: Z1S2PI, ZPIS180
-
-LOGICAL, DIMENSION(:), ALLOCATABLE :: OINTERP_LST, OINTERP_SST
-LOGICAL, DIMENSION(:), ALLOCATABLE :: OINTERP_LST1, OINTERP_SST1
-
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-! ----------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK ('OI_CONTROL', 0, ZHOOK_HANDLE)
-
-PRINT *,'--------------------------------------------------------------------------'
-PRINT *,'| |'
-PRINT *,'| ENTER OI_ASSIM |'
-PRINT *,'| |'
-PRINT *,'--------------------------------------------------------------------------'
-
- CALL OPEN_NAMELIST('ASCII ',ILUNAM,CNAMELIST)
- CALL POSNAM(ILUNAM,'NAM_IO_OFFLINE',GFOUND)
-IF (GFOUND) READ (UNIT=ILUNAM,NML=NAM_IO_OFFLINE)
- CALL CLOSE_NAMELIST('ASCII ',ILUNAM)
-
-!
- CALL READ_ALL_NAMELISTS(YSC,CSURF_FILETYPE,'ALL',.FALSE.)
-!
-IF (LDINLINE) THEN
-
- YPROGRAM = 'AROME'
-#ifdef SFX_ARO
- IGPCOMP = MIN (NGPTOT, NGPTOT_CAP)
-
- NBLOCK = 1
- NINDX1 = 1 + (NBLOCK - 1) * NPROMA
- NINDX2 = MIN (NBLOCK * NPROMA, IGPCOMP)
- NKPROMA = NINDX2 - NINDX1 + 1
- YSURFEX_ARO_CUR => YSURFEX_ARO_ALL(NBLOCK)
-#endif
-
-ELSE
-
- YPROGRAM = 'LFI'
-
-ENDIF
-
-ICURRENT_MODEL = 1
-
-ILUOUT = 111
-LLKEEPEXTZONE = .FALSE.
-
-Z1S2PI=1.0_JPRB/(2.0_JPRB*XPI)
-ZPIS180=XPI/180.0_JPRB
-
-! Update some constants dependant from NACVEG
-
-! scaling of soil moisture increments when assimilation window is different from 6 hours
-XRSCALDW = REAL(NECHGU)/6.0_JPRB
-! half assimilation window in sec
-NITRAD = NECHGU*1800
-
- CALL INI_DATA_COVER(YSC%DTCO, YSC%U)
-
-! File handling definition
-
-IF (.NOT. LDINLINE) THEN
-#ifdef SFX_LFI
- CFILEPGD_LFI = 'PGD'
- CFILEIN_LFI = 'PREP' ! input PREP file (surface fields)
- CFILEIN_LFI_SAVE = CFILEIN_LFI
-#endif
-ENDIF
-
-! Read grid dimension for allocation
-
- CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
- YPROGRAM,'FULL ','SURF ','READ ')
-
-! Find current time
-
- CALL READ_SURF(&
- YPROGRAM,'DTCUR',TTIME,IRESP)
-
-! Time initializations
-
-IYEAR = TTIME%TDATE%YEAR
-IMONTH = TTIME%TDATE%MONTH
-IDAY = TTIME%TDATE%DAY
-NSSSSS = TTIME%TIME
-IF (NSSSSS > NDAYSEC) NSSSSS = NSSSSS - NDAYSEC
-
-! Reading grid characteristics to perform nature mask
-
- CALL END_IO_SURF_n(YPROGRAM)
- CALL SET_SURFEX_FILEIN(YPROGRAM,'PGD ') ! change input file name to pgd name
- CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
- YPROGRAM,'FULL ','SURF ','READ ')
-
- CALL READ_SURF(&
- YPROGRAM,'SEA ',YSC%U%CSEA ,IRESP)
- CALL READ_SURF(&
- YPROGRAM,'WATER ',YSC%U%CWATER ,IRESP)
- CALL READ_SURF(&
- YPROGRAM,'NATURE',YSC%U%CNATURE,IRESP)
- CALL READ_SURF(&
- YPROGRAM,'TOWN ',YSC%U%CTOWN ,IRESP)
-
- CALL READ_SURF(&
- YPROGRAM,'DIM_FULL ',YSC%U%NDIM_FULL, IRESP)
-NINDX2SFX = YSC%U%NDIM_FULL
- CALL END_IO_SURF_n(YPROGRAM)
- CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
- YPROGRAM,'FULL ','SURF ','READ ')
-
- CALL READ_SURF(&
- YPROGRAM,'DIM_SEA ',YSC%U%NDIM_SEA, IRESP)
- CALL READ_SURF(&
- YPROGRAM,'DIM_NATURE',YSC%U%NDIM_NATURE,IRESP)
- CALL READ_SURF(&
- YPROGRAM,'DIM_WATER ',YSC%U%NDIM_WATER, IRESP)
- CALL READ_SURF(&
- YPROGRAM,'DIM_TOWN ',YSC%U%NDIM_TOWN, IRESP)
-
-ALLOCATE(NWORK(YSC%U%NDIM_FULL))
-ALLOCATE(XWORK(YSC%U%NDIM_FULL))
-ALLOCATE(NWORK2(YSC%U%NDIM_FULL,10))
-ALLOCATE(XWORK2(YSC%U%NDIM_FULL,10))
-ALLOCATE(XWORK3(YSC%U%NDIM_FULL,10,10))
-IF (NRANK==NPIO) THEN
- ALLOCATE(NWORK_FULL(YSC%U%NDIM_FULL))
- ALLOCATE(XWORK_FULL(YSC%U%NDIM_FULL))
- ALLOCATE(NWORK2_FULL(YSC%U%NDIM_FULL,10))
- ALLOCATE(XWORK2_FULL(YSC%U%NDIM_FULL,10))
-ELSE
- ALLOCATE(NWORK_FULL(0))
- ALLOCATE(XWORK_FULL(0))
- ALLOCATE(NWORK2_FULL(0,0))
- ALLOCATE(XWORK2_FULL(0,0))
-ENDIF
-!
-! Get total dimension of domain (excluding extension zone)
-
- CALL GET_SIZE_FULL_n(YSC%U, &
- YPROGRAM,YSC%U%NDIM_FULL,YSC%U%NSIZE_FULL)
-
-IF (LDINLINE) THEN
- ISIZE = YSC%U%NSIZE_FULL
-ELSE
- ISIZE = YSC%U%NDIM_FULL
-ENDIF
-
-ALLOCATE (PSAB(ISIZE))
-ALLOCATE (PARG(ISIZE))
-ALLOCATE (ZALT(ISIZE))
-
- CALL READ_SURF(&
- YPROGRAM,'SAND', PSAB, IRESP)
- CALL READ_SURF(&
- YPROGRAM,'CLAY', PARG, IRESP)
- CALL READ_SURF(&
- YPROGRAM,'ZS', ZALT, IRESP)
-
- CALL READ_COVER_n(YSC%DTCO, YSC%U, &
- YPROGRAM)
-
-! Perform masks (only nature used)
-
-ALLOCATE(YSC%U%XSEA (ISIZE))
-ALLOCATE(YSC%U%XNATURE(ISIZE))
-ALLOCATE(YSC%U%XWATER (ISIZE))
-ALLOCATE(YSC%U%XTOWN (ISIZE))
-
- CALL CONVERT_COVER_FRAC(YSC%DTCO, &
- YSC%U%XCOVER,YSC%U%LCOVER,YSC%U%XSEA,YSC%U%XNATURE,YSC%U%XTOWN,YSC%U%XWATER)
-
-YSC%U%NSIZE_NATURE = COUNT(YSC%U%XNATURE(:) > 0.0)
-YSC%U%NSIZE_TOWN = COUNT(YSC%U%XTOWN(:) > 0.0)
-YSC%U%NSIZE_WATER = COUNT(YSC%U%XWATER(:) > 0.0)
-YSC%U%NSIZE_SEA = COUNT(YSC%U%XSEA(:) > 0.0)
-
-ALLOCATE(YSC%U%NR_NATURE (YSC%U%NSIZE_NATURE))
-ALLOCATE(YSC%U%NR_TOWN (YSC%U%NSIZE_TOWN ))
-ALLOCATE(YSC%U%NR_WATER (YSC%U%NSIZE_WATER ))
-ALLOCATE(YSC%U%NR_SEA (YSC%U%NSIZE_SEA ))
-
- CALL GET_1D_MASK( YSC%U%NSIZE_SEA, ISIZE, YSC%U%XSEA , YSC%U%NR_SEA )
- CALL GET_1D_MASK( YSC%U%NSIZE_WATER, ISIZE, YSC%U%XWATER , YSC%U%NR_WATER )
- CALL GET_1D_MASK( YSC%U%NSIZE_TOWN, ISIZE, YSC%U%XTOWN , YSC%U%NR_TOWN )
- CALL GET_1D_MASK( YSC%U%NSIZE_NATURE, ISIZE, YSC%U%XNATURE, YSC%U%NR_NATURE)
-
-! Allocate arrays
-
-YSC%IM%I%NPATCH = 1
-
-ALLOCATE (PWS(ISIZE,1))
-ALLOCATE (PWP(ISIZE,1))
-ALLOCATE (PTS(ISIZE,1))
-ALLOCATE (PTP(ISIZE,1))
-ALLOCATE (PTL(ISIZE,1))
-ALLOCATE (PSST(ISIZE))
-ALLOCATE (PSNS(ISIZE,1))
-ALLOCATE (PLAI(ISIZE,1))
-ALLOCATE (PVEG(ISIZE,1))
-ALLOCATE (PRSMIN(ISIZE,1))
-ALLOCATE (PD2(ISIZE,1))
-ALLOCATE (PTCLS(ISIZE))
-ALLOCATE (PHCLS(ISIZE))
-ALLOCATE (PUCLS(ISIZE))
-ALLOCATE (PVCLS(ISIZE))
-ALLOCATE (PEVAP(ISIZE))
-ALLOCATE (PLST(ISIZE))
-ALLOCATE (PTRD3(ISIZE))
-
-ALLOCATE (OINTERP_LST(ISIZE))
-ALLOCATE (OINTERP_SST(ISIZE))
-ALLOCATE (ZLST(ISIZE))
-ALLOCATE (ZSST(ISIZE))
-
-! Read prognostic variables
-
- CALL END_IO_SURF_n(YPROGRAM)
- CALL SET_SURFEX_FILEIN(YPROGRAM,'PREP') ! change input file name to pgd name
- CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
- YPROGRAM,'FULL ','SURF ','READ ')
-
-IF (YSC%U%NSIZE_NATURE>0 .AND. YSC%U%CNATURE/='NONE') THEN
- CALL READ_SURF(&
- YPROGRAM,'WG1', PWS, IRESP)
- CALL READ_SURF(&
- YPROGRAM,'WG2', PWP, IRESP)
- CALL READ_SURF(&
- YPROGRAM,'TG1', PTS, IRESP)
- CALL READ_SURF(&
- YPROGRAM,'TG2', PTP, IRESP)
- CALL READ_SURF(&
- YPROGRAM,'WGI2', PTL, IRESP)
-
- CALL READ_SURF(&
- YPROGRAM,'VERSION',IVERSION,IRESP)
- CALL READ_SURF(&
- YPROGRAM,'BUG',IBUGFIX,IRESP)
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
- CALL READ_SURF(&
- YPROGRAM,'WSN_VEG1',PSNS, IRESP)
- ELSE
- CALL READ_SURF(&
- YPROGRAM,'WSNOW_VEG1',PSNS, IRESP)
- ENDIF
-ENDIF
-
-IF (YSC%U%NSIZE_SEA>0 .AND. YSC%U%CSEA/='NONE') THEN
- CALL READ_SURF(&
- YPROGRAM,'SST', PSST, IRESP)
-ENDIF
-
-IF (YSC%U%NSIZE_WATER>0 .AND. YSC%U%CWATER/='NONE') THEN
- CALL READ_SURF(&
- YPROGRAM,'TS_WATER', PLST, IRESP)
-ENDIF
-
-IF (YSC%U%NSIZE_TOWN>0 .AND. YSC%U%CTOWN/='NONE' .AND. LAROME) THEN
- CALL READ_SURF(&
- YPROGRAM,'VERSION',IVERSION,IRESP)
- CALL READ_SURF(&
- YPROGRAM,'BUG',IBUGFIX,IRESP)
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
- CALL READ_SURF(&
- YPROGRAM,'TROAD3', PTRD3, IRESP)
- ELSE
- CALL READ_SURF(&
- YPROGRAM,'T_ROAD3', PTRD3, IRESP)
- ENDIF
-ELSE
- PTRD3(:) = XUNDEF
-ENDIF
-
- CALL READ_SURF(&
- YPROGRAM,'T2M', PTCLS, IRESP)
- CALL READ_SURF(&
- YPROGRAM,'HU2M', PHCLS, IRESP)
-
-! Read constant surface fields
-
- CALL READ_SURF(&
- YPROGRAM,'RSMIN', PRSMIN,IRESP)
- CALL READ_SURF(&
- YPROGRAM,'DG2', PD2, IRESP)
- CALL READ_SURF(&
- YPROGRAM,'LAI', PLAI, IRESP)
- CALL READ_SURF(&
- YPROGRAM,'VEG', PVEG, IRESP)
-
-IF (NPRINTLEV>0) THEN
- JJ = YSC%U%NR_NATURE(1)
- PRINT *,'value in PREP file => WG1 ',PWS(JJ,1)
- PRINT *,'value in PREP file => WG2 ',PWP(JJ,1)
- PRINT *,'value in PREP file => TG1 ',PTS(JJ,1)
- PRINT *,'value in PREP file => TG2 ',PTP(JJ,1)
- PRINT *,'value in PREP file => WGI2 ',PTL(JJ,1)
- PRINT *,'value in PREP file => WSNOW_VEG1',PSNS(JJ,1)
- PRINT *,'value in PREP file => SST ',PSST(JJ)
- PRINT *,'value in PREP file => LAI ',PLAI(JJ,1)
- PRINT *,'value in PREP file => VEG ',PVEG(JJ,1)
- PRINT *,'value in PREP file => RSMIN ',PRSMIN(JJ,1)
- PRINT *,'value in PREP file => DATA_DG2 ',PD2(JJ,1)
- PRINT *,'value in PREP file => SAND ',PSAB(JJ)
- PRINT *,'value in PREP file => CLAY ',PARG(JJ)
- PRINT *,'value in PREP file => ZS ',ZALT(JJ)
-ENDIF
-
- CALL END_IO_SURF_n(YPROGRAM)
- CALL IO_BUFF_CLEAN
-
-! Interface (allocate arrays)
-
-ALLOCATE (PLAT(ISIZE))
-ALLOCATE (PLON(ISIZE))
-ALLOCATE (ZPX(ISIZE))
-ALLOCATE (ZPY(ISIZE))
-ALLOCATE (PEVAPTR(ISIZE))
-ALLOCATE (ZWP(ISIZE))
-ALLOCATE (ZWS(ISIZE))
-ALLOCATE (ZTL(ISIZE))
-ALLOCATE (ZTS(ISIZE))
-ALLOCATE (ZTP(ISIZE))
-ALLOCATE (ZSNS(ISIZE))
-ALLOCATE (ZTCLS(ISIZE))
-ALLOCATE (ZHCLS(ISIZE))
-ALLOCATE (ZUCLS(ISIZE))
-ALLOCATE (ZVCLS(ISIZE))
-ALLOCATE (PSSTC(ISIZE))
-ALLOCATE (PWPINC1(ISIZE))
-ALLOCATE (PWPINC2(ISIZE))
-ALLOCATE (PWPINC3(ISIZE))
-ALLOCATE (PT2MBIAS(ISIZE))
-ALLOCATE (PH2MBIAS(ISIZE))
-ALLOCATE (PRRCN(ISIZE))
-ALLOCATE (PRRCL(ISIZE))
-ALLOCATE (PRRSN(ISIZE))
-ALLOCATE (PRRSL(ISIZE))
-ALLOCATE (PATMNEB(ISIZE))
-ALLOCATE (PITM(ISIZE))
-ALLOCATE (PALBF(ISIZE))
-ALLOCATE (PEMISF(ISIZE))
-ALLOCATE (PZ0F(ISIZE))
-ALLOCATE (PIVEG(ISIZE))
-ALLOCATE (PZ0H(ISIZE))
-ALLOCATE (PTSC(ISIZE))
-ALLOCATE (PTPC(ISIZE))
-ALLOCATE (PWSC(ISIZE))
-ALLOCATE (PWPC(ISIZE))
-ALLOCATE (PSNC(ISIZE))
-ALLOCATE (ZEVAP(ISIZE))
-ALLOCATE (ZEVAPTR(ISIZE))
-ALLOCATE (PGELAT(ISIZE))
-ALLOCATE (PGELAM(ISIZE))
-ALLOCATE (PGEMU(ISIZE))
-ALLOCATE (PT2M_O(ISIZE))
-ALLOCATE (PHU2M_O(ISIZE))
-ALLOCATE (PTS_O(ISIZE))
-ALLOCATE (PSM_O(ISIZE))
-ALLOCATE (PSIG_SMO(ISIZE))
-ALLOCATE (PLSM_O(ISIZE))
-ALLOCATE (PWS_O(ISIZE))
-ALLOCATE (ZWGINC(ISIZE))
-
-IF (.NOT. LDINLINE) THEN
-
-! Read atmospheric forecast fields from FA files
-#ifdef SFX_FA
- CFILEIN_FA = 'FG_OI_MAIN' ! input forecast
- CFILEIN_FA_SAVE = CFILEIN_FA
-#endif
-! Open FA file (LAM version with extension zone)
- CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
- YPROGRAM2,'EXTZON','SURF ','READ ')
-ENDIF
-
-! Read model forecast quantities
-
-IF (LAROME) THEN
- IF (LDINLINE) THEN
- PRRSL(:) = P__SURFACCPLUIE (1:ISIZE)
- PRRSN(:) = P__SURFACCNEIGE (1:ISIZE)
- PRRCN(:) = P__SURFACCGRAUPEL (1:ISIZE)
- ELSE
- CALL READ_SURF(&
- YPROGRAM2,'SURFACCPLUIE', PRRSL ,IRESP)
- CALL READ_SURF(&
- YPROGRAM2,'SURFACCNEIGE', PRRSN ,IRESP)
- CALL READ_SURF(&
- YPROGRAM2,'SURFACCGRAUPEL', PRRCN ,IRESP)
- ENDIF
- PRRCL(:) = 0.0
-! CALL READ_SURF(YPROGRAM2,'SURFIND.VEG.DOMI',PIVEG ,IRESP)
- PIVEG(:) = 0.0
-ELSE
- IF (LDINLINE) THEN
- PRRCL(:) = P__SURFPREC_EAU_CON (1:ISIZE)
- PRRSL(:) = P__SURFPREC_EAU_GEC (1:ISIZE)
- PRRCN(:) = P__SURFPREC_NEI_CON (1:ISIZE)
- PRRSN(:) = P__SURFPREC_NEI_GEC (1:ISIZE)
- ELSE
- CALL READ_SURF(&
- YPROGRAM2,'SURFPREC.EAU.CON',PRRCL ,IRESP)
- CALL READ_SURF(&
- YPROGRAM2,'SURFPREC.EAU.GEC',PRRSL ,IRESP)
- CALL READ_SURF(&
- YPROGRAM2,'SURFPREC.NEI.CON',PRRCN ,IRESP)
- CALL READ_SURF(&
- YPROGRAM2,'SURFPREC.NEI.GEC',PRRSN ,IRESP)
- ENDIF
- PIVEG(:) = 0.0
-ENDIF
-IF (LDINLINE) THEN
- PATMNEB(:) = P__ATMONEBUL_BASSE (1:ISIZE)
- PITM(:) = P__SURFIND_TERREMER (1:ISIZE)
- PEVAP(:) = P__SURFFLU_LAT_MEVA (1:ISIZE)
-ELSE
- CALL READ_SURF(&
- YPROGRAM2,'ATMONEBUL.BASSE ',PATMNEB,IRESP)
- CALL READ_SURF(&
- YPROGRAM2,'SURFIND.TERREMER',PITM ,IRESP)
- CALL READ_SURF(&
- YPROGRAM2,'SURFFLU.LAT.MEVA',PEVAP ,IRESP) ! accumulated fluxes (not available in LFI)
-ENDIF
-IF (.NOT.LALADSURF) THEN
- IF (LDINLINE) THEN
- PEVAPTR(:) = P__SURFXEVAPOTRANSP (1:ISIZE)
- ELSE
- CALL READ_SURF(&
- YPROGRAM2,'SURFXEVAPOTRANSP',PEVAPTR,IRESP) ! not in ALADIN SURFEX
- ENDIF
-ELSE
- PEVAPTR(:) = 0.0
-ENDIF
-
-IF (.NOT. LDINLINE) THEN
-! Close FA file
- CALL END_IO_SURF_n(YPROGRAM2)
- CALL IO_BUFF_CLEAN
- PRINT *,'READ FG_OI_MAIN OK'
-ENDIF
-
-IF (.NOT. LDINLINE) THEN
-! Define FA file name for CANARI analysis
-#ifdef SFX_FA
- CFILEIN_FA = 'CANARI' ! input CANARI analysis
- CFILEIN_FA_SAVE = CFILEIN_FA
-#endif
-! Open FA file
- CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
- YPROGRAM2,'EXTZON','SURF ','READ ')
-ENDIF
-
-IF (LDINLINE) THEN
- PT2M_O(:) = P__CLSTEMPERATURE (1:ISIZE)
- PHU2M_O(:) = P__CLSHUMI_RELATIVE (1:ISIZE)
- PTS_O(:) = P__SURFTEMPERATURE (1:ISIZE)
- PUCLS(:) = P__CLSVENT_ZONAL (1:ISIZE)
- PVCLS(:) = P__CLSVENT_MERIDIEN (1:ISIZE)
-ELSE
-! Read CANARI analysis
- CALL READ_SURF(&
- YPROGRAM2,'CLSTEMPERATURE ',PT2M_O ,IRESP)
- CALL READ_SURF(&
- YPROGRAM2,'CLSHUMI.RELATIVE',PHU2M_O,IRESP)
- CALL READ_SURF(&
- YPROGRAM2,'SURFTEMPERATURE ',PTS_O ,IRESP)
- CALL READ_SURF(&
- YPROGRAM2,'CLSVENT.ZONAL ',PUCLS ,IRESP)
- CALL READ_SURF(&
- YPROGRAM2,'CLSVENT.MERIDIEN',PVCLS ,IRESP)
-ENDIF
-
-IF (.NOT. LDINLINE) THEN
-! Close CANARI file
- CALL END_IO_SURF_n(YPROGRAM2)
- CALL IO_BUFF_CLEAN
- PRINT *,'READ CANARI OK'
-ENDIF
-
-! Read ASCAT SM observations (in percent)
-
-INOBS = 0
-IF (LOBSWG) THEN
- OPEN(UNIT=111,FILE='ASCAT_SM.DAT')
- DO JJ=1,YSC%U%NDIM_FULL
- READ(111,*,END=990) PSM_O(JJ),PSIG_SMO(JJ),PLSM_O(JJ)
- IF (PLSM_O(JJ) < 1.0) PSM_O(JJ) = 999.0 ! data rejection if not on land
- IF (PSIG_SMO(JJ) > XSIGWGO_MAX) PSM_O(JJ) = 999.0 ! data rejection of error too large
- IF (PSM_O(JJ) /= 999.0) INOBS = INOBS + 1
- ENDDO
-990 CONTINUE
- CLOSE(UNIT=111)
- PRINT *,'READ ASCAT SM OK'
-ELSE
- PSM_O(:) = 999.0
- PSIG_SMO(:) = 999.0
- PLSM_O(:) = 0.0
-ENDIF
-PRINT *,' NUMBER OF ASCAT OBSERVATIONS AFTER INITIAL CHECKS :: ',INOBS
-INOBS = 0
-
-! Perform bias correction of SM observations
-
- CALL OI_BC_SOIL_MOISTURE(ISIZE,PSM_O,PSAB,PWS_O)
-
-IF (.NOT. LDINLINE) THEN
-! Define FA file name for surface climatology
-#ifdef SFX_FA
- CFILEIN_FA = 'clim_isba' ! input climatology
- CFILEIN_FA_SAVE = CFILEIN_FA
- CDNOMC = 'climat' ! new frame name
-#endif
-! Open FA file
- CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
- YPROGRAM2,'EXTZON','SURF ','READ ')
-ENDIF
-
-IF (LDINLINE) THEN
- PSNC(:) = P__SURFRESERV_NEIGE (1:ISIZE)
-ELSE
-! Read climatology file (snow water equivalent)
- CALL READ_SURF(&
- YPROGRAM2,'SURFRESERV.NEIGE',PSNC ,IRESP)
-ENDIF
-
-IF (.NOT. LDINLINE) THEN
-! Close climatology file
- CALL END_IO_SURF_n(YPROGRAM2)
- CALL IO_BUFF_CLEAN
- PRINT *,'READ CLIMATOLOGY OK'
-ENDIF
-
-IF (.NOT. LDINLINE) THEN
-#ifdef SFX_FA
- PLAT0 = PELAT0
- PLON0 = PELON0
- PLATOR = PELAT1
- PLONOR = PELON1
- PRPK = PERPK
- PBETA = PEBETA
- DELX = PEDELX
- DELY = PEDELY
- IF (PLONOR > 180.0) PLONOR = PLONOR - 360.0
- IF (PLON0 > 180.0) PLON0 = PLON0 - 360.0
- DO JJ=1,NDGUX
- DO J1=1,NDLUX
- ZPX((JJ-1)*NDLUX + J1) = DELX*REAL(J1-1)
- ZPY((JJ-1)*NDLUX + J1) = DELY*REAL(JJ-1)
- ENDDO
- ENDDO
-#endif
- CALL OI_LATLON_CONF_PROJ(ISIZE,PLAT0,PLON0,PRPK,PBETA,PLATOR,PLONOR,ZPX,ZPY,PLAT,PLON)
-ELSE
- PLAT(:) = P__LAT (1:ISIZE)
- PLON(:) = P__LON (1:ISIZE)
-ENDIF
-
-! Allocate arrays to produce analysis increments
-
-ALLOCATE (ZT2INC(ISIZE))
-ALLOCATE (ZH2INC(ISIZE))
-ALLOCATE (ZWSINC(ISIZE))
-ALLOCATE (ZWPINC(ISIZE))
-ALLOCATE (ZTLINC(ISIZE))
-ALLOCATE (ZTSINC(ISIZE))
-ALLOCATE (ZTPINC(ISIZE))
-ALLOCATE (ZSNINC(ISIZE))
-
-! Screen-level innovations
-
-ZT2INC(:) = PT2M_O(:) - PTCLS(:)
-ZH2INC(:) = PHU2M_O(:) - PHCLS(:)
-
-! Threshold for background check
-
-ZTHRES=XRTHR_QC*SQRT(XSIGWGO**2 + XSIGWGB**2)
-
-! Superficial soil moisture innovations in (m3/m3)
-
-DO JJ = 1, ISIZE
- IF (PWS_O(JJ) /= 999.0) THEN
- ZWGINC(JJ) = PWS_O(JJ) - PWS(JJ,1)
- IF (ABS(ZWGINC(JJ)) > ZTHRES) THEN
- ZWGINC(JJ) = 0.0 ! background check
- ELSE
- INOBS = INOBS + 1
- ENDIF
- ELSE
- ZWGINC(JJ) = 0.0
- ENDIF
-ENDDO
-PRINT *,' NUMBER OF ASCAT OBSERVATIONS AFTER BACKGROUND CHECK :: ',INOBS
-
-! Interface (define arrays and perform unit conversions)
-
-PARG(:) = PARG(:)*100.0
-PSAB(:) = PSAB(:)*100.0
-
-ZWS(:) = XUNDEF
-ZWP(:) = XUNDEF
-ZTL(:) = XUNDEF
-
-WHERE (PWS(:,1)/=XUNDEF)
- ZWS(:) = PWS(:,1)*XRD1*XRHOLW ! conversion of m3/m3 -> mm
- ZWP(:) = PWP(:,1)*PD2(:,1)*XRHOLW ! conversion of m3/m3 -> mm
- ZTL(:) = PTL(:,1)*PD2(:,1)*XRHOLW ! conversion of m3/m3 -> mm
-END WHERE
-
-ZTCLS(:) = PTCLS(:)
-ZHCLS(:) = PHCLS(:)
-ZUCLS(:) = PUCLS(:)
-ZVCLS(:) = PVCLS(:)
-PSSTC(:) = PTS_O(:)
-PWPINC1(:) = XUNDEF
-PWPINC2(:) = XUNDEF
-PWPINC3(:) = XUNDEF
-PT2MBIAS(:) = XUNDEF
-PH2MBIAS(:) = XUNDEF
-
-! Sea-ice surface properties
-
-PALBF(:) = XUNDEF
-PEMISF(:) = XUNDEF
-PZ0F(:) = XUNDEF
-PZ0H(:) = XUNDEF
-
-! Climatological arrays set to missing values
-
-PSNC(:) = PSNS(:,1) ! need to read the snow climatology
-PWSC(:) = XUNDEF
-PWPC(:) = XUNDEF
-PTSC(:) = XUNDEF
-PTPC(:) = XUNDEF
-
-DO JJ = 1, ISIZE
- PGELAT(JJ) = PLAT(JJ)
- PGELAM(JJ) = PLON(JJ)
- PGEMU(JJ) = SIN(PLAT(JJ)*ZPIS180)
-ENDDO
-
-ZEVAP(:) = (PEVAP(:)/XLVTT*XDAY)/(NECHGU*3600.) ! conversion W/m2 -> mm/day
-ZEVAPTR(:) = PEVAPTR(:)*XDAY
-ZSNS(:) = PSNS(:,1)
-
-DO JJ = 1, ISIZE
- ZTS(JJ) = PTS(JJ,1)
- ZTP(JJ) = PTP(JJ,1)
-ENDDO
-
-IDAT = IYEAR*10000. + IMONTH*100. + IDAY
-
-IF (LDINLINE) THEN
-! Avoid division by zero in next WHERE statement;
-! this may occur in the extension zone
- WHERE (LD_MASKEXT (1:ISIZE))
- PD2(:,1) = 1.0
- ZT2INC(:) = 0.0_JPRB
- ZH2INC(:) = 0.0_JPRB
- END WHERE
-ENDIF
-
-PRINT *,' '
-PRINT *,'Mean T2m increments ',SUM(ZT2INC)/YSC%U%NDIM_FULL
-PRINT *,'Mean HU2m increments ',SUM(ZH2INC)/YSC%U%NDIM_FULL
-PRINT *,' '
-
-! Soil analysis based on optimal interpolation
-
- CALL OI_CACSTS(ISIZE,ZT2INC,ZH2INC,ZWGINC,PWS_O, &
- IDAT,NSSSSS, &
- ZTP,ZWP,ZTL,ZSNS,ZTS,ZWS, &
- ZTCLS,ZHCLS,ZUCLS,ZVCLS,PSSTC,PWPINC1,PWPINC2,PWPINC3, &
- PT2MBIAS,PH2MBIAS, &
- PRRCL,PRRSL,PRRCN,PRRSN,PATMNEB,ZEVAP,ZEVAPTR, &
- PITM,PVEG(:,1),PALBF,PEMISF,PZ0F, &
- PIVEG,PARG,PD2(:,1),PSAB,PLAI(:,1),PRSMIN(:,1),PZ0H, &
- PTSC,PTPC,PWSC,PWPC,PSNC, &
- PGELAT,PGELAM,PGEMU)
-
-! Store increments
-
-ZWSINC(:) = 0.0_JPRB
-ZWPINC(:) = 0.0_JPRB
-ZTLINC(:) = 0.0_JPRB
-ZSNINC(:) = 0.0_JPRB
-
-WHERE (PWS(:,1)/=XUNDEF)
- ZWSINC(:) = ZWS(:) - PWS(:,1)*(XRD1*XRHOLW)
- ZWPINC(:) = ZWP(:) - PWP(:,1)*(PD2(:,1)*XRHOLW)
- ZTLINC(:) = ZTL(:) - PTL(:,1)*(PD2(:,1)*XRHOLW)
- ZSNINC(:) = ZSNS(:) - PSNS(:,1)
-END WHERE
-
-IF (LDINLINE) THEN
-! Avoid division by zero in next WHERE statement;
-! this may occur in the extension zone
- WHERE (LD_MASKEXT (1:ISIZE))
- PD2(:,1) = 1.0
- END WHERE
-ENDIF
-
-! Define soil moiture analyses over NATURE points
-
-WHERE (PWS(:,1)/=XUNDEF)
- PWS(:,1) = ZWS(:)/(XRD1*XRHOLW)
- PWP(:,1) = ZWP(:)/(PD2(:,1)*XRHOLW)
- PTL(:,1) = ZTL(:)/(PD2(:,1)*XRHOLW)
- PSNS(:,1) = ZSNS(:)
-END WHERE
-
-! Perform temperature analysis according to surface types
-
-OINTERP_LST(:) = .FALSE.
-OINTERP_SST(:) = .FALSE.
-
-ZTSINC(:) = 0.0_JPRB
-ZTPINC(:) = 0.0_JPRB
-
-! a) Temperature analysis of NATURE points
-
-WHERE (PTS(:,1)/=XUNDEF)
- ZTSINC(:) = ZTS(:) - PTS(:,1)
- ZTPINC(:) = ZTP(:) - PTP(:,1)
- PTS(:,1) = ZTS(:)
- PTP(:,1) = ZTP(:)
-END WHERE
-
-! b) Temperature analysis of SEA and LAKE points
-
-DO JJ = 1, ISIZE
- IF (PITM(JJ) < 0.5_JPRB) THEN
- IF (PSST(JJ)/=XUNDEF) THEN
- ZTSINC(JJ) = PTS_O(JJ) - PSST(JJ)
- PSST(JJ) = PTS_O(JJ) ! canari
- ENDIF
- IF (PLST(JJ)/=XUNDEF) THEN
- PLST(JJ) = PTS_O(JJ) ! canari
- ENDIF
- ELSE
- IF (PSST(JJ)/=XUNDEF) THEN
- PSST(JJ) = XUNDEF
- OINTERP_SST(JJ) = .TRUE.
- ENDIF
- IF (PLST(JJ)/=XUNDEF) THEN
- PLST(JJ) = XUNDEF
- OINTERP_LST(JJ) = .TRUE.
- ENDIF
- ENDIF
-ENDDO
-
-! c) Temperature analysis of TOWN points
-
-WHERE (PTRD3(:)/=XUNDEF)
- PTRD3(:) = PTRD3(:) + ZT2INC(:)*Z1S2PI
-END WHERE
-
-! Search for the nearest grid point values for lake and sea points
-! at locations where the water fraction is less than 50 %
-! and therefore no useful information is given from the SST analysis
-! A standard temperature gradient is applied to account for the atitude differences
-
-IF (LDINLINE) THEN
-
- IF (LLKEEPEXTZONE) THEN
-
- ZLST(:) = PLST(:)
-
- IF (LDINLINE) THEN
- WHERE (LD_MASKEXT (1:ISIZE))
- ZLST = XUNDEF
- END WHERE
- ENDIF
-
- CALL OI_HOR_EXTRAPOL_SURF(ISIZE,PLAT,PLON,ZLST,PLAT,PLON,PLST,OINTERP_LST,ZALT)
-
- ZSST(:) = PSST(:)
-
- IF (LDINLINE) THEN
- WHERE (LD_MASKEXT (1:ISIZE))
- ZSST = XUNDEF
- END WHERE
- ENDIF
-
- CALL OI_HOR_EXTRAPOL_SURF(ISIZE,PLAT,PLON,ZSST,PLAT,PLON,PSST,OINTERP_SST,ZALT)
-
- ELSE
-
- ISIZE1 = COUNT (.NOT. LD_MASKEXT)
-
- ALLOCATE (PSST1 (ISIZE1), PLST1 (ISIZE1), ZSST1 (ISIZE1), ZLST1 (ISIZE1), PLAT1 (ISIZE1), &
- & PLON1 (ISIZE1), ZALT1 (ISIZE1), OINTERP_LST1 (ISIZE1), OINTERP_SST1 (ISIZE1))
-
- ! remove extension zone
- JJ = 1
- DO J1 = 1, ISIZE
- IF (.NOT. LD_MASKEXT (J1)) THEN
- PSST1 (JJ) = PSST (J1)
- PLST1 (JJ) = PLST (J1)
- PLAT1 (JJ) = PLAT (J1)
- PLON1 (JJ) = PLON (J1)
- ZALT1 (JJ) = ZALT (J1)
- OINTERP_LST1 (JJ) = OINTERP_LST (J1)
- OINTERP_SST1 (JJ) = OINTERP_SST (J1)
- JJ = JJ + 1
- ENDIF
- ENDDO
-
- ZLST1(:) = PLST1(:)
- CALL OI_HOR_EXTRAPOL_SURF(ISIZE1,PLAT1,PLON1,ZLST1,PLAT1,PLON1,PLST1,OINTERP_LST1,ZALT1)
-
- ZSST1(:) = PSST1(:)
- CALL OI_HOR_EXTRAPOL_SURF(ISIZE1,PLAT1,PLON1,ZSST1,PLAT1,PLON1,PSST1,OINTERP_SST1,ZALT1)
-
- ! copy back
- JJ = 1
- DO J1 = 1, ISIZE
- IF (.NOT. LD_MASKEXT (J1)) THEN
- PSST (J1) = PSST1 (JJ)
- PLST (J1) = PLST1 (JJ)
- JJ = JJ + 1
- ENDIF
- ENDDO
-
- DEALLOCATE (PSST1, PLST1, ZSST1, ZLST1, PLAT1, PLON1, &
- & ZALT1, OINTERP_LST1, OINTERP_SST1)
-
- ENDIF
-
-ELSE
-
- ZLST(:) = PLST(:)
- CALL OI_HOR_EXTRAPOL_SURF(ISIZE,PLAT,PLON,ZLST,PLAT,PLON,PLST,OINTERP_LST,ZALT)
-
- ZSST(:) = PSST(:)
- CALL OI_HOR_EXTRAPOL_SURF(ISIZE,PLAT,PLON,ZSST,PLAT,PLON,PSST,OINTERP_SST,ZALT)
-
-ENDIF
-
-! PRINT values produced by OI_HO_EXTRAPOL_SURF
-
-IF (NPRINTLEV>0) THEN
- DO JJ = 1, ISIZE
- IF (OINTERP_LST(JJ)) THEN
- PRINT *,'Lake surface temperature set to ',PLST(JJ),'from nearest neighbour at J=',JJ
- ENDIF
- IF (OINTERP_SST(JJ)) THEN
- PRINT *,'Sea surface temperature set to ',PSST(JJ),'from nearest neighbour at J=',JJ
- ENDIF
- ENDDO
-ENDIF
-
-! PRINT statistics of the soil analysis
-
-PRINT *,'---------------------------------------------------------------'
-PRINT *,'Mean WS increments over NATURE ',SUM(ZWSINC,YSC%U%XNATURE > 0.)/YSC%U%NDIM_NATURE
-PRINT *,'Mean WP increments over NATURE ',SUM(ZWPINC,YSC%U%XNATURE > 0.)/YSC%U%NDIM_NATURE
-PRINT *,'Mean TS increments over NATURE ',SUM(ZTSINC,YSC%U%XNATURE > 0.)/YSC%U%NDIM_NATURE
-PRINT *,'Mean TP increments over NATURE ',SUM(ZTPINC,YSC%U%XNATURE > 0.)/YSC%U%NDIM_NATURE
-PRINT *,'Mean TL increments over NATURE ',SUM(ZTLINC,YSC%U%XNATURE > 0.)/YSC%U%NDIM_NATURE
-PRINT *,'Mean SN increments over NATURE ',SUM(ZSNINC,YSC%U%XNATURE > 0.)/YSC%U%NDIM_NATURE
-PRINT *,'---------------------------------------------------------------'
-PRINT *,'Mean WS increments over SEA ',SUM(ZWSINC,YSC%U%XSEA > 0.)/YSC%U%NDIM_SEA
-PRINT *,'Mean WP increments over SEA ',SUM(ZWPINC,YSC%U%XSEA > 0.)/YSC%U%NDIM_SEA
-PRINT *,'Mean TS increments over SEA ',SUM(ZTSINC,YSC%U%XSEA > 0.)/YSC%U%NDIM_SEA
-PRINT *,'Mean TP increments over SEA ',SUM(ZTPINC,YSC%U%XSEA > 0.)/YSC%U%NDIM_SEA
-PRINT *,'Mean TL increments over SEA ',SUM(ZTLINC,YSC%U%XSEA > 0.)/YSC%U%NDIM_SEA
-PRINT *,'Mean SN increments over SEA ',SUM(ZSNINC,YSC%U%XSEA > 0.)/YSC%U%NDIM_SEA
-PRINT *,'---------------------------------------------------------------'
-
-IF (.NOT. LDINLINE) THEN
-! Write analysis in LFI file PREP
-#ifdef SFX_LFI
- CFILEOUT_LFI='PREP'
-#endif
-ENDIF
-
- CALL FLAG_UPDATE(YSC%IM%DGI, YSC%DGU, &
- .FALSE.,.FALSE.,.TRUE.,.FALSE.)
- CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
- YPROGRAM,'FULL ','SURF ','WRITE')
-
-IF (LDINLINE) THEN
-#ifdef SFX_ARO
-! Count 2D fields in MSE
-! NINDX1, NINDX2, NKPROMA already set
- CALL SURFEX_FIELD_BUF_SET_RECORD (YSURFEX_CACHE_OUT, .FALSE.)
-
- CALL WRITE
-
- CALL SURFEX_FIELD_BUF_PREALLOC (YSURFEX_CACHE_OUT)
- CALL SURFEX_FIELD_BUF_SET_RECORD (YSURFEX_CACHE_OUT, .TRUE.)
-
-#endif
-
-ENDIF
-
- CALL WRITE
-
- CALL END_IO_SURF_n(YPROGRAM)
- CALL IO_BUFF_CLEAN
-
-DEALLOCATE(NWORK)
-DEALLOCATE(XWORK)
-DEALLOCATE(NWORK2)
-DEALLOCATE(XWORK2)
-DEALLOCATE(XWORK3)
-DEALLOCATE(NWORK_FULL)
-DEALLOCATE(XWORK_FULL)
-DEALLOCATE(NWORK2_FULL)
-DEALLOCATE(XWORK2_FULL)
-
-IF (.NOT. LDINLINE) THEN
- PRINT *,'after write in PREP file'
-ENDIF
-
-! -------------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK ('OI_CONTROL', 1, ZHOOK_HANDLE)
-
- CONTAINS
-
-SUBROUTINE WRITE
-
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
-IF (LHOOK) CALL DR_HOOK ('OI_CONTROL:WRITE', 0, ZHOOK_HANDLE)
-
- CALL DD ('WG1', PWS (:,1))
-
-YVAR='WG1'
-YPREFIX='X_Y_WG1 (m3/m3) '
- CALL WRITE_SURF(YSC%DGU, YSC%U, &
- YPROGRAM,YVAR,PWS,IRESP,HCOMMENT=YPREFIX)
-
- CALL DD ('WG2', PWP (:,1))
-
-YVAR='WG2'
-YPREFIX='X_Y_WG2 (m3/m3) '
- CALL WRITE_SURF(YSC%DGU, YSC%U, &
- YPROGRAM,YVAR,PWP,IRESP,HCOMMENT=YPREFIX)
-
- CALL DD ('WGI2', PTL (:,1))
-
-YVAR='WGI2'
-YPREFIX='X_Y_WGI2 (m3/m3) '
- CALL WRITE_SURF(YSC%DGU, YSC%U, &
- YPROGRAM,YVAR,PTL,IRESP,HCOMMENT=YPREFIX)
-
- CALL DD ('TG1', PTS (:,1))
-
-YVAR='TG1'
-YPREFIX='X_Y_TG1 (K) '
- CALL WRITE_SURF(YSC%DGU, YSC%U, &
- YPROGRAM,YVAR,PTS,IRESP,HCOMMENT=YPREFIX)
-
- CALL DD ('TG2', PTP (:,1))
-
-YVAR='TG2'
-YPREFIX='X_Y_TG2 (K) '
- CALL WRITE_SURF(YSC%DGU, YSC%U, &
- YPROGRAM,YVAR,PTP,IRESP,HCOMMENT=YPREFIX)
-
- CALL DD ('SST', PSST)
-
-YVAR='SST'
-YPREFIX='X_Y_SST (K) '
- CALL WRITE_SURF(YSC%DGU, YSC%U, &
- YPROGRAM,YVAR,PSST,IRESP,HCOMMENT=YPREFIX)
-
- CALL DD ('TS_WATER', PLST)
-
-YVAR='TS_WATER'
-YPREFIX='X_Y_TS_WATER (K) '
- CALL WRITE_SURF(YSC%DGU, YSC%U, &
- YPROGRAM,YVAR,PLST,IRESP,HCOMMENT=YPREFIX)
-
-IF (YSC%U%NSIZE_TOWN > 0 .AND. LAROME) THEN
- CALL DD ('T_ROAD3', PTRD3)
-
- YVAR='TROAD3'
- YPREFIX='X_Y_T_ROAD3 (K) '
- CALL WRITE_SURF(YSC%DGU, YSC%U, &
- YPROGRAM,YVAR,PTRD3,IRESP,HCOMMENT=YPREFIX)
-ENDIF
-
- CALL DD ('WSNOW_VEG1', PSNS (:,1))
-
-YVAR='WSN_VEG1'
-YPREFIX='X_Y_WSNOW_VEG1 (kg/m2) '
- CALL WRITE_SURF(YSC%DGU, YSC%U, &
- YPROGRAM,YVAR,PSNS,IRESP,HCOMMENT=YPREFIX)
-
-IF (LHOOK) CALL DR_HOOK ('OI_CONTROL:WRITE', 1, ZHOOK_HANDLE)
-
-END SUBROUTINE WRITE
-
-SUBROUTINE DD (CDN, PX)
- CHARACTER(LEN=*), INTENT (IN) :: CDN
-REAL, INTENT (IN) :: PX (:)
-
-REAL :: ZX (SIZE (PX))
-INTEGER :: JI, JN
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
-IF (LHOOK) CALL DR_HOOK ('OI_CONTROL:DD', 0, ZHOOK_HANDLE)
-
-IF (LDINLINE) THEN
-#ifdef SFX_ARO
- IF (LHOOK) CALL DR_HOOK ('OI_CONTROL:DD', 1, ZHOOK_HANDLE)
- RETURN
-#endif
- JN = COUNT (.NOT. LD_MASKEXT)
- ZX (1:JN) = PACK (PX, .NOT. LD_MASKEXT)
-ELSE
- ZX = PX
- JN = SIZE (PX)
-ENDIF
-
-WRITE (0, *) TRIM(CDN)//" = "
-WRITE (0, *) JN, MINVAL(ZX(1:JN)), MAXVAL(ZX(1:JN))
-!WRITE (0, '(10(E14.6,", "))') ZX (1:N)
-
-IF (LHOOK) CALL DR_HOOK ('OI_CONTROL:DD', 1, ZHOOK_HANDLE)
-
-END SUBROUTINE DD
-
-END SUBROUTINE OI_CONTROL
diff --git a/src/SURFEX/oi_fctveg.F90 b/src/SURFEX/oi_fctveg.F90
deleted file mode 100644
index e5b0e9322f056630dca6ddd70ea360aa3ea942a7..0000000000000000000000000000000000000000
--- a/src/SURFEX/oi_fctveg.F90
+++ /dev/null
@@ -1,87 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE OI_FCTVEG(KH,PVEG,&
- PVGAT1,PVGAT2,PVGAT3,PVGBT1,PVGBT2,PVGBT3,PVGCT1,PVGCT2, &
- PVGAH1,PVGAH2,PVGAH3,PVGBH1,PVGBH2,PVGBH3,PVGCH1,PVGCH2, &
- PSIGT2MP,PSIGHP2,PG1,PG2,PG3,PG4,&
- PVGST,PVGSH,PVGPT1,PVGPH1,PVGPT2,PVGPH2)
-!
-!****-------------------------------------------------------------------
-!
-USE MODD_ASSIM, ONLY : XSIGHP1, XSIGT2MR, XSIGH2MR, XSIGT2MO, XSIGH2MO
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-INTEGER :: J
-INTEGER, INTENT(IN) :: KH
-!
-REAL, DIMENSION(24), INTENT(IN) :: PVGAT1,PVGAT2,PVGAT3
-REAL, DIMENSION(24), INTENT(IN) :: PVGBT1,PVGBT2,PVGBT3
-REAL, DIMENSION(24), INTENT(IN) :: PVGCT1,PVGCT2
-REAL, DIMENSION(24), INTENT(IN) :: PVGAH1,PVGAH2,PVGAH3
-REAL, DIMENSION(24), INTENT(IN) :: PVGBH1,PVGBH2,PVGBH3
-REAL, DIMENSION(24), INTENT(IN) :: PVGCH1,PVGCH2
-REAL, DIMENSION(24), INTENT(IN) :: PSIGT2MP,PSIGHP2
-!
-REAL, INTENT(IN) :: PVEG
-!
-REAL, INTENT(OUT) :: PG1,PG2,PG3,PG4
-REAL, INTENT(OUT) :: PVGST,PVGSH,PVGPT1,PVGPH1,PVGPT2,PVGPH2
-!
-REAL :: ZSIGH2MP
-REAL :: ZX1,ZY1,ZX2,ZY2,ZX3,ZY3,ZX4,ZY4
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!**---------------------------------------------------------------------
-!** 1. Initialisation des polynomes bruts et des champs de reference.
-!** -------------------------------------------------------------
-!
-! fonction definissant la dependance par rapport aux erreurs d'observation
-!REAL :: G
-!REAL :: PX,PY
-!G ( PX,PY ) = PX**2 / (PX**2 + PY**2 + (PX*PY)**2)
-!
-! ecart-type d'erreurs de prevision sur H2m
-!
-IF (LHOOK) CALL DR_HOOK('OI_FCTVEG',0,ZHOOK_HANDLE)
-ZSIGH2MP = XSIGHP1 + PSIGHP2(KH)*PVEG
-!
-!G1 = G(SIGH2MO/SIGH2MP(KH,PVEG),SIGT2MO/SIGT2MP(KH))
-ZX1 = XSIGH2MO/ZSIGH2MP
-ZY1 = XSIGT2MO/PSIGT2MP(KH)
-PG1 = ZX1**2 / (ZX1**2 + ZY1**2 + (ZX1*ZY1)**2)
-!
-!G2= G(SIGH2MR/SIGH2MP(KH,PVEG),SIGT2MR/SIGT2MP(KH))
-ZX2 = XSIGH2MR/ZSIGH2MP
-ZY2 = XSIGT2MR/PSIGT2MP(KH)
-PG2 = ZX2**2 / (ZX2**2 + ZY2**2 + (ZX2*ZY2)**2)
-!
-!G3= G(SIGT2MO/SIGT2MP(KH),SIGH2MO/SIGH2MP(KH,PVEG))
-ZX3 = XSIGT2MO/PSIGT2MP(KH)
-ZY3 = XSIGH2MO/ZSIGH2MP
-PG3 = ZX3**2 / (ZX3**2 + ZY3**2 + (ZX3*ZY3)**2)
-!
-!G4= G(SIGT2MR/SIGT2MP(KH),SIGH2MR/SIGH2MP(KH,PVEG))
-ZX4 = XSIGT2MR/PSIGT2MP(KH)
-ZY4 = XSIGH2MR/ZSIGH2MP
-PG4 = ZX4**2 / (ZX4**2 + ZY4**2 + (ZX4*ZY4)**2)
-!
-! polynomes de base pour la dependance par rapport a l'indice de vegetation
-!
-PVGST = (1.0 - PVEG)*(PVGAT1(KH) + PVGAT2(KH)*PVEG + PVGAT3(KH)*PVEG**2)
-PVGSH = (1.0 - PVEG)*(PVGAH1(KH) + PVGAH2(KH)*PVEG + PVGAH3(KH)*PVEG**2)
-PVGPT1 = (1.0 - PVEG)*(PVGBT1(KH) + PVGBT2(KH)*PVEG + PVGBT3(KH)*PVEG**2)
-PVGPH1 = (1.0 - PVEG)*(PVGBH1(KH) + PVGBH2(KH)*PVEG + PVGBH3(KH)*PVEG**2)
-PVGPT2 = PVEG*(PVGCT1(KH) + PVGCT2(KH)*PVEG)
-PVGPH2 = PVEG*(PVGCH1(KH) + PVGCH2(KH)*PVEG)
-IF (LHOOK) CALL DR_HOOK('OI_FCTVEG',1,ZHOOK_HANDLE)
-!
-!**---------------------------------------------------------------------
-END SUBROUTINE OI_FCTVEG
-
diff --git a/src/SURFEX/oi_hor_extrapol_surf.F90 b/src/SURFEX/oi_hor_extrapol_surf.F90
deleted file mode 100644
index 43b2df3cfb69daf24766ad9ab609fa16f4ff2b77..0000000000000000000000000000000000000000
--- a/src/SURFEX/oi_hor_extrapol_surf.F90
+++ /dev/null
@@ -1,180 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-
-! ###################################################################
- SUBROUTINE OI_HOR_EXTRAPOL_SURF(NDIM,PLAT_IN,PLON_IN,PFIELD_IN, &
- PLAT,PLON,PFIELD,OINTERP,PZS,NDIM2)
-! ###################################################################
-!
-!!**** *OI_HOR_EXTRAPOL_SURF* extrapolate a surface field
-!!
-!! PURPOSE
-!! -------
-!!
-!!
-!! METHOD
-!! ------
-!!
-!! For each point to interpolate, the nearest valid point value is set.
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! V. Masson Meteo-France
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 01/12/98
-!! V. Masson 01/2004 extrapolation in latitude and longitude
-!! J.-F. Mahfouf 03/2010 adaptation for OI soil analysis
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_CSTS, ONLY : XPI
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-USE MODI_ABOR1_SFX
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-!
-INTEGER, INTENT(IN) :: NDIM ! dimension of arrays
-REAL, DIMENSION(NDIM), INTENT(IN) :: PLAT_IN ! input lat. of each grid mesh.
-REAL, DIMENSION(NDIM), INTENT(IN) :: PLON_IN ! input lon. of each grid mesh.
-REAL, DIMENSION(NDIM), INTENT(IN) :: PFIELD_IN! input field on grid mesh
-REAL, DIMENSION(NDIM), INTENT(IN) :: PLAT ! latitude of each grid mesh.
-REAL, DIMENSION(NDIM), INTENT(IN) :: PLON ! longitude of each grid mesh.
-REAL, DIMENSION(NDIM), INTENT(INOUT) :: PFIELD ! field on grid mesh
-LOGICAL,DIMENSION(NDIM), INTENT(IN) :: OINTERP ! .true. where physical value is needed
-REAL, DIMENSION(NDIM), OPTIONAL, INTENT(IN) :: PZS ! surface height
-INTEGER, OPTIONAL, INTENT(IN) :: NDIM2 ! Optional subdomain to search in
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-REAL :: ZLAT ! latitude of point to define
-REAL :: ZLON ! longitude of point to define
-REAL :: ZDIST ! current distance to valid point (in lat/lon grid)
-REAL :: ZFIELD ! current found field value
-REAL :: ZNDIST ! smallest distance to valid point
-REAL :: ZCOSLA ! cosine of latitude
-REAL :: ZZS_OUT ! altitude of nearest grid point
-REAL,PARAMETER :: ZLIMMAX = 1. ! Maximum distance allowed (in degrees)
-!
-INTEGER :: JI ! loop index on points
-INTEGER :: JISC ! loop index on valid points
-INTEGER :: JISC1,JISC2,JZLIMCNT
-!
-REAL :: ZLONSC, ZDLAT, ZDLON, ZCONV, ZR_EARTH
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-LOGICAL :: LNDIM2
-!
-! Earth radius
-!
-IF (LHOOK) CALL DR_HOOK('OI_HOR_EXTRAPOL_SURF',0,ZHOOK_HANDLE)
-ZR_EARTH = 6371598.0
-!
-! Angle conversion factor
-!
-ZCONV = XPI/180.0
-!-------------------------------------------------------------------------------
-!
-!* 3. No data point
-! -------------
-!
-IF (COUNT(PFIELD_IN(:)/=XUNDEF)==0 .AND. LHOOK) CALL DR_HOOK('OI_HOR_EXTRAPOL_SURF',1,ZHOOK_HANDLE)
-IF (COUNT(PFIELD_IN(:)/=XUNDEF)==0) RETURN
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. Loop on points to define
-! ------------------------
-!
-JZLIMCNT = 0
-!
-DO JI=1,NDIM
- IF (PFIELD(JI)/=XUNDEF) CYCLE
- IF (.NOT. OINTERP(JI)) CYCLE
-!
-!* 4.1 initialisation
-! --------------
-!
- ZNDIST=XUNDEF
- ZLAT=PLAT(JI)
- ZLON=PLON(JI)
- ZFIELD=PFIELD(JI)
- ZCOSLA=COS(ZLAT*ZCONV)
- IF (PRESENT(PZS)) ZZS_OUT=PZS(JI)
- IF ( PRESENT (NDIM2)) THEN
- JISC1=MAX((JI-NDIM2),1)
- JISC2=MIN((JI+NDIM2),NDIM)
- LNDIM2=.TRUE.
- ELSE
- JISC1=1
- JISC2=NDIM
- LNDIM2=.FALSE.
- ENDIF
-!
-!* 4.2 extrapolation with nearest valid point
-! --------------------------------------
-!
- DO JISC=JISC1,JISC2
- IF (PFIELD_IN(JISC)/=XUNDEF) THEN
- ZLONSC = PLON_IN(JISC)
- IF (ZLONSC-ZLON> 180.) ZLONSC = ZLONSC - 360.0
- IF (ZLONSC-ZLON<-180.) ZLONSC = ZLONSC + 360.0
- ZDLAT = (PLAT_IN(JISC)-ZLAT)*ZCONV
- ZDLON = (ZLONSC-ZLON)*ZCONV
- ZDIST = ZDLAT*ZDLAT + ZDLON*ZDLON*ZCOSLA*ZCOSLA
- IF (ZDIST<=ZNDIST) THEN
- ZFIELD=PFIELD_IN(JISC)
- IF (PRESENT(PZS)) ZZS_OUT=PZS(JISC)
- ZNDIST=ZDIST
- END IF
- END IF
- END DO
-
- ! Check if we got values
- IF ( ZNDIST == XUNDEF ) THEN
- CALL ABOR1_SFX("Extrapolated point is undefined! No nearby point found.")
- ELSEIF ( ZNDIST > (ZLIMMAX*ZCONV) ) THEN
- IF ( LNDIM2 ) &
- & CALL ABOR1_SFX("Distance to extrapolated point is to large. Increase ZLIMMAX or NDIM2")
- JZLIMCNT = JZLIMCNT + 1
- ENDIF
- IF (PRESENT(PZS)) THEN
- PFIELD(JI) = ZFIELD + (ZZS_OUT - PZS(JI))*0.0065
- ELSE
- PFIELD(JI) = ZFIELD
- ENDIF
-
-END DO
-
-IF ( JZLIMCNT > 0 ) THEN
- PRINT *,'Points with extrapolation distance > ',ZLIMMAX,' degrees are ',JZLIMCNT
-ENDIF
-
-IF (LHOOK) CALL DR_HOOK('OI_HOR_EXTRAPOL_SURF',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE OI_HOR_EXTRAPOL_SURF
diff --git a/src/SURFEX/oi_jacobians.F90 b/src/SURFEX/oi_jacobians.F90
deleted file mode 100644
index c9d6579057c65194743f0e3d6eb22a6c3c5f5971..0000000000000000000000000000000000000000
--- a/src/SURFEX/oi_jacobians.F90
+++ /dev/null
@@ -1,93 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE OI_JACOBIANS (KNBPT,&
-!---------------------------------------------------------------------------------
-! - INPUT 1D
- PWS_O, PSAB, PARG, PD2, PWP, &
-! - OUTPUT 1D .
- PDWG_DWG, PDWG_DW2)
-!
-!**** * JACOBIANS * - Compute analytical Jacobians for assimilation of WG
-
-! Purpose.
-! --------
-
-! - Based on the restore term of the ISBA equation for WG
-!
-
-!** Interface.
-! ----------
-! *CALL* *OI_JACOBIANS*
-
-!----------------------------------------------------------------------------------
-
-! Externals.
-! ---------
-
-! Method. analytical formulation
-! -------
-
-! Author.
-! -------
-! 09-06, J.-F. Mahfouf
-
-!-----------------------------------------------------------------------
-!
-USE MODD_ASSIM, ONLY : NECHGU, XRSCAL_JAC
-USE MODD_CSTS, ONLY : XRHOLW, XDAY
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-INTEGER, INTENT(IN) :: KNBPT
-REAL ,INTENT(IN) :: PWS_O(KNBPT)
-REAL ,INTENT(IN) :: PSAB(KNBPT)
-REAL ,INTENT(IN) :: PARG(KNBPT)
-REAL ,INTENT(IN) :: PD2(KNBPT)
-REAL ,INTENT(IN) :: PWP(KNBPT)
-!
-REAL ,INTENT(OUT) :: PDWG_DWG(KNBPT)
-REAL ,INTENT(OUT) :: PDWG_DW2(KNBPT)
-!
-REAL :: ZWSAT, ZWL, ZDT, ZW2, ZC2, ZC2REF, ZP, ZA, ZWGEQ_DW2
-INTEGER :: JROF
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-IF (LHOOK) CALL DR_HOOK('OI_JACOBIANS',0,ZHOOK_HANDLE)
-!
-ZWL = 1.E-5
-ZDT = REAL(NECHGU)*3600.0*XRSCAL_JAC
-!
-! Compute analytical Jacobians for the ISBA 2L scheme
-!
-DO JROF = 1,KNBPT
-
- IF (PWS_O(JROF) /= 999.0) THEN
-
- ZP = 0.134 * PARG(JROF) + 3.4
- ZA = 732.42E-3 * PARG(JROF)**(-0.539)
- ZC2REF = 13.815 * PARG(JROF)**(-0.954)
- ZWSAT = (-1.08*PSAB(JROF) + 494.305)*0.001
- ZW2 = PWP(JROF)/(PD2(JROF)*XRHOLW)
- ZC2 = ZC2REF*ZW2/(ZWSAT -ZW2 + ZWL)
- ZWGEQ_DW2 = 1.0 - ZA*ZP*(ZW2/ZWSAT)**(ZP-1.0) + &
- 9.0*ZA*ZP*(ZW2/ZWSAT)**(9.0*ZP-1.0)
- PDWG_DWG(JROF) = EXP(-ZC2/XDAY*ZDT)
- PDWG_DW2(JROF) = ZWGEQ_DW2 * (1.0 - EXP(-ZC2/XDAY*ZDT))
-
- ELSE
-
- PDWG_DWG(JROF) = 0.0
- PDWG_DW2(JROF) = 0.0
-
- ENDIF
-
-ENDDO
-IF (LHOOK) CALL DR_HOOK('OI_JACOBIANS',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE OI_JACOBIANS
diff --git a/src/SURFEX/oi_kalman_gain.F90 b/src/SURFEX/oi_kalman_gain.F90
deleted file mode 100644
index 13e871df6dcf13ec44002d921faa92bc5671128a..0000000000000000000000000000000000000000
--- a/src/SURFEX/oi_kalman_gain.F90
+++ /dev/null
@@ -1,51 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE OI_KALMAN_GAIN(PDWG_DWG,PDWG_DW2,PD2,PK1,PK2)
-!
-!****-------------------------------------------------------------------
-!
-USE MODD_CSTS, ONLY : XRHOLW
-USE MODD_ASSIM, ONLY : XRD1, XSIGWGO, XSIGWGB, XSIGW2B
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-REAL ,INTENT(IN) :: PDWG_DWG, PDWG_DW2, PD2
-REAL ,INTENT(OUT) :: PK1, PK2
-!
-REAL :: ZSIG_WG,ZSIG_W2,ZSIG_WO,ZA,ZB,ZH1,ZH2,ZDENOM
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-! Standard deviation of background and observation errors
-!
-IF (LHOOK) CALL DR_HOOK('OI_KALMAN_GAIN',0,ZHOOK_HANDLE)
-ZSIG_WG = XSIGWGB
-ZSIG_W2 = XSIGW2B
-ZSIG_WO = XSIGWGO
-!
-! Jacobians elements
-!
-ZH1 = PDWG_DWG
-ZH2 = PDWG_DW2
-!
-! Elements of background covariance matrix
-!
-ZA = (ZSIG_WG*ZH1)**2 + (ZSIG_W2*ZH2)**2
-ZB = ZSIG_W2**2
-!
-ZDENOM = (ZA + ZSIG_WO*ZSIG_WO)
-!
-! Kalman gain elements (m3/m3)
-!
-PK1 = ZA /ZDENOM !*RD1*XRHOLW
-PK2 = ZB*ZH2/ZDENOM !*PD2*XRHOLW
-IF (LHOOK) CALL DR_HOOK('OI_KALMAN_GAIN',1,ZHOOK_HANDLE)
-!
-!**---------------------------------------------------------------------
-END SUBROUTINE OI_KALMAN_GAIN
-
diff --git a/src/SURFEX/oi_latlon_conf_proj.F90 b/src/SURFEX/oi_latlon_conf_proj.F90
deleted file mode 100644
index 15fec3584151fcd3c1102ff005f4ce214a9bd2a4..0000000000000000000000000000000000000000
--- a/src/SURFEX/oi_latlon_conf_proj.F90
+++ /dev/null
@@ -1,225 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ###################################################
- SUBROUTINE OI_LATLON_CONF_PROJ(NDIM,PLAT0,PLON0,PRPK,PBETA,PLATOR,PLONOR, &
- PX,PY,PLAT,PLON )
-! ###################################################
-!
-!!**** *LATLON_CONF_PROJ * - Routine to compute geographical coordinates
-!!
-!! PURPOSE
-!! -------
-! This routine computes the latitude and longitude of
-! an array given in cartesian conformal coordinates
-! Five map projections are available:
-! - polar-stereographic from south pole (PRPK=1),
-! - lambert conformal from south pole (0<PRPK<1),
-! - mercator (PRPK=0),
-! - lambert conformal from north pole (-1<PRPK<0),
-! - polar-stereographic from north pole (PRPK=-1).
-!
-!
-!!** METHOD
-!! ------
-!! Spherical earth approximation is used. Longitude origin is
-!! set in Greenwich, and is positive eastwards. An anticlockwise
-!! rotation of PBETA degrees is applied to the conformal frame
-!! with respect to the geographical directions.
-!!
-!! WARNING: ALL INPUT AND OUTPUT ANGLES ARE IN DEGREES...
-!!
-!! EXTERNAL
-!! --------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!! Asencio N. et al., 1994, "Le projet de modele non-hydrostatique
-!! commun CNRM-LA, specifications techniques",
-!! Note CNRM/GMME, 26, 139p, (Chapter 2).
-!! Ducrocq V., 1994, "Generation de la grille dans le modele",
-!! Note interne MNH, 5 mai, 3p.
-!! Joly A., 1992, "Geographic parameters for ARPEGE/ALADIN",
-!! Internal note ARPEGE/ALADIN, february 27,28p.
-!! Levallois J., 1970, "Geodesie generale", Tome 2, Collection
-!! de l'IGN, Eyrolles, Paris, 408p.
-!!
-!! AUTHOR
-!! ------
-!! P.M. *LA*
-!!
-!! MODIFICATION
-!! ------------
-!! Original PM 24/05/94
-!! Updated PM 27/07/94
-!! Updated VD 23/08/94
-!! Updated VM 24/10/95 projection from north pole (PRPK<0) and
-!! longitudes set between PLON0-180. and PLON0+180.
-!! Update VM 11/2004 externalized version
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CSTS,ONLY : XPI, XRADIUS
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments and results
-!
-REAL, INTENT(IN) :: PLAT0 ! Reference latitude
-REAL, INTENT(IN) :: PLON0 ! Reference longitude
-REAL, INTENT(IN) :: PRPK ! projection parameter
-! ! K=1 : stereographic north pole
-! ! 0<K<1 : Lambert, north hemisphere
-! ! K=0 : Mercator
-! !-1<K<0 : Lambert, south hemisphere
-! ! K=-1: stereographic south pole
-REAL, INTENT(IN) :: PBETA ! angle between grid and reference longitude
-REAL, INTENT(IN) :: PLATOR ! Latitude of the origine point
-REAL, INTENT(IN) :: PLONOR ! Longitude of the origine point
-REAL, DIMENSION(NDIM), INTENT(IN) :: PX,PY
- ! given conformal coordinates of the
- ! processed points (meters);
-REAL, DIMENSION(NDIM), INTENT(OUT):: PLAT,PLON
- ! returned geographic latitudes and
- ! longitudes of the processed points
- ! (degrees).
-INTEGER, INTENT(IN) :: NDIM
-!
-!* 0.2 Declarations of local variables
-!
-REAL, DIMENSION(NDIM) :: ZY
-REAL :: ZRPK,ZBETA,ZLAT0,ZLON0,ZLATOR,ZLONOR
-REAL :: ZRDSDG,ZCLAT0,ZSLAT0,ZCLATOR,ZSLATOR
-REAL :: ZXBM0,ZYBM0,ZRO0,ZGA0
-REAL :: ZXP,ZYP,ZEPSI,ZT1,ZCGAM,ZSGAM,ZRACLAT0
-!
-REAL, DIMENSION(NDIM) :: ZATA,ZRO2,ZT2,ZXMI0,ZYMI0
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!--------------------------------------------------------------------------------
-!
-!* 1. Preliminary calculations for all projections
-! --------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('OI_LATLON_CONF_PROJ',0,ZHOOK_HANDLE)
-ZRDSDG = XPI/180. ! Degree to radian conversion factor
-ZEPSI = 10.*EPSILON(1.) ! A small number
-!
-! By definition, (PLONOR,PLATOR) are the geographical
-! coordinates, and (ZXBM0,ZYBM0) the conformal cartesian
-! point of coordinates (x=0,y=0).
-!
-ZXBM0 = 0.
-ZYBM0 = 0.
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. POLAR STEREOGRAPHIC AND LAMBERT CONFORMAL CASES
-! -----------------------------------------------
-! (PRPK=1 P-stereo, 0<PRPK<1 Lambert)
-!
-IF(PRPK /= 0.) THEN
-!
- IF (PRPK<0.) THEN ! projection from north pole
- ZRPK=-PRPK
- ZBETA=-PBETA
- ZLAT0=-PLAT0
- ZLON0=PLON0+180.
- ZLATOR=-PLATOR
- ZLONOR=PLONOR+180.
- ZY(:)=-PY(:)
- ZYBM0=-ZYBM0
- ELSE ! projection from south pole
- ZRPK=PRPK
- ZBETA=PBETA
- ZLAT0=PLAT0
- ZLON0=PLON0
- ZLATOR=PLATOR
- ZLONOR=PLONOR
- ZY(:)=PY(:)
- ENDIF
-!
-!* 2.1 Preliminary calculations
-!
- ZCLAT0 = COS(ZRDSDG*ZLAT0)
- ZSLAT0 = SIN(ZRDSDG*ZLAT0)
- ZCLATOR = COS(ZRDSDG*ZLATOR)
- ZSLATOR = SIN(ZRDSDG*ZLATOR)
- ZRO0 = (XRADIUS/ZRPK)*(ABS(ZCLAT0))**(1.-ZRPK) &
- * ((1.+ZSLAT0)*ABS(ZCLATOR)/(1.+ZSLATOR))**ZRPK
- ZGA0 = (ZRPK*(ZLONOR-ZLON0)-ZBETA)*ZRDSDG
- ZXP = ZXBM0-ZRO0*SIN(ZGA0)
- ZYP = ZYBM0+ZRO0*COS(ZGA0)
-!
-!* 2.2 Longitude
-!
- WHERE (ABS(ZY(:)-ZYP) < ZEPSI &
- .AND.ABS(PX(:)-ZXP) < ZEPSI)
- ZATA(:) = 0.
- ELSEWHERE
- ZATA(:) = ATAN2(-(ZXP-PX(:)),(ZYP-ZY(:)))/ZRDSDG
- END WHERE
- !
- PLON(:) = (ZBETA+ZATA(:))/ZRPK+ZLON0
-!
-!* 2.3 Latitude
-!
- ZRO2(:) = (PX(:)-ZXP)**2+(ZY(:)-ZYP)**2
- ZT1 = (XRADIUS*(ABS(ZCLAT0))**(1.-ZRPK))**(2./ZRPK) &
- * (1+ZSLAT0)**2
- ZT2(:) = (ZRPK**2*ZRO2(:))**(1./ZRPK)
- !
- PLAT(:) = (XPI/2.-ACOS((ZT1-ZT2(:))/(ZT1+ZT2(:))))/ZRDSDG
-!
- IF (PRPK<0.) THEN ! projection from north pole
- PLAT(:)=-PLAT(:)
- PLON(:)=PLON(:)+180.
- ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. MERCATOR PROJECTION WITH ROTATION
-! ---------------------------------
-! (PRPK=0)
-!
-ELSE
-!
-!* 3.1 Preliminary calculations
-!
- ZCGAM = COS(-ZRDSDG*PBETA)
- ZSGAM = SIN(-ZRDSDG*PBETA)
- ZRACLAT0 = XRADIUS*COS(ZRDSDG*PLAT0)
-!
-!* 3.2 Longitude
-!
- ZXMI0(:) = PX(:)-ZXBM0
- ZYMI0(:) = PY(:)-ZYBM0
-!
- PLON(:) = (ZXMI0(:)*ZCGAM+ZYMI0(:)*ZSGAM) &
- / (ZRACLAT0*ZRDSDG)+PLONOR
-!
-!* 3.3 Latitude
-!
- ZT1 = ALOG(TAN(XPI/4.+PLATOR*ZRDSDG/2.))
- ZT2(:) = (-ZXMI0(:)*ZSGAM+ZYMI0(:)*ZCGAM)/ZRACLAT0
- !
- PLAT(:) = (-XPI/2.+2.*ATAN(EXP(ZT1+ZT2(:))))/ZRDSDG
-!
-!---------------------------------------------------------------------------------
-!
-!* 4. EXIT
-! ----
-!
-END IF
-PLON(:)=PLON(:)+NINT((PLON0-PLON(:))/360.)*360.
-IF (LHOOK) CALL DR_HOOK('OI_LATLON_CONF_PROJ',1,ZHOOK_HANDLE)
-!---------------------------------------------------------------------------------
-END SUBROUTINE OI_LATLON_CONF_PROJ
diff --git a/src/SURFEX/oi_tsl.F90 b/src/SURFEX/oi_tsl.F90
deleted file mode 100644
index ea46064e8abcf0bc9c1d3dd82d40b1eb6c55fd19..0000000000000000000000000000000000000000
--- a/src/SURFEX/oi_tsl.F90
+++ /dev/null
@@ -1,211 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE OI_TSL(KDAT,KSSSSS,PLAT,PLON,PMU0,PMU0M,KH)
-!-----------------------------------------------------------------------
-!
-! Computation of solar zenith angle
-! ---------------------------------
-!
-! INPUT PARAMETERS :
-!
-! IDAT : DATE in the following form => YYYYMMDD
-! NSSSSS : TIME of the day in seconds
-! PLAT : LATITUDE in Degrees
-! PLON : LONGITUDE in Degrees
-!
-! OUTPUT PARAMETERS :
-!
-! PMU0 : Cosine of solar zenith angle
-! PMU0M : Cosine of solar zenith angle (mean value)
-! IH : local time (hour)
-!
-!
-! J.F. Mahfouf (4/12/97) from IFS/ARPEGE routines
-!
-!
-! 23/05/2009 : Fortran 90 recoding (IMPLICIT NONE + FUNCTIONS)
-!
-!-----------------------------------------------------------------------
-!
-! - Astronomical functions
-! you will find the description in the annex 1 of the documentation
-! RRS is the distance Sun-Earth
-! RDS is the declination of the Earth
-! RET is the equation of time
-!
-USE MODD_CSTS, ONLY : XPI
-USE MODD_ASSIM, ONLY : XREPSM, XRCDTR, NITRAD
-!
-!
-USE YOMHOOK, ONLY : LHOOK, DR_HOOK
-USE PARKIND1, ONLY : JPRB
-!
-IMPLICIT NONE
-!
-INTEGER, INTENT(IN) :: KDAT
-INTEGER, INTENT(IN) :: KSSSSS
-REAL, INTENT(IN) :: PLAT, PLON
-REAL, INTENT(OUT) :: PMU0, PMU0M
-INTEGER, INTENT(OUT) :: KH
-!
-REAL :: ZGEMU, ZGELAM, ZTIME, ZTETA, ZRDECLI, ZREQTIM, ZRHGMT, ZRSOVR, &
- ZRWSOVR, ZRCODEC, ZRSIDEC, ZRCOVSR, ZRSIVSR, ZRTIMTRM, ZTETAM, &
- ZRDECLIM, ZREQTIMM, ZRHGMTM, ZRSOVRM, ZRWSOVRM, ZRCODECM, &
- ZRSIDECM, ZRCOVSRM, ZRSIVSRM, ZT
-INTEGER :: ID, IM, IA, INSSSSS
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-! Angle conversions
-!
-IF (LHOOK) CALL DR_HOOK('OI_TSL',0,ZHOOK_HANDLE)
-!
-ZGEMU = SIN(PLAT*XPI/180.) ! sinus of latitude
-ZGELAM = PLON*XPI/180. ! longitude
-!
-ID = MOD(KDAT,100)
-IM = MOD((KDAT-ID)/100,100)
-IA = KDAT/10000
-
-ZTIME = RTIME(IA,IM,ID,KSSSSS)
-!
- CALL GET_MU0(ZGEMU,ZGELAM,ZTIME,KSSSSS,PMU0)
-!
-!
-! Mean angle over the previous 6 hours
-! ------------------------------------
-!
-ZTIME = RTIME(IA,IM,ID,KSSSSS-NITRAD)
-!
-IF ( (KSSSSS-NITRAD).LT.0 ) THEN
- INSSSSS = KSSSSS + 86400
-ELSE
- INSSSSS = KSSSSS
-ENDIF
-!
- CALL GET_MU0(ZGEMU,ZGELAM,ZTIME,INSSSSS-NITRAD,PMU0M)
-!
-!
-! Local time in hours
-! Should be inside [1,24]
-!
-ZT = (KSSSSS + PLON*XRCDTR*3600.)/3600.
-IF (ZT < 0.0) THEN
- ZT = ZT + 24.
-ELSEIF (ZT > 24.0) THEN
- ZT = ZT - 24.
-ENDIF
-!
-KH = INT(ZT)
-IF ( KH==0 ) KH = 24
-!
-IF (LHOOK) CALL DR_HOOK('OI_TSL',1,ZHOOK_HANDLE)
-!
- CONTAINS
-!
-SUBROUTINE GET_MU0(PGEMU,PGELAM,PTIME,KSSSSS,PMU)
-!
-USE MODD_CSTS, ONLY : XDAY
-!
-IMPLICIT NONE
-!
-REAL, INTENT(IN) :: PGEMU
-REAL, INTENT(IN) :: PGELAM
-REAL, INTENT(IN) :: PTIME
-INTEGER, INTENT(IN) :: KSSSSS
-REAL, INTENT(OUT) :: PMU
-!
-REAL :: ZTETA, ZDECLI, ZEQTIM, ZHGMT, ZWSOVR
-REAL :: ZINTER
-!
-ZTETA = PTIME/(XDAY*365.25)
-!
-ZDECLI = RDS(ZTETA) ! declinaison
-!
-ZEQTIM = RET(ZTETA)
-ZHGMT = REAL( MOD(KSSSSS,NINT(XDAY)) )
-ZWSOVR = (ZEQTIM + ZHGMT) * 2. * XPI/XDAY ! hour angle
-!
-ZINTER = SQRT(1.-PGEMU**2)
-PMU = MAX( SIN(ZDECLI) * PGEMU + COS(ZDECLI) * ZINTER * &
- ( SIN(ZWSOVR)*SIN(PGELAM) - COS(ZWSOVR)*COS(PGELAM) ) , 0. )
-!
-IF (PMU.GT.0.) PMU = SQRT(1224.*PMU*PMU +1.)/35. ! Magnification factor
-!
-END SUBROUTINE GET_MU0
-!
-FUNCTION RDS(PT)
-
-USE MODD_ASSIM, ONLY : XREPSM
-
-IMPLICIT NONE
-
-REAL, INTENT(IN) :: PT
-REAL :: RDS, ZLS, ZEL
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
-IF (LHOOK) CALL DR_HOOK('RDS',0,ZHOOK_HANDLE)
-!
-ZEL = 1.7535 + 6.283076 * PT
-ZLS = 4.8952 + 6.283320 * PT &
- - 0.0075*SIN(ZEL) - 0.0326*COS(ZEL) &
- - 0.0003*SIN(2.*ZEL) + 0.0002*COS(2.*ZEL)
-!
-RDS = ASIN(SIN(XREPSM)*SIN(ZLS))
-!
-IF (LHOOK) CALL DR_HOOK('RDS',1,ZHOOK_HANDLE)
-
-END FUNCTION RDS
-!
-FUNCTION RET(PT)
-
-IMPLICIT NONE
-
-REAL, INTENT(IN) :: PT
-REAL :: RET, ZEM, ZLS
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
-IF (LHOOK) CALL DR_HOOK('RET',0,ZHOOK_HANDLE)
-
-ZEM = 6.240075 + 6.283020 * PT
-ZLS = 4.8951 + 6.283076 * PT
-RET = 591.8*SIN(2.*ZLS) - 12.7 * SIN(4.*ZLS) &
- - 459.4*SIN(ZEM) - 4.8 *SIN(2.*ZEM) &
- + 39.5 * SIN(ZEM) * COS(2.*ZLS)
-
-IF (LHOOK) CALL DR_HOOK('RET',1,ZHOOK_HANDLE)
-
-END FUNCTION RET
-!
-FUNCTION RTIME(KA,KM,KD,KS)
-
-USE MODD_CSTS, ONLY : XDAY
-
-IMPLICIT NONE
-
-INTEGER, INTENT(IN) :: KA, KM, KD, KS
-REAL :: RTIME, ZJ
-INTEGER :: IA, IM
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
-IF (LHOOK) CALL DR_HOOK('RTIME',0,ZHOOK_HANDLE)
-
-IM = KM + 6*(1-ISIGN(1,KM-3))
-IA = KA - ( (1-ISIGN(1,KM-3))/2 )
-!
-ZJ = 1720994.5 + &
- FLOAT( 2 - IA/100 + (IA/100)/4 + &
- INT(365.25*FLOAT(IA)) + INT(30.601*FLOAT(IM+1)) + KD )
-!
-RTIME = (ZJ-2451545.)*XDAY + FLOAT(KS)
-!
-IF (LHOOK) CALL DR_HOOK('RTIME',1,ZHOOK_HANDLE)
-
-END FUNCTION RTIME
-
-END SUBROUTINE OI_TSL
-
-
-
-
diff --git a/src/SURFEX/old_name.F90 b/src/SURFEX/old_name.F90
index ddaf96dc44aeb440a47fcd28271ff763f87fa080..b54ca0c7852a7b7c24944d32d36a338373c81895 100644
--- a/src/SURFEX/old_name.F90
+++ b/src/SURFEX/old_name.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE OLD_NAME (&
- HPROGRAM,HRECIN,HRECOUT)
+ SUBROUTINE OLD_NAME (HPROGRAM,HRECIN,HRECOUT,HDIR)
! #######################################################
!
!!**** *OLD_NAME* - get the old name of a field for reading in an old SURFEX file
@@ -56,13 +55,15 @@ IMPLICIT NONE
!
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! main program
- CHARACTER(LEN=*), INTENT(IN) :: HRECIN ! name of field to be read
- CHARACTER(LEN=*), INTENT(OUT) :: HRECOUT ! name of field to be read is old file
+ CHARACTER(LEN=LEN_HREC), INTENT(IN) :: HRECIN ! name of field to be read
+ CHARACTER(LEN=LEN_HREC), INTENT(OUT) :: HRECOUT ! name of field to be read is old file
+ CHARACTER(LEN=1), INTENT(IN), OPTIONAL :: HDIR
!
!
!* 0.2 Declarations of local variables
! -------------------------------
!
+ CHARACTER(LEN=1) :: YDIR
INTEGER :: IVERSION ! version of the old file
INTEGER :: IBUGFIX ! bugfix of the old file
!
@@ -72,12 +73,13 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('OLD_NAME',0,ZHOOK_HANDLE)
!
+YDIR = 'H'
+IF (PRESENT(HDIR)) YDIR = HDIR
+!
HRECOUT = HRECIN
IF (HRECIN=='COVER_LIST') THEN
- CALL READ_SURF(&
- HPROGRAM,'VERSION',IVERSION,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'BUG', IBUGFIX ,IRESP)
+ CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP,HDIR=YDIR)
+ CALL READ_SURF(HPROGRAM,'BUG', IBUGFIX ,IRESP,HDIR=YDIR)
IF (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX==0)) HRECOUT='COVER'
END IF
!
diff --git a/src/SURFEX/open_aux_io_surf.F90 b/src/SURFEX/open_aux_io_surf.F90
index c6ad0776786b8b72c1b97b24886cf55184a2e17c..183686a75a6fd71850f43215cbd9804010aee627 100644
--- a/src/SURFEX/open_aux_io_surf.F90
+++ b/src/SURFEX/open_aux_io_surf.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE OPEN_AUX_IO_SURF (&
- HFILE,HFILETYPE,HMASK)
+ SUBROUTINE OPEN_AUX_IO_SURF (HFILE,HFILETYPE,HMASK,HDIR)
! #######################################################
!
!!**** *OPEN_AUX_IO_SURF* - chooses the routine to OPENialize IO
@@ -39,12 +38,7 @@
!* 0. DECLARATIONS
! ------------
!
-!
-!
-!
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
#ifdef SFX_ASC
@@ -70,9 +64,14 @@ USE MODI_OPEN_AUX_IO_SURF_NC
#ifdef SFX_MNH
USE MODI_MNHOPEN_AUX_IO_SURF
#endif
+
+#ifdef SFX_ARO
+USE MODI_AROOPEN_AUX_IO_SURF
+#endif
!
IMPLICIT NONE
!
+!
!* 0.1 Declarations of arguments
! -------------------------
!
@@ -81,14 +80,20 @@ IMPLICIT NONE
CHARACTER(LEN=28), INTENT(IN) :: HFILE ! file name
CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! main program
CHARACTER(LEN=6), INTENT(IN) :: HMASK
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ CHARACTER(LEN=1), OPTIONAL, INTENT(IN) :: HDIR
!
!* 0.2 Declarations of local variables
! -------------------------------
!
+ CHARACTER(LEN=1) :: YDIR
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('OPEN_AUX_IO_SURF',0,ZHOOK_HANDLE)
+!
+YDIR = '-'
+IF (PRESENT(HDIR)) YDIR=HDIR
+!
IF (HFILETYPE=='MESONH') THEN
#ifdef SFX_MNH
CALL MNHOPEN_AUX_IO_SURF(HFILE,HFILETYPE,HMASK)
@@ -103,8 +108,7 @@ ENDIF
!
IF (HFILETYPE=='ASCII ' ) THEN
#ifdef SFX_ASC
- CALL OPEN_AUX_IO_SURF_ASC(&
- HFILE,HFILETYPE,HMASK)
+ CALL OPEN_AUX_IO_SURF_ASC(HFILE,HFILETYPE,HMASK,YDIR)
#endif
ENDIF
!
@@ -116,22 +120,19 @@ ENDIF
!
IF (HFILETYPE=='FA ' ) THEN
#ifdef SFX_FA
- CALL OPEN_AUX_IO_SURF_FA(&
- HFILE,HFILETYPE,HMASK)
+ CALL OPEN_AUX_IO_SURF_FA(HFILE,HFILETYPE,HMASK,YDIR)
#endif
ENDIF
!
IF (HFILETYPE=='LFI ' ) THEN
#ifdef SFX_LFI
- CALL OPEN_AUX_IO_SURF_LFI(&
- HFILE,HFILETYPE,HMASK)
+ CALL OPEN_AUX_IO_SURF_LFI(HFILE,HFILETYPE,HMASK,YDIR)
#endif
ENDIF
!
IF (HFILETYPE=='NC ' ) THEN
#ifdef SFX_NC
- CALL OPEN_AUX_IO_SURF_NC(&
- HFILE,HFILETYPE,HMASK)
+ CALL OPEN_AUX_IO_SURF_NC(HFILE,HFILETYPE,HMASK,YDIR)
#endif
ENDIF
!
diff --git a/src/SURFEX/open_aux_io_surf_asc.F90 b/src/SURFEX/open_aux_io_surf_asc.F90
index 070e336dfd21a45d71219736254c9a8f856269c6..78f3513c21752bbdca98895983f34c5aca2ac118 100644
--- a/src/SURFEX/open_aux_io_surf_asc.F90
+++ b/src/SURFEX/open_aux_io_surf_asc.F90
@@ -4,7 +4,7 @@
!SFX_LIC for details. version 1.
! #######################################################
SUBROUTINE OPEN_AUX_IO_SURF_ASC (&
- HFILE,HFILETYPE,HMASK)
+ HFILE,HFILETYPE,HMASK,HDIR)
! #######################################################
!
!!**** *OPEN_AUX_IO_SURF_ASC* - chooses the routine to OPENialize IO
@@ -41,7 +41,7 @@
!
!
!
-USE MODD_IO_SURF_ASC,ONLY:NUNIT,CFILEIN,CFILEOUT,NMASK,NLUOUT,NFULL,CMASK
+USE MODD_IO_SURF_ASC,ONLY:NUNIT,NMASK,NLUOUT,NFULL,CMASK
USE MODI_GET_LUOUT
USE MODI_READ_SURF
USE MODI_IO_BUFF_CLEAN
@@ -58,13 +58,13 @@ IMPLICIT NONE
!
!
CHARACTER(LEN=28), INTENT(IN) :: HFILE ! file name
- CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! main program
- CHARACTER(LEN=6), INTENT(IN) :: HMASK
+ CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! main program
+ CHARACTER(LEN=6), INTENT(IN) :: HMASK
+ CHARACTER(LEN=1), INTENT(IN) :: HDIR
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-INTEGER, DIMENSION(:),POINTER :: IMASK
INTEGER :: IRET, IL
REAL, DIMENSION(:),ALLOCATABLE :: ZFULL ! total cover
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -79,17 +79,21 @@ NUNIT=9
!
OPEN(UNIT=NUNIT,FILE=TRIM(HFILE)//'.txt',FORM='FORMATTED')
!
- CMASK = 'FULL '
+CMASK = HMASK
CALL READ_SURF(&
- 'ASCII ','DIM_FULL',NFULL,IRET)
-ALLOCATE(NMASK(NFULL))
+ 'ASCII ','DIM_FULL',NFULL,IRET,HDIR=HDIR)
+!
ALLOCATE(ZFULL(NFULL))
-ZFULL=1.
- CALL GET_1D_MASK(NFULL,NFULL,ZFULL,NMASK)
+IL = NFULL
+ZFULL = 1.
+!
+ALLOCATE(NMASK(IL))
+CALL GET_1D_MASK(IL,NFULL,ZFULL,NMASK)
+!
DEALLOCATE(ZFULL)
!
!------------------------------------------------------------------------------
- CMASK = HMASK
+CMASK = HMASK
IF (LHOOK) CALL DR_HOOK('OPEN_AUX_IO_SURF_ASC',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/open_aux_io_surf_fa.F90 b/src/SURFEX/open_aux_io_surf_fa.F90
index 562cfad09ee289eabf17ecb3e5f90df1a4bd9a79..9fdcd39ec0435b6d623f7c4544fcb1bad5690fda 100644
--- a/src/SURFEX/open_aux_io_surf_fa.F90
+++ b/src/SURFEX/open_aux_io_surf_fa.F90
@@ -4,7 +4,7 @@
!SFX_LIC for details. version 1.
! #######################################################
SUBROUTINE OPEN_AUX_IO_SURF_FA (&
- HFILE,HFILETYPE,HMASK)
+ HFILE,HFILETYPE,HMASK,HDIR)
! #######################################################
!
!!**** *OPEN_AUX_IO_SURF_ASC* - chooses the routine to OPENialize IO
@@ -39,22 +39,19 @@
! ------------
!
!
+USE MODD_SURFEX_MPI, ONLY : NRANK
+USE MODD_IO_SURF_FA, ONLY : NUNIT_FA,CFILEIN_FA,NMASK,NLUOUT,NFULL,CMASK, &
+ CDNOMC,IVERBFA
!
-!
-USE MODD_IO_SURF_FA,ONLY:NUNIT_FA,NLUOUT,NFULL,NMASK,CMASK,IVERBFA,CDNOMC
USE MODI_GET_LUOUT
USE MODI_READ_SURF
USE MODI_IO_BUFF_CLEAN
+USE MODI_GET_SURF_MASK_n
+USE MODI_GET_1D_MASK
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
-USE MODI_GET_SURF_MASK_n
-!
-USE MODI_GET_TYPE_DIM_n
-!RJ: missing modi
-USE MODI_GET_1D_MASK
-!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -65,46 +62,48 @@ IMPLICIT NONE
CHARACTER(LEN=28), INTENT(IN) :: HFILE ! file name
CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! main program
CHARACTER(LEN=6), INTENT(IN) :: HMASK
+ CHARACTER(LEN=1), INTENT(IN) :: HDIR
!
!* 0.2 Declarations of local variables
! -------------------------------
-!
- CHARACTER(LEN=28) :: YFILE
- CHARACTER(LEN=16), PARAMETER :: YCADRE='external'
!
INTEGER :: INB ! number of articles in the file
INTEGER, DIMENSION(:),POINTER :: IMASK
-INTEGER :: ILU,IRET
+INTEGER :: ILU, IRET, IL
REAL, DIMENSION(:),ALLOCATABLE :: ZFULL ! total cover
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('OPEN_AUX_IO_SURF_FA',0,ZHOOK_HANDLE)
- CALL IO_BUFF_CLEAN
- CALL GET_LUOUT(HFILETYPE,NLUOUT)
+CALL IO_BUFF_CLEAN
+CALL GET_LUOUT(HFILETYPE,NLUOUT)
!
-ILU =0
+NUNIT_FA = 20+NRANK
+CDNOMC = 'extern'
!
-YFILE=HFILE(1:LEN_TRIM(HFILE))//'.fa'
+ILU =0
!
- CALL FAITOU(IRET,NUNIT_FA,.TRUE.,YFILE,'OLD',.TRUE.,.FALSE.,IVERBFA,0,INB,YCADRE)
-WRITE(NLUOUT,*)'HFILETYPE ',HFILETYPE,'READ EXTERNAL',NUNIT_FA,YFILE
+CFILEIN_FA = ADJUSTL(ADJUSTR(HFILE)//'.fa')
+ CALL FAITOU(IRET,NUNIT_FA,.TRUE.,CFILEIN_FA,'OLD',.TRUE.,.FALSE.,IVERBFA,0,INB,CDNOMC)
+WRITE(NLUOUT,*)' FA OPEN_AUX_IO_SURF ',NUNIT_FA,CFILEIN_FA
+ CALL FACAGE(CDNOMC,.TRUE.)
!
- CMASK = 'FULL '
- CALL READ_SURF(&
- HFILETYPE,'DIM_FULL',ILU,IRET)
+CMASK = 'FULL '
+CALL READ_SURF(HFILETYPE,'DIM_FULL',ILU,IRET,HDIR=HDIR)
NFULL = ILU
!
!------------------------------------------------------------------------------
-!
-ALLOCATE(NMASK(NFULL))
ALLOCATE(ZFULL(NFULL))
-ZFULL=1.
- CALL GET_1D_MASK(NFULL,NFULL,ZFULL,NMASK)
+IL = NFULL
+ZFULL = 1.
+!
+ALLOCATE(NMASK(IL))
+CALL GET_1D_MASK(IL,NFULL,ZFULL,NMASK)
+!
DEALLOCATE(ZFULL)
!
!------------------------------------------------------------------------------
- CMASK = HMASK
+CMASK = HMASK
IF (LHOOK) CALL DR_HOOK('OPEN_AUX_IO_SURF_FA',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/open_file_asc.F90 b/src/SURFEX/open_file_asc.F90
index b6ab4eb4dea7484b6938a9eb74cdf41c726d6973..965ebfff2fcbba82a2f5e6ae01046966ff977b7a 100644
--- a/src/SURFEX/open_file_asc.F90
+++ b/src/SURFEX/open_file_asc.F90
@@ -86,7 +86,7 @@ ELSE
FORM=HFORM,ACCESS=HACCESS,RECL=KRECL, ERR=100 )
ELSE
OPEN(UNIT=KUNIT,FILE=HFILE,ACTION=HACTION, &
- FORM=HFORM, ERR=100 )
+ FORM=HFORM, ACCESS=HACCESS, ERR=100 )
END IF
END IF
!
diff --git a/src/SURFEX/open_file_fa.F90 b/src/SURFEX/open_file_fa.F90
index 8105b26f918ab6057c82c825ab1e1cc61769fabf..72ac78baa1d5b17cf35c363be1ecac82c692b679 100644
--- a/src/SURFEX/open_file_fa.F90
+++ b/src/SURFEX/open_file_fa.F90
@@ -86,7 +86,7 @@ ELSE
FORM=HFORM,ACCESS=HACCESS,RECL=KRECL, ERR=100 )
ELSE
OPEN(UNIT=KUNIT,FILE=HFILE,ACTION=HACTION, &
- FORM=HFORM, ERR=100 )
+ FORM=HFORM, ACCESS=HACCESS, ERR=100 )
END IF
END IF
!
diff --git a/src/SURFEX/open_namelist.F90 b/src/SURFEX/open_namelist.F90
index 5963cdd67a1ea9f8805d3d0c5787706fd3b2d4b7..a965cfc6a5f537a25bdf5b41911aede4b3461c61 100644
--- a/src/SURFEX/open_namelist.F90
+++ b/src/SURFEX/open_namelist.F90
@@ -55,6 +55,9 @@ USE MODI_OPEN_NAMELIST_NC
#ifdef SFX_MNH
USE MODI_MNHOPEN_NAMELIST
#endif
+#ifdef SFX_ARO
+USE MODI_AROOPEN_NAMELIST
+#endif
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -81,10 +84,9 @@ IF (LHOOK) CALL DR_HOOK('OPEN_NAMELIST',0,ZHOOK_HANDLE)
IF (PRESENT(HFILE)) THEN
YFILE = HFILE
ELSE
- YFILE = ' '
+ YFILE = ' '
END IF
-!$OMP SINGLE
IF (HPROGRAM=='MESONH') THEN
#ifdef SFX_MNH
CALL MNHOPEN_NAMELIST(HPROGRAM,KLUNAM,YFILE)
@@ -114,7 +116,6 @@ ELSE IF (HPROGRAM=='NC ') THEN
CALL OPEN_NAMELIST_NC(HPROGRAM,KLUNAM,YFILE)
#endif
END IF
-!$OMP END SINGLE COPYPRIVATE(KLUNAM)
!
IF (LHOOK) CALL DR_HOOK('OPEN_NAMELIST',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/outer_product.F90 b/src/SURFEX/outer_product.F90
deleted file mode 100644
index 9838fd1cfa7d081f4c7b82200065140858dabb58..0000000000000000000000000000000000000000
--- a/src/SURFEX/outer_product.F90
+++ /dev/null
@@ -1,76 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-SUBROUTINE OUTER_PRODUCT(KENS,KX,KY,PX,PY,PA,PC,OPB_CORRELATIONS,HVAR,HOBS)
-!---------------------------------------------------------
-!
-! Computes the outer product of two vectors X and Y
-! to produce a matrix A = XY**T
-!
-!
-! Jean-Francois MAHFOUF (11/06)
-!--------------------------------------------------------
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-INTEGER, INTENT(IN) :: KENS, KX, KY
-LOGICAL, INTENT(IN) :: OPB_CORRELATIONS
- CHARACTER(LEN=3), DIMENSION(KX), INTENT(IN) :: HVAR
- CHARACTER(LEN=3), DIMENSION(KY), INTENT(IN) :: HOBS
-REAL, DIMENSION(KX,KENS), INTENT(IN) :: PX
-REAL, DIMENSION(KY,KENS), INTENT(IN) :: PY
-REAL, DIMENSION(KX,KY), INTENT(OUT) :: PA
-REAL, DIMENSION(KY,KY), INTENT(OUT) :: PC
-!
-REAL, DIMENSION(KX,KENS) :: ZXPERT
-REAL, DIMENSION(KY,KENS) :: ZYPERT
-REAL, DIMENSION(KENS,KY) :: ZYT
-REAL, DIMENSION(KX) :: ZXM
-REAL, DIMENSION(KY) :: ZYM
-!
-INTEGER :: I, K, L
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-IF (LHOOK) CALL DR_HOOK('OUTER_PRODUCT',0,ZHOOK_HANDLE)
-!
-DO L = 1,KX
- !
- ZXM(L) = SUM(PX(L,:))/REAL(KENS)!MEAN
- ZXPERT(L,:) = PX(L,:)-ZXM(L) !ANOMALY
- !
-ENDDO
-!
-DO K = 1,KY
- ZYM(K) = SUM(PY(K,:))/REAL(KENS)
- ZYPERT(K,:) = PY(K,:)-ZYM(K)
-ENDDO
-!
-IF (OPB_CORRELATIONS) THEN
- !For 2D EnKF
- PA(:,:)=MATMUL(ZXPERT(:,:),TRANSPOSE(ZYPERT(:,:)))
- PC(:,:)=MATMUL(ZYPERT(:,:),TRANSPOSE(ZYPERT(:,:)))
- !
-ELSE
- !For 1D EnKF
- DO L = 1,KX
- DO K = 1,KY
- IF (HVAR(L).EQ.HOBS(K)) THEN
- PA(L,K) = DOT_PRODUCT(ZXPERT(L,:),ZYPERT(K,:))
- ELSE
- PA(L,K) = 0.0
- ENDIF
- ENDDO
- ENDDO
-ENDIF
-!
-PA = PA / REAL(KENS - 1)
-PC = PC / REAL(KENS - 1)
-!
-IF (LHOOK) CALL DR_HOOK('OUTER_PRODUCT',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE OUTER_PRODUCT
diff --git a/src/SURFEX/pack_ch_isba_patchn.F90 b/src/SURFEX/pack_ch_isba_patchn.F90
deleted file mode 100644
index c799f7a82aaf44ce31aed69941904a5fc5e13618..0000000000000000000000000000000000000000
--- a/src/SURFEX/pack_ch_isba_patchn.F90
+++ /dev/null
@@ -1,82 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE PACK_CH_ISBA_PATCH_n (CHI, PKCI, &
- KMASK,KSIZE,KNPATCH,KPATCH)
-!##############################################
-!
-!
-!!**** *PACK_CH_ISBA_PATCH_n * - packs chemistry variables
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!!------------------------------------------------------------------
-!
-!
-!
-USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
-USE MODD_PACK_CH_ISBA, ONLY : PACK_CH_ISBA_t
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!
-TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
-TYPE(PACK_CH_ISBA_t), INTENT(INOUT) :: PKCI
-!
-INTEGER, INTENT(IN) :: KSIZE, KPATCH, KNPATCH
-!
-INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
-!
-INTEGER JJ, JI
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!------------------------------------------------------------------------
-!
-! Packed surface module variables:
-!
-IF (LHOOK) CALL DR_HOOK('PACK_CH_ISBA_PATCH_N',0,ZHOOK_HANDLE)
-!
-ALLOCATE(PKCI%XBLOCK_SIMPLE(KSIZE,2))
-!
-PKCI%XP_SOILRC_SO2 => PKCI%XBLOCK_SIMPLE(:,1)
-PKCI%XP_SOILRC_O3 => PKCI%XBLOCK_SIMPLE(:,2)
-!
-ALLOCATE(PKCI%XP_DEP(KSIZE,CHI%SVI%NBEQ))
-!
-!------------------------------------------------------------------------
-!
-IF (KNPATCH==1) THEN
- PKCI%XP_SOILRC_SO2 (:) = CHI%XSOILRC_SO2 (:, 1)
- PKCI%XP_SOILRC_O3 (:) = CHI%XSOILRC_O3 (:, 1)
-ELSE
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKCI%XP_SOILRC_SO2 (JJ) = CHI%XSOILRC_SO2 (JI, KPATCH)
- PKCI%XP_SOILRC_O3 (JJ) = CHI%XSOILRC_O3 (JI, KPATCH)
- ENDDO
-END IF
-IF (LHOOK) CALL DR_HOOK('PACK_CH_ISBA_PATCH_N',1,ZHOOK_HANDLE)
-!
-!------------------------------------------------------------------------
-!
-END SUBROUTINE PACK_CH_ISBA_PATCH_n
diff --git a/src/SURFEX/pack_diag_patch_get_sizen.F90 b/src/SURFEX/pack_diag_patch_get_sizen.F90
deleted file mode 100644
index f694d7090da0971e2df49e168dc763769b5ad241..0000000000000000000000000000000000000000
--- a/src/SURFEX/pack_diag_patch_get_sizen.F90
+++ /dev/null
@@ -1,144 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE PACK_DIAG_PATCH_GET_SIZE_n (DGEI, DGI, DGMI, I, PKDI, &
- KPATCH)
-!##############################################
-!
-!!**** *PACK_DIAG_PATCH_GET_SIZE_n* - packs ISBA diagnostics
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! Modified 10/2004 by P. Le Moigne: Halstead coefficient
-!! Modified 10/2005 by P. Le Moigne: Allocation (not EBA case)
-!! Modified 2008 by B. Decharme : Allocation for the floodplains
-!! Modified 04-09 by A.L. Gibelin : Add carbon diagnostics
-!! Modified 10-14 by P. Samuelsson: MEB
-!!
-!!------------------------------------------------------------------
-!
-!
-!
-!
-USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
-USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
-USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_PACK_DIAG_ISBA, ONLY : PACK_DIAG_ISBA_t
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!
-TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DGEI
-TYPE(DIAG_ISBA_t), INTENT(INOUT) :: DGI
-TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DGMI
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(PACK_DIAG_ISBA_t), INTENT(INOUT) :: PKDI
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-INTEGER, INTENT(IN) :: KPATCH
-!------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('PACK_DIAG_PATCH_GET_SIZE_N',0,ZHOOK_HANDLE)
-!
-PKDI%NSIZE_SIMPLE=59
-PKDI%NSIZE_GROUND=0
-PKDI%NSIZE_SNOW=0
-PKDI%NSIZE_KSW=2
-PKDI%NSIZE_ABC=0
-PKDI%NSIZE_0=0
-PKDI%NSIZE_00=0
-!
-IF (I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO') THEN
- PKDI%NSIZE_SIMPLE=PKDI%NSIZE_SIMPLE+25
- PKDI%NSIZE_SNOW=PKDI%NSIZE_SNOW+2
-ELSE
- PKDI%NSIZE_0=PKDI%NSIZE_0+25
- PKDI%NSIZE_00=PKDI%NSIZE_00+2
-ENDIF
-!
-IF(I%TSNOW%SCHEME/='EBA') THEN
- PKDI%NSIZE_SNOW=PKDI%NSIZE_SNOW+1
-ELSE
- PKDI%NSIZE_00=PKDI%NSIZE_00+1
-ENDIF
-!
-IF(I%TSNOW%SCHEME=='EBA') THEN
- PKDI%NSIZE_SIMPLE=PKDI%NSIZE_SIMPLE+2
-ELSE
- PKDI%NSIZE_0=PKDI%NSIZE_0+2
-ENDIF
-!
-IF (I%LTR_ML) THEN
- PKDI%NSIZE_SIMPLE=PKDI%NSIZE_SIMPLE+4
-ELSE
- PKDI%NSIZE_0=PKDI%NSIZE_0+4
-ENDIF
-!
-IF (I%CPHOTO/='NON') THEN
- PKDI%NSIZE_ABC=PKDI%NSIZE_ABC+1
-ELSE
- PKDI%NSIZE_00=PKDI%NSIZE_00+1
-ENDIF
-!
-IF (DGI%N2M>=1) THEN
- PKDI%NSIZE_SIMPLE=PKDI%NSIZE_SIMPLE+5
-ELSE
- PKDI%NSIZE_0=PKDI%NSIZE_0+5
-ENDIF
-!
-IF (DGMI%LSURF_MISC_BUDGET) THEN
- PKDI%NSIZE_GROUND=PKDI%NSIZE_GROUND+2
- PKDI%NSIZE_SIMPLE=PKDI%NSIZE_SIMPLE+2
-ELSE
- PKDI%NSIZE_00=PKDI%NSIZE_00+2
- PKDI%NSIZE_0=PKDI%NSIZE_0+2
-ENDIF
-!
-IF(I%LGLACIER)THEN
- PKDI%NSIZE_SIMPLE=PKDI%NSIZE_SIMPLE+1
-ELSE
- PKDI%NSIZE_0=PKDI%NSIZE_0+1
-ENDIF
-!
-! MEB STUFF START
-IF (I%LMEB_PATCH(KPATCH))THEN
-! NSIZE_SIMPLE=NSIZE_SIMPLE+27
- PKDI%NSIZE_SIMPLE=PKDI%NSIZE_SIMPLE+29
-ELSE
-! NSIZE_0=NSIZE_0+27
- PKDI%NSIZE_0=PKDI%NSIZE_0+29
-ENDIF
-PKDI%NSIZE_0=PKDI%NSIZE_0+2
-! MEB STUFF END
-!
-IF(DGEI%LWATER_BUDGET)THEN
- PKDI%NSIZE_SIMPLE=PKDI%NSIZE_SIMPLE+5
-ELSE
- PKDI%NSIZE_0=PKDI%NSIZE_0+5
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('PACK_DIAG_PATCH_GET_SIZE_N',1,ZHOOK_HANDLE)
-!------------------------------------------------------------------------
-!
-END SUBROUTINE PACK_DIAG_PATCH_GET_SIZE_n
diff --git a/src/SURFEX/pack_diag_patchn.F90 b/src/SURFEX/pack_diag_patchn.F90
deleted file mode 100644
index cd0477c2ab0f02395b6b676c5f6425da6c494efe..0000000000000000000000000000000000000000
--- a/src/SURFEX/pack_diag_patchn.F90
+++ /dev/null
@@ -1,613 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE PACK_DIAG_PATCH_n (DGEI, DGI, DGMI, I, PKDI, &
- KSIZE,KSW,KPATCH)
-!##############################################
-!
-!!**** *PACK_DIAG_PATCH_n* - packs ISBA diagnostics
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! Modified 10/2004 by P. Le Moigne: Halstead coefficient
-!! Modified 10/2005 by P. Le Moigne: Allocation (not EBA case)
-!! Modified 2008 by B. Decharme : Allocation for the floodplains
-!! Modified 04-09 by A.L. Gibelin : Add carbon diagnostics
-!! B. Decharme 04/2013 DIF lateral subsurface drainage
-!! Sublimation diag flux
-!! Modified 10-14 by P. Samuelsson: MEB
-!!
-!!------------------------------------------------------------------
-!
-!
-!
-!
- ! End For multi-energy balance
-
-
-!
-!
-USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
-USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
-USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_PACK_DIAG_ISBA, ONLY : PACK_DIAG_ISBA_t
-!
-USE MODI_ABOR1_SFX
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!
-TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DGEI
-TYPE(DIAG_ISBA_t), INTENT(INOUT) :: DGI
-TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DGMI
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(PACK_DIAG_ISBA_t), INTENT(INOUT) :: PKDI
-!
-INTEGER, INTENT(IN) :: KSIZE, KSW, KPATCH
-!
-INTEGER :: ISIZE_SIMPLE, ISIZE_GROUND, ISIZE_SNOW, ISIZE_KSW, &
- ISIZE_ABC, ISIZE_0, ISIZE_00
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('PACK_DIAG_PATCH_N',0,ZHOOK_HANDLE)
-!
-! Packed surface module variables:
-!
-ALLOCATE(PKDI%XBLOCK_SIMPLE(KSIZE,PKDI%NSIZE_SIMPLE))
-ALLOCATE(PKDI%XBLOCK_GROUND(KSIZE,I%NGROUND_LAYER,PKDI%NSIZE_GROUND))
-ALLOCATE(PKDI%XBLOCK_SNOW(KSIZE,I%TSNOW%NLAYER,PKDI%NSIZE_SNOW))
-ALLOCATE(PKDI%XBLOCK_KSW(KSIZE,KSW,PKDI%NSIZE_KSW))
-ALLOCATE(PKDI%XBLOCK_ABC(KSIZE,SIZE(I%XABC),PKDI%NSIZE_ABC))
-ALLOCATE(PKDI%XBLOCK_0(0,PKDI%NSIZE_0))
-ALLOCATE(PKDI%XBLOCK_00(0,0,PKDI%NSIZE_00))
-!
-ISIZE_SIMPLE=0
-ISIZE_GROUND=0
-ISIZE_SNOW=0
-ISIZE_KSW=0
-ISIZE_ABC=0
-ISIZE_0=0
-ISIZE_00=0
-!
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_CH => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_CE => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_CD => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_CDN => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_RI => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_HU => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_HUG => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_ALBT => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_RN => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_H => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_LEI => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_LEG => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_LEGI => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_LEV => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_LES => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_LER => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_LETR => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_GFLUX => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_EVAP => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_SUBL => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_RESTORE => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_DRAIN => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_QSB => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_RUNOFF => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_MELT => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_MELTADV => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_SRSFC => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_RRSFC => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_SNOWFREE_ALB=> PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-!
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_HORT => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_DRIP => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_RRVEG => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_IRRIG_FLUX=> PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-!
-ISIZE_KSW = ISIZE_KSW + 1
-PKDI%XP_SWBD => PKDI%XBLOCK_KSW(:,:,ISIZE_KSW)
-ISIZE_KSW = ISIZE_KSW + 1
-PKDI%XP_SWBU => PKDI%XBLOCK_KSW(:,:,ISIZE_KSW)
-!
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_SWD => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_SWU => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_LWD => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_LWU => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_FMU => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_FMV => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-!
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_Z0_WITH_SNOW => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_Z0H_WITH_SNOW=> PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_Z0EFF => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-!
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_CG => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_C1 => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_C2 => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_WGEQ => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_CT => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_RS => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_HV => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_QS => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-!
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_TS => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_TSRAD => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-!
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_RESP_AUTO => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_RESP_ECO => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_GPP => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-!
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_IFLOOD => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_PFLOOD => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_LE_FLOOD => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKDI%XP_LEI_FLOOD=> PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-!
-IF (I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO') THEN
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_RNSNOW => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_HSNOW => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_HPSNOW => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_GFLUXSNOW => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_USTARSNOW => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_GRNDFLUX => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LESL => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_SNDRIFT => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_CDSNOW => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_CHSNOW => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_SNOWHMASS => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_RN_ISBA => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_H_ISBA => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LEG_ISBA => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LEGI_ISBA => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LEV_ISBA => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LETR_ISBA => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_USTAR_ISBA=> PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LER_ISBA => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LE_ISBA => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LEI_ISBA => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_GFLUX_ISBA=> PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SNOW = ISIZE_SNOW + 1
- PKDI%XP_SNOWLIQ => PKDI%XBLOCK_SNOW(:,:,ISIZE_SNOW)
- ISIZE_SNOW = ISIZE_SNOW + 1
- PKDI%XP_SNOWDZ => PKDI%XBLOCK_SNOW(:,:,ISIZE_SNOW)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_SWNET_N => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_SWNET_NS => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LWNET_N => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ELSE
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_RNSNOW => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_HSNOW => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_HPSNOW => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_GFLUXSNOW => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_USTARSNOW => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_GRNDFLUX => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LESL => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_SNDRIFT => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_CDSNOW => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_CHSNOW => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_SNOWHMASS => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_RN_ISBA => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_H_ISBA => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LEG_ISBA => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LEGI_ISBA => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LEV_ISBA => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LETR_ISBA => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_USTAR_ISBA=> PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LER_ISBA => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LE_ISBA => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LEI_ISBA => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_GFLUX_ISBA=> PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_00 = ISIZE_00 + 1
- PKDI%XP_SNOWLIQ => PKDI%XBLOCK_00(:,:,ISIZE_00)
- ISIZE_00 = ISIZE_00 + 1
- PKDI%XP_SNOWDZ => PKDI%XBLOCK_00(:,:,ISIZE_00)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_SWNET_N => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_SWNET_NS => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LWNET_N => PKDI%XBLOCK_0(:,ISIZE_0)
-END IF
-!
-IF(I%TSNOW%SCHEME/='EBA') THEN
- ISIZE_SNOW = ISIZE_SNOW + 1
- PKDI%XP_SNOWTEMP => PKDI%XBLOCK_SNOW(:,:,ISIZE_SNOW)
-ELSE
- ISIZE_00 = ISIZE_00 + 1
- PKDI%XP_SNOWTEMP => PKDI%XBLOCK_00(:,:,ISIZE_00)
-ENDIF
-!
-IF(I%TSNOW%SCHEME=='EBA') THEN
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_SNOWFREE_ALB_VEG=> PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_SNOWFREE_ALB_SOIL=> PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ELSE
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_SNOWFREE_ALB_VEG=> PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_SNOWFREE_ALB_SOIL=> PKDI%XBLOCK_0(:,ISIZE_0)
-ENDIF
-!
-IF (I%LTR_ML) THEN
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_FAPAR => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_FAPIR => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_FAPAR_BS => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_FAPIR_BS => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ELSE
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_FAPAR => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_FAPIR => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_FAPAR_BS => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_FAPIR_BS => PKDI%XBLOCK_0(:,ISIZE_0)
-END IF
-!
-IF (I%CPHOTO/='NON') THEN
- ISIZE_ABC = ISIZE_ABC + 1
- PKDI%XP_IACAN => PKDI%XBLOCK_ABC(:,:,ISIZE_ABC)
-ELSE
- ISIZE_00 = ISIZE_00 + 1
- PKDI%XP_IACAN => PKDI%XBLOCK_00(:,:,ISIZE_00)
-END IF
-!
-IF (DGI%N2M>=1) THEN
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_T2M => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_Q2M => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_HU2M => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_ZON10M => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_MER10M => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ELSE
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_T2M => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_Q2M => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_HU2M => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_ZON10M => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_MER10M => PKDI%XBLOCK_0(:,ISIZE_0)
-END IF
-!
-IF (DGMI%LSURF_MISC_BUDGET) THEN
- ISIZE_GROUND = ISIZE_GROUND + 1
- PKDI%XP_SWI => PKDI%XBLOCK_GROUND(:,:,ISIZE_GROUND)
- ISIZE_GROUND = ISIZE_GROUND + 1
- PKDI%XP_TSWI => PKDI%XBLOCK_GROUND(:,:,ISIZE_GROUND)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_TWSNOW => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_TDSNOW => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ELSE
- ISIZE_00 = ISIZE_00 + 1
- PKDI%XP_SWI => PKDI%XBLOCK_00(:,:,ISIZE_00)
- ISIZE_00 = ISIZE_00 + 1
- PKDI%XP_TSWI => PKDI%XBLOCK_00(:,:,ISIZE_00)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_TWSNOW => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_TDSNOW => PKDI%XBLOCK_0(:,ISIZE_0)
-ENDIF
-!
-IF(I%LGLACIER)THEN
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_ICEFLUX=> PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ELSE
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_ICEFLUX=> PKDI%XBLOCK_0(:,ISIZE_0)
-ENDIF
-!
-! MEB STUFF START
-IF (I%LMEB_PATCH(KPATCH))THEN
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_SWUP => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_SWNET_V => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_SWNET_G => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LWUP => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LWNET_V => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LWNET_G => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LEVCV => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LESC => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_H_V_C => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_H_G_C => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-! ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-! XP_LETRGV => XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LETRCV => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-! ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-! XP_LERGV => XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LELITTER => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LELITTERI => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_DRIPLIT => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_RRLIT => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LERCV => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_H_C_A => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_H_N_C => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LE_C_A => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LE_V_C => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LE_G_C => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LE_N_C => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_EVAP_N_C => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_EVAP_G_C => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_SR_GN => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_MELTCV => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_FRZCV => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_SWDOWN_GN => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_LWDOWN_GN => PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ELSE
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_SWUP => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_SWNET_V => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_SWNET_G => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LWUP => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LWNET_V => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LWNET_G => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LEVCV => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LESC => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_H_V_C => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_H_G_C => PKDI%XBLOCK_0(:,ISIZE_0)
-! ISIZE_0 = ISIZE_0 + 1
-! XP_LETRGV => XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LETRCV => PKDI%XBLOCK_0(:,ISIZE_0)
-! ISIZE_0 = ISIZE_0 + 1
-! XP_LERGV => XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LELITTER => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LELITTERI => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_DRIPLIT => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_RRLIT => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LERCV => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_H_C_A => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_H_N_C => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LE_C_A => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LE_V_C => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LE_G_C => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LE_N_C => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_EVAP_N_C => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_EVAP_G_C => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_SR_GN => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_MELTCV => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_FRZCV => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_SWDOWN_GN => PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_LWDOWN_GN => PKDI%XBLOCK_0(:,ISIZE_0)
-ENDIF
-ISIZE_0 = ISIZE_0 + 1
-PKDI%XP_LETRGV => PKDI%XBLOCK_0(:,ISIZE_0)
-ISIZE_0 = ISIZE_0 + 1
-PKDI%XP_LERGV => PKDI%XBLOCK_0(:,ISIZE_0)
-!
-IF(DGEI%LWATER_BUDGET)THEN
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_DWG=> PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_DWGI=> PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_DWR=> PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_DSWE=> PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKDI%XP_WATBUD=> PKDI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ELSE
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_DWG=> PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_DWGI=> PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_DWR=> PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_DSWE=> PKDI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKDI%XP_WATBUD=> PKDI%XBLOCK_0(:,ISIZE_0)
-ENDIF
-!
-!
-IF (ISIZE_SIMPLE.GT.PKDI%NSIZE_SIMPLE) &
- CALL ABOR1_SFX("PACK_DIAG_PATCH_n: PROBLEM DEFINING SIZE_SIMPLE / NUMBER OF FIELDS")
-IF (ISIZE_GROUND.GT.PKDI%NSIZE_GROUND) &
- CALL ABOR1_SFX("PACK_DIAG_PATCH_n: PROBLEM DEFINING SIZE_GROUND / NUMBER OF FIELDS")
-IF (ISIZE_SNOW.GT.PKDI%NSIZE_SNOW) &
- CALL ABOR1_SFX("PACK_DIAG_PATCH_n: PROBLEM DEFINING SIZE_SNOW / NUMBER OF FIELDS")
-IF (ISIZE_KSW.GT.PKDI%NSIZE_KSW) &
- CALL ABOR1_SFX("PACK_DIAG_PATCH_n: PROBLEM DEFINING SIZE_KSW / NUMBER OF FIELDS")
-IF (ISIZE_ABC.GT.PKDI%NSIZE_ABC) &
- CALL ABOR1_SFX("PACK_DIAG_PATCH_n: PROBLEM DEFINING SIZE_3 / NUMBER OF FIELDS")
-IF (ISIZE_0.GT.PKDI%NSIZE_0) &
- CALL ABOR1_SFX("PACK_DIAG_PATCH_n: PROBLEM DEFINING SIZE_0 / NUMBER OF FIELDS")
-IF (ISIZE_00.GT.PKDI%NSIZE_00) &
- CALL ABOR1_SFX("PACK_DIAG_PATCH_n: PROBLEM DEFINING SIZE_00 / NUMBER OF FIELDS")
-!
-IF (LHOOK) CALL DR_HOOK('PACK_DIAG_PATCH_N',1,ZHOOK_HANDLE)
-!------------------------------------------------------------------------
-!
-END SUBROUTINE PACK_DIAG_PATCH_n
diff --git a/src/SURFEX/pack_grid_gauss.F90 b/src/SURFEX/pack_grid_gauss.F90
index 0ce028ded4aefb8e5a54ac2a7c96542078b44b43..83d7012517c28cd098988aa27a8b2fdc544d32bb 100644
--- a/src/SURFEX/pack_grid_gauss.F90
+++ b/src/SURFEX/pack_grid_gauss.F90
@@ -94,7 +94,7 @@ IF (LHOOK) CALL DR_HOOK('PACK_GRID_GAUSS',0,ZHOOK_HANDLE)
!* 1. Computes grid parameters
! ------------------------
!
- CALL GET_GRIDTYPE_GAUSS(PGRID_PAR1,INLATI,KL=IL)
+CALL GET_GRIDTYPE_GAUSS(PGRID_PAR1,INLATI,KL=IL)
!
ALLOCATE(INLOPA (INLATI))
ALLOCATE(ZLAT_XY1 (IL))
@@ -107,7 +107,7 @@ ALLOCATE(ZLATINF1 (IL))
ALLOCATE(ZLONSUP1 (IL))
ALLOCATE(ZLATSUP1 (IL))
!
- CALL GET_GRIDTYPE_GAUSS(PGRID_PAR1,INLATI,ZLAPO,ZLOPO,ZCODIL,INLOPA(:), &
+CALL GET_GRIDTYPE_GAUSS(PGRID_PAR1,INLATI,ZLAPO,ZLOPO,ZCODIL,INLOPA(:), &
IL,ZLAT1,ZLON1,ZLAT_XY1,ZLON_XY1,ZMESH_SIZE1 , &
ZLONINF1,ZLATINF1,ZLONSUP1,ZLATSUP1 )
!
@@ -127,15 +127,15 @@ ALLOCATE(ZLATINF2 (KMASK_SIZE))
ALLOCATE(ZLONSUP2 (KMASK_SIZE))
ALLOCATE(ZLATSUP2 (KMASK_SIZE))
!
- CALL PACK_SAME_RANK(KMASK,ZLAT_XY1,ZLAT_XY2)
- CALL PACK_SAME_RANK(KMASK,ZLON_XY1,ZLON_XY2)
- CALL PACK_SAME_RANK(KMASK,ZLAT1,ZLAT2)
- CALL PACK_SAME_RANK(KMASK,ZLON1,ZLON2)
- CALL PACK_SAME_RANK(KMASK,ZMESH_SIZE1,ZMESH_SIZE2)
- CALL PACK_SAME_RANK(KMASK,ZLONINF1,ZLONINF2)
- CALL PACK_SAME_RANK(KMASK,ZLATINF1,ZLATINF2)
- CALL PACK_SAME_RANK(KMASK,ZLONSUP1,ZLONSUP2)
- CALL PACK_SAME_RANK(KMASK,ZLATSUP1,ZLATSUP2)
+CALL PACK_SAME_RANK(KMASK,ZLAT_XY1,ZLAT_XY2)
+CALL PACK_SAME_RANK(KMASK,ZLON_XY1,ZLON_XY2)
+CALL PACK_SAME_RANK(KMASK,ZLAT1,ZLAT2)
+CALL PACK_SAME_RANK(KMASK,ZLON1,ZLON2)
+CALL PACK_SAME_RANK(KMASK,ZMESH_SIZE1,ZMESH_SIZE2)
+CALL PACK_SAME_RANK(KMASK,ZLONINF1,ZLONINF2)
+CALL PACK_SAME_RANK(KMASK,ZLATINF1,ZLATINF2)
+CALL PACK_SAME_RANK(KMASK,ZLONSUP1,ZLONSUP2)
+CALL PACK_SAME_RANK(KMASK,ZLATSUP1,ZLATSUP2)
!
DEALLOCATE(ZLAT_XY1 )
DEALLOCATE(ZLON_XY1 )
@@ -152,7 +152,7 @@ DEALLOCATE(ZLATSUP1 )
!* 3. Stores data in new grid vector
! ------------------------------
!
- CALL PUT_GRIDTYPE_GAUSS(ZGRID_PAR2,INLATI,ZLAPO,ZLOPO,ZCODIL,INLOPA(:), &
+CALL PUT_GRIDTYPE_GAUSS(ZGRID_PAR2,INLATI,ZLAPO,ZLOPO,ZCODIL,INLOPA(:), &
KMASK_SIZE,ZLAT2,ZLON2,ZLAT_XY2,ZLON_XY2, &
ZMESH_SIZE2,ZLONINF2,ZLATINF2,ZLONSUP2,ZLATSUP2 )
!
diff --git a/src/SURFEX/pack_grid_ign.F90 b/src/SURFEX/pack_grid_ign.F90
index 66d76d20c4b95efba031bd9ca63933684bf5aefb..b3a3c1136e49795f26d4c7944e07511e84d532bb 100644
--- a/src/SURFEX/pack_grid_ign.F90
+++ b/src/SURFEX/pack_grid_ign.F90
@@ -32,7 +32,8 @@
!* 0. DECLARATION
! -----------
!
-USE MODI_GET_XYALL_IGN
+USE MODD_SURFEX_MPI, ONLY : NRANK
+!
USE MODI_PACK_SAME_RANK
USE MODE_GRIDTYPE_IGN
!
@@ -92,8 +93,8 @@ ALLOCATE(ZX2 (KMASK_SIZE))
ALLOCATE(ZY2 (KMASK_SIZE))
ALLOCATE(ZDX2(KMASK_SIZE))
ALLOCATE(ZDY2(KMASK_SIZE))
-ALLOCATE(ZXALL(KMASK_SIZE*3))
-ALLOCATE(ZYALL(KMASK_SIZE*3))
+ALLOCATE(ZXALL(0))
+ALLOCATE(ZYALL(0))
!
CALL PACK_SAME_RANK(KMASK,ZX1 ,ZX2 )
CALL PACK_SAME_RANK(KMASK,ZY1 ,ZY2 )
@@ -105,10 +106,7 @@ DEALLOCATE(ZY1 )
DEALLOCATE(ZDX1)
DEALLOCATE(ZDY1)
!
- CALL GET_XYALL_IGN(ZX2,ZY2,ZDX2,ZDY2,ZXALL,ZYALL,IDIMX,IDIMY)
-!
- CALL PUT_GRIDTYPE_IGN(ZGRID_PAR2,ILAMBERT,ZX2,ZY2,ZDX2,ZDY2, &
- IDIMX,IDIMY,ZXALL(1:IDIMX),ZYALL(1:IDIMY))
+ CALL PUT_GRIDTYPE_IGN(ZGRID_PAR2,ILAMBERT,ZX2,ZY2,ZDX2,ZDY2,0,0,ZXALL,ZYALL)
!
DEALLOCATE(ZXALL)
DEALLOCATE(ZYALL)
diff --git a/src/SURFEX/pack_init.F90 b/src/SURFEX/pack_init.F90
new file mode 100644
index 0000000000000000000000000000000000000000..92742ac1ea95256b9ddb6fd5d96d31b4bf033fcd
--- /dev/null
+++ b/src/SURFEX/pack_init.F90
@@ -0,0 +1,160 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE PACK_INIT(DTCO, U, UG, HPROGRAM, HSURF, G, OCOVER, PCOVER, PZS, PDIR )
+! ##############################################################
+!
+!!**** *PACK_INIT* packs ISBA physiographic fields from all surface points to ISBA points
+!!
+!! PURPOSE
+!! -------
+!!
+!! METHOD
+!! ------
+!!
+!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! V. Masson Meteo-France
+!!
+!! MODIFICATION
+!! ------------
+!!
+!! Original 03/2004
+!! Escobar J. 08/02/2005 : bug declare ILU local variable
+!!
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATION
+! -----------
+!
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+!
+USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
+!
+USE MODI_GET_COVER_n
+USE MODI_GET_LCOVER_n
+USE MODI_GET_ZS_n
+USE MODI_PACK_SAME_RANK
+USE MODI_PACK_GRID
+USE MODI_LATLON_GRID
+!
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODI_GET_SURF_MASK_n
+!
+USE MODI_GET_TYPE_DIM_n
+!
+USE MODI_GET_LUOUT
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
+ CHARACTER(LEN=6), INTENT(IN) :: HSURF ! surface type
+!
+TYPE(GRID_t), INTENT(INOUT) :: G
+LOGICAL, DIMENSION(:), INTENT(OUT):: OCOVER ! list of present cover
+REAL, DIMENSION(:,:), POINTER :: PCOVER ! cover fraction
+REAL, DIMENSION(:), INTENT(OUT):: PZS ! zs
+REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PDIR ! angle of grid axis with N.
+!
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+INTEGER :: ILUOUT ! output listing logical unit
+INTEGER :: IL ! number of points
+INTEGER :: ILU ! expected physical size of full surface array
+INTEGER :: JCOVER
+INTEGER, DIMENSION(:), POINTER :: IMASK ! mask for packing from complete field to nature field
+REAL, DIMENSION(SIZE(G%XLAT)) :: ZDIR
+!
+REAL, DIMENSION(U%NSIZE_FULL) :: ZCOVER ! cover on all surface points
+REAL, DIMENSION(U%NSIZE_FULL) :: ZZS ! zs on all surface points
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('PACK_INIT',0,ZHOOK_HANDLE)
+ CALL GET_LUOUT(HPROGRAM,ILUOUT)
+!
+!* 1. Number of points and packing
+! ----------------------------
+!
+ CALL GET_TYPE_DIM_n(DTCO,U,HSURF,IL)
+!
+ALLOCATE(IMASK(IL))
+ILU=0
+ CALL GET_SURF_MASK_n(DTCO,U,HSURF,IL,IMASK,ILU,ILUOUT)
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. Packing of grid
+! ---------------
+!
+ CALL PACK_GRID(IMASK,UG%G%CGRID,G%CGRID,UG%G%XGRID_PAR,G%XGRID_PAR)
+!
+ CALL GET_LCOVER_n(U,HPROGRAM,JPCOVER,OCOVER)
+!
+IF (IL==0) THEN
+ ALLOCATE(PCOVER(0,0))
+ IF (LHOOK) CALL DR_HOOK('PACK_INIT',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. Computes geographical quantities
+! --------------------------------
+!
+ CALL LATLON_GRID(G,IL,ZDIR)
+!
+IF (PRESENT(PDIR)) PDIR = ZDIR
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. Packing of fields
+! -----------------
+!
+ALLOCATE(PCOVER(SIZE(G%XLAT),COUNT(OCOVER)))
+!
+DO JCOVER=1,COUNT(OCOVER)
+ CALL GET_COVER_n(U,HPROGRAM,JCOVER,ZCOVER)
+ CALL PACK_SAME_RANK(IMASK,ZCOVER(:),PCOVER(:,JCOVER))
+ENDDO
+ CALL GET_ZS_n(U,HPROGRAM,U%NSIZE_FULL,ZZS)
+!
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+!
+ CALL PACK_SAME_RANK(IMASK,ZZS(:),PZS(:))
+!
+!-------------------------------------------------------------------------------
+!
+DEALLOCATE(IMASK)
+IF (LHOOK) CALL DR_HOOK('PACK_INIT',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE PACK_INIT
diff --git a/src/SURFEX/pack_isba_patch_get_sizen.F90 b/src/SURFEX/pack_isba_patch_get_sizen.F90
deleted file mode 100644
index f7a9f2de5bcf433567b74d49e8ace35e33ceb435..0000000000000000000000000000000000000000
--- a/src/SURFEX/pack_isba_patch_get_sizen.F90
+++ /dev/null
@@ -1,245 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE PACK_ISBA_PATCH_GET_SIZE_n (I, PKI, &
- KPATCH)
-!##############################################
-!
-!
-!!**** *PACK_ISBA_PATCH_GET_SIZE_n * - packs ISBA variables
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson and A. boone
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! B. Decharme 2008 floodplains
-!! B. Decharme 01/2009 Good dim for XP_TG
-!! A.L. Gibelin 04/2009 : BIOMASS and RESP_BIOMASS arrays
-!! A.L. Gibelin 04/2009 : TAU_WOOD for NCB option
-!! A.L. Gibelin 05/2009 : Add carbon spinup
-!! A.L. Gibelin 06/2009 : Soil carbon variables for CNT option
-!! A.L. Gibelin 07/2009 : Suppress RDK and transform GPP as a diagnostic
-!! A.L. Gibelin 07/2009 : Suppress PPST and PPSTF as outputs
-!! B. Decharme 04/2013 : DIF lateral subsurface drainage
-!! water table / surface coupling
-!! P Samuelsson 10/2014 : MEB
-!!
-!!------------------------------------------------------------------
-!
-!
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_PACK_ISBA, ONLY : PACK_ISBA_t
-!
-USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
-!
-USE MODD_AGRI, ONLY : LAGRIP
-USE MODD_TREEDRAG, ONLY : LTREEDRAG
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(PACK_ISBA_t), INTENT(INOUT) :: PKI
-!
-INTEGER, INTENT(IN) :: KPATCH
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('PACK_ISBA_PATCH_GET_SIZE_N',0,ZHOOK_HANDLE)
-!
-PKI%NSIZE_LSIMPLE=0
-PKI%NSIZE_L0=0
-!
-PKI%NSIZE_NSIMPLE=0
-PKI%NSIZE_N0=0
-!
-PKI%NSIZE_TSIMPLE=0
-PKI%NSIZE_T0=0
-!
-PKI%NSIZE_SIMPLE=67
-PKI%NSIZE_GROUND=11
-PKI%NSIZE_VEGTYPE=1
-PKI%NSIZE_TG=1
-PKI%NSIZE_SNOW=2
-PKI%NSIZE_ALB=2
-PKI%NSIZE_2=0
-PKI%NSIZE_BIOMASS=0
-PKI%NSIZE_LITTER=0
-PKI%NSIZE_SOILCARB=0
-PKI%NSIZE_LITTLEVS=0
-!
-PKI%NSIZE_0=0
-PKI%NSIZE_00=0
-PKI%NSIZE_000=0
-PKI%NSIZE_01=0
-!
-IF (I%TSNOW%SCHEME=='EBA') THEN
- PKI%NSIZE_SIMPLE=PKI%NSIZE_SIMPLE+1
-ELSE
- PKI%NSIZE_0=PKI%NSIZE_0+1
-ENDIF
-!
-IF (I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO') THEN
- PKI%NSIZE_SIMPLE=PKI%NSIZE_SIMPLE+4
- PKI%NSIZE_SNOW=PKI%NSIZE_SNOW+2
-ELSE
- PKI%NSIZE_0=PKI%NSIZE_0+4
- PKI%NSIZE_00=PKI%NSIZE_00+2
-ENDIF
-!
-IF(I%TSNOW%SCHEME=='CRO') THEN
- PKI%NSIZE_SNOW=PKI%NSIZE_SNOW+3
-ELSE
- PKI%NSIZE_00=PKI%NSIZE_00+3
-ENDIF
-!
-IF(I%LGLACIER) THEN
- PKI%NSIZE_SIMPLE=PKI%NSIZE_SIMPLE+1
-ELSE
- PKI%NSIZE_0=PKI%NSIZE_0+1
-ENDIF
-!
-IF (I%CSCOND=='PL98'.OR.I%CISBA=='DIF') THEN
- PKI%NSIZE_GROUND=PKI%NSIZE_GROUND+3
-ELSE
- PKI%NSIZE_01=PKI%NSIZE_01+3
-ENDIF
-!
-IF (I%CISBA=='2-L' .OR. I%CISBA=='3-L') THEN
- PKI%NSIZE_SIMPLE=PKI%NSIZE_SIMPLE+7
- PKI%NSIZE_2=PKI%NSIZE_2+1
-ELSE
- PKI%NSIZE_0=PKI%NSIZE_0+7
- PKI%NSIZE_00=PKI%NSIZE_00+1
-ENDIF
-!
-IF (I%CISBA=='DIF') THEN
- PKI%NSIZE_GROUND=PKI%NSIZE_GROUND+4
- PKI%NSIZE_NSIMPLE=PKI%NSIZE_NSIMPLE+1
- PKI%NSIZE_SIMPLE=PKI%NSIZE_SIMPLE+2
-ELSE
- PKI%NSIZE_01=PKI%NSIZE_01+4
- PKI%NSIZE_N0=PKI%NSIZE_N0+1
- PKI%NSIZE_0=PKI%NSIZE_0+2
-ENDIF
-!
-IF (I%CISBA=='DIF'.AND.I%CRUNOFF=='SGH') THEN
- PKI%NSIZE_GROUND=PKI%NSIZE_GROUND+1
-ELSE
- PKI%NSIZE_01=PKI%NSIZE_01+1
-ENDIF
-!
-IF (I%LTR_ML) THEN
- PKI%NSIZE_SIMPLE = PKI%NSIZE_SIMPLE+4
-ELSE
- PKI%NSIZE_0 = PKI%NSIZE_0+4
-ENDIF
-!
-IF (I%CPHOTO=='NON') THEN
- PKI%NSIZE_SIMPLE=PKI%NSIZE_SIMPLE+1
-ELSE
- PKI%NSIZE_0 = PKI%NSIZE_0+1
-ENDIF
-!
-IF (I%CPHOTO/='NON'.OR.LTREEDRAG) THEN
- PKI%NSIZE_SIMPLE=PKI%NSIZE_SIMPLE+1
-ELSE
- PKI%NSIZE_0 = PKI%NSIZE_0+1
-ENDIF
-!
-IF (I%CPHOTO/='NON') THEN
- PKI%NSIZE_SIMPLE=PKI%NSIZE_SIMPLE+22
- PKI%NSIZE_BIOMASS=PKI%NSIZE_BIOMASS+2
-ELSE
- PKI%NSIZE_0=PKI%NSIZE_0+22
- PKI%NSIZE_00=PKI%NSIZE_00+2
-ENDIF
-!
-IF (I%CPHOTO=='AST' .OR. I%CPHOTO=='LST' .OR. I%CPHOTO=='NIT' .OR. I%CPHOTO=='NCB') THEN
- PKI%NSIZE_LSIMPLE=PKI%NSIZE_LSIMPLE+1
- PKI%NSIZE_SIMPLE=PKI%NSIZE_SIMPLE+4
-ELSE
- PKI%NSIZE_L0=PKI%NSIZE_L0+1
- PKI%NSIZE_0=PKI%NSIZE_0+4
-ENDIF
-!
-IF (I%CPHOTO=='LAI' .OR. I%CPHOTO=='LST' .OR. I%CPHOTO=='NIT' .OR. I%CPHOTO=='NCB') THEN
- PKI%NSIZE_SIMPLE=PKI%NSIZE_SIMPLE+2
- PKI%NSIZE_TSIMPLE=PKI%NSIZE_TSIMPLE+2
- IF (LAGRIP) THEN
- PKI%NSIZE_LSIMPLE=PKI%NSIZE_LSIMPLE+2
- PKI%NSIZE_SIMPLE=PKI%NSIZE_SIMPLE+1
- ELSE
- PKI%NSIZE_L0=PKI%NSIZE_L0+2
- PKI%NSIZE_0=PKI%NSIZE_0+1
- ENDIF
-ELSE
- PKI%NSIZE_L0=PKI%NSIZE_L0+2
- PKI%NSIZE_0=PKI%NSIZE_0+3
- PKI%NSIZE_T0=PKI%NSIZE_T0+2
-ENDIF
-!
-IF(I%CPHOTO=='NIT' .OR. I%CPHOTO=='NCB') THEN
- PKI%NSIZE_SIMPLE=PKI%NSIZE_SIMPLE+4
-ELSE
- PKI%NSIZE_0=PKI%NSIZE_0+4
-ENDIF
-!
-IF (I%CPHOTO=='NCB') THEN
- PKI%NSIZE_BIOMASS=PKI%NSIZE_BIOMASS+1
- PKI%NSIZE_SIMPLE=PKI%NSIZE_SIMPLE+1
-ELSE
- PKI%NSIZE_00=PKI%NSIZE_00+1
- PKI%NSIZE_0=PKI%NSIZE_0+1
-ENDIF
-!
-IF (I%CRESPSL=='CNT') THEN
- PKI%NSIZE_LITTER=PKI%NSIZE_LITTER+1
- PKI%NSIZE_SOILCARB=PKI%NSIZE_SOILCARB+1
- PKI%NSIZE_LITTLEVS=PKI%NSIZE_LITTLEVS+1
- PKI%NSIZE_BIOMASS=PKI%NSIZE_BIOMASS+1
-ELSE
- PKI%NSIZE_000=PKI%NSIZE_000+1
- PKI%NSIZE_00=PKI%NSIZE_00+3
-ENDIF
-!
-IF (I%CRAIN=='SGH') THEN
- PKI%NSIZE_SIMPLE=PKI%NSIZE_SIMPLE+1
-ELSE
- PKI%NSIZE_0=PKI%NSIZE_0+1
-ENDIF
-! MEB STUFF START
-IF (I%LMEB_PATCH(KPATCH))THEN
- PKI%NSIZE_SIMPLE=PKI%NSIZE_SIMPLE+12
-! NSIZE_GROUND=NSIZE_GROUND+1
-ELSE
- PKI%NSIZE_0=PKI%NSIZE_0+12
-! NSIZE_01=NSIZE_01+1
-ENDIF
-! Old MEB varibales now eliminated
-PKI%NSIZE_0=PKI%NSIZE_0+7
-PKI%NSIZE_01=PKI%NSIZE_01+1
-! MEB STUFF END
-!
-IF (LHOOK) CALL DR_HOOK('PACK_ISBA_PATCH_GET_SIZE_N',1,ZHOOK_HANDLE)
-!------------------------------------------------------------------------
-END SUBROUTINE PACK_ISBA_PATCH_GET_SIZE_n
diff --git a/src/SURFEX/pack_isba_patchn.F90 b/src/SURFEX/pack_isba_patchn.F90
deleted file mode 100644
index 7de6c709a4e83e3afb649961627a904d8f363975..0000000000000000000000000000000000000000
--- a/src/SURFEX/pack_isba_patchn.F90
+++ /dev/null
@@ -1,1633 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE PACK_ISBA_PATCH_n (AG, IG, I, PKI, &
- KMASK,KSIZE,KPATCH)
-!##############################################
-!
-!
-!!**** *PACK_ISBA_PATCH_n * - packs ISBA variables
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson and A. boone
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! B. Decharme 2008 floodplains
-!! B. Decharme 01/2009 Good dim for XP_TG
-!! A.L. Gibelin 04/2009 : BIOMASS and RESP_BIOMASS arrays
-!! A.L. Gibelin 04/2009 : TAU_WOOD for NCB option
-!! A.L. Gibelin 05/2009 : Add carbon spinup
-!! A.L. Gibelin 06/2009 : Soil carbon variables for CNT option
-!! A.L. Gibelin 07/2009 : Suppress RDK and transform GPP as a diagnostic
-!! A.L. Gibelin 07/2009 : Suppress PPST and PPSTF as outputs
-!! B. Decharme 04/2013 : DIF lateral subsurface drainage
-!! water table / surface coupling
-!! P Samuelsson 10/2014 : MEB
-!! P Samuelsson 10/2014 : Additional snow albedos
-!!
-!!------------------------------------------------------------------
-!
-!
-USE MODD_AGRI_n, ONLY : AGRI_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_PACK_ISBA, ONLY : PACK_ISBA_t
-!
-USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
-!
-USE MODD_TREEDRAG, ONLY : LTREEDRAG
-USE MODD_AGRI, ONLY : LAGRIP
-
-
-!
-USE MODD_CSTS, ONLY : XLVTT, XLSTT, XCPD
-!
-USE MODI_ABOR1_SFX
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!
-TYPE(AGRI_t), INTENT(INOUT) :: AG
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(PACK_ISBA_t), INTENT(INOUT) :: PKI
-!
-INTEGER, INTENT(IN) :: KSIZE, KPATCH
-INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
-!
-INTEGER :: ISIZE_LSIMPLE, ISIZE_L0, ISIZE_TSIMPLE, ISIZE_T0, ISIZE_SIMPLE, &
- ISIZE_GROUND, ISIZE_VEGTYPE, ISIZE_TG, ISIZE_SNOW, ISIZE_ALB, &
- ISIZE_2, ISIZE_BIOMASS, ISIZE_SOILCARB, ISIZE_LITTLEVS, &
- ISIZE_LITTER, ISIZE_0, ISIZE_00,ISIZE_000, ISIZE_01, &
- ISIZE_NSIMPLE, ISIZE_N0
-!
-INTEGER :: JJ, JI, JK, JL
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('PACK_ISBA_PATCH_N',0,ZHOOK_HANDLE)
-!
-ALLOCATE(PKI%LBLOCK_SIMPLE(KSIZE,PKI%NSIZE_LSIMPLE))
-ALLOCATE(PKI%LBLOCK_0(0,PKI%NSIZE_L0))
-ALLOCATE(PKI%NBLOCK_SIMPLE(KSIZE,PKI%NSIZE_NSIMPLE))
-ALLOCATE(PKI%NBLOCK_0(0,PKI%NSIZE_N0))
-ALLOCATE(PKI%TBLOCK_SIMPLE(KSIZE,PKI%NSIZE_TSIMPLE))
-ALLOCATE(PKI%TBLOCK_0(0,PKI%NSIZE_T0))
-ALLOCATE(PKI%XBLOCK_SIMPLE(KSIZE,PKI%NSIZE_SIMPLE))
-ALLOCATE(PKI%XBLOCK_GROUND(KSIZE,I%NGROUND_LAYER,PKI%NSIZE_GROUND))
-ALLOCATE(PKI%XBLOCK_VEGTYPE(KSIZE,NVEGTYPE,PKI%NSIZE_VEGTYPE))
-ALLOCATE(PKI%XBLOCK_TG(KSIZE,SIZE(I%XTG,2),PKI%NSIZE_TG))
-ALLOCATE(PKI%XBLOCK_SNOW(KSIZE,I%TSNOW%NLAYER,PKI%NSIZE_SNOW))
-ALLOCATE(PKI%XBLOCK_ALB(KSIZE,SIZE(I%XDIR_ALB_WITH_SNOW,2),PKI%NSIZE_ALB))
-ALLOCATE(PKI%XBLOCK_2(KSIZE,2,PKI%NSIZE_2))
-ALLOCATE(PKI%XBLOCK_BIOMASS(KSIZE,I%NNBIOMASS,PKI%NSIZE_BIOMASS))
-ALLOCATE(PKI%XBLOCK_SOILCARB(KSIZE,I%NNSOILCARB,PKI%NSIZE_SOILCARB))
-ALLOCATE(PKI%XBLOCK_LITTLEVS(KSIZE,I%NNLITTLEVS,PKI%NSIZE_LITTLEVS))
-ALLOCATE(PKI%XBLOCK_LITTER(KSIZE,I%NNLITTER,I%NNLITTLEVS,PKI%NSIZE_LITTER))
-ALLOCATE(PKI%XBLOCK_0(0,PKI%NSIZE_0))
-ALLOCATE(PKI%XBLOCK_00(0,0,PKI%NSIZE_00))
-ALLOCATE(PKI%XBLOCK_000(0,0,0,PKI%NSIZE_000))
-ALLOCATE(PKI%XBLOCK_01(0,1,PKI%NSIZE_01))
-!
-ISIZE_LSIMPLE=0
-ISIZE_L0=0
-ISIZE_NSIMPLE=0
-ISIZE_N0=0
-ISIZE_TSIMPLE=0
-ISIZE_T0=0
-ISIZE_SIMPLE=0
-ISIZE_GROUND=0
-ISIZE_VEGTYPE=0
-ISIZE_TG=0
-ISIZE_SNOW=0
-ISIZE_ALB=0
-ISIZE_2=0
-ISIZE_BIOMASS=0
-ISIZE_LITTER=0
-ISIZE_SOILCARB=0
-ISIZE_LITTLEVS=0
-ISIZE_0=0
-ISIZE_00=0
-ISIZE_000=0
-ISIZE_01=0
-!
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_Z0_O_Z0H => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_EMIS => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_ALBNIR => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_ALBVIS => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_ALBUV => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_ALBNIR_VEG => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_ALBVIS_VEG => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_ALBUV_VEG => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_ALBNIR_SOIL => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_ALBVIS_SOIL => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_ALBUV_SOIL => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_Z0 => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_WRMAX_CF => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_GAMMA => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_CV => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_RGL => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_RUNOFFD => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_Z0EFFIP => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_Z0EFFIM => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_Z0EFFJP => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_Z0EFFJM => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_WR => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_LAI => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_RESA => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_CPS => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_LVTT => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_LSTT => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_VEG => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_SNOWALB => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_LE => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_PSN => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_PSNG => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_PSNV => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_ALBNIR_DRY => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_ALBVIS_DRY => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_ALBUV_DRY => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_ALBNIR_WET => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_ALBVIS_WET => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_ALBUV_WET => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_RUNOFFB => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_WDRAIN => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_TAUICE => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_Z0REL => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_AOSIP => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_AOSIM => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_AOSJP => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_AOSJM => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_HO2IP => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_HO2IM => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_HO2JP => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_HO2JM => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_SSO_SLOPE => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_GAMMAT => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_TDEEP => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_LAT => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_LON => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-!
-ISIZE_GROUND = ISIZE_GROUND + 1
-PKI%XP_CLAY => PKI%XBLOCK_GROUND(:,:,ISIZE_GROUND)
-ISIZE_GROUND = ISIZE_GROUND + 1
-PKI%XP_SAND => PKI%XBLOCK_GROUND(:,:,ISIZE_GROUND)
-ISIZE_GROUND = ISIZE_GROUND + 1
-PKI%XP_WFC => PKI%XBLOCK_GROUND(:,:,ISIZE_GROUND)
-ISIZE_GROUND = ISIZE_GROUND + 1
-PKI%XP_WWILT => PKI%XBLOCK_GROUND(:,:,ISIZE_GROUND)
-ISIZE_GROUND = ISIZE_GROUND + 1
-PKI%XP_WSAT => PKI%XBLOCK_GROUND(:,:,ISIZE_GROUND)
-ISIZE_GROUND = ISIZE_GROUND + 1
-PKI%XP_CONDSAT => PKI%XBLOCK_GROUND(:,:,ISIZE_GROUND)
-ISIZE_GROUND = ISIZE_GROUND + 1
-PKI%XP_DG => PKI%XBLOCK_GROUND(:,:,ISIZE_GROUND)
-ISIZE_GROUND = ISIZE_GROUND + 1
-PKI%XP_WG => PKI%XBLOCK_GROUND(:,:,ISIZE_GROUND)
-ISIZE_GROUND = ISIZE_GROUND + 1
-PKI%XP_WGI => PKI%XBLOCK_GROUND(:,:,ISIZE_GROUND)
-!
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_KSAT_ICE => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_D_ICE => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-!
-ISIZE_VEGTYPE = ISIZE_VEGTYPE + 1
-PKI%XP_VEGTYPE_PATCH => PKI%XBLOCK_VEGTYPE(:,:,ISIZE_VEGTYPE)
-!
-ISIZE_TG = ISIZE_TG + 1
-PKI%XP_TG => PKI%XBLOCK_TG(:,:,ISIZE_TG)
-!
-ISIZE_SNOW = ISIZE_SNOW + 1
-PKI%XP_SNOWSWE => PKI%XBLOCK_SNOW(:,:,ISIZE_SNOW)
-ISIZE_SNOW = ISIZE_SNOW + 1
-PKI%XP_SNOWRHO => PKI%XBLOCK_SNOW(:,:,ISIZE_SNOW)
-!
-ISIZE_ALB = ISIZE_ALB + 1
-PKI%XP_DIR_ALB_WITH_SNOW=> PKI%XBLOCK_ALB(:,:,ISIZE_ALB)
-ISIZE_ALB = ISIZE_ALB + 1
-PKI%XP_SCA_ALB_WITH_SNOW=> PKI%XBLOCK_ALB(:,:,ISIZE_ALB)
-!
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_FFLOOD => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_PIFLOOD => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_FF => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_FFG => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_FFV => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_FFROZEN => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_ALBF => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_EMISF => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-PKI%XP_FSAT => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-!
-IF(I%TSNOW%SCHEME=='EBA') THEN
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_PSNV_A => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ELSE
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_PSNV_A => PKI%XBLOCK_0(:,ISIZE_0)
-ENDIF
-!
-IF (I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO') THEN
- ISIZE_SNOW = ISIZE_SNOW + 1
- PKI%XP_SNOWHEAT => PKI%XBLOCK_SNOW(:,:,ISIZE_SNOW)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_SNOWEMIS => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SNOW = ISIZE_SNOW + 1
- PKI%XP_SNOWAGE => PKI%XBLOCK_SNOW(:,:,ISIZE_SNOW)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_SNOWALBVIS => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_SNOWALBNIR => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_SNOWALBFIR => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ELSE
- ISIZE_00 = ISIZE_00 + 1
- PKI%XP_SNOWHEAT => PKI%XBLOCK_00(:,:,ISIZE_00)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_SNOWEMIS => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_00 = ISIZE_00 + 1
- PKI%XP_SNOWAGE => PKI%XBLOCK_00(:,:,ISIZE_00)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_SNOWALBVIS => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_SNOWALBNIR => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_SNOWALBFIR => PKI%XBLOCK_0(:,ISIZE_0)
-END IF
-!
-IF(I%TSNOW%SCHEME=='CRO') THEN
- ISIZE_SNOW = ISIZE_SNOW + 1
- PKI%XP_SNOWGRAN1 => PKI%XBLOCK_SNOW(:,:,ISIZE_SNOW)
- ISIZE_SNOW = ISIZE_SNOW + 1
- PKI%XP_SNOWGRAN2 => PKI%XBLOCK_SNOW(:,:,ISIZE_SNOW)
- ISIZE_SNOW = ISIZE_SNOW + 1
- PKI%XP_SNOWHIST => PKI%XBLOCK_SNOW(:,:,ISIZE_SNOW)
-ELSE
- ISIZE_00 = ISIZE_00 + 1
- PKI%XP_SNOWGRAN1 => PKI%XBLOCK_00(:,:,ISIZE_00)
- ISIZE_00 = ISIZE_00 + 1
- PKI%XP_SNOWGRAN2 => PKI%XBLOCK_00(:,:,ISIZE_00)
- ISIZE_00 = ISIZE_00 + 1
- PKI%XP_SNOWHIST => PKI%XBLOCK_00(:,:,ISIZE_00)
-END IF
-!
-IF(I%LGLACIER)THEN
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_ICE_STO=> PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ELSE
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_ICE_STO=> PKI%XBLOCK_0(:,ISIZE_0)
-ENDIF
-!
-IF (I%CSCOND=='PL98'.OR.I%CISBA=='DIF') THEN
- ISIZE_GROUND = ISIZE_GROUND + 1
- PKI%XP_HCAPSOIL => PKI%XBLOCK_GROUND(:,:,ISIZE_GROUND)
- ISIZE_GROUND = ISIZE_GROUND + 1
- PKI%XP_CONDDRY => PKI%XBLOCK_GROUND(:,:,ISIZE_GROUND)
- ISIZE_GROUND = ISIZE_GROUND + 1
- PKI%XP_CONDSLD => PKI%XBLOCK_GROUND(:,:,ISIZE_GROUND)
-ELSE
- ISIZE_01 = ISIZE_01 + 1
- PKI%XP_HCAPSOIL => PKI%XBLOCK_01(:,:,ISIZE_01)
- ISIZE_01 = ISIZE_01 + 1
- PKI%XP_CONDDRY => PKI%XBLOCK_01(:,:,ISIZE_01)
- ISIZE_01 = ISIZE_01 + 1
- PKI%XP_CONDSLD => PKI%XBLOCK_01(:,:,ISIZE_01)
-END IF
-!
-IF (I%CISBA=='2-L' .OR. I%CISBA=='3-L') THEN
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_C4B => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_ACOEF => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_PCOEF => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_CGSAT => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_C1SAT => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_C2REF => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_C4REF => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_2 = ISIZE_2 + 1
- PKI%XP_C3 => PKI%XBLOCK_2(:,:,ISIZE_2)
-ELSE
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_C4B => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_ACOEF => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_PCOEF => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_CGSAT => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_C1SAT => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_C2REF => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_C4REF => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_00 = ISIZE_00 + 1
- PKI%XP_C3 => PKI%XBLOCK_00(:,:,ISIZE_00)
-END IF
-!
-ISIZE_GROUND = ISIZE_GROUND + 1
-PKI%XP_MPOTSAT => PKI%XBLOCK_GROUND(:,:,ISIZE_GROUND)
-ISIZE_GROUND = ISIZE_GROUND + 1
-PKI%XP_BCOEF => PKI%XBLOCK_GROUND(:,:,ISIZE_GROUND)
-!
-IF (I%CISBA=='DIF') THEN
-!
- ISIZE_GROUND = ISIZE_GROUND + 1
- PKI%XP_ROOTFRAC => PKI%XBLOCK_GROUND(:,:,ISIZE_GROUND)
- ISIZE_GROUND = ISIZE_GROUND + 1
- PKI%XP_DZG => PKI%XBLOCK_GROUND(:,:,ISIZE_GROUND)
- ISIZE_GROUND = ISIZE_GROUND + 1
- PKI%XP_DZDIF => PKI%XBLOCK_GROUND(:,:,ISIZE_GROUND)
- ISIZE_GROUND = ISIZE_GROUND + 1
- PKI%XP_SOILWGHT => PKI%XBLOCK_GROUND(:,:,ISIZE_GROUND)
-!
- ISIZE_NSIMPLE = ISIZE_NSIMPLE + 1
- PKI%NK_WG_LAYER => PKI%NBLOCK_SIMPLE(:,ISIZE_NSIMPLE)
-!
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_FWTD=> PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_WTD=> PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-!
-ELSE
-!
- ISIZE_01 = ISIZE_01 + 1
- PKI%XP_ROOTFRAC => PKI%XBLOCK_01(:,:,ISIZE_01)
- ISIZE_01 = ISIZE_01 + 1
- PKI%XP_DZG => PKI%XBLOCK_01(:,:,ISIZE_01)
- ISIZE_01 = ISIZE_01 + 1
- PKI%XP_DZDIF => PKI%XBLOCK_01(:,:,ISIZE_01)
- ISIZE_01 = ISIZE_01 + 1
- PKI%XP_SOILWGHT => PKI%XBLOCK_01(:,:,ISIZE_01)
-!
- ISIZE_N0 = ISIZE_N0 + 1
- PKI%NK_WG_LAYER => PKI%NBLOCK_0(:,ISIZE_N0)
-!
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_FWTD=> PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_WTD=> PKI%XBLOCK_0(:,ISIZE_0)
-!
-END IF
-!
-IF (I%CISBA=='DIF'.AND.I%CRUNOFF=='SGH') THEN
-!
- ISIZE_GROUND = ISIZE_GROUND + 1
- PKI%XP_TOPQS => PKI%XBLOCK_GROUND(:,:,ISIZE_GROUND)
-!
-ELSE
-!
- ISIZE_01 = ISIZE_01 + 1
- PKI%XP_TOPQS => PKI%XBLOCK_01(:,:,ISIZE_01)
-!
-END IF
-!
-IF (I%LTR_ML) THEN
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_FAPARC => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_FAPIRC => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_LAI_EFFC => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_MUS => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ELSE
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_FAPARC => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_FAPIRC => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_LAI_EFFC => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_MUS => PKI%XBLOCK_0(:,ISIZE_0)
-ENDIF
-!
-IF (I%CPHOTO=='NON') THEN
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_RSMIN => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ELSE
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_RSMIN => PKI%XBLOCK_0(:,ISIZE_0)
-END IF
-!
-IF (I%CPHOTO/='NON' .OR. I%LMEB_PATCH(KPATCH)) THEN
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_BSLAI => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ELSE
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_BSLAI => PKI%XBLOCK_0(:,ISIZE_0)
-ENDIF
-!
-IF (I%CPHOTO/='NON'.OR.LTREEDRAG) THEN
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_H_TREE => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ELSE
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_H_TREE => PKI%XBLOCK_0(:,ISIZE_0)
-ENDIF
-!
-IF (I%CPHOTO/='NON') THEN
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_LAIMIN => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_SEFOLD => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_ANF => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_ANMAX => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_FZERO => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_EPSO => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_GAMM => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_QDGAMM => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_GMES => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_RE25 => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_QDGMES => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_T1GMES => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_T2GMES => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_AMAX => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_QDAMAX => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_T1AMAX => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_T2AMAX => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_AN => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_ANDAY => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_ANFM => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_GC => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_BIOMASS = ISIZE_BIOMASS + 1
- PKI%XP_BIOMASS => PKI%XBLOCK_BIOMASS(:,:,ISIZE_BIOMASS)
- ISIZE_BIOMASS = ISIZE_BIOMASS + 1
- PKI%XP_RESP_BIOMASS => PKI%XBLOCK_BIOMASS(:,:,ISIZE_BIOMASS)
-ELSE
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_LAIMIN => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_SEFOLD => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_ANF => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_ANMAX => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_FZERO => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_EPSO => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_GAMM => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_QDGAMM => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_GMES => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_RE25 => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_QDGMES => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_T1GMES => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_T2GMES => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_AMAX => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_QDAMAX => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_T1AMAX => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_T2AMAX => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_AN => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_ANDAY => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_ANFM => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_GC => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_00 = ISIZE_00 + 1
- PKI%XP_BIOMASS => PKI%XBLOCK_00(:,:,ISIZE_00)
- ISIZE_00 = ISIZE_00 + 1
- PKI%XP_RESP_BIOMASS => PKI%XBLOCK_00(:,:,ISIZE_00)
-END IF
-!
-IF (I%CPHOTO=='AST' .OR. I%CPHOTO=='LST' .OR. I%CPHOTO=='NIT' .OR. I%CPHOTO=='NCB') THEN
- ISIZE_LSIMPLE = ISIZE_LSIMPLE + 1
- PKI%LP_STRESS => PKI%LBLOCK_SIMPLE(:,ISIZE_LSIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_F2I => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_AH => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_BH => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_DMAX => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ELSE
- ISIZE_L0 = ISIZE_L0 + 1
- PKI%LP_STRESS => PKI%LBLOCK_0(:,ISIZE_L0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_F2I => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_AH => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_BH => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_DMAX => PKI%XBLOCK_0(:,ISIZE_0)
-END IF
-!
-IF (I%CPHOTO=='LAI' .OR. I%CPHOTO=='LST' .OR. I%CPHOTO=='NIT' .OR. I%CPHOTO=='NCB') THEN
- ISIZE_TSIMPLE = ISIZE_TSIMPLE + 1
- PKI%TP_SEED => PKI%TBLOCK_SIMPLE(:,ISIZE_TSIMPLE)
- ISIZE_TSIMPLE = ISIZE_TSIMPLE + 1
- PKI%TP_REAP => PKI%TBLOCK_SIMPLE(:,ISIZE_TSIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_IRRIG => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_WATSUP => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- IF (LAGRIP) THEN
- ISIZE_LSIMPLE = ISIZE_LSIMPLE + 1
- PKI%XP_LIRRIDAY => PKI%LBLOCK_SIMPLE(:,ISIZE_LSIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_THRESHOLD => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_LSIMPLE = ISIZE_LSIMPLE + 1
- PKI%XP_LIRRIGATE => PKI%LBLOCK_SIMPLE(:,ISIZE_LSIMPLE)
- ELSE
- ISIZE_L0 = ISIZE_L0 + 1
- PKI%XP_LIRRIDAY => PKI%LBLOCK_0(:,ISIZE_L0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_THRESHOLD => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_L0 = ISIZE_L0 + 1
- PKI%XP_LIRRIGATE => PKI%LBLOCK_0(:,ISIZE_L0)
- ENDIF
-ELSE
- ISIZE_T0 = ISIZE_T0 + 1
- PKI%TP_SEED => PKI%TBLOCK_0(:,ISIZE_T0)
- ISIZE_T0 = ISIZE_T0 + 1
- PKI%TP_REAP => PKI%TBLOCK_0(:,ISIZE_T0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_IRRIG => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_WATSUP => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_L0 = ISIZE_L0 + 1
- PKI%XP_LIRRIDAY => PKI%LBLOCK_0(:,ISIZE_L0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_THRESHOLD => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_L0 = ISIZE_L0 + 1
- PKI%XP_LIRRIGATE => PKI%LBLOCK_0(:,ISIZE_L0)
-ENDIF
-!
-IF(I%CPHOTO=='NIT' .OR. I%CPHOTO=='NCB') THEN
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_CE_NITRO => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_CF_NITRO => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_CNA_NITRO => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_BSLAI_NITRO => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ELSE
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_CE_NITRO => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_CF_NITRO => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_CNA_NITRO => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_BSLAI_NITRO => PKI%XBLOCK_0(:,ISIZE_0)
-END IF
-!
-IF (I%CPHOTO=='NCB') THEN
- ISIZE_BIOMASS = ISIZE_BIOMASS + 1
- PKI%XP_INCREASE => PKI%XBLOCK_BIOMASS(:,:,ISIZE_BIOMASS)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_TAU_WOOD => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ELSE
- ISIZE_00 = ISIZE_00 + 1
- PKI%XP_INCREASE => PKI%XBLOCK_00(:,:,ISIZE_00)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_TAU_WOOD => PKI%XBLOCK_0(:,ISIZE_0)
-ENDIF
-!
-IF (I%CRESPSL=='CNT') THEN
- ISIZE_LITTER = ISIZE_LITTER + 1
- PKI%XP_LITTER => PKI%XBLOCK_LITTER(:,:,:,ISIZE_LITTER)
- ISIZE_SOILCARB = ISIZE_SOILCARB + 1
- PKI%XP_SOILCARB => PKI%XBLOCK_SOILCARB(:,:,ISIZE_SOILCARB)
- ISIZE_LITTLEVS = ISIZE_LITTLEVS + 1
- PKI%XP_LIGNIN_STRUC => PKI%XBLOCK_LITTLEVS(:,:,ISIZE_LITTLEVS)
- ISIZE_BIOMASS = ISIZE_BIOMASS + 1
- PKI%XP_TURNOVER => PKI%XBLOCK_BIOMASS(:,:,ISIZE_BIOMASS)
-ELSE
- ISIZE_000 = ISIZE_000 + 1
- PKI%XP_LITTER => PKI%XBLOCK_000(:,:,:,ISIZE_000)
- ISIZE_00 = ISIZE_00 + 1
- PKI%XP_SOILCARB => PKI%XBLOCK_00(:,:,ISIZE_00)
- ISIZE_00 = ISIZE_00 + 1
- PKI%XP_LIGNIN_STRUC => PKI%XBLOCK_00(:,:,ISIZE_00)
- ISIZE_00 = ISIZE_00 + 1
- PKI%XP_TURNOVER => PKI%XBLOCK_00(:,:,ISIZE_00)
-END IF
-!
-IF (I%CRAIN=='SGH')THEN
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_MUF=> PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-ELSE
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_MUF=> PKI%XBLOCK_0(:,ISIZE_0)
-ENDIF
-!
-! MEB STUFF START
-!
-! Note that here the understory ground vegetation (GV) that was part of the original
-! MEB development has been eliminated. The reason is to avoid a composite
-! of vegetation and soil. Thus, most varibales with old extension V
-! (representing canopy vegetation) are now unassociated. Instead, the classical ISBA
-! variables (e.g. RGL, GAMMA, ...) will represent a composite vegetation in the
-! MEB case. We still keep the GV-variables in the system for future needs.
-! Code is commented with "nogv" in appropriate places.
-!
-IF (I%LMEB_PATCH(KPATCH))THEN
-!
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_WRL => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_WRLI => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_WRVN => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_TV => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_TL => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_TC => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_QC => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-!nogv ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-!nogv XP_RSMINV => XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_H_VEG => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-!nogv ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-!nogv XP_RGLV => XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-!nogv ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-!nogv XP_GAMMAV => XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-!nogv ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-!nogv XP_WRMAX_CFV => XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-!nogv ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-!nogv XP_LAIV => XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-!nogv ISIZE_SIMPLE = ISIZE_SIMPLE + 1
-!nogv XP_Z0V => XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_GNDLITTER => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
- ISIZE_SIMPLE = ISIZE_SIMPLE + 1
- PKI%XP_Z0LITTER => PKI%XBLOCK_SIMPLE(:,ISIZE_SIMPLE)
-!
-!nogv ISIZE_GROUND = ISIZE_GROUND + 1
-!nogv XP_ROOTFRACV => XBLOCK_GROUND(:,:,ISIZE_GROUND)
-ELSE
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_WRL => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_WRLI => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_WRVN => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_TV => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_TL => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_TC => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_QC => PKI%XBLOCK_0(:,ISIZE_0)
-!nogv ISIZE_0 = ISIZE_0 + 1
-!nogv XP_RSMINV => XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_H_VEG => PKI%XBLOCK_0(:,ISIZE_0)
-!nogv ISIZE_0 = ISIZE_0 + 1
-!nogv XP_RGLV => XBLOCK_0(:,ISIZE_0)
-!nogv ISIZE_0 = ISIZE_0 + 1
-!nogv XP_GAMMAV => XBLOCK_0(:,ISIZE_0)
-!nogv ISIZE_0 = ISIZE_0 + 1
-!nogv XP_WRMAX_CFV => XBLOCK_0(:,ISIZE_0)
-!nogv ISIZE_0 = ISIZE_0 + 1
-!nogv XP_LAIV => XBLOCK_0(:,ISIZE_0)
-!nogv ISIZE_0 = ISIZE_0 + 1
-!nogv XP_Z0V => XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_GNDLITTER => PKI%XBLOCK_0(:,ISIZE_0)
- ISIZE_0 = ISIZE_0 + 1
- PKI%XP_Z0LITTER => PKI%XBLOCK_0(:,ISIZE_0)
-!
-!nogv ISIZE_01 = ISIZE_01 + 1
-!nogv XP_ROOTFRACV => XBLOCK_01(:,:,ISIZE_01)
-ENDIF
-ISIZE_0 = ISIZE_0 + 1
-PKI%XP_RSMINV => PKI%XBLOCK_0(:,ISIZE_0)
-ISIZE_0 = ISIZE_0 + 1
-PKI%XP_RGLV => PKI%XBLOCK_0(:,ISIZE_0)
-ISIZE_0 = ISIZE_0 + 1
-PKI%XP_GAMMAV => PKI%XBLOCK_0(:,ISIZE_0)
-ISIZE_0 = ISIZE_0 + 1
-PKI%XP_WRMAX_CFV => PKI%XBLOCK_0(:,ISIZE_0)
-ISIZE_0 = ISIZE_0 + 1
-PKI%XP_LAIV => PKI%XBLOCK_0(:,ISIZE_0)
-ISIZE_0 = ISIZE_0 + 1
-PKI%XP_Z0V => PKI%XBLOCK_0(:,ISIZE_0)
-ISIZE_01 = ISIZE_01 + 1
-PKI%XP_ROOTFRACV => PKI%XBLOCK_01(:,:,ISIZE_01)
-! MEB STUFF END
-!
-!
-IF (ISIZE_SIMPLE.GT.PKI%NSIZE_SIMPLE) &
- CALL ABOR1_SFX("PACK_ISBA_PATCH_n: PROBLEM DEFINING SIZE_SIMPLE / NUMBER OF FIELDS")
-IF (ISIZE_GROUND.GT.PKI%NSIZE_GROUND) &
- CALL ABOR1_SFX("PACK_ISBA_PATCH_n: PROBLEM DEFINING SIZE_GROUND / NUMBER OF FIELDS")
-IF (ISIZE_VEGTYPE.GT.PKI%NSIZE_VEGTYPE) &
- CALL ABOR1_SFX("PACK_ISBA_PATCH_n: PROBLEM DEFINING SIZE_VEGTYPE / NUMBER OF FIELDS")
-IF (ISIZE_TG.GT.PKI%NSIZE_TG) &
- CALL ABOR1_SFX("PACK_ISBA_PATCH_n: PROBLEM DEFINING SIZE_TG / NUMBER OF FIELDS")
-IF (ISIZE_SNOW.GT.PKI%NSIZE_SNOW) &
- CALL ABOR1_SFX("PACK_ISBA_PATCH_n: PROBLEM DEFINING SIZE_SNOW / NUMBER OF FIELDS")
-IF (ISIZE_ALB.GT.PKI%NSIZE_ALB) &
- CALL ABOR1_SFX("PACK_ISBA_PATCH_n: PROBLEM DEFINING SIZE_ALB / NUMBER OF FIELDS")
-IF (ISIZE_0.GT.PKI%NSIZE_0) &
- CALL ABOR1_SFX("PACK_ISBA_PATCH_n: PROBLEM DEFINING SIZE_0 / NUMBER OF FIELDS")
-IF (ISIZE_00.GT.PKI%NSIZE_00) &
- CALL ABOR1_SFX("PACK_ISBA_PATCH_n: PROBLEM DEFINING SIZE_00 / NUMBER OF FIELDS")
-IF (ISIZE_01.GT.PKI%NSIZE_01) &
- CALL ABOR1_SFX("PACK_ISBA_PATCH_n: PROBLEM DEFINING SIZE_01 / NUMBER OF FIELDS")
-IF (ISIZE_2.GT.PKI%NSIZE_2) &
- CALL ABOR1_SFX("PACK_ISBA_PATCH_n: PROBLEM DEFINING SIZE_2 / NUMBER OF FIELDS")
-IF (ISIZE_BIOMASS.GT.PKI%NSIZE_BIOMASS) &
- CALL ABOR1_SFX("PACK_ISBA_PATCH_n: PROBLEM DEFINING SIZE_BIOMASS / NUMBER OF FIELDS")
-IF (ISIZE_LITTER.GT.PKI%NSIZE_LITTER) &
- CALL ABOR1_SFX("PACK_ISBA_PATCH_n: PROBLEM DEFINING SIZE_LITTER / NUMBER OF FIELDS")
-IF (ISIZE_SOILCARB.GT.PKI%NSIZE_SOILCARB) &
- CALL ABOR1_SFX("PACK_ISBA_PATCH_n: PROBLEM DEFINING SIZE_SOILCARB / NUMBER OF FIELDS")
-IF (ISIZE_LITTLEVS.GT.PKI%NSIZE_LITTLEVS) &
- CALL ABOR1_SFX("PACK_ISBA_PATCH_n: PROBLEM DEFINING SIZE_LITTLEVS / NUMBER OF FIELDS")
-IF (ISIZE_000.GT.PKI%NSIZE_000) &
- CALL ABOR1_SFX("PACK_ISBA_PATCH_n: PROBLEM DEFINING SIZE_000 / NUMBER OF FIELDS")
-IF (ISIZE_TSIMPLE.GT.PKI%NSIZE_TSIMPLE) &
- CALL ABOR1_SFX("PACK_ISBA_PATCH_n: PROBLEM DEFINING SIZE_TSIMPLE / NUMBER OF FIELDS")
-IF (ISIZE_T0.GT.PKI%NSIZE_T0) &
- CALL ABOR1_SFX("PACK_ISBA_PATCH_n: PROBLEM DEFINING SIZE_T0 / NUMBER OF FIELDS")
-IF (ISIZE_LSIMPLE.GT.PKI%NSIZE_LSIMPLE) &
- CALL ABOR1_SFX("PACK_ISBA_PATCH_n: PROBLEM DEFINING SIZE_LSIMPLE / NUMBER OF FIELDS")
-IF (ISIZE_L0.GT.PKI%NSIZE_L0) &
- CALL ABOR1_SFX("PACK_ISBA_PATCH_n: PROBLEM DEFINING SIZE_L0 / NUMBER OF FIELDS")
-IF (ISIZE_N0.GT.PKI%NSIZE_N0) &
- CALL ABOR1_SFX("PACK_ISBA_PATCH_n: PROBLEM DEFINING SIZE_N0 / NUMBER OF FIELDS")
-!
-!------------------------------------------------------------------------
-!
-IF (I%NPATCH==1) THEN
- !
- PKI%XP_Z0_O_Z0H (:) = I%XZ0_O_Z0H (:, 1)
- PKI%XP_EMIS (:) = I%XEMIS (:, 1)
- PKI%XP_ALBNIR (:) = I%XALBNIR (:, 1)
- PKI%XP_ALBVIS (:) = I%XALBVIS (:, 1)
- PKI%XP_ALBUV (:) = I%XALBUV (:, 1)
- PKI%XP_ALBNIR_VEG (:) = I%XALBNIR_VEG (:, 1)
- PKI%XP_ALBVIS_VEG (:) = I%XALBVIS_VEG (:, 1)
- PKI%XP_ALBUV_VEG (:) = I%XALBUV_VEG (:, 1)
- PKI%XP_ALBNIR_SOIL (:) = I%XALBNIR_SOIL (:, 1)
- PKI%XP_ALBVIS_SOIL (:) = I%XALBVIS_SOIL (:, 1)
- PKI%XP_ALBUV_SOIL (:) = I%XALBUV_SOIL (:, 1)
- PKI%XP_Z0 (:) = I%XZ0 (:, 1)
- PKI%XP_WRMAX_CF (:) = I%XWRMAX_CF (:, 1)
- PKI%XP_GAMMA (:) = I%XGAMMA (:, 1)
- PKI%XP_CV (:) = I%XCV (:, 1)
- PKI%XP_RGL (:) = I%XRGL (:, 1)
- PKI%XP_RUNOFFD (:) = I%XRUNOFFD (:, 1)
- PKI%XP_Z0EFFIP (:) = I%XZ0EFFIP (:, 1)
- PKI%XP_Z0EFFIM (:) = I%XZ0EFFIM (:, 1)
- PKI%XP_Z0EFFJP (:) = I%XZ0EFFJP (:, 1)
- PKI%XP_Z0EFFJM (:) = I%XZ0EFFJM (:, 1)
- PKI%XP_WR (:) = I%XWR (:, 1)
- PKI%XP_LAI (:) = I%XLAI (:, 1)
- PKI%XP_RESA (:) = I%XRESA (:, 1)
- PKI%XP_CPS (:) = I%XPCPS (:, 1)
- PKI%XP_LVTT (:) = I%XPLVTT (:, 1)
- PKI%XP_LSTT (:) = I%XPLSTT (:, 1)
- PKI%XP_VEG (:) = I%XVEG (:, 1)
- PKI%XP_SNOWALB (:) = I%TSNOW%ALB (:, 1)
- PKI%XP_LE (:) = I%XLE (:, 1)
- PKI%XP_PSN (:) = I%XPSN (:, 1)
- PKI%XP_PSNG (:) = I%XPSNG (:, 1)
- PKI%XP_PSNV (:) = I%XPSNV (:, 1)
- PKI%XP_ALBNIR_DRY (:) = I%XALBNIR_DRY (:)
- PKI%XP_ALBVIS_DRY (:) = I%XALBVIS_DRY (:)
- PKI%XP_ALBUV_DRY (:) = I%XALBUV_DRY (:)
- PKI%XP_ALBNIR_WET (:) = I%XALBNIR_WET (:)
- PKI%XP_ALBVIS_WET (:) = I%XALBVIS_WET (:)
- PKI%XP_ALBUV_WET (:) = I%XALBUV_WET (:)
- PKI%XP_RUNOFFB (:) = I%XRUNOFFB (:)
- PKI%XP_WDRAIN (:) = I%XWDRAIN (:)
- PKI%XP_TAUICE (:) = I%XTAUICE (:)
- PKI%XP_Z0REL (:) = I%XZ0REL (:)
- PKI%XP_AOSIP (:) = I%XAOSIP (:)
- PKI%XP_AOSIM (:) = I%XAOSIM (:)
- PKI%XP_AOSJP (:) = I%XAOSJP (:)
- PKI%XP_AOSJM (:) = I%XAOSJM (:)
- PKI%XP_HO2IP (:) = I%XHO2IP (:)
- PKI%XP_HO2IM (:) = I%XHO2IM (:)
- PKI%XP_HO2JP (:) = I%XHO2JP (:)
- PKI%XP_HO2JM (:) = I%XHO2JM (:)
- PKI%XP_SSO_SLOPE (:) = I%XSSO_SLOPE (:)
- PKI%XP_GAMMAT (:) = I%XGAMMAT (:)
- PKI%XP_TDEEP (:) = I%XTDEEP (:)
- PKI%XP_LAT (:) = IG%XLAT (:)
- PKI%XP_LON (:) = IG%XLON (:)
- !
- PKI%XP_CLAY (:,:) = I%XCLAY (:, :)
- PKI%XP_SAND (:,:) = I%XSAND (:, :)
- PKI%XP_WFC (:, :) = I%XWFC (:, :)
- PKI%XP_WWILT (:, :) = I%XWWILT (:, :)
- PKI%XP_WSAT (:, :) = I%XWSAT (:, :)
- PKI%XP_CONDSAT (:, :) = I%XCONDSAT (:, :, 1)
- PKI%XP_DG (:, :) = I%XDG (:, :, 1)
- PKI%XP_WG (:, :) = I%XWG (:, :, 1)
- PKI%XP_WGI (:, :) = I%XWGI (:, :, 1)
- PKI%XP_MPOTSAT (:, :) = I%XMPOTSAT (:, :)
- PKI%XP_BCOEF (:, :) = I%XBCOEF (:, :)
- !
- PKI%XP_KSAT_ICE (:) = I%XKSAT_ICE (:, 1)
- PKI%XP_D_ICE (:) = I%XD_ICE (:, 1)
- !
- PKI%XP_VEGTYPE_PATCH(:, :) = I%XVEGTYPE_PATCH(:, :, 1)
- !
- PKI%XP_TG (:, :) = I%XTG (:, :, 1)
- !
- PKI%XP_SNOWSWE (:, :) = I%TSNOW%WSNOW (:, :, 1)
- PKI%XP_SNOWRHO (:, :) = I%TSNOW%RHO (:, :, 1)
- !
- PKI%XP_DIR_ALB_WITH_SNOW (:,:)= I%XDIR_ALB_WITH_SNOW(:, :, 1)
- PKI%XP_SCA_ALB_WITH_SNOW (:,:)= I%XSCA_ALB_WITH_SNOW(:, :, 1)
- !
- PKI%XP_FSAT(:)=I%XFSAT(:)
- !
- IF(I%LFLOOD)THEN
- PKI%XP_FFLOOD (:)=I%XFFLOOD (:)
- PKI%XP_PIFLOOD (:)=I%XPIFLOOD (:)
- PKI%XP_FF (:)=I%XFF (:, 1)
- PKI%XP_FFG (:)=I%XFFG (:, 1)
- PKI%XP_FFV (:)=I%XFFV (:, 1)
- PKI%XP_FFROZEN (:)=I%XFFROZEN (:, 1)
- PKI%XP_ALBF (:)=I%XALBF (:, 1)
- PKI%XP_EMISF (:)=I%XEMISF (:, 1)
- ELSE
- PKI%XP_FFLOOD (:)= 0.0
- PKI%XP_PIFLOOD (:)= 0.0
- PKI%XP_FF (:)= 0.0
- PKI%XP_FFG (:)= 0.0
- PKI%XP_FFV (:)= 0.0
- PKI%XP_FFROZEN (:)= 0.0
- PKI%XP_ALBF (:)= 0.0
- PKI%XP_EMISF (:)= 0.0
- ENDIF
- !
- IF(I%TSNOW%SCHEME=='EBA') THEN
- PKI%XP_PSNV_A (:) = I%XPSNV_A(:, 1)
- ENDIF
- !
- IF (I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO') THEN
- PKI%XP_SNOWHEAT (:,:) = I%TSNOW%HEAT (:,:,1)
- PKI%XP_SNOWAGE (:,:) = I%TSNOW%AGE (:,:,1)
- PKI%XP_SNOWALBVIS (:) = I%TSNOW%ALBVIS (:, 1)
- PKI%XP_SNOWALBNIR (:) = I%TSNOW%ALBNIR (:, 1)
- PKI%XP_SNOWALBFIR (:) = I%TSNOW%ALBFIR (:, 1)
- END IF
- !
- IF(I%TSNOW%SCHEME=='CRO') THEN
- PKI%XP_SNOWGRAN1 (:,:) = I%TSNOW%GRAN1 (:,:,1)
- PKI%XP_SNOWGRAN2 (:,:) = I%TSNOW%GRAN2 (:,:,1)
- PKI%XP_SNOWHIST (:,:) = I%TSNOW%HIST (:,:,1)
- END IF
- !
- IF(I%LGLACIER)THEN
- PKI%XP_ICE_STO (:)= I%XICE_STO (:,1)
- ENDIF
- !
- IF (I%CSCOND=='PL98'.OR.I%CISBA=='DIF') THEN
- PKI%XP_HCAPSOIL(:, :) = I%XHCAPSOIL (:, :)
- PKI%XP_CONDDRY (:, :) = I%XCONDDRY (:, :)
- PKI%XP_CONDSLD (:, :) = I%XCONDSLD (:, :)
- END IF
- !
- IF (I%CISBA=='2-L' .OR. I%CISBA=='3-L') THEN
- PKI%XP_C4B (:) = I%XC4B (:)
- PKI%XP_ACOEF (:) = I%XACOEF (:)
- PKI%XP_PCOEF (:) = I%XPCOEF (:)
- PKI%XP_CGSAT (:) = I%XCGSAT (:)
- PKI%XP_C1SAT (:) = I%XC1SAT (:, 1)
- PKI%XP_C2REF (:) = I%XC2REF (:, 1)
- PKI%XP_C4REF (:) = I%XC4REF (:, 1)
- PKI%XP_C3 (:,:) = I%XC3 (:,:,1)
- END IF
- !
- IF (I%CISBA=='DIF') THEN
- PKI%XP_ROOTFRAC (:, :) = I%XROOTFRAC (:, :, 1)
- PKI%XP_DZG (:, :) = I%XDZG (:, :, 1)
- PKI%XP_DZDIF (:, :) = I%XDZDIF (:, :, 1)
- PKI%XP_SOILWGHT (:, :) = I%XSOILWGHT (:, :, 1)
- PKI%NK_WG_LAYER (: ) = I%NWG_LAYER (:, 1)
- PKI%XP_FWTD (: ) = I%XFWTD (:)
- PKI%XP_WTD (: ) = I%XWTD (:)
- END IF
- !
- IF (I%CISBA=='DIF'.AND.I%CRUNOFF=='SGH') THEN
- PKI%XP_TOPQS (:, :) = I%XTOPQS (:, :, 1)
- END IF
- !
- IF (I%LTR_ML) THEN
- PKI%XP_FAPARC (:) = I%XFAPARC (:, 1)
- PKI%XP_FAPIRC (:) = I%XFAPIRC (:, 1)
- PKI%XP_LAI_EFFC (:) = I%XLAI_EFFC (:, 1)
- PKI%XP_MUS (:) = I%XMUS (:, 1)
- ENDIF
- !
- IF (I%CPHOTO=='NON') THEN
- PKI%XP_RSMIN (:) = I%XRSMIN (:, 1)
- END IF
-!
-! For multi-energy balance (MEB):
-!
-! Note that here the understory ground vegetation (GV) that was part of the original
-! MEB development has been eliminated. The reason is to avoid a composite
-! of vegetation and soil. Thus, most varibales with old extension V
-! (representing canopy vegetation) are now unassociated. Instead, the classical ISBA
-! variables (e.g. RGL, GAMMA, ...) will represent a composite vegetation in the
-! MEB case. We still keep the GV-variables in the system for future needs.
-! Code is commented with "nogv" in appropriate places.
-!
- IF(I%LMEB_PATCH(1))THEN
-!
- PKI%XP_WRL (:) = I%XWRL (:, 1)
- PKI%XP_WRLI (:) = I%XWRLI (:, 1)
- PKI%XP_WRVN (:) = I%XWRVN (:, 1)
- PKI%XP_TV (:) = I%XTV (:, 1)
- PKI%XP_TL (:) = I%XTL (:, 1)
- PKI%XP_TC (:) = I%XTC (:, 1)
- PKI%XP_QC (:) = I%XQC (:, 1)
-!
-! Please note that secondary Ecoclimap parameters, i.e. those
-! with postfix GV, are given to the corresponing original ISBA physiography
-! parameters in the case of LMEB_PATCH/OMEB=true. And the original ISBA
-! physiography parameters are given to the canopy vegetation parameters.
-! E.g. XLAI -> XP_LAIV and XLAIGV -> XP_LAI
-!
-!nogv IF (CISBA=='DIF') THEN
-!nogv XP_ROOTFRACV = XP_ROOTFRAC
-!nogv XP_ROOTFRAC (:, :) = XROOTFRACGV (:, :, 1)
-!nogv END IF
-!nogv IF (CPHOTO=='NON') THEN
-!nogv XP_RSMINV = XP_RSMIN
-!nogv XP_RSMIN (:) = XRSMINGV (:, 1)
-!nogv END IF
-!
-!nogv XP_RGLV (:) = XRGL (:, 1)
-!nogv XP_GAMMAV (:) = XGAMMA (:, 1)
-!nogv XP_WRMAX_CFV (:) = XWRMAX_CF (:, 1)
-!nogv XP_LAIV (:) = XLAI (:, 1)
-!nogv XP_Z0V (:) = XZ0 (:, 1)
- PKI%XP_H_VEG (:) = I%XH_VEG (:, 1)
-!
-!nogv XP_VEG (:) = XGNDLITTER (:, 1)
-!nogv XP_RGL (:) = XRGLGV (:, 1)
-!nogv XP_GAMMA (:) = XGAMMAGV (:, 1)
-!nogv XP_WRMAX_CF (:) = XWRMAX_CFGV (:, 1)
-!nogv XP_LAI (:) = XLAIGV (:, 1)
-!nogv XP_Z0 (:) = XZ0LITTER (:, 1)
- PKI%XP_GNDLITTER (:) = I%XGNDLITTER (:, 1)
- PKI%XP_Z0LITTER (:) = I%XZ0LITTER (:, 1)
-
- ENDIF
-!
- IF(I%CPHOTO/='NON' .OR. I%LMEB_PATCH(1))THEN
- PKI%XP_BSLAI (:) = I%XBSLAI (:, 1)
- ENDIF
-!
- IF (I%CPHOTO/='NON') THEN
- PKI%XP_LAIMIN (:) = I%XLAIMIN (:, 1)
- PKI%XP_SEFOLD (:) = I%XSEFOLD (:, 1)
- PKI%XP_H_TREE (:) = I%XH_TREE (:, 1)
- PKI%XP_ANMAX (:) = I%XANMAX (:, 1)
- PKI%XP_FZERO (:) = I%XFZERO (:, 1)
- PKI%XP_EPSO (:) = I%XEPSO (:, 1)
- PKI%XP_GAMM (:) = I%XGAMM (:, 1)
- PKI%XP_QDGAMM (:) = I%XQDGAMM (:, 1)
- PKI%XP_GMES (:) = I%XGMES (:, 1)
- PKI%XP_RE25 (:) = I%XRE25 (:, 1)
- PKI%XP_QDGMES (:) = I%XQDGMES (:, 1)
- PKI%XP_T1GMES (:) = I%XT1GMES (:, 1)
- PKI%XP_T2GMES (:) = I%XT2GMES (:, 1)
- PKI%XP_AMAX (:) = I%XAMAX (:, 1)
- PKI%XP_QDAMAX (:) = I%XQDAMAX (:, 1)
- PKI%XP_T1AMAX (:) = I%XT1AMAX (:, 1)
- PKI%XP_T2AMAX (:) = I%XT2AMAX (:, 1)
- PKI%XP_AN (:) = I%XAN (:, 1)
- PKI%XP_ANDAY (:) = I%XANDAY (:, 1)
- PKI%XP_ANFM (:) = I%XANFM (:, 1)
- PKI%XP_GC (:) = I%XGC (:, 1)
- PKI%XP_BIOMASS (:,:) = I%XBIOMASS (:,:,1)
- PKI%XP_RESP_BIOMASS (:,:) = I%XRESP_BIOMASS (:,:,1)
- END IF
- !
- IF (I%CPHOTO=='AST' .OR. I%CPHOTO=='LST' .OR. I%CPHOTO=='NIT' .OR. I%CPHOTO=='NCB') THEN
- PKI%LP_STRESS (:) = I%LSTRESS (:, 1)
- PKI%XP_F2I (:) = I%XF2I (:, 1)
- PKI%XP_AH (:) = I%XAH (:, 1)
- PKI%XP_BH (:) = I%XBH (:, 1)
- PKI%XP_DMAX (:) = I%XDMAX (:, 1)
- END IF
- !
- IF(I%CPHOTO=='LAI' .OR. I%CPHOTO=='LST' .OR. I%CPHOTO=='NIT' .OR. I%CPHOTO=='NCB') THEN
- PKI%TP_SEED (:) = I%TSEED (:,1)
- PKI%TP_REAP (:) = I%TREAP (:,1)
- PKI%XP_IRRIG (:) = I%XIRRIG (:,1)
- PKI%XP_WATSUP (:) = I%XWATSUP (:,1)
- IF (LAGRIP) THEN
- PKI%XP_LIRRIDAY (:) = AG%LIRRIDAY (:,1)
- PKI%XP_THRESHOLD(:) = AG%XTHRESHOLDSPT(:,1)
- PKI%XP_LIRRIGATE(:) = AG%LIRRIGATE (:,1)
- END IF
- ENDIF
- !
- IF(I%CPHOTO=='NIT' .OR. I%CPHOTO=='NCB') THEN
- PKI%XP_CE_NITRO (:) = I%XCE_NITRO (:,1)
- PKI%XP_CF_NITRO (:) = I%XCF_NITRO (:,1)
- PKI%XP_CNA_NITRO (:) = I%XCNA_NITRO (:,1)
- PKI%XP_BSLAI_NITRO (:) = I%XBSLAI_NITRO (:,1)
- END IF
- !
- IF (I%CPHOTO=='NCB') THEN
- PKI%XP_INCREASE (:,:) = I%XINCREASE (:,:,1)
- PKI%XP_TAU_WOOD (:) = I%XTAU_WOOD (:,1)
- END IF
- !
- IF (I%CRESPSL=='CNT') THEN
- PKI%XP_LITTER (:,:,:) = I%XLITTER (:,:,:,1)
- PKI%XP_SOILCARB (:,:) = I%XSOILCARB (:,:,1)
- PKI%XP_LIGNIN_STRUC (:,:) = I%XLIGNIN_STRUC (:,:,1)
- PKI%XP_TURNOVER (:,:) = I%XTURNOVER (:,:,1)
- END IF
- !
- IF (I%CRAIN=='SGH') THEN
- PKI%XP_MUF(:)=I%XMUF(:)
- ENDIF
-!
-!------------------------------------------------------------------------
-ELSE
-!------------------------------------------------------------------------
-!
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_Z0_O_Z0H (JJ) = I%XZ0_O_Z0H (JI, KPATCH)
- PKI%XP_EMIS (JJ) = I%XEMIS (JI, KPATCH)
- PKI%XP_ALBNIR (JJ) = I%XALBNIR (JI, KPATCH)
- PKI%XP_ALBVIS (JJ) = I%XALBVIS (JI, KPATCH)
- PKI%XP_ALBUV (JJ) = I%XALBUV (JI, KPATCH)
- PKI%XP_ALBNIR_VEG (JJ) = I%XALBNIR_VEG (JI, KPATCH)
- PKI%XP_ALBVIS_VEG (JJ) = I%XALBVIS_VEG (JI, KPATCH)
- PKI%XP_ALBUV_VEG (JJ) = I%XALBUV_VEG (JI, KPATCH)
- PKI%XP_ALBNIR_SOIL (JJ) = I%XALBNIR_SOIL (JI, KPATCH)
- PKI%XP_ALBVIS_SOIL (JJ) = I%XALBVIS_SOIL (JI, KPATCH)
- PKI%XP_ALBUV_SOIL (JJ) = I%XALBUV_SOIL (JI, KPATCH)
- PKI%XP_Z0 (JJ) = I%XZ0 (JI, KPATCH)
- PKI%XP_WRMAX_CF (JJ) = I%XWRMAX_CF (JI, KPATCH)
- PKI%XP_GAMMA (JJ) = I%XGAMMA (JI, KPATCH)
- PKI%XP_CV (JJ) = I%XCV (JI, KPATCH)
- PKI%XP_RGL (JJ) = I%XRGL (JI, KPATCH)
- PKI%XP_RUNOFFD (JJ) = I%XRUNOFFD (JI, KPATCH)
- PKI%XP_Z0EFFIP (JJ) = I%XZ0EFFIP (JI, KPATCH)
- PKI%XP_Z0EFFIM (JJ) = I%XZ0EFFIM (JI, KPATCH)
- PKI%XP_Z0EFFJP (JJ) = I%XZ0EFFJP (JI, KPATCH)
- PKI%XP_Z0EFFJM (JJ) = I%XZ0EFFJM (JI, KPATCH)
- PKI%XP_WR (JJ) = I%XWR (JI, KPATCH)
- PKI%XP_LAI (JJ) = I%XLAI (JI, KPATCH)
- PKI%XP_RESA (JJ) = I%XRESA (JI, KPATCH)
- PKI%XP_CPS (JJ) = I%XPCPS (JI, KPATCH)
- PKI%XP_LVTT (JJ) = I%XPLVTT (JI, KPATCH)
- PKI%XP_LSTT (JJ) = I%XPLSTT (JI, KPATCH)
- PKI%XP_VEG (JJ) = I%XVEG (JI, KPATCH)
- PKI%XP_SNOWALB (JJ) = I%TSNOW%ALB (JI, KPATCH)
- PKI%XP_LE (JJ) = I%XLE (JI, KPATCH)
- PKI%XP_PSN (JJ) = I%XPSN (JI, KPATCH)
- PKI%XP_PSNG (JJ) = I%XPSNG (JI, KPATCH)
- PKI%XP_PSNV (JJ) = I%XPSNV (JI, KPATCH)
- PKI%XP_ALBNIR_DRY (JJ) = I%XALBNIR_DRY (JI)
- PKI%XP_ALBVIS_DRY (JJ) = I%XALBVIS_DRY (JI)
- PKI%XP_ALBUV_DRY (JJ) = I%XALBUV_DRY (JI)
- PKI%XP_ALBNIR_WET (JJ) = I%XALBNIR_WET (JI)
- PKI%XP_ALBVIS_WET (JJ) = I%XALBVIS_WET (JI)
- PKI%XP_ALBUV_WET (JJ) = I%XALBUV_WET (JI)
- PKI%XP_RUNOFFB (JJ) = I%XRUNOFFB (JI)
- PKI%XP_WDRAIN (JJ) = I%XWDRAIN (JI)
- PKI%XP_TAUICE (JJ) = I%XTAUICE (JI)
- PKI%XP_Z0REL (JJ) = I%XZ0REL (JI)
- PKI%XP_AOSIP (JJ) = I%XAOSIP (JI)
- PKI%XP_AOSIM (JJ) = I%XAOSIM (JI)
- PKI%XP_AOSJP (JJ) = I%XAOSJP (JI)
- PKI%XP_AOSJM (JJ) = I%XAOSJM (JI)
- PKI%XP_HO2IP (JJ) = I%XHO2IP (JI)
- PKI%XP_HO2IM (JJ) = I%XHO2IM (JI)
- PKI%XP_HO2JP (JJ) = I%XHO2JP (JI)
- PKI%XP_HO2JM (JJ) = I%XHO2JM (JI)
- PKI%XP_SSO_SLOPE (JJ) = I%XSSO_SLOPE (JI)
- PKI%XP_GAMMAT (JJ) = I%XGAMMAT (JI)
- PKI%XP_TDEEP (JJ) = I%XTDEEP (JI)
- PKI%XP_LAT (JJ) = IG%XLAT (JI)
- PKI%XP_LON (JJ) = IG%XLON (JI)
- PKI%XP_FSAT (JJ) = I%XFSAT (JI)
- ENDDO
- !
- DO JK=1,I%NGROUND_LAYER
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_CLAY (JJ,JK) = I%XCLAY (JI, JK)
- PKI%XP_SAND (JJ,JK) = I%XSAND (JI, JK)
- PKI%XP_WFC (JJ,JK) = I%XWFC (JI, JK)
- PKI%XP_WWILT (JJ,JK) = I%XWWILT (JI, JK)
- PKI%XP_WSAT (JJ,JK) = I%XWSAT (JI, JK)
- PKI%XP_CONDSAT (JJ,JK) = I%XCONDSAT (JI, JK, KPATCH)
- PKI%XP_DG (JJ,JK) = I%XDG (JI, JK, KPATCH)
- PKI%XP_WG (JJ,JK) = I%XWG (JI, JK, KPATCH)
- PKI%XP_WGI (JJ,JK) = I%XWGI (JI, JK, KPATCH)
- PKI%XP_MPOTSAT (JJ, JK) = I%XMPOTSAT (JI, JK)
- PKI%XP_BCOEF (JJ, JK) = I%XBCOEF (JI, JK)
- ENDDO
- ENDDO
- !
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_KSAT_ICE(JJ) = I%XKSAT_ICE(JI,KPATCH)
- PKI%XP_D_ICE (JJ) = I%XD_ICE (JI,KPATCH)
- END DO
- !
- DO JK=1,NVEGTYPE
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_VEGTYPE_PATCH(JJ,JK) = I%XVEGTYPE_PATCH(JI, JK, KPATCH)
- ENDDO
- ENDDO
- !
- DO JK=1,SIZE(I%XTG,2)
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_TG (JJ,JK) = I%XTG (JI, JK, KPATCH)
- ENDDO
- ENDDO
- !
- DO JK=1,I%TSNOW%NLAYER
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_SNOWSWE (JJ,JK) = I%TSNOW%WSNOW (JI, JK, KPATCH)
- PKI%XP_SNOWRHO (JJ,JK) = I%TSNOW%RHO (JI, JK, KPATCH)
- ENDDO
- ENDDO
- !
- DO JK=1,SIZE(PKI%XP_DIR_ALB_WITH_SNOW,2)
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_DIR_ALB_WITH_SNOW (JJ,JK)= I%XDIR_ALB_WITH_SNOW(JI,JK,KPATCH)
- PKI%XP_SCA_ALB_WITH_SNOW (JJ,JK)= I%XSCA_ALB_WITH_SNOW(JI,JK,KPATCH)
- ENDDO
- ENDDO
- !
- IF (I%LFLOOD)THEN
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_FFLOOD (JJ)=I%XFFLOOD (JI)
- PKI%XP_PIFLOOD (JJ)=I%XPIFLOOD (JI)
- PKI%XP_FF (JJ)=I%XFF (JI,KPATCH)
- PKI%XP_FFG (JJ)=I%XFFG (JI,KPATCH)
- PKI%XP_FFV (JJ)=I%XFFV (JI,KPATCH)
- PKI%XP_FFROZEN (JJ)=I%XFFROZEN (JI,KPATCH)
- PKI%XP_ALBF (JJ)=I%XALBF (JI,KPATCH)
- PKI%XP_EMISF (JJ)=I%XEMISF (JI,KPATCH)
- END DO
- ELSE
- PKI%XP_FFLOOD (:) = 0.0
- PKI%XP_PIFLOOD (:) = 0.0
- PKI%XP_FF (:) = 0.0
- PKI%XP_FFG (:) = 0.0
- PKI%XP_FFROZEN (:) = 0.0
- PKI%XP_FFV (:) = 0.0
- PKI%XP_ALBF (:) = 0.0
- PKI%XP_EMISF (:) = 0.0
- ENDIF
-!
- IF(I%TSNOW%SCHEME=='EBA') THEN
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_PSNV_A (JJ) = I%XPSNV_A(JI, KPATCH)
- END DO
- END IF
- !
- IF (I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO') THEN
- DO JK=1,SIZE(PKI%XP_SNOWHEAT,2)
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_SNOWHEAT (JJ, JK) = I%TSNOW%HEAT (JI, JK, KPATCH)
- PKI%XP_SNOWAGE (JJ, JK) = I%TSNOW%AGE (JI, JK, KPATCH)
- ENDDO
- END DO
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_SNOWALBVIS (JJ) = I%TSNOW%ALBVIS (JI, KPATCH)
- PKI%XP_SNOWALBNIR (JJ) = I%TSNOW%ALBNIR (JI, KPATCH)
- PKI%XP_SNOWALBFIR (JJ) = I%TSNOW%ALBFIR (JI, KPATCH)
- ENDDO
- END IF
- !
- IF (I%TSNOW%SCHEME=='CRO') THEN
- DO JK=1,SIZE(PKI%XP_SNOWGRAN1,2)
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_SNOWGRAN1 (JJ, JK) = I%TSNOW%GRAN1 (JI, JK, KPATCH)
- PKI%XP_SNOWGRAN2 (JJ, JK) = I%TSNOW%GRAN2 (JI, JK, KPATCH)
- PKI%XP_SNOWHIST (JJ, JK) = I%TSNOW%HIST (JI, JK, KPATCH)
- ENDDO
- END DO
- END IF
- !
- IF(I%LGLACIER)THEN
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_ICE_STO(JJ) = I%XICE_STO (JI,KPATCH)
- ENDDO
- ENDIF
- !
- IF (I%CSCOND=='PL98'.OR.I%CISBA=='DIF') THEN
- DO JK=1,SIZE(I%XHCAPSOIL,2)
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_HCAPSOIL (JJ, JK) = I%XHCAPSOIL (JI, JK)
- PKI%XP_CONDDRY (JJ, JK) = I%XCONDDRY (JI, JK)
- PKI%XP_CONDSLD (JJ, JK) = I%XCONDSLD (JI, JK)
- ENDDO
- ENDDO
- END IF
- !
- IF (I%CISBA=='2-L' .OR. I%CISBA=='3-L') THEN
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_C4B (JJ) = I%XC4B (JI)
- PKI%XP_ACOEF (JJ) = I%XACOEF (JI)
- PKI%XP_PCOEF (JJ) = I%XPCOEF (JI)
- PKI%XP_CGSAT (JJ) = I%XCGSAT (JI)
- PKI%XP_C1SAT (JJ) = I%XC1SAT (JI, KPATCH)
- PKI%XP_C2REF (JJ) = I%XC2REF (JI, KPATCH)
- PKI%XP_C4REF (JJ) = I%XC4REF (JI, KPATCH)
- ENDDO
- !
- DO JK=1,SIZE(I%XC3,2)
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_C3 (JJ,JK) = I%XC3 (JI, JK, KPATCH)
- ENDDO
- ENDDO
- END IF
- !
- DO JK=1,SIZE(I%XBCOEF,2)
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_MPOTSAT (JJ, JK) = I%XMPOTSAT (JI, JK)
- PKI%XP_BCOEF (JJ, JK) = I%XBCOEF (JI, JK)
- ENDDO
- ENDDO
- !
- IF (I%CISBA=='DIF') THEN
- DO JK=1,SIZE(I%XROOTFRAC,2)
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_ROOTFRAC (JJ, JK) = I%XROOTFRAC (JI, JK, KPATCH)
- PKI%XP_DZG (JJ, JK) = I%XDZG (JI, JK, KPATCH)
- PKI%XP_DZDIF (JJ, JK) = I%XDZDIF (JI, JK, KPATCH)
- PKI%XP_SOILWGHT (JJ, JK) = I%XSOILWGHT (JI, JK, KPATCH)
- ENDDO
- ENDDO
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%NK_WG_LAYER (JJ) = I%NWG_LAYER (JI,KPATCH)
- PKI%XP_FWTD (JJ) = I%XFWTD (JI)
- PKI%XP_WTD (JJ) = I%XWTD (JI)
- ENDDO
- ENDIF
- !
- IF (I%CISBA=='DIF'.AND.I%CRUNOFF=='SGH') THEN
- DO JK=1,SIZE(I%XROOTFRAC,2)
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_TOPQS (JJ, JK) = I%XTOPQS (JI, JK, KPATCH)
- ENDDO
- ENDDO
- END IF
- !
- IF (I%LTR_ML) THEN
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_FAPARC (JJ) = I%XFAPARC (JI, KPATCH)
- PKI%XP_FAPIRC (JJ) = I%XFAPIRC (JI, KPATCH)
- PKI%XP_LAI_EFFC (JJ) = I%XLAI_EFFC (JI, KPATCH)
- PKI%XP_MUS (JJ) = I%XMUS (JI, KPATCH)
- ENDDO
- ENDIF
- !
- IF (I%CPHOTO=='NON') THEN
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_RSMIN (JJ) = I%XRSMIN (JI, KPATCH)
- END DO
- END IF
- !
- IF(I%LMEB_PATCH(KPATCH))THEN
-!
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_WRL (JJ) = I%XWRL (JI, KPATCH)
- PKI%XP_WRLI (JJ) = I%XWRLI (JI, KPATCH)
- PKI%XP_WRVN (JJ) = I%XWRVN (JI, KPATCH)
- PKI%XP_TV (JJ) = I%XTV (JI, KPATCH)
- PKI%XP_TL (JJ) = I%XTL (JI, KPATCH)
- PKI%XP_TC (JJ) = I%XTC (JI, KPATCH)
- PKI%XP_QC (JJ) = I%XQC (JI, KPATCH)
- ENDDO
-!
-! Please note that secondary Ecoclimap parameters, i.e. those
-! with postfix GV, are given to the corresponing original ISBA physiography
-! parameters in the case of LMEB_PATCH/OMEB=true. And the original ISBA
-! physiography parameters are given to the canopy vegetation parameters.
-! E.g. XLAI -> XP_LAIV and XLAIGV -> XP_LAI
-!
-!nogv IF (CISBA=='DIF') THEN
-!nogv XP_ROOTFRACV = XP_ROOTFRAC
-!nogv DO JK=1,SIZE(XROOTFRAC,2)
-!nogv DO JJ=1,KSIZE
-!nogv JI = KMASK(JJ)
-!nogv XP_ROOTFRAC (JJ, JK) = XROOTFRACGV (JI, JK, KPATCH)
-!nogv ENDDO
-!nogv ENDDO
-!nogv END IF
-!
-!nogv IF (CPHOTO=='NON') THEN
-!nogv XP_RSMINV = XP_RSMIN
-!nogv DO JJ=1,KSIZE
-!nogv JI = KMASK(JJ)
-!nogv XP_RSMIN (JJ) = XRSMINGV (JI, KPATCH)
-!nogv END DO
-!nogv END IF
-!
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_H_VEG (JJ) = I%XH_VEG (JI, KPATCH)
-!nogv XP_RGLV (JJ) = XRGL (JI, KPATCH)
-!nogv XP_GAMMAV (JJ) = XGAMMA (JI, KPATCH)
-!nogv XP_WRMAX_CFV (JJ) = XWRMAX_CF (JI, KPATCH)
-!nogv XP_LAIV (JJ) = XLAI (JI, KPATCH)
-!nogv XP_Z0V (JJ) = XZ0 (JI, KPATCH)
-!
-!nogv XP_VEG (JJ) = XGNDLITTER (JI, KPATCH)
-!nogv XP_RGL (JJ) = XRGLGV (JI, KPATCH)
-!nogv XP_GAMMA (JJ) = XGAMMAGV (JI, KPATCH)
-!nogv XP_WRMAX_CF (JJ) = XWRMAX_CFGV (JI, KPATCH)
-!nogv XP_LAI (JJ) = XLAIGV (JI, KPATCH)
-!nogv XP_Z0 (JJ) = XZ0LITTER (JI, KPATCH)
- PKI%XP_GNDLITTER (JJ) = I%XGNDLITTER (JI, KPATCH)
- PKI%XP_Z0LITTER (JJ) = I%XZ0LITTER (JI, KPATCH)
- ENDDO
- ENDIF
-!
- IF(I%CPHOTO/='NON' .OR. I%LMEB_PATCH(KPATCH))THEN
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_BSLAI (JJ) = I%XBSLAI (JI, KPATCH)
- ENDDO
- ENDIF
-!
- IF (I%CPHOTO/='NON') THEN
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_LAIMIN (JJ) = I%XLAIMIN (JI, KPATCH)
- PKI%XP_SEFOLD (JJ) = I%XSEFOLD (JI, KPATCH)
- PKI%XP_H_TREE (JJ) = I%XH_TREE (JI, KPATCH)
- PKI%XP_ANMAX (JJ) = I%XANMAX (JI, KPATCH)
- PKI%XP_FZERO (JJ) = I%XFZERO (JI, KPATCH)
- PKI%XP_EPSO (JJ) = I%XEPSO (JI, KPATCH)
- PKI%XP_GAMM (JJ) = I%XGAMM (JI, KPATCH)
- PKI%XP_QDGAMM (JJ) = I%XQDGAMM (JI, KPATCH)
- PKI%XP_GMES (JJ) = I%XGMES (JI, KPATCH)
- PKI%XP_RE25 (JJ) = I%XRE25 (JI, KPATCH)
- PKI%XP_QDGMES (JJ) = I%XQDGMES (JI, KPATCH)
- PKI%XP_T1GMES (JJ) = I%XT1GMES (JI, KPATCH)
- PKI%XP_T2GMES (JJ) = I%XT2GMES (JI, KPATCH)
- PKI%XP_AMAX (JJ) = I%XAMAX (JI, KPATCH)
- PKI%XP_QDAMAX (JJ) = I%XQDAMAX (JI, KPATCH)
- PKI%XP_T1AMAX (JJ) = I%XT1AMAX (JI, KPATCH)
- PKI%XP_T2AMAX (JJ) = I%XT2AMAX (JI, KPATCH)
- PKI%XP_AN (JJ) = I%XAN (JI, KPATCH)
- PKI%XP_ANDAY (JJ) = I%XANDAY (JI, KPATCH)
- PKI%XP_ANFM (JJ) = I%XANFM (JI, KPATCH)
- PKI%XP_GC (JJ) = I%XGC (JI, KPATCH)
- ENDDO
- DO JK=1,SIZE(I%XBIOMASS,2)
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_BIOMASS (JJ,JK) = I%XBIOMASS (JI,JK,KPATCH)
- PKI%XP_RESP_BIOMASS (JJ,JK) = I%XRESP_BIOMASS (JI,JK,KPATCH)
- ENDDO
- END DO
- END IF
- !
- IF (I%CPHOTO=='AST' .OR. I%CPHOTO=='LST' .OR. I%CPHOTO=='NIT' .OR. I%CPHOTO=='NCB') THEN
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%LP_STRESS (JJ) = I%LSTRESS (JI, KPATCH)
- PKI%XP_F2I (JJ) = I%XF2I (JI, KPATCH)
- PKI%XP_AH (JJ) = I%XAH (JI, KPATCH)
- PKI%XP_BH (JJ) = I%XBH (JI, KPATCH)
- PKI%XP_DMAX (JJ) = I%XDMAX (JI, KPATCH)
- END DO
- END IF
- !
- IF(I%CPHOTO=='LAI' .OR. I%CPHOTO=='LST' .OR. I%CPHOTO=='NIT' .OR. I%CPHOTO=='NCB') THEN
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%TP_SEED (JJ) = I%TSEED (JI,KPATCH)
- PKI%TP_REAP (JJ) = I%TREAP (JI,KPATCH)
- PKI%XP_IRRIG (JJ) = I%XIRRIG (JI,KPATCH)
- PKI%XP_WATSUP (JJ) = I%XWATSUP (JI,KPATCH)
- ENDDO
- IF (LAGRIP) THEN
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_LIRRIDAY (JJ) = AG%LIRRIDAY (JI,KPATCH)
- PKI%XP_THRESHOLD(JJ) = AG%XTHRESHOLDSPT(JI,KPATCH)
- PKI%XP_LIRRIGATE(JJ) = AG%LIRRIGATE (JI,KPATCH)
- ENDDO
- ENDIF
- ENDIF
- !
- IF(I%CPHOTO=='NIT' .OR. I%CPHOTO=='NCB') THEN
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_CE_NITRO (JJ) = I%XCE_NITRO (JI,KPATCH)
- PKI%XP_CF_NITRO (JJ) = I%XCF_NITRO (JI,KPATCH)
- PKI%XP_CNA_NITRO (JJ) = I%XCNA_NITRO (JI,KPATCH)
- PKI%XP_BSLAI_NITRO (JJ) = I%XBSLAI_NITRO (JI,KPATCH)
- END DO
- END IF
- !
- IF (I%CPHOTO=='NCB') THEN
- DO JK=1,SIZE(I%XINCREASE,2)
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_INCREASE (JJ,JK) = I%XINCREASE (JI,JK,KPATCH)
- ENDDO
- END DO
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_TAU_WOOD (JJ) = I%XTAU_WOOD (JI,KPATCH)
- END DO
- END IF
- !
- IF (I%CRESPSL=='CNT') THEN
- DO JL=1,SIZE(PKI%XP_LITTER,3)
- DO JK=1,SIZE(PKI%XP_LITTER,2)
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_LITTER (JJ,JK,JL) = I%XLITTER (JI,JK,JL,KPATCH)
- ENDDO
- ENDDO
- ENDDO
- DO JK=1,SIZE(PKI%XP_SOILCARB,2)
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_SOILCARB (JJ,JK) = I%XSOILCARB (JI,JK,KPATCH)
- ENDDO
- ENDDO
- DO JK=1,SIZE(PKI%XP_LIGNIN_STRUC,2)
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_LIGNIN_STRUC (JJ,JK) = I%XLIGNIN_STRUC (JI,JK,KPATCH)
- ENDDO
- ENDDO
- DO JK=1,SIZE(PKI%XP_TURNOVER,2)
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_TURNOVER (JJ,JK) = I%XTURNOVER (JI,JK,KPATCH)
- ENDDO
- ENDDO
- END IF
-!
- IF (I%CRAIN=='SGH')THEN
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- PKI%XP_MUF(JJ) = I%XMUF(JI)
- END DO
- ENDIF
-!
-!------------------------------------------------------------------------
-END IF
-IF (LHOOK) CALL DR_HOOK('PACK_ISBA_PATCH_N',1,ZHOOK_HANDLE)
-!------------------------------------------------------------------------
-END SUBROUTINE PACK_ISBA_PATCH_n
diff --git a/src/SURFEX/pack_pgd.F90 b/src/SURFEX/pack_pgd.F90
index 914a2a85a52aa19612d2320854f264b2dcb9afb9..7549f84092e9cc9b85743377b196ded6c463c0af 100644
--- a/src/SURFEX/pack_pgd.F90
+++ b/src/SURFEX/pack_pgd.F90
@@ -3,11 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PACK_PGD (DTCO, U, &
- HPROGRAM, HSURF, &
- HGRID, PGRID_PAR, &
- OCOVER, PCOVER, PZS, &
- PLAT, PLON, PMESH_SIZE, PDIR )
+ SUBROUTINE PACK_PGD (DTCO, U, HPROGRAM, HSURF, G, OCOVER, PCOVER, PZS, PDIR )
! ##############################################################
!
!!**** *PACK_PGD* packs ISBA physiographic fields from all surface points to ISBA points
@@ -38,7 +34,6 @@
!!
!! Original 03/2004
!! Escobar J. 08/02/2005 : bug declare ILU local variable
-!! M.Moge 10/02/2015 parallelization : changes in the calls to GET_COVER_n and GET_ZS_n, use NSIE_FULL instead of NL
!!
!----------------------------------------------------------------------------
!
@@ -46,7 +41,7 @@
! -----------
!
!
-!
+USE MODD_SFX_GRID_n, ONLY : GRID_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
@@ -62,7 +57,6 @@ USE MODI_PACK_SAME_RANK
USE MODI_PACK_GRID
USE MODI_LATLON_GRID
!
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -79,18 +73,14 @@ IMPLICIT NONE
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(GRID_t), INTENT(INOUT) :: G
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
CHARACTER(LEN=6), INTENT(IN) :: HSURF ! surface type
!
- CHARACTER(LEN=10), INTENT(OUT):: HGRID ! grid used
-REAL, DIMENSION(:), POINTER :: PGRID_PAR ! grid definition
LOGICAL, DIMENSION(:), INTENT(OUT):: OCOVER ! list of present cover
REAL, DIMENSION(:,:), POINTER :: PCOVER ! cover fraction
REAL, DIMENSION(:), INTENT(OUT):: PZS ! zs
-REAL, DIMENSION(:), INTENT(OUT):: PLAT ! latitude
-REAL, DIMENSION(:), INTENT(OUT):: PLON ! longitude
-REAL, DIMENSION(:), INTENT(OUT):: PMESH_SIZE! mesh size
REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PDIR ! angle of grid axis with N.
!
!
@@ -102,11 +92,10 @@ INTEGER :: IL ! number of points
INTEGER :: ILU ! expected physical size of full surface array
INTEGER :: JCOVER
INTEGER, DIMENSION(:), POINTER :: IMASK ! mask for packing from complete field to nature field
-REAL, DIMENSION(SIZE(PLAT)) :: ZDIR
+REAL, DIMENSION(SIZE(G%XLAT)) :: ZDIR
!
-REAL, DIMENSION(U%NSIZE_FULL) :: ZCOVER ! cover on all surface points
-LOGICAL, DIMENSION(JPCOVER) :: GCOVER ! list of existing cover
-REAL, DIMENSION(U%NSIZE_FULL) :: ZZS ! zs on all surface points
+REAL, DIMENSION(NL) :: ZCOVER ! cover on all surface points
+REAL, DIMENSION(NL) :: ZZS ! zs on all surface points
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
@@ -116,26 +105,33 @@ IF (LHOOK) CALL DR_HOOK('PACK_PGD',0,ZHOOK_HANDLE)
!* 1. Number of points and packing
! ----------------------------
!
- CALL GET_TYPE_DIM_n(DTCO, U, &
- HSURF,IL)
+ CALL GET_TYPE_DIM_n(DTCO, U, HSURF,IL)
+!
ALLOCATE(IMASK(IL))
ILU=0
- CALL GET_SURF_MASK_n(DTCO, U, &
- HSURF,IL,IMASK,ILU,ILUOUT)
+ CALL GET_SURF_MASK_n(DTCO, U, HSURF,IL,IMASK,ILU,ILUOUT)
!
!-------------------------------------------------------------------------------
!
!* 2. Packing of grid
! ---------------
!
- CALL PACK_GRID(IMASK,CGRID,HGRID,XGRID_PAR,PGRID_PAR)
+ CALL PACK_GRID(IMASK,CGRID,G%CGRID,XGRID_PAR,G%XGRID_PAR)
+!
+ CALL GET_LCOVER_n(U,HPROGRAM,JPCOVER,OCOVER)
+!
+IF (IL==0) THEN
+ ALLOCATE(PCOVER(0,0))
+ IF (LHOOK) CALL DR_HOOK('PACK_PGD',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
!
!-------------------------------------------------------------------------------
!
!* 3. Computes geographical quantities
! --------------------------------
!
- CALL LATLON_GRID(HGRID,SIZE(PGRID_PAR),IL,ILUOUT,PGRID_PAR,PLAT,PLON,PMESH_SIZE,ZDIR)
+ CALL LATLON_GRID(G,IL,ZDIR)
!
IF (PRESENT(PDIR)) PDIR = ZDIR
!
@@ -144,23 +140,23 @@ IF (PRESENT(PDIR)) PDIR = ZDIR
!* 4. Packing of fields
! -----------------
!
- CALL GET_LCOVER_n(U, &
- HPROGRAM,JPCOVER,GCOVER)
+IF (HSURF=='NATURE') THEN
+ !
+ ALLOCATE(PCOVER(SIZE(G%XLAT),COUNT(OCOVER)))
+ !
+ DO JCOVER=1,COUNT(OCOVER)
+ CALL GET_COVER_n(U,HPROGRAM,JCOVER,ZCOVER)
+ CALL PACK_SAME_RANK(IMASK,ZCOVER(:),PCOVER(:,JCOVER))
+ ENDDO
+ !
+ELSE
+ !
+ ALLOCATE(PCOVER(0,0))
+ !
+ENDIF
!
-ALLOCATE(PCOVER(SIZE(PLAT),COUNT(GCOVER)))
+ CALL GET_ZS_n(U, HPROGRAM,NL,ZZS)
!
-DO JCOVER=1,COUNT(GCOVER)
- CALL GET_COVER_n(U, &
- HPROGRAM,JCOVER,ZCOVER)
- CALL PACK_SAME_RANK(IMASK,ZCOVER(:),PCOVER(:,JCOVER))
-ENDDO
-
- CALL GET_ZS_n(U, &
- HPROGRAM,U%NSIZE_FULL,ZZS)
-!
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-!
-OCOVER=GCOVER
!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
@@ -169,6 +165,7 @@ OCOVER=GCOVER
!-------------------------------------------------------------------------------
!
DEALLOCATE(IMASK)
+!
IF (LHOOK) CALL DR_HOOK('PACK_PGD',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/pack_pgd_isba.F90 b/src/SURFEX/pack_pgd_isba.F90
index 1ae0b11b4022abaa27960590e813c2504e83fbff..584a95e0052a7947c8051ef795e603209a9d590b 100644
--- a/src/SURFEX/pack_pgd_isba.F90
+++ b/src/SURFEX/pack_pgd_isba.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PACK_PGD_ISBA (DTCO, IG, I, U, &
+ SUBROUTINE PACK_PGD_ISBA (DTCO, KDIM, ISS, U, &
HPROGRAM, &
PAOSIP, PAOSIM, PAOSJP, PAOSJM, &
PHO2IP, PHO2IM, PHO2JP, PHO2JM, &
@@ -48,8 +48,7 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_SSO_n, ONLY : SSO_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODI_PACK_SAME_RANK
@@ -69,8 +68,8 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
+INTEGER, INTENT(INOUT) :: KDIM
+TYPE(SSO_t), INTENT(INOUT) :: ISS
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
@@ -101,12 +100,10 @@ IF (LHOOK) CALL DR_HOOK('PACK_PGD_ISBA',0,ZHOOK_HANDLE)
!* 1. Number of points and packing
! ----------------------------
!
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'NATURE',IG%NDIM)
-ALLOCATE(IMASK(IG%NDIM))
+ CALL GET_TYPE_DIM_n(DTCO, U, 'NATURE',KDIM)
+ALLOCATE(IMASK(KDIM))
ILU=0
- CALL GET_SURF_MASK_n(DTCO, U, &
- 'NATURE',IG%NDIM,IMASK,ILU,ILUOUT)
+ CALL GET_SURF_MASK_n(DTCO, U, 'NATURE',KDIM,IMASK,ILU,ILUOUT)
!
!
!-------------------------------------------------------------------------------
@@ -114,24 +111,25 @@ ILU=0
!* 2. Packing of fields
! -----------------
!
-ALLOCATE(I%XAOSIP(IG%NDIM))
-ALLOCATE(I%XAOSIM(IG%NDIM))
-ALLOCATE(I%XAOSJP(IG%NDIM))
-ALLOCATE(I%XAOSJM(IG%NDIM))
-ALLOCATE(I%XHO2IP(IG%NDIM))
-ALLOCATE(I%XHO2IM(IG%NDIM))
-ALLOCATE(I%XHO2JP(IG%NDIM))
-ALLOCATE(I%XHO2JM(IG%NDIM))
-ALLOCATE(I%XSSO_SLOPE(IG%NDIM))
- CALL PACK_SAME_RANK(IMASK,PAOSIP(:),I%XAOSIP(:))
- CALL PACK_SAME_RANK(IMASK,PAOSIM(:),I%XAOSIM(:))
- CALL PACK_SAME_RANK(IMASK,PAOSJP(:),I%XAOSJP(:))
- CALL PACK_SAME_RANK(IMASK,PAOSJM(:),I%XAOSJM(:))
- CALL PACK_SAME_RANK(IMASK,PHO2IP(:),I%XHO2IP(:))
- CALL PACK_SAME_RANK(IMASK,PHO2IM(:),I%XHO2IM(:))
- CALL PACK_SAME_RANK(IMASK,PHO2JP(:),I%XHO2JP(:))
- CALL PACK_SAME_RANK(IMASK,PHO2JM(:),I%XHO2JM(:))
- CALL PACK_SAME_RANK(IMASK,PSSO_SLOPE(:),I%XSSO_SLOPE(:))
+ALLOCATE(ISS%XAOSIP(KDIM))
+ALLOCATE(ISS%XAOSIM(KDIM))
+ALLOCATE(ISS%XAOSJP(KDIM))
+ALLOCATE(ISS%XAOSJM(KDIM))
+ALLOCATE(ISS%XHO2IP(KDIM))
+ALLOCATE(ISS%XHO2IM(KDIM))
+ALLOCATE(ISS%XHO2JP(KDIM))
+ALLOCATE(ISS%XHO2JM(KDIM))
+ALLOCATE(ISS%XSSO_SLOPE(KDIM))
+ CALL PACK_SAME_RANK(IMASK,PAOSIP(:),ISS%XAOSIP(:))
+ CALL PACK_SAME_RANK(IMASK,PAOSIM(:),ISS%XAOSIM(:))
+ CALL PACK_SAME_RANK(IMASK,PAOSJP(:),ISS%XAOSJP(:))
+ CALL PACK_SAME_RANK(IMASK,PAOSJM(:),ISS%XAOSJM(:))
+ CALL PACK_SAME_RANK(IMASK,PHO2IP(:),ISS%XHO2IP(:))
+ CALL PACK_SAME_RANK(IMASK,PHO2IM(:),ISS%XHO2IM(:))
+ CALL PACK_SAME_RANK(IMASK,PHO2JP(:),ISS%XHO2JP(:))
+ CALL PACK_SAME_RANK(IMASK,PHO2JM(:),ISS%XHO2JM(:))
+ CALL PACK_SAME_RANK(IMASK,PSSO_SLOPE(:),ISS%XSSO_SLOPE(:))
+!
IF (LHOOK) CALL DR_HOOK('PACK_PGD_ISBA',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/pack_pgd_seaflux.F90 b/src/SURFEX/pack_pgd_seaflux.F90
index ae27a362056fa514e25fd5839140ae55ade76a54..72487423dbbcccb69e06669dcc4d8fb280dfaac3 100644
--- a/src/SURFEX/pack_pgd_seaflux.F90
+++ b/src/SURFEX/pack_pgd_seaflux.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PACK_PGD_SEAFLUX (DTCO, SG, S, U, &
- HPROGRAM,PSEABATHY)
+ SUBROUTINE PACK_PGD_SEAFLUX (DTCO, KDIM, S, U, HPROGRAM,PSEABATHY)
! ##############################################################
!
!!**** *PACK_PGD_SEAFLUX* packs SEAFLUX physiographic fields from all surface points to SEAFLUX points
@@ -45,7 +44,6 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_SEAFLUX_GRID_n, ONLY : SEAFLUX_GRID_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
@@ -59,6 +57,7 @@ USE MODI_GET_SURF_MASK_n
USE MODI_GET_TYPE_DIM_n
!
USE MODI_GET_LUOUT
+!
IMPLICIT NONE
!
!* 0.1 Declaration of arguments
@@ -66,7 +65,7 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(SEAFLUX_GRID_t), INTENT(INOUT) :: SG
+INTEGER, INTENT(INOUT) :: KDIM
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
@@ -89,12 +88,10 @@ IF (LHOOK) CALL DR_HOOK('PACK_PGD_SEAFLUX',0,ZHOOK_HANDLE)
!* 1. Number of points and packing
! ----------------------------
!
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'SEA ',SG%NDIM)
-ALLOCATE(IMASK(SG%NDIM))
+ CALL GET_TYPE_DIM_n(DTCO, U, 'SEA ',KDIM)
+ALLOCATE(IMASK(KDIM))
ILU=0
- CALL GET_SURF_MASK_n(DTCO, U, &
- 'SEA ',SG%NDIM,IMASK,ILU,ILUOUT)
+ CALL GET_SURF_MASK_n(DTCO, U, 'SEA ',KDIM,IMASK,ILU,ILUOUT)
!
!
!-------------------------------------------------------------------------------
@@ -102,7 +99,7 @@ ILU=0
!* 2. Packing of fields
! -----------------
!
-ALLOCATE(S%XSEABATHY(SG%NDIM))
+ALLOCATE(S%XSEABATHY(KDIM))
CALL PACK_SAME_RANK(IMASK,PSEABATHY(:),S%XSEABATHY(:))
IF (LHOOK) CALL DR_HOOK('PACK_PGD_SEAFLUX',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/pack_pgd_soil.F90 b/src/SURFEX/pack_pgd_soil.F90
deleted file mode 100644
index 182e9ff0600d9c14ef35845731ec94e56bf5ea65..0000000000000000000000000000000000000000
--- a/src/SURFEX/pack_pgd_soil.F90
+++ /dev/null
@@ -1,126 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE PACK_PGD_SOIL (DTCO, IG, I, U, &
- HPROGRAM, PSAND, PCLAY, PRUNOFFB, PWDRAIN)
-! ##############################################################
-!
-!!**** *PACK_PGD_SOIL* packs ISBA physiographic fields from all surface points to ISBA points
-!!
-!! PURPOSE
-!! -------
-!!
-!! METHOD
-!! ------
-!!
-!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! V. Masson Meteo-France
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 03/2004
-!! Escobar J. 08/02/2005 : bug declare ILU local variable
-!! B. Decharme 20008 : XWDRAIN
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
-!
-!
-!
-!
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
-USE MODI_PACK_SAME_RANK
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODI_GET_SURF_MASK_n
-!
-USE MODI_GET_TYPE_DIM_n
-!
-USE MODI_GET_LUOUT
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-!
-!
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
-REAL, DIMENSION(:,:), INTENT(IN) :: PSAND ! sand on all surface points
-REAL, DIMENSION(:,:), INTENT(IN) :: PCLAY ! clay on all surface points
-REAL, DIMENSION(:), INTENT(IN) :: PRUNOFFB ! runoff coef. on all surface points
-REAL, DIMENSION(:), INTENT(IN) :: PWDRAIN ! drainage coef. on all surface points
-!
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-INTEGER :: ILU ! expected physical size of full surface array
-INTEGER :: ILUOUT ! output listing logical unit
-INTEGER, DIMENSION(:), POINTER :: IMASK ! mask for packing from complete field to nature field
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('PACK_PGD_SOIL',0,ZHOOK_HANDLE)
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
-!
-!* 1. Number of points and packing
-! ----------------------------
-!
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'NATURE',IG%NDIM)
-ALLOCATE(IMASK(IG%NDIM))
-ILU=0
- CALL GET_SURF_MASK_n(DTCO, U, &
- 'NATURE',IG%NDIM,IMASK,ILU,ILUOUT)
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. Packing of fields
-! -----------------
-!
-ALLOCATE(I%XSAND(IG%NDIM,I%NGROUND_LAYER))
- CALL PACK_SAME_RANK(IMASK,PSAND(:,:),I%XSAND(:,:))
-!
-ALLOCATE(I%XCLAY(IG%NDIM,I%NGROUND_LAYER))
- CALL PACK_SAME_RANK(IMASK,PCLAY(:,:),I%XCLAY(:,:))
-!
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-!
-ALLOCATE(I%XRUNOFFB(IG%NDIM))
- CALL PACK_SAME_RANK(IMASK,PRUNOFFB(:),I%XRUNOFFB(:))
-!
-ALLOCATE(I%XWDRAIN(IG%NDIM))
- CALL PACK_SAME_RANK(IMASK,PWDRAIN(:),I%XWDRAIN(:))
-IF (LHOOK) CALL DR_HOOK('PACK_PGD_SOIL',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE PACK_PGD_SOIL
diff --git a/src/SURFEX/pack_same_rank.F90 b/src/SURFEX/pack_same_rank.F90
index 233e7eae1bbc774fa6328b7286665578eecb27c8..2ba7462fd255b2cd5c6730a92ceaf66297530eca 100644
--- a/src/SURFEX/pack_same_rank.F90
+++ b/src/SURFEX/pack_same_rank.F90
@@ -19,6 +19,14 @@ INTEGER, DIMENSION(:), INTENT(IN) :: KM
INTEGER, DIMENSION(:,:), INTENT(IN) :: K1D_IN
INTEGER, DIMENSION(:,:), INTENT(OUT):: K1D_OUT
END SUBROUTINE PACK_SAME_RANK_FROM2DI
+!
+ SUBROUTINE PACK_SAME_RANK_FROM3DI(KM,K3D_IN,K3D_OUT)
+
+INTEGER, DIMENSION(:), INTENT(IN) :: KM
+INTEGER, DIMENSION(:,:,:), INTENT(IN) :: K3D_IN
+INTEGER, DIMENSION(:,:,:), INTENT(OUT):: K3D_OUT
+!
+END SUBROUTINE PACK_SAME_RANK_FROM3DI
!
SUBROUTINE PACK_SAME_RANK_FROM1DL(KM,O1D_IN,O1D_OUT)
@@ -266,6 +274,77 @@ IF (LHOOK) CALL DR_HOOK('MODI_PACK_SAME_RANK:PACK_SAME_RANK_FROM2DI',1,ZHOOK_HAN
!
END SUBROUTINE PACK_SAME_RANK_FROM2DI
!
+! ##############################################
+ SUBROUTINE PACK_SAME_RANK_FROM3DI(KM,K3D_IN,K3D_OUT)
+! ##############################################
+!
+!!**** *PACK_SAME_RANK* - extract the defined data from a 2D field into a 2D field
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! F. Habets *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 08/03
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+INTEGER, DIMENSION(:), INTENT(IN) :: KM
+INTEGER, DIMENSION(:,:,:), INTENT(IN) :: K3D_IN
+INTEGER, DIMENSION(:,:,:), INTENT(OUT):: K3D_OUT
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI, JJ, JK ! loop counter
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+!
+!
+IF (LHOOK) CALL DR_HOOK('MODI_PACK_SAME_RANK:PACK_SAME_RANK_FROM3DI',0,ZHOOK_HANDLE)
+DO JK=1,SIZE(K3D_OUT,3)
+ DO JJ=1,SIZE(K3D_OUT,2)
+ DO JI=1,SIZE(K3D_OUT,1)
+ K3D_OUT(JI,JJ,JK) = K3D_IN(KM(JI),JJ,JK)
+ ENDDO
+ ENDDO
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK('MODI_PACK_SAME_RANK:PACK_SAME_RANK_FROM3DI',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE PACK_SAME_RANK_FROM3DI
+!
! ##############################################
SUBROUTINE PACK_SAME_RANK_FROM1DL(KM,O1D_IN,O1D_OUT)
! ##############################################
diff --git a/src/SURFEX/pack_sso.F90 b/src/SURFEX/pack_sso.F90
new file mode 100644
index 0000000000000000000000000000000000000000..82a1c5b7d4519ecb6a9c45006bf9d3af364ef745
--- /dev/null
+++ b/src/SURFEX/pack_sso.F90
@@ -0,0 +1,90 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE PACK_SSO(USS,HPROGRAM,KMASK,ISS)
+! #########################################
+!
+!!**** *PACK_SSO* - routine to initialise the horizontal grid of a scheme
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2003
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_SSO_n, ONLY : SSO_t
+!
+USE MODI_PACK_SAME_RANK
+!
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+TYPE(SSO_t), INTENT(INOUT) :: USS
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
+INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
+TYPE(SSO_t), INTENT(INOUT) :: ISS
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!---------------------------------------------------------------------------
+!
+!* 1. Reading of type of grid
+! -----------------------
+!
+IF (LHOOK) CALL DR_HOOK('PACK_SSO',0,ZHOOK_HANDLE)
+!
+!* 1. Number of points and packing
+! ----------------------------
+!
+CALL PACK_SAME_RANK(KMASK,USS%XAOSIP(:),ISS%XAOSIP(:))
+CALL PACK_SAME_RANK(KMASK,USS%XAOSIM(:),ISS%XAOSIM(:))
+CALL PACK_SAME_RANK(KMASK,USS%XAOSJP(:),ISS%XAOSJP(:))
+CALL PACK_SAME_RANK(KMASK,USS%XAOSJM(:),ISS%XAOSJM(:))
+!
+CALL PACK_SAME_RANK(KMASK,USS%XHO2IP(:),ISS%XHO2IP(:))
+CALL PACK_SAME_RANK(KMASK,USS%XHO2IM(:),ISS%XHO2IM(:))
+CALL PACK_SAME_RANK(KMASK,USS%XHO2JP(:),ISS%XHO2JP(:))
+CALL PACK_SAME_RANK(KMASK,USS%XHO2JM(:),ISS%XHO2JM(:))
+!
+CALL PACK_SAME_RANK(KMASK,USS%XSSO_STDEV(:),ISS%XSSO_STDEV(:))
+CALL PACK_SAME_RANK(KMASK,USS%XSSO_SLOPE(:),ISS%XSSO_SLOPE(:))
+
+!
+IF (LHOOK) CALL DR_HOOK('PACK_SSO',1,ZHOOK_HANDLE)
+!
+!---------------------------------------------------------------------------
+!
+END SUBROUTINE PACK_SSO
diff --git a/src/SURFEX/param_cls.F90 b/src/SURFEX/param_cls.F90
deleted file mode 100644
index c17d9b35ce32a837c1ab23e68089f16f5b5e6f3e..0000000000000000000000000000000000000000
--- a/src/SURFEX/param_cls.F90
+++ /dev/null
@@ -1,263 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE PARAM_CLS(PTA, PTS, PQA, PPA, PRHOA, PZONA, PMERA, PH, PHW, &
- PSFTH, PSFTQ, PSFZON, PSFMER, &
- PT2M, PQ2M, PHU2M, PZON10M, PMER10M )
-! #####################################################################
-!
-!!**** *PARAMCLS* interpolates wind at 10m and temperature/humidity at 2m
-!!
-!! PURPOSE
-!! -------
-!
-!
-!
-!!** METHOD
-!! ------
-!
-!! EXTERNAL
-!! --------
-!!
-!! none
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!!
-!! Rui Salgado
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!! Original 26/10/98
-!! 06/2003 (V. Masson) use of Paulson functions and
-!! atmospheric level only
-!! 11/2006 (P. LeMoigne) min value for LMO for unstable case
-!! 01/2010 (S. Riette) XUNDEF is sent for wind where forcing
-!! level is below heigt of diagnostic
-!! (no extrapolation, only interpolation)
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_CSTS, ONLY : XKARMAN, XRD, XCPD, XP00, XRV, XG
-!
-USE MODE_SBLS
-USE MODE_THERMOS
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTA ! atmospheric temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS ! surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PQA ! atmospheric specific humidity
-REAL, DIMENSION(:), INTENT(IN) :: PPA ! atmospheric level pressure
-REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! air density
-REAL, DIMENSION(:), INTENT(IN) :: PZONA ! zonal wind
-REAL, DIMENSION(:), INTENT(IN) :: PMERA ! meridian wind
-REAL, DIMENSION(:), INTENT(IN) :: PH ! atmospheric level height
-REAL, DIMENSION(:), INTENT(IN) :: PHW ! atmospheric level height for wind
-REAL, DIMENSION(:), INTENT(IN) :: PSFZON ! zonal friction
-REAL, DIMENSION(:), INTENT(IN) :: PSFMER ! meridian friction
-REAL, DIMENSION(:), INTENT(IN) :: PSFTH ! heat flux (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PSFTQ ! vapor flux (kg/m2/s)
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PT2M ! temperature at 2 meters
-REAL, DIMENSION(:), INTENT(OUT) :: PQ2M ! specific humidity at 2 meters
-REAL, DIMENSION(:), INTENT(OUT) :: PHU2M ! relative humidity at 2 meters
-REAL, DIMENSION(:), INTENT(OUT) :: PZON10M! zonal wind component at 10 meters
-REAL, DIMENSION(:), INTENT(OUT) :: PMER10M! meridian wind component at 10 meters
-!
-!* 0.2 declarations of local variables
-!
-REAL, DIMENSION(SIZE(PTA)) :: ZUSTAR ! friction
-REAL, DIMENSION(SIZE(PTA)) :: ZTH ! potential temperature
-REAL, DIMENSION(SIZE(PTA)) :: ZRV ! H2O mixing ratio
-REAL, DIMENSION(SIZE(PTA)) :: ZLMO ! Monin Obhukov length
-REAL, DIMENSION(SIZE(PTA)) :: ZH_O_LMO ! h/LMO
-REAL, DIMENSION(SIZE(PTA)) :: Z10M_O_LMO ! 10m/LMO
-REAL, DIMENSION(SIZE(PTA)) :: Z2M_O_LMO ! 2m/LMO
-REAL, DIMENSION(SIZE(PTA)) :: ZTSTAR ! Scale of Temperature
-REAL, DIMENSION(SIZE(PTA)) :: ZQSTAR ! Scale of humidity
-REAL, DIMENSION(SIZE(PTA)) :: ZTH2M ! Potential temperature at 2m
-REAL, DIMENSION(SIZE(PTA)) :: ZP2M ! Pressure at 2m
-REAL, DIMENSION(SIZE(PTA)) :: ZQSAT2M ! saturation specific humidity at 2m
-REAL :: Z10M ! 10m
-REAL :: Z2M ! 2m
-REAL, DIMENSION(SIZE(PTA)) :: ZWT ! potential temperature flux (Km/s)
-REAL, DIMENSION(SIZE(PTA)) :: ZWQ ! water vapor flux (kg/kg*m/s)
-REAL, DIMENSION(SIZE(PTA)) :: ZEXN ! Exner function
-REAL :: ZLMOMIN ! Minimum value of ZLMO for unstable cases
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('PARAM_CLS',0,ZHOOK_HANDLE)
-Z10M = 10.
-Z2M = 2.
-!
-!* friction
-!
-ZUSTAR(:) = SQRT(SQRT(PSFZON(:)**2+PSFMER(:)**2))
-!
-!* Exner function
-!
-ZEXN(:) = (PPA(:)/XP00)**(XRD/XCPD)
-!
-!* Potential temperature
-!
-ZTH(:) = PTA(:) / ZEXN(:)
-!
-!* Vapor mixing ratio
-!
-WHERE (PQA(:)/=0.)
- ZRV = 1./(1./PQA(:) - 1.)
-ELSEWHERE
- ZRV = 0.
-END WHERE
-!
-!* Kinematic fluxes
-!
-ZWT(:) = PSFTH(:) / (PRHOA(:) * XCPD / ZEXN(:))
-ZWQ(:) = PSFTQ(:) / PRHOA(:)
-!
-!
-!* Monin Obhukov length
-!
-ZLMO = LMO(ZUSTAR,ZTH,ZRV,ZWT,ZWQ)
-!
-! min value of 1 meter for ZLMO for unstable case
-!
-ZLMOMIN = 1.
-ZLMO = ZLMO * (1.-SIGN(1.,ZLMO))/2. + MAX(ZLMOMIN,ZLMO) * (1.+SIGN(1.,ZLMO))/2.
-!
-!* h/LMO; 10m/LMO; 2m/LMO
-!
-ZH_O_LMO = 0.
-Z10M_O_LMO = 0.
-Z2M_O_LMO = 0.
-!
-WHERE (ZLMO/=XUNDEF)
- Z10M_O_LMO = Z10M/ZLMO
- Z2M_O_LMO = Z2M/ZLMO
-END WHERE
-!
-!-------------------------------------------------------------------------------
-!
-!* use of wind forcing height
-!
-WHERE (ZLMO/=XUNDEF)
- ZH_O_LMO = PHW/ZLMO
-END WHERE
-!
-!* Wind at 10m
-!
-!* note : is set to zero value where the law does not apply correctly
-! (e.g. over high mountains)
-! and is set to XUNDEF when forcing level is below 10m diagnostic level
-PZON10M(:) = XUNDEF
-PMER10M(:) = XUNDEF
-WHERE(PHW(:)>=Z10M)
-WHERE (PSFZON(:)>=0.)
- PZON10M(:) = PZONA(:) - SQRT( PSFZON(:))/XKARMAN *( LOG ( Z10M/PHW) &
- - PAULSON_PSIM(Z10M_O_LMO) &
- + PAULSON_PSIM(ZH_O_LMO) )
- PZON10M(:) = MIN ( 0., PZON10M(:) )
-END WHERE
-!
-WHERE (PSFZON(:)< 0.)
- PZON10M(:) = PZONA(:) + SQRT(-PSFZON(:))/XKARMAN *( LOG ( Z10M/PHW) &
- - PAULSON_PSIM(Z10M_O_LMO) &
- + PAULSON_PSIM(ZH_O_LMO) )
- PZON10M(:) = MAX ( 0., PZON10M(:) )
-END WHERE
-!
-WHERE (PSFMER(:)>=0.)
- PMER10M(:) = PMERA(:) - SQRT( PSFMER(:))/XKARMAN *( LOG ( Z10M/PHW) &
- - PAULSON_PSIM(Z10M_O_LMO) &
- + PAULSON_PSIM(ZH_O_LMO) )
- PMER10M(:) = MIN ( 0., PMER10M(:) )
-END WHERE
-!
-WHERE (PSFMER(:)< 0.)
- PMER10M(:) = PMERA(:) + SQRT(-PSFMER(:))/XKARMAN *( LOG ( Z10M/PHW) &
- - PAULSON_PSIM(Z10M_O_LMO) &
- + PAULSON_PSIM(ZH_O_LMO) )
- PMER10M(:) = MAX ( 0., PMER10M(:) )
-END WHERE
-END WHERE
-!
-!-------------------------------------------------------------------------------
-!
-!* use of temperature forcing height
-!
-WHERE (ZLMO/=XUNDEF)
- ZH_O_LMO = PH/ZLMO
-END WHERE
-!
-!* Temperature scale
-!
-ZTSTAR(:) = - ZWT(:) / MAX(ZUSTAR,0.01)
-!
-!* Potential Temperature at 2m
-!
-ZTH2M(:) = ZTH(:) + 0.74 * ZTSTAR(:)/XKARMAN *( LOG ( Z2M/PH) &
- - PAULSON_PSIH(Z2M_O_LMO) &
- + PAULSON_PSIH(ZH_O_LMO) )
-!
-!* Pressure at 2m
-!
-ZP2M(:) = PPA(:) - XG * PRHOA(:) * (Z2M-PH(:))
-!
-!* Temperature at 2m
-!
-WHERE (ZWT(:) > 0. .OR. PTS(:) == XUNDEF)
- ! Businger formulation in unstable case
- PT2M(:) = ZTH2M(:) * (ZP2M(:)/XP00)**(XRD/XCPD)
-ELSEWHERE
- ! Linear interpolation between Ts and Ta in stable case
- PT2M(:) = PTS(:) + (PTA(:)-PTS(:))*Z2M/PH(:)
-END WHERE
-!
-!-------------------------------------------------------------------------------
-!
-!* Humidity scale
-!
-ZQSTAR(:) = - ZWQ(:) / MAX(ZUSTAR,0.01)
-!
-!* Specific humidity at 2m
-!
-PQ2M(:) = PQA(:) + 0.74 * ZQSTAR(:)/XKARMAN *( LOG ( Z2M/PH) &
- - PAULSON_PSIH(Z2M_O_LMO) &
- + PAULSON_PSIH(ZH_O_LMO) )
-!
-!* must be below saturation
-!
-ZQSAT2M(:) = QSAT(PT2M(:),ZP2M(:))
-PQ2M(:) = MIN (ZQSAT2M(:),PQ2M(:))
-!
-PHU2M(:) = PQ2M(:) / ZQSAT2M(:)
-IF (LHOOK) CALL DR_HOOK('PARAM_CLS',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE PARAM_CLS
diff --git a/src/SURFEX/permafrost_depth.F90 b/src/SURFEX/permafrost_depth.F90
index 2e2656d37fc93736e6d30fbd61d087c73e53c651..c0fb95b068fa0c22a0eb4892e8a1a5f0c42af6e1 100644
--- a/src/SURFEX/permafrost_depth.F90
+++ b/src/SURFEX/permafrost_depth.F90
@@ -2,8 +2,125 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
+MODULE MODI_PERMAFROST_DEPTH
+!
+INTERFACE PERMAFROST_DEPTH
+!
+SUBROUTINE PERMAFROST_DEPTH_1D (KNI,KPATCH,PPERM,PSOILDEPTH)
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN ) :: KNI ! number of point
+!
+INTEGER, INTENT(IN ) :: KPATCH ! patch number
+!
+REAL, DIMENSION(:), INTENT(IN ) :: PPERM ! permafrost area (fraction)
+!
+REAL, DIMENSION(:),INTENT(INOUT) :: PSOILDEPTH ! output soil depth distribution (m)
+!
+END SUBROUTINE PERMAFROST_DEPTH_1D
+!
+SUBROUTINE PERMAFROST_DEPTH_2D (KNI,KPATCH,PPERM,PSOILDEPTH)
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN ) :: KNI ! number of point
+!
+INTEGER, INTENT(IN ) :: KPATCH ! patch number
+!
+REAL, DIMENSION(:), INTENT(IN ) :: PPERM ! permafrost area (fraction)
+!
+REAL, DIMENSION(:,:),INTENT(INOUT) :: PSOILDEPTH ! output soil depth distribution (m)
+!
+END SUBROUTINE PERMAFROST_DEPTH_2D
+!
+END INTERFACE PERMAFROST_DEPTH
+!
+END MODULE MODI_PERMAFROST_DEPTH
+!
+! #########################
+SUBROUTINE PERMAFROST_DEPTH_1D (KNI,KPATCH,PPERM,PSOILDEPTH)
+! ###################################################
+!
+!!**** *PERMAFROST_DEPTH*
+!!
+!! PURPOSE
+!! -------
+!
+! Extended ground depth to 12m over permafrost area
+!
+!!** METHOD
+!! ------
+!
+! Direct calculation
+!
+!! EXTERNAL
+!! --------
+!
+! None
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! B. Decharme
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 30/08/12
+!-------------------------------------------------------------------------------
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_ISBA_PAR, ONLY : XPERMFRAC, XPERMDEPTH
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+!* 0.1 declarations of arguments
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN ) :: KNI ! number of point
+!
+INTEGER, INTENT(IN ) :: KPATCH ! patch number
+!
+REAL, DIMENSION(:), INTENT(IN ) :: PPERM ! permafrost area (fraction)
+!
+REAL, DIMENSION(:),INTENT(INOUT) :: PSOILDEPTH ! output soil depth distribution (m)
+!
+!* 0.2 declarations of local variables
+!
+REAL, DIMENSION(KNI) :: ZPERM
+!
+INTEGER :: JJ, JPATCH
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('PERMAFROST_DEPTH_1D',0,ZHOOK_HANDLE)
+!
+ZPERM(:)=0.0
+WHERE(PPERM(:)/=XUNDEF)ZPERM(:)=PPERM(:)
+!
+DO JJ=1,KNI
+ IF(ZPERM(JJ)>=XPERMFRAC.AND.PSOILDEPTH(JJ)/=XUNDEF)THEN
+ PSOILDEPTH(JJ)=MAX(PSOILDEPTH(JJ),XPERMDEPTH)
+ ENDIF
+ENDDO
+
+!
+IF (LHOOK) CALL DR_HOOK('PERMAFROST_DEPTH_1D',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE PERMAFROST_DEPTH_1D
+!
! #########################
-SUBROUTINE PERMAFROST_DEPTH (KNI,KPATCH,PPERM,PSOILDEPTH)
+SUBROUTINE PERMAFROST_DEPTH_2D (KNI,KPATCH,PPERM,PSOILDEPTH)
! ###################################################
!
!!**** *PERMAFROST_DEPTH*
@@ -67,7 +184,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
-IF (LHOOK) CALL DR_HOOK('PERMAFROST_DEPTH',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('PERMAFROST_DEPTH_2D',0,ZHOOK_HANDLE)
!
ZPERM(:)=0.0
WHERE(PPERM(:)/=XUNDEF)ZPERM(:)=PPERM(:)
@@ -81,9 +198,9 @@ DO JPATCH=1,KPATCH
ENDDO
!
-IF (LHOOK) CALL DR_HOOK('PERMAFROST_DEPTH',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('PERMAFROST_DEPTH_2D',1,ZHOOK_HANDLE)
!
-END SUBROUTINE PERMAFROST_DEPTH
+END SUBROUTINE PERMAFROST_DEPTH_2D
diff --git a/src/SURFEX/pgd_bathyfield.F90 b/src/SURFEX/pgd_bathyfield.F90
index 86f8c40996c1860ea6c1e611f56c26e22389a819..61875ea32dac73313e10b36f7b6abce8746d71e6 100644
--- a/src/SURFEX/pgd_bathyfield.F90
+++ b/src/SURFEX/pgd_bathyfield.F90
@@ -42,14 +42,14 @@
! -----------
!
!
-!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_PGD_GRID, ONLY : NL
-USE MODD_PGDWORK, ONLY : XSUMVAL, NSIZE
+USE MODD_PGDWORK, ONLY : XALL, NSIZE_ALL, NSIZE, XSUMVAL
!
USE MODI_GET_LUOUT
USE MODI_TREAT_BATHYFIELD
@@ -68,7 +68,7 @@ IMPLICIT NONE
!
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
CHARACTER(LEN=*), INTENT(IN) :: HFIELD ! field name for prints
@@ -100,7 +100,6 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ---------------
!
IF (LHOOK) CALL DR_HOOK('PGD_BATHYFIELD',0,ZHOOK_HANDLE)
-PFIELD(:) = XUNDEF
!-------------------------------------------------------------------------------
!
!* 2. Output listing logical unit
@@ -120,15 +119,17 @@ IF (LEN_TRIM(HFILE)/=0) THEN
!* 3. Averages the field
! ------------------
!
- ALLOCATE(NSIZE (NL))
- ALLOCATE(XSUMVAL (NL))
+ ALLOCATE(NSIZE_ALL (U%NDIM_FULL,1))
+ ALLOCATE(XALL (U%NDIM_FULL,1,1))
!
- NSIZE (:) = 0.
- XSUMVAL (:) = 0.
+ NSIZE_ALL(:,:) = 0
+ XALL (:,:,:) = 0.
!
YFIELD = ' '
YFIELD = HFIELD(1:MIN(LEN(HFIELD),20))
!
+ PFIELD(:) = XUNDEF
+
CALL TREAT_BATHYFIELD(UG, U, USS, &
HPROGRAM,'SURF ',HFILETYPE,'A_MESH',HFILE, HNCVARNAME,&
YFIELD,PFIELD,HAREA )
@@ -140,15 +141,15 @@ IF (LEN_TRIM(HFILE)/=0) THEN
!
SELECT CASE (HAREA)
CASE ('LAN')
- WHERE (U%XTOWN(:)+U%XNATURE(:)==0. .AND. NSIZE(:)==0 ) NSIZE(:) = -1
+ WHERE (U%XTOWN(:)+U%XNATURE(:)==0. .AND. NSIZE(:,1)==0 ) NSIZE(:,1) = -1
CASE ('TWN')
- WHERE (U%XTOWN (:)==0. .AND. NSIZE(:)==0 ) NSIZE(:) = -1
+ WHERE (U%XTOWN (:)==0. .AND. NSIZE(:,1)==0 ) NSIZE(:,1) = -1
CASE ('NAT')
- WHERE (U%XNATURE(:)==0. .AND. NSIZE(:)==0 ) NSIZE(:) = -1
+ WHERE (U%XNATURE(:)==0. .AND. NSIZE(:,1)==0 ) NSIZE(:,1) = -1
CASE ('SEA')
- WHERE (U%XSEA (:)==0. .AND. NSIZE(:)==0 ) NSIZE(:) = -1
+ WHERE (U%XSEA (:)==0. .AND. NSIZE(:,1)==0 ) NSIZE(:,1) = -1
CASE ('WAT')
- WHERE (U%XWATER (:)==0. .AND. NSIZE(:)==0 ) NSIZE(:) = -1
+ WHERE (U%XWATER (:)==0. .AND. NSIZE(:,1)==0 ) NSIZE(:,1) = -1
END SELECT
!
@@ -158,7 +159,7 @@ IF (LEN_TRIM(HFILE)/=0) THEN
! ------------------------------------------------
!
CALL INTERPOL_FIELD(UG, U, &
- HPROGRAM,ILUOUT,NSIZE,PFIELD(:),HFIELD)
+ HPROGRAM,ILUOUT,NSIZE(:,1),PFIELD(:),HFIELD)
!
DO JLOOP=1,SIZE(PFIELD)
PFIELD(JLOOP)=MIN(PFIELD(JLOOP),-1.)
diff --git a/src/SURFEX/pgd_bem_par.F90 b/src/SURFEX/pgd_bem_par.F90
index 54197ac34c60aa022c783cfbf29392d1dd737abb..8b03c3100e96ba1bdad383da0b4f7d028ad6af7f 100644
--- a/src/SURFEX/pgd_bem_par.F90
+++ b/src/SURFEX/pgd_bem_par.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ##########################################
- SUBROUTINE PGD_BEM_PAR (DTCO, DGU, UG, U, USS, DTB, DTI, TG, &
+ SUBROUTINE PGD_BEM_PAR (DTCO, UG, U, USS, DTB, KDIM, &
HPROGRAM,OAUTOSIZE)
! ##########################################
!
@@ -44,13 +44,10 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
USE MODD_DATA_BEM_n, ONLY : DATA_BEM_t
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
@@ -74,13 +71,12 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
TYPE(DATA_BEM_t), INTENT(INOUT) :: DTB
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
+!
+INTEGER, INTENT(IN) :: KDIM
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
LOGICAL, INTENT(IN) :: OAUTOSIZE ! T for automatic determination
@@ -203,7 +199,7 @@ REAL :: XUNIF_T_SIZE_MIN !
CHARACTER(LEN=6) :: CFTYP_T_SIZE_MAX !
CHARACTER(LEN=6) :: CFTYP_T_SIZE_MIN !
!
-REAL, DIMENSION(TG%NDIM) :: ZWORK
+REAL, DIMENSION(KDIM) :: ZWORK
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
NAMELIST/NAM_DATA_BEM/ NPAR_FLOOR_LAYER, &
@@ -281,63 +277,63 @@ XUNIF_COP_RAT = XUNDEF
XUNIF_T_SIZE_MAX = XUNDEF
XUNIF_T_SIZE_MIN = XUNDEF
!
- CFNAM_SHADE = ' '
- CFNAM_NATVENT = ' '
- CFNAM_HC_FLOOR (:) = ' '
- CFNAM_TC_FLOOR (:) = ' '
- CFNAM_D_FLOOR (:) = ' '
- CFNAM_TCOOL_TARGET = ' '
- CFNAM_THEAT_TARGET = ' '
- CFNAM_F_WASTE_CAN = ' '
- CFNAM_EFF_HEAT = ' '
- CFNAM_QIN = ' '
- CFNAM_QIN_FRAD = ' '
- CFNAM_SHGC = ' '
- CFNAM_U_WIN = ' '
- CFNAM_GR = ' '
- CFNAM_SHGC_SH = ' '
- CFNAM_FLOOR_HEIGHT = ' '
- CFNAM_INF = ' '
- CFNAM_F_WATER_COND = ' '
- CFNAM_QIN_FLAT = ' '
- CFNAM_HR_TARGET = ' '
- CFNAM_V_VENT = ' '
- CFNAM_CAP_SYS_HEAT = ' '
- CFNAM_CAP_SYS_RAT = ' '
- CFNAM_T_ADP = ' '
- CFNAM_M_SYS_RAT = ' '
- CFNAM_COP_RAT = ' '
- CFNAM_T_SIZE_MAX = ' '
- CFNAM_T_SIZE_MIN = ' '
-!
- CFTYP_SHADE = ' '
- CFTYP_NATVENT = ' '
- CFTYP_HC_FLOOR(:) = ' '
- CFTYP_TC_FLOOR(:) = ' '
- CFTYP_D_FLOOR(:) = ' '
- CFTYP_TCOOL_TARGET = ' '
- CFTYP_THEAT_TARGET = ' '
- CFTYP_F_WASTE_CAN = ' '
- CFTYP_EFF_HEAT = ' '
- CFTYP_QIN = ' '
- CFTYP_QIN_FRAD = ' '
- CFTYP_SHGC = ' '
- CFTYP_U_WIN = ' '
- CFTYP_GR = ' '
- CFTYP_SHGC_SH = ' '
- CFTYP_FLOOR_HEIGHT = ' '
- CFTYP_INF = ' '
- CFTYP_F_WATER_COND = ' '
- CFTYP_QIN_FLAT = ' '
- CFTYP_HR_TARGET = ' '
- CFTYP_V_VENT = ' '
- CFTYP_CAP_SYS_HEAT = ' '
- CFTYP_CAP_SYS_RAT = ' '
- CFTYP_T_ADP = ' '
- CFTYP_M_SYS_RAT = ' '
- CFTYP_COP_RAT = ' '
- CFTYP_T_SIZE_MAX = ' '
- CFTYP_T_SIZE_MIN = ' '
+CFNAM_SHADE = ' '
+CFNAM_NATVENT = ' '
+CFNAM_HC_FLOOR (:) = ' '
+CFNAM_TC_FLOOR (:) = ' '
+CFNAM_D_FLOOR (:) = ' '
+CFNAM_TCOOL_TARGET = ' '
+CFNAM_THEAT_TARGET = ' '
+CFNAM_F_WASTE_CAN = ' '
+CFNAM_EFF_HEAT = ' '
+CFNAM_QIN = ' '
+CFNAM_QIN_FRAD = ' '
+CFNAM_SHGC = ' '
+CFNAM_U_WIN = ' '
+CFNAM_GR = ' '
+CFNAM_SHGC_SH = ' '
+CFNAM_FLOOR_HEIGHT = ' '
+CFNAM_INF = ' '
+CFNAM_F_WATER_COND = ' '
+CFNAM_QIN_FLAT = ' '
+CFNAM_HR_TARGET = ' '
+CFNAM_V_VENT = ' '
+CFNAM_CAP_SYS_HEAT = ' '
+CFNAM_CAP_SYS_RAT = ' '
+CFNAM_T_ADP = ' '
+CFNAM_M_SYS_RAT = ' '
+CFNAM_COP_RAT = ' '
+CFNAM_T_SIZE_MAX = ' '
+CFNAM_T_SIZE_MIN = ' '
+!
+CFTYP_SHADE = ' '
+CFTYP_NATVENT = ' '
+CFTYP_HC_FLOOR(:) = ' '
+CFTYP_TC_FLOOR(:) = ' '
+CFTYP_D_FLOOR(:) = ' '
+CFTYP_TCOOL_TARGET = ' '
+CFTYP_THEAT_TARGET = ' '
+CFTYP_F_WASTE_CAN = ' '
+CFTYP_EFF_HEAT = ' '
+CFTYP_QIN = ' '
+CFTYP_QIN_FRAD = ' '
+CFTYP_SHGC = ' '
+CFTYP_U_WIN = ' '
+CFTYP_GR = ' '
+CFTYP_SHGC_SH = ' '
+CFTYP_FLOOR_HEIGHT = ' '
+CFTYP_INF = ' '
+CFTYP_F_WATER_COND = ' '
+CFTYP_QIN_FLAT = ' '
+CFTYP_HR_TARGET = ' '
+CFTYP_V_VENT = ' '
+CFTYP_CAP_SYS_HEAT = ' '
+CFTYP_CAP_SYS_RAT = ' '
+CFTYP_T_ADP = ' '
+CFTYP_M_SYS_RAT = ' '
+CFTYP_COP_RAT = ' '
+CFTYP_T_SIZE_MAX = ' '
+CFTYP_T_SIZE_MIN = ' '
!
!-------------------------------------------------------------------------------
!
@@ -368,40 +364,6 @@ IF (( ANY(XUNIF_HC_FLOOR/=XUNDEF) .OR. ANY(LEN_TRIM(CFNAM_HC_FLOOR)>0) &
END IF
!
!-------------------------------------------------------------------------------
-!
-ALLOCATE(DTB%XPAR_HC_FLOOR (TG%NDIM,NPAR_FLOOR_LAYER))
-ALLOCATE(DTB%XPAR_TC_FLOOR (TG%NDIM,NPAR_FLOOR_LAYER))
-ALLOCATE(DTB%XPAR_D_FLOOR (TG%NDIM,NPAR_FLOOR_LAYER))
-!
-ALLOCATE(DTB%XPAR_TCOOL_TARGET (TG%NDIM))
-ALLOCATE(DTB%XPAR_THEAT_TARGET (TG%NDIM))
-ALLOCATE(DTB%XPAR_F_WASTE_CAN (TG%NDIM))
-ALLOCATE(DTB%XPAR_EFF_HEAT (TG%NDIM))
-ALLOCATE(DTB%XPAR_QIN (TG%NDIM))
-ALLOCATE(DTB%XPAR_QIN_FRAD (TG%NDIM))
-ALLOCATE(DTB%XPAR_SHGC (TG%NDIM))
-ALLOCATE(DTB%XPAR_U_WIN (TG%NDIM))
-ALLOCATE(DTB%XPAR_GR (TG%NDIM))
-ALLOCATE(DTB%XPAR_SHGC_SH (TG%NDIM))
-ALLOCATE(DTB%XPAR_FLOOR_HEIGHT (TG%NDIM))
-ALLOCATE(DTB%XPAR_INF (TG%NDIM))
-!
-ALLOCATE(DTB%XPAR_F_WATER_COND (TG%NDIM))
-ALLOCATE(DTB%XPAR_QIN_FLAT (TG%NDIM))
-ALLOCATE(DTB%XPAR_HR_TARGET (TG%NDIM))
-ALLOCATE(DTB%XPAR_V_VENT (TG%NDIM))
-ALLOCATE(DTB%XPAR_CAP_SYS_HEAT (TG%NDIM))
-ALLOCATE(DTB%XPAR_CAP_SYS_RAT (TG%NDIM))
-ALLOCATE(DTB%XPAR_T_ADP (TG%NDIM))
-ALLOCATE(DTB%XPAR_M_SYS_RAT (TG%NDIM))
-ALLOCATE(DTB%XPAR_COP_RAT (TG%NDIM))
-ALLOCATE(DTB%XPAR_T_SIZE_MAX (TG%NDIM))
-ALLOCATE(DTB%XPAR_T_SIZE_MIN (TG%NDIM))
-!
-ALLOCATE(DTB%XPAR_SHADE (TG%NDIM))
-ALLOCATE(DTB%XPAR_NATVENT (TG%NDIM))
-!
-!-------------------------------------------------------------------------------
IF (NFLOOR_MAX < NPAR_FLOOR_LAYER) THEN
WRITE(ILUOUT,*) '---------------------------------------------'
WRITE(ILUOUT,*) 'Please update pgd_bem_par.F90 routine : '
@@ -417,128 +379,155 @@ END IF
! ----------------------------------
!
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_SHADE (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'MAJ','SHADE ','TWN', CFNAM_SHADE, CFTYP_SHADE, XUNIF_SHADE, &
DTB%XPAR_SHADE, DTB%LDATA_SHADE )
IF (.NOT.DTB%LDATA_SHADE) DEALLOCATE(DTB%XPAR_SHADE)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_NATVENT (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'MAJ','NATVENT ','TWN', CFNAM_NATVENT, CFTYP_NATVENT, XUNIF_NATVENT, &
DTB%XPAR_NATVENT, DTB%LDATA_NATVENT )
IF (.NOT.DTB%LDATA_NATVENT) DEALLOCATE(DTB%XPAR_NATVENT)
!
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
+ALLOCATE(DTB%XPAR_HC_FLOOR (KDIM,NPAR_FLOOR_LAYER))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, &
HPROGRAM,'INV','HC_FLOOR ','TWN',CFNAM_HC_FLOOR,CFTYP_HC_FLOOR, &
XUNIF_HC_FLOOR,DTB%XPAR_HC_FLOOR,DTB%LDATA_HC_FLOOR )
IF (.NOT.DTB%LDATA_HC_FLOOR) DEALLOCATE(DTB%XPAR_HC_FLOOR)
!
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
+ALLOCATE(DTB%XPAR_TC_FLOOR (KDIM,NPAR_FLOOR_LAYER))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, &
HPROGRAM,'ARI','TC_FLOOR ','TWN',CFNAM_TC_FLOOR,CFTYP_TC_FLOOR, &
XUNIF_TC_FLOOR ,DTB%XPAR_TC_FLOOR, DTB%LDATA_TC_FLOOR )
IF (.NOT.DTB%LDATA_TC_FLOOR) DEALLOCATE(DTB%XPAR_TC_FLOOR)
!
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
+ALLOCATE(DTB%XPAR_D_FLOOR (KDIM,NPAR_FLOOR_LAYER))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, &
HPROGRAM,'ARI','D_FLOOR ','TWN',CFNAM_D_FLOOR,CFTYP_D_FLOOR, &
XUNIF_D_FLOOR ,DTB%XPAR_D_FLOOR , DTB%LDATA_D_FLOOR )
IF (.NOT.DTB%LDATA_D_FLOOR) DEALLOCATE(DTB%XPAR_D_FLOOR)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+!-------------------------------------------------------------------------------
+!
+ALLOCATE(DTB%XPAR_TCOOL_TARGET (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','TCOOL_TARGET','TWN',CFNAM_TCOOL_TARGET, CFTYP_TCOOL_TARGET, XUNIF_TCOOL_TARGET, &
DTB%XPAR_TCOOL_TARGET, DTB%LDATA_TCOOL_TARGET)
IF (.NOT.DTB%LDATA_TCOOL_TARGET) DEALLOCATE(DTB%XPAR_TCOOL_TARGET)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_THEAT_TARGET (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','THEAT_TARGET','TWN',CFNAM_THEAT_TARGET, CFTYP_THEAT_TARGET, XUNIF_THEAT_TARGET, &
DTB%XPAR_THEAT_TARGET, DTB%LDATA_THEAT_TARGET)
IF (.NOT.DTB%LDATA_THEAT_TARGET) DEALLOCATE(DTB%XPAR_THEAT_TARGET)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_F_WASTE_CAN (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','F_WASTE_CAN','TWN',CFNAM_F_WASTE_CAN, CFTYP_F_WASTE_CAN, XUNIF_F_WASTE_CAN, &
DTB%XPAR_F_WASTE_CAN, DTB%LDATA_F_WASTE_CAN)
IF (.NOT.DTB%LDATA_F_WASTE_CAN) DEALLOCATE(DTB%XPAR_F_WASTE_CAN)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_EFF_HEAT (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','EFF_HEAT','TWN',CFNAM_EFF_HEAT, CFTYP_EFF_HEAT, XUNIF_EFF_HEAT, &
DTB%XPAR_EFF_HEAT, DTB%LDATA_EFF_HEAT)
IF (.NOT.DTB%LDATA_EFF_HEAT) DEALLOCATE(DTB%XPAR_EFF_HEAT)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_QIN (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','QIN','TWN',CFNAM_QIN, CFTYP_QIN, XUNIF_QIN, DTB%XPAR_QIN, DTB%LDATA_QIN)
IF (.NOT.DTB%LDATA_QIN) DEALLOCATE(DTB%XPAR_QIN)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_QIN_FRAD (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','QIN_FRAD','TWN',CFNAM_QIN_FRAD, CFTYP_QIN_FRAD, XUNIF_QIN_FRAD, &
DTB%XPAR_QIN_FRAD, DTB%LDATA_QIN_FRAD)
IF (.NOT.DTB%LDATA_QIN_FRAD) DEALLOCATE(DTB%XPAR_QIN_FRAD)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_SHGC (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','SHGC','TWN',CFNAM_SHGC, CFTYP_SHGC, XUNIF_SHGC, DTB%XPAR_SHGC, DTB%LDATA_SHGC)
IF (.NOT.DTB%LDATA_SHGC) DEALLOCATE(DTB%XPAR_SHGC)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_U_WIN (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','U_WIN','TWN',CFNAM_U_WIN, CFTYP_U_WIN, XUNIF_U_WIN, DTB%XPAR_U_WIN, DTB%LDATA_U_WIN)
IF (.NOT.DTB%LDATA_U_WIN) DEALLOCATE(DTB%XPAR_U_WIN)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_GR (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','GR','TWN',CFNAM_GR, CFTYP_GR, XUNIF_GR, DTB%XPAR_GR, DTB%LDATA_GR)
IF (.NOT.DTB%LDATA_GR) DEALLOCATE(DTB%XPAR_GR)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_SHGC_SH (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','SHGC_SH','TWN',CFNAM_SHGC_SH, CFTYP_SHGC_SH, XUNIF_SHGC_SH, &
DTB%XPAR_SHGC_SH, DTB%LDATA_SHGC_SH)
IF (.NOT.DTB%LDATA_SHGC_SH) DEALLOCATE(DTB%XPAR_SHGC_SH)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_FLOOR_HEIGHT (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','FLOOR_HEIGHT','TWN',CFNAM_FLOOR_HEIGHT, CFTYP_FLOOR_HEIGHT, XUNIF_FLOOR_HEIGHT, &
DTB%XPAR_FLOOR_HEIGHT, DTB%LDATA_FLOOR_HEIGHT)
IF (.NOT.DTB%LDATA_FLOOR_HEIGHT) DEALLOCATE(DTB%XPAR_FLOOR_HEIGHT)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_INF (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','INF','TWN',CFNAM_INF, CFTYP_INF, XUNIF_INF, DTB%XPAR_INF, DTB%LDATA_INF)
IF (.NOT.DTB%LDATA_INF) DEALLOCATE(DTB%XPAR_INF)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_F_WATER_COND (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','F_WATER_COND','TWN',CFNAM_F_WATER_COND, CFTYP_F_WATER_COND, XUNIF_F_WATER_COND, &
DTB%XPAR_F_WATER_COND, DTB%LDATA_F_WATER_COND)
IF (.NOT.DTB%LDATA_F_WATER_COND) DEALLOCATE(DTB%XPAR_F_WATER_COND)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_QIN_FLAT (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','QIN_FLAT','TWN',CFNAM_QIN_FLAT, CFTYP_QIN_FLAT, XUNIF_QIN_FLAT, &
DTB%XPAR_QIN_FLAT, DTB%LDATA_QIN_FLAT)
IF (.NOT.DTB%LDATA_QIN_FLAT) DEALLOCATE(DTB%XPAR_QIN_FLAT)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_HR_TARGET (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','HR_TARGET','TWN',CFNAM_HR_TARGET, CFTYP_HR_TARGET, XUNIF_HR_TARGET, &
DTB%XPAR_HR_TARGET, DTB%LDATA_HR_TARGET)
IF (.NOT.DTB%LDATA_HR_TARGET) DEALLOCATE(DTB%XPAR_HR_TARGET)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_V_VENT (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','V_VENT','TWN',CFNAM_V_VENT, CFTYP_V_VENT, &
XUNIF_V_VENT, DTB%XPAR_V_VENT, DTB%LDATA_V_VENT)
IF (.NOT.DTB%LDATA_V_VENT) DEALLOCATE(DTB%XPAR_V_VENT)
!
-!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_T_SIZE_MAX (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','T_SIZE_MAX','TWN',CFNAM_T_SIZE_MAX, CFTYP_T_SIZE_MAX, XUNIF_T_SIZE_MAX, &
DTB%XPAR_T_SIZE_MAX, DTB%LDATA_T_SIZE_MAX)
IF (.NOT.DTB%LDATA_T_SIZE_MAX) DEALLOCATE(DTB%XPAR_T_SIZE_MAX)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_T_SIZE_MIN (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','T_SIZE_MIN','TWN',CFNAM_T_SIZE_MIN, CFTYP_T_SIZE_MIN, XUNIF_T_SIZE_MIN, &
DTB%XPAR_T_SIZE_MIN, DTB%LDATA_T_SIZE_MIN)
IF (.NOT.DTB%LDATA_T_SIZE_MIN) DEALLOCATE(DTB%XPAR_T_SIZE_MIN)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_CAP_SYS_HEAT (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','CAP_SYS_HEAT','TWN',CFNAM_CAP_SYS_HEAT, CFTYP_CAP_SYS_HEAT, XUNIF_CAP_SYS_HEAT, &
DTB%XPAR_CAP_SYS_HEAT, DTB%LDATA_CAP_SYS_HEAT)
IF (.NOT.DTB%LDATA_CAP_SYS_HEAT) DEALLOCATE(DTB%XPAR_CAP_SYS_HEAT)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_CAP_SYS_RAT (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','CAP_SYS_RAT','TWN',CFNAM_CAP_SYS_RAT, CFTYP_CAP_SYS_RAT, XUNIF_CAP_SYS_RAT, &
DTB%XPAR_CAP_SYS_RAT, DTB%LDATA_CAP_SYS_RAT)
IF (.NOT.DTB%LDATA_CAP_SYS_RAT) DEALLOCATE(DTB%XPAR_CAP_SYS_RAT)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_M_SYS_RAT (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','M_SYS_RAT','TWN',CFNAM_M_SYS_RAT, CFTYP_M_SYS_RAT, XUNIF_M_SYS_RAT, &
DTB%XPAR_M_SYS_RAT, DTB%LDATA_M_SYS_RAT)
IF (.NOT.DTB%LDATA_M_SYS_RAT) DEALLOCATE(DTB%XPAR_M_SYS_RAT)
@@ -582,11 +571,13 @@ ELSE
DTB%LDATA_T_SIZE_MIN = .FALSE.
END IF
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_T_ADP (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','T_ADP','TWN',CFNAM_T_ADP, CFTYP_T_ADP, XUNIF_T_ADP, DTB%XPAR_T_ADP, DTB%LDATA_T_ADP)
IF (.NOT.DTB%LDATA_T_ADP) DEALLOCATE(DTB%XPAR_T_ADP)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTB%XPAR_COP_RAT (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','COP_RAT','TWN',CFNAM_COP_RAT, CFTYP_COP_RAT, XUNIF_COP_RAT, &
DTB%XPAR_COP_RAT, DTB%LDATA_COP_RAT)
IF (.NOT.DTB%LDATA_COP_RAT) DEALLOCATE(DTB%XPAR_COP_RAT)
@@ -600,7 +591,7 @@ IF (.NOT.DTB%LDATA_COP_RAT) DEALLOCATE(DTB%XPAR_COP_RAT)
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('PGD_BEM_PAR',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
SUBROUTINE COHERENCE_THERMAL_DATA_FL(HTYPE,ODATA_HC,ODATA_TC,ODATA_D)
CHARACTER(LEN=5), INTENT(IN) :: HTYPE
LOGICAL, INTENT(IN) :: ODATA_HC
diff --git a/src/SURFEX/pgd_chemistry.F90 b/src/SURFEX/pgd_chemistry.F90
index 4bd8051b887391af172a471b031764fbe0a0f57f..7d8e7e24691ae76435f234c37248a87f66820252 100644
--- a/src/SURFEX/pgd_chemistry.F90
+++ b/src/SURFEX/pgd_chemistry.F90
@@ -49,7 +49,7 @@ USE MODD_CH_EMIS_FIELD_n, ONLY : CH_EMIS_FIELD_t
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_PGD_GRID, ONLY : NL
USE MODD_PGDWORK, ONLY : CATYPE
@@ -83,7 +83,7 @@ TYPE(CH_EMIS_FIELD_t), INTENT(INOUT) :: CHE
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
LOGICAL, INTENT(OUT) :: OCH_EMIS ! emission flag
@@ -126,13 +126,13 @@ NAMELIST/NAM_CH_EMIS_PGD/ NEMIS_PGD_NBR,CEMIS_PGD_NAME,NEMIS_PGD_TIME,&
!
IF (LHOOK) CALL DR_HOOK('PGD_CHEMISTRY',0,ZHOOK_HANDLE)
NEMIS_PGD_NBR = 0
- CEMIS_PGD_NAME(:) = ' '
+CEMIS_PGD_NAME(:) = ' '
NEMIS_PGD_TIME(:) = 0
- CEMIS_PGD_COMMENT(:) = ''
- CEMIS_PGD_AREA(:) = 'ALL'
- CEMIS_PGD_FILETYPE(:)= 'DIRECT'
- CEMIS_PGD_FILE(:) = ' '
- CEMIS_PGD_ATYPE(:) = 'ARI'
+CEMIS_PGD_COMMENT(:) = ''
+CEMIS_PGD_AREA(:) = 'ALL'
+CEMIS_PGD_FILETYPE(:)= 'DIRECT'
+CEMIS_PGD_FILE(:) = ' '
+CEMIS_PGD_ATYPE(:) = 'ARI'
!
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
@@ -154,8 +154,8 @@ IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CH_EMIS_PGD)
!* 3. Allocation
! ----------
!
- CHE%NEMISPEC_NBR = -999 ! will be counted in writesurf_ch_emisn.f90
- CHE%NEMIS_NBR = NEMIS_PGD_NBR
+CHE%NEMISPEC_NBR = -999 ! will be counted in writesurf_ch_emisn.f90
+CHE%NEMIS_NBR = NEMIS_PGD_NBR
!
CALL GET_SURF_SIZE_n(DTCO, U, &
'LAND', IL_LAND)
@@ -171,12 +171,12 @@ ALLOCATE(CHE%CEMIS_COMMENT(CHE%NEMIS_NBR))
ALLOCATE(CHE%CEMIS_NAME (CHE%NEMIS_NBR))
ALLOCATE(CHE%NEMIS_TIME (CHE%NEMIS_NBR))
!
- CHE%CEMIS_AREA (:) = CEMIS_PGD_AREA (1:CHE%NEMIS_NBR)
- CHE%CEMIS_NAME (:) = CEMIS_PGD_NAME (1:CHE%NEMIS_NBR)
- CHE%NEMIS_TIME (:) = NEMIS_PGD_TIME (1:CHE%NEMIS_NBR)
- CHE%CEMIS_COMMENT(:) = CEMIS_PGD_COMMENT(1:CHE%NEMIS_NBR)
+CHE%CEMIS_AREA (:) = CEMIS_PGD_AREA (1:CHE%NEMIS_NBR)
+CHE%CEMIS_NAME (:) = CEMIS_PGD_NAME (1:CHE%NEMIS_NBR)
+CHE%NEMIS_TIME (:) = NEMIS_PGD_TIME (1:CHE%NEMIS_NBR)
+CHE%CEMIS_COMMENT(:) = CEMIS_PGD_COMMENT(1:CHE%NEMIS_NBR)
!
- CHE%NTIME_MAX = MAXVAL(CHE%NEMIS_TIME)
+CHE%NTIME_MAX = MAXVAL(CHE%NEMIS_TIME)
!
!-------------------------------------------------------------------------------
OCH_EMIS = CHE%NEMIS_NBR > 0
diff --git a/src/SURFEX/pgd_chemistry_snap.F90 b/src/SURFEX/pgd_chemistry_snap.F90
index 2fed8c2002d5fef13c2fb94697b60a76beb8b9d9..79ff5de72d6b2f7852c60671a6066fc7a927ad63 100644
--- a/src/SURFEX/pgd_chemistry_snap.F90
+++ b/src/SURFEX/pgd_chemistry_snap.F90
@@ -47,7 +47,7 @@ USE MODD_CH_SNAP_n, ONLY : CH_EMIS_SNAP_t
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_PGDWORK, ONLY : CATYPE
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -78,7 +78,7 @@ TYPE(CH_EMIS_SNAP_t), INTENT(INOUT) :: CHN
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
LOGICAL, INTENT(OUT) :: OCH_EMIS ! emission flag
@@ -133,22 +133,22 @@ NAMELIST/NAM_CH_SNAP_EMIS_PGD/ NEMIS_NBR, NEMIS_SNAP, CEMIS_NAME,&
!
IF (LHOOK) CALL DR_HOOK('PGD_CHEMISTRY_SNAP',0,ZHOOK_HANDLE)
NEMIS_NBR = 0
- CEMIS_NAME(:) = ' '
- CEMIS_COMMENT(:) = ''
+CEMIS_NAME(:) = ' '
+CEMIS_COMMENT(:) = ''
!
NEMIS_SNAP = 0
- CHN%NSNAP_M = 12
- CHN%NSNAP_D = 7
- CHN%NSNAP_H = 24
+CHN%NSNAP_M = 12
+CHN%NSNAP_D = 7
+CHN%NSNAP_H = 24
XUNIF_SNAP = XUNDEF
XUNIF_DELTA_LEGAL_TIME = XUNDEF
- CSNAP_MONTHLY_FILE(:) = ' '
- CSNAP_DAILY_FILE(:) = ' '
- CSNAP_HOURLY_FILE(:) = ' '
- CSNAP_POTENTIAL_FILETYPE(:)= ' '
- CSNAP_POTENTIAL_FILE(:,:) = ' '
- CDELTA_LEGAL_TIME_FILETYPE = ' '
- CDELTA_LEGAL_TIME_FILE = ' '
+CSNAP_MONTHLY_FILE(:) = ' '
+CSNAP_DAILY_FILE(:) = ' '
+CSNAP_HOURLY_FILE(:) = ' '
+CSNAP_POTENTIAL_FILETYPE(:)= ' '
+CSNAP_POTENTIAL_FILE(:,:) = ' '
+CDELTA_LEGAL_TIME_FILETYPE = ' '
+CDELTA_LEGAL_TIME_FILE = ' '
!
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
@@ -170,8 +170,8 @@ IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CH_SNAP_EMIS_PGD)
!* 3. Allocation
! ----------
!
- CHN%NEMIS_NBR = NEMIS_NBR
- CHN%NEMIS_SNAP = NEMIS_SNAP
+CHN%NEMIS_NBR = NEMIS_NBR
+CHN%NEMIS_SNAP = NEMIS_SNAP
!
ALLOCATE(CHN%CEMIS_NAME(NEMIS_NBR))
ALLOCATE(CHN%CEMIS_COMMENT(NEMIS_NBR))
@@ -180,8 +180,8 @@ ALLOCATE(CHN%XSNAP_MONTHLY (CHN%NSNAP_M,NEMIS_SNAP,NEMIS_NBR))
ALLOCATE(CHN%XSNAP_DAILY (CHN%NSNAP_D,NEMIS_SNAP,NEMIS_NBR))
ALLOCATE(CHN%XSNAP_HOURLY (CHN%NSNAP_H,NEMIS_SNAP,NEMIS_NBR))
!
- CHN%CEMIS_NAME (:) = CEMIS_NAME (1:NEMIS_NBR)
- CHN%CEMIS_COMMENT (:) = CEMIS_COMMENT(1:NEMIS_NBR)
+CHN%CEMIS_NAME (:) = CEMIS_NAME (1:NEMIS_NBR)
+CHN%CEMIS_COMMENT (:) = CEMIS_COMMENT(1:NEMIS_NBR)
!
ALLOCATE(CHN%XEMIS_FIELDS_SNAP(NL,NEMIS_SNAP,NEMIS_NBR))
!
diff --git a/src/SURFEX/pgd_cover.F90 b/src/SURFEX/pgd_cover.F90
index 3aa1069a4724fd3a669012aa15dc880f9548f9e8..ff55901770aecceb24b199114bf217a090e8468d 100644
--- a/src/SURFEX/pgd_cover.F90
+++ b/src/SURFEX/pgd_cover.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PGD_COVER ( DGU, DTCO, UG, U, USS, &
- HPROGRAM,ORM_RIVER)
+ SUBROUTINE PGD_COVER ( DTCO, UG, U, USS, HPROGRAM, ORM_RIVER)
! ##############################################################
!
!!**** *PGD_COVER* monitor for averaging and interpolations of cover fractions
@@ -45,16 +44,16 @@
!* 0. DECLARATION
! -----------
!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NPROC, NCOMM
USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_PGD_GRID, ONLY : CGRID, NL, XGRID_PAR, NGRID_PAR
-USE MODD_PGDWORK, ONLY : XSUMCOVER, NSIZE
-USE MODD_DATA_COVER_PAR, ONLY : JPCOVER, NROCK, NSEA, NWATER, NPERMSNOW
+USE MODD_PGD_GRID, ONLY : CGRID, NL, XGRID_PAR
+USE MODD_PGDWORK, ONLY : XALL, NSIZE_ALL, NSIZE, XSUMVAL, XPREC
+USE MODD_DATA_COVER_PAR, ONLY : JPCOVER, NROCK, NSEA, NWATER, NPERMSNOW, LVEG_PRES
USE MODD_DATA_COVER, ONLY : XDATA_TOWN, XDATA_SEA, XDATA_NATURE, XDATA_WATER
!
USE MODI_GET_LUOUT
@@ -70,6 +69,7 @@ USE MODI_CONVERT_COVER_FRAC
USE MODI_READ_LCOVER
USE MODI_SUM_ON_ALL_PROCS
!
+USE MODI_MAKE_LCOVER
USE MODI_READ_NAM_PGD_COVER
!
USE MODI_INIT_IO_SURF_n
@@ -98,17 +98,20 @@ USE MODE_MPPDB
!
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1 Declaration of arguments
! ------------------------
!
!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
LOGICAL, INTENT(OUT) :: ORM_RIVER ! delete river coverage (default = false)
!
!
@@ -137,21 +140,27 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZSEA !to check compatibility between
REAL, DIMENSION(:), ALLOCATABLE :: ZWATER !prescribed fractions and ECOCLIMAP
REAL, DIMENSION(:), ALLOCATABLE :: ZNATURE
REAL, DIMENSION(:), ALLOCATABLE :: ZTOWN
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOVER_NATURE, ZCOVER_TOWN, ZCOVER_SEA, ZCOVER_WATER, ZCOVER
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOVER_NATURE, ZCOVER_TOWN, ZCOVER_SEA, ZCOVER_WATER, &
+ ZCOVER, ZCOVER2
!
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GCOVER, GCOVER2
!
+INTEGER :: INFOMPI, JPROC
INTEGER :: ILUOUT ! output listing logical unit
INTEGER :: IRESP ! Error code after redding
-INTEGER :: JCOVER ! loop counter on covers
-INTEGER :: JL ! loop counter on horizontal points
+INTEGER :: JCOV ! loop counter on covers
+INTEGER :: JL, JI ! loop counter on horizontal points
INTEGER :: ICOVER, ICOVERSUM, ICOVER_OLD, ICPT ! 0 if cover is not present, >1 if present somewhere
INTEGER :: IPERMSNOW, IECO2
INTEGER :: IC_NAT, IC_TWN, IC_WAT, IC_SEA
+INTEGER :: ICPT1, ICPT2, ICPT_TOT
!
-INTEGER, DIMENSION(1) :: IMAXCOVER ! index of maximum cover for the given point
+INTEGER :: IMAXCOVER ! index of maximum cover for the given point
INTEGER, DIMENSION(:), POINTER :: IMASK_COVER=>NULL()
INTEGER, DIMENSION(:), ALLOCATABLE :: IMASK_SEA, IMASK_WATER
!
+LOGICAL, DIMENSION(:,:), ALLOCATABLE :: GCOVER_ALL
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GCORINE
LOGICAL :: LORCA_GRID ! flag to compatibility between Surfex and Orca grid
! (Earth Model over Antarctic)
LOGICAL :: LIMP_COVER ! Imposed values for Cover from another PGD file
@@ -162,7 +171,7 @@ LOGICAL :: LRM_RIVER ! delete inland river coverage. Default
!
REAL, PARAMETER :: ZLAT_ANT_WATER = -60. ! Lattitude limit to delete lake over antarctica
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!
!---------------------------------------------------------------
!
@@ -173,10 +182,10 @@ IF (LHOOK) CALL DR_HOOK('PGD_COVER',0,ZHOOK_HANDLE)
!
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
-ALLOCATE(U%LCOVER (JPCOVER))
+ALLOCATE(U%LCOVER (JPCOVER))
ALLOCATE(XUNIF_COVER(JPCOVER))
!
-U%LCOVER = .FALSE.
+U%LCOVER = .FALSE.
XUNIF_COVER = XUNDEF
!
IECO2 = 0
@@ -188,7 +197,7 @@ IECO2 = 0
!
CALL READ_NAM_PGD_COVER(HPROGRAM, YCOVER, YFILETYPE, XUNIF_COVER, &
XRM_COVER, XRM_COAST, XRM_LAKE, LRM_RIVER, &
- XRM_SEA, LORCA_GRID, XLAT_ANT, LIMP_COVER )
+ XRM_SEA, LORCA_GRID, XLAT_ANT, LIMP_COVER )
!
!-------------------------------------------------------------------------------
!
@@ -218,14 +227,14 @@ IF (ANY(XUNIF_COVER/=0.)) THEN
ICOVER = COUNT(XUNIF_COVER(:)/=0.)
ALLOCATE(U%XCOVER(NL,ICOVER))
ICPT = 0
- DO JCOVER=1,JPCOVER
- IF (XUNIF_COVER(JCOVER)/=0.) THEN
- U%LCOVER(JCOVER) = .TRUE.
+ DO JCOV=1,JPCOVER
+ IF (XUNIF_COVER(JCOV)/=0.) THEN
+ U%LCOVER(JCOV) = .TRUE.
ICPT = ICPT + 1
- U%XCOVER(:,ICPT) = XUNIF_COVER(JCOVER)
+ U%XCOVER(:,ICPT) = XUNIF_COVER(JCOV)
ENDIF
END DO
- U%XCOVER(:,:)=U%XCOVER(:,:)/SPREAD(SUM(U%XCOVER(:,:),2),2,ICOVER)
+ U%XCOVER(:,:) = U%XCOVER(:,:) / SPREAD(SUM(U%XCOVER(:,:),2),2,ICOVER)
END IF
!
!* 3.3 No data
@@ -255,16 +264,14 @@ ELSEIF(LIMP_COVER)THEN !LIMP_COVER (impose cover from input file at the same res
#ifdef SFX_LFI
CFILEIN_LFI = ADJUSTL(YCOVER)
#endif
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
+CALL INIT_IO_SURF_n(DTCO, U, &
YFILETYPE,'FULL ','SURF ','READ ')
ENDIF
!
ALLOCATE(U%LCOVER(JPCOVER))
- CALL READ_LCOVER(&
- YFILETYPE,U%LCOVER)
+ CALL READ_LCOVER(YFILETYPE,U%LCOVER)
!
- CALL READ_SURF_COV(&
- YFILETYPE,'COVER',U%XCOVER(:,:),U%LCOVER,IRESP)
+ CALL READ_SURF_COV(YFILETYPE,'COVER',U%XCOVER(:,:),U%LCOVER,IRESP)
!
CALL END_IO_SURF_n(YFILETYPE)
!
@@ -274,92 +281,85 @@ ELSE
!* 3. Averages the field
! ------------------
!
- ALLOCATE(NSIZE (NL) )
- ALLOCATE(XSUMCOVER (NL,JPCOVER))
+ ALLOCATE(NSIZE_ALL(U%NDIM_FULL,1) )
+ ALLOCATE(XALL (U%NDIM_FULL,1,2) )
!
- NSIZE (:) = 0.
- XSUMCOVER(:,:) = 0.
+ NSIZE_ALL(:,:) = 0
+ XALL (:,:,:) = 0.
CALL TREAT_FIELD(UG, U, USS, &
- HPROGRAM,'SURF ',YFILETYPE,'A_COVR',YCOVER, &
- 'COVER ' )
-
+ HPROGRAM,'SURF ',YFILETYPE,'A_COVR',YCOVER, 'COVER ' )
+!
+ DEALLOCATE(XSUMVAL )
+!
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
!
!* 4. Interpolation if some points are not initialized (no data for these points) (same time)
! ---------------------------------------------------------------------------------------
!
WRITE(YFIELD,FMT='(A)') 'covers'
- CALL INTERPOL_FIELD2D(UG, U, &
- HPROGRAM,ILUOUT,NSIZE,U%XCOVER(:,:),YFIELD)
+ CALL INTERPOL_FIELD2D(UG, U, HPROGRAM,ILUOUT,NSIZE(:,1), U%XCOVER(:,:),YFIELD)
#ifdef MNH_PARALLEL
CALL MPPDB_CHECK_SURFEX3D(U%XCOVER,"PGD_COVER:XCOVER",PRECISION,ILUOUT,'FULL',SIZE(U%XCOVER,2))
#endif
!
!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
!
!* 5. Coherence check
! ---------------
!
ICOVER = SIZE(U%XCOVER,2)
!
- U%XCOVER(:,:)=U%XCOVER(:,:)/SPREAD(SUM(U%XCOVER(:,:),2),2,ICOVER)
+ U%XCOVER(:,:) = U%XCOVER(:,:) / SPREAD(SUM(U%XCOVER(:,:),2),2,ICOVER)
!
DEALLOCATE(NSIZE )
- DEALLOCATE(XSUMCOVER)
!
CALL MAKE_MASK_COVER(IMASK_COVER,ICOVER)
!
ALLOCATE(IMASK_SEA(SIZE(NSEA)))
IMASK_SEA(:) = 0
DO JL=1,SIZE(NSEA)
- DO JCOVER=1,ICOVER
- IF (IMASK_COVER(JCOVER)==NSEA(JL)) IMASK_SEA(JL) = JCOVER
+ DO JCOV=1,ICOVER
+ IF (IMASK_COVER(JCOV)==NSEA(JL)) IMASK_SEA(JL) = JCOV
ENDDO
ENDDO
!
ALLOCATE(IMASK_WATER(SIZE(NWATER)))
IMASK_WATER(:) = 0
DO JL=1,SIZE(NWATER)
- DO JCOVER=1,ICOVER
- IF (IMASK_COVER(JCOVER)==NWATER(JL)) IMASK_WATER(JL) = JCOVER
+ DO JCOV=1,ICOVER
+ IF (IMASK_COVER(JCOV)==NWATER(JL)) IMASK_WATER(JL) = JCOV
ENDDO
ENDDO
!
IPERMSNOW=0
- DO JCOVER=1,ICOVER
- IF (IMASK_COVER(JCOVER)==NPERMSNOW) IPERMSNOW = JCOVER
+ DO JCOV=1,ICOVER
+ IF (IMASK_COVER(JCOV)==NPERMSNOW) IPERMSNOW = JCOV
ENDDO
!
IECO2 = 0
- DO JCOVER=1,ICOVER
- IF (IMASK_COVER(JCOVER)>300) THEN
- IECO2 = JCOVER
+ DO JCOV=1,ICOVER
+ IF (IMASK_COVER(JCOV)>300) THEN
+ IECO2 = JCOV
EXIT
ENDIF
ENDDO
!
+!
!-------------------------------------------------------------------------------
!
!* 6. Special treatments asked by user
! --------------------------------
!
-! * removes cover with very small coverage
- DO JL=1,SIZE(U%XCOVER,1)
- IMAXCOVER(:) = MAXLOC(U%XCOVER(JL,:))
- DO JCOVER=1,ICOVER
- IF (U%XCOVER(JL,JCOVER)/=0.) THEN
- IF (U%XCOVER(JL,JCOVER)<=XRM_COVER .AND. JCOVER /= IMAXCOVER(1)) THEN
- U%XCOVER(JL,JCOVER) = 0.
- END IF
- ENDIF
- END DO
- END DO
+ CALL GET_RMCOV_OMP(ICOVER,U%XCOVER)
!
! * removes River if the user want
ORM_RIVER=LRM_RIVER
IF(LRM_RIVER.AND.IMASK_WATER(2)/=0)THEN
DO JL=1,SIZE(U%XCOVER,1)
- IMAXCOVER(:) = MAXLOC(U%XCOVER(JL,:))
- IF(IMASK_WATER(2)/=IMAXCOVER(1).AND.U%XCOVER(JL,IMASK_WATER(2))>0.)THEN
+ IMAXCOVER = MAXLOC(U%XCOVER(JL,:),1)
+ IF(IMASK_WATER(2)/=IMAXCOVER.AND.U%XCOVER(JL,IMASK_WATER(2))>0.)THEN
U%XCOVER(JL,IMASK_WATER(2)) = 0.
ENDIF
ENDDO
@@ -369,7 +369,7 @@ ELSE
IF(XRM_LAKE>0.0)THEN
DO JL=1,SIZE(NWATER)
IF (IMASK_WATER(JL)/=0) THEN
- WHERE(U%XCOVER(:,IMASK_WATER(JL))<=XRM_LAKE)
+ WHERE(ANINT(U%XCOVER(:,IMASK_WATER(JL))*XPREC)/XPREC<=XRM_LAKE)
U%XCOVER(:,IMASK_WATER(JL)) = 0.
ENDWHERE
ENDIF
@@ -380,7 +380,7 @@ ELSE
IF(XRM_SEA>0.0)THEN
DO JL=1,SIZE(NSEA)
IF (IMASK_SEA(JL)/=0) THEN
- WHERE(U%XCOVER(:,IMASK_SEA(JL))<=XRM_SEA)
+ WHERE(ANINT(U%XCOVER(:,IMASK_SEA(JL))*XPREC)/XPREC<=XRM_SEA)
U%XCOVER(:,IMASK_SEA(JL)) = 0.
ENDWHERE
ENDIF
@@ -389,27 +389,33 @@ ELSE
!
!
! * removes cover; replace by sea or inland water if sea > XRM_COAST
- DO JCOVER=1,ICOVER
+ IF (XRM_COAST<1.) THEN
!
DO JL=1,SIZE(NSEA)
IF (IMASK_SEA(JL)/=0) THEN
- WHERE(U%XCOVER(:,IMASK_SEA(JL))>=XRM_COAST)
- U%XCOVER(:,JCOVER) = 0.
- U%XCOVER(:,IMASK_SEA(JL)) = 1.
- END WHERE
+ DO JI=1,SIZE(U%XCOVER,1)
+ IF (ANINT(U%XCOVER(JI,IMASK_SEA(JL))*XPREC)/XPREC>=XRM_COAST .AND. &
+ U%XCOVER(JI,IMASK_SEA(JL))/=1.) THEN
+ U%XCOVER(JI,:) = 0.
+ U%XCOVER(JI,IMASK_SEA(JL)) = 1.
+ ENDIF
+ ENDDO
ENDIF
ENDDO
- !
+ !
DO JL=1,SIZE(NWATER)
IF (IMASK_WATER(JL)/=0) THEN
- WHERE(U%XCOVER(:,IMASK_WATER(JL))>=XRM_COAST)
- U%XCOVER(:,JCOVER) = 0.
- U%XCOVER(:,IMASK_WATER(JL)) = 1.
- END WHERE
+ DO JI=1,SIZE(U%XCOVER,1)
+ IF (ANINT(U%XCOVER(JI,IMASK_WATER(JL))*XPREC)/XPREC>=XRM_COAST .AND. &
+ U%XCOVER(JI,IMASK_WATER(JL))/=1. ) THEN
+ U%XCOVER(JI,:) = 0.
+ U%XCOVER(JI,IMASK_WATER(JL)) = 1.
+ ENDIF
+ ENDDO
ENDIF
- ENDDO
+ ENDDO
!
- ENDDO
+ ENDIF
!
!
! * Compatibility between Surfex and Orca grid
@@ -456,30 +462,66 @@ ELSE
!* 8. List of cover present
! ---------------------
!
- ALLOCATE(ZCOVER(NL,ICOVER))
- ZCOVER(:,:) = 0.
+ U%LCOVER(:) = .FALSE.
+ DO JCOV=1,ICOVER
+ IF (ANY(U%XCOVER(:,JCOV)/=0.)) U%LCOVER(IMASK_COVER(JCOV)) = .TRUE.
+ ENDDO
+!
+ CALL MAKE_LCOVER(U%LCOVER)
!
ICOVER_OLD = ICOVER
- ICOVER = 0
-!
- IECO2 = 0
+ ICOVER = COUNT(U%LCOVER)
!
- U%LCOVER(:) = .FALSE.
- DO JCOVER=1,ICOVER_OLD
- ICOVERSUM = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,U%XCOVER(:,JCOVER)/=0., 'COV')
- IF (ICOVERSUM>0) THEN
- U%LCOVER(IMASK_COVER(JCOVER))=.TRUE.
- ICOVER = ICOVER+1
- ZCOVER(:,ICOVER) = U%XCOVER(:,JCOVER)
- IF (IMASK_COVER(JCOVER)>300) IECO2 = ICOVER
+ IF (HPROGRAM=='MESONH'.OR.ICOVER<ICOVER_OLD) THEN
+
+ IF (ICOVER/=ICOVER_OLD) THEN
+ ALLOCATE(ZCOVER(NL,ICOVER_OLD))
+ ZCOVER(:,:) = U%XCOVER(:,:)
+ DEALLOCATE(U%XCOVER)
+ ALLOCATE(U%XCOVER(NL,ICOVER))
+ U%XCOVER(:,:) = 0.
+ ICPT = 0
+ DO JCOV=1,ICOVER_OLD
+ IF (U%LCOVER(IMASK_COVER(JCOV))) THEN
+ ICPT = ICPT + 1
+ U%XCOVER(:,ICPT) = ZCOVER(:,JCOV)
+ ENDIF
+ ENDDO
+ DEALLOCATE(ZCOVER)
ENDIF
- END DO
+
+ IF (HPROGRAM=='MESONH') THEN
+
+ DO JCOV=1,ICOVER
+ ICOVERSUM = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,U%XCOVER(:,JCOV)/=0., 'COV')
+ IF (ICOVERSUM==0) U%LCOVER(IMASK_COVER(JCOV) )= .FALSE.
+ ENDDO
+
+ ICOVER_OLD = ICOVER
+ ICOVER = COUNT(U%LCOVER)
+ IF (ICOVER/=ICOVER_OLD) THEN
+ ALLOCATE(ZCOVER(NL,ICOVER_OLD))
+ ZCOVER(:,:) = U%XCOVER(:,:)
+ DEALLOCATE(U%XCOVER)
+ ALLOCATE(U%XCOVER(NL,ICOVER))
+ U%XCOVER(:,:) = 0.
+ ICPT = 0
+ DO JCOV=1,ICOVER_OLD
+ IF (U%LCOVER(IMASK_COVER(JCOV))) THEN
+ ICPT = ICPT + 1
+ U%XCOVER(:,ICPT) = ZCOVER(:,JCOV)
+ ENDIF
+ ENDDO
+ DEALLOCATE(ZCOVER)
+ ENDIF
+
+ ENDIF
+
+ ENDIF
!
- DEALLOCATE(U%XCOVER)
- ALLOCATE(U%XCOVER(NL,ICOVER))
- U%XCOVER(:,:) = ZCOVER(:,1:ICOVER)
+ IECO2 = 0
+ IF (ANY(U%LCOVER(301:))) IECO2=1
!
- DEALLOCATE(ZCOVER)
DEALLOCATE(IMASK_COVER)
!
!-------------------------------------------------------------------------------
@@ -495,9 +537,7 @@ IF(.NOT.LIMP_COVER)THEN
! ---------------------
!
IF (IECO2/=0) THEN
- IF ( SUM_ON_ALL_PROCS(HPROGRAM,CGRID,ANY(U%XCOVER(:,IECO2:)>0.,DIM=2),'COV' ) >0 ) &
- CALL PGD_ECOCLIMAP2_DATA(DTCO, &
- HPROGRAM)
+ CALL PGD_ECOCLIMAP2_DATA(DTCO%NYEAR, DTCO%XDATA_VEGTYPE, HPROGRAM)
ENDIF
!
!-------------------------------------------------------------------------------
@@ -514,8 +554,7 @@ IF (.NOT.ASSOCIATED(U%XSEA)) THEN
ALLOCATE(U%XWATER (NL))
ALLOCATE(U%XNATURE(NL))
ALLOCATE(U%XTOWN (NL))
- CALL CONVERT_COVER_FRAC(DTCO, &
- U%XCOVER,U%LCOVER,U%XSEA,U%XNATURE,U%XTOWN,U%XWATER)
+ CALL CONVERT_COVER_FRAC(DTCO, U%XCOVER,U%LCOVER,U%XSEA,U%XNATURE,U%XTOWN,U%XWATER)
ELSE
!
@@ -529,13 +568,12 @@ ELSE
ALLOCATE(ZWATER (NL))
ALLOCATE(ZNATURE(NL))
ALLOCATE(ZTOWN (NL))
- CALL CONVERT_COVER_FRAC(DTCO, &
- U%XCOVER,U%LCOVER,ZSEA,ZNATURE,ZTOWN,ZWATER)
+ CALL CONVERT_COVER_FRAC(DTCO, U%XCOVER,U%LCOVER,ZSEA,ZNATURE,ZTOWN,ZWATER)
!
CALL FIT_COVERS(XDATA_NATURE,U%XNATURE,4,ICOVER,IC_NAT)
- CALL FIT_COVERS(XDATA_TOWN,U%XTOWN,7,ICOVER,IC_TWN)
- CALL FIT_COVERS(XDATA_WATER,U%XWATER,2,ICOVER,IC_WAT)
- CALL FIT_COVERS(XDATA_SEA,U%XSEA,1,ICOVER,IC_SEA)
+ CALL FIT_COVERS(XDATA_TOWN ,U%XTOWN ,7,ICOVER,IC_TWN)
+ CALL FIT_COVERS(XDATA_WATER ,U%XWATER ,2,ICOVER,IC_WAT)
+ CALL FIT_COVERS(XDATA_SEA ,U%XSEA ,1,ICOVER,IC_SEA)
!
ALLOCATE(ZCOVER_NATURE(NL,ICOVER))
ALLOCATE(ZCOVER_TOWN (NL,ICOVER))
@@ -547,7 +585,7 @@ ELSE
ZCOVER_SEA (:,:) = U%XCOVER(:,:)
ZCOVER_WATER (:,:) = U%XCOVER(:,:)
!
- ALLOCATE(NSIZE(NL))
+ ALLOCATE(NSIZE(NL,1))
!
ALLOCATE(ZDEF(ICOVER))
!
@@ -557,21 +595,21 @@ ELSE
'* Coherence computation between covers and imposed nature fraction *'
WRITE(ILUOUT,FMT=*) &
'*********************************************************************'
- NSIZE(:) = 1
- WHERE (U%XNATURE(:).NE.0. .AND. ZNATURE(:).EQ.0.) NSIZE(:)=0
+ NSIZE(:,1) = 1
+ WHERE (U%XNATURE(:).NE.0. .AND. ZNATURE(:).EQ.0.) NSIZE(:,1)=0
DO JL=1,SIZE(U%XCOVER,1)
- IF (U%XNATURE(JL).EQ.0.) NSIZE(JL)=-1
+ IF (U%XNATURE(JL).EQ.0.) NSIZE(JL,1)=-1
ENDDO
ZDEF(:)=0.
- DO JCOVER=1,ICOVER
- IF (XDATA_NATURE(IMASK_COVER(JCOVER))/=0.) THEN
- ZDEF(JCOVER) = 1.
+ DO JCOV=1,ICOVER
+ IF (XDATA_NATURE(IMASK_COVER(JCOV))/=0.) THEN
+ ZDEF(JCOV) = 1.
EXIT
ENDIF
ENDDO
CALL INTERPOL_FIELD2D(UG, U, &
- HPROGRAM,ILUOUT,NSIZE,ZCOVER_NATURE(:,:),YFIELD,ZDEF)
+ HPROGRAM,ILUOUT,NSIZE(:,1),ZCOVER_NATURE(:,:),YFIELD,ZDEF)
!
WRITE(ILUOUT,FMT=*) &
'*********************************************************************'
@@ -579,20 +617,20 @@ ELSE
'* Coherence computation between covers and imposed town fraction *'
WRITE(ILUOUT,FMT=*) &
'*********************************************************************'
- NSIZE(:) = 1
- WHERE (U%XTOWN(:).NE.0. .AND. ZTOWN(:).EQ.0.) NSIZE(:)=0
+ NSIZE(:,1) = 1
+ WHERE (U%XTOWN(:).NE.0. .AND. ZTOWN(:).EQ.0.) NSIZE(:,1)=0
DO JL=1,SIZE(U%XCOVER,1)
- IF (U%XTOWN(JL).EQ.0.) NSIZE(JL)=-1
+ IF (U%XTOWN(JL).EQ.0.) NSIZE(JL,1)=-1
ENDDO
ZDEF(:)=0.
- DO JCOVER=1,ICOVER
- IF (XDATA_TOWN(IMASK_COVER(JCOVER))/=0.) THEN
- ZDEF(JCOVER) = 1.
+ DO JCOV=1,ICOVER
+ IF (XDATA_TOWN(IMASK_COVER(JCOV))/=0.) THEN
+ ZDEF(JCOV) = 1.
EXIT
ENDIF
ENDDO
CALL INTERPOL_FIELD2D(UG, U, &
- HPROGRAM,ILUOUT,NSIZE,ZCOVER_TOWN (:,:),YFIELD,ZDEF)
+ HPROGRAM,ILUOUT,NSIZE(:,1),ZCOVER_TOWN (:,:),YFIELD,ZDEF)
WRITE(ILUOUT,FMT=*) &
'*********************************************************************'
@@ -600,57 +638,57 @@ ELSE
'* Coherence computation between covers and imposed water fraction *'
WRITE(ILUOUT,FMT=*) &
'*********************************************************************'
- NSIZE(:) = 1
- WHERE (U%XWATER(:).NE.0. .AND. ZWATER(:).EQ.0.) NSIZE(:)=0
+ NSIZE(:,1) = 1
+ WHERE (U%XWATER(:).NE.0. .AND. ZWATER(:).EQ.0.) NSIZE(:,1)=0
! if water imposed to 1 in a grid cell: no extrapolation
DO JL=1,SIZE(U%XCOVER,1)
IF(U%XWATER(JL)==1.0)THEN
ZCOVER_WATER(JL,:)=0.0
ZCOVER_WATER(JL,IC_WAT)=1.0
- NSIZE(JL)=1
+ NSIZE(JL,1)=1
ELSEIF(U%XWATER(JL)==0.0)THEN
- NSIZE(JL)=-1
+ NSIZE(JL,1)=-1
ENDIF
ENDDO
ZDEF(:)=0.
- DO JCOVER=1,ICOVER
- IF (XDATA_WATER(IMASK_COVER(JCOVER))/=0.) THEN
- ZDEF(JCOVER) = 1.
+ DO JCOV=1,ICOVER
+ IF (XDATA_WATER(IMASK_COVER(JCOV))/=0.) THEN
+ ZDEF(JCOV) = 1.
EXIT
ENDIF
ENDDO
CALL INTERPOL_FIELD2D(UG, U, &
- HPROGRAM,ILUOUT,NSIZE,ZCOVER_WATER (:,:),YFIELD,PDEF=ZDEF)
+ HPROGRAM,ILUOUT,NSIZE(:,1),ZCOVER_WATER (:,:),YFIELD,PDEF=ZDEF)
WRITE(ILUOUT,FMT=*) &
'*********************************************************************'
WRITE(ILUOUT,FMT=*) &
'* Coherence computation between covers and imposed sea fraction *'
WRITE(ILUOUT,FMT=*) &
'*********************************************************************'
- NSIZE(:) = 1
- WHERE (U%XSEA(:).NE.0. .AND. ZSEA(:).EQ.0.) NSIZE(:)=0
+ NSIZE(:,1) = 1
+ WHERE (U%XSEA(:).NE.0. .AND. ZSEA(:).EQ.0.) NSIZE(:,1)=0
! if sea imposed to 1 in a grid cell: no extrapolation
DO JL=1,SIZE(U%XCOVER,1)
IF(U%XSEA(JL)==1.0)THEN
ZCOVER_SEA(JL,:)=0.0
ZCOVER_SEA(JL,IC_SEA)=1.0
- NSIZE(JL)=1
+ NSIZE(JL,1)=1
ELSEIF(U%XSEA(JL)==0.0)THEN
- NSIZE(JL)=-1
+ NSIZE(JL,1)=-1
ENDIF
ENDDO
ZDEF(:)=0.
- DO JCOVER=1,ICOVER
- IF (XDATA_SEA(IMASK_COVER(JCOVER))/=0.) THEN
- ZDEF(JCOVER) = 1.
+ DO JCOV=1,ICOVER
+ IF (XDATA_SEA(IMASK_COVER(JCOV))/=0.) THEN
+ ZDEF(JCOV) = 1.
EXIT
ENDIF
ENDDO
CALL INTERPOL_FIELD2D(UG, U, &
- HPROGRAM,ILUOUT,NSIZE,ZCOVER_SEA (:,:),YFIELD,PDEF=ZDEF)
+ HPROGRAM,ILUOUT,NSIZE(:,1),ZCOVER_SEA (:,:),YFIELD,PDEF=ZDEF)
!
U%XCOVER(:,:) = U%XCOVER(:,:) + 0.001 * ( ZCOVER_NATURE(:,:) + ZCOVER_TOWN(:,:) + &
- ZCOVER_WATER (:,:) + ZCOVER_SEA (:,:) )
+ ZCOVER_WATER (:,:) + ZCOVER_SEA (:,:) )
!
U%XCOVER(:,:)=U%XCOVER(:,:)/SPREAD(SUM(U%XCOVER(:,:),2),2,ICOVER)
!
@@ -670,6 +708,15 @@ ELSE
!
ENDIF
!
+LVEG_PRES(:) = .FALSE.
+IF (.NOT.U%LECOSG) THEN
+ DO JCOV = 1,JPCOVER
+ IF (U%LCOVER(JCOV)) THEN
+ WHERE(DTCO%XDATA_VEGTYPE(JCOV,:) > 0.) LVEG_PRES(1:SIZE(DTCO%XDATA_VEGTYPE,2)) = .TRUE.
+ ENDIF
+ ENDDO
+ENDIF
+!
U%NSIZE_NATURE = COUNT(U%XNATURE(:) > 0.0)
U%NSIZE_WATER = COUNT(U%XWATER (:) > 0.0)
U%NSIZE_SEA = COUNT(U%XSEA (:) > 0.0)
@@ -683,7 +730,7 @@ U%NDIM_TOWN = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,U%XTOWN (:) > 0., 'DIM')
!
IF (LHOOK) CALL DR_HOOK('PGD_COVER',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!
SUBROUTINE FIT_COVERS(PDATA_SURF,PSURF,KSURF,KCOVER,KC_SURF)
!
@@ -694,10 +741,13 @@ INTEGER, INTENT(INOUT) :: KCOVER
INTEGER, INTENT(OUT) :: KC_SURF
!
LOGICAL :: GPRESENT
+REAL :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('PGD_COVER:FIT_COVERS',0,ZHOOK_HANDLE)
!
GPRESENT = .FALSE.
-DO JCOVER=1,KCOVER
- IF (PDATA_SURF(IMASK_COVER(JCOVER))/=0.) THEN
+DO JCOV=1,KCOVER
+ IF (PDATA_SURF(IMASK_COVER(JCOV))/=0.) THEN
GPRESENT = .TRUE.
EXIT
ENDIF
@@ -707,9 +757,9 @@ IF (ANY(PSURF(:)/=0.)) THEN
!
IF (GPRESENT) THEN
!
- DO JCOVER=1,KCOVER
- IF (IMASK_COVER(JCOVER)==KSURF) THEN
- KC_SURF = JCOVER
+ DO JCOV=1,KCOVER
+ IF (IMASK_COVER(JCOV)==KSURF) THEN
+ KC_SURF = JCOV
EXIT
ENDIF
ENDDO
@@ -719,14 +769,14 @@ IF (ANY(PSURF(:)/=0.)) THEN
U%LCOVER(KSURF) = .TRUE.
KCOVER = KCOVER + 1
ALLOCATE(ZCOVER(NL,KCOVER))
- DO JCOVER = 1,KCOVER
- IF (JCOVER<KCOVER) THEN
- IF (IMASK_COVER(JCOVER)<KSURF) CYCLE
+ DO JCOV = 1,KCOVER
+ IF (JCOV<KCOVER) THEN
+ IF (IMASK_COVER(JCOV)<KSURF) CYCLE
ENDIF
- KC_SURF = JCOVER
- IF (JCOVER>1) ZCOVER(:,1:JCOVER-1) = U%XCOVER(:,1:JCOVER-1)
- ZCOVER(:,JCOVER) = 0.
- IF (JCOVER<KCOVER) ZCOVER(:,JCOVER+1:KCOVER) = U%XCOVER(:,JCOVER:KCOVER-1)
+ KC_SURF = JCOV
+ IF (JCOV>1) ZCOVER(:,1:JCOV-1) = U%XCOVER(:,1:JCOV-1)
+ ZCOVER(:,JCOV) = 0.
+ IF (JCOV<KCOVER) ZCOVER(:,JCOV+1:KCOVER) = U%XCOVER(:,JCOV:KCOVER-1)
EXIT
ENDDO
DEALLOCATE(U%XCOVER)
@@ -740,6 +790,8 @@ IF (ANY(PSURF(:)/=0.)) THEN
!
ENDIF
!
+IF (LHOOK) CALL DR_HOOK('PGD_COVER:FIT_COVERS',1,ZHOOK_HANDLE)
+!
END SUBROUTINE FIT_COVERS
!
!------------------------------------------------------
@@ -750,17 +802,68 @@ INTEGER, DIMENSION(:), POINTER :: KMASK_COVER
INTEGER, INTENT(IN) :: KCOVER
!
INTEGER :: ICPT
+REAL :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('PGD_COVER:MAKE_MASK_COVER',0,ZHOOK_HANDLE)
!
IF (ASSOCIATED(KMASK_COVER)) DEALLOCATE(KMASK_COVER)
ALLOCATE(KMASK_COVER(KCOVER))
ICPT = 0
-DO JCOVER=1,JPCOVER
- IF (U%LCOVER(JCOVER)) THEN
+DO JCOV=1,JPCOVER
+ IF (U%LCOVER(JCOV)) THEN
ICPT = ICPT + 1
- KMASK_COVER(ICPT) = JCOVER
+ KMASK_COVER(ICPT) = JCOV
ENDIF
ENDDO
!
+IF (LHOOK) CALL DR_HOOK('PGD_COVER:MAKE_MASK_COVER',1,ZHOOK_HANDLE)
+!
END SUBROUTINE MAKE_MASK_COVER
!
+!------------------------------------------------------
+!
+SUBROUTINE GET_RMCOV_OMP(KCOVER,PCOVER)
+!
+USE MODD_SURFEX_OMP, ONLY : NBLOCKTOT
+!
+USE MODI_GATHER_AND_WRITE_MPI
+USE MODI_READ_AND_SEND_MPI
+!
+INTEGER, INTENT(IN) :: KCOVER
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PCOVER
+!
+REAL, DIMENSION(U%NDIM_FULL,SIZE(PCOVER,2)) :: ZCOVER_ALL
+INTEGER, DIMENSION(U%NDIM_FULL) :: IMAXCOVER_ALL
+INTEGER, DIMENSION(U%NSIZE_FULL) :: IMAXCOVER
+INTEGER :: JK, JCOV, ISIZE_OMP
+REAL :: ZHOOK_HANDLE_OMP
+!
+ISIZE_OMP = MAX(1,SIZE(PCOVER,1)/NBLOCKTOT)
+!
+ CALL GATHER_AND_WRITE_MPI(PCOVER,ZCOVER_ALL)
+IF (NRANK==NPIO) THEN
+ DO JL = 1,U%NDIM_FULL
+ IMAXCOVER_ALL(JL) = MAXLOC(ZCOVER_ALL(JL,:),1)
+ ENDDO
+ENDIF
+!
+ CALL READ_AND_SEND_MPI(IMAXCOVER_ALL,IMAXCOVER)
+!
+! * removes cover with very small coverage
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('PGD_COVER:GET_RMCOV_OMP',0,ZHOOK_HANDLE_OMP)
+!$OMP DO SCHEDULE(STATIC,ISIZE_OMP) PRIVATE(JL,JCOV)
+DO JL=1,SIZE(PCOVER,1)
+ DO JCOV=1,KCOVER
+ IF (JCOV /= IMAXCOVER(JL)) THEN
+ IF (ANINT(PCOVER(JL,JCOV)*XPREC)/XPREC<=XRM_COVER ) PCOVER(JL,JCOV) = 0.
+ ENDIF
+ END DO
+END DO
+!$OMP END DO
+IF (LHOOK) CALL DR_HOOK('PGD_COVER:GET_RMCOV_OMP',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
+!
+END SUBROUTINE GET_RMCOV_OMP
+!
END SUBROUTINE PGD_COVER
diff --git a/src/SURFEX/pgd_dummy.F90 b/src/SURFEX/pgd_dummy.F90
index bbc5c71bbac5c0fe9c3a0123d1e4f44caec8f96f..8dfed99705b92c849eb39ad5458c5ab8ba0d3ad5 100644
--- a/src/SURFEX/pgd_dummy.F90
+++ b/src/SURFEX/pgd_dummy.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PGD_DUMMY (DTCO, DUU, UG, U, USS, &
- HPROGRAM)
+ SUBROUTINE PGD_DUMMY (DTCO, DUU, UG, U, USS, HPROGRAM)
! ##############################################################
!
!!**** *PGD_DUMMY* monitor for averaging and interpolations of physiographic fields
@@ -46,7 +45,7 @@ USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_DUMMY_SURF_FIELDS_n, ONLY : DUMMY_SURF_FIELDS_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_PGD_GRID, ONLY : NL
USE MODD_PGDWORK, ONLY : CATYPE
@@ -70,7 +69,7 @@ TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(DUMMY_SURF_FIELDS_t), INTENT(INOUT) :: DUU
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
!
diff --git a/src/SURFEX/pgd_ecoclimap2_data.F90 b/src/SURFEX/pgd_ecoclimap2_data.F90
index 52dbd694021a3f9fccf72e9d0e287e7dde85b829..7fdf439d969edda80b1b689016aae1a201d5f539 100644
--- a/src/SURFEX/pgd_ecoclimap2_data.F90
+++ b/src/SURFEX/pgd_ecoclimap2_data.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########################
- SUBROUTINE PGD_ECOCLIMAP2_DATA (DTCO, &
+ SUBROUTINE PGD_ECOCLIMAP2_DATA (KYEAR, PDATA_VEGTYPE, &
HPROGRAM)
! #########################
!
@@ -39,9 +39,6 @@
!
!* 0. DECLARATION
! -----------
-
-!
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
!
@@ -74,7 +71,8 @@ IMPLICIT NONE
! ------------------------
!
!
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+INTEGER, INTENT(INOUT) :: KYEAR
+REAL, DIMENSION(:,:), INTENt(IN) :: PDATA_VEGTYPE
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
!
@@ -114,7 +112,7 @@ NAMELIST/NAM_ECOCLIMAP2/ YIRRIG, LCLIM_LAI
IF (LHOOK) CALL DR_HOOK('PGD_ECOCLIMAP2_DATA',0,ZHOOK_HANDLE)
YIRRIG = ' '
LCLIM_LAI = .TRUE.
-DTCO%NYEAR = NUNDEF
+KYEAR = NUNDEF
!
!* Reading
!
@@ -193,7 +191,8 @@ END IF
! 4. Computes LAI evolution for the chosen year
! ------------------------------------------
!
- CALL ECOCLIMAP2_LAI(DTCO)
+ CALL ECOCLIMAP2_LAI(KYEAR)
+!
IF (LHOOK) CALL DR_HOOK('PGD_ECOCLIMAP2_DATA',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/pgd_field.F90 b/src/SURFEX/pgd_field.F90
index d2672e10ea49ecce475aba7e3c89303e82eec467..71f34488e60dad97ccfd2dae61651ce0d237e228 100644
--- a/src/SURFEX/pgd_field.F90
+++ b/src/SURFEX/pgd_field.F90
@@ -2,75 +2,59 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE PGD_FIELD (DTCO, UG, U, USS, &
- HPROGRAM,HFIELD,HAREA,HFILE,HFILETYPE,PUNIF,PFIELD,OPRESENT)
-! ##############################################################
-!
-!!**** *PGD_FIELD* monitor for averaging and interpolations of ISBA physiographic fields
-!!
-!! PURPOSE
-!! -------
-!!
-!! METHOD
-!! ------
-!!
-!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! V. Masson Meteo-France
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 10/12/97
-!! 09/2010 (E. Kourzeneva): interpolation of the lake depth
-!! is not allowed and not necessary
-!!
-!! 02/2014 (B. Decharme): interpolation of the lake depth
-!! re-allowed but using the nearest point
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
-!
+MODULE MODI_PGD_FIELD
!
+INTERFACE PGD_FIELD
!
+! #########
+ SUBROUTINE PGD_FIELD_1D (DTCO, UG, U, USS, &
+ HPROGRAM,HFIELD,HAREA,HFILE,HFILETYPE,PUNIF,PFIELD,OPRESENT,PVEGTYPE)
+! ##############################################################
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_PGD_GRID, ONLY : NL
-USE MODD_PGDWORK, ONLY : XSUMVAL, NSIZE, CATYPE, &
- NVALNBR, NVALCOUNT, XVALLIST, JPVALMAX
+IMPLICIT NONE
!
-USE MODI_GET_LUOUT
-USE MODI_TREAT_FIELD
-USE MODI_INTERPOL_FIELD
-USE MODI_PACK_SAME_RANK
+!* 0.1 Declaration of arguments
+! ------------------------
!
!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
-USE MODI_ABOR1_SFX
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
+ CHARACTER(LEN=*), INTENT(IN) :: HFIELD ! field name for prints
+ CHARACTER(LEN=3), INTENT(IN) :: HAREA ! area where field is defined
+! ! 'ALL' : everywhere
+! ! 'NAT' : on nature
+! ! 'TWN' : on town
+! ! 'SEA' : on sea
+! ! 'WAT' : on inland waters
+ CHARACTER(LEN=28), INTENT(IN) :: HFILE ! data file name
+ CHARACTER(LEN=6), INTENT(INOUT) :: HFILETYPE ! data file type
+REAL, INTENT(IN) :: PUNIF ! prescribed uniform value for field
+REAL, DIMENSION(:),INTENT(OUT):: PFIELD ! physiographic field
+LOGICAL, OPTIONAL, INTENT(OUT) :: OPRESENT
+REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PVEGTYPE
!
-USE MODI_GET_SURF_MASK_n
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE PGD_FIELD_1D
+!
+! #########
+ SUBROUTINE PGD_FIELD_2D (DTCO, UG, U, USS, &
+ HPROGRAM,HFIELD,HAREA,HFILE,HFILETYPE,PUNIF,PFIELD,OPRESENT,PVEGTYPE)
+! ##############################################################
!
-USE MODI_GET_TYPE_DIM_n
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
!
IMPLICIT NONE
!
@@ -81,7 +65,7 @@ IMPLICIT NONE
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
CHARACTER(LEN=*), INTENT(IN) :: HFIELD ! field name for prints
@@ -92,188 +76,133 @@ TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
! ! 'SEA' : on sea
! ! 'WAT' : on inland waters
CHARACTER(LEN=28), INTENT(IN) :: HFILE ! data file name
- CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! data file type
+ CHARACTER(LEN=6), INTENT(INOUT) :: HFILETYPE ! data file type
REAL, INTENT(IN) :: PUNIF ! prescribed uniform value for field
-REAL, DIMENSION(:),INTENT(OUT):: PFIELD ! physiographic field
+REAL, DIMENSION(:,:),INTENT(OUT):: PFIELD ! physiographic field
LOGICAL, OPTIONAL, INTENT(OUT) :: OPRESENT
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PVEGTYPE
!
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-INTEGER :: ILU ! expected physical size of full surface array
-INTEGER :: ILUOUT ! output listing logical unit
-INTEGER, DIMENSION(:), POINTER :: IMASK ! mask for packing from complete field to nature field
-INTEGER :: IDIM !
-
-!
- CHARACTER(LEN=20) :: YFIELD
- CHARACTER(LEN=6) :: YMASK
-INTEGER :: INPTS ! number of points used for interpolation
-REAL, DIMENSION(NL) :: ZFIELD ! physiographic field on full grid
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
-!* 1. Initializations
-! ---------------
+END SUBROUTINE PGD_FIELD_2D
!
-IF (LHOOK) CALL DR_HOOK('PGD_FIELD',0,ZHOOK_HANDLE)
-ZFIELD(:) = XUNDEF
-IF (PRESENT(OPRESENT)) OPRESENT=.TRUE.
-!-------------------------------------------------------------------------------
+END INTERFACE PGD_FIELD
!
-!* 2. Output listing logical unit
-! ---------------------------
+END MODULE MODI_PGD_FIELD
!
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
-!-------------------------------------------------------------------------------
+! #########
+ SUBROUTINE PGD_FIELD_1D (DTCO, UG, U, USS, &
+ HPROGRAM,HFIELD,HAREA,HFILE,HFILETYPE,PUNIF,PFIELD,OPRESENT,PVEGTYPE)
+! ##############################################################
!
-!* 3. Read from file
-! --------------
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
!
-IF (LEN_TRIM(HFILE)/=0) THEN
-!
-!-------------------------------------------------------------------------------
+USE MODI_PGD_FIELDIN
!
-!* 4. Averages the field
-! ------------------
+IMPLICIT NONE
!
- ALLOCATE(NSIZE (NL))
- ALLOCATE(XSUMVAL (NL))
+!* 0.1 Declaration of arguments
+! ------------------------
!
- NSIZE (:) = 0.
- XSUMVAL (:) = 0.
- INPTS = 3
!
- IF(HFIELD=="water depth") THEN
- INPTS = 1
- ENDIF
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
- IF (CATYPE=='MAJ') THEN
- ALLOCATE(NVALNBR (NL))
- ALLOCATE(NVALCOUNT(NL,JPVALMAX))
- ALLOCATE(XVALLIST (NL,JPVALMAX))
- NVALNBR = 0
- NVALCOUNT = 0
- XVALLIST = XUNDEF
- INPTS = 1
- END IF
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
+ CHARACTER(LEN=*), INTENT(IN) :: HFIELD ! field name for prints
+ CHARACTER(LEN=3), INTENT(IN) :: HAREA ! area where field is defined
+! ! 'ALL' : everywhere
+! ! 'NAT' : on nature
+! ! 'TWN' : on town
+! ! 'SEA' : on sea
+! ! 'WAT' : on inland waters
+ CHARACTER(LEN=28), INTENT(IN) :: HFILE ! data file name
+ CHARACTER(LEN=6), INTENT(INOUT) :: HFILETYPE ! data file type
+REAL, INTENT(IN) :: PUNIF ! prescribed uniform value for field
+REAL, DIMENSION(:),INTENT(OUT):: PFIELD ! physiographic field
+LOGICAL, OPTIONAL, INTENT(OUT) :: OPRESENT
+REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PVEGTYPE
+!
+LOGICAL :: GPRESENT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZMASK
+REAL, DIMENSION(SIZE(PFIELD),1) :: ZFIELD
+!
+IF (PRESENT(PVEGTYPE)) THEN
+ ALLOCATE(ZMASK(SIZE(PVEGTYPE),1))
+ ZMASK(:,1) = PVEGTYPE
+ CALL PGD_FIELDIN(DTCO, UG, U, USS, &
+ HPROGRAM,HFIELD,HAREA,HFILE,HFILETYPE,PUNIF,ZFIELD,GPRESENT,ZMASK)
+ DEALLOCATE(ZMASK)
+ELSE
+ CALL PGD_FIELDIN(DTCO, UG, U, USS, &
+ HPROGRAM,HFIELD,HAREA,HFILE,HFILETYPE,PUNIF,ZFIELD,GPRESENT)
+ENDIF
!
- YFIELD = ' '
- YFIELD = HFIELD(1:MIN(LEN(HFIELD),20))
+PFIELD(:) = ZFIELD(:,1)
!
- CALL TREAT_FIELD(UG, U, USS, &
- HPROGRAM,'SURF ',HFILETYPE,'A_MESH',HFILE, &
- YFIELD,ZFIELD,HAREA )
+IF (PRESENT(OPRESENT)) OPRESENT = GPRESENT
!
!-------------------------------------------------------------------------------
!
-!* 4. Mask for the interpolations
-! ---------------------------
-!
- SELECT CASE (HAREA)
- CASE ('LAN')
- WHERE ((U%XTOWN(:)+U%XNATURE(:))==0. .AND. NSIZE(:)==0 ) NSIZE(:) = -1
- CASE ('TWN')
- WHERE (U%XTOWN (:)==0. .AND. NSIZE(:)==0 ) NSIZE(:) = -1
- CASE ('BLD')
- WHERE (U%XTOWN (:)==0. .AND. NSIZE(:)==0 ) NSIZE(:) = -1
- CASE ('NAT')
- WHERE (U%XNATURE(:)==0. .AND. NSIZE(:)==0 ) NSIZE(:) = -1
- CASE ('SEA')
- WHERE (U%XSEA (:)==0. .AND. NSIZE(:)==0 ) NSIZE(:) = -1
- CASE ('WAT')
- WHERE (U%XWATER (:)==0. .AND. NSIZE(:)==0 ) NSIZE(:) = -1
- END SELECT
+END SUBROUTINE PGD_FIELD_1D
!
-!-------------------------------------------------------------------------------
+! #########
+ SUBROUTINE PGD_FIELD_2D (DTCO, UG, U, USS, &
+ HPROGRAM,HFIELD,HAREA,HFILE,HFILETYPE,PUNIF,PFIELD,OPRESENT,PVEGTYPE)
+! ##############################################################
!
-!* 5. Interpolation if some points are not initialized (no data for these points)
-! ------------------------------------------------
-!
- IF (PUNIF/=XUNDEF) THEN
- CALL INTERPOL_FIELD(UG, U, &
- HPROGRAM,ILUOUT,NSIZE,ZFIELD(:),HFIELD,PDEF=PUNIF,KNPTS=INPTS)
- ELSE
- CALL INTERPOL_FIELD(UG, U, &
- HPROGRAM,ILUOUT,NSIZE,ZFIELD(:),HFIELD)
- END IF
-!
- DEALLOCATE(NSIZE )
- DEALLOCATE(XSUMVAL )
- IF (CATYPE=='MAJ') THEN
- DEALLOCATE(NVALNBR )
- DEALLOCATE(NVALCOUNT)
- DEALLOCATE(XVALLIST )
- END IF
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
!
-!-------------------------------------------------------------------------------
+USE MODI_PGD_FIELDIN
!
-ELSEIF (PUNIF/=XUNDEF) THEN
+IMPLICIT NONE
!
-!* 3.1 Use of the presribed field
-! --------------------------
+!* 0.1 Declaration of arguments
+! ------------------------
!
- ZFIELD(:) = PUNIF
!
-ELSE
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
- IF (PRESENT(OPRESENT)) THEN
- OPRESENT=.FALSE.
- IF (LHOOK) CALL DR_HOOK('PGD_FIELD',1,ZHOOK_HANDLE)
- RETURN
- ENDIF
-!
- WRITE(ILUOUT,*) ' '
- WRITE(ILUOUT,*) '***********************************************************'
- WRITE(ILUOUT,*) '* Error in PGD field preparation of field : ', HFIELD
- WRITE(ILUOUT,*) '* There is no prescribed value and no input file *'
- WRITE(ILUOUT,*) '***********************************************************'
- WRITE(ILUOUT,*) ' '
- CALL ABOR1_SFX('PGD_FIELD: NO PRESCRIBED VALUE NOR INPUT FILE FOR '//HFIELD)
-!
-END IF
-!-------------------------------------------------------------------------------
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
+ CHARACTER(LEN=*), INTENT(IN) :: HFIELD ! field name for prints
+ CHARACTER(LEN=3), INTENT(IN) :: HAREA ! area where field is defined
+! ! 'ALL' : everywhere
+! ! 'NAT' : on nature
+! ! 'TWN' : on town
+! ! 'SEA' : on sea
+! ! 'WAT' : on inland waters
+ CHARACTER(LEN=28), INTENT(IN) :: HFILE ! data file name
+ CHARACTER(LEN=6), INTENT(INOUT) :: HFILETYPE ! data file type
+REAL, INTENT(IN) :: PUNIF ! prescribed uniform value for field
+REAL, DIMENSION(:,:),INTENT(OUT):: PFIELD ! physiographic field
+LOGICAL, OPTIONAL, INTENT(OUT) :: OPRESENT
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PVEGTYPE
+!
+LOGICAL :: GPRESENT
!
-!* 6. Mask for the field
-! ------------------
-!
-SELECT CASE (HAREA)
- CASE ('LAN')
- YMASK = 'LAND '
- CASE ('TWN')
- YMASK = 'TOWN '
- CASE ('BLD')
- YMASK = 'TOWN '
- CASE ('NAT')
- YMASK = 'NATURE'
- CASE ('SEA')
- YMASK = 'SEA '
- CASE ('WAT')
- YMASK = 'WATER '
- CASE DEFAULT
- PFIELD(:) = ZFIELD(:)
- IF (LHOOK) CALL DR_HOOK('PGD_FIELD',1,ZHOOK_HANDLE)
- RETURN
-END SELECT
-
- CALL GET_TYPE_DIM_n(DTCO, U, &
- YMASK,IDIM)
-IF (IDIM/=SIZE(PFIELD)) THEN
- WRITE(ILUOUT,*)'Wrong dimension of MASK: ',IDIM,SIZE(PFIELD)
- CALL ABOR1_SFX('PGD_FIELD: WRONG DIMENSION OF MASK')
+IF (PRESENT(PVEGTYPE)) THEN
+ CALL PGD_FIELDIN(DTCO, UG, U, USS, &
+ HPROGRAM,HFIELD,HAREA,HFILE,HFILETYPE,PUNIF,PFIELD,GPRESENT,PVEGTYPE)
+ELSE
+ CALL PGD_FIELDIN(DTCO, UG, U, USS, &
+ HPROGRAM,HFIELD,HAREA,HFILE,HFILETYPE,PUNIF,PFIELD,GPRESENT)
ENDIF
-
-ALLOCATE(IMASK(IDIM))
-ILU=0
- CALL GET_SURF_MASK_n(DTCO, U, &
- YMASK,IDIM,IMASK,ILU,ILUOUT)
- CALL PACK_SAME_RANK(IMASK,ZFIELD(:),PFIELD(:))
-DEALLOCATE(IMASK)
-IF (LHOOK) CALL DR_HOOK('PGD_FIELD',1,ZHOOK_HANDLE)
-
+!
+IF (PRESENT(OPRESENT)) OPRESENT = GPRESENT
!
!-------------------------------------------------------------------------------
!
-END SUBROUTINE PGD_FIELD
+END SUBROUTINE PGD_FIELD_2D
+!
diff --git a/src/SURFEX/pgd_fieldin.F90 b/src/SURFEX/pgd_fieldin.F90
new file mode 100644
index 0000000000000000000000000000000000000000..683611a1c6db9abc6a56ac5ce4510edf25811734
--- /dev/null
+++ b/src/SURFEX/pgd_fieldin.F90
@@ -0,0 +1,371 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE PGD_FIELDIN (DTCO, UG, U, USS, &
+ HPROGRAM,HFIELD,HAREA,HFILE,HFILETYPE,PUNIF,PFIELD,&
+ OPRESENT,PVEGTYPE)
+! ##############################################################
+!
+!!**** *PGD_FIELDIN* monitor for averaging and interpolations of ISBA physiographic fields
+!!
+!! PURPOSE
+!! -------
+!!
+!! METHOD
+!! ------
+!!
+!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! V. Masson Meteo-France
+!!
+!! MODIFICATION
+!! ------------
+!!
+!! Original 10/12/97
+!! 09/2010 (E. Kourzeneva): interpolation of the lake depth
+!! is not allowed and not necessary
+!!
+!! 02/2014 (B. Decharme): interpolation of the lake depth
+!! re-allowed but using the nearest point
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATION
+! -----------
+!
+!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NPROC
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
+!
+USE MODD_PGDWORK, ONLY : XALL, NSIZE_ALL, CATYPE, NSIZE, XSUMVAL, &
+ NVALNBR, NVALCOUNT, XVALLIST, JPVALMAX
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_PGD_GRID, ONLY : NL
+!
+USE MODD_DATA_COVER_PAR, ONLY : NTYPE, LVEG_PRES, NVEGTYPE
+!
+USE MODI_GET_LUOUT
+USE MODI_TREAT_FIELD
+USE MODI_INTERPOL_FIELD
+USE MODI_PACK_SAME_RANK
+USE MODI_UNPACK_SAME_RANK
+!
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODI_ABOR1_SFX
+!
+USE MODI_GET_SURF_MASK_n
+!
+USE MODI_GET_TYPE_DIM_n
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
+ CHARACTER(LEN=*), INTENT(IN) :: HFIELD ! field name for prints
+ CHARACTER(LEN=3), INTENT(IN) :: HAREA ! area where field is defined
+! ! 'ALL' : everywhere
+! ! 'NAT' : on nature
+! ! 'TWN' : on town
+! ! 'SEA' : on sea
+! ! 'WAT' : on inland waters
+ CHARACTER(LEN=28), INTENT(IN) :: HFILE ! data file name
+ CHARACTER(LEN=6), INTENT(INOUT) :: HFILETYPE ! data file type
+REAL, INTENT(IN) :: PUNIF ! prescribed uniform value for field
+REAL, DIMENSION(:,:),INTENT(OUT):: PFIELD ! physiographic field
+LOGICAL, OPTIONAL, INTENT(OUT) :: OPRESENT
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PVEGTYPE
+!
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+INTEGER :: ILU ! expected physical size of full surface array
+INTEGER :: ILUOUT ! output listing logical unit
+INTEGER, DIMENSION(:), POINTER :: IMASK ! mask for packing from complete field to nature field
+INTEGER :: IDIM !
+INTEGER :: JI, ICASE
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEGTYPE
+INTEGER :: JJ, JT, JTN
+ CHARACTER(LEN=20) :: YFIELD
+ CHARACTER(LEN=6) :: YMASK
+INTEGER :: INPTS ! number of points used for interpolation
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFIELD ! physiographic field on full grid
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+!
+!* 1. Initializations
+! ---------------
+!
+IF (LHOOK) CALL DR_HOOK('PGD_FIELDIN',0,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. Output listing logical unit
+! ---------------------------
+!
+ CALL GET_LUOUT(HPROGRAM,ILUOUT)
+!
+IF (LEN_TRIM(HFILE)/=0 .OR. PUNIF/=XUNDEF) THEN
+ !
+ IF (PRESENT(OPRESENT)) OPRESENT=.TRUE.
+ !
+ IF (HFILETYPE=='DIRTYP') THEN
+ ALLOCATE(ZFIELD(NL,SUM(NTYPE)))
+ ELSE
+ ALLOCATE(ZFIELD(NL,1))
+ ENDIF
+ !-------------------------------------------------------------------------------
+ !
+ !* 6. Mask for the field
+ ! ------------------
+ !
+ YMASK = ''
+ SELECT CASE (HAREA)
+ CASE ('LAN')
+ YMASK = 'LAND '
+ CASE ('TWN')
+ YMASK = 'TOWN '
+ CASE ('BLD')
+ YMASK = 'TOWN '
+ CASE ('NAT')
+ YMASK = 'NATURE'
+ CASE ('SEA')
+ YMASK = 'SEA '
+ CASE ('WAT')
+ YMASK = 'WATER '
+ CASE DEFAULT
+ YMASK = 'FULL '
+ END SELECT
+
+ CALL GET_TYPE_DIM_n(DTCO, U, YMASK,IDIM)
+ IF (IDIM/=SIZE(PFIELD,1)) THEN
+ WRITE(ILUOUT,*)'Wrong dimension of MASK: ',IDIM,SIZE(PFIELD,1)
+ CALL ABOR1_SFX('PGD_FIELDIN: WRONG DIMENSION OF MASK')
+ ENDIF
+
+ ALLOCATE(IMASK(IDIM))
+ ILU=0
+ CALL GET_SURF_MASK_n(DTCO, U, YMASK,IDIM,IMASK,ILU,ILUOUT)
+!
+ELSE
+ !
+ IF (PRESENT(OPRESENT)) THEN
+ OPRESENT=.FALSE.
+ PFIELD(:,:) = XUNDEF
+ IF (LHOOK) CALL DR_HOOK('PGD_FIELDIN',1,ZHOOK_HANDLE)
+ RETURN
+ ENDIF
+ !
+ WRITE(ILUOUT,*) ' '
+ WRITE(ILUOUT,*) '***********************************************************'
+ WRITE(ILUOUT,*) '* Error in PGD field preparation of field : ', HFIELD
+ WRITE(ILUOUT,*) '* There is no prescribed value and no input file *'
+ WRITE(ILUOUT,*) '***********************************************************'
+ WRITE(ILUOUT,*) ' '
+ CALL ABOR1_SFX('PGD_FIELDIN: NO PRESCRIBED VALUE NOR INPUT FILE FOR '//HFIELD)
+ !
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. Read from file
+! --------------
+!
+IF (LEN_TRIM(HFILE)/=0) THEN
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. Averages the field
+! ------------------
+!
+ ALLOCATE(NSIZE_ALL (U%NDIM_FULL,1))
+!
+ NSIZE_ALL(:,1) = 0
+!
+ IF (CATYPE=='MAJ') THEN
+ ALLOCATE(NVALNBR (U%NDIM_FULL,1))
+ ALLOCATE(NVALCOUNT(U%NDIM_FULL,JPVALMAX,1))
+ ALLOCATE(XVALLIST (U%NDIM_FULL,JPVALMAX,1))
+ NVALNBR = 0
+ NVALCOUNT = 0
+ XVALLIST = XUNDEF
+ INPTS = 1
+ ELSE
+ ALLOCATE(XALL(U%NDIM_FULL,1,1))
+ XALL(:,:,:) = 0.
+ INPTS = 3
+ ENDIF
+!
+ IF(HFIELD=="water depth") THEN
+ INPTS = 1
+ ENDIF
+!
+ YFIELD = ' '
+ YFIELD = HFIELD(1:MIN(LEN(HFIELD),20))
+!
+ ZFIELD(:,:) = XUNDEF
+!
+ CALL TREAT_FIELD(UG, U, USS, &
+ HPROGRAM,'SURF ',HFILETYPE,'A_MESH',HFILE, &
+ YFIELD,ZFIELD )
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. Mask for the interpolations
+! ---------------------------
+!
+ DO JT=1,SIZE(NSIZE,2)
+
+ SELECT CASE (HAREA)
+
+ CASE ('LAN')
+ WHERE ((U%XTOWN(:)+U%XNATURE(:))==0. .AND. NSIZE(:,JT)==0 ) NSIZE(:,JT) = -1
+
+ CASE ('TWN')
+ WHERE (U%XTOWN (:)==0. .AND. NSIZE(:,JT)==0 ) NSIZE(:,JT) = -1
+
+ CASE ('BLD')
+ WHERE (U%XTOWN (:)==0. .AND. NSIZE(:,JT)==0 ) NSIZE(:,JT) = -1
+
+ CASE ('NAT')
+ WHERE (U%XNATURE(:)==0. .AND. NSIZE(:,JT)==0 ) NSIZE(:,JT) = -1
+ !
+ ! for fields calculated by vegtype
+ IF (PRESENT(PVEGTYPE) .AND.SIZE(NSIZE,2)>1) THEN
+ ! only for the natural part
+ IF (U%LECOSG) THEN
+ JTN = JT - SUM(NTYPE(1:2))
+ NSIZE(:,1:SUM(NTYPE(1:2))) = -1
+ ELSE
+ JTN = JT
+ ENDIF
+ IF ( JTN <= SIZE(PVEGTYPE,2) ) THEN
+ ALLOCATE(ZVEGTYPE(U%NSIZE_FULL))
+ CALL UNPACK_SAME_RANK(IMASK,PVEGTYPE(:,JTN),ZVEGTYPE)
+ WHERE (ZVEGTYPE(:)==0. .AND. NSIZE(:,JT)==0) NSIZE(:,JT) = -1
+ DEALLOCATE(ZVEGTYPE)
+ ELSE
+ NSIZE(:,JT) = -1
+ ENDIF
+ ENDIF
+
+ CASE ('SEA')
+ WHERE (U%XSEA (:)==0. .AND. NSIZE(:,JT)==0 ) NSIZE(:,JT) = -1
+
+ CASE ('WAT')
+ WHERE (U%XWATER (:)==0. .AND. NSIZE(:,JT)==0 ) NSIZE(:,JT) = -1
+
+ END SELECT
+
+ ENDDO
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. Interpolation if some points are not initialized (no data for these points)
+! ------------------------------------------------
+!
+ DO JT=1,SIZE(NSIZE,2)
+
+ IF (.NOT.U%LECOSG.AND.JT>NVEGTYPE) EXIT
+
+ !multitype input file
+ IF (SIZE(ZFIELD,2)>1) THEN
+
+ !fields defined only on the not-bare soil part
+ IF ( (YFIELD(1:3)=='LAI'.OR.YFIELD(1:10)=='ALBNIR_VEG'.OR.YFIELD(1:10)=='ALBVIS_VEG') .OR. &
+ (SIZE(ZFIELD,2)>1.AND.YFIELD(1:6)=='H_TREE') ) THEN
+
+ IF ( (.NOT.U%LECOSG.AND.JT<=3).OR.(U%LECOSG.AND.JT<=SUM(NTYPE(1:2))+3) ) THEN
+ ZFIELD(:,JT) = 0.
+ NSIZE (:,JT) = 1
+ ENDIF
+
+ ! height of trees only defined for tree vegtypes
+ IF (YFIELD(1:6)=='H_TREE') THEN
+ IF ((.NOT.U%LECOSG.AND.((JT>=7 .AND. JT<=12) .OR. (JT>=18 .AND. JT<=19))).OR. &
+ ( U%LECOSG.AND.((JT<=(SUM(NTYPE(1:2))+3).OR.JT>=(SUM(NTYPE(1:2))+13)).AND.JT/=22) ) ) THEN
+ ZFIELD(:,JT) = 0.
+ NSIZE (:,JT) = 1.
+ ENDIF
+ ENDIF
+
+ ENDIF
+
+ ! if the cover / vegtype is not present on the area
+ !ICASE = 0
+ !IF (.NOT.U%LECOSG) THEN
+ ! IF (.NOT.LVEG_PRES(JT)) ICASE=1
+ !ENDIF
+ !IF( (U%LECOSG.AND..NOT.U%LCOVER(JT)) .OR. ICASE==1 ) THEN
+ ! ZFIELD(:,JT) = 0.
+ ! NSIZE (:,JT) = 1.
+ !ENDIF
+
+ ENDIF
+
+ IF (PUNIF/=XUNDEF) THEN
+ CALL INTERPOL_FIELD(UG, U, HPROGRAM,ILUOUT,NSIZE(:,JT),ZFIELD(:,JT),HFIELD,PDEF=PUNIF,KNPTS=INPTS)
+ ELSE
+ CALL INTERPOL_FIELD(UG, U, HPROGRAM,ILUOUT,NSIZE(:,JT),ZFIELD(:,JT),HFIELD)
+ ENDIF
+
+ ENDDO
+!
+ DEALLOCATE(NSIZE )
+ DEALLOCATE(XSUMVAL )
+!
+!-------------------------------------------------------------------------------
+!
+ELSEIF (PUNIF/=XUNDEF) THEN
+!
+!* 3.1 Use of the presribed field
+! --------------------------
+!
+ ZFIELD(:,:) = PUNIF
+!
+!
+END IF
+!
+! only the case nature is treated for now, to adapt for town later
+IF (HAREA=='NAT'.AND.SIZE(ZFIELD,2)>SIZE(PFIELD,2).AND.U%LECOSG) THEN
+ CALL PACK_SAME_RANK(IMASK,ZFIELD(:,SUM(NTYPE(1:2))+1:SUM(NTYPE(1:3))),PFIELD(:,:))
+ELSE
+ CALL PACK_SAME_RANK(IMASK,ZFIELD(:,1:SIZE(PFIELD,2)),PFIELD(:,:))
+ENDIF
+!
+DEALLOCATE(ZFIELD)
+DEALLOCATE(IMASK)
+!
+IF (LHOOK) CALL DR_HOOK('PGD_FIELDIN',1,ZHOOK_HANDLE)
+
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE PGD_FIELDIN
diff --git a/src/SURFEX/pgd_flake.F90 b/src/SURFEX/pgd_flake.F90
index 464b352a657db77e3c8b4dc0e349c6eedd3daf85..3fc19755abb1f0ce0996e3988e7f5e35cf908219 100644
--- a/src/SURFEX/pgd_flake.F90
+++ b/src/SURFEX/pgd_flake.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PGD_FLAKE (DTCO, FG, F, UG, U, USS, &
- HPROGRAM,OECOCLIMAP,ORM_RIVER)
+ SUBROUTINE PGD_FLAKE (DTCO, FG, F, UG, U, USS, HPROGRAM,ORM_RIVER)
! ##############################################################
!
!!**** *PGD_FLAKE* monitor for averaging and interpolations of FLAKE physiographic fields
@@ -35,7 +34,6 @@
!!
!! Original 03/2004
!! 04/2013, P. Le Moigne : allow limitation of lake depth
-!! M. Moge 02/2015 : MPPDB_CHECK
!!
!----------------------------------------------------------------------------
!
@@ -43,14 +41,14 @@
! -----------
!
!
-!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_FLAKE_GRID_n, ONLY : FLAKE_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_FLAKE_n, ONLY : FLAKE_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_DATA_LAKE, ONLY : CLAKELDB, CSTATUSLDB
USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
@@ -73,15 +71,16 @@ USE MODI_TREAT_GLOBAL_LAKE_DEPTH
!
USE MODE_POS_SURF
!
-#ifdef MNH_PARALLEL
-USE MODE_MPPDB
-#endif
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
USE MODI_WRITE_COVER_TEX_WATER
!
+#ifdef MNH_PARALLEL
+USE MODE_MPPDB
+#endif
+!
IMPLICIT NONE
!
!* 0.1 Declaration of arguments
@@ -89,14 +88,13 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(FLAKE_GRID_t), INTENT(INOUT) :: FG
+TYPE(GRID_t), INTENT(INOUT) :: FG
TYPE(FLAKE_t), INTENT(INOUT) :: F
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
-LOGICAL, INTENT(IN) :: OECOCLIMAP
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
LOGICAL, INTENT(IN) :: ORM_RIVER ! delete river coverage (default = false)
!
!
@@ -191,27 +189,22 @@ IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_DATA_FLAKE)
!* 4. Number of points and packing
! ----------------------------
!
- CALL GET_SURF_SIZE_n(DTCO, U, &
- 'WATER ',FG%NDIM)
+ CALL GET_SURF_SIZE_n(DTCO, U, 'WATER ',FG%NDIM)
!
-ALLOCATE(F%LCOVER (JPCOVER))
-ALLOCATE(F%XZS (FG%NDIM))
+ALLOCATE(F%LCOVER (JPCOVER))
+ALLOCATE(F%XZS (FG%NDIM))
ALLOCATE(FG%XLAT (FG%NDIM))
ALLOCATE(FG%XLON (FG%NDIM))
ALLOCATE(FG%XMESH_SIZE (FG%NDIM))
!
- CALL PACK_PGD(DTCO, U, &
- HPROGRAM, 'WATER ', &
- FG%CGRID, FG%XGRID_PAR, &
- F%LCOVER, F%XCOVER, F%XZS, &
- FG%XLAT, FG%XLON, FG%XMESH_SIZE )
+ CALL PACK_PGD(DTCO, U, HPROGRAM, 'WATER ', FG, F%LCOVER, F%XCOVER, F%XZS )
+!
#ifdef MNH_PARALLEL
CALL MPPDB_CHECK_SURFEX3D(F%XCOVER,"PGD_FLAKE after PACK_PGD:XCOVER",PRECISION,ILUOUT,'WATER',SIZE(F%XCOVER,2))
CALL MPPDB_CHECK_SURFEX2D(FG%XLAT,"PGD_FLAKE after PACK_PGD:XLAT",PRECISION,ILUOUT,'WATER')
CALL MPPDB_CHECK_SURFEX2D(FG%XLON,"PGD_FLAKE after PACK_PGD:XLON",PRECISION,ILUOUT,'WATER')
CALL MPPDB_CHECK_SURFEX2D(FG%XMESH_SIZE,"PGD_FLAKE after PACK_PGD:XMESH_SIZE",PRECISION,ILUOUT,'WATER')
#endif
-!
!-------------------------------------------------------------------------------
!
!* 5. Water depth
@@ -236,7 +229,7 @@ IF (TRIM(YWATER_DEPTH)==TRIM(CLAKELDB) .AND. TRIM(YWATER_DEPTHFILETYPE)=='DIRECT
!
ELSE
!
- IF(OECOCLIMAP.AND.(.NOT.ORM_RIVER))THEN
+ IF(U%LECOCLIMAP.AND.(.NOT.ORM_RIVER))THEN
WRITE(ILUOUT,*)'With this version of Flake, river must be removed'
WRITE(ILUOUT,*)'Indeed, river energy budget can not be computed '
WRITE(ILUOUT,*)'using static lake scheme without 2D informations.'
@@ -265,8 +258,8 @@ WRITE(ILUOUT,*)'MAXIMUM LAKE DEPTH = ',XMAX_DEPTH
!
ALLOCATE(F%XWATER_FETCH (FG%NDIM))
!
- CATYPE='ARI'
- CALL PGD_FIELD(DTCO, UG, U, USS, &
+CATYPE='ARI'
+CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'wind fetch','WAT',YWATER_FETCH,YWATER_FETCHFILETYPE,XUNIF_WATER_FETCH,F%XWATER_FETCH(:))
!
!-------------------------------------------------------------------------------
@@ -276,8 +269,8 @@ ALLOCATE(F%XWATER_FETCH (FG%NDIM))
!
ALLOCATE(F%XT_BS (FG%NDIM))
!
- CATYPE='ARI'
- CALL PGD_FIELD(DTCO, UG, U, USS, &
+CATYPE='ARI'
+CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'sediments bottom temperature ','WAT',YT_BS,YT_BSFILETYPE,XUNIF_T_BS,F%XT_BS(:))
!
!-------------------------------------------------------------------------------
@@ -287,8 +280,8 @@ ALLOCATE(F%XT_BS (FG%NDIM))
!
ALLOCATE(F%XDEPTH_BS (FG%NDIM))
!
- CATYPE='INV'
- CALL PGD_FIELD(DTCO, UG, U, USS, &
+CATYPE='INV'
+CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'depth of sediments layer','WAT',YDEPTH_BS,YDEPTH_BSFILETYPE,XUNIF_DEPTH_BS,F%XDEPTH_BS(:))
!
!-------------------------------------------------------------------------------
@@ -298,8 +291,8 @@ ALLOCATE(F%XDEPTH_BS (FG%NDIM))
ALLOCATE(F%XEXTCOEF_WATER(FG%NDIM))
!
- CATYPE='ARI'
- CALL PGD_FIELD(DTCO, UG, U, USS, &
+CATYPE='ARI'
+CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'water extinction coefficient','WAT', &
YEXTCOEF_WATER,YEXTCOEF_WATERFILETYPE,XUNIF_EXTCOEF_WATER, &
F%XEXTCOEF_WATER(:))
@@ -309,7 +302,7 @@ ALLOCATE(F%XEXTCOEF_WATER(FG%NDIM))
!* 10. Prints of flake parameters in a tex file
! ----------------------------------------
!
- CALL WRITE_COVER_TEX_WATER
+IF (NRANK==NPIO) CALL WRITE_COVER_TEX_WATER
!
IF (LHOOK) CALL DR_HOOK('PGD_FLAKE',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/pgd_frac.F90 b/src/SURFEX/pgd_frac.F90
index bcb138b15424ca37a92ad9e90995e8f09093c535..78c5d5cf731f3302d2223e41651d3d6352340733 100644
--- a/src/SURFEX/pgd_frac.F90
+++ b/src/SURFEX/pgd_frac.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PGD_FRAC (DTCO, UG, U, USS, &
- HPROGRAM,OECOCLIMAP)
+ SUBROUTINE PGD_FRAC (DTCO, UG, U, USS, HPROGRAM)
! ##############################################################
!
!!**** *PGD_FRAC* monitor for averaging and interpolations of cover fractions
@@ -47,11 +46,11 @@
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_PGD_GRID, ONLY : NL, CGRID
-USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
+USE MODD_DATA_COVER_PAR, ONLY : JPCOVER, NCOVER, NTYPE
!
USE MODD_PGDWORK, ONLY : CATYPE
!
@@ -78,11 +77,9 @@ IMPLICIT NONE
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
-LOGICAL, INTENT(OUT) :: OECOCLIMAP ! F if fractions prescribed by user
-! ! T if fractions will be computed from ecoclimap
!
!* 0.2 Declaration of local variables
! ------------------------------
@@ -99,6 +96,7 @@ REAL, DIMENSION(NL) :: ZSUM ! sum of 4 tiles fractions
! ------------------------
!
LOGICAL :: LECOCLIMAP ! F if ecoclimap is not used
+LOGICAL :: LECOSG ! F if ecosg is not used
REAL :: XUNIF_SEA ! value of sea fraction
REAL :: XUNIF_WATER ! value of water fraction
REAL :: XUNIF_NATURE! value of nature fraction
@@ -118,6 +116,7 @@ REAL :: XUNIF_TOWN ! value of town fraction
CHARACTER(LEN=6) :: CFTYP_NATURE ! type of nature file
CHARACTER(LEN=6) :: CFTYP_TOWN ! type of town file
!
+INTEGER, DIMENSION(4) :: ID_COV
INTEGER :: ICOVER ! 0 if cover is not present, >1 if present somewhere
! ! (even on another processor)
INTEGER :: ICPT
@@ -125,10 +124,10 @@ INTEGER :: ICPT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
-NAMELIST/NAM_FRAC/ LECOCLIMAP, &
- XUNIF_SEA, XUNIF_WATER, XUNIF_NATURE, XUNIF_TOWN, &
- CFNAM_SEA, CFNAM_WATER, CFNAM_NATURE, CFNAM_TOWN, &
- CFTYP_SEA, CFTYP_WATER, CFTYP_NATURE, CFTYP_TOWN
+NAMELIST/NAM_FRAC/ LECOCLIMAP, LECOSG, &
+ XUNIF_SEA, XUNIF_WATER, XUNIF_NATURE, XUNIF_TOWN, &
+ CFNAM_SEA, CFNAM_WATER, CFNAM_NATURE, CFNAM_TOWN, &
+ CFTYP_SEA, CFTYP_WATER, CFTYP_NATURE, CFTYP_TOWN
!-------------------------------------------------------------------------------
!
!* 1. Initializations
@@ -140,16 +139,18 @@ XUNIF_WATER = XUNDEF
XUNIF_NATURE = XUNDEF
XUNIF_TOWN = XUNDEF
LECOCLIMAP = .TRUE.
- CFNAM_SEA (:)= ' '
- CFNAM_WATER (:)= ' '
- CFNAM_NATURE(:)= ' '
- CFNAM_TOWN (:)= ' '
- CFTYP_SEA (:)= ' '
- CFTYP_WATER (:)= ' '
- CFTYP_NATURE(:)= ' '
- CFTYP_TOWN (:)= ' '
-!
-OECOCLIMAP = .TRUE.
+LECOSG = .FALSE.
+CFNAM_SEA (:)= ' '
+CFNAM_WATER (:)= ' '
+CFNAM_NATURE(:)= ' '
+CFNAM_TOWN (:)= ' '
+CFTYP_SEA (:)= ' '
+CFTYP_WATER (:)= ' '
+CFTYP_NATURE(:)= ' '
+CFTYP_TOWN (:)= ' '
+!
+U%LECOCLIMAP = .TRUE.
+U%LECOSG = .FALSE.
!
!-------------------------------------------------------------------------------
!
@@ -164,6 +165,8 @@ IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_FRAC)
!
CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
!
+U%LECOSG = LECOSG
+!
!-------------------------------------------------------------------------------
!
IF ((LEN_TRIM(CFNAM_SEA)/=0 .OR. XUNIF_SEA/=XUNDEF) .AND. (LEN_TRIM(CFNAM_WATER)/=0 .OR. XUNIF_WATER/=XUNDEF) .AND. &
@@ -265,53 +268,67 @@ U%XTOWN(:) = U%XTOWN(:) / ZSUM(:)
WRITE(ILUOUT,*) ' '
!-------------------------------------------------------------------------------
!
-OECOCLIMAP = LECOCLIMAP
+U%LECOCLIMAP = LECOCLIMAP
!
!* 5. List of cover present
! ---------------------
!
IF (.NOT.LECOCLIMAP) THEN
+ IF (.NOT.LECOSG) THEN
+ ID_COV(1) = 1
+ ID_COV(2) = 2
+ ID_COV(3) = 4
+ ID_COV(4) = 151
+ JPCOVER = NCOVER
+ ELSE
+ ID_COV(1) = 21
+ ID_COV(2) = 22
+ ID_COV(3) = 1
+ ID_COV(4) = 20
+ JPCOVER = SUM(NTYPE)
+ ENDIF
+
ALLOCATE(U%LCOVER(JPCOVER))
U%LCOVER(:) = .FALSE.
ICOVER = 0
ICPT= SUM_ON_ALL_PROCS(HPROGRAM,CGRID,U%XSEA(:)/=0. ,'COV')
IF (ICPT/=0) THEN
- U%LCOVER(1) = .TRUE.
+ U%LCOVER(ID_COV(1)) = .TRUE.
ICOVER=ICOVER+1
ENDIF
ICPT= SUM_ON_ALL_PROCS(HPROGRAM,CGRID,U%XWATER(:)/=0. ,'COV')
IF (ICPT/=0) THEN
- U%LCOVER(2) = .TRUE.
+ U%LCOVER(ID_COV(2)) = .TRUE.
ICOVER=ICOVER+1
ENDIF
ICPT= SUM_ON_ALL_PROCS(HPROGRAM,CGRID,U%XNATURE(:)/=0. ,'COV')
IF (ICPT/=0) THEN
- U%LCOVER(4) = .TRUE.
+ U%LCOVER(ID_COV(3)) = .TRUE.
ICOVER=ICOVER+1
ENDIF
ICPT= SUM_ON_ALL_PROCS(HPROGRAM,CGRID,U%XTOWN(:)/=0. ,'COV')
IF (ICPT/=0) THEN
- U%LCOVER(151) = .TRUE.
+ U%LCOVER(ID_COV(4)) = .TRUE.
ICOVER=ICOVER+1
ENDIF
ALLOCATE(U%XCOVER (NL,ICOVER))
ICPT = 0
- IF (U%LCOVER(1)) THEN
+ IF (U%LCOVER(ID_COV(1))) THEN
ICPT = ICPT + 1
U%XCOVER(:,ICPT) = U%XSEA(:)
ENDIF
- IF (U%LCOVER(2)) THEN
+ IF (U%LCOVER(ID_COV(2))) THEN
ICPT = ICPT + 1
U%XCOVER(:,ICPT) = U%XWATER(:)
ENDIF
- IF (U%LCOVER(4)) THEN
+ IF (U%LCOVER(ID_COV(3))) THEN
ICPT = ICPT + 1
U%XCOVER(:,ICPT) = U%XNATURE(:)
ENDIF
- IF (U%LCOVER(151)) THEN
+ IF (U%LCOVER(ID_COV(4))) THEN
ICPT = ICPT + 1
U%XCOVER(:,ICPT) = U%XTOWN(:)
ENDIF
diff --git a/src/SURFEX/pgd_gauss_index.F90 b/src/SURFEX/pgd_gauss_index.F90
deleted file mode 100644
index ad61909b7db52ee69c508741ccf7ae2a0e3a81db..0000000000000000000000000000000000000000
--- a/src/SURFEX/pgd_gauss_index.F90
+++ /dev/null
@@ -1,11 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE PGD_GAUSS_INDEX
-! #########################################
-!!
-!!! to be suppressed
-!
-END SUBROUTINE PGD_GAUSS_INDEX
diff --git a/src/SURFEX/pgd_grid.F90 b/src/SURFEX/pgd_grid.F90
index f4759b145d05d1342295a33b414fb038a7432143..5a7158fc109dd922e185beef9c6b51261a77ee8e 100644
--- a/src/SURFEX/pgd_grid.F90
+++ b/src/SURFEX/pgd_grid.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PGD_GRID (&
- UG, U,GCP, &
- HPROGRAM,HFILE,HFILETYPE,OGRID,HGRID,KGRID_PAR,PGRID_PAR)
+ SUBROUTINE PGD_GRID (UG, U, GCP, HPROGRAM,HFILE,HFILETYPE,OGRID,HDIR)
! ##########################################################
!!
!! PURPOSE
@@ -45,17 +43,11 @@
!* 0. DECLARATION
! -----------
!
-!
-!
-!
-!
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY :GRID_CONF_PROJ_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
-USE MODD_SURFEX_MPI, ONLY : NSIZE, NINDEX, NPIO, NRANK
-USE MODD_SURFEX_OMP, ONLY : NINDX2SFX, NWORK, NWORK2, XWORK, XWORK2, XWORK3, &
- NWORK_FULL, NWORK2_FULL, XWORK_FULL, XWORK2_FULL
+USE MODD_SURFEX_MPI, ONLY : NSIZE, NPIO, NRANK, NCOMM, NPROC
!
USE MODD_PGD_GRID, ONLY : NL, XGRID_PAR, NGRID_PAR, XMESHLENGTH
USE MODN_PGD_GRID
@@ -69,35 +61,33 @@ USE MODI_CLOSE_NAMELIST
USE MODI_GET_LUOUT
USE MODI_READ_NAM_GRIDTYPE
USE MODI_LATLON_GRID
+USE MODI_ABOR1_SFX
+USE MODI_PGD_GRID_IO_INIT
+USE MODI_GATHER_AND_WRITE_MPI
!
USE MODE_POS_SURF
!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODI_ABOR1_SFX
-!
-USE MODI_PGD_GRID_IO_INIT
#ifdef MNH_PARALLEL
+USE MODD_CONF, ONLY : CPROGRAM
USE MODE_TOOLS_ll, ONLY : GET_MEAN_OF_COORD_SQRT_ll
!
USE MODI_GET_SIZE_FULL_n
-#ifdef MNH_PARALLEL
-USE MODE_MPPDB
-#endif
USE MODI_SPLIT_GRID
-USE MODD_CONF, ONLY : CPROGRAM
+USE MODE_MPPDB
#endif
!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1 Declaration of dummy arguments
! ------------------------------
!
-!
-!
-!
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
@@ -106,20 +96,26 @@ TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
CHARACTER(LEN=28), INTENT(IN) :: HFILE ! atmospheric file name
CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! atmospheric file type
LOGICAL, INTENT(IN) :: OGRID ! .true. if grid is imposed by atm. model
- CHARACTER(LEN=10), INTENT(OUT) :: HGRID ! grid type
-INTEGER, INTENT(OUT) :: KGRID_PAR ! size of PGRID_PAR
-REAL, DIMENSION(:), POINTER :: PGRID_PAR ! parameters defining this grid
+ CHARACTER(LEN=1), INTENT(IN), OPTIONAL :: HDIR
!
!
!* 0.2 Declaration of local variables
! ------------------------------
!
-INTEGER :: ILUOUT ! output listing logical unit
-INTEGER :: ILUNAM ! namelist file logical unit
-LOGICAL :: GFOUND ! Flag true if namelist is present
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL, DIMENSION(:), ALLOCATABLE :: ZMESH_SIZE
+ CHARACTER(LEN=1) :: YDIR
+INTEGER :: ILUOUT ! output listing logical unit
+INTEGER :: ILUNAM ! namelist file logical unit
INTEGER :: IIMAX_ll, IJMAX_ll ! global size of son model
+INTEGER :: ISIZE_FULL
+LOGICAL :: GFOUND ! Flag true if namelist is present
LOGICAL :: GRECT
+INTEGER :: INFOMPI
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!* 0.3 Declaration of namelists
+! ------------------------
!
INTEGER :: IXOR = 1 ! position of modified bottom left point
INTEGER :: IYOR = 1 ! according to initial grid
@@ -129,15 +125,18 @@ LOGICAL :: GRECT
INTEGER :: IDYRATIO = 1 ! and initial grid
NAMELIST/NAM_INIFILE_CONF_PROJ/IXOR,IYOR,IXSIZE,IYSIZE,IDXRATIO,IDYRATIO
!
-!* 0.3 Declaration of namelists
-! ------------------------
-!
!------------------------------------------------------------------------------
!
!* 1. Defaults
! --------
!
IF (LHOOK) CALL DR_HOOK('PGD_GRID',0,ZHOOK_HANDLE)
+!
+YDIR = 'H'
+IF (PRESENT(HDIR)) YDIR = HDIR
+!
+IF (ASSOCIATED(XGRID_PAR)) DEALLOCATE(XGRID_PAR)
+!
CALL DEFAULT_GRID(HPROGRAM,CGRID)
!
YINIFILE = ' '
@@ -155,6 +154,7 @@ END IF
! -------------
!
IF (.NOT. OGRID) THEN
+!
CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
!
!------------------------------------------------------------------------------
@@ -192,15 +192,20 @@ END IF
! -----------------
!
IF (LEN_TRIM(YINIFILETYPE)>0 .AND. LEN_TRIM(YINIFILE)>0 ) THEN
+ !
IF (YINIFILETYPE=='MESONH' .OR. YINIFILETYPE=='LFI ' .OR. YINIFILETYPE=='ASCII ' .OR. YINIFILETYPE=='NC ') THEN
- CALL GRID_FROM_FILE(&
- HPROGRAM,YINIFILE,YINIFILETYPE,OGRID,CGRID,NGRID_PAR,XGRID_PAR,NL,U)
- HGRID = CGRID
- IF ( HGRID == "IGN " .OR. HGRID == "GAUSS " .OR. HGRID == "NONE " ) THEN
+ !
+ CALL GRID_FROM_FILE(U,GCP,UG%XGRID_FULL_PAR,HPROGRAM,YINIFILE,YINIFILETYPE,&
+ OGRID,CGRID,NGRID_PAR,XGRID_PAR,NL,YDIR)
+ !
+ UG%G%CGRID = CGRID
+ !
+ IF ( CGRID == "IGN " .OR. CGRID == "GAUSS " .OR. CGRID == "NONE " ) THEN
GRECT = .FALSE.
ELSE
GRECT = .TRUE.
ENDIF
+ !
! on lit la taille globale du modele fils dans la namelist
CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
CALL POSNAM(ILUNAM,'NAM_INIFILE_CONF_PROJ',GFOUND,ILUOUT)
@@ -210,31 +215,31 @@ IF (LEN_TRIM(YINIFILETYPE)>0 .AND. LEN_TRIM(YINIFILE)>0 ) THEN
IJMAX_ll = IYSIZE*IDYRATIO
ENDIF
CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
-
+ !
!* 3. Additional actions for I/O
!
IF (GFOUND) THEN
#ifdef MNH_PARALLEL
- CALL PGD_GRID_IO_INIT(HPROGRAM,NGRID_PAR,XGRID_PAR, HGRID, GRECT, IIMAX_ll, IJMAX_ll, IDXRATIO, IDYRATIO)
+ CALL PGD_GRID_IO_INIT(HPROGRAM,UG,NGRID_PAR,XGRID_PAR,CGRID,GRECT,IIMAX_ll,IJMAX_ll,IDXRATIO,IDYRATIO)
#else
- CALL PGD_GRID_IO_INIT(HPROGRAM)
+ CALL PGD_GRID_IO_INIT(HPROGRAM,UG)
#endif
- U%NDIM_FULL = NL
+ IF (YDIR/='H') U%NDIM_FULL = NL
ELSE
#ifdef MNH_PARALLEL
- CALL PGD_GRID_IO_INIT(HPROGRAM,NGRID_PAR,XGRID_PAR, HGRID, GRECT)
+ CALL PGD_GRID_IO_INIT(HPROGRAM,UG,NGRID_PAR,XGRID_PAR,CGRID,GRECT)
#else
- CALL PGD_GRID_IO_INIT(HPROGRAM)
+ CALL PGD_GRID_IO_INIT(HPROGRAM,UG)
#endif
ENDIF
- NSIZE = U%NDIM_FULL
+ !
#ifdef MNH_PARALLEL
- CALL GET_SIZE_FULL_n(U,HPROGRAM,U%NDIM_FULL,U%NSIZE_FULL)
+ CALL GET_SIZE_FULL_n(HPROGRAM,U%NDIM_FULL,U%NSIZE_FULL,ISIZE_FULL)
+ U%NSIZE_FULL = ISIZE_FULL
NL = U%NSIZE_FULL
#else
- U%NSIZE_FULL = NL
+ U%NSIZE_FULL = NL
#endif
-
ELSE
CALL ABOR1_SFX('PGD_GRID: FILE TYPE NOT SUPPORTED '//HFILETYPE//' FOR FILE '//HFILE)
END IF
@@ -253,76 +258,65 @@ ELSE
!
ELSE
!
- CALL READ_NAM_GRIDTYPE(HPROGRAM,CGRID,NGRID_PAR,XGRID_PAR,NL,GCP)
- HGRID = CGRID
+ CALL READ_NAM_GRIDTYPE(GCP,UG%XGRID_FULL_PAR,U%NDIM_FULL,HPROGRAM,CGRID,NGRID_PAR,XGRID_PAR,NL,YDIR)
+!
!* 3. Additional actions for I/O
!
+ UG%G%CGRID = CGRID
+ !
#ifdef MNH_PARALLEL
- CALL PGD_GRID_IO_INIT(HPROGRAM,NGRID_PAR,XGRID_PAR)
+ CALL PGD_GRID_IO_INIT(HPROGRAM,UG,NGRID_PAR,XGRID_PAR)
#else
- CALL PGD_GRID_IO_INIT(HPROGRAM)
+ CALL PGD_GRID_IO_INIT(HPROGRAM,UG)
#endif
- U%NDIM_FULL = NL
- NSIZE = U%NDIM_FULL
+ IF (YDIR/='H') U%NDIM_FULL = NL
#ifdef MNH_PARALLEL
- CALL GET_SIZE_FULL_n(U,HPROGRAM,U%NDIM_FULL,U%NSIZE_FULL)
+ CALL GET_SIZE_FULL_n(HPROGRAM,NL,U%NSIZE_FULL,ISIZE_FULL)
+ U%NSIZE_FULL = ISIZE_FULL
NL = U%NSIZE_FULL
-#else
- U%NSIZE_FULL = NL
#endif
- END IF
+ !
+ END IF
+
#ifdef MNH_PARALLEL
! IF we are in PREP_PGD, we need to split the grid. Otherwise, the grid was read in parallel and is already splitted
IF ( CPROGRAM == 'PGD ') THEN
CALL SPLIT_GRID(UG,U,'MESONH',NGRID_PAR,XGRID_PAR)
ENDIF
#endif
-
+
END IF
!
-!
-IF (.NOT.ALLOCATED(NINDEX)) THEN
- ALLOCATE(NINDEX(U%NDIM_FULL))
- NINDEX(:) = 0
-ENDIF
-NINDX2SFX = U%NDIM_FULL
-ALLOCATE(NWORK(U%NDIM_FULL))
-ALLOCATE(XWORK(U%NDIM_FULL))
-ALLOCATE(NWORK2(U%NDIM_FULL,10))
-ALLOCATE(XWORK2(U%NDIM_FULL,10))
-ALLOCATE(XWORK3(U%NDIM_FULL,10,10))
-IF (NRANK==NPIO) THEN
- ALLOCATE(NWORK_FULL(U%NDIM_FULL))
- ALLOCATE(XWORK_FULL(U%NDIM_FULL))
- ALLOCATE(NWORK2_FULL(U%NDIM_FULL,10))
- ALLOCATE(XWORK2_FULL(U%NDIM_FULL,10))
+IF (HDIR=='A') THEN
+ UG%NGRID_FULL_PAR = NGRID_PAR
+ ALLOCATE(UG%XGRID_FULL_PAR(UG%NGRID_FULL_PAR))
+ UG%XGRID_FULL_PAR = XGRID_PAR
ELSE
- ALLOCATE(NWORK_FULL(0))
- ALLOCATE(XWORK_FULL(0))
- ALLOCATE(NWORK2_FULL(0,0))
- ALLOCATE(XWORK2_FULL(0,0))
+ UG%G%NGRID_PAR = NGRID_PAR
+ ALLOCATE(UG%G%XGRID_PAR(UG%G%NGRID_PAR))
+ UG%G%XGRID_PAR = XGRID_PAR
ENDIF
!
-KGRID_PAR = NGRID_PAR
-ALLOCATE(PGRID_PAR(KGRID_PAR))
-PGRID_PAR = XGRID_PAR
+IF (YDIR=='A') THEN
+ CALL DR_HOOK('PGD_GRID',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
!
!------------------------------------------------------------------------------
!
!* 6. Latitude and longitude
! ----------------------
!
-ALLOCATE(UG%XLAT (U%NSIZE_FULL))
-ALLOCATE(UG%XLON (U%NSIZE_FULL))
-ALLOCATE(UG%XMESH_SIZE (U%NSIZE_FULL))
-ALLOCATE(UG%XJPDIR (U%NSIZE_FULL))
- CALL LATLON_GRID(CGRID,NGRID_PAR,U%NSIZE_FULL,ILUOUT,XGRID_PAR,UG%XLAT,UG%XLON,UG%XMESH_SIZE,UG%XJPDIR)
+ALLOCATE(UG%G%XLAT (NL))
+ALLOCATE(UG%G%XLON (NL))
+ALLOCATE(UG%G%XMESH_SIZE (NL))
+ALLOCATE(UG%XJPDIR (NL))
+ CALL LATLON_GRID(UG%G,NL,UG%XJPDIR)
#ifdef MNH_PARALLEL
- CALL MPPDB_CHECK_SURFEX2D(UG%XLAT,"PGD_GRID after LATLON_GRID:XLAT",PRECISION,ILUOUT)
- CALL MPPDB_CHECK_SURFEX2D(UG%XLON,"PGD_GRID after LATLON_GRID:XLON",PRECISION,ILUOUT)
- CALL MPPDB_CHECK_SURFEX2D(UG%XMESH_SIZE,"PGD_GRID after LATLON_GRID:XMESH_SIZE",PRECISION,ILUOUT)
-#endif
-!
+ CALL MPPDB_CHECK_SURFEX2D(UG%G%XLAT,"PGD_GRID after LATLON_GRID:XLAT",PRECISION,ILUOUT)
+ CALL MPPDB_CHECK_SURFEX2D(UG%G%XLON,"PGD_GRID after LATLON_GRID:XLON",PRECISION,ILUOUT)
+ CALL MPPDB_CHECK_SURFEX2D(UG%G%XMESH_SIZE,"PGD_GRID after LATLON_GRID:XMESH_SIZE",PRECISION,ILUOUT)
+#endif!
!------------------------------------------------------------------------------
!
!* 7. Average grid length (in degrees)
@@ -330,9 +324,17 @@ ALLOCATE(UG%XJPDIR (U%NSIZE_FULL))
!
!* in meters
#ifdef MNH_PARALLEL
-CALL GET_MEAN_OF_COORD_SQRT_ll(UG%XMESH_SIZE,U%NSIZE_FULL,U%NDIM_FULL,XMESHLENGTH)
+ CALL GET_MEAN_OF_COORD_SQRT_ll(UG%G%XMESH_SIZE,U%NSIZE_FULL,U%NDIM_FULL,XMESHLENGTH)
#else
-XMESHLENGTH = SUM ( SQRT(UG%XMESH_SIZE) ) / NL
+IF (NRANK==NPIO) ALLOCATE(ZMESH_SIZE(U%NDIM_FULL))
+CALL GATHER_AND_WRITE_MPI(UG%G%XMESH_SIZE,ZMESH_SIZE)
+IF (NRANK==NPIO) XMESHLENGTH = SUM ( SQRT(ZMESH_SIZE) ) / MAX(U%NDIM_FULL,1)
+IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(XMESHLENGTH,KIND(XMESHLENGTH)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+#endif
+ENDIF
+IF (NRANK==NPIO) DEALLOCATE(ZMESH_SIZE)
#endif
!
!* in degrees (of latitude)
diff --git a/src/SURFEX/pgd_grid_io_init.F90 b/src/SURFEX/pgd_grid_io_init.F90
index e077108581f15915adb793b15f93f90ebb47067b..05a15cd95495542e355e303492d0dce82d0ac8ed 100644
--- a/src/SURFEX/pgd_grid_io_init.F90
+++ b/src/SURFEX/pgd_grid_io_init.F90
@@ -3,11 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-#ifdef MNH_PARALLEL
- SUBROUTINE PGD_GRID_IO_INIT(HPROGRAM,KGRID_PAR,PGRID_PAR,HGRID,ORECT,KIMAX,KJMAX,KDXRATIO,KDYRATIO)
-#else
- SUBROUTINE PGD_GRID_IO_INIT(HPROGRAM)
-#endif
+ SUBROUTINE PGD_GRID_IO_INIT(HPROGRAM,UG,KGRID_PAR,PGRID_PAR,HGRID,ORECT,KIMAX,KJMAX,KDXRATIO,KDYRATIO)
! ######################################
!!
!! PURPOSE
@@ -44,6 +40,7 @@
!* 0. DECLARATION
! -----------
!
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -57,9 +54,11 @@ IMPLICIT NONE
! ------------------------------
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling READ_PGD
-#ifdef MNH_PARALLEL
- INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
- REAL, DIMENSION(KGRID_PAR), INTENT(IN) :: PGRID_PAR ! grid parameters
+!
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+!
+ INTEGER, OPTIONAL, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
+ REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PGRID_PAR ! grid parameters
CHARACTER(LEN=10), INTENT(IN), OPTIONAL :: HGRID
LOGICAL, INTENT(IN), OPTIONAL :: ORECT
! if KIMAX,KJMAX,KDXRATIO,KDYRATIO present, this means we are in PREP_PGD, and we only initialise the child model,
@@ -68,7 +67,7 @@ IMPLICIT NONE
INTEGER, INTENT(IN), OPTIONAL :: KJMAX
INTEGER, INTENT(IN), OPTIONAL :: KDXRATIO
INTEGER, INTENT(IN), OPTIONAL :: KDYRATIO
-#endif
+!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
@@ -79,18 +78,22 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PGD_GRID_IO_INIT',0,ZHOOK_HANDLE)
IF (HPROGRAM=='MESONH') THEN
-#ifdef MNH_PARALLEL
- IF ( PRESENT(KIMAX) .AND. PRESENT(KJMAX) .AND. PRESENT(HGRID) .AND. PRESENT(ORECT) &
- .AND. PRESENT(KDXRATIO) .AND. PRESENT(KDYRATIO) ) THEN
- CALL PGD_GRID_IO_INIT_MNH(KGRID_PAR,PGRID_PAR,HGRID,ORECT,KIMAX,KJMAX,KDXRATIO,KDYRATIO)
+ IF (PRESENT(KGRID_PAR).AND.PRESENT(PGRID_PAR)) THEN
+#ifdef MNH_PARALLEL
+ IF ( PRESENT(KIMAX) .AND. PRESENT(KJMAX) .AND. PRESENT(HGRID) .AND. PRESENT(ORECT) &
+ .AND. PRESENT(KDXRATIO) .AND. PRESENT(KDYRATIO) ) THEN
+ CALL PGD_GRID_IO_INIT_MNH(UG,KGRID_PAR,PGRID_PAR,HGRID,ORECT,KIMAX,KJMAX,KDXRATIO,KDYRATIO)
+ ELSE
+ CALL PGD_GRID_IO_INIT_MNH(UG,KGRID_PAR,PGRID_PAR)
+ ENDIF
+#endif
ELSE
- CALL PGD_GRID_IO_INIT_MNH(KGRID_PAR,PGRID_PAR)
- ENDIF
-#else
+#ifndef MNH_PARALLEL
#ifdef SFX_MNH
- CALL PGD_GRID_IO_INIT_MNH
+ CALL PGD_GRID_IO_INIT_MNH(UG)
#endif
#endif
+ ENDIF
END IF
IF (LHOOK) CALL DR_HOOK('PGD_GRID_IO_INIT',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/pgd_grid_surf_atm.F90 b/src/SURFEX/pgd_grid_surf_atm.F90
index 6ad8d634c9ca66e5494f4da4385f13371ecb199a..72e5906bb4ce580e05d7287067eb301658e6d5ea 100644
--- a/src/SURFEX/pgd_grid_surf_atm.F90
+++ b/src/SURFEX/pgd_grid_surf_atm.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###########################################################
- SUBROUTINE PGD_GRID_SURF_ATM (&
- UG, U,GCP, &
- HPROGRAM,HFILE,HFILETYPE,OGRID)
+ SUBROUTINE PGD_GRID_SURF_ATM (UG, U, GCP, HPROGRAM,HFILE,HFILETYPE,OGRID,HDIR)
! ###########################################################
!!
!! PURPOSE
@@ -41,18 +39,15 @@
!* 0. DECLARATION
! -----------
!
-!
-!
-!
-!
+USE MODD_SURFEX_MPI, ONLY : NRANK
!
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY :GRID_CONF_PROJ_t
+USE MODD_GRID_CONF_PROJ_n, ONLY :GRID_CONF_PROJ_t
!
USE MODD_SURF_PAR, ONLY : NVERSION, NBUGFIX
USE MODD_SURF_CONF, ONLY : CPROGNAME
-USE MODD_PGD_GRID, ONLY : LLATLONMASK, NL
+USE MODD_PGD_GRID, ONLY : LLATLONMASK, NL, NGRID_PAR
!
USE MODI_PGD_GRID
USE MODI_INI_CSTS
@@ -67,9 +62,6 @@ IMPLICIT NONE
!* 0.1 Declaration of dummy arguments
! ------------------------------
!
-!
-!
-!
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
@@ -78,17 +70,23 @@ TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
CHARACTER(LEN=28), INTENT(IN) :: HFILE ! atmospheric file name
CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE! atmospheric file type
LOGICAL, INTENT(IN) :: OGRID ! .true. if grid is imposed by atm. model
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ CHARACTER(LEN=1), INTENT(IN), OPTIONAL :: HDIR
!
!
!* 0.2 Declaration of local variables
! ------------------------------
!
+ CHARACTER(LEN=1) :: YDIR
CHARACTER(LEN=100) :: YCOMMENT
INTEGER :: IRESP ! error return code
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('PGD_GRID_SURF_ATM',0,ZHOOK_HANDLE)
- CPROGNAME=HPROGRAM
+!
+YDIR = 'A'
+IF (PRESENT(HDIR)) YDIR=HDIR
+!
+CPROGNAME=HPROGRAM
!
!* 1. Set default constant values
! ---------------------------
@@ -102,17 +100,8 @@ IF (LHOOK) CALL DR_HOOK('PGD_GRID_SURF_ATM',0,ZHOOK_HANDLE)
!* 2. Initialisation of output grid
! -----------------------------
!
- CALL PGD_GRID(&
- UG, U,GCP, &
- HPROGRAM,HFILE,HFILETYPE,OGRID,UG%CGRID,UG%NGRID_PAR,UG%XGRID_PAR)
+ CALL PGD_GRID(UG, U, GCP, HPROGRAM,HFILE,HFILETYPE,OGRID,YDIR)
!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 3. Additional actions for I/O
-!
-!
IF (LHOOK) CALL DR_HOOK('PGD_GRID_SURF_ATM',1,ZHOOK_HANDLE)
!_______________________________________________________________________________
!
diff --git a/src/SURFEX/pgd_inland_water.F90 b/src/SURFEX/pgd_inland_water.F90
index 0b108908c2b15a02e3fc103718d3fbd63d6dac99..6c6ec569017608b9dc6ce4481772ed7765b12e39 100644
--- a/src/SURFEX/pgd_inland_water.F90
+++ b/src/SURFEX/pgd_inland_water.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PGD_INLAND_WATER (DTCO, FG, F, UG, U, USS, WG, W, &
- HPROGRAM,OECOCLIMAP,ORM_RIVER)
+ SUBROUTINE PGD_INLAND_WATER (DTCO, FG, F, UG, U, USS, WG, W, HPROGRAM,ORM_RIVER)
! #############################################################
!
!!**** *PGD_INLAND_WATER* - routine to choose initialization of lake scheme
@@ -44,12 +43,11 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_FLAKE_GRID_n, ONLY : FLAKE_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_FLAKE_n, ONLY : FLAKE_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_WATFLUX_GRID_n, ONLY : WATFLUX_GRID_t
+USE MODD_SSO_n, ONLY : SSO_t
USE MODD_WATFLUX_n, ONLY : WATFLUX_t
!
USE MODI_PGD_WATFLUX
@@ -67,16 +65,15 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(FLAKE_GRID_t), INTENT(INOUT) :: FG
+TYPE(GRID_t), INTENT(INOUT) :: FG
TYPE(FLAKE_t), INTENT(INOUT) :: F
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(WATFLUX_GRID_t), INTENT(INOUT) :: WG
+TYPE(SSO_t), INTENT(INOUT) :: USS
+TYPE(GRID_t), INTENT(INOUT) :: WG
TYPE(WATFLUX_t), INTENT(INOUT) :: W
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-LOGICAL, INTENT(IN) :: OECOCLIMAP
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
LOGICAL, INTENT(IN) :: ORM_RIVER ! delete river coverage (default = false)
!
!* 0.2 Declarations of local variables
@@ -98,11 +95,9 @@ ELSE IF (U%CWATER=='FLUX ') THEN
IF (LHOOK) CALL DR_HOOK('PGD_INLAND_WATER',1,ZHOOK_HANDLE)
RETURN
ELSE IF (U%CWATER=='WATFLX') THEN
- CALL PGD_WATFLUX(DTCO, U, WG, W, &
- HPROGRAM)
+ CALL PGD_WATFLUX(DTCO, U, WG, W, HPROGRAM)
ELSE IF (U%CWATER=='FLAKE ') THEN
- CALL PGD_FLAKE(DTCO, FG, F, UG, U, USS, &
- HPROGRAM,OECOCLIMAP,ORM_RIVER)
+ CALL PGD_FLAKE(DTCO, FG, F, UG, U, USS, HPROGRAM,ORM_RIVER)
END IF
!
IF (LHOOK) CALL DR_HOOK('PGD_INLAND_WATER',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/pgd_isba.F90 b/src/SURFEX/pgd_isba.F90
index 60ca41eca13b71999821c496c6d6966f071ed255..a86499b1a0140653bfcbea1be81557cdaf3e760f 100644
--- a/src/SURFEX/pgd_isba.F90
+++ b/src/SURFEX/pgd_isba.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PGD_ISBA (DTCO, DTI, DGU, IG, I, UG, U, USS, &
- HPROGRAM,OECOCLIMAP)
+ SUBROUTINE PGD_ISBA (DTCO, DTV, IG, IO, S, K, ISS, UG, U, USS, HPROGRAM)
! ##############################################################
!
!!**** *PGD_ISBA* monitor for averaging and interpolations of ISBA physiographic fields
@@ -44,29 +43,37 @@
!! R. Alkama 05/2012 : npatch must be 12 or 19 if CPHOTO/='NON'
!! B. Decharme 11/2013 : groundwater distribution for water table/surface coupling
!! P. Samuelsson 02/2012 : MEB
-!! M. Moge 02/2015 : MPPDB_CHECK
+!! B. Decharme 10/2016 bug surface/groundwater coupling
!!
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
! -----------
!
+#ifdef SFX_OL
+USE MODN_IO_OFFLINE, ONLY : LWR_VEGTYPE
+#endif
+!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t
+USE MODD_SSO_n, ONLY : SSO_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
USE MODD_PGD_GRID, ONLY : NL
USE MODD_PGDWORK, ONLY : CATYPE
-USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, JPCOVER
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, JPCOVER, NVT_TEBD, NVT_BONE, NVT_TRBE, &
+ NVT_TRBD, NVT_TEBE, NVT_TENE, NVT_BOBD, NVT_BOND
+USE MODD_DATA_COVER, ONLY : XDATA_VEGTYPE
!
USE MODD_ISBA_PAR, ONLY : NOPTIMLAYER, XOPTIMGRID
!
+USE MODI_AV_PGD
+!
USE MODI_GET_LUOUT
USE MODI_READ_NAM_PGD_ISBA
USE MODI_READ_NAM_PGD_ISBA_MEB
@@ -85,13 +92,14 @@ USE MODI_OPEN_NAMELIST
USE MODI_CLOSE_NAMELIST
USE MODI_PGD_ISBA_PAR
USE MODI_PGD_TOPD
-USE MODI_CONVERT_COVER_ISBA
USE MODE_POS_SURF
!
USE MODI_READ_SURF
USE MODI_INIT_IO_SURF_n
USE MODI_END_IO_SURF_n
!
+USE MODI_READ_NAMELISTS_ISBA
+!
#ifdef SFX_ASC
USE MODD_IO_SURF_ASC, ONLY : CFILEIN
#endif
@@ -106,11 +114,11 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
USE MODI_ABOR1_SFX
-!
#ifdef MNH_PARALLEL
USE MODE_MPPDB
!
#endif
+!
IMPLICIT NONE
!
!* 0.1 Declaration of arguments
@@ -118,17 +126,17 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+TYPE(GRID_t), INTENT(INOUT) :: IG
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(SSO_t), INTENT(INOUT) :: ISS
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-LOGICAL, INTENT(IN) :: OECOCLIMAP ! T if parameters are computed with ecoclimap
-! ! F if all parameters must be specified
!
!
!* 0.2 Declaration of local variables
@@ -157,28 +165,28 @@ LOGICAL :: GFOUND ! flag when namelist is present
!
INTEGER :: IPATCH ! number of patches
INTEGER :: IGROUND_LAYER ! number of soil layers
- CHARACTER(LEN=3) :: YISBA ! ISBA option
- CHARACTER(LEN=4) :: YPEDOTF ! Pedo transfert function for DIF
- CHARACTER(LEN=3) :: YPHOTO ! photosynthesis option
+INTEGER :: JVEGTYPE
+CHARACTER(LEN=3) :: YISBA ! ISBA option
+CHARACTER(LEN=4) :: YPEDOTF ! Pedo transfert function for DIF
+CHARACTER(LEN=3) :: YPHOTO ! photosynthesis option
LOGICAL :: GTR_ML ! new radiative transfert
+CHARACTER(LEN=4) :: YALBEDO
REAL :: ZRM_PATCH ! threshold to remove little fractions of patches
- CHARACTER(LEN=28) :: YSAND ! file name for sand fraction
- CHARACTER(LEN=28) :: YCLAY ! file name for clay fraction
- CHARACTER(LEN=28) :: YSOC_TOP ! file name for organic carbon top soil
- CHARACTER(LEN=28) :: YSOC_SUB ! file name for organic carbon sub soil
- CHARACTER(LEN=28) :: YCTI ! file name for topographic index
- CHARACTER(LEN=28) :: YRUNOFFB ! file name for runoffb parameter
- CHARACTER(LEN=28) :: YWDRAIN ! file name for wdrain parameter
- CHARACTER(LEN=28) :: YPERM ! file name for permafrost distribution
- CHARACTER(LEN=28) :: YGW ! file name for groundwater map
- CHARACTER(LEN=6) :: YSANDFILETYPE ! sand data file type
- CHARACTER(LEN=6) :: YCLAYFILETYPE ! clay data file type
- CHARACTER(LEN=6) :: YSOCFILETYPE ! organic carbon data file type
- CHARACTER(LEN=6) :: YCTIFILETYPE ! topographic index data file type
- CHARACTER(LEN=6) :: YRUNOFFBFILETYPE ! subgrid runoff data file type
- CHARACTER(LEN=6) :: YWDRAINFILETYPE ! subgrid drainage data file type
- CHARACTER(LEN=6) :: YPERMFILETYPE ! permafrost distribution data file type
- CHARACTER(LEN=6) :: YGWFILETYPE ! groundwater distribution data file type
+CHARACTER(LEN=28) :: YSAND ! file name for sand fraction
+CHARACTER(LEN=28) :: YCLAY ! file name for clay fraction
+CHARACTER(LEN=28) :: YSOC_TOP ! file name for organic carbon top soil
+CHARACTER(LEN=28) :: YSOC_SUB ! file name for organic carbon sub soil
+CHARACTER(LEN=28) :: YCTI ! file name for topographic index
+CHARACTER(LEN=28) :: YRUNOFFB ! file name for runoffb parameter
+CHARACTER(LEN=28) :: YWDRAIN ! file name for wdrain parameter
+CHARACTER(LEN=28) :: YPERM ! file name for permafrost distribution
+CHARACTER(LEN=6) :: YSANDFILETYPE ! sand data file type
+CHARACTER(LEN=6) :: YCLAYFILETYPE ! clay data file type
+CHARACTER(LEN=6) :: YSOCFILETYPE ! organic carbon data file type
+CHARACTER(LEN=6) :: YCTIFILETYPE ! topographic index data file type
+CHARACTER(LEN=6) :: YRUNOFFBFILETYPE ! subgrid runoff data file type
+CHARACTER(LEN=6) :: YWDRAINFILETYPE ! subgrid drainage data file type
+CHARACTER(LEN=6) :: YPERMFILETYPE ! permafrost distribution data file type
REAL :: XUNIF_SAND ! uniform value of sand fraction (-)
REAL :: XUNIF_CLAY ! uniform value of clay fraction (-)
REAL :: XUNIF_SOC_TOP ! uniform value of organic carbon top soil (kg/m2)
@@ -186,22 +194,20 @@ REAL :: XUNIF_SOC_SUB ! uniform value of organic carbon s
REAL :: XUNIF_RUNOFFB ! uniform value of subgrid runoff coefficient
REAL :: XUNIF_WDRAIN ! uniform subgrid drainage parameter
REAL :: XUNIF_PERM ! uniform permafrost distribution
-REAL :: XUNIF_GW ! uniform groundwater distribution
LOGICAL :: LIMP_SAND ! Imposed maps of Sand
LOGICAL :: LIMP_CLAY ! Imposed maps of Clay
LOGICAL :: LIMP_SOC ! Imposed maps of organic carbon
LOGICAL :: LIMP_CTI ! Imposed maps of topographic index statistics
LOGICAL :: LIMP_PERM ! Imposed maps of permafrost distribution
-LOGICAL :: LIMP_GW ! Imposed maps of groundwater distribution
REAL, DIMENSION(150) :: ZSOILGRID ! Soil grid reference for DIF
- CHARACTER(LEN=28) :: YPH ! file name for pH
- CHARACTER(LEN=28) :: YFERT ! file name for fertilisation rate
- CHARACTER(LEN=6) :: YPHFILETYPE ! pH data file type
- CHARACTER(LEN=6) :: YFERTFILETYPE ! fertilisation data file type
+CHARACTER(LEN=28) :: YPH ! file name for pH
+CHARACTER(LEN=28) :: YFERT ! file name for fertilisation rate
+CHARACTER(LEN=6) :: YPHFILETYPE ! pH data file type
+CHARACTER(LEN=6) :: YFERTFILETYPE ! fertilisation data file type
REAL :: XUNIF_PH ! uniform value of pH
REAL :: XUNIF_FERT ! uniform value of fertilisation rate
-LOGICAL, DIMENSION(19) :: GMEB_PATCH
-LOGICAL, DIMENSION(19) :: GMEB_PATCH_REC ! Recommended MEB patch settings
+LOGICAL, DIMENSION(NVEGTYPE) :: GMEB_PATCH
+LOGICAL, DIMENSION(NVEGTYPE) :: GMEB_PATCH_REC ! Recommended MEB patch settings
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -209,88 +215,102 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PGD_ISBA',0,ZHOOK_HANDLE)
!
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
+CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
!-------------------------------------------------------------------------------
!
!* 2.1 Reading of ISBA namelist
! -------------------------
!
- CALL READ_NAM_PGD_ISBA(HPROGRAM, IPATCH, IGROUND_LAYER, &
- YISBA, YPEDOTF, YPHOTO, GTR_ML, ZRM_PATCH, &
+CALL READ_NAM_PGD_ISBA(HPROGRAM, IPATCH, IGROUND_LAYER, &
+ YISBA, YPEDOTF, YPHOTO, GTR_ML, YALBEDO, ZRM_PATCH, &
YCLAY, YCLAYFILETYPE, XUNIF_CLAY, LIMP_CLAY, &
YSAND, YSANDFILETYPE, XUNIF_SAND, LIMP_SAND, &
YSOC_TOP, YSOC_SUB, YSOCFILETYPE, XUNIF_SOC_TOP, &
XUNIF_SOC_SUB, LIMP_SOC, YCTI, YCTIFILETYPE, LIMP_CTI, &
YPERM, YPERMFILETYPE, XUNIF_PERM, LIMP_PERM, GMEB, &
- YGW, YGWFILETYPE, XUNIF_GW, LIMP_GW, &
YRUNOFFB, YRUNOFFBFILETYPE, XUNIF_RUNOFFB, &
YWDRAIN, YWDRAINFILETYPE , XUNIF_WDRAIN, ZSOILGRID, &
YPH, YPHFILETYPE, XUNIF_PH, YFERT, YFERTFILETYPE, &
XUNIF_FERT )
!
-I%NPATCH = IPATCH
-I%NGROUND_LAYER = IGROUND_LAYER
-I%CISBA = YISBA
-I%CPEDOTF = YPEDOTF
-I%CPHOTO = YPHOTO
-I%LTR_ML = GTR_ML
-I%XRM_PATCH = MAX(MIN(ZRM_PATCH,1.),0.)
+IO%NPATCH = IPATCH
+IO%NGROUND_LAYER = IGROUND_LAYER
+IO%CISBA = YISBA
+IO%CPEDOTF = YPEDOTF
+IO%CPHOTO = YPHOTO
+IO%LTR_ML = GTR_ML
+IO%CALBEDO = YALBEDO
+IO%XRM_PATCH = MAX(MIN(ZRM_PATCH,1.),0.)
+!
!
+ CALL READ_NAMELISTS_ISBA(HPROGRAM)
!
!-------------------------------------------------------------------------------
!
!* 2.2 Reading of ISBA MEB namelist
! -----------------------------
!
-IF (I%NPATCH<1 .OR. I%NPATCH>NVEGTYPE) THEN
+IF (IO%NPATCH<1 .OR. IO%NPATCH>NVEGTYPE) THEN
WRITE(ILUOUT,*) '*****************************************'
WRITE(ILUOUT,*) '* Number of patch must be between 1 and ', NVEGTYPE
- WRITE(ILUOUT,*) '* You have chosen NPATCH = ', I%NPATCH
+ WRITE(ILUOUT,*) '* You have chosen NPATCH = ', IO%NPATCH
WRITE(ILUOUT,*) '*****************************************'
CALL ABOR1_SFX('PGD_ISBA: NPATCH MUST BE BETWEEN 1 AND NVEGTYPE')
END IF
!
-ALLOCATE(I%LMEB_PATCH(I%NPATCH))
+ALLOCATE(IO%LMEB_PATCH(IO%NPATCH))
!
-I%LMEB_PATCH(:) = .FALSE.
-I%LFORC_MEASURE = .FALSE.
-I%LMEB_LITTER = .FALSE.
-I%LMEB_GNDRES = .FALSE.
+IO%LMEB_PATCH(:) = .FALSE.
+IO%LFORC_MEASURE = .FALSE.
+IO%LMEB_LITTER = .FALSE.
+IO%LMEB_GNDRES = .FALSE.
IF(GMEB)THEN
- I%LTR_ML = .TRUE. ! Always use this SW radiative transfer option with MEB
+ IO%LTR_ML = .TRUE. ! Always use this SW radiative transfer option with MEB
- CALL READ_NAM_PGD_ISBA_MEB(HPROGRAM,ILUOUT,GMEB_PATCH,I%LFORC_MEASURE,I%LMEB_LITTER,I%LMEB_GNDRES)
+ CALL READ_NAM_PGD_ISBA_MEB(HPROGRAM,ILUOUT,GMEB_PATCH,IO%LFORC_MEASURE,IO%LMEB_LITTER,IO%LMEB_GNDRES)
-! Current recommendation is to use MEB for tree patches only.
-! Here follows a test in which non-tree patches in LMEB_PATCH are set to FALSE.
-! Thus, if you wish to test MEB for non-tree patches you can set
-! GMEB_PATCH_REC(:)=.TRUE.
-! in the following line:
+ ! Current recommendation is to use MEB for tree patches only.
+ ! Here follows a test in which non-tree patches in LMEB_PATCH are set to FALSE.
+ ! Thus, if you wish to test MEB for non-tree patches you can set
+ ! GMEB_PATCH_REC(:)=.TRUE.
+ ! in the following line:
GMEB_PATCH_REC(:)=.FALSE.
- IF(I%NPATCH==1 .AND. GMEB_PATCH(1))THEN
+ GMEB_PATCH_REC(:)=.TRUE.
+ GMEB_PATCH_REC(1:3)=.FALSE.
+
+
+ IF(IO%NPATCH==1 .AND. GMEB_PATCH(1))THEN
WRITE(ILUOUT,*) '*****************************************'
WRITE(ILUOUT,*) '* WARNING!'
WRITE(ILUOUT,*) '* Using MEB for one patch only is not recommended.'
WRITE(ILUOUT,*) '* LMEB_PATCH(1) has been set to .FALSE.'
WRITE(ILUOUT,*) '*****************************************'
- ELSEIF(I%NPATCH>=2 .AND. I%NPATCH<=6)THEN
+ ELSEIF(IO%NPATCH>=2 .AND. IO%NPATCH<=6)THEN
GMEB_PATCH_REC(2)=.TRUE. ! Only the tree patch (number 2) is allowed to be TRUE
- ELSEIF(I%NPATCH>=7 .AND. I%NPATCH<=8)THEN
+ ELSEIF(IO%NPATCH>=7 .AND. IO%NPATCH<=8)THEN
GMEB_PATCH_REC(3)=.TRUE. ! Only the tree patch (number 3) is allowed to be TRUE
- ELSEIF(I%NPATCH==9)THEN
+ ELSEIF(IO%NPATCH==9)THEN
GMEB_PATCH_REC(3:4)=(/.TRUE.,.TRUE./) ! Only the tree patches (numbers 3-4) are allowed to be TRUE
- ELSEIF(I%NPATCH==10)THEN
+ ELSEIF(IO%NPATCH==10)THEN
GMEB_PATCH_REC(3:5)=(/.TRUE.,.TRUE.,.TRUE./) ! Only the tree patches (numbers 3-5) are allowed to be TRUE
- ELSEIF(I%NPATCH>=11 .AND. I%NPATCH<=12)THEN
+ ELSEIF(IO%NPATCH>=11 .AND. IO%NPATCH<=12)THEN
GMEB_PATCH_REC(4:6)=(/.TRUE.,.TRUE.,.TRUE./) ! Only the tree patches (numbers 4-6) are allowed to be TRUE
- ELSEIF(I%NPATCH==19)THEN
- GMEB_PATCH_REC(4:6)=(/.TRUE.,.TRUE.,.TRUE./) ! The "old" tree patches (numbers 4-6) are allowed to be TRUE
- GMEB_PATCH_REC(13:17)=(/.TRUE.,.TRUE.,.TRUE.,.TRUE.,.TRUE./) ! The "new" tree patches (numbers 13-17) are allowed to be TRUE
+ ELSEIF(IO%NPATCH==NVEGTYPE)THEN
+ ! The "old" tree patches (numbers 4-6) are allowed to be TRUE
+ GMEB_PATCH_REC(NVT_TEBD) = .TRUE.
+ GMEB_PATCH_REC(NVT_BONE) = .TRUE.
+ GMEB_PATCH_REC(NVT_TRBE) = .TRUE.
+ ! The "new" tree patches (numbers 13-17) are allowed to be TRUE
+ GMEB_PATCH_REC(NVT_TRBD) = .TRUE.
+ GMEB_PATCH_REC(NVT_TEBE) = .TRUE.
+ GMEB_PATCH_REC(NVT_TENE) = .TRUE.
+ GMEB_PATCH_REC(NVT_BOBD) = .TRUE.
+ GMEB_PATCH_REC(NVT_BOND) = .TRUE.
ENDIF
IF(COUNT(.NOT.GMEB_PATCH_REC(:) .AND. GMEB_PATCH(:))>0)THEN
@@ -299,17 +319,15 @@ IF(GMEB)THEN
WRITE(ILUOUT,*) '* Using MEB for non-tree patches is not yet recommended.'
WRITE(ILUOUT,*) '* Therefor, LMEB_PATCH for non-tree patches has been set to .FALSE.'
WRITE(ILUOUT,*) '* The final LMEB_PATCH vector becomes:'
- WRITE(ILUOUT,*) GMEB_PATCH(1:I%NPATCH).AND.GMEB_PATCH_REC(1:I%NPATCH)
+ WRITE(ILUOUT,*) GMEB_PATCH(1:IO%NPATCH).AND.GMEB_PATCH_REC(1:IO%NPATCH)
WRITE(ILUOUT,*) '*****************************************'
ENDIF
GMEB_PATCH(:)=GMEB_PATCH(:).AND.GMEB_PATCH_REC(:)
- I%LMEB_PATCH(1:I%NPATCH) = GMEB_PATCH(1:I%NPATCH)
-!
- IF (I%LMEB_LITTER) THEN
- I%LMEB_GNDRES = .FALSE.
- ENDIF
-!
+ IO%LMEB_PATCH(1:IO%NPATCH) = GMEB_PATCH(1:IO%NPATCH)
+
+ IF (IO%LMEB_LITTER) IO%LMEB_GNDRES = .FALSE.
+
ENDIF
!
!-------------------------------------------------------------------------------
@@ -317,39 +335,40 @@ ENDIF
!* 3. Coherence of options
! --------------------
!
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CISBA',I%CISBA,'2-L','3-L','DIF')
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CPEDOTF',I%CPEDOTF,'CH78','CO84')
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CPHOTO',I%CPHOTO,'NON','AGS','LAI','AST','LST','NIT','NCB')
+ CALL TEST_NAM_VAR_SURF(ILUOUT,'CISBA',IO%CISBA,'2-L','3-L','DIF')
+ CALL TEST_NAM_VAR_SURF(ILUOUT,'CPEDOTF',IO%CPEDOTF,'CH78','CO84')
+ CALL TEST_NAM_VAR_SURF(ILUOUT,'CPHOTO',IO%CPHOTO,'NON','AST','NIT','NCB')
+ CALL TEST_NAM_VAR_SURF(ILUOUT,'CALBEDO',IO%CALBEDO,'EVOL','DRY ','WET ','MEAN','USER','CM13')
!
-SELECT CASE (I%CISBA)
+SELECT CASE (IO%CISBA)
!
CASE ('2-L')
!
- I%NGROUND_LAYER = 2
- I%CPEDOTF ='CH78'
- ALLOCATE(I%XSOILGRID(0))
+ IO%NGROUND_LAYER = 2
+ IO%CPEDOTF ='CH78'
+ ALLOCATE(IO%XSOILGRID(0))
WRITE(ILUOUT,*) '*****************************************'
- WRITE(ILUOUT,*) '* With option CISBA = ',I%CISBA,' *'
+ WRITE(ILUOUT,*) '* With option CISBA = ',IO%CISBA,' *'
WRITE(ILUOUT,*) '* the number of soil layers is set to 2 *'
WRITE(ILUOUT,*) '* Pedo transfert function = CH78 *'
WRITE(ILUOUT,*) '*****************************************'
!
CASE ('3-L')
!
- I%NGROUND_LAYER = 3
- I%CPEDOTF ='CH78'
- ALLOCATE(I%XSOILGRID(0))
+ IO%NGROUND_LAYER = 3
+ IO%CPEDOTF ='CH78'
+ ALLOCATE(IO%XSOILGRID(0))
WRITE(ILUOUT,*) '*****************************************'
- WRITE(ILUOUT,*) '* With option CISBA = ',I%CISBA,' *'
+ WRITE(ILUOUT,*) '* With option CISBA = ',IO%CISBA,' *'
WRITE(ILUOUT,*) '* the number of soil layers is set to 3 *'
WRITE(ILUOUT,*) '* Pedo transfert function = CH78 *'
WRITE(ILUOUT,*) '*****************************************'
!
CASE ('DIF')
!
- IF(I%NGROUND_LAYER==NUNDEF)THEN
- IF(OECOCLIMAP)THEN
- I%NGROUND_LAYER=NOPTIMLAYER
+ IF(IO%NGROUND_LAYER==NUNDEF)THEN
+ IF(U%LECOCLIMAP)THEN
+ IO%NGROUND_LAYER=NOPTIMLAYER
ELSE
WRITE(ILUOUT,*) '****************************************'
WRITE(ILUOUT,*) '* Number of ground layer not specified *'
@@ -358,54 +377,54 @@ SELECT CASE (I%CISBA)
ENDIF
ENDIF
!
- ALLOCATE(I%XSOILGRID(I%NGROUND_LAYER))
- I%XSOILGRID(:)=XUNDEF
- I%XSOILGRID(:)=ZSOILGRID(1:I%NGROUND_LAYER)
+ ALLOCATE(IO%XSOILGRID(IO%NGROUND_LAYER))
+ IO%XSOILGRID(:)=0.
+ IO%XSOILGRID(:)=ZSOILGRID(1:IO%NGROUND_LAYER)
IF (ALL(ZSOILGRID(:)==XUNDEF)) THEN
- IF(OECOCLIMAP) I%XSOILGRID(1:I%NGROUND_LAYER)=XOPTIMGRID(1:I%NGROUND_LAYER)
- ELSEIF (COUNT(I%XSOILGRID/=XUNDEF)/=I%NGROUND_LAYER) THEN
+ IF(U%LECOCLIMAP) IO%XSOILGRID(1:IO%NGROUND_LAYER)=XOPTIMGRID(1:IO%NGROUND_LAYER)
+ ELSEIF (COUNT(IO%XSOILGRID/=XUNDEF)/=IO%NGROUND_LAYER) THEN
WRITE(ILUOUT,*) '********************************************************'
WRITE(ILUOUT,*) '* Soil grid reference values /= number of ground layer *'
WRITE(ILUOUT,*) '********************************************************'
CALL ABOR1_SFX('PGD_ISBA: XSOILGRID must be coherent with NGROUND_LAYER in NAM_ISBA')
- ELSEIF (I%XSOILGRID(1).GT.0.01) THEN
+ ELSEIF (IO%XSOILGRID(1).GT.0.01) THEN
CALL ABOR1_SFX('PGD_ISBA: First layer of XSOILGRID must be lower than 1cm')
ENDIF
!
WRITE(ILUOUT,*) '*****************************************'
- WRITE(ILUOUT,*) '* Option CISBA = ',I%CISBA
- WRITE(ILUOUT,*) '* Pedo transfert function = ',I%CPEDOTF
- WRITE(ILUOUT,*) '* Number of soil layers = ',I%NGROUND_LAYER
- IF(OECOCLIMAP)THEN
- WRITE(ILUOUT,*) '* Soil layers grid (m) = ',I%XSOILGRID(1:I%NGROUND_LAYER)
+ WRITE(ILUOUT,*) '* Option CISBA = ',IO%CISBA
+ WRITE(ILUOUT,*) '* Pedo transfert function = ',IO%CPEDOTF
+ WRITE(ILUOUT,*) '* Number of soil layers = ',IO%NGROUND_LAYER
+ IF(U%LECOCLIMAP)THEN
+ WRITE(ILUOUT,*) '* Soil layers grid (m) = ',IO%XSOILGRID(1:IO%NGROUND_LAYER)
ENDIF
WRITE(ILUOUT,*) '*****************************************'
!
END SELECT
!
-SELECT CASE (I%CPHOTO)
- CASE ('AGS','LAI','AST','LST')
- I%NNBIOMASS = 1
+SELECT CASE (IO%CPHOTO)
+ CASE ('AST')
+ IO%NNBIOMASS = 1
CASE ('NIT')
- I%NNBIOMASS = 3
+ IO%NNBIOMASS = 3
CASE ('NCB')
- I%NNBIOMASS = 6
+ IO%NNBIOMASS = 6
END SELECT
WRITE(ILUOUT,*) '*****************************************'
-WRITE(ILUOUT,*) '* With option CPHOTO = ',I%CPHOTO,' *'
-WRITE(ILUOUT,*) '* the number of biomass pools is set to ', I%NNBIOMASS
+WRITE(ILUOUT,*) '* With option CPHOTO = ',IO%CPHOTO,' *'
+WRITE(ILUOUT,*) '* the number of biomass pools is set to ', IO%NNBIOMASS
WRITE(ILUOUT,*) '*****************************************'
!
-IF ( I%CPHOTO/='NON' .AND. I%NPATCH/=12 .AND. I%NPATCH/=19 ) THEN
+IF ( IO%CPHOTO/='NON' .AND. IO%NPATCH/=12 .AND. IO%NPATCH/=NVEGTYPE ) THEN
WRITE(ILUOUT,*) '*****************************************'
- WRITE(ILUOUT,*) '* With option CPHOTO = ', I%CPHOTO
- WRITE(ILUOUT,*) '* Number of patch must be equal to 12 or 19'
- WRITE(ILUOUT,*) '* But you have chosen NPATCH = ', I%NPATCH
+ WRITE(ILUOUT,*) '* With option CPHOTO = ', IO%CPHOTO
+ WRITE(ILUOUT,*) '* Number of patch must be equal to 12 or NVEGTYPE'
+ WRITE(ILUOUT,*) '* But you have chosen NPATCH = ', IO%NPATCH
WRITE(ILUOUT,*) '*****************************************'
- CALL ABOR1_SFX('PGD_ISBA: CPHOTO='//I%CPHOTO//' REQUIRES NPATCH=12 or 19')
+ CALL ABOR1_SFX('PGD_ISBA: CPHOTO='//IO%CPHOTO//' REQUIRES NPATCH=12 or NVEGTYPE')
END IF
!
-IF ( I%CPHOTO=='NON' .AND. I%LTR_ML .AND. .NOT. GMEB) THEN
+IF ( IO%CPHOTO=='NON' .AND. IO%LTR_ML .AND. .NOT. GMEB) THEN
WRITE(ILUOUT,*) '*****************************************'
WRITE(ILUOUT,*) '* With option CPHOTO == NON '
WRITE(ILUOUT,*) '* And With MEB = F '
@@ -420,49 +439,67 @@ END IF
!* 4. Number of points and packing of general fields
! ----------------------------------------------
!
- CALL GET_SURF_SIZE_n(DTCO, U, &
- 'NATURE',ILU)
+ CALL GET_SURF_SIZE_n(DTCO, U, 'NATURE',ILU)
!
-ALLOCATE(I%LCOVER (JPCOVER))
-ALLOCATE(I%XZS (ILU))
+ALLOCATE(S%LCOVER (JPCOVER))
+ALLOCATE(S%XZS (ILU))
ALLOCATE(IG%XLAT (ILU))
ALLOCATE(IG%XLON (ILU))
ALLOCATE(IG%XMESH_SIZE (ILU))
-ALLOCATE(I%XZ0EFFJPDIR(ILU))
+ALLOCATE(ISS%XZ0EFFJPDIR(ILU))
+!
+ CALL PACK_PGD(DTCO, U, HPROGRAM, 'NATURE', IG, S%LCOVER, S%XCOVER, S%XZS )
!
- CALL PACK_PGD(DTCO, U, &
- HPROGRAM, 'NATURE', &
- IG%CGRID, IG%XGRID_PAR, &
- I%LCOVER, I%XCOVER, I%XZS, &
- IG%XLAT, IG%XLON, IG%XMESH_SIZE, I%XZ0EFFJPDIR )
#ifdef MNH_PARALLEL
CALL MPPDB_CHECK_SURFEX2D(IG%XLAT,"PGD_ISBA after PACK_PGD:XLAT",PRECISION,ILUOUT, 'NATURE')
CALL MPPDB_CHECK_SURFEX2D(IG%XLON,"PGD_ISBA after PACK_PGD:XLON",PRECISION,ILUOUT, 'NATURE')
CALL MPPDB_CHECK_SURFEX2D(IG%XMESH_SIZE,"PGD_ISBA after PACK_PGD:XMESH_SIZE",PRECISION,ILUOUT, 'NATURE')
#endif
-!
!-------------------------------------------------------------------------------
!
!* 5. Packing of ISBA specific fields
! -------------------------------
!
- CALL GET_AOS_n(USS, &
- HPROGRAM,NL,ZAOSIP,ZAOSIM,ZAOSJP,ZAOSJM,ZHO2IP,ZHO2IM,ZHO2JP,ZHO2JM)
- CALL GET_SSO_n(USS, &
- HPROGRAM,NL,ZSSO_SLOPE)
+ CALL GET_AOS_n(USS, HPROGRAM,NL,ZAOSIP,ZAOSIM,ZAOSJP,ZAOSJM,ZHO2IP,ZHO2IM,ZHO2JP,ZHO2JM)
+ CALL GET_SSO_n(USS, HPROGRAM,NL,ZSSO_SLOPE)
!
- CALL PACK_PGD_ISBA(DTCO, IG, I, U, &
- HPROGRAM, &
+ CALL PACK_PGD_ISBA(DTCO, IG%NDIM, ISS, U, HPROGRAM, &
ZAOSIP, ZAOSIM, ZAOSJP, ZAOSJM, &
ZHO2IP, ZHO2IM, ZHO2JP, ZHO2JM, &
ZSSO_SLOPE )
!
!-------------------------------------------------------------------------------
!
+!* 15. ISBA specific fields
+! --------------------
+!
+IO%LECOCLIMAP = U%LECOCLIMAP
+!
+ CALL PGD_ISBA_PAR(DTCO, UG, U, USS, DTV, IO, S, IG%NDIM, HPROGRAM)
+!
+!-------------------------------------------------------------------------------
+!
+#ifdef SFX_OL
+IF (LWR_VEGTYPE) THEN
+ ALLOCATE(K%XVEGTYPE(ILU,NVEGTYPE))
+ IF (DTV%LDATA_VEGTYPE) THEN
+ K%XVEGTYPE(:,:) = DTV%XPAR_VEGTYPE(:,:)
+ ELSE
+ DO JVEGTYPE=1,NVEGTYPE
+ CALL AV_PGD(DTCO,K%XVEGTYPE(:,JVEGTYPE),S%XCOVER,XDATA_VEGTYPE(:,JVEGTYPE),'NAT','ARI',S%LCOVER)
+ ENDDO
+ ENDIF
+ENDIF
+#endif
+!
+DEALLOCATE(S%XCOVER)
+!
+!-------------------------------------------------------------------------------
+!
!* 6. Topographic index for TOPMODEL
! ------------------------------
!
- CALL PGD_TOPO_INDEX(DGU, DTCO, UG, U, USS, I, &
+ CALL PGD_TOPO_INDEX(DTCO, UG, U, USS, S, IO%LCTI, &
HPROGRAM,ILU,YCTI,YCTIFILETYPE,LIMP_CTI)
!
!-------------------------------------------------------------------------------
@@ -470,78 +507,26 @@ ALLOCATE(I%XZ0EFFJPDIR(ILU))
!* 7. Sand fraction
! -------------
!
- CATYPE='ARI'
+CATYPE='ARI'
!
-ALLOCATE(I%XSAND(ILU,I%NGROUND_LAYER))
+ALLOCATE(K%XSAND(ILU,IO%NGROUND_LAYER))
!
-IF(LIMP_SAND)THEN
+ CALL GET_FIELD(YSANDFILETYPE,YSAND,"SAND",LIMP_SAND,XUNIF_SAND,K%XSAND(:,1))
!
- IF(YSANDFILETYPE=='NETCDF')THEN
- CALL ABOR1_SFX('Use another format than netcdf for sand input file with LIMP_SAND')
- ELSE
-#ifdef SFX_ASC
- CFILEIN = ADJUSTL(ADJUSTR(YSAND)//'.txt')
-#endif
-#ifdef SFX_FA
- CFILEIN_FA = ADJUSTL(ADJUSTR(YSAND)//'.fa')
-#endif
-#ifdef SFX_LFI
- CFILEIN_LFI = ADJUSTL(YSAND)
-#endif
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- YSANDFILETYPE,'NATURE','ISBA ','READ ')
- ENDIF
-!
- CALL READ_SURF(&
- YSANDFILETYPE,'SAND',I%XSAND(:,1),IRESP)
-!
- CALL END_IO_SURF_n(YSANDFILETYPE)
-!
-ELSE
- CALL PGD_FIELD(DTCO, UG, U, USS, &
- HPROGRAM,'sand fraction','NAT',YSAND,YSANDFILETYPE,XUNIF_SAND,I%XSAND(:,1))
-ENDIF
-!
-DO JLAYER=1,I%NGROUND_LAYER
- I%XSAND(:,JLAYER) = I%XSAND(:,1)
+DO JLAYER=1,IO%NGROUND_LAYER
+ K%XSAND(:,JLAYER) = K%XSAND(:,1)
END DO
!-------------------------------------------------------------------------------
!
!* 8. Clay fraction
! -------------
!
-ALLOCATE(I%XCLAY(ILU,I%NGROUND_LAYER))
+ALLOCATE(K%XCLAY(ILU,IO%NGROUND_LAYER))
!
-IF(LIMP_CLAY)THEN
+ CALL GET_FIELD(YCLAYFILETYPE,YCLAY,"CLAY",LIMP_CLAY,XUNIF_CLAY,K%XCLAY(:,1))
!
- IF(YCLAYFILETYPE=='NETCDF')THEN
- CALL ABOR1_SFX('Use another format than netcdf for clay input file with LIMP_CLAY')
- ELSE
-#ifdef SFX_ASC
- CFILEIN = ADJUSTL(ADJUSTR(YCLAY)//'.txt')
-#endif
-#ifdef SFX_FA
- CFILEIN_FA = ADJUSTL(ADJUSTR(YCLAY)//'.fa')
-#endif
-#ifdef SFX_LFI
- CFILEIN_LFI = ADJUSTL(YCLAY)
-#endif
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- YCLAYFILETYPE,'NATURE','ISBA ','READ ')
- ENDIF
-!
- CALL READ_SURF(&
- YCLAYFILETYPE,'CLAY',I%XCLAY(:,1),IRESP)
-!
- CALL END_IO_SURF_n(YCLAYFILETYPE)
-!
-ELSE
- CALL PGD_FIELD(DTCO, UG, U, USS, &
- HPROGRAM,'clay fraction','NAT',YCLAY,YCLAYFILETYPE,XUNIF_CLAY,I%XCLAY(:,1))
-ENDIF
-!
-DO JLAYER=1,I%NGROUND_LAYER
- I%XCLAY(:,JLAYER) = I%XCLAY(:,1)
+DO JLAYER=1,IO%NGROUND_LAYER
+ K%XCLAY(:,JLAYER) = K%XCLAY(:,1)
END DO
!
!-------------------------------------------------------------------------------
@@ -551,9 +536,9 @@ END DO
!
IF(LEN_TRIM(YSOCFILETYPE)/=0.OR.(XUNIF_SOC_TOP/=XUNDEF.AND.XUNIF_SOC_SUB/=XUNDEF))THEN
!
- ALLOCATE(I%XSOC(ILU,I%NGROUND_LAYER))
+ ALLOCATE(S%XSOC(ILU,IO%NGROUND_LAYER))
!
- I%LSOCP=.TRUE.
+ IO%LSOCP=.TRUE.
!
IF((LEN_TRIM(YSOC_TOP)==0.AND.LEN_TRIM(YSOC_SUB)/=0).OR.(LEN_TRIM(YSOC_TOP)/=0.AND.LEN_TRIM(YSOC_SUB)==0))THEN
WRITE(ILUOUT,*) ' '
@@ -565,69 +550,18 @@ IF(LEN_TRIM(YSOCFILETYPE)/=0.OR.(XUNIF_SOC_TOP/=XUNDEF.AND.XUNIF_SOC_SUB/=XUNDEF
CALL ABOR1_SFX('PGD_ISBA: TOP AND SUB SOC INPUT FILE REQUIRED')
ENDIF
!
- IF(LIMP_SOC)THEN
-!
-! Topsoil
-!
- IF(YSOCFILETYPE=='NETCDF')THEN
- CALL ABOR1_SFX('Use another format than netcdf for organic carbon input file with LIMP_SOC')
- ELSE
-#ifdef SFX_ASC
- CFILEIN = ADJUSTL(ADJUSTR(YSOC_TOP)//'.txt')
-#endif
-#ifdef SFX_FA
- CFILEIN_FA = ADJUSTL(ADJUSTR(YSOC_TOP)//'.fa')
-#endif
-#ifdef SFX_LFI
- CFILEIN_LFI = ADJUSTL(YSOC_TOP)
-#endif
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- YSOCFILETYPE,'NATURE','ISBA ','READ ')
- ENDIF
-!
- CALL READ_SURF(&
- YSOCFILETYPE,'SOC_TOP',I%XSOC(:,1),IRESP)
-!
- CALL END_IO_SURF_n(YSOCFILETYPE)
-!
-! Subsoil
-!
- IF(YSOCFILETYPE=='NETCDF')THEN
- CALL ABOR1_SFX('Use another format than netcdf for organic carbon input file with LIMP_SOC')
- ELSE
-#ifdef SFX_ASC
- CFILEIN = ADJUSTL(ADJUSTR(YSOC_SUB)//'.txt')
-#endif
-#ifdef SFX_FA
- CFILEIN_FA = ADJUSTL(ADJUSTR(YSOC_SUB)//'.fa')
-#endif
-#ifdef SFX_LFI
- CFILEIN_LFI = ADJUSTL(YSOC_SUB)
-#endif
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- YSOCFILETYPE,'NATURE','ISBA ','READ ')
- ENDIF
-!
- CALL READ_SURF(&
- YSOCFILETYPE,'SOC_SUB',I%XSOC(:,2),IRESP)
-!
- CALL END_IO_SURF_n(YSOCFILETYPE)
+ CALL GET_FIELD(YSOCFILETYPE,YSOC_TOP,"SOC_TOP",LIMP_SOC,XUNIF_SOC_TOP,S%XSOC(:,1))
!
- ELSE
- CALL PGD_FIELD(DTCO, UG, U, USS, &
- HPROGRAM,'organic carbon','NAT',YSOC_TOP,YSOCFILETYPE,XUNIF_SOC_TOP,I%XSOC(:,1))
- CALL PGD_FIELD(DTCO, UG, U, USS, &
- HPROGRAM,'organic carbon','NAT',YSOC_SUB,YSOCFILETYPE,XUNIF_SOC_SUB,I%XSOC(:,2))
- ENDIF
+ CALL GET_FIELD(YSOCFILETYPE,YSOC_SUB,"SOC_SUB",LIMP_SOC,XUNIF_SOC_SUB,S%XSOC(:,2))
!
- DO JLAYER=2,I%NGROUND_LAYER
- I%XSOC(:,JLAYER) = I%XSOC(:,2)
+ DO JLAYER=2,IO%NGROUND_LAYER
+ S%XSOC(:,JLAYER) = S%XSOC(:,2)
END DO
!
ELSE
!
- I%LSOCP=.FALSE.
- ALLOCATE(I%XSOC(0,0))
+ IO%LSOCP=.FALSE.
+ ALLOCATE(S%XSOC(0,0))
!
ENDIF
!
@@ -636,84 +570,16 @@ ENDIF
!
IF(LEN_TRIM(YPERM)/=0.OR.XUNIF_PERM/=XUNDEF)THEN
!
- ALLOCATE(I%XPERM(ILU))
-!
- I%LPERM=.TRUE.
-!
- IF(LIMP_PERM)THEN
-!
- IF(YPERMFILETYPE=='NETCDF')THEN
- CALL ABOR1_SFX('Use another format than netcdf for permafrost input file with LIMP_PERM')
- ELSE
-#ifdef SFX_ASC
- CFILEIN = ADJUSTL(ADJUSTR(YPERM)//'.txt')
-#endif
-#ifdef SFX_FA
- CFILEIN_FA = ADJUSTL(ADJUSTR(YPERM)//'.fa')
-#endif
-#ifdef SFX_LFI
- CFILEIN_LFI = ADJUSTL(YPERM)
-#endif
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- YPERMFILETYPE,'NATURE','ISBA ','READ ')
- ENDIF
-!
- CALL READ_SURF(&
- YPERMFILETYPE,'PERM',I%XPERM(:),IRESP)
-!
- CALL END_IO_SURF_n(YPERMFILETYPE)
- ELSE
- CALL PGD_FIELD(DTCO, UG, U, USS, &
- HPROGRAM,'permafrost mask','NAT',YPERM,YPERMFILETYPE,XUNIF_PERM,I%XPERM(:))
- ENDIF
-!
-ELSE
-!
- I%LPERM=.FALSE.
- ALLOCATE(I%XPERM(0))
-!
-ENDIF
-!
-!* 11. Groundwater bassin distribution
-! -----------------------
-!
-IF(LEN_TRIM(YGW)/=0.OR.XUNIF_GW/=XUNDEF)THEN
-!
- ALLOCATE(I%XGW(ILU))
+ ALLOCATE(K%XPERM(ILU))
!
- I%LGW=.TRUE.
-!
- IF(LIMP_GW)THEN
-!
- IF(YGWFILETYPE=='NETCDF')THEN
- CALL ABOR1_SFX('Use another format than netcdf for groundwater input file with LIMP_GW')
- ELSE
-#ifdef SFX_ASC
- CFILEIN = ADJUSTL(ADJUSTR(YGW)//'.txt')
-#endif
-#ifdef SFX_FA
- CFILEIN_FA = ADJUSTL(ADJUSTR(YGW)//'.fa')
-#endif
-#ifdef SFX_LFI
- CFILEIN_LFI = ADJUSTL(YGW)
-#endif
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- YGWFILETYPE,'NATURE','ISBA ','READ ')
- ENDIF
-!
- CALL READ_SURF(&
- YGWFILETYPE,'GW',I%XGW(:),IRESP)
-!
- CALL END_IO_SURF_n(YGWFILETYPE)
- ELSE
- CALL PGD_FIELD(DTCO, UG, U, USS, &
- HPROGRAM,'Groundwater bassin','NAT',YGW,YGWFILETYPE,XUNIF_GW,I%XGW(:))
- ENDIF
+ IO%LPERM=.TRUE.
+!
+ CALL GET_FIELD(YPERMFILETYPE,YPERM,"PERM",LIMP_PERM,XUNIF_PERM,K%XPERM(:))
!
ELSE
!
- I%LGW=.FALSE.
- ALLOCATE(I%XGW(0))
+ IO%LPERM=.FALSE.
+ ALLOCATE(K%XPERM(0))
!
ENDIF
!
@@ -722,17 +588,18 @@ ENDIF
!* 12. pH and fertlisation data
! --------------------------
!
-IF((LEN_TRIM(YPHFILETYPE)/=0.OR.XUNIF_PH/=XUNDEF) .AND. (LEN_TRIM(YFERTFILETYPE)/=0.OR.XUNIF_FERT/=XUNDEF)) THEN
+IF((LEN_TRIM(YPHFILETYPE)/=0.OR.XUNIF_PH/=XUNDEF) .AND. &
+ (LEN_TRIM(YFERTFILETYPE)/=0.OR.XUNIF_FERT/=XUNDEF)) THEN
!
- ALLOCATE(I%XPH(ILU))
- ALLOCATE(I%XFERT(ILU))
+ ALLOCATE(S%XPH(ILU))
+ ALLOCATE(S%XFERT(ILU))
!
- I%LNOF = .TRUE.
+ IO%LNOF = .TRUE.
!
CALL PGD_FIELD(DTCO, UG, U, USS, &
- HPROGRAM,'pH value','NAT',YPH,YPHFILETYPE,XUNIF_PH,I%XPH(:))
+ HPROGRAM,'pH value','NAT',YPH,YPHFILETYPE,XUNIF_PH,S%XPH(:))
CALL PGD_FIELD(DTCO, UG, U, USS, &
- HPROGRAM,'fertilisation','NAT',YFERT,YFERTFILETYPE,XUNIF_FERT,I%XFERT(:))
+ HPROGRAM,'fertilisation','NAT',YFERT,YFERTFILETYPE,XUNIF_FERT,S%XFERT(:))
!
ENDIF
!
@@ -741,59 +608,81 @@ ENDIF
!* 13. Subgrid runoff
! --------------
!
-ALLOCATE(I%XRUNOFFB(ILU))
- CALL PGD_FIELD(DTCO, UG, U, USS, &
- HPROGRAM,'subgrid runoff','NAT',YRUNOFFB,YRUNOFFBFILETYPE,XUNIF_RUNOFFB,I%XRUNOFFB(:))
+ALLOCATE(K%XRUNOFFB(ILU))
+ CALL PGD_FIELD(DTCO, UG, U, USS, HPROGRAM,'subgrid runoff','NAT',YRUNOFFB,YRUNOFFBFILETYPE,&
+ XUNIF_RUNOFFB,K%XRUNOFFB(:))
!
!-------------------------------------------------------------------------------
!
!* 14. Drainage coefficient
! --------------------
!
-ALLOCATE(I%XWDRAIN(ILU))
- CALL PGD_FIELD(DTCO, UG, U, USS, &
- HPROGRAM,'subgrid drainage','NAT',YWDRAIN,YWDRAINFILETYPE,XUNIF_WDRAIN,I%XWDRAIN(:))
+ALLOCATE(K%XWDRAIN(ILU))
+ CALL PGD_FIELD(DTCO, UG, U, USS, HPROGRAM,'subgrid drainage','NAT',YWDRAIN,YWDRAINFILETYPE,&
+ XUNIF_WDRAIN,K%XWDRAIN(:))
!
!-------------------------------------------------------------------------------
!
-!* 15. ISBA specific fields
-! --------------------
+ CALL PGD_TOPD(IO%CISBA, UG%G%CGRID, UG%G%XGRID_PAR, U%NDIM_FULL, USS%XSSO_SLOPE, HPROGRAM)
!
-I%LECOCLIMAP = OECOCLIMAP
+!-------------------------------------------------------------------------------
!
- CALL PGD_ISBA_PAR(DTCO, DGU, UG, U, USS, DTI, I, IG, &
- HPROGRAM)
+!* 16. Prints of cover parameters in a tex file
+! ----------------------------------------
!
-!-------------------------------------------------------------------------------
+IF (U%LECOCLIMAP) THEN
+ CALL WRITE_COVER_TEX_ISBA (IO%NPATCH,IO%NGROUND_LAYER,IO%CISBA)
+ CALL WRITE_COVER_TEX_ISBA_PAR(DTCO, IO%CALBEDO, IO%LTR_ML, &
+ IO%NPATCH,IO%NGROUND_LAYER,IO%CISBA,IO%CPHOTO,IO%XSOILGRID)
+END IF
+IF (LHOOK) CALL DR_HOOK('PGD_ISBA',1,ZHOOK_HANDLE)
!
- CALL PGD_TOPD(I, UG, U, USS, &
- HPROGRAM)
+CONTAINS
!
-!-------------------------------------------------------------------------------
+SUBROUTINE GET_FIELD(HFILETYPE,HFILE,HFIELD,OIMP,PUNIF,PFIELD)
!
-!* 16. ISBA diagnostic PGD fields stored in PGD file for improved efficiency in PREP step
-! ----------------------------------------------------------------------------------
+IMPLICIT NONE
!
-IF (OECOCLIMAP) THEN
- ALLOCATE(I%XDG(ILU,I%NGROUND_LAYER,I%NPATCH))
- IF (I%CISBA=='DIF') THEN
- ALLOCATE(I%NWG_LAYER(ILU,I%NPATCH))
+ CHARACTER(LEN=*), INTENT(INOUT) :: HFILETYPE
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE
+ CHARACTER(LEN=*), INTENT(IN) :: HFIELD
+LOGICAL, INTENT(IN) :: OIMP
+REAL, INTENT(IN) :: PUNIF
+REAL, DIMENSION(:), INTENT(OUT) :: PFIELD
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('PGD_ISBA:GET_FIELD',0,ZHOOK_HANDLE)
+!
+IF(OIMP)THEN
+!
+ IF(HFILETYPE=='NETCDF')THEN
+ CALL ABOR1_SFX('Use another format than netcdf for '//TRIM(HFIELD)//' input file with LIMP ')
ELSE
- ALLOCATE(I%NWG_LAYER(0,0))
- END IF
- CALL CONVERT_COVER_ISBA(DTCO,I,I%CISBA,1,I%XCOVER,I%LCOVER,' ','NAT',&
- PSOILGRID=I%XSOILGRID,PDG=I%XDG,KWG_LAYER=I%NWG_LAYER)
-END IF
-
-!* 17. Prints of cover parameters in a tex file
-! ----------------------------------------
+#ifdef SFX_ASC
+ CFILEIN = ADJUSTL(ADJUSTR(HFILE)//'.txt')
+#endif
+#ifdef SFX_FA
+ CFILEIN_FA = ADJUSTL(ADJUSTR(HFILE)//'.fa')
+#endif
+#ifdef SFX_LFI
+ CFILEIN_LFI = ADJUSTL(HFILE)
+#endif
+CALL INIT_IO_SURF_n(DTCO, U, HFILETYPE,'NATURE','ISBA ','READ ')
+ ENDIF
+!
+ CALL READ_SURF(HFILETYPE,TRIM(HFIELD),PFIELD,IRESP)
!
-IF (OECOCLIMAP) THEN
- CALL WRITE_COVER_TEX_ISBA (I%NPATCH,I%NGROUND_LAYER,I%CISBA)
- CALL WRITE_COVER_TEX_ISBA_PAR(DTCO, I, &
- I%NPATCH,I%NGROUND_LAYER,I%CISBA,I%CPHOTO,I%XSOILGRID)
-END IF
-IF (LHOOK) CALL DR_HOOK('PGD_ISBA',1,ZHOOK_HANDLE)
+ CALL END_IO_SURF_n(HFILETYPE)
+!
+ELSE
+ CALL PGD_FIELD(DTCO, UG, U, USS, &
+ HPROGRAM,HFIELD,'NAT',HFILE,HFILETYPE,PUNIF,PFIELD)
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('PGD_ISBA:GET_FIELD',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE GET_FIELD
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/pgd_isba_par.F90 b/src/SURFEX/pgd_isba_par.F90
index b54e43c82c99a947876205a6d2394dc94f9ec163..3bb5202c2b85efcea4fcaed81d2c49827ddd8f9a 100644
--- a/src/SURFEX/pgd_isba_par.F90
+++ b/src/SURFEX/pgd_isba_par.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PGD_ISBA_PAR (DTCO, DGU, UG, U, USS, DTI, I, IG, &
- HPROGRAM)
+ SUBROUTINE PGD_ISBA_PAR (DTCO, UG, U, USS, DTV, IO, S, KDIM, HPROGRAM)
! ##############################################################
!
!!**** *PGD_ISBA_PAR* monitor for averaging and interpolations of cover fractions
@@ -47,18 +46,19 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t
!
USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
USE MODD_SURF_PAR, ONLY : XUNDEF
!
+USE MODD_AGRI, ONLY : LAGRIP
+!
+USE MODI_AV_PGD
USE MODI_GET_LUOUT
USE MODI_OPEN_NAMELIST
USE MODI_CLOSE_NAMELIST
@@ -79,13 +79,14 @@ IMPLICIT NONE
! ------------------------
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
+TYPE(SSO_t), INTENT(INOUT) :: USS
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+!
+INTEGER, INTENT(IN) :: KDIM
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
!
@@ -93,14 +94,14 @@ TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
!* 0.2 Declaration of local variables
! ------------------------------
!
-REAL, DIMENSION(IG%NDIM,NVEGTYPE) :: ZROOTFRACGV,TEST,TEST2,TEST3
+REAL, DIMENSION(KDIM,NVEGTYPE) :: TEST,TEST2,TEST3
INTEGER :: ILUOUT ! output listing logical unit
INTEGER :: ILUNAM ! namelist file logical unit
INTEGER :: IHGROUND_LAYER ! Half number of NGROUND_LAYER
INTEGER :: IIH ! Ground layer counter
LOGICAL :: GFOUND ! true if namelist is found
!
-INTEGER :: JVEGTYPE ! loop counter on patch
+INTEGER :: JVEG, JL ! loop counter on patch
LOGICAL :: GPAR_STRESS ! type of stress
!
INTEGER :: ISIZE_LMEB_PATCH ! Number of patches with MEB=true
@@ -111,7 +112,7 @@ INTEGER :: ISIZE_LMEB_PATCH ! Number of patches with MEB=true
INTEGER :: NTIME
INTEGER, PARAMETER :: NTIME_MAX = 36
INTEGER, PARAMETER :: NGROUND_MAX = 150
-INTEGER, PARAMETER :: NVEGTYPE_MAX = 19
+INTEGER, PARAMETER :: NVEGTYPE_MAX = 20
!
REAL, DIMENSION(NVEGTYPE_MAX) :: XSTRESS ! 1. if defensive /0. if offensive
!
@@ -136,12 +137,12 @@ REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_WRMAX_CF ! coefficient fo
REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_RGL !Rgl
REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_CV ! Cv
REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_Z0_O_Z0H ! ratio of roughness lengths
-REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_ALBNIR_VEG ! albedo of vegetation (near-infra-red)
-REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_ALBVIS_VEG ! albedo of vegetation (visible)
-REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_ALBUV_VEG ! albedo of vegetation (UV)
-REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_ALBNIR_SOIL! albedo of soil (near-infra-red)
-REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_ALBVIS_SOIL! albedo of soil (visible)
-REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_ALBUV_SOIL ! albedo of soil (UV)
+REAL, DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: XUNIF_ALBNIR_VEG ! albedo of vegetation (near-infra-red)
+REAL, DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: XUNIF_ALBVIS_VEG ! albedo of vegetation (visible)
+REAL, DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: XUNIF_ALBUV_VEG ! albedo of vegetation (UV)
+REAL, DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: XUNIF_ALBNIR_SOIL! albedo of soil (near-infra-red)
+REAL, DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: XUNIF_ALBVIS_SOIL! albedo of soil (visible)
+REAL, DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: XUNIF_ALBUV_SOIL ! albedo of soil (UV)
REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_GMES ! Gmes
REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_BSLAI ! Biomass over LAI
REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_LAIMIN ! minimum LAI
@@ -155,19 +156,26 @@ REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_CE_NITRO ! CE for nitroge
REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_CF_NITRO ! CF for nitrogen
REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_CNA_NITRO ! CNA for nitrogen
!
-REAL, DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: XUNIF_LAIGV
+REAL, DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: XUNIF_IRRIG
+REAL, DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: XUNIF_WATSUP
+REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_SEED_M
+REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_SEED_D
+REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_REAP_M
+REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_REAP_D
+!
REAL, DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: XUNIF_Z0LITTER
REAL, DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: XUNIF_GNDLITTER
-REAL, DIMENSION(NVEGTYPE_MAX,NGROUND_MAX) :: XUNIF_ROOTFRACGV
-REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_RSMINGV
-REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_GAMMAGV
-REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_WRMAX_CFGV
-REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_RGLGV
REAL, DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: XUNIF_H_VEG
-REAL, DIMENSION(NVEGTYPE_MAX) :: XUNIF_ROOT_EXTINCTIONGV! root extinction parameter
!
LOGICAL, DIMENSION(NVEGTYPE_MAX) :: LUNIF_STRESS ! stress type
!
+REAL, DIMENSION(NGROUND_MAX) :: XUNIF_CONDSAT
+REAL, DIMENSION(NGROUND_MAX) :: XUNIF_MPOTSAT
+REAL, DIMENSION(NGROUND_MAX) :: XUNIF_BCOEF
+REAL, DIMENSION(NGROUND_MAX) :: XUNIF_WWILT
+REAL, DIMENSION(NGROUND_MAX) :: XUNIF_WFC
+REAL, DIMENSION(NGROUND_MAX) :: XUNIF_WSAT
+!
! name of files containing data
!
CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_VEGTYPE ! fractions of each vegtypes
@@ -191,12 +199,12 @@ LOGICAL, DIMENSION(NVEGTYPE_MAX) :: LUNIF_STRESS ! stress type
CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_RGL ! Rgl
CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_CV ! Cv
CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_Z0_O_Z0H ! ratio of roughness lengths
- CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_ALBNIR_VEG ! albedo of vegetation (near-infra-red)
- CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_ALBVIS_VEG ! albedo of vegetation (visible)
- CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_ALBUV_VEG ! albedo of vegetation (UV)
- CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_ALBNIR_SOIL! albedo of soil (near-infra-red)
- CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_ALBVIS_SOIL! albedo of soil (visible)
- CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_ALBUV_SOIL ! albedo of soil (UV)
+ CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFNAM_ALBNIR_VEG ! albedo of vegetation (near-infra-red)
+ CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFNAM_ALBVIS_VEG ! albedo of vegetation (visible)
+ CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFNAM_ALBUV_VEG ! albedo of vegetation (UV)
+ CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFNAM_ALBNIR_SOIL! albedo of soil (near-infra-red)
+ CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFNAM_ALBVIS_SOIL! albedo of soil (visible)
+ CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFNAM_ALBUV_SOIL ! albedo of soil (UV)
CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_GMES ! Gmes
CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_BSLAI ! Biomass over LAI
CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_LAIMIN ! minimum LAI
@@ -210,16 +218,23 @@ LOGICAL, DIMENSION(NVEGTYPE_MAX) :: LUNIF_STRESS ! stress type
CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_CF_NITRO ! CF for nitrogen
CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_CNA_NITRO ! CNA for nitrogen
!
- CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFNAM_LAIGV
- CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFNAM_Z0LITTER
- CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFNAM_GNDLITTER
- CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NGROUND_MAX) :: CFNAM_ROOTFRACGV
- CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_RSMINGV
- CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_GAMMAGV
- CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_WRMAX_CFGV
- CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_RGLGV
- CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFNAM_H_VEG
- CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_ROOT_EXTINCTIONGV! root extinction parameter
+ CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFNAM_IRRIG !
+ CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFNAM_WATSUP !
+ CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_SEED_M !
+ CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_SEED_D !
+ CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_REAP_M !
+ CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: CFNAM_REAP_D !
+!
+CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFNAM_Z0LITTER
+CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFNAM_GNDLITTER
+CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFNAM_H_VEG
+!
+CHARACTER(LEN=28), DIMENSION(NGROUND_MAX) :: CFNAM_CONDSAT
+CHARACTER(LEN=28), DIMENSION(NGROUND_MAX) :: CFNAM_MPOTSAT
+CHARACTER(LEN=28), DIMENSION(NGROUND_MAX) :: CFNAM_BCOEF
+CHARACTER(LEN=28), DIMENSION(NGROUND_MAX) :: CFNAM_WWILT
+CHARACTER(LEN=28), DIMENSION(NGROUND_MAX) :: CFNAM_WFC
+CHARACTER(LEN=28), DIMENSION(NGROUND_MAX) :: CFNAM_WSAT
!
! types of file containing data
!
@@ -244,12 +259,12 @@ LOGICAL, DIMENSION(NVEGTYPE_MAX) :: LUNIF_STRESS ! stress type
CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_RGL ! Rgl
CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_CV ! Cv
CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_Z0_O_Z0H ! ratio of roughness lengths
- CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_ALBNIR_VEG ! albedo of vegetation (near-infra-red)
- CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_ALBVIS_VEG ! albedo of vegetation (visible)
- CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_ALBUV_VEG ! albedo of vegetation (UV)
- CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_ALBNIR_SOIL! albedo of soil (near-infra-red)
- CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_ALBVIS_SOIL! albedo of soil (visible)
- CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_ALBUV_SOIL ! albedo of soil (UV)
+ CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFTYP_ALBNIR_VEG ! albedo of vegetation (near-infra-red)
+ CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFTYP_ALBVIS_VEG ! albedo of vegetation (visible)
+ CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFTYP_ALBUV_VEG ! albedo of vegetation (UV)
+ CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFTYP_ALBNIR_SOIL! albedo of soil (near-infra-red)
+ CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFTYP_ALBVIS_SOIL! albedo of soil (visible)
+ CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFTYP_ALBUV_SOIL ! albedo of soil (UV)
CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_GMES ! Gmes
CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_BSLAI ! Biomass over LAI
CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_LAIMIN ! minimum LAI
@@ -263,16 +278,23 @@ LOGICAL, DIMENSION(NVEGTYPE_MAX) :: LUNIF_STRESS ! stress type
CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_CF_NITRO ! CF for nitrogen
CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_CNA_NITRO ! CNA for nitrogen
!
- CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFTYP_LAIGV
- CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFTYP_Z0LITTER
- CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFTYP_GNDLITTER
- CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NGROUND_MAX) :: CFTYP_ROOTFRACGV
- CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_RSMINGV
- CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_GAMMAGV
- CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_WRMAX_CFGV
- CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_RGLGV
- CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFTYP_H_VEG
- CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_ROOT_EXTINCTIONGV! root extinction parameter
+ CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFTYP_IRRIG
+ CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFTYP_WATSUP
+ CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_SEED_M
+ CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_SEED_D
+ CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_REAP_M
+ CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: CFTYP_REAP_D
+!
+CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFTYP_Z0LITTER
+CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFTYP_GNDLITTER
+CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: CFTYP_H_VEG
+!
+CHARACTER(LEN=6), DIMENSION(NGROUND_MAX) :: CFTYP_CONDSAT
+CHARACTER(LEN=6), DIMENSION(NGROUND_MAX) :: CFTYP_MPOTSAT
+CHARACTER(LEN=6), DIMENSION(NGROUND_MAX) :: CFTYP_BCOEF
+CHARACTER(LEN=6), DIMENSION(NGROUND_MAX) :: CFTYP_WWILT
+CHARACTER(LEN=6), DIMENSION(NGROUND_MAX) :: CFTYP_WFC
+CHARACTER(LEN=6), DIMENSION(NGROUND_MAX) :: CFTYP_WSAT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -286,6 +308,7 @@ NAMELIST/NAM_DATA_ISBA/NTIME, XUNIF_VEGTYPE, XUNIF_DG, XUNIF_ROOTFRAC, XUNIF_DIC
XUNIF_GMES, XUNIF_BSLAI, XUNIF_LAIMIN, XUNIF_SEFOLD, &
XUNIF_GC, XUNIF_DMAX, XUNIF_F2I, LUNIF_STRESS, XUNIF_H_TREE, XUNIF_RE25, &
XUNIF_CE_NITRO, XUNIF_CF_NITRO, XUNIF_CNA_NITRO, &
+ XUNIF_IRRIG, XUNIF_WATSUP, XUNIF_SEED_M, XUNIF_SEED_D, XUNIF_REAP_M, XUNIF_REAP_D, &
CFNAM_VEG,CFNAM_LAI,CFNAM_RSMIN,CFNAM_GAMMA,CFNAM_WRMAX_CF, &
CFNAM_RGL,CFNAM_CV,CFNAM_DG,CFNAM_DICE,CFNAM_Z0,CFNAM_Z0_O_Z0H, &
CFNAM_ALBNIR_VEG,CFNAM_ALBVIS_VEG,CFNAM_ALBUV_VEG, &
@@ -296,6 +319,7 @@ NAMELIST/NAM_DATA_ISBA/NTIME, XUNIF_VEGTYPE, XUNIF_DG, XUNIF_ROOTFRAC, XUNIF_DIC
CFNAM_GMES,CFNAM_BSLAI,CFNAM_LAIMIN,CFNAM_SEFOLD,CFNAM_GC, &
CFNAM_DMAX,CFNAM_F2I, CFNAM_H_TREE,CFNAM_RE25, &
CFNAM_CE_NITRO,CFNAM_CF_NITRO,CFNAM_CNA_NITRO, &
+ CFNAM_IRRIG, CFNAM_WATSUP, CFNAM_SEED_M, CFNAM_SEED_D, CFNAM_REAP_M, CFNAM_REAP_D, &
CFTYP_VEG,CFTYP_LAI,CFTYP_RSMIN,CFTYP_GAMMA,CFTYP_WRMAX_CF, &
CFTYP_RGL,CFTYP_CV,CFTYP_DG,CFTYP_DICE,CFTYP_Z0,CFTYP_Z0_O_Z0H, &
CFTYP_ALBNIR_VEG,CFTYP_ALBVIS_VEG,CFTYP_ALBUV_VEG, &
@@ -306,23 +330,30 @@ NAMELIST/NAM_DATA_ISBA/NTIME, XUNIF_VEGTYPE, XUNIF_DG, XUNIF_ROOTFRAC, XUNIF_DIC
CFTYP_GMES,CFTYP_BSLAI,CFTYP_LAIMIN,CFTYP_SEFOLD,CFTYP_GC, &
CFTYP_DMAX,CFTYP_F2I, CFTYP_H_TREE,CFTYP_RE25, &
CFTYP_CE_NITRO,CFTYP_CF_NITRO,CFTYP_CNA_NITRO, &
- XUNIF_LAIGV, XUNIF_Z0LITTER, XUNIF_ROOTFRACGV, XUNIF_GNDLITTER, XUNIF_RSMINGV, &
- XUNIF_GAMMAGV, XUNIF_WRMAX_CFGV, XUNIF_RGLGV, &
- XUNIF_H_VEG, XUNIF_ROOT_EXTINCTIONGV, &
- CFNAM_LAIGV, CFNAM_Z0LITTER, CFNAM_ROOTFRACGV, CFNAM_GNDLITTER, CFNAM_RSMINGV, &
- CFNAM_GAMMAGV, CFNAM_WRMAX_CFGV, CFNAM_RGLGV, &
- CFNAM_H_VEG, CFNAM_ROOT_EXTINCTIONGV, &
- CFTYP_LAIGV, CFTYP_Z0LITTER, CFTYP_ROOTFRACGV, CFTYP_GNDLITTER, CFTYP_RSMINGV, &
- CFTYP_GAMMAGV, CFTYP_WRMAX_CFGV, CFTYP_RGLGV, &
- CFTYP_H_VEG, CFTYP_ROOT_EXTINCTIONGV
+ CFTYP_IRRIG, CFTYP_WATSUP, CFTYP_SEED_M, CFTYP_SEED_D, CFTYP_REAP_M, CFTYP_REAP_D, &
+ XUNIF_Z0LITTER, XUNIF_GNDLITTER, XUNIF_H_VEG, CFNAM_Z0LITTER, &
+ CFNAM_GNDLITTER, CFNAM_H_VEG, CFTYP_Z0LITTER, CFTYP_GNDLITTER, CFTYP_H_VEG, &
+ XUNIF_CONDSAT, CFNAM_CONDSAT, CFTYP_CONDSAT, XUNIF_MPOTSAT, CFNAM_MPOTSAT, &
+ CFTYP_MPOTSAT, XUNIF_BCOEF, CFNAM_BCOEF, CFTYP_BCOEF, XUNIF_WWILT, CFNAM_WWILT, &
+ CFTYP_WWILT, XUNIF_WFC, CFNAM_WFC, CFTYP_WFC, XUNIF_WSAT, CFNAM_WSAT, CFTYP_WSAT
-DATA XSTRESS /1.,1.,1.,0.,1.,0.,1.,0.,1.,0.,0.,0.,0.,0.,1.,0.,1.,0.,0./
!-------------------------------------------------------------------------------
!
!* 1. Initializations
! ---------------
!
IF (LHOOK) CALL DR_HOOK('PGD_ISBA_PAR',0,ZHOOK_HANDLE)
+!
+IF (U%LECOSG) THEN
+ !4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
+ XSTRESS = (/1.,1.,1.,0.,0.,0.,0.,0.,1.,1.,1.,0.,0.,0.,0.,1.,1.,0.,0.,0./)
+ELSE
+ !1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
+ XSTRESS = (/1.,1.,1.,0.,1.,0.,1.,0.,1.,0.,0.,0.,0.,0.,1.,0.,1.,0.,0.,0./)
+ENDIF
+!
+DTV%NVEGTYPE = NVEGTYPE
+!
NTIME = 36
XUNIF_VEG = XUNDEF ! vegetation fraction
XUNIF_LAI = XUNDEF ! LAI
@@ -362,122 +393,143 @@ XUNIF_CE_NITRO = XUNDEF ! CE for nitrogen
XUNIF_CF_NITRO = XUNDEF ! CF for nitrogen
XUNIF_CNA_NITRO = XUNDEF ! CNA for nitrogen
!
-XUNIF_LAIGV = XUNDEF
+XUNIF_IRRIG = XUNDEF
+XUNIF_WATSUP = XUNDEF
+XUNIF_SEED_M = XUNDEF
+XUNIF_SEED_D = XUNDEF
+XUNIF_REAP_M = XUNDEF
+XUNIF_REAP_D = XUNDEF
+!
XUNIF_Z0LITTER = XUNDEF
-XUNIF_ROOTFRACGV = XUNDEF
XUNIF_GNDLITTER = XUNDEF
-XUNIF_RSMINGV = XUNDEF
-XUNIF_GAMMAGV = XUNDEF
-XUNIF_WRMAX_CFGV = XUNDEF
-XUNIF_RGLGV = XUNDEF
XUNIF_H_VEG = XUNDEF
-XUNIF_ROOT_EXTINCTIONGV = XUNDEF ! root extinction parameter
-!
- CFNAM_VEGTYPE (:) = ' '
-!
- CFNAM_VEG (:,:) = ' '
- CFNAM_LAI (:,:) = ' '
- CFNAM_Z0 (:,:) = ' '
- CFNAM_EMIS (:,:) = ' '
-!
- CFNAM_DG (:,:) = ' '
- CFNAM_ROOTFRAC (:,:) = ' '
- CFNAM_DICE (:) = ' '
-!
- CFNAM_GROUND_DEPTH (:) = ' '
- CFNAM_ROOT_DEPTH (:) = ' '
- CFNAM_ROOT_EXTINCTION (:) = ' '
- CFNAM_ROOT_LIN (:) = ' '
-!
- CFNAM_RSMIN (:) = ' '
- CFNAM_GAMMA (:) = ' '
- CFNAM_WRMAX_CF (:) = ' '
- CFNAM_RGL (:) = ' '
- CFNAM_CV (:) = ' '
- CFNAM_Z0_O_Z0H (:) = ' '
- CFNAM_ALBNIR_VEG (:) = ' '
- CFNAM_ALBVIS_VEG (:) = ' '
- CFNAM_ALBUV_VEG (:) = ' '
- CFNAM_ALBNIR_SOIL (:) = ' '
- CFNAM_ALBVIS_SOIL (:) = ' '
- CFNAM_ALBUV_SOIL (:) = ' '
- CFNAM_GMES (:) = ' '
- CFNAM_BSLAI (:) = ' '
- CFNAM_LAIMIN (:) = ' '
- CFNAM_SEFOLD (:) = ' '
- CFNAM_GC (:) = ' '
- CFNAM_DMAX (:) = ' '
- CFNAM_F2I (:) = ' '
- CFNAM_H_TREE (:) = ' '
- CFNAM_RE25 (:) = ' '
- CFNAM_CE_NITRO (:) = ' '
- CFNAM_CF_NITRO (:) = ' '
- CFNAM_CNA_NITRO (:) = ' '
-!
- CFNAM_LAIGV (:,:) = ' '
- CFNAM_Z0LITTER (:,:) = ' '
- CFNAM_GNDLITTER (:,:) = ' '
- CFNAM_ROOTFRACGV (:,:) = ' '
- CFNAM_RSMINGV (:) = ' '
- CFNAM_GAMMAGV (:) = ' '
- CFNAM_WRMAX_CFGV (:) = ' '
- CFNAM_RGLGV (:) = ' '
- CFNAM_H_VEG (:,:) = ' '
- CFNAM_ROOT_EXTINCTIONGV (:) = ' '
-
- CFTYP_VEGTYPE (:) = ' '
-!
- CFTYP_VEG (:,:) = ' '
- CFTYP_LAI (:,:) = ' '
- CFTYP_Z0 (:,:) = ' '
- CFTYP_EMIS (:,:) = ' '
-!
- CFTYP_DG (:,:) = ' '
- CFTYP_ROOTFRAC (:,:) = ' '
- CFTYP_DICE (:) = ' '
-!
- CFTYP_GROUND_DEPTH (:) = ' '
- CFTYP_ROOT_DEPTH (:) = ' '
- CFTYP_ROOT_EXTINCTION (:) = ' '
- CFTYP_ROOT_LIN (:) = ' '
-!
- CFTYP_RSMIN (:) = ' '
- CFTYP_GAMMA (:) = ' '
- CFTYP_WRMAX_CF (:) = ' '
- CFTYP_RGL (:) = ' '
- CFTYP_CV (:) = ' '
- CFTYP_Z0_O_Z0H (:) = ' '
- CFTYP_ALBNIR_VEG (:) = ' '
- CFTYP_ALBVIS_VEG (:) = ' '
- CFTYP_ALBUV_VEG (:) = ' '
- CFTYP_ALBNIR_SOIL (:) = ' '
- CFTYP_ALBVIS_SOIL (:) = ' '
- CFTYP_ALBUV_SOIL (:) = ' '
- CFTYP_GMES (:) = ' '
- CFTYP_BSLAI (:) = ' '
- CFTYP_LAIMIN (:) = ' '
- CFTYP_SEFOLD (:) = ' '
- CFTYP_GC (:) = ' '
- CFTYP_DMAX (:) = ' '
- CFTYP_F2I (:) = ' '
- CFTYP_H_TREE (:) = ' '
- CFTYP_RE25 (:) = ' '
- CFTYP_CE_NITRO (:) = ' '
- CFTYP_CF_NITRO (:) = ' '
- CFTYP_CNA_NITRO (:) = ' '
-!
- CFTYP_LAIGV (:,:) = ' '
- CFTYP_Z0LITTER (:,:) = ' '
- CFTYP_GNDLITTER (:,:) = ' '
- CFTYP_ROOTFRACGV (:,:) = ' '
- CFTYP_RSMINGV (:) = ' '
- CFTYP_GAMMAGV (:) = ' '
- CFTYP_WRMAX_CFGV (:) = ' '
- CFTYP_RGLGV (:) = ' '
- CFTYP_H_VEG (:,:) = ' '
- CFTYP_ROOT_EXTINCTIONGV (:) = ' '
-!
-ISIZE_LMEB_PATCH=COUNT(I%LMEB_PATCH(:))
+!
+XUNIF_CONDSAT = XUNDEF
+XUNIF_MPOTSAT = XUNDEF
+XUNIF_BCOEF = XUNDEF
+XUNIF_WWILT = XUNDEF
+XUNIF_WFC = XUNDEF
+XUNIF_WSAT = XUNDEF
+!
+CFNAM_VEGTYPE (:) = ' '
+!
+CFNAM_VEG (:,:) = ' '
+CFNAM_LAI (:,:) = ' '
+CFNAM_Z0 (:,:) = ' '
+CFNAM_EMIS (:,:) = ' '
+!
+CFNAM_DG (:,:) = ' '
+CFNAM_ROOTFRAC (:,:) = ' '
+CFNAM_DICE (:) = ' '
+!
+CFNAM_GROUND_DEPTH (:) = ' '
+CFNAM_ROOT_DEPTH (:) = ' '
+CFNAM_ROOT_EXTINCTION (:) = ' '
+CFNAM_ROOT_LIN (:) = ' '
+!
+CFNAM_RSMIN (:) = ' '
+CFNAM_GAMMA (:) = ' '
+CFNAM_WRMAX_CF (:) = ' '
+CFNAM_RGL (:) = ' '
+CFNAM_CV (:) = ' '
+CFNAM_Z0_O_Z0H (:) = ' '
+CFNAM_ALBNIR_VEG (:,:) = ' '
+CFNAM_ALBVIS_VEG (:,:) = ' '
+CFNAM_ALBUV_VEG (:,:) = ' '
+CFNAM_ALBNIR_SOIL (:,:) = ' '
+CFNAM_ALBVIS_SOIL (:,:) = ' '
+CFNAM_ALBUV_SOIL (:,:) = ' '
+CFNAM_GMES (:) = ' '
+CFNAM_BSLAI (:) = ' '
+CFNAM_LAIMIN (:) = ' '
+CFNAM_SEFOLD (:) = ' '
+CFNAM_GC (:) = ' '
+CFNAM_DMAX (:) = ' '
+CFNAM_F2I (:) = ' '
+CFNAM_H_TREE (:) = ' '
+CFNAM_RE25 (:) = ' '
+CFNAM_CE_NITRO (:) = ' '
+CFNAM_CF_NITRO (:) = ' '
+CFNAM_CNA_NITRO (:) = ' '
+!
+CFNAM_IRRIG (:,:) = ' '
+CFNAM_WATSUP (:,:) = ' '
+CFNAM_SEED_M (:) = ' '
+CFNAM_SEED_D (:) = ' '
+CFNAM_REAP_M (:) = ' '
+CFNAM_REAP_D (:) = ' '
+!
+CFNAM_Z0LITTER (:,:) = ' '
+CFNAM_GNDLITTER (:,:) = ' '
+CFNAM_H_VEG (:,:) = ' '
+!
+CFNAM_CONDSAT (:) = ' '
+CFNAM_MPOTSAT (:) = ' '
+CFNAM_BCOEF (:) = ' '
+CFNAM_WWILT (:) = ' '
+CFNAM_WFC (:) = ' '
+CFNAM_WSAT (:) = ' '
+!
+CFTYP_VEGTYPE (:) = ' '
+!
+CFTYP_VEG (:,:) = ' '
+CFTYP_LAI (:,:) = ' '
+CFTYP_Z0 (:,:) = ' '
+CFTYP_EMIS (:,:) = ' '
+!
+CFTYP_DG (:,:) = ' '
+CFTYP_ROOTFRAC (:,:) = ' '
+CFTYP_DICE (:) = ' '
+!
+CFTYP_GROUND_DEPTH (:) = ' '
+CFTYP_ROOT_DEPTH (:) = ' '
+CFTYP_ROOT_EXTINCTION (:) = ' '
+CFTYP_ROOT_LIN (:) = ' '
+!
+CFTYP_RSMIN (:) = ' '
+CFTYP_GAMMA (:) = ' '
+CFTYP_WRMAX_CF (:) = ' '
+CFTYP_RGL (:) = ' '
+CFTYP_CV (:) = ' '
+CFTYP_Z0_O_Z0H (:) = ' '
+CFTYP_ALBNIR_VEG (:,:) = ' '
+CFTYP_ALBVIS_VEG (:,:) = ' '
+CFTYP_ALBUV_VEG (:,:) = ' '
+CFTYP_ALBNIR_SOIL (:,:) = ' '
+CFTYP_ALBVIS_SOIL (:,:) = ' '
+CFTYP_ALBUV_SOIL (:,:) = ' '
+CFTYP_GMES (:) = ' '
+CFTYP_BSLAI (:) = ' '
+CFTYP_LAIMIN (:) = ' '
+CFTYP_SEFOLD (:) = ' '
+CFTYP_GC (:) = ' '
+CFTYP_DMAX (:) = ' '
+CFTYP_F2I (:) = ' '
+CFTYP_H_TREE (:) = ' '
+CFTYP_RE25 (:) = ' '
+CFTYP_CE_NITRO (:) = ' '
+CFTYP_CF_NITRO (:) = ' '
+CFTYP_CNA_NITRO (:) = ' '
+!
+CFTYP_IRRIG (:,:) = ' '
+CFTYP_WATSUP (:,:) = ' '
+CFTYP_SEED_M (:) = ' '
+CFTYP_SEED_D (:) = ' '
+CFTYP_REAP_M (:) = ' '
+CFTYP_REAP_D (:) = ' '
+!
+CFTYP_Z0LITTER (:,:) = ' '
+CFTYP_GNDLITTER (:,:) = ' '
+CFTYP_H_VEG (:,:) = ' '
+!
+CFTYP_CONDSAT (:) = ' '
+CFTYP_MPOTSAT (:) = ' '
+CFTYP_BCOEF (:) = ' '
+CFTYP_WWILT (:) = ' '
+CFTYP_WFC (:) = ' '
+CFTYP_WSAT (:) = ' '
+!
+ISIZE_LMEB_PATCH=COUNT(IO%LMEB_PATCH(:))
!-------------------------------------------------------------------------------
!
!* 2. Input file for cover types
@@ -491,7 +543,7 @@ IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_DATA_ISBA)
!
CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
!
-DTI%NTIME = NTIME
+DTV%NTIME = NTIME
!
!-------------------------------------------------------------------------------
IF (NVEGTYPE_MAX < NVEGTYPE) THEN
@@ -504,12 +556,12 @@ IF (NVEGTYPE_MAX < NVEGTYPE) THEN
CALL ABOR1_SFX('PGD_ISBA_PAR: MAXIMUM NUMBER OF VEGTYPE MUST BE INCREASED IN NAMELIST DECLARATION')
END IF
!-------------------------------------------------------------------------------
-IF (NGROUND_MAX < I%NGROUND_LAYER) THEN
+IF (NGROUND_MAX < IO%NGROUND_LAYER) THEN
WRITE(ILUOUT,*) '------------------------------------'
WRITE(ILUOUT,*) 'Please update pgd_isba_par.f90 routine : '
WRITE(ILUOUT,*) 'The maximum number of soil layers '
WRITE(ILUOUT,*) 'in the declaration of the namelist variables '
- WRITE(ILUOUT,*) 'must be increased to : ', I%NGROUND_LAYER
+ WRITE(ILUOUT,*) 'must be increased to : ', IO%NGROUND_LAYER
WRITE(ILUOUT,*) '------------------------------------'
CALL ABOR1_SFX('PGD_ISBA_PAR: MAXIMUM NUMBER OF SOIL LAYERS MUST BE INCREASED IN NAMELIST DECLARATION')
END IF
@@ -525,12 +577,17 @@ IF (NTIME/=36 .AND. NTIME/=12 .AND. NTIME/=2 .AND. NTIME/=1) &
!
!-------------------------------------vegtypes-----------------------------------------
!
-ALLOCATE(DTI%XPAR_VEGTYPE (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','VEGTYPE: vegetation type','NAT',CFNAM_VEGTYPE, &
- CFTYP_VEGTYPE,XUNIF_VEGTYPE,DTI%XPAR_VEGTYPE,DTI%LDATA_VEGTYPE)
+ALLOCATE(DTV%XPAR_VEGTYPE(KDIM,NVEGTYPE))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, &
+ HPROGRAM,'ARI','VEGTYPE: vegetation type','NAT',CFNAM_VEGTYPE, &
+ CFTYP_VEGTYPE,XUNIF_VEGTYPE,DTV%XPAR_VEGTYPE,DTV%LDATA_VEGTYPE)
+IF (.NOT. DTV%LDATA_VEGTYPE ) THEN
+ DO JVEG = 1,NVEGTYPE
+ CALL AV_PGD(DTCO, DTV%XPAR_VEGTYPE(:,JVEG),S%XCOVER,DTCO%XDATA_VEGTYPE(:,JVEG),'NAT','ARI',S%LCOVER)
+ ENDDO
+ENDIF
!
-IF (.NOT.I%LECOCLIMAP .AND. .NOT.DTI%LDATA_VEGTYPE) THEN
+IF (.NOT.IO%LECOCLIMAP .AND. .NOT.DTV%LDATA_VEGTYPE) THEN
!
WRITE(ILUOUT,*) ' '
WRITE(ILUOUT,*) '***********************************************************'
@@ -541,56 +598,62 @@ IF (.NOT.I%LECOCLIMAP .AND. .NOT.DTI%LDATA_VEGTYPE) THEN
WRITE(ILUOUT,*) ' '
CALL ABOR1_SFX('PGD_ISBA_PAR: NO PRESCRIBED VALUE NOR INPUT FILE FOR VEGTYPE')
!
-ELSEIF (DTI%LDATA_VEGTYPE) THEN
+ELSEIF (DTV%LDATA_VEGTYPE) THEN
!
- WHERE (DTI%XPAR_VEGTYPE(:,:)==XUNDEF) DTI%XPAR_VEGTYPE(:,:)=0.
- WHERE (DTI%XPAR_VEGTYPE(:,:)/=0.) DTI%XPAR_VEGTYPE(:,:) = DTI%XPAR_VEGTYPE(:,:) / &
- SPREAD(SUM(DTI%XPAR_VEGTYPE(:,:),2),2,NVEGTYPE)
+ WHERE (DTV%XPAR_VEGTYPE(:,:)==XUNDEF) DTV%XPAR_VEGTYPE(:,:)=0.
+ WHERE (DTV%XPAR_VEGTYPE(:,:)/=0.) DTV%XPAR_VEGTYPE(:,:) = DTV%XPAR_VEGTYPE(:,:) / &
+ SPREAD(SUM(DTV%XPAR_VEGTYPE(:,:),2),2,NVEGTYPE)
!
ENDIF
!
!--------------------------------temporal fields-----------------------------------
!
-ALLOCATE(DTI%XPAR_VEG (IG%NDIM,NTIME,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
+ALLOCATE(DTV%LDATA_VEG(NTIME*NVEGTYPE))
+ALLOCATE(DTV%XPAR_VEG(KDIM,NTIME,NVEGTYPE))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
HPROGRAM,'ARI','VEG: vegetation fraction','NAT',CFNAM_VEG,CFTYP_VEG,XUNIF_VEG, &
- DTI%XPAR_VEG,DTI%LDATA_VEG)
-IF (.NOT. DTI%LDATA_VEG) DEALLOCATE(DTI%XPAR_VEG)
+ DTV%XPAR_VEG,DTV%LDATA_VEG)
+IF (ALL(.NOT.DTV%LDATA_VEG)) DEALLOCATE(DTV%XPAR_VEG)
!
-ALLOCATE(DTI%XPAR_LAI (IG%NDIM,NTIME,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
+ALLOCATE(DTV%LDATA_LAI(NTIME*NVEGTYPE))
+ALLOCATE(DTV%XPAR_LAI(KDIM,NTIME,NVEGTYPE))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
HPROGRAM,'ARI','LAI: leaf area index','NAT',CFNAM_LAI,CFTYP_LAI,XUNIF_LAI, &
- DTI%XPAR_LAI,DTI%LDATA_LAI)
-IF (.NOT. DTI%LDATA_VEGTYPE .AND. .NOT. DTI%LDATA_LAI) DEALLOCATE(DTI%XPAR_LAI)
+ DTV%XPAR_LAI,DTV%LDATA_LAI)
+IF (ALL(.NOT.DTV%LDATA_LAI)) DEALLOCATE(DTV%XPAR_LAI)
!
-ALLOCATE(DTI%XPAR_H_VEG (IG%NDIM,NTIME,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
+ALLOCATE(DTV%LDATA_H_VEG(NTIME*NVEGTYPE))
+ALLOCATE(DTV%XPAR_H_VEG(KDIM,NTIME,NVEGTYPE))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
HPROGRAM,'ARI','H_VEG: vegetation height','NAT',CFNAM_H_VEG,CFTYP_H_VEG,XUNIF_H_VEG, &
- DTI%XPAR_H_VEG,DTI%LDATA_H_VEG)
-IF (.NOT. DTI%LDATA_H_VEG) DEALLOCATE(DTI%XPAR_H_VEG)
+ DTV%XPAR_H_VEG,DTV%LDATA_H_VEG)
+IF (ALL(.NOT.DTV%LDATA_H_VEG)) DEALLOCATE(DTV%XPAR_H_VEG)
!
-ALLOCATE(DTI%XPAR_Z0 (IG%NDIM,NTIME,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
+ALLOCATE(DTV%LDATA_Z0(NTIME*NVEGTYPE))
+ALLOCATE(DTV%XPAR_Z0(KDIM,NTIME,NVEGTYPE))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
HPROGRAM,'CDN','Z0: roughness length','NAT',CFNAM_Z0,CFTYP_Z0,XUNIF_Z0, &
- DTI%XPAR_Z0,DTI%LDATA_Z0)
-IF (.NOT. DTI%LDATA_Z0) DEALLOCATE(DTI%XPAR_Z0)
+ DTV%XPAR_Z0,DTV%LDATA_Z0)
+IF (ALL(.NOT.DTV%LDATA_Z0)) DEALLOCATE(DTV%XPAR_Z0)
!
-ALLOCATE(DTI%XPAR_EMIS (IG%NDIM,NTIME,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
+ALLOCATE(DTV%LDATA_EMIS(NTIME*NVEGTYPE))
+ALLOCATE(DTV%XPAR_EMIS(KDIM,NTIME,NVEGTYPE))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
HPROGRAM,'ARI','EMIS: emissivity','NAT',CFNAM_EMIS,CFTYP_EMIS,XUNIF_EMIS, &
- DTI%XPAR_EMIS,DTI%LDATA_EMIS)
-IF (.NOT. DTI%LDATA_EMIS) DEALLOCATE(DTI%XPAR_EMIS)
+ DTV%XPAR_EMIS,DTV%LDATA_EMIS)
+IF (ALL(.NOT.DTV%LDATA_EMIS)) DEALLOCATE(DTV%XPAR_EMIS)
!
-IF (.NOT.I%LECOCLIMAP .AND. .NOT.(DTI%LDATA_VEG .AND. DTI%LDATA_LAI .AND. DTI%LDATA_Z0 .AND. DTI%LDATA_EMIS)) THEN
+IF (.NOT.IO%LECOCLIMAP .AND. .NOT.(ANY(DTV%LDATA_VEG) .AND. ANY(DTV%LDATA_LAI) .AND. &
+ ANY(DTV%LDATA_Z0) .AND. ANY(DTV%LDATA_EMIS))) THEN
!
WRITE(ILUOUT,*) ' '
WRITE(ILUOUT,*) '***********************************************************'
WRITE(ILUOUT,*) '* Error in PGD field preparation of temporal fields *'
WRITE(ILUOUT,*) '* There is no prescribed value and no input file : *'
- IF (.NOT.DTI%LDATA_VEG ) WRITE(ILUOUT,*) '* for VEG *'
- IF (.NOT.DTI%LDATA_LAI ) WRITE(ILUOUT,*) '* for LAI *'
- IF (.NOT.DTI%LDATA_Z0 ) WRITE(ILUOUT,*) '* for Z0 *'
- IF (.NOT.DTI%LDATA_EMIS) WRITE(ILUOUT,*) '* for EMIS *'
+ IF (ALL(.NOT.DTV%LDATA_VEG )) WRITE(ILUOUT,*) '* for VEG *'
+ IF (ALL(.NOT.DTV%LDATA_LAI )) WRITE(ILUOUT,*) '* for LAI *'
+ IF (ALL(.NOT.DTV%LDATA_Z0 )) WRITE(ILUOUT,*) '* for Z0 *'
+ IF (ALL(.NOT.DTV%LDATA_EMIS)) WRITE(ILUOUT,*) '* for EMIS *'
WRITE(ILUOUT,*) '* Without ECOCLIMAP, these fields must be prescribed *'
WRITE(ILUOUT,*) '***********************************************************'
WRITE(ILUOUT,*) ' '
@@ -598,113 +661,116 @@ IF (.NOT.I%LECOCLIMAP .AND. .NOT.(DTI%LDATA_VEG .AND. DTI%LDATA_LAI .AND. DTI%LD
!
ENDIF
!
+ALLOCATE(DTV%LDATA_ALBNIR_VEG(NTIME*NVEGTYPE))
+ALLOCATE(DTV%XPAR_ALBNIR_VEG(KDIM,NTIME,NVEGTYPE))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','ALBNIR_VEG: NIR albedo of vegetation','NAT',CFNAM_ALBNIR_VEG, &
+ CFTYP_ALBNIR_VEG,XUNIF_ALBNIR_VEG,DTV%XPAR_ALBNIR_VEG,DTV%LDATA_ALBNIR_VEG)
+IF (ALL(.NOT.DTV%LDATA_ALBNIR_VEG)) DEALLOCATE(DTV%XPAR_ALBNIR_VEG)
+!
+ALLOCATE(DTV%LDATA_ALBVIS_VEG(NTIME*NVEGTYPE))
+ALLOCATE(DTV%XPAR_ALBVIS_VEG(KDIM,NTIME,NVEGTYPE))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','ALBVIS_VEG: VIS albedo of vegetation','NAT',CFNAM_ALBVIS_VEG, &
+ CFTYP_ALBVIS_VEG,XUNIF_ALBVIS_VEG,DTV%XPAR_ALBVIS_VEG,DTV%LDATA_ALBVIS_VEG)
+IF (ALL(.NOT.DTV%LDATA_ALBVIS_VEG)) DEALLOCATE(DTV%XPAR_ALBVIS_VEG)
+!
+ALLOCATE(DTV%LDATA_ALBUV_VEG(NTIME*NVEGTYPE))
+ALLOCATE(DTV%XPAR_ALBUV_VEG(KDIM,NTIME,NVEGTYPE))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','ALBUV_VEG: UV albedo of vegetation','NAT',CFNAM_ALBUV_VEG, &
+ CFTYP_ALBUV_VEG,XUNIF_ALBUV_VEG,DTV%XPAR_ALBUV_VEG,DTV%LDATA_ALBUV_VEG)
+IF (ALL(.NOT.DTV%LDATA_ALBUV_VEG)) DEALLOCATE(DTV%XPAR_ALBUV_VEG)
+!
+ALLOCATE(DTV%LDATA_ALBNIR_SOIL(NTIME*NVEGTYPE))
+ALLOCATE(DTV%XPAR_ALBNIR_SOIL(KDIM,NTIME,NVEGTYPE))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','ALBNIR_SOIL: NIR albedo of SOIL','NAT',CFNAM_ALBNIR_SOIL, &
+ CFTYP_ALBNIR_SOIL,XUNIF_ALBNIR_SOIL,DTV%XPAR_ALBNIR_SOIL,DTV%LDATA_ALBNIR_SOIL)
+IF (ALL(.NOT.DTV%LDATA_ALBNIR_SOIL)) DEALLOCATE(DTV%XPAR_ALBNIR_SOIL)
+!
+ALLOCATE(DTV%LDATA_ALBVIS_SOIL(NTIME*NVEGTYPE))
+ALLOCATE(DTV%XPAR_ALBVIS_SOIL(KDIM,NTIME,NVEGTYPE))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','ALBVIS_SOIL: VIS albedo of SOIL','NAT',CFNAM_ALBVIS_SOIL, &
+ CFTYP_ALBVIS_SOIL,XUNIF_ALBVIS_SOIL,DTV%XPAR_ALBVIS_SOIL,DTV%LDATA_ALBVIS_SOIL)
+IF (ALL(.NOT.DTV%LDATA_ALBVIS_SOIL)) DEALLOCATE(DTV%XPAR_ALBVIS_SOIL)
+!
+ALLOCATE(DTV%LDATA_ALBUV_SOIL(NTIME*NVEGTYPE))
+ALLOCATE(DTV%XPAR_ALBUV_SOIL(KDIM,NTIME,NVEGTYPE))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','ALBUV_SOIL: UV albedo of SOIL','NAT',CFNAM_ALBUV_SOIL, &
+ CFTYP_ALBUV_SOIL,XUNIF_ALBUV_SOIL,DTV%XPAR_ALBUV_SOIL,DTV%LDATA_ALBUV_SOIL)
+IF (ALL(.NOT.DTV%LDATA_ALBUV_SOIL)) DEALLOCATE(DTV%XPAR_ALBUV_SOIL)
+!
+!
! ------------ Begin MEB parameters ---------------------
+!
+ALLOCATE(DTV%LDATA_GNDLITTER(NTIME*NVEGTYPE))
+ALLOCATE(DTV%LDATA_Z0LITTER (NTIME*NVEGTYPE))
+DTV%LDATA_GNDLITTER(:) = .FALSE.
+DTV%LDATA_Z0LITTER (:) = .FALSE.
+!
IF(ISIZE_LMEB_PATCH>0) THEN
!
- ALLOCATE(DTI%XPAR_LAIGV (IG%NDIM,NTIME,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','LAIGV: GV leaf area index','NAT', &
- CFNAM_LAIGV,CFTYP_LAIGV,XUNIF_LAIGV,DTI%XPAR_LAIGV,DTI%LDATA_LAIGV)
- IF (.NOT. DTI%LDATA_LAIGV) DEALLOCATE(DTI%XPAR_LAIGV)
+ ALLOCATE(DTV%XPAR_GNDLITTER(KDIM,NTIME,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','GNDLITTER: ground litter fraction','NAT',&
+ CFNAM_GNDLITTER,CFTYP_GNDLITTER,XUNIF_GNDLITTER,DTV%XPAR_GNDLITTER,DTV%LDATA_GNDLITTER)
+ IF (ALL(.NOT.DTV%LDATA_GNDLITTER)) DEALLOCATE(DTV%XPAR_GNDLITTER)
!
- ALLOCATE(DTI%XPAR_GNDLITTER (IG%NDIM,NTIME,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','GNDLITTER: ground litter fraction','NAT',&
- CFNAM_GNDLITTER,CFTYP_GNDLITTER,XUNIF_GNDLITTER,DTI%XPAR_GNDLITTER,DTI%LDATA_GNDLITTER)
- IF (.NOT. DTI%LDATA_GNDLITTER) DEALLOCATE(DTI%XPAR_GNDLITTER)
- !
- ALLOCATE(DTI%XPAR_Z0LITTER (IG%NDIM,NTIME,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'CDN','Z0LITTER: ground litter roughness length','NAT', &
- CFNAM_Z0LITTER,CFTYP_Z0LITTER,XUNIF_Z0LITTER,DTI%XPAR_Z0LITTER,DTI%LDATA_Z0LITTER)
- IF (.NOT. DTI%LDATA_Z0LITTER) DEALLOCATE(DTI%XPAR_Z0LITTER)
+ ALLOCATE(DTV%XPAR_Z0LITTER(KDIM,NTIME,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'CDN','Z0LITTER: ground litter roughness length','NAT', &
+ CFNAM_Z0LITTER,CFTYP_Z0LITTER,XUNIF_Z0LITTER,DTV%XPAR_Z0LITTER,DTV%LDATA_Z0LITTER)
+ IF (ALL(.NOT.DTV%LDATA_Z0LITTER)) DEALLOCATE(DTV%XPAR_Z0LITTER)
!
ENDIF
! ------------ End MEB parameters ---------------------
!
!--------------------------------depths fields-----------------------------------
!
-ALLOCATE(DTI%XPAR_DG (IG%NDIM,I%NGROUND_LAYER,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','DG: ground depth','NAT',CFNAM_DG,CFTYP_DG,XUNIF_DG,DTI%XPAR_DG,DTI%LDATA_DG)
-IF (.NOT. DTI%LDATA_VEGTYPE .AND. .NOT. DTI%LDATA_DG) DEALLOCATE(DTI%XPAR_DG)
+ALLOCATE(DTV%XPAR_DG(KDIM,IO%NGROUND_LAYER,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','DG: ground depth','NAT',CFNAM_DG,CFTYP_DG,&
+ XUNIF_DG,DTV%XPAR_DG,DTV%LDATA_DG(1:NVEGTYPE))
+IF (ALL(.NOT.DTV%LDATA_DG)) DEALLOCATE(DTV%XPAR_DG)
!
-ALLOCATE(DTI%XPAR_ROOT_DEPTH (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','ROOT_DEPTH: root depth','NAT',CFNAM_ROOT_DEPTH,CFTYP_ROOT_DEPTH,&
- XUNIF_ROOT_DEPTH,DTI%XPAR_ROOT_DEPTH,DTI%LDATA_ROOT_DEPTH)
-!
-ALLOCATE(DTI%XPAR_GROUND_DEPTH (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
+ALLOCATE(DTV%XPAR_ROOT_DEPTH(KDIM,NVEGTYPE))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','ROOT_DEPTH: root depth','NAT',CFNAM_ROOT_DEPTH,CFTYP_ROOT_DEPTH,&
+ XUNIF_ROOT_DEPTH,DTV%XPAR_ROOT_DEPTH,DTV%LDATA_ROOT_DEPTH)
+IF (ALL(.NOT.DTV%LDATA_ROOT_DEPTH)) DEALLOCATE(DTV%XPAR_ROOT_DEPTH)
+ALLOCATE(DTV%XPAR_GROUND_DEPTH(KDIM,NVEGTYPE))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
HPROGRAM,'ARI','GROUND_DEPTH: ground depth','NAT',CFNAM_GROUND_DEPTH,CFTYP_GROUND_DEPTH,&
- XUNIF_GROUND_DEPTH,DTI%XPAR_GROUND_DEPTH,DTI%LDATA_GROUND_DEPTH)
+ XUNIF_GROUND_DEPTH,DTV%XPAR_GROUND_DEPTH,DTV%LDATA_GROUND_DEPTH)
+IF (ALL(.NOT.DTV%LDATA_GROUND_DEPTH)) DEALLOCATE(DTV%XPAR_GROUND_DEPTH)
!
-IF(I%CISBA=='DIF')THEN
+IF(IO%CISBA=='DIF')THEN
!
- ALLOCATE(DTI%XPAR_ROOTFRAC (IG%NDIM,I%NGROUND_LAYER,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','ROOTFRAC: root fraction','NAT',CFNAM_ROOTFRAC,CFTYP_ROOTFRAC,&
- XUNIF_ROOTFRAC,DTI%XPAR_ROOTFRAC,DTI%LDATA_ROOTFRAC)
- IF (.NOT. DTI%LDATA_ROOTFRAC) DEALLOCATE(DTI%XPAR_ROOTFRAC)
+ ALLOCATE(DTV%XPAR_ROOTFRAC(KDIM,IO%NGROUND_LAYER,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','ROOTFRAC: root fraction','NAT',&
+ CFNAM_ROOTFRAC,CFTYP_ROOTFRAC,XUNIF_ROOTFRAC,&
+ DTV%XPAR_ROOTFRAC,DTV%LDATA_ROOTFRAC(1:NVEGTYPE))
+ IF (ALL(.NOT.DTV%LDATA_ROOTFRAC)) DEALLOCATE(DTV%XPAR_ROOTFRAC)
!
- ALLOCATE(DTI%XPAR_ROOT_EXTINCTION (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
+ ALLOCATE(DTV%XPAR_ROOT_EXTINCTION(KDIM,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
HPROGRAM,'ARI','ROOT_EXTINCTION: root extinction','NAT',CFNAM_ROOT_EXTINCTION,CFTYP_ROOT_EXTINCTION,&
- XUNIF_ROOT_EXTINCTION,DTI%XPAR_ROOT_EXTINCTION,DTI%LDATA_ROOT_EXTINCTION)
- IF (.NOT. DTI%LDATA_ROOT_EXTINCTION) DEALLOCATE(DTI%XPAR_ROOT_EXTINCTION)
- !
- ALLOCATE(DTI%XPAR_ROOT_LIN (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
+ XUNIF_ROOT_EXTINCTION,DTV%XPAR_ROOT_EXTINCTION,DTV%LDATA_ROOT_EXTINCTION)
+ IF (ALL(.NOT.DTV%LDATA_ROOT_EXTINCTION)) DEALLOCATE(DTV%XPAR_ROOT_EXTINCTION)
+ !
+ ALLOCATE(DTV%XPAR_ROOT_LIN(KDIM,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
HPROGRAM,'ARI','ROOT_LIN: root linear','NAT',CFNAM_ROOT_LIN,CFTYP_ROOT_LIN,&
- XUNIF_ROOT_LIN,DTI%XPAR_ROOT_LIN,DTI%LDATA_ROOT_LIN)
- IF (.NOT. DTI%LDATA_ROOT_LIN) DEALLOCATE(DTI%XPAR_ROOT_LIN)
- !
- ! ------------ Begin MEB parameters ---------------------
- IF(ISIZE_LMEB_PATCH>0) THEN
- !
- ALLOCATE(DTI%XPAR_ROOTFRACGV (IG%NDIM,I%NGROUND_LAYER,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','ROOTFRACGV: GV root fraction','NAT',CFNAM_ROOTFRACGV,CFTYP_ROOTFRACGV,&
- XUNIF_ROOTFRACGV,DTI%XPAR_ROOTFRACGV,DTI%LDATA_ROOTFRACGV)
- IF (.NOT. DTI%LDATA_ROOTFRACGV) DEALLOCATE(DTI%XPAR_ROOTFRACGV)
- !
- ! Apply a function of XPAR_ROOTFRAC on XPAR_ROOTFRACGV if XUNIF_ROOTFRACGV is undefined
- IF (.NOT. DTI%LDATA_ROOTFRACGV .AND. DTI%LDATA_ROOTFRAC)THEN
- ALLOCATE(DTI%XPAR_ROOTFRACGV (IG%NDIM,I%NGROUND_LAYER,NVEGTYPE))
- IHGROUND_LAYER=INT(CEILING(REAL(I%NGROUND_LAYER)/2.0))
- DTI%XPAR_ROOTFRACGV=0.
- DO IIH=1,IHGROUND_LAYER
- DTI%XPAR_ROOTFRACGV(:,IIH,:)=DTI%XPAR_ROOTFRAC(:,IIH,:)
- ENDDO
- ZROOTFRACGV(:,:)=SUM(DTI%XPAR_ROOTFRACGV,DIM=2)
- DO IIH=1,IHGROUND_LAYER
- TEST=RESHAPE(DTI%XPAR_ROOTFRACGV(:,IIH,:),(/IG%NDIM,NVEGTYPE/))
- TEST2=1.
- WHERE(ZROOTFRACGV>0.)TEST2 = 1./ZROOTFRACGV
- TEST3=TEST * TEST2
- DTI%XPAR_ROOTFRACGV(:,IIH,:)=TEST3
- ENDDO
- DTI%LDATA_ROOTFRACGV = .TRUE.
- ENDIF
- ! ' '
- ALLOCATE(DTI%XPAR_ROOT_EXTINCTIONGV(IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','ROOT_EXTINCTIONGV: root ext gv ','NAT',CFNAM_ROOT_EXTINCTIONGV,CFTYP_ROOT_EXTINCTIONGV,&
- XUNIF_ROOT_EXTINCTIONGV,DTI%XPAR_ROOT_EXTINCTIONGV,DTI%LDATA_ROOT_EXTINCTIONGV)
- IF (.NOT. DTI%LDATA_ROOT_EXTINCTIONGV) DEALLOCATE(DTI%XPAR_ROOT_EXTINCTIONGV)
- !
- IF (.NOT. DTI%LDATA_ROOT_EXTINCTIONGV .AND. DTI%LDATA_ROOT_EXTINCTION)THEN
- ALLOCATE(DTI%XPAR_ROOT_EXTINCTIONGV(IG%NDIM,NVEGTYPE))
- DTI%XPAR_ROOT_EXTINCTIONGV = DTI%XPAR_ROOT_EXTINCTION
- DTI%LDATA_ROOT_EXTINCTIONGV = .TRUE.
- ENDIF
- !
- ENDIF
- ! ------------ End MEB parameters ---------------------
+ XUNIF_ROOT_LIN,DTV%XPAR_ROOT_LIN,DTV%LDATA_ROOT_LIN)
+ IF (ALL(.NOT.DTV%LDATA_ROOT_LIN)) DEALLOCATE(DTV%XPAR_ROOT_LIN)
!
- IF (.NOT.I%LECOCLIMAP) THEN
- IF(DTI%LDATA_DG .AND. .NOT.DTI%LDATA_ROOTFRAC .AND. &
- (.NOT.DTI%LDATA_ROOT_DEPTH.OR..NOT.DTI%LDATA_ROOT_EXTINCTION.OR..NOT.DTI%LDATA_ROOT_LIN)) THEN
+ IF (.NOT.IO%LECOCLIMAP) THEN
+ IF(ALL(.NOT.DTV%LDATA_DG) .AND. ALL(.NOT.DTV%LDATA_ROOTFRAC) .AND. &
+ (ALL(.NOT.DTV%LDATA_ROOT_DEPTH).OR.ALL(.NOT.DTV%LDATA_ROOT_EXTINCTION).OR.ALL(.NOT.DTV%LDATA_ROOT_LIN))) THEN
WRITE(ILUOUT,*) ' '
WRITE(ILUOUT,*) '****************************************************************************'
WRITE(ILUOUT,*) '* Without ECOCLIMAP, Error in PGD field preparation for ISBA-DIF *'
@@ -717,9 +783,9 @@ IF(I%CISBA=='DIF')THEN
WRITE(ILUOUT,*) '****************************************************************************'
WRITE(ILUOUT,*) ' '
CALL ABOR1_SFX("PGD_ISBA_PAR: PROBLEM IN SOIL GRID COMPUTATION")
- ELSEIF( .NOT.ALL(I%XSOILGRID(:)==XUNDEF) .AND. &
- (.NOT.DTI%LDATA_GROUND_DEPTH .OR..NOT.DTI%LDATA_ROOT_DEPTH.OR. &
- .NOT.DTI%LDATA_ROOT_EXTINCTION.OR..NOT.DTI%LDATA_ROOT_LIN )) THEN
+ ELSEIF( .NOT.ALL(IO%XSOILGRID(:)==XUNDEF) .AND. &
+ (ALL(.NOT.DTV%LDATA_GROUND_DEPTH) .OR.ALL(.NOT.DTV%LDATA_ROOT_DEPTH).OR. &
+ ALL(.NOT.DTV%LDATA_ROOT_EXTINCTION).OR.ALL(.NOT.DTV%LDATA_ROOT_LIN) )) THEN
WRITE(ILUOUT,*) ' '
WRITE(ILUOUT,*) '****************************************************************************'
WRITE(ILUOUT,*) '* Without ECOCLIMAP, Error in PGD field preparation for ISBA-DIF *'
@@ -733,7 +799,7 @@ IF(I%CISBA=='DIF')THEN
WRITE(ILUOUT,*) ' '
CALL ABOR1_SFX("PGD_ISBA_PAR: PROBLEM IN SOIL GRID COMPUTATION")
ENDIF
- IF(.NOT.DTI%LDATA_DG .AND.ALL(I%XSOILGRID(:)==XUNDEF))THEN
+ IF(ALL(.NOT.DTV%LDATA_DG) .AND.ALL(IO%XSOILGRID(:)==XUNDEF))THEN
WRITE(ILUOUT,*) ' '
WRITE(ILUOUT,*) '****************************************************************************'
WRITE(ILUOUT,*) '* Without ECOCLIMAP, Error in PGD field preparation for ISBA-DIF *'
@@ -750,8 +816,8 @@ IF(I%CISBA=='DIF')THEN
!
ELSE
!
- IF ( .NOT.I%LECOCLIMAP .AND. .NOT.DTI%LDATA_DG .AND. &
- (.NOT.DTI%LDATA_GROUND_DEPTH.OR..NOT.DTI%LDATA_ROOT_DEPTH) ) THEN
+ IF ( .NOT.IO%LECOCLIMAP .AND. ALL(.NOT.DTV%LDATA_DG) .AND. &
+ (ALL(.NOT.DTV%LDATA_GROUND_DEPTH).OR.ALL(.NOT.DTV%LDATA_ROOT_DEPTH)) ) THEN
WRITE(ILUOUT,*) ' '
WRITE(ILUOUT,*) '****************************************************************************'
WRITE(ILUOUT,*) '* Without ECOCLIMAP, Error in PGD field preparation *'
@@ -764,22 +830,26 @@ ELSE
!
ENDIF
!
-ALLOCATE(DTI%XPAR_DICE (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','DICE: ice depth for runoff','NAT',CFNAM_DICE,CFTYP_DICE,&
- XUNIF_DICE,DTI%XPAR_DICE,DTI%LDATA_DICE)
-!
-IF (.NOT.I%LECOCLIMAP.AND..NOT. DTI%LDATA_DICE) THEN
- IF(I%CISBA/='DIF' .AND. (DTI%LDATA_DG.OR.DTI%LDATA_ROOT_DEPTH)) THEN
- IF(DTI%LDATA_DG)THEN
- DTI%XPAR_DICE(:,:) = MAX(0.2,0.8*DTI%XPAR_DG(:,2,:))
- ELSEIF(DTI%LDATA_ROOT_DEPTH)THEN
- DTI%XPAR_DICE(:,:) = MAX(0.2,0.8*DTI%XPAR_ROOT_DEPTH(:,:))
- ENDIF
- DTI%LDATA_DICE=.TRUE.
- ELSEIF (I%CISBA=='DIF') THEN
- DTI%XPAR_DICE(:,:) = 0.0
- DTI%LDATA_DICE=.TRUE.
+ALLOCATE(DTV%XPAR_DICE(KDIM,NVEGTYPE))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','DICE: ice depth for runoff','NAT',CFNAM_DICE,CFTYP_DICE,&
+ XUNIF_DICE,DTV%XPAR_DICE,DTV%LDATA_DICE)
+!
+IF (.NOT.IO%LECOCLIMAP.AND.ALL(.NOT.DTV%LDATA_DICE)) THEN
+ DTV%LDATA_DICE(:) = .FALSE.
+ IF(IO%CISBA/='DIF' .AND. (ANY(DTV%LDATA_DG).OR.ANY(DTV%LDATA_ROOT_DEPTH))) THEN
+ DO JVEG = 1,NVEGTYPE
+ IF(DTV%LDATA_DG(JVEG))THEN
+ DTV%LDATA_DICE(JVEG)=.TRUE.
+ WHERE(DTV%XPAR_DG(:,2,JVEG)/=XUNDEF) DTV%XPAR_DICE(:,JVEG) = MAX(0.2,0.8*DTV%XPAR_DG(:,2,JVEG))
+ ELSEIF(DTV%LDATA_ROOT_DEPTH(JVEG))THEN
+ DTV%LDATA_DICE(JVEG)=.TRUE.
+ WHERE(DTV%XPAR_ROOT_DEPTH(:,JVEG)/=XUNDEF) DTV%XPAR_DICE(:,JVEG) = MAX(0.2,0.8*DTV%XPAR_ROOT_DEPTH(:,JVEG))
+ ENDIF
+ ENDDO
+ ELSEIF (IO%CISBA=='DIF') THEN
+ DTV%XPAR_DICE(:,:) = 0.0
+ DTV%LDATA_DICE(:) =.TRUE.
ELSE
WRITE(ILUOUT,*) ' '
WRITE(ILUOUT,*) '***********************************************************'
@@ -791,101 +861,67 @@ IF (.NOT.I%LECOCLIMAP.AND..NOT. DTI%LDATA_DICE) THEN
CALL ABOR1_SFX('PGD_ISBA_PAR: NO PRESCRIBED VALUE NOR INPUT FILE FOR DICE')
ENDIF
ENDIF
+IF (ALL(.NOT.DTV%LDATA_DICE)) DEALLOCATE(DTV%XPAR_DICE)
!
!---------------------classical fields---------------------------------------------
!
-ALLOCATE(DTI%XPAR_RSMIN (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'INV','RSMIN: minimal stomatal resistance','NAT',CFNAM_RSMIN, &
- CFTYP_RSMIN,XUNIF_RSMIN,DTI%XPAR_RSMIN,DTI%LDATA_RSMIN)
-IF (.NOT. DTI%LDATA_RSMIN) DEALLOCATE(DTI%XPAR_RSMIN)
-!
-ALLOCATE(DTI%XPAR_GAMMA (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','GAMMA: gamma coefficient','NAT',CFNAM_GAMMA, &
- CFTYP_GAMMA,XUNIF_GAMMA,DTI%XPAR_GAMMA,DTI%LDATA_GAMMA)
-IF (.NOT. DTI%LDATA_GAMMA) DEALLOCATE(DTI%XPAR_GAMMA)
-!
-ALLOCATE(DTI%XPAR_WRMAX_CF (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','WRMAX_CF: coeff. for max WR','NAT',CFNAM_WRMAX_CF, &
- CFTYP_WRMAX_CF,XUNIF_WRMAX_CF,DTI%XPAR_WRMAX_CF,DTI%LDATA_WRMAX_CF)
-IF (.NOT. DTI%LDATA_WRMAX_CF) DEALLOCATE(DTI%XPAR_WRMAX_CF)
-!
-ALLOCATE(DTI%XPAR_RGL (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','RGL: max SW rad. for photosynthesis','NAT',CFNAM_RGL, &
- CFTYP_RGL,XUNIF_RGL,DTI%XPAR_RGL,DTI%LDATA_RGL)
-IF (.NOT. DTI%LDATA_RGL) DEALLOCATE(DTI%XPAR_RGL)
-!
-ALLOCATE(DTI%XPAR_CV (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'INV','CV: thermal inertia for vegetation','NAT',CFNAM_CV, &
- CFTYP_CV,XUNIF_CV,DTI%XPAR_CV,DTI%LDATA_CV)
-IF (.NOT. DTI%LDATA_CV) DEALLOCATE(DTI%XPAR_CV)
-!
-ALLOCATE(DTI%XPAR_Z0_O_Z0H (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','Z0_O_Z0H: ratio of roughness lengths','NAT',CFNAM_Z0_O_Z0H, &
- CFTYP_Z0_O_Z0H,XUNIF_Z0_O_Z0H,DTI%XPAR_Z0_O_Z0H,DTI%LDATA_Z0_O_Z0H)
-IF (.NOT. DTI%LDATA_Z0_O_Z0H) DEALLOCATE(DTI%XPAR_Z0_O_Z0H)
-!
-ALLOCATE(DTI%XPAR_ALBNIR_VEG (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','ALBNIR_VEG: NIR albedo of vegetation','NAT',CFNAM_ALBNIR_VEG, &
- CFTYP_ALBNIR_VEG,XUNIF_ALBNIR_VEG,DTI%XPAR_ALBNIR_VEG,DTI%LDATA_ALBNIR_VEG)
-IF (.NOT. DTI%LDATA_ALBNIR_VEG) DEALLOCATE(DTI%XPAR_ALBNIR_VEG)
-!
-ALLOCATE(DTI%XPAR_ALBVIS_VEG (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','ALBVIS_VEG: VIS albedo of vegetation','NAT',CFNAM_ALBVIS_VEG, &
- CFTYP_ALBVIS_VEG,XUNIF_ALBVIS_VEG,DTI%XPAR_ALBVIS_VEG,DTI%LDATA_ALBVIS_VEG)
-IF (.NOT. DTI%LDATA_ALBVIS_VEG) DEALLOCATE(DTI%XPAR_ALBVIS_VEG)
-!
-ALLOCATE(DTI%XPAR_ALBUV_VEG (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','ALBUV_VEG: UV albedo of vegetation','NAT',CFNAM_ALBUV_VEG, &
- CFTYP_ALBUV_VEG,XUNIF_ALBUV_VEG,DTI%XPAR_ALBUV_VEG,DTI%LDATA_ALBUV_VEG)
-IF (.NOT. DTI%LDATA_ALBUV_VEG) DEALLOCATE(DTI%XPAR_ALBUV_VEG)
-!
-ALLOCATE(DTI%XPAR_ALBNIR_SOIL (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','ALBNIR_SOIL: NIR albedo of SOIL','NAT',CFNAM_ALBNIR_SOIL, &
- CFTYP_ALBNIR_SOIL,XUNIF_ALBNIR_SOIL,DTI%XPAR_ALBNIR_SOIL,DTI%LDATA_ALBNIR_SOIL)
-IF (.NOT. DTI%LDATA_ALBNIR_SOIL) DEALLOCATE(DTI%XPAR_ALBNIR_SOIL)
-!
-ALLOCATE(DTI%XPAR_ALBVIS_SOIL (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','ALBVIS_SOIL: VIS albedo of SOIL','NAT',CFNAM_ALBVIS_SOIL, &
- CFTYP_ALBVIS_SOIL,XUNIF_ALBVIS_SOIL,DTI%XPAR_ALBVIS_SOIL,DTI%LDATA_ALBVIS_SOIL)
-IF (.NOT. DTI%LDATA_ALBVIS_SOIL) DEALLOCATE(DTI%XPAR_ALBVIS_SOIL)
-!
-ALLOCATE(DTI%XPAR_ALBUV_SOIL (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','ALBUV_SOIL: UV albedo of SOIL','NAT',CFNAM_ALBUV_SOIL, &
- CFTYP_ALBUV_SOIL,XUNIF_ALBUV_SOIL,DTI%XPAR_ALBUV_SOIL,DTI%LDATA_ALBUV_SOIL)
-IF (.NOT. DTI%LDATA_ALBUV_SOIL) DEALLOCATE(DTI%XPAR_ALBUV_SOIL)
-!
-IF (.NOT.I%LECOCLIMAP .AND. .NOT.(DTI%LDATA_RSMIN.AND.DTI%LDATA_GAMMA.AND.DTI%LDATA_WRMAX_CF.AND.DTI%LDATA_RGL &
- .AND.DTI%LDATA_CV.AND.DTI%LDATA_Z0_O_Z0H.AND.DTI%LDATA_ALBNIR_VEG.AND.DTI%LDATA_ALBVIS_VEG.AND.&
- DTI%LDATA_ALBUV_VEG.AND.DTI%LDATA_ALBNIR_SOIL.AND.DTI%LDATA_ALBVIS_SOIL.AND.DTI%LDATA_ALBUV_SOIL)) THEN
+ALLOCATE(DTV%XPAR_RSMIN(KDIM,NVEGTYPE))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'INV','RSMIN: minimal stomatal resistance','NAT',CFNAM_RSMIN, &
+ CFTYP_RSMIN,XUNIF_RSMIN,DTV%XPAR_RSMIN,DTV%LDATA_RSMIN)
+IF (ALL(.NOT.DTV%LDATA_RSMIN)) DEALLOCATE(DTV%XPAR_RSMIN)
+!
+ALLOCATE(DTV%XPAR_GAMMA(KDIM,NVEGTYPE))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','GAMMA: gamma coefficient','NAT',CFNAM_GAMMA, &
+ CFTYP_GAMMA,XUNIF_GAMMA,DTV%XPAR_GAMMA,DTV%LDATA_GAMMA)
+IF (ALL(.NOT.DTV%LDATA_GAMMA)) DEALLOCATE(DTV%XPAR_GAMMA)
+!
+ALLOCATE(DTV%XPAR_WRMAX_CF(KDIM,NVEGTYPE))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','WRMAX_CF: coeff. for max WR','NAT',CFNAM_WRMAX_CF, &
+ CFTYP_WRMAX_CF,XUNIF_WRMAX_CF,DTV%XPAR_WRMAX_CF,DTV%LDATA_WRMAX_CF)
+IF (ALL(.NOT.DTV%LDATA_WRMAX_CF)) DEALLOCATE(DTV%XPAR_WRMAX_CF)
+!
+ALLOCATE(DTV%XPAR_RGL(KDIM,NVEGTYPE))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','RGL: max SW rad. for photosynthesis','NAT',CFNAM_RGL, &
+ CFTYP_RGL,XUNIF_RGL,DTV%XPAR_RGL,DTV%LDATA_RGL)
+IF (ALL(.NOT.DTV%LDATA_RGL)) DEALLOCATE(DTV%XPAR_RGL)
+!
+ALLOCATE(DTV%XPAR_CV(KDIM,NVEGTYPE))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'INV','CV: thermal inertia for vegetation','NAT',CFNAM_CV, &
+ CFTYP_CV,XUNIF_CV,DTV%XPAR_CV,DTV%LDATA_CV)
+IF (ALL(.NOT.DTV%LDATA_CV)) DEALLOCATE(DTV%XPAR_CV)
+!
+ALLOCATE(DTV%XPAR_Z0_O_Z0H(KDIM,NVEGTYPE))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','Z0_O_Z0H: ratio of roughness lengths','NAT',CFNAM_Z0_O_Z0H, &
+ CFTYP_Z0_O_Z0H,XUNIF_Z0_O_Z0H,DTV%XPAR_Z0_O_Z0H,DTV%LDATA_Z0_O_Z0H)
+IF (ALL(.NOT.DTV%LDATA_Z0_O_Z0H)) DEALLOCATE(DTV%XPAR_Z0_O_Z0H)
+!
+IF (.NOT.IO%LECOCLIMAP .AND. .NOT.(ANY(DTV%LDATA_RSMIN).AND.ANY(DTV%LDATA_GAMMA).AND.ANY(DTV%LDATA_WRMAX_CF).AND.&
+ ANY(DTV%LDATA_RGL).AND.ANY(DTV%LDATA_CV).AND.ANY(DTV%LDATA_Z0_O_Z0H).AND.ANY(DTV%LDATA_ALBNIR_VEG).AND. &
+ ANY(DTV%LDATA_ALBVIS_VEG).AND.ANY(DTV%LDATA_ALBUV_VEG).AND.ANY(DTV%LDATA_ALBNIR_SOIL).AND.&
+ ANY(DTV%LDATA_ALBVIS_SOIL).AND.ANY(DTV%LDATA_ALBUV_SOIL))) THEN
!
WRITE(ILUOUT,*) ' '
WRITE(ILUOUT,*) '***********************************************************'
WRITE(ILUOUT,*) '* Error in PGD field preparation of classical fields *'
WRITE(ILUOUT,*) '* There is no prescribed value and no input file : *'
- IF (.NOT.DTI%LDATA_RSMIN ) WRITE(ILUOUT,*) '* for RSMIN *'
- IF (.NOT.DTI%LDATA_GAMMA ) WRITE(ILUOUT,*) '* for GAMMA *'
- IF (.NOT.DTI%LDATA_WRMAX_CF ) WRITE(ILUOUT,*) '* for WRMAX_CF *'
- IF (.NOT.DTI%LDATA_RGL ) WRITE(ILUOUT,*) '* for RGL *'
- IF (.NOT.DTI%LDATA_CV ) WRITE(ILUOUT,*) '* for CV *'
- IF (.NOT.DTI%LDATA_Z0_O_Z0H ) WRITE(ILUOUT,*) '* for Z0_O_Z0H *'
- IF (.NOT.DTI%LDATA_ALBNIR_VEG ) WRITE(ILUOUT,*) '* for ALBNIR_VEG *'
- IF (.NOT.DTI%LDATA_ALBVIS_VEG ) WRITE(ILUOUT,*) '* for ALBVIS_VEG *'
- IF (.NOT.DTI%LDATA_ALBUV_VEG ) WRITE(ILUOUT,*) '* for ALBUV_VEG *'
- IF (.NOT.DTI%LDATA_ALBNIR_SOIL ) WRITE(ILUOUT,*) '* for ALBNIR_SOIL *'
- IF (.NOT.DTI%LDATA_ALBVIS_SOIL ) WRITE(ILUOUT,*) '* for ALBVIS_SOIL *'
- IF (.NOT.DTI%LDATA_ALBUV_SOIL ) WRITE(ILUOUT,*) '* for ALBUV_SOIL *'
+ IF (ALL(.NOT.DTV%LDATA_RSMIN )) WRITE(ILUOUT,*) '* for RSMIN *'
+ IF (ALL(.NOT.DTV%LDATA_GAMMA )) WRITE(ILUOUT,*) '* for GAMMA *'
+ IF (ALL(.NOT.DTV%LDATA_WRMAX_CF )) WRITE(ILUOUT,*) '* for WRMAX_CF *'
+ IF (ALL(.NOT.DTV%LDATA_RGL )) WRITE(ILUOUT,*) '* for RGL *'
+ IF (ALL(.NOT.DTV%LDATA_CV )) WRITE(ILUOUT,*) '* for CV *'
+ IF (ALL(.NOT.DTV%LDATA_Z0_O_Z0H )) WRITE(ILUOUT,*) '* for Z0_O_Z0H *'
+ IF (ALL(.NOT.DTV%LDATA_ALBNIR_VEG )) WRITE(ILUOUT,*) '* for ALBNIR_VEG *'
+ IF (ALL(.NOT.DTV%LDATA_ALBVIS_VEG )) WRITE(ILUOUT,*) '* for ALBVIS_VEG *'
+ IF (ALL(.NOT.DTV%LDATA_ALBUV_VEG )) WRITE(ILUOUT,*) '* for ALBUV_VEG *'
+ IF (ALL(.NOT.DTV%LDATA_ALBNIR_SOIL )) WRITE(ILUOUT,*) '* for ALBNIR_SOIL *'
+ IF (ALL(.NOT.DTV%LDATA_ALBVIS_SOIL )) WRITE(ILUOUT,*) '* for ALBVIS_SOIL *'
+ IF (ALL(.NOT.DTV%LDATA_ALBUV_SOIL )) WRITE(ILUOUT,*) '* for ALBUV_SOIL *'
WRITE(ILUOUT,*) '* Without ECOCLIMAP, these fields must be prescribed *'
WRITE(ILUOUT,*) '***********************************************************'
WRITE(ILUOUT,*) ' '
@@ -893,120 +929,110 @@ IF (.NOT.I%LECOCLIMAP .AND. .NOT.(DTI%LDATA_RSMIN.AND.DTI%LDATA_GAMMA.AND.DTI%LD
!
ENDIF
!
-! ------------ Begin MEB parameters ---------------------
-IF(ISIZE_LMEB_PATCH>0) THEN
- !
- ALLOCATE(DTI%XPAR_RSMINGV (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'INV','RSMINGV: GV min stomatal res','NAT',CFNAM_RSMINGV, &
- CFTYP_RSMINGV,XUNIF_RSMINGV,DTI%XPAR_RSMINGV,DTI%LDATA_RSMINGV)
- IF (.NOT. DTI%LDATA_RSMINGV) DEALLOCATE(DTI%XPAR_RSMINGV)
- ! ' '
- ALLOCATE(DTI%XPAR_GAMMAGV (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','GAMMAGV: GV gamma coeff','NAT',CFNAM_GAMMAGV, &
- CFTYP_GAMMAGV,XUNIF_GAMMAGV,DTI%XPAR_GAMMAGV,DTI%LDATA_GAMMAGV)
- IF (.NOT. DTI%LDATA_GAMMAGV) DEALLOCATE(DTI%XPAR_GAMMAGV)
- ! ' '
- ALLOCATE(DTI%XPAR_WRMAX_CFGV (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','WRMAX_CFGV: cff max GV WR','NAT',CFNAM_WRMAX_CFGV, &
- CFTYP_WRMAX_CFGV,XUNIF_WRMAX_CFGV,DTI%XPAR_WRMAX_CFGV,DTI%LDATA_WRMAX_CFGV)
- IF (.NOT. DTI%LDATA_WRMAX_CFGV) DEALLOCATE(DTI%XPAR_WRMAX_CFGV)
- ! ' '
- ALLOCATE(DTI%XPAR_RGLGV (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','RGLGV: max GV SW photosynth','NAT',CFNAM_RGLGV, &
- CFTYP_RGLGV,XUNIF_RGLGV,DTI%XPAR_RGLGV,DTI%LDATA_RGLGV)
- IF (.NOT. DTI%LDATA_RGLGV) DEALLOCATE(DTI%XPAR_RGLGV)
- !
-ENDIF
-! ------------ End MEB parameters ---------------------
-!
!--------------------------------------AGS parameters----------------------------
!
-IF (I%CPHOTO/='NON' .OR. (.NOT.DTI%LDATA_Z0.AND.(DTI%LDATA_LAI.OR.DTI%LDATA_VEGTYPE)) .OR. ISIZE_LMEB_PATCH>0) THEN
+IF (IO%CPHOTO/='NON' .OR. &
+ (ALL(.NOT.DTV%LDATA_Z0).AND.(ANY(DTV%LDATA_LAI).OR.DTV%LDATA_VEGTYPE)) .OR. ISIZE_LMEB_PATCH>0) THEN
!
- ALLOCATE(DTI%XPAR_H_TREE (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
+ ALLOCATE(DTV%XPAR_H_TREE(KDIM,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
HPROGRAM,'ARI','H_TREE: height of trees','NAT',CFNAM_H_TREE, &
- CFTYP_H_TREE,XUNIF_H_TREE,DTI%XPAR_H_TREE,DTI%LDATA_H_TREE)
- IF (.NOT. DTI%LDATA_VEGTYPE .AND. .NOT. DTI%LDATA_H_TREE) DEALLOCATE(DTI%XPAR_H_TREE)
+ CFTYP_H_TREE,XUNIF_H_TREE,DTV%XPAR_H_TREE,DTV%LDATA_H_TREE)
+ IF (ALL(.NOT.DTV%LDATA_H_TREE)) THEN
+ DEALLOCATE(DTV%XPAR_H_TREE)
+ ELSE
+ IF (U%LECOSG) THEN
+ DTV%LDATA_H_TREE(1:3) = .FALSE.
+ DTV%LDATA_H_TREE(13:18) = .FALSE.
+ DTV%LDATA_H_TREE(20) = .FALSE.
+ ELSE
+ DTV%LDATA_H_TREE (1:3) = .FALSE.
+ DTV%LDATA_H_TREE (7:12) = .FALSE.
+ DTV%LDATA_H_TREE(18:19) = .FALSE.
+ ENDIF
+ ENDIF
!
ENDIF
-IF (I%CPHOTO/='NON' .OR. ISIZE_LMEB_PATCH>0) THEN
- ALLOCATE(DTI%XPAR_BSLAI (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','BSLAI: biomass over LAI','NAT',CFNAM_BSLAI, &
- CFTYP_BSLAI,XUNIF_BSLAI,DTI%XPAR_BSLAI,DTI%LDATA_BSLAI)
- IF (.NOT. DTI%LDATA_BSLAI) DEALLOCATE(DTI%XPAR_BSLAI)
+IF (IO%CPHOTO/='NON' .OR. ISIZE_LMEB_PATCH>0) THEN
+ ALLOCATE(DTV%XPAR_BSLAI(KDIM,NVEGTYPE))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','BSLAI: biomass over LAI','NAT',CFNAM_BSLAI, &
+ CFTYP_BSLAI,XUNIF_BSLAI,DTV%XPAR_BSLAI,DTV%LDATA_BSLAI)
+ IF (ALL(.NOT.DTV%LDATA_BSLAI)) DEALLOCATE(DTV%XPAR_BSLAI)
ENDIF
!
-IF (.NOT.I%LECOCLIMAP .AND. ISIZE_LMEB_PATCH>0 .AND. .NOT.(DTI%LDATA_H_TREE &
- .AND. DTI%LDATA_GNDLITTER .AND. DTI%LDATA_Z0LITTER &
- .AND. DTI%LDATA_BSLAI))THEN
- WRITE(ILUOUT,*) ' '
- WRITE(ILUOUT,*) '***********************************************************'
- WRITE(ILUOUT,*) '* Error in PGD field preparation of MEB fields *'
- WRITE(ILUOUT,*) '* There is no prescribed value and no input file : *'
- IF (.NOT.DTI%LDATA_GNDLITTER ) WRITE(ILUOUT,*) '* for GNDLITTER *'
- IF (.NOT.DTI%LDATA_Z0LITTER ) WRITE(ILUOUT,*) '* for Z0LITTER *'
- IF (.NOT.DTI%LDATA_H_TREE ) WRITE(ILUOUT,*) '* for H_TREE *'
- IF (.NOT.DTI%LDATA_BSLAI ) WRITE(ILUOUT,*) '* for BSLAI *'
- WRITE(ILUOUT,*) '* Without ECOCLIMAP, these fields must be prescribed *'
- WRITE(ILUOUT,*) '***********************************************************'
- WRITE(ILUOUT,*) ' '
- CALL ABOR1_SFX('PGD_ISBA_PAR: NO PRESCRIBED VALUE NOR INPUT FILE FOR MEB PARAMETERS')
+IF (.NOT.IO%LECOCLIMAP .AND. ISIZE_LMEB_PATCH>0 ) THEN
+ IF (.NOT.(ANY(DTV%LDATA_H_TREE).AND.ANY(DTV%LDATA_GNDLITTER).AND.ANY(DTV%LDATA_Z0LITTER) &
+ .AND. ANY(DTV%LDATA_BSLAI))) THEN
+ WRITE(ILUOUT,*) ' '
+ WRITE(ILUOUT,*) '***********************************************************'
+ WRITE(ILUOUT,*) '* Error in PGD field preparation of MEB fields *'
+ WRITE(ILUOUT,*) '* There is no prescribed value and no input file : *'
+ IF (ALL(.NOT.DTV%LDATA_GNDLITTER )) WRITE(ILUOUT,*) '* for GNDLITTER *'
+ IF (ALL(.NOT.DTV%LDATA_Z0LITTER )) WRITE(ILUOUT,*) '* for Z0LITTER *'
+ IF (ALL(.NOT.DTV%LDATA_H_TREE )) WRITE(ILUOUT,*) '* for H_TREE *'
+ IF (ALL(.NOT.DTV%LDATA_BSLAI )) WRITE(ILUOUT,*) '* for BSLAI *'
+ WRITE(ILUOUT,*) '* Without ECOCLIMAP, these fields must be prescribed *'
+ WRITE(ILUOUT,*) '***********************************************************'
+ WRITE(ILUOUT,*) ' '
+ CALL ABOR1_SFX('PGD_ISBA_PAR: NO PRESCRIBED VALUE NOR INPUT FILE FOR MEB PARAMETERS')
+ ENDIF
!
ENDIF
!
-IF (I%CPHOTO/='NON') THEN
+ALLOCATE(DTV%LDATA_IRRIG (NTIME*NVEGTYPE))
+ALLOCATE(DTV%LDATA_WATSUP(NTIME*NVEGTYPE))
+DTV%LDATA_IRRIG (:) = .FALSE.
+DTV%LDATA_WATSUP(:) = .FALSE.
+!
+IF (IO%CPHOTO/='NON') THEN
!
- ALLOCATE(DTI%XPAR_RE25 (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','RE25: ecosystem respiration','NAT',CFNAM_RE25, &
- CFTYP_RE25,XUNIF_RE25,DTI%XPAR_RE25,DTI%LDATA_RE25)
- IF (.NOT. DTI%LDATA_RE25) DEALLOCATE(DTI%XPAR_RE25)
+ ALLOCATE(DTV%XPAR_RE25 (KDIM,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','RE25: ecosystem respiration','NAT',CFNAM_RE25, &
+ CFTYP_RE25,XUNIF_RE25,DTV%XPAR_RE25,DTV%LDATA_RE25)
+ IF (ALL(.NOT.DTV%LDATA_RE25)) DEALLOCATE(DTV%XPAR_RE25)
!
- ALLOCATE(DTI%XPAR_LAIMIN (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','LAIMIN: minimum LAI','NAT',CFNAM_LAIMIN, &
- CFTYP_LAIMIN,XUNIF_LAIMIN,DTI%XPAR_LAIMIN,DTI%LDATA_LAIMIN)
- IF (.NOT. DTI%LDATA_LAIMIN) DEALLOCATE(DTI%XPAR_LAIMIN)
+ ALLOCATE(DTV%XPAR_LAIMIN(KDIM,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','LAIMIN: minimum LAI','NAT',CFNAM_LAIMIN, &
+ CFTYP_LAIMIN,XUNIF_LAIMIN,DTV%XPAR_LAIMIN,DTV%LDATA_LAIMIN)
+ IF (ALL(.NOT.DTV%LDATA_LAIMIN)) DEALLOCATE(DTV%XPAR_LAIMIN)
!
- ALLOCATE(DTI%XPAR_SEFOLD (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','SEFOLD: e-folding time for senescence','NAT',CFNAM_SEFOLD, &
- CFTYP_SEFOLD,XUNIF_SEFOLD,DTI%XPAR_SEFOLD,DTI%LDATA_SEFOLD)
- IF (.NOT. DTI%LDATA_SEFOLD) DEALLOCATE(DTI%XPAR_SEFOLD)
+ ALLOCATE(DTV%XPAR_SEFOLD(KDIM,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','SEFOLD: e-folding time for senescence','NAT',CFNAM_SEFOLD, &
+ CFTYP_SEFOLD,XUNIF_SEFOLD,DTV%XPAR_SEFOLD,DTV%LDATA_SEFOLD)
+ IF (ALL(.NOT.DTV%LDATA_SEFOLD)) DEALLOCATE(DTV%XPAR_SEFOLD)
!
- ALLOCATE(DTI%XPAR_GMES (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','GMES: mesophyl conductance','NAT',CFNAM_GMES, &
- CFTYP_GMES,XUNIF_GMES,DTI%XPAR_GMES,DTI%LDATA_GMES)
- IF (.NOT. DTI%LDATA_GMES) DEALLOCATE(DTI%XPAR_GMES)
+ ALLOCATE(DTV%XPAR_GMES(KDIM,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','GMES: mesophyl conductance','NAT',CFNAM_GMES, &
+ CFTYP_GMES,XUNIF_GMES,DTV%XPAR_GMES,DTV%LDATA_GMES)
+ IF (ALL(.NOT.DTV%LDATA_GMES)) DEALLOCATE(DTV%XPAR_GMES)
!
- ALLOCATE(DTI%XPAR_GC (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','GC: cuticular conductance','NAT',CFNAM_GC, &
- CFTYP_GC,XUNIF_GC,DTI%XPAR_GC,DTI%LDATA_GC)
- IF (.NOT. DTI%LDATA_GC) DEALLOCATE(DTI%XPAR_GC)
+ ALLOCATE(DTV%XPAR_GC(KDIM,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','GC: cuticular conductance','NAT',CFNAM_GC, &
+ CFTYP_GC,XUNIF_GC,DTV%XPAR_GC,DTV%LDATA_GC)
+ IF (ALL(.NOT.DTV%LDATA_GC)) DEALLOCATE(DTV%XPAR_GC)
!
- IF (.NOT.I%LECOCLIMAP .AND. .NOT.(DTI%LDATA_H_TREE.AND.DTI%LDATA_RE25.AND.DTI%LDATA_LAIMIN.AND.&
- DTI%LDATA_BSLAI.AND.DTI%LDATA_SEFOLD.AND.DTI%LDATA_GMES.AND.DTI%LDATA_GC)) THEN
+ IF (.NOT.IO%LECOCLIMAP .AND. .NOT.(ANY(DTV%LDATA_H_TREE).AND.ANY(DTV%LDATA_RE25).AND.&
+ ANY(DTV%LDATA_LAIMIN).AND.ANY(DTV%LDATA_BSLAI).AND.ANY(DTV%LDATA_SEFOLD).AND.&
+ ANY(DTV%LDATA_GMES).AND.ANY(DTV%LDATA_GC))) THEN
!
WRITE(ILUOUT,*) ' '
WRITE(ILUOUT,*) '***********************************************************'
WRITE(ILUOUT,*) '* Error in PGD field preparation of AGS fields *'
WRITE(ILUOUT,*) '* There is no prescribed value and no input file : *'
- IF (.NOT.DTI%LDATA_H_TREE ) WRITE(ILUOUT,*) '* for H_TREE *'
- IF (.NOT.DTI%LDATA_RE25 ) WRITE(ILUOUT,*) '* for RE25 *'
- IF (.NOT.DTI%LDATA_LAIMIN ) WRITE(ILUOUT,*) '* for LAIMIN *'
- IF (.NOT.DTI%LDATA_BSLAI ) WRITE(ILUOUT,*) '* for BSLAI *'
- IF (.NOT.DTI%LDATA_SEFOLD ) WRITE(ILUOUT,*) '* for SEFOLD *'
- IF (.NOT.DTI%LDATA_GMES ) WRITE(ILUOUT,*) '* for GMES *'
- IF (.NOT.DTI%LDATA_GC ) WRITE(ILUOUT,*) '* for GC *'
+ IF (ALL(.NOT.DTV%LDATA_H_TREE )) WRITE(ILUOUT,*) '* for H_TREE *'
+ IF (ALL(.NOT.DTV%LDATA_RE25 )) WRITE(ILUOUT,*) '* for RE25 *'
+ IF (ALL(.NOT.DTV%LDATA_LAIMIN )) WRITE(ILUOUT,*) '* for LAIMIN *'
+ IF (ALL(.NOT.DTV%LDATA_BSLAI )) WRITE(ILUOUT,*) '* for BSLAI *'
+ IF (ALL(.NOT.DTV%LDATA_SEFOLD )) WRITE(ILUOUT,*) '* for SEFOLD *'
+ IF (ALL(.NOT.DTV%LDATA_GMES )) WRITE(ILUOUT,*) '* for GMES *'
+ IF (ALL(.NOT.DTV%LDATA_GC )) WRITE(ILUOUT,*) '* for GC *'
WRITE(ILUOUT,*) '* Without ECOCLIMAP, these fields must be prescribed *'
WRITE(ILUOUT,*) '***********************************************************'
WRITE(ILUOUT,*) ' '
@@ -1016,113 +1042,212 @@ IF (I%CPHOTO/='NON') THEN
!
!--------------------------------------AGS Stress parameters----------------------------
!
- IF (I%CPHOTO/='AGS' .AND. I%CPHOTO/='LAI') THEN
+ ALLOCATE(DTV%XPAR_F2I(KDIM,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','F2I: critical normalized soil water content (stress)','NAT',CFNAM_F2I, &
+ CFTYP_F2I,XUNIF_F2I,DTV%XPAR_F2I,DTV%LDATA_F2I)
+ IF (ALL(.NOT.DTV%LDATA_F2I)) DEALLOCATE(DTV%XPAR_F2I)
+ !
+ ALLOCATE(DTV%XPAR_DMAX(KDIM,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','DMAX: maximum air saturation deficit','NAT',CFNAM_DMAX, &
+ CFTYP_DMAX,XUNIF_DMAX,DTV%XPAR_DMAX,DTV%LDATA_DMAX)
+ IF (ALL(.NOT.DTV%LDATA_DMAX)) DEALLOCATE(DTV%XPAR_DMAX)
+ !
+ ALLOCATE(DTV%LPAR_STRESS(KDIM,NVEGTYPE))
+ DO JVEG=1,NVEGTYPE
+ GPAR_STRESS = LUNIF_STRESS(JVEG)
+ IF (XSTRESS(JVEG)<1.) GPAR_STRESS = .FALSE.
+ IF (XSTRESS(JVEG)==1. .AND. .NOT.GPAR_STRESS) DTV%LDATA_STRESS=.TRUE.
+ DTV%LPAR_STRESS(:,JVEG) = GPAR_STRESS
+ ENDDO
+ IF (ALL(.NOT.DTV%LDATA_STRESS)) DEALLOCATE(DTV%LPAR_STRESS)
+ !
+ IF (.NOT.IO%LECOCLIMAP .AND. .NOT.(ANY(DTV%LDATA_F2I).AND.ANY(DTV%LDATA_DMAX))) THEN
+ !
+ WRITE(ILUOUT,*) ' '
+ WRITE(ILUOUT,*) '***********************************************************'
+ WRITE(ILUOUT,*) '* Error in PGD field preparation of AGS Stress fields *'
+ WRITE(ILUOUT,*) '* There is no prescribed value and no input file : *'
+ IF (ALL(.NOT.DTV%LDATA_F2I )) WRITE(ILUOUT,*) '* for F2I *'
+ IF (ALL(.NOT.DTV%LDATA_DMAX )) WRITE(ILUOUT,*) '* for DMAX *'
+ WRITE(ILUOUT,*) '* Without ECOCLIMAP, these fields must be prescribed *'
+ WRITE(ILUOUT,*) '***********************************************************'
+ WRITE(ILUOUT,*) ' '
+ CALL ABOR1_SFX('PGD_ISBA_PAR: NO PRESCRIBED VALUE NOR INPUT FILE FOR AGS STRESS PARAMETERS')
+ !
+ ENDIF
+ !
+ !--------------------------------------AGS Nitrogen parameters----------------------------
+ !
+ IF (IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') THEN
!
- ALLOCATE(DTI%XPAR_F2I (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','F2I: critical normalized soil water content (stress)','NAT',CFNAM_F2I, &
- CFTYP_F2I,XUNIF_F2I,DTI%XPAR_F2I,DTI%LDATA_F2I)
- IF (.NOT. DTI%LDATA_F2I) DEALLOCATE(DTI%XPAR_F2I)
+ ALLOCATE(DTV%XPAR_CE_NITRO(KDIM,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','CE_NITRO: leaf area ratio sensitivity to nitrogen ccion','NAT',&
+ CFNAM_CE_NITRO, CFTYP_CE_NITRO,XUNIF_CE_NITRO,DTV%XPAR_CE_NITRO,DTV%LDATA_CE_NITRO)
+ IF (ALL(.NOT.DTV%LDATA_CE_NITRO)) DEALLOCATE(DTV%XPAR_CE_NITRO)
!
- ALLOCATE(DTI%XPAR_DMAX (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','DMAX: maximum air saturation deficit','NAT',CFNAM_DMAX, &
- CFTYP_DMAX,XUNIF_DMAX,DTI%XPAR_DMAX,DTI%LDATA_DMAX)
- IF (.NOT. DTI%LDATA_DMAX) DEALLOCATE(DTI%XPAR_DMAX)
+ ALLOCATE(DTV%XPAR_CF_NITRO(KDIM,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','CF_NITRO: lethal minimum value of leaf area ratio','NAT',&
+ CFNAM_CF_NITRO,CFTYP_CF_NITRO,XUNIF_CF_NITRO,DTV%XPAR_CF_NITRO,DTV%LDATA_CF_NITRO)
+ IF (ALL(.NOT.DTV%LDATA_CF_NITRO)) DEALLOCATE(DTV%XPAR_CF_NITRO)
!
- ALLOCATE(DTI%LPAR_STRESS (IG%NDIM,NVEGTYPE))
- DO JVEGTYPE=1,NVEGTYPE
- GPAR_STRESS = LUNIF_STRESS(JVEGTYPE)
- IF (XSTRESS(JVEGTYPE)<1.) GPAR_STRESS = .FALSE.
- IF (XSTRESS(JVEGTYPE)==1. .AND. .NOT.GPAR_STRESS) DTI%LDATA_STRESS=.TRUE.
- DTI%LPAR_STRESS(:,JVEGTYPE) = GPAR_STRESS
- ENDDO
- IF (.NOT. DTI%LDATA_STRESS) DEALLOCATE(DTI%LPAR_STRESS)
+ ALLOCATE(DTV%XPAR_CNA_NITRO(KDIM,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','CNA_NITRO: nitrogen ccion of active biomass','NAT',&
+ CFNAM_CNA_NITRO,CFTYP_CNA_NITRO,XUNIF_CNA_NITRO,DTV%XPAR_CNA_NITRO,DTV%LDATA_CNA_NITRO)
+ IF (ALL(.NOT.DTV%LDATA_CNA_NITRO)) DEALLOCATE(DTV%XPAR_CNA_NITRO)
!
- IF (.NOT.I%LECOCLIMAP .AND. .NOT.(DTI%LDATA_F2I.AND.DTI%LDATA_DMAX)) THEN
+ IF (.NOT.IO%LECOCLIMAP .AND. &
+ .NOT.(ANY(DTV%LDATA_CE_NITRO).AND.ANY(DTV%LDATA_CF_NITRO).AND.ANY(DTV%LDATA_CNA_NITRO))) THEN
!
WRITE(ILUOUT,*) ' '
WRITE(ILUOUT,*) '***********************************************************'
- WRITE(ILUOUT,*) '* Error in PGD field preparation of AGS Stress fields *'
+ WRITE(ILUOUT,*) '* Error in PGD field preparation of AGS Nitrogen fields *'
WRITE(ILUOUT,*) '* There is no prescribed value and no input file : *'
- IF (.NOT.DTI%LDATA_F2I ) WRITE(ILUOUT,*) '* for F2I *'
- IF (.NOT.DTI%LDATA_DMAX ) WRITE(ILUOUT,*) '* for DMAX *'
+ IF (ALL(.NOT.DTV%LDATA_CE_NITRO )) WRITE(ILUOUT,*) '* for CE_NITRO *'
+ IF (ALL(.NOT.DTV%LDATA_CF_NITRO )) WRITE(ILUOUT,*) '* for CF_NITRO *'
+ IF (ALL(.NOT.DTV%LDATA_CNA_NITRO )) WRITE(ILUOUT,*) '* for CNA_NITRO *'
WRITE(ILUOUT,*) '* Without ECOCLIMAP, these fields must be prescribed *'
WRITE(ILUOUT,*) '***********************************************************'
WRITE(ILUOUT,*) ' '
- CALL ABOR1_SFX('PGD_ISBA_PAR: NO PRESCRIBED VALUE NOR INPUT FILE FOR AGS STRESS PARAMETERS')
+ CALL ABOR1_SFX('PGD_ISBA_PAR: NO PRESCRIBED VALUE NOR INPUT FILE FOR AGS NITROGEN PARAMETERS')
!
ENDIF
!
- !--------------------------------------AGS Nitrogen parameters----------------------------
- !
- IF (I%CPHOTO=='NIT' .OR. I%CPHOTO=='NCB') THEN
+ IF (LAGRIP) THEN
!
- ALLOCATE(DTI%XPAR_CE_NITRO (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','CE_NITRO: leaf area ratio sensitivity to nitrogen ccion','NAT',&
- CFNAM_CE_NITRO, CFTYP_CE_NITRO,XUNIF_CE_NITRO,DTI%XPAR_CE_NITRO,DTI%LDATA_CE_NITRO)
- IF (.NOT. DTI%LDATA_CE_NITRO) DEALLOCATE(DTI%XPAR_CE_NITRO)
+ ALLOCATE(DTV%XPAR_IRRIG(KDIM,DTV%NTIME,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','IRRIG: flag for irrigation','NAT',&
+ CFNAM_IRRIG,CFTYP_IRRIG,XUNIF_IRRIG,DTV%XPAR_IRRIG,DTV%LDATA_IRRIG)
+ IF (ALL(.NOT.DTV%LDATA_IRRIG)) DEALLOCATE(DTV%XPAR_IRRIG)
!
- ALLOCATE(DTI%XPAR_CF_NITRO (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','CF_NITRO: lethal minimum value of leaf area ratio','NAT',&
- CFNAM_CF_NITRO,CFTYP_CF_NITRO,XUNIF_CF_NITRO,DTI%XPAR_CF_NITRO,DTI%LDATA_CF_NITRO)
- IF (.NOT. DTI%LDATA_CF_NITRO) DEALLOCATE(DTI%XPAR_CF_NITRO)
+ ALLOCATE(DTV%XPAR_WATSUP(KDIM,DTV%NTIME,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'ARI','WATSUP: water supply during irr. (mm)','NAT',&
+ CFNAM_WATSUP,CFTYP_WATSUP,XUNIF_WATSUP,DTV%XPAR_WATSUP,DTV%LDATA_WATSUP)
+ IF (ALL(.NOT.DTV%LDATA_WATSUP)) DEALLOCATE(DTV%XPAR_WATSUP)
!
- ALLOCATE(DTI%XPAR_CNA_NITRO (IG%NDIM,NVEGTYPE))
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,'ARI','CNA_NITRO: nitrogen ccion of active biomass','NAT',&
- CFNAM_CNA_NITRO,CFTYP_CNA_NITRO,XUNIF_CNA_NITRO,DTI%XPAR_CNA_NITRO,DTI%LDATA_CNA_NITRO)
- IF (.NOT. DTI%LDATA_CNA_NITRO) DEALLOCATE(DTI%XPAR_CNA_NITRO)
+ ALLOCATE(DTV%XPAR_SEED_M(KDIM,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'MAJ','SEED_M: month of seeding','NAT',&
+ CFNAM_SEED_M,CFTYP_SEED_M,XUNIF_SEED_M,DTV%XPAR_SEED_M,DTV%LDATA_SEED_M)
+ IF (ALL(.NOT.DTV%LDATA_SEED_M)) DEALLOCATE(DTV%XPAR_SEED_M)
+ !
+ ALLOCATE(DTV%XPAR_SEED_D(KDIM,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'MAJ','SEED_D: day of seeding','NAT',&
+ CFNAM_SEED_D,CFTYP_SEED_D,XUNIF_SEED_D,DTV%XPAR_SEED_D,DTV%LDATA_SEED_D)
+ IF (ALL(.NOT.DTV%LDATA_SEED_D)) DEALLOCATE(DTV%XPAR_SEED_D)
+ !
+ ALLOCATE(DTV%XPAR_REAP_M(KDIM,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'MAJ','REAP_M: month of reaping','NAT',&
+ CFNAM_REAP_M,CFTYP_REAP_M,XUNIF_REAP_M,DTV%XPAR_REAP_M,DTV%LDATA_REAP_M)
+ IF (ALL(.NOT.DTV%LDATA_REAP_M)) DEALLOCATE(DTV%XPAR_REAP_M)
+ !
+ ALLOCATE(DTV%XPAR_REAP_D(KDIM,NVEGTYPE))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, DTV%XPAR_VEGTYPE, &
+ HPROGRAM,'MAJ','REAP_D: day of reaping','NAT',&
+ CFNAM_REAP_D,CFTYP_REAP_D,XUNIF_REAP_D,DTV%XPAR_REAP_D,DTV%LDATA_REAP_D)
+ IF (ALL(.NOT.DTV%LDATA_REAP_D)) DEALLOCATE(DTV%XPAR_REAP_D)
+ !
+ ENDIF
+ !
+ IF ((ANY(DTV%LDATA_IRRIG).OR.ANY(DTV%LDATA_WATSUP).OR.ANY(DTV%LDATA_SEED_M).OR.&
+ ANY(DTV%LDATA_SEED_D).OR.ANY(DTV%LDATA_REAP_M).OR.ANY(DTV%LDATA_REAP_D)) .AND. &
+ (ALL(.NOT.DTV%LDATA_IRRIG).OR.ALL(.NOT.DTV%LDATA_WATSUP).OR.ALL(.NOT.DTV%LDATA_SEED_M).OR.&
+ ALL(.NOT.DTV%LDATA_SEED_D).OR.ALL(.NOT.DTV%LDATA_REAP_M).OR.ALL(.NOT.DTV%LDATA_REAP_D))) THEN
+ !
+ WRITE(ILUOUT,*) ' '
+ WRITE(ILUOUT,*) '***********************************************************'
+ WRITE(ILUOUT,*) '* Error in PGD field preparation of irrigation parameters *'
+ WRITE(ILUOUT,*) '* There is no prescribed value and no input file : *'
+ WRITE(ILUOUT,*) '* Some are prescribed and some are not. If you prescribe *'
+ WRITE(ILUOUT,*) '* one of IRRIG, WATSUP, SEED_M, SEED_D, REAP_M and REAP_D, *'
+ WRITE(ILUOUT,*) '* you need to prescribe all the others. *'
+ WRITE(ILUOUT,*) '***********************************************************'
+ WRITE(ILUOUT,*) ' '
+ CALL ABOR1_SFX('PGD_ISBA_PAR: MISSING PRESCRIBED VALUE OR INPUT FILE FOR IRRIGATION PARAMETERS')
+ !
+ ENDIF
+ !
+ IF (.NOT.IO%LECOCLIMAP .AND. .NOT.(ANY(DTV%LDATA_IRRIG).AND.ANY(DTV%LDATA_WATSUP).AND.&
+ ANY(DTV%LDATA_SEED_M).AND.ANY(DTV%LDATA_SEED_D).AND.ANY(DTV%LDATA_REAP_M).AND.&
+ ANY(DTV%LDATA_REAP_D))) THEN
+ !
+ WRITE(ILUOUT,*) ' '
+ WRITE(ILUOUT,*) '***********************************************************'
+ WRITE(ILUOUT,*) '* Error in PGD field preparation of irrigation fields *'
+ WRITE(ILUOUT,*) '* There is no prescribed value and no input file : *'
+ IF (ALL(.NOT.DTV%LDATA_IRRIG )) WRITE(ILUOUT,*) '* for IRRIG *'
+ IF (ALL(.NOT.DTV%LDATA_WATSUP )) WRITE(ILUOUT,*) '* for WATSUP *'
+ IF (ALL(.NOT.DTV%LDATA_SEED_M )) WRITE(ILUOUT,*) '* for SEED_M *'
+ IF (ALL(.NOT.DTV%LDATA_SEED_D )) WRITE(ILUOUT,*) '* for SEED_D *'
+ IF (ALL(.NOT.DTV%LDATA_REAP_M )) WRITE(ILUOUT,*) '* for REAP_M *'
+ IF (ALL(.NOT.DTV%LDATA_REAP_D )) WRITE(ILUOUT,*) '* for REAP_D *'
+ WRITE(ILUOUT,*) '* Without ECOCLIMAP, these fields must be prescribed *'
+ WRITE(ILUOUT,*) '***********************************************************'
+ WRITE(ILUOUT,*) ' '
+ CALL ABOR1_SFX('PGD_ISBA_PAR: NO PRESCRIBED VALUE NOR INPUT FILE FOR IRRIGATION PARAMETERS')
!
- IF (.NOT.I%LECOCLIMAP .AND. .NOT.(DTI%LDATA_CE_NITRO.AND.DTI%LDATA_CF_NITRO.AND.DTI%LDATA_CNA_NITRO)) THEN
- !
- WRITE(ILUOUT,*) ' '
- WRITE(ILUOUT,*) '***********************************************************'
- WRITE(ILUOUT,*) '* Error in PGD field preparation of AGS Nitrogen fields *'
- WRITE(ILUOUT,*) '* There is no prescribed value and no input file : *'
- IF (.NOT.DTI%LDATA_CE_NITRO ) WRITE(ILUOUT,*) '* for CE_NITRO *'
- IF (.NOT.DTI%LDATA_CF_NITRO ) WRITE(ILUOUT,*) '* for CF_NITRO *'
- IF (.NOT.DTI%LDATA_CNA_NITRO ) WRITE(ILUOUT,*) '* for CNA_NITRO *'
- WRITE(ILUOUT,*) '* Without ECOCLIMAP, these fields must be prescribed *'
- WRITE(ILUOUT,*) '***********************************************************'
- WRITE(ILUOUT,*) ' '
- CALL ABOR1_SFX('PGD_ISBA_PAR: NO PRESCRIBED VALUE NOR INPUT FILE FOR AGS NITROGEN PARAMETERS')
- !
- ENDIF
- !
ENDIF
+
!
ENDIF
!
ENDIF
!
-!--------------------------------------irrigation parameters----------------------------
-!
-DTI%LDATA_IRRIG=.FALSE.
-DTI%LDATA_WATSUP=.FALSE.
+!--------------------------------hydrological fields-----------------------------------
+!
+ALLOCATE(DTV%XPAR_CONDSAT(KDIM,IO%NGROUND_LAYER))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, &
+ HPROGRAM,'ARI','CONDSAT: ','NAT',CFNAM_CONDSAT,CFTYP_CONDSAT,&
+ XUNIF_CONDSAT,DTV%XPAR_CONDSAT,DTV%LDATA_CONDSAT)
+IF (.NOT.DTV%LDATA_CONDSAT) DEALLOCATE(DTV%XPAR_CONDSAT)
+!
+ALLOCATE(DTV%XPAR_MPOTSAT(KDIM,IO%NGROUND_LAYER))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, &
+ HPROGRAM,'ARI','MPOTSAT: ','NAT',CFNAM_MPOTSAT,CFTYP_MPOTSAT,&
+ XUNIF_MPOTSAT,DTV%XPAR_MPOTSAT,DTV%LDATA_MPOTSAT)
+IF (.NOT.DTV%LDATA_MPOTSAT) DEALLOCATE(DTV%XPAR_MPOTSAT)
+!
+ALLOCATE(DTV%XPAR_BCOEF(KDIM,IO%NGROUND_LAYER))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, &
+ HPROGRAM,'ARI','BCOEF: ','NAT',CFNAM_BCOEF,CFTYP_BCOEF,&
+ XUNIF_BCOEF,DTV%XPAR_BCOEF,DTV%LDATA_BCOEF)
+IF (.NOT.DTV%LDATA_BCOEF) DEALLOCATE(DTV%XPAR_BCOEF)
+!
+ALLOCATE(DTV%XPAR_WWILT(KDIM,IO%NGROUND_LAYER))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, &
+ HPROGRAM,'ARI','WWILT: ','NAT',CFNAM_WWILT,CFTYP_WWILT,&
+ XUNIF_WWILT,DTV%XPAR_WWILT,DTV%LDATA_WWILT)
+IF (.NOT.DTV%LDATA_WWILT) DEALLOCATE(DTV%XPAR_WWILT)
+!
+ALLOCATE(DTV%XPAR_WFC(KDIM,IO%NGROUND_LAYER))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, &
+ HPROGRAM,'ARI','WFC: ','NAT',CFNAM_WFC,CFTYP_WFC,&
+ XUNIF_WFC,DTV%XPAR_WFC,DTV%LDATA_WFC)
+IF (.NOT.DTV%LDATA_WFC) DEALLOCATE(DTV%XPAR_WFC)
+!
+ALLOCATE(DTV%XPAR_WSAT(KDIM,IO%NGROUND_LAYER))
+ CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, &
+ HPROGRAM,'ARI','WSAT: ','NAT',CFNAM_WSAT,CFTYP_WSAT,&
+ XUNIF_WSAT,DTV%XPAR_WSAT,DTV%LDATA_WSAT)
+IF (.NOT.DTV%LDATA_WSAT) DEALLOCATE(DTV%XPAR_WSAT)
!
!----------------------------------------------------------------------------------------
!
-IF (I%LECOCLIMAP .AND. DTI%LDATA_VEGTYPE) THEN
- !
- ALLOCATE(DTI%XPAR_IRRIG (IG%NDIM,NTIME,NVEGTYPE))
- ALLOCATE(DTI%XPAR_WATSUP (IG%NDIM,NTIME,NVEGTYPE))
- ALLOCATE(DTI%XPAR_ROOT_DEPTHGV(IG%NDIM,NVEGTYPE))
+IF (IO%LECOCLIMAP .AND. DTV%LDATA_VEGTYPE) THEN
!
- CALL EXTRAPOL_FIELDS(DTCO, DTI, IG, I, UG, U, &
- HPROGRAM,ILUOUT)
- !
- IF (.NOT. DTI%LDATA_LAI) DEALLOCATE(DTI%XPAR_LAI)
- IF (.NOT. DTI%LDATA_H_TREE .AND. I%CPHOTO/='NON') DEALLOCATE(DTI%XPAR_H_TREE)
- IF (.NOT. DTI%LDATA_DG) DEALLOCATE(DTI%XPAR_DG)
- IF (.NOT. DTI%LDATA_ROOT_DEPTH) DEALLOCATE(DTI%XPAR_ROOT_DEPTH)
- IF (.NOT. DTI%LDATA_ROOT_DEPTHGV) DEALLOCATE(DTI%XPAR_ROOT_DEPTHGV)
- IF (.NOT. DTI%LDATA_GROUND_DEPTH) DEALLOCATE(DTI%XPAR_GROUND_DEPTH)
+ CALL EXTRAPOL_FIELDS(DTCO, DTV, KDIM, IO, S, UG, U, HPROGRAM,ILUOUT)
!
ENDIF
!
+
!----------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PGD_ISBA_PAR',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/pgd_nature.F90 b/src/SURFEX/pgd_nature.F90
index 6e20bacf625ab316c0bf4fae222bcd5d2a142258..5783ec4a7242a660bfe8b08da4a1735f37671f38 100644
--- a/src/SURFEX/pgd_nature.F90
+++ b/src/SURFEX/pgd_nature.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PGD_NATURE (DTCO, DTI, DTZ, DGU, IG, I, UG, U, USS, &
- HPROGRAM,OECOCLIMAP)
+ SUBROUTINE PGD_NATURE (DTCO, DTZ, IM, UG, U, USS, HPROGRAM)
! #############################################################
!
!!**** *PGD_NATURE* - routine to choose initialization of vegetation scheme
@@ -39,15 +38,11 @@
! ------------
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
USE MODD_DATA_TSZ0_n, ONLY : DATA_TSZ0_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODI_PGD_ISBA
USE MODI_PGD_TSZ0_PAR
@@ -61,21 +56,16 @@ IMPLICIT NONE
! -------------------------
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
TYPE(DATA_TSZ0_t), INTENT(INOUT) :: DTZ
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
+ REAL, DIMENSION(:,:), POINTER :: PVEGTYPE
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-LOGICAL, INTENT(IN) :: OECOCLIMAP ! T if parameters are computed with ecoclimap
REAL(KIND=JPRB) :: ZHOOK_HANDLE
-! ! F if all parameters must be specified
-!
!
!* 0.2 Declarations of local variables
! -------------------------------
@@ -93,10 +83,8 @@ ELSE IF (U%CNATURE=='FLUX ') THEN
IF (LHOOK) CALL DR_HOOK('PGD_NATURE',1,ZHOOK_HANDLE)
RETURN
ELSE IF (U%CNATURE=='ISBA ' .OR. U%CNATURE=='TSZ0') THEN
- CALL PGD_ISBA(DTCO, DTI, DGU, IG, I, UG, U, USS, &
- HPROGRAM,OECOCLIMAP)
- IF (U%CNATURE=='TSZ0') CALL PGD_TSZ0_PAR(DTZ, &
- HPROGRAM)
+ CALL PGD_ISBA(DTCO, IM%DTV, IM%G, IM%O, IM%S, IM%K, IM%ISS, UG, U, USS, HPROGRAM)
+ IF (U%CNATURE=='TSZ0') CALL PGD_TSZ0_PAR(DTZ, HPROGRAM)
END IF
IF (LHOOK) CALL DR_HOOK('PGD_NATURE',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/pgd_orography.F90 b/src/SURFEX/pgd_orography.F90
index 2c811c7caac4ec442e34b2068d7bd16884f321b5..295d322b2cff87fbe4f61b0a2615c5aa84ce5635 100644
--- a/src/SURFEX/pgd_orography.F90
+++ b/src/SURFEX/pgd_orography.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PGD_OROGRAPHY (DGU, DTCO, UG, U, USS, &
- HPROGRAM,PSEA,PWATER,HFILE,HFILETYPE,OZS)
+ SUBROUTINE PGD_OROGRAPHY (DTCO, UG, U, USS, HPROGRAM, HFILE, HFILETYPE, OZS)
! ##############################################################
!
!!**** *PGD_OROGRAPHY* monitor for averaging and interpolations of cover fractions
@@ -43,15 +42,17 @@
!* 0. DECLARATION
! -----------
!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
+!
USE MODD_PGD_GRID, ONLY : NL, CGRID, XGRID_PAR
-USE MODD_PGDWORK, ONLY : XSUMVAL, XSUMVAL2, NSIZE, XSSQO, LSSQO, NSSO
+USE MODD_PGDWORK, ONLY : XALL, NSIZE_ALL, XSSQO, LSSQO, NSSO, &
+ XEXT_ALL, XSUMVAL, NSIZE
USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
!
USE MODI_GET_LUOUT
@@ -62,7 +63,6 @@ USE MODI_READ_SURF
USE MODI_TREAT_FIELD
USE MODI_READ_PGD_NETCDF
USE MODI_INTERPOL_FIELD
-USE MODI_INI_SSOWORK
USE MODI_SSO
USE MODI_SUBSCALE_AOS
USE MODI_GET_SIZE_FULL_n
@@ -95,15 +95,12 @@ IMPLICIT NONE
! ------------------------
!
!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
-REAL, DIMENSION(:), INTENT(IN) :: PSEA ! sea fraction
-REAL, DIMENSION(:), INTENT(IN) :: PWATER ! lake fraction
CHARACTER(LEN=28), INTENT(IN) :: HFILE ! atmospheric file name
CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE! atmospheric file type
LOGICAL, INTENT(IN) :: OZS ! .true. if orography is imposed by atm. model
@@ -135,8 +132,8 @@ INTEGER :: IZS ! size of orographic array in atmospheri
!
CHARACTER(LEN=28) :: YZS ! file name for orography
CHARACTER(LEN=6) :: YFILETYPE ! data file type
- CHARACTER(LEN=28) :: YSLOPE ! file name for orography
- CHARACTER(LEN=6) :: YSLOPEFILETYPE ! data file type
+CHARACTER(LEN=28) :: YSLOPE ! file name for orography
+CHARACTER(LEN=6) :: YSLOPEFILETYPE ! data file type
REAL :: XUNIF_ZS ! uniform orography
CHARACTER(LEN=3) :: COROGTYPE ! orogpraphy type
! ! 'AVG' : average orography
@@ -163,7 +160,7 @@ IF (LHOOK) CALL DR_HOOK('PGD_OROGRAPHY',0,ZHOOK_HANDLE)
! -------------------
!
CALL READ_NAM_PGD_OROGRAPHY(HPROGRAM, YZS, YFILETYPE, XUNIF_ZS, &
- COROGTYPE, XENV, LIMP_ZS , &
+ COROGTYPE, XENV, LIMP_ZS, &
YSLOPE, YSLOPEFILETYPE, LEXPLICIT_SLOPE)
!
CALL TEST_NAM_VAR_SURF(ILUOUT,'YSLOPEFILETYPE',YSLOPEFILETYPE,' ','NETCDF')
@@ -218,16 +215,6 @@ USS%XHO2JM (:) = XUNDEF
!* 4. Allocations of work arrays
! --------------------------
!
-ALLOCATE(NSIZE (NL))
-ALLOCATE(XSUMVAL (NL))
-ALLOCATE(XSUMVAL2 (NL))
-!
-NSIZE (:) = 0.
-XSUMVAL (:) = 0.
-XSUMVAL2 (:) = 0.
-!
- CALL INI_SSOWORK
-!
!-------------------------------------------------------------------------------
!
!* 5. Uniform field is prescribed
@@ -238,12 +225,9 @@ IF (OZS) THEN
!* 5.1 Use of imposed field
! --------------------
!
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'FULL ')
- CALL READ_SURF(&
- HFILETYPE,'DIM_FULL ',IDIM_FULL,IRESP)
- CALL GET_SIZE_FULL_n(U, &
- HPROGRAM,IDIM_FULL,IZS)
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'FULL ')
+ CALL READ_SURF(HFILETYPE,'DIM_FULL ',IDIM_FULL,IRESP)
+ CALL GET_SIZE_FULL_n(HPROGRAM,IDIM_FULL,U%NSIZE_FULL,IZS)
IF (IZS /= NL) THEN
WRITE(ILUOUT,*) ' '
WRITE(ILUOUT,*) '***********************************************************'
@@ -256,8 +240,7 @@ IF (OZS) THEN
WRITE(ILUOUT,*) ' '
CALL ABOR1_SFX('PGD_OROGRAPHY: ATMOSPHERIC PRESCRIBED OROGRAPHY DOES NOT HAVE THE CORRECT NB OF POINTS')
END IF
- CALL READ_SURF(&
- HFILETYPE,'ZS',U%XZS(:),IRESP)
+ CALL READ_SURF(HFILETYPE,'ZS',U%XZS(:),IRESP)
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
!
USS%XAVG_ZS(:) = U%XZS(:)
@@ -277,10 +260,6 @@ IF (OZS) THEN
USS%XSSO_DIR(:) = 0.
USS%XSSO_SLOPE(:) = 0.
- DEALLOCATE(NSIZE )
- DEALLOCATE(XSUMVAL )
- DEALLOCATE(XSUMVAL2 )
-
IF (LHOOK) CALL DR_HOOK('PGD_OROGRAPHY',1,ZHOOK_HANDLE)
RETURN
@@ -308,10 +287,6 @@ ELSE IF (XUNIF_ZS/=XUNDEF) THEN
USS%XSSO_DIR(:) = 0.
USS%XSSO_SLOPE(:) = 0.
- DEALLOCATE(NSIZE )
- DEALLOCATE(XSUMVAL )
- DEALLOCATE(XSUMVAL2 )
-
IF (LHOOK) CALL DR_HOOK('PGD_OROGRAPHY',1,ZHOOK_HANDLE)
RETURN
!
@@ -319,6 +294,7 @@ ELSE IF (XUNIF_ZS/=XUNDEF) THEN
! -------
!
ELSEIF (LEN_TRIM(YZS)==0) THEN
+
WRITE(ILUOUT,*) ' '
WRITE(ILUOUT,*) '***********************************************************'
WRITE(ILUOUT,*) '* Error in orography preparation *'
@@ -327,29 +303,29 @@ ELSEIF (LEN_TRIM(YZS)==0) THEN
WRITE(ILUOUT,*) ' '
CALL ABOR1_SFX('PGD_OROGRAPHY: NO PRESCRIBED OROGRAPHY NOR INPUT FILE')
!
-ELSEIF(LIMP_ZS)THEN !LIMP_ZS (impose topo from input file at the same resolution)
+ELSEIF (LIMP_ZS) THEN !LIMP_ZS (impose topo from input file at the same resolution)
!
IF(YFILETYPE=='NETCDF')THEN
! CALL ABOR1_SFX('Use another format than netcdf for topo input file with LIMP_ZS')
- CALL READ_PGD_NETCDF(USS, &
+ CALL READ_PGD_NETCDF(UG, U, USS, &
HPROGRAM,'SURF ',' ',YZS,'ZS ',U%XZS)
- USS%XSIL_ZS(:) = U%XZS(:)
- USS%XAVG_ZS(:) = U%XZS(:)
- USS%XMIN_ZS(:) = U%XZS(:)
- USS%XMAX_ZS(:) = U%XZS(:)
- USS%XSSO_STDEV(:) = 0.
- USS%XHO2IP(:) = 0.
- USS%XHO2IM(:) = 0.
- USS%XHO2JP(:) = 0.
- USS%XHO2JM(:) = 0.
- USS%XAOSIP(:) = 0.
- USS%XAOSIM(:) = 0.
- USS%XAOSJP(:) = 0.
- USS%XAOSJM(:) = 0.
- USS%XSSO_ANIS(:) = 0.
- USS%XSSO_DIR(:) = 0.
+ USS%XSIL_ZS(:) = U%XZS(:)
+ USS%XAVG_ZS(:) = U%XZS(:)
+ USS%XMIN_ZS(:) = U%XZS(:)
+ USS%XMAX_ZS(:) = U%XZS(:)
+ USS%XSSO_STDEV(:) = 0.
+ USS%XHO2IP(:) = 0.
+ USS%XHO2IM(:) = 0.
+ USS%XHO2JP(:) = 0.
+ USS%XHO2JM(:) = 0.
+ USS%XAOSIP(:) = 0.
+ USS%XAOSIM(:) = 0.
+ USS%XAOSJP(:) = 0.
+ USS%XAOSJM(:) = 0.
+ USS%XSSO_ANIS(:) = 0.
+ USS%XSSO_DIR(:) = 0.
! read slope in file
@@ -357,70 +333,73 @@ ELSEIF(LIMP_ZS)THEN !LIMP_ZS (impose topo from input file at the same resolution
ALLOCATE(ZSLOPE(NL))
! Read field on the same grid as FORCING
- CALL READ_PGD_NETCDF(USS, &
+ CALL READ_PGD_NETCDF(UG, U, USS, &
HPROGRAM,'SURF ',' ',YSLOPE,'slope ',ZSLOPE)
DO JJ=1,NL
- USS%XSSO_SLOPE(JJ)=TAN(ZSLOPE(JJ)*PP_DEG2RAD)
+ USS%XSSO_SLOPE(JJ)=TAN(ZSLOPE(JJ)*PP_DEG2RAD)
END DO
DEALLOCATE(ZSLOPE)
ELSE
USS%XSSO_SLOPE=0.
ENDIF
-
-
-
+
ELSE
#ifdef SFX_ASC
- CFILEIN = ADJUSTL(ADJUSTR(YZS)//'.txt')
+ CFILEIN = ADJUSTL(ADJUSTR(YZS)//'.txt')
#endif
#ifdef SFX_FA
- CFILEIN_FA = ADJUSTL(ADJUSTR(YZS)//'.fa')
+ CFILEIN_FA = ADJUSTL(ADJUSTR(YZS)//'.fa')
#endif
#ifdef SFX_LFI
- CFILEIN_LFI = ADJUSTL(YZS)
+ CFILEIN_LFI = ADJUSTL(YZS)
#endif
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- YFILETYPE,'FULL ','SURF ','READ ')
+ CALL INIT_IO_SURF_n(DTCO, U, YFILETYPE,'FULL ','SURF ','READ ')
ENDIF
!
- CALL READ_SURF(&
- YFILETYPE,'ZS',U%XZS(:),IRESP)
- CALL READ_SSO_n(&
- U, USS, &
- YFILETYPE)
+ CALL READ_SURF(YFILETYPE,'ZS',U%XZS(:),IRESP)
+ CALL READ_SSO_n(U%NSIZE_FULL, U%XSEA, USS, YFILETYPE)
!
CALL END_IO_SURF_n(YFILETYPE)
-!
- DEALLOCATE(NSIZE )
- DEALLOCATE(XSUMVAL )
- DEALLOCATE(XSUMVAL2 )
!
IF (LHOOK) CALL DR_HOOK('PGD_OROGRAPHY',1,ZHOOK_HANDLE)
RETURN
!
-END IF
-!
-!-------------------------------------------------------------------------------
-
+ELSE
+ !
+ ALLOCATE(NSIZE_ALL(U%NDIM_FULL,1))
+ ALLOCATE(XEXT_ALL (U%NDIM_FULL,2))
+ ALLOCATE(XALL (U%NDIM_FULL,2,1))
+ NSIZE_ALL(:,1) = 0.
+ XEXT_ALL (:,1) = -99999.
+ XEXT_ALL (:,2) = 99999.
+ XALL (:,:,1) = 0.
+ !
+ !-------------------------------------------------------------------------------
!
!* 6. Averages the field
! ------------------
!
- CALL TREAT_FIELD(UG, U, USS, &
- HPROGRAM,'SURF ',YFILETYPE,'A_OROG',YZS, &
- 'ZS ' )
+ CALL TREAT_FIELD(UG, U, USS, &
+ HPROGRAM,'SURF ',YFILETYPE,'A_OROG',YZS, 'ZS ' )
+!
+
+ DEALLOCATE(XSUMVAL )
+ !
+ENDIF
!
-DEALLOCATE(XSUMVAL )
-DEALLOCATE(XSUMVAL2 )
+IF (.NOT.ALLOCATED(NSIZE)) THEN
+ ALLOCATE(NSIZE(NL,1))
+ NSIZE(:,1) = 0
+ENDIF
!
!-------------------------------------------------------------------------------
!
!* 7. Coherence with land sea mask
! ----------------------------
!
-WHERE (PSEA(:)==1. .AND. NSIZE(:)==0) NSIZE(:) = -1
+WHERE (U%XSEA(:)==1. .AND. NSIZE(:,1)==0) NSIZE(:,1) = -1
!
!-------------------------------------------------------------------------------
!
@@ -431,16 +410,16 @@ WHERE (PSEA(:)==1. .AND. NSIZE(:)==0) NSIZE(:) = -1
! these points are probably small isolated islands, and a default value of 1m is assumed.
!
CALL INTERPOL_FIELD(UG, U, &
- HPROGRAM,ILUOUT,NSIZE,USS%XAVG_ZS, 'average orography',PDEF=1.)
+ HPROGRAM,ILUOUT,NSIZE(:,1),USS%XAVG_ZS, 'average orography',PDEF=1.)
CALL INTERPOL_FIELD(UG, U, &
- HPROGRAM,ILUOUT,NSIZE,USS%XSIL_ZS, 'silhouette orography',PDEF=1.)
+ HPROGRAM,ILUOUT,NSIZE(:,1),USS%XSIL_ZS, 'silhouette orography',PDEF=1.)
CALL INTERPOL_FIELD(UG, U, &
- HPROGRAM,ILUOUT,NSIZE,USS%XMIN_ZS, 'minimum orography',PDEF=1.)
+ HPROGRAM,ILUOUT,NSIZE(:,1),USS%XMIN_ZS, 'minimum orography',PDEF=1.)
CALL INTERPOL_FIELD(UG, U, &
- HPROGRAM,ILUOUT,NSIZE,USS%XMAX_ZS, 'maximum orography',PDEF=1.)
+ HPROGRAM,ILUOUT,NSIZE(:,1),USS%XMAX_ZS, 'maximum orography',PDEF=1.)
!
-IFLAG(:) = NSIZE(:)
-WHERE (NSIZE(:)==1) IFLAG(:) = 0 ! only 1 data point was not enough for standard deviation
+IFLAG(:) = NSIZE(:,1)
+WHERE (NSIZE(:,1)==1) IFLAG(:) = 0 ! only 1 data point was not enough for standard deviation
CALL INTERPOL_FIELD(UG, U, &
HPROGRAM,ILUOUT,IFLAG,USS%XSSO_STDEV,'standard deviation of orography',PDEF=0.)
!
@@ -449,22 +428,22 @@ WHERE (NSIZE(:)==1) IFLAG(:) = 0 ! only 1 data point was not enough for standard
!* 9. Coherence with land sea mask
! ----------------------------
!
-USS%XAVG_ZS (:) = USS%XAVG_ZS (:) * (1. - PSEA(:))
-USS%XSIL_ZS (:) = USS%XSIL_ZS (:) * (1. - PSEA(:))
+USS%XAVG_ZS (:) = USS%XAVG_ZS (:) * (1. - U%XSEA(:))
+USS%XSIL_ZS (:) = USS%XSIL_ZS (:) * (1. - U%XSEA(:))
!
-WHERE (PSEA(:)==1.)
+WHERE (U%XSEA(:)==1.)
USS%XSSO_STDEV(:) = XUNDEF
END WHERE
!
-WHERE (PWATER(:)==1.)
+WHERE (U%XWATER(:)==1.)
USS%XSSO_STDEV(:) = 0.
END WHERE
!
-WHERE(PSEA(:)>0.)
+WHERE(U%XSEA(:)>0.)
USS%XMIN_ZS(:) = 0.
END WHERE
!
-WHERE(PSEA(:)==1.)
+WHERE(U%XSEA(:)==1.)
USS%XMAX_ZS(:) = 0.
END WHERE
!
@@ -486,7 +465,7 @@ SELECT CASE (COROGTYPE)
U%XZS(:) = USS%XAVG_ZS(:)
CASE ('ENV')
U%XZS(:) = USS%XAVG_ZS(:)
- WHERE (PSEA(:)<1.) U%XZS(:) = USS%XAVG_ZS(:) + XENV * USS%XSSO_STDEV
+ WHERE (U%XSEA(:)<1.) U%XZS(:) = USS%XAVG_ZS(:) + XENV * USS%XSSO_STDEV
CASE ('SIL')
U%XZS(:) = USS%XSIL_ZS(:)
CASE ('MAX')
@@ -500,38 +479,36 @@ END SELECT
!* 12. Subgrid scale orography characteristics
! ---------------------------------------
!
- CALL SSO(UG, USS, &
- GSSO,GSSO_ANIS,PSEA)
+ CALL SSO(U, UG, USS, GSSO, GSSO_ANIS)
!
-IFLAG(:) = NSIZE(:)
+IFLAG(:) = NSIZE(:,1)
WHERE(.NOT. GSSO(:)) IFLAG(:) = 0
-WHERE(PSEA(:)==1. .AND. IFLAG(:)==0) IFLAG(:) = -1
+WHERE(U%XSEA(:)==1. .AND. IFLAG(:)==0) IFLAG(:) = -1
!
CALL INTERPOL_FIELD(UG, U, &
HPROGRAM,ILUOUT,IFLAG,USS%XSSO_DIR, 'subgrid orography direction',PDEF=0.)
!
IF (LEXPLICIT_SLOPE) THEN
- CALL EXPLICIT_SLOPE(UG, &
- U%XZS,USS%XSSO_SLOPE)
+ CALL EXPLICIT_SLOPE(UG, U%NDIM_FULL, U%XZS, USS%XSSO_SLOPE)
ELSEIF (LEN_TRIM(YSLOPE)==0) THEN
CALL INTERPOL_FIELD(UG, U, &
HPROGRAM,ILUOUT,IFLAG,USS%XSSO_SLOPE,'subgrid orography slope',PDEF=0.)
END IF
!
-IFLAG(:) = NSIZE(:)
+IFLAG(:) = NSIZE(:,1)
WHERE(.NOT. GSSO_ANIS(:)) IFLAG(:) = 0
-WHERE(PSEA(:)==1. .AND. IFLAG(:)==0) IFLAG(:) = -1
+WHERE(U%XSEA(:)==1. .AND. IFLAG(:)==0) IFLAG(:) = -1
!
CALL INTERPOL_FIELD(UG, U, &
HPROGRAM,ILUOUT,IFLAG,USS%XSSO_ANIS, 'subgrid orography anisotropy',PDEF=0.)
!
-WHERE (PSEA(:)==1.)
+WHERE (U%XSEA(:)==1.)
USS%XSSO_ANIS (:) = XUNDEF
USS%XSSO_DIR (:) = XUNDEF
USS%XSSO_SLOPE(:) = XUNDEF
END WHERE
!
-WHERE (PWATER(:)==1.)
+WHERE (U%XWATER(:)==1.)
USS%XSSO_ANIS (:) = 1.
USS%XSSO_DIR (:) = 0.
USS%XSSO_SLOPE(:) = 0.
@@ -542,12 +519,11 @@ END WHERE
!* 13. Subgrid scale orography roughness
! ---------------------------------
!
- CALL SUBSCALE_AOS(UG, USS, &
- GZ0EFFI,GZ0EFFJ,PSEA)
+ CALL SUBSCALE_AOS(U, UG, USS, GZ0EFFI, GZ0EFFJ)
!
-IFLAG(:) = NSIZE(:)
+IFLAG(:) = NSIZE(:,1)
WHERE(.NOT. GZ0EFFI(:)) IFLAG(:) = 0
-WHERE(PSEA(:)==1. .AND. IFLAG(:)==0) IFLAG(:) = -1
+WHERE(U%XSEA(:)==1. .AND. IFLAG(:)==0) IFLAG(:) = -1
CALL INTERPOL_FIELD(UG, U, &
HPROGRAM,ILUOUT,IFLAG,USS%XAOSIP, 'subgrid orography A/S, direction i+',PDEF=0.)
CALL INTERPOL_FIELD(UG, U, &
@@ -557,9 +533,9 @@ WHERE(PSEA(:)==1. .AND. IFLAG(:)==0) IFLAG(:) = -1
CALL INTERPOL_FIELD(UG, U, &
HPROGRAM,ILUOUT,IFLAG,USS%XHO2IM, 'subgrid orography h/2, direction i-',PDEF=0.)
!
-IFLAG(:) = NSIZE(:)
+IFLAG(:) = NSIZE(:,1)
WHERE(.NOT. GZ0EFFJ(:)) IFLAG(:) = 0
-WHERE(PSEA(:)==1. .AND. IFLAG(:)==0) IFLAG(:) = -1
+WHERE(U%XSEA(:)==1. .AND. IFLAG(:)==0) IFLAG(:) = -1
CALL INTERPOL_FIELD(UG, U, &
HPROGRAM,ILUOUT,IFLAG,USS%XAOSJP, 'subgrid orography A/S, direction j+',PDEF=0.)
CALL INTERPOL_FIELD(UG, U, &
@@ -569,7 +545,7 @@ WHERE(PSEA(:)==1. .AND. IFLAG(:)==0) IFLAG(:) = -1
CALL INTERPOL_FIELD(UG, U, &
HPROGRAM,ILUOUT,IFLAG,USS%XHO2JM, 'subgrid orography h/2, direction j-',PDEF=0.)
!
-WHERE (PSEA(:)==1.)
+WHERE (U%XSEA(:)==1.)
USS%XHO2IP(:) = XUNDEF
USS%XHO2IM(:) = XUNDEF
USS%XHO2JP(:) = XUNDEF
@@ -580,7 +556,7 @@ WHERE (PSEA(:)==1.)
USS%XAOSJM(:) = XUNDEF
END WHERE
!
-WHERE (PWATER(:)==1.)
+WHERE (U%XWATER(:)==1.)
USS%XHO2IP(:) = 0.
USS%XHO2IM(:) = 0.
USS%XHO2JP(:) = 0.
diff --git a/src/SURFEX/pgd_sea.F90 b/src/SURFEX/pgd_sea.F90
index 3e4876da22ae9fe2b92eefb3c32498d50b31a86c..a4c074ea75d7e93fe2744e22aae22ba68e6d0c70 100644
--- a/src/SURFEX/pgd_sea.F90
+++ b/src/SURFEX/pgd_sea.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PGD_SEA (DTCO, DTS, SG, S, UG, U, USS, &
- HPROGRAM)
+ SUBROUTINE PGD_SEA (DTCO, DTS, SG, S, UG, U, USS, HPROGRAM)
! #############################################################
!
!!**** *PGD_SEA* - routine to choose initialization of sea scheme
@@ -42,11 +41,11 @@
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_t
-USE MODD_SEAFLUX_GRID_n, ONLY : SEAFLUX_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODI_PGD_SEAFLUX
!
@@ -63,11 +62,11 @@ IMPLICIT NONE
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(DATA_SEAFLUX_t), INTENT(INOUT) :: DTS
-TYPE(SEAFLUX_GRID_t), INTENT(INOUT) :: SG
+TYPE(GRID_t), INTENT(INOUT) :: SG
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -89,8 +88,7 @@ ELSE IF (U%CSEA=='FLUX ') THEN
IF (LHOOK) CALL DR_HOOK('PGD_SEA',1,ZHOOK_HANDLE)
RETURN
ELSE IF (U%CSEA=='SEAFLX') THEN
- CALL PGD_SEAFLUX(DTCO, DTS, SG, S, UG, U, USS, &
- HPROGRAM)
+ CALL PGD_SEAFLUX(DTCO, DTS, SG, S, UG, U, USS, HPROGRAM)
END IF
IF (LHOOK) CALL DR_HOOK('PGD_SEA',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/pgd_seaflux.F90 b/src/SURFEX/pgd_seaflux.F90
index 310f67f7ff30f92864de8843ea624d57051ff45a..50ba2923b6cbd3d6bf34207cac351a6501ab413e 100644
--- a/src/SURFEX/pgd_seaflux.F90
+++ b/src/SURFEX/pgd_seaflux.F90
@@ -35,7 +35,6 @@
!!
!! Original 03/2004
!! Lebeaupin-B C. 01/2008 : include bathymetry
-!! M.Moge 02/2015 check with MPPDB
!!
!----------------------------------------------------------------------------
!
@@ -47,11 +46,11 @@
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_t
-USE MODD_SEAFLUX_GRID_n, ONLY : SEAFLUX_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_PGD_GRID, ONLY : NL
USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
@@ -81,11 +80,11 @@ IMPLICIT NONE
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(DATA_SEAFLUX_t), INTENT(INOUT) :: DTS
-TYPE(SEAFLUX_GRID_t), INTENT(INOUT) :: SG
+TYPE(GRID_t), INTENT(INOUT) :: SG
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
!
@@ -94,10 +93,10 @@ TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
! ------------------------------
!
REAL, DIMENSION(NL) :: ZSEABATHY ! bathymetry on all surface points
+!
#ifdef MNH_PARALLEL
INTEGER :: ILUOUT
#endif
-!
!* 0.3 Declaration of namelists
! ------------------------
!
@@ -136,16 +135,14 @@ IF (LHOOK) CALL DR_HOOK('PGD_SEAFLUX',0,ZHOOK_HANDLE)
!* 4. Bathymetry
! ----------
!
- CALL PGD_BATHYFIELD(UG, U, USS, &
- HPROGRAM,'bathymetry','SEA',YSEABATHY,YSEABATHYFILETYPE,&
+ CALL PGD_BATHYFIELD(UG, U, USS, HPROGRAM,'bathymetry','SEA',YSEABATHY,YSEABATHYFILETYPE,&
YNCVARNAME,XUNIF_SEABATHY,ZSEABATHY(:))
!-------------------------------------------------------------------------------
!
!* 5. Number of points and packing
! ----------------------------
!
- CALL GET_SURF_SIZE_n(DTCO, U, &
- 'SEA ',SG%NDIM)
+ CALL GET_SURF_SIZE_n(DTCO, U, 'SEA ',SG%NDIM)
!
ALLOCATE(S%LCOVER (JPCOVER))
ALLOCATE(S%XZS (SG%NDIM))
@@ -153,22 +150,18 @@ ALLOCATE(SG%XLAT (SG%NDIM))
ALLOCATE(SG%XLON (SG%NDIM))
ALLOCATE(SG%XMESH_SIZE (SG%NDIM))
!
- CALL PACK_PGD(DTCO, U, &
- HPROGRAM, 'SEA ', &
- SG%CGRID, SG%XGRID_PAR, &
- S%LCOVER, S%XCOVER, S%XZS, &
- SG%XLAT, SG%XLON, SG%XMESH_SIZE )
+ CALL PACK_PGD(DTCO, U, HPROGRAM, 'SEA ', SG, S%LCOVER, S%XCOVER, S%XZS )
+!
#ifdef MNH_PARALLEL
CALL MPPDB_CHECK_SURFEX2D(SG%XLAT,"PGD_SEAFLUX after PACK_PGD:XLAT",PRECISION,ILUOUT,'SEA')
CALL MPPDB_CHECK_SURFEX2D(SG%XLON,"PGD_SEAFLUX after PACK_PGD:XLON",PRECISION,ILUOUT,'SEA')
CALL MPPDB_CHECK_SURFEX2D(SG%XMESH_SIZE,"PGD_SEAFLUX after PACK_PGD:XMESH_SIZE",PRECISION,ILUOUT,'SEA')
#endif
+
+ CALL PACK_PGD_SEAFLUX(DTCO, SG%NDIM, S, U, HPROGRAM, ZSEABATHY)
!
- CALL PACK_PGD_SEAFLUX(DTCO, SG, S, U, &
- HPROGRAM, ZSEABATHY)
-!
- CALL PGD_SEAFLUX_PAR(DTCO, DTS, SG, UG, U, USS, &
- HPROGRAM,DTS%LSST_DATA)
+ CALL PGD_SEAFLUX_PAR(DTCO, DTS, SG%NDIM, UG, U, USS, HPROGRAM)
+ !
IF (LHOOK) CALL DR_HOOK('PGD_SEAFLUX',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/pgd_seaflux_par.F90 b/src/SURFEX/pgd_seaflux_par.F90
index 5a30ab42763b9e4468499dbfd86c0f12b2c54c9a..e009b61fd2aefb435e99b903ba728cf1e15382b0 100644
--- a/src/SURFEX/pgd_seaflux_par.F90
+++ b/src/SURFEX/pgd_seaflux_par.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PGD_SEAFLUX_PAR (DTCO, DTS, SG, UG, U, USS, &
- HPROGRAM,OSST_DATA)
+ SUBROUTINE PGD_SEAFLUX_PAR (DTCO, DTS, KDIM, UG, U, USS, HPROGRAM)
! ##############################################################
!
!!**** *PGD_SEAFLUX_PAR* monitor for averaging and interpolations of sst
@@ -45,10 +44,9 @@
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_t
-USE MODD_SEAFLUX_GRID_n, ONLY : SEAFLUX_GRID_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
!
@@ -77,13 +75,12 @@ IMPLICIT NONE
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(DATA_SEAFLUX_t), INTENT(INOUT) :: DTS
-TYPE(SEAFLUX_GRID_t), INTENT(INOUT) :: SG
+INTEGER, INTENT(IN) :: KDIM
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
-LOGICAL , INTENT(OUT) :: OSST_DATA
!
!
!* 0.2 Declaration of local variables
@@ -126,9 +123,9 @@ IF (LHOOK) CALL DR_HOOK('PGD_SEAFLUX_PAR',0,ZHOOK_HANDLE)
NTIME_SST = 12
XUNIF_SST (:) = XUNDEF ! sea surface temperature
!
- CFNAM_SST (:) = ' '
+CFNAM_SST (:) = ' '
!
- CFTYP_SST (:) = ' '
+CFTYP_SST (:) = ' '
!
NYEAR_SST (:) = NUNDEF
NMONTH_SST (:) = NUNDEF
@@ -149,7 +146,7 @@ IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_DATA_SEAFLUX)
!
CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
!
-OSST_DATA = LSST_DATA
+DTS%LSST_DATA = LSST_DATA
IF (.NOT. LSST_DATA .AND. LHOOK) CALL DR_HOOK('PGD_SEAFLUX_PAR',1,ZHOOK_HANDLE)
IF (.NOT. LSST_DATA) RETURN
!
@@ -157,7 +154,7 @@ IF (NTIME_SST > NTIME_MAX) THEN
WRITE(ILUOUT,*)'NTIME_SST SHOULD NOT EXCEED',NTIME_MAX
CALL ABOR1_SFX('PGD_SEAFLUX_PAR: NTIME TOO BIG')
ENDIF
-ALLOCATE(DTS%XDATA_SST (SG%NDIM,NTIME_SST))
+ALLOCATE(DTS%XDATA_SST (KDIM,NTIME_SST))
ALLOCATE(DTS%TDATA_SST (NTIME_SST))
!
!-------------------------------------------------------------------------------
@@ -165,7 +162,7 @@ ALLOCATE(DTS%TDATA_SST (NTIME_SST))
!* 3. Uniform fields are prescribed
! -----------------------------
!
- CATYPE = 'ARI'
+CATYPE = 'ARI'
!
DO JTIME=1,NTIME_SST
CALL PGD_FIELD(DTCO, UG, U, USS, &
diff --git a/src/SURFEX/pgd_snap_temp_profile.F90 b/src/SURFEX/pgd_snap_temp_profile.F90
index 708ed4cc3922ebd620fd237ab30647a6fb52b12b..37c63b916c8074f2580f8929255deb0cadb40608 100644
--- a/src/SURFEX/pgd_snap_temp_profile.F90
+++ b/src/SURFEX/pgd_snap_temp_profile.F90
@@ -106,7 +106,7 @@ ENDDO
! ------------------------
!
2000 CONTINUE
- CALL CLOSE_FILE (HPROGRAM,IUNIT)
+CALL CLOSE_FILE (HPROGRAM,IUNIT)
!
IF (LHOOK) CALL DR_HOOK('PGD_SNAP_TEMP_PROFILE',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/pgd_surf_atm.F90 b/src/SURFEX/pgd_surf_atm.F90
index fcca45b8901a76c57cb2bce39db51f61b353c2b4..263f45be63f4bb778f1a67fa7011123cdd76ae1a 100644
--- a/src/SURFEX/pgd_surf_atm.F90
+++ b/src/SURFEX/pgd_surf_atm.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###########################################################
- SUBROUTINE PGD_SURF_ATM (YSC, &
- HPROGRAM,HFILE,HFILETYPE,OZS)
+ SUBROUTINE PGD_SURF_ATM (YSC,HPROGRAM,HFILE,HFILETYPE,OZS)
! ###########################################################
!!
!! PURPOSE
@@ -37,7 +36,6 @@
!! A. Lemonsu 05/2009 Ajout de la clef LGARDEN pour TEB
!! J. Escobar 11/2013 Add USE MODI_READ_NAM_PGD_CHEMISTRY
!! B. Decharme 02/2014 Add LRM_RIVER
-!! M.Moge 02/2015 check with MPPDB
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
@@ -46,9 +44,12 @@
!
USE MODD_SURFEX_n, ONLY : SURFEX_t
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NSIZE, NINDEX, NNUM
+!
USE MODD_SURF_CONF, ONLY : CPROGNAME
-USE MODD_PGD_GRID, ONLY : LLATLONMASK
+USE MODD_PGD_GRID, ONLY : NL, LLATLONMASK, NGRID_PAR
!
+USE MODI_GET_SIZE_FULL_n
USE MODI_GET_LUOUT
USE MODI_READ_PGD_ARRANGE_COVER
USE MODI_READ_PGD_COVER_GARDEN
@@ -77,12 +78,6 @@ USE MODI_INIT_READ_DATA_COVER
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
-USE MODI_READ_NAM_PGD_CHEMISTRY
-#ifdef MNH_PARALLEL
-!
-USE MODE_MPPDB
-#endif
-!
IMPLICIT NONE
!
!* 0.1 Declaration of dummy arguments
@@ -91,9 +86,9 @@ IMPLICIT NONE
!
TYPE(SURFEX_t), INTENT(INOUT) :: YSC
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
- CHARACTER(LEN=28), INTENT(IN) :: HFILE ! atmospheric file name
- CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE! atmospheric file type
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
+CHARACTER(LEN=28), INTENT(IN) :: HFILE ! atmospheric file name
+CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE! atmospheric file type
LOGICAL, INTENT(IN) :: OZS ! .true. if orography is imposed by atm. model
!
!* 0.2 Declaration of local variables
@@ -101,6 +96,7 @@ LOGICAL, INTENT(IN) :: OZS ! .true. if orography is imposed b
!
LOGICAL :: LRM_RIVER !delete inland river coverage. Default is false
!
+INTEGER :: ISIZE_FULL, JI, IDIM_FULL
INTEGER :: ILUOUT ! logical unit of output listing file
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -110,111 +106,116 @@ IF (LHOOK) CALL DR_HOOK('PGD_SURF_ATM',0,ZHOOK_HANDLE)
!
LRM_RIVER = .FALSE.
!
- CPROGNAME=HPROGRAM
+CPROGNAME=HPROGRAM
!
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
!* 1. Set default constant values
! ---------------------------
-!
- CALL READ_PGD_ARRANGE_COVER(HPROGRAM,YSC%U%LWATER_TO_NATURE,YSC%U%LTOWN_TO_ROCK)
-!
- CALL READ_PGD_COVER_GARDEN(HPROGRAM,YSC%U%LGARDEN)
-!
- CALL INIT_READ_DATA_COVER(HPROGRAM)
-!
- CALL INI_DATA_COVER(YSC%DTCO, YSC%U)
!
!* 1.2 surface schemes
- CALL READ_PGD_SCHEMES(HPROGRAM,YSC%U%CNATURE,YSC%U%CSEA,YSC%U%CTOWN,YSC%U%CWATER)
+ CALL READ_PGD_SCHEMES(HPROGRAM, YSC%U%CNATURE, YSC%U%CSEA, YSC%U%CTOWN, YSC%U%CWATER)
!
-!* 1.3 prints all parameters in a Latex file
CALL READ_NAM_WRITE_COVER_TEX(HPROGRAM)
!
- CALL WRITE_COVER_TEX_START(HPROGRAM)
- CALL WRITE_COVER_TEX_COVER
!-------------------------------------------------------------------------------
!
!* 2. Grid
! ----
!
-ALLOCATE(YSC%UG%XLAT(YSC%U%NSIZE_FULL))
-ALLOCATE(YSC%UG%XLON(YSC%U%NSIZE_FULL))
-ALLOCATE(YSC%UG%XMESH_SIZE(YSC%U%NSIZE_FULL))
-ALLOCATE(YSC%UG%XJPDIR(YSC%U%NSIZE_FULL))
- CALL LATLON_GRID(YSC%UG%CGRID,YSC%UG%NGRID_PAR,YSC%U%NSIZE_FULL,ILUOUT,&
- YSC%UG%XGRID_PAR,YSC%UG%XLAT,YSC%UG%XLON,YSC%UG%XMESH_SIZE,YSC%UG%XJPDIR)
-#ifdef MNH_PARALLEL
-! CALL MPPDB_CHECK_SURFEX2D(YSC%UG%XLAT,"PGD_SURF_ATM_n after LATLON_GRID:XLAT",PRECISION,ILUOUT)
-! CALL MPPDB_CHECK_SURFEX2D(YSC%UG%XLON,"PGD_SURF_ATM_n after LATLON_GRID:XLON",PRECISION,ILUOUT)
-! CALL MPPDB_CHECK_SURFEX2D(YSC%UG%XMESH_SIZE,"PGD_SURF_ATM_n after LATLON_GRID:XMESH_SIZE",PRECISION,ILUOUT)
-#endif
+ALLOCATE(YSC%UG%G%XLAT (YSC%U%NSIZE_FULL))
+ALLOCATE(YSC%UG%G%XLON (YSC%U%NSIZE_FULL))
+ALLOCATE(YSC%UG%G%XMESH_SIZE(YSC%U%NSIZE_FULL))
+ALLOCATE(YSC%UG%XJPDIR (YSC%U%NSIZE_FULL))
+ CALL LATLON_GRID(YSC%UG%G, YSC%U%NSIZE_FULL, YSC%UG%XJPDIR)
!
!
!* 2.3 Stores the grid in the module MODD_PGD_GRID
!
- CALL PUT_PGD_GRID(YSC%UG%CGRID,YSC%U%NSIZE_FULL,YSC%UG%NGRID_PAR,YSC%UG%XGRID_PAR)
+ CALL PUT_PGD_GRID(YSC%UG%G%CGRID, YSC%U%NSIZE_FULL,YSC%UG%G%NGRID_PAR, YSC%UG%G%XGRID_PAR)
+!
+IF (HPROGRAM=='MESONH') THEN
+ IDIM_FULL = YSC%U%NDIM_FULL
+ YSC%U%NDIM_FULL = NL
+ NSIZE = NL
+ ALLOCATE(NINDEX(NL))
+ NINDEX(:) = 0
+ ALLOCATE(NNUM(NL))
+ DO JI = 1,NL
+ NNUM(JI) = JI
+ ENDDO
+ENDIF
+!
+IF (.NOT.ASSOCIATED(YSC%UG%XGRID_FULL_PAR)) THEN
+ ALLOCATE(YSC%UG%XGRID_FULL_PAR(SIZE(YSC%UG%G%XGRID_PAR)))
+ YSC%UG%XGRID_FULL_PAR(:) = YSC%UG%G%XGRID_PAR(:)
+ YSC%UG%NGRID_FULL_PAR = NGRID_PAR
+ENDIF
!
!* 2.4 mask to limit the number of input data to read
- CALL LATLONMASK (YSC%UG%CGRID,YSC%UG%NGRID_PAR,YSC%UG%XGRID_PAR,LLATLONMASK)
+ CALL LATLONMASK(YSC%UG%G%CGRID, YSC%UG%NGRID_FULL_PAR, YSC%UG%XGRID_FULL_PAR, LLATLONMASK)
!
!-------------------------------------------------------------------------------
!
!* 3. surface cover
! -------------
!
- CALL PGD_FRAC(YSC%DTCO, YSC%UG, YSC%U, YSC%USS, &
- HPROGRAM,YSC%U%LECOCLIMAP)
-IF (YSC%U%LECOCLIMAP) CALL PGD_COVER(YSC%DGU, YSC%DTCO, YSC%UG, YSC%U, YSC%USS, &
- HPROGRAM,LRM_RIVER)
+ CALL PGD_FRAC(YSC%DTCO, YSC%UG, YSC%U, YSC%USS, HPROGRAM)
+!
+ CALL READ_PGD_ARRANGE_COVER(HPROGRAM, YSC%U%LWATER_TO_NATURE, YSC%U%LTOWN_TO_ROCK)
+!
+ CALL READ_PGD_COVER_GARDEN(HPROGRAM, YSC%U%LGARDEN)
+!
+ CALL INIT_READ_DATA_COVER(HPROGRAM)
+!
+ CALL INI_DATA_COVER(YSC%DTCO, YSC%U)
+IF (YSC%U%LECOCLIMAP) CALL PGD_COVER(YSC%DTCO, YSC%UG, YSC%U, YSC%USS, HPROGRAM,LRM_RIVER)
+!
+IF (NRANK==NPIO) THEN
+ CALL WRITE_COVER_TEX_START(HPROGRAM)
+ CALL WRITE_COVER_TEX_COVER
+ENDIF
!
!-------------------------------------------------------------------------------
!
!* 4. Orography
! ---------
!
- CALL PGD_OROGRAPHY(YSC%DGU, YSC%DTCO, YSC%UG, YSC%U, YSC%USS, &
- HPROGRAM,YSC%U%XSEA,YSC%U%XWATER,HFILE,HFILETYPE,OZS)
+ CALL PGD_OROGRAPHY(YSC%DTCO, YSC%UG, YSC%U, YSC%USS, HPROGRAM, HFILE, HFILETYPE, OZS)
!
!_______________________________________________________________________________
!
!* 5. Additionnal fields for nature scheme
! ------------------------------------
!
-IF (YSC%U%NDIM_NATURE>0) CALL PGD_NATURE(YSC%DTCO, YSC%IM%DTI, YSC%DTZ, YSC%DGU, YSC%IM%IG, &
- YSC%IM%I, YSC%UG, YSC%U, YSC%USS, &
- HPROGRAM,YSC%U%LECOCLIMAP)
+IF (YSC%U%NDIM_NATURE>0) CALL PGD_NATURE(YSC%DTCO, YSC%DTZ, YSC%IM, YSC%UG, YSC%U, YSC%USS, HPROGRAM)
!_______________________________________________________________________________
!
!* 6. Additionnal fields for town scheme
! ----------------------------------
!
-IF (YSC%U%NDIM_TOWN>0) CALL PGD_TOWN(YSC%DTCO, YSC%DGU, YSC%UG, YSC%U, YSC%USS, &
- YSC%IM%DTI, YSC%TM, YSC%GDM, YSC%GRM, &
- HPROGRAM,YSC%U%LECOCLIMAP,YSC%U%LGARDEN)
+IF (YSC%U%NDIM_TOWN>0) CALL PGD_TOWN(YSC%DTCO, YSC%UG, YSC%U, YSC%USS, &
+ YSC%IM%DTV, YSC%TM, YSC%GDM, YSC%GRM, HPROGRAM)
!_______________________________________________________________________________
!
!* 7. Additionnal fields for inland water scheme
! ------------------------------------------
!
-IF (YSC%U%NDIM_WATER>0) CALL PGD_INLAND_WATER(YSC%DTCO, YSC%FM%FG, YSC%FM%F, YSC%UG, YSC%U, &
- YSC%USS, YSC%WM%WG, YSC%WM%W, &
- HPROGRAM,YSC%U%LECOCLIMAP,LRM_RIVER)
+IF (YSC%U%NDIM_WATER>0) CALL PGD_INLAND_WATER(YSC%DTCO, YSC%FM%G, YSC%FM%F, YSC%UG, YSC%U, &
+ YSC%USS, YSC%WM%G, YSC%WM%W, HPROGRAM,LRM_RIVER)
!_______________________________________________________________________________
!
!* 8. Additionnal fields for sea scheme
! ---------------------------------
!
-IF (YSC%U%NDIM_SEA>0) CALL PGD_SEA(YSC%DTCO, YSC%SM%DTS, YSC%SM%SG, YSC%SM%S, YSC%UG, YSC%U, YSC%USS, &
- HPROGRAM)
-!
+IF (YSC%U%NDIM_SEA>0) CALL PGD_SEA(YSC%DTCO, YSC%SM%DTS, YSC%SM%G, YSC%SM%S, &
+ YSC%UG, YSC%U, YSC%USS, HPROGRAM)
!_______________________________________________________________________________
!
!* 9. Dummy fields
! ------------
!
- CALL PGD_DUMMY(YSC%DTCO, YSC%DUU, YSC%UG, YSC%U, YSC%USS, &
- HPROGRAM)
+ CALL PGD_DUMMY(YSC%DTCO, YSC%DUU, YSC%UG, YSC%U, YSC%USS, HPROGRAM)
!_______________________________________________________________________________
!
!* 10. Chemical Emission fields
@@ -233,7 +234,12 @@ ENDIF
!* 11. Writing in cover latex file
! ---------------------------
!
- CALL WRITE_COVER_TEX_END(HPROGRAM)
+IF (NRANK==NPIO) CALL WRITE_COVER_TEX_END(HPROGRAM)
+!
+IF (HPROGRAM=='MESONH') THEN
+ YSC%U%NDIM_FULL = IDIM_FULL
+ENDIF
+!
IF (LHOOK) CALL DR_HOOK('PGD_SURF_ATM',1,ZHOOK_HANDLE)
!_______________________________________________________________________________
!
diff --git a/src/SURFEX/pgd_teb.F90 b/src/SURFEX/pgd_teb.F90
index e3d1e3ee8f13fb99723930b384673b7eb44ff7e0..6358eb24ed5ba657a3144ed01f3bfedaf7236be4 100644
--- a/src/SURFEX/pgd_teb.F90
+++ b/src/SURFEX/pgd_teb.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PGD_TEB (DTCO, DGU, UG, U, USS, DTI, TM, GDM, GRM, &
- HPROGRAM,OECOCLIMAP,OGARDEN)
+ SUBROUTINE PGD_TEB (DTCO, UG, U, USS, TOP, BOP, TG, BDD, DTT, DTB, &
+ GDO, GDK, DTGD, GDIR, GRO, GRS, GRK, DTGR, HPROGRAM)
! ##############################################################
!
!!**** *PGD_TEB* monitor for averaging and interpolations of TEB physiographic fields
@@ -36,24 +36,30 @@
!! Original 10/12/97
!! A. Lemonsu 05/2009 Key for garden option
!! G. Pigeon /09/12: WALL, ROOF, FLOOR, MASS LAYER default to 5
-!! M. Moge 02/2015 : MPPDB_CHECK
!!
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
! -----------
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_SSO_n, ONLY : SSO_t
+!
+USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
+USE MODD_BEM_OPTION_n, ONLY : BEM_OPTIONS_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_BLD_DESCRIPTION_n, ONLY : BLD_DESC_t
+USE MODD_DATA_TEB_n, ONLY : DATA_TEB_t
+USE MODD_DATA_BEM_n, ONLY : DATA_BEM_t
!
-USE MODD_SURFEX_n, ONLY : TEB_MODEL_t
-USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t
-USE MODD_SURFEX_n, ONLY : TEB_GREENROOF_MODEL_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_TEB_IRRIG_n, ONLY : TEB_IRRIG_t
!
USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
!
@@ -75,6 +81,7 @@ USE PARKIND1 ,ONLY : JPRB
USE MODE_MPPDB
!
#endif
+!
USE MODI_WRITE_COVER_TEX_TEB
!
IMPLICIT NONE
@@ -84,19 +91,26 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM
-TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
-TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM
+TYPE(SSO_t), INTENT(INOUT) :: USS
+TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+TYPE(BEM_OPTIONS_t), INTENT(INOUT) :: BOP
+TYPE(GRID_t), INTENT(INOUT) :: TG
+TYPE(BLD_DESC_t), INTENT(INOUT) :: BDD
+TYPE(DATA_TEB_t), INTENT(INOUT) :: DTT
+TYPE(DATA_BEM_t), INTENT(INOUT) :: DTB
+!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: GDO
+TYPE(ISBA_K_t), INTENT(INOUT) :: GDK
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTGD
+TYPE(TEB_IRRIG_t), INTENT(INOUT) :: GDIR
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: GRO
+TYPE(ISBA_S_t), INTENT(INOUT) :: GRS
+TYPE(ISBA_K_t), INTENT(INOUT) :: GRK
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTGR
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
-LOGICAL, INTENT(IN) :: OECOCLIMAP ! T if parameters are computed with ecoclimap
-! ! F if all parameters must be specified
-LOGICAL, INTENT(IN) :: OGARDEN ! T if urban green areas
!
!
!* 0.2 Declaration of local variables
@@ -113,33 +127,33 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('PGD_TEB',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
-TM%TOP%NROOF_LAYER = 5
-TM%TOP%NROAD_LAYER = 5
-TM%TOP%NWALL_LAYER = 5
-TM%BOP%NFLOOR_LAYER = 5
+TOP%NROOF_LAYER = 5
+TOP%NROAD_LAYER = 5
+TOP%NWALL_LAYER = 5
+BOP%NFLOOR_LAYER = 5
!
!-------------------------------------------------------------------------------
!
!* 2. Reading of namelist
! -------------------
!
- CALL READ_NAM_PGD_TEB(HPROGRAM,TM%TOP%NTEB_PATCH,TM%TOP%CBEM,TM%BOP%CCOOL_COIL,&
- TM%BOP%CHEAT_COIL,TM%BOP%LAUTOSIZE,TM%TOP%NROAD_LAYER,&
- TM%TOP%NROOF_LAYER,TM%TOP%NWALL_LAYER,TM%BOP%NFLOOR_LAYER, &
- TM%TOP%LGREENROOF,TM%TOP%LHYDRO,TM%TOP%LSOLAR_PANEL )
+ CALL READ_NAM_PGD_TEB(HPROGRAM,TOP%NTEB_PATCH,TOP%CBEM,BOP%CCOOL_COIL, &
+ BOP%CHEAT_COIL,BOP%LAUTOSIZE,TOP%NROAD_LAYER, &
+ TOP%NROOF_LAYER,TOP%NWALL_LAYER,BOP%NFLOOR_LAYER, &
+ TOP%LGREENROOF,TOP%LHYDRO,TOP%LSOLAR_PANEL )
!
!-------------------------------------------------------------------------------
!
!* 3. Coherence of options
! --------------------
!
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CBLD',TM%TOP%CBEM,'DEF','BEM ')
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CCOOL_COIL',TM%BOP%CCOOL_COIL,'IDEAL ','DXCOIL')
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CHEAT_COIL',TM%BOP%CHEAT_COIL,'IDEAL ','FINCAP')
+ CALL TEST_NAM_VAR_SURF(ILUOUT,'CBLD',TOP%CBEM,'DEF','BEM ')
+ CALL TEST_NAM_VAR_SURF(ILUOUT,'CCOOL_COIL',BOP%CCOOL_COIL,'IDEAL ','DXCOIL')
+ CALL TEST_NAM_VAR_SURF(ILUOUT,'CHEAT_COIL',BOP%CHEAT_COIL,'IDEAL ','FINCAP')
!
-IF (.NOT. OGARDEN) THEN
- IF (TM%TOP%LGREENROOF) CALL ABOR1_SFX('ERROR: You cannot activate LGREENROOF if LGARDEN is FALSE')
- IF (TM%TOP%LHYDRO ) CALL ABOR1_SFX('ERROR: You cannot activate LHYDRO if LGARDEN is FALSE')
+IF (.NOT. U%LGARDEN) THEN
+ IF (TOP%LGREENROOF) CALL ABOR1_SFX('ERROR: You cannot activate LGREENROOF if LGARDEN is FALSE')
+ IF (TOP%LHYDRO ) CALL ABOR1_SFX('ERROR: You cannot activate LHYDRO if LGARDEN is FALSE')
ENDIF
!
!-------------------------------------------------------------------------------
@@ -147,43 +161,37 @@ ENDIF
!* 4. Number of points and packing
! ----------------------------
!
- CALL GET_SURF_SIZE_n(DTCO, U, &
- 'TOWN ',TM%TG%NDIM)
-!
-ALLOCATE(TM%TOP%LCOVER (JPCOVER))
-ALLOCATE(TM%TOP%XCOVER (TM%TG%NDIM,JPCOVER))
-ALLOCATE(TM%TOP%XZS (TM%TG%NDIM))
-ALLOCATE(TM%TG%XLAT (TM%TG%NDIM))
-ALLOCATE(TM%TG%XLON (TM%TG%NDIM))
-ALLOCATE(TM%TG%XMESH_SIZE (TM%TG%NDIM))
-!
- CALL PACK_PGD(DTCO, U, &
- HPROGRAM, 'TOWN ', &
- TM%TG%CGRID, TM%TG%XGRID_PAR, &
- TM%TOP%LCOVER, TM%TOP%XCOVER, TM%TOP%XZS, &
- TM%TG%XLAT, TM%TG%XLON, TM%TG%XMESH_SIZE )
+ CALL GET_SURF_SIZE_n(DTCO, U, 'TOWN ',TG%NDIM)
+!
+ALLOCATE(TOP%LCOVER (JPCOVER))
+ALLOCATE(TOP%XZS (TG%NDIM))
+ALLOCATE(TG%XLAT (TG%NDIM))
+ALLOCATE(TG%XLON (TG%NDIM))
+ALLOCATE(TG%XMESH_SIZE (TG%NDIM))
+!
+ CALL PACK_PGD(DTCO, U, HPROGRAM, 'TOWN ', TG, TOP%LCOVER, TOP%XCOVER, TOP%XZS )
+!
#ifdef MNH_PARALLEL
- CALL MPPDB_CHECK_SURFEX3D(TM%TOP%XCOVER,"PGD_TEB after PACK_PGD:XCOVER",PRECISION,ILUOUT, 'TOWN ',SIZE(TM%TOP%XCOVER,2))
- CALL MPPDB_CHECK_SURFEX2D(TM%TG%XLAT,"PGD_TEB after PACK_PGD:XLAT",PRECISION,ILUOUT, 'TOWN ')
- CALL MPPDB_CHECK_SURFEX2D(TM%TG%XLON,"PGD_TEB after PACK_PGD:XLON",PRECISION,ILUOUT, 'TOWN ')
- CALL MPPDB_CHECK_SURFEX2D(TM%TG%XMESH_SIZE,"PGD_TEB after PACK_PGD:XMESH_SIZE",PRECISION,ILUOUT, 'TOWN ')
+ CALL MPPDB_CHECK_SURFEX3D(TOP%XCOVER,"PGD_TEB after PACK_PGD:XCOVER",PRECISION,ILUOUT, 'TOWN ',SIZE(TOP%XCOVER,2))
+ CALL MPPDB_CHECK_SURFEX2D(TG%XLAT,"PGD_TEB after PACK_PGD:XLAT",PRECISION,ILUOUT, 'TOWN ')
+ CALL MPPDB_CHECK_SURFEX2D(TG%XLON,"PGD_TEB after PACK_PGD:XLON",PRECISION,ILUOUT, 'TOWN ')
+ CALL MPPDB_CHECK_SURFEX2D(TG%XMESH_SIZE,"PGD_TEB after PACK_PGD:XMESH_SIZE",PRECISION,ILUOUT, 'TOWN ')
#endif
-!
!-------------------------------------------------------------------------------
!
!* 5. TEB specific fields
! -------------------
!
-TM%TOP%LECOCLIMAP = OECOCLIMAP
- CALL PGD_TEB_PAR(DTCO, DGU, UG, U, USS, TM%BDD, TM%DTT, DTI, TM%TG, &
- HPROGRAM,OGARDEN,TM%TOP%LGREENROOF,TM%TOP%CBLD_ATYPE)
+TOP%LECOCLIMAP = U%LECOCLIMAP
+ CALL PGD_TEB_PAR(DTCO, UG, U, USS, BDD, DTT, TG%NDIM, &
+ HPROGRAM,U%LGARDEN,TOP%LGREENROOF,TOP%CBLD_ATYPE)
!
!-------------------------------------------------------------------------------
!
!* 6. Prints of cover parameters in a tex file
! ----------------------------------------
!
-IF (OECOCLIMAP) CALL WRITE_COVER_TEX_TEB
+IF (U%LECOCLIMAP .AND. NRANK==NPIO) CALL WRITE_COVER_TEX_TEB
!
!
!-------------------------------------------------------------------------------
@@ -191,18 +199,18 @@ IF (OECOCLIMAP) CALL WRITE_COVER_TEX_TEB
!* 7. Case of urban green areas (and hydrology)
! -----------------------------------------
!
-TM%TOP%LGARDEN = OGARDEN
+TOP%LGARDEN = U%LGARDEN
!
-IF (TM%TOP%LGARDEN) CALL PGD_TEB_VEG(DTCO, UG, U, USS, GDM, GRM, TM%TOP, TM%TG, &
- HPROGRAM)
+IF (TOP%LGARDEN) CALL PGD_TEB_VEG(DTCO, UG, U, USS, GDO, GDK, DTGD, GDIR, &
+ GRO, GRS, GRK, DTGR, TOP, TG%NDIM, HPROGRAM)
!
!-------------------------------------------------------------------------------
!
!* 8. Case of Building Energy Model
! -----------------------------
!
-IF (TM%TOP%CBEM .EQ. 'BEM') CALL PGD_BEM_PAR(DTCO, DGU, UG, U, USS, TM%DTB, DTI, TM%TG, &
- HPROGRAM,TM%BOP%LAUTOSIZE)
+IF (TOP%CBEM .EQ. 'BEM') CALL PGD_BEM_PAR(DTCO, UG, U, USS, DTB, TG%NDIM, &
+ HPROGRAM,BOP%LAUTOSIZE)
!
IF (LHOOK) CALL DR_HOOK('PGD_TEB',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/pgd_teb_garden_par.F90 b/src/SURFEX/pgd_teb_garden_par.F90
index ce93f6972708e403bafa9f71d50c19a2a62bb2c4..8898e48d4b9ca3c523cb047882b78bb53e92f4f7 100644
--- a/src/SURFEX/pgd_teb_garden_par.F90
+++ b/src/SURFEX/pgd_teb_garden_par.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PGD_TEB_GARDEN_PAR (DTCO, UG, U, USS, TG, GDM, &
- HPROGRAM)
+ SUBROUTINE PGD_TEB_GARDEN_PAR (DTCO, UG, U, USS, KDIM, IO, DTV, HPROGRAM)
! ##############################################################
!
!!**** *PGD_TEB_GARDEN_PAR* monitor for averaging and interpolations of cover fractions
@@ -45,9 +44,10 @@
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
-USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t
+USE MODD_SSO_n, ONLY : SSO_t
+!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
!
USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -75,9 +75,10 @@ IMPLICIT NONE
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
-TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
+TYPE(SSO_t), INTENT(INOUT) :: USS
+INTEGER, INTENT(IN) :: KDIM
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
!
@@ -156,9 +157,9 @@ IF (LHOOK) CALL DR_HOOK('PGD_TEB_GARDEN_PAR',0,ZHOOK_HANDLE)
NTIME_GD = 12
!
- CTYP_GARDEN_HVEG = 'TEBD' ! Temperate broadleaf trees (forest)
- CTYP_GARDEN_LVEG = 'PARK' ! Grassland
- CTYP_GARDEN_NVEG = 'NO ' ! No vegetation
+CTYP_GARDEN_HVEG = 'TEBD' ! Temperate broadleaf trees (forest)
+CTYP_GARDEN_LVEG = 'PARK' ! Grassland
+CTYP_GARDEN_NVEG = 'NO ' ! No vegetation
!
XUNIF_FRAC_HVEG = XUNDEF
XUNIF_FRAC_LVEG = XUNDEF
@@ -167,22 +168,22 @@ XUNIF_LAI_HVEG = XUNDEF
XUNIF_LAI_LVEG = XUNDEF
XUNIF_H_HVEG = XUNDEF
!
- CFNAM_FRAC_HVEG = ' '
- CFNAM_FRAC_LVEG = ' '
- CFNAM_FRAC_NVEG = ' '
- CFNAM_LAI_HVEG = ' '
- CFNAM_LAI_LVEG = ' '
- CFNAM_H_HVEG = ' '
+CFNAM_FRAC_HVEG = ' '
+CFNAM_FRAC_LVEG = ' '
+CFNAM_FRAC_NVEG = ' '
+CFNAM_LAI_HVEG = ' '
+CFNAM_LAI_LVEG = ' '
+CFNAM_H_HVEG = ' '
!
- CFTYP_FRAC_HVEG = ' '
- CFTYP_FRAC_LVEG = ' '
- CFTYP_FRAC_NVEG = ' '
- CFTYP_LAI_HVEG = ' '
- CFTYP_LAI_LVEG = ' '
- CFTYP_H_HVEG = ' '
+CFTYP_FRAC_HVEG = ' '
+CFTYP_FRAC_LVEG = ' '
+CFTYP_FRAC_NVEG = ' '
+CFTYP_LAI_HVEG = ' '
+CFTYP_LAI_LVEG = ' '
+CFTYP_H_HVEG = ' '
!
!-------------------------------------------------------------------------------
-GDM%DTGD%NTIME = 12
+DTV%NTIME = 12
!-------------------------------------------------------------------------------
!
!* 2. Input file for cover types
@@ -207,7 +208,7 @@ END IF
!* 3. Coherence check
! ---------------
!
-GDM%TGDO%LPAR_GARDEN = (XUNIF_FRAC_HVEG /= XUNDEF .OR. LEN_TRIM(CFNAM_FRAC_HVEG) >0 )&
+IO%LPAR = (XUNIF_FRAC_HVEG /= XUNDEF .OR. LEN_TRIM(CFNAM_FRAC_HVEG) >0 )&
.AND. (XUNIF_FRAC_LVEG /= XUNDEF .OR. LEN_TRIM(CFNAM_FRAC_LVEG) >0 )&
.AND. (XUNIF_FRAC_NVEG /= XUNDEF .OR. LEN_TRIM(CFNAM_FRAC_NVEG) >0 )
@@ -215,7 +216,7 @@ GNO_PAR_GARDEN = (XUNIF_FRAC_HVEG == XUNDEF .AND. LEN_TRIM(CFNAM_FRAC_HVEG)==0)&
.AND. (XUNIF_FRAC_LVEG == XUNDEF .AND. LEN_TRIM(CFNAM_FRAC_LVEG)==0)&
.AND. (XUNIF_FRAC_NVEG == XUNDEF .AND. LEN_TRIM(CFNAM_FRAC_NVEG)==0)
-IF ( .NOT. GDM%TGDO%LPAR_GARDEN .AND. .NOT. GNO_PAR_GARDEN ) THEN
+IF ( .NOT. IO%LPAR .AND. .NOT. GNO_PAR_GARDEN ) THEN
WRITE(ILUOUT,*) ' Error for fraction of high, low and no vegetation fractions in gardens '
WRITE(ILUOUT,*) ' You need to specify the three of them ... or none. '
CALL ABOR1_SFX( 'Namelist NAM_DATA_TEB_GARDEN: you need to specify all of HVEG, LVEG, NVEG fractions or NONE of them')
@@ -228,48 +229,48 @@ END IF
!
!-------------------------------------------------------------------------------
!
-GDM%DTGD%NTIME = NTIME_GD
+DTV%NTIME = NTIME_GD
!
-ALLOCATE(GDM%DTGD%XDATA_FRAC_HVEG (TG%NDIM ))
-ALLOCATE(GDM%DTGD%XDATA_FRAC_LVEG (TG%NDIM ))
-ALLOCATE(GDM%DTGD%XDATA_FRAC_NVEG (TG%NDIM ))
-ALLOCATE(GDM%DTGD%XDATA_LAI_HVEG (TG%NDIM,GDM%DTGD%NTIME))
-ALLOCATE(GDM%DTGD%XDATA_LAI_LVEG (TG%NDIM,GDM%DTGD%NTIME))
-ALLOCATE(GDM%DTGD%XDATA_H_HVEG (TG%NDIM ))
+ALLOCATE(DTV%XPAR_FRAC_HVEG (KDIM ))
+ALLOCATE(DTV%XPAR_FRAC_LVEG (KDIM ))
+ALLOCATE(DTV%XPAR_FRAC_NVEG (KDIM ))
+ALLOCATE(DTV%XPAR_LAI_HVEG (KDIM,DTV%NTIME))
+ALLOCATE(DTV%XPAR_LAI_LVEG (KDIM,DTV%NTIME))
+ALLOCATE(DTV%XPAR_H_HVEG (KDIM ))
!
-GDM%TGDP%CTYPE_HVEG = CTYP_GARDEN_HVEG
-GDM%TGDP%CTYPE_LVEG = CTYP_GARDEN_LVEG
-GDM%TGDP%CTYPE_NVEG = CTYP_GARDEN_NVEG
+IO%CTYPE_HVEG = CTYP_GARDEN_HVEG
+IO%CTYPE_LVEG = CTYP_GARDEN_LVEG
+IO%CTYPE_NVEG = CTYP_GARDEN_NVEG
!
!-------------------------------------------------------------------------------
!
!* 3. Uniform fields are prescribed
! -----------------------------
!
- CATYPE = 'ARI'
+CATYPE = 'ARI'
!
CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'FRAC_HVEG: fraction of high vegetation','TWN',CFNAM_FRAC_HVEG, &
- CFTYP_FRAC_HVEG,XUNIF_FRAC_HVEG,GDM%DTGD%XDATA_FRAC_HVEG(:))
+ CFTYP_FRAC_HVEG,XUNIF_FRAC_HVEG,DTV%XPAR_FRAC_HVEG(:))
!
CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'FRAC_LVEG: fraction of low vegetation' ,'TWN',CFNAM_FRAC_LVEG, &
- CFTYP_FRAC_LVEG,XUNIF_FRAC_LVEG,GDM%DTGD%XDATA_FRAC_LVEG(:))
+ CFTYP_FRAC_LVEG,XUNIF_FRAC_LVEG,DTV%XPAR_FRAC_LVEG(:))
!
CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'FRAC_NVEG: fraction of bare soil' ,'TWN',CFNAM_FRAC_NVEG, &
- CFTYP_FRAC_NVEG,XUNIF_FRAC_NVEG,GDM%DTGD%XDATA_FRAC_NVEG(:))
+ CFTYP_FRAC_NVEG,XUNIF_FRAC_NVEG,DTV%XPAR_FRAC_NVEG(:))
!
!
-DO JTIME=1,GDM%DTGD%NTIME
+DO JTIME=1,DTV%NTIME
!
CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'LAI_HVEG: LAI of high vegetation','TWN',CFNAM_LAI_HVEG(JTIME), &
- CFTYP_LAI_HVEG(JTIME),XUNIF_LAI_HVEG(JTIME),GDM%DTGD%XDATA_LAI_HVEG(:,JTIME))
+ CFTYP_LAI_HVEG(JTIME),XUNIF_LAI_HVEG(JTIME),DTV%XPAR_LAI_HVEG(:,JTIME))
!
CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'LAI_LVEG: LAI of low vegetation','TWN',CFNAM_LAI_LVEG(JTIME), &
- CFTYP_LAI_LVEG(JTIME),XUNIF_LAI_LVEG(JTIME),GDM%DTGD%XDATA_LAI_LVEG(:,JTIME))
+ CFTYP_LAI_LVEG(JTIME),XUNIF_LAI_LVEG(JTIME),DTV%XPAR_LAI_LVEG(:,JTIME))
!
!
ENDDO
@@ -277,7 +278,7 @@ ENDDO
!
CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'H_HVEG: height of trees','TWN',CFNAM_H_HVEG, &
- CFTYP_H_HVEG,XUNIF_H_HVEG,GDM%DTGD%XDATA_H_HVEG(:))
+ CFTYP_H_HVEG,XUNIF_H_HVEG,DTV%XPAR_H_HVEG(:))
IF (LHOOK) CALL DR_HOOK('PGD_TEB_GARDEN_PAR',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/pgd_teb_greenroof.F90 b/src/SURFEX/pgd_teb_greenroof.F90
index ed1e9dd55db0b7a31c3d553bb0e4f4245c943915..9340d23cbb1a457296b37c226015b3ff33f64b91 100644
--- a/src/SURFEX/pgd_teb_greenroof.F90
+++ b/src/SURFEX/pgd_teb_greenroof.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PGD_TEB_GREENROOF (DTCO, UG, U, USS, GRM, TG, &
- HPROGRAM)
+ SUBROUTINE PGD_TEB_GREENROOF (DTCO, UG, U, USS, IO, S, K, DTV, KDIM, HPROGRAM)
! ##############################################################
!
!!**** *PGD_TEB_GREENROOF* monitor for averaging and interpolations of TEB GR physiographic fields
@@ -40,14 +39,15 @@
!* 0. DECLARATION
! -----------
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_SURFEX_n, ONLY : TEB_GREENROOF_MODEL_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_PGD_GRID, ONLY : NL
USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
@@ -68,9 +68,13 @@ IMPLICIT NONE
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
+TYPE(SSO_t), INTENT(INOUT) :: USS
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+!
+INTEGER, INTENT(IN) :: KDIM
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
! ! F if all parameters must be specified
@@ -94,22 +98,24 @@ IF (LHOOK) CALL DR_HOOK('PGD_TEB_GREENROOF',0,ZHOOK_HANDLE)
! ------------------------------------
!
! for green roofs, CISBA = DIF / CSCOND = 'DEF '
-GRM%TGRO%CISBA_GR = 'DIF'
-GRM%TGRO%CSCOND_GR = 'PL98 ' ! CSCOND_GR = 'PL98' !begin test 29092011 ! normalement pas besoin
-GRM%TGRO%CHORT_GR = 'DEF '
-GRM%TGRO%CKSAT_GR = 'DEF '
-GRM%TGRO%LSOC_GR = .FALSE.
-GRM%TGRO%LTR_ML_GR = .FALSE.
-!
-ALLOCATE(GRM%TGRP%XRUNOFFB_GR(TG%NDIM))
-ALLOCATE(GRM%TGRP%XWDRAIN_GR (TG%NDIM))
-!
-GRM%TGRP%XRUNOFFB_GR(:) = 0.5
-GRM%TGRP%XWDRAIN_GR (:) = 0.0
-!
-GRM%TGRO%NTIME_GR = 12
- CALL PGD_TEB_GREENROOF_PAR(DTCO, GRM%DTGR, UG, U, USS, GRM%TGRO, TG, &
- HPROGRAM)
+IO%CISBA = 'DIF'
+IO%CSCOND = 'PL98 ' ! CSCOND_GR = 'PL98' !begin test 29092011 ! normalement pas besoin
+IO%CHORT = 'DEF '
+IO%CKSAT = 'DEF '
+IO%LSOC = .FALSE.
+IO%LTR_ML = .FALSE.
+!
+ALLOCATE(K%XRUNOFFB(KDIM))
+ALLOCATE(K%XWDRAIN (KDIM))
+!
+K%XRUNOFFB(:) = 0.5
+K%XWDRAIN (:) = 0.0
+!
+DTV%NTIME = 12
+!
+IO%LPAR = .TRUE.
+!
+CALL PGD_TEB_GREENROOF_PAR(DTCO, DTV, UG, U, USS, IO, S, K, KDIM, HPROGRAM)
!
!
IF (LHOOK) CALL DR_HOOK('PGD_TEB_GREENROOF',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/pgd_teb_greenroof_par.F90 b/src/SURFEX/pgd_teb_greenroof_par.F90
index 208e3c23804483092a336344673b12c159acd944..6631794a4fe53df38fe2d3d266dd7bea42fd044e 100644
--- a/src/SURFEX/pgd_teb_greenroof_par.F90
+++ b/src/SURFEX/pgd_teb_greenroof_par.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PGD_TEB_GREENROOF_PAR (DTCO, DTGR, UG, U, USS, TGRO, TG, &
- HPROGRAM)
+ SUBROUTINE PGD_TEB_GREENROOF_PAR (DTCO, DTV, UG, U, USS, IO, S, K, KDIM, HPROGRAM)
! ##############################################################
!
!!**** *PGD_TEB_GREENROOF_PAR* monitor for averaging and interpolations of cover fractions
@@ -44,12 +43,12 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DATA_TEB_GREENROOF_n, ONLY : DATA_TEB_GREENROOF_t
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
+USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t
!
USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -74,12 +73,15 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DATA_TEB_GREENROOF_t), INTENT(INOUT) :: DTGR
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: TGRO
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
+TYPE(SSO_t), INTENT(INOUT) :: USS
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+!
+INTEGER, INTENT(IN) :: KDIM
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
!
@@ -164,51 +166,51 @@ YFTYP_LAI_GR = ' '
YFNAM_OM_GR, YFNAM_CLAY_GR, YFNAM_SAND_GR, YFNAM_LAI_GR, &
YFTYP_OM_GR, YFTYP_CLAY_GR, YFTYP_SAND_GR, YFTYP_LAI_GR)
!
-TGRO%NTIME_GR = ITIME_GR
-TGRO%NLAYER_GR = ILAYER_GR
-TGRO%CTYP_GR = YTYP_GR
+DTV%NTIME = ITIME_GR
+IO%NGROUND_LAYER = ILAYER_GR
+IO%CTYP_COV = YTYP_GR
!
!* Coherence of options for the green roof type
! -------------------------------------------
!
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CTYP_GR',TGRO%CTYP_GR,'GRASS','SEDUM')
+ CALL TEST_NAM_VAR_SURF(ILUOUT,'CTYP_GR',IO%CTYP_COV,'GRASS','SEDUM')
!
!
-ALLOCATE(DTGR%XPAR_OM_GR (TG%NDIM,TGRO%NLAYER_GR))
-ALLOCATE(DTGR%XPAR_CLAY_GR (TG%NDIM,TGRO%NLAYER_GR))
-ALLOCATE(DTGR%XPAR_SAND_GR (TG%NDIM,TGRO%NLAYER_GR))
-ALLOCATE(DTGR%XPAR_LAI_GR (TG%NDIM,TGRO%NTIME_GR ))
+ALLOCATE(S%XSOC (KDIM,IO%NGROUND_LAYER))
+ALLOCATE(K%XCLAY (KDIM,IO%NGROUND_LAYER))
+ALLOCATE(K%XSAND (KDIM,IO%NGROUND_LAYER))
+ALLOCATE(DTV%XPAR_LAI (KDIM,DTV%NTIME ,1))
!
!-------------------------------------------------------------------------------
!
!* 3.2 Uniform fields are prescribed
! -----------------------------
!
- CATYPE = 'ARI'
+CATYPE = 'ARI'
!
!
-DO JLAYER_GR=1,TGRO%NLAYER_GR
+DO JLAYER_GR=1,IO%NGROUND_LAYER
CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'OM_GR: fraction of OM in GR layer','BLD',YFNAM_OM_GR(JLAYER_GR), &
- YFTYP_OM_GR(JLAYER_GR), ZUNIF_OM_GR(JLAYER_GR), DTGR%XPAR_OM_GR(:,JLAYER_GR))
+ YFTYP_OM_GR(JLAYER_GR), ZUNIF_OM_GR(JLAYER_GR), S%XSOC(:,JLAYER_GR))
ENDDO
!
-DO JLAYER_GR=1,TGRO%NLAYER_GR
+DO JLAYER_GR=1,IO%NGROUND_LAYER
CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'CLAY_GR: fraction of CLAY in the non-OM part of GR layer','BLD',YFNAM_CLAY_GR(JLAYER_GR), &
- YFTYP_CLAY_GR(JLAYER_GR), ZUNIF_CLAY_GR(JLAYER_GR), DTGR%XPAR_CLAY_GR(:,JLAYER_GR))
+ YFTYP_CLAY_GR(JLAYER_GR), ZUNIF_CLAY_GR(JLAYER_GR), K%XCLAY(:,JLAYER_GR))
ENDDO
!
-DO JLAYER_GR=1,TGRO%NLAYER_GR
+DO JLAYER_GR=1,IO%NGROUND_LAYER
CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'SAND_GR: fraction of SAND in the non-OM part of GR layer','BLD',YFNAM_SAND_GR(JLAYER_GR), &
- YFTYP_SAND_GR(JLAYER_GR), ZUNIF_SAND_GR(JLAYER_GR), DTGR%XPAR_SAND_GR(:,JLAYER_GR))
+ YFTYP_SAND_GR(JLAYER_GR), ZUNIF_SAND_GR(JLAYER_GR), K%XSAND(:,JLAYER_GR))
ENDDO
!
-DO JTIME=1,TGRO%NTIME_GR
+DO JTIME=1,DTV%NTIME
CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'LAI_GR: LAI of green roof','BLD',YFNAM_LAI_GR(JTIME), &
- YFTYP_LAI_GR(JTIME),ZUNIF_LAI_GR(JTIME),DTGR%XPAR_LAI_GR(:,JTIME))
+ YFTYP_LAI_GR(JTIME),ZUNIF_LAI_GR(JTIME),DTV%XPAR_LAI(:,JTIME,1))
!
ENDDO
!
diff --git a/src/SURFEX/pgd_teb_irrig.F90 b/src/SURFEX/pgd_teb_irrig.F90
index b849fc65244bb3617c0e8ee18923986297652618..d0205cd5ef5100aec067ee9b7d9aef4a4e6a2131 100644
--- a/src/SURFEX/pgd_teb_irrig.F90
+++ b/src/SURFEX/pgd_teb_irrig.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PGD_TEB_IRRIG (DTCO, UG, U, USS, TG, TIR, &
- HPROGRAM)
+ SUBROUTINE PGD_TEB_IRRIG (DTCO, UG, U, USS, KDIM, TIR, HPROGRAM)
! ##############################################################
!
!!**** *PGD_TEB_IRRIG* monitor for averaging and interpolations of cover fractions
@@ -45,8 +44,7 @@
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
+USE MODD_SSO_n, ONLY : SSO_t
USE MODD_TEB_IRRIG_n, ONLY : TEB_IRRIG_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -74,8 +72,8 @@ IMPLICIT NONE
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
+TYPE(SSO_t), INTENT(INOUT) :: USS
+INTEGER, INTENT(IN) :: KDIM
TYPE(TEB_IRRIG_t), INTENT(INOUT) :: TIR
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
@@ -222,37 +220,37 @@ XUNIF_RD_START_HOUR = XUNDEF
XUNIF_RD_END_HOUR = XUNDEF
XUNIF_RD_24H_IRRIG = XUNDEF
!
- CFNAM_GD_START_MONTH = ' '
- CFNAM_GD_END_MONTH = ' '
- CFNAM_GD_START_HOUR = ' '
- CFNAM_GD_END_HOUR = ' '
- CFNAM_GD_24H_IRRIG = ' '
- CFNAM_GR_START_MONTH = ' '
- CFNAM_GR_END_MONTH = ' '
- CFNAM_GR_START_HOUR = ' '
- CFNAM_GR_END_HOUR = ' '
- CFNAM_GR_24H_IRRIG = ' '
- CFNAM_RD_START_MONTH = ' '
- CFNAM_RD_END_MONTH = ' '
- CFNAM_RD_START_HOUR = ' '
- CFNAM_RD_END_HOUR = ' '
- CFNAM_RD_24H_IRRIG = ' '
-!
- CFTYP_GD_START_MONTH = ' '
- CFTYP_GD_END_MONTH = ' '
- CFTYP_GD_START_HOUR = ' '
- CFTYP_GD_END_HOUR = ' '
- CFTYP_GD_24H_IRRIG = ' '
- CFTYP_GR_START_MONTH = ' '
- CFTYP_GR_END_MONTH = ' '
- CFTYP_GR_START_HOUR = ' '
- CFTYP_GR_END_HOUR = ' '
- CFTYP_GR_24H_IRRIG = ' '
- CFTYP_RD_START_MONTH = ' '
- CFTYP_RD_END_MONTH = ' '
- CFTYP_RD_START_HOUR = ' '
- CFTYP_RD_END_HOUR = ' '
- CFTYP_RD_24H_IRRIG = ' '
+CFNAM_GD_START_MONTH = ' '
+CFNAM_GD_END_MONTH = ' '
+CFNAM_GD_START_HOUR = ' '
+CFNAM_GD_END_HOUR = ' '
+CFNAM_GD_24H_IRRIG = ' '
+CFNAM_GR_START_MONTH = ' '
+CFNAM_GR_END_MONTH = ' '
+CFNAM_GR_START_HOUR = ' '
+CFNAM_GR_END_HOUR = ' '
+CFNAM_GR_24H_IRRIG = ' '
+CFNAM_RD_START_MONTH = ' '
+CFNAM_RD_END_MONTH = ' '
+CFNAM_RD_START_HOUR = ' '
+CFNAM_RD_END_HOUR = ' '
+CFNAM_RD_24H_IRRIG = ' '
+!
+CFTYP_GD_START_MONTH = ' '
+CFTYP_GD_END_MONTH = ' '
+CFTYP_GD_START_HOUR = ' '
+CFTYP_GD_END_HOUR = ' '
+CFTYP_GD_24H_IRRIG = ' '
+CFTYP_GR_START_MONTH = ' '
+CFTYP_GR_END_MONTH = ' '
+CFTYP_GR_START_HOUR = ' '
+CFTYP_GR_END_HOUR = ' '
+CFTYP_GR_24H_IRRIG = ' '
+CFTYP_RD_START_MONTH = ' '
+CFTYP_RD_END_MONTH = ' '
+CFTYP_RD_START_HOUR = ' '
+CFTYP_RD_END_HOUR = ' '
+CFTYP_RD_24H_IRRIG = ' '
!-------------------------------------------------------------------------------
!
!* 2. Input file for cover types
@@ -292,18 +290,18 @@ END IF
!-------------------------------------------------------------------------------
IF (TIR%LPAR_GD_IRRIG) THEN
!
-ALLOCATE(TIR%XGD_START_MONTH (TG%NDIM ))
-ALLOCATE(TIR%XGD_END_MONTH (TG%NDIM ))
-ALLOCATE(TIR%XGD_START_HOUR (TG%NDIM ))
-ALLOCATE(TIR%XGD_END_HOUR (TG%NDIM ))
-ALLOCATE(TIR%XGD_24H_IRRIG (TG%NDIM ))
+ALLOCATE(TIR%XGD_START_MONTH (KDIM ))
+ALLOCATE(TIR%XGD_END_MONTH (KDIM ))
+ALLOCATE(TIR%XGD_START_HOUR (KDIM ))
+ALLOCATE(TIR%XGD_END_HOUR (KDIM ))
+ALLOCATE(TIR%XGD_24H_IRRIG (KDIM ))
!
!-------------------------------------------------------------------------------
!
!* 4. Fields are prescribed for gardens
! ---------------------------------
!
- CATYPE = 'MAJ'
+CATYPE = 'MAJ'
!
CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'GD_START_MONTH : start month for irrigation of gardens','TWN',CFNAM_GD_START_MONTH, &
@@ -317,7 +315,7 @@ ALLOCATE(TIR%XGD_24H_IRRIG (TG%NDIM ))
CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'GD_END_HOUR : end HOUR for irrigation of gardens','TWN',CFNAM_GD_END_HOUR , &
CFTYP_GD_END_HOUR ,XUNIF_GD_END_HOUR ,TIR%XGD_END_HOUR (:))
- CATYPE = 'ARI'
+CATYPE = 'ARI'
CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'GD_24H_IRRIG : total irrigation over 24h for gardens','TWN',CFNAM_GD_24H_IRRIG , &
CFTYP_GD_24H_IRRIG ,XUNIF_GD_24H_IRRIG ,TIR%XGD_24H_IRRIG (:))
@@ -350,18 +348,18 @@ END IF
!-------------------------------------------------------------------------------
IF (TIR%LPAR_GR_IRRIG) THEN
!
-ALLOCATE(TIR%XGR_START_MONTH (TG%NDIM ))
-ALLOCATE(TIR%XGR_END_MONTH (TG%NDIM ))
-ALLOCATE(TIR%XGR_START_HOUR (TG%NDIM ))
-ALLOCATE(TIR%XGR_END_HOUR (TG%NDIM ))
-ALLOCATE(TIR%XGR_24H_IRRIG (TG%NDIM ))
+ALLOCATE(TIR%XGR_START_MONTH (KDIM ))
+ALLOCATE(TIR%XGR_END_MONTH (KDIM ))
+ALLOCATE(TIR%XGR_START_HOUR (KDIM ))
+ALLOCATE(TIR%XGR_END_HOUR (KDIM ))
+ALLOCATE(TIR%XGR_24H_IRRIG (KDIM ))
!
!-------------------------------------------------------------------------------
!
!* 6. fields are prescribed for greenroofs
! ------------------------------------
!
- CATYPE = 'MAJ'
+CATYPE = 'MAJ'
!
CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'GR_START_MONTH : start month for irrigation of greenroofs','TWN',CFNAM_GR_START_MONTH, &
@@ -375,7 +373,7 @@ ALLOCATE(TIR%XGR_24H_IRRIG (TG%NDIM ))
CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'GR_END_HOUR : end HOUR for irrigation of greenroofs','TWN',CFNAM_GR_END_HOUR , &
CFTYP_GR_END_HOUR ,XUNIF_GR_END_HOUR ,TIR%XGR_END_HOUR (:))
- CATYPE = 'ARI'
+CATYPE = 'ARI'
CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'GR_24H_IRRIG : total irrigation over 24h for greenroofs','TWN',CFNAM_GR_24H_IRRIG , &
CFTYP_GR_24H_IRRIG ,XUNIF_GR_24H_IRRIG ,TIR%XGR_24H_IRRIG (:))
@@ -407,18 +405,18 @@ END IF
!-------------------------------------------------------------------------------
IF (TIR%LPAR_RD_IRRIG) THEN
!
-ALLOCATE(TIR%XRD_START_MONTH (TG%NDIM ))
-ALLOCATE(TIR%XRD_END_MONTH (TG%NDIM ))
-ALLOCATE(TIR%XRD_START_HOUR (TG%NDIM ))
-ALLOCATE(TIR%XRD_END_HOUR (TG%NDIM ))
-ALLOCATE(TIR%XRD_24H_IRRIG (TG%NDIM ))
+ALLOCATE(TIR%XRD_START_MONTH (KDIM ))
+ALLOCATE(TIR%XRD_END_MONTH (KDIM ))
+ALLOCATE(TIR%XRD_START_HOUR (KDIM ))
+ALLOCATE(TIR%XRD_END_HOUR (KDIM ))
+ALLOCATE(TIR%XRD_24H_IRRIG (KDIM ))
!
!-------------------------------------------------------------------------------
!
!* 8. fields are prescribed for roads
! -------------------------------
!
- CATYPE = 'MAJ'
+CATYPE = 'MAJ'
!
CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'RD_START_MONTH : start month for irrigation of roads','TWN',CFNAM_RD_START_MONTH, &
@@ -432,7 +430,7 @@ ALLOCATE(TIR%XRD_24H_IRRIG (TG%NDIM ))
CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'RD_END_HOUR : end HOUR for irrigation of roads','TWN',CFNAM_RD_END_HOUR , &
CFTYP_RD_END_HOUR ,XUNIF_RD_END_HOUR ,TIR%XRD_END_HOUR (:))
- CATYPE = 'ARI'
+CATYPE = 'ARI'
CALL PGD_FIELD(DTCO, UG, U, USS, &
HPROGRAM,'RD_24H_IRRIG : total irrigation over 24h for roads','TWN',CFNAM_RD_24H_IRRIG , &
CFTYP_RD_24H_IRRIG ,XUNIF_RD_24H_IRRIG ,TIR%XRD_24H_IRRIG (:))
diff --git a/src/SURFEX/pgd_teb_par.F90 b/src/SURFEX/pgd_teb_par.F90
index b286095bae93244a029f926cd22248e26c15356a..060abee018cc1b150deafacb28e51019426d11d5 100644
--- a/src/SURFEX/pgd_teb_par.F90
+++ b/src/SURFEX/pgd_teb_par.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PGD_TEB_PAR (DTCO, DGU, UG, U, USS, BDD, DTT, DTI, TG, &
+ SUBROUTINE PGD_TEB_PAR (DTCO, UG, U, USS, BDD, DTT, KDIM, &
HPROGRAM,OGARDEN,OGREENROOF,HBLD_ATYPE)
! ##############################################################
!
@@ -48,14 +48,11 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
USE MODD_BLD_DESCRIPTION_n, ONLY : BLD_DESC_t
USE MODD_DATA_TEB_n, ONLY : DATA_TEB_t
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
!
@@ -83,14 +80,13 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
TYPE(BLD_DESC_t), INTENT(INOUT) :: BDD
TYPE(DATA_TEB_t), INTENT(INOUT) :: DTT
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
+!
+INTEGER, INTENT(IN) :: KDIM
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
LOGICAL, INTENT(IN) :: OGARDEN ! T if urban green areas
@@ -105,7 +101,7 @@ INTEGER :: ILUOUT ! output listing logical unit
INTEGER :: ILUNAM ! namelist file logical unit
LOGICAL :: GFOUND ! true if namelist is found
!
-REAL, DIMENSION(TG%NDIM) :: ZWORK
+REAL, DIMENSION(KDIM) :: ZWORK
REAL :: ZUNIF ! temporary variable
!
!* 0.3 Declaration of namelists
@@ -314,7 +310,7 @@ IF (LHOOK) CALL DR_HOOK('PGD_TEB_PAR',0,ZHOOK_HANDLE)
NPAR_ROOF_LAYER=0
NPAR_ROAD_LAYER=0
NPAR_WALL_LAYER=0
- CBLD_ATYPE ='MAJ'
+CBLD_ATYPE ='MAJ'
NUNIF_BLDTYPE = NUNDEF
NUNIF_BLD_AGE = NUNDEF
NUNIF_USETYPE = NUNDEF
@@ -352,85 +348,85 @@ XUNIF_ALB_PANEL = XUNDEF
XUNIF_EFF_PANEL = XUNDEF
XUNIF_FRAC_PANEL = XUNDEF
- CFNAM_BLDTYPE = ' '
- CFNAM_BLD_AGE = ' '
- CFNAM_USETYPE = ' '
- CCSVDATAFILE =' '
- CFNAM_BLD = ' '
- CFNAM_BLD_HEIGHT = ' '
- CFNAM_WALL_O_HOR = ' '
- CFNAM_Z0_TOWN = ' '
+CFNAM_BLDTYPE = ' '
+CFNAM_BLD_AGE = ' '
+CFNAM_USETYPE = ' '
+CCSVDATAFILE =' '
+CFNAM_BLD = ' '
+CFNAM_BLD_HEIGHT = ' '
+CFNAM_WALL_O_HOR = ' '
+CFNAM_Z0_TOWN = ' '
- CFNAM_ALB_ROOF (:) = ' '
- CFNAM_EMIS_ROOF(:) = ' '
- CFNAM_HC_ROOF (:) = ' '
- CFNAM_TC_ROOF (:) = ' '
- CFNAM_D_ROOF (:) = ' '
- CFNAM_ROUGH_ROOF(:) = ' '
- CFNAM_ROUGH_WALL(:) = ' '
- CFNAM_RESIDENTIAL(:)= ' '
- CFNAM_ALB_ROAD (:) = ' '
- CFNAM_EMIS_ROAD(:) = ' '
- CFNAM_HC_ROAD (:) = ' '
- CFNAM_TC_ROAD (:) = ' '
- CFNAM_D_ROAD (:) = ' '
- CFNAM_ALB_WALL (:) = ' '
- CFNAM_EMIS_WALL(:) = ' '
- CFNAM_HC_WALL (:) = ' '
- CFNAM_TC_WALL (:) = ' '
- CFNAM_D_WALL (:) = ' '
+CFNAM_ALB_ROOF (:) = ' '
+CFNAM_EMIS_ROOF(:) = ' '
+CFNAM_HC_ROOF (:) = ' '
+CFNAM_TC_ROOF (:) = ' '
+CFNAM_D_ROOF (:) = ' '
+CFNAM_ROUGH_ROOF(:) = ' '
+CFNAM_ROUGH_WALL(:) = ' '
+CFNAM_RESIDENTIAL(:)= ' '
+CFNAM_ALB_ROAD (:) = ' '
+CFNAM_EMIS_ROAD(:) = ' '
+CFNAM_HC_ROAD (:) = ' '
+CFNAM_TC_ROAD (:) = ' '
+CFNAM_D_ROAD (:) = ' '
+CFNAM_ALB_WALL (:) = ' '
+CFNAM_EMIS_WALL(:) = ' '
+CFNAM_HC_WALL (:) = ' '
+CFNAM_TC_WALL (:) = ' '
+CFNAM_D_WALL (:) = ' '
- CFNAM_H_TRAFFIC = ' '
- CFNAM_LE_TRAFFIC = ' '
- CFNAM_H_INDUSTRY = ' '
- CFNAM_LE_INDUSTRY = ' '
+CFNAM_H_TRAFFIC = ' '
+CFNAM_LE_TRAFFIC = ' '
+CFNAM_H_INDUSTRY = ' '
+CFNAM_LE_INDUSTRY = ' '
- CFNAM_GARDEN = ' '
- CFNAM_GREENROOF = ' '
- CFNAM_ROAD_DIR = ' '
+CFNAM_GARDEN = ' '
+CFNAM_GREENROOF = ' '
+CFNAM_ROAD_DIR = ' '
- CFNAM_EMIS_PANEL = ' '
- CFNAM_ALB_PANEL = ' '
- CFNAM_EFF_PANEL = ' '
- CFNAM_FRAC_PANEL = ' '
+CFNAM_EMIS_PANEL = ' '
+CFNAM_ALB_PANEL = ' '
+CFNAM_EFF_PANEL = ' '
+CFNAM_FRAC_PANEL = ' '
- CFTYP_BLDTYPE = ' '
- CFTYP_BLD_AGE = ' '
- CFTYP_USETYPE = ' '
- CFTYP_BLD = ' '
- CFTYP_BLD_HEIGHT = ' '
- CFTYP_WALL_O_HOR = ' '
- CFTYP_Z0_TOWN = ' '
- CFTYP_ALB_ROOF(:) = ' '
- CFTYP_EMIS_ROOF(:) = ' '
- CFTYP_HC_ROOF(:) = ' '
- CFTYP_TC_ROOF(:) = ' '
- CFTYP_D_ROOF(:) = ' '
- CFTYP_ROUGH_ROOF(:) = ' '
- CFTYP_ROUGH_WALL(:) = ' '
- CFTYP_RESIDENTIAL(:) = ' '
- CFTYP_ALB_ROAD(:) = ' '
- CFTYP_EMIS_ROAD(:) = ' '
- CFTYP_HC_ROAD(:) = ' '
- CFTYP_TC_ROAD(:) = ' '
- CFTYP_D_ROAD(:) = ' '
- CFTYP_ALB_WALL(:) = ' '
- CFTYP_EMIS_WALL(:) = ' '
- CFTYP_HC_WALL(:) = ' '
- CFTYP_TC_WALL(:) = ' '
- CFTYP_D_WALL(:) = ' '
- CFTYP_H_TRAFFIC = ' '
- CFTYP_LE_TRAFFIC = ' '
- CFTYP_H_INDUSTRY = ' '
- CFTYP_LE_INDUSTRY = ' '
- CFTYP_GARDEN = ' '
- CFTYP_GREENROOF = ' '
- CFTYP_ROAD_DIR = ' '
-!
- CFTYP_EMIS_PANEL = ' '
- CFTYP_ALB_PANEL = ' '
- CFTYP_EFF_PANEL = ' '
- CFTYP_FRAC_PANEL = ' '
+CFTYP_BLDTYPE = ' '
+CFTYP_BLD_AGE = ' '
+CFTYP_USETYPE = ' '
+CFTYP_BLD = ' '
+CFTYP_BLD_HEIGHT = ' '
+CFTYP_WALL_O_HOR = ' '
+CFTYP_Z0_TOWN = ' '
+CFTYP_ALB_ROOF(:) = ' '
+CFTYP_EMIS_ROOF(:) = ' '
+CFTYP_HC_ROOF(:) = ' '
+CFTYP_TC_ROOF(:) = ' '
+CFTYP_D_ROOF(:) = ' '
+CFTYP_ROUGH_ROOF(:) = ' '
+CFTYP_ROUGH_WALL(:) = ' '
+CFTYP_RESIDENTIAL(:) = ' '
+CFTYP_ALB_ROAD(:) = ' '
+CFTYP_EMIS_ROAD(:) = ' '
+CFTYP_HC_ROAD(:) = ' '
+CFTYP_TC_ROAD(:) = ' '
+CFTYP_D_ROAD(:) = ' '
+CFTYP_ALB_WALL(:) = ' '
+CFTYP_EMIS_WALL(:) = ' '
+CFTYP_HC_WALL(:) = ' '
+CFTYP_TC_WALL(:) = ' '
+CFTYP_D_WALL(:) = ' '
+CFTYP_H_TRAFFIC = ' '
+CFTYP_LE_TRAFFIC = ' '
+CFTYP_H_INDUSTRY = ' '
+CFTYP_LE_INDUSTRY = ' '
+CFTYP_GARDEN = ' '
+CFTYP_GREENROOF = ' '
+CFTYP_ROAD_DIR = ' '
+!
+CFTYP_EMIS_PANEL = ' '
+CFTYP_ALB_PANEL = ' '
+CFTYP_EFF_PANEL = ' '
+CFTYP_FRAC_PANEL = ' '
!
!-------------------------------------------------------------------------------
!
@@ -477,47 +473,6 @@ IF (( ANY(XUNIF_HC_WALL/=XUNDEF) .OR. ANY(LEN_TRIM(CFNAM_HC_WALL)>0) &
CALL ABOR1_SFX('In order to initialize WALL thermal quantities, please specify NPAR_WALL_LAYER in namelist NAM_DATA_TEB')
END IF
!-------------------------------------------------------------------------------
-ALLOCATE(DTT%NPAR_BLDTYPE (TG%NDIM))
-ALLOCATE(DTT%NPAR_BLD_AGE (TG%NDIM))
-ALLOCATE(DTT%NPAR_BLDCODE (TG%NDIM))
-ALLOCATE(DTT%NPAR_USETYPE (TG%NDIM))
-ALLOCATE(DTT%XPAR_Z0_TOWN (TG%NDIM))
-ALLOCATE(DTT%XPAR_ALB_ROOF (TG%NDIM))
-ALLOCATE(DTT%XPAR_EMIS_ROOF (TG%NDIM))
-ALLOCATE(DTT%XPAR_ALB_ROAD (TG%NDIM))
-ALLOCATE(DTT%XPAR_EMIS_ROAD (TG%NDIM))
-ALLOCATE(DTT%XPAR_ALB_WALL (TG%NDIM))
-ALLOCATE(DTT%XPAR_EMIS_WALL (TG%NDIM))
-ALLOCATE(DTT%XPAR_BLD (TG%NDIM))
-ALLOCATE(DTT%XPAR_BLD_HEIGHT (TG%NDIM))
-ALLOCATE(DTT%XPAR_WALL_O_HOR (TG%NDIM))
-ALLOCATE(DTT%XPAR_H_TRAFFIC (TG%NDIM))
-ALLOCATE(DTT%XPAR_LE_TRAFFIC (TG%NDIM))
-ALLOCATE(DTT%XPAR_H_INDUSTRY (TG%NDIM))
-ALLOCATE(DTT%XPAR_LE_INDUSTRY (TG%NDIM))
-ALLOCATE(DTT%XPAR_GARDEN (TG%NDIM))
-ALLOCATE(DTT%XPAR_GREENROOF (TG%NDIM))
-ALLOCATE(DTT%XPAR_ROAD_DIR (TG%NDIM))
-!
-ALLOCATE(DTT%XPAR_HC_ROOF (TG%NDIM,NPAR_ROOF_LAYER))
-ALLOCATE(DTT%XPAR_TC_ROOF (TG%NDIM,NPAR_ROOF_LAYER))
-ALLOCATE(DTT%XPAR_D_ROOF (TG%NDIM,NPAR_ROOF_LAYER))
-ALLOCATE(DTT%XPAR_HC_ROAD (TG%NDIM,NPAR_ROAD_LAYER))
-ALLOCATE(DTT%XPAR_TC_ROAD (TG%NDIM,NPAR_ROAD_LAYER))
-ALLOCATE(DTT%XPAR_D_ROAD (TG%NDIM,NPAR_ROAD_LAYER))
-ALLOCATE(DTT%XPAR_HC_WALL (TG%NDIM,NPAR_WALL_LAYER))
-ALLOCATE(DTT%XPAR_TC_WALL (TG%NDIM,NPAR_WALL_LAYER))
-ALLOCATE(DTT%XPAR_D_WALL (TG%NDIM,NPAR_WALL_LAYER))
-ALLOCATE(DTT%XPAR_ROUGH_ROOF (TG%NDIM))
-ALLOCATE(DTT%XPAR_ROUGH_WALL (TG%NDIM))
-ALLOCATE(DTT%XPAR_RESIDENTIAL (TG%NDIM))
-!
-ALLOCATE(DTT%XPAR_EMIS_PANEL (TG%NDIM))
-ALLOCATE(DTT%XPAR_ALB_PANEL (TG%NDIM))
-ALLOCATE(DTT%XPAR_EFF_PANEL (TG%NDIM))
-ALLOCATE(DTT%XPAR_FRAC_PANEL (TG%NDIM))
-!
-!-------------------------------------------------------------------------------
IF (NROOF_MAX < NPAR_ROOF_LAYER) THEN
WRITE(ILUOUT,*) '---------------------------------------------'
WRITE(ILUOUT,*) 'Please update pgd_teb_par.f90 routine : '
@@ -556,9 +511,9 @@ ENDIF
!* building's type
ZUNIF = XUNDEF
IF (NUNIF_BLDTYPE/=NUNDEF) ZUNIF=FLOAT(NUNIF_BLDTYPE)
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
- HPROGRAM,'MAJ','BLDTYPE ','TWN', CFNAM_BLDTYPE,CFTYP_BLDTYPE,ZUNIF,&
- ZWORK(:),DTT%LDATA_BLDTYPE )
+ALLOCATE(DTT%NPAR_BLDTYPE (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, HPROGRAM,'MAJ','BLDTYPE ','TWN', &
+ CFNAM_BLDTYPE,CFTYP_BLDTYPE,ZUNIF,ZWORK(:),DTT%LDATA_BLDTYPE )
IF (.NOT. DTT%LDATA_BLDTYPE) THEN
DEALLOCATE(DTT%NPAR_BLDTYPE)
ELSE
@@ -568,9 +523,9 @@ END IF
!* building's age
ZUNIF = XUNDEF
IF (NUNIF_BLD_AGE/=NUNDEF) ZUNIF=FLOAT(NUNIF_BLD_AGE)
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
- HPROGRAM,'ARI','BLD_AGE ','TWN', CFNAM_BLD_AGE,CFTYP_BLD_AGE,ZUNIF,&
- ZWORK(:),DTT%LDATA_BLD_AGE )
+ALLOCATE(DTT%NPAR_BLD_AGE (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, HPROGRAM,'ARI','BLD_AGE ','TWN', &
+ CFNAM_BLD_AGE,CFTYP_BLD_AGE,ZUNIF,ZWORK(:),DTT%LDATA_BLD_AGE )
IF (.NOT. DTT%LDATA_BLD_AGE) THEN
DEALLOCATE(DTT%NPAR_BLD_AGE)
ELSE
@@ -600,148 +555,168 @@ END IF
!* building's use
ZUNIF = XUNDEF
IF (NUNIF_USETYPE/=NUNDEF) ZUNIF=FLOAT(NUNIF_USETYPE)
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
- HPROGRAM,'MAJ','USETYPE ','TWN', CFNAM_USETYPE,CFTYP_USETYPE,ZUNIF,&
- ZWORK(:),DTT%LDATA_USETYPE )
+ALLOCATE(DTT%NPAR_USETYPE (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, HPROGRAM,'MAJ','USETYPE ','TWN', &
+ CFNAM_USETYPE,CFTYP_USETYPE,ZUNIF,ZWORK(:),DTT%LDATA_USETYPE )
IF (.NOT. DTT%LDATA_USETYPE) THEN
DEALLOCATE(DTT%NPAR_USETYPE)
ELSE
DTT%NPAR_USETYPE = NINT(ZWORK)
END IF
!
-IF (DTT%LDATA_BLDTYPE .OR. DTT%LDATA_BLD_AGE .OR. DTT%LDATA_USETYPE) CALL READ_CSVDATA_TEB(BDD, &
- HPROGRAM,CCSVDATAFILE)
+IF (DTT%LDATA_BLDTYPE .OR. DTT%LDATA_BLD_AGE .OR. DTT%LDATA_USETYPE) &
+ CALL READ_CSVDATA_TEB(BDD, HPROGRAM,CCSVDATAFILE)
!
!* building's code
-IF (ASSOCIATED(DTT%NPAR_BLDTYPE)) DTT%NPAR_BLDCODE(:) = BLDCODE(BDD, DTT%NPAR_BLDTYPE,DTT%NPAR_BLD_AGE)
+IF (ASSOCIATED(DTT%NPAR_BLDTYPE)) THEN
+ ALLOCATE(DTT%NPAR_BLDCODE (KDIM))
+ DTT%NPAR_BLDCODE(:) = BLDCODE(BDD, DTT%NPAR_BLDTYPE,DTT%NPAR_BLD_AGE)
+ENDIF
!
!
!* other building parameters
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
- HPROGRAM,'ARI','BLD ','TWN', CFNAM_BLD,CFTYP_BLD,XUNIF_BLD,DTT%XPAR_BLD,DTT%LDATA_BLD )
+ALLOCATE(DTT%XPAR_BLD (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, HPROGRAM,'ARI','BLD ','TWN', &
+ CFNAM_BLD,CFTYP_BLD,XUNIF_BLD,DTT%XPAR_BLD,DTT%LDATA_BLD )
IF (.NOT.DTT%LDATA_BLD) DEALLOCATE(DTT%XPAR_BLD)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
- HPROGRAM,'ARI','BLD_HEIGHT ','TWN',CFNAM_BLD_HEIGHT,CFTYP_BLD_HEIGHT,XUNIF_BLD_HEIGHT,&
+ALLOCATE(DTT%XPAR_BLD_HEIGHT (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, HPROGRAM,'ARI','BLD_HEIGHT ','TWN',&
+ CFNAM_BLD_HEIGHT,CFTYP_BLD_HEIGHT,XUNIF_BLD_HEIGHT,&
DTT%XPAR_BLD_HEIGHT,DTT%LDATA_BLD_HEIGHT)
IF (.NOT.DTT%LDATA_BLD_HEIGHT) DEALLOCATE(DTT%XPAR_BLD_HEIGHT)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
- HPROGRAM,'ARI','WALL_O_HOR ','TWN',CFNAM_WALL_O_HOR,CFTYP_WALL_O_HOR,XUNIF_WALL_O_HOR,&
- DTT%XPAR_WALL_O_HOR,DTT%LDATA_WALL_O_HOR)
+ALLOCATE(DTT%XPAR_WALL_O_HOR (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, HPROGRAM,'ARI','WALL_O_HOR ','TWN',&
+ CFNAM_WALL_O_HOR,CFTYP_WALL_O_HOR,XUNIF_WALL_O_HOR,DTT%XPAR_WALL_O_HOR,DTT%LDATA_WALL_O_HOR)
IF (.NOT.DTT%LDATA_WALL_O_HOR) DEALLOCATE(DTT%XPAR_WALL_O_HOR)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
- HPROGRAM,'CDN','Z0_TOWN ','TWN',CFNAM_Z0_TOWN,CFTYP_Z0_TOWN,XUNIF_Z0_TOWN,&
- DTT%XPAR_Z0_TOWN,DTT%LDATA_Z0_TOWN)
+ALLOCATE(DTT%XPAR_Z0_TOWN (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, HPROGRAM,'CDN','Z0_TOWN ','TWN',&
+ CFNAM_Z0_TOWN,CFTYP_Z0_TOWN,XUNIF_Z0_TOWN,DTT%XPAR_Z0_TOWN,DTT%LDATA_Z0_TOWN)
IF (.NOT.DTT%LDATA_Z0_TOWN) DEALLOCATE(DTT%XPAR_Z0_TOWN)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
- HPROGRAM,CBLD_ATYPE,'ALB_ROOF ','TWN',CFNAM_ALB_ROOF,CFTYP_ALB_ROOF,XUNIF_ALB_ROOF ,&
- DTT%XPAR_ALB_ROOF,DTT%LDATA_ALB_ROOF)
+ALLOCATE(DTT%XPAR_ALB_ROOF (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, HPROGRAM,CBLD_ATYPE,'ALB_ROOF ','TWN',&
+ CFNAM_ALB_ROOF,CFTYP_ALB_ROOF,XUNIF_ALB_ROOF ,DTT%XPAR_ALB_ROOF,DTT%LDATA_ALB_ROOF)
IF (.NOT.DTT%LDATA_ALB_ROOF) DEALLOCATE(DTT%XPAR_ALB_ROOF)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
- HPROGRAM,CBLD_ATYPE,'EMIS_ROOF ','TWN',CFNAM_EMIS_ROOF,CFTYP_EMIS_ROOF,XUNIF_EMIS_ROOF ,&
- DTT%XPAR_EMIS_ROOF,DTT%LDATA_EMIS_ROOF)
+ALLOCATE(DTT%XPAR_EMIS_ROOF (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, HPROGRAM,CBLD_ATYPE,'EMIS_ROOF ','TWN',&
+ CFNAM_EMIS_ROOF,CFTYP_EMIS_ROOF,XUNIF_EMIS_ROOF ,DTT%XPAR_EMIS_ROOF,DTT%LDATA_EMIS_ROOF)
IF (.NOT.DTT%LDATA_EMIS_ROOF) DEALLOCATE(DTT%XPAR_EMIS_ROOF)
!
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,CBLD_ATYPE,'HC_ROOF ','TWN',CFNAM_HC_ROOF,CFTYP_HC_ROOF, &
- XUNIF_HC_ROOF,DTT%XPAR_HC_ROOF,DTT%LDATA_HC_ROOF )
+ALLOCATE(DTT%XPAR_HC_ROOF (KDIM,NPAR_ROOF_LAYER))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, HPROGRAM,CBLD_ATYPE,'HC_ROOF ','TWN',&
+ CFNAM_HC_ROOF,CFTYP_HC_ROOF, XUNIF_HC_ROOF,DTT%XPAR_HC_ROOF,DTT%LDATA_HC_ROOF )
IF (.NOT.DTT%LDATA_HC_ROOF) DEALLOCATE(DTT%XPAR_HC_ROOF)
!
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,CBLD_ATYPE,'TC_ROOF ','TWN',CFNAM_TC_ROOF,CFTYP_TC_ROOF, &
- XUNIF_TC_ROOF ,DTT%XPAR_TC_ROOF, DTT%LDATA_TC_ROOF )
+ALLOCATE(DTT%XPAR_TC_ROOF (KDIM,NPAR_ROOF_LAYER))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, HPROGRAM,CBLD_ATYPE,'TC_ROOF ','TWN',&
+ CFNAM_TC_ROOF,CFTYP_TC_ROOF, XUNIF_TC_ROOF ,DTT%XPAR_TC_ROOF, DTT%LDATA_TC_ROOF )
IF (.NOT.DTT%LDATA_TC_ROOF) DEALLOCATE(DTT%XPAR_TC_ROOF)
!
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
- HPROGRAM,CBLD_ATYPE,'D_ROOF ','TWN',CFNAM_D_ROOF,CFTYP_D_ROOF, &
- XUNIF_D_ROOF ,DTT%XPAR_D_ROOF , DTT%LDATA_D_ROOF )
+ALLOCATE(DTT%XPAR_D_ROOF (KDIM,NPAR_ROOF_LAYER))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, HPROGRAM,CBLD_ATYPE,'D_ROOF ','TWN',&
+ CFNAM_D_ROOF,CFTYP_D_ROOF, XUNIF_D_ROOF ,DTT%XPAR_D_ROOF , DTT%LDATA_D_ROOF )
IF (.NOT.DTT%LDATA_D_ROOF) DEALLOCATE(DTT%XPAR_D_ROOF)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
- HPROGRAM,'ARI','ALB_ROAD ','TWN',CFNAM_ALB_ROAD ,CFTYP_ALB_ROAD ,XUNIF_ALB_ROAD ,&
- DTT%XPAR_ALB_ROAD, DTT%LDATA_ALB_ROAD )
+ALLOCATE(DTT%XPAR_ALB_ROAD (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, HPROGRAM,'ARI','ALB_ROAD ','TWN',&
+ CFNAM_ALB_ROAD ,CFTYP_ALB_ROAD ,XUNIF_ALB_ROAD ,DTT%XPAR_ALB_ROAD, DTT%LDATA_ALB_ROAD )
IF (.NOT.DTT%LDATA_ALB_ROAD) DEALLOCATE(DTT%XPAR_ALB_ROAD)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
- HPROGRAM,'ARI','EMIS_ROAD ','TWN',CFNAM_EMIS_ROAD ,CFTYP_EMIS_ROAD ,XUNIF_EMIS_ROAD ,&
- DTT%XPAR_EMIS_ROAD, DTT%LDATA_EMIS_ROAD )
+ALLOCATE(DTT%XPAR_EMIS_ROAD (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, HPROGRAM,'ARI','EMIS_ROAD ','TWN',&
+ CFNAM_EMIS_ROAD ,CFTYP_EMIS_ROAD ,XUNIF_EMIS_ROAD ,DTT%XPAR_EMIS_ROAD, DTT%LDATA_EMIS_ROAD )
IF (.NOT.DTT%LDATA_EMIS_ROAD) DEALLOCATE(DTT%XPAR_EMIS_ROAD)
!
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
+ALLOCATE(DTT%XPAR_HC_ROAD (KDIM,NPAR_ROAD_LAYER))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, &
HPROGRAM,CBLD_ATYPE,'HC_ROAD ','TWN',CFNAM_HC_ROAD ,CFTYP_HC_ROAD , &
XUNIF_HC_ROAD ,DTT%XPAR_HC_ROAD, DTT%LDATA_HC_ROAD )
IF (.NOT.DTT%LDATA_HC_ROAD) DEALLOCATE(DTT%XPAR_HC_ROAD)
!
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
+ALLOCATE(DTT%XPAR_TC_ROAD (KDIM,NPAR_ROAD_LAYER))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, &
HPROGRAM,CBLD_ATYPE,'TC_ROAD ','TWN',CFNAM_TC_ROAD ,CFTYP_TC_ROAD , &
XUNIF_TC_ROAD ,DTT%XPAR_TC_ROAD, DTT%LDATA_TC_ROAD )
IF (.NOT.DTT%LDATA_TC_ROAD) DEALLOCATE(DTT%XPAR_TC_ROAD)
!
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
+ALLOCATE(DTT%XPAR_D_ROAD (KDIM,NPAR_ROAD_LAYER))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, &
HPROGRAM,'ARI','D_ROAD ','TWN',CFNAM_D_ROAD ,CFTYP_D_ROAD , &
XUNIF_D_ROAD ,DTT%XPAR_D_ROAD , DTT%LDATA_D_ROAD )
IF (.NOT.DTT%LDATA_D_ROAD) DEALLOCATE(DTT%XPAR_D_ROAD)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTT%XPAR_ALB_WALL (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,CBLD_ATYPE,'ALB_WALL ','TWN',CFNAM_ALB_WALL ,CFTYP_ALB_WALL ,XUNIF_ALB_WALL ,&
DTT%XPAR_ALB_WALL, DTT%LDATA_ALB_WALL )
IF (.NOT.DTT%LDATA_ALB_WALL) DEALLOCATE(DTT%XPAR_ALB_WALL)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTT%XPAR_EMIS_WALL (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,CBLD_ATYPE,'EMIS_WALL ','TWN',CFNAM_EMIS_WALL ,CFTYP_EMIS_WALL ,XUNIF_EMIS_WALL ,&
DTT%XPAR_EMIS_WALL, DTT%LDATA_EMIS_WALL )
IF (.NOT.DTT%LDATA_EMIS_WALL) DEALLOCATE(DTT%XPAR_EMIS_WALL)
!
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
+ALLOCATE(DTT%XPAR_HC_WALL (KDIM,NPAR_WALL_LAYER))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, &
HPROGRAM,CBLD_ATYPE,'HC_WALL ','TWN',CFNAM_HC_WALL ,CFTYP_HC_WALL , &
XUNIF_HC_WALL ,DTT%XPAR_HC_WALL, DTT%LDATA_HC_WALL )
IF (.NOT.DTT%LDATA_HC_WALL) DEALLOCATE(DTT%XPAR_HC_WALL)
!
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
+ALLOCATE(DTT%XPAR_TC_WALL (KDIM,NPAR_WALL_LAYER))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, &
HPROGRAM,CBLD_ATYPE,'TC_WALL ','TWN',CFNAM_TC_WALL ,CFTYP_TC_WALL , &
XUNIF_TC_WALL ,DTT%XPAR_TC_WALL, DTT%LDATA_TC_WALL )
IF (.NOT.DTT%LDATA_TC_WALL) DEALLOCATE(DTT%XPAR_TC_WALL)
!
- CALL INI_VAR_FROM_DATA(DTCO, DGU, UG, U, USS, DTI, &
+ALLOCATE(DTT%XPAR_D_WALL (KDIM,NPAR_WALL_LAYER))
+CALL INI_VAR_FROM_DATA(DTCO, UG, U, USS, &
HPROGRAM,CBLD_ATYPE,'D_WALL ','TWN',CFNAM_D_WALL ,CFTYP_D_WALL , &
XUNIF_D_WALL ,DTT%XPAR_D_WALL , DTT%LDATA_D_WALL )
IF (.NOT.DTT%LDATA_D_WALL) DEALLOCATE(DTT%XPAR_D_WALL)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTT%XPAR_H_TRAFFIC (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','H_TRAFFIC ','TWN',CFNAM_H_TRAFFIC ,CFTYP_H_TRAFFIC ,XUNIF_H_TRAFFIC ,&
DTT%XPAR_H_TRAFFIC, DTT%LDATA_H_TRAFFIC )
IF (.NOT.DTT%LDATA_H_TRAFFIC) DEALLOCATE(DTT%XPAR_H_TRAFFIC)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTT%XPAR_LE_TRAFFIC (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','LE_TRAFFIC ','TWN',CFNAM_LE_TRAFFIC ,CFTYP_LE_TRAFFIC ,XUNIF_LE_TRAFFIC ,&
DTT%XPAR_LE_TRAFFIC, DTT%LDATA_LE_TRAFFIC )
IF (.NOT.DTT%LDATA_LE_TRAFFIC) DEALLOCATE(DTT%XPAR_LE_TRAFFIC)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTT%XPAR_H_INDUSTRY (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','H_INDUSTRY ','TWN',CFNAM_H_INDUSTRY ,CFTYP_H_INDUSTRY ,XUNIF_H_INDUSTRY ,&
DTT%XPAR_H_INDUSTRY, DTT%LDATA_H_INDUSTRY )
IF (.NOT.DTT%LDATA_H_INDUSTRY) DEALLOCATE(DTT%XPAR_H_INDUSTRY)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTT%XPAR_LE_INDUSTRY (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','LE_INDUSTRY','TWN',CFNAM_LE_INDUSTRY,CFTYP_LE_INDUSTRY,XUNIF_LE_INDUSTRY,&
DTT%XPAR_LE_INDUSTRY, DTT%LDATA_LE_INDUSTRY )
IF (.NOT.DTT%LDATA_LE_INDUSTRY) DEALLOCATE(DTT%XPAR_LE_INDUSTRY)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTT%XPAR_ROUGH_ROOF (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,CBLD_ATYPE,'ROUGH_ROOF','TWN',CFNAM_ROUGH_ROOF,CFTYP_ROUGH_ROOF,XUNIF_ROUGH_ROOF ,&
DTT%XPAR_ROUGH_ROOF,DTT%LDATA_ROUGH_ROOF)
IF (.NOT.DTT%LDATA_ROUGH_ROOF) DEALLOCATE(DTT%XPAR_ROUGH_ROOF)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTT%XPAR_ROUGH_WALL (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,CBLD_ATYPE,'ROUGH_WALL','TWN',CFNAM_ROUGH_WALL,CFTYP_ROUGH_WALL,XUNIF_ROUGH_WALL ,&
DTT%XPAR_ROUGH_WALL,DTT%LDATA_ROUGH_WALL)
IF (.NOT.DTT%LDATA_ROUGH_WALL) DEALLOCATE(DTT%XPAR_ROUGH_WALL)
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTT%XPAR_RESIDENTIAL (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,CBLD_ATYPE,'RESIDENTIAL','TWN',CFNAM_RESIDENTIAL,CFTYP_RESIDENTIAL,XUNIF_RESIDENTIAL ,&
DTT%XPAR_RESIDENTIAL,DTT%LDATA_RESIDENTIAL)
IF (.NOT.DTT%LDATA_RESIDENTIAL) DEALLOCATE(DTT%XPAR_RESIDENTIAL)
@@ -757,7 +732,8 @@ IF (.NOT.DTT%LDATA_RESIDENTIAL) DEALLOCATE(DTT%XPAR_RESIDENTIAL)
!
!* road directions
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTT%XPAR_ROAD_DIR (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','ROAD_DIR ','TWN',CFNAM_ROAD_DIR ,CFTYP_ROAD_DIR ,XUNIF_ROAD_DIR ,&
DTT%XPAR_ROAD_DIR, DTT%LDATA_ROAD_DIR )
IF (.NOT.DTT%LDATA_ROAD_DIR) DEALLOCATE(DTT%XPAR_ROAD_DIR)
@@ -766,19 +742,23 @@ IF (.NOT.DTT%LDATA_ROAD_DIR) DEALLOCATE(DTT%XPAR_ROAD_DIR)
!
!* solar panels
!
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTT%XPAR_EMIS_PANEL (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','EMIS_PANEL ','BLD',CFNAM_EMIS_PANEL,CFTYP_EMIS_PANEL,XUNIF_EMIS_PANEL,&
DTT%XPAR_EMIS_PANEL, DTT%LDATA_EMIS_PANEL )
IF (.NOT.DTT%LDATA_EMIS_PANEL) DEALLOCATE(DTT%XPAR_EMIS_PANEL)
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTT%XPAR_ALB_PANEL (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','ALB_PANEL ','BLD',CFNAM_ALB_PANEL ,CFTYP_ALB_PANEL ,XUNIF_ALB_PANEL ,&
DTT%XPAR_ALB_PANEL , DTT%LDATA_ALB_PANEL )
IF (.NOT.DTT%LDATA_ALB_PANEL ) DEALLOCATE(DTT%XPAR_ALB_PANEL )
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTT%XPAR_EFF_PANEL (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','EFF_PANEL ','BLD',CFNAM_EFF_PANEL ,CFTYP_EFF_PANEL ,XUNIF_EFF_PANEL ,&
DTT%XPAR_EFF_PANEL , DTT%LDATA_EFF_PANEL )
IF (.NOT.DTT%LDATA_EFF_PANEL ) DEALLOCATE(DTT%XPAR_EFF_PANEL )
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ALLOCATE(DTT%XPAR_FRAC_PANEL (KDIM))
+CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','FRAC_PANEL ','BLD',CFNAM_FRAC_PANEL,CFTYP_FRAC_PANEL,XUNIF_FRAC_PANEL,&
DTT%XPAR_FRAC_PANEL, DTT%LDATA_FRAC_PANEL )
IF (.NOT.DTT%LDATA_FRAC_PANEL) DEALLOCATE(DTT%XPAR_FRAC_PANEL)
@@ -788,7 +768,8 @@ IF (.NOT.DTT%LDATA_FRAC_PANEL) DEALLOCATE(DTT%XPAR_FRAC_PANEL)
!* greenroof fraction
!
IF (OGREENROOF) THEN
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ ALLOCATE(DTT%XPAR_GREENROOF (KDIM))
+ CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,CBLD_ATYPE,'GREENROOF','BLD',CFNAM_GREENROOF,CFTYP_GREENROOF,XUNIF_GREENROOF ,&
DTT%XPAR_GREENROOF,DTT%LDATA_GREENROOF)
IF (.NOT.DTT%LDATA_GREENROOF) DEALLOCATE(DTT%XPAR_GREENROOF)
@@ -813,7 +794,8 @@ END IF
!* gardens
!
IF (OGARDEN) THEN
- CALL INI_VAR_FROM_DATA_0D(DTCO, DGU, UG, U, USS, &
+ ALLOCATE(DTT%XPAR_GARDEN (KDIM))
+ CALL INI_VAR_FROM_DATA_0D(DTCO, UG, U, USS, &
HPROGRAM,'ARI','GARDEN ','TWN',CFNAM_GARDEN ,CFTYP_GARDEN ,XUNIF_GARDEN ,&
DTT%XPAR_GARDEN, DTT%LDATA_GARDEN )
IF (.NOT.DTT%LDATA_GARDEN) DEALLOCATE(DTT%XPAR_GARDEN)
@@ -840,7 +822,7 @@ END IF
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('PGD_TEB_PAR',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
SUBROUTINE COHERENCE_THERMAL_DATA(HTYPE,ODATA_HC,ODATA_TC,ODATA_D)
CHARACTER(LEN=4), INTENT(IN) :: HTYPE
LOGICAL, INTENT(IN) :: ODATA_HC
diff --git a/src/SURFEX/pgd_teb_veg.F90 b/src/SURFEX/pgd_teb_veg.F90
index 0e809a52c5077102c9aa1a27806de4ab453c7d41..448e3324aadfd5ca0a05327a2c4ed37372510470 100644
--- a/src/SURFEX/pgd_teb_veg.F90
+++ b/src/SURFEX/pgd_teb_veg.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PGD_TEB_VEG (DTCO, UG, U, USS, GDM, GRM, TOP, TG, &
- HPROGRAM)
+ SUBROUTINE PGD_TEB_VEG (DTCO, UG, U, USS, GDO, GDK, DTGD, GDIR, &
+ GRO, GRS, GRK, DTGR, TOP, KDIM, HPROGRAM)
! ##############################################################
!
!!**** *PGD_TEB_VEG* monitor for averaging and interpolations of physiographic fields
@@ -39,6 +39,7 @@
!! J.Escobar 11/2013 Add USE MODI_PGD_TEB_GREENROOF
!! V. Masson 04/2014 Adds Irrigation
!! P. Samuelsson 02/2014 Introduced dummy variable in call to READ_NAM_PGD_ISBA for MEB
+!! B. Decharme 08/16 : soil grdi optimization key
!!
!----------------------------------------------------------------------------
!
@@ -49,13 +50,15 @@
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-!
-USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t
-USE MODD_SURFEX_n, ONLY : TEB_GREENROOF_MODEL_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
+!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_TEB_IRRIG_n, ONLY : TEB_IRRIG_t
+!
!
USE MODD_PGD_GRID, ONLY : NL
USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
@@ -71,7 +74,6 @@ USE MODI_TEST_NAM_VAR_SURF
USE MODI_PGD_TEB_GREENROOF
USE MODI_PGD_TEB_GARDEN_PAR
USE MODI_PGD_TEB_IRRIG
-USE MODI_CONVERT_COVER_TEB_VEG
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -87,11 +89,18 @@ IMPLICIT NONE
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
-TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM
+TYPE(SSO_t), INTENT(INOUT) :: USS
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: GDO
+TYPE(ISBA_K_t), INTENT(INOUT) :: GDK
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTGD
+TYPE(TEB_IRRIG_t), INTENT(INOUT) :: GDIR
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: GRO
+TYPE(ISBA_S_t), INTENT(INOUT) :: GRS
+TYPE(ISBA_K_t), INTENT(INOUT) :: GRK
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTGR
TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
+!
+INTEGER, INTENT(IN) :: KDIM
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
! ! F if all parameters must be specified
@@ -112,6 +121,7 @@ INTEGER :: IGROUND_LAYER ! number of soil layers
CHARACTER(LEN=4) :: YPEDOTF ! Pedo-transfert function for DIF
CHARACTER(LEN=3) :: YPHOTO ! photosynthesis option
LOGICAL :: GTR_ML ! new radiative transfert
+ CHARACTER(LEN=4) :: YALBEDO
REAL :: ZRM_PATCH ! threshold to remove little fractions of patches
CHARACTER(LEN=28) :: YSAND ! file name for sand fraction
CHARACTER(LEN=28) :: YCLAY ! file name for clay fraction
@@ -131,26 +141,20 @@ LOGICAL :: LIMP_SAND ! Imposed maps of Sand
LOGICAL :: LIMP_CLAY ! Imposed maps of Clay
LOGICAL :: LIMP_CTI ! Imposed maps of topographic index statistics
REAL, DIMENSION(150) :: ZSOILGRID ! Soil layer thickness for DIF
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDG ! ground layers
-INTEGER, DIMENSION(:,:), ALLOCATABLE :: IWG_LAYER ! number of layers for DIF option
!
! Not used in TEB garden
!
CHARACTER(LEN=28) :: YSOC_TOP ! file name for organic carbon
CHARACTER(LEN=28) :: YSOC_SUB ! file name for organic carbon
CHARACTER(LEN=28) :: YPERM ! file name for permafrost distribution
- CHARACTER(LEN=28) :: YGW ! file name for groundwater map
CHARACTER(LEN=6) :: YSOCFILETYPE ! organic carbon data file type
CHARACTER(LEN=6) :: YPERMFILETYPE ! permafrost distribution data file type
- CHARACTER(LEN=6) :: YGWFILETYPE ! groundwater distribution data file type
REAL :: XUNIF_SOC_TOP ! uniform value of organic carbon top soil (kg/m2)
REAL :: XUNIF_SOC_SUB ! uniform value of organic carbon sub soil (kg/m2)
REAL :: XUNIF_PERM ! uniform permafrost distribution
-REAL :: XUNIF_GW ! uniform groundwater distribution
LOGICAL :: LIMP_SOC ! Imposed maps of organic carbon
LOGICAL :: LIMP_PERM ! Imposed maps of permafrost distribution
LOGICAL :: GMEB ! Multi-energy balance (MEB)
-LOGICAL :: LIMP_GW ! Imposed maps of groundwater distribution
CHARACTER(LEN=28) :: YPH ! file name for pH
CHARACTER(LEN=28) :: YFERT ! file name for fertilisation rate
CHARACTER(LEN=6) :: YPHFILETYPE ! pH data file type
@@ -162,76 +166,73 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PGD_TEB_VEG',0,ZHOOK_HANDLE)
+!
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
-!-------------------------------------------------------------------------------
+!-------------------------------------R-----------------------------------------
!
!* 1. Reading of namelist NAM_ISBA for general options of vegetation
! --------------------------------------------------------------
!
-GDM%TGDO%NGROUND_LAYER = 0
-GDM%TVG%CISBA = ' '
-GDM%TVG%CPEDOTF = ' '
-GDM%TVG%CPHOTO = ' '
-!
- CALL READ_NAM_PGD_ISBA(HPROGRAM, IPATCH, IGROUND_LAYER, &
- YISBA, YPEDOTF, YPHOTO, GTR_ML, ZRM_PATCH, &
+CALL READ_NAM_PGD_ISBA(HPROGRAM, IPATCH, IGROUND_LAYER, &
+ YISBA, YPEDOTF, YPHOTO, GTR_ML, YALBEDO, ZRM_PATCH, &
YCLAY, YCLAYFILETYPE, XUNIF_CLAY, LIMP_CLAY, &
YSAND, YSANDFILETYPE, XUNIF_SAND, LIMP_SAND, &
YSOC_TOP, YSOC_SUB, YSOCFILETYPE, XUNIF_SOC_TOP, &
XUNIF_SOC_SUB, LIMP_SOC, YCTI, YCTIFILETYPE, LIMP_CTI, &
- YPERM, YPERMFILETYPE, XUNIF_PERM, LIMP_PERM, GMEB, &
- YGW, YGWFILETYPE, XUNIF_GW, LIMP_GW, &
+ YPERM, YPERMFILETYPE, XUNIF_PERM, LIMP_PERM, GMEB, &
YRUNOFFB, YRUNOFFBFILETYPE, XUNIF_RUNOFFB, &
YWDRAIN, YWDRAINFILETYPE , XUNIF_WDRAIN, ZSOILGRID, &
YPH, YPHFILETYPE, XUNIF_PH, YFERT, YFERTFILETYPE, &
XUNIF_FERT )
!
-GDM%TGDO%NGROUND_LAYER = IGROUND_LAYER
-GDM%TVG%CISBA = YISBA
-GDM%TVG%CPEDOTF = YPEDOTF
-GDM%TVG%CPHOTO = YPHOTO
-GDM%TVG%LTR_ML = GTR_ML
+GDO%NPATCH = 1
+GDO%NGROUND_LAYER = IGROUND_LAYER
+GDO%CISBA = YISBA
+GDO%CPEDOTF = YPEDOTF
+GDO%CPHOTO = YPHOTO
+GDO%LTR_ML = GTR_ML
+GDO%CALBEDO = YALBEDO
!
!-------------------------------------------------------------------------------
!
!* 2. Coherence of options
! --------------------
!
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CISBA',GDM%TVG%CISBA,'2-L','3-L','DIF')
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CPEDOTF',GDM%TVG%CPEDOTF,'CH78','CO84')
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CPHOTO',GDM%TVG%CPHOTO,'NON','AGS','LAI','AST','LST','NIT','NCB')
+ CALL TEST_NAM_VAR_SURF(ILUOUT,'CISBA',GDO%CISBA,'2-L','3-L','DIF')
+ CALL TEST_NAM_VAR_SURF(ILUOUT,'CPEDOTF',GDO%CPEDOTF,'CH78','CO84')
+ CALL TEST_NAM_VAR_SURF(ILUOUT,'CPHOTO',GDO%CPHOTO,'NON','AST','NIT','NCB')
!
- IF (GDM%TVG%CPHOTO=='NCB') THEN
- GDM%TVG%CPHOTO = 'NIT'
+ IF (GDO%CPHOTO=='NCB') THEN
+ GDO%CPHOTO = 'NIT'
WRITE(ILUOUT,*) '****************************************************************'
WRITE(ILUOUT,*) '* FOR GARDENS, AGS OPTION HAS BEEN CHANGED FROM "NCB" TO "NIT" *'
WRITE(ILUOUT,*) '****************************************************************'
END IF
!
- SELECT CASE (GDM%TVG%CISBA)
+ SELECT CASE (GDO%CISBA)
CASE ('2-L')
- GDM%TGDO%NGROUND_LAYER = 2
- GDM%TVG%CPEDOTF ='CH78'
+ GDO%NGROUND_LAYER = 2
+ GDO%CPEDOTF ='CH78'
WRITE(ILUOUT,*) '*****************************************'
- WRITE(ILUOUT,*) '* With option CISBA = ',GDM%TVG%CISBA,' *'
+ WRITE(ILUOUT,*) '* With option CISBA = ',GDO%CISBA,' *'
WRITE(ILUOUT,*) '* the number of soil layers is set to 2 *'
WRITE(ILUOUT,*) '* theta(psi) function = Brook and Corey *'
WRITE(ILUOUT,*) '* Pedo transfert function = CH78 *'
WRITE(ILUOUT,*) '*****************************************'
CASE ('3-L')
- GDM%TGDO%NGROUND_LAYER = 3
- GDM%TVG%CPEDOTF ='CH78'
+ GDO%NGROUND_LAYER = 3
+ GDO%CPEDOTF ='CH78'
WRITE(ILUOUT,*) '*****************************************'
- WRITE(ILUOUT,*) '* With option CISBA = ',GDM%TVG%CISBA,' *'
+ WRITE(ILUOUT,*) '* With option CISBA = ',GDO%CISBA,' *'
WRITE(ILUOUT,*) '* the number of soil layers is set to 3 *'
WRITE(ILUOUT,*) '* theta(psi) function = Brook and Corey *'
WRITE(ILUOUT,*) '* Pedo transfert function = CH78 *'
WRITE(ILUOUT,*) '*****************************************'
CASE ('DIF')
- IF(GDM%TGDO%NGROUND_LAYER==NUNDEF)THEN
+ IF(GDO%NGROUND_LAYER==NUNDEF)THEN
IF(TOP%LECOCLIMAP)THEN
- GDM%TGDO%NGROUND_LAYER=NOPTIMLAYER
+ GDO%NGROUND_LAYER=NOPTIMLAYER
ELSE
WRITE(ILUOUT,*) '****************************************'
WRITE(ILUOUT,*) '* Number of ground layer not specified *'
@@ -240,13 +241,13 @@ GDM%TVG%LTR_ML = GTR_ML
ENDIF
ENDIF
!
- ALLOCATE(GDM%TGDO%XSOILGRID(GDM%TGDO%NGROUND_LAYER))
- GDM%TGDO%XSOILGRID(:)=XUNDEF
- GDM%TGDO%XSOILGRID(:)=ZSOILGRID(1:GDM%TGDO%NGROUND_LAYER)
+ ALLOCATE(GDO%XSOILGRID(GDO%NGROUND_LAYER))
+ GDO%XSOILGRID(:)=XUNDEF
+ GDO%XSOILGRID(:)=ZSOILGRID(1:GDO%NGROUND_LAYER)
IF(ALL(ZSOILGRID(:)==XUNDEF))THEN
IF(TOP%LECOCLIMAP) &
- GDM%TGDO%XSOILGRID(1:GDM%TGDO%NGROUND_LAYER)=XOPTIMGRID(1:GDM%TGDO%NGROUND_LAYER)
- ELSEIF(COUNT(GDM%TGDO%XSOILGRID/=XUNDEF)/=GDM%TGDO%NGROUND_LAYER)THEN
+ GDO%XSOILGRID(1:GDO%NGROUND_LAYER)=XOPTIMGRID(1:GDO%NGROUND_LAYER)
+ ELSEIF(COUNT(GDO%XSOILGRID/=XUNDEF)/=GDO%NGROUND_LAYER)THEN
WRITE(ILUOUT,*) '********************************************************'
WRITE(ILUOUT,*) '* Soil grid reference values /= number of ground layer *'
WRITE(ILUOUT,*) '********************************************************'
@@ -254,25 +255,25 @@ GDM%TVG%LTR_ML = GTR_ML
ENDIF
!
WRITE(ILUOUT,*) '*****************************************'
- WRITE(ILUOUT,*) '* Option CISBA = ',GDM%TVG%CISBA
- WRITE(ILUOUT,*) '* Pedo transfert function = ',GDM%TVG%CPEDOTF
- WRITE(ILUOUT,*) '* Number of soil layers = ',GDM%TGDO%NGROUND_LAYER
+ WRITE(ILUOUT,*) '* Option CISBA = ',GDO%CISBA
+ WRITE(ILUOUT,*) '* Pedo transfert function = ',GDO%CPEDOTF
+ WRITE(ILUOUT,*) '* Number of soil layers = ',GDO%NGROUND_LAYER
IF(TOP%LECOCLIMAP)THEN
- WRITE(ILUOUT,*) '* Soil layers grid (m) = ',GDM%TGDO%XSOILGRID(1:GDM%TGDO%NGROUND_LAYER)
+ WRITE(ILUOUT,*) '* Soil layers grid (m) = ',GDO%XSOILGRID(1:GDO%NGROUND_LAYER)
ENDIF
WRITE(ILUOUT,*) '*****************************************'
END SELECT
!
- SELECT CASE (GDM%TVG%CPHOTO)
- CASE ('AGS','LAI','AST','LST')
- GDM%TVG%NNBIOMASS = 1
+ SELECT CASE (GDO%CPHOTO)
+ CASE ('AST')
+ GDO%NNBIOMASS = 1
CASE ('NIT')
- GDM%TVG%NNBIOMASS = 3
+ GDO%NNBIOMASS = 3
END SELECT
WRITE(ILUOUT,*) '*****************************************'
- WRITE(ILUOUT,*) '* With option CPHOTO = ',GDM%TVG%CPHOTO,' *'
- WRITE(ILUOUT,*) '* the number of biomass pools is set to ', GDM%TVG%NNBIOMASS
+ WRITE(ILUOUT,*) '* With option CPHOTO = ',GDO%CPHOTO,' *'
+ WRITE(ILUOUT,*) '* the number of biomass pools is set to ', GDO%NNBIOMASS
WRITE(ILUOUT,*) '*****************************************'
!
!-------------------------------------------------------------------------------
@@ -280,7 +281,7 @@ GDM%TVG%LTR_ML = GTR_ML
!* 3. Sand fraction
! -------------
!
-ALLOCATE(GDM%TGDP%XSAND(TG%NDIM,GDM%TGDO%NGROUND_LAYER))
+ALLOCATE(GDK%XSAND(KDIM,GDO%NGROUND_LAYER))
!
IF(LIMP_SAND)THEN
!
@@ -289,18 +290,18 @@ IF(LIMP_SAND)THEN
ELSE
!
CALL PGD_FIELD(DTCO, UG, U, USS, &
- HPROGRAM,'sand fraction','TWN',YSAND,YSANDFILETYPE,XUNIF_SAND,GDM%TGDP%XSAND(:,1))
+ HPROGRAM,'sand fraction','TWN',YSAND,YSANDFILETYPE,XUNIF_SAND,GDK%XSAND(:,1))
ENDIF
!
-DO JLAYER=1,GDM%TGDO%NGROUND_LAYER
- GDM%TGDP%XSAND(:,JLAYER) = GDM%TGDP%XSAND(:,1)
+DO JLAYER=1,GDO%NGROUND_LAYER
+ GDK%XSAND(:,JLAYER) = GDK%XSAND(:,1)
END DO
!-------------------------------------------------------------------------------
!
!* 4. Clay fraction
! -------------
!
-ALLOCATE(GDM%TGDP%XCLAY(TG%NDIM,GDM%TGDO%NGROUND_LAYER))
+ALLOCATE(GDK%XCLAY(KDIM,GDO%NGROUND_LAYER))
!
IF(LIMP_CLAY)THEN
!
@@ -308,54 +309,51 @@ IF(LIMP_CLAY)THEN
!
ELSE
CALL PGD_FIELD(DTCO, UG, U, USS, &
- HPROGRAM,'clay fraction','TWN',YCLAY,YCLAYFILETYPE,XUNIF_CLAY,GDM%TGDP%XCLAY(:,1))
+ HPROGRAM,'clay fraction','TWN',YCLAY,YCLAYFILETYPE,XUNIF_CLAY,GDK%XCLAY(:,1))
ENDIF
!
-DO JLAYER=1,GDM%TGDO%NGROUND_LAYER
- GDM%TGDP%XCLAY(:,JLAYER) = GDM%TGDP%XCLAY(:,1)
+DO JLAYER=1,GDO%NGROUND_LAYER
+ GDK%XCLAY(:,JLAYER) = GDK%XCLAY(:,1)
END DO
!-------------------------------------------------------------------------------
!
!* 5. Subgrid runoff
! --------------
!
-ALLOCATE(GDM%TGDP%XRUNOFFB(TG%NDIM))
+ALLOCATE(GDK%XRUNOFFB(KDIM))
CALL PGD_FIELD(DTCO, UG, U, USS, &
- HPROGRAM,'subgrid runoff','TWN',YRUNOFFB,YRUNOFFBFILETYPE,XUNIF_RUNOFFB,GDM%TGDP%XRUNOFFB(:))
+ HPROGRAM,'subgrid runoff','TWN',YRUNOFFB,YRUNOFFBFILETYPE,XUNIF_RUNOFFB,GDK%XRUNOFFB(:))
!
!-------------------------------------------------------------------------------
!
!* 6. Drainage coefficient
! --------------------
!
-ALLOCATE(GDM%TGDP%XWDRAIN(TG%NDIM))
+ALLOCATE(GDK%XWDRAIN(KDIM))
CALL PGD_FIELD(DTCO, UG, U, USS, &
- HPROGRAM,'subgrid drainage','TWN',YWDRAIN,YWDRAINFILETYPE,XUNIF_WDRAIN,GDM%TGDP%XWDRAIN(:))
+ HPROGRAM,'subgrid drainage','TWN',YWDRAIN,YWDRAINFILETYPE,XUNIF_WDRAIN,GDK%XWDRAIN(:))
!
!-------------------------------------------------------------------------------
!
!* 7. Interpolation of GARDEN physiographic fields
! --------------------------------------------
!
-GDM%DTGD%NTIME = 12
- CALL PGD_TEB_GARDEN_PAR(DTCO, UG, U, USS, TG, GDM, &
- HPROGRAM)
+DTGD%NTIME = 12
+ CALL PGD_TEB_GARDEN_PAR(DTCO, UG, U, USS, KDIM, GDO, DTGD, HPROGRAM)
!
!-------------------------------------------------------------------------------
!
!* 8. Case of greenroofs
! ------------------
!
-IF (TOP%LGREENROOF) CALL PGD_TEB_GREENROOF(DTCO, UG, U, USS, GRM, TG, &
- HPROGRAM)
+IF (TOP%LGREENROOF) CALL PGD_TEB_GREENROOF(DTCO, UG, U, USS, GRO, GRS, GRK, DTGR, KDIM, HPROGRAM)
!
!-------------------------------------------------------------------------------
!
!* 9. Irrigation of gardens and greenroofs
! ------------------------------------
!
- CALL PGD_TEB_IRRIG(DTCO, UG, U, USS, TG, GDM%TIR, &
- HPROGRAM)
+CALL PGD_TEB_IRRIG(DTCO, UG, U, USS, KDIM, GDIR, HPROGRAM)
!
!-------------------------------------------------------------------------------
!
@@ -366,26 +364,6 @@ IF (TOP%LHYDRO) print*," CALL PGD_TEB_URBHYDRO(HPROGRAM,LECOCLIMAP)"
!
!-------------------------------------------------------------------------------
!
-!* 10. GARDEN diagnostic PGD fields stored in PGD file for improved efficiency in PREP step
-! ------------------------------------------------------------------------------------
-!
-IF (TOP%LECOCLIMAP) THEN
- ALLOCATE(ZDG(TG%NDIM,GDM%TGDO%NGROUND_LAYER,1))
- ALLOCATE(IWG_LAYER(TG%NDIM,1))
- CALL CONVERT_COVER_TEB_VEG(DTCO,GDM%TVG,GDM%TVG%CISBA,1,TOP%XCOVER,TOP%LCOVER,' ',&
- 'GRD',PSOILGRID=GDM%TGDO%XSOILGRID,PDG=ZDG,KWG_LAYER=IWG_LAYER)
- !
- ALLOCATE(GDM%TGDP%XDG(TG%NDIM,GDM%TGDO%NGROUND_LAYER))
- GDM%TGDP%XDG(:,:) = ZDG(:,:,1)
- IF (GDM%TVG%CISBA=='DIF') THEN
- ALLOCATE(GDM%TGDP%NWG_LAYER(TG%NDIM))
- GDM%TGDP%NWG_LAYER(:) = IWG_LAYER(:,1)
- ELSE
- ALLOCATE(GDM%TGDP%NWG_LAYER(0))
- END IF
-END IF
-!-------------------------------------------------------------------------------
-!!
IF (LHOOK) CALL DR_HOOK('PGD_TEB_GARDEN',1,ZHOOK_HANDLE)
!
!
diff --git a/src/SURFEX/pgd_topo_index.F90 b/src/SURFEX/pgd_topo_index.F90
index c44a37713fefe4c564ffe74a0c5d4f41276cf0f7..9759a6fe35980d9e776d5c7c73d9dacc80436bdd 100644
--- a/src/SURFEX/pgd_topo_index.F90
+++ b/src/SURFEX/pgd_topo_index.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PGD_TOPO_INDEX (DGU, DTCO, UG, U, USS, I, &
+ SUBROUTINE PGD_TOPO_INDEX (DTCO, UG, U, USS, S, OCTI, &
HPROGRAM,KLU,HCTI,HCTIFILETYPE,OIMP_CTI)
! ##################################################################
!
@@ -42,20 +42,21 @@
! -----------
!
!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t
+!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
!
USE MODD_PGD_GRID, ONLY : NL
!
!
-USE MODD_PGDWORK, ONLY : XSUMVAL, XSUMVAL2, NSIZE, &
+USE MODD_PGDWORK, ONLY : XALL, XEXT_ALL, NSIZE_ALL, &
XMIN_WORK, XMAX_WORK, &
XMEAN_WORK, XSTD_WORK, &
- XSKEW_WORK, XSUMVAL3
+ XSKEW_WORK, NSIZE, XSUMVAL
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
@@ -96,17 +97,19 @@ IMPLICIT NONE
! ------------------------
!
!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(SSO_t), INTENT(INOUT) :: USS
+!
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
+LOGICAL, INTENT(INOUT) :: OCTI
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
INTEGER, INTENT(IN) :: KLU ! number of nature points
- CHARACTER(LEN=28), INTENT(IN) :: HCTI ! topographic index file name
- CHARACTER(LEN=6), INTENT(IN) :: HCTIFILETYPE ! topographic index file type
+CHARACTER(LEN=28), INTENT(IN) :: HCTI ! topographic index file name
+CHARACTER(LEN=6), INTENT(IN) :: HCTIFILETYPE ! topographic index file type
LOGICAL, INTENT(IN) :: OIMP_CTI ! .true. if topographic index statistics is imposed
!
!
@@ -125,8 +128,8 @@ INTEGER :: I_DIM
INTEGER :: IRET ! error code
INTEGER :: ILUOUT ! output listing logical unit
!
- CHARACTER(LEN=6 ) :: YFILETYPE, YSCHEME, YSUBROUTINE
- CHARACTER(LEN=20) :: YFIELD ! Name of the field.
+CHARACTER(LEN=6 ) :: YFILETYPE, YSCHEME, YSUBROUTINE
+CHARACTER(LEN=20) :: YFIELD ! Name of the field.
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
@@ -137,17 +140,17 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('PGD_TOPO_INDEX',0,ZHOOK_HANDLE)
IF(LEN_TRIM(HCTI)==0)THEN
!
- ALLOCATE(I%XTI_MIN (0))
- ALLOCATE(I%XTI_MAX (0))
- ALLOCATE(I%XTI_MEAN(0))
- ALLOCATE(I%XTI_STD (0))
- ALLOCATE(I%XTI_SKEW(0))
+ ALLOCATE(S%XTI_MIN (0))
+ ALLOCATE(S%XTI_MAX (0))
+ ALLOCATE(S%XTI_MEAN(0))
+ ALLOCATE(S%XTI_STD (0))
+ ALLOCATE(S%XTI_SKEW(0))
!
!-------------------------------------------------------------------------------
ELSE
!-------------------------------------------------------------------------------
!
- I%LCTI = .TRUE.
+ OCTI = .TRUE.
!
!* 2. Find LUOUT
! ----------
@@ -161,25 +164,24 @@ ELSE
!* 3. Allocations of statistics arrays
! --------------------------------
!
- ALLOCATE(I%XTI_MIN (KLU))
- ALLOCATE(I%XTI_MAX (KLU))
- ALLOCATE(I%XTI_MEAN(KLU))
- ALLOCATE(I%XTI_STD (KLU))
- ALLOCATE(I%XTI_SKEW(KLU))
+ ALLOCATE(S%XTI_MIN (KLU))
+ ALLOCATE(S%XTI_MAX (KLU))
+ ALLOCATE(S%XTI_MEAN(KLU))
+ ALLOCATE(S%XTI_STD (KLU))
+ ALLOCATE(S%XTI_SKEW(KLU))
!
- I%XTI_MIN (:) = XUNDEF
- I%XTI_MAX (:) = XUNDEF
- I%XTI_MEAN(:) = XUNDEF
- I%XTI_STD (:) = XUNDEF
- I%XTI_SKEW(:) = XUNDEF
+ S%XTI_MIN (:) = XUNDEF
+ S%XTI_MAX (:) = XUNDEF
+ S%XTI_MEAN(:) = XUNDEF
+ S%XTI_STD (:) = XUNDEF
+ S%XTI_SKEW(:) = XUNDEF
!
!-------------------------------------------------------------------------------
!
!* 4. Allocations of work arrays
! --------------------------
!
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'NATURE',I_DIM)
+ CALL GET_TYPE_DIM_n(DTCO, U, 'NATURE',I_DIM)
IF (I_DIM/=KLU) THEN
WRITE(ILUOUT,*)'PGD_TOPO_INDEX: Wrong dimension of MASK: ',I_DIM,KLU
CALL ABOR1_SFX('PGD_TOPO_INDEX: WRONG DIMENSION OF MASK')
@@ -226,20 +228,15 @@ ELSE
#ifdef SFX_LFI
CFILEIN_LFI = ADJUSTL(HCTI)
#endif
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
+CALL INIT_IO_SURF_n(DTCO, U, &
YFILETYPE,'FULL ','SURF ','READ ')
ENDIF
!
- CALL READ_SURF(&
- YFILETYPE,'TI_MIN' ,XMIN_WORK ,IRET)
- CALL READ_SURF(&
- YFILETYPE,'TI_MAX' ,XMAX_WORK ,IRET)
- CALL READ_SURF(&
- YFILETYPE,'TI_MEAN',XMEAN_WORK,IRET)
- CALL READ_SURF(&
- YFILETYPE,'TI_STD' ,XSTD_WORK ,IRET)
- CALL READ_SURF(&
- YFILETYPE,'TI_SKEW',XSKEW_WORK,IRET)
+ CALL READ_SURF(YFILETYPE,'TI_MIN' ,XMIN_WORK ,IRET)
+ CALL READ_SURF(YFILETYPE,'TI_MAX' ,XMAX_WORK ,IRET)
+ CALL READ_SURF(YFILETYPE,'TI_MEAN',XMEAN_WORK,IRET)
+ CALL READ_SURF(YFILETYPE,'TI_STD' ,XSTD_WORK ,IRET)
+ CALL READ_SURF(YFILETYPE,'TI_SKEW',XSKEW_WORK,IRET)
!
CALL END_IO_SURF_n(YFILETYPE)
!
@@ -250,15 +247,14 @@ ELSE
!* 6. Use of cti file
! ---------------
!
- ALLOCATE(NSIZE (IFULL))
- ALLOCATE(XSUMVAL (IFULL))
- ALLOCATE(XSUMVAL2(IFULL))
- ALLOCATE(XSUMVAL3(IFULL))
+ ALLOCATE(NSIZE_ALL(U%NDIM_FULL,1))
+ ALLOCATE(XEXT_ALL (U%NDIM_FULL,2))
+ ALLOCATE(XALL (U%NDIM_FULL,3,1))
!
- NSIZE (:) = 0.
- XSUMVAL (:) = 0.
- XSUMVAL2 (:) = 0.
- XSUMVAL3 (:) = 0.
+ NSIZE_ALL(:,1) = 0.
+ XEXT_ALL (:,1) = -99999.
+ XEXT_ALL (:,2) = 99999.
+ XALL (:,:,1) = 0.
!
XMAX_WORK(:) =-99999.
!
@@ -273,13 +269,13 @@ ELSE
!* 7. Coherence
! ---------
!
- WHERE(NSIZE(:)<36.OR.XSTD_WORK(:)==0.0)
+ WHERE(NSIZE(:,1)<36.OR.XSTD_WORK(:)==0.0)
XMIN_WORK (:) = XUNDEF
XMAX_WORK (:) = XUNDEF
XMEAN_WORK(:) = XUNDEF
XSTD_WORK (:) = XUNDEF
XSKEW_WORK(:) = XUNDEF
- NSIZE (:) = 0
+ NSIZE (:,1) = 0
ENDWHERE
!
WHERE(U%XNATURE(:)>0.0.AND.XSKEW_WORK(:)<=-8.0)
@@ -288,7 +284,7 @@ ELSE
XMEAN_WORK(:) = XUNDEF
XSTD_WORK (:) = XUNDEF
XSKEW_WORK(:) = XUNDEF
- NSIZE (:) = 0
+ NSIZE (:,1) = 0
ENDWHERE
!
WHERE(U%XNATURE(:)==0.)
@@ -297,7 +293,7 @@ ELSE
XMEAN_WORK(:) = XUNDEF
XSTD_WORK (:) = XUNDEF
XSKEW_WORK(:) = XUNDEF
- NSIZE (:) = 0
+ NSIZE (:,1) = 0
ENDWHERE
!
!-------------------------------------------------------------------------------
@@ -356,6 +352,11 @@ ELSE
XSKEW_WORK(:)= 2.266-0.023*ZTI_MEAN(:)-0.245*ZTI_STD(:)-0.240*ZTI_SKEW(:)
ENDWHERE
ENDIF
+!
+ WHERE(XMEAN_WORK(:)/=XUNDEF.AND.(XMAX_WORK(:)-XMIN_WORK(:))>0.2)
+ XSTD_WORK (:)=MAX(0.2,XSTD_WORK (:))
+ XSKEW_WORK(:)=MAX(0.2,XSKEW_WORK(:))
+ ENDWHERE
!
WHERE(XMEAN_WORK(:)>0.0.AND.XMEAN_WORK(:)/=XUNDEF)
ZDELTA (:)= (XMEAN_WORK(:)-ZMEAN_INI(:))
@@ -367,7 +368,7 @@ ELSE
XMEAN_WORK(:) = XUNDEF
XSTD_WORK (:) = XUNDEF
XSKEW_WORK(:) = XUNDEF
- NSIZE (:) = 0
+ NSIZE (:,1) = 0
ENDWHERE
!
DEALLOCATE(ZDELTA )
@@ -390,10 +391,10 @@ ELSE
WRITE(ILUOUT,*) '*********************************************'
!
ALLOCATE(ZLAT(NL))
- CALL GET_GRID_COORD(UG, U, &
+ CALL GET_GRID_COORD(UG%G%CGRID, UG%G%NGRID_PAR, UG%G%XGRID_PAR, U%NSIZE_FULL, &
ILUOUT,PY=ZLAT)
!
- WHERE (U%XNATURE(:)==0..AND.NSIZE(:)==0) NSIZE(:) = -1
+ WHERE (U%XNATURE(:)==0..AND.NSIZE(:,1)==0) NSIZE(:,1) = -1
!
! No Antarctic
WHERE(U%XNATURE(:)>0..AND.ZLAT(:)<-60.)
@@ -402,26 +403,19 @@ ELSE
XMEAN_WORK(:) = XUNDEF
XSTD_WORK (:) = XUNDEF
XSKEW_WORK(:) = XUNDEF
- NSIZE (:) = -1
+ NSIZE (:,1) = -1
ENDWHERE
!
- IF(ALL(NSIZE(:)==0.0))NSIZE(:)=-1
+ IF(ALL(NSIZE(:,1)==0.0))NSIZE(:,1)=-1
!
- CALL INTERPOL_FIELD(UG, U, &
- HPROGRAM,ILUOUT,NSIZE,XMIN_WORK (:),'TI_MIN ',PDEF=XUNDEF,KNPTS=1)
- CALL INTERPOL_FIELD(UG, U, &
- HPROGRAM,ILUOUT,NSIZE,XMAX_WORK (:),'TI_MAX ',PDEF=XUNDEF,KNPTS=1)
- CALL INTERPOL_FIELD(UG, U, &
- HPROGRAM,ILUOUT,NSIZE,XMEAN_WORK(:),'TI_MEAN',PDEF=XUNDEF,KNPTS=1)
- CALL INTERPOL_FIELD(UG, U, &
- HPROGRAM,ILUOUT,NSIZE,XSTD_WORK (:),'TI_STD ',PDEF=XUNDEF,KNPTS=1)
- CALL INTERPOL_FIELD(UG, U, &
- HPROGRAM,ILUOUT,NSIZE,XSKEW_WORK(:),'TI_SKEW',PDEF=XUNDEF,KNPTS=1)
+ CALL INTERPOL_FIELD(UG, U, HPROGRAM,ILUOUT,NSIZE(:,1),XMIN_WORK (:),'TI_MIN ',PDEF=XUNDEF,KNPTS=1)
+ CALL INTERPOL_FIELD(UG, U, HPROGRAM,ILUOUT,NSIZE(:,1),XMAX_WORK (:),'TI_MAX ',PDEF=XUNDEF,KNPTS=1)
+ CALL INTERPOL_FIELD(UG, U, HPROGRAM,ILUOUT,NSIZE(:,1),XMEAN_WORK(:),'TI_MEAN',PDEF=XUNDEF,KNPTS=1)
+ CALL INTERPOL_FIELD(UG, U, HPROGRAM,ILUOUT,NSIZE(:,1),XSTD_WORK (:),'TI_STD ',PDEF=XUNDEF,KNPTS=1)
+ CALL INTERPOL_FIELD(UG, U, HPROGRAM,ILUOUT,NSIZE(:,1),XSKEW_WORK(:),'TI_SKEW',PDEF=XUNDEF,KNPTS=1)
!
DEALLOCATE(NSIZE )
DEALLOCATE(XSUMVAL )
- DEALLOCATE(XSUMVAL2 )
- DEALLOCATE(XSUMVAL3 )
DEALLOCATE(ZLAT )
!
ENDIF
@@ -430,11 +424,11 @@ ELSE
!* 11. Asign parameters
! ----------------
!
- CALL PACK_SAME_RANK(IMASK,XMIN_WORK ,I%XTI_MIN)
- CALL PACK_SAME_RANK(IMASK,XMAX_WORK ,I%XTI_MAX)
- CALL PACK_SAME_RANK(IMASK,XMEAN_WORK,I%XTI_MEAN)
- CALL PACK_SAME_RANK(IMASK,XSTD_WORK ,I%XTI_STD)
- CALL PACK_SAME_RANK(IMASK,XSKEW_WORK,I%XTI_SKEW)
+ CALL PACK_SAME_RANK(IMASK,XMIN_WORK ,S%XTI_MIN)
+ CALL PACK_SAME_RANK(IMASK,XMAX_WORK ,S%XTI_MAX)
+ CALL PACK_SAME_RANK(IMASK,XMEAN_WORK,S%XTI_MEAN)
+ CALL PACK_SAME_RANK(IMASK,XSTD_WORK ,S%XTI_STD)
+ CALL PACK_SAME_RANK(IMASK,XSKEW_WORK,S%XTI_SKEW)
!
!-------------------------------------------------------------------------------
!
@@ -453,7 +447,7 @@ ENDIF
IF (LHOOK) CALL DR_HOOK('PGD_TOPO_INDEX',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
- CONTAINS
+CONTAINS
!
SUBROUTINE CTIREG(OREG,OREG10,OREG2)
!
@@ -483,7 +477,7 @@ REAL :: ZGLBLONMIN ! minimum longitude of data box in the fil
REAL :: ZGLBLATMAX ! maximum latitude of data box in the file
REAL :: ZGLBLONMAX ! maximum longitude of data box in the file
!
- CHARACTER(LEN=28) :: YFILEHDR ! Name of the field file header
+CHARACTER(LEN=28) :: YFILEHDR ! Name of the field file header
!
INTEGER :: INBLAT
INTEGER :: INBLON
@@ -495,15 +489,15 @@ INTEGER :: IEINDEX ! index of character 'E' in YSTRING1
INTEGER :: IWINDEX ! index of character 'W' in YSTRING1
REAL, DIMENSION(7) :: ZVAL ! values of the head data
INTEGER :: IHEAD ! index of the data in the array ZVAL
- CHARACTER(LEN=100) :: YSTRING ! total string in the head
- CHARACTER(LEN=100) :: YSTRING1 ! string less the begining line descriptor
- CHARACTER(LEN=100) :: YVAL ! absolute value of the data of the line
+CHARACTER(LEN=100) :: YSTRING ! total string in the head
+CHARACTER(LEN=100) :: YSTRING1 ! string less the begining line descriptor
+CHARACTER(LEN=100) :: YVAL ! absolute value of the data of the line
INTEGER :: IPOINT ! index of '.' in the string YVAL
INTEGER :: ILENGTH ! length of the string YVAL
INTEGER :: IFRACLENGTH! length of the fractional part in string YVAL
- CHARACTER(LEN=2) :: YLENGTH ! length of the string YVAL
- CHARACTER(LEN=2) :: YFRACLENGTH! length of the fractional part in string YVAL
- CHARACTER(LEN=10) :: YINTERNALFORMAT ! format to read YVAL in real ZVAL
+CHARACTER(LEN=2) :: YLENGTH ! length of the string YVAL
+CHARACTER(LEN=2) :: YFRACLENGTH! length of the fractional part in string YVAL
+CHARACTER(LEN=10) :: YINTERNALFORMAT ! format to read YVAL in real ZVAL
!
REAL :: Z1000M, Z100M, Z10M
!
@@ -519,7 +513,7 @@ OREG2 =.FALSE.
!
IGLB=11
YFILEHDR =ADJUSTL(ADJUSTR(HCTI)//'.hdr')
- CALL OPEN_NAMELIST(HPROGRAM,IGLB,YFILEHDR)
+CALL OPEN_NAMELIST(HPROGRAM,IGLB,YFILEHDR)
!
!* 1. Line of comments
! ----------------
@@ -631,12 +625,12 @@ IF(SQRT(ZDLAT*ZDLON)>=Z10M.AND.SQRT(ZDLAT*ZDLON)<=Z100M)THEN
OREG2 =.TRUE.
ENDIF
!
- CALL CLOSE_NAMELIST(HPROGRAM,IGLB)
+CALL CLOSE_NAMELIST(HPROGRAM,IGLB)
!
IF (LHOOK) CALL DR_HOOK('PGD_TOPO_INDEX:CTIREG',1,ZHOOK_HANDLE)
RETURN
99 CONTINUE
- CALL ABOR1_SFX('CTIREG: PB READING TOPO INDEX FILE HEADER')
+CALL ABOR1_SFX('CTIREG: PB READING TOPO INDEX FILE HEADER')
IF (LHOOK) CALL DR_HOOK('PGD_TOPO_INDEX:CTIREG',1,ZHOOK_HANDLE)
!
END SUBROUTINE CTIREG
diff --git a/src/SURFEX/pgd_town.F90 b/src/SURFEX/pgd_town.F90
index 64b92edaec601ff797b35b402b06d84d9835c01f..7d5dc7ed99ac5c1243dd3745be1576b7c7586a34 100644
--- a/src/SURFEX/pgd_town.F90
+++ b/src/SURFEX/pgd_town.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PGD_TOWN (DTCO, DGU, UG, U, USS, DTI, TM, GDM, GRM, &
- HPROGRAM,OECOCLIMAP,OGARDEN)
+ SUBROUTINE PGD_TOWN (DTCO, UG, U, USS, DTV, TM, GDM, GRM, HPROGRAM)
! #############################################################
!
!!**** *PGD_TOWN* - routine to choose initialization of urban scheme
@@ -40,10 +39,9 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
!
USE MODD_SURFEX_n, ONLY : TEB_MODEL_t
@@ -63,19 +61,15 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
+TYPE(SSO_t), INTENT(INOUT) :: USS
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM
TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-LOGICAL, INTENT(IN) :: OECOCLIMAP ! T if parameters are computed with ecoclimap
-! ! F if all parameters must be specified
-LOGICAL, INTENT(IN) :: OGARDEN ! T if urban green areas
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
@@ -95,8 +89,9 @@ ELSE IF (U%CTOWN=='FLUX ') THEN
IF (LHOOK) CALL DR_HOOK('PGD_TOWN',1,ZHOOK_HANDLE)
RETURN
ELSE IF (U%CTOWN=='TEB ') THEN
- CALL PGD_TEB(DTCO, DGU, UG, U, USS, DTI, TM, GDM, GRM, &
- HPROGRAM,OECOCLIMAP,OGARDEN)
+ CALL PGD_TEB(DTCO, UG, U, USS, TM%TOP, TM%BOP, TM%G, TM%BDD, TM%DTT, TM%DTB, &
+ GDM%O, GDM%K, GDM%DTV, TM%TIR, &
+ GRM%O, GRM%S, GRM%K, GRM%DTV, HPROGRAM)
END IF
IF (LHOOK) CALL DR_HOOK('PGD_TOWN',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/pgd_tsz0_par.F90 b/src/SURFEX/pgd_tsz0_par.F90
index fde097874f08acda1e4c228a2c2a266365d8f006..5ee6a6549711a3cb9cec231937325fe0f6ed1d48 100644
--- a/src/SURFEX/pgd_tsz0_par.F90
+++ b/src/SURFEX/pgd_tsz0_par.F90
@@ -104,10 +104,10 @@ IF (LHOOK) CALL DR_HOOK('PGD_TSZ0_PAR',0,ZHOOK_HANDLE)
NTIME = 25
XUNIF_DTS (:) = -0.250
XUNIF_DHUGRD(:) = 0.0
- CFNAM_DTS (:) = ' '
- CFNAM_DHUGRD(:) = ' '
- CFTYP_DTS (:) = ' '
- CFTYP_DHUGRD(:) = ' '
+CFNAM_DTS (:) = ' '
+CFNAM_DHUGRD(:) = ' '
+CFTYP_DTS (:) = ' '
+CFTYP_DHUGRD(:) = ' '
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/pgd_watflux.F90 b/src/SURFEX/pgd_watflux.F90
index 77f2bfbff5ee7682c237fdec9363e53a7fa899e7..6bd3d6b5cd6f039af577f2c5318c3574beeb1c76 100644
--- a/src/SURFEX/pgd_watflux.F90
+++ b/src/SURFEX/pgd_watflux.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PGD_WATFLUX (DTCO, U, WG, W, &
- HPROGRAM)
+ SUBROUTINE PGD_WATFLUX (DTCO, U, G, W, HPROGRAM)
! ##############################################################
!
!!**** *PGD_WATFLUX* monitor for averaging and interpolations of WATFLUX physiographic fields
@@ -41,10 +40,11 @@
! -----------
!
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_WATFLUX_GRID_n, ONLY : WATFLUX_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_WATFLUX_n, ONLY : WATFLUX_t
!
USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
@@ -66,7 +66,7 @@ IMPLICIT NONE
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(WATFLUX_GRID_t), INTENT(INOUT) :: WG
+TYPE(GRID_t), INTENT(INOUT) :: G
TYPE(WATFLUX_t), INTENT(INOUT) :: W
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
@@ -100,23 +100,18 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ----------------------------
!
IF (LHOOK) CALL DR_HOOK('PGD_WATFLUX',0,ZHOOK_HANDLE)
- CALL GET_SURF_SIZE_n(DTCO, U, &
- 'WATER ',WG%NDIM)
+ CALL GET_SURF_SIZE_n(DTCO, U, 'WATER ',G%NDIM)
!
ALLOCATE(W%LCOVER (JPCOVER))
-ALLOCATE(W%XZS (WG%NDIM))
-ALLOCATE(WG%XLAT (WG%NDIM))
-ALLOCATE(WG%XLON (WG%NDIM))
-ALLOCATE(WG%XMESH_SIZE (WG%NDIM))
+ALLOCATE(W%XZS (G%NDIM))
+ALLOCATE(G%XLAT (G%NDIM))
+ALLOCATE(G%XLON (G%NDIM))
+ALLOCATE(G%XMESH_SIZE (G%NDIM))
!
- CALL PACK_PGD(DTCO, U, &
- HPROGRAM, 'WATER ', &
- WG%CGRID, WG%XGRID_PAR, &
- W%LCOVER, W%XCOVER, W%XZS, &
- WG%XLAT, WG%XLON, WG%XMESH_SIZE )
+ CALL PACK_PGD(DTCO, U, HPROGRAM, 'WATER ', G, W%LCOVER, W%XCOVER, W%XZS )
!
!-------------------------------------------------------------------------------
- CALL WRITE_COVER_TEX_WATER
+IF (NRANK==NPIO) CALL WRITE_COVER_TEX_WATER
IF (LHOOK) CALL DR_HOOK('PGD_WATFLUX',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/prep_ctrl_ideal.F90 b/src/SURFEX/prep_ctrl.F90
similarity index 55%
rename from src/SURFEX/prep_ctrl_ideal.F90
rename to src/SURFEX/prep_ctrl.F90
index a7589e6ea7e3ab7f32c85b9a3c980db95543d099..e2181c9dd31d0ffb54e7ebc8483f8a943bd1a15a 100644
--- a/src/SURFEX/prep_ctrl_ideal.F90
+++ b/src/SURFEX/prep_ctrl.F90
@@ -3,11 +3,10 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PREP_CTRL_IDEAL(K2M,OSURF_BUDGET,O2M_MIN_ZS,ORAD_BUDGET,OCOEF,OSURF_VARS,&
- KLUOUT,OSURF_BUDGETC)
+ SUBROUTINE PREP_CTRL(DGO,KLUOUT)
! #################################################################################################################
!
-!!**** *PREP_CTRL_IDEAL* - routine to check that diagnostics are switched off
+!!**** *PREP_CTRL* - routine to check that diagnostics are switched off
!!
!! PURPOSE
!! -------
@@ -38,6 +37,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
+!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -47,14 +48,10 @@ IMPLICIT NONE
! -------------------------
!
!
-INTEGER, INTENT(INOUT) :: K2M ! flag for 2m parameters
-LOGICAL, INTENT(INOUT) :: OSURF_BUDGET ! flag for surface budget
-LOGICAL, INTENT(INOUT) :: O2M_MIN_ZS ! flag for 2m parameters at min zs
-LOGICAL, INTENT(INOUT) :: ORAD_BUDGET ! flag for radiative budget
-LOGICAL, INTENT(INOUT) :: OCOEF ! flag for turbulent coefficients
-LOGICAL, INTENT(INOUT) :: OSURF_VARS ! flag for other surface variables
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+!
INTEGER, INTENT(IN) :: KLUOUT ! unit number
-LOGICAL, INTENT(INOUT) :: OSURF_BUDGETC ! flag for cumulated surface budget
+!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.2 Declarations of local variables
@@ -62,18 +59,18 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
-IF (LHOOK) CALL DR_HOOK('PREP_CTRL_IDEAL',0,ZHOOK_HANDLE)
-K2M = 0
+IF (LHOOK) CALL DR_HOOK('PREP_CTRL',0,ZHOOK_HANDLE)
+DGO%N2M = 0
!
-OSURF_BUDGET = .FALSE.
-O2M_MIN_ZS = .FALSE.
-ORAD_BUDGET = .FALSE.
-OCOEF = .FALSE.
-OSURF_VARS = .FALSE.
-OSURF_BUDGETC = .FALSE.
+DGO%LSURF_BUDGET = .FALSE.
+DGO%L2M_MIN_ZS = .FALSE.
+DGO%LRAD_BUDGET = .FALSE.
+DGO%LCOEF = .FALSE.
+DGO%LSURF_VARS = .FALSE.
+DGO%LSURF_BUDGETC = .FALSE.
!
-WRITE(KLUOUT,*)'IDEAL DIAGNOSTICS DESACTIVATED'
-IF (LHOOK) CALL DR_HOOK('PREP_CTRL_IDEAL',1,ZHOOK_HANDLE)
+WRITE(KLUOUT,*)'DIAGNOSTICS DESACTIVATED'
+IF (LHOOK) CALL DR_HOOK('PREP_CTRL',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
-END SUBROUTINE PREP_CTRL_IDEAL
+END SUBROUTINE PREP_CTRL
diff --git a/src/SURFEX/prep_ctrl_flake.F90 b/src/SURFEX/prep_ctrl_flake.F90
index 5e6228d8f98f87e932e0541f20e0eaae308f7906..8e63ea222e50b3a36ad87924538c197809f5a216 100644
--- a/src/SURFEX/prep_ctrl_flake.F90
+++ b/src/SURFEX/prep_ctrl_flake.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PREP_CTRL_FLAKE(K2M,OSURF_BUDGET,O2M_MIN_ZS,ORAD_BUDGET,OCOEF,OSURF_VARS,&
- KLUOUT,OWATER_PROFILE,OSURF_BUDGETC)
+SUBROUTINE PREP_CTRL_FLAKE(DGO, KLUOUT,OWATER_PROFILE)
! #################################################################################################################
!
!!**** *PREP_CTRL_FLAKE* - routine to check that diagnostics are switched off
@@ -38,6 +37,10 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
+!
+USE MODI_PREP_CTRL
+!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -47,34 +50,25 @@ IMPLICIT NONE
! -------------------------
!
!
-INTEGER, INTENT(INOUT) :: K2M ! flag for 2m parameters
-LOGICAL, INTENT(INOUT) :: OSURF_BUDGET ! flag for surface budget
-LOGICAL, INTENT(INOUT) :: O2M_MIN_ZS ! flag for 2m parameters at min zs
-LOGICAL, INTENT(INOUT) :: ORAD_BUDGET ! flag for radiative budget
-LOGICAL, INTENT(INOUT) :: OCOEF ! flag for turbulent coefficients
-LOGICAL, INTENT(INOUT) :: OSURF_VARS ! flag for other surface variables
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+!
INTEGER, INTENT(IN) :: KLUOUT ! unit number
LOGICAL, INTENT(INOUT) :: OWATER_PROFILE !
-LOGICAL, INTENT(INOUT) :: OSURF_BUDGETC ! flag for cumulated surface budget
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.2 Declarations of local variables
! -------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PREP_CTRL_FLAKE',0,ZHOOK_HANDLE)
-K2M = 0
!
-OSURF_BUDGET = .FALSE.
-O2M_MIN_ZS = .FALSE.
-ORAD_BUDGET = .FALSE.
-OCOEF = .FALSE.
-OSURF_VARS = .FALSE.
+ CALL PREP_CTRL(DGO,KLUOUT)
+!
OWATER_PROFILE = .FALSE.
-OSURF_BUDGETC = .FALSE.
!
WRITE(KLUOUT,*)'FLAKE DIAGNOSTICS DESACTIVATED'
+!
IF (LHOOK) CALL DR_HOOK('PREP_CTRL_FLAKE',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/prep_ctrl_isba.F90 b/src/SURFEX/prep_ctrl_isba.F90
index db936dc390c5ab9040ac88a991e37fa10a373845..5ee02d2113e60b4d3f75891ed9e01b4b9a4ba463 100644
--- a/src/SURFEX/prep_ctrl_isba.F90
+++ b/src/SURFEX/prep_ctrl_isba.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PREP_CTRL_ISBA(K2M,OSURF_BUDGET,O2M_MIN_ZS,ORAD_BUDGET,OCOEF,OSURF_VARS,&
- OSURF_EVAP_BUDGET,OSURF_MISC_BUDGET,OSURF_BUDGETC, &
- OPATCH_BUDGET,OSURF_MISC_DIF,KLUOUT )
+SUBROUTINE PREP_CTRL_ISBA(DGO,OSURF_EVAP_BUDGET,OSURF_MISC_BUDGET,OSURF_MISC_DIF,KLUOUT )
! #################################################################################################################
!
!!**** *PREP_CTRL_ISBA* - routine to check that diagnostics are switched off
@@ -41,7 +39,9 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
+USE MODI_PREP_CTRL
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -51,17 +51,10 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
!
-INTEGER, INTENT(INOUT) :: K2M ! flag for 2m parameters
-LOGICAL, INTENT(INOUT) :: OSURF_BUDGET ! flag for surface budget
-LOGICAL, INTENT(INOUT) :: O2M_MIN_ZS ! flag for 2m parameters at min zs
-LOGICAL, INTENT(INOUT) :: ORAD_BUDGET ! flag for radiative budget
-LOGICAL, INTENT(INOUT) :: OCOEF ! flag for turbulent coefficients
-LOGICAL, INTENT(INOUT) :: OSURF_VARS ! flag for other surface variables
LOGICAL, INTENT(INOUT) :: OSURF_EVAP_BUDGET ! flag for surface evaporation budget
LOGICAL, INTENT(INOUT) :: OSURF_MISC_BUDGET ! flag for surface miscellaneous budget
-LOGICAL, INTENT(INOUT) :: OSURF_BUDGETC ! flag for cumulated surface budget
-LOGICAL, INTENT(INOUT) :: OPATCH_BUDGET ! flaf for surface budget by patch
LOGICAL, INTENT(INOUT) :: OSURF_MISC_DIF ! flag for surface miscellaneous dif variables
INTEGER, INTENT(IN) :: KLUOUT ! unit number
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -72,16 +65,13 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PREP_CTRL_ISBA',0,ZHOOK_HANDLE)
-K2M = 0
!
-OSURF_BUDGET = .FALSE.
-O2M_MIN_ZS = .FALSE.
-ORAD_BUDGET = .FALSE.
-OCOEF = .FALSE.
-OSURF_VARS = .FALSE.
+ CALL PREP_CTRL(DGO,KLUOUT)
+!
+DGO%N2M = 0
+!
+DGO%LPATCH_BUDGET = .FALSE.
!
-OSURF_BUDGETC = .FALSE.
-OPATCH_BUDGET = .FALSE.
OSURF_EVAP_BUDGET = .FALSE.
OSURF_MISC_BUDGET = .FALSE.
OSURF_MISC_DIF = .FALSE.
diff --git a/src/SURFEX/prep_ctrl_seaflux.F90 b/src/SURFEX/prep_ctrl_seaflux.F90
index 8a73d34ebb3b4cbbeb7257590f227da534b4ee8b..af7acb13f6108ce646660f62038dc7c9afd20554 100644
--- a/src/SURFEX/prep_ctrl_seaflux.F90
+++ b/src/SURFEX/prep_ctrl_seaflux.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PREP_CTRL_SEAFLUX(K2M,OSURF_BUDGET,O2M_MIN_ZS,ORAD_BUDGET,OCOEF,OSURF_VARS,&
- ODIAG_OCEAN,ODIAG_SEAICE,KLUOUT,OSURF_BUDGETC)
+ SUBROUTINE PREP_CTRL_SEAFLUX(DGO,ODIAG_OCEAN,ODIAG_MISC_SEAICE,KLUOUT)
! #################################################################################################################
!
!!**** *PREP_CTRL_SEAFLUX* - routine to check that diagnostics are switched off
@@ -39,6 +38,10 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
+!
+USE MODI_PREP_CTRL
+!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -48,34 +51,25 @@ IMPLICIT NONE
! -------------------------
!
!
-INTEGER, INTENT(INOUT) :: K2M ! flag for 2m parameters
-LOGICAL, INTENT(INOUT) :: OSURF_BUDGET ! flag for surface budget
-LOGICAL, INTENT(INOUT) :: O2M_MIN_ZS ! flag for 2m parameters at min zs
-LOGICAL, INTENT(INOUT) :: ORAD_BUDGET ! flag for radiative budget
-LOGICAL, INTENT(INOUT) :: OCOEF ! flag for turbulent coefficients
-LOGICAL, INTENT(INOUT) :: OSURF_VARS ! flag for other surface variables
-LOGICAL, INTENT(INOUT) :: ODIAG_OCEAN ! flag for ocean variables
-LOGICAL, INTENT(INOUT) :: ODIAG_SEAICE ! flag for seaice variables
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+!
+LOGICAL, INTENT(INOUT) :: ODIAG_OCEAN
+LOGICAL, INTENT(INOUT) :: ODIAG_MISC_SEAICE ! flag for seaice variables
INTEGER, INTENT(IN) :: KLUOUT ! unit number
-LOGICAL, INTENT(INOUT) :: OSURF_BUDGETC ! flag for cumulated surface budget
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.2 Declarations of local variables
! -------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PREP_CTRL_SEAFLUX',0,ZHOOK_HANDLE)
-K2M = 0
!
-OSURF_BUDGET = .FALSE.
-O2M_MIN_ZS = .FALSE.
-ORAD_BUDGET = .FALSE.
-OCOEF = .FALSE.
-OSURF_VARS = .FALSE.
+ CALL PREP_CTRL(DGO,KLUOUT)
+!
ODIAG_OCEAN = .FALSE.
-ODIAG_SEAICE = .FALSE.
-OSURF_BUDGETC = .FALSE.
+!
+ODIAG_MISC_SEAICE = .FALSE.
!
WRITE(KLUOUT,*)'SEAFLUX DIAGNOSTICS DESACTIVATED'
IF (LHOOK) CALL DR_HOOK('PREP_CTRL_SEAFLUX',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/prep_ctrl_surf_atm.F90 b/src/SURFEX/prep_ctrl_surf_atm.F90
index c3f43edd7618d0e36733181e8395be3224da5886..9a588bc409c52e6e5b87d4d58859f05b6ee1d76d 100644
--- a/src/SURFEX/prep_ctrl_surf_atm.F90
+++ b/src/SURFEX/prep_ctrl_surf_atm.F90
@@ -3,10 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PREP_CTRL_SURF_ATM(K2M,OSURF_BUDGET,O2M_MIN_ZS,ORAD_BUDGET, &
- OCOEF,OSURF_VARS,OSURF_BUDGETC, &
- ORESET_BUDGETC,ONOWRITE_TEXFILE, &
- OSELECT,KLUOUT,OPROVAR_TO_DIAG)
+ SUBROUTINE PREP_CTRL_SURF_ATM(DGO,ONOWRITE_TEXFILE,KLUOUT)
! ########################################################################
!
!!**** *PREP_CTRL_SURF_ATM* - routine to check that diagnostics are switched off
@@ -41,6 +38,10 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
+!
+USE MODI_PREP_CTRL
+!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -50,18 +51,9 @@ IMPLICIT NONE
! -------------------------
!
!
-INTEGER, INTENT(INOUT) :: K2M ! flag for operational 2m quantities
-LOGICAL, INTENT(INOUT) :: OSURF_BUDGET ! flag for surface budget
-LOGICAL, INTENT(INOUT) :: O2M_MIN_ZS ! flag for 2m quantities on min. orography
-LOGICAL, INTENT(INOUT) :: ORAD_BUDGET ! flag for radiative budget
-LOGICAL, INTENT(INOUT) :: OCOEF ! flag for transfer coefficients
-LOGICAL, INTENT(INOUT) :: OSURF_VARS ! flag for surface variables
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
LOGICAL, INTENT(INOUT) :: ONOWRITE_TEXFILE ! flag for surface variables
INTEGER, INTENT(IN) :: KLUOUT ! unit number
-LOGICAL, INTENT(INOUT) :: OSURF_BUDGETC ! flag for cumulated surface budget
-LOGICAL, INTENT(INOUT) :: ORESET_BUDGETC ! flag for cumulated surface budget
-LOGICAL, INTENT(INOUT) :: OSELECT ! switch to control which fields are written
-LOGICAL, INTENT(INOUT) :: OPROVAR_TO_DIAG ! switch to write (or not) prognostic variable
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.2 Declarations of local variables
@@ -70,20 +62,14 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PREP_CTRL_SURF_ATM',0,ZHOOK_HANDLE)
-K2M = 0
!
-OSURF_BUDGET = .FALSE.
-O2M_MIN_ZS = .FALSE.
-ORAD_BUDGET = .FALSE.
-OCOEF = .FALSE.
-OSURF_VARS = .FALSE.
+ CALL PREP_CTRL(DGO,KLUOUT)
!
-OSURF_BUDGETC = .FALSE.
-ORESET_BUDGETC = .FALSE.
+DGO%LRESET_BUDGETC = .FALSE.
!
ONOWRITE_TEXFILE = .TRUE.
-OSELECT = .FALSE.
-OPROVAR_TO_DIAG = .FALSE.
+DGO%LSELECT = .FALSE.
+DGO%LPROVAR_TO_DIAG = .FALSE.
!
WRITE(KLUOUT,*)'SURF_ATM DIAGNOSTICS DESACTIVATED'
IF (LHOOK) CALL DR_HOOK('PREP_CTRL_SURF_ATM',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/prep_ctrl_teb.F90 b/src/SURFEX/prep_ctrl_teb.F90
index 4b7a5fc28d38e661e2d5fda8304557607db34f3b..0b528b282d6d250a38f9663d98546d3686415d4f 100644
--- a/src/SURFEX/prep_ctrl_teb.F90
+++ b/src/SURFEX/prep_ctrl_teb.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PREP_CTRL_TEB (K2M,OSURF_BUDGET,O2M_MIN_ZS,ORAD_BUDGET,OCOEF,OSURF_VARS,&
- OSURF_EVAP_BUDGET,OSURF_MISC_BUDGET,OUTCI,KLUOUT)
+ SUBROUTINE PREP_CTRL_TEB (DGO, OSURF_EVAP_BUDGET,OSURF_MISC_BUDGET,OUTCI,KLUOUT)
! #################################################################################################################
!
!!**** *PREP_CTRL_TEB * - routine to check that diagnostics are switched off
@@ -38,6 +37,10 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
+!
+USE MODI_PREP_CTRL
+!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -46,13 +49,8 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
!
-INTEGER, INTENT(INOUT) :: K2M ! flag for 2m parameters
-LOGICAL, INTENT(INOUT) :: OSURF_BUDGET ! flag for surface budget
-LOGICAL, INTENT(INOUT) :: O2M_MIN_ZS ! flag for 2m parameters at min zs
-LOGICAL, INTENT(INOUT) :: ORAD_BUDGET ! flag for radiative budget
-LOGICAL, INTENT(INOUT) :: OCOEF ! flag for turbulent coefficients
-LOGICAL, INTENT(INOUT) :: OSURF_VARS ! flag for other surface variables
LOGICAL, INTENT(INOUT) :: OSURF_EVAP_BUDGET ! flag for surface evaporation budget
LOGICAL, INTENT(INOUT) :: OSURF_MISC_BUDGET ! flag for surface miscellaneous budget
LOGICAL, INTENT(INOUT) :: OUTCI ! flag for UTCI fields
@@ -65,13 +63,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PREP_CTRL_TEB',0,ZHOOK_HANDLE)
-K2M = 0
!
-OSURF_BUDGET = .FALSE.
-O2M_MIN_ZS = .FALSE.
-ORAD_BUDGET = .FALSE.
-OCOEF = .FALSE.
-OSURF_VARS = .FALSE.
+ CALL PREP_CTRL(DGO,KLUOUT)
!
OSURF_EVAP_BUDGET = .FALSE.
OSURF_MISC_BUDGET = .FALSE.
diff --git a/src/SURFEX/prep_ctrl_watflux.F90 b/src/SURFEX/prep_ctrl_watflux.F90
deleted file mode 100644
index cbbc116408efa0f0c32d8f18a0ecf98fdba4883a..0000000000000000000000000000000000000000
--- a/src/SURFEX/prep_ctrl_watflux.F90
+++ /dev/null
@@ -1,79 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE PREP_CTRL_WATFLUX(K2M,OSURF_BUDGET,O2M_MIN_ZS,ORAD_BUDGET,OCOEF,OSURF_VARS,&
- KLUOUT,OSURF_BUDGETC)
-! #################################################################################################################
-!
-!!**** *PREP_CTRL_WATFLUX* - routine to check that diagnostics are switched off
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! P. Le Moigne *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 04/2007
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
-!
-INTEGER, INTENT(INOUT) :: K2M ! flag for 2m parameters
-LOGICAL, INTENT(INOUT) :: OSURF_BUDGET ! flag for surface budget
-LOGICAL, INTENT(INOUT) :: O2M_MIN_ZS ! flag for 2m parameters at min zs
-LOGICAL, INTENT(INOUT) :: ORAD_BUDGET ! flag for radiative budget
-LOGICAL, INTENT(INOUT) :: OCOEF ! flag for turbulent coefficients
-LOGICAL, INTENT(INOUT) :: OSURF_VARS ! flag for other surface variables
-INTEGER, INTENT(IN) :: KLUOUT ! unit number
-LOGICAL, INTENT(INOUT) :: OSURF_BUDGETC ! flag for cumulated surface budget
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('PREP_CTRL_WATFLUX',0,ZHOOK_HANDLE)
-K2M = 0
-!
-OSURF_BUDGET = .FALSE.
-O2M_MIN_ZS = .FALSE.
-ORAD_BUDGET = .FALSE.
-OCOEF = .FALSE.
-OSURF_VARS = .FALSE.
-OSURF_BUDGETC = .FALSE.
-!
-WRITE(KLUOUT,*)'WATFLUX DIAGNOSTICS DESACTIVATED'
-IF (LHOOK) CALL DR_HOOK('PREP_CTRL_WATFLUX',1,ZHOOK_HANDLE)
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE PREP_CTRL_WATFLUX
diff --git a/src/SURFEX/prep_flake.F90 b/src/SURFEX/prep_flake.F90
index 49f737490f48e66934aba1cf072c7e4aee2484a8..4d3798c1a1139360fac955ebd8552116a8532060 100644
--- a/src/SURFEX/prep_flake.F90
+++ b/src/SURFEX/prep_flake.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_FLAKE (DTCO, USS, FM, UG, U,GCP, &
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+SUBROUTINE PREP_FLAKE (DTCO, USS, FG, F, SB, UG, U, GCP, &
+ HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
! #################################################################################
!
!!**** *PREP_FLAKE* - prepares FLAKE fields
@@ -30,22 +30,24 @@ SUBROUTINE PREP_FLAKE (DTCO, USS, FM, UG, U,GCP, &
!! E. Kourzeneva 09/2010 (i) Change the default initialisation,
!! (ii) Include the possibility to use
!! lake climate data
+!! P. Marguinaud10/2014, Support for a 2-part PREP
!!------------------------------------------------------------------
!
!
-!
-USE MODD_SURFEX_n, ONLY : FLAKE_MODEL_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_FLAKE_n, ONLY : FLAKE_t
+USE MODD_CANOPY_n, ONLY : CANOPY_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
USE MODI_PREP_HOR_FLAKE_FIELD
USE MODI_PREP_VER_FLAKE
-USE MODI_PREP_FLAKE_SBL
+USE MODI_PREP_SBL
USE MODI_PREP_OUTPUT_GRID
USE MODI_GET_LUOUT
USE MODI_CLI_LAKE
@@ -58,9 +60,8 @@ USE MODD_PREP, ONLY : XZS_LS
USE MODD_PREP_FLAKE, ONLY : LCLIM_LAKE
USE MODD_SURF_PAR, ONLY : XUNDEF
!
-!
USE MODD_CSTS, ONLY : XTT
-
+USE MODE_PREP_CTL, ONLY : PREP_CTL, PREP_CTL_CAN
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -75,12 +76,16 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
-TYPE(FLAKE_MODEL_t), INTENT(INOUT) :: FM
+TYPE(GRID_t), INTENT(INOUT) :: FG
+TYPE(FLAKE_t), INTENT(INOUT) :: F
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
+TYPE (PREP_CTL), INTENT(INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! name of the Atmospheric file
@@ -90,6 +95,7 @@ TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
!* 0.2 declarations of local variables
!
+INTEGER :: ISIZE
INTEGER :: ILUOUT
LOGICAL :: GNOVALUE ! if the variable is not defined
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -99,10 +105,16 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
IF (LHOOK) CALL DR_HOOK('PREP_FLAKE',0,ZHOOK_HANDLE)
+!
+IF (.NOT. PREP_CTL_CAN (YDCTL)) THEN
+ CALL ABOR1_SFX('PREP_FLAKE: TWO STEP PREP NOT IMPLEMENTED')
+ENDIF
+
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
- CALL PREP_OUTPUT_GRID(UG, U, &
- ILUOUT,FM%FG%CGRID,FM%FG%XGRID_PAR,FM%FG%XLAT,FM%FG%XLON)
+ CALL PREP_OUTPUT_GRID(UG%G, FG, U%NSIZE_FULL, ILUOUT)
+!
+ISIZE = SIZE(FG%XLAT)
!
!-------------------------------------------------------------------------------------
!
@@ -111,8 +123,7 @@ IF (LHOOK) CALL DR_HOOK('PREP_FLAKE',0,ZHOOK_HANDLE)
!
!* 2.0 Large scale orography
!
- CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, &
- FM%FG, FM%F,GCP, &
+ CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, GCP, ISIZE, F, &
HPROGRAM,'ZS ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
!
!* 2.1 FLake variables
@@ -121,91 +132,71 @@ GNOVALUE = .FALSE.
!
IF (.NOT.LCLIM_LAKE) THEN
!
- CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, &
- FM%FG, FM%F,GCP, &
+ CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, GCP, ISIZE, F, &
HPROGRAM,'TS ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,GNOVALUE)
IF (GNOVALUE) CALL ABOR1_SFX('PREP_FLAKE: AT LEAST TS SHOULD BE GIVEN!')
!
- CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, &
- FM%FG, FM%F,GCP, &
+ CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, GCP, ISIZE, F, &
HPROGRAM,'T_SNOW ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,GNOVALUE)
!
- IF (.NOT.GNOVALUE) CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, &
- FM%FG, FM%F,GCP, &
- HPROGRAM,'T_ICE ',HATMFILE,HATMFILETYPE,&
- HPGDFILE,HPGDFILETYPE,GNOVALUE)
+ IF (.NOT.GNOVALUE) CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, GCP, ISIZE, F, &
+ HPROGRAM,'T_ICE ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,GNOVALUE)
!
- IF (.NOT.GNOVALUE) CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, &
- FM%FG, FM%F,GCP, &
- HPROGRAM,'T_WML ',HATMFILE,HATMFILETYPE,&
- HPGDFILE,HPGDFILETYPE,GNOVALUE)
+ IF (.NOT.GNOVALUE) CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, GCP, ISIZE, F, &
+ HPROGRAM,'T_WML ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,GNOVALUE)
!
- ALLOCATE(FM%F%XT_MNW(SIZE(FM%FG%XLAT)))
+ ALLOCATE(F%XT_MNW(ISIZE))
!
- IF (.NOT.GNOVALUE) CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, &
- FM%FG, FM%F,GCP, &
- HPROGRAM,'T_BOT ',HATMFILE,HATMFILETYPE,&
- HPGDFILE,HPGDFILETYPE,GNOVALUE)
+ IF (.NOT.GNOVALUE) CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, GCP, ISIZE, F, &
+ HPROGRAM,'T_BOT ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,GNOVALUE)
!
- IF (.NOT.GNOVALUE) CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, &
- FM%FG, FM%F,GCP, &
- HPROGRAM,'T_B1 ',HATMFILE,HATMFILETYPE,&
- HPGDFILE,HPGDFILETYPE,GNOVALUE)
+ IF (.NOT.GNOVALUE) CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, GCP, ISIZE, F, &
+ HPROGRAM,'T_B1 ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,GNOVALUE)
!
- IF (.NOT.GNOVALUE) CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, &
- FM%FG, FM%F,GCP, &
- HPROGRAM,'CT ',HATMFILE,HATMFILETYPE,&
- HPGDFILE,HPGDFILETYPE,GNOVALUE)
+ IF (.NOT.GNOVALUE) CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, GCP, ISIZE, F, &
+ HPROGRAM,'CT ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,GNOVALUE)
!
- IF (.NOT.GNOVALUE) CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, &
- FM%FG, FM%F,GCP, &
- HPROGRAM,'H_SNOW ',HATMFILE,HATMFILETYPE,&
- HPGDFILE,HPGDFILETYPE,GNOVALUE)
+ IF (.NOT.GNOVALUE) CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, GCP, ISIZE, F, &
+ HPROGRAM,'H_SNOW ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,GNOVALUE)
!
- IF (.NOT.GNOVALUE) CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, &
- FM%FG, FM%F,GCP, &
- HPROGRAM,'H_ICE ',HATMFILE,HATMFILETYPE,&
- HPGDFILE,HPGDFILETYPE,GNOVALUE)
+ IF (.NOT.GNOVALUE) CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, GCP, ISIZE, F, &
+ HPROGRAM,'H_ICE ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,GNOVALUE)
!
- IF (.NOT.GNOVALUE) CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, &
- FM%FG, FM%F,GCP, &
- HPROGRAM,'H_ML ',HATMFILE,HATMFILETYPE,&
- HPGDFILE,HPGDFILETYPE,GNOVALUE)
+ IF (.NOT.GNOVALUE) CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, GCP, ISIZE, F, &
+ HPROGRAM,'H_ML ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,GNOVALUE)
!
- IF (.NOT.GNOVALUE) CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, &
- FM%FG, FM%F,GCP, &
- HPROGRAM,'H_B1 ',HATMFILE,HATMFILETYPE,&
- HPGDFILE,HPGDFILETYPE,GNOVALUE)
+ IF (.NOT.GNOVALUE) CALL PREP_HOR_FLAKE_FIELD(DTCO, UG, U, USS, GCP, ISIZE, F, &
+ HPROGRAM,'H_B1 ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,GNOVALUE)
!
ENDIF
!
IF (LCLIM_LAKE .OR. GNOVALUE) THEN
IF (LCLIM_LAKE) THEN
- ALLOCATE(FM%F%XTS(SIZE(FM%FG%XLAT)))
- FM%F%XTS(:)=XUNDEF
+ ALLOCATE(F%XTS(ISIZE))
+ F%XTS(:)=XUNDEF
ENDIF
- ALLOCATE(FM%F%XT_SNOW(SIZE(FM%FG%XLAT)))
- ALLOCATE(FM%F%XT_ICE(SIZE(FM%FG%XLAT)))
- ALLOCATE(FM%F%XT_WML(SIZE(FM%FG%XLAT)))
- ALLOCATE(FM%F%XT_MNW(SIZE(FM%FG%XLAT)))
- ALLOCATE(FM%F%XT_BOT(SIZE(FM%FG%XLAT)))
- ALLOCATE(FM%F%XT_B1(SIZE(FM%FG%XLAT)))
- ALLOCATE(FM%F%XCT(SIZE(FM%FG%XLAT)))
- ALLOCATE(FM%F%XH_SNOW(SIZE(FM%FG%XLAT)))
- ALLOCATE(FM%F%XH_ICE(SIZE(FM%FG%XLAT)))
- ALLOCATE(FM%F%XH_ML(SIZE(FM%FG%XLAT)))
- ALLOCATE(FM%F%XH_B1(SIZE(FM%FG%XLAT)))
- FM%F%XT_SNOW(:)=XUNDEF
- FM%F%XT_ICE(:)=XUNDEF
- FM%F%XT_WML(:)=XUNDEF
- FM%F%XT_MNW(:)=XUNDEF
- FM%F%XT_BOT(:)=XUNDEF
- FM%F%XT_B1(:)=XUNDEF
- FM%F%XCT(:)=XUNDEF
- FM%F%XH_SNOW(:)=XUNDEF
- FM%F%XH_ICE(:)=XUNDEF
- FM%F%XH_ML(:)=XUNDEF
- FM%F%XH_B1(:)=XUNDEF
+ ALLOCATE(F%XT_SNOW(ISIZE))
+ ALLOCATE(F%XT_ICE(ISIZE))
+ ALLOCATE(F%XT_WML(ISIZE))
+ ALLOCATE(F%XT_MNW(ISIZE))
+ ALLOCATE(F%XT_BOT(ISIZE))
+ ALLOCATE(F%XT_B1(ISIZE))
+ ALLOCATE(F%XCT(ISIZE))
+ ALLOCATE(F%XH_SNOW(ISIZE))
+ ALLOCATE(F%XH_ICE(ISIZE))
+ ALLOCATE(F%XH_ML(ISIZE))
+ ALLOCATE(F%XH_B1(ISIZE))
+ F%XT_SNOW(:)=XUNDEF
+ F%XT_ICE(:)=XUNDEF
+ F%XT_WML(:)=XUNDEF
+ F%XT_MNW(:)=XUNDEF
+ F%XT_BOT(:)=XUNDEF
+ F%XT_B1(:)=XUNDEF
+ F%XCT(:)=XUNDEF
+ F%XH_SNOW(:)=XUNDEF
+ F%XH_ICE(:)=XUNDEF
+ F%XH_ML(:)=XUNDEF
+ F%XH_B1(:)=XUNDEF
ENDIF
!
!-------------------------------------------------------------------------------------
@@ -214,13 +205,13 @@ ENDIF
!
!* 2.2 Roughness
!
-ALLOCATE(FM%F%XZ0(SIZE(FM%F%XTS)))
-FM%F%XZ0 = 0.001
+ALLOCATE(F%XZ0(SIZE(F%XTS)))
+F%XZ0 = 0.001
!
!* 2.2 Friction velocity
!
-ALLOCATE(FM%F%XUSTAR(SIZE(FM%F%XTS)))
-FM%F%XUSTAR = 0.
+ALLOCATE(F%XUSTAR(SIZE(F%XTS)))
+F%XUSTAR = 0.
!
!-------------------------------------------------------------------------------------
@@ -229,7 +220,7 @@ FM%F%XUSTAR = 0.
!
IF(.NOT.LCLIM_LAKE) THEN
IF (LVERTSHIFT)THEN
- CALL PREP_VER_FLAKE(FM%F)
+ CALL PREP_VER_FLAKE(F)
WRITE(ILUOUT,*) "WARNING: You want the vertical shift for lakes?"
WRITE(ILUOUT,*) "WARNING: Vertical shift for the lake temperature profile is impossible!"
WRITE(ILUOUT,*) "WARNING: So, set the default vertical profiles from the shifted surface temperature." !
@@ -244,29 +235,29 @@ DEALLOCATE(XZS_LS)
! or read data from climate files
!
IF (LCLIM_LAKE) THEN
- CALL CLI_LAKE(FM%FG, FM%F)
+ CALL CLI_LAKE(FG, F)
ELSEIF (.NOT.GNOVALUE) THEN
- FM%F%XT_MNW(:)=FM%F%XT_WML(:)-(FM%F%XT_WML(:)-FM%F%XT_BOT(:))*(1.-FM%F%XH_ML(:)/FM%F%XWATER_DEPTH(:))*FM%F%XCT(:)
+ F%XT_MNW(:)=F%XT_WML(:)-(F%XT_WML(:)-F%XT_BOT(:))*(1.-F%XH_ML(:)/F%XWATER_DEPTH(:))*F%XCT(:)
ELSE
WRITE(ILUOUT,*) "WARNING! One of the lake profile variales was not indicated, so set the default profile!"
- FM%F%XT_WML=MAX(FM%F%XTS(:),XTT)
- FM%F%XT_SNOW=MIN(FM%F%XTS(:),XTT)
- FM%F%XT_ICE=MIN(FM%F%XTS(:),XTT)
- FM%F%XH_B1=0.0
- FM%F%XCT=0.5
- FM%F%XH_SNOW=0.0
- WHERE (FM%F%XTS <= XTT)
- FM%F%XT_BOT=XTT+4.
- FM%F%XT_B1=XTT+3.9
- FM%F%XH_ICE=0.01
- FM%F%XH_ML=FM%F%XWATER_DEPTH/2.
- FM%F%XT_MNW=FM%F%XT_WML-(FM%F%XT_WML-FM%F%XT_BOT)*(1.-FM%F%XH_ML/FM%F%XWATER_DEPTH)*FM%F%XCT
+ F%XT_WML=MAX(F%XTS(:),XTT)
+ F%XT_SNOW=MIN(F%XTS(:),XTT)
+ F%XT_ICE=MIN(F%XTS(:),XTT)
+ F%XH_B1=0.0
+ F%XCT=0.5
+ F%XH_SNOW=0.0
+ WHERE (F%XTS <= XTT)
+ F%XT_BOT=XTT+4.
+ F%XT_B1=XTT+3.9
+ F%XH_ICE=0.01
+ F%XH_ML=F%XWATER_DEPTH/2.
+ F%XT_MNW=F%XT_WML-(F%XT_WML-F%XT_BOT)*(1.-F%XH_ML/F%XWATER_DEPTH)*F%XCT
ELSEWHERE
- FM%F%XT_BOT=FM%F%XTS
- FM%F%XT_B1=FM%F%XTS-0.1
- FM%F%XH_ICE=0.0
- FM%F%XH_ML=FM%F%XWATER_DEPTH
- FM%F%XT_MNW=FM%F%XTS
+ F%XT_BOT=F%XTS
+ F%XT_B1=F%XTS-0.1
+ F%XH_ICE=0.0
+ F%XH_ML=F%XWATER_DEPTH
+ F%XT_MNW=F%XTS
END WHERE
END IF
!
@@ -274,8 +265,9 @@ END IF
!
!* 6. Preparation of SBL air variables
!
-FM%F%LSBL = LWAT_SBL
-IF (FM%F%LSBL) CALL PREP_FLAKE_SBL(FM%FG, FM%FSB)
+F%LSBL = LWAT_SBL
+IF (F%LSBL) CALL PREP_SBL(ISIZE, SB)
+!
IF (LHOOK) CALL DR_HOOK('PREP_FLAKE',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_flake_ascllv.F90 b/src/SURFEX/prep_flake_ascllv.F90
index 4dde143360b911b3d64af4c67215ad617c82f232..930eb4f9a54200ddd398619b245ee52a036aac3e 100644
--- a/src/SURFEX/prep_flake_ascllv.F90
+++ b/src/SURFEX/prep_flake_ascllv.F90
@@ -31,12 +31,12 @@ SUBROUTINE PREP_FLAKE_ASCLLV (DTCO, UG, U, USS, &
!
!
!
-!
+USE MODD_SURFEX_MPI, ONLY : NPROC, NINDEX, NNUM, NCOMM, NPIO, NRANK
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_PREP, ONLY : CINTERP_TYPE
USE MODD_PGD_GRID, ONLY : NL,LLATLONMASK,CGRID,XGRID_PAR,NGRID_PAR
@@ -54,13 +54,17 @@ USE MODI_GET_TYPE_DIM_n
!
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1 declarations of arguments
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
@@ -71,30 +75,58 @@ REAL, POINTER, DIMENSION(:,:) :: PFIELD ! field to interpolate horizontally
!
INTEGER :: IL
!
+INTEGER, DIMENSION(0:NPROC-1) :: INB
+INTEGER :: INFOMPI, JJ
+!
REAL, ALLOCATABLE, DIMENSION(:) :: ZFIELD
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PREP_FLAKE_ASCLLV',0,ZHOOK_HANDLE)
- CATYPE = 'ARI'
+!
+IF (.NOT.ALLOCATED(NNUM)) THEN
+ ALLOCATE(NNUM(U%NDIM_FULL))
+ IF (NRANK/=NPIO) THEN
+ IF (ALLOCATED(NINDEX)) DEALLOCATE(NINDEX)
+ ALLOCATE(NINDEX(U%NDIM_FULL))
+ ENDIF
+ IF (NRANK==NPIO) THEN
+ INB(:) = 0
+ DO JJ=1,U%NDIM_FULL
+ INB(NINDEX(JJ)) = INB(NINDEX(JJ))+1
+ NNUM(JJ) = INB(NINDEX(JJ))
+ ENDDO
+ ENDIF
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(NINDEX,SIZE(NINDEX)*KIND(NINDEX)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(NNUM,SIZE(NNUM)*KIND(NNUM)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(UG%NGRID_FULL_PAR,KIND(UG%NGRID_FULL_PAR)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ IF (NRANK/=NPIO) ALLOCATE(UG%XGRID_FULL_PAR(UG%NGRID_FULL_PAR))
+#ifdef SFX_MPI
+ CALL MPI_BCAST(UG%XGRID_FULL_PAR,&
+ SIZE(UG%XGRID_FULL_PAR)*KIND(UG%XGRID_FULL_PAR)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+#endif
+ ENDIF
+ENDIF
+!
+CATYPE = 'ARI'
!
!* 1. get full dimension of grid
!
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'FULL ',NL)
+ CALL GET_TYPE_DIM_n(DTCO, U, 'FULL ',NL)
!
!* 2. get water dimension
!
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'WATER ',IL)
+ CALL GET_TYPE_DIM_n(DTCO, U, 'WATER ',IL)
!
ALLOCATE(ZFIELD(IL))
!
!* 3. get grid informations known over full grid
!
- CALL GET_LATLONMASK_n(UG, &
- LLATLONMASK,CGRID,XGRID_PAR,NGRID_PAR)
+ CALL GET_LATLONMASK_n(UG, LLATLONMASK,CGRID,XGRID_PAR,NGRID_PAR)
!
!
SELECT CASE(HSURF)
@@ -104,8 +136,7 @@ SELECT CASE(HSURF)
CASE('TS ')
- CALL PGD_FIELD(DTCO, UG, U, USS, &
- HPROGRAM,'TS_WATER: temperature','WAT',CFILE_FLAKE, &
+ CALL PGD_FIELD(DTCO, UG, U, USS, HPROGRAM,'TS_WATER: temperature','WAT',CFILE_FLAKE, &
CTYPE,XUNDEF,ZFIELD(:))
ALLOCATE(PFIELD(IL,1))
@@ -116,8 +147,15 @@ END SELECT
!* 6. Interpolation method
! --------------------
!
- CINTERP_TYPE='NONE '
+CINTERP_TYPE='NONE '
DEALLOCATE(ZFIELD)
+!
+DEALLOCATE(NNUM)
+IF (NRANK/=NPIO) THEN
+ DEALLOCATE(NINDEX,UG%XGRID_FULL_PAR)
+ ALLOCATE(NINDEX(0))
+ENDIF
+!
IF (LHOOK) CALL DR_HOOK('PREP_FLAKE_ASCLLV',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_flake_buffer.F90 b/src/SURFEX/prep_flake_buffer.F90
index 3dd77bc0691a78e324f8eab1981d98db7cdd900d..f77563d6cd0c12c2ca4f16fdc485bf1a27163e2e 100644
--- a/src/SURFEX/prep_flake_buffer.F90
+++ b/src/SURFEX/prep_flake_buffer.F90
@@ -103,7 +103,7 @@ END SELECT
!* 4. Interpolation method
! --------------------
!
- CINTERP_TYPE='NONE'
+CINTERP_TYPE='NONE'
IF (LHOOK) CALL DR_HOOK('PREP_FLAKE_BUFFER',1,ZHOOK_HANDLE)
!
!
diff --git a/src/SURFEX/prep_flake_extern.F90 b/src/SURFEX/prep_flake_extern.F90
index dae0075344a5c7732fcd4251129f9ba821448eb7..868f1f52c256565220826d8911ab1ae1a7b77d98 100644
--- a/src/SURFEX/prep_flake_extern.F90
+++ b/src/SURFEX/prep_flake_extern.F90
@@ -3,15 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_FLAKE_EXTERN (GCP,&
- HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)
+SUBROUTINE PREP_FLAKE_EXTERN (GCP,HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)
! #################################################################################
!
!
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
-!
+USE MODD_SURFEX_MPI, ONLY : NRANK,NPIO
USE MODD_TYPE_DATE_SURF
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
!
USE MODI_PREP_GRID_EXTERN
USE MODI_READ_SURF
@@ -30,9 +29,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-!
-!
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file
@@ -68,30 +66,28 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PREP_FLAKE_EXTERN',0,ZHOOK_HANDLE)
!
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'FULL ')
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'FULL ')
!
- CALL READ_SURF(&
- HFILEPGDTYPE,'WATER',YWATER,IRESP)
+ CALL READ_SURF(HFILEPGDTYPE,'WATER',YWATER,IRESP,HDIR='-')
!
!-------------------------------------------------------------------------------------
!
!* 2. Reading of grid
! ---------------
!
- CALL PREP_GRID_EXTERN(GCP,&
- HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
+ CALL PREP_GRID_EXTERN(GCP,HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
!
- CALL READ_SURF(&
- HFILEPGDTYPE,'DIM_WATER',IDIM_WATER,IRESP)
+ CALL READ_SURF(HFILEPGDTYPE,'DIM_WATER',IDIM_WATER,IRESP,HDIR='-')
!
YRECFM='VERSION'
CALL READ_SURF(HFILEPGDTYPE,YRECFM,IVERSION,IRESP)
!
+IF (NRANK/=NPIO) INI = 0
+!
ALLOCATE(ZMASK(INI))
IF (IVERSION>=7) THEN
YRECFM='FRAC_WATER'
- CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZMASK,IRESP,HDIR='A')
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZMASK,IRESP,HDIR='E')
ELSE
ZMASK(:) = 1.
ENDIF
@@ -106,6 +102,8 @@ IF (IDIM_WATER==0) THEN
CALL ABOR1_SFX('PREP_FLAKE_EXTERN: No inland water data available in input file')
END IF
!
+IF (NRANK/=NPIO) INI = 0
+!
!---------------------------------------------------------------------------------------
SELECT CASE(HSURF)
!---------------------------------------------------------------------------------------
@@ -116,8 +114,7 @@ SELECT CASE(HSURF)
CASE('ZS ')
ALLOCATE(PFIELD(INI,1))
YRECFM='ZS'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='E')
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
!
!* 4. Sea surface temperature
@@ -127,10 +124,8 @@ SELECT CASE(HSURF)
ALLOCATE(PFIELD(INI,1))
YRECFM='TS_WATER'
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'WATER ')
- CALL READ_SURF(&
- HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'WATER ')
+ CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='E')
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
WHERE (ZMASK(:)==0.) PFIELD(:,1) = XUNDEF
!
@@ -145,64 +140,54 @@ IF (HSURF/='ZS ' .AND. HSURF/='TS ') THEN
IF (YWATER=='FLAKE ') THEN
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'WATER ')
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'WATER ')
SELECT CASE(HSURF)
CASE('T_SNOW ')
ALLOCATE(PFIELD(INI,1))
YRECFM='T_SNOW '
- CALL READ_SURF(&
- HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
+ CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='E')
!
CASE('T_ICE ')
ALLOCATE(PFIELD(INI,1))
YRECFM='T_ICE '
- CALL READ_SURF(&
- HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
+ CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='E')
!
CASE('T_MNW ')
ALLOCATE(PFIELD(INI,1))
YRECFM='T_MNW '
- CALL READ_SURF(&
- HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
+ CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='E')
!
CASE('T_BOT ')
ALLOCATE(PFIELD(INI,1))
YRECFM='T_BOT '
- CALL READ_SURF(&
- HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
+ CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='E')
!
CASE('T_B1 ')
ALLOCATE(PFIELD(INI,1))
YRECFM='T_B1 '
- CALL READ_SURF(&
- HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
+ CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='E')
!
CASE('H_SNOW ')
ALLOCATE(PFIELD(INI,1))
YRECFM='H_SNOW '
- CALL READ_SURF(&
- HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
+ CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='E')
!
CASE('H_ICE ')
ALLOCATE(PFIELD(INI,1))
YRECFM='H_ICE '
- CALL READ_SURF(&
- HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
+ CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='E')
!
CASE('H_ML ')
ALLOCATE(PFIELD(INI,1))
YRECFM='H_ML '
- CALL READ_SURF(&
- HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
+ CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='E')
!
CASE('H_B1 ')
ALLOCATE(PFIELD(INI,1))
YRECFM='H_B1 '
- CALL READ_SURF(&
- HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
+ CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='E')
!
!---------------------------------------------------------------------------------------
END SELECT
diff --git a/src/SURFEX/prep_flake_grib.F90 b/src/SURFEX/prep_flake_grib.F90
index d5cdcb12e6f743a2ad57a9d93d4d59d6e2ddb863..30989a93c8c9b586d145f64dc8ebe6c404d7c6ff 100644
--- a/src/SURFEX/prep_flake_grib.F90
+++ b/src/SURFEX/prep_flake_grib.F90
@@ -34,9 +34,6 @@ USE MODE_READ_GRIB
!
USE MODD_TYPE_DATE_SURF
!
-USE MODI_PREP_GRIB_GRID
-!
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
USE MODD_GRID_GRIB, ONLY : CGRIB_FILE
!
!
@@ -69,8 +66,6 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('PREP_FLAKE_GRIB',0,ZHOOK_HANDLE)
!
IF (TRIM(HFILE).NE.CGRIB_FILE) CGRIB_FILE=""
-!
- CALL PREP_GRIB_GRID(HFILE,KLUOUT,YINMODEL,CINGRID_TYPE,TZTIME_GRIB)
!
CALL READ_GRIB_LAND_MASK(HFILE,KLUOUT,YINMODEL,ZMASK)
!
@@ -86,7 +81,7 @@ SELECT CASE(HSURF)
!
CASE('ZS ')
SELECT CASE (YINMODEL)
- CASE ('ECMWF ','ARPEGE','ALADIN','MOCAGE')
+ CASE ('ECMWF ','ARPEGE','ALADIN','MOCAGE','HIRLAM')
CALL READ_GRIB_ZS_LAND(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD)
ALLOCATE(PFIELD(SIZE(ZFIELD),1))
PFIELD(:,1) = ZFIELD(:)
@@ -99,8 +94,8 @@ SELECT CASE(HSURF)
!
CASE('TS ')
SELECT CASE (YINMODEL)
- CASE ('ECMWF ','ARPEGE','ALADIN','MOCAGE')
- CALL READ_GRIB_T2(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD)
+ CASE ('ECMWF ','ARPEGE','ALADIN','MOCAGE','HIRLAM')
+ CALL READ_GRIB_TSWATER(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD)
ALLOCATE(PFIELD(SIZE(ZFIELD),1))
PFIELD(:,1) = ZFIELD(:)
DEALLOCATE(ZFIELD)
@@ -112,8 +107,6 @@ DEALLOCATE(ZMASK)
!
!* 4. Interpolation method
! --------------------
-!
- CINTERP_TYPE='HORIBL'
!
IF (LHOOK) CALL DR_HOOK('PREP_FLAKE_GRIB',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/prep_flake_sbl.F90 b/src/SURFEX/prep_flake_sbl.F90
deleted file mode 100644
index ed5f0f1c3b3afec8a25ca610139fd3984fb9ef2c..0000000000000000000000000000000000000000
--- a/src/SURFEX/prep_flake_sbl.F90
+++ /dev/null
@@ -1,92 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE PREP_FLAKE_SBL (FG, FSB)
-! #################################################################################
-!
-!!**** *PREP_FLAKE_SBL* - prepares FLAKE SBL fields
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/2006
-!! S. Riette 06/2009 XT, XU, XQ, XTKE are set to XUNDEF
-!! No more argument needed
-!! E. Martin 01/2012 XUNDEF fields are no more written in PREP file
-!!------------------------------------------------------------------
-!
-!
-!
-!
-USE MODD_FLAKE_GRID_n, ONLY : FLAKE_GRID_t
-USE MODD_FLAKE_SBL_n, ONLY : FLAKE_SBL_t
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!* 0.2 declarations of local variables
-!
-!
-TYPE(FLAKE_GRID_t), INTENT(INOUT) :: FG
-TYPE(FLAKE_SBL_t), INTENT(INOUT) :: FSB
-!
-INTEGER :: JLAYER
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZZF ! altitudes at half levels
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------------
-!
-
-!
-!* 1. number of levels (MUST be at least equal to 2)
-! ----------------
-!
-IF (LHOOK) CALL DR_HOOK('PREP_FLAKE_SBL',0,ZHOOK_HANDLE)
-FSB%NLVL = 6
-!
-!* 2. height of half levels (where turbulent fluxes will be)
-! ---------------------
-!
-!* Warning : ZZF(:,1) MUST BE ZERO
-ALLOCATE(ZZF(FG%NDIM,FSB%NLVL))
-ZZF(:,1) = 0.
-ZZF(:,2) = 1
-ZZF(:,3) = 3.
-ZZF(:,4) = 5.
-ZZF(:,5) = 8.
-ZZF(:,6) = 12.
-
-ALLOCATE(FSB%XZ(FG%NDIM,FSB%NLVL))
-DO JLAYER=1,FSB%NLVL-1
- FSB%XZ(:,JLAYER) = 0.5 * (ZZF(:,JLAYER)+ZZF(:,JLAYER+1))
-END DO
-FSB%XZ(:,FSB%NLVL) = 1.5 * ZZF(:,FSB%NLVL) - 0.5 * ZZF(:,FSB%NLVL-1)
-!
-DEALLOCATE(ZZF)
-!
-IF (LHOOK) CALL DR_HOOK('PREP_FLAKE_SBL',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE PREP_FLAKE_SBL
diff --git a/src/SURFEX/prep_flake_unif.F90 b/src/SURFEX/prep_flake_unif.F90
index c850f854b2c370fea7dbe9def3d413893f564748..4eb55a941b5a1299465e2ca603a65806fe96a407 100644
--- a/src/SURFEX/prep_flake_unif.F90
+++ b/src/SURFEX/prep_flake_unif.F90
@@ -127,7 +127,7 @@ END SELECT
!* 4. Interpolation method
! --------------------
!
- CINTERP_TYPE='UNIF '
+CINTERP_TYPE='UNIF '
IF (LHOOK) CALL DR_HOOK('PREP_FLAKE_UNIF',1,ZHOOK_HANDLE)
!
!
diff --git a/src/SURFEX/prep_grib_grid.F90 b/src/SURFEX/prep_grib_grid.F90
index c4d7b26ecf5338d94777a0a1865218fd11c36c66..e33be8e3a6078b50d0b609fb8b7260ac0fef1501 100644
--- a/src/SURFEX/prep_grib_grid.F90
+++ b/src/SURFEX/prep_grib_grid.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PREP_GRIB_GRID(HGRIB,KLUOUT,HINMODEL,HGRIDTYPE,TPTIME_GRIB)
+ SUBROUTINE PREP_GRIB_GRID(HGRIB,KLUOUT,HINMODEL,HGRIDTYPE,HINTERP_TYPE,TPTIME_GRIB)
! ##########################################################################
!
!!**** *PREP_GRIB_GRID* - reads GRIB grid.
@@ -35,7 +35,6 @@
!! Original 06/2003
!! S. Faroux 01/2011 : to use library GRIB_API instead of GRIBEX (from
!! read_all_data_grib_case)
-!! 05/12/2016 (G.Delautier) length of HGRID for grib_api > 1.14
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -43,15 +42,28 @@
!
USE MODD_TYPE_DATE_SURF
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC
+!
USE MODE_READ_GRIB
!
+USE MODD_HORIBL, ONLY : LGLOBLON, LGLOBS, LGLOBN, XILO1H, XILO2H, NO, NINLOH, &
+ XLA, XOLA, XOLO, NP, XLOPH
+!
+USE MODD_PREP, ONLY : XLAT_OUT, XLON_OUT, LINTERP
+!
USE MODD_GRID_ROTLATLON
-USE MODD_GRID_GAUSS, ONLY : XILA1, XILO1, XILA2, XILO2, NINLA, NINLO, NILEN, LROTPOLE, XCOEF, XLAP, XLOP
-USE MODD_GRID_AROME, ONLY : XX, XY, NX, NY, XLAT0, XLON0, XLATOR, XLONOR, XRPK, XBETA
-USE MODD_GRID_GRIB, ONLY : NNI
+USE MODD_GRID_GAUSS, ONLY : XILA1, XILO1, XILA2, XILO2, NINLA, NINLO, NILEN, LROTPOLE, XCOEF, XLAP, XLOP, &
+ XLAT, XLON
+USE MODD_GRID_AROME, ONLY : XX, XY, NX, NY, XLAT0, XLON0, XLATOR, XLONOR, XRPK, XBETA, XZX, XZY, NIX
+USE MODD_GRID_GRIB, ONLY : NNI, CGRIB_FILE
USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
USE MODD_CSTS, ONLY : XPI
!
+USE MODE_GRIDTYPE_CONF_PROJ
+USE MODI_HORIBL_SURF_INIT
+USE MODI_HORIBL_SURF_COEF
+USE MODI_ARPEGE_STRETCH_A
+!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -59,6 +71,10 @@ USE MODI_ABOR1_SFX
!
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1. Declaration of arguments
! ------------------------
!
@@ -66,36 +82,44 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
CHARACTER(LEN=6), INTENT(OUT) :: HINMODEL ! Grib originating model
CHARACTER(LEN=10), INTENT(OUT) :: HGRIDTYPE ! Grid type
+ CHARACTER(LEN=6), INTENT(OUT) :: HINTERP_TYPE ! Grid type
TYPE (DATE_TIME) :: TPTIME_GRIB ! current date and time
!
!* 0.2 Declaration of local variables
! ------------------------------
-! General purpose variables
-INTEGER(KIND=kindOfInt) :: IRET ! Return code from subroutines
!
-! Variable involved in the task of reading the grib file
+ CHARACTER(LEN=50) :: HGRID ! type of grid
+! General purpose variables
+INTEGER(KIND=kindOfInt), DIMENSION(:), ALLOCATABLE :: ININLO_GRIB
INTEGER(KIND=kindOfInt) :: IMISSING
INTEGER(KIND=kindOfInt) :: IUNIT
INTEGER(KIND=kindOfInt) :: IGRIB
+INTEGER(KIND=kindOfInt) :: IRET ! Return code from subroutines
+!
+! Variable involved in the task of reading the grib file
INTEGER :: ICENTER ! number of center
- CHARACTER(LEN=40) :: HGRID ! type of grid
INTEGER :: ISCAN, JSCAN
INTEGER :: ILENX ! nb points in X
INTEGER :: ILENY ! nb points in Y
-INTEGER :: ITIME
+INTEGER :: ITIME, IYEAR, IMONTH, IDAY
INTEGER :: IUNITTIME,IP1
+INTEGER :: INO, IINLA ! output number of points
+REAL :: ZTIME
!
! Grib Grid definition variables
INTEGER :: JLOOP1 ! Dummy counter
!JUAN
-INTEGER(KIND=kindOfInt), DIMENSION(:), ALLOCATABLE :: ININLO_GRIB
!JUAN
+INTEGER :: INFOMPI, J
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!---------------------------------------------------------------------------------------
!
-IF (LHOOK) CALL DR_HOOK('PREP_GRIB_GRID',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('PREP_GRIB_GRID_1',0,ZHOOK_HANDLE)
+!
+IF (NRANK==NPIO) THEN
+!
WRITE (KLUOUT,'(A)') ' -- Grib reader started'
!
! open grib file
@@ -105,6 +129,9 @@ IF (IRET /= 0) THEN
END IF
!
CALL GRIB_NEW_FROM_FILE(IUNIT,IGRIB,IRET)
+! needed for HIRLAM ROTLATLON (infos in the second record)
+ CALL GRIB_NEW_FROM_FILE(IUNIT,IGRIB,IRET)
+!
IF (IRET /= 0) THEN
CALL ABOR1_SFX('PREP_GRIB_GRID: Error in reading the grib file')
END IF
@@ -112,6 +139,7 @@ END IF
! close the grib file
CALL GRIB_CLOSE_FILE(IUNIT)
!
+!
!---------------------------------------------------------------------------------------
!* 2. Fix originating center
!---------------------------------------------------------------------------------------
@@ -129,9 +157,19 @@ END IF
SELECT CASE (ICENTER)
CASE (96)
- WRITE (KLUOUT,'(A)') ' | Grib file from HARMONY'
- HINMODEL='ALADIN'
- HGRIDTYPE='AROME '
+ SELECT CASE (HGRID)
+
+ CASE('rotated_ll')
+ WRITE (KLUOUT,'(A)') ' | Grib file from HIRLAM - regular latlon grid '
+ HINMODEL='HIRLAM'
+ HGRIDTYPE='ROTLATLON '
+
+ CASE DEFAULT
+ WRITE (KLUOUT,'(A)') ' | Grib file from HARMONY'
+ HINMODEL='ALADIN'
+ HGRIDTYPE='AROME '
+
+ END SELECT
CASE (82)
WRITE (KLUOUT,'(A)') ' | Grib file from HIRLAM'
@@ -163,11 +201,17 @@ SELECT CASE (ICENTER)
HINMODEL = 'MOCAGE'
HGRIDTYPE= 'LATLON '
- CASE('unknown_PLPresent','reduced_stretched_rotated_gg')
+ CASE('unknown_PLPresent')
WRITE (KLUOUT,'(A)') ' | Grib file from French Weather Service - Arpege model'
HINMODEL = 'ARPEGE'
HGRIDTYPE= 'ROTGAUSS '
+ CASE('reduced_stretched_rotated_gg')
+ WRITE (KLUOUT,'(A)') ' | Grib file from French Weather Service - Arpege model'
+ WRITE (KLUOUT,'(A)') 'but reduced grid'
+ HINMODEL = 'ARPEGE'
+ HGRIDTYPE= 'ROTGAUSS '
+
CASE('lambert')
WRITE (KLUOUT,'(A)') ' | Grib file from French Weather Service - Aladin france model'
HINMODEL = 'ALADIN'
@@ -184,7 +228,16 @@ SELECT CASE (ICENTER)
CALL ABOR1_SFX('PREP_GRIB_GRID: GRIB FILE FORMAT NOT SUPPORTED')
END SELECT
-
+ENDIF
+!
+IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(IGRIB,KIND(IGRIB)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(HINMODEL,LEN(HINMODEL),MPI_CHARACTER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(HGRIDTYPE,LEN(HGRIDTYPE),MPI_CHARACTER,NPIO,NCOMM,INFOMPI)
+#endif
+ENDIF
+!
!---------------------------------------------------------------------------------------
!* 3. Number of points
!---------------------------------------------------------------------------------------
@@ -200,34 +253,65 @@ SELECT CASE (HGRIDTYPE)
CASE ('AROME ','MERCATOR ')
! 3.1 Lambert conformal projection (ALADIN files)
! or Mercator projection (ALADIN REUNION files)
- CALL GRIB_GET(IGRIB,'Nj',NY,IRET)
- CALL GRIB_GET(IGRIB,'Ni',NX,IRET)
+ IF (NRANK==NPIO) THEN
+ CALL GRIB_GET(IGRIB,'Nj',NY,IRET)
+ CALL GRIB_GET(IGRIB,'Ni',NX,IRET)
+ ENDIF
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(NY,KIND(NY)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(NX,KIND(NX)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ ENDIF
NNI= NX * NY
!
!
- CASE ('GAUSS ','ROTGAUSS ','LATLON ')
+ CASE ('GAUSS ','ROTGAUSS ','LATLON ')
! 3.2 Usual or Gaussian lat,lon grid (ECMWF files)
!
- CALL GRIB_GET(IGRIB,'Nj',NINLA,IRET)
+
+ IF (NRANK==NPIO) CALL GRIB_GET(IGRIB,'Nj',NINLA,IRET)
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(NINLA,KIND(NINLA)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ ENDIF
ALLOCATE (NINLO(NINLA))
- ALLOCATE (ININLO_GRIB(NINLA))
NILEN = 0
- CALL GRIB_IS_MISSING(IGRIB,'pl',IMISSING,IRET)
- IF (IRET /= 0 .OR. IMISSING==1) THEN ! regular
- CALL GRIB_GET(IGRIB,'Ni',ININLO_GRIB(1),IRET)
- ININLO_GRIB(2:NINLA)=ININLO_GRIB(1)
- NILEN=NINLA*ININLO_GRIB(1)
- ELSE ! quasi-regular
- CALL GRIB_GET(IGRIB,'pl',ININLO_GRIB)
- DO JLOOP1=1 ,NINLA
- NILEN = NILEN + ININLO_GRIB(JLOOP1)
- ENDDO
+ IF (NRANK==NPIO) THEN
+ ALLOCATE (ININLO_GRIB(NINLA))
+ CALL GRIB_IS_MISSING(IGRIB,'pl',IMISSING,IRET)
+ IF (IRET /= 0 .OR. IMISSING==1) THEN ! regular
+ CALL GRIB_GET(IGRIB,'Ni',ININLO_GRIB(1),IRET)
+ ININLO_GRIB(2:NINLA)=ININLO_GRIB(1)
+ NILEN=NINLA*ININLO_GRIB(1)
+ ELSE ! quasi-regular
+ CALL GRIB_GET(IGRIB,'pl',ININLO_GRIB)
+ DO JLOOP1=1 ,NINLA
+ NILEN = NILEN + ININLO_GRIB(JLOOP1)
+ ENDDO
+ ENDIF
+ NINLO = ININLO_GRIB !JUAN
+ DEALLOCATE(ININLO_GRIB)
+ ENDIF
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(NILEN,KIND(NILEN)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(NINLO,SIZE(NINLO)*KIND(NINLO)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
ENDIF
NNI = NILEN
- NINLO = ININLO_GRIB !JUAN
- CASE ('ROTLATLON')
+ CASE ('ROTLATLON ')
+ IF (NRANK==NPIO) THEN
CALL GRIB_GET(IGRIB,'Nj',NRY,IRET)
- CALL GRIB_GET(IGRIB,'Ni',NRX,IRET)
+ CALL GRIB_GET(IGRIB,'Ni',NRX,IRET)
+ ENDIF
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(NRY,KIND(NRY)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(NRX,KIND(NRX)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ ENDIF
NNI = NRX * NRY
CASE DEFAULT
@@ -255,18 +339,42 @@ SELECT CASE (HGRIDTYPE)
CASE ('AROME ')
! 4.1 Lambert conformal projection (ALADIN files)
!
+ IF (NRANK==NPIO) THEN
CALL GRIB_GET(IGRIB,'xDirectionGridLength',ILENX)
- CALL GRIB_GET(IGRIB,'yDirectionGridLength',ILENY)
+ CALL GRIB_GET(IGRIB,'yDirectionGridLength',ILENY)
XY = (NY-1)*ILENY
XX = (NX-1)*ILENX
+ ENDIF
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(XY,KIND(XY)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XX,KIND(XX)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+#endif
+ ENDIF
- CALL GRIB_GET(IGRIB,'Latin1InDegrees',XLAT0)
- CALL GRIB_GET(IGRIB,'LoVInDegrees',XLON0)
+ IF (NRANK==NPIO) THEN
+ CALL GRIB_GET(IGRIB,'Latin1InDegrees',XLAT0)
+ CALL GRIB_GET(IGRIB,'LoVInDegrees',XLON0)
IF (XLON0 > 180.) XLON0 = XLON0 - 360.
+ ENDIF
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(XLAT0,KIND(XLAT0)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XLON0,KIND(XLON0)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+#endif
+ ENDIF
+ IF (NRANK==NPIO) THEN
CALL GRIB_GET(IGRIB,'latitudeOfFirstGridPointInDegrees',XLATOR)
CALL GRIB_GET(IGRIB,'longitudeOfFirstGridPointInDegrees',XLONOR)
IF (XLONOR > 180.) XLONOR = XLONOR - 360.
+ ENDIF
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(XLATOR,KIND(XLATOR)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XLONOR,KIND(XLONOR)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+#endif
+ ENDIF
XRPK = SIN(XLAT0/180.*XPI)
XBETA = 0.
@@ -276,10 +384,20 @@ SELECT CASE (HGRIDTYPE)
! 4.2 Usual or Gaussian lat,lon grid (ECMWF files)
! No projection - just stores the grid definition
!
+ IF (NRANK==NPIO) THEN
CALL GRIB_GET(IGRIB,'latitudeOfFirstGridPointInDegrees',XILA1)
CALL GRIB_GET(IGRIB,'longitudeOfFirstGridPointInDegrees',XILO1)
CALL GRIB_GET(IGRIB,'latitudeOfLastGridPointInDegrees',XILA2)
CALL GRIB_GET(IGRIB,'longitudeOfLastGridPointInDegrees',XILO2)
+ ENDIF
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(XILA1,KIND(XILA1)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XILO1,KIND(XILO1)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XILA2,KIND(XILA2)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XILO2,KIND(XILO2)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+#endif
+ ENDIF
LROTPOLE = .FALSE.
!
@@ -287,78 +405,116 @@ SELECT CASE (HGRIDTYPE)
!
! 4.2.5 Rotated lat/lon grid (HIRLAM)
!
+ IF (NRANK==NPIO) THEN
CALL GRIB_GET(IGRIB,'iScansNegatively',ISCAN)
- CALL GRIB_GET(IGRIB,'jScansNegatively',JSCAN)
+ CALL GRIB_GET(IGRIB,'jScansPositively',JSCAN)
- IF (ISCAN+JSCAN == 0 ) THEN
+ IF (ISCAN+JSCAN == 0 ) THEN !lon (i) positive, lat (j) negative
CALL GRIB_GET(IGRIB,'latitudeOfFirstGridPointInDegrees',XRILA2)
CALL GRIB_GET(IGRIB,'longitudeOfFirstGridPointInDegrees',XRILO1)
CALL GRIB_GET(IGRIB,'latitudeOfLastGridPointInDegrees',XRILA1)
CALL GRIB_GET(IGRIB,'longitudeOfLastGridPointInDegrees',XRILO2)
- ELSEIF (ISCAN+JSCAN == 2) THEN
+ ELSEIF (ISCAN+JSCAN == 2) THEN ! lon (i) negative, lat (j) positive
CALL GRIB_GET(IGRIB,'latitudeOfFirstGridPointInDegrees',XRILA1)
CALL GRIB_GET(IGRIB,'longitudeOfFirstGridPointInDegrees',XRILO2)
CALL GRIB_GET(IGRIB,'latitudeOfLastGridPointInDegrees',XRILA2)
CALL GRIB_GET(IGRIB,'longitudeOfLastGridPointInDegrees',XRILO1)
- ELSEIF (ISCAN == 1) THEN
+ ELSEIF (ISCAN == 1) THEN ! lon (i) negative, lat (j) negative)
CALL GRIB_GET(IGRIB,'latitudeOfFirstGridPointInDegrees',XRILA2)
CALL GRIB_GET(IGRIB,'longitudeOfFirstGridPointInDegrees',XRILO2)
CALL GRIB_GET(IGRIB,'latitudeOfLastGridPointInDegrees',XRILA1)
CALL GRIB_GET(IGRIB,'longitudeOfLastGridPointInDegrees',XRILO1)
- ELSEIF (JSCAN == 1) THEN
+ ELSEIF (JSCAN == 1) THEN ! lon (i) positive, lat (j) positive
CALL GRIB_GET(IGRIB,'latitudeOfFirstGridPointInDegrees',XRILA1)
CALL GRIB_GET(IGRIB,'longitudeOfFirstGridPointInDegrees',XRILO1)
CALL GRIB_GET(IGRIB,'latitudeOfLastGridPointInDegrees',XRILA2)
CALL GRIB_GET(IGRIB,'longitudeOfLastGridPointInDegrees',XRILO2)
ENDIF
- CALL GRIB_GET(IGRIB,'latitudeOfSouthernPoleInDegrees',XRLAP)
- CALL GRIB_GET(IGRIB,'longitudeOfSouthernPoleInDegrees',XRLOP)
+ CALL GRIB_GET(IGRIB,'latitudeOfSouthernPoleInDegrees',XRLAP)
+ CALL GRIB_GET(IGRIB,'longitudeOfSouthernPoleInDegrees',XRLOP)
CALL GRIB_GET(IGRIB,'iDirectionIncrementInDegrees',XRDX)
CALL GRIB_GET(IGRIB,'jDirectionIncrementInDegrees',XRDY)
-
WRITE(KLUOUT,*)'XRILA1,XRILO1',XRILA1,XRILO1
WRITE(KLUOUT,*)'XRILA2,XRILO2',XRILA2,XRILO2
WRITE(KLUOUT,*)'XRLAP,XRLOP',XRLAP,XRLOP
WRITE(KLUOUT,*)'XRDX,XRDY',XRDX,XRDY
+ ENDIF
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(XRILA1,KIND(XRILA1)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XRILO1,KIND(XRILO1)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XRILA2,KIND(XRILA2)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XRILO2,KIND(XRILO2)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XRLAP,KIND(XRLAP)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XRLOP,KIND(XRLOP)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XRDX,KIND(XRDX)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XRDY,KIND(XRDY)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+#endif
+ ENDIF
+
!
CASE ('ROTGAUSS ')
! 4.3 Stretched lat,lon grid (Arpege files)
!
HGRIDTYPE = 'GAUSS '
+ IF (NRANK==NPIO) THEN
CALL GRIB_GET(IGRIB,'latitudeOfFirstGridPointInDegrees',XILA1)
CALL GRIB_GET(IGRIB,'longitudeOfFirstGridPointInDegrees',XILO1)
CALL GRIB_GET(IGRIB,'latitudeOfLastGridPointInDegrees',XILA2)
CALL GRIB_GET(IGRIB,'longitudeOfLastGridPointInDegrees',XILO2)
- LROTPOLE = .TRUE.
CALL GRIB_GET(IGRIB,'stretchingFactor',XCOEF)
CALL GRIB_GET(IGRIB,'latitudeOfStretchingPoleInDegrees',XLAP)
CALL GRIB_GET(IGRIB,'longitudeOfStretchingPoleInDegrees',XLOP)
+ ENDIF
+ LROTPOLE = .TRUE.
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(XILA1,KIND(XILA1)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XILO1,KIND(XILO1)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XILA2,KIND(XILA2)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XILO2,KIND(XILO2)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XCOEF,KIND(XCOEF)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XLAP,KIND(XLAP)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XLOP,KIND(XLOP)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+#endif
+ ENDIF
+
!
CASE ('MERCATOR ')
! 4.4 Mercator projection (ALADIN Reunion files)
!
HGRIDTYPE = 'AROME '
+ IF (NRANK==NPIO) THEN
CALL GRIB_GET(IGRIB,'Dj',ILENY)
CALL GRIB_GET(IGRIB,'Di',ILENX)
XY = (NY-1)*ILENY
XX = (NX-1)*ILENX
CALL GRIB_GET(IGRIB,'LaDInDegrees',XLAT0)
- XLON0 = 0.
CALL GRIB_GET(IGRIB,'latitudeOfFirstGridPointInDegrees',XLATOR)
CALL GRIB_GET(IGRIB,'longitudeOfFirstGridPointInDegrees',XLONOR)
IF (XLONOR > 180.) XLONOR = XLONOR - 360.
-
+ ENDIF
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(XY,KIND(XY)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XX,KIND(XX)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XLAT0,KIND(XLAT0)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XLATOR,KIND(XLATOR)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(XLONOR,KIND(XLONOR)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+#endif
+ ENDIF
+ XLON0 = 0.
XRPK = 0.
XBETA = 0.
CASE DEFAULT
- WRITE (KLUOUT,'(A)') 'No such projection implemented in prep_grib_grid ',HGRID
+ IF (NRANK==NPIO) WRITE (KLUOUT,'(A)') 'No such projection implemented in prep_grib_grid ',HGRID
CALL ABOR1_SFX('PREP_GRIB_GRID: UNKNOWN PROJECTION')
!
END SELECT
@@ -368,30 +524,122 @@ END SELECT
!
WRITE (KLUOUT,'(A)') ' | Reading date'
!
- CALL GRIB_GET(IGRIB,'year',TPTIME_GRIB%TDATE%YEAR,IRET)
- CALL GRIB_GET(IGRIB,'month',TPTIME_GRIB%TDATE%MONTH,IRET)
- CALL GRIB_GET(IGRIB,'day',TPTIME_GRIB%TDATE%DAY,IRET)
+IF (NRANK==NPIO) THEN
+ CALL GRIB_GET(IGRIB,'year',IYEAR,IRET)
+ CALL GRIB_GET(IGRIB,'month',IMONTH,IRET)
+ CALL GRIB_GET(IGRIB,'day',IDAY,IRET)
CALL GRIB_GET(IGRIB,'time',ITIME,IRET)
-TPTIME_GRIB%TIME=INT(ITIME/100)*3600+(ITIME-INT(ITIME/100)*100)*60
+ZTIME=INT(ITIME/100)*3600+(ITIME-INT(ITIME/100)*100)*60
!
CALL GRIB_GET(IGRIB,'P1',IP1,IRET)
IF ( IP1>0 ) THEN
CALL GRIB_GET(IGRIB,'unitOfTimeRange',IUNITTIME,IRET)
SELECT CASE (IUNITTIME) ! Time unit indicator
CASE (1) !hour
- TPTIME_GRIB%TIME = TPTIME_GRIB%TIME + IP1*3600.
+ ZTIME = ZTIME + IP1*3600.
CASE (0) !minute
- TPTIME_GRIB%TIME = TPTIME_GRIB%TIME + IP1*60.
+ ZTIME = ZTIME + IP1*60.
END SELECT
ENDIF
+ENDIF
+!
+IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(IYEAR,KIND(IYEAR)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(IMONTH,KIND(IMONTH)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(IDAY,KIND(IDAY)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(ZTIME,KIND(ZTIME)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+#endif
+ENDIF
+
+TPTIME_GRIB%TDATE%YEAR = IYEAR
+TPTIME_GRIB%TDATE%MONTH = IMONTH
+TPTIME_GRIB%TDATE%DAY = IDAY
+TPTIME_GRIB%TIME = ZTIME
!
!---------------------------------------------------------------------------------------
!
- CALL GRIB_RELEASE(IGRIB,IRET)
+IF (NRANK==NPIO) THEN
+CALL GRIB_RELEASE(IGRIB,IRET)
IF (IRET /= 0) THEN
CALL ABOR1_SFX('PREP_GRIB_GRID: Error in releasing the grib message memory')
END IF
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('PREP_GRIB_GRID_1',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('PREP_GRIB_GRID_2',0,ZHOOK_HANDLE)
+!
+IF (ALLOCATED(XLAT_OUT)) THEN
+
+ INO = SIZE(XLAT_OUT)
+
+ IF (HGRIDTYPE=='GAUSS ') THEN
+ IF (ALLOCATED(XLAT)) DEALLOCATE(XLAT)
+ IF (ALLOCATED(XLON)) DEALLOCATE(XLON)
+ ALLOCATE(XLAT (INO))
+ ALLOCATE(XLON (INO))
+ IF (LROTPOLE) THEN
+!* transformation of output latitudes, longitudes into rotated coordinates
+ CALL ARPEGE_STRETCH_A(INO,XLAP,XLOP,XCOEF,XLAT_OUT,XLON_OUT,XLAT,XLON)
+ ELSE
+ XLAT = XLAT_OUT
+ XLON = XLON_OUT
+ END IF
+ ELSEIF (HGRIDTYPE=='AROME ') THEN
+ IF (ALLOCATED(XZX)) DEALLOCATE(XZX)
+ IF (ALLOCATED(XZY)) DEALLOCATE(XZY)
+ IF (ALLOCATED(NIX)) DEALLOCATE(NIX)
+ ALLOCATE(XZX (INO))
+ ALLOCATE(XZY (INO))
+ ALLOCATE(NIX(NY))
+ NIX=NX
+ CALL XY_CONF_PROJ(XLAT0,XLON0,XRPK,XBETA,XLATOR,XLONOR,XZX,XZY,XLAT_OUT,XLON_OUT)
+ ELSEIF (HGRIDTYPE=='ROTLATLON ') THEN
+ ENDIF
+!
+ IF (ALLOCATED(NO)) DEALLOCATE(NO)
+ IF (ALLOCATED(XLA)) DEALLOCATE(XLA)
+ IF (ALLOCATED(XOLA)) DEALLOCATE(XOLA)
+ IF (ALLOCATED(XOLO)) DEALLOCATE(XOLO)
+ IF (ALLOCATED(NINLOH)) DEALLOCATE(NINLOH)
+
+ ALLOCATE(NO(INO,4))
+ ALLOCATE(XOLA(INO),XOLO(INO))
+ ALLOCATE(XLA(INO,4))
+!
+
+ !
+ IF (HGRIDTYPE=='GAUSS ') THEN
+ IINLA = NINLA
+ ALLOCATE(NINLOH(IINLA+4))
+ CALL HORIBL_SURF_INIT(XILA1,XILO1,XILA2,XILO2,NINLA,NINLO,INO,XLON,XLAT, &
+ LINTERP,LGLOBLON,LGLOBN,LGLOBS,NO, &
+ NINLOH,XOLA,XOLO,XILO1H,XILO2H,XLA)
+ ELSEIF (HGRIDTYPE=='AROME ') THEN
+ IINLA = NY
+ ALLOCATE(NINLOH(IINLA+4))
+ CALL HORIBL_SURF_INIT(0.,0.,XY,XX,NY,NIX,INO,XZX,XZY, &
+ LINTERP,LGLOBLON,LGLOBN,LGLOBS,NO, &
+ NINLOH,XOLA,XOLO,XILO1H,XILO2H,XLA)
+ ENDIF
+!
+ IF (ALLOCATED(NP)) DEALLOCATE(NP)
+ IF (ALLOCATED(XLOPH)) DEALLOCATE(XLOPH)
+ ALLOCATE(NP(INO,12))
+ ALLOCATE(XLOPH(INO,12))
+
+ IF (LGLOBS) IINLA = IINLA + 2
+ IF (LGLOBN) IINLA = IINLA + 2
+
+ IF (HGRIDTYPE=='GAUSS '.OR.HGRIDTYPE=='AROME ') THEN
+ CALL HORIBL_SURF_COEF(INO,LINTERP,LGLOBLON,XILO1H,XILO2H,XOLO,&
+ NO,NINLOH(1:IINLA),NP,XLOPH)
+ ENDIF
+!
+ENDIF
+!
+HINTERP_TYPE = "HORIBL"
!
-IF (LHOOK) CALL DR_HOOK('PREP_GRIB_GRID',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('PREP_GRIB_GRID_2',1,ZHOOK_HANDLE)
!
END SUBROUTINE PREP_GRIB_GRID
diff --git a/src/SURFEX/prep_grid_cartesian.F90 b/src/SURFEX/prep_grid_cartesian.F90
index edef06fde55b29aaa904aa029feba55c21994bb6..e42577e32ab0ab9f77e9ebb6bb02102eab7b4291 100644
--- a/src/SURFEX/prep_grid_cartesian.F90
+++ b/src/SURFEX/prep_grid_cartesian.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PREP_GRID_CARTESIAN (&
- HFILETYPE,HINTERP_TYPE,KNI)
+ SUBROUTINE PREP_GRID_CARTESIAN (HFILETYPE,HINTERP_TYPE,KNI)
! ##########################################################################
!
!!**** *PREP_GRID_CARTESIAN* - reads EXTERNALIZED Surface grid.
@@ -64,11 +63,11 @@ INTEGER, INTENT(OUT) :: KNI ! number of points
!* 0.2 Declaration of local variables
! ------------------------------
!
+REAL, DIMENSION(:), ALLOCATABLE :: ZW ! work array
CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+ CHARACTER(LEN=1) :: YDIR
INTEGER :: IRESP
-!
INTEGER :: JL ! loop counter
-REAL, DIMENSION(:), ALLOCATABLE :: ZW ! work array
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-----------------------------------------------------------------------
@@ -86,13 +85,16 @@ YRECFM = 'JMAX'
!
KNI = NX * NY
!
+YDIR = '-'
+IF (HFILETYPE=='MESONH') YDIR = 'A'
+!
ALLOCATE(ZW(KNI))
!
IF (ALLOCATED(XX)) DEALLOCATE(XX)
ALLOCATE(XX(NX))
YRECFM = 'XX'
CALL READ_SURF(&
- HFILETYPE,YRECFM,ZW,IRESP,HDIR='A')
+ HFILETYPE,YRECFM,ZW,IRESP,HDIR=YDIR)
XX = ZW(1:NX)
@@ -100,7 +102,7 @@ IF (ALLOCATED(XY)) DEALLOCATE(XY)
ALLOCATE(XY(NY))
YRECFM = 'YY'
CALL READ_SURF(&
- HFILETYPE,YRECFM,ZW,IRESP,HDIR='A')
+ HFILETYPE,YRECFM,ZW,IRESP,HDIR=YDIR)
DO JL=1,KNI
IF (MOD(JL,NX)==0) XY(JL/NX) = ZW(JL)
END DO
diff --git a/src/SURFEX/prep_grid_conf_proj.F90 b/src/SURFEX/prep_grid_conf_proj.F90
index 51a9cd44a0a2fbdd738817950b44c78733dd0095..507fc0cf69b1430cfd07deac80ad0d65b55aa3c4 100644
--- a/src/SURFEX/prep_grid_conf_proj.F90
+++ b/src/SURFEX/prep_grid_conf_proj.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PREP_GRID_CONF_PROJ (GCP,&
- HFILETYPE,HINTERP_TYPE,KNI)
+ SUBROUTINE PREP_GRID_CONF_PROJ (GCP,HFILETYPE,HINTERP_TYPE,KNI)
! ##########################################################################
!
!!**** *PREP_GRID_CONF_PROJ* - reads EXTERNALIZED Surface grid.
@@ -44,7 +43,7 @@
!
USE MODI_READ_SURF
!
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t,XX,XY
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t, XX, XY
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -54,22 +53,21 @@ IMPLICIT NONE
!* 0.1. Declaration of arguments
! ------------------------
!
-!
-!
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
-CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! file type
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! file type
CHARACTER(LEN=6), INTENT(OUT) :: HINTERP_TYPE ! Grid type
INTEGER, INTENT(OUT) :: KNI ! number of points
!
!* 0.2 Declaration of local variables
! ------------------------------
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZW ! work array
!
CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+ CHARACTER(LEN=1) :: YDIR
INTEGER :: IRESP
-!
-!
INTEGER :: JL ! loop counter
-REAL, DIMENSION(:), ALLOCATABLE :: ZW ! work array
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-----------------------------------------------------------------------
@@ -79,17 +77,13 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PREP_GRID_CONF_PROJ',0,ZHOOK_HANDLE)
YRECFM = 'LAT0'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,GCP%XLAT0,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,GCP%XLAT0,IRESP)
YRECFM = 'LON0'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,GCP%XLON0,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,GCP%XLON0,IRESP)
YRECFM = 'RPK'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,GCP%XRPK,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,GCP%XRPK,IRESP)
YRECFM = 'BETA'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,GCP%XBETA,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,GCP%XBETA,IRESP)
!
!-----------------------------------------------------------------------
!
@@ -97,36 +91,33 @@ YRECFM = 'BETA'
! ----
!
YRECFM = 'LATORI'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,GCP%XLATORI,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,GCP%XLATORI,IRESP)
YRECFM = 'LONORI'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,GCP%XLONORI,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,GCP%XLONORI,IRESP)
!
YRECFM = 'IMAX'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,GCP%NX,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,GCP%NX,IRESP)
YRECFM = 'JMAX'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,GCP%NY,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,GCP%NY,IRESP)
!
KNI = GCP%NX * GCP%NY
!
+YDIR = '-'
+IF (HFILETYPE=='MESONH') YDIR = 'A'
+!
ALLOCATE(ZW(KNI))
!
IF (ALLOCATED(XX)) DEALLOCATE(XX)
ALLOCATE(XX(GCP%NX))
YRECFM = 'XX'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,ZW,IRESP,HDIR='A')
+ CALL READ_SURF(HFILETYPE,YRECFM,ZW,IRESP,HDIR=YDIR)
XX = ZW(1:GCP%NX)
IF (ALLOCATED(XY)) DEALLOCATE(XY)
ALLOCATE(XY(GCP%NY))
YRECFM = 'YY'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,ZW,IRESP,HDIR='A')
+ CALL READ_SURF(HFILETYPE,YRECFM,ZW,IRESP,HDIR=YDIR)
DO JL=1,KNI
IF (MOD(JL,GCP%NX)==0) XY(JL/GCP%NX) = ZW(JL)
END DO
diff --git a/src/SURFEX/prep_grid_extern.F90 b/src/SURFEX/prep_grid_extern.F90
index 41b89edb0d949fed8307056ce134edd1b4f5fd94..0e01f370adbe7217d7e7ed1b53c5aa6c7aa3de6e 100644
--- a/src/SURFEX/prep_grid_extern.F90
+++ b/src/SURFEX/prep_grid_extern.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PREP_GRID_EXTERN (GCP,&
- HFILETYPE,KLUOUT,HGRIDTYPE,HINTERP_TYPE,KNI)
+ SUBROUTINE PREP_GRID_EXTERN (GCP,HFILETYPE,KLUOUT,HGRIDTYPE,HINTERP_TYPE,KNI)
! ##########################################################################
!
!!**** *PREP_GRID_EXTERN* - reads EXTERNALIZED Surface grid.
@@ -39,15 +38,30 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t, XX, XY, XCX, XCY, NCIJ
!
+USE MODD_SURFEX_MPI, ONLY : WLOG_MPI, NRANK, NPIO, NPROC, NCOMM
+USE MODD_HORIBL, ONLY : LGLOBLON, LGLOBS, LGLOBN, XILO1H, XILO2H, NINLOH, &
+ XLA, XOLA, XOLO, NP, XLOPH, NO
+USE MODD_PREP, ONLY : XLAT_OUT, XLON_OUT, LINTERP, XX_OUT, XY_OUT
!
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_GRID_GAUSS, ONLY : XILA1, XILO1, XILA2, XILO2, NINLA, NINLO, NILEN, LROTPOLE, &
+ XLAP, XLOP, XCOEF, XLAT, XLON, XILATARRAY_g=>XILATARRAY
+USE MODD_GRID_LATLONREGUL, ONLY : XILAT1,XILON1,XILAT2,XILON2,NINLAT,NINLON,NILENGTH,&
+ XILATARRAY_l=>XILATARRAY
+USE MODD_GRID_CARTESIAN, ONLY : XX_ca=>XX, XY_ca=>XY, NCIJ_ca=>NCIJ, XCX_ca=>XCX, XCY_ca=>XCY
!
+USE MODE_GRIDTYPE_CONF_PROJ
+!
+USE MODI_BILIN_COEF
USE MODI_READ_SURF
USE MODI_PREP_GRID_CONF_PROJ
USE MODI_PREP_GRID_CARTESIAN
USE MODI_PREP_GRID_GAUSS
USE MODI_PREP_GRID_LONLAT_REG
+USE MODI_HORIBL_SURF_INIT
+USE MODI_HORIBL_SURF_COEF
+USE MODI_ARPEGE_STRETCH_A
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -59,9 +73,8 @@ IMPLICIT NONE
!* 0.1. Declaration of arguments
! ------------------------
!
-!
-!
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! file type
INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
CHARACTER(LEN=10), INTENT(OUT) :: HGRIDTYPE ! Grid type
@@ -71,6 +84,7 @@ INTEGER, INTENT(OUT) :: KNI ! number of points
!* 0.2 Declaration of local variables
! ------------------------------
!
+INTEGER :: IINLA, INO
INTEGER :: IRESP
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -80,8 +94,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ------------
!
IF (LHOOK) CALL DR_HOOK('PREP_GRID_EXTERN',0,ZHOOK_HANDLE)
- CALL READ_SURF(&
- HFILETYPE,'GRID_TYPE',HGRIDTYPE,IRESP)
+ CALL READ_SURF(HFILETYPE,'GRID_TYPE',HGRIDTYPE,IRESP,HDIR='-')
!
!-----------------------------------------------------------------------
!
@@ -89,22 +102,104 @@ IF (LHOOK) CALL DR_HOOK('PREP_GRID_EXTERN',0,ZHOOK_HANDLE)
! ---------------
!
IF (HGRIDTYPE=='CONF PROJ ') THEN
- CALL PREP_GRID_CONF_PROJ(GCP,&
- HFILETYPE,HINTERP_TYPE,KNI)
+ CALL PREP_GRID_CONF_PROJ(GCP,HFILETYPE,HINTERP_TYPE,KNI)
ELSE IF (HGRIDTYPE=='CARTESIAN ') THEN
- CALL PREP_GRID_CARTESIAN(&
- HFILETYPE,HINTERP_TYPE,KNI)
+ CALL PREP_GRID_CARTESIAN(HFILETYPE,HINTERP_TYPE,KNI)
ELSE IF (HGRIDTYPE=='GAUSS ') THEN
- CALL PREP_GRID_GAUSS(&
- HFILETYPE,HINTERP_TYPE,KNI)
+ CALL PREP_GRID_GAUSS(HFILETYPE,HINTERP_TYPE,KNI)
ELSE IF (HGRIDTYPE=='LONLAT REG') THEN
HGRIDTYPE = 'LATLON '
- CALL PREP_GRID_LONLAT_REG(&
- HFILETYPE,HINTERP_TYPE,KNI)
+ CALL PREP_GRID_LONLAT_REG(HFILETYPE,HINTERP_TYPE,KNI)
ELSE
WRITE(KLUOUT,*) 'GRIDTYPE "',HGRIDTYPE,'" NOT ACCEPTED AS INPUT FILE FOR FIELD PREPARATION'
CALL ABOR1_SFX('GRIDTYPE NOT ACCEPTED AS INPUT FILE FOR FIELD PREPARATION, '//HGRIDTYPE)
END IF
+!
+IF (ALLOCATED(XLAT_OUT)) THEN
+ !
+ INO = SIZE(XLAT_OUT)
+ !
+ IF (HGRIDTYPE=='GAUSS ' .OR. HGRIDTYPE=='LATLON ') THEN
+ !
+ IF (HGRIDTYPE=='GAUSS ') THEN
+ IF (ALLOCATED(XLAT)) DEALLOCATE(XLAT)
+ IF (ALLOCATED(XLON)) DEALLOCATE(XLON)
+ ALLOCATE(XLAT (INO))
+ ALLOCATE(XLON (INO))
+ IF (LROTPOLE) THEN
+!* transformation of output latitudes, longitudes into rotated coordinates
+ CALL ARPEGE_STRETCH_A(INO,XLAP,XLOP,XCOEF,XLAT_OUT,XLON_OUT,XLAT,XLON)
+ ELSE
+ XLAT = XLAT_OUT
+ XLON = XLON_OUT
+ END IF
+ ENDIF
+!
+ IF (ALLOCATED(NO)) DEALLOCATE(NO)
+ IF (ALLOCATED(XLA)) DEALLOCATE(XLA)
+ IF (ALLOCATED(XOLA)) DEALLOCATE(XOLA)
+ IF (ALLOCATED(XOLO)) DEALLOCATE(XOLO)
+ IF (ALLOCATED(NINLOH)) DEALLOCATE(NINLOH)
+
+ ALLOCATE(NO(INO,4))
+ ALLOCATE(XOLA(INO),XOLO(INO))
+ ALLOCATE(XLA(INO,4))
+ !
+ IF (HGRIDTYPE=='GAUSS ') THEN
+ IINLA = NINLA
+ ALLOCATE(NINLOH(IINLA+4))
+ CALL HORIBL_SURF_INIT(XILA1,XILO1,XILA2,XILO2,NINLA,NINLO,INO,XLON,XLAT, &
+ LINTERP,LGLOBLON,LGLOBN,LGLOBS,NO, &
+ NINLOH,XOLA,XOLO,XILO1H,XILO2H,XLA,XILATARRAY_g)
+ ELSEIF (HGRIDTYPE=='LATLON ') THEN
+ IINLA = NINLAT
+ ALLOCATE(NINLOH(IINLA+4))
+ CALL HORIBL_SURF_INIT(XILAT1,XILON1,XILAT2,XILON2,NINLAT,NINLON, &
+ INO,XLON_OUT,XLAT_OUT,LINTERP,LGLOBLON,&
+ LGLOBN,LGLOBS,NO,NINLOH,XOLA,XOLO,XILO1H,&
+ XILO2H,XLA,XILATARRAY_l)
+
+ ENDIF
+ !
+ IF (ALLOCATED(NP)) DEALLOCATE(NP)
+ IF (ALLOCATED(XLOPH)) DEALLOCATE(XLOPH)
+ ALLOCATE(NP(INO,12))
+ ALLOCATE(XLOPH(INO,12))
+
+ IF (LGLOBS) IINLA = IINLA + 2
+ IF (LGLOBN) IINLA = IINLA + 2
+ CALL HORIBL_SURF_COEF(INO,LINTERP,LGLOBLON,XILO1H,XILO2H,XOLO,&
+ NO,NINLOH(1:IINLA),NP,XLOPH)
+ !
+ ELSEIF (HGRIDTYPE=='CONF PROJ ') THEN
+ !
+ IF (ALLOCATED(XCX)) DEALLOCATE(XCX)
+ IF (ALLOCATED(XCY)) DEALLOCATE(XCY)
+ IF (ALLOCATED(NCIJ)) DEALLOCATE(NCIJ)
+ ALLOCATE(XCX(INO,3),XCY(INO,3),NCIJ(INO,2))
+ !
+ !* 2. Transformation of latitudes/longitudes into metric coordinates of output grid
+ !
+ CALL XY_CONF_PROJ(GCP%XLAT0,GCP%XLON0,GCP%XRPK,GCP%XBETA,GCP%XLATORI,GCP%XLONORI, &
+ XX_OUT,XY_OUT,XLAT_OUT,XLON_OUT )
+ !
+ !* 3. Put input field on its squared grid
+ !
+ CALL BILIN_COEF(KLUOUT,XX,XY,XX_OUT,XY_OUT,XCX,XCY,NCIJ(:,1),NCIJ(:,2))
+ !
+ ELSEIF (HGRIDTYPE=='CARTESIAN ') THEN
+ !
+ IF (ALLOCATED(XCX_ca)) DEALLOCATE(XCX_ca)
+ IF (ALLOCATED(XCY_ca)) DEALLOCATE(XCY_ca)
+ IF (ALLOCATED(NCIJ_ca)) DEALLOCATE(NCIJ_ca)
+ ALLOCATE(XCX_ca(INO,3),XCY_ca(INO,3),NCIJ_ca(INO,2))
+ !
+ CALL BILIN_COEF(KLUOUT,XX_ca,XY_ca,XX_OUT,XY_OUT,XCX_ca,XCY_ca,NCIJ_ca(:,1),NCIJ_ca(:,2))
+ !
+ ENDIF
+ !
+ENDIF
+!
IF (LHOOK) CALL DR_HOOK('PREP_GRID_EXTERN',1,ZHOOK_HANDLE)
!
!-----------------------------------------------------------------------
diff --git a/src/SURFEX/prep_grid_gauss.F90 b/src/SURFEX/prep_grid_gauss.F90
index d032796093b226684261ca619f3f8fdc9df9e367..205b94efb7c5f036c93b88f07f71508b9d88634c 100644
--- a/src/SURFEX/prep_grid_gauss.F90
+++ b/src/SURFEX/prep_grid_gauss.F90
@@ -46,7 +46,8 @@
!
USE MODI_READ_SURF
!
-USE MODD_GRID_GAUSS, ONLY : XILA1, XILO1, XILA2, XILO2, NINLA, NINLO, NILEN, LROTPOLE, XCOEF, XLAP, XLOP
+USE MODD_GRID_GAUSS, ONLY : XILA1, XILO1, XILA2, XILO2, NINLA, NINLO, NILEN, LROTPOLE, &
+ XCOEF, XLAP, XLOP, XILATARRAY
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -69,9 +70,10 @@ INTEGER, INTENT(OUT) :: KNI ! number of points
INTEGER :: IRESP
!
!
-INTEGER :: JL ! loop counter
+REAL, DIMENSION(:), ALLOCATABLE :: ZLAT ! latitudes
REAL, DIMENSION(:), ALLOCATABLE :: ZW ! work array
!
+INTEGER :: JL, ICPT ! loop counter
INTEGER :: INLATI ! number of pseudo-latitudes
INTEGER :: INLATI2 ! number of half pseudo-latitudes
REAL :: ZLAPO ! latitude of the rotated pole (deg)
@@ -89,14 +91,11 @@ IF (LHOOK) CALL DR_HOOK('PREP_GRID_GAUSS',0,ZHOOK_HANDLE)
! ----------
!
YRECFM = 'LAPO'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,ZLAPO,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,ZLAPO,IRESP)
YRECFM = 'LOPO'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,ZLOPO,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,ZLOPO,IRESP)
YRECFM = 'CODIL'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,ZCODIL,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,ZCODIL,IRESP)
!
!-----------------------------------------------------------------------
!
@@ -104,19 +103,33 @@ YRECFM = 'CODIL'
! ----
!
YRECFM = 'NLATI'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,INLATI,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,INLATI,IRESP)
!
IF (ALLOCATED(INLOPA)) DEALLOCATE(INLOPA)
ALLOCATE(INLOPA(INLATI))
IF (ALLOCATED(NINLO)) DEALLOCATE(NINLO)
ALLOCATE(NINLO(INLATI))
YRECFM = 'NLOPA'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,INLOPA,IRESP,HDIR='A')
+ CALL READ_SURF(HFILETYPE,YRECFM,INLOPA,IRESP,HDIR='-')
!
KNI = SUM(INLOPA)
!
+ALLOCATE(ZLAT(KNI))
+! CALL READ_SURF(HFILETYPE,'LATGAUSS',ZLAT(:),IRESP,HDIR='-')
+ CALL READ_SURF(HFILETYPE,'LAT_G_XY',ZLAT(:),IRESP,HDIR='-')
+!
+IF (ALLOCATED(XILATARRAY)) DEALLOCATE(XILATARRAY)
+ALLOCATE(XILATARRAY(INLATI))
+XILATARRAY(1) = ZLAT(1)
+ICPT = 1
+DO JL = 2,KNI
+ IF (ZLAT(JL)/=ZLAT(JL-1)) THEN
+ ICPT = ICPT + 1
+ XILATARRAY(ICPT) = ZLAT(JL)
+ ENDIF
+ENDDO
+!
+DEALLOCATE(ZLAT)
!-----------------------------------------------------------------------
!
!* 3 Computes additional quantities used in interpolation
@@ -138,9 +151,11 @@ ELSE
LROTPOLE = .TRUE.
ENDIF
!
-XILA1=90.0*(1.0-0.5/REAL(INLATI))
+!XILA1=90.0*(1.0-1.0/(REAL(INLATI)))
+!XILA2=-90.0*(1.0-1.0/(REAL(INLATI)))
+XILA1 = XILATARRAY(1)
+XILA2 = XILATARRAY(INLATI)
XILO1=0.0
-XILA2=-90.0*(1.0-0.5/REAL(INLATI))
XILO2=360.0*(REAL(INLOPA(INLATI2))-1.0)/REAL(INLOPA(INLATI2))
!
HINTERP_TYPE = 'HORIBL'
diff --git a/src/SURFEX/prep_grid_lonlat_reg.F90 b/src/SURFEX/prep_grid_lonlat_reg.F90
index c859f36a28528929caa16ba5e1dda2e9c6f047ae..5a8dfd215d93e888c4e2843a59227ca9ba541f59 100644
--- a/src/SURFEX/prep_grid_lonlat_reg.F90
+++ b/src/SURFEX/prep_grid_lonlat_reg.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PREP_GRID_LONLAT_REG (&
- HFILETYPE,HINTERP_TYPE,KNI)
+ SUBROUTINE PREP_GRID_LONLAT_REG (HFILETYPE,HINTERP_TYPE,KNI)
! ##########################################################################
!
!!**** *PREP_GRID_LATLON* - reads EXTERNALIZED Surface grid.
@@ -77,26 +76,20 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PREP_GRID_LONLAT_REG',0,ZHOOK_HANDLE)
YRECFM = 'LONMIN'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,XILON1,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,XILON1,IRESP)
YRECFM = 'LONMAX'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,XILON2,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,XILON2,IRESP)
YRECFM = 'LATMIN'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,XILAT1,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,XILAT1,IRESP)
YRECFM = 'LATMAX'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,XILAT2,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,XILAT2,IRESP)
YRECFM = 'NLAT'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,NINLAT,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,NINLAT,IRESP)
!
IF (ALLOCATED(NINLON)) DEALLOCATE(NINLON)
ALLOCATE(NINLON(NINLAT))
YRECFM = 'NLON'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,NINLON(1),IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,NINLON(1),IRESP)
IF (NINLAT.GT.1) NINLON(2:NINLAT) = NINLON(1)
!
!-----------------------------------------------------------------------
diff --git a/src/SURFEX/prep_hor_flake_field.F90 b/src/SURFEX/prep_hor_flake_field.F90
index 6812401abaa2c9a7f01c91a4328961a74fc99bb1..350c8bc66c40295b60edb1003c2b399aebbe0f12 100644
--- a/src/SURFEX/prep_hor_flake_field.F90
+++ b/src/SURFEX/prep_hor_flake_field.F90
@@ -3,10 +3,9 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_HOR_FLAKE_FIELD (DTCO, UG, U, USS, &
- FG, F,GCP, &
+SUBROUTINE PREP_HOR_FLAKE_FIELD (DTCO, UG, U, USS, GCP, KLAT, F, &
HPROGRAM,HSURF,HATMFILE,HATMFILETYPE,&
- HPGDFILE,HPGDFILETYPE,ONOVALUE)
+ HPGDFILE,HPGDFILETYPE,ONOVALUE)
! #################################################################################
!
!!**** *PREP_HOR_FLAKE_FIELD* - Reads, interpolates and prepares a water field
@@ -34,30 +33,24 @@ SUBROUTINE PREP_HOR_FLAKE_FIELD (DTCO, UG, U, USS, &
!! but not profiles
!!------------------------------------------------------------------
!
-!
-!
-!
-!
-!
-!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
-USE MODD_FLAKE_GRID_n, ONLY : FLAKE_GRID_t
USE MODD_FLAKE_n, ONLY : FLAKE_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE, XZS_LS, XLAT_OUT, XLON_OUT, &
- XX_OUT, XY_OUT, CMASK
-!
+USE MODD_TYPE_DATE_SURF, ONLY : DATE_TIME
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC
+USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE, XZS_LS, CMASK
+USE MODD_GRID_GRIB, ONLY : CINMODEL
!
USE MODD_CSTS, ONLY : XTT
USE MODD_PREP_FLAKE, ONLY : LCLIM_LAKE
!
+USE MODI_PREP_GRIB_GRID
USE MODI_READ_PREP_FLAKE_CONF
USE MODI_PREP_FLAKE_GRIB
USE MODI_PREP_FLAKE_ASCLLV
@@ -73,18 +66,20 @@ USE PARKIND1 ,ONLY : JPRB
USE MODI_ABOR1_SFX
IMPLICIT NONE
!
-!* 0.1 declarations of arguments
-!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
!
+!* 0.1 declarations of arguments
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
+TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
-TYPE(FLAKE_GRID_t), INTENT(INOUT) :: FG
+INTEGER, INTENT(IN) :: KLAT
TYPE(FLAKE_t), INTENT(INOUT) :: F
-TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
@@ -101,9 +96,11 @@ LOGICAL, OPTIONAL, INTENT(OUT) :: ONOVALUE ! flag for the not given value
CHARACTER(LEN=28) :: YFILE ! name of file
CHARACTER(LEN=6) :: YFILEPGDTYPE ! type of input file
CHARACTER(LEN=28) :: YFILEPGD ! name of file
-REAL, POINTER, DIMENSION(:,:) :: ZFIELDIN ! field to interpolate horizontally
+ TYPE (DATE_TIME) :: TZTIME_GRIB ! current date and time
+REAL, POINTER, DIMENSION(:,:) :: ZFIELDIN=>NULL() ! field to interpolate horizontally
REAL, ALLOCATABLE, DIMENSION(:,:) :: ZFIELDOUT ! field interpolated horizontally
INTEGER :: ILUOUT ! output listing logical unit
+INTEGER :: INL, INFOMPI
!
LOGICAL :: GUNIF ! flag for prescribed uniform field
LOGICAL :: GDEFAULT ! flag for prescribed default field
@@ -119,10 +116,10 @@ IF (LHOOK) CALL DR_HOOK('PREP_HOR_FLAKE_FIELD',0,ZHOOK_HANDLE)
CALL READ_PREP_FLAKE_CONF(HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,&
HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,ILUOUT,GUNIF)
!
- CMASK = 'WATER'
+CMASK = 'WATER'
!
GDEFAULT = (YFILETYPE==' ' .OR. (HSURF(1:2)/='ZS' .AND. HSURF(1:2)/='TS' &
- .AND. SIZE(FG%XLAT).NE.1)) .AND. .NOT.GUNIF
+ .AND. KLAT.NE.1)) .AND. .NOT.GUNIF
IF (PRESENT(ONOVALUE)) ONOVALUE = GDEFAULT
!
IF (.NOT. GDEFAULT) THEN
@@ -134,13 +131,13 @@ IF (.NOT. GDEFAULT) THEN
IF (GUNIF) THEN
CALL PREP_FLAKE_UNIF(ILUOUT,HSURF,ZFIELDIN)
ELSE IF (YFILETYPE=='ASCLLV') THEN
- CALL PREP_FLAKE_ASCLLV(DTCO, UG, U, USS, &
- HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
+ CALL PREP_FLAKE_ASCLLV(DTCO, UG, U, USS, HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
ELSE IF (YFILETYPE=='GRIB ') THEN
- CALL PREP_FLAKE_GRIB(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
- ELSE IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='ASCII ' .OR. YFILETYPE=='LFI '.OR. YFILETYPE=='FA ') THEN
- CALL PREP_FLAKE_EXTERN(GCP,&
- HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,ILUOUT,ZFIELDIN)
+ CALL PREP_GRIB_GRID(YFILE,ILUOUT,CINMODEL,CINGRID_TYPE,CINTERP_TYPE,TZTIME_GRIB)
+ IF (NRANK==NPIO) CALL PREP_FLAKE_GRIB(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
+ ELSE IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='ASCII ' .OR. YFILETYPE=='LFI '.OR. YFILETYPE=='FA '&
+ .OR.YFILETYPE=='NC ') THEN
+ CALL PREP_FLAKE_EXTERN(GCP,HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,ILUOUT,ZFIELDIN)
ELSE IF (YFILETYPE=='BUFFER') THEN
CALL PREP_FLAKE_BUFFER(HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
ELSE
@@ -150,19 +147,28 @@ IF (.NOT. GDEFAULT) THEN
!
!* 4. Horizontal interpolation
!
+IF (NRANK==NPIO) THEN
+ INL = SIZE(ZFIELDIN,2)
+ELSEIF (.NOT.ASSOCIATED(ZFIELDIN)) THEN
+ ALLOCATE(ZFIELDIN(0,0))
+ENDIF
+!
+IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(INL,KIND(INL)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ENDIF
!ALLOCATE(ZFIELDOUT(SIZE(XLAT),SIZE(ZFIELDIN,2)))
- ALLOCATE(ZFIELDOUT(SIZE(FG%XLAT),1))
+ ALLOCATE(ZFIELDOUT(KLAT,1))
!
!Impossible to interpolate lake profiles, only the lake surface temperature!
!But in uniform case and 1 point case
- IF(GUNIF .OR. SIZE(FG%XLAT).EQ.1) THEN
- CALL HOR_INTERPOL(DTCO, U,GCP, &
- ILUOUT,ZFIELDIN,ZFIELDOUT)
+ IF(GUNIF .OR. KLAT.EQ.1) THEN
+ CALL HOR_INTERPOL(DTCO, U, GCP, ILUOUT,ZFIELDIN,ZFIELDOUT)
ELSE IF(HSURF(1:2)=='ZS' .OR. HSURF(1:2)=='TS') THEN
WRITE(ILUOUT,*) "WARNING! Impossible to interpolate lake profiles in horisontal!"
WRITE(ILUOUT,*) "So, interoplate only surface temperature and start from lakes mixed down to the bottom"
- CALL HOR_INTERPOL(DTCO, U,GCP, &
- ILUOUT,ZFIELDIN,ZFIELDOUT)
+ CALL HOR_INTERPOL(DTCO, U, GCP, ILUOUT,ZFIELDIN,ZFIELDOUT)
END IF
!
!* 5. Return to historical variable
diff --git a/src/SURFEX/prep_hor_isba_cc_field.F90 b/src/SURFEX/prep_hor_isba_cc_field.F90
index 6048c9c0324a1a30df3feede266c5702d5499619..b7bdbb262f4c4ef0af0cb957b6decdf813abd900 100644
--- a/src/SURFEX/prep_hor_isba_cc_field.F90
+++ b/src/SURFEX/prep_hor_isba_cc_field.F90
@@ -3,9 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_HOR_ISBA_CC_FIELD (DTCO, U, &
- IG, I,GCP, &
- HPROGRAM,HSURF,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+SUBROUTINE PREP_HOR_ISBA_CC_FIELD (DTCO, U, GCP, KLAT, IO, S, NK, NP, NPE, &
+ HPROGRAM,HSURF,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
! #################################################################################
!
!!**** *PREP_HOR_ISBA_CC_FIELD* - reads, interpolates and prepares an ISBA-CC field
@@ -28,29 +27,28 @@ SUBROUTINE PREP_HOR_ISBA_CC_FIELD (DTCO, U, &
!! MODIFICATIONS
!! -------------
!! Original 05/2014
+!! P. Marguinaud10/2014, Support for a 2-part PREP
!!------------------------------------------------------------------
!
-!
-!
-!
-!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-!
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_NK_t, ISBA_NP_t, ISBA_NPE_t, ISBA_K_t, ISBA_S_t, &
+ ISBA_PE_t, ISBA_P_t
!
USE MODD_CO2V_PAR, ONLY : XCA_NIT, XCC_NIT
!
USE MODD_PREP, ONLY : LINTERP, CMASK
!
-
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC
+!
USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
USE MODD_SURF_PAR, ONLY : XUNDEF,NUNDEF
!
+USE MODE_PREP_CTL, ONLY : PREP_CTL, PREP_CTL_INT_PART2, PREP_CTL_INT_PART4
+!
USE MODI_READ_PREP_ISBA_CONF
USE MODI_ABOR1_SFX
USE MODI_HOR_INTERPOL
@@ -58,22 +56,31 @@ USE MODI_VEGTYPE_GRID_TO_PATCH_GRID
USE MODI_GET_LUOUT
USE MODI_PREP_ISBA_CC_EXTERN
USE MODI_PUT_ON_ALL_VEGTYPES
+USE MODI_GET_PREP_INTERP
+USE MODI_PACK_SAME_RANK
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
-!* 0.1 declarations of arguments
-!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
!
+!* 0.1 declarations of arguments
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-!
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
+INTEGER, INTENT(IN) :: KLAT
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_NK_t), INTENT(INOUT) :: NK
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
+TYPE (PREP_CTL), INTENT(INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=8), INTENT(IN) :: HSURF ! type of field
@@ -83,25 +90,38 @@ TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
CHARACTER(LEN=6), INTENT(IN) :: HPGDFILETYPE! type of the Atmospheric file
!
!* 0.2 declarations of local variables
+!
+TYPE FOUT
+ REAL, DIMENSION(:,:), ALLOCATABLE :: ZOUT
+END TYPE FOUT
+TYPE NFOUT
+ TYPE(FOUT), DIMENSION(:), ALLOCATABLE :: AL
+END TYPE NFOUT
+TYPE (NFOUT) :: ZW
+TYPE(NFOUT) :: ZF
+!
+TYPE(ISBA_P_t), POINTER :: PK
+TYPE(ISBA_PE_t), POINTER :: PEK
!
CHARACTER(LEN=6) :: YFILETYPE ! type of input file
CHARACTER(LEN=28) :: YFILE ! name of file
CHARACTER(LEN=6) :: YFILEPGDTYPE ! type of input file
CHARACTER(LEN=28) :: YFILEPGD ! name of file
-REAL, POINTER, DIMENSION(:,:,:) :: ZFIELDIN ! field to interpolate horizontally
-REAL, POINTER, DIMENSION(:,:) :: ZFIELD ! field to interpolate horizontally
-REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZFIELDOUTP ! field interpolated horizontally
-REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZFIELDOUTV ! field interpolated horizontally
-REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZW ! work array (x, fine soil grid, npatch)
+REAL, POINTER, DIMENSION(:,:,:) :: ZFIELDIN ! field to interpolate horizontally
+REAL, POINTER, DIMENSION(:,:,:) :: ZFIELDOUTP ! field interpolated horizontally
+REAL, POINTER, DIMENSION(:,:,:) :: ZFIELDOUTV ! field interpolated horizontally
!
INTEGER :: ILUOUT ! output listing logical unit
!
LOGICAL :: GUNIF ! flag for prescribed uniform field
LOGICAL :: GPREP_AGS ! flag to prepare ags field (only external case implemeted)
!
-INTEGER :: JPATCH ! loop on patches
+INTEGER :: JP ! loop on patches
INTEGER :: JVEGTYPE ! loop on vegtypes
-INTEGER :: INI, INL, INP, JJ, JL ! Work integer
+INTEGER :: INL, INP, JJ, JL ! Work integer
+INTEGER :: INFOMPI
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZPATCH
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
@@ -110,14 +130,12 @@ IF (LHOOK) CALL DR_HOOK('PREP_HOR_ISBA_CC_FIELD',0,ZHOOK_HANDLE)
!
!* 1. Reading of input file name and type
!
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
+CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
- CALL READ_PREP_ISBA_CONF(HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE, &
+CALL READ_PREP_ISBA_CONF(HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE, &
HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,ILUOUT,GUNIF)
!
- CMASK = 'NATURE'
-!
-INI=SIZE(IG%XLAT)
+CMASK = 'NATURE'
!
GPREP_AGS = .TRUE.
!
@@ -125,185 +143,248 @@ GPREP_AGS = .TRUE.
!
!* 2. Reading of input configuration (Grid and interpolation type)
!
-IF (GUNIF) THEN
- GPREP_AGS = .FALSE.
-ELSE IF (YFILETYPE=='ASCLLV') THEN
- GPREP_AGS = .FALSE.
-ELSE IF (YFILETYPE=='GRIB ') THEN
- GPREP_AGS = .FALSE.
-ELSE IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='ASCII ' .OR. YFILETYPE=='LFI '.OR.YFILETYPE=='FA ') THEN
- CALL PREP_ISBA_CC_EXTERN(GCP,&
- HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,ILUOUT,ZFIELDIN,GPREP_AGS)
-ELSE IF (YFILETYPE=='BUFFER') THEN
- GPREP_AGS = .FALSE.
-ELSE IF (YFILETYPE=='NETCDF') THEN
- GPREP_AGS = .FALSE.
-ELSE
- CALL ABOR1_SFX('PREP_HOR_ISBA_CC_FIELD: data file type not supported : '//YFILETYPE)
-END IF
+NULLIFY (ZFIELDIN, ZFIELDOUTP, ZFIELDOUTV)
+!
+IF (YDCTL%LPART1) THEN
+!
+ IF (GUNIF) THEN
+ GPREP_AGS = .FALSE.
+ ELSE IF (YFILETYPE=='ASCLLV') THEN
+ GPREP_AGS = .FALSE.
+ ELSE IF (YFILETYPE=='GRIB ') THEN
+ GPREP_AGS = .FALSE.
+ ELSE IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='ASCII ' .OR. YFILETYPE=='LFI '&
+ .OR.YFILETYPE=='FA '.OR. YFILETYPE=='AROME '.OR.YFILETYPE=='NC ') THEN
+ CALL PREP_ISBA_CC_EXTERN(GCP,HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,ILUOUT,ZFIELDIN,GPREP_AGS)
+ ELSE IF (YFILETYPE=='BUFFER') THEN
+ GPREP_AGS = .FALSE.
+ ELSE IF (YFILETYPE=='NETCDF') THEN
+ GPREP_AGS = .FALSE.
+ ELSE
+ CALL ABOR1_SFX('PREP_HOR_ISBA_CC_FIELD: data file type not supported : '//YFILETYPE)
+ END IF
+!
+ INL = SIZE(ZFIELDIN,2)
+ INP = SIZE(ZFIELDIN,3)
!
+ENDIF
!-------------------------------------------------------------------------------------
!
!* 3. Horizontal interpolation
!
-IF(GPREP_AGS)THEN
-!
- INL = SIZE(ZFIELDIN,2)
- INP = SIZE(ZFIELDIN,3)
+ CALL PREP_CTL_INT_PART2 (YDCTL, HSURF, CMASK, 'NATURE', ZFIELDIN)
!
- ALLOCATE(ZFIELDOUTP(INI,INL,INP))
- ALLOCATE(ZFIELD(SIZE(ZFIELDIN,1),INL))
+IF (YDCTL%LPART3) THEN
!
- DO JPATCH = 1, INP
- ZFIELD(:,:)=ZFIELDIN(:,:,JPATCH)
- IF (INP==NVEGTYPE) THEN
- LINTERP = (I%XVEGTYPE(:,JPATCH) > 0.)
- ELSEIF(INP==I%NPATCH)THEN
- LINTERP = (I%XPATCH(:,JPATCH) > 0.)
+ IF(GPREP_AGS)THEN
+ !
+ IF (NRANK==NPIO) THEN
+ INL = SIZE(ZFIELDIN,2)
+ INP = SIZE(ZFIELDIN,3)
+ ELSEIF (.NOT.ASSOCIATED(ZFIELDIN)) THEN
+ ALLOCATE(ZFIELDIN(0,0,0))
ENDIF
- CALL HOR_INTERPOL(DTCO, U,GCP, &
- ILUOUT,ZFIELD,ZFIELDOUTP(:,:,JPATCH))
- LINTERP = .TRUE.
- END DO
+ !
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(INL,KIND(INL)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(INP,KIND(INP)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ ENDIF
+ ALLOCATE(ZFIELDOUTP(KLAT,INL,INP))
+ !
+ ! ZPATCH is the array of output patches put on the input patches
+ ALLOCATE(ZPATCH(KLAT,INP))
+ ZPATCH(:,:) = 0.
!
- DEALLOCATE(ZFIELD)
- DEALLOCATE(ZFIELDIN)
+ CALL GET_PREP_INTERP(INP,IO%NPATCH,S%XVEGTYPE,S%XPATCH,ZPATCH)
+
+ DO JP = 1, INP
+ ! we interpolate each point the output patch is present
+ LINTERP(:) = (ZPATCH(:,JP) > 0.)
+ CALL HOR_INTERPOL(DTCO, U, GCP, ILUOUT,ZFIELDIN(:,:,JP),ZFIELDOUTP(:,:,JP))
+ LINTERP = .TRUE.
+ END DO
!
- ALLOCATE(ZFIELDOUTV(INI,INL,NVEGTYPE))
+ DEALLOCATE(ZFIELDIN)
!
- CALL PUT_ON_ALL_VEGTYPES(INI,INL,INP,NVEGTYPE,ZFIELDOUTP,ZFIELDOUTV)
+ ENDIF
+ !
+ENDIF
!
- DEALLOCATE(ZFIELDOUTP)
+ CALL PREP_CTL_INT_PART4 (YDCTL, HSURF, 'NATURE', CMASK, ZFIELDIN, ZFIELDOUTP)
!
+IF (YDCTL%LPART5) THEN
+
+ ALLOCATE(ZW%AL(IO%NPATCH))
+
+ IF (GPREP_AGS) THEN
+
+ INL = SIZE (ZFIELDOUTP,2)
+ INP = SIZE (ZFIELDOUTP,3)
+
+ IF (IO%NPATCH/=INP) THEN
+
+ ALLOCATE(ZFIELDOUTV(KLAT,INL,NVEGTYPE))
+ CALL PUT_ON_ALL_VEGTYPES(KLAT,INL,INP,NVEGTYPE,ZFIELDOUTP,ZFIELDOUTV)
!
-ENDIF
+ DEALLOCATE(ZFIELDOUTP)
!
!-------------------------------------------------------------------------------------
!
!* 6. Transformation from vegtype grid to patch grid
!
-IF(GPREP_AGS)THEN
-!
- ALLOCATE(ZW (INI,SIZE(ZFIELDOUTV,2),I%NPATCH))
-!
- ZW(:,:,:) = 0.
- CALL VEGTYPE_GRID_TO_PATCH_GRID(I%NPATCH,I%XVEGTYPE_PATCH,I%XPATCH,ZFIELDOUTV,ZW)
-!
-ELSE
-!
- SELECT CASE (HSURF)
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
- CASE('BIOMASS')
- ALLOCATE(ZW(INI,I%NNBIOMASS,I%NPATCH))
- ZW(:,:,:) = 0.
- WHERE(I%XLAI(:,:)/=XUNDEF)
- ZW(:,1,:) = I%XLAI(:,:) * I%XBSLAI_NITRO(:,:)
- ENDWHERE
- ZW(:,2,:) = MAX( 0., (ZW(:,1,:)/ (XCC_NIT/10.**XCA_NIT)) &
- **(1.0/(1.0-XCA_NIT)) - ZW(:,1,:) )
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
- CASE('LITTER')
- ALLOCATE(ZW(INI,I%NNLITTER*I%NNLITTLEVS,I%NPATCH))
- ZW(:,:,:) = 0.0
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
- CASE('SOILCARB')
- ALLOCATE(ZW(INI,I%NNSOILCARB,I%NPATCH))
- ZW(:,:,:) = 0.0
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
- CASE('LIGNIN')
- ALLOCATE(ZW(INI,I%NNLITTLEVS,I%NPATCH))
- ZW(:,:,:) = 0.0
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ !
+ ALLOCATE(ZW%AL(JP)%ZOUT(PK%NSIZE_P,INL))
+ !
+ CALL VEGTYPE_GRID_TO_PATCH_GRID(JP,IO%NPATCH,PK%XVEGTYPE_PATCH,PK%XPATCH,&
+ PK%NR_P,ZFIELDOUTV,ZW%AL(JP)%ZOUT)
+ ENDDO
+ !
+ DEALLOCATE(ZFIELDOUTV)
+ !
+ ELSE
+ !
+ DO JP = 1,IO%NPATCH
+ !
+ PK => NP%AL(JP)
+ !
+ ALLOCATE(ZW%AL(JP)%ZOUT(PK%NSIZE_P,INL))
+ !
+ CALL PACK_SAME_RANK(PK%NR_P,ZFIELDOUTP(:,:,JP),ZW%AL(JP)%ZOUT)
+ !
+ ENDDO
+ !
+ DEALLOCATE(ZFIELDOUTP)
+ !
+ ENDIF
!
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ ELSE
!
- END SELECT
-!
-ENDIF
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+ !
+ SELECT CASE (HSURF)
+ !
+ CASE('BIOMASS')
+ ALLOCATE(ZW%AL(JP)%ZOUT(PK%NSIZE_P,IO%NNBIOMASS))
+ ZW%AL(JP)%ZOUT(:,:) = 0.
+ WHERE(PEK%XLAI(:)/=XUNDEF)
+ ZW%AL(JP)%ZOUT(:,1) = PEK%XLAI(:) * PK%XBSLAI_NITRO(:)
+ ENDWHERE
+ ZW%AL(JP)%ZOUT(:,2) = MAX( 0., (ZW%AL(JP)%ZOUT(:,1)/ (XCC_NIT/10.**XCA_NIT)) &
+ **(1.0/(1.0-XCA_NIT)) - ZW%AL(JP)%ZOUT(:,1) )
+ !
+ CASE('LITTER')
+ ALLOCATE(ZW%AL(JP)%ZOUT(PK%NSIZE_P,IO%NNLITTER*IO%NNLITTLEVS))
+ ZW%AL(JP)%ZOUT(:,:) = 0.0
+ !
+ CASE('SOILCARB')
+ ALLOCATE(ZW%AL(JP)%ZOUT(PK%NSIZE_P,IO%NNSOILCARB))
+ ZW%AL(JP)%ZOUT(:,:) = 0.0
+ !
+ CASE('LIGNIN')
+ ALLOCATE(ZW%AL(JP)%ZOUT(PK%NSIZE_P,IO%NNLITTLEVS))
+ ZW%AL(JP)%ZOUT(:,:) = 0.0
+ !
+ END SELECT
+ !
+ ENDDO
+ !
+ ENDIF
!-------------------------------------------------------------------------------------
!
!* 7. Return to historical variable
!
!
-SELECT CASE (HSURF)
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
- CASE('BIOMASS')
- ALLOCATE(I%XBIOMASS(INI,I%NNBIOMASS,I%NPATCH))
- INL=MIN(I%NNBIOMASS,SIZE(ZW,2))
- DO JL=1,INL
- WHERE(ZW(:,JL,:)/=XUNDEF)
- I%XBIOMASS(:,JL,:) = ZW(:,JL,:)
- ELSEWHERE
- I%XBIOMASS(:,JL,:) = 0.0
- ENDWHERE
- ENDDO
- IF(I%NNBIOMASS>INL)THEN
- DO JL=INL+1,I%NNBIOMASS
- WHERE(ZW(:,JL,:)/=XUNDEF)
- I%XBIOMASS(:,JL,:) = ZW(:,INL,:)
- ELSEWHERE
- I%XBIOMASS(:,JL,:) = 0.0
- ENDWHERE
- ENDDO
- ENDIF
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
- CASE('LITTER')
- ALLOCATE(I%XLITTER(INI,I%NNLITTER,I%NNLITTLEVS,I%NPATCH))
- DO JPATCH=1,I%NPATCH
- INL=0
- DO JJ=1,I%NNLITTER
- DO JL=1,I%NNLITTLEVS
- INL=INL+1
- WHERE(ZW(:,INL,JPATCH)/=XUNDEF)
- I%XLITTER(:,JJ,JL,JPATCH) = ZW(:,INL,JPATCH)
+ SELECT CASE (HSURF)
+ !
+ CASE('BIOMASS')
+ DO JP = 1,IO%NPATCH
+ PEK => NPE%AL(JP)
+ PK => NP%AL(JP)
+
+ ALLOCATE(PEK%XBIOMASS(PK%NSIZE_P,IO%NNBIOMASS))
+ INL=MIN(IO%NNBIOMASS,SIZE(ZW%AL(JP)%ZOUT,2))
+ DO JL=1,INL
+ WHERE(ZW%AL(JP)%ZOUT(:,JL)/=XUNDEF)
+ PEK%XBIOMASS(:,JL) = ZW%AL(JP)%ZOUT(:,JL)
ELSEWHERE
- I%XLITTER(:,JJ,JL,JPATCH) = 0.0
+ PEK%XBIOMASS(:,JL) = 0.0
ENDWHERE
- ENDDO
- ENDDO
- END DO
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
- CASE('SOILCARB')
- ALLOCATE(I%XSOILCARB(INI,I%NNSOILCARB,I%NPATCH))
- WHERE(ZW(:,:,:)/=XUNDEF)
- I%XSOILCARB(:,:,:) = ZW(:,:,:)
- ELSEWHERE
- I%XSOILCARB(:,:,:) = 0.0
- ENDWHERE
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
- CASE('LIGNIN')
- ALLOCATE(I%XLIGNIN_STRUC(INI,I%NNLITTLEVS,I%NPATCH))
- WHERE(ZW(:,:,:)/=XUNDEF)
- I%XLIGNIN_STRUC(:,:,:) = ZW(:,:,:)
- ELSEWHERE
- I%XLIGNIN_STRUC(:,:,:) = 0.0
- ENDWHERE
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
-END SELECT
-!
-DEALLOCATE(ZW)
+ ENDDO
+ IF(IO%NNBIOMASS>INL)THEN
+ DO JL=INL+1,IO%NNBIOMASS
+ WHERE(ZW%AL(JP)%ZOUT(:,JL)/=XUNDEF)
+ PEK%XBIOMASS(:,JL) = ZW%AL(JP)%ZOUT(:,INL)
+ ELSEWHERE
+ PEK%XBIOMASS(:,JL) = 0.0
+ ENDWHERE
+ ENDDO
+ ENDIF
+ ENDDO
+ !
+ CASE('LITTER')
+ DO JP = 1,IO%NPATCH
+ PEK => NPE%AL(JP)
+ PK => NP%AL(JP)
+
+ ALLOCATE(PEK%XLITTER(PK%NSIZE_P,IO%NNLITTER,IO%NNLITTLEVS))
+ INL=0
+ DO JJ=1,IO%NNLITTER
+ DO JL=1,IO%NNLITTLEVS
+ INL=INL+1
+ WHERE(ZW%AL(JP)%ZOUT(:,INL)/=XUNDEF)
+ PEK%XLITTER(:,JJ,JL) = ZW%AL(JP)%ZOUT(:,INL)
+ ELSEWHERE
+ PEK%XLITTER(:,JJ,JL) = 0.0
+ ENDWHERE
+ ENDDO
+ ENDDO
+ END DO
+ !
+ CASE('SOILCARB')
+ DO JP = 1,IO%NPATCH
+ PEK => NPE%AL(JP)
+ PK => NP%AL(JP)
+
+ ALLOCATE(PEK%XSOILCARB(PK%NSIZE_P,IO%NNSOILCARB))
+ WHERE(ZW%AL(JP)%ZOUT(:,:)/=XUNDEF)
+ PEK%XSOILCARB(:,:) = ZW%AL(JP)%ZOUT(:,:)
+ ELSEWHERE
+ PEK%XSOILCARB(:,:) = 0.0
+ ENDWHERE
+ ENDDO
+ !
+ CASE('LIGNIN')
+ DO JP = 1,IO%NPATCH
+ PEK => NPE%AL(JP)
+ PK => NP%AL(JP)
+
+ ALLOCATE(PEK%XLIGNIN_STRUC(PK%NSIZE_P,IO%NNLITTLEVS))
+ WHERE(ZW%AL(JP)%ZOUT(:,:)/=XUNDEF)
+ PEK%XLIGNIN_STRUC(:,:) = ZW%AL(JP)%ZOUT(:,:)
+ ELSEWHERE
+ PEK%XLIGNIN_STRUC(:,:) = 0.0
+ ENDWHERE
+ ENDDO
+ !
+ END SELECT
+ !
+ DO JP = 1,IO%NPATCH
+ DEALLOCATE(ZW%AL(JP)%ZOUT)
+ ENDDO
+ DEALLOCATE(ZW%AL)
+ !
+ENDIF
!-------------------------------------------------------------------------------------
!
!* 8. Deallocations
!
-IF (ALLOCATED(ZFIELDOUTV)) DEALLOCATE(ZFIELDOUTV)
!
IF (LHOOK) CALL DR_HOOK('PREP_HOR_ISBA_CC_FIELD',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/prep_hor_isba_field.F90 b/src/SURFEX/prep_hor_isba_field.F90
index 34a0cf608217b33ec2e498cde97425d142c9ac31..8e2fbee391b5955b945745c5ac98ab96567fa95d 100644
--- a/src/SURFEX/prep_hor_isba_field.F90
+++ b/src/SURFEX/prep_hor_isba_field.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_HOR_ISBA_FIELD (DTCO, IG, I, UG, U, USS,GCP, &
- HPROGRAM,HSURF,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,OKEY)
+SUBROUTINE PREP_HOR_ISBA_FIELD (DTCO, UG, U, USS, GCP, IG, IO, S, NK, NP, NPE, TPTIME, &
+ HPROGRAM,HSURF,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL,OKEY)
! #################################################################################
!
!!**** *PREP_HOR_ISBA_FIELD* - reads, interpolates and prepares an ISBA field
@@ -35,25 +35,30 @@ SUBROUTINE PREP_HOR_ISBA_FIELD (DTCO, IG, I, UG, U, USS,GCP, &
!! B. Decharme 03/2014, external init with FA files
!! new vertical interpolation
!! P Samuelsson 10/2014, MEB
+!! P. Marguinaud10/2014, Support for a 2-part PREP
!!------------------------------------------------------------------
!
+USE MODD_TYPE_SNOW
+USE MODD_TYPE_DATE_SURF, ONLY : DATE_TIME
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC
!
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
!
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_NK_t, ISBA_NP_t, ISBA_NPE_t, ISBA_K_t, ISBA_S_t, &
+ ISBA_PE_t, ISBA_P_t
!
-!
-!
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
+!
+USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE, XZS_LS, LINTERP, CMASK
+USE MODD_GRID_GRIB, ONLY : CINMODEL
!
-USE MODD_PREP, ONLY : XZS_LS, LINTERP, CMASK
-
USE MODD_PREP_ISBA, ONLY : XGRID_SOIL, NGRID_LEVEL, LSNOW_IDEAL, &
- XWSNOW, XRSNOW, XTSNOW, XLWCSNOW, XASNOW, &
+ XWSNOW, XRSNOW, XTSNOW, XLWCSNOW, XASNOW, &
XSG1SNOW, XSG2SNOW, XHISTSNOW, XAGESNOW
@@ -61,6 +66,9 @@ USE MODD_ISBA_PAR, ONLY : XWGMIN
USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
USE MODD_SURF_PAR, ONLY : XUNDEF,NUNDEF
!
+USE MODE_PREP_CTL, ONLY : PREP_CTL, PREP_CTL_INT_PART2, PREP_CTL_INT_PART4
+!
+USE MODI_PREP_GRIB_GRID
USE MODI_READ_PREP_ISBA_CONF
USE MODI_READ_PREP_ISBA_SNOW
USE MODI_PREP_ISBA_ASCLLV
@@ -75,23 +83,38 @@ USE MODI_PREP_HOR_SNOW_FIELDS
USE MODI_GET_LUOUT
USE MODI_PREP_ISBA_EXTERN
USE MODI_PREP_ISBA_NETCDF
-USE MODI_VEGTYPE_TO_PATCH
+USE MODI_PACK_SAME_RANK
+USE MODI_ALLOCATE_GR_SNOW
+USE MODI_GET_PREP_INTERP
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1 declarations of arguments
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
+!
+TYPE(GRID_t), INTENT(INOUT) :: IG
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_NK_t), INTENT(INOUT) :: NK
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
+TYPE(DATE_TIME), INTENT(IN) :: TPTIME
+!
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
+TYPE (PREP_CTL), INTENT(INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
@@ -112,21 +135,47 @@ LOGICAL, OPTIONAL, INTENT(INOUT):: OKEY
CHARACTER(LEN=28) :: YFILEPGD_SNOW ! name of file
CHARACTER(LEN=6) :: YFILEPGDTYPE ! type of input file
CHARACTER(LEN=28) :: YFILEPGD ! name of file
-REAL, POINTER, DIMENSION(:,:,:) :: ZFIELDIN ! field to interpolate horizontally
-REAL, POINTER, DIMENSION(:,:) :: ZFIELD, ZPATCH ! field to interpolate horizontally
-REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZFIELDOUTP ! field interpolated horizontally
-REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZFIELDOUTV !
-REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZW ! work array (x, fine soil grid, npatch)
-REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZF ! work array (x, output soil grid, npatch)
-REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZDG ! out T grid (x, output soil grid, npatch)
+REAL, POINTER, DIMENSION(:,:,:) :: ZFIELDIN ! field to interpolate horizontally
+REAL, POINTER, DIMENSION(:,:,:) :: ZFIELDOUTP ! field interpolated horizontally
+REAL, POINTER, DIMENSION(:,:,:) :: ZFIELDOUTV !
+!
+TYPE(NSURF_SNOW) :: TNPSNOW
+!
+TYPE(ISBA_K_t), POINTER :: KK
+TYPE(ISBA_P_t), POINTER :: PK
+TYPE(ISBA_PE_t), POINTER :: PEK
+!
+TYPE FOUT
+ REAL, DIMENSION(:,:), ALLOCATABLE :: ZOUT
+END TYPE FOUT
+TYPE NFOUT
+ TYPE(FOUT), DIMENSION(:), ALLOCATABLE :: AL
+END TYPE NFOUT
+TYPE (NFOUT) :: ZW
+TYPE(NFOUT) :: ZF
+!
+REAL, ALLOCATABLE, DIMENSION(:,:) :: ZDG ! out T grid (x, output soil grid, npatch)
+TYPE (DATE_TIME) :: TZTIME_GRIB ! current date and time
+!
+ CHARACTER(LEN=3) :: YSNOW_SCHEME
+INTEGER :: ISNOW_NLAYER
+!
+INTEGER, DIMENSION(IO%NPATCH) :: ISIZE_P
+INTEGER, DIMENSION(SIZE(IG%XLAT),IO%NPATCH) :: IR_P
+!
INTEGER :: ILUOUT ! output listing logical unit
!
LOGICAL :: GUNIF ! flag for prescribed uniform field
LOGICAL :: GUNIF_SNOW! flag for prescribed uniform field
-INTEGER :: JPATCH ! loop on patches
-INTEGER :: JVEGTYPE ! loop on vegtypes
-INTEGER :: INI, INL, INP, JJ, JL, IP_I, IP_O, JP, JVEG ! Work integer
-INTEGER, DIMENSION(SIZE(I%XDG,1),SIZE(I%XDG,3)) :: IWORK
+INTEGER :: JP ! loop on patches
+INTEGER :: JVEG ! loop on vegtypes
+INTEGER :: INI, INL, INP, JI, JL! Work integer
+INTEGER :: INFOMPI
+INTEGER, DIMENSION(SIZE(IG%XLAT)) :: IWORK
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZVEGTYPE_PATCH
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZPATCH
+!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
!
@@ -139,7 +188,7 @@ IF (LHOOK) CALL DR_HOOK('PREP_HOR_ISBA_FIELD',0,ZHOOK_HANDLE)
CALL READ_PREP_ISBA_CONF(HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,&
HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,ILUOUT,GUNIF)
!
- CMASK = 'NATURE'
+CMASK = 'NATURE'
!
INI=SIZE(IG%XLAT)
!
@@ -148,31 +197,75 @@ INI=SIZE(IG%XLAT)
!* 2. Snow variables case?
!
IF (HSURF=='SN_VEG ') THEN
- CALL READ_PREP_ISBA_SNOW(HPROGRAM,I%TSNOW%SCHEME,I%TSNOW%NLAYER,YFILE_SNOW,YFILETYPE_SNOW,&
- YFILEPGD_SNOW,YFILEPGDTYPE_SNOW,GUNIF_SNOW)
+ CALL READ_PREP_ISBA_SNOW(HPROGRAM, YSNOW_SCHEME, ISNOW_NLAYER, YFILE_SNOW, YFILETYPE_SNOW,&
+ YFILEPGD_SNOW, YFILEPGDTYPE_SNOW, GUNIF_SNOW)
+ !
+ DO JP = 1,IO%NPATCH
+ NPE%AL(JP)%TSNOW%SCHEME = YSNOW_SCHEME
+ NPE%AL(JP)%TSNOW%NLAYER = ISNOW_NLAYER
+ ISIZE_P(JP) = NP%AL(JP)%NSIZE_P
+ IR_P(:,JP) = 0
+ IR_P(1:ISIZE_P(JP),JP) = NP%AL(JP)%NR_P
+ ENDDO
+ !
IF(.NOT.GUNIF_SNOW.AND.LEN_TRIM(YFILE_SNOW)==0.AND.LEN_TRIM(YFILETYPE_SNOW)==0)THEN
IF(LEN_TRIM(YFILE)/=0.AND.LEN_TRIM(YFILETYPE)/=0)THEN
- YFILE_SNOW =YFILE
- YFILETYPE_SNOW=YFILETYPE
- YFILEPGD_SNOW =YFILEPGD
- YFILEPGDTYPE_SNOW=YFILEPGDTYPE
+ YFILE_SNOW = YFILE
+ YFILETYPE_SNOW = YFILETYPE
+ YFILEPGD_SNOW = YFILEPGD
+ YFILEPGDTYPE_SNOW = YFILEPGDTYPE
ELSE
- GUNIF_SNOW=.TRUE.
- IF(ALL(XWSNOW==XUNDEF))XWSNOW=0.0
+ GUNIF_SNOW=.TRUE.
+ IF(ALL(XWSNOW==XUNDEF))XWSNOW=0.0
ENDIF
ENDIF
- CALL PREP_HOR_SNOW_FIELDS(DTCO, &
- IG, U,GCP, &
- HPROGRAM, HSURF, &
+ !
+ ALLOCATE(TNPSNOW%AL(IO%NPATCH))
+ ALLOCATE(ZVEGTYPE_PATCH(SIZE(S%XVEGTYPE_PATCH,1),SIZE(S%XVEGTYPE_PATCH,2),SIZE(S%XVEGTYPE_PATCH,3)))
+ ALLOCATE(ZPATCH(SIZE(S%XPATCH,1),SIZE(S%XPATCH,2)))
+ ZVEGTYPE_PATCH(:,:,:) = 0.
+ ZPATCH(:,:) = 0.
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,S%XVEGTYPE_PATCH(:,:,JP),ZVEGTYPE_PATCH(1:NP%AL(JP)%NSIZE_P,:,JP))
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,S%XPATCH(:,JP),ZPATCH(1:NP%AL(JP)%NSIZE_P,JP))
+ TNPSNOW%AL(JP)%SCHEME = NPE%AL(JP)%TSNOW%SCHEME
+ TNPSNOW%AL(JP)%NLAYER = NPE%AL(JP)%TSNOW%NLAYER
+ ENDDO
+ !
+ CALL PREP_HOR_SNOW_FIELDS(DTCO, IG, U, GCP, HPROGRAM, HSURF, &
YFILE_SNOW, YFILETYPE_SNOW, &
YFILEPGD_SNOW, YFILEPGDTYPE_SNOW, &
- ILUOUT, GUNIF_SNOW, I%NPATCH, 1, &
- INI,I%TSNOW, I%TTIME, &
+ ILUOUT, GUNIF_SNOW, IO%NPATCH, 1, &
+ INI,TNPSNOW, TPTIME, &
XWSNOW, XRSNOW, XTSNOW, XLWCSNOW, &
XASNOW, LSNOW_IDEAL, XSG1SNOW, &
- XSG2SNOW, XHISTSNOW, XAGESNOW, &
- I%XVEGTYPE, I%XVEGTYPE_PATCH, I%XPATCH, &
- OKEY )
+ XSG2SNOW, XHISTSNOW, XAGESNOW, YDCTL,&
+ PVEGTYPE_PATCH=ZVEGTYPE_PATCH, &
+ PPATCH=ZPATCH, KSIZE_P=ISIZE_P, &
+ KR_P=IR_P, OKEY=OKEY )
+ !
+ DEALLOCATE(ZPATCH)
+ DEALLOCATE(ZVEGTYPE_PATCH)
+ !
+ DO JP = 1,IO%NPATCH
+ PEK => NPE%AL(JP)
+ CALL ALLOCATE_GR_SNOW(PEK%TSNOW,NP%AL(JP)%NSIZE_P)
+ PEK%TSNOW%WSNOW = TNPSNOW%AL(JP)%WSNOW
+ PEK%TSNOW%RHO = TNPSNOW%AL(JP)%RHO
+ PEK%TSNOW%ALB = TNPSNOW%AL(JP)%ALB
+ IF (PEK%TSNOW%SCHEME/='D95') PEK%TSNOW%HEAT = TNPSNOW%AL(JP)%HEAT
+ IF (PEK%TSNOW%SCHEME=='CRO'.OR.PEK%TSNOW%SCHEME=='3-L') &
+ PEK%TSNOW%AGE = TNPSNOW%AL(JP)%AGE
+ IF (PEK%TSNOW%SCHEME=='CRO') THEN
+ PEK%TSNOW%GRAN1 = TNPSNOW%AL(JP)%GRAN1
+ PEK%TSNOW%GRAN2 = TNPSNOW%AL(JP)%GRAN2
+ PEK%TSNOW%HIST = TNPSNOW%AL(JP)%HIST
+ ENDIF
+ !
+ CALL TYPE_SNOW_INIT(TNPSNOW%AL(JP))
+ ENDDO
+ DEALLOCATE(TNPSNOW%AL)
+ !
DEALLOCATE(XWSNOW)
DEALLOCATE(XRSNOW)
DEALLOCATE(XTSNOW)
@@ -189,307 +282,359 @@ END IF
!
!* 3. Reading of input configuration (Grid and interpolation type)
!
-IF (GUNIF) THEN
- CALL PREP_ISBA_UNIF(ILUOUT,HSURF,ZFIELDIN)
-ELSE IF (YFILETYPE=='ASCLLV') THEN
- CALL PREP_ISBA_ASCLLV(DTCO, UG, U, USS, &
- HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
-ELSE IF (YFILETYPE=='GRIB ') THEN
- CALL PREP_ISBA_GRIB(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN,OKEY)
-ELSE IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='ASCII ' .OR. YFILETYPE=='LFI '.OR.YFILETYPE=='FA ') THEN
- CALL PREP_ISBA_EXTERN(DTCO, I, U,GCP, &
- HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,ILUOUT,ZFIELDIN,OKEY)
-ELSE IF (YFILETYPE=='BUFFER') THEN
- CALL PREP_ISBA_BUFFER(IG, U, &
- HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
-ELSE IF (YFILETYPE=='NETCDF') THEN
- CALL PREP_ISBA_NETCDF(DTCO, U, &
- HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
-ELSE
- CALL ABOR1_SFX('PREP_HOR_ISBA_FIELD: data file type not supported : '//YFILETYPE)
-END IF
+NULLIFY (ZFIELDIN, ZFIELDOUTP, ZFIELDOUTV)
+!
+IF (YDCTL%LPART1) THEN
+!
+ IF (GUNIF) THEN
+ CALL PREP_ISBA_UNIF(ILUOUT,HSURF,ZFIELDIN)
+ ELSE IF (YFILETYPE=='ASCLLV') THEN
+ CALL PREP_ISBA_ASCLLV(DTCO, UG, U, USS, HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
+ ELSE IF (YFILETYPE=='GRIB ') THEN
+ CALL PREP_GRIB_GRID(YFILE,ILUOUT,CINMODEL,CINGRID_TYPE,CINTERP_TYPE,TZTIME_GRIB)
+ IF (NRANK==NPIO) CALL PREP_ISBA_GRIB(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
+ ELSE IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='ASCII ' .OR. YFILETYPE=='LFI '&
+ .OR.YFILETYPE=='FA '.OR. YFILETYPE=='AROME '.OR.YFILETYPE=='NC ') THEN
+ CALL PREP_ISBA_EXTERN(DTCO, IO, U, GCP, HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,ILUOUT,ZFIELDIN,OKEY)
+ ELSE IF (YFILETYPE=='BUFFER') THEN
+ CALL PREP_ISBA_BUFFER(IG, U, HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
+ ELSE IF (YFILETYPE=='NETCDF') THEN
+ CALL PREP_ISBA_NETCDF(DTCO, U, HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
+ ELSE
+ CALL ABOR1_SFX('PREP_HOR_ISBA_FIELD: data file type not supported : '//YFILETYPE)
+ END IF
+!
+ INL = SIZE(ZFIELDIN,2)
+ INP = SIZE(ZFIELDIN,3)
+!
+ENDIF
!
!-------------------------------------------------------------------------------------
!
!* 5. Horizontal interpolation
!
-INL = SIZE(ZFIELDIN,2)
-INP = SIZE(ZFIELDIN,3)
+ CALL PREP_CTL_INT_PART2 (YDCTL, HSURF, CMASK, 'NATURE', ZFIELDIN)
!
-ALLOCATE(ZFIELDOUTP(INI,INL,INP))
-ALLOCATE(ZFIELD(SIZE(ZFIELDIN,1),INL))
+IF (YDCTL%LPART3) THEN
!
-ALLOCATE(ZPATCH(INI,INP))
-ZPATCH(:,:) = 0.
-!
-IF (INP==NVEGTYPE) THEN
- ZPATCH(:,:) = I%XVEGTYPE(:,:)
-ELSEIF (INP==I%NPATCH) THEN
- ZPATCH(:,:) = I%XPATCH(:,:)
-ELSEIF (INP<I%NPATCH) THEN
- DO JP = 1,I%NPATCH
- DO JVEG = 1,NVEGTYPE
- IP_I = VEGTYPE_TO_PATCH(JVEG,INP)
- IP_O = VEGTYPE_TO_PATCH(JVEG,I%NPATCH)
- !
- ! pour chaque patch d'entrée à interpoler, le masque
- ! est la somme des patchs de sortie (plus détaillés) présent sur
- ! chaque point
- IF (IP_O==JP) THEN
- ZPATCH(:,IP_I) = ZPATCH(:,IP_I) + I%XPATCH(:,IP_O)
- EXIT
- ENDIF
- ENDDO
- ENDDO
-ELSEIF (INP>I%NPATCH) THEN
- DO JP = 1,INP
- DO JVEG = 1,NVEGTYPE
- IP_I = VEGTYPE_TO_PATCH(JVEG,INP)
- IP_O = VEGTYPE_TO_PATCH(JVEG,I%NPATCH)
- !
- ! pour chaque patch d'entrée à interpoler, le masque
- ! est le patch de sortie (moins détaillé) présent
- ! sur ce point
- IF (IP_I==JP) THEN
- ZPATCH(:,IP_I) = I%XPATCH(:,IP_O)
- EXIT
- ENDIF
- ENDDO
- ENDDO
-ENDIF
-!
-DO JPATCH = 1, INP
-
- ZFIELD=ZFIELDIN(:,:,JPATCH)
- LINTERP(:) = (ZPATCH(:,JPATCH) > 0.)
- CALL HOR_INTERPOL(DTCO, U,GCP, &
- ILUOUT,ZFIELD,ZFIELDOUTP(:,:,JPATCH))
- LINTERP = .TRUE.
-
-END DO
+ IF (NRANK==NPIO) THEN
+ INL = SIZE(ZFIELDIN,2)
+ INP = SIZE(ZFIELDIN,3)
+ ELSEIF (.NOT.ASSOCIATED(ZFIELDIN)) THEN
+ ALLOCATE(ZFIELDIN(0,0,0))
+ ENDIF
!
-DEALLOCATE(ZFIELD)
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(INL,KIND(INL)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(INP,KIND(INP)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ ENDIF
+ ALLOCATE(ZFIELDOUTP(INI,INL,INP))
!
-ALLOCATE(ZFIELDOUTV(INI,INL,NVEGTYPE))
+! ZPATCH is the array of output patches put on the input patches
+ ALLOCATE(ZPATCH(INI,INP))
+ ZPATCH(:,:) = 0.
!
- CALL PUT_ON_ALL_VEGTYPES(INI,INL,INP,NVEGTYPE,ZFIELDOUTP,ZFIELDOUTV)
+ CALL GET_PREP_INTERP(INP,IO%NPATCH,S%XVEGTYPE,S%XPATCH,ZPATCH)
!
-DEALLOCATE(ZFIELDOUTP)
+ DO JP = 1, INP
+ ! we interpolate each point the output patch is present
+ LINTERP(:) = (ZPATCH(:,JP) > 0.)
+ CALL HOR_INTERPOL(DTCO, U, GCP, ILUOUT,ZFIELDIN(:,:,JP),ZFIELDOUTP(:,:,JP))
+ LINTERP = .TRUE.
+ END DO
!
-!-------------------------------------------------------------------------------------
+ DEALLOCATE(ZFIELDIN,ZPATCH)
!
-!* 6. Transformation from vegtype grid to patch grid
+ENDIF
!
-ALLOCATE(ZW (INI,SIZE(ZFIELDOUTV,2),I%NPATCH))
+ CALL PREP_CTL_INT_PART4 (YDCTL, HSURF, 'NATURE', CMASK, ZFIELDIN, ZFIELDOUTP)
+!
+IF (YDCTL%LPART5) THEN
+!
+ INL = SIZE (ZFIELDOUTP,2)
+ INP = SIZE (ZFIELDOUTP,3)
+!
+ IF (TRIM(HSURF)/="ZS") THEN
+ !
+ ALLOCATE(ZW%AL(IO%NPATCH))
+ !
+ IF (IO%NPATCH/=INP) THEN
+ !
+ ALLOCATE(ZFIELDOUTV(INI,INL,NVEGTYPE))
+ CALL PUT_ON_ALL_VEGTYPES(INI,INL,INP,NVEGTYPE,ZFIELDOUTP,ZFIELDOUTV)
+ !
+ !* 6. Transformation from vegtype grid to patch grid
+ !
+ DEALLOCATE(ZFIELDOUTP)
+ !
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ !
+ ALLOCATE(ZW%AL(JP)%ZOUT(PK%NSIZE_P,INL))
+ !
+ CALL VEGTYPE_GRID_TO_PATCH_GRID(JP, IO%NPATCH, PK%XVEGTYPE_PATCH, PK%XPATCH,&
+ PK%NR_P, ZFIELDOUTV, ZW%AL(JP)%ZOUT)
+ ENDDO
+ !
+ DEALLOCATE(ZFIELDOUTV)
+ !
+ ELSE
+ !
+ DO JP = 1,IO%NPATCH
+ !
+ PK => NP%AL(JP)
+ !
+ ALLOCATE(ZW%AL(JP)%ZOUT(PK%NSIZE_P,INL))
+ !
+ CALL PACK_SAME_RANK(PK%NR_P,ZFIELDOUTP(:,:,JP),ZW%AL(JP)%ZOUT)
+ !
+ ENDDO
+ !
+ DEALLOCATE(ZFIELDOUTP)
+ !
+ ENDIF
+ !
+ ENDIF
!
-ZW = 0.
- CALL VEGTYPE_GRID_TO_PATCH_GRID(I%NPATCH,I%XVEGTYPE_PATCH,I%XPATCH,ZFIELDOUTV,ZW)
!
!-------------------------------------------------------------------------------------
!
!* 7. Return to historical variable
!
!
-SELECT CASE (HSURF)
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
- CASE('ZS ')
- ALLOCATE(XZS_LS(INI))
- XZS_LS(:) = ZFIELDOUTV(:,1,1)
+ SELECT CASE (HSURF)
!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
- CASE('WG ')
- ALLOCATE(ZF (INI,I%NGROUND_LAYER,I%NPATCH))
- !
- !* interpolates on output levels
- CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW,I%XDG,ZF)
- !
- !* retrieves soil water content from soil relative humidity
- ALLOCATE(I%XWG(INI,I%NGROUND_LAYER,I%NPATCH))
- I%XWG(:,:,:)=XUNDEF
- IF(I%CISBA=='DIF')THEN
- IWORK(:,:)=I%NWG_LAYER(:,:)
- ELSE
- IWORK(:,:)=SIZE(I%XWG,2)
- ENDIF
- DO JPATCH=1,I%NPATCH
- DO JJ=1,INI
- IF(IWORK(JJ,JPATCH)==NUNDEF)CYCLE
- INL=IWORK(JJ,JPATCH)
- DO JL=1,INL
- I%XWG(JJ,JL,JPATCH) = I%XWWILT(JJ,JL) + ZF(JJ,JL,JPATCH) * (I%XWFC(JJ,JL)-I%XWWILT(JJ,JL))
- I%XWG(JJ,JL,JPATCH) = MAX(MIN(I%XWG(JJ,JL,JPATCH),I%XWSAT(JJ,JL)),XWGMIN)
- ENDDO
- ENDDO
- ENDDO
- !
- WHERE(ZF(:,:,:)==XUNDEF)I%XWG(:,:,:)=XUNDEF
- !
- DEALLOCATE(ZF)
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
- CASE('WGI ')
- ALLOCATE(ZF (INI,I%NGROUND_LAYER,I%NPATCH))
- !
- !* interpolates on output levels
- CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW,I%XDG,ZF)
- !
- !* retrieves soil ice content from soil relative humidity
- ALLOCATE(I%XWGI(INI,I%NGROUND_LAYER,I%NPATCH))
- I%XWGI(:,:,:)=0.0
- IF(I%CISBA=='DIF')THEN
- IWORK(:,:)=I%NWG_LAYER(:,:)
- ELSE
- IWORK(:,:)=2
- ENDIF
- DO JPATCH=1,I%NPATCH
- DO JJ=1,INI
- IF(IWORK(JJ,JPATCH)==NUNDEF)CYCLE
- INL=IWORK(JJ,JPATCH)
- DO JL=1,INL
- I%XWGI(JJ,JL,JPATCH) = ZF(JJ,JL,JPATCH) * I%XWSAT(JJ,JL)
- I%XWGI(JJ,JL,JPATCH) = MAX(MIN(I%XWGI(JJ,JL,JPATCH),I%XWSAT(JJ,JL)),0.)
- ENDDO
+ CASE('ZS ')
+ ALLOCATE(XZS_LS(INI))
+ XZS_LS(:) = ZFIELDOUTP(:,1,1)
+ DEALLOCATE(ZFIELDOUTP)
+ !
+ !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ !
+ CASE('WG ')
+ !
+ ALLOCATE(ZF%AL(IO%NPATCH))
+ !
+ DO JP = 1,IO%NPATCH
+ KK => NK%AL(JP)
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+ !
+ ALLOCATE(ZF%AL(JP)%ZOUT(PK%NSIZE_P,IO%NGROUND_LAYER))
+ !
+ !* interpolates on output levels
+ CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW%AL(JP)%ZOUT,PK%XDG,ZF%AL(JP)%ZOUT)
+ !
+ !* retrieves soil water content from soil relative humidity
+ ALLOCATE(PEK%XWG(PK%NSIZE_P,IO%NGROUND_LAYER))
+ PEK%XWG(:,:)=XUNDEF
+ IF(IO%CISBA=='DIF')THEN
+ IWORK(1:PK%NSIZE_P)=PK%NWG_LAYER(:)
+ ELSE
+ IWORK(1:PK%NSIZE_P)=SIZE(PEK%XWG,2)
+ ENDIF
+ DO JI=1,PK%NSIZE_P
+ IF(IWORK(JI)==NUNDEF)CYCLE
+ INL=IWORK(JI)
+ DO JL=1,INL
+ PEK%XWG(JI,JL) = KK%XWWILT(JI,JL) + ZF%AL(JP)%ZOUT(JI,JL) * (KK%XWFC(JI,JL)-KK%XWWILT(JI,JL))
+ PEK%XWG(JI,JL) = MAX(MIN(PEK%XWG(JI,JL),KK%XWSAT(JI,JL)),XWGMIN)
+ ENDDO
+ ENDDO
+ !
+ WHERE(ZF%AL(JP)%ZOUT(:,:)==XUNDEF) PEK%XWG(:,:)=XUNDEF
+ !
+ DEALLOCATE(ZF%AL(JP)%ZOUT)
+ ENDDO
+ !
+ DEALLOCATE(ZF%AL)
+ !
+ !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ !
+ CASE('WGI ')
+ ALLOCATE(ZF%AL(IO%NPATCH))
+ !
+ DO JP = 1,IO%NPATCH
+ KK => NK%AL(JP)
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+ !
+ ALLOCATE(ZF%AL(JP)%ZOUT(PK%NSIZE_P,IO%NGROUND_LAYER))
+ !
+ !* interpolates on output levels
+ CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW%AL(JP)%ZOUT,PK%XDG,ZF%AL(JP)%ZOUT)
+ !
+ !* retrieves soil ice content from soil relative humidity
+ ALLOCATE(PEK%XWGI(PK%NSIZE_P,IO%NGROUND_LAYER))
+ PEK%XWGI(:,:)=0.0
+ IF(IO%CISBA=='DIF')THEN
+ IWORK(1:PK%NSIZE_P)=PK%NWG_LAYER(:)
+ ELSE
+ IWORK(1:PK%NSIZE_P)=2
+ ENDIF
+ DO JI=1,PK%NSIZE_P
+ IF(IWORK(JI)==NUNDEF)CYCLE
+ INL=IWORK(JI)
+ DO JL=1,INL
+ PEK%XWGI(JI,JL) = ZF%AL(JP)%ZOUT(JI,JL) * KK%XWSAT(JI,JL)
+ PEK%XWGI(JI,JL) = MAX(MIN(PEK%XWGI(JI,JL),KK%XWSAT(JI,JL)),0.)
+ ENDDO
+ END DO
+ !
+ WHERE(ZF%AL(JP)%ZOUT(:,:)==XUNDEF ) PEK%XWGI(:,:)=XUNDEF
+ WHERE(PEK%XWGI(:,:)<=1.0E-10)PEK%XWGI(:,:)=0.0
+ !
+ DEALLOCATE(ZF%AL(JP)%ZOUT)
+ !
+ ENDDO
+ !
+ DEALLOCATE(ZF%AL)
+ !
+ !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ !
+ CASE('TG ')
+ IF(IO%LTEMP_ARP)THEN
+ INL=IO%NTEMPLAYER_ARP
+ ELSE
+ INL=IO%NGROUND_LAYER
+ ENDIF
+ !
+ DO JP = 1,IO%NPATCH
+ !
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+ !
+ ALLOCATE(PEK%XTG(PK%NSIZE_P,INL))
+ !
+ ALLOCATE(ZDG(SIZE(PK%XDG,1),INL))
+ IF (IO%CISBA=='2-L'.OR.IO%CISBA=='3-L') THEN
+ ZDG(:,1) = 0.01
+ ZDG(:,2) = 0.40 ! deep temperature for force-restore taken at 20cm
+ IF(IO%CISBA=='3-L') ZDG(:,3) = 5.00 ! climatological temperature, usually not used
+ IF(IO%LTEMP_ARP)THEN
+ ZDG(:,3) = 1.0
+ DO JL=4,INL
+ ZDG(:,JL) = ZDG(:,JL-1)+1.0
+ ENDDO
+ ENDIF
+ ELSE
+ !* diffusion method, the soil grid is the same as for humidity
+ ZDG(:,:) = PK%XDG(:,:)
+ END IF
+ CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW%AL(JP)%ZOUT,ZDG,PEK%XTG)
+ DEALLOCATE(ZDG)
+ !
+ ENDDO
+ !
+ !
+ !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ !
+ CASE('WR ')
+ DO JP = 1,IO%NPATCH
+ ALLOCATE(NPE%AL(JP)%XWR(NP%AL(JP)%NSIZE_P))
+ NPE%AL(JP)%XWR(:) = ZW%AL(JP)%ZOUT(:,1)
+
+ ENDDO
+ !
+ !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ !
+ CASE('WRL ')
+ DO JP = 1,IO%NPATCH
+ ALLOCATE(NPE%AL(JP)%XWRL(NP%AL(JP)%NSIZE_P))
+ NPE%AL(JP)%XWRL(:) = ZW%AL(JP)%ZOUT(:,1)
+ ENDDO
+ !
+ !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ !
+ CASE('WRLI ')
+ DO JP = 1,IO%NPATCH
+ ALLOCATE(NPE%AL(JP)%XWRLI(NP%AL(JP)%NSIZE_P))
+ NPE%AL(JP)%XWRLI(:) = ZW%AL(JP)%ZOUT(:,1)
+ ENDDO
+ !
+ !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ !
+ CASE('WRVN ')
+ DO JP = 1,IO%NPATCH
+ ALLOCATE(NPE%AL(JP)%XWRVN(NP%AL(JP)%NSIZE_P))
+ NPE%AL(JP)%XWRVN(:) = ZW%AL(JP)%ZOUT(:,1)
+ ENDDO
+ !
+ !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ !
+ CASE('TV ')
+ DO JP = 1,IO%NPATCH
+ ALLOCATE(NPE%AL(JP)%XTV(NP%AL(JP)%NSIZE_P))
+ NPE%AL(JP)%XTV(:) = ZW%AL(JP)%ZOUT(:,1)
+ ENDDO
+ !
+ !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ !
+ CASE('TL ')
+ DO JP = 1,IO%NPATCH
+ ALLOCATE(NPE%AL(JP)%XTL(NP%AL(JP)%NSIZE_P))
+ NPE%AL(JP)%XTL(:) = ZW%AL(JP)%ZOUT(:,1)
+ ENDDO
+ !
+ !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ !
+ CASE('TC ')
+ DO JP = 1,IO%NPATCH
+ ALLOCATE(NPE%AL(JP)%XTC(NP%AL(JP)%NSIZE_P))
+ NPE%AL(JP)%XTC(:) = ZW%AL(JP)%ZOUT(:,1)
+ ENDDO
+ !
+ !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ !
+ CASE('QC ')
+ DO JP = 1,IO%NPATCH
+ ALLOCATE(NPE%AL(JP)%XQC(NP%AL(JP)%NSIZE_P))
+ NPE%AL(JP)%XQC(:) = ZW%AL(JP)%ZOUT(:,1)
+ ENDDO
+ !
+ !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ !
+ CASE('LAI ')
+ !* LAI is updated only if present and pertinent (evolutive LAI) in input file
+ DO JP = 1,IO%NPATCH
+ IF (ANY(ZW%AL(JP)%ZOUT(:,:)/=XUNDEF)) THEN
+ ALLOCATE(NPE%AL(JP)%XLAI(NP%AL(JP)%NSIZE_P))
+ NPE%AL(JP)%XLAI(:) = ZW%AL(JP)%ZOUT(:,1)
+ ENDIF
+ ENDDO
+ !
+ !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ !
+ CASE('ICE_STO')
+ DO JP = 1,IO%NPATCH
+ ALLOCATE(NPE%AL(JP)%XICE_STO(NP%AL(JP)%NSIZE_P))
+ NPE%AL(JP)%XICE_STO(:) = ZW%AL(JP)%ZOUT(:,1)
+ ENDDO
+ !
+ END SELECT
+ !
+ IF (TRIM(HSURF)/="ZS") THEN
+ DO JP = 1,IO%NPATCH
+ DEALLOCATE(ZW%AL(JP)%ZOUT)
ENDDO
- END DO
- !
- WHERE(ZF (:,:,:)==XUNDEF )I%XWGI(:,:,:)=XUNDEF
- WHERE(I%XWGI(:,:,:)<=1.0E-10)I%XWGI(:,:,:)=0.0
- !
- DEALLOCATE(ZF)
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
- CASE('TG ')
- IF(I%LTEMP_ARP)THEN
- INL=I%NTEMPLAYER_ARP
- ELSE
- INL=I%NGROUND_LAYER
+ DEALLOCATE(ZW%AL)
ENDIF
- ALLOCATE(I%XTG(INI,INL,I%NPATCH))
- ALLOCATE(ZDG(SIZE(I%XDG,1),INL,SIZE(I%XDG,3)))
- IF (I%CISBA=='2-L'.OR.I%CISBA=='3-L') THEN
- DO JPATCH=1,I%NPATCH
- ZDG(:,1,JPATCH) = 0.01
- ZDG(:,2,JPATCH) = 0.40 ! deep temperature for force-restore taken at 20cm
- IF(I%CISBA=='3-L') ZDG(:,3,JPATCH) = 5.00 ! climatological temperature, usually not used
- ENDDO
- IF(I%LTEMP_ARP)THEN
- DO JPATCH=1,I%NPATCH
- ZDG(:,3,JPATCH) = 1.0
- DO JL=4,INL
- ZDG(:,JL,JPATCH) = ZDG(:,JL-1,JPATCH)+1.0
- ENDDO
- ENDDO
- ENDIF
- ELSE
- !* diffusion method, the soil grid is the same as for humidity
- ZDG(:,:,:) = I%XDG(:,:,:)
- END IF
- CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW,ZDG,I%XTG)
- DEALLOCATE(ZDG)
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
- CASE('WR ')
- ALLOCATE(I%XWR(INI,I%NPATCH))
- DO JPATCH=1,I%NPATCH
- I%XWR(:,JPATCH) = ZW(:,1,JPATCH)
- END DO
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
- CASE('WRL ')
- ALLOCATE(I%XWRL(INI,I%NPATCH))
- DO JPATCH=1,I%NPATCH
- I%XWRL(:,JPATCH) = ZW(:,1,JPATCH)
- END DO
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
- CASE('WRLI ')
- ALLOCATE(I%XWRLI(INI,I%NPATCH))
- DO JPATCH=1,I%NPATCH
- I%XWRLI(:,JPATCH) = ZW(:,1,JPATCH)
- END DO
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
- CASE('WRVN ')
- ALLOCATE(I%XWRVN(INI,I%NPATCH))
- DO JPATCH=1,I%NPATCH
- I%XWRVN(:,JPATCH) = ZW(:,1,JPATCH)
- END DO
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
- CASE('TV ')
- ALLOCATE(I%XTV(INI,I%NPATCH))
- DO JPATCH=1,I%NPATCH
- I%XTV(:,JPATCH) = ZW(:,1,JPATCH)
- END DO
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
- CASE('TL ')
- ALLOCATE(I%XTL(INI,I%NPATCH))
- DO JPATCH=1,I%NPATCH
- I%XTL(:,JPATCH) = ZW(:,1,JPATCH)
- END DO
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
- CASE('TC ')
- ALLOCATE(I%XTC(INI,I%NPATCH))
- DO JPATCH=1,I%NPATCH
- I%XTC(:,JPATCH) = ZW(:,1,JPATCH)
- END DO
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
- CASE('QC ')
- ALLOCATE(I%XQC(INI,I%NPATCH))
- DO JPATCH=1,I%NPATCH
- I%XQC(:,JPATCH) = ZW(:,1,JPATCH)
- END DO
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
- CASE('LAI ')
- !* LAI is updated only if present and pertinent (evolutive LAI) in input file
- IF (ANY(ZW(:,:,:)/=XUNDEF)) THEN
- DO JPATCH=1,I%NPATCH
- I%XLAI(:,JPATCH) = ZW(:,1,JPATCH)
- END DO
- END IF
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
- CASE('ICE_STO')
- ALLOCATE(I%XICE_STO(INI,I%NPATCH))
- DO JPATCH=1,I%NPATCH
- I%XICE_STO(:,JPATCH) = ZW(:,1,JPATCH)
- END DO
- !
-END SELECT
!
-DEALLOCATE(ZW)
+ENDIF
!-------------------------------------------------------------------------------------
!
!* 8. Deallocations
!
-DEALLOCATE(ZFIELDIN )
-DEALLOCATE(ZFIELDOUTV)
-!
IF (LHOOK) CALL DR_HOOK('PREP_HOR_ISBA_FIELD',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
!
- CONTAINS
+CONTAINS
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
@@ -498,10 +643,10 @@ SUBROUTINE INIT_FROM_REF_GRID(PGRID1,PT1,PD2,PT2)
!
USE MODI_INTERP_GRID_NAT
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PT1 ! variable profile
-REAL, DIMENSION(:), INTENT(IN) :: PGRID1 ! normalized grid
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PD2 ! output layer thickness
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PT2 ! variable profile
+REAL, DIMENSION(:,:), INTENT(IN) :: PT1 ! variable profile
+REAL, DIMENSION(:), INTENT(IN) :: PGRID1 ! normalized grid
+REAL, DIMENSION(:,:), INTENT(IN) :: PD2 ! output layer thickness
+REAL, DIMENSION(:,:), INTENT(OUT) :: PT2 ! variable profile
!
INTEGER :: JI,JL ! loop counter
REAL, DIMENSION(SIZE(PT1,1),SIZE(PT1,2)) :: ZD1 ! input grid
@@ -521,7 +666,8 @@ IF (SIZE(PT1,2)==3) THEN
!* 1. case with only 3 input levels (typically coming from 'UNIF')
! -----------------------------
!
- IF (I%CISBA=='2-L' .OR. I%CISBA=='3-L') THEN
+ IF (IO%CISBA=='2-L' .OR. IO%CISBA=='3-L') THEN
+
!* Possible LTEMP_ARP case
IF(SIZE(PT2,2)>3)THEN
ILAYER1=3
@@ -531,33 +677,31 @@ IF (SIZE(PT1,2)==3) THEN
ILAYER2=0
ENDIF
!* historical 2L or 3L ISBA version
- DO JPATCH=1,I%NPATCH
- PT2(:,1:ILAYER1,JPATCH) = PT1(:,1:ILAYER1,JPATCH)
- !* Possible LTEMP_ARP case
- IF(ILAYER2>0)THEN
- DO JL=ILAYER1+1,ILAYER2
- PT2(:,JL,JPATCH) = PT2(:,ILAYER1,JPATCH)
- ENDDO
- ENDIF
- END DO
- ELSEIF(I%CISBA=='DIF')THEN
- DO JPATCH=1,I%NPATCH
- !surface layer (generally 0.01m imposed)
- PT2(:,1,JPATCH) = PT1(:,1,JPATCH)
- !second layer
- PT2(:,2,JPATCH) = 0.25*PT1(:,1,JPATCH)+0.75*PT1(:,2,JPATCH)
- !others layers
- DO JI=1,SIZE(PT1,1)
- DO JL=3,I%NGROUND_LAYER
- IF(PD2(JI,JL,JPATCH)<=I%XDG2(JI,JPATCH))THEN
- !root layers
- PT2(JI,JL,JPATCH) = PT1(JI,2,JPATCH)
- ELSE
- !deep layers
- PT2(JI,JL,JPATCH) = PT1(JI,3,JPATCH)
- ENDIF
- END DO
- END DO
+ PT2(:,1:ILAYER1) = PT1(:,1:ILAYER1)
+ !* Possible LTEMP_ARP case
+ IF(ILAYER2>0)THEN
+ DO JL=ILAYER1+1,ILAYER2
+ PT2(:,JL) = PT2(:,ILAYER1)
+ ENDDO
+ ENDIF
+
+ ELSEIF(IO%CISBA=='DIF')THEN
+
+ !surface layer (generally 0.01m imposed)
+ PT2(:,1) = PT1(:,1)
+ !second layer
+ PT2(:,2) = 0.25*PT1(:,1)+0.75*PT1(:,2)
+ !others layers
+ DO JI=1,SIZE(PT1,1)
+ DO JL=3,IO%NGROUND_LAYER
+ IF(PD2(JI,JL)<=PK%XDG2(JI))THEN
+ !root layers
+ PT2(JI,JL) = PT1(JI,2)
+ ELSE
+ !deep layers
+ PT2(JI,JL) = PT1(JI,3)
+ ENDIF
+ END DO
END DO
END IF
!
@@ -572,10 +716,8 @@ ELSE
ZD1(:,JL) = PGRID1(JL)
ENDDO
!
- DO JPATCH=1,I%NPATCH
- ZD2(:,:) = PD2(:,:,JPATCH)
- CALL INTERP_GRID_NAT(ZD1,PT1(:,:,JPATCH),ZD2,PT2(:,:,JPATCH))
- ENDDO
+ ZD2(:,:) = PD2(:,:)
+ CALL INTERP_GRID_NAT(ZD1,PT1(:,:),ZD2,PT2(:,:))
!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
ENDIF
diff --git a/src/SURFEX/prep_hor_ocean_field.F90 b/src/SURFEX/prep_hor_ocean_field.F90
index 075fc738fda933d57348a9afe27fe0dee3d22f89..be0b3cd4b80e82824e46b379781cd01b9ee2724c 100644
--- a/src/SURFEX/prep_hor_ocean_field.F90
+++ b/src/SURFEX/prep_hor_ocean_field.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_HOR_OCEAN_FIELD (DTCO, UG, U, &
- O, OR, SG,GCP, &
- HPROGRAM, &
+SUBROUTINE PREP_HOR_OCEAN_FIELD (DTCO, UG, U, GCP, O, OR, KLAT, HPROGRAM, &
HFILE,HFILETYPE,KLUOUT,OUNIF, &
HSURF,HNCVARNAME )
! #######################################################
@@ -33,7 +31,7 @@ SUBROUTINE PREP_HOR_OCEAN_FIELD (DTCO, UG, U, &
!!------------------------------------------------------------------
!
!
-!
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
@@ -41,14 +39,11 @@ USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODD_OCEAN_n, ONLY : OCEAN_t
USE MODD_OCEAN_REL_n, ONLY : OCEAN_REL_t
-USE MODD_SEAFLUX_GRID_n, ONLY : SEAFLUX_GRID_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
!
USE MODD_CSTS, ONLY : XTT
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_OCEAN_GRID, ONLY : NOCKMIN,NOCKMAX
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE, XLAT_OUT, XLON_OUT,&
- XX_OUT, XY_OUT
+USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
!
USE MODI_PREP_OCEAN_UNIF
USE MODI_PREP_OCEAN_NETCDF
@@ -64,16 +59,14 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-!
-!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
TYPE(OCEAN_t), INTENT(INOUT) :: O
TYPE(OCEAN_REL_t), INTENT(INOUT) :: OR
-TYPE(SEAFLUX_GRID_t), INTENT(INOUT) :: SG
-TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+INTEGER, INTENT(IN) :: KLAT
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=28), INTENT(IN) :: HFILE ! file name
@@ -86,8 +79,8 @@ LOGICAL, INTENT(IN) :: OUNIF ! flag for prescribed uniform field
!
!* 0.2 declarations of local variables
!
-REAL, POINTER, DIMENSION(:,:,:) ::ZFIELDIN!field to interpolate horizontally
-REAL, POINTER, DIMENSION(:,:) ::ZFIELD !field to interpolate horizontally
+REAL, POINTER, DIMENSION(:,:,:) ::ZFIELDIN=>NULL()!field to interpolate horizontally
+REAL, POINTER, DIMENSION(:,:) ::ZFIELD=>NULL() !field to interpolate horizontally
REAL, ALLOCATABLE, DIMENSION(:,:,:)::ZFIELDOUT!field interpolated horizontally
!
INTEGER :: JLEV ! loop on oceanic vertical level
@@ -104,13 +97,11 @@ IF (OUNIF) THEN
WRITE(KLUOUT,*) '*****warning*****: you ask for uniform oceanic variables'
CALL PREP_OCEAN_UNIF(KLUOUT,HSURF,ZFIELDIN)
ELSE IF (HFILETYPE=='NETCDF') THEN
- CALL PREP_OCEAN_NETCDF(HPROGRAM,HSURF,HFILE,HFILETYPE,KLUOUT,&
- HNCVARNAME,ZFIELDIN)
+ CALL PREP_OCEAN_NETCDF(HPROGRAM,HSURF,HFILE,HFILETYPE,KLUOUT,HNCVARNAME,ZFIELDIN)
ELSE IF (HFILETYPE=='ASCII') THEN
WRITE(KLUOUT,*) 'PERSONAL LIB TEST FOR READING ',HFILETYPE,'file type'
WRITE(KLUOUT,*) 'ASCII FILE MUST CONTAIN LAT,LON,DEPTH,T,S,U,V'
- CALL PREP_OCEAN_ASCLLV(DTCO, UG, U, &
- HPROGRAM,HSURF,HFILE,KLUOUT,ZFIELDIN)
+ CALL PREP_OCEAN_ASCLLV(DTCO, UG, U, HPROGRAM,HSURF,HFILE,KLUOUT,ZFIELDIN)
ELSE
CALL ABOR1_SFX('PREP_OCEAN_HOR_FIELD: data file type not supported : '//HFILETYPE)
END IF
@@ -119,13 +110,12 @@ END IF
!
!* 3. Horizontal interpolation
!
-ALLOCATE(ZFIELDOUT (SIZE(SG%XLAT),SIZE(ZFIELDIN,2),SIZE(ZFIELDIN,3)) )
+ALLOCATE(ZFIELDOUT (KLAT,SIZE(ZFIELDIN,2),SIZE(ZFIELDIN,3)) )
ALLOCATE(ZFIELD(SIZE(ZFIELDIN,1),SIZE(ZFIELDIN,3)))
!
DO JLEV=1,SIZE(ZFIELDIN,2)
ZFIELD(:,:)=ZFIELDIN(:,JLEV,:)
- CALL HOR_INTERPOL(DTCO, U,GCP, &
- KLUOUT,ZFIELD,ZFIELDOUT(:,JLEV,:))
+ CALL HOR_INTERPOL(DTCO, U, GCP, KLUOUT,ZFIELD,ZFIELDOUT(:,JLEV,:))
ENDDO
!
!* 5. Return to historical variable
diff --git a/src/SURFEX/prep_hor_ocean_fields.F90 b/src/SURFEX/prep_hor_ocean_fields.F90
index 9eb454dad24f87bd58bbb0fcf4e82633454c470f..93975631d7f21d93358a33c8fc4de67272c9fdbb 100644
--- a/src/SURFEX/prep_hor_ocean_fields.F90
+++ b/src/SURFEX/prep_hor_ocean_fields.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_HOR_OCEAN_FIELDS (DTCO, UG, U, &
- O, OR, SG, S,GCP, &
+SUBROUTINE PREP_HOR_OCEAN_FIELDS (DTCO, UG, U, GCP, O, OR, KLAT, PSEABATHY, &
HPROGRAM,HSURF,HFILE,HFILETYPE,KLUOUT,OUNIF)
! #######################################################
!
@@ -31,20 +30,13 @@ SUBROUTINE PREP_HOR_OCEAN_FIELDS (DTCO, UG, U, &
!! Modified 07/2012, P. Le Moigne : CMO1D phasing
!!------------------------------------------------------------------
!
-!
-!
-!
-!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
USE MODD_OCEAN_n, ONLY : OCEAN_t
USE MODD_OCEAN_REL_n, ONLY : OCEAN_REL_t
-USE MODD_SEAFLUX_GRID_n, ONLY : SEAFLUX_GRID_t
-USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_OCEAN_CSTS, ONLY : XRHOSWREF
@@ -60,17 +52,15 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-!
-!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
TYPE(OCEAN_t), INTENT(INOUT) :: O
TYPE(OCEAN_REL_t), INTENT(INOUT) :: OR
-TYPE(SEAFLUX_GRID_t), INTENT(INOUT) :: SG
-TYPE(SEAFLUX_t), INTENT(INOUT) :: S
-TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+REAL, DIMENSION(:), INTENT(IN) :: PSEABATHY
+INTEGER, INTENT(IN) :: KLAT
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
@@ -99,29 +89,25 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('PREP_HOR_OCEAN_FIELDS',0,ZHOOK_HANDLE)
YSURF='TEMP_OC'
YNCVARNAME='temperature'
- CALL PREP_HOR_OCEAN_FIELD(DTCO, UG, U, &
- O, OR, SG,GCP, &
+ CALL PREP_HOR_OCEAN_FIELD(DTCO, UG, U, GCP, O, OR, KLAT, &
HPROGRAM,HFILE,HFILETYPE,KLUOUT,OUNIF,YSURF,YNCVARNAME)
!---------------------------------------------------------------------------
!
!* 4. Treatment of oceanic salinity
YSURF='SALT_OC'
YNCVARNAME='salinity'
- CALL PREP_HOR_OCEAN_FIELD(DTCO, UG, U, &
- O, OR, SG,GCP, &
+ CALL PREP_HOR_OCEAN_FIELD(DTCO, UG, U, GCP, O, OR, KLAT, &
HPROGRAM,HFILE,HFILETYPE,KLUOUT,OUNIF,YSURF,YNCVARNAME)
!---------------------------------------------------------------------------
!
!* 5. Treatment of oceanic current
YSURF='UCUR_OC'
YNCVARNAME='u'
- CALL PREP_HOR_OCEAN_FIELD(DTCO, UG, U, &
- O, OR, SG,GCP, &
+ CALL PREP_HOR_OCEAN_FIELD(DTCO, UG, U, GCP, O, OR, KLAT, &
HPROGRAM,HFILE,HFILETYPE,KLUOUT,OUNIF,YSURF,YNCVARNAME)
YSURF='VCUR_OC'
YNCVARNAME='v'
- CALL PREP_HOR_OCEAN_FIELD(DTCO, UG, U, &
- O, OR, SG,GCP, &
+ CALL PREP_HOR_OCEAN_FIELD(DTCO, UG, U, GCP, O, OR, KLAT, &
HPROGRAM,HFILE,HFILETYPE,KLUOUT,OUNIF,YSURF,YNCVARNAME)
!---------------------------------------------------------------------------
!
@@ -155,7 +141,7 @@ IF (IL/=0) THEN
!! apply bathy mask
DO J=1,IL
DO JLEV=IK1+1,NOCKMAX
- IF (S%XSEABATHY(J)-XZHOC(JLEV)>0.) THEN
+ IF (PSEABATHY(J)-XZHOC(JLEV)>0.) THEN
O%XSEABATH(J,JLEV)=0.
O%XSEAE(J,JLEV) = XUNDEF
O%XSEAU(J,JLEV) = XUNDEF
diff --git a/src/SURFEX/prep_hor_seaflux_field.F90 b/src/SURFEX/prep_hor_seaflux_field.F90
index 23d2b7df2593240af14f453de30d27d7588140e5..65922f9fa1ee26b0b1408933e85fd90103decf30 100644
--- a/src/SURFEX/prep_hor_seaflux_field.F90
+++ b/src/SURFEX/prep_hor_seaflux_field.F90
@@ -3,9 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_HOR_SEAFLUX_FIELD (DTCO, UG, U, &
- DTS, O, OR, SG, S,GCP, &
- HPROGRAM,HSURF,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+SUBROUTINE PREP_HOR_SEAFLUX_FIELD (DTCO, UG, U, GCP, DTS, O, OR, KLAT, S, &
+ HPROGRAM,HSURF,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
! #################################################################################
!
!!**** *PREP_HOR_SEAFLUX_FIELD* - reads, interpolates and prepares a sea field
@@ -30,31 +29,28 @@ SUBROUTINE PREP_HOR_SEAFLUX_FIELD (DTCO, UG, U, &
!! P. Le Moigne 10/2005, Phasage Arome
!! P. Le Moigne 09/2007, sst from clim
!! S. Senesi 09/2013, extends to fields of SSS and SIC
+!! P. Marguinaud10/2014, Support for a 2-part PREP
!!------------------------------------------------------------------
!
-
-!
-!
-!
-!
-!
-!
-!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_t
USE MODD_OCEAN_n, ONLY : OCEAN_t
USE MODD_OCEAN_REL_n, ONLY : OCEAN_REL_t
-USE MODD_SEAFLUX_GRID_n, ONLY : SEAFLUX_GRID_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
!
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE, XZS_LS, XLAT_OUT, XLON_OUT, &
- XX_OUT, XY_OUT, CMASK
+USE MODD_TYPE_DATE_SURF, ONLY : DATE_TIME
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC
+USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE, XZS_LS, CMASK
!
+USE MODD_GRID_GRIB, ONLY : CINMODEL
+!
+USE MODE_PREP_CTL, ONLY : PREP_CTL, PREP_CTL_INT_PART2, PREP_CTL_INT_PART4
+!
+USE MODI_PREP_GRIB_GRID
USE MODI_READ_PREP_SEAFLUX_CONF
USE MODI_PREP_SEAFLUX_GRIB
USE MODI_PREP_SEAFLUX_UNIF
@@ -71,22 +67,26 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
USE MODI_ABOR1_SFX
-IMPLICIT NONE
!
-!* 0.1 declarations of arguments
+IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
!
+!* 0.1 declarations of arguments
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
TYPE(DATA_SEAFLUX_t), INTENT(INOUT) :: DTS
TYPE(OCEAN_t), INTENT(INOUT) :: O
TYPE(OCEAN_REL_t), INTENT(INOUT) :: OR
-TYPE(SEAFLUX_GRID_t), INTENT(INOUT) :: SG
+INTEGER, INTENT(IN) :: KLAT
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
-TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+TYPE (PREP_CTL), INTENT(INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
@@ -102,10 +102,16 @@ TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
CHARACTER(LEN=6) :: YFILEPGDTYPE ! type of input file
CHARACTER(LEN=28) :: YFILEPGD ! name of file
REAL, POINTER, DIMENSION(:,:) :: ZFIELDIN ! field to interpolate horizontally
-REAL, ALLOCATABLE, DIMENSION(:,:) :: ZFIELDOUT ! field interpolated horizontally
-INTEGER :: ILUOUT ! output listing logical unit
+REAL, POINTER, DIMENSION(:,:) :: ZFIELDOUT ! field interpolated horizontally
+TYPE (DATE_TIME) :: TZTIME_GRIB ! current date and time
+INTEGER :: ILUOUT ! output listing logical unit
+INTEGER :: INFOMPI, INL
!
LOGICAL :: GUNIF ! flag for prescribed uniform field
+ CHARACTER (LEN=28) :: CLFILE
+INTEGER :: IRESP
+ CHARACTER (LEN=100) :: CLCOMMENT
+ CHARACTER (LEN=6) :: CLSCHEME
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
!
@@ -115,72 +121,100 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('PREP_HOR_SEAFLUX_FIELD',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
- CALL READ_PREP_SEAFLUX_CONF(O, &
+ CALL READ_PREP_SEAFLUX_CONF(O%LMERCATOR, &
HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,&
HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,ILUOUT,GUNIF)
!
CMASK = 'SEA'
+!
+NULLIFY (ZFIELDIN, ZFIELDOUT)
+!
+IF (YDCTL%LPART1) THEN
+!
!--------------------------------------------------------------------- ----------------
!
!* 2. Reading of input configuration (Grid and interpolation type)
!
-IF (GUNIF) THEN
- CALL PREP_SEAFLUX_UNIF(ILUOUT,HSURF,ZFIELDIN)
-ELSE IF (YFILETYPE=='GRIB ') THEN
- CALL PREP_SEAFLUX_GRIB(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
-ELSE IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='ASCII ' .OR. YFILETYPE=='LFI '.OR. YFILETYPE=='FA ') THEN
- CALL PREP_SEAFLUX_EXTERN(GCP,&
- HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,ILUOUT,ZFIELDIN)
-ELSE IF (YFILETYPE=='BUFFER') THEN
- CALL PREP_SEAFLUX_BUFFER(HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
-ELSE IF (YFILETYPE=='NETCDF') THEN
- CALL PREP_SEAFLUX_NETCDF(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
-ELSE
- CALL ABOR1_SFX('PREP_HOR_SEAFLUX_FIELD: data file type not supported : '//YFILETYPE)
-END IF
+ IF (GUNIF) THEN
+ CALL PREP_SEAFLUX_UNIF(ILUOUT,HSURF,ZFIELDIN)
+ ELSE IF (YFILETYPE=='GRIB ') THEN
+ CALL PREP_GRIB_GRID(YFILE,ILUOUT,CINMODEL,CINGRID_TYPE,CINTERP_TYPE,TZTIME_GRIB)
+ IF (NRANK==NPIO) CALL PREP_SEAFLUX_GRIB(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
+ ELSE IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='ASCII ' .OR. YFILETYPE=='LFI '&
+ .OR. YFILETYPE=='FA '.OR. YFILETYPE=='AROME '.OR.YFILETYPE=='NC ') THEN
+ CALL PREP_SEAFLUX_EXTERN(GCP,HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,ILUOUT,ZFIELDIN)
+ ELSE IF (YFILETYPE=='BUFFER') THEN
+ CALL PREP_SEAFLUX_BUFFER(HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
+ ELSE IF (YFILETYPE=='NETCDF') THEN
+ CALL PREP_SEAFLUX_NETCDF(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
+ ELSE
+ CALL ABOR1_SFX('PREP_HOR_SEAFLUX_FIELD: data file type not supported : '//YFILETYPE)
+ END IF
+!
+ENDIF
!
!
!* 4. Horizontal interpolation
!
-ALLOCATE(ZFIELDOUT(SIZE(SG%XLAT),SIZE(ZFIELDIN,2)))
+ CALL PREP_CTL_INT_PART2 (YDCTL, HSURF, 'SEA', CMASK, ZFIELDIN)
!
- CALL HOR_INTERPOL(DTCO, U,GCP, &
- ILUOUT,ZFIELDIN,ZFIELDOUT)
+IF (YDCTL%LPART3) THEN
!
-!* 5. Return to historical variable
+ IF (NRANK==NPIO) THEN
+ INL = SIZE(ZFIELDIN,2)
+ ELSEIF (.NOT.ASSOCIATED(ZFIELDIN)) THEN
+ ALLOCATE(ZFIELDIN(0,0))
+ ENDIF
!
-SELECT CASE (HSURF)
- CASE('ZS ')
- ALLOCATE(XZS_LS(SIZE(ZFIELDOUT,1)))
- XZS_LS(:) = ZFIELDOUT(:,1)
- CASE('SST ')
- ALLOCATE(S%XSST(SIZE(ZFIELDOUT,1)))
- S%XSST(:) = ZFIELDOUT(:,1)
- IF (DTS%LSST_DATA) THEN
- ! XSST is derived from array XDATA_SST from MODD_DATA_SEAFLUX, with time interpolation
- CALL PREP_SST_INIT(DTS, S, &
- S%XSST)
- END IF
- IF (O%LMERCATOR) THEN
- ! Preparing input for ocean 1D model
- CALL PREP_HOR_OCEAN_FIELDS(DTCO, UG, U, &
- O, OR, SG, S,GCP, &
- HPROGRAM,HSURF,YFILE,YFILETYPE,ILUOUT,GUNIF)
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(INL,KIND(INL)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
ENDIF
- CASE('SSS ')
- ALLOCATE(S%XSSS(SIZE(ZFIELDOUT,1)))
- S%XSSS(:) = ZFIELDOUT(:,1)
- CASE('SIC ')
- ALLOCATE(S%XSIC(SIZE(ZFIELDOUT,1)))
- S%XSIC(:) = ZFIELDOUT(:,1)
-END SELECT
+ ALLOCATE(ZFIELDOUT(KLAT,INL))
+!
+ CALL HOR_INTERPOL(DTCO, U, GCP, ILUOUT,ZFIELDIN,ZFIELDOUT)
+!
+ENDIF
+!
+ CALL PREP_CTL_INT_PART4 (YDCTL, HSURF, 'SEA', CMASK, ZFIELDIN, ZFIELDOUT)
+!
+IF (YDCTL%LPART5) THEN
+!
+!* 5. Return to historical variable
+!
+ SELECT CASE (HSURF)
+ CASE('ZS ')
+ ALLOCATE(XZS_LS(SIZE(ZFIELDOUT,1)))
+ XZS_LS(:) = ZFIELDOUT(:,1)
+ CASE('SST ')
+ ALLOCATE(S%XSST(SIZE(ZFIELDOUT,1)))
+ S%XSST(:) = ZFIELDOUT(:,1)
+ IF (DTS%LSST_DATA) THEN
+ ! XSST is derived from array XDATA_SST from MODD_DATA_SEAFLUX, with time interpolation
+ CALL PREP_SST_INIT(DTS, S%TTIME, S%JSX, S%XSST)
+ END IF
+ IF (O%LMERCATOR) THEN
+ ! Preparing input for ocean 1D model
+ CALL PREP_HOR_OCEAN_FIELDS(DTCO, UG, U, GCP, O, OR, KLAT, S%XSEABATHY, &
+ HPROGRAM,HSURF,YFILE,YFILETYPE,ILUOUT,GUNIF)
+ ENDIF
+ CASE('SSS ')
+ ALLOCATE(S%XSSS(SIZE(ZFIELDOUT,1)))
+ S%XSSS(:) = ZFIELDOUT(:,1)
+ CASE('SIC ')
+ ALLOCATE(S%XSIC(SIZE(ZFIELDOUT,1)))
+ S%XSIC(:) = ZFIELDOUT(:,1)
+ END SELECT
+!
+ENDIF
!
!-------------------------------------------------------------------------------------
!
!* 6. Deallocations
!
-DEALLOCATE(ZFIELDIN )
-DEALLOCATE(ZFIELDOUT)
+IF (ASSOCIATED (ZFIELDIN)) DEALLOCATE(ZFIELDIN )
+IF (ASSOCIATED (ZFIELDOUT)) DEALLOCATE(ZFIELDOUT)
IF (LHOOK) CALL DR_HOOK('PREP_HOR_SEAFLUX_FIELD',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_hor_snow_field.F90 b/src/SURFEX/prep_hor_snow_field.F90
index 18480df9768c354ca29b6ec47b7de8562bfe3325..d10f234884922a4db9267408cc6b1083c476fee9 100644
--- a/src/SURFEX/prep_hor_snow_field.F90
+++ b/src/SURFEX/prep_hor_snow_field.F90
@@ -3,21 +3,19 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_HOR_SNOW_FIELD (DTCO, &
- IG, U,GCP, &
- HPROGRAM, &
+SUBROUTINE PREP_HOR_SNOW_FIELD (DTCO, G, U, GCP, HPROGRAM, &
HFILE,HFILETYPE, &
HFILEPGD,HFILEPGDTYPE, &
KLUOUT,OUNIF,HSNSURF,KPATCH, &
- KTEB_PATCH, &
- KL,TPSNOW, TPTIME, &
+ KTEB_PATCH, &
+ KL,TNPSNOW, TPTIME, &
PUNIF_WSNOW, PUNIF_RSNOW, &
PUNIF_TSNOW, PUNIF_LWCSNOW, &
PUNIF_ASNOW, OSNOW_IDEAL, &
PUNIF_SG1SNOW, PUNIF_SG2SNOW, &
- PUNIF_HISTSNOW,PUNIF_AGESNOW, &
- PF,PDEPTH,PVEGTYPE, &
- PVEGTYPE_PATCH,PPATCH )
+ PUNIF_HISTSNOW,PUNIF_AGESNOW, YDCTL, &
+ PVEGTYPE_PATCH, PPATCH, &
+ KSIZE_P, KR_P, PDEPTH )
! #######################################################
!
!!**** *PREP_HOR_SNOW_FIELD* - reads, interpolates and prepares a snow field
@@ -44,38 +42,45 @@ SUBROUTINE PREP_HOR_SNOW_FIELD (DTCO, &
!! M. Lafaysse 11/2012, snow liquid water content
!! B. Decharme 04/2014, external init with FA files
!! new init for ES
+!! P. Marguinaud10/2014, Support for a 2-part PREP
!!------------------------------------------------------------------
!
-!
-!
-!
-!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
!
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
USE MODD_TYPE_SNOW
USE MODD_TYPE_DATE_SURF, ONLY : DATE_TIME
!
+USE MODE_PREP_CTL, ONLY : PREP_CTL, PREP_CTL_INT_PART2, PREP_CTL_INT_PART4
+!
+USE MODD_GRID_GRIB, ONLY : CINMODEL
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC
+!
USE MODD_CSTS, ONLY : XTT
USE MODD_PREP_SNOW, ONLY : XGRID_SNOW
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, NVT_SNOW
-USE MODD_PREP, ONLY : LINTERP
+USE MODD_PREP, ONLY : LINTERP,CINTERP_TYPE,CINGRID_TYPE, CMASK
!
USE MODD_SNOW_PAR, ONLY : XANSMAX
!
+USE MODI_PREP_GRIB_GRID
USE MODI_PREP_SNOW_GRIB
USE MODI_PREP_SNOW_UNIF
USE MODI_PREP_SNOW_EXTERN
USE MODI_PREP_SNOW_BUFFER
USE MODI_HOR_INTERPOL
USE MODI_VEGTYPE_GRID_TO_PATCH_GRID
-USE MODI_SNOW_HEAT_TO_T_WLIQ
+USE MODI_SNOW_T_WLIQ_TO_HEAT
USE MODI_VEGTYPE_TO_PATCH
+USE MODI_PACK_SAME_RANK
+USE MODI_GET_PREP_INTERP
+USE MODI_PUT_ON_ALL_VEGTYPES
+!
+USE MODE_SNOW3L, ONLY : SNOW3LGRID
!
USE MODI_ABOR1_SFX
!
@@ -84,15 +89,19 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
-!* 0.1 declarations of arguments
-!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
!
+!* 0.1 declarations of arguments
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
!
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
+TYPE(GRID_t), INTENT(INOUT) :: G
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
+TYPE (PREP_CTL), INTENT (INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=28), INTENT(IN) :: HFILE ! file name
@@ -104,41 +113,52 @@ LOGICAL, INTENT(IN) :: OUNIF ! flag for prescribed uniform field
CHARACTER(LEN=10) :: HSNSURF ! type of field
INTEGER, INTENT(IN) :: KPATCH ! patch number for output scheme
INTEGER, INTENT(IN) :: KTEB_PATCH
+TYPE(NSURF_SNOW), INTENT(INOUT) :: TNPSNOW ! snow fields
INTEGER, INTENT(IN) :: KL ! number of points
-TYPE(SURF_SNOW) :: TPSNOW ! snow fields
TYPE(DATE_TIME), INTENT(IN) :: TPTIME ! date and time
REAL, DIMENSION(:), INTENT(IN) :: PUNIF_WSNOW ! prescribed snow content (kg/m2)
REAL, DIMENSION(:), INTENT(IN) :: PUNIF_RSNOW ! prescribed density (kg/m3)
REAL, DIMENSION(:), INTENT(IN) :: PUNIF_TSNOW ! prescribed temperature (K)
REAL, DIMENSION(:), INTENT(IN) :: PUNIF_LWCSNOW ! prescribed snow liquid water content (kg/m3)
REAL, INTENT(IN) :: PUNIF_ASNOW ! prescribed albedo (-)
-LOGICAL, INTENT(IN) :: OSNOW_IDEAL
+LOGICAL, INTENT(INOUT) :: OSNOW_IDEAL
REAL, DIMENSION(:), INTENT(IN) :: PUNIF_SG1SNOW !
REAL, DIMENSION(:), INTENT(IN) :: PUNIF_SG2SNOW !
REAL, DIMENSION(:), INTENT(IN) :: PUNIF_HISTSNOW !
REAL, DIMENSION(:), INTENT(IN) :: PUNIF_AGESNOW !
-
-REAL,DIMENSION(:,:,:), INTENT(OUT),OPTIONAL :: PF ! output field (x,kpatch)
-REAL,DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PDEPTH ! thickness of each snow layer
-REAL,DIMENSION(:,:), INTENT(IN), OPTIONAL :: PVEGTYPE ! fraction of each vegtype
-REAL,DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PVEGTYPE_PATCH ! fraction of each vegtype per patch
-REAL,DIMENSION(:,:), INTENT(IN), OPTIONAL :: PPATCH ! fraction of each patch
!
+REAL,DIMENSION(:,:,:), INTENT(IN) :: PVEGTYPE_PATCH ! fraction of each vegtype per patch
+REAL,DIMENSION(:,:), INTENT(IN) :: PPATCH ! fraction of each patch
+INTEGER, DIMENSION(:), INTENT(IN) :: KSIZE_P
+INTEGER,DIMENSION(:,:), INTENT(IN) :: KR_P
+!
+REAL,DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PDEPTH ! thickness of each snow layer
!
!* 0.2 declarations of local variables
!
-REAL, POINTER, DIMENSION(:,:,:) :: ZFIELDIN ! field to interpolate horizontally
-REAL, POINTER, DIMENSION(:,:) :: ZFIELD ! field to interpolate horizontally
-REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZFIELDOUT ! field interpolated horizontally
-REAL, ALLOCATABLE, DIMENSION(:,:) :: ZD ! snow depth (x, kpatch)
-REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZW ! work array (x, fine snow grid, kpatch)
-REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZHEAT ! work array (x, output snow grid, kpatch)
+TYPE FOUT
+ REAL, DIMENSION(:,:), ALLOCATABLE :: ZOUT
+END TYPE FOUT
+TYPE NFOUT
+ TYPE(FOUT), DIMENSION(:), ALLOCATABLE :: AL
+END TYPE NFOUT
+TYPE (NFOUT) :: ZW
+TYPE(SURF_SNOW), POINTER :: SK
+!
+REAL, POINTER, DIMENSION(:,:,:) :: ZFIELDIN ! field to interpolate horizontally
+REAL, POINTER, DIMENSION(:,:,:) :: ZFIELDOUTP ! field interpolated horizontally
+REAL, POINTER, DIMENSION(:,:,:) :: ZFIELDOUTV !
+REAL, ALLOCATABLE, DIMENSION(:) :: ZD ! snow depth (x, kpatch)
+REAL, ALLOCATABLE, DIMENSION(:,:) :: ZTEMP
+REAL, ALLOCATABLE, DIMENSION(:,:) :: ZWLIQ ! liquid water snow pack content
REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZGRID ! grid array (x, output snow grid, kpatch)
!
-LOGICAL :: GSNOW_IDEAL
-INTEGER :: JPATCH ! loop on patches
-INTEGER :: JVEGTYPE ! loop on vegtypes
-INTEGER :: JLAYER ! loop on layers
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDEPTH, ZPATCH
+!
+TYPE (DATE_TIME) :: TZTIME_GRIB ! current date and time
+INTEGER :: JP, IP ! loop on patches
+INTEGER :: JL ! loop on layers
+INTEGER :: INFOMPI, INL, INP, ISNOW_NLAYER, IMASK, JI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
!
@@ -147,338 +167,435 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PREP_HOR_SNOW_FIELD',0,ZHOOK_HANDLE)
!
-GSNOW_IDEAL = .FALSE.
+ISNOW_NLAYER = TNPSNOW%AL(1)%NLAYER
!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
!* 2. Reading of input configuration (Grid and interpolation type)
!
-IF (OUNIF) THEN
- GSNOW_IDEAL = OSNOW_IDEAL
- CALL PREP_SNOW_UNIF(KLUOUT,HSNSURF,ZFIELDIN, TPTIME, GSNOW_IDEAL, &
- PUNIF_WSNOW, PUNIF_RSNOW, PUNIF_TSNOW, &
- PUNIF_LWCSNOW, PUNIF_ASNOW, PUNIF_SG1SNOW, &
- PUNIF_SG2SNOW, PUNIF_HISTSNOW, PUNIF_AGESNOW, &
- TPSNOW%NLAYER )
-ELSE IF (HFILETYPE=='GRIB ') THEN
- CALL PREP_SNOW_GRIB(HPROGRAM,HSNSURF,HFILE,KLUOUT,TPSNOW%NLAYER,ZFIELDIN)
-ELSE IF (HFILETYPE=='MESONH' .OR. HFILETYPE=='ASCII ' .OR. HFILETYPE=='LFI '.OR. HFILETYPE=='FA ') THEN
- GSNOW_IDEAL = OSNOW_IDEAL
- CALL PREP_SNOW_EXTERN(GCP,&
- HPROGRAM,HSNSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,&
- KLUOUT,ZFIELDIN,GSNOW_IDEAL,TPSNOW%NLAYER,KTEB_PATCH)
-ELSE IF (HFILETYPE=='BUFFER') THEN
- CALL PREP_SNOW_BUFFER(IG, U, &
- HPROGRAM,HSNSURF,KLUOUT,TPSNOW%NLAYER,ZFIELDIN)
-ELSE
- CALL ABOR1_SFX('PREP_HOR_SNOW_FIELD: data file type not supported : '//HFILETYPE)
-END IF
+NULLIFY (ZFIELDIN, ZFIELDOUTP, ZFIELDOUTV)
+!
+IF (YDCTL%LPART1) THEN
+ IF (OUNIF) THEN
+ CALL PREP_SNOW_UNIF(KLUOUT,HSNSURF,ZFIELDIN, TPTIME, OSNOW_IDEAL, &
+ PUNIF_WSNOW, PUNIF_RSNOW, PUNIF_TSNOW, &
+ PUNIF_LWCSNOW, PUNIF_ASNOW, PUNIF_SG1SNOW, &
+ PUNIF_SG2SNOW, PUNIF_HISTSNOW, PUNIF_AGESNOW, &
+ ISNOW_NLAYER )
+ ELSE IF (HFILETYPE=='GRIB ') THEN
+ CALL PREP_GRIB_GRID(HFILE,KLUOUT,CINMODEL,CINGRID_TYPE,CINTERP_TYPE,TZTIME_GRIB)
+ IF (NRANK==NPIO) CALL PREP_SNOW_GRIB(HPROGRAM,HSNSURF,HFILE,KLUOUT,ISNOW_NLAYER,ZFIELDIN)
+ ELSE IF (HFILETYPE=='MESONH' .OR. HFILETYPE=='ASCII ' .OR. HFILETYPE=='LFI '&
+ .OR. HFILETYPE=='FA '.OR. HFILETYPE=='AROME '.OR.HFILETYPE=='NC ') THEN
+ CALL PREP_SNOW_EXTERN(GCP,HPROGRAM,HSNSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE, &
+ KLUOUT,ZFIELDIN,OSNOW_IDEAL,ISNOW_NLAYER,KTEB_PATCH)
+ ELSE IF (HFILETYPE=='BUFFER') THEN
+ CALL PREP_SNOW_BUFFER(G, U, HPROGRAM,HSNSURF,KLUOUT,ISNOW_NLAYER,ZFIELDIN)
+ ELSE
+ CALL ABOR1_SFX('PREP_HOR_SNOW_FIELD: data file type not supported : '//HFILETYPE)
+ END IF
+ENDIF
!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
!* 3. Horizontal interpolation
!
-ALLOCATE(ZFIELDOUT(KL,SIZE(ZFIELDIN,2),SIZE(ZFIELDIN,3)))
-ALLOCATE(ZFIELD(SIZE(ZFIELDIN,1),SIZE(ZFIELDIN,2)))
-!
-DO JVEGTYPE = 1, SIZE(ZFIELDIN,3)
- !* horizontal interpolation
- ZFIELD=ZFIELDIN(:,:,JVEGTYPE)
- IF(PRESENT(PVEGTYPE).AND.SIZE(ZFIELDIN,3)==NVEGTYPE) LINTERP(:) = (PVEGTYPE(:,JVEGTYPE) > 0.)
- IF(PRESENT(PDEPTH)) THEN
- JPATCH = 1
- IF (KPATCH>1) JPATCH = VEGTYPE_TO_PATCH(JVEGTYPE,KPATCH)
- LINTERP(:) = (LINTERP(:).AND.PDEPTH(:,1,JPATCH)>0..AND.PDEPTH(:,1,JPATCH)<XUNDEF)
- ENDIF
- !
- CALL HOR_INTERPOL(DTCO, U, GCP,&
- KLUOUT,ZFIELD,ZFIELDOUT(:,:,JVEGTYPE))
- !
- LINTERP(:) = .TRUE.
-END DO
+CALL PREP_CTL_INT_PART2 (YDCTL, HSNSURF, 'SNOW', CMASK, ZFIELDIN)
!
-DEALLOCATE(ZFIELD)
-!
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-!
-!* 4. Transformation from vegtype grid to patch grid, if any
+IF (YDCTL%LPART3) THEN
!
-ALLOCATE(ZW (SIZE(ZFIELDOUT,1),SIZE(ZFIELDOUT,2),KPATCH))
-!
-ZW = 0.
-IF (SIZE(ZFIELDOUT,3)==NVEGTYPE.AND.SIZE(PVEGTYPE_PATCH,2)==NVEGTYPE) THEN
- CALL VEGTYPE_GRID_TO_PATCH_GRID(KPATCH,PVEGTYPE_PATCH,PPATCH,ZFIELDOUT,ZW)
-ELSE
- DO JPATCH=1,KPATCH
- ZW(:,:,JPATCH) = ZFIELDOUT(:,:,1)
- END DO
-END IF
-!
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-!
-!* 5. Defines normalized output grid, if depths of snow layers are present
-!
-IF (PRESENT(PDEPTH) .AND. .NOT.GSNOW_IDEAL) THEN
-!
-!* total snow depth
+ IF (NRANK==NPIO) THEN
+ INL = SIZE(ZFIELDIN,2)
+ INP = SIZE(ZFIELDIN,3)
+ ELSEIF (.NOT.ASSOCIATED(ZFIELDIN)) THEN
+ ALLOCATE(ZFIELDIN(0,0,0))
+ ENDIF
!
- ALLOCATE(ZD(SIZE(TPSNOW%WSNOW,1),KPATCH))
- ZD(:,:)=0.
- DO JPATCH=1,KPATCH
- DO JLAYER=1,TPSNOW%NLAYER
- WHERE (PDEPTH(:,JLAYER,JPATCH)/=XUNDEF) ZD(:,JPATCH) = ZD(:,JPATCH) + PDEPTH(:,JLAYER,JPATCH)
- END DO
- END DO
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(INL,KIND(INL)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(INP,KIND(INP)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ ENDIF
+!
+ ALLOCATE(ZFIELDOUTP(KL,INL,INP))
+!
+! ZPATCH is the array of output patches put on the input patches
+ ALLOCATE(ZPATCH(KL,INP))
+ ZPATCH(:,:) = 0.
+!
+! if the number of input patches is NVEGTYPE
+ IF (INP==NVEGTYPE) THEN
+ DO JP = 1,NVEGTYPE
+ ! each vegtype takes the output contribution of the patch it is in
+ IP = VEGTYPE_TO_PATCH(JP,KPATCH)
+ ZPATCH(:,JP) = PVEGTYPE_PATCH(:,JP,IP)
+ ENDDO
+ ENDIF
!
-!* grid at center of layers
+ CALL GET_PREP_INTERP(INP,KPATCH,ZPATCH,PPATCH,ZPATCH,KR_P)
!
- ALLOCATE(ZGRID(SIZE(ZW,1),TPSNOW%NLAYER,KPATCH))
- ZGRID(:,1,:) = PDEPTH(:,1,:)
- IF(TPSNOW%NLAYER>1)THEN
- DO JPATCH=1,KPATCH
- DO JLAYER=2,TPSNOW%NLAYER
- ZGRID(:,JLAYER,JPATCH) = ZGRID(:,JLAYER-1,JPATCH) + PDEPTH(:,JLAYER,JPATCH)
+! the same for depth that is defined on the output patches
+ IF (PRESENT(PDEPTH)) THEN
+ !
+ ALLOCATE(ZDEPTH(KL,INP))
+ ZDEPTH(:,:) = 0.
+ !
+ IF (INP==NVEGTYPE) THEN
+ DO JP = 1,NVEGTYPE
+ IP = VEGTYPE_TO_PATCH(JP,KPATCH)
+ ZDEPTH(:,JP) = PDEPTH(:,1,IP)
ENDDO
- ENDDO
+ ENDIF
+ !
+ CALL GET_PREP_INTERP(INP,KPATCH,ZDEPTH,PDEPTH(:,1,:),ZDEPTH,KR_P)
+ !
ENDIF
!
-!* normalized grid
-!
- DO JPATCH=1,KPATCH
- DO JLAYER=1,TPSNOW%NLAYER
- WHERE (ZD(:,JPATCH)/=0.)
- ZGRID(:,JLAYER,JPATCH) = ZGRID(:,JLAYER,JPATCH) / ZD(:,JPATCH)
- ELSEWHERE
- ZGRID(:,JLAYER,JPATCH) = 1.0
- END WHERE
- END DO
+ DO JP = 1, INP
+ ! ZDEPTH and ZPATCH are defined on the size on the patch for the snow: use of
+ ! the mask
+ IF (PRESENT(PDEPTH)) THEN
+ LINTERP(:) = ( ZDEPTH(:,JP) /= 0. .AND. ZDEPTH(:,JP) /= XUNDEF )
+ ENDIF
+ LINTERP(:) = (LINTERP(:) .AND. ZPATCH(:,JP)>0.)
+ !* horizontal interpolation
+ CALL HOR_INTERPOL(DTCO, U, GCP, KLUOUT,ZFIELDIN(:,:,JP),ZFIELDOUTP(:,:,JP))
+ !
+ LINTERP(:) = .TRUE.
END DO
-!
- DEALLOCATE(ZD)
-!
-ELSEIF (.NOT.GSNOW_IDEAL) THEN
- IF (HSNSURF(1:3)=='RHO' .OR. HSNSURF(1:3)=='HEA') THEN
- WRITE(KLUOUT,*) 'when interpolation profiles of snow pack quantities,'
- WRITE(KLUOUT,*) 'depth of snow layers must be given'
- CALL ABOR1_SFX('PREP_HOR_SNOW_FIELD: DEPTH OF SNOW LAYERS NEEDED')
- END IF
-END IF
+ !
+ DEALLOCATE(ZFIELDIN, ZPATCH )
+ IF (PRESENT(PDEPTH)) DEALLOCATE(ZDEPTH)
+ !
+ENDIF
!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-!* 6. Return to historical variable
+!* 4. Transformation from vegtype grid to patch grid, if any
+!
+CALL PREP_CTL_INT_PART4 (YDCTL, HSNSURF, 'SNOW', CMASK, ZFIELDIN, ZFIELDOUTP)
+
+IF (YDCTL%LPART5) THEN
!
-SELECT CASE (HSNSURF(1:3))
+ ALLOCATE(ZW%AL(KPATCH))
!
- CASE('WWW') ! total snow content
+ IF (KPATCH/=INP.and.INP/=1) THEN
!
- IF (GSNOW_IDEAL) THEN
- PF(:,:,:) = ZW(:,:,:)
- ELSE
- DO JLAYER=1,SIZE(PF,2)
- PF(:,JLAYER,:) = ZW(:,1,:)
- ENDDO
- ENDIF
+ ALLOCATE(ZFIELDOUTV(KL,INL,NVEGTYPE))
+ CALL PUT_ON_ALL_VEGTYPES(KL,INL,INP,NVEGTYPE,ZFIELDOUTP,ZFIELDOUTV)
!
- IF (PRESENT(PPATCH)) THEN
- DO JLAYER = 1,TPSNOW%NLAYER
- WHERE(PPATCH(:,:)==0.)
- PF(:,JLAYER,:) = XUNDEF
- END WHERE
- ENDDO
- ENDIF
- !
- CASE('DEP') ! snow thickness
+ !* 6. Transformation from vegtype grid to patch grid
!
- IF (GSNOW_IDEAL) THEN
- PF(:,:,:) = ZW(:,:,:)
- ELSE
- DO JLAYER=1,SIZE(PF,2)
- PF(:,JLAYER,:) = ZW(:,JLAYER,:)
- ENDDO
- ENDIF
+ DEALLOCATE(ZFIELDOUTP)
!
- IF (PRESENT(PPATCH)) THEN
- DO JLAYER = 1,TPSNOW%NLAYER
- WHERE(PPATCH(:,:)==0.)
- PF(:,JLAYER,:) = XUNDEF
- END WHERE
- ENDDO
- ENDIF
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
- CASE('RHO')
+ DO JP = 1,KPATCH
+ !
+ ALLOCATE(ZW%AL(JP)%ZOUT(KSIZE_P(JP),INL))
+ !
+ CALL VEGTYPE_GRID_TO_PATCH_GRID(JP, KPATCH, PVEGTYPE_PATCH(1:KSIZE_P(JP),:,JP), &
+ PPATCH(1:KSIZE_P(JP),JP), KR_P(1:KSIZE_P(JP),JP), &
+ ZFIELDOUTV, ZW%AL(JP)%ZOUT)
+ ENDDO
!
- IF (GSNOW_IDEAL) THEN
- TPSNOW%RHO(:,:,:) = ZW(:,:,:)
- ELSEIF(SIZE(ZW,2)==TPSNOW%NLAYER)THEN
- TPSNOW%RHO(:,:,:) = ZW(:,:,:)
- ELSE
- !* interpolation on snow levels
- CALL INIT_FROM_REF_GRID(XGRID_SNOW,ZW,ZGRID,TPSNOW%RHO)
- ENDIF
+ DEALLOCATE(ZFIELDOUTV)
!
- !* mask for areas where there is no snow
- DO JPATCH=1,KPATCH
- DO JLAYER=1,TPSNOW%NLAYER
- WHERE(PDEPTH(:,JLAYER,JPATCH)==0. .OR. PDEPTH(:,JLAYER,JPATCH)==XUNDEF) TPSNOW%RHO(:,JLAYER,JPATCH) = XUNDEF
- END DO
- END DO
- !
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- !
- CASE('ALB')
+ ELSEIF (INP==1) THEN
+ !
+ DO JP = 1,KPATCH
+ !
+ ALLOCATE(ZW%AL(JP)%ZOUT(KSIZE_P(JP),INL))
+ !
+ CALL PACK_SAME_RANK(KR_P(1:KSIZE_P(JP),JP),ZFIELDOUTP(:,:,1),ZW%AL(JP)%ZOUT)
+ !
+ ENDDO
!
- DO JPATCH=1,KPATCH
- TPSNOW%ALB(:,JPATCH) = ZW(:,1,JPATCH)
- END DO
+ ELSE
!
- !* mask for areas where there is no snow
- DO JPATCH=1,KPATCH
- WHERE(PDEPTH(:,1,JPATCH)==0. .OR. PDEPTH(:,1,JPATCH)==XUNDEF) TPSNOW%ALB(:,JPATCH) = XUNDEF
- END DO
+ DO JP = 1,KPATCH
+ !
+ ALLOCATE(ZW%AL(JP)%ZOUT(KSIZE_P(JP),INL))
+ !
+ CALL PACK_SAME_RANK(KR_P(1:KSIZE_P(JP),JP),ZFIELDOUTP(:,:,JP),ZW%AL(JP)%ZOUT)
+ !
+ ENDDO
+ !
+ DEALLOCATE(ZFIELDOUTP)
+ !
+ ENDIF
+ !
+
+ !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
- !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ !* 5. Defines normalized output grid, if depths of snow layers are present
!
- CASE('HEA')
+ IF ( PRESENT(PDEPTH) .AND. .NOT.OSNOW_IDEAL ) THEN
!
- IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
- !
- IF (GSNOW_IDEAL) THEN
- TPSNOW%HEAT(:,:,:) = ZW(:,:,:)
- ELSEIF(SIZE(ZW,2)==TPSNOW%NLAYER)THEN
- TPSNOW%HEAT(:,:,:) = ZW(:,:,:)
- ELSE
- !* interpolation of heat on snow levels
- CALL INIT_FROM_REF_GRID(XGRID_SNOW,ZW,ZGRID,TPSNOW%HEAT)
- ENDIF
+ ALLOCATE(ZD(SIZE(PDEPTH,1)))
+ !
+ ALLOCATE(ZGRID(SIZE(PDEPTH,1),ISNOW_NLAYER,KPATCH))
+ DO JP = 1,KPATCH
+ !* total snow depth
!
- !* mask for areas where there is no snow
- DO JPATCH=1,KPATCH
- DO JLAYER=1,TPSNOW%NLAYER
- WHERE(PDEPTH(:,JLAYER,JPATCH)==0. .OR. PDEPTH(:,JLAYER,JPATCH)==XUNDEF) TPSNOW%HEAT(:,JLAYER,JPATCH) = XUNDEF
- END DO
+ ZD(:)=0.
+ DO JL = 1,ISNOW_NLAYER
+ WHERE (PDEPTH(1:KSIZE_P(JP),JL,JP)/=XUNDEF) ZD(1:KSIZE_P(JP)) = ZD(1:KSIZE_P(JP)) + PDEPTH(1:KSIZE_P(JP),JL,JP)
END DO
!
- ELSE IF (TPSNOW%SCHEME=='1-L') THEN
- !* interpolation of heat on snow levels
- ALLOCATE(ZHEAT(SIZE(ZFIELDOUT,1),TPSNOW%NLAYER,KPATCH))
+ !* grid at center of layers
!
- IF (GSNOW_IDEAL) THEN
- ZHEAT(:,:,:) = ZW(:,:,:)
- ELSEIF(SIZE(ZW,2)==TPSNOW%NLAYER)THEN
- ZHEAT(:,:,:) = ZW(:,:,:)
- ELSE
- CALL INIT_FROM_REF_GRID(XGRID_SNOW,ZW,ZGRID,ZHEAT)
+ ZGRID(1:KSIZE_P(JP),1,JP) = PDEPTH(1:KSIZE_P(JP),1,JP)
+ IF(ISNOW_NLAYER>1) THEN
+ DO JL = 2,ISNOW_NLAYER
+ ZGRID(1:KSIZE_P(JP),JL,JP) = ZGRID(1:KSIZE_P(JP),JL-1,JP) + PDEPTH(1:KSIZE_P(JP),JL,JP)
+ ENDDO
ENDIF
!
- !* transformation from heat to temperature
- CALL SNOW_HEAT_TO_T_WLIQ(ZHEAT,TPSNOW%RHO,TPSNOW%T)
- WHERE (TPSNOW%T>XTT) TPSNOW%T = XTT
- DEALLOCATE(ZHEAT)
+ ! * normalized grid
!
- !* mask for areas where there is no snow
- DO JPATCH=1,KPATCH
- DO JLAYER=1,TPSNOW%NLAYER
- WHERE(PDEPTH(:,JLAYER,JPATCH)==0. .OR. PDEPTH(:,JLAYER,JPATCH)==XUNDEF) TPSNOW%T(:,JLAYER,JPATCH) = XUNDEF
- END DO
+ DO JL=1,ISNOW_NLAYER
+ WHERE (ZD(1:KSIZE_P(JP))/=0.)
+ ZGRID(1:KSIZE_P(JP),JL,JP) = ZGRID(1:KSIZE_P(JP),JL,JP) / ZD(1:KSIZE_P(JP))
+ ELSEWHERE
+ ZGRID(1:KSIZE_P(JP),JL,JP) = 1.0
+ END WHERE
END DO
!
+ ENDDO
+ !
+ DEALLOCATE(ZD)
+ !
+ ELSEIF (.NOT.OSNOW_IDEAL) THEN
+ IF (HSNSURF(1:3)=='RHO' .OR. HSNSURF(1:3)=='HEA') THEN
+ WRITE(KLUOUT,*) 'when interpolation profiles of snow pack quantities,'
+ WRITE(KLUOUT,*) 'depth of snow layers must be given'
+ CALL ABOR1_SFX('PREP_HOR_SNOW_FIELD: DEPTH OF SNOW LAYERS NEEDED')
END IF
+ END IF
!
+ !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
- CASE('SG1')
- !
- IF (GSNOW_IDEAL) THEN
- TPSNOW%GRAN1(:,:,:) = ZW(:,:,:)
- ELSEIF(SIZE(ZW,2)==TPSNOW%NLAYER)THEN
- TPSNOW%GRAN1(:,:,:) = ZW(:,:,:)
- ELSE
- !* interpolation of heat on snow levels
- CALL INIT_FROM_REF_GRID(XGRID_SNOW,ZW,ZGRID,TPSNOW%GRAN1)
- ENDIF
- !
- !* mask for areas where there is no snow
- DO JPATCH=1,KPATCH
- DO JLAYER=1,TPSNOW%NLAYER
- WHERE(PDEPTH(:,JLAYER,JPATCH)==0. .OR. PDEPTH(:,JLAYER,JPATCH)==XUNDEF) TPSNOW%GRAN1(:,JLAYER,JPATCH) = XUNDEF
- END DO
- END DO
- !
- CASE('SG2')
- !
- IF (GSNOW_IDEAL) THEN
- TPSNOW%GRAN2(:,:,:) = ZW(:,:,:)
- ELSEIF(SIZE(ZW,2)==TPSNOW%NLAYER)THEN
- TPSNOW%GRAN2(:,:,:) = ZW(:,:,:)
- ELSE
- !* interpolation of heat on snow levels
- CALL INIT_FROM_REF_GRID(XGRID_SNOW,ZW,ZGRID,TPSNOW%GRAN2)
- ENDIF
- !
- !* mask for areas where there is no snow
- DO JPATCH=1,KPATCH
- DO JLAYER=1,TPSNOW%NLAYER
- WHERE(PDEPTH(:,JLAYER,JPATCH)==0. .OR. PDEPTH(:,JLAYER,JPATCH)==XUNDEF) TPSNOW%GRAN2(:,JLAYER,JPATCH) = XUNDEF
- END DO
- END DO
- !
- CASE('HIS')
- !
- IF (GSNOW_IDEAL) THEN
- TPSNOW%HIST(:,:,:) = ZW(:,:,:)
- ELSEIF(SIZE(ZW,2)==TPSNOW%NLAYER)THEN
- TPSNOW%HIST(:,:,:) = ZW(:,:,:)
- ELSE
- !* interpolation of heat on snow levels
- CALL INIT_FROM_REF_GRID(XGRID_SNOW,ZW,ZGRID,TPSNOW%HIST)
- ENDIF
- !
- !* mask for areas where there is no snow
- DO JPATCH=1,KPATCH
- DO JLAYER=1,TPSNOW%NLAYER
- WHERE(PDEPTH(:,JLAYER,JPATCH)==0. .OR. PDEPTH(:,JLAYER,JPATCH)==XUNDEF) TPSNOW%HIST(:,JLAYER,JPATCH) = XUNDEF
- END DO
- END DO
- !
- CASE('AGE')
+ !* 6. Return to historical variable
+ !
+ DO JP = 1,KPATCH
!
- IF (TPSNOW%SCHEME=='3-L'.AND.(.NOT.GSNOW_IDEAL).AND.(.NOT.OUNIF))THEN
- TPSNOW%AGE(:,:,:) = 0.0
- ELSE
- IF (GSNOW_IDEAL) THEN
- TPSNOW%AGE(:,:,:) = ZW(:,:,:)
- ELSEIF(SIZE(ZW,2)==TPSNOW%NLAYER)THEN
- TPSNOW%AGE(:,:,:) = ZW(:,:,:)
- ELSE
- !* interpolation of heat on snow levels
- CALL INIT_FROM_REF_GRID(XGRID_SNOW,ZW,ZGRID,TPSNOW%AGE)
- ENDIF
- ENDIF
+ SK => TNPSNOW%AL(JP)
!
- !* mask for areas where there is no snow
- DO JPATCH=1,KPATCH
- DO JLAYER=1,TPSNOW%NLAYER
- WHERE(PDEPTH(:,JLAYER,JPATCH)==0. .OR. PDEPTH(:,JLAYER,JPATCH)==XUNDEF) TPSNOW%AGE(:,JLAYER,JPATCH) = XUNDEF
- END DO
- END DO
+ SELECT CASE (HSNSURF(1:3))
+ !
+ CASE('WWW') ! total snow content
+ !
+ IF (OSNOW_IDEAL) THEN
+ SK%WSNOW(:,:) = ZW%AL(JP)%ZOUT(:,:)
+ ELSE
+ DO JL=1,SIZE(SK%WSNOW,2)
+ SK%WSNOW(:,JL) = ZW%AL(JP)%ZOUT(:,1)
+ ENDDO
+ ENDIF
+ !
+ DO JL = 1,ISNOW_NLAYER
+ WHERE(PPATCH(1:KSIZE_P(JP),JP)==0.)
+ SK%WSNOW(:,JL) = XUNDEF
+ END WHERE
+ ENDDO
+ !
+ CASE('DEP') ! snow thickness
+ !
+ IF (OSNOW_IDEAL) THEN
+ SK%DEPTH(:,:) = ZW%AL(JP)%ZOUT(:,:)
+ ELSE
+ CALL SNOW3LGRID(SK%DEPTH(:,:),ZW%AL(JP)%ZOUT(:,1))
+ !DO JL=1,SIZE(SK%DEPTH,2)
+ ! SK%DEPTH(:,JL) = ZW%AL(JP)%ZOUT(:,1)
+ !ENDDO
+ ENDIF
+ !
+ DO JL = 1,ISNOW_NLAYER
+ WHERE(PPATCH(1:KSIZE_P(JP),JP)==0.)
+ SK%DEPTH(:,JL) = XUNDEF
+ END WHERE
+ ENDDO
+ !
+ !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ !
+ CASE('RHO')
+ !
+ IF (OSNOW_IDEAL) THEN
+ SK%RHO(:,:) = ZW%AL(JP)%ZOUT(:,:)
+ ELSEIF(INL==1) THEN
+ DO JL = 1,ISNOW_NLAYER
+ SK%RHO(:,JL) = ZW%AL(JP)%ZOUT(:,1)
+ ENDDO
+ ELSE
+ !* interpolation on snow levels
+ CALL INIT_FROM_REF_GRID(XGRID_SNOW,ZW%AL(JP)%ZOUT,ZGRID(1:KSIZE_P(JP),:,JP),SK%RHO)
+ ENDIF
+ !
+ !* mask for areas where there is no snow
+ DO JL=1,ISNOW_NLAYER
+ WHERE(PDEPTH(1:KSIZE_P(JP),JL,JP)==0. .OR. PDEPTH(1:KSIZE_P(JP),JL,JP)==XUNDEF) SK%RHO(:,JL) = XUNDEF
+ END DO
+ !
+ !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ !
+ CASE('ALB')
+ !
+ SK%ALB(:) = ZW%AL(JP)%ZOUT(:,1)
+ !
+ !* mask for areas where there is no snow
+ WHERE(PDEPTH(1:KSIZE_P(JP),1,JP)==0. .OR. PDEPTH(1:KSIZE_P(JP),1,JP)==XUNDEF) SK%ALB(:) = XUNDEF
+ !
+ !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ !
+ CASE('HEA')
+ !
+ IF (SK%SCHEME=='3-L' .OR. SK%SCHEME=='CRO') THEN
+ !
+ ALLOCATE(ZTEMP(KSIZE_P(JP),ISNOW_NLAYER))
+ ALLOCATE(ZWLIQ(KSIZE_P(JP),ISNOW_NLAYER))
+ ZWLIQ(:,:) = 0.0
+ !
+ IF (OSNOW_IDEAL) THEN
+ ZTEMP(:,:) = ZW%AL(JP)%ZOUT(:,:)
+ ELSEIF (INL==1) THEN
+ DO JL = 1,ISNOW_NLAYER
+ ZTEMP(:,JL) = ZW%AL(JP)%ZOUT(:,1)
+ ENDDO
+ ELSE
+ !* interpolation of heat on snow levels
+ CALL INIT_FROM_REF_GRID(XGRID_SNOW,ZW%AL(JP)%ZOUT,ZGRID(1:KSIZE_P(JP),:,JP),ZTEMP)
+ ENDIF
+ !
+ CALL SNOW_T_WLIQ_TO_HEAT(SK%HEAT,SK%RHO,ZTEMP,ZWLIQ)
+ DEALLOCATE(ZTEMP)
+ DEALLOCATE(ZWLIQ)
+ !
+ !* mask for areas where there is no snow
+ DO JL=1,ISNOW_NLAYER
+ WHERE(PDEPTH(1:KSIZE_P(JP),JL,JP)==0. .OR. PDEPTH(1:KSIZE_P(JP),JL,JP)==XUNDEF) SK%HEAT(:,JL) = XUNDEF
+ END DO
+ !
+ ELSE IF (SK%SCHEME=='1-L') THEN
+ !* interpolation of heat on snow levels
+ !
+ IF (OSNOW_IDEAL) THEN
+ SK%T(:,:) = ZW%AL(JP)%ZOUT(:,:)
+ ELSEIF(INL==1) THEN
+ DO JL = 1,ISNOW_NLAYER
+ SK%T(:,JL) = ZW%AL(JP)%ZOUT(:,1)
+ ENDDO
+ ELSE
+ CALL INIT_FROM_REF_GRID(XGRID_SNOW,ZW%AL(JP)%ZOUT,ZGRID(1:KSIZE_P(JP),:,JP),SK%T)
+ ENDIF
+ !
+ !* transformation from heat to temperature
+ WHERE (SK%T>XTT) SK%T = XTT
+ !
+ !* mask for areas where there is no snow
+ DO JL=1,ISNOW_NLAYER
+ WHERE(PDEPTH(1:KSIZE_P(JP),JL,JP)==0. .OR. PDEPTH(1:KSIZE_P(JP),JL,JP)==XUNDEF) SK%T(:,JL) = XUNDEF
+ END DO
+ !
+ END IF
+ !
+ !
+ CASE('SG1')
+ !
+ IF (OSNOW_IDEAL) THEN
+ SK%GRAN1(:,:) = ZW%AL(JP)%ZOUT(:,:)
+ ELSEIF(INL==1) THEN
+ DO JL = 1,ISNOW_NLAYER
+ SK%GRAN1(:,JL) = ZW%AL(JP)%ZOUT(:,1)
+ ENDDO
+ ELSE
+ !* interpolation of heat on snow levels
+ CALL INIT_FROM_REF_GRID(XGRID_SNOW,ZW%AL(JP)%ZOUT,ZGRID(1:KSIZE_P(JP),:,JP),SK%GRAN1)
+ ENDIF
+ !
+ !* mask for areas where there is no snow
+ DO JL=1,ISNOW_NLAYER
+ WHERE(PDEPTH(1:KSIZE_P(JP),JL,JP)==0. .OR. PDEPTH(1:KSIZE_P(JP),JL,JP)==XUNDEF) SK%GRAN1(:,JL) = XUNDEF
+ END DO
+ !
+ CASE('SG2')
+ !
+ IF (OSNOW_IDEAL) THEN
+ SK%GRAN2(:,:) = ZW%AL(JP)%ZOUT(:,:)
+ ELSEIF(SIZE(ZW%AL(JP)%ZOUT,2)==1) THEN
+ DO JL = 1,ISNOW_NLAYER
+ SK%GRAN2(:,JL) = ZW%AL(JP)%ZOUT(:,1)
+ ENDDO
+ ELSE
+ !* interpolation of heat on snow levels
+ CALL INIT_FROM_REF_GRID(XGRID_SNOW,ZW%AL(JP)%ZOUT,ZGRID(1:KSIZE_P(JP),:,JP),SK%GRAN2)
+ ENDIF
+ !
+ !* mask for areas where there is no snow
+ DO JL=1,ISNOW_NLAYER
+ WHERE(PDEPTH(1:KSIZE_P(JP),JL,JP)==0. .OR. PDEPTH(1:KSIZE_P(JP),JL,JP)==XUNDEF) SK%GRAN2(:,JL) = XUNDEF
+ END DO
+ !
+ CASE('HIS')
+ !
+ IF (OSNOW_IDEAL) THEN
+ SK%HIST(:,:) = ZW%AL(JP)%ZOUT(:,:)
+ ELSEIF(INL==1) THEN
+ DO JL = 1,ISNOW_NLAYER
+ SK%HIST(:,JL) = ZW%AL(JP)%ZOUT(:,1)
+ ENDDO
+ ELSE
+ !* interpolation of heat on snow levels
+ CALL INIT_FROM_REF_GRID(XGRID_SNOW,ZW%AL(JP)%ZOUT,ZGRID(1:KSIZE_P(JP),:,JP),SK%HIST)
+ ENDIF
+ !
+ !* mask for areas where there is no snow
+ DO JL=1,ISNOW_NLAYER
+ WHERE(PDEPTH(1:KSIZE_P(JP),JL,JP)==0. .OR. PDEPTH(1:KSIZE_P(JP),JL,JP)==XUNDEF) SK%HIST(:,JL) = XUNDEF
+ END DO
+ !
+ CASE('AGE')
+ !
+ IF (SK%SCHEME=='3-L'.AND.(.NOT.OSNOW_IDEAL).AND.(.NOT.OUNIF))THEN
+ SK%AGE(:,:) = 0.0
+ ELSE
+ IF (OSNOW_IDEAL) THEN
+ SK%AGE(:,:) = ZW%AL(JP)%ZOUT(:,:)
+ ELSEIF(INL==1) THEN
+ DO JL = 1,ISNOW_NLAYER
+ SK%AGE(:,JL) = ZW%AL(JP)%ZOUT(:,1)
+ ENDDO
+ ELSE
+ !* interpolation of heat on snow levels
+ CALL INIT_FROM_REF_GRID(XGRID_SNOW,ZW%AL(JP)%ZOUT,ZGRID(1:KSIZE_P(JP),:,JP),SK%AGE)
+ ENDIF
+ ENDIF
+ !
+ !* mask for areas where there is no snow
+ DO JL=1,ISNOW_NLAYER
+ WHERE(PDEPTH(1:KSIZE_P(JP),JL,JP)==0. .OR. PDEPTH(1:KSIZE_P(JP),JL,JP)==XUNDEF) SK%AGE(:,JL) = XUNDEF
+ END DO
+ !
+ END SELECT
!
-END SELECT
+ ENDDO
!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
!* 7. Deallocations
!
-DEALLOCATE(ZFIELDIN )
-DEALLOCATE(ZFIELDOUT)
-IF (PRESENT(PDEPTH) .AND. .NOT.GSNOW_IDEAL) DEALLOCATE(ZGRID )
-DEALLOCATE(ZW )
+ IF (PRESENT(PDEPTH) .AND. .NOT.OSNOW_IDEAL) DEALLOCATE(ZGRID )
+ DO JP =1,KPATCH
+ DEALLOCATE(ZW%AL(JP)%ZOUT)
+ ENDDO
+ DEALLOCATE(ZW%AL)
+!
+ENDIF
+!
IF (LHOOK) CALL DR_HOOK('PREP_HOR_SNOW_FIELD',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
!
- CONTAINS
+CONTAINS
!
!-------------------------------------------------------------------------------------
!
@@ -486,32 +603,35 @@ SUBROUTINE INIT_FROM_REF_GRID(PGRID1,PT1,PD2,PT2)
!
USE MODI_INTERP_GRID_NAT
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PT1 ! variable profile
+REAL, DIMENSION(:,:), INTENT(IN) :: PT1 ! variable profile
REAL, DIMENSION(:), INTENT(IN) :: PGRID1 ! normalized grid
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PD2 ! output layer thickness
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PT2 ! variable profile
+REAL, DIMENSION(:,:), INTENT(IN) :: PD2 ! output layer thickness
+REAL, DIMENSION(:,:), INTENT(OUT) :: PT2 ! variable profile
!
-INTEGER :: JL ! loop counter
-REAL, DIMENSION(SIZE(PT1,1),SIZE(PT1,2)) :: ZD1 ! input grid
+INTEGER :: JL, JL1 ! loop counter
+REAL, DIMENSION(SIZE(PT1,1),SIZE(PGRID1)) :: ZT1
+REAL, DIMENSION(SIZE(PT1,1),SIZE(PGRID1)) :: ZD1 ! input grid
REAL, DIMENSION(SIZE(PD2,1),SIZE(PD2,2)) :: ZD2 ! output grid
-INTEGER :: JPATCH ! loop on patches
+INTEGER :: JP ! loop on patches
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
IF (LHOOK) CALL DR_HOOK('INIT_FROM_REF_GRID',0,ZHOOK_HANDLE)
-DO JPATCH=1,KPATCH
- ZD2(:,:) = 0.
- DO JL=1,SIZE(ZD2,2)
- ZD2(:,JL) = PD2(:,JL,JPATCH)
- END DO
- !
- DO JL=1,SIZE(PT1,2)
- ZD1(:,JL) = PGRID1(JL)
- END DO
- !
- CALL INTERP_GRID_NAT(ZD1,PT1(:,:,JPATCH),ZD2,PT2(:,:,JPATCH))
+!
+ZD2(:,:) = 0.
+DO JL=1,SIZE(ZD2,2)
+ ZD2(:,JL) = PD2(:,JL)
END DO
+!
+DO JL=1,SIZE(PGRID1)
+ JL1 = MIN(JL,SIZE(PT1,2))
+ ZT1(:,JL) = PT1(:,JL1)
+ ZD1(:,JL) = PGRID1(JL)
+END DO
+!
+CALL INTERP_GRID_NAT(ZD1,ZT1(:,:),ZD2,PT2(:,:))
+!
IF (LHOOK) CALL DR_HOOK('INIT_FROM_REF_GRID',1,ZHOOK_HANDLE)
!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
diff --git a/src/SURFEX/prep_hor_snow_fields.F90 b/src/SURFEX/prep_hor_snow_fields.F90
index e844d00a78f5f0a30fc0a860856150e4f28104c1..7588fb02562dd015e2c71f8fec723aaed3596335 100644
--- a/src/SURFEX/prep_hor_snow_fields.F90
+++ b/src/SURFEX/prep_hor_snow_fields.F90
@@ -3,20 +3,17 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_HOR_SNOW_FIELDS (DTCO, &
- IG, U,GCP, &
- HPROGRAM,HSURF, &
+SUBROUTINE PREP_HOR_SNOW_FIELDS (DTCO, G, U, GCP, HPROGRAM,HSURF,&
HFILE,HFILETYPE, &
HFILEPGD,HFILEPGDTYPE, &
KLUOUT,OUNIF,KPATCH, &
- KTEB_PATCH, &
- KL,TPSNOW, TPTIME, &
+ KTEB_PATCH, KL,TNPSNOW, TPTIME, &
PUNIF_WSNOW, PUNIF_RSNOW, &
PUNIF_TSNOW, PUNIF_LWCSNOW, &
PUNIF_ASNOW, OSNOW_IDEAL, &
PUNIF_SG1SNOW, PUNIF_SG2SNOW,&
- PUNIF_HISTSNOW,PUNIF_AGESNOW,&
- PVEGTYPE, PVEGTYPE_PATCH, &
+ PUNIF_HISTSNOW,PUNIF_AGESNOW, YDCTL,&
+ PVEGTYPE_PATCH, KSIZE_P, KR_P,&
PPATCH, OKEY )
! #######################################################
!
@@ -42,18 +39,15 @@ SUBROUTINE PREP_HOR_SNOW_FIELDS (DTCO, &
!! Original 01/2004
!! B. Decharme 10/2013, Phasage Arpege-Climat
!! B. Decharme 04/2014, Init permsnow
+!! P. Marguinaud10/2014, Support for a 2-part PREP
!!------------------------------------------------------------------
!
!
-!
-!
-!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
!
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
USE MODD_TYPE_SNOW
USE MODD_TYPE_DATE_SURF, ONLY : DATE_TIME
@@ -63,6 +57,8 @@ USE MODD_SNOW_PAR, ONLY : XAGLAMIN, XAGLAMAX
!
USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
!
+USE MODE_PREP_CTL, ONLY : PREP_CTL, PREP_CTL_INT_PART2, PREP_CTL_INT_PART4
+!
USE MODI_ALLOCATE_GR_SNOW
USE MODI_PREP_HOR_SNOW_FIELD
USE MODE_SNOW3L
@@ -81,9 +77,11 @@ IMPLICIT NONE
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
!
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
+TYPE(GRID_t), INTENT(INOUT) :: G
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
+TYPE (PREP_CTL), INTENT (INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
@@ -96,41 +94,42 @@ LOGICAL, INTENT(IN) :: OUNIF ! flag for prescribed uniform field
INTEGER, INTENT(IN) :: KPATCH ! patch number for output scheme
INTEGER, INTENT(IN) :: KTEB_PATCH
INTEGER, INTENT(IN) :: KL ! number of points
-TYPE(SURF_SNOW) :: TPSNOW ! snow fields
+TYPE(NSURF_SNOW), INTENT(INOUT) :: TNPSNOW ! snow fields
TYPE(DATE_TIME), INTENT(IN) :: TPTIME ! date and time
REAL, DIMENSION(:), INTENT(IN) :: PUNIF_WSNOW ! prescribed snow content (kg/m2)
REAL, DIMENSION(:), INTENT(IN) :: PUNIF_RSNOW ! prescribed density (kg/m3)
REAL, DIMENSION(:), INTENT(IN) :: PUNIF_TSNOW ! prescribed temperature (K)
REAL, DIMENSION(:), INTENT(IN) :: PUNIF_LWCSNOW ! prescribed snow liquid water content (kg/m3)
REAL, INTENT(IN) :: PUNIF_ASNOW ! prescribed albedo (-)
-LOGICAL, INTENT(IN) :: OSNOW_IDEAL
+LOGICAL, INTENT(INOUT) :: OSNOW_IDEAL
REAL, DIMENSION(:), INTENT(IN) :: PUNIF_SG1SNOW !
REAL, DIMENSION(:), INTENT(IN) :: PUNIF_SG2SNOW !
REAL, DIMENSION(:), INTENT(IN) :: PUNIF_HISTSNOW !
REAL, DIMENSION(:), INTENT(IN) :: PUNIF_AGESNOW !
-REAL,DIMENSION(:,:), INTENT(IN ), OPTIONAL :: PVEGTYPE ! fraction of each vegtype
REAL,DIMENSION(:,:,:), INTENT(IN ), OPTIONAL :: PVEGTYPE_PATCH ! fraction of each vegtype per patch
+INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KSIZE_P
+INTEGER, DIMENSION(:,:), INTENT(IN), OPTIONAL :: KR_P
REAL,DIMENSION(:,:), INTENT(IN ), OPTIONAL :: PPATCH ! fraction of each patch
LOGICAL, INTENT(OUT), OPTIONAL :: OKEY
!
!
!* 0.2 declarations of local variables
!
+TYPE(SURF_SNOW), POINTER :: SK
CHARACTER(LEN=10) :: YSNSURF ! type of field
-REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ZW ! total snow content
-REAL,ALLOCATABLE,DIMENSION(:,:) :: ZWRHO ! total snow content from rho profile alone
-REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ZD ! total snow depth
-REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ZDEPTH ! snow depth of each layer
-REAL,ALLOCATABLE,DIMENSION(:,:) :: ZDTOT ! total snow depth
-REAL,DIMENSION(KL,KPATCH) :: ZPATCH ! fraction of each patch
-REAL,DIMENSION(:,:), ALLOCATABLE :: ZVEGTYPE ! fraction of each patch
+REAL,ALLOCATABLE,DIMENSION(:) :: ZWRHO ! total snow content from rho profile alone
+REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ZDEPTH ! snow depth of each layer
+REAL,ALLOCATABLE,DIMENSION(:) :: ZDTOT ! total snow depth
+INTEGER, DIMENSION(KPATCH) :: ISIZE_P
+INTEGER,DIMENSION(KL,KPATCH) :: IR_P ! fraction of each patch
+REAL,DIMENSION(KL,KPATCH) :: ZPATCH ! fraction of each patch
REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZVEGTYPE_PATCH ! fraction of each vegtype per patch
!
-INTEGER :: JPATCH ! loop counter on patches
-INTEGER :: JLAYER ! loop counter on layers
+INTEGER :: JP, ISNOW_NLAYER ! loop counter on patches
+INTEGER :: JL, JI, ISIZE ! loop counter on layers
INTEGER :: IVERSION ! surface version
-CHARACTER(LEN=LEN_HREC) :: YRECFM ! record name
+CHARACTER(LEN=LEN_HREC) :: YRECFM ! record name
INTEGER :: IRESP ! error return code
LOGICAL :: GGLACIER
!
@@ -139,18 +138,27 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PREP_HOR_SNOW_FIELDS',0,ZHOOK_HANDLE)
!
+ISNOW_NLAYER = TNPSNOW%AL(1)%NLAYER
+!
+IF (PRESENT(KSIZE_P)) THEN
+ ISIZE_P(:) = KSIZE_P(:)
+ELSE
+ ISIZE_P(:) = KL
+ENDIF
+!
+IF (PRESENT(KR_P)) THEN
+ IR_P(:,:) = KR_P(:,:)
+ELSE
+ DO JI = 1,KL
+ IR_P(JI,:) = JI
+ ENDDO
+ENDIF
+!
IF (PRESENT(PPATCH)) THEN
ZPATCH = PPATCH
ELSE
ZPATCH = 1.
ENDIF
-IF (PRESENT(PVEGTYPE)) THEN
- ALLOCATE(ZVEGTYPE(KL,SIZE(PVEGTYPE,2)))
- ZVEGTYPE = PVEGTYPE
-ELSE
- ALLOCATE(ZVEGTYPE(KL,NVEGTYPE))
- ZVEGTYPE = 1.
-ENDIF
IF (PRESENT(PVEGTYPE_PATCH)) THEN
ALLOCATE(ZVEGTYPE_PATCH(KL,SIZE(PVEGTYPE_PATCH,2),KPATCH))
ZVEGTYPE_PATCH = PVEGTYPE_PATCH
@@ -161,99 +169,91 @@ ENDIF
!
!* 1. Allocation of output field
!
- CALL ALLOCATE_GR_SNOW(TPSNOW,KL,KPATCH)
+DO JP = 1,KPATCH
+ CALL ALLOCATE_GR_SNOW(TNPSNOW%AL(JP),ISIZE_P(JP))
+ENDDO
!
!---------------------------------------------------------------------------
!
!* 2. Find if PERMSNOW must be done
!
IF(PRESENT(OKEY))THEN
-!
+ !
IF ( (HFILETYPE=='MESONH' .OR. HFILETYPE=='ASCII ' .OR. HFILETYPE=='LFI '.OR. HFILETYPE=='FA ') &
.AND. (HSURF=='SN_VEG ') ) THEN
-!
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'FULL ')
- YRECFM='VERSION'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,IVERSION,IRESP)
- CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
-!
- IF(IVERSION>7)THEN
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'NATURE')
- YRECFM='GLACIER'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,GGLACIER,IRESP)
- CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
- IF(GGLACIER)OKEY=.FALSE.
- ENDIF
-!
+ !
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'FULL ')
+ YRECFM='VERSION'
+ CALL READ_SURF(HFILETYPE,YRECFM,IVERSION,IRESP)
+ CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
+ !
+ IF(IVERSION>7)THEN
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
+ YRECFM='GLACIER'
+ CALL READ_SURF(HFILETYPE,YRECFM,GGLACIER,IRESP)
+ CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
+ IF(GGLACIER)OKEY=.FALSE.
+ ENDIF
+ !
ENDIF
-!
+ !
IF(OSNOW_IDEAL)OKEY=.FALSE.
-!
+ !
ENDIF
!
!---------------------------------------------------------------------------
!
!* 3. Treatment of total snow content (kg/m2)
!
-ALLOCATE(ZW(KL,TPSNOW%NLAYER,KPATCH))
-!
YSNSURF='WWW'//HSURF
- CALL PREP_HOR_SNOW_FIELD(DTCO, &
- IG, U,GCP, &
+CALL PREP_HOR_SNOW_FIELD(DTCO, G, U, GCP, &
HPROGRAM, HFILE, HFILETYPE, HFILEPGD, HFILEPGDTYPE, &
- KLUOUT, OUNIF, YSNSURF, KPATCH, KTEB_PATCH, KL, TPSNOW, TPTIME, &
+ KLUOUT, OUNIF, YSNSURF, KPATCH, KTEB_PATCH, KL, TNPSNOW, TPTIME, &
PUNIF_WSNOW, PUNIF_RSNOW, PUNIF_TSNOW, PUNIF_LWCSNOW,&
PUNIF_ASNOW, OSNOW_IDEAL, PUNIF_SG1SNOW, &
- PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, &
- PF=ZW, PVEGTYPE=ZVEGTYPE, &
- PVEGTYPE_PATCH=ZVEGTYPE_PATCH, PPATCH=ZPATCH )
+ PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, YDCTL, &
+ ZVEGTYPE_PATCH, ZPATCH, ISIZE_P, IR_P )
!
!----------------------------------------------------------------------------
!
!* 4. Treatment of total snow depth
!
-ALLOCATE(ZD(KL,TPSNOW%NLAYER,KPATCH))
+DO JP = 1,KPATCH
+ ALLOCATE(TNPSNOW%AL(JP)%DEPTH(ISIZE_P(JP),ISNOW_NLAYER))
+ENDDO
!
YSNSURF='DEP'//HSURF
- CALL PREP_HOR_SNOW_FIELD(DTCO, &
- IG, U,GCP, &
+CALL PREP_HOR_SNOW_FIELD(DTCO, G, U, GCP, &
HPROGRAM, HFILE, HFILETYPE, HFILEPGD, HFILEPGDTYPE, &
- KLUOUT, OUNIF, YSNSURF, KPATCH, KTEB_PATCH, KL, TPSNOW, TPTIME, &
+ KLUOUT, OUNIF, YSNSURF, KPATCH, KTEB_PATCH, KL, TNPSNOW, TPTIME, &
PUNIF_WSNOW, PUNIF_RSNOW, PUNIF_TSNOW, PUNIF_LWCSNOW,&
PUNIF_ASNOW, OSNOW_IDEAL, PUNIF_SG1SNOW, &
- PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, &
- PF=ZD, PVEGTYPE=ZVEGTYPE, &
- PVEGTYPE_PATCH=ZVEGTYPE_PATCH, PPATCH=ZPATCH )
+ PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, YDCTL, &
+ ZVEGTYPE_PATCH, ZPATCH, ISIZE_P, IR_P )
!
!* snow layer thickness definition
!
-ALLOCATE(ZDEPTH(KL,TPSNOW%NLAYER,KPATCH))
+ALLOCATE(ZDEPTH(KL,ISNOW_NLAYER,KPATCH))
!
-IF (OSNOW_IDEAL) THEN
- ZDEPTH(:,:,:) = ZD(:,:,:)
-ELSE
- IF (TPSNOW%NLAYER==1) THEN
- DO JPATCH=1,KPATCH
- ZDEPTH(:,1,JPATCH) = ZD(:,1,JPATCH)
- END DO
- ELSEIF (TPSNOW%SCHEME=='3-L') THEN
- ZDEPTH(:,:,:)=ZD(:,:,:)
- ELSEIF (TPSNOW%SCHEME=='CRO') THEN
- ALLOCATE(ZDTOT(KL,KPATCH))
- ZDTOT(:,:)=0.0
- DO JLAYER=1,TPSNOW%NLAYER
- ZDTOT(:,:)=ZDTOT(:,:)+ZD(:,JLAYER,:)
- END DO
- DO JPATCH=1,KPATCH
- CALL SNOW3LGRID(ZDEPTH(:,:,JPATCH),ZDTOT(:,JPATCH))
+DO JP = 1,KPATCH
+ !
+ IF (OSNOW_IDEAL .OR. ISNOW_NLAYER==1 .OR. TNPSNOW%AL(JP)%SCHEME=='3-L') THEN
+ ZDEPTH(1:ISIZE_P(JP),:,JP) = TNPSNOW%AL(JP)%DEPTH(:,:)
+ ELSEIF (TNPSNOW%AL(1)%SCHEME=='CRO') THEN
+ ALLOCATE(ZDTOT(ISIZE_P(JP)))
+ ZDTOT(:) = 0.0
+ DO JL=1,ISNOW_NLAYER
+ ZDTOT(:) = ZDTOT(:) + TNPSNOW%AL(JP)%DEPTH(:,JL)
END DO
+ CALL SNOW3LGRID(ZDEPTH(1:ISIZE_P(JP),:,JP),ZDTOT(:))
DEALLOCATE(ZDTOT)
ENDIF
-ENDIF
+ !
+ENDDO
+!
+DO JP = 1,KPATCH
+ DEALLOCATE(TNPSNOW%AL(JP)%DEPTH)
+ENDDO
!
!----------------------------------------------------------------------------
!
@@ -262,64 +262,67 @@ ENDIF
!
!* density profile
YSNSURF='RHO'//HSURF
- CALL PREP_HOR_SNOW_FIELD(DTCO, &
- IG, U,GCP, &
+CALL PREP_HOR_SNOW_FIELD(DTCO, G, U, GCP, &
HPROGRAM,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE, &
- KLUOUT,OUNIF,YSNSURF, KPATCH, KTEB_PATCH, KL, TPSNOW, TPTIME, &
+ KLUOUT,OUNIF,YSNSURF, KPATCH, KTEB_PATCH, KL, TNPSNOW, TPTIME, &
PUNIF_WSNOW, PUNIF_RSNOW, PUNIF_TSNOW, PUNIF_LWCSNOW, &
PUNIF_ASNOW, OSNOW_IDEAL, PUNIF_SG1SNOW, &
- PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, &
- PDEPTH=ZDEPTH, PVEGTYPE=ZVEGTYPE, &
- PVEGTYPE_PATCH=ZVEGTYPE_PATCH, PPATCH=ZPATCH )
+ PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, YDCTL, &
+ ZVEGTYPE_PATCH, ZPATCH, ISIZE_P, IR_P, PDEPTH=ZDEPTH )
!
!----------------------------------------------------------------------------
!
!* 5. Snow water content profile
! --------------------------
!
-IF (OSNOW_IDEAL) THEN
+IF (.NOT.OSNOW_IDEAL) THEN
!
- TPSNOW%WSNOW(:,:,:) = ZW(:,:,:)
+ ALLOCATE(ZWRHO(KL))
+ ALLOCATE(ZDTOT(KL))
!
-ELSE
- !
- ALLOCATE(ZWRHO(SIZE(TPSNOW%WSNOW,1),KPATCH))
- ALLOCATE(ZDTOT(SIZE(TPSNOW%WSNOW,1),KPATCH))
- ZWRHO(:,:) = 0.0
- ZDTOT(:,:) = 0.0
- !
- !* snow depth estimated from rho profile
- DO JPATCH=1,KPATCH
- DO JLAYER=1,TPSNOW%NLAYER
- WHERE (ZPATCH(:,JPATCH)>0. .AND. TPSNOW%RHO(:,JLAYER,JPATCH)/=XUNDEF)
- ZWRHO(:,JPATCH) = ZWRHO(:,JPATCH) + TPSNOW%RHO(:,JLAYER,JPATCH) * ZDEPTH(:,JLAYER,JPATCH)
+ DO JP = 1,KPATCH
+ !
+ SK => TNPSNOW%AL(JP)
+ !
+ ZWRHO(:) = 0.0
+ ZDTOT(:) = 0.0
+ !
+ ISIZE = ISIZE_P(JP)
+ !
+ !* snow depth estimated from rho profile
+ DO JL=1,ISNOW_NLAYER
+ WHERE (ZPATCH(1:ISIZE,JP)>0. .AND. SK%RHO(:,JL)/=XUNDEF)
+ ZWRHO(1:ISIZE) = ZWRHO(1:ISIZE) + SK%RHO(:,JL) * ZDEPTH(1:ISIZE,JL,JP)
ELSEWHERE
- ZWRHO(:,JPATCH) = XUNDEF
+ ZWRHO(1:ISIZE) = XUNDEF
END WHERE
- END DO
- END DO
- !
- !* modification of snow depth: coherence between rho profile, total snow and total depth
- DO JPATCH=1,KPATCH
- DO JLAYER=1,TPSNOW%NLAYER
- WHERE(ZPATCH(:,JPATCH)>0. .AND. ZWRHO(:,JPATCH)/=0. .AND. ZWRHO(:,JPATCH)/=XUNDEF .AND. ZW(:,1,JPATCH)>0.0)
- ZDTOT(:,JPATCH) = ZDTOT(:,JPATCH) + ZDEPTH(:,JLAYER,JPATCH) * ZW(:,1,JPATCH) / ZWRHO(:,JPATCH)
+ ENDDO
+ !
+ DO JL = 1,ISNOW_NLAYER
+ !* modification of snow depth: coherence between rho profile, total snow and total depth
+ WHERE(ZPATCH(1:ISIZE,JP)>0. .AND. ZWRHO(1:ISIZE)/=0. &
+ .AND. ZWRHO(1:ISIZE)/=XUNDEF .AND. SK%WSNOW(:,1)>0.0)
+ ZDTOT(1:ISIZE) = ZDTOT(1:ISIZE) + ZDEPTH(1:ISIZE,JL,JP) * SK%WSNOW(:,1) / ZWRHO(1:ISIZE)
ENDWHERE
END DO
- CALL SNOW3LGRID(ZDEPTH(:,:,JPATCH),ZDTOT(:,JPATCH))
- END DO
- !
- !* snow content profile for each grid level
- DO JPATCH=1,KPATCH
- DO JLAYER=1,TPSNOW%NLAYER
- WHERE(ZPATCH(:,JPATCH)>0..AND.TPSNOW%RHO(:,JLAYER,JPATCH)/=XUNDEF.AND.ZDTOT(:,JPATCH)>0.)
- TPSNOW%WSNOW(:,JLAYER,JPATCH) = TPSNOW%RHO(:,JLAYER,JPATCH) * ZDEPTH(:,JLAYER,JPATCH)
- ELSEWHERE(ZPATCH(:,JPATCH)>0..AND.(TPSNOW%RHO(:,JLAYER,JPATCH)==XUNDEF.OR.ZDTOT(:,JPATCH)==0.0))
- TPSNOW%WSNOW(:,JLAYER,JPATCH) = 0.0
+ !
+ IF (ISNOW_NLAYER > 1) THEN
+ CALL SNOW3LGRID(ZDEPTH(1:ISIZE,:,JP),ZDTOT(1:ISIZE))
+ ELSE
+ ZDEPTH(1:ISIZE,1,JP) = ZDTOT(1:ISIZE)
+ ENDIF
+ !
+ !* snow content profile for each grid level
+ DO JL=1,ISNOW_NLAYER
+ WHERE(ZPATCH(1:ISIZE,JP)>0..AND.SK%RHO(:,JL)/=XUNDEF.AND.ZDTOT(1:ISIZE)>0.)
+ SK%WSNOW(:,JL) = SK%RHO(:,JL) * ZDEPTH(1:ISIZE,JL,JP)
+ ELSEWHERE(ZPATCH(1:ISIZE,JP)>0..AND.(SK%RHO(:,JL)==XUNDEF.OR.ZDTOT(1:ISIZE)==0.0))
+ SK%WSNOW(:,JL) = 0.0
ELSEWHERE
- TPSNOW%WSNOW(:,JLAYER,JPATCH) = XUNDEF
+ SK%WSNOW(:,JL) = XUNDEF
END WHERE
END DO
+ !
END DO
!
DEALLOCATE(ZWRHO)
@@ -334,50 +337,46 @@ ENDIF
!
!* albedo
YSNSURF='ALB'//HSURF
- CALL PREP_HOR_SNOW_FIELD(DTCO, &
- IG, U,GCP, &
+ CALL PREP_HOR_SNOW_FIELD(DTCO, G, U, GCP, &
HPROGRAM,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE, &
- KLUOUT,OUNIF,YSNSURF, KPATCH, KTEB_PATCH, KL, TPSNOW, TPTIME, &
+ KLUOUT,OUNIF,YSNSURF, KPATCH, KTEB_PATCH, KL, TNPSNOW, TPTIME, &
PUNIF_WSNOW, PUNIF_RSNOW, PUNIF_TSNOW, PUNIF_LWCSNOW, &
PUNIF_ASNOW, OSNOW_IDEAL, PUNIF_SG1SNOW, &
- PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, &
- PDEPTH=ZDEPTH, PVEGTYPE=ZVEGTYPE, &
- PVEGTYPE_PATCH=ZVEGTYPE_PATCH, PPATCH=ZPATCH )
+ PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, YDCTL, &
+ ZVEGTYPE_PATCH, ZPATCH, ISIZE_P, IR_P, PDEPTH=ZDEPTH )
!
-IF (TPSNOW%SCHEME/='D95') THEN
+IF (TNPSNOW%AL(1)%SCHEME/='D95') THEN
!
!* heat in snowpack profile
YSNSURF='HEA'//HSURF
- CALL PREP_HOR_SNOW_FIELD(DTCO, &
- IG, U,GCP, &
- HPROGRAM,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE, &
- KLUOUT,OUNIF,YSNSURF, KPATCH, KTEB_PATCH, KL, TPSNOW, TPTIME, &
+ CALL PREP_HOR_SNOW_FIELD(DTCO, G, U, GCP, &
+ HPROGRAM,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE, &
+ KLUOUT,OUNIF,YSNSURF, KPATCH, KTEB_PATCH, KL, TNPSNOW, TPTIME, &
PUNIF_WSNOW, PUNIF_RSNOW, PUNIF_TSNOW, PUNIF_LWCSNOW, &
PUNIF_ASNOW, OSNOW_IDEAL, PUNIF_SG1SNOW, &
- PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, &
- PDEPTH=ZDEPTH, PVEGTYPE=ZVEGTYPE, &
- PVEGTYPE_PATCH=ZVEGTYPE_PATCH, PPATCH=ZPATCH )
+ PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, YDCTL, &
+ ZVEGTYPE_PATCH, ZPATCH, ISIZE_P, IR_P, PDEPTH=ZDEPTH )
!
ENDIF
!
-IF (TPSNOW%SCHEME=='CRO'.OR. TPSNOW%SCHEME=='3-L') THEN
+IF (TNPSNOW%AL(1)%SCHEME=='CRO'.OR. TNPSNOW%AL(1)%SCHEME=='3-L') THEN
!
!* age in snowpack profile
YSNSURF='AGE'//HSURF
- CALL PREP_HOR_SNOW_FIELD(DTCO, &
- IG, U,GCP, &
+ CALL PREP_HOR_SNOW_FIELD(DTCO, G, U, GCP, &
HPROGRAM,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE, &
- KLUOUT,OUNIF,YSNSURF, KPATCH, KTEB_PATCH, KL, TPSNOW, TPTIME, &
+ KLUOUT,OUNIF,YSNSURF, KPATCH, KTEB_PATCH, KL, TNPSNOW, TPTIME, &
PUNIF_WSNOW, PUNIF_RSNOW, PUNIF_TSNOW, PUNIF_LWCSNOW, &
PUNIF_ASNOW, OSNOW_IDEAL, PUNIF_SG1SNOW, &
- PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, &
- PDEPTH=ZDEPTH, PVEGTYPE=ZVEGTYPE, &
- PVEGTYPE_PATCH=ZVEGTYPE_PATCH, PPATCH=ZPATCH )
+ PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, YDCTL, &
+ ZVEGTYPE_PATCH, ZPATCH, ISIZE_P, IR_P, PDEPTH=ZDEPTH )
!
- WHERE(TPSNOW%WSNOW(:,1,:)>0.0.AND.TPSNOW%WSNOW(:,1,:)/=XUNDEF.AND. &
- TPSNOW%AGE(:,1,:)==0.0.AND.TPSNOW%ALB(:,:)<XAGLAMIN)
- TPSNOW%ALB(:,:)=(XAGLAMIN+XAGLAMAX)/2.0
- ENDWHERE
+ DO JP = 1,KPATCH
+ WHERE(TNPSNOW%AL(JP)%WSNOW(:,1)>0.0 .AND. TNPSNOW%AL(JP)%WSNOW(:,1)/=XUNDEF .AND. &
+ TNPSNOW%AL(JP)%AGE(:,1)==0.0 .AND. TNPSNOW%AL(JP)%ALB(:)<XAGLAMIN)
+ TNPSNOW%AL(JP)%ALB(:)=(XAGLAMIN+XAGLAMAX)/2.0
+ ENDWHERE
+ ENDDO
!
ENDIF
!
@@ -386,49 +385,40 @@ ENDIF
!* 7. Crocus specific parameters
! --------------------------
!
-IF (TPSNOW%SCHEME=='CRO') THEN
+IF (TNPSNOW%AL(1)%SCHEME=='CRO') THEN
!
YSNSURF='SG1'//HSURF
- CALL PREP_HOR_SNOW_FIELD(DTCO, &
- IG, U,GCP, &
+ CALL PREP_HOR_SNOW_FIELD(DTCO, G, U, GCP, &
HPROGRAM,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE, &
- KLUOUT,OUNIF,YSNSURF, KPATCH, KTEB_PATCH, KL, TPSNOW, TPTIME, &
+ KLUOUT,OUNIF,YSNSURF, KPATCH, KTEB_PATCH, KL, TNPSNOW, TPTIME, &
PUNIF_WSNOW, PUNIF_RSNOW, PUNIF_TSNOW, PUNIF_LWCSNOW, &
PUNIF_ASNOW, OSNOW_IDEAL, PUNIF_SG1SNOW, &
- PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, &
- PDEPTH=ZDEPTH, PVEGTYPE=ZVEGTYPE, &
- PVEGTYPE_PATCH=ZVEGTYPE_PATCH, PPATCH=ZPATCH )
+ PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, YDCTL, &
+ ZVEGTYPE_PATCH, ZPATCH, ISIZE_P, IR_P, PDEPTH=ZDEPTH )
!
YSNSURF='SG2'//HSURF
- CALL PREP_HOR_SNOW_FIELD(DTCO, &
- IG, U,GCP, &
+ CALL PREP_HOR_SNOW_FIELD(DTCO, G, U, GCP, &
HPROGRAM,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE, &
- KLUOUT,OUNIF,YSNSURF, KPATCH, KTEB_PATCH, KL, TPSNOW, TPTIME, &
+ KLUOUT,OUNIF,YSNSURF, KPATCH, KTEB_PATCH, KL, TNPSNOW, TPTIME, &
PUNIF_WSNOW, PUNIF_RSNOW, PUNIF_TSNOW, PUNIF_LWCSNOW, &
PUNIF_ASNOW, OSNOW_IDEAL, PUNIF_SG1SNOW, &
- PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, &
- PDEPTH=ZDEPTH, PVEGTYPE=ZVEGTYPE, &
- PVEGTYPE_PATCH=ZVEGTYPE_PATCH, PPATCH=ZPATCH )
+ PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, YDCTL, &
+ ZVEGTYPE_PATCH, ZPATCH, ISIZE_P, IR_P, PDEPTH=ZDEPTH )
!
YSNSURF='HIS'//HSURF
- CALL PREP_HOR_SNOW_FIELD(DTCO, &
- IG, U,GCP, &
+ CALL PREP_HOR_SNOW_FIELD(DTCO, G, U, GCP, &
HPROGRAM,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE, &
- KLUOUT,OUNIF,YSNSURF, KPATCH, KTEB_PATCH, KL, TPSNOW, TPTIME, &
+ KLUOUT,OUNIF,YSNSURF, KPATCH, KTEB_PATCH, KL, TNPSNOW, TPTIME, &
PUNIF_WSNOW, PUNIF_RSNOW, PUNIF_TSNOW, PUNIF_LWCSNOW, &
PUNIF_ASNOW, OSNOW_IDEAL, PUNIF_SG1SNOW, &
- PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, &
- PDEPTH=ZDEPTH, PVEGTYPE=ZVEGTYPE, &
- PVEGTYPE_PATCH=ZVEGTYPE_PATCH, PPATCH=ZPATCH )
+ PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, YDCTL, &
+ ZVEGTYPE_PATCH, ZPATCH, ISIZE_P, IR_P, PDEPTH=ZDEPTH )
!
ENDIF
!
!* 8. Deallocations
!
-DEALLOCATE(ZD )
-DEALLOCATE(ZW )
DEALLOCATE(ZDEPTH )
-DEALLOCATE(ZVEGTYPE)
DEALLOCATE(ZVEGTYPE_PATCH)
!
IF (LHOOK) CALL DR_HOOK('PREP_HOR_SNOW_FIELDS',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/prep_hor_teb_field.F90 b/src/SURFEX/prep_hor_teb_field.F90
index 70a50ed2080860ac592e651447fd95ec566b3a75..c241f557dfb62d1bbf737681bc6f3c4fd5d2078e 100644
--- a/src/SURFEX/prep_hor_teb_field.F90
+++ b/src/SURFEX/prep_hor_teb_field.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_HOR_TEB_FIELD (B, BOP, DTCO, IG, U, TG, T, TOP,GCP, &
- HPROGRAM,HSURF,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH)
+SUBROUTINE PREP_HOR_TEB_FIELD (B, BOP, DTCO, U, GCP, G, T, TOP, &
+ HPROGRAM,HSURF,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH,YDCTL)
! #################################################################################
!
!
@@ -28,24 +28,23 @@ SUBROUTINE PREP_HOR_TEB_FIELD (B, BOP, DTCO, IG, U, TG, T, TOP,GCP, &
!! -------------
!! Original 01/2004
!! P. Le Moigne 10/2005, Phasage Arome
+!! P. Marguinaud10/2014, Support for a 2-part PREP
!!------------------------------------------------------------------
!
-!
-!
-!
-!
USE MODD_BEM_n, ONLY : BEM_t
USE MODD_BEM_OPTION_n, ONLY : BEM_OPTIONS_t
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_TEB_n, ONLY : TEB_t
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
!
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE, XZS_LS, XLAT_OUT, XLON_OUT, &
- XX_OUT, XY_OUT, CMASK
+USE MODD_TYPE_SNOW
+USE MODD_TYPE_DATE_SURF, ONLY : DATE_TIME
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC
+USE MODD_GRID_GRIB, ONLY : CINMODEL
+USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE, XZS_LS, CMASK
USE MODD_PREP_TEB, ONLY : XGRID_ROOF, XGRID_ROAD, XGRID_WALL, XGRID_FLOOR, LSNOW_IDEAL_TEB, &
XWSNOW_ROOF, XRSNOW_ROOF, XTSNOW_ROOF, XLWCSNOW_ROOF, XASNOW_ROOF, &
XWSNOW_ROAD, XRSNOW_ROAD, XTSNOW_ROAD, XLWCSNOW_ROAD, XASNOW_ROAD, &
@@ -54,8 +53,11 @@ USE MODD_PREP_TEB, ONLY : XGRID_ROOF, XGRID_ROAD, XGRID_WALL, XGRID_FLOOR, LSNOW
USE MODD_CSTS, ONLY: XG, XP00
USE MODD_SURF_PAR, ONLY: XUNDEF
!
+USE MODE_PREP_CTL, ONLY : PREP_CTL, PREP_CTL_INT_PART2, PREP_CTL_INT_PART4
+!
USE MODE_THERMOS
!
+USE MODI_PREP_GRIB_GRID
USE MODI_READ_PREP_TEB_CONF
USE MODI_READ_PREP_TEB_SNOW
USE MODI_PREP_TEB_GRIB
@@ -65,6 +67,7 @@ USE MODI_HOR_INTERPOL
USE MODI_PREP_HOR_SNOW_FIELDS
USE MODI_GET_LUOUT
USE MODI_PREP_TEB_EXTERN
+USE MODI_ALLOCATE_GR_SNOW
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -72,18 +75,22 @@ USE PARKIND1 ,ONLY : JPRB
USE MODI_ABOR1_SFX
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1 declarations of arguments
!
!
TYPE(BEM_t), INTENT(INOUT) :: B
TYPE(BEM_OPTIONS_t), INTENT(INOUT) :: BOP
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
+TYPE(GRID_t), INTENT(INOUT) :: G
TYPE(TEB_t), INTENT(INOUT) :: T
TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+TYPE (PREP_CTL), INTENT(INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
@@ -95,6 +102,8 @@ TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
INTEGER, INTENT(IN) :: KPATCH
!
!* 0.2 declarations of local variables
+!
+TYPE(NSURF_SNOW) :: TNPSNOW
!
CHARACTER(LEN=6) :: YFILETYPE ! type of input file
CHARACTER(LEN=28) :: YFILE ! name of file
@@ -102,12 +111,14 @@ INTEGER, INTENT(IN) :: KPATCH
CHARACTER(LEN=28) :: YFILEPGD ! name of file
REAL, DIMENSION(:), ALLOCATABLE :: ZSG1SNOW, ZSG2SNOW, ZHISTSNOW, ZAGESNOW
REAL, POINTER, DIMENSION(:,:) :: ZFIELDIN ! field to interpolate horizontally
-REAL, ALLOCATABLE, DIMENSION(:,:) :: ZFIELDOUT ! field interpolated horizontally
+REAL, POINTER, DIMENSION(:,:) :: ZFIELDOUT ! field interpolated horizontally
REAL, ALLOCATABLE, DIMENSION(:) :: ZPS !surface pressure
REAL, PARAMETER :: ZRHOA=1.19 ! volumic mass of air at 20C and 1000hPa
INTEGER :: ILUOUT ! output listing logical unit
+INTEGER :: INFOMPI, INL
!
-LOGICAL :: GUNIF ! flag for prescribed uniform field
+TYPE (DATE_TIME) :: TZTIME_GRIB ! current date and time
+LOGICAL :: GUNIF ! flag for prescribed uniform field
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
!
@@ -120,33 +131,46 @@ IF (LHOOK) CALL DR_HOOK('PREP_HOR_TEB_FIELD',0,ZHOOK_HANDLE)
CALL READ_PREP_TEB_CONF(HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,&
HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,ILUOUT,GUNIF)
!
- CMASK = 'TOWN'
+CMASK = 'TOWN'
!
!-------------------------------------------------------------------------------------
!
!* 2. Snow variables case?
!
IF (HSURF=='SN_ROOF') THEN
- CALL READ_PREP_TEB_SNOW(HPROGRAM,T%CUR%TSNOW_ROOF%SCHEME,T%CUR%TSNOW_ROOF%NLAYER,&
- T%CUR%TSNOW_ROAD%SCHEME,T%CUR%TSNOW_ROAD%NLAYER,&
+ CALL READ_PREP_TEB_SNOW(HPROGRAM,T%TSNOW_ROOF%SCHEME,T%TSNOW_ROOF%NLAYER,&
+ T%TSNOW_ROAD%SCHEME,T%TSNOW_ROAD%NLAYER,&
YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE)
IF (LEN_TRIM(YFILE)>0 .AND. LEN_TRIM(YFILETYPE)>0) GUNIF = .FALSE.
ALLOCATE(ZSG1SNOW(SIZE(XWSNOW_ROOF)))
ALLOCATE(ZSG2SNOW(SIZE(XWSNOW_ROOF)))
ALLOCATE(ZHISTSNOW(SIZE(XWSNOW_ROOF)))
- ALLOCATE(ZAGESNOW(SIZE(XWSNOW_ROOF)))
- CALL PREP_HOR_SNOW_FIELDS(DTCO, &
- IG, U,GCP, &
+ ALLOCATE(ZAGESNOW(SIZE(XWSNOW_ROOF)))
+ ALLOCATE(TNPSNOW%AL(1))
+ TNPSNOW%AL(1)%SCHEME = T%TSNOW_ROOF%SCHEME
+ TNPSNOW%AL(1)%NLAYER = T%TSNOW_ROOF%NLAYER
+ CALL PREP_HOR_SNOW_FIELDS(DTCO, G, U, GCP, &
HPROGRAM,HSURF, &
YFILE,YFILETYPE, &
YFILEPGD, YFILEPGDTYPE, &
ILUOUT,GUNIF,1,KPATCH, &
- SIZE(TG%XLAT),T%CUR%TSNOW_ROOF, TOP%TTIME,&
+ SIZE(G%XLAT),TNPSNOW, TOP%TTIME,&
XWSNOW_ROOF, XRSNOW_ROOF, &
XTSNOW_ROOF, XLWCSNOW_ROOF, &
XASNOW_ROOF, &
LSNOW_IDEAL_TEB, ZSG1SNOW, &
- ZSG2SNOW, ZHISTSNOW, ZAGESNOW)
+ ZSG2SNOW, ZHISTSNOW, ZAGESNOW, YDCTL)
+
+ CALL ALLOCATE_GR_SNOW(T%TSNOW_ROOF,SIZE(G%XLAT))
+ T%TSNOW_ROOF%WSNOW = TNPSNOW%AL(1)%WSNOW
+ T%TSNOW_ROOF%RHO = TNPSNOW%AL(1)%RHO
+ T%TSNOW_ROOF%ALB = TNPSNOW%AL(1)%ALB
+ T%TSNOW_ROOF%T = TNPSNOW%AL(1)%T
+ T%TSNOW_ROOF%HEAT = TNPSNOW%AL(1)%HEAT
+ !
+ CALL TYPE_SNOW_INIT(TNPSNOW%AL(1))
+ DEALLOCATE(TNPSNOW%AL)
+
DEALLOCATE(ZSG1SNOW)
DEALLOCATE(ZSG2SNOW)
DEALLOCATE(ZHISTSNOW)
@@ -154,26 +178,39 @@ IF (HSURF=='SN_ROOF') THEN
IF (LHOOK) CALL DR_HOOK('PREP_HOR_TEB_FIELD',1,ZHOOK_HANDLE)
RETURN
ELSE IF (HSURF=='SN_ROAD') THEN
- CALL READ_PREP_TEB_SNOW(HPROGRAM,T%CUR%TSNOW_ROOF%SCHEME,T%CUR%TSNOW_ROOF%NLAYER,&
- T%CUR%TSNOW_ROAD%SCHEME,T%CUR%TSNOW_ROAD%NLAYER,&
+ CALL READ_PREP_TEB_SNOW(HPROGRAM,T%TSNOW_ROOF%SCHEME,T%TSNOW_ROOF%NLAYER,&
+ T%TSNOW_ROAD%SCHEME,T%TSNOW_ROAD%NLAYER,&
YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE)
IF (LEN_TRIM(YFILE)>0 .AND. LEN_TRIM(YFILETYPE)>0) GUNIF = .FALSE.
ALLOCATE(ZSG1SNOW(SIZE(XWSNOW_ROAD)))
ALLOCATE(ZSG2SNOW(SIZE(XWSNOW_ROAD)))
ALLOCATE(ZHISTSNOW(SIZE(XWSNOW_ROAD)))
- ALLOCATE(ZAGESNOW(SIZE(XWSNOW_ROAD)))
- CALL PREP_HOR_SNOW_FIELDS(DTCO, &
- IG, U,GCP, &
+ ALLOCATE(ZAGESNOW(SIZE(XWSNOW_ROAD)))
+ ALLOCATE(TNPSNOW%AL(1))
+ TNPSNOW%AL(1)%SCHEME = T%TSNOW_ROAD%SCHEME
+ TNPSNOW%AL(1)%NLAYER = T%TSNOW_ROAD%NLAYER
+ CALL PREP_HOR_SNOW_FIELDS(DTCO, G, U, GCP, &
HPROGRAM,HSURF, &
YFILE,YFILETYPE, &
YFILEPGD, YFILEPGDTYPE, &
ILUOUT,GUNIF,1,KPATCH, &
- SIZE(TG%XLAT),T%CUR%TSNOW_ROAD, TOP%TTIME,&
+ SIZE(G%XLAT),TNPSNOW, TOP%TTIME,&
XWSNOW_ROAD, XRSNOW_ROAD, &
XTSNOW_ROAD, XLWCSNOW_ROAD, &
XASNOW_ROAD, &
LSNOW_IDEAL_TEB, ZSG1SNOW, &
- ZSG2SNOW, ZHISTSNOW, ZAGESNOW)
+ ZSG2SNOW, ZHISTSNOW, ZAGESNOW, YDCTL)
+
+ CALL ALLOCATE_GR_SNOW(T%TSNOW_ROAD,SIZE(G%XLAT))
+ T%TSNOW_ROAD%WSNOW = TNPSNOW%AL(1)%WSNOW
+ T%TSNOW_ROAD%RHO = TNPSNOW%AL(1)%RHO
+ T%TSNOW_ROAD%ALB = TNPSNOW%AL(1)%ALB
+ T%TSNOW_ROAD%T = TNPSNOW%AL(1)%T
+ T%TSNOW_ROAD%HEAT = TNPSNOW%AL(1)%HEAT
+ !
+ CALL TYPE_SNOW_INIT(TNPSNOW%AL(1))
+ DEALLOCATE(TNPSNOW%AL)
+
DEALLOCATE(ZSG1SNOW)
DEALLOCATE(ZSG2SNOW)
DEALLOCATE(ZHISTSNOW)
@@ -185,105 +222,136 @@ END IF
!
!* 4. Reading of input configuration (Grid and interpolation type)
!
-IF (GUNIF) THEN
- CALL PREP_TEB_UNIF(ILUOUT,HSURF,ZFIELDIN)
-ELSE IF (YFILETYPE=='GRIB ') THEN
- CALL PREP_TEB_GRIB(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
- ELSE IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='ASCII ' .OR. YFILETYPE=='LFI '.OR. YFILETYPE=='FA ') THEN
- CALL PREP_TEB_EXTERN(DTCO,GCP, &
- HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,ILUOUT,KPATCH,ZFIELDIN)
- ELSE IF (YFILETYPE=='BUFFER') THEN
- CALL PREP_TEB_BUFFER(HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
- ELSE
- CALL ABOR1_SFX('PREP_HOR_TEB_FIELD: data file type not supported : '//YFILETYPE)
-END IF
+NULLIFY (ZFIELDIN, ZFIELDOUT)
!
-!* 5. Horizontal interpolation
+IF (YDCTL%LPART1) THEN
+!
+ IF (GUNIF) THEN
+ CALL PREP_TEB_UNIF(ILUOUT,HSURF,ZFIELDIN)
+ ELSE IF (YFILETYPE=='GRIB ') THEN
+ CALL PREP_GRIB_GRID(YFILE,ILUOUT,CINMODEL,CINGRID_TYPE,CINTERP_TYPE,TZTIME_GRIB)
+ IF (NRANK==NPIO)CALL PREP_TEB_GRIB(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
+ ELSE IF (YFILETYPE=='MESONH' .OR.YFILETYPE=='ASCII ' .OR.YFILETYPE=='LFI '&
+ .OR.YFILETYPE=='FA '.OR.YFILETYPE=='AROME '.OR.YFILETYPE=='NC ') THEN
+ CALL PREP_TEB_EXTERN(DTCO,GCP,TOP,BOP,HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,ILUOUT,KPATCH,ZFIELDIN)
+ ELSE IF (YFILETYPE=='BUFFER') THEN
+ CALL PREP_TEB_BUFFER(HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
+ ELSE
+ CALL ABOR1_SFX('PREP_HOR_TEB_FIELD: data file type not supported : '//YFILETYPE)
+ END IF
!
-ALLOCATE(ZFIELDOUT(SIZE(TG%XLAT),SIZE(ZFIELDIN,2)))
+ENDIF
!
- CALL HOR_INTERPOL(DTCO, U,GCP, &
- ILUOUT,ZFIELDIN,ZFIELDOUT)
+!* 5. Horizontal interpolation
!
-!* 6. Return to historical variable
+CALL PREP_CTL_INT_PART2 (YDCTL, HSURF, CMASK, 'TOWN', ZFIELDIN)
!
-SELECT CASE (HSURF)
- CASE('ZS ')
- ALLOCATE(XZS_LS(SIZE(ZFIELDOUT,1)))
- XZS_LS(:) = ZFIELDOUT(:,1)
- CASE('WS_ROOF')
- ALLOCATE(T%CUR%XWS_ROOF(SIZE(ZFIELDOUT,1)))
- T%CUR%XWS_ROOF(:) = ZFIELDOUT(:,1)
- CASE('WS_ROAD')
- ALLOCATE(T%CUR%XWS_ROAD(SIZE(ZFIELDOUT,1)))
- T%CUR%XWS_ROAD(:) = ZFIELDOUT(:,1)
- CASE('TI_ROAD')
- ALLOCATE(T%CUR%XTI_ROAD(SIZE(ZFIELDOUT,1)))
- T%CUR%XTI_ROAD(:) = ZFIELDOUT(:,1)
- CASE('TI_BLD ')
- ALLOCATE(B%CUR%XTI_BLD (SIZE(ZFIELDOUT,1)))
- B%CUR%XTI_BLD (:) = ZFIELDOUT(:,1)
- CASE('QI_BLD ')
- ALLOCATE(B%CUR%XQI_BLD (SIZE(ZFIELDOUT,1)))
- IF (ALL(ZFIELDOUT .GE. XUNDEF-1.E+5 .AND. ZFIELDOUT .LE. XUNDEF+1.E+5)) THEN
- ALLOCATE(ZPS(SIZE(ZFIELDOUT,1)))
- ZPS = XP00 - ZRHOA * XG * XZS_LS
- IF (XHUI_BLD==XUNDEF) THEN
- ZFIELDOUT(:,1) = XHUI_BLD_DEF * QSAT(B%CUR%XTI_BLD, ZPS)
- ELSE
- ZFIELDOUT(:,1) = XHUI_BLD * QSAT(B%CUR%XTI_BLD, ZPS)
- ENDIF
- DEALLOCATE(ZPS)
+IF (YDCTL%LPART3) THEN
+!
+ IF (NRANK==NPIO) THEN
+ INL = SIZE(ZFIELDIN,2)
+ ELSEIF (.NOT.ASSOCIATED(ZFIELDIN)) THEN
+ ALLOCATE(ZFIELDIN(0,0))
ENDIF
- B%CUR%XQI_BLD (:) = ZFIELDOUT(:,1)
- CASE('T_WIN1 ')
- ALLOCATE(B%CUR%XT_WIN1 (SIZE(ZFIELDOUT,1)))
- B%CUR%XT_WIN1 (:) = ZFIELDOUT(:,1)
- CASE('T_WIN2 ')
- ALLOCATE(B%CUR%XT_WIN2 (SIZE(ZFIELDOUT,1)))
- B%CUR%XT_WIN2 (:) = ZFIELDOUT(:,1)
- CASE('T_FLOOR')
- ALLOCATE(B%CUR%XT_FLOOR(SIZE(ZFIELDOUT,1),BOP%NFLOOR_LAYER))
- CALL INIT_FROM_REF_GRID(XGRID_FLOOR,ZFIELDOUT,B%CUR%XD_FLOOR,B%CUR%XT_FLOOR)
- CASE('T_MASS')
- ALLOCATE(B%CUR%XT_MASS(SIZE(ZFIELDOUT,1),BOP%NFLOOR_LAYER))
- CALL INIT_FROM_REF_GRID(XGRID_FLOOR,ZFIELDOUT,B%CUR%XD_FLOOR,B%CUR%XT_MASS)
- CASE('T_ROAD ')
- ALLOCATE(T%CUR%XT_ROAD(SIZE(ZFIELDOUT,1),TOP%NROAD_LAYER))
- CALL INIT_FROM_REF_GRID(XGRID_ROAD,ZFIELDOUT,T%CUR%XD_ROAD,T%CUR%XT_ROAD)
- CASE('T_WALLA')
- ALLOCATE(T%CUR%XT_WALL_A(SIZE(ZFIELDOUT,1),TOP%NWALL_LAYER))
- CALL INIT_FROM_REF_GRID(XGRID_WALL,ZFIELDOUT,T%CUR%XD_WALL,T%CUR%XT_WALL_A)
- CASE('T_WALLB')
- ALLOCATE(T%CUR%XT_WALL_B(SIZE(ZFIELDOUT,1),TOP%NWALL_LAYER))
- IF (TOP%CWALL_OPT=='UNIF') THEN
- T%CUR%XT_WALL_B = T%CUR%XT_WALL_A
- ELSE
- CALL INIT_FROM_REF_GRID(XGRID_WALL,ZFIELDOUT,T%CUR%XD_WALL,T%CUR%XT_WALL_B)
- END IF
- CASE('T_ROOF ')
- ALLOCATE(T%CUR%XT_ROOF(SIZE(ZFIELDOUT,1),TOP%NROOF_LAYER))
- CALL INIT_FROM_REF_GRID(XGRID_ROOF,ZFIELDOUT,T%CUR%XD_ROOF,T%CUR%XT_ROOF)
- CASE('T_CAN ')
- ALLOCATE(T%CUR%XT_CANYON(SIZE(ZFIELDOUT,1)))
- T%CUR%XT_CANYON (:) = ZFIELDOUT(:,1)
- CASE('Q_CAN ')
- ALLOCATE(T%CUR%XQ_CANYON(SIZE(ZFIELDOUT,1)))
- T%CUR%XQ_CANYON (:) = ZFIELDOUT(:,1)
-END SELECT
+ !
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(INL,KIND(INL)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ ENDIF
+ ALLOCATE(ZFIELDOUT(SIZE(G%XLAT),INL))
+ !
+ IF (TOP%CWALL_OPT/='UNIF'.OR.TRIM(HSURF)/='T_WALLB') THEN
+ CALL HOR_INTERPOL(DTCO, U, GCP, ILUOUT,ZFIELDIN,ZFIELDOUT)
+ ENDIF
+ !
+ DEALLOCATE(ZFIELDIN )
+ !
+ENDIF
+!
+CALL PREP_CTL_INT_PART4 (YDCTL, HSURF, 'TOWN', CMASK, ZFIELDIN, ZFIELDOUT)
+
+IF (YDCTL%LPART5) THEN
+!
+!* 6. Return to historical variable
!
+ SELECT CASE (HSURF)
+ CASE('ZS ')
+ ALLOCATE(XZS_LS(SIZE(ZFIELDOUT,1)))
+ XZS_LS(:) = ZFIELDOUT(:,1)
+ CASE('WS_ROOF')
+ ALLOCATE(T%XWS_ROOF(SIZE(ZFIELDOUT,1)))
+ T%XWS_ROOF(:) = ZFIELDOUT(:,1)
+ CASE('WS_ROAD')
+ ALLOCATE(T%XWS_ROAD(SIZE(ZFIELDOUT,1)))
+ T%XWS_ROAD(:) = ZFIELDOUT(:,1)
+ CASE('TI_ROAD')
+ ALLOCATE(T%XTI_ROAD(SIZE(ZFIELDOUT,1)))
+ T%XTI_ROAD(:) = ZFIELDOUT(:,1)
+ CASE('TI_BLD ')
+ ALLOCATE(B%XTI_BLD (SIZE(ZFIELDOUT,1)))
+ B%XTI_BLD (:) = ZFIELDOUT(:,1)
+ CASE('QI_BLD ')
+ ALLOCATE(B%XQI_BLD (SIZE(ZFIELDOUT,1)))
+ IF (ALL(ZFIELDOUT .GE. XUNDEF-1.E+5 .AND. ZFIELDOUT .LE. XUNDEF+1.E+5)) THEN
+ ALLOCATE(ZPS(SIZE(ZFIELDOUT,1)))
+ ZPS = XP00 - ZRHOA * XG * XZS_LS
+ IF (XHUI_BLD==XUNDEF) THEN
+ ZFIELDOUT(:,1) = XHUI_BLD_DEF * QSAT(B%XTI_BLD, ZPS)
+ ELSE
+ ZFIELDOUT(:,1) = XHUI_BLD * QSAT(B%XTI_BLD, ZPS)
+ ENDIF
+ DEALLOCATE(ZPS)
+ ENDIF
+ B%XQI_BLD (:) = ZFIELDOUT(:,1)
+ CASE('T_WIN1 ')
+ ALLOCATE(B%XT_WIN1 (SIZE(ZFIELDOUT,1)))
+ B%XT_WIN1 (:) = ZFIELDOUT(:,1)
+ CASE('T_WIN2 ')
+ ALLOCATE(B%XT_WIN2 (SIZE(ZFIELDOUT,1)))
+ B%XT_WIN2 (:) = ZFIELDOUT(:,1)
+ CASE('T_FLOOR')
+ ALLOCATE(B%XT_FLOOR(SIZE(ZFIELDOUT,1),BOP%NFLOOR_LAYER))
+ CALL INIT_FROM_REF_GRID(XGRID_FLOOR,ZFIELDOUT,B%XD_FLOOR,B%XT_FLOOR)
+ CASE('T_MASS')
+ ALLOCATE(B%XT_MASS(SIZE(ZFIELDOUT,1),BOP%NFLOOR_LAYER))
+ CALL INIT_FROM_REF_GRID(XGRID_FLOOR,ZFIELDOUT,B%XD_FLOOR,B%XT_MASS)
+ CASE('T_ROAD ')
+ ALLOCATE(T%XT_ROAD(SIZE(ZFIELDOUT,1),TOP%NROAD_LAYER))
+ CALL INIT_FROM_REF_GRID(XGRID_ROAD,ZFIELDOUT,T%XD_ROAD,T%XT_ROAD)
+ CASE('T_WALLA')
+ ALLOCATE(T%XT_WALL_A(SIZE(ZFIELDOUT,1),TOP%NWALL_LAYER))
+ CALL INIT_FROM_REF_GRID(XGRID_WALL,ZFIELDOUT,T%XD_WALL,T%XT_WALL_A)
+ CASE('T_WALLB')
+ ALLOCATE(T%XT_WALL_B(SIZE(ZFIELDOUT,1),TOP%NWALL_LAYER))
+ IF (TOP%CWALL_OPT=='UNIF') THEN
+ T%XT_WALL_B = T%XT_WALL_A
+ ELSE
+ CALL INIT_FROM_REF_GRID(XGRID_WALL,ZFIELDOUT,T%XD_WALL,T%XT_WALL_B)
+ END IF
+ CASE('T_ROOF ')
+ ALLOCATE(T%XT_ROOF(SIZE(ZFIELDOUT,1),TOP%NROOF_LAYER))
+ CALL INIT_FROM_REF_GRID(XGRID_ROOF,ZFIELDOUT,T%XD_ROOF,T%XT_ROOF)
+ CASE('T_CAN ')
+ ALLOCATE(T%XT_CANYON(SIZE(ZFIELDOUT,1)))
+ T%XT_CANYON (:) = ZFIELDOUT(:,1)
+ CASE('Q_CAN ')
+ ALLOCATE(T%XQ_CANYON(SIZE(ZFIELDOUT,1)))
+ T%XQ_CANYON (:) = ZFIELDOUT(:,1)
+ END SELECT
+!
+ENDIF
!-------------------------------------------------------------------------------------
!
!* 7. Deallocations
!
-DEALLOCATE(ZFIELDIN )
-DEALLOCATE(ZFIELDOUT)
+IF (ASSOCIATED (ZFIELDOUT)) DEALLOCATE(ZFIELDOUT)
IF (LHOOK) CALL DR_HOOK('PREP_HOR_TEB_FIELD',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
!
- CONTAINS
+CONTAINS
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_hor_teb_garden_field.F90 b/src/SURFEX/prep_hor_teb_garden_field.F90
index 3ab88b1e3c0868b823b35a841998cfb3b7902712..d6e6c5ef8848af4c33d0e94cad1f019513a0d48c 100644
--- a/src/SURFEX/prep_hor_teb_garden_field.F90
+++ b/src/SURFEX/prep_hor_teb_garden_field.F90
@@ -3,9 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_HOR_TEB_GARDEN_FIELD (DTCO, IG, I, UG, U, USS, &
- TGD, TGDO, TGDPE, TGDP, TG, TOP, TVG,GCP, &
- HPROGRAM,HSURF,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH)
+SUBROUTINE PREP_HOR_TEB_GARDEN_FIELD (DTCO, UG, U, USS, GCP, IO, S, K, P, PEK, TG, TOP, &
+ HPROGRAM,HSURF,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH,YDCTL)
! #################################################################################
!
!!**** *PREP_HOR_TEB_GARDEN_FIELD* - reads, interpolates and prepares an ISBA field
@@ -32,44 +31,38 @@ SUBROUTINE PREP_HOR_TEB_GARDEN_FIELD (DTCO, IG, I, UG, U, USS, &
!! B. Decharme 01/2009, Optional Arpege deep soil temperature initialization
!! B. Decharme 03/2014, external init with FA files
!! new vertical interpol
+!! P. Marguinaud10/2014, Support for a 2-part PREP
!!------------------------------------------------------------------
!
-!
-!
-!
-!
-!
-!
-!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
+!
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
-USE MODD_TEB_GARDEN_n, ONLY : TEB_GARDEN_t
-USE MODD_TEB_GARDEN_OPTION_n, ONLY : TEB_GARDEN_OPTIONS_t
-USE MODD_TEB_GARDEN_PGD_EVOL_n, ONLY : TEB_GARDEN_PGD_EVOL_t
-USE MODD_TEB_GARDEN_PGD_n, ONLY : TEB_GARDEN_PGD_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
!
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE, XZS_LS, &
- XLAT_OUT, XLON_OUT, XX_OUT, XY_OUT, &
- LINTERP, CMASK
+USE MODD_TYPE_SNOW
+USE MODD_TYPE_DATE_SURF, ONLY : DATE_TIME
+USE MODD_GRID_GRIB, ONLY : CINMODEL
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC
+USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE, XZS_LS, LINTERP, CMASK
USE MODD_PREP_TEB_GARDEN, ONLY : XGRID_SOIL, NGRID_LEVEL, &
XWSNOW_GD, XRSNOW_GD, XTSNOW_GD, XLWCSNOW_GD, &
XAGESNOW_GD, XASNOW_GD, LSNOW_IDEAL_GD
-
+!
USE MODD_ISBA_PAR, ONLY : XWGMIN
USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
USE MODD_SURF_PAR, ONLY : XUNDEF
!
+USE MODE_PREP_CTL, ONLY : PREP_CTL, PREP_CTL_CAN
+!
+USE MODI_PREP_GRIB_GRID
USE MODI_READ_PREP_TEB_GARDEN_CONF
USE MODI_READ_PREP_GARDEN_SNOW
USE MODI_PREP_TEB_GARDEN_ASCLLV
@@ -83,31 +76,35 @@ USE MODI_PREP_HOR_SNOW_FIELDS
USE MODI_GET_LUOUT
USE MODI_PREP_TEB_GARDEN_EXTERN
USE MODI_ABOR1_SFX
+USE MODI_ALLOCATE_GR_SNOW
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1 declarations of arguments
!
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
+TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
-TYPE(TEB_GARDEN_t), INTENT(INOUT) :: TGD
-TYPE(TEB_GARDEN_OPTIONS_t), INTENT(INOUT) :: TGDO
-TYPE(TEB_GARDEN_PGD_EVOL_t), INTENT(INOUT) :: TGDPE
-TYPE(TEB_GARDEN_PGD_t), INTENT(INOUT) :: TGDP
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_P_t), INTENT(INOUT) :: P
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(GRID_t), INTENT(INOUT) :: TG
TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
-TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+TYPE (PREP_CTL), INTENT(INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
@@ -128,8 +125,10 @@ INTEGER, INTENT(IN) :: KPATCH
CHARACTER(LEN=28) :: YFILE_SNOW ! name of file
CHARACTER(LEN=6) :: YFILEPGDTYPE_SNOW ! type of input file
CHARACTER(LEN=28) :: YFILEPGD_SNOW ! name of file
-REAL, POINTER, DIMENSION(:,:,:) :: ZFIELDIN ! field to interpolate horizontally
-REAL, POINTER, DIMENSION(:,:) :: ZFIELD ! field to interpolate horizontally
+REAL, POINTER, DIMENSION(:,:,:) :: ZFIELDIN=>NULL() ! field to interpolate horizontally
+!
+TYPE(NSURF_SNOW) :: TNPSNOW
+!
REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZFIELDOUTP ! field interpolated horizontally
REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZFIELDOUTV !
REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZVEGTYPE_PATCH ! vegtype for each patch
@@ -141,12 +140,14 @@ REAL, ALLOCATABLE, DIMENSION(:,:) :: ZPATCH ! work array for patches
REAL, ALLOCATABLE, DIMENSION(:) :: ZSG1SNOW, ZSG2SNOW, ZHISTSNOW
INTEGER :: ILUOUT ! output listing logical unit
!
+TYPE (DATE_TIME) :: TZTIME_GRIB ! current date and time
LOGICAL :: GUNIF ! flag for prescribed uniform field
LOGICAL :: GUNIF_SNOW! flag for prescribed uniform field
INTEGER :: JVEGTYPE, JPATCH ! loop on vegtypes
INTEGER :: JLAYER ! loop on layers
INTEGER :: JI, INP, INL, INI
INTEGER :: IWORK ! Work integer
+INTEGER :: INFOMPI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
!
@@ -154,12 +155,17 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* 1. Reading of input file name and type
!
IF (LHOOK) CALL DR_HOOK('PREP_HOR_TEB_GARDEN_FIELD',0,ZHOOK_HANDLE)
+!
+IF (.NOT. PREP_CTL_CAN (YDCTL)) THEN
+ CALL ABOR1_SFX('PREP_HOR_TEB_GARDEN_FIELD: TWO STEP PREP NOT IMPLEMENTED')
+ENDIF
+!
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
CALL READ_PREP_TEB_GARDEN_CONF(HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,&
HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,ILUOUT,GUNIF)
!
- CMASK = 'TOWN '
+CMASK = 'TOWN '
!
INI=SIZE(TG%XLAT)
!-------------------------------------------------------------------------------------
@@ -167,45 +173,60 @@ INI=SIZE(TG%XLAT)
!* 2. Snow variables case?
!
IF (HSURF=='SN_VEG ') THEN
- CALL READ_PREP_GARDEN_SNOW(HPROGRAM,TGD%CUR%TSNOW%SCHEME,TGD%CUR%TSNOW%NLAYER,YFILE_SNOW,&
+ CALL READ_PREP_GARDEN_SNOW(HPROGRAM,PEK%TSNOW%SCHEME,PEK%TSNOW%NLAYER,YFILE_SNOW,&
YFILETYPE_SNOW,YFILEPGD_SNOW,YFILEPGDTYPE_SNOW,GUNIF_SNOW)
+ !
IF(.NOT.GUNIF_SNOW.AND.LEN_TRIM(YFILE_SNOW)==0.AND.LEN_TRIM(YFILETYPE_SNOW)==0)THEN
!IF(LEN_TRIM(YFILE)/=0.AND.LEN_TRIM(YFILETYPE)/=0)THEN
IF (YFILETYPE=='GRIB') THEN
- YFILE_SNOW =YFILE
- YFILETYPE_SNOW=YFILETYPE
- YFILEPGD_SNOW =YFILEPGD
- YFILEPGDTYPE_SNOW=YFILEPGDTYPE
+ YFILE_SNOW = YFILE
+ YFILETYPE_SNOW = YFILETYPE
+ YFILEPGD_SNOW = YFILEPGD
+ YFILEPGDTYPE_SNOW = YFILEPGDTYPE
ELSE
- GUNIF_SNOW=.TRUE.
- IF(ALL(XWSNOW_GD==XUNDEF))XWSNOW_GD=0.0
+ GUNIF_SNOW = .TRUE.
+ IF(ALL(XWSNOW_GD==XUNDEF)) XWSNOW_GD = 0.0
ENDIF
- ENDIF
+ ENDIF
+ !
ALLOCATE(ZSG1SNOW(SIZE(XWSNOW_GD)))
ALLOCATE(ZSG2SNOW(SIZE(XWSNOW_GD)))
ALLOCATE(ZHISTSNOW(SIZE(XWSNOW_GD)))
- ALLOCATE(ZPATCH(SIZE(TGDP%XVEGTYPE,1),1))
- ALLOCATE(ZVEGTYPE_PATCH (SIZE(TGDP%XVEGTYPE,1),SIZE(TGDP%XVEGTYPE,2),1))
!
- ZPATCH=1.
- ZVEGTYPE_PATCH(:,:,1) = TGDP%XVEGTYPE(:,:)
- CALL PREP_HOR_SNOW_FIELDS(DTCO, &
- IG, U,GCP, &
- HPROGRAM,HSURF, &
+ ALLOCATE(TNPSNOW%AL(1))
+ TNPSNOW%AL(1)%SCHEME = PEK%TSNOW%SCHEME
+ TNPSNOW%AL(1)%NLAYER = PEK%TSNOW%NLAYER
+ !
+ CALL PREP_HOR_SNOW_FIELDS(DTCO, TG, U, GCP, HPROGRAM,HSURF, &
YFILE,YFILETYPE, &
YFILEPGD, YFILEPGDTYPE, &
- ILUOUT,GUNIF_SNOW,1,KPATCH, &
- INI,TGD%CUR%TSNOW, TOP%TTIME, &
+ ILUOUT,GUNIF_SNOW,1, KPATCH, &
+ INI, TNPSNOW, TOP%TTIME, &
XWSNOW_GD, XRSNOW_GD, XTSNOW_GD,&
XLWCSNOW_GD, XASNOW_GD, &
LSNOW_IDEAL_GD, ZSG1SNOW, &
- ZSG2SNOW, ZHISTSNOW, XAGESNOW_GD, &
- TGDP%XVEGTYPE,ZVEGTYPE_PATCH, ZPATCH )
+ ZSG2SNOW, ZHISTSNOW, XAGESNOW_GD, YDCTL, &
+ PVEGTYPE_PATCH=S%XVEGTYPE_PATCH, PPATCH=S%XPATCH )
+ !
+ CALL ALLOCATE_GR_SNOW(PEK%TSNOW,INI)
+ PEK%TSNOW%WSNOW = TNPSNOW%AL(1)%WSNOW
+ PEK%TSNOW%RHO = TNPSNOW%AL(1)%RHO
+ PEK%TSNOW%ALB = TNPSNOW%AL(1)%ALB
+ IF (PEK%TSNOW%SCHEME/='D95') PEK%TSNOW%HEAT = TNPSNOW%AL(1)%HEAT
+ IF (PEK%TSNOW%SCHEME=='CRO'.OR.PEK%TSNOW%SCHEME=='3-L') &
+ PEK%TSNOW%AGE = TNPSNOW%AL(1)%AGE
+ IF (PEK%TSNOW%SCHEME=='CRO') THEN
+ PEK%TSNOW%GRAN1 = TNPSNOW%AL(1)%GRAN1
+ PEK%TSNOW%GRAN2 = TNPSNOW%AL(1)%GRAN2
+ PEK%TSNOW%HIST = TNPSNOW%AL(1)%HIST
+ ENDIF
+ !
+ CALL TYPE_SNOW_INIT(TNPSNOW%AL(1))
+ DEALLOCATE(TNPSNOW%AL)
+ !
DEALLOCATE(ZSG1SNOW)
DEALLOCATE(ZSG2SNOW)
DEALLOCATE(ZHISTSNOW)
- DEALLOCATE(ZPATCH)
- DEALLOCATE(ZVEGTYPE_PATCH)
IF (LHOOK) CALL DR_HOOK('PREP_HOR_TEB_GARDEN_FIELD',1,ZHOOK_HANDLE)
RETURN
END IF
@@ -217,12 +238,13 @@ END IF
IF (GUNIF) THEN
CALL PREP_TEB_GARDEN_UNIF(ILUOUT,HSURF,ZFIELDIN)
ELSE IF (YFILETYPE=='ASCLLV') THEN
- CALL PREP_TEB_GARDEN_ASCLLV(DTCO, UG, U, USS, &
- HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
+ CALL PREP_TEB_GARDEN_ASCLLV(DTCO, UG, U, USS, HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
ELSE IF (YFILETYPE=='GRIB ') THEN
- CALL PREP_TEB_GARDEN_GRIB(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
-ELSE IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='ASCII ' .OR. YFILETYPE=='LFI '.OR.YFILETYPE=='FA ') THEN
- CALL PREP_TEB_GARDEN_EXTERN(DTCO, I, U,GCP, &
+ CALL PREP_GRIB_GRID(YFILE,ILUOUT,CINMODEL,CINGRID_TYPE,CINTERP_TYPE,TZTIME_GRIB)
+ IF (NRANK==NPIO) CALL PREP_TEB_GARDEN_GRIB(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
+ELSE IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='ASCII ' .OR. YFILETYPE=='LFI '&
+ .OR.YFILETYPE=='FA '.OR. YFILETYPE=='AROME '.OR.YFILETYPE=='NC ') THEN
+ CALL PREP_TEB_GARDEN_EXTERN(DTCO, IO, U, GCP, &
HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,ILUOUT,KPATCH,ZFIELDIN)
ELSE IF (YFILETYPE=='BUFFER') THEN
CALL PREP_TEB_GARDEN_BUFFER(HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
@@ -234,47 +256,60 @@ END IF
!
!* 5. Horizontal interpolation
!
-INL = SIZE(ZFIELDIN,2)
-INP = SIZE(ZFIELDIN,3)
+IF (NRANK==NPIO) THEN
+ INL = SIZE(ZFIELDIN,2)
+ INP = SIZE(ZFIELDIN,3)
+ELSE
+ IF (.NOT.ASSOCIATED(ZFIELDIN)) ALLOCATE(ZFIELDIN(0,0,0))
+ENDIF
+!
+IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(INL,KIND(INL)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(INP,KIND(INP)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ENDIF
!
ALLOCATE(ZFIELDOUTP(INI,INL,INP))
-ALLOCATE(ZFIELD(SIZE(ZFIELDIN,1),INL))
!
-DO JPATCH = 1, SIZE(ZFIELDIN,3)
- ZFIELD=ZFIELDIN(:,:,JPATCH)
- IF (INP==NVEGTYPE) LINTERP = (TGDP%XVEGTYPE(:,JPATCH) > 0.)
- CALL HOR_INTERPOL(DTCO, U,GCP, &
- ILUOUT,ZFIELD,ZFIELDOUTP(:,:,JPATCH))
+DO JPATCH = 1, INP
+ IF (INP==NVEGTYPE) LINTERP = (S%XVEGTYPE(:,JPATCH) > 0.)
+ CALL HOR_INTERPOL(DTCO, U, GCP, ILUOUT,ZFIELDIN(:,:,JPATCH),ZFIELDOUTP(:,:,JPATCH))
LINTERP = .TRUE.
END DO
!
-DEALLOCATE(ZFIELD)
-!
-ALLOCATE(ZFIELDOUTV(INI,INL,NVEGTYPE))
-!
- CALL PUT_ON_ALL_VEGTYPES(INI,INL,INP,NVEGTYPE,ZFIELDOUTP,ZFIELDOUTV)
-!
-DEALLOCATE(ZFIELDOUTP)
-!
-!-------------------------------------------------------------------------------------
-!
-!* 6. Transformation from vegtype grid to averaged grid
+DEALLOCATE(ZFIELDIN )
!
-ALLOCATE(ZW (INI,SIZE(ZFIELDOUTV,2)))
-ALLOCATE(ZSUM (SIZE(ZFIELDOUTV,1)))
+ALLOCATE(ZW (INI,INL))
ZW = 0.
!
-DO JLAYER=1,SIZE(ZW,2)
- ZSUM(:) = SUM(TGDP%XVEGTYPE(:,:),2,ZFIELDOUTV(:,JLAYER,:)/=XUNDEF)
- DO JVEGTYPE=1,NVEGTYPE
- WHERE (ZFIELDOUTV(:,JLAYER,JVEGTYPE)/=XUNDEF)
- ZW(:,JLAYER) = ZW(:,JLAYER) + TGDP%XVEGTYPE(:,JVEGTYPE) * ZFIELDOUTV(:,JLAYER,JVEGTYPE) / ZSUM(:)
- END WHERE
+IF (1/=INP) THEN
+ !
+ ALLOCATE(ZFIELDOUTV(INI,INL,NVEGTYPE))
+ CALL PUT_ON_ALL_VEGTYPES(INI,INL,INP,NVEGTYPE,ZFIELDOUTP,ZFIELDOUTV)
+ !
+ ALLOCATE(ZSUM (INI))
+ DO JLAYER=1,SIZE(ZW,2)
+ ZSUM(:) = SUM(S%XVEGTYPE(:,:),2,ZFIELDOUTV(:,JLAYER,:)/=XUNDEF)
+ DO JVEGTYPE=1,NVEGTYPE
+ WHERE (ZFIELDOUTV(:,JLAYER,JVEGTYPE)/=XUNDEF)
+ ZW(:,JLAYER) = ZW(:,JLAYER) + S%XVEGTYPE(:,JVEGTYPE) * ZFIELDOUTV(:,JLAYER,JVEGTYPE) / ZSUM(:)
+ END WHERE
+ END DO
+ DO JI=1,SIZE(ZW,1)
+ IF (ALL(ZFIELDOUTV(JI,JLAYER,:)==XUNDEF)) ZW(JI,JLAYER) = XUNDEF
+ ENDDO
END DO
- DO JI=1,SIZE(ZW,1)
- IF (ALL(ZFIELDOUTV(JI,JLAYER,:)==XUNDEF)) ZW(JI,JLAYER) = XUNDEF
- ENDDO
-END DO
+ DEALLOCATE(ZFIELDOUTV)
+ DEALLOCATE(ZSUM)
+ !
+ELSE
+ !
+ ZW(:,:) = ZFIELDOUTP(:,:,1)
+ !
+ENDIF
+!
+DEALLOCATE(ZFIELDOUTP)
!
!-------------------------------------------------------------------------------------
!
@@ -286,66 +321,66 @@ SELECT CASE (HSURF)
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
CASE('WG ')
- ALLOCATE(ZF (SIZE(ZFIELDOUTV,1),TGDO%NGROUND_LAYER))
+ ALLOCATE(ZF (INI,IO%NGROUND_LAYER))
!
!* interpolates on output levels
- CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW,TGDP%XDG,ZF)
+ CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW,P%XDG(:,:),ZF)
!
!* retrieves soil water content from soil relative humidity
- ALLOCATE(TGD%CUR%XWG(SIZE(ZFIELDOUTV,1),TGDO%NGROUND_LAYER))
- TGD%CUR%XWG(:,:) = TGDP%XWWILT + ZF(:,:) * (TGDP%XWFC-TGDP%XWWILT)
- TGD%CUR%XWG(:,:) = MAX(MIN(TGD%CUR%XWG(:,:),TGDP%XWSAT),XWGMIN)
+ ALLOCATE(PEK%XWG(INI,IO%NGROUND_LAYER))
+ PEK%XWG(:,:) = K%XWWILT + ZF(:,:) * (K%XWFC-K%XWWILT)
+ PEK%XWG(:,:) = MAX(MIN(PEK%XWG(:,:),K%XWSAT),XWGMIN)
!
- WHERE(ZF(:,:)==XUNDEF)TGD%CUR%XWG(:,:)=XUNDEF
+ WHERE(ZF(:,:)==XUNDEF)PEK%XWG(:,:)=XUNDEF
!
DEALLOCATE(ZF)
!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
CASE('WGI ')
- ALLOCATE(ZF (SIZE(ZFIELDOUTV,1),TGDO%NGROUND_LAYER))
+ ALLOCATE(ZF (INI,IO%NGROUND_LAYER))
!
!* interpolates on output levels
- CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW,TGDP%XDG,ZF)
+ CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW,P%XDG(:,:),ZF)
!
!* retrieves soil ice content from soil relative humidity
- ALLOCATE(TGD%CUR%XWGI(SIZE(ZFIELDOUTV,1),TGDO%NGROUND_LAYER))
- TGD%CUR%XWGI(:,:) = ZF(:,:) * TGDP%XWSAT
- TGD%CUR%XWGI(:,:) = MAX(MIN(TGD%CUR%XWGI(:,:),TGDP%XWSAT),0.)
+ ALLOCATE(PEK%XWGI(INI,IO%NGROUND_LAYER))
+ PEK%XWGI(:,:) = ZF(:,:) * K%XWSAT
+ PEK%XWGI(:,:) = MAX(MIN(PEK%XWGI(:,:),K%XWSAT),0.)
!
- WHERE(ZF(:,:)==XUNDEF)TGD%CUR%XWGI(:,:)=XUNDEF
+ WHERE(ZF(:,:)==XUNDEF)PEK%XWGI(:,:)=XUNDEF
!
DEALLOCATE(ZF)
!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
CASE('TG ')
- IWORK=TGDO%NGROUND_LAYER
- ALLOCATE(TGD%CUR%XTG(SIZE(ZFIELDOUTV,1),IWORK))
- ALLOCATE(ZDG(SIZE(TGDP%XDG,1),IWORK))
- IF (TVG%CISBA=='2-L'.OR.TVG%CISBA=='3-L') THEN
+ IWORK=IO%NGROUND_LAYER
+ ALLOCATE(PEK%XTG(INI,IWORK))
+ ALLOCATE(ZDG(SIZE(P%XDG,1),IWORK))
+ IF (IO%CISBA=='2-L'.OR.IO%CISBA=='3-L') THEN
ZDG(:,1) = 0.01
ZDG(:,2) = 0.40 ! deep temperature for force-restore taken at 20cm
- IF(TVG%CISBA=='3-L') ZDG(:,3) = 5.00 ! climatological temperature, usually not used
+ IF(IO%CISBA=='3-L') ZDG(:,3) = 5.00 ! climatological temperature, usually not used
ELSE
!* diffusion method, the soil grid is the same as for humidity
- ZDG(:,:) = TGDP%XDG(:,:)
+ ZDG(:,:) = P%XDG(:,:)
END IF
- CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW,ZDG,TGD%CUR%XTG)
+ CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW,ZDG,PEK%XTG(:,:))
DEALLOCATE(ZDG)
!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
CASE('WR ')
- ALLOCATE(TGD%CUR%XWR(SIZE(ZFIELDOUTV,1)))
- TGD%CUR%XWR(:) = ZW(:,1)
+ ALLOCATE(PEK%XWR(INI))
+ PEK%XWR(:) = ZW(:,1)
!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
CASE('LAI ')
!* LAI is updated only if present and pertinent (evolutive LAI) in input file
- WHERE (ZW(:,1)/=XUNDEF) TGDPE%CUR%XLAI(:) = ZW(:,1)
+ WHERE (ZW(:,1)/=XUNDEF) PEK%XLAI(:) = ZW(:,1)
!
END SELECT
!
@@ -354,15 +389,13 @@ DEALLOCATE(ZW)
!
!* 8. Deallocations
!
-DEALLOCATE(ZFIELDIN )
-DEALLOCATE(ZFIELDOUTV)
!
IF (LHOOK) CALL DR_HOOK('PREP_HOR_TEB_GARDEN_FIELD',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
!
- CONTAINS
+CONTAINS
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
@@ -377,7 +410,7 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PD2 ! output layer thickness
REAL, DIMENSION(:,:), INTENT(OUT) :: PT2 ! variable profile
!
INTEGER :: JI, JL ! loop counter
-REAL, DIMENSION(SIZE(PT1,1),SIZE(PT1,2)) :: ZD1 ! input grid
+REAL, DIMENSION(SIZE(PT1),SIZE(PT1,2)) :: ZD1 ! input grid
!
INTEGER :: ILAYER1, ILAYER2
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -391,7 +424,7 @@ IF (SIZE(PT1,2)==3) THEN
!* 1. case with only 3 input levels (typically coming from 'UNIF')
! -----------------------------
!
- IF (TVG%CISBA=='2-L' .OR. TVG%CISBA=='3-L') THEN
+ IF (IO%CISBA=='2-L' .OR. IO%CISBA=='3-L') THEN
!* Possible LTEMP_ARP case
IF(SIZE(PT2,2)>3)THEN
ILAYER1=3
@@ -409,17 +442,17 @@ IF (SIZE(PT1,2)==3) THEN
ENDDO
ENDIF
!
- ELSEIF(TVG%CISBA=='DIF')THEN
+ ELSEIF(IO%CISBA=='DIF')THEN
!surface layer (generally 0.01m imposed)
PT2(:,1) = PT1(:,1)
!deep layers
- DO JL=2,TGDO%NGROUND_LAYER
+ DO JL=2,IO%NGROUND_LAYER
PT2(:,JL) = PT1(:,3)
END DO
!if root layers
DO JI=1,SIZE(PT1,1)
- DO JL=2,TGDO%NGROUND_LAYER
- IF(TGDP%XROOTFRAC(JI,JL)<=1.0)THEN
+ DO JL=2,IO%NGROUND_LAYER
+ IF(P%XROOTFRAC(JI,JL)<=1.0)THEN
PT2(JI,JL) = PT1(JI,2)
EXIT
ENDIF
diff --git a/src/SURFEX/prep_hor_teb_greenroof_field.F90 b/src/SURFEX/prep_hor_teb_greenroof_field.F90
index 4be453fbabdec879e181c6d21eb9d5a85da6b54d..51372ddc38f9c41e69f1850f3ca179ea5323578b 100644
--- a/src/SURFEX/prep_hor_teb_greenroof_field.F90
+++ b/src/SURFEX/prep_hor_teb_greenroof_field.F90
@@ -3,9 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_HOR_TEB_GREENROOF_FIELD (DTCO, IG, I, UG, U, USS, TGR, TGRO, TGRPE, TGRP, &
- TG, TOP,GCP, &
- HPROGRAM,HSURF,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH)
+SUBROUTINE PREP_HOR_TEB_GREENROOF_FIELD (DTCO, UG, U, USS, GCP, IO, S, K, P, PEK, TG, TOP, &
+ HPROGRAM,HSURF,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH,YDCTL)
! #################################################################################################
!
!!**** *PREP_HOR_TEB_GREENROOF_FIELD* - reads, interpolates and prepares an ISBA field for green roofs
@@ -29,26 +28,27 @@ SUBROUTINE PREP_HOR_TEB_GREENROOF_FIELD (DTCO, IG, I, UG, U, USS, TGR, TGRO, TGR
!! MODIFICATIONS
!! -------------
!! Original 07/2011
+!! P. Marguinaud 10/2014, Support for a 2-part PREP
!!------------------------------------------------------------------
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_TEB_GREENROOF_n, ONLY : TEB_GREENROOF_t
-USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
-USE MODD_TEB_GREENROOF_PGD_EVOL_n, ONLY : TEB_GREENROOF_PGD_EVOL_t
-USE MODD_TEB_GREENROOF_PGD_n, ONLY : TEB_GREENROOF_PGD_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
+USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
+!
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+!
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
!
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE, XZS_LS, &
- XLAT_OUT, XLON_OUT, XX_OUT, XY_OUT, &
- LINTERP, CMASK
+USE MODD_TYPE_SNOW
+USE MODD_TYPE_DATE_SURF, ONLY : DATE_TIME
+USE MODD_GRID_GRIB, ONLY : CINMODEL
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC
+USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE, XZS_LS, LINTERP, CMASK
USE MODD_PREP_TEB_GREENROOF, ONLY : XGRID_SOIL, NGRID_LEVEL, &
XWSNOW_GR, XRSNOW_GR, XTSNOW_GR,XLWCSNOW_GR, &
XAGESNOW_GR, XASNOW_GR, LSNOW_IDEAL_GR
@@ -56,6 +56,9 @@ USE MODD_ISBA_PAR, ONLY : XWGMIN
USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
USE MODD_SURF_PAR, ONLY : XUNDEF
!
+USE MODE_PREP_CTL, ONLY : PREP_CTL, PREP_CTL_CAN
+!
+USE MODI_PREP_GRIB_GRID
USE MODI_READ_PREP_TEB_GREENROOF_CONF
USE MODI_READ_PREP_GREENROOF_SNOW
USE MODI_PREP_TEB_GREENROOF_ASCLLV
@@ -68,6 +71,7 @@ USE MODI_PREP_HOR_SNOW_FIELDS
USE MODI_GET_LUOUT
USE MODI_PREP_TEB_GREENROOF_EXTERN
USE MODI_PUT_ON_ALL_VEGTYPES
+USE MODI_ALLOCATE_GR_SNOW
!
USE MODI_ABOR1_SFX
!
@@ -76,22 +80,28 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1 declarations of arguments
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(TEB_GREENROOF_t), INTENT(INOUT) :: TGR
-TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: TGRO
-TYPE(TEB_GREENROOF_PGD_EVOL_t), INTENT(INOUT) :: TGRPE
-TYPE(TEB_GREENROOF_PGD_t), INTENT(INOUT) :: TGRP
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
-TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+TYPE(SSO_t), INTENT(INOUT) :: USS
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_P_t), INTENT(INOUT) :: P
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
+TYPE(GRID_t), INTENT(INOUT) :: TG
+TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+TYPE (PREP_CTL), INTENT(INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
@@ -112,8 +122,10 @@ INTEGER, INTENT(IN) :: KPATCH
CHARACTER(LEN=28) :: YFILE_SNOW ! name of file
CHARACTER(LEN=6) :: YFILEPGDTYPE_SNOW ! type of input file
CHARACTER(LEN=28) :: YFILEPGD_SNOW ! name of file
-REAL, POINTER, DIMENSION(:,:,:) :: ZFIELDIN ! field to interpolate horizontally
-REAL, POINTER, DIMENSION(:,:) :: ZFIELD ! field to interpolate horizontally
+REAL, POINTER, DIMENSION(:,:,:) :: ZFIELDIN=>NULL() ! field to interpolate horizontally
+!
+TYPE(NSURF_SNOW) :: TNPSNOW
+!
REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZFIELDOUTP ! field interpolated horizontally
REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZFIELDOUTV !
REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZVEGTYPE_PATCH ! vegtype for each patch
@@ -124,12 +136,14 @@ REAL, ALLOCATABLE, DIMENSION(:,:) :: ZPATCH ! work array for patches
REAL, ALLOCATABLE, DIMENSION(:) :: ZSG1SNOW, ZSG2SNOW, ZHISTSNOW
INTEGER :: ILUOUT ! output listing logical unit
!
+TYPE (DATE_TIME) :: TZTIME_GRIB ! current date and time
LOGICAL :: GUNIF ! flag for prescribed uniform field
LOGICAL :: GUNIF_SNOW ! flag for prescribed uniform field
INTEGER :: JVEGTYPE, JPATCH ! loop on vegtypes
INTEGER :: JLAYER ! loop on layers
INTEGER :: INI, INL, INP
INTEGER :: IWORK ! Work integer
+INTEGER :: INFOMPI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
!
@@ -138,13 +152,16 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PREP_HOR_TEB_GREENROOF_FIELD',0,ZHOOK_HANDLE)
!
+IF (.NOT. PREP_CTL_CAN (YDCTL)) THEN
+ CALL ABOR1_SFX('PREP_HOR_TEB_GREENROOF_FIELD: TWO STEP PREP NOT IMPLEMENTED')
+ENDIF
!
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
CALL READ_PREP_TEB_GREENROOF_CONF(HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,&
HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,ILUOUT,GUNIF)
!
- CMASK = 'TOWN '
+CMASK = 'TOWN '
!
INI=SIZE(TG%XLAT)
!
@@ -152,45 +169,57 @@ INI=SIZE(TG%XLAT)
!* 2. Snow variables case
!
IF (HSURF=='SN_VEG ') THEN
- CALL READ_PREP_GREENROOF_SNOW(HPROGRAM,TGR%CUR%TSNOW%SCHEME,TGR%CUR%TSNOW%NLAYER,YFILE_SNOW,&
+ CALL READ_PREP_GREENROOF_SNOW(HPROGRAM,PEK%TSNOW%SCHEME,PEK%TSNOW%NLAYER,YFILE_SNOW,&
YFILETYPE_SNOW,YFILEPGD_SNOW,YFILEPGDTYPE_SNOW,GUNIF_SNOW)
+ !
IF(.NOT.GUNIF_SNOW.AND.LEN_TRIM(YFILE_SNOW)==0.AND.LEN_TRIM(YFILETYPE_SNOW)==0)THEN
!IF(LEN_TRIM(YFILE)/=0.AND.LEN_TRIM(YFILETYPE)/=0)THEN
IF (YFILETYPE=='GRIB') THEN
- YFILE_SNOW =YFILE
- YFILETYPE_SNOW=YFILETYPE
- YFILEPGD_SNOW =YFILEPGD
- YFILEPGDTYPE_SNOW=YFILEPGDTYPE
+ YFILE_SNOW = YFILE
+ YFILETYPE_SNOW = YFILETYPE
+ YFILEPGD_SNOW = YFILEPGD
+ YFILEPGDTYPE_SNOW = YFILEPGDTYPE
ELSE
GUNIF_SNOW=.TRUE.
IF(ALL(XWSNOW_GR==XUNDEF))XWSNOW_GR=0.0
ENDIF
- ENDIF
+ ENDIF
+ !
ALLOCATE(ZSG1SNOW(SIZE(XWSNOW_GR)))
ALLOCATE(ZSG2SNOW(SIZE(XWSNOW_GR)))
ALLOCATE(ZHISTSNOW(SIZE(XWSNOW_GR)))
- ALLOCATE(ZPATCH(SIZE(TGRP%XVEGTYPE,1),1))
- ALLOCATE(ZVEGTYPE_PATCH (SIZE(TGRP%XVEGTYPE,1),SIZE(TGRP%XVEGTYPE,2),1))
!
- ZPATCH=1.
- ZVEGTYPE_PATCH(:,:,1) = TGRP%XVEGTYPE(:,:)
- CALL PREP_HOR_SNOW_FIELDS(DTCO, &
- IG, U,GCP, &
- HPROGRAM,HSURF, &
+ ALLOCATE(TNPSNOW%AL(1))
+ TNPSNOW%AL(1)%SCHEME = PEK%TSNOW%SCHEME
+ TNPSNOW%AL(1)%NLAYER = PEK%TSNOW%NLAYER
+ !
+ CALL PREP_HOR_SNOW_FIELDS(DTCO, TG, U, GCP, HPROGRAM,HSURF, &
YFILE,YFILETYPE, &
YFILEPGD, YFILEPGDTYPE, &
ILUOUT,GUNIF_SNOW, 1, KPATCH, &
- SIZE(TG%XLAT),TGR%CUR%TSNOW, TOP%TTIME, &
+ INI, TNPSNOW, TOP%TTIME, &
XWSNOW_GR, XRSNOW_GR, XTSNOW_GR,&
XLWCSNOW_GR, XASNOW_GR, &
LSNOW_IDEAL_GR, ZSG1SNOW, &
- ZSG2SNOW, ZHISTSNOW, XAGESNOW_GR, &
- TGRP%XVEGTYPE,ZVEGTYPE_PATCH, ZPATCH )
+ ZSG2SNOW, ZHISTSNOW, XAGESNOW_GR, YDCTL, &
+ PVEGTYPE_PATCH=S%XVEGTYPE_PATCH, PPATCH=S%XPATCH )
+ !
+ CALL ALLOCATE_GR_SNOW(PEK%TSNOW,INI)
+ PEK%TSNOW%WSNOW = TNPSNOW%AL(1)%WSNOW
+ PEK%TSNOW%RHO = TNPSNOW%AL(1)%RHO
+ PEK%TSNOW%ALB = TNPSNOW%AL(1)%ALB
+ IF (PEK%TSNOW%SCHEME/='D95') PEK%TSNOW%HEAT = TNPSNOW%AL(1)%HEAT
+ IF (PEK%TSNOW%SCHEME=='CRO'.OR.PEK%TSNOW%SCHEME=='3-L') &
+ PEK%TSNOW%AGE = TNPSNOW%AL(1)%AGE
+ IF (PEK%TSNOW%SCHEME=='CRO') THEN
+ PEK%TSNOW%GRAN1 = TNPSNOW%AL(1)%GRAN1
+ PEK%TSNOW%GRAN2 = TNPSNOW%AL(1)%GRAN2
+ PEK%TSNOW%HIST = TNPSNOW%AL(1)%HIST
+ ENDIF
+ !
DEALLOCATE(ZSG1SNOW)
DEALLOCATE(ZSG2SNOW)
DEALLOCATE(ZHISTSNOW)
- DEALLOCATE(ZPATCH)
- DEALLOCATE(ZVEGTYPE_PATCH)
IF (LHOOK) CALL DR_HOOK('PREP_HOR_TEB_GREENROOF_FIELD',1,ZHOOK_HANDLE)
RETURN
END IF
@@ -202,12 +231,13 @@ END IF
IF (GUNIF) THEN
CALL PREP_TEB_GREENROOF_UNIF(ILUOUT,HSURF,ZFIELDIN)
ELSE IF (YFILETYPE=='ASCLLV') THEN
- CALL PREP_TEB_GREENROOF_ASCLLV(DTCO, UG, U, USS, &
- HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
+ CALL PREP_TEB_GREENROOF_ASCLLV(DTCO, UG, U, USS, HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
ELSE IF (YFILETYPE=='GRIB ') THEN
- CALL PREP_TEB_GREENROOF_GRIB(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
-ELSE IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='ASCII ' .OR. YFILETYPE=='LFI '.OR. YFILETYPE=='FA ') THEN
- CALL PREP_TEB_GREENROOF_EXTERN(DTCO, I, U,GCP, &
+ CALL PREP_GRIB_GRID(YFILE,ILUOUT,CINMODEL,CINGRID_TYPE,CINTERP_TYPE,TZTIME_GRIB)
+ IF (NRANK==NPIO) CALL PREP_TEB_GREENROOF_GRIB(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
+ELSE IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='ASCII ' .OR. YFILETYPE=='LFI '&
+ .OR. YFILETYPE=='FA '.OR. YFILETYPE=='AROME '.OR.YFILETYPE=='NC ') THEN
+ CALL PREP_TEB_GREENROOF_EXTERN(DTCO, IO, U, GCP, &
HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,ILUOUT,KPATCH,ZFIELDIN)
ELSE IF (YFILETYPE=='BUFFER') THEN
CALL PREP_TEB_GREENROOF_BUFFER(HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
@@ -219,25 +249,50 @@ END IF
!
!* 5. Horizontal interpolation for vegtype grid
!
-INL = SIZE(ZFIELDIN,2)
-INP = SIZE(ZFIELDIN,3)
+IF (NRANK==NPIO) THEN
+ INL = SIZE(ZFIELDIN,2)
+ INP = SIZE(ZFIELDIN,3)
+ELSE
+ IF (.NOT.ASSOCIATED(ZFIELDIN)) ALLOCATE(ZFIELDIN(0,0,0))
+ENDIF
+!
+IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(INL,KIND(INL)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(INP,KIND(INP)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ENDIF
!
ALLOCATE(ZFIELDOUTP(INI,INL,INP))
-ALLOCATE(ZFIELD(SIZE(ZFIELDIN,1),INL))
!
DO JPATCH = 1, INP
- ZFIELD=ZFIELDIN(:,:,JPATCH)
- IF (INP==NVEGTYPE) LINTERP = (TGRP%XVEGTYPE(:,JPATCH) > 0.)
- CALL HOR_INTERPOL(DTCO, U,GCP, &
- ILUOUT,ZFIELD,ZFIELDOUTP(:,:,JPATCH))
+ IF (INP==NVEGTYPE) LINTERP = (S%XVEGTYPE(:,JPATCH) > 0.)
+ CALL HOR_INTERPOL(DTCO, U, GCP, ILUOUT,ZFIELDIN(:,:,JPATCH),ZFIELDOUTP(:,:,JPATCH))
LINTERP = .TRUE.
END DO
!
-DEALLOCATE(ZFIELD)
+DEALLOCATE(ZFIELDIN )
!
-ALLOCATE(ZFIELDOUTV(INI,INL,NVEGTYPE))
+ALLOCATE(ZW (INI,INL))
+ZW = 0.
!
- CALL PUT_ON_ALL_VEGTYPES(INI,INL,INP,NVEGTYPE,ZFIELDOUTP,ZFIELDOUTV)
+IF (1/=INP) THEN
+ !
+ ALLOCATE(ZFIELDOUTV(INI,INL,NVEGTYPE))
+ CALL PUT_ON_ALL_VEGTYPES(INI,INL,INP,NVEGTYPE,ZFIELDOUTP,ZFIELDOUTV)
+ !
+ DO JVEGTYPE=1,NVEGTYPE
+ DO JLAYER=1,SIZE(ZW,2)
+ ZW(:,JLAYER) = ZW(:,JLAYER) + S%XVEGTYPE(:,JVEGTYPE) * ZFIELDOUTV(:,JLAYER,JVEGTYPE)
+ END DO
+ END DO
+ DEALLOCATE(ZFIELDOUTV)
+ !
+ELSE
+ !
+ ZW(:,:) = ZFIELDOUTP(:,:,1)
+ !
+ENDIF
!
DEALLOCATE(ZFIELDOUTP)
!
@@ -245,20 +300,9 @@ DEALLOCATE(ZFIELDOUTP)
!
!* 6. Transformation from vegtype grid to patch grid
!
-ALLOCATE(ZW (INI,INL))
-ZW = 0.
-DO JVEGTYPE=1,NVEGTYPE
- DO JLAYER=1,SIZE(ZW,2)
- ZW(:,JLAYER) = ZW(:,JLAYER) + TGRP%XVEGTYPE(:,JVEGTYPE) * ZFIELDOUTV(:,JLAYER,JVEGTYPE)
- END DO
-END DO
-!
!
!* 8. Deallocations
!
-DEALLOCATE(ZFIELDIN )
-DEALLOCATE(ZFIELDOUTV)
-!
!-------------------------------------------------------------------------------------
!
!* 7. Return to historical variable
@@ -269,59 +313,60 @@ SELECT CASE (HSURF)
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
CASE('WG ')
- ALLOCATE(ZF (INI,TGRO%NLAYER_GR))
+ ALLOCATE(ZF (INI,IO%NGROUND_LAYER))
!
!* interpolates on output levels
- CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW,TGRP%XDG,ZF)
+ CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW,P%XDG(:,:),ZF)
+
!
!* retrieves soil water content from soil relative humidity
- ALLOCATE(TGR%CUR%XWG(INI,TGRO%NLAYER_GR))
- TGR%CUR%XWG(:,:) = TGRP%XWWILT + ZF(:,:) * (TGRP%XWFC-TGRP%XWWILT)
- TGR%CUR%XWG(:,:) = MAX(MIN(TGR%CUR%XWG(:,:),TGRP%XWSAT),XWGMIN)
+ ALLOCATE(PEK%XWG(INI,IO%NGROUND_LAYER))
+ PEK%XWG(:,:) = K%XWWILT + ZF(:,:) * (K%XWFC-K%XWWILT)
+ PEK%XWG(:,:) = MAX(MIN(PEK%XWG(:,:),K%XWSAT),XWGMIN)
!
- WHERE(ZF(:,:)==XUNDEF)TGR%CUR%XWG(:,:)=XUNDEF
+ WHERE(ZF(:,:)==XUNDEF)PEK%XWG(:,:)=XUNDEF
!
DEALLOCATE(ZF)
!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
CASE('WGI ')
- ALLOCATE(ZF (INI,TGRO%NLAYER_GR))
+ ALLOCATE(ZF (INI,IO%NGROUND_LAYER))
!
!* interpolates on output levels
- CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW,TGRP%XDG,ZF)
+ CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW,P%XDG(:,:),ZF)
!
!* retrieves soil ice content from soil relative humidity
- ALLOCATE(TGR%CUR%XWGI(INI,TGRO%NLAYER_GR))
- TGR%CUR%XWGI(:,:) = ZF(:,:) * TGRP%XWSAT
- TGR%CUR%XWGI(:,:) = MAX(MIN(TGR%CUR%XWGI(:,:),TGRP%XWSAT),0.)
+ ALLOCATE(PEK%XWGI(INI,IO%NGROUND_LAYER))
+ PEK%XWGI(:,:) = ZF(:,:) * K%XWSAT
+ PEK%XWGI(:,:) = MAX(MIN(PEK%XWGI(:,:),K%XWSAT),0.)
!
- WHERE(ZF(:,:)==XUNDEF)TGR%CUR%XWGI(:,:)=XUNDEF
+ WHERE(ZF(:,:)==XUNDEF)PEK%XWGI(:,:)=XUNDEF
!
DEALLOCATE(ZF)
!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
CASE('TG ')
- IWORK=TGRO%NLAYER_GR
- ALLOCATE(TGR%CUR%XTG(INI,IWORK))
- ALLOCATE(ZDG(SIZE(TGRP%XDG,1),IWORK))
+ IWORK=IO%NGROUND_LAYER
+ ALLOCATE(PEK%XTG(INI,IWORK))
+ ALLOCATE(ZDG(SIZE(P%XDG,1),IWORK))
!* diffusion method, the soil grid is the same as for humidity
- ZDG(:,:) = TGRP%XDG(:,:)
- CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW,ZDG,TGR%CUR%XTG)
+ ZDG(:,:) = P%XDG(:,:)
+ CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW,ZDG,PEK%XTG(:,:))
DEALLOCATE(ZDG)
!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
CASE('WR ')
- ALLOCATE(TGR%CUR%XWR(INI))
- TGR%CUR%XWR(:) = ZW(:,1)
+ ALLOCATE(PEK%XWR(INI))
+ PEK%XWR(:) = ZW(:,1)
!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
CASE('LAI ')
!* LAI is updated only if present and pertinent (evolutive LAI) in input file
- WHERE (ZW(:,1)/=XUNDEF) TGRPE%CUR%XLAI(:) = ZW(:,1)
+ WHERE (ZW(:,1)/=XUNDEF) PEK%XLAI(:) = ZW(:,1)
!
END SELECT
!
@@ -333,7 +378,7 @@ IF (LHOOK) CALL DR_HOOK('PREP_HOR_TEB_GREENROOF_FIELD',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
!
- CONTAINS
+CONTAINS
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
@@ -365,13 +410,13 @@ IF (SIZE(PT1,2)==3) THEN
!surface layer (generally 0.01m imposed)
PT2(:,1) = PT1(:,1)
!deep layers
- DO JL=2,TGRO%NLAYER_GR
+ DO JL=2,IO%NGROUND_LAYER
PT2(:,JL) = PT1(:,3)
END DO
!if root layers
DO JI=1,SIZE(PT1,1)
- DO JL=2,TGRO%NLAYER_GR
- IF(TGRP%XROOTFRAC(JI,JL)<=1.0)THEN
+ DO JL=2,IO%NGROUND_LAYER
+ IF(P%XROOTFRAC(JI,JL)<=1.0)THEN
PT2(JI,JL) = PT1(JI,2)
EXIT
ENDIF
diff --git a/src/SURFEX/prep_hor_watflux_field.F90 b/src/SURFEX/prep_hor_watflux_field.F90
index 0b70a303219baf22a0bb7a777b420bd398768e49..9b6bdcd2f16f7b2d569dbd35695a4498d33b3dd3 100644
--- a/src/SURFEX/prep_hor_watflux_field.F90
+++ b/src/SURFEX/prep_hor_watflux_field.F90
@@ -3,9 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_HOR_WATFLUX_FIELD (DTCO, U, &
- WG, W,GCP, &
- HPROGRAM,HSURF,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+SUBROUTINE PREP_HOR_WATFLUX_FIELD (DTCO, U, GCP, KLAT, W, &
+ HPROGRAM,HSURF,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
! #################################################################################
!
!!**** *PREP_HOR_WATFLUX_FIELD* - Reads, interpolates and prepares a water field
@@ -28,24 +27,25 @@ SUBROUTINE PREP_HOR_WATFLUX_FIELD (DTCO, U, &
!! -------------
!! Original 01/2004
!! P. Le Moigne 10/2005, Phasage Arome
+!! P. Marguinaud10/2014, Support for a 2-part PREP
!!------------------------------------------------------------------
!
-!
-!
-!
-!
-!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
-USE MODD_WATFLUX_GRID_n, ONLY : WATFLUX_GRID_t
USE MODD_WATFLUX_n, ONLY : WATFLUX_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
!
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE, XZS_LS, XLAT_OUT, XLON_OUT, &
- XX_OUT, XY_OUT, CMASK
+USE MODD_TYPE_DATE_SURF, ONLY : DATE_TIME
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC
+!
+USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE, XZS_LS, CMASK
+!
+USE MODD_GRID_GRIB, ONLY : CINMODEL
+!
+USE MODE_PREP_CTL, ONLY : PREP_CTL, PREP_CTL_INT_PART2, PREP_CTL_INT_PART4
!
+USE MODI_PREP_GRIB_GRID
USE MODI_READ_PREP_WATFLUX_CONF
USE MODI_PREP_WATFLUX_GRIB
USE MODI_PREP_WATFLUX_UNIF
@@ -60,16 +60,19 @@ USE PARKIND1 ,ONLY : JPRB
USE MODI_ABOR1_SFX
IMPLICIT NONE
!
-!* 0.1 declarations of arguments
-!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
!
+!* 0.1 declarations of arguments
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
-TYPE(WATFLUX_GRID_t), INTENT(INOUT) :: WG
+INTEGER, INTENT(IN) :: KLAT
TYPE(WATFLUX_t), INTENT(INOUT) :: W
-TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+TYPE (PREP_CTL), INTENT (INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
@@ -84,11 +87,13 @@ TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
CHARACTER(LEN=28) :: YFILE ! name of file
CHARACTER(LEN=6) :: YFILEPGDTYPE ! type of input file
CHARACTER(LEN=28) :: YFILEPGD ! name of file
+ TYPE (DATE_TIME) :: TZTIME_GRIB ! current date and time
REAL, POINTER, DIMENSION(:,:) :: ZFIELDIN ! field to interpolate horizontally
-REAL, ALLOCATABLE, DIMENSION(:,:) :: ZFIELDOUT ! field interpolated horizontally
+REAL, POINTER, DIMENSION(:,:) :: ZFIELDOUT ! field interpolated horizontally
INTEGER :: ILUOUT ! output listing logical unit
!
LOGICAL :: GUNIF ! flag for prescribed uniform field
+INTEGER :: INFOMPI, INL
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
!
@@ -101,50 +106,77 @@ IF (LHOOK) CALL DR_HOOK('PREP_HOR_WATFLUX_FIELD',0,ZHOOK_HANDLE)
CALL READ_PREP_WATFLUX_CONF(HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,&
HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,ILUOUT,GUNIF)
!
- CMASK = 'WATER'
+CMASK = 'WATER'
!
!-------------------------------------------------------------------------------------
!
!* 2. Reading of input configuration (Grid and interpolation type)
!
-IF (GUNIF) THEN
- CALL PREP_WATFLUX_UNIF(ILUOUT,HSURF,ZFIELDIN)
-ELSE IF (YFILETYPE=='GRIB ') THEN
- CALL PREP_WATFLUX_GRIB(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
-ELSE IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='ASCII ' .OR. YFILETYPE=='LFI '.OR. YFILETYPE=='FA ') THEN
- CALL PREP_WATFLUX_EXTERN(GCP,&
- HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,ILUOUT,ZFIELDIN)
-ELSE IF (YFILETYPE=='BUFFER') THEN
- CALL PREP_WATFLUX_BUFFER(HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
-ELSE
- CALL ABOR1_SFX('PREP_HOR_WATFLUX_FIELD: data file type not supported : '//YFILETYPE)
-END IF
+NULLIFY (ZFIELDIN, ZFIELDOUT)
+!
+IF (YDCTL%LPART1) THEN
+ IF (GUNIF) THEN
+ CALL PREP_WATFLUX_UNIF(ILUOUT,HSURF,ZFIELDIN)
+ ELSE IF (YFILETYPE=='GRIB ') THEN
+ CALL PREP_GRIB_GRID(YFILE,ILUOUT,CINMODEL,CINGRID_TYPE,CINTERP_TYPE,TZTIME_GRIB)
+ IF (NRANK==NPIO) CALL PREP_WATFLUX_GRIB(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN)
+ ELSE IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='ASCII ' .OR. YFILETYPE=='LFI '&
+ .OR. YFILETYPE=='FA '.OR. YFILETYPE=='AROME '.OR.YFILETYPE=='NC ') THEN
+ CALL PREP_WATFLUX_EXTERN(GCP,HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,ILUOUT,ZFIELDIN)
+ ELSE IF (YFILETYPE=='BUFFER') THEN
+ CALL PREP_WATFLUX_BUFFER(HPROGRAM,HSURF,ILUOUT,ZFIELDIN)
+ ELSE
+ CALL ABOR1_SFX('PREP_HOR_WATFLUX_FIELD: data file type not supported : '//YFILETYPE)
+ END IF
+ENDIF
!
!
!* 4. Horizontal interpolation
!
-ALLOCATE(ZFIELDOUT(SIZE(WG%XLAT),SIZE(ZFIELDIN,2)))
+ CALL PREP_CTL_INT_PART2 (YDCTL, HSURF, 'WATER', CMASK, ZFIELDIN)
!
- CALL HOR_INTERPOL(DTCO, U,GCP, &
- ILUOUT,ZFIELDIN,ZFIELDOUT)
+IF (YDCTL%LPART3) THEN
+!
+ IF (NRANK==NPIO) THEN
+ INL = SIZE(ZFIELDIN,2)
+ ELSEIF (.NOT.ASSOCIATED(ZFIELDIN)) THEN
+ ALLOCATE(ZFIELDIN(0,0))
+ ENDIF
+ !
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(INL,KIND(INL)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ ENDIF
+ ALLOCATE(ZFIELDOUT(KLAT,INL))
+ !
+ CALL HOR_INTERPOL(DTCO, U, GCP, ILUOUT,ZFIELDIN,ZFIELDOUT)
+ !
+ENDIF
+!
+ CALL PREP_CTL_INT_PART4 (YDCTL, HSURF, 'WATER', CMASK, ZFIELDIN, ZFIELDOUT)
+!
+IF (YDCTL%LPART5) THEN
!
!* 5. Return to historical variable
!
-SELECT CASE (HSURF)
- CASE('ZS ')
- ALLOCATE(XZS_LS(SIZE(ZFIELDOUT,1)))
- XZS_LS(:) = ZFIELDOUT(:,1)
- CASE('TSWATER')
- ALLOCATE(W%XTS(SIZE(ZFIELDOUT,1)))
- W%XTS(:) = ZFIELDOUT(:,1)
-END SELECT
+ SELECT CASE (HSURF)
+ CASE('ZS ')
+ ALLOCATE(XZS_LS(SIZE(ZFIELDOUT,1)))
+ XZS_LS(:) = ZFIELDOUT(:,1)
+ CASE('TSWATER')
+ ALLOCATE(W%XTS(SIZE(ZFIELDOUT,1)))
+ W%XTS(:) = ZFIELDOUT(:,1)
+ END SELECT
+!
+ENDIF
!
!-------------------------------------------------------------------------------------
!
!* 6. Deallocations
!
-DEALLOCATE(ZFIELDIN )
-DEALLOCATE(ZFIELDOUT)
+IF (ASSOCIATED (ZFIELDIN)) DEALLOCATE(ZFIELDIN )
+IF (ASSOCIATED (ZFIELDOUT)) DEALLOCATE(ZFIELDOUT)
IF (LHOOK) CALL DR_HOOK('PREP_HOR_WATFLUX_FIELD',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_inland_water.F90 b/src/SURFEX/prep_inland_water.F90
index 05e60609dd98dcd84a648222c272d0c11702b7ba..d9e6db5ef561f79e296c1977bcf9b4afb1973c68 100644
--- a/src/SURFEX/prep_inland_water.F90
+++ b/src/SURFEX/prep_inland_water.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_INLAND_WATER (DTCO, USS, UG, U, FM, WM,GCP, &
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+SUBROUTINE PREP_INLAND_WATER (DTCO, USS, UG, U, GCP, FM, WM, &
+ HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
! #################################################################################
!
!!**** *PREP_INLAND_WATER* - Chooses the surface schemes for lakes preparation
@@ -26,6 +26,7 @@ SUBROUTINE PREP_INLAND_WATER (DTCO, USS, UG, U, FM, WM,GCP, &
!! MODIFICATIONS
!! -------------
!! Original 01/2004
+!! P. Marguinaud10/2014, Support for a 2-part PREP
!!------------------------------------------------------------------
!
!
@@ -33,11 +34,13 @@ USE MODD_SURFEX_n, ONLY : WATFLUX_MODEL_t
USE MODD_SURFEX_n, ONLY : FLAKE_MODEL_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
+!
+USE MODE_PREP_CTL, ONLY : PREP_CTL
!
USE MODI_PREP_WATFLUX
USE MODI_PREP_FLAKE
@@ -52,13 +55,15 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
TYPE(FLAKE_MODEL_t), INTENT(INOUT) :: FM
TYPE(WATFLUX_MODEL_t), INTENT(INOUT) :: WM
-TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+TYPE (PREP_CTL), INTENT(INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! name of the Atmospheric file
@@ -74,11 +79,9 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PREP_INLAND_WATER',0,ZHOOK_HANDLE)
IF (U%CWATER=='WATFLX') THEN
- CALL PREP_WATFLUX(DTCO, UG, U, WM,GCP, &
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+ CALL PREP_WATFLUX(DTCO, UG, U, GCP, WM%G, WM%W, WM%SB, HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
ELSE IF (U%CWATER=='FLAKE ') THEN
- CALL PREP_FLAKE(DTCO, USS, FM, UG, U,GCP, &
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+ CALL PREP_FLAKE(DTCO, USS, FM%G, FM%F, FM%SB, UG, U, GCP, HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
END IF
IF (LHOOK) CALL DR_HOOK('PREP_INLAND_WATER',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/prep_isba.F90 b/src/SURFEX/prep_isba.F90
index 3f24f7b23063071aed82fe5f9fef4bbe5039ee13..cfe861bffd138c28745e21fb182dbd6adc93ef09 100644
--- a/src/SURFEX/prep_isba.F90
+++ b/src/SURFEX/prep_isba.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_ISBA (DTCO, ICP, IG, I, UG, U, USS,GCP, &
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+SUBROUTINE PREP_ISBA (DTCO, UG, U, USS, GCP, SB, IG, IO, S, NK, NP, NPE, &
+ HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
! #################################################################################
!
!!**** *PREP_ISBA* - Prepares ISBA fields
@@ -45,74 +45,79 @@ SUBROUTINE PREP_ISBA (DTCO, ICP, IG, I, UG, U, USS,GCP, &
!! liquid/solid water with DIF (results don't change)
!! if lglacier in input file, do not initialize again
!! P. Samuelsson (10/2014): MEB
+!! P. Marguinaud10/2014, Support for a 2-part PREP
!!------------------------------------------------------------------
!
-!
-!
-!
-!
-!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_ISBA_CANOPY_n, ONLY : ISBA_CANOPY_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
-USE MODI_PREP_HOR_ISBA_FIELD
-USE MODI_PREP_VER_ISBA
-USE MODI_PREP_OUTPUT_GRID
-USE MODI_GET_LUOUT
-USE MODI_PREP_ISBA_CANOPY
+USE MODD_CANOPY_n, ONLY : CANOPY_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_NK_t, ISBA_K_t, ISBA_NP_t, ISBA_P_t, &
+ ISBA_NPE_t, ISBA_PE_t
!
-USE MODD_READ_NAMELIST, ONLY : LNAM_READ
-USE MODD_SURF_ATM, ONLY : LVERTSHIFT
-USE MODD_DATA_COVER_PAR, ONLY : NVT_SNOW
+USE MODN_PREP_ISBA
+USE MODN_PREP_ISBA_SNOW, ONLY : LSWEMAX, XSWEMAX
!
-!
-USE MODD_DEEPSOIL, ONLY : LPHYSDOMC
-USE MODD_CSTS, ONLY : XTT, XG, XLMTT
+USE MODD_DATA_COVER_PAR, ONLY : NVT_SNOW
USE MODD_SNOW_PAR, ONLY : XEMISSN
USE MODD_ISBA_PAR, ONLY : XWGMIN
-!
USE MODD_CO2V_PAR, ONLY : XANFMINIT
USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE MODD_READ_NAMELIST, ONLY : LNAM_READ
+USE MODD_SURF_ATM, ONLY : LVERTSHIFT
+!
+USE MODD_DEEPSOIL, ONLY : LPHYSDOMC
+USE MODD_CSTS, ONLY : XTT, XG, XLMTT
USE MODD_PREP, ONLY : XZS_LS
USE MODD_PREP_SNOW, ONLY : LSNOW_PREP_PERM
!
-USE MODN_PREP_ISBA
-USE MODN_PREP_ISBA_SNOW, ONLY : LSWEMAX, XSWEMAX
+USE MODE_PREP_CTL, ONLY : PREP_CTL
!
+USE MODI_PREP_HOR_ISBA_FIELD
+USE MODI_PREP_VER_ISBA
+USE MODI_PREP_OUTPUT_GRID
+USE MODI_GET_LUOUT
+USE MODI_PREP_SBL
USE MODI_VEGTYPE_TO_PATCH
+!
USE MODI_PREP_PERM_SNOW
USE MODI_INIT_SNOW_LW
USE MODI_AVERAGED_ALBEDO_EMIS_ISBA
USE MODI_PREP_HOR_ISBA_CC_FIELD
USE MODI_SOIL_ALBEDO
!
+USE MODI_CLEAN_PREP_OUTPUT_GRID
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
-USE MODI_CLEAN_PREP_OUTPUT_GRID
-!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(ISBA_CANOPY_t), INTENT(INOUT) :: ICP
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
+TYPE(GRID_t), INTENT(INOUT) :: IG
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_NK_t), INTENT(INOUT) :: NK
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
+!
+TYPE (PREP_CTL), INTENT(INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! name of the Atmospheric file
@@ -122,17 +127,20 @@ TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
!* 0.2 declarations of local variables
!
+TYPE(ISBA_K_t), POINTER :: KK
+TYPE(ISBA_P_t), POINTER :: PK
+TYPE(ISBA_PE_t), POINTER :: PEK
+!
INTEGER :: ILUOUT, INI
INTEGER :: JP, JL, JJ
-INTEGER :: ISNOW ! patch number where permanent snow is
REAL :: ZWORK, ZLOG, ZWTOT, ZMATPOT, ZWL
!
REAL, DIMENSION(1) :: ZSW_BANDS ! middle wavelength of each band
-REAL, DIMENSION(SIZE(I%XLAI,1),SIZE(I%XLAI,2)) :: ZDIR_ALB ! direct albedo for each band
-REAL, DIMENSION(SIZE(I%XLAI,1),SIZE(I%XLAI,2)) :: ZSCA_ALB ! diffuse albedo for each band
-REAL, DIMENSION(SIZE(I%XLAI,1)) :: ZEMIS ! emissivity
-REAL, DIMENSION(SIZE(I%XLAI,1)) :: ZZENITH ! solar zenithal angle
-REAL, DIMENSION(SIZE(I%XLAI,1)) :: ZTSURF ! surface effective temperature
+REAL, DIMENSION(U%NSIZE_NATURE,IO%NPATCH) :: ZDIR_ALB, ZTG1 ! direct albedo for each band
+REAL, DIMENSION(U%NSIZE_NATURE,IO%NPATCH) :: ZSCA_ALB ! diffuse albedo for each band
+REAL, DIMENSION(U%NSIZE_NATURE) :: ZEMIS ! emissivity
+REAL, DIMENSION(U%NSIZE_NATURE) :: ZZENITH ! solar zenithal angle
+REAL, DIMENSION(U%NSIZE_NATURE) :: ZTSURF ! surface effective temperature
!
LOGICAL :: GPERMSNOW
LOGICAL :: GTEMP2WGI
@@ -142,7 +150,7 @@ LOGICAL :: GTG
!
REAL :: SMAX
!
-INTEGER :: ISIZE_LMEB_PATCH
+INTEGER :: ISIZE_LMEB_PATCH, ISNOW
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -157,14 +165,13 @@ GWG = .TRUE.
GWGI = .TRUE.
GTG = .TRUE.
!
-ISIZE_LMEB_PATCH=COUNT(I%LMEB_PATCH(:))
+ISIZE_LMEB_PATCH=COUNT(IO%LMEB_PATCH(:))
!
!* 1.1 Default
!
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
- CALL PREP_OUTPUT_GRID(UG, U, &
- ILUOUT,IG%CGRID,IG%XGRID_PAR,IG%XLAT,IG%XLON)
+ CALL PREP_OUTPUT_GRID(UG%G, IG, U%NSIZE_FULL, ILUOUT)
!
!-------------------------------------------------------------------------------------
!
@@ -173,168 +180,212 @@ ISIZE_LMEB_PATCH=COUNT(I%LMEB_PATCH(:))
!
!* 2.0 Large scale orography
!
- CALL PREP_HOR_ISBA_FIELD(DTCO, IG, I, UG, U, USS,GCP, &
- HPROGRAM,'ZS ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+ CALL PREP_HOR_ISBA_FIELD(DTCO, UG, U, USS, GCP, IG, IO, S, NK, NP, NPE, S%TTIME, &
+ HPROGRAM,'ZS ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
!
!* 2.1 Soil Water reservoirs
!
- CALL PREP_HOR_ISBA_FIELD(DTCO, IG, I, UG, U, USS,GCP, &
- HPROGRAM,'WG ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,GWG)
+ CALL PREP_HOR_ISBA_FIELD(DTCO, UG, U, USS, GCP, IG, IO, S, NK, NP, NPE, S%TTIME, &
+ HPROGRAM,'WG ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL,GWG)
!
!* 2.2 Soil ice reservoirs
!
- CALL PREP_HOR_ISBA_FIELD(DTCO, IG, I, UG, U, USS,GCP, &
- HPROGRAM,'WGI ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,GWGI)
+ CALL PREP_HOR_ISBA_FIELD(DTCO, UG, U, USS, GCP, IG, IO, S, NK, NP, NPE, S%TTIME, &
+ HPROGRAM,'WGI ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL,GWGI)
!
!* 2.3 Leaves interception water reservoir
!
- CALL PREP_HOR_ISBA_FIELD(DTCO, IG, I, UG, U, USS,GCP, &
- HPROGRAM,'WR ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+ CALL PREP_HOR_ISBA_FIELD(DTCO, UG, U, USS, GCP, IG, IO, S, NK, NP, NPE, S%TTIME, &
+ HPROGRAM,'WR ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
!
!* 2.4 Temperature profile
!
- CALL PREP_HOR_ISBA_FIELD(DTCO, IG, I, UG, U, USS,GCP, &
- HPROGRAM,'TG ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,GTG)
+ CALL PREP_HOR_ISBA_FIELD(DTCO, UG, U, USS, GCP, IG, IO, S, NK, NP, NPE, S%TTIME, &
+ HPROGRAM,'TG ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL,GTG)
!
!* 2.5 Snow variables
!
- CALL PREP_HOR_ISBA_FIELD(DTCO, IG, I, UG, U, USS,GCP, &
- HPROGRAM,'SN_VEG ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,GPERMSNOW)
+ CALL PREP_HOR_ISBA_FIELD(DTCO, UG, U, USS, GCP, IG, IO, S, NK, NP, NPE, S%TTIME, &
+ HPROGRAM,'SN_VEG ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL,GPERMSNOW)
!
!* 2.6 LAI
!
- CALL PREP_HOR_ISBA_FIELD(DTCO, IG, I, UG, U, USS,GCP, &
- HPROGRAM,'LAI ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+ CALL PREP_HOR_ISBA_FIELD(DTCO, UG, U, USS, GCP, IG, IO, S, NK, NP, NPE, S%TTIME, &
+ HPROGRAM,'LAI ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
!
!* 2.7 GLACIER
!
-IF(I%LGLACIER)THEN
- CALL PREP_HOR_ISBA_FIELD(DTCO, IG, I, UG, U, USS,GCP, &
- HPROGRAM,'ICE_STO',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+IF(IO%LGLACIER)THEN
+ CALL PREP_HOR_ISBA_FIELD(DTCO, UG, U, USS, GCP, IG, IO, S, NK, NP, NPE, S%TTIME, &
+ HPROGRAM,'ICE_STO',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
ENDIF
!
!* 2.8 Canopy vegetation temperature and interception reservoirs and air variables
!
IF(ISIZE_LMEB_PATCH>0)THEN
- CALL PREP_HOR_ISBA_FIELD(DTCO, IG, I, UG, U, USS,GCP, &
- HPROGRAM,'TV ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
- CALL PREP_HOR_ISBA_FIELD(DTCO, IG, I, UG, U, USS,GCP, &
- HPROGRAM,'TL ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
- CALL PREP_HOR_ISBA_FIELD(DTCO, IG, I, UG, U, USS,GCP, &
- HPROGRAM,'WRL ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
- CALL PREP_HOR_ISBA_FIELD(DTCO, IG, I, UG, U, USS,GCP, &
- HPROGRAM,'WRLI ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
- CALL PREP_HOR_ISBA_FIELD(DTCO, IG, I, UG, U, USS,GCP, &
- HPROGRAM,'WRVN ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
- CALL PREP_HOR_ISBA_FIELD(DTCO, IG, I, UG, U, USS,GCP, &
- HPROGRAM,'TC ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
- CALL PREP_HOR_ISBA_FIELD(DTCO, IG, I, UG, U, USS,GCP, &
- HPROGRAM,'QC ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+ CALL PREP_HOR_ISBA_FIELD(DTCO, UG, U, USS, GCP, IG, IO, S, NK, NP, NPE, S%TTIME, &
+ HPROGRAM,'TV ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
+ CALL PREP_HOR_ISBA_FIELD(DTCO, UG, U, USS, GCP, IG, IO, S, NK, NP, NPE, S%TTIME, &
+ HPROGRAM,'TL ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
+ CALL PREP_HOR_ISBA_FIELD(DTCO, UG, U, USS, GCP, IG, IO, S, NK, NP, NPE, S%TTIME, &
+ HPROGRAM,'WRL ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
+ CALL PREP_HOR_ISBA_FIELD(DTCO, UG, U, USS, GCP, IG, IO, S, NK, NP, NPE, S%TTIME, &
+ HPROGRAM,'WRLI ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
+ CALL PREP_HOR_ISBA_FIELD(DTCO, UG, U, USS, GCP, IG, IO, S, NK, NP, NPE, S%TTIME, &
+ HPROGRAM,'WRVN ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
+ CALL PREP_HOR_ISBA_FIELD(DTCO, UG, U, USS, GCP, IG, IO, S, NK, NP, NPE, S%TTIME, &
+ HPROGRAM,'TC ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
+ CALL PREP_HOR_ISBA_FIELD(DTCO, UG, U, USS, GCP, IG, IO, S, NK, NP, NPE, S%TTIME, &
+ HPROGRAM,'QC ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
+ENDIF
+!
+!* 7. Isba-Ags prognostic fields
+!
+IF (IO%CPHOTO == 'NIT' .OR. IO%CPHOTO == 'NCB') THEN
+ CALL PREP_HOR_ISBA_CC_FIELD(DTCO, U, GCP, SIZE(IG%XLAT), IO, S, NK, NP, NPE, &
+ HPROGRAM,'BIOMASS ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
ENDIF
!
+!* 8. Isba-CC prognostic fields
+!
+IF (IO%CPHOTO/='NON' .AND. IO%CRESPSL == 'CNT') THEN
+ !
+ !* 8.1 Litter
+ !
+ CALL PREP_HOR_ISBA_CC_FIELD(DTCO, U, GCP, SIZE(IG%XLAT), IO, S, NK, NP, NPE, &
+ HPROGRAM,'LITTER ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
+ !
+ !* 8.2 Soil carbon
+ !
+ CALL PREP_HOR_ISBA_CC_FIELD(DTCO, U, GCP, SIZE(IG%XLAT), IO, S, NK, NP, NPE, &
+ HPROGRAM,'SOILCARB',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
+ !
+ !* 8.2 lignin
+ !
+ CALL PREP_HOR_ISBA_CC_FIELD(DTCO, U, GCP, SIZE(IG%XLAT), IO, S, NK, NP, NPE, &
+ HPROGRAM,'LIGNIN ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
+ENDIF
+!
+ CALL CLEAN_PREP_OUTPUT_GRID
+
+IF (YDCTL%LPART6) THEN
!-------------------------------------------------------------------------------------
!
!* 3. Physical limitation:
!
-! No ice for force restore third layer:
-IF (I%CISBA == '3-L') THEN
- DO JP=1,I%NPATCH
- WHERE(I%XWG(:,3,JP) /= XUNDEF)
- I%XWG(:,3,JP) = MIN(I%XWG(:,3,JP)+I%XWGI(:,3,JP),I%XWSAT(:,3))
- I%XWGI(:,3,JP) = 0.
+ DO JP=1,IO%NPATCH
+ PEK => NPE%AL(JP)
+ KK => NK%AL(JP)
+ !
+ ! No ice for force restore third layer:
+ IF (IO%CISBA == '3-L') THEN
+ !
+ WHERE(PEK%XWG(:,3) /= XUNDEF)
+ PEK%XWG(:,3) = MIN(PEK%XWG(:,3)+ PEK%XWGI(:,3),KK%XWSAT(:,3))
+ PEK%XWGI(:,3) = 0.
END WHERE
- ENDDO
-ENDIF
-!
-! Total water content should not exceed saturation:
-DO JP=1,I%NPATCH
- WHERE(I%XWG(:,:,JP) /= XUNDEF .AND. (I%XWG(:,:,JP) + I%XWGI(:,:,JP)) > I%XWSAT(:,:) )
- I%XWGI(:,:,JP) = I%XWSAT(:,:) - I%XWG(:,:,JP)
- END WHERE
-ENDDO
+ ENDIF
+ !
+ ! Total water content should not exceed saturation:
+ WHERE(PEK%XWG(:,:) /= XUNDEF .AND. (PEK%XWG(:,:) + PEK%XWGI(:,:)) > KK%XWSAT(:,:) )
+ PEK%XWGI(:,:) = KK%XWSAT(:,:) - PEK%XWG(:,:)
+ END WHERE
+
+ ENDDO
!
!-------------------------------------------------------------------------------------
!
!* 3. Vertical interpolations of all variables
!
-IF(LVERTSHIFT)THEN
- CALL PREP_VER_ISBA(I)
-ENDIF
+ IF(LVERTSHIFT)THEN
+ CALL PREP_VER_ISBA(IO, NPE, S%XZS, NP)
+ ENDIF
!
-DEALLOCATE(XZS_LS)
+ DEALLOCATE(XZS_LS)
!-------------------------------------------------------------------------------------
!
!* 4. Treatment of permanent snow
!
-IF (GPERMSNOW.AND.LSNOW_PREP_PERM) THEN
- ISNOW = VEGTYPE_TO_PATCH(NVT_SNOW,I%NPATCH)
- CALL PREP_PERM_SNOW(I, &
- I%TSNOW,I%XTG(:,:,ISNOW),I%XVEGTYPE_PATCH(:,:,ISNOW),ISNOW)
-ENDIF
+ IF (GPERMSNOW.AND.LSNOW_PREP_PERM) THEN
+ ISNOW = VEGTYPE_TO_PATCH(NVT_SNOW,IO%NPATCH)
+ CALL PREP_PERM_SNOW(IO, NK%AL(ISNOW), NP%AL(ISNOW), NPE%AL(ISNOW))
+ ENDIF
!
- CALL INIT_SNOW_LW(XEMISSN,I%TSNOW)
+ DO JP = 1,IO%NPATCH
+ CALL INIT_SNOW_LW(XEMISSN,NPE%AL(JP)%TSNOW)
+ ENDDO
!
-IF (LPHYSDOMC) THEN
- I%TSNOW%WSNOW(:,:,:)=0.
-ENDIF
+ IF (LPHYSDOMC) THEN
+ DO JP = 1,IO%NPATCH
+ NPE%AL(JP)%TSNOW%WSNOW(:,:)=0.
+ ENDDO
+ ENDIF
!-------------------------------------------------------------------------------------
!
!* 4.b Possibility for setting an upper limit on the initial snow water equivalent field
-IF (LSWEMAX) THEN
- SMAX = MAXVAL(I%TSNOW%WSNOW(:,:,:))
- WRITE(*,*) ' MAX(Snow content (kg/m2)): ', SMAX
- WRITE(*,*) ' Set MAX to', XSWEMAX, '(kg/m2)'
- I%TSNOW%WSNOW(:,:,:) = MIN(I%TSNOW%WSNOW(:,:,:),XSWEMAX)
- SMAX = MAXVAL(I%TSNOW%WSNOW(:,:,:))
- WRITE(*,*) ' MAX(Snow content (kg/m2)): ', SMAX
-ENDIF
+!
+ IF (LSWEMAX) THEN
+ DO JP = 1,IO%NPATCH
+ SMAX = MAXVAL(NPE%AL(JP)%TSNOW%WSNOW(:,:))
+ WRITE(*,*) ' MAX(Snow content (kg/m2)): ', SMAX
+ WRITE(*,*) ' Set MAX to', XSWEMAX, '(kg/m2)'
+ NPE%AL(JP)%TSNOW%WSNOW(:,:) = MIN(NPE%AL(JP)%TSNOW%WSNOW(:,:),XSWEMAX)
+ SMAX = MAXVAL(NPE%AL(JP)%TSNOW%WSNOW(:,:))
+ WRITE(*,*) ' MAX(Snow content (kg/m2)): ', SMAX
+ ENDDO
+ ENDIF
!
!-------------------------------------------------------------------------------------
!
!* 5. coherence between soil temperature and liquid/solid water
!
-GTEMP2WGI=(GWG.OR.GWGI.OR.GTG)
-!
-IF (I%CISBA == 'DIF'.AND.GTEMP2WGI) THEN
- INI=SIZE(I%XWSAT,1)
- DO JP=1,I%NPATCH
- DO JL=1,I%NGROUND_LAYER
- DO JJ=1,INI
- IF(I%XWG(JJ,JL,JP)/=XUNDEF)THEN
+ GTEMP2WGI=(GWG.OR.GWGI.OR.GTG)
+!
+ IF (IO%CISBA == 'DIF'.AND.GTEMP2WGI) THEN
+ DO JP=1,IO%NPATCH
+ PEK => NPE%AL(JP)
+ PK => NP%AL(JP)
+ KK => NK%AL(JP)
+ !
+ DO JL=1,IO%NGROUND_LAYER
+ !
+ DO JJ=1,PK%NSIZE_P
+ !
+ IF(PEK%XWG(JJ,JL)/=XUNDEF)THEN
!
-! total soil moisture
- ZWTOT = I%XWG(JJ,JL,JP)+I%XWGI(JJ,JL,JP)
- ZWTOT = MIN(ZWTOT,I%XWSAT(JJ,JL))
-!
-! total matric potential
-! psi=mpotsat*(w/wsat)**(-bcoef)
- ZWORK = ZWTOT/I%XWSAT(JJ,JL)
- ZLOG = I%XBCOEF(JJ,JL)*LOG(ZWORK)
- ZMATPOT = I%XMPOTSAT(JJ,JL)*EXP(-ZLOG)
-!
-! soil liquid water content computation
-! w=wsat*(psi/mpotsat)**(-1/bcoef)
- ZMATPOT = MIN(I%XMPOTSAT(JJ,JL),XLMTT*(I%XTG(JJ,JL,JP)-XTT)/(XG*I%XTG(JJ,JL,JP)))
- ZWORK = MAX(1.0,ZMATPOT/I%XMPOTSAT(JJ,JL))
- ZLOG = LOG(ZWORK)
- ZWL = I%XWSAT(JJ,JL)*EXP(-ZLOG/I%XBCOEF(JJ,JL))
- ZWL = MAX(ZWL,XWGMIN)
- I%XWG(JJ,JL,JP) = MIN(ZWL,ZWTOT )
+! total soil moisture
+ ZWTOT = PEK%XWG(JJ,JL)+PEK%XWGI(JJ,JL)
+ ZWTOT = MIN(ZWTOT,KK%XWSAT(JJ,JL))
+!
+! total matric potential
+! psi=mpotsat*(w/wsat)**(-bcoef)
+ ZWORK = ZWTOT/KK%XWSAT(JJ,JL)
+ ZLOG = KK%XBCOEF(JJ,JL)*LOG(ZWORK)
+ ZMATPOT = KK%XMPOTSAT(JJ,JL)*EXP(-ZLOG)
+!
+! soil liquid water content computation
+! w=wsat*(psi/mpotsat)**(-1/bcoef)
+ ZMATPOT = MIN(KK%XMPOTSAT(JJ,JL),XLMTT*(PEK%XTG(JJ,JL)-XTT)/(XG*PEK%XTG(JJ,JL)))
+ ZWORK = MAX(1.0,ZMATPOT/KK%XMPOTSAT(JJ,JL))
+ ZLOG = LOG(ZWORK)
+ ZWL = KK%XWSAT(JJ,JL)*EXP(-ZLOG/KK%XBCOEF(JJ,JL))
+ ZWL = MAX(ZWL,XWGMIN)
+ PEK%XWG(JJ,JL) = MIN(ZWL,ZWTOT )
!
-! soil ice computation
- I%XWGI(JJ,JL,JP) = MAX(0.0,ZWTOT-I%XWG(JJ,JL,JP))
+! soil ice computation
+ PEK%XWGI(JJ,JL) = MAX(0.0,ZWTOT-PEK%XWG(JJ,JL))
!
-! supress numerical artefact
- IF(I%XTG(JJ,JL,JP)>=XTT)THEN
- I%XWG (JJ,JL,JP) = MIN(I%XWG(JJ,JL,JP)+I%XWGI(JJ,JL,JP),I%XWSAT(JJ,JL))
- I%XWGI(JJ,JL,JP) = 0.0
- ENDIF
-!
+! supress numerical artefact
+ IF(PEK%XTG(JJ,JL)>=XTT)THEN
+ PEK%XWG (JJ,JL) = MIN(PEK%XWG(JJ,JL)+PEK%XWGI(JJ,JL),KK%XWSAT(JJ,JL))
+ PEK%XWGI(JJ,JL) = 0.0
ENDIF
+!
+ ENDIF
ENDDO
ENDDO
- ENDDO
-ENDIF
+ ENDDO
+ ENDIF
!
!-------------------------------------------------------------------------------------
!
@@ -342,141 +393,113 @@ ENDIF
! The only variable used from the AVERAGED_ALBEDO_EMIS_ISBA call
! is XTSRAD_NAT. All other variables are treated as dummies.
!
-ALLOCATE(I%XRESA(SIZE(I%XLAI,1),SIZE(I%XLAI,2)))
-I%XRESA = 100.
-!
-ALLOCATE(I%XTSRAD_NAT(SIZE(I%XLAI,1)))
-ZZENITH(:)=0.
-ZSW_BANDS(:)=0.
-!
-ALLOCATE(I%XALBNIR(SIZE(I%XLAI,1),SIZE(I%XLAI,2)))
-ALLOCATE(I%XALBVIS(SIZE(I%XLAI,1),SIZE(I%XLAI,2)))
-ALLOCATE(I%XALBUV(SIZE(I%XLAI,1),SIZE(I%XLAI,2)))
-I%XALBNIR = 0.0
-I%XALBVIS = 0.0
-I%XALBUV = 0.0
-!
-ALLOCATE(I%XALBNIR_SOIL(SIZE(I%XLAI,1),SIZE(I%XLAI,2)))
-ALLOCATE(I%XALBVIS_SOIL(SIZE(I%XLAI,1),SIZE(I%XLAI,2)))
-ALLOCATE(I%XALBUV_SOIL(SIZE(I%XLAI,1),SIZE(I%XLAI,2)))
- CALL SOIL_ALBEDO (I%CALBEDO, I%XWSAT(:,1),I%XWG(:,1,:), &
- I%XALBVIS_DRY,I%XALBNIR_DRY,I%XALBUV_DRY, &
- I%XALBVIS_WET,I%XALBNIR_WET,I%XALBUV_WET, &
- I%XALBVIS_SOIL,I%XALBNIR_SOIL,I%XALBUV_SOIL )
-!
-ALLOCATE(I%XPSN (SIZE(I%XLAI,1),SIZE(I%XLAI,2)))
-ALLOCATE(I%XPSNG (SIZE(I%XLAI,1),SIZE(I%XLAI,2)))
-ALLOCATE(I%XPSNV (SIZE(I%XLAI,1),SIZE(I%XLAI,2)))
-ALLOCATE(I%XPSNV_A(SIZE(I%XLAI,1),SIZE(I%XLAI,2)))
-I%XPSN = 0.0
-I%XPSNG = 0.0
-I%XPSNV = 0.0
-I%XPSNV_A = 0.0
-ALLOCATE(I%XDIR_ALB_WITH_SNOW(SIZE(I%XLAI,1),1,SIZE(I%XLAI,2)))
-ALLOCATE(I%XSCA_ALB_WITH_SNOW(SIZE(I%XLAI,1),1,SIZE(I%XLAI,2)))
-I%XDIR_ALB_WITH_SNOW = 0.0
-I%XSCA_ALB_WITH_SNOW = 0.0
- CALL AVERAGED_ALBEDO_EMIS_ISBA(I, &
- .FALSE., I%CALBEDO, ZZENITH, &
- I%XVEG,I%XZ0,I%XLAI, &
- I%LMEB_PATCH,I%XGNDLITTER,I%XZ0LITTER,I%XLAIGV, &
- I%XH_VEG, I%XTV, &
- I%XTG(:,1,:),I%XPATCH, ZSW_BANDS, &
- I%XALBNIR_VEG,I%XALBVIS_VEG,I%XALBUV_VEG, &
- I%XALBNIR_SOIL,I%XALBVIS_SOIL,I%XALBUV_SOIL, &
- I%XEMIS, &
- I%TSNOW, &
- I%XALBNIR,I%XALBVIS,I%XALBUV, &
- ZDIR_ALB, ZSCA_ALB, &
- ZEMIS,I%XTSRAD_NAT,ZTSURF )
-DEALLOCATE(I%XPSN)
-DEALLOCATE(I%XPSNG)
-DEALLOCATE(I%XPSNV)
-DEALLOCATE(I%XPSNV_A)
-DEALLOCATE(I%XDIR_ALB_WITH_SNOW)
-DEALLOCATE(I%XSCA_ALB_WITH_SNOW)
-!
-!-------------------------------------------------------------------------------------
-!
-!* 7. Isba-Ags prognostic fields
-!
-IF (I%CPHOTO /= 'NON') THEN
-!
- ALLOCATE(I%XAN(SIZE(I%XLAI,1),SIZE(I%XLAI,2)))
- I%XAN = 0.
-!
- ALLOCATE(I%XANDAY(SIZE(I%XLAI,1),SIZE(I%XLAI,2)))
- I%XANDAY = 0.
-!
- ALLOCATE(I%XANFM(SIZE(I%XLAI,1),SIZE(I%XLAI,2)))
- I%XANFM = XANFMINIT
-!
- ALLOCATE(I%XLE(SIZE(I%XLAI,1),SIZE(I%XLAI,2)))
- I%XLE = 0.
-!
- ALLOCATE(I%XRESP_BIOMASS(SIZE(I%XLAI,1),I%NNBIOMASS,SIZE(I%XLAI,2)))
- I%XRESP_BIOMASS(:,:,:) = 0.
-!
-ENDIF
-!
-IF (I%CPHOTO == 'AGS' .OR. I%CPHOTO == 'AST') THEN
-!
- ALLOCATE(I%XBIOMASS(SIZE(I%XLAI,1),I%NNBIOMASS,SIZE(I%XLAI,2)))
- I%XBIOMASS(:,:,:) = 0.
-!
-ELSEIF (I%CPHOTO == 'LAI' .OR. I%CPHOTO == 'LST') THEN
-!
- ALLOCATE(I%XBIOMASS(SIZE(I%XLAI,1),I%NNBIOMASS,SIZE(I%XLAI,2)))
- WHERE(I%XLAI(:,:)/=XUNDEF)
- I%XBIOMASS(:,1,:) = I%XLAI(:,:) * I%XBSLAI(:,:)
- ELSEWHERE
- I%XBIOMASS(:,1,:) = 0.0
- ENDWHERE
-!
-ELSEIF (I%CPHOTO == 'NIT' .OR. I%CPHOTO == 'NCB') THEN
-!
- CALL PREP_HOR_ISBA_CC_FIELD(DTCO, U, &
- IG, I,GCP, &
- HPROGRAM,'BIOMASS ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
-!
-ENDIF
+ DO JP = 1,IO%NPATCH
+ !
+ PEK => NPE%AL(JP)
+ PK => NP%AL(JP)
+ KK => NK%AL(JP)
+ !
+ ALLOCATE(PEK%XRESA(PK%NSIZE_P))
+ PEK%XRESA = 100.
+ !
+ ALLOCATE(PEK%XALBNIR(PK%NSIZE_P))
+ ALLOCATE(PEK%XALBVIS(PK%NSIZE_P))
+ ALLOCATE(PEK%XALBUV(PK%NSIZE_P))
+ PEK%XALBNIR = 0.0
+ PEK%XALBVIS = 0.0
+ PEK%XALBUV = 0.0
+ !
+ ALLOCATE(PEK%XALBNIR_SOIL(PK%NSIZE_P))
+ ALLOCATE(PEK%XALBVIS_SOIL(PK%NSIZE_P))
+ ALLOCATE(PEK%XALBUV_SOIL (PK%NSIZE_P))
+ CALL SOIL_ALBEDO (IO%CALBEDO, KK%XWSAT(:,1),PEK%XWG(:,1), KK, PEK, "ALL" )
+ !
+ ALLOCATE(PEK%XPSN (PK%NSIZE_P))
+ ALLOCATE(PEK%XPSNG (PK%NSIZE_P))
+ ALLOCATE(PEK%XPSNV (PK%NSIZE_P))
+ ALLOCATE(PEK%XPSNV_A(PK%NSIZE_P))
+ PEK%XPSN = 0.0
+ PEK%XPSNG = 0.0
+ PEK%XPSNV = 0.0
+ PEK%XPSNV_A = 0.0
+ ALLOCATE(KK%XDIR_ALB_WITH_SNOW(PK%NSIZE_P,1))
+ ALLOCATE(KK%XSCA_ALB_WITH_SNOW(PK%NSIZE_P,1))
+ !
+ ZTG1(1:PK%NSIZE_P,JP) = PEK%XTG(:,1)
+ !
+ ENDDO
+ !
+ ALLOCATE(S%XTSRAD_NAT(U%NSIZE_NATURE))
+ ZZENITH(:)=0.
+ ZSW_BANDS(:)=0.
+ !
+ CALL AVERAGED_ALBEDO_EMIS_ISBA(IO, S, NK, NP, NPE, &
+ ZZENITH, ZTG1, ZSW_BANDS, ZDIR_ALB, ZSCA_ALB, &
+ ZEMIS, S%XTSRAD_NAT, ZTSURF )
+ !
+ DO JP = 1,IO%NPATCH
+ DEALLOCATE(NPE%AL(JP)%XPSN)
+ DEALLOCATE(NPE%AL(JP)%XPSNG)
+ DEALLOCATE(NPE%AL(JP)%XPSNV)
+ DEALLOCATE(NPE%AL(JP)%XPSNV_A)
+ DEALLOCATE(NK%AL(JP)%XDIR_ALB_WITH_SNOW)
+ DEALLOCATE(NK%AL(JP)%XSCA_ALB_WITH_SNOW)
+ ENDDO
+ !
+ !-------------------------------------------------------------------------------------
+ !
+ !* 7. Isba-Ags prognostic fields
+ !
+ IF (IO%CPHOTO /= 'NON') THEN
+ !
+ DO JP = 1,IO%NPATCH
+ !
+ PEK => NPE%AL(JP)
+ PK => NP%AL(JP)
+ !
+ ALLOCATE(PEK%XAN(PK%NSIZE_P))
+ PEK%XAN = 0.
+ !
+ ALLOCATE(PEK%XANDAY(PK%NSIZE_P))
+ PEK%XANDAY = 0.
+ !
+ ALLOCATE(PEK%XANFM(PK%NSIZE_P))
+ PEK%XANFM = XANFMINIT
+ !
+ ALLOCATE(PEK%XLE(PK%NSIZE_P))
+ PEK%XLE = 0.
+ !
+ ALLOCATE(PEK%XRESP_BIOMASS(PK%NSIZE_P,IO%NNBIOMASS))
+ PEK%XRESP_BIOMASS(:,:) = 0.
+ !
+ ENDDO
+ !
+ ENDIF
+ !
+ IF (IO%CPHOTO == 'AST') THEN
+ !
+ DO JP = 1,IO%NPATCH
+ !
+ PEK => NPE%AL(JP)
+ PK => NP%AL(JP)
+ !
+ ALLOCATE(PEK%XBIOMASS(PK%NSIZE_P,IO%NNBIOMASS))
+ PEK%XBIOMASS(:,:) = 0.
+ !
+ ENDDO
+ !
+ ENDIF
!
!-------------------------------------------------------------------------------------
!
-!* 8. Isba-CC prognostic fields
-!
-IF (I%CRESPSL == 'CNT') THEN
-!
-!* 8.1 Litter
-!
- CALL PREP_HOR_ISBA_CC_FIELD(DTCO, U, &
- IG, I,GCP, &
- HPROGRAM,'LITTER ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
-!
-!* 8.2 Soil carbon
-!
- CALL PREP_HOR_ISBA_CC_FIELD(DTCO, U, &
- IG, I,GCP, &
- HPROGRAM,'SOILCARB',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+!* 10. Preparation of canopy air variables
!
-!* 8.2 lignin
!
- CALL PREP_HOR_ISBA_CC_FIELD(DTCO, U, &
- IG, I,GCP, &
- HPROGRAM,'LIGNIN ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+ IO%LCANOPY = LISBA_CANOPY
+ IF (IO%LCANOPY) CALL PREP_SBL(IG%NDIM, SB)
!
ENDIF
!
-!-------------------------------------------------------------------------------------
- CALL CLEAN_PREP_OUTPUT_GRID
-!-------------------------------------------------------------------------------------
-!
-!* 10. Preparation of canopy air variables
-!
-!
-I%LCANOPY = LISBA_CANOPY
-IF (I%LCANOPY) CALL PREP_ISBA_CANOPY(ICP, IG)
-!
IF (LHOOK) CALL DR_HOOK('PREP_ISBA',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_isba_ascllv.F90 b/src/SURFEX/prep_isba_ascllv.F90
index 24db817bcf8683cce746a3f51619d88fda8663da..3b9ba798d4992d3a46205ac5e198381b7d45d8bd 100644
--- a/src/SURFEX/prep_isba_ascllv.F90
+++ b/src/SURFEX/prep_isba_ascllv.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_ISBA_ASCLLV (DTCO, UG, U, USS, &
- HPROGRAM,HSURF,KLUOUT,PFIELD)
+SUBROUTINE PREP_ISBA_ASCLLV (DTCO, UG, U, USS, HPROGRAM,HSURF,KLUOUT,PFIELD)
! #################################################################################
!
!!**** *PREP_ISBA_ASCLLV* - prepares ISBA field from prescribed values
@@ -31,12 +30,12 @@ SUBROUTINE PREP_ISBA_ASCLLV (DTCO, UG, U, USS, &
!
!
!
-!
+USE MODD_SURFEX_MPI, ONLY : NPROC, NINDEX, NNUM, NCOMM, NPIO, NRANK
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_PREP, ONLY : CINTERP_TYPE
USE MODD_PGD_GRID, ONLY : NL,LLATLONMASK,CGRID,XGRID_PAR,NGRID_PAR
@@ -59,13 +58,17 @@ USE MODI_GET_TYPE_DIM_n
!
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1 declarations of arguments
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
@@ -78,30 +81,58 @@ INTEGER :: JV ! loop counter
INTEGER :: JLAYER
INTEGER :: IL
!
+INTEGER, DIMENSION(0:NPROC-1) :: INB
+INTEGER :: INFOMPI, JJ
+!
REAL, ALLOCATABLE, DIMENSION(:,:) :: ZFIELD
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PREP_ISBA_ASCLLV',0,ZHOOK_HANDLE)
- CATYPE = 'ARI'
+!
+IF (.NOT.ALLOCATED(NNUM)) THEN
+ ALLOCATE(NNUM(U%NDIM_FULL))
+ IF (NRANK/=NPIO) THEN
+ IF (ALLOCATED(NINDEX)) DEALLOCATE(NINDEX)
+ ALLOCATE(NINDEX(U%NDIM_FULL))
+ ENDIF
+ IF (NRANK==NPIO) THEN
+ INB(:) = 0
+ DO JJ=1,U%NDIM_FULL
+ INB(NINDEX(JJ)) = INB(NINDEX(JJ))+1
+ NNUM(JJ) = INB(NINDEX(JJ))
+ ENDDO
+ ENDIF
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(NINDEX,SIZE(NINDEX)*KIND(NINDEX)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(NNUM,SIZE(NNUM)*KIND(NNUM)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(UG%NGRID_FULL_PAR,KIND(UG%NGRID_FULL_PAR)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ IF (NRANK/=NPIO) ALLOCATE(UG%XGRID_FULL_PAR(UG%NGRID_FULL_PAR))
+#ifdef SFX_MPI
+ CALL MPI_BCAST(UG%XGRID_FULL_PAR,&
+ SIZE(UG%XGRID_FULL_PAR)*KIND(UG%XGRID_FULL_PAR)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+#endif
+ ENDIF
+ENDIF
+!
+CATYPE = 'ARI'
!
!* 1. get full dimension of grid
!
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'FULL ',NL)
+ CALL GET_TYPE_DIM_n(DTCO, U, 'FULL ',NL)
!
!* 2. get nature dimension
!
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'NATURE',IL)
+ CALL GET_TYPE_DIM_n(DTCO, U, 'NATURE',IL)
!
ALLOCATE(ZFIELD(IL,3))
!
!* 3. get grid informations known over full grid
!
- CALL GET_LATLONMASK_n(UG, &
- LLATLONMASK,CGRID,XGRID_PAR,NGRID_PAR)
+ CALL GET_LATLONMASK_n(UG, LLATLONMASK,CGRID,XGRID_PAR,NGRID_PAR)
!
!
SELECT CASE(HSURF)
@@ -111,14 +142,11 @@ SELECT CASE(HSURF)
!
CASE('WG ')
- CALL PGD_FIELD(DTCO, UG, U, USS, &
- HPROGRAM,'HUG_SURF: relative humidity','NAT',CFILE_HUG_SURF, &
+ CALL PGD_FIELD(DTCO, UG, U, USS, HPROGRAM,'HUG_SURF: relative humidity','NAT',CFILE_HUG_SURF, &
CTYPE_HUG,XUNDEF,ZFIELD(:,1))
- CALL PGD_FIELD(DTCO, UG, U, USS, &
- HPROGRAM,'HUG_ROOT: relative humidity','NAT',CFILE_HUG_ROOT, &
+ CALL PGD_FIELD(DTCO, UG, U, USS, HPROGRAM,'HUG_ROOT: relative humidity','NAT',CFILE_HUG_ROOT, &
CTYPE_HUG,XUNDEF,ZFIELD(:,2))
- CALL PGD_FIELD(DTCO, UG, U, USS, &
- HPROGRAM,'HUG_DEEP: relative humidity','NAT',CFILE_HUG_DEEP, &
+ CALL PGD_FIELD(DTCO, UG, U, USS, HPROGRAM,'HUG_DEEP: relative humidity','NAT',CFILE_HUG_DEEP, &
CTYPE_HUG,XUNDEF,ZFIELD(:,3))
ALLOCATE(PFIELD(IL,3,NVEGTYPE))
@@ -132,14 +160,11 @@ SELECT CASE(HSURF)
CASE('TG ')
- CALL PGD_FIELD(DTCO, UG, U, USS, &
- HPROGRAM,'TG_SURF: temperature','NAT',CFILE_TG_SURF, &
+ CALL PGD_FIELD(DTCO, UG, U, USS, HPROGRAM,'TG_SURF: temperature','NAT',CFILE_TG_SURF, &
CTYPE_TG,XUNDEF,ZFIELD(:,1))
- CALL PGD_FIELD(DTCO, UG, U, USS, &
- HPROGRAM,'TG_ROOT: temperature','NAT',CFILE_TG_ROOT, &
+ CALL PGD_FIELD(DTCO, UG, U, USS, HPROGRAM,'TG_ROOT: temperature','NAT',CFILE_TG_ROOT, &
CTYPE_TG,XUNDEF,ZFIELD(:,2))
- CALL PGD_FIELD(DTCO, UG, U, USS, &
- HPROGRAM,'TG_DEEP: temperature','NAT',CFILE_TG_DEEP, &
+ CALL PGD_FIELD(DTCO, UG, U, USS, HPROGRAM,'TG_DEEP: temperature','NAT',CFILE_TG_DEEP, &
CTYPE_TG,XUNDEF,ZFIELD(:,3))
ALLOCATE(PFIELD(IL,3,NVEGTYPE))
@@ -157,9 +182,15 @@ END SELECT
!* 6. Interpolation method
! --------------------
!
- CINTERP_TYPE='NONE '
+CINTERP_TYPE='NONE '
DEALLOCATE(ZFIELD)
!
+DEALLOCATE(NNUM)
+IF (NRANK/=NPIO) THEN
+ DEALLOCATE(NINDEX,UG%XGRID_FULL_PAR)
+ ALLOCATE(NINDEX(0))
+ENDIF
+!
IF (LHOOK) CALL DR_HOOK('PREP_ISBA_ASCLLV',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_isba_buffer.F90 b/src/SURFEX/prep_isba_buffer.F90
index 97f5d20a8da000904b783eaf9715505e2aa132d4..7c50e4f2d642ceb049896b86b8bc612e94a41072 100644
--- a/src/SURFEX/prep_isba_buffer.F90
+++ b/src/SURFEX/prep_isba_buffer.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_ISBA_BUFFER (IG, U, &
- HPROGRAM,HSURF,KLUOUT,PFIELD)
+SUBROUTINE PREP_ISBA_BUFFER (G, U, HPROGRAM,HSURF,KLUOUT,PFIELD)
! #################################################################################
!
!!**** *PREP_ISBA_BUFFER* - initializes ISBA fields from operational BUFFER
@@ -31,7 +30,7 @@ SUBROUTINE PREP_ISBA_BUFFER (IG, U, &
!
!
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODE_READ_BUFFER
@@ -62,7 +61,7 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
+TYPE(GRID_t), INTENT(INOUT) :: G
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
@@ -73,7 +72,7 @@ REAL,DIMENSION(:,:,:), POINTER :: PFIELD ! field to interpolate horizontal
!* 0.2 declarations of local variables
!
TYPE (DATE_TIME) :: TZTIME_BUF ! current date and time
- CHARACTER(LEN=6) :: YINMODEL ! model from which buffer originates
+CHARACTER(LEN=6) :: YINMODEL ! model from which buffer originates
REAL, DIMENSION(:,:), POINTER :: ZFIELD ! field read
REAL, DIMENSION(:), POINTER :: ZFIELD1D ! field read
REAL, DIMENSION(:,:), POINTER :: ZD ! depth of field in the soil
@@ -147,8 +146,8 @@ SELECT CASE(HSURF)
ZFIELD_EP_IN(:) = ZFIELD_EP(:)
#ifdef SFX_ARO
- CALL OI_HOR_EXTRAPOL_SURF(U%NSIZE_NATURE,IG%XLAT,IG%XLON,ZFIELD_EP_IN(:), &
- IG%XLAT,IG%XLON,ZFIELD_EP(:),OINTERP,PZS=ZALT,NDIM2=10)
+ CALL OI_HOR_EXTRAPOL_SURF(U%NSIZE_NATURE,G%XLAT,G%XLON,ZFIELD_EP_IN(:), &
+ G%XLAT,G%XLON,ZFIELD_EP(:),OINTERP,PZS=ZALT,NDIM2=10)
#endif
! Unpack to full rank
@@ -204,8 +203,8 @@ SELECT CASE(HSURF)
ZFIELD_EP_IN(:) = ZFIELD_EP
#ifdef SFX_ARO
- CALL OI_HOR_EXTRAPOL_SURF(U%NSIZE_NATURE,IG%XLAT,IG%XLON,ZFIELD_EP_IN(:), &
- IG%XLAT,IG%XLON,ZFIELD_EP(:),OINTERP,NDIM2=10)
+ CALL OI_HOR_EXTRAPOL_SURF(U%NSIZE_NATURE,G%XLAT,G%XLON,ZFIELD_EP_IN(:), &
+ G%XLAT,G%XLON,ZFIELD_EP(:),OINTERP,NDIM2=10)
#endif
! Unpack to full rank
@@ -264,8 +263,8 @@ SELECT CASE(HSURF)
ZFIELD_EP_IN(:) = ZFIELD_EP
#ifdef SFX_ARO
- CALL OI_HOR_EXTRAPOL_SURF(U%NSIZE_NATURE,IG%XLAT,IG%XLON,ZFIELD_EP_IN(:), &
- IG%XLAT,IG%XLON,ZFIELD_EP(:),OINTERP,NDIM2=10)
+ CALL OI_HOR_EXTRAPOL_SURF(U%NSIZE_NATURE,G%XLAT,G%XLON,ZFIELD_EP_IN(:), &
+ G%XLAT,G%XLON,ZFIELD_EP(:),OINTERP,NDIM2=10)
#endif
! Unpack to full rank
@@ -312,14 +311,14 @@ END SELECT
!* 4. Interpolation method
! --------------------
!
- CINTERP_TYPE='BUFFER'
+CINTERP_TYPE='BUFFER'
!
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PREP_ISBA_BUFFER',1,ZHOOK_HANDLE)
- CONTAINS
+CONTAINS
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_isba_canopy.F90 b/src/SURFEX/prep_isba_canopy.F90
deleted file mode 100644
index e11aefb3f47036e09d215972b2cff28c9b93019e..0000000000000000000000000000000000000000
--- a/src/SURFEX/prep_isba_canopy.F90
+++ /dev/null
@@ -1,90 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE PREP_ISBA_CANOPY (ICP, IG)
-! #################################################################################
-!
-!!**** *PREP_ISBA_CANOPY* - prepares ISBA canopy fields
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/2006
-!! S. Riette 06/2009 XT, XU, XQ, XTKE are set to XUNDEF
-!! No more argument needed
-!! E. Martin 01/2012 XUNDEF fields are no more written in PREP file
-!!------------------------------------------------------------------
-!
-!
-!
-USE MODD_ISBA_CANOPY_n, ONLY : ISBA_CANOPY_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!* 0.2 declarations of local variables
-!
-!
-TYPE(ISBA_CANOPY_t), INTENT(INOUT) :: ICP
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-!
-INTEGER :: JLAYER
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZZF ! altitudes at half levels
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------------
-!
-!
-!* 1. number of levels (MUST be at least equal to 2)
-! ----------------
-!
-IF (LHOOK) CALL DR_HOOK('PREP_ISBA_CANOPY',0,ZHOOK_HANDLE)
-ICP%NLVL = 6
-!
-!* 2. height of half levels (where turbulent fluxes will be)
-! ---------------------
-!
-!* Warning : ZZF(:,1) MUST BE ZERO
-ALLOCATE(ZZF(IG%NDIM,ICP%NLVL))
-ZZF(:,1) = 0.
-ZZF(:,2) = 1
-ZZF(:,3) = 3.
-ZZF(:,4) = 5.
-ZZF(:,5) = 8.
-ZZF(:,6) = 12.
-
-ALLOCATE(ICP%XZ(IG%NDIM,ICP%NLVL))
-DO JLAYER=1,ICP%NLVL-1
- ICP%XZ(:,JLAYER) = 0.5 * (ZZF(:,JLAYER)+ZZF(:,JLAYER+1))
-END DO
-ICP%XZ(:,ICP%NLVL) = 1.5 * ZZF(:,ICP%NLVL) - 0.5 * ZZF(:,ICP%NLVL-1)
-!
-DEALLOCATE(ZZF)
-!
-IF (LHOOK) CALL DR_HOOK('PREP_ISBA_CANOPY',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE PREP_ISBA_CANOPY
diff --git a/src/SURFEX/prep_isba_cc_extern.F90 b/src/SURFEX/prep_isba_cc_extern.F90
index ce633aa2a6d6ec32f876dfd158ee1bd298451a5d..5747a1be613cb380a019bde2d727c02b4950f9db 100644
--- a/src/SURFEX/prep_isba_cc_extern.F90
+++ b/src/SURFEX/prep_isba_cc_extern.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_ISBA_CC_EXTERN (GCP,&
- HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD,OPREP_AGS)
+SUBROUTINE PREP_ISBA_CC_EXTERN (GCP,HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD,OPREP_AGS)
! #################################################################################
!
!!**** *PREP_ISBA_CC_EXTERN* - initializes ISBA-CC fields from external isba field
@@ -29,21 +28,17 @@ SUBROUTINE PREP_ISBA_CC_EXTERN (GCP,&
!! B. Decharme 04/2014, external init with FA files
!!------------------------------------------------------------------
!
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
-!
-!
-USE MODE_READ_EXTERN
-!
-USE MODD_TYPE_DATE_SURF
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
+USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
+USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE MODI_PREP_GRID_EXTERN
USE MODI_READ_SURF
USE MODI_OPEN_AUX_IO_SURF
USE MODI_CLOSE_AUX_IO_SURF
-!
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
-USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODI_MAKE_CHOICE_ARRAY
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -52,9 +47,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-!
-!
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=8), INTENT(IN) :: HSURF ! type of field
CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file
@@ -67,21 +61,25 @@ LOGICAL, INTENT(INOUT):: OPREP_AGS
!
!* 0.2 declarations of local variables
!
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+REAL, DIMENSION(:), ALLOCATABLE :: ZMASK
+!
+CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
INTEGER :: IRESP ! reading return code
INTEGER :: INI ! total 1D dimension
INTEGER :: IPATCH ! number of patch
- CHARACTER(LEN=3) :: YPHOTO
- CHARACTER(LEN=3) :: YRESPSL
- CHARACTER(LEN=4) :: YLVL
+CHARACTER(LEN=3) :: YPHOTO
+CHARACTER(LEN=3) :: YRESPSL
+CHARACTER(LEN=4) :: YLVL
!
INTEGER :: JNBIOMASS ! loop counter
INTEGER :: JNLITTER ! loop counter
INTEGER :: JNLITTLEVS ! loop counter
INTEGER :: JNSOILCARB ! loop counter
-INTEGER :: IVERSION ! surface version
+INTEGER :: IVERSION, IBUGFIX ! surface version
INTEGER :: IWORK,INBIOMASS,INLITTER, &
- INLITTLEVS,INSOILCARB
+ INLITTLEVS,INSOILCARB, JP, JL
+!
+LOGICAL :: GDIM
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -101,32 +99,46 @@ IF (LHOOK) CALL DR_HOOK('PREP_ISBA_CC_EXTERN',0,ZHOOK_HANDLE)
!* 2. Reading of grid
! ---------------
!
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'FULL ')
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'FULL ')
+!
+ CALL PREP_GRID_EXTERN(GCP,HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
+!
+YRECFM='VERSION'
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,IVERSION,IRESP)
+!
+ALLOCATE(ZMASK(INI))
+IF (IVERSION>=7) THEN
+ YRECFM='FRAC_NATURE'
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZMASK,IRESP,HDIR='A')
+ELSE
+ ZMASK(:) = 1.
+ENDIF
!
- CALL PREP_GRID_EXTERN(GCP,&
- HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
+CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
!
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'FULL ')
YRECFM='VERSION'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,IVERSION,IRESP)
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,IVERSION,IRESP)
+YRECFM='BUG'
+ CALL READ_SURF(HFILETYPE,YRECFM,IBUGFIX,IRESP)
+GDIM = (IVERSION>8 .OR. IVERSION==8 .AND. IBUGFIX>0)
+IF (GDIM) CALL READ_SURF(HFILETYPE,'SPLIT_PATCH',GDIM,IRESP)
!
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
+!
+IF (NRANK/=NPIO) INI = 0
!
!---------------------------------------------------------------------------------------
!
!* 3. Transformation into physical quantity to be interpolated
! --------------------------------------------------------
!
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'NATURE')
+CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
YRECFM='PHOTO'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,YPHOTO,IRESP)
+CALL READ_SURF(HFILEPGDTYPE,YRECFM,YPHOTO,IRESP,HDIR='-')
YRECFM='PATCH_NUMBER'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,IPATCH,IRESP)
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP,HDIR='-')
+CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
!
IF(IVERSION<8.OR.(YPHOTO/='NIT'.AND.YPHOTO/='NCB'))THEN
OPREP_AGS = .FALSE.
@@ -137,41 +149,38 @@ ENDIF
SELECT CASE(HSURF)
!
CASE('BIOMASS')
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'NATURE')
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
YRECFM='NBIOMASS'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,INBIOMASS,IRESP)
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,INBIOMASS,IRESP,HDIR='-')
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
IF (YPHOTO=='NIT' .OR. YPHOTO=='NCB') THEN
ALLOCATE(PFIELD(INI,INBIOMASS,IPATCH))
PFIELD(:,:,:) = XUNDEF
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'NATURE')
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
DO JNBIOMASS=1,INBIOMASS
WRITE(YLVL,'(I1)') JNBIOMASS
YRECFM='BIOMA'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(&
- HFILETYPE,YRECFM,PFIELD(:,JNBIOMASS,:),IRESP,HDIR='A')
+ CALL MAKE_CHOICE_ARRAY(HFILETYPE, IPATCH, GDIM, YRECFM, PFIELD(:,JNBIOMASS,:),HDIR='E')
ENDDO
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
+ DO JP=1,SIZE(PFIELD,3)
+ DO JL=1,SIZE(PFIELD,2)
+ WHERE (ZMASK(:)==0.) PFIELD(:,JL,JP) = XUNDEF
+ ENDDO
+ ENDDO
ELSE
OPREP_AGS = .FALSE.
ENDIF
!
CASE('LITTER')
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'NATURE')
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
YRECFM='RESPSL'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,YRESPSL,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,YRESPSL,IRESP,HDIR='-')
IF(YRESPSL=='CNT')THEN
YRECFM='NLITTER'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,INLITTER,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,INLITTER,IRESP,HDIR='-')
YRECFM='NLITTLEVS'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,INLITTLEVS,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,INLITTLEVS,IRESP,HDIR='-')
ALLOCATE(PFIELD(INI,INLITTER*INLITTLEVS,IPATCH))
PFIELD(:,:,:) = XUNDEF
IWORK=0
@@ -180,32 +189,37 @@ SELECT CASE(HSURF)
IWORK=IWORK+1
WRITE(YLVL,'(I1,A1,I1)') JNLITTER,'_',JNLITTLEVS
YRECFM='LITTER'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(&
- HFILETYPE,YRECFM,PFIELD(:,IWORK,:),IRESP,HDIR='A')
+ CALL MAKE_CHOICE_ARRAY(HFILETYPE, IPATCH, GDIM, YRECFM, PFIELD(:,IWORK,:),HDIR='E')
ENDDO
ENDDO
+ DO JP=1,SIZE(PFIELD,3)
+ DO JL=1,SIZE(PFIELD,2)
+ WHERE (ZMASK(:)==0.) PFIELD(:,JL,JP) = XUNDEF
+ ENDDO
+ ENDDO
ELSE
OPREP_AGS = .FALSE.
ENDIF
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
!
CASE('SOILCARB')
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'NATURE')
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
YRECFM='RESPSL'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,YRESPSL,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,YRESPSL,IRESP,HDIR='-')
IF(YRESPSL=='CNT')THEN
YRECFM='NSOILCARB'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,INSOILCARB,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,INSOILCARB,IRESP,HDIR='-')
ALLOCATE(PFIELD(INI,INSOILCARB,IPATCH))
PFIELD(:,:,:) = XUNDEF
DO JNSOILCARB=1,INSOILCARB
WRITE(YLVL,'(I4)') JNSOILCARB
YRECFM='SOILCARB'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(&
- HFILETYPE,YRECFM,PFIELD(:,JNSOILCARB,:),IRESP,HDIR='A')
+ CALL MAKE_CHOICE_ARRAY(HFILETYPE, IPATCH, GDIM, YRECFM, PFIELD(:,JNSOILCARB,:),HDIR='E')
+ ENDDO
+ DO JP=1,SIZE(PFIELD,3)
+ DO JL=1,SIZE(PFIELD,2)
+ WHERE (ZMASK(:)==0.) PFIELD(:,JL,JP) = XUNDEF
+ ENDDO
ENDDO
ELSE
OPREP_AGS = .FALSE.
@@ -213,22 +227,23 @@ SELECT CASE(HSURF)
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
!
CASE('LIGNIN')
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'NATURE')
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
YRECFM='RESPSL'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,YRESPSL,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,YRESPSL,IRESP,HDIR='-')
IF(YRESPSL=='CNT')THEN
YRECFM='NLITTLEVS'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,INLITTLEVS,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,INLITTLEVS,IRESP,HDIR='-')
ALLOCATE(PFIELD(INI,INLITTLEVS,IPATCH))
PFIELD(:,:,:) = XUNDEF
DO JNLITTLEVS=1,INLITTLEVS
WRITE(YLVL,'(I4)') JNLITTLEVS
YRECFM='LIGNIN_STR'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(&
- HFILETYPE,YRECFM,PFIELD(:,JNLITTLEVS,:),IRESP,HDIR='A')
+ CALL MAKE_CHOICE_ARRAY(HFILETYPE, IPATCH, GDIM, YRECFM, PFIELD(:,JNLITTLEVS,:),HDIR='E')
+ ENDDO
+ DO JP=1,SIZE(PFIELD,3)
+ DO JL=1,SIZE(PFIELD,2)
+ WHERE (ZMASK(:)==0.) PFIELD(:,JL,JP) = XUNDEF
+ ENDDO
ENDDO
ELSE
OPREP_AGS = .FALSE.
@@ -237,6 +252,7 @@ SELECT CASE(HSURF)
!
END SELECT
!
+DEALLOCATE(ZMASK)
!
!---------------------------------------------------------------------------
!
diff --git a/src/SURFEX/prep_isba_extern.F90 b/src/SURFEX/prep_isba_extern.F90
index b2653569d89e18347e2e907cb3fd06cebeeaa8ca..9b3ea5e9502b3468a1b4aac47a49da33984da278 100644
--- a/src/SURFEX/prep_isba_extern.F90
+++ b/src/SURFEX/prep_isba_extern.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_ISBA_EXTERN (DTCO, I, U,GCP, &
+SUBROUTINE PREP_ISBA_EXTERN (DTCO, IO, U, GCP, &
HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD,OKEY)
! #################################################################################
!
@@ -27,33 +27,26 @@ SUBROUTINE PREP_ISBA_EXTERN (DTCO, I, U,GCP, &
!! -------------
!! Original 01/2004
!! B. Decharme 04/2014, external init with FA files
-!! M.Moge 01/2016 using READ_SURF_FIELD2D for 2D surfex fields reads
-!!!------------------------------------------------------------------
-!
-!
-!
-!
-!
+!!------------------------------------------------------------------
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
+USE MODD_SURFEX_MPI, ONLY : NRANK,NPIO
USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
USE MODD_PREP_ISBA, ONLY : XGRID_SOIL, XWR_DEF
USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE MODE_READ_EXTERN
!
-USE MODD_TYPE_DATE_SURF
-!
+USE MODI_MAKE_CHOICE_ARRAY
USE MODI_PREP_GRID_EXTERN
USE MODI_READ_SURF
USE MODI_INTERP_GRID_NAT
USE MODI_OPEN_AUX_IO_SURF
USE MODI_CLOSE_AUX_IO_SURF
-USE MODI_READ_SURF_FIELD2D
!
USE MODI_ABOR1_SFX
!
@@ -66,7 +59,7 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
@@ -82,21 +75,19 @@ LOGICAL, OPTIONAL, INTENT(INOUT):: OKEY
!
!* 0.2 declarations of local variables
!
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
INTEGER :: IRESP ! reading return code
INTEGER :: INI ! total 1D dimension
INTEGER :: IPATCH ! number of patch
LOGICAL :: GGLACIER
- CHARACTER(LEN=3) :: YPHOTO
+CHARACTER(LEN=3) :: YPHOTO
!
-REAL, DIMENSION(:,:,:), POINTER :: ZFIELD ! field read on initial MNH vertical soil grid, all patches
-REAL, DIMENSION(:,:), POINTER :: ZFIELD1 ! field read on initial MNH vertical soil grid, one patch
-REAL, DIMENSION(:,:,:), POINTER :: ZD ! layer thicknesses
-REAL, DIMENSION(:,:), POINTER :: ZD1 ! layer thicknesses, one patch
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZOUT !
+REAL, DIMENSION(:,:,:), POINTER :: ZFIELD=>NULL() ! field read on initial MNH vertical soil grid, all patches
+REAL, DIMENSION(:,:,:), POINTER :: ZD=>NULL() ! layer thicknesses
REAL, DIMENSION(:), ALLOCATABLE :: ZMASK
-INTEGER :: JPATCH, JL ! loop counter for patch
-INTEGER :: IVERSION
+INTEGER :: JP, JL ! loop counter for patch
+INTEGER :: IVERSION, IBUGFIX
+LOGICAL :: GDIM
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!------------------------------------------------------------------------------
@@ -115,15 +106,16 @@ IF (LHOOK) CALL DR_HOOK('PREP_ISBA_EXTERN',0,ZHOOK_HANDLE)
!* 2. Reading of grid
! ---------------
!
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'FULL ')
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'FULL ')
+!
+ CALL PREP_GRID_EXTERN(GCP,HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
!
- CALL PREP_GRID_EXTERN(GCP,&
- HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
!
YRECFM='VERSION'
CALL READ_SURF(HFILEPGDTYPE,YRECFM,IVERSION,IRESP)
!
+IF (NRANK/=NPIO) INI = 0
+!
ALLOCATE(ZMASK(INI))
IF (IVERSION>=7) THEN
YRECFM='FRAC_NATURE'
@@ -131,6 +123,19 @@ IF (IVERSION>=7) THEN
ELSE
ZMASK(:) = 1.
ENDIF
+!
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+!
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'FULL ')
+YRECFM='VERSION'
+ CALL READ_SURF(HFILETYPE,YRECFM,IVERSION,IRESP)
+YRECFM='BUG'
+ CALL READ_SURF(HFILETYPE,YRECFM,IBUGFIX,IRESP)
+GDIM = (IVERSION>8 .OR. IVERSION==8 .AND. IBUGFIX>0)
+IF (GDIM) CALL READ_SURF(HFILETYPE,'SPLIT_PATCH',GDIM,IRESP)
+ CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
+!
+IF (NRANK/=NPIO) INI = 0
!
!---------------------------------------------------------------------------------------
!
@@ -146,8 +151,8 @@ SELECT CASE(HSURF)
ALLOCATE(PFIELD(INI,1,1))
PFIELD(:,:,:) = XUNDEF
YRECFM='ZS'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,PFIELD(:,1,1),IRESP,HDIR='A')
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'FULL ')
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1,1),IRESP,HDIR='E')
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
!
!--------------------------------------------------------------------------
@@ -156,112 +161,85 @@ SELECT CASE(HSURF)
!* 3.1 Profile of temperature, water or ice in the soil
!
CASE('TG ','WG ','WGI ')
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
!* reading of the profile and its depth definition
- CALL READ_EXTERN_ISBA(U, &
- DTCO, I,GCP, &
- HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,&
+ CALL READ_EXTERN_ISBA(U, DTCO, GCP, IO, HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,&
KLUOUT,INI,HSURF,HSURF,ZFIELD,ZD,OKEY)
!
- ALLOCATE(ZFIELD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
- ALLOCATE(ZD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
- ALLOCATE(ZOUT(SIZE(ZFIELD,1),SIZE(XGRID_SOIL)))
- ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_SOIL),SIZE(ZFIELD,3)))
- PFIELD(:,:,:) = XUNDEF
-!
- DO JPATCH=1,SIZE(ZFIELD,3)
- ZFIELD1(:,:)=ZFIELD(:,:,JPATCH)
- ZD1 (:,:)=ZD (:,:,JPATCH)
- CALL INTERP_GRID_NAT(ZD1,ZFIELD1,XGRID_SOIL,ZOUT)
- PFIELD(:,:,JPATCH)=ZOUT(:,:)
- END DO
- !
- DO JPATCH=1,SIZE(PFIELD,3)
- DO JL=1,SIZE(PFIELD,2)
- WHERE (ZMASK(:)==0.) PFIELD(:,JL,JPATCH) = XUNDEF
- ENDDO
- ENDDO
- !
- DEALLOCATE(ZFIELD)
- DEALLOCATE(ZOUT)
- DEALLOCATE(ZFIELD1)
- DEALLOCATE(ZD)
+ IF (INI>0) THEN
+ ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_SOIL),SIZE(ZFIELD,3)))
+ DO JP=1,SIZE(ZFIELD,3)
+ CALL INTERP_GRID_NAT(ZD(:,:,JP),ZFIELD(:,:,JP),XGRID_SOIL,PFIELD(:,:,JP))
+ END DO
+ !
+ DO JP=1,SIZE(PFIELD,3)
+ DO JL=1,SIZE(PFIELD,2)
+ WHERE (ZMASK(:)==0.) PFIELD(:,JL,JP) = XUNDEF
+ ENDDO
+ ENDDO
+ !
+ ENDIF
+ !
+ DEALLOCATE(ZFIELD)
+ DEALLOCATE(ZD)
!
!--------------------------------------------------------------------------
!
!* 3.4 Water content intercepted on leaves, LAI
!
- CASE('WR ')
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ CASE('WR ')
!* number of tiles
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'NATURE')
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
YRECFM='PATCH_NUMBER'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,IPATCH,IRESP)
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP,HDIR='-')
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
ALLOCATE(PFIELD(INI,1,IPATCH))
PFIELD(:,:,:) = XUNDEF
YRECFM = 'WR'
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'NATURE')
- CALL READ_SURF_FIELD2D(&
- HFILETYPE,PFIELD(:,1,:),YRECFM,HDIR='A')
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
+ CALL MAKE_CHOICE_ARRAY(HFILETYPE, IPATCH, GDIM, YRECFM, PFIELD(:,1,:),HDIR='E')
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
- DO JPATCH=1,SIZE(PFIELD,3)
- WHERE (ZMASK(:)==0.) PFIELD(:,1,JPATCH) = XUNDEF
+ DO JP=1,SIZE(PFIELD,3)
+ WHERE (ZMASK(:)==0.) PFIELD(:,1,JP) = XUNDEF
ENDDO
!
CASE('LAI ')
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
!* number of tiles
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'NATURE')
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
YRECFM='PATCH_NUMBER'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,IPATCH,IRESP)
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP,HDIR='-')
YRECFM='PHOTO'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,YPHOTO,IRESP)
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,YPHOTO,IRESP,HDIR='-')
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
ALLOCATE(PFIELD(INI,1,IPATCH))
PFIELD(:,:,:) = XUNDEF
- IF (YPHOTO=='LAI' .OR. YPHOTO=='LST' .OR. YPHOTO=='NIT' .OR. YPHOTO=='NCB') THEN
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'NATURE')
+ IF (YPHOTO=='NIT' .OR. YPHOTO=='NCB') THEN
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
YRECFM = 'LAI'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,PFIELD(:,1,:),IRESP,HDIR='A')
+ CALL MAKE_CHOICE_ARRAY(HFILETYPE, IPATCH, GDIM, YRECFM, PFIELD(:,1,:),HDIR='E')
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
- DO JPATCH=1,SIZE(PFIELD,3)
- WHERE (ZMASK(:)==0.) PFIELD(:,1,JPATCH) = XUNDEF
+ DO JP=1,SIZE(PFIELD,3)
+ WHERE (ZMASK(:)==0.) PFIELD(:,1,JP) = XUNDEF
ENDDO
ENDIF
!
- CASE('ICE_STO')
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ CASE('ICE_STO')
!* number of tiles
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'NATURE')
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
YRECFM='PATCH_NUMBER'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,IPATCH,IRESP)
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP,HDIR='-')
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'NATURE')
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
YRECFM='GLACIER'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,GGLACIER,IRESP)
+ CALL READ_SURF(HFILETYPE,YRECFM,GGLACIER,IRESP,HDIR='-')
ALLOCATE(PFIELD(INI,1,IPATCH))
PFIELD(:,:,:) = 0.0
IF(GGLACIER)THEN
YRECFM = 'ICE_STO'
- CALL READ_SURF(&
- HFILETYPE,YRECFM,PFIELD(:,1,:),IRESP,HDIR='A')
+ CALL MAKE_CHOICE_ARRAY(HFILETYPE, IPATCH, GDIM, YRECFM, PFIELD(:,1,:),HDIR='E')
ENDIF
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
- DO JPATCH=1,SIZE(PFIELD,3)
- WHERE (ZMASK(:)==0.) PFIELD(:,1,JPATCH) = XUNDEF
+ DO JP=1,SIZE(PFIELD,3)
+ WHERE (ZMASK(:)==0.) PFIELD(:,1,JP) = XUNDEF
ENDDO
!
CASE DEFAULT
diff --git a/src/SURFEX/prep_isba_grib.F90 b/src/SURFEX/prep_isba_grib.F90
index 40270494ce6573a78794f4485a0f747b96680511..5b2430a6e402b66d451c4e951fff63574274672d 100644
--- a/src/SURFEX/prep_isba_grib.F90
+++ b/src/SURFEX/prep_isba_grib.F90
@@ -32,14 +32,12 @@ USE MODE_READ_GRIB
!
USE MODD_TYPE_DATE_SURF
!
-USE MODI_PREP_GRIB_GRID
USE MODI_INTERP_GRID_NAT
!
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
USE MODD_PREP_ISBA, ONLY : XGRID_SOIL, XWR_DEF, XWRV_DEF, &
XWRVN_DEF, XQC_DEF
USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_GRID_GRIB, ONLY : CGRIB_FILE, NNI
+USE MODD_GRID_GRIB, ONLY : CGRIB_FILE, NNI, CINMODEL
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -51,17 +49,15 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
- CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
- CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
+CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file
INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
REAL,DIMENSION(:,:,:), POINTER :: PFIELD ! field to interpolate horizontally
LOGICAL, OPTIONAL, INTENT(INOUT) :: OKEY
!
!* 0.2 declarations of local variables
!
-TYPE (DATE_TIME) :: TZTIME_GRIB ! current date and time
- CHARACTER(LEN=6) :: YINMODEL ! model from which GRIB file originates
REAL, DIMENSION(:) , POINTER :: ZMASK => NULL() ! Land mask
REAL, DIMENSION(:,:), POINTER :: ZFIELD => NULL() ! field read
REAL, DIMENSION(:), POINTER :: ZFIELD1D => NULL() ! field read
@@ -78,9 +74,7 @@ IF (LHOOK) CALL DR_HOOK('PREP_ISBA_GRIB',0,ZHOOK_HANDLE)
!
IF (TRIM(HFILE).NE.CGRIB_FILE) CGRIB_FILE=""
!
- CALL PREP_GRIB_GRID(HFILE,KLUOUT,YINMODEL,CINGRID_TYPE,TZTIME_GRIB)
-!
- CALL READ_GRIB_LAND_MASK(HFILE,KLUOUT,YINMODEL,ZMASK)
+ CALL READ_GRIB_LAND_MASK(HFILE,KLUOUT,CINMODEL,ZMASK)
!
!
!* 2. Reading of field
@@ -95,27 +89,27 @@ SELECT CASE(HSURF)
!
CASE('TG ')
!* reading of the profile and its depth definition
- SELECT CASE(YINMODEL)
+ SELECT CASE(CINMODEL)
CASE('ECMWF ')
IF(PRESENT(OKEY))OKEY=.FALSE.
- CALL READ_GRIB_TG_ECMWF(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_TG_ECMWF(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
CASE('ARPEGE','ALADIN','MOCAGE')
- CALL READ_GRIB_TG_METEO_FRANCE(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_TG_METEO_FRANCE(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
CASE('HIRLAM')
- CALL READ_GRIB_TG_HIRLAM(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_TG_HIRLAM(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
END SELECT
CALL SOIL_PROFILE_GRIB
CASE('WG ')
!* reading of the profile and its depth definition
- SELECT CASE(YINMODEL)
+ SELECT CASE(CINMODEL)
CASE('ECMWF ')
IF(PRESENT(OKEY))OKEY=.FALSE.
- CALL READ_GRIB_WG_ECMWF(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_WG_ECMWF(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
CASE('ARPEGE','ALADIN','MOCAGE')
- CALL READ_GRIB_WG_METEO_FRANCE(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_WG_METEO_FRANCE(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
CASE('HIRLAM')
- CALL READ_GRIB_WG_HIRLAM(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_WG_HIRLAM(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
END SELECT
CALL SOIL_PROFILE_GRIB
@@ -123,12 +117,12 @@ SELECT CASE(HSURF)
CASE('WGI ')
!* reading of the profile and its depth definition
- SELECT CASE(YINMODEL)
+ SELECT CASE(CINMODEL)
CASE('ECMWF ')
IF(PRESENT(OKEY))OKEY=.FALSE.
- CALL READ_GRIB_WGI_ECMWF(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_WGI_ECMWF(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
CASE('ARPEGE','ALADIN','MOCAGE')
- CALL READ_GRIB_WGI_METEO_FRANCE(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_WGI_METEO_FRANCE(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
CASE('HIRLAM')
CALL READ_GRIB_WGI_HIRLAM(HFILE,KLUOUT,ZFIELD,ZD)
END SELECT
@@ -148,7 +142,7 @@ SELECT CASE(HSURF)
!* 3.5 Other fields
!
CASE('ZS ')
- CALL READ_GRIB_ZS_LAND(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD1D)
+ CALL READ_GRIB_ZS_LAND(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD1D)
ALLOCATE(PFIELD(SIZE(ZFIELD1D,1),1,1))
PFIELD(:,1,1)=ZFIELD1D(:)
DEALLOCATE(ZFIELD1D)
@@ -173,14 +167,14 @@ SELECT CASE(HSURF)
!
CASE('TV ','TC ')
!* reading of the profile and its depth definition
- SELECT CASE(YINMODEL)
+ SELECT CASE(CINMODEL)
CASE('ECMWF ')
IF(PRESENT(OKEY))OKEY=.FALSE.
- CALL READ_GRIB_TG_ECMWF(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_TG_ECMWF(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
CASE('ARPEGE','ALADIN','MOCAGE')
- CALL READ_GRIB_TG_METEO_FRANCE(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_TG_METEO_FRANCE(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
CASE('HIRLAM')
- CALL READ_GRIB_TG_HIRLAM(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_TG_HIRLAM(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
END SELECT
ALLOCATE(PFIELD(NNI,1,1))
PFIELD(:,1,1) =ZFIELD(:,1)
@@ -196,14 +190,12 @@ DEALLOCATE(ZMASK)
!
!* 4. Interpolation method
! --------------------
-!
- CINTERP_TYPE='HORIBL'
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PREP_ISBA_GRIB',1,ZHOOK_HANDLE)
- CONTAINS
+CONTAINS
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_isba_netcdf.F90 b/src/SURFEX/prep_isba_netcdf.F90
index 496cd717b4d8d4a7933e04ae6fe06951b17d870c..c61ec8c397670cd77ad5579eb3b1ceeda601f857 100644
--- a/src/SURFEX/prep_isba_netcdf.F90
+++ b/src/SURFEX/prep_isba_netcdf.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_ISBA_NETCDF (DTCO, U, &
- HPROGRAM,HSURF,HFILE,KLUOUT,PFIELD)
+SUBROUTINE PREP_ISBA_NETCDF (DTCO, U, HPROGRAM,HSURF,HFILE,KLUOUT,PFIELD)
! #################################################################################
!
!!**** *PREP_ISBA_NETCDF* - prepares ISBA fields from initialization files in NETCDF
@@ -34,19 +33,24 @@ SUBROUTINE PREP_ISBA_NETCDF (DTCO, U, &
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
USE MODD_PREP, ONLY : CINTERP_TYPE
!
USE MODI_ABOR1_SFX
USE MODI_GET_TYPE_DIM_n
+USE MODI_READ_AND_SEND_MPI
+USE MODI_GATHER_AND_WRITE_MPI
!
USE MODE_READ_CDF
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
+USE NETCDF
+!
IMPLICIT NONE
-INCLUDE 'netcdf.inc'
!
!* 0.1 declarations of arguments
!
@@ -62,13 +66,13 @@ REAL,DIMENSION(:,:,:), POINTER :: PFIELD ! field to interpolate horizontal
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(:), POINTER :: ZFIELD ! field read
-
-REAL,DIMENSION(:,:),ALLOCATABLE:: ZFIELD_2D
+REAL, DIMENSION(:), ALLOCATABLE :: ZNATURE
+REAL, DIMENSION(:), ALLOCATABLE :: ZFIELD, ZFIELD0 ! field read
! CHARACTER(LEN=28) :: YNCVAR
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
+INTEGER :: JI, ICPT
INTEGER::IERROR !error status
INTEGER::JJ,JK,JLOOP ! loop counters
INTEGER::INLAYERS ! vertical dimension length
@@ -93,70 +97,97 @@ IF (LHOOK) CALL DR_HOOK('PREP_ISBA_NETCDF',0,ZHOOK_HANDLE)
!* 1. get nature dimension
!
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'NATURE',IL)
+ CALL GET_TYPE_DIM_n(DTCO, U, 'NATURE',IL)
!
!* 2. Reading of field
! ----------------
+!
+IF (NRANK==NPIO) THEN
+ ! Open netcdf file
+ IERROR=NF90_OPEN(HFILE,NF90_NOWRITE,ID_FILE)
+ CALL HANDLE_ERR_CDF(IERROR,"can't open file "//TRIM(HFILE))
+
+ ! Look for variable ID
+ IERROR=NF90_INQ_VARID(ID_FILE,TRIM(HSURF),ID_VAR)
+ CALL HANDLE_ERR_CDF(IERROR,"can't find variable "//TRIM(HSURF))
-! Open netcdf file
-IERROR=NF_OPEN(HFILE,NF_NOWRITE,ID_FILE)
- CALL HANDLE_ERR_CDF(IERROR,"can't open file "//TRIM(HFILE))
-
-! Look for variable ID
-IERROR=NF_INQ_VARID(ID_FILE,TRIM(HSURF),ID_VAR)
- CALL HANDLE_ERR_CDF(IERROR,"can't find variable "//TRIM(HSURF))
-
-! Number of dimensions
-IERROR=NF_INQ_VARNDIMS(ID_FILE,ID_VAR,INVARDIMS)
-if (IERROR/=NF_NOERR) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions number")
-
-! Id of dimensions
-ALLOCATE(IVARDIMSID(INVARDIMS))
-IERROR=NF_INQ_VARDIMID(ID_FILE,ID_VAR,IVARDIMSID)
-if (IERROR/=NF_NOERR) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions ids")
-
-ALLOCATE(ZFIELD(IL))
-
-SELECT CASE (INVARDIMS)
- CASE (1)
- ! Check dimension length
- IERROR=NF_INQ_DIMLEN(ID_FILE,IVARDIMSID(1),ILENDIM)
- if (IERROR/=NF_NOERR) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions lengths")
- CASE (2)
- IERROR=NF_INQ_DIMLEN(ID_FILE,IVARDIMSID(1),ILENDIM1)
- if (IERROR/=NF_NOERR) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions lengths")
- IERROR=NF_INQ_DIMLEN(ID_FILE,IVARDIMSID(2),ILENDIM2)
- if (IERROR/=NF_NOERR) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions lengths")
-
- ILENDIM=ILENDIM1*ILENDIM2
+ ! Number of dimensions
+ IERROR=NF90_INQUIRE_VARIABLE(ID_FILE,ID_VAR,NDIMS=INVARDIMS)
+ if (IERROR/=NF90_NOERR) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions number")
+ ! Id of dimensions
+ ALLOCATE(IVARDIMSID(INVARDIMS))
+ IERROR=NF90_INQUIRE_VARIABLE(ID_FILE,ID_VAR,DIMIDS=IVARDIMSID)
+ if (IERROR/=NF90_NOERR) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions ids")
- CASE DEFAULT
- CALL ABOR1_SFX('PREP_ISBA_NETCDF: incorrect number of dimensions for variable '//TRIM(HSURF))
+ ALLOCATE(ZFIELD(U%NDIM_NATURE))
-END SELECT
-!
-IF(ILENDIM/=IL) CALL ABOR1_SFX('PREP_ISBA_NETCDF: incorrect number of points '// &
- 'in netcdf file for variable '//TRIM(HSURF))
-!
-! Read 1D variable
-IERROR=NF_GET_VAR_DOUBLE(ID_FILE,ID_VAR,ZFIELD)
- CALL HANDLE_ERR_CDF(IERROR,"can't read variable "//TRIM(HSURF))
-!
-! Close netcdf file
-IERROR=NF_CLOSE(ID_FILE)
-!
+ SELECT CASE (INVARDIMS)
+ CASE (1)
+ ! Check dimension length
+ IERROR=NF90_INQUIRE_DIMENSION(ID_FILE,IVARDIMSID(1),LEN=ILENDIM)
+ if (IERROR/=NF90_NOERR) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions lengths")
+ CASE (2)
+ IERROR=NF90_INQUIRE_DIMENSION(ID_FILE,IVARDIMSID(1),LEN=ILENDIM1)
+ if (IERROR/=NF90_NOERR) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions lengths")
+ IERROR=NF90_INQUIRE_DIMENSION(ID_FILE,IVARDIMSID(2),LEN=ILENDIM2)
+ if (IERROR/=NF90_NOERR) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions lengths")
+
+ ILENDIM=ILENDIM1*ILENDIM2
+
+ CASE DEFAULT
+ CALL ABOR1_SFX('PREP_ISBA_NETCDF: incorrect number of dimensions for variable '//TRIM(HSURF))
+
+ END SELECT
+ !
+ IF(ILENDIM/=U%NDIM_NATURE) CALL ABOR1_SFX('PREP_ISBA_NETCDF: incorrect number of points '// &
+ 'in netcdf file for variable '//TRIM(HSURF))
+ !
+ ! Read 1D variable
+ IERROR=NF90_GET_VAR(ID_FILE,ID_VAR,ZFIELD)
+ CALL HANDLE_ERR_CDF(IERROR,"can't read variable "//TRIM(HSURF))
+ !
+ ! Close netcdf file
+ IERROR=NF90_CLOSE(ID_FILE)
+ !
+ELSE
+ ALLOCATE(ZFIELD(0))
+ENDIF
+!
+IF (NRANK==NPIO) THEN
+ ALLOCATE(ZNATURE(U%NDIM_FULL))
+ELSE
+ ALLOCATE(ZNATURE(0))
+ENDIF
+CALL GATHER_AND_WRITE_MPI(U%XNATURE,ZNATURE)
+!
+IF (NRANK==NPIO) THEN
+ ALLOCATE(ZFIELD0(U%NDIM_FULL))
+ ZFIELD0(:) = XUNDEF
+ ICPT = 0
+ DO JI=1,U%NDIM_FULL
+ IF (ZNATURE(JI)/=0.) THEN
+ ICPT = ICPT + 1
+ ZFIELD0(JI) = ZFIELD(ICPT)
+ ENDIF
+ ENDDO
+ELSE
+ ALLOCATE(ZFIELD0(0))
+ENDIF
+!
+DEALLOCATE(ZNATURE,ZFIELD)
ALLOCATE(PFIELD(IL,INLAYERS,1)) !will be deallocated later by prep_hor_isba_field
!
+CALL READ_AND_SEND_MPI(ZFIELD0,PFIELD(:,1,1),U%NR_NATURE)
+!
! For now initial values are identical for all tiles / soil layers.
-DO JJ=1,INLAYERS
- PFIELD(:,JJ,1)=ZFIELD
+DO JJ=2,INLAYERS
+ PFIELD(:,JJ,1)=PFIELD(:,1,1)
END DO
!
-DEALLOCATE(ZFIELD)
+DEALLOCATE(ZFIELD0)
!
!Interpolation method
- CINTERP_TYPE='NONE'
+CINTERP_TYPE='NONE'
!
IF (LHOOK) CALL DR_HOOK('PREP_ISBA_NETCDF',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_isba_unif.F90 b/src/SURFEX/prep_isba_unif.F90
index 965c3b722f2a684f3bad916c0be0f2e4ae4d4587..45f6c35458e5ac2a3b7fb15ae577d0bb8f1d7053 100644
--- a/src/SURFEX/prep_isba_unif.F90
+++ b/src/SURFEX/prep_isba_unif.F90
@@ -141,7 +141,7 @@ END SELECT
!* 4. Interpolation method
! --------------------
!
- CINTERP_TYPE='UNIF '
+CINTERP_TYPE='UNIF '
!
IF (LHOOK) CALL DR_HOOK('PREP_ISBA_UNIF',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/prep_nature.F90 b/src/SURFEX/prep_nature.F90
index 5d9e318205564e3247fc04aaee1c5b3bbe27521d..b4a6d3c78f70247c41ede943aa902a844f487664 100644
--- a/src/SURFEX/prep_nature.F90
+++ b/src/SURFEX/prep_nature.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_NATURE (DTCO, ICP, IG, I, UG, U, USS,GCP, &
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+SUBROUTINE PREP_NATURE (DTCO, IM, UG, U, USS, GCP, &
+ HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
! #################################################################################
!
!!**** *PREP_NATURE* - chooses type of scheme to prepare for nature
@@ -26,26 +26,19 @@ SUBROUTINE PREP_NATURE (DTCO, ICP, IG, I, UG, U, USS,GCP, &
!! MODIFICATIONS
!! -------------
!! Original 01/2004
+!! P. Marguinaud10/2014, Support for a 2-part PREP
!!------------------------------------------------------------------
!
-!
-!
-!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_ISBA_CANOPY_n, ONLY : ISBA_CANOPY_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
-!
-USE MODI_PREP_ISBA
-!
-!USE MODI_PREP_ISBA
+USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
+USE MODE_PREP_CTL, ONLY : PREP_CTL
!
+USE MODI_PREP_ISBA
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -56,13 +49,12 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(ISBA_CANOPY_t), INTENT(INOUT) :: ICP
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+TYPE (PREP_CTL), INTENT(INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! name of the Atmospheric file
@@ -78,8 +70,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PREP_NATURE',0,ZHOOK_HANDLE)
IF (U%CNATURE=='ISBA ' .OR. U%CNATURE=='TSZ0 ' ) THEN
- CALL PREP_ISBA(DTCO, ICP, IG, I, UG, U, USS,GCP, &
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+ CALL PREP_ISBA(DTCO, UG, U, USS, GCP, IM%SB, IM%G, IM%O, IM%S, IM%NK, IM%NP, IM%NPE, &
+ HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
END IF
IF (LHOOK) CALL DR_HOOK('PREP_NATURE',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/prep_ocean_ascllv.F90 b/src/SURFEX/prep_ocean_ascllv.F90
index 79a0d90c43b3c877dd4700e38e8a2eb097cdae0b..0ef584a77dae14be5d530d240fb93f0b673dec01 100644
--- a/src/SURFEX/prep_ocean_ascllv.F90
+++ b/src/SURFEX/prep_ocean_ascllv.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #################################################################################
-SUBROUTINE PREP_OCEAN_ASCLLV (DTCO, UG, U, &
- HPROGRAM,HSURF,HFILE, &
- & KLUOUT,PFIELD)
+SUBROUTINE PREP_OCEAN_ASCLLV (DTCO, UG, U, HPROGRAM,HSURF,HFILE, KLUOUT,PFIELD)
! #################################################################################
!
!!**** *PREP_OCEAN_ASCLLDV* - prepares oceanic fields from personal data in ascii
@@ -40,6 +38,7 @@ SUBROUTINE PREP_OCEAN_ASCLLV (DTCO, UG, U, &
!! J.Escobar 11/2013 Add USE MODI_ABOR1_SFX and USE MODI_GET_SURF_MASK_N
!!------------------------------------------------------------------
!
+USE MODD_SURFEX_MPI, ONLY : NPROC, NINDEX, NNUM, NCOMM, NPIO, NRANK
!
!
!
@@ -47,10 +46,10 @@ USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
-USE MODD_PREP, ONLY : CINTERP_TYPE, CINGRID_TYPE
+USE MODD_PREP, ONLY : CINTERP_TYPE
USE MODD_PGD_GRID, ONLY : NL,LLATLONMASK,CGRID,XGRID_PAR,NGRID_PAR
USE MODD_OCEAN_GRID , ONLY : NOCKMAX
-USE MODD_PGDWORK, ONLY : XSUMVAL, NSIZE
+USE MODD_PGDWORK, ONLY : CATYPE
!
USE MODI_OPEN_FILE
USE MODI_CLOSE_FILE
@@ -66,6 +65,10 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1 declarations of arguments
!
!
@@ -88,10 +91,13 @@ REAL,DIMENSION(:), ALLOCATABLE :: ZDEPTH
REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZFIELD
REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZFIELDR
!
+INTEGER, DIMENSION(0:NPROC-1) :: INB
+!
INTEGER :: IL
INTEGER :: IGLB ! logical unit
INTEGER :: IDIM, ILU
INTEGER :: JI,JK
+INTEGER :: INFOMPI, JJ
!
INTEGER, DIMENSION(:), POINTER :: IMASK ! mask for packing from complete field to nature field
CHARACTER(LEN=6) :: YMASK
@@ -100,20 +106,44 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('PREP_OCEAN_ASCLLV',0,ZHOOK_HANDLE)
!
- CINGRID_TYPE='CONF PROJ '
-
+IF (.NOT.ALLOCATED(NNUM)) THEN
+ ALLOCATE(NNUM(U%NDIM_FULL))
+ IF (NRANK/=NPIO) THEN
+ IF (ALLOCATED(NINDEX)) DEALLOCATE(NINDEX)
+ ALLOCATE(NINDEX(U%NDIM_FULL))
+ ENDIF
+ IF (NRANK==NPIO) THEN
+ INB(:) = 0
+ DO JJ=1,U%NDIM_FULL
+ INB(NINDEX(JJ)) = INB(NINDEX(JJ))+1
+ NNUM(JJ) = INB(NINDEX(JJ))
+ ENDDO
+ ENDIF
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(NINDEX,SIZE(NINDEX)*KIND(NINDEX)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(NNUM,SIZE(NNUM)*KIND(NNUM)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(UG%NGRID_FULL_PAR,KIND(UG%NGRID_FULL_PAR)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ IF (NRANK/=NPIO) ALLOCATE(UG%XGRID_FULL_PAR(UG%NGRID_FULL_PAR))
+#ifdef SFX_MPI
+ CALL MPI_BCAST(UG%XGRID_FULL_PAR,&
+ SIZE(UG%XGRID_FULL_PAR)*KIND(UG%XGRID_FULL_PAR)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+#endif
+ ENDIF
+ENDIF
+!
+CATYPE = 'ARI'
+!
!* 1. get full dimension of grid
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'FULL ',NL)
+ CALL GET_TYPE_DIM_n(DTCO, U, 'FULL ',NL)
!* 2. get Ocean dimension
!
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'SEA ',IL)
+ CALL GET_TYPE_DIM_n(DTCO, U, 'SEA ',IL)
!* 3. get grid informations known over full grid
!
- CALL GET_LATLONMASK_n(UG, &
- LLATLONMASK,CGRID,XGRID_PAR,NGRID_PAR)
+ CALL GET_LATLONMASK_n(UG, LLATLONMASK,CGRID,XGRID_PAR,NGRID_PAR)
!
!!
@@ -154,7 +184,7 @@ END DO
! 3. Close the file
99 CONTINUE
- CALL CLOSE_FILE (HPROGRAM,IGLB)
+CALL CLOSE_FILE (HPROGRAM,IGLB)
WRITE(KLUOUT,*) MINVAL(ZFIELDR), MAXVAL(ZFIELDR)
@@ -176,13 +206,12 @@ END SELECT
!* 3. Interpolation method
! --------------------
!
- CINTERP_TYPE='NONE '
+CINTERP_TYPE='NONE '
!CINTERP_TYPE='HORIBL'
!
YMASK = 'SEA '
- CALL GET_TYPE_DIM_n(DTCO, U, &
- YMASK,IDIM)
+ CALL GET_TYPE_DIM_n(DTCO, U, YMASK,IDIM)
WRITE(KLUOUT,*) "IDIM (dim sea) =", IDIM
ALLOCATE(PFIELD(1:IDIM,1:SIZE(ZFIELD,2),1:SIZE(ZFIELD,3)))
@@ -194,8 +223,7 @@ ENDIF
ALLOCATE(IMASK(IDIM))
ILU=0
- CALL GET_SURF_MASK_n(DTCO, U, &
- YMASK,IDIM,IMASK,ILU,KLUOUT)
+ CALL GET_SURF_MASK_n(DTCO, U, YMASK,IDIM,IMASK,ILU,KLUOUT)
DO JK=1,NOCKMAX
CALL PACK_SAME_RANK(IMASK,ZFIELD(:,JK,1),PFIELD(:,JK,1))
END DO
@@ -210,6 +238,12 @@ IF (ALLOCATED(ZDEPTH )) DEALLOCATE(ZDEPTH )
IF (ALLOCATED(ZFIELD )) DEALLOCATE(ZFIELD )
IF (ALLOCATED(ZFIELDR )) DEALLOCATE(ZFIELDR )
!
+DEALLOCATE(NNUM)
+IF (NRANK/=NPIO) THEN
+ DEALLOCATE(NINDEX,UG%XGRID_FULL_PAR)
+ ALLOCATE(NINDEX(0))
+ENDIF
+!
IF (LHOOK) CALL DR_HOOK('PREP_OCEAN_ASCLLV',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_ocean_mercatorvergrid.F90 b/src/SURFEX/prep_ocean_mercatorvergrid.F90
index 16be5d9fda6f06ed77cc6d87c340d08cfa20d68c..5165e21b95b1d1ab2534dff29e75f7c2b68028f1 100644
--- a/src/SURFEX/prep_ocean_mercatorvergrid.F90
+++ b/src/SURFEX/prep_ocean_mercatorvergrid.F90
@@ -59,7 +59,7 @@ USE PARKIND1 ,ONLY : JPRB
IMPLICIT NONE
!
!* 0.1 declarations of arguments
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
LOGICAL, INTENT(IN) :: OUNIF
!
!* 0.2 declarations of local variables
diff --git a/src/SURFEX/prep_ocean_netcdf.F90 b/src/SURFEX/prep_ocean_netcdf.F90
index f4f28aa186f65d13b3c3e78efca0ce909f2e304d..bff8843c14b595d3b0e2f8607ea67f6672ec3302 100644
--- a/src/SURFEX/prep_ocean_netcdf.F90
+++ b/src/SURFEX/prep_ocean_netcdf.F90
@@ -61,7 +61,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* 1. Grid type
! ---------
IF (LHOOK) CALL DR_HOOK('PREP_OCEAN_NETCDF',0,ZHOOK_HANDLE)
- CINGRID_TYPE='LATLON'
+CINGRID_TYPE='LATLON'
!
!
IF (.NOT. ALLOCATED(XILONARRAY)) CALL PREP_NETCDF_GRID(HFILE,HNCVARNAME)
@@ -81,7 +81,7 @@ PFIELD=ZFIELD
!* 3. Interpolation method
! --------------------
!
- CINTERP_TYPE='HORIBL'
+CINTERP_TYPE='HORIBL'
!
!* 4. Deallocations
! -------------
diff --git a/src/SURFEX/prep_ocean_unif.F90 b/src/SURFEX/prep_ocean_unif.F90
index 246f76534f1b43251a4ad4eed11e25becdcc5511..e1df0847e7b7574384466fdfe15daef6f2ef2b89 100644
--- a/src/SURFEX/prep_ocean_unif.F90
+++ b/src/SURFEX/prep_ocean_unif.F90
@@ -94,7 +94,7 @@ END SELECT
!* 4. Interpolation method
! --------------------
!
- CINTERP_TYPE='UNIF '
+CINTERP_TYPE='UNIF '
IF (LHOOK) CALL DR_HOOK('PREP_OCEAN_UNIF',1,ZHOOK_HANDLE)
!
!
diff --git a/src/SURFEX/prep_output_grid.F90 b/src/SURFEX/prep_output_grid.F90
index 7f69ff1d12e6c106bd77759ff6f90895d92e85db..984c7effebe000077434aa1d16b7ccc83dd5ed41 100644
--- a/src/SURFEX/prep_output_grid.F90
+++ b/src/SURFEX/prep_output_grid.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PREP_OUTPUT_GRID (UG, U, &
- KLUOUT,HGRID,PGRID_PAR,PLAT,PLON)
+ SUBROUTINE PREP_OUTPUT_GRID (UG, G, KSIZE_FULL, KLUOUT)
! #######################################
!!
!! PURPOSE
@@ -39,10 +38,7 @@
!* 0. DECLARATION
! -----------
!
-!
-!
-USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
!
USE MODI_GET_GRID_COORD
!
@@ -58,37 +54,39 @@ IMPLICIT NONE
! ------------------------------
!
!
-TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(GRID_t), INTENT(INOUT) :: UG
+TYPE(GRID_t), INTENT(INOUT) :: G
+INTEGER, INTENT(IN) :: KSIZE_FULL
!
INTEGER, INTENT(IN) :: KLUOUT ! output listing logical unit
- CHARACTER(LEN=10), INTENT(IN) :: HGRID ! grid type
-REAL, DIMENSION(:), POINTER :: PGRID_PAR ! parameters defining this grid
-REAL, DIMENSION(:),INTENT(IN) :: PLAT ! latitudes
-REAL, DIMENSION(:),INTENT(IN) :: PLON ! longitudes
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
!
!* 0.2 Declaration of local variables
! ------------------------------
!
-!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PREP_OUTPUT_GRID',0,ZHOOK_HANDLE)
-IF (.NOT.ALLOCATED(XLAT_OUT)) ALLOCATE(XLAT_OUT(SIZE(PLAT)))
-IF (.NOT.ALLOCATED(XLON_OUT)) ALLOCATE(XLON_OUT(SIZE(PLAT)))
-IF (.NOT.ALLOCATED(XX_OUT)) ALLOCATE(XX_OUT (SIZE(PLAT)))
-IF (.NOT.ALLOCATED(XY_OUT)) ALLOCATE(XY_OUT (SIZE(PLAT)))
-!
-IF (.NOT.ALLOCATED(LINTERP)) ALLOCATE(LINTERP (SIZE(PLAT)))
-
-XLAT_OUT = PLAT
-XLON_OUT = PLON
+!
+IF (.NOT.ALLOCATED(XLAT_OUT)) ALLOCATE(XLAT_OUT(SIZE(G%XLAT)))
+IF (.NOT.ALLOCATED(XLON_OUT)) ALLOCATE(XLON_OUT(SIZE(G%XLAT)))
+IF (.NOT.ALLOCATED(XX_OUT)) ALLOCATE(XX_OUT (SIZE(G%XLAT)))
+IF (.NOT.ALLOCATED(XY_OUT)) ALLOCATE(XY_OUT (SIZE(G%XLAT)))
+!
+IF (.NOT.ALLOCATED(LINTERP)) ALLOCATE(LINTERP (SIZE(G%XLAT)))
+!
+IF (SIZE(G%XLAT)==0) THEN
+ IF (LHOOK) CALL DR_HOOK('PREP_OUTPUT_GRID',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
+!
+XLAT_OUT = G%XLAT
+XLON_OUT = G%XLON
LINTERP = .TRUE.
!
- CALL GET_GRID_COORD(UG, U, &
- KLUOUT,XX_OUT,XY_OUT,SIZE(PLAT),HGRID,PGRID_PAR)
+ CALL GET_GRID_COORD(UG%CGRID, UG%NGRID_PAR, UG%XGRID_PAR, KSIZE_FULL, &
+ KLUOUT,XX_OUT,XY_OUT,SIZE(G%XLAT),G%CGRID,G%XGRID_PAR)
+!
IF (LHOOK) CALL DR_HOOK('PREP_OUTPUT_GRID',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/prep_perm_snow.F90 b/src/SURFEX/prep_perm_snow.F90
index 5986190edc14444e3eb25dd7880f486c8b698906..44e909136467486095b11523b96582c30b0c08f7 100644
--- a/src/SURFEX/prep_perm_snow.F90
+++ b/src/SURFEX/prep_perm_snow.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_PERM_SNOW (I, &
- TPSNOW,PTG,PPERM_SNOW_FRAC,KSNOW)
+SUBROUTINE PREP_PERM_SNOW (IO, KK, PK, PEK)
! ################################################
!
!
@@ -33,9 +32,10 @@ SUBROUTINE PREP_PERM_SNOW (I, &
!! M. Lafaysse 09/2012: adaptation with new snow age in Crocus
!!------------------------------------------------------------------
!
-
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC
!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
!
USE MODD_TYPE_SNOW
USE MODD_CSTS, ONLY : XTT
@@ -47,6 +47,7 @@ USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE MODD_ISBA_PAR, ONLY : XWGMIN
!
+USE MODI_VEGTYPE_TO_PATCH
USE MODI_SNOW_HEAT_TO_T_WLIQ
USE MODI_SNOW_T_WLIQ_TO_HEAT
USE MODI_MKFLAG_SNOW
@@ -58,15 +59,17 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
-!* 0.1 declarations of arguments
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
!
+!* 0.1 declarations of arguments
!
-TYPE(ISBA_t), INTENT(INOUT) :: I
!
-TYPE(SURF_SNOW), INTENT(INOUT) :: TPSNOW ! snow mantel characteristics
-REAL, DIMENSION(:,:), INTENT(IN):: PTG ! soil temperature for patch KSNOW
-REAL, DIMENSION(:,:), INTENT(IN):: PPERM_SNOW_FRAC ! fraction of permanent snow for patch KSNOW
-INTEGER, INTENT(IN):: KSNOW ! patch number where permanent snow is
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
!
!* 0.2 declarations of local parameter
!
@@ -74,18 +77,26 @@ REAL, PARAMETER :: ZRHOL1 = 150.
!
!* 0.3 declarations of local variables
!
-INTEGER :: JLAYER ! loop counter on snow layers
+INTEGER :: JL ! loop counter on snow layers
REAL, DIMENSION(:), ALLOCATABLE :: ZWSNOW_PERM ! snow total reservoir due to perm. snow
REAL, DIMENSION(:), ALLOCATABLE :: ZWSNOW ! initial snow total reservoir
REAL, DIMENSION(:), ALLOCATABLE :: ZD ! new snow total depth
REAL, DIMENSION(:,:), ALLOCATABLE :: ZDEPTH ! depth of each layer
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZT ! new snow temperature profile
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZT ! new snow temperature profile
REAL, DIMENSION(:), ALLOCATABLE :: ZPSN ! permanent snow fraction
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWAT !
!
LOGICAL, DIMENSION(:,:), ALLOCATABLE :: GWORK
INTEGER :: IWORK
!
+#ifdef SFX_MPI
+INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+#endif
+INTEGER :: INFOMPI
+INTEGER :: ISNOW ! patch number where permanent snow is
+!
+REAL, DIMENSION(0:NPROC-1) :: ZPSN0
+REAL :: ZSUM_PSN
REAL ::ZRHOSMAX
REAL ::ZAGE_NOW
!
@@ -103,16 +114,27 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('PREP_PERM_SNOW',0,ZHOOK_HANDLE)
!
ZRHOSMAX=XRHOSMAX
-IF(TPSNOW%SCHEME=='3-L'.OR.TPSNOW%SCHEME=='CRO')THEN
+IF(PEK%TSNOW%SCHEME=='3-L'.OR.PEK%TSNOW%SCHEME=='CRO')THEN
ZRHOSMAX=XRHOSMAX_ES
ENDIF
!
-ALLOCATE(ZPSN(SIZE(PTG,1)))
-ZPSN(:) = MIN ( PPERM_SNOW_FRAC(:,NVT_SNOW) , 0.9999 )
+ALLOCATE(ZPSN(SIZE(PEK%XTG,1)))
+
+ZPSN(:) = MIN ( PK%XVEGTYPE_PATCH(:,NVT_SNOW) , 0.9999 )
!
!* if no permanent snow present
!
-IF (ALL(ZPSN(:)==0.)) THEN
+ZSUM_PSN = SUM(ZPSN(:))
+IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_ALLGATHER(ZSUM_PSN,KIND(ZSUM_PSN)/4,MPI_REAL,&
+ ZPSN0,KIND(ZPSN0)/4,MPI_REAL,NCOMM,INFOMPI)
+#endif
+ELSE
+ ZPSN0(:) = ZSUM_PSN
+ENDIF
+
+IF (ALL(ZPSN0(:)==0.)) THEN
DEALLOCATE(ZPSN)
IF (LHOOK) CALL DR_HOOK('PREP_PERM_SNOW',1,ZHOOK_HANDLE)
RETURN
@@ -120,12 +142,12 @@ END IF
!
!* total snow amount due to permanent snow
!
-ALLOCATE(ZWSNOW_PERM(SIZE(PTG,1)))
+ALLOCATE(ZWSNOW_PERM(SIZE(PEK%XTG,1)))
ZWSNOW_PERM(:) = WSNOW_FROM_SNOW_FRAC_GROUND(ZPSN)
!
!* limitation of maximum snow amount
!
-IF(I%LGLACIER)THEN
+IF(IO%LGLACIER)THEN
! limited to 33.3 meters of aged snow
ZWSNOW_PERM(:) = MIN(ZWSNOW_PERM(:),XHGLA * ZRHOSMAX )
ELSE
@@ -136,8 +158,8 @@ ENDIF
!* permanent snow can be added only if deep soil temperature is below 5 C
! (glaciers on subgrid mountains tops that are contained in the grid mesh are neglected)
!
-IF(.NOT.I%LGLACIER)THEN
- WHERE(PTG(:,SIZE(PTG,2))>XTT+5.) ZWSNOW_PERM(:) = 0.
+IF(.NOT.IO%LGLACIER)THEN
+ WHERE(PEK%XTG(:,SIZE(PEK%XTG,2))>XTT+5.) ZWSNOW_PERM(:) = 0.
ENDIF
!
!-------------------------------------------------------------------------------------
@@ -147,97 +169,94 @@ ENDIF
!
!* rho must be defined for snow 3-L before temperature and heat computations
!
-ALLOCATE(GWORK(SIZE(PTG,1),TPSNOW%NLAYER))
+ALLOCATE(GWORK(SIZE(PEK%XTG,1),PEK%TSNOW%NLAYER))
!
-DO JLAYER=1,TPSNOW%NLAYER
+DO JL=1,PEK%TSNOW%NLAYER
!
- GWORK(:,JLAYER)=.FALSE.
+ GWORK(:,JL)=.FALSE.
!
- IF(I%LGLACIER)THEN
- WHERE(ZWSNOW_PERM(:)>0.)GWORK(:,JLAYER)=.TRUE.
+ IF(IO%LGLACIER)THEN
+ WHERE(ZWSNOW_PERM(:)>0.)GWORK(:,JL)=.TRUE.
ELSE
- WHERE(ZWSNOW_PERM(:)>0..AND.TPSNOW%WSNOW(:,JLAYER,KSNOW)==0.)GWORK(:,JLAYER)=.TRUE.
+ WHERE(ZWSNOW_PERM(:)>0..AND.PEK%TSNOW%WSNOW(:,JL)==0.)GWORK(:,JL)=.TRUE.
ENDIF
!
!* rho
!
- WHERE(GWORK(:,JLAYER))
- TPSNOW%RHO(:,JLAYER,KSNOW) = ZRHOSMAX
+ WHERE(GWORK(:,JL))
+ PEK%TSNOW%RHO(:,JL) = ZRHOSMAX
END WHERE
!
!* albedo
!
- IF(I%LGLACIER)THEN
- WHERE(GWORK(:,JLAYER))
- TPSNOW%ALB(:,KSNOW) = (XAGLAMAX+XAGLAMIN)/2.0
+ IF(IO%LGLACIER)THEN
+ WHERE(GWORK(:,JL))
+ PEK%TSNOW%ALB(:) = (XAGLAMAX+XAGLAMIN)/2.0
END WHERE
ELSE
- WHERE(GWORK(:,JLAYER))
- TPSNOW%ALB(:,KSNOW) = (XANSMAX+XANSMIN)/2.0
+ WHERE(GWORK(:,JL))
+ PEK%TSNOW%ALB(:) = (XANSMAX+XANSMIN)/2.0
END WHERE
ENDIF
!
END DO
!
-IF (TPSNOW%SCHEME=='3-L'.OR.TPSNOW%SCHEME=='CRO') THEN
+IF (PEK%TSNOW%SCHEME=='3-L'.OR.PEK%TSNOW%SCHEME=='CRO') THEN
!
! * optimized rho perm snow profile
!
- IF(I%LGLACIER.AND.TPSNOW%NLAYER>=6)THEN
+ IF(IO%LGLACIER.AND.PEK%TSNOW%NLAYER>=6)THEN
WHERE(GWORK(:,1))
- TPSNOW%RHO(:,1,KSNOW) = ZRHOL1
+ PEK%TSNOW%RHO(:,1) = ZRHOL1
END WHERE
- IF(TPSNOW%NLAYER>=6.AND.TPSNOW%NLAYER<12)THEN
+ IF(PEK%TSNOW%NLAYER>=6.AND.PEK%TSNOW%NLAYER<12)THEN
WHERE(GWORK(:,2))
- TPSNOW%RHO(:,2,KSNOW) = ZRHOL1 + 100.
+ PEK%TSNOW%RHO(:,2) = ZRHOL1 + 100.
END WHERE
WHERE(GWORK(:,3))
- TPSNOW%RHO(:,3,KSNOW) = ZRHOL1 + 250.
+ PEK%TSNOW%RHO(:,3) = ZRHOL1 + 250.
END WHERE
ELSE
- DO JLAYER=2,TPSNOW%NLAYER
- WHERE(GWORK(:,JLAYER))
- TPSNOW%RHO(:,JLAYER,KSNOW) = MIN(ZRHOSMAX,TPSNOW%RHO(:,JLAYER-1,KSNOW)+100.)
- END WHERE
+ DO JL=2,PEK%TSNOW%NLAYER
+ WHERE(GWORK(:,JL))
+ PEK%TSNOW%RHO(:,JL) = MIN(ZRHOSMAX,PEK%TSNOW%RHO(:,JL-1)+100.)
+ END WHERE
ENDDO
ENDIF
ENDIF
!
! * Snow age profile
!
- DO JLAYER=1,TPSNOW%NLAYER/4
- WHERE(GWORK(:,JLAYER))
- TPSNOW%AGE(:,JLAYER,KSNOW) = 365.0*FLOAT(JLAYER-1)/ &
- FLOAT(TPSNOW%NLAYER)
+ DO JL=1,PEK%TSNOW%NLAYER/4
+ WHERE(GWORK(:,JL))
+ PEK%TSNOW%AGE(:,JL) = 365.0*FLOAT(JL-1)/ FLOAT(PEK%TSNOW%NLAYER)
END WHERE
END DO
- DO JLAYER=1+TPSNOW%NLAYER/4,TPSNOW%NLAYER
- WHERE(GWORK(:,JLAYER))
- TPSNOW%AGE(:,JLAYER,KSNOW) = 3650.*FLOAT(JLAYER-1)/ &
- FLOAT(TPSNOW%NLAYER)
+ DO JL=1+PEK%TSNOW%NLAYER/4,PEK%TSNOW%NLAYER
+ WHERE(GWORK(:,JL))
+ PEK%TSNOW%AGE(:,JL) = 3650.*FLOAT(JL-1)/ FLOAT(PEK%TSNOW%NLAYER)
END WHERE
END DO
!
- IF(I%LGLACIER)THEN
- WHERE(GWORK(:,:))TPSNOW%AGE(:,:,KSNOW) = 0.0
+ IF(IO%LGLACIER)THEN
+ WHERE(GWORK(:,:))PEK%TSNOW%AGE(:,:) = 0.0
ENDIF
!
END IF
!
-IF (TPSNOW%SCHEME=='CRO') THEN
-DO JLAYER=1,TPSNOW%NLAYER/4
- WHERE(GWORK(:,JLAYER))
- TPSNOW%GRAN1(:,JLAYER,KSNOW) = MIN(-1.,-99.* &
- (1.-4*FLOAT(JLAYER)/FLOAT(TPSNOW%NLAYER)))
- TPSNOW%GRAN2(:,JLAYER,KSNOW) = 50.
- TPSNOW%HIST(:,JLAYER,KSNOW) = 0
+IF (PEK%TSNOW%SCHEME=='CRO') THEN
+DO JL=1,PEK%TSNOW%NLAYER/4
+ WHERE(GWORK(:,JL))
+ PEK%TSNOW%GRAN1(:,JL) = MIN(-1.,-99.* (1.-4*FLOAT(JL)/FLOAT(PEK%TSNOW%NLAYER)))
+ PEK%TSNOW%GRAN2(:,JL) = 50.
+ PEK%TSNOW%HIST(:,JL) = 0
END WHERE
END DO
-DO JLAYER=1+TPSNOW%NLAYER/4,TPSNOW%NLAYER
- WHERE(GWORK(:,JLAYER))
- TPSNOW%GRAN1(:,JLAYER,KSNOW) = 99.
- TPSNOW%GRAN2(:,JLAYER,KSNOW) = 0.0003
- TPSNOW%HIST(:,JLAYER,KSNOW) = 0
+DO JL=1+PEK%TSNOW%NLAYER/4,PEK%TSNOW%NLAYER
+ WHERE(GWORK(:,JL))
+ PEK%TSNOW%GRAN1(:,JL) = 99.
+ PEK%TSNOW%GRAN2(:,JL) = 0.0003
+ PEK%TSNOW%HIST(:,JL) = 0
END WHERE
END DO
END IF
@@ -249,10 +268,10 @@ END IF
!
!* initial snow content
!
-ALLOCATE(ZWSNOW(SIZE(PTG,1)))
+ALLOCATE(ZWSNOW(SIZE(PEK%XTG,1)))
ZWSNOW(:) = 0.
-DO JLAYER=1,TPSNOW%NLAYER
- ZWSNOW(:) = ZWSNOW(:) + TPSNOW%WSNOW(:,JLAYER,KSNOW)
+DO JL=1,PEK%TSNOW%NLAYER
+ ZWSNOW(:) = ZWSNOW(:) + PEK%TSNOW%WSNOW(:,JL)
END DO
!
!* new total snow content
@@ -261,33 +280,33 @@ ZWSNOW_PERM(:) = MAX(ZWSNOW_PERM(:),ZWSNOW(:))
!
!* new total snow depth
!
-ALLOCATE(ZD(SIZE(PTG,1)))
+ALLOCATE(ZD(SIZE(PEK%XTG,1)))
ZD(:) = 0.
-DO JLAYER=1,TPSNOW%NLAYER
- ZD(:) = ZD(:) + TPSNOW%WSNOW(:,JLAYER,KSNOW)/TPSNOW%RHO(:,JLAYER,KSNOW)
+DO JL=1,PEK%TSNOW%NLAYER
+ ZD(:) = ZD(:) + PEK%TSNOW%WSNOW(:,JL)/PEK%TSNOW%RHO(:,JL)
END DO
ZD(:) = ZD(:) + (ZWSNOW_PERM(:)-ZWSNOW(:))/ZRHOSMAX
!
!* modified snow content profile
!
-SELECT CASE(TPSNOW%SCHEME)
+SELECT CASE(PEK%TSNOW%SCHEME)
CASE('D95','1-L','EBA')
GWORK(:,1)=.FALSE.
- IF(I%LGLACIER)THEN
- WHERE(ZWSNOW(:)>=0..AND.TPSNOW%WSNOW(:,1,KSNOW)/=XUNDEF)GWORK(:,1)=.TRUE.
+ IF(IO%LGLACIER)THEN
+ WHERE(ZWSNOW(:)>=0..AND.PEK%TSNOW%WSNOW(:,1)/=XUNDEF)GWORK(:,1)=.TRUE.
ELSE
- WHERE(ZWSNOW(:)==0..AND.TPSNOW%WSNOW(:,1,KSNOW)/=XUNDEF)GWORK(:,1)=.TRUE.
+ WHERE(ZWSNOW(:)==0..AND.PEK%TSNOW%WSNOW(:,1)/=XUNDEF)GWORK(:,1)=.TRUE.
ENDIF
WHERE(GWORK(:,1))
- TPSNOW%WSNOW(:,1,KSNOW) = ZWSNOW_PERM(:)
+ PEK%TSNOW%WSNOW(:,1) = ZWSNOW_PERM(:)
END WHERE
CASE('3-L','CRO')
!* grid
- ALLOCATE(ZDEPTH(SIZE(PTG,1),TPSNOW%NLAYER))
+ ALLOCATE(ZDEPTH(SIZE(PEK%XTG,1),PEK%TSNOW%NLAYER))
CALL SNOW3LGRID(ZDEPTH,ZD)
- DO JLAYER=1,TPSNOW%NLAYER
- WHERE(ZWSNOW(:)>= 0. .AND. TPSNOW%WSNOW(:,JLAYER,KSNOW)/=XUNDEF)
- TPSNOW%WSNOW(:,JLAYER,KSNOW) = ZDEPTH(:,JLAYER) * TPSNOW%RHO(:,JLAYER,KSNOW)
+ DO JL=1,PEK%TSNOW%NLAYER
+ WHERE(ZWSNOW(:)>= 0. .AND. PEK%TSNOW%WSNOW(:,JL)/=XUNDEF)
+ PEK%TSNOW%WSNOW(:,JL) = ZDEPTH(:,JL) * PEK%TSNOW%RHO(:,JL)
END WHERE
END DO
DEALLOCATE(ZDEPTH)
@@ -300,39 +319,39 @@ DEALLOCATE(ZD)
!* 4. Temperature of new snow
! -----------------------
!
-ALLOCATE(ZT (SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,2),SIZE(TPSNOW%WSNOW,3)))
+ALLOCATE(ZT(SIZE(PEK%TSNOW%WSNOW,1),SIZE(PEK%TSNOW%WSNOW,2)))
!
-SELECT CASE(TPSNOW%SCHEME)
+SELECT CASE(PEK%TSNOW%SCHEME)
CASE('1-L')
- ZT(:,:,:) = TPSNOW%T (:,:,:)
+ ZT(:,:) = PEK%TSNOW%T (:,:)
CASE('3-L','CRO')
- CALL SNOW_HEAT_TO_T_WLIQ(TPSNOW%HEAT,TPSNOW%RHO,ZT)
+ CALL SNOW_HEAT_TO_T_WLIQ(PEK%TSNOW%HEAT,PEK%TSNOW%RHO,ZT)
END SELECT
!
!* new snow is set to deep ground temperature
!
-DO JLAYER=1,TPSNOW%NLAYER
+DO JL=1,PEK%TSNOW%NLAYER
!
- GWORK(:,JLAYER)=.FALSE.
+ GWORK(:,JL)=.FALSE.
!
- IF(I%LGLACIER)THEN
- WHERE(ZWSNOW_PERM(:)>0.)GWORK(:,JLAYER)=.TRUE.
+ IF(IO%LGLACIER)THEN
+ WHERE(ZWSNOW_PERM(:)>0.)GWORK(:,JL)=.TRUE.
ELSE
- WHERE(ZWSNOW_PERM(:)>0. .AND. ZWSNOW(:)==0)GWORK(:,JLAYER)=.TRUE.
+ WHERE(ZWSNOW_PERM(:)>0. .AND. ZWSNOW(:)==0)GWORK(:,JL)=.TRUE.
ENDIF
!
- WHERE(GWORK(:,JLAYER))
- ZT(:,JLAYER,KSNOW) = MIN(PTG(:,SIZE(PTG,2)),XTT)
+ WHERE(GWORK(:,JL))
+ ZT(:,JL) = MIN(PEK%XTG(:,SIZE(PEK%XTG,2)),XTT)
END WHERE
!
END DO
!
!
-SELECT CASE(TPSNOW%SCHEME)
+SELECT CASE(PEK%TSNOW%SCHEME)
CASE('1-L')
- TPSNOW%T (:,:,:) = ZT(:,:,:)
+ PEK%TSNOW%T (:,:) = ZT(:,:)
CASE('3-L','CRO')
- CALL SNOW_T_WLIQ_TO_HEAT(TPSNOW%HEAT,TPSNOW%RHO,ZT)
+ CALL SNOW_T_WLIQ_TO_HEAT(PEK%TSNOW%HEAT,PEK%TSNOW%RHO,ZT)
END SELECT
!
DEALLOCATE(ZT )
@@ -344,25 +363,25 @@ DEALLOCATE(GWORK)
!* 5. Soil ice initialization for LGLACIER
! -----------------------
!
-ALLOCATE(ZWAT(SIZE(PTG,1),SIZE(PTG,2)))
+ALLOCATE(ZWAT(SIZE(PEK%XTG,1),SIZE(PEK%XTG,2)))
!
-IF(I%LGLACIER)THEN
+IF(IO%LGLACIER)THEN
!
- IF (I%CISBA == 'DIF') THEN
- IWORK=I%NGROUND_LAYER
- ZWAT(:,:)=I%XWFC(:,:)
+ IF (IO%CISBA == 'DIF') THEN
+ IWORK=IO%NGROUND_LAYER
+ ZWAT(:,:)=KK%XWFC(:,:)
ELSE
IWORK=2
- ZWAT(:,:)=I%XWSAT(:,:)
+ ZWAT(:,:)=KK%XWSAT(:,:)
ENDIF
!
- DO JLAYER=1,IWORK
- WHERE(PPERM_SNOW_FRAC(:,NVT_SNOW)>0.0)
- I%XWGI(:,JLAYER,KSNOW) = MAX(I%XWGI(:,JLAYER,KSNOW),ZWAT(:,JLAYER)*ZPSN(:))
- I%XWG (:,JLAYER,KSNOW) = MIN(I%XWG (:,JLAYER,KSNOW),MAX(I%XWSAT(:,JLAYER)-I%XWGI(:,JLAYER,KSNOW),XWGMIN))
+ DO JL=1,IWORK
+ WHERE(PK%XVEGTYPE_PATCH(:,NVT_SNOW)>0.0)
+ PEK%XWGI(:,JL) = MAX(PEK%XWGI(:,JL),ZWAT(:,JL)*ZPSN(:))
+ PEK%XWG (:,JL) = MIN(PEK%XWG (:,JL), MAX(KK%XWSAT(:,JL)-PEK%XWGI(:,JL),XWGMIN))
END WHERE
- WHERE(I%XWG(:,JLAYER,KSNOW) /= XUNDEF .AND. (I%XWG(:,JLAYER,KSNOW) + I%XWGI(:,JLAYER,KSNOW)) > I%XWSAT(:,JLAYER) )
- I%XWGI(:,JLAYER,KSNOW) = I%XWSAT(:,JLAYER)-I%XWG (:,JLAYER,KSNOW) !WGT<=WSAT
+ WHERE(PEK%XWG(:,JL) /= XUNDEF .AND. (PEK%XWG(:,JL) + PEK%XWGI(:,JL)) > KK%XWSAT(:,JL) )
+ PEK%XWGI(:,JL) = KK%XWSAT(:,JL)-PEK%XWG (:,JL) !WGT<=WSAT
END WHERE
ENDDO
!
@@ -376,7 +395,8 @@ DEALLOCATE(ZPSN)
!* 6. Masking where there is no snow
! ------------------------------
!
- CALL MKFLAG_SNOW(TPSNOW)
+ CALL MKFLAG_SNOW(PEK%TSNOW)
+!
IF (LHOOK) CALL DR_HOOK('PREP_PERM_SNOW',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_teb_canopy.F90 b/src/SURFEX/prep_sbl.F90
similarity index 72%
rename from src/SURFEX/prep_teb_canopy.F90
rename to src/SURFEX/prep_sbl.F90
index 7525772eb919efb12bb76ce3ae54d05c4cf3d3a8..df64881a18f499601294574d3ee3da3c543b008f 100644
--- a/src/SURFEX/prep_teb_canopy.F90
+++ b/src/SURFEX/prep_sbl.F90
@@ -3,10 +3,10 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_TEB_CANOPY (TCP, TG)
+SUBROUTINE PREP_SBL (KDIM, SB)
! #################################################################################
!
-!!**** *PREP_TEB_CANOPY* - prepares TEB canopy fields
+!!**** *PREP_SBL* - prepares FLAKE SBL fields
!!
!! PURPOSE
!! -------
@@ -30,11 +30,7 @@ SUBROUTINE PREP_TEB_CANOPY (TCP, TG)
!! E. Martin 01/2012 XUNDEF fields are no more written in PREP file
!!------------------------------------------------------------------
!
-!
-!
-!
-USE MODD_TEB_CANOPY_n, ONLY : TEB_CANOPY_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
+USE MODD_CANOPY_n, ONLY : CANOPY_t
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -46,9 +42,8 @@ IMPLICIT NONE
!
!* 0.2 declarations of local variables
!
-!
-TYPE(TEB_CANOPY_t), INTENT(INOUT) :: TCP
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
+INTEGER, INTENT(IN) :: KDIM
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
!
INTEGER :: JLAYER
!
@@ -57,18 +52,19 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
!
-IF (LHOOK) CALL DR_HOOK('PREP_TEB_CANOPY',0,ZHOOK_HANDLE)
+
!
!* 1. number of levels (MUST be at least equal to 2)
! ----------------
!
-TCP%NLVL = 6
+IF (LHOOK) CALL DR_HOOK('PREP_SBL',0,ZHOOK_HANDLE)
+SB%NLVL = 6
!
!* 2. height of half levels (where turbulent fluxes will be)
! ---------------------
!
!* Warning : ZZF(:,1) MUST BE ZERO
-ALLOCATE(ZZF(TG%NDIM,TCP%NLVL))
+ALLOCATE(ZZF(KDIM,SB%NLVL))
ZZF(:,1) = 0.
ZZF(:,2) = 1.
ZZF(:,3) = 3.
@@ -76,16 +72,16 @@ ZZF(:,4) = 5.
ZZF(:,5) = 8.
ZZF(:,6) = 12.
-ALLOCATE(TCP%XZ(TG%NDIM,TCP%NLVL))
-DO JLAYER=1,TCP%NLVL-1
- TCP%XZ(:,JLAYER) = 0.5 * (ZZF(:,JLAYER)+ZZF(:,JLAYER+1))
+ALLOCATE(SB%XZ(KDIM,SB%NLVL))
+DO JLAYER=1,SB%NLVL-1
+ SB%XZ(:,JLAYER) = 0.5 * (ZZF(:,JLAYER)+ZZF(:,JLAYER+1))
END DO
-TCP%XZ(:,TCP%NLVL) = 1.5 * ZZF(:,TCP%NLVL) - 0.5 * ZZF(:,TCP%NLVL-1)
+SB%XZ(:,SB%NLVL) = 1.5 * ZZF(:,SB%NLVL) - 0.5 * ZZF(:,SB%NLVL-1)
!
DEALLOCATE(ZZF)
!
-IF (LHOOK) CALL DR_HOOK('PREP_TEB_CANOPY',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('PREP_SBL',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
!
-END SUBROUTINE PREP_TEB_CANOPY
+END SUBROUTINE PREP_SBL
diff --git a/src/SURFEX/prep_sea.F90 b/src/SURFEX/prep_sea.F90
index 69370e73a3ac923d48ad6c355fca35375825dede..3ac99637d119cc517ae1bb144feac03770a4e6a9 100644
--- a/src/SURFEX/prep_sea.F90
+++ b/src/SURFEX/prep_sea.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_SEA (DTCO, UG, U, SM,GCP, &
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+SUBROUTINE PREP_SEA (DTCO, UG, U, GCP, SM, &
+ HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
! #################################################################################
!
!!**** *PREP_SEA* - chooses scheme var. to prepare for sea
@@ -26,20 +26,21 @@ SUBROUTINE PREP_SEA (DTCO, UG, U, SM,GCP, &
!! MODIFICATIONS
!! -------------
!! Original 01/2004
+!! P. Marguinaud10/2014, Support for a 2-part PREP
!!------------------------------------------------------------------
!
!
-USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
+USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
-!
-USE MODI_PREP_SEAFLUX
!
+USE MODE_PREP_CTL, ONLY : PREP_CTL
!
+USE MODI_PREP_SEAFLUX
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -52,8 +53,9 @@ IMPLICIT NONE
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM
+TYPE (PREP_CTL), INTENT(INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! name of the Atmospheric file
@@ -69,8 +71,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PREP_SEA',0,ZHOOK_HANDLE)
IF (U%CSEA=='SEAFLX') THEN
- CALL PREP_SEAFLUX(DTCO, UG, U, SM,GCP, &
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+ CALL PREP_SEAFLUX(DTCO, UG, U, GCP, SM%G, SM%SB, SM%S, SM%DTS, SM%O, SM%OR, &
+ HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
END IF
IF (LHOOK) CALL DR_HOOK('PREP_SEA',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/prep_seaflux.F90 b/src/SURFEX/prep_seaflux.F90
index 40c81916af691f0c5d5de2333a28d2a4c496ae3c..76a05e2476832cbfc5c214ce50343a11a72fe934 100644
--- a/src/SURFEX/prep_seaflux.F90
+++ b/src/SURFEX/prep_seaflux.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_SEAFLUX (DTCO, UG, U, SM,GCP, &
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+SUBROUTINE PREP_SEAFLUX (DTCO, UG, U, GCP, SG, SB, S, DTS, O, OR, &
+ HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
! #################################################################################
!
!!**** *PREP_SEAFLUX* - prepares variables for SEAFLUX scheme
@@ -30,21 +30,25 @@ SUBROUTINE PREP_SEAFLUX (DTCO, UG, U, SM,GCP, &
!! Modified 07/2012, P. Le Moigne : CMO1D phasing
!! Modified 01/2014, S. Senesi : introduce sea-ice model
!! Modified 01/2015, R. Séférian : introduce ocean surface albedo
+!! P. Marguinaud10/2014, Support for a 2-part PREP
!!------------------------------------------------------------------
!
-!
-USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t
-!
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_CANOPY_n, ONLY : CANOPY_t
+USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
+USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_t
+USE MODD_OCEAN_n, ONLY : OCEAN_t
+USE MODD_OCEAN_REL_n, ONLY : OCEAN_REL_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
USE MODI_PREP_HOR_SEAFLUX_FIELD
USE MODI_PREP_VER_SEAFLUX
USE MODI_PREP_OUTPUT_GRID
-USE MODI_PREP_SEAFLUX_SBL
+USE MODI_PREP_SBL
USE MODI_PREP_SEAICE
USE MODI_GET_LUOUT
!
@@ -53,6 +57,7 @@ USE MODD_READ_NAMELIST, ONLY : LNAM_READ
USE MODD_PREP, ONLY : XZS_LS
USE MODD_SURF_ATM, ONLY : LVERTSHIFT
!
+USE MODE_PREP_CTL, ONLY : PREP_CTL
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -63,14 +68,18 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-!
-!
-!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
+TYPE(GRID_t), INTENT(INOUT) :: SG
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
+TYPE(SEAFLUX_t), INTENT(INOUT) :: S
+TYPE(DATA_SEAFLUX_t), INTENT(INOUT) :: DTS
+TYPE(OCEAN_t), INTENT(INOUT) :: O
+TYPE(OCEAN_REL_t), INTENT(INOUT) :: OR
+TYPE (PREP_CTL), INTENT(INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! name of the Atmospheric file
@@ -94,25 +103,26 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('PREP_SEAFLUX',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
- CALL PREP_OUTPUT_GRID(UG, U, &
- ILUOUT,SM%SG%CGRID,SM%SG%XGRID_PAR,SM%SG%XLAT,SM%SG%XLON)
+ CALL PREP_OUTPUT_GRID(UG%G, SG, U%NSIZE_FULL, ILUOUT)
!
!-------------------------------------------------------------------------------------
!
!* 1. Read namelist
!
-SM%S%LSBL = LSEA_SBL
-SM%O%LMERCATOR = LOCEAN_MERCATOR
-SM%O%LCURRENT = LOCEAN_CURRENT
+S%LSBL = LSEA_SBL
+!
+O%LMERCATOR = LOCEAN_MERCATOR
+O%LCURRENT = LOCEAN_CURRENT
+!
! Relaxation-forcing parameters
-SM%OR%XTAU_REL = XTIME_REL
-SM%OR%XQCORR = XCORFLX
+OR%XTAU_REL = XTIME_REL
+OR%XQCORR = XCORFLX
!
-SM%OR%LREL_CUR = LCUR_REL
-SM%OR%LREL_TS = LTS_REL
-SM%OR%LFLUX_NULL = LZERO_FLUX
-SM%OR%LFLX_CORR = LCORR_FLUX
-SM%OR%LDIAPYCNAL = LDIAPYC
+OR%LREL_CUR = LCUR_REL
+OR%LREL_TS = LTS_REL
+OR%LFLUX_NULL = LZERO_FLUX
+OR%LFLX_CORR = LCORR_FLUX
+OR%LDIAPYCNAL = LDIAPYC
!
!-------------------------------------------------------------------------------------
!
@@ -121,107 +131,105 @@ SM%OR%LDIAPYCNAL = LDIAPYC
!
!* 2.0 Large scale orography
!
- CALL PREP_HOR_SEAFLUX_FIELD(DTCO, UG, U, &
- SM%DTS, SM%O, SM%OR, SM%SG, SM%S, GCP,&
- HPROGRAM,'ZS ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+CALL PREP_HOR_SEAFLUX_FIELD(DTCO, UG, U, GCP, DTS, O, OR, SIZE(SG%XLAT), S, &
+ HPROGRAM,'ZS ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
!
!* 2.1.1 Temperature
!
- CALL PREP_HOR_SEAFLUX_FIELD(DTCO, UG, U, &
- SM%DTS, SM%O, SM%OR, SM%SG, SM%S,GCP, &
- HPROGRAM,'SST ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+CALL PREP_HOR_SEAFLUX_FIELD(DTCO, UG, U, GCP, DTS, O, OR, SIZE(SG%XLAT), S, &
+ HPROGRAM,'SST ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
!
!* 2.1.2 Salinity
!
- CALL PREP_HOR_SEAFLUX_FIELD(DTCO, UG, U, &
- SM%DTS, SM%O, SM%OR, SM%SG, SM%S,GCP, &
- HPROGRAM,'SSS ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+CALL PREP_HOR_SEAFLUX_FIELD(DTCO, UG, U, GCP, DTS, O, OR, SIZE(SG%XLAT), S, &
+ HPROGRAM,'SSS ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
!
!* 2.1.3 Sea-ice
!
IF (CSEAICE_SCHEME /= 'NONE ') THEN
- CALL PREP_SEAICE(UG, &
- DTCO, SM%DTS, SM%O, SM%OR, SM%SG, SM%S, U,GCP, &
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+ CALL PREP_SEAICE(UG, DTCO, DTS, O, OR, SIZE(SG%XLAT), S, U, GCP, &
+ HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
ENDIF
!
+ CALL CLEAN_PREP_OUTPUT_GRID
+
+IF (YDCTL%LPART6) THEN
!
!* 2.2 Roughness
!
-ALLOCATE(SM%S%XZ0(SIZE(SM%S%XSST)))
-SM%S%XZ0 = 0.001
+ ALLOCATE(S%XZ0(SIZE(S%XSST)))
+ S%XZ0 = 0.001
!
-ALLOCATE(SM%S%XZ0H(SIZE(SM%S%XSST)))
-SM%S%XZ0H = SM%S%XZ0
+ ALLOCATE(S%XZ0H(SIZE(S%XSST)))
+ S%XZ0H = S%XZ0
!
!* 2.3 Ocean Surface Albedo
!
-IF(SM%S%CSEA_ALB=='RS14')THEN
- ALLOCATE(SM%S%XDIR_ALB(SIZE(SM%S%XSST)))
- ALLOCATE(SM%S%XSCA_ALB(SIZE(SM%S%XSST)))
- SM%S%XDIR_ALB = 0.065
- SM%S%XSCA_ALB = 0.065
-ENDIF
+ IF(S%CSEA_ALB=='RS14')THEN
+ ALLOCATE(S%XDIR_ALB(SIZE(S%XSST)))
+ ALLOCATE(S%XSCA_ALB(SIZE(S%XSST)))
+ S%XDIR_ALB = 0.065
+ S%XSCA_ALB = 0.065
+ ENDIF
!
-!-------------------------------------------------------------------------------------
- CALL CLEAN_PREP_OUTPUT_GRID
!-------------------------------------------------------------------------------------
!
!* 3. Vertical interpolations of all variables
!
-IF(LVERTSHIFT)THEN
- CALL PREP_VER_SEAFLUX(SM%S)
-ENDIF
+ IF(LVERTSHIFT)THEN
+ CALL PREP_VER_SEAFLUX(S)
+ ENDIF
!
-DEALLOCATE(XZS_LS)
+ DEALLOCATE(XZS_LS)
!
!-------------------------------------------------------------------------------------
!
!* 4. Preparation of optional interpolation of monthly sst
!
-SM%S%LINTERPOL_SST=.FALSE.
-IF(TRIM(SM%S%CINTERPOL_SST)/='NONE')THEN
+ S%LINTERPOL_SST=.FALSE.
+ IF(TRIM(S%CINTERPOL_SST)/='NONE')THEN
!
- SM%S%LINTERPOL_SST=.TRUE.
+ S%LINTERPOL_SST=.TRUE.
!
! Precedent, Current, Next, and Second-next Monthly SST
- INMTH=4
+ INMTH=4
!
- ALLOCATE(SM%S%XSST_MTH(SIZE(SM%S%XSST),INMTH))
- DO JMTH=1,INMTH
- SM%S%XSST_MTH(:,JMTH)=SM%S%XSST(:)
- ENDDO
+ ALLOCATE(S%XSST_MTH(SIZE(S%XSST),INMTH))
+ DO JMTH=1,INMTH
+ S%XSST_MTH(:,JMTH)=S%XSST(:)
+ ENDDO
!
-ENDIF
+ ENDIF
!
!-------------------------------------------------------------------------------------
!
!
!* 5. Optional preparation of interpolation of monthly Sea Surface salinity
!
-SM%S%LINTERPOL_SSS=.FALSE.
-IF(TRIM(SM%S%CINTERPOL_SSS)/='NONE')THEN
+ S%LINTERPOL_SSS=.FALSE.
+ IF(TRIM(S%CINTERPOL_SSS)/='NONE')THEN
!
- SM%S%LINTERPOL_SSS=.TRUE.
+ S%LINTERPOL_SSS=.TRUE.
!
! Precedent, Current, Next, and Second-next Monthly SSS
- INMTH=4
+ INMTH=4
!
- ALLOCATE(SM%S%XSSS_MTH(SIZE(SM%S%XSSS),INMTH))
- DO JMTH=1,INMTH
- SM%S%XSSS_MTH(:,JMTH)=SM%S%XSSS(:)
- ENDDO
+ ALLOCATE(S%XSSS_MTH(SIZE(S%XSSS),INMTH))
+ DO JMTH=1,INMTH
+ S%XSSS_MTH(:,JMTH)=S%XSSS(:)
+ ENDDO
!
-ENDIF
+ ENDIF
!
!-------------------------------------------------------------------------------------
!
!* 6. Preparation of SBL air variables
!
!
-IF (SM%S%LSBL) CALL PREP_SEAFLUX_SBL(SM%SG, SM%SSB)
+ IF (S%LSBL) CALL PREP_SBL(SG%NDIM, SB)
!
+ENDIF
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PREP_SEAFLUX',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/prep_seaflux_buffer.F90 b/src/SURFEX/prep_seaflux_buffer.F90
index 776a6b48c8509e3f29b57ccc93a092b704674f27..74518d46c1b8095439a3310a893a7fe7b5ab6001 100644
--- a/src/SURFEX/prep_seaflux_buffer.F90
+++ b/src/SURFEX/prep_seaflux_buffer.F90
@@ -113,7 +113,7 @@ END SELECT
!* 4. Interpolation method
! --------------------
!
- CINTERP_TYPE='BUFFER'
+CINTERP_TYPE='BUFFER'
IF (LHOOK) CALL DR_HOOK('PREP_SEAFLUX_BUFFER',1,ZHOOK_HANDLE)
!
!
diff --git a/src/SURFEX/prep_seaflux_extern.F90 b/src/SURFEX/prep_seaflux_extern.F90
index 6d259d7ab847540ae49f7e8d23b7dc6412afb489..2f78620a9592c0bdd87dbbbc1c6323d5927d72bd 100644
--- a/src/SURFEX/prep_seaflux_extern.F90
+++ b/src/SURFEX/prep_seaflux_extern.F90
@@ -3,14 +3,13 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_SEAFLUX_EXTERN (GCP,&
- HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)
+SUBROUTINE PREP_SEAFLUX_EXTERN (GCP,HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)
! #################################################################################
!
!
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
-!
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_SURFEX_MPI, ONLY : NRANK,NPIO
!
USE MODD_TYPE_DATE_SURF
!
@@ -29,9 +28,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-!
-!
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file
@@ -45,7 +43,7 @@ REAL,DIMENSION(:,:), POINTER :: PFIELD ! field to interpolate horizontally
!
!
REAL, DIMENSION(:), ALLOCATABLE :: ZMASK
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
INTEGER :: IRESP ! reading return code
!
INTEGER :: INI ! total 1D dimension
@@ -68,14 +66,14 @@ IF (LHOOK) CALL DR_HOOK('PREP_SEAFLUX_EXTERN',0,ZHOOK_HANDLE)
!* 2. Reading of grid
! ---------------
!
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'FULL ')
- CALL PREP_GRID_EXTERN(GCP,&
- HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'FULL ')
+ CALL PREP_GRID_EXTERN(GCP,HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
!
YRECFM='VERSION'
CALL READ_SURF(HFILEPGDTYPE,YRECFM,IVERSION,IRESP)
!
+IF (NRANK/=NPIO) INI = 0
+!
ALLOCATE(ZMASK(INI))
IF (IVERSION>=7) THEN
YRECFM='FRAC_SEA'
@@ -86,6 +84,7 @@ ENDIF
!
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
!
+IF (NRANK/=NPIO) INI = 0
!---------------------------------------------------------------------------------------
SELECT CASE(HSURF)
!---------------------------------------------------------------------------------------
@@ -103,10 +102,8 @@ SELECT CASE(HSURF)
CASE('SST ')
ALLOCATE(PFIELD(INI,1))
YRECFM='SST'
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'SEA ')
- CALL READ_SURF(&
- HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'SEA ')
+ CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='E')
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
WHERE (ZMASK(:)==0.) PFIELD(:,1) = XUNDEF
!
@@ -116,16 +113,12 @@ SELECT CASE(HSURF)
CASE('SSS ')
ALLOCATE(PFIELD(INI,1))
YRECFM='SSS'
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'FULL ')
- CALL READ_SURF(&
- HFILETYPE,'VERSION',IVERSION,IRESP)
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'FULL ')
+ CALL READ_SURF(HFILETYPE,'VERSION',IVERSION,IRESP)
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
IF(IVERSION>=8)THEN
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'SEA ')
- CALL READ_SURF(&
- HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'SEA ')
+ CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='E')
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
WHERE (ZMASK(:)==0.) PFIELD(:,1) = XUNDEF
ELSE
diff --git a/src/SURFEX/prep_seaflux_grib.F90 b/src/SURFEX/prep_seaflux_grib.F90
index 07e1afdf6e115bc40019df52a4744f34e5d0540f..7462e2317ef50b8d71db14595892e3fb466baa7b 100644
--- a/src/SURFEX/prep_seaflux_grib.F90
+++ b/src/SURFEX/prep_seaflux_grib.F90
@@ -31,13 +31,7 @@ SUBROUTINE PREP_SEAFLUX_GRIB(HPROGRAM,HSURF,HFILE,KLUOUT,PFIELD)
!
USE MODE_READ_GRIB
!
-USE MODD_TYPE_DATE_SURF
-!
-USE MODI_PREP_GRIB_GRID
-!
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
-USE MODD_GRID_GRIB, ONLY : CGRIB_FILE, NNI
-!
+USE MODD_GRID_GRIB, ONLY : CGRIB_FILE, CINMODEL
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -54,8 +48,6 @@ REAL,DIMENSION(:,:), POINTER :: PFIELD ! field to interpolate horizontally
!
!* 0.2 declarations of local variables
!
-TYPE (DATE_TIME) :: TZTIME_GRIB ! current date and time
- CHARACTER(LEN=6) :: YINMODEL ! model from which GRIB file originates
REAL, DIMENSION(:) , POINTER :: ZMASK => NULL() ! Land mask
REAL, DIMENSION(:), POINTER :: ZFIELD => NULL() ! field read
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -69,9 +61,7 @@ IF (LHOOK) CALL DR_HOOK('PREP_SEAFLUX_GRIB',0,ZHOOK_HANDLE)
!
IF (TRIM(HFILE).NE.CGRIB_FILE) CGRIB_FILE=""
!
- CALL PREP_GRIB_GRID(HFILE,KLUOUT,YINMODEL,CINGRID_TYPE,TZTIME_GRIB)
-!
- CALL READ_GRIB_LAND_MASK(HFILE,KLUOUT,YINMODEL,ZMASK)
+ CALL READ_GRIB_LAND_MASK(HFILE,KLUOUT,CINMODEL,ZMASK)
!
!* 2. Reading of field
! ----------------
@@ -83,9 +73,9 @@ SELECT CASE(HSURF)
! ---------
!
CASE('ZS ')
- SELECT CASE (YINMODEL)
- CASE ('ECMWF ','ARPEGE','ALADIN','MOCAGE')
- CALL READ_GRIB_ZS_SEA(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD)
+ SELECT CASE (CINMODEL)
+ CASE ('ECMWF ','ARPEGE','ALADIN','MOCAGE','HIRLAM')
+ CALL READ_GRIB_ZS_SEA(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD)
ALLOCATE(PFIELD(SIZE(ZFIELD),1))
PFIELD(:,1) = ZFIELD(:)
DEALLOCATE(ZFIELD)
@@ -96,9 +86,9 @@ SELECT CASE(HSURF)
! --------------------
!
CASE('SST ')
- SELECT CASE (YINMODEL)
- CASE ('ECMWF ','ARPEGE','ALADIN','MOCAGE')
- CALL READ_GRIB_SST(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD)
+ SELECT CASE (CINMODEL)
+ CASE ('ECMWF ','ARPEGE','ALADIN','MOCAGE','HIRLAM')
+ CALL READ_GRIB_SST(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD)
ALLOCATE(PFIELD(SIZE(ZFIELD),1))
PFIELD(:,1) = ZFIELD(:)
DEALLOCATE(ZFIELD)
@@ -108,7 +98,7 @@ SELECT CASE(HSURF)
! -------------------------------------
!
CASE('SSS ','SIC ')
- ALLOCATE(PFIELD(NNI,1))
+ ALLOCATE(PFIELD(SIZE(ZFIELD),1))
PFIELD = 0.0
!
END SELECT
@@ -118,7 +108,6 @@ DEALLOCATE(ZMASK)
!* 4. Interpolation method
! --------------------
!
- CINTERP_TYPE='HORIBL'
IF (LHOOK) CALL DR_HOOK('PREP_SEAFLUX_GRIB',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_seaflux_netcdf.F90 b/src/SURFEX/prep_seaflux_netcdf.F90
index 24555c7f6b622c7ffce0f5cf55807144fd73174d..78c8a5f1b357eb45fb0fde3fb9973e08a5bb21ce 100644
--- a/src/SURFEX/prep_seaflux_netcdf.F90
+++ b/src/SURFEX/prep_seaflux_netcdf.F90
@@ -32,8 +32,9 @@ USE MODE_READ_NETCDF_MERCATOR
!
!USE MODD_TYPE_DATE_SURF
!
-USE MODD_PREP, ONLY : CINGRID_TYPE
-USE MODD_GRID_LATLONREGUL, ONLY : NILENGTH
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC
+USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
+USE MODD_GRID_LATLONREGUL, ONLY : NILENGTH,NINDEPTH
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -41,6 +42,10 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1 declarations of arguments
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
@@ -55,6 +60,7 @@ REAL,DIMENSION(:,:), POINTER :: PFIELD ! field to interpolate horizontally
!CHARACTER(LEN=6) :: YINMODEL ! model from which GRIB file originates
REAL, DIMENSION(:), POINTER :: ZFIELD ! field read
CHARACTER(LEN=28) :: YNCVAR
+INTEGER :: INFOMPI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
@@ -62,7 +68,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* 1. Grid type
! ---------
IF (LHOOK) CALL DR_HOOK('PREP_SEAFLUX_NETCDF',0,ZHOOK_HANDLE)
- CINGRID_TYPE='LATLON '
+CINGRID_TYPE='LATLON '
!
!* 2. Reading of field
! ----------------
@@ -76,10 +82,14 @@ SELECT CASE(HSURF)
CASE('ZS ')
YNCVAR='topo'
CALL PREP_NETCDF_GRID(HFILE,YNCVAR)
- CALL READ_NETCDF_ZS_SEA(HFILE,YNCVAR,ZFIELD)
- ALLOCATE(PFIELD(MAX(1,NILENGTH),1))
- PFIELD(:,1) = ZFIELD(:)
- DEALLOCATE(ZFIELD)
+ IF (NRANK==NPIO) THEN
+ CALL READ_NETCDF_ZS_SEA(HFILE,YNCVAR,ZFIELD)
+ ALLOCATE(PFIELD(MAX(1,NILENGTH),1))
+ PFIELD(:,1) = ZFIELD(:)
+ DEALLOCATE(ZFIELD)
+ ELSE
+ ALLOCATE(PFIELD(0,0))
+ ENDIF
!
!
!* 2.2 Temperature profiles
@@ -94,12 +104,29 @@ SELECT CASE(HSURF)
YNCVAR='sic'
END IF
CALL PREP_NETCDF_GRID(HFILE,YNCVAR)
- CALL READ_NETCDF_SST(HFILE,YNCVAR,ZFIELD)
- ALLOCATE(PFIELD(MAX(1,NILENGTH),1))
- PFIELD(:,1) = ZFIELD(:)
- DEALLOCATE(ZFIELD)
+ IF (NRANK==NPIO) THEN
+ CALL READ_NETCDF_SST(HFILE,YNCVAR,ZFIELD)
+ ALLOCATE(PFIELD(MAX(1,NILENGTH),1))
+ PFIELD(:,1) = ZFIELD(:)
+ DEALLOCATE(ZFIELD)
+ ENDIF
!
END SELECT
+!
+IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(CINTERP_TYPE,LEN(CINTERP_TYPE),MPI_CHARACTER,NPIO,NCOMM,INFOMPI)
+#endif
+ IF (TRIM(CINTERP_TYPE)=="UNIF") THEN
+ IF (NRANK/=NPIO) ALLOCATE(PFIELD(1,1))
+#ifdef SFX_MPI
+ CALL MPI_BCAST(PFIELD(1:1,1:1),KIND(PFIELD)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+#endif
+ ELSEIF (NRANK/=NPIO) THEN
+ ALLOCATE(PFIELD(0,0))
+ ENDIF
+ENDIF
+!
IF (LHOOK) CALL DR_HOOK('PREP_SEAFLUX_NETCDF',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------------
END SUBROUTINE PREP_SEAFLUX_NETCDF
diff --git a/src/SURFEX/prep_seaflux_sbl.F90 b/src/SURFEX/prep_seaflux_sbl.F90
deleted file mode 100644
index b1e30ed0d8c7cba0ef14f73f402e6fa7b927b83c..0000000000000000000000000000000000000000
--- a/src/SURFEX/prep_seaflux_sbl.F90
+++ /dev/null
@@ -1,89 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE PREP_SEAFLUX_SBL (SG, SSB)
-! #################################################################################
-!
-!!**** *PREP_SEAFLUX_SBL* - prepares SEAFLUX SBL fields
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/2006
-!! S. Riette 06/2009 XT, XU, XQ, XTKE are set to XUNDEF
-!! No more argument needed
-!! E. Martin 01/2012 XUNDEF fields are no more written in PREP file
-!!------------------------------------------------------------------
-!
-!
-!
-USE MODD_SEAFLUX_GRID_n, ONLY : SEAFLUX_GRID_t
-USE MODD_SEAFLUX_SBL_n, ONLY : SEAFLUX_SBL_t
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!* 0.2 declarations of local variables
-!
-!
-TYPE(SEAFLUX_GRID_t), INTENT(INOUT) :: SG
-TYPE(SEAFLUX_SBL_t), INTENT(INOUT) :: SSB
-!
-INTEGER :: JLAYER
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZZF ! altitudes at half levels
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------------
-!
-!* 1. number of levels (MUST be at least equal to 2)
-! ----------------
-!
-IF (LHOOK) CALL DR_HOOK('PREP_SEAFLUX_SBL',0,ZHOOK_HANDLE)
-SSB%NLVL = 6
-!
-!* 2. height of half levels (where turbulent fluxes will be)
-! ---------------------
-!
-!* Warning : ZZF(:,1) MUST BE ZERO
-ALLOCATE(ZZF(SG%NDIM,SSB%NLVL))
-ZZF(:,1) = 0.
-ZZF(:,2) = 1
-ZZF(:,3) = 3.
-ZZF(:,4) = 5.
-ZZF(:,5) = 8.
-ZZF(:,6) = 12.
-
-ALLOCATE(SSB%XZ(SG%NDIM,SSB%NLVL))
-DO JLAYER=1,SSB%NLVL-1
- SSB%XZ(:,JLAYER) = 0.5 * (ZZF(:,JLAYER)+ZZF(:,JLAYER+1))
-END DO
-SSB%XZ(:,SSB%NLVL) = 1.5 * ZZF(:,SSB%NLVL) - 0.5 * ZZF(:,SSB%NLVL-1)
-!
-DEALLOCATE(ZZF)
-!
-IF (LHOOK) CALL DR_HOOK('PREP_SEAFLUX_SBL',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE PREP_SEAFLUX_SBL
diff --git a/src/SURFEX/prep_seaflux_unif.F90 b/src/SURFEX/prep_seaflux_unif.F90
index cc7bdf6d7120b572f21f2429ab26c36773371e16..220cc03e2564bbf251219dccbf00adb4cd3835bc 100644
--- a/src/SURFEX/prep_seaflux_unif.F90
+++ b/src/SURFEX/prep_seaflux_unif.F90
@@ -84,7 +84,7 @@ END SELECT
!* 4. Interpolation method
! --------------------
!
- CINTERP_TYPE='UNIF '
+CINTERP_TYPE='UNIF '
IF (LHOOK) CALL DR_HOOK('PREP_SEAFLUX_UNIF',1,ZHOOK_HANDLE)
!
!
diff --git a/src/SURFEX/prep_seaice.F90 b/src/SURFEX/prep_seaice.F90
index 57094943a34d3fdc8f55c7c60d05eae3787eb43c..1cbfc4d2255775853303e1e5cf75d5c5d9589f72 100644
--- a/src/SURFEX/prep_seaice.F90
+++ b/src/SURFEX/prep_seaice.F90
@@ -3,9 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_SEAICE (UG, &
- DTCO, DTS, O, OR, SG, S, U,GCP, &
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+SUBROUTINE PREP_SEAICE (UG, DTCO, DTS, O, OR, KLAT, S, U, GCP, &
+ HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
! #################################################################################
!
!!**** *PREP_SEAICE* - prepares variables for SEAICE scheme (for now : Gelato only)
@@ -29,22 +28,15 @@ SUBROUTINE PREP_SEAICE (UG, &
!! Original 01/2014
!!------------------------------------------------------------------
!
-!
-!
-!
-!
-!
-!
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_t
USE MODD_OCEAN_n, ONLY : OCEAN_t
USE MODD_OCEAN_REL_n, ONLY : OCEAN_REL_t
-USE MODD_SEAFLUX_GRID_n, ONLY : SEAFLUX_GRID_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODI_GET_LUOUT
@@ -53,6 +45,8 @@ USE MODI_GLTOOLS_READNAM
!
USE MODD_TYPES_GLT, ONLY : T_GLT
!
+USE MODE_PREP_CTL, ONLY : PREP_CTL
+!
USE MODN_PREP_SEAFLUX, ONLY : CPREP_SEAICE_SCHEME => CSEAICE_SCHEME
USE MODI_PREP_HOR_SEAFLUX_FIELD
!
@@ -74,16 +68,18 @@ TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(DATA_SEAFLUX_t), INTENT(INOUT) :: DTS
TYPE(OCEAN_t), INTENT(INOUT) :: O
TYPE(OCEAN_REL_t), INTENT(INOUT) :: OR
-TYPE(SEAFLUX_GRID_t), INTENT(INOUT) :: SG
+INTEGER, INTENT(IN) :: KLAT
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
- CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! name of the Atmospheric file
- CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! type of the Atmospheric file
- CHARACTER(LEN=28), INTENT(IN) :: HPGDFILE ! name of the Atmospheric file
- CHARACTER(LEN=6), INTENT(IN) :: HPGDFILETYPE! type of the Atmospheric file
+TYPE (PREP_CTL), INTENT(INOUT) :: YDCTL
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! name of the Atmospheric file
+CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! type of the Atmospheric file
+CHARACTER(LEN=28), INTENT(IN) :: HPGDFILE ! name of the Atmospheric file
+CHARACTER(LEN=6), INTENT(IN) :: HPGDFILETYPE! type of the Atmospheric file
!
!* 0.2 declarations of local variables
!
@@ -101,7 +97,7 @@ IF (LHOOK) CALL DR_HOOK('PREP_SEAICE',0,ZHOOK_HANDLE)
!* 0. Default of configuration
!
!
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
+CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
!-------------------------------------------------------------------------------------
!
@@ -122,9 +118,8 @@ ENDIF
!* 2. Reading and horizontal interpolations of Seaice cover
!
IF (S%LHANDLE_SIC) THEN
- CALL PREP_HOR_SEAFLUX_FIELD(DTCO, UG, U, &
- DTS, O, OR, SG, S,GCP, &
- HPROGRAM,'SIC ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+ CALL PREP_HOR_SEAFLUX_FIELD(DTCO, UG, U, GCP, DTS, O, OR, KLAT, S, &
+ HPROGRAM,'SIC ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
ENDIF
!
!-------------------------------------------------------------------------------------
@@ -169,12 +164,11 @@ ENDIF
!* Creating default initial state for Gelato
!
!
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'SEA ',nx)
+CALL GET_TYPE_DIM_n(DTCO, U, 'SEA ',nx)
ny=1
nyglo=1
nxglo=nx
- CALL GLTOOLS_ALLOC(S%TGLT)
+CALL GLTOOLS_ALLOC(S%TGLT)
!
!* G1 Prognostic fields with only space dimension(s) :
!
diff --git a/src/SURFEX/prep_snow_buffer.F90 b/src/SURFEX/prep_snow_buffer.F90
index 936acedec4a879febfe3aefb9ead955452b25d8c..02fa903ce012fd8468cae5ad3a0bf4fa1517be8f 100644
--- a/src/SURFEX/prep_snow_buffer.F90
+++ b/src/SURFEX/prep_snow_buffer.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_SNOW_BUFFER (IG, U, &
- HPROGRAM,HSURF,KLUOUT,KLAYER,PFIELD)
+SUBROUTINE PREP_SNOW_BUFFER (G, U, HPROGRAM,HSURF,KLUOUT,KLAYER,PFIELD)
! #################################################################################
!
!!**** *PREP_SNOW_BUFFER* - prepares snow field from operational BUFFER
@@ -29,7 +28,7 @@ SUBROUTINE PREP_SNOW_BUFFER (IG, U, &
!!------------------------------------------------------------------
!
!
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODE_SNOW3L
@@ -39,7 +38,6 @@ USE MODE_READ_BUFFER
USE MODD_TYPE_DATE_SURF
!
USE MODI_PREP_BUFFER_GRID
-USE MODI_SNOW_T_WLIQ_TO_HEAT
#ifdef SFX_ARO
USE MODI_OI_HOR_EXTRAPOL_SURF
#endif
@@ -50,7 +48,6 @@ USE MODI_ABOR1_SFX
USE MODD_PREP, ONLY : CINTERP_TYPE
USE MODD_PREP_ISBA, ONLY : LEXTRAP_SN
USE MODD_PREP_SNOW, ONLY : XGRID_SNOW
-USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_GRID_BUFFER, ONLY : NNI
USE MODD_SNOW_PAR, ONLY : XANSMIN, XANSMAX, XRHOSMAX
@@ -65,11 +62,11 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
+TYPE(GRID_t), INTENT(INOUT) :: G
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
- CHARACTER(LEN=10), INTENT(IN) :: HSURF ! type of field
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+CHARACTER(LEN=10), INTENT(IN) :: HSURF ! type of field
INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
INTEGER, INTENT(IN) :: KLAYER ! Number of layer of output snow scheme
REAL,DIMENSION(:,:,:), POINTER :: PFIELD ! field to interpolate horizontally
@@ -77,7 +74,7 @@ REAL,DIMENSION(:,:,:), POINTER :: PFIELD ! field to interpolate horizontall
!* 0.2 declarations of local variables
!
TYPE (DATE_TIME) :: TZTIME_BUFFER ! current date and time
- CHARACTER(LEN=6) :: YINMODEL ! model from which GRIB file originates
+CHARACTER(LEN=6) :: YINMODEL ! model from which GRIB file originates
REAL, DIMENSION(:), POINTER :: ZFIELD1D ! field read
REAL, DIMENSION(:), POINTER :: ZHEAT ! heat in snow
REAL, DIMENSION(:), POINTER :: ZRHO ! density of snow
@@ -98,7 +95,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ---------------
!
IF (LHOOK) CALL DR_HOOK('PREP_SNOW_BUFFER',0,ZHOOK_HANDLE)
- CALL PREP_BUFFER_GRID(KLUOUT,YINMODEL,TZTIME_BUFFER)
+CALL PREP_BUFFER_GRID(KLUOUT,YINMODEL,TZTIME_BUFFER)
!
!-------------------------------------------------------------------------------------
!
@@ -164,7 +161,7 @@ ELSE
ZFIELD_EP_IN(:) = ZFIELD_EP
#ifdef SFX_ARO
- CALL OI_HOR_EXTRAPOL_SURF(U%NSIZE_NATURE,IG%XLAT,IG%XLON,ZFIELD_EP_IN(:),IG%XLAT,IG%XLON,ZFIELD_EP(:),OINTERP,NDIM2=IDIM2)
+ CALL OI_HOR_EXTRAPOL_SURF(U%NSIZE_NATURE,G%XLAT,G%XLON,ZFIELD_EP_IN(:),G%XLAT,G%XLON,ZFIELD_EP(:),OINTERP,NDIM2=IDIM2)
#endif
! Unpack to full rank
@@ -175,12 +172,9 @@ ELSE
DEALLOCATE(OINTERP)
ENDIF
ENDIF
-
!
- ALLOCATE(PFIELD(NNI,1,NVEGTYPE))
- DO JVEGTYPE=1,NVEGTYPE
- PFIELD(:,1,JVEGTYPE)=ZFIELD1D(:)
- END DO
+ ALLOCATE(PFIELD(NNI,1,1))
+ PFIELD(:,1,1)=ZFIELD1D(:)
DEALLOCATE(ZFIELD1D)
!
!
@@ -220,7 +214,7 @@ ELSE
ZFIELD_EP_IN(:) = ZFIELD_EP
#ifdef SFX_ARO
- CALL OI_HOR_EXTRAPOL_SURF(U%NSIZE_NATURE,IG%XLAT,IG%XLON,ZFIELD_EP_IN(:),IG%XLAT,IG%XLON,ZFIELD_EP(:),OINTERP,NDIM2=IDIM2)
+ CALL OI_HOR_EXTRAPOL_SURF(U%NSIZE_NATURE,G%XLAT,G%XLON,ZFIELD_EP_IN(:),G%XLAT,G%XLON,ZFIELD_EP(:),OINTERP,NDIM2=IDIM2)
#endif
! Unpack to full rank
@@ -233,10 +227,8 @@ ELSE
ENDIF
!
- ALLOCATE(PFIELD(NNI,KLAYER,NVEGTYPE))
- DO JVEGTYPE=1,NVEGTYPE
- CALL SNOW3LGRID(PFIELD(:,:,JVEGTYPE),ZFIELD1D(:))
- END DO
+ ALLOCATE(PFIELD(NNI,1,1))
+ PFIELD(:,1,1) = ZFIELD1D(:)
DEALLOCATE(ZFIELD1D)
!
!
@@ -246,33 +238,21 @@ ELSE
!* read temperature
CALL READ_BUFFER_TS(KLUOUT,YINMODEL,ZFIELD1D)
WHERE (ZFIELD1D/=XUNDEF) ZFIELD1D(:) = MIN(ZFIELD1D,XTT)
- !* assumes no liquid water in the snow
- ALLOCATE(ZHEAT(SIZE(ZFIELD1D)))
- ALLOCATE(ZRHO (SIZE(ZFIELD1D)))
- ZRHO(:) = XRHOSMAX
- !
- CALL SNOW_T_WLIQ_TO_HEAT(ZHEAT,ZRHO,ZFIELD1D)
!
- ALLOCATE(PFIELD(NNI,SIZE(XGRID_SNOW),NVEGTYPE))
- DO JVEGTYPE=1,NVEGTYPE
- DO JLAYER=1,SIZE(XGRID_SNOW)
- PFIELD(:,JLAYER,JVEGTYPE)=ZHEAT(:)
- END DO
- END DO
+ ALLOCATE(PFIELD(NNI,1,1))
+ PFIELD(:,1,1)=ZFIELD1D(:)
DEALLOCATE(ZFIELD1D)
- DEALLOCATE(ZHEAT )
- DEALLOCATE(ZRHO )
!
!* 3.4 Albedo
!
CASE('ALB')
- ALLOCATE(PFIELD(NNI,1,NVEGTYPE))
+ ALLOCATE(PFIELD(NNI,1,1))
PFIELD = 0.5 * ( XANSMIN + XANSMAX )
!
!* 3.5 Density
!
CASE('RHO')
- ALLOCATE(PFIELD(NNI,SIZE(XGRID_SNOW),NVEGTYPE))
+ ALLOCATE(PFIELD(NNI,1,1))
PFIELD = XRHOSMAX
END SELECT
@@ -284,7 +264,7 @@ END IF
!* 4. Interpolation method
! --------------------
!
- CINTERP_TYPE='BUFFER'
+CINTERP_TYPE='BUFFER'
IF (LHOOK) CALL DR_HOOK('PREP_SNOW_BUFFER',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_snow_extern.F90 b/src/SURFEX/prep_snow_extern.F90
index b5b2e1c41d4d4004e61943bb9b783321a55f77fc..f2e9d764210d13fae24f437507b670f98b00bf55 100644
--- a/src/SURFEX/prep_snow_extern.F90
+++ b/src/SURFEX/prep_snow_extern.F90
@@ -3,9 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_SNOW_EXTERN (GCP,&
- HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,&
- KLUOUT,PFIELD,OSNOW_IDEAL,KLAYER,KTEB_PATCH)
+SUBROUTINE PREP_SNOW_EXTERN (GCP,HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,&
+ KLUOUT,PFIELD,OSNOW_IDEAL,KLAYER,KTEB_PATCH)
! #################################################################################
!
!
@@ -41,11 +40,9 @@ SUBROUTINE PREP_SNOW_EXTERN (GCP,&
!! improve vertical interpolation
!-------------------------------------------------------------------------------
!
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
-!
-!
-!
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
USE MODD_TYPE_SNOW
USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
USE MODD_PREP_SNOW, ONLY : XGRID_SNOW, NGRID_LEVEL
@@ -53,40 +50,38 @@ USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_CSTS, ONLY : XTT
!
-USE MODE_SNOW3L
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
USE MODI_TOWN_PRESENCE
-USE MODI_PUT_ON_ALL_VEGTYPES
USE MODI_ABOR1_SFX
USE MODI_PREP_GRID_EXTERN
USE MODI_OPEN_AUX_IO_SURF
USE MODI_CLOSE_AUX_IO_SURF
USE MODI_ALLOCATE_GR_SNOW
+USE MODI_DEALLOC_GR_SNOW
USE MODI_INTERP_GRID_NAT
USE MODI_READ_GR_SNOW
USE MODI_READ_SURF
USE MODI_SNOW_T_WLIQ_TO_HEAT
+USE MODI_SNOW_HEAT_TO_T_WLIQ
USE MODI_READ_TEB_PATCH
!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-!
-!
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
- CHARACTER(LEN=10), INTENT(IN) :: HSURF ! type of field
- CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file
- CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! type of file
- CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! name of file
- CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! type of file
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+CHARACTER(LEN=10), INTENT(IN) :: HSURF ! type of field
+CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file
+CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! type of file
+CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! name of file
+CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! type of file
INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
REAL,DIMENSION(:,:,:), POINTER :: PFIELD ! field to interpolate horizontally
-LOGICAL, INTENT(IN) :: OSNOW_IDEAL
+LOGICAL, INTENT(INOUT) :: OSNOW_IDEAL
INTEGER, INTENT(IN) :: KLAYER ! Number of layer of output snow scheme
INTEGER, INTENT(IN) :: KTEB_PATCH
!
@@ -94,30 +89,30 @@ INTEGER, INTENT(IN) :: KTEB_PATCH
!
TYPE(SURF_SNOW) :: TZSNOW ! snow characteristics
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFIELD ! work field on input snow grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFIELD_FINE ! work field on fine snow grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTEMP ! snow temperature
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWLIQ ! liquid water snow pack content
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZD ! total snow depth
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDEPTH ! thickness of each layer (m)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZGRID ! normalized input grid
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFIELD ! work field on input snow grid
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZHEAT
+REAL, DIMENSION(:), ALLOCATABLE :: ZD ! total snow depth
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDEPTH ! thickness of each layer (m)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZGRID ! normalized input grid
+!
+INTEGER, DIMENSION(:), ALLOCATABLE :: IMASK_P
!
LOGICAL :: GTOWN ! town variables written in the file
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! record name
+CHARACTER(LEN=LEN_HREC) :: YRECFM ! record name
INTEGER :: IRESP ! error return code
-INTEGER :: IVERSION ! SURFEX version
+INTEGER :: IVERSION_PGD, IVERSION_PREP ! SURFEX version
LOGICAL :: GOLD_NAME ! old name flag
-INTEGER :: IBUGFIX ! SURFEX bug version
+INTEGER :: IBUGFIX_PGD, IBUGFIX_PREP ! SURFEX bug version
INTEGER :: IVEGTYPE ! actual number of vegtypes
-INTEGER :: JLAYER ! loop on snow vertical grids
+INTEGER :: JL ! loop on snow vertical grids
INTEGER :: JI ! loop on pts
INTEGER :: INI
- CHARACTER(LEN=8) :: YAREA ! area treated ('ROOF','ROAD','VEG ')
- CHARACTER(LEN=3) :: YPREFIX ! prefix to identify patch
+CHARACTER(LEN=8) :: YAREA ! area treated ('ROOF','ROAD','VEG ')
+CHARACTER(LEN=3) :: YPREFIX ! prefix to identify patch
INTEGER :: IPATCH ! number of input patch
INTEGER :: ITEB_PATCH ! number of input patch for TEB
-INTEGER :: JPATCH ! loop on patch
- CHARACTER(LEN=6) :: YMASK ! type of tile mask
+INTEGER :: JP ! loop on patch
+CHARACTER(LEN=6) :: YMASK ! type of tile mask
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
@@ -151,266 +146,233 @@ END IF
! Their value must be defined as XUNDEF.
!
!* reading of version of the file being read
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'FULL ')
- CALL READ_SURF(&
- HFILEPGDTYPE,'VERSION',IVERSION,IRESP)
- CALL READ_SURF(&
- HFILEPGDTYPE,'BUG',IBUGFIX,IRESP)
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'FULL ')
+CALL READ_SURF(HFILEPGDTYPE,'VERSION',IVERSION_PGD,IRESP,HDIR='-')
+CALL READ_SURF(HFILEPGDTYPE,'BUG',IBUGFIX_PGD,IRESP,HDIR='-')
+GOLD_NAME=(IVERSION_PGD<7 .OR. (IVERSION_PGD==7 .AND. IBUGFIX_PGD<3))
+!
+ CALL PREP_GRID_EXTERN(GCP,HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
!
-GOLD_NAME=(IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<3))
+ CALL TOWN_PRESENCE(HFILEPGDTYPE,GTOWN,HDIR='-')
!
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,YMASK)
+CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+!
+CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,YMASK)
!
IF (YAREA(1:4)=='VEG ') THEN
YRECFM = 'PATCH_NUMBER'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,IPATCH,IRESP)
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP,HDIR='-')
ELSE
IF (.NOT.GOLD_NAME) THEN
- IF (YAREA(1:4)=='ROOF') YAREA(1:4) = 'RF '
- IF (YAREA(1:4)=='ROAD') YAREA(1:4) = 'RD '
- ENDIF
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- CALL READ_TEB_PATCH(&
- HFILEPGD,HFILEPGDTYPE,ITEB_PATCH)
+ IF (YAREA(1:4)=='ROOF') YAREA(1:4) = 'RF '
+ IF (YAREA(1:4)=='ROAD') YAREA(1:4) = 'RD '
+ ENDIF
+ IF (GTOWN) THEN
+ CALL READ_TEB_PATCH(HFILEPGD,HFILEPGDTYPE,IVERSION_PGD,IBUGFIX_PGD,ITEB_PATCH,HDIR='-')
+ ELSE
+ ITEB_PATCH = 1
+ ENDIF
IF (ITEB_PATCH>1) THEN
WRITE(YPREFIX,FMT='(A,I1,A)') 'T',MIN(KTEB_PATCH,ITEB_PATCH),'_'
END IF
END IF
!
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+!
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'FULL ')
+ CALL READ_SURF(HFILETYPE,'VERSION',IVERSION_PREP,IRESP,HDIR='-')
+ CALL READ_SURF(HFILETYPE,'BUG',IBUGFIX_PREP,IRESP,HDIR='-')
+ CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
!
!-------------------------------------------------------------------------------------
!
!* 2. Reading of grid
! ---------------
!
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'FULL ')
-!
- CALL PREP_GRID_EXTERN(GCP,&
- HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
+IF (NRANK/=NPIO) INI = 0
!
!-------------------------------------------------------------------------------------
!
!* 4. Reading of snow data
! ---------------------
!
-IF (YAREA(1:2)=='RO' .OR. YAREA(1:2)=='GA' .OR. YAREA(1:2)=='RF' .OR. YAREA(1:2)=='RD') THEN
- CALL TOWN_PRESENCE(&
- HFILEPGDTYPE,GTOWN)
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- IF (.NOT. GTOWN) THEN
- TZSNOW%SCHEME='1-L'
- TZSNOW%NLAYER=1
- CALL ALLOCATE_GR_SNOW(TZSNOW,INI,IPATCH)
+ALLOCATE(IMASK_P(INI))
+DO JI = 1,INI
+ IMASK_P(JI) = JI
+ENDDO
+!
+DO JP = 1,IPATCH
+ !
+ IF (YAREA(1:2)=='RO' .OR. YAREA(1:2)=='GA' .OR. YAREA(1:2)=='RF' .OR. YAREA(1:2)=='RD') THEN
+ IF (.NOT. GTOWN) THEN
+ TZSNOW%SCHEME='1-L'
+ TZSNOW%NLAYER=1
+ CALL ALLOCATE_GR_SNOW(TZSNOW,INI)
+ ELSE
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,YMASK)
+ CALL READ_GR_SNOW(HFILETYPE,TRIM(YAREA),YPREFIX,INI,INI,IMASK_P,0,TZSNOW, &
+ HDIR='E',KVERSION=IVERSION_PREP,KBUGFIX=IBUGFIX_PREP)
+ CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
+ ENDIF
ELSE
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,YMASK)
- CALL READ_GR_SNOW(&
- HFILETYPE,TRIM(YAREA),YPREFIX,INI,IPATCH,TZSNOW, &
- HDIR='A',KVERSION=IVERSION,KBUGFIX=IBUGFIX)
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,YMASK)
+ CALL READ_GR_SNOW(HFILETYPE,TRIM(YAREA),YPREFIX,INI,INI,IMASK_P,JP,TZSNOW, &
+ HDIR='E',KVERSION=IVERSION_PREP,KBUGFIX=IBUGFIX_PREP,KNPATCH=IPATCH)
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
ENDIF
-ELSE
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,YMASK)
- CALL READ_GR_SNOW(&
- HFILETYPE,TRIM(YAREA),YPREFIX,INI,IPATCH,TZSNOW, &
- HDIR='A',KVERSION=IVERSION,KBUGFIX=IBUGFIX)
- CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
-ENDIF
-!
-!-------------------------------------------------------------------------------------
-!
-!* 5. Total snow content
-! ------------------
-!
-SELECT CASE (HSURF(1:3))
- CASE ('WWW')
- IF (OSNOW_IDEAL) THEN
- ALLOCATE(ZFIELD(INI,KLAYER,IPATCH))
- ZFIELD(:,:,:) = TZSNOW%WSNOW(:,1:KLAYER,:)
- ALLOCATE(PFIELD(INI,KLAYER,IVEGTYPE))
- CALL PUT_ON_ALL_VEGTYPES(INI,KLAYER,IPATCH,IVEGTYPE,ZFIELD,PFIELD)
- ELSE
- ALLOCATE(ZFIELD(INI,1,IPATCH))
- ZFIELD(:,1,:) = 0.0
- DO JLAYER=1,TZSNOW%NLAYER
- ZFIELD(:,1,:) = ZFIELD(:,1,:) + TZSNOW%WSNOW(:,JLAYER,:)
- END DO
- WHERE ( ZFIELD(:,1,:)>XUNDEF ) ZFIELD(:,1,:)=XUNDEF
- ALLOCATE(PFIELD(INI,1,IVEGTYPE))
- CALL PUT_ON_ALL_VEGTYPES(INI,1,IPATCH,IVEGTYPE,ZFIELD,PFIELD)
- ENDIF
- DEALLOCATE(ZFIELD)
-!
-!-------------------------------------------------------------------------------------
-!
-!* 6. Albedo
-! ------
-!
- CASE ('ALB')
- ALLOCATE(ZFIELD(INI,1,IPATCH))
- ZFIELD(:,1,:) = TZSNOW%ALB(:,:)
+ !
+ !-------------------------------------------------------------------------------------
+ !
+ !* 5. Total snow content
+ ! ------------------
+ !
+ IF (NRANK==NPIO) THEN
!
- ALLOCATE(PFIELD(INI,1,IVEGTYPE))
- CALL PUT_ON_ALL_VEGTYPES(INI,1,IPATCH,IVEGTYPE,ZFIELD,PFIELD)
- DEALLOCATE(ZFIELD)
-!
-!-------------------------------------------------------------------------------------
-!
-!* 7. Total depth to snow grid
-! ------------------------
-!
- CASE ('DEP')
- ALLOCATE(ZFIELD_FINE(INI,KLAYER,IPATCH))
- IF (OSNOW_IDEAL) THEN
- ZFIELD_FINE(:,:,:) = TZSNOW%WSNOW(:,1:KLAYER,:)/TZSNOW%RHO(:,1:KLAYER,:)
- WHERE(TZSNOW%WSNOW(:,1:KLAYER,:)==XUNDEF) ZFIELD_FINE(:,:,:)=XUNDEF
- ELSE
- ALLOCATE(ZDEPTH(INI,TZSNOW%NLAYER,IPATCH))
- ZDEPTH(:,:,:) = TZSNOW%WSNOW(:,:,:)/TZSNOW%RHO(:,:,:)
- WHERE(TZSNOW%WSNOW(:,:,:)==XUNDEF) ZDEPTH(:,:,:)=XUNDEF
- IF(TZSNOW%NLAYER/=KLAYER)THEN
- !* total depth
- ALLOCATE(ZD(INI,IPATCH))
- ZD(:,:) = 0.0
- DO JPATCH=1,IPATCH
- DO JLAYER=1,TZSNOW%NLAYER
- DO JI=1,INI
- IF(ZDEPTH(JI,JLAYER,JPATCH)/=XUNDEF)THEN
- ZD(JI,JPATCH) = ZD(JI,JPATCH) + ZDEPTH(JI,JLAYER,JPATCH)
- ENDIF
- ENDDO
- ENDDO
- ENDDO
- !* fine grid
- DO JPATCH=1,IPATCH
- CALL SNOW3LGRID(ZFIELD_FINE(:,:,JPATCH),ZD(:,JPATCH))
- ENDDO
+ SELECT CASE (HSURF(1:3))
+ CASE ('WWW')
+ IF (OSNOW_IDEAL) THEN
+ IF (JP<=1) ALLOCATE(PFIELD(INI,KLAYER,IPATCH))
+ PFIELD(:,:,JP) = TZSNOW%WSNOW(:,1:KLAYER)
+ ELSE
+ IF (JP<=1) ALLOCATE(PFIELD(INI,1,IPATCH))
+ PFIELD(:,:,JP) = 0.
+ DO JL=1,TZSNOW%NLAYER
+ PFIELD(:,1,JP) = PFIELD(:,1,JP) + TZSNOW%WSNOW(:,JL)
+ END DO
+ WHERE ( PFIELD(:,1,JP)>XUNDEF ) PFIELD(:,1,JP)=XUNDEF
+ ENDIF
+ !
+ !-------------------------------------------------------------------------------------
+ !
+ !* 6. Albedo
+ ! ------
+ !
+ CASE ('ALB')
+ IF (JP<=1) ALLOCATE(PFIELD(INI,1,IPATCH))
+ PFIELD(:,1,JP) = TZSNOW%ALB(:)
+ !
+ !-------------------------------------------------------------------------------------
+ !
+ !* 7. Total depth to snow grid
+ ! ------------------------
+ !
+ CASE ('DEP')
+ IF (OSNOW_IDEAL) THEN
+ IF (JP<=1) ALLOCATE(PFIELD(INI,KLAYER,IPATCH))
+ PFIELD(:,:,JP) = TZSNOW%WSNOW(:,1:KLAYER)/TZSNOW%RHO(:,1:KLAYER)
+ WHERE(TZSNOW%WSNOW(:,1:KLAYER)==XUNDEF) PFIELD(:,:,JP)=XUNDEF
+ ELSE
+ ALLOCATE(ZD(INI))
+ ZD(:) = 0.0
+ DO JL=1,TZSNOW%NLAYER
+ WHERE (TZSNOW%WSNOW(:,JL)/=XUNDEF)
+ ZD(:) = ZD(:) + TZSNOW%WSNOW(:,JL)/TZSNOW%RHO(:,JL)
+ ENDWHERE
+ END DO
+ IF (JP<=1) ALLOCATE(PFIELD(INI,1,IPATCH))
+ PFIELD(:,1,JP) = ZD(:)
DEALLOCATE(ZD)
- ELSE
- ZFIELD_FINE(:,:,:)=ZDEPTH(:,:,:)
ENDIF
- DEALLOCATE(ZDEPTH)
- ENDIF
- ALLOCATE(PFIELD(INI,KLAYER,IVEGTYPE))
- CALL PUT_ON_ALL_VEGTYPES(INI,KLAYER,IPATCH,IVEGTYPE,ZFIELD_FINE,PFIELD)
- DEALLOCATE(ZFIELD_FINE)
-!
-!-------------------------------------------------------------------------------------
-!
-!* 8. Density or heat profile
-! -----------------------
-!
- CASE ('RHO','HEA','SG1','SG2','HIS','AGE')
- ALLOCATE(ZFIELD(INI,TZSNOW%NLAYER,IPATCH))
-!
- SELECT CASE (TZSNOW%SCHEME)
- CASE ('D95','1-L','EBA')
- ALLOCATE(ZFIELD_FINE(INI,NGRID_LEVEL,IPATCH))
- !* computes output physical variable
- IF (HSURF(1:3)=='RHO') ZFIELD(:,1,:) = TZSNOW%RHO(:,1,:)
- IF (HSURF(1:3)=='HEA') THEN
- ALLOCATE(ZTEMP(INI,TZSNOW%NLAYER,IPATCH))
- ALLOCATE(ZWLIQ(INI,TZSNOW%NLAYER,IPATCH))
- IF (TZSNOW%SCHEME=='D95'.OR.TZSNOW%SCHEME=='EBA') ZTEMP(:,1,:) = XTT-2.
- IF (TZSNOW%SCHEME=='1-L') ZTEMP(:,1,:) = TZSNOW%T(:,1,:)
- ZWLIQ(:,:,:) = 0.0
- CALL SNOW_T_WLIQ_TO_HEAT(ZFIELD,TZSNOW%RHO,ZTEMP,ZWLIQ)
- DEALLOCATE(ZTEMP)
- DEALLOCATE(ZWLIQ)
- END IF
- IF (HSURF(1:3)=='SG1') ZFIELD(:,1,:) = -20.0
- IF (HSURF(1:3)=='SG2') ZFIELD(:,1,:) = 80.0
- IF (HSURF(1:3)=='HIS') ZFIELD(:,1,:) = 0.0
- IF (HSURF(1:3)=='AGE') ZFIELD(:,1,:) = 3.0
- !* put profile on fine snow grid
- DO JLAYER=1,NGRID_LEVEL
- ZFIELD_FINE(:,JLAYER,:) = ZFIELD(:,1,:)
- END DO
- ALLOCATE(PFIELD(INI,NGRID_LEVEL,IVEGTYPE))
- CALL PUT_ON_ALL_VEGTYPES(INI,NGRID_LEVEL,IPATCH,IVEGTYPE,ZFIELD_FINE,PFIELD)
+ !
+ !-------------------------------------------------------------------------------------
+ !
+ !* 8. Density or heat profile
+ ! -----------------------
+ !
+ CASE ('RHO','HEA','SG1','SG2','HIS','AGE')
+ !
+ SELECT CASE (TZSNOW%SCHEME)
+ CASE ('D95','1-L','EBA')
+ IF (JP<=1) ALLOCATE(PFIELD(INI,1,IPATCH))
+ !* computes output physical variable
+ IF (HSURF(1:3)=='RHO') PFIELD(:,1,JP) = TZSNOW%RHO(:,1)
+ IF (HSURF(1:3)=='HEA') THEN
+ IF (TZSNOW%SCHEME=='D95'.OR.TZSNOW%SCHEME=='EBA') PFIELD(:,1,JP) = XTT-2.
+ IF (TZSNOW%SCHEME=='1-L') PFIELD(:,1,JP) = TZSNOW%T(:,1)
+ END IF
+ IF (HSURF(1:3)=='SG1') PFIELD(:,1,JP) = -20.0
+ IF (HSURF(1:3)=='SG2') PFIELD(:,1,JP) = 80.0
+ IF (HSURF(1:3)=='HIS') PFIELD(:,1,JP) = 0.0
+ IF (HSURF(1:3)=='AGE') PFIELD(:,1,JP) = 3.0
- CASE ('3-L','CRO')
- !* input physical variable
- IF (HSURF(1:3)=='RHO') ZFIELD(:,:,:) = TZSNOW%RHO (:,1:TZSNOW%NLAYER,:)
- IF (HSURF(1:3)=='HEA') ZFIELD(:,:,:) = TZSNOW%HEAT(:,1:TZSNOW%NLAYER,:)
- IF (HSURF(1:3)=='AGE') ZFIELD(:,:,:) = TZSNOW%AGE (:,1:TZSNOW%NLAYER,:)
- IF (TZSNOW%SCHEME=='CRO')THEN
- IF (HSURF(1:3)=='SG1') ZFIELD(:,:,:) = TZSNOW%GRAN1(:,1:TZSNOW%NLAYER,:)
- IF (HSURF(1:3)=='SG2') ZFIELD(:,:,:) = TZSNOW%GRAN2(:,1:TZSNOW%NLAYER,:)
- IF (HSURF(1:3)=='HIS') ZFIELD(:,:,:) = TZSNOW%HIST (:,1:TZSNOW%NLAYER,:)
- ELSE
- IF (HSURF(1:3)=='SG1') ZFIELD(:,:,:) = -20.0
- IF (HSURF(1:3)=='SG2') ZFIELD(:,:,:) = 80.0
- IF (HSURF(1:3)=='HIS') ZFIELD(:,:,:) = 0.0
- ENDIF
- !
- IF (OSNOW_IDEAL) THEN
- ALLOCATE(ZFIELD_FINE(INI,KLAYER,IPATCH))
- ZFIELD_FINE(:,:,:) = ZFIELD(:,:,:)
- ALLOCATE(PFIELD(INI,KLAYER,IVEGTYPE))
- CALL PUT_ON_ALL_VEGTYPES(INI,KLAYER,IPATCH,IVEGTYPE,ZFIELD_FINE,PFIELD)
- ELSE
- ALLOCATE(ZFIELD_FINE(INI,NGRID_LEVEL,IPATCH))
- !
- !* input snow layer thickness
- ALLOCATE(ZDEPTH(INI,TZSNOW%NLAYER,IPATCH))
- DO JPATCH=1,IPATCH
- ZDEPTH(:,:,JPATCH) = TZSNOW%WSNOW(:,:,JPATCH)/TZSNOW%RHO(:,:,JPATCH)
- END DO
+ CASE ('3-L','CRO')
+ ALLOCATE(ZFIELD(INI,TZSNOW%NLAYER))
+ !* input physical variable
+ IF (HSURF(1:3)=='RHO') ZFIELD(:,:) = TZSNOW%RHO (:,1:TZSNOW%NLAYER)
+ IF (HSURF(1:3)=='AGE') ZFIELD(:,:) = TZSNOW%AGE(:,1:TZSNOW%NLAYER)
+ IF (TZSNOW%SCHEME=='CRO')THEN
+ IF (HSURF(1:3)=='SG1') ZFIELD(:,:) = TZSNOW%GRAN1(:,1:TZSNOW%NLAYER)
+ IF (HSURF(1:3)=='SG2') ZFIELD(:,:) = TZSNOW%GRAN2(:,1:TZSNOW%NLAYER)
+ IF (HSURF(1:3)=='HIS') ZFIELD(:,:) = TZSNOW%HIST(:,1:TZSNOW%NLAYER)
+ ELSE
+ IF (HSURF(1:3)=='SG1') ZFIELD(:,:) = -20.0
+ IF (HSURF(1:3)=='SG2') ZFIELD(:,:) = 80.0
+ IF (HSURF(1:3)=='HIS') ZFIELD(:,:) = 0.0
+ ENDIF
!
- !* total depth
- ALLOCATE(ZD(INI,IPATCH))
- ZD(:,:) = 0.
- DO JLAYER=1,TZSNOW%NLAYER
- ZD(:,:) = ZD(:,:) + ZDEPTH(:,JLAYER,:)
- ENDDO
+ IF ( HSURF(1:3)=='HEA') THEN
+ ALLOCATE(ZHEAT(INI,TZSNOW%NLAYER))
+ ZHEAT(:,:) = TZSNOW%HEAT(:,1:TZSNOW%NLAYER)
+ CALL SNOW_HEAT_TO_T_WLIQ(ZHEAT,TZSNOW%RHO,ZFIELD)
+ WHERE (ZFIELD>XTT.AND.ZFIELD/=XUNDEF) ZFIELD = XTT
+ DEALLOCATE(ZHEAT)
+ ENDIF
!
- !* input normalized grid
- ALLOCATE(ZGRID(INI,TZSNOW%NLAYER,IPATCH))
- DO JPATCH=1,IPATCH
- DO JI=1,INI
- IF(ZD(JI,JPATCH)==0.0)THEN
- DO JLAYER = 1,TZSNOW%NLAYER
- ZGRID(JI,JLAYER,JPATCH)=REAL(JLAYER)/REAL(TZSNOW%NLAYER)
- ENDDO
- ELSE
- DO JLAYER = 1,TZSNOW%NLAYER
- IF(JLAYER==1)THEN
- ZGRID(JI,JLAYER,JPATCH)=ZDEPTH(JI,JLAYER,JPATCH)/ ZD(JI,JPATCH)
- ELSE
- ZGRID(JI,JLAYER,JPATCH) = ZGRID(JI,JLAYER-1,JPATCH) + ZDEPTH(JI,JLAYER,JPATCH)/ZD(JI,JPATCH)
- ENDIF
- ENDDO
- ENDIF
- ENDDO
- ENDDO
- DEALLOCATE(ZDEPTH)
- DEALLOCATE(ZD)
- !
- !* interpolation of profile onto fine normalized snow grid
- DO JPATCH=1,IPATCH
- CALL INTERP_GRID_NAT(ZGRID(:,:,JPATCH),ZFIELD(:,:,JPATCH), &
- XGRID_SNOW(:), ZFIELD_FINE(:,:,JPATCH))
- END DO
- DEALLOCATE(ZGRID)
- ALLOCATE(PFIELD(INI,NGRID_LEVEL,IVEGTYPE))
- CALL PUT_ON_ALL_VEGTYPES(INI,NGRID_LEVEL,IPATCH,IVEGTYPE,ZFIELD_FINE,PFIELD)
- ENDIF
- END SELECT
- !
- !* put field form patch to all vegtypes
- DEALLOCATE(ZFIELD)
- DEALLOCATE(ZFIELD_FINE)
+ IF (OSNOW_IDEAL) THEN
+ IF (JP<=1) ALLOCATE(PFIELD(INI,KLAYER,IPATCH))
+ PFIELD(:,:,JP) = ZFIELD(:,:)
+ ELSE
+ !
+ IF (JP<=1) ALLOCATE(PFIELD(INI,NGRID_LEVEL,IPATCH))
+ !* input snow layer thickness
+ ALLOCATE(ZDEPTH(INI,TZSNOW%NLAYER))
+ ZDEPTH(:,:) = TZSNOW%WSNOW(:,:)/TZSNOW%RHO(:,:)
+ !
+ !* total depth
+ ALLOCATE(ZD(INI))
+ ZD(:) = 0.
+ DO JL=1,TZSNOW%NLAYER
+ ZD(:) = ZD(:) + ZDEPTH(:,JL)
+ ENDDO
+ !
+ !* input normalized grid
+ ALLOCATE(ZGRID(INI,TZSNOW%NLAYER))
+ DO JI=1,INI
+ IF(ZD(JI)==0.0)THEN
+ DO JL = 1,TZSNOW%NLAYER
+ ZGRID(JI,JL)=REAL(JL)/REAL(TZSNOW%NLAYER)
+ ENDDO
+ ELSE
+ DO JL = 1,TZSNOW%NLAYER
+ IF(JL==1)THEN
+ ZGRID(JI,JL)=ZDEPTH(JI,JL)/ ZD(JI)
+ ELSE
+ ZGRID(JI,JL) = ZGRID(JI,JL-1) + ZDEPTH(JI,JL)/ZD(JI)
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+ DEALLOCATE(ZDEPTH)
+ DEALLOCATE(ZD)
+ !
+ ! * interpolation of profile onto fine normalized snow grid
+ CALL INTERP_GRID_NAT(ZGRID(:,:),ZFIELD(:,:), &
+ XGRID_SNOW(:), PFIELD(:,:,JP))
+ DEALLOCATE(ZGRID)
+ ENDIF
+ DEALLOCATE(ZFIELD)
+
+ END SELECT
+ !* put field form patch to all vegtypes
+ END SELECT
+ !
+ ENDIF
+ !
+ CALL DEALLOC_GR_SNOW(TZSNOW)
+ !
+ENDDO
!
-END SELECT
+DEALLOCATE(IMASK_P)
!
!-------------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/prep_snow_grib.F90 b/src/SURFEX/prep_snow_grib.F90
index e7ec7a2454a09414f951b94fff6ba31555c2be98..39a918ecdd66d3c15525b975b7700153c8b301a6 100644
--- a/src/SURFEX/prep_snow_grib.F90
+++ b/src/SURFEX/prep_snow_grib.F90
@@ -30,18 +30,12 @@ SUBROUTINE PREP_SNOW_GRIB(HPROGRAM,HSURF,HFILE,KLUOUT,KLAYER,PFIELD)
!
!
USE MODE_READ_GRIB
-USE MODE_SNOW3L
!
USE MODD_TYPE_DATE_SURF
!
-USE MODI_PREP_GRIB_GRID
-USE MODI_SNOW_T_WLIQ_TO_HEAT
-!
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
USE MODD_PREP_SNOW, ONLY : NGRID_LEVEL, XGRID_SNOW
-USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_GRID_GRIB, ONLY : CGRIB_FILE, NNI
+USE MODD_GRID_GRIB, ONLY : CGRIB_FILE, NNI, CINMODEL
USE MODD_SNOW_PAR, ONLY : XANSMIN, XANSMAX, XRHOSMAX
USE MODD_CSTS, ONLY : XTT
!
@@ -53,17 +47,15 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
- CHARACTER(LEN=10), INTENT(IN) :: HSURF ! type of field
- CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+CHARACTER(LEN=10), INTENT(IN) :: HSURF ! type of field
+CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file
INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
INTEGER, INTENT(IN) :: KLAYER ! Number of layer of output snow scheme
REAL,DIMENSION(:,:,:), POINTER :: PFIELD ! field to interpolate horizontally
!
!* 0.2 declarations of local variables
!
-TYPE (DATE_TIME) :: TZTIME_GRIB ! current date and time
- CHARACTER(LEN=6) :: YINMODEL ! model from which GRIB file originates
REAL, DIMENSION(:) , POINTER :: ZMASK => NULL() ! Land mask
REAL, DIMENSION(:), POINTER :: ZFIELD1D => NULL() ! field read
REAL, DIMENSION(:), POINTER :: ZHEAT => NULL() ! heat in snow
@@ -81,9 +73,7 @@ IF (LHOOK) CALL DR_HOOK('PREP_SNOW_GRIB',0,ZHOOK_HANDLE)
!
IF (TRIM(HFILE).NE.CGRIB_FILE) CGRIB_FILE=""
!
- CALL PREP_GRIB_GRID(HFILE,KLUOUT,YINMODEL,CINGRID_TYPE,TZTIME_GRIB)
-!
- CALL READ_GRIB_LAND_MASK(HFILE,KLUOUT,YINMODEL,ZMASK)
+ CALL READ_GRIB_LAND_MASK(HFILE,KLUOUT,CINMODEL,ZMASK)
!
!-------------------------------------------------------------------------------------
!
@@ -94,11 +84,11 @@ IF (HSURF(7:8)=='RO') THEN
!
SELECT CASE(HSURF(1:3))
CASE('DEP')
- ALLOCATE(PFIELD(NNI,KLAYER,1))
+ ALLOCATE(PFIELD(NNI,1,1))
CASE('ALB','WWW')
ALLOCATE(PFIELD(NNI,1,1))
CASE('HEA','RHO')
- ALLOCATE(PFIELD(NNI,NGRID_LEVEL,1))
+ ALLOCATE(PFIELD(NNI,1,1))
END SELECT
!
PFIELD(:,:,:) = 0.
@@ -115,24 +105,20 @@ ELSE
!* 3.1 Total snow content (kg/m2)
!
CASE('WWW')
- CALL READ_GRIB_SNOW_VEG_AND_DEPTH(HFILE,KLUOUT,YINMODEL,ZMASK,PSNV=ZFIELD1D)
+ CALL READ_GRIB_SNOW_VEG_AND_DEPTH(HFILE,KLUOUT,CINMODEL,ZMASK,PSNV=ZFIELD1D)
!
- ALLOCATE(PFIELD(SIZE(ZFIELD1D),1,NVEGTYPE))
- DO JVEGTYPE=1,NVEGTYPE
- PFIELD(:,1,JVEGTYPE)=ZFIELD1D(:)
- END DO
+ ALLOCATE(PFIELD(SIZE(ZFIELD1D),1,1))
+ PFIELD(:,1,1)=ZFIELD1D(:)
DEALLOCATE(ZFIELD1D)
!
!
!* 3.2 Total snow depth (m)
!
CASE('DEP')
- CALL READ_GRIB_SNOW_VEG_AND_DEPTH(HFILE,KLUOUT,YINMODEL,ZMASK,PSNVD=ZFIELD1D)
+ CALL READ_GRIB_SNOW_VEG_AND_DEPTH(HFILE,KLUOUT,CINMODEL,ZMASK,PSNVD=ZFIELD1D)
!
- ALLOCATE(PFIELD(SIZE(ZFIELD1D),KLAYER,NVEGTYPE))
- DO JVEGTYPE=1,NVEGTYPE
- CALL SNOW3LGRID(PFIELD(:,:,JVEGTYPE),ZFIELD1D(:))
- END DO
+ ALLOCATE(PFIELD(SIZE(ZFIELD1D),1,1))
+ PFIELD(:,1,1)=ZFIELD1D(:)
DEALLOCATE(ZFIELD1D)
!
!
@@ -140,67 +126,51 @@ ELSE
!
CASE('HEA')
!* read temperature
- CALL READ_GRIB_TS(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD1D)
+ CALL READ_GRIB_TS(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD1D)
WHERE (ZFIELD1D/=XUNDEF) ZFIELD1D(:) = MIN(ZFIELD1D,XTT)
- !* assumes no liquid water in the snow
- ALLOCATE(ZHEAT(SIZE(ZFIELD1D)))
- CALL READ_GRIB_SNOW_DEN(HFILE,KLUOUT,YINMODEL,ZMASK,ZRHO)
- WHERE(ZFIELD1D(:)==XUNDEF)ZRHO(:)=XUNDEF
- !
- CALL SNOW_T_WLIQ_TO_HEAT(ZHEAT,ZRHO,ZFIELD1D)
!
- ALLOCATE(PFIELD(SIZE(ZFIELD1D),NGRID_LEVEL,NVEGTYPE))
- DO JVEGTYPE=1,NVEGTYPE
- DO JLAYER=1,NGRID_LEVEL
- PFIELD(:,JLAYER,JVEGTYPE)=ZHEAT(:)
- END DO
- END DO
+ ALLOCATE(PFIELD(SIZE(ZFIELD1D),1,1))
+ PFIELD(:,1,1)=ZFIELD1D(:)
DEALLOCATE(ZFIELD1D)
- DEALLOCATE(ZHEAT )
- DEALLOCATE(ZRHO )
!
!* 3.4 Albedo
!
CASE('ALB')
- CALL READ_GRIB_SNOW_ALB(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD1D)
- ALLOCATE(PFIELD(SIZE(ZFIELD1D),1,NVEGTYPE))
- DO JVEGTYPE=1,NVEGTYPE
- PFIELD(:,1,JVEGTYPE)=ZFIELD1D(:)
- END DO
+ CALL READ_GRIB_SNOW_ALB(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD1D)
+ ALLOCATE(PFIELD(SIZE(ZFIELD1D),1,1))
+ PFIELD(:,1,1)=ZFIELD1D(:)
DEALLOCATE(ZFIELD1D)
!
!* 3.5 Density
!
CASE('RHO')
- CALL READ_GRIB_SNOW_DEN(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD1D)
- ALLOCATE(PFIELD(SIZE(ZFIELD1D),1,NVEGTYPE))
- DO JVEGTYPE=1,NVEGTYPE
- PFIELD(:,1,JVEGTYPE)=ZFIELD1D(:)
- END DO
+ CALL READ_GRIB_SNOW_DEN(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD1D)
+ ALLOCATE(PFIELD(SIZE(ZFIELD1D),1,1))
+ PFIELD(:,1,1)=ZFIELD1D(:)
DEALLOCATE(ZFIELD1D)
!
!* 3.6 SG1: initial grain is partially rounded
!
CASE('SG1')
- ALLOCATE(PFIELD(NNI,NGRID_LEVEL,NVEGTYPE))
+ ALLOCATE(PFIELD(NNI,1,1))
PFIELD = -20
!
!* 3.7 SG2: initial grain is partially rounded
!
CASE('SG2')
- ALLOCATE(PFIELD(NNI,NGRID_LEVEL,NVEGTYPE))
+ ALLOCATE(PFIELD(NNI,1,1))
PFIELD = 80
!
!* 3.8 AGE: snow is 3-days old
!
CASE('AGE')
- ALLOCATE(PFIELD(NNI,NGRID_LEVEL,NVEGTYPE))
+ ALLOCATE(PFIELD(NNI,1,1))
PFIELD = 3
!
!* 3.9 HIS: 0 by default
!
CASE('HIS')
- ALLOCATE(PFIELD(NNI,NGRID_LEVEL,NVEGTYPE))
+ ALLOCATE(PFIELD(NNI,1,1))
PFIELD = 0
!
END SELECT
@@ -213,8 +183,6 @@ DEALLOCATE(ZMASK)
!
!* 4. Interpolation method
! --------------------
-!
- CINTERP_TYPE='HORIBL'
!
IF (LHOOK) CALL DR_HOOK('PREP_SNOW_GRIB',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/prep_snow_unif.F90 b/src/SURFEX/prep_snow_unif.F90
index 587ba72a72d79a4a351b263ad0cb37375391ace1..086c0c33a5e7a31b785eff5309c59868443a93f7 100644
--- a/src/SURFEX/prep_snow_unif.F90
+++ b/src/SURFEX/prep_snow_unif.F90
@@ -42,11 +42,8 @@ USE MODD_TYPE_DATE_SURF, ONLY : DATE_TIME
!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_PREP, ONLY : CINTERP_TYPE
-USE MODD_PREP_SNOW, ONLY : NGRID_LEVEL
USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
!
-USE MODI_SNOW_T_WLIQ_TO_HEAT
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -88,19 +85,15 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('PREP_SNOW_UNIF',0,ZHOOK_HANDLE)
!
IF (OSNOW_IDEAL) THEN
- ALLOCATE(PFIELD (1,SIZE(PUNIF_WSNOW),NVEGTYPE))
- ALLOCATE(ZTSNOW (1,SIZE(PUNIF_WSNOW),NVEGTYPE))
- ALLOCATE(ZRSNOW (1,SIZE(PUNIF_WSNOW),NVEGTYPE))
- ALLOCATE(ZLWCSNOW(1,SIZE(PUNIF_WSNOW),NVEGTYPE))
+ ALLOCATE(PFIELD (1,SIZE(PUNIF_WSNOW),1))
+ ALLOCATE(ZTSNOW (1,SIZE(PUNIF_WSNOW),1))
+ ALLOCATE(ZRSNOW (1,SIZE(PUNIF_WSNOW),1))
+ ALLOCATE(ZLWCSNOW(1,SIZE(PUNIF_WSNOW),1))
ELSE
- IF(HSURF(1:3)=='DEP')THEN
- ALLOCATE(PFIELD(1,KLAYER,NVEGTYPE))
- ELSE
- ALLOCATE(PFIELD(1,NGRID_LEVEL,NVEGTYPE))
- ENDIF
- ALLOCATE(ZTSNOW (1,NGRID_LEVEL,NVEGTYPE))
- ALLOCATE(ZRSNOW (1,NGRID_LEVEL,NVEGTYPE))
- ALLOCATE(ZLWCSNOW(1,NGRID_LEVEL,NVEGTYPE))
+ ALLOCATE(PFIELD (1,1,1))
+ ALLOCATE(ZTSNOW (1,1,1))
+ ALLOCATE(ZRSNOW (1,1,1))
+ ALLOCATE(ZLWCSNOW(1,1,1))
ENDIF
!
!* 1. No snow
@@ -118,105 +111,67 @@ SELECT CASE(HSURF(1:3))
!
CASE('WWW')
IF (OSNOW_IDEAL) THEN
- DO JVEGTYPE=1,NVEGTYPE
- PFIELD(1,:,JVEGTYPE) = PUNIF_WSNOW(:)
- ENDDO
+ PFIELD(1,:,1) = PUNIF_WSNOW(:)
ELSE
- DO JVEGTYPE=1,NVEGTYPE
- PFIELD(1,:,JVEGTYPE) = PUNIF_WSNOW(1)
- ENDDO
+ PFIELD(1,:,1) = PUNIF_WSNOW(1)
ENDIF
!
CASE('DEP')
IF (OSNOW_IDEAL) THEN
- DO JVEGTYPE=1,NVEGTYPE
- PFIELD(1,:,JVEGTYPE) = PUNIF_WSNOW(:)/PUNIF_RSNOW(:)
- ENDDO
+ PFIELD(1,:,1) = PUNIF_WSNOW(:)/PUNIF_RSNOW(:)
ELSE
IF(PUNIF_RSNOW(1)>0.0)THEN
ZD(1)=PUNIF_WSNOW(1)/PUNIF_RSNOW(1)
ELSE
ZD(1)=0.0
ENDIF
- DO JVEGTYPE=1,NVEGTYPE
- CALL SNOW3LGRID(PFIELD(:,:,JVEGTYPE),ZD(:))
- ENDDO
+ CALL SNOW3LGRID(PFIELD(:,:,1),ZD(:))
ENDIF
!
CASE('RHO')
IF (OSNOW_IDEAL) THEN
- DO JVEGTYPE=1,NVEGTYPE
- PFIELD(1,:,JVEGTYPE) = PUNIF_RSNOW(:)
- ENDDO
+ PFIELD(1,:,1) = PUNIF_RSNOW(:)
ELSE
- DO JVEGTYPE=1,NVEGTYPE
- PFIELD(1,:,JVEGTYPE) = PUNIF_RSNOW(1)
- ENDDO
+ PFIELD(1,:,1) = PUNIF_RSNOW(1)
ENDIF
!
CASE('ALB')
- DO JVEGTYPE=1,NVEGTYPE
- PFIELD(1,:,JVEGTYPE) = PUNIF_ASNOW
- ENDDO
-!
+ PFIELD(1,:,1) = PUNIF_ASNOW
+!n
CASE('HEA')
IF (OSNOW_IDEAL) THEN
- DO JVEGTYPE=1,NVEGTYPE
- ZRSNOW (1,:,JVEGTYPE) = PUNIF_RSNOW(:)
- ZTSNOW (1,:,JVEGTYPE) = PUNIF_TSNOW(:)
- ZLWCSNOW(1,:,JVEGTYPE) = PUNIF_LWCSNOW(:) ! kg/m3
- ENDDO
+ PFIELD(1,:,1) = PUNIF_TSNOW(:)
ELSE
- DO JVEGTYPE=1,NVEGTYPE
- ZRSNOW (1,:,JVEGTYPE) = PUNIF_RSNOW (1)
- ZTSNOW (1,:,JVEGTYPE) = PUNIF_TSNOW (1)
- ZLWCSNOW(1,:,JVEGTYPE) = PUNIF_LWCSNOW(1) ! kg/m3
- ENDDO
- ENDIF
- CALL SNOW_T_WLIQ_TO_HEAT(PFIELD,ZRSNOW,ZTSNOW,ZLWCSNOW)
+ PFIELD(1,:,1) = PUNIF_TSNOW(1)
+ ENDIF
+
!
CASE('SG1')
IF (OSNOW_IDEAL) THEN
- DO JVEGTYPE=1,NVEGTYPE
- PFIELD(1,:,JVEGTYPE) = PUNIF_SG1SNOW(:)
- ENDDO
+ PFIELD(1,:,1) = PUNIF_SG1SNOW(:)
ELSE
- DO JVEGTYPE=1,NVEGTYPE
- PFIELD(1,:,JVEGTYPE) = PUNIF_SG1SNOW(1)
- ENDDO
+ PFIELD(1,:,1) = PUNIF_SG1SNOW(1)
ENDIF
!
CASE('SG2')
IF (OSNOW_IDEAL) THEN
- DO JVEGTYPE=1,NVEGTYPE
- PFIELD(1,:,JVEGTYPE) = PUNIF_SG2SNOW(:)
- ENDDO
+ PFIELD(1,:,1) = PUNIF_SG2SNOW(:)
ELSE
- DO JVEGTYPE=1,NVEGTYPE
- PFIELD(1,:,JVEGTYPE) = PUNIF_SG2SNOW(1)
- ENDDO
+ PFIELD(1,:,1) = PUNIF_SG2SNOW(1)
ENDIF
!
CASE('HIS')
IF (OSNOW_IDEAL) THEN
- DO JVEGTYPE=1,NVEGTYPE
- PFIELD(1,:,JVEGTYPE) = PUNIF_HISTSNOW(:)
- ENDDO
+ PFIELD(1,:,1) = PUNIF_HISTSNOW(:)
ELSE
- DO JVEGTYPE=1,NVEGTYPE
- PFIELD(1,:,JVEGTYPE) = PUNIF_HISTSNOW(1)
- ENDDO
+ PFIELD(1,:,1) = PUNIF_HISTSNOW(1)
ENDIF
!
CASE('AGE')
IF (OSNOW_IDEAL) THEN
- DO JVEGTYPE=1,NVEGTYPE
- PFIELD(1,:,JVEGTYPE) = PUNIF_AGESNOW(:)
- ENDDO
+ PFIELD(1,:,1) = PUNIF_AGESNOW(:)
ELSE
- DO JVEGTYPE=1,NVEGTYPE
- PFIELD(1,:,JVEGTYPE) = PUNIF_AGESNOW(1)
- ENDDO
+ PFIELD(1,:,1) = PUNIF_AGESNOW(1)
ENDIF
!
END SELECT
@@ -224,7 +179,7 @@ END SELECT
!* 2. Interpolation method
! --------------------
!
- CINTERP_TYPE='UNIF '
+CINTERP_TYPE='UNIF '
DEALLOCATE(ZTSNOW)
DEALLOCATE(ZRSNOW)
DEALLOCATE(ZLWCSNOW)
diff --git a/src/SURFEX/prep_sst_init.F90 b/src/SURFEX/prep_sst_init.F90
index c1e39db5d4c8f3bb9206198316d466614ee3c791..3e4b1bfdf84a165cf5fd78018b72bb85d3428d89 100644
--- a/src/SURFEX/prep_sst_init.F90
+++ b/src/SURFEX/prep_sst_init.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PREP_SST_INIT (DTS, S, &
- PSST)
+ SUBROUTINE PREP_SST_INIT (DTS, TPTIME, KSX, PSST)
! ###############################################################
!!**** *SST_UPDATE*
!!
@@ -43,9 +42,9 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TYPE_DATE_SURF, ONLY : DATE_TIME
!
USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_t
-USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
!
USE MODD_TYPE_DATE_SURF
USE MODI_TEMPORAL_DISTS
@@ -60,9 +59,10 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-!
TYPE(DATA_SEAFLUX_t), INTENT(INOUT) :: DTS
-TYPE(SEAFLUX_t), INTENT(INOUT) :: S
+!
+TYPE(DATE_TIME), INTENT(IN) :: TPTIME
+INTEGER, INTENT(INOUT) :: KSX
!
REAL, DIMENSION(:), INTENT(INOUT) :: PSST ! sst
!
@@ -81,31 +81,31 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PREP_SST_INIT',0,ZHOOK_HANDLE)
LOOP: DO JI = DTS%NTIME-1,1,-1
- S%JSX = JI
- IF (.NOT.TEMPORAL_LTS(S%TTIME,DTS%TDATA_SST(S%JSX))) EXIT LOOP
+ KSX = JI
+ IF (.NOT.TEMPORAL_LTS(TPTIME,DTS%TDATA_SST(KSX))) EXIT LOOP
ENDDO LOOP
-IF ( TEMPORAL_LTS ( S%TTIME, DTS%TDATA_SST(S%JSX) ) ) THEN
- ZSST(:) = DTS%XDATA_SST(:,S%JSX)
-ELSE IF ( .NOT. TEMPORAL_LTS ( S%TTIME, DTS%TDATA_SST(DTS%NTIME) ) ) THEN
+IF ( TEMPORAL_LTS ( TPTIME, DTS%TDATA_SST(KSX) ) ) THEN
+ ZSST(:) = DTS%XDATA_SST(:,KSX)
+ELSE IF ( .NOT. TEMPORAL_LTS ( TPTIME, DTS%TDATA_SST(DTS%NTIME) ) ) THEN
ZSST(:) = DTS%XDATA_SST(:,DTS%NTIME)
ELSE
- CALL TEMPORAL_DISTS ( DTS%TDATA_SST(S%JSX+1)%TDATE%YEAR,DTS%TDATA_SST(S%JSX+1)%TDATE%MONTH, &
- DTS%TDATA_SST(S%JSX+1)%TDATE%DAY ,DTS%TDATA_SST(S%JSX+1)%TIME, &
- DTS%TDATA_SST(S%JSX)%TDATE%YEAR,DTS%TDATA_SST(S%JSX)%TDATE%MONTH, &
- DTS%TDATA_SST(S%JSX)%TDATE%DAY ,DTS%TDATA_SST(S%JSX)%TIME, &
- ZSDTJX )
+ CALL TEMPORAL_DISTS ( DTS%TDATA_SST(KSX+1)%TDATE%YEAR,DTS%TDATA_SST(KSX+1)%TDATE%MONTH, &
+ DTS%TDATA_SST(KSX+1)%TDATE%DAY ,DTS%TDATA_SST(KSX+1)%TIME, &
+ DTS%TDATA_SST(KSX)%TDATE%YEAR,DTS%TDATA_SST(KSX)%TDATE%MONTH, &
+ DTS%TDATA_SST(KSX)%TDATE%DAY ,DTS%TDATA_SST(KSX)%TIME, &
+ ZSDTJX )
- CALL TEMPORAL_DISTS ( S%TTIME%TDATE%YEAR ,S%TTIME%TDATE%MONTH, &
- S%TTIME%TDATE%DAY ,S%TTIME%TIME, &
- DTS%TDATA_SST(S%JSX)%TDATE%YEAR,DTS%TDATA_SST(S%JSX)%TDATE%MONTH, &
- DTS%TDATA_SST(S%JSX)%TDATE%DAY ,DTS%TDATA_SST(S%JSX)%TIME, &
- ZDT )
+ CALL TEMPORAL_DISTS ( TPTIME%TDATE%YEAR ,TPTIME%TDATE%MONTH, &
+ TPTIME%TDATE%DAY ,TPTIME%TIME, &
+ DTS%TDATA_SST(KSX)%TDATE%YEAR,DTS%TDATA_SST(KSX)%TDATE%MONTH, &
+ DTS%TDATA_SST(KSX)%TDATE%DAY ,DTS%TDATA_SST(KSX)%TIME, &
+ ZDT )
!
ZALPHA = ZDT / ZSDTJX
!
- ZSST(:)= DTS%XDATA_SST(:,S%JSX)+(DTS%XDATA_SST(:,S%JSX+1)-DTS%XDATA_SST(:,S%JSX))*ZALPHA
+ ZSST(:)= DTS%XDATA_SST(:,KSX)+(DTS%XDATA_SST(:,KSX+1)-DTS%XDATA_SST(:,KSX))*ZALPHA
END IF
diff --git a/src/SURFEX/prep_surf_atm.F90 b/src/SURFEX/prep_surf_atm.F90
index b9d39135a05416e0a9bb6947f9f9bc6fe98d581a..1cfe780133fdb8abae002c23da7221c093d8726f 100644
--- a/src/SURFEX/prep_surf_atm.F90
+++ b/src/SURFEX/prep_surf_atm.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #################################################################################
-SUBROUTINE PREP_SURF_ATM (YSC, &
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+SUBROUTINE PREP_SURF_ATM (YSC, HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
! #################################################################################
!
!!**** *PREP_SURF_ATM* - driver for surface fields preparation
@@ -27,12 +26,13 @@ SUBROUTINE PREP_SURF_ATM (YSC, &
!! -------------
!! Original 01/2004
!! P. Le Moigne 10/2005, Phasage Arome
+!! P. Marguinaud10/2014, Support for a 2-part PREP
!!------------------------------------------------------------------
-!
-
!
USE MODD_SURFEX_n, ONLY : SURFEX_t
!
+USE MODE_PREP_CTL, ONLY : PREP_CTL
+!
USE MODI_PREP_NATURE
USE MODI_PREP_SEA
USE MODI_PREP_INLAND_WATER
@@ -50,6 +50,7 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
TYPE(SURFEX_t), INTENT(INOUT) :: YSC
+TYPE (PREP_CTL), INTENT(INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! name of the Atmospheric file
@@ -94,36 +95,35 @@ ELSE
YPGDFILETYPE=' '
ENDIF
!
+IF (ASSOCIATED(YSC%U%XCOVER)) DEALLOCATE(YSC%U%XCOVER)
+!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! SEA Tile calculations:
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-IF(YSC%U%NDIM_SEA>0) CALL PREP_SEA(YSC%DTCO, YSC%UG, YSC%U, YSC%SM,YSC%GCP, &
- HPROGRAM,YATMFILE,YATMFILETYPE,YPGDFILE,YPGDFILETYPE)
+IF(YSC%U%NDIM_SEA>0) CALL PREP_SEA(YSC%DTCO, YSC%UG, YSC%U, YSC%GCP, YSC%SM, &
+ HPROGRAM,YATMFILE,YATMFILETYPE,YPGDFILE,YPGDFILETYPE,YDCTL)
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! INLAND WATER Tile calculations:
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-IF(YSC%U%NDIM_WATER>0) CALL PREP_INLAND_WATER(YSC%DTCO, YSC%USS, &
- YSC%UG, YSC%U, YSC%FM, YSC%WM,YSC%GCP, &
- HPROGRAM,YATMFILE,YATMFILETYPE,YPGDFILE,YPGDFILETYPE)
+IF(YSC%U%NDIM_WATER>0) CALL PREP_INLAND_WATER(YSC%DTCO, YSC%USS, YSC%UG, YSC%U, YSC%GCP, YSC%FM, YSC%WM, &
+ HPROGRAM,YATMFILE,YATMFILETYPE,YPGDFILE,YPGDFILETYPE,YDCTL)
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! NATURAL SURFACE Tile calculations:
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-IF(YSC%U%NDIM_NATURE>0) CALL PREP_NATURE(YSC%DTCO, YSC%IM%ICP, YSC%IM%IG, &
- YSC%IM%I, YSC%UG, YSC%U,YSC%USS,YSC%GCP, &
- HPROGRAM,YATMFILE,YATMFILETYPE,YPGDFILE,YPGDFILETYPE)
+IF(YSC%U%NDIM_NATURE>0) CALL PREP_NATURE(YSC%DTCO, YSC%IM, YSC%UG, YSC%U, YSC%USS, YSC%GCP, &
+ HPROGRAM,YATMFILE,YATMFILETYPE,YPGDFILE,YPGDFILETYPE,YDCTL)
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! URBAN Tile calculations:
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-IF(YSC%U%NDIM_TOWN>0) CALL PREP_TOWN(YSC%DTCO, YSC%UG, YSC%U, YSC%USS, &
- YSC%IM%IG, YSC%IM%I, YSC%TM, YSC%GDM, YSC%GRM,YSC%GCP, &
- HPROGRAM,YATMFILE,YATMFILETYPE,YPGDFILE,YPGDFILETYPE)
+IF(YSC%U%NDIM_TOWN>0) CALL PREP_TOWN(YSC%DTCO, YSC%UG, YSC%U, YSC%USS, YSC%GCP, YSC%TM, YSC%GDM, YSC%GRM, &
+ HPROGRAM,YATMFILE,YATMFILETYPE,YPGDFILE,YPGDFILETYPE,YDCTL)
!
CALL CLEAR_GRIB_INDEX
!
diff --git a/src/SURFEX/prep_teb.F90 b/src/SURFEX/prep_teb.F90
index e36c6681e2a27f7c50c13d0d8178407eca5d44f4..e28ca515c2033f4d81b97e6acff7cd3ba5180bf0 100644
--- a/src/SURFEX/prep_teb.F90
+++ b/src/SURFEX/prep_teb.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_TEB (DTCO, UG, U, USS, IG, I, TM, GDM, GRM,GCP, &
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+SUBROUTINE PREP_TEB (DTCO, UG, U, USS, GCP, TOP, BOP, NB, TG, SB, NT, GDM, GRM, &
+ HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
! #################################################################################
!
!!**** *PREP_TEB* - prepares TEB fields
@@ -27,28 +27,32 @@ SUBROUTINE PREP_TEB (DTCO, UG, U, USS, IG, I, TM, GDM, GRM,GCP, &
!! -------------
!! Original 01/2004
!! S. Riette 06/2009 PREP_TEB_CANOPY has no more argument
+!! P. Marguinaud10/2014, Support for a 2-part PREP
!!------------------------------------------------------------------
!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_SURFEX_n, ONLY : TEB_MODEL_t
-USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t
-USE MODD_SURFEX_n, ONLY : TEB_GREENROOF_MODEL_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
+!
+USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
+USE MODD_BEM_OPTION_n, ONLY : BEM_OPTIONS_t
+USE MODD_BEM_n, ONLY : BEM_NP_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_CANOPY_n, ONLY : CANOPY_t
+USE MODD_TEB_n, ONLY : TEB_NP_t
+USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t, TEB_GREENROOF_MODEL_t
+!
+USE MODE_PREP_CTL, ONLY : PREP_CTL
!
USE MODI_PREP_HOR_TEB_FIELD
USE MODI_PREP_VER_TEB
USE MODI_PREP_OUTPUT_GRID
USE MODI_GET_LUOUT
-USE MODI_PREP_TEB_CANOPY
+USE MODI_PREP_SBL
USE MODI_PREP_TEB_GARDEN
USE MODI_PREP_TEB_GREENROOF
-USE MODI_GOTO_WRAPPER_TEB_PATCH
!
USE MODN_PREP_TEB
!
@@ -64,8 +68,6 @@ USE MODD_PREP_TEB_GREENROOF, ONLY : XWSNOW_GR, XRSNOW_GR, XTSNOW_GR, XLWCSNOW_GR
!
USE MODD_SURF_ATM, ONLY : LVERTSHIFT
!
-!
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -79,13 +81,19 @@ IMPLICIT NONE
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM
+TYPE(SSO_t), INTENT(INOUT) :: USS
+TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
+TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+TYPE(BEM_OPTIONS_t), INTENT(INOUT) :: BOP
+TYPE(BEM_NP_t), INTENT(INOUT) :: NB
+TYPE(GRID_t), INTENT(INOUT) :: TG
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
+TYPE(TEB_NP_t), INTENT(INOUT) :: NT
TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM
-TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
+TYPE (PREP_CTL), INTENT(INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! name of the Atmospheric file
@@ -96,7 +104,7 @@ TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!* 0.2 declarations of local variables
!
INTEGER :: ILUOUT
-INTEGER :: JPATCH ! TEB patch number
+INTEGER :: JP ! TEB patch number
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
!
@@ -106,90 +114,90 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('PREP_TEB',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
- CALL PREP_OUTPUT_GRID(UG, U, &
- ILUOUT,TM%TG%CGRID,TM%TG%XGRID_PAR,TM%TG%XLAT,TM%TG%XLON)
+ CALL PREP_OUTPUT_GRID(UG%G, TG, U%NSIZE_FULL, ILUOUT)
!
!-------------------------------------------------------------------------------------
!
!* 2. Reading and horizontal interpolations
!
!
-!* 2.0 Large scale orography
-!
- CALL PREP_HOR_TEB_FIELD(TM%B, TM%BOP, DTCO, IG, U, TM%TG, TM%T, TM%TOP,GCP, &
- HPROGRAM,'ZS ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,1)
!
!* option for roads
!
-TM%TOP%CROAD_DIR = CROAD_DIR
-TM%TOP%CWALL_OPT = CWALL_OPT
+TOP%CROAD_DIR = CROAD_DIR
+TOP%CWALL_OPT = CWALL_OPT
!
-DO JPATCH=1,TM%TOP%NTEB_PATCH
+DO JP=1,TOP%NTEB_PATCH
+ !
+ !* 2.0 Large scale orography
!
- CALL GOTO_WRAPPER_TEB_PATCH(TM%B, TM%DGCT, TM%DGMT, TM%T, &
- GDM%TGD, GDM%TGDPE, GRM%TGR, GRM%TGRPE, JPATCH)
+ IF (JP==1) &
+ CALL PREP_HOR_TEB_FIELD(NB%AL(JP), BOP, DTCO, U, GCP, TG, NT%AL(JP), TOP, &
+ HPROGRAM,'ZS ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,1,YDCTL)
+
+
!* 2.1 Water reservoirs
!
- CALL PREP_HOR_TEB_FIELD(TM%B, TM%BOP, DTCO, IG, U, TM%TG, TM%T, TM%TOP,GCP, &
- HPROGRAM,'WS_ROOF',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JPATCH)
- CALL PREP_HOR_TEB_FIELD(TM%B, TM%BOP, DTCO, IG, U, TM%TG, TM%T, TM%TOP,GCP, &
- HPROGRAM,'WS_ROAD',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JPATCH)
+ CALL PREP_HOR_TEB_FIELD(NB%AL(JP), BOP, DTCO, U, GCP, TG, NT%AL(JP), TOP, &
+ HPROGRAM,'WS_ROOF',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JP,YDCTL)
+ CALL PREP_HOR_TEB_FIELD(NB%AL(JP), BOP, DTCO, U, GCP, TG, NT%AL(JP), TOP, &
+ HPROGRAM,'WS_ROAD',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JP,YDCTL)
!
!* 2.2 Building temperature
!
- CALL PREP_HOR_TEB_FIELD(TM%B, TM%BOP, DTCO, IG, U, TM%TG, TM%T, TM%TOP,GCP, &
- HPROGRAM,'TI_BLD ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JPATCH)
+ CALL PREP_HOR_TEB_FIELD(NB%AL(JP), BOP, DTCO, U, GCP, TG, NT%AL(JP), TOP, &
+ HPROGRAM,'TI_BLD ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JP,YDCTL)
!
!* 2.3 Road deep temperature
!
- CALL PREP_HOR_TEB_FIELD(TM%B, TM%BOP, DTCO, IG, U, TM%TG, TM%T, TM%TOP,GCP, &
- HPROGRAM,'TI_ROAD',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JPATCH)
+ CALL PREP_HOR_TEB_FIELD(NB%AL(JP), BOP, DTCO, U, GCP, TG, NT%AL(JP), TOP, &
+ HPROGRAM,'TI_ROAD',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JP,YDCTL)
!
!* 2.4 Temperature profiles
!
- CALL PREP_HOR_TEB_FIELD(TM%B, TM%BOP, DTCO, IG, U, TM%TG, TM%T, TM%TOP,GCP, &
- HPROGRAM,'T_ROAD ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JPATCH)
- CALL PREP_HOR_TEB_FIELD(TM%B, TM%BOP, DTCO, IG, U, TM%TG, TM%T, TM%TOP,GCP, &
- HPROGRAM,'T_WALLA',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JPATCH)
- CALL PREP_HOR_TEB_FIELD(TM%B, TM%BOP, DTCO, IG, U, TM%TG, TM%T, TM%TOP,GCP, &
- HPROGRAM,'T_WALLB',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JPATCH)
- CALL PREP_HOR_TEB_FIELD(TM%B, TM%BOP, DTCO, IG, U, TM%TG, TM%T, TM%TOP,GCP, &
- HPROGRAM,'T_ROOF ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JPATCH)
- !
- CALL PREP_HOR_TEB_FIELD(TM%B, TM%BOP, DTCO, IG, U, TM%TG, TM%T, TM%TOP,GCP, &
- HPROGRAM,'T_WIN1 ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JPATCH)
- IF (TM%TOP%CBEM == 'BEM') THEN
- CALL PREP_HOR_TEB_FIELD(TM%B, TM%BOP, DTCO, IG, U, TM%TG, TM%T, TM%TOP,GCP, &
- HPROGRAM,'QI_BLD ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JPATCH)
- CALL PREP_HOR_TEB_FIELD(TM%B, TM%BOP, DTCO, IG, U, TM%TG, TM%T, TM%TOP,GCP, &
- HPROGRAM,'T_WIN2 ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JPATCH)
- CALL PREP_HOR_TEB_FIELD(TM%B, TM%BOP, DTCO, IG, U, TM%TG, TM%T, TM%TOP,GCP, &
- HPROGRAM,'T_FLOOR',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JPATCH)
- CALL PREP_HOR_TEB_FIELD(TM%B, TM%BOP, DTCO, IG, U, TM%TG, TM%T, TM%TOP,GCP, &
- HPROGRAM,'T_MASS ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JPATCH)
+ CALL PREP_HOR_TEB_FIELD(NB%AL(JP), BOP, DTCO, U, GCP, TG, NT%AL(JP), TOP, &
+ HPROGRAM,'T_ROAD ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JP,YDCTL)
+ CALL PREP_HOR_TEB_FIELD(NB%AL(JP), BOP, DTCO, U, GCP, TG, NT%AL(JP), TOP, &
+ HPROGRAM,'T_WALLA',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JP,YDCTL)
+ CALL PREP_HOR_TEB_FIELD(NB%AL(JP), BOP, DTCO, U, GCP, TG, NT%AL(JP), TOP, &
+ HPROGRAM,'T_WALLB',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JP,YDCTL)
+ CALL PREP_HOR_TEB_FIELD(NB%AL(JP), BOP, DTCO, U, GCP, TG, NT%AL(JP), TOP, &
+ HPROGRAM,'T_ROOF ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JP,YDCTL)
+ !
+ CALL PREP_HOR_TEB_FIELD(NB%AL(JP), BOP, DTCO, U, GCP, TG, NT%AL(JP), TOP, &
+ HPROGRAM,'T_WIN1 ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JP,YDCTL)
+ IF (TOP%CBEM == 'BEM') THEN
+ CALL PREP_HOR_TEB_FIELD(NB%AL(JP), BOP, DTCO, U, GCP, TG, NT%AL(JP), TOP, &
+ HPROGRAM,'QI_BLD ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JP,YDCTL)
+ CALL PREP_HOR_TEB_FIELD(NB%AL(JP), BOP, DTCO, U, GCP, TG, NT%AL(JP), TOP, &
+ HPROGRAM,'T_WIN2 ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JP,YDCTL)
+ CALL PREP_HOR_TEB_FIELD(NB%AL(JP), BOP, DTCO, U, GCP, TG, NT%AL(JP), TOP, &
+ HPROGRAM,'T_FLOOR',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JP,YDCTL)
+ CALL PREP_HOR_TEB_FIELD(NB%AL(JP), BOP, DTCO, U, GCP, TG, NT%AL(JP), TOP, &
+ HPROGRAM,'T_MASS ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JP,YDCTL)
ENDIF
!* 2.5 Snow variables
!
- TM%T%CUR%TSNOW_ROOF%SCHEME='1-L'
- CALL PREP_HOR_TEB_FIELD(TM%B, TM%BOP, DTCO, IG, U, TM%TG, TM%T, TM%TOP,GCP, &
- HPROGRAM,'SN_ROOF',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JPATCH)
- TM%T%CUR%TSNOW_ROAD%SCHEME='1-L'
- CALL PREP_HOR_TEB_FIELD(TM%B, TM%BOP, DTCO, IG, U, TM%TG, TM%T, TM%TOP,GCP, &
- HPROGRAM,'SN_ROAD',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JPATCH)
+ NT%AL(JP)%TSNOW_ROOF%SCHEME='1-L'
+ CALL PREP_HOR_TEB_FIELD(NB%AL(JP), BOP, DTCO, U, GCP, TG, NT%AL(JP), TOP, &
+ HPROGRAM,'SN_ROOF',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JP,YDCTL)
+ NT%AL(JP)%TSNOW_ROAD%SCHEME='1-L'
+ CALL PREP_HOR_TEB_FIELD(NB%AL(JP), BOP, DTCO, U, GCP, TG, NT%AL(JP), TOP, &
+ HPROGRAM,'SN_ROAD',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JP,YDCTL)
!
!* 2.6 Canyon air variables
!
- CALL PREP_HOR_TEB_FIELD(TM%B, TM%BOP, DTCO, IG, U, TM%TG, TM%T, TM%TOP,GCP, &
- HPROGRAM,'T_CAN ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JPATCH)
- CALL PREP_HOR_TEB_FIELD(TM%B, TM%BOP, DTCO, IG, U, TM%TG, TM%T, TM%TOP,GCP, &
- HPROGRAM,'Q_CAN ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JPATCH)
+ CALL PREP_HOR_TEB_FIELD(NB%AL(JP), BOP, DTCO, U, GCP, TG, NT%AL(JP), TOP, &
+ HPROGRAM,'T_CAN ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JP,YDCTL)
+ CALL PREP_HOR_TEB_FIELD(NB%AL(JP), BOP, DTCO, U, GCP, TG, NT%AL(JP), TOP, &
+ HPROGRAM,'Q_CAN ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JP,YDCTL)
!
!-------------------------------------------------------------------------------------
!
!* 3. Vertical interpolations of all variables
!
IF(LVERTSHIFT)THEN
- CALL PREP_VER_TEB(TM%B, TM%T, TM%TOP)
+ CALL PREP_VER_TEB(NB%AL(JP), NT%AL(JP), TOP%XZS, TOP%CBEM)
ENDIF
!
!-------------------------------------------------------------------------------------
@@ -197,13 +205,19 @@ DO JPATCH=1,TM%TOP%NTEB_PATCH
!* 4. Urban green areas
!
- IF (TM%TOP%LGARDEN) CALL PREP_TEB_GARDEN(DTCO, UG, U, USS, IG, I, &
- TM%TG, TM%TOP, GDM,GCP, &
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JPATCH)
- IF (TM%TOP%LGREENROOF) CALL PREP_TEB_GREENROOF(DTCO, UG, U, USS, IG, I, &
- TM%TG, TM%T, TM%TOP, GDM%TVG, GRM,GCP, &
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JPATCH)
- !
+ IF (TOP%LGARDEN) CALL PREP_TEB_GARDEN(DTCO, UG, U, USS, GCP, TG, TOP, &
+ GDM%O, GDM%S, GDM%K, GDM%P, GDM%NPE%AL(JP), &
+ HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JP,YDCTL)
+ IF (TOP%LGREENROOF) THEN
+ CALL PREP_TEB_GREENROOF(DTCO, UG, U, USS, GCP, TG, TOP, GRM%O, GRM%S, GRM%K, GRM%P, GRM%NPE%AL(JP), &
+ HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE, JP,YDCTL)
+ !
+ ! Initializing deep GR temp. with that of the outer layer of the structural roof
+ !
+ GRM%K%XTDEEP(:) = NT%AL(JP)%XT_ROOF(:,1)
+ !
+ ENDIF
+ !
ENDDO
!
DEALLOCATE(XWSNOW_GD,XRSNOW_GD,XTSNOW_GD,XLWCSNOW_GD,XAGESNOW_GD)
@@ -213,15 +227,18 @@ DEALLOCATE(XWSNOW_GR,XRSNOW_GR,XTSNOW_GR,XLWCSNOW_GR,XAGESNOW_GR)
!
!* 5. Preparation of canopy air variables
!
-TM%TOP%LCANOPY = LTEB_CANOPY
-IF (TM%TOP%LCANOPY) CALL PREP_TEB_CANOPY(TM%TCP, TM%TG)
+TOP%LCANOPY = LTEB_CANOPY
+IF (TOP%LCANOPY) CALL PREP_SBL(TG%NDIM, SB)
!
-DEALLOCATE(XZS_LS)
+IF (YDCTL%LPART5) THEN
+ DEALLOCATE(XZS_LS)
+ENDIF
!
!-------------------------------------------------------------------------------------
CALL CLEAN_PREP_OUTPUT_GRID
IF (LHOOK) CALL DR_HOOK('PREP_TEB',1,ZHOOK_HANDLE)
!
+!
!-------------------------------------------------------------------------------------
!
END SUBROUTINE PREP_TEB
diff --git a/src/SURFEX/prep_teb_buffer.F90 b/src/SURFEX/prep_teb_buffer.F90
index 7f86fad2409a876768089e71ddf72fe797b7c5c4..36e887e96f57af99f485cd77c6210503b15c312b 100644
--- a/src/SURFEX/prep_teb_buffer.F90
+++ b/src/SURFEX/prep_teb_buffer.F90
@@ -72,7 +72,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('PREP_TEB_BUFFER',0,ZHOOK_HANDLE)
CALL PREP_BUFFER_GRID(KLUOUT,YINMODEL,TZTIME_BUF)
!
-IF (HSURF=='T_FLOOR' .OR. HSURF=='T_WALL' .OR. HSURF=='T_ROOF' .OR. HSURF=='T_WIN2' .OR. HSURF=='TI_BLD') THEN
+IF (HSURF=='T_FLOOR' .OR. HSURF=='T_WALL ' .OR. HSURF=='T_ROOF ' .OR. HSURF=='T_WIN2 ' .OR. HSURF=='TI_BLD ' .OR. &
+ HSURF=='T_WALLA' .OR. HSURF=='T_WALLB') THEN
ZTI_BLD = XTI_BLD_DEF
IF (XTI_BLD/=XUNDEF) ZTI_BLD=XTI_BLD
ENDIF
@@ -95,7 +96,7 @@ SELECT CASE(HSURF)
!* 3. Profile of temperatures in roads
! --------------------------------
!
- CASE('T_ROAD')
+ CASE('T_ROAD ')
!* reading of the profile and its depth definition
SELECT CASE(YINMODEL)
CASE('ALADIN')
@@ -129,7 +130,7 @@ SELECT CASE(HSURF)
CALL READ_BUFFER_T_TEB(KLUOUT,YINMODEL,ZTI_BLD,ZFIELD,ZD)
CALL TEB_PROFILE_BUFFER(XGRID_WALL)
- CASE('T_WIN1')
+ CASE('T_WIN1 ')
SELECT CASE (YINMODEL)
CASE ('ALADIN')
CALL READ_BUFFER_TS(KLUOUT,YINMODEL,ZFIELD1D)
@@ -141,14 +142,14 @@ SELECT CASE(HSURF)
!* 5. Profile of temperatures in roofs
! --------------------------------
- CASE('T_ROOF')
+ CASE('T_ROOF ')
CALL READ_BUFFER_T_TEB(KLUOUT,YINMODEL,ZTI_BLD,ZFIELD,ZD)
CALL TEB_PROFILE_BUFFER(XGRID_ROOF)
!* 5.bis Profile of temperatures in thermal mass
! -----------------------------------------
!
- CASE('T_MASS')
+ CASE('T_MASS ')
ALLOCATE(PFIELD(NNI,3))
PFIELD(:,:) = ZTI_BLD
CALL TEB_PROFILE_BUFFER(XGRID_FLOOR)
@@ -198,7 +199,7 @@ SELECT CASE(HSURF)
ALLOCATE(PFIELD(NNI,1))
PFIELD(:,:) = ZTI_BLD
!
- CASE('T_WIN2')
+ CASE('T_WIN2 ')
ALLOCATE(PFIELD(NNI,1))
PFIELD(:,:) = ZTI_BLD
@@ -218,13 +219,13 @@ END SELECT
!* 4. Interpolation method
! --------------------
!
- CINTERP_TYPE='BUFFER'
+CINTERP_TYPE='BUFFER'
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PREP_TEB_BUFFER',1,ZHOOK_HANDLE)
- CONTAINS
+CONTAINS
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_teb_extern.F90 b/src/SURFEX/prep_teb_extern.F90
index 0d53d1e6afa4cd146e39ddfa2a2f5b3962cd70d5..99da5d3b121432fde259094d8ef90ff349ad0d5a 100644
--- a/src/SURFEX/prep_teb_extern.F90
+++ b/src/SURFEX/prep_teb_extern.F90
@@ -3,21 +3,21 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-!!
-!! MODIFICATIONS
-!! -------------
-!! M.Moge 01/2016 using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads
-!
-SUBROUTINE PREP_TEB_EXTERN (DTCO,GCP, &
+SUBROUTINE PREP_TEB_EXTERN (DTCO, GCP, TOP, BOP, &
HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,KPATCH,PFIELD)
! #################################################################################
!
!
+!! MODIFICATIONS
+!! -------------
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
+USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
+USE MODD_BEM_OPTION_n, ONLY : BEM_OPTIONS_t
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
USE MODD_TYPE_DATE_SURF
!
USE MODI_PREP_GRID_EXTERN
@@ -28,7 +28,7 @@ USE MODI_OPEN_AUX_IO_SURF
USE MODI_CLOSE_AUX_IO_SURF
USE MODI_TOWN_PRESENCE
USE MODI_READ_TEB_PATCH
-USE MODI_READ_SURF_FIELD2D
+USE MODI_MAKE_CHOICE_ARRAY
!
USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
USE MODD_PREP_TEB, ONLY : XGRID_ROAD, XGRID_WALL, XGRID_ROOF, &
@@ -47,6 +47,8 @@ IMPLICIT NONE
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+TYPE(BEM_OPTIONS_t), INTENT(INOUT) :: BOP
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
@@ -62,7 +64,7 @@ REAL,DIMENSION(:,:), POINTER :: PFIELD ! field to interpolate horizontally
!
REAL, DIMENSION(:,:), ALLOCATABLE :: ZFIELD ! field read
REAL, DIMENSION(:,:), ALLOCATABLE :: ZDEPTH ! depth of each layer
-REAL, DIMENSION(:), ALLOCATABLE :: ZDEPTH_TOT ! total depth of surface
+REAL :: ZDEPTH_TOT ! total depth of surface
!
REAL, DIMENSION(:,:), ALLOCATABLE :: ZD ! intermediate array
!
@@ -71,9 +73,9 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZMASK
CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
INTEGER :: IRESP ! reading return code
INTEGER :: ILAYER ! number of layers
-INTEGER :: JLAYER ! loop counter
-INTEGER :: IVERSION ! SURFEX version
-INTEGER :: IBUGFIX ! SURFEX bug version
+INTEGER :: JLAYER, JI ! loop counter
+INTEGER :: IVERSION_PGD, IVERSION_PREP ! SURFEX version
+INTEGER :: IBUGFIX_PGD, IBUGFIX_PREP ! SURFEX bug version
LOGICAL :: GOLD_NAME ! old name flag for temperatures
CHARACTER(LEN=4) :: YWALL_OPT ! option of walls
CHARACTER(LEN=6) :: YSURF ! Surface type
@@ -82,6 +84,7 @@ LOGICAL :: GOLD_NAME ! old name flag for temperatures
!
INTEGER :: INI ! total 1D dimension
!
+LOGICAL :: GDIM
LOGICAL :: GTEB ! flag if TEB fields are present
INTEGER :: IPATCH ! number of soil temperature patches
INTEGER :: ITEB_PATCH! number of TEB patches in file
@@ -99,53 +102,41 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('PREP_TEB_EXTERN',0,ZHOOK_HANDLE)
!
!
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'FULL ')
+ CALL READ_SURF(HFILETYPE,'VERSION',IVERSION_PREP,IRESP,HDIR='-')
+ CALL READ_SURF(HFILETYPE,'BUG',IBUGFIX_PREP,IRESP,HDIR='-')
+ GDIM = (IVERSION_PREP>8 .OR. IVERSION_PREP==8 .AND. IBUGFIX_PREP>0)
+ IF (GDIM) CALL READ_SURF(HFILETYPE,'SPLIT_PATCH',GDIM,IRESP)
+ CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
+ !
!* reading of version of the file being read
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'FULL ')
- CALL READ_SURF(&
- HFILEPGDTYPE,'VERSION',IVERSION,IRESP)
- CALL READ_SURF(&
- HFILEPGDTYPE,'BUG',IBUGFIX,IRESP)
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
-GOLD_NAME=(IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<3))
+CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'FULL ')
+CALL READ_SURF(HFILEPGDTYPE,'VERSION',IVERSION_PGD,IRESP,HDIR='-')
+CALL READ_SURF(HFILEPGDTYPE,'BUG',IBUGFIX_PGD,IRESP,HDIR='-')
!
!-------------------------------------------------------------------------------------
!
!* 2. Reading of grid
! ---------------
!
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'FULL ')
!* reads the grid
- CALL PREP_GRID_EXTERN(GCP,&
- HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
+CALL PREP_GRID_EXTERN(GCP,HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
+!
+IF (NRANK/=NPIO) INI = 0
!
-YRECFM='VERSION'
- CALL READ_SURF(HFILEPGDTYPE,YRECFM,IVERSION,IRESP)
+!* reads if TEB fields exist in the input file
+ CALL TOWN_PRESENCE(HFILEPGDTYPE,GTEB,HDIR='-')
!
ALLOCATE(ZMASK(INI))
-IF (IVERSION>=7) THEN
+IF (IVERSION_PGD>=7.AND.GTEB) THEN
YRECFM='FRAC_TOWN'
CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZMASK,IRESP,HDIR='A')
ELSE
ZMASK(:) = 1.
-ENDIF
+ENDIF
!
-!* reads if TEB fields exist in the input file
- CALL TOWN_PRESENCE(&
- HFILEPGDTYPE,GTEB)
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
!
-IF (.NOT.GOLD_NAME.AND.GTEB) THEN
- YRECFM='BEM'
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'TOWN ')
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,YBEM,IRESP)
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
-ELSE
- YBEM='DEF'
-ENDIF
!---------------------------------------------------------------------------------------
!
!* 3. Orography
@@ -155,10 +146,8 @@ IF (HSURF=='ZS ') THEN
!
ALLOCATE(PFIELD(INI,1))
YRECFM='ZS'
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'FULL ')
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'FULL ')
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='E')
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
!
!---------------------------------------------------------------------------------------
@@ -170,16 +159,21 @@ ELSE
!
IF (GTEB) THEN
!
- CALL READ_TEB_PATCH(&
- HFILEPGD,HFILEPGDTYPE,ITEB_PATCH)
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ')
+ GOLD_NAME=(IVERSION_PGD<7 .OR. (IVERSION_PGD==7 .AND. IBUGFIX_PGD<3))
+ IF (.NOT.GOLD_NAME.AND.GTEB) THEN
+ YRECFM='BEM'
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,YBEM,IRESP,HDIR='-')
+ ELSE
+ YBEM='DEF'
+ ENDIF
+ CALL READ_TEB_PATCH(HFILEPGD,HFILEPGDTYPE,IVERSION_PGD,IBUGFIX_PGD,ITEB_PATCH,HDIR='-')
YPATCH=' '
IF (ITEB_PATCH>1) THEN
WRITE(YPATCH,FMT='(A,I1,A)') 'T',MIN(KPATCH,ITEB_PATCH),'_'
END IF
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
!
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'TOWN ')
-!
!---------------------------------------------------------------------------------------
SELECT CASE(HSURF)
!---------------------------------------------------------------------------------------
@@ -188,13 +182,12 @@ ELSE
! ------------------------------------------------
!
CASE('T_ROAD','T_ROOF','T_WALLA','T_WALLB','T_FLOOR','T_MASS')
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ')
YSURF=HSURF(1:6)
!* reading of number of layers
IF (YSURF=='T_ROAD') YRECFM='ROAD_LAYER'
IF (YSURF=='T_ROOF') YRECFM='ROOF_LAYER'
IF (YSURF=='T_WALL') YRECFM='WALL_LAYER'
- IF (YSURF=='T_WALLA') YRECFM='WALL_LAYER'
- IF (YSURF=='T_WALLB') YRECFM='WALL_LAYER'
IF (YSURF=='T_FLOO' .OR. YSURF=='T_MASS') THEN
IF (YBEM=='DEF') THEN
YRECFM='ROAD_LAYER'
@@ -202,126 +195,102 @@ ELSE
YRECFM='FLOOR_LAYER'
END IF
END IF
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,ILAYER,IRESP)
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ILAYER,IRESP,HDIR='-')
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
!
- ALLOCATE(ZD(INI,ILAYER))
- IF (YSURF=='T_ROAD') CALL GET_TEB_DEPTHS(&
- DTCO, &
- HFILEPGD,HFILEPGDTYPE,PD_ROAD=ZD)
- IF (YSURF=='T_ROOF') CALL GET_TEB_DEPTHS(&
- DTCO, &
- HFILEPGD,HFILEPGDTYPE,PD_ROOF=ZD)
- IF (YSURF=='T_WALL') CALL GET_TEB_DEPTHS(&
- DTCO, &
- HFILEPGD,HFILEPGDTYPE,PD_WALL=ZD)
- IF (YSURF=='T_WALLA') CALL GET_TEB_DEPTHS(&
- DTCO, &
- HFILEPGD,HFILEPGDTYPE,PD_WALL=ZD)
- IF (YSURF=='T_WALLB') CALL GET_TEB_DEPTHS(&
- DTCO, &
- HFILEPGD,HFILEPGDTYPE,PD_WALL=ZD)
- IF (YSURF=='T_MASS') CALL GET_TEB_DEPTHS(&
- DTCO, &
- HFILEPGD,HFILEPGDTYPE,PD_FLOOR=ZD)
- IF (YSURF=='T_FLOO') CALL GET_TEB_DEPTHS(&
- DTCO, &
- HFILEPGD,HFILEPGDTYPE,PD_FLOOR=ZD)
- !
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'TOWN ')
+ !* reading of version of the file being read
+ GOLD_NAME=(IVERSION_PREP<7 .OR. (IVERSION_PREP==7 .AND. IBUGFIX_PREP<3))
+ !
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ')
!
!* reading option for road orientation
YWALL_OPT = 'UNIF'
IF (YSURF =='T_WALL' .AND. .NOT. GOLD_NAME) THEN
- CALL READ_SURF(&
- HFILETYPE,'WALL_OPT',YWALL_OPT,IRESP)
- END IF
- IF (YSURF =='T_WALLA' .AND. .NOT. GOLD_NAME) THEN
- CALL READ_SURF(&
- HFILETYPE,'WALL_OPT',YWALL_OPT,IRESP)
- END IF
- IF (YSURF =='T_WALLB' .AND. .NOT. GOLD_NAME) THEN
- CALL READ_SURF(&
- HFILETYPE,'WALL_OPT',YWALL_OPT,IRESP)
+ CALL READ_SURF(HFILETYPE,'WALL_OPT',YWALL_OPT,IRESP,HDIR='-')
END IF
!
!* reading of the profile
ALLOCATE(ZFIELD(INI,ILAYER))
DO JLAYER=1,ILAYER
+ !
IF (GOLD_NAME) THEN
WRITE(YRECFM,'(A6,I1.1)') HSURF(1:6),JLAYER
ELSE
- WRITE(YRECFM,'(A1,A4,I1.1)') HSURF(1:1),HSURF(3:6),JLAYER
- IF (YSURF =='T_WALL' .AND. YWALL_OPT/='UNIF') &
+ !
+ IF (YSURF =='T_WALL' .AND. YWALL_OPT/='UNIF') THEN
WRITE(YRECFM,'(A1,A5,I1.1)') HSURF(1:1),HSURF(3:7),JLAYER
- IF (YSURF =='T_WALLA' .AND. YWALL_OPT/='UNIF') &
- WRITE(YRECFM,'(A1,A5,I1.1)') HSURF(1:1),HSURF(3:7),JLAYER
- IF (YSURF =='T_WALLB' .AND. YWALL_OPT/='UNIF') &
- WRITE(YRECFM,'(A1,A5,I1.1)') HSURF(1:1),HSURF(3:7),JLAYER
- IF ((HSURF=='T_FLOOR' .OR. HSURF=='T_MASS') .AND. YBEM=='DEF') THEN
- IF (HSURF=='T_FLOOR' .AND. JLAYER>1) THEN
+ ELSEIF ((YSURF=='T_FLOO' .OR. YSURF=='T_MASS') .AND. YBEM=='DEF') THEN
+ IF (YSURF=='T_FLOO' .AND. JLAYER>1) THEN
WRITE(YRECFM,'(A5,I1.1)') 'TROAD',JLAYER
ELSE
WRITE(YRECFM,'(A6)') 'TI_BLD'
ENDIF
+ ELSE
+ WRITE(YRECFM,'(A1,A4,I1.1)') HSURF(1:1),HSURF(3:6),JLAYER
END IF
+ !
END IF
+ !
YRECFM=YPATCH//YRECFM
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HFILETYPE,YRECFM,ZFIELD(:,JLAYER),IRESP,HDIR='A')
+ CALL READ_SURF(HFILETYPE,YRECFM,ZFIELD(:,JLAYER),IRESP,HDIR='E')
+ !
END DO
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
+ !
DO JLAYER=1,SIZE(ZFIELD,2)
WHERE (ZMASK(:)==0.) ZFIELD(:,JLAYER) = XUNDEF
ENDDO
!
- !* recovers middle layer depth (from the surface)
- ALLOCATE(ZDEPTH (INI,ILAYER))
- ALLOCATE(ZDEPTH_TOT(INI))
- ZDEPTH (:,1)=ZD(:,1)/2.
- ZDEPTH_TOT(:) =ZD(:,1)
- DO JLAYER=2,ILAYER
- ZDEPTH (:,JLAYER) = ZDEPTH_TOT(:) + ZD(:,JLAYER)/2.
- ZDEPTH_TOT(:) = ZDEPTH_TOT(:) + ZD(:,JLAYER)
- END DO
- !
- !* in case of wall or roof, normalizes by total wall or roof thickness
- IF (YSURF=='T_ROOF' .OR. YSURF=='T_WALL' .OR. HSURF == 'T_FLOOR' &
- &.OR. HSURF == 'T_MASS'.OR. YSURF=='T_WALLA' .OR. HSURF == 'T_WALLB') THEN
- DO JLAYER=1,ILAYER
- ZDEPTH(:,JLAYER) = ZDEPTH(:,JLAYER) / ZDEPTH_TOT(:)
- END DO
- END IF
+ ALLOCATE(ZD(INI,ILAYER))
+ IF (YSURF=='T_ROAD') CALL GET_TEB_DEPTHS(DTCO,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,PD_ROAD=ZD,HDIR='E')
+ IF (YSURF=='T_ROOF') CALL GET_TEB_DEPTHS(DTCO,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,PD_ROOF=ZD,HDIR='E')
+ IF (YSURF=='T_WALL') CALL GET_TEB_DEPTHS(DTCO,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,PD_WALL=ZD,HDIR='E')
+ IF (YSURF=='T_MASS') CALL GET_TEB_DEPTHS(DTCO,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,PD_FLOOR=ZD,HDIR='E')
+ IF (YSURF=='T_FLOO') CALL GET_TEB_DEPTHS(DTCO,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,PD_FLOOR=ZD,HDIR='E')
!
- !* interpolation on the fine vertical grid
- IF (YSURF=='T_ROAD') THEN
- ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_ROAD)))
- CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_ROAD,PFIELD)
- ELSEIF (YSURF=='T_ROOF') THEN
- ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_ROOF)))
- CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_ROOF,PFIELD)
- ELSEIF (YSURF=='T_WALL') THEN
- ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_WALL)))
- CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_WALL,PFIELD)
- ELSEIF (YSURF=='T_WALLA') THEN
- ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_WALL)))
- CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_WALL,PFIELD)
- ELSEIF (YSURF=='T_WALLB') THEN
- ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_WALL)))
- CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_WALL,PFIELD)
- ELSEIF (YSURF=='T_FLOO' .OR. YSURF=='T_MASS') THEN
- ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_FLOOR)))
- CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_FLOOR,PFIELD)
- END IF
+ IF (NRANK==NPIO) THEN
+ !
+ !* recovers middle layer depth (from the surface)
+ ALLOCATE(ZDEPTH (INI,ILAYER))
+ DO JI=1,INI
+ !
+ ZDEPTH (JI,1)= ZD(JI,1)/2.
+ ZDEPTH_TOT = ZD(JI,1)
+ DO JLAYER=2,ILAYER
+ ZDEPTH (JI,JLAYER) = ZDEPTH_TOT + ZD(JI,JLAYER)/2.
+ ZDEPTH_TOT = ZDEPTH_TOT + ZD(JI,JLAYER)
+ ENDDO
+ !
+ !* in case of wall or roof, normalizes by total wall or roof thickness
+ IF (YSURF=='T_ROOF' .OR. YSURF=='T_WALL' .OR. YSURF == 'T_FLOO' .OR. YSURF == 'T_MASS') THEN
+ DO JLAYER=1,ILAYER
+ ZDEPTH(JI,JLAYER) = ZDEPTH(JI,JLAYER) / ZDEPTH_TOT
+ END DO
+ END IF
+ !
+ ENDDO
+ !
+ !* interpolation on the fine vertical grid
+ IF (YSURF=='T_ROAD') THEN
+ ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_ROAD)))
+ CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_ROAD,PFIELD)
+ ELSEIF (YSURF=='T_ROOF') THEN
+ ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_ROOF)))
+ CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_ROOF,PFIELD)
+ ELSEIF (YSURF=='T_WALL') THEN
+ ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_WALL)))
+ CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_WALL,PFIELD)
+ ELSEIF (YSURF=='T_FLOO' .OR. YSURF=='T_MASS') THEN
+ ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_FLOOR)))
+ CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_FLOOR,PFIELD)
+ END IF
+ DEALLOCATE(ZDEPTH)
+ !
+ ENDIF
!
- !* end
DEALLOCATE(ZD)
DEALLOCATE(ZFIELD)
- DEALLOCATE(ZDEPTH)
- DEALLOCATE(ZDEPTH_TOT)
!---------------------------------------------------------------------------------------
!
!* 4.2 Internal moisture
@@ -333,15 +302,12 @@ ELSE
YRECFM='QI_BLD'
YRECFM=YPATCH//YRECFM
YRECFM=ADJUSTL(YRECFM)
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'TOWN ')
- CALL READ_SURF(&
- HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ')
+ CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='E')
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
WHERE (ZMASK(:)==0.) PFIELD(:,1) = XUNDEF
ELSE
- PFIELD(:,1) = XUNDEF
+ IF (INI>0) PFIELD(:,1) = XUNDEF
ENDIF
!
!---------------------------------------------------------------------------------------
@@ -351,7 +317,9 @@ ELSE
!
CASE DEFAULT
ALLOCATE(PFIELD(INI,1))
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ')
YRECFM=HSURF
+ GOLD_NAME=(IVERSION_PREP<7 .OR. (IVERSION_PREP==7 .AND. IBUGFIX_PREP<3))
IF (HSURF=='T_CAN ') THEN
YRECFM='TCANYON'
IF (GOLD_NAME) YRECFM='T_CANYON'
@@ -367,11 +335,7 @@ ELSE
ENDIF
YRECFM=YPATCH//YRECFM
YRECFM=ADJUSTL(YRECFM)
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'TOWN ')
- CALL READ_SURF(&
- HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
+ CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='E')
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
WHERE (ZMASK(:)==0.) PFIELD(:,1) = XUNDEF
!
@@ -389,23 +353,20 @@ ELSE
!* temperature profiles
CASE('T_ROAD','T_ROOF','T_WALL','T_WIN1','T_FLOOR','T_CAN','TI_ROAD','T_WALLA','T_WALLB')
YSURF=HSURF(1:6)
+ !
!* reading of the soil surface temperature
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'NATURE')
- CALL READ_SURF(&
- HFILEPGDTYPE,'PATCH_NUMBER',IPATCH,IRESP)
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
+ IPATCH = 0
+ CALL READ_SURF(HFILEPGDTYPE,'PATCH_NUMBER',IPATCH,IRESP,HDIR='-')
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ !
ALLOCATE(ZFIELD(INI,IPATCH))
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'NATURE')
+ !
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
IF (YSURF=='T_FLOO' .OR. YSURF=='T_CAN ' .OR. YSURF=='TI_ROA') THEN
- YRECFM='TG2'
- CALL READ_SURF_FIELD2D(&
- HFILETYPE,ZFIELD(:,:),YRECFM,HDIR='A')
- ELSE
- YRECFM='TG1'
- CALL READ_SURF_FIELD2D(&
- HFILETYPE,ZFIELD(:,:),YRECFM,HDIR='A')
+ CALL MAKE_CHOICE_ARRAY(HFILETYPE, IPATCH, GDIM, 'TG2', ZFIELD(:,:),HDIR='E')
+ ELSE
+ CALL MAKE_CHOICE_ARRAY(HFILETYPE, IPATCH, GDIM, 'TG1', ZFIELD(:,:),HDIR='E')
ENDIF
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
DO JLAYER=1,SIZE(ZFIELD,2)
@@ -415,8 +376,6 @@ ELSE
IF (YSURF=='T_ROAD') ILAYER=SIZE(XGRID_ROAD)
IF (YSURF=='T_ROOF') ILAYER=SIZE(XGRID_ROOF)
IF (YSURF=='T_WALL') ILAYER=SIZE(XGRID_WALL)
- IF (YSURF=='T_WALLA') ILAYER=SIZE(XGRID_WALL)
- IF (YSURF=='T_WALLB') ILAYER=SIZE(XGRID_WALL)
IF (YSURF=='T_FLOO') ILAYER=SIZE(XGRID_FLOOR)
IF (YSURF=='T_WIN1' .OR. YSURF=='T_CAN ' .OR. YSURF=='TI_ROA') ILAYER=1
ALLOCATE(PFIELD(INI,ILAYER))
diff --git a/src/SURFEX/prep_teb_garden.F90 b/src/SURFEX/prep_teb_garden.F90
index cdee51c094842e9057958fafcbd09f5acfde638d..3c57301c723988ba8518d1cfe34629c285963b9a 100644
--- a/src/SURFEX/prep_teb_garden.F90
+++ b/src/SURFEX/prep_teb_garden.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_TEB_GARDEN (DTCO, UG, U, USS, IG, I, TG, TOP, GDM,GCP, &
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH)
+SUBROUTINE PREP_TEB_GARDEN (DTCO, UG, U, USS, GCP, TG, TOP, IO, S, K, P, PEK, &
+ HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH,YDCTL)
! #################################################################################
!
!!**** *PREP_TEB_GARDEN* - Prepares ISBA fields
@@ -32,22 +32,25 @@ SUBROUTINE PREP_TEB_GARDEN (DTCO, UG, U, USS, IG, I, TG, TOP, GDM,GCP, &
!! temperature
!! Modified by B. Decharme (03/2009): Consistency with Arpege permanent
!! snow/ice treatment
+!! P. Marguinaud10/2014, Support for a 2-part PREP
!!------------------------------------------------------------------
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
+USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
+!
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+!
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_P_t, ISBA_PE_t
!
USE MODI_PREP_HOR_TEB_GARDEN_FIELD
-USE MODI_PREP_VER_TEB_GARDEN
+USE MODI_PREP_VER_TEB_VEG
!
USE MODD_SURF_ATM, ONLY : LVERTSHIFT
!
@@ -60,6 +63,8 @@ USE MODD_ISBA_PAR, ONLY : XWGMIN
USE MODD_CO2V_PAR, ONLY : XANFMINIT, XCA_NIT, XCC_NIT
USE MODD_SURF_PAR, ONLY : XUNDEF
!
+USE MODE_PREP_CTL, ONLY : PREP_CTL
+!
USE MODN_PREP_ISBA
USE MODE_POS_SURF
!
@@ -75,13 +80,18 @@ IMPLICIT NONE
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
-TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
-TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
+TYPE(SSO_t), INTENT(INOUT) :: USS
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+TYPE(GRID_t), INTENT(INOUT) :: TG
+TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_P_t), INTENT(INOUT) :: P
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
+TYPE (PREP_CTL), INTENT(INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! name of the Atmospheric file
@@ -110,41 +120,35 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* 2.1 Soil Water reservoirs
!
IF (LHOOK) CALL DR_HOOK('PREP_TEB_GARDEN',0,ZHOOK_HANDLE)
- CALL PREP_HOR_TEB_GARDEN_FIELD(DTCO, IG, I, UG, U, USS, &
- GDM%TGD, GDM%TGDO, GDM%TGDPE, GDM%TGDP, TG, TOP, GDM%TVG,GCP, &
- HPROGRAM,'WG ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH)
+ CALL PREP_HOR_TEB_GARDEN_FIELD(DTCO, UG, U, USS, GCP, IO, S, K, P, PEK, TG, TOP, &
+ HPROGRAM,'WG ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH,YDCTL)
!
!* 2.2 Soil ice reservoirs
!
- CALL PREP_HOR_TEB_GARDEN_FIELD(DTCO, IG, I, UG, U, USS, &
- GDM%TGD, GDM%TGDO, GDM%TGDPE, GDM%TGDP, TG, TOP, GDM%TVG,GCP, &
- HPROGRAM,'WGI ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH)
+ CALL PREP_HOR_TEB_GARDEN_FIELD(DTCO, UG, U, USS, GCP, IO, S, K, P, PEK, TG, TOP, &
+ HPROGRAM,'WGI ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH,YDCTL)
!
!* 2.3 Leaves interception water reservoir
!
- CALL PREP_HOR_TEB_GARDEN_FIELD(DTCO, IG, I, UG, U, USS, &
- GDM%TGD, GDM%TGDO, GDM%TGDPE, GDM%TGDP, TG, TOP, GDM%TVG,GCP, &
- HPROGRAM,'WR ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH)
+ CALL PREP_HOR_TEB_GARDEN_FIELD(DTCO, UG, U, USS, GCP, IO, S, K, P, PEK, TG, TOP, &
+ HPROGRAM,'WR ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH,YDCTL)
!
!* 2.4 Temperature profile
!
- CALL PREP_HOR_TEB_GARDEN_FIELD(DTCO, IG, I, UG, U, USS, &
- GDM%TGD, GDM%TGDO, GDM%TGDPE, GDM%TGDP, TG, TOP, GDM%TVG,GCP, &
- HPROGRAM,'TG ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH)
+ CALL PREP_HOR_TEB_GARDEN_FIELD(DTCO, UG, U, USS, GCP, IO, S, K, P, PEK, TG, TOP, &
+ HPROGRAM,'TG ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH,YDCTL)
!
!* 2.5 Snow variables
!
- CALL PREP_HOR_TEB_GARDEN_FIELD(DTCO, IG, I, UG, U, USS, &
- GDM%TGD, GDM%TGDO, GDM%TGDPE, GDM%TGDP, TG, TOP, GDM%TVG,GCP, &
- HPROGRAM,'SN_VEG ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH)
+ CALL PREP_HOR_TEB_GARDEN_FIELD(DTCO, UG, U, USS, GCP, IO, S, K, P, PEK, TG, TOP, &
+ HPROGRAM,'SN_VEG ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH,YDCTL)
!
!* 2.6 LAI
!
-IF (GDM%TVG%CPHOTO/='NON' .AND. GDM%TVG%CPHOTO/='AGS' .AND. GDM%TVG%CPHOTO/='LST') &
- CALL PREP_HOR_TEB_GARDEN_FIELD(DTCO, IG, I, UG, U, USS, &
- GDM%TGD, GDM%TGDO, GDM%TGDPE, GDM%TGDP, TG, TOP, GDM%TVG,GCP, &
- HPROGRAM,'LAI ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH)
+IF (IO%CPHOTO/='NON') &
+ CALL PREP_HOR_TEB_GARDEN_FIELD(DTCO, UG, U, USS, GCP, IO, S, K, P, PEK, TG, TOP, &
+ HPROGRAM,'LAI ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH,YDCTL)
!
!-------------------------------------------------------------------------------------
!
@@ -153,25 +157,24 @@ IF (GDM%TVG%CPHOTO/='NON' .AND. GDM%TVG%CPHOTO/='AGS' .AND. GDM%TVG%CPHOTO/='LST
! If whole ice reservoir is empty (grib from ecmwf case) and surface temperature is
! lower than -10C, then ice content is maximum and water content minimum
!
-IF (ALL(GDM%TGD%CUR%XWGI(:,:)==0.)) THEN
- WHERE(GDM%TGD%CUR%XTG(:,1:SIZE(GDM%TGD%CUR%XWG,2)) < XTT-10.)
- GDM%TGD%CUR%XWGI(:,:) = GDM%TGDP%XWSAT(:,:)-XWGMIN
- GDM%TGD%CUR%XWG (:,:) = XWGMIN
+IF (ALL(PEK%XWGI(:,:)==0.)) THEN
+ WHERE(PEK%XTG(:,1:SIZE(PEK%XWG,2)) < XTT-10.)
+ PEK%XWGI(:,:) = K%XWSAT(:,:)-XWGMIN
+ PEK%XWG (:,:) = XWGMIN
END WHERE
ENDIF
!
! No ice for force restore third layer:
-IF (GDM%TVG%CISBA == '3-L') THEN
- WHERE(GDM%TGD%CUR%XWG(:,3)/=XUNDEF.AND.GDM%TGD%CUR%XWGI(:,3)/=XUNDEF)
- GDM%TGD%CUR%XWG(:,3) = MIN(GDM%TGD%CUR%XWG(:,3)+GDM%TGD%CUR%XWGI(:,3),GDM%TGDP%XWSAT(:,3))
- GDM%TGD%CUR%XWGI(:,3) = 0.
+IF (IO%CISBA == '3-L') THEN
+ WHERE(PEK%XWG(:,3)/=XUNDEF.AND.PEK%XWGI(:,3)/=XUNDEF)
+ PEK%XWG(:,3) = MIN(PEK%XWG(:,3)+PEK%XWGI(:,3),K%XWSAT(:,3))
+ PEK%XWGI(:,3) = 0.
END WHERE
ENDIF
!
! Total water content should not exceed saturation:
-WHERE(GDM%TGD%CUR%XWG(:,:) /= XUNDEF .AND. &
- (GDM%TGD%CUR%XWG(:,:) + GDM%TGD%CUR%XWGI(:,:)) > GDM%TGDP%XWSAT(:,:) )
- GDM%TGD%CUR%XWGI(:,:) = GDM%TGDP%XWSAT(:,:) - GDM%TGD%CUR%XWG(:,:)
+WHERE(PEK%XWG(:,:) /= XUNDEF .AND. (PEK%XWG(:,:) + PEK%XWGI(:,:)) > K%XWSAT(:,:) )
+ PEK%XWGI(:,:) = K%XWSAT(:,:) - PEK%XWG(:,:)
END WHERE
!
!-------------------------------------------------------------------------------------
@@ -179,7 +182,7 @@ END WHERE
!* 3. Vertical interpolations of all variables
!
IF(LVERTSHIFT)THEN
- CALL PREP_VER_TEB_GARDEN(GDM%TGD, GDM%TGDO, GDM%TGDP, TOP, GDM%TVG)
+ CALL PREP_VER_TEB_VEG(P, PEK, IO, TOP%XZS)
ENDIF
!
!
@@ -187,55 +190,47 @@ ENDIF
!
!* 5. Half prognostic fields
!
-ALLOCATE(GDM%TGD%CUR%XRESA(SIZE(GDM%TGDPE%CUR%XLAI,1)))
-GDM%TGD%CUR%XRESA = 100.
+ALLOCATE(PEK%XRESA(SIZE(PEK%XLAI)))
+PEK%XRESA = 100.
!
!-------------------------------------------------------------------------------------
!
!* 6. Isba-Ags prognostic fields
!
-IF (GDM%TVG%CPHOTO /= 'NON') THEN
+IF (IO%CPHOTO /= 'NON') THEN
!
- ALLOCATE(GDM%TGD%CUR%XAN(SIZE(GDM%TGDPE%CUR%XLAI,1)))
- GDM%TGD%CUR%XAN = 0.
+ ALLOCATE(PEK%XAN(SIZE(PEK%XLAI)))
+ PEK%XAN = 0.
!
- ALLOCATE(GDM%TGD%CUR%XANDAY(SIZE(GDM%TGDPE%CUR%XLAI,1)))
- GDM%TGD%CUR%XANDAY = 0.
+ ALLOCATE(PEK%XANDAY(SIZE(PEK%XLAI)))
+ PEK%XANDAY = 0.
!
- ALLOCATE(GDM%TGD%CUR%XANFM(SIZE(GDM%TGDPE%CUR%XLAI,1)))
- GDM%TGD%CUR%XANFM = XANFMINIT
+ ALLOCATE(PEK%XANFM(SIZE(PEK%XLAI)))
+ PEK%XANFM = XANFMINIT
!
- ALLOCATE(GDM%TGD%CUR%XLE(SIZE(GDM%TGDPE%CUR%XLAI,1)))
- GDM%TGD%CUR%XLE = 0.
+ ALLOCATE(PEK%XLE(SIZE(PEK%XLAI)))
+ PEK%XLE = 0.
!
ENDIF
!
-IF (GDM%TVG%CPHOTO == 'AGS' .OR. GDM%TVG%CPHOTO == 'AST') THEN
-!
- ALLOCATE(GDM%TGD%CUR%XBIOMASS(SIZE(GDM%TGDPE%CUR%XLAI,1),GDM%TVG%NNBIOMASS))
- GDM%TGD%CUR%XBIOMASS(:,1) = 0.
-!
- ALLOCATE(GDM%TGD%CUR%XRESP_BIOMASS(SIZE(GDM%TGDPE%CUR%XLAI,1),GDM%TVG%NNBIOMASS))
- GDM%TGD%CUR%XRESP_BIOMASS(:,:) = 0.
-!
-ELSEIF (GDM%TVG%CPHOTO == 'LAI' .OR. GDM%TVG%CPHOTO == 'LST') THEN
+IF (IO%CPHOTO == 'AST') THEN
!
- ALLOCATE(GDM%TGD%CUR%XBIOMASS(SIZE(GDM%TGDPE%CUR%XLAI,1),GDM%TVG%NNBIOMASS))
- GDM%TGD%CUR%XBIOMASS(:,1) = GDM%TGDPE%CUR%XLAI(:) * GDM%TGDP%XBSLAI(:)
+ ALLOCATE(PEK%XBIOMASS(SIZE(PEK%XLAI),IO%NNBIOMASS))
+ PEK%XBIOMASS(:,1) = 0.
!
- ALLOCATE(GDM%TGD%CUR%XRESP_BIOMASS(SIZE(GDM%TGDPE%CUR%XLAI,1),GDM%TVG%NNBIOMASS))
- GDM%TGD%CUR%XRESP_BIOMASS(:,:) = 0.
+ ALLOCATE(PEK%XRESP_BIOMASS(SIZE(PEK%XLAI),IO%NNBIOMASS))
+ PEK%XRESP_BIOMASS(:,:) = 0.
!
-ELSEIF (GDM%TVG%CPHOTO == 'NIT' .OR. GDM%TVG%CPHOTO == 'NCB') THEN
+ELSEIF (IO%CPHOTO == 'NIT' .OR. IO%CPHOTO == 'NCB') THEN
!
- ALLOCATE(GDM%TGD%CUR%XBIOMASS(SIZE(GDM%TGDPE%CUR%XLAI,1),GDM%TVG%NNBIOMASS))
- GDM%TGD%CUR%XBIOMASS(:,1) = GDM%TGDPE%CUR%XLAI(:) * GDM%TGDP%XBSLAI_NITRO(:)
- GDM%TGD%CUR%XBIOMASS(:,2) = MAX( 0., (GDM%TGD%CUR%XBIOMASS(:,1)/ (XCC_NIT/10.**XCA_NIT)) &
- **(1.0/(1.0-XCA_NIT)) - GDM%TGD%CUR%XBIOMASS(:,1) )
- GDM%TGD%CUR%XBIOMASS(:,3:GDM%TVG%NNBIOMASS) = 0.
+ ALLOCATE(PEK%XBIOMASS(SIZE(PEK%XLAI),IO%NNBIOMASS))
+ PEK%XBIOMASS(:,1) = PEK%XLAI(:) * P%XBSLAI_NITRO(:)
+ PEK%XBIOMASS(:,2) = MAX( 0., (PEK%XBIOMASS(:,1)/ (XCC_NIT/10.**XCA_NIT)) &
+ **(1.0/(1.0-XCA_NIT)) - PEK%XBIOMASS(:,1) )
+ PEK%XBIOMASS(:,3:IO%NNBIOMASS) = 0.
!
- ALLOCATE(GDM%TGD%CUR%XRESP_BIOMASS(SIZE(GDM%TGDPE%CUR%XLAI,1),GDM%TVG%NNBIOMASS))
- GDM%TGD%CUR%XRESP_BIOMASS(:,:) = 0.
+ ALLOCATE(PEK%XRESP_BIOMASS(SIZE(PEK%XLAI),IO%NNBIOMASS))
+ PEK%XRESP_BIOMASS(:,:) = 0.
!
ENDIF
!
diff --git a/src/SURFEX/prep_teb_garden_ascllv.F90 b/src/SURFEX/prep_teb_garden_ascllv.F90
index 9caad3096efba82e8a4ff0eed3e46d1d3e2304dc..444782c93b41356e0db99eaf1c192a290c5937f9 100644
--- a/src/SURFEX/prep_teb_garden_ascllv.F90
+++ b/src/SURFEX/prep_teb_garden_ascllv.F90
@@ -31,12 +31,12 @@ SUBROUTINE PREP_TEB_GARDEN_ASCLLV (DTCO, UG, U, USS, &
!
!
!
-!
+USE MODD_SURFEX_MPI, ONLY : NPROC, NINDEX, NNUM, NCOMM, NPIO, NRANK
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_PREP, ONLY : CINTERP_TYPE
USE MODD_PGD_GRID, ONLY : NL,LLATLONMASK,CGRID,XGRID_PAR,NGRID_PAR
@@ -58,13 +58,17 @@ USE MODI_GET_TYPE_DIM_n
!
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1 declarations of arguments
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
@@ -77,13 +81,44 @@ INTEGER :: JV ! loop counter
INTEGER :: JLAYER
INTEGER :: IL
!
+INTEGER, DIMENSION(0:NPROC-1) :: INB
+INTEGER :: INFOMPI, JJ
+!
REAL, ALLOCATABLE, DIMENSION(:,:) :: ZFIELD
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PREP_TEB_GARDEN_ASCLLV',0,ZHOOK_HANDLE)
- CATYPE = 'ARI'
+!
+IF (.NOT.ALLOCATED(NNUM)) THEN
+ ALLOCATE(NNUM(U%NDIM_FULL))
+ IF (NRANK/=NPIO) THEN
+ IF (ALLOCATED(NINDEX)) DEALLOCATE(NINDEX)
+ ALLOCATE(NINDEX(U%NDIM_FULL))
+ ENDIF
+ IF (NRANK==NPIO) THEN
+ INB(:) = 0
+ DO JJ=1,U%NDIM_FULL
+ INB(NINDEX(JJ)) = INB(NINDEX(JJ))+1
+ NNUM(JJ) = INB(NINDEX(JJ))
+ ENDDO
+ ENDIF
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(NINDEX,SIZE(NINDEX)*KIND(NINDEX)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(NNUM,SIZE(NNUM)*KIND(NNUM)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(UG%NGRID_FULL_PAR,KIND(UG%NGRID_FULL_PAR)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ IF (NRANK/=NPIO) ALLOCATE(UG%XGRID_FULL_PAR(UG%NGRID_FULL_PAR))
+#ifdef SFX_MPI
+ CALL MPI_BCAST(UG%XGRID_FULL_PAR,&
+ SIZE(UG%XGRID_FULL_PAR)*KIND(UG%XGRID_FULL_PAR)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+#endif
+ ENDIF
+ENDIF
+!
+CATYPE = 'ARI'
!
!* 1. get full dimension of grid
!
@@ -153,8 +188,15 @@ END SELECT
!* 6. Interpolation method
! --------------------
!
- CINTERP_TYPE='NONE '
+CINTERP_TYPE='NONE '
DEALLOCATE(ZFIELD)
+!
+DEALLOCATE(NNUM)
+IF (NRANK/=NPIO) THEN
+ DEALLOCATE(NINDEX,UG%XGRID_FULL_PAR)
+ ALLOCATE(NINDEX(0))
+ENDIF
+!
IF (LHOOK) CALL DR_HOOK('PREP_TEB_GARDEN_ASCLLV',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_teb_garden_buffer.F90 b/src/SURFEX/prep_teb_garden_buffer.F90
index fae85c4ad39a21c9a8e3ecfe9a178c5a48e14ac2..aa3fe5d85f628a207e92d094c30520261a33ca91 100644
--- a/src/SURFEX/prep_teb_garden_buffer.F90
+++ b/src/SURFEX/prep_teb_garden_buffer.F90
@@ -138,14 +138,14 @@ END SELECT
!* 4. Interpolation method
! --------------------
!
- CINTERP_TYPE='BUFFER'
+CINTERP_TYPE='BUFFER'
!
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PREP_TEB_GARDEN_BUFFER',1,ZHOOK_HANDLE)
- CONTAINS
+CONTAINS
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_teb_garden_extern.F90 b/src/SURFEX/prep_teb_garden_extern.F90
index d80403711f1531e77dbda8d6a97ee681f606e0a2..6dbd8088bd8679ccf26826576e2abe611ffed8cd 100644
--- a/src/SURFEX/prep_teb_garden_extern.F90
+++ b/src/SURFEX/prep_teb_garden_extern.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_TEB_GARDEN_EXTERN (DTCO, I, U,GCP, &
+SUBROUTINE PREP_TEB_GARDEN_EXTERN (DTCO, IO, U, GCP, &
HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,KPATCH,PFIELD)
! #################################################################################
!
@@ -26,19 +26,14 @@ SUBROUTINE PREP_TEB_GARDEN_EXTERN (DTCO, I, U,GCP, &
!! MODIFICATIONS
!! -------------
!! Original 01/2004
-!! M.Moge 01/2016 using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads
!!------------------------------------------------------------------
!
-
-!
-!
-!
-!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
USE MODE_READ_EXTERN
!
@@ -51,6 +46,7 @@ USE MODI_OPEN_AUX_IO_SURF
USE MODI_CLOSE_AUX_IO_SURF
USE MODI_READ_TEB_PATCH
USE MODI_TOWN_PRESENCE
+USE MODI_MAKE_CHOICE_ARRAY
!
USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
USE MODD_PREP_TEB_GARDEN,ONLY : XGRID_SOIL, XWR_DEF
@@ -61,7 +57,6 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
USE MODI_PUT_ON_ALL_VEGTYPES
-USE MODI_READ_SURF_FIELD2D
!
IMPLICIT NONE
!
@@ -69,7 +64,7 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
@@ -95,15 +90,16 @@ REAL, DIMENSION(:,:), POINTER :: ZFIELD1 ! field read on initial MN
REAL, DIMENSION(:,:,:), POINTER :: ZD ! depth of field in the soil
REAL, DIMENSION(:,:), POINTER :: ZD1 ! depth of field in the soil, one patch
REAL, DIMENSION(:,:), ALLOCATABLE :: ZOUT !
+ CHARACTER(LEN=LEN_HREC) :: YSURF ! type of field
+ CHARACTER(LEN=3) :: YPATCH ! indentificator for TEB patch
INTEGER :: JPATCH ! loop counter for patch
INTEGER :: ITEB_PATCH ! number of TEB patches in file
INTEGER :: IVERSION ! SURFEX version
INTEGER :: IBUGFIX ! SURFEX bug version
-LOGICAL :: GOLD_NAME ! old name flag for temperatures
- CHARACTER(LEN=LEN_HREC) :: YSURF ! type of field
- CHARACTER(LEN=3) :: YPATCH ! indentificator for TEB patch
-LOGICAL :: GTEB ! flag if TEB fields are present
+LOGICAL :: GTEB ! flag if TEB fields are present
+LOGICAL :: GOLD_NAME ! old name flag for temperatures
LOGICAL :: GGARDEN ! T if gardens are present in the file
+LOGICAL :: GDIM
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!------------------------------------------------------------------------------
@@ -122,34 +118,31 @@ IF (LHOOK) CALL DR_HOOK('PREP_TEB_GARDEN_EXTERN',0,ZHOOK_HANDLE)
!* 2. Reading of grid
! ---------------
!
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'FULL ')
+CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'FULL ')
!
!* reading of version of the file being read
- CALL READ_SURF(&
- HFILEPGDTYPE,'VERSION',IVERSION,IRESP)
- CALL READ_SURF(&
- HFILEPGDTYPE,'BUG',IBUGFIX,IRESP)
-GOLD_NAME=(IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<3))
+CALL READ_SURF(HFILEPGDTYPE,'VERSION',IVERSION,IRESP)
+CALL READ_SURF(HFILEPGDTYPE,'BUG',IBUGFIX,IRESP)
+GOLD_NAME = (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<3))
+!
+CALL PREP_GRID_EXTERN(GCP,HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
!
- CALL PREP_GRID_EXTERN(GCP,&
- HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
+IF (NRANK/=NPIO) INI = 0
!
!* reads if TEB fields exist in the input file
- CALL TOWN_PRESENCE(&
- HFILEPGDTYPE,GTEB)
+CALL TOWN_PRESENCE(HFILEPGDTYPE,GTEB,HDIR='-')
!
IF (GTEB) THEN
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- CALL READ_TEB_PATCH(&
- HFILEPGD,HFILEPGDTYPE,ITEB_PATCH)
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'FULL ')
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ')
+ CALL READ_TEB_PATCH(HFILEPGD,HFILEPGDTYPE,IVERSION,IBUGFIX,ITEB_PATCH,HDIR='-')
YPATCH=' '
IF (ITEB_PATCH>1) THEN
WRITE(YPATCH,FMT='(A,I1,A)') 'T',MIN(KPATCH,ITEB_PATCH),'_'
END IF
END IF
+!
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
!
!---------------------------------------------------------------------------------------
!
@@ -164,8 +157,8 @@ SELECT CASE(HSURF)
CASE('ZS ')
ALLOCATE(PFIELD(INI,1,1))
YRECFM='ZS'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,PFIELD(:,1,1),IRESP,HDIR='A')
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'FULL ')
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1,1),IRESP,HDIR='A')
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
!
!--------------------------------------------------------------------------
@@ -175,9 +168,9 @@ SELECT CASE(HSURF)
!
CASE('TG ','WG ','WGI ')
!* choice if one reads garden fields (if present) or ISBA fields
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ')
GGARDEN = .FALSE.
- IF (GTEB) CALL READ_SURF(&
- HFILEPGDTYPE,'GARDEN',GGARDEN,IRESP)
+ IF (GTEB) CALL READ_SURF(HFILEPGDTYPE,'GARDEN',GGARDEN,IRESP,HDIR='-')
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
IF (GGARDEN) THEN
YSURF = 'GD_'//HSURF(1:3)
@@ -188,69 +181,77 @@ SELECT CASE(HSURF)
END IF
YSURF=ADJUSTL(YSURF)
!* reading of the profile and its depth definition
- CALL READ_EXTERN_ISBA(U, &
- DTCO, I,GCP, &
- HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,INI,&
- HSURF,YSURF,ZFIELD,ZD)
+ CALL READ_EXTERN_ISBA(U, DTCO, GCP, IO, HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,INI,&
+ HSURF,YSURF,ZFIELD,ZD)
!
- ALLOCATE(ZFIELD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
- ALLOCATE(ZD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
- ALLOCATE(ZOUT(SIZE(ZFIELD,1),SIZE(XGRID_SOIL)))
- ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_SOIL),SIZE(ZFIELD,3)))
-!
- DO JPATCH=1,SIZE(ZFIELD,3)
- ZFIELD1(:,:)=ZFIELD(:,:,JPATCH)
- ZD1(:,:)=ZD(:,:,JPATCH)
- CALL INTERP_GRID_NAT(ZD1,ZFIELD1,XGRID_SOIL,ZOUT)
- PFIELD(:,:,JPATCH)=ZOUT(:,:)
- END DO
-!
- DEALLOCATE(ZFIELD)
- DEALLOCATE(ZOUT)
- DEALLOCATE(ZFIELD1)
- DEALLOCATE(ZD)
+ IF (NRANK==NPIO) THEN
+
+ ALLOCATE(ZOUT (SIZE(ZFIELD,1),SIZE(XGRID_SOIL)))
+ ALLOCATE(PFIELD (SIZE(ZFIELD,1),SIZE(XGRID_SOIL),SIZE(ZFIELD,3)))
+ ALLOCATE(ZFIELD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
+ ALLOCATE(ZD1 (SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
+ DO JPATCH=1,SIZE(ZFIELD,3)
+ ZFIELD1(:,:)=ZFIELD(:,:,JPATCH)
+ ZD1(:,:)=ZD(:,:,JPATCH)
+ CALL INTERP_GRID_NAT(ZD1,ZFIELD1,XGRID_SOIL,ZOUT)
+ PFIELD(:,:,JPATCH)=ZOUT(:,:)
+ END DO
+ DEALLOCATE(ZFIELD)
+ DEALLOCATE(ZOUT)
+ DEALLOCATE(ZFIELD1)
+ DEALLOCATE(ZD)
+
+ ENDIF
!
!--------------------------------------------------------------------------
!
!* 3.4 Water content intercepted on leaves, LAI
!
CASE('WR ')
- ALLOCATE(PFIELD(INI,1,NVEGTYPE))
- !* choice if one reads garden fields (if present) or ISBA fields
+ !* choice if one reads garden fields (if present) or ISBA fields
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ')
GGARDEN = .FALSE.
- IF (GTEB) CALL READ_SURF(&
- HFILEPGDTYPE,'GARDEN',GGARDEN,IRESP)
+ IF (GTEB) CALL READ_SURF(HFILEPGDTYPE,'GARDEN',GGARDEN,IRESP,HDIR='-')
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
IF (GGARDEN) THEN
IPATCH = 1
YRECFM = 'GD_WR'
IF (GOLD_NAME) YRECFM = 'TWN_WR'
YRECFM = YPATCH//YRECFM
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'TOWN ')
- ELSE
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ')
+ ELSE
+ IPATCH = 0
YRECFM = 'PATCH_NUMBER'
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'NATURE')
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,IPATCH,IRESP)
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP,HDIR='-')
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'NATURE')
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
YRECFM = 'WR'
END IF
+
+ CALL READ_SURF(HFILETYPE,'VERSION',IVERSION,IRESP)
+ CALL READ_SURF(HFILETYPE,'BUG',IBUGFIX,IRESP)
+ GDIM = (IVERSION>8 .OR. IVERSION==8 .AND. IBUGFIX>0)
+ IF (GDIM) CALL READ_SURF(HFILETYPE,'SPLIT_PATCH',GDIM,IRESP)
YRECFM=ADJUSTL(YRECFM)
-
ALLOCATE(ZFIELD(INI,1,IPATCH))
- CALL READ_SURF_FIELD2D(&
- HFILETYPE,ZFIELD(:,1,:),YRECFM,HDIR='A')
+ IF (GGARDEN) THEN
+ CALL READ_SURF(HFILETYPE,YRECFM,ZFIELD(:,1,1),IRESP,HDIR='E')
+ ELSE
+ CALL MAKE_CHOICE_ARRAY(HFILETYPE, IPATCH, GDIM, YRECFM, ZFIELD(:,1,:),HDIR='E')
+ ENDIF
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
- CALL PUT_ON_ALL_VEGTYPES(INI,1,1,NVEGTYPE,ZFIELD,PFIELD)
+ IF (IPATCH/=1) THEN
+ ALLOCATE(PFIELD(INI,1,NVEGTYPE))
+ CALL PUT_ON_ALL_VEGTYPES(INI,1,IPATCH,NVEGTYPE,ZFIELD,PFIELD)
+ ELSE
+ ALLOCATE(PFIELD(INI,1,1))
+ PFIELD(:,:,:) = ZFIELD(:,:,:)
+ ENDIF
DEALLOCATE(ZFIELD)
!
CASE('LAI ')
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- ALLOCATE(PFIELD(INI,1,NVEGTYPE))
+ ALLOCATE(PFIELD(INI,1,1))
PFIELD(:,:,:) = XUNDEF
!
END SELECT
diff --git a/src/SURFEX/prep_teb_garden_grib.F90 b/src/SURFEX/prep_teb_garden_grib.F90
index 2d55dee2f339f39e596ef1f8957d8562e8cd208b..49cf5861c407a0c7ef4dc50ae6de57ad58b35649 100644
--- a/src/SURFEX/prep_teb_garden_grib.F90
+++ b/src/SURFEX/prep_teb_garden_grib.F90
@@ -34,14 +34,11 @@ USE MODE_READ_GRIB
!
USE MODD_TYPE_DATE_SURF
!
-USE MODI_PREP_GRIB_GRID
USE MODI_INTERP_GRID_NAT
!
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
USE MODD_PREP_TEB_GARDEN,ONLY : XGRID_SOIL, XWR_DEF
-USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_GRID_GRIB, ONLY : CGRIB_FILE, NNI
+USE MODD_GRID_GRIB, ONLY : CGRIB_FILE, NNI, CINMODEL
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -61,8 +58,6 @@ REAL,DIMENSION(:,:,:), POINTER :: PFIELD ! field to interpolate horizontal
!
!* 0.2 declarations of local variables
!
-TYPE (DATE_TIME) :: TZTIME_GRIB ! current date and time
- CHARACTER(LEN=6) :: YINMODEL ! model from which GRIB file originates
REAL, DIMENSION(:) , POINTER :: ZMASK => NULL() ! Land mask
REAL, DIMENSION(:,:), POINTER :: ZFIELD => NULL() ! field read
REAL, DIMENSION(:), POINTER :: ZFIELD1D => NULL() ! field read
@@ -79,9 +74,7 @@ IF (LHOOK) CALL DR_HOOK('PREP_TEB_GARDEN_GRIB',0,ZHOOK_HANDLE)
!
IF (TRIM(HFILE).NE.CGRIB_FILE) CGRIB_FILE=""
!
- CALL PREP_GRIB_GRID(HFILE,KLUOUT,YINMODEL,CINGRID_TYPE,TZTIME_GRIB)
-!
- CALL READ_GRIB_LAND_MASK(HFILE,KLUOUT,YINMODEL,ZMASK)
+ CALL READ_GRIB_LAND_MASK(HFILE,KLUOUT,CINMODEL,ZMASK)
!
!* 2. Reading of field
! ----------------
@@ -95,25 +88,25 @@ SELECT CASE(HSURF)
!
CASE('TG ')
!* reading of the profile and its depth definition
- SELECT CASE(YINMODEL)
+ SELECT CASE(CINMODEL)
CASE('ECMWF ')
- CALL READ_GRIB_TG_ECMWF(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_TG_ECMWF(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
CASE('ARPEGE','ALADIN','MOCAGE')
- CALL READ_GRIB_TG_METEO_FRANCE(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_TG_METEO_FRANCE(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
CASE('HIRLAM')
- CALL READ_GRIB_TG_HIRLAM(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_TG_HIRLAM(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
END SELECT
CALL SOIL_PROFILE_GRIB
CASE('WG ')
!* reading of the profile and its depth definition
- SELECT CASE(YINMODEL)
+ SELECT CASE(CINMODEL)
CASE('ECMWF ')
- CALL READ_GRIB_WG_ECMWF(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_WG_ECMWF(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
CASE('ARPEGE','ALADIN','MOCAGE')
- CALL READ_GRIB_WG_METEO_FRANCE(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_WG_METEO_FRANCE(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
CASE('HIRLAM')
- CALL READ_GRIB_WG_HIRLAM(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_WG_HIRLAM(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
END SELECT
CALL SOIL_PROFILE_GRIB
@@ -122,11 +115,11 @@ SELECT CASE(HSURF)
CASE('WGI ')
!* reading of the profile and its depth definition
- SELECT CASE(YINMODEL)
+ SELECT CASE(CINMODEL)
CASE('ECMWF ')
- CALL READ_GRIB_WGI_ECMWF(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_WGI_ECMWF(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
CASE('ARPEGE','ALADIN','MOCAGE')
- CALL READ_GRIB_WGI_METEO_FRANCE(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_WGI_METEO_FRANCE(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
CASE('HIRLAM')
CALL READ_GRIB_WGI_HIRLAM(HFILE,KLUOUT,ZFIELD,ZD)
END SELECT
@@ -135,18 +128,18 @@ SELECT CASE(HSURF)
!* 3.4 Water content intercepted on leaves, LAI
!
CASE('WR ')
- ALLOCATE(PFIELD(NNI,1,NVEGTYPE))
+ ALLOCATE(PFIELD(NNI,1,1))
PFIELD(:,:,:) = XWR_DEF
!
CASE('LAI ')
- ALLOCATE(PFIELD(NNI,1,NVEGTYPE))
+ ALLOCATE(PFIELD(NNI,1,1))
PFIELD(:,:,:) = XUNDEF
!
!
!* 3.5 Other fields
!
CASE('ZS ')
- CALL READ_GRIB_ZS_LAND(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD1D)
+ CALL READ_GRIB_ZS_LAND(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD1D)
ALLOCATE(PFIELD(SIZE(ZFIELD1D,1),1,1))
PFIELD(:,1,1)=ZFIELD1D(:)
DEALLOCATE(ZFIELD1D)
@@ -160,14 +153,12 @@ DEALLOCATE(ZMASK)
!
!* 4. Interpolation method
! --------------------
-!
- CINTERP_TYPE='HORIBL'
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PREP_TEB_GARDEN_GRIB',1,ZHOOK_HANDLE)
- CONTAINS
+CONTAINS
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
@@ -186,10 +177,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
CALL INTERP_GRID_NAT(ZD,ZFIELD,XGRID_SOIL,ZOUT)
!
!* extends definition to all vegtypes.
- ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_SOIL),NVEGTYPE))
- DO JVEGTYPE=1,NVEGTYPE
- PFIELD(:,:,JVEGTYPE)=ZOUT(:,:)
- END DO
+ ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_SOIL),1))
+ PFIELD(:,:,1)=ZOUT(:,:)
!* end
DEALLOCATE(ZOUT)
DEALLOCATE(ZFIELD)
diff --git a/src/SURFEX/prep_teb_garden_unif.F90 b/src/SURFEX/prep_teb_garden_unif.F90
index ef52f9e65fa29910a0f36833bd71cf702fcd4d17..c40f6484d020990ff1346f34b57f4b23085e01cd 100644
--- a/src/SURFEX/prep_teb_garden_unif.F90
+++ b/src/SURFEX/prep_teb_garden_unif.F90
@@ -68,41 +68,35 @@ SELECT CASE(HSURF)
!* 3.1 Profile of soil relative humidity
!
CASE('WG ')
- ALLOCATE(PFIELD(1,3,NVEGTYPE))
- DO JV=1,NVEGTYPE
- PFIELD(:,1,JV) = XHUG_SURF_GD
- PFIELD(:,2,JV) = XHUG_ROOT_GD
- PFIELD(:,3,JV) = XHUG_DEEP_GD
- END DO
+ ALLOCATE(PFIELD(1,3,1))
+ PFIELD(:,1,1) = XHUG_SURF_GD
+ PFIELD(:,2,1) = XHUG_ROOT_GD
+ PFIELD(:,3,1) = XHUG_DEEP_GD
!* 3.2 Profile of soil humidity for ice
CASE('WGI ')
- ALLOCATE(PFIELD(1,3,NVEGTYPE))
- DO JV=1,NVEGTYPE
- PFIELD(:,1,JV) = XHUGI_SURF_GD
- PFIELD(:,2,JV) = XHUGI_ROOT_GD
- PFIELD(:,3,JV) = XHUGI_DEEP_GD
- END DO
+ ALLOCATE(PFIELD(1,3,1))
+ PFIELD(:,1,1) = XHUGI_SURF_GD
+ PFIELD(:,2,1) = XHUGI_ROOT_GD
+ PFIELD(:,3,1) = XHUGI_DEEP_GD
!* 3.3 Profile of temperatures
CASE('TG ')
- ALLOCATE(PFIELD(1,3,NVEGTYPE))
- DO JV=1,NVEGTYPE
- PFIELD(:,1,JV) = XTG_SURF_GD
- PFIELD(:,2,JV) = XTG_ROOT_GD
- PFIELD(:,3,JV) = XTG_DEEP_GD
- END DO
+ ALLOCATE(PFIELD(1,3,1))
+ PFIELD(:,1,1) = XTG_SURF_GD
+ PFIELD(:,2,1) = XTG_ROOT_GD
+ PFIELD(:,3,1) = XTG_DEEP_GD
!* 3.4 Other quantities
CASE('WR ')
- ALLOCATE(PFIELD(1,1,NVEGTYPE))
+ ALLOCATE(PFIELD(1,1,1))
PFIELD = XWR_DEF
CASE('LAI ')
- ALLOCATE(PFIELD(1,1,NVEGTYPE))
+ ALLOCATE(PFIELD(1,1,1))
PFIELD = XUNDEF
END SELECT
@@ -110,7 +104,7 @@ END SELECT
!* 4. Interpolation method
! --------------------
!
- CINTERP_TYPE='UNIF '
+CINTERP_TYPE='UNIF '
IF (LHOOK) CALL DR_HOOK('PREP_TEB_GARDEN_UNIF',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_teb_greenroof.F90 b/src/SURFEX/prep_teb_greenroof.F90
index 4146fb7e9e5a88837291bb62753cc10d4567dbf9..57fdf745f983e5c16f810bcb4d595336e3b2bf05 100644
--- a/src/SURFEX/prep_teb_greenroof.F90
+++ b/src/SURFEX/prep_teb_greenroof.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_TEB_GREENROOF (DTCO, UG, U, USS, IG, I, TG, T, TOP, TVG,GRM,GCP, &
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH)
+SUBROUTINE PREP_TEB_GREENROOF (DTCO, UG, U, USS, GCP, TG, TOP, IO, S, K, P, PEK, &
+ HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH,YDCTL)
! #################################################################################
!
!!**** *PREP_TEB_GREENROOF* - Prepares ISBA fields for greenroofs
@@ -27,27 +27,23 @@ SUBROUTINE PREP_TEB_GREENROOF (DTCO, UG, U, USS, IG, I, TG, T, TOP, TVG,GRM,GCP,
!! MODIFICATIONS
!! -------------
!! Original 07/2011
+!! P. Marguinaud10/2014, Support for a 2-part PREP
!!------------------------------------------------------------------
!
-!
-!
-!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
-USE MODD_TEB_n, ONLY : TEB_t
+USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
+!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_P_t, ISBA_PE_t
+!
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
-USE MODD_SURFEX_n, ONLY : TEB_GREENROOF_MODEL_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
!
USE MODI_PREP_HOR_TEB_GREENROOF_FIELD
-USE MODI_PREP_VER_TEB_GREENROOF
+USE MODI_PREP_VER_TEB_VEG
!
! A FAIRE :
! IL FAUT RAJOUTER TSNOW
@@ -59,10 +55,11 @@ USE MODD_ISBA_PAR, ONLY : XWGMIN
USE MODD_CO2V_PAR, ONLY : XCC_NIT, XCA_NIT, XANFMINIT
USE MODD_SURF_PAR, ONLY : XUNDEF
!
+USE MODE_PREP_CTL, ONLY : PREP_CTL
+!
USE MODN_PREP_ISBA
USE MODE_POS_SURF
!
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -74,15 +71,18 @@ IMPLICIT NONE
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
-TYPE(TEB_t), INTENT(INOUT) :: T
-TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
-TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM
+TYPE(SSO_t), INTENT(INOUT) :: USS
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_P_t), INTENT(INOUT) :: P
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
+TYPE(GRID_t), INTENT(INOUT) :: TG
+TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+TYPE (PREP_CTL), INTENT(INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! name of the Atmospheric file
@@ -113,43 +113,33 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PREP_TEB_GREENROOF',0,ZHOOK_HANDLE)
!
- CALL PREP_HOR_TEB_GREENROOF_FIELD(DTCO, IG, I, UG, U, USS, GRM%TGR, GRM%TGRO, GRM%TGRPE, GRM%TGRP, &
- TG, TOP,GCP, &
- HPROGRAM,'WG ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH)
+ CALL PREP_HOR_TEB_GREENROOF_FIELD(DTCO, UG, U, USS, GCP, IO, S, K, P, PEK, TG, TOP, &
+ HPROGRAM,'WG ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH,YDCTL)
!
!* 2.2 Soil ice reservoirs
!
- CALL PREP_HOR_TEB_GREENROOF_FIELD(DTCO, IG, I, UG, U, USS, GRM%TGR, GRM%TGRO, GRM%TGRPE, GRM%TGRP, &
- TG, TOP,GCP, &
- HPROGRAM,'WGI ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH)
+ CALL PREP_HOR_TEB_GREENROOF_FIELD(DTCO, UG, U, USS, GCP, IO, S, K, P, PEK, TG, TOP, &
+ HPROGRAM,'WGI ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH,YDCTL)
!
!* 2.3 Leaves interception water reservoir
!
- CALL PREP_HOR_TEB_GREENROOF_FIELD(DTCO, IG, I, UG, U, USS, GRM%TGR, GRM%TGRO, GRM%TGRPE, GRM%TGRP, &
- TG, TOP,GCP, &
- HPROGRAM,'WR ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH)
+ CALL PREP_HOR_TEB_GREENROOF_FIELD(DTCO, UG, U, USS, GCP, IO, S, K, P, PEK, TG, TOP, &
+ HPROGRAM,'WR ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH,YDCTL)
!
!* 2.4 Temperature profile
!
- CALL PREP_HOR_TEB_GREENROOF_FIELD(DTCO, IG, I, UG, U, USS, GRM%TGR, GRM%TGRO, GRM%TGRPE, GRM%TGRP, &
- TG, TOP,GCP, &
- HPROGRAM,'TG ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH)
-!
-! Initializing deep GR temp. with that of the outer layer of the structural roof
-!
-GRM%TGRP%XTDEEP(:) = T%CUR%XT_ROOF(:,1)
+ CALL PREP_HOR_TEB_GREENROOF_FIELD(DTCO, UG, U, USS, GCP, IO, S, K, P, PEK, TG, TOP, &
+ HPROGRAM,'TG ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH,YDCTL)
!
!* 2.5 Snow variables
!
- CALL PREP_HOR_TEB_GREENROOF_FIELD(DTCO, IG, I, UG, U, USS, GRM%TGR, GRM%TGRO, GRM%TGRPE, GRM%TGRP, &
- TG, TOP,GCP, &
- HPROGRAM,'SN_VEG ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH)
+ CALL PREP_HOR_TEB_GREENROOF_FIELD(DTCO, UG, U, USS, GCP, IO, S, K, P, PEK, TG, TOP, &
+ HPROGRAM,'SN_VEG ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH,YDCTL)
!
!* 2.6 LAI
!
- CALL PREP_HOR_TEB_GREENROOF_FIELD(DTCO, IG, I, UG, U, USS, GRM%TGR, GRM%TGRO, GRM%TGRPE, GRM%TGRP, &
- TG, TOP,GCP, &
- HPROGRAM,'LAI ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH)
+ CALL PREP_HOR_TEB_GREENROOF_FIELD(DTCO, UG, U, USS, GCP, IO, S, K, P, PEK, TG, TOP, &
+ HPROGRAM,'LAI ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KPATCH,YDCTL)
!
!-------------------------------------------------------------------------------------
!
@@ -158,17 +148,17 @@ GRM%TGRP%XTDEEP(:) = T%CUR%XT_ROOF(:,1)
! 3.1 If whole ice reservoir is empty (grib from ecmwf case) and surface temperature is
! lower than -10C, then ice content is maximum and water content minimum
!
-IF (ALL(GRM%TGR%CUR%XWGI(:,:)==0.)) THEN
- WHERE(GRM%TGR%CUR%XTG(:,1:SIZE(GRM%TGR%CUR%XWG,2)) < XTT-10.)
- GRM%TGR%CUR%XWGI(:,:) = GRM%TGRP%XWSAT(:,:)-XWGMIN
- GRM%TGR%CUR%XWG (:,:) = XWGMIN
+IF (ALL(PEK%XWGI(:,:)==0.)) THEN
+ WHERE(PEK%XTG(:,1:SIZE(PEK%XWG,2)) < XTT-10.)
+ PEK%XWGI(:,:) = K%XWSAT(:,:)-XWGMIN
+ PEK%XWG (:,:) = XWGMIN
END WHERE
ENDIF
!
!
! 3.2. Total water content should not exceed saturation:
-WHERE(GRM%TGR%CUR%XWG(:,:) /= XUNDEF .AND. (GRM%TGR%CUR%XWG(:,:) + GRM%TGR%CUR%XWGI(:,:)) > GRM%TGRP%XWSAT(:,:) )
- GRM%TGR%CUR%XWGI(:,:) = GRM%TGRP%XWSAT(:,:) - GRM%TGR%CUR%XWG(:,:)
+WHERE(PEK%XWG(:,:) /= XUNDEF .AND. (PEK%XWG(:,:) + PEK%XWGI(:,:)) > K%XWSAT(:,:) )
+ PEK%XWGI(:,:) = K%XWSAT(:,:) - PEK%XWG(:,:)
END WHERE
!
!-------------------------------------------------------------------------------------
@@ -176,7 +166,7 @@ END WHERE
!* 4. Vertical interpolations of all variables
!
IF(LVERTSHIFT)THEN
- CALL PREP_VER_TEB_GREENROOF(GRM%TGR, GRM%TGRO, GRM%TGRP, TOP)
+ CALL PREP_VER_TEB_VEG(P, PEK, IO, TOP%XZS)
ENDIF
!
!
@@ -184,55 +174,47 @@ ENDIF
!
!* 5. Half prognostic fields
!
-ALLOCATE(GRM%TGR%CUR%XRESA(SIZE(GRM%TGRPE%CUR%XLAI)))
-GRM%TGR%CUR%XRESA(:) = 100.
+ALLOCATE(PEK%XRESA(SIZE(PEK%XLAI)))
+PEK%XRESA(:) = 100.
!
!-------------------------------------------------------------------------------------
!
!* 6. Isba-Ags prognostic fields
!
-IF (TVG%CPHOTO /= 'NON') THEN
+IF (IO%CPHOTO /= 'NON') THEN
!
- ALLOCATE(GRM%TGR%CUR%XAN(SIZE(GRM%TGRPE%CUR%XLAI)))
- GRM%TGR%CUR%XAN = 0.
+ ALLOCATE(PEK%XAN(SIZE(PEK%XLAI)))
+ PEK%XAN = 0.
!
- ALLOCATE(GRM%TGR%CUR%XANDAY(SIZE(GRM%TGRPE%CUR%XLAI)))
- GRM%TGR%CUR%XANDAY = 0.
+ ALLOCATE(PEK%XANDAY(SIZE(PEK%XLAI)))
+ PEK%XANDAY = 0.
!
- ALLOCATE(GRM%TGR%CUR%XANFM(SIZE(GRM%TGRPE%CUR%XLAI)))
- GRM%TGR%CUR%XANFM = XANFMINIT
+ ALLOCATE(PEK%XANFM(SIZE(PEK%XLAI)))
+ PEK%XANFM = XANFMINIT
!
- ALLOCATE(GRM%TGR%CUR%XLE(SIZE(GRM%TGRPE%CUR%XLAI)))
- GRM%TGR%CUR%XLE = 0.
+ ALLOCATE(PEK%XLE(SIZE(PEK%XLAI)))
+ PEK%XLE = 0.
!
ENDIF
!
-IF (TVG%CPHOTO == 'AGS' .OR. TVG%CPHOTO == 'AST') THEN
-!
- ALLOCATE(GRM%TGR%CUR%XBIOMASS(SIZE(GRM%TGRPE%CUR%XLAI),TVG%NNBIOMASS))
- GRM%TGR%CUR%XBIOMASS(:,1) = 0.
-!
- ALLOCATE(GRM%TGR%CUR%XRESP_BIOMASS(SIZE(GRM%TGRPE%CUR%XLAI),TVG%NNBIOMASS))
- GRM%TGR%CUR%XRESP_BIOMASS(:,:) = 0.
-!
-ELSEIF (TVG%CPHOTO == 'LAI' .OR. TVG%CPHOTO == 'LST') THEN
+IF (IO%CPHOTO == 'AST') THEN
!
- ALLOCATE(GRM%TGR%CUR%XBIOMASS(SIZE(GRM%TGRPE%CUR%XLAI),TVG%NNBIOMASS))
- GRM%TGR%CUR%XBIOMASS(:,1) = GRM%TGRPE%CUR%XLAI(:) * GRM%TGRP%XBSLAI(:)
+ ALLOCATE(PEK%XBIOMASS(SIZE(PEK%XLAI),IO%NNBIOMASS))
+ PEK%XBIOMASS(:,1) = 0.
!
- ALLOCATE(GRM%TGR%CUR%XRESP_BIOMASS(SIZE(GRM%TGRPE%CUR%XLAI),TVG%NNBIOMASS))
- GRM%TGR%CUR%XRESP_BIOMASS(:,:) = 0.
+ ALLOCATE(PEK%XRESP_BIOMASS(SIZE(PEK%XLAI),IO%NNBIOMASS))
+ PEK%XRESP_BIOMASS(:,:) = 0.
!
-ELSEIF (TVG%CPHOTO == 'NIT' .OR. TVG%CPHOTO == 'NCB') THEN
+ELSEIF (IO%CPHOTO == 'NIT' .OR. IO%CPHOTO == 'NCB') THEN
!
- ALLOCATE(GRM%TGR%CUR%XBIOMASS(SIZE(GRM%TGRPE%CUR%XLAI),TVG%NNBIOMASS))
- GRM%TGR%CUR%XBIOMASS(:,1) = GRM%TGRPE%CUR%XLAI(:) * GRM%TGRP%XBSLAI_NITRO(:)
- GRM%TGR%CUR%XBIOMASS(:,2) = MAX( 0., (GRM%TGR%CUR%XBIOMASS(:,1)/ (XCC_NIT/10.**XCA_NIT)) &
- **(1.0/(1.0-XCA_NIT)) - GRM%TGR%CUR%XBIOMASS(:,1) )
- GRM%TGR%CUR%XBIOMASS(:,3:TVG%NNBIOMASS) = 0.
+ ALLOCATE(PEK%XBIOMASS(SIZE(PEK%XLAI),IO%NNBIOMASS))
+ PEK%XBIOMASS(:,1) = PEK%XLAI(:) * P%XBSLAI_NITRO(:)
+ PEK%XBIOMASS(:,2) = MAX( 0., (PEK%XBIOMASS(:,1)/ (XCC_NIT/10.**XCA_NIT)) &
+ **(1.0/(1.0-XCA_NIT)) - PEK%XBIOMASS(:,1) )
+ PEK%XBIOMASS(:,3:IO%NNBIOMASS) = 0.
!
- ALLOCATE(GRM%TGR%CUR%XRESP_BIOMASS(SIZE(GRM%TGRPE%CUR%XLAI),TVG%NNBIOMASS))
- GRM%TGR%CUR%XRESP_BIOMASS(:,:) = 0.
+ ALLOCATE(PEK%XRESP_BIOMASS(SIZE(PEK%XLAI),IO%NNBIOMASS))
+ PEK%XRESP_BIOMASS(:,:) = 0.
!
ENDIF
!
diff --git a/src/SURFEX/prep_teb_greenroof_ascllv.F90 b/src/SURFEX/prep_teb_greenroof_ascllv.F90
index 0bffcd7b64d94484a130366ab79e8635e5b335b7..aae3ddd71f7d163127c346c1467ab2087c8770fb 100644
--- a/src/SURFEX/prep_teb_greenroof_ascllv.F90
+++ b/src/SURFEX/prep_teb_greenroof_ascllv.F90
@@ -33,12 +33,12 @@ SUBROUTINE PREP_TEB_GREENROOF_ASCLLV (DTCO, UG, U, USS, &
!
!
!
-!
+USE MODD_SURFEX_MPI, ONLY : NPROC, NINDEX, NNUM, NCOMM, NPIO, NRANK
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_PREP, ONLY : CINTERP_TYPE
USE MODD_PGD_GRID, ONLY : NL,LLATLONMASK,CGRID,XGRID_PAR,NGRID_PAR
@@ -60,13 +60,17 @@ USE MODI_GET_TYPE_DIM_n
!
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1 declarations of arguments
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
@@ -79,13 +83,44 @@ INTEGER :: JV ! loop counter
INTEGER :: JLAYER
INTEGER :: IL
!
+INTEGER, DIMENSION(0:NPROC-1) :: INB
+INTEGER :: INFOMPI, JJ
+!
REAL, ALLOCATABLE, DIMENSION(:,:) :: ZFIELD
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PREP_TEB_GREENROOF_ASCLLV',0,ZHOOK_HANDLE)
- CATYPE = 'ARI'
+!
+IF (.NOT.ALLOCATED(NNUM)) THEN
+ ALLOCATE(NNUM(U%NDIM_FULL))
+ IF (NRANK/=NPIO) THEN
+ IF (ALLOCATED(NINDEX)) DEALLOCATE(NINDEX)
+ ALLOCATE(NINDEX(U%NDIM_FULL))
+ ENDIF
+ IF (NRANK==NPIO) THEN
+ INB(:) = 0
+ DO JJ=1,U%NDIM_FULL
+ INB(NINDEX(JJ)) = INB(NINDEX(JJ))+1
+ NNUM(JJ) = INB(NINDEX(JJ))
+ ENDDO
+ ENDIF
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_BCAST(NINDEX,SIZE(NINDEX)*KIND(NINDEX)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(NNUM,SIZE(NNUM)*KIND(NNUM)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(UG%NGRID_FULL_PAR,KIND(UG%NGRID_FULL_PAR)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#endif
+ IF (NRANK/=NPIO) ALLOCATE(UG%XGRID_FULL_PAR(UG%NGRID_FULL_PAR))
+#ifdef SFX_MPI
+ CALL MPI_BCAST(UG%XGRID_FULL_PAR,&
+ SIZE(UG%XGRID_FULL_PAR)*KIND(UG%XGRID_FULL_PAR)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
+#endif
+ ENDIF
+ENDIF
+!
+CATYPE = 'ARI'
!
!* 1. get full dimension of grid
!
@@ -155,8 +190,15 @@ END SELECT
!* 6. Interpolation method
! --------------------
!
- CINTERP_TYPE='NONE '
+CINTERP_TYPE='NONE '
DEALLOCATE(ZFIELD)
+!
+DEALLOCATE(NNUM)
+IF (NRANK/=NPIO) THEN
+ DEALLOCATE(NINDEX,UG%XGRID_FULL_PAR)
+ ALLOCATE(NINDEX(0))
+ENDIF
+!
IF (LHOOK) CALL DR_HOOK('PREP_TEB_GREENROOF_ASCLLV',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_teb_greenroof_buffer.F90 b/src/SURFEX/prep_teb_greenroof_buffer.F90
index 682a4faaf9005af718d339f579033093f37d381d..16fae26f9e09bc2ecca8a306c10429eef471e9db 100644
--- a/src/SURFEX/prep_teb_greenroof_buffer.F90
+++ b/src/SURFEX/prep_teb_greenroof_buffer.F90
@@ -135,14 +135,14 @@ END SELECT
!* 4. Interpolation method
! --------------------
!
- CINTERP_TYPE='BUFFER'
+CINTERP_TYPE='BUFFER'
!
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PREP_TEB_GREENROOF_BUFFER',1,ZHOOK_HANDLE)
- CONTAINS
+CONTAINS
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_teb_greenroof_extern.F90 b/src/SURFEX/prep_teb_greenroof_extern.F90
index 44e2273bb6646d2f8786b45917350f7dcb01b437..afcb6662facd46989c23f2393a4eba4bdb2ef531 100644
--- a/src/SURFEX/prep_teb_greenroof_extern.F90
+++ b/src/SURFEX/prep_teb_greenroof_extern.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_TEB_GREENROOF_EXTERN (DTCO, I, U,GCP, &
+SUBROUTINE PREP_TEB_GREENROOF_EXTERN (DTCO, IO, U, GCP, &
HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,KPATCH,PFIELD)
! #################################################################################
!
@@ -27,14 +27,14 @@ SUBROUTINE PREP_TEB_GREENROOF_EXTERN (DTCO, I, U,GCP, &
!! MODIFICATIONS
!! -------------
!! Original 07/2011
-!! M.Moge 01/2016 using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads
!!------------------------------------------------------------------
!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
+!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
!
USE MODE_READ_EXTERN
!
@@ -47,6 +47,7 @@ USE MODI_OPEN_AUX_IO_SURF
USE MODI_CLOSE_AUX_IO_SURF
USE MODI_READ_TEB_PATCH
USE MODI_TOWN_PRESENCE
+USE MODI_MAKE_CHOICE_ARRAY
!
USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
USE MODD_PREP_TEB_GREENROOF, ONLY : XGRID_SOIL, XWR_DEF
@@ -57,7 +58,6 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
USE MODI_PUT_ON_ALL_VEGTYPES
-USE MODI_READ_SURF_FIELD2D
!
IMPLICIT NONE
!
@@ -65,7 +65,7 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
@@ -91,15 +91,16 @@ REAL, DIMENSION(:,:), POINTER :: ZFIELD1 ! field read on initial MN
REAL, DIMENSION(:,:,:), POINTER :: ZD ! depth of field in the soil
REAL, DIMENSION(:,:), POINTER :: ZD1 ! depth of field in the soil, one patch
REAL, DIMENSION(:,:), ALLOCATABLE :: ZOUT !
-LOGICAL :: GTEB ! flag if TEB fields are present
-INTEGER :: JPATCH ! loop counter for patch
CHARACTER(LEN=LEN_HREC) :: YSURF ! type of field
+ CHARACTER(LEN=3) :: YPATCH ! indentificator for TEB patch
+INTEGER :: JPATCH ! loop counter for patch
INTEGER :: ITEB_PATCH ! number of TEB patches in file
INTEGER :: IVERSION ! SURFEX version
INTEGER :: IBUGFIX ! SURFEX bug version
-LOGICAL :: GOLD_NAME ! old name flag for temperatures
- CHARACTER(LEN=3) :: YPATCH ! indentificator for TEB patch
-LOGICAL :: GGREENROOF ! T if gardens are present in the file
+LOGICAL :: GTEB ! flag if TEB fields are present
+LOGICAL :: GOLD_NAME ! old name flag for temperatures
+LOGICAL :: GGREENROOF ! T if gardens are present in the file
+LOGICAL :: GDIM
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -114,14 +115,11 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PREP_TEB_GREENROOF_EXTERN',0,ZHOOK_HANDLE)
!
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'FULL ')
+CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'FULL ')
!
!* reading of version of the file being read
- CALL READ_SURF(&
- HFILEPGDTYPE,'VERSION',IVERSION,IRESP)
- CALL READ_SURF(&
- HFILEPGDTYPE,'BUG',IBUGFIX,IRESP)
+CALL READ_SURF(HFILEPGDTYPE,'VERSION',IVERSION,IRESP)
+CALL READ_SURF(HFILEPGDTYPE,'BUG',IBUGFIX,IRESP)
GOLD_NAME=(IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<3))
!
!------------------------------------------------------------------------------
@@ -129,24 +127,24 @@ GOLD_NAME=(IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<3))
!* 2. Reading of grid
! ---------------
!
- CALL PREP_GRID_EXTERN(GCP,&
- HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
+CALL PREP_GRID_EXTERN(GCP,HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
+!
+IF (NRANK/=NPIO) INI = 0
!
!* reads if TEB fields exist in the input file
- CALL TOWN_PRESENCE(&
- HFILEPGDTYPE,GTEB)
+CALL TOWN_PRESENCE(HFILEPGDTYPE,GTEB,HDIR='-')
!
IF (GTEB) THEN
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- CALL READ_TEB_PATCH(&
- HFILEPGD,HFILEPGDTYPE,ITEB_PATCH)
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'FULL ')
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ')
+ CALL READ_TEB_PATCH(HFILEPGD,HFILEPGDTYPE,IVERSION,IBUGFIX,ITEB_PATCH,HDIR='-')
YPATCH=' '
IF (ITEB_PATCH>1) THEN
WRITE(YPATCH,FMT='(A,I1,A)') 'T',MIN(KPATCH,ITEB_PATCH),'_'
END IF
END IF
+!
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
!
! A FAIRE : VERIFIER QUE LES MODIFS DES PATCH/GTEB/GGREENROOF SONT CORRECTES
!---------------------------------------------------------------------------------------
@@ -162,8 +160,8 @@ SELECT CASE(HSURF)
CASE('ZS ')
ALLOCATE(PFIELD(INI,1,1))
YRECFM='ZS'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,PFIELD(:,1,1),IRESP,HDIR='A')
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ')
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1,1),IRESP,HDIR='A')
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
!
!--------------------------------------------------------------------------
@@ -173,85 +171,88 @@ SELECT CASE(HSURF)
!
CASE('TG ','WG ','WGI ')
!* choice if one reads garden fields (if present) or ISBA fields
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'TOWN ')
- GGREENROOF = .FALSE.
- IF (GTEB) CALL READ_SURF(&
- HFILEPGDTYPE,'LGREENROOF',GGREENROOF,IRESP)
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- IF (GGREENROOF) THEN
- YSURF = 'GR_'//HSURF(1:3)
- YSURF=YPATCH//YSURF
- ELSE
- YSURF = HSURF
- END IF
- YSURF=ADJUSTL(YSURF)
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ')
+ GGREENROOF = .FALSE.
+ IF (GTEB) CALL READ_SURF(HFILEPGDTYPE,'LGREENROOF',GGREENROOF,IRESP,HDIR='-')
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ IF (GGREENROOF) THEN
+ YSURF = 'GR_'//HSURF(1:3)
+ YSURF=YPATCH//YSURF
+ ELSE
+ YSURF = HSURF
+ END IF
+ YSURF=ADJUSTL(YSURF)
!* reading of the profile and its depth definition
- CALL READ_EXTERN_ISBA(U, &
- DTCO, I,GCP, &
- HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,INI,&
- HSURF,YSURF,ZFIELD,ZD)
+ CALL READ_EXTERN_ISBA(U, DTCO, GCP, IO, HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,INI,&
+ HSURF,YSURF,ZFIELD,ZD)
!
- ALLOCATE(ZFIELD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
- ALLOCATE(ZD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
- ALLOCATE(ZOUT(SIZE(ZFIELD,1),SIZE(XGRID_SOIL)))
- ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_SOIL),SIZE(ZFIELD,3)))
-!
- DO JPATCH=1,SIZE(ZFIELD,3)
- ZFIELD1(:,:)=ZFIELD(:,:,JPATCH)
- ZD1(:,:)=ZD(:,:,JPATCH)
- CALL INTERP_GRID_NAT(ZD1,ZFIELD1,XGRID_SOIL,ZOUT)
- PFIELD(:,:,JPATCH)=ZOUT(:,:)
- END DO
-!
- DEALLOCATE(ZFIELD)
- DEALLOCATE(ZOUT)
- DEALLOCATE(ZFIELD1)
- DEALLOCATE(ZD)
+ IF (NRANK==NPIO) THEN
+
+ ALLOCATE(ZFIELD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
+ ALLOCATE(ZD1 (SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
+ ALLOCATE(ZOUT (SIZE(ZFIELD,1),SIZE(XGRID_SOIL)))
+ ALLOCATE(PFIELD (SIZE(ZFIELD,1),SIZE(XGRID_SOIL),SIZE(ZFIELD,3)))
+ DO JPATCH=1,SIZE(ZFIELD,3)
+ ZFIELD1(:,:)=ZFIELD(:,:,JPATCH)
+ ZD1(:,:)=ZD(:,:,JPATCH)
+ CALL INTERP_GRID_NAT(ZD1,ZFIELD1,XGRID_SOIL,ZOUT)
+ PFIELD(:,:,JPATCH)=ZOUT(:,:)
+ END DO
+ DEALLOCATE(ZFIELD)
+ DEALLOCATE(ZOUT)
+ DEALLOCATE(ZFIELD1)
+ DEALLOCATE(ZD)
+
+ ENDIF
!
!--------------------------------------------------------------------------
!
!* 3.4 Water content intercepted on leaves, LAI
!
CASE('WR ')
- ALLOCATE(PFIELD(INI,1,NVEGTYPE))
!* choice if one reads garden fields (if present) or ISBA fields
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'TOWN ')
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ')
GGREENROOF = .FALSE.
- IF (GTEB) CALL READ_SURF(&
- HFILEPGDTYPE,'LGREENROOF',GGREENROOF,IRESP)
+ IF (GTEB) CALL READ_SURF(HFILEPGDTYPE,'LGREENROOF',GGREENROOF,IRESP,HDIR='-')
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
IF (GGREENROOF) THEN
IPATCH = 1
- YRECFM = 'GD_WR'
+ YRECFM = 'GR_WR'
YRECFM=YPATCH//YRECFM
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'TOWN ')
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ')
ELSE
YRECFM = 'PATCH_NUMBER'
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'NATURE')
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,IPATCH,IRESP)
+ IPATCH = 0
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP,HDIR='-')
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'NATURE')
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
YRECFM = 'WR'
END IF
+
+ CALL READ_SURF(HFILETYPE,'VERSION',IVERSION,IRESP)
+ CALL READ_SURF(HFILETYPE,'BUG',IBUGFIX,IRESP)
+ GDIM = (IVERSION>8 .OR. IVERSION==8 .AND. IBUGFIX>0)
+ IF (GDIM) CALL READ_SURF(HFILETYPE,'SPLIT_PATCH',GDIM,IRESP)
YRECFM=ADJUSTL(YRECFM)
ALLOCATE(ZFIELD(INI,1,IPATCH))
- CALL READ_SURF_FIELD2D(&
- HFILETYPE,ZFIELD(:,1,:),YRECFM,HDIR='A')
+ IF (GGREENROOF) THEN
+ CALL READ_SURF(HFILETYPE,YRECFM,ZFIELD(:,1,1),IRESP,HDIR='E')
+ ELSE
+ CALL MAKE_CHOICE_ARRAY(HFILETYPE, IPATCH, GDIM, YRECFM, ZFIELD(:,1,:),HDIR='E')
+ ENDIF
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
- CALL PUT_ON_ALL_VEGTYPES(INI,1,1,NVEGTYPE,ZFIELD,PFIELD)
+ IF (IPATCH/=1) THEN
+ ALLOCATE(PFIELD(INI,1,NVEGTYPE))
+ CALL PUT_ON_ALL_VEGTYPES(INI,1,IPATCH,NVEGTYPE,ZFIELD,PFIELD)
+ ELSE
+ ALLOCATE(PFIELD(INI,1,1))
+ PFIELD(:,:,:) = ZFIELD(:,:,:)
+ ENDIF
DEALLOCATE(ZFIELD)
!
CASE('LAI ')
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- ALLOCATE(PFIELD(INI,1,NVEGTYPE))
+ ALLOCATE(PFIELD(INI,1,1))
PFIELD(:,:,:) = XUNDEF
!
END SELECT
diff --git a/src/SURFEX/prep_teb_greenroof_grib.F90 b/src/SURFEX/prep_teb_greenroof_grib.F90
index 1b92b17a3d7049fcccf68fd10006b122713236f8..4bbd19b523c875e2bf8cd9c5fd8e5405e7326cd0 100644
--- a/src/SURFEX/prep_teb_greenroof_grib.F90
+++ b/src/SURFEX/prep_teb_greenroof_grib.F90
@@ -34,14 +34,12 @@ USE MODE_READ_GRIB
!
USE MODD_TYPE_DATE_SURF
!
-USE MODI_PREP_GRIB_GRID
USE MODI_INTERP_GRID_NAT
!
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
USE MODD_PREP_TEB_GREENROOF, ONLY : XGRID_SOIL, XWR_DEF
USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_GRID_GRIB, ONLY : CGRIB_FILE, NNI
+USE MODD_GRID_GRIB, ONLY : CGRIB_FILE, NNI, CINMODEL
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -61,8 +59,6 @@ REAL,DIMENSION(:,:,:), POINTER :: PFIELD ! field to interpolate horizontally
!
!* 0.2 declarations of local variables
!
-TYPE (DATE_TIME) :: TZTIME_GRIB ! current date and time
- CHARACTER(LEN=6) :: YINMODEL ! model from which GRIB file originates
REAL, DIMENSION(:) , POINTER :: ZMASK => NULL() ! Land mask
REAL, DIMENSION(:,:), POINTER :: ZFIELD => NULL() ! field read
REAL, DIMENSION(:), POINTER :: ZFIELD1D => NULL() ! field read
@@ -79,9 +75,7 @@ IF (LHOOK) CALL DR_HOOK('PREP_TEB_GREENROOF_GRIB',0,ZHOOK_HANDLE)
!
IF (TRIM(HFILE).NE.CGRIB_FILE) CGRIB_FILE=""
!
- CALL PREP_GRIB_GRID(HFILE,KLUOUT,YINMODEL,CINGRID_TYPE,TZTIME_GRIB)
-!
- CALL READ_GRIB_LAND_MASK(HFILE,KLUOUT,YINMODEL,ZMASK)
+ CALL READ_GRIB_LAND_MASK(HFILE,KLUOUT,CINMODEL,ZMASK)
!
!* 2. Reading of field
! ----------------
@@ -95,25 +89,25 @@ SELECT CASE(HSURF)
!
CASE('TG ')
!* reading of the profile and its depth definition
- SELECT CASE(YINMODEL)
+ SELECT CASE(CINMODEL)
CASE('ECMWF ')
- CALL READ_GRIB_TG_ECMWF(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_TG_ECMWF(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
CASE('ARPEGE','ALADIN','MOCAGE')
- CALL READ_GRIB_TG_METEO_FRANCE(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_TG_METEO_FRANCE(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
CASE('HIRLAM')
- CALL READ_GRIB_TG_HIRLAM(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_TG_HIRLAM(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
END SELECT
CALL SOIL_PROFILE_GRIB
CASE('WG ')
!* reading of the profile and its depth definition
- SELECT CASE(YINMODEL)
+ SELECT CASE(CINMODEL)
CASE('ECMWF ')
- CALL READ_GRIB_WG_ECMWF(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_WG_ECMWF(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
CASE('ARPEGE','ALADIN','MOCAGE')
- CALL READ_GRIB_WG_METEO_FRANCE(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_WG_METEO_FRANCE(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
CASE('HIRLAM')
- CALL READ_GRIB_WG_HIRLAM(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_WG_HIRLAM(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
END SELECT
CALL SOIL_PROFILE_GRIB
@@ -122,11 +116,11 @@ SELECT CASE(HSURF)
CASE('WGI ')
!* reading of the profile and its depth definition
- SELECT CASE(YINMODEL)
+ SELECT CASE(CINMODEL)
CASE('ECMWF ')
- CALL READ_GRIB_WGI_ECMWF(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_WGI_ECMWF(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
CASE('ARPEGE','ALADIN','MOCAGE')
- CALL READ_GRIB_WGI_METEO_FRANCE(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_WGI_METEO_FRANCE(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
CASE('HIRLAM')
CALL READ_GRIB_WGI_HIRLAM(HFILE,KLUOUT,ZFIELD,ZD)
END SELECT
@@ -135,18 +129,18 @@ SELECT CASE(HSURF)
!* 3.4 Water content intercepted on leaves, LAI
!
CASE('WR ')
- ALLOCATE(PFIELD(NNI,1,NVEGTYPE))
+ ALLOCATE(PFIELD(NNI,1,1))
PFIELD(:,:,:) = XWR_DEF
!
CASE('LAI ')
- ALLOCATE(PFIELD(NNI,1,NVEGTYPE))
+ ALLOCATE(PFIELD(NNI,1,1))
PFIELD(:,:,:) = XUNDEF
!
!
!* 3.5 Other fields
!
CASE('ZS ')
- CALL READ_GRIB_ZS_LAND(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD1D)
+ CALL READ_GRIB_ZS_LAND(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD1D)
ALLOCATE(PFIELD(SIZE(ZFIELD1D,1),1,1))
PFIELD(:,1,1)=ZFIELD1D(:)
DEALLOCATE(ZFIELD1D)
@@ -160,14 +154,12 @@ DEALLOCATE(ZMASK)
!
!* 4. Interpolation method
! --------------------
-!
- CINTERP_TYPE='HORIBL'
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PREP_TEB_GREENROOF_GRIB',1,ZHOOK_HANDLE)
- CONTAINS
+CONTAINS
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
@@ -186,10 +178,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
CALL INTERP_GRID_NAT(ZD,ZFIELD,XGRID_SOIL,ZOUT)
!
!* extends definition to all vegtypes.
- ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_SOIL),NVEGTYPE))
- DO JVEGTYPE=1,NVEGTYPE
- PFIELD(:,:,JVEGTYPE)=ZOUT(:,:)
- END DO
+ ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_SOIL),1))
+ PFIELD(:,:,1)=ZOUT(:,:)
!* end
DEALLOCATE(ZOUT)
DEALLOCATE(ZFIELD)
diff --git a/src/SURFEX/prep_teb_greenroof_unif.F90 b/src/SURFEX/prep_teb_greenroof_unif.F90
index db2db699126b36414ab85da61cd6dce53b710bf7..17d3556394716e4ad9e9afe28d316066d5ce7559 100644
--- a/src/SURFEX/prep_teb_greenroof_unif.F90
+++ b/src/SURFEX/prep_teb_greenroof_unif.F90
@@ -70,41 +70,35 @@ SELECT CASE(HSURF)
!* 3.1 Profile of soil relative humidity
!
CASE('WG ')
- ALLOCATE(PFIELD(1,3,NVEGTYPE))
- DO JV=1,NVEGTYPE
- PFIELD(:,1,JV) = XHUG_SURF_GR
- PFIELD(:,2,JV) = XHUG_ROOT_GR
- PFIELD(:,3,JV) = XHUG_DEEP_GR
- END DO
-
+ ALLOCATE(PFIELD(1,3,1))
+ PFIELD(:,1,1) = XHUG_SURF_GR
+ PFIELD(:,2,1) = XHUG_ROOT_GR
+ PFIELD(:,3,1) = XHUG_DEEP_GR
+!
!* 3.2 Profile of soil humidity for ice
CASE('WGI ')
- ALLOCATE(PFIELD(1,3,NVEGTYPE))
- DO JV=1,NVEGTYPE
- PFIELD(:,1,JV) = XHUGI_SURF_GR
- PFIELD(:,2,JV) = XHUGI_ROOT_GR
- PFIELD(:,3,JV) = XHUGI_DEEP_GR
- END DO
+ ALLOCATE(PFIELD(1,3,1))
+ PFIELD(:,1,1) = XHUGI_SURF_GR
+ PFIELD(:,2,1) = XHUGI_ROOT_GR
+ PFIELD(:,3,1) = XHUGI_DEEP_GR
!* 3.3 Profile of temperatures
CASE('TG ')
- ALLOCATE(PFIELD(1,3,NVEGTYPE))
- DO JV=1,NVEGTYPE
- PFIELD(:,1,JV) = XTG_SURF_GR
- PFIELD(:,2,JV) = XTG_ROOT_GR
- PFIELD(:,3,JV) = XTG_DEEP_GR
- END DO
+ ALLOCATE(PFIELD(1,3,1))
+ PFIELD(:,1,1) = XTG_SURF_GR
+ PFIELD(:,2,1) = XTG_ROOT_GR
+ PFIELD(:,3,1) = XTG_DEEP_GR
!* 3.4 Other quantities
CASE('WR ')
- ALLOCATE(PFIELD(1,1,NVEGTYPE))
+ ALLOCATE(PFIELD(1,1,1))
PFIELD = XWR_DEF
CASE('LAI ')
- ALLOCATE(PFIELD(1,1,NVEGTYPE))
+ ALLOCATE(PFIELD(1,1,1))
PFIELD = XUNDEF
END SELECT
@@ -112,7 +106,7 @@ END SELECT
!* 4. Interpolation method
! --------------------
!
- CINTERP_TYPE='UNIF '
+CINTERP_TYPE='UNIF '
IF (LHOOK) CALL DR_HOOK('PREP_TEB_GREENROOF_UNIF',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_teb_grib.F90 b/src/SURFEX/prep_teb_grib.F90
index fa44147727bc15cfec708e47d91781802df47094..d2fb790e664191ad2a710ad8ba5d3b84d3bec8ad 100644
--- a/src/SURFEX/prep_teb_grib.F90
+++ b/src/SURFEX/prep_teb_grib.F90
@@ -27,16 +27,13 @@ SUBROUTINE PREP_TEB_GRIB(HPROGRAM,HSURF,HFILE,KLUOUT,PFIELD)
!! Original 01/2004
!!------------------------------------------------------------------
!
-
!
USE MODD_TYPE_DATE_SURF
!
-USE MODI_PREP_GRIB_GRID
USE MODE_READ_GRIB
USE MODI_INTERP_GRID
!
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
-USE MODD_GRID_GRIB, ONLY : CGRIB_FILE, NNI
+USE MODD_GRID_GRIB, ONLY : CGRIB_FILE, NNI, CINMODEL
USE MODD_PREP_TEB, ONLY : XGRID_ROAD, XGRID_WALL, XGRID_ROOF, XGRID_FLOOR, &
XTI_BLD, XTI_ROAD, XHUI_BLD, XTI_BLD_DEF, &
XHUI_BLD_DEF
@@ -58,8 +55,6 @@ REAL,DIMENSION(:,:), POINTER :: PFIELD ! field to interpolate horizontally
!
!* 0.2 declarations of local variables
!
-TYPE (DATE_TIME) :: TZTIME_GRIB ! current date and time
- CHARACTER(LEN=6) :: YINMODEL ! model from which GRIB file originates
REAL, DIMENSION(:) , POINTER :: ZMASK => NULL() ! Land mask
REAL, DIMENSION(:), POINTER :: ZFIELD1D => NULL() ! 1D field read
REAL, DIMENSION(:,:), POINTER :: ZFIELD => NULL() ! field read
@@ -76,9 +71,7 @@ REAL :: ZTI_BLD !indoor air temperature
!
IF (TRIM(HFILE).NE.CGRIB_FILE) CGRIB_FILE=""
!
- CALL PREP_GRIB_GRID(HFILE,KLUOUT,YINMODEL,CINGRID_TYPE,TZTIME_GRIB)
-!
- CALL READ_GRIB_LAND_MASK(HFILE,KLUOUT,YINMODEL,ZMASK)
+ CALL READ_GRIB_LAND_MASK(HFILE,KLUOUT,CINMODEL,ZMASK)
!
IF (HSURF=='T_FLOOR' .OR. HSURF(1:6)=='T_WALL' .OR. HSURF=='T_ROOF' .OR. &
HSURF=='T_WIN2' .OR. HSURF=='TI_BLD' .OR. HSURF=='T_MASS') THEN
@@ -94,9 +87,9 @@ SELECT CASE(HSURF)
! ---------
!
CASE('ZS ')
- SELECT CASE (YINMODEL)
- CASE ('ECMWF ','ARPEGE','ALADIN','MOCAGE')
- CALL READ_GRIB_ZS_LAND(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD1D)
+ SELECT CASE (CINMODEL)
+ CASE ('ECMWF ','ARPEGE','ALADIN','MOCAGE','HIRLAM')
+ CALL READ_GRIB_ZS_LAND(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD1D)
ALLOCATE(PFIELD(SIZE(ZFIELD1D),1))
PFIELD(:,1) = ZFIELD1D(:)
DEALLOCATE(ZFIELD1D)
@@ -107,11 +100,13 @@ SELECT CASE(HSURF)
!
CASE('T_ROAD')
!* reading of the profile and its depth definition
- SELECT CASE(YINMODEL)
+ SELECT CASE(CINMODEL)
CASE('ECMWF ')
- CALL READ_GRIB_TG_ECMWF(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_TG_ECMWF(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
CASE('ARPEGE','ALADIN','MOCAGE')
- CALL READ_GRIB_TG_METEO_FRANCE(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_TG_METEO_FRANCE(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
+ CASE('HIRLAM')
+ CALL READ_GRIB_TG_HIRLAM(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD,ZD)
END SELECT
!* if deep road temperature is prescribed
IF (XTI_ROAD/=XUNDEF) THEN
@@ -124,9 +119,9 @@ SELECT CASE(HSURF)
CASE('T_FLOOR')
!* reading of the profile and its depth definition
- SELECT CASE(YINMODEL)
- CASE('ECMWF ','ARPEGE','ALADIN','MOCAGE')
- CALL READ_GRIB_TF_TEB(HFILE,KLUOUT,YINMODEL,ZTI_BLD,ZMASK,ZFIELD,ZD)
+ SELECT CASE(CINMODEL)
+ CASE('ECMWF ','ARPEGE','ALADIN','MOCAGE','HIRLAM')
+ CALL READ_GRIB_TF_TEB(HFILE,KLUOUT,CINMODEL,ZTI_BLD,ZMASK,ZFIELD,ZD)
END SELECT
!* if deep road temperature is prescribed
IF (XTI_ROAD/=XUNDEF) THEN
@@ -138,13 +133,13 @@ SELECT CASE(HSURF)
! --------------------------------
CASE('T_WALLA','T_WALLB')
- CALL READ_GRIB_T_TEB(HFILE,KLUOUT,YINMODEL,ZTI_BLD,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_T_TEB(HFILE,KLUOUT,CINMODEL,ZTI_BLD,ZMASK,ZFIELD,ZD)
CALL TEB_PROFILE_GRIB(XGRID_WALL)
CASE('T_WIN1')
- SELECT CASE (YINMODEL)
- CASE ('ECMWF ','ARPEGE','ALADIN','MOCAGE')
- CALL READ_GRIB_TS(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD1D)
+ SELECT CASE (CINMODEL)
+ CASE ('ECMWF ','ARPEGE','ALADIN','MOCAGE','HIRLAM')
+ CALL READ_GRIB_TS(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD1D)
ALLOCATE(PFIELD(NNI,1))
PFIELD(:,1) = ZFIELD1D(:)
DEALLOCATE(ZFIELD1D)
@@ -154,7 +149,7 @@ SELECT CASE(HSURF)
! --------------------------------
!
CASE('T_ROOF')
- CALL READ_GRIB_T_TEB(HFILE,KLUOUT,YINMODEL,ZTI_BLD,ZMASK,ZFIELD,ZD)
+ CALL READ_GRIB_T_TEB(HFILE,KLUOUT,CINMODEL,ZTI_BLD,ZMASK,ZFIELD,ZD)
CALL TEB_PROFILE_GRIB(XGRID_ROOF)
!
!* 5.bis Profile of temperatures in thermal mass
@@ -168,9 +163,9 @@ SELECT CASE(HSURF)
! ----------------------
!
CASE('T_CAN ')
- SELECT CASE (YINMODEL)
- CASE ('ECMWF ','ARPEGE','ALADIN','MOCAGE')
- CALL READ_GRIB_T2(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD1D)
+ SELECT CASE (CINMODEL)
+ CASE ('ECMWF ','ARPEGE','ALADIN','MOCAGE','HIRLAM')
+ CALL READ_GRIB_T2_LAND(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD1D)
ALLOCATE(PFIELD(SIZE(ZFIELD1D),1))
PFIELD(:,1) = ZFIELD1D(:)
DEALLOCATE(ZFIELD1D)
@@ -180,8 +175,8 @@ SELECT CASE(HSURF)
! -------------------
!
CASE('Q_CAN ')
- SELECT CASE (YINMODEL)
- CASE ('ECMWF ','ARPEGE','ALADIN','MOCAGE')
+ SELECT CASE (CINMODEL)
+ CASE ('ECMWF ','ARPEGE','ALADIN','MOCAGE','HIRLAM')
ALLOCATE(PFIELD(NNI,1))
PFIELD(:,1) = 0.01
END SELECT
@@ -192,7 +187,7 @@ SELECT CASE(HSURF)
CASE('TI_ROAD')
IF (XTI_ROAD==XUNDEF) THEN
- CALL READ_GRIB_T2(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD1D)
+ CALL READ_GRIB_T2_LAND(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD1D)
ALLOCATE(PFIELD(SIZE(ZFIELD1D),1))
PFIELD(:,1) = ZFIELD1D(:)
DEALLOCATE(ZFIELD1D)
@@ -230,14 +225,12 @@ DEALLOCATE(ZMASK)
!
!* 4. Interpolation method
! --------------------
-!
- CINTERP_TYPE='HORIBL'
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
!
!IF (LHOOK) CALL DR_HOOK('PREP_TEB_GRIB',1,ZHOOK_HANDLE)
- CONTAINS
+CONTAINS
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_teb_unif.F90 b/src/SURFEX/prep_teb_unif.F90
index 43a5c811b5b5330bb73112cc335236588cc70c23..50dadeb42de24456ab227bcd6b85f070c28eb124 100644
--- a/src/SURFEX/prep_teb_unif.F90
+++ b/src/SURFEX/prep_teb_unif.F90
@@ -111,12 +111,12 @@ SELECT CASE(HSURF)
PFIELD = XTI_BLD
CASE('QI_BLD ')
- ALLOCATE(PFIELD(SIZE(XZS_LS),1))
+ ALLOCATE(PFIELD(MAX(1,SIZE(XZS_LS)),1))
ALLOCATE(ZPS(SIZE(XZS_LS)))
ALLOCATE(ZTI_BLD(SIZE(XZS_LS)))
ZPS = XP00 - ZRHOA*XG*XZS_LS
ZTI_BLD = XTI_BLD
- PFIELD(:,1) = XHUI_BLD * QSAT(ZTI_BLD, ZPS)
+ PFIELD(:SIZE(XZS_LS),1) = XHUI_BLD * QSAT(ZTI_BLD, ZPS)
DEALLOCATE(ZPS)
DEALLOCATE(ZTI_BLD)
@@ -145,13 +145,13 @@ END SELECT
!* 4. Interpolation method
! --------------------
!
- CINTERP_TYPE='UNIF '
+CINTERP_TYPE='UNIF '
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PREP_TEB_UNIF',1,ZHOOK_HANDLE)
- CONTAINS
+CONTAINS
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_town.F90 b/src/SURFEX/prep_town.F90
index 9f606a8c42407ac4fa8d7c6c1ff8fb24badd8ddf..7fa7ef1dbaaa84804d0bb1fbf654be8376a9e9ce 100644
--- a/src/SURFEX/prep_town.F90
+++ b/src/SURFEX/prep_town.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_TOWN (DTCO, UG, U, USS, IG, I, TM, GDM, GRM,GCP, &
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+SUBROUTINE PREP_TOWN (DTCO, UG, U, USS, GCP, TM, GDM, GRM, &
+ HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
! #################################################################################
!
!!**** *PREP_TOWN* - chooses town scheme to prepare
@@ -26,23 +26,23 @@ SUBROUTINE PREP_TOWN (DTCO, UG, U, USS, IG, I, TM, GDM, GRM,GCP, &
!! MODIFICATIONS
!! -------------
!! Original 01/2004
+!! P. Marguinaud10/2014, Support for a 2-part PREP
!!------------------------------------------------------------------
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
+!
USE MODD_SURFEX_n, ONLY : TEB_MODEL_t
USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t
USE MODD_SURFEX_n, ONLY : TEB_GREENROOF_MODEL_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
-!
-USE MODI_PREP_TEB
!
+USE MODE_PREP_CTL, ONLY : PREP_CTL
!
+USE MODI_PREP_TEB
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -55,13 +55,12 @@ IMPLICIT NONE
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(SSO_t), INTENT(INOUT) :: USS
+TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM
TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM
-TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+TYPE (PREP_CTL), INTENT(INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! name of the Atmospheric file
@@ -77,8 +76,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PREP_TOWN',0,ZHOOK_HANDLE)
IF (U%CTOWN=='TEB ') THEN
- CALL PREP_TEB(DTCO, UG, U, USS, IG, I, TM, GDM, GRM, GCP,&
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+ CALL PREP_TEB(DTCO, UG, U, USS, GCP, TM%TOP, TM%BOP, TM%NB, TM%G, TM%SB, TM%NT, GDM, GRM, &
+ HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
END IF
IF (LHOOK) CALL DR_HOOK('PREP_TOWN',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/prep_ver_isba.F90 b/src/SURFEX/prep_ver_isba.F90
index 70771b6fd8903dcccb021a774eec7980eb881bde..b2d08819eae73d0b96ba28e225166224e4dfffc8 100644
--- a/src/SURFEX/prep_ver_isba.F90
+++ b/src/SURFEX/prep_ver_isba.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_VER_ISBA (I)
+SUBROUTINE PREP_VER_ISBA (IO, NPE, PZS, NP)
! #################################################################################
!
!!**** *PREP_VER_ISBA* - change in ISBA fields due to altitude change
@@ -30,10 +30,8 @@ SUBROUTINE PREP_VER_ISBA (I)
!! Y. Seity 02/2016 Add limits in Force-Restore case (WG2 contains WG1)
!!------------------------------------------------------------------
!
-
-!
-!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_NP_t, ISBA_NPE_t, ISBA_P_t, ISBA_PE_t
!
USE MODD_ISBA_PAR, ONLY : XWGMIN
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -43,7 +41,7 @@ USE MODD_CSTS, ONLY : XTT, XDAY, XLMTT, XRHOLW
!
USE MODE_THERMOS
USE MODI_PREP_VER_SNOW
-!
+USE MODI_PACK_SAME_RANK
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -56,20 +54,27 @@ IMPLICIT NONE
!* 0.2 declarations of local variables
!
!
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+REAL, DIMENSION(:), INTENT(IN) :: PZS
+!
+TYPE(ISBA_P_t), POINTER :: PK
+TYPE(ISBA_PE_t), POINTER :: PEK
!
INTEGER :: JL ! loop counter on layers
INTEGER :: JP ! loop counter on patches
INTEGER :: IWORK ! Work integer
!
+REAL, DIMENSION(:), ALLOCATABLE :: ZZS, ZZS_LS
REAL, DIMENSION(:), ALLOCATABLE :: ZWGTOT ! total water content
REAL, DIMENSION(:), ALLOCATABLE :: ZDW ! variation of water in soil
REAL, DIMENSION(:), ALLOCATABLE :: ZZSFREEZE ! altitude where soil temperature equals XTT
INTEGER :: IDEEP_SOIL! layer corresponding to deep soil temperature
!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWGI_CLIM_GRAD ! ice content vertical gradient
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWGI_CLIM_GRAD ! ice content vertical gradient
!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTG_LS! temperature on initial orography
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTG_LS! temperature on initial orography
!
REAL :: ZGRADX = 5.E-4 ! slope of ice content gradient
REAL :: ZH0 = 5.E-1 ! constant used to define ice content gradient
@@ -79,74 +84,88 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* 1.0 Ice content climatologic gradient
!
IF (LHOOK) CALL DR_HOOK('PREP_VER_ISBA',0,ZHOOK_HANDLE)
-ALLOCATE(ZWGI_CLIM_GRAD (SIZE(I%XWG,1),SIZE(I%XWG,2),SIZE(I%XWG,3)))
-!
-ZWGI_CLIM_GRAD(:,:,:) = ZGRADX * EXP( - I%XDG(:,:,:) / ZH0 )
-!-------------------------------------------------------------------------------------
-!
-!* 1.1 Temperature profile
-!
-ALLOCATE(ZTG_LS(SIZE(I%XTG,1),SIZE(I%XTG,2),SIZE(I%XTG,3)))
-ZTG_LS(:,:,:) = I%XTG(:,:,:)
-!
-DO JP=1,SIZE(I%XTG,3)
- DO JL=1,SIZE(I%XTG,2)
- WHERE(I%XTG(:,JL,JP)/=XUNDEF) &
- I%XTG(:,JL,JP) = I%XTG(:,JL,JP) + XT_CLIM_GRAD * (I%XZS - XZS_LS)
- END DO
-END DO
-!
-!-------------------------------------------------------------------------------------
!
-!* 1.2 Water and ice in the soil
!
-ALLOCATE(ZZSFREEZE (SIZE(I%XWG,1)))
-ALLOCATE(ZWGTOT (SIZE(I%XWG,1)))
-ALLOCATE(ZDW (SIZE(I%XWG,1)))
-!
-!* general case
-!
-IF(I%LTEMP_ARP)THEN
- IWORK=SIZE(I%XWG,2)
+IF (IO%CISBA=='DIF') THEN
+ IDEEP_SOIL = IO%NGROUND_LAYER
ELSE
- IWORK=SIZE(I%XTG,2)
-ENDIF
+ IDEEP_SOIL = 2
+END IF
!
-DO JP=1,SIZE(I%XWG,3)
+DO JP = 1,IO%NPATCH
+ !
+ PEK => NPE%AL(JP)
+ PK => NP%AL(JP)
+ !
+ IF(IO%LTEMP_ARP)THEN
+ IWORK=SIZE(PEK%XWG,2)
+ ELSE
+ IWORK=SIZE(PEK%XTG,2)
+ ENDIF
+ !
+ ALLOCATE(ZZS(PK%NSIZE_P))
+ CALL PACK_SAME_RANK(PK%NR_P,PZS,ZZS)
+ ALLOCATE(ZZS_LS(PK%NSIZE_P))
+ CALL PACK_SAME_RANK(PK%NR_P,XZS_LS,ZZS_LS)
+ !
+ ALLOCATE(ZWGI_CLIM_GRAD (SIZE(PEK%XWG,1),SIZE(PEK%XWG,2)))
+ !
+ ZWGI_CLIM_GRAD(:,:) = ZGRADX * EXP( - PK%XDG(:,:) / ZH0 )
+ !-------------------------------------------------------------------------------------
+ !
+ !* 1.1 Temperature profile
+ !
+ ALLOCATE(ZTG_LS(SIZE(PEK%XTG,1),SIZE(PEK%XTG,2)))
+ ZTG_LS(:,:) = PEK%XTG(:,:)
+ !
+ DO JL=1,SIZE(PEK%XTG,2)
+ WHERE(PEK%XTG(:,JL)/=XUNDEF) &
+ PEK%XTG(:,JL) = PEK%XTG(:,JL) + XT_CLIM_GRAD * (ZZS - ZZS_LS)
+ END DO
+ !
+ !-------------------------------------------------------------------------------------
+ !
+ !* 1.2 Water and ice in the soil
+ !
+ ALLOCATE(ZZSFREEZE (SIZE(PEK%XWG,1)))
+ ALLOCATE(ZWGTOT (SIZE(PEK%XWG,1)))
+ ALLOCATE(ZDW (SIZE(PEK%XWG,1)))
+ !
+ !* general case
!
DO JL=1,IWORK
!
ZDW(:) = 0.
! altitude where deep soil freezes (diurnal surface response is not treated)
- ZZSFREEZE(:) = I%XZS + (XTT - I%XTG(:,JL,JP)) / XT_CLIM_GRAD
+ ZZSFREEZE(:) = ZZS + (XTT - PEK%XTG(:,JL)) / XT_CLIM_GRAD
!
- WHERE(I%XTG(:,JL,JP)/=XUNDEF)
+ WHERE(PEK%XTG(:,JL)/=XUNDEF)
!
- WHERE (ZTG_LS(:,JL,JP) < XTT)
+ WHERE (ZTG_LS(:,JL) < XTT)
!
- WHERE (I%XZS <= XZS_LS)
+ WHERE (ZZS <= ZZS_LS)
!
- WHERE (I%XZS > ZZSFREEZE)
- ZDW(:) = ZWGI_CLIM_GRAD(:,JL,JP) * (I%XZS - XZS_LS)
+ WHERE (ZZS > ZZSFREEZE)
+ ZDW(:) = ZWGI_CLIM_GRAD(:,JL) * (ZZS - ZZS_LS)
ELSEWHERE
- ZDW(:) = ZWGI_CLIM_GRAD(:,JL,JP) * (ZZSFREEZE - XZS_LS) + ZGRADX * (I%XZS - ZZSFREEZE)
+ ZDW(:) = ZWGI_CLIM_GRAD(:,JL) * (ZZSFREEZE - ZZS_LS) + ZGRADX * (ZZS - ZZSFREEZE)
ENDWHERE
!
ELSEWHERE
!
- ZDW(:) = ZWGI_CLIM_GRAD(:,JL,JP) * (I%XZS - XZS_LS)
+ ZDW(:) = ZWGI_CLIM_GRAD(:,JL) * (ZZS - ZZS_LS)
!
ENDWHERE
!
ELSEWHERE
!
- WHERE (I%XZS <= XZS_LS)
+ WHERE (ZZS <= ZZS_LS)
!
- ZDW(:) = ZGRADX * (I%XZS - XZS_LS)
+ ZDW(:) = ZGRADX * (ZZS - ZZS_LS)
!
ELSEWHERE
!
- ZDW(:) = ZWGI_CLIM_GRAD(:,JL,JP) * (I%XZS - ZZSFREEZE)
+ ZDW(:) = ZWGI_CLIM_GRAD(:,JL) * (ZZS - ZZSFREEZE)
!
END WHERE
!
@@ -154,91 +173,83 @@ DO JP=1,SIZE(I%XWG,3)
!
ZWGTOT(:) = XUNDEF
!
- WHERE(I%XWG(:,JL,JP)/=XUNDEF)
- ZWGTOT(:) = I%XWG(:,JL,JP) + I%XWGI(:,JL,JP)
+ WHERE(PEK%XWG(:,JL)/=XUNDEF)
+ ZWGTOT(:) = PEK%XWG(:,JL) + PEK%XWGI(:,JL)
ENDWHERE
!
- WHERE(I%XWG(:,JL,JP)/=XUNDEF)
- I%XWGI(:,JL,JP) = I%XWGI(:,JL,JP) + ZDW(:)
- I%XWG (:,JL,JP) = I%XWG (:,JL,JP) - ZDW(:)
+ WHERE(PEK%XWG(:,JL)/=XUNDEF)
+ PEK%XWGI(:,JL) = PEK%XWGI(:,JL) + ZDW(:)
+ PEK%XWG (:,JL) = PEK%XWG (:,JL) - ZDW(:)
ENDWHERE
!
- WHERE (I%XWGI(:,JL,JP)<0.0.AND.I%XWGI(:,JL,JP)/=XUNDEF)
- I%XWGI(:,JL,JP) = 0.
- I%XWG (:,JL,JP) = ZWGTOT(:)
+ WHERE (PEK%XWGI(:,JL)<0.0.AND.PEK%XWGI(:,JL)/=XUNDEF)
+ PEK%XWGI(:,JL) = 0.
+ PEK%XWG (:,JL) = ZWGTOT(:)
END WHERE
!
- WHERE (I%XWG(:,JL,JP)<XWGMIN.AND.I%XWG(:,JL,JP)/=XUNDEF)
- I%XWG (:,JL,JP) = XWGMIN
- I%XWGI(:,JL,JP) = ZWGTOT(:) - XWGMIN
+ WHERE (PEK%XWG(:,JL)<XWGMIN.AND.PEK%XWG(:,JL)/=XUNDEF)
+ PEK%XWG (:,JL) = XWGMIN
+ PEK%XWGI(:,JL) = ZWGTOT(:) - XWGMIN
END WHERE
!
- WHERE(I%XWGI(:,JL,JP)>0.0.AND.I%XWGI(:,JL,JP)/=XUNDEF)
- I%XTG(:,JL,JP) = MIN(XTT,I%XTG(:,JL,JP))
+ WHERE(PEK%XWGI(:,JL)>0.0.AND.PEK%XWGI(:,JL)/=XUNDEF)
+ PEK%XTG(:,JL) = MIN(XTT,PEK%XTG(:,JL))
ELSEWHERE
- I%XTG(:,JL,JP) = MAX(XTT,I%XTG(:,JL,JP))
+ PEK%XTG(:,JL) = MAX(XTT,PEK%XTG(:,JL))
ENDWHERE
!
END WHERE
!
END DO
!
-END DO
+ !
+ !* limits in force-restore case
+ !
+ IF (IO%CISBA=='2-L'.OR.IO%CISBA=='3-L') THEN
+ PEK%XWG (:,2) = MAX(PEK%XWG (:,1)*PK%XDG(:,1),PEK%XWG (:,2)*PK%XDG(:,2))/PK%XDG(:,2)
+ PEK%XWGI(:,2) = MAX(PEK%XWGI(:,1)*PK%XDG(:,1),PEK%XWGI(:,2)*PK%XDG(:,2))/PK%XDG(:,2)
+ ENDIF
+ !
+ IF (IO%CISBA=='3-L') THEN
+ !
+ WHERE (PEK%XWGI(:,3) /= XUNDEF)
+ PEK%XWG (:,3) = PEK%XWG(:,3)+PEK%XWGI(:,3)
+ PEK%XWGI(:,3) = 0.
+ PEK%XTG (:,3) = ZTG_LS(:,3) + XT_CLIM_GRAD * (ZZS - ZZS_LS)
+ END WHERE
+ IF(IO%LTEMP_ARP)THEN
+ PEK%XTG (:,4:SIZE(PEK%XTG,2)) = ZTG_LS(:,4:SIZE(PEK%XTG,2))
+ ENDIF
+ !
+ ELSEIF(IO%CISBA=='2-L'.AND.IO%LTEMP_ARP) THEN
+ !
+ PEK%XTG (:,3:SIZE(PEK%XTG,2)) = ZTG_LS(:,3:SIZE(PEK%XTG,2))
+ !
+ ENDIF
+ !
+ !* masks where fields are not defined
+ WHERE (PEK%XTG(:,1:SIZE(PEK%XWG,2)) == XUNDEF)
+ PEK%XWG (:,:) = XUNDEF
+ PEK%XWGI(:,:) = XUNDEF
+ END WHERE
+ !
+ IF (.NOT.LSNOW_IDEAL) THEN
+ CALL PREP_VER_SNOW(PEK%TSNOW,ZZS_LS,ZZS,ZTG_LS,PEK%XTG,IDEEP_SOIL)
+ ENDIF
+ DEALLOCATE(ZZSFREEZE)
+ DEALLOCATE(ZWGI_CLIM_GRAD)
+ DEALLOCATE(ZWGTOT )
+ DEALLOCATE(ZDW )
+ DEALLOCATE(ZTG_LS, ZZS, ZZS_LS)
+ !
+END DO
!
-!* limits in force-restore case
-!
-IF (I%CISBA=='2-L'.OR.I%CISBA=='3-L') THEN
-I%XWG(:,2,:)=MAX(I%XWG(:,1,:)*I%XDG(:,1,:),I%XWG(:,2,:)*I%XDG(:,2,:))/I%XDG(:,2,:)
-I%XWGI(:,2,:)=MAX(I%XWGI(:,1,:)*I%XDG(:,1,:),I%XWGI(:,2,:)*I%XDG(:,2,:))/I%XDG(:,2,:)
-ENDIF
-IF (I%CISBA=='3-L') THEN
- DO JP=1,SIZE(I%XWG,3)
- WHERE (I%XWGI(:,3,JP) /= XUNDEF)
- I%XWG (:,3,JP) = I%XWG(:,3,JP)+I%XWGI(:,3,JP)
- I%XWGI(:,3,JP) = 0.
- I%XTG (:,3,JP) = ZTG_LS(:,3,JP) + XT_CLIM_GRAD * (I%XZS - XZS_LS)
- END WHERE
- IF(I%LTEMP_ARP)THEN
- I%XTG (:,4:SIZE(I%XTG,2),JP) = ZTG_LS(:,4:SIZE(I%XTG,2),JP)
- ENDIF
- END DO
-ELSEIF(I%CISBA=='2-L'.AND.I%LTEMP_ARP) THEN
- DO JP=1,SIZE(I%XWG,3)
- I%XTG (:,3:SIZE(I%XTG,2),JP) = ZTG_LS(:,3:SIZE(I%XTG,2),JP)
- END DO
-END IF
-!
-DEALLOCATE(ZZSFREEZE)
-DEALLOCATE(ZWGI_CLIM_GRAD)
-DEALLOCATE(ZWGTOT )
-DEALLOCATE(ZDW )
-!
-!* masks where fields are not defined
-WHERE (I%XTG(:,1:SIZE(I%XWG,2),:) == XUNDEF)
- I%XWG (:,:,:) = XUNDEF
- I%XWGI(:,:,:) = XUNDEF
-END WHERE
-!
-!-------------------------------------------------------------------------------------
-!
-!* 1.4 Snow variables
-!
-!* vertical shift
-IF (.NOT.LSNOW_IDEAL) THEN
- IF (I%CISBA=='DIF') THEN
- IDEEP_SOIL = I%NGROUND_LAYER
- ELSE
- IDEEP_SOIL = 2
- END IF
- CALL PREP_VER_SNOW(I%TSNOW,XZS_LS,I%XZS,ZTG_LS,I%XTG,IDEEP_SOIL)
-ENDIF
!
!-------------------------------------------------------------------------------------
!
!* 2. Deallocation of large-scale orography
!
-DEALLOCATE(ZTG_LS)
IF (LHOOK) CALL DR_HOOK('PREP_VER_ISBA',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/prep_ver_snow.F90 b/src/SURFEX/prep_ver_snow.F90
index 299ae10eb957070a88ad5d640f2c9df7c259691f..fd121fc90eabdcb84707173d217a44aa39cbc582 100644
--- a/src/SURFEX/prep_ver_snow.F90
+++ b/src/SURFEX/prep_ver_snow.F90
@@ -53,59 +53,54 @@ IMPLICIT NONE
TYPE(SURF_SNOW), INTENT(INOUT) :: TPSNOW ! snow mantel characteristics
REAL, DIMENSION(:), INTENT(IN) :: PZS_LS ! initial orography
REAL, DIMENSION(:), INTENT(IN) :: PZS ! final orography
-REAL, DIMENSION(:,:,:),INTENT(IN),OPTIONAL:: PTG_LS ! soil temperature on initial orography
-REAL, DIMENSION(:,:,:),INTENT(IN),OPTIONAL:: PTG ! soil temperature on final orography
+REAL, DIMENSION(:,:),INTENT(IN),OPTIONAL:: PTG_LS ! soil temperature on initial orography
+REAL, DIMENSION(:,:),INTENT(IN),OPTIONAL:: PTG ! soil temperature on final orography
INTEGER, INTENT(IN),OPTIONAL:: KDEEP_SOIL ! index of deep soil temperature
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWSNOW_LS ! snow reservoir on initial orography
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTSNOW_LS ! snow temperature on initial orography
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWSNOW ! snow content on final orography
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTSNOW ! snow temperature on final orography
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWSNOW2 ! snow content on final orography
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTSNOW2 ! snow temperature on final orography
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWLIQ ! snow liquid water content
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZZSFREEZE ! altitude where deep soil freezes
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTOT ! snow depth
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDZSN ! snow layer thickness
-!
-INTEGER :: IPATCH ! number of patches
-INTEGER :: JPATCH ! loop counter on patches
-INTEGER :: JLAYER ! loop counter on snow layers
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWSNOW_LS ! snow reservoir on initial orography
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTSNOW_LS ! snow temperature on initial orography
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWSNOW ! snow content on final orography
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTSNOW ! snow temperature on final orography
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWSNOW2 ! snow content on final orography
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTSNOW2 ! snow temperature on final orography
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWLIQ ! snow liquid water content
+REAL, DIMENSION(:), ALLOCATABLE :: ZZSFREEZE ! altitude where deep soil freezes
+REAL, DIMENSION(:), ALLOCATABLE :: ZDTOT ! snow depth
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDZSN ! snow layer thickness
+!
+INTEGER :: JL ! loop counter on snow layers
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('PREP_VER_SNOW',0,ZHOOK_HANDLE)
-IPATCH = SIZE(TPSNOW%WSNOW,3)
!
!* 1. Snow reservoir on initial orography
! -----------------------------------
!
-ALLOCATE(ZWSNOW_LS(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,2),IPATCH))
-ZWSNOW_LS(:,:,:) = TPSNOW%WSNOW(:,:,:)
+ALLOCATE(ZWSNOW_LS(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,2)))
+ZWSNOW_LS(:,:) = TPSNOW%WSNOW(:,:)
!
!-------------------------------------------------------------------------------------
!
!* 2. temperature of snow on initial orography
! ----------------------------------------
!
-ALLOCATE(ZTSNOW_LS(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,2),IPATCH))
+ALLOCATE(ZTSNOW_LS(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,2)))
SELECT CASE(TPSNOW%SCHEME)
CASE ('D95','EBA')
IF (PRESENT(PTG_LS)) THEN
- DO JPATCH=1,IPATCH
- ZTSNOW_LS(:,1,JPATCH) = MIN(PTG_LS(:,1,JPATCH),XTT)
- END DO
+ ZTSNOW_LS(:,1) = MIN(PTG_LS(:,1),XTT)
ELSE
ZTSNOW_LS = XUNDEF
END IF
CASE ('1-L')
- ZTSNOW_LS(:,:,:) = TPSNOW%T(:,:,:)
+ ZTSNOW_LS(:,:) = TPSNOW%T(:,:)
CASE ('3-L','CRO')
- CALL SNOW_HEAT_TO_T_WLIQ(TPSNOW%HEAT(:,:,:),TPSNOW%RHO(:,:,:),ZTSNOW_LS(:,:,:))
+ CALL SNOW_HEAT_TO_T_WLIQ(TPSNOW%HEAT(:,:),TPSNOW%RHO(:,:),ZTSNOW_LS(:,:))
END SELECT
!
!-------------------------------------------------------------------------------------
@@ -113,11 +108,9 @@ END SELECT
!* 3. vertical shift of temperature
! -----------------------------
!
-ALLOCATE(ZTSNOW(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,2),IPATCH))
-DO JPATCH=1,IPATCH
- DO JLAYER=1,TPSNOW%NLAYER
- ZTSNOW(:,JLAYER,JPATCH) = ZTSNOW_LS(:,JLAYER,JPATCH) + XT_CLIM_GRAD * (PZS(:) - PZS_LS(:))
- END DO
+ALLOCATE(ZTSNOW(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,2)))
+DO JL=1,TPSNOW%NLAYER
+ ZTSNOW(:,JL) = ZTSNOW_LS(:,JL) + XT_CLIM_GRAD * (PZS(:) - PZS_LS(:))
END DO
!
!-------------------------------------------------------------------------------------
@@ -127,33 +120,27 @@ END DO
!
!* use of climatological snow content gradient
!
-ALLOCATE(ZWSNOW(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,2),IPATCH))
+ALLOCATE(ZWSNOW(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,2)))
!
-ZWSNOW(:,:,:) = ZWSNOW_LS(:,:,:)
+ZWSNOW(:,:) = ZWSNOW_LS(:,:)
!
IF (PRESENT(PTG)) THEN
- DO JPATCH=1,IPATCH
- DO JLAYER=1,TPSNOW%NLAYER
- WHERE(ZWSNOW_LS(:,JLAYER,JPATCH)>0..AND.((PTG(:,KDEEP_SOIL,JPATCH)-XTT >= 2.).OR.(PZS(:) > PZS_LS(:))))
- ZWSNOW(:,JLAYER,JPATCH) = ZWSNOW_LS(:,JLAYER,JPATCH) + &
- &( XWSNOW_CLIM_GRAD * (PZS(:) - PZS_LS(:))/TPSNOW%NLAYER)
- ZWSNOW(:,JLAYER,JPATCH) = MAX(ZWSNOW(:,JLAYER,JPATCH),0.)
- END WHERE
- END DO
+ DO JL=1,TPSNOW%NLAYER
+ WHERE(ZWSNOW_LS(:,JL)>0..AND.((PTG(:,KDEEP_SOIL)-XTT >= 2.).OR.(PZS(:) > PZS_LS(:))))
+ ZWSNOW(:,JL) = ZWSNOW_LS(:,JL) + ( XWSNOW_CLIM_GRAD * (PZS(:) - PZS_LS(:))/TPSNOW%NLAYER)
+ ZWSNOW(:,JL) = MAX(ZWSNOW(:,JL),0.)
+ END WHERE
END DO
ELSE
- DO JPATCH=1,IPATCH
- DO JLAYER=1,TPSNOW%NLAYER
- WHERE(ZWSNOW_LS(:,JLAYER,JPATCH)>0.)
- ZWSNOW(:,JLAYER,JPATCH) = ZWSNOW_LS(:,JLAYER,JPATCH) + &
- &( XWSNOW_CLIM_GRAD * (PZS(:) - PZS_LS(:))/TPSNOW%NLAYER)
- ZWSNOW(:,JLAYER,JPATCH) = MAX(ZWSNOW(:,JLAYER,JPATCH),0.)
- END WHERE
- END DO
+ DO JL=1,TPSNOW%NLAYER
+ WHERE(ZWSNOW_LS(:,JL)>0.)
+ ZWSNOW(:,JL) = ZWSNOW_LS(:,JL) + ( XWSNOW_CLIM_GRAD * (PZS(:) - PZS_LS(:))/TPSNOW%NLAYER)
+ ZWSNOW(:,JL) = MAX(ZWSNOW(:,JL),0.)
+ END WHERE
END DO
ENDIF
!
-WHERE(TPSNOW%WSNOW(:,:,:)/=XUNDEF) TPSNOW%WSNOW = ZWSNOW
+WHERE(TPSNOW%WSNOW(:,:)/=XUNDEF) TPSNOW%WSNOW = ZWSNOW
!
!-------------------------------------------------------------------------------------
!
@@ -170,11 +157,9 @@ WHERE(TPSNOW%WSNOW(:,:,:)/=XUNDEF) TPSNOW%WSNOW = ZWSNOW
! --------------------------------
!
IF (PRESENT(PTG)) THEN
- ALLOCATE(ZZSFREEZE(SIZE(TPSNOW%WSNOW,1),IPATCH))
- DO JPATCH=1,IPATCH
- ZZSFREEZE(:,JPATCH) = PZS &
- + (XTT - PTG(:,KDEEP_SOIL,JPATCH)) / XT_CLIM_GRAD
- END DO
+
+ ALLOCATE(ZZSFREEZE(SIZE(TPSNOW%WSNOW,1)))
+ ZZSFREEZE(:) = PZS + (XTT - PTG(:,KDEEP_SOIL)) / XT_CLIM_GRAD
!
!* 5.2 Amount and Temperature of new snow (only if soil temperatures are provided)
! ----------------------------------
@@ -182,28 +167,22 @@ IF (PRESENT(PTG)) THEN
!* Snow temperature is then defined as the deep soil temperature at the final
! altitude.
!
- ALLOCATE(ZWSNOW2(SIZE(TPSNOW%WSNOW,1),TPSNOW%NLAYER,IPATCH))
- ALLOCATE(ZTSNOW2(SIZE(TPSNOW%WSNOW,1),TPSNOW%NLAYER,IPATCH))
- DO JPATCH=1,IPATCH
- DO JLAYER=1,TPSNOW%NLAYER
- ZWSNOW2(:,JLAYER,JPATCH) = XWSNOW_CLIM_GRAD *&
- & (PZS(:) - ZZSFREEZE(:,JPATCH))/TPSNOW%NLAYER
- ZWSNOW2(:,JLAYER,JPATCH) = MAX(ZWSNOW2(:,JLAYER,JPATCH),0.)
- ZTSNOW2 (:,JLAYER,JPATCH) = PTG(:,KDEEP_SOIL,JPATCH)
- END DO
+ ALLOCATE(ZWSNOW2(SIZE(TPSNOW%WSNOW,1),TPSNOW%NLAYER))
+ ALLOCATE(ZTSNOW2(SIZE(TPSNOW%WSNOW,1),TPSNOW%NLAYER))
+ DO JL=1,TPSNOW%NLAYER
+ ZWSNOW2(:,JL) = XWSNOW_CLIM_GRAD * (PZS(:) - ZZSFREEZE(:))/TPSNOW%NLAYER
+ ZWSNOW2(:,JL) = MAX(ZWSNOW2(:,JL),0.)
+ ZTSNOW2(:,JL) = PTG(:,KDEEP_SOIL)
END DO
!
!* 5.3 Apply maximum between this value and the shifted one
! ----------------------------------------------------
!
- DO JPATCH=1,IPATCH
- DO JLAYER=1,TPSNOW%NLAYER
- WHERE(TPSNOW%WSNOW(:,JLAYER,JPATCH)/=XUNDEF .AND. ZWSNOW_LS(:,JLAYER,JPATCH)==0. &
- .AND. (PZS(:)-PZS_LS(:))>1000. )
- TPSNOW%WSNOW(:,JLAYER,JPATCH) = ZWSNOW2(:,JLAYER,JPATCH)
- ZTSNOW (:,JLAYER,JPATCH) = ZTSNOW2(:,JLAYER,JPATCH)
- END WHERE
- END DO
+ DO JL=1,TPSNOW%NLAYER
+ WHERE(TPSNOW%WSNOW(:,JL)/=XUNDEF .AND. ZWSNOW_LS(:,JL)==0. .AND. (PZS(:)-PZS_LS(:))>1000. )
+ TPSNOW%WSNOW(:,JL) = ZWSNOW2(:,JL)
+ ZTSNOW (:,JL) = ZTSNOW2(:,JL)
+ END WHERE
END DO
DEALLOCATE(ZZSFREEZE)
@@ -219,9 +198,9 @@ END IF
SELECT CASE(TPSNOW%SCHEME)
CASE('1-L')
!* snow temperature cannot be larger than 0 C
- TPSNOW%T (:,:,:) = MIN ( ZTSNOW(:,:,:), XTT )
+ TPSNOW%T (:,:) = MIN ( ZTSNOW(:,:), XTT )
CASE('3-L','CRO')
- ALLOCATE(ZWLIQ(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,2),IPATCH))
+ ALLOCATE(ZWLIQ(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,2)))
CALL SNOW_T_WLIQ_TO_HEAT(TPSNOW%HEAT,TPSNOW%RHO,ZTSNOW)
CALL SNOW_HEAT_TO_T_WLIQ(TPSNOW%HEAT,TPSNOW%RHO,ZTSNOW,ZWLIQ)
CALL SNOW_T_WLIQ_TO_HEAT(TPSNOW%HEAT,TPSNOW%RHO,ZTSNOW,ZWLIQ)
@@ -233,25 +212,23 @@ END SELECT
!
SELECT CASE(TPSNOW%SCHEME)
CASE('3-L','CRO')
- ALLOCATE(ZDTOT(SIZE(TPSNOW%WSNOW,1),IPATCH))
- ALLOCATE(ZDZSN(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,2),IPATCH))
- ZDTOT(:,:)=0.0
- DO JLAYER=1,TPSNOW%NLAYER
- WHERE(TPSNOW%WSNOW(:,JLAYER,:)/=XUNDEF.AND.TPSNOW%RHO(:,JLAYER,:)/=XUNDEF)
- ZDTOT(:,:)=ZDTOT(:,:)+TPSNOW%WSNOW(:,JLAYER,:)/TPSNOW%RHO(:,JLAYER,:)
+ ALLOCATE(ZDTOT(SIZE(TPSNOW%WSNOW,1)))
+ ALLOCATE(ZDZSN(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,2)))
+ ZDTOT(:)=0.0
+ DO JL=1,TPSNOW%NLAYER
+ WHERE(TPSNOW%WSNOW(:,JL)/=XUNDEF.AND.TPSNOW%RHO(:,JL)/=XUNDEF)
+ ZDTOT(:)=ZDTOT(:)+TPSNOW%WSNOW(:,JL)/TPSNOW%RHO(:,JL)
ENDWHERE
END DO
- DO JPATCH=1,IPATCH
- CALL SNOW3LGRID(ZDZSN(:,:,JPATCH),ZDTOT(:,JPATCH))
- DO JLAYER=1,TPSNOW%NLAYER
- WHERE(TPSNOW%RHO(:,JLAYER,JPATCH)/=XUNDEF.AND.ZDTOT(:,JPATCH)>0.)
- TPSNOW%WSNOW(:,JLAYER,JPATCH) = TPSNOW%RHO(:,JLAYER,JPATCH) * ZDZSN(:,JLAYER,JPATCH)
- ELSEWHERE(TPSNOW%RHO(:,JLAYER,JPATCH)==XUNDEF.OR.ZDTOT(:,JPATCH)==0.0)
- TPSNOW%WSNOW(:,JLAYER,JPATCH) = 0.0
- ELSEWHERE
- TPSNOW%WSNOW(:,JLAYER,JPATCH) = XUNDEF
- END WHERE
- END DO
+ CALL SNOW3LGRID(ZDZSN(:,:),ZDTOT(:))
+ DO JL=1,TPSNOW%NLAYER
+ WHERE(TPSNOW%RHO(:,JL)/=XUNDEF.AND.ZDTOT(:)>0.)
+ TPSNOW%WSNOW(:,JL) = TPSNOW%RHO(:,JL) * ZDZSN(:,JL)
+ ELSEWHERE(TPSNOW%RHO(:,JL)==XUNDEF.OR.ZDTOT(:)==0.0)
+ TPSNOW%WSNOW(:,JL) = 0.0
+ ELSEWHERE
+ TPSNOW%WSNOW(:,JL) = XUNDEF
+ END WHERE
END DO
DEALLOCATE(ZDTOT)
DEALLOCATE(ZDZSN)
diff --git a/src/SURFEX/prep_ver_teb.F90 b/src/SURFEX/prep_ver_teb.F90
index bf3a9fe2abab990b60a1f23d6eaadae21512ffdc..4e1f3eefbb1320b8ad421a557cc3e3f70bebd63d 100644
--- a/src/SURFEX/prep_ver_teb.F90
+++ b/src/SURFEX/prep_ver_teb.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_VER_TEB (B, T, TOP)
+SUBROUTINE PREP_VER_TEB (B, T, PZS, HBEM)
! #################################################################################
!
!!**** *PREP_VER_TEB* - change in TEB variables due to altitude change
@@ -32,7 +32,6 @@ SUBROUTINE PREP_VER_TEB (B, T, TOP)
!
USE MODD_BEM_n, ONLY : BEM_t
USE MODD_TEB_n, ONLY : TEB_t
-USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
!
USE MODD_PREP, ONLY : XZS_LS, XT_CLIM_GRAD
USE MODD_CSTS, ONLY : XRD, XG, XP00
@@ -54,7 +53,8 @@ IMPLICIT NONE
!
TYPE(BEM_t), INTENT(INOUT) :: B
TYPE(TEB_t), INTENT(INOUT) :: T
-TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+REAL, DIMENSION(:), INTENT(IN) :: PZS
+ CHARACTER(LEN=*), INTENT(IN) :: HBEM
!
INTEGER :: JL ! loop counter
REAL, DIMENSION(:), ALLOCATABLE :: ZT0 ! estimated temperature at sea level
@@ -78,34 +78,34 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* 1.3 Road deep temperature
!
IF (LHOOK) CALL DR_HOOK('PREP_VER_TEB',0,ZHOOK_HANDLE)
-T%CUR%XTI_ROAD = T%CUR%XTI_ROAD + XT_CLIM_GRAD * (TOP%XZS - XZS_LS)
+T%XTI_ROAD = T%XTI_ROAD + XT_CLIM_GRAD * (PZS - XZS_LS)
!
!* 1.4 Road Temperature profile
!
-DO JL=1,SIZE(T%CUR%XT_ROAD,2)
- T%CUR%XT_ROAD(:,JL) = T%CUR%XT_ROAD(:,JL) + XT_CLIM_GRAD * (TOP%XZS - XZS_LS)
+DO JL=1,SIZE(T%XT_ROAD,2)
+ T%XT_ROAD(:,JL) = T%XT_ROAD(:,JL) + XT_CLIM_GRAD * (PZS - XZS_LS)
END DO
!
!* 1.5 Wall Temperature profile
!
!* wall grid
-ALLOCATE(ZD (SIZE(T%CUR%XD_WALL,1)))
-ALLOCATE(ZGRID(SIZE(T%CUR%XD_WALL,1),SIZE(T%CUR%XD_WALL,2)))
+ALLOCATE(ZD (SIZE(T%XD_WALL,1)))
+ALLOCATE(ZGRID(SIZE(T%XD_WALL,1),SIZE(T%XD_WALL,2)))
ZGRID(:,:) = 0.
ZD (:) = 0.
!
-DO JL=1,SIZE(T%CUR%XD_WALL,2)
- ZGRID(:,JL) = ZD(:) + T%CUR%XD_WALL(:,JL)/2.
- ZD (:) = ZD(:) + T%CUR%XD_WALL(:,JL)
+DO JL=1,SIZE(T%XD_WALL,2)
+ ZGRID(:,JL) = ZD(:) + T%XD_WALL(:,JL)/2.
+ ZD (:) = ZD(:) + T%XD_WALL(:,JL)
END DO
!
!* surface temperature shift is given by climatological gradient
!* shift of temperatures within the wall is attenuated
!* shift is zero from internal wall to half of wall
-DO JL=1,SIZE(T%CUR%XT_WALL_A,2)
- T%CUR%XT_WALL_A(:,JL) = T%CUR%XT_WALL_A(:,JL) + XT_CLIM_GRAD * (TOP%XZS - XZS_LS) &
+DO JL=1,SIZE(T%XT_WALL_A,2)
+ T%XT_WALL_A(:,JL) = T%XT_WALL_A(:,JL) + XT_CLIM_GRAD * (PZS - XZS_LS) &
* MAX(1.-2.*ZGRID(:,JL)/ZD(:),0.)
- T%CUR%XT_WALL_B(:,JL) = T%CUR%XT_WALL_B(:,JL) + XT_CLIM_GRAD * (TOP%XZS - XZS_LS) &
+ T%XT_WALL_B(:,JL) = T%XT_WALL_B(:,JL) + XT_CLIM_GRAD * (PZS - XZS_LS) &
* MAX(1.-2.*ZGRID(:,JL)/ZD(:),0.)
END DO
!
@@ -115,21 +115,21 @@ DEALLOCATE(ZGRID)
!* 1.6 Roof Temperature profile
!
!* roof grid
-ALLOCATE(ZD (SIZE(T%CUR%XD_ROOF,1)))
-ALLOCATE(ZGRID(SIZE(T%CUR%XD_ROOF,1),SIZE(T%CUR%XD_ROOF,2)))
+ALLOCATE(ZD (SIZE(T%XD_ROOF,1)))
+ALLOCATE(ZGRID(SIZE(T%XD_ROOF,1),SIZE(T%XD_ROOF,2)))
ZGRID(:,:) = 0.
ZD (:) = 0.
!
-DO JL=1,SIZE(T%CUR%XD_ROOF,2)
- ZGRID(:,JL) = ZD(:) + T%CUR%XD_ROOF(:,JL)/2.
- ZD (:) = ZD(:) + T%CUR%XD_ROOF(:,JL)
+DO JL=1,SIZE(T%XD_ROOF,2)
+ ZGRID(:,JL) = ZD(:) + T%XD_ROOF(:,JL)/2.
+ ZD (:) = ZD(:) + T%XD_ROOF(:,JL)
END DO
!
!* surface temperature shift is given by climatological gradient
!* shift of temperatures within the wall is attenuated
!* shift is zero from internal wall to half of wall
-DO JL=1,SIZE(T%CUR%XT_ROOF,2)
- T%CUR%XT_ROOF(:,JL) = T%CUR%XT_ROOF(:,JL) + XT_CLIM_GRAD * (TOP%XZS - XZS_LS) &
+DO JL=1,SIZE(T%XT_ROOF,2)
+ T%XT_ROOF(:,JL) = T%XT_ROOF(:,JL) + XT_CLIM_GRAD * (PZS - XZS_LS) &
* MAX(1.-2.*ZGRID(:,JL)/ZD(:),0.)
END DO
!
@@ -137,26 +137,26 @@ DEALLOCATE(ZD)
DEALLOCATE(ZGRID)
!
!
-IF (TOP%CBEM=='BEM') THEN
+IF (HBEM=='BEM') THEN
!
!* 1.6bis Floor Temperature profile
!
!* Floor grid
- ALLOCATE(ZD (SIZE(B%CUR%XD_FLOOR,1)))
- ALLOCATE(ZGRID(SIZE(B%CUR%XD_FLOOR,1),SIZE(B%CUR%XD_FLOOR,2)))
+ ALLOCATE(ZD (SIZE(B%XD_FLOOR,1)))
+ ALLOCATE(ZGRID(SIZE(B%XD_FLOOR,1),SIZE(B%XD_FLOOR,2)))
ZGRID(:,:) = 0.
ZD (:) = 0.
!
- DO JL=1,SIZE(B%CUR%XD_FLOOR,2)
- ZGRID(:,JL) = ZD(:) + B%CUR%XD_FLOOR(:,JL)/2.
- ZD (:) = ZD(:) + B%CUR%XD_FLOOR(:,JL)
+ DO JL=1,SIZE(B%XD_FLOOR,2)
+ ZGRID(:,JL) = ZD(:) + B%XD_FLOOR(:,JL)/2.
+ ZD (:) = ZD(:) + B%XD_FLOOR(:,JL)
END DO
!
!* deep ground temperature shift is given by climatological gradient
!* shift of temperatures within the floor is attenuated
!* shift is zero from internal floor layer to half of floor
- DO JL=1,SIZE(B%CUR%XT_FLOOR,2)
- B%CUR%XT_FLOOR(:,JL) = B%CUR%XT_FLOOR(:,JL) + XT_CLIM_GRAD * (TOP%XZS - XZS_LS) &
+ DO JL=1,SIZE(B%XT_FLOOR,2)
+ B%XT_FLOOR(:,JL) = B%XT_FLOOR(:,JL) + XT_CLIM_GRAD * (PZS - XZS_LS) &
* MAX(2.*ZGRID(:,JL)/ZD(:)-1.,0.)
END DO
!
@@ -166,21 +166,21 @@ IF (TOP%CBEM=='BEM') THEN
!* 1.6bis Mass Temperature profile
!
!* mass grid
- ALLOCATE(ZD (SIZE(B%CUR%XD_FLOOR,1)))
- ALLOCATE(ZGRID(SIZE(B%CUR%XD_FLOOR,1),SIZE(B%CUR%XD_FLOOR,2)))
+ ALLOCATE(ZD (SIZE(B%XD_FLOOR,1)))
+ ALLOCATE(ZGRID(SIZE(B%XD_FLOOR,1),SIZE(B%XD_FLOOR,2)))
ZGRID(:,:) = 0.
ZD (:) = 0.
!
- DO JL=1,SIZE(B%CUR%XD_FLOOR,2)
- ZGRID(:,JL) = ZD(:) + B%CUR%XD_FLOOR(:,JL)/2.
- ZD (:) = ZD(:) + B%CUR%XD_FLOOR(:,JL)
+ DO JL=1,SIZE(B%XD_FLOOR,2)
+ ZGRID(:,JL) = ZD(:) + B%XD_FLOOR(:,JL)/2.
+ ZD (:) = ZD(:) + B%XD_FLOOR(:,JL)
END DO
!
!* deep ground temperature shift is given by climatological gradient
!* shift of temperatures within the floor is attenuated
!* shift is zero from internal floor layer to half of floor
- DO JL=1,SIZE(B%CUR%XT_MASS,2)
- B%CUR%XT_MASS(:,JL) = B%CUR%XT_MASS(:,JL) + XT_CLIM_GRAD * (TOP%XZS - XZS_LS) &
+ DO JL=1,SIZE(B%XT_MASS,2)
+ B%XT_MASS(:,JL) = B%XT_MASS(:,JL) + XT_CLIM_GRAD * (PZS - XZS_LS) &
* MAX(2.*ZGRID(:,JL)/ZD(:)-1.,0.)
END DO
!
@@ -191,23 +191,23 @@ ENDIF
!
!* 1.7 Snow variables
!
- CALL PREP_VER_SNOW(T%CUR%TSNOW_ROOF,XZS_LS,TOP%XZS)
- CALL PREP_VER_SNOW(T%CUR%TSNOW_ROAD,XZS_LS,TOP%XZS)
+ CALL PREP_VER_SNOW(T%TSNOW_ROOF,XZS_LS,PZS)
+ CALL PREP_VER_SNOW(T%TSNOW_ROAD,XZS_LS,PZS)
!
!
!* 1.8 Canyon air temperature
!
!* estimation of temperature at sea level
!
-ALLOCATE(ZT0(SIZE(T%CUR%XQ_CANYON)))
-ZT0 = T%CUR%XT_CANYON - XT_CLIM_GRAD * XZS_LS
+ALLOCATE(ZT0(SIZE(T%XQ_CANYON)))
+ZT0 = T%XT_CANYON - XT_CLIM_GRAD * XZS_LS
!
!* shift of canyon air temperature
!
-ALLOCATE(ZT_LS(SIZE(T%CUR%XQ_CANYON)))
-ZT_LS = T%CUR%XT_CANYON
+ALLOCATE(ZT_LS(SIZE(T%XQ_CANYON)))
+ZT_LS = T%XT_CANYON
!
-T%CUR%XT_CANYON = T%CUR%XT_CANYON + XT_CLIM_GRAD * (TOP%XZS - XZS_LS)
+T%XT_CANYON = T%XT_CANYON + XT_CLIM_GRAD * (PZS - XZS_LS)
!
!* 1.9 Canyon air humidity
!
@@ -215,17 +215,17 @@ T%CUR%XT_CANYON = T%CUR%XT_CANYON + XT_CLIM_GRAD * (TOP%XZS - XZS_LS)
!
!* estimation of pressure at large-scale orography
!
-ALLOCATE(ZP_LS(SIZE(T%CUR%XQ_CANYON)))
+ALLOCATE(ZP_LS(SIZE(T%XQ_CANYON)))
ZP_LS = XP00 * EXP(-(XG/XRD/ZT0)*XZS_LS +(XG*XT_CLIM_GRAD/(2.*XRD*ZT0**2))*XZS_LS**2)
!
!* estimation of pressure at output orography
!
-ALLOCATE(ZP(SIZE(T%CUR%XQ_CANYON)))
-ZP = XP00 * EXP(-(XG/XRD/ZT0)*TOP%XZS +(XG*XT_CLIM_GRAD/(2.*XRD*ZT0**2))*TOP%XZS **2)
+ALLOCATE(ZP(SIZE(T%XQ_CANYON)))
+ZP = XP00 * EXP(-(XG/XRD/ZT0)*PZS +(XG*XT_CLIM_GRAD/(2.*XRD*ZT0**2))*PZS **2)
!
!* conservation of estimated relative humidity
!
-T%CUR%XQ_CANYON = T%CUR%XQ_CANYON * QSAT(T%CUR%XT_CANYON,ZP) / QSAT(ZT_LS,ZP_LS)
+T%XQ_CANYON = T%XQ_CANYON * QSAT(T%XT_CANYON,ZP) / QSAT(ZT_LS,ZP_LS)
!
DEALLOCATE(ZP_LS)
DEALLOCATE(ZP )
diff --git a/src/SURFEX/prep_ver_teb_greenroof.F90 b/src/SURFEX/prep_ver_teb_greenroof.F90
deleted file mode 100644
index c2a031e761142b39ced529b996d8288dd464002e..0000000000000000000000000000000000000000
--- a/src/SURFEX/prep_ver_teb_greenroof.F90
+++ /dev/null
@@ -1,207 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE PREP_VER_TEB_GREENROOF (TGR, TGRO, TGRP, TOP)
-! #################################################################################
-!
-!!**** *PREP_VER_TEB_GREENROOF* - change in ISBA fields due to altitude change
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson + A.Lemonsu & C.deMunck
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! Modified by B. Decharme (01/2009), Optional Arpege deep soil temperature initialization
-!!------------------------------------------------------------------
-!
-
-!
-!
-USE MODD_TEB_GREENROOF_n, ONLY : TEB_GREENROOF_t
-USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
-USE MODD_TEB_GREENROOF_PGD_n, ONLY : TEB_GREENROOF_PGD_t
-USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-!
-USE MODD_ISBA_PAR, ONLY : XWGMIN
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_PREP, ONLY : XZS_LS, XT_CLIM_GRAD
-USE MODD_CSTS, ONLY : XTT, XDAY, XLMTT, XRHOLW
-!
-USE MODE_THERMOS
-USE MODI_PREP_VER_SNOW
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!* 0.2 declarations of local variables
-!
-!
-TYPE(TEB_GREENROOF_t), INTENT(INOUT) :: TGR
-TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: TGRO
-TYPE(TEB_GREENROOF_PGD_t), INTENT(INOUT) :: TGRP
-TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
-!
-INTEGER :: JL ! loop counter on layers
-INTEGER :: IWORK ! Work integer
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZWGTOT ! total water content
-REAL, DIMENSION(:), ALLOCATABLE :: ZDW ! variation of water in soil
-REAL, DIMENSION(:), ALLOCATABLE :: ZZSFREEZE ! altitude where soil temperature equals XTT
-INTEGER :: IDEEP_SOIL! layer corresponding to deep soil temperature
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZWGI_CLIM_GRAD ! ice content vertical gradient
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZTG_LS! temperature on initial orography
-!
-REAL :: ZGRADX = 5.E-4 ! slope of ice content gradient
-REAL :: ZH0 = 5.E-1 ! constant used to define ice content gradient
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------------
-!
-!* 1.0 Ice content climatologic gradient
-!
-IF (LHOOK) CALL DR_HOOK('PREP_VER_TEB_GREENROOF',0,ZHOOK_HANDLE)
-ALLOCATE(ZWGI_CLIM_GRAD (SIZE(TGR%CUR%XWG,1),SIZE(TGR%CUR%XWG,2)))
-!
-ZWGI_CLIM_GRAD(:,:) = ZGRADX * EXP( - TGRP%XDG(:,:) / ZH0 )
-!-------------------------------------------------------------------------------------
-!
-!* 1.1 Temperature profile
-!
-ALLOCATE(ZTG_LS(SIZE(TGR%CUR%XTG,1),SIZE(TGR%CUR%XTG,2)))
-ZTG_LS(:,:) = TGR%CUR%XTG(:,:)
-!
- DO JL=1,SIZE(TGR%CUR%XTG,2)
- WHERE(TGR%CUR%XTG(:,JL)/=XUNDEF) &
- TGR%CUR%XTG(:,JL) = TGR%CUR%XTG(:,JL) + XT_CLIM_GRAD * (TOP%XZS - XZS_LS)
- END DO
-!
-!-------------------------------------------------------------------------------------
-!
-!* 1.2 Water and ice in the soil
-!
-ALLOCATE(ZZSFREEZE (SIZE(TGR%CUR%XWG,1)))
-ALLOCATE(ZWGTOT (SIZE(TGR%CUR%XWG,1)))
-ALLOCATE(ZDW (SIZE(TGR%CUR%XWG,1)))
-!
-!* general case
-!
-IWORK=SIZE(TGR%CUR%XTG,2)
-!
- !
- DO JL=1,IWORK
- !
- ZDW(:) = 0.
- ! altitude where deep soil freezes (diurnal surface response is not treated)
- ZZSFREEZE(:) = TOP%XZS + (XTT - TGR%CUR%XTG(:,JL)) / XT_CLIM_GRAD
- !
- WHERE(TGR%CUR%XTG(:,JL)/=XUNDEF)
- !
- WHERE (ZTG_LS(:,JL) < XTT)
- !
- WHERE (TOP%XZS <= XZS_LS)
- !
- WHERE (TOP%XZS > ZZSFREEZE)
- ZDW(:) = ZWGI_CLIM_GRAD(:,JL) * (TOP%XZS - XZS_LS)
- ELSEWHERE
- ZDW(:) = ZWGI_CLIM_GRAD(:,JL) * (ZZSFREEZE - XZS_LS) + ZGRADX * (TOP%XZS - ZZSFREEZE)
- ENDWHERE
- !
- ELSEWHERE
- !
- ZDW(:) = ZWGI_CLIM_GRAD(:,JL) * (TOP%XZS - XZS_LS)
- !
- ENDWHERE
- !
- ELSEWHERE
- !
- WHERE (TOP%XZS <= XZS_LS)
- !
- ZDW(:) = ZGRADX * (TOP%XZS - XZS_LS)
- !
- ELSEWHERE
- !
- ZDW(:) = ZWGI_CLIM_GRAD(:,JL) * (TOP%XZS - ZZSFREEZE)
- !
- END WHERE
- !
- END WHERE
- !
- ZWGTOT(:) = XUNDEF
- !
- WHERE(TGR%CUR%XWG(:,JL)/=XUNDEF)
- ZWGTOT(:) = TGR%CUR%XWG(:,JL) + TGR%CUR%XWGI(:,JL)
- ENDWHERE
- !
- WHERE(TGR%CUR%XWG(:,JL)/=XUNDEF)
- TGR%CUR%XWGI(:,JL) = TGR%CUR%XWGI(:,JL) + ZDW(:)
- TGR%CUR%XWG (:,JL) = TGR%CUR%XWG (:,JL) - ZDW(:)
- ENDWHERE
- !
- WHERE (TGR%CUR%XWGI(:,JL) < 0..AND.TGR%CUR%XWGI(:,JL)/=XUNDEF)
- TGR%CUR%XWGI(:,JL) = 0.
- TGR%CUR%XWG (:,JL) = ZWGTOT(:)
- END WHERE
- !
- WHERE (TGR%CUR%XWG(:,JL) < XWGMIN.AND.TGR%CUR%XWG(:,JL)/=XUNDEF)
- TGR%CUR%XWG (:,JL) = XWGMIN
- TGR%CUR%XWGI(:,JL) = ZWGTOT(:) - XWGMIN
- END WHERE
- !
- WHERE(TGR%CUR%XWGI(:,JL) > 0..AND.TGR%CUR%XWGI(:,JL)/=XUNDEF)
- TGR%CUR%XTG(:,JL) = MIN(XTT,TGR%CUR%XTG(:,JL))
- ELSEWHERE
- TGR%CUR%XTG(:,JL) = MAX(XTT,TGR%CUR%XTG(:,JL))
- ENDWHERE
- !
- ENDWHERE
- !
- END DO
- !
-!
-!
-DEALLOCATE(ZZSFREEZE )
-DEALLOCATE(ZWGI_CLIM_GRAD)
-DEALLOCATE(ZWGTOT )
-DEALLOCATE(ZDW )
-!
-!* masks where fields are not defined
-WHERE (TGR%CUR%XTG(:,1:SIZE(TGR%CUR%XWG,2)) == XUNDEF)
- TGR%CUR%XWG (:,:) = XUNDEF
- TGR%CUR%XWGI(:,:) = XUNDEF
-END WHERE
-!
-!-------------------------------------------------------------------------------------
-!
-IDEEP_SOIL = TGRO%NLAYER_GR
- CALL PREP_VER_SNOW(TGR%CUR%TSNOW,XZS_LS,TOP%XZS,SPREAD(ZTG_LS,3,1),SPREAD(TGR%CUR%XTG,3,1),IDEEP_SOIL)
-!
-!-------------------------------------------------------------------------------------
-!
-!* 2. Deallocation of large-scale orography
-!
-DEALLOCATE(ZTG_LS)
-IF (LHOOK) CALL DR_HOOK('PREP_VER_TEB_GREENROOF',1,ZHOOK_HANDLE)
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE PREP_VER_TEB_GREENROOF
diff --git a/src/SURFEX/prep_ver_teb_garden.F90 b/src/SURFEX/prep_ver_teb_veg.F90
similarity index 56%
rename from src/SURFEX/prep_ver_teb_garden.F90
rename to src/SURFEX/prep_ver_teb_veg.F90
index afc91a3645164cf0a60ac64654000fd58306f595..c1d9449d63f785e31d5c93f0ab6120631a2788a3 100644
--- a/src/SURFEX/prep_ver_teb_garden.F90
+++ b/src/SURFEX/prep_ver_teb_veg.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_VER_TEB_GARDEN (TGD, TGDO, TGDP, TOP, TVG)
+SUBROUTINE PREP_VER_TEB_VEG (P, PEK, IO, PZS)
! #################################################################################
!
!!**** *PREP_VER_TEB_GARDEN* - change in ISBA fields due to altitude change
@@ -28,14 +28,8 @@ SUBROUTINE PREP_VER_TEB_GARDEN (TGD, TGDO, TGDP, TOP, TVG)
!! Modified by B. Decharme (01/2009), Optional Arpege deep soil temperature initialization
!!------------------------------------------------------------------
!
-
-!
-!
-USE MODD_TEB_GARDEN_n, ONLY : TEB_GARDEN_t
-USE MODD_TEB_GARDEN_OPTION_n, ONLY : TEB_GARDEN_OPTIONS_t
-USE MODD_TEB_GARDEN_PGD_n, ONLY : TEB_GARDEN_PGD_t
-USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_PE_t, ISBA_P_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
USE MODD_ISBA_PAR, ONLY : XWGMIN
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -57,11 +51,10 @@ IMPLICIT NONE
!* 0.2 declarations of local variables
!
!
-TYPE(TEB_GARDEN_t), INTENT(INOUT) :: TGD
-TYPE(TEB_GARDEN_OPTIONS_t), INTENT(INOUT) :: TGDO
-TYPE(TEB_GARDEN_PGD_t), INTENT(INOUT) :: TGDP
-TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
+TYPE(ISBA_P_t), INTENT(INOUT) :: P
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+REAL, DIMENSION(:), INTENT(IN) :: PZS
!
INTEGER :: JL ! loop counter on layers
INTEGER :: IWORK ! Work integer
@@ -82,67 +75,67 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 1.0 Ice content climatologic gradient
!
-IF (LHOOK) CALL DR_HOOK('PREP_VER_TEB_GARDEN',0,ZHOOK_HANDLE)
-ALLOCATE(ZWGI_CLIM_GRAD (SIZE(TGD%CUR%XWG,1),SIZE(TGD%CUR%XWG,2)))
+IF (LHOOK) CALL DR_HOOK('PREP_VER_TEB_VEG',0,ZHOOK_HANDLE)
+ALLOCATE(ZWGI_CLIM_GRAD (SIZE(PEK%XWG,1),SIZE(PEK%XWG,2)))
!
-ZWGI_CLIM_GRAD(:,:) = ZGRADX * EXP( - TGDP%XDG(:,:) / ZH0 )
+ZWGI_CLIM_GRAD(:,:) = ZGRADX * EXP( - P%XDG(:,:) / ZH0 )
!-------------------------------------------------------------------------------------
!
!* 1.1 Temperature profile
!
-ALLOCATE(ZTG_LS(SIZE(TGD%CUR%XTG,1),SIZE(TGD%CUR%XTG,2)))
-ZTG_LS(:,:) = TGD%CUR%XTG(:,:)
+ALLOCATE(ZTG_LS(SIZE(PEK%XTG,1),SIZE(PEK%XTG,2)))
+ZTG_LS(:,:) = PEK%XTG(:,:)
!
-DO JL=1,SIZE(TGD%CUR%XTG,2)
- WHERE(TGD%CUR%XTG(:,JL)/=XUNDEF) &
- TGD%CUR%XTG(:,JL) = TGD%CUR%XTG(:,JL) + XT_CLIM_GRAD * (TOP%XZS - XZS_LS)
+DO JL=1,SIZE(PEK%XTG,2)
+ WHERE(PEK%XTG(:,JL)/=XUNDEF) &
+ PEK%XTG(:,JL) = PEK%XTG(:,JL) + XT_CLIM_GRAD * (PZS - XZS_LS)
END DO
!
!-------------------------------------------------------------------------------------
!
!* 1.2 Water and ice in the soil
!
-ALLOCATE(ZZSFREEZE (SIZE(TGD%CUR%XWG,1)))
-ALLOCATE(ZWGTOT (SIZE(TGD%CUR%XWG,1)))
-ALLOCATE(ZDW (SIZE(TGD%CUR%XWG,1)))
+ALLOCATE(ZZSFREEZE (SIZE(PEK%XWG,1)))
+ALLOCATE(ZWGTOT (SIZE(PEK%XWG,1)))
+ALLOCATE(ZDW (SIZE(PEK%XWG,1)))
!
!* general case
!
-IWORK=SIZE(TGD%CUR%XTG,2)
+IWORK=SIZE(PEK%XTG,2)
!
DO JL=1,IWORK
!
ZDW(:) = 0.
! altitude where deep soil freezes (diurnal surface response is not treated)
- ZZSFREEZE(:) = TOP%XZS + (XTT - TGD%CUR%XTG(:,JL)) / XT_CLIM_GRAD
+ ZZSFREEZE(:) = PZS + (XTT - PEK%XTG(:,JL)) / XT_CLIM_GRAD
!
- WHERE(TGD%CUR%XTG(:,JL)/=XUNDEF)
+ WHERE(PEK%XTG(:,JL)/=XUNDEF)
!
WHERE (ZTG_LS(:,JL) < XTT)
!
- WHERE (TOP%XZS <= XZS_LS)
+ WHERE (PZS <= XZS_LS)
!
- WHERE (TOP%XZS > ZZSFREEZE)
- ZDW(:) = ZWGI_CLIM_GRAD(:,JL) * (TOP%XZS - XZS_LS)
+ WHERE (PZS > ZZSFREEZE)
+ ZDW(:) = ZWGI_CLIM_GRAD(:,JL) * (PZS - XZS_LS)
ELSEWHERE
- ZDW(:) = ZWGI_CLIM_GRAD(:,JL) * (ZZSFREEZE - XZS_LS) + ZGRADX * (TOP%XZS - ZZSFREEZE)
+ ZDW(:) = ZWGI_CLIM_GRAD(:,JL) * (ZZSFREEZE - XZS_LS) + ZGRADX * (PZS - ZZSFREEZE)
ENDWHERE
!
ELSEWHERE
!
- ZDW(:) = ZWGI_CLIM_GRAD(:,JL) * (TOP%XZS - XZS_LS)
+ ZDW(:) = ZWGI_CLIM_GRAD(:,JL) * (PZS - XZS_LS)
!
ENDWHERE
!
ELSEWHERE
!
- WHERE (TOP%XZS <= XZS_LS)
+ WHERE (PZS <= XZS_LS)
!
- ZDW(:) = ZGRADX * (TOP%XZS - XZS_LS)
+ ZDW(:) = ZGRADX * (PZS - XZS_LS)
!
ELSEWHERE
!
- ZDW(:) = ZWGI_CLIM_GRAD(:,JL) * (TOP%XZS - ZZSFREEZE)
+ ZDW(:) = ZWGI_CLIM_GRAD(:,JL) * (PZS - ZZSFREEZE)
!
END WHERE
!
@@ -150,29 +143,29 @@ DO JL=1,IWORK
!
ZWGTOT(:) = XUNDEF
!
- WHERE(TGD%CUR%XWG(:,JL)/=XUNDEF)
- ZWGTOT(:) = TGD%CUR%XWG(:,JL) + TGD%CUR%XWGI(:,JL)
+ WHERE(PEK%XWG(:,JL)/=XUNDEF)
+ ZWGTOT(:) = PEK%XWG(:,JL) + PEK%XWGI(:,JL)
ENDWHERE
!
- WHERE(TGD%CUR%XWG(:,JL)/=XUNDEF)
- TGD%CUR%XWGI(:,JL) = TGD%CUR%XWGI(:,JL) + ZDW(:)
- TGD%CUR%XWG (:,JL) = TGD%CUR%XWG (:,JL) - ZDW(:)
+ WHERE(PEK%XWG(:,JL)/=XUNDEF)
+ PEK%XWGI(:,JL) = PEK%XWGI(:,JL) + ZDW(:)
+ PEK%XWG (:,JL) = PEK%XWG (:,JL) - ZDW(:)
ENDWHERE
!
- WHERE (TGD%CUR%XWGI(:,JL) < 0..AND.TGD%CUR%XWGI(:,JL)/=XUNDEF)
- TGD%CUR%XWGI(:,JL) = 0.
- TGD%CUR%XWG (:,JL) = ZWGTOT(:)
+ WHERE (PEK%XWGI(:,JL) < 0..AND.PEK%XWGI(:,JL)/=XUNDEF)
+ PEK%XWGI(:,JL) = 0.
+ PEK%XWG (:,JL) = ZWGTOT(:)
END WHERE
!
- WHERE (TGD%CUR%XWG(:,JL) < XWGMIN.AND.TGD%CUR%XWG(:,JL)/=XUNDEF)
- TGD%CUR%XWG (:,JL) = XWGMIN
- TGD%CUR%XWGI(:,JL) = ZWGTOT(:) - XWGMIN
+ WHERE (PEK%XWG(:,JL) < XWGMIN.AND.PEK%XWG(:,JL)/=XUNDEF)
+ PEK%XWG (:,JL) = XWGMIN
+ PEK%XWGI(:,JL) = ZWGTOT(:) - XWGMIN
END WHERE
!
- WHERE(TGD%CUR%XWGI(:,JL) > 0..AND.TGD%CUR%XWGI(:,JL)/=XUNDEF)
- TGD%CUR%XTG(:,JL) = MIN(XTT,TGD%CUR%XTG(:,JL))
+ WHERE(PEK%XWGI(:,JL) > 0..AND.PEK%XWGI(:,JL)/=XUNDEF)
+ PEK%XTG(:,JL) = MIN(XTT,PEK%XTG(:,JL))
ELSEWHERE
- TGD%CUR%XTG(:,JL) = MAX(XTT,TGD%CUR%XTG(:,JL))
+ PEK%XTG(:,JL) = MAX(XTT,PEK%XTG(:,JL))
ENDWHERE
!
ENDWHERE
@@ -181,11 +174,11 @@ END DO
!
!* limits in force-restore case
!
-IF (TVG%CISBA=='3-L') THEN
- WHERE (TGD%CUR%XWGI(:,3) /= XUNDEF)
- TGD%CUR%XWG (:,3) = TGD%CUR%XWG(:,3)+TGD%CUR%XWGI(:,3)
- TGD%CUR%XWGI(:,3) = 0.
- TGD%CUR%XTG (:,3) = ZTG_LS(:,3)
+IF (IO%CISBA=='3-L') THEN
+ WHERE (PEK%XWGI(:,3) /= XUNDEF)
+ PEK%XWG (:,3) = PEK%XWG(:,3)+PEK%XWGI(:,3)
+ PEK%XWGI(:,3) = 0.
+ PEK%XTG (:,3) = ZTG_LS(:,3)
END WHERE
END IF
!
@@ -195,9 +188,9 @@ DEALLOCATE(ZWGTOT )
DEALLOCATE(ZDW )
!
!* masks where fields are not defined
-WHERE (TGD%CUR%XTG(:,1:SIZE(TGD%CUR%XWG,2)) == XUNDEF)
- TGD%CUR%XWG (:,:) = XUNDEF
- TGD%CUR%XWGI(:,:) = XUNDEF
+WHERE (PEK%XTG(:,1:SIZE(PEK%XWG,2)) == XUNDEF)
+ PEK%XWG (:,:) = XUNDEF
+ PEK%XWGI(:,:) = XUNDEF
END WHERE
!
!-------------------------------------------------------------------------------------
@@ -205,19 +198,19 @@ END WHERE
!* 1.4 Snow variables
!
!* vertical shift
-IF (TVG%CISBA=='DIF') THEN
- IDEEP_SOIL = TGDO%NGROUND_LAYER
+IF (IO%CISBA=='DIF') THEN
+ IDEEP_SOIL = IO%NGROUND_LAYER
ELSE
IDEEP_SOIL = 2
END IF
- CALL PREP_VER_SNOW(TGD%CUR%TSNOW,XZS_LS,TOP%XZS,SPREAD(ZTG_LS,3,1),SPREAD(TGD%CUR%XTG,3,1),IDEEP_SOIL)
+ CALL PREP_VER_SNOW(PEK%TSNOW,XZS_LS,PZS,ZTG_LS,PEK%XTG,IDEEP_SOIL)
!
!-------------------------------------------------------------------------------------
!
!* 2. Deallocation of large-scale orography
!
DEALLOCATE(ZTG_LS)
-IF (LHOOK) CALL DR_HOOK('PREP_VER_TEB_GARDEN',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('PREP_VER_TEB_VEG',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------------
!
-END SUBROUTINE PREP_VER_TEB_GARDEN
+END SUBROUTINE PREP_VER_TEB_VEG
diff --git a/src/SURFEX/prep_watflux.F90 b/src/SURFEX/prep_watflux.F90
index c8b4643343058e18dda1cad3337bebd53236a29e..1246fd4b6a99cdee7df30f49218fa91ae9765041 100644
--- a/src/SURFEX/prep_watflux.F90
+++ b/src/SURFEX/prep_watflux.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_WATFLUX (DTCO, UG, U, WM,GCP, &
- HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+SUBROUTINE PREP_WATFLUX (DTCO, UG, U, GCP, WG, W, SB, &
+ HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
! #################################################################################
!
!!**** *PREP_WATFLUX* - prepares WATFLUX fields
@@ -27,30 +27,31 @@ SUBROUTINE PREP_WATFLUX (DTCO, UG, U, WM,GCP, &
!! -------------
!! Original 01/2004
!! S. Riette 06/2009 PREP_WATFLUX_SBL has no more argument
+!! P. Marguinaud10/2014, Support for a 2-part PREP
!!------------------------------------------------------------------
!
-!
-!
-USE MODD_SURFEX_n, ONLY : WATFLUX_MODEL_t
-!
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_WATFLUX_n, ONLY : WATFLUX_t
+USE MODD_CANOPY_n, ONLY : CANOPY_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
!
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
USE MODI_PREP_HOR_WATFLUX_FIELD
USE MODI_PREP_VER_WATFLUX
USE MODI_PREP_OUTPUT_GRID
USE MODI_GET_LUOUT
-USE MODI_PREP_WATFLUX_SBL
+USE MODI_PREP_SBL
!
USE MODD_READ_NAMELIST, ONLY : LNAM_READ
USE MODN_PREP_WATFLUX
USE MODD_PREP, ONLY : XZS_LS
USE MODD_SURF_ATM, ONLY : LVERTSHIFT
-
+!
+USE MODE_PREP_CTL, ONLY : PREP_CTL
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -67,8 +68,11 @@ TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
!
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(WATFLUX_MODEL_t), INTENT(INOUT) :: WM
-TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+ TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+TYPE(GRID_t), INTENT(INOUT) :: WG
+TYPE(WATFLUX_t), INTENT(INOUT) :: W
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
+TYPE (PREP_CTL), INTENT(INOUT) :: YDCTL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! name of the Atmospheric file
@@ -92,8 +96,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('PREP_WATFLUX',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
- CALL PREP_OUTPUT_GRID(UG, U, &
- ILUOUT,WM%WG%CGRID,WM%WG%XGRID_PAR,WM%WG%XLAT,WM%WG%XLON)
+ CALL PREP_OUTPUT_GRID(UG%G, WG, U%NSIZE_FULL, ILUOUT)
!
!-------------------------------------------------------------------------------------
!
@@ -102,59 +105,62 @@ IF (LHOOK) CALL DR_HOOK('PREP_WATFLUX',0,ZHOOK_HANDLE)
!
!* 2.0 Large scale orography
!
- CALL PREP_HOR_WATFLUX_FIELD(DTCO, U, &
- WM%WG, WM%W,GCP, &
- HPROGRAM,'ZS ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+ CALL PREP_HOR_WATFLUX_FIELD(DTCO, U, GCP, SIZE(WG%XLAT), W, &
+ HPROGRAM,'ZS ',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
!
!* 2.1 Temperature
!
- CALL PREP_HOR_WATFLUX_FIELD(DTCO, U, &
- WM%WG, WM%W,GCP, &
- HPROGRAM,'TSWATER',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE)
+ CALL PREP_HOR_WATFLUX_FIELD(DTCO, U, GCP, SIZE(WG%XLAT), W, &
+ HPROGRAM,'TSWATER',HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
+!
+ CALL CLEAN_PREP_OUTPUT_GRID
!
+IF (YDCTL%LPART6) THEN
+
!* 2.2 Roughness
!
-ALLOCATE(WM%W%XZ0(SIZE(WM%W%XTS)))
-WM%W%XZ0 = 0.001
+ ALLOCATE(W%XZ0(SIZE(W%XTS)))
+ W%XZ0 = 0.001
!
-!-------------------------------------------------------------------------------------
- CALL CLEAN_PREP_OUTPUT_GRID
!-------------------------------------------------------------------------------------
!
!* 3. Vertical interpolations of all variables
!
-IF(LVERTSHIFT)THEN
- CALL PREP_VER_WATFLUX(WM%W)
-ENDIF
+ IF(LVERTSHIFT)THEN
+ CALL PREP_VER_WATFLUX(W)
+ ENDIF
!
-DEALLOCATE(XZS_LS)
+ DEALLOCATE(XZS_LS)
!-------------------------------------------------------------------------------------
!
!* 4. Preparation of optional interpolation of monthly ts water
!
-WM%W%LINTERPOL_TS=.FALSE.
-IF(WM%W%CINTERPOL_TS/='NONE ')THEN
- WM%W%LINTERPOL_TS=.TRUE.
-ENDIF
+ W%LINTERPOL_TS=.FALSE.
+ IF(W%CINTERPOL_TS/='NONE ')THEN
+ W%LINTERPOL_TS=.TRUE.
+ ENDIF
!
-IF(WM%W%LINTERPOL_TS)THEN
+ IF(W%LINTERPOL_TS)THEN
!
! Precedent, Current, Next, and Second-next Monthly TS water
- INMTH=4
+ INMTH=4
!
- ALLOCATE(WM%W%XTS_MTH(SIZE(WM%W%XTS),INMTH))
- DO JMTH=1,INMTH
- WM%W%XTS_MTH(:,JMTH)=WM%W%XTS(:)
- ENDDO
+ ALLOCATE(W%XTS_MTH(SIZE(W%XTS),INMTH))
+ DO JMTH=1,INMTH
+ W%XTS_MTH(:,JMTH)=W%XTS(:)
+ ENDDO
!
-ENDIF
+ ENDIF
!
!-------------------------------------------------------------------------------------
!
!* 5. Preparation of SBL air variables
!
-WM%W%LSBL = LWAT_SBL
-IF (WM%W%LSBL) CALL PREP_WATFLUX_SBL(WM%WG, WM%WSB)
+ W%LSBL = LWAT_SBL
+ IF (W%LSBL) CALL PREP_SBL(WG%NDIM, SB)
+!
+ENDIF
+!
IF (LHOOK) CALL DR_HOOK('PREP_WATFLUX',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/prep_watflux_buffer.F90 b/src/SURFEX/prep_watflux_buffer.F90
index 745db4bba114b7e15615ed5826c51400aaff464a..b0984b95754d13ea456ffa94007e70a2edaf336a 100644
--- a/src/SURFEX/prep_watflux_buffer.F90
+++ b/src/SURFEX/prep_watflux_buffer.F90
@@ -103,7 +103,7 @@ END SELECT
!* 4. Interpolation method
! --------------------
!
- CINTERP_TYPE='BUFFER'
+CINTERP_TYPE='BUFFER'
IF (LHOOK) CALL DR_HOOK('PREP_WATFLUX_BUFFER',1,ZHOOK_HANDLE)
!
!
diff --git a/src/SURFEX/prep_watflux_extern.F90 b/src/SURFEX/prep_watflux_extern.F90
index 033c4da70e1c671679028c7175f2113eefca9113..d1fcc6c42a9652b2a7d699c581016d43bc0661b5 100644
--- a/src/SURFEX/prep_watflux_extern.F90
+++ b/src/SURFEX/prep_watflux_extern.F90
@@ -3,14 +3,15 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PREP_WATFLUX_EXTERN (GCP,&
- HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)
+SUBROUTINE PREP_WATFLUX_EXTERN (GCP,HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)
! #################################################################################
!
!
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
+USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
+USE MODD_SURFEX_MPI, ONLY : NRANK,NPIO
!
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
USE MODD_TYPE_DATE_SURF
!
USE MODI_PREP_GRID_EXTERN
@@ -21,7 +22,6 @@ USE MODI_ABOR1_SFX
USE MODI_GET_LUOUT
!
USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -30,9 +30,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-!
-!
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file
@@ -71,17 +70,16 @@ IF (LHOOK) CALL DR_HOOK('PREP_WATFLUX_EXTERN',0,ZHOOK_HANDLE)
!* 2. Reading of grid
! ---------------
!
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'FULL ')
- CALL PREP_GRID_EXTERN(GCP,&
- HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
+CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'FULL ')
+CALL PREP_GRID_EXTERN(GCP,HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
!
- CALL READ_SURF(&
- HFILEPGDTYPE,'DIM_WATER',IDIM_WATER,IRESP)
+CALL READ_SURF(HFILEPGDTYPE,'DIM_WATER',IDIM_WATER,IRESP,HDIR='-')
!
YRECFM='VERSION'
CALL READ_SURF(HFILEPGDTYPE,YRECFM,IVERSION,IRESP)
!
+IF (NRANK/=NPIO) INI = 0
+!
ALLOCATE(ZMASK(INI))
IF (IVERSION>=7) THEN
YRECFM='FRAC_WATER'
@@ -99,6 +97,9 @@ IF (IDIM_WATER==0) THEN
WRITE(ILUOUT,*) 'specify inland water temperature XTS_WATER_UNIF'
CALL ABOR1_SFX('PREP_WATFLUX_EXTERN: No inland water data available in input file')
END IF
+!
+IF (NRANK/=NPIO) INI=0
+!
!---------------------------------------------------------------------------------------
SELECT CASE(HSURF)
!---------------------------------------------------------------------------------------
@@ -109,8 +110,7 @@ SELECT CASE(HSURF)
CASE('ZS ')
ALLOCATE(PFIELD(INI,1))
YRECFM='ZS'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='E')
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
!
!* 4. Sea surface temperature
@@ -120,10 +120,8 @@ SELECT CASE(HSURF)
ALLOCATE(PFIELD(INI,1))
YRECFM='TS_WATER'
CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'WATER ')
- CALL READ_SURF(&
- HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'WATER ')
+ CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='E')
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
WHERE (ZMASK(:)==0.) PFIELD(:,1) = XUNDEF
!
diff --git a/src/SURFEX/prep_watflux_grib.F90 b/src/SURFEX/prep_watflux_grib.F90
index f55bb7f14702d760cea087565bdf6b42e3aeac00..4971e2ed6cc9c215376457ca37ffcfee06d15506 100644
--- a/src/SURFEX/prep_watflux_grib.F90
+++ b/src/SURFEX/prep_watflux_grib.F90
@@ -32,11 +32,7 @@ USE MODE_READ_GRIB
!
USE MODD_TYPE_DATE_SURF
!
-USE MODI_PREP_GRIB_GRID
-!
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
-USE MODD_GRID_GRIB, ONLY : CGRIB_FILE
-!
+USE MODD_GRID_GRIB, ONLY : CGRIB_FILE, CINMODEL
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -53,8 +49,6 @@ REAL,DIMENSION(:,:), POINTER :: PFIELD ! field to interpolate horizontally
!
!* 0.2 declarations of local variables
!
-TYPE (DATE_TIME) :: TZTIME_GRIB ! current date and time
- CHARACTER(LEN=6) :: YINMODEL ! model from which GRIB file originates
REAL, DIMENSION(:) ,POINTER:: ZMASK => NULL() ! Land mask
REAL, DIMENSION(:), POINTER :: ZFIELD => NULL() ! field read
!
@@ -69,9 +63,7 @@ IF (LHOOK) CALL DR_HOOK('PREP_WATFLUX_GRIB',0,ZHOOK_HANDLE)
!
IF (TRIM(HFILE).NE.CGRIB_FILE) CGRIB_FILE=""
!
- CALL PREP_GRIB_GRID(HFILE,KLUOUT,YINMODEL,CINGRID_TYPE,TZTIME_GRIB)
-!
- CALL READ_GRIB_LAND_MASK(HFILE,KLUOUT,YINMODEL,ZMASK)
+ CALL READ_GRIB_LAND_MASK(HFILE,KLUOUT,CINMODEL,ZMASK)
!
!
!* 2. Reading of field
@@ -85,9 +77,9 @@ SELECT CASE(HSURF)
! ---------
!
CASE('ZS ')
- SELECT CASE (YINMODEL)
- CASE ('ECMWF ','ARPEGE','ALADIN','MOCAGE')
- CALL READ_GRIB_ZS_LAND(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD)
+ SELECT CASE (CINMODEL)
+ CASE ('ECMWF ','ARPEGE','ALADIN','MOCAGE','HIRLAM')
+ CALL READ_GRIB_ZS_LAND(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD)
ALLOCATE(PFIELD(SIZE(ZFIELD),1))
PFIELD(:,1) = ZFIELD(:)
DEALLOCATE(ZFIELD)
@@ -97,9 +89,9 @@ SELECT CASE(HSURF)
! --------------------
!
CASE('TSWATER')
- SELECT CASE (YINMODEL)
- CASE ('ECMWF ','ARPEGE','ALADIN','MOCAGE')
- CALL READ_GRIB_T2(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD)
+ SELECT CASE (CINMODEL)
+ CASE ('ECMWF ','ARPEGE','ALADIN','MOCAGE','HIRLAM')
+ CALL READ_GRIB_TSWATER(HFILE,KLUOUT,CINMODEL,ZMASK,ZFIELD)
ALLOCATE(PFIELD(SIZE(ZFIELD),1))
PFIELD(:,1) = ZFIELD(:)
DEALLOCATE(ZFIELD)
@@ -111,8 +103,6 @@ DEALLOCATE(ZMASK)
!
!* 4. Interpolation method
! --------------------
-!
- CINTERP_TYPE='HORIBL'
!
IF (LHOOK) CALL DR_HOOK('PREP_WATFLUX_GRIB',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/prep_watflux_sbl.F90 b/src/SURFEX/prep_watflux_sbl.F90
deleted file mode 100644
index 6417ec0afddda34e137222e86567a8c4f6aa4f37..0000000000000000000000000000000000000000
--- a/src/SURFEX/prep_watflux_sbl.F90
+++ /dev/null
@@ -1,90 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE PREP_WATFLUX_SBL (WG, WSB)
-! #################################################################################
-!
-!!**** *PREP_WATFLUX_SBL* - prepares WATFLUX SBL fields
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/2006
-!! S. Riette 06/2009 XT, XU, XQ, XTKE are set to XUNDEF
-!! No more argument needed
-!! E. Martin 01/2011 XUNDEF fields are no more written in PREP file
-!!------------------------------------------------------------------
-!
-!
-!
-!
-USE MODD_WATFLUX_GRID_n, ONLY : WATFLUX_GRID_t
-USE MODD_WATFLUX_SBL_n, ONLY : WATFLUX_SBL_t
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!* 0.2 declarations of local variables
-!
-!
-TYPE(WATFLUX_GRID_t), INTENT(INOUT) :: WG
-TYPE(WATFLUX_SBL_t), INTENT(INOUT) :: WSB
-!
-INTEGER :: JLAYER
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZZF ! altitudes at half levels
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------------
-!
-!* 1. number of levels (MUST be at least equal to 2)
-! ----------------
-!
-IF (LHOOK) CALL DR_HOOK('PREP_WATFLUX_SBL',0,ZHOOK_HANDLE)
-WSB%NLVL = 6
-!
-!* 2. height of half levels (where turbulent fluxes will be)
-! ---------------------
-!
-!* Warning : ZZF(:,1) MUST BE ZERO
-ALLOCATE(ZZF(WG%NDIM,WSB%NLVL))
-ZZF(:,1) = 0.
-ZZF(:,2) = 1
-ZZF(:,3) = 3.
-ZZF(:,4) = 5.
-ZZF(:,5) = 8.
-ZZF(:,6) = 12.
-
-ALLOCATE(WSB%XZ(WG%NDIM,WSB%NLVL))
-DO JLAYER=1,WSB%NLVL-1
- WSB%XZ(:,JLAYER) = 0.5 * (ZZF(:,JLAYER)+ZZF(:,JLAYER+1))
-END DO
-WSB%XZ(:,WSB%NLVL) = 1.5 * ZZF(:,WSB%NLVL) - 0.5 * ZZF(:,WSB%NLVL-1)
-!
-DEALLOCATE(ZZF)
-!
-IF (LHOOK) CALL DR_HOOK('PREP_WATFLUX_SBL',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE PREP_WATFLUX_SBL
diff --git a/src/SURFEX/prep_watflux_unif.F90 b/src/SURFEX/prep_watflux_unif.F90
index 3a03c3df7ed80853039514879781b8f80fa8285e..c96f8479729b52a7808d746521de3c8181565c35 100644
--- a/src/SURFEX/prep_watflux_unif.F90
+++ b/src/SURFEX/prep_watflux_unif.F90
@@ -69,7 +69,7 @@ END SELECT
!* 4. Interpolation method
! --------------------
!
- CINTERP_TYPE='UNIF '
+CINTERP_TYPE='UNIF '
IF (LHOOK) CALL DR_HOOK('PREP_WATFLUX_UNIF',1,ZHOOK_HANDLE)
!
!
diff --git a/src/SURFEX/preps_for_meb_drag.F90 b/src/SURFEX/preps_for_meb_drag.F90
index 23bd49e38d338dc472f318db8ac6fd93c87331d5..c5b7ce5c230822bcd371cd9a6f06703a3126f36f 100644
--- a/src/SURFEX/preps_for_meb_drag.F90
+++ b/src/SURFEX/preps_for_meb_drag.F90
@@ -161,7 +161,7 @@ ENDIF
! Exner function at displacement height
! For consistancy displacement height has the same pressure as the surface
!
- CALL SURFACE_RI(PTC, PQC, PEXNS, PEXNA, PTA, PQA, &
+CALL SURFACE_RI(PTC, PQC, PEXNS, PEXNA, PTA, PQA, &
ZCUR, ZUCUR, PDIRCOSZW, PVMOD, PRI )
!
PRI(:) = MIN(PRI(:),XRIMAX)
diff --git a/src/SURFEX/preps_for_meb_ebud_rad.F90 b/src/SURFEX/preps_for_meb_ebud_rad.F90
index f6cd5213da762c5de8be1edc56feda6079e97527..5d1e9d0d521765de27b404eb80861f9059e4af9c 100644
--- a/src/SURFEX/preps_for_meb_ebud_rad.F90
+++ b/src/SURFEX/preps_for_meb_ebud_rad.F90
@@ -4,7 +4,7 @@
!SFX_LIC for details. version 1.
! ############################################################################
SUBROUTINE PREPS_FOR_MEB_EBUD_RAD(PPS, &
- PLAICV,PSNOWRHO,PSNOWSWE,PSNOWHEAT, &
+ PLAICV,PSNOWRHO,PSNOWSWE,PSNOWHEAT,PSNOWLIQ, &
PSNOWTEMP,PSNOWDZ,PSCOND,PHEATCAPS,PEMISNOW,PSIGMA_F,PCHIP, &
PTSTEP,PSR,PTA,PVMOD,PSNOWAGE,PPERMSNOWFRAC )
! ############################################################################
@@ -49,15 +49,17 @@ SUBROUTINE PREPS_FOR_MEB_EBUD_RAD(PPS, &
! ------------
!
!
+USE MODD_SNOW_PAR, ONLY : XRHOSMAX_ES, XRHOSMIN_ES, XEMISSN, XSNOWDMIN, &
+ XSNOWTHRMCOND1
+!
USE MODD_CSTS, ONLY : XTT, XLMTT, XRHOLW
!
-USE MODD_SNOW_PAR, ONLY : XRHOSMAX_ES, XRHOSMIN_ES, XEMISSN
+USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE MODD_SNOW_METAMO, ONLY : XSNOWDZMIN
!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE MODE_SNOW3L, ONLY : SNOW3LTHRM, SNOW3LSCAP
+USE MODE_SNOW3L, ONLY : SNOW3LTHRM, SNOW3LSCAP, SNOW3LFALL, &
+ SNOW3LTRANSF, SNOW3LGRID, SNOW3LCOMPACTN
!
USE MODE_MEB, ONLY : MEB_SHIELD_FACTOR
!
@@ -82,15 +84,15 @@ REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWSWE, PSNOWAGE, PSNOWRHO
REAL, DIMENSION(:), INTENT(OUT) :: PSIGMA_F, PCHIP
REAL, DIMENSION(:), INTENT(OUT) :: PEMISNOW
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSNOWDZ, PSCOND, PHEATCAPS, PSNOWTEMP
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSNOWDZ, PSCOND, PHEATCAPS, PSNOWTEMP, PSNOWLIQ
!
!
!* 0.2 declarations of local variables
!
-INTEGER :: JI, JK
+INTEGER :: JI, JK, JJ, INLVLS, ISIZE_SNOW, INI
+INTEGER, DIMENSION(SIZE(PTA)) :: NMASK ! indices correspondance between arrays
REAL, DIMENSION(SIZE(PLAICV,1)) :: ZPSNA
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWLIQ, ZSNOWHEAT, ZSNOWDZN
-REAL, DIMENSION(SIZE(PTA)) :: ZSNOW, ZSNOWHMASS
+REAL, DIMENSION(SIZE(PTA)) :: ZSNOW, ZSNOWFALL
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------
@@ -98,62 +100,59 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PREPS_FOR_MEB_EBUD_RAD',0,ZHOOK_HANDLE)
!
-! Here, as in snow3l (ISBA-ES), we account for several processes
-! on the snowpack before surface energy budget computations
-! (i.e. snowfall on albedo, density, thickness, and compaction etc...)
-!
-! First, since snow might not exist, check using snow density as a
-! proxy (since several computations below depend on this value). Note
-! that if snow doesn't exist, the variables below depending on snow
-! density are either zero (e.g. PSNOWDZ) or unused (e.g. PSCOND)
+INI = SIZE(PSNOWRHO,1)
+INLVLS = SIZE(PSNOWRHO,2)
!
WHERE(PSNOWRHO(:,:)==XUNDEF)
- PSNOWRHO(:,:) = XRHOSMIN_ES
+ PSNOWRHO(:,:) = XRHOSMIN_ES ! arbitrary...will be correctly set if snow present
ENDWHERE
!
-PSNOWDZ(:,:) = PSNOWSWE(:,:)/PSNOWRHO(:,:) ! diagnose current layer thicknesses (m)
+PSNOWDZ(:,:) = PSNOWSWE(:,:)/PSNOWRHO(:,:)
+PHEATCAPS(:,:) = SNOW3LSCAP(PSNOWRHO)
+PSCOND(:,:) = XSNOWTHRMCOND1 ! arbitrary...will be correctly set if snow present
+PSNOWTEMP(:,:) = XTT
+PSNOWLIQ(:,:) = 0.0
!
-! Local working:
+! Test variables to check for existance of snow:
+!
+ZSNOWFALL(:) = PSR(:)*PTSTEP/XRHOSMAX_ES
!
-ZSNOWHEAT(:,:) = PSNOWHEAT(:,:)*PSNOWSWE(:,:)/PSNOWRHO(:,:) ! J/m3 to J/m2
-
ZSNOW(:) = 0.0
-DO JK=1,SIZE(PSNOWDZ,2)
- DO JI=1,SIZE(PSNOWDZ,1)
+DO JK=1,INLVLS
+ DO JI=1,INI
ZSNOW(JI) = ZSNOW(JI) + PSNOWDZ(JI,JK)
ENDDO
ENDDO
!
- CALL SNOW3LFALL(PTSTEP,PSR,PTA,PVMOD,ZSNOW,PSNOWRHO,PSNOWDZ, &
- ZSNOWHEAT,ZSNOWHMASS,PSNOWAGE,PPERMSNOWFRAC )
-
- CALL SNOW3LGRID(ZSNOWDZN,ZSNOW,PSNOWDZ_OLD=PSNOWDZ)
-
- CALL SNOW3LTRANSF(ZSNOW,PSNOWDZ,ZSNOWDZN,PSNOWRHO,ZSNOWHEAT,PSNOWAGE)
-
-! Snow heat capacity:
+! Here, as in snow3l (ISBA-ES), we account for several processes
+! on the snowpack before surface energy budget computations
+! (i.e. snowfall on albedo, density, thickness, and compaction etc...)
!
-PHEATCAPS(:,:) = SNOW3LSCAP(PSNOWRHO) ! J m-3 K-1
+! ===============================================================
+! === Packing: Only call snow model routines when there is snow on the surface
+! exceeding a minimum threshold OR if the equivalent
+! snow depth falling during the current time step exceeds
+! this limit.
!
-! Snow temperature (K)
+! counts the number of points where the computations will be made
!
-PSNOWTEMP(:,:) = XTT + ( ((ZSNOWHEAT(:,:)/MAX(1.E-10,PSNOWDZ(:,:))) &
- + XLMTT*PSNOWRHO(:,:))/PHEATCAPS(:,:) )
!
-ZSNOWLIQ(:,:) = MAX(0.0,PSNOWTEMP(:,:)-XTT)*PHEATCAPS(:,:)* &
- PSNOWDZ(:,:)/(XLMTT*XRHOLW)
-
-PSNOWTEMP(:,:) = MIN(XTT,PSNOWTEMP(:,:))
-
-! SWE:
-
-PSNOWSWE(:,:) = PSNOWDZ(:,:)*PSNOWRHO(:,:)
-
- CALL SNOW3LCOMPACTN(PTSTEP,XSNOWDZMIN,PSNOWRHO,PSNOWDZ,PSNOWTEMP,ZSNOW,ZSNOWLIQ)
-
-! Snow thermal conductivity:
+ISIZE_SNOW = 0
+NMASK(:) = 0
+!
+DO JJ=1,INI
+ IF (ZSNOW(JJ) >= XSNOWDMIN .OR. ZSNOWFALL(JJ) >= XSNOWDMIN) THEN
+ ISIZE_SNOW = ISIZE_SNOW + 1
+ NMASK(ISIZE_SNOW) = JJ
+ ENDIF
+ENDDO
+!
+IF (ISIZE_SNOW>0) THEN
+ CALL CALL_SNOW_ROUTINES(ISIZE_SNOW,INLVLS,NMASK)
+ENDIF
+!
+! ===============================================================
!
- CALL SNOW3LTHRM(PSNOWRHO,PSCOND,PSNOWTEMP,PPS)
!
! View factor: (1 - shielding factor)
!
@@ -167,829 +166,124 @@ PEMISNOW(:) = XEMISSN
!
IF (LHOOK) CALL DR_HOOK('PREPS_FOR_MEB_EBUD_RAD',1,ZHOOK_HANDLE)
!
- CONTAINS
-!####################################################################
-SUBROUTINE SNOW3LFALL(PTSTEP,PSR,PTA,PVMOD,PSNOW,PSNOWRHO,PSNOWDZ, &
- PSNOWHEAT,PSNOWHMASS,PSNOWAGE,PPERMSNOWFRAC)
-!
-!! PURPOSE
-!! -------
-! Calculate changes to snowpack resulting from snowfall.
-! Update mass and heat content of uppermost layer.
!
+CONTAINS
+!================================================================
+SUBROUTINE CALL_SNOW_ROUTINES(KSIZE1,KSIZE2,KMASK)
!
-USE MODD_CSTS, ONLY : XLMTT, XTT, XCI
-USE MODD_SNOW_PAR, ONLY : XRHOSMIN_ES, XSNOWDMIN, &
- XSNOWFALL_A_SN, &
- XSNOWFALL_B_SN, &
- XSNOWFALL_C_SN
-!
-USE MODE_SNOW3L
+! Make some snow computations only over regions with snow cover or snow falling
!
IMPLICIT NONE
!
-!* 0.1 declarations of arguments
-!
-REAL, INTENT(IN) :: PTSTEP
-!
-REAL, DIMENSION(:), INTENT(IN) :: PSR, PTA, PVMOD, PPERMSNOWFRAC
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PSNOW
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWRHO, PSNOWDZ, PSNOWHEAT, PSNOWAGE
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PSNOWHMASS
-!
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: JJ, JI
-!
-INTEGER :: INI
-INTEGER :: INLVLS
-!
-REAL, DIMENSION(SIZE(PTA)) :: ZSNOWFALL, ZRHOSNEW, &
- ZSNOW, ZSNOWTEMP, &
- ZSNOWFALL_DELTA, ZSCAP, &
- ZAGENEW
-!
+INTEGER, INTENT(IN) :: KSIZE1
+INTEGER, INTENT(IN) :: KSIZE2
+INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
+!
+REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWSWE
+REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWRHO
+REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWHEAT
+REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWTEMP
+REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWLIQ
+REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWDZ
+REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SCOND
+REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWAGE
+REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWDZN
+REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_HEATCAPS
+REAL, DIMENSION(KSIZE1) :: ZP_SNOW
+REAL, DIMENSION(KSIZE1) :: ZP_SNOWHMASS
+REAL, DIMENSION(KSIZE1) :: ZP_PERMSNOWFRAC
+REAL, DIMENSION(KSIZE1) :: ZP_PS
+REAL, DIMENSION(KSIZE1) :: ZP_SR
+REAL, DIMENSION(KSIZE1) :: ZP_TA
+REAL, DIMENSION(KSIZE1) :: ZP_VMOD
+
+INTEGER :: JWRK, JJ, JI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-!-------------------------------------------------------------------------------
-!
-! 0. Initialize:
-! ------------------
-!
-IF (LHOOK) CALL DR_HOOK('SNOW3LFALL',0,ZHOOK_HANDLE)
-!
-INI = SIZE(PSNOWDZ(:,:),1)
-INLVLS = SIZE(PSNOWDZ(:,:),2)
-!
-ZRHOSNEW(:) = XRHOSMIN_ES
-ZAGENEW (:) = 0.0
-ZSNOWFALL(:) = 0.0
-ZSCAP(:) = 0.0
-ZSNOW(:) = PSNOW(:)
-!
-PSNOWHMASS(:) = 0.0
-!
-! 1. Incorporate snowfall into snowpack:
-! --------------------------------------
-!
-!
-! Heat content of newly fallen snow (J/m2):
-! NOTE for now we assume the snowfall has
-! the temperature of the snow surface upon reaching the snow.
-! This is done as opposed to using the air temperature since
-! this flux is quite small and has little to no impact
-! on the time scales of interest. If we use the above assumption
-! then, then the snowfall advective heat flux is zero.
+!----------------------------------------------------------------
!
-ZSNOWTEMP(:) = XTT
-ZSCAP (:) = SNOW3LSCAP(PSNOWRHO(:,1))
+IF (LHOOK) CALL DR_HOOK('SNOW3L_ISBA:CALL_MODEL',0,ZHOOK_HANDLE)
!
-WHERE (PSR(:) > 0.0 .AND. PSNOWDZ(:,1)>0.)
- ZSNOWTEMP(:) = XTT + (PSNOWHEAT(:,1) + &
- XLMTT*PSNOWRHO(:,1)*PSNOWDZ(:,1))/ &
- (ZSCAP(:)*MAX(XSNOWDMIN/INLVLS,PSNOWDZ(:,1)))
- ZSNOWTEMP(:) = MIN(XTT, ZSNOWTEMP(:))
-END WHERE
-!
-WHERE (PSR(:) > 0.0)
-!
- PSNOWHMASS(:) = PSR(:)*(XCI*(ZSNOWTEMP(:)-XTT)-XLMTT)*PTSTEP
-!
-! Snowfall density: Following CROCUS (Pahaut 1976)
-!
- ZRHOSNEW(:) = MAX(XRHOSMIN_ES, XSNOWFALL_A_SN + XSNOWFALL_B_SN*(PTA(:)-XTT)+ &
- XSNOWFALL_C_SN*SQRT(PVMOD(:)))
-!
-!
-! Fresh snowfall changes the snowpack age,
-! decreasing in uppermost snow layer (mass weighted average):
-!
- PSNOWAGE(:,1) = (PSNOWAGE(:,1)*PSNOWDZ(:,1)*PSNOWRHO(:,1)+ZAGENEW(:)*PSR(:)*PTSTEP) / &
- (PSNOWDZ(:,1)*PSNOWRHO(:,1)+PSR(:)*PTSTEP)
-!
-! Augment total pack depth:
-!
- ZSNOWFALL(:) = PSR(:)*PTSTEP/ZRHOSNEW(:) ! snowfall thickness (m)
-!
- PSNOW(:) = PSNOW(:) + ZSNOWFALL(:)
-!
-! Fresh snowfall changes the snowpack
-! density, increases the total liquid water
-! equivalent: in uppermost snow layer:
-!
- PSNOWRHO(:,1) = (PSNOWDZ(:,1)*PSNOWRHO(:,1) + ZSNOWFALL(:)*ZRHOSNEW(:))/ &
- (PSNOWDZ(:,1)+ZSNOWFALL(:))
-!
- PSNOWDZ(:,1) = PSNOWDZ(:,1) + ZSNOWFALL(:)
-!
-! Add energy of snowfall to snowpack:
-! Update heat content (J/m2) (therefore the snow temperature
-! and liquid content):
-!
- PSNOWHEAT(:,1) = PSNOWHEAT(:,1) + PSNOWHMASS(:)
-!
-END WHERE
-!
-!
-! 2. Case of new snowfall on a previously snow-free surface:
-! ----------------------------------------------------------
-!
-! When snow first falls on a surface devoid of snow,
-! redistribute the snow mass throughout the 3 layers:
-! (temperature already set in the calling routine
-! for this case)
-!
-ZSNOWFALL_DELTA(:) = 0.0
-WHERE(ZSNOW(:) == 0.0 .AND. PSR(:) > 0.0)
- ZSNOWFALL_DELTA(:) = 1.0
-END WHERE
-!
-DO JJ=1,INLVLS
- DO JI=1,INI
-!
- PSNOWDZ(JI,JJ) = ZSNOWFALL_DELTA(JI)*(ZSNOWFALL(JI) /INLVLS) + &
- (1.0-ZSNOWFALL_DELTA(JI))*PSNOWDZ(JI,JJ)
-!
- PSNOWHEAT(JI,JJ) = ZSNOWFALL_DELTA(JI)*(PSNOWHMASS(JI)/INLVLS) + &
- (1.0-ZSNOWFALL_DELTA(JI))*PSNOWHEAT(JI,JJ)
-!
- PSNOWRHO(JI,JJ) = ZSNOWFALL_DELTA(JI)*ZRHOSNEW(JI) + &
- (1.0-ZSNOWFALL_DELTA(JI))*PSNOWRHO(JI,JJ)
-!
- PSNOWAGE(JI,JJ) = ZSNOWFALL_DELTA(JI)*(ZAGENEW(JI)/INLVLS) + &
- (1.0-ZSNOWFALL_DELTA(JI))*PSNOWAGE(JI,JJ)
+! pack the variables
!
+DO JWRK=1,KSIZE2
+ DO JJ=1,KSIZE1
+ JI = KMASK(JJ)
+ ZP_SNOWSWE (JJ,JWRK) = PSNOWSWE (JI,JWRK)
+ ZP_SNOWRHO (JJ,JWRK) = PSNOWRHO (JI,JWRK)
+ ZP_SNOWHEAT(JJ,JWRK) = PSNOWHEAT(JI,JWRK)
+ ZP_SNOWAGE (JJ,JWRK) = PSNOWAGE (JI,JWRK)
+ ZP_SNOWDZ (JJ,JWRK) = PSNOWDZ (JI,JWRK)
ENDDO
ENDDO
!
-IF (LHOOK) CALL DR_HOOK('SNOW3LFALL',1,ZHOOK_HANDLE)
-!
-!
-END SUBROUTINE SNOW3LFALL
-!####################################################################
- SUBROUTINE SNOW3LTRANSF(PSNOW,PSNOWDZ,PSNOWDZN, &
- PSNOWRHO,PSNOWHEAT,PSNOWAGE)
-!
-!! PURPOSE
-!! -------
-! Snow mass,heat and characteristics redistibution in case of
-! grid resizing. Total mass and heat content of the overall snowpack
-! unchanged/conserved within this routine.
-! Same method as in Crocus
-!
-USE MODD_SNOW_PAR, ONLY : XSNOWCRITD
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-REAL, DIMENSION(: ), INTENT(IN) :: PSNOW
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWDZN
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWHEAT
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWRHO
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWDZ
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWAGE
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: JI, JL, JLO
-!
-INTEGER :: INI
-INTEGER :: INLVLS
-!
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWRHON
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWHEATN
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWAGEN
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWZTOP_NEW
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWZBOT_NEW
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWRHOO
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWHEATO
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWAGEO
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWDZO
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWZTOP_OLD
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWZBOT_OLD
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWHEAN
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWAGN
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZMASTOTN
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZMASSDZO
-!
-REAL, DIMENSION(SIZE(PSNOW)) :: ZPSNOW_OLD, ZPSNOW_NEW
-REAL, DIMENSION(SIZE(PSNOW)) :: ZSUMHEAT, ZSUMSWE, ZSUMAGE, ZSNOWMIX_DELTA
-!
-REAL :: ZPROPOR
+DO JJ=1,KSIZE1
+ JI = KMASK(JJ)
+ ZP_SNOW (JJ) = ZSNOW(JI)
+ ZP_PS (JJ) = PPS (JI)
+ ZP_SR (JJ) = PSR (JI)
+ ZP_TA (JJ) = PTA (JI)
+ ZP_VMOD (JJ) = PVMOD(JI)
+ ZP_PERMSNOWFRAC(JJ) = PPERMSNOWFRAC(JI)
+ENDDO
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!---------------------------------------------------------------
!
-!-------------------------------------------------------------------------------
-!
-! 0. Initialization:
-! ------------------
+! Local working:
!
+ZP_SNOWHEAT(:,:) = ZP_SNOWHEAT(:,:)*ZP_SNOWDZ(:,:) ! J/m3 to J/m2
!
-IF (LHOOK) CALL DR_HOOK('SNOW3LTRANSF',0,ZHOOK_HANDLE)
!
-INI = SIZE(PSNOWRHO,1)
-INLVLS = SIZE(PSNOWRHO,2)
+CALL SNOW3LFALL(PTSTEP,ZP_SR,ZP_TA,ZP_VMOD,ZP_SNOW,ZP_SNOWRHO,ZP_SNOWDZ, &
+ ZP_SNOWHEAT,ZP_SNOWHMASS,ZP_SNOWAGE,ZP_PERMSNOWFRAC)
!
-ZPSNOW_NEW(:) = 0.0
-ZPSNOW_OLD(:) = PSNOW(:)
+CALL SNOW3LGRID(ZP_SNOWDZN,ZP_SNOW,PSNOWDZ_OLD=ZP_SNOWDZ)
!
-DO JL=1,INLVLS
- DO JI=1,INI
- ZPSNOW_NEW(JI)=ZPSNOW_NEW(JI)+PSNOWDZN(JI,JL)
- ENDDO
-ENDDO
+CALL SNOW3LTRANSF(ZP_SNOW,ZP_SNOWDZ,ZP_SNOWDZN,ZP_SNOWRHO,ZP_SNOWHEAT,ZP_SNOWAGE)
!
-! initialization of variables describing the initial snowpack
+! Snow heat capacity:
!
-ZSNOWDZO (:,:) = PSNOWDZ (:,:)
-ZSNOWRHOO (:,:) = PSNOWRHO (:,:)
-ZSNOWHEATO(:,:) = PSNOWHEAT(:,:)
-ZSNOWAGEO (:,:) = PSNOWAGE (:,:)
-ZMASSDZO (:,:) = XUNDEF
+ZP_HEATCAPS(:,:) = SNOW3LSCAP(ZP_SNOWRHO) ! J m-3 K-1
!
-! 1. Calculate vertical grid limits (m):
-! --------------------------------------
+! Snow temperature (K)
!
-ZSNOWZTOP_OLD(:,1) = ZPSNOW_OLD(:)
-ZSNOWZTOP_NEW(:,1) = ZPSNOW_NEW(:)
-ZSNOWZBOT_OLD(:,1) = ZSNOWZTOP_OLD(:,1)-ZSNOWDZO(:,1)
-ZSNOWZBOT_NEW(:,1) = ZSNOWZTOP_NEW(:,1)-PSNOWDZN(:,1)
+ZP_SNOWTEMP(:,:) = XTT + ( ((ZP_SNOWHEAT(:,:)/MAX(1.E-10,ZP_SNOWDZ(:,:))) &
+ + XLMTT*ZP_SNOWRHO(:,:))/ZP_HEATCAPS(:,:) )
!
-DO JL=2,INLVLS
- DO JI=1,INI
- ZSNOWZTOP_OLD(JI,JL) = ZSNOWZBOT_OLD(JI,JL-1)
- ZSNOWZTOP_NEW(JI,JL) = ZSNOWZBOT_NEW(JI,JL-1)
- ZSNOWZBOT_OLD(JI,JL) = ZSNOWZTOP_OLD(JI,JL )-ZSNOWDZO(JI,JL)
- ZSNOWZBOT_NEW(JI,JL) = ZSNOWZTOP_NEW(JI,JL )-PSNOWDZN(JI,JL)
- ENDDO
-ENDDO
-ZSNOWZBOT_OLD(:,INLVLS)=0.0
-ZSNOWZBOT_NEW(:,INLVLS)=0.0
+ZP_SNOWLIQ(:,:) = MAX(0.0,ZP_SNOWTEMP(:,:)-XTT)*ZP_HEATCAPS(:,:)* &
+ ZP_SNOWDZ(:,:)/(XLMTT*XRHOLW)
-WHERE(PSNOWDZN(:,:)==0.)
- ZSNOWZTOP_OLD(:,:) = 0.
- ZSNOWZTOP_NEW(:,:) = 0.
- ZSNOWZBOT_OLD(:,:) = 0.
- ZSNOWZBOT_NEW(:,:) = 0.
-END WHERE
-!
-! 3. Calculate mass, heat, charcateristics mixing due to vertical grid resizing:
-! --------------------------------------------------------------------
-!
-! loop over the new snow layers
-! Summ or avergage of the constituting quantities of the old snow layers
-! which are totally or partially inserted in the new snow layer
-! For snow age, mass weighted average is used.
-!
-ZSNOWHEAN(:,:)=0.0
-ZMASTOTN (:,:)=0.0
-ZSNOWAGN (:,:)=0.0
-!
-DO JL=1,INLVLS
- DO JLO=1, INLVLS
- DO JI=1,INI
- IF((ZSNOWZTOP_OLD(JI,JLO)>ZSNOWZBOT_NEW(JI,JL)).AND.(ZSNOWZBOT_OLD(JI,JLO)<ZSNOWZTOP_NEW(JI,JL)))THEN
-!
- ZPROPOR = (MIN(ZSNOWZTOP_OLD(JI,JLO), ZSNOWZTOP_NEW(JI,JL)) &
- - MAX(ZSNOWZBOT_OLD(JI,JLO), ZSNOWZBOT_NEW(JI,JL)))&
- / ZSNOWDZO(JI,JLO)
-!
- ZMASSDZO (JI,JLO)=ZSNOWRHOO(JI,JLO)*ZSNOWDZO(JI,JLO)*ZPROPOR
-!
- ZMASTOTN (JI,JL)=ZMASTOTN (JI,JL)+ZMASSDZO (JI,JLO)
- ZSNOWAGN (JI,JL)=ZSNOWAGN (JI,JL)+ZSNOWAGEO (JI,JLO)*ZMASSDZO(JI,JLO)
-!
- ZSNOWHEAN(JI,JL)=ZSNOWHEAN(JI,JL)+ZSNOWHEATO(JI,JLO)*ZPROPOR
-!
- ENDIF
- ENDDO
- ENDDO
-ENDDO
-!
-! the new layer inherits from the weighted average properties of the old ones
-! heat and mass
-!
-ZSNOWHEATN(:,:)= ZSNOWHEAN(:,:)
-WHERE(PSNOWDZN(:,:)==0.)
- ZSNOWAGEN (:,:)= PSNOWAGE(:,:)
- ZSNOWRHON (:,:)= PSNOWRHO(:,:)
- ZSNOWHEATN(:,:)= PSNOWHEAT(:,:)
-ELSEWHERE
- ZSNOWAGEN (:,:)= ZSNOWAGN (:,:)/ZMASTOTN(:,:)
- ZSNOWRHON (:,:)= ZMASTOTN (:,:)/PSNOWDZN(:,:)
-END WHERE
-!
-! 4. Vanishing or very thin snowpack check:
-! -----------------------------------------
-!
-! NOTE: ONLY for very shallow snowpacks, mix properties (homogeneous):
-! this avoids problems related to heat and mass exchange for
-! thin layers during heavy snowfall or signifigant melt: one
-! new/old layer can exceed the thickness of several old/new layers.
-! Therefore, mix (conservative):
-!
-ZSUMHEAT(:) = 0.0
-ZSUMSWE(:) = 0.0
-ZSUMAGE(:) = 0.0
-ZSNOWMIX_DELTA(:) = 0.0
-!
-DO JL=1,INLVLS
- DO JI=1,INI
- IF(PSNOW(JI) < XSNOWCRITD)THEN
- ZSUMHEAT (JI) = ZSUMHEAT(JI) + PSNOWHEAT(JI,JL)
- ZSUMSWE (JI) = ZSUMSWE (JI) + PSNOWRHO (JI,JL)*PSNOWDZ(JI,JL)
- ZSUMAGE (JI) = ZSUMAGE (JI) + PSNOWAGE (JI,JL)
- ZSNOWMIX_DELTA(JI) = 1.0
- ENDIF
- ENDDO
-ENDDO
-!
-! Heat and mass are evenly distributed vertically:
-! heat and mass (density and thickness) are constant
-! in profile:
-!
-DO JL=1,INLVLS
- DO JI=1,INI
+ZP_SNOWTEMP(:,:) = MIN(XTT,ZP_SNOWTEMP(:,:))
- IF(PSNOWDZN(JI,JL)>0.)THEN
+! SWE:
-!
- ZSNOWHEATN(JI,JL) = ZSNOWMIX_DELTA(JI)*(ZSUMHEAT(JI)/INLVLS) + &
- (1.0-ZSNOWMIX_DELTA(JI))*ZSNOWHEATN(JI,JL)
-!
- PSNOWDZN(JI,JL) = ZSNOWMIX_DELTA(JI)*(PSNOW(JI)/INLVLS) + &
- (1.0-ZSNOWMIX_DELTA(JI))*PSNOWDZN(JI,JL)
-!
- ZSNOWRHON(JI,JL) = ZSNOWMIX_DELTA(JI)*(ZSUMSWE(JI)/PSNOW(JI)) + &
- (1.0-ZSNOWMIX_DELTA(JI))*ZSNOWRHON(JI,JL)
-!
- ZSNOWAGEN(JI,JL) = ZSNOWMIX_DELTA(JI)*(ZSUMAGE(JI)/INLVLS) + &
- (1.0-ZSNOWMIX_DELTA(JI))*ZSNOWAGEN(JI,JL)
-!
- ENDIF
- ENDDO
-ENDDO
-!
-! 5. Update mass (density and thickness) and heat:
-! ------------------------------------------------
-!
-PSNOWDZ (:,:) = PSNOWDZN (:,:)
-PSNOWRHO (:,:) = ZSNOWRHON (:,:)
-PSNOWHEAT(:,:) = ZSNOWHEATN(:,:)
-PSNOWAGE (:,:) = ZSNOWAGEN (:,:)
-!
-IF (LHOOK) CALL DR_HOOK('SNOW3LTRANSF',1,ZHOOK_HANDLE)
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE SNOW3LTRANSF
-!####################################################################
- SUBROUTINE SNOW3LGRID(PSNOWDZ,PSNOW,PSNOWDZ_OLD)
-!
-!! PURPOSE
-!! -------
-! Once during each time step, update grid to maintain
-! grid proportions. Similar to approach of Lynch-Steiglitz,
-! 1994, J. Clim., 7, 1842-1855. Corresponding mass and
-! heat adjustments made directly after the call to this
-! routine. 3 grid configurations:
-! 1) for very thin snow, constant grid spacing
-! 2) for intermediate thicknesses, highest resolution at soil/snow
-! interface and at the snow/atmosphere interface
-! 3) for deep snow, vertical resoution finest at snow/atmosphere
-! interface (set to a constant value) and increases with snow depth.
-! Second layer can't be more than an order of magnitude thicker
-! than surface layer.
-!
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_SNOW_PAR, ONLY : XSNOWCRITD
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-REAL, DIMENSION(: ), INTENT(IN ) :: PSNOW
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSNOWDZ
-REAL, DIMENSION(:,:), INTENT(IN ), OPTIONAL :: PSNOWDZ_OLD
-!
-!* 0.1 declarations of local variables
-!
-INTEGER :: JJ, JI
-!
-INTEGER :: INLVLS, INI
-!
-REAL, DIMENSION(SIZE(PSNOW)) :: ZWORK
-!
-LOGICAL , DIMENSION(SIZE(PSNOW)) :: GREGRID
+ZP_SNOWSWE(:,:) = ZP_SNOWDZ(:,:)*ZP_SNOWRHO(:,:)
-! ISBA-ES snow grid parameters
-!
-REAL, PARAMETER, DIMENSION(3) :: ZSGCOEF1 = (/0.25, 0.50, 0.25/)
-REAL, PARAMETER, DIMENSION(2) :: ZSGCOEF2 = (/0.05, 0.34/)
-!
-REAL, PARAMETER, DIMENSION(3) :: ZSGCOEF = (/0.3, 0.4, 0.3/)
-!
-! Minimum total snow depth at which surface layer thickness is constant:
-!
-REAL, PARAMETER :: ZSNOWTRANS = 0.20 ! (m)
-!
-! Minimum snow depth by layer for 6-L or 12-L configuration :
-!
-REAL, PARAMETER :: ZDZ1=0.01
-REAL, PARAMETER :: ZDZ2=0.05
-REAL, PARAMETER :: ZDZ3=0.15
-REAL, PARAMETER :: ZDZ4=0.50
-REAL, PARAMETER :: ZDZ5=1.00
-REAL, PARAMETER :: ZDZN0=0.02
-REAL, PARAMETER :: ZDZN1=0.1
-REAL, PARAMETER :: ZDZN2=0.5
-REAL, PARAMETER :: ZDZN3=1.0
-!
-REAL, PARAMETER :: ZCOEF1 = 0.5
-REAL, PARAMETER :: ZCOEF2 = 1.5
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-! 0. Initialization:
-! ------------------
-!
-IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LGRID_2D',0,ZHOOK_HANDLE)
-!
-INLVLS = SIZE(PSNOWDZ(:,:),2)
-INI = SIZE(PSNOWDZ(:,:),1)
-!
-ZWORK (:) = 0.0
-GREGRID(:) = .TRUE.
-!
-! 1. Calculate current grid for 3-layer (default) configuration):
-! ---------------------------------------------------------------
-! Based on formulation of Lynch-Stieglitz (1994)
-! except for 3 modifications:
-! i) smooth transition here at ZSNOWTRANS
-! ii) constant ratio for very thin snow:
-! iii) ratio of layer 2 to surface layer <= 10
-!
-IF(INLVLS == 1)THEN
-!
- DO JI=1,INI
- PSNOWDZ(JI,1) = PSNOW(JI)
- ENDDO
-!
-ELSEIF(INLVLS == 3)THEN
-!
- WHERE(PSNOW <= XSNOWCRITD+0.01)
- PSNOWDZ(:,1) = MIN(0.01, PSNOW(:)/INLVLS)
- PSNOWDZ(:,3) = MIN(0.01, PSNOW(:)/INLVLS)
- PSNOWDZ(:,2) = PSNOW(:) - PSNOWDZ(:,1) - PSNOWDZ(:,3)
- END WHERE
-!
- WHERE(PSNOW <= ZSNOWTRANS .AND. PSNOW > XSNOWCRITD+0.01)
- PSNOWDZ(:,1) = PSNOW(:)*ZSGCOEF1(1)
- PSNOWDZ(:,2) = PSNOW(:)*ZSGCOEF1(2)
- PSNOWDZ(:,3) = PSNOW(:)*ZSGCOEF1(3)
- END WHERE
-!
- WHERE(PSNOW > ZSNOWTRANS)
- PSNOWDZ(:,1) = ZSGCOEF2(1)
- PSNOWDZ(:,2) = (PSNOW(:)-ZSGCOEF2(1))*ZSGCOEF2(2) + ZSGCOEF2(1)
-!
-! When using simple finite differences, limit the thickness
-! factor between the top and 2nd layers to at most 10
-!
- PSNOWDZ(:,2) = MIN(10*ZSGCOEF2(1), PSNOWDZ(:,2))
- PSNOWDZ(:,3) = PSNOW(:) - PSNOWDZ(:,2) - PSNOWDZ(:,1)
- END WHERE
-!
-!
-! 2. Calculate current grid for 6-layer :
-! ---------------------------------------------------------------
-!
-ELSEIF(INLVLS == 6)THEN
-!
-! critere a satisfaire pour remaillage
-!
- IF(PRESENT(PSNOWDZ_OLD))THEN
- GREGRID(:) = PSNOWDZ_OLD(:,1) < ZCOEF1 * MIN(ZDZ1 ,PSNOW(:)/INLVLS) .OR. &
- & PSNOWDZ_OLD(:,1) > ZCOEF2 * MIN(ZDZ1 ,PSNOW(:)/INLVLS) .OR. &
- & PSNOWDZ_OLD(:,2) < ZCOEF1 * MIN(ZDZ2 ,PSNOW(:)/INLVLS) .OR. &
- & PSNOWDZ_OLD(:,2) > ZCOEF2 * MIN(ZDZ2 ,PSNOW(:)/INLVLS) .OR. &
- & PSNOWDZ_OLD(:,6) < ZCOEF1 * MIN(ZDZN1,PSNOW(:)/INLVLS) .OR. &
- & PSNOWDZ_OLD(:,6) > ZCOEF2 * MIN(ZDZN1,PSNOW(:)/INLVLS)
- ENDIF
-!
- WHERE(GREGRID(:))
-! top layers
- PSNOWDZ(:,1) = MIN(ZDZ1,PSNOW(:)/INLVLS)
- PSNOWDZ(:,2) = MIN(ZDZ2,PSNOW(:)/INLVLS)
-! last layers
- PSNOWDZ(:,6) = MIN(ZDZN1,PSNOW(:)/INLVLS)
-! remaining snow for remaining layers
- ZWORK(:) = PSNOW(:) - PSNOWDZ(:,1) - PSNOWDZ(:,2) - PSNOWDZ(:,6)
- PSNOWDZ(:,3) = ZWORK(:)*ZSGCOEF(1)
- PSNOWDZ(:,4) = ZWORK(:)*ZSGCOEF(2)
- PSNOWDZ(:,5) = ZWORK(:)*ZSGCOEF(3)
-! layer 3 tickness >= layer 2 tickness
- ZWORK(:)=MIN(0.0,PSNOWDZ(:,3)-PSNOWDZ(:,2))
- PSNOWDZ(:,3)=PSNOWDZ(:,3)-ZWORK(:)
- PSNOWDZ(:,4)=PSNOWDZ(:,4)+ZWORK(:)
-! layer 5 tickness >= layer 6 tickness
- ZWORK(:)=MIN(0.0,PSNOWDZ(:,5)-PSNOWDZ(:,6))
- PSNOWDZ(:,5)=PSNOWDZ(:,5)-ZWORK(:)
- PSNOWDZ(:,4)=PSNOWDZ(:,4)+ZWORK(:)
- ENDWHERE
-!
-! 3. Calculate current grid for 9-layer :
-! ---------------------------------------------------------------
-!
-ELSEIF(INLVLS == 9)THEN
-!
-! critere a satisfaire pour remaillage
-!
- IF(PRESENT(PSNOWDZ_OLD))THEN
- GREGRID(:) = PSNOWDZ_OLD(:,1) < ZCOEF1 * MIN(ZDZ1 ,PSNOW(:)/INLVLS) .OR. &
- & PSNOWDZ_OLD(:,1) > ZCOEF2 * MIN(ZDZ1 ,PSNOW(:)/INLVLS) .OR. &
- & PSNOWDZ_OLD(:,2) < ZCOEF1 * MIN(ZDZ2 ,PSNOW(:)/INLVLS) .OR. &
- & PSNOWDZ_OLD(:,2) > ZCOEF2 * MIN(ZDZ2 ,PSNOW(:)/INLVLS) .OR. &
- & PSNOWDZ_OLD(:,9) < ZCOEF1 * MIN(ZDZN0,PSNOW(:)/INLVLS) .OR. &
- & PSNOWDZ_OLD(:,9) > ZCOEF2 * MIN(ZDZN0,PSNOW(:)/INLVLS)
- ENDIF
-!
- WHERE(GREGRID(:))
-! top layers
- PSNOWDZ(:,1) = MIN(ZDZ1,PSNOW(:)/INLVLS)
- PSNOWDZ(:,2) = MIN(ZDZ2,PSNOW(:)/INLVLS)
- PSNOWDZ(:,3) = MIN(ZDZ3,PSNOW(:)/INLVLS)
-! last layers
- PSNOWDZ(:,9)= MIN(ZDZN0,PSNOW(:)/INLVLS)
- PSNOWDZ(:,8)= MIN(ZDZN1,PSNOW(:)/INLVLS)
- PSNOWDZ(:,7)= MIN(ZDZN2,PSNOW(:)/INLVLS)
-! remaining snow for remaining layers
- ZWORK(:) = PSNOW(:) - PSNOWDZ(:, 1) - PSNOWDZ(:, 2) - PSNOWDZ(:, 3) &
- - PSNOWDZ(:, 7) - PSNOWDZ(:, 8) - PSNOWDZ(:, 9)
- PSNOWDZ(:,4) = ZWORK(:)*ZSGCOEF(1)
- PSNOWDZ(:,5) = ZWORK(:)*ZSGCOEF(2)
- PSNOWDZ(:,6) = ZWORK(:)*ZSGCOEF(3)
-! layer 4 tickness >= layer 3 tickness
- ZWORK(:)=MIN(0.0,PSNOWDZ(:,4)-PSNOWDZ(:,3))
- PSNOWDZ(:,4)=PSNOWDZ(:,4)-ZWORK(:)
- PSNOWDZ(:,5)=PSNOWDZ(:,5)+ZWORK(:)
-! layer 6 tickness >= layer 7 tickness
- ZWORK(:)=MIN(0.0,PSNOWDZ(:,6)-PSNOWDZ(:,7))
- PSNOWDZ(:,6)=PSNOWDZ(:,6)-ZWORK(:)
- PSNOWDZ(:,5)=PSNOWDZ(:,5)+ZWORK(:)
- ENDWHERE
-!
-! 4. Calculate current grid for 12-layer :
-! ---------------------------------------------------------------
-!
-ELSEIF(INLVLS == 12)THEN
-!
-! critere a satisfaire pour remaillage
-!
- IF(PRESENT(PSNOWDZ_OLD))THEN
- GREGRID(:) = PSNOWDZ_OLD(:, 1) < ZCOEF1 * MIN(ZDZ1 ,PSNOW(:)/INLVLS) .OR. &
- & PSNOWDZ_OLD(:, 1) > ZCOEF2 * MIN(ZDZ1 ,PSNOW(:)/INLVLS) .OR. &
- & PSNOWDZ_OLD(:, 2) < ZCOEF1 * MIN(ZDZ2 ,PSNOW(:)/INLVLS) .OR. &
- & PSNOWDZ_OLD(:, 2) > ZCOEF2 * MIN(ZDZ2 ,PSNOW(:)/INLVLS) .OR. &
- & PSNOWDZ_OLD(:,12) < ZCOEF1 * MIN(ZDZN0,PSNOW(:)/INLVLS) .OR. &
- & PSNOWDZ_OLD(:,12) > ZCOEF2 * MIN(ZDZN0,PSNOW(:)/INLVLS)
- ENDIF
-!
- WHERE(GREGRID(:))
-! top layers
- PSNOWDZ(:,1) = MIN(ZDZ1,PSNOW(:)/INLVLS)
- PSNOWDZ(:,2) = MIN(ZDZ2,PSNOW(:)/INLVLS)
- PSNOWDZ(:,3) = MIN(ZDZ3,PSNOW(:)/INLVLS)
- PSNOWDZ(:,4) = MIN(ZDZ4,PSNOW(:)/INLVLS)
- PSNOWDZ(:,5) = MIN(ZDZ5,PSNOW(:)/INLVLS)
-! last layers
- PSNOWDZ(:,12)= MIN(ZDZN0,PSNOW(:)/INLVLS)
- PSNOWDZ(:,11)= MIN(ZDZN1,PSNOW(:)/INLVLS)
- PSNOWDZ(:,10)= MIN(ZDZN2,PSNOW(:)/INLVLS)
- PSNOWDZ(:, 9)= MIN(ZDZN3,PSNOW(:)/INLVLS)
-! remaining snow for remaining layers
- ZWORK(:) = PSNOW(:) - PSNOWDZ(:, 1) - PSNOWDZ(:, 2) - PSNOWDZ(:, 3) &
- - PSNOWDZ(:, 4) - PSNOWDZ(:, 5) - PSNOWDZ(:, 9) &
- - PSNOWDZ(:,10) - PSNOWDZ(:,11) - PSNOWDZ(:,12)
- PSNOWDZ(:,6) = ZWORK(:)*ZSGCOEF(1)
- PSNOWDZ(:,7) = ZWORK(:)*ZSGCOEF(2)
- PSNOWDZ(:,8) = ZWORK(:)*ZSGCOEF(3)
-! layer 6 tickness >= layer 5 tickness
- ZWORK(:)=MIN(0.0,PSNOWDZ(:,6)-PSNOWDZ(:,5))
- PSNOWDZ(:,6)=PSNOWDZ(:,6)-ZWORK(:)
- PSNOWDZ(:,7)=PSNOWDZ(:,7)+ZWORK(:)
-! layer 8 tickness >= layer 9 tickness
- ZWORK(:)=MIN(0.0,PSNOWDZ(:,8)-PSNOWDZ(:,9))
- PSNOWDZ(:,8)=PSNOWDZ(:,8)-ZWORK(:)
- PSNOWDZ(:,7)=PSNOWDZ(:,7)+ZWORK(:)
- ENDWHERE
-!
-! 4. Calculate other non-optimized grid :
-! ---------------------------------------
-!
-ELSEIF(INLVLS<10.AND.INLVLS/=3.AND.INLVLS/=6.AND.INLVLS/=9) THEN
-!
- DO JJ=1,INLVLS
- DO JI=1,INI
- PSNOWDZ(JI,JJ) = PSNOW(JI)/INLVLS
- ENDDO
- ENDDO
-!
- PSNOWDZ(:,INLVLS) = PSNOWDZ(:,INLVLS) + (PSNOWDZ(:,1) - MIN(0.05, PSNOWDZ(:,1)))
- PSNOWDZ(:,1) = MIN(0.05, PSNOWDZ(:,1))
-!
-ELSE !(INLVLS>=10 and /=12)
-!
-! critere a satisfaire pour remaillage
-!
- IF(PRESENT(PSNOWDZ_OLD))THEN
- GREGRID(:) = PSNOWDZ_OLD(:, 1) < ZCOEF1 * MIN(ZDZ1 ,PSNOW(:)/INLVLS) .OR. &
- & PSNOWDZ_OLD(:, 1) > ZCOEF2 * MIN(ZDZ1 ,PSNOW(:)/INLVLS) .OR. &
- & PSNOWDZ_OLD(:, 2) < ZCOEF1 * MIN(ZDZ2 ,PSNOW(:)/INLVLS) .OR. &
- & PSNOWDZ_OLD(:, 2) > ZCOEF2 * MIN(ZDZ2 ,PSNOW(:)/INLVLS) .OR. &
- & PSNOWDZ_OLD(:,INLVLS) < ZCOEF1 * MIN(0.05*PSNOW(:),PSNOW(:)/INLVLS) .OR. &
- & PSNOWDZ_OLD(:,INLVLS) > ZCOEF2 * MIN(0.05*PSNOW(:),PSNOW(:)/INLVLS)
- ENDIF
-!
- WHERE(GREGRID(:))
- PSNOWDZ(:,1 ) = MIN(ZDZ1 ,PSNOW(:)/INLVLS)
- PSNOWDZ(:,2 ) = MIN(ZDZ2 ,PSNOW(:)/INLVLS)
- PSNOWDZ(:,3 ) = MIN(ZDZ3 ,PSNOW(:)/INLVLS)
- PSNOWDZ(:,4 ) = MIN(ZDZ4 ,PSNOW(:)/INLVLS)
- PSNOWDZ(:,5 ) = MIN(ZDZ5 ,PSNOW(:)/INLVLS)
- PSNOWDZ(:,INLVLS) = MIN(0.05*PSNOW(:),PSNOW(:)/INLVLS)
- ENDWHERE
-!
- DO JJ=6,INLVLS-1,1
- DO JI=1,INI
- IF(GREGRID(JI))THEN
- ZWORK(JI) = PSNOWDZ(JI,1)+PSNOWDZ(JI,2)+PSNOWDZ(JI,3)+PSNOWDZ(JI,4)+PSNOWDZ(JI,5)
- PSNOWDZ(JI,JJ) = (PSNOW(JI)-ZWORK(JI)-PSNOWDZ(JI,INLVLS))/(INLVLS-6)
- ENDIF
- ENDDO
- ENDDO
-!
-ENDIF
-!
-DO JJ=1,INLVLS
- DO JI=1,INI
- IF(PSNOW(JI)==XUNDEF)THEN
- PSNOWDZ(JI,JJ) = XUNDEF
- ELSEIF(.NOT.GREGRID(JI))THEN
- PSNOWDZ(JI,JJ)=PSNOWDZ_OLD(JI,JJ)
- ENDIF
- ENDDO
-ENDDO
-!
-IF (LHOOK) CALL DR_HOOK('MODE_SNOW3L:SNOW3LGRID_2D',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE SNOW3LGRID
-!####################################################################
-SUBROUTINE SNOW3LCOMPACTN(PTSTEP,PSNOWDZMIN,PSNOWRHO,PSNOWDZ,PSNOWTEMP,PSNOW,PSNOWLIQ)
-!
-!! PURPOSE
-!! -------
-! Snow compaction due to overburden and settling.
-! Mass is unchanged: layer thickness is reduced
-! in proportion to density increases. Method
-! of Brun et al (1989) and Vionnet et al. (2012)
-!
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE MODD_CSTS, ONLY : XTT, XG
-USE MODD_SNOW_PAR, ONLY : XRHOSMAX_ES
-!
-USE MODD_SNOW_METAMO, ONLY : XVVISC1,XVVISC3,XVVISC4, &
- XVVISC5,XVVISC6,XVRO11
-!
-USE MODE_SNOW3L, ONLY : SNOW3LHOLD
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-REAL, INTENT(IN) :: PTSTEP
-REAL, INTENT(IN) :: PSNOWDZMIN
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWTEMP, PSNOWLIQ
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWRHO, PSNOWDZ
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PSNOW
-!
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: JJ, JI
-!
-INTEGER :: INI
-INTEGER :: INLVLS
-!
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWRHO2, ZVISCOCITY, ZF1, &
- ZTEMP, ZSMASS, ZSNOWDZ, &
- ZWSNOWDZ, ZWHOLDMAX
-!
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-! 0. Initialization:
-! ------------------
-!
-IF (LHOOK) CALL DR_HOOK('SNOW3LCOMPACTN',0,ZHOOK_HANDLE)
-!
-INI = SIZE(PSNOWDZ(:,:),1)
-INLVLS = SIZE(PSNOWDZ(:,:),2)
-!
-ZSNOWRHO2 (:,:) = PSNOWRHO(:,:)
-ZSNOWDZ (:,:) = MAX(PSNOWDZMIN,PSNOWDZ(:,:))
-ZVISCOCITY(:,:) = 0.0
-ZTEMP (:,:) = 0.0
-!
-! 1. Cumulative snow mass (kg/m2):
-! --------------------------------
-!
-ZSMASS(:,:) = 0.0
-DO JJ=2,INLVLS
- DO JI=1,INI
- ZSMASS(JI,JJ) = ZSMASS(JI,JJ-1) + PSNOWDZ(JI,JJ-1)*PSNOWRHO(JI,JJ-1)
- ENDDO
-ENDDO
-! overburden of half the mass of the uppermost layer applied to itself
-ZSMASS(:,1) = 0.5 * PSNOWDZ(:,1) * PSNOWRHO(:,1)
-!
-! 2. Compaction
-! -------------
-!
-!Liquid water effect
-!
-ZWHOLDMAX(:,:) = SNOW3LHOLD(PSNOWRHO,PSNOWDZ)
-ZWHOLDMAX(:,:) = MAX(1.E-10, ZWHOLDMAX(:,:))
-ZF1(:,:) = 1.0/(XVVISC5+10.*MIN(1.0,PSNOWLIQ(:,:)/ZWHOLDMAX(:,:)))
-!
-!Snow viscocity, density and grid thicknesses
+CALL SNOW3LCOMPACTN(PTSTEP,XSNOWDZMIN,ZP_SNOWRHO,ZP_SNOWDZ,ZP_SNOWTEMP,ZP_SNOW,ZP_SNOWLIQ)
+
+! Snow thermal conductivity:
!
-DO JJ=1,INLVLS
- DO JI=1,INI
-!
- IF(PSNOWRHO(JI,JJ) < XRHOSMAX_ES)THEN
-!
-! temperature dependence limited to 10K: Schleef et al. (2014)
- ZTEMP (JI,JJ) = XVVISC4*MIN(10.,ABS(XTT-PSNOWTEMP(JI,JJ)))
-!
-! Calculate snow viscocity: Brun et al. (1989), Vionnet et al. (2012)
- ZVISCOCITY(JI,JJ) = XVVISC1*ZF1(JI,JJ)*EXP(XVVISC3*PSNOWRHO(JI,JJ)+ZTEMP(JI,JJ))*PSNOWRHO(JI,JJ)/XVRO11
-!
-! Calculate snow density:
- ZSNOWRHO2(JI,JJ) = PSNOWRHO(JI,JJ) + PSNOWRHO(JI,JJ)*PTSTEP &
- * ( (XG*ZSMASS(JI,JJ)/ZVISCOCITY(JI,JJ)) )
-!
-! Conserve mass by decreasing grid thicknesses in response to density increases
- PSNOWDZ(JI,JJ) = PSNOWDZ(JI,JJ)*(PSNOWRHO(JI,JJ)/ZSNOWRHO2(JI,JJ))
-!
- ENDIF
+CALL SNOW3LTHRM(ZP_SNOWRHO,ZP_SCOND,ZP_SNOWTEMP,ZP_PS)
!
- ENDDO
-ENDDO
-!
-! 3. Update total snow depth and density profile:
-! -----------------------------------------------
+!----------------------------------------------------------------
!
-! Compaction/augmentation of total snowpack depth
+! Unpack:
!
-PSNOW(:) = 0.
-DO JJ=1,INLVLS
- DO JI=1,INI
- PSNOW(JI) = PSNOW(JI) + PSNOWDZ(JI,JJ)
+DO JWRK=1,KSIZE2
+ DO JJ=1,KSIZE1
+ JI = KMASK(JJ)
+ PSNOWSWE (JI,JWRK) = ZP_SNOWSWE (JJ,JWRK)
+ PSNOWRHO (JI,JWRK) = ZP_SNOWRHO (JJ,JWRK)
+ PSNOWAGE (JI,JWRK) = ZP_SNOWAGE (JJ,JWRK)
+ PSNOWDZ (JI,JWRK) = ZP_SNOWDZ (JJ,JWRK)
+ PSNOWTEMP(JI,JWRK) = ZP_SNOWTEMP(JJ,JWRK)
+ PSNOWLIQ (JI,JWRK) = ZP_SNOWLIQ (JJ,JWRK)
+ PSCOND (JI,JWRK) = ZP_SCOND (JJ,JWRK)
+ PHEATCAPS(JI,JWRK) = ZP_HEATCAPS(JJ,JWRK)
ENDDO
ENDDO
!
-! Update density (kg m-3):
+END SUBROUTINE CALL_SNOW_ROUTINES
+!================================================================
!
-PSNOWRHO(:,:) = ZSNOWRHO2(:,:)
-!
-IF (LHOOK) CALL DR_HOOK('SNOW3LCOMPACTN',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE SNOW3LCOMPACTN
-!####################################################################
-
-
END SUBROUTINE PREPS_FOR_MEB_EBUD_RAD
diff --git a/src/SURFEX/pt_by_pt_treatment.F90 b/src/SURFEX/pt_by_pt_treatment.F90
index aab7b4f0dcf717360aa77f6ee698cb88818d93b7..351c6b3083d81b57f66ac28abe15ade4043e5e4c 100644
--- a/src/SURFEX/pt_by_pt_treatment.F90
+++ b/src/SURFEX/pt_by_pt_treatment.F90
@@ -3,8 +3,9 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PT_BY_PT_TREATMENT (USS, &
- KLUOUT,PLAT,PLON,PVALUE,HSUBROUTINE,KNBLINES,PNODATA)
+ SUBROUTINE PT_BY_PT_TREATMENT (UG, U, USS, &
+ KLUOUT,PLAT,PLON,PVALUE,HSUBROUTINE,&
+ KNBLINES,PNODATA,OMULTITYPE,KFACT)
! ###################################################################
!
!!**** *PT_BY_PT_TREATMENT*
@@ -41,9 +42,9 @@
!* 0. DECLARATION
! -----------
!
-!
-!
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODI_AVERAGE1_COVER
USE MODI_AVERAGE1_OROGRAPHY
@@ -61,7 +62,9 @@ IMPLICIT NONE
! ------------------------
!
!
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
INTEGER, INTENT(IN) :: KLUOUT
REAL,DIMENSION(:), INTENT(IN) :: PLAT
@@ -70,66 +73,75 @@ REAL,DIMENSION(:), INTENT(IN) :: PVALUE
CHARACTER(LEN=6), INTENT(IN) :: HSUBROUTINE ! Name of the subroutine to call
INTEGER, OPTIONAL, INTENT(IN) :: KNBLINES
REAL, OPTIONAL, INTENT(IN) :: PNODATA
+LOGICAL, OPTIONAL, INTENT(IN) :: OMULTITYPE
+INTEGER, OPTIONAL, INTENT(IN) :: KFACT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
!* 0.2 Declaration of local variables
! ------------------------------
!
+LOGICAL :: GMULTITYPE
+INTEGER :: ITYPE, IFACT
INTEGER :: INBLINES
!----------------------------------------------------------------------------
!
- IF (LHOOK) CALL DR_HOOK('PT_BY_PT_TREATMENT',0,ZHOOK_HANDLE)
- INBLINES = 1
- IF (PRESENT(KNBLINES)) INBLINES = KNBLINES
-
- SELECT CASE (HSUBROUTINE)
+IF (LHOOK) CALL DR_HOOK('PT_BY_PT_TREATMENT',0,ZHOOK_HANDLE)
+!
+INBLINES = 0
+IF (PRESENT(KNBLINES)) INBLINES = KNBLINES
+!
+GMULTITYPE = .FALSE.
+IF (PRESENT(OMULTITYPE)) GMULTITYPE = OMULTITYPE
+!
+IFACT = 1
+IF (PRESENT(KFACT)) IFACT = KFACT
+!
+SELECT CASE (HSUBROUTINE)
- CASE ('A_COVR')
- IF (PRESENT(PNODATA)) THEN
- CALL AVERAGE1_COVER(KLUOUT,INBLINES,PLAT,PLON,PVALUE,PNODATA)
- ELSE
- CALL AVERAGE1_COVER(KLUOUT,INBLINES,PLAT,PLON,PVALUE)
- ENDIF
+ CASE ('A_COVR')
+ IF (PRESENT(PNODATA)) THEN
+ CALL AVERAGE1_COVER(UG, U, KLUOUT,INBLINES,PLAT,PLON,PVALUE,PNODATA)
+ ELSE
+ CALL AVERAGE1_COVER(UG, U, KLUOUT,INBLINES,PLAT,PLON,PVALUE)
+ ENDIF
- CASE ('A_OROG')
- IF (PRESENT(PNODATA)) THEN
- CALL AVERAGE1_OROGRAPHY(USS, &
- KLUOUT,INBLINES,PLAT,PLON,PVALUE,PNODATA)
- ELSE
- CALL AVERAGE1_OROGRAPHY(USS, &
- KLUOUT,INBLINES,PLAT,PLON,PVALUE)
- ENDIF
+ CASE ('A_OROG')
+ IF (PRESENT(PNODATA)) THEN
+ CALL AVERAGE1_OROGRAPHY(UG, USS, KLUOUT,INBLINES,PLAT,PLON,PVALUE,PNODATA)
+ ELSE
+ CALL AVERAGE1_OROGRAPHY(UG, USS, KLUOUT,INBLINES,PLAT,PLON,PVALUE)
+ ENDIF
- CASE ('A_CTI ')
- IF (PRESENT(PNODATA)) THEN
- CALL AVERAGE1_CTI(KLUOUT,INBLINES,PLAT,PLON,PVALUE,PNODATA)
- ELSE
- CALL AVERAGE1_CTI(KLUOUT,INBLINES,PLAT,PLON,PVALUE)
- ENDIF
+ CASE ('A_CTI ')
+ IF (PRESENT(PNODATA)) THEN
+ CALL AVERAGE1_CTI(UG, KLUOUT,INBLINES,PLAT,PLON,PVALUE,PNODATA)
+ ELSE
+ CALL AVERAGE1_CTI(UG, KLUOUT,INBLINES,PLAT,PLON,PVALUE)
+ ENDIF
- CASE ('A_LDBD')
- IF (PRESENT(PNODATA)) THEN
- CALL AVERAGE1_LDB(KLUOUT,INBLINES,PLAT,PLON,PVALUE,'D',PNODATA)
- ELSE
- CALL AVERAGE1_LDB(KLUOUT,INBLINES,PLAT,PLON,PVALUE,'D')
- ENDIF
-
- CASE ('A_LDBS')
- IF (PRESENT(PNODATA)) THEN
- CALL AVERAGE1_LDB(KLUOUT,INBLINES,PLAT,PLON,PVALUE,'S',PNODATA)
- ELSE
- CALL AVERAGE1_LDB(KLUOUT,INBLINES,PLAT,PLON,PVALUE,'S')
- ENDIF
-
- CASE ('A_MESH')
- IF (PRESENT(PNODATA)) THEN
- CALL AVERAGE1_MESH(KLUOUT,INBLINES,PLAT,PLON,PVALUE,PNODATA)
- ELSE
- CALL AVERAGE1_MESH(KLUOUT,INBLINES,PLAT,PLON,PVALUE)
- ENDIF
-
- END SELECT
+ CASE ('A_LDBD')
+ IF (PRESENT(PNODATA)) THEN
+ CALL AVERAGE1_LDB(UG, KLUOUT,INBLINES,PLAT,PLON,PVALUE,'D',PNODATA)
+ ELSE
+ CALL AVERAGE1_LDB(UG, KLUOUT,INBLINES,PLAT,PLON,PVALUE,'D')
+ ENDIF
+
+ CASE ('A_LDBS')
+ IF (PRESENT(PNODATA)) THEN
+ CALL AVERAGE1_LDB(UG, KLUOUT,INBLINES,PLAT,PLON,PVALUE,'S',PNODATA)
+ ELSE
+ CALL AVERAGE1_LDB(UG, KLUOUT,INBLINES,PLAT,PLON,PVALUE,'S')
+ ENDIF
+
+ CASE ('A_MESH')
+ IF (PRESENT(PNODATA)) THEN
+ CALL AVERAGE1_MESH(UG, KLUOUT,INBLINES,PLAT,PLON,PVALUE,GMULTITYPE,IFACT,PNODATA)
+ ELSE
+ CALL AVERAGE1_MESH(UG,KLUOUT,INBLINES,PLAT,PLON,PVALUE,GMULTITYPE,IFACT)
+ ENDIF
+
+END SELECT
IF (LHOOK) CALL DR_HOOK('PT_BY_PT_TREATMENT',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/put_in_time.F90 b/src/SURFEX/put_in_time.F90
index 5f831ca60612bdc943b66f31aec6a6569724f89d..ab66d8a7a435ad3259185123697f399392600af6 100644
--- a/src/SURFEX/put_in_time.F90
+++ b/src/SURFEX/put_in_time.F90
@@ -11,14 +11,14 @@ USE MODI_ABOR1_SFX
IMPLICIT NONE
- CHARACTER(LEN=*), INTENT(IN) :: HNAME
- CHARACTER(LEN=3), INTENT(IN) :: HTYPE
+CHARACTER(LEN=*), INTENT(IN) :: HNAME
+CHARACTER(LEN=3), INTENT(IN) :: HTYPE
INTEGER, INTENT(IN) :: NTIME1
INTEGER, INTENT(IN) :: NTIME2
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDATA
- CHARACTER(LEN=2) :: YTIME1, YTIME2
+CHARACTER(LEN=2) :: YTIME1, YTIME2
INTEGER :: I1, I2, JJ, JTIME
REAL, DIMENSION(SIZE(PDATA,1),NTIME1,SIZE(PDATA,3)) :: ZDATA
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -36,20 +36,32 @@ ELSEIF (NTIME1==1) THEN
PDATA(:,JJ,:)=PDATA(:,1,:)
ENDDO
ELSEIF (NTIME1==2) THEN !2 values: winter and summer
- IF (NTIME2.NE.36) THEN
- CALL ABOR1_SFX('PUT_IN_TIME: WITH NTIME1=2, NTIME2 MUST BE =36 (WINTER AND SUMMER VALUES) '//&
- 'PROBLEM VAR '//HNAME//''//HTYPE)
+ IF (NTIME2.EQ.36) THEN
+ ZDATA=PDATA(:,1:2,:)
+ DO JJ=1,8
+ PDATA(:,JJ,:)=ZDATA(:,1,:) !until 20 march
+ ENDDO
+ DO JJ=9,26
+ PDATA(:,JJ,:)=ZDATA(:,2,:) !from 21 march to 20 september
+ ENDDO
+ DO JJ=27,36
+ PDATA(:,JJ,:)=ZDATA(:,1,:) !from 21 september to 31 december
+ ENDDO
+ ELSEIF (NTIME2.EQ.12) THEN
+ ZDATA=PDATA(:,1:2,:)
+ DO JJ=1,3
+ PDATA(:,JJ,:)=ZDATA(:,1,:) !until 20 march
+ ENDDO
+ DO JJ=4,9
+ PDATA(:,JJ,:)=ZDATA(:,2,:) !from 21 march to 20 september
+ ENDDO
+ DO JJ=10,12
+ PDATA(:,JJ,:)=ZDATA(:,1,:) !from 21 september to 31 december
+ ENDDO
+ ELSE
+ CALL ABOR1_SFX('PUT_IN_TIME: WITH NTIME1=2, NTIME2 MUST BE =36 OR =12 (WINTER AND SUMMER VALUES) '//&
+ 'PROBLEM VAR '//HNAME//''//HTYPE)
ENDIF
- ZDATA=PDATA(:,1:2,:)
- DO JJ=1,8
- PDATA(:,JJ,:)=ZDATA(:,1,:) !until 20 march
- ENDDO
- DO JJ=9,26
- PDATA(:,JJ,:)=ZDATA(:,2,:) !from 21 march to 20 september
- ENDDO
- DO JJ=27,36
- PDATA(:,JJ,:)=ZDATA(:,1,:) !from 21 september to 31 december
- ENDDO
ELSE
I1=NTIME2/NTIME1
I2=NTIME2/I1
diff --git a/src/SURFEX/put_pgd_grid.F90 b/src/SURFEX/put_pgd_grid.F90
index 1441745a3f698d8f91ca1bbd05dba409302e5388..5f27f8fe66f59bf04737cad67e0f70cccf789f2d 100644
--- a/src/SURFEX/put_pgd_grid.F90
+++ b/src/SURFEX/put_pgd_grid.F90
@@ -68,7 +68,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PUT_PGD_GRID',0,ZHOOK_HANDLE)
!
- CGRID = HGRID
+CGRID = HGRID
NL=KSIZE_FULL
NGRID_PAR=KGRID_PAR
ALLOCATE(XGRID_PAR(NGRID_PAR))
diff --git a/src/SURFEX/put_rad_sean.F90 b/src/SURFEX/put_rad_sean.F90
deleted file mode 100644
index 3463b00181b1b58244708c5d6b2f2e6b64edc26f..0000000000000000000000000000000000000000
--- a/src/SURFEX/put_rad_sean.F90
+++ /dev/null
@@ -1,11 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ######spl
- SUBROUTINE PUT_RAD_SEA_n
-! ###########################################################################
-!
-! A supprimer
-!
-END SUBROUTINE PUT_RAD_SEA_n
diff --git a/src/SURFEX/put_rad_watn.F90 b/src/SURFEX/put_rad_watn.F90
deleted file mode 100644
index e51bcaa46414e82bd9b87b89f221024b724bcca0..0000000000000000000000000000000000000000
--- a/src/SURFEX/put_rad_watn.F90
+++ /dev/null
@@ -1,13 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ######spl
- SUBROUTINE PUT_RAD_WAT_n
-! ##########################################################################
-!
-!A supprimer
-!
-!==============================================================================
-!
-END SUBROUTINE PUT_RAD_WAT_n
diff --git a/src/SURFEX/put_sfx_land.F90 b/src/SURFEX/put_sfx_land.F90
index a9ab49d5920a24d26eb6419b754ccc1916d57eec..feeb9f87f27053bac136b35930f3d7558cb2b5cd 100644
--- a/src/SURFEX/put_sfx_land.F90
+++ b/src/SURFEX/put_sfx_land.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PUT_SFX_LAND (I, U, &
+ SUBROUTINE PUT_SFX_LAND (IO, S, K, NK, NP, U, &
KLUOUT,OCPL_WTD,OCPL_FLOOD, &
PWTD,PFWTD,PFFLOOD,PPIFLOOD )
! #####################################################
@@ -33,17 +33,19 @@
!! MODIFICATIONS
!! -------------
!! Original 08/2009
-!!
!! B. Decharme 01/16 : Bug with flood budget
+!! 10/2016 B. Decharme : bug surface/groundwater coupling
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_NK_t, ISBA_NP_t, ISBA_P_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODN_SFX_OASIS, ONLY : XFLOOD_LIM
!
USE MODI_PACK_SAME_RANK
!
@@ -55,8 +57,11 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_NK_t), INTENT(INOUT) :: NK
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
INTEGER, INTENT(IN) :: KLUOUT
@@ -71,7 +76,11 @@ REAL, DIMENSION(:), INTENT(IN) :: PPIFLOOD ! Potential floodplain infiltration (
!* 0.2 Declarations of local variables
! -------------------------------
!
- CHARACTER(LEN=50) :: YCOMMENT
+TYPE(ISBA_P_t), POINTER :: PK
+TYPE(ISBA_K_t), POINTER :: KK
+!
+INTEGER :: JP
+CHARACTER(LEN=50) :: YCOMMENT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -92,43 +101,63 @@ ENDIF
!
IF(OCPL_WTD)THEN
!
- I%XWTD (:) = XUNDEF
- I%XFWTD (:) = XUNDEF
+ K%XWTD (:) = XUNDEF
+ K%XFWTD (:) = XUNDEF
!
YCOMMENT='water table depth'
- CALL PACK_SAME_RANK(U%NR_NATURE(:),PWTD(:),I%XWTD(:))
- CALL CHECK_LAND(YCOMMENT,I%XWTD)
+ CALL PACK_SAME_RANK(U%NR_NATURE(:),PWTD(:),K%XWTD(:))
+ CALL CHECK_LAND(YCOMMENT,K%XWTD)
!
YCOMMENT='fraction of water table rise'
- CALL PACK_SAME_RANK(U%NR_NATURE(:),PFWTD(:),I%XFWTD(:))
- CALL CHECK_LAND(YCOMMENT,I%XFWTD)
+ CALL PACK_SAME_RANK(U%NR_NATURE(:),PFWTD(:),K%XFWTD(:))
+ CALL CHECK_LAND(YCOMMENT,K%XFWTD)
!
- WHERE(I%XGW(:)==0.0)
- I%XWTD (:) = XUNDEF
- I%XFWTD (:) = 0.0
+ WHERE(K%XFWTD(:)==0.0)
+ K%XWTD (:) = XUNDEF
ENDWHERE
!
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ KK => NK%AL(JP)
+ CALL PACK_SAME_RANK(PK%NR_P,K%XWTD,KK%XWTD)
+ CALL PACK_SAME_RANK(PK%NR_P,K%XFWTD,KK%XFWTD)
+ ENDDO
+!
ENDIF
!
IF(OCPL_FLOOD)THEN
!
- I%XFFLOOD (:) = XUNDEF
- I%XPIFLOOD(:) = XUNDEF
+ K%XFFLOOD (:) = XUNDEF
+ K%XPIFLOOD(:) = XUNDEF
!
YCOMMENT='Flood fraction'
- CALL PACK_SAME_RANK(U%NR_NATURE(:),PFFLOOD(:),I%XFFLOOD(:))
- CALL CHECK_LAND(YCOMMENT,I%XFFLOOD)
+ CALL PACK_SAME_RANK(U%NR_NATURE(:),PFFLOOD(:),K%XFFLOOD(:))
+ CALL CHECK_LAND(YCOMMENT,K%XFFLOOD)
!
YCOMMENT='Potential flood infiltration'
- CALL PACK_SAME_RANK(U%NR_NATURE(:),PPIFLOOD(:),I%XPIFLOOD(:))
- CALL CHECK_LAND(YCOMMENT,I%XPIFLOOD)
+ CALL PACK_SAME_RANK(U%NR_NATURE(:),PPIFLOOD(:),K%XPIFLOOD(:))
+ CALL CHECK_LAND(YCOMMENT,K%XPIFLOOD)
+!
+! No flood for very smal flooded area (default 1%)
+!
+ WHERE(K%XFFLOOD (:)<XFLOOD_LIM)
+ K%XFFLOOD (:)=0.0
+ K%XPIFLOOD(:)=0.0
+ ENDWHERE
+!
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ KK => NK%AL(JP)
+ CALL PACK_SAME_RANK(PK%NR_P,K%XFFLOOD,KK%XFFLOOD)
+ CALL PACK_SAME_RANK(PK%NR_P,K%XPIFLOOD,KK%XPIFLOOD)
+ ENDDO
!
ENDIF
!
IF (LHOOK) CALL DR_HOOK('PUT_SFX_LAND',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
!
SUBROUTINE CHECK_LAND(HCOMMENT,PFIELD)
@@ -137,7 +166,7 @@ USE MODI_ABOR1_SFX
!
IMPLICIT NONE
!
- CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT
+CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT
REAL, DIMENSION(:), INTENT(IN) :: PFIELD
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
diff --git a/src/SURFEX/put_sfx_sea.F90 b/src/SURFEX/put_sfx_sea.F90
index 850cfcd27e23482c7eaaff63e5454082a3621127..d08c045811f619cc0f93ac657ebcc198173dfbe6 100644
--- a/src/SURFEX/put_sfx_sea.F90
+++ b/src/SURFEX/put_sfx_sea.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE PUT_SFX_SEA (S, U, W, &
- KLUOUT,OCPL_SEAICE,OWATER,PSEA_SST,PSEA_UCU, &
+ SUBROUTINE PUT_SFX_SEA (S, U, W, KLUOUT,OCPL_SEAICE,OWATER,PSEA_SST,PSEA_UCU, &
PSEA_VCU,PSEAICE_SIT,PSEAICE_CVR,PSEAICE_ALB )
! ####################################################
!
@@ -79,7 +78,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PSEAICE_ALB
! -------------------------------
!
!
- CHARACTER(LEN=50) :: YCOMMENT
+CHARACTER(LEN=50) :: YCOMMENT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -112,7 +111,7 @@ ENDIF
IF (LHOOK) CALL DR_HOOK('PUT_SFX_SEA',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
!
SUBROUTINE TREAT_SEA(KLU)
@@ -127,16 +126,16 @@ REAL, DIMENSION(KLU) :: ZSST ! sea surface temperature
REAL, DIMENSION(KLU) :: ZICE_FRAC! ice fraction
REAL :: ZTMIN ! Minimum temperature over this proc
REAL :: ZTMAX ! Maximum temperature over this proc
- CHARACTER(LEN=50) :: YCOMMENT
+CHARACTER(LEN=50) :: YCOMMENT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PUT_SFX_SEA:TREAT_SEA',0,ZHOOK_HANDLE)
!
YCOMMENT='Sea surface temperature'
- CALL PACK_SAME_RANK(U%NR_SEA(:),PSEA_SST(:),ZSST(:))
+CALL PACK_SAME_RANK(U%NR_SEA(:),PSEA_SST(:),ZSST(:))
WHERE (ZSST(:)/=0.0) S%XSST(:)=ZSST(:)
- CALL CHECK_SEA(YCOMMENT,S%XSST(:))
+CALL CHECK_SEA(YCOMMENT,S%XSST(:))
!
ZTMIN=MINVAL(S%XSST(:))
ZTMAX=MAXVAL(S%XSST(:))
@@ -152,12 +151,12 @@ IF(ZTMIN<=0.0.OR.ZTMAX>500.)THEN
ENDIF
!
YCOMMENT='Sea u-current stress'
- CALL PACK_SAME_RANK(U%NR_SEA(:),PSEA_UCU(:),S%XUMER(:))
- CALL CHECK_SEA(YCOMMENT,S%XUMER(:))
+CALL PACK_SAME_RANK(U%NR_SEA(:),PSEA_UCU(:),S%XUMER(:))
+CALL CHECK_SEA(YCOMMENT,S%XUMER(:))
!
YCOMMENT='Sea v-current stress'
- CALL PACK_SAME_RANK(U%NR_SEA(:),PSEA_VCU(:),S%XVMER(:))
- CALL CHECK_SEA(YCOMMENT,S%XVMER(:))
+CALL PACK_SAME_RANK(U%NR_SEA(:),PSEA_VCU(:),S%XVMER(:))
+CALL CHECK_SEA(YCOMMENT,S%XVMER(:))
!
IF(OCPL_SEAICE)THEN
!
@@ -204,15 +203,15 @@ INTEGER, INTENT(IN) :: KLU
REAL, DIMENSION(KLU) :: ZICE_FRAC! ice fraction
REAL :: ZTMIN ! Minimum temperature over this proc
REAL :: ZTMAX ! Maximum temperature over this proc
- CHARACTER(LEN=50) :: YCOMMENT
+CHARACTER(LEN=50) :: YCOMMENT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PUT_SFX_SEA:TREAT_WATER',0,ZHOOK_HANDLE)
!
YCOMMENT='Water surface temperature'
- CALL PACK_SAME_RANK(U%NR_WATER(:),PSEA_SST(:),W%XTS(:))
- CALL CHECK_SEA(YCOMMENT,W%XTS(:))
+CALL PACK_SAME_RANK(U%NR_WATER(:),PSEA_SST(:),W%XTS(:))
+CALL CHECK_SEA(YCOMMENT,W%XTS(:))
!
ZTMIN=MINVAL(W%XTS(:))
ZTMAX=MAXVAL(W%XTS(:))
@@ -228,12 +227,12 @@ IF(ZTMIN<=0.0.OR.ZTMAX>500.)THEN
ENDIF
!
YCOMMENT='Water-ice Temperature'
- CALL PACK_SAME_RANK(U%NR_WATER(:),PSEAICE_SIT(:),W%XTICE(:))
- CALL CHECK_SEA(YCOMMENT,W%XTICE(:))
+CALL PACK_SAME_RANK(U%NR_WATER(:),PSEAICE_SIT(:),W%XTICE(:))
+CALL CHECK_SEA(YCOMMENT,W%XTICE(:))
!
YCOMMENT='Water-ice cover'
- CALL PACK_SAME_RANK(U%NR_WATER(:),PSEAICE_CVR(:),ZICE_FRAC(:))
- CALL CHECK_SEA(YCOMMENT,ZICE_FRAC(:))
+CALL PACK_SAME_RANK(U%NR_WATER(:),PSEAICE_CVR(:),ZICE_FRAC(:))
+CALL CHECK_SEA(YCOMMENT,ZICE_FRAC(:))
!
WHERE(ZICE_FRAC(:)>=XICEC)
W%XTS(:) = MIN(W%XTS(:),XTT-0.01)
@@ -242,8 +241,8 @@ ELSEWHERE
ENDWHERE
!
YCOMMENT='Water-ice albedo'
- CALL PACK_SAME_RANK(U%NR_WATER(:),PSEAICE_ALB(:),W%XICE_ALB(:))
- CALL CHECK_SEA(YCOMMENT,W%XICE_ALB(:))
+CALL PACK_SAME_RANK(U%NR_WATER(:),PSEAICE_ALB(:),W%XICE_ALB(:))
+CALL CHECK_SEA(YCOMMENT,W%XICE_ALB(:))
!
! Fill the table with sea ice albedo where temperature is lower than the freezing
! point
@@ -262,7 +261,7 @@ SUBROUTINE CHECK_SEA(HCOMMENT,PFIELD)
!
IMPLICIT NONE
!
- CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT
+CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT
REAL, DIMENSION(:), INTENT(IN) :: PFIELD
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
diff --git a/src/SURFEX/put_sfxcpln.F90 b/src/SURFEX/put_sfxcpln.F90
index cea9350824969555ffc2291cce14a31c691d4c8e..3f24c258a1f265d76ee63e099544b313f1a219c4 100644
--- a/src/SURFEX/put_sfxcpln.F90
+++ b/src/SURFEX/put_sfxcpln.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE PUT_SFXCPL_n (F, I, S, U, W, &
+SUBROUTINE PUT_SFXCPL_n (F, IM, S, U, W, &
HPROGRAM,KI,KSW,PSW_BANDS,PZENITH, &
PLAND_WTD,PLAND_FWTD,PLAND_FFLOOD, &
PLAND_PIFLOOD,PSEA_SST,PSEA_UCU, &
@@ -45,14 +45,8 @@ SUBROUTINE PUT_SFXCPL_n (F, I, S, U, W, &
!* 0. DECLARATIONS
! ------------
!
-!
-!
-!
-!
-!
-!
USE MODD_FLAKE_n, ONLY : FLAKE_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_WATFLUX_n, ONLY : WATFLUX_t
@@ -81,12 +75,12 @@ IMPLICIT NONE
!
!
TYPE(FLAKE_t), INTENT(INOUT) :: F
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(WATFLUX_t), INTENT(INOUT) :: W
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
INTEGER, INTENT(IN) :: KI ! number of points
INTEGER, INTENT(IN) :: KSW ! number of bands
!
@@ -123,7 +117,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('PUT_SFXCL_N',0,ZHOOK_HANDLE)
!
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
+CALL GET_LUOUT(HPROGRAM,ILUOUT)
!-------------------------------------------------------------------------------
!
! Global argument
@@ -139,9 +133,8 @@ ENDIF
!-------------------------------------------------------------------------------
!
IF(LCPL_LAND)THEN
- CALL PUT_SFX_LAND(I, U, &
- ILUOUT,LCPL_GW,LCPL_FLOOD,PLAND_WTD(:), &
- PLAND_FWTD(:),PLAND_FFLOOD(:),PLAND_PIFLOOD(:))
+ CALL PUT_SFX_LAND(IM%O, IM%S, IM%K, IM%NK, IM%NP, U, ILUOUT, LCPL_GW, LCPL_FLOOD, &
+ PLAND_WTD(:), PLAND_FWTD(:),PLAND_FFLOOD(:),PLAND_PIFLOOD(:))
ENDIF
!
!-------------------------------------------------------------------------------
@@ -150,8 +143,7 @@ ENDIF
!
IF(LCPL_SEA)THEN
!
- CALL PUT_SFX_SEA(S, U, W, &
- ILUOUT,LCPL_SEAICE,LWATER,PSEA_SST(:),PSEA_UCU(:), &
+ CALL PUT_SFX_SEA(S, U, W, ILUOUT,LCPL_SEAICE,LWATER,PSEA_SST(:),PSEA_UCU(:), &
PSEA_VCU(:),PSEAICE_SIT(:),PSEAICE_CVR(:),PSEAICE_ALB(:) )
!
ENDIF
@@ -161,8 +153,7 @@ ENDIF
!-------------------------------------------------------------------------------
!
IF(LCPL_SEA.OR.LCPL_FLOOD)THEN
- CALL UPDATE_ESM_SURF_ATM_n(F, I, S, U, W, &
- HPROGRAM, KI, KSW, PZENITH, PSW_BANDS, &
+ CALL UPDATE_ESM_SURF_ATM_n(F, IM, S, U, W, HPROGRAM, KI, KSW, PZENITH, PSW_BANDS, &
PTSRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF )
ENDIF
!
diff --git a/src/SURFEX/put_zs_inland_watern.F90 b/src/SURFEX/put_zs_inland_watern.F90
index cbd2f720add269bdc8a8b4242349a030e573db93..4b740bbc919e2e8243ba3ce955ae87c759eb0457 100644
--- a/src/SURFEX/put_zs_inland_watern.F90
+++ b/src/SURFEX/put_zs_inland_watern.F90
@@ -80,7 +80,7 @@ ELSE
END IF
!
IF (LHOOK) CALL DR_HOOK('PUT_ZS_INLAND_WATER_N',1,ZHOOK_HANDLE)
- CONTAINS
+CONTAINS
!
!------------------------------------------------------------------------------
!------------------------------------------------------------------------------
diff --git a/src/SURFEX/put_zs_naturen.F90 b/src/SURFEX/put_zs_naturen.F90
index e0f396737b3ac1578ae48f7f891e73e7dd1b6f6d..ef52fef5019e47b025b5202ec519fce84168a1a6 100644
--- a/src/SURFEX/put_zs_naturen.F90
+++ b/src/SURFEX/put_zs_naturen.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###########################################
- SUBROUTINE PUT_ZS_NATURE_n (I, &
- HPROGRAM,KI,PZS)
+ SUBROUTINE PUT_ZS_NATURE_n (S, HPROGRAM,KI,PZS)
! ###########################################
!
!!**** *PUT_ZS_SURF_ATM_n* - routine to modify nature oropgraphy using atmospheric
@@ -40,7 +39,7 @@
! ------------
!
!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t
!
USE MODI_GET_LUOUT
!
@@ -57,7 +56,7 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
INTEGER, INTENT(IN) :: KI ! horizontal dim. of cover
@@ -75,13 +74,13 @@ IF (LHOOK) CALL DR_HOOK('PUT_ZS_NATURE_N',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!-------------------------------------------------------------------------------
!
-IF ( SIZE(PZS) /= SIZE(I%XZS) ) THEN
+IF ( SIZE(PZS) /= SIZE(S%XZS) ) THEN
WRITE(ILUOUT,*) 'try to get ZS field from atmospheric model, but size is not correct'
WRITE(ILUOUT,*) 'size of field expected by the atmospheric model (PZS) :', SIZE(PZS)
- WRITE(ILUOUT,*) 'size of field over nature (XZS) :', SIZE(I%XZS)
+ WRITE(ILUOUT,*) 'size of field over nature (XZS) :', SIZE(S%XZS)
CALL ABOR1_SFX('PUT_ZS_NATUREN: GET ZS FROM ATMOSPHERIC MODEL: SIZE NOT CORRECT')
ELSE
- I%XZS = PZS
+ S%XZS = PZS
END IF
IF (LHOOK) CALL DR_HOOK('PUT_ZS_NATURE_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/put_zsn.F90 b/src/SURFEX/put_zsn.F90
index 15e7aa5c52cfb915d73b1c80895b0fca62cc7ccc..035e23cf58c20a7b774984afbe2cd5ce2e4d2ce1 100644
--- a/src/SURFEX/put_zsn.F90
+++ b/src/SURFEX/put_zsn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ########################################
- SUBROUTINE PUT_ZS_n (F, I, S, U, TOP, W, &
- HPROGRAM,KI,PZS)
+ SUBROUTINE PUT_ZS_n (F, IS, S, U, TOP, W, HPROGRAM,KI,PZS)
! ########################################
!
!!**** *PUT_ZS_n* - routine to modify surface oropgraphy of each tile using atmospheric
@@ -36,19 +35,12 @@
!! Original 01/2004
!! P. Le Moigne 05/2007: write model orography over each tile
!-------------------------------------------------------------------------------
-!
-!
-!
-!
-!
!
!* 0. DECLARATIONS
! ------------
!
-!
-!
USE MODD_FLAKE_n, ONLY : FLAKE_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
@@ -76,7 +68,7 @@ IMPLICIT NONE
!
!
TYPE(FLAKE_t), INTENT(INOUT) :: F
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_S_t), INTENT(INOUT) :: IS
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
@@ -98,8 +90,7 @@ IF (LHOOK) CALL DR_HOOK('PUT_ZS_N',0,ZHOOK_HANDLE)
!* 1. Full surface
! ------------
!
- CALL PUT_ZS_SURF_ATM_n(U, &
- HPROGRAM,KI,PZS)
+ CALL PUT_ZS_SURF_ATM_n(U, HPROGRAM,KI,PZS)
!
!* 2. inland water
! ------------
@@ -123,7 +114,7 @@ IF (U%NSIZE_SEA > 0 .AND. U%CSEA/='NONE' .AND. U%CSEA/='FLUX') CALL PACK_ZS(U%NS
!
IF (LHOOK) CALL DR_HOOK('PUT_ZS_N',1,ZHOOK_HANDLE)
!
- CONTAINS
+CONTAINS
!=======================================================================================
SUBROUTINE PACK_ZS(KSIZE,KMASK,YTYPE)
!
@@ -132,7 +123,7 @@ INTEGER, POINTER, DIMENSION(:) :: KMASK
CHARACTER(LEN=1), INTENT(IN) :: YTYPE
!
REAL, DIMENSION(KSIZE) :: ZP_ZS
-INTEGER :: JJ
+INTEGER :: JJ, ISIZE_FULL
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
! input arguments:
@@ -142,8 +133,8 @@ IF (LHOOK) CALL DR_HOOK('PUT_ZS_N:PACK_ZS',0,ZHOOK_HANDLE)
IF (.NOT.ASSOCIATED(KMASK)) THEN
ALLOCATE(KMASK (KSIZE))
IF (KSIZE>0) THEN
- CALL GET_SIZE_FULL_n(U, &
- HPROGRAM,U%NDIM_FULL,U%NSIZE_FULL)
+ CALL GET_SIZE_FULL_n(HPROGRAM,U%NDIM_FULL,U%NSIZE_FULL,ISIZE_FULL)
+ U%NSIZE_FULL = ISIZE_FULL
IF (YTYPE=='W') THEN
CALL GET_1D_MASK( KSIZE, U%NSIZE_FULL, U%XWATER, KMASK)
ELSEIF (YTYPE=='N') THEN
@@ -161,17 +152,13 @@ DO JJ=1,KSIZE
ENDDO
!
IF (YTYPE=='W') THEN
- CALL PUT_ZS_INLAND_WATER_n(F, W, &
- HPROGRAM,KSIZE,ZP_ZS,U%CWATER)
+ CALL PUT_ZS_INLAND_WATER_n(F, W, HPROGRAM,KSIZE,ZP_ZS,U%CWATER)
ELSEIF (YTYPE=='N') THEN
- CALL PUT_ZS_NATURE_n(I, &
- HPROGRAM,KSIZE,ZP_ZS)
+ CALL PUT_ZS_NATURE_n(IS, HPROGRAM,KSIZE,ZP_ZS)
ELSEIF (YTYPE=='T') THEN
- CALL PUT_ZS_TOWN_n(TOP, &
- HPROGRAM,KSIZE,ZP_ZS)
+ CALL PUT_ZS_TOWN_n(TOP, HPROGRAM,KSIZE,ZP_ZS)
ELSEIF (YTYPE=='S') THEN
- CALL PUT_ZS_SEA_n(S, &
- HPROGRAM,KSIZE,ZP_ZS)
+ CALL PUT_ZS_SEA_n(S, HPROGRAM,KSIZE,ZP_ZS)
ENDIF
!
IF (LHOOK) CALL DR_HOOK('PUT_ZS_N:PACK_ZS',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/radiative_transfert.F90 b/src/SURFEX/radiative_transfert.F90
index 07c3577cad38a7763453cc1154237a48a9470f13..045bac07bbe786b7fc8ba2f9bd43b52b8b0c59cd 100644
--- a/src/SURFEX/radiative_transfert.F90
+++ b/src/SURFEX/radiative_transfert.F90
@@ -61,10 +61,12 @@ USE MODD_CSTS, ONLY : XI0 ! Solar constan
USE MODD_CO2V_PAR, ONLY : XPARCF, XLAI_SHADE, &
XXB_SUP, XXB_INF, & ! sigma parameter in clumping (Table 1, eq4)
XSSA_SUP, XSSA_INF, & ! single scatering albedo (PAR)
- XSSA_SUP_PIR, XSSA_INF_PIR ! single scatering albedo (NIR)
+ XSSA_SUP_PIR, XSSA_INF_PIR, & ! single scatering albedo (NIR)
+ ITRANSFERT_ESG
!
USE MODD_DATA_COVER_PAR, ONLY : NVT_C3, NVT_C4, &
- NVT_IRR, NVT_GRAS
+ NVT_IRR, NVT_GRAS, &
+ NVT_C3W, NVT_C3S, NVEGTYPE, NVEGTYPE_ECOSG
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
@@ -117,11 +119,11 @@ REAL, DIMENSION(:), INTENT(OUT) :: PFAPAR, PFAPIR, PFAPAR_BS, PFAPIR_BS
!* 0.2 declarations of local variables
!
!
-REAL, DIMENSION(SIZE(PLAI)) :: ZIA, ZLAI, ZLAI_EFF, ZXMUS, ZFD_SKY
+REAL, DIMENSION(SIZE(PLAI)) :: ZIA, ZLAI, ZLAI_EFF, ZXMUS, ZFD_SKY
! ZXMUS = cosine of solar zenith angle
! ZFD_SKY = fraction of diffuse radiation in sky
REAL, DIMENSION(SIZE(PLAI)) :: ZB_INF, ZB_SUP
-INTEGER, DIMENSION(1) :: IDMAX
+INTEGER, DIMENSION(1) :: IDMAX, IDMAX2
REAL :: ZTAU, ZRATIO
! ZTAU = exp(-aerosol optical depth taken as 0.1)
! ZRATIO = clearness index K_t eq.1 from Carrer et al
@@ -142,11 +144,14 @@ WHERE (PLAI(:)==XUNDEF) ZLAI(:) = 0.0
OSHADE(:)= .TRUE.
DO JJ = 1, SIZE(PLAI)
! CD value calculated for patch with largest fraction ?
- IDMAX = MAXLOC(PVEGTYPE(JJ,:))
- IF(OAGRI_TO_GRASS.AND.(IDMAX(1)==NVT_C3.OR.IDMAX(1)==NVT_C4.OR.IDMAX(1)==NVT_IRR))IDMAX(1)=NVT_GRAS
- IF (PLAI(JJ).LT.XLAI_SHADE(IDMAX(1))) OSHADE(JJ) = .FALSE.
- ZB_INF(JJ) = XXB_INF(IDMAX(1))
- ZB_SUP(JJ) = XXB_SUP(IDMAX(1))
+ IDMAX = MAXLOC(PVEGTYPE(JJ,:))
+ IF(OAGRI_TO_GRASS.AND. (IDMAX(1)==NVT_C3 .OR. IDMAX(1)==NVT_C3W .OR. &
+ IDMAX(1)==NVT_C3S .OR. IDMAX(1)==NVT_C4 .OR. IDMAX(1)==NVT_IRR)) IDMAX(1) = NVT_GRAS
+ IDMAX2(1) = IDMAX(1)
+ IF (NVEGTYPE==NVEGTYPE_ECOSG) IDMAX2(1) = ITRANSFERT_ESG(IDMAX(1))
+ IF (PLAI(JJ).LT.XLAI_SHADE(IDMAX2(1))) OSHADE(JJ) = .FALSE.
+ ZB_INF(JJ) = XXB_INF(IDMAX2(1))
+ ZB_SUP(JJ) = XXB_SUP(IDMAX2(1))
ENDDO
!
!to consider all the tickness of the canopy
diff --git a/src/SURFEX/read_all_namelists.F90 b/src/SURFEX/read_all_namelists.F90
index 55945d1870ef4ae9e1e97bafa5f8f2ee59030d40..e1f0a10fb7079983979b8810230a3da4d632b29b 100644
--- a/src/SURFEX/read_all_namelists.F90
+++ b/src/SURFEX/read_all_namelists.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE READ_ALL_NAMELISTS (YSC, &
- HPROGRAM,HINIT,ONAM_READ)
+SUBROUTINE READ_ALL_NAMELISTS (YSC, HPROGRAM,HINIT,ONAM_READ)
!
!
!
@@ -28,6 +27,9 @@ USE MODI_READ_NAMELISTS_SLT
USE MODI_READ_NAMELISTS_DST
USE MODI_READ_NAMELISTS_ASSIM
USE MODI_READ_NAMELISTS_TOPD
+#ifdef SFX_ARO
+USE MODI_READ_NAMELISTS_IO
+#endif
!
USE MODI_READ_NAM_PREP_FLAKE_n
USE MODI_READ_NAM_PREP_GARDEN_n
@@ -46,7 +48,6 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
-!
TYPE(SURFEX_t), INTENT(INOUT) :: YSC
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
@@ -85,21 +86,14 @@ IF (.NOT.LNAM_READ) THEN
!
LNAM_READ=.TRUE.
!
- CALL READ_NAMELISTS_SURF_n(YSC%CHU, YSC%DGU, YSC%USS, &
- HPROGRAM,HINIT)
+ CALL READ_NAMELISTS_SURF_n(YSC%CHU, YSC%DUO, YSC%USS, HPROGRAM,HINIT)
!
- CALL READ_NAMELISTS_FLAKE_n(YSC%FM, &
- HPROGRAM,HINIT)
- CALL READ_NAMELISTS_WATFLUX_n(YSC%WM, &
- HPROGRAM,HINIT)
- CALL READ_NAMELISTS_SEAFLUX_n(YSC%SM, &
- HPROGRAM,HINIT)
- CALL READ_NAMELISTS_ISBA_n(YSC%IM, &
- HPROGRAM,HINIT)
- CALL READ_NAMELISTS_TEB_n(YSC%TM, YSC%GRM%TGRO, YSC%GDM%TVG, &
- HPROGRAM,HINIT)
- CALL READ_NAMELISTS_IDEAL_n(YSC%DGL, &
- HPROGRAM)
+ CALL READ_NAMELISTS_FLAKE_n(YSC%FM, HPROGRAM,HINIT)
+ CALL READ_NAMELISTS_WATFLUX_n(YSC%WM, HPROGRAM,HINIT)
+ CALL READ_NAMELISTS_SEAFLUX_n(YSC%SM, HPROGRAM,HINIT)
+ CALL READ_NAMELISTS_ISBA_n(YSC%IM, HPROGRAM,HINIT)
+ CALL READ_NAMELISTS_TEB_n(YSC%TM, YSC%GRM%O, YSC%GDM%O, HPROGRAM, HINIT)
+ CALL READ_NAMELISTS_IDEAL_n(YSC%DLO, HPROGRAM)
!
LNAM_READ=.FALSE.
!
diff --git a/src/SURFEX/read_and_send_mpi.F90 b/src/SURFEX/read_and_send_mpi.F90
index bb4545e7c46ccf8b933732cffb2c91b6e321a693..8d3275736d26d4e3e10654fa8f7e3ce47b63decb 100644
--- a/src/SURFEX/read_and_send_mpi.F90
+++ b/src/SURFEX/read_and_send_mpi.F90
@@ -2,23 +2,18 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
-!----------------------------------------------------
-!! MODIFICATIONS
-!! -------------
-!! Original
-!! J.Escobar 10/06/2013: replace DOUBLE PRECISION by REAL to handle problem for promotion of real on IBM SP
-!----------------------------------------------------
-!
MODULE MODI_READ_AND_SEND_MPI
!
INTERFACE READ_AND_SEND_MPI
!
-SUBROUTINE READ_AND_SEND_MPI_N1D(KWORK,KWORK2,KMASK)
+SUBROUTINE READ_AND_SEND_MPI_N1D(KWORK,KWORK2,KMASK,KPIO,KDX)
!
INTEGER, DIMENSION(:), INTENT(IN) :: KWORK
INTEGER, DIMENSION(:), INTENT(OUT) :: KWORK2
!
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
+INTEGER, INTENT(IN), OPTIONAL :: KPIO
+INTEGER, INTENT(IN), OPTIONAL :: KDX
!
END SUBROUTINE READ_AND_SEND_MPI_N1D
!
@@ -31,30 +26,47 @@ INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
END SUBROUTINE READ_AND_SEND_MPI_N2D
!
-SUBROUTINE READ_AND_SEND_MPI_X1D(PWORK,PWORK2,KMASK)
+SUBROUTINE READ_AND_SEND_MPI_N3D(KWORK,KWORK2,KMASK,KPIO,KDX)
+!
+INTEGER, DIMENSION(:,:,:), INTENT(IN) :: KWORK
+INTEGER, DIMENSION(:,:,:), INTENT(OUT) :: KWORK2
+!
+INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
+INTEGER, INTENT(IN), OPTIONAL :: KPIO
+INTEGER, INTENT(IN), OPTIONAL :: KDX
+!
+END SUBROUTINE READ_AND_SEND_MPI_N3D
+!
+SUBROUTINE READ_AND_SEND_MPI_X1D(PWORK,PWORK2,KMASK,KPIO,KDX)
!
REAL, DIMENSION(:), INTENT(IN) :: PWORK
REAL, DIMENSION(:), INTENT(OUT) :: PWORK2
!
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
+INTEGER, INTENT(IN), OPTIONAL :: KPIO
+INTEGER, INTENT(IN), OPTIONAL :: KDX
!
END SUBROUTINE READ_AND_SEND_MPI_X1D
!
-SUBROUTINE READ_AND_SEND_MPI_X2D(PWORK,PWORK2,KMASK)
+SUBROUTINE READ_AND_SEND_MPI_X2D(PWORK,PWORK2,KMASK,KPIO,KDX)
!
REAL, DIMENSION(:,:), INTENT(IN) :: PWORK
REAL, DIMENSION(:,:), INTENT(OUT) :: PWORK2
!
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
+INTEGER, INTENT(IN), OPTIONAL :: KPIO
+INTEGER, INTENT(IN), OPTIONAL :: KDX
!
END SUBROUTINE READ_AND_SEND_MPI_X2D
!
-SUBROUTINE READ_AND_SEND_MPI_X3D(PWORK,PWORK2,KMASK)
+SUBROUTINE READ_AND_SEND_MPI_X3D(PWORK,PWORK2,KMASK,KPIO,KDX)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PWORK
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWORK2
!
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
+INTEGER, INTENT(IN), OPTIONAL :: KPIO
+INTEGER, INTENT(IN), OPTIONAL :: KDX
!
END SUBROUTINE READ_AND_SEND_MPI_X3D
!
@@ -62,11 +74,10 @@ END INTERFACE
!
END MODULE MODI_READ_AND_SEND_MPI
!
-SUBROUTINE READ_AND_SEND_MPI_N1D(KWORK,KWORK2,KMASK)
+SUBROUTINE READ_AND_SEND_MPI_N1D(KWORK,KWORK2,KMASK,KPIO,KDX)
!
-USE MODD_SURFEX_MPI, ONLY : NINDEX, NPROC, NRANK, NCOMM, NPIO, NSIZE, &
+USE MODD_SURFEX_MPI, ONLY : NINDEX, NPROC, NRANK, NCOMM, NPIO, NSIZE, NREQ, &
XTIME_NPIO_READ, XTIME_COMM_READ, IDX_R, WLOG_MPI
-USE MODD_SURFEX_OMP, ONLY : NINDX1SFX, NINDX2SFX, NWORK, NBLOCK
!
USE MODI_PACK_SAME_RANK
!
@@ -83,86 +94,125 @@ INTEGER, DIMENSION(:), INTENT(IN) :: KWORK
INTEGER, DIMENSION(:), INTENT(OUT) :: KWORK2
!
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
+INTEGER, INTENT(IN), OPTIONAL :: KPIO
+INTEGER, INTENT(IN), OPTIONAL :: KDX
!
+INTEGER, DIMENSION(NSIZE,NPROC) :: IWORKS
+INTEGER, DIMENSION(NSIZE) :: IWORKR
#ifdef SFX_MPI
INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+INTEGER, DIMENSION(MPI_STATUS_SIZE,NPROC-1) :: ISTATUS2
#endif
-INTEGER :: ICPT
+INTEGER :: ICPT, IPIO, IDX, IREQ
INTEGER :: I,J
INTEGER :: INFOMPI
-REAL :: XTIME0
+DOUBLE PRECISION :: XTIME0
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!
-IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N1D',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N1D_1',0,ZHOOK_HANDLE)
!
-!$OMP BARRIER
+IF (PRESENT(KPIO)) THEN
+ IPIO = KPIO
+ELSE
+ IPIO = NPIO
+ENDIF
!
-IF (NRANK==NPIO) THEN
- !
-!$OMP SINGLE
+IF (PRESENT(KDX)) THEN
+ IDX = KDX
+ELSE
+ IDX = IDX_R
+ENDIF
+!
+IF (NRANK==IPIO) THEN
!
- IDX_R = IDX_R + 1
+ IDX = IDX + 1
!
- DO I=1,NPROC-1
+ IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N1D_1',1,ZHOOK_HANDLE)
+!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(I,ICPT,J,IREQ,INFOMPI,ZHOOK_HANDLE_OMP)
+ DO I=0,NPROC-1
!
-#ifdef SFX_MPI
+ IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N1D_20',0,ZHOOK_HANDLE_OMP)
+ !
+#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
#endif
!
ICPT = 0
!
- NWORK(:) = 0
+ IWORKS(:,I+1) = 0
!
DO J=1,SIZE(NINDEX)
!
- IF ( NINDEX(J)==MOD(I,NPROC) ) THEN
+ IF ( NINDEX(J)==I ) THEN
ICPT = ICPT + 1
- NWORK(ICPT) = KWORK(J)
+ IWORKS(ICPT,I+1) = KWORK(J)
ENDIF
!
ENDDO
!
-#ifdef SFX_MPI
+ IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N1D_20',1,ZHOOK_HANDLE_OMP)
+ IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N1D_30',0,ZHOOK_HANDLE_OMP)
+ !
+#ifdef SFX_MPI
XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
+#endif
!
- IF (I<NPROC) THEN
+ IF (I/=IPIO) THEN
+
+#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
- CALL MPI_SEND(NWORK,SIZE(NWORK)*KIND(NWORK)/4,MPI_INTEGER,I,IDX_R,NCOMM,INFOMPI)
+
+ IF (PRESENT(KPIO) .AND.PRESENT(KDX)) THEN
+ IF (I<IPIO) THEN
+ IREQ = I+1
+ ELSE
+ IREQ = I
+ ENDIF
+
+ CALL MPI_ISEND(IWORKS(:,I+1),SIZE(IWORKS,1)*KIND(IWORKS)/4,&
+ MPI_INTEGER,I,IDX,NCOMM,NREQ(IREQ),INFOMPI)
+ ELSE
+ CALL MPI_SEND(IWORKS(:,I+1),SIZE(IWORKS,1)*KIND(IWORKS)/4,MPI_INTEGER,I,IDX,NCOMM,INFOMPI)
+ ENDIF
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
- ENDIF
#endif
+
+ ELSE
+ IWORKR(:) = IWORKS(:,I+1)
+ ENDIF
+ IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N1D_30',1,ZHOOK_HANDLE_OMP)
!
ENDDO
- !
-!$OMP END SINGLE
+!$OMP END PARALLEL DO
!
ELSE
- !
-!$OMP SINGLE
!
- IDX_R = IDX_R + 1
+ IDX = IDX + 1
!
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N1D_1',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N1D_2',0,ZHOOK_HANDLE)
#ifdef SFX_MPI
- NWORK(:) = 0
!
XTIME0 = MPI_WTIME()
- CALL MPI_RECV(NWORK,SIZE(NWORK)*KIND(NWORK)/4,MPI_INTEGER,NPIO,IDX_R,NCOMM,ISTATUS,INFOMPI)
+ CALL MPI_RECV(IWORKR,SIZE(IWORKR)*KIND(IWORKR)/4,MPI_INTEGER,IPIO,IDX,NCOMM,ISTATUS,INFOMPI)
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
#endif
!
-!$OMP END SINGLE
- !
+ IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N1D_2',1,ZHOOK_HANDLE)
+ !
ENDIF
!
+ IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N1D_3',0,ZHOOK_HANDLE)
IF (PRESENT(KMASK)) THEN
- CALL PACK_SAME_RANK(KMASK,NWORK(NINDX1SFX:NINDX2SFX),KWORK2)
+ CALL PACK_SAME_RANK(KMASK,IWORKR(:),KWORK2)
ELSE
- KWORK2(:) = NWORK(NINDX1SFX:NINDX2SFX)
+ KWORK2(:) = IWORKR(1:SIZE(KWORK2))
ENDIF
!
-IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N1D',1,ZHOOK_HANDLE)
+IF (.NOT.PRESENT(KDX)) IDX_R = IDX_R + 1
!
+ IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N1D_3',1,ZHOOK_HANDLE)
!
END SUBROUTINE READ_AND_SEND_MPI_N1D
!
@@ -172,7 +222,6 @@ SUBROUTINE READ_AND_SEND_MPI_N2D(KWORK,KWORK2,KMASK)
!
USE MODD_SURFEX_MPI, ONLY : NINDEX, NPROC, NRANK, NCOMM, NPIO, NSIZE, &
XTIME_NPIO_READ, XTIME_COMM_READ, IDX_R, WLOG_MPI
-USE MODD_SURFEX_OMP, ONLY : NINDX1SFX, NINDX2SFX, NWORK2, NBLOCK
!
USE MODI_PACK_SAME_RANK
!
@@ -190,6 +239,9 @@ INTEGER, DIMENSION(:,:), INTENT(OUT) :: KWORK2
!
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
+INTEGER, DIMENSION(NSIZE,SIZE(KWORK2,2)) :: IWORKS
+INTEGER, DIMENSION(NSIZE,SIZE(KWORK2,2)) :: IWORKR
+!
#ifdef SFX_MPI
INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
#endif
@@ -197,85 +249,67 @@ INTEGER :: IS2, IP2
INTEGER :: ICPT
INTEGER :: I,J, K
INTEGER :: INFOMPI
-REAL XTIME0
+DOUBLE PRECISION :: XTIME0
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N2D',0,ZHOOK_HANDLE)
!
-!$OMP BARRIER
-!
-IP2 = SIZE(KWORK2,2)
-IS2 = SIZE(NWORK2,2)
-!
-!$OMP SINGLE
-IF (IP2>IS2) THEN
- DEALLOCATE(NWORK2)
- ALLOCATE(NWORK2(NSIZE,IP2))
-ENDIF
-!$OMP END SINGLE
-!
IF (NRANK==NPIO) THEN
!
-!$OMP SINGLE
- !
IDX_R = IDX_R + 1
!
- DO I=1,NPROC-1
+ DO I=0,NPROC-1
!
-#ifdef SFX_MPI
+#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
#endif
!
ICPT = 0
!
- NWORK2(:,1:IP2) = 0
+ IWORKS(:,:) = 0
!
DO J=1,SIZE(NINDEX)
!
IF ( NINDEX(J)==MOD(I,NPROC) ) THEN
ICPT = ICPT + 1
- NWORK2(ICPT,1:IP2) = KWORK(J,:)
+ IWORKS(ICPT,:) = KWORK(J,:)
ENDIF
!
ENDDO
!
-#ifdef SFX_MPI
+#ifdef SFX_MPI
XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
!
- IF (I<NPROC) THEN
+ IF (I/=NPIO) THEN
XTIME0 = MPI_WTIME()
- CALL MPI_SEND(NWORK2(:,1:IP2),NSIZE*IP2*KIND(NWORK2)/4,MPI_INTEGER,I,IDX_R,NCOMM,INFOMPI)
+ CALL MPI_SEND(IWORKS(:,:),SIZE(IWORKS)*KIND(IWORKS)/4,MPI_INTEGER,I,IDX_R,NCOMM,INFOMPI)
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
+ ELSE
+ IWORKR(:,:) = IWORKS(:,:)
ENDIF
#endif
!
ENDDO
!
-!$OMP END SINGLE
- !
ELSE
!
-!$OMP SINGLE
- !
IDX_R = IDX_R + 1
!
#ifdef SFX_MPI
- NWORK2(:,1:IP2) = 0
+ IWORKS(:,:) = 0
!
XTIME0 = MPI_WTIME()
- CALL MPI_RECV(NWORK2(:,1:IP2),NSIZE*IP2*KIND(NWORK2)/4,MPI_INTEGER,NPIO,IDX_R,NCOMM,ISTATUS,INFOMPI)
+ CALL MPI_RECV(IWORKR(:,:),SIZE(IWORKR)*KIND(IWORKR)/4,MPI_INTEGER,NPIO,IDX_R,NCOMM,ISTATUS,INFOMPI)
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
#endif
!
-!$OMP END SINGLE
- !
ENDIF
!
IF (PRESENT(KMASK)) THEN
- CALL PACK_SAME_RANK(KMASK,NWORK2(NINDX1SFX:NINDX2SFX,1:IP2),KWORK2)
+ CALL PACK_SAME_RANK(KMASK,IWORKR(:,:),KWORK2)
ELSE
- KWORK2(:,:) = NWORK2(NINDX1SFX:NINDX2SFX,1:IP2)
+ KWORK2(:,:) = IWORKR(1:SIZE(KWORK2,1),:)
ENDIF
!
IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N2D',1,ZHOOK_HANDLE)
@@ -285,11 +319,150 @@ END SUBROUTINE READ_AND_SEND_MPI_N2D
!
!**************************************************************************
!
-SUBROUTINE READ_AND_SEND_MPI_X1D(PWORK,PWORK2,KMASK)
+SUBROUTINE READ_AND_SEND_MPI_N3D(KWORK,KWORK2,KMASK,KPIO,KDX)
!
USE MODD_SURFEX_MPI, ONLY : NINDEX, NPROC, NRANK, NCOMM, NPIO, NSIZE, &
- XTIME_NPIO_READ, XTIME_COMM_READ, WLOG_MPI, IDX_R
-USE MODD_SURFEX_OMP, ONLY : NINDX1SFX, NINDX2SFX, XWORK, NBLOCK
+ XTIME_NPIO_READ, XTIME_COMM_READ, IDX_R, WLOG_MPI, &
+ NREQ
+!
+USE MODI_PACK_SAME_RANK
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
+INTEGER, DIMENSION(:,:,:), INTENT(IN) :: KWORK
+INTEGER, DIMENSION(:,:,:), INTENT(OUT) :: KWORK2
+!
+INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
+INTEGER, INTENT(IN), OPTIONAL :: KPIO
+INTEGER, INTENT(IN), OPTIONAL :: KDX
+!
+INTEGER, DIMENSION(NSIZE,SIZE(KWORK2,2),SIZE(KWORK2,3),NPROC) :: IWORK3S
+INTEGER, DIMENSION(NSIZE,SIZE(KWORK2,2),SIZE(KWORK2,3)) :: IWORK3
+#ifdef SFX_MPI
+INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+#endif
+INTEGER :: IP2, IS2, IP3, IS3
+INTEGER :: ICPT, IPIO, IDX
+INTEGER :: I,J
+INTEGER :: INFOMPI, IREQ
+DOUBLE PRECISION :: XTIME0
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
+!
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N3D_1',0,ZHOOK_HANDLE)
+!
+IF (PRESENT(KPIO)) THEN
+ IPIO = KPIO
+ELSE
+ IPIO = NPIO
+ENDIF
+!
+IF (PRESENT(KDX)) THEN
+ IDX = KDX
+ELSE
+ IDX = IDX_R
+ENDIF
+!
+IF (NRANK==IPIO) THEN
+ !
+ IDX = IDX + 1
+ !
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N3D_1',1,ZHOOK_HANDLE)
+!$OMP PARALLEL DO PRIVATE(I,ICPT,J,INFOMPI,IREQ,ZHOOK_HANDLE_OMP)
+ DO I=0,NPROC-1
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N3D_2',0,ZHOOK_HANDLE_OMP)
+ !
+#ifdef SFX_MPI
+ XTIME0 = MPI_WTIME()
+#endif
+ !
+ ICPT = 0
+ !
+ IWORK3S(:,:,:,I+1) = 0.
+ !
+ DO J=1,SIZE(NINDEX)
+ !
+ IF ( NINDEX(J)==I ) THEN
+ ICPT = ICPT + 1
+ IWORK3S(ICPT,:,:,I+1) = KWORK(J,:,:)
+ ENDIF
+ !
+ ENDDO
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N3D_2',1,ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N3D_3',0,ZHOOK_HANDLE_OMP)
+ !
+#ifdef SFX_MPI
+ XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
+#endif
+ !
+ IF (I/=IPIO) THEN
+#ifdef SFX_MPI
+ IF (PRESENT(KPIO).AND.PRESENT(KDX)) THEN
+ IF (I<IPIO) THEN
+ IREQ = I+1
+ ELSE
+ IREQ = I
+ ENDIF
+ XTIME0 = MPI_WTIME()
+ CALL MPI_ISEND(IWORK3S(:,:,:,I+1),SIZE(IWORK3)*KIND(IWORK3)/4,&
+ MPI_INTEGER,I,IDX,NCOMM,NREQ(IREQ),INFOMPI)
+ ELSE
+ CALL MPI_SEND(IWORK3S(:,:,:,I+1),SIZE(IWORK3)*KIND(IWORK3)/4,&
+ MPI_INTEGER,I,IDX,NCOMM,INFOMPI)
+ ENDIF
+ XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
+#endif
+ ELSE
+ IWORK3(:,:,:) = IWORK3S(:,:,:,I+1)
+ ENDIF
+ !
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N3D_3',1,ZHOOK_HANDLE_OMP)
+ ENDDO
+!$OMP END PARALLEL DO
+ !
+ELSE
+ !
+ IDX = IDX + 1
+ !
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N3D_1',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N3D_2',0,ZHOOK_HANDLE)
+#ifdef SFX_MPI
+ !
+ XTIME0 = MPI_WTIME()
+ CALL MPI_RECV(IWORK3,SIZE(IWORK3)*KIND(IWORK3)/4,MPI_INTEGER,IPIO,IDX,NCOMM,ISTATUS,INFOMPI)
+ XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
+#endif
+ !
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N3D_2',1,ZHOOK_HANDLE)
+ !
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N3D_4',0,ZHOOK_HANDLE)
+IF (PRESENT(KMASK)) THEN
+ CALL PACK_SAME_RANK(KMASK,IWORK3(:,:,:),KWORK2)
+ELSE
+ KWORK2(:,:,:) = IWORK3(1:SIZE(KWORK2,1),:,:)
+ENDIF
+!
+IF (.NOT.PRESENT(KDX)) IDX_R = IDX_R + 1
+!
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N3D_4',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE READ_AND_SEND_MPI_N3D
+!**************************************************************************
+!
+SUBROUTINE READ_AND_SEND_MPI_X1D(PWORK,PWORK2,KMASK,KPIO,KDX)
+!
+USE MODD_SURFEX_MPI, ONLY : NINDEX, NPROC, NRANK, NCOMM, NPIO, NSIZE, NREQ, &
+ XTIME_NPIO_READ, XTIME_COMM_READ, WLOG_MPI, IDX_R,&
+ NSIZE, XWORKS
!
USE MODI_PACK_SAME_RANK
!
@@ -306,28 +479,46 @@ REAL, DIMENSION(:), INTENT(IN) :: PWORK
REAL, DIMENSION(:), INTENT(OUT) :: PWORK2
!
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
+INTEGER, INTENT(IN), OPTIONAL :: KPIO
+INTEGER, INTENT(IN), OPTIONAL :: KDX
!
+REAL, DIMENSION(NSIZE,NPROC) :: ZWORKS
+REAL, DIMENSION(NSIZE) :: ZWORKR
#ifdef SFX_MPI
INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
#endif
-INTEGER :: ICPT
-INTEGER :: I,J
+INTEGER :: ICPT, IPIO, IDX
+INTEGER :: I,J, IREQ
INTEGER :: INFOMPI
-REAL :: XTIME0
+DOUBLE PRECISION :: XTIME0
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!
-IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X1D',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X1D_1',0,ZHOOK_HANDLE)
!
-!$OMP BARRIER
!
-IF (NRANK==NPIO) THEN
- !
-!$OMP SINGLE
+IF (PRESENT(KPIO)) THEN
+ IPIO = KPIO
+ELSE
+ IPIO = NPIO
+ENDIF
+!
+IF (NRANK==IPIO.AND..NOT.ALLOCATED(XWORKS)) ALLOCATE(XWORKS(NSIZE,NPROC))
+!
+IF (PRESENT(KDX)) THEN
+ IDX = KDX
+ELSE
+ IDX = IDX_R
+ENDIF
+!
+IF (NRANK==IPIO) THEN
!
- IDX_R = IDX_R + 1
+ IDX = IDX + 1
!
- DO I=1,NPROC
+ IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X1D_1',1,ZHOOK_HANDLE)
+!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(I,ICPT,J,IREQ,INFOMPI,ZHOOK_HANDLE_OMP)
+ DO I=0,NPROC-1
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X1D_2',0,ZHOOK_HANDLE_OMP)
!
#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
@@ -335,66 +526,88 @@ IF (NRANK==NPIO) THEN
!
ICPT = 0
!
- XWORK(:) = 0.
+ XWORKS(:,I+1) = 0.
!
DO J=1,SIZE(NINDEX)
!
- IF ( NINDEX(J)==MOD(I,NPROC) ) THEN
+ IF ( NINDEX(J)==I) THEN
ICPT = ICPT + 1
- XWORK(ICPT) = PWORK(J)
+ XWORKS(ICPT,I+1) = PWORK(J)
ENDIF
!
ENDDO
+ !
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X1D_2',1,ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X1D_30',0,ZHOOK_HANDLE_OMP)
!
-#ifdef SFX_MPI
+#ifdef SFX_MPI
XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
+#endif
!
- IF (I<NPROC) THEN
+ IF (I/=IPIO) THEN
+#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
- CALL MPI_SEND(XWORK,SIZE(XWORK)*KIND(XWORK)/4,MPI_REAL,I,IDX_R,NCOMM,INFOMPI)
+ IF (PRESENT(KPIO).AND.PRESENT(KDX)) THEN
+ IF (I<IPIO) THEN
+ IREQ = I+1
+ ELSE
+ IREQ = I
+ ENDIF
+ CALL MPI_ISEND(XWORKS(:,I+1),SIZE(XWORKS(:,I+1))*KIND(XWORKS)/4,MPI_REAL,I,IDX,NCOMM,NREQ(IREQ),INFOMPI)
+ ELSE
+ CALL MPI_SEND(XWORKS(:,I+1),SIZE(XWORKS(:,I+1))*KIND(XWORKS)/4,MPI_REAL,I,IDX,NCOMM,INFOMPI)
+ ENDIF
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
- ENDIF
-#endif
+#endif
+ ELSE
+ ZWORKR(:) = XWORKS(:,I+1)
+ ENDIF
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X1D_30',1,ZHOOK_HANDLE_OMP)
!
ENDDO
+!$OMP END PARALLEL DO
!
-!$OMP END SINGLE
-!
ELSE
!
-!$OMP SINGLE
- !
- IDX_R = IDX_R + 1
+ IDX = IDX + 1
!
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X1D_1',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X1D_2',0,ZHOOK_HANDLE)
#ifdef SFX_MPI
- XWORK(:) = 0.
+ ZWORKR(:) = 0.
!
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X1D_2',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X1D_3',0,ZHOOK_HANDLE)
XTIME0 = MPI_WTIME()
- CALL MPI_RECV(XWORK,SIZE(XWORK)*KIND(XWORK)/4,MPI_REAL,NPIO,IDX_R,NCOMM,ISTATUS,INFOMPI)
+ CALL MPI_RECV(ZWORKR(:),SIZE(ZWORKR(:))*KIND(ZWORKR)/4,MPI_REAL,IPIO,IDX,NCOMM,ISTATUS,INFOMPI)
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
#endif
!
-!$OMP END SINGLE
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X1D_3',1,ZHOOK_HANDLE)
!
ENDIF
!
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X1D_4',0,ZHOOK_HANDLE)
+
IF (PRESENT(KMASK)) THEN
- CALL PACK_SAME_RANK(KMASK,XWORK(NINDX1SFX:NINDX2SFX),PWORK2)
+ CALL PACK_SAME_RANK(KMASK,ZWORKR(:),PWORK2(:))
ELSE
- PWORK2(:) = XWORK(NINDX1SFX:NINDX2SFX)
+ PWORK2(:) = ZWORKR(1:SIZE(PWORK2))
ENDIF
+
+IF (.NOT.PRESENT(KDX)) IDX_R = IDX_R + 1
!
-IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X1D',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X1D_4',1,ZHOOK_HANDLE)
!
END SUBROUTINE READ_AND_SEND_MPI_X1D
!
!**************************************************************************
!
-SUBROUTINE READ_AND_SEND_MPI_X2D(PWORK,PWORK2,KMASK)
+SUBROUTINE READ_AND_SEND_MPI_X2D(PWORK,PWORK2,KMASK,KPIO,KDX)
!
USE MODD_SURFEX_MPI, ONLY : NINDEX, NPROC, NRANK, NCOMM, NPIO, NSIZE, &
- XTIME_NPIO_READ, XTIME_COMM_READ, WLOG_MPI, IDX_R
-USE MODD_SURFEX_OMP, ONLY : NINDX1SFX, NINDX2SFX, XWORK2, NBLOCK
+ XTIME_NPIO_READ, XTIME_COMM_READ, WLOG_MPI, IDX_R, &
+ NREQ, XWORK2S
!
USE MODI_PACK_SAME_RANK
!
@@ -411,105 +624,136 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PWORK
REAL, DIMENSION(:,:), INTENT(OUT) :: PWORK2
!
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
+INTEGER, INTENT(IN), OPTIONAL :: KPIO
+INTEGER, INTENT(IN), OPTIONAL :: KDX
!
+REAL, DIMENSION(NSIZE,SIZE(PWORK2,2),NPROC) :: ZWORK2S
+REAL, DIMENSION(NSIZE,SIZE(PWORK2,2)) :: ZWORK2
#ifdef SFX_MPI
INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
#endif
INTEGER :: IS2, IP2
-INTEGER :: ICPT
-INTEGER :: I,J, K
+INTEGER :: ICPT, IPIO, IDX
+INTEGER :: I,J, K, IREQ
INTEGER :: INFOMPI
-REAL :: XTIME0
+DOUBLE PRECISION :: XTIME0
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!
-IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X2D',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X2D_1',0,ZHOOK_HANDLE)
!
-!$OMP BARRIER
+IF (PRESENT(KPIO)) THEN
+ IPIO = KPIO
+ELSE
+ IPIO = NPIO
+ENDIF
!
-IP2 = SIZE(PWORK2,2)
-IS2 = SIZE(XWORK2,2)
+IF (NRANK==IPIO) THEN
+ IF (ALLOCATED(XWORK2S)) THEN
+ IF (SIZE(XWORK2S,2)/=SIZE(PWORK2,2)) DEALLOCATE(XWORK2S)
+ ENDIF
+ IF (.NOT.ALLOCATED(XWORK2S)) ALLOCATE(XWORK2S(NSIZE,SIZE(PWORK2,2),NPROC))
+ENDIF
!
-!$OMP SINGLE
-IF (IP2>IS2) THEN
- DEALLOCATE(XWORK2)
- ALLOCATE(XWORK2(NSIZE,IP2))
+IF (PRESENT(KDX)) THEN
+ IDX = KDX
+ELSE
+ IDX = IDX_R
ENDIF
-!$OMP END SINGLE
!
-IF (NRANK==NPIO) THEN
+IF (NRANK==IPIO) THEN
!
-!$OMP SINGLE
- !
- IDX_R = IDX_R + 1
+ IDX = IDX + 1
!
- DO I=1,NPROC
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X2D_1',1,ZHOOK_HANDLE)
+!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(I,ICPT,J,IREQ,INFOMPI,ZHOOK_HANDLE_OMP)
+ DO I=0,NPROC-1
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X2D_2',0,ZHOOK_HANDLE_OMP)
!
-#ifdef SFX_MPI
+#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
-#endif
+#endif
!
ICPT = 0
!
- XWORK2(:,1:IP2) = 0.
+ XWORK2S(:,:,I+1) = 0.
!
DO J=1,SIZE(NINDEX)
!
- IF ( NINDEX(J)==MOD(I,NPROC) ) THEN
+ IF ( NINDEX(J)==I ) THEN
ICPT = ICPT + 1
- XWORK2(ICPT,1:IP2) = PWORK(J,:)
+ XWORK2S(ICPT,:,I+1) = PWORK(J,:)
ENDIF
!
ENDDO
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X2D_2',1,ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X2D_3',0,ZHOOK_HANDLE_OMP)
!
-#ifdef SFX_MPI
+#ifdef SFX_MPI
XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
+#endif
!
- IF (I<NPROC) THEN
- XTIME0 = MPI_WTIME()
- CALL MPI_SEND(XWORK2(:,1:IP2),NSIZE*IP2*KIND(XWORK2)/4,MPI_REAL,I,IDX_R,NCOMM,INFOMPI)
+ IF (I/=IPIO) THEN
+#ifdef SFX_MPI
+ IF (PRESENT(KPIO).AND.PRESENT(KDX)) THEN
+ IF (I<IPIO) THEN
+ IREQ = I+1
+ ELSE
+ IREQ = I
+ ENDIF
+ CALL MPI_ISEND(XWORK2S(:,:,I+1),SIZE(XWORK2S(:,:,I+1))*KIND(XWORK2S)/4,&
+ MPI_REAL,I,IDX,NCOMM,NREQ(IREQ),INFOMPI)
+ ELSE
+ CALL MPI_SEND(XWORK2S(:,:,I+1),SIZE(XWORK2S(:,:,I+1))*KIND(XWORK2S)/4,&
+ MPI_REAL,I,IDX,NCOMM,INFOMPI)
+ ENDIF
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
+#endif
+ ELSE
+ ZWORK2(:,:) = XWORK2S(:,:,I+1)
ENDIF
-#endif
!
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X2D_3',1,ZHOOK_HANDLE_OMP)
ENDDO
+!$OMP END PARALLEL DO
!
-!$OMP END SINGLE
- !
ELSE
!
-!$OMP SINGLE
- !
- IDX_R = IDX_R + 1
+ IDX = IDX + 1
!
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X2D_1',1,ZHOOK_HANDLE)
#ifdef SFX_MPI
- XWORK2(:,1:IP2) = 0.
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X2D_3',0,ZHOOK_HANDLE)
!
XTIME0 = MPI_WTIME()
- CALL MPI_RECV(XWORK2(:,1:IP2),NSIZE*IP2*KIND(XWORK2)/4,MPI_REAL,NPIO,IDX_R,NCOMM,ISTATUS,INFOMPI)
+ CALL MPI_RECV(ZWORK2(:,:),SIZE(ZWORK2)*KIND(ZWORK2)/4,MPI_REAL,IPIO,IDX,NCOMM,ISTATUS,INFOMPI)
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
#endif
!
-!$OMP END SINGLE
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X2D_3',1,ZHOOK_HANDLE)
!
ENDIF
!
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X2D_4',0,ZHOOK_HANDLE)
+!
IF (PRESENT(KMASK)) THEN
- CALL PACK_SAME_RANK(KMASK,XWORK2(NINDX1SFX:NINDX2SFX,1:IP2),PWORK2)
+ CALL PACK_SAME_RANK(KMASK,ZWORK2(:,:),PWORK2(:,:))
ELSE
- PWORK2(:,:) = XWORK2(NINDX1SFX:NINDX2SFX,1:IP2)
+ PWORK2(:,:) = ZWORK2(1:SIZE(PWORK2,1),:)
ENDIF
!
-IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X2D',1,ZHOOK_HANDLE)
+IF (.NOT.PRESENT(KDX)) IDX_R = IDX_R + 1
+!
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X2D_4',1,ZHOOK_HANDLE)
!
END SUBROUTINE READ_AND_SEND_MPI_X2D
!**************************************************************************
!
-SUBROUTINE READ_AND_SEND_MPI_X3D(PWORK,PWORK2,KMASK)
+SUBROUTINE READ_AND_SEND_MPI_X3D(PWORK,PWORK2,KMASK,KPIO,KDX)
!
USE MODD_SURFEX_MPI, ONLY : NINDEX, NPROC, NRANK, NCOMM, NPIO, NSIZE, &
- XTIME_NPIO_READ, XTIME_COMM_READ, IDX_R, WLOG_MPI
-USE MODD_SURFEX_OMP, ONLY : NINDX1SFX, NINDX2SFX, XWORK3, NBLOCK
+ XTIME_NPIO_READ, XTIME_COMM_READ, IDX_R, WLOG_MPI, &
+ NREQ
!
USE MODI_PACK_SAME_RANK
!
@@ -526,98 +770,120 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PWORK
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWORK2
!
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
+INTEGER, INTENT(IN), OPTIONAL :: KPIO
+INTEGER, INTENT(IN), OPTIONAL :: KDX
!
+REAL, DIMENSION(NSIZE,SIZE(PWORK2,2),SIZE(PWORK2,3),NPROC) :: ZWORK3S
+REAL, DIMENSION(NSIZE,SIZE(PWORK2,2),SIZE(PWORK2,3)) :: ZWORK3
#ifdef SFX_MPI
INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
#endif
INTEGER :: IP2, IS2, IP3, IS3
-INTEGER :: ICPT
+INTEGER :: ICPT, IPIO, IDX
INTEGER :: I,J
-INTEGER :: INFOMPI
-REAL :: XTIME0
+INTEGER :: INFOMPI, IREQ
+DOUBLE PRECISION :: XTIME0
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X3D',0,ZHOOK_HANDLE)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!
-!$OMP BARRIER
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X3D_1',0,ZHOOK_HANDLE)
!
-IP2 = SIZE(PWORK2,2)
-IP3 = SIZE(PWORK2,3)
-IS2 = SIZE(XWORK3,2)
-IS3 = SIZE(XWORK3,3)
+IF (PRESENT(KPIO)) THEN
+ IPIO = KPIO
+ELSE
+ IPIO = NPIO
+ENDIF
!
-!$OMP SINGLE
-IF (IP2>IS2 .OR. IP3>IS3) THEN
- DEALLOCATE(XWORK3)
- ALLOCATE(XWORK3(NSIZE,MAX(IP2,IS2),MAX(IP3,IS3)))
+IF (PRESENT(KDX)) THEN
+ IDX = KDX
+ELSE
+ IDX = IDX_R
ENDIF
-!$OMP END SINGLE
!
-IF (NRANK==NPIO) THEN
- !
-!$OMP SINGLE
+IF (NRANK==IPIO) THEN
!
- IDX_R = IDX_R + 1
+ IDX = IDX + 1
!
- DO I=1,NPROC
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X3D_1',1,ZHOOK_HANDLE)
+!$OMP PARALLEL DO PRIVATE(I,ICPT,J,IREQ,INFOMPI,ZHOOK_HANDLE_OMP)
+ DO I=0,NPROC-1
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X3D_2',0,ZHOOK_HANDLE_OMP)
!
-#ifdef SFX_MPI
+#ifdef SFX_MPI
XTIME0 = MPI_WTIME()
-#endif
+#endif
!
ICPT = 0
!
- XWORK3(:,1:IP2,1:IP3) = 0.
+ ZWORK3S(:,:,:,I+1) = 0.
!
DO J=1,SIZE(NINDEX)
!
- IF ( NINDEX(J)==MOD(I,NPROC) ) THEN
+ IF ( NINDEX(J)==I ) THEN
ICPT = ICPT + 1
- XWORK3(ICPT,1:IP2,1:IP3) = PWORK(J,:,:)
+ ZWORK3S(ICPT,:,:,I+1) = PWORK(J,:,:)
ENDIF
!
ENDDO
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X3D_2',1,ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X3D_3',0,ZHOOK_HANDLE_OMP)
!
-#ifdef SFX_MPI
+#ifdef SFX_MPI
XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
- !
- IF (I<NPROC) THEN
- XTIME0 = MPI_WTIME()
- CALL MPI_SEND(XWORK3(:,1:IP2,1:IP3),NSIZE*IP2*IP3*KIND(XWORK3)/4,MPI_REAL,I,IDX_R,NCOMM,INFOMPI)
+#endif
+ !
+ IF (I/=IPIO) THEN
+#ifdef SFX_MPI
+ IF (PRESENT(KPIO).AND.PRESENT(KDX)) THEN
+ IF (I<IPIO) THEN
+ IREQ = I+1
+ ELSE
+ IREQ = I
+ ENDIF
+ XTIME0 = MPI_WTIME()
+ CALL MPI_ISEND(ZWORK3S(:,:,:,I+1),SIZE(ZWORK3)*KIND(ZWORK3)/4,&
+ MPI_REAL,I,IDX,NCOMM,NREQ(IREQ),INFOMPI)
+ ELSE
+ CALL MPI_SEND(ZWORK3S(:,:,:,I+1),SIZE(ZWORK3)*KIND(ZWORK3)/4,&
+ MPI_REAL,I,IDX,NCOMM,INFOMPI)
+ ENDIF
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
+#endif
+ ELSE
+ ZWORK3(:,:,:) = ZWORK3S(:,:,:,I+1)
ENDIF
-#endif
!
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X3D_3',1,ZHOOK_HANDLE_OMP)
ENDDO
- !
-!$OMP END SINGLE
+!$OMP END PARALLEL DO
!
ELSE
- !
-!$OMP SINGLE
!
- IDX_R = IDX_R + 1
+ IDX = IDX + 1
!
-#ifdef SFX_MPI
- XWORK3(:,1:IP2,1:IP3) = 0.
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X3D_1',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X3D_2',0,ZHOOK_HANDLE)
+#ifdef SFX_MPI
!
XTIME0 = MPI_WTIME()
- CALL MPI_RECV(XWORK3(:,1:IP2,1:IP3),NSIZE*IP2*IP3*KIND(XWORK3)/4,MPI_REAL,NPIO,IDX_R,NCOMM,ISTATUS,INFOMPI)
+ CALL MPI_RECV(ZWORK3,SIZE(ZWORK3)*KIND(ZWORK3)/4,MPI_REAL,IPIO,IDX,NCOMM,ISTATUS,INFOMPI)
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
#endif
!
-!$OMP END SINGLE
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X3D_2',1,ZHOOK_HANDLE)
!
ENDIF
!
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X3D_4',0,ZHOOK_HANDLE)
+!
IF (PRESENT(KMASK)) THEN
- CALL PACK_SAME_RANK(KMASK,XWORK3(NINDX1SFX:NINDX2SFX,1:IP2,1:IP3),PWORK2)
+ CALL PACK_SAME_RANK(KMASK,ZWORK3(:,:,:),PWORK2)
ELSE
- PWORK2(:,:,:) = XWORK3(NINDX1SFX:NINDX2SFX,1:IP2,1:IP3)
+ PWORK2(:,:,:) = ZWORK3(1:SIZE(PWORK2,1),:,:)
ENDIF
!
-IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X3D',1,ZHOOK_HANDLE)
+IF (.NOT.PRESENT(KDX)) IDX_R = IDX_R + 1
!
+IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X3D_4',1,ZHOOK_HANDLE)
!
END SUBROUTINE READ_AND_SEND_MPI_X3D
diff --git a/src/SURFEX/read_ascllv.F90 b/src/SURFEX/read_ascllv.F90
index 58a2371bba37248f32061aa50dad9860d62dc3ee..a8fda182d299cb4ca247d17e94d1f2d180aaee71 100644
--- a/src/SURFEX/read_ascllv.F90
+++ b/src/SURFEX/read_ascllv.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_ASCLLV (USS, &
+ SUBROUTINE READ_ASCLLV (UG, U, USS, &
HPROGRAM,HSUBROUTINE,HFILENAME)
! ##############################################################
!
@@ -30,8 +30,9 @@
! -----------
!
!
-!
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_PGD_GRID, ONLY : LLATLONMASK
!
@@ -50,7 +51,9 @@ IMPLICIT NONE
! ------------------------
!
!
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
CHARACTER(LEN=6), INTENT(IN) :: HSUBROUTINE ! Name of the subroutine to call
@@ -63,10 +66,17 @@ TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
INTEGER :: IGLB ! logical unit
!
INTEGER :: JLAT, JLON ! indexes of OLATLONMASK array
-REAL :: ZVALUE ! values of a data point
-REAL :: ZLAT ! latitude of data point
-REAL :: ZLON ! longitude of data point
!
+INTEGER*4, PARAMETER :: ILONG=200000
+!
+REAL :: ZVALUER
+REAL, DIMENSION(ILONG) :: ZVALUE ! values of a data point
+REAL :: ZLATR
+REAL, DIMENSION(ILONG) :: ZLAT ! latitude of data point
+REAL :: ZLONR, ZLONR2
+REAL, DIMENSION(ILONG) :: ZLON ! longitude of data point
+!
+INTEGER :: ICPT, ISTAT
INTEGER :: ILUOUT ! output listing
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
@@ -79,6 +89,12 @@ IF (LHOOK) CALL DR_HOOK('READ_ASCLLV',0,ZHOOK_HANDLE)
!
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
+ICPT = 0
+!
+ZLAT(:) = 0
+ZLON(:) = 0
+ZVALUE(:) = 0
+!
!----------------------------------------------------------------------------
DO
!----------------------------------------------------------------------------
@@ -86,32 +102,56 @@ DO
!* 3. Reading of a data point
! -----------------------
!
- READ(IGLB,*,END=99) ZLAT,ZLON,ZVALUE
+ READ(IGLB,*,IOSTAT=ISTAT) ZLATR,ZLONR,ZVALUER
!
!----------------------------------------------------------------------------
!
!* 4. Test if point is in MESO-NH domain
! ----------------------------------
!
- ZLON=ZLON+NINT((180.-ZLON)/360.)*360.
+ IF (ISTAT==0) THEN
+ !
+ ZLONR2=ZLONR+NINT((180.-ZLONR)/360.)*360.
+ !
+ JLAT = 1 + INT( ( ZLATR + 90. ) * 2. )
+ JLAT = MIN(JLAT,360)
+ JLON = 1 + INT( ( ZLONR2 ) * 2. )
+ JLON = MIN(JLON,720)
+ !
+ IF (.NOT. LLATLONMASK(JLON,JLAT)) CYCLE
+ !
+ ICPT = ICPT + 1
+ !
+ IF (ICPT<=ILONG) THEN
+ !
+ ZLAT (ICPT) = ZLATR
+ ZLON (ICPT) = ZLONR
+ ZVALUE(ICPT) = ZVALUER
+ !
+ ENDIF
+ !
+ ENDIF
+ !
+ IF (ISTAT==-1 .OR. ICPT==ILONG) THEN
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !* 5. Call to the adequate subroutine (point by point treatment)
+ ! ----------------------------------------------------------
+ !
+ CALL PT_BY_PT_TREATMENT(UG, U, USS, ILUOUT, &
+ ZLAT(1:ICPT), ZLON(1:ICPT), ZVALUE(1:ICPT), HSUBROUTINE )
+ !
+ ICPT = 0
+ ZLAT (:) = 0.
+ ZLON (:) = 0.
+ ZVALUE(:) = 0.
+ !
+ ENDIF
!
- JLAT = 1 + INT( ( ZLAT + 90. ) * 2. )
- JLAT = MIN(JLAT,360)
- JLON = 1 + INT( ( ZLON ) * 2. )
- JLON = MIN(JLON,720)
+ IF (ISTAT==-1) EXIT
!
- IF (.NOT. LLATLONMASK(JLON,JLAT)) CYCLE
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. Call to the adequate subroutine (point by point treatment)
-! ----------------------------------------------------------
-!
- CALL PT_BY_PT_TREATMENT(USS, &
- ILUOUT, (/ ZLAT /) , (/ ZLON /) , (/ ZVALUE /) , &
- HSUBROUTINE )
-!
-!-------------------------------------------------------------------------------
+ !-------------------------------------------------------------------------------
ENDDO
!
!----------------------------------------------------------------------------
diff --git a/src/SURFEX/read_assim_conf.F90 b/src/SURFEX/read_assim_conf.F90
index 2f772bd2c70ceffdc53d660c67271984ad73775f..143b5b37920e8775106387eb502ad12b83eb7b7e 100644
--- a/src/SURFEX/read_assim_conf.F90
+++ b/src/SURFEX/read_assim_conf.F90
@@ -43,7 +43,7 @@ USE MODN_ASSIM, ONLY : NAM_NACVEG,NAM_ASSIM,LASSIM,CASSIM,&
USE MODD_ASSIM, ONLY : NVAR,NOBSTYPE,XTPRT,XTPRT_M,XSIGMA,&
XSIGMA_M,CVAR,CVAR_M,COBS,NNCO,&
NVARMAX,NNCV,LASSIM,CASSIM_ISBA,LPRT,&
- NOBSMAX,XERROBS_M,XERROBS, &
+ NOBSMAX,COBS_M,XERROBS_M,XERROBS, &
XQCOBS_M,XQCOBS,&
XINFL_M,XINFL,XADDINFL_M,XADDINFL, &
XADDTIMECORR_M, XADDTIMECORR, NIE, &
@@ -62,7 +62,7 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
!
!* 0.2 Declarations of local variables
@@ -79,30 +79,30 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* get output listing file logical unit
!
IF (LHOOK) CALL DR_HOOK('READ_ASSIM_CONF',0,ZHOOK_HANDLE)
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
+CALL GET_LUOUT(HPROGRAM,ILUOUT)
!* open namelist file
- CALL OPEN_NAMELIST(HPROGRAM,INAM)
+CALL OPEN_NAMELIST(HPROGRAM,INAM)
!* reading of namelist
- CALL POSNAM(INAM,'NAM_ASSIM', GFOUND,ILUOUT)
+CALL POSNAM(INAM,'NAM_ASSIM', GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=INAM,NML=NAM_ASSIM)
- CALL POSNAM(INAM,'NAM_NACVEG', GFOUND,ILUOUT)
+CALL POSNAM(INAM,'NAM_NACVEG', GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=INAM,NML=NAM_NACVEG)
- CALL POSNAM(INAM,'NAM_IO_VARASSIM',GFOUND,ILUOUT)
+CALL POSNAM(INAM,'NAM_IO_VARASSIM',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=INAM,NML=NAM_IO_VARASSIM)
- CALL POSNAM(INAM,'NAM_OBS', GFOUND,ILUOUT)
+CALL POSNAM(INAM,'NAM_OBS', GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=INAM,NML=NAM_OBS)
- CALL POSNAM(INAM,'NAM_VAR', GFOUND,ILUOUT)
+CALL POSNAM(INAM,'NAM_VAR', GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=INAM,NML=NAM_VAR)
- CALL POSNAM(INAM,'NAM_ENS', GFOUND,ILUOUT)
+CALL POSNAM(INAM,'NAM_ENS', GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=INAM,NML=NAM_ENS)
!
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CASSIM',CASSIM,'PLUS ','2DVAR','AVERA')
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CASSIM_ISBA',CASSIM_ISBA,'OI ','EKF ','ENKF ')
+CALL TEST_NAM_VAR_SURF(ILUOUT,'CASSIM',CASSIM,'PLUS ','2DVAR','AVERA')
+CALL TEST_NAM_VAR_SURF(ILUOUT,'CASSIM_ISBA',CASSIM_ISBA,'OI ','EKF ','ENKF ')
!
!* close namelist file
- CALL CLOSE_NAMELIST(HPROGRAM,INAM)
+CALL CLOSE_NAMELIST(HPROGRAM,INAM)
! Set EKF setup based on namelist input
IF ( ( CASSIM_ISBA == "EKF" .AND. ( LASSIM.OR.LPRT ) ) .OR. &
@@ -126,6 +126,7 @@ IF ( ( CASSIM_ISBA == "EKF" .AND. ( LASSIM.OR.LPRT ) ) .OR. &
J = J + 1
ENDIF
ENDDO
+ CVAR = ADJUSTL(CVAR)
ENDIF
IF ( ( CASSIM_ISBA == "EKF" .AND. ( LASSIM.OR.LPRT ) ) .OR. &
@@ -143,21 +144,14 @@ IF ( ( CASSIM_ISBA == "EKF" .AND. ( LASSIM.OR.LPRT ) ) .OR. &
J = 1
DO I = 1,NOBSMAX
IF (NNCO(I) == 1 .AND. J <= NOBSTYPE ) THEN
- SELECT CASE (I)
- CASE (1)
- COBS(J) = 'T2M'
- CASE (2)
- COBS(J) = 'HU2M'
- CASE (3)
- COBS(J) = 'WG1'
- CASE (4)
- COBS(J) = 'LAI'
- CASE (5)
- COBS(J) = 'SWE'
- END SELECT
- XERROBS(J) = XERROBS_M(I)
- XQCOBS(J) = XQCOBS_M(I)
- J = J + 1
+ IF (J <= NOBSTYPE .AND. (TRIM(COBS_M(I)) == 'T2M' .OR. TRIM(COBS_M(I)) == 'HU2M' .OR. &
+ TRIM(COBS_M(I)) == 'WG1' .OR. TRIM(COBS_M(I)) == 'WG2' .OR. TRIM(COBS_M(I)) == 'LAI' .OR. &
+ TRIM(COBS_M(I)) == 'SWE') ) THEN
+ COBS(J) = TRIM(COBS_M(I))
+ XERROBS(J) = XERROBS_M(I)
+ XQCOBS(J) = XQCOBS_M(I)
+ J = J + 1
+ ENDIF
ENDIF
ENDDO
ENDIF
diff --git a/src/SURFEX/read_binllv.F90 b/src/SURFEX/read_binllv.F90
index f3ea4157f16861d89548c82dd6504e56532f5f28..2357330807b67fd2d8122f72c5442e3d2513ff8f 100644
--- a/src/SURFEX/read_binllv.F90
+++ b/src/SURFEX/read_binllv.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_BINLLV (USS, &
+ SUBROUTINE READ_BINLLV (UG, U, USS, &
HPROGRAM,HSUBROUTINE,HFILENAME)
! ##############################################################
!
@@ -30,8 +30,9 @@
! -----------
!
!
-!
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_PGD_GRID, ONLY : LLATLONMASK
!
@@ -49,8 +50,9 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
-!
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
CHARACTER(LEN=6), INTENT(IN) :: HSUBROUTINE ! Name of the subroutine to call
@@ -63,10 +65,17 @@ TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
INTEGER :: IGLB ! logical unit
!
INTEGER :: JLAT, JLON ! indexes of OLATLONMASK array
-REAL :: ZVALUE ! values of a data point
-REAL :: ZLAT ! latitude of data point
-REAL :: ZLON ! longitude of data point
!
+INTEGER, PARAMETER :: ILONG=1000
+!
+REAL*4 :: ZVALUER
+REAL, DIMENSION(ILONG) :: ZVALUE ! values of a data point
+REAL*4 :: ZLATR
+REAL, DIMENSION(ILONG) :: ZLAT ! latitude of data point
+REAL*4 :: ZLONR, ZLONR2
+REAL, DIMENSION(ILONG) :: ZLON ! longitude of data point
+!
+INTEGER :: ICPT, ISTAT
INTEGER :: ILUOUT ! output listing
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
@@ -79,6 +88,12 @@ IF (LHOOK) CALL DR_HOOK('READ_BINLLV',0,ZHOOK_HANDLE)
!
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
+ICPT = 0
+!
+ZLAT(:) = 0
+ZLON(:) = 0
+ZVALUE(:) = 0
+!
!----------------------------------------------------------------------------
DO
!----------------------------------------------------------------------------
@@ -86,32 +101,56 @@ DO
!* 3. Reading of a data point
! -----------------------
!
- READ(IGLB,END=99) ZLAT,ZLON,ZVALUE
+ READ(IGLB,IOSTAT=ISTAT) ZLATR,ZLONR,ZVALUER
!
!----------------------------------------------------------------------------
!
!* 4. Test if point is in the domain
! ------------------------------
!
- ZLON=ZLON+NINT((180.-ZLON)/360.)*360.
+ IF (ISTAT==0) THEN
+ !
+ ZLONR2=ZLONR+NINT((180.-ZLONR)/360.)*360.
+ !
+ JLAT = 1 + INT( ( ZLATR + 90. ) * 2. )
+ JLAT = MIN(JLAT,360)
+ JLON = 1 + INT( ( ZLONR2 ) * 2. )
+ JLON = MIN(JLON,720)
+ !
+ IF (.NOT. LLATLONMASK(JLON,JLAT)) CYCLE
+ !
+ ICPT = ICPT + 1
+ !
+ IF (ICPT<=ILONG) THEN
+ !
+ ZLAT (ICPT) = ZLATR
+ ZLON (ICPT) = ZLONR
+ ZVALUE(ICPT) = ZVALUER
+ !
+ ENDIF
+ !
+ ENDIF
+ !
+ IF (ISTAT==-1 .OR. ICPT==ILONG) THEN
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !* 5. Call to the adequate subroutine (point by point treatment)
+ ! ----------------------------------------------------------
+ !
+ CALL PT_BY_PT_TREATMENT(UG, U, USS, ILUOUT, &
+ ZLAT(1:ICPT), ZLON(1:ICPT), ZVALUE(1:ICPT), HSUBROUTINE )
+ !
+ ICPT = 0
+ ZLAT (:) = 0.
+ ZLON (:) = 0.
+ ZVALUE(:) = 0.
+ !
+ ENDIF
!
- JLAT = 1 + INT( ( ZLAT + 90. ) * 2. )
- JLAT = MIN(JLAT,360)
- JLON = 1 + INT( ( ZLON ) * 2. )
- JLON = MIN(JLON,720)
+ IF (ISTAT==-1) EXIT
!
- IF (.NOT. LLATLONMASK(JLON,JLAT)) CYCLE
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. Call to the adequate subroutine (point by point treatment)
-! ----------------------------------------------------------
-!
- CALL PT_BY_PT_TREATMENT(USS, &
- ILUOUT, (/ ZLAT /) , (/ ZLON /) , (/ ZVALUE /) , &
- HSUBROUTINE )
-!
-!-------------------------------------------------------------------------------
+ !-------------------------------------------------------------------------------
ENDDO
!
!----------------------------------------------------------------------------
@@ -119,7 +158,6 @@ ENDDO
!* 8. Closing of the data file
! ------------------------
!
-99 CONTINUE
CALL CLOSE_FILE (HPROGRAM,IGLB)
IF (LHOOK) CALL DR_HOOK('READ_BINLLV',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/read_binllvfast.F90 b/src/SURFEX/read_binllvfast.F90
index 66878e0e30ae551687ffa6d2c64f041f3c2d062b..93359d3f96383fe22bd4b09b52f34c9c680784bd 100644
--- a/src/SURFEX/read_binllvfast.F90
+++ b/src/SURFEX/read_binllvfast.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_BINLLVFAST (USS, &
+ SUBROUTINE READ_BINLLVFAST (UG, U, USS, &
HPROGRAM,HSUBROUTINE,HFILENAME)
! ##############################################################
!
@@ -34,8 +34,9 @@
! -----------
!
!
-!
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_PGD_GRID, ONLY : LLATLONMASK
@@ -55,7 +56,9 @@ IMPLICIT NONE
! ------------------------
!
!
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
CHARACTER(LEN=6), INTENT(IN) :: HSUBROUTINE ! Name of the subroutine to call
@@ -72,6 +75,7 @@ INTEGER :: ICPT ! number of data points to
REAL,DIMENSION(:,:),ALLOCATABLE,TARGET :: ZLLV ! ZLLV(1,:) :: latitude of data points
! ZLLV(2,:) :: longitude of data points
! ZLLV(3,:) :: value of data points
+REAL, DIMENSION(:), ALLOCATABLE :: ZLLV2
REAL,DIMENSION(:,:),POINTER :: ZLLVWORK ! point on ZLLV array
INTEGER :: JI ! loop counter
!
@@ -94,7 +98,8 @@ IF (LHOOK) CALL DR_HOOK('READ_BINLLVFAST',0,ZHOOK_HANDLE)
! -----------------------
!
READ(IGLB) INELT ! number of data points
-ALLOCATE(ZLLV(3,INELT))
+ALLOCATE(ZLLV (3,INELT))
+ALLOCATE(ZLLV2(INELT))
READ(IGLB) ZLLV
!
!----------------------------------------------------------------------------
@@ -102,13 +107,13 @@ READ(IGLB) ZLLV
!* 4. Test if point is in the domain
! ------------------------------
!
-ZLLV(2,:) = ZLLV(2,:)+NINT((180.-ZLLV(2,:))/360.)*360.
+ZLLV2(:) = ZLLV(2,:)+NINT((180.-ZLLV(2,:))/360.)*360.
!
ICPT = 0
DO JI=1,INELT
JLAT = 1 + INT( ( ZLLV(1,JI)+ 90. ) * 2. )
JLAT = MIN(JLAT,360)
- JLON = 1 + INT( ( ZLLV(2,JI) ) * 2. )
+ JLON = 1 + INT( ( ZLLV2(JI) ) * 2. )
JLON = MIN(JLON,720)
IF (LLATLONMASK(JLON,JLAT)) THEN
ICPT = ICPT+1
@@ -123,7 +128,7 @@ END DO
!
IF (ICPT > 0) THEN
ZLLVWORK=>ZLLV(:,1:ICPT)
- CALL PT_BY_PT_TREATMENT(USS, &
+ CALL PT_BY_PT_TREATMENT(UG, U, USS, &
ILUOUT,ZLLVWORK(1,:),ZLLVWORK(2,:),ZLLVWORK(3,:),HSUBROUTINE)
END IF
!
diff --git a/src/SURFEX/read_bld_descriptionn.F90 b/src/SURFEX/read_bld_descriptionn.F90
index e7c24c0d64e0b7dfb5f5dc2b740bcc345c9f82bb..10fe03f13c05c5ed94e71a79c4c849da4ddc7e8d 100644
--- a/src/SURFEX/read_bld_descriptionn.F90
+++ b/src/SURFEX/read_bld_descriptionn.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########################
- SUBROUTINE READ_BLD_DESCRIPTION_n (&
- BDD, &
- HPROGRAM)
+ SUBROUTINE READ_BLD_DESCRIPTION_n (BDD, HPROGRAM)
! #########################
!
!!
@@ -41,10 +39,6 @@
! -----------
!
!
-!
-!
-!
-!
USE MODD_BLD_DESCRIPTION_n, ONLY : BLD_DESC_t
!
USE MODI_READ_SURF
@@ -89,18 +83,15 @@ IF (LHOOK) CALL DR_HOOK('READ_BLD_DESCRIPTION_n',0,ZHOOK_HANDLE)
!* 1. Read file version
! -----------------
!
- CALL READ_SURF(&
- HPROGRAM,'VERSION',IVERSION,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'BUG',IBUGFIX,IRESP)
+ CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP)
!-------------------------------------------------------------------------------
!
!* 1. Read configuration variables of the descriptive data
! ----------------------------------------------------
!
ALLOCATE(ZWORK(7))
- CALL READ_SURF(&
- HPROGRAM,'BLD_DESC_CNF',ZWORK,IRESP,HDIR='-')
+ CALL READ_SURF(HPROGRAM,'BLD_DESC_CNF',ZWORK,IRESP,HDIR='-')
!
BDD%NDESC_BLD = NINT(ZWORK(1))
BDD%NDESC_AGE = NINT(ZWORK(2))
@@ -179,13 +170,12 @@ BDD%XDESC_FRAC_PANEL = 0. ! no solar panels for old versions of SURFEX
!* 3. Read descriptive data
! ---------------------
!
-ITOT=(21+3*BDD%NDESC_ROOF_LAYER+3*BDD%NDESC_ROAD_LAYER+3*BDD%NDESC_WALL_LAYER+3*BDD%NDESC_FLOOR_LAYER)*BDD%NDESC_CODE &
+ITOT = (21 + 3*BDD%NDESC_ROOF_LAYER + 3*BDD%NDESC_ROAD_LAYER + &
+ 3*BDD%NDESC_WALL_LAYER + 3*BDD%NDESC_FLOOR_LAYER) * BDD%NDESC_CODE &
+ 9*BDD%NDESC_USE + 2*BDD%NDESC_AGE + BDD%NDESC_BLD
ALLOCATE(ZWORK(ITOT))
!
- CALL READ_SURF(&
- HPROGRAM,'BLD_DESC_DAT',ZWORK,IRESP,HDIR='-')
-!
+ CALL READ_SURF(HPROGRAM,'BLD_DESC_DAT',ZWORK,IRESP,HDIR='-')
!
I1=0 ; I2=0
CALL UP_DESC_IND(BDD%NDESC_BLD) ; BDD%NDESC_BLD_LIST(:) = NINT(ZWORK(I1:I2))
@@ -268,7 +258,7 @@ DEALLOCATE(ZWORK)
!
IF (LHOOK) CALL DR_HOOK('READ_BLD_DESCRIPTION_n',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
SUBROUTINE UP_DESC_IND(K)
INTEGER, INTENT(IN) :: K
I1=I2+1
diff --git a/src/SURFEX/read_buffer.F90 b/src/SURFEX/read_buffer.F90
index 50af726ead2315a4a8ab12c79d5c8302cae40c22..9a23da41dc8111bbc46471557fbb90c1d18ed65f 100644
--- a/src/SURFEX/read_buffer.F90
+++ b/src/SURFEX/read_buffer.F90
@@ -88,6 +88,10 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+#ifdef SFX_ARO
+#include "get_bufc0.h"
+#endif
+!
!* 0.1 Declarations of arguments
! -------------------------
!
@@ -166,6 +170,10 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+#ifdef SFX_ARO
+#include "get_bufn0.h"
+#endif
+!
!* 0.1 Declarations of arguments
! -------------------------
!
@@ -244,6 +252,10 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+#ifdef SFX_ARO
+#include "get_bufn1.h"
+#endif
+!
!* 0.1 Declarations of arguments
! -------------------------
!
@@ -322,6 +334,10 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+#ifdef SFX_ARO
+#include "get_bufx0.h"
+#endif
+!
!* 0.1 Declarations of arguments
! -------------------------
!
@@ -400,6 +416,10 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+#ifdef SFX_ARO
+#include "get_bufx1.h"
+#endif
+!
!* 0.1 Declarations of arguments
! -------------------------
!
diff --git a/src/SURFEX/read_covern.F90 b/src/SURFEX/read_covern.F90
index 6bdddeab33afaa99467886302e642e9a5885d617..cdb974468cae8131cdd1a0b4e511f658e87cde64 100644
--- a/src/SURFEX/read_covern.F90
+++ b/src/SURFEX/read_covern.F90
@@ -106,17 +106,14 @@ IF (LASSIM) THEN
ENDIF
!
YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
!
ALLOCATE(U%LCOVER(JPCOVER))
- CALL READ_LCOVER(&
- HPROGRAM,U%LCOVER)
+ CALL READ_LCOVER(HPROGRAM,U%LCOVER)
!
!
ALLOCATE(U%XCOVER(U%NSIZE_FULL,COUNT(U%LCOVER)))
- CALL READ_SURF_COV(&
- HPROGRAM,'COVER',U%XCOVER(:,:),U%LCOVER,IRESP)
+ CALL READ_SURF_COV(HPROGRAM,'COVER',U%XCOVER(:,:),U%LCOVER,IRESP)
!
!* 2.1 Fractions :
! ---------
@@ -128,18 +125,13 @@ ALLOCATE(U%XTOWN (U%NSIZE_FULL))
!
IF (IVERSION>=7) THEN
!
- CALL READ_SURF(&
- HPROGRAM,'FRAC_SEA ',U%XSEA, IRESP)
- CALL READ_SURF(&
- HPROGRAM,'FRAC_NATURE',U%XNATURE,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'FRAC_WATER ',U%XWATER, IRESP)
- CALL READ_SURF(&
- HPROGRAM,'FRAC_TOWN ',U%XTOWN, IRESP)
+ CALL READ_SURF(HPROGRAM,'FRAC_SEA ',U%XSEA, IRESP)
+ CALL READ_SURF(HPROGRAM,'FRAC_NATURE',U%XNATURE,IRESP)
+ CALL READ_SURF(HPROGRAM,'FRAC_WATER ',U%XWATER, IRESP)
+ CALL READ_SURF(HPROGRAM,'FRAC_TOWN ',U%XTOWN, IRESP)
!
ELSE
- CALL CONVERT_COVER_FRAC(DTCO, &
- U%XCOVER,U%LCOVER,U%XSEA,U%XNATURE,U%XTOWN,U%XWATER)
+ CALL CONVERT_COVER_FRAC(DTCO,U%XCOVER,U%LCOVER,U%XSEA,U%XNATURE,U%XTOWN,U%XWATER)
ENDIF
!
!* 2.2 Orography :
@@ -148,8 +140,7 @@ ENDIF
!
ALLOCATE(U%XZS(U%NSIZE_FULL))
YRECFM='ZS'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,U%XZS(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,U%XZS(:),IRESP)
!
IF (LASSIM) LREAD_ALL = GREAD_ALL
!
diff --git a/src/SURFEX/read_covers_and_av_pgd_on_layers.F90 b/src/SURFEX/read_covers_and_av_pgd_on_layers.F90
deleted file mode 100644
index 91bdb4be37aaf17a363372c88bc762eb7183c824..0000000000000000000000000000000000000000
--- a/src/SURFEX/read_covers_and_av_pgd_on_layers.F90
+++ /dev/null
@@ -1,220 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ################################################################
- SUBROUTINE READ_COVERS_AND_AV_PGD_1D_ON_LAYERS(HFILEPGDTYPE,HRECFM,DTCO,KLU,KDATA_LAYER,PFIELD2D,&
- PDATA,HSFTYPE,HATYPE,PDZ,KDECADE)
-! ################################################################
-!!
-!! PURPOSE
-!! -------
-!!
-!! METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! M.Moge CNRS - LA
-!! inspired from AV_PGD_1D
-!!
-!! MODIFICATION
-!! ------------
-!
-!
-!! Original 06/05/2015
-!!
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_DATA_COVER, ONLY : XDATA_BLD_HEIGHT
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DATA_COVER_PAR, ONLY : XCDREF, JPCOVER,NVT_TRBD,NVT_TEBE,NVT_TEBD ,NVT_BOBD,&
- NVT_TENE,NVT_BONE,NVT_BOND,NVT_TRBE,NVT_SHRB
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODI_ABOR1_SFX
-!
-USE MODI_READ_SURF
-#ifdef SFX_MNH
-USE MODI_READ_SURFX2COV_1COV_MNH
-#endif
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-!
-CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! type of input file
-CHARACTER(LEN=LEN_HREC), INTENT(IN) :: HRECFM ! Name of the article to be read
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-INTEGER, INTENT(IN) :: KLU ! number of points
-INTEGER, INTENT(IN) :: KDATA_LAYER ! number of layers
-REAL, DIMENSION(KLU,KDATA_LAYER), INTENT(OUT) :: PFIELD2D ! secondary field to construct
-REAL, DIMENSION(JPCOVER,KDATA_LAYER), INTENT(IN) :: PDATA ! secondary field value for each class
-CHARACTER(LEN=3), INTENT(IN) :: HSFTYPE ! Type of surface where the field is defined
-CHARACTER(LEN=3), INTENT(IN) :: HATYPE ! Type of averaging
-REAL, DIMENSION(KLU), INTENT(IN), OPTIONAL :: PDZ ! first model half level
-INTEGER, INTENT(IN), OPTIONAL :: KDECADE ! current month
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-!
-INTEGER :: ICOVER ! number of cover classes
-INTEGER :: JCOVER ! loop on cover classes
-INTEGER :: JLAYER ! loop on layers
-!
-REAL, DIMENSION(KLU) :: ZWORK, ZDZ
-REAL :: ZWEIGHT
-REAL, DIMENSION(KLU) :: ZCOVER_WEIGHT
-REAL :: ZDATA_COVER
-REAL, DIMENSION(KLU) :: ZSUM_COVER_WEIGHT
-REAL, DIMENSION(KLU) :: ZWEIGHT_MAX
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-LOGICAL, DIMENSION(JPCOVER) :: GCOVER ! flag to read the covers
-REAL, DIMENSION(KLU) :: ZCOVER ! cover fractions
-CHARACTER(LEN=100) :: YCOMMENT
-INTEGER :: IRESP ! reading return code
-CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('READ_COVERS_AND_AV_PGD_1D_ON_LAYERS',0,ZHOOK_HANDLE)
-!
-!* 0.3 Initializations
-!
-IF (PRESENT(PDZ)) THEN
- ZDZ(:)=PDZ(:)
-ELSE
- ZDZ(:)=XCDREF
-END IF
-!
-PFIELD2D(:,:)=XUNDEF
-!
-!
-!* depths are deduced from the cover types
-!* reading of the cover to obtain the thickness of layers
-CALL READ_SURF(HFILEPGDTYPE,HRECFM,GCOVER(:),IRESP,HDIR='-')
-YRECFM='COVER'
-#ifdef SFX_MNH
-!
-! Loop on layers
-DO JLAYER=1,KDATA_LAYER
- ZWORK(:)=0.
- ZWEIGHT_MAX(:)=0.
- ZSUM_COVER_WEIGHT(:)=0.
- ! loop on covers
- DO JCOVER=1,JPCOVER
- !
- !* 1. depths are deduced from the cover types
- ! reading of the cover to obtain the thickness of layers
- !
- IF ( GCOVER( JCOVER ) ) THEN
- CALL READ_SURFX2COV_1COV_MNH(YRECFM,KLU,JCOVER,ZCOVER(:),IRESP,YCOMMENT,'A')
- ELSE
- ZCOVER(:) = 0.
- ENDIF
- !
- !* 2. averaging
- !
- ! 2.1. Selection of the weighting function
- SELECT CASE (HSFTYPE)
- CASE('ALL')
- ZWEIGHT=1.
- CASE('NAT')
- ZWEIGHT=DTCO%XDATA_NATURE(JCOVER)
- CASE('GRD')
- ZWEIGHT=DTCO%XDATA_TOWN (JCOVER) * DTCO%XDATA_GARDEN(JCOVER)
- CASE('TWN')
- ZWEIGHT=DTCO%XDATA_TOWN (JCOVER)
- CASE('WAT')
- ZWEIGHT=DTCO%XDATA_WATER (JCOVER)
- CASE('SEA')
- ZWEIGHT=DTCO%XDATA_SEA (JCOVER)
- CASE('BLD')
- ZWEIGHT=DTCO%XDATA_TOWN (JCOVER) * DTCO%XDATA_BLD(JCOVER)
- CASE('BLV') !* building Volume
- ZWEIGHT=DTCO%XDATA_TOWN (JCOVER) * DTCO%XDATA_BLD(JCOVER) * XDATA_BLD_HEIGHT(JCOVER)
- CASE('STR')
- ZWEIGHT=DTCO%XDATA_TOWN (JCOVER) * ( 1. - DTCO%XDATA_BLD(JCOVER) )
- CASE('TRE')
- ZWEIGHT=DTCO%XDATA_NATURE(JCOVER) * ( DTCO%XDATA_VEGTYPE(JCOVER,NVT_TRBD) &
- + DTCO%XDATA_VEGTYPE(JCOVER,NVT_TEBE) + DTCO%XDATA_VEGTYPE(JCOVER,NVT_TEBD) &
- + DTCO%XDATA_VEGTYPE(JCOVER,NVT_BOBD) + DTCO%XDATA_VEGTYPE(JCOVER,NVT_SHRB) &
- + DTCO%XDATA_VEGTYPE(JCOVER,NVT_TRBE) + DTCO%XDATA_VEGTYPE(JCOVER,NVT_TENE) &
- + DTCO%XDATA_VEGTYPE(JCOVER,NVT_BONE) + DTCO%XDATA_VEGTYPE(JCOVER,NVT_BOND) )
- CASE('GRT')
- ZWEIGHT=DTCO%XDATA_TOWN(JCOVER) * DTCO%XDATA_GARDEN(JCOVER) * ( DTCO%XDATA_VEGTYPE(JCOVER,NVT_TRBD) &
- + DTCO%XDATA_VEGTYPE(JCOVER,NVT_TEBE) + DTCO%XDATA_VEGTYPE(JCOVER,NVT_TEBD) &
- + DTCO%XDATA_VEGTYPE(JCOVER,NVT_BOBD) + DTCO%XDATA_VEGTYPE(JCOVER,NVT_SHRB) &
- + DTCO%XDATA_VEGTYPE(JCOVER,NVT_TRBE) + DTCO%XDATA_VEGTYPE(JCOVER,NVT_TENE) &
- + DTCO%XDATA_VEGTYPE(JCOVER,NVT_BONE) + DTCO%XDATA_VEGTYPE(JCOVER,NVT_BOND) )
- CASE DEFAULT
- CALL ABOR1_SFX('AV_PGD_1D: WEIGHTING FUNCTION NOT ALLOWED '//HSFTYPE)
- END SELECT
- ! 2.2. Averaging
- ZCOVER_WEIGHT(:) = ZCOVER(:) * ZWEIGHT
- ZSUM_COVER_WEIGHT(:) = ZSUM_COVER_WEIGHT(:) + ZCOVER_WEIGHT(:)
- ZDATA_COVER = PDATA(JCOVER,JLAYER)
- SELECT CASE (HATYPE)
- CASE ('ARI')
- ZWORK(:) = ZWORK(:) + ZDATA_COVER * ZCOVER_WEIGHT(:)
- CASE('INV' )
- ZWORK (:)= ZWORK(:) + 1./ZDATA_COVER * ZCOVER_WEIGHT(:)
- CASE('CDN')
- ZWORK (:)= ZWORK(:) + 1./(LOG(ZDZ(:)/ZDATA_COVER))**2 * ZCOVER_WEIGHT(:)
- CASE('MAJ' )
- WHERE(ZCOVER_WEIGHT(:)>ZWEIGHT_MAX(:))
- ZWEIGHT_MAX(:) = ZCOVER_WEIGHT(:)
- ZWORK (:) = ZDATA_COVER
- END WHERE
- CASE DEFAULT
- CALL ABOR1_SFX('AV_PGD_1D: (1) AVERAGING TYPE NOT ALLOWED : "'//HATYPE//'"')
- END SELECT
- !
- END DO ! DO JCOVER=1,JPCOVER
- !
- ! 2.3. End of Averaging
- SELECT CASE (HATYPE)
- CASE ('ARI')
- WHERE ( ZSUM_COVER_WEIGHT(:) >0. )
- PFIELD2D(:,JLAYER) = ZWORK(:) / ZSUM_COVER_WEIGHT(:)
- END WHERE
- CASE('INV' )
- WHERE ( ZSUM_COVER_WEIGHT(:) >0. )
- PFIELD2D(:,JLAYER) = ZSUM_COVER_WEIGHT(:) / ZWORK(:)
- END WHERE
- CASE('CDN')
- WHERE ( ZSUM_COVER_WEIGHT(:) >0. )
- PFIELD2D(:,JLAYER) = ZDZ(:) * EXP( - SQRT(ZSUM_COVER_WEIGHT(:)/ZWORK(:)) )
- END WHERE
- CASE('MAJ' )
- WHERE ( ZSUM_COVER_WEIGHT(:) >0. )
- PFIELD2D(:,JLAYER) = ZWORK(:)
- END WHERE
- CASE DEFAULT
- CALL ABOR1_SFX('AV_PGD_1D: (2) AVERAGING TYPE NOT ALLOWED')
- END SELECT
-!
-END DO !DO JLAYER=1,KDATA_LAYER
-#endif
-!
-IF (LHOOK) CALL DR_HOOK('READ_COVERS_AND_AV_PGD_1D_ON_LAYERS',1,ZHOOK_HANDLE)
-!-------------------------------------------------------------------------------
-END SUBROUTINE READ_COVERS_AND_AV_PGD_1D_ON_LAYERS
diff --git a/src/SURFEX/read_covers_param.F90 b/src/SURFEX/read_covers_param.F90
index 86f87bdf3d5dc271fa2998bcebeedb0263530d73..f5ab16f65cb1f496a3f280f33ca09e21845a85e5 100644
--- a/src/SURFEX/read_covers_param.F90
+++ b/src/SURFEX/read_covers_param.F90
@@ -159,11 +159,11 @@ DO JCOVER = 1,INB_COVER
IF (XDATA_GARDEN(ICOVER).NE.0. .AND. XDATA_NATURE(ICOVER).EQ.0.) CALL READ_NATURE
ENDIF
ENDDO
- CLOSE(41)
+CLOSE(41)
!
IF (LHOOK) CALL DR_HOOK('READ_COVERS_PARAM',1,ZHOOK_HANDLE)
!------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!
SUBROUTINE READ_NATURE
!
diff --git a/src/SURFEX/read_csvdata_teb.F90 b/src/SURFEX/read_csvdata_teb.F90
index 13a277c591ac0c443008923818e5e46988590ded..53b2ae09eb41a579b01508095f9b124b037e74f6 100644
--- a/src/SURFEX/read_csvdata_teb.F90
+++ b/src/SURFEX/read_csvdata_teb.F90
@@ -448,7 +448,7 @@ ALLOCATE(BDD%XDESC_NATVENT(BDD%NDESC_USE))
!
!* fraction of residential use for the buildings
ALLOCATE(BDD%XDESC_RESIDENTIAL(BDD%NDESC_USE))
- CALL READ_CONF_IN_CSVFILE("Residentiel",IRES)
+CALL READ_CONF_IN_CSVFILE("Residentiel",IRES)
BDD%XDESC_RESIDENTIAL(:) = 0.
DO JUSE=1,BDD%NDESC_USE
IF (JUSE==IRES) BDD%XDESC_RESIDENTIAL(JUSE) = 1.
@@ -482,7 +482,7 @@ BDD%XDESC_D_ROAD(:,3:) = 1.
!
IF (LHOOK) CALL DR_HOOK('READ_CSVDATA_TEB',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
!
FUNCTION BLD_CODE(KBLD,KAGE)
diff --git a/src/SURFEX/read_default_flaken.F90 b/src/SURFEX/read_default_flaken.F90
index 7c367d225030c3df550811e53f45d910dccaf8c5..b6e5c872f5a26fe9d06c44fb83fa6e2633ea876d 100644
--- a/src/SURFEX/read_default_flaken.F90
+++ b/src/SURFEX/read_default_flaken.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_DEFAULT_FLAKE_n (CHF, DGF, DGMF, F, &
- HPROGRAM)
+ SUBROUTINE READ_DEFAULT_FLAKE_n (CHF, DGO, DMF, F, HPROGRAM)
! #############################################################
!
!!**** *READ_FLAKE_CONF* - routine to read the configuration for FLAKE
@@ -45,7 +44,7 @@
!
!
USE MODD_CH_FLAKE_n, ONLY : CH_FLAKE_t
-USE MODD_DIAG_FLAKE_n, ONLY : DIAG_FLAKE_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
USE MODD_DIAG_MISC_FLAKE_n, ONLY : DIAG_MISC_FLAKE_t
USE MODD_FLAKE_n, ONLY : FLAKE_t
!
@@ -71,8 +70,8 @@ IMPLICIT NONE
!
!
TYPE(CH_FLAKE_t), INTENT(INOUT) :: CHF
-TYPE(DIAG_FLAKE_t), INTENT(INOUT) :: DGF
-TYPE(DIAG_MISC_FLAKE_t), INTENT(INOUT) :: DGMF
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_MISC_FLAKE_t), INTENT(INOUT) :: DMF
TYPE(FLAKE_t), INTENT(INOUT) :: F
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling ISBA
@@ -103,8 +102,8 @@ IMI=GET_CURRENT_MODEL_INDEX_SURFEX()
!
IF (IMI.NE.-1 .AND. LNAM_READ) THEN
CALL INIT_NAM_FLAKEn(F)
- CALL INIT_NAM_DIAG_SURFn(DGF)
- CALL INIT_NAM_DIAG_FLAKEn(DGMF)
+ CALL INIT_NAM_DIAG_SURFn(DGO)
+ CALL INIT_NAM_DIAG_FLAKEn(DMF)
CALL INIT_NAM_CH_FLAKEn(CHF)
ENDIF
!
@@ -128,8 +127,8 @@ ENDIF
!
IF (IMI.NE.-1) THEN
CALL UPDATE_NAM_FLAKEn(F)
- CALL UPDATE_NAM_DIAG_SURFn(DGF)
- CALL UPDATE_NAM_DIAG_FLAKEn(DGMF)
+ CALL UPDATE_NAM_DIAG_SURFn(DGO)
+ CALL UPDATE_NAM_DIAG_FLAKEn(DMF)
CALL UPDATE_NAM_CH_FLAKEn(CHF)
ENDIF
IF (LHOOK) CALL DR_HOOK('READ_DEFAULT_FLAKE_N',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/read_default_idealn.F90 b/src/SURFEX/read_default_idealn.F90
index 25ebb37172fd7ac520f349560d9c889a7c527857..fa2b7d5dd8191615e5669166bee68047c5881a88 100644
--- a/src/SURFEX/read_default_idealn.F90
+++ b/src/SURFEX/read_default_idealn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_DEFAULT_IDEAL_n (DGL, &
- HPROGRAM)
+ SUBROUTINE READ_DEFAULT_IDEAL_n (DGO, HPROGRAM)
! #############################################################
!
!!**** *READ_IDEAL_CONF* - routine to read the configuration for IDEAL
@@ -41,7 +40,7 @@
!
!
!
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
USE MODE_MODELN_SURFEX_HANDLER
!
@@ -63,7 +62,7 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling ISBA
!
@@ -88,7 +87,7 @@ IF (ILUDES==0) RETURN
!
IMI=GET_CURRENT_MODEL_INDEX_SURFEX()
!
-IF (IMI.NE.-1 .AND. LNAM_READ) CALL INIT_NAM_DIAG_SURFn(DGL)
+IF (IMI.NE.-1 .AND. LNAM_READ) CALL INIT_NAM_DIAG_SURFn(DGO)
IF (LNAM_READ) THEN
!
@@ -100,7 +99,7 @@ IF (LNAM_READ) THEN
!
ENDIF
!
-IF (IMI.NE.-1) CALL UPDATE_NAM_DIAG_SURFn(DGL)
+IF (IMI.NE.-1) CALL UPDATE_NAM_DIAG_SURFn(DGO)
IF (LHOOK) CALL DR_HOOK('READ_DEFAULT_IDEAL_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/read_default_isban.F90 b/src/SURFEX/read_default_isban.F90
index bb35954f37332aeefe2096ac4c3c9bf385f84595..6691723df978260eb55a2e13ffbe5c36622650e6 100644
--- a/src/SURFEX/read_default_isban.F90
+++ b/src/SURFEX/read_default_isban.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_DEFAULT_ISBA_n (CHI, DGEI, DGI, DGMI, I, &
- HPROGRAM)
+ SUBROUTINE READ_DEFAULT_ISBA_n (CHI, DE, DGO, DMI, IO, HPROGRAM)
! #######################################################
!
!!**** *READ_ISBA_CONF* - routine to read the configuration for ISBA
@@ -44,9 +43,9 @@
!
USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
-USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
USE MODE_MODELN_SURFEX_HANDLER
!
@@ -70,10 +69,10 @@ IMPLICIT NONE
!
!
TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
-TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DGEI
-TYPE(DIAG_ISBA_t), INTENT(INOUT) :: DGI
-TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DGMI
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DE
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMI
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling ISBA
@@ -100,15 +99,15 @@ IF (ILUDES==0) RETURN
IMI=GET_CURRENT_MODEL_INDEX_SURFEX()
!
IF (IMI.NE.-1 .AND. LNAM_READ) THEN
- CALL INIT_NAM_ISBAn(I)
- CALL INIT_NAM_ISBA_AGSn(I)
- CALL INIT_NAM_SGH_ISBAn(I)
- CALL INIT_NAM_DIAG_SURFn(DGEI, DGI)
- CALL INIT_NAM_DIAG_ISBAn(DGEI, DGI, DGMI)
+ CALL INIT_NAM_ISBAn(IO)
+ CALL INIT_NAM_ISBA_AGSn(IO)
+ CALL INIT_NAM_SGH_ISBAn(IO)
+ CALL INIT_NAM_DIAG_SURFn(DGO)
+ CALL INIT_NAM_DIAG_ISBAn(DE, DGO, DMI)
CALL INIT_NAM_CH_CONTROLn(CHI)
CALL INIT_NAM_CH_ISBAn(CHI)
- CALL INIT_NAM_SPINUP_CARB_ISBAn(I)
- CALL INIT_NAM_ISBA_SNOWn(I)
+ CALL INIT_NAM_SPINUP_CARB_ISBAn(IO)
+ CALL INIT_NAM_ISBA_SNOWn(IO)
ENDIF
!
IF (LNAM_READ) THEN
@@ -137,15 +136,15 @@ IF (LNAM_READ) THEN
ENDIF
IF (IMI.NE.-1) THEN
- CALL UPDATE_NAM_ISBAn(I)
- CALL UPDATE_NAM_ISBA_AGSn(I)
- CALL UPDATE_NAM_SGH_ISBAn(I)
- CALL UPDATE_NAM_DIAG_SURFn(DGEI, DGI)
- CALL UPDATE_NAM_DIAG_ISBAn(DGEI, DGI, DGMI)
+ CALL UPDATE_NAM_ISBAn(IO)
+ CALL UPDATE_NAM_ISBA_AGSn(IO)
+ CALL UPDATE_NAM_SGH_ISBAn(IO)
+ CALL UPDATE_NAM_DIAG_SURFn(DGO)
+ CALL UPDATE_NAM_DIAG_ISBAn(DE, DGO, DMI)
CALL UPDATE_NAM_CH_CONTROLn(CHI)
CALL UPDATE_NAM_CH_ISBAn(CHI)
- CALL UPDATE_NAM_SPINUP_CARB_ISBAn(I)
- CALL UPDATE_NAM_ISBA_SNOWn(I)
+ CALL UPDATE_NAM_SPINUP_CARB_ISBAn(IO)
+ CALL UPDATE_NAM_ISBA_SNOWn(IO)
ENDIF
IF (LHOOK) CALL DR_HOOK('READ_DEFAULT_ISBA_N',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/read_default_seafluxn.F90 b/src/SURFEX/read_default_seafluxn.F90
index 277ba5bf865f1ff905b3d2713afecc5054eff53b..6bf175ae5e0716afe15ada87858cd9b307ae7a6f 100644
--- a/src/SURFEX/read_default_seafluxn.F90
+++ b/src/SURFEX/read_default_seafluxn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_DEFAULT_SEAFLUX_n (CHS, DGO, DGS, DGSI, O, S, &
- HPROGRAM)
+ SUBROUTINE READ_DEFAULT_SEAFLUX_n (CHS, DOC, DGO, DGMSI, O, S, HPROGRAM)
! #############################################################
!
!!**** *READ_SEAFLUX_CONF* - routine to read the configuration for SEAFLUX
@@ -49,8 +48,8 @@
!
USE MODD_CH_SEAFLUX_n, ONLY : CH_SEAFLUX_t
USE MODD_DIAG_OCEAN_n, ONLY : DIAG_OCEAN_t
-USE MODD_DIAG_SEAFLUX_n, ONLY : DIAG_SEAFLUX_t
-USE MODD_DIAG_SEAICE_n, ONLY : DIAG_SEAICE_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
+USE MODD_DIAG_MISC_SEAICE_n, ONLY : DIAG_MISC_SEAICE_t
USE MODD_OCEAN_n, ONLY : OCEAN_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
!
@@ -75,9 +74,9 @@ IMPLICIT NONE
!
!
TYPE(CH_SEAFLUX_t), INTENT(INOUT) :: CHS
-TYPE(DIAG_OCEAN_t), INTENT(INOUT) :: DGO
-TYPE(DIAG_SEAFLUX_t), INTENT(INOUT) :: DGS
-TYPE(DIAG_SEAICE_t), INTENT(INOUT) :: DGSI
+TYPE(DIAG_OCEAN_t), INTENT(INOUT) :: DOC
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_MISC_SEAICE_t), INTENT(INOUT) :: DGMSI
TYPE(OCEAN_t), INTENT(INOUT) :: O
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
!
@@ -106,10 +105,10 @@ IMI=GET_CURRENT_MODEL_INDEX_SURFEX()
!
IF (IMI.NE.-1 .AND. LNAM_READ) THEN
CALL INIT_NAM_SEAFLUXn(O, S)
- CALL INIT_NAM_DIAG_SURFn(DGS)
+ CALL INIT_NAM_DIAG_SURFn(DGO)
CALL INIT_NAM_CH_SEAFLUXn(CHS)
- CALL INIT_NAM_DIAG_OCEANn(DGO)
- CALL INIT_NAM_SEAICEn(DGSI, S)
+ CALL INIT_NAM_DIAG_OCEANn(DOC)
+ CALL INIT_NAM_SEAICEn(DGMSI, S)
ENDIF
!
IF (LNAM_READ) THEN
@@ -141,10 +140,10 @@ ENDIF
!
IF (IMI.NE.-1) THEN
CALL UPDATE_NAM_SEAFLUXn(O, S)
- CALL UPDATE_NAM_DIAG_SURFn(DGS)
+ CALL UPDATE_NAM_DIAG_SURFn(DGO)
CALL UPDATE_NAM_CH_SEAFLUXn(CHS)
- CALL UPDATE_NAM_DIAG_OCEANn(DGO)
- CALL UPDATE_NAM_SEAICEn(DGSI, S)
+ CALL UPDATE_NAM_DIAG_OCEANn(DOC)
+ CALL UPDATE_NAM_SEAICEn(DGMSI, S)
ENDIF
IF (LHOOK) CALL DR_HOOK('READ_DEFAULT_SEAFLUX_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/read_default_surf_atmn.F90 b/src/SURFEX/read_default_surf_atmn.F90
index 3c9c8603603d2241b70e8185f54ad34eb6b78fb4..a9970ba4b6a43b27dde2550c062ba7091df98e86 100644
--- a/src/SURFEX/read_default_surf_atmn.F90
+++ b/src/SURFEX/read_default_surf_atmn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_DEFAULT_SURF_ATM_n (CHU, DGU, USS, &
- HPROGRAM)
+ SUBROUTINE READ_DEFAULT_SURF_ATM_n (CHU, DGO, USS, HPROGRAM)
! #######################################################
!
!!**** *READ_DEFAULT_SURF_ATM* - routine to read the default general configuration for surface
@@ -43,8 +42,8 @@
!
!
USE MODD_CH_SURF_n, ONLY : CH_SURF_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODE_MODELN_SURFEX_HANDLER
!
@@ -69,8 +68,8 @@ IMPLICIT NONE
!
!
TYPE(CH_SURF_t), INTENT(INOUT) :: CHU
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling GROUND
!
@@ -99,9 +98,9 @@ IF (IMI.NE.-1 .AND. LNAM_READ) THEN
CALL INIT_NAM_SSOn(USS)
CALL INIT_NAM_CH_CONTROLn(CHU)
CALL INIT_NAM_CH_SURFn(CHU)
- CALL INIT_NAM_DIAG_SURF_ATMn(DGU)
- CALL INIT_NAM_DIAG_SURFn(DGU)
- CALL INIT_NAM_WRITE_DIAG_SURFn(DGU)
+ CALL INIT_NAM_DIAG_SURF_ATMn(DGO)
+ CALL INIT_NAM_DIAG_SURFn(DGO)
+ CALL INIT_NAM_WRITE_DIAG_SURFn(DGO)
ENDIF
!
IF (LNAM_READ) THEN
@@ -128,9 +127,9 @@ IF (IMI.NE.-1) THEN
CALL UPDATE_NAM_SSOn(USS)
CALL UPDATE_NAM_CH_CONTROLn(CHU)
CALL UPDATE_NAM_CH_SURFn(CHU)
- CALL UPDATE_NAM_DIAG_SURF_ATMn(DGU)
- CALL UPDATE_NAM_DIAG_SURFn(DGU)
- CALL UPDATE_NAM_WRITE_DIAG_SURFn(DGU)
+ CALL UPDATE_NAM_DIAG_SURF_ATMn(DGO)
+ CALL UPDATE_NAM_DIAG_SURFn(DGO)
+ CALL UPDATE_NAM_WRITE_DIAG_SURFn(DGO)
ENDIF
IF (LHOOK) CALL DR_HOOK('READ_DEFAULT_SURF_ATM_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/read_default_teb_vegn.F90 b/src/SURFEX/read_default_teb_vegn.F90
index 467f8722e8d6f0f3a99664300b4949ed8b167454..2d7a9510a2da54b20afe04852912b61b2d5b5dc8 100644
--- a/src/SURFEX/read_default_teb_vegn.F90
+++ b/src/SURFEX/read_default_teb_vegn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_DEFAULT_TEB_VEG_n (CHT, TVG, &
- HPROGRAM)
+ SUBROUTINE READ_DEFAULT_TEB_VEG_n (CHT, IO, HPROGRAM)
! #######################################################
!
!!**** *READ_DEFAULT_TEB_VEG* - routine to read the configuration for VEGs
@@ -42,7 +41,7 @@
!
!
USE MODD_CH_TEB_n, ONLY : CH_TEB_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
USE MODE_MODELN_SURFEX_HANDLER
!
@@ -65,7 +64,7 @@ IMPLICIT NONE
!
!
TYPE(CH_TEB_t), INTENT(INOUT) :: CHT
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling ISBA
@@ -92,11 +91,11 @@ IF (ILUDES==0) RETURN
IMI=GET_CURRENT_MODEL_INDEX_SURFEX()
!
IF (IMI.NE.-1 .AND. LNAM_READ) THEN
- CALL INIT_NAM_TEB_VEGn(TVG)
- CALL INIT_NAM_TEB_VEG_AGSn(TVG)
+ CALL INIT_NAM_TEB_VEGn(IO)
+ CALL INIT_NAM_TEB_VEG_AGSn(IO)
CALL INIT_NAM_CH_CONTROLn(CHT)
CALL INIT_NAM_CH_TEB_VEGn(CHT)
- CALL INIT_NAM_SGH_TEB_VEGn(TVG)
+ CALL INIT_NAM_SGH_TEB_VEGn(IO)
ENDIF
!
IF (LNAM_READ) THEN
@@ -119,11 +118,11 @@ IF (LNAM_READ) THEN
ENDIF
!
IF (IMI.NE.-1) THEN
- CALL UPDATE_NAM_TEB_VEGn(TVG)
- CALL UPDATE_NAM_TEB_VEG_AGSn(TVG)
+ CALL UPDATE_NAM_TEB_VEGn(IO)
+ CALL UPDATE_NAM_TEB_VEG_AGSn(IO)
CALL UPDATE_NAM_CH_CONTROLn(CHT)
CALL UPDATE_NAM_CH_TEB_VEGn(CHT)
- CALL UPDATE_NAM_SGH_TEB_VEGn(TVG)
+ CALL UPDATE_NAM_SGH_TEB_VEGn(IO)
ENDIF
IF (LHOOK) CALL DR_HOOK('READ_DEFAULT_TEB_VEG_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/read_default_tebn.F90 b/src/SURFEX/read_default_tebn.F90
index b71626364f372140c84e159982cae5b4e06a82cb..543b975dc366d9f81d49e73a74d7ef494fb80351 100644
--- a/src/SURFEX/read_default_tebn.F90
+++ b/src/SURFEX/read_default_tebn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_DEFAULT_TEB_n (CHT, DGMTO, DGT, DGUT, TGRO, T, TOP, &
- HPROGRAM)
+ SUBROUTINE READ_DEFAULT_TEB_n (CHT, DMTO, DGO, DUT, IO, T, TOP, HPROGRAM)
! #######################################################
!
!!**** *READ_TEB_CONF* - routine to read the configuration for TEB
@@ -39,16 +38,11 @@
! ------------
!
!
-!
-!
-!
-!
-!
USE MODD_CH_TEB_n, ONLY : CH_TEB_t
-USE MODD_DIAG_MISC_TEB_OPTION_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
-USE MODD_DIAG_TEB_n, ONLY : DIAG_TEB_t
+USE MODD_DIAG_MISC_TEB_OPTIONS_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
USE MODD_DIAG_UTCI_TEB_n, ONLY : DIAG_UTCI_TEB_t
-USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
USE MODD_TEB_n, ONLY : TEB_t
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
!
@@ -74,10 +68,10 @@ IMPLICIT NONE
!
!
TYPE(CH_TEB_t), INTENT(INOUT) :: CHT
-TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: DGMTO
-TYPE(DIAG_TEB_t), INTENT(INOUT) :: DGT
-TYPE(DIAG_UTCI_TEB_t), INTENT(INOUT) :: DGUT
-TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: TGRO
+TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: DMTO
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_UTCI_TEB_t), INTENT(INOUT) :: DUT
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
TYPE(TEB_t), INTENT(INOUT) :: T
TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
!
@@ -107,10 +101,10 @@ IMI=GET_CURRENT_MODEL_INDEX_SURFEX()
!
IF (IMI.NE.-1 .AND. LNAM_READ) THEN
CALL INIT_NAM_TEBn(T, TOP)
- CALL INIT_NAM_DIAG_SURFn(DGT, TOP)
- CALL INIT_NAM_DIAG_TEBn(DGMTO, DGT, DGUT)
+ CALL INIT_NAM_DIAG_SURFn(DGO, TOP)
+ CALL INIT_NAM_DIAG_TEBn(DMTO, DGO, DUT)
CALL INIT_NAM_CH_TEBn(CHT)
- CALL INIT_NAM_TEB_GREENROOFn(TGRO)
+ CALL INIT_NAM_TEB_GREENROOFn(IO)
ENDIF
!
IF (LNAM_READ) THEN
@@ -133,10 +127,10 @@ ENDIF
!
IF (IMI.NE.-1) THEN
CALL UPDATE_NAM_TEBn(T, TOP)
- CALL UPDATE_NAM_DIAG_SURFn(DGT)
- CALL UPDATE_NAM_DIAG_TEBn(DGMTO, DGT, DGUT)
+ CALL UPDATE_NAM_DIAG_SURFn(DGO)
+ CALL UPDATE_NAM_DIAG_TEBn(DMTO, DGO, DUT)
CALL UPDATE_NAM_CH_TEBn(CHT)
- CALL UPDATE_NAM_TEB_GREENROOFn(TGRO)
+ CALL UPDATE_NAM_TEB_GREENROOFn(IO)
ENDIF
IF (LHOOK) CALL DR_HOOK('READ_DEFAULT_TEB_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/read_default_watfluxn.F90 b/src/SURFEX/read_default_watfluxn.F90
index 2d59afeaafca7178684fc5a39fb7b2f30ec8b68d..74002463538c2ce7ae3734d97e999ecf5eab5513 100644
--- a/src/SURFEX/read_default_watfluxn.F90
+++ b/src/SURFEX/read_default_watfluxn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_DEFAULT_WATFLUX_n (CHW, DGW, W, &
- HPROGRAM)
+ SUBROUTINE READ_DEFAULT_WATFLUX_n (CHW, DGO, W, HPROGRAM)
! #############################################################
!
!!**** *READ_WATFLUX_CONF* - routine to read the configuration for WATFLUX
@@ -43,7 +42,7 @@
!
!
USE MODD_CH_WATFLUX_n, ONLY : CH_WATFLUX_t
-USE MODD_DIAG_WATFLUX_n, ONLY : DIAG_WATFLUX_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
USE MODD_WATFLUX_n, ONLY : WATFLUX_t
!
USE MODE_MODELN_SURFEX_HANDLER
@@ -67,7 +66,7 @@ IMPLICIT NONE
!
!
TYPE(CH_WATFLUX_t), INTENT(INOUT) :: CHW
-TYPE(DIAG_WATFLUX_t), INTENT(INOUT) :: DGW
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
TYPE(WATFLUX_t), INTENT(INOUT) :: W
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling ISBA
@@ -94,7 +93,7 @@ IMI=GET_CURRENT_MODEL_INDEX_SURFEX()
!
IF (IMI.NE.-1 .AND. LNAM_READ) THEN
CALL INIT_NAM_WATFLUXn(W)
- CALL INIT_NAM_DIAG_SURFn(DGW)
+ CALL INIT_NAM_DIAG_SURFn(DGO)
CALL INIT_NAM_CH_WATFLUXn(CHW)
ENDIF
!
@@ -117,7 +116,7 @@ ENDIF
!
IF (IMI.NE.-1) THEN
CALL UPDATE_NAM_WATFLUXn(W)
- CALL UPDATE_NAM_DIAG_SURFn(DGW)
+ CALL UPDATE_NAM_DIAG_SURFn(DGO)
CALL UPDATE_NAM_CH_WATFLUXn(CHW)
ENDIF
IF (LHOOK) CALL DR_HOOK('READ_DEFAULT_WATFLUX_N',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/read_direct.F90 b/src/SURFEX/read_direct.F90
index 0f192051e52b6ed5cbc1ba8c32cf9a6232204296..e82aa9e3dcfdd118be26cb6c22dda5dff3cd2925 100644
--- a/src/SURFEX/read_direct.F90
+++ b/src/SURFEX/read_direct.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_DIRECT (USS, &
- HPROGRAM,HSCHEME,HSUBROUTINE,HFILENAME,HFIELD)
+ SUBROUTINE READ_DIRECT (UG, U, USS, &
+ HPROGRAM,HSCHEME,HSUBROUTINE,HFILENAME,HFIELD,OMULTITYPE)
! #########################################################
!
!!**** *READ_DIRECT1* reads a latlon file and call treatment subroutine
@@ -41,14 +41,19 @@
!* 0. DECLARATION
! -----------
!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC, NPIO
!
-!
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_PGD_GRID, ONLY : LLATLONMASK, XMESHLENGTH
!
USE MODD_ARCH, ONLY : LITTLE_ENDIAN_ARCH
!
+USE MODD_DATA_COVER_PAR, ONLY : JPCOVER, NTYPE
+!
USE MODI_GET_LUOUT
USE MODI_OPEN_NAMELIST
USE MODI_CLOSE_NAMELIST
@@ -59,13 +64,17 @@ USE MODI_INI_SSOWORK
USE MODI_PT_BY_PT_TREATMENT
USE MODE_CHAR2REAL
!
+USE MODI_UNCOMPRESS_FIELD
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
USE MODI_ABOR1_SFX
!
+USE MODD_PGDWORK, ONLY : NSIZE_ALL, XALL, NVALNBR, NVALCOUNT, XVALLIST, &
+ CATYPE, JPVALMAX
USE MODI_REFRESH_PGDWORK
+!
USE MODD_CSTS ,ONLY : XSURF_EPSILON
!
IMPLICIT NONE
@@ -73,83 +82,94 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
-!
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
CHARACTER(LEN=6), INTENT(IN) :: HSCHEME ! Scheme treated
CHARACTER(LEN=6), INTENT(IN) :: HSUBROUTINE ! Name of the subroutine to call
CHARACTER(LEN=28), INTENT(IN) :: HFILENAME ! Name of the field file.
CHARACTER(LEN=20), INTENT(IN) :: HFIELD ! Name of the field.
+LOGICAL, OPTIONAL, INTENT(IN) :: OMULTITYPE
!
-!* 0.2 Declaration of local variables read in the data file head
-! ---------------------------------------------------------
-!
-REAL :: ZGLBLATMIN ! minimum latitude of data box in the file
-REAL :: ZGLBLONMIN ! minimum longitude of data box in the file
-REAL :: ZGLBLATMAX ! maximum latitude of data box in the file
-REAL :: ZGLBLONMAX ! maximum longitude of data box in the file
-INTEGER :: INBLINE ! number of latitude rows (number of lines
-INTEGER :: INBCOL ! number of longitude rows (number of columns)
-REAL :: ZNODATA ! value below which data are not considered
-!
-!* 0.3 Declaration of local variables
+!* 0.2 Declaration of local variables
! ------------------------------
-!
-INTEGER :: IGLB, IGLBHDR ! logical units
-INTEGER :: ILUOUT ! output listing logical unit
-INTEGER :: IERR ! return codes
!
CHARACTER(LEN=28) :: YFILENAME ! Name of the field file without header
CHARACTER(LEN=28) :: YFILEHDR ! Name of the field file header
!
CHARACTER(LEN=7) :: YTYPE ! type of numerical field stored in the
! ! direct access file ('INTEGER','REAL ')
-INTEGER :: IBITS ! number of bits of a record in the
-! ! direct access file (16,32,64)
-INTEGER :: JLOOP ! loop index
CHARACTER(LEN=100):: YSTRING ! string
CHARACTER(LEN=88 ):: YSTRING1 ! part of string STRING
-INTEGER :: IINDEX ! index of a character in string STRING1
!
+ CHARACTER(LEN=2), DIMENSION(1) :: YCPT16 ! value of a data point
+ CHARACTER(LEN=4), DIMENSION(:), ALLOCATABLE :: YCPT32
+!
+ CHARACTER, DIMENSION(:), ALLOCATABLE :: YVALUE8 ! value of a data point
+ CHARACTER(LEN=2), DIMENSION(:), ALLOCATABLE :: YVALUE16 ! value of a data point
+ CHARACTER(LEN=4), DIMENSION(:), ALLOCATABLE :: YVALUE32R ! value of a data point
+ CHARACTER(LEN=8), DIMENSION(:), ALLOCATABLE :: YVALUE64 ! value of a data point
+!
+REAL, DIMENSION(1) :: ZCPT
+!
+REAL :: ZGLBLATMIN ! minimum latitude of data box in the file
+REAL :: ZGLBLONMIN ! minimum longitude of data box in the file
+REAL :: ZGLBLATMAX ! maximum latitude of data box in the file
+REAL :: ZGLBLONMAX ! maximum longitude of data box in the file
+REAL :: ZNODATA, ZNODATA2 ! value below which data are not considered
REAL :: ZDLAT ! latitude mesh in the data file
REAL :: ZDLON ! longitude mesh in the data file
-INTEGER :: JLINE ! index of line
-INTEGER :: JCOL ! index of column
-INTEGER, DIMENSION(2) :: ICOL1, ICOL2 ! limits of index of columns
-INTEGER :: ILINE1,ILINE2! limits of index of lines
-INTEGER :: ICOL ! number of columns in mask domain
-INTEGER :: ICOLINDEX ! column index in record
-REAL, DIMENSION(:), POINTER :: ZLAT ! latitude of data points
-REAL, DIMENSION(:), POINTER :: ZLON ! longitude of data points
-!
-INTEGER :: JLON, JLAT ! loop counters
REAL :: ZLONMIN ! minimum longitude of mask mesh
REAL :: ZLONMAX ! maximum longitude of mask mesh
REAL :: ZLATMIN ! minimum latitude of mask mesh
REAL :: ZLATMAX ! maximum latitude of mask mesh
REAL :: ZSHIFT ! shift on longitudes
-REAL :: ZFACT ! Factor integer to real
+INTEGER :: IFACT ! Factor integer to real
+INTEGER(KIND=2) :: INODATA, INODATA2
!
- CHARACTER, DIMENSION(:), ALLOCATABLE :: IVALUE8 ! value of a data point
- CHARACTER(LEN=2), DIMENSION(:), ALLOCATABLE :: IVALUE16 ! value of a data point
- CHARACTER(LEN=4), DIMENSION(:), ALLOCATABLE :: IVALUE32R ! value of a data point
-INTEGER (KIND=4), DIMENSION(:), ALLOCATABLE :: IVALUE32 ! value of a data point
-INTEGER (KIND=8), DIMENSION(:), ALLOCATABLE :: IVALUE64 ! value of a data point
-REAL (KIND=4), DIMENSION(:), ALLOCATABLE :: ZVALUE32 ! value of a data point
- CHARACTER(LEN=8), DIMENSION(:), ALLOCATABLE :: ZVALUE64 ! value of a data point
+REAL, DIMENSION(:), ALLOCATABLE :: ZVALUE
+REAL, DIMENSION(:), POINTER :: ZLAT ! latitude of data points
+REAL, DIMENSION(:), POINTER :: ZLON ! longitude of data points
+REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: ZVALUE32 ! value of a data point
+REAL, DIMENSION(:), ALLOCATABLE :: ZINTER ! value of a record of data points
+REAL, DIMENSION(:), ALLOCATABLE :: ZVALUE_WORK ! value of a valid data points
+REAL, DIMENSION(:), ALLOCATABLE :: ZLAT_WORK ! latitude of a valid data points
+REAL, DIMENSION(:), ALLOCATABLE :: ZLON_WORK ! longitude of a valid data points
+!
+INTEGER :: IINDEX ! index of a character in string STRING1
+INTEGER :: IBITS ! number of bits of a record in the
+ ! direct access file (16,32,64)
+INTEGER :: IRECLENGTH ! record length
+INTEGER :: IREC ! record number
+INTEGER :: IGLB, IGLBHDR ! logical units
+INTEGER :: ILUOUT ! output listing logical unit
+INTEGER :: IERR ! return codes
!
-REAL, DIMENSION(:), ALLOCATABLE :: ZVALUE ! value of a record of data points
+INTEGER :: INBLINE ! number of latitude rows (number of lines
+INTEGER :: INBCOL ! number of longitude rows (number of columns)
+INTEGER :: ILINE1,ILINE2 ! limits of index of lines
+INTEGER :: ICOL ! number of columns in mask domain
+INTEGER :: ICOLINDEX ! column index in record
+INTEGER :: ISIZE
+INTEGER :: IWORK, IDEB, IPAS ! index of these data
+INTEGER :: JLOOP, JLON, JLAT, JLINE, JCOL, JL, ICPT, INB, JTYPE
+INTEGER :: ILINE_COMPRESS
+INTEGER :: INB_LINE_READ
+INTEGER(KIND=8) :: IPOS
+!
+INTEGER, DIMENSION(360) :: IMASK
+INTEGER, DIMENSION(2) :: ICOL1, ICOL2 ! limits of index of columns
!
-REAL, DIMENSION(:), ALLOCATABLE :: ZVALUE_WORK ! value of a valid data points
-REAL, DIMENSION(:), ALLOCATABLE :: ZLAT_WORK ! latitude of a valid data points
-REAL, DIMENSION(:), ALLOCATABLE :: ZLON_WORK ! longitude of a valid data points
-INTEGER :: IWORK ! index of these data
-LOGICAL :: GSWAP ! T: swap has been done
+INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ICPT0 ! loop index
+INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: IVALUE32 ! value of a data point
+INTEGER(KIND=8), DIMENSION(:), ALLOCATABLE :: IVALUE64 ! value of a data point
!
+ CHARACTER(LEN=6) :: YACCESS
+LOGICAL :: GSWAP ! T: swap has been done
+LOGICAL :: GMULTITYPE, GCOMPRESS
!
-INTEGER :: IRECLENGTH ! record length
-INTEGER :: IREC ! record number
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
!
@@ -173,7 +193,7 @@ YFILEHDR =ADJUSTL(ADJUSTR(HFILENAME)//'.hdr')
!* 1.3 Reading in header of direct access characteristics
! --------------------------------------------------
!
-DO JLOOP=1,9
+DO JLOOP=1,11
READ(IGLBHDR,'(A100)') YSTRING
IF (YSTRING(1:10)=='recordtype') EXIT
END DO
@@ -199,19 +219,6 @@ IF (IINDEX/=0) IBITS=32
IINDEX=INDEX(YSTRING1,'4')
IF (IINDEX/=0) IBITS=64
!
-IF(YTYPE=='INTEGER')THEN
- IF(HFIELD=='CTI'.OR.HFIELD=='sand fraction'.OR. &
- HFIELD=='clay fraction'.OR.HFIELD=='organic carbon')THEN
- ZFACT=100.0
- ELSEIF (HFIELD=='water depth') THEN
- ZFACT=10.0
- ELSE
- ZFACT=1.0
- ENDIF
-ELSE
- ZFACT=1.0
-ENDIF
-!
!----------------------------------------------------------------------------
!
!* 2. Reading of the global field
@@ -221,9 +228,44 @@ ENDIF
! -----------------
!
CALL READHEAD(IGLBHDR,ZGLBLATMIN,ZGLBLATMAX,ZGLBLONMIN,ZGLBLONMAX, &
- INBLINE,INBCOL,ZNODATA,ZDLAT,ZDLON,ZLAT,ZLON,IERR)
+ INBLINE,INBCOL,ZNODATA,ZDLAT,ZDLON,ZLAT,ZLON,IERR,IFACT,&
+ GCOMPRESS)
IF (IERR/=0) CALL ABOR1_SFX('READ_DIRECT: PB IN FILE HEADER')
!
+IF (GCOMPRESS .AND. (YTYPE/='INTEGER' .OR. IBITS/=16)) &
+ CALL ABOR1_SFX('READ_DIRECT: COMPRESSED FILES ARE POSSIBLE ONLY WITH INTEGER 16 BYTES FOR THE MOMENT')
+!
+GMULTITYPE = .FALSE.
+IF (PRESENT(OMULTITYPE)) GMULTITYPE = OMULTITYPE
+!
+IF (GMULTITYPE) THEN
+ DEALLOCATE(NSIZE_ALL)
+ ALLOCATE(NSIZE_ALL(U%NDIM_FULL,SUM(NTYPE)))
+ NSIZE_ALL(:,:) = 0
+ IF (CATYPE=='MAJ') THEN
+ DEALLOCATE(NVALNBR,NVALCOUNT,XVALLIST)
+ ALLOCATE(NVALNBR (U%NDIM_FULL,SUM(NTYPE)))
+ ALLOCATE(NVALCOUNT(U%NDIM_FULL,JPVALMAX,SUM(NTYPE)))
+ ALLOCATE(XVALLIST (U%NDIM_FULL,JPVALMAX,SUM(NTYPE)))
+ NVALNBR (:,:) = 0
+ NVALCOUNT(:,:,:) = 0
+ XVALLIST (:,:,:) = XUNDEF
+ ELSE
+ DEALLOCATE(XALL)
+ ALLOCATE(XALL (U%NDIM_FULL,SUM(NTYPE),1))
+ XALL (:,:,:) = 0.
+ ENDIF
+ENDIF
+!
+IF(YTYPE=='INTEGER')THEN
+ IF(HFIELD(1:3)=='CTI'.OR.HFIELD=='sand fraction'.OR.HFIELD=='clay fraction'.OR.&
+ HFIELD=='organic carbon'.OR.HFIELD(1:4)=='SAND'.OR. HFIELD(1:4)=='CLAY'.OR.HFIELD(1:3)=='SOC')THEN
+ IFACT=100
+ ELSEIF (HFIELD=='water depth') THEN
+ IFACT=10
+ ENDIF
+ENDIF
+!
!* 2.2 Closing of header
! -----------------
!
@@ -232,9 +274,19 @@ IF (IERR/=0) CALL ABOR1_SFX('READ_DIRECT: PB IN FILE HEADER')
!* 2.3 Dimension of work arrays
! ------------------------
!
-ALLOCATE(ZLAT_WORK (INBCOL))
-ALLOCATE(ZLON_WORK (INBCOL))
-ALLOCATE(ZVALUE_WORK(INBCOL))
+! ires c'est le nombre de lignes qu'on lit dans un demi degré (multiple de 60)
+INB_LINE_READ = INBLINE / ((ZGLBLATMAX-ZGLBLATMIN)*2.)
+IF (INB_LINE_READ>60) INB_LINE_READ = MAX(INB_LINE_READ/3,60)
+! on lit toujours 60 lignes d'un coup
+ISIZE = INB_LINE_READ * INBCOL
+!
+ALLOCATE(ZLAT_WORK (ISIZE))
+ALLOCATE(ZLON_WORK (ISIZE))
+ALLOCATE(ZVALUE_WORK(ISIZE))
+IF (GCOMPRESS.OR.GMULTITYPE) THEN
+ ALLOCATE (ZINTER(ISIZE))
+ ZINTER(:) = 0.
+ENDIF
!
!----------------------------------------------------------------------------
!
@@ -252,232 +304,349 @@ IF (HSUBROUTINE=='A_OROG') CALL INI_SSOWORK(XMESHLENGTH,ZDLAT,ZDLON)
! -------------
!
IRECLENGTH = IBITS/8 * INBCOL
-ALLOCATE (ZVALUE(INBCOL))
-ALLOCATE (IVALUE8 (INBCOL))
-ALLOCATE (IVALUE16(INBCOL))
-ALLOCATE (IVALUE32(INBCOL))
-ALLOCATE (IVALUE32R(INBCOL))
-ALLOCATE (IVALUE64(INBCOL))
-ALLOCATE (ZVALUE32(INBCOL))
-ALLOCATE (ZVALUE64(INBCOL))
+ALLOCATE (ZVALUE (INBCOL))
+ZVALUE(:) = 0.
+!
+IF (GCOMPRESS) THEN
+ ALLOCATE(YCPT32(INBLINE))
+ ALLOCATE(ICPT0 (INBLINE))
+ENDIF
+!
+IF (YTYPE=='INTEGER' .AND. IBITS== 8) THEN
+ ALLOCATE (YVALUE8 (INBCOL))
+ELSEIF (YTYPE=='INTEGER' .AND. IBITS==16) THEN
+ ALLOCATE (YVALUE16(INBCOL))
+ELSEIF (YTYPE=='INTEGER' .AND. IBITS==32) THEN
+ ALLOCATE (IVALUE32(INBCOL))
+ ELSEIF (YTYPE=='INTEGER' .AND. IBITS==64) THEN
+ ALLOCATE (IVALUE64(INBCOL))
+ELSEIF (YTYPE=='REAL ' .AND. IBITS==32) THEN
+ ALLOCATE (YVALUE32R(INBCOL))
+ELSEIF (YTYPE=='REAL ' .AND. IBITS==64) THEN
+ ALLOCATE (YVALUE64(INBCOL))
+ENDIF
!
!* 7.2 Openning of direct access file
! ------------------------------
+!
+YACCESS = 'DIRECT'
+IF (GCOMPRESS) THEN
+ YACCESS='STREAM'
+ LITTLE_ENDIAN_ARCH = .FALSE.
+ENDIF
!
CALL OPEN_FILE(HPROGRAM,IGLB,YFILENAME,'UNFORMATTED', &
- HACTION='READ',HACCESS='DIRECT',KRECL=IRECLENGTH )
+ HACTION='READ',HACCESS=YACCESS,KRECL=IRECLENGTH )
+!
+! we read numbers of elements by line of the grid at the beginning
+IF (GCOMPRESS) THEN
+ READ(IGLB) YCPT32
+ ICPT0(:) = TRANSFER(YCPT32(:),1_4,INBLINE)
+ENDIF
!
!----------------------------------------------------------------------------
!
!* 4. loop on mask meshes (lat)
! -------------------
!
-GSWAP = .FALSE.
-!
-JLAT = 0
-!
-DO
-!
- JLAT = JLAT + 1
- IF (JLAT==361) EXIT
-!
+IMASK(:) = 0
+ICPT = 0
+DO JLAT = 1,360
IF ( .NOT. ANY(LLATLONMASK(:,JLAT)) ) CYCLE
-!
ZLATMIN = (JLAT-180)/2. - 0.5
ZLATMAX = (JLAT-180)/2.
-!
-!----------------------------------------------------------------------------
-!
-!* 5. index limits on latitude
-! ------------------------
-!
- ILINE1=MAX(MIN(INT((ZGLBLATMAX-ZDLAT/2.-ZLATMAX)/ZDLAT+1.),INBLINE),0)+1
- ILINE2=MAX(MIN(INT((ZGLBLATMAX-ZDLAT/2.-ZLATMIN)/ZDLAT+1.),INBLINE),0)
IF ( .NOT. ANY(ZLAT(:)<ZLATMAX .AND. ZLAT(:)>=ZLATMIN) ) CYCLE
+ ICPT = ICPT + 1
+ IMASK(ICPT) = JLAT
+ENDDO
!
-!----------------------------------------------------------------------------
+!INB: number of lat to be read
+INB = ICPT
!
-!* 8. Loop on lines
-! -------------
+!IPAS: number of lat to be read for each task
+IPAS = CEILING(INB*1./NPROC)
!
- DO JLINE = ILINE1,ILINE2
+GSWAP = .FALSE.
!
-!----------------------------------------------------------------------------
+!first lat read for this task
+IDEB = IPAS*NRANK
!
-!* 10. Reading in the direct access file
-! ---------------------------------
+ICPT = 0
!
-!* 10.1 Record number
-! -------------
+JL = IPAS + 1
+!
+IF (GCOMPRESS) ILINE_COMPRESS = 1
!
- IREC=JLINE
-!
-!* 10.2 Reading the correct data type and conversion into real
-! ------------------------------------------------------
+INODATA = ZNODATA
+INODATA2 = ISHFTC(INODATA,8)
+ZNODATA2 = INODATA2
!
+DO
+ !
+ !the file is read from the top to the bottom (quicker)
+ JL = JL - 1
+ IF (JL==0) EXIT
+ !
+ IF (IDEB+JL>INB) CYCLE
+ !
+ !lat read by this task for this loop index JL
+ JLAT = IMASK(IDEB+JL)
+ !
+ ZLATMIN = (JLAT-180)/2. - 0.5
+ ZLATMAX = (JLAT-180)/2.
+ !
+ !----------------------------------------------------------------------------
+ !
+ !* 5. index limits on latitude
+ ! ------------------------
+ !
+ ILINE1=MAX(MIN(INT((ZGLBLATMAX-ZDLAT/2.-ZLATMAX)/ZDLAT+1.),INBLINE),0)+1
+ ILINE2=MAX(MIN(INT((ZGLBLATMAX-ZDLAT/2.-ZLATMIN)/ZDLAT+1.),INBLINE),0)
+ !
+ !----------------------------------------------------------------------------
+ !
+ !* 8. Loop on lines
+ ! -------------
+ !
+ ! first IPOS for this task is the first information plus the
+ ! number of elements by lines before the first to read
+ IF (GCOMPRESS.AND.(JL==IPAS.OR.ILINE_COMPRESS<ILINE1)) THEN
+ IPOS = 0
+ IF (ILINE1>1) THEN
+ DO JLOOP=1,ILINE1-1
+ IPOS = IPOS + ICPT0(JLOOP)
+ ENDDO
+ ENDIF
+ IPOS = IPOS*2 + 1 + INBLINE*4
+ ILINE_COMPRESS = ILINE1
+ ELSE
+ IPOS = 0
+ ENDIF
+ !
+ DO JLINE = ILINE1,ILINE2
+ !
+ !----------------------------------------------------------------------------
+ !
+ !* 10. Reading in the direct access file
+ ! ---------------------------------
+ !
+ !* 10.1 Record number
+ ! -------------
+ !
+ IREC = JLINE
+ !
+ !* 10.2 Reading the correct data type and conversion into real
+ ! ------------------------------------------------------
+ !
IF (YTYPE=='INTEGER' .AND. IBITS== 8) THEN
- READ(IGLB,REC=IREC) IVALUE8(:)
- ZVALUE(:)=IVALUE8(:)
+ READ(IGLB,REC=IREC) YVALUE8(:)
+ ZVALUE(:)=YVALUE8(:)
! negative values are shifted to positive values according to binary coding
WHERE (ZVALUE(:)<0.) ZVALUE(:) = NINT(256.+ZVALUE(:))
!
ELSE IF (YTYPE=='INTEGER' .AND. IBITS==16) THEN
- READ(IGLB,REC=IREC) IVALUE16(:)
- ZVALUE(:)=IVALUE16(:)
- IF ( ANY(ABS(ZVALUE)>15000) ) THEN
- IF (GSWAP) CALL ABOR1_SFX('READ_DIRECT: SWAP ALREADY DONE, CANNOT BE REDONE')
- LITTLE_ENDIAN_ARCH = .NOT. LITTLE_ENDIAN_ARCH
- GSWAP = .TRUE.
- WRITE(ILUOUT,*) '*******************************************************************'
- WRITE(ILUOUT,*) 'Architecture of the machine needs to swap LITTLE_ENDIAN_ARCH to ', &
- LITTLE_ENDIAN_ARCH
- WRITE(ILUOUT,*) '*******************************************************************'
- JLAT = 0
- CALL REFRESH_PGDWORK
- EXIT ! rereads the file
- END IF
-
+ !
+ IF (GCOMPRESS) THEN
+ IF (IPOS/=0) THEN
+ READ(IGLB,POS=IPOS) YVALUE16(1:ICPT0(JLINE))
+ IPOS = 0
+ ELSE
+ READ(IGLB) YVALUE16(1:ICPT0(JLINE))
+ ENDIF
+ ZVALUE(1:ICPT0(JLINE))=YVALUE16(1:ICPT0(JLINE))
+ ILINE_COMPRESS = ILINE_COMPRESS + 1
+ ELSE
+ READ(IGLB,REC=IREC) YVALUE16(:)
+ ZVALUE(:)=YVALUE16(:)
+ ENDIF
+ !
+ IF (ICPT==0.AND..NOT.GCOMPRESS) THEN
+ IF ( (HFIELD(1:5)=="COVER" .AND. (ANY(ZVALUE>JPCOVER.AND.ZVALUE/=ZNODATA) .OR. &
+ ANY(ZVALUE<0..AND.ZVALUE/=ZNODATA) .OR. ALL(ZVALUE==256.)) ) .OR. &
+ (ZNODATA/=0 .AND. (ALL(ZVALUE==ZNODATA2))) .OR. &
+ ((HFIELD(1:4)=="SAND" .OR. HFIELD(1:4)=="CLAY") .AND. &
+ (ANY(ZVALUE>100..AND.ZVALUE/=ZNODATA) .OR. ANY(ZVALUE<0..AND.ZVALUE/=ZNODATA)) ) .OR. &
+ (HFIELD(1:3)=="SOC" .AND. (ANY(ZVALUE>15000..AND.ZVALUE/=ZNODATA) .OR. ANY(ZVALUE<0..AND.ZVALUE/=ZNODATA)) ) .OR. &
+ ((HFIELD(1:5)/="COVER" .AND. HFIELD(1:4)/="SAND" .AND. HFIELD(1:4)/="CLAY" .AND. &
+ HFIELD(1:3)/="SOC" .AND. ANY(ZVALUE>15000..AND.ZVALUE/=ZNODATA) ) ) ) THEN
+ ICPT = ICPT + 1
+ IF (GSWAP) CALL ABOR1_SFX('READ_DIRECT: SWAP ALREADY DONE, CANNOT BE REDONE')
+ LITTLE_ENDIAN_ARCH = .NOT. LITTLE_ENDIAN_ARCH
+ GSWAP = .TRUE.
+ IF (NRANK==NPIO) THEN
+ WRITE(ILUOUT,*) '*******************************************************************'
+ WRITE(ILUOUT,*) 'Architecture of the machine needs to swap LITTLE_ENDIAN_ARCH to ', &
+ LITTLE_ENDIAN_ARCH
+ WRITE(ILUOUT,*) '*******************************************************************'
+ ENDIF
+ JL = IPAS + 1 !back to first lat
+ IF (HFIELD(1:5)=="COVER") U%LCOVER(:) = .FALSE.
+ CALL REFRESH_PGDWORK(HSUBROUTINE)
+ EXIT ! rereads the file
+ ENDIF
+ ENDIF
+ !
+ !
ELSE IF (YTYPE=='INTEGER' .AND. IBITS==32) THEN
READ(IGLB,REC=IREC) IVALUE32(:)
ZVALUE(:)=IVALUE32(:)
+ !
ELSE IF (YTYPE=='INTEGER' .AND. IBITS==64) THEN
READ(IGLB,REC=IREC) IVALUE64(:)
ZVALUE(:)=IVALUE64(:)
+ !
ELSE IF (YTYPE=='REAL ' .AND. IBITS==32) THEN
- READ(IGLB,REC=IREC) IVALUE32R(:)
- ZVALUE(:)=IVALUE32R(:)
- IF ( ANY(ABS(ZVALUE)>0. .AND. ABS(ZVALUE)<1.E-50) &
- .OR. ANY(ABS(ZVALUE)>1.E20) ) THEN
- IF (GSWAP) CALL ABOR1_SFX('READ_DIRECT: SWAP ALREADY DONE, CANNOT BE REDONE')
- LITTLE_ENDIAN_ARCH = .NOT. LITTLE_ENDIAN_ARCH
- GSWAP = .TRUE.
- WRITE(ILUOUT,*) '*******************************************************************'
- WRITE(ILUOUT,*) 'Architecture of the machine needs to swap LITTLE_ENDIAN_ARCH to ', &
- LITTLE_ENDIAN_ARCH
- WRITE(ILUOUT,*) '*******************************************************************'
- JLAT = 0
- CALL REFRESH_PGDWORK
- EXIT
- END IF
+ READ(IGLB,REC=IREC) YVALUE32R(:)
+ ZVALUE(:)=YVALUE32R(:)
+ !
+ IF (ICPT==0) THEN
+ IF ( ANY(ABS(ZVALUE)>0. .AND. ABS(ZVALUE)<1.E-50) &
+ .OR. ANY(ABS(ZVALUE)>1.E20) ) THEN
+ ICPT = ICPT + 1
+ IF (GSWAP) CALL ABOR1_SFX('READ_DIRECT: SWAP ALREADY DONE, CANNOT BE REDONE')
+ LITTLE_ENDIAN_ARCH = .NOT. LITTLE_ENDIAN_ARCH
+ GSWAP = .TRUE.
+ IF (NRANK==NPIO) THEN
+ WRITE(ILUOUT,*) '*******************************************************************'
+ WRITE(ILUOUT,*) 'Architecture of the machine needs to swap LITTLE_ENDIAN_ARCH to ', &
+ LITTLE_ENDIAN_ARCH
+ WRITE(ILUOUT,*) '*******************************************************************'
+ ENDIF
+ JL = IPAS + 1
+ CALL REFRESH_PGDWORK(HSUBROUTINE)
+ EXIT
+ ENDIF
+ END IF
+ !
ELSE IF (YTYPE=='REAL ' .AND. IBITS==64) THEN
- READ(IGLB,REC=IREC) ZVALUE64(:)
- ZVALUE(:)=ZVALUE64(:)
- IF ( ANY(ABS(ZVALUE)>0. .AND. ABS(ZVALUE)<1.E-50) &
- .OR. ANY(ABS(ZVALUE)>1.E20) ) THEN
- IF (GSWAP) CALL ABOR1_SFX('READ_DIRECT: SWAP ALREADY DONE, CANNOT BE REDONE')
- LITTLE_ENDIAN_ARCH = .NOT. LITTLE_ENDIAN_ARCH
- GSWAP = .TRUE.
- WRITE(ILUOUT,*) '*******************************************************************'
- WRITE(ILUOUT,*) 'Architecture of the machine needs to swap LITTLE_ENDIAN_ARCH to ', &
- LITTLE_ENDIAN_ARCH
- WRITE(ILUOUT,*) '*******************************************************************'
- JLAT = 0
- CALL REFRESH_PGDWORK
- EXIT
- END IF
+ READ(IGLB,REC=IREC) YVALUE64(:)
+ ZVALUE(:)=YVALUE64(:)
+ !
+ IF (ICPT==0) THEN
+ IF ( ANY(ABS(ZVALUE)>0. .AND. ABS(ZVALUE)<1.E-50) &
+ .OR. ANY(ABS(ZVALUE)>1.E20) ) THEN
+ ICPT = ICPT + 1
+ IF (GSWAP) CALL ABOR1_SFX('READ_DIRECT: SWAP ALREADY DONE, CANNOT BE REDONE')
+ LITTLE_ENDIAN_ARCH = .NOT. LITTLE_ENDIAN_ARCH
+ GSWAP = .TRUE.
+ IF (NRANK==NPIO) THEN
+ WRITE(ILUOUT,*) '*******************************************************************'
+ WRITE(ILUOUT,*) 'Architecture of the machine needs to swap LITTLE_ENDIAN_ARCH to ', &
+ LITTLE_ENDIAN_ARCH
+ WRITE(ILUOUT,*) '*******************************************************************'
+ ENDIF
+ JL = IPAS + 1
+ CALL REFRESH_PGDWORK(HSUBROUTINE)
+ EXIT
+ ENDIF
+ ENDIF
ELSE
CALL ABOR1_SFX('READ_DIRECT1: DATA TYPE NOT SUPPORTED')
END IF
-!
+ !
IF(HFIELD=='CTI')THEN
- WHERE(ZVALUE(:)<0.0)ZVALUE(:)=ZNODATA
+ WHERE(ZVALUE(:)<0.0) ZVALUE(:)=ZNODATA
ENDIF
-!
- WHERE(ZVALUE(:)/=ZNODATA)ZVALUE(:)=ZVALUE(:)/ZFACT
-!
-!----------------------------------------------------------------------------
-!
-!* 4. loop on mask meshes (lon)
-! -------------------
-!
+ !
+ IF (GCOMPRESS) THEN
+ WHERE (ZVALUE(1:ICPT0(JLINE))<0.) ZVALUE(1:ICPT0(JLINE)) = NINT(32768*2.+ZVALUE(1:ICPT0(JLINE)))
+ ZINTER(1:ICPT0(JLINE)) = ZVALUE(1:ICPT0(JLINE))
+ CALL UNCOMPRESS_FIELD(INBCOL,4000.,ZINTER(1:ICPT0(JLINE)),ZVALUE(:))
+ ENDIF
+ !
+ !----------------------------------------------------------------------------
+ !
+ !* 4. loop on mask meshes (lon)
+ ! -------------------
+ !
DO JLON=1,720
-!
+ !
IF (.NOT. LLATLONMASK(JLON,JLAT)) CYCLE
-!
+ !
ZLONMIN = JLON /2. - 0.5
ZLONMAX = JLON /2.
-!
-!----------------------------------------------------------------------------
-!
-!* 5. limits on longitude
-! -------------------
-!
-!* 5.1 left domain border is set just higher than the global field min. longitude
-! -----------------------------------------------------------------
-!
+ !
+ !----------------------------------------------------------------------------
+ !
+ !* 5. limits on longitude
+ ! -------------------
+ !
+ !* 5.1 left domain border is set just higher than the global field min. longitude
+ ! -----------------------------------------------------------------
+ !
ZSHIFT = 360. * NINT((ZLONMIN-ZGLBLONMIN-180.*(1-XSURF_EPSILON))/360.)
-
-!
+ !
ZGLBLONMIN = ZGLBLONMIN + ZSHIFT
ZGLBLONMAX = ZGLBLONMAX + ZSHIFT
-
-!
-!
-!* 5.2 index limits on longitude
-! -------------------------
-!
+ !
+ !* 5.2 index limits on longitude
+ ! -------------------------
+ !
ICOL1(1)=MAX(MIN(INT((ZLONMIN-ZGLBLONMIN-ZDLON/2.)/ZDLON+1.),INBCOL),0)+1
ICOL2(1)=MAX(MIN(INT((ZLONMAX-ZGLBLONMIN-ZDLON/2.)/ZDLON+1.),INBCOL),0)
-!
-!* Does right domain border goes outside the global field longitude range?
-!* Does it then goes into the global field domain by the other side?
-!* Then a second part of the global field domain must be considered
-!
+ !
+ !* Does right domain border goes outside the global field longitude range?
+ !* Does it then goes into the global field domain by the other side?
+ !* Then a second part of the global field domain must be considered
+ !
ICOL1(2)=1
ICOL2(2)=MAX(MIN(INT((ZLONMAX-ZGLBLONMIN-ZDLON/2.-360.)/ZDLON+1.),INBCOL),0)
-!
-!----------------------------------------------------------------------------
-!
-!* 6. Loop on longitude limits
-! ------------------------
-!
+ !
+ !----------------------------------------------------------------------------
+ !
+ !* 6. Loop on longitude limits
+ ! ------------------------
+ !
DO JLOOP=1,2
-!
+ !
ICOL = ICOL2(JLOOP) - ICOL1(JLOOP) + 1
-!
+ !
IF (ICOL<1) CYCLE
-!
-!----------------------------------------------------------------------------
-!
-!* 11. Loop on columns
-! ---------------
-!
+ !
+ !----------------------------------------------------------------------------
+ !
+ !* 11. Loop on columns
+ ! ---------------
+ !
IWORK=0
-!
+ !
DO JCOL=1,ICOL
-!
-!* 11.1 Recovers point value
-! --------------------
-!
+ !
+ !* 11.1 Recovers point value
+ ! --------------------
+ !
ICOLINDEX = JCOL+ICOL1(JLOOP)-1
-
-!
-!* 11.2 Test with respect to the 'no data' value
-! ----------------------------------------
-!
+ !
+ !* 11.2 Test with respect to the 'no data' value
+ ! ----------------------------------------
+ !
IF (ABS(ZVALUE(ICOLINDEX)-ZNODATA)<=1.E-10) CYCLE
-!
-!
-!* 11.3 copy of the correct values in a work array
-! ------------------------------------------
-!
+ !
+ !* 11.3 copy of the correct values in a work array
+ ! ------------------------------------------
+ !
IWORK = IWORK + 1
ZLAT_WORK (IWORK) = ZLAT (JLINE)
ZLON_WORK (IWORK) = ZLON (ICOLINDEX)
ZVALUE_WORK(IWORK) = ZVALUE(ICOLINDEX)
-!
+ !
END DO
-!
-!-------------------------------------------------------------------------------
-!
-!* 12. Call to the adequate subroutine (point by point treatment)
-! ----------------------------------------------------------
-!
- IF (IWORK>0) &
- CALL PT_BY_PT_TREATMENT(USS, &
- ILUOUT, ZLAT_WORK(1:IWORK),ZLON_WORK(1:IWORK), &
- ZVALUE_WORK(1:IWORK), &
- HSUBROUTINE )
+ !-------------------------------------------------------------------------------
+ !
+ IF (.NOT.GMULTITYPE.AND.IFACT/=1) THEN
+ WHERE(ZVALUE_WORK(1:IWORK)/=ZNODATA)
+ ZVALUE_WORK(1:IWORK)=ZVALUE_WORK(1:IWORK)/FLOAT(IFACT)
+ END WHERE
+ ENDIF
+ !
+ !* 12. Call to the adequate subroutine (point by point treatment)
+ ! ----------------------------------------------------------
+ !
+ IF (IWORK>0) &
+ CALL PT_BY_PT_TREATMENT(UG, U, USS, &
+ ILUOUT, ZLAT_WORK(1:IWORK),ZLON_WORK(1:IWORK), &
+ ZVALUE_WORK(1:IWORK), &
+ HSUBROUTINE, OMULTITYPE=GMULTITYPE, KFACT=IFACT)
!
!-------------------------------------------------------------------------------
END DO
@@ -499,13 +668,14 @@ DEALLOCATE(ZLON_WORK )
DEALLOCATE(ZVALUE_WORK)
!
DEALLOCATE (ZVALUE)
-DEALLOCATE (IVALUE8 )
-DEALLOCATE (IVALUE16)
-DEALLOCATE (IVALUE32)
-DEALLOCATE (IVALUE32R)
-DEALLOCATE (IVALUE64)
-DEALLOCATE (ZVALUE32)
-DEALLOCATE (ZVALUE64)
+IF (ALLOCATED(ZINTER)) DEALLOCATE (ZINTER)
+IF (ALLOCATED(YVALUE8)) DEALLOCATE (YVALUE8 )
+IF (ALLOCATED(YVALUE16)) DEALLOCATE (YVALUE16)
+IF (ALLOCATED(YVALUE32R)) DEALLOCATE (YVALUE32R)
+IF (ALLOCATED(YVALUE64)) DEALLOCATE (YVALUE64)
+IF (ALLOCATED(IVALUE32)) DEALLOCATE (IVALUE32)
+IF (ALLOCATED(IVALUE64)) DEALLOCATE (IVALUE64)
+IF (ALLOCATED(ZVALUE32)) DEALLOCATE (ZVALUE32)
!
CALL CLOSE_FILE(HPROGRAM,IGLB)
IF (LHOOK) CALL DR_HOOK('READ_DIRECT',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/read_direct_gauss.F90 b/src/SURFEX/read_direct_gauss.F90
index d1467f047d0df0f89c29063a51b960b14d1d8bd3..cd38199731711a17a057a2e4492a71c23472b483 100644
--- a/src/SURFEX/read_direct_gauss.F90
+++ b/src/SURFEX/read_direct_gauss.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_DIRECT_GAUSS (USS, &
- HPROGRAM,HSCHEME,HSUBROUTINE,HFILENAME,HFIELD)
+ SUBROUTINE READ_DIRECT_GAUSS (UG, U, USS, &
+ HPROGRAM,HSCHEME,HSUBROUTINE,HFILENAME,HFIELD,OMULTITYPE)
! #########################################################
!
!!**** *READ_DIRECT_GAUSS1* reads a latlon file and call treatment subroutine
@@ -40,14 +40,19 @@
!* 0. DECLARATION
! -----------
!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPROC, NPIO
!
-!
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_PGD_GRID, ONLY : LLATLONMASK, XMESHLENGTH
!
USE MODD_ARCH, ONLY : LITTLE_ENDIAN_ARCH
!
+USE MODD_DATA_COVER_PAR, ONLY : JPCOVER, NTYPE
+!
USE MODI_GET_LUOUT
USE MODI_OPEN_NAMELIST
USE MODI_CLOSE_NAMELIST
@@ -58,27 +63,34 @@ USE MODI_INI_SSOWORK
USE MODI_PT_BY_PT_TREATMENT
USE MODE_CHAR2REAL
!
+USE MODI_UNCOMPRESS_FIELD
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
USE MODI_ABOR1_SFX
!
+USE MODD_PGDWORK, ONLY : NSIZE_ALL, XALL, NVALNBR, NVALCOUNT, XVALLIST, &
+ CATYPE, JPVALMAX
USE MODI_REFRESH_PGDWORK
!
+USE MODD_CSTS ,ONLY : XSURF_EPSILON
+!
IMPLICIT NONE
!
!* 0.1 Declaration of arguments
! ------------------------
!
-!
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
CHARACTER(LEN=6), INTENT(IN) :: HSCHEME ! Scheme treated
CHARACTER(LEN=6), INTENT(IN) :: HSUBROUTINE ! Name of the subroutine to call
CHARACTER(LEN=28), INTENT(IN) :: HFILENAME ! Name of the field file.
CHARACTER(LEN=20), INTENT(IN) :: HFIELD ! Name of the field.
+LOGICAL, OPTIONAL, INTENT(IN) :: OMULTITYPE
!
!* 0.2 Declaration of local variables
! ------------------------------
@@ -90,18 +102,22 @@ TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
! ! direct access file ('INTEGER','REAL ')
CHARACTER(LEN=100):: YSTRING ! string
CHARACTER(LEN=88 ):: YSTRING1 ! part of string STRING
+!
+ CHARACTER(LEN=2), DIMENSION(1) :: YCPT16 ! value of a data point
+ CHARACTER(LEN=4), DIMENSION(:), ALLOCATABLE :: YCPT32
!
CHARACTER, DIMENSION(:), ALLOCATABLE :: YVALUE8 ! value of a data point
CHARACTER(LEN=2), DIMENSION(:), ALLOCATABLE :: YVALUE16 ! value of a data point
CHARACTER(LEN=4), DIMENSION(:), ALLOCATABLE :: YVALUE32R ! value of a data point
CHARACTER(LEN=8), DIMENSION(:), ALLOCATABLE :: YVALUE64 ! value of a data point
!
+REAL, DIMENSION(1) :: ZCPT
!
REAL :: ZGLBLATMIN ! minimum latitude of data box in the file
REAL :: ZGLBLONMIN ! minimum longitude of data box in the file
REAL :: ZGLBLATMAX ! maximum latitude of data box in the file
REAL :: ZGLBLONMAX ! maximum longitude of data box in the file
-REAL :: ZNODATA ! value below which data are not considered
+REAL :: ZNODATA, ZNODATA2 ! value below which data are not considered
REAL :: ZDLAT ! latitude mesh in the data file
REAL :: ZDLON ! longitude mesh in the data file
REAL :: ZLONMIN ! minimum longitude of mask mesh
@@ -109,12 +125,14 @@ REAL :: ZLONMAX ! maximum longitude of mask mesh
REAL :: ZLATMIN ! minimum latitude of mask mesh
REAL :: ZLATMAX ! maximum latitude of mask mesh
REAL :: ZSHIFT ! shift on longitudes
-REAL :: ZFACT ! Factor integer to real
+INTEGER :: IFACT ! Factor integer to real
+INTEGER(KIND=2) :: INODATA, INODATA2
!
+REAL, DIMENSION(:), ALLOCATABLE :: ZVALUE
REAL, DIMENSION(:), POINTER :: ZLAT ! latitude of data points
REAL, DIMENSION(:), POINTER :: ZLON ! longitude of data points
REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: ZVALUE32 ! value of a data point
-REAL, DIMENSION(:), ALLOCATABLE :: ZVALUE ! value of a record of data points
+REAL, DIMENSION(:), ALLOCATABLE :: ZINTER ! value of a record of data points
REAL, DIMENSION(:), ALLOCATABLE :: ZVALUE_WORK ! value of a valid data points
REAL, DIMENSION(:), ALLOCATABLE :: ZLAT_WORK ! latitude of a valid data points
REAL, DIMENSION(:), ALLOCATABLE :: ZLON_WORK ! longitude of a valid data points
@@ -134,15 +152,22 @@ INTEGER :: ILINE1,ILINE2 ! limits of index of lines
INTEGER :: ICOL ! number of columns in mask domain
INTEGER :: ICOLINDEX ! column index in record
INTEGER :: INBLINES, ISIZE
-INTEGER :: IWORK ! index of these data
-INTEGER :: JLOOP, JLON, JLAT, JLINE, JCOL ! loop index
+INTEGER :: IWORK, IDEB, IPAS ! index of these data
+INTEGER :: JLOOP, JLON, JLAT, JLINE, JCOL, JL, ICPT, INB, JTYPE
+INTEGER :: ILINE_COMPRESS
+INTEGER :: INB_LINE_READ
+INTEGER(KIND=8) :: IPOS
!
+INTEGER, DIMENSION(360) :: IMASK
INTEGER, DIMENSION(2) :: ICOL1, ICOL2 ! limits of index of columns
!
-INTEGER (KIND=4), DIMENSION(:), ALLOCATABLE :: IVALUE32 ! value of a data point
-INTEGER (KIND=8), DIMENSION(:), ALLOCATABLE :: IVALUE64 ! value of a data point
+INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: ICPT0 ! loop index
+INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: IVALUE32 ! value of a data point
+INTEGER(KIND=8), DIMENSION(:), ALLOCATABLE :: IVALUE64 ! value of a data point
!
-LOGICAL :: GSWAP ! T: swap has been done
+ CHARACTER(LEN=6) :: YACCESS
+LOGICAL :: GSWAP ! T: swap has been done
+LOGICAL :: GMULTITYPE, GCOMPRESS
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
@@ -167,7 +192,7 @@ YFILEHDR =ADJUSTL(ADJUSTR(HFILENAME)//'.hdr')
!* 1.3 Reading in header of direct access characteristics
! --------------------------------------------------
!
-DO JLOOP=1,9
+DO JLOOP=1,11
READ(IGLBHDR,'(A100)') YSTRING
IF (YSTRING(1:10)=='recordtype') EXIT
END DO
@@ -193,19 +218,6 @@ IF (IINDEX/=0) IBITS=32
IINDEX=INDEX(YSTRING1,'4')
IF (IINDEX/=0) IBITS=64
!
-IF(YTYPE=='INTEGER')THEN
- IF(HFIELD=='CTI'.OR.HFIELD=='sand fraction'.OR. &
- HFIELD=='clay fraction'.OR.HFIELD=='organic carbon')THEN
- ZFACT=100.0
- ELSEIF (HFIELD=='water depth') THEN
- ZFACT=10.0
- ELSE
- ZFACT=1.0
- ENDIF
-ELSE
- ZFACT=1.0
-ENDIF
-!
IF (LHOOK) CALL DR_HOOK('READ_DIRECT_GAUSS_1',1,ZHOOK_HANDLE)
IF (LHOOK) CALL DR_HOOK('READ_DIRECT_GAUSS_2',0,ZHOOK_HANDLE)
!----------------------------------------------------------------------------
@@ -217,9 +229,44 @@ IF (LHOOK) CALL DR_HOOK('READ_DIRECT_GAUSS_2',0,ZHOOK_HANDLE)
! -----------------
!
CALL READHEAD(IGLBHDR,ZGLBLATMIN,ZGLBLATMAX,ZGLBLONMIN,ZGLBLONMAX, &
- INBLINE,INBCOL,ZNODATA,ZDLAT,ZDLON,ZLAT,ZLON,IERR)
+ INBLINE,INBCOL,ZNODATA,ZDLAT,ZDLON,ZLAT,ZLON,IERR,IFACT,&
+ GCOMPRESS)
IF (IERR/=0) CALL ABOR1_SFX('READ_DIRECT_GAUSS: PB IN FILE HEADER')
!
+IF (GCOMPRESS .AND. (YTYPE/='INTEGER' .OR. IBITS/=16)) &
+ CALL ABOR1_SFX('READ_DIRECT_GAUSS: COMPRESSED FILES ARE POSSIBLE ONLY WITH INTEGER 16 BYTES FOR THE MOMENT')
+!
+GMULTITYPE = .FALSE.
+IF (PRESENT(OMULTITYPE)) GMULTITYPE = OMULTITYPE
+!
+IF (GMULTITYPE) THEN
+ DEALLOCATE(NSIZE_ALL)
+ ALLOCATE(NSIZE_ALL(U%NDIM_FULL,SUM(NTYPE)))
+ NSIZE_ALL(:,:) = 0
+ IF (CATYPE=='MAJ') THEN
+ DEALLOCATE(NVALNBR,NVALCOUNT,XVALLIST)
+ ALLOCATE(NVALNBR (U%NDIM_FULL,SUM(NTYPE)))
+ ALLOCATE(NVALCOUNT(U%NDIM_FULL,JPVALMAX,SUM(NTYPE)))
+ ALLOCATE(XVALLIST (U%NDIM_FULL,JPVALMAX,SUM(NTYPE)))
+ NVALNBR (:,:) = 0
+ NVALCOUNT(:,:,:) = 0
+ XVALLIST (:,:,:) = XUNDEF
+ ELSE
+ DEALLOCATE(XALL)
+ ALLOCATE(XALL (U%NDIM_FULL,SUM(NTYPE),1))
+ XALL (:,:,:) = 0.
+ ENDIF
+ENDIF
+!
+IF(YTYPE=='INTEGER')THEN
+ IF(HFIELD(1:3)=='CTI'.OR.HFIELD=='sand fraction'.OR.HFIELD=='clay fraction'.OR.&
+ HFIELD=='organic carbon'.OR.HFIELD(1:4)=='SAND'.OR. HFIELD(1:4)=='CLAY'.OR.HFIELD(1:3)=='SOC')THEN
+ IFACT=100
+ ELSEIF (HFIELD=='water depth') THEN
+ IFACT=10
+ ENDIF
+ENDIF
+!
!* 2.2 Closing of header
! -----------------
!
@@ -228,10 +275,19 @@ IF (IERR/=0) CALL ABOR1_SFX('READ_DIRECT_GAUSS: PB IN FILE HEADER')
!* 2.3 Dimension of work arrays
! ------------------------
!
-ISIZE = INBLINE*(INBCOL/((ZGLBLATMAX-ZGLBLATMIN)*2.))
+! ires c'est le nombre de lignes qu'on lit dans un demi degré (multiple de 60)
+INB_LINE_READ = INBLINE / ((ZGLBLATMAX-ZGLBLATMIN)*2.)
+IF (INB_LINE_READ>60) INB_LINE_READ = MAX(INB_LINE_READ/3,60)
+! on lit toujours 60 lignes d'un coup
+ISIZE = INB_LINE_READ * INBCOL
+!
ALLOCATE(ZLAT_WORK (ISIZE))
ALLOCATE(ZLON_WORK (ISIZE))
ALLOCATE(ZVALUE_WORK(ISIZE))
+IF (GCOMPRESS.OR.GMULTITYPE) THEN
+ ALLOCATE (ZINTER(ISIZE))
+ ZINTER(:) = 0.
+ENDIF
!
IF (LHOOK) CALL DR_HOOK('READ_DIRECT_GAUSS_2',1,ZHOOK_HANDLE)
IF (LHOOK) CALL DR_HOOK('READ_DIRECT_GAUSS_3',0,ZHOOK_HANDLE)
@@ -253,7 +309,14 @@ IF (LHOOK) CALL DR_HOOK('READ_DIRECT_GAUSS_4',0,ZHOOK_HANDLE)
! -------------
!
IRECLENGTH = IBITS/8 * INBCOL
-ALLOCATE (ZVALUE(INBCOL))
+ALLOCATE (ZVALUE (INBCOL))
+ZVALUE(:) = 0.
+!
+IF (GCOMPRESS) THEN
+ ALLOCATE(YCPT32(INBLINE))
+ ALLOCATE(ICPT0 (INBLINE))
+ENDIF
+!
IF (YTYPE=='INTEGER' .AND. IBITS== 8) THEN
ALLOCATE (YVALUE8 (INBCOL))
ELSEIF (YTYPE=='INTEGER' .AND. IBITS==16) THEN
@@ -270,9 +333,21 @@ ENDIF
!
!* 7.2 Openning of direct access file
! ------------------------------
+!
+YACCESS = 'DIRECT'
+IF (GCOMPRESS) THEN
+ YACCESS='STREAM'
+ LITTLE_ENDIAN_ARCH = .FALSE.
+ENDIF
!
CALL OPEN_FILE(HPROGRAM,IGLB,YFILENAME,'UNFORMATTED', &
- HACTION='READ',HACCESS='DIRECT',KRECL=IRECLENGTH )
+ HACTION='READ',HACCESS=YACCESS,KRECL=IRECLENGTH )
+!
+! we read numbers of elements by line of the grid at the beginning
+IF (GCOMPRESS) THEN
+ READ(IGLB) YCPT32
+ ICPT0(:) = TRANSFER(YCPT32(:),1_4,INBLINE)
+ENDIF
!
IF (LHOOK) CALL DR_HOOK('READ_DIRECT_GAUSS_4',1,ZHOOK_HANDLE)
IF (LHOOK) CALL DR_HOOK('READ_DIRECT_GAUSS_5',0,ZHOOK_HANDLE)
@@ -281,16 +356,51 @@ IF (LHOOK) CALL DR_HOOK('READ_DIRECT_GAUSS_5',0,ZHOOK_HANDLE)
!* 4. loop on mask meshes (lat)
! -------------------
!
+!IMASK contains the indexes of lat to be read (inside the domain)
+IMASK(:) = 0
+ICPT = 0
+DO JLAT = 1,360
+ IF ( .NOT. ANY(LLATLONMASK(:,JLAT)) ) CYCLE
+ ZLATMIN = (JLAT-180)/2. - 0.5
+ ZLATMAX = (JLAT-180)/2.
+ IF ( .NOT. ANY(ZLAT(:)<ZLATMAX .AND. ZLAT(:)>=ZLATMIN) ) CYCLE
+ ICPT = ICPT + 1
+ IMASK(ICPT) = JLAT
+ENDDO
+!
+!INB: number of lat to be read
+INB = ICPT
+!
+!IPAS: number of lat to be read for each task
+IPAS = CEILING(INB*1./NPROC)
+!
GSWAP = .FALSE.
!
-JLAT = 0
+!first lat read for this task
+IDEB = IPAS*NRANK
+!
+ICPT = 0
+!
+JL = IPAS + 1
+!
+IF (GCOMPRESS) ILINE_COMPRESS = 1
+!
+IWORK=0
+!
+INODATA = ZNODATA
+INODATA2 = ISHFTC(INODATA,8)
+ZNODATA2 = INODATA2
!
DO
!
- JLAT = JLAT + 1
- IF (JLAT==361) EXIT
+ !the file is read from the top to the bottom (quicker)
+ JL = JL - 1
+ IF (JL==0) EXIT
!
- IF ( .NOT. ANY(LLATLONMASK(:,JLAT)) ) CYCLE
+ IF (IDEB+JL>INB) CYCLE
+ !
+ !lat read by this task for this loop index JL
+ JLAT = IMASK(IDEB+JL)
!
ZLATMIN = (JLAT-180)/2. - 0.5
ZLATMAX = (JLAT-180)/2.
@@ -302,17 +412,31 @@ DO
!
ILINE1=MAX(MIN(INT((ZGLBLATMAX-ZDLAT/2.-ZLATMAX)/ZDLAT+1.),INBLINE),0)+1
ILINE2=MAX(MIN(INT((ZGLBLATMAX-ZDLAT/2.-ZLATMIN)/ZDLAT+1.),INBLINE),0)
- IF ( .NOT. ANY(ZLAT(:)<ZLATMAX .AND. ZLAT(:)>=ZLATMIN) ) CYCLE
!
!----------------------------------------------------------------------------
!
!* 8. Loop on lines
! -------------
!
- IWORK=0
+ INBLINES = ILINE2 - ILINE1 + 1
+ !
+ ! first IPOS for this task is the first information plus the
+ ! number of elements by lines before the first to read
+ IF (GCOMPRESS.AND.(JL==IPAS.OR.ILINE_COMPRESS<ILINE1)) THEN
+ IPOS = 0
+ IF (ILINE1>1) THEN
+ DO JLOOP=1,ILINE1-1
+ IPOS = IPOS + ICPT0(JLOOP)
+ ENDDO
+ ENDIF
+ IPOS = IPOS*2 + 1 + INBLINE*4
+ ILINE_COMPRESS = ILINE1
+ ELSE
+ IPOS = 0
+ ENDIF
+ !
DO JLINE = ILINE1,ILINE2
!
- INBLINES = ILINE2 - ILINE1 + 1
!----------------------------------------------------------------------------
!
!* 10. Reading in the direct access file
@@ -321,7 +445,7 @@ DO
!* 10.1 Record number
! -------------
!
- IREC=JLINE
+ IREC = JLINE
!
!* 10.2 Reading the correct data type and conversion into real
! ------------------------------------------------------
@@ -333,21 +457,48 @@ DO
WHERE (ZVALUE(:)<0.) ZVALUE(:) = NINT(256.+ZVALUE(:))
!
ELSE IF (YTYPE=='INTEGER' .AND. IBITS==16) THEN
- READ(IGLB,REC=IREC) YVALUE16(:)
- ZVALUE(:)=YVALUE16(:)
!
- IF ( ANY(ABS(ZVALUE)>15000) ) THEN
- IF (GSWAP) CALL ABOR1_SFX('READ_DIRECT_GAUSS: SWAP ALREADY DONE, CANNOT BE REDONE')
- LITTLE_ENDIAN_ARCH = .NOT. LITTLE_ENDIAN_ARCH
- GSWAP = .TRUE.
- WRITE(ILUOUT,*) '*******************************************************************'
- WRITE(ILUOUT,*) 'Architecture of the machine needs to swap LITTLE_ENDIAN_ARCH to ', &
- LITTLE_ENDIAN_ARCH
- WRITE(ILUOUT,*) '*******************************************************************'
- JLAT = 0
- CALL REFRESH_PGDWORK
- EXIT ! rereads the file
- END IF
+ IF (GCOMPRESS) THEN
+ IF (IPOS/=0) THEN
+ READ(IGLB,POS=IPOS) YVALUE16(1:ICPT0(JLINE))
+ IPOS = 0
+ ELSE
+ READ(IGLB) YVALUE16(1:ICPT0(JLINE))
+ ENDIF
+ ZVALUE(1:ICPT0(JLINE))=YVALUE16(1:ICPT0(JLINE))
+ ILINE_COMPRESS = ILINE_COMPRESS + 1
+ ELSE
+ READ(IGLB,REC=IREC) YVALUE16(:)
+ ZVALUE(:)=YVALUE16(:)
+ ENDIF
+ !
+ IF (ICPT==0.AND..NOT.GCOMPRESS) THEN
+ IF ( (HFIELD(1:5)=="COVER" .AND. (ANY(ZVALUE>JPCOVER.AND.ZVALUE/=ZNODATA) .OR. &
+ ANY(ZVALUE<0..AND.ZVALUE/=ZNODATA) .OR. ALL(ZVALUE==256.)) ) .OR. &
+ (ZNODATA/=0 .AND. (ALL(ZVALUE==ZNODATA2))) .OR. &
+ ((HFIELD(1:4)=="SAND" .OR. HFIELD(1:4)=="CLAY") .AND. &
+ (ANY(ZVALUE>100..AND.ZVALUE/=ZNODATA) .OR. ANY(ZVALUE<0..AND.ZVALUE/=ZNODATA)) ) .OR. &
+ (HFIELD(1:3)=="SOC" .AND. (ANY(ZVALUE>15000..AND.ZVALUE/=ZNODATA) .OR. ANY(ZVALUE<0..AND.ZVALUE/=ZNODATA)) ) .OR. &
+ ((HFIELD(1:5)/="COVER" .AND. HFIELD(1:4)/="SAND" .AND. HFIELD(1:4)/="CLAY" .AND. &
+ HFIELD(1:3)/="SOC" .AND. ANY(ZVALUE>15000..AND.ZVALUE/=ZNODATA) ) ) ) THEN
+ ICPT = ICPT + 1
+ IF (GSWAP) CALL ABOR1_SFX('READ_DIRECT_GAUSS: SWAP ALREADY DONE, CANNOT BE REDONE')
+ LITTLE_ENDIAN_ARCH = .NOT. LITTLE_ENDIAN_ARCH
+ GSWAP = .TRUE.
+ IF (NRANK==NPIO) THEN
+ WRITE(ILUOUT,*) '*******************************************************************'
+ WRITE(ILUOUT,*) 'Architecture of the machine needs to swap LITTLE_ENDIAN_ARCH to ', &
+ LITTLE_ENDIAN_ARCH
+ WRITE(ILUOUT,*) '*******************************************************************'
+ ENDIF
+ JL = IPAS + 1 !back to first lat
+ IWORK = 0
+ IF (HFIELD(1:5)=="COVER") U%LCOVER(:) = .FALSE.
+ CALL REFRESH_PGDWORK(HSUBROUTINE)
+ EXIT ! rereads the file
+ ENDIF
+ ENDIF
+ !
!
ELSE IF (YTYPE=='INTEGER' .AND. IBITS==32) THEN
READ(IGLB,REC=IREC) IVALUE32(:)
@@ -361,47 +512,63 @@ DO
READ(IGLB,REC=IREC) YVALUE32R(:)
ZVALUE(:)=YVALUE32R(:)
!
- IF ( ANY(ABS(ZVALUE)>0. .AND. ABS(ZVALUE)<1.E-50) &
- .OR. ANY(ABS(ZVALUE)>1.E20) ) THEN
- IF (GSWAP) CALL ABOR1_SFX('READ_DIRECT_GAUSS: SWAP ALREADY DONE, CANNOT BE REDONE')
- LITTLE_ENDIAN_ARCH = .NOT. LITTLE_ENDIAN_ARCH
- GSWAP = .TRUE.
- WRITE(ILUOUT,*) '*******************************************************************'
- WRITE(ILUOUT,*) 'Architecture of the machine needs to swap LITTLE_ENDIAN_ARCH to ', &
- LITTLE_ENDIAN_ARCH
- WRITE(ILUOUT,*) '*******************************************************************'
- JLAT = 0
- CALL REFRESH_PGDWORK
- EXIT
+ IF (ICPT==0) THEN
+ IF ( ANY(ABS(ZVALUE)>0. .AND. ABS(ZVALUE)<1.E-50) &
+ .OR. ANY(ABS(ZVALUE)>1.E20) ) THEN
+ ICPT = ICPT + 1
+ IF (GSWAP) CALL ABOR1_SFX('READ_DIRECT_GAUSS: SWAP ALREADY DONE, CANNOT BE REDONE')
+ LITTLE_ENDIAN_ARCH = .NOT. LITTLE_ENDIAN_ARCH
+ GSWAP = .TRUE.
+ IF (NRANK==NPIO) THEN
+ WRITE(ILUOUT,*) '*******************************************************************'
+ WRITE(ILUOUT,*) 'Architecture of the machine needs to swap LITTLE_ENDIAN_ARCH to ', &
+ LITTLE_ENDIAN_ARCH
+ WRITE(ILUOUT,*) '*******************************************************************'
+ ENDIF
+ JL = IPAS + 1
+ IWORK = 0
+ CALL REFRESH_PGDWORK(HSUBROUTINE)
+ EXIT
+ ENDIF
END IF
- !
+ !
ELSE IF (YTYPE=='REAL ' .AND. IBITS==64) THEN
READ(IGLB,REC=IREC) YVALUE64(:)
ZVALUE(:)=YVALUE64(:)
!
- IF ( ANY(ABS(ZVALUE)>0. .AND. ABS(ZVALUE)<1.E-50) &
- .OR. ANY(ABS(ZVALUE)>1.E20) ) THEN
- IF (GSWAP) CALL ABOR1_SFX('READ_DIRECT_GAUSS: SWAP ALREADY DONE, CANNOT BE REDONE')
- LITTLE_ENDIAN_ARCH = .NOT. LITTLE_ENDIAN_ARCH
- GSWAP = .TRUE.
- WRITE(ILUOUT,*) '*******************************************************************'
- WRITE(ILUOUT,*) 'Architecture of the machine needs to swap LITTLE_ENDIAN_ARCH to ', &
- LITTLE_ENDIAN_ARCH
- WRITE(ILUOUT,*) '*******************************************************************'
- JLAT = 0
- CALL REFRESH_PGDWORK
- EXIT
- END IF
+ IF (ICPT==0) THEN
+ IF ( ANY(ABS(ZVALUE)>0. .AND. ABS(ZVALUE)<1.E-50) &
+ .OR. ANY(ABS(ZVALUE)>1.E20) ) THEN
+ ICPT = ICPT + 1
+ IF (GSWAP) CALL ABOR1_SFX('READ_DIRECT_GAUSS: SWAP ALREADY DONE, CANNOT BE REDONE')
+ LITTLE_ENDIAN_ARCH = .NOT. LITTLE_ENDIAN_ARCH
+ GSWAP = .TRUE.
+ IF (NRANK==NPIO) THEN
+ WRITE(ILUOUT,*) '*******************************************************************'
+ WRITE(ILUOUT,*) 'Architecture of the machine needs to swap LITTLE_ENDIAN_ARCH to ', &
+ LITTLE_ENDIAN_ARCH
+ WRITE(ILUOUT,*) '*******************************************************************'
+ ENDIF
+ JL = IPAS + 1
+ IWORK = 0
+ CALL REFRESH_PGDWORK(HSUBROUTINE)
+ EXIT
+ ENDIF
+ ENDIF
!
ELSE
- CALL ABOR1_SFX('READ_DIRECT_GAUSS1: DATA TYPE NOT SUPPORTED')
+ CALL ABOR1_SFX('READ_DIRECT_GAUSS: DATA TYPE NOT SUPPORTED')
END IF
!
IF(HFIELD=='CTI')THEN
WHERE(ZVALUE(:)<0.0) ZVALUE(:)=ZNODATA
ENDIF
!
- WHERE(ZVALUE(:)/=ZNODATA)ZVALUE(:)=ZVALUE(:)/ZFACT
+ IF (GCOMPRESS) THEN
+ WHERE (ZVALUE(1:ICPT0(JLINE))<0.) ZVALUE(1:ICPT0(JLINE)) = NINT(32768*2.+ZVALUE(1:ICPT0(JLINE)))
+ ZINTER(1:ICPT0(JLINE)) = ZVALUE(1:ICPT0(JLINE))
+ CALL UNCOMPRESS_FIELD(INBCOL,4000.,ZINTER(1:ICPT0(JLINE)),ZVALUE(:))
+ ENDIF
!
!----------------------------------------------------------------------------
!
@@ -423,7 +590,7 @@ DO
!* 5.1 left domain border is set just higher than the global field min. longitude
! -----------------------------------------------------------------
!
- ZSHIFT = 360. * NINT((ZLONMIN-ZGLBLONMIN-180.+1.E-10)/360.)
+ ZSHIFT = 360. * NINT((ZLONMIN-ZGLBLONMIN-180.*(1-XSURF_EPSILON))/360.)
!
ZGLBLONMIN = ZGLBLONMIN + ZSHIFT
ZGLBLONMAX = ZGLBLONMAX + ZSHIFT
@@ -467,6 +634,8 @@ DO
!* 11.2 Test with respect to the 'no data' value
! ----------------------------------------
!
+ !IF (ABS(ZVALUE(ICOLINDEX)-ZNODATA)<=1.E-10) CYCLE
+ !
!* 11.3 copy of the correct values in a work array
! ------------------------------------------
!
@@ -481,17 +650,31 @@ DO
!-------------------------------------------------------------------------------
END DO !JLON
!-------------------------------------------------------------------------------
+ IF (MOD((JLINE-ILINE1+1),INB_LINE_READ)==0.OR.JLINE==ILINE2) THEN
+ !
+ IF (.NOT.GMULTITYPE.AND.IFACT/=1) THEN
+ WHERE(ZVALUE_WORK(1:IWORK)/=ZNODATA)
+ ZVALUE_WORK(1:IWORK)=ZVALUE_WORK(1:IWORK)/FLOAT(IFACT)
+ END WHERE
+ ENDIF
+ !
+ !* 12. Call to the adequate subroutine (point by point treatment)
+ ! ----------------------------------------------------------
+ !
+ IF (IWORK>0) THEN
+ CALL PT_BY_PT_TREATMENT(UG, U, USS, &
+ ILUOUT, ZLAT_WORK(1:IWORK),ZLON_WORK(1:IWORK), &
+ ZVALUE_WORK(1:IWORK), HSUBROUTINE, INBLINES, &
+ ZNODATA, GMULTITYPE, IFACT )
+ ENDIF
+ !
+ IWORK = 0
+ !
+ ENDIF
+
END DO ! JLINE
!-------------------------------------------------------------------------------
!
- !* 12. Call to the adequate subroutine (point by point treatment)
- ! ----------------------------------------------------------
- !
- IF (IWORK>0) &
- CALL PT_BY_PT_TREATMENT(USS, &
- ILUOUT, ZLAT_WORK(1:IWORK),ZLON_WORK(1:IWORK), &
- ZVALUE_WORK(1:IWORK), &
- HSUBROUTINE, INBLINES, ZNODATA )
!
!-------------------------------------------------------------------------------
END DO !JLAT
@@ -509,6 +692,7 @@ DEALLOCATE(ZLON_WORK )
DEALLOCATE(ZVALUE_WORK)
!
DEALLOCATE (ZVALUE)
+IF (ALLOCATED(ZINTER)) DEALLOCATE (ZINTER)
IF (ALLOCATED(YVALUE8)) DEALLOCATE (YVALUE8 )
IF (ALLOCATED(YVALUE16)) DEALLOCATE (YVALUE16)
IF (ALLOCATED(YVALUE32R)) DEALLOCATE (YVALUE32R)
diff --git a/src/SURFEX/read_dummyn.F90 b/src/SURFEX/read_dummyn.F90
index 0779d4854b88a8b5086b207410e2a994da7533c8..7f5f57bc964b629b67b79b5f850721a27283b19c 100644
--- a/src/SURFEX/read_dummyn.F90
+++ b/src/SURFEX/read_dummyn.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_DUMMY_n (&
- DUU, U, &
- HPROGRAM)
+ SUBROUTINE READ_DUMMY_n (DUU, KSIZE_FULL, HPROGRAM)
! #################################
!
!!**** *READ_DUMMY_n* - routine to READ dummy surface fields
@@ -26,13 +24,7 @@
!* 0. DECLARATIONS
! ------------
!
-!
-!
-!
-!
-!
USE MODD_DUMMY_SURF_FIELDS_n, ONLY : DUMMY_SURF_FIELDS_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODI_READ_SURF
!
@@ -49,7 +41,7 @@ IMPLICIT NONE
!
!
TYPE(DUMMY_SURF_FIELDS_t), INTENT(INOUT) :: DUU
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+INTEGER, INTENT(IN) :: KSIZE_FULL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !
!
@@ -75,8 +67,7 @@ IF (LHOOK) CALL DR_HOOK('READ_DUMMY_N',0,ZHOOK_HANDLE)
YRECFM='DUMMY_GR_NBR'
YCOMMENT=' '
!
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DUU%NDUMMY_NBR,IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,DUU%NDUMMY_NBR,IRESP,HCOMMENT=YCOMMENT)
!
!-------------------------------------------------------------------------------
!
@@ -85,16 +76,15 @@ YCOMMENT=' '
!
ALLOCATE(DUU%CDUMMY_NAME(DUU%NDUMMY_NBR))
ALLOCATE(DUU%CDUMMY_AREA(DUU%NDUMMY_NBR))
-ALLOCATE(DUU%XDUMMY_FIELDS(U%NSIZE_FULL,DUU%NDUMMY_NBR))
+ALLOCATE(DUU%XDUMMY_FIELDS(KSIZE_FULL,DUU%NDUMMY_NBR))
DUU%CDUMMY_NAME(:) = ' '
DUU%CDUMMY_AREA(:) = ' '
!
!
DO JDUMMY=1,DUU%NDUMMY_NBR
!
- WRITE(YRECFM,FMT='(A8,I3.3,A1)') 'DUMMY_GR',JDUMMY,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DUU%XDUMMY_FIELDS(:,JDUMMY),IRESP,HCOMMENT=YCOMMENT)
+ WRITE(YRECFM,FMT='(A8,I3.3,A1)') 'DUMMY_GR',JDUMMY,' '
+ CALL READ_SURF(HPROGRAM,YRECFM,DUU%XDUMMY_FIELDS(:,JDUMMY),IRESP,HCOMMENT=YCOMMENT)
!
!
YSTRING20=YCOMMENT(21:40)
diff --git a/src/SURFEX/read_flake_confn.F90 b/src/SURFEX/read_flake_confn.F90
index f32990de31114631204601b02cabe26e8415e4fd..22a0bdb5108719a1a4537f6ea2da7247eca2d4ea 100644
--- a/src/SURFEX/read_flake_confn.F90
+++ b/src/SURFEX/read_flake_confn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_FLAKE_CONF_n (CHF, DGF, DGMF, F, &
- HPROGRAM)
+ SUBROUTINE READ_FLAKE_CONF_n (CHF, DGO, DMF, F, HPROGRAM)
! #############################################################
!
!!**** *READ_FLAKE_CONF* - reads the configuration for FLAKE
@@ -46,7 +45,7 @@
!
!
USE MODD_CH_FLAKE_n, ONLY : CH_FLAKE_t
-USE MODD_DIAG_FLAKE_n, ONLY : DIAG_FLAKE_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
USE MODD_DIAG_MISC_FLAKE_n, ONLY : DIAG_MISC_FLAKE_t
USE MODD_FLAKE_n, ONLY : FLAKE_t
!
@@ -76,8 +75,8 @@ IMPLICIT NONE
!
!
TYPE(CH_FLAKE_t), INTENT(INOUT) :: CHF
-TYPE(DIAG_FLAKE_t), INTENT(INOUT) :: DGF
-TYPE(DIAG_MISC_FLAKE_t), INTENT(INOUT) :: DGMF
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_MISC_FLAKE_t), INTENT(INOUT) :: DMF
TYPE(FLAKE_t), INTENT(INOUT) :: F
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling ISBA
@@ -105,8 +104,8 @@ IMI=GET_CURRENT_MODEL_INDEX_SURFEX()
!
IF (IMI.NE.-1 .AND. LNAM_READ) THEN
CALL INIT_NAM_FLAKEn(F)
- CALL INIT_NAM_DIAG_SURFn(DGF)
- CALL INIT_NAM_DIAG_FLAKEn(DGMF)
+ CALL INIT_NAM_DIAG_SURFn(DGO)
+ CALL INIT_NAM_DIAG_FLAKEn(DMF)
CALL INIT_NAM_CH_FLAKEn(CHF)
ENDIF
!
@@ -145,8 +144,8 @@ ENDIF
!
IF (IMI.NE.-1) THEN
CALL UPDATE_NAM_FLAKEn(F)
- CALL UPDATE_NAM_DIAG_SURFn(DGF)
- CALL UPDATE_NAM_DIAG_FLAKEn(DGMF)
+ CALL UPDATE_NAM_DIAG_SURFn(DGO)
+ CALL UPDATE_NAM_DIAG_FLAKEn(DMF)
CALL UPDATE_NAM_CH_FLAKEn(CHF)
ENDIF
!
diff --git a/src/SURFEX/read_flake_sbln.F90 b/src/SURFEX/read_flake_sbln.F90
deleted file mode 100644
index 6d6105504be365494f80d79ec4d42ba4ce9deb23..0000000000000000000000000000000000000000
--- a/src/SURFEX/read_flake_sbln.F90
+++ /dev/null
@@ -1,233 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE READ_FLAKE_SBL_n (DTCO, U, F, FSB, &
- HPROGRAM)
-! #########################################
-!
-!!**** *READ_FLAKE_SBL_n* - reads FLAKE fields
-!!
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2003
-!! E. Martin 01/2012 Add LSBL_COLD_START
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!
-!
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_FLAKE_n, ONLY : FLAKE_t
-USE MODD_FLAKE_SBL_n, ONLY : FLAKE_SBL_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE MODI_READ_SURF
-USE MODI_CANOPY_GRID
-USE MODI_GET_TYPE_DIM_n
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
-!
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(FLAKE_t), INTENT(INOUT) :: F
-TYPE(FLAKE_SBL_t), INTENT(INOUT) :: FSB
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
-!
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=3) :: YREAD
-INTEGER :: ILU ! 1D physical dimension
-INTEGER :: IRESP ! Error code after redding
-INTEGER :: JLAYER ! loop counter on layers
-INTEGER :: IVERSION, IBUGFIX
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-!* 1D physical dimension
-!
-IF (LHOOK) CALL DR_HOOK('READ_FLAKE_SBL_N',0,ZHOOK_HANDLE)
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'WATER ',ILU)
-!
-YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
-!
-YRECFM='BUG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IBUGFIX,IRESP)
-!
-!* flag to use or not SBL levels
-!
-YRECFM='WAT_SBL'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,F%LSBL,IRESP)
-!
-IF (.NOT.F%LSBL) THEN
- ALLOCATE(FSB%XZ (0,0))
- ALLOCATE(FSB%XU (0,0))
- ALLOCATE(FSB%XT (0,0))
- ALLOCATE(FSB%XQ (0,0))
- ALLOCATE(FSB%XTKE(0,0))
- ALLOCATE(FSB%XLMO(0) )
- ALLOCATE(FSB%XP (0,0))
- ALLOCATE(FSB%XDZ (0,0))
- ALLOCATE(FSB%XZF (0,0))
- ALLOCATE(FSB%XDZF(0,0))
- IF (LHOOK) CALL DR_HOOK('READ_SEAFLUX_SBL_N',1,ZHOOK_HANDLE)
- RETURN
-ENDIF
-!
-!* number of vertical levels
-!
-YRECFM='WAT_SBL_LVL'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,FSB%NLVL,IRESP)
-!
-!* 2. Prognostic fields:
-! -----------------
-!
-!* altitudes
-!
-ALLOCATE(FSB%XZ(ILU,FSB%NLVL))
-!
-DO JLAYER=1,FSB%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_Z',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,FSB%XZ(:,JLAYER),IRESP)
-END DO
-!
-ALLOCATE(FSB%XU (ILU,FSB%NLVL))
-ALLOCATE(FSB%XT (ILU,FSB%NLVL))
-ALLOCATE(FSB%XQ (ILU,FSB%NLVL))
-ALLOCATE(FSB%XTKE(ILU,FSB%NLVL))
-ALLOCATE(FSB%XLMO(ILU) )
-ALLOCATE(FSB%XP (ILU,FSB%NLVL))
-!
-IF (IVERSION>7 .OR. IVERSION==7 .AND.IBUGFIX>=2) THEN
- YRECFM='STORAGETYPE'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,YREAD,IRESP)
-ELSE
- YREAD = 'ALL'
-ENDIF
-!
-IF(YREAD=='ALL') THEN
- !
- !* wind in SBL
- DO JLAYER=1,FSB%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_U',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,FSB%XU(:,JLAYER),IRESP)
- END DO
- !
- !* theta in SBL
- DO JLAYER=1,FSB%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_T',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,FSB%XT(:,JLAYER),IRESP)
- END DO
- !
- !* humidity in SBL
- DO JLAYER=1,FSB%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_Q',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,FSB%XQ(:,JLAYER),IRESP)
- END DO
- !
- !* Tke in SBL
- DO JLAYER=1,FSB%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_E',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,FSB%XTKE(:,JLAYER),IRESP)
- END DO
- !
- !* Monin-Obhukov length
- YRECFM='WAT_SBL_LMO '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,FSB%XLMO(:),IRESP)
- !
- !* Pressure
- DO JLAYER=1,FSB%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_P',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,FSB%XP(:,JLAYER),IRESP)
- END DO
- !
-ELSE
- FSB%XU (:,:) = XUNDEF
- FSB%XT (:,:) = XUNDEF
- FSB%XQ (:,:) = XUNDEF
- FSB%XTKE(:,:) = XUNDEF
- FSB%XLMO(:) = XUNDEF
- FSB%XP (:,:) = XUNDEF
-ENDIF
-!
-!
-!* Grid characteristics
-!
-!
-! --------------------------------- XZ(k+1) XDZ(k+1)
-! ^
-! |
-! |
-! - - - - - - - - - - - - - - - - - XZf(k+1) | XDZf(k+1)
-! ^ |
-! | |
-! --------------------------------- XZ(k), XU, XT, XQ, XTKE | XDZ(k) V
-! | ^
-! - - - - - - - - - - - - - - - - - XZf(k) V | XDZf(k)
-! --------------------------------- XZ(k-1) XDZ(k-1) V
-! - - - - - - - - - - - - - - - - - XZf(k-1)
-!
-ALLOCATE(FSB%XDZ (ILU,FSB%NLVL))
-ALLOCATE(FSB%XZF (ILU,FSB%NLVL))
-ALLOCATE(FSB%XDZF(ILU,FSB%NLVL))
- CALL CANOPY_GRID(ILU,FSB%NLVL,FSB%XZ,FSB%XZF,FSB%XDZ,FSB%XDZF)
-!
-IF (LHOOK) CALL DR_HOOK('READ_FLAKE_SBL_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE READ_FLAKE_SBL_n
diff --git a/src/SURFEX/read_flaken.F90 b/src/SURFEX/read_flaken.F90
index cf07ea4eb09d1b4fbf3fe75c2b2154808414f0db..707c0d2f7b67278fe0ff78f9236fe182d6ce70d9 100644
--- a/src/SURFEX/read_flaken.F90
+++ b/src/SURFEX/read_flaken.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_FLAKE_n (DTCO, U, F, &
- HPROGRAM)
+ SUBROUTINE READ_FLAKE_n (DTCO, U, F, HPROGRAM)
! #########################################
!
!!**** *READ_FLAKE_n* - reads FLAKE variables
@@ -85,8 +84,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('READ_FLAKE_N',0,ZHOOK_HANDLE)
YRECFM='SIZE_WATER'
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'WATER ',ILU)
+ CALL GET_TYPE_DIM_n(DTCO, U, 'WATER ',ILU)
!
!* 3. Prognostic fields:
! -----------------
@@ -108,41 +106,29 @@ ALLOCATE(F%XH_ML (ILU))
ALLOCATE(F%XH_B1 (ILU))
YRECFM='TS_WATER'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,F%XTS(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,F%XTS(:),IRESP)
YRECFM='T_SNOW'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,F%XT_SNOW(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,F%XT_SNOW(:),IRESP)
YRECFM='T_ICE'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,F%XT_ICE(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,F%XT_ICE(:),IRESP)
YRECFM='T_MNW'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,F%XT_MNW(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,F%XT_MNW(:),IRESP)
YRECFM='T_WML'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,F%XT_WML(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,F%XT_WML(:),IRESP)
YRECFM='T_BOT'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,F%XT_BOT(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,F%XT_BOT(:),IRESP)
YRECFM='T_B1'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,F%XT_B1(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,F%XT_B1(:),IRESP)
YRECFM='CT'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,F%XCT(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,F%XCT(:),IRESP)
YRECFM='H_SNOW'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,F%XH_SNOW(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,F%XH_SNOW(:),IRESP)
YRECFM='H_ICE'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,F%XH_ICE(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,F%XH_ICE(:),IRESP)
YRECFM='H_ML'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,F%XH_ML(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,F%XH_ML(:),IRESP)
YRECFM='H_B1'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,F%XH_B1(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,F%XH_B1(:),IRESP)
!
!-------------------------------------------------------------------------------
!
@@ -154,8 +140,7 @@ YRECFM='H_B1'
ALLOCATE(F%XZ0(ILU))
YRECFM='Z0WATER'
F%XZ0(:) = 0.001
- CALL READ_SURF(&
- HPROGRAM,YRECFM,F%XZ0(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,F%XZ0(:),IRESP)
!
!
!* friction velocity
@@ -163,8 +148,7 @@ YRECFM='H_B1'
ALLOCATE(F%XUSTAR(ILU))
YRECFM='USTAR_WATER'
F%XUSTAR(:) = 0.
- CALL READ_SURF(&
- HPROGRAM,YRECFM,F%XUSTAR(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,F%XUSTAR(:),IRESP)
IF (LHOOK) CALL DR_HOOK('READ_FLAKE_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/read_from_surfex_file.F90 b/src/SURFEX/read_from_surfex_file.F90
index d80c1800ff7fbca9dd3813ab6d770be5116392ad..d7e279d5d45b2d3d411b595e2c3935f323b5f08c 100644
--- a/src/SURFEX/read_from_surfex_file.F90
+++ b/src/SURFEX/read_from_surfex_file.F90
@@ -2,14 +2,13 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
-SUBROUTINE READ_FROM_SURFEX_FILE (DTCO, DGU, U, &
+SUBROUTINE READ_FROM_SURFEX_FILE (DTCO, U, &
HFTYP,HFNAM,HMASK,HSCHEME,PFIELD,HNAM)
!
!
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODI_INIT_IO_SURF_n
@@ -37,7 +36,6 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
@@ -82,7 +80,7 @@ ELSEIF (HFTYP=='NC ') THEN
CALL SET_SURFEX_FILE_NAME_NC(HNAME_IN=HNAME)
#endif
ENDIF
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
+CALL INIT_IO_SURF_n(DTCO, U, &
HFTYP,HMASK,HSCHEME,'READ ')
CALL READ_SURF(&
HFTYP,YRECFM,PFIELD,IRESP)
diff --git a/src/SURFEX/read_gr_snow.F90 b/src/SURFEX/read_gr_snow.F90
index 21b37f8cdc1ab5b666a9a7deda5d633744b3b72b..d806efd7d64498b0ff7b8f04a8e78f90e88769dd 100644
--- a/src/SURFEX/read_gr_snow.F90
+++ b/src/SURFEX/read_gr_snow.F90
@@ -3,9 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_GR_SNOW (&
- HPROGRAM,HSURFTYPE,HPREFIX, &
- KLU,KPATCH,TPSNOW,HDIR,KVERSION,KBUGFIX)
+ SUBROUTINE READ_GR_SNOW(HPROGRAM, HSURFTYPE, HPREFIX, &
+ KLU, KSIZE_P, KMASK_P, KPATCH, TPSNOW, HDIR, KVERSION, KBUGFIX, KNPATCH)
! ##########################################################
!
!!**** *READ_GR_SNOW* - routine to read snow surface fields
@@ -33,7 +32,7 @@
!!
!! AUTHOR
!! ------
-!! V. Masson * Meteo France *
+!! V. Masson * Meteo France *
!!
!! MODIFICATIONS
!! -------------
@@ -41,21 +40,16 @@
! F.solmon 06/00 adaptation for patch
! V.Masson 01/03 new version of ISBA
! B. Decharme 2008 If no WSNOW, WSNOW = XUNDEF
-!! M.Moge 01/2016 using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads
!-----------------------------------------------------------------------------
!
!* 0. DECLARATIONS
!
-!
-!
-!
USE MODD_TYPE_SNOW
!
USE MODI_READ_SURF
-USE MODI_READ_SURF_FIELD2D
-USE MODI_READ_SURF_FIELD3D
!
USE MODI_ALLOCATE_GR_SNOW
+USE MODI_PACK_SAME_RANK
!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_PREP_SNOW, ONLY : LSNOW_FRAC_TOT
@@ -66,8 +60,6 @@ USE PARKIND1 ,ONLY : JPRB
IMPLICIT NONE
!
!* 0.1 declarations of arguments
-!
-!
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
CHARACTER (LEN=*), INTENT(IN) :: HSURFTYPE ! generic name used for
@@ -76,97 +68,126 @@ IMPLICIT NONE
CHARACTER (LEN=3), INTENT(IN) :: HPREFIX ! generic name for patch
! ! identification
INTEGER, INTENT(IN) :: KLU ! horizontal size of snow var.
+INTEGER, INTENT(IN) :: KSIZE_P
+INTEGER, DIMENSION(:), INTENT(IN) :: KMASK_P
INTEGER, INTENT(IN) :: KPATCH ! number of tiles
-TYPE(SURF_SNOW) :: TPSNOW ! snow characteristics
+TYPE(SURF_SNOW), INTENT(INOUT) :: TPSNOW ! snow characteristics
CHARACTER (LEN=1), INTENT(IN), OPTIONAL :: HDIR ! type of reading
! ! HDIR = 'A' : entire field on All processors
! ! HDIR = 'H' : distribution on each processor
!
INTEGER, INTENT(IN), OPTIONAL :: KVERSION
INTEGER, INTENT(IN), OPTIONAL :: KBUGFIX
+INTEGER, INTENT(IN), OPTIONAL :: KNPATCH
!
!* 0.2 declarations of local variables
!
-INTEGER :: IRESP ! Error code after redding
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=LEN_HREC) :: YRECFM2
-!
+ CHARACTER (LEN=7) :: YFMT0 ! format for writing
CHARACTER (LEN=100) :: YFMT ! format for writing
-INTEGER :: ISURFTYPE_LEN !
-LOGICAL :: GSNOW ! snow written in the file
-INTEGER :: JLAYER ! loop counter
-REAL, DIMENSION(:,:),ALLOCATABLE :: ZWORK ! 2D array to write data in file
- CHARACTER(LEN=1) :: YDIR ! type of reading
+ CHARACTER(LEN=LEN_HREC) :: YRECFM2
+ CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
CHARACTER(LEN=4) :: YNLAYER !Format depending on the number of layers
+ CHARACTER(LEN=1) :: YDIR ! type of reading
+ CHARACTER(LEN=3) :: YPAT
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK
+!
+INTEGER :: IRESP, JI, JP ! Error code after redding
+INTEGER :: ISURFTYPE_LEN, IPAT_LEN !
+INTEGER :: JL ! loop counter
INTEGER :: IVERSION, IBUGFIX
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+INTEGER :: INPATCH
+!
+LOGICAL :: GVERSION, GDIM, GDIM2
+LOGICAL :: GSNOW ! snow written in the file
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!-------------------------------------------------------------------------------
!
-IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW_1',0,ZHOOK_HANDLE)
+!
YDIR = 'H'
IF (PRESENT(HDIR)) YDIR = HDIR
!
+INPATCH = 1
+IF (PRESENT(KNPATCH)) INPATCH = KNPATCH
+!
!-------------------------------------------------------------------------------
IF(PRESENT(KVERSION))THEN
IVERSION=KVERSION
ELSE
- CALL READ_SURF(&
- HPROGRAM,'VERSION',IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
ENDIF
IF(PRESENT(KBUGFIX))THEN
IBUGFIX=KBUGFIX
ELSE
- CALL READ_SURF(&
- HPROGRAM,'BUG',IBUGFIX,IRESP)
+ CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP)
ENDIF
+!
+GDIM = (IVERSION>8 .OR. IVERSION==8 .AND. IBUGFIX>0)
+GDIM2 = GDIM
+IF (GDIM) CALL READ_SURF(HPROGRAM,'SPLIT_PATCH',GDIM2,IRESP)
+!
!-------------------------------------------------------------------------------
!
+GVERSION = (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3)
+!
!* 1. Type of snow scheme
! -------------------
!
ISURFTYPE_LEN=LEN_TRIM(HSURFTYPE)
-IF (IVERSION <=2 .OR. (IVERSION==3 .AND. IBUGFIX<=4)) THEN
- WRITE(YFMT,'(A5,I1,A4)') '(A5,A',ISURFTYPE_LEN,',A5)'
- WRITE(YRECFM2,YFMT) 'SNOW_',HSURFTYPE,'_TYPE'
-ELSE
- IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
- WRITE(YFMT,'(A5,I1,A4)') '(A3,A',ISURFTYPE_LEN,',A5)'
- WRITE(YRECFM2,YFMT) 'SN_',HSURFTYPE,'_TYPE'
- ELSE
- WRITE(YFMT,'(A5,I1,A4)') '(A3,A',ISURFTYPE_LEN,',A4)'
- WRITE(YRECFM2,YFMT) 'SN_',HSURFTYPE,'_TYP'
- YRECFM2=ADJUSTL(HPREFIX//YRECFM2)
- ENDIF
-END IF
-!
- CALL READ_SURF(&
- HPROGRAM,YRECFM2,TPSNOW%SCHEME,IRESP)
!
-!* 2. Snow levels
-! -----------
-!
-!
-IF (IVERSION <=2 .OR. (IVERSION==3 .AND. IBUGFIX<=4)) THEN
- WRITE(YFMT,'(A5,I1,A4)') '(A5,A',ISURFTYPE_LEN,',A6)'
- WRITE(YRECFM2,YFMT) 'SNOW_',HSURFTYPE,'_LAYER'
-ELSE
- WRITE(YFMT,'(A5,I1,A4)') '(A3,A',ISURFTYPE_LEN,',A2)'
- WRITE(YRECFM2,YFMT) 'SN_',HSURFTYPE,'_N'
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM2=ADJUSTL(HPREFIX//YRECFM2)
-END IF
-!
- CALL READ_SURF(&
- HPROGRAM,YRECFM2,TPSNOW%NLAYER,IRESP)
+IF (KPATCH<=1) THEN
+
+ IF (IVERSION <=2 .OR. (IVERSION==3 .AND. IBUGFIX<=4)) THEN
+ WRITE(YFMT,'(A5,I1,A4)') '(A5,A',ISURFTYPE_LEN,',A5)'
+ WRITE(YRECFM2,YFMT) 'SNOW_',HSURFTYPE,'_TYPE'
+ ELSE
+ IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
+ WRITE(YFMT,'(A5,I1,A4)') '(A3,A',ISURFTYPE_LEN,',A5)'
+ WRITE(YRECFM2,YFMT) 'SN_',HSURFTYPE,'_TYPE'
+ ELSE
+ WRITE(YFMT,'(A5,I1,A4)') '(A3,A',ISURFTYPE_LEN,',A4)'
+ WRITE(YRECFM2,YFMT) 'SN_',HSURFTYPE,'_TYP'
+ YRECFM2=ADJUSTL(HPREFIX//YRECFM2)
+ ENDIF
+ END IF
+ !
+ CALL READ_SURF(HPROGRAM,YRECFM2,TPSNOW%SCHEME,IRESP)
+ !
+ !* 2. Snow levels
+ ! -----------
+ !
+ !
+ IF (IVERSION <=2 .OR. (IVERSION==3 .AND. IBUGFIX<=4)) THEN
+ WRITE(YFMT,'(A5,I1,A4)') '(A5,A',ISURFTYPE_LEN,',A6)'
+ WRITE(YRECFM2,YFMT) 'SNOW_',HSURFTYPE,'_LAYER'
+ ELSE
+ WRITE(YFMT,'(A5,I1,A4)') '(A3,A',ISURFTYPE_LEN,',A2)'
+ WRITE(YRECFM2,YFMT) 'SN_',HSURFTYPE,'_N'
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM2=ADJUSTL(HPREFIX//YRECFM2)
+ END IF
+ !
+ CALL READ_SURF(HPROGRAM,YRECFM2,TPSNOW%NLAYER,IRESP)
+ !
+ENDIF
!
!* 2. Presence of snow fields in the file
! -----------------------------------
!
+IF (KPATCH>0.AND.GDIM2) THEN
+ WRITE(YPAT,'(I2)') KPATCH
+ YPAT = "P"//ADJUSTL(YPAT)
+ IPAT_LEN = LEN_TRIM(ADJUSTL(YPAT))
+ELSE
+ YPAT = " "
+ IPAT_LEN=1
+ENDIF
+!
IF (IVERSION >6 .OR. (IVERSION==6 .AND. IBUGFIX>=1)) THEN
- WRITE(YFMT,'(A5,I1,A1)') '(A3,A',ISURFTYPE_LEN,')'
- WRITE(YRECFM,YFMT) 'SN_',HSURFTYPE
+ WRITE(YFMT,'(A5,I1,A2,I1,A1)') '(A3,A',ISURFTYPE_LEN,',A1,A',IPAT_LEN,')'
+ WRITE(YRECFM,YFMT) 'SN_',ADJUSTL(HSURFTYPE(:LEN_TRIM(HSURFTYPE))),ADJUSTL(YPAT(:LEN_TRIM(YPAT)))
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM=ADJUSTL(HPREFIX//YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,GSNOW,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,GSNOW,IRESP)
ELSE
IF (TPSNOW%NLAYER==0) THEN
GSNOW = .FALSE.
@@ -177,15 +198,20 @@ ELSE
END IF
END IF
!
+IF (.NOT.GDIM2) THEN
+ YPAT = " "
+ IPAT_LEN=1
+ENDIF
+!
!-------------------------------------------------------------------------------
!
!* 3. Allocations
! -----------
!
- CALL ALLOCATE_GR_SNOW(TPSNOW,KLU,KPATCH)
+ CALL ALLOCATE_GR_SNOW(TPSNOW,KSIZE_P)
!
IF (.NOT. GSNOW) THEN
- IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW_1',1,ZHOOK_HANDLE)
RETURN
END IF
!-------------------------------------------------------------------------------
@@ -193,160 +219,200 @@ END IF
!* 4. Additional key
! ---------------
!
-IF (IVERSION >= 7 .AND. HSURFTYPE=='VEG') CALL READ_SURF(&
- HPROGRAM,'LSNOW_FRAC_T',LSNOW_FRAC_TOT,IRESP)
+IF (IVERSION >= 7 .AND. HSURFTYPE=='VEG'.AND.KPATCH==1) &
+ CALL READ_SURF(HPROGRAM,'LSNOW_FRAC_T',LSNOW_FRAC_TOT,IRESP)
!
!-------------------------------------------------------------------------------
!
+!
!* 5. Snow reservoir
! --------------
!
-ALLOCATE(ZWORK(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,3)))
-!
-!
- IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='3-L' &
- .OR. TPSNOW%SCHEME=='CRO') THEN
-!
- IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
- YRECFM='WSNOW_'//HSURFTYPE
- ELSE
- YRECFM=ADJUSTL(HPREFIX//'WSN_'//HSURFTYPE)
- ENDIF
- CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%WSNOW,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
- END IF
-!
-!* 6. Snow density
-! ------------
-!
- IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='3-L' &
- .OR. TPSNOW%SCHEME=='CRO') THEN
- IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
- YRECFM='RSNOW_'//HSURFTYPE
- ELSE
- YRECFM=ADJUSTL(HPREFIX//'RSN_'//HSURFTYPE)
- ENDIF
- CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%RHO,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
- WHERE(TPSNOW%WSNOW(:,1:TPSNOW%NLAYER,:)==0.0)TPSNOW%RHO(:,1:TPSNOW%NLAYER,:)=XUNDEF
- END IF
-!
-!* 7. Snow temperature
-! ----------------
+ALLOCATE(ZWORK(KLU,INPATCH))
!
+IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' &
+ .OR. TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
+ !
+ WRITE(YFMT0,'(A5,I1,A1)') ',A1,A',ISURFTYPE_LEN
+ !
+ IF (GVERSION) THEN
+ YFMT = '(A3'//YFMT0//')'
+ ELSE
+ YFMT = '(A5'//YFMT0//')'
+ ENDIF
+ CALL READ_LAYERS(GVERSION,TPSNOW%NLAYER,YDIR,HPREFIX,YFMT,"WSNOW",HSURFTYPE,TPSNOW%WSNOW)
+ CALL READ_LAYERS(GVERSION,TPSNOW%NLAYER,YDIR,HPREFIX,YFMT,"RSNOW",HSURFTYPE,TPSNOW%RHO)
+ !
+ !* 7. Snow temperature
+ ! ----------------
+ !
IF (TPSNOW%SCHEME=='1-L') THEN
- IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
- YRECFM='TSNOW_'//HSURFTYPE
- ELSE
- YRECFM=ADJUSTL(HPREFIX//'TSN_'//HSURFTYPE)
- ENDIF
- CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%T,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
- DO JLAYER = 1,TPSNOW%NLAYER
- WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%T(:,JLAYER,:) = XUNDEF
- ENDDO
- END IF
-!
-!* 8. Heat content
-! ------------
-!
+ !
+ CALL READ_LAYERS(GVERSION,TPSNOW%NLAYER,YDIR,HPREFIX,YFMT,"TSNOW",HSURFTYPE,TPSNOW%T)
+ !
+ ENDIF
+ !
+ !* 8. Heat content
+ ! ------------
+ !
IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
- IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
- YRECFM='HSNOW_'//HSURFTYPE
- ELSE
- YRECFM=ADJUSTL(HPREFIX//'HSN_'//HSURFTYPE)
+ !
+ CALL READ_LAYERS(GVERSION,TPSNOW%NLAYER,YDIR,HPREFIX,YFMT,"HSNOW",HSURFTYPE,TPSNOW%HEAT)
+ !
+ IF (TPSNOW%SCHEME=='CRO') THEN
+ !
+ CALL READ_LAYERS(GVERSION,TPSNOW%NLAYER,YDIR,HPREFIX,YFMT,"SHIST",HSURFTYPE,TPSNOW%HIST)
+ !
+ !* 9. Snow Gran1
+ ! ------------
+ !
+ IF (GVERSION) THEN
+ YFMT = "(A2,A1"//YFMT0//')'
+ ELSE
+ YFMT = "(A5"//YFMT0//')'
+ ENDIF
+ YFMT = YFMT//YNLAYER//')'
+ CALL READ_LAYERS(GVERSION,TPSNOW%NLAYER,YDIR,HPREFIX,YFMT,"SGRAN",HSURFTYPE,TPSNOW%GRAN1,HREC2="1")
+ CALL READ_LAYERS(GVERSION,TPSNOW%NLAYER,YDIR,HPREFIX,YFMT,"SGRAN",HSURFTYPE,TPSNOW%GRAN2,HREC2="2")
+ !
ENDIF
- CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%HEAT,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
- DO JLAYER = 1,TPSNOW%NLAYER
- WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%HEAT(:,JLAYER,:) = XUNDEF
- ENDDO
- END IF
+ !
+ IF ((TPSNOW%SCHEME=='3-L'.AND.IVERSION>=8) .OR. TPSNOW%SCHEME=='CRO') THEN
+ !* 12. Age parameter
+ ! -------------------
+ !
+ IF (GVERSION) THEN
+ YFMT = "(A3"//YFMT0//')'
+ ELSE
+ YFMT = "(A4"//YFMT0//')'
+ ENDIF
+ YFMT = YFMT//YNLAYER//')'
+ CALL READ_LAYERS(GVERSION,TPSNOW%NLAYER,YDIR,HPREFIX,YFMT,"SAGE",HSURFTYPE,TPSNOW%AGE)
+ !
+ ELSE
+ !
+ DO JL = 1,TPSNOW%NLAYER
+ WHERE (TPSNOW%WSNOW(:,1) >= 0.0)
+ TPSNOW%AGE(:,JL) = 0.0
+ ELSEWHERE
+ TPSNOW%AGE(:,JL) = XUNDEF
+ ENDWHERE
+ ENDDO
+ !
+ END IF
+ !
+ ENDIF
+ !
+ WRITE(YFMT,'(A5,I1,A2,I1,A1)') '(A4,A',ISURFTYPE_LEN,',A',IPAT_LEN,')'
+ WRITE(YRECFM,YFMT) 'ASN_',ADJUSTL(HSURFTYPE(:LEN_TRIM(HSURFTYPE))),ADJUSTL(YPAT)
+ IF (GVERSION) YRECFM=ADJUSTL(HPREFIX//YRECFM)
+ IF (GDIM2) THEN
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,1),IRESP,HDIR=YDIR)
+ CALL PACK_SAME_RANK(KMASK_P,ZWORK(:,1),TPSNOW%ALB(:))
+ ELSE
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
+ CALL PACK_SAME_RANK(KMASK_P,ZWORK(:,MAX(1,KPATCH)),TPSNOW%ALB(:))
+ ENDIF
+ IF (KLU>0) print*,YRECFM,minval(TPSNOW%ALB(:)),maxval(TPSNOW%ALB(:))
+ !
+ENDIF
!
-!* 9. Snow Gran1
-! ------------
+DEALLOCATE(ZWORK)
!
- IF (TPSNOW%SCHEME=='CRO') THEN
- IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
- YRECFM='SGRAN1_'//HSURFTYPE
- ELSE
- YRECFM=ADJUSTL(HPREFIX//'SG1_'//HSURFTYPE)
+IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW_1',1,ZHOOK_HANDLE)
+!
+IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' &
+ .OR. TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
+ !
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW_2',0,ZHOOK_HANDLE_OMP)
+!$OMP DO PRIVATE(JI,JL)
+ DO JI = 1,SIZE(TPSNOW%WSNOW,1)
+ !
+ IF (TPSNOW%WSNOW(JI,1) == 0.0 ) THEN
+ !
+ TPSNOW%ALB(JI) = XUNDEF
+ !
+ DO JL = 1,TPSNOW%NLAYER
+ !
+ TPSNOW%RHO(JI,JL)=XUNDEF
+ IF (TPSNOW%SCHEME=='1-L') THEN
+ TPSNOW%T(JI,JL) = XUNDEF
+ ELSEIF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
+ TPSNOW%HEAT(JI,JL) = XUNDEF
+ IF (TPSNOW%SCHEME=='CRO') THEN
+ TPSNOW%HIST (JI,JL) = XUNDEF
+ TPSNOW%GRAN1(JI,JL) = XUNDEF
+ TPSNOW%GRAN2(JI,JL) = XUNDEF
+ TPSNOW%AGE (JI,JL) = XUNDEF
+ ENDIF
+ ENDIF
+ !
+ ENDDO
ENDIF
- CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%GRAN1,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
- DO JLAYER = 1,TPSNOW%NLAYER
- WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%GRAN1(:,JLAYER,:) = XUNDEF
- ENDDO
- END IF
+ ENDDO
+!$OMP ENDDO
+IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW_2',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
+ !
+ENDIF
!
-!* 10. Snow Gran2
-! ------------
+!-------------------------------------------------------------------------------
!
- IF (TPSNOW%SCHEME=='CRO') THEN
- IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
- YRECFM='SGRAN2_'//HSURFTYPE
- ELSE
- YRECFM=ADJUSTL(HPREFIX//'SG2_'//HSURFTYPE)
- ENDIF
- CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%GRAN2,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
- DO JLAYER = 1,TPSNOW%NLAYER
- WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%GRAN2(:,JLAYER,:) = XUNDEF
- ENDDO
- END IF
+CONTAINS
!
-!* 11. Historical parameter
-! -------------------
+SUBROUTINE READ_LAYERS(OVERSION,KNL,HDIRIN,HPREF,HFMT,HREC,HSURF,PTAB,HREC2)
!
- IF (TPSNOW%SCHEME=='CRO') THEN
- IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
- YRECFM='SHIST_'//HSURFTYPE
- ELSE
- YRECFM=ADJUSTL(HPREFIX//'SHI_'//HSURFTYPE)
- ENDIF
- CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%HIST,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
- DO JLAYER = 1,TPSNOW%NLAYER
- WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%HIST(:,JLAYER,:) = XUNDEF
- ENDDO
- END IF
+USE MODE_READ_SURF_LAYERS
!
-!* 12. Age parameter
-! -------------------
+IMPLICIT NONE
!
- IF ((TPSNOW%SCHEME=='3-L'.AND.IVERSION>=8) .OR. TPSNOW%SCHEME=='CRO') THEN
- IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
- YRECFM='SAGE_'//HSURFTYPE
- ELSE
- YRECFM=ADJUSTL(HPREFIX//'SAG_'//HSURFTYPE)
- ENDIF
- CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%AGE,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
- DO JLAYER = 1,TPSNOW%NLAYER
- WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%AGE(:,JLAYER,:) = XUNDEF
- ENDDO
- ELSEIF(TPSNOW%SCHEME=='3-L'.AND.IVERSION<8)THEN
- DO JLAYER = 1,TPSNOW%NLAYER
- WHERE (TPSNOW%WSNOW(:,1,:) >= 0.0)
- TPSNOW%AGE(:,JLAYER,:) = 0.0
- ELSEWHERE
- TPSNOW%AGE(:,JLAYER,:) = XUNDEF
- ENDWHERE
- ENDDO
- END IF
-!-------------------------------------------------------------------------------
+LOGICAL, INTENT(IN) :: OVERSION
+INTEGER, INTENT(IN) :: KNL
+ CHARACTER(LEN=*), INTENT(IN) :: HDIRIN
+ CHARACTER(LEN=*), INTENT(IN) :: HPREF
+ CHARACTER(LEN=*), INTENT(IN) :: HFMT
+ CHARACTER(LEN=*), INTENT(IN) :: HREC
+ CHARACTER(LEN=*), INTENT(IN) :: HSURF
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTAB
+ CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HREC2
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK3D
+ CHARACTER(LEN=1) :: YREC2
+ CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+INTEGER :: JL, IRESP
+!
+IF (PRESENT(HREC2)) THEN
+ YREC2=TRIM(HREC2)
+ELSE
+ YREC2=""
+ENDIF
!
+IF (YREC2/="") THEN
+ WRITE(YRECFM,HFMT) TRIM(HREC),TRIM(YREC2),'_',TRIM(HSURF)
+ELSE
+ WRITE(YRECFM,HFMT) TRIM(HREC),'_',TRIM(HSURF)
+ENDIF
+IF (OVERSION) YRECFM=ADJUSTL(TRIM(HPREF)//YRECFM)
!
-DEALLOCATE(ZWORK)
-!-------------------------------------------------------------------------------
+IF (GDIM2) THEN
+ ALLOCATE(ZWORK3D(KLU,SIZE(PTAB,2),1))
+ELSE
+ ALLOCATE(ZWORK3D(KLU,SIZE(PTAB,2),INPATCH))
+ENDIF
!
-!* 13. Albedo
-! ------
+ CALL READ_SURF_LAYERS(HPROGRAM,YRECFM,GDIM2,ZWORK3D,IRESP,KPATCH=KPATCH,HDIR=YDIR)
!
-IF (TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='3-L' &
- .OR. TPSNOW%SCHEME=='CRO') THEN
- IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
- YRECFM='ASNOW_'//HSURFTYPE
+DO JL = 1,KNL
+ IF (GDIM2) THEN
+ CALL PACK_SAME_RANK(KMASK_P,ZWORK3D(:,JL,1),PTAB(:,JL))
ELSE
- YRECFM=ADJUSTL(HPREFIX//'ASN_'//HSURFTYPE)
+ CALL PACK_SAME_RANK(KMASK_P,ZWORK3D(:,JL,MAX(1,KPATCH)),PTAB(:,JL))
ENDIF
- CALL READ_SURF_FIELD2D(HPROGRAM,TPSNOW%ALB,YRECFM,HDIR=YDIR)
- WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%ALB(:,:) = XUNDEF
-END IF
-IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW',1,ZHOOK_HANDLE)
+ENDDO
!
-!-------------------------------------------------------------------------------
+DEALLOCATE(ZWORK3D)
+!
+END SUBROUTINE READ_LAYERS
!
END SUBROUTINE READ_GR_SNOW
diff --git a/src/SURFEX/read_grid.F90 b/src/SURFEX/read_grid.F90
index 92b1c6b8ceadfc421bd3266f6ee245d8416df260..48b390cd8fed679a1c4114276873bffd4d823b03 100644
--- a/src/SURFEX/read_grid.F90
+++ b/src/SURFEX/read_grid.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_GRID (&
- HPROGRAM,HGRID,PGRID_PAR,PLAT,PLON,PMESH_SIZE,KRESP,PDIR)
+ SUBROUTINE READ_GRID (HPROGRAM,G,KRESP,PDIR)
! #########################################
!
!!**** *READ_GRID* - routine to initialise the horizontal grid of a scheme
@@ -39,7 +38,7 @@
! ------------
!
!
-!
+USE MODD_SFX_GRID_n, ONLY : GRID_t
!
USE MODI_GET_LUOUT
USE MODI_READ_SURF
@@ -59,11 +58,7 @@ IMPLICIT NONE
!
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
- CHARACTER(LEN=10), INTENT(OUT) :: HGRID ! type of horizontal grid
-REAL, DIMENSION(:), POINTER :: PGRID_PAR ! parameters defining this grid
-REAL, DIMENSION(:), INTENT(OUT) :: PLAT ! latitude (degrees)
-REAL, DIMENSION(:), INTENT(OUT) :: PLON ! longitude (degrees)
-REAL, DIMENSION(:), INTENT(OUT) :: PMESH_SIZE ! horizontal mesh size (m2)
+TYPE(GRID_t), INTENT(INOUT) :: G
INTEGER, INTENT(OUT) :: KRESP ! error return code
REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PDIR ! heading of main axis of grid compared to North (degrees)
!
@@ -71,7 +66,6 @@ REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PDIR ! heading of main axis of grid
! -------------------------------
!
LOGICAL :: GREAD_ALL
-INTEGER :: IGRID_PAR
INTEGER :: ILUOUT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!---------------------------------------------------------------------------
@@ -86,20 +80,17 @@ IF (LASSIM) THEN
LREAD_ALL = .TRUE.
ENDIF
!
- CALL READ_SURF(&
- HPROGRAM,'GRID_TYPE',HGRID,KRESP)
+ CALL READ_SURF(HPROGRAM,'GRID_TYPE',G%CGRID,KRESP)
!
!---------------------------------------------------------------------------
!
!* 2. Reading parameters of the grid
! ------------------------------
!
- CALL READ_GRIDTYPE(&
- HPROGRAM,HGRID,IGRID_PAR,SIZE(PLAT),.FALSE.)
+ CALL READ_GRIDTYPE(HPROGRAM,G%CGRID,G%NGRID_PAR,SIZE(G%XLAT),.FALSE.)
!
-ALLOCATE(PGRID_PAR(IGRID_PAR))
- CALL READ_GRIDTYPE(&
- HPROGRAM,HGRID,IGRID_PAR,SIZE(PLAT),.TRUE.,PGRID_PAR,KRESP)
+ALLOCATE(G%XGRID_PAR(G%NGRID_PAR))
+ CALL READ_GRIDTYPE(HPROGRAM,G%CGRID,G%NGRID_PAR,SIZE(G%XLAT),.TRUE.,G%XGRID_PAR,KRESP)
!
!---------------------------------------------------------------------------
!
@@ -108,28 +99,25 @@ ALLOCATE(PGRID_PAR(IGRID_PAR))
!
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
-SELECT CASE (HGRID)
+SELECT CASE (G%CGRID)
CASE("NONE ")
IF (PRESENT(PDIR)) PDIR(:) = 0.
!
- CALL READ_SURF(&
- HPROGRAM,'LON', PLON,KRESP)
+ CALL READ_SURF(HPROGRAM,'LON', G%XLON,KRESP)
IF (KRESP/=0 .AND. LHOOK) CALL DR_HOOK('READ_GRID',1,ZHOOK_HANDLE)
IF (KRESP/=0) RETURN
- CALL READ_SURF(&
- HPROGRAM,'LAT', PLAT,KRESP)
+ CALL READ_SURF(HPROGRAM,'LAT', G%XLAT,KRESP)
IF (KRESP/=0 .AND. LHOOK) CALL DR_HOOK('READ_GRID',1,ZHOOK_HANDLE)
IF (KRESP/=0) RETURN
- CALL READ_SURF(&
- HPROGRAM,'MESH_SIZE',PMESH_SIZE,KRESP)
+ CALL READ_SURF(HPROGRAM,'MESH_SIZE',G%XMESH_SIZE,KRESP)
IF (KRESP/=0 .AND. LHOOK) CALL DR_HOOK('READ_GRID',1,ZHOOK_HANDLE)
IF (KRESP/=0) RETURN
CASE DEFAULT
IF (PRESENT(PDIR)) THEN
- CALL LATLON_GRID(HGRID,SIZE(PGRID_PAR),SIZE(PLAT),ILUOUT,PGRID_PAR,PLAT,PLON,PMESH_SIZE,PDIR)
+ CALL LATLON_GRID(G,SIZE(G%XLAT),PDIR)
ELSE
- CALL LATLON_GRID(HGRID,SIZE(PGRID_PAR),SIZE(PLAT),ILUOUT,PGRID_PAR,PLAT,PLON,PMESH_SIZE)
+ CALL LATLON_GRID(G,SIZE(G%XLAT))
END IF
END SELECT
diff --git a/src/SURFEX/read_gridtype_cartesian.F90 b/src/SURFEX/read_gridtype_cartesian.F90
index 5447c231b4134e759c5e9318527581c18b9936bb..fc3e81d97e42eeb0fa5ea5d5ac27300e9fad35df 100644
--- a/src/SURFEX/read_gridtype_cartesian.F90
+++ b/src/SURFEX/read_gridtype_cartesian.F90
@@ -66,7 +66,7 @@ LOGICAL, INTENT(IN) :: OREAD ! flag to read the grid
INTEGER, INTENT(IN) :: KSIZE ! estimated size of PGRID_PAR
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PGRID_PAR ! parameters defining this grid
INTEGER, INTENT(OUT) :: KRESP ! error return code
- CHARACTER(LEN=1), INTENT(OUT) :: HDIR ! reading directive ('A','H')
+ CHARACTER(LEN=1), INTENT(IN) :: HDIR ! reading directive ('A','H')
!
!
!* 0.2 Declarations of local variables
@@ -84,7 +84,6 @@ REAL, DIMENSION(KLU) :: ZDY ! Y grid mesh size
INTEGER :: ILUOUT
!---------------------------------------------------------------------------
REAL, DIMENSION(:), POINTER :: ZGRID_PAR=>NULL()
-!$OMP THREADPRIVATE(ZGRID_PAR)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!---------------------------------------------------------------------------
!
diff --git a/src/SURFEX/read_gridtype_conf_proj.F90 b/src/SURFEX/read_gridtype_conf_proj.F90
index b5d5117daad26b0e5156d3072e2b00a46bfc5759..dfaaf3f53289a9f75030e27dadc22aee8c473017 100644
--- a/src/SURFEX/read_gridtype_conf_proj.F90
+++ b/src/SURFEX/read_gridtype_conf_proj.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ################################################################
- SUBROUTINE READ_GRIDTYPE_CONF_PROJ (&
- HPROGRAM,KGRID_PAR,KLU,OREAD,KSIZE,PGRID_PAR,KRESP,HDIR)
+ SUBROUTINE READ_GRIDTYPE_CONF_PROJ (HPROGRAM,KGRID_PAR,KLU,OREAD,KSIZE,PGRID_PAR,KRESP,HDIR)
! ################################################################
!
!!**** *READ_GRIDTYPE_CONF_PROJ* - routine to initialise the horizontal grid
@@ -39,9 +38,6 @@
!* 0. DECLARATIONS
! ------------
!
-!
-!
-!
USE MODI_READ_SURF
USE MODI_GET_LUOUT
!
@@ -51,6 +47,7 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
USE MODI_ABOR1_SFX
+!
#ifdef MNH_PARALLEL
USE MODE_TOOLS_ll, ONLY : GET_DIM_PHYS_ll
#endif
@@ -99,10 +96,10 @@ INTEGER :: IIMAX_LOC ! number of points in I direct
INTEGER :: IJMAX_LOC ! number of points in J direction local
INTEGER :: IINFO
#endif
+!
INTEGER :: ILUOUT
!---------------------------------------------------------------------------
REAL, DIMENSION(:), POINTER :: ZGRID_PAR=>NULL()
-!$OMP THREADPRIVATE(ZGRID_PAR)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!---------------------------------------------------------------------------
!
@@ -111,41 +108,30 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('READ_GRIDTYPE_CONF_PROJ',0,ZHOOK_HANDLE)
!
- CALL READ_SURF(&
- HPROGRAM,'LAT0',ZLAT0,KRESP,HDIR=HDIR)
- CALL READ_SURF(&
- HPROGRAM,'LON0',ZLON0,KRESP,HDIR=HDIR)
- CALL READ_SURF(&
- HPROGRAM,'RPK ',ZRPK, KRESP,HDIR=HDIR)
- CALL READ_SURF(&
- HPROGRAM,'BETA',ZBETA,KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'LAT0',ZLAT0,KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'LON0',ZLON0,KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'RPK ',ZRPK, KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'BETA',ZBETA,KRESP,HDIR=HDIR)
!
!---------------------------------------------------------------------------
!
!* 2. Reading parameters of the grid
! ------------------------------
!
- CALL READ_SURF(&
- HPROGRAM,'LATORI',ZLATORI,KRESP,HDIR=HDIR)
- CALL READ_SURF(&
- HPROGRAM,'LONORI',ZLONORI,KRESP,HDIR=HDIR)
- CALL READ_SURF(&
- HPROGRAM,'IMAX ',IIMAX, KRESP,HDIR=HDIR)
- CALL READ_SURF(&
- HPROGRAM,'JMAX ',IJMAX, KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'LATORI',ZLATORI,KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'LONORI',ZLONORI,KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'IMAX ',IIMAX, KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'JMAX ',IJMAX, KRESP,HDIR=HDIR)
!
#ifdef MNH_PARALLEL
CALL GET_DIM_PHYS_ll('B',IIMAX_LOC,IJMAX_LOC)
#endif
- CALL READ_SURF(&
- HPROGRAM,'XX',ZX,KRESP,HDIR=HDIR)
- CALL READ_SURF(&
- HPROGRAM,'YY',ZY,KRESP,HDIR=HDIR)
!
- CALL READ_SURF(&
- HPROGRAM,'DX',ZDX,KRESP,HDIR=HDIR)
- CALL READ_SURF(&
- HPROGRAM,'DY',ZDY,KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'XX',ZX,KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'YY',ZY,KRESP,HDIR=HDIR)
+!
+ CALL READ_SURF(HPROGRAM,'DX',ZDX,KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'DY',ZDY,KRESP,HDIR=HDIR)
!
!---------------------------------------------------------------------------
!
@@ -154,13 +140,13 @@ IF (LHOOK) CALL DR_HOOK('READ_GRIDTYPE_CONF_PROJ',0,ZHOOK_HANDLE)
!
#ifdef MNH_PARALLEL
CALL PUT_GRIDTYPE_CONF_PROJ(ZGRID_PAR,ZLAT0,ZLON0,ZRPK,ZBETA,&
- ZLATORI,ZLONORI,IIMAX_LOC,IJMAX_LOC, &
+ ZLATORI,ZLONORI,IIMAX_LOC,IJMAX_LOC, &
ZX,ZY,ZDX,ZDY )
#else
- CALL PUT_GRIDTYPE_CONF_PROJ(ZGRID_PAR,ZLAT0,ZLON0,ZRPK,ZBETA,&
+ CALL PUT_GRIDTYPE_CONF_PROJ(ZGRID_PAR,ZLAT0,ZLON0,ZRPK,ZBETA,&
ZLATORI,ZLONORI,IIMAX,IJMAX, &
ZX,ZY,ZDX,ZDY )
-#endif
+#endif
!
!---------------------------------------------------------------------------
IF (OREAD) THEN
diff --git a/src/SURFEX/read_gridtype_gauss.F90 b/src/SURFEX/read_gridtype_gauss.F90
index a7ded5904a36ab685394b24cd1ca5b2d258713f3..569e34d9bbebfd3582b59164af8aa90863db1636 100644
--- a/src/SURFEX/read_gridtype_gauss.F90
+++ b/src/SURFEX/read_gridtype_gauss.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!################################################################
-SUBROUTINE READ_GRIDTYPE_GAUSS (&
- HPROGRAM,KGRID_PAR,KLU,OREAD,KSIZE,PGRID_PAR,KRESP,HDIR)
+SUBROUTINE READ_GRIDTYPE_GAUSS (HPROGRAM,KGRID_PAR,KLU,OREAD,KSIZE,PGRID_PAR,KRESP,HDIR)
!################################################################
!
!!**** *READ_GRIDTYPE_GAUSS* - routine to initialise the horizontal grid
@@ -38,14 +37,12 @@ SUBROUTINE READ_GRIDTYPE_GAUSS (&
!* 0. DECLARATIONS
! ------------
!
-!
-!
-!
USE MODI_READ_SURF
USE MODI_GET_LUOUT
!
USE MODE_GRIDTYPE_GAUSS
!
+USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -56,8 +53,6 @@ IMPLICIT NONE
!
!* 0.1 Declarations of arguments
! -------------------------
-!
-!
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
INTEGER, INTENT(INOUT) :: KGRID_PAR ! real size of PGRID_PAR
@@ -70,7 +65,6 @@ INTEGER, INTENT(OUT) :: KRESP ! error return code
! ! 'A' : all field
! ! 'H' : field on this processor only
!
-!
!* 0.2 Declarations of local variables
! -------------------------------
!
@@ -91,10 +85,10 @@ REAL, DIMENSION(KLU) :: ZLONSUP ! Grid corner Longitude | |
REAL, DIMENSION(KLU) :: ZLATINF ! Grid corner Latitude |_____|
REAL, DIMENSION(KLU) :: ZLONINF ! Grid corner Longitude Inf
!
+INTEGER :: IVERSION
INTEGER :: ILUOUT
!---------------------------------------------------------------------------
REAL, DIMENSION(:), POINTER :: ZGRID_PAR=>NULL()
-!$OMP THREADPRIVATE(ZGRID_PAR)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!---------------------------------------------------------------------------
!
@@ -102,47 +96,43 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! --------------------------------
!
IF (LHOOK) CALL DR_HOOK('READ_GRIDTYPE_GAUSS',0,ZHOOK_HANDLE)
- CALL READ_SURF(&
- HPROGRAM,'LAPO',ZLAPO, KRESP,HDIR=HDIR)
- CALL READ_SURF(&
- HPROGRAM,'LOPO',ZLOPO,KRESP,HDIR=HDIR)
- CALL READ_SURF(&
- HPROGRAM,'CODIL',ZCODIL,KRESP,HDIR=HDIR)
+!
+ CALL READ_SURF(HPROGRAM,'LAPO',ZLAPO, KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'LOPO',ZLOPO,KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'CODIL',ZCODIL,KRESP,HDIR=HDIR)
!
!---------------------------------------------------------------------------
!
!* 2. Reading parameters of the grid
! ------------------------------
!
- CALL READ_SURF(&
- HPROGRAM,'NLATI',INLATI,KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'NLATI',INLATI,KRESP,HDIR=HDIR)
ALLOCATE(INLOPA(INLATI))
IF (HDIR=='A') THEN
- CALL READ_SURF(&
- HPROGRAM,'NLOPA',INLOPA(:),KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'NLOPA',INLOPA(:),KRESP,HDIR=HDIR)
ELSE
- CALL READ_SURF(&
- HPROGRAM,'NLOPA',INLOPA(:),KRESP,HDIR='-')
+ CALL READ_SURF(HPROGRAM,'NLOPA',INLOPA(:),KRESP,HDIR='-')
ENDIF
- CALL READ_SURF(&
- HPROGRAM,'LATGAUSS',ZLAT(:),KRESP,HDIR=HDIR)
- CALL READ_SURF(&
- HPROGRAM,'LONGAUSS',ZLON(:),KRESP,HDIR=HDIR)
- CALL READ_SURF(&
- HPROGRAM,'LAT_G_XY',ZLAT_XY(:),KRESP,HDIR=HDIR)
- CALL READ_SURF(&
- HPROGRAM,'LON_G_XY',ZLON_XY(:),KRESP,HDIR=HDIR)
- CALL READ_SURF(&
- HPROGRAM,'MESHGAUSS',ZMESH_SIZE(:),KRESP,HDIR=HDIR)
- CALL READ_SURF(&
- HPROGRAM,'LONINF',ZLONINF(:),KRESP,HDIR=HDIR)
- CALL READ_SURF(&
- HPROGRAM,'LATINF',ZLATINF(:),KRESP,HDIR=HDIR)
- CALL READ_SURF(&
- HPROGRAM,'LONSUP',ZLONSUP(:),KRESP,HDIR=HDIR)
- CALL READ_SURF(&
- HPROGRAM,'LATSUP',ZLATSUP(:),KRESP,HDIR=HDIR)
-
+ CALL READ_SURF(HPROGRAM,'LATGAUSS',ZLAT(:),KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'LONGAUSS',ZLON(:),KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'LAT_G_XY',ZLAT_XY(:),KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'LON_G_XY',ZLON_XY(:),KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'MESHGAUSS',ZMESH_SIZE(:),KRESP,HDIR=HDIR)
+!
+ CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,KRESP,HDIR=HDIR)
+!
+IF (IVERSION>=8) THEN
+ CALL READ_SURF(HPROGRAM,'LONINF',ZLONINF(:),KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'LATINF',ZLATINF(:),KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'LONSUP',ZLONSUP(:),KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'LATSUP',ZLATSUP(:),KRESP,HDIR=HDIR)
+ELSE
+ ZLONINF(:) = XUNDEF
+ ZLATINF(:) = XUNDEF
+ ZLONSUP(:) = XUNDEF
+ ZLATSUP(:) = XUNDEF
+ENDIF
+!
!---------------------------------------------------------------------------
!
!* 4. All this information stored into pointer PGRID_PAR
diff --git a/src/SURFEX/read_gridtype_ign.F90 b/src/SURFEX/read_gridtype_ign.F90
index 0602cf68d00473e162a263290a88548f8eadd475..c06bb243b39d05796ee837bda640ba6c0e3fb627 100644
--- a/src/SURFEX/read_gridtype_ign.F90
+++ b/src/SURFEX/read_gridtype_ign.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ################################################################
- SUBROUTINE READ_GRIDTYPE_IGN (&
- HPROGRAM,KGRID_PAR,KLU,OREAD,KSIZE,PGRID_PAR,KRESP,HDIR)
+ SUBROUTINE READ_GRIDTYPE_IGN (HPROGRAM,KGRID_PAR,KLU,OREAD,KSIZE,PGRID_PAR,KRESP,HDIR)
! ################################################################
!
!!**** *READ_GRIDTYPE_IGN* - routine to initialise the horizontal grid
@@ -39,9 +38,6 @@
!* 0. DECLARATIONS
! ------------
!
-!
-!
-!
USE MODI_READ_SURF
USE MODI_GET_LUOUT
USE MODI_GET_XYALL_IGN
@@ -57,8 +53,6 @@ IMPLICIT NONE
!
!* 0.1 Declarations of arguments
! -------------------------
-!
-!
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
INTEGER, INTENT(INOUT) :: KGRID_PAR ! real size of PGRID_PAR
@@ -71,7 +65,6 @@ INTEGER, INTENT(OUT) :: KRESP ! error return code
! ! 'A' : all field
! ! 'H' : field on this processor only
!
-!
!* 0.2 Declarations of local variables
! -------------------------------
!
@@ -88,7 +81,6 @@ INTEGER :: IDIMY ! maximum domain length in Y
INTEGER :: ILUOUT
!---------------------------------------------------------------------------
REAL, DIMENSION(:), POINTER :: ZGRID_PAR=>NULL()
-!$OMP THREADPRIVATE(ZGRID_PAR)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!---------------------------------------------------------------------------
!
@@ -96,23 +88,18 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! --------------------------------
!
IF (LHOOK) CALL DR_HOOK('READ_GRIDTYPE_IGN',0,ZHOOK_HANDLE)
- CALL READ_SURF(&
- HPROGRAM,'LAMBERT',ILAMBERT,KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'LAMBERT',ILAMBERT,KRESP,HDIR=HDIR)
!
!---------------------------------------------------------------------------
!
!* 2. Reading parameters of the grid
! ------------------------------
!
- CALL READ_SURF(&
- HPROGRAM,'XX',ZX,KRESP,HDIR=HDIR)
- CALL READ_SURF(&
- HPROGRAM,'XY',ZY,KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'XX',ZX,KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'XY',ZY,KRESP,HDIR=HDIR)
!
- CALL READ_SURF(&
- HPROGRAM,'DX',ZDX,KRESP,HDIR=HDIR)
- CALL READ_SURF(&
- HPROGRAM,'DY',ZDY,KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'DX',ZDX,KRESP,HDIR=HDIR)
+ CALL READ_SURF(HPROGRAM,'DY',ZDY,KRESP,HDIR=HDIR)
!
!---------------------------------------------------------------------------
!
diff --git a/src/SURFEX/read_gridtype_lonlat_reg.F90 b/src/SURFEX/read_gridtype_lonlat_reg.F90
index 043cedf6caf00895358268ad8e49abe98a8f36e0..76f7bb6f8125ae221f1773790acc581561539340 100644
--- a/src/SURFEX/read_gridtype_lonlat_reg.F90
+++ b/src/SURFEX/read_gridtype_lonlat_reg.F90
@@ -86,7 +86,6 @@ REAL, DIMENSION(KLU) :: ZLAT ! latitudes
INTEGER :: ILUOUT
!---------------------------------------------------------------------------
REAL, DIMENSION(:), POINTER :: ZGRID_PAR=>NULL()
-!$OMP THREADPRIVATE(ZGRID_PAR)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!---------------------------------------------------------------------------
!
diff --git a/src/SURFEX/read_gridtype_lonlat_rot.F90 b/src/SURFEX/read_gridtype_lonlat_rot.F90
index 93f95eab4bc3b234d9ff1203abf460e187c9c1a9..ab1257cb034e1b00d6a2e158daeaa1a21fd8af81 100644
--- a/src/SURFEX/read_gridtype_lonlat_rot.F90
+++ b/src/SURFEX/read_gridtype_lonlat_rot.F90
@@ -59,7 +59,7 @@ IMPLICIT NONE
!
!
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
INTEGER, INTENT(INOUT) :: KGRID_PAR ! real size of PGRID_PAR
INTEGER, INTENT(IN) :: KLU ! number of points
LOGICAL, INTENT(IN) :: OREAD ! flag to read the grid
@@ -88,7 +88,6 @@ REAL, DIMENSION(KLU) :: ZLAT ! latitudes
INTEGER :: ILUOUT
!---------------------------------------------------------------------------
REAL, DIMENSION(:), POINTER :: ZGRID_PAR=>NULL()
-!$OMP THREADPRIVATE(ZGRID_PAR)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!---------------------------------------------------------------------------
!
diff --git a/src/SURFEX/read_gridtype_lonlatval.F90 b/src/SURFEX/read_gridtype_lonlatval.F90
index 8a4516a609a8d076436f92cbfaa0b38075364211..3a94a5ebd1efc70c7a55a0eda5bd490d2b939e05 100644
--- a/src/SURFEX/read_gridtype_lonlatval.F90
+++ b/src/SURFEX/read_gridtype_lonlatval.F90
@@ -82,7 +82,6 @@ REAL, DIMENSION(KLU) :: ZDY ! Y grid mesh size
INTEGER :: ILUOUT
!---------------------------------------------------------------------------
REAL, DIMENSION(:), POINTER :: ZGRID_PAR=>NULL()
-!$OMP THREADPRIVATE(ZGRID_PAR)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!---------------------------------------------------------------------------
!
diff --git a/src/SURFEX/read_ideal_confn.F90 b/src/SURFEX/read_ideal_confn.F90
index 4229d644e15e8d4a55268df8654e927a335c7df9..f62ee0d9520d7b30e855b6febc66d4d3653e15a9 100644
--- a/src/SURFEX/read_ideal_confn.F90
+++ b/src/SURFEX/read_ideal_confn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_IDEAL_CONF_n (DGL, &
- HPROGRAM)
+ SUBROUTINE READ_IDEAL_CONF_n (DGO, HPROGRAM)
! #######################################################
!
!!**** *READ_IDEAL_CONF* - routine to read the configuration for IDEAL
@@ -41,7 +40,7 @@
!
!
!
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
USE MODE_MODELN_SURFEX_HANDLER
!
@@ -65,7 +64,7 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling ISBA
@@ -88,7 +87,7 @@ IF (LHOOK) CALL DR_HOOK('READ_IDEAL_CONF_N',0,ZHOOK_HANDLE)
!
IMI=GET_CURRENT_MODEL_INDEX_SURFEX()
!
-IF (IMI.NE.-1 .AND. LNAM_READ) CALL INIT_NAM_DIAG_SURFn(DGL)
+IF (IMI.NE.-1 .AND. LNAM_READ) CALL INIT_NAM_DIAG_SURFn(DGO)
!
IF (LNAM_READ) THEN
!
@@ -108,7 +107,7 @@ IF (LNAM_READ) THEN
!
ENDIF
!
-IF (IMI.NE.-1) CALL UPDATE_NAM_DIAG_SURFn(DGL)
+IF (IMI.NE.-1) CALL UPDATE_NAM_DIAG_SURFn(DGO)
IF (LHOOK) CALL DR_HOOK('READ_IDEAL_CONF_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/read_ideal_flux_conf.F90 b/src/SURFEX/read_ideal_flux_conf.F90
index efae41cd1cf5c798ad8459c4ee7f0f111e1d9c95..5763643c5b66d5152fe6e6b30ddb4fc8f7df7b42 100644
--- a/src/SURFEX/read_ideal_flux_conf.F90
+++ b/src/SURFEX/read_ideal_flux_conf.F90
@@ -79,7 +79,7 @@ IF (LHOOK) CALL DR_HOOK('READ_IDEAL_FLUX_CONF',0,ZHOOK_HANDLE)
!
CALL OPEN_NAMELIST(HPROGRAM,INAM)
!
- CSFTQ='kg/m2/s'
+CSFTQ='kg/m2/s'
!
!* reading of namelist
! -------------------
diff --git a/src/SURFEX/read_isba_canopyn.F90 b/src/SURFEX/read_isba_canopyn.F90
deleted file mode 100644
index 91aefd8562e86c92688f3b12c3c27f617df28901..0000000000000000000000000000000000000000
--- a/src/SURFEX/read_isba_canopyn.F90
+++ /dev/null
@@ -1,240 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE READ_ISBA_CANOPY_n (DTCO, ICP, I, U, &
- HPROGRAM)
-! #########################################
-!
-!!**** *READ_ISBA_CANOPY_n* - reads ISBA fields
-!!
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2003
-!! E. Martin 01/2012 Add LSBL_COLD_START
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!
-!
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_ISBA_CANOPY_n, ONLY : ISBA_CANOPY_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-!
-USE MODI_READ_SURF
-USE MODI_CANOPY_GRID
-USE MODI_GET_TYPE_DIM_n
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
-!
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(ISBA_CANOPY_t), INTENT(INOUT) :: ICP
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
-!
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-!
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=3) :: YREAD
-INTEGER :: JLAYER ! loop counter on layers
-INTEGER :: ILU ! 1D physical dimension
-INTEGER :: IRESP ! Error code after redding
-INTEGER :: IVERSION, IBUGFIX ! surface version
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-!
-!* 1D physical dimension
-!
-IF (LHOOK) CALL DR_HOOK('READ_ISBA_CANOPY_N',0,ZHOOK_HANDLE)
-YRECFM='SIZE_NATURE'
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'NATURE',ILU)
-!
-!
-!* flag to use or not canopy levels
-!
-YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
-!
-YRECFM='BUG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IBUGFIX,IRESP)
-!
-IF (IVERSION<3) THEN
- I%LCANOPY = .FALSE.
-ELSE
- YRECFM='ISBA_CANOPY'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%LCANOPY,IRESP)
-END IF
-!
-IF (.NOT.I%LCANOPY) THEN
- ALLOCATE(ICP%XZ (0,0))
- ALLOCATE(ICP%XU (0,0))
- ALLOCATE(ICP%XT (0,0))
- ALLOCATE(ICP%XQ (0,0))
- ALLOCATE(ICP%XTKE(0,0))
- ALLOCATE(ICP%XLMO(0) )
- ALLOCATE(ICP%XP (0,0))
- ALLOCATE(ICP%XDZ (0,0))
- ALLOCATE(ICP%XZF (0,0))
- ALLOCATE(ICP%XDZF(0,0))
- IF (LHOOK) CALL DR_HOOK('READ_ISBA_CANOPY_N',1,ZHOOK_HANDLE)
- RETURN
-ENDIF
-!
-!* number of vertical levels
-!
-YRECFM='ISBA_CAN_LVL'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ICP%NLVL,IRESP)
-!
-!* 2. Prognostic fields:
-! -----------------
-!
-!* altitudes
-!
-ALLOCATE(ICP%XZ(ILU,ICP%NLVL))
-!
-DO JLAYER=1,ICP%NLVL
- WRITE(YRECFM,'(A10,I2.2)') 'ISBA_CAN_Z',JLAYER
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ICP%XZ(:,JLAYER),IRESP)
-END DO
-!
-ALLOCATE(ICP%XU (ILU,ICP%NLVL))
-ALLOCATE(ICP%XT (ILU,ICP%NLVL))
-ALLOCATE(ICP%XQ (ILU,ICP%NLVL))
-ALLOCATE(ICP%XTKE(ILU,ICP%NLVL))
-ALLOCATE(ICP%XLMO(ILU) )
-ALLOCATE(ICP%XP (ILU,ICP%NLVL))
-!
-IF (IVERSION>7 .OR. IVERSION==7 .AND.IBUGFIX>=2) THEN
- YRECFM='STORAGETYPE'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,YREAD,IRESP)
-ELSE
- YREAD = 'ALL'
-ENDIF
-!
-IF(YREAD=='ALL') THEN
- !
- !* wind in SBL
- DO JLAYER=1,ICP%NLVL
- WRITE(YRECFM,'(A10,I2.2)') 'ISBA_CAN_U',JLAYER
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ICP%XU(:,JLAYER),IRESP)
- END DO
- !
- !* theta in SBL
- DO JLAYER=1,ICP%NLVL
- WRITE(YRECFM,'(A10,I2.2)') 'ISBA_CAN_T',JLAYER
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ICP%XT(:,JLAYER),IRESP)
- END DO
- !
- !* humidity in SBL
- DO JLAYER=1,ICP%NLVL
- WRITE(YRECFM,'(A10,I2.2)') 'ISBA_CAN_Q',JLAYER
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ICP%XQ(:,JLAYER),IRESP)
- END DO
- !
- !* Tke in SBL
- DO JLAYER=1,ICP%NLVL
- WRITE(YRECFM,'(A10,I2.2)') 'ISBA_CAN_E',JLAYER
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ICP%XTKE(:,JLAYER),IRESP)
- END DO
- !
- !* Monin-Obhukov length
- YRECFM='ISBA_CAN_LMO '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ICP%XLMO(:),IRESP)
- !
- !* Pressure
- DO JLAYER=1,ICP%NLVL
- WRITE(YRECFM,'(A10,I2.2)') 'ISBA_CAN_P',JLAYER
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ICP%XP(:,JLAYER),IRESP)
- END DO
- !
-ELSE
- ICP%XU (:,:) = XUNDEF
- ICP%XT (:,:) = XUNDEF
- ICP%XQ (:,:) = XUNDEF
- ICP%XTKE(:,:) = XUNDEF
- ICP%XLMO(:) = XUNDEF
- ICP%XP (:,:) = XUNDEF
-ENDIF
-!
-!
-!* Grid characteristics
-!
-!
-! --------------------------------- XZ(k+1) XDZ(k+1)
-! ^
-! |
-! |
-! - - - - - - - - - - - - - - - - - XZf(k+1) | XDZf(k+1)
-! ^ |
-! | |
-! --------------------------------- XZ(k), XU, XT, XQ, XTKE | XDZ(k) V
-! | ^
-! - - - - - - - - - - - - - - - - - XZf(k) V | XDZf(k)
-! --------------------------------- XZ(k-1) XDZ(k-1) V
-! - - - - - - - - - - - - - - - - - XZf(k-1)
-!
-ALLOCATE(ICP%XDZ (ILU,ICP%NLVL))
-ALLOCATE(ICP%XZF (ILU,ICP%NLVL))
-ALLOCATE(ICP%XDZF(ILU,ICP%NLVL))
- CALL CANOPY_GRID(ILU,ICP%NLVL,ICP%XZ,ICP%XZF,ICP%XDZ,ICP%XDZF)
-!
-IF (LHOOK) CALL DR_HOOK('READ_ISBA_CANOPY_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE READ_ISBA_CANOPY_n
diff --git a/src/SURFEX/read_isba_confn.F90 b/src/SURFEX/read_isba_confn.F90
index 0e6cb7c1d8951aaefd5da8e65b85471c4743c5c9..75665b619d8e4b29ce4cecaf5eaa60aaad32b14b 100644
--- a/src/SURFEX/read_isba_confn.F90
+++ b/src/SURFEX/read_isba_confn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_ISBA_CONF_n (CHI, DGEI, DGI, DGMI, I, &
- HPROGRAM)
+ SUBROUTINE READ_ISBA_CONF_n (CHI, DE, DGO, DMI, IO, HPROGRAM)
! #######################################################
!
!!**** *READ_ISBA_CONF* - routine to read the configuration for ISBA
@@ -51,9 +50,9 @@
!
USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
-USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
USE MODE_MODELN_SURFEX_HANDLER
!
@@ -73,7 +72,6 @@ USE MODD_SURF_PAR, ONLY : XUNDEF
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
-USE MODI_GET_SURF_ATM_SSO_ROUGH
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -81,10 +79,10 @@ IMPLICIT NONE
!
!
TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
-TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DGEI
-TYPE(DIAG_ISBA_t), INTENT(INOUT) :: DGI
-TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DGMI
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DE
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMI
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling ISBA
@@ -96,7 +94,6 @@ TYPE(ISBA_t), INTENT(INOUT) :: I
LOGICAL :: GFOUND ! Return code when searching namelist
INTEGER :: ILUOUT ! logical unit of output file
INTEGER :: INAM ! logical unit of namelist file
- CHARACTER(LEN=4) :: YROUGH ! CROUGH from surf_atm
INTEGER :: IMI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
@@ -109,15 +106,15 @@ IF (LHOOK) CALL DR_HOOK('READ_ISBA_CONF_N',0,ZHOOK_HANDLE)
IMI=GET_CURRENT_MODEL_INDEX_SURFEX()
!
IF (IMI.NE.-1 .AND. LNAM_READ) THEN
- CALL INIT_NAM_ISBAn(I)
- CALL INIT_NAM_ISBA_AGSn(I)
- CALL INIT_NAM_SGH_ISBAn(I)
- CALL INIT_NAM_DIAG_ISBAn(DGEI, DGI, DGMI)
- CALL INIT_NAM_DIAG_SURFn(DGEI, DGI)
+ CALL INIT_NAM_ISBAn(IO)
+ CALL INIT_NAM_ISBA_AGSn(IO)
+ CALL INIT_NAM_SGH_ISBAn(IO)
+ CALL INIT_NAM_DIAG_ISBAn(DE, DGO, DMI)
+ CALL INIT_NAM_DIAG_SURFn(DGO)
CALL INIT_NAM_CH_CONTROLn(CHI)
CALL INIT_NAM_CH_ISBAn(CHI)
- CALL INIT_NAM_SPINUP_CARB_ISBAn(I)
- CALL INIT_NAM_ISBA_SNOWn(I)
+ CALL INIT_NAM_SPINUP_CARB_ISBAn(IO)
+ CALL INIT_NAM_ISBA_SNOWn(IO)
ENDIF
!
IF (LNAM_READ) THEN
@@ -148,9 +145,7 @@ IF (LNAM_READ) THEN
CALL POSNAM(INAM,'NAM_ISBA_SNOWN',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=INAM,NML=NAM_ISBA_SNOWn)
!
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CROUGH',CROUGH,'NONE','Z01D','Z04D','BE04','UNDE')
CALL TEST_NAM_VAR_SURF(ILUOUT,'CSCOND',CSCOND,'NP89','PL98')
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CALBEDO',CALBEDO,'EVOL','DRY ','WET ','MEAN','USER','CM13')
CALL TEST_NAM_VAR_SURF(ILUOUT,'CC1DRY',CC1DRY,'DEF ','GB93')
CALL TEST_NAM_VAR_SURF(ILUOUT,'CSOILFRZ',CSOILFRZ,'DEF','LWT')
CALL TEST_NAM_VAR_SURF(ILUOUT,'CDIFSFCOND',CDIFSFCOND,'DEF ','MLCH')
@@ -174,15 +169,15 @@ IF (LNAM_READ) THEN
ENDIF
!
IF (IMI.NE.-1) THEN
- CALL UPDATE_NAM_ISBAn(I)
- CALL UPDATE_NAM_ISBA_AGSn(I)
- CALL UPDATE_NAM_SGH_ISBAn(I)
- CALL UPDATE_NAM_DIAG_ISBAn(DGEI, DGI, DGMI)
- CALL UPDATE_NAM_DIAG_SURFn(DGEI, DGI)
+ CALL UPDATE_NAM_ISBAn(IO)
+ CALL UPDATE_NAM_ISBA_AGSn(IO)
+ CALL UPDATE_NAM_SGH_ISBAn(IO)
+ CALL UPDATE_NAM_DIAG_ISBAn(DE, DGO, DMI)
+ CALL UPDATE_NAM_DIAG_SURFn(DGO)
CALL UPDATE_NAM_CH_CONTROLn(CHI)
CALL UPDATE_NAM_CH_ISBAn(CHI)
- CALL UPDATE_NAM_SPINUP_CARB_ISBAn(I)
- CALL UPDATE_NAM_ISBA_SNOWn(I)
+ CALL UPDATE_NAM_SPINUP_CARB_ISBAn(IO)
+ CALL UPDATE_NAM_ISBA_SNOWn(IO)
ENDIF
!
!-------------------------------------------------------------------------------
@@ -193,20 +188,6 @@ ENDIF
!
!-------------------------------------------------------------------------------
!
-!* coherence check : orographic drag must be done only once
-!
- CALL GET_SURF_ATM_SSO_ROUGH(YROUGH)
-!
-IF (YROUGH/="NONE") THEN
- IF (LNAM_READ) THEN
- WRITE(ILUOUT,*) " -------------------------------------------------------------------------- "
- WRITE(ILUOUT,*) " Orographic roughness is done in SURF_ATM, so it should not be done in ISBA "
- WRITE(ILUOUT,*) " CROUGH in NAM_ISBAn is set to 'NONE' "
- WRITE(ILUOUT,*) " "
- WRITE(ILUOUT,*) " -------------------------------------------------------------------------- "
- ENDIF
- CROUGH = "NONE"
-END IF
IF (LHOOK) CALL DR_HOOK('READ_ISBA_CONF_N',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/read_isban.F90 b/src/SURFEX/read_isban.F90
index 7bb5aa5d7ab9b5e2a7006730fe30bf8dc9f3f48c..8af417896027ac21554691310abaf94ea52071fe 100644
--- a/src/SURFEX/read_isban.F90
+++ b/src/SURFEX/read_isban.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_ISBA_n (DTCO, I, U, &
- HPROGRAM)
+ SUBROUTINE READ_ISBA_n (DTCO, IO, S, NP, NPE, PCLAY, U, HPROGRAM)
! ##################################
!
!!**** *READ_ISBA_n* - routine to initialise ISBA variables
@@ -44,19 +43,15 @@
!! B. Decharme 09/2012 : suppress NWG_LAYER (parallelization problems)
!! T. Aspelien 08/2013 : Read diagnostics for assimilation
!! P. Samuelsson 10/2014 : MEB
-!! M.Moge 01/2016 using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-!
-!
-!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_NP_t, ISBA_NPE_t, ISBA_P_t, ISBA_PE_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODD_CO2V_PAR, ONLY : XANFMINIT, XCONDCTMIN
@@ -68,10 +63,13 @@ USE MODD_ASSIM, ONLY : LASSIM,CASSIM_ISBA,XAT2M_ISBA,XAHU2M_ISBA,&
!
USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
USE MODD_SNOW_PAR, ONLY : XZ0SN
+USE MODD_ISBA_PAR, ONLY : XWGMIN
+!
+USE MODE_READ_SURF_LAYERS
!
USE MODI_READ_SURF
-USE MODI_READ_SURF_FIELD3D
-USE MODI_READ_SURF_FIELD2D
+USE MODI_MAKE_CHOICE_ARRAY
+USE MODI_PACK_SAME_RANK
!
USE MODI_READ_GR_SNOW
USE MODI_ABOR1_SFX
@@ -80,6 +78,7 @@ USE MODI_IO_BUFF
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
+USE MODI_IO_BUFF_CLEAN
USE MODI_GET_TYPE_DIM_n
USE MODE_RANDOM
USE MODE_EKF
@@ -91,31 +90,41 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
+REAL, DIMENSION(:,:), INTENT(IN) :: PCLAY
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
!
!* 0.2 Declarations of local variables
! -------------------------------
+!
+TYPE(ISBA_P_t), POINTER :: PK
+TYPE(ISBA_PE_t), POINTER :: PEK
+!
INTEGER :: ILU ! 1D physical dimension
!
INTEGER :: IRESP ! Error code after redding
!
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=LEN_HREC) :: YCBIO ! Name of biomass variable
!
- CHARACTER(LEN=4) :: YLVL
+CHARACTER(LEN=4) :: YLVL
!
REAL, DIMENSION(:,:,:),ALLOCATABLE :: ZLAI
+REAL, DIMENSION(:,:,:),ALLOCATABLE :: ZWORK3D ! 2D array to write data in file
REAL, DIMENSION(:,:),ALLOCATABLE :: ZWORK ! 2D array to write data in file
REAL, DIMENSION(:), ALLOCATABLE :: ZCOFSWI
!
-REAL,DIMENSION(I%NPATCH) :: ZVLAIMIN
+REAL,DIMENSION(IO%NPATCH) :: ZVLAIMIN
REAL :: ZCOEF
!
INTEGER :: IWORK ! Work integer
!
-INTEGER :: JP, JL, JNBIOMASS, JNLITTER, JNSOILCARB, JNLITTLEVS ! loop counter on layers
+INTEGER :: JP, JL, JNB, JNLITTER, JNSOILCARB, JNLITTLEVS ! loop counter on layers
INTEGER :: JVAR, JI
!
INTEGER :: IVERSION ! surface version
@@ -123,9 +132,9 @@ INTEGER :: IBUGFIX
INTEGER :: IIVAR
INTEGER :: IOBS
INTEGER :: IBSUP
-INTEGER :: ISIZE_LMEB_PATCH
+INTEGER :: ISIZE_LMEB_PATCH, IMASK
!
-LOGICAL :: GKNOWN
+LOGICAL :: GKNOWN, GDIM
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -136,133 +145,209 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('READ_ISBA_N',0,ZHOOK_HANDLE)
YRECFM='SIZE_NATURE'
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'NATURE',ILU)
+ CALL GET_TYPE_DIM_n(DTCO, U, 'NATURE',ILU)
+!
+YRECFM='VERSION'
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
!
+YRECFM='BUG'
+ CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
+!
+GDIM = (IVERSION>8 .OR. IVERSION==8 .AND. IBUGFIX>0)
+IF (GDIM) CALL READ_SURF(HPROGRAM,'SPLIT_PATCH',GDIM,IRESP)
!
+YRECFM='BUG'
+ CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
+
!* 2. Prognostic fields:
! -----------------
!
-ALLOCATE(ZWORK(ILU,I%NPATCH))
+ALLOCATE(ZWORK(ILU,IO%NPATCH))
!* soil temperatures
!
-IF(I%LTEMP_ARP)THEN
- IWORK=I%NTEMPLAYER_ARP
-ELSEIF(I%CISBA=='DIF')THEN
- IWORK=I%NGROUND_LAYER
+IF(IO%LTEMP_ARP)THEN
+ IWORK=IO%NTEMPLAYER_ARP
+ELSEIF(IO%CISBA=='DIF')THEN
+ IWORK=IO%NGROUND_LAYER
ELSE
IWORK=2 !Only 2 temperature layer in ISBA-FR
ENDIF
!
IF ( TRIM(CASSIM_ISBA)=="ENKF") THEN
- ALLOCATE(I%XRED_NOISE(ILU,I%NPATCH,NVAR))
- I%XRED_NOISE(:,:,:) = 0.
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ ALLOCATE(PK%XRED_NOISE(PK%NSIZE_P,NVAR))
+ PK%XRED_NOISE(:,:) = 0.
+ ENDDO
+ELSE
+ DO JP = 1,IO%NPATCH
+ ALLOCATE(NP%AL(JP)%XRED_NOISE(0,0))
+ ENDDO
+ENDIF
+!
+IF ( TRIM(CASSIM_ISBA)=="ENKF" .OR. (TRIM(CASSIM_ISBA)=="EKF" .AND. LPRT) ) THEN
ALLOCATE(ZCOFSWI(ILU))
- CALL COFSWI(I%XCLAY(:,1),ZCOFSWI)
+ CALL COFSWI(PCLAY(:,1),ZCOFSWI)
ELSE
- ALLOCATE(I%XRED_NOISE(0,0,0))
ALLOCATE(ZCOFSWI(0))
ENDIF
!
-ALLOCATE(I%XTG(ILU,IWORK,I%NPATCH))
-I%XTG(:,:,:)=XUNDEF
+DO JP = 1,IO%NPATCH
+ PEK => NPE%AL(JP)
+ PK => NP%AL(JP)
+ !
+ ALLOCATE(PEK%XTG(PK%NSIZE_P,IWORK))
+ !
+ ALLOCATE(PEK%XWG (PK%NSIZE_P,IO%NGROUND_LAYER))
+ ALLOCATE(PEK%XWGI(PK%NSIZE_P,IO%NGROUND_LAYER))
+ !
+ PEK%XTG (:,:) = XUNDEF
+ PEK%XWG (:,:) = XUNDEF
+ PEK%XWGI(:,:) = XUNDEF
+ !
+ ALLOCATE(PEK%XWR(PK%NSIZE_P))
+ !
+ENDDO
!
-YRECFM='TG'
- CALL READ_SURF_FIELD3D(HPROGRAM,I%XTG,1,IWORK,YRECFM)
+ALLOCATE(ZWORK3D(ILU,IWORK,IO%NPATCH))
+CALL READ_SURF_LAYERS(HPROGRAM,'TG',GDIM,ZWORK3D,IRESP)
+DO JL=1,IWORK
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK3D(:,JL,JP),NPE%AL(JP)%XTG(:,JL))
+ ENDDO
+ENDDO
+DEALLOCATE(ZWORK3D)
!
! Perturb value if requested
IF ( TRIM(CASSIM_ISBA)=="EKF" .AND. LPRT ) THEN
!
DO JL=1,IWORK
! read in control variable
- IF ( (TRIM(CVAR(NIVAR))=="TG1" .AND. JL==1) .OR. &
- (TRIM(CVAR(NIVAR))=="TG2" .AND. JL==2) ) THEN
- WHERE ( I%XTG(:,JL,:)/=XUNDEF )
- I%XTG(:,JL,:) = I%XTG(:,JL,:) + XTPRT(NIVAR)*I%XTG(:,JL,:)
- ENDWHERE
+ IF ( (TRIM(CVAR(NIVAR))=="TG1" .AND. JL==1) .OR. (TRIM(CVAR(NIVAR))=="TG2" .AND. JL==2) ) THEN
+ DO JP = 1,IO%NPATCH
+ PEK => NPE%AL(JP)
+ WHERE ( PEK%XTG(:,JL)/=XUNDEF )
+ PEK%XTG(:,JL) = PEK%XTG(:,JL) + XTPRT(NIVAR)*PEK%XTG(:,JL)
+ ENDWHERE
+ ENDDO
ENDIF
END DO
!
ELSEIF ( TRIM(CASSIM_ISBA)=="ENKF" .AND. NIE<NENS+1 ) THEN
!
- CALL MAKE_ENS_ENKF(IWORK,ILU,"TG ",ZCOFSWI,I%XTG,I%XRED_NOISE)
+ CALL MAKE_ENS_ENKF(IWORK,ILU,"TG ",ZCOFSWI,NP)
!
ENDIF
!
!
!* soil liquid and ice water contents
!
-ALLOCATE(I%XWG (ILU,I%NGROUND_LAYER,I%NPATCH))
-ALLOCATE(I%XWGI(ILU,I%NGROUND_LAYER,I%NPATCH))
-!
-I%XWG (:,:,:)=XUNDEF
-I%XWGI(:,:,:)=XUNDEF
-!
-YRECFM='WG'
- CALL READ_SURF_FIELD3D(HPROGRAM,I%XWG,1,I%NGROUND_LAYER,YRECFM)
+ALLOCATE(ZWORK3D(ILU,IO%NGROUND_LAYER,IO%NPATCH))
+CALL READ_SURF_LAYERS(HPROGRAM,'WG',GDIM,ZWORK3D,IRESP)
+DO JL=1,IO%NGROUND_LAYER
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK3D(:,JL,JP),NPE%AL(JP)%XWG(:,JL))
+ ENDDO
+ENDDO
+DEALLOCATE(ZWORK3D)
!
! Perturb value if requested
IF ( TRIM(CASSIM_ISBA)=="EKF" .AND. LPRT ) THEN
!
- DO JL=1,I%NGROUND_LAYER
- ! read in control variable
- IF ( (TRIM(CVAR(NIVAR))=="WG1" .AND. JL==1) .OR. &
- (TRIM(CVAR(NIVAR))=="WG2" .AND. JL==2) ) THEN
- WHERE ( I%XWG(:,JL,:)/=XUNDEF )
- I%XWG(:,JL,:) = I%XWG(:,JL,:) + XTPRT(NIVAR)*I%XWG(:,JL,:)
- ENDWHERE
- ENDIF
+ DO JL=1,IO%NGROUND_LAYER
+ ! read in control variable
+ IF ( (TRIM(CVAR(NIVAR))=="WG1" .AND. JL==1) .OR. &
+ (TRIM(CVAR(NIVAR))=="WG2" .AND. JL==2) .OR. &
+ (TRIM(CVAR(NIVAR))=="WG3" .AND. JL==3) .OR. &
+ (TRIM(CVAR(NIVAR))=="WG4" .AND. JL==4) .OR. &
+ (TRIM(CVAR(NIVAR))=="WG5" .AND. JL==5) .OR. &
+ (TRIM(CVAR(NIVAR))=="WG6" .AND. JL==6) .OR. &
+ (TRIM(CVAR(NIVAR))=="WG7" .AND. JL==7) .OR. &
+ (TRIM(CVAR(NIVAR))=="WG8" .AND. JL==8) ) THEN
+
+ DO JP = 1,IO%NPATCH
+ PEK => NPE%AL(JP)
+ PK => NP%AL(JP)
+ DO JI = 1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ IF (PEK%XWG(JI,JL)/=XUNDEF ) THEN
+ PEK%XWG(JI,JL) = PEK%XWG(JI,JL) + XTPRT(NIVAR) * ZCOFSWI(IMASK)
+ ENDIF
+ ENDDO
+ END DO
+ !
+ ENDIF
+ !
END DO
!
ELSEIF ( TRIM(CASSIM_ISBA)=="ENKF" .AND. NIE<NENS+1 ) THEN
!
- CALL MAKE_ENS_ENKF(IWORK,ILU,"WG ",ZCOFSWI,I%XWG,I%XRED_NOISE)
+ CALL MAKE_ENS_ENKF(IWORK,ILU,"WG ",ZCOFSWI,NP)
!
ENDIF
!
-IF(I%CISBA=='DIF')THEN
- IWORK=I%NGROUND_LAYER
+IF(IO%CISBA=='DIF')THEN
+ IWORK=IO%NGROUND_LAYER
ELSE
IWORK=2 !Only 2 soil ice layer in ISBA-FR
ENDIF
!
-YRECFM='WGI'
- CALL READ_SURF_FIELD3D(HPROGRAM,I%XWGI,1,IWORK,YRECFM)
+ALLOCATE(ZWORK3D(ILU,IWORK,IO%NPATCH))
+CALL READ_SURF_LAYERS(HPROGRAM,'WGI',GDIM,ZWORK3D,IRESP)
+DO JL=1,IWORK
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK3D(:,JL,JP),NPE%AL(JP)%XWGI(:,JL))
+ ENDDO
+ENDDO
+DEALLOCATE(ZWORK3D)
!
!* water intercepted on leaves
!
-ALLOCATE(I%XWR(ILU,I%NPATCH))
!
YRECFM = 'WR'
- CALL READ_SURF_FIELD2D(HPROGRAM,I%XWR,YRECFM)
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
+DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XWR(:))
+ENDDO
!
!* Leaf Area Index
!
-IF (I%CPHOTO=='LAI' .OR. I%CPHOTO=='LST' .OR. I%CPHOTO=='NIT' .OR. I%CPHOTO=='NCB') THEN
+IF (IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') THEN
+
YRECFM = 'LAI'
- CALL READ_SURF_FIELD2D(HPROGRAM,I%XLAI,YRECFM)
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XLAI(:))
+ ENDDO
+
IF ( TRIM(CASSIM_ISBA)=="EKF" .AND. LPRT ) THEN
!
! read in control variable
IF ( TRIM(CVAR(NIVAR))=="LAI" ) THEN
- WHERE ( I%XLAI(:,:)/=XUNDEF )
- I%XLAI(:,:) = I%XLAI(:,:) + XTPRT(NIVAR)*I%XLAI(:,:)
- ENDWHERE
+ DO JP = 1,IO%NPATCH
+ PEK => NPE%AL(JP)
+ WHERE ( PEK%XLAI(:)/=XUNDEF )
+ PEK%XLAI(:) = PEK%XLAI(:) + XTPRT(NIVAR)* PEK%XLAI(:)
+ ENDWHERE
+ ENDDO
ENDIF
!
ELSEIF ( TRIM(CASSIM_ISBA)=="ENKF" .AND. NIE<NENS+1 ) THEN
!
- IF (I%NPATCH==12) THEN
+ IF (IO%NPATCH==12) THEN
ZVLAIMIN = (/0.3,0.3,0.3,0.3,1.0,1.0,0.3,0.3,0.3,0.3,0.3,0.3/)
ELSE
ZVLAIMIN = (/0.3/)
ENDIF
!
- ALLOCATE(ZLAI(ILU,1,I%NPATCH))
- ZLAI(:,1,:) = I%XLAI(:,:)
- CALL MAKE_ENS_ENKF(1,ILU,"LAI",ZCOFSWI,ZLAI,I%XRED_NOISE)
- DO JP = 1,I%NPATCH
- I%XLAI(:,JP) = MAX(ZVLAIMIN(JP),ZLAI(:,1,JP))
+ ALLOCATE(ZLAI(ILU,1,IO%NPATCH))
+ ZLAI(:,:,:) = 0.
+ DO JP = 1,IO%NPATCH
+ ZLAI(1:NP%AL(JP)%NSIZE_P,1,JP) = NPE%AL(JP)%XLAI(:)
+ ENDDO
+ CALL MAKE_ENS_ENKF(1,ILU,"LAI",ZCOFSWI,NP,ZLAI)
+ DO JP = 1,IO%NPATCH
+ NPE%AL(JP)%XLAI(:) = MAX(ZVLAIMIN(JP),ZLAI(1:NP%AL(JP)%NSIZE_P,1,JP))
ENDDO
DEALLOCATE(ZLAI)
!
@@ -271,27 +356,35 @@ END IF
!
!* snow mantel
!
- CALL READ_GR_SNOW(&
- HPROGRAM,'VEG',' ',ILU,I%NPATCH,I%TSNOW )
-!
-YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
-!
-YRECFM='BUG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IBUGFIX,IRESP)
+DO JP = 1,IO%NPATCH
+ IF (JP>1) THEN
+ NPE%AL(JP)%TSNOW%SCHEME = NPE%AL(1)%TSNOW%SCHEME
+ NPE%AL(JP)%TSNOW%NLAYER = NPE%AL(1)%TSNOW%NLAYER
+ ENDIF
+ CALL READ_GR_SNOW(HPROGRAM,'VEG',' ',ILU,NP%AL(JP)%NSIZE_P,NP%AL(JP)%NR_P,JP,&
+ NPE%AL(JP)%TSNOW,KNPATCH=IO%NPATCH )
+ CALL IO_BUFF_CLEAN
+ENDDO
!
-IF(I%LGLACIER)THEN
- ALLOCATE(I%XICE_STO(ILU,I%NPATCH))
+IF(IO%LGLACIER)THEN
+ DO JP = 1,IO%NPATCH
+ ALLOCATE(NPE%AL(JP)%XICE_STO(NP%AL(JP)%NSIZE_P))
+ ENDDO
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN
YRECFM = 'ICE_STO'
- CALL READ_SURF_FIELD2D(HPROGRAM,I%XICE_STO,YRECFM)
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XICE_STO(:))
+ ENDDO
ELSE
- I%XICE_STO(:,:) = 0.0
+ DO JP = 1,IO%NPATCH
+ NPE%AL(JP)%XICE_STO(:) = 0.0
+ ENDDO
ENDIF
-ELSE
- ALLOCATE(I%XICE_STO(0,0))
+ELSE
+ DO JP = 1,IO%NPATCH
+ ALLOCATE(NPE%AL(JP)%XICE_STO(0))
+ ENDDO
ENDIF
!
!-------------------------------------------------------------------------------
@@ -299,52 +392,75 @@ ENDIF
!* 3. MEB Prognostic or Semi-prognostic variables
! -------------------------------------------
!
-ISIZE_LMEB_PATCH=COUNT(I%LMEB_PATCH(:))
+ISIZE_LMEB_PATCH=COUNT(IO%LMEB_PATCH(:))
!
IF (ISIZE_LMEB_PATCH>0) THEN
!
-!* water intercepted on litter
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+ ALLOCATE(PEK%XWRL (PK%NSIZE_P))
+ ALLOCATE(PEK%XWRLI(PK%NSIZE_P))
+ ALLOCATE(PEK%XWRVN(PK%NSIZE_P))
+ ALLOCATE(PEK%XTV (PK%NSIZE_P))
+ ALLOCATE(PEK%XTL (PK%NSIZE_P))
+ ALLOCATE(PEK%XTC (PK%NSIZE_P))
+ ALLOCATE(PEK%XQC (PK%NSIZE_P))
+ ENDDO
- ALLOCATE(I%XWRL(ILU,I%NPATCH))
+!* water intercepted on litter
+
YRECFM = 'WRL'
- CALL READ_SURF(HPROGRAM,YRECFM,I%XWRL(:,:),IRESP)
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
+DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XWRL(:))
+ENDDO
- ALLOCATE(I%XWRLI(ILU,I%NPATCH))
YRECFM = 'WRLI'
- CALL READ_SURF(HPROGRAM,YRECFM,I%XWRLI(:,:),IRESP)
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
+DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XWRLI(:))
+ENDDO
!
!* snow intercepted on vegetation canopy leaves
!
- ALLOCATE(I%XWRVN(ILU,I%NPATCH))
YRECFM = 'WRVN'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XWRVN(:,:),IRESP)
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
+DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XWRVN(:))
+ENDDO
!
!* vegetation canopy temperature
!
- ALLOCATE(I%XTV(ILU,I%NPATCH))
YRECFM = 'TV'
- CALL READ_SURF(HPROGRAM,YRECFM,I%XTV(:,:),IRESP)
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
+DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XTV(:))
+ENDDO
!
!* litter temperature
!
- ALLOCATE(I%XTL(ILU,I%NPATCH))
YRECFM = 'TL'
- CALL READ_SURF(HPROGRAM,YRECFM,I%XTL(:,:),IRESP)
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
+DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XTL(:))
+ENDDO
!
!* vegetation canopy air temperature
!
- ALLOCATE(I%XTC(ILU,I%NPATCH))
YRECFM = 'TC'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XTC(:,:),IRESP)
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
+DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XTC(:))
+ENDDO
!
!* vegetation canopy air specific humidity
!
- ALLOCATE(I%XQC(ILU,I%NPATCH))
YRECFM = 'QC'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XQC(:,:),IRESP)
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
+DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XQC(:))
+ENDDO
!
ENDIF
!
@@ -353,89 +469,106 @@ ENDIF
!* 4. Semi-prognostic variables
! -------------------------
!
-ALLOCATE(I%XRESA(ILU,I%NPATCH))
-ALLOCATE(I%XLE (ILU,I%NPATCH))
-IF (I%CPHOTO/='NON') THEN
- ALLOCATE(I%XANFM (ILU,I%NPATCH))
- ALLOCATE(I%XAN (ILU,I%NPATCH))
- ALLOCATE(I%XANDAY (ILU,I%NPATCH))
-END IF
-!
-IF(I%CPHOTO/='NON') THEN
- ALLOCATE(I%XBIOMASS (ILU,I%NNBIOMASS,I%NPATCH))
- ALLOCATE(I%XRESP_BIOMASS (ILU,I%NNBIOMASS,I%NPATCH))
-END IF
+DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+
+ ALLOCATE(PEK%XRESA(PK%NSIZE_P))
+ ALLOCATE(PEK%XLE (PK%NSIZE_P))
+ PEK%XRESA(:) = 100.
+ PEK%XLE(:) = 0.
+
+ IF (IO%CPHOTO/='NON') THEN
+ ALLOCATE(PEK%XANFM (PK%NSIZE_P))
+ ALLOCATE(PEK%XAN (PK%NSIZE_P))
+ ALLOCATE(PEK%XANDAY (PK%NSIZE_P))
+ PEK%XANFM (:) = XANFMINIT
+ PEK%XAN (:) = 0.
+ PEK%XANDAY(:) = 0.
+ !
+ ALLOCATE(PEK%XBIOMASS (PK%NSIZE_P,IO%NNBIOMASS))
+ ALLOCATE(PEK%XRESP_BIOMASS (PK%NSIZE_P,IO%NNBIOMASS))
+ PEK%XBIOMASS(:,:) = 0.
+ PEK%XRESP_BIOMASS(:,:) = 0.
+ END IF
+
+ENDDO
!
!
!* aerodynamical resistance
!
YRECFM = 'RESA'
-I%XRESA(:,:) = 100.
- CALL READ_SURF_FIELD2D(HPROGRAM,I%XRESA,YRECFM)
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
+DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XRESA(:))
+ENDDO
!
!* patch averaged radiative temperature (K)
!
-ALLOCATE(I%XTSRAD_NAT(ILU))
+ALLOCATE(S%XTSRAD_NAT(ILU))
IF (IVERSION<6) THEN
- I%XTSRAD_NAT(:)=0.
- DO JP=1,I%NPATCH
- I%XTSRAD_NAT(:)=I%XTSRAD_NAT(:)+I%XTG(:,1,JP)
+ S%XTSRAD_NAT(:)=0.
+ DO JP=1,IO%NPATCH
+ DO JI = 1,NP%AL(JP)%NSIZE_P
+ IMASK = NP%AL(JP)%NR_P(JI)
+ S%XTSRAD_NAT(IMASK) = S%XTSRAD_NAT(IMASK)+NPE%AL(JP)%XTG(JI,1)
+ ENDDO
ENDDO
- I%XTSRAD_NAT(:)=I%XTSRAD_NAT(:)/I%NPATCH
+ S%XTSRAD_NAT(:)=S%XTSRAD_NAT(:)/IO%NPATCH
ELSE
YRECFM='TSRAD_NAT'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XTSRAD_NAT(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XTSRAD_NAT(:),IRESP)
ENDIF
!
-I%XLE(:,:) = XUNDEF
+DO JP = 1,IO%NPATCH
+ NPE%AL(JP)%XLE(:) = XUNDEF
+ENDDO
!
!* 5. ISBA-AGS variables
!
-IF (I%CPHOTO/='NON') THEN
+IF (IO%CPHOTO/='NON') THEN
YRECFM = 'AN'
- I%XAN(:,:) = 0.
- CALL READ_SURF_FIELD2D(HPROGRAM,I%XAN,YRECFM)
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XAN(:))
+ ENDDO
!
YRECFM = 'ANDAY'
- I%XANDAY(:,:) = 0.
- CALL READ_SURF_FIELD2D(HPROGRAM,I%XANDAY,YRECFM)
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XANDAY(:))
+ ENDDO
!
YRECFM = 'ANFM'
- I%XANFM(:,:) = XANFMINIT
- CALL READ_SURF_FIELD2D(HPROGRAM,I%XANFM,YRECFM)
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XANFM(:))
+ ENDDO
!
YRECFM = 'LE_AGS'
- I%XLE(:,:) = 0.
- CALL READ_SURF_FIELD2D(HPROGRAM,I%XLE,YRECFM)
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XLE(:))
+ ENDDO
END IF
!
-IF (I%CPHOTO=='AGS' .OR. I%CPHOTO=='AST') THEN
+IF (IO%CPHOTO=='NIT'.OR.IO%CPHOTO=='NCB') THEN
!
- I%XBIOMASS(:,:,:) = 0.
- I%XRESP_BIOMASS(:,:,:) = 0.
-
-ELSEIF (I%CPHOTO=='LAI' .OR. I%CPHOTO=='LST') THEN
- !
- I%XBIOMASS(:,1,:) = I%XBSLAI(:,:) * I%XLAI(:,:)
- I%XRESP_BIOMASS(:,:,:) = 0.
-
-ELSEIF (I%CPHOTO=='NIT'.OR.I%CPHOTO=='NCB') THEN
- !
- I%XBIOMASS(:,:,:) = 0.
+ ALLOCATE(ZWORK3D(ILU,IO%NNBIOMASS,IO%NPATCH))
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
YRECFM='BIOMA'
ELSE
YRECFM='BIOMASS'
ENDIF
- CALL READ_SURF_FIELD3D(HPROGRAM,I%XBIOMASS,1,I%NNBIOMASS,YRECFM)
-
- DO JNBIOMASS=1,I%NNBIOMASS
- IF ( TRIM(CASSIM_ISBA)=="EKF" .AND. LPRT ) THEN
+ CALL READ_SURF_LAYERS(HPROGRAM,YRECFM,GDIM,ZWORK3D,IRESP)
+ DO JNB=1,IO%NNBIOMASS
+ WRITE(YLVL,'(I1)') JNB
+ IF ( TRIM(CASSIM_ISBA)=="EKF" .AND. LPRT ) THEN
+ YCBIO = YRECFM(:LEN_TRIM(YRECFM))//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
! read in control variable
- IF ( TRIM(CVAR(NIVAR)) == "LAI" .AND. TRIM(CBIO)==TRIM(YRECFM) ) THEN
- WHERE ( I%XBIOMASS(:,JNBIOMASS,:)/=XUNDEF )
- I%XBIOMASS(:,JNBIOMASS,:) = I%XBIOMASS(:,JNBIOMASS,:) + XTPRT(NIVAR)*I%XBIOMASS(:,JNBIOMASS,:)
+ IF ( TRIM(CVAR(NIVAR)) == "LAI" .AND. TRIM(CBIO)==TRIM(YCBIO) ) THEN
+ WHERE ( ZWORK3D(:,JNB,:)/=XUNDEF )
+ ZWORK3D(:,JNB,:) = ZWORK3D(:,JNB,:) * ( 1. + XTPRT(NIVAR) )
ENDWHERE
ENDIF
ELSEIF ( TRIM(CASSIM_ISBA)=="ENKF" .AND. NIE<NENS+1 .AND. .NOT.LASSIM ) THEN
@@ -444,8 +577,8 @@ ELSEIF (I%CPHOTO=='NIT'.OR.I%CPHOTO=='NCB') THEN
DO JVAR = 1,NVAR
IF (TRIM(CVAR(JVAR)) == "LAI") THEN
DO JI = 1,ILU
- DO JP = 1,I%NPATCH
- I%XBIOMASS(JI,JNBIOMASS,JP) = I%XBIOMASS(JI,JNBIOMASS,JP) + XADDINFL(JVAR)*RANDOM_NORMAL()
+ DO JP = 1,IO%NPATCH
+ ZWORK3D(JI,JNB,JP) = ZWORK3D(JI,JNB,JP) + XADDINFL(JVAR)*RANDOM_NORMAL()
ENDDO
ENDDO
EXIT
@@ -454,25 +587,28 @@ ELSEIF (I%CPHOTO=='NIT'.OR.I%CPHOTO=='NCB') THEN
ENDIF
!
ENDIF
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK3D(:,JNB,JP),NPE%AL(JP)%XBIOMASS(:,JNB))
+ ENDDO
END DO
+ DEALLOCATE(ZWORK3D)
!
IWORK=0
- IF(I%CPHOTO=='NCB'.OR.IVERSION<8)IWORK=2
+ IF(IO%CPHOTO=='NCB'.OR.IVERSION<8)IWORK=2
!
- I%XRESP_BIOMASS(:,:,:) = 0.
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
- YRECFM='RESPI'
- ELSE
- YRECFM='RESP_BIOM'
- ENDIF
- CALL READ_SURF_FIELD3D(HPROGRAM,I%XRESP_BIOMASS,2,I%NNBIOMASS,YRECFM)
- DO JNBIOMASS=2,I%NNBIOMASS-IWORK
+ DO JNB=2,IO%NNBIOMASS-IWORK
+ WRITE(YLVL,'(I1)') JNB
+ IF (IVERSION>7 .OR. (IVERSION==7 .AND. IBUGFIX>=3)) THEN
+ YRECFM='RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ ELSE
+ YRECFM='RESP_BIOM'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ ENDIF
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
IF ( TRIM(CASSIM_ISBA)=="EKF" .AND. LPRT ) THEN
! read in control variable
IF ( TRIM(CVAR(NIVAR)) == "LAI" .AND. TRIM(CBIO)==TRIM(YRECFM) ) THEN
- WHERE ( I%XRESP_BIOMASS(:,JNBIOMASS,:)/=XUNDEF )
- I%XRESP_BIOMASS(:,JNBIOMASS,:) = I%XRESP_BIOMASS(:,JNBIOMASS,:) + &
- XTPRT(NIVAR)*I%XRESP_BIOMASS(:,JNBIOMASS,:)
+ WHERE ( ZWORK(:,:)/=XUNDEF )
+ ZWORK(:,:) = ZWORK(:,:) + XTPRT(NIVAR)*ZWORK(:,:)
ENDWHERE
ELSEIF ( TRIM(CASSIM_ISBA)=="ENKF" .AND. NIE<NENS+1 .AND. .NOT.LASSIM ) THEN
!
@@ -480,9 +616,8 @@ ELSEIF (I%CPHOTO=='NIT'.OR.I%CPHOTO=='NCB') THEN
DO JVAR = 1,NVAR
IF (TRIM(CVAR(JVAR)) == "LAI") THEN
DO JI = 1,ILU
- DO JP = 1,I%NPATCH
- I%XRESP_BIOMASS(JI,JNBIOMASS,JP) = I%XRESP_BIOMASS(JI,JNBIOMASS,JP) + &
- XADDINFL(JVAR)*RANDOM_NORMAL()
+ DO JP = 1,IO%NPATCH
+ ZWORK(JI,JP) = ZWORK(JI,JP) + XADDINFL(JVAR)*RANDOM_NORMAL()
ENDDO
ENDDO
EXIT
@@ -491,7 +626,10 @@ ELSEIF (I%CPHOTO=='NIT'.OR.I%CPHOTO=='NCB') THEN
ENDIF
!
ENDIF
- ENDIF
+ ENDIF
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XRESP_BIOMASS(:,JNB))
+ ENDDO
END DO
!
ENDIF
@@ -501,64 +639,80 @@ DEALLOCATE(ZCOFSWI)
!* 6. Soil carbon
!
!
-IF (I%CRESPSL=='CNT') THEN
+IF (IO%CRESPSL=='CNT') THEN
!
- ALLOCATE(I%XLITTER (ILU,I%NNLITTER,I%NNLITTLEVS,I%NPATCH))
- ALLOCATE(I%XSOILCARB (ILU,I%NNSOILCARB,I%NPATCH))
- ALLOCATE(I%XLIGNIN_STRUC (ILU,I%NNLITTLEVS,I%NPATCH))
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+ ALLOCATE(PEK%XLITTER (PK%NSIZE_P,IO%NNLITTER,IO%NNLITTLEVS))
+ ALLOCATE(PEK%XSOILCARB (PK%NSIZE_P,IO%NNSOILCARB))
+ ALLOCATE(PEK%XLIGNIN_STRUC(PK%NSIZE_P,IO%NNLITTLEVS))
+ !
+ PEK%XLITTER(:,:,:) = 0.
+ PEK%XSOILCARB(:,:) = 0.
+ PEK%XLIGNIN_STRUC(:,:) = 0.
+ !
+ ENDDO
!
- I%XLITTER(:,:,:,:) = 0.
- DO JNLITTER=1,I%NNLITTER
- DO JNLITTLEVS=1,I%NNLITTLEVS
+ DO JNLITTER=1,IO%NNLITTER
+ DO JNLITTLEVS=1,IO%NNLITTLEVS
WRITE(YLVL,'(I1,A1,I1)') JNLITTER,'_',JNLITTLEVS
YRECFM='LITTER'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF_FIELD2D(HPROGRAM,ZWORK(:,:),YRECFM)
- I%XLITTER(:,JNLITTER,JNLITTLEVS,:)=ZWORK
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XLITTER(:,JNLITTER,JNLITTLEVS))
+ ENDDO
END DO
END DO
- I%XSOILCARB(:,:,:) = 0.
- YRECFM='SOILCARB'
- CALL READ_SURF_FIELD3D(HPROGRAM,I%XSOILCARB,1,I%NNSOILCARB,YRECFM)
+ DO JNSOILCARB=1,IO%NNSOILCARB
+ WRITE(YLVL,'(I4)') JNSOILCARB
+ YRECFM='SOILCARB'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XSOILCARB(:,JNSOILCARB))
+ ENDDO
+ END DO
!
- I%XLIGNIN_STRUC(:,:,:) = 0.
- YRECFM='LIGNIN_STR'
- CALL READ_SURF_FIELD3D(HPROGRAM,I%XLIGNIN_STRUC,1,I%NNLITTLEVS,YRECFM)
+ DO JNLITTLEVS=1,IO%NNLITTLEVS
+ WRITE(YLVL,'(I4)') JNLITTLEVS
+ YRECFM='LIGN_STR'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XSOILCARB(:,JNLITTLEVS))
+ ENDDO
+ END DO
!
ENDIF
IF ( LASSIM ) THEN
IF ( TRIM(CASSIM_ISBA) == "OI" ) THEN
- IF ( I%NPATCH /= 1 ) CALL ABOR1_SFX ('Reading of diagnostical values for'&
+ IF ( IO%NPATCH /= 1 ) CALL ABOR1_SFX ('Reading of diagnostical values for'&
& //'assimilation at the moment only works for one patch for OI')
! Diagnostic fields for assimilation
IF ( .NOT. ALLOCATED(XAT2M_ISBA)) ALLOCATE(XAT2M_ISBA(ILU,1))
XAT2M_ISBA=XUNDEF
YRECFM='T2M'
CALL IO_BUFF(YRECFM,'R',GKNOWN)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,XAT2M_ISBA(:,1),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,XAT2M_ISBA(:,1),IRESP)
IF ( .NOT. ALLOCATED(XAHU2M_ISBA)) ALLOCATE(XAHU2M_ISBA(ILU,1))
XAHU2M_ISBA=XUNDEF
YRECFM='HU2M'
CALL IO_BUFF(YRECFM,'R',GKNOWN)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,XAHU2M_ISBA(:,1),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,XAHU2M_ISBA(:,1),IRESP)
IF ( .NOT. ALLOCATED(XAZON10M_ISBA)) ALLOCATE(XAZON10M_ISBA(ILU,1))
XAZON10M_ISBA=XUNDEF
YRECFM='ZON10M'
CALL IO_BUFF(YRECFM,'R',GKNOWN)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,XAZON10M_ISBA(:,1),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,XAZON10M_ISBA(:,1),IRESP)
IF ( .NOT. ALLOCATED(XAMER10M_ISBA)) ALLOCATE(XAMER10M_ISBA(ILU,1))
XAMER10M_ISBA=XUNDEF
YRECFM='MER10M'
CALL IO_BUFF(YRECFM,'R',GKNOWN)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,XAMER10M_ISBA(:,1),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,XAMER10M_ISBA(:,1),IRESP)
ELSEIF ( NIFIC/=NVAR+2 ) THEN
! Diagnostic fields for EKF assimilation ("observations")
DO IOBS = 1,NOBSTYPE
@@ -568,17 +722,17 @@ IF ( LASSIM ) THEN
XAT2M_ISBA=XUNDEF
YRECFM='T2M'
CALL IO_BUFF(YRECFM,'R',GKNOWN)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,XAT2M_ISBA(:,1),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,XAT2M_ISBA(:,1),IRESP)
CASE("HU2M")
IF ( .NOT. ALLOCATED(XAHU2M_ISBA)) ALLOCATE(XAHU2M_ISBA(ILU,1))
XAHU2M_ISBA=XUNDEF
YRECFM='HU2M'
CALL IO_BUFF(YRECFM,'R',GKNOWN)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,XAHU2M_ISBA(:,1),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,XAHU2M_ISBA(:,1),IRESP)
CASE("WG1")
! This is already read above
+ CASE("WG2")
+ ! This is already read above
CASE("LAI")
! This is already read above
CASE("SWE")
@@ -592,11 +746,19 @@ ENDIF
!
DEALLOCATE(ZWORK)
!
+DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+ ALLOCATE(PEK%XSNOWFREE_ALB (PK%NSIZE_P))
+ ALLOCATE(PEK%XSNOWFREE_ALB_VEG (PK%NSIZE_P))
+ ALLOCATE(PEK%XSNOWFREE_ALB_SOIL(PK%NSIZE_P))
+ENDDO
+!
IF (LHOOK) CALL DR_HOOK('READ_ISBA_N',1,ZHOOK_HANDLE)
!
- CONTAINS
+CONTAINS
!
-SUBROUTINE MAKE_ENS_ENKF(KWORK,KLU,HREC,PCOFSWI,PVAR,PRED_NOISE)
+SUBROUTINE MAKE_ENS_ENKF(KWORK,KLU,HREC,PCOFSWI,NP,PVAR)
!
USE MODD_ASSIM, ONLY : LENS_GEN, XADDTIMECORR, XADDINFL, XASSIM_WINH
!
@@ -609,12 +771,13 @@ INTEGER, INTENT(IN) :: KWORK
INTEGER, INTENT(IN) :: KLU
CHARACTER(LEN=3), INTENT(IN) :: HREC
REAL, DIMENSION(:), INTENT(IN) :: PCOFSWI
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PVAR
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRED_NOISE
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+REAL, DIMENSION(:,:,:), INTENT(INOUT), OPTIONAL :: PVAR
!
CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
CHARACTER(LEN=4) :: YLVL
CHARACTER(LEN=3) :: YVAR
+REAL, DIMENSION(KLU) :: ZVAR
REAL :: ZWHITE_NOISE, ZVAR0
INTEGER :: JL, JI, JP, IVAR
LOGICAL :: GPASS
@@ -646,32 +809,37 @@ DO JL=1,KWORK
!
IF (XADDINFL(IVAR)>0.) THEN
!
- IF (LASSIM) THEN
- !
- WRITE(YVAR,'(I3)') IVAR
- YRECFM='RED_NOISE'//ADJUSTL(YVAR(:LEN_TRIM(YVAR)))
- CALL READ_SURF(HPROGRAM,YRECFM,PRED_NOISE(:,:,IVAR),IRESP)
- !
- ELSEIF (.NOT.LENS_GEN .AND. XADDTIMECORR(IVAR)>0. ) THEN
+ IF (LASSIM .OR. (.NOT.LENS_GEN .AND. XADDTIMECORR(IVAR)>0.)) THEN
!
WRITE(YVAR,'(I3)') IVAR
- YRECFM='RED_NOISE'//ADJUSTL(YVAR(:LEN_TRIM(YVAR)))
- CALL READ_SURF(HPROGRAM,YRECFM,PRED_NOISE(:,:,IVAR),IRESP)
- !
- DO JI = 1,KLU
- DO JP = 1,I%NPATCH
- ZWHITE_NOISE = XADDINFL(IVAR)*PCOFSWI(JI)*RANDOM_NORMAL()
- CALL ADD_NOISE(XADDTIMECORR(IVAR),XASSIM_WINH,ZWHITE_NOISE,PRED_NOISE(JI,JP,IVAR))
- ENDDO
- ENDDO
+ YRECFM='RD_NS'//ADJUSTL(YVAR(:LEN_TRIM(YVAR)))
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
+ DO JP = 1,IO%NPATCH
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NP%AL(JP)%XRED_NOISE(:,IVAR))
+ ENDDO
!
- ZCOEF = XASSIM_WINH/24.
+ IF (.NOT.LASSIM) THEN
+ !
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ DO JI = 1,NP%AL(JP)%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ ZWHITE_NOISE = XADDINFL(IVAR)*PCOFSWI(IMASK)*RANDOM_NORMAL()
+ CALL ADD_NOISE(XADDTIMECORR(IVAR),XASSIM_WINH,ZWHITE_NOISE,PK%XRED_NOISE(JI,IVAR))
+ ENDDO
+ ENDDO
+ !
+ ZCOEF = XASSIM_WINH/24.
+ !
+ ENDIF
!
ELSE
!
- DO JI = 1,ILU
- DO JP = 1,I%NPATCH
- PRED_NOISE(JI,JP,IVAR) = XADDINFL(IVAR)*PCOFSWI(JI)*RANDOM_NORMAL()
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ DO JI = 1,NP%AL(JP)%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ NP%AL(JP)%XRED_NOISE(JI,IVAR) = XADDINFL(IVAR)*PCOFSWI(IMASK)*RANDOM_NORMAL()
ENDDO
ENDDO
!
@@ -681,23 +849,44 @@ DO JL=1,KWORK
!
IF (.NOT.LASSIM) THEN
!
- DO JI = 1,ILU
- DO JP = 1,I%NPATCH
- IF ( PVAR(JI,JL,JP)/=XUNDEF ) THEN
+ DO JP = 1,IO%NPATCH
+ !
+ ZVAR(:) = 0.
+ IF (TRIM(HREC)=='TG') THEN
+ ZVAR(1:NP%AL(JP)%NSIZE_P) = NPE%AL(JP)%XTG(:,JL)
+ ELSEIF (TRIM(HREC)=='WG') THEN
+ ZVAR(1:NP%AL(JP)%NSIZE_P) = NPE%AL(JP)%XWG(:,JL)
+ ELSEIF (TRIM(HREC)=='LAI' .AND. PRESENT(PVAR)) THEN
+ ZVAR(1:NP%AL(JP)%NSIZE_P) = PVAR(1:NP%AL(JP)%NSIZE_P,JL,JP)
+ ELSE
+ CALL ABOR1_SFX("READ_ISBAn: HREC "//HREC//" not permitted")
+ ENDIF
+ !
+ DO JI = 1,NP%AL(JP)%NSIZE_P
+ IF ( ZVAR(JI)/=XUNDEF ) THEN
!
- ZVAR0 = PVAR(JI,JL,JP)
+ ZVAR0 = ZVAR(JI)
!
- PVAR(JI,JL,JP) = PVAR(JI,JL,JP) + ZCOEF * PRED_NOISE(JI,JP,IVAR)
+ ZVAR(JI) = ZVAR(JI) + ZCOEF * NP%AL(JP)%XRED_NOISE(JI,IVAR)
!
- IF (PVAR(JI,JL,JP) < 0.) THEN
+ IF (ZVAR(JI) < 0.) THEN
IF (LENS_GEN) THEN
- PVAR(JI,JL,JP) = ABS(PVAR(JI,JL,JP))
+ ZVAR(JI) = ABS(ZVAR(JI))
ELSE
- PVAR(JI,JL,JP) = ZVAR0
+ ZVAR(JI) = ZVAR0
ENDIF
ENDIF
ENDIF
ENDDO
+ !
+ IF (TRIM(HREC)=='TG') THEN
+ NPE%AL(JP)%XTG(:,JL) = ZVAR(1:NP%AL(JP)%NSIZE_P)
+ ELSEIF (TRIM(HREC)=='WG') THEN
+ NPE%AL(JP)%XWG(:,JL) = ZVAR(1:NP%AL(JP)%NSIZE_P)
+ ELSEIF (TRIM(HREC)=='LAI') THEN
+ PVAR(1:NP%AL(JP)%NSIZE_P,JL,JP) = ZVAR(1:NP%AL(JP)%NSIZE_P)
+ ENDIF
+ !
ENDDO
!
ENDIF
diff --git a/src/SURFEX/read_latlon.F90 b/src/SURFEX/read_latlon.F90
index 6d4f499e5eb555f7d418b91e79623be6c2acb4b0..2ad17afae18277c774e33624da8918d4d9dae3f1 100644
--- a/src/SURFEX/read_latlon.F90
+++ b/src/SURFEX/read_latlon.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_LATLON (USS, &
+ SUBROUTINE READ_LATLON (UG, U, USS, &
HPROGRAM,HSCHEME,HSUBROUTINE,HFILENAME)
! #########################################################
!
@@ -40,8 +40,9 @@
! -----------
!
!
-!
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_PGD_GRID, ONLY : XMESHLENGTH
!
@@ -65,8 +66,9 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
-!
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
CHARACTER(LEN=6), INTENT(IN) :: HSCHEME ! Scheme treated
@@ -91,7 +93,7 @@ INTEGER :: IFILE ! logical units
INTEGER :: ILUOUT ! output listing logical unit
INTEGER :: IERR ! return codes
!
-INTEGER :: JLOOP ! loop index
+INTEGER :: JLOOP, IFACT ! loop index
CHARACTER(LEN=100):: YSTRING ! string
!
REAL :: ZDLAT ! latitude mesh in the data file
@@ -102,8 +104,9 @@ INTEGER :: JCOL ! index of column
REAL, DIMENSION(:), ALLOCATABLE :: ZVALUE ! value of a record of data points
REAL, DIMENSION(:), POINTER :: ZLAT ! latitude of data points
REAL, DIMENSION(:), POINTER :: ZLON ! longitude of data points
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+LOGICAL :: GCOMPRESS
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!----------------------------------------------------------------------------
!
@@ -124,7 +127,8 @@ IF (LHOOK) CALL DR_HOOK('READ_LATLON',0,ZHOOK_HANDLE)
! -----------------
!
CALL READHEAD(IFILE,ZGLBLATMIN,ZGLBLATMAX,ZGLBLONMIN,ZGLBLONMAX, &
- INBLINE,INBCOL,ZNODATA,ZDLAT,ZDLON,ZLAT,ZLON,IERR)
+ INBLINE,INBCOL,ZNODATA,ZDLAT,ZDLON,ZLAT,ZLON,IERR,IFACT,&
+ GCOMPRESS)
IF (IERR/=0) THEN
CALL ABOR1_SFX('READ_LATLON: PROBLEM IN FILE HEADER')
END IF
@@ -192,8 +196,10 @@ DO JLINE=1,INBLINE
!* 10. Call to the adequate subroutine (point by point treatment)
! ----------------------------------------------------------
!
- CALL PT_BY_PT_TREATMENT(USS, &
- ILUOUT,ZLAT(JLINE:JLINE),ZLON(JCOL:JCOL),ZVALUE(JCOL:JCOL),&
+ ZVALUE(:) = ZVALUE(:) / FLOAT(IFACT)
+
+ CALL PT_BY_PT_TREATMENT(UG, U, USS, &
+ ILUOUT,ZLAT(JLINE:JLINE),ZLON(JCOL:JCOL),ZVALUE(JCOL:JCOL),&
HSUBROUTINE )
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/read_lcover.F90 b/src/SURFEX/read_lcover.F90
index 94ca615add4106c359b4aa57a666a6c54850ca19..575b0ba0bbd2b53fec731b3ecf37bf815910b371 100644
--- a/src/SURFEX/read_lcover.F90
+++ b/src/SURFEX/read_lcover.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_LCOVER (&
- HPROGRAM,OCOVER)
+ SUBROUTINE READ_LCOVER (HPROGRAM,OCOVER)
! ################################
!
!!**** *READ_LCOVER* - routine to read a file for
@@ -37,7 +36,7 @@
!! MODIFICATIONS
!! -------------
!! Original 10/2008
-!! M. Moge 02/2015 parallelization
+!! M. Moge 02/2015 parallelization for mésonh
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -55,9 +54,12 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
+!
+#ifdef MNH_PARALLEL
#ifndef NOMPI
INCLUDE "mpif.h"
#endif
+#endif
!
!* 0.1 Declarations of arguments
! -------------------------
@@ -70,35 +72,41 @@ LOGICAL, DIMENSION(JPCOVER) :: OCOVER ! list of covers
!* 0.2 Declarations of local variables
! -------------------------------
!
-INTEGER :: IRESP ! Error code after redding
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
-INTEGER :: IVERSION ! version of surfex file being read
LOGICAL, DIMENSION(:), ALLOCATABLE :: GCOVER ! cover list in the file
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+ CHARACTER(LEN=LEN_HREC) :: YRECFMOLD ! Name of the article to be read
+INTEGER :: IVERSION ! version of surfex file being read
+INTEGER :: IRESP ! Error code after redding
+#ifdef MNH_PARALLEL
INTEGER :: IINFO
+#endif
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
!
!* ascendant compatibility
IF (LHOOK) CALL DR_HOOK('READ_LCOVER',0,ZHOOK_HANDLE)
YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
IF (IVERSION<=3) THEN
ALLOCATE(GCOVER(255))
ELSE
ALLOCATE(GCOVER(JPCOVER))
END IF
- CALL OLD_NAME(&
- HPROGRAM,'COVER_LIST ',YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,GCOVER(:),IRESP,HDIR='-')
+ YRECFMOLD='COVER_LIST'
+ CALL OLD_NAME(HPROGRAM,YRECFMOLD,YRECFM)
+ CALL READ_SURF(HPROGRAM,YRECFM,GCOVER(:),IRESP,HDIR='-')
!
OCOVER=.FALSE.
OCOVER(:SIZE(GCOVER))=GCOVER(:)
+!
+#ifdef MNH_PARALLEL
#ifndef NOMPI
CALL MPI_ALLREDUCE(GCOVER, OCOVER, SIZE(GCOVER),MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, IINFO)
#endif
+#endif
+!
DEALLOCATE(GCOVER)
IF (LHOOK) CALL DR_HOOK('READ_LCOVER',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/read_lecoclimap.F90 b/src/SURFEX/read_lecoclimap.F90
index 8ea72a9206ffd5e85c554cd4574c5fff72b4e32a..a77cc44def3fd111accae6173e912b984f633469 100644
--- a/src/SURFEX/read_lecoclimap.F90
+++ b/src/SURFEX/read_lecoclimap.F90
@@ -3,13 +3,9 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #######################
- SUBROUTINE READ_LECOCLIMAP (&
- HPROGRAM,OECOCLIMAP)
+ SUBROUTINE READ_LECOCLIMAP (HPROGRAM,OECOCLIMAP,OECOSG,HDIR)
! #######################
!
-!
-!
-!
USE MODI_READ_SURF
!
!
@@ -20,16 +16,17 @@ IMPLICIT NONE
!
!* dummy arguments
! ---------------
-!
-!
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
LOGICAL, INTENT(OUT) :: OECOCLIMAP! flag for ecoclimap
+LOGICAL, INTENT(OUT) :: OECOSG ! flag for ecoclimap
+ CHARACTER(LEN=1), INTENT(IN), OPTIONAL :: HDIR
!
!
!* local variables
! ---------------
!
+ CHARACTER(LEN=1) :: YDIR
CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
INTEGER :: IRESP ! reading return code
!
@@ -41,20 +38,31 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('READ_LECOCLIMAP',0,ZHOOK_HANDLE)
+!
+YDIR = 'H'
+IF (PRESENT(HDIR)) then
+YDIR = HDIR
+endif
+!
YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP,HDIR=YDIR)
YRECFM='BUG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IBUGFIX,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP,HDIR=YDIR)
!
IF (IVERSION<1 .OR. (IVERSION==1 .AND. IBUGFIX==0)) THEN
OECOCLIMAP = .TRUE.
ELSE
YRECFM='ECOCLIMAP'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,OECOCLIMAP,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,OECOCLIMAP,IRESP,HDIR=YDIR)
END IF
+!
+IF (IVERSION<8 .OR. (IVERSION==8 .AND. IBUGFIX==0)) THEN
+ OECOSG = .FALSE.
+ELSE
+ YRECFM='ECOSG'
+ CALL READ_SURF(HPROGRAM,YRECFM,OECOSG,IRESP,HDIR=YDIR)
+END IF
+!
IF (LHOOK) CALL DR_HOOK('READ_LECOCLIMAP',1,ZHOOK_HANDLE)
!
!------------------------------------------------------------------------------
diff --git a/src/SURFEX/read_nam_grid_cartesian.F90 b/src/SURFEX/read_nam_grid_cartesian.F90
index 78eebcec1497053fcac56949458d7c621db328b6..2aff9bd75b0b5c324be9fe10bfd15b744ee7258d 100644
--- a/src/SURFEX/read_nam_grid_cartesian.F90
+++ b/src/SURFEX/read_nam_grid_cartesian.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ################################################################
- SUBROUTINE READ_NAM_GRID_CARTESIAN(HPROGRAM,KGRID_PAR,KL,PGRID_PAR)
+ SUBROUTINE READ_NAM_GRID_CARTESIAN(PGRID_FULL_PAR,KDIM_FULL,HPROGRAM,KGRID_PAR,KL,PGRID_PAR,HDIR)
! ################################################################
!
!!**** *READ_NAM_GRID_CARTESIAN* - routine to read in namelist the horizontal grid
@@ -37,6 +37,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NSIZE_TASK
+!
USE MODE_POS_SURF
!
USE MODI_OPEN_NAMELIST
@@ -44,7 +46,7 @@ USE MODI_CLOSE_NAMELIST
USE MODI_GET_LUOUT
!
USE MODE_GRIDTYPE_CARTESIAN
-!
+USE MODI_READ_AND_SEND_MPI
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -53,11 +55,15 @@ IMPLICIT NONE
!
!* 0.1 Declarations of arguments
! -------------------------
+!
+REAL, DIMENSION(:), POINTER :: PGRID_FULL_PAR
+INTEGER, INTENT(IN) :: KDIM_FULL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
INTEGER, INTENT(INOUT) :: KGRID_PAR ! size of PGRID_PAR
INTEGER, INTENT(OUT) :: KL ! number of points
REAL, DIMENSION(KGRID_PAR), INTENT(OUT) :: PGRID_PAR ! parameters defining this grid
+ CHARACTER(LEN=1), INTENT(IN) :: HDIR
!
!* 0.2 Declarations of local variables
! -------------------------------
@@ -67,10 +73,10 @@ INTEGER :: ILUNAM ! namelist file logical unit
INTEGER :: JI, JJ ! loop counters
INTEGER :: JL ! loop counter
-REAL, DIMENSION(:), ALLOCATABLE :: ZX ! X conformal coordinate of grid mesh
-REAL, DIMENSION(:), ALLOCATABLE :: ZY ! Y conformal coordinate of grid mesh
-REAL, DIMENSION(:), ALLOCATABLE :: ZDX ! X grid mesh size
-REAL, DIMENSION(:), ALLOCATABLE :: ZDY ! Y grid mesh size
+REAL, DIMENSION(:), ALLOCATABLE :: ZX, ZX0 ! X conformal coordinate of grid mesh
+REAL, DIMENSION(:), ALLOCATABLE :: ZY, ZY0 ! Y conformal coordinate of grid mesh
+REAL, DIMENSION(:), ALLOCATABLE :: ZDX, ZDX0 ! X grid mesh size
+REAL, DIMENSION(:), ALLOCATABLE :: ZDY, ZDY0 ! Y grid mesh size
!
!* 0.3 Declarations of namelist
! ------------------------
@@ -96,51 +102,72 @@ NAMELIST/NAM_CARTESIAN/XLAT0, XLON0, NIMAX, NJMAX, XDX, XDY
IF (LHOOK) CALL DR_HOOK('READ_NAM_GRID_CARTESIAN',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
- CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
-!
-!---------------------------------------------------------------------------
-!
-!* 2. Reading of projection parameters
-! --------------------------------
-!
- CALL POSNAM(ILUNAM,'NAM_CARTESIAN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CARTESIAN)
-!
-!---------------------------------------------------------------------------
- CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
-!---------------------------------------------------------------------------
-!
-!* 3. Number of points
-! ----------------
-!
-KL = NIMAX * NJMAX
-!
-!---------------------------------------------------------------------------
-!
-!* 3. Array of X and Y coordinates
-! ----------------------------
-!
-!
-ALLOCATE(ZX(KL))
-ALLOCATE(ZY(KL))
-DO JJ=1,NJMAX
- DO JI=1,NIMAX
- JL = JI + (JJ-1) * NIMAX
- ZX(JL) = FLOAT(JI) * XDX
- ZY(JL) = FLOAT(JJ) * XDY
+IF (HDIR/='H') THEN
+ !
+ CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 2. Reading of projection parameters
+ ! --------------------------------
+ !
+ CALL POSNAM(ILUNAM,'NAM_CARTESIAN',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CARTESIAN)
+ !
+ !---------------------------------------------------------------------------
+ CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
+ !---------------------------------------------------------------------------
+ !
+ !* 3. Number of points
+ ! ----------------
+ !
+ KL = NIMAX * NJMAX
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 3. Array of X and Y coordinates
+ ! ----------------------------
+ !
+ !
+ ALLOCATE(ZX(KL))
+ ALLOCATE(ZY(KL))
+ DO JJ=1,NJMAX
+ DO JI=1,NIMAX
+ JL = JI + (JJ-1) * NIMAX
+ ZX(JL) = FLOAT(JI) * XDX
+ ZY(JL) = FLOAT(JJ) * XDY
+ END DO
END DO
-END DO
-!
-!---------------------------------------------------------------------------
-!
-!* 4. Array of X and Y increments
-! ---------------------------
-!
-ALLOCATE(ZDX(KL))
-ALLOCATE(ZDY(KL))
-ZDX(:) = XDX
-ZDY(:) = XDY
-!
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 4. Array of X and Y increments
+ ! ---------------------------
+ !
+ ALLOCATE(ZDX(KL))
+ ALLOCATE(ZDY(KL))
+ ZDX(:) = XDX
+ ZDY(:) = XDY
+ !
+ELSE
+ !
+ ALLOCATE(ZX0(KDIM_FULL),ZY0(KDIM_FULL),ZDX0(KDIM_FULL),ZDY0(KDIM_FULL))
+ !
+ CALL GET_GRIDTYPE_CARTESIAN(PGRID_FULL_PAR,PLAT0=XLAT0,PLON0=XLON0,&
+ KIMAX=NIMAX,KJMAX=NJMAX,&
+ PX=ZX0,PY=ZY0,PDX=ZDX0,PDY=ZDY0)
+ !
+ KL = NSIZE_TASK(NRANK)
+ ALLOCATE(ZX(KL),ZY(KL),ZDX(KL),ZDY(KL))
+ !
+ CALL READ_AND_SEND_MPI(ZX0,ZX)
+ CALL READ_AND_SEND_MPI(ZY0,ZY)
+ CALL READ_AND_SEND_MPI(ZDX0,ZDX)
+ CALL READ_AND_SEND_MPI(ZDY0,ZDY)
+ !
+ DEALLOCATE(ZX0,ZY0,ZDX0,ZDY0)
+ !
+ENDIF
!---------------------------------------------------------------------------
!
!* 8. All this information stored into pointer PGRID_PAR
diff --git a/src/SURFEX/read_nam_grid_conf_proj.F90 b/src/SURFEX/read_nam_grid_conf_proj.F90
index 374c1f5752e198b86c09a903415a33cfdc49d3d1..f7e158ebaf45b75de6c565e21b27aaa017f2cbcd 100644
--- a/src/SURFEX/read_nam_grid_conf_proj.F90
+++ b/src/SURFEX/read_nam_grid_conf_proj.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ################################################################
- SUBROUTINE READ_NAM_GRID_CONF_PROJ(HPROGRAM,KGRID_PAR,KL,PGRID_PAR,GCP)
+ SUBROUTINE READ_NAM_GRID_CONF_PROJ(GCP,PGRID_FULL_PAR,KDIM_FULL,HPROGRAM,KGRID_PAR,KL,PGRID_PAR,HDIR)
! ################################################################
!
!!**** *READ_NAM_GRID_CONF_PROJ* - routine to read in namelist the horizontal grid
@@ -38,14 +38,18 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_GRID_CONF_PROJ_n, ONLY :GRID_CONF_PROJ_t
+!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NSIZE_TASK, NPIO
+!
USE MODE_POS_SURF
!
USE MODI_OPEN_NAMELIST
USE MODI_CLOSE_NAMELIST
USE MODI_GET_LUOUT
+USE MODI_READ_AND_SEND_MPI
!
USE MODE_GRIDTYPE_CONF_PROJ
-USE MODD_GRID_CONF_PROJ, ONLY :GRID_CONF_PROJ_t
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -54,12 +58,17 @@ IMPLICIT NONE
!
!* 0.1 Declarations of arguments
! -------------------------
+!
+TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
+REAL, DIMENSION(:), POINTER :: PGRID_FULL_PAR
+INTEGER, INTENT(IN) :: KDIM_FULL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
INTEGER, INTENT(INOUT) :: KGRID_PAR ! size of PGRID_PAR
INTEGER, INTENT(OUT) :: KL ! number of points
REAL, DIMENSION(KGRID_PAR), INTENT(OUT) :: PGRID_PAR ! parameters defining this grid
-TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+ CHARACTER(LEN=1), INTENT(IN) :: HDIR
!
!* 0.2 Declarations of local variables
! -------------------------------
@@ -69,10 +78,10 @@ INTEGER :: ILUNAM ! namelist file logical unit
INTEGER :: JI, JJ ! loop counters
INTEGER :: JL ! loop counter
-REAL, DIMENSION(:), ALLOCATABLE :: ZX ! X conformal coordinate of grid mesh
-REAL, DIMENSION(:), ALLOCATABLE :: ZY ! Y conformal coordinate of grid mesh
-REAL, DIMENSION(:), ALLOCATABLE :: ZDX ! X grid mesh size
-REAL, DIMENSION(:), ALLOCATABLE :: ZDY ! Y grid mesh size
+REAL, DIMENSION(:), ALLOCATABLE :: ZX, ZX0 ! X conformal coordinate of grid mesh
+REAL, DIMENSION(:), ALLOCATABLE :: ZY, ZY0 ! Y conformal coordinate of grid mesh
+REAL, DIMENSION(:), ALLOCATABLE :: ZDX, ZDX0 ! X grid mesh size
+REAL, DIMENSION(:), ALLOCATABLE :: ZDY, ZDY0 ! Y grid mesh size
REAL, DIMENSION(1) :: ZXOR ! X conformal coordinate of origine point
REAL, DIMENSION(1) :: ZYOR ! Y conformal coordinate of origin point
REAL, DIMENSION(1) :: ZLATOR ! latitude of origine point
@@ -112,76 +121,99 @@ NAMELIST/NAM_CONF_PROJ_GRID/NIMAX,NJMAX,XLATCEN,XLONCEN,XDX,XDY
IF (LHOOK) CALL DR_HOOK('READ_NAM_GRID_CONF_PROJ',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
- CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
-!
-!---------------------------------------------------------------------------
-!
-!* 2. Reading of projection parameters
-! --------------------------------
-!
- CALL POSNAM(ILUNAM,'NAM_CONF_PROJ',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CONF_PROJ)
-!
-!---------------------------------------------------------------------------
-!
-!* 2. Reading parameters of the grid
-! ------------------------------
-!
- CALL POSNAM(ILUNAM,'NAM_CONF_PROJ_GRID',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CONF_PROJ_GRID)
-!
-!---------------------------------------------------------------------------
- CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
-!---------------------------------------------------------------------------
-!
-!* 3. Number of points
-! ----------------
-!
-KL = NIMAX * NJMAX
-!
-!---------------------------------------------------------------------------
-!
-!* 3. Array of X and Y coordinates
-! ----------------------------
-!
-!
-ALLOCATE(ZX(KL))
-ALLOCATE(ZY(KL))
-DO JJ=1,NJMAX
- DO JI=1,NIMAX
- JL = JI + (JJ-1) * NIMAX
- ZX(JL) = FLOAT(JI) * XDX
- ZY(JL) = FLOAT(JJ) * XDY
+IF (HDIR/='H') THEN
+ !
+ CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 2. Reading of projection parameters
+ ! --------------------------------
+ !
+ CALL POSNAM(ILUNAM,'NAM_CONF_PROJ',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CONF_PROJ)
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 2. Reading parameters of the grid
+ ! ------------------------------
+ !
+ CALL POSNAM(ILUNAM,'NAM_CONF_PROJ_GRID',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CONF_PROJ_GRID)
+ !
+ !---------------------------------------------------------------------------
+ CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
+ !---------------------------------------------------------------------------
+ !
+ !* 3. Number of points
+ ! ----------------
+ !
+ KL = NIMAX * NJMAX
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 3. Array of X and Y coordinates
+ ! ----------------------------
+ !
+ !
+ ALLOCATE(ZX(KL))
+ ALLOCATE(ZY(KL))
+ DO JJ=1,NJMAX
+ DO JI=1,NIMAX
+ JL = JI + (JJ-1) * NIMAX
+ ZX(JL) = FLOAT(JI) * XDX
+ ZY(JL) = FLOAT(JJ) * XDY
+ END DO
END DO
-END DO
-!
-!---------------------------------------------------------------------------
-!
-!* 4. Array of X and Y increments
-! ---------------------------
-!
-ALLOCATE(ZDX(KL))
-ALLOCATE(ZDY(KL))
-ZDX(:) = XDX
-ZDY(:) = XDY
-!
-!---------------------------------------------------------------------------
-!
-!* 5. Latitude and longitude of point of coordinates 0,0
-! --------------------------------------------------
-!
-! Coordinates of origin point are here defined from center point, that
-! is then used as substitute reference point.
-! In all further computations, origin point will be of course be x=0, y=0
-!
-ZXOR = - FLOAT(NIMAX+1)/2.*XDX
-ZYOR = - FLOAT(NJMAX+1)/2.*XDY
-!
- CALL LATLON_CONF_PROJ(XLAT0,XLON0,XRPK,XBETA,XLATCEN,XLONCEN, &
- ZXOR,ZYOR,ZLATOR,ZLONOR )
-!
-GCP%XLATC=XLATCEN
-GCP%XLONC=XLONCEN
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 4. Array of X and Y increments
+ ! ---------------------------
+ !
+ ALLOCATE(ZDX(KL))
+ ALLOCATE(ZDY(KL))
+ ZDX(:) = XDX
+ ZDY(:) = XDY
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 5. Latitude and longitude of point of coordinates 0,0
+ ! --------------------------------------------------
+ !
+ ! Coordinates of origin point are here defined from center point, that
+ ! is then used as substitute reference point.
+ ! In all further computations, origin point will be of course be x=0, y=0
+ !
+ ZXOR = - FLOAT(NIMAX+1)/2.*XDX
+ ZYOR = - FLOAT(NJMAX+1)/2.*XDY
+ !
+ CALL LATLON_CONF_PROJ(XLAT0,XLON0,XRPK,XBETA,XLATCEN,XLONCEN, &
+ ZXOR,ZYOR,ZLATOR,ZLONOR )
+ !
+ GCP%XLATC=XLATCEN
+ GCP%XLONC=XLONCEN
+ !
+ELSE
+ !
+ !
+ ALLOCATE(ZX0(KDIM_FULL),ZY0(KDIM_FULL),ZDX0(KDIM_FULL),ZDY0(KDIM_FULL))
+ CALL GET_GRIDTYPE_CONF_PROJ(PGRID_FULL_PAR,PLAT0=XLAT0,PLON0=XLON0,&
+ PRPK=XRPK,PBETA=XBETA,PLATOR=ZLATOR(1),&
+ PLONOR=ZLONOR(1),KIMAX=NIMAX,KJMAX=NJMAX,&
+ PX=ZX0,PY=ZY0,PDX=ZDX0,PDY=ZDY0)
+ !
+ KL = NSIZE_TASK(NRANK)
+ ALLOCATE(ZX(KL),ZY(KL),ZDX(KL),ZDY(KL))
+ !
+ CALL READ_AND_SEND_MPI(ZX0,ZX)
+ CALL READ_AND_SEND_MPI(ZY0,ZY)
+ CALL READ_AND_SEND_MPI(ZDX0,ZDX)
+ CALL READ_AND_SEND_MPI(ZDY0,ZDY)
+ !
+ IF (NRANK==NPIO) DEALLOCATE(ZX0,ZY0,ZDX0,ZDY0)
+ !
+ENDIF
!---------------------------------------------------------------------------
!
!* 8. All this information stored into pointer PGRID_PAR
diff --git a/src/SURFEX/read_nam_grid_gauss.F90 b/src/SURFEX/read_nam_grid_gauss.F90
index da3fd7d2d50b88a2593b09baa228aac7f8ae3c95..ad778ec8a7e29fc434483104e0c9c09499501ad8 100644
--- a/src/SURFEX/read_nam_grid_gauss.F90
+++ b/src/SURFEX/read_nam_grid_gauss.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!################################################################
-SUBROUTINE READ_NAM_GRID_GAUSS(HPROGRAM,KGRID_PAR,KL,PGRID_PAR)
+SUBROUTINE READ_NAM_GRID_GAUSS(PGRID_FULL_PAR,KDIM_FULL,HPROGRAM,KGRID_PAR,KL,PGRID_PAR,HDIR)
!################################################################
!
!!**** *READ_NAM_GRID_GAUSS* - routine to read in namelist the horizontal grid
@@ -40,6 +40,8 @@ SUBROUTINE READ_NAM_GRID_GAUSS(HPROGRAM,KGRID_PAR,KL,PGRID_PAR)
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NSIZE_TASK
+!
USE MODD_CSTS, ONLY : XPI
USE MODD_SURF_PAR, ONLY : XUNDEF
!
@@ -53,6 +55,7 @@ USE MODE_GRIDTYPE_GAUSS
!
USE EGGANGLES , ONLY : P_ASIN
!
+USE MODI_READ_AND_SEND_MPI
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -64,26 +67,30 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
+REAL, DIMENSION(:), POINTER :: PGRID_FULL_PAR
+INTEGER, INTENT(IN) :: KDIM_FULL
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
INTEGER, INTENT(INOUT) :: KGRID_PAR ! size of PGRID_PAR
INTEGER, INTENT(OUT) :: KL ! number of points
REAL, DIMENSION(KGRID_PAR), INTENT(OUT) :: PGRID_PAR ! parameters defining this grid
+ CHARACTER(LEN=1), INTENT(IN) :: HDIR
!
!* 0.2 Declarations of local variables
! -------------------------------
!
INTEGER :: ILUOUT ! output listing logical unit
INTEGER :: ILUNAM ! namelist file logical unit
-REAL, DIMENSION(:), ALLOCATABLE :: ZLAT_XY ! pseudo-latitudes
-REAL, DIMENSION(:), ALLOCATABLE :: ZLON_XY ! pseudo-longitudes
-REAL, DIMENSION(:), ALLOCATABLE :: ZLAT ! latitudes
-REAL, DIMENSION(:), ALLOCATABLE :: ZLON ! longitudes
-REAL, DIMENSION(:), ALLOCATABLE :: ZMESH_SIZE ! Mesh size
+REAL, DIMENSION(:), ALLOCATABLE :: ZLAT_XY, ZLAT_XY0 ! pseudo-latitudes
+REAL, DIMENSION(:), ALLOCATABLE :: ZLON_XY, ZLON_XY0 ! pseudo-longitudes
+REAL, DIMENSION(:), ALLOCATABLE :: ZLAT, ZLAT0 ! latitudes
+REAL, DIMENSION(:), ALLOCATABLE :: ZLON, ZLON0 ! longitudes
+REAL, DIMENSION(:), ALLOCATABLE :: ZMESH_SIZE, ZMESH_SIZE0 ! Mesh size
! _____ Sup
-REAL, DIMENSION(:), ALLOCATABLE :: ZLATSUP ! Grid corner Latitude | |
-REAL, DIMENSION(:), ALLOCATABLE :: ZLONSUP ! Grid corner Longitude | |
-REAL, DIMENSION(:), ALLOCATABLE :: ZLATINF ! Grid corner Latitude |_____|
-REAL, DIMENSION(:), ALLOCATABLE :: ZLONINF ! Grid corner Longitude Inf
+REAL, DIMENSION(:), ALLOCATABLE :: ZLATSUP, ZLATSUP0 ! Grid corner Latitude | |
+REAL, DIMENSION(:), ALLOCATABLE :: ZLONSUP, ZLONSUP0 ! Grid corner Longitude | |
+REAL, DIMENSION(:), ALLOCATABLE :: ZLATINF, ZLATINF0 ! Grid corner Latitude |_____|
+REAL, DIMENSION(:), ALLOCATABLE :: ZLONINF, ZLONINF0 ! Grid corner Longitude Inf
!
REAL, DIMENSION(:), ALLOCATABLE :: ZXINF ! pseudo-longitude western limit of grid mesh
REAL, DIMENSION(:), ALLOCATABLE :: ZXSUP ! pseudo-longitude eastern limit of grid mesh
@@ -139,137 +146,182 @@ NRGRI(:) = 0
!
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
- CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
-!
-!---------------------------------------------------------------------------
-!
-!* 3. Reading of projection parameters
-! --------------------------------
-!
- CALL POSNAM(ILUNAM,'NAMGEM',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUNAM,NML=NAMGEM)
-!
-IF (RSTRET<1.) THEN
- WRITE(ILUOUT,*) '****************************************************'
- WRITE(ILUOUT,*) 'stretching factor RSTRET for the Gaussian grid'
- WRITE(ILUOUT,*) 'definition must be greater than or equal to 1'
- WRITE(ILUOUT,*) 'You have set RSTRET=', RSTRET
- WRITE(ILUOUT,*) 'Please modify the value of RSTRET in namelist NAMGEM'
- WRITE(ILUOUT,*) '****************************************************'
- CALL ABOR1_SFX('READ_NAM_GRID_GAUSS: STRETCHING FACTOR MUST BE >= 1.')
-END IF
-!
-ZLAPO = 180. / XPI * P_ASIN(RMUCEN)
-ZLOPO = 180. / XPI * RLOCEN
-!
-ZCODIL = RSTRET
-!
-!---------------------------------------------------------------------------
-!
-!* 4. Reading parameters of the grid
-! ------------------------------
-!
- CALL POSNAM(ILUNAM,'NAMDIM',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUNAM,NML=NAMDIM)
- CALL POSNAM(ILUNAM,'NAMRGRI',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUNAM,NML=NAMRGRI)
-!
-INLATI = NDGLG
-ALLOCATE(INLOPA(INLATI))
-INLOPA(1:INLATI/2) = NRGRI(1:INLATI/2)
-INLOPA(INLATI/2+1:INLATI) = NRGRI(INLATI/2:1:-1)
-!
-!---------------------------------------------------------------------------
- CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
-!---------------------------------------------------------------------------
-!
-!* 5. Computes pseudo-latitudes and pseudo-longitudes of all points
-! -------------------------------------------------------------
-!
-!* number of points
-KL = SUM(INLOPA)
-
-!
-!* type of transform
-IF (ZLAPO>89.99 .AND. ABS(ZLOPO)<0.00001) THEN
- ITYP=0
-ELSE
- ITYP=1
-ENDIF
-!
-ALLOCATE(ZLAT_XY(KL))
-ALLOCATE(ZLON_XY(KL))
-ZLAT_XY(:) = XUNDEF
-ZLON_XY(:) = XUNDEF
-!
- CALL COMP_GRIDTYPE_GAUSS(INLATI,INLOPA,KL,ITYP,ZLAT_XY,ZLON_XY)
-!
-!---------------------------------------------------------------------------
-!
-!* 6. Computes latitudes and longitudes
-! ---------------------------------
-!
-!* all points are used
-ALLOCATE(ZLAT(KL))
-ALLOCATE(ZLON(KL))
-!
-ZLAT(:) = XUNDEF
-ZLON(:) = XUNDEF
+IF (HDIR/='H') THEN
+ !
+ CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 3. Reading of projection parameters
+ ! --------------------------------
+ !
+ CALL POSNAM(ILUNAM,'NAMGEM',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUNAM,NML=NAMGEM)
+ !
+ IF (RSTRET<1.) THEN
+ WRITE(ILUOUT,*) '****************************************************'
+ WRITE(ILUOUT,*) 'stretching factor RSTRET for the Gaussian grid'
+ WRITE(ILUOUT,*) 'definition must be greater than or equal to 1'
+ WRITE(ILUOUT,*) 'You have set RSTRET=', RSTRET
+ WRITE(ILUOUT,*) 'Please modify the value of RSTRET in namelist NAMGEM'
+ WRITE(ILUOUT,*) '****************************************************'
+ CALL ABOR1_SFX('READ_NAM_GRID_GAUSS: STRETCHING FACTOR MUST BE >= 1.')
+ END IF
+ !
+ ZLAPO = 180. / XPI * P_ASIN(RMUCEN)
+ ZLOPO = 180. / XPI * RLOCEN
+ !
+ ZCODIL = RSTRET
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 4. Reading parameters of the grid
+ ! ------------------------------
+ !
+ CALL POSNAM(ILUNAM,'NAMDIM',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUNAM,NML=NAMDIM)
+ CALL POSNAM(ILUNAM,'NAMRGRI',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUNAM,NML=NAMRGRI)
+ !
+ INLATI = NDGLG
+ ALLOCATE(INLOPA(INLATI))
+ INLOPA(1:INLATI/2) = NRGRI(1:INLATI/2)
+ INLOPA(INLATI/2+1:INLATI) = NRGRI(INLATI/2:1:-1)
+ !
+ !---------------------------------------------------------------------------
+ CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
+ !---------------------------------------------------------------------------
+ !
+ !* 5. Computes pseudo-latitudes and pseudo-longitudes of all points
+ ! -------------------------------------------------------------
+ !
+ !* number of points
+ KL = SUM(INLOPA)
+ !
+ !
+ !* type of transform
+ IF (ZLAPO>89.99 .AND. ABS(ZLOPO)<0.00001) THEN
+ ITYP=0
+ ELSE
+ ITYP=1
+ ENDIF
+ !
+ ALLOCATE(ZLAT_XY(KL))
+ ALLOCATE(ZLON_XY(KL))
+ ZLAT_XY(:) = XUNDEF
+ ZLON_XY(:) = XUNDEF
+ !
+ CALL COMP_GRIDTYPE_GAUSS(INLATI,INLOPA,KL,ITYP,ZLAT_XY,ZLON_XY)
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 6. Computes latitudes and longitudes
+ ! ---------------------------------
+ !
+ !* all points are used
+ ALLOCATE(ZLAT(KL))
+ ALLOCATE(ZLON(KL))
+ !
+ ZLAT(:) = XUNDEF
+ ZLON(:) = XUNDEF
+ !
+ IF(ZCODIL==1.0.AND.ITYP==0)THEN
+ ZLON(:)=ZLON_XY(:)
+ ZLAT(:)=ZLAT_XY(:)
+ ELSE
+ CALL LATLON_GAUSS(ZLON_XY,ZLAT_XY,KL,ZLOPO,ZLAPO,ZCODIL,ZLON,ZLAT)
+ ENDIF
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 7. Computes grid corner latitudes and longitudes
+ ! ---------------------------------------------
+ !
+ ALLOCATE(ZXINF(KL))
+ ALLOCATE(ZYINF(KL))
+ ALLOCATE(ZXSUP(KL))
+ ALLOCATE(ZYSUP(KL))
+ !
+ ALLOCATE(ZLONINF(KL))
+ ALLOCATE(ZLATINF(KL))
+ ALLOCATE(ZLONSUP(KL))
+ ALLOCATE(ZLATSUP(KL))
+ !
+ ZXINF (:) = XUNDEF
+ ZYINF (:) = XUNDEF
+ ZXSUP (:) = XUNDEF
+ ZYSUP (:) = XUNDEF
+ ZLONINF(:) = XUNDEF
+ ZLATINF(:) = XUNDEF
+ ZLONSUP(:) = XUNDEF
+ ZLATSUP(:) = XUNDEF
+ !
+ CALL GAUSS_GRID_LIMITS(INLATI,INLOPA,ZXINF,ZXSUP,ZYINF,ZYSUP)
+ !
+ IF(ZCODIL==1.0.AND.ITYP==0)THEN
+ ZLONINF(:) = ZXINF(:)
+ ZLATINF(:) = ZYINF(:)
+ ZLONSUP(:) = ZXSUP(:)
+ ZLATSUP(:) = ZYSUP(:)
+ ELSE
+ CALL LATLON_GAUSS(ZXINF,ZYINF,KL,ZLOPO,ZLAPO,ZCODIL,ZLONINF,ZLATINF)
+ CALL LATLON_GAUSS(ZXSUP,ZYSUP,KL,ZLOPO,ZLAPO,ZCODIL,ZLONSUP,ZLATSUP)
+ ENDIF
+ !
+ DEALLOCATE(ZXINF)
+ DEALLOCATE(ZYINF)
+ DEALLOCATE(ZXSUP)
+ DEALLOCATE(ZYSUP)
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 8. Computes mesh size
+ ! ---------------------------------
+ !
+ ALLOCATE(ZMESH_SIZE(KL))
+ ZMESH_SIZE(:) = XUNDEF
+ !
+ CALL MESH_SIZE_GAUSS(KL,INLATI,INLOPA,ZLAPO,ZLOPO,ZCODIL,&
+ ZLAT_XY,ZLON,ZLAT,ZMESH_SIZE)
!
-IF(ZCODIL==1.0.AND.ITYP==0)THEN
- ZLON(:)=ZLON_XY(:)
- ZLAT(:)=ZLAT_XY(:)
ELSE
- CALL LATLON_GAUSS(ZLON_XY,ZLAT_XY,KL,ZLOPO,ZLAPO,ZCODIL,ZLON,ZLAT)
+ !
+ ALLOCATE(ZLON0(KDIM_FULL),ZLAT0(KDIM_FULL),ZLON_XY0(KDIM_FULL),ZLAT_XY0(KDIM_FULL),&
+ ZMESH_SIZE0(KDIM_FULL),ZLONINF0(KDIM_FULL),ZLATINF0(KDIM_FULL),&
+ ZLONSUP0(KDIM_FULL),ZLATSUP0(KDIM_FULL))
+ !
+ CALL GET_GRIDTYPE_GAUSS(PGRID_FULL_PAR,INLATI)
+ !
+ ALLOCATE(INLOPA(INLATI))
+ !
+ CALL GET_GRIDTYPE_GAUSS(PGRID_FULL_PAR,KNLATI=INLATI,PLAPO=ZLAPO,&
+ PLOPO=ZLOPO,PCODIL=ZCODIL,KNLOPA=INLOPA, &
+ PLAT=ZLAT0,PLON=ZLON0,PLAT_XY=ZLAT_XY0,&
+ PLON_XY=ZLON_XY0,PMESH_SIZE=ZMESH_SIZE0,&
+ PLONINF=ZLONINF0,PLATINF=ZLATINF0,&
+ PLONSUP=ZLONSUP0,PLATSUP=ZLATSUP0)
+ !
+ KL = NSIZE_TASK(NRANK)
+ ALLOCATE(ZLAT(KL),ZLON(KL),ZLAT_XY(KL),ZLON_XY(KL),ZMESH_SIZE(KL))
+ ALLOCATE(ZLONINF(KL))
+ ALLOCATE(ZLATINF(KL))
+ ALLOCATE(ZLONSUP(KL))
+ ALLOCATE(ZLATSUP(KL))
+ !
+ CALL READ_AND_SEND_MPI(ZLON0,ZLON)
+ CALL READ_AND_SEND_MPI(ZLAT0,ZLAT)
+ CALL READ_AND_SEND_MPI(ZLON_XY0,ZLON_XY)
+ CALL READ_AND_SEND_MPI(ZLAT_XY0,ZLAT_XY)
+ CALL READ_AND_SEND_MPI(ZMESH_SIZE0,ZMESH_SIZE)
+ CALL READ_AND_SEND_MPI(ZLONINF0,ZLONINF)
+ CALL READ_AND_SEND_MPI(ZLATINF0,ZLATINF)
+ CALL READ_AND_SEND_MPI(ZLONSUP0,ZLONSUP)
+ CALL READ_AND_SEND_MPI(ZLATSUP0,ZLATSUP)
+ !
+ DEALLOCATE(ZLON0,ZLAT0,ZLON_XY0,ZLAT_XY0,ZMESH_SIZE0,ZLONINF0,ZLATINF0,&
+ ZLONSUP0,ZLATSUP0)
+ !
ENDIF
-!
-!---------------------------------------------------------------------------
-!
-!* 7. Computes grid corner latitudes and longitudes
-! ---------------------------------------------
-!
-ALLOCATE(ZXINF(KL))
-ALLOCATE(ZYINF(KL))
-ALLOCATE(ZXSUP(KL))
-ALLOCATE(ZYSUP(KL))
-!
-ALLOCATE(ZLONINF(KL))
-ALLOCATE(ZLATINF(KL))
-ALLOCATE(ZLONSUP(KL))
-ALLOCATE(ZLATSUP(KL))
-!
-ZXINF (:) = XUNDEF
-ZYINF (:) = XUNDEF
-ZXSUP (:) = XUNDEF
-ZYSUP (:) = XUNDEF
-ZLONINF(:) = XUNDEF
-ZLATINF(:) = XUNDEF
-ZLONSUP(:) = XUNDEF
-ZLATSUP(:) = XUNDEF
-!
- CALL GAUSS_GRID_LIMITS(INLATI,INLOPA,ZXINF,ZXSUP,ZYINF,ZYSUP)
-!
-IF(ZCODIL==1.0.AND.ITYP==0)THEN
- ZLONINF(:) = ZXINF(:)
- ZLATINF(:) = ZYINF(:)
- ZLONSUP(:) = ZXSUP(:)
- ZLATSUP(:) = ZYSUP(:)
-ELSE
- CALL LATLON_GAUSS(ZXINF,ZYINF,KL,ZLOPO,ZLAPO,ZCODIL,ZLONINF,ZLATINF)
- CALL LATLON_GAUSS(ZXSUP,ZYSUP,KL,ZLOPO,ZLAPO,ZCODIL,ZLONSUP,ZLATSUP)
-ENDIF
-!
-!---------------------------------------------------------------------------
-!
-!* 8. Computes mesh size
-! ---------------------------------
-!
-ALLOCATE(ZMESH_SIZE(KL))
-ZMESH_SIZE(:) = XUNDEF
-!
- CALL MESH_SIZE_GAUSS(KL,INLATI,INLOPA,ZLAPO,ZLOPO,ZCODIL,&
- ZLAT_XY,ZLON,ZLAT,ZMESH_SIZE)
-!
!---------------------------------------------------------------------------
!
!* 9. All this information stored into pointer PGRID_PAR
@@ -294,10 +346,6 @@ DEALLOCATE(ZLATINF)
DEALLOCATE(ZLONINF)
DEALLOCATE(ZLATSUP)
DEALLOCATE(ZLONSUP)
-DEALLOCATE(ZXINF)
-DEALLOCATE(ZYINF)
-DEALLOCATE(ZXSUP)
-DEALLOCATE(ZYSUP)
!
!---------------------------------------------------------------------------
!
diff --git a/src/SURFEX/read_nam_grid_ign.F90 b/src/SURFEX/read_nam_grid_ign.F90
index 4a7781367133bf452425a09482e5e07eb0849bdc..ae96b0429ee0474e4c1bd462b2fe43ece02b6b8b 100644
--- a/src/SURFEX/read_nam_grid_ign.F90
+++ b/src/SURFEX/read_nam_grid_ign.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ################################################################
- SUBROUTINE READ_NAM_GRID_IGN(HPROGRAM,KGRID_PAR,KL,PGRID_PAR)
+ SUBROUTINE READ_NAM_GRID_IGN(PGRID_FULL_PAR,KDIM_FULL,HPROGRAM,KGRID_PAR,KL,PGRID_PAR,HDIR)
! ################################################################
!
!!**** *READ_NAM_GRID_IGN* - routine to read in namelist the horizontal grid
@@ -38,6 +38,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NSIZE_TASK
+!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE MODE_POS_SURF
@@ -50,6 +52,8 @@ USE MODI_TEST_NAM_VAR_SURF
USE MODE_GRIDTYPE_IGN
USE MODI_GET_XYALL_IGN
!
+USE MODI_READ_AND_SEND_MPI
+!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -57,11 +61,15 @@ IMPLICIT NONE
!
!* 0.1 Declarations of arguments
! -------------------------
+!
+REAL, DIMENSION(:), POINTER :: PGRID_FULL_PAR
+INTEGER, INTENT(IN) :: KDIM_FULL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
INTEGER, INTENT(INOUT) :: KGRID_PAR ! size of PGRID_PAR
INTEGER, INTENT(OUT) :: KL ! number of points
REAL, DIMENSION(KGRID_PAR), INTENT(OUT) :: PGRID_PAR ! parameters defining this grid
+ CHARACTER(LEN=1), INTENT(IN) :: HDIR
!
!* 0.2 Declarations of local variables
! -------------------------------
@@ -70,10 +78,10 @@ INTEGER :: ILUOUT ! output listing logical unit
INTEGER :: ILUNAM ! namelist file logical unit
INTEGER :: ILAMBERT ! Lambert type
-REAL, DIMENSION(:), ALLOCATABLE :: ZX ! X conformal coordinate of grid mesh
-REAL, DIMENSION(:), ALLOCATABLE :: ZY ! Y conformal coordinate of grid mesh
-REAL, DIMENSION(:), ALLOCATABLE :: ZDX ! X grid mesh size
-REAL, DIMENSION(:), ALLOCATABLE :: ZDY ! Y grid mesh size
+REAL, DIMENSION(:), ALLOCATABLE :: ZX, ZX0 ! X conformal coordinate of grid mesh
+REAL, DIMENSION(:), ALLOCATABLE :: ZY, ZY0 ! Y conformal coordinate of grid mesh
+REAL, DIMENSION(:), ALLOCATABLE :: ZDX, ZDX0 ! X grid mesh size
+REAL, DIMENSION(:), ALLOCATABLE :: ZDY, ZDY0 ! Y grid mesh size
!
!* 0.3 Declarations of namelist
! ------------------------
@@ -113,122 +121,149 @@ NAMELIST/NAM_IGN/CLAMBERT,NPOINTS,XX,XY,XDX,XDY, &
IF (LHOOK) CALL DR_HOOK('READ_NAM_GRID_IGN',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
- CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
-!
-XX_LLCORNER = XUNDEF
-XY_LLCORNER = XUNDEF
-XCELLSIZE = XUNDEF
-NCOLS = 0
-NROWS = 0
-!
-!---------------------------------------------------------------------------
-!
-!* 2. Reading of projection parameters
-! --------------------------------
-!
- CALL POSNAM(ILUNAM,'NAM_IGN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_IGN)
-!
-!---------------------------------------------------------------------------
- CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
-!---------------------------------------------------------------------------
-!
-!* 3. Initialisation for a regular grid
-! ---------------------------------
-!
-IF (XCELLSIZE/=XUNDEF) THEN
+IF (HDIR/='H') THEN
+ !
+ CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
+ !
+ XX_LLCORNER = XUNDEF
+ XY_LLCORNER = XUNDEF
+ XCELLSIZE = XUNDEF
+ NCOLS = 0
+ NROWS = 0
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 2. Reading of projection parameters
+ ! --------------------------------
+ !
+ CALL POSNAM(ILUNAM,'NAM_IGN',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_IGN)
+ !
+ !---------------------------------------------------------------------------
+ CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
+ !---------------------------------------------------------------------------
!
- WRITE(ILUOUT,*) 'Initialisation of IGN Coordinates for a regular grid'
- !
- XDX(:) = XCELLSIZE
- XDY(:) = XCELLSIZE
+ !* 3. Initialisation for a regular grid
+ ! ---------------------------------
!
- IF ( XX_LLCORNER/=XUNDEF .AND. XY_LLCORNER/=XUNDEF &
- .AND. NCOLS>0 .AND. NROWS>0 ) THEN
+ IF (XCELLSIZE/=XUNDEF) THEN
!
- NPOINTS = NCOLS * NROWS
+ WRITE(ILUOUT,*) 'Initialisation of IGN Coordinates for a regular grid'
+ !
+ XDX(:) = XCELLSIZE
+ XDY(:) = XCELLSIZE
!
- DO JROWS=1,NROWS
- DO JCOLS=1,NCOLS
- !
- IINDEX = JCOLS + (JROWS-1) * NCOLS
- XX(IINDEX) = XX_LLCORNER + (JCOLS-0.5) * XCELLSIZE
- XY(IINDEX) = XY_LLCORNER + (JROWS-0.5) * XCELLSIZE
- !
+ IF ( XX_LLCORNER/=XUNDEF .AND. XY_LLCORNER/=XUNDEF &
+ .AND. NCOLS>0 .AND. NROWS>0 ) THEN
+ !
+ NPOINTS = NCOLS * NROWS
+ !
+ DO JROWS=1,NROWS
+ DO JCOLS=1,NCOLS
+ !
+ IINDEX = JCOLS + (JROWS-1) * NCOLS
+ XX(IINDEX) = XX_LLCORNER + (JCOLS-0.5) * XCELLSIZE
+ XY(IINDEX) = XY_LLCORNER + (JROWS-0.5) * XCELLSIZE
+ !
+ END DO
END DO
- END DO
+ !
+ ENDIF
!
- ENDIF
+ END IF
!
-END IF
-!
-!---------------------------------------------------------------------------
-!
-!* 3. Number of points
-! ----------------
-!
-KL = NPOINTS
-!
-!---------------------------------------------------------------------------
-!
-!* 3. Array of X and Y coordinates
-! ----------------------------
-!
-!
-ALLOCATE(ZX(KL))
-ALLOCATE(ZY(KL))
-ZX(:) = XX(:KL)
-ZY(:) = XY(:KL)
-!
-!---------------------------------------------------------------------------
-!
-!* 4. Array of X and Y increments
-! ---------------------------
-!
-ALLOCATE(ZDX(KL))
-ALLOCATE(ZDY(KL))
-ZDX(:) = XDX(:KL)
-ZDY(:) = XDY(:KL)
-!
-!---------------------------------------------------------------------------
-!
-!* 5. Lambert type
-! ------------
-!
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CLAMBERT',CLAMBERT,'L1 ','L2 ','L3 ',&
+ !---------------------------------------------------------------------------
+ !
+ !* 3. Number of points
+ ! ----------------
+ !
+ KL = NPOINTS
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 3. Array of X and Y coordinates
+ ! ----------------------------
+ !
+ !
+ ALLOCATE(ZX(KL))
+ ALLOCATE(ZY(KL))
+ ZX(:) = XX(:KL)
+ ZY(:) = XY(:KL)
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 4. Array of X and Y increments
+ ! ---------------------------
+ !
+ ALLOCATE(ZDX(KL))
+ ALLOCATE(ZDY(KL))
+ ZDX(:) = XDX(:KL)
+ ZDY(:) = XDY(:KL)
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 5. Lambert type
+ ! ------------
+ !
+ CALL TEST_NAM_VAR_SURF(ILUOUT,'CLAMBERT',CLAMBERT,'L1 ','L2 ','L3 ',&
'L4 ','L2E','L93' )
-!
-SELECT CASE (CLAMBERT)
- CASE ('L1 ')
- ILAMBERT=1
- CASE ('L2 ')
- ILAMBERT=2
- CASE ('L3 ')
- ILAMBERT=3
- CASE ('L4 ')
- ILAMBERT=4
- CASE ('L2E')
- ILAMBERT=5
- CASE ('L93')
- ILAMBERT=6
-END SELECT
-!
-!---------------------------------------------------------------------------
-!
-!* 7. maximum domain lengths
-! ----------------------
-!
-ALLOCATE(ZXALL(KL*3))
-ALLOCATE(ZYALL(KL*3))
- CALL GET_XYALL_IGN(ZX,ZY,ZDX,ZDY,ZXALL,ZYALL,IDIMX,IDIMY)
-!
-!---------------------------------------------------------------------------
-!
-!* 8. All this information stored into pointer PGRID_PAR
-! --------------------------------------------------
-!
- CALL PUT_GRIDTYPE_IGN(ZGRID_PAR,ILAMBERT,ZX,ZY,ZDX,ZDY, &
+ !
+ SELECT CASE (CLAMBERT)
+ CASE ('L1 ')
+ ILAMBERT=1
+ CASE ('L2 ')
+ ILAMBERT=2
+ CASE ('L3 ')
+ ILAMBERT=3
+ CASE ('L4 ')
+ ILAMBERT=4
+ CASE ('L2E')
+ ILAMBERT=5
+ CASE ('L93')
+ ILAMBERT=6
+ END SELECT
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 7. maximum domain lengths
+ ! ----------------------
+ !
+ ALLOCATE(ZXALL(KL*3))
+ ALLOCATE(ZYALL(KL*3))
+ CALL GET_XYALL_IGN(ZX,ZY,ZDX,ZDY,ZXALL,ZYALL,IDIMX,IDIMY)
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 8. All this information stored into pointer PGRID_PAR
+ ! --------------------------------------------------
+ !
+ CALL PUT_GRIDTYPE_IGN(ZGRID_PAR,ILAMBERT,ZX,ZY,ZDX,ZDY, &
IDIMX,IDIMY,ZXALL(1:IDIMX),ZYALL(1:IDIMY))
+ !
+ELSE
+ !
+ ALLOCATE(ZX0(KDIM_FULL),ZY0(KDIM_FULL),ZDX0(KDIM_FULL),ZDY0(KDIM_FULL))
+ !
+ CALL GET_GRIDTYPE_IGN(PGRID_FULL_PAR,KLAMBERT=ILAMBERT,&
+ PX=ZX0,PY=ZY0,PDX=ZDX0,PDY=ZDY0)
+ !
+ KL = NSIZE_TASK(NRANK)
+ ALLOCATE(ZX(KL),ZY(KL),ZDX(KL),ZDY(KL))
+ ALLOCATE(ZXALL(KL*3),ZYALL(KL*3))
+ IDIMX=0
+ IDIMY=0
+ !
+ CALL READ_AND_SEND_MPI(ZX0,ZX)
+ CALL READ_AND_SEND_MPI(ZY0,ZY)
+ CALL READ_AND_SEND_MPI(ZDX0,ZDX)
+ CALL READ_AND_SEND_MPI(ZDY0,ZDY)
+ !
+ DEALLOCATE(ZX0,ZY0,ZDX0,ZDY0)
+ !
+ CALL PUT_GRIDTYPE_IGN(ZGRID_PAR,ILAMBERT,ZX,ZY,ZDX,ZDY, &
+ IDIMX,IDIMY,ZXALL,ZYALL)
+ !
+ENDIF
!
!---------------------------------------------------------------------------
DEALLOCATE(ZX)
diff --git a/src/SURFEX/read_nam_grid_lonlat_reg.F90 b/src/SURFEX/read_nam_grid_lonlat_reg.F90
index 8993101becd037a53c340aab42f610ab7f3fd81a..5eebeca8ca68d2211cdbf2a6fa71770b75ceb9b8 100644
--- a/src/SURFEX/read_nam_grid_lonlat_reg.F90
+++ b/src/SURFEX/read_nam_grid_lonlat_reg.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ################################################################
- SUBROUTINE READ_NAM_GRID_LONLAT_REG(HPROGRAM,KGRID_PAR,KL,PGRID_PAR)
+ SUBROUTINE READ_NAM_GRID_LONLAT_REG(PGRID_FULL_PAR,KDIM_FULL,HPROGRAM,KGRID_PAR,KL,PGRID_PAR,HDIR)
! ################################################################
!
!!**** *READ_NAM_GRID_LONLAT_REG* - routine to read in namelist the horizontal grid
@@ -37,6 +37,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NSIZE_TASK
+!
USE MODE_POS_SURF
!
USE MODI_OPEN_NAMELIST
@@ -44,7 +46,7 @@ USE MODI_CLOSE_NAMELIST
USE MODI_GET_LUOUT
!
USE MODE_GRIDTYPE_LONLAT_REG
-!
+USE MODI_READ_AND_SEND_MPI
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -53,11 +55,15 @@ IMPLICIT NONE
!
!* 0.1 Declarations of arguments
! -------------------------
+!
+REAL, DIMENSION(:), POINTER :: PGRID_FULL_PAR
+INTEGER, INTENT(IN) :: KDIM_FULL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
INTEGER, INTENT(INOUT) :: KGRID_PAR ! size of PGRID_PAR
INTEGER, INTENT(OUT) :: KL ! number of points
REAL, DIMENSION(KGRID_PAR), INTENT(OUT) :: PGRID_PAR ! parameters defining this grid
+ CHARACTER(LEN=1), INTENT(IN) :: HDIR
!
!* 0.2 Declarations of local variables
! -------------------------------
@@ -65,8 +71,8 @@ REAL, DIMENSION(KGRID_PAR), INTENT(OUT) :: PGRID_PAR ! parameters defining th
INTEGER :: ILUOUT ! output listing logical unit
INTEGER :: ILUNAM ! namelist file logical unit
!
-REAL, DIMENSION(:), ALLOCATABLE :: ZLAT ! latitude of all points
-REAL, DIMENSION(:), ALLOCATABLE :: ZLON ! longitude of all points
+REAL, DIMENSION(:), ALLOCATABLE :: ZLAT, ZLAT0 ! latitude of all points
+REAL, DIMENSION(:), ALLOCATABLE :: ZLON, ZLON0 ! longitude of all points
!
REAL, DIMENSION(:), POINTER :: ZGRID_PAR
!
@@ -92,35 +98,55 @@ NAMELIST/NAM_LONLAT_REG/XLONMIN, XLONMAX, XLATMIN, XLATMAX, NLON, NLAT
IF (LHOOK) CALL DR_HOOK('READ_NAM_GRID_LONLAT_REG',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
- CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
-!
-!---------------------------------------------------------------------------
-!
-!* 2. Reading of projection parameters
-! --------------------------------
-!
- CALL POSNAM(ILUNAM,'NAM_LONLAT_REG',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_LONLAT_REG)
-!
-!---------------------------------------------------------------------------
-!
-!* 3. Number of points
-! ----------------
-!
-KL = NLON * NLAT
-!
-!---------------------------------------------------------------------------
- CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
-!---------------------------------------------------------------------------
-!
-!* 4. All this information stored into pointer PGRID_PAR
-! --------------------------------------------------
-!
-ALLOCATE(ZLAT(KL))
-ALLOCATE(ZLON(KL))
-!
- CALL LATLON_LONLAT_REG(XLONMIN,XLONMAX,XLATMIN,XLATMAX,&
+IF (HDIR/='H') THEN
+ !
+ CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 2. Reading of projection parameters
+ ! --------------------------------
+ !
+ CALL POSNAM(ILUNAM,'NAM_LONLAT_REG',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_LONLAT_REG)
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 3. Number of points
+ ! ----------------
+ !
+ KL = NLON * NLAT
+ !
+ !---------------------------------------------------------------------------
+ CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
+ !---------------------------------------------------------------------------
+ !
+ !* 4. All this information stored into pointer PGRID_PAR
+ ! --------------------------------------------------
+ !
+ ALLOCATE(ZLAT(KL))
+ ALLOCATE(ZLON(KL))
+ !
+ CALL LATLON_LONLAT_REG(XLONMIN,XLONMAX,XLATMIN,XLATMAX,&
NLON,NLAT,ZLON,ZLAT )
+ !
+ELSE
+ !
+ ALLOCATE(ZLON0(KDIM_FULL),ZLAT0(KDIM_FULL))
+ !
+ CALL GET_GRIDTYPE_LONLAT_REG(PGRID_FULL_PAR,PLONMIN=XLONMIN,PLONMAX=XLONMAX,&
+ PLATMIN=XLATMIN,PLATMAX=XLATMAX,KLON=NLON,&
+ KLAT=NLAT,PLON=ZLON0,PLAT=ZLAT0)
+ !
+ KL = NSIZE_TASK(NRANK)
+ ALLOCATE(ZLON(KL),ZLAT(KL))
+ !
+ CALL READ_AND_SEND_MPI(ZLON0,ZLON)
+ CALL READ_AND_SEND_MPI(ZLAT0,ZLAT)
+ !
+ DEALLOCATE(ZLON0,ZLAT0)
+ !
+ENDIF
!
CALL PUT_GRIDTYPE_LONLAT_REG(ZGRID_PAR,XLONMIN,XLONMAX,XLATMIN,XLATMAX, &
NLON,NLAT,KL,ZLON,ZLAT )
diff --git a/src/SURFEX/read_nam_grid_lonlat_rot.F90 b/src/SURFEX/read_nam_grid_lonlat_rot.F90
index f1446bd9d23ffb8a197c55843ebc96aa7a2d271d..c3cc9a762fbf94ca3cf560a4971d308f2281a801 100644
--- a/src/SURFEX/read_nam_grid_lonlat_rot.F90
+++ b/src/SURFEX/read_nam_grid_lonlat_rot.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ################################################################
- SUBROUTINE READ_NAM_GRID_LONLAT_ROT(HPROGRAM,KGRID_PAR,KL,PGRID_PAR)
+ SUBROUTINE READ_NAM_GRID_LONLAT_ROT(PGRID_FULL_PAR,KDIM_FULL,HPROGRAM,KGRID_PAR,KL,PGRID_PAR,HDIR)
! ################################################################
!
!!**** *READ_NAM_GRID_LONLAT_ROT* - routine to read in namelist the horizontal grid
@@ -37,6 +37,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NSIZE_TASK
+!
USE MODE_POS_SURF
!
USE MODI_OPEN_NAMELIST
@@ -45,6 +47,7 @@ USE MODI_GET_LUOUT
!
USE MODE_GRIDTYPE_LONLAT_ROT
!
+USE MODI_READ_AND_SEND_MPI
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -54,10 +57,14 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
+REAL, DIMENSION(:), POINTER :: PGRID_FULL_PAR
+INTEGER, INTENT(IN) :: KDIM_FULL
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
INTEGER, INTENT(INOUT) :: KGRID_PAR ! size of PGRID_PAR
INTEGER, INTENT(OUT) :: KL ! number of points
REAL, DIMENSION(KGRID_PAR), INTENT(OUT) :: PGRID_PAR ! parameters defining this grid
+ CHARACTER(LEN=1), INTENT(IN) :: HDIR
!
!* 0.2 Declarations of local variables
! -------------------------------
@@ -65,8 +72,8 @@ REAL, DIMENSION(KGRID_PAR), INTENT(OUT) :: PGRID_PAR ! parameters defining th
INTEGER :: ILUOUT ! output listing logical unit
INTEGER :: ILUNAM ! namelist file logical unit
!
-REAL, DIMENSION(:), ALLOCATABLE :: ZLAT ! latitude of all points
-REAL, DIMENSION(:), ALLOCATABLE :: ZLON ! longitude of all points
+REAL, DIMENSION(:), ALLOCATABLE :: ZLAT, ZLAT0 ! latitude of all points
+REAL, DIMENSION(:), ALLOCATABLE :: ZLON, ZLON0 ! longitude of all points
!
REAL, DIMENSION(:), POINTER :: ZGRID_PAR
!
@@ -92,37 +99,56 @@ NAMELIST/NAM_LONLAT_ROT/XWEST,XSOUTH,XDLON,XDLAT,XPOLON,XPOLAT,NLON,NLAT
!* 1. opening of namelist
!
IF (LHOOK) CALL DR_HOOK('READ_NAM_GRID_LONLAT_ROT',0,ZHOOK_HANDLE)
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
-!
- CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
-!
-!---------------------------------------------------------------------------
-!
-!* 2. Reading of projection parameters
-! --------------------------------
-!
- CALL POSNAM(ILUNAM,'NAM_LONLAT_ROT',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_LONLAT_ROT)
-!
-!---------------------------------------------------------------------------
-!
-!* 3. Number of points
-! ----------------
-!
-KL = NLON * NLAT
-!
-!---------------------------------------------------------------------------
- CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
-!---------------------------------------------------------------------------
-!
-!* 4. All this information stored into pointer PGRID_PAR
-! --------------------------------------------------
-!
-ALLOCATE(ZLAT(KL))
-ALLOCATE(ZLON(KL))
-!
- CALL LATLON_LONLAT_ROT(XWEST,XSOUTH,XDLON,XDLAT,XPOLON,XPOLAT, &
- NLON,NLAT,ZLON,ZLAT )
+CALL GET_LUOUT(HPROGRAM,ILUOUT)
+!
+IF (HDIR/='H') THEN
+ !
+ CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 2. Reading of projection parameters
+ ! --------------------------------
+ !
+ CALL POSNAM(ILUNAM,'NAM_LONLAT_ROT',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_LONLAT_ROT)
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 3. Number of points
+ ! ----------------
+ !
+ KL = NLON * NLAT
+ !
+ !---------------------------------------------------------------------------
+ CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
+ !---------------------------------------------------------------------------
+ !
+ !* 4. All this information stored into pointer PGRID_PAR
+ ! --------------------------------------------------
+ !
+ ALLOCATE(ZLAT(KL))
+ ALLOCATE(ZLON(KL))
+ !
+ CALL LATLON_LONLAT_ROT(XWEST,XSOUTH,XDLON,XDLAT,XPOLON,XPOLAT, &
+ NLON,NLAT,ZLON,ZLAT )
+ !
+ELSE
+ !
+ ALLOCATE(ZLON0(KDIM_FULL),ZLAT0(KDIM_FULL))
+ !
+ CALL GET_GRIDTYPE_LONLAT_ROT(PGRID_FULL_PAR,PWEST=XWEST,PSOUTH=XSOUTH,&
+ PDLON=XDLON,PDLAT=XDLAT,PPOLON=XPOLON,PPOLAT=XPOLAT,&
+ KLON=NLON,KLAT=NLAT,KL=KL,PLON=ZLON0,PLAT=ZLAT0)
+ !
+ ALLOCATE(ZLON(KL),ZLAT(KL))
+ !
+ CALL READ_AND_SEND_MPI(ZLON0,ZLON)
+ CALL READ_AND_SEND_MPI(ZLAT0,ZLAT)
+ !
+ DEALLOCATE(ZLON0,ZLAT0)
+ !
+ENDIF
!
CALL PUT_GRIDTYPE_LONLAT_ROT(ZGRID_PAR, &
XWEST,XSOUTH,XDLON,XDLAT,XPOLON,XPOLAT, &
diff --git a/src/SURFEX/read_nam_grid_lonlatval.F90 b/src/SURFEX/read_nam_grid_lonlatval.F90
index 0ba5129c51dda63156ca8c27fc153aba82d3fb8d..a9acbfd3981a23171ec6998a08ff3211ea1ac7eb 100644
--- a/src/SURFEX/read_nam_grid_lonlatval.F90
+++ b/src/SURFEX/read_nam_grid_lonlatval.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ################################################################
- SUBROUTINE READ_NAM_GRID_LONLATVAL(HPROGRAM,KGRID_PAR,KL,PGRID_PAR)
+ SUBROUTINE READ_NAM_GRID_LONLATVAL(PGRID_FULL_PAR,KDIM_FULL,HPROGRAM,KGRID_PAR,KL,PGRID_PAR,HDIR)
! ################################################################
!
!!**** *READ_NAM_GRID_LONLATVAL* - routine to read in namelist the horizontal grid
@@ -37,6 +37,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NSIZE_TASK
+!
USE MODE_POS_SURF
!
USE MODI_OPEN_NAMELIST
@@ -44,6 +46,7 @@ USE MODI_CLOSE_NAMELIST
USE MODI_GET_LUOUT
!
USE MODE_GRIDTYPE_LONLATVAL
+USE MODI_READ_AND_SEND_MPI
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -52,22 +55,26 @@ IMPLICIT NONE
!
!* 0.1 Declarations of arguments
! -------------------------
+!
+REAL, DIMENSION(:), POINTER :: PGRID_FULL_PAR
+INTEGER, INTENT(IN) :: KDIM_FULL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
INTEGER, INTENT(INOUT) :: KGRID_PAR ! size of PGRID_PAR
INTEGER, INTENT(OUT) :: KL ! number of points
REAL, DIMENSION(KGRID_PAR), INTENT(OUT) :: PGRID_PAR ! parameters defining this grid
+ CHARACTER(LEN=1), INTENT(IN) :: HDIR
!
!* 0.2 Declarations of local variables
! -------------------------------
!
INTEGER :: ILUOUT ! output listing logical unit
INTEGER :: ILUNAM ! namelist file logical unit
-
-REAL, DIMENSION(:), ALLOCATABLE :: ZX ! X conformal coordinate of grid mesh
-REAL, DIMENSION(:), ALLOCATABLE :: ZY ! Y conformal coordinate of grid mesh
-REAL, DIMENSION(:), ALLOCATABLE :: ZDX ! X grid mesh size
-REAL, DIMENSION(:), ALLOCATABLE :: ZDY ! Y grid mesh size
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZX, ZX0 ! X conformal coordinate of grid mesh
+REAL, DIMENSION(:), ALLOCATABLE :: ZY, ZY0 ! Y conformal coordinate of grid mesh
+REAL, DIMENSION(:), ALLOCATABLE :: ZDX, ZDX0 ! X grid mesh size
+REAL, DIMENSION(:), ALLOCATABLE :: ZDY, ZDY0 ! Y grid mesh size
!
!* 0.3 Declarations of namelist
! ------------------------
@@ -92,46 +99,66 @@ NAMELIST/NAM_LONLATVAL/NPOINTS,XX,XY,XDX,XDY
IF (LHOOK) CALL DR_HOOK('READ_NAM_GRID_LONLATVAL',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
- CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
-!
-!---------------------------------------------------------------------------
-!
-!* 2. Reading of projection parameters
-! --------------------------------
-!
- CALL POSNAM(ILUNAM,'NAM_LONLATVAL',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_LONLATVAL)
-!
-!---------------------------------------------------------------------------
- CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
-!---------------------------------------------------------------------------
-!
-!* 3. Number of points
-! ----------------
-!
-KL = NPOINTS
-!
-!---------------------------------------------------------------------------
-!
-!* 3. Array of X and Y coordinates
-! ----------------------------
-!
-!
-ALLOCATE(ZX(KL))
-ALLOCATE(ZY(KL))
-ZX(:) = XX(:KL)
-ZY(:) = XY(:KL)
-!
-!---------------------------------------------------------------------------
-!
-!* 4. Array of X and Y increments
-! ---------------------------
-!
-ALLOCATE(ZDX(KL))
-ALLOCATE(ZDY(KL))
-ZDX(:) = XDX(:KL)
-ZDY(:) = XDY(:KL)
-!
+IF (HDIR/='H') THEN
+ !
+ CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 2. Reading of projection parameters
+ ! --------------------------------
+ !
+ CALL POSNAM(ILUNAM,'NAM_LONLATVAL',GFOUND,ILUOUT)
+ IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_LONLATVAL)
+ !
+ !---------------------------------------------------------------------------
+ CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
+ !---------------------------------------------------------------------------
+ !
+ !* 3. Number of points
+ ! ----------------
+ !
+ KL = NPOINTS
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 3. Array of X and Y coordinates
+ ! ----------------------------
+ !
+ !
+ ALLOCATE(ZX(KL))
+ ALLOCATE(ZY(KL))
+ ZX(:) = XX(:KL)
+ ZY(:) = XY(:KL)
+ !
+ !---------------------------------------------------------------------------
+ !
+ !* 4. Array of X and Y increments
+ ! ---------------------------
+ !
+ ALLOCATE(ZDX(KL))
+ ALLOCATE(ZDY(KL))
+ ZDX(:) = XDX(:KL)
+ ZDY(:) = XDY(:KL)
+ !
+ELSE
+ !
+ ALLOCATE(ZX0(KDIM_FULL),ZY0(KDIM_FULL),ZDX0(KDIM_FULL),ZDY0(KDIM_FULL))
+ !
+ CALL GET_GRIDTYPE_LONLATVAL(PGRID_FULL_PAR,&
+ PX=ZX0,PY=ZY0,PDX=ZDX0,PDY=ZDY0)
+ !
+ KL = NSIZE_TASK(NRANK)
+ ALLOCATE(ZX(KL),ZY(KL),ZDX(KL),ZDY(KL))
+ !
+ CALL READ_AND_SEND_MPI(ZX0,ZX)
+ CALL READ_AND_SEND_MPI(ZY0,ZY)
+ CALL READ_AND_SEND_MPI(ZDX0,ZDX)
+ CALL READ_AND_SEND_MPI(ZDY0,ZDY)
+ !
+ DEALLOCATE(ZX0,ZY0,ZDX0,ZDY0)
+ !
+ENDIF
!---------------------------------------------------------------------------
!
!* 8. All this information stored into pointer PGRID_PAR
diff --git a/src/SURFEX/read_nam_gridtype.F90 b/src/SURFEX/read_nam_gridtype.F90
index 992e0ad9974de10bac9d2202cf00e750f6b24e24..0a9a1ec242b7746269335b42f1362f8d7b47d1a3 100644
--- a/src/SURFEX/read_nam_gridtype.F90
+++ b/src/SURFEX/read_nam_gridtype.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_NAM_GRIDTYPE(HPROGRAM,HGRID,KGRID_PAR,PGRID_PAR,KL,GCP)
+ SUBROUTINE READ_NAM_GRIDTYPE(GCP,PGRID_FULL_PAR,KDIM_FULL,HPROGRAM,HGRID,KGRID_PAR,PGRID_PAR,KL,HDIR)
! ##########################################################
!!
!! PURPOSE
@@ -40,46 +40,51 @@
!* 0. DECLARATION
! -----------
!
+USE MODD_GRID_CONF_PROJ_n, ONLY :GRID_CONF_PROJ_t
+!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
-USE MODD_GRID_CONF_PROJ, ONLY :GRID_CONF_PROJ_t
-!
USE MODI_ABOR1_SFX
!
USE MODI_READ_NAM_GRID_CARTESIAN
-!
USE MODI_READ_NAM_GRID_CONF_PROJ
-!
USE MODI_READ_NAM_GRID_GAUSS
-!
USE MODI_READ_NAM_GRID_IGN
-!
USE MODI_READ_NAM_GRID_LONLAT_REG
-!
USE MODI_READ_NAM_GRID_LONLATVAL
-!
USE MODI_READ_NAM_GRID_LONLAT_ROT
+!
IMPLICIT NONE
!
!* 0.1 Declaration of dummy arguments
! ------------------------------
+!
+TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
+REAL, DIMENSION(:), POINTER :: PGRID_FULL_PAR
+INTEGER, INTENT(IN) :: KDIM_FULL
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling the surface
CHARACTER(LEN=10), INTENT(IN) :: HGRID ! grid type
INTEGER, INTENT(OUT) :: KGRID_PAR ! size of PGRID_PAR
REAL, DIMENSION(:), POINTER :: PGRID_PAR ! parameters defining this grid
INTEGER, INTENT(OUT) :: KL ! number of points
-TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ CHARACTER(LEN=1), INTENT(IN), OPTIONAL :: HDIR
!
!
!* 0.2 Declaration of local variables
! ------------------------------
!
+ CHARACTER(LEN=1) :: YDIR
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('READ_NAM_GRIDTYPE',0,ZHOOK_HANDLE)
+!
+YDIR = 'A'
+IF (PRESENT(HDIR)) YDIR = HDIR
+!
SELECT CASE (HGRID)
!* 1. Conformal projection grid and regular lat/lon
@@ -89,35 +94,35 @@ SELECT CASE (HGRID)
KGRID_PAR = 0
ALLOCATE(PGRID_PAR(0))
IF (HGRID=='CONF PROJ ')&
- CALL READ_NAM_GRID_CONF_PROJ(HPROGRAM,KGRID_PAR,KL,PGRID_PAR,GCP)
+ CALL READ_NAM_GRID_CONF_PROJ(GCP,PGRID_FULL_PAR,KDIM_FULL,HPROGRAM,KGRID_PAR,KL,PGRID_PAR,YDIR)
IF (HGRID=='CARTESIAN ')&
- CALL READ_NAM_GRID_CARTESIAN(HPROGRAM,KGRID_PAR,KL,PGRID_PAR)
+ CALL READ_NAM_GRID_CARTESIAN(PGRID_FULL_PAR,KDIM_FULL,HPROGRAM,KGRID_PAR,KL,PGRID_PAR,YDIR)
IF (HGRID=='LONLAT REG')&
- CALL READ_NAM_GRID_LONLAT_REG(HPROGRAM,KGRID_PAR,KL,PGRID_PAR)
+ CALL READ_NAM_GRID_LONLAT_REG(PGRID_FULL_PAR,KDIM_FULL,HPROGRAM,KGRID_PAR,KL,PGRID_PAR,YDIR)
IF (HGRID=='GAUSS ')&
- CALL READ_NAM_GRID_GAUSS(HPROGRAM,KGRID_PAR,KL,PGRID_PAR)
+ CALL READ_NAM_GRID_GAUSS(PGRID_FULL_PAR,KDIM_FULL,HPROGRAM,KGRID_PAR,KL,PGRID_PAR,YDIR)
IF (HGRID=='IGN ')&
- CALL READ_NAM_GRID_IGN(HPROGRAM,KGRID_PAR,KL,PGRID_PAR)
+ CALL READ_NAM_GRID_IGN(PGRID_FULL_PAR,KDIM_FULL,HPROGRAM,KGRID_PAR,KL,PGRID_PAR,YDIR)
IF (HGRID=='LONLATVAL ')&
- CALL READ_NAM_GRID_LONLATVAL(HPROGRAM,KGRID_PAR,KL,PGRID_PAR)
+ CALL READ_NAM_GRID_LONLATVAL(PGRID_FULL_PAR,KDIM_FULL,HPROGRAM,KGRID_PAR,KL,PGRID_PAR,YDIR)
IF (HGRID=='LONLAT ROT')&
- CALL READ_NAM_GRID_LONLAT_ROT(HPROGRAM,KGRID_PAR,KL,PGRID_PAR)
+ CALL READ_NAM_GRID_LONLAT_ROT(PGRID_FULL_PAR,KDIM_FULL,HPROGRAM,KGRID_PAR,KL,PGRID_PAR,YDIR)
DEALLOCATE(PGRID_PAR)
ALLOCATE(PGRID_PAR(KGRID_PAR))
IF (HGRID=='CONF PROJ ')&
- CALL READ_NAM_GRID_CONF_PROJ(HPROGRAM,KGRID_PAR,KL,PGRID_PAR,GCP)
+ CALL READ_NAM_GRID_CONF_PROJ(GCP,PGRID_FULL_PAR,KDIM_FULL,HPROGRAM,KGRID_PAR,KL,PGRID_PAR,YDIR)
IF (HGRID=='CARTESIAN ')&
- CALL READ_NAM_GRID_CARTESIAN(HPROGRAM,KGRID_PAR,KL,PGRID_PAR)
+ CALL READ_NAM_GRID_CARTESIAN(PGRID_FULL_PAR,KDIM_FULL,HPROGRAM,KGRID_PAR,KL,PGRID_PAR,YDIR)
IF (HGRID=='LONLAT REG')&
- CALL READ_NAM_GRID_LONLAT_REG(HPROGRAM,KGRID_PAR,KL,PGRID_PAR)
+ CALL READ_NAM_GRID_LONLAT_REG(PGRID_FULL_PAR,KDIM_FULL,HPROGRAM,KGRID_PAR,KL,PGRID_PAR,YDIR)
IF (HGRID=='GAUSS ')&
- CALL READ_NAM_GRID_GAUSS(HPROGRAM,KGRID_PAR,KL,PGRID_PAR)
+ CALL READ_NAM_GRID_GAUSS(PGRID_FULL_PAR,KDIM_FULL,HPROGRAM,KGRID_PAR,KL,PGRID_PAR,YDIR)
IF (HGRID=='IGN ')&
- CALL READ_NAM_GRID_IGN(HPROGRAM,KGRID_PAR,KL,PGRID_PAR)
+ CALL READ_NAM_GRID_IGN(PGRID_FULL_PAR,KDIM_FULL,HPROGRAM,KGRID_PAR,KL,PGRID_PAR,YDIR)
IF (HGRID=='LONLATVAL ')&
- CALL READ_NAM_GRID_LONLATVAL(HPROGRAM,KGRID_PAR,KL,PGRID_PAR)
+ CALL READ_NAM_GRID_LONLATVAL(PGRID_FULL_PAR,KDIM_FULL,HPROGRAM,KGRID_PAR,KL,PGRID_PAR,YDIR)
IF (HGRID=='LONLAT ROT')&
- CALL READ_NAM_GRID_LONLAT_ROT(HPROGRAM,KGRID_PAR,KL,PGRID_PAR)
+ CALL READ_NAM_GRID_LONLAT_ROT(PGRID_FULL_PAR,KDIM_FULL,HPROGRAM,KGRID_PAR,KL,PGRID_PAR,YDIR)
! note that all points of the grid will be kept, whatever the surface
! type under consideration (e.g. sea points will be kept even for
! initialization of continents)
diff --git a/src/SURFEX/read_nam_pgd_chemistry.F90 b/src/SURFEX/read_nam_pgd_chemistry.F90
index 48a36cc17ed8770355cecfc9523715d0a573a8a0..fd04cd860c4dfe0d6b09c2fa03ab661e4a1b1ae8 100644
--- a/src/SURFEX/read_nam_pgd_chemistry.F90
+++ b/src/SURFEX/read_nam_pgd_chemistry.F90
@@ -80,7 +80,7 @@ NAMELIST/NAM_CH_EMISSIONS/ CCH_EMIS
! ---------------------------
!
IF (LHOOK) CALL DR_HOOK('READ_NAM_PGD_CHEMISTRY',0,ZHOOK_HANDLE)
- CCH_EMIS = 'NONE'
+CCH_EMIS = 'NONE'
!
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
diff --git a/src/SURFEX/read_nam_pgd_cover.F90 b/src/SURFEX/read_nam_pgd_cover.F90
index 0e7e3af4ee112abf3b66eb6c4f8cb584c4b57a73..5f5f3930794f9eb9bbd1375383ea8d70c284c468 100644
--- a/src/SURFEX/read_nam_pgd_cover.F90
+++ b/src/SURFEX/read_nam_pgd_cover.F90
@@ -5,7 +5,7 @@
! #########
SUBROUTINE READ_NAM_PGD_COVER(HPROGRAM, HCOVER, HFILETYPE, PUNIF_COVER, &
PRM_COVER, PRM_COAST, PRM_LAKE, ORM_RIVER, &
- PRM_SEA, OORCA_GRID, PLAT_ANT, OIMP_COVER )
+ PRM_SEA, OORCA_GRID, PLAT_ANT, OIMP_COVER )
! ##############################################################
!
!!**** *READ_NAM_PGD_COVER* reads namelist for Cover
@@ -40,7 +40,7 @@
!* 0. DECLARATION
! -----------
!
-USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
+USE MODD_DATA_COVER_PAR, ONLY : NCOVER
!
USE MODI_GET_LUOUT
USE MODI_OPEN_NAMELIST
@@ -57,9 +57,9 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
- CHARACTER(LEN=28), INTENT(OUT) :: HCOVER ! file name for cover types
- CHARACTER(LEN=6), INTENT(OUT) :: HFILETYPE ! data file type
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
+CHARACTER(LEN=28), INTENT(OUT) :: HCOVER ! file name for cover types
+CHARACTER(LEN=6), INTENT(OUT) :: HFILETYPE ! data file type
REAL, DIMENSION(:), INTENT(OUT) :: PUNIF_COVER ! value of each cover (cover will be uniform on the horizontal)
REAL, INTENT(OUT) :: PRM_COVER ! limit of coverage under which the cover is removed. Default is 1.E-6
REAL, INTENT(OUT) :: PRM_COAST ! limit of coast coverage
@@ -81,11 +81,11 @@ LOGICAL :: GFOUND ! flag when namelist is present
!* 0.3 Declaration of namelists
! ------------------------
!
-REAL, DIMENSION(JPCOVER) :: XUNIF_COVER ! value of each cover (cover will be
+REAL, DIMENSION(NCOVER) :: XUNIF_COVER ! value of each cover (cover will be
! uniform on the horizontal)
!
- CHARACTER(LEN=28) :: YCOVER ! file name for cover types
- CHARACTER(LEN=6) :: YCOVERFILETYPE ! data file type
+CHARACTER(LEN=28) :: YCOVER ! file name for cover types
+CHARACTER(LEN=6) :: YCOVERFILETYPE ! data file type
REAL :: XRM_COVER ! limit of coverage under which the
! cover is removed. Default is 1.E-6
REAL :: XRM_COAST ! limit of coast coverage under which
@@ -105,10 +105,11 @@ LOGICAL :: LORCA_GRID ! flag to compatibility between Surfex a
REAL :: XLAT_ANT ! Lattitude limit from Orca grid (Antartic)
!
LOGICAL :: LIMP_COVER ! Imposed values for Cover from another PGD file
+!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
NAMELIST/NAM_COVER/ YCOVER, YCOVERFILETYPE, XUNIF_COVER, XRM_COVER, XRM_COAST, &
- XRM_LAKE, LRM_RIVER, XRM_SEA, LORCA_GRID, XLAT_ANT, LIMP_COVER
+ XRM_LAKE, LRM_RIVER, XRM_SEA, LORCA_GRID, XLAT_ANT, LIMP_COVER
!
!-------------------------------------------------------------------------------
!
@@ -148,7 +149,7 @@ IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_COVER)
!
HCOVER = YCOVER ! file name for cover types
HFILETYPE = YCOVERFILETYPE ! data file type
-PUNIF_COVER = XUNIF_COVER ! value of each cover (cover will be uniform on the horizontal)
+PUNIF_COVER = XUNIF_COVER(1:SIZE(PUNIF_COVER)) ! value of each cover (cover will be uniform on the horizontal)
PRM_COVER = XRM_COVER ! limit of coverage under which the cover is removed. Default is 1.E-6
PRM_COAST = XRM_COAST ! limit of coast coverage
PRM_LAKE = XRM_LAKE ! limit of inland lake coverage
diff --git a/src/SURFEX/read_nam_pgd_dummy.F90 b/src/SURFEX/read_nam_pgd_dummy.F90
index 3761132d45553f680f0d2429fe8ab110d39faa97..971832bcbf33ad1699e72ca05a6cba2f1c85a65f 100644
--- a/src/SURFEX/read_nam_pgd_dummy.F90
+++ b/src/SURFEX/read_nam_pgd_dummy.F90
@@ -116,11 +116,11 @@ NAMELIST/NAM_DUMMY_PGD/ NDUMMY_NBR, CDUMMY_NAME, CDUMMY_AREA, &
IF (LHOOK) CALL DR_HOOK('READ_NAM_PGD_DUMMY',0,ZHOOK_HANDLE)
NDUMMY_NBR = 0
!
- CDUMMY_NAME = " "
- CDUMMY_FILE = " "
- CDUMMY_FILETYPE = " "
- CDUMMY_AREA = "ALL"
- CDUMMY_ATYPE = "ARI"
+CDUMMY_NAME = " "
+CDUMMY_FILE = " "
+CDUMMY_FILETYPE = " "
+CDUMMY_AREA = "ALL"
+CDUMMY_ATYPE = "ARI"
!
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
diff --git a/src/SURFEX/read_nam_pgd_gauss_index.F90 b/src/SURFEX/read_nam_pgd_gauss_index.F90
deleted file mode 100644
index 48b1197a4431f7728188b25f3ede84cf94f870a6..0000000000000000000000000000000000000000
--- a/src/SURFEX/read_nam_pgd_gauss_index.F90
+++ /dev/null
@@ -1,12 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE READ_NAM_PGD_GAUSS_INDEX
-! ####################################################################################
-!!
-!
-!!!! to be suppressed
-!
-END SUBROUTINE READ_NAM_PGD_GAUSS_INDEX
diff --git a/src/SURFEX/read_nam_pgd_isba.F90 b/src/SURFEX/read_nam_pgd_isba.F90
index 9b4fa8840aa56ca8437dda5bc12fa8d84ac4bdf4..85b23f284ab955d6b17bbfc4dabb3891e2cbd93d 100644
--- a/src/SURFEX/read_nam_pgd_isba.F90
+++ b/src/SURFEX/read_nam_pgd_isba.F90
@@ -4,13 +4,12 @@
!SFX_LIC for details. version 1.
! #########
SUBROUTINE READ_NAM_PGD_ISBA(HPROGRAM, KPATCH, KGROUND_LAYER, &
- HISBA, HPEDOTF, HPHOTO, OTR_ML, PRM_PATCH, &
+ HISBA, HPEDOTF, HPHOTO, OTR_ML, HALBEDO, PRM_PATCH, &
HCLAY, HCLAYFILETYPE, PUNIF_CLAY, OIMP_CLAY, &
HSAND, HSANDFILETYPE, PUNIF_SAND, OIMP_SAND, &
HSOC_TOP, HSOC_SUB, HSOCFILETYPE, PUNIF_SOC_TOP, &
PUNIF_SOC_SUB, OIMP_SOC, HCTI, HCTIFILETYPE, OIMP_CTI, &
HPERM, HPERMFILETYPE, PUNIF_PERM, OIMP_PERM, OMEB, &
- HGW, HGWFILETYPE, PUNIF_GW, OIMP_GW, &
HRUNOFFB, HRUNOFFBFILETYPE, PUNIF_RUNOFFB, &
HWDRAIN, HWDRAINFILETYPE , PUNIF_WDRAIN, PSOILGRID, &
HPH, HPHFILETYPE, PUNIF_PH, HFERT, HFERTFILETYPE, &
@@ -50,6 +49,7 @@
!! 06/2009 B. Decharme : files of data for topographic index
!! 07/2012 B. Decharme : files of data for permafrost area and for SOC top and sub soil
!! 10/2014 P. Samuelsson: MEB
+!! 10/2016 B. Decharme : bug surface/groundwater coupling
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
@@ -79,19 +79,18 @@ INTEGER, INTENT(OUT) :: KGROUND_LAYER ! number of soil layers
CHARACTER(LEN=4), INTENT(OUT) :: HPEDOTF ! Pedo-transfert function for DIF
CHARACTER(LEN=3), INTENT(OUT) :: HPHOTO ! photosynthesis option
LOGICAL, INTENT(OUT) :: OTR_ML ! new radiative transfert
+ CHARACTER(LEN=4), INTENT(OUT) :: HALBEDO
REAL, INTENT(OUT) :: PRM_PATCH ! threshold to remove little fractions of patches
CHARACTER(LEN=28), INTENT(OUT) :: HSAND ! file name for sand fraction
CHARACTER(LEN=28), INTENT(OUT) :: HCLAY ! file name for clay fraction
CHARACTER(LEN=28), INTENT(OUT) :: HCTI ! file name for topographic index
CHARACTER(LEN=28), INTENT(OUT) :: HPERM ! file name for permafrost distribution
- CHARACTER(LEN=28), INTENT(OUT) :: HGW ! file name for groundwater distribution
CHARACTER(LEN=28), INTENT(OUT) :: HRUNOFFB ! file name for runoffb parameter
CHARACTER(LEN=28), INTENT(OUT) :: HWDRAIN ! file name for wdrain parameter
CHARACTER(LEN=6), INTENT(OUT) :: HSANDFILETYPE ! sand data file type
CHARACTER(LEN=6), INTENT(OUT) :: HCLAYFILETYPE ! clay data file type
CHARACTER(LEN=6), INTENT(OUT) :: HCTIFILETYPE ! topographic index data file type
CHARACTER(LEN=6), INTENT(OUT) :: HPERMFILETYPE ! permafrost distribution data file type
- CHARACTER(LEN=6), INTENT(OUT) :: HGWFILETYPE ! groundwater distribution data file type
CHARACTER(LEN=6), INTENT(OUT) :: HRUNOFFBFILETYPE ! subgrid runoff data file type
CHARACTER(LEN=6), INTENT(OUT) :: HWDRAINFILETYPE ! subgrid drainage data file type
REAL, INTENT(OUT) :: PUNIF_SAND ! uniform value of sand fraction
@@ -99,13 +98,11 @@ REAL, INTENT(OUT) :: PUNIF_CLAY ! uniform value of clay frac
REAL, INTENT(OUT) :: PUNIF_RUNOFFB ! uniform value of subgrid runoff coefficient
REAL, INTENT(OUT) :: PUNIF_WDRAIN ! uniform value of subgrid drainage coefficient
REAL, INTENT(OUT) :: PUNIF_PERM ! uniform value of permafrost distribution
-REAL, INTENT(OUT) :: PUNIF_GW ! uniform value of groundwater distribution
LOGICAL, INTENT(OUT) :: OIMP_SAND ! Imposed values for Sand
LOGICAL, INTENT(OUT) :: OIMP_CLAY ! Imposed values for Clay
LOGICAL, INTENT(OUT) :: OIMP_CTI ! Imposed values for topographic index statistics
LOGICAL, INTENT(OUT) :: OMEB ! MEB
LOGICAL, INTENT(OUT) :: OIMP_PERM ! Imposed maps of permafrost distribution
-LOGICAL, INTENT(OUT) :: OIMP_GW ! Imposed maps of permafrost distribution
CHARACTER(LEN=28), INTENT(OUT) :: HSOC_TOP ! file name for organic carbon
CHARACTER(LEN=28), INTENT(OUT) :: HSOC_SUB ! file name for organic carbon
CHARACTER(LEN=6), INTENT(OUT) :: HSOCFILETYPE ! organic carbon data file type
@@ -137,12 +134,12 @@ INTEGER :: NGROUND_LAYER ! number of soil layers
CHARACTER(LEN=4) :: CPEDO_FUNCTION ! Pedo-transfert function for DIF
CHARACTER(LEN=3) :: CPHOTO ! photosynthesis option
LOGICAL :: LTR_ML ! new radiative transfert
+ CHARACTER(LEN=4) :: CALBEDO
REAL :: XRM_PATCH ! threshold to remove little fractions of patches
CHARACTER(LEN=28) :: YSAND ! file name for sand fraction
CHARACTER(LEN=28) :: YCLAY ! file name for clay fraction
CHARACTER(LEN=28) :: YCTI ! file name for topographic index
CHARACTER(LEN=28) :: YPERM ! file name for permafrost distribution
- CHARACTER(LEN=28) :: YGW ! file name for groundwater map
CHARACTER(LEN=28) :: YRUNOFFB ! file name for runoffb parameter
CHARACTER(LEN=28) :: YWDRAIN ! file name for wdrain parameter
CHARACTER(LEN=28) :: YPH ! file name for pH
@@ -151,7 +148,6 @@ REAL :: XRM_PATCH ! threshold to remove little fracti
CHARACTER(LEN=6) :: YCLAYFILETYPE ! clay data file type
CHARACTER(LEN=6) :: YCTIFILETYPE ! topographic index data file type
CHARACTER(LEN=6) :: YPERMFILETYPE ! permafrost distribution data file type
- CHARACTER(LEN=6) :: YGWFILETYPE ! groundwater distribution data file type
CHARACTER(LEN=6) :: YRUNOFFBFILETYPE ! subgrid runoff data file type
CHARACTER(LEN=6) :: YWDRAINFILETYPE ! subgrid drainage data file type
CHARACTER(LEN=6) :: YPHFILETYPE ! pH data file type
@@ -161,13 +157,11 @@ LOGICAL :: LIMP_CLAY ! Imposed maps of Clay from another
LOGICAL :: LIMP_CTI ! Imposed values for topographic index statistics from another PGD file
LOGICAL :: LMEB ! MEB
LOGICAL :: LIMP_PERM ! Imposed maps of permafrost distribution
-LOGICAL :: LIMP_GW ! Imposed maps of groundwater distribution
REAL :: XUNIF_SAND ! uniform value of sand fraction
REAL :: XUNIF_CLAY ! uniform value of clay fraction
REAL :: XUNIF_RUNOFFB ! uniform value of subgrid runoff coefficient
REAL :: XUNIF_WDRAIN ! uniform value of subgrid drainage coefficient
REAL :: XUNIF_PERM ! uniform value of permafrost distribution
-REAL :: XUNIF_GW ! uniform groundwater distribution
REAL :: XUNIF_PH ! uniform value of pH
REAL :: XUNIF_FERT ! uniform value of fertilisation rate
!
@@ -183,12 +177,11 @@ LOGICAL :: LIMP_SOC ! Imposed maps of organic carbon
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
NAMELIST/NAM_ISBA/ NPATCH, NGROUND_LAYER, CISBA, CPEDO_FUNCTION, CPHOTO, &
- LTR_ML, XRM_PATCH, YCLAY, YCLAYFILETYPE, XUNIF_CLAY, &
+ LTR_ML, CALBEDO, XRM_PATCH, YCLAY, YCLAYFILETYPE, XUNIF_CLAY, &
LIMP_CLAY, YSAND, YSANDFILETYPE, XUNIF_SAND, LIMP_SAND, &
YSOC_TOP, YSOC_SUB, YSOCFILETYPE, XUNIF_SOC_TOP, &
XUNIF_SOC_SUB, LIMP_SOC, YCTI, YCTIFILETYPE, LIMP_CTI, &
YPERM, YPERMFILETYPE, XUNIF_PERM, LIMP_PERM, LMEB, &
- YGW, YGWFILETYPE, XUNIF_GW, LIMP_GW, &
YRUNOFFB, YRUNOFFBFILETYPE, XUNIF_RUNOFFB, &
YWDRAIN, YWDRAINFILETYPE, XUNIF_WDRAIN, XSOILGRID, &
YPH, YPHFILETYPE, XUNIF_PH, YFERT, YFERTFILETYPE, &
@@ -203,10 +196,11 @@ NAMELIST/NAM_ISBA/ NPATCH, NGROUND_LAYER, CISBA, CPEDO_FUNCTION, CPHOTO, &
IF (LHOOK) CALL DR_HOOK('READ_NAM_PGD_ISBA',0,ZHOOK_HANDLE)
NPATCH = 1
NGROUND_LAYER = NUNDEF
- CISBA = '3-L'
- CPEDO_FUNCTION = 'CH78'
- CPHOTO = 'NON'
+CISBA = '3-L'
+CPEDO_FUNCTION = 'CH78'
+CPHOTO = 'NON'
LTR_ML = .FALSE.
+CALBEDO = 'DRY '
XSOILGRID(:) = XUNDEF
XRM_PATCH = 0.0
!#####################
@@ -218,7 +212,6 @@ XUNIF_SOC_SUB = XUNDEF
XUNIF_RUNOFFB = 0.5
XUNIF_WDRAIN = 0.
XUNIF_PERM = XUNDEF
-XUNIF_GW = XUNDEF
XUNIF_PH = XUNDEF
XUNIF_FERT = XUNDEF
!
@@ -228,7 +221,6 @@ YSOC_TOP = ' '
YSOC_SUB = ' '
YCTI = ' '
YPERM = ' '
-YGW = ' '
YRUNOFFB = ' '
YWDRAIN = ' '
YPH = ' '
@@ -239,7 +231,6 @@ YSANDFILETYPE = ' '
YSOCFILETYPE = ' '
YCTIFILETYPE = ' '
YPERMFILETYPE = ' '
-YGWFILETYPE = ' '
YRUNOFFBFILETYPE = ' '
YWDRAINFILETYPE = ' '
YPHFILETYPE = ' '
@@ -251,7 +242,6 @@ LIMP_SOC = .FALSE.
LIMP_CTI = .FALSE.
LMEB = .FALSE.
LIMP_PERM = .FALSE.
-LIMP_GW = .FALSE.
!
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
@@ -276,6 +266,7 @@ HISBA = CISBA ! ISBA option
HPEDOTF = CPEDO_FUNCTION ! Pedo-transfert function for DIF
HPHOTO = CPHOTO ! photosynthesis option
OTR_ML = LTR_ML ! new radiative transfert
+HALBEDO = CALBEDO
PRM_PATCH = XRM_PATCH ! threshol to remove little fractions of patches
HSAND = YSAND ! file name for sand fraction
HCLAY = YCLAY ! file name for clay fraction
@@ -283,7 +274,6 @@ HSOC_TOP = YSOC_TOP ! file name for organic carbon
HSOC_SUB = YSOC_SUB ! file name for organic carbon
HCTI = YCTI ! file name for topographic index
HPERM = YPERM ! file name for permafrost distribution
-HGW = YGW ! file name for groundwater distribution
HRUNOFFB = YRUNOFFB ! file name for subgrid runoff
HWDRAIN = YWDRAIN ! file name for subgrid drainage
HSANDFILETYPE = YSANDFILETYPE ! sand data file type
@@ -291,7 +281,6 @@ HCLAYFILETYPE = YCLAYFILETYPE ! clay data file type
HSOCFILETYPE = YSOCFILETYPE ! organic carbon data file type
HCTIFILETYPE = YCTIFILETYPE ! topographic index data file type
HPERMFILETYPE = YPERMFILETYPE ! permafrost distribution data file type
-HGWFILETYPE = YGWFILETYPE ! groundwater distribution data file type
HRUNOFFBFILETYPE = YRUNOFFBFILETYPE ! subgrid runoff data file type
HWDRAINFILETYPE = YWDRAINFILETYPE ! subgrid drainage data file type
PUNIF_SAND = XUNIF_SAND ! uniform value of sand fraction
@@ -301,14 +290,12 @@ PUNIF_SOC_SUB = XUNIF_SOC_SUB ! uniform value of organic carbon sub soil
PUNIF_RUNOFFB = XUNIF_RUNOFFB ! uniform value of subgrid runoff coefficient
PUNIF_WDRAIN = XUNIF_WDRAIN ! uniform value of subgrid drainage coefficient
PUNIF_PERM = XUNIF_PERM ! uniform value of permafrost distribution
-PUNIF_GW = XUNIF_GW ! uniform value of groundwater distribution
OIMP_SAND = LIMP_SAND ! Imposed values for SAND
OIMP_CLAY = LIMP_CLAY ! Imposed values for CLAY
OIMP_SOC = LIMP_SOC ! Imposed values for organic carbon
OIMP_CTI = LIMP_CTI ! Imposed values for topographic index statistics
OIMP_PERM = LIMP_PERM ! Imposed values for permafrost distribution
OMEB = LMEB ! MEB
-OIMP_GW = LIMP_GW ! Imposed values for groundwater distribution
!
HPH = YPH ! file name for pH value
HFERT = YFERT ! file name for fertilisation data
diff --git a/src/SURFEX/read_nam_pgd_isba_meb.F90 b/src/SURFEX/read_nam_pgd_isba_meb.F90
index eb2cbb7cf29e96c3815fcca26fc9a490e42b577d..0cf00afaa9e7b9450dfb1548b237f8d0fdf297bc 100644
--- a/src/SURFEX/read_nam_pgd_isba_meb.F90
+++ b/src/SURFEX/read_nam_pgd_isba_meb.F90
@@ -4,7 +4,7 @@
!SFX_LIC for details. version 1.
! #########
SUBROUTINE READ_NAM_PGD_ISBA_MEB(HPROGRAM, KLUOUT, OMEB_PATCH, OFORC_MEASURE, &
- OMEB_LITTER, OMEB_GNDRES)
+ OMEB_LITTER, OMEB_GNDRES)
! #############################################################################
!
!!**** *READ_NAM_PGD_ISBA_MEB* reads namelist for ISBA
@@ -43,6 +43,8 @@
USE MODI_OPEN_NAMELIST
USE MODI_CLOSE_NAMELIST
!
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE_ECOSG
+!
USE MODE_POS_SURF
!
USE MODI_ABOR1_SFX
@@ -55,7 +57,7 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
INTEGER, INTENT(IN) :: KLUOUT
!
LOGICAL, DIMENSION(:), INTENT(OUT) :: OMEB_PATCH
@@ -63,7 +65,6 @@ LOGICAL , INTENT(OUT) :: OFORC_MEASURE
LOGICAL , INTENT(OUT) :: OMEB_LITTER
LOGICAL , INTENT(OUT) :: OMEB_GNDRES
!
-!
!* 0.2 Declaration of local variables
! ------------------------------
!
@@ -74,14 +75,14 @@ LOGICAL :: GFOUND ! flag when namelist is present
!* 0.3 Declaration of namelists
! ------------------------
!
-LOGICAL, DIMENSION(19) :: LMEB_PATCH
+LOGICAL, DIMENSION(NVEGTYPE_ECOSG) :: LMEB_PATCH
LOGICAL :: LFORC_MEASURE
LOGICAL :: LMEB_LITTER
LOGICAL :: LMEB_GNDRES
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-NAMELIST/NAM_MEB_ISBA/LMEB_PATCH,LFORC_MEASURE,LMEB_LITTER,LMEB_GNDRES
+NAMELIST/NAM_MEB_ISBA/LMEB_PATCH,LFORC_MEASURE,LMEB_LITTER,LMEB_GNDRES
!
!-------------------------------------------------------------------------------
!
@@ -100,9 +101,9 @@ LMEB_GNDRES =.FALSE.
!* 2. Reading of namelist
! -------------------
!
- CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
+CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
!
- CALL POSNAM(ILUNAM,'NAM_MEB_ISBA',GFOUND,KLUOUT)
+CALL POSNAM(ILUNAM,'NAM_MEB_ISBA',GFOUND,KLUOUT)
IF (GFOUND) THEN
READ(UNIT=ILUNAM,NML=NAM_MEB_ISBA)
ELSE
@@ -114,7 +115,7 @@ ELSE
CALL ABOR1_SFX('PGD_ISBA: NAM_MEB_ISBA and LMEB_PATCH not defined')
ENDIF
!
- CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
+CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/read_nam_pgd_orography.F90 b/src/SURFEX/read_nam_pgd_orography.F90
index 2548cfb2d9e0dbe8918a2173dfdf17aea4246bc5..00b2aabbd1cdd132ff68b6ac05bf4fb0ae7466eb 100644
--- a/src/SURFEX/read_nam_pgd_orography.F90
+++ b/src/SURFEX/read_nam_pgd_orography.F90
@@ -65,8 +65,8 @@ REAL, INTENT(OUT) :: PUNIF_ZS ! uniform orography
CHARACTER(LEN=3), INTENT(OUT) :: HOROGTYPE ! orogpraphy type
REAL, INTENT(OUT) :: PENV ! parameter for enveloppe orography:
LOGICAL, INTENT(OUT) :: OIMP_ZS ! Imposed orography from another PGD file
- CHARACTER(LEN=28), INTENT(OUT),OPTIONAL :: HSLOPE ! file name for slope
- CHARACTER(LEN=6), INTENT(OUT),OPTIONAL :: HSLOPEFILETYPE ! data file type
+CHARACTER(LEN=28), INTENT(OUT),OPTIONAL :: HSLOPE ! file name for slope
+CHARACTER(LEN=6), INTENT(OUT),OPTIONAL :: HSLOPEFILETYPE ! data file type
LOGICAL, INTENT(OUT),OPTIONAL :: OEXPLICIT_SLOPE ! Slope is computed from explicit ZS field and not subgrid orography
!
!
@@ -82,8 +82,8 @@ LOGICAL :: GFOUND ! flag when namelist is present
!
CHARACTER(LEN=28) :: YZS ! file name for orography
CHARACTER(LEN=6) :: YZSFILETYPE ! data file type
- CHARACTER(LEN=28) :: YSLOPE ! file name for slope
- CHARACTER(LEN=6) :: YSLOPEFILETYPE ! data file type
+CHARACTER(LEN=28) :: YSLOPE ! file name for slope
+CHARACTER(LEN=6) :: YSLOPEFILETYPE ! data file type
REAL :: XUNIF_ZS ! uniform orography
CHARACTER(LEN=3) :: COROGTYPE ! orogpraphy type
! ! 'AVG' : average orography
@@ -110,7 +110,7 @@ YZSFILETYPE = ' '
YSLOPE = ' '
YSLOPEFILETYPE = ' '
!
- COROGTYPE = 'ENV'
+COROGTYPE = 'ENV'
XENV = 0.
LIMP_ZS = .FALSE.
LEXPLICIT_SLOPE=.FALSE.
diff --git a/src/SURFEX/read_nam_pgd_teb.F90 b/src/SURFEX/read_nam_pgd_teb.F90
index bb9596833aea186ace9125fc2b15e6fbf8fb820b..cc6d7fdb612ac3f93cb7b6dae39b45de61c512de 100644
--- a/src/SURFEX/read_nam_pgd_teb.F90
+++ b/src/SURFEX/read_nam_pgd_teb.F90
@@ -117,10 +117,10 @@ NAMELIST/NAM_TEB/ NTEB_PATCH, CBEM, CCOOL_COIL, CHEAT_COIL, LAUTOSIZE, &
!
IF (LHOOK) CALL DR_HOOK('READ_NAM_PGD_TEB',0,ZHOOK_HANDLE)
NTEB_PATCH = 1
- CBEM = 'DEF'
+CBEM = 'DEF'
LAUTOSIZE =.FALSE.
- CHEAT_COIL ='IDEAL'
- CCOOL_COIL ='IDEAL'
+CHEAT_COIL ='IDEAL'
+CCOOL_COIL ='IDEAL'
NROAD_LAYER = 5
NROOF_LAYER = 5
NWALL_LAYER = 5
diff --git a/src/SURFEX/read_nam_pgd_teb_greenroof.F90 b/src/SURFEX/read_nam_pgd_teb_greenroof.F90
index 3f610c925fca39dd5dbc18f3553159613e5a09be..c80e86df6cb368ee2a011ca5e841c71d8fe76443 100644
--- a/src/SURFEX/read_nam_pgd_teb_greenroof.F90
+++ b/src/SURFEX/read_nam_pgd_teb_greenroof.F90
@@ -130,22 +130,22 @@ IF (LHOOK) CALL DR_HOOK('PGD_TEB_GREENROOF_PAR',0,ZHOOK_HANDLE)
!
NTIME_GR = 1
NLAYER_GR = 6
- CTYP_GR = 'GRASS' ! Grasses - graminoïds
+CTYP_GR = 'GRASS' ! Grasses - graminoïds
!
XUNIF_OM_GR = XUNDEF
XUNIF_CLAY_GR = XUNDEF
XUNIF_SAND_GR = XUNDEF
XUNIF_LAI_GR = XUNDEF
!
- CFNAM_OM_GR = ' '
- CFNAM_CLAY_GR = ' '
- CFNAM_SAND_GR = ' '
- CFNAM_LAI_GR = ' '
+CFNAM_OM_GR = ' '
+CFNAM_CLAY_GR = ' '
+CFNAM_SAND_GR = ' '
+CFNAM_LAI_GR = ' '
!
- CFTYP_OM_GR = ' '
- CFTYP_CLAY_GR = ' '
- CFTYP_SAND_GR = ' '
- CFTYP_LAI_GR = ' '
+CFTYP_OM_GR = ' '
+CFTYP_CLAY_GR = ' '
+CFTYP_SAND_GR = ' '
+CFTYP_LAI_GR = ' '
!
!-------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/read_nam_prep_seafluxn.F90 b/src/SURFEX/read_nam_prep_seafluxn.F90
index 587b73d63dc483f59cf91e0bc07d7b72467055e8..8d6a54218f96e51d90752e72fad63b042f684f44 100644
--- a/src/SURFEX/read_nam_prep_seafluxn.F90
+++ b/src/SURFEX/read_nam_prep_seafluxn.F90
@@ -40,19 +40,19 @@ NMONTH=NUNDEF
NDAY=NUNDEF
XTIME=XUNDEF
!
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
+CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
- CALL DEFAULT_PREP_SEAFLUX
+CALL DEFAULT_PREP_SEAFLUX
!
- CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
- CALL POSNAM(ILUNAM,'NAM_PREP_SEAFLUX',GFOUND,ILUOUT)
+CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
+CALL POSNAM(ILUNAM,'NAM_PREP_SEAFLUX',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_PREP_SEAFLUX)
- CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
+CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
!
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CTYPE_SEAFLX', CTYPE_SEAFLX, ' ','GRIB ','MESONH',&
+CALL TEST_NAM_VAR_SURF(ILUOUT,'CTYPE_SEAFLX', CTYPE_SEAFLX, ' ','GRIB ','MESONH',&
'ASCII ','NETCDF','LFI ','FA ')
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CTYPEPGD', CTYPEPGD, ' ','GRIB ','MESONH','ASCII ','LFI ','FA ')
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CSEAICE_SCHEME',CSEAICE_SCHEME,'GELATO','NONE ')
+CALL TEST_NAM_VAR_SURF(ILUOUT,'CTYPEPGD', CTYPEPGD, ' ','GRIB ','MESONH','ASCII ','LFI ','FA ')
+CALL TEST_NAM_VAR_SURF(ILUOUT,'CSEAICE_SCHEME',CSEAICE_SCHEME,'GELATO','NONE ')
!
IF (LHOOK) CALL DR_HOOK('READ_NAM_PREP_SEAFLUX_N',1,ZHOOK_HANDLE)
!------------------------------------
diff --git a/src/SURFEX/read_nam_prep_surfn.F90 b/src/SURFEX/read_nam_prep_surfn.F90
index 0f002d49fbafe276da222ae0730d08809d00cdea..54f56b0c6090f43f2a032ac2959fe6eb28aa13c1 100644
--- a/src/SURFEX/read_nam_prep_surfn.F90
+++ b/src/SURFEX/read_nam_prep_surfn.F90
@@ -34,16 +34,17 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('READ_NAM_PREP_SURF_N',0,ZHOOK_HANDLE)
!
-NHALO_PREP = 2
+NHALO_PREP = 0
!
NYEAR=NUNDEF
NMONTH=NUNDEF
NDAY=NUNDEF
XTIME=XUNDEF
- CFILE = ' '
- CFILETYPE = ' '
- CFILEPGD = ' '
- CFILEPGDTYPE = ' '
+CFILE = ' '
+CFILETYPE = ' '
+CFILEPGD = ' '
+CFILEPGDTYPE = ' '
+LWRITE_EXTERN = .FALSE.
!
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
@@ -53,8 +54,10 @@ XTIME=XUNDEF
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_PREP_SURF_ATM)
CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
!
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CFILETYPE', CFILETYPE, ' ','GRIB ','MESONH','ASCII ','LFI ','FA ')
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CFILEPGDTYPE', CFILEPGDTYPE, ' ','GRIB ','MESONH','ASCII ','LFI ','FA ')
+ CALL TEST_NAM_VAR_SURF(ILUOUT,'CFILETYPE', CFILETYPE, ' ','GRIB ','MESONH','ASCII ','LFI ',&
+ 'FA ','NC ')
+ CALL TEST_NAM_VAR_SURF(ILUOUT,'CFILEPGDTYPE', CFILEPGDTYPE, ' ','GRIB ','MESONH','ASCII ',&
+ 'LFI ','FA ','NC ')
IF (LHOOK) CALL DR_HOOK('READ_NAM_PREP_SURF_N',1,ZHOOK_HANDLE)
!
END SUBROUTINE READ_NAM_PREP_SURF_n
diff --git a/src/SURFEX/read_namelists_assim.F90 b/src/SURFEX/read_namelists_assim.F90
index c8f817d77c0ac76190750f0be22e9287f9766fd3..38c7aeb3b81f4328a75f35f89a825710352c52ea 100644
--- a/src/SURFEX/read_namelists_assim.F90
+++ b/src/SURFEX/read_namelists_assim.F90
@@ -16,11 +16,11 @@ USE MODD_ASSIM, ONLY : LASSIM,CASSIM,CASSIM_ISBA,NPRINTLEV,LAROME,LECS
LOBSWG,LOBS2M,LIMVEG,XSPRECIP2,XRTHR_QC,XSIGWGO_MAX, &
XRSCAL_JAC,LPRT,LSIM,LBEV,LBFIXED,NOBSTYPE, &
LOBSHEADER,CFILE_FORMAT_LSM,CFILE_FORMAT_OBS, &
- CFILE_FORMAT_FG,CFILE_FORMAT_CLIM,XERROBS_M,XQCOBS_M,&
- NNCO,NIVAR,NVAR,CVAR_M,CPREFIX_M,XSIGMA_M,XTPRT_M, &
- NNCV,XSCALE_Q,XSCALE_QLAI,CBIO,CPREFIX_BIO,XALPH, &
- NENS,NIE,XINFL_M,XADDINFL_M,XASSIM_WINH,LOBSNAT, &
- XADDTIMECORR_M,LENS_GEN,LPB_CORRELATIONS, &
+ CFILE_FORMAT_FG,CFILE_FORMAT_CLIM,COBS_M,XERROBS_M, &
+ XQCOBS_M,NNCO,NIVAR,NVAR,CVAR_M,CPREFIX_M,XSIGMA_M, &
+ XTPRT_M,NNCV,XSCALE_Q,XSCALE_QLAI,CBIO,CPREFIX_BIO, &
+ XALPH,NENS,NIE,XINFL_M,XADDINFL_M,XASSIM_WINH, &
+ LOBSNAT,XADDTIMECORR_M,LENS_GEN,LPB_CORRELATIONS, &
LPERTURBATION_RUN,LBIAS_CORRECTION,LENKF,LDENKF
!
USE MODI_DEFAULT_ASSIM
@@ -32,14 +32,14 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!---------------------------------------------------
IF (LHOOK) CALL DR_HOOK('READ_NAMELISTS_ASSIM',0,ZHOOK_HANDLE)
! Set default assimilation options/schemes
- CALL DEFAULT_ASSIM(LASSIM,CASSIM,CASSIM_ISBA,NPRINTLEV, &
+CALL DEFAULT_ASSIM(LASSIM,CASSIM,CASSIM_ISBA,NPRINTLEV, &
LAROME,LECSST,LAESST,LAESNM, &
LALADSURF,LREAD_SST_FROM_FILE, &
CFILE_FORMAT_SST,LEXTRAP_SEA, &
@@ -50,7 +50,7 @@ IF (LHOOK) CALL DR_HOOK('READ_NAMELISTS_ASSIM',0,ZHOOK_HANDLE)
XRTHR_QC,XSIGWGO_MAX,XRSCAL_JAC,LPRT, &
LSIM,LBEV,LBFIXED,NOBSTYPE,LOBSHEADER, &
CFILE_FORMAT_OBS,LOBSNAT,CFILE_FORMAT_FG, &
- CFILE_FORMAT_LSM,CFILE_FORMAT_CLIM, &
+ CFILE_FORMAT_LSM,CFILE_FORMAT_CLIM,COBS_M,&
XERROBS_M,XQCOBS_M,NNCO,NIVAR,NVAR,CVAR_M,&
CPREFIX_M,XSIGMA_M,XTPRT_M,NNCV,XSCALE_Q, &
XSCALE_QLAI,CBIO,CPREFIX_BIO,XALPH, &
@@ -60,10 +60,10 @@ IF (LHOOK) CALL DR_HOOK('READ_NAMELISTS_ASSIM',0,ZHOOK_HANDLE)
LENKF,LDENKF,'OK')
!
! Set default assimilations values/constants
- CALL INI_ASSIM
+CALL INI_ASSIM
!
! Override with namelist values
- CALL READ_ASSIM_CONF(HPROGRAM)
+CALL READ_ASSIM_CONF(HPROGRAM)
IF (LHOOK) CALL DR_HOOK('READ_NAMELISTS_ASSIM',1,ZHOOK_HANDLE)
!---------------------------------------------------------
diff --git a/src/SURFEX/read_namelists_flaken.F90 b/src/SURFEX/read_namelists_flaken.F90
index 17755fc4847c14f2e23c56974dfbf2413c5937b4..267a301c8ca554fb5f9ae749f56d5b19894ecede 100644
--- a/src/SURFEX/read_namelists_flaken.F90
+++ b/src/SURFEX/read_namelists_flaken.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE READ_NAMELISTS_FLAKE_n (FM, &
- HPROGRAM, HINIT)
+SUBROUTINE READ_NAMELISTS_FLAKE_n (FM, HPROGRAM, HINIT)
! #######################################################
!
!---------------------------
@@ -47,11 +46,9 @@ IF (LHOOK) CALL DR_HOOK('READ_NAMELISTS_FLAKE_N',0,ZHOOK_HANDLE)
LWATER_PROFILE,LSURF_BUDGETC,LRESET_BUDGETC,XDIAG_TSTEP, &
XZWAT_PROFILE )
!
- CALL READ_DEFAULT_FLAKE_n(FM%CHF, FM%DGF, FM%DGMF, FM%F, &
- HPROGRAM)
+ CALL READ_DEFAULT_FLAKE_n(FM%CHF, FM%DFO, FM%DMF, FM%F, HPROGRAM)
!
- CALL READ_FLAKE_CONF_n(FM%CHF, FM%DGF, FM%DGMF, FM%F, &
- HPROGRAM)
+ CALL READ_FLAKE_CONF_n(FM%CHF, FM%DFO, FM%DMF, FM%F, HPROGRAM)
!
!----------------------------------------------------------------------------
!
diff --git a/src/SURFEX/read_namelists_idealn.F90 b/src/SURFEX/read_namelists_idealn.F90
index f9a2680638cbbb10bdce52d7f4b5e80f7d1e6c5c..3eea7b9719039656eb9b4d777cdcdee32ff21c1c 100644
--- a/src/SURFEX/read_namelists_idealn.F90
+++ b/src/SURFEX/read_namelists_idealn.F90
@@ -3,15 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE READ_NAMELISTS_IDEAL_n (DGL, &
- HPROGRAM)
+SUBROUTINE READ_NAMELISTS_IDEAL_n (DGO, HPROGRAM)
! #######################################################
!
!--------------------------------------------------------------------------
!
!
!
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
!
USE MODN_IDEAL_n
!
@@ -26,7 +25,7 @@ USE PARKIND1 ,ONLY : JPRB
IMPLICIT NONE
!
!
-TYPE(DIAG_IDEAL_t), INTENT(INOUT) :: DGL
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -37,11 +36,10 @@ IF (LHOOK) CALL DR_HOOK('READ_NAMELISTS_IDEAL_N',0,ZHOOK_HANDLE)
CALL DEFAULT_DIAG_IDEAL(N2M,LSURF_BUDGET,L2M_MIN_ZS,LRAD_BUDGET,LCOEF,LSURF_VARS,&
LSURF_BUDGETC,LRESET_BUDGETC,XDIAG_TSTEP )
!
- CALL READ_DEFAULT_IDEAL_n(DGL, &
- HPROGRAM)
+ CALL READ_DEFAULT_IDEAL_n(DGO, HPROGRAM)
!
- CALL READ_IDEAL_CONF_n(DGL, &
- HPROGRAM)
+ CALL READ_IDEAL_CONF_n(DGO, HPROGRAM)
+ !
IF (LHOOK) CALL DR_HOOK('READ_NAMELISTS_IDEAL_N',1,ZHOOK_HANDLE)
!
END SUBROUTINE READ_NAMELISTS_IDEAL_n
diff --git a/src/SURFEX/read_namelists_isban.F90 b/src/SURFEX/read_namelists_isban.F90
index 01ebc562008acfafc12f352a2a2d6a9a57317a34..36e969351139507ee41c8277b8b8104a7a4d8e71 100644
--- a/src/SURFEX/read_namelists_isban.F90
+++ b/src/SURFEX/read_namelists_isban.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE READ_NAMELISTS_ISBA_n (IM, &
- HPROGRAM, HINIT)
+SUBROUTINE READ_NAMELISTS_ISBA_n (IM, HPROGRAM, HINIT)
! #######################################################
!
!---------------------------
@@ -54,8 +53,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!------------------------------------
!
IF (LHOOK) CALL DR_HOOK('READ_NAMELISTS_ISBA_N',0,ZHOOK_HANDLE)
- CALL DEFAULT_ISBA(XTSTEP, XOUT_TSTEP, &
- CROUGH,CRUNOFF,CALBEDO,CSCOND, &
+ CALL DEFAULT_ISBA(XTSTEP, XOUT_TSTEP, &
+ CRUNOFF, CSCOND, &
CC1DRY, CSOILFRZ, CDIFSFCOND, CSNOWRES, &
CCPSURF, XCGMAX, XCDRAG, CKSAT, LSOC, &
CRAIN, CHORT, LGLACIER, LCANOPY_DRAG, &
@@ -66,21 +65,19 @@ IF (LHOOK) CALL DR_HOOK('READ_NAMELISTS_ISBA_N',0,ZHOOK_HANDLE)
CALL DEFAULT_CH_DEP(CCH_DRY_DEP)
CALL DEFAULT_CH_BIO_FLUX(LCH_BIO_FLUX)
!
- CALL DEFAULT_DIAG_ISBA(N2M,LSURF_BUDGET,L2M_MIN_ZS,LRAD_BUDGET, &
+ CALL DEFAULT_DIAG_ISBA(N2M,LSURF_BUDGET,L2M_MIN_ZS,LRAD_BUDGET, &
LCOEF,LSURF_VARS,LSURF_EVAP_BUDGET, &
LSURF_MISC_BUDGET,LSURF_DIAG_ALBEDO, &
LSURF_BUDGETC,LSURF_MISC_DIF,LPATCH_BUDGET,&
- LPGD,LRESET_BUDGETC,LWATER_BUDGET, &
- XDIAG_TSTEP )
+ LPGD,LRESET_BUDGETC,LWATER_BUDGET,LPROSNOW,&
+ LVOLUMETRIC_SNOWLIQ,XDIAG_TSTEP )
!
CALL DEFAULT_CROCUS(LSNOWDRIFT,LSNOWDRIFT_SUBLIM,LSNOW_ABS_ZENITH,&
CSNOWMETAMO,CSNOWRAD)
!
- CALL READ_DEFAULT_ISBA_n(IM%CHI, IM%DGEI, IM%DGI, IM%DGMI, IM%I, &
- HPROGRAM)
+ CALL READ_DEFAULT_ISBA_n(IM%CHI, IM%ID%DE, IM%ID%O, IM%ID%DM, IM%O, HPROGRAM)
!
- CALL READ_ISBA_CONF_n(IM%CHI, IM%DGEI, IM%DGI, IM%DGMI, IM%I, &
- HPROGRAM)
+ CALL READ_ISBA_CONF_n(IM%CHI, IM%ID%DE, IM%ID%O, IM%ID%DM, IM%O, HPROGRAM)
!
!
SODELX(:) = XUNDEF
diff --git a/src/SURFEX/read_namelists_seafluxn.F90 b/src/SURFEX/read_namelists_seafluxn.F90
index b7509b39fb671c467adc669713339d6623a4e175..0a6bb1e652fc99ac8ac27eed852ab07a8c8f0b47 100644
--- a/src/SURFEX/read_namelists_seafluxn.F90
+++ b/src/SURFEX/read_namelists_seafluxn.F90
@@ -41,23 +41,23 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('READ_NAMELISTS_SEAFLUX_N',0,ZHOOK_HANDLE)
!
- CALL DEFAULT_SEAFLUX(XTSTEP,XOUT_TSTEP,CSEA_ALB,CSEA_FLUX,LPWG, &
+CALL DEFAULT_SEAFLUX(XTSTEP,XOUT_TSTEP,CSEA_ALB,CSEA_FLUX,LPWG, &
LPRECIP,LPWEBB,NZ0,NGRVWAVES,LPROGSST, &
NTIME_COUPLING,XOCEAN_TSTEP,XICHCE,CINTERPOL_SST,&
CINTERPOL_SSS)
- CALL DEFAULT_SEAICE(HPROGRAM, CINTERPOL_SIC, CINTERPOL_SIT, &
+CALL DEFAULT_SEAICE(HPROGRAM, CINTERPOL_SIC, CINTERPOL_SIT, &
XFREEZING_SST,XSEAICE_TSTEP, XSIC_EFOLDING_TIME, &
XSIT_EFOLDING_TIME, XCD_ICE_CST, XSI_FLX_DRV )
!
- CALL DEFAULT_CH_DEP(CCH_DRY_DEP)
+CALL DEFAULT_CH_DEP(CCH_DRY_DEP)
!
- CALL DEFAULT_DIAG_SEAFLUX(N2M,LSURF_BUDGET,L2M_MIN_ZS,LRAD_BUDGET,LCOEF,LSURF_VARS,&
- LDIAG_OCEAN,LDIAG_SEAICE,LSURF_BUDGETC,LRESET_BUDGETC,XDIAG_TSTEP)
+CALL DEFAULT_DIAG_SEAFLUX(N2M,LSURF_BUDGET,L2M_MIN_ZS,LRAD_BUDGET,LCOEF,LSURF_VARS,&
+ LDIAG_OCEAN,LDIAG_MISC_SEAICE,LSURF_BUDGETC,LRESET_BUDGETC,XDIAG_TSTEP)
!
- CALL READ_DEFAULT_SEAFLUX_n(SM%CHS, SM%DGO, SM%DGS, SM%DGSI, SM%O, SM%S, &
+CALL READ_DEFAULT_SEAFLUX_n(SM%CHS, SM%SD%GO, SM%SD%O, SM%SD%DMI, SM%O, SM%S, &
HPROGRAM)
!
- CALL READ_SEAFLUX_CONF_n(SM%CHS, SM%DGO, SM%DGS, SM%DGSI, SM%O, SM%S, &
+CALL READ_SEAFLUX_CONF_n(SM%CHS, SM%SD%GO, SM%SD%O, SM%SD%DMI, SM%O, SM%S, &
HPROGRAM)
!
IF (HINIT=='PRE') CALL READ_NAM_PREP_SEAFLUX_n(HPROGRAM)
diff --git a/src/SURFEX/read_namelists_surf.F90 b/src/SURFEX/read_namelists_surf.F90
index 9e31bff9e58eb4cc65476c4bcaed51f3a724012c..3be4c4f2654229ad46894f58bc85528e881116d9 100644
--- a/src/SURFEX/read_namelists_surf.F90
+++ b/src/SURFEX/read_namelists_surf.F90
@@ -22,7 +22,7 @@ USE MODD_SURF_ATM, ONLY : XCISMIN, XVMODMIN, LALDTHRES, &
LVSHIFT_PRCP, &
XCO2UNCPL
!
-USE MODD_WRITE_SURF_ATM, ONLY : LNOWRITE_CANOPY, LNOWRITE_TEXFILE
+USE MODD_WRITE_SURF_ATM, ONLY : LNOWRITE_CANOPY, LNOWRITE_TEXFILE, LSPLIT_PATCH
!
USE MODI_DEFAULT_SURF_ATM
USE MODI_DEFAULT_WRITE_SURF_ATM
@@ -61,14 +61,14 @@ IF (LHOOK) CALL DR_HOOK('READ_NAMELISTS_SURF',0,ZHOOK_HANDLE)
LQVNPLUS, LVERTSHIFT, LVSHIFT_LW, &
LVSHIFT_PRCP, XCO2UNCPL )
!
- CALL DEFAULT_WRITE_SURF_ATM(LNOWRITE_CANOPY, LNOWRITE_TEXFILE)
+ CALL DEFAULT_WRITE_SURF_ATM(LNOWRITE_CANOPY, LNOWRITE_TEXFILE, LSPLIT_PATCH)
!
CALL READ_DEFAULT_SURF_ATM(HPROGRAM)
!
CALL READ_SURF_ATM_CONF(HPROGRAM)
!
!
- CPROGNAME=HPROGRAM
+CPROGNAME=HPROGRAM
CALL INI_CSTS
!
CALL READ_NAM_WRITE_COVER_TEX(HPROGRAM)
diff --git a/src/SURFEX/read_namelists_surfn.F90 b/src/SURFEX/read_namelists_surfn.F90
index 4c2a3317d4d8629f76108c54a1c1a3e0129090e8..01c68633a82152366a8d0eb6ef419e98196871d4 100644
--- a/src/SURFEX/read_namelists_surfn.F90
+++ b/src/SURFEX/read_namelists_surfn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE READ_NAMELISTS_SURF_n (CHU, DGU, USS, &
- HPROGRAM,HINIT)
+SUBROUTINE READ_NAMELISTS_SURF_n (CHU, DGO, USS, HPROGRAM,HINIT)
! #######################################################
!
!---------------------------
@@ -12,8 +11,8 @@ SUBROUTINE READ_NAMELISTS_SURF_n (CHU, DGU, USS, &
!
!
USE MODD_CH_SURF_n, ONLY : CH_SURF_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODN_SURF_ATM_n
!
@@ -41,8 +40,8 @@ IMPLICIT NONE
!
!
TYPE(CH_SURF_t), INTENT(INOUT) :: CHU
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize
@@ -55,16 +54,14 @@ IF (LHOOK) CALL DR_HOOK('READ_NAMELISTS_SURF_N',0,ZHOOK_HANDLE)
!
CALL DEFAULT_CH_SURF_ATM(CCHEM_SURF_FILE,LCH_SURF_EMIS)
!
- CALL DEFAULT_DIAG_SURF_ATM(N2M,LT2MMW,LSURF_BUDGET,L2M_MIN_ZS,LRAD_BUDGET, &
- LCOEF,LSURF_VARS,LSURF_BUDGETC, &
- LRESET_BUDGETC,LSELECT, LPROVAR_TO_DIAG, &
- LDIAG_GRID,LFRAC, XDIAG_TSTEP, CSELECT )
+CALL DEFAULT_DIAG_SURF_ATM(N2M, LT2MMW, LSURF_BUDGET, L2M_MIN_ZS, LRAD_BUDGET, &
+ LCOEF, LSURF_VARS, LSURF_BUDGETC, LRESET_BUDGETC, &
+ LSELECT, LPROVAR_TO_DIAG, LDIAG_GRID, LFRAC, &
+ XDIAG_TSTEP, LSNOWDIMNC, LRESETCUMUL, CSELECT )
!
- CALL READ_DEFAULT_SURF_ATM_n(CHU, DGU, USS, &
- HPROGRAM)
+ CALL READ_DEFAULT_SURF_ATM_n(CHU, DGO, USS, HPROGRAM)
!
- CALL READ_SURF_ATM_CONF_n(CHU, DGU, USS, &
- HPROGRAM)
+ CALL READ_SURF_ATM_CONF_n(CHU, DGO, USS, HPROGRAM)
!
!---------------------------------------------------------------------------
!PREP
diff --git a/src/SURFEX/read_namelists_tebn.F90 b/src/SURFEX/read_namelists_tebn.F90
index 2dfb870e991887d3ee4c9766268e1c8387128904..784beee7c69c2a22ec37a1206eba62dce2475f0c 100644
--- a/src/SURFEX/read_namelists_tebn.F90
+++ b/src/SURFEX/read_namelists_tebn.F90
@@ -3,19 +3,17 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE READ_NAMELISTS_TEB_n (TM, TGRO, TVG, &
- HPROGRAM, HINIT)
+SUBROUTINE READ_NAMELISTS_TEB_n (TM, GRO, GDO, HPROGRAM, HINIT)
! #######################################################
!
!---------------------------------------------------------------------------
!
!
USE MODD_SURFEX_n, ONLY : TEB_MODEL_t
-USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
USE MODN_TEB_n
-USE MODN_TEB_VEG_n, ONLY: CROUGH,CRUNOFF,CALBEDO,CSCOND, &
+USE MODN_TEB_VEG_n, ONLY: CRUNOFF,CSCOND, &
CC1DRY, CSOILFRZ, CDIFSFCOND, CSNOWRES, &
CCPSURF, XCGMAX, CKSAT, &
CRAIN, CHORT, LGLACIER, &
@@ -44,8 +42,8 @@ IMPLICIT NONE
!
!
TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM
-TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: TGRO
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: GRO
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: GDO
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize
@@ -56,29 +54,27 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('READ_NAMELISTS_TEB_N',0,ZHOOK_HANDLE)
CALL DEFAULT_TEB(CZ0H,XTSTEP,XOUT_TSTEP, CCH_BEM, XDT_RES, XDT_OFF)
!
- CALL DEFAULT_TEB_VEG(CROUGH,CRUNOFF,CALBEDO,CSCOND, &
- CC1DRY, CSOILFRZ, CDIFSFCOND, CSNOWRES, &
- CCPSURF, XCGMAX, CKSAT, &
- CRAIN, CHORT, LGLACIER, &
- LCANOPY_DRAG, LVEGUPD, LNITRO_DILU )
+ CALL DEFAULT_TEB_VEG(CRUNOFF, CSCOND, &
+ CC1DRY, CSOILFRZ, CDIFSFCOND, CSNOWRES, &
+ CCPSURF, XCGMAX, CKSAT, &
+ CRAIN, CHORT, LGLACIER, &
+ LCANOPY_DRAG, LVEGUPD, LNITRO_DILU )
!
- CALL DEFAULT_GREENROOF(CRUNOFF_GR,CSCOND_GR, &
- CKSAT_GR,CHORT_GR)
+ CALL DEFAULT_GREENROOF(CRUNOFF_GR,CSCOND_GR, CKSAT_GR,CHORT_GR)
!
CALL DEFAULT_CH_DEP(CCH_DRY_DEP)
!
CALL DEFAULT_DIAG_TEB(N2M,LSURF_BUDGET,L2M_MIN_ZS,LRAD_BUDGET, &
LCOEF,LSURF_VARS,LSURF_MISC_BUDGET,&
- LSURF_DIAG_ALBEDO,LUTCI,LPGD,LPGD_FIX,XDIAG_TSTEP)
+ LSURF_DIAG_ALBEDO,LUTCI,LPGD,XDIAG_TSTEP)
!
- CALL READ_DEFAULT_TEB_n(TM%CHT, TM%DGMTO, TM%DGT, TM%DGUT, TGRO, TM%T, TM%TOP, &
+ CALL READ_DEFAULT_TEB_n(TM%CHT, TM%TD%MTO, TM%TD%O, TM%TD%DUT, GRO, TM%NT%AL(1), TM%TOP, &
HPROGRAM)
!
- CALL READ_TEB_CONF_n(TM%CHT, TM%DGMTO, TM%DGT, TM%DGUT, TM%T, TM%TOP, &
+ CALL READ_TEB_CONF_n(TM%CHT, TM%TD%MTO, TM%TD%O, TM%TD%DUT, TM%NT%AL(1), TM%TOP, &
HPROGRAM)
!
- CALL READ_TEB_VEG_CONF_n(TM%CHT, TVG, &
- HPROGRAM)
+ CALL READ_TEB_VEG_CONF_n(TM%CHT, GDO, HPROGRAM)
!
IF (HINIT=='PRE') THEN
CALL READ_NAM_PREP_TEB_n(HPROGRAM)
diff --git a/src/SURFEX/read_namelists_watfluxn.F90 b/src/SURFEX/read_namelists_watfluxn.F90
index d2019bc5772afef6d8f1da81e811f0fb18682098..c6f8dc3a2f90db3b7490f0025705af72153129a6 100644
--- a/src/SURFEX/read_namelists_watfluxn.F90
+++ b/src/SURFEX/read_namelists_watfluxn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE READ_NAMELISTS_WATFLUX_n (WM, &
- HPROGRAM,HINIT)
+SUBROUTINE READ_NAMELISTS_WATFLUX_n (WM, HPROGRAM,HINIT)
! #######################################################
!
! --------------------------------------------------------------------------
@@ -47,11 +46,9 @@ IF (LHOOK) CALL DR_HOOK('READ_NAMELISTS_WATFLUX_N',0,ZHOOK_HANDLE)
CALL DEFAULT_DIAG_WATFLUX(N2M,LSURF_BUDGET,L2M_MIN_ZS,LRAD_BUDGET,LCOEF,LSURF_VARS, &
LSURF_BUDGETC,LRESET_BUDGETC,XDIAG_TSTEP )
!
- CALL READ_DEFAULT_WATFLUX_n(WM%CHW, WM%DGW, WM%W, &
- HPROGRAM)
+ CALL READ_DEFAULT_WATFLUX_n(WM%CHW, WM%DWO, WM%W, HPROGRAM)
!
- CALL READ_WATFLUX_CONF_n(WM%CHW, WM%DGW, WM%W, &
- HPROGRAM)
+ CALL READ_WATFLUX_CONF_n(WM%CHW, WM%DWO, WM%W, HPROGRAM)
!
!----------------------------------------------------------------------------
!
diff --git a/src/SURFEX/read_netcdf.F90 b/src/SURFEX/read_netcdf.F90
index bfa6d218fbf4aa10729761227bbd2a9917cbeb45..bdd337748e285b1dd8725e6c0abf392282f98e1e 100644
--- a/src/SURFEX/read_netcdf.F90
+++ b/src/SURFEX/read_netcdf.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_NETCDF (USS, &
+ SUBROUTINE READ_NETCDF (UG, U, USS, &
HPROGRAM,HSUBROUTINE,HFILENAME,HNCVARNAME)
! ##############################################################
!
@@ -29,8 +29,9 @@
! -----------
!
!
-!
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_PGD_GRID, ONLY : LLATLONMASK
!
@@ -48,7 +49,9 @@ IMPLICIT NONE
! ------------------------
!
!
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
CHARACTER(LEN=6), INTENT(IN) :: HSUBROUTINE ! Name of the subroutine to call
@@ -115,7 +118,7 @@ DO JLOOP=1,SIZE(ZVALU)
!* 5. Call to the adequate subroutine (point by point treatment)
! ----------------------------------------------------------
!
- CALL PT_BY_PT_TREATMENT(USS, &
+ CALL PT_BY_PT_TREATMENT(UG, U, USS, &
ILUOUT, (/ ZLAT /) , (/ ZLON /) , (/ ZVALUE /) , &
HSUBROUTINE )
!
diff --git a/src/SURFEX/read_oceann.F90 b/src/SURFEX/read_oceann.F90
index a43fef5097758e2af87f78d6ffe111bdd0ebdc3d..ac9e6af5fca033cd7ac92bccefc2653790ea9075 100644
--- a/src/SURFEX/read_oceann.F90
+++ b/src/SURFEX/read_oceann.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_OCEAN_n (DTCO, O, OR, U, &
- HPROGRAM)
+ SUBROUTINE READ_OCEAN_n (DTCO, O, OR, U, HPROGRAM)
! #########################################
!
!!**** *READ_OCEAN_n* - read oceanic variables
@@ -98,8 +97,7 @@ IF (LHOOK) CALL DR_HOOK('READ_OCEAN_N',0,ZHOOK_HANDLE)
O%NOCTCOUNT=0
!
YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
!
!* flag to use or not Ocean model
!
@@ -107,19 +105,19 @@ IF (IVERSION<=3) THEN
O%LMERCATOR=.FALSE.
ELSE
YRECFM='SEA_OCEAN'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,O%LMERCATOR,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,O%LMERCATOR,IRESP)
ENDIF
!
IF (.NOT. O%LMERCATOR) THEN
ALLOCATE(O%XSEAT(0,0))
+ ALLOCATE(O%XSEAS(0,0))
+ ALLOCATE(O%XSEAU(0,0))
+ ALLOCATE(O%XSEAV(0,0))
ALLOCATE(OR%XSEAT_REL(0,0))
- ALLOCATE(O%XSEAS(0,0))
ALLOCATE(OR%XSEAS_REL(0,0))
ALLOCATE(OR%XSEAU_REL(0,0))
ALLOCATE(OR%XSEAV_REL(0,0))
- ALLOCATE(O%XSEAU(0,0))
- ALLOCATE(O%XSEAV(0,0))
+ !
ALLOCATE(O%XSEAE(0,0))
ALLOCATE(O%XSEABATH(0,0))
ALLOCATE(O%XSEAHMO(0))
@@ -153,34 +151,26 @@ END DO
!
! Relaxation time and logical
YRECFM='TAU_REL_OC'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,OR%XTAU_REL,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,OR%XTAU_REL,IRESP)
!
YRECFM='LREL_CUR_OC'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,OR%LREL_CUR,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,OR%LREL_CUR,IRESP)
YRECFM='LREL_TS_OC'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,OR%LREL_TS,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,OR%LREL_TS,IRESP)
YRECFM='LFLX_NULL_OC'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,OR%LFLUX_NULL,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,OR%LFLUX_NULL,IRESP)
YRECFM='LFLX_CORR_OC'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,OR%LFLX_CORR,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,OR%LFLX_CORR,IRESP)
YRECFM='CORR_FLX_OC'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,OR%XQCORR,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,OR%XQCORR,IRESP)
YRECFM='LDIAPYC_OC'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,OR%LDIAPYCNAL,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,OR%LDIAPYCNAL,IRESP)
!
!* 1D physical dimension
!
YRECFM='SIZE_SEA'
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'SEA ',ILU)
+ CALL GET_TYPE_DIM_n(DTCO, U, 'SEA ',ILU)
!
!* 2. Prognostic fields:
! -----------------
@@ -193,8 +183,7 @@ ALLOCATE(O%XSEAT(ILU,NOCKMIN:NOCKMAX))
DO JLEVEL=NOCKMIN+1,NOCKMAX
WRITE(YLVL,'(I4)') JLEVEL
YRECFM='TEMP_OC'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ZWORK(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP)
O%XSEAT(:,JLEVEL)=ZWORK(:)
END DO
O%XSEAT(:,NOCKMIN)=O%XSEAT(:,NOCKMIN+1)
@@ -206,8 +195,7 @@ ALLOCATE(OR%XSEAT_REL(ILU,NOCKMIN:NOCKMAX))
DO JLEVEL=NOCKMIN+1,NOCKMAX
WRITE(YLVL,'(I4)') JLEVEL
YRECFM='T_OC_REL'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ZWORK(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP)
OR%XSEAT_REL(:,JLEVEL)=ZWORK(:)
END DO
OR%XSEAT_REL(:,NOCKMIN)=OR%XSEAT_REL(:,NOCKMIN+1)
@@ -219,8 +207,7 @@ ALLOCATE(O%XSEAS(ILU,NOCKMIN:NOCKMAX))
DO JLEVEL=NOCKMIN+1,NOCKMAX
WRITE(YLVL,'(I4)') JLEVEL
YRECFM='SALT_OC'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ZWORK(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP)
O%XSEAS(:,JLEVEL)=ZWORK(:)
END DO
O%XSEAS(:,NOCKMIN)=O%XSEAS(:,NOCKMIN+1)
@@ -232,8 +219,7 @@ ALLOCATE(OR%XSEAS_REL(ILU,NOCKMIN:NOCKMAX))
DO JLEVEL=NOCKMIN+1,NOCKMAX
WRITE(YLVL,'(I4)') JLEVEL
YRECFM='S_OC_REL'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ZWORK(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP)
OR%XSEAS_REL(:,JLEVEL)=ZWORK(:)
END DO
OR%XSEAS_REL(:,NOCKMIN)=OR%XSEAS_REL(:,NOCKMIN+1)
@@ -246,8 +232,7 @@ ALLOCATE(OR%XSEAV_REL(ILU,NOCKMIN:NOCKMAX))
DO JLEVEL=NOCKMIN+1,NOCKMAX
WRITE(YLVL,'(I4)') JLEVEL
YRECFM='U_OC_REL'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ZWORK(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP)
OR%XSEAU_REL(:,JLEVEL)=ZWORK(:)
END DO
OR%XSEAU_REL(:,NOCKMIN)=OR%XSEAU_REL(:,NOCKMIN+1)
@@ -255,8 +240,7 @@ OR%XSEAU_REL(:,NOCKMIN)=OR%XSEAU_REL(:,NOCKMIN+1)
DO JLEVEL=NOCKMIN+1,NOCKMAX
WRITE(YLVL,'(I4)') JLEVEL
YRECFM='V_OC_REL'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ZWORK(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP)
OR%XSEAV_REL(:,JLEVEL)=ZWORK(:)
END DO
OR%XSEAV_REL(:,NOCKMIN)=OR%XSEAV_REL(:,NOCKMIN+1)
@@ -267,15 +251,13 @@ ALLOCATE(O%XSEAV(ILU,NOCKMIN:NOCKMAX))
DO JLEVEL=NOCKMIN+1,NOCKMAX
WRITE(YLVL,'(I4)') JLEVEL
YRECFM='UCUR_OC'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ZWORK(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP)
O%XSEAU(:,JLEVEL)=ZWORK(:)
END DO
DO JLEVEL=NOCKMIN+1,NOCKMAX
WRITE(YLVL,'(I4)') JLEVEL
YRECFM='VCUR_OC'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ZWORK(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP)
O%XSEAV(:,JLEVEL)=ZWORK(:)
END DO
O%XSEAU(:,NOCKMIN)=O%XSEAU(:,NOCKMIN+1)
@@ -288,8 +270,7 @@ ALLOCATE(O%XSEAE(ILU,NOCKMIN:NOCKMAX))
DO JLEVEL=NOCKMIN+1,NOCKMAX
WRITE(YLVL,'(I4)') JLEVEL
YRECFM='TKE_OC'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ZWORK(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP)
O%XSEAE(:,JLEVEL)=ZWORK(:)
END DO
O%XSEAE(:,NOCKMIN)=O%XSEAE(:,NOCKMIN+1)
@@ -307,8 +288,7 @@ ALLOCATE(O%XSEABATH(ILU,NOCKMIN:NOCKMAX))
DO JLEVEL=NOCKMIN+1,NOCKMAX
WRITE(YLVL,'(I4)') JLEVEL
YRECFM='SEAINDBATH'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ZWORK(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP)
O%XSEABATH(:,JLEVEL)=ZWORK(:)
END DO
O%XSEABATH(:,NOCKMIN)=1.
@@ -336,8 +316,7 @@ DEALLOCATE(ZWORK)
!-------------------------------------------------------------------------------
ALLOCATE(O%XSEAHMO(ILU))
YRECFM='SEA_HMO'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,O%XSEAHMO(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,O%XSEAHMO(:),IRESP)
!
!-------------------------------------------------------------------------------
ALLOCATE(O%XLE (SIZE(O%XSEAT,1),NOCKMIN:NOCKMAX))
diff --git a/src/SURFEX/read_pgd_flaken.F90 b/src/SURFEX/read_pgd_flaken.F90
index f39244be012b6ead078d4ddd4a122b2c10f42286..aa7b1d0d62c4dc84401bda80bdbd46d1efc37f94 100644
--- a/src/SURFEX/read_pgd_flaken.F90
+++ b/src/SURFEX/read_pgd_flaken.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_PGD_FLAKE_n (DTCO, U, FG, F, &
- HPROGRAM)
+ SUBROUTINE READ_PGD_FLAKE_n (DTCO, U, UG, FG, F, HPROGRAM)
! #########################################
!
!!**** *READ_PGD_FLAKE_n* - read FLAKE physiographic fields
@@ -43,8 +42,9 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_FLAKE_GRID_n, ONLY : FLAKE_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_FLAKE_n, ONLY : FLAKE_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODD_TYPE_DATE_SURF
@@ -56,8 +56,7 @@ USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
USE MODE_READ_SURF_COV, ONLY : READ_SURF_COV
!
USE MODI_READ_SURF
-USE MODI_READ_GRID
-USE MODI_READ_LCOVER
+USE MODI_PACK_INIT
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -72,9 +71,10 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(FLAKE_GRID_t), INTENT(INOUT) :: FG
+TYPE(GRID_t), INTENT(INOUT) :: FG
TYPE(FLAKE_t), INTENT(INOUT) :: F
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
!
@@ -92,9 +92,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('READ_PGD_FLAKE_N',0,ZHOOK_HANDLE)
YRECFM='SIZE_WATER'
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'WATER ',FG%NDIM)
-!
+ CALL GET_TYPE_DIM_n(DTCO, U, 'WATER ',FG%NDIM)
!
!
!* 2. Physiographic data fields:
@@ -103,54 +101,34 @@ YRECFM='SIZE_WATER'
!* cover classes
!
ALLOCATE(F%LCOVER(JPCOVER))
- CALL READ_LCOVER(&
- HPROGRAM,F%LCOVER)
-!
-ALLOCATE(F%XCOVER(FG%NDIM,JPCOVER))
- CALL READ_SURF_COV(&
- HPROGRAM,'COVER',F%XCOVER(:,:),F%LCOVER,IRESP)
-!
-!* orography
-!
ALLOCATE(F%XZS(FG%NDIM))
-YRECFM='ZS'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,F%XZS(:),IRESP)
-!
-!* latitude, longitude
+ALLOCATE(FG%XLAT (FG%NDIM))
+ALLOCATE(FG%XLON (FG%NDIM))
!
-ALLOCATE(FG%XLAT (FG%NDIM))
-ALLOCATE(FG%XLON (FG%NDIM))
-ALLOCATE(FG%XMESH_SIZE(FG%NDIM))
- CALL READ_GRID(&
- HPROGRAM,FG%CGRID,FG%XGRID_PAR,FG%XLAT,FG%XLON,FG%XMESH_SIZE,IRESP)
+ALLOCATE(FG%XMESH_SIZE (FG%NDIM))
+CALL PACK_INIT(DTCO, U, UG,HPROGRAM,'WATER ',FG, F%LCOVER,F%XCOVER,F%XZS)
!
!* FLake parameters
!
ALLOCATE(F%XWATER_DEPTH (FG%NDIM))
YRECFM='WATER_DEPTH'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,F%XWATER_DEPTH(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,F%XWATER_DEPTH(:),IRESP)
!
ALLOCATE(F%XWATER_FETCH (FG%NDIM))
YRECFM='WATER_FETCH'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,F%XWATER_FETCH(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,F%XWATER_FETCH(:),IRESP)
!
ALLOCATE(F%XT_BS (FG%NDIM))
YRECFM='T_BS'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,F%XT_BS(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,F%XT_BS(:),IRESP)
!
ALLOCATE(F%XDEPTH_BS (FG%NDIM))
YRECFM='DEPTH_BS'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,F%XDEPTH_BS(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,F%XDEPTH_BS(:),IRESP)
!
ALLOCATE(F%XEXTCOEF_WATER (FG%NDIM))
YRECFM='EXTCOEF_WAT'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,F%XEXTCOEF_WATER(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,F%XEXTCOEF_WATER(:),IRESP)
!
IF (LHOOK) CALL DR_HOOK('READ_PGD_FLAKE_N',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/read_pgd_isba_parn.F90 b/src/SURFEX/read_pgd_isba_parn.F90
index fea45320787d07dcac18991f1dcea8d362273d18..a54f1248d00e74112b5c94eaab5512336259f4ec 100644
--- a/src/SURFEX/read_pgd_isba_parn.F90
+++ b/src/SURFEX/read_pgd_isba_parn.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_PGD_ISBA_PAR_n (DTCO, U, &
- DTI, IG, I,GCP, &
- HPROGRAM,KSIZE,OLAND_USE,HDIR)
+ SUBROUTINE READ_PGD_ISBA_PAR_n (DTCO, U, GCP, DTI, KDIM, IO, HPROGRAM,KSIZE,OLAND_USE, TPDATE_BEG, TPDATE_END, HDIR)
! ################################################
!
!!**** *READ_PGD_ISBA_PAR_n* - reads ISBA physiographic fields
@@ -36,34 +34,30 @@
!! Original 01/2003
!! P. Le Moigne 12/2004 : add type of photosynthesis
!! P. Samuelsson 02/2012 : MEB
-!! M.Moge 01/2016 using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads
!! B. Decharme 01/16 : Bug when vegetation veg, z0 and emis are imposed whith interactive vegetation
-!!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-!
-!
-!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_TYPE_DATE_SURF, ONLY : DATE
!
USE MODD_ASSIM, ONLY : LREAD_ALL, LASSIM
!
-USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, NVEGTYPE_OLD, NVEGTYPE_ECOSG
USE MODD_PREP, ONLY : LINTERP
!
-!
USE MODI_GET_LUOUT
USE MODI_READ_SURF
-USE MODI_READ_SURF_FIELD2D
+USE MODI_MAKE_CHOICE_ARRAY
USE MODI_HOR_INTERPOL
USE MODI_READ_SURF_ISBA_PAR_n
!
@@ -75,20 +69,20 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+INTEGER, INTENT(IN) :: KDIM
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: OLAND_USE !
- CHARACTER(LEN=1),OPTIONAL,INTENT(IN) :: HDIR ! type of field :
+TYPE(DATE), INTENT(IN) :: TPDATE_BEG
+TYPE(DATE), INTENT(IN) :: TPDATE_END
+CHARACTER(LEN=1),OPTIONAL,INTENT(IN) :: HDIR ! type of field :
! ! 'H' : field with
! ! horizontal spatial dim.
! ! '-' : no horizontal dim.
@@ -98,21 +92,22 @@ LOGICAL, INTENT(IN) :: OLAND_USE !
!
REAL, DIMENSION(KSIZE,NVEGTYPE) :: ZFIELD
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK
+LOGICAL, DIMENSION(36) :: GTIME
INTEGER :: ILUOUT
INTEGER :: ITIME
INTEGER :: IRESP ! IRESP : return-code if a problem appears
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=LEN_HREC) :: YRECFM2
- CHARACTER(LEN=100):: YCOMMENT ! Comment string
- CHARACTER(LEN=1) :: YDIR
-INTEGER :: JTIME ! loop index
-INTEGER :: JLAYER ! loop index
-INTEGER :: JPATCH ! loop index
+CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=LEN_HREC) :: YRECFM2
+CHARACTER(LEN=100):: YCOMMENT
+CHARACTER(LEN=1) :: YDIR
+INTEGER :: JT ! loop index
+INTEGER :: JL ! loop index
INTEGER :: IVERSION ! surface version
INTEGER :: IBUGFIX
INTEGER :: ISIZE_LMEB_PATCH
+INTEGER :: IENDT, IEND, ID1, ID2, JT_BEG, JT_END
!
-LOGICAL :: GREAD_ALL
+LOGICAL :: GREAD_ALL, GDIM, GDIM2
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -120,7 +115,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('READ_PGD_ISBA_PAR_N',0,ZHOOK_HANDLE)
!
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
+CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
YDIR = 'H'
IF (PRESENT(HDIR)) YDIR = HDIR
@@ -131,192 +126,200 @@ IF (LASSIM) THEN
ENDIF
!
YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
+CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
WRITE(ILUOUT,*) 'read version ',IVERSION
!
YRECFM='BUG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IBUGFIX,IRESP)
+CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
!
-ISIZE_LMEB_PATCH=COUNT(I%LMEB_PATCH(:))
+!
+GDIM = (IVERSION>8 .OR. (IVERSION==8 .AND. IBUGFIX>=1))
+GDIM2 = GDIM
+IF (GDIM) CALL READ_SURF(HPROGRAM,'SPLIT_PATCH',GDIM2,IRESP)
+!
+ISIZE_LMEB_PATCH=COUNT(IO%LMEB_PATCH(:))
!
DTI%LDATA_MIXPAR = .FALSE.
!
-IF (IVERSION<7 .AND. .NOT.I%LECOCLIMAP) THEN
+IF (GDIM) THEN
+ YRECFM='NDATA_TIME'
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%NTIME,IRESP,HCOMMENT=YCOMMENT)
+ENDIF
+!
+DTI%NVEGTYPE = NVEGTYPE
+!
+ALLOCATE(DTI%LDATA_VEG (36*NVEGTYPE))
+ALLOCATE(DTI%LDATA_LAI (36*NVEGTYPE))
+ALLOCATE(DTI%LDATA_Z0 (36*NVEGTYPE))
+ALLOCATE(DTI%LDATA_EMIS (36*NVEGTYPE))
+ALLOCATE(DTI%LDATA_ALBNIR_VEG (36*NVEGTYPE))
+ALLOCATE(DTI%LDATA_ALBVIS_VEG (36*NVEGTYPE))
+ALLOCATE(DTI%LDATA_ALBUV_VEG (36*NVEGTYPE))
+ALLOCATE(DTI%LDATA_ALBNIR_SOIL(36*NVEGTYPE))
+ALLOCATE(DTI%LDATA_ALBVIS_SOIL(36*NVEGTYPE))
+ALLOCATE(DTI%LDATA_ALBUV_SOIL (36*NVEGTYPE))
+ALLOCATE(DTI%LDATA_IRRIG (36*NVEGTYPE))
+ALLOCATE(DTI%LDATA_WATSUP (36*NVEGTYPE))
+DTI%LDATA_VEG (:) = .FALSE.
+DTI%LDATA_LAI (:) = .FALSE.
+DTI%LDATA_Z0 (:) = .FALSE.
+DTI%LDATA_EMIS (:) = .FALSE.
+DTI%LDATA_ALBNIR_VEG (:) = .FALSE.
+DTI%LDATA_ALBVIS_VEG (:) = .FALSE.
+DTI%LDATA_ALBUV_VEG (:) = .FALSE.
+DTI%LDATA_ALBNIR_SOIL(:) = .FALSE.
+DTI%LDATA_ALBVIS_SOIL(:) = .FALSE.
+DTI%LDATA_ALBUV_SOIL (:) = .FALSE.
+DTI%LDATA_IRRIG (:) = .FALSE.
+DTI%LDATA_WATSUP (:) = .FALSE.
+!
+IF (IVERSION<7 .AND. .NOT.IO%LECOCLIMAP) THEN
!
- DTI%LDATA_VEGTYPE=.TRUE.
- DTI%LDATA_VEG=.TRUE.
- DTI%LDATA_LAI=.TRUE.
- DTI%LDATA_Z0=.TRUE.
- DTI%LDATA_EMIS=.TRUE.
- DTI%LDATA_RSMIN=.TRUE.
- DTI%LDATA_GAMMA=.TRUE.
+ DTI%LDATA_VEGTYPE =.TRUE.
+ !
+ DTI%LDATA_VEG =.TRUE.
+ DTI%LDATA_LAI =.TRUE.
+ DTI%LDATA_Z0 =.TRUE.
+ DTI%LDATA_EMIS =.TRUE.
+ DTI%LDATA_ALBNIR_VEG =.TRUE.
+ DTI%LDATA_ALBVIS_VEG =.TRUE.
+ DTI%LDATA_ALBUV_VEG =.TRUE.
+ DTI%LDATA_ALBNIR_SOIL=.TRUE.
+ DTI%LDATA_ALBVIS_SOIL=.TRUE.
+ DTI%LDATA_ALBUV_SOIL =.TRUE.
+ DTI%LDATA_IRRIG =.FALSE.
+ DTI%LDATA_WATSUP=.FALSE.
+ !
+ DTI%LDATA_RSMIN =.TRUE.
+ DTI%LDATA_GAMMA =.TRUE.
DTI%LDATA_WRMAX_CF=.TRUE.
- DTI%LDATA_RGL=.TRUE.
- DTI%LDATA_CV=.TRUE.
+ DTI%LDATA_RGL =.TRUE.
+ DTI%LDATA_CV =.TRUE.
DTI%LDATA_Z0_O_Z0H=.TRUE.
- DTI%LDATA_DG=.TRUE.
+ DTI%LDATA_DG =.TRUE.
DTI%LDATA_ROOTFRAC=.TRUE.
!
- DTI%LDATA_DICE=.FALSE.
- DTI%LDATA_GROUND_DEPTH=.FALSE.
- DTI%LDATA_ROOT_DEPTH=.FALSE.
- DTI%LDATA_ROOT_LIN=.FALSE.
+ DTI%LDATA_DICE =.FALSE.
+ DTI%LDATA_GROUND_DEPTH =.FALSE.
+ DTI%LDATA_ROOT_DEPTH =.FALSE.
+ DTI%LDATA_ROOT_LIN =.FALSE.
DTI%LDATA_ROOT_EXTINCTION=.FALSE.
!
- DTI%LDATA_ALBNIR_VEG=.TRUE.
- DTI%LDATA_ALBVIS_VEG=.TRUE.
- DTI%LDATA_ALBUV_VEG=.TRUE.
- DTI%LDATA_ALBNIR_SOIL=.TRUE.
- DTI%LDATA_ALBVIS_SOIL=.TRUE.
- DTI%LDATA_ALBUV_SOIL=.TRUE.
- DTI%LDATA_GMES=.TRUE.
- DTI%LDATA_BSLAI=.TRUE.
- DTI%LDATA_LAIMIN=.TRUE.
- DTI%LDATA_SEFOLD=.TRUE.
- DTI%LDATA_GC=.TRUE.
- DTI%LDATA_DMAX=.TRUE.
- DTI%LDATA_F2I=.TRUE.
- DTI%LDATA_STRESS=.TRUE.
- DTI%LDATA_H_TREE=.TRUE.
- DTI%LDATA_RE25=.TRUE.
- DTI%LDATA_CE_NITRO=.TRUE.
- DTI%LDATA_CF_NITRO=.TRUE.
- DTI%LDATA_CNA_NITRO=.TRUE.
+ DTI%LDATA_GMES =.TRUE.
+ DTI%LDATA_BSLAI =.TRUE.
+ DTI%LDATA_LAIMIN =.TRUE.
+ DTI%LDATA_SEFOLD =.TRUE.
+ DTI%LDATA_GC =.TRUE.
+ DTI%LDATA_DMAX =.TRUE.
+ DTI%LDATA_F2I =.TRUE.
+ DTI%LDATA_STRESS =.TRUE.
+ DTI%LDATA_H_TREE =.TRUE.
+ DTI%LDATA_RE25 =.TRUE.
+ DTI%LDATA_CE_NITRO =.TRUE.
+ DTI%LDATA_CF_NITRO =.TRUE.
+ DTI%LDATA_CNA_NITRO =.TRUE.
!
- DTI%LDATA_IRRIG=.FALSE.
- DTI%LDATA_WATSUP=.FALSE.
+ DTI%LDATA_SEED_M=.FALSE.
+ DTI%LDATA_SEED_D=.FALSE.
+ DTI%LDATA_REAP_M=.FALSE.
+ DTI%LDATA_REAP_D=.FALSE.
!
ENDIF
!
-IF ((IVERSION<8.AND..NOT.I%LECOCLIMAP).OR.ISIZE_LMEB_PATCH==0.0) THEN
- !
- DTI%LDATA_GNDLITTER=.FALSE.
- DTI%LDATA_RGLGV=.FALSE.
- DTI%LDATA_GAMMAGV=.FALSE.
- DTI%LDATA_RSMINGV=.FALSE.
- DTI%LDATA_ROOTFRACGV=.FALSE.
- DTI%LDATA_WRMAX_CFGV=.FALSE.
- DTI%LDATA_LAIGV=.FALSE.
- DTI%LDATA_Z0LITTER=.FALSE.
- DTI%LDATA_H_VEG=.FALSE.
- DTI%LDATA_ROOT_DEPTHGV=.FALSE.
- DTI%LDATA_ROOT_EXTINCTIONGV=.FALSE.
- !
-ENDIF
+ALLOCATE(DTI%LDATA_GNDLITTER(36*NVEGTYPE))
+ALLOCATE(DTI%LDATA_Z0LITTER (36*NVEGTYPE))
+ALLOCATE(DTI%LDATA_H_VEG (36*NVEGTYPE))
+DTI%LDATA_GNDLITTER(:) = .FALSE.
+DTI%LDATA_Z0LITTER (:) = .FALSE.
+DTI%LDATA_H_VEG (:) = .FALSE.
!
-DTI%LIMP_VEG=.FALSE.
-DTI%LIMP_Z0=.FALSE.
+DTI%LIMP_VEG =.FALSE.
+DTI%LIMP_Z0 =.FALSE.
DTI%LIMP_EMIS=.FALSE.
!
+IF (GDIM) THEN
+ IENDT = NVEGTYPE * DTI%NTIME
+ IEND = MAX(NVEGTYPE_OLD,NVEGTYPE_ECOSG)
+ELSE
+ IENDT = 1
+ IEND = 1
+ENDIF
+!
+!
IF (.NOT.OLAND_USE) THEN
!
IF (IVERSION>=7) THEN
!
YRECFM='L_VEGTYPE'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_VEGTYPE,IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_VEGTYPE,IRESP,HCOMMENT=YCOMMENT)
IF (DTI%LDATA_VEGTYPE) DTI%LDATA_MIXPAR = .TRUE.
!
YRECFM='L_VEG'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_VEG,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_VEG) THEN
- DTI%LDATA_MIXPAR = .TRUE.
- DTI%LIMP_VEG = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_VEG(1:IENDT),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_VEG)) THEN
+ DTI%LDATA_MIXPAR = .TRUE.
+ DTI%LIMP_VEG = .TRUE.
ENDIF
+ !
YRECFM='L_LAI'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_LAI,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_LAI) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_LAI(1:IENDT),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_LAI)) DTI%LDATA_MIXPAR = .TRUE.
+ !
YRECFM='L_Z0'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_Z0,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_Z0) THEN
- DTI%LDATA_MIXPAR = .TRUE.
- DTI%LIMP_Z0 = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_Z0(1:IENDT),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_Z0)) THEN
+ DTI%LDATA_MIXPAR = .TRUE.
+ DTI%LIMP_Z0 = .TRUE.
ENDIF
+ !
YRECFM='L_EMIS'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_EMIS,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_EMIS) THEN
- DTI%LDATA_MIXPAR = .TRUE.
- DTI%LIMP_EMIS = .TRUE.
- ENDIF
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_EMIS(1:IENDT),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_EMIS)) THEN
+ DTI%LDATA_MIXPAR = .TRUE.
+ DTI%LIMP_EMIS = .TRUE.
+ ENDIF
!
YRECFM='L_RSMIN'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_RSMIN,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_RSMIN) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_RSMIN(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_RSMIN)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_GAMMA'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_GAMMA,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_GAMMA) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_GAMMA(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_GAMMA)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_WRMAX_CF'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_WRMAX_CF,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_WRMAX_CF) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_WRMAX_CF(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_WRMAX_CF)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_RGL'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_RGL,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_RGL) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_RGL(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_RGL)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_CV'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_CV,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_CV) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_CV(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_CV)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_Z0_O_Z0H'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_Z0_O_Z0H,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_Z0_O_Z0H) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_Z0_O_Z0H(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_Z0_O_Z0H)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_DG'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_DG,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_DG) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_DG(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_DG)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_ROOTFRAC'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_ROOTFRAC,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_ROOTFRAC) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_ROOTFRAC(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_ROOTFRAC)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_DICE'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_DICE,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_DICE) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_DICE(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_DICE)) DTI%LDATA_MIXPAR = .TRUE.
!
IF ( (IVERSION==7 .AND. IBUGFIX>=2) .OR. IVERSION>7 ) THEN
YRECFM2='L_GROUND_DPT'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM2,DTI%LDATA_GROUND_DEPTH,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_GROUND_DEPTH) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM2,DTI%LDATA_GROUND_DEPTH(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_GROUND_DEPTH)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_ROOT_DEPTH'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_ROOT_DEPTH,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_ROOT_DEPTH) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_ROOT_DEPTH(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_ROOT_DEPTH)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_ROOT_EXT'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_ROOT_EXTINCTION,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_ROOT_EXTINCTION) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_ROOT_EXTINCTION(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_ROOT_EXTINCTION)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_ROOT_LIN'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_ROOT_LIN,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_ROOT_LIN) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_ROOT_LIN(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_ROOT_LIN)) DTI%LDATA_MIXPAR = .TRUE.
ELSE
DTI%LDATA_GROUND_DEPTH = .FALSE.
DTI%LDATA_ROOT_DEPTH = .FALSE.
@@ -325,650 +328,974 @@ IF (.NOT.OLAND_USE) THEN
ENDIF
!
YRECFM='L_ALBNIR_VEG'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_ALBNIR_VEG,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_ALBNIR_VEG) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_ALBNIR_VEG(1:IENDT),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_ALBNIR_VEG)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_ALBVIS_VEG'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_ALBVIS_VEG,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_ALBVIS_VEG) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_ALBVIS_VEG(1:IENDT),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_ALBVIS_VEG)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_ALBUV_VEG'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_ALBUV_VEG,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_ALBUV_VEG) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_ALBUV_VEG(1:IENDT),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_ALBUV_VEG)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_ALBNIR_SOI'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_ALBNIR_SOIL,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_ALBNIR_SOIL) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_ALBNIR_SOIL(1:IENDT),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_ALBNIR_SOIL)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_ALBVIS_SOI'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_ALBVIS_SOIL,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_ALBVIS_SOIL) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_ALBVIS_SOIL(1:IENDT),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_ALBVIS_SOIL)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_ALBUV_SOI'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_ALBUV_SOIL,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_ALBUV_SOIL) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_ALBUV_SOIL(1:IENDT),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_ALBUV_SOIL)) DTI%LDATA_MIXPAR = .TRUE.
+ !
YRECFM='L_GMES'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_GMES,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_GMES) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_GMES(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_GMES)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_BSLAI'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_BSLAI,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_BSLAI) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_BSLAI(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_BSLAI)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_LAIMIN'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_LAIMIN,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_LAIMIN) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_LAIMIN(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_LAIMIN)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_SEFOLD'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_SEFOLD,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_SEFOLD) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_SEFOLD(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_SEFOLD)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_GC'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_GC,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_GC) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_GC(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_GC)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_DMAX'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_DMAX,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_DMAX) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_DMAX(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_DMAX)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_F2I'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_F2I,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_F2I) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_F2I(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_F2I)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_STRESS'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_STRESS,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_STRESS) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_STRESS(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_STRESS)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_H_TREE'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_H_TREE,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_H_TREE) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_H_TREE(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_H_TREE)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_RE25'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_RE25,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_RE25) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_RE25(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_RE25)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_CE_NITRO'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_CE_NITRO,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_CE_NITRO) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_CE_NITRO(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_CE_NITRO)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_CF_NITRO'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_CF_NITRO,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_CF_NITRO) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_CF_NITRO(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_CF_NITRO)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_CNA_NITRO'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_CNA_NITRO,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_CNA_NITRO) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_CNA_NITRO(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_CNA_NITRO)) DTI%LDATA_MIXPAR = .TRUE.
+ !
YRECFM='L_IRRIG'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_IRRIG,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_IRRIG) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_IRRIG(1:IENDT),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_IRRIG)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_WATSUP'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_WATSUP,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_WATSUP) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_WATSUP(1:IENDT),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_WATSUP)) DTI%LDATA_MIXPAR = .TRUE.
!
ENDIF
!
IF (IVERSION>=8.AND.ISIZE_LMEB_PATCH>0) THEN
!
- YRECFM='L_LAIGV'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_LAIGV,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_LAIGV) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_H_VEG'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_H_VEG,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_H_VEG) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_H_VEG(1:IENDT),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_H_VEG)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_Z0LITTER'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_Z0LITTER,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_Z0LITTER) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_Z0LITTER(1:IENDT),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_Z0LITTER)) DTI%LDATA_MIXPAR = .TRUE.
YRECFM='L_GNDLITTER'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_GNDLITTER,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_GNDLITTER) DTI%LDATA_MIXPAR = .TRUE.
- YRECFM='L_RSMINGV'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_RSMINGV,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_RSMINGV) DTI%LDATA_MIXPAR = .TRUE.
- YRECFM='L_GAMMAGV'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_GAMMAGV,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_GAMMAGV) DTI%LDATA_MIXPAR = .TRUE.
- YRECFM='L_WRMAX_CFGV'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_WRMAX_CFGV,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_WRMAX_CFGV) DTI%LDATA_MIXPAR = .TRUE.
- YRECFM='L_RGLGV'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_RGLGV,IRESP,HCOMMENT=YCOMMENT)
- YRECFM='L_RTFRACGV'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_ROOTFRACGV,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_ROOTFRACGV) DTI%LDATA_MIXPAR = .TRUE.
- YRECFM='L_RT_DEPTHGV'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_ROOT_DEPTHGV,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_ROOT_DEPTHGV) DTI%LDATA_MIXPAR = .TRUE.
- YRECFM='L_RT_EXTGV'
- YCOMMENT=YRECFM
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%LDATA_ROOT_EXTINCTIONGV,IRESP,HCOMMENT=YCOMMENT)
- IF (DTI%LDATA_ROOT_EXTINCTIONGV) DTI%LDATA_MIXPAR = .TRUE.
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_GNDLITTER(1:IENDT),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_GNDLITTER)) DTI%LDATA_MIXPAR = .TRUE.
+ !
+ ENDIF
+ !
+ IF (GDIM) THEN
+ !
+ YRECFM='L_SEED_M'
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_SEED_M(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_SEED_M)) DTI%LDATA_MIXPAR = .TRUE.
+ YRECFM='L_SEED_D'
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_SEED_D(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_SEED_D)) DTI%LDATA_MIXPAR = .TRUE.
+ YRECFM='L_REAP_M'
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_REAP_M(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_REAP_M)) DTI%LDATA_MIXPAR = .TRUE.
+ YRECFM='L_REAP_D'
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_REAP_D(1:IEND),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ IF (ANY(DTI%LDATA_REAP_D)) DTI%LDATA_MIXPAR = .TRUE.
+ !
+ YRECFM='L_CONDSAT'
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_CONDSAT,IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ YRECFM='L_MPOTSAT'
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_MPOTSAT,IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ YRECFM='L_BCOEF'
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_BCOEF,IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ YRECFM='L_WWILT'
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_WWILT,IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ YRECFM='L_WFC'
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_WFC,IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ YRECFM='L_WSAT'
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%LDATA_WSAT,IRESP,HCOMMENT=YCOMMENT,HDIR='-')
!
ELSE
!
- DTI%LDATA_GNDLITTER=.FALSE.
- DTI%LDATA_RGLGV=.FALSE.
- DTI%LDATA_GAMMAGV=.FALSE.
- DTI%LDATA_RSMINGV=.FALSE.
- DTI%LDATA_ROOTFRACGV=.FALSE.
- DTI%LDATA_WRMAX_CFGV=.FALSE.
- DTI%LDATA_LAIGV=.FALSE.
- DTI%LDATA_Z0LITTER=.FALSE.
- DTI%LDATA_H_VEG=.FALSE.
- DTI%LDATA_ROOT_DEPTHGV=.FALSE.
- DTI%LDATA_ROOT_EXTINCTIONGV=.FALSE.
+ DTI%LDATA_SEED_M=.FALSE.
+ DTI%LDATA_SEED_D=.FALSE.
+ DTI%LDATA_REAP_M=.FALSE.
+ DTI%LDATA_REAP_D=.FALSE.
+ !
+ DTI%LDATA_CONDSAT=.FALSE.
+ DTI%LDATA_MPOTSAT=.FALSE.
+ DTI%LDATA_BCOEF=.FALSE.
+ DTI%LDATA_WWILT=.FALSE.
+ DTI%LDATA_WFC=.FALSE.
+ DTI%LDATA_WSAT=.FALSE.
!
- ENDIF
+ ENDIF
!
IF (ALLOCATED(LINTERP)) LINTERP(:) = .TRUE.
!
+ IF (GDIM .OR. ( ANY(DTI%LDATA_LAI) .OR. ANY(DTI%LDATA_VEG) .OR. &
+ ANY(DTI%LDATA_Z0) .OR. ANY(DTI%LDATA_EMIS)) ) THEN
+ IF (.NOT.GDIM) THEN
+ YRECFM='NDATA_TIME'
+ CALL READ_SURF(HPROGRAM,YRECFM,DTI%NTIME,IRESP,HCOMMENT=YCOMMENT)
+ ENDIF
+ ITIME = DTI%NTIME
+ ELSE
+ ITIME = 1
+ ENDIF
+ !
+ IF (ITIME==1) THEN
+ JT_BEG = 1
+ JT_END = 1
+ ELSE
+ ! get JT corresponding to DATE_BEG and DATE_END
+ ! for ITIME = 36
+ JT_BEG = (TPDATE_BEG%MONTH-1) * 3 + CEILING(MIN(TPDATE_BEG%DAY,30)/10.)
+ JT_END = (TPDATE_END%MONTH-1) * 3 + CEILING(MIN(TPDATE_END%DAY,30)/10.)
+ IF ( TPDATE_END%YEAR > TPDATE_BEG%YEAR+1 ) THEN
+ JT_BEG = 1
+ JT_END = 36
+ ENDIF
+ ! for ITIME = DTI%NTIME
+ IF (ITIME==2) THEN ! particular case of summer / winter
+ IF (JT_BEG<=8.OR.JT_BEG>=27) THEN
+ JT_BEG = 1
+ ELSE
+ JT_BEG = 2
+ ENDIF
+ IF (JT_END<=8.OR.JT_END>=27) THEN
+ JT_END = 1
+ ELSE
+ JT_END = 2
+ ENDIF
+ ELSE
+ JT_BEG = CEILING(JT_BEG/(36./ITIME))
+ JT_END = CEILING(JT_END/(36./ITIME))
+ ENDIF
+ ENDIF
+ GTIME(:) = .FALSE.
+ DO JT = 1,SIZE(GTIME)
+ IF (JT_BEG==JT_END .AND. TPDATE_END%YEAR==TPDATE_BEG%YEAR+1) THEN
+ GTIME(JT) = .TRUE.
+ ELSEIF (JT_BEG<=JT_END .AND. JT>=JT_BEG .AND. JT<=JT_END) THEN
+ GTIME(JT) = .TRUE.
+ ELSEIF (JT_BEG>JT_END .AND. (JT>=JT_BEG .OR. JT<=JT_END)) THEN
+ GTIME(JT) = .TRUE.
+ ENDIF
+ ENDDO
+ !
+ !
IF (DTI%LDATA_VEGTYPE) THEN
- YRECFM='D_VEGTYPE'
- CALL READ_SURF_FIELD2D(HPROGRAM,ZFIELD(:,:),YRECFM,HCOMMENT=YCOMMENT,HDIR=YDIR)
- ALLOCATE(DTI%XPAR_VEGTYPE (IG%NDIM,NVEGTYPE))
- IF (IG%NDIM/=KSIZE) THEN
- CALL HOR_INTERPOL(DTCO, U,GCP, &
- ILUOUT,ZFIELD,DTI%XPAR_VEGTYPE)
+ IF (GDIM2) THEN
+ YRECFM='D_VEGTY_'
+ ELSE
+ YRECFM='D_VEGTYPE'
+ ENDIF
+ CALL MAKE_CHOICE_ARRAY(HPROGRAM, NVEGTYPE, GDIM2, YRECFM, ZFIELD(:,:),HDIR=YDIR)
+ ALLOCATE(DTI%XPAR_VEGTYPE(KDIM,NVEGTYPE))
+ IF (KDIM/=KSIZE) THEN
+ CALL HOR_INTERPOL(DTCO, U, GCP, ILUOUT,ZFIELD,DTI%XPAR_VEGTYPE)
ELSE
DTI%XPAR_VEGTYPE(:,:) = ZFIELD(:,:)
ENDIF
ENDIF
-!
- IF (DTI%LDATA_LAI .OR. DTI%LDATA_VEG .OR. DTI%LDATA_Z0 .OR. DTI%LDATA_EMIS) THEN
- YRECFM='NDATA_TIME'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTI%NTIME,IRESP,HCOMMENT=YCOMMENT)
- ITIME = DTI%NTIME
- ELSE
- DTI%NTIME = 1
- ENDIF
-!
- IF (DTI%LDATA_VEG) THEN
- ALLOCATE(DTI%XPAR_VEG(IG%NDIM,DTI%NTIME,NVEGTYPE))
- DO JTIME=1,ITIME
- WRITE(YRECFM,FMT='(A7,I2.2)') 'D_VEG_T',JTIME
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_VEG(:,JTIME,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- END DO
- ENDIF
-!
- IF (DTI%LDATA_LAI) THEN
- ALLOCATE(DTI%XPAR_LAI(IG%NDIM,DTI%NTIME,NVEGTYPE))
- DO JTIME=1,ITIME
- WRITE(YRECFM,FMT='(A7,I2.2)') 'D_LAI_T',JTIME
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_LAI(:,JTIME,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
+ !
+ IF (ANY(DTI%LDATA_VEG)) THEN
+ ALLOCATE(DTI%XPAR_VEG(KDIM,DTI%NTIME,NVEGTYPE))
+ DO JT=1,ITIME
+ ID1 = (JT-1)*NVEGTYPE + 1
+ ID2 = JT*NVEGTYPE
+ IF (GTIME(JT)) THEN
+ WRITE(YRECFM,FMT='(A7,I2.2)') 'D_VEG_T',JT
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_VEG(ID1:ID2), DTI%XPAR_VEG(:,JT,:),IRESP,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ELSE
+ DTI%XPAR_VEG(:,JT,:) = XUNDEF
+ ENDIF
END DO
ENDIF
!
- IF (DTI%LDATA_LAIGV) THEN
- ALLOCATE(DTI%XPAR_LAIGV(IG%NDIM,DTI%NTIME,NVEGTYPE))
- DO JTIME=1,ITIME
- WRITE(YRECFM,FMT='(A9,I2.2)') 'D_LAIGV_T',JTIME
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_LAIGV(:,JTIME,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
+ IF (ANY(DTI%LDATA_LAI)) THEN
+ ALLOCATE(DTI%XPAR_LAI(KDIM,DTI%NTIME,NVEGTYPE))
+ DO JT=1,ITIME
+ ID1 = (JT-1)*NVEGTYPE + 1
+ ID2 = JT*NVEGTYPE
+ IF (GTIME(JT)) THEN
+ WRITE(YRECFM,FMT='(A7,I2.2)') 'D_LAI_T',JT
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_LAI(ID1:ID2),DTI%XPAR_LAI(:,JT,:),IRESP,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ELSE
+ DTI%XPAR_LAI(:,JT,:) = XUNDEF
+ ENDIF
END DO
ENDIF
!
- IF (DTI%LDATA_H_VEG) THEN
- ALLOCATE(DTI%XPAR_H_VEG(IG%NDIM,DTI%NTIME,NVEGTYPE))
- DO JTIME=1,ITIME
- WRITE(YRECFM,FMT='(A9,I2.2)') 'D_H_VEG_T',JTIME
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_H_VEG(:,JTIME,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
+ IF (ANY(DTI%LDATA_Z0)) THEN
+ ALLOCATE(DTI%XPAR_Z0 (KDIM,DTI%NTIME,NVEGTYPE))
+ DO JT=1,ITIME
+ ID1 = (JT-1)*NVEGTYPE + 1
+ ID2 = JT*NVEGTYPE
+ IF (GTIME(JT)) THEN
+ WRITE(YRECFM,FMT='(A6,I2.2)') 'D_Z0_T',JT
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_Z0(ID1:ID2),DTI%XPAR_Z0(:,JT,:),IRESP,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ELSE
+ DTI%XPAR_Z0(:,JT,:) = XUNDEF
+ ENDIF
END DO
ENDIF
!
- IF (DTI%LDATA_GNDLITTER) THEN
- ALLOCATE(DTI%XPAR_GNDLITTER(IG%NDIM,DTI%NTIME,NVEGTYPE))
- DO JTIME=1,ITIME
- WRITE(YRECFM,FMT='(A7,I2.2)') 'D_GNDLITTER',JTIME
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_GNDLITTER(:,JTIME,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
+ IF (ANY(DTI%LDATA_EMIS)) THEN
+ ALLOCATE(DTI%XPAR_EMIS (KDIM,DTI%NTIME,NVEGTYPE))
+ DO JT=1,ITIME
+ ID1 = (JT-1)*NVEGTYPE + 1
+ ID2 = JT*NVEGTYPE
+ IF (GDIM) THEN
+ WRITE(YRECFM,FMT='(A8,I2.2)') 'D_EMI_T',JT
+ ELSE
+ WRITE(YRECFM,FMT='(A8,I2.2)') 'D_EMIS_T',JT
+ ENDIF
+ IF (GTIME(JT)) THEN
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_EMIS(ID1:ID2),DTI%XPAR_EMIS(:,JT,:),IRESP,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ELSE
+ DTI%XPAR_EMIS(:,JT,:) = XUNDEF
+ ENDIF
END DO
ENDIF
!
- IF (DTI%LDATA_Z0) THEN
- ALLOCATE(DTI%XPAR_Z0 (IG%NDIM,DTI%NTIME,NVEGTYPE))
- DO JTIME=1,ITIME
- WRITE(YRECFM,FMT='(A6,I2.2)') 'D_Z0_T',JTIME
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_Z0(:,JTIME,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
+ IF (ANY(DTI%LDATA_H_VEG)) THEN
+ ALLOCATE(DTI%XPAR_H_VEG(KDIM,DTI%NTIME,NVEGTYPE))
+ DO JT=1,ITIME
+ ID1 = (JT-1)*NVEGTYPE + 1
+ ID2 = JT*NVEGTYPE
+ IF (GDIM) THEN
+ WRITE(YRECFM,FMT='(A7,I2.2)') 'D_HVG_T',JT
+ ELSE
+ WRITE(YRECFM,FMT='(A9,I2.2)') 'D_H_VEG_T',JT
+ ENDIF
+ IF (GTIME(JT)) THEN
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_H_VEG(ID1:ID2),DTI%XPAR_H_VEG(:,JT,:),IRESP,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ELSE
+ DTI%XPAR_H_VEG(:,JT,:) = XUNDEF
+ ENDIF
END DO
ENDIF
!
- IF (DTI%LDATA_Z0LITTER) THEN
- ALLOCATE(DTI%XPAR_Z0LITTER (IG%NDIM,DTI%NTIME,NVEGTYPE))
- DO JTIME=1,ITIME
- WRITE(YRECFM,FMT='(A8,I2.2)') 'D_Z0LITTER_T',JTIME
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_Z0LITTER(:,JTIME,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
+ IF (ANY(DTI%LDATA_GNDLITTER)) THEN
+ ALLOCATE(DTI%XPAR_GNDLITTER(KDIM,DTI%NTIME,NVEGTYPE))
+ DO JT=1,ITIME
+ ID1 = (JT-1)*NVEGTYPE + 1
+ ID2 = JT*NVEGTYPE
+ IF (GDIM) THEN
+ WRITE(YRECFM,FMT='(A7,I2.2)') 'D_GLI_T',JT
+ ELSE
+ WRITE(YRECFM,FMT='(A7,I2.2)') 'D_GNDLITTER',JT
+ ENDIF
+ IF (GTIME(JT)) THEN
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_GNDLITTER(ID1:ID2),DTI%XPAR_GNDLITTER(:,JT,:),IRESP,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ELSE
+ DTI%XPAR_GNDLITTER(:,JT,:) = XUNDEF
+ ENDIF
END DO
ENDIF
!
- IF (DTI%LDATA_EMIS) THEN
- ALLOCATE(DTI%XPAR_EMIS (IG%NDIM,DTI%NTIME,NVEGTYPE))
- DO JTIME=1,ITIME
- WRITE(YRECFM,FMT='(A8,I2.2)') 'D_EMIS_T',JTIME
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_EMIS(:,JTIME,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
+ IF (ANY(DTI%LDATA_Z0LITTER)) THEN
+ ALLOCATE(DTI%XPAR_Z0LITTER (KDIM,DTI%NTIME,NVEGTYPE))
+ DO JT=1,ITIME
+ ID1 = (JT-1)*NVEGTYPE + 1
+ ID2 = JT*NVEGTYPE
+ IF (GDIM) THEN
+ WRITE(YRECFM,FMT='(A7,I2.2)') 'D_Z0L_T',JT
+ ELSE
+ WRITE(YRECFM,FMT='(A8,I2.2)') 'D_Z0LITTER_T',JT
+ ENDIF
+ IF (GTIME(JT)) THEN
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_Z0LITTER(ID1:ID2),DTI%XPAR_Z0LITTER(:,JT,:),IRESP,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ELSE
+ DTI%XPAR_Z0LITTER(:,JT,:) = XUNDEF
+ ENDIF
END DO
ENDIF
!
- IF (DTI%LDATA_RSMIN) THEN
- ALLOCATE(DTI%XPAR_RSMIN (IG%NDIM,NVEGTYPE))
- YRECFM='D_RSMIN'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_RSMIN(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_ALBNIR_VEG)) THEN
+ ALLOCATE(DTI%XPAR_ALBNIR_VEG(KDIM,DTI%NTIME,NVEGTYPE))
+ DO JT=1,ITIME
+ ID1 = (JT-1)*NVEGTYPE + 1
+ ID2 = JT*NVEGTYPE
+ IF (GDIM) THEN
+ IF (GTIME(JT)) THEN
+ WRITE(YRECFM,FMT='(A7,I2.2)') 'D_ANV_T',JT
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_ALBNIR_VEG(ID1:ID2),DTI%XPAR_ALBNIR_VEG(:,JT,:),IRESP,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ELSE
+ DTI%XPAR_ALBNIR_VEG(:,JT,:) = XUNDEF
+ ENDIF
+ ELSE
+ IF (JT==1) THEN
+ YRECFM='D_ALBNIR_VEG'
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_ALBNIR_VEG,DTI%XPAR_ALBNIR_VEG(:,1,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ELSE
+ DTI%XPAR_ALBNIR_VEG(:,JT,:) = DTI%XPAR_ALBNIR_VEG(:,1,:)
+ ENDIF
+ ENDIF
+ ENDDO
ENDIF
!
- IF (DTI%LDATA_RSMINGV) THEN
- ALLOCATE(DTI%XPAR_RSMINGV (IG%NDIM,NVEGTYPE))
- YRECFM='D_RSMINGV'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_RSMINGV(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (DTI%LDATA_GAMMA) THEN
- ALLOCATE(DTI%XPAR_GAMMA (IG%NDIM,NVEGTYPE))
- YRECFM='D_GAMMA'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_GAMMA(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_ALBVIS_VEG)) THEN
+ ALLOCATE(DTI%XPAR_ALBVIS_VEG(KDIM,DTI%NTIME,NVEGTYPE))
+ DO JT=1,ITIME
+ ID1 = (JT-1)*NVEGTYPE + 1
+ ID2 = JT*NVEGTYPE
+ IF (GDIM) THEN
+ IF (GTIME(JT)) THEN
+ WRITE(YRECFM,FMT='(A7,I2.2)') 'D_AVV_T',JT
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_ALBVIS_VEG(ID1:ID2),DTI%XPAR_ALBVIS_VEG(:,JT,:),IRESP,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ELSE
+ DTI%XPAR_ALBVIS_VEG(:,JT,:) = XUNDEF
+ ENDIF
+ ELSE
+ IF (JT==1) THEN
+ YRECFM='D_ALBVIS_VEG'
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_ALBVIS_VEG,DTI%XPAR_ALBVIS_VEG(:,1,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ELSE
+ DTI%XPAR_ALBVIS_VEG(:,JT,:) = DTI%XPAR_ALBVIS_VEG(:,1,:)
+ ENDIF
+ ENDIF
+ ENDDO
ENDIF
!
- IF (DTI%LDATA_GAMMAGV) THEN
- ALLOCATE(DTI%XPAR_GAMMAGV (IG%NDIM,NVEGTYPE))
- YRECFM='D_GAMMAGV'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_GAMMAGV(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (DTI%LDATA_WRMAX_CF) THEN
- ALLOCATE(DTI%XPAR_WRMAX_CF (IG%NDIM,NVEGTYPE))
- YRECFM='D_WRMAX_CF'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_WRMAX_CF(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_ALBUV_VEG)) THEN
+ ALLOCATE(DTI%XPAR_ALBUV_VEG(KDIM,DTI%NTIME,NVEGTYPE))
+ DO JT=1,ITIME
+ ID1 = (JT-1)*NVEGTYPE + 1
+ ID2 = JT*NVEGTYPE
+ IF (GDIM) THEN
+ IF (GTIME(JT)) THEN
+ WRITE(YRECFM,FMT='(A7,I2.2)') 'D_AUV_T',JT
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_ALBUV_VEG(ID1:ID2),DTI%XPAR_ALBUV_VEG(:,JT,:),IRESP,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ELSE
+ DTI%XPAR_ALBUV_VEG(:,JT,:) = XUNDEF
+ ENDIF
+ ELSE
+ IF (JT==1) THEN
+ YRECFM='D_ALBUV_VEG'
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_ALBUV_VEG,DTI%XPAR_ALBUV_VEG(:,1,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ELSE
+ DTI%XPAR_ALBUV_VEG(:,JT,:) = DTI%XPAR_ALBUV_VEG(:,1,:)
+ ENDIF
+ ENDIF
+ ENDDO
ENDIF
!
- IF (DTI%LDATA_WRMAX_CFGV) THEN
- ALLOCATE(DTI%XPAR_WRMAX_CFGV (IG%NDIM,NVEGTYPE))
- YRECFM='D_WRMAX_CFGV'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_WRMAX_CFGV(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (DTI%LDATA_RGL) THEN
- ALLOCATE(DTI%XPAR_RGL (IG%NDIM,NVEGTYPE))
- YRECFM='D_RGL'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_RGL(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_ALBNIR_SOIL)) THEN
+ ALLOCATE(DTI%XPAR_ALBNIR_SOIL(KDIM,DTI%NTIME,NVEGTYPE))
+ DO JT=1,ITIME
+ ID1 = (JT-1)*NVEGTYPE + 1
+ ID2 = JT*NVEGTYPE
+ IF (GDIM) THEN
+ IF (GTIME(JT)) THEN
+ WRITE(YRECFM,FMT='(A7,I2.2)') 'D_ANS_T',JT
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_ALBNIR_SOIL(ID1:ID2),DTI%XPAR_ALBNIR_SOIL(:,JT,:),IRESP,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ELSE
+ DTI%XPAR_ALBNIR_SOIL(:,JT,:) = XUNDEF
+ ENDIF
+ ELSE
+ IF (JT==1) THEN
+ YRECFM='D_ALBNIR_SOI'
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_ALBNIR_SOIL,DTI%XPAR_ALBNIR_SOIL(:,1,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (DTI%LDATA_RGLGV) THEN
- ALLOCATE(DTI%XPAR_RGLGV (IG%NDIM,NVEGTYPE))
- YRECFM='D_RGLGV'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_RGLGV(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (DTI%LDATA_CV) THEN
- ALLOCATE(DTI%XPAR_CV (IG%NDIM,NVEGTYPE))
- YRECFM='D_CV'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_CV(:,:),IRESP,IVERSION,&
+ ELSE
+ DTI%XPAR_ALBNIR_SOIL(:,JT,:) = DTI%XPAR_ALBNIR_SOIL(:,1,:)
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+!
+ IF (ANY(DTI%LDATA_ALBVIS_SOIL)) THEN
+ ALLOCATE(DTI%XPAR_ALBVIS_SOIL(KDIM,DTI%NTIME,NVEGTYPE))
+ DO JT=1,ITIME
+ ID1 = (JT-1)*NVEGTYPE + 1
+ ID2 = JT*NVEGTYPE
+ IF (GDIM) THEN
+ IF (GTIME(JT)) THEN
+ WRITE(YRECFM,FMT='(A7,I2.2)') 'D_AVS_T',JT
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_ALBVIS_SOIL(ID1:ID2),DTI%XPAR_ALBVIS_SOIL(:,JT,:),IRESP,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ELSE
+ DTI%XPAR_ALBVIS_SOIL(:,JT,:) = XUNDEF
+ ENDIF
+ ELSE
+ IF (JT==1) THEN
+ YRECFM='D_ALBVIS_SOI'
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_ALBVIS_SOIL,DTI%XPAR_ALBVIS_SOIL(:,1,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (DTI%LDATA_Z0_O_Z0H) THEN
- ALLOCATE(DTI%XPAR_Z0_O_Z0H (IG%NDIM,NVEGTYPE))
- YRECFM='D_Z0_O_Z0H'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_Z0_O_Z0H(:,:),IRESP,IVERSION,&
+ ELSE
+ DTI%XPAR_ALBVIS_SOIL(:,JT,:) = DTI%XPAR_ALBVIS_SOIL(:,1,:)
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+!
+ IF (ANY(DTI%LDATA_ALBUV_SOIL)) THEN
+ ALLOCATE(DTI%XPAR_ALBUV_SOIL(KDIM,DTI%NTIME,NVEGTYPE))
+ DO JT=1,ITIME
+ ID1 = (JT-1)*NVEGTYPE + 1
+ ID2 = JT*NVEGTYPE
+ IF (GDIM) THEN
+ IF (GTIME(JT)) THEN
+ WRITE(YRECFM,FMT='(A7,I2.2)') 'D_AUS_T',JT
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_ALBUV_SOIL(ID1:ID2),DTI%XPAR_ALBUV_SOIL(:,JT,:),IRESP,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ELSE
+ DTI%XPAR_ALBUV_SOIL(:,JT,:) = XUNDEF
+ ENDIF
+ ELSE
+ IF (JT==1) THEN
+ YRECFM='D_ALBUV_SOI'
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_ALBUV_SOIL,DTI%XPAR_ALBUV_SOIL(:,1,:),IRESP,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ELSE
+ DTI%XPAR_ALBUV_SOIL(:,JT,:) = DTI%XPAR_ALBUV_SOIL(:,1,:)
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+!
+ IF (ANY(DTI%LDATA_RSMIN)) THEN
+ ALLOCATE(DTI%XPAR_RSMIN (KDIM,NVEGTYPE))
+ IF (GDIM) THEN
+ YRECFM='D_RSMIN_'
+ ELSE
+ YRECFM='D_RSMIN'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_RSMIN,DTI%XPAR_RSMIN(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
ENDIF
!
- IF (DTI%LDATA_DG) THEN
- ALLOCATE(DTI%XPAR_DG (IG%NDIM,I%NGROUND_LAYER,NVEGTYPE))
- ALLOCATE(ZWORK(SIZE(DTI%XPAR_DG,1),SIZE(DTI%XPAR_DG,3)))
- DO JLAYER=1,SIZE(DTI%XPAR_DG,2)
- IF (JLAYER<10) WRITE(YRECFM,FMT='(A4,I1.1)') 'D_DG',JLAYER
- IF (JLAYER>=10) WRITE(YRECFM,FMT='(A4,I2.2)') 'D_DG',JLAYER
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,ZWORK,IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- DO JPATCH=1,SIZE(DTI%XPAR_DG,3)
- DTI%XPAR_DG(:,JLAYER,JPATCH) = ZWORK(:,JPATCH)
- END DO
- END DO
- DEALLOCATE(ZWORK)
- ENDIF
-!
- IF (DTI%LDATA_ROOTFRAC) THEN
- ALLOCATE(DTI%XPAR_ROOTFRAC (IG%NDIM,I%NGROUND_LAYER,NVEGTYPE))
- ALLOCATE(ZWORK(SIZE(DTI%XPAR_ROOTFRAC,1),SIZE(DTI%XPAR_ROOTFRAC,3)))
- DO JLAYER=1,SIZE(DTI%XPAR_ROOTFRAC,2)
- IF (JLAYER<10) WRITE(YRECFM,FMT='(A10,I1.1)') 'D_ROOTFRAC',JLAYER
- IF (JLAYER>=10) WRITE(YRECFM,FMT='(A10,I2.2)') 'D_ROOTFRAC',JLAYER
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,ZWORK,IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- DO JPATCH=1,SIZE(DTI%XPAR_ROOTFRAC,3)
- DTI%XPAR_ROOTFRAC(:,JLAYER,JPATCH) = ZWORK(:,JPATCH)
- END DO
- END DO
- DEALLOCATE(ZWORK)
- ENDIF
-!
- IF (DTI%LDATA_ROOTFRACGV) THEN
- ALLOCATE(DTI%XPAR_ROOTFRACGV (IG%NDIM,I%NGROUND_LAYER,NVEGTYPE))
- ALLOCATE(ZWORK(SIZE(DTI%XPAR_ROOTFRACGV,1),SIZE(DTI%XPAR_ROOTFRACGV,3)))
- DO JLAYER=1,SIZE(DTI%XPAR_ROOTFRACGV,2)
- IF (JLAYER<10) WRITE(YRECFM,FMT='(A10,I1.1)') 'D_RTFRACGV',JLAYER
- IF (JLAYER>=10) WRITE(YRECFM,FMT='(A10,I2.2)') 'D_RTFRACGV',JLAYER
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,ZWORK,IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- DO JPATCH=1,SIZE(DTI%XPAR_ROOTFRACGV,3)
- DTI%XPAR_ROOTFRACGV(:,JLAYER,JPATCH) = ZWORK(:,JPATCH)
- END DO
- END DO
- DEALLOCATE(ZWORK)
- ENDIF
-!
- IF (DTI%LDATA_DICE) THEN
- ALLOCATE(DTI%XPAR_DICE (IG%NDIM,NVEGTYPE))
- YRECFM='D_DICE'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_DICE(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_GAMMA)) THEN
+ ALLOCATE(DTI%XPAR_GAMMA (KDIM,NVEGTYPE))
+ IF (GDIM) THEN
+ YRECFM='D_GAMMA_'
+ ELSE
+ YRECFM='D_GAMMA'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_GAMMA,DTI%XPAR_GAMMA(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
ENDIF
!
- IF (DTI%LDATA_GROUND_DEPTH) THEN
- ALLOCATE(DTI%XPAR_GROUND_DEPTH(IG%NDIM,NVEGTYPE))
- YRECFM2='D_GROUND_DEPTH'
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM2='D_GROUND_DPT'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM2,ILUOUT,KSIZE,DTI%XPAR_GROUND_DEPTH(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_WRMAX_CF)) THEN
+ ALLOCATE(DTI%XPAR_WRMAX_CF (KDIM,NVEGTYPE))
+ IF (GDIM) THEN
+ YRECFM='D_WRMAX_'
+ ELSE
+ YRECFM='D_WRMAX_CF'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_WRMAX_CF,DTI%XPAR_WRMAX_CF(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
ENDIF
!
- IF (DTI%LDATA_ROOT_DEPTH) THEN
- ALLOCATE(DTI%XPAR_ROOT_DEPTH(IG%NDIM,NVEGTYPE))
- YRECFM='D_ROOT_DEPTH'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_ROOT_DEPTH(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_RGL)) THEN
+ ALLOCATE(DTI%XPAR_RGL (KDIM,NVEGTYPE))
+ IF (GDIM) THEN
+ YRECFM='D_RGL_'
+ ELSE
+ YRECFM='D_RGL'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_RGL,DTI%XPAR_RGL(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
ENDIF
!
- IF (DTI%LDATA_ROOT_DEPTHGV) THEN
- ALLOCATE(DTI%XPAR_ROOT_DEPTHGV(IG%NDIM,NVEGTYPE))
- YRECFM='D_RT_DEPTHGV'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_ROOT_DEPTHGV(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
+ IF (ANY(DTI%LDATA_CV)) THEN
+ ALLOCATE(DTI%XPAR_CV (KDIM,NVEGTYPE))
+ IF (GDIM) THEN
+ YRECFM='D_CV_'
+ ELSE
+ YRECFM='D_CV'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_CV,DTI%XPAR_CV(:,:),IRESP,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
ENDIF
!
- IF (DTI%LDATA_ROOT_EXTINCTION) THEN
- ALLOCATE(DTI%XPAR_ROOT_EXTINCTION(IG%NDIM,NVEGTYPE))
- YRECFM='D_ROOT_EXT'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_ROOT_EXTINCTION(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_Z0_O_Z0H)) THEN
+ ALLOCATE(DTI%XPAR_Z0_O_Z0H (KDIM,NVEGTYPE))
+ IF (GDIM) THEN
+ YRECFM='D_Z0H_'
+ ELSE
+ YRECFM='D_Z0_O_Z0H'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_Z0_O_Z0H,DTI%XPAR_Z0_O_Z0H(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
ENDIF
!
- IF (DTI%LDATA_ROOT_EXTINCTIONGV) THEN
- ALLOCATE(DTI%XPAR_ROOT_EXTINCTIONGV(IG%NDIM,NVEGTYPE))
- YRECFM='D_RT_EXTGV'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_ROOT_EXTINCTIONGV(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_DG)) THEN
+ ALLOCATE(DTI%XPAR_DG (KDIM,IO%NGROUND_LAYER,NVEGTYPE))
+ DO JL=1,SIZE(DTI%XPAR_DG,2)
+ IF (GDIM) THEN
+ WRITE(YRECFM,FMT='(A6,I2.2)') 'D_DG_L',JL
+ ELSE
+ IF (JL<10) WRITE(YRECFM,FMT='(A4,I1.1)') 'D_DG',JL
+ IF (JL>=10) WRITE(YRECFM,FMT='(A4,I2.2)') 'D_DG',JL
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_DG,DTI%XPAR_DG(:,JL,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-
- IF (DTI%LDATA_ROOT_LIN) THEN
- ALLOCATE(DTI%XPAR_ROOT_LIN(IG%NDIM,NVEGTYPE))
- YRECFM='D_ROOT_LIN'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_ROOT_LIN(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
+ END DO
ENDIF
!
- IF (DTI%LDATA_ALBNIR_VEG) THEN
- ALLOCATE(DTI%XPAR_ALBNIR_VEG(IG%NDIM,NVEGTYPE))
- YRECFM='D_ALBNIR_VEG'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_ALBNIR_VEG(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
+ IF (ANY(DTI%LDATA_ROOTFRAC)) THEN
+ ALLOCATE(DTI%XPAR_ROOTFRAC (KDIM,IO%NGROUND_LAYER,NVEGTYPE))
+ DO JL=1,SIZE(DTI%XPAR_ROOTFRAC,2)
+ IF (GDIM) THEN
+ WRITE(YRECFM,FMT='(A6,I2.2)') 'D_RTF_L',JL
+ ELSE
+ IF (JL<10) WRITE(YRECFM,FMT='(A10,I1.1)') 'D_ROOTFRAC',JL
+ IF (JL>=10) WRITE(YRECFM,FMT='(A10,I2.2)') 'D_ROOTFRAC',JL
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_ROOTFRAC,DTI%XPAR_ROOTFRAC(:,JL,:),IRESP,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ END DO
ENDIF
!
- IF (DTI%LDATA_ALBVIS_VEG) THEN
- ALLOCATE(DTI%XPAR_ALBVIS_VEG(IG%NDIM,NVEGTYPE))
- YRECFM='D_ALBVIS_VEG'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_ALBVIS_VEG(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_GROUND_DEPTH)) THEN
+ ALLOCATE(DTI%XPAR_GROUND_DEPTH(KDIM,NVEGTYPE))
+ IF (GDIM) THEN
+ YRECFM2='D_GRDPT_'
+ ELSE
+ YRECFM2='D_GROUND_DEPTH'
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM2='D_GROUND_DPT'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM2, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_GROUND_DEPTH,DTI%XPAR_GROUND_DEPTH(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
ENDIF
!
- IF (DTI%LDATA_ALBUV_VEG) THEN
- ALLOCATE(DTI%XPAR_ALBUV_VEG (IG%NDIM,NVEGTYPE))
- YRECFM='D_ALBUV_VEG'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_ALBUV_VEG(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_ROOT_DEPTH)) THEN
+ ALLOCATE(DTI%XPAR_ROOT_DEPTH(KDIM,NVEGTYPE))
+ IF (GDIM) THEN
+ YRECFM='D_RTDPT_'
+ ELSE
+ YRECFM='D_ROOT_DEPTH'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_ROOT_DEPTH,DTI%XPAR_ROOT_DEPTH(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
ENDIF
!
- IF (DTI%LDATA_ALBNIR_SOIL) THEN
- ALLOCATE(DTI%XPAR_ALBNIR_SOIL(IG%NDIM,NVEGTYPE))
- YRECFM='D_ALBNIR_SOI'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_ALBNIR_SOIL(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_ROOT_EXTINCTION)) THEN
+ ALLOCATE(DTI%XPAR_ROOT_EXTINCTION(KDIM,NVEGTYPE))
+ IF (GDIM) THEN
+ YRECFM='D_RTEXT_'
+ ELSE
+ YRECFM='D_ROOT_EXT'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_ROOT_EXTINCTION,DTI%XPAR_ROOT_EXTINCTION(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
ENDIF
-!
- IF (DTI%LDATA_ALBVIS_SOIL) THEN
- ALLOCATE(DTI%XPAR_ALBVIS_SOIL(IG%NDIM,NVEGTYPE))
- YRECFM='D_ALBVIS_SOI'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_ALBVIS_SOIL(:,:),IRESP,IVERSION,&
+
+ IF (ANY(DTI%LDATA_ROOT_LIN)) THEN
+ ALLOCATE(DTI%XPAR_ROOT_LIN(KDIM,NVEGTYPE))
+ IF (GDIM) THEN
+ YRECFM='D_RTLIN_'
+ ELSE
+ YRECFM='D_ROOT_LIN'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_ROOT_LIN,DTI%XPAR_ROOT_LIN(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
+ ENDIF
!
- IF (DTI%LDATA_ALBUV_SOIL) THEN
- ALLOCATE(DTI%XPAR_ALBUV_SOIL (IG%NDIM,NVEGTYPE))
- YRECFM='D_ALBUV_SOI'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_ALBUV_SOIL(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_DICE)) THEN
+ ALLOCATE(DTI%XPAR_DICE (KDIM,NVEGTYPE))
+ IF (GDIM) THEN
+ YRECFM='D_DICE_'
+ ELSE
+ YRECFM='D_DICE'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_DICE,DTI%XPAR_DICE(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
ENDIF
!
- IF (DTI%LDATA_GMES) THEN
- ALLOCATE(DTI%XPAR_GMES (IG%NDIM,NVEGTYPE))
- YRECFM='D_GMES'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_GMES(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_GMES)) THEN
+ ALLOCATE(DTI%XPAR_GMES (KDIM,NVEGTYPE))
+ IF (GDIM) THEN
+ YRECFM='D_GMES_'
+ ELSE
+ YRECFM='D_GMES'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_GMES,DTI%XPAR_GMES(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
ENDIF
!
- IF (DTI%LDATA_BSLAI) THEN
- ALLOCATE(DTI%XPAR_BSLAI (IG%NDIM,NVEGTYPE))
- YRECFM='D_BSLAI'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_BSLAI(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_BSLAI)) THEN
+ ALLOCATE(DTI%XPAR_BSLAI (KDIM,NVEGTYPE))
+ IF (GDIM) THEN
+ YRECFM='D_BSLAI_'
+ ELSE
+ YRECFM='D_BSLAI'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_BSLAI,DTI%XPAR_BSLAI(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
ENDIF
!
- IF (DTI%LDATA_LAIMIN) THEN
- ALLOCATE(DTI%XPAR_LAIMIN (IG%NDIM,NVEGTYPE))
- YRECFM='D_LAIMIN'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_LAIMIN(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_LAIMIN)) THEN
+ ALLOCATE(DTI%XPAR_LAIMIN (KDIM,NVEGTYPE))
+ IF (GDIM) THEN
+ YRECFM='D_LAIMIN_'
+ ELSE
+ YRECFM='D_LAIMIN'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_LAIMIN,DTI%XPAR_LAIMIN(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
ENDIF
!
- IF (DTI%LDATA_SEFOLD) THEN
- ALLOCATE(DTI%XPAR_SEFOLD (IG%NDIM,NVEGTYPE))
- YRECFM='D_SEFOLD'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_SEFOLD(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_SEFOLD)) THEN
+ ALLOCATE(DTI%XPAR_SEFOLD (KDIM,NVEGTYPE))
+ IF (GDIM) THEN
+ YRECFM='D_SEFOLD_'
+ ELSE
+ YRECFM='D_SEFOLD'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_SEFOLD,DTI%XPAR_SEFOLD(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
ENDIF
!
- IF (DTI%LDATA_GC) THEN
- ALLOCATE(DTI%XPAR_GC (IG%NDIM,NVEGTYPE))
- YRECFM='D_GC'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_GC(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_GC)) THEN
+ ALLOCATE(DTI%XPAR_GC (KDIM,NVEGTYPE))
+ IF (GDIM) THEN
+ YRECFM='D_GC_'
+ ELSE
+ YRECFM='D_GC'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_GC,DTI%XPAR_GC(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
ENDIF
!
- IF (DTI%LDATA_DMAX) THEN
- ALLOCATE(DTI%XPAR_DMAX (IG%NDIM,NVEGTYPE))
- YRECFM='D_DMAX'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_DMAX(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_DMAX)) THEN
+ ALLOCATE(DTI%XPAR_DMAX (KDIM,NVEGTYPE))
+ IF (GDIM) THEN
+ YRECFM='D_DMAX_'
+ ELSE
+ YRECFM='D_DMAX'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_DMAX,DTI%XPAR_DMAX(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
ENDIF
!
- IF (DTI%LDATA_F2I) THEN
- ALLOCATE(DTI%XPAR_F2I (IG%NDIM,NVEGTYPE))
+ IF (ANY(DTI%LDATA_F2I)) THEN
+ ALLOCATE(DTI%XPAR_F2I (KDIM,NVEGTYPE))
YRECFM='D_F2I'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_F2I(:,:),IRESP,IVERSION,&
+ IF (GDIM) THEN
+ YRECFM='D_F2I_'
+ ELSE
+ YRECFM='D_F2I'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_F2I,DTI%XPAR_F2I(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
ENDIF
!
- IF (DTI%LDATA_STRESS) THEN
- ALLOCATE(DTI%LPAR_STRESS (IG%NDIM,NVEGTYPE))
+ IF (ANY(DTI%LDATA_STRESS)) THEN
+ ALLOCATE(DTI%LPAR_STRESS (KDIM,NVEGTYPE))
ALLOCATE(ZWORK(SIZE(DTI%LPAR_STRESS,1),SIZE(DTI%LPAR_STRESS,2)))
YRECFM='D_STRESS'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,ZWORK(:,:),IRESP,IVERSION,&
+ IF (GDIM) THEN
+ YRECFM='D_STRESS_'
+ ELSE
+ YRECFM='D_STRESS'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_STRESS,ZWORK(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
DTI%LPAR_STRESS = .FALSE.
WHERE(ZWORK==1.) DTI%LPAR_STRESS = .TRUE.
DEALLOCATE(ZWORK)
ENDIF
!
- IF (DTI%LDATA_H_TREE) THEN
- ALLOCATE(DTI%XPAR_H_TREE (IG%NDIM,NVEGTYPE))
- YRECFM='D_H_TREE'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_H_TREE(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_H_TREE)) THEN
+ ALLOCATE(DTI%XPAR_H_TREE (KDIM,NVEGTYPE))
+ IF (GDIM) THEN
+ YRECFM='D_H_TREE_'
+ ELSE
+ YRECFM='D_H_TREE'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_H_TREE,DTI%XPAR_H_TREE(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
ENDIF
!
- IF (DTI%LDATA_RE25) THEN
- ALLOCATE(DTI%XPAR_RE25 (IG%NDIM,NVEGTYPE))
- YRECFM='D_RE25'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_RE25(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_RE25)) THEN
+ ALLOCATE(DTI%XPAR_RE25 (KDIM,NVEGTYPE))
+ IF (GDIM) THEN
+ YRECFM='D_RE25_'
+ ELSE
+ YRECFM='D_RE25'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_RE25,DTI%XPAR_RE25(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
ENDIF
!
- IF (DTI%LDATA_CE_NITRO) THEN
- ALLOCATE(DTI%XPAR_CE_NITRO (IG%NDIM,NVEGTYPE))
- YRECFM='D_CE_NITRO'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_CE_NITRO(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_CE_NITRO)) THEN
+ ALLOCATE(DTI%XPAR_CE_NITRO (KDIM,NVEGTYPE))
+ IF (GDIM) THEN
+ YRECFM='D_CENITR_'
+ ELSE
+ YRECFM='D_CE_NITRO'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_CE_NITRO,DTI%XPAR_CE_NITRO(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
ENDIF
!
- IF (DTI%LDATA_CF_NITRO) THEN
- ALLOCATE(DTI%XPAR_CF_NITRO (IG%NDIM,NVEGTYPE))
- YRECFM='D_CF_NITRO'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_CF_NITRO(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_CF_NITRO)) THEN
+ ALLOCATE(DTI%XPAR_CF_NITRO (KDIM,NVEGTYPE))
+ IF (GDIM) THEN
+ YRECFM='D_CFNITR_'
+ ELSE
+ YRECFM='D_CF_NITRO'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_CF_NITRO,DTI%XPAR_CF_NITRO(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
ENDIF
!
- IF (DTI%LDATA_CNA_NITRO) THEN
- ALLOCATE(DTI%XPAR_CNA_NITRO (IG%NDIM,NVEGTYPE))
- YRECFM='D_CNA_NITRO'
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_CNA_NITRO(:,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_CNA_NITRO)) THEN
+ ALLOCATE(DTI%XPAR_CNA_NITRO (KDIM,NVEGTYPE))
+ IF (GDIM) THEN
+ YRECFM='D_CNANIT_'
+ ELSE
+ YRECFM='D_CNA_NITRO'
+ ENDIF
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_CNA_NITRO,DTI%XPAR_CNA_NITRO(:,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
ENDIF
!
- IF (DTI%LDATA_IRRIG) THEN
- ALLOCATE(DTI%XPAR_IRRIG (IG%NDIM,DTI%NTIME,NVEGTYPE))
- DO JTIME=1,ITIME
- WRITE(YRECFM,FMT='(A9,I2.2)') 'D_IRRIG_T',JTIME
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_IRRIG(:,JTIME,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_IRRIG)) THEN
+ ALLOCATE(DTI%XPAR_IRRIG (KDIM,DTI%NTIME,NVEGTYPE))
+ DO JT=1,ITIME
+ ID1 = (JT-1)*NVEGTYPE + 1
+ ID2 = JT*NVEGTYPE
+ IF (GDIM) THEN
+ WRITE(YRECFM,FMT='(A9,I2.2)') 'D_IRR_T',JT
+ ELSE
+ WRITE(YRECFM,FMT='(A9,I2.2)') 'D_IRRIG_T',JT
+ ENDIF
+ IF (GTIME(JT)) THEN
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_IRRIG(ID1:ID2),DTI%XPAR_IRRIG(:,JT,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ELSE
+ DTI%XPAR_IRRIG(:,JT,:) = XUNDEF
+ ENDIF
END DO
ENDIF
!
- IF (DTI%LDATA_WATSUP) THEN
- ALLOCATE(DTI%XPAR_WATSUP (IG%NDIM,DTI%NTIME,NVEGTYPE))
- DO JTIME=1,ITIME
- WRITE(YRECFM,FMT='(A10,I2.2)') 'D_WATSUP_T',JTIME
- CALL READ_SURF_ISBA_PAR_n(DTCO, U, I,GCP, &
- HPROGRAM,YRECFM,ILUOUT,KSIZE,DTI%XPAR_WATSUP(:,JTIME,:),IRESP,IVERSION,&
+ IF (ANY(DTI%LDATA_WATSUP)) THEN
+ ALLOCATE(DTI%XPAR_WATSUP (KDIM,DTI%NTIME,NVEGTYPE))
+ DO JT=1,ITIME
+ ID1 = (JT-1)*NVEGTYPE + 1
+ ID2 = JT*NVEGTYPE
+ IF (GDIM) THEN
+ WRITE(YRECFM,FMT='(A10,I2.2)') 'D_WAT_T',JT
+ ELSE
+ WRITE(YRECFM,FMT='(A10,I2.2)') 'D_WATSUP_T',JT
+ ENDIF
+ IF (GTIME(JT)) THEN
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_WATSUP(ID1:ID2),DTI%XPAR_WATSUP(:,JT,:),IRESP,&
HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ELSE
+ DTI%XPAR_WATSUP(:,JT,:) = XUNDEF
+ ENDIF
END DO
ENDIF
!
+ IF (GDIM) THEN
+
+ IF (ANY(DTI%LDATA_SEED_M)) THEN
+ ALLOCATE(DTI%XPAR_SEED_M (KDIM,NVEGTYPE))
+ YRECFM='D_SEED_M_'
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_SEED_M,DTI%XPAR_SEED_M(:,:),IRESP,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+
+!
+ IF (ANY(DTI%LDATA_SEED_D)) THEN
+ ALLOCATE(DTI%XPAR_SEED_D (KDIM,NVEGTYPE))
+ YRECFM='D_SEED_D_'
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_SEED_D,DTI%XPAR_SEED_D(:,:),IRESP,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (ANY(DTI%LDATA_REAP_M)) THEN
+ ALLOCATE(DTI%XPAR_REAP_M (KDIM,NVEGTYPE))
+ YRECFM='D_REAP_M_'
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_REAP_M,DTI%XPAR_REAP_M(:,:),IRESP,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (ANY(DTI%LDATA_REAP_D)) THEN
+ ALLOCATE(DTI%XPAR_REAP_D (KDIM,NVEGTYPE))
+ YRECFM='D_REAP_D_'
+ CALL READ_SURF_ISBA_PAR_n(DTCO, U, GCP, IO%NPATCH, HPROGRAM, YRECFM, ILUOUT, KSIZE, &
+ IVERSION, IBUGFIX, DTI%LDATA_REAP_D,DTI%XPAR_REAP_D(:,:),IRESP,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+ !
+ ALLOCATE(ZWORK(KSIZE,IO%NGROUND_LAYER))
+ !
+ IF (DTI%LDATA_CONDSAT) THEN
+ ALLOCATE(DTI%XPAR_CONDSAT(KDIM,IO%NGROUND_LAYER))
+ DO JL=1,SIZE(DTI%XPAR_CONDSAT,2)
+ WRITE(YRECFM,FMT='(A10,I2.2)') 'D_CNDSAT_L',JL
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JL),IRESP,HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDDO
+ IF (KDIM/=KSIZE) THEN
+ CALL HOR_INTERPOL(DTCO, U, GCP, ILUOUT,ZWORK,DTI%XPAR_CONDSAT)
+ ELSE
+ DTI%XPAR_CONDSAT(:,:) = ZWORK(:,:)
+ ENDIF
+ ENDIF
+ !
+ IF (DTI%LDATA_MPOTSAT) THEN
+ ALLOCATE(DTI%XPAR_MPOTSAT(KDIM,IO%NGROUND_LAYER))
+ DO JL=1,SIZE(DTI%XPAR_MPOTSAT,2)
+ WRITE(YRECFM,FMT='(A10,I2.2)') 'D_MPTSAT_L',JL
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JL),IRESP,HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDDO
+ IF (KDIM/=KSIZE) THEN
+ CALL HOR_INTERPOL(DTCO, U, GCP, ILUOUT,ZWORK,DTI%XPAR_MPOTSAT)
+ ELSE
+ DTI%XPAR_MPOTSAT(:,:) = ZWORK(:,:)
+ ENDIF
+ ENDIF
+ !
+ IF (DTI%LDATA_BCOEF) THEN
+ ALLOCATE(DTI%XPAR_BCOEF(KDIM,IO%NGROUND_LAYER))
+ DO JL=1,SIZE(DTI%XPAR_BCOEF,2)
+ WRITE(YRECFM,FMT='(A9,I2.2)') 'D_BCOEF_L',JL
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JL),IRESP,HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDDO
+ IF (KDIM/=KSIZE) THEN
+ CALL HOR_INTERPOL(DTCO, U, GCP, ILUOUT,ZWORK,DTI%XPAR_BCOEF)
+ ELSE
+ DTI%XPAR_BCOEF(:,:) = ZWORK(:,:)
+ ENDIF
+ ENDIF
+ !
+ IF (DTI%LDATA_WWILT) THEN
+ ALLOCATE(DTI%XPAR_WWILT(KDIM,IO%NGROUND_LAYER))
+ DO JL=1,SIZE(DTI%XPAR_WWILT,2)
+ WRITE(YRECFM,FMT='(A9,I2.2)') 'D_WWILT_L',JL
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JL),IRESP,HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDDO
+ IF (KDIM/=KSIZE) THEN
+ CALL HOR_INTERPOL(DTCO, U, GCP, ILUOUT,ZWORK,DTI%XPAR_WWILT)
+ ELSE
+ DTI%XPAR_WWILT(:,:) = ZWORK(:,:)
+ ENDIF
+ ENDIF
+ !
+ IF (DTI%LDATA_WFC) THEN
+ ALLOCATE(DTI%XPAR_WFC(KDIM,IO%NGROUND_LAYER))
+ DO JL=1,SIZE(DTI%XPAR_WFC,2)
+ WRITE(YRECFM,FMT='(A7,I2.2)') 'D_WFC_L',JL
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JL),IRESP,HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDDO
+ IF (KDIM/=KSIZE) THEN
+ CALL HOR_INTERPOL(DTCO, U, GCP, ILUOUT,ZWORK,DTI%XPAR_WFC)
+ ELSE
+ DTI%XPAR_WFC(:,:) = ZWORK(:,:)
+ ENDIF
+ ENDIF
+ !
+ IF (DTI%LDATA_WSAT) THEN
+ ALLOCATE(DTI%XPAR_WSAT(KDIM,IO%NGROUND_LAYER))
+ DO JL=1,SIZE(DTI%XPAR_WSAT,2)
+ WRITE(YRECFM,FMT='(A8,I2.2)') 'D_WSAT_L',JL
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JL),IRESP,HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDDO
+ IF (KDIM/=KSIZE) THEN
+ CALL HOR_INTERPOL(DTCO, U, GCP, ILUOUT,ZWORK,DTI%XPAR_WSAT)
+ ELSE
+ DTI%XPAR_WSAT(:,:) = ZWORK(:,:)
+ ENDIF
+ ENDIF
+ !
+ DEALLOCATE(ZWORK)
+ !
+ ENDIF
+ !
ENDIF
!
IF (LASSIM) LREAD_ALL = GREAD_ALL
diff --git a/src/SURFEX/read_pgd_isban.F90 b/src/SURFEX/read_pgd_isban.F90
index 3efc7093240b0a334b87a9670f5edba7003c94d4..532c0c7e96fb6f64886c03ef9e8212683be12701 100644
--- a/src/SURFEX/read_pgd_isban.F90
+++ b/src/SURFEX/read_pgd_isban.F90
@@ -3,9 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_PGD_ISBA_n (CHI, DTCO, DTI, DTZ, DGU, GB, IG, I, &
- UG, U, SV,GCP, &
- HPROGRAM,OLAND_USE)
+ SUBROUTINE READ_PGD_ISBA_n (CHI, DTCO, DTV, DTZ, GB, IG, ISS, IO, S, K, &
+ UG, U, USS, GCP, SV, HPROGRAM, OLAND_USE, TPDATE_END)
! #########################################
!
!!**** *READ_PGD_ISBA_n* - routine to initialise ISBA physiographic variables
@@ -42,7 +41,7 @@
!! 11/2013 : same for groundwater distribution
!! 11/2014 : Read XSOILGRID as a series of real
!! P. Samuelsson 10/2014 : MEB
-!! M. Moge 02/2015 READ_SURF // + MPPDB_CHECK
+!! 10/2016 B. Decharme : bug surface/groundwater coupling
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -53,14 +52,16 @@ USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
USE MODD_DATA_TSZ0_n, ONLY : DATA_TSZ0_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
USE MODD_SV_n, ONLY : SV_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
!
USE MODD_TYPE_DATE_SURF
!
@@ -69,14 +70,14 @@ USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_ISBA_PAR, ONLY : XOPTIMGRID
!
-USE MODE_READ_SURF_COV, ONLY : READ_SURF_COV
+USE MODI_READ_NAM_PGD_ISBA
!
USE MODI_INIT_IO_SURF_n
USE MODI_END_IO_SURF_n
!
USE MODI_READ_SURF
-USE MODI_READ_GRID
-USE MODI_READ_LCOVER
+USE MODI_PACK_INIT
+USE MODI_PACK_SSO
USE MODI_READ_PGD_ISBA_PAR_n
USE MODI_READ_PGD_TSZ0_PAR_n
!
@@ -92,10 +93,6 @@ USE MODI_GET_LUOUT
USE MODI_PACK_SAME_RANK
USE MODI_GET_SURF_MASK_n
!
-#ifdef MNH_PARALLEL
-USE MODE_MPPDB
-!
-#endif
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -104,19 +101,23 @@ IMPLICIT NONE
!
TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
TYPE(DATA_TSZ0_t), INTENT(INOUT) :: DTZ
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(GR_BIOG_t), INTENT(INOUT) :: GB
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(GRID_t), INTENT(INOUT) :: IG
+TYPE(SSO_t), INTENT(INOUT) :: ISS
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SV_t), INTENT(INOUT) :: SV
+TYPE(SSO_t), INTENT(INOUT) :: USS
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+TYPE(SV_t), INTENT(INOUT) :: SV
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
LOGICAL, INTENT(IN) :: OLAND_USE !
+TYPE(DATE), INTENT(IN) :: TPDATE_END
!
!* 0.2 Declarations of local variables
! -------------------------------
@@ -125,16 +126,62 @@ INTEGER, DIMENSION(:), POINTER :: IMASK ! mask for packing from complete field
!
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK
!
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=4 ) :: YLVL
+CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=4 ) :: YLVL
!
+INTEGER :: ISIZE_LMEB_PATCH ! Number of patches with MEB=true
INTEGER :: ILU ! expected physical size of full surface array
INTEGER :: ILUOUT ! output listing logical unit
INTEGER :: IRESP ! Error code after redding
INTEGER :: JLAYER ! loop counter on layers
INTEGER :: IVERSION, IBUGFIX ! surface version
!
-INTEGER :: ISIZE_LMEB_PATCH ! Number of patches with MEB=true
+INTEGER :: IPATCH ! number of patches
+INTEGER :: IGROUND_LAYER ! number of soil layers
+INTEGER :: JVEGTYPE
+CHARACTER(LEN=3) :: YISBA ! ISBA option
+CHARACTER(LEN=4) :: YPEDOTF ! Pedo transfert function for DIF
+CHARACTER(LEN=3) :: YPHOTO ! photosynthesis option
+LOGICAL :: GTR_ML ! new radiative transfert
+CHARACTER(LEN=4) :: YALBEDO
+REAL :: ZRM_PATCH ! threshold to remove little fractions of patches
+CHARACTER(LEN=28) :: YSAND ! file name for sand fraction
+CHARACTER(LEN=28) :: YCLAY ! file name for clay fraction
+CHARACTER(LEN=28) :: YSOC_TOP ! file name for organic carbon top soil
+CHARACTER(LEN=28) :: YSOC_SUB ! file name for organic carbon sub soil
+CHARACTER(LEN=28) :: YCTI ! file name for topographic index
+CHARACTER(LEN=28) :: YRUNOFFB ! file name for runoffb parameter
+CHARACTER(LEN=28) :: YWDRAIN ! file name for wdrain parameter
+CHARACTER(LEN=28) :: YPERM ! file name for permafrost distribution
+CHARACTER(LEN=6) :: YSANDFILETYPE ! sand data file type
+CHARACTER(LEN=6) :: YCLAYFILETYPE ! clay data file type
+CHARACTER(LEN=6) :: YSOCFILETYPE ! organic carbon data file type
+CHARACTER(LEN=6) :: YCTIFILETYPE ! topographic index data file type
+CHARACTER(LEN=6) :: YRUNOFFBFILETYPE ! subgrid runoff data file type
+CHARACTER(LEN=6) :: YWDRAINFILETYPE ! subgrid drainage data file type
+CHARACTER(LEN=6) :: YPERMFILETYPE ! permafrost distribution data file type
+REAL :: XUNIF_SAND ! uniform value of sand fraction (-)
+REAL :: XUNIF_CLAY ! uniform value of clay fraction (-)
+REAL :: XUNIF_SOC_TOP ! uniform value of organic carbon top soil (kg/m2)
+REAL :: XUNIF_SOC_SUB ! uniform value of organic carbon sub soil (kg/m2)
+REAL :: XUNIF_RUNOFFB ! uniform value of subgrid runoff coefficient
+REAL :: XUNIF_WDRAIN ! uniform subgrid drainage parameter
+REAL :: XUNIF_PERM ! uniform permafrost distribution
+LOGICAL :: LIMP_SAND ! Imposed maps of Sand
+LOGICAL :: LIMP_CLAY ! Imposed maps of Clay
+LOGICAL :: LIMP_SOC ! Imposed maps of organic carbon
+LOGICAL :: LIMP_CTI ! Imposed maps of topographic index statistics
+LOGICAL :: LIMP_PERM ! Imposed maps of permafrost distribution
+REAL, DIMENSION(150) :: ZSOILGRID ! Soil grid reference for DIF
+CHARACTER(LEN=28) :: YPH ! file name for pH
+CHARACTER(LEN=28) :: YFERT ! file name for fertilisation rate
+CHARACTER(LEN=6) :: YPHFILETYPE ! pH data file type
+CHARACTER(LEN=6) :: YFERTFILETYPE ! fertilisation data file type
+REAL :: XUNIF_PH ! uniform value of pH
+REAL :: XUNIF_FERT ! uniform value of fertilisation rate
+LOGICAL :: GMEB ! Multi-energy balance (MEB)
+!
+LOGICAL :: GECOSG
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -144,16 +191,13 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('READ_PGD_ISBA_N',0,ZHOOK_HANDLE)
YRECFM='SIZE_NATURE'
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'NATURE',IG%NDIM)
+ CALL GET_TYPE_DIM_n(DTCO, U, 'NATURE',IG%NDIM)
!
YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
!
YRECFM='BUG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IBUGFIX,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
!
!* 2. Dimension initializations:
! -------------------------
@@ -161,37 +205,55 @@ YRECFM='BUG'
!* soil scheme
!
YRECFM='ISBA'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%CISBA,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%CISBA,IRESP)
!
IF (IVERSION>=7) THEN
!
!* Pedo-transfert function
!
YRECFM='PEDOTF'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%CPEDOTF,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%CPEDOTF,IRESP)
!
ELSE
- I%CPEDOTF = 'CH78'
+ IO%CPEDOTF = 'CH78'
ENDIF
!
!* type of photosynthesis
!
YRECFM='PHOTO'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%CPHOTO,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%CPHOTO,IRESP)
!
!* new radiative transfert
!
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN
!
YRECFM='TR_ML'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%LTR_ML,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%LTR_ML,IRESP)
!
ELSE
- I%LTR_ML = .FALSE.
+ IO%LTR_ML = .FALSE.
+ENDIF
+!
+IF (IVERSION>8 .OR. IVERSION==8 .AND. IBUGFIX>=1) THEN
+ !
+ YRECFM='ALBEDO'
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%CALBEDO,IRESP)
+ !
+ELSE
+ !
+ CALL READ_NAM_PGD_ISBA(HPROGRAM, IPATCH, IGROUND_LAYER, &
+ YISBA, YPEDOTF, YPHOTO, GTR_ML, YALBEDO, ZRM_PATCH, &
+ YCLAY, YCLAYFILETYPE, XUNIF_CLAY, LIMP_CLAY, &
+ YSAND, YSANDFILETYPE, XUNIF_SAND, LIMP_SAND, &
+ YSOC_TOP, YSOC_SUB, YSOCFILETYPE, XUNIF_SOC_TOP, &
+ XUNIF_SOC_SUB, LIMP_SOC, YCTI, YCTIFILETYPE, LIMP_CTI, &
+ YPERM, YPERMFILETYPE, XUNIF_PERM, LIMP_PERM, GMEB, &
+ YRUNOFFB, YRUNOFFBFILETYPE, XUNIF_RUNOFFB, &
+ YWDRAIN, YWDRAINFILETYPE , XUNIF_WDRAIN, ZSOILGRID, &
+ YPH, YPHFILETYPE, XUNIF_PH, YFERT, YFERTFILETYPE, &
+ XUNIF_FERT )
+ IO%CALBEDO = YALBEDO
+ !
ENDIF
!
!* threshold to remove little fractions of patches
@@ -199,95 +261,88 @@ ENDIF
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
!
YRECFM='RM_PATCH'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XRM_PATCH,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%XRM_PATCH,IRESP)
!
ELSE
- I%XRM_PATCH = 0.0
+ IO%XRM_PATCH = 0.0
ENDIF
!
!* number of soil layers
!
YRECFM='GROUND_LAYER'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%NGROUND_LAYER,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%NGROUND_LAYER,IRESP)
!
!* Reference grid for DIF
!
-IF(I%CISBA=='DIF') THEN
- ALLOCATE(I%XSOILGRID(I%NGROUND_LAYER))
- I%XSOILGRID=XUNDEF
+IF(IO%CISBA=='DIF') THEN
+ ALLOCATE(IO%XSOILGRID(IO%NGROUND_LAYER))
+ IO%XSOILGRID=XUNDEF
IF (IVERSION>=8) THEN
- DO JLAYER=1,I%NGROUND_LAYER
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='SOILGRID'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XSOILGRID(JLAYER),IRESP)
- ENDDO
+ DO JLAYER=1,IO%NGROUND_LAYER
+ WRITE(YLVL,'(I4)') JLAYER
+ YRECFM='SOILGRID'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%XSOILGRID(JLAYER),IRESP)
+ ENDDO
ELSEIF (IVERSION==7 .AND. IBUGFIX>=2) THEN
YRECFM='SOILGRID'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XSOILGRID,IRESP,HDIR='-')
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%XSOILGRID,IRESP,HDIR='-')
ELSE
- I%XSOILGRID(1:I%NGROUND_LAYER)=XOPTIMGRID(1:I%NGROUND_LAYER)
+ IO%XSOILGRID(1:IO%NGROUND_LAYER)=XOPTIMGRID(1:IO%NGROUND_LAYER)
ENDIF
ELSE
- ALLOCATE(I%XSOILGRID(0))
+ ALLOCATE(IO%XSOILGRID(0))
ENDIF
!
!* number of biomass pools
!
IF (IVERSION>=6) THEN
YRECFM='NBIOMASS'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%NNBIOMASS,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%NNBIOMASS,IRESP)
ELSE
- SELECT CASE (I%CPHOTO)
- CASE ('AGS','LAI','AST','LST')
- I%NNBIOMASS = 1
+ SELECT CASE (IO%CPHOTO)
+ CASE ('AST')
+ IO%NNBIOMASS = 1
CASE ('NIT')
- I%NNBIOMASS = 3
+ IO%NNBIOMASS = 3
CASE ('NCB')
- I%NNBIOMASS = 6
+ IO%NNBIOMASS = 6
END SELECT
ENDIF
!
!* number of tiles
!
YRECFM='PATCH_NUMBER'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%NPATCH,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%NPATCH,IRESP)
!
!* logical vector indicating for which patches MEB should be applied
!
-ALLOCATE(I%LMEB_PATCH(I%NPATCH))
+ALLOCATE(IO%LMEB_PATCH(IO%NPATCH))
!
IF (IVERSION>=8) THEN
!
- YRECFM='MEB_PATCH'
- CALL READ_SURF(HPROGRAM,YRECFM,I%LMEB_PATCH(:),IRESP,HDIR='-')
-!
- ISIZE_LMEB_PATCH = COUNT(I%LMEB_PATCH(:))
-!
- IF (ISIZE_LMEB_PATCH>0)THEN
- YRECFM='FORC_MEASURE'
- CALL READ_SURF(HPROGRAM,YRECFM,I%LFORC_MEASURE,IRESP)
- YRECFM='MEB_LITTER'
- CALL READ_SURF(HPROGRAM,YRECFM,I%LMEB_LITTER,IRESP)
- YRECFM='MEB_GNDRES'
- CALL READ_SURF(HPROGRAM,YRECFM,I%LMEB_GNDRES,IRESP)
-
- ELSE
- I%LFORC_MEASURE=.FALSE.
- I%LMEB_LITTER =.FALSE.
- I%LMEB_GNDRES =.FALSE.
- ENDIF
+ YRECFM='MEB_PATCH'
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%LMEB_PATCH(:),IRESP,HDIR='-')
+!
+ ISIZE_LMEB_PATCH = COUNT(IO%LMEB_PATCH(:))
+!
+ IF (ISIZE_LMEB_PATCH>0)THEN
+ YRECFM='FORC_MEASURE'
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%LFORC_MEASURE,IRESP)
+ YRECFM='MEB_LITTER'
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%LMEB_LITTER,IRESP)
+ YRECFM='MEB_GNDRES'
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%LMEB_GNDRES,IRESP)
+ ELSE
+ IO%LFORC_MEASURE=.FALSE.
+ IO%LMEB_LITTER =.FALSE.
+ IO%LMEB_GNDRES =.FALSE.
+ ENDIF
!
ELSE
- I%LMEB_PATCH(:)=.FALSE.
- I%LFORC_MEASURE=.FALSE.
- I%LMEB_LITTER =.FALSE.
- I%LMEB_GNDRES =.FALSE.
+ IO%LMEB_PATCH(:)=.FALSE.
+ IO%LFORC_MEASURE=.FALSE.
+ IO%LMEB_LITTER =.FALSE.
+ IO%LMEB_GNDRES =.FALSE.
ENDIF
!
!
@@ -298,93 +353,61 @@ ENDIF
!* 3.1 Cover classes :
! -------------
!
-ALLOCATE(I%LCOVER(JPCOVER))
- CALL READ_LCOVER(&
- HPROGRAM,I%LCOVER)
-!
-ALLOCATE(I%XCOVER(IG%NDIM,COUNT(I%LCOVER)))
-#ifdef MNH_PARALLEL
- CALL READ_SURF_COV(&
- HPROGRAM,'COVER',I%XCOVER(:,:),I%LCOVER,IRESP,HDIR='H')
- CALL MPPDB_CHECK_SURFEX3D(I%XCOVER,"READ_PGD_ISBA_n after READ_SURF:XCOVER",PRECISION,ILUOUT,'NATURE',SIZE(I%XCOVER,2))
-#else
- CALL READ_SURF_COV(&
- HPROGRAM,'COVER',I%XCOVER(:,:),I%LCOVER,IRESP)
-#endif
-!
-!* 3.2 Orography :
-! ---------
-!
-!
-ALLOCATE(I%XZS(IG%NDIM))
-YRECFM='ZS'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XZS(:),IRESP)
-!
-!
-!* latitude, longitude, mesh size, and heading of JP axis (deg from N clockwise)
+ALLOCATE(S%LCOVER(JPCOVER))
+ALLOCATE(S%XZS(IG%NDIM))
!
ALLOCATE(IG%XLAT (IG%NDIM))
ALLOCATE(IG%XLON (IG%NDIM))
ALLOCATE(IG%XMESH_SIZE (IG%NDIM))
-ALLOCATE(I%XZ0EFFJPDIR(IG%NDIM))
- CALL READ_GRID(&
- HPROGRAM,IG%CGRID,IG%XGRID_PAR,IG%XLAT,IG%XLON,IG%XMESH_SIZE,IRESP,I%XZ0EFFJPDIR)
-#ifdef MNH_PARALLEL
- CALL MPPDB_CHECK_SURFEX2D(IG%XLAT,"READ_PGD_ISBA_n after READ_GRID:XLAT",PRECISION,ILUOUT,'NATURE')
- CALL MPPDB_CHECK_SURFEX2D(IG%XLON,"READ_PGD_ISBA_n after READ_GRID:XLON",PRECISION,ILUOUT,'NATURE')
- CALL MPPDB_CHECK_SURFEX2D(IG%XMESH_SIZE,"READ_PGD_ISBA_n after READ_GRID:XMESH_SIZE",PRECISION,ILUOUT,'NATURE')
-#endif
+!
+ALLOCATE(ISS%XZ0EFFJPDIR(IG%NDIM))
+!
+CALL PACK_INIT(DTCO, U, UG, HPROGRAM, 'NATURE', IG, S%LCOVER, S%XCOVER, S%XZS, ISS%XZ0EFFJPDIR )
!
!* clay fraction : attention, seul un niveau est present dans le fichier
!* on rempli tout les niveaux de XCLAY avec les valeurs du fichiers
!
-ALLOCATE(I%XCLAY(IG%NDIM,I%NGROUND_LAYER))
+ALLOCATE(K%XCLAY(IG%NDIM,IO%NGROUND_LAYER))
YRECFM='CLAY'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XCLAY(:,1),IRESP)
-DO JLAYER=2,I%NGROUND_LAYER
- I%XCLAY(:,JLAYER)=I%XCLAY(:,1)
+ CALL READ_SURF(HPROGRAM,YRECFM,K%XCLAY(:,1),IRESP)
+DO JLAYER=2,IO%NGROUND_LAYER
+ K%XCLAY(:,JLAYER) = K%XCLAY(:,1)
END DO
!
!* sand fraction
!
-ALLOCATE(I%XSAND(IG%NDIM,I%NGROUND_LAYER))
+ALLOCATE(K%XSAND(IG%NDIM,IO%NGROUND_LAYER))
YRECFM='SAND'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XSAND(:,1),IRESP)
-DO JLAYER=2,I%NGROUND_LAYER
- I%XSAND(:,JLAYER)=I%XSAND(:,1)
+ CALL READ_SURF(HPROGRAM,YRECFM,K%XSAND(:,1),IRESP)
+DO JLAYER=2,IO%NGROUND_LAYER
+ K%XSAND(:,JLAYER) = K%XSAND(:,1)
END DO
!
!* Soil organic carbon profile
!
IF (IVERSION>7 .OR. (IVERSION==7 .AND. IBUGFIX>=3)) THEN
YRECFM='SOCP'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%LSOCP,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%LSOCP,IRESP)
ELSE
- I%LSOCP=.FALSE.
+ IO%LSOCP=.FALSE.
ENDIF
!
-IF(I%LSOCP)THEN
+IF(IO%LSOCP)THEN
!
- ALLOCATE(I%XSOC (IG%NDIM,I%NGROUND_LAYER))
+ ALLOCATE(S%XSOC (IG%NDIM,IO%NGROUND_LAYER))
!
YRECFM='SOC_TOP'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XSOC(:,1),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XSOC(:,1),IRESP)
YRECFM='SOC_SUB'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XSOC(:,2),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XSOC(:,2),IRESP)
!
- DO JLAYER=2,I%NGROUND_LAYER
- I%XSOC (:,JLAYER)=I%XSOC (:,2)
+ DO JLAYER=2,IO%NGROUND_LAYER
+ S%XSOC (:,JLAYER)=S%XSOC (:,2)
END DO
!
ELSE
!
- ALLOCATE(I%XSOC (0,1))
+ ALLOCATE(S%XSOC (0,1))
!
ENDIF
!
@@ -392,201 +415,122 @@ ENDIF
!
IF (IVERSION>7 .OR. (IVERSION==7 .AND. IBUGFIX>=3)) THEN
YRECFM='PERMAFROST'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%LPERM,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%LPERM,IRESP)
ELSE
- I%LPERM=.FALSE.
+ IO%LPERM=.FALSE.
ENDIF
!
-IF(I%LPERM)THEN
+IF(IO%LPERM)THEN
!
- ALLOCATE(I%XPERM (IG%NDIM))
+ ALLOCATE(K%XPERM (IG%NDIM))
!
YRECFM='PERM'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XPERM(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,K%XPERM(:),IRESP)
!
ELSE
!
- ALLOCATE(I%XPERM (0))
-!
-ENDIF
-!
-!* groundwater distribution
+ ALLOCATE(K%XPERM (0))
!
-IF (IVERSION>=8) THEN
- YRECFM='GWKEY'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%LGW,IRESP)
-ELSE
- I%LGW=.FALSE.
ENDIF
!
-IF(I%LGW)THEN
-!
- ALLOCATE(I%XGW (IG%NDIM))
-!
- YRECFM='GWFRAC'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XGW(:),IRESP)
- WHERE(I%XGW(:)==XUNDEF)I%XGW(:)=0.0
-!
-ELSE
-!
- ALLOCATE(I%XGW (0))
-!
-ENDIF
+!SOILNOX
!
IF (IVERSION>7 .OR. (IVERSION==7 .AND. IBUGFIX>=3)) THEN
YRECFM='NO'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%LNOF,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%LNOF,IRESP)
ELSE
- I%LNOF = .FALSE.
+ IO%LNOF = .FALSE.
ENDIF
!
-!SOILNOX
-!
IF (CHI%LCH_NO_FLUX) THEN
!
- IF (I%LNOF) THEN
+ IF (IO%LNOF) THEN
!
- ALLOCATE(I%XPH(IG%NDIM))
+ ALLOCATE(S%XPH(IG%NDIM))
YRECFM='PH'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XPH(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XPH(:),IRESP)
!
- ALLOCATE(I%XFERT(IG%NDIM))
+ ALLOCATE(S%XFERT(IG%NDIM))
YRECFM='FERT'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XFERT(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XFERT(:),IRESP)
!
ELSE
CALL ABOR1_SFX("READ_PGD_ISBAn: WITH LCH_NO_FLUX=T, PH AND FERT FIELDS ARE GIVEN AT PGD STEP")
ENDIF
!
ELSE
- ALLOCATE(I%XPH (0))
- ALLOCATE(I%XFERT(0))
+ ALLOCATE(S%XPH (0))
+ ALLOCATE(S%XFERT(0))
END IF
!
!* subgrid-scale orography parameters to compute dynamical roughness length
!
-ALLOCATE(I%XAOSIP(IG%NDIM))
-YRECFM='AOSIP'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XAOSIP,IRESP)
-!
-ALLOCATE(I%XAOSIM(IG%NDIM))
-YRECFM='AOSIM'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XAOSIM,IRESP)
-
-ALLOCATE(I%XAOSJP(IG%NDIM))
-YRECFM='AOSJP'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XAOSJP,IRESP)
-!
-ALLOCATE(I%XAOSJM(IG%NDIM))
-YRECFM='AOSJM'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XAOSJM,IRESP)
-!
-ALLOCATE(I%XHO2IP(IG%NDIM))
-YRECFM='HO2IP'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XHO2IP,IRESP)
-!
-ALLOCATE(I%XHO2IM(IG%NDIM))
-YRECFM='HO2IM'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XHO2IM,IRESP)
-!
-ALLOCATE(I%XHO2JP(IG%NDIM))
-YRECFM='HO2JP'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XHO2JP,IRESP)
-!
-ALLOCATE(I%XHO2JM(IG%NDIM))
-YRECFM='HO2JM'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XHO2JM,IRESP)
-!
-!* orographic parameter to compute effective surface of energy exchanges
-!
-ALLOCATE(I%XSSO_SLOPE(IG%NDIM))
-YRECFM='SSO_SLOPE'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XSSO_SLOPE,IRESP)
-!
-!* orographic standard deviation for subgrid-scale orographic drag
-!
-ALLOCATE(I%XSSO_STDEV(IG%NDIM))
-YRECFM='SSO_STDEV'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XSSO_STDEV(:),IRESP)
+ALLOCATE(ISS%XAOSIP(IG%NDIM))
+ALLOCATE(ISS%XAOSIM(IG%NDIM))
+ALLOCATE(ISS%XAOSJP(IG%NDIM))
+ALLOCATE(ISS%XAOSJM(IG%NDIM))
+ALLOCATE(ISS%XHO2IP(IG%NDIM))
+ALLOCATE(ISS%XHO2IM(IG%NDIM))
+ALLOCATE(ISS%XHO2JP(IG%NDIM))
+ALLOCATE(ISS%XHO2JM(IG%NDIM))
+ALLOCATE(ISS%XSSO_SLOPE(IG%NDIM))
+ALLOCATE(ISS%XSSO_STDEV(IG%NDIM))
+!
+ CALL PACK_SSO(USS,HPROGRAM,U%NR_NATURE, ISS)
!
!* orographic runoff coefficient
!
-ALLOCATE(I%XRUNOFFB(IG%NDIM))
+ALLOCATE(K%XRUNOFFB(IG%NDIM))
YRECFM='RUNOFFB'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XRUNOFFB,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,K%XRUNOFFB,IRESP)
!
!* subgrid drainage coefficient
!
-ALLOCATE(I%XWDRAIN(IG%NDIM))
+ALLOCATE(K%XWDRAIN(IG%NDIM))
IF (IVERSION<=3) THEN
- I%XWDRAIN = 0.
+ K%XWDRAIN = 0.
ELSE
YRECFM='WDRAIN'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XWDRAIN,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,K%XWDRAIN,IRESP)
ENDIF
!
!* topographic index statistics
!
-IF(I%CRUNOFF=='SGH ' .AND. IVERSION>=5) THEN
+IF(IO%CRUNOFF=='SGH ' .AND. IVERSION>=5) THEN
!
YRECFM='CTI'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%LCTI,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%LCTI,IRESP)
!
- IF (.NOT.I%LCTI) CALL ABOR1_SFX("READ_PGD_ISBA_n:WITH CRUNOFF=SGH, CTI MAPS MUST BE GIVEN TO PGD")
+ IF (.NOT.IO%LCTI) CALL ABOR1_SFX("READ_PGD_ISBA_n:WITH CRUNOFF=SGH, CTI MAPS MUST BE GIVEN TO PGD")
!
- ALLOCATE(I%XTI_MIN(IG%NDIM))
- ALLOCATE(I%XTI_MAX(IG%NDIM))
- ALLOCATE(I%XTI_MEAN(IG%NDIM))
- ALLOCATE(I%XTI_STD(IG%NDIM))
- ALLOCATE(I%XTI_SKEW(IG%NDIM))
+ ALLOCATE(S%XTI_MIN(IG%NDIM))
+ ALLOCATE(S%XTI_MAX(IG%NDIM))
+ ALLOCATE(S%XTI_MEAN(IG%NDIM))
+ ALLOCATE(S%XTI_STD(IG%NDIM))
+ ALLOCATE(S%XTI_SKEW(IG%NDIM))
!
YRECFM='TI_MIN'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XTI_MIN,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XTI_MIN,IRESP)
!
YRECFM='TI_MAX'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XTI_MAX,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XTI_MAX,IRESP)
!
YRECFM='TI_MEAN'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XTI_MEAN,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XTI_MEAN,IRESP)
!
YRECFM='TI_STD'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XTI_STD,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XTI_STD,IRESP)
!
YRECFM='TI_SKEW'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,I%XTI_SKEW,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XTI_SKEW,IRESP)
!
ELSE
!
- ALLOCATE(I%XTI_MIN(0))
- ALLOCATE(I%XTI_MAX(0))
- ALLOCATE(I%XTI_MEAN(0))
- ALLOCATE(I%XTI_STD(0))
- ALLOCATE(I%XTI_SKEW(0))
+ ALLOCATE(S%XTI_MIN(0))
+ ALLOCATE(S%XTI_MAX(0))
+ ALLOCATE(S%XTI_MEAN(0))
+ ALLOCATE(S%XTI_STD(0))
+ ALLOCATE(S%XTI_SKEW(0))
!
ENDIF
!
@@ -598,32 +542,27 @@ IF (CHI%LCH_BIO_FLUX) THEN
ALLOCATE(ZWORK(U%NSIZE_FULL,1))
!
CALL END_IO_SURF_n(HPROGRAM)
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'FULL ','SURF ','READ ')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'FULL ','SURF ','READ ')
!
CALL GET_LUOUT(HPROGRAM,ILUOUT)
ALLOCATE(IMASK(IG%NDIM))
ILU=0
- CALL GET_SURF_MASK_n(DTCO, U, &
- 'NATURE',IG%NDIM,IMASK,ILU,ILUOUT)
+ CALL GET_SURF_MASK_n(DTCO, U, 'NATURE',IG%NDIM,IMASK,ILU,ILUOUT)
ALLOCATE(GB%XISOPOT(IG%NDIM))
ALLOCATE(GB%XMONOPOT(IG%NDIM))
!
ZWORK(:,:) = 0.
YRECFM='E_ISOPOT'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ZWORK,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP)
CALL PACK_SAME_RANK(IMASK,ZWORK(:,1),GB%XISOPOT(:))
!
ZWORK(:,:) = 0.
YRECFM='E_MONOPOT'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ZWORK,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP)
CALL PACK_SAME_RANK(IMASK,ZWORK(:,1),GB%XMONOPOT(:))
!
CALL END_IO_SURF_n(HPROGRAM)
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'NATURE','ISBA ','READ ')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'NATURE','ISBA ','READ ')
!
DEALLOCATE(ZWORK)
ELSE
@@ -636,15 +575,10 @@ END IF
!* 4. Physiographic data fields not to be computed by ecoclimap
! ---------------------------------------------------------
!
- CALL READ_LECOCLIMAP(&
- HPROGRAM,I%LECOCLIMAP)
+ CALL READ_LECOCLIMAP(HPROGRAM,IO%LECOCLIMAP,GECOSG)
!
- CALL READ_PGD_ISBA_PAR_n(DTCO, U, &
- DTI, IG, I,GCP, &
- HPROGRAM,IG%NDIM,OLAND_USE)
-IF (U%CNATURE == 'TSZ0') CALL READ_PGD_TSZ0_PAR_n(&
- DTZ, &
- HPROGRAM)
+ CALL READ_PGD_ISBA_PAR_n(DTCO, U, GCP, DTV, IG%NDIM, IO, HPROGRAM,IG%NDIM, OLAND_USE, S%TTIME%TDATE, TPDATE_END)
+IF (U%CNATURE == 'TSZ0') CALL READ_PGD_TSZ0_PAR_n(DTZ, HPROGRAM)
!
IF (LHOOK) CALL DR_HOOK('READ_PGD_ISBA_N',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/read_pgd_netcdf.F90 b/src/SURFEX/read_pgd_netcdf.F90
index 34f3feda2ef1dcc3f9388e6d3271df79087197ac..a30e3b5ad8e4c858b2a6ea43e36be0e0cb5f3166 100644
--- a/src/SURFEX/read_pgd_netcdf.F90
+++ b/src/SURFEX/read_pgd_netcdf.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#################################################################################
-SUBROUTINE READ_PGD_NETCDF (USS, &
+SUBROUTINE READ_PGD_NETCDF (UG, U, USS, &
HPROGRAM,HSCHEME,HSUBROUTINE,HFILENAME,HFIELD,PFIELD)
!#################################################################################
!
@@ -27,14 +27,15 @@ SUBROUTINE READ_PGD_NETCDF (USS, &
!! -------------
!! Original 11/2012
!!------------------------------------------------------------------
-!
-
!
!
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODI_ABOR1_SFX
+USE MODI_READ_AND_SEND_MPI
USE MODE_READ_CDF, ONLY :HANDLE_ERR_CDF
! USE MODD_PGD_GRID, ONLY : NL ! grid dimension length
USE MODI_PT_BY_PT_TREATMENT
@@ -43,15 +44,17 @@ USE MODI_GET_LUOUT
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
+USE NETCDF
+!
IMPLICIT NONE
-INCLUDE 'netcdf.inc'
!
!* 0.1 declarations of arguments
!
-
!
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
CHARACTER(LEN=6), INTENT(IN) :: HSCHEME ! Scheme treated
@@ -64,6 +67,8 @@ REAL,DIMENSION(:),POINTER :: ZLAT,ZLON
REAL,DIMENSION(:),POINTER :: ZLAT2D,ZLON2D
REAL,DIMENSION(:),POINTER,SAVE :: ZFIELD ! field to read
!
+REAL, DIMENSION(:), ALLOCATABLE :: ZFIELD0
+!
!* 0.2 declarations of local variables
!
! CHARACTER(LEN=28) :: YNCVAR
@@ -78,7 +83,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('READ_PGD_NETCDF',0,ZHOOK_HANDLE)
!
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
+CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
SELECT CASE (TRIM(HFIELD))
CASE ('ZS','slope')
@@ -94,28 +99,34 @@ END SELECT
! ----------------
! Open netcdf file
-IERROR=NF_OPEN(HFILENAME,NF_NOWRITE,ID_FILE)
- CALL HANDLE_ERR_CDF(IERROR,"can't open file "//TRIM(HFILENAME))
+IERROR=NF90_OPEN(HFILENAME,NF90_NOWRITE,ID_FILE)
+CALL HANDLE_ERR_CDF(IERROR,"can't open file "//TRIM(HFILENAME))
- CALL READ_FIELD_NETCDF(ID_FILE,'LAT ',ZLAT,INLAT)
- CALL READ_FIELD_NETCDF(ID_FILE,'LON ',ZLON,INLON)
- CALL READ_FIELD_NETCDF(ID_FILE,HFIELD,ZFIELD,INFIELD)
+CALL READ_FIELD_NETCDF(ID_FILE,'LAT ',ZLAT,INLAT)
+CALL READ_FIELD_NETCDF(ID_FILE,'LON ',ZLON,INLON)
+CALL READ_FIELD_NETCDF(ID_FILE,HFIELD,ZFIELD,INFIELD)
! Close netcdf file
-IERROR=NF_CLOSE(ID_FILE)
+IERROR=NF90_CLOSE(ID_FILE)
IF (PRESENT(PFIELD)) THEN
+ ALLOCATE(ZFIELD0(U%NDIM_FULL))
+ !
DO JPOINT=1,INFIELD
! On pourrait faire un controle des coordonnées ?
! IF ((ABS(ZLAT(JPOINT)-????XLAT???)<0.001) .AND. (ABS(ZLON(JPOINT)-????XLON???)<0.001)) THEN
- PFIELD(JPOINT)=ZFIELD(JPOINT)
+ ZFIELD0(JPOINT)=ZFIELD(JPOINT)
! END IF
END DO
-
+ !
+ CALL READ_AND_SEND_MPI(ZFIELD0,PFIELD)
+ !
+ DEALLOCATE(ZFIELD0)
+ !
ELSE
ALLOCATE(ZLAT2D(INFIELD))
@@ -134,7 +145,7 @@ ELSE
!* 5. Call to the adequate subroutine (point by point treatment)
! ----------------------------------------------------------
!
- CALL PT_BY_PT_TREATMENT(USS, &
+ CALL PT_BY_PT_TREATMENT(UG, U, USS, &
ILUOUT, (/ ZLAT2D(JPOINT)/) , (/ZLON2D(JPOINT)/) , (/ ZFIELD(JPOINT)/) , &
HSUBROUTINE )
@@ -153,15 +164,16 @@ DEALLOCATE(ZFIELD)
IF (LHOOK) CALL DR_HOOK('READ_PGD_NETCDF',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
SUBROUTINE READ_FIELD_NETCDF(ID_FILE,HFIELD,PFIELD,ILENDIM)
USE MODE_READ_CDF, ONLY :HANDLE_ERR_CDF
+USE NETCDF
+!
IMPLICIT NONE
-INCLUDE 'netcdf.inc'
INTEGER,INTENT(IN)::ID_FILE
CHARACTER(LEN=20), INTENT(IN) :: HFIELD ! name of variable
@@ -176,31 +188,31 @@ INTEGER::IERROR !error status
INTEGER::ITYPE
! Look for variable ID for HFIELD
-IERROR=NF_INQ_VARID(ID_FILE,TRIM(HFIELD),ID_VAR)
- CALL HANDLE_ERR_CDF(IERROR,"can't find variable "//TRIM(HFIELD))
+IERROR=NF90_INQ_VARID(ID_FILE,TRIM(HFIELD),ID_VAR)
+CALL HANDLE_ERR_CDF(IERROR,"can't find variable "//TRIM(HFIELD))
! Number of dimensions
-IERROR=NF_INQ_VARNDIMS(ID_FILE,ID_VAR,INVARDIMS)
-if (IERROR/=NF_NOERR) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions number")
+IERROR=NF90_INQUIRE_VARIABLE(ID_FILE,ID_VAR,NDIMS=INVARDIMS)
+if (IERROR/=NF90_NOERR) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions number")
! Id of dimensions
ALLOCATE(IVARDIMSID(INVARDIMS))
-IERROR=NF_INQ_VARDIMID(ID_FILE,ID_VAR,IVARDIMSID)
-if (IERROR/=NF_NOERR) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions ids")
+IERROR=NF90_INQUIRE_VARIABLE(ID_FILE,ID_VAR,DIMIDS=IVARDIMSID)
+if (IERROR/=NF90_NOERR) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions ids")
SELECT CASE (INVARDIMS)
CASE (1)
! Check dimension length
- IERROR=NF_INQ_DIMLEN(ID_FILE,IVARDIMSID(1),ILENDIM)
- if (IERROR/=NF_NOERR) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions lengths")
+ IERROR=NF90_INQUIRE_DIMENSION(ID_FILE,IVARDIMSID(1),LEN=ILENDIM)
+ if (IERROR/=NF90_NOERR) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions lengths")
CASE (2)
- IERROR=NF_INQ_DIMLEN(ID_FILE,IVARDIMSID(1),ILENDIM1)
- if (IERROR/=NF_NOERR) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions lengths")
- IERROR=NF_INQ_DIMLEN(ID_FILE,IVARDIMSID(2),ILENDIM2)
- if (IERROR/=NF_NOERR) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions lengths")
+ IERROR=NF90_INQUIRE_DIMENSION(ID_FILE,IVARDIMSID(1),LEN=ILENDIM1)
+ if (IERROR/=NF90_NOERR) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions lengths")
+ IERROR=NF90_INQUIRE_DIMENSION(ID_FILE,IVARDIMSID(2),LEN=ILENDIM2)
+ if (IERROR/=NF90_NOERR) CALL HANDLE_ERR_CDF(IERROR,"can't get variable dimensions lengths")
ILENDIM=ILENDIM1*ILENDIM2
@@ -216,15 +228,15 @@ DEALLOCATE(IVARDIMSID)
ALLOCATE(PFIELD(ILENDIM))
-IERROR=NF_INQ_VARTYPE(ID_FILE,ID_VAR,ITYPE)
-IF (ITYPE/=NF_DOUBLE) THEN
+IERROR=NF90_INQUIRE_VARIABLE(ID_FILE,ID_VAR,XTYPE=ITYPE)
+IF (ITYPE/=NF90_DOUBLE) THEN
CALL ABOR1_SFX('READ_PGD_NETCDF: incorrect type for variable '//TRIM(HFIELD))
END IF
! Read 1D variable
-IERROR=NF_GET_VAR_DOUBLE(ID_FILE,ID_VAR,PFIELD)
+IERROR=NF90_GET_VAR(ID_FILE,ID_VAR,PFIELD)
- CALL HANDLE_ERR_CDF(IERROR,"can't read variable "//TRIM(HFIELD))
+CALL HANDLE_ERR_CDF(IERROR,"can't read variable "//TRIM(HFIELD))
END SUBROUTINE READ_FIELD_NETCDF
diff --git a/src/SURFEX/read_pgd_seaflux_parn.F90 b/src/SURFEX/read_pgd_seaflux_parn.F90
index ac8dac9b62b1fa2574da40608cfbd9030cef250f..20a7f31df13bc4197bebdcc9d56d9e217f3b5201 100644
--- a/src/SURFEX/read_pgd_seaflux_parn.F90
+++ b/src/SURFEX/read_pgd_seaflux_parn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_PGD_SEAFLUX_PAR_n (DTCO, U, DTS, SG,GCP, &
- HPROGRAM,KSIZE,HDIR)
+ SUBROUTINE READ_PGD_SEAFLUX_PAR_n (DTCO, U, GCP, DTS, KDIM, HPROGRAM,KSIZE,HDIR)
! ################################################
!
!!**** *READ_PGD_SEAFLUX_PAR_n* - reads SEAFLUX sst
@@ -39,18 +38,11 @@
!* 0. DECLARATIONS
! ------------
!
-!
-!
-!
-!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
-!
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_t
-USE MODD_SEAFLUX_GRID_n, ONLY : SEAFLUX_GRID_t
!
USE MODD_TYPE_DATE_SURF
USE MODD_PREP, ONLY : LINTERP
@@ -67,16 +59,13 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-!
-!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
-!
TYPE(DATA_SEAFLUX_t), INTENT(INOUT) :: DTS
-TYPE(SEAFLUX_GRID_t), INTENT(INOUT) :: SG
+!
+INTEGER, INTENT(IN) :: KDIM
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
INTEGER, INTENT(IN) :: KSIZE
@@ -107,12 +96,10 @@ YDIR = 'H'
IF (PRESENT(HDIR)) YDIR = HDIR
!
YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
!
YRECFM='BUG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IBUGFIX,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
!
IF (IVERSION<4 .OR. IVERSION==4 .AND. IBUGFIX<=4 .OR. &
IVERSION>5 .OR. IVERSION==5 .AND. IBUGFIX>=1) THEN
@@ -120,8 +107,7 @@ IF (IVERSION<4 .OR. IVERSION==4 .AND. IBUGFIX<=4 .OR. &
ELSE
YRECFM='NDATA_SEA_TIME'
ENDIF
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTS%NTIME,IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTS%NTIME,IRESP,HCOMMENT=YCOMMENT)
!
ALLOCATE(ZDATA_SST (KSIZE,DTS%NTIME))
DO JTIME=1,DTS%NTIME
@@ -134,18 +120,16 @@ DO JTIME=1,DTS%NTIME
WRITE(YRECFM,FMT='(A10,I3.3)') 'DATA_SST_T',JTIME
ENDIF
!
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ZDATA_SST(:,JTIME),IRESP,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
+ CALL READ_SURF(HPROGRAM,YRECFM,ZDATA_SST(:,JTIME),IRESP,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
!
END DO
!
-ALLOCATE(DTS%XDATA_SST(SG%NDIM,DTS%NTIME))
-IF (SG%NDIM/=KSIZE) THEN
+ALLOCATE(DTS%XDATA_SST(KDIM,DTS%NTIME))
+IF (KDIM/=KSIZE) THEN
LINTERP(:) = .TRUE.
DO JTIME=1,DTS%NTIME
- CALL HOR_INTERPOL(DTCO, U,GCP, &
- ILUOUT,ZDATA_SST(:,JTIME:JTIME),DTS%XDATA_SST(:,JTIME:JTIME))
+ CALL HOR_INTERPOL(DTCO, U, GCP, ILUOUT,ZDATA_SST(:,JTIME:JTIME),DTS%XDATA_SST(:,JTIME:JTIME))
ENDDO
DEALLOCATE(ZDATA_SST)
ELSE
@@ -158,8 +142,7 @@ IF (IVERSION<4 .OR. IVERSION==4 .AND. IBUGFIX<=4) THEN
DO JTIME=1,DTS%NTIME
WRITE(YRECFM,FMT='(A7,I3.3)') 'DTA_SST',JTIME
YCOMMENT='(-)'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTS%TDATA_SST,IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTS%TDATA_SST,IRESP,HCOMMENT=YCOMMENT)
END DO
ELSE
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
@@ -168,8 +151,7 @@ ELSE
YRECFM='TDATA_SST'
ENDIF
YCOMMENT='(-)'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTS%TDATA_SST,IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTS%TDATA_SST,IRESP,HCOMMENT=YCOMMENT)
ENDIF
!
IF (LHOOK) CALL DR_HOOK('READ_PGD_SEAFLUX_PAR_N',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/read_pgd_seafluxn.F90 b/src/SURFEX/read_pgd_seafluxn.F90
index 8b4d53a55ff191fb6fc1bc4092a197e979ced8a8..590e5de451d3cbf2e2853eff6e77199f8e1d28e8 100644
--- a/src/SURFEX/read_pgd_seafluxn.F90
+++ b/src/SURFEX/read_pgd_seafluxn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_PGD_SEAFLUX_n (DTCO, DTS, SG, S, U,GCP, &
- HPROGRAM)
+ SUBROUTINE READ_PGD_SEAFLUX_n (DTCO, DTS, SG, S, U, UG, GCP, HPROGRAM)
! #########################################
!
!!**** *READ_PGD_SEAFLUX_n* - routine to read SEAFLUX physiographic fields
@@ -39,15 +38,13 @@
!* 0. DECLARATIONS
! ------------
!
-!
-!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_t
-USE MODD_SEAFLUX_GRID_n, ONLY : SEAFLUX_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
USE MODD_TYPE_DATE_SURF
!
@@ -56,12 +53,10 @@ USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
USE MODE_READ_SURF_COV, ONLY : READ_SURF_COV
!
USE MODI_READ_SURF
-USE MODI_READ_GRID
+USE MODI_PACK_INIT
USE MODI_READ_LCOVER
USE MODI_READ_PGD_SEAFLUX_PAR_n
!
-!
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -75,9 +70,10 @@ IMPLICIT NONE
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(DATA_SEAFLUX_t), INTENT(INOUT) :: DTS
-TYPE(SEAFLUX_GRID_t), INTENT(INOUT) :: SG
+TYPE(GRID_t), INTENT(INOUT) :: SG
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
@@ -98,8 +94,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('READ_PGD_SEAFLUX_N',0,ZHOOK_HANDLE)
YRECFM='SIZE_SEA'
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'SEA ',SG%NDIM)
+ CALL GET_TYPE_DIM_n(DTCO, U, 'SEA ',SG%NDIM)
!
!
!* 2. Physiographic data fields:
@@ -108,21 +103,18 @@ YRECFM='SIZE_SEA'
!* cover classes
!
ALLOCATE(S%LCOVER(JPCOVER))
- CALL READ_LCOVER(&
- HPROGRAM,S%LCOVER)
-!
-ALLOCATE(S%XCOVER(SG%NDIM,JPCOVER))
- CALL READ_SURF_COV(&
- HPROGRAM,'COVER',S%XCOVER(:,:),S%LCOVER,IRESP)
+ALLOCATE(S%XZS(SG%NDIM))
+ALLOCATE(SG%XLAT (SG%NDIM))
+ALLOCATE(SG%XLON (SG%NDIM))
+ALLOCATE(SG%XMESH_SIZE (SG%NDIM))
+CALL PACK_INIT(DTCO,U,UG,HPROGRAM,'SEA ',SG,S%LCOVER,S%XCOVER,S%XZS )
!
!* orography
!
-ALLOCATE(S%XZS(SG%NDIM))
S%XZS(:) = 0.
!
YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
!
!* bathymetry
!
@@ -131,19 +123,9 @@ IF (IVERSION<=3) THEN
S%XSEABATHY(:) = -300.
ELSE
YRECFM='BATHY'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,S%XSEABATHY(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XSEABATHY(:),IRESP)
END IF
!
-!* latitude, longitude
-!
-ALLOCATE(SG%XLAT (SG%NDIM))
-ALLOCATE(SG%XLON (SG%NDIM))
-ALLOCATE(SG%XMESH_SIZE(SG%NDIM))
- CALL READ_GRID(&
- HPROGRAM,SG%CGRID,SG%XGRID_PAR,SG%XLAT,SG%XLON,SG%XMESH_SIZE,IRESP)
-!
-!
!* sst
!
!
@@ -151,12 +133,11 @@ IF (IVERSION<3) THEN
DTS%LSST_DATA = .FALSE.
ELSE
YRECFM='SST_DATA'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTS%LSST_DATA,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTS%LSST_DATA,IRESP)
END IF
!
-IF (DTS%LSST_DATA) CALL READ_PGD_SEAFLUX_PAR_n(DTCO, U, DTS, SG,GCP, &
- HPROGRAM,SG%NDIM)
+IF (DTS%LSST_DATA) CALL READ_PGD_SEAFLUX_PAR_n(DTCO, U, GCP, DTS, SG%NDIM, HPROGRAM,SG%NDIM)
+!
IF (LHOOK) CALL DR_HOOK('READ_PGD_SEAFLUX_N',1,ZHOOK_HANDLE)
!
!------------------------------------------------------------------------------!
diff --git a/src/SURFEX/read_pgd_teb_garden_parn.F90 b/src/SURFEX/read_pgd_teb_garden_parn.F90
index c22ae9bd7daf47033faa41e3010ae40fc8d709bb..4ee99aacea75219947315d5d89d65f45b029922e 100644
--- a/src/SURFEX/read_pgd_teb_garden_parn.F90
+++ b/src/SURFEX/read_pgd_teb_garden_parn.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_PGD_TEB_GARDEN_PAR_n (&
- DTGD, TGDO, TGDP, TG, &
- HPROGRAM)
+ SUBROUTINE READ_PGD_TEB_GARDEN_PAR_n (DTV, IO, KDIM, HPROGRAM)
! ################################################
!
!!**** *READ_PGD_TEB_GARDEN_PAR_n* - reads ISBA physiographic fields
@@ -47,10 +45,8 @@
!
!
!
-USE MODD_DATA_TEB_GARDEN_n, ONLY : DATA_TEB_GARDEN_t
-USE MODD_TEB_GARDEN_OPTION_n, ONLY : TEB_GARDEN_OPTIONS_t
-USE MODD_TEB_GARDEN_PGD_n, ONLY : TEB_GARDEN_PGD_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
USE MODD_CSTS, ONLY : XDAY
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -59,14 +55,13 @@ USE MODD_DATA_COVER_PAR, ONLY : NVT_NO, NVT_ROCK, NVT_SNOW, NVT_TEBD, &
NVT_BONE, NVT_TRBE, NVT_C3, NVT_C4, &
NVT_IRR, NVT_GRAS, NVT_TROG,NVT_PARK, &
NVT_TRBD, NVT_TEBE, NVT_TENE, NVT_BOBD, &
- NVT_BOND, NVT_BOGR, NVT_SHRB, NVEGTYPE
+ NVT_BOND, NVT_BOGR, NVT_SHRB, NVT_C3W, &
+ NVT_C3S, NVT_FLTR, NVT_FLGR, NVEGTYPE
!
USE MODI_READ_SURF
USE MODI_VEG_FROM_LAI
USE MODI_Z0V_FROM_LAI
USE MODI_EMIS_FROM_VEG
-USE MODI_DRY_WET_SOIL_ALBEDOS
-USE MODI_SOIL_ALBEDO
USE MODI_ABOR1_SFX
!
USE MODD_REPROD_OPER, ONLY : XEVERG_RSMIN
@@ -82,10 +77,9 @@ IMPLICIT NONE
!
!
!
-TYPE(DATA_TEB_GARDEN_t), INTENT(INOUT) :: DTGD
-TYPE(TEB_GARDEN_OPTIONS_t), INTENT(INOUT) :: TGDO
-TYPE(TEB_GARDEN_PGD_t), INTENT(INOUT) :: TGDP
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+INTEGER, INTENT(IN) :: KDIM
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
!
@@ -93,33 +87,30 @@ TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
! -------------------------------
!
INTEGER :: IRESP ! IRESP : return-code if a problem appears
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=100) :: YCOMMENT ! Comment string
+CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=100) :: YCOMMENT ! Comment string
INTEGER :: JI, JLAYER ! loop index
INTEGER :: JTIME ! loop index
!
-REAL, DIMENSION(TG%NDIM,3) :: ZDATA_RSMIN
-REAL, DIMENSION(TG%NDIM,3) :: ZDATA_GAMMA
-REAL, DIMENSION(TG%NDIM,3) :: ZDATA_WRMAX_CF
-REAL, DIMENSION(TG%NDIM,3) :: ZDATA_RGL
-REAL, DIMENSION(TG%NDIM,3) :: ZDATA_CV
-REAL, DIMENSION(TG%NDIM,TGDO%NGROUND_LAYER,3) :: ZDATA_DG
-REAL, DIMENSION(TG%NDIM,3) :: ZDATA_ALBNIR_VEG
-REAL, DIMENSION(TG%NDIM,3) :: ZDATA_ALBVIS_VEG
-REAL, DIMENSION(TG%NDIM,3) :: ZDATA_ALBUV_VEG
-REAL, DIMENSION(TG%NDIM,3) :: ZDATA_GMES
-REAL, DIMENSION(TG%NDIM,3) :: ZDATA_RE25
-REAL, DIMENSION(TG%NDIM,3) :: ZDATA_BSLAI
-REAL, DIMENSION(TG%NDIM,3) :: ZDATA_LAIMIN
-REAL, DIMENSION(TG%NDIM,3) :: ZDATA_SEFOLD
-REAL, DIMENSION(TG%NDIM,3) :: ZDATA_GC
-REAL, DIMENSION(TG%NDIM,3) :: ZDATA_DMAX
-REAL, DIMENSION(TG%NDIM,3) :: ZDATA_CE_NITRO
-REAL, DIMENSION(TG%NDIM,3) :: ZDATA_CF_NITRO
-REAL, DIMENSION(TG%NDIM,3) :: ZDATA_CNA_NITRO
-!
-REAL, DIMENSION(TG%NDIM) :: ZDATA_WG1
-REAL, DIMENSION(TG%NDIM) :: ZDATA_WGSAT
+REAL, DIMENSION(KDIM,3) :: ZDATA_RSMIN
+REAL, DIMENSION(KDIM,3) :: ZDATA_GAMMA
+REAL, DIMENSION(KDIM,3) :: ZDATA_WRMAX_CF
+REAL, DIMENSION(KDIM,3) :: ZDATA_RGL
+REAL, DIMENSION(KDIM,3) :: ZDATA_CV
+REAL, DIMENSION(KDIM,IO%NGROUND_LAYER,3) :: ZDATA_DG
+REAL, DIMENSION(KDIM,3) :: ZDATA_ALBNIR_VEG
+REAL, DIMENSION(KDIM,3) :: ZDATA_ALBVIS_VEG
+REAL, DIMENSION(KDIM,3) :: ZDATA_ALBUV_VEG
+REAL, DIMENSION(KDIM,3) :: ZDATA_GMES
+REAL, DIMENSION(KDIM,3) :: ZDATA_RE25
+REAL, DIMENSION(KDIM,3) :: ZDATA_BSLAI
+REAL, DIMENSION(KDIM,3) :: ZDATA_LAIMIN
+REAL, DIMENSION(KDIM,3) :: ZDATA_SEFOLD
+REAL, DIMENSION(KDIM,3) :: ZDATA_GC
+REAL, DIMENSION(KDIM,3) :: ZDATA_DMAX
+REAL, DIMENSION(KDIM,3) :: ZDATA_CE_NITRO
+REAL, DIMENSION(KDIM,3) :: ZDATA_CF_NITRO
+REAL, DIMENSION(KDIM,3) :: ZDATA_CNA_NITRO
!
LOGICAL :: GAGRI_TO_GRASS
!
@@ -131,64 +122,58 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! --------------------
!
IF (LHOOK) CALL DR_HOOK('READ_PGD_TEB_GARDEN_PAR_N',0,ZHOOK_HANDLE)
-DTGD%NTIME= 12
+DTV%NTIME= 12
!
GAGRI_TO_GRASS=.FALSE.
!
YRECFM='GD_NTIME'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTGD%NTIME,IRESP,HCOMMENT=YCOMMENT)
+CALL READ_SURF(HPROGRAM,YRECFM,DTV%NTIME,IRESP,HCOMMENT=YCOMMENT)
!
-ALLOCATE(DTGD%XDATA_FRAC_HVEG (TG%NDIM))
-ALLOCATE(DTGD%XDATA_FRAC_LVEG (TG%NDIM))
-ALLOCATE(DTGD%XDATA_FRAC_NVEG (TG%NDIM))
-ALLOCATE(DTGD%XDATA_LAI_HVEG (TG%NDIM,DTGD%NTIME))
-ALLOCATE(DTGD%XDATA_LAI_LVEG (TG%NDIM,DTGD%NTIME))
-ALLOCATE(DTGD%XDATA_H_HVEG (TG%NDIM))
+DTV%LIMP_VEG=.FALSE.
+DTV%LIMP_Z0=.FALSE.
+DTV%LIMP_EMIS=.FALSE.
+!
+ALLOCATE(DTV%XPAR_FRAC_HVEG (KDIM))
+ALLOCATE(DTV%XPAR_FRAC_LVEG (KDIM))
+ALLOCATE(DTV%XPAR_FRAC_NVEG (KDIM))
+ALLOCATE(DTV%XPAR_LAI_HVEG (KDIM,DTV%NTIME))
+ALLOCATE(DTV%XPAR_LAI_LVEG (KDIM,DTV%NTIME))
+ALLOCATE(DTV%XPAR_H_HVEG (KDIM))
!
! Read type of high vegetation
YRECFM='D_TYPE_HVEG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TGDP%CTYPE_HVEG,IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%CTYPE_HVEG,IRESP,HCOMMENT=YCOMMENT)
!
! Read type of low vegetation
YRECFM='D_TYPE_LVEG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TGDP%CTYPE_LVEG,IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%CTYPE_LVEG,IRESP,HCOMMENT=YCOMMENT)
!
! Read type of bare soil (no vegetation)
YRECFM='D_TYPE_NVEG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TGDP%CTYPE_NVEG,IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%CTYPE_NVEG,IRESP,HCOMMENT=YCOMMENT)
!
! Read fraction of high vegetation
YRECFM='D_FRAC_HVEG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTGD%XDATA_FRAC_HVEG,IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTV%XPAR_FRAC_HVEG,IRESP,HCOMMENT=YCOMMENT)
!
! Read fraction of low vegetation
YRECFM='D_FRAC_LVEG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTGD%XDATA_FRAC_LVEG,IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTV%XPAR_FRAC_LVEG,IRESP,HCOMMENT=YCOMMENT)
!
! Read fraction of bare soil (no vegetation)
YRECFM='D_FRAC_NVEG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTGD%XDATA_FRAC_NVEG,IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTV%XPAR_FRAC_NVEG,IRESP,HCOMMENT=YCOMMENT)
!
! Read height of trees( for high vegetation)
YRECFM='D_H_HVEG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTGD%XDATA_H_HVEG,IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTV%XPAR_H_HVEG,IRESP,HCOMMENT=YCOMMENT)
!
! Read LAI of high vegetation
-DO JTIME=1,DTGD%NTIME
+DO JTIME=1,DTV%NTIME
WRITE(YRECFM,FMT='(A10,I2.2)') 'D_LAI_HVEG',JTIME
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTGD%XDATA_LAI_HVEG(:,JTIME),IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTV%XPAR_LAI_HVEG(:,JTIME),IRESP,HCOMMENT=YCOMMENT)
WRITE(YRECFM,FMT='(A10,I2.2)') 'D_LAI_LVEG',JTIME
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTGD%XDATA_LAI_LVEG(:,JTIME),IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTV%XPAR_LAI_LVEG(:,JTIME),IRESP,HCOMMENT=YCOMMENT)
END DO
!
!-------------------------------------------------------------------------------
@@ -196,511 +181,656 @@ END DO
!* 2. Definition of ISBA parameters
! -----------------------------
!
-ALLOCATE(DTGD%XDATA_LAI (TG%NDIM,DTGD%NTIME))
-ALLOCATE(DTGD%XDATA_VEG (TG%NDIM,DTGD%NTIME))
-ALLOCATE(DTGD%XDATA_RSMIN (TG%NDIM))
-ALLOCATE(DTGD%XDATA_GAMMA (TG%NDIM))
-ALLOCATE(DTGD%XDATA_WRMAX_CF (TG%NDIM))
-ALLOCATE(DTGD%XDATA_RGL (TG%NDIM))
-ALLOCATE(DTGD%XDATA_CV (TG%NDIM))
-ALLOCATE(DTGD%XDATA_DG (TG%NDIM,TGDO%NGROUND_LAYER))
-ALLOCATE(DTGD%XDATA_ROOTFRAC (TG%NDIM,TGDO%NGROUND_LAYER))
-ALLOCATE(DTGD%XDATA_DICE (TG%NDIM))
-ALLOCATE(DTGD%XDATA_Z0 (TG%NDIM,DTGD%NTIME))
-ALLOCATE(DTGD%XDATA_Z0_O_Z0H (TG%NDIM))
-ALLOCATE(DTGD%XDATA_ALBNIR_VEG (TG%NDIM))
-ALLOCATE(DTGD%XDATA_ALBVIS_VEG (TG%NDIM))
-ALLOCATE(DTGD%XDATA_ALBUV_VEG (TG%NDIM))
-ALLOCATE(DTGD%XDATA_ALBNIR_SOIL(TG%NDIM))
-ALLOCATE(DTGD%XDATA_ALBVIS_SOIL(TG%NDIM))
-ALLOCATE(DTGD%XDATA_ALBUV_SOIL (TG%NDIM))
-ALLOCATE(DTGD%XDATA_ALBNIR_DRY (TG%NDIM))
-ALLOCATE(DTGD%XDATA_ALBVIS_DRY (TG%NDIM))
-ALLOCATE(DTGD%XDATA_ALBUV_DRY (TG%NDIM))
-ALLOCATE(DTGD%XDATA_ALBNIR_WET (TG%NDIM))
-ALLOCATE(DTGD%XDATA_ALBVIS_WET (TG%NDIM))
-ALLOCATE(DTGD%XDATA_ALBUV_WET (TG%NDIM))
-ALLOCATE(DTGD%XDATA_EMIS (TG%NDIM,DTGD%NTIME))
-ALLOCATE(DTGD%XDATA_VEGTYPE (TG%NDIM,NVEGTYPE))
-ALLOCATE(DTGD%XDATA_GMES (TG%NDIM))
-ALLOCATE(DTGD%XDATA_RE25 (TG%NDIM))
-ALLOCATE(DTGD%XDATA_BSLAI (TG%NDIM))
-ALLOCATE(DTGD%XDATA_LAIMIN (TG%NDIM))
-ALLOCATE(DTGD%XDATA_SEFOLD (TG%NDIM))
-ALLOCATE(DTGD%XDATA_GC (TG%NDIM))
-ALLOCATE(DTGD%XDATA_DMAX (TG%NDIM))
-ALLOCATE(DTGD%XDATA_F2I (TG%NDIM))
-ALLOCATE(DTGD%LDATA_STRESS (TG%NDIM))
-ALLOCATE(DTGD%XDATA_H_TREE (TG%NDIM))
-ALLOCATE(DTGD%XDATA_CE_NITRO (TG%NDIM))
-ALLOCATE(DTGD%XDATA_CF_NITRO (TG%NDIM))
-ALLOCATE(DTGD%XDATA_CNA_NITRO (TG%NDIM))
-!
-DTGD%XDATA_LAI (:,:) = XUNDEF
-DTGD%XDATA_VEG (:,:) = XUNDEF
-DTGD%XDATA_RSMIN (:) = XUNDEF
-DTGD%XDATA_GAMMA (:) = XUNDEF
-DTGD%XDATA_WRMAX_CF (:) = XUNDEF
-DTGD%XDATA_RGL (:) = XUNDEF
-DTGD%XDATA_CV (:) = XUNDEF
-DTGD%XDATA_DG (:,:) = XUNDEF
-DTGD%XDATA_DICE (:) = XUNDEF
-DTGD%XDATA_ROOTFRAC (:,:) = XUNDEF
-DTGD%XDATA_Z0 (:,:) = XUNDEF
-DTGD%XDATA_Z0_O_Z0H (:) = XUNDEF
-DTGD%XDATA_ALBNIR_VEG (:) = XUNDEF
-DTGD%XDATA_ALBVIS_VEG (:) = XUNDEF
-DTGD%XDATA_ALBUV_VEG (:) = XUNDEF
-DTGD%XDATA_ALBNIR_SOIL (:) = XUNDEF
-DTGD%XDATA_ALBVIS_SOIL (:) = XUNDEF
-DTGD%XDATA_ALBUV_SOIL (:) = XUNDEF
-DTGD%XDATA_ALBNIR_DRY (:) = XUNDEF
-DTGD%XDATA_ALBVIS_DRY (:) = XUNDEF
-DTGD%XDATA_ALBUV_DRY (:) = XUNDEF
-DTGD%XDATA_ALBNIR_WET (:) = XUNDEF
-DTGD%XDATA_ALBVIS_WET (:) = XUNDEF
-DTGD%XDATA_ALBUV_WET (:) = XUNDEF
-DTGD%XDATA_EMIS (:,:) = XUNDEF
-DTGD%XDATA_VEGTYPE (:,:) = XUNDEF
-DTGD%XDATA_GMES (:) = XUNDEF
-DTGD%XDATA_RE25 (:) = XUNDEF
-DTGD%XDATA_BSLAI (:) = XUNDEF
-DTGD%XDATA_LAIMIN (:) = XUNDEF
-DTGD%XDATA_SEFOLD (:) = XUNDEF
-DTGD%XDATA_GC (:) = XUNDEF
-DTGD%XDATA_DMAX (:) = XUNDEF
-DTGD%XDATA_F2I (:) = XUNDEF
-DTGD%LDATA_STRESS (:) = .FALSE.
-DTGD%XDATA_H_TREE (:) = XUNDEF
-DTGD%XDATA_CE_NITRO (:) = XUNDEF
-DTGD%XDATA_CF_NITRO (:) = XUNDEF
-DTGD%XDATA_CNA_NITRO (:) = XUNDEF
+ALLOCATE(DTV%XPAR_LAI (KDIM,DTV%NTIME,1))
+ALLOCATE(DTV%XPAR_VEG (KDIM,DTV%NTIME,1))
+ALLOCATE(DTV%XPAR_RSMIN (KDIM,1))
+ALLOCATE(DTV%XPAR_GAMMA (KDIM,1))
+ALLOCATE(DTV%XPAR_WRMAX_CF (KDIM,1))
+ALLOCATE(DTV%XPAR_RGL (KDIM,1))
+ALLOCATE(DTV%XPAR_CV (KDIM,1))
+ALLOCATE(DTV%XPAR_DG (KDIM,IO%NGROUND_LAYER,1))
+ALLOCATE(DTV%XPAR_ROOTFRAC (KDIM,IO%NGROUND_LAYER,1))
+ALLOCATE(DTV%XPAR_DICE (KDIM,1))
+ALLOCATE(DTV%XPAR_Z0 (KDIM,DTV%NTIME,1))
+ALLOCATE(DTV%XPAR_Z0_O_Z0H (KDIM,1))
+ALLOCATE(DTV%XPAR_ALBNIR_VEG (KDIM,1,1))
+ALLOCATE(DTV%XPAR_ALBVIS_VEG (KDIM,1,1))
+ALLOCATE(DTV%XPAR_ALBUV_VEG (KDIM,1,1))
+ALLOCATE(DTV%XPAR_ALBNIR_SOIL(KDIM,1,1))
+ALLOCATE(DTV%XPAR_ALBVIS_SOIL(KDIM,1,1))
+ALLOCATE(DTV%XPAR_ALBUV_SOIL (KDIM,1,1))
+ALLOCATE(DTV%XPAR_EMIS (KDIM,DTV%NTIME,1))
+ALLOCATE(DTV%XPAR_VEGTYPE (KDIM,NVEGTYPE))
+ALLOCATE(DTV%XPAR_GMES (KDIM,1))
+ALLOCATE(DTV%XPAR_RE25 (KDIM,1))
+ALLOCATE(DTV%XPAR_BSLAI (KDIM,1))
+ALLOCATE(DTV%XPAR_LAIMIN (KDIM,1))
+ALLOCATE(DTV%XPAR_SEFOLD (KDIM,1))
+ALLOCATE(DTV%XPAR_GC (KDIM,1))
+ALLOCATE(DTV%XPAR_DMAX (KDIM,1))
+ALLOCATE(DTV%XPAR_F2I (KDIM,1))
+ALLOCATE(DTV%LPAR_STRESS (KDIM,1))
+ALLOCATE(DTV%XPAR_H_TREE (KDIM,1))
+ALLOCATE(DTV%XPAR_CE_NITRO (KDIM,1))
+ALLOCATE(DTV%XPAR_CF_NITRO (KDIM,1))
+ALLOCATE(DTV%XPAR_CNA_NITRO (KDIM,1))
+!
+DTV%XPAR_LAI (:,:,:) = XUNDEF
+DTV%XPAR_VEG (:,:,:) = XUNDEF
+DTV%XPAR_RSMIN (:,:) = XUNDEF
+DTV%XPAR_GAMMA (:,:) = XUNDEF
+DTV%XPAR_WRMAX_CF (:,:) = XUNDEF
+DTV%XPAR_RGL (:,:) = XUNDEF
+DTV%XPAR_CV (:,:) = XUNDEF
+DTV%XPAR_DG (:,:,:) = XUNDEF
+DTV%XPAR_DICE (:,:) = XUNDEF
+DTV%XPAR_ROOTFRAC (:,:,:) = XUNDEF
+DTV%XPAR_Z0 (:,:,:) = XUNDEF
+DTV%XPAR_Z0_O_Z0H (:,:) = XUNDEF
+DTV%XPAR_ALBNIR_VEG (:,:,:) = XUNDEF
+DTV%XPAR_ALBVIS_VEG (:,:,:) = XUNDEF
+DTV%XPAR_ALBUV_VEG (:,:,:) = XUNDEF
+DTV%XPAR_ALBNIR_SOIL (:,:,:) = XUNDEF
+DTV%XPAR_ALBVIS_SOIL (:,:,:) = XUNDEF
+DTV%XPAR_ALBUV_SOIL (:,:,:) = XUNDEF
+DTV%XPAR_EMIS (:,:,:) = XUNDEF
+DTV%XPAR_VEGTYPE (:,:) = XUNDEF
+DTV%XPAR_GMES (:,:) = XUNDEF
+DTV%XPAR_RE25 (:,:) = XUNDEF
+DTV%XPAR_BSLAI (:,:) = XUNDEF
+DTV%XPAR_LAIMIN (:,:) = XUNDEF
+DTV%XPAR_SEFOLD (:,:) = XUNDEF
+DTV%XPAR_GC (:,:) = XUNDEF
+DTV%XPAR_DMAX (:,:) = XUNDEF
+DTV%XPAR_F2I (:,:) = XUNDEF
+DTV%LPAR_STRESS (:,:) = .FALSE.
+DTV%XPAR_H_TREE (:,:) = XUNDEF
+DTV%XPAR_CE_NITRO (:,:) = XUNDEF
+DTV%XPAR_CF_NITRO (:,:) = XUNDEF
+DTV%XPAR_CNA_NITRO (:,:) = XUNDEF
!
! Vegtypes
-DTGD%XDATA_VEGTYPE(:,:) = 0.
-IF (TGDP%CTYPE_NVEG == 'NO ') DTGD%XDATA_VEGTYPE(:, NVT_NO ) = DTGD%XDATA_FRAC_NVEG(:)
-IF (TGDP%CTYPE_NVEG == 'ROCK') DTGD%XDATA_VEGTYPE(:, NVT_ROCK) = DTGD%XDATA_FRAC_NVEG(:)
-IF (TGDP%CTYPE_NVEG == 'SNOW') DTGD%XDATA_VEGTYPE(:, NVT_SNOW) = DTGD%XDATA_FRAC_NVEG(:)
-IF (TGDP%CTYPE_HVEG == 'TEBD') DTGD%XDATA_VEGTYPE(:, NVT_TEBD) = DTGD%XDATA_FRAC_HVEG(:)
-IF (TGDP%CTYPE_HVEG == 'TRBD') DTGD%XDATA_VEGTYPE(:, NVT_TRBD) = DTGD%XDATA_FRAC_HVEG(:)
-IF (TGDP%CTYPE_HVEG == 'TEBE') DTGD%XDATA_VEGTYPE(:, NVT_TEBE) = DTGD%XDATA_FRAC_HVEG(:)
-IF (TGDP%CTYPE_HVEG == 'BOBD') DTGD%XDATA_VEGTYPE(:, NVT_BOBD) = DTGD%XDATA_FRAC_HVEG(:)
-IF (TGDP%CTYPE_HVEG == 'SHRB') DTGD%XDATA_VEGTYPE(:, NVT_SHRB) = DTGD%XDATA_FRAC_HVEG(:)
-IF (TGDP%CTYPE_HVEG == 'BONE') DTGD%XDATA_VEGTYPE(:, NVT_BONE) = DTGD%XDATA_FRAC_HVEG(:)
-IF (TGDP%CTYPE_HVEG == 'TENE') DTGD%XDATA_VEGTYPE(:, NVT_TENE) = DTGD%XDATA_FRAC_HVEG(:)
-IF (TGDP%CTYPE_HVEG == 'BOND') DTGD%XDATA_VEGTYPE(:, NVT_BOND) = DTGD%XDATA_FRAC_HVEG(:)
-IF (TGDP%CTYPE_HVEG == 'TRBE') DTGD%XDATA_VEGTYPE(:, NVT_TRBE) = DTGD%XDATA_FRAC_HVEG(:)
-IF (TGDP%CTYPE_LVEG == 'C3 ') DTGD%XDATA_VEGTYPE(:, NVT_C3 ) = DTGD%XDATA_FRAC_LVEG(:)
-IF (TGDP%CTYPE_LVEG == 'C4 ') DTGD%XDATA_VEGTYPE(:, NVT_C4 ) = DTGD%XDATA_FRAC_LVEG(:)
-IF (TGDP%CTYPE_LVEG == 'IRR ') DTGD%XDATA_VEGTYPE(:, NVT_IRR ) = DTGD%XDATA_FRAC_LVEG(:)
-IF (TGDP%CTYPE_LVEG == 'GRAS') DTGD%XDATA_VEGTYPE(:, NVT_GRAS) = DTGD%XDATA_FRAC_LVEG(:)
-IF (TGDP%CTYPE_LVEG == 'BOGR') DTGD%XDATA_VEGTYPE(:, NVT_BOGR) = DTGD%XDATA_FRAC_LVEG(:)
-IF (TGDP%CTYPE_LVEG == 'TROG') DTGD%XDATA_VEGTYPE(:, NVT_TROG) = DTGD%XDATA_FRAC_LVEG(:)
-IF (TGDP%CTYPE_LVEG == 'PARK') DTGD%XDATA_VEGTYPE(:, NVT_PARK) = DTGD%XDATA_FRAC_LVEG(:)
-
-!
-! Dry/Wet soil albedo
- CALL DRY_WET_SOIL_ALBEDOS(TGDP%XSAND(:,1),TGDP%XCLAY(:,1), &
- DTGD%XDATA_VEGTYPE, &
- DTGD%XDATA_ALBNIR_DRY,DTGD%XDATA_ALBVIS_DRY,DTGD%XDATA_ALBUV_DRY, &
- DTGD%XDATA_ALBNIR_WET,DTGD%XDATA_ALBVIS_WET,DTGD%XDATA_ALBUV_WET )
+DTV%XPAR_VEGTYPE(:,:) = 0.
+IF (IO%CTYPE_NVEG == 'NO ') DTV%XPAR_VEGTYPE(:, NVT_NO ) = DTV%XPAR_FRAC_NVEG(:)
+IF (IO%CTYPE_NVEG == 'ROCK') DTV%XPAR_VEGTYPE(:, NVT_ROCK) = DTV%XPAR_FRAC_NVEG(:)
+IF (IO%CTYPE_NVEG == 'SNOW') DTV%XPAR_VEGTYPE(:, NVT_SNOW) = DTV%XPAR_FRAC_NVEG(:)
+IF (IO%CTYPE_HVEG == 'TEBD') DTV%XPAR_VEGTYPE(:, NVT_TEBD) = DTV%XPAR_FRAC_HVEG(:)
+IF (IO%CTYPE_HVEG == 'TRBD') DTV%XPAR_VEGTYPE(:, NVT_TRBD) = DTV%XPAR_FRAC_HVEG(:)
+IF (IO%CTYPE_HVEG == 'TEBE') DTV%XPAR_VEGTYPE(:, NVT_TEBE) = DTV%XPAR_FRAC_HVEG(:)
+IF (IO%CTYPE_HVEG == 'BOBD') DTV%XPAR_VEGTYPE(:, NVT_BOBD) = DTV%XPAR_FRAC_HVEG(:)
+IF (IO%CTYPE_HVEG == 'SHRB') DTV%XPAR_VEGTYPE(:, NVT_SHRB) = DTV%XPAR_FRAC_HVEG(:)
+IF (IO%CTYPE_HVEG == 'BONE') DTV%XPAR_VEGTYPE(:, NVT_BONE) = DTV%XPAR_FRAC_HVEG(:)
+IF (IO%CTYPE_HVEG == 'TENE') DTV%XPAR_VEGTYPE(:, NVT_TENE) = DTV%XPAR_FRAC_HVEG(:)
+IF (IO%CTYPE_HVEG == 'BOND') DTV%XPAR_VEGTYPE(:, NVT_BOND) = DTV%XPAR_FRAC_HVEG(:)
+IF (IO%CTYPE_HVEG == 'TRBE') DTV%XPAR_VEGTYPE(:, NVT_TRBE) = DTV%XPAR_FRAC_HVEG(:)
+!
+IF (IO%CTYPE_LVEG == 'C3 ') THEN
+ IF (NVT_C3>0) THEN
+ DTV%XPAR_VEGTYPE(:, NVT_C3 ) = DTV%XPAR_FRAC_LVEG(:)
+ ELSEIF (NVT_C3W>0) THEN
+ DTV%XPAR_VEGTYPE(:, NVT_C3W ) = DTV%XPAR_FRAC_LVEG(:)
+ ENDIF
+ENDIF
+!
+IF (IO%CTYPE_LVEG == 'C3W ') THEN
+ IF (NVT_C3W>0) THEN
+ DTV%XPAR_VEGTYPE(:, NVT_C3W ) = DTV%XPAR_FRAC_LVEG(:)
+ ELSE
+ CALL ABOR1_SFX("READ_PGD_TEB_GARDEN_PAR: NO VEGTYPE C3W WITHOUT ECOSG")
+ ENDIF
+ENDIF
+!
+IF (IO%CTYPE_LVEG == 'C3S ') THEN
+ IF (NVT_C3S>0) THEN
+ DTV%XPAR_VEGTYPE(:, NVT_C3S ) = DTV%XPAR_FRAC_LVEG(:)
+ ELSE
+ CALL ABOR1_SFX("READ_PGD_TEB_GARDEN_PAR: NO VEGTYPE C3S WITHOUT ECOSG")
+ ENDIF
+ENDIF
+!
+IF (IO%CTYPE_LVEG == 'C4 ') DTV%XPAR_VEGTYPE(:, NVT_C4 ) = DTV%XPAR_FRAC_LVEG(:)
+!
+IF (IO%CTYPE_LVEG == 'IRR ') THEN
+ IF (NVT_IRR>0) THEN
+ DTV%XPAR_VEGTYPE(:, NVT_IRR ) = DTV%XPAR_FRAC_LVEG(:)
+ ELSE
+ CALL ABOR1_SFX("READ_PGD_TEB_GARDEN_PAR: NO VEGTYPE IRR WITH ECOSG")
+ ENDIF
+ENDIF
+!
+IF (IO%CTYPE_LVEG == 'GRAS') DTV%XPAR_VEGTYPE(:, NVT_GRAS) = DTV%XPAR_FRAC_LVEG(:)
+IF (IO%CTYPE_LVEG == 'BOGR') DTV%XPAR_VEGTYPE(:, NVT_BOGR) = DTV%XPAR_FRAC_LVEG(:)
+IF (IO%CTYPE_LVEG == 'TROG') DTV%XPAR_VEGTYPE(:, NVT_TROG) = DTV%XPAR_FRAC_LVEG(:)
+!
+IF (IO%CTYPE_LVEG == 'PARK') THEN
+ IF (NVT_PARK>0) THEN
+ DTV%XPAR_VEGTYPE(:, NVT_PARK) = DTV%XPAR_FRAC_LVEG(:)
+ ELSEIF (NVT_FLGR>0) THEN
+ DTV%XPAR_VEGTYPE(:, NVT_FLGR) = DTV%XPAR_FRAC_LVEG(:)
+ ENDIF
+ENDIF
+!
+IF (IO%CTYPE_LVEG == 'FLGR') THEN
+ IF (NVT_FLGR>0) THEN
+ DTV%XPAR_VEGTYPE(:, NVT_FLGR) = DTV%XPAR_FRAC_LVEG(:)
+ ELSE
+ CALL ABOR1_SFX("READ_PGD_TEB_GARDEN_PAR: NO VEGTYPE FLGR WITHOUT ECOSG")
+ ENDIF
+ENDIF
+IF (IO%CTYPE_LVEG == 'FLTR') THEN
+ IF (NVT_FLTR>0) THEN
+ DTV%XPAR_VEGTYPE(:, NVT_FLTR) = DTV%XPAR_FRAC_HVEG(:)
+ ELSE
+ CALL ABOR1_SFX("READ_PGD_TEB_GARDEN_PAR: NO VEGTYPE FLTR WITHOUT ECOSG")
+ ENDIF
+ENDIF
!
! Height of trees
-DTGD%XDATA_H_TREE (:) = DTGD%XDATA_H_HVEG(:)
+DTV%XPAR_H_TREE (:,1) = DTV%XPAR_H_HVEG(:)
!
! Critical normilized soil water content for stress parameterisation
-DTGD%XDATA_F2I (:) = 0.3
+DTV%XPAR_F2I (:,1) = 0.3
!
! Ratio between roughness length for momentum and heat
-DTGD%XDATA_Z0_O_Z0H(:) = 10.
+DTV%XPAR_Z0_O_Z0H(:,1) = 10.
!
! Defensive/offensive strategy (1/0)
-DTGD%LDATA_STRESS (:) = .FALSE.
+DTV%LPAR_STRESS (:,1) = .FALSE.
!
-DO JI=1,TG%NDIM
+DO JI=1,KDIM
!
! Near-IR, visible, and UV albedo (vegetation only)
ZDATA_ALBNIR_VEG(JI,:)= 0.30
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_ALBNIR_VEG(JI,1)= 0.25
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_ALBNIR_VEG(JI,1)= 0.25
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_ALBNIR_VEG(JI,1)= 0.25
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_ALBNIR_VEG(JI,1)= 0.25
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_ALBNIR_VEG(JI,1)= 0.25
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_ALBNIR_VEG(JI,1)= 0.15
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_ALBNIR_VEG(JI,1)= 0.15
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_ALBNIR_VEG(JI,1)= 0.15
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_ALBNIR_VEG(JI,1)= 0.21
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_ALBNIR_VEG(JI,1)= 0.25
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_ALBNIR_VEG(JI,1)= 0.25
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_ALBNIR_VEG(JI,1)= 0.25
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_ALBNIR_VEG(JI,1)= 0.25
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_ALBNIR_VEG(JI,1)= 0.25
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_ALBNIR_VEG(JI,1)= 0.15
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_ALBNIR_VEG(JI,1)= 0.15
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_ALBNIR_VEG(JI,1)= 0.15
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_ALBNIR_VEG(JI,1)= 0.21
+ IF (NVT_FLTR>0) THEN
+ IF (DTV%XPAR_VEGTYPE(JI,NVT_FLTR)>0.) ZDATA_ALBNIR_VEG(JI,1) = 0.25
+ ENDIF
ZDATA_ALBVIS_VEG(JI,:)= 0.10
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_ALBVIS_VEG(JI,1)= 0.05
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_ALBVIS_VEG(JI,1)= 0.05
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_ALBVIS_VEG(JI,1)= 0.05
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_ALBVIS_VEG(JI,1)= 0.05
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_ALBVIS_VEG(JI,1)= 0.05
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_ALBVIS_VEG(JI,1)= 0.05
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_ALBVIS_VEG(JI,1)= 0.05
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_ALBVIS_VEG(JI,1)= 0.05
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_ALBVIS_VEG(JI,1)= 0.05
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_ALBVIS_VEG(JI,1)= 0.05
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_ALBVIS_VEG(JI,1)= 0.05
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_ALBVIS_VEG(JI,1)= 0.05
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_ALBVIS_VEG(JI,1)= 0.05
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_ALBVIS_VEG(JI,1)= 0.05
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_ALBVIS_VEG(JI,1)= 0.05
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_ALBVIS_VEG(JI,1)= 0.05
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_ALBVIS_VEG(JI,1)= 0.05
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_ALBVIS_VEG(JI,1)= 0.05
+ IF (NVT_FLTR>0) THEN
+ IF (DTV%XPAR_VEGTYPE(JI,NVT_FLTR)>0.) ZDATA_ALBVIS_VEG(JI,1) = 0.05
+ ENDIF
ZDATA_ALBUV_VEG (JI,:)= 0.06
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_ALBUV_VEG(JI,1)= 0.0525
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_ALBUV_VEG(JI,1)= 0.0525
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_ALBUV_VEG(JI,1)= 0.0525
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_ALBUV_VEG(JI,1)= 0.0525
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_ALBUV_VEG(JI,1)= 0.0525
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_ALBUV_VEG(JI,1)= 0.0425
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_ALBUV_VEG(JI,1)= 0.0425
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_ALBUV_VEG(JI,1)= 0.0425
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_ALBUV_VEG(JI,1)= 0.0380
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_GRAS)>0. ) ZDATA_ALBUV_VEG(JI,2)= 0.0800
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOGR)>0. ) ZDATA_ALBUV_VEG(JI,2)= 0.0800
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TROG)>0. ) ZDATA_ALBUV_VEG(JI,2)= 0.1250
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_IRR )>0. ) ZDATA_ALBUV_VEG(JI,2)= 0.0450
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_PARK)>0. ) ZDATA_ALBUV_VEG(JI,2)= 0.0450
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_ALBUV_VEG(JI,1)= 0.0525
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_ALBUV_VEG(JI,1)= 0.0525
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_ALBUV_VEG(JI,1)= 0.0525
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_ALBUV_VEG(JI,1)= 0.0525
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_ALBUV_VEG(JI,1)= 0.0525
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_ALBUV_VEG(JI,1)= 0.0425
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_ALBUV_VEG(JI,1)= 0.0425
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_ALBUV_VEG(JI,1)= 0.0425
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_ALBUV_VEG(JI,1)= 0.0380
+ IF (NVT_FLTR>0) THEN
+ IF (DTV%XPAR_VEGTYPE(JI,NVT_FLTR)>0.) ZDATA_ALBUV_VEG(JI,1) = 0.0525
+ ENDIF
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) ZDATA_ALBUV_VEG(JI,2)= 0.0800
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOGR)>0. ) ZDATA_ALBUV_VEG(JI,2)= 0.0800
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) ZDATA_ALBUV_VEG(JI,2)= 0.1250
+ IF (NVT_IRR>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_IRR )>0. ) ZDATA_ALBUV_VEG(JI,2)= 0.0450
+ ENDIF
+ IF (NVT_PARK>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_PARK)>0. ) ZDATA_ALBUV_VEG(JI,2)= 0.0450
+ ELSEIF (NVT_FLGR>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_FLGR)>0. ) ZDATA_ALBUV_VEG(JI,2)= 0.0450
+ ENDIF
- IF (DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) .GT. 0.) THEN
- DTGD%XDATA_ALBNIR_VEG(JI) = ( ZDATA_ALBNIR_VEG(JI,1)*DTGD%XDATA_FRAC_HVEG(JI) &
- + ZDATA_ALBNIR_VEG(JI,2)*DTGD%XDATA_FRAC_LVEG(JI) ) &
- / ( DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) )
-!
- DTGD%XDATA_ALBVIS_VEG(JI) = ( ZDATA_ALBVIS_VEG(JI,1)*DTGD%XDATA_FRAC_HVEG(JI) &
- + ZDATA_ALBVIS_VEG(JI,2)*DTGD%XDATA_FRAC_LVEG(JI) ) &
- / ( DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) )
+ IF (DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) .GT. 0.) THEN
+ DTV%XPAR_ALBNIR_VEG(JI,1,1) = ( ZDATA_ALBNIR_VEG(JI,1)*DTV%XPAR_FRAC_HVEG(JI) &
+ + ZDATA_ALBNIR_VEG(JI,2)*DTV%XPAR_FRAC_LVEG(JI) ) &
+ / ( DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) )
+!
+ DTV%XPAR_ALBVIS_VEG(JI,1,1) = ( ZDATA_ALBVIS_VEG(JI,1)*DTV%XPAR_FRAC_HVEG(JI) &
+ + ZDATA_ALBVIS_VEG(JI,2)*DTV%XPAR_FRAC_LVEG(JI) ) &
+ / ( DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) )
!
- DTGD%XDATA_ALBUV_VEG (JI) = ( ZDATA_ALBUV_VEG (JI,1)*DTGD%XDATA_FRAC_HVEG(JI) &
- + ZDATA_ALBUV_VEG (JI,2)*DTGD%XDATA_FRAC_LVEG(JI) ) &
- / ( DTGD%XDATA_FRAC_HVEG (JI)+DTGD%XDATA_FRAC_LVEG(JI) )
- ENDIF
-!
-! Soil albedo
- ZDATA_WGSAT(:) = 0.
- ZDATA_WG1 (:) = 0.
- CALL SOIL_ALBEDO('DRY', &
- ZDATA_WGSAT, ZDATA_WG1, &
- DTGD%XDATA_ALBVIS_DRY, DTGD%XDATA_ALBNIR_DRY, DTGD%XDATA_ALBUV_DRY, &
- DTGD%XDATA_ALBVIS_WET, DTGD%XDATA_ALBNIR_WET, DTGD%XDATA_ALBUV_WET, &
- DTGD%XDATA_ALBVIS_SOIL,DTGD%XDATA_ALBNIR_SOIL,DTGD%XDATA_ALBUV_SOIL )
+ DTV%XPAR_ALBUV_VEG (JI,1,1) = ( ZDATA_ALBUV_VEG (JI,1)*DTV%XPAR_FRAC_HVEG(JI) &
+ + ZDATA_ALBUV_VEG (JI,2)*DTV%XPAR_FRAC_LVEG(JI) ) &
+ / ( DTV%XPAR_FRAC_HVEG (JI)+DTV%XPAR_FRAC_LVEG(JI) )
+ ENDIF
!
! Min stomatal resistance
ZDATA_RSMIN(JI,:)= 40.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_RSMIN(JI,1)= 150.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_RSMIN(JI,1)= 150.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_RSMIN(JI,1)= 150.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_RSMIN(JI,1)= 150.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_RSMIN(JI,1)= 150.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_RSMIN(JI,1)= 150.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_RSMIN(JI,1)= 150.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_RSMIN(JI,1)= 150.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_RSMIN(JI,1)= XEVERG_RSMIN
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TROG)>0. ) ZDATA_RSMIN(JI,2)= 120.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_C4 )>0. ) ZDATA_RSMIN(JI,2)= 120.
- IF (DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) .GT. 0.) &
- DTGD%XDATA_RSMIN(JI) = ( ZDATA_RSMIN(JI,1)*DTGD%XDATA_FRAC_HVEG(JI) &
- + ZDATA_RSMIN(JI,2)*DTGD%XDATA_FRAC_LVEG(JI) ) &
- / ( DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) )
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_RSMIN(JI,1)= 150.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_RSMIN(JI,1)= 150.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_RSMIN(JI,1)= 150.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_RSMIN(JI,1)= 150.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_RSMIN(JI,1)= 150.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_RSMIN(JI,1)= 150.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_RSMIN(JI,1)= 150.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_RSMIN(JI,1)= 150.
+ IF (NVT_FLTR>0) THEN
+ IF (DTV%XPAR_VEGTYPE(JI,NVT_FLTR)>0.) ZDATA_RSMIN(JI,1) = 150.
+ ENDIF
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_RSMIN(JI,1)= XEVERG_RSMIN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) ZDATA_RSMIN(JI,2)= 120.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_C4 )>0. ) ZDATA_RSMIN(JI,2)= 120.
+ IF (DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) .GT. 0.) &
+ DTV%XPAR_RSMIN(JI,1) = ( ZDATA_RSMIN(JI,1)*DTV%XPAR_FRAC_HVEG(JI) &
+ + ZDATA_RSMIN(JI,2)*DTV%XPAR_FRAC_LVEG(JI) ) &
+ / ( DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) )
!
! Gamma parameter
ZDATA_GAMMA(JI,:)= 0.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_GAMMA(JI,1)= 0.04
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_GAMMA(JI,1)= 0.04
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_GAMMA(JI,1)= 0.04
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_GAMMA(JI,1)= 0.04
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_GAMMA(JI,1)= 0.04
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_GAMMA(JI,1)= 0.04
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_GAMMA(JI,1)= 0.04
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_GAMMA(JI,1)= 0.04
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_GAMMA(JI,1)= 0.04
- IF (DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) .GT. 0.) &
- DTGD%XDATA_GAMMA(JI) = ( ZDATA_GAMMA(JI,1)*DTGD%XDATA_FRAC_HVEG(JI) &
- + ZDATA_GAMMA(JI,2)*DTGD%XDATA_FRAC_LVEG(JI) ) &
- / ( DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) )
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_GAMMA(JI,1)= 0.04
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_GAMMA(JI,1)= 0.04
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_GAMMA(JI,1)= 0.04
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_GAMMA(JI,1)= 0.04
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_GAMMA(JI,1)= 0.04
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_GAMMA(JI,1)= 0.04
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_GAMMA(JI,1)= 0.04
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_GAMMA(JI,1)= 0.04
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_GAMMA(JI,1)= 0.04
+ IF (NVT_FLTR>0) THEN
+ IF (DTV%XPAR_VEGTYPE(JI,NVT_FLTR)>0.) ZDATA_GAMMA(JI,1) = 0.04
+ ENDIF
+ IF (DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) .GT. 0.) &
+ DTV%XPAR_GAMMA(JI,1) = ( ZDATA_GAMMA(JI,1)*DTV%XPAR_FRAC_HVEG(JI) &
+ + ZDATA_GAMMA(JI,2)*DTV%XPAR_FRAC_LVEG(JI) ) &
+ / ( DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) )
!
! Wrmax_cf
ZDATA_WRMAX_CF(JI,:)= 0.2
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_WRMAX_CF(JI,1)= 0.1
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_WRMAX_CF(JI,1)= 0.1
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_WRMAX_CF(JI,1)= 0.1
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_WRMAX_CF(JI,1)= 0.1
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_WRMAX_CF(JI,1)= 0.1
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_WRMAX_CF(JI,1)= 0.1
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_WRMAX_CF(JI,1)= 0.1
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_WRMAX_CF(JI,1)= 0.1
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_WRMAX_CF(JI,1)= 0.1
- IF (DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) .GT. 0.) &
- DTGD%XDATA_WRMAX_CF(JI) = ( ZDATA_WRMAX_CF(JI,1)*DTGD%XDATA_FRAC_HVEG(JI) &
- + ZDATA_WRMAX_CF(JI,2)*DTGD%XDATA_FRAC_LVEG(JI) ) &
- / ( DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) )
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_WRMAX_CF(JI,1)= 0.1
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_WRMAX_CF(JI,1)= 0.1
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_WRMAX_CF(JI,1)= 0.1
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_WRMAX_CF(JI,1)= 0.1
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_WRMAX_CF(JI,1)= 0.1
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_WRMAX_CF(JI,1)= 0.1
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_WRMAX_CF(JI,1)= 0.1
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_WRMAX_CF(JI,1)= 0.1
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_WRMAX_CF(JI,1)= 0.1
+ IF (NVT_FLTR>0) THEN
+ IF (DTV%XPAR_VEGTYPE(JI,NVT_FLTR)>0.) ZDATA_WRMAX_CF(JI,1) = 0.1
+ ENDIF
+ IF (DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) .GT. 0.) &
+ DTV%XPAR_WRMAX_CF(JI,1) = ( ZDATA_WRMAX_CF(JI,1)*DTV%XPAR_FRAC_HVEG(JI) &
+ + ZDATA_WRMAX_CF(JI,2)*DTV%XPAR_FRAC_LVEG(JI) ) &
+ / ( DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) )
!
! Rgl
ZDATA_RGL(JI,:)= 100.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_RGL(JI,1)= 30.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_RGL(JI,1)= 30.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_RGL(JI,1)= 30.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_RGL(JI,1)= 30.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_RGL(JI,1)= 30.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_RGL(JI,1)= 30.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_RGL(JI,1)= 30.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_RGL(JI,1)= 30.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_RGL(JI,1)= 30.
- IF (DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) .GT. 0.) &
- DTGD%XDATA_RGL(JI) = ( ZDATA_RGL(JI,1)*DTGD%XDATA_FRAC_HVEG(JI) &
- + ZDATA_RGL(JI,2)*DTGD%XDATA_FRAC_LVEG(JI) ) &
- / ( DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) )
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_RGL(JI,1)= 30.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_RGL(JI,1)= 30.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_RGL(JI,1)= 30.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_RGL(JI,1)= 30.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_RGL(JI,1)= 30.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_RGL(JI,1)= 30.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_RGL(JI,1)= 30.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_RGL(JI,1)= 30.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_RGL(JI,1)= 30.
+ IF (NVT_FLTR>0) THEN
+ IF (DTV%XPAR_VEGTYPE(JI,NVT_FLTR)>0.) ZDATA_RGL(JI,1) = 30.
+ ENDIF
+ IF (DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) .GT. 0.) &
+ DTV%XPAR_RGL(JI,1) = ( ZDATA_RGL(JI,1)*DTV%XPAR_FRAC_HVEG(JI) &
+ + ZDATA_RGL(JI,2)*DTV%XPAR_FRAC_LVEG(JI) ) &
+ / ( DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) )
!
! Cv
ZDATA_CV(JI,:)= 2.E-5
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_CV(JI,1)= 1.E-5
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_CV(JI,1)= 1.E-5
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_CV(JI,1)= 1.E-5
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_CV(JI,1)= 1.E-5
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_CV(JI,1)= 1.E-5
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_CV(JI,1)= 1.E-5
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_CV(JI,1)= 1.E-5
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_CV(JI,1)= 1.E-5
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_CV(JI,1)= 1.E-5
- IF (DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) .GT. 0.) &
- DTGD%XDATA_CV(JI) = ( ZDATA_CV(JI,1)*DTGD%XDATA_FRAC_HVEG(JI) &
- + ZDATA_CV(JI,2)*DTGD%XDATA_FRAC_LVEG(JI) ) &
- / ( DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) )
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_CV(JI,1)= 1.E-5
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_CV(JI,1)= 1.E-5
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_CV(JI,1)= 1.E-5
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_CV(JI,1)= 1.E-5
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_CV(JI,1)= 1.E-5
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_CV(JI,1)= 1.E-5
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_CV(JI,1)= 1.E-5
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_CV(JI,1)= 1.E-5
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_CV(JI,1)= 1.E-5
+ IF (NVT_FLTR>0) THEN
+ IF (DTV%XPAR_VEGTYPE(JI,NVT_FLTR)>0.) ZDATA_CV(JI,1) = 1.E-5
+ ENDIF
+ IF (DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) .GT. 0.) &
+ DTV%XPAR_CV(JI,1) = ( ZDATA_CV(JI,1)*DTV%XPAR_FRAC_HVEG(JI) &
+ + ZDATA_CV(JI,2)*DTV%XPAR_FRAC_LVEG(JI) ) &
+ / ( DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) )
!
! Mesophyll conductance (m s-1)
ZDATA_GMES(JI,:)=0.020
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_GMES(JI,1)= 0.001
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_GMES(JI,1)= 0.001
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_GMES(JI,1)= 0.001
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_GMES(JI,1)= 0.001
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_GMES(JI,1)= 0.001
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_GMES(JI,1)= 0.001
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_GMES(JI,1)= 0.001
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_GMES(JI,1)= 0.001
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_GMES(JI,1)= 0.001
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_C3 )>0. ) ZDATA_GMES(JI,2)= 0.003
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_C4 )>0. ) ZDATA_GMES(JI,2)= 0.003
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_IRR )>0. ) ZDATA_GMES(JI,2)= 0.003
- IF (DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) .GT. 0.) &
- DTGD%XDATA_GMES(JI) = ( ZDATA_GMES(JI,1)*DTGD%XDATA_FRAC_HVEG(JI) &
- + ZDATA_GMES(JI,2)*DTGD%XDATA_FRAC_LVEG(JI) ) &
- / ( DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) )
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_GMES(JI,1)= 0.001
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_GMES(JI,1)= 0.001
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_GMES(JI,1)= 0.001
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_GMES(JI,1)= 0.001
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_GMES(JI,1)= 0.001
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_GMES(JI,1)= 0.001
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_GMES(JI,1)= 0.001
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_GMES(JI,1)= 0.001
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_GMES(JI,1)= 0.001
+ IF (NVT_FLTR>0) THEN
+ IF (DTV%XPAR_VEGTYPE(JI,NVT_FLTR)>0.) ZDATA_GMES(JI,1) = 0.001
+ ENDIF
+ IF (NVT_C3>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_C3 )>0. ) ZDATA_GMES(JI,2)= 0.003
+ ENDIF
+ IF (NVT_C3W>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_C3W )>0. ) ZDATA_GMES(JI,2)= 0.003
+ ENDIF
+ IF (NVT_C3S>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_C3S )>0. ) ZDATA_GMES(JI,2)= 0.003
+ ENDIF
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_C4 )>0. ) ZDATA_GMES(JI,2)= 0.003
+ IF (NVT_IRR>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_IRR )>0. ) ZDATA_GMES(JI,2)= 0.003
+ ENDIF
+ IF (DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) .GT. 0.) &
+ DTV%XPAR_GMES(JI,1) = ( ZDATA_GMES(JI,1)*DTV%XPAR_FRAC_HVEG(JI) &
+ + ZDATA_GMES(JI,2)*DTV%XPAR_FRAC_LVEG(JI) ) &
+ / ( DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) )
!
! Ecosystem Respiration (kg/kg.m.s-1)
ZDATA_RE25(JI,:)= 3.0E-7
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_RE25(JI,1)= 1.5E-7
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_RE25(JI,1)= 1.5E-7
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_RE25(JI,1)= 1.5E-7
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_C4 )>0. ) ZDATA_RE25(JI,2)= 2.5E-7
- IF (DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) .GT. 0.) &
- DTGD%XDATA_RE25(JI) = ( ZDATA_RE25(JI,1)*DTGD%XDATA_FRAC_HVEG(JI) &
- + ZDATA_RE25(JI,2)*DTGD%XDATA_FRAC_LVEG(JI) ) &
- / ( DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) )
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_RE25(JI,1)= 1.5E-7
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_RE25(JI,1)= 1.5E-7
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_RE25(JI,1)= 1.5E-7
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_C4 )>0. ) ZDATA_RE25(JI,2)= 2.5E-7
+ IF (DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) .GT. 0.) &
+ DTV%XPAR_RE25(JI,1) = ( ZDATA_RE25(JI,1)*DTV%XPAR_FRAC_HVEG(JI) &
+ + ZDATA_RE25(JI,2)*DTV%XPAR_FRAC_LVEG(JI) ) &
+ / ( DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) )
!
! Cuticular conductance (m s-1)
ZDATA_GC(JI,:)=0.00025
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_GC(JI,1)= 0.00015
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_GC(JI,1)= 0.00015
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_GC(JI,1)= 0.00015
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_GC(JI,1)= 0.00015
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_GC(JI,1)= 0.00015
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_GC(JI,1)= 0.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_GC(JI,1)= 0.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_GC(JI,1)= 0.
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_GC(JI,1)= 0.00015
- IF (DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) .GT. 0.) &
- DTGD%XDATA_GC(JI) = ( ZDATA_GC(JI,1)*DTGD%XDATA_FRAC_HVEG(JI) &
- + ZDATA_GC(JI,2)*DTGD%XDATA_FRAC_LVEG(JI) ) &
- / ( DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) )
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_GC(JI,1)= 0.00015
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_GC(JI,1)= 0.00015
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_GC(JI,1)= 0.00015
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_GC(JI,1)= 0.00015
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_GC(JI,1)= 0.00015
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_GC(JI,1)= 0.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_GC(JI,1)= 0.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_GC(JI,1)= 0.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_GC(JI,1)= 0.00015
+ IF (NVT_FLTR>0) THEN
+ IF (DTV%XPAR_VEGTYPE(JI,NVT_FLTR)>0.) ZDATA_GC(JI,1) = 0.00015
+ ENDIF
+ IF (DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) .GT. 0.) &
+ DTV%XPAR_GC(JI,1) = ( ZDATA_GC(JI,1)*DTV%XPAR_FRAC_HVEG(JI) &
+ + ZDATA_GC(JI,2)*DTV%XPAR_FRAC_LVEG(JI) ) &
+ / ( DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) )
!
! Ratio d(biomass)/d(lai) (kg/m2)
ZDATA_BSLAI(JI,:)=0.36
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_BSLAI(JI,1)= 0.25
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_BSLAI(JI,1)= 0.25
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_BSLAI(JI,1)= 0.25
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_BSLAI(JI,1)= 0.25
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_BSLAI(JI,1)= 0.25
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_BSLAI(JI,1)= 0.25
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_BSLAI(JI,1)= 0.25
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_BSLAI(JI,1)= 0.25
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_BSLAI(JI,1)= 0.25
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_C3 )>0. ) ZDATA_BSLAI(JI,2)= 0.06
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_C4 )>0. ) ZDATA_BSLAI(JI,2)= 0.06
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_IRR )>0. ) ZDATA_BSLAI(JI,2)= 0.06
- IF (DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) .GT. 0.) &
- DTGD%XDATA_BSLAI(JI) = ( ZDATA_BSLAI(JI,1)*DTGD%XDATA_FRAC_HVEG(JI) &
- + ZDATA_BSLAI(JI,2)*DTGD%XDATA_FRAC_LVEG(JI) ) &
- / ( DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) )
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_BSLAI(JI,1)= 0.25
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_BSLAI(JI,1)= 0.25
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_BSLAI(JI,1)= 0.25
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_BSLAI(JI,1)= 0.25
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_BSLAI(JI,1)= 0.25
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_BSLAI(JI,1)= 0.25
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_BSLAI(JI,1)= 0.25
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_BSLAI(JI,1)= 0.25
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_BSLAI(JI,1)= 0.25
+ IF (NVT_FLTR>0) THEN
+ IF (DTV%XPAR_VEGTYPE(JI,NVT_FLTR)>0.) ZDATA_BSLAI(JI,1) = 0.25
+ ENDIF
+ IF (NVT_C3>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_C3 )>0. ) ZDATA_BSLAI(JI,2)= 0.06
+ ENDIF
+ IF (NVT_C3W>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_C3W )>0. ) ZDATA_BSLAI(JI,2)= 0.06
+ ENDIF
+ IF (NVT_C3S>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_C3S )>0. ) ZDATA_BSLAI(JI,2)= 0.06
+ ENDIF
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_C4 )>0. ) ZDATA_BSLAI(JI,2)= 0.06
+ IF (NVT_IRR>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_IRR )>0. ) ZDATA_BSLAI(JI,2)= 0.06
+ ENDIF
+ IF (DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) .GT. 0.) &
+ DTV%XPAR_BSLAI(JI,1) = ( ZDATA_BSLAI(JI,1)*DTV%XPAR_FRAC_HVEG(JI) &
+ + ZDATA_BSLAI(JI,2)*DTV%XPAR_FRAC_LVEG(JI) ) &
+ / ( DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) )
!
! Maximum air saturation deficit tolerate by vegetation (kg/kg)
ZDATA_DMAX(JI,:) = 0.1
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_DMAX(JI,1)= 0.1
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_DMAX(JI,1)= 0.1
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_DMAX(JI,1)= 0.1
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_DMAX(JI,1)= 0.1
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_DMAX(JI,1)= 0.1
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_DMAX(JI,1)= 0.1
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_DMAX(JI,1)= 0.1
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_DMAX(JI,1)= 0.1
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_DMAX(JI,1)= 0.1
- IF (DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) .GT. 0.) &
- DTGD%XDATA_DMAX(JI) = ( ZDATA_DMAX(JI,1)*DTGD%XDATA_FRAC_HVEG(JI) &
- + ZDATA_DMAX(JI,2)*DTGD%XDATA_FRAC_LVEG(JI) ) &
- / ( DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) )
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_DMAX(JI,1)= 0.1
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_DMAX(JI,1)= 0.1
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_DMAX(JI,1)= 0.1
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_DMAX(JI,1)= 0.1
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_DMAX(JI,1)= 0.1
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_DMAX(JI,1)= 0.1
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_DMAX(JI,1)= 0.1
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_DMAX(JI,1)= 0.1
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_DMAX(JI,1)= 0.1
+ IF (NVT_FLTR>0) THEN
+ IF (DTV%XPAR_VEGTYPE(JI,NVT_FLTR)>0.) ZDATA_DMAX(JI,1) = 0.1
+ ENDIF
+ IF (DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) .GT. 0.) &
+ DTV%XPAR_DMAX(JI,1) = ( ZDATA_DMAX(JI,1)*DTV%XPAR_FRAC_HVEG(JI) &
+ + ZDATA_DMAX(JI,2)*DTV%XPAR_FRAC_LVEG(JI) ) &
+ / ( DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) )
!
! e-folding time for senescence (days)
ZDATA_SEFOLD(JI,:)=90. * XDAY
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_SEFOLD(JI,1)= 365.* XDAY
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_SEFOLD(JI,1)= 365.* XDAY
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_SEFOLD(JI,1)= 365.* XDAY
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_SEFOLD(JI,1)= 365.* XDAY
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_SEFOLD(JI,1)= 365.* XDAY
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_SEFOLD(JI,1)= 365.* XDAY
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_SEFOLD(JI,1)= 365.* XDAY
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_SEFOLD(JI,1)= 365.* XDAY
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_SEFOLD(JI,1)= 365.* XDAY
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_C3 )>0. ) ZDATA_SEFOLD(JI,2)= 60.* XDAY
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_C4 )>0. ) ZDATA_SEFOLD(JI,2)= 60.* XDAY
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_IRR )>0. ) ZDATA_SEFOLD(JI,2)= 60.* XDAY
- IF (DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) .GT. 0.) &
- DTGD%XDATA_SEFOLD(JI) = ( ZDATA_SEFOLD(JI,1)*DTGD%XDATA_FRAC_HVEG(JI) &
- + ZDATA_SEFOLD(JI,2)*DTGD%XDATA_FRAC_LVEG(JI) ) &
- / ( DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) )
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_SEFOLD(JI,1)= 365.* XDAY
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_SEFOLD(JI,1)= 365.* XDAY
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_SEFOLD(JI,1)= 365.* XDAY
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_SEFOLD(JI,1)= 365.* XDAY
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_SEFOLD(JI,1)= 365.* XDAY
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_SEFOLD(JI,1)= 365.* XDAY
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_SEFOLD(JI,1)= 365.* XDAY
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_SEFOLD(JI,1)= 365.* XDAY
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_SEFOLD(JI,1)= 365.* XDAY
+ IF (NVT_FLTR>0) THEN
+ IF (DTV%XPAR_VEGTYPE(JI,NVT_FLTR)>0.) ZDATA_SEFOLD(JI,1) = 365.*XDAY
+ ENDIF
+ IF (NVT_C3>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_C3 )>0. ) ZDATA_SEFOLD(JI,2)= 60.* XDAY
+ ENDIF
+ IF (NVT_C3W>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_C3W )>0. ) ZDATA_SEFOLD(JI,2)= 60.* XDAY
+ ENDIF
+ IF (NVT_C3S>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_C3S )>0. ) ZDATA_SEFOLD(JI,2)= 60.* XDAY
+ ENDIF
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_C4 )>0. ) ZDATA_SEFOLD(JI,2)= 60.* XDAY
+ IF (NVT_IRR>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_IRR )>0. ) ZDATA_SEFOLD(JI,2)= 60.* XDAY
+ ENDIF
+ IF (DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) .GT. 0.) &
+ DTV%XPAR_SEFOLD(JI,1) = ( ZDATA_SEFOLD(JI,1)*DTV%XPAR_FRAC_HVEG(JI) &
+ + ZDATA_SEFOLD(JI,2)*DTV%XPAR_FRAC_LVEG(JI) ) &
+ / ( DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) )
!
! Minimum LAI (m2/m2)
ZDATA_LAIMIN (JI,:) = 0.3
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_LAIMIN(JI,1)= 1.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_LAIMIN(JI,1)= 1.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_LAIMIN(JI,1)= 1.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_LAIMIN(JI,1)= 1.0
- IF (DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) .GT. 0.) &
- DTGD%XDATA_LAIMIN(JI) = ( ZDATA_LAIMIN(JI,1)*DTGD%XDATA_FRAC_HVEG(JI) &
- + ZDATA_LAIMIN(JI,2)*DTGD%XDATA_FRAC_LVEG(JI) ) &
- / ( DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) )
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_LAIMIN(JI,1)= 1.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_LAIMIN(JI,1)= 1.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_LAIMIN(JI,1)= 1.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_LAIMIN(JI,1)= 1.0
+ IF (DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) .GT. 0.) &
+ DTV%XPAR_LAIMIN(JI,1) = ( ZDATA_LAIMIN(JI,1)*DTV%XPAR_FRAC_HVEG(JI) &
+ + ZDATA_LAIMIN(JI,2)*DTV%XPAR_FRAC_LVEG(JI) ) &
+ / ( DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) )
!
! Leaf aera ratio sensitivity to nitrogen concentration
ZDATA_CE_NITRO(JI,:)=7.68
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_CE_NITRO(JI,1)= 4.83
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_CE_NITRO(JI,1)= 4.83
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_CE_NITRO(JI,1)= 4.83
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_CE_NITRO(JI,1)= 4.83
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_CE_NITRO(JI,1)= 4.83
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_CE_NITRO(JI,1)= 4.85
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_CE_NITRO(JI,1)= 4.85
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_CE_NITRO(JI,1)= 4.85
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_CE_NITRO(JI,1)= 4.83
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_C3 )>0. ) ZDATA_CE_NITRO(JI,2)= 3.79
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_GRAS)>0. ) ZDATA_CE_NITRO(JI,2)= 5.56
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOGR)>0. ) ZDATA_CE_NITRO(JI,2)= 5.56
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_PARK)>0. ) ZDATA_CE_NITRO(JI,2)= 5.56
- IF (DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) .GT. 0.) &
- DTGD%XDATA_CE_NITRO(JI) = ( ZDATA_CE_NITRO(JI,1)*DTGD%XDATA_FRAC_HVEG(JI) &
- + ZDATA_CE_NITRO(JI,2)*DTGD%XDATA_FRAC_LVEG(JI) ) &
- / ( DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) )
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_CE_NITRO(JI,1)= 4.83
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_CE_NITRO(JI,1)= 4.83
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_CE_NITRO(JI,1)= 4.83
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_CE_NITRO(JI,1)= 4.83
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_CE_NITRO(JI,1)= 4.83
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_CE_NITRO(JI,1)= 4.85
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_CE_NITRO(JI,1)= 4.85
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_CE_NITRO(JI,1)= 4.85
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_CE_NITRO(JI,1)= 4.83
+ IF (NVT_FLTR>0) THEN
+ IF (DTV%XPAR_VEGTYPE(JI,NVT_FLTR)>0.) ZDATA_CE_NITRO(JI,1) = 4.83
+ ENDIF
+ IF (NVT_C3>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_C3 )>0. ) ZDATA_CE_NITRO(JI,2)= 3.79
+ ENDIF
+ IF (NVT_C3W>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_C3W )>0. ) ZDATA_CE_NITRO(JI,2)= 3.79
+ ENDIF
+ IF (NVT_C3S>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_C3S )>0. ) ZDATA_CE_NITRO(JI,2)= 3.79
+ ENDIF
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) ZDATA_CE_NITRO(JI,2)= 5.56
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOGR)>0. ) ZDATA_CE_NITRO(JI,2)= 5.56
+ IF (NVT_PARK>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_PARK)>0. ) ZDATA_CE_NITRO(JI,2)= 5.56
+ ELSEIF (NVT_FLGR>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_FLGR)>0. ) ZDATA_CE_NITRO(JI,2)= 5.56
+ ENDIF
+ IF (DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) .GT. 0.) &
+ DTV%XPAR_CE_NITRO(JI,1) = ( ZDATA_CE_NITRO(JI,1)*DTV%XPAR_FRAC_HVEG(JI) &
+ + ZDATA_CE_NITRO(JI,2)*DTV%XPAR_FRAC_LVEG(JI) ) &
+ / ( DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) )
!
! Lethal minimum value of leaf area ratio
ZDATA_CF_NITRO(JI,:)=-4.33
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_CF_NITRO(JI,1)= 2.53
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_CF_NITRO(JI,1)= 2.53
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_CF_NITRO(JI,1)= 2.53
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_CF_NITRO(JI,1)= 2.53
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_CF_NITRO(JI,1)= 2.53
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_CF_NITRO(JI,1)= -0.24
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_CF_NITRO(JI,1)= -0.24
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_CF_NITRO(JI,1)= -0.24
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_CF_NITRO(JI,1)= 0.12
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_C3 )>0. ) ZDATA_CF_NITRO(JI,2)= 9.84
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_GRAS)>0. ) ZDATA_CF_NITRO(JI,2)= 6.73
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOGR)>0. ) ZDATA_CF_NITRO(JI,2)= 6.73
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_PARK)>0. ) ZDATA_CF_NITRO(JI,2)= 6.73
- IF (DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) .GT. 0.) &
- DTGD%XDATA_CF_NITRO(JI) = ( ZDATA_CF_NITRO(JI,1)*DTGD%XDATA_FRAC_HVEG(JI) &
- + ZDATA_CF_NITRO(JI,2)*DTGD%XDATA_FRAC_LVEG(JI) ) &
- / ( DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) )
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_CF_NITRO(JI,1)= 2.53
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_CF_NITRO(JI,1)= 2.53
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_CF_NITRO(JI,1)= 2.53
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_CF_NITRO(JI,1)= 2.53
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_CF_NITRO(JI,1)= 2.53
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_CF_NITRO(JI,1)= -0.24
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_CF_NITRO(JI,1)= -0.24
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_CF_NITRO(JI,1)= -0.24
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_CF_NITRO(JI,1)= 0.12
+ IF (NVT_FLTR>0) THEN
+ IF (DTV%XPAR_VEGTYPE(JI,NVT_FLTR)>0.) ZDATA_CF_NITRO(JI,1) = 2.53
+ ENDIF
+ IF (NVT_C3>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_C3 )>0. ) ZDATA_CF_NITRO(JI,2)= 9.84
+ ENDIF
+ IF (NVT_C3W>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_C3W )>0. ) ZDATA_CF_NITRO(JI,2)= 9.84
+ ENDIF
+ IF (NVT_C3S>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_C3S )>0. ) ZDATA_CF_NITRO(JI,2)= 9.84
+ ENDIF
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) ZDATA_CF_NITRO(JI,2)= 6.73
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOGR)>0. ) ZDATA_CF_NITRO(JI,2)= 6.73
+ IF (NVT_PARK>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_PARK)>0. ) ZDATA_CF_NITRO(JI,2)= 6.73
+ ELSEIF (NVT_FLGR>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_FLGR)>0. ) ZDATA_CF_NITRO(JI,2)= 6.73
+ ENDIF
+ IF (DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) .GT. 0.) &
+ DTV%XPAR_CF_NITRO(JI,1) = ( ZDATA_CF_NITRO(JI,1)*DTV%XPAR_FRAC_HVEG(JI) &
+ + ZDATA_CF_NITRO(JI,2)*DTV%XPAR_FRAC_LVEG(JI) ) &
+ / ( DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) )
!
! Nitrogen concentration of active biomass
ZDATA_CNA_NITRO(JI,:)=1.3
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_CNA_NITRO(JI,1)= 2.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_CNA_NITRO(JI,1)= 2.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_CNA_NITRO(JI,1)= 2.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_CNA_NITRO(JI,1)= 2.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_CNA_NITRO(JI,1)= 2.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_CNA_NITRO(JI,1)= 2.8
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_CNA_NITRO(JI,1)= 2.8
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_CNA_NITRO(JI,1)= 2.8
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_CNA_NITRO(JI,1)= 1.7
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_C4 )>0. ) ZDATA_CNA_NITRO(JI,2)= 1.9
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_IRR )>0. ) ZDATA_CNA_NITRO(JI,2)= 1.9
- IF (DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) .GT. 0.) &
- DTGD%XDATA_CNA_NITRO(JI) = ( ZDATA_CNA_NITRO(JI,1)*DTGD%XDATA_FRAC_HVEG(JI) &
- + ZDATA_CNA_NITRO(JI,2)*DTGD%XDATA_FRAC_LVEG(JI) ) &
- / ( DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) )
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_CNA_NITRO(JI,1)= 2.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_CNA_NITRO(JI,1)= 2.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_CNA_NITRO(JI,1)= 2.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_CNA_NITRO(JI,1)= 2.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_CNA_NITRO(JI,1)= 2.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_CNA_NITRO(JI,1)= 2.8
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_CNA_NITRO(JI,1)= 2.8
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_CNA_NITRO(JI,1)= 2.8
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_CNA_NITRO(JI,1)= 1.7
+ IF (NVT_FLTR>0) THEN
+ IF (DTV%XPAR_VEGTYPE(JI,NVT_FLTR)>0.) ZDATA_CNA_NITRO(JI,1) = 2.0
+ ENDIF
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_C4 )>0. ) ZDATA_CNA_NITRO(JI,2)= 1.9
+ IF (NVT_IRR>0) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_IRR )>0. ) ZDATA_CNA_NITRO(JI,2)= 1.9
+ ENDIF
+ IF (DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) .GT. 0.) &
+ DTV%XPAR_CNA_NITRO(JI,1) = ( ZDATA_CNA_NITRO(JI,1)*DTV%XPAR_FRAC_HVEG(JI) &
+ + ZDATA_CNA_NITRO(JI,2)*DTV%XPAR_FRAC_LVEG(JI) ) &
+ / ( DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) )
!
! Ground layers
- IF (TGDO%NGROUND_LAYER<=3) THEN
+ IF (IO%NGROUND_LAYER<=3) THEN
ZDATA_DG(JI,1,:) = 0.01
ZDATA_DG(JI,2,:) = 1.50
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_DG(JI,2,1)= 2.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_DG(JI,2,1)= 2.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_DG(JI,2,1)= 2.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_DG(JI,2,1)= 2.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_DG(JI,2,1)= 2.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_DG(JI,2,1)= 2.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_DG(JI,2,1)= 2.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_DG(JI,2,1)= 2.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_DG(JI,2,1)= 2.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_NO )>0. ) ZDATA_DG(JI,2,3)= 0.5
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_ROCK)>0. ) ZDATA_DG(JI,2,3)= 0.5
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_SNOW)>0. ) ZDATA_DG(JI,2,3)= 0.5
- IF (TGDO%NGROUND_LAYER==3) THEN
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_DG(JI,2,1)= 2.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_DG(JI,2,1)= 2.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_DG(JI,2,1)= 2.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_DG(JI,2,1)= 2.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_DG(JI,2,1)= 2.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_DG(JI,2,1)= 2.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_DG(JI,2,1)= 2.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_DG(JI,2,1)= 2.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_DG(JI,2,1)= 2.0
+ IF (NVT_FLTR>0) THEN
+ IF (DTV%XPAR_VEGTYPE(JI,NVT_FLTR)>0.) ZDATA_DG(JI,2,1) = 2.0
+ ENDIF
+ !
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_NO )>0. ) ZDATA_DG(JI,2,3)= 0.5
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_ROCK)>0. ) ZDATA_DG(JI,2,3)= 0.5
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_SNOW)>0. ) ZDATA_DG(JI,2,3)= 0.5
+ !
+ IF (IO%NGROUND_LAYER==3) THEN
ZDATA_DG(JI,3,:) = 2.00
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_DG(JI,3,1)= 3.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_DG(JI,3,1)= 3.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_DG(JI,3,1)= 3.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_DG(JI,3,1)= 3.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_DG(JI,3,1)= 3.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_DG(JI,3,1)= 3.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_DG(JI,3,1)= 3.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_DG(JI,3,1)= 3.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_DG(JI,3,1)= 3.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_NO )>0. ) ZDATA_DG(JI,3,3)= 1.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_ROCK)>0. ) ZDATA_DG(JI,3,3)= 1.0
- IF(DTGD%XDATA_VEGTYPE(JI,NVT_SNOW)>0. ) ZDATA_DG(JI,3,3)= 1.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBD)>0. ) ZDATA_DG(JI,3,1)= 3.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBD)>0. ) ZDATA_DG(JI,3,1)= 3.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TEBE)>0. ) ZDATA_DG(JI,3,1)= 3.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOBD)>0. ) ZDATA_DG(JI,3,1)= 3.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_SHRB)>0. ) ZDATA_DG(JI,3,1)= 3.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BONE)>0. ) ZDATA_DG(JI,3,1)= 3.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TENE)>0. ) ZDATA_DG(JI,3,1)= 3.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_BOND)>0. ) ZDATA_DG(JI,3,1)= 3.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TRBE)>0. ) ZDATA_DG(JI,3,1)= 3.0
+ IF (NVT_FLTR>0) THEN
+ IF (DTV%XPAR_VEGTYPE(JI,NVT_FLTR)>0.) ZDATA_DG(JI,3,1) = 3.0
+ ENDIF
+ !
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_NO )>0. ) ZDATA_DG(JI,3,3)= 1.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_ROCK)>0. ) ZDATA_DG(JI,3,3)= 1.0
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_SNOW)>0. ) ZDATA_DG(JI,3,3)= 1.0
ENDIF
- DTGD%XDATA_DG(JI,:) = ZDATA_DG(JI,:,1)*DTGD%XDATA_FRAC_HVEG(JI) &
- + ZDATA_DG(JI,:,2)*DTGD%XDATA_FRAC_LVEG(JI) &
- + ZDATA_DG(JI,:,3)*DTGD%XDATA_FRAC_NVEG(JI)
- ELSEIF (TGDO%NGROUND_LAYER<=NOPTIMLAYER) THEN
- DTGD%XDATA_DG(JI,:) = XOPTIMGRID(:)
+ DTV%XPAR_DG(JI,:,1) = ZDATA_DG(JI,:,1)*DTV%XPAR_FRAC_HVEG(JI) &
+ + ZDATA_DG(JI,:,2)*DTV%XPAR_FRAC_LVEG(JI) &
+ + ZDATA_DG(JI,:,3)*DTV%XPAR_FRAC_NVEG(JI)
+ ELSEIF (IO%NGROUND_LAYER<=NOPTIMLAYER) THEN
+ DTV%XPAR_DG(JI,:,1) = XOPTIMGRID(:)
ELSE
CALL ABOR1_SFX("READ_PGD_TEB_GARDEN_PAR: WITH MORE THAN 14 SOIL LAYERS, "//&
"WITHOUT ECOCLIMAP, GARDEN CANNOT RUN")
ENDIF
!
! Root fractions
- DTGD%XDATA_ROOTFRAC(JI,TGDO%NGROUND_LAYER) = 1.
- DTGD%XDATA_ROOTFRAC(JI,1) = 0.20
- IF (TGDO%NGROUND_LAYER>2) THEN
- DO JLAYER = TGDO%NGROUND_LAYER-1,2,-1
- DTGD%XDATA_ROOTFRAC(JI,JLAYER) = DTGD%XDATA_ROOTFRAC(JI,JLAYER+1)-0.8/(TGDO%NGROUND_LAYER-1)
+ DTV%XPAR_ROOTFRAC(JI,IO%NGROUND_LAYER,1) = 1.
+ DTV%XPAR_ROOTFRAC(JI,1,1) = 0.20
+ IF (IO%NGROUND_LAYER>2) THEN
+ DO JLAYER = IO%NGROUND_LAYER-1,2,-1
+ DTV%XPAR_ROOTFRAC(JI,JLAYER,1) = DTV%XPAR_ROOTFRAC(JI,JLAYER+1,1)-0.8/(IO%NGROUND_LAYER-1)
ENDDO
ENDIF
!
- DTGD%XDATA_DICE(JI) = DTGD%XDATA_DG(JI,2)
+ DTV%XPAR_DICE(JI,1) = DTV%XPAR_DG(JI,2,1)
!
- DO JTIME=1,DTGD%NTIME
+ DO JTIME=1,DTV%NTIME
! Leaf Area Index
- IF (DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI) .GT. 0.) &
- DTGD%XDATA_LAI (JI,JTIME) = ( DTGD%XDATA_LAI_HVEG(JI,JTIME)*DTGD%XDATA_FRAC_HVEG(JI) &
- + DTGD%XDATA_LAI_LVEG(JI,JTIME)*DTGD%XDATA_FRAC_LVEG(JI)) &
- /( DTGD%XDATA_FRAC_HVEG(JI)+DTGD%XDATA_FRAC_LVEG(JI))
+ IF (DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI) .GT. 0.) &
+ DTV%XPAR_LAI (JI,JTIME,1) = ( DTV%XPAR_LAI_HVEG(JI,JTIME)*DTV%XPAR_FRAC_HVEG(JI) &
+ + DTV%XPAR_LAI_LVEG(JI,JTIME)*DTV%XPAR_FRAC_LVEG(JI)) &
+ /( DTV%XPAR_FRAC_HVEG(JI)+DTV%XPAR_FRAC_LVEG(JI))
! Fraction of vegetation
- DTGD%XDATA_VEG (JI,JTIME) = VEG_FROM_LAI (DTGD%XDATA_LAI (JI,JTIME), &
- DTGD%XDATA_VEGTYPE(JI,:),GAGRI_TO_GRASS)
+ DTV%XPAR_VEG (JI,JTIME,1) = VEG_FROM_LAI (DTV%XPAR_LAI (JI,JTIME,1), &
+ DTV%XPAR_VEGTYPE(JI,:),GAGRI_TO_GRASS)
! Roughness length for momentum
- DTGD%XDATA_Z0 (JI,JTIME) = Z0V_FROM_LAI (DTGD%XDATA_LAI (JI,JTIME), &
- DTGD%XDATA_H_TREE (JI), &
- DTGD%XDATA_VEGTYPE(JI,:),GAGRI_TO_GRASS)
+ DTV%XPAR_Z0 (JI,JTIME,1) = Z0V_FROM_LAI (DTV%XPAR_LAI (JI,JTIME,1), &
+ DTV%XPAR_H_TREE (JI,1), &
+ DTV%XPAR_VEGTYPE(JI,:),GAGRI_TO_GRASS)
! Emissivity
- DTGD%XDATA_EMIS (JI,JTIME) = EMIS_FROM_VEG (DTGD%XDATA_VEG (JI,JTIME), &
- DTGD%XDATA_VEGTYPE(JI,:))
+ DTV%XPAR_EMIS (JI,JTIME,1) = EMIS_FROM_VEG (DTV%XPAR_VEG (JI,JTIME,1), &
+ DTV%XPAR_VEGTYPE(JI,:))
END DO
!
ENDDO
diff --git a/src/SURFEX/read_pgd_teb_gardenn.F90 b/src/SURFEX/read_pgd_teb_gardenn.F90
index 3c0537fbe864179851988fd733a7f099df766977..9fe56f1e05e8e96feb773696e66828de36a819e5 100644
--- a/src/SURFEX/read_pgd_teb_gardenn.F90
+++ b/src/SURFEX/read_pgd_teb_gardenn.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_PGD_TEB_GARDEN_n (CHT, DTCO, DTGD, GBGD, U, TGDO, TGDP, TG, TOP, &
- HPROGRAM,KVERSION,KBUGFIX)
+ SUBROUTINE READ_PGD_TEB_GARDEN_n (OCH_BIO_FLUX, DTCO, DTV, GB, U, &
+ IO, K, KDIM, TOP, HPROGRAM,KVERSION,KBUGFIX)
! #########################################
!
!!**** *READ_PGD_TEB_GARDEN_n* - routine to initialise ISBA physiographic variables
@@ -40,18 +40,16 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
!
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t
!
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t
!
-USE MODD_CH_TEB_n, ONLY : CH_TEB_t
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DATA_TEB_GARDEN_n, ONLY : DATA_TEB_GARDEN_t
-USE MODD_GR_BIOG_GARDEN_n, ONLY : GR_BIOG_GARDEN_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_TEB_GARDEN_OPTION_n, ONLY : TEB_GARDEN_OPTIONS_t
-USE MODD_TEB_GARDEN_PGD_n, ONLY : TEB_GARDEN_PGD_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -70,15 +68,15 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
+LOGICAL, INTENT(IN) :: OCH_BIO_FLUX
!
-TYPE(CH_TEB_t), INTENT(INOUT) :: CHT
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DATA_TEB_GARDEN_t), INTENT(INOUT) :: DTGD
-TYPE(GR_BIOG_GARDEN_t), INTENT(INOUT) :: GBGD
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+TYPE(GR_BIOG_t), INTENT(INOUT) :: GB
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(TEB_GARDEN_OPTIONS_t), INTENT(INOUT) :: TGDO
-TYPE(TEB_GARDEN_PGD_t), INTENT(INOUT) :: TGDP
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+INTEGER, INTENT(INOUT) :: KDIM
TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
@@ -101,70 +99,59 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('READ_PGD_TEB_GARDEN_N',0,ZHOOK_HANDLE)
YRECFM='SIZE_TOWN'
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'TOWN ',TG%NDIM)
+ CALL GET_TYPE_DIM_n(DTCO, U, 'TOWN ',KDIM)
!
!
!* clay fraction : attention, seul un niveau est present dans le fichier
!* on rempli tout les niveaux de XCLAY avec les valeurs du fichiers
!
-ALLOCATE(TGDP%XCLAY(TG%NDIM,TGDO%NGROUND_LAYER))
YRECFM='TWN_CLAY'
IF (KVERSION>7 .OR. KVERSION==7 .AND. KBUGFIX>=3) YRECFM='GD_CLAY'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TGDP%XCLAY(:,1),IRESP)
-DO JLAYER=2,TGDO%NGROUND_LAYER
- TGDP%XCLAY(:,JLAYER)=TGDP%XCLAY(:,1)
+ CALL READ_SURF(HPROGRAM,YRECFM,K%XCLAY(:,1),IRESP)
+DO JLAYER=2,IO%NGROUND_LAYER
+ K%XCLAY(:,JLAYER)=K%XCLAY(:,1)
END DO
!
!* sand fraction
!
-ALLOCATE(TGDP%XSAND(TG%NDIM,TGDO%NGROUND_LAYER))
YRECFM='TWN_SAND'
IF (KVERSION>7 .OR. KVERSION==7 .AND. KBUGFIX>=3) YRECFM='GD_SAND'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TGDP%XSAND(:,1),IRESP)
-DO JLAYER=2,TGDO%NGROUND_LAYER
- TGDP%XSAND(:,JLAYER)=TGDP%XSAND(:,1)
+ CALL READ_SURF(HPROGRAM,YRECFM,K%XSAND(:,1),IRESP)
+DO JLAYER=2,IO%NGROUND_LAYER
+ K%XSAND(:,JLAYER)=K%XSAND(:,1)
END DO
!
!* orographic runoff coefficient
!
-ALLOCATE(TGDP%XRUNOFFB(TG%NDIM))
YRECFM='TWN_RUNOFFB'
IF (KVERSION>7 .OR. KVERSION==7 .AND. KBUGFIX>=3) YRECFM='GD_RUNOFFB'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TGDP%XRUNOFFB,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,K%XRUNOFFB,IRESP)
!
!* subgrid drainage coefficient
!
-ALLOCATE(TGDP%XWDRAIN(TG%NDIM))
IF (KVERSION<=3) THEN
- TGDP%XWDRAIN = 0.
+ K%XWDRAIN = 0.
ELSE
YRECFM='TWN_WDRAIN'
IF (KVERSION>7 .OR. KVERSION==7 .AND. KBUGFIX>=3) YRECFM='GD_WDRAIN'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TGDP%XWDRAIN,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,K%XWDRAIN,IRESP)
ENDIF
!
!-------------------------------------------------------------------------------
!
!* biogenic chemical emissions
!
-IF (CHT%LCH_BIO_FLUX) THEN
- ALLOCATE(GBGD%XISOPOT(TG%NDIM))
+IF (OCH_BIO_FLUX) THEN
+ ALLOCATE(GB%XISOPOT(KDIM))
YRECFM='E_ISOPOT'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,GBGD%XISOPOT,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,GB%XISOPOT,IRESP)
!
- ALLOCATE(GBGD%XMONOPOT(TG%NDIM))
+ ALLOCATE(GB%XMONOPOT(KDIM))
YRECFM='E_MONOPOT'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,GBGD%XMONOPOT,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,GB%XMONOPOT,IRESP)
ELSE
- ALLOCATE(GBGD%XISOPOT (0))
- ALLOCATE(GBGD%XMONOPOT(0))
+ ALLOCATE(GB%XISOPOT (0))
+ ALLOCATE(GB%XMONOPOT(0))
END IF
!
!-------------------------------------------------------------------------------
@@ -174,17 +161,52 @@ END IF
!
IF (KVERSION>=7) THEN
YRECFM='PAR_GARDEN'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TGDO%LPAR_GARDEN,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%LPAR,IRESP)
ELSEIF (.NOT.TOP%LECOCLIMAP) THEN
- TGDO%LPAR_GARDEN = .TRUE.
+ IO%LPAR = .TRUE.
ELSE
- TGDO%LPAR_GARDEN = .FALSE.
+ IO%LPAR = .FALSE.
ENDIF
!
-IF (TGDO%LPAR_GARDEN) CALL READ_PGD_TEB_GARDEN_PAR_n(&
- DTGD, TGDO, TGDP, TG, &
- HPROGRAM)
+IO%LECOCLIMAP = (.NOT. IO%LPAR)
+!
+ALLOCATE(DTV%LDATA_LAI (1))
+ALLOCATE(DTV%LDATA_VEG (1))
+ALLOCATE(DTV%LDATA_Z0 (1))
+ALLOCATE(DTV%LDATA_EMIS (1))
+ALLOCATE(DTV%LDATA_ALBNIR_VEG (1))
+ALLOCATE(DTV%LDATA_ALBVIS_VEG (1))
+ALLOCATE(DTV%LDATA_ALBUV_VEG (1))
+ALLOCATE(DTV%LDATA_ALBNIR_SOIL(1))
+ALLOCATE(DTV%LDATA_ALBVIS_SOIL(1))
+ALLOCATE(DTV%LDATA_ALBUV_SOIL (1))
+!
+IF (.NOT.IO%LPAR) THEN
+ DTV%LDATA_LAI = .FALSE.
+ DTV%LDATA_VEG = .FALSE.
+ DTV%LDATA_Z0 = .FALSE.
+ DTV%LDATA_EMIS = .FALSE.
+ DTV%LDATA_ALBNIR_VEG = .FALSE.
+ DTV%LDATA_ALBVIS_VEG = .FALSE.
+ DTV%LDATA_ALBUV_VEG = .FALSE.
+ DTV%LDATA_ALBNIR_SOIL= .FALSE.
+ DTV%LDATA_ALBVIS_SOIL= .FALSE.
+ DTV%LDATA_ALBUV_SOIL = .FALSE.
+ELSE
+ DTV%LDATA_LAI = .TRUE.
+ DTV%LDATA_VEG = .TRUE.
+ DTV%LDATA_Z0 = .TRUE.
+ DTV%LDATA_EMIS = .TRUE.
+ DTV%LDATA_ALBNIR_VEG = .TRUE.
+ DTV%LDATA_ALBVIS_VEG = .TRUE.
+ DTV%LDATA_ALBUV_VEG = .TRUE.
+ DTV%LDATA_ALBNIR_SOIL= .TRUE.
+ DTV%LDATA_ALBVIS_SOIL= .TRUE.
+ DTV%LDATA_ALBUV_SOIL = .TRUE.
+ENDIF
+!
+IF (IO%LPAR) CALL READ_PGD_TEB_GARDEN_PAR_n(DTV, IO, KDIM, HPROGRAM)
+!
IF (LHOOK) CALL DR_HOOK('READ_PGD_TEB_GARDEN_N',1,ZHOOK_HANDLE)
!
!
diff --git a/src/SURFEX/read_pgd_teb_greenroof_parn.F90 b/src/SURFEX/read_pgd_teb_greenroof_parn.F90
index 5fd5e0e074604a1e59fb38737ff279d052a76b80..0e5b7c6c095ec3336d1f82e7c7065aa86cfe0958 100644
--- a/src/SURFEX/read_pgd_teb_greenroof_parn.F90
+++ b/src/SURFEX/read_pgd_teb_greenroof_parn.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_PGD_TEB_GREENROOF_PAR_n (&
- DTGR, TGRO, TG, &
- HPROGRAM)
+ SUBROUTINE READ_PGD_TEB_GREENROOF_PAR_n (DTV, IO, S, K, KDIM, HPROGRAM)
! ################################################
!
!!**** *READ_PGD_TEB_GREENROOF_PAR_n* - reads ISBA physiographic fields
@@ -46,9 +44,9 @@
!
!
!
-USE MODD_DATA_TEB_GREENROOF_n, ONLY : DATA_TEB_GREENROOF_t
-USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t
!
USE MODD_CSTS, ONLY : XDAY
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -60,9 +58,6 @@ USE MODI_READ_SURF
USE MODI_VEG_FROM_LAI
USE MODI_Z0V_FROM_LAI
USE MODI_EMIS_FROM_VEG
-USE MODI_DRY_WET_SOIL_ALBEDOS
-USE MODI_SOIL_ALBEDO
-!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -72,12 +67,11 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-!
-!
-TYPE(DATA_TEB_GREENROOF_t), INTENT(INOUT) :: DTGR
-TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: TGRO
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+INTEGER, INTENT(IN) :: KDIM
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
!
@@ -91,9 +85,6 @@ INTEGER :: JI ! loop index
INTEGER :: JTIME ! loop index
INTEGER :: JLAYER ! loop index
!
-REAL, DIMENSION(TG%NDIM) :: ZDATA_WG1
-REAL, DIMENSION(TG%NDIM) :: ZDATA_WGSAT
-!
LOGICAL :: GAGRI_TO_GRASS
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -108,51 +99,42 @@ IF (LHOOK) CALL DR_HOOK('READ_PGD_TEB_GREENROOF_PAR_N',0,ZHOOK_HANDLE)
GAGRI_TO_GRASS=.FALSE.
!
YRECFM='GR_NTIME'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TGRO%NTIME_GR,IRESP)
-!
-YRECFM='GR_LAYER'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TGRO%NLAYER_GR,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTV%NTIME,IRESP)
!
! Read type of green roof
YRECFM='D_TYPE_GR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TGRO%CTYP_GR,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IO%CTYP_COV,IRESP)
+!
+DTV%LIMP_VEG=.FALSE.
+DTV%LIMP_Z0=.FALSE.
+DTV%LIMP_EMIS=.FALSE.
!
! Read green roof OM fraction
-ALLOCATE(DTGR%XPAR_OM_GR (TG%NDIM,TGRO%NLAYER_GR))
-DO JLAYER=1,TGRO%NLAYER_GR
+DO JLAYER=1,IO%NGROUND_LAYER
!WRITE(YRECFM,FMT='(A8,I1.1)') 'D_OM_GR0',JLAYER
WRITE(YRECFM,FMT='(A7,I2.2)') 'D_OM_GR',JLAYER
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTGR%XPAR_OM_GR(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XSOC(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
END DO
!
! Read green roof SAND fraction
-ALLOCATE(DTGR%XPAR_SAND_GR (TG%NDIM,TGRO%NLAYER_GR))
-DO JLAYER=1,TGRO%NLAYER_GR
+DO JLAYER=1,IO%NGROUND_LAYER
!WRITE(YRECFM,FMT='(A10,I1.1)') 'D_SAND_GR0',JLAYER
WRITE(YRECFM,FMT='(A9,I2.2)') 'D_SAND_GR',JLAYER
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTGR%XPAR_SAND_GR(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,K%XSAND(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
END DO
!
! Read green roof CLAY fraction
-ALLOCATE(DTGR%XPAR_CLAY_GR (TG%NDIM,TGRO%NLAYER_GR))
-DO JLAYER=1,TGRO%NLAYER_GR
+DO JLAYER=1,IO%NGROUND_LAYER
!WRITE(YRECFM,FMT='(A10,I1.1)') 'D_CLAY_GR0',JLAYER
WRITE(YRECFM,FMT='(A9,I2.2)') 'D_CLAY_GR',JLAYER
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTGR%XPAR_CLAY_GR(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,K%XCLAY(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
END DO
!
! Read green roof LAI
-ALLOCATE(DTGR%XPAR_LAI_GR (TG%NDIM,TGRO%NTIME_GR))
-DO JTIME=1,TGRO%NTIME_GR
+ALLOCATE(DTV%XPAR_LAI (KDIM,DTV%NTIME,1))
+DO JTIME=1,DTV%NTIME
WRITE(YRECFM,FMT='(A8,I2.2)') 'D_LAI_GR',JTIME
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTGR%XPAR_LAI_GR(:,JTIME),IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTV%XPAR_LAI(:,JTIME,1),IRESP,HCOMMENT=YCOMMENT)
END DO
!
!
@@ -161,85 +143,71 @@ END DO
!* 2. Definition of ISBA parameters
! -----------------------------
!
-ALLOCATE(DTGR%XPAR_LAI (TG%NDIM,TGRO%NTIME_GR))
-ALLOCATE(DTGR%XPAR_VEG (TG%NDIM,TGRO%NTIME_GR))
-ALLOCATE(DTGR%XPAR_RSMIN (TG%NDIM))
-ALLOCATE(DTGR%XPAR_GAMMA (TG%NDIM))
-ALLOCATE(DTGR%XPAR_WRMAX_CF (TG%NDIM))
-ALLOCATE(DTGR%XPAR_RGL (TG%NDIM))
-ALLOCATE(DTGR%XPAR_CV (TG%NDIM))
-ALLOCATE(DTGR%XPAR_DG (TG%NDIM,TGRO%NLAYER_GR))
-ALLOCATE(DTGR%XPAR_ROOTFRAC (TG%NDIM,TGRO%NLAYER_GR))
-ALLOCATE(DTGR%XPAR_DICE (TG%NDIM))
-ALLOCATE(DTGR%XPAR_Z0 (TG%NDIM,TGRO%NTIME_GR))
-ALLOCATE(DTGR%XPAR_Z0_O_Z0H (TG%NDIM))
-ALLOCATE(DTGR%XPAR_ALBNIR_VEG (TG%NDIM))
-ALLOCATE(DTGR%XPAR_ALBVIS_VEG (TG%NDIM))
-ALLOCATE(DTGR%XPAR_ALBUV_VEG (TG%NDIM))
-ALLOCATE(DTGR%XPAR_ALBNIR_SOIL(TG%NDIM))
-ALLOCATE(DTGR%XPAR_ALBVIS_SOIL(TG%NDIM))
-ALLOCATE(DTGR%XPAR_ALBUV_SOIL (TG%NDIM))
-ALLOCATE(DTGR%XPAR_ALBNIR_DRY (TG%NDIM))
-ALLOCATE(DTGR%XPAR_ALBVIS_DRY (TG%NDIM))
-ALLOCATE(DTGR%XPAR_ALBUV_DRY (TG%NDIM))
-ALLOCATE(DTGR%XPAR_ALBNIR_WET (TG%NDIM))
-ALLOCATE(DTGR%XPAR_ALBVIS_WET (TG%NDIM))
-ALLOCATE(DTGR%XPAR_ALBUV_WET (TG%NDIM))
-ALLOCATE(DTGR%XPAR_EMIS (TG%NDIM,TGRO%NTIME_GR))
-ALLOCATE(DTGR%XPAR_VEGTYPE (TG%NDIM,NVEGTYPE))
-ALLOCATE(DTGR%XPAR_GMES (TG%NDIM))
-ALLOCATE(DTGR%XPAR_RE25 (TG%NDIM))
-ALLOCATE(DTGR%XPAR_BSLAI (TG%NDIM))
-ALLOCATE(DTGR%XPAR_LAIMIN (TG%NDIM))
-ALLOCATE(DTGR%XPAR_SEFOLD (TG%NDIM))
-ALLOCATE(DTGR%XPAR_GC (TG%NDIM))
-ALLOCATE(DTGR%XPAR_DMAX (TG%NDIM))
-ALLOCATE(DTGR%XPAR_F2I (TG%NDIM))
-ALLOCATE(DTGR%LDATA_STRESS (TG%NDIM))
-ALLOCATE(DTGR%XPAR_H_TREE (TG%NDIM))
-ALLOCATE(DTGR%XPAR_CE_NITRO (TG%NDIM))
-ALLOCATE(DTGR%XPAR_CF_NITRO (TG%NDIM))
-ALLOCATE(DTGR%XPAR_CNA_NITRO (TG%NDIM))
-!
-DTGR%XPAR_LAI (:,:) = XUNDEF
-DTGR%XPAR_VEG (:,:) = XUNDEF
-DTGR%XPAR_RSMIN (:) = XUNDEF
-DTGR%XPAR_GAMMA (:) = XUNDEF
-DTGR%XPAR_WRMAX_CF (:) = XUNDEF
-DTGR%XPAR_RGL (:) = XUNDEF
-DTGR%XPAR_CV (:) = XUNDEF
-DTGR%XPAR_DG (:,:) = XUNDEF
-DTGR%XPAR_DICE (:) = XUNDEF
-DTGR%XPAR_ROOTFRAC (:,:) = XUNDEF
-DTGR%XPAR_Z0 (:,:) = XUNDEF
-DTGR%XPAR_Z0_O_Z0H (:) = XUNDEF
-DTGR%XPAR_ALBNIR_VEG (:) = XUNDEF
-DTGR%XPAR_ALBVIS_VEG (:) = XUNDEF
-DTGR%XPAR_ALBUV_VEG (:) = XUNDEF
-DTGR%XPAR_ALBNIR_SOIL (:) = XUNDEF
-DTGR%XPAR_ALBVIS_SOIL (:) = XUNDEF
-DTGR%XPAR_ALBUV_SOIL (:) = XUNDEF
-DTGR%XPAR_ALBNIR_DRY (:) = XUNDEF
-DTGR%XPAR_ALBVIS_DRY (:) = XUNDEF
-DTGR%XPAR_ALBUV_DRY (:) = XUNDEF
-DTGR%XPAR_ALBNIR_WET (:) = XUNDEF
-DTGR%XPAR_ALBVIS_WET (:) = XUNDEF
-DTGR%XPAR_ALBUV_WET (:) = XUNDEF
-DTGR%XPAR_EMIS (:,:) = XUNDEF
-DTGR%XPAR_VEGTYPE (:,:) = XUNDEF
-DTGR%XPAR_GMES (:) = XUNDEF
-DTGR%XPAR_RE25 (:) = XUNDEF
-DTGR%XPAR_BSLAI (:) = XUNDEF
-DTGR%XPAR_LAIMIN (:) = XUNDEF
-DTGR%XPAR_SEFOLD (:) = XUNDEF
-DTGR%XPAR_GC (:) = XUNDEF
-DTGR%XPAR_DMAX (:) = XUNDEF
-DTGR%XPAR_F2I (:) = XUNDEF
-DTGR%LDATA_STRESS (:) = .FALSE.
-DTGR%XPAR_H_TREE (:) = XUNDEF
-DTGR%XPAR_CE_NITRO (:) = XUNDEF
-DTGR%XPAR_CF_NITRO (:) = XUNDEF
-DTGR%XPAR_CNA_NITRO (:) = XUNDEF
+ALLOCATE(DTV%XPAR_VEG (KDIM,DTV%NTIME,1))
+ALLOCATE(DTV%XPAR_RSMIN (KDIM,1))
+ALLOCATE(DTV%XPAR_GAMMA (KDIM,1))
+ALLOCATE(DTV%XPAR_WRMAX_CF (KDIM,1))
+ALLOCATE(DTV%XPAR_RGL (KDIM,1))
+ALLOCATE(DTV%XPAR_CV (KDIM,1))
+ALLOCATE(DTV%XPAR_DG (KDIM,IO%NGROUND_LAYER,1))
+ALLOCATE(DTV%XPAR_ROOTFRAC (KDIM,IO%NGROUND_LAYER,1))
+ALLOCATE(DTV%XPAR_DICE (KDIM,1))
+ALLOCATE(DTV%XPAR_Z0 (KDIM,DTV%NTIME,1))
+ALLOCATE(DTV%XPAR_Z0_O_Z0H (KDIM,1))
+ALLOCATE(DTV%XPAR_ALBNIR_VEG (KDIM,1,1))
+ALLOCATE(DTV%XPAR_ALBVIS_VEG (KDIM,1,1))
+ALLOCATE(DTV%XPAR_ALBUV_VEG (KDIM,1,1))
+ALLOCATE(DTV%XPAR_ALBNIR_SOIL(KDIM,1,1))
+ALLOCATE(DTV%XPAR_ALBVIS_SOIL(KDIM,1,1))
+ALLOCATE(DTV%XPAR_ALBUV_SOIL (KDIM,1,1))
+ALLOCATE(DTV%XPAR_EMIS (KDIM,DTV%NTIME,1))
+ALLOCATE(DTV%XPAR_VEGTYPE (KDIM,NVEGTYPE))
+ALLOCATE(DTV%XPAR_GMES (KDIM,1))
+ALLOCATE(DTV%XPAR_RE25 (KDIM,1))
+ALLOCATE(DTV%XPAR_BSLAI (KDIM,1))
+ALLOCATE(DTV%XPAR_LAIMIN (KDIM,1))
+ALLOCATE(DTV%XPAR_SEFOLD (KDIM,1))
+ALLOCATE(DTV%XPAR_GC (KDIM,1))
+ALLOCATE(DTV%XPAR_DMAX (KDIM,1))
+ALLOCATE(DTV%XPAR_F2I (KDIM,1))
+ALLOCATE(DTV%LPAR_STRESS (KDIM,1))
+ALLOCATE(DTV%XPAR_H_TREE (KDIM,1))
+ALLOCATE(DTV%XPAR_CE_NITRO (KDIM,1))
+ALLOCATE(DTV%XPAR_CF_NITRO (KDIM,1))
+ALLOCATE(DTV%XPAR_CNA_NITRO (KDIM,1))
+!
+DTV%XPAR_VEG (:,:,:) = XUNDEF
+DTV%XPAR_RSMIN (:,:) = XUNDEF
+DTV%XPAR_GAMMA (:,:) = XUNDEF
+DTV%XPAR_WRMAX_CF (:,:) = XUNDEF
+DTV%XPAR_RGL (:,:) = XUNDEF
+DTV%XPAR_CV (:,:) = XUNDEF
+DTV%XPAR_DG (:,:,:) = XUNDEF
+DTV%XPAR_DICE (:,:) = XUNDEF
+DTV%XPAR_ROOTFRAC (:,:,:) = XUNDEF
+DTV%XPAR_Z0 (:,:,:) = XUNDEF
+DTV%XPAR_Z0_O_Z0H (:,:) = XUNDEF
+DTV%XPAR_ALBNIR_VEG (:,:,:) = XUNDEF
+DTV%XPAR_ALBVIS_VEG (:,:,:) = XUNDEF
+DTV%XPAR_ALBUV_VEG (:,:,:) = XUNDEF
+DTV%XPAR_ALBNIR_SOIL (:,:,:) = XUNDEF
+DTV%XPAR_ALBVIS_SOIL (:,:,:) = XUNDEF
+DTV%XPAR_ALBUV_SOIL (:,:,:) = XUNDEF
+DTV%XPAR_EMIS (:,:,:) = XUNDEF
+DTV%XPAR_VEGTYPE (:,:) = XUNDEF
+DTV%XPAR_GMES (:,:) = XUNDEF
+DTV%XPAR_RE25 (:,:) = XUNDEF
+DTV%XPAR_BSLAI (:,:) = XUNDEF
+DTV%XPAR_LAIMIN (:,:) = XUNDEF
+DTV%XPAR_SEFOLD (:,:) = XUNDEF
+DTV%XPAR_GC (:,:) = XUNDEF
+DTV%XPAR_DMAX (:,:) = XUNDEF
+DTV%XPAR_F2I (:,:) = XUNDEF
+DTV%LPAR_STRESS (:,:) = .FALSE.
+DTV%XPAR_H_TREE (:,:) = XUNDEF
+DTV%XPAR_CE_NITRO (:,:) = XUNDEF
+DTV%XPAR_CF_NITRO (:,:) = XUNDEF
+DTV%XPAR_CNA_NITRO (:,:) = XUNDEF
!
!---------------------------------------------------------------------------
! Vegtypes adapted to greenroofs:
@@ -253,161 +221,144 @@ DTGR%XPAR_CNA_NITRO (:) = XUNDEF
! NB2: Functions existing for gardens are used for initial greenroofs
! This will need to be refined specifically for greenroofs
!
-DTGR%XPAR_VEGTYPE(:,:) = 0.
-IF (TGRO%CTYP_GR == 'GRASS') DTGR%XPAR_VEGTYPE(:, NVT_GRAS) = 1.
-IF (TGRO%CTYP_GR == 'SEDUM') DTGR%XPAR_VEGTYPE(:, NVT_TROG) = 1.
+DTV%XPAR_VEGTYPE(:,:) = 0.
+IF (IO%CTYP_COV == 'GRASS') DTV%XPAR_VEGTYPE(:, NVT_GRAS) = 1.
+IF (IO%CTYP_COV == 'SEDUM') DTV%XPAR_VEGTYPE(:, NVT_TROG) = 1.
!--------------------------------------------------------------------------
!
-! Dry/Wet soil albedos: (* Will need to account for XOM_GR eventually *)
-!CALL DRY_WET_SOIL_ALBEDOS_1D(XSAND_GR(:,1),XCLAY_GR(:,1), &
- CALL DRY_WET_SOIL_ALBEDOS_1D(DTGR%XPAR_SAND_GR(:,1),DTGR%XPAR_CLAY_GR(:,1), &
- DTGR%XPAR_VEGTYPE, &
- DTGR%XPAR_ALBNIR_DRY,DTGR%XPAR_ALBVIS_DRY,DTGR%XPAR_ALBUV_DRY, &
- DTGR%XPAR_ALBNIR_WET,DTGR%XPAR_ALBVIS_WET,DTGR%XPAR_ALBUV_WET )
-!
! Critical normilized soil water content for stress parameterisation
-DTGR%XPAR_F2I(:) = 0.3
+DTV%XPAR_F2I(:,:) = 0.3
!
! Ratio between roughness length for momentum and heat
-DTGR%XPAR_Z0_O_Z0H(:) = 10.
+DTV%XPAR_Z0_O_Z0H(:,:) = 10.
!
! Defensive/offensive strategy (1/0)
-DTGR%LDATA_STRESS(:) = .FALSE.
+DTV%LPAR_STRESS(:,:) = .FALSE.
!
-DO JI=1,TG%NDIM
+DO JI=1,KDIM
!
! Vegetation albedo: near-IR, visible, and UV albedo
! * Will need to be adapted to greenroof GRASS and SEDUM species *
! * vérifier si/où l'abedo ds l'UV est utilisé *
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTGR%XPAR_ALBNIR_VEG(JI)= 0.3
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTGR%XPAR_ALBNIR_VEG(JI)= 0.154 ! mesures ONERA/Doya (2011)
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTV%XPAR_ALBNIR_VEG(JI,:,:)= 0.3
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTV%XPAR_ALBNIR_VEG(JI,:,:)= 0.154 ! mesures ONERA/Doya (2011)
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTGR%XPAR_ALBVIS_VEG(JI)= 0.10
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTGR%XPAR_ALBVIS_VEG(JI)= 0.154 ! mesures ONERA/Doya (2011)
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTV%XPAR_ALBVIS_VEG(JI,:,:)= 0.10
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTV%XPAR_ALBVIS_VEG(JI,:,:)= 0.154 ! mesures ONERA/Doya (2011)
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTGR%XPAR_ALBUV_VEG(JI) = 0.0800
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTGR%XPAR_ALBUV_VEG(JI) = 0.1250
-!
-! Soil albedo (* Will need to be refined for greenroofs - cf OM fraction *)
- ZDATA_WGSAT(:) = 0.
- ZDATA_WG1 (:) = 0.
- CALL SOIL_ALBEDO('DRY', &
- ZDATA_WGSAT, ZDATA_WG1, &
- DTGR%XPAR_ALBVIS_DRY, DTGR%XPAR_ALBNIR_DRY, DTGR%XPAR_ALBUV_DRY, &
- DTGR%XPAR_ALBVIS_WET, DTGR%XPAR_ALBNIR_WET, DTGR%XPAR_ALBUV_WET, &
- DTGR%XPAR_ALBVIS_SOIL,DTGR%XPAR_ALBNIR_SOIL,DTGR%XPAR_ALBUV_SOIL )
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTV%XPAR_ALBUV_VEG(JI,:,:) = 0.0800
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTV%XPAR_ALBUV_VEG(JI,:,:) = 0.1250
!
! Min stomatal resistance
!IF(XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) XPAR_RSMIN(JI)= 40 (dans isba & garden)
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTGR%XPAR_RSMIN(JI)= 120 ! for GRASS
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTGR%XPAR_RSMIN(JI)= 150. ! for SEDUM
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTV%XPAR_RSMIN(JI,:)= 120 ! for GRASS
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTV%XPAR_RSMIN(JI,:)= 150. ! for SEDUM
!IF(XPAR_VEGTYPE(JI,NVT_TROG)>0. ) XPAR_RSMIN(JI)= 120.
!
! Gamma parameter
! (* Check if values needs to be refined for GRASS and SEDUM *)
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTGR%XPAR_GAMMA(JI)= 0.
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTGR%XPAR_GAMMA(JI)= 0.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTV%XPAR_GAMMA(JI,:)= 0.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTV%XPAR_GAMMA(JI,:)= 0.
!
! Wrmax_cf
! (* Check if needs to be refined for GRASS and SEDUM greenroofs *)
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTGR%XPAR_WRMAX_CF(JI)= 0.2
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTGR%XPAR_WRMAX_CF(JI)= 0.2
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTV%XPAR_WRMAX_CF(JI,:)= 0.2
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTV%XPAR_WRMAX_CF(JI,:)= 0.2
!
! Rgl
! (* Check if needs to be refined for GRASS and SEDUM greenroofs *)
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTGR%XPAR_RGL(JI)= 100.
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTGR%XPAR_RGL(JI)= 100.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTV%XPAR_RGL(JI,:)= 100.
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTV%XPAR_RGL(JI,:)= 100.
!
! Cv
! (* Check if needs to be refined for GRASS and SEDUM greenroofs *)
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTGR%XPAR_CV(JI)= 2.E-5
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTGR%XPAR_CV(JI)= 2.E-5
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTV%XPAR_CV(JI,:)= 2.E-5
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTV%XPAR_CV(JI,:)= 2.E-5
!
!! Mesophyll conductance (m s-1)
! (* Check if needs to be refined for GRASS and SEDUM greenroofs *)
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTGR%XPAR_GMES(JI)= 0.020
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTGR%XPAR_GMES(JI)= 0.020
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTV%XPAR_GMES(JI,:)= 0.020
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTV%XPAR_GMES(JI,:)= 0.020
!IF(XPAR_VEGTYPE(JI,NVT_TROG)>0. ) XPAR_GMES(JI)= 0.003
!
! Ecosystem Respiration (kg/kg.m.s-1)
! (* Check if needs to be refined for GRASS and SEDUM greenroofs *)
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTGR%XPAR_RE25(JI)= 3.0E-7
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_TROG )>0.) DTGR%XPAR_RE25(JI)= 3.0E-7
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTV%XPAR_RE25(JI,:)= 3.0E-7
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG )>0.) DTV%XPAR_RE25(JI,:)= 3.0E-7
!
! Cuticular conductance (m s-1)
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTGR%XPAR_GC(JI)= 0.00025
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTGR%XPAR_GC(JI)= 0.00025
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTV%XPAR_GC(JI,:)= 0.00025
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTV%XPAR_GC(JI,:)= 0.00025
!
! Ratio d(biomass)/d(lai) (kg/m2)
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTGR%XPAR_BSLAI(JI)= 0.36
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTGR%XPAR_BSLAI(JI)= 0.06
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTV%XPAR_BSLAI(JI,:)= 0.36
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTV%XPAR_BSLAI(JI,:)= 0.06
!
! Maximum air saturation deficit tolerate by vegetation (kg/kg)
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTGR%XPAR_DMAX(JI)= 0.1
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTGR%XPAR_DMAX(JI)= 0.1
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTV%XPAR_DMAX(JI,:)= 0.1
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTV%XPAR_DMAX(JI,:)= 0.1
!
! e-folding time for senescence (days)
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTGR%XPAR_SEFOLD(JI)= 90.* XDAY
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTGR%XPAR_SEFOLD(JI)= 60.* XDAY
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTV%XPAR_SEFOLD(JI,:)= 90.* XDAY
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTV%XPAR_SEFOLD(JI,:)= 60.* XDAY
!
! Minimum LAI (m2/m2)
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTGR%XPAR_LAIMIN (JI) = 0.3
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTGR%XPAR_LAIMIN (JI) = 0.3
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTV%XPAR_LAIMIN (JI,:) = 0.3
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTV%XPAR_LAIMIN (JI,:) = 0.3
!
! Leaf aera ratio sensitivity to nitrogen concentration
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTGR%XPAR_CE_NITRO(JI)= 5.56
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTGR%XPAR_CE_NITRO(JI)= 3.79
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTV%XPAR_CE_NITRO(JI,:)= 5.56
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTV%XPAR_CE_NITRO(JI,:)= 3.79
!
! Lethal minimum value of leaf area ratio
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTGR%XPAR_CF_NITRO(JI)= 6.73
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTGR%XPAR_CF_NITRO(JI)= 9.84
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTV%XPAR_CF_NITRO(JI,:)= 6.73
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTV%XPAR_CF_NITRO(JI,:)= 9.84
!
! Nitrogen concentration of active biomass
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTGR%XPAR_CNA_NITRO(JI)= 1.9
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_TROG )>0.) DTGR%XPAR_CNA_NITRO(JI)= 1.3
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTV%XPAR_CNA_NITRO(JI,:)= 1.9
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG )>0.) DTV%XPAR_CNA_NITRO(JI,:)= 1.3
!
! Depth of greenroof ground layers
- DTGR%XPAR_DG(JI, 1) = XGRID_SOIL(NGRID_LEVEL - 5)
- DTGR%XPAR_DG(JI, 2) = XGRID_SOIL(NGRID_LEVEL - 4)
- DTGR%XPAR_DG(JI, 3) = XGRID_SOIL(NGRID_LEVEL - 3)
- DTGR%XPAR_DG(JI, 4) = XGRID_SOIL(NGRID_LEVEL - 2)
- DTGR%XPAR_DG(JI, 5) = XGRID_SOIL(NGRID_LEVEL - 1)
- DTGR%XPAR_DG(JI, 6) = XGRID_SOIL(NGRID_LEVEL - 0)
+ DTV%XPAR_DG(JI, 1,:) = XGRID_SOIL(NGRID_LEVEL - 5)
+ DTV%XPAR_DG(JI, 2,:) = XGRID_SOIL(NGRID_LEVEL - 4)
+ DTV%XPAR_DG(JI, 3,:) = XGRID_SOIL(NGRID_LEVEL - 3)
+ DTV%XPAR_DG(JI, 4,:) = XGRID_SOIL(NGRID_LEVEL - 2)
+ DTV%XPAR_DG(JI, 5,:) = XGRID_SOIL(NGRID_LEVEL - 1)
+ DTV%XPAR_DG(JI, 6,:) = XGRID_SOIL(NGRID_LEVEL - 0)
!
! Root fractions
- DTGR%XPAR_ROOTFRAC(JI, 1) = 0.04
- DTGR%XPAR_ROOTFRAC(JI, 2) = 0.36
- DTGR%XPAR_ROOTFRAC(JI, 3) = 0.68
- DTGR%XPAR_ROOTFRAC(JI, 4) = 1.
- DTGR%XPAR_ROOTFRAC(JI, 5) = 1.
- DTGR%XPAR_ROOTFRAC(JI, 6) = 1.
+ DTV%XPAR_ROOTFRAC(JI, 1,:) = 0.04
+ DTV%XPAR_ROOTFRAC(JI, 2,:) = 0.36
+ DTV%XPAR_ROOTFRAC(JI, 3,:) = 0.68
+ DTV%XPAR_ROOTFRAC(JI, 4,:) = 1.
+ DTV%XPAR_ROOTFRAC(JI, 5,:) = 1.
+ DTV%XPAR_ROOTFRAC(JI, 6,:) = 1.
!
! Depth of the soil column for the calculation of the frozen soil fraction (m)
- DTGR%XPAR_DICE(JI) = DTGR%XPAR_DG(JI,1)
+ DTV%XPAR_DICE(JI,:) = DTV%XPAR_DG(JI,1,:)
!
-DO JTIME=1,TGRO%NTIME_GR
+DO JTIME=1,DTV%NTIME
! Leaf Area Index
- DTGR%XPAR_LAI(JI,JTIME) = DTGR%XPAR_LAI_GR(JI,JTIME)
! Fraction of vegetation on greenroof
!* Will need to be refined for greenroofs *)
!XPAR_VEG (JI,1,JTIME) = VEG_FROM_LAI (XPAR_LAI_GR(JI,JTIME), &
! XPAR_VEGTYPE(JI,:),GAGRI_TO_GRASS)
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTGR%XPAR_VEG (JI,JTIME) = 0.9
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTV%XPAR_VEG (JI,JTIME,:) = 0.9
!IF(XPAR_VEGTYPE(JI,NVT_TROG)>0. ) XPAR_VEG (JI,JTIME) = 1.0
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTGR%XPAR_VEG (JI,JTIME) = 0.95
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTV%XPAR_VEG (JI,JTIME,:) = 0.95
! Roughness length for momentum
!* Will need to be refined for greenroofs *)
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTGR%XPAR_Z0 (JI,JTIME) = 0.01
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTGR%XPAR_Z0 (JI,JTIME) = 0.01
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTV%XPAR_Z0 (JI,JTIME,:) = 0.01
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTV%XPAR_Z0 (JI,JTIME,:) = 0.01
!
! Emissivity
!* Will need to be refined for greenroofs *)
!XPAR_EMIS (JI,1,JTIME) = EMIS_FROM_VEG (XPAR_VEG (JI,1,JTIME),&
! XPAR_VEGTYPE(JI,:))
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTGR%XPAR_EMIS (JI,JTIME) = 0.95
- IF(DTGR%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTGR%XPAR_EMIS (JI,JTIME) = 0.83 ! Feng. et al. (2010)
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_GRAS)>0. ) DTV%XPAR_EMIS (JI,JTIME,:) = 0.95
+ IF(DTV%XPAR_VEGTYPE(JI,NVT_TROG)>0. ) DTV%XPAR_EMIS (JI,JTIME,:) = 0.83 ! Feng. et al. (2010)
END DO
!
diff --git a/src/SURFEX/read_pgd_teb_greenroofn.F90 b/src/SURFEX/read_pgd_teb_greenroofn.F90
index 58d61c51a2206b0bf9ab7317f0b52e02b6bf0ddb..9aaba367345966b8b3ac33677503f693c19bbb79 100644
--- a/src/SURFEX/read_pgd_teb_greenroofn.F90
+++ b/src/SURFEX/read_pgd_teb_greenroofn.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_PGD_TEB_GREENROOF_n (CHT, DTCO, DTGR, GBGR, U, TGRO, TGRP, TG, &
- HPROGRAM,KVERSION)
+ SUBROUTINE READ_PGD_TEB_GREENROOF_n (OCH_BIO_FLUX, DTCO, DTV, GB, U, &
+ IO, S, K, KDIM, HPROGRAM,KVERSION)
! #########################################
!
!!**** *READ_PGD_TEB_GREENROOF_n* - routine to initialise ISBA physiographic variables
@@ -42,14 +42,13 @@
!
!
!
-USE MODD_CH_TEB_n, ONLY : CH_TEB_t
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DATA_TEB_GREENROOF_n, ONLY : DATA_TEB_GREENROOF_t
-USE MODD_GR_BIOG_GREENROOF_n, ONLY : GR_BIOG_GREENROOF_t
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
-USE MODD_TEB_GREENROOF_PGD_n, ONLY : TEB_GREENROOF_PGD_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
+!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_S_t
!
USE MODD_ISBA_PAR, ONLY : XOPTIMGRID
!
@@ -69,14 +68,15 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(CH_TEB_t), INTENT(INOUT) :: CHT
+LOGICAL, INTENT(IN) :: OCH_BIO_FLUX
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DATA_TEB_GREENROOF_t), INTENT(INOUT) :: DTGR
-TYPE(GR_BIOG_GREENROOF_t), INTENT(INOUT) :: GBGR
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+TYPE(GR_BIOG_t), INTENT(INOUT) :: GB
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: TGRO
-TYPE(TEB_GREENROOF_PGD_t), INTENT(INOUT) :: TGRP
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+INTEGER, INTENT(INOUT) :: KDIM
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
INTEGER, INTENT(IN) :: KVERSION ! version of SURFEX of the file being read
@@ -98,59 +98,40 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('READ_PGD_TEB_GREENROOF_N',0,ZHOOK_HANDLE)
YRECFM='SIZE_TOWN'
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'TOWN ',TG%NDIM)
-!
-!
-!* 2. Initialisation of ISBA options for greenroofs
-! ---------------------------------------------
-!
+ CALL GET_TYPE_DIM_n(DTCO, U, 'TOWN ',KDIM)
!
-YRECFM='GR_ISBA'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TGRO%CISBA_GR,IRESP)
-!
-YRECFM='GR_SCOND'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TGRO%CSCOND_GR,IRESP)
!
!* 3. Physiographic data fields:
! -------------------------
!
!* orographic runoff coefficient
!
-ALLOCATE(TGRP%XRUNOFFB_GR(TG%NDIM))
YRECFM='GR_RUNOFFB'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TGRP%XRUNOFFB_GR,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,K%XRUNOFFB,IRESP)
!
!* subgrid drainage coefficient
!
-ALLOCATE(TGRP%XWDRAIN_GR(TG%NDIM))
IF (KVERSION<=6) THEN
- TGRP%XWDRAIN_GR = 0.
+ K%XWDRAIN = 0.
ELSE
YRECFM='GR_WDRAIN'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TGRP%XWDRAIN_GR,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,K%XWDRAIN,IRESP)
ENDIF
!
!-------------------------------------------------------------------------------
!* biogenic chemical emissions
!
-IF (CHT%LCH_BIO_FLUX) THEN
- ALLOCATE(GBGR%XISOPOT(TG%NDIM))
+IF (OCH_BIO_FLUX) THEN
+ ALLOCATE(GB%XISOPOT(KDIM))
YRECFM='E_ISOPOT'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,GBGR%XISOPOT,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,GB%XISOPOT,IRESP)
!
- ALLOCATE(GBGR%XMONOPOT(TG%NDIM))
+ ALLOCATE(GB%XMONOPOT(KDIM))
YRECFM='E_MONOPOT'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,GBGR%XMONOPOT,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,GB%XMONOPOT,IRESP)
ELSE
- ALLOCATE(GBGR%XISOPOT (0))
- ALLOCATE(GBGR%XMONOPOT(0))
+ ALLOCATE(GB%XISOPOT (0))
+ ALLOCATE(GB%XMONOPOT(0))
END IF
!
!-------------------------------------------------------------------------------
@@ -167,9 +148,11 @@ END IF
!
!IF (LPAR_GREENROOF) CALL READ_PGD_TEB_GREENROOF_PAR_n(HPROGRAM)
!
- CALL READ_PGD_TEB_GREENROOF_PAR_n(&
- DTGR, TGRO, TG, &
- HPROGRAM)
+IO%LPAR = .TRUE.
+!
+IO%LECOCLIMAP = (.NOT. IO%LPAR)
+!
+ CALL READ_PGD_TEB_GREENROOF_PAR_n(DTV, IO, S, K, KDIM, HPROGRAM)
!
IF (LHOOK) CALL DR_HOOK('READ_PGD_TEB_GREENROOF_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/read_pgd_teb_irrign.F90 b/src/SURFEX/read_pgd_teb_irrign.F90
index f81dc5f24892dc0afb553a381d07e799892f4427..6a6e8c1cbd2c286d3819875d3d1fea06dd185c97 100644
--- a/src/SURFEX/read_pgd_teb_irrign.F90
+++ b/src/SURFEX/read_pgd_teb_irrign.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_PGD_TEB_IRRIG_n (&
- TG, TIR, &
- HPROGRAM)
+ SUBROUTINE READ_PGD_TEB_IRRIG_n (G, TIR, HPROGRAM)
! ################################################
!
!!**** *READ_PGD_TEB_IRRIG_n* - reads ISBA physiographic fields
@@ -45,7 +43,7 @@
!
!
!
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_TEB_IRRIG_n, ONLY : TEB_IRRIG_t
!
USE MODI_READ_SURF
@@ -63,7 +61,7 @@ IMPLICIT NONE
!
!
!
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
+TYPE(GRID_t), INTENT(INOUT) :: G
TYPE(TEB_IRRIG_t), INTENT(INOUT) :: TIR
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
@@ -79,7 +77,7 @@ INTEGER :: JLAYER ! loop index
!
INTEGER :: IVERSION ! surface version
INTEGER :: IBUGFIX ! surface bugfix version
-REAL, DIMENSION(TG%NDIM) :: ZWORK ! work array
+REAL, DIMENSION(G%NDIM) :: ZWORK ! work array
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
@@ -88,11 +86,9 @@ IF (LHOOK) CALL DR_HOOK('READ_PGD_TEB_IRRIG_N',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
YRECFM='BUG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IBUGFIX,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
!
IF (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<=3)) THEN
!
@@ -103,44 +99,36 @@ IF (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<=3)) THEN
ELSE
!
YRECFM='L_PAR_GD_IRR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TIR%LPAR_GD_IRRIG,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,TIR%LPAR_GD_IRRIG,IRESP)
YRECFM='L_PAR_GR_IRR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TIR%LPAR_GR_IRRIG,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,TIR%LPAR_GR_IRRIG,IRESP)
YRECFM='L_PAR_RD_IRR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TIR%LPAR_RD_IRRIG,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,TIR%LPAR_RD_IRRIG,IRESP)
!
ENDIF
!
!* read garden irrigation
!
IF (TIR%LPAR_GD_IRRIG) THEN
- ALLOCATE(TIR%XGD_START_MONTH(TG%NDIM))
+ ALLOCATE(TIR%XGD_START_MONTH(G%NDIM))
YRECFM='D_GD_SM_IRR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TIR%XGD_START_MONTH(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,TIR%XGD_START_MONTH(:),IRESP,HCOMMENT=YCOMMENT)
!
- ALLOCATE(TIR%XGD_END_MONTH (TG%NDIM))
+ ALLOCATE(TIR%XGD_END_MONTH (G%NDIM))
YRECFM='D_GD_EM_IRR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TIR%XGD_END_MONTH (:),IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,TIR%XGD_END_MONTH (:),IRESP,HCOMMENT=YCOMMENT)
!
- ALLOCATE(TIR%XGD_START_HOUR (TG%NDIM))
+ ALLOCATE(TIR%XGD_START_HOUR (G%NDIM))
YRECFM='D_GD_SH_IRR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TIR%XGD_START_HOUR (:),IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,TIR%XGD_START_HOUR (:),IRESP,HCOMMENT=YCOMMENT)
!
- ALLOCATE(TIR%XGD_END_HOUR (TG%NDIM))
+ ALLOCATE(TIR%XGD_END_HOUR (G%NDIM))
YRECFM='D_GD_EH_IRR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TIR%XGD_END_HOUR (:),IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,TIR%XGD_END_HOUR (:),IRESP,HCOMMENT=YCOMMENT)
!
- ALLOCATE(TIR%XGD_24H_IRRIG (TG%NDIM))
+ ALLOCATE(TIR%XGD_24H_IRRIG (G%NDIM))
YRECFM='D_GD_IRRIG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TIR%XGD_24H_IRRIG (:),IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,TIR%XGD_24H_IRRIG (:),IRESP,HCOMMENT=YCOMMENT)
ELSE
ALLOCATE(TIR%XGD_START_MONTH(0))
ALLOCATE(TIR%XGD_END_MONTH (0))
@@ -152,30 +140,25 @@ END IF
!* read greenroof irrigation
!
IF (TIR%LPAR_GR_IRRIG) THEN
- ALLOCATE(TIR%XGR_START_MONTH(TG%NDIM))
+ ALLOCATE(TIR%XGR_START_MONTH(G%NDIM))
YRECFM='D_GR_SM_IRR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TIR%XGR_START_MONTH(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,TIR%XGR_START_MONTH(:),IRESP,HCOMMENT=YCOMMENT)
!
- ALLOCATE(TIR%XGR_END_MONTH (TG%NDIM))
+ ALLOCATE(TIR%XGR_END_MONTH (G%NDIM))
YRECFM='D_GR_EM_IRR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TIR%XGR_END_MONTH (:),IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,TIR%XGR_END_MONTH (:),IRESP,HCOMMENT=YCOMMENT)
!
- ALLOCATE(TIR%XGR_START_HOUR (TG%NDIM))
+ ALLOCATE(TIR%XGR_START_HOUR (G%NDIM))
YRECFM='D_GR_SH_IRR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TIR%XGR_START_HOUR (:),IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,TIR%XGR_START_HOUR (:),IRESP,HCOMMENT=YCOMMENT)
!
- ALLOCATE(TIR%XGR_END_HOUR (TG%NDIM))
+ ALLOCATE(TIR%XGR_END_HOUR (G%NDIM))
YRECFM='D_GR_EH_IRR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TIR%XGR_END_HOUR (:),IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,TIR%XGR_END_HOUR (:),IRESP,HCOMMENT=YCOMMENT)
!
- ALLOCATE(TIR%XGR_24H_IRRIG (TG%NDIM))
+ ALLOCATE(TIR%XGR_24H_IRRIG (G%NDIM))
YRECFM='D_GR_IRRIG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TIR%XGR_24H_IRRIG (:),IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,TIR%XGR_24H_IRRIG (:),IRESP,HCOMMENT=YCOMMENT)
ELSE
ALLOCATE(TIR%XGR_START_MONTH(0))
ALLOCATE(TIR%XGR_END_MONTH (0))
@@ -187,30 +170,25 @@ END IF
!* read road watering
!
IF (TIR%LPAR_RD_IRRIG) THEN
- ALLOCATE(TIR%XRD_START_MONTH(TG%NDIM))
+ ALLOCATE(TIR%XRD_START_MONTH(G%NDIM))
YRECFM='D_RD_SM_IRR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TIR%XRD_START_MONTH(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,TIR%XRD_START_MONTH(:),IRESP,HCOMMENT=YCOMMENT)
!
- ALLOCATE(TIR%XRD_END_MONTH (TG%NDIM))
+ ALLOCATE(TIR%XRD_END_MONTH (G%NDIM))
YRECFM='D_RD_EM_IRR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TIR%XRD_END_MONTH (:),IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,TIR%XRD_END_MONTH (:),IRESP,HCOMMENT=YCOMMENT)
!
- ALLOCATE(TIR%XRD_START_HOUR (TG%NDIM))
+ ALLOCATE(TIR%XRD_START_HOUR (G%NDIM))
YRECFM='D_RD_SH_IRR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TIR%XRD_START_HOUR (:),IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,TIR%XRD_START_HOUR (:),IRESP,HCOMMENT=YCOMMENT)
!
- ALLOCATE(TIR%XRD_END_HOUR (TG%NDIM))
+ ALLOCATE(TIR%XRD_END_HOUR (G%NDIM))
YRECFM='D_RD_EH_IRR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TIR%XRD_END_HOUR (:),IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,TIR%XRD_END_HOUR (:),IRESP,HCOMMENT=YCOMMENT)
!
- ALLOCATE(TIR%XRD_24H_IRRIG (TG%NDIM))
+ ALLOCATE(TIR%XRD_24H_IRRIG (G%NDIM))
YRECFM='D_RD_IRRIG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TIR%XRD_24H_IRRIG (:),IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,TIR%XRD_24H_IRRIG (:),IRESP,HCOMMENT=YCOMMENT)
ELSE
ALLOCATE(TIR%XRD_START_MONTH(0))
ALLOCATE(TIR%XRD_END_MONTH (0))
diff --git a/src/SURFEX/read_pgd_teb_parn.F90 b/src/SURFEX/read_pgd_teb_parn.F90
index f8ff1bd9b58051615752c40ecca41bfe831fe172..8d9bde6193cc705779f0a50da5101ae76a3488ef 100644
--- a/src/SURFEX/read_pgd_teb_parn.F90
+++ b/src/SURFEX/read_pgd_teb_parn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_PGD_TEB_PAR_n (DTCO, U,GCP, &
- BDD, DTB, DTT, TG, TOP, &
+ SUBROUTINE READ_PGD_TEB_PAR_n (DTCO, U, GCP, BDD, DTB, DTT, KDIM, TOP, &
HPROGRAM,KNI,HDIRIN)
! ################################################
!
@@ -41,22 +40,14 @@
!* 0. DECLARATIONS
! ------------
!
-!
-
-!
-!
-!
-!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
USE MODD_BLD_DESCRIPTION_n, ONLY : BLD_DESC_t
USE MODD_DATA_BEM_n, ONLY : DATA_BEM_t
USE MODD_DATA_TEB_n, ONLY : DATA_TEB_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
!
USE MODI_READ_SURF
USE MODI_READ_BLD_DESCRIPTION_n
@@ -76,13 +67,13 @@ IMPLICIT NONE
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
TYPE(BLD_DESC_t), INTENT(INOUT) :: BDD
TYPE(DATA_BEM_t), INTENT(INOUT) :: DTB
TYPE(DATA_TEB_t), INTENT(INOUT) :: DTT
-TYPE(TEB_GRID_t), INTENT(INOUT) :: TG
+INTEGER, INTENT(IN) :: KDIM
TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
-TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
INTEGER, INTENT(IN) :: KNI ! size of the new domain
@@ -98,7 +89,7 @@ INTEGER :: JLAYER ! loop index
!
INTEGER :: IVERSION ! surface version
INTEGER :: IBUGFIX ! surface bugfix version
-REAL, DIMENSION(TG%NDIM) :: ZWORK ! work array
+REAL, DIMENSION(KDIM) :: ZWORK ! work array
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
@@ -107,11 +98,9 @@ IF (LHOOK) CALL DR_HOOK('READ_PGD_TEB_PAR_N',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
YRECFM='BUG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IBUGFIX,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
!
IF (IVERSION<7 .AND. .NOT.TOP%LECOCLIMAP) THEN
!
@@ -152,39 +141,30 @@ ELSEIF (IVERSION>=7) THEN
!
IF (IVERSION>7 .OR. IBUGFIX>=3) THEN
YRECFM='L_BLDTYPE'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_BLDTYPE,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_BLDTYPE,IRESP)
YRECFM='L_BLD_AGE'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_BLD_AGE,IRESP)
+ CALL READ_SURF( HPROGRAM,YRECFM,DTT%LDATA_BLD_AGE,IRESP)
YRECFM='L_USETYPE'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_USETYPE,IRESP)
- IF (DTT%LDATA_BLDTYPE .OR. DTT%LDATA_BLD_AGE .OR. DTT%LDATA_USETYPE) CALL READ_BLD_DESCRIPTION_n(&
- BDD, &
- HPROGRAM)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_USETYPE,IRESP)
+ IF (DTT%LDATA_BLDTYPE .OR. DTT%LDATA_BLD_AGE .OR. DTT%LDATA_USETYPE) &
+ CALL READ_BLD_DESCRIPTION_n(BDD, HPROGRAM)
ENDIF
YRECFM='L_Z0_TOWN'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_Z0_TOWN,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_Z0_TOWN,IRESP)
YRECFM='L_BLD'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_BLD,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_BLD,IRESP)
IF (IVERSION>=6) THEN
YRECFM='L_GARDEN'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_GARDEN,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_GARDEN,IRESP)
ENDIF
IF (IVERSION==7 .AND. IBUGFIX<=2) THEN
DTT%LDATA_ROAD_DIR = .FALSE.
DTT%LDATA_GREENROOF= .FALSE.
ELSE
YRECFM='L_ROAD_DIR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_ROAD_DIR,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_ROAD_DIR,IRESP)
YRECFM='L_GREENROOF'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_GREENROOF,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_GREENROOF,IRESP)
END IF
IF (IVERSION==7 .AND. IBUGFIX<=3) THEN
DTT%LDATA_EMIS_PANEL = .FALSE.
@@ -193,180 +173,124 @@ ELSEIF (IVERSION>=7) THEN
DTT%LDATA_FRAC_PANEL = .FALSE.
ELSE
YRECFM='L_EMIS_PANEL'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_EMIS_PANEL,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_EMIS_PANEL,IRESP)
YRECFM='L_ALB_PANEL'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_ALB_PANEL,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_ALB_PANEL,IRESP)
YRECFM='L_EFF_PANEL'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_EFF_PANEL,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_EFF_PANEL,IRESP)
YRECFM='L_FRAC_PANEL'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_FRAC_PANEL,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_FRAC_PANEL,IRESP)
END IF
YRECFM='L_ALB_ROOF'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_ALB_ROOF,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_ALB_ROOF,IRESP)
YRECFM='L_EMIS_ROOF'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_EMIS_ROOF,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_EMIS_ROOF,IRESP)
YRECFM='L_HC_ROOF'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_HC_ROOF,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_HC_ROOF,IRESP)
YRECFM='L_TC_ROOF'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_TC_ROOF,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_TC_ROOF,IRESP)
YRECFM='L_D_ROOF'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_D_ROOF,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_D_ROOF,IRESP)
YRECFM='L_ALB_ROAD'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_ALB_ROAD,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_ALB_ROAD,IRESP)
YRECFM='L_EMIS_ROAD'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_EMIS_ROAD,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_EMIS_ROAD,IRESP)
YRECFM='L_HC_ROAD'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_HC_ROAD,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_HC_ROAD,IRESP)
YRECFM='L_TC_ROAD'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_TC_ROAD,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_TC_ROAD,IRESP)
YRECFM='L_D_ROAD'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_D_ROAD,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_D_ROAD,IRESP)
YRECFM='L_ALB_WALL'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_ALB_WALL,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_ALB_WALL,IRESP)
YRECFM='L_EMIS_WALL'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_EMIS_WALL,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_EMIS_WALL,IRESP)
YRECFM='L_HC_WALL'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_HC_WALL,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_HC_WALL,IRESP)
YRECFM='L_TC_WALL'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_TC_WALL,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_TC_WALL,IRESP)
YRECFM='L_D_WALL'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_D_WALL,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_D_WALL,IRESP)
YRECFM='L_BLD_HEIGHT'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_BLD_HEIGHT,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_BLD_HEIGHT,IRESP)
YRECFM='L_WALL_O_HOR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_WALL_O_HOR,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_WALL_O_HOR,IRESP)
YRECFM='L_H_TRAF'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_H_TRAFFIC,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_H_TRAFFIC,IRESP)
YRECFM='L_LE_TRAF'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_LE_TRAFFIC,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_LE_TRAFFIC,IRESP)
YRECFM='L_H_IND'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_H_INDUSTRY,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_H_INDUSTRY,IRESP)
YRECFM='L_LE_IND'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_LE_INDUSTRY,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_LE_INDUSTRY,IRESP)
IF (IVERSION>7 .OR. IBUGFIX>=3) THEN
YRECFM='L_ROUGH_ROOF'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_ROUGH_ROOF,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_ROUGH_ROOF,IRESP)
YRECFM='L_ROUGH_WALL'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_ROUGH_WALL,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_ROUGH_WALL,IRESP)
ENDIF
IF (IVERSION>7) THEN
YRECFM='L_F_RESIDENT'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%LDATA_RESIDENTIAL,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%LDATA_RESIDENTIAL,IRESP)
ENDIF
!
IF (TOP%CBEM=='BEM') THEN
YRECFM='L_HC_FLOOR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_HC_FLOOR,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_HC_FLOOR,IRESP)
YRECFM='L_TC_FLOOR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_TC_FLOOR,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_TC_FLOOR,IRESP)
YRECFM='L_D_FLOOR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_D_FLOOR,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_D_FLOOR,IRESP)
YRECFM='L_TCOOL_TARG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_TCOOL_TARGET,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_TCOOL_TARGET,IRESP)
YRECFM='L_THEAT_TARG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_THEAT_TARGET,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_THEAT_TARGET,IRESP)
YRECFM='L_F_WAST_CAN'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_F_WASTE_CAN,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_F_WASTE_CAN,IRESP)
YRECFM='L_EFF_HEAT'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_EFF_HEAT,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_EFF_HEAT,IRESP)
YRECFM='L_QIN'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_QIN,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_QIN,IRESP)
YRECFM='L_QIN_FRAD'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_QIN_FRAD,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_QIN_FRAD,IRESP)
YRECFM='L_SHGC'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_SHGC,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_SHGC,IRESP)
YRECFM='L_U_WIN'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_U_WIN,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_U_WIN,IRESP)
YRECFM='L_GR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_GR,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_GR,IRESP)
YRECFM='L_SHGC_SH'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_SHGC_SH,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_SHGC_SH,IRESP)
YRECFM='L_FLOOR_HEIG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_FLOOR_HEIGHT,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_FLOOR_HEIGHT,IRESP)
YRECFM='L_INF'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_INF,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_INF,IRESP)
YRECFM='L_FWAT_COND'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_F_WATER_COND,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_F_WATER_COND,IRESP)
YRECFM='L_SHADE'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_SHADE,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_SHADE,IRESP)
YRECFM='L_NATVENT'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_NATVENT,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_NATVENT,IRESP)
YRECFM='L_V_VENT'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_V_VENT,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_V_VENT,IRESP)
YRECFM='L_QIN_FLAT'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_QIN_FLAT,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_QIN_FLAT,IRESP)
YRECFM='L_HR_TARGET'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_HR_TARGET,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_HR_TARGET,IRESP)
YRECFM='L_CAP_SYS_HE'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_CAP_SYS_HEAT,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_CAP_SYS_HEAT,IRESP)
YRECFM='L_CAP_SYS_RA'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_CAP_SYS_RAT,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_CAP_SYS_RAT,IRESP)
YRECFM='L_T_ADP'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_T_ADP,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_T_ADP,IRESP)
YRECFM='L_M_SYS_RAT'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_M_SYS_RAT,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_M_SYS_RAT,IRESP)
YRECFM='L_COP_RAT'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_COP_RAT,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_COP_RAT,IRESP)
YRECFM='L_T_SIZE_MAX'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_T_SIZE_MAX,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_T_SIZE_MAX,IRESP)
YRECFM='L_T_SIZE_MIN'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%LDATA_T_SIZE_MIN,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%LDATA_T_SIZE_MIN,IRESP)
ENDIF
!
ENDIF
@@ -376,29 +300,25 @@ ENDIF
IF (DTT%LDATA_HC_ROOF) THEN
YRECFM='PAR_RF_LAYER'
IF (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<=2)) YRECFM='ROOF_LAYER'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%NPAR_ROOF_LAYER,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%NPAR_ROOF_LAYER,IRESP)
END IF
!
IF (DTT%LDATA_HC_ROAD) THEN
YRECFM='PAR_RD_LAYER'
IF (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<=2)) YRECFM='ROAD_LAYER'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%NPAR_ROAD_LAYER,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%NPAR_ROAD_LAYER,IRESP)
END IF
!
IF (DTT%LDATA_HC_WALL) THEN
YRECFM='PAR_WL_LAYER'
IF (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<=2)) YRECFM='WALL_LAYER'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTT%NPAR_WALL_LAYER,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTT%NPAR_WALL_LAYER,IRESP)
END IF
!
IF (DTB%LDATA_HC_FLOOR) THEN
YRECFM='PAR_FL_LAYER'
IF (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<=2)) YRECFM='FLOOR_LAYER'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTB%NPAR_FLOOR_LAYER,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTB%NPAR_FLOOR_LAYER,IRESP)
END IF
!
!* read specified fields
@@ -408,46 +328,46 @@ IF (DTT%LDATA_BLDTYPE .AND. .NOT. DTT%LDATA_BLDTYPE) THEN
END IF
!
IF (DTT%LDATA_BLDTYPE) THEN
- ALLOCATE(DTT%NPAR_BLDTYPE (TG%NDIM))
+ ALLOCATE(DTT%NPAR_BLDTYPE (KDIM))
YRECFM='D_BLDTYPE'
CALL READ_FIELD(YRECFM,ZWORK,HDIRIN)
DTT%NPAR_BLDTYPE(:) = NINT(ZWORK)
ENDIF
!
IF (DTT%LDATA_BLD_AGE) THEN
- ALLOCATE(DTT%NPAR_BLD_AGE (TG%NDIM))
+ ALLOCATE(DTT%NPAR_BLD_AGE (KDIM))
YRECFM='D_BLD_AGE'
CALL READ_FIELD(YRECFM,ZWORK,HDIRIN)
DTT%NPAR_BLD_AGE(:) = NINT(ZWORK)
ENDIF
!
IF (DTT%LDATA_BLDTYPE .AND. DTT%LDATA_BLDTYPE) THEN
- ALLOCATE(DTT%NPAR_BLDCODE(TG%NDIM))
+ ALLOCATE(DTT%NPAR_BLDCODE(KDIM))
DTT%NPAR_BLDCODE=BLDCODE(BDD, DTT%NPAR_BLDTYPE,DTT%NPAR_BLD_AGE)
END IF
!
IF (DTT%LDATA_USETYPE) THEN
- ALLOCATE(DTT%NPAR_USETYPE (TG%NDIM))
+ ALLOCATE(DTT%NPAR_USETYPE (KDIM))
YRECFM='D_USETYPE'
CALL READ_FIELD(YRECFM,ZWORK,HDIRIN)
DTT%NPAR_USETYPE(:) = NINT(ZWORK)
ENDIF
!
IF (DTT%LDATA_Z0_TOWN) THEN
- ALLOCATE(DTT%XPAR_Z0_TOWN (TG%NDIM))
+ ALLOCATE(DTT%XPAR_Z0_TOWN (KDIM))
YRECFM='D_Z0_TOWN'
CALL READ_FIELD(YRECFM,DTT%XPAR_Z0_TOWN,HDIRIN)
ENDIF
!
IF (DTT%LDATA_BLD) THEN
- ALLOCATE(DTT%XPAR_BLD (TG%NDIM))
+ ALLOCATE(DTT%XPAR_BLD (KDIM))
YRECFM='D_BLD'
CALL READ_FIELD(YRECFM,DTT%XPAR_BLD,HDIRIN)
ENDIF
!
IF (IVERSION>=6) THEN
IF (DTT%LDATA_GARDEN) THEN
- ALLOCATE(DTT%XPAR_GARDEN (TG%NDIM))
+ ALLOCATE(DTT%XPAR_GARDEN (KDIM))
YRECFM='D_GARDEN'
CALL READ_FIELD(YRECFM,DTT%XPAR_GARDEN,HDIRIN)
ENDIF
@@ -455,31 +375,31 @@ IF (IVERSION>=6) THEN
ENDIF
!
IF (DTT%LDATA_GREENROOF) THEN
- ALLOCATE(DTT%XPAR_GREENROOF (TG%NDIM))
+ ALLOCATE(DTT%XPAR_GREENROOF (KDIM))
YRECFM='D_GREENROOF'
CALL READ_FIELD(YRECFM,DTT%XPAR_GREENROOF,HDIRIN)
ENDIF
!
IF (DTT%LDATA_ROAD_DIR) THEN
- ALLOCATE(DTT%XPAR_ROAD_DIR (TG%NDIM))
+ ALLOCATE(DTT%XPAR_ROAD_DIR (KDIM))
YRECFM='D_ROAD_DIR'
CALL READ_FIELD(YRECFM,DTT%XPAR_ROAD_DIR,HDIRIN)
ENDIF
!
IF (DTT%LDATA_ALB_ROOF) THEN
- ALLOCATE(DTT%XPAR_ALB_ROOF (TG%NDIM))
+ ALLOCATE(DTT%XPAR_ALB_ROOF (KDIM))
YRECFM='D_ALB_ROOF'
CALL READ_FIELD(YRECFM,DTT%XPAR_ALB_ROOF,HDIRIN)
ENDIF
!
IF (DTT%LDATA_EMIS_ROOF) THEN
- ALLOCATE(DTT%XPAR_EMIS_ROOF (TG%NDIM))
+ ALLOCATE(DTT%XPAR_EMIS_ROOF (KDIM))
YRECFM='D_EMI_ROOF'
CALL READ_FIELD(YRECFM,DTT%XPAR_EMIS_ROOF,HDIRIN)
ENDIF
!
IF (DTT%LDATA_HC_ROOF) THEN
- ALLOCATE(DTT%XPAR_HC_ROOF (TG%NDIM,DTT%NPAR_ROOF_LAYER))
+ ALLOCATE(DTT%XPAR_HC_ROOF (KDIM,DTT%NPAR_ROOF_LAYER))
DO JLAYER=1,DTT%NPAR_ROOF_LAYER
WRITE(YRECFM,FMT='(A9,I1.1)') 'D_HC_ROOF',JLAYER
CALL READ_FIELD(YRECFM,DTT%XPAR_HC_ROOF(:,JLAYER),HDIRIN)
@@ -487,7 +407,7 @@ IF (DTT%LDATA_HC_ROOF) THEN
ENDIF
!
IF (DTT%LDATA_TC_ROOF) THEN
- ALLOCATE(DTT%XPAR_TC_ROOF (TG%NDIM,DTT%NPAR_ROOF_LAYER))
+ ALLOCATE(DTT%XPAR_TC_ROOF (KDIM,DTT%NPAR_ROOF_LAYER))
DO JLAYER=1,DTT%NPAR_ROOF_LAYER
WRITE(YRECFM,FMT='(A9,I1.1)') 'D_TC_ROOF',JLAYER
CALL READ_FIELD(YRECFM,DTT%XPAR_TC_ROOF(:,JLAYER),HDIRIN)
@@ -495,7 +415,7 @@ IF (DTT%LDATA_TC_ROOF) THEN
ENDIF
!
IF (DTT%LDATA_D_ROOF) THEN
- ALLOCATE(DTT%XPAR_D_ROOF (TG%NDIM,DTT%NPAR_ROOF_LAYER))
+ ALLOCATE(DTT%XPAR_D_ROOF (KDIM,DTT%NPAR_ROOF_LAYER))
DO JLAYER=1,DTT%NPAR_ROOF_LAYER
WRITE(YRECFM,FMT='(A8,I1.1)') 'D_D_ROOF',JLAYER
CALL READ_FIELD(YRECFM,DTT%XPAR_D_ROOF(:,JLAYER),HDIRIN)
@@ -503,19 +423,19 @@ IF (DTT%LDATA_D_ROOF) THEN
ENDIF
!
IF (DTT%LDATA_ALB_ROAD) THEN
- ALLOCATE(DTT%XPAR_ALB_ROAD (TG%NDIM))
+ ALLOCATE(DTT%XPAR_ALB_ROAD (KDIM))
YRECFM='D_ALB_ROAD'
CALL READ_FIELD(YRECFM,DTT%XPAR_ALB_ROAD,HDIRIN)
ENDIF
!
IF (DTT%LDATA_EMIS_ROAD) THEN
- ALLOCATE(DTT%XPAR_EMIS_ROAD (TG%NDIM))
+ ALLOCATE(DTT%XPAR_EMIS_ROAD (KDIM))
YRECFM='D_EMI_ROAD'
CALL READ_FIELD(YRECFM,DTT%XPAR_EMIS_ROAD,HDIRIN)
ENDIF
!
IF (DTT%LDATA_HC_ROAD) THEN
- ALLOCATE(DTT%XPAR_HC_ROAD (TG%NDIM,DTT%NPAR_ROAD_LAYER))
+ ALLOCATE(DTT%XPAR_HC_ROAD (KDIM,DTT%NPAR_ROAD_LAYER))
DO JLAYER=1,DTT%NPAR_ROAD_LAYER
WRITE(YRECFM,FMT='(A9,I1.1)') 'D_HC_ROAD',JLAYER
CALL READ_FIELD(YRECFM,DTT%XPAR_HC_ROAD(:,JLAYER),HDIRIN)
@@ -523,7 +443,7 @@ IF (DTT%LDATA_HC_ROAD) THEN
ENDIF
!
IF (DTT%LDATA_TC_ROAD) THEN
- ALLOCATE(DTT%XPAR_TC_ROAD (TG%NDIM,DTT%NPAR_ROAD_LAYER))
+ ALLOCATE(DTT%XPAR_TC_ROAD (KDIM,DTT%NPAR_ROAD_LAYER))
DO JLAYER=1,DTT%NPAR_ROAD_LAYER
WRITE(YRECFM,FMT='(A9,I1.1)') 'D_TC_ROAD',JLAYER
CALL READ_FIELD(YRECFM,DTT%XPAR_TC_ROAD(:,JLAYER),HDIRIN)
@@ -531,7 +451,7 @@ IF (DTT%LDATA_TC_ROAD) THEN
ENDIF
!
IF (DTT%LDATA_D_ROAD) THEN
- ALLOCATE(DTT%XPAR_D_ROAD (TG%NDIM,DTT%NPAR_ROAD_LAYER))
+ ALLOCATE(DTT%XPAR_D_ROAD (KDIM,DTT%NPAR_ROAD_LAYER))
DO JLAYER=1,DTT%NPAR_ROAD_LAYER
WRITE(YRECFM,FMT='(A8,I1.1)') 'D_D_ROAD',JLAYER
CALL READ_FIELD(YRECFM,DTT%XPAR_D_ROAD(:,JLAYER),HDIRIN)
@@ -539,19 +459,19 @@ IF (DTT%LDATA_D_ROAD) THEN
ENDIF
!
IF (DTT%LDATA_ALB_WALL) THEN
- ALLOCATE(DTT%XPAR_ALB_WALL (TG%NDIM))
+ ALLOCATE(DTT%XPAR_ALB_WALL (KDIM))
YRECFM='D_ALB_WALL'
CALL READ_FIELD(YRECFM,DTT%XPAR_ALB_WALL,HDIRIN)
ENDIF
!
IF (DTT%LDATA_EMIS_WALL) THEN
- ALLOCATE(DTT%XPAR_EMIS_WALL (TG%NDIM))
+ ALLOCATE(DTT%XPAR_EMIS_WALL (KDIM))
YRECFM='D_EMI_WALL'
CALL READ_FIELD(YRECFM,DTT%XPAR_EMIS_WALL,HDIRIN)
ENDIF
!
IF (DTT%LDATA_HC_WALL) THEN
- ALLOCATE(DTT%XPAR_HC_WALL (TG%NDIM,DTT%NPAR_WALL_LAYER))
+ ALLOCATE(DTT%XPAR_HC_WALL (KDIM,DTT%NPAR_WALL_LAYER))
DO JLAYER=1,DTT%NPAR_WALL_LAYER
WRITE(YRECFM,FMT='(A9,I1.1)') 'D_HC_WALL',JLAYER
CALL READ_FIELD(YRECFM,DTT%XPAR_HC_WALL(:,JLAYER),HDIRIN)
@@ -559,7 +479,7 @@ IF (DTT%LDATA_HC_WALL) THEN
ENDIF
!
IF (DTT%LDATA_TC_WALL) THEN
- ALLOCATE(DTT%XPAR_TC_WALL (TG%NDIM,DTT%NPAR_WALL_LAYER))
+ ALLOCATE(DTT%XPAR_TC_WALL (KDIM,DTT%NPAR_WALL_LAYER))
DO JLAYER=1,DTT%NPAR_WALL_LAYER
WRITE(YRECFM,FMT='(A9,I1.1)') 'D_TC_WALL',JLAYER
CALL READ_FIELD(YRECFM,DTT%XPAR_TC_WALL(:,JLAYER),HDIRIN)
@@ -567,7 +487,7 @@ IF (DTT%LDATA_TC_WALL) THEN
ENDIF
!
IF (DTT%LDATA_D_WALL) THEN
- ALLOCATE(DTT%XPAR_D_WALL (TG%NDIM,DTT%NPAR_WALL_LAYER))
+ ALLOCATE(DTT%XPAR_D_WALL (KDIM,DTT%NPAR_WALL_LAYER))
DO JLAYER=1,DTT%NPAR_WALL_LAYER
WRITE(YRECFM,FMT='(A8,I1.1)') 'D_D_WALL',JLAYER
CALL READ_FIELD(YRECFM,DTT%XPAR_D_WALL(:,JLAYER),HDIRIN)
@@ -575,55 +495,55 @@ IF (DTT%LDATA_D_WALL) THEN
ENDIF
!
IF (DTT%LDATA_BLD_HEIGHT) THEN
- ALLOCATE(DTT%XPAR_BLD_HEIGHT (TG%NDIM))
+ ALLOCATE(DTT%XPAR_BLD_HEIGHT (KDIM))
YRECFM='D_BLD_HEIG'
CALL READ_FIELD(YRECFM,DTT%XPAR_BLD_HEIGHT,HDIRIN)
ENDIF
!
IF (DTT%LDATA_WALL_O_HOR) THEN
- ALLOCATE(DTT%XPAR_WALL_O_HOR (TG%NDIM))
+ ALLOCATE(DTT%XPAR_WALL_O_HOR (KDIM))
YRECFM='D_WALL_O_H'
CALL READ_FIELD(YRECFM,DTT%XPAR_WALL_O_HOR,HDIRIN)
ENDIF
!
IF (DTT%LDATA_H_TRAFFIC) THEN
- ALLOCATE(DTT%XPAR_H_TRAFFIC (TG%NDIM))
+ ALLOCATE(DTT%XPAR_H_TRAFFIC (KDIM))
YRECFM='D_H_TRAF'
CALL READ_FIELD(YRECFM,DTT%XPAR_H_TRAFFIC,HDIRIN)
ENDIF
!
IF (DTT%LDATA_LE_TRAFFIC) THEN
- ALLOCATE(DTT%XPAR_LE_TRAFFIC (TG%NDIM))
+ ALLOCATE(DTT%XPAR_LE_TRAFFIC (KDIM))
YRECFM='D_LE_TRAF'
CALL READ_FIELD(YRECFM,DTT%XPAR_LE_TRAFFIC,HDIRIN)
ENDIF
!
IF (DTT%LDATA_H_INDUSTRY) THEN
- ALLOCATE(DTT%XPAR_H_INDUSTRY (TG%NDIM))
+ ALLOCATE(DTT%XPAR_H_INDUSTRY (KDIM))
YRECFM='D_H_IND'
CALL READ_FIELD(YRECFM,DTT%XPAR_H_INDUSTRY,HDIRIN)
ENDIF
!
IF (DTT%LDATA_LE_INDUSTRY) THEN
- ALLOCATE(DTT%XPAR_LE_INDUSTRY (TG%NDIM))
+ ALLOCATE(DTT%XPAR_LE_INDUSTRY (KDIM))
YRECFM='D_LE_IND'
CALL READ_FIELD(YRECFM,DTT%XPAR_LE_INDUSTRY,HDIRIN)
ENDIF
!
IF (DTT%LDATA_ROUGH_ROOF) THEN
- ALLOCATE(DTT%XPAR_ROUGH_ROOF (TG%NDIM))
+ ALLOCATE(DTT%XPAR_ROUGH_ROOF (KDIM))
YRECFM='D_ROUGH_ROOF'
CALL READ_FIELD(YRECFM,DTT%XPAR_ROUGH_ROOF,HDIRIN)
ENDIF
!
IF (DTT%LDATA_ROUGH_WALL) THEN
- ALLOCATE(DTT%XPAR_ROUGH_WALL (TG%NDIM))
+ ALLOCATE(DTT%XPAR_ROUGH_WALL (KDIM))
YRECFM='D_ROUGH_WALL'
CALL READ_FIELD(YRECFM,DTT%XPAR_ROUGH_WALL,HDIRIN)
ENDIF
!
IF (DTT%LDATA_RESIDENTIAL) THEN
- ALLOCATE(DTT%XPAR_RESIDENTIAL (TG%NDIM))
+ ALLOCATE(DTT%XPAR_RESIDENTIAL (KDIM))
YRECFM='D_F_RESIDENT'
CALL READ_FIELD(YRECFM,DTT%XPAR_RESIDENTIAL,HDIRIN)
ENDIF
@@ -631,25 +551,25 @@ ENDIF
! solar panels
!
IF (DTT%LDATA_EMIS_PANEL) THEN
- ALLOCATE(DTT%XPAR_EMIS_PANEL (TG%NDIM))
+ ALLOCATE(DTT%XPAR_EMIS_PANEL (KDIM))
YRECFM='D_EMIS_PANEL'
CALL READ_FIELD(YRECFM,DTT%XPAR_EMIS_PANEL,HDIRIN)
ENDIF
!
IF (DTT%LDATA_ALB_PANEL) THEN
- ALLOCATE(DTT%XPAR_ALB_PANEL (TG%NDIM))
+ ALLOCATE(DTT%XPAR_ALB_PANEL (KDIM))
YRECFM='D_ALB_PANEL'
CALL READ_FIELD(YRECFM,DTT%XPAR_ALB_PANEL,HDIRIN)
ENDIF
!
IF (DTT%LDATA_EFF_PANEL) THEN
- ALLOCATE(DTT%XPAR_EFF_PANEL (TG%NDIM))
+ ALLOCATE(DTT%XPAR_EFF_PANEL (KDIM))
YRECFM='D_EFF_PANEL'
CALL READ_FIELD(YRECFM,DTT%XPAR_EFF_PANEL,HDIRIN)
ENDIF
!
IF (DTT%LDATA_FRAC_PANEL) THEN
- ALLOCATE(DTT%XPAR_FRAC_PANEL (TG%NDIM))
+ ALLOCATE(DTT%XPAR_FRAC_PANEL (KDIM))
YRECFM='D_FRAC_PANEL'
CALL READ_FIELD(YRECFM,DTT%XPAR_FRAC_PANEL,HDIRIN)
ENDIF
@@ -660,7 +580,7 @@ IF (TOP%CBEM=='BEM') THEN
!
IF (DTB%LDATA_HC_FLOOR) THEN
- ALLOCATE(DTB%XPAR_HC_FLOOR (TG%NDIM,DTB%NPAR_FLOOR_LAYER))
+ ALLOCATE(DTB%XPAR_HC_FLOOR (KDIM,DTB%NPAR_FLOOR_LAYER))
DO JLAYER=1,DTB%NPAR_FLOOR_LAYER
WRITE(YRECFM,FMT='(A10,I1.1)') 'D_HC_FLOOR',JLAYER
CALL READ_FIELD(YRECFM,DTB%XPAR_HC_FLOOR(:,JLAYER),HDIRIN)
@@ -668,7 +588,7 @@ IF (TOP%CBEM=='BEM') THEN
ENDIF
!
IF (DTB%LDATA_TC_FLOOR) THEN
- ALLOCATE(DTB%XPAR_TC_FLOOR (TG%NDIM,DTB%NPAR_FLOOR_LAYER))
+ ALLOCATE(DTB%XPAR_TC_FLOOR (KDIM,DTB%NPAR_FLOOR_LAYER))
DO JLAYER=1,DTB%NPAR_FLOOR_LAYER
WRITE(YRECFM,FMT='(A10,I1.1)') 'D_TC_FLOOR',JLAYER
CALL READ_FIELD(YRECFM,DTB%XPAR_TC_FLOOR(:,JLAYER),HDIRIN)
@@ -676,7 +596,7 @@ IF (TOP%CBEM=='BEM') THEN
ENDIF
!
IF (DTB%LDATA_D_FLOOR) THEN
- ALLOCATE(DTB%XPAR_D_FLOOR (TG%NDIM,DTB%NPAR_FLOOR_LAYER))
+ ALLOCATE(DTB%XPAR_D_FLOOR (KDIM,DTB%NPAR_FLOOR_LAYER))
DO JLAYER=1,DTB%NPAR_FLOOR_LAYER
WRITE(YRECFM,FMT='(A9,I1.1)') 'D_D_FLOOR',JLAYER
CALL READ_FIELD(YRECFM,DTB%XPAR_D_FLOOR(:,JLAYER),HDIRIN)
@@ -684,153 +604,153 @@ IF (TOP%CBEM=='BEM') THEN
ENDIF
!
IF (DTB%LDATA_TCOOL_TARGET) THEN
- ALLOCATE(DTB%XPAR_TCOOL_TARGET (TG%NDIM))
+ ALLOCATE(DTB%XPAR_TCOOL_TARGET (KDIM))
YRECFM='D_TCOOL_TARG'
CALL READ_FIELD(YRECFM,DTB%XPAR_TCOOL_TARGET,HDIRIN)
ENDIF
!
IF (DTB%LDATA_THEAT_TARGET) THEN
- ALLOCATE(DTB%XPAR_THEAT_TARGET (TG%NDIM))
+ ALLOCATE(DTB%XPAR_THEAT_TARGET (KDIM))
YRECFM='D_THEAT_TARG'
CALL READ_FIELD(YRECFM,DTB%XPAR_THEAT_TARGET,HDIRIN)
ENDIF
!
IF (DTB%LDATA_F_WASTE_CAN) THEN
- ALLOCATE(DTB%XPAR_F_WASTE_CAN (TG%NDIM))
+ ALLOCATE(DTB%XPAR_F_WASTE_CAN (KDIM))
YRECFM='D_F_WAST_CAN'
CALL READ_FIELD(YRECFM,DTB%XPAR_F_WASTE_CAN,HDIRIN)
ENDIF
!
IF (DTB%LDATA_EFF_HEAT) THEN
- ALLOCATE(DTB%XPAR_EFF_HEAT (TG%NDIM))
+ ALLOCATE(DTB%XPAR_EFF_HEAT (KDIM))
YRECFM='D_EFF_HEAT'
CALL READ_FIELD(YRECFM,DTB%XPAR_EFF_HEAT,HDIRIN)
ENDIF
!
IF (DTB%LDATA_QIN) THEN
- ALLOCATE(DTB%XPAR_QIN (TG%NDIM))
+ ALLOCATE(DTB%XPAR_QIN (KDIM))
YRECFM='D_QIN'
CALL READ_FIELD(YRECFM,DTB%XPAR_QIN,HDIRIN)
ENDIF
!
IF (DTB%LDATA_QIN_FRAD) THEN
- ALLOCATE(DTB%XPAR_QIN_FRAD (TG%NDIM))
+ ALLOCATE(DTB%XPAR_QIN_FRAD (KDIM))
YRECFM='D_QIN_FRAD'
CALL READ_FIELD(YRECFM,DTB%XPAR_QIN_FRAD,HDIRIN)
ENDIF
!
IF (DTB%LDATA_SHGC) THEN
- ALLOCATE(DTB%XPAR_SHGC (TG%NDIM))
+ ALLOCATE(DTB%XPAR_SHGC (KDIM))
YRECFM='D_SHGC'
CALL READ_FIELD(YRECFM,DTB%XPAR_SHGC,HDIRIN)
ENDIF
!
IF (DTB%LDATA_U_WIN) THEN
- ALLOCATE(DTB%XPAR_U_WIN (TG%NDIM))
+ ALLOCATE(DTB%XPAR_U_WIN (KDIM))
YRECFM='D_U_WIN'
CALL READ_FIELD(YRECFM,DTB%XPAR_U_WIN,HDIRIN)
ENDIF
!
IF (DTB%LDATA_GR) THEN
- ALLOCATE(DTB%XPAR_GR (TG%NDIM))
+ ALLOCATE(DTB%XPAR_GR (KDIM))
YRECFM='D_GR'
CALL READ_FIELD(YRECFM,DTB%XPAR_GR,HDIRIN)
ENDIF
!
IF (DTB%LDATA_SHGC_SH) THEN
- ALLOCATE(DTB%XPAR_SHGC_SH (TG%NDIM))
+ ALLOCATE(DTB%XPAR_SHGC_SH (KDIM))
YRECFM='D_SHGC_SH'
CALL READ_FIELD(YRECFM,DTB%XPAR_SHGC_SH,HDIRIN)
ENDIF
!
IF (DTB%LDATA_FLOOR_HEIGHT) THEN
- ALLOCATE(DTB%XPAR_FLOOR_HEIGHT (TG%NDIM))
+ ALLOCATE(DTB%XPAR_FLOOR_HEIGHT (KDIM))
YRECFM='D_FLOOR_HEIG'
CALL READ_FIELD(YRECFM,DTB%XPAR_FLOOR_HEIGHT,HDIRIN)
ENDIF
!
IF (DTB%LDATA_INF) THEN
- ALLOCATE(DTB%XPAR_INF (TG%NDIM))
+ ALLOCATE(DTB%XPAR_INF (KDIM))
YRECFM='D_INF'
CALL READ_FIELD(YRECFM,DTB%XPAR_INF,HDIRIN)
ENDIF
!
IF (DTB%LDATA_F_WATER_COND) THEN
- ALLOCATE(DTB%XPAR_F_WATER_COND (TG%NDIM))
+ ALLOCATE(DTB%XPAR_F_WATER_COND (KDIM))
YRECFM='D_FWAT_COND'
CALL READ_FIELD(YRECFM,DTB%XPAR_F_WATER_COND,HDIRIN)
ENDIF
!
IF (DTB%LDATA_SHADE) THEN
- ALLOCATE(DTB%XPAR_SHADE (TG%NDIM))
+ ALLOCATE(DTB%XPAR_SHADE (KDIM))
YRECFM='D_SHADE'
CALL READ_FIELD(YRECFM,DTB%XPAR_SHADE,HDIRIN)
DTB%XPAR_SHADE=FLOAT(NINT(DTB%XPAR_SHADE))
ENDIF
!
IF (DTB%LDATA_NATVENT) THEN
- ALLOCATE(DTB%XPAR_NATVENT (TG%NDIM))
+ ALLOCATE(DTB%XPAR_NATVENT (KDIM))
YRECFM='D_NATVENT'
CALL READ_FIELD(YRECFM,DTB%XPAR_NATVENT,HDIRIN)
DTB%XPAR_NATVENT=FLOAT(NINT(DTB%XPAR_NATVENT))
ENDIF
!
IF (DTB%LDATA_QIN_FLAT) THEN
- ALLOCATE(DTB%XPAR_QIN_FLAT (TG%NDIM))
+ ALLOCATE(DTB%XPAR_QIN_FLAT (KDIM))
YRECFM='D_QIN_FLAT'
CALL READ_FIELD(YRECFM,DTB%XPAR_QIN_FLAT,HDIRIN)
ENDIF
!
IF (DTB%LDATA_HR_TARGET) THEN
- ALLOCATE(DTB%XPAR_HR_TARGET (TG%NDIM))
+ ALLOCATE(DTB%XPAR_HR_TARGET (KDIM))
YRECFM='D_HR_TARGET'
CALL READ_FIELD(YRECFM,DTB%XPAR_HR_TARGET,HDIRIN)
ENDIF
!
IF (DTB%LDATA_V_VENT) THEN
- ALLOCATE(DTB%XPAR_V_VENT (TG%NDIM))
+ ALLOCATE(DTB%XPAR_V_VENT (KDIM))
YRECFM='D_V_VENT'
CALL READ_FIELD(YRECFM,DTB%XPAR_V_VENT,HDIRIN)
ENDIF
!
IF (DTB%LDATA_CAP_SYS_HEAT) THEN
- ALLOCATE(DTB%XPAR_CAP_SYS_HEAT (TG%NDIM))
+ ALLOCATE(DTB%XPAR_CAP_SYS_HEAT (KDIM))
YRECFM='D_CAP_SYS_HE'
CALL READ_FIELD(YRECFM,DTB%XPAR_CAP_SYS_HEAT,HDIRIN)
ENDIF
!
IF (DTB%LDATA_CAP_SYS_RAT) THEN
- ALLOCATE(DTB%XPAR_CAP_SYS_RAT (TG%NDIM))
+ ALLOCATE(DTB%XPAR_CAP_SYS_RAT (KDIM))
YRECFM='D_CAP_SYS_RA'
CALL READ_FIELD(YRECFM,DTB%XPAR_CAP_SYS_RAT,HDIRIN)
ENDIF
!
IF (DTB%LDATA_T_ADP) THEN
- ALLOCATE(DTB%XPAR_T_ADP (TG%NDIM))
+ ALLOCATE(DTB%XPAR_T_ADP (KDIM))
YRECFM='D_T_ADP'
CALL READ_FIELD(YRECFM,DTB%XPAR_T_ADP,HDIRIN)
ENDIF
!
IF (DTB%LDATA_M_SYS_RAT) THEN
- ALLOCATE(DTB%XPAR_M_SYS_RAT (TG%NDIM))
+ ALLOCATE(DTB%XPAR_M_SYS_RAT (KDIM))
YRECFM='D_M_SYS_RAT'
CALL READ_FIELD(YRECFM,DTB%XPAR_M_SYS_RAT,HDIRIN)
ENDIF
!
IF (DTB%LDATA_COP_RAT) THEN
- ALLOCATE(DTB%XPAR_COP_RAT (TG%NDIM))
+ ALLOCATE(DTB%XPAR_COP_RAT (KDIM))
YRECFM='D_COP_RAT'
CALL READ_FIELD(YRECFM,DTB%XPAR_COP_RAT,HDIRIN)
ENDIF
!
IF (DTB%LDATA_T_SIZE_MAX) THEN
- ALLOCATE(DTB%XPAR_T_SIZE_MAX (TG%NDIM))
+ ALLOCATE(DTB%XPAR_T_SIZE_MAX (KDIM))
YRECFM='D_T_SIZE_MAX'
CALL READ_FIELD(YRECFM,DTB%XPAR_T_SIZE_MAX,HDIRIN)
ENDIF
!
IF (DTB%LDATA_T_SIZE_MIN) THEN
- ALLOCATE(DTB%XPAR_T_SIZE_MIN (TG%NDIM))
+ ALLOCATE(DTB%XPAR_T_SIZE_MIN (KDIM))
YRECFM='D_T_SIZE_MIN'
CALL READ_FIELD(YRECFM,DTB%XPAR_T_SIZE_MIN,HDIRIN)
ENDIF
@@ -840,7 +760,7 @@ ENDIF
IF (LHOOK) CALL DR_HOOK('READ_PGD_TEB_PAR_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
!
SUBROUTINE READ_FIELD(HRECFM,PFIELD,YDIR)
@@ -850,30 +770,27 @@ USE MODI_HOR_INTERPOL
IMPLICIT NONE
!
CHARACTER(LEN=*), INTENT(IN) :: HRECFM ! name of record in the file
-REAL, DIMENSION(TG%NDIM), INTENT(OUT) :: PFIELD
+REAL, DIMENSION(KDIM), INTENT(OUT) :: PFIELD
CHARACTER(LEN=1), INTENT(IN) :: YDIR
!
REAL, DIMENSION(KNI) :: ZF
REAL, DIMENSION(:,:), POINTER :: ZIN
-REAL, DIMENSION(TG%NDIM,1) :: ZOUT
+REAL, DIMENSION(KDIM,1) :: ZOUT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('READ_PGD_TEB_PAR_N:READ_FIELD',0,ZHOOK_HANDLE)
!
IF (YDIR=='A') THEN
!
- CALL READ_SURF(&
- HPROGRAM,HRECFM,ZF,IRESP,HDIR='A')
+ CALL READ_SURF(HPROGRAM,HRECFM,ZF,IRESP,HDIR='A')
ALLOCATE(ZIN(KNI,1))
ZIN(:,1) = ZF(:)
- CALL HOR_INTERPOL(DTCO, U,GCP, &
- ILUOUT,ZIN,ZOUT)
+ CALL HOR_INTERPOL(DTCO, U, GCP, ILUOUT,ZIN,ZOUT)
DEALLOCATE(ZIN)
PFIELD(:) = ZOUT(:,1)
!
ELSE
- CALL READ_SURF(&
- HPROGRAM,HRECFM,PFIELD,IRESP)
+ CALL READ_SURF(HPROGRAM,HRECFM,PFIELD,IRESP)
ENDIF
!
IF (LHOOK) CALL DR_HOOK('READ_PGD_TEB_PAR_N:READ_FIELD',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/read_pgd_tebn.F90 b/src/SURFEX/read_pgd_tebn.F90
index 4cd313dc7dd3d0198827a3c34a0b47045a5c5e4f..6d292fa1c8a64bd8a80609724065c7c394c80472 100644
--- a/src/SURFEX/read_pgd_tebn.F90
+++ b/src/SURFEX/read_pgd_tebn.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_PGD_TEB_n (DTCO, U, TM,GCP, &
- HPROGRAM)
+ SUBROUTINE READ_PGD_TEB_n (DTCO, U, UG, GCP, TOP, TG, &
+ BOP, BDD, DTB, DTT, HPROGRAM)
! #########################################
!
!!**** *READ_PGD_TEB_n* - reads TEB physiographic fields
@@ -34,7 +34,6 @@
!! MODIFICATIONS
!! -------------
!! Original 01/2003
-!! M. Moge 02/2015 READ_SURF // + MPPDB_CHECK
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -42,9 +41,15 @@
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_t
-USE MODD_SURFEX_n, ONLY : TEB_MODEL_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
+!
+USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_BEM_OPTION_n, ONLY : BEM_OPTIONS_t
+USE MODD_BLD_DESCRIPTION_n, ONLY : BLD_DESC_t
+USE MODD_DATA_BEM_n, ONLY : DATA_BEM_t
+USE MODD_DATA_TEB_n, ONLY : DATA_TEB_t
!
USE MODD_TYPE_DATE_SURF
!
@@ -54,8 +59,7 @@ USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
USE MODE_READ_SURF_COV, ONLY : READ_SURF_COV
!
USE MODI_READ_SURF
-USE MODI_READ_GRID
-USE MODI_READ_LCOVER
+USE MODI_PACK_INIT
USE MODI_READ_PGD_TEB_PAR_n
!
!
@@ -66,11 +70,6 @@ USE MODI_GET_TYPE_DIM_n
!
USE MODI_READ_LECOCLIMAP
!
-#ifdef MNH_PARALLEL
-USE MODI_GET_LUOUT
-USE MODE_MPPDB
-!
-#endif
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -79,22 +78,27 @@ IMPLICIT NONE
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
+TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+TYPE(GRID_t), INTENT(INOUT) :: TG
+TYPE(BEM_OPTIONS_t), INTENT(INOUT) :: BOP
+TYPE(BLD_DESC_t), INTENT(INOUT) :: BDD
+TYPE(DATA_BEM_t), INTENT(INOUT) :: DTB
+TYPE(DATA_TEB_t), INTENT(INOUT) :: DTT
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
!
!* 0.2 Declarations of local variables
! -------------------------------
-!
-INTEGER :: IRESP ! Error code after redding
-#ifdef MNH_PARALLEL
-INTEGER :: ILUOUT ! output listing logical unit
-#endif
!
CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
INTEGER :: IVERSION
INTEGER :: IBUGFIX
+INTEGER :: IRESP ! Error code after redding
+!
+LOGICAL :: GECOSG
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
@@ -102,106 +106,87 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* 1D physical dimension
!
IF (LHOOK) CALL DR_HOOK('READ_PGD_TEB_N',0,ZHOOK_HANDLE)
-#ifdef MNH_PARALLEL
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
-#endif
YRECFM='SIZE_TOWN'
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'TOWN ',TM%TG%NDIM)
+ CALL GET_TYPE_DIM_n(DTCO, U, 'TOWN ',TG%NDIM)
!
!* 2. Other dimension initializations:
! --------------------------------
!
- CALL READ_SURF(&
- HPROGRAM,'VERSION',IVERSION,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'BUG',IBUGFIX,IRESP)
+ CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP)
!
!* number of TEB patches
!
IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<=2) THEN
- TM%TOP%NTEB_PATCH=1
+ TOP%NTEB_PATCH=1
ELSE
YRECFM='TEB_PATCH'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TM%TOP%NTEB_PATCH,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,TOP%NTEB_PATCH,IRESP)
END IF
!
!* number of road and roof layers
!
YRECFM='ROAD_LAYER'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TM%TOP%NROAD_LAYER,IRESP)
+ CALL READ_SURF( HPROGRAM,YRECFM,TOP%NROAD_LAYER,IRESP)
YRECFM='ROOF_LAYER'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TM%TOP%NROOF_LAYER,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,TOP%NROOF_LAYER,IRESP)
YRECFM='WALL_LAYER'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TM%TOP%NWALL_LAYER,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,TOP%NWALL_LAYER,IRESP)
!
!
!* type of averaging for Buildings (to allow ascendant compatibility)
!* type of Building Energy Model
!
IF (IVERSION<7 .OR.( IVERSION==7 .AND. IBUGFIX<=2)) THEN
- TM%TOP%CBLD_ATYPE='ARI'
- TM%TOP%CBEM = 'DEF'
+ TOP%CBLD_ATYPE='ARI'
+ TOP%CBEM = 'DEF'
ELSE
YRECFM='BLD_ATYPE'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TM%TOP%CBLD_ATYPE,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,TOP%CBLD_ATYPE,IRESP)
YRECFM='BEM'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TM%TOP%CBEM,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,TOP%CBEM,IRESP)
END IF
!
-IF (TM%TOP%CBEM=="BEM") THEN
+IF (TOP%CBEM=="BEM") THEN
YRECFM='FLOOR_LAYER'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TM%BOP%NFLOOR_LAYER,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,BOP%NFLOOR_LAYER,IRESP)
YRECFM='COOL_COIL'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TM%BOP%CCOOL_COIL,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,BOP%CCOOL_COIL,IRESP)
YRECFM='HEAT_COIL'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TM%BOP%CHEAT_COIL,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,BOP%CHEAT_COIL,IRESP)
YRECFM='AUTOSIZE'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TM%BOP%LAUTOSIZE,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,BOP%LAUTOSIZE,IRESP)
ENDIF
!
!* Case of urban green roofs
!
-IF (TM%TOP%LGARDEN) THEN
+IF (TOP%LGARDEN) THEN
IF (IVERSION<7 .OR.( IVERSION==7 .AND. IBUGFIX<=2)) THEN
- TM%TOP%LGREENROOF = .FALSE.
+ TOP%LGREENROOF = .FALSE.
ELSE
YRECFM='LGREENROOF'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TM%TOP%LGREENROOF,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,TOP%LGREENROOF,IRESP)
END IF
!
!* Case of urban hydrology
!
IF (IVERSION<7 .OR.( IVERSION==7 .AND. IBUGFIX<=3)) THEN
- TM%TOP%LHYDRO = .FALSE.
+ TOP%LHYDRO = .FALSE.
ELSE
YRECFM='LURBAN_HYDRO'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TM%TOP%LHYDRO,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,TOP%LHYDRO,IRESP)
END IF
ENDIF
!
!* Solar panels
!
IF (IVERSION<7 .OR.( IVERSION==7 .AND. IBUGFIX<=3)) THEN
- TM%TOP%LSOLAR_PANEL = .FALSE.
+ TOP%LSOLAR_PANEL = .FALSE.
ELSE
YRECFM='SOLAR_PANEL'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TM%TOP%LSOLAR_PANEL,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,TOP%LSOLAR_PANEL,IRESP)
END IF
!
!
@@ -211,51 +196,24 @@ END IF
!
!* cover classes
!
-ALLOCATE(TM%TOP%LCOVER(JPCOVER))
- CALL READ_LCOVER(&
- HPROGRAM,TM%TOP%LCOVER)
-!
-ALLOCATE(TM%TOP%XCOVER(TM%TG%NDIM,COUNT(TM%TOP%LCOVER)))
-#ifdef MNH_PARALLEL
- CALL READ_SURF_COV(&
- HPROGRAM,'COVER',TM%TOP%XCOVER(:,:),TM%TOP%LCOVER,IRESP,HDIR='H')
- CALL MPPDB_CHECK_SURFEX3D(TM%TOP%XCOVER,"READ_PGD_TEB_n after READ_SURF:XCOVER",PRECISION,ILUOUT, 'TOWN ',SIZE(TM%TOP%XCOVER,2))
-#else
- CALL READ_SURF_COV(&
- HPROGRAM,'COVER',TM%TOP%XCOVER(:,:),TM%TOP%LCOVER,IRESP)
-#endif
-!
-!* orography
-!
-ALLOCATE(TM%TOP%XZS(TM%TG%NDIM))
-YRECFM='ZS'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TM%TOP%XZS(:),IRESP)
-!
-!
-!* latitude, longitude
-!
-ALLOCATE(TM%TG%XLAT (TM%TG%NDIM))
-ALLOCATE(TM%TG%XLON (TM%TG%NDIM))
-ALLOCATE(TM%TG%XMESH_SIZE(TM%TG%NDIM))
- CALL READ_GRID(&
- HPROGRAM,TM%TG%CGRID,TM%TG%XGRID_PAR,&
- TM%TG%XLAT,TM%TG%XLON,TM%TG%XMESH_SIZE,IRESP)
-!
+ALLOCATE(TOP%LCOVER(JPCOVER))
+ALLOCATE(TOP%XZS(TG%NDIM))
+ALLOCATE(TG%XLAT (TG%NDIM))
+ALLOCATE(TG%XLON (TG%NDIM))
+ALLOCATE(TG%XMESH_SIZE (TG%NDIM))
+CALL PACK_INIT(DTCO,U,UG,HPROGRAM,'TOWN ',TG, TOP%LCOVER,TOP%XCOVER,TOP%XZS )
!
!-------------------------------------------------------------------------------
!
!* 4. Physiographic data fields not to be computed by ecoclimap
! ---------------------------------------------------------
!
- CALL READ_LECOCLIMAP(&
- HPROGRAM,TM%TOP%LECOCLIMAP)
+ CALL READ_LECOCLIMAP(HPROGRAM,TOP%LECOCLIMAP,GECOSG)
!
- CALL READ_PGD_TEB_PAR_n(DTCO, U,GCP, &
- TM%BDD, TM%DTB, TM%DTT, TM%TG, TM%TOP, &
- HPROGRAM,TM%TG%NDIM,'-')
-IF (LHOOK) CALL DR_HOOK('READ_PGD_TEB_N',1,ZHOOK_HANDLE)
+ CALL READ_PGD_TEB_PAR_n(DTCO, U, GCP, BDD, DTB, DTT, TG%NDIM, TOP, &
+ HPROGRAM,TG%NDIM,'-')
!
+IF (LHOOK) CALL DR_HOOK('READ_PGD_TEB_N',1,ZHOOK_HANDLE)
!
!------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/read_pgd_tsz0_parn.F90 b/src/SURFEX/read_pgd_tsz0_parn.F90
index 89dda7bb10432ce0d46391620e629d68d7159716..52811f1cab072b867ff58961d69dd76e6daeac7a 100644
--- a/src/SURFEX/read_pgd_tsz0_parn.F90
+++ b/src/SURFEX/read_pgd_tsz0_parn.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_PGD_TSZ0_PAR_n (&
- DTZ, &
- HPROGRAM)
+ SUBROUTINE READ_PGD_TSZ0_PAR_n (DTZ, HPROGRAM)
! ################################################
!
!!**** *READ_PGD_TSZ0_PAR_n* - reads SEAFLUX sst
@@ -79,16 +77,13 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('READ_PGD_TSZ0_PAR_N',0,ZHOOK_HANDLE)
!
- CALL READ_SURF(&
- HPROGRAM,'VERSION',IVERSION,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'BUG', IBUGFIX ,IRESP)
+ CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,'BUG', IBUGFIX ,IRESP)
!
IF (IVERSION.GT.7 .OR. (IVERSION==7 .AND. IBUGFIX.GT.1)) THEN
YRECFM='ND_TSZ0_TIME'
YCOMMENT = '(-)'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTZ%NTIME,IRESP,HCOMMENT=YCOMMENT)
+ CALL READ_SURF(HPROGRAM,YRECFM,DTZ%NTIME,IRESP,HCOMMENT=YCOMMENT)
ELSE
DTZ%NTIME=37
ENDIF
@@ -100,13 +95,11 @@ IF (IVERSION.GT.7 .OR. (IVERSION==7 .AND. IBUGFIX.GT.1)) THEN
!
YRECFM = 'D_DTS'
YCOMMENT = 'X_Y_DATA_DTS'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTZ%XDATA_DTS(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ CALL READ_SURF(HPROGRAM,YRECFM,DTZ%XDATA_DTS(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
!
YRECFM='D_DHUGRD'
YCOMMENT = 'X_Y_DATA_DHUGRD'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,DTZ%XDATA_DHUGRD(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ CALL READ_SURF(HPROGRAM,YRECFM,DTZ%XDATA_DHUGRD(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
!
ELSE
!
diff --git a/src/SURFEX/read_pgd_watfluxn.F90 b/src/SURFEX/read_pgd_watfluxn.F90
index 9218dc32dc4caa031f974599d65ed4fcd7b4fb98..1d5fe7c5acbd4a0b25942ae867d40d38dd1748cd 100644
--- a/src/SURFEX/read_pgd_watfluxn.F90
+++ b/src/SURFEX/read_pgd_watfluxn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_PGD_WATFLUX_n (DTCO, U, WG, W, &
- HPROGRAM)
+ SUBROUTINE READ_PGD_WATFLUX_n (DTCO, U, UG, WG, W, HPROGRAM)
! #########################################
!
!!**** *READ_PGD_WATFLUX_n* - read WATFLUX physiographic fields
@@ -39,12 +38,10 @@
!* 0. DECLARATIONS
! ------------
!
-!
-!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_WATFLUX_GRID_n, ONLY : WATFLUX_GRID_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_WATFLUX_n, ONLY : WATFLUX_t
!
USE MODD_TYPE_DATE_SURF
@@ -54,9 +51,7 @@ USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
USE MODE_READ_SURF_COV, ONLY : READ_SURF_COV
!
USE MODI_READ_SURF
-USE MODI_READ_GRID
-USE MODI_READ_LCOVER
-!
+USE MODI_PACK_INIT
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -71,7 +66,8 @@ IMPLICIT NONE
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(WATFLUX_GRID_t), INTENT(INOUT) :: WG
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(GRID_t), INTENT(INOUT) :: WG
TYPE(WATFLUX_t), INTENT(INOUT) :: W
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
@@ -90,9 +86,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('READ_PGD_WATFLUX_N',0,ZHOOK_HANDLE)
YRECFM='SIZE_WATER'
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'WATER ',WG%NDIM)
-!
+ CALL GET_TYPE_DIM_n(DTCO, U, 'WATER ',WG%NDIM)
!
!
!* 2. Physiographic data fields:
@@ -101,29 +95,13 @@ YRECFM='SIZE_WATER'
!* cover classes
!
ALLOCATE(W%LCOVER(JPCOVER))
- CALL READ_LCOVER(&
- HPROGRAM,W%LCOVER)
-!
-ALLOCATE(W%XCOVER(WG%NDIM,JPCOVER))
- CALL READ_SURF_COV(&
- HPROGRAM,'COVER',W%XCOVER(:,:),W%LCOVER,IRESP)
-!
-!* orography
-!
ALLOCATE(W%XZS(WG%NDIM))
-YRECFM='ZS'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,W%XZS(:),IRESP)
+ALLOCATE(WG%XLAT (WG%NDIM))
+ALLOCATE(WG%XLON (WG%NDIM))
+ALLOCATE(WG%XMESH_SIZE (WG%NDIM))
+CALL PACK_INIT(DTCO, U, UG, HPROGRAM,'WATER ',WG,W%LCOVER,W%XCOVER,W%XZS)
!
-!* latitude, longitude
-!
-ALLOCATE(WG%XLAT (WG%NDIM))
-ALLOCATE(WG%XLON (WG%NDIM))
-ALLOCATE(WG%XMESH_SIZE(WG%NDIM))
- CALL READ_GRID(&
- HPROGRAM,WG%CGRID,WG%XGRID_PAR,WG%XLAT,WG%XLON,WG%XMESH_SIZE,IRESP)
IF (LHOOK) CALL DR_HOOK('READ_PGD_WATFLUX_N',1,ZHOOK_HANDLE)
-!
!-------------------------------------------------------------------------------
!
END SUBROUTINE READ_PGD_WATFLUX_n
diff --git a/src/SURFEX/read_precipn.F90 b/src/SURFEX/read_precipn.F90
deleted file mode 100644
index 53bfec8ff4e300c0882ca21dbf40687264fcf266..0000000000000000000000000000000000000000
--- a/src/SURFEX/read_precipn.F90
+++ /dev/null
@@ -1,11 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE READ_PRECIP_n
-! ########################################
-!
-! Ã supprimer
-!
-END SUBROUTINE READ_PRECIP_n
diff --git a/src/SURFEX/read_prep_file_date.F90 b/src/SURFEX/read_prep_file_date.F90
index 92dbab07e59b20977f244ecebf02840861e63877..5eca827a652c9eb4379d2ca8c601375c5decbcd6 100644
--- a/src/SURFEX/read_prep_file_date.F90
+++ b/src/SURFEX/read_prep_file_date.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE READ_PREP_FILE_DATE (&
- HPROGRAM,HFILE,HFILETYPE,TPTIME,KLUOUT)
+SUBROUTINE READ_PREP_FILE_DATE (HPROGRAM,HFILE,HFILETYPE,TPTIME,KLUOUT)
! #################################################################################
!
!!**** *READ_PREP_FILE_DATE* - reads the date for the surface
@@ -39,7 +38,7 @@ USE MODI_READ_BUFFER
USE MODI_OPEN_AUX_IO_SURF
USE MODI_READ_SURF
USE MODI_CLOSE_AUX_IO_SURF
-!
+USE MODI_ABOR1_SFX
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -59,9 +58,10 @@ INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
!
!* 0.2 declarations of local variables
!
- CHARACTER(LEN=LEN_HREC), DIMENSION(3000) :: HREC ! list of records already read/written
+ CHARACTER(LEN=LEN_HREC), DIMENSION(SIZE(CREC)) :: HREC ! list of records already read/written
INTEGER :: IREC
CHARACTER(LEN=6) :: YINMODEL ! model from which GRIB file originates
+ CHARACTER(LEN=6) :: YINTERPTYPE
CHARACTER(LEN=10) :: YGRIDTYPE ! Grid type
INTEGER :: IRESP ! Error code after redding
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -74,16 +74,15 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('READ_PREP_FILE_DATE',0,ZHOOK_HANDLE)
IF(HFILETYPE=='GRIB ') THEN
!
- CALL PREP_GRIB_GRID(HFILE,KLUOUT,YINMODEL,YGRIDTYPE,TPTIME)
+ CALL PREP_GRIB_GRID(HFILE,KLUOUT,YINMODEL,YGRIDTYPE,YINTERPTYPE,TPTIME)
!
-ELSE IF(HFILETYPE=='MESONH' .OR. HFILETYPE=='LFI ' .OR. HFILETYPE=='ASCII '.OR. HFILETYPE=='FA ') THEN
+ELSE IF(HFILETYPE=='MESONH' .OR. HFILETYPE=='LFI ' .OR. HFILETYPE=='ASCII '.OR. HFILETYPE=='FA '.OR.&
+ HFILETYPE=='NC ') THEN
!
HREC = CREC
IREC = NREC
- CALL OPEN_AUX_IO_SURF(&
- HFILE,HFILETYPE,'FULL ')
- CALL READ_SURF(&
- HFILETYPE,'DTCUR ',TPTIME,IRESP)
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'FULL ')
+ CALL READ_SURF(HFILETYPE,'DTCUR ',TPTIME,IRESP)
CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
CREC = HREC
NREC = IREC
@@ -99,6 +98,7 @@ ELSE
!
WRITE(UNIT=KLUOUT, FMT=*) 'STOP IN READ_PREP_FILE_DATE'
WRITE(UNIT=KLUOUT, FMT='("FILETYPE =",A6,"NOT SUPPORTED")') HFILETYPE
+ CALL ABOR1_SFX("READ_PREP_FILE_DATE: FILETYPE NOT SUPPORTED")
!
ENDIF
IF (LHOOK) CALL DR_HOOK('READ_PREP_FILE_DATE',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/read_prep_garden_snow.F90 b/src/SURFEX/read_prep_garden_snow.F90
index 3c73c54944bd254ca4f410e66d69e5e0ffa6f90b..76c7ae01836a7c3cab7b2c5baf34191264453860 100644
--- a/src/SURFEX/read_prep_garden_snow.F90
+++ b/src/SURFEX/read_prep_garden_snow.F90
@@ -73,11 +73,11 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling ISBA
- CHARACTER(LEN=3), INTENT(OUT) :: HSNOW ! snow scheme
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling ISBA
+CHARACTER(LEN=3), INTENT(OUT) :: HSNOW ! snow scheme
INTEGER, INTENT(OUT) :: KSNOW_LAYER ! number of snow layers
- CHARACTER(LEN=28), OPTIONAL, INTENT(OUT) :: HFILE ! file name
- CHARACTER(LEN=6), OPTIONAL, INTENT(OUT) :: HFILETYPE ! file type
+CHARACTER(LEN=28), OPTIONAL, INTENT(OUT) :: HFILE ! file name
+CHARACTER(LEN=6), OPTIONAL, INTENT(OUT) :: HFILETYPE ! file type
CHARACTER(LEN=28),OPTIONAL, INTENT(OUT) :: HFILEPGD ! file name
CHARACTER(LEN=6), OPTIONAL, INTENT(OUT) :: HFILEPGDTYPE ! file type
LOGICAL, OPTIONAL, INTENT(OUT) :: OUNIF ! uniform snow
@@ -85,9 +85,9 @@ INTEGER, INTENT(OUT) :: KSNOW_LAYER ! number of snow layers
!* 0.2 Declarations of local variables
! -------------------------------
!
- CHARACTER(LEN=3) :: CSNOW
+CHARACTER(LEN=3) :: CSNOW
INTEGER :: NSNOW_LAYER
- CHARACTER(LEN=28) :: CFILE_SNOW, CFILEPGD_SNOW
+CHARACTER(LEN=28) :: CFILE_SNOW, CFILEPGD_SNOW
LOGICAL :: LSNOW_IDEAL, LSNOW_FRAC_TOT, LSWEMAX
REAL :: XASNOW, XSWEMAX
REAL, DIMENSION(NSNOW_LAYER_MAX) :: XWSNOW, XZSNOW, XRSNOW, XTSNOW, XLWCSNOW, XSG1SNOW, XSG2SNOW,&
@@ -199,7 +199,7 @@ IF (LNAM_READ) THEN
IF (GFOUND) THEN
READ(UNIT=ILUNAM,NML=NAM_PREP_GARDEN_SNOW)
!crocus can't be used in garden if not used in isba scheme
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CSNOW',CSNOW_GD,'D95','3-L','EBA','NON')
+ CALL TEST_NAM_VAR_SURF(ILUOUT,'CSNOW',CSNOW_GD,'D95','3-L','EBA','NON','CRO')
ENDIF
!
IF (CSNOW_GD=='NON') NSNOW_LAYER_GD = 0
diff --git a/src/SURFEX/read_prep_greenroof_snow.F90 b/src/SURFEX/read_prep_greenroof_snow.F90
index ec254f5e4c81783b0ec43dcef51acd33b727d399..9e2c2139f8de737152f61a1da6575fb651c65d6a 100644
--- a/src/SURFEX/read_prep_greenroof_snow.F90
+++ b/src/SURFEX/read_prep_greenroof_snow.F90
@@ -81,9 +81,9 @@ INTEGER, INTENT(OUT) :: KSNOW_LAYER ! number of snow layers
!* 0.2 Declarations of local variables
! -------------------------------
!
- CHARACTER(LEN=3) :: CSNOW
+CHARACTER(LEN=3) :: CSNOW
INTEGER :: NSNOW_LAYER
- CHARACTER(LEN=28) :: CFILE_SNOW, CFILEPGD_SNOW
+CHARACTER(LEN=28) :: CFILE_SNOW, CFILEPGD_SNOW
LOGICAL :: LSNOW_IDEAL, LSNOW_FRAC_TOT, LSWEMAX
REAL :: XASNOW, XSWEMAX
REAL, DIMENSION(NSNOW_LAYER_MAX) :: XWSNOW, XZSNOW, XRSNOW, XTSNOW, XLWCSNOW, XSG1SNOW, XSG2SNOW,&
@@ -116,7 +116,7 @@ IF (LHOOK) CALL DR_HOOK('READ_PREP_GREENROOF_SNOW',0,ZHOOK_HANDLE)
!
!* default for greenroofs
! ----------------------
- CSNOW_GR = '3-L'
+CSNOW_GR = '3-L'
NSNOW_LAYER_GR = 3
!
IF (LNAM_READ) THEN
diff --git a/src/SURFEX/read_prep_seaflux_conf.F90 b/src/SURFEX/read_prep_seaflux_conf.F90
index 97641c8475ad3b0e24fcc59b388dbda716ad47cb..83e5bc1fe124f049a1f13d4980b212bd7282a211 100644
--- a/src/SURFEX/read_prep_seaflux_conf.F90
+++ b/src/SURFEX/read_prep_seaflux_conf.F90
@@ -3,9 +3,9 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_PREP_SEAFLUX_CONF (O, &
- HPROGRAM,HVAR,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE, &
- HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,KLUOUT,OUNIF)
+ SUBROUTINE READ_PREP_SEAFLUX_CONF (OMERCATOR, HPROGRAM,HVAR,HFILE,HFILETYPE,&
+ HFILEPGD,HFILEPGDTYPE, HATMFILE,HATMFILETYPE,&
+ HPGDFILE,HPGDFILETYPE,KLUOUT,OUNIF)
! #######################################################
!
!!**** *READ_PREP_SEAFLUX_CONF* - routine to read the configuration for
@@ -67,19 +67,18 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-TYPE(OCEAN_t), INTENT(INOUT) :: O
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling ISBA
- CHARACTER(LEN=7), INTENT(IN) :: HVAR ! variable treated
- CHARACTER(LEN=28), INTENT(OUT) :: HFILE ! file name
- CHARACTER(LEN=6), INTENT(OUT) :: HFILETYPE! file type
- CHARACTER(LEN=28), INTENT(OUT) :: HFILEPGD ! file name
- CHARACTER(LEN=6), INTENT(OUT) :: HFILEPGDTYPE! file type
- CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! atmospheric file name
- CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! atmospheric file type
- CHARACTER(LEN=28), INTENT(IN) :: HPGDFILE ! atmospheric file name
- CHARACTER(LEN=6), INTENT(IN) :: HPGDFILETYPE! atmospheric file type
+LOGICAL, INTENT(IN) :: OMERCATOR
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling ISBA
+CHARACTER(LEN=7), INTENT(IN) :: HVAR ! variable treated
+CHARACTER(LEN=28), INTENT(OUT) :: HFILE ! file name
+CHARACTER(LEN=6), INTENT(OUT) :: HFILETYPE! file type
+CHARACTER(LEN=28), INTENT(OUT) :: HFILEPGD ! file name
+CHARACTER(LEN=6), INTENT(OUT) :: HFILEPGDTYPE! file type
+CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! atmospheric file name
+CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! atmospheric file type
+CHARACTER(LEN=28), INTENT(IN) :: HPGDFILE ! atmospheric file name
+CHARACTER(LEN=6), INTENT(IN) :: HPGDFILETYPE! atmospheric file type
INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
LOGICAL, INTENT(OUT) :: OUNIF ! flag for prescribed uniform field
@@ -171,7 +170,7 @@ END IF
!* If 1D coupling: ocean variables initializing
! --------------------------------------------
!
-IF (O%LMERCATOR) THEN
+IF (OMERCATOR) THEN
WRITE(KLUOUT,*) 'LMERCATOR=T : initializing oceanic vertical grid'
CALL PREP_OCEAN_MERCATORVERGRID(HPROGRAM,OUNIF)
END IF
diff --git a/src/SURFEX/read_teb_canopyn.F90 b/src/SURFEX/read_sbln.F90
similarity index 50%
rename from src/SURFEX/read_teb_canopyn.F90
rename to src/SURFEX/read_sbln.F90
index 43b8dae95619b0af4e79aa3ae06e58588cd7c1c9..500e64ae7024c6a7e2bb54a41cf59c04c22c18fe 100644
--- a/src/SURFEX/read_teb_canopyn.F90
+++ b/src/SURFEX/read_sbln.F90
@@ -3,11 +3,10 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_TEB_CANOPY_n (DTCO, U, TCP, TOP, &
- HPROGRAM)
+ SUBROUTINE READ_SBL_n (DTCO, U, SB, OSBL, HPROGRAM, HSURF)
! #########################################
!
-!!**** *READ_TEB_CANOPY_n* - reads TEB fields
+!!**** *READ_SBL_n* - reads TEB fields
!!
!!
!! PURPOSE
@@ -45,8 +44,7 @@
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_TEB_CANOPY_n, ONLY : TEB_CANOPY_t
-USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
+USE MODD_CANOPY_n, ONLY : CANOPY_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
@@ -65,17 +63,20 @@ IMPLICIT NONE
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(TEB_CANOPY_t), INTENT(INOUT) :: TCP
-TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
+LOGICAL, INTENT(INOUT) :: OSBL
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
+ CHARACTER(LEN=6), INTENT(IN) :: HSURF
!
!
!* 0.2 Declarations of local variables
! -------------------------------
!
!
+ CHARACTER(LEN=8) :: YBASE
CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+ CHARACTER(LEN=13) :: YFORMAT
CHARACTER(LEN=3) :: YREAD
INTEGER :: JLAYER ! loop counter on layers
INTEGER :: ILU ! 1D physical dimension
@@ -86,76 +87,95 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 1D physical dimension
!
-IF (LHOOK) CALL DR_HOOK('READ_TEB_CANOPY_N',0,ZHOOK_HANDLE)
-YRECFM='SIZE_TOWN'
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'TOWN ',ILU)
+IF (LHOOK) CALL DR_HOOK('READ_SBL_N',0,ZHOOK_HANDLE)
+!
+ CALL GET_TYPE_DIM_n(DTCO, U, HSURF, ILU)
!
!* flag to use or not canopy levels
!
YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
!
YRECFM='BUG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IBUGFIX,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
!
IF (IVERSION<3) THEN
- TOP%LCANOPY = .FALSE.
+ OSBL = .FALSE.
ELSE
- YRECFM='TEB_CANOPY'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TOP%LCANOPY,IRESP)
+ IF (HSURF=="TOWN ") THEN
+ YRECFM='TEB_CANOPY'
+ ELSEIF (HSURF=="WATER ") THEN
+ YRECFM='WAT_SBL'
+ ELSEIF (HSURF=="NATURE") THEN
+ YRECFM='ISBA_CANOPY'
+ ELSEIF (HSURF=="SEA ") THEN
+ YRECFM='SEA_SBL'
+ ENDIF
+ CALL READ_SURF(HPROGRAM,YRECFM,OSBL,IRESP)
END IF
!
-IF (.NOT.TOP%LCANOPY) THEN
- ALLOCATE(TCP%XZ (0,0))
- ALLOCATE(TCP%XU (0,0))
- ALLOCATE(TCP%XT (0,0))
- ALLOCATE(TCP%XQ (0,0))
- ALLOCATE(TCP%XTKE(0,0))
- ALLOCATE(TCP%XLMO(0,0))
- ALLOCATE(TCP%XP (0,0))
- ALLOCATE(TCP%XLM (0,0))
- ALLOCATE(TCP%XLEPS(0,0))
- ALLOCATE(TCP%XDZ (0,0))
- ALLOCATE(TCP%XZF (0,0))
- ALLOCATE(TCP%XDZF(0,0))
- IF (LHOOK) CALL DR_HOOK('READ_TEB_CANOPY_N',1,ZHOOK_HANDLE)
+IF (.NOT.OSBL) THEN
+ ALLOCATE(SB%XZ (0,0))
+ ALLOCATE(SB%XU (0,0))
+ ALLOCATE(SB%XT (0,0))
+ ALLOCATE(SB%XQ (0,0))
+ ALLOCATE(SB%XTKE(0,0))
+ ALLOCATE(SB%XLMO(0,0))
+ ALLOCATE(SB%XP (0,0))
+ IF (HSURF=="TOWN ") THEN
+ ALLOCATE(SB%XLM (0,0))
+ ALLOCATE(SB%XLEPS(0,0))
+ ENDIF
+ ALLOCATE(SB%XDZ (0,0))
+ ALLOCATE(SB%XZF (0,0))
+ ALLOCATE(SB%XDZF(0,0))
+ IF (LHOOK) CALL DR_HOOK('READ_SBL_N',1,ZHOOK_HANDLE)
RETURN
ENDIF
!
!* number of vertical levels
!
-YRECFM='TEB_CAN_LVL'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TCP%NLVL,IRESP)
+IF (HSURF=="TOWN ") THEN
+ YBASE = "TEB_CAN "
+ELSEIF (HSURF=="WATER ") THEN
+ YBASE = "WAT_SBL "
+ELSEIF (HSURF=="NATURE") THEN
+ YBASE = "ISBA_CAN"
+ELSEIF (HSURF=="SEA ") THEN
+ YBASE = "SEA_SBL "
+ENDIF
+!
+IF (HSURF=="NATURE") THEN
+ YFORMAT='(A10,I2.2)'
+ELSE
+ YFORMAT='(A9,I2.2) '
+ENDIF
+!
+YRECFM=TRIM(YBASE)//'_LVL'
+ CALL READ_SURF(HPROGRAM,YRECFM,SB%NLVL,IRESP)
!
!* 2. Prognostic fields:
! -----------------
!
!* altitudes
!
-ALLOCATE(TCP%XZ(ILU,TCP%NLVL))
+ALLOCATE(SB%XZ(ILU,SB%NLVL))
!
-DO JLAYER=1,TCP%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'TEB_CAN_Z',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TCP%XZ(:,JLAYER),IRESP)
+DO JLAYER=1,SB%NLVL
+ WRITE(YRECFM,YFORMAT) TRIM(YBASE)//'_Z',JLAYER
+ CALL READ_SURF(HPROGRAM,YRECFM,SB%XZ(:,JLAYER),IRESP)
END DO
!
-ALLOCATE(TCP%XU (ILU,TCP%NLVL))
-ALLOCATE(TCP%XT (ILU,TCP%NLVL))
-ALLOCATE(TCP%XQ (ILU,TCP%NLVL))
-ALLOCATE(TCP%XTKE(ILU,TCP%NLVL))
-ALLOCATE(TCP%XLMO(ILU,TCP%NLVL))
-ALLOCATE(TCP%XP (ILU,TCP%NLVL))
+ALLOCATE(SB%XU (ILU,SB%NLVL))
+ALLOCATE(SB%XT (ILU,SB%NLVL))
+ALLOCATE(SB%XQ (ILU,SB%NLVL))
+ALLOCATE(SB%XTKE(ILU,SB%NLVL))
+ALLOCATE(SB%XLMO(ILU,SB%NLVL))
+ALLOCATE(SB%XP (ILU,SB%NLVL))
!
IF (IVERSION>7 .OR. IVERSION==7 .AND.IBUGFIX>=2) THEN
YRECFM='STORAGETYPE'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,YREAD,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,YREAD,IRESP)
ELSE
YREAD = 'ALL'
ENDIF
@@ -163,72 +183,69 @@ ENDIF
IF(YREAD=='ALL') THEN
!
!* wind in SBL
- DO JLAYER=1,TCP%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'TEB_CAN_U',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TCP%XU(:,JLAYER),IRESP)
+ DO JLAYER=1,SB%NLVL
+ WRITE(YRECFM,YFORMAT) TRIM(YBASE)//'_U',JLAYER
+ CALL READ_SURF(HPROGRAM,YRECFM,SB%XU(:,JLAYER),IRESP)
END DO
!
!* theta in SBL
- DO JLAYER=1,TCP%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'TEB_CAN_T',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TCP%XT(:,JLAYER),IRESP)
+ DO JLAYER=1,SB%NLVL
+ WRITE(YRECFM,YFORMAT) TRIM(YBASE)//'_T',JLAYER
+ CALL READ_SURF(HPROGRAM,YRECFM,SB%XT(:,JLAYER),IRESP)
END DO
!
!* humidity in SBL
- DO JLAYER=1,TCP%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'TEB_CAN_Q',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TCP%XQ(:,JLAYER),IRESP)
+ DO JLAYER=1,SB%NLVL
+ WRITE(YRECFM,YFORMAT) TRIM(YBASE)//'_Q',JLAYER
+ CALL READ_SURF( HPROGRAM,YRECFM,SB%XQ(:,JLAYER),IRESP)
END DO
!
!* Tke in SBL
- DO JLAYER=1,TCP%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'TEB_CAN_E',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TCP%XTKE(:,JLAYER),IRESP)
+ DO JLAYER=1,SB%NLVL
+ WRITE(YRECFM,YFORMAT) TRIM(YBASE)//'_E',JLAYER
+ CALL READ_SURF(HPROGRAM,YRECFM,SB%XTKE(:,JLAYER),IRESP)
END DO
!
!* Monin-Obhukov length
- IF (IVERSION<7) THEN
- YRECFM='TEB_CAN_LMO '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TCP%XLMO(:,1),IRESP)
- DO JLAYER = 2,TCP%NLVL
- TCP%XLMO(:,JLAYER) = TCP%XLMO(:,1)
+ IF (IVERSION<7 .OR. HSURF/="TOWN ") THEN
+ YRECFM=TRIM(YBASE)//'_LMO '
+ CALL READ_SURF(HPROGRAM,YRECFM,SB%XLMO(:,1),IRESP)
+ DO JLAYER = 2,SB%NLVL
+ SB%XLMO(:,JLAYER) = SB%XLMO(:,1)
ENDDO
ELSE
- DO JLAYER=1,TCP%NLVL
- WRITE(YRECFM,'(A10,I2.2)') 'TEB_CAN_MO',JLAYER
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TCP%XLMO(:,JLAYER),IRESP)
+ DO JLAYER=1,SB%NLVL
+ WRITE(YRECFM,'(A10,I2.2)') TRIM(YBASE)//'_MO',JLAYER
+ CALL READ_SURF(HPROGRAM,YRECFM,SB%XLMO(:,JLAYER),IRESP)
ENDDO
ENDIF
!
!* Pressure
- DO JLAYER=1,TCP%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'TEB_CAN_P',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TCP%XP(:,JLAYER),IRESP)
+ DO JLAYER=1,SB%NLVL
+ WRITE(YRECFM,YFORMAT) TRIM(YBASE)//'_P',JLAYER
+ CALL READ_SURF(HPROGRAM,YRECFM,SB%XP(:,JLAYER),IRESP)
END DO
!
ELSE
- TCP%XU (:,:) = XUNDEF
- TCP%XT (:,:) = XUNDEF
- TCP%XQ (:,:) = XUNDEF
- TCP%XTKE(:,:) = XUNDEF
- TCP%XLMO(:,:) = XUNDEF
- TCP%XP (:,:) = XUNDEF
+ SB%XU (:,:) = XUNDEF
+ SB%XT (:,:) = XUNDEF
+ SB%XQ (:,:) = XUNDEF
+ SB%XTKE(:,:) = XUNDEF
+ SB%XLMO(:,:) = XUNDEF
+ SB%XP (:,:) = XUNDEF
ENDIF
!
-!* mixing length
-!
-ALLOCATE(TCP%XLM(ILU,TCP%NLVL))
-!
-!* dissipative length
-!
-ALLOCATE(TCP%XLEPS(ILU,TCP%NLVL))
+IF (HSURF=="TOWN ") THEN
+ !
+ !* mixing length
+ !
+ ALLOCATE(SB%XLM(ILU,SB%NLVL))
+ !
+ !* dissipative length
+ !
+ ALLOCATE(SB%XLEPS(ILU,SB%NLVL))
+ !
+ENDIF
!
!
!* Grid characteristics
@@ -247,12 +264,13 @@ ALLOCATE(TCP%XLEPS(ILU,TCP%NLVL))
! --------------------------------- XZ(k-1) XDZ(k-1) V
! - - - - - - - - - - - - - - - - - XZf(k-1)
!
-ALLOCATE(TCP%XDZ (ILU,TCP%NLVL))
-ALLOCATE(TCP%XZF (ILU,TCP%NLVL))
-ALLOCATE(TCP%XDZF(ILU,TCP%NLVL))
- CALL CANOPY_GRID(ILU,TCP%NLVL,TCP%XZ,TCP%XZF,TCP%XDZ,TCP%XDZF)
+ALLOCATE(SB%XDZ (ILU,SB%NLVL))
+ALLOCATE(SB%XZF (ILU,SB%NLVL))
+ALLOCATE(SB%XDZF(ILU,SB%NLVL))
+!
+ CALL CANOPY_GRID(ILU,SB)
!
-IF (LHOOK) CALL DR_HOOK('READ_TEB_CANOPY_N',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('READ_SBL_N',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
-END SUBROUTINE READ_TEB_CANOPY_n
+END SUBROUTINE READ_SBL_n
diff --git a/src/SURFEX/read_seaflux_confn.F90 b/src/SURFEX/read_seaflux_confn.F90
index b3e73f5d111387519a2a72d7c982c5a2d44afcb4..14aecd2145a9da614f5fc13e9aeb00d04f6089aa 100644
--- a/src/SURFEX/read_seaflux_confn.F90
+++ b/src/SURFEX/read_seaflux_confn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_SEAFLUX_CONF_n (CHS, DGO, DGS, DGSI, O, S, &
- HPROGRAM)
+ SUBROUTINE READ_SEAFLUX_CONF_n (CHS, DOC, DGO, DGMSI, O, S, HPROGRAM)
! #############################################################
!
!!**** *READ_SEAFLUX_CONF* - routine to read the configuration for SEAFLUX
@@ -50,8 +49,8 @@
!
USE MODD_CH_SEAFLUX_n, ONLY : CH_SEAFLUX_t
USE MODD_DIAG_OCEAN_n, ONLY : DIAG_OCEAN_t
-USE MODD_DIAG_SEAFLUX_n, ONLY : DIAG_SEAFLUX_t
-USE MODD_DIAG_SEAICE_n, ONLY : DIAG_SEAICE_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
+USE MODD_DIAG_MISC_SEAICE_n, ONLY : DIAG_MISC_SEAICE_t
USE MODD_OCEAN_n, ONLY : OCEAN_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
!
@@ -80,9 +79,9 @@ IMPLICIT NONE
!
!
TYPE(CH_SEAFLUX_t), INTENT(INOUT) :: CHS
-TYPE(DIAG_OCEAN_t), INTENT(INOUT) :: DGO
-TYPE(DIAG_SEAFLUX_t), INTENT(INOUT) :: DGS
-TYPE(DIAG_SEAICE_t), INTENT(INOUT) :: DGSI
+TYPE(DIAG_OCEAN_t), INTENT(INOUT) :: DOC
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_MISC_SEAICE_t), INTENT(INOUT) :: DGMSI
TYPE(OCEAN_t), INTENT(INOUT) :: O
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
!
@@ -102,16 +101,16 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* get output listing file logical unit
!
IF (LHOOK) CALL DR_HOOK('READ_SEAFLUX_CONF_N',0,ZHOOK_HANDLE)
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
+CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
IMI=GET_CURRENT_MODEL_INDEX_SURFEX()
!
IF (IMI.NE.-1 .AND. LNAM_READ) THEN
CALL INIT_NAM_SEAFLUXn(O, S)
- CALL INIT_NAM_DIAG_SURFn(DGS)
+ CALL INIT_NAM_DIAG_SURFn(DGO)
CALL INIT_NAM_CH_SEAFLUXn(CHS)
- CALL INIT_NAM_DIAG_OCEANn(DGO)
- CALL INIT_NAM_SEAICEn(DGSI, S)
+ CALL INIT_NAM_DIAG_OCEANn(DOC)
+ CALL INIT_NAM_SEAICEn(DGMSI, S)
ENDIF
!
IF (LNAM_READ) THEN
@@ -129,7 +128,7 @@ IF (LNAM_READ) THEN
IF (GFOUND) READ(UNIT=INAM,NML=NAM_DIAG_SURFn)
CALL POSNAM(INAM,'NAM_CH_SEAFLUXN',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=INAM,NML=NAM_CH_SEAFLUXn)
- CALL POSNAM(INAM,'NAM_DIAG_OCEANN',GFOUND,ILUOUT)
+CALL POSNAM(INAM,'NAM_DIAG_OCEANN',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=INAM,NML=NAM_DIAG_OCEANn)
!
CALL POSNAM(INAM,'NAM_SEAICEN',GFOUND,ILUOUT)
@@ -153,10 +152,10 @@ ENDIF
!
IF (IMI.NE.-1) THEN
CALL UPDATE_NAM_SEAFLUXn(O, S)
- CALL UPDATE_NAM_DIAG_SURFn(DGS)
+ CALL UPDATE_NAM_DIAG_SURFn(DGO)
CALL UPDATE_NAM_CH_SEAFLUXn(CHS)
- CALL UPDATE_NAM_DIAG_OCEANn(DGO)
- CALL UPDATE_NAM_SEAICEn(DGSI, S)
+ CALL UPDATE_NAM_DIAG_OCEANn(DOC)
+ CALL UPDATE_NAM_SEAICEn(DGMSI, S)
ENDIF
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/read_seaflux_date.F90 b/src/SURFEX/read_seaflux_date.F90
index 1dbaa072f09953a11dbfe323459af859e4b91439..110b7ea6c04c201c1fe16ef299b817c3aebf4f8d 100644
--- a/src/SURFEX/read_seaflux_date.F90
+++ b/src/SURFEX/read_seaflux_date.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_SEAFLUX_DATE (O, &
+ SUBROUTINE READ_SEAFLUX_DATE (OMERCATOR, &
HPROGRAM,HINIT,KLUOUT,HATMFILE,HATMFILETYPE,&
KYEAR,KMONTH,KDAY,PTIME,TPTIME)
! #######################################################
@@ -64,8 +64,7 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-TYPE(OCEAN_t), INTENT(INOUT) :: O
+LOGICAL, INTENT(IN) :: OMERCATOR
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
CHARACTER(LEN=3), INTENT(IN) :: HINIT ! fields to initialize 'ALL', 'PRE', 'PGD'
@@ -119,7 +118,7 @@ END IF
IF (TPTIME%TDATE%YEAR==NUNDEF.OR.TPTIME%TDATE%MONTH==NUNDEF &
.OR.TPTIME%TDATE%DAY==NUNDEF.OR.TPTIME%TIME==XUNDEF) THEN
!
- CALL READ_PREP_SEAFLUX_CONF(O, &
+ CALL READ_PREP_SEAFLUX_CONF(OMERCATOR, &
HPROGRAM,'DATE ',YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,&
HATMFILE,HATMFILETYPE,YFILEPGDIN,YFILEPGDINTYPE,KLUOUT,GUNIF)
!
diff --git a/src/SURFEX/read_seaflux_sbln.F90 b/src/SURFEX/read_seaflux_sbln.F90
deleted file mode 100644
index d079d8a8909a5165c45d085ad6ffddcd521b4a85..0000000000000000000000000000000000000000
--- a/src/SURFEX/read_seaflux_sbln.F90
+++ /dev/null
@@ -1,234 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE READ_SEAFLUX_SBL_n (DTCO, S, SSB, U, &
- HPROGRAM)
-! #########################################
-!
-!!**** *READ_SEAFLUX_SBL_n* - reads SEAFLUX fields
-!!
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2003
-!! E. Martin 01/2012 Add LSBL_COLD_START
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!
-!
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
-USE MODD_SEAFLUX_SBL_n, ONLY : SEAFLUX_SBL_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE MODI_READ_SURF
-USE MODI_CANOPY_GRID
-USE MODI_GET_TYPE_DIM_n
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
-!
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(SEAFLUX_t), INTENT(INOUT) :: S
-TYPE(SEAFLUX_SBL_t), INTENT(INOUT) :: SSB
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
-!
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-!
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=3) :: YREAD
-INTEGER :: ILU ! 1D physical dimension
-INTEGER :: IRESP ! Error code after redding
-INTEGER :: JLAYER ! loop counter on layers
-INTEGER :: IVERSION, IBUGFIX
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-!* 1D physical dimension
-!
-IF (LHOOK) CALL DR_HOOK('READ_SEAFLUX_SBL_N',0,ZHOOK_HANDLE)
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'SEA ',ILU)
-!
-YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
-!
-YRECFM='BUG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IBUGFIX,IRESP)
-!
-!* flag to use or not SBL levels
-!
-YRECFM='SEA_SBL'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,S%LSBL,IRESP)
-!
-IF (.NOT.S%LSBL) THEN
- ALLOCATE(SSB%XZ (0,0))
- ALLOCATE(SSB%XU (0,0))
- ALLOCATE(SSB%XT (0,0))
- ALLOCATE(SSB%XQ (0,0))
- ALLOCATE(SSB%XTKE(0,0))
- ALLOCATE(SSB%XLMO(0) )
- ALLOCATE(SSB%XP (0,0))
- ALLOCATE(SSB%XDZ (0,0))
- ALLOCATE(SSB%XZF (0,0))
- ALLOCATE(SSB%XDZF(0,0))
- IF (LHOOK) CALL DR_HOOK('READ_SEAFLUX_SBL_N',1,ZHOOK_HANDLE)
- RETURN
-ENDIF
-!
-!* number of vertical levels
-!
-YRECFM='SEA_SBL_LVL'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,SSB%NLVL,IRESP)
-!
-!* 2. Prognostic fields:
-! -----------------
-!
-!* altitudes
-!
-ALLOCATE(SSB%XZ(ILU,SSB%NLVL))
-!
-DO JLAYER=1,SSB%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'SEA_SBL_Z',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,SSB%XZ(:,JLAYER),IRESP)
-END DO
-!
-ALLOCATE(SSB%XU (ILU,SSB%NLVL))
-ALLOCATE(SSB%XT (ILU,SSB%NLVL))
-ALLOCATE(SSB%XQ (ILU,SSB%NLVL))
-ALLOCATE(SSB%XTKE(ILU,SSB%NLVL))
-ALLOCATE(SSB%XLMO(ILU) )
-ALLOCATE(SSB%XP (ILU,SSB%NLVL))
-!
-IF (IVERSION>7 .OR. IVERSION==7 .AND.IBUGFIX>=2) THEN
- YRECFM='STORAGETYPE'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,YREAD,IRESP)
-ELSE
- YREAD = 'ALL'
-ENDIF
-!
-IF(YREAD=='ALL') THEN
- !
- !* wind in SBL
- DO JLAYER=1,SSB%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'SEA_SBL_U',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,SSB%XU(:,JLAYER),IRESP)
- END DO
- !
- !* theta in SBL
- DO JLAYER=1,SSB%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'SEA_SBL_T',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,SSB%XT(:,JLAYER),IRESP)
- END DO
- !
- !* humidity in SBL
- DO JLAYER=1,SSB%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'SEA_SBL_Q',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,SSB%XQ(:,JLAYER),IRESP)
- END DO
- !
- !* Tke in SBL
- DO JLAYER=1,SSB%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'SEA_SBL_E',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,SSB%XTKE(:,JLAYER),IRESP)
- END DO
- !
- !* Monin-Obhukov length
- YRECFM='SEA_SBL_LMO '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,SSB%XLMO(:),IRESP)
- !
- !* Pressure
- DO JLAYER=1,SSB%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'SEA_SBL_P',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,SSB%XP(:,JLAYER),IRESP)
- END DO
- !
-ELSE
- SSB%XU (:,:) = XUNDEF
- SSB%XT (:,:) = XUNDEF
- SSB%XQ (:,:) = XUNDEF
- SSB%XTKE(:,:) = XUNDEF
- SSB%XLMO(:) = XUNDEF
- SSB%XP (:,:) = XUNDEF
-ENDIF
-!
-!
-!* Grid characteristics
-!
-!
-! --------------------------------- XZ(k+1) XDZ(k+1)
-! ^
-! |
-! |
-! - - - - - - - - - - - - - - - - - XZf(k+1) | XDZf(k+1)
-! ^ |
-! | |
-! --------------------------------- XZ(k), XU, XT, XQ, XTKE | XDZ(k) V
-! | ^
-! - - - - - - - - - - - - - - - - - XZf(k) V | XDZf(k)
-! --------------------------------- XZ(k-1) XDZ(k-1) V
-! - - - - - - - - - - - - - - - - - XZf(k-1)
-!
-ALLOCATE(SSB%XDZ (ILU,SSB%NLVL))
-ALLOCATE(SSB%XZF (ILU,SSB%NLVL))
-ALLOCATE(SSB%XDZF(ILU,SSB%NLVL))
- CALL CANOPY_GRID(ILU,SSB%NLVL,SSB%XZ,SSB%XZF,SSB%XDZ,SSB%XDZF)
-!
-IF (LHOOK) CALL DR_HOOK('READ_SEAFLUX_SBL_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE READ_SEAFLUX_SBL_n
diff --git a/src/SURFEX/read_seafluxn.F90 b/src/SURFEX/read_seafluxn.F90
index 875ea8da44170a0594516e606598950f2ad27ada..64ed006a2f44eb7ec9052eaae6668bf8aeb93b17 100644
--- a/src/SURFEX/read_seafluxn.F90
+++ b/src/SURFEX/read_seafluxn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_SEAFLUX_n (DTCO, SG, S, U, &
- HPROGRAM,KLUOUT)
+ SUBROUTINE READ_SEAFLUX_n (DTCO, G, S, U, HPROGRAM,KLUOUT)
! #########################################
!
!!**** *READ_SEAFLUX_n* - read SEAFLUX varaibles
@@ -46,7 +45,7 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_SEAFLUX_GRID_n, ONLY : SEAFLUX_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
@@ -68,24 +67,24 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(SEAFLUX_GRID_t), INTENT(INOUT) :: SG
+TYPE(GRID_t), INTENT(INOUT) :: G
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
INTEGER, INTENT(IN) :: KLUOUT
!
!* 0.2 Declarations of local variables
! -------------------------------
!
INTEGER :: JMTH, INMTH
- CHARACTER(LEN=2 ) :: YMTH
+CHARACTER(LEN=2 ) :: YMTH
!
INTEGER :: ILU ! 1D physical dimension
!
INTEGER :: IRESP ! Error code after redding
!
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
!
INTEGER :: IVERSION ! surface version
!
@@ -98,8 +97,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('READ_SEAFLUX_N',0,ZHOOK_HANDLE)
!
YRECFM='SIZE_SEA'
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'SEA ',ILU)
+CALL GET_TYPE_DIM_n(DTCO, U, 'SEA ',ILU)
!
!* 2. Prognostic fields:
! -----------------
@@ -117,20 +115,17 @@ IF(S%LINTERPOL_SST)THEN
DO JMTH=1,INMTH
WRITE(YMTH,'(I2)') (JMTH-1)
YRECFM='SST_MTH'//ADJUSTL(YMTH(:LEN_TRIM(YMTH)))
- CALL READ_SURF(&
- HPROGRAM,YRECFM,S%XSST_MTH(:,JMTH),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XSST_MTH(:,JMTH),IRESP)
ENDDO
!
- CALL INTERPOL_SST_MTH(S, &
- S%TTIME%TDATE%YEAR,S%TTIME%TDATE%MONTH,S%TTIME%TDATE%DAY,'T',S%XSST)
+ CALL INTERPOL_SST_MTH(S,'T')
!
ELSE
!
ALLOCATE(S%XSST_MTH(0,0))
!
YRECFM='SST'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,S%XSST(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XSST(:),IRESP)
!
ENDIF
!
@@ -138,8 +133,7 @@ ENDIF
!
ALLOCATE(S%XPERTFLUX(ILU))
IF( S%LPERTFLUX ) THEN
- CALL READ_SURF(&
- HPROGRAM,'PERTSEAFLUX',S%XPERTFLUX(:),IRESP)
+ CALL READ_SURF(HPROGRAM,'PERTSEAFLUX',S%XPERTFLUX(:),IRESP)
ELSE
S%XPERTFLUX(:) = 0.
ENDIF
@@ -154,18 +148,15 @@ ENDIF
ALLOCATE(S%XZ0(ILU))
YRECFM='Z0SEA'
S%XZ0(:) = 0.001
- CALL READ_SURF(&
- HPROGRAM,YRECFM,S%XZ0(:),IRESP)
+CALL READ_SURF(HPROGRAM,YRECFM,S%XZ0(:),IRESP)
!
!* flag to use or not the SeaIce model
!
- CALL READ_SURF(&
- HPROGRAM,'VERSION',IVERSION,IRESP)
+CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
IF (IVERSION <8) THEN
S%LHANDLE_SIC=.FALSE.
ELSE
- CALL READ_SURF(&
- HPROGRAM,'HANDLE_SIC',S%LHANDLE_SIC,IRESP)
+ CALL READ_SURF(HPROGRAM,'HANDLE_SIC',S%LHANDLE_SIC,IRESP)
ENDIF
!
!
@@ -185,21 +176,18 @@ IF(S%LINTERPOL_SSS)THEN
DO JMTH=1,INMTH
WRITE(YMTH,'(I2)') (JMTH-1)
YRECFM='SSS_MTH'//ADJUSTL(YMTH(:LEN_TRIM(YMTH)))
- CALL READ_SURF(&
- HPROGRAM,YRECFM,S%XSSS_MTH(:,JMTH),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XSSS_MTH(:,JMTH),IRESP)
CALL CHECK_SEA(YRECFM,S%XSSS_MTH(:,JMTH))
ENDDO
!
- CALL INTERPOL_SST_MTH(S, &
- S%TTIME%TDATE%YEAR,S%TTIME%TDATE%MONTH,S%TTIME%TDATE%DAY,'S',S%XSSS)
+ CALL INTERPOL_SST_MTH(S,'S')
!
ELSEIF (IVERSION>=8) THEN
!
ALLOCATE(S%XSSS_MTH(0,0))
!
YRECFM='SSS'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,S%XSSS,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XSSS,IRESP)
IF(S%LHANDLE_SIC)THEN
CALL CHECK_SEA(YRECFM,S%XSSS(:))
ENDIF
@@ -214,12 +202,10 @@ ALLOCATE(S%XSCA_ALB (ILU))
IF(S%CSEA_ALB=='RS14')THEN
!
YRECFM='OSA_DIR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,S%XDIR_ALB(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XDIR_ALB(:),IRESP)
!
YRECFM='OSA_SCA'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,S%XSCA_ALB(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XSCA_ALB(:),IRESP)
!
ELSE
!
@@ -231,7 +217,7 @@ ENDIF
IF (LHOOK) CALL DR_HOOK('READ_SEAFLUX_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
!
SUBROUTINE CHECK_SEA(HFIELD,PFIELD)
@@ -239,7 +225,7 @@ SUBROUTINE CHECK_SEA(HFIELD,PFIELD)
!
IMPLICIT NONE
!
- CHARACTER(LEN=LEN_HREC), INTENT(IN) :: HFIELD
+CHARACTER(LEN=LEN_HREC), INTENT(IN) :: HFIELD
REAL, DIMENSION(:), INTENT(IN) :: PFIELD
!
REAL :: ZMAX,ZMIN
@@ -258,7 +244,7 @@ DO JI=1,ILU
IF(PFIELD(JI)>ZMAX.OR.PFIELD(JI)<ZMIN)THEN
IERRC=IERRC+1
WRITE(KLUOUT,*)'PROBLEM FIELD '//TRIM(HFIELD)//' =',PFIELD(JI),&
- 'NOT REALISTIC AT LOCATION (LAT/LON)',SG%XLAT(JI),SG%XLON(JI)
+ 'NOT REALISTIC AT LOCATION (LAT/LON)',G%XLAT(JI),G%XLON(JI)
ENDIF
ENDDO
!
diff --git a/src/SURFEX/read_seaicen.F90 b/src/SURFEX/read_seaicen.F90
index 56b873f543df6ed582d374b852dff28c712073b4..167b3c89bfcb773652293140e77655d7e4486f54 100644
--- a/src/SURFEX/read_seaicen.F90
+++ b/src/SURFEX/read_seaicen.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_SEAICE_n (&
- SG, S, &
- HPROGRAM,KLU,KLUOUT)
+ SUBROUTINE READ_SEAICE_n (G, S, HPROGRAM,KLU,KLUOUT)
! #########################################
!
!!**** *READ_SEAICE_n* - read seaice scheme variables
@@ -47,7 +45,7 @@
!
!
!
-USE MODD_SEAFLUX_GRID_n, ONLY : SEAFLUX_GRID_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
!
USE MODD_CSTS, ONLY : XPI, XTTSI, XTT
@@ -70,7 +68,6 @@ USE MODI_INTERPOL_SST_MTH
!
USE MODI_GET_LUOUT
USE MODI_ABOR1_SFX
-USE MODD_SURFEX_OMP, ONLY : NBLOCKTOT
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -83,10 +80,10 @@ IMPLICIT NONE
!
!
!
-TYPE(SEAFLUX_GRID_t), INTENT(INOUT) :: SG
+TYPE(GRID_t), INTENT(INOUT) :: G
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
INTEGER, INTENT(IN) :: KLU ! number of sea patch point
INTEGER, INTENT(IN) :: KLUOUT
!
@@ -96,13 +93,13 @@ INTEGER, INTENT(IN) :: KLUOUT
INTEGER :: IRESP ! Error code after reading
!
INTEGER :: JMTH, INMTH
- CHARACTER(LEN=2 ) :: YMTH
- CHARACTER(LEN=5) :: YLVL
+CHARACTER(LEN=2 ) :: YMTH
+CHARACTER(LEN=5) :: YLVL
!
- CHARACTER(LEN=LEN_HREC) :: YCATEG ! category to read
- CHARACTER(LEN=LEN_HREC) :: YLEVEL ! Level to read
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=200) :: YMESS ! Error Message
+CHARACTER(LEN=LEN_HREC) :: YCATEG ! category to read
+CHARACTER(LEN=LEN_HREC) :: YLEVEL ! Level to read
+CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=200) :: YMESS ! Error Message
!
INTEGER :: JX,JK,JL ! loop counter on ice categories and layers and grid points
INTEGER :: inl_in_file,int_in_file ! file values for ice catgories and layers numbers
@@ -141,13 +138,11 @@ IF(S%LINTERPOL_SIC)THEN
DO JMTH=1,INMTH
WRITE(YMTH,'(I2)') (JMTH-1)
YRECFM='SIC_MTH'//ADJUSTL(YMTH(:LEN_TRIM(YMTH)))
- CALL READ_SURF(&
- HPROGRAM,YRECFM,S%XSIC_MTH(:,JMTH),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XSIC_MTH(:,JMTH),IRESP)
CALL CHECK_SEAICE(YRECFM,S%XSIC_MTH(:,JMTH))
ENDDO
!
- CALL INTERPOL_SST_MTH(S, &
- S%TTIME%TDATE%YEAR,S%TTIME%TDATE%MONTH,S%TTIME%TDATE%DAY,'C',S%XFSIC)
+ CALL INTERPOL_SST_MTH(S,'C')
!
IF (ANY(S%XFSIC(:)>1.0).OR.ANY(S%XFSIC(:)<0.0)) THEN
CALL ABOR1_SFX('READ_SEAICE_n: FSIC should be >=0 and <=1')
@@ -166,12 +161,7 @@ ENDIF
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
- CALL READ_SURF(&
- HPROGRAM,'SEAICE_SCHEM',S%CSEAICE_SCHEME,IRESP)
-!
-IF (TRIM(S%CSEAICE_SCHEME) == 'GELATO' .AND. (NBLOCKTOT>1)) THEN
- CALL ABOR1_SFX("READ_SEAICE_n: GELATO CANNOT YET RUN MULTI-THREAD")
-ENDIF
+CALL READ_SURF(HPROGRAM,'SEAICE_SCHEM',S%CSEAICE_SCHEME,IRESP)
!
IF (TRIM(S%CSEAICE_SCHEME) == 'NONE' ) THEN
IF (S%LINTERPOL_SIC ) THEN
@@ -201,7 +191,7 @@ IF(LCPL_SEAICE)THEN
ENDIF
nxglo=nx
#if ! defined in_arpege
- CALL mpp_sum(nxglo) ! Should also sum up over NPROMA blocks, in Arpege; but not that easy....
+CALL mpp_sum(nxglo) ! Should also sum up over NPROMA blocks, in Arpege; but not that easy....
#else
IF (NPRINTO > 0) THEN
WRITE(KLUOUT,*)'Gelato cannot yet compute global averages when running in Arpege (because of collective comm vs. NPROMA blocks)'
@@ -234,22 +224,20 @@ ENDIF
!
! Supersedes Gelato hard defaults with a Gelato genuine namelist
! if available (for Gelato wizzards !)
- CALL GLTOOLS_READNAM(.FALSE.,KLUOUT)
+CALL GLTOOLS_READNAM(.FALSE.,KLUOUT)
!
ny=1
nyglo=1
- CALL GLTOOLS_ALLOC(S%TGLT)
+CALL GLTOOLS_ALLOC(S%TGLT)
!
!* 0. Check dimensions : number of layers and ice categories
!
- CALL READ_SURF(&
- HPROGRAM,'ICENL',inl_in_file,IRESP)
+CALL READ_SURF(HPROGRAM,'ICENL',inl_in_file,IRESP)
IF (inl_in_file /= nl) THEN
WRITE(YMESS,'("Mismatch in # of seaice layers : prep=",I2," nml=",I2)') inl_in_file, nl
CALL ABOR1_SFX(YMESS)
END IF
- CALL READ_SURF(&
- HPROGRAM,'ICENT',int_in_file,IRESP)
+CALL READ_SURF(HPROGRAM,'ICENT',int_in_file,IRESP)
IF (int_in_file /= nt) THEN
WRITE(YMESS,'("Mismatch in # of seaice categories : prep=",I2," nml=",I2)') int_in_file, nt
CALL ABOR1_SFX(YMESS)
@@ -257,8 +245,7 @@ END IF
!
!* 1. (Semi-)prognostic fields with only space dimension(s) :
!
- CALL READ_SURF(&
- HPROGRAM,'ICEUSTAR',S%TGLT%ust(:,1),IRESP)
+CALL READ_SURF(HPROGRAM,'ICEUSTAR',S%TGLT%ust(:,1),IRESP)
!
!* 2. Prognostic fields with space and ice-category dimension(s) :
!
@@ -266,32 +253,23 @@ DO JK=1,nt
WRITE(YLVL,'(I2)') JK
YCATEG='_'//ADJUSTL(YLVL)
! .. Read sea ice age for type JK
- CALL READ_SURF(&
- HPROGRAM,'ICEAGE'//YCATEG,S%TGLT%sit(JK,:,1)%age,IRESP)
+ CALL READ_SURF(HPROGRAM,'ICEAGE'//YCATEG,S%TGLT%sit(JK,:,1)%age,IRESP)
! .. Read melt pond volume for type JK
- CALL READ_SURF(&
- HPROGRAM,'ICEVMP'//YCATEG,S%TGLT%sit(JK,:,1)%vmp,IRESP)
+ CALL READ_SURF(HPROGRAM,'ICEVMP'//YCATEG,S%TGLT%sit(JK,:,1)%vmp,IRESP)
! .. Read sea ice surface albedo for type JK
- CALL READ_SURF(&
- HPROGRAM,'ICEASN'//YCATEG,S%TGLT%sit(JK,:,1)%asn,IRESP)
+ CALL READ_SURF(HPROGRAM,'ICEASN'//YCATEG,S%TGLT%sit(JK,:,1)%asn,IRESP)
! .. Read sea ice fraction for type JK
- CALL READ_SURF(&
- HPROGRAM,'ICEFSI'//YCATEG, S%TGLT%sit(JK,:,1)%fsi,IRESP)
+ CALL READ_SURF(HPROGRAM,'ICEFSI'//YCATEG, S%TGLT%sit(JK,:,1)%fsi,IRESP)
! .. Read sea ice thickness for type JK
- CALL READ_SURF(&
- HPROGRAM,'ICEHSI'//YCATEG, S%TGLT%sit(JK,:,1)%hsi,IRESP)
+ CALL READ_SURF(HPROGRAM,'ICEHSI'//YCATEG, S%TGLT%sit(JK,:,1)%hsi,IRESP)
! .. Read sea ice salinity for type JK
- CALL READ_SURF(&
- HPROGRAM,'ICESSI'//YCATEG, S%TGLT%sit(JK,:,1)%ssi,IRESP)
+ CALL READ_SURF(HPROGRAM,'ICESSI'//YCATEG, S%TGLT%sit(JK,:,1)%ssi,IRESP)
! .. Read sea ice surface temperature for type JK
- CALL READ_SURF(&
- HPROGRAM,'ICETSF'//YCATEG, S%TGLT%sit(JK,:,1)%tsf,IRESP)
+ CALL READ_SURF(HPROGRAM,'ICETSF'//YCATEG, S%TGLT%sit(JK,:,1)%tsf,IRESP)
! .. Read snow thickness for type JK
- CALL READ_SURF(&
- HPROGRAM,'ICEHSN'//YCATEG, S%TGLT%sit(JK,:,1)%hsn,IRESP)
+ CALL READ_SURF(HPROGRAM,'ICEHSN'//YCATEG, S%TGLT%sit(JK,:,1)%hsn,IRESP)
! .. Read snow density for type JK
- CALL READ_SURF(&
- HPROGRAM,'ICERSN'//YCATEG, S%TGLT%sit(JK,:,1)%rsn,IRESP)
+ CALL READ_SURF(HPROGRAM,'ICERSN'//YCATEG, S%TGLT%sit(JK,:,1)%rsn,IRESP)
!
!* 3. Prognostic fields with space, ice-category and layer dimensions :
!
@@ -299,8 +277,7 @@ DO JK=1,nt
WRITE(YLVL,'(I2)') JL
YLEVEL=YCATEG(1:LEN_TRIM(YCATEG))//'_'//ADJUSTL(YLVL)
! .. Read sea ice vertical gltools_enthalpy profile for type JK and level JL
- CALL READ_SURF(&
- HPROGRAM,'ICEH'//YLEVEL, S%TGLT%sil(JL,JK,:,1)%ent,IRESP)
+ CALL READ_SURF(HPROGRAM,'ICEH'//YLEVEL, S%TGLT%sil(JL,JK,:,1)%ent,IRESP)
END DO
END DO
!
@@ -361,22 +338,22 @@ S%TGLT%dom(:,1)%vmk=1
!
! lat,lon,srf are inherited from seaflux grid
!
-S%TGLT%dom(:,1)%lon=SG%XLON(:)*XPI/180.
-S%TGLT%dom(:,1)%lat=SG%XLAT(:)*XPI/180.
+S%TGLT%dom(:,1)%lon=G%XLON(:)*XPI/180.
+S%TGLT%dom(:,1)%lat=G%XLAT(:)*XPI/180.
!
! Except in Gelato dynamics, mesh lengths are used only to compute mesh area
! Hence, a simple setting can be used
!
-S%TGLT%dom(:,1)%dxc=SG%XMESH_SIZE(:)**0.5
+S%TGLT%dom(:,1)%dxc=G%XMESH_SIZE(:)**0.5
S%TGLT%dom(:,1)%dyc=S%TGLT%dom(:,1)%dxc
-S%TGLT%dom(:,1)%srf=SG%XMESH_SIZE(:)
+S%TGLT%dom(:,1)%srf=G%XMESH_SIZE(:)
!
! Surface of local and global ocean domain (ghost points are masked out)
!
xdomsrf = SUM( S%TGLT%dom(:,1)%srf, MASK=(S%TGLT%dom(:,1)%tmk==1) )
xdomsrf_g = xdomsrf
#if ! defined in_arpege
- CALL mpp_sum(xdomsrf_g)
+CALL mpp_sum(xdomsrf_g)
#else
! Avoid zero divide in Gelato computation of global area averages
xdomsrf_g = MAX(xdomsrf_g, 1.e-9)
@@ -410,13 +387,11 @@ IF(S%LINTERPOL_SIT)THEN
DO JMTH=1,INMTH
WRITE(YMTH,'(I2)') (JMTH-1)
YRECFM='SIT_MTH'//ADJUSTL(YMTH(:LEN_TRIM(YMTH)))
- CALL READ_SURF(&
- HPROGRAM,YRECFM,S%XSIT_MTH(:,JMTH),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,S%XSIT_MTH(:,JMTH),IRESP)
CALL CHECK_SEAICE(YRECFM,S%XSIT_MTH(:,JMTH))
ENDDO
!
- CALL INTERPOL_SST_MTH(S, &
- S%TTIME%TDATE%YEAR,S%TTIME%TDATE%MONTH,S%TTIME%TDATE%DAY,'H',S%XFSIT)
+ CALL INTERPOL_SST_MTH(S,'H')
!
ELSE
!
@@ -428,7 +403,7 @@ ENDIF
!! Initialize the coupling variables with 'snapshot' prognostic variables
! (for now, averaged over ice categories)
!
- CALL GLT_SNDATMF( S%TGLT, XTTSI - XTT )
+CALL GLT_SNDATMF( S%TGLT, XTTSI - XTT )
S%XSIC(:) = S%TGLT%ice_atm(1,:,1)%fsi
S%XTICE(:) = S%TGLT%ice_atm(1,:,1)%tsf
S%XICE_ALB(:) = S%TGLT%ice_atm(1,:,1)%alb
@@ -439,7 +414,7 @@ S%TGLT%oce_all(:,1)%tml=S%XSST(:)
IF (LHOOK) CALL DR_HOOK('READ_SEAICE_n',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
!
SUBROUTINE CHECK_SEAICE(HFIELD,PFIELD)
@@ -447,7 +422,7 @@ SUBROUTINE CHECK_SEAICE(HFIELD,PFIELD)
!
IMPLICIT NONE
!
- CHARACTER(LEN=LEN_HREC), INTENT(IN) :: HFIELD
+CHARACTER(LEN=LEN_HREC), INTENT(IN) :: HFIELD
REAL, DIMENSION(:), INTENT(IN) :: PFIELD
!
REAL :: ZMAX,ZMIN
@@ -466,7 +441,7 @@ DO JI=1,KLU
IF(PFIELD(JI)>ZMAX.OR.PFIELD(JI)<ZMIN)THEN
IERRC=IERRC+1
WRITE(KLUOUT,*)'PROBLEM FIELD '//TRIM(HFIELD)//' =',PFIELD(JI),&
- 'NOT REALISTIC AT LOCATION (LAT/LON)',SG%XLAT(JI),SG%XLON(JI)
+ 'NOT REALISTIC AT LOCATION (LAT/LON)',G%XLAT(JI),G%XLON(JI)
ENDIF
ENDDO
!
diff --git a/src/SURFEX/read_sso_canopyn.F90 b/src/SURFEX/read_sso_canopyn.F90
index ec8ae439add13540aa52b07674efe292e901c14d..5f69469afedaed01826199cfe1a76308068fc9e5 100644
--- a/src/SURFEX/read_sso_canopyn.F90
+++ b/src/SURFEX/read_sso_canopyn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########################################
- SUBROUTINE READ_SSO_CANOPY_n (DTCO, SSCP, U, &
- HPROGRAM,HINIT)
+ SUBROUTINE READ_SSO_CANOPY_n (DTCO, SB, U, HPROGRAM,HINIT)
! #########################################
!
!!**** *READ_SSO_CANOPY_n* - reads SSO fields
@@ -45,7 +44,7 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_SSO_CANOPY_n, ONLY : SSO_CANOPY_t
+USE MODD_CANOPY_n, ONLY : CANOPY_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -65,7 +64,7 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(SSO_CANOPY_t), INTENT(INOUT) :: SSCP
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
@@ -87,26 +86,22 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* 1D physical dimension
!
IF (LHOOK) CALL DR_HOOK('READ_SSO_CANOPY_N',0,ZHOOK_HANDLE)
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'FULL ',ILU)
+ CALL GET_TYPE_DIM_n(DTCO, U, 'FULL ',ILU)
!
!* flag to use or not canopy levels
!
YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
!
YRECFM='BUG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IBUGFIX,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
!
IF (IVERSION<6.OR.HINIT=='PGD'.OR. HINIT=='PRE') THEN
GCANOPY = .FALSE.
ELSE
IF (IVERSION>7 .OR. IVERSION==7 .AND.IBUGFIX>=2) THEN
YRECFM='STORAGETYPE'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,YREAD,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,YREAD,IRESP)
ELSE
YREAD = 'ALL'
ENDIF
@@ -114,8 +109,7 @@ ELSE
GCANOPY = .FALSE.
ELSE
YRECFM='SSO_CANOPY'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,GCANOPY,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,GCANOPY,IRESP)
ENDIF
END IF
!
@@ -125,41 +119,36 @@ END IF
!* number of vertical levels
!
IF (.NOT. GCANOPY) THEN
- CALL SET_SSO_LEVELS(SSCP, &
- ILU)
+ CALL SET_SSO_LEVELS(SB, ILU)
ELSE
!
YRECFM='SSO_CAN_LVL'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,SSCP%NLVL,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,SB%NLVL,IRESP)
!
!
!* 3. Reading of Prognostic fields:
! -----------------------------
!
- ALLOCATE(SSCP%XZ(ILU,SSCP%NLVL))
- ALLOCATE(SSCP%XU(ILU,SSCP%NLVL))
- ALLOCATE(SSCP%XTKE(ILU,SSCP%NLVL))
+ ALLOCATE(SB%XZ(ILU,SB%NLVL))
+ ALLOCATE(SB%XU(ILU,SB%NLVL))
+ ALLOCATE(SB%XTKE(ILU,SB%NLVL))
!
!* altitudes
- DO JLAYER=1,SSCP%NLVL
+ DO JLAYER=1,SB%NLVL
WRITE(YRECFM,'(A9,I2.2,A1)') 'SSO_CAN_Z',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,SSCP%XZ(:,JLAYER),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,SB%XZ(:,JLAYER),IRESP)
END DO
!
!* wind in canopy
- DO JLAYER=1,SSCP%NLVL
+ DO JLAYER=1,SB%NLVL
WRITE(YRECFM,'(A9,I2.2,A1)') 'SSO_CAN_U',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,SSCP%XU(:,JLAYER),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,SB%XU(:,JLAYER),IRESP)
END DO
!
!* Tke in canopy
- DO JLAYER=1,SSCP%NLVL
+ DO JLAYER=1,SB%NLVL
WRITE(YRECFM,'(A9,I2.2,A1)') 'SSO_CAN_E',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,SSCP%XTKE(:,JLAYER),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,SB%XTKE(:,JLAYER),IRESP)
END DO
!
ENDIF
@@ -181,10 +170,11 @@ ENDIF
! --------------------------------- XZ(k-1) XDZ(k-1) V
! - - - - - - - - - - - - - - - - - XZf(k-1)
!
-ALLOCATE(SSCP%XDZ (ILU,SSCP%NLVL))
-ALLOCATE(SSCP%XZF (ILU,SSCP%NLVL))
-ALLOCATE(SSCP%XDZF(ILU,SSCP%NLVL))
- CALL CANOPY_GRID(ILU,SSCP%NLVL,SSCP%XZ,SSCP%XZF,SSCP%XDZ,SSCP%XDZF)
+ALLOCATE(SB%XDZ (ILU,SB%NLVL))
+ALLOCATE(SB%XZF (ILU,SB%NLVL))
+ALLOCATE(SB%XDZF(ILU,SB%NLVL))
+ CALL CANOPY_GRID(ILU,SB)
+!
IF (LHOOK) CALL DR_HOOK('READ_SSO_CANOPY_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/read_sson.F90 b/src/SURFEX/read_sson.F90
index d213f80c16bfe3a9da0a72fd28dfa4318e6506d0..a3a8ee3fa248f91c75b8fb543f58926a5025a8d2 100644
--- a/src/SURFEX/read_sson.F90
+++ b/src/SURFEX/read_sson.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_SSO_n (&
- U, USS, &
- HPROGRAM)
+ SUBROUTINE READ_SSO_n (KSIZE_FULL, PSEA, USS, HPROGRAM)
! ################################
!
!!**** *READ_SSO_n* - routine to read a file for
@@ -50,13 +48,7 @@
! ------------
!
!
-!
-!
-!
-!
-!
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODI_READ_SURF
!
@@ -71,10 +63,10 @@ IMPLICIT NONE
! -------------------------
!
!
+INTEGER, INTENT(IN) :: KSIZE_FULL
+REAL, DIMENSION(:), INTENT(IN) :: PSEA
!
-!
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
!
@@ -95,54 +87,46 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
IF (LHOOK) CALL DR_HOOK('READ_SSO_N',0,ZHOOK_HANDLE)
-IF(.NOT.ASSOCIATED(USS%XAVG_ZS)) ALLOCATE(USS%XAVG_ZS(U%NSIZE_FULL))
+IF(.NOT.ASSOCIATED(USS%XAVG_ZS)) ALLOCATE(USS%XAVG_ZS(KSIZE_FULL))
YRECFM='AVG_ZS'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,USS%XAVG_ZS(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,USS%XAVG_ZS(:),IRESP)
!
-IF(.NOT.ASSOCIATED(USS%XSIL_ZS)) ALLOCATE(USS%XSIL_ZS(U%NSIZE_FULL))
+IF(.NOT.ASSOCIATED(USS%XSIL_ZS)) ALLOCATE(USS%XSIL_ZS(KSIZE_FULL))
YRECFM='SIL_ZS'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,USS%XSIL_ZS(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,USS%XSIL_ZS(:),IRESP)
!
!
!* 3. Subgrid Orography :
! -----------------
!
!
-IF(.NOT.ASSOCIATED(USS%XSSO_STDEV)) ALLOCATE(USS%XSSO_STDEV(U%NSIZE_FULL))
+IF(.NOT.ASSOCIATED(USS%XSSO_STDEV)) ALLOCATE(USS%XSSO_STDEV(KSIZE_FULL))
YRECFM='SSO_STDEV'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,USS%XSSO_STDEV(:),IRESP)
-WHERE (U%XSEA(:) == 1.) USS%XSSO_STDEV(:) = XUNDEF
+ CALL READ_SURF(HPROGRAM,YRECFM,USS%XSSO_STDEV(:),IRESP)
+WHERE (PSEA(:) == 1.) USS%XSSO_STDEV(:) = XUNDEF
!
-IF(.NOT.ASSOCIATED(USS%XMIN_ZS)) ALLOCATE(USS%XMIN_ZS(U%NSIZE_FULL))
+IF(.NOT.ASSOCIATED(USS%XMIN_ZS)) ALLOCATE(USS%XMIN_ZS(KSIZE_FULL))
YRECFM='MIN_ZS'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,USS%XMIN_ZS(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,USS%XMIN_ZS(:),IRESP)
!
-IF(.NOT.ASSOCIATED(USS%XMAX_ZS)) ALLOCATE(USS%XMAX_ZS(U%NSIZE_FULL))
+IF(.NOT.ASSOCIATED(USS%XMAX_ZS)) ALLOCATE(USS%XMAX_ZS(KSIZE_FULL))
YRECFM='MAX_ZS'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,USS%XMAX_ZS(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,USS%XMAX_ZS(:),IRESP)
!
-IF(.NOT.ASSOCIATED(USS%XSSO_ANIS)) ALLOCATE(USS%XSSO_ANIS(U%NSIZE_FULL))
+IF(.NOT.ASSOCIATED(USS%XSSO_ANIS)) ALLOCATE(USS%XSSO_ANIS(KSIZE_FULL))
YRECFM='SSO_ANIS'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,USS%XSSO_ANIS(:),IRESP)
-WHERE (U%XSEA(:) == 1.) USS%XSSO_ANIS(:) = XUNDEF
+ CALL READ_SURF(HPROGRAM,YRECFM,USS%XSSO_ANIS(:),IRESP)
+WHERE (PSEA(:) == 1.) USS%XSSO_ANIS(:) = XUNDEF
!
-IF(.NOT.ASSOCIATED(USS%XSSO_DIR)) ALLOCATE(USS%XSSO_DIR(U%NSIZE_FULL))
+IF(.NOT.ASSOCIATED(USS%XSSO_DIR)) ALLOCATE(USS%XSSO_DIR(KSIZE_FULL))
YRECFM='SSO_DIR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,USS%XSSO_DIR(:),IRESP)
-WHERE (U%XSEA(:) == 1.) USS%XSSO_DIR(:) = XUNDEF
+ CALL READ_SURF(HPROGRAM,YRECFM,USS%XSSO_DIR(:),IRESP)
+WHERE (PSEA(:) == 1.) USS%XSSO_DIR(:) = XUNDEF
!
-IF(.NOT.ASSOCIATED(USS%XSSO_SLOPE)) ALLOCATE(USS%XSSO_SLOPE(U%NSIZE_FULL))
+IF(.NOT.ASSOCIATED(USS%XSSO_SLOPE)) ALLOCATE(USS%XSSO_SLOPE(KSIZE_FULL))
YRECFM='SSO_SLOPE'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,USS%XSSO_SLOPE(:),IRESP)
-WHERE (U%XSEA(:) == 1.) USS%XSSO_SLOPE(:) = XUNDEF
+ CALL READ_SURF(HPROGRAM,YRECFM,USS%XSSO_SLOPE(:),IRESP)
+WHERE (PSEA(:) == 1.) USS%XSSO_SLOPE(:) = XUNDEF
!
!-------------------------------------------------------------------------------
!
@@ -150,53 +134,45 @@ WHERE (U%XSEA(:) == 1.) USS%XSSO_SLOPE(:) = XUNDEF
! ---------------------------
!
!
-IF(.NOT.ASSOCIATED(USS%XHO2IP)) ALLOCATE(USS%XHO2IP(U%NSIZE_FULL))
+IF(.NOT.ASSOCIATED(USS%XHO2IP)) ALLOCATE(USS%XHO2IP(KSIZE_FULL))
YRECFM='HO2IP'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,USS%XHO2IP(:),IRESP)
-WHERE (U%XSEA(:) == 1.) USS%XHO2IP(:) = XUNDEF
+ CALL READ_SURF(HPROGRAM,YRECFM,USS%XHO2IP(:),IRESP)
+WHERE (PSEA(:) == 1.) USS%XHO2IP(:) = XUNDEF
!
-IF(.NOT.ASSOCIATED(USS%XHO2JP)) ALLOCATE(USS%XHO2JP(U%NSIZE_FULL))
+IF(.NOT.ASSOCIATED(USS%XHO2JP)) ALLOCATE(USS%XHO2JP(KSIZE_FULL))
YRECFM='HO2JP'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,USS%XHO2JP(:),IRESP)
-WHERE (U%XSEA(:) == 1.) USS%XHO2JP(:) = XUNDEF
+ CALL READ_SURF(HPROGRAM,YRECFM,USS%XHO2JP(:),IRESP)
+WHERE (PSEA(:) == 1.) USS%XHO2JP(:) = XUNDEF
!
-IF(.NOT.ASSOCIATED(USS%XHO2IM)) ALLOCATE(USS%XHO2IM(U%NSIZE_FULL))
+IF(.NOT.ASSOCIATED(USS%XHO2IM)) ALLOCATE(USS%XHO2IM(KSIZE_FULL))
YRECFM='HO2IM'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,USS%XHO2IM(:),IRESP)
-WHERE (U%XSEA(:) == 1.) USS%XHO2IM(:) = XUNDEF
+ CALL READ_SURF(HPROGRAM,YRECFM,USS%XHO2IM(:),IRESP)
+WHERE (PSEA(:) == 1.) USS%XHO2IM(:) = XUNDEF
!
-IF(.NOT.ASSOCIATED(USS%XHO2JM)) ALLOCATE(USS%XHO2JM(U%NSIZE_FULL))
+IF(.NOT.ASSOCIATED(USS%XHO2JM)) ALLOCATE(USS%XHO2JM(KSIZE_FULL))
YRECFM='HO2JM'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,USS%XHO2JM(:),IRESP)
-WHERE (U%XSEA(:) == 1.) USS%XHO2JM(:) = XUNDEF
+ CALL READ_SURF(HPROGRAM,YRECFM,USS%XHO2JM(:),IRESP)
+WHERE (PSEA(:) == 1.) USS%XHO2JM(:) = XUNDEF
!
-IF(.NOT.ASSOCIATED(USS%XAOSIP)) ALLOCATE(USS%XAOSIP(U%NSIZE_FULL))
+IF(.NOT.ASSOCIATED(USS%XAOSIP)) ALLOCATE(USS%XAOSIP(KSIZE_FULL))
YRECFM='AOSIP'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,USS%XAOSIP(:),IRESP)
-WHERE (U%XSEA(:) == 1.) USS%XAOSIP(:) = XUNDEF
+ CALL READ_SURF(HPROGRAM,YRECFM,USS%XAOSIP(:),IRESP)
+WHERE (PSEA(:) == 1.) USS%XAOSIP(:) = XUNDEF
!
-IF(.NOT.ASSOCIATED(USS%XAOSJP)) ALLOCATE(USS%XAOSJP(U%NSIZE_FULL))
+IF(.NOT.ASSOCIATED(USS%XAOSJP)) ALLOCATE(USS%XAOSJP(KSIZE_FULL))
YRECFM='AOSJP'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,USS%XAOSJP(:),IRESP)
-WHERE (U%XSEA(:) == 1.) USS%XAOSJP(:) = XUNDEF
+ CALL READ_SURF(HPROGRAM,YRECFM,USS%XAOSJP(:),IRESP)
+WHERE (PSEA(:) == 1.) USS%XAOSJP(:) = XUNDEF
!
-IF(.NOT.ASSOCIATED(USS%XAOSIM)) ALLOCATE(USS%XAOSIM(U%NSIZE_FULL))
+IF(.NOT.ASSOCIATED(USS%XAOSIM)) ALLOCATE(USS%XAOSIM(KSIZE_FULL))
YRECFM='AOSIM'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,USS%XAOSIM(:),IRESP)
-WHERE (U%XSEA(:) == 1.) USS%XAOSIM(:) = XUNDEF
+ CALL READ_SURF(HPROGRAM,YRECFM,USS%XAOSIM(:),IRESP)
+WHERE (PSEA(:) == 1.) USS%XAOSIM(:) = XUNDEF
!
-IF(.NOT.ASSOCIATED(USS%XAOSJM)) ALLOCATE(USS%XAOSJM(U%NSIZE_FULL))
+IF(.NOT.ASSOCIATED(USS%XAOSJM)) ALLOCATE(USS%XAOSJM(KSIZE_FULL))
YRECFM='AOSJM'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,USS%XAOSJM(:),IRESP)
-WHERE (U%XSEA(:) == 1.) USS%XAOSJM(:) = XUNDEF
+ CALL READ_SURF(HPROGRAM,YRECFM,USS%XAOSJM(:),IRESP)
+WHERE (PSEA(:) == 1.) USS%XAOSJM(:) = XUNDEF
IF (LHOOK) CALL DR_HOOK('READ_SSO_N',1,ZHOOK_HANDLE)
!
!
diff --git a/src/SURFEX/read_surf.F90 b/src/SURFEX/read_surf.F90
index 71dd5c6221f72a03126744adcb40f81b25de2c34..cffe3e0e1fd82f12c68abfa5c3e2f43b3cd91c17 100644
--- a/src/SURFEX/read_surf.F90
+++ b/src/SURFEX/read_surf.F90
@@ -233,7 +233,6 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC, XTIME_NPIO_READ, XTIME_COMM_READ
-USE MODD_SURFEX_OMP, ONLY : XWORK0, NWORKB, CWORKB
!
#ifdef SFX_OL
USE MODE_READ_SURF_OL, ONLY: READ_SURF0_OL
@@ -253,6 +252,9 @@ USE MODE_READ_SURF_FA, ONLY: READ_SURF0_FA
#ifdef SFX_MNH
USE MODI_READ_SURFX0_MNH
#endif
+#ifdef SFX_ARO
+USE MODI_READ_SURFX0_ARO
+#endif
!
IMPLICIT NONE
!
@@ -261,7 +263,6 @@ INCLUDE "mpif.h"
#endif
!
!
-!
!* 0.1 Declarations of arguments
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
@@ -273,6 +274,7 @@ INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem ap
!
!* 0.2 Declarations of local variables
!
+ CHARACTER(LEN=100) :: YCOMMENT
CHARACTER(LEN=LEN_HREC) :: YREC
CHARACTER(LEN=1) :: YDIR
REAL :: XTIME0
@@ -282,10 +284,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODI_READ_SURF:READ_SURFX0',0,ZHOOK_HANDLE)
!
-!$OMP BARRIER
-!
-NWORKB = 0
- CWORKB = ""
+KRESP = 0
+YCOMMENT = ""
!
YREC = HREC
YDIR = 'H'
@@ -293,13 +293,13 @@ IF (PRESENT(HDIR)) YDIR = HDIR
!
IF (HPROGRAM=='MESONH') THEN
#ifdef SFX_MNH
- CALL READ_SURFX0_MNH(YREC,XWORK0,NWORKB,CWORKB)
+ CALL READ_SURFX0_MNH(YREC,PFIELD,KRESP,YCOMMENT)
#endif
ENDIF
!
IF (HPROGRAM=='AROME ') THEN
#ifdef SFX_ARO
- CALL READ_SURFX0_ARO(YREC,XWORK0,NWORKB,CWORKB)
+ CALL READ_SURFX0_ARO(YREC,PFIELD,KRESP,YCOMMENT)
#endif
ENDIF
!
@@ -313,34 +313,30 @@ IF (HPROGRAM=='OFFLIN' .OR. HPROGRAM=='ASCII ' .OR. &
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP SINGLE
- !
IF (HPROGRAM=='OFFLIN') THEN
#ifdef SFX_OL
- CALL READ_SURF0_OL(YREC,XWORK0,NWORKB,CWORKB)
+ CALL READ_SURF0_OL(YREC,PFIELD,KRESP,YCOMMENT)
#endif
ELSEIF (HPROGRAM=='LFI ') THEN
#ifdef SFX_LFI
- CALL READ_SURF0_LFI(YREC,XWORK0,NWORKB,CWORKB)
+ CALL READ_SURF0_LFI(YREC,PFIELD,KRESP,YCOMMENT)
#endif
ELSEIF (HPROGRAM=='ASCII ') THEN
#ifdef SFX_ASC
CALL READ_SURF0_ASC(&
- YREC,XWORK0,NWORKB,CWORKB)
+ YREC,PFIELD,KRESP,YCOMMENT)
#endif
ELSEIF (HPROGRAM=='FA ') THEN
#ifdef SFX_FA
CALL READ_SURF0_FA(&
- YREC,XWORK0,NWORKB,CWORKB)
+ YREC,PFIELD,KRESP,YCOMMENT)
#endif
ELSEIF (HPROGRAM=='NC ') THEN
#ifdef SFX_NC
- CALL READ_SURF0_NC(YREC,XWORK0,NWORKB,CWORKB)
+ CALL READ_SURF0_NC(YREC,PFIELD,KRESP,YCOMMENT)
#endif
ENDIF
!
-!$OMP END SINGLE
- !
#ifdef SFX_MPI
XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
#endif
@@ -350,30 +346,21 @@ IF (HPROGRAM=='OFFLIN' .OR. HPROGRAM=='ASCII ' .OR. &
#ifdef SFX_MPI
IF (YDIR/='A' .AND. NPROC>1) THEN
XTIME0 = MPI_WTIME()
-!$OMP SINGLE
- CALL MPI_BCAST(XWORK0,KIND(XWORK0)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
-!$OMP END SINGLE
+ CALL MPI_BCAST(PFIELD,KIND(PFIELD)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
ENDIF
#endif
!
ENDIF
!
-PFIELD=XWORK0
-!
-KRESP = NWORKB
-!
-IF (PRESENT(HCOMMENT)) HCOMMENT = CWORKB
-!
-!$OMP BARRIER
+IF (PRESENT(HCOMMENT)) HCOMMENT = YCOMMENT
!
IF (LHOOK) CALL DR_HOOK('MODI_READ_SURF:READ_SURFX0',1,ZHOOK_HANDLE)
!
END SUBROUTINE READ_SURFX0
!
! #############################################################
- SUBROUTINE READ_SURFX1 (&
- HPROGRAM,HREC,PFIELD,KRESP,HCOMMENT,HDIR)
+ SUBROUTINE READ_SURFX1 (HPROGRAM,HREC,PFIELD,KRESP,HCOMMENT,HDIR)
! #############################################################
!
!
@@ -386,7 +373,7 @@ USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_ASSIM, ONLY : LASSIM, LREAD_ALL, CASSIM_ISBA
!
#ifdef SFX_OL
-USE MODE_READ_SURF_OL, ONLY: READ_SURFN_OL
+USE MODE_READ_SURF_OL
#endif
#ifdef SFX_LFI
USE MODE_READ_SURF_LFI, ONLY: READ_SURFN_LFI
@@ -403,11 +390,15 @@ USE MODE_READ_SURF_FA, ONLY: READ_SURFX_FA
#ifdef SFX_MNH
USE MODI_READ_SURFX1_MNH
#endif
+#ifdef SFX_ARO
+USE MODI_READ_SURFX1_ARO
+#endif
!
USE MODI_GET_IOK_ASSIM
!
IMPLICIT NONE
!
+!
!* 0.1 Declarations of arguments
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
@@ -463,7 +454,7 @@ ENDIF
!
IF (HPROGRAM=='OFFLIN') THEN
#ifdef SFX_OL
- CALL READ_SURFN_OL(YREC,PFIELD,KRESP,YCOMMENT,YDIR)
+ CALL READ_SURFX1N1_OL(YREC,PFIELD,KRESP,YCOMMENT,YDIR)
#endif
ENDIF
!
@@ -498,8 +489,7 @@ IF (LHOOK) CALL DR_HOOK('MODI_READ_SURF:READ_SURFX1',1,ZHOOK_HANDLE)
END SUBROUTINE READ_SURFX1
!
! #############################################################
- SUBROUTINE READ_SURFX2 (&
- HPROGRAM,HREC,PFIELD,KRESP,HCOMMENT,HDIR)
+ SUBROUTINE READ_SURFX2 (HPROGRAM,HREC,PFIELD,KRESP,HCOMMENT,HDIR)
! #############################################################
!
!
@@ -512,7 +502,7 @@ USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_ASSIM, ONLY : LASSIM, LREAD_ALL, CASSIM_ISBA
!
#ifdef SFX_OL
-USE MODE_READ_SURF_OL, ONLY: READ_SURFN_OL
+USE MODE_READ_SURF_OL
#endif
#ifdef SFX_LFI
USE MODE_READ_SURF_LFI, ONLY: READ_SURFN_LFI
@@ -529,11 +519,15 @@ USE MODE_READ_SURF_FA, ONLY: READ_SURFX_FA
#ifdef SFX_MNH
USE MODI_READ_SURFX2_MNH
#endif
+#ifdef SFX_ARO
+USE MODI_READ_SURFX2_ARO
+#endif
!
USE MODI_GET_IOK_ASSIM
!
IMPLICIT NONE
!
+!
!* 0.1 Declarations of arguments
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
@@ -590,7 +584,7 @@ ENDIF
!
IF (HPROGRAM=='OFFLIN') THEN
#ifdef SFX_OL
- CALL READ_SURFN_OL(YREC,PFIELD,KRESP,YCOMMENT,YDIR)
+ CALL READ_SURFL1X2_OL(YREC,PFIELD,KRESP,YCOMMENT,YDIR)
#endif
ENDIF
!
@@ -608,8 +602,7 @@ ENDIF
!
IF (HPROGRAM=='ASCII ') THEN
#ifdef SFX_ASC
- CALL READ_SURFN_ASC(&
- YREC,PFIELD,KRESP,YCOMMENT,YDIR)
+ CALL READ_SURFN_ASC(YREC,PFIELD,KRESP,YCOMMENT,YDIR)
#endif
ENDIF
!
@@ -636,7 +629,7 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
#ifdef SFX_OL
-USE MODE_READ_SURF_OL, ONLY: READ_SURFN_OL
+USE MODE_READ_SURF_OL
#endif
!
IMPLICIT NONE
@@ -678,7 +671,7 @@ IL3 = SIZE(PFIELD,3)
!
IF (HPROGRAM=='OFFLIN') THEN
#ifdef SFX_OL
- CALL READ_SURFN_OL(YREC,PFIELD,KRESP,YCOMMENT,YDIR)
+ CALL READ_SURFL1X2_OL(YREC,PFIELD,KRESP,YCOMMENT,YDIR)
#endif
ENDIF
!
@@ -712,12 +705,12 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC, XTIME_NPIO_READ, XTIME_COMM_READ
-USE MODD_SURFEX_OMP, ONLY : NWORK0, NWORKB, CWORKB
!
#ifdef SFX_OL
USE MODE_READ_SURF_OL, ONLY: READ_SURF0_OL
#endif
#ifdef SFX_LFI
+USE MODD_IO_SURF_LFI, ONLY : LMNH_COMPATIBLE, NIU,NIB,NIE,NJU,NJB,NJE
USE MODE_READ_SURF_LFI, ONLY: READ_SURF0_LFI
#endif
#ifdef SFX_NC
@@ -732,6 +725,9 @@ USE MODE_READ_SURF_FA, ONLY: READ_SURF0_FA
#ifdef SFX_MNH
USE MODI_READ_SURFN0_MNH
#endif
+#ifdef SFX_ARO
+USE MODI_READ_SURFN0_ARO
+#endif
!
IMPLICIT NONE
!
@@ -752,18 +748,18 @@ INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem app
!
!* 0.2 Declarations of local variables
!
+ CHARACTER(LEN=100) :: YCOMMENT
CHARACTER(LEN=LEN_HREC) :: YREC
CHARACTER(LEN=1) :: YDIR
REAL :: XTIME0
+INTEGER, DIMENSION(6) :: IDIMS
INTEGER :: INFOMPI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODI_READ_SURF:READ_SURFN0',0,ZHOOK_HANDLE)
!
-!$OMP BARRIER
-!
-NWORKB = 0
- CWORKB = ""
+KRESP = 0
+YCOMMENT = ""
!
YREC = HREC
YDIR = 'H'
@@ -771,13 +767,13 @@ IF (PRESENT(HDIR)) YDIR = HDIR
!
IF (HPROGRAM=='MESONH') THEN
#ifdef SFX_MNH
- CALL READ_SURFN0_MNH(YREC,NWORK0,NWORKB,CWORKB)
+ CALL READ_SURFN0_MNH(YREC,KFIELD,KRESP,YCOMMENT)
#endif
ENDIF
!
IF (HPROGRAM=='AROME ') THEN
#ifdef SFX_ARO
- CALL READ_SURFN0_ARO(YREC,NWORK0,NWORKB,CWORKB)
+ CALL READ_SURFN0_ARO(YREC,KFIELD,KRESP,YCOMMENT)
#endif
ENDIF
!
@@ -791,42 +787,38 @@ IF (HPROGRAM=='OFFLIN' .OR. HPROGRAM=='ASCII ' .OR. &
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP SINGLE
- !
IF (HPROGRAM=='OFFLIN') THEN
#ifdef SFX_OL
- CALL READ_SURF0_OL(YREC,NWORK0,NWORKB,CWORKB)
+ CALL READ_SURF0_OL(YREC,KFIELD,KRESP,YCOMMENT)
#endif
ENDIF
!
IF (HPROGRAM=='LFI ') THEN
#ifdef SFX_LFI
- CALL READ_SURF0_LFI(YREC,NWORK0,NWORKB,CWORKB)
+ CALL READ_SURF0_LFI(YREC,KFIELD,KRESP,YCOMMENT)
#endif
ENDIF
!
IF (HPROGRAM=='NC ') THEN
#ifdef SFX_NC
- CALL READ_SURF0_NC(YREC,NWORK0,NWORKB,CWORKB)
+ CALL READ_SURF0_NC(YREC,KFIELD,KRESP,YCOMMENT)
#endif
ENDIF
!
IF (HPROGRAM=='ASCII ') THEN
#ifdef SFX_ASC
CALL READ_SURF0_ASC(&
- YREC,NWORK0,NWORKB,CWORKB)
+ YREC,KFIELD,KRESP,YCOMMENT)
#endif
ENDIF
!
IF (HPROGRAM=='FA ') THEN
#ifdef SFX_FA
CALL READ_SURF0_FA(&
- YREC,NWORK0,NWORKB,CWORKB)
+ YREC,KFIELD,KRESP,YCOMMENT)
#endif
ENDIF
!
-!$OMP END SINGLE
- !
#ifdef SFX_MPI
XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
#endif
@@ -836,22 +828,37 @@ IF (HPROGRAM=='OFFLIN' .OR. HPROGRAM=='ASCII ' .OR. &
#ifdef SFX_MPI
IF (YDIR/='A' .AND. NPROC>1) THEN
XTIME0 = MPI_WTIME()
-!$OMP SINGLE
- CALL MPI_BCAST(NWORK0,KIND(NWORK0)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
-!$OMP END SINGLE
+ CALL MPI_BCAST(KFIELD,KIND(KFIELD)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+#ifdef SFX_LFI
+ IF (HPROGRAM=='LFI '.AND.TRIM(HREC)=="DIM_FULL") THEN
+ CALL MPI_BCAST(LMNH_COMPATIBLE,1,MPI_LOGICAL,NPIO,NCOMM,INFOMPI)
+ IF (NRANK==NPIO) THEN
+ IDIMS(1) = NIU
+ IDIMS(2) = NIB
+ IDIMS(3) = NIE
+ IDIMS(4) = NJU
+ IDIMS(5) = NJB
+ IDIMS(6) = NJE
+ ENDIF
+ CALL MPI_BCAST(IDIMS,SIZE(IDIMS)*KIND(IDIMS)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ IF (NRANK/=NPIO) THEN
+ NIU = IDIMS(1)
+ NIB = IDIMS(2)
+ NIE = IDIMS(3)
+ NJU = IDIMS(4)
+ NJB = IDIMS(5)
+ NJE = IDIMS(6)
+ ENDIF
+ ENDIF
+#endif
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
ENDIF
#endif
!
ENDIF
!
-KFIELD=NWORK0
-!
-KRESP = NWORKB
-!
-IF (PRESENT(HCOMMENT)) HCOMMENT = CWORKB
+IF (PRESENT(HCOMMENT)) HCOMMENT = YCOMMENT
!
-!$OMP BARRIER
!
IF (LHOOK) CALL DR_HOOK('MODI_READ_SURF:READ_SURFN0',1,ZHOOK_HANDLE)
!
@@ -869,7 +876,7 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
#ifdef SFX_OL
-USE MODE_READ_SURF_OL, ONLY: READ_SURFN_OL
+USE MODE_READ_SURF_OL
#endif
#ifdef SFX_LFI
USE MODE_READ_SURF_LFI, ONLY: READ_SURFN_LFI
@@ -886,9 +893,13 @@ USE MODE_READ_SURF_FA, ONLY: READ_SURFN_FA
#ifdef SFX_MNH
USE MODI_READ_SURFN1_MNH
#endif
+#ifdef SFX_ARO
+USE MODI_READ_SURFN1_ARO
+#endif
!
IMPLICIT NONE
!
+!
!* 0.1 Declarations of arguments
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
@@ -932,7 +943,7 @@ ENDIF
!
IF (HPROGRAM=='OFFLIN') THEN
#ifdef SFX_OL
- CALL READ_SURFN_OL(YREC,KFIELD,KRESP,YCOMMENT,YDIR)
+ CALL READ_SURFX1N1_OL(YREC,KFIELD,KRESP,YCOMMENT,YDIR)
#endif
ENDIF
!
@@ -979,7 +990,6 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC, XTIME_NPIO_READ, XTIME_COMM_READ
-USE MODD_SURFEX_OMP, ONLY : CWORK0, NWORKB, CWORKB
!
#ifdef SFX_OL
USE MODE_READ_SURF_OL, ONLY: READ_SURF0_OL
@@ -999,6 +1009,9 @@ USE MODE_READ_SURF_FA, ONLY: READ_SURF0_FA
#ifdef SFX_MNH
USE MODI_READ_SURFC0_MNH
#endif
+#ifdef SFX_ARO
+USE MODI_READ_SURFC0_ARO
+#endif
!
IMPLICIT NONE
!
@@ -1019,6 +1032,8 @@ INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem ap
!
!* 0.2 Declarations of local variables
!
+ CHARACTER(LEN=40) :: YFIELD
+ CHARACTER(LEN=100) :: YCOMMENT
CHARACTER(LEN=LEN_HREC) :: YREC
CHARACTER(LEN=1) :: YDIR
REAL :: XTIME0
@@ -1027,10 +1042,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODI_READ_SURF:READ_SURFC0',0,ZHOOK_HANDLE)
!
-!$OMP BARRIER
-!
-NWORKB = 0
- CWORKB = ""
+KRESP = 0
+YCOMMENT = ""
!
YREC = HREC
YDIR = 'H'
@@ -1038,11 +1051,13 @@ IF (PRESENT(HDIR)) YDIR = HDIR
!
IF (HPROGRAM=='MESONH') THEN
#ifdef SFX_MNH
- CALL READ_SURFC0_MNH(YREC,CWORK0(1:40),NWORKB,CWORKB)
+ CALL READ_SURFC0_MNH(YREC,YFIELD,KRESP,YCOMMENT)
+ HFIELD = YFIELD
#endif
ELSE IF (HPROGRAM=='AROME ') THEN
#ifdef SFX_ARO
- CALL READ_SURFC0_ARO(YREC,CWORK0(1:40),NWORKB,CWORKB)
+ CALL READ_SURFC0_ARO(YREC,YFIELD,KRESP,YCOMMENT)
+ HFIELD = YFIELD
#endif
ELSEIF (HPROGRAM=='OFFLIN' .OR. HPROGRAM=='ASCII ' .OR. &
HPROGRAM=='FA ' .OR. HPROGRAM=='LFI ' .OR. &
@@ -1054,34 +1069,30 @@ ELSEIF (HPROGRAM=='OFFLIN' .OR. HPROGRAM=='ASCII ' .OR. &
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP SINGLE
- !
IF (HPROGRAM=='OFFLIN') THEN
#ifdef SFX_OL
- CALL READ_SURF0_OL(YREC,CWORK0(1:40),NWORKB,CWORKB)
+ CALL READ_SURF0_OL(YREC,YFIELD,KRESP,YCOMMENT)
#endif
ELSE IF (HPROGRAM=='LFI ') THEN
#ifdef SFX_LFI
- CALL READ_SURF0_LFI(YREC,CWORK0(1:40),NWORKB,CWORKB)
+ CALL READ_SURF0_LFI(YREC,YFIELD,KRESP,YCOMMENT)
#endif
ELSE IF (HPROGRAM=='NC ') THEN
#ifdef SFX_NC
- CALL READ_SURF0_NC(YREC,CWORK0(1:40),NWORKB,CWORKB)
+ CALL READ_SURF0_NC(YREC,YFIELD,KRESP,YCOMMENT)
#endif
ELSE IF (HPROGRAM=='ASCII ') THEN
#ifdef SFX_ASC
CALL READ_SURF0_ASC(&
- YREC,CWORK0(1:40),NWORKB,CWORKB)
+ YREC,YFIELD,KRESP,YCOMMENT)
#endif
ELSE IF (HPROGRAM=='FA ') THEN
#ifdef SFX_FA
CALL READ_SURF0_FA(&
- YREC,CWORK0(1:40),NWORKB,CWORKB)
+ YREC,YFIELD,KRESP,YCOMMENT)
#endif
ENDIF
!
-!$OMP END SINGLE
- !
#ifdef SFX_MPI
XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
#endif
@@ -1091,22 +1102,16 @@ ELSEIF (HPROGRAM=='OFFLIN' .OR. HPROGRAM=='ASCII ' .OR. &
#ifdef SFX_MPI
IF (YDIR/='A' .AND. NPROC>1) THEN
XTIME0 = MPI_WTIME()
-!$OMP SINGLE
- CALL MPI_BCAST(CWORK0(1:40),40,MPI_CHARACTER,NPIO,NCOMM,INFOMPI)
-!$OMP END SINGLE
+ CALL MPI_BCAST(YFIELD,40,MPI_CHARACTER,NPIO,NCOMM,INFOMPI)
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
ENDIF
#endif
!
+ HFIELD = YFIELD(1:LEN(HFIELD))
+ !
ENDIF
!
-HFIELD = CWORK0(1:LEN(HFIELD))
-!
-KRESP = NWORKB
-!
-IF (PRESENT(HCOMMENT)) HCOMMENT = CWORKB
-!
-!$OMP BARRIER
+IF (PRESENT(HCOMMENT)) HCOMMENT = YCOMMENT
!
IF (LHOOK) CALL DR_HOOK('MODI_READ_SURF:READ_SURFC0',1,ZHOOK_HANDLE)
!
@@ -1124,7 +1129,6 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC, XTIME_NPIO_READ, XTIME_COMM_READ
-USE MODD_SURFEX_OMP, ONLY : LWORK0, NWORKB, CWORKB
!
#ifdef SFX_OL
USE MODE_READ_SURF_OL, ONLY: READ_SURF0_OL
@@ -1144,6 +1148,9 @@ USE MODE_READ_SURF_FA, ONLY: READ_SURF0_FA
#ifdef SFX_MNH
USE MODI_READ_SURFL0_MNH
#endif
+#ifdef SFX_ARO
+USE MODI_READ_SURFL0_ARO
+#endif
!
IMPLICIT NONE
!
@@ -1164,6 +1171,7 @@ INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appe
!
!* 0.2 Declarations of local variables
!
+ CHARACTER(LEN=100) :: YCOMMENT
CHARACTER(LEN=LEN_HREC) :: YREC
CHARACTER(LEN=1) :: YDIR
REAL :: XTIME0
@@ -1172,10 +1180,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODI_READ_SURF:READ_SURFL0',0,ZHOOK_HANDLE)
!
-!$OMP BARRIER
-!
-NWORKB = 0
- CWORKB = ""
+KRESP = 0
+YCOMMENT = ""
!
YREC = HREC
YDIR = 'H'
@@ -1183,11 +1189,11 @@ IF (PRESENT(HDIR)) YDIR = HDIR
!
IF (HPROGRAM=='MESONH') THEN
#ifdef SFX_MNH
- CALL READ_SURFL0_MNH(YREC,LWORK0,NWORKB,CWORKB)
+ CALL READ_SURFL0_MNH(YREC,OFIELD,KRESP,YCOMMENT)
#endif
ELSE IF (HPROGRAM=='AROME ') THEN
#ifdef SFX_ARO
- CALL READ_SURFL0_ARO(YREC,LWORK0,NWORKB,CWORKB)
+ CALL READ_SURFL0_ARO(YREC,OFIELD,KRESP,YCOMMENT)
#endif
ELSEIF (HPROGRAM=='OFFLIN' .OR. HPROGRAM=='ASCII ' .OR. &
HPROGRAM=='FA ' .OR. HPROGRAM=='LFI ' .OR. &
@@ -1199,34 +1205,30 @@ ELSEIF (HPROGRAM=='OFFLIN' .OR. HPROGRAM=='ASCII ' .OR. &
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP SINGLE
- !
IF (HPROGRAM=='OFFLIN') THEN
#ifdef SFX_OL
- CALL READ_SURF0_OL(YREC,LWORK0,NWORKB,CWORKB)
+ CALL READ_SURF0_OL(YREC,OFIELD,KRESP,YCOMMENT)
#endif
ELSE IF (HPROGRAM=='LFI ') THEN
#ifdef SFX_LFI
- CALL READ_SURF0_LFI(YREC,LWORK0,NWORKB,CWORKB)
+ CALL READ_SURF0_LFI(YREC,OFIELD,KRESP,YCOMMENT)
#endif
ELSE IF (HPROGRAM=='NC ') THEN
#ifdef SFX_NC
- CALL READ_SURF0_NC(YREC,LWORK0,NWORKB,CWORKB)
+ CALL READ_SURF0_NC(YREC,OFIELD,KRESP,YCOMMENT)
#endif
ELSE IF (HPROGRAM=='ASCII ') THEN
#ifdef SFX_ASC
CALL READ_SURF0_ASC(&
- YREC,LWORK0,NWORKB,CWORKB)
+ YREC,OFIELD,KRESP,YCOMMENT)
#endif
ELSE IF (HPROGRAM=='FA ') THEN
#ifdef SFX_FA
CALL READ_SURF0_FA(&
- YREC,LWORK0,NWORKB,CWORKB)
+ YREC,OFIELD,KRESP,YCOMMENT)
#endif
ENDIF
!
-!$OMP END SINGLE
- !
#ifdef SFX_MPI
XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
#endif
@@ -1236,30 +1238,21 @@ ELSEIF (HPROGRAM=='OFFLIN' .OR. HPROGRAM=='ASCII ' .OR. &
#ifdef SFX_MPI
IF (YDIR/='A' .AND. NPROC>1) THEN
XTIME0 = MPI_WTIME()
-!$OMP SINGLE
- CALL MPI_BCAST(LWORK0,1,MPI_LOGICAL,NPIO,NCOMM,INFOMPI)
-!$OMP END SINGLE
+ CALL MPI_BCAST(OFIELD,1,MPI_LOGICAL,NPIO,NCOMM,INFOMPI)
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
ENDIF
#endif
!
ENDIF
!
-OFIELD = LWORK0
-!
-KRESP = NWORKB
-!
-IF (PRESENT(HCOMMENT)) HCOMMENT = CWORKB
-!
-!$OMP BARRIER
+IF (PRESENT(HCOMMENT)) HCOMMENT = YCOMMENT
!
IF (LHOOK) CALL DR_HOOK('MODI_READ_SURF:READ_SURFL0',1,ZHOOK_HANDLE)
!
END SUBROUTINE READ_SURFL0
!
! #############################################################
- SUBROUTINE READ_SURFL1 (&
- HPROGRAM,HREC,OFIELD,KRESP,HCOMMENT,HDIR)
+ SUBROUTINE READ_SURFL1 (HPROGRAM,HREC,OFIELD,KRESP,HCOMMENT,HDIR)
! #############################################################
!
!
@@ -1269,7 +1262,7 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
#ifdef SFX_OL
-USE MODE_READ_SURF_OL, ONLY: READ_SURFN_OL
+USE MODE_READ_SURF_OL
#endif
#ifdef SFX_LFI
USE MODE_READ_SURF_LFI, ONLY: READ_SURFN_LFI
@@ -1286,7 +1279,10 @@ USE MODE_READ_SURF_FA, ONLY: READ_SURFN_FA
#ifdef SFX_MNH
USE MODI_READ_SURFL1_MNH
#endif
-!
+#ifdef SFX_ARO
+USE MODI_READ_SURFL1_ARO
+#endif
+
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -1308,6 +1304,7 @@ INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem
CHARACTER(LEN=LEN_HREC) :: YREC
CHARACTER(LEN=1) :: YDIR
INTEGER :: IL
+LOGICAL :: GDATA
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODI_READ_SURF:READ_SURFL1',0,ZHOOK_HANDLE)
@@ -1324,11 +1321,17 @@ IF (HPROGRAM=='MESONH') THEN
#endif
ELSE IF (HPROGRAM=='AROME ') THEN
#ifdef SFX_ARO
- CALL READ_SURFL1_ARO(YREC,IL,OFIELD,KRESP,YCOMMENT,YDIR)
+ ! ascendant reproducibility
+ IF (YREC(1:2)=="L_".AND.IL==1) THEN
+ CALL READ_SURFL0_ARO(YREC,GDATA,KRESP,YCOMMENT)
+ OFIELD = GDATA
+ ELSE
+ CALL READ_SURFL1_ARO(YREC,IL,OFIELD,KRESP,YCOMMENT,YDIR)
+ ENDIF
#endif
ELSE IF (HPROGRAM=='OFFLIN') THEN
#ifdef SFX_OL
- CALL READ_SURFN_OL(YREC,OFIELD,KRESP,YCOMMENT,YDIR)
+ CALL READ_SURFL1X2_OL(YREC,OFIELD,KRESP,YCOMMENT,YDIR)
#endif
ELSE IF (HPROGRAM=='LFI ') THEN
#ifdef SFX_LFI
@@ -1369,7 +1372,6 @@ USE PARKIND1 ,ONLY : JPRB
USE MODD_TYPE_DATE_SURF
!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC, XTIME_NPIO_READ, XTIME_COMM_READ
-USE MODD_SURFEX_OMP, ONLY : NWORKD, XWORK0, NWORKB, CWORKB
!
#ifdef SFX_OL
USE MODE_READ_SURF_OL, ONLY: READ_SURFT_OL
@@ -1389,6 +1391,9 @@ USE MODE_READ_SURF_FA, ONLY: READ_SURFT_FA
#ifdef SFX_MNH
USE MODI_READ_SURFT0_MNH
#endif
+#ifdef SFX_ARO
+USE MODI_READ_SURFT0_ARO
+#endif
!
USE MODI_GET_LUOUT
!
@@ -1413,6 +1418,9 @@ INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem app
!
!* 0.2 Declarations of local variables
!
+ CHARACTER(LEN=100) :: YCOMMENT
+REAL :: ZWORK
+ INTEGER, DIMENSION(3) :: IWORK
CHARACTER(LEN=LEN_HREC) :: YREC
CHARACTER(LEN=1) :: YDIR
!
@@ -1423,26 +1431,20 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODI_READ_SURF:READ_SURFT0',0,ZHOOK_HANDLE)
!
-!$OMP BARRIER
-!
-NWORKB = 0
- CWORKB = ""
+KRESP = 0
+YCOMMENT = ""
!
YREC = HREC
YDIR = 'H'
IF (PRESENT(HDIR)) YDIR = HDIR
!
-!$OMP SINGLE
-ALLOCATE(NWORKD(3))
-!$OMP END SINGLE
-!
IF (HPROGRAM=='MESONH') THEN
#ifdef SFX_MNH
- CALL READ_SURFT0_MNH(YREC,NWORKD(1),NWORKD(2),NWORKD(3),XWORK0,NWORKB,CWORKB)
+ CALL READ_SURFT0_MNH(YREC,IWORK(1),IWORK(2),IWORK(3),ZWORK,KRESP,YCOMMENT)
#endif
ELSE IF (HPROGRAM=='AROME ') THEN
#ifdef SFX_ARO
- CALL READ_SURFT0_ARO(YREC,NWORKD(1),NWORKD(2),NWORKD(3),XWORK0,NWORKB,CWORKB)
+ CALL READ_SURFT0_ARO(YREC,IWORK(1),IWORK(2),IWORK(3),ZWORK,KRESP,YCOMMENT)
#endif
ELSEIF (HPROGRAM=='OFFLIN' .OR. HPROGRAM=='ASCII ' .OR. &
HPROGRAM=='FA ' .OR. HPROGRAM=='LFI ' .OR. &
@@ -1454,34 +1456,30 @@ ELSEIF (HPROGRAM=='OFFLIN' .OR. HPROGRAM=='ASCII ' .OR. &
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP SINGLE
- !
IF (HPROGRAM=='OFFLIN') THEN
#ifdef SFX_OL
- CALL READ_SURFT_OL(YREC,NWORKD(1),NWORKD(2),NWORKD(3),XWORK0,NWORKB,CWORKB)
+ CALL READ_SURFT_OL(YREC,IWORK(1),IWORK(2),IWORK(3),ZWORK,KRESP,YCOMMENT)
#endif
ELSE IF (HPROGRAM=='LFI ') THEN
#ifdef SFX_LFI
- CALL READ_SURFT_LFI(YREC,NWORKD(1),NWORKD(2),NWORKD(3),XWORK0,NWORKB,CWORKB)
+ CALL READ_SURFT_LFI(YREC,IWORK(1),IWORK(2),IWORK(3),ZWORK,KRESP,YCOMMENT)
#endif
ELSE IF (HPROGRAM=='NC ') THEN
#ifdef SFX_NC
- CALL READ_SURFT_NC(YREC,NWORKD(1),NWORKD(2),NWORKD(3),XWORK0,NWORKB,CWORKB)
+ CALL READ_SURFT_NC(YREC,IWORK(1),IWORK(2),IWORK(3),ZWORK,KRESP,YCOMMENT)
#endif
ELSE IF (HPROGRAM=='ASCII ') THEN
#ifdef SFX_ASC
CALL READ_SURFT_ASC(&
- YREC,NWORKD(1),NWORKD(2),NWORKD(3),XWORK0,NWORKB,CWORKB)
+ YREC,IWORK(1),IWORK(2),IWORK(3),ZWORK,KRESP,YCOMMENT)
#endif
ELSE IF (HPROGRAM=='FA ') THEN
#ifdef SFX_FA
CALL READ_SURFT_FA(&
- YREC,NWORKD(1),NWORKD(2),NWORKD(3),XWORK0,NWORKB,CWORKB)
+ YREC,IWORK(1),IWORK(2),IWORK(3),ZWORK,KRESP,YCOMMENT)
#endif
ENDIF
!
-!$OMP END SINGLE
- !
#ifdef SFX_MPI
XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
#endif
@@ -1491,23 +1489,17 @@ ELSEIF (HPROGRAM=='OFFLIN' .OR. HPROGRAM=='ASCII ' .OR. &
#ifdef SFX_MPI
IF (YDIR/='A' .AND. NPROC>1) THEN
XTIME0 = MPI_WTIME()
-!$OMP SINGLE
- CALL MPI_BCAST(NWORKD(1),KIND(NWORKD)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
- CALL MPI_BCAST(NWORKD(2),KIND(NWORKD)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
- CALL MPI_BCAST(NWORKD(3),KIND(NWORKD)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
- CALL MPI_BCAST(XWORK0,KIND(XWORK0)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
-!$OMP END SINGLE
+ CALL MPI_BCAST(IWORK(1),KIND(IWORK)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(IWORK(2),KIND(IWORK)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(IWORK(3),KIND(IWORK)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(ZWORK,KIND(ZWORK)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
ENDIF
#endif
!
ENDIF
!
-KRESP = NWORKB
-!
-IF (PRESENT(HCOMMENT)) HCOMMENT = CWORKB
-!
-!$OMP BARRIER
+IF (PRESENT(HCOMMENT)) HCOMMENT = YCOMMENT
!
IF (KRESP==-2) THEN
CALL GET_LUOUT(HPROGRAM,ILUOUT)
@@ -1519,18 +1511,12 @@ IF (KRESP==-2) THEN
WRITE(ILUOUT,*) 'Forcing value is kept'
WRITE(ILUOUT,*) ' '
ELSE
- TFIELD%TDATE%YEAR = NWORKD(1)
- TFIELD%TDATE%MONTH = NWORKD(2)
- TFIELD%TDATE%DAY = NWORKD(3)
- TFIELD%TIME = XWORK0
+ TFIELD%TDATE%YEAR = IWORK(1)
+ TFIELD%TDATE%MONTH = IWORK(2)
+ TFIELD%TDATE%DAY = IWORK(3)
+ TFIELD%TIME = ZWORK
END IF
!
-!$OMP BARRIER
-!
-!$OMP SINGLE
-DEALLOCATE(NWORKD)
-!$OMP END SINGLE
-!
IF (LHOOK) CALL DR_HOOK('MODI_READ_SURF:READ_SURFT0',1,ZHOOK_HANDLE)
!
END SUBROUTINE READ_SURFT0
@@ -1549,7 +1535,6 @@ USE PARKIND1 ,ONLY : JPRB
USE MODD_TYPE_DATE_SURF
!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC, XTIME_NPIO_READ, XTIME_COMM_READ
-USE MODD_SURFEX_OMP, ONLY : NWORKD2, XWORKD, NWORKB, CWORKB
!
#ifdef SFX_ASC
USE MODE_READ_SURF_ASC, ONLY: READ_SURFT_ASC
@@ -1563,6 +1548,9 @@ USE MODE_READ_SURF_NC, ONLY: READ_SURFT_NC
#ifdef SFX_MNH
USE MODI_READ_SURFT1_MNH
#endif
+#ifdef SFX_ARO
+USE MODI_READ_SURFT1_ARO
+#endif
!
USE MODI_ABOR1_SFX
USE MODI_GET_LUOUT
@@ -1586,39 +1574,38 @@ INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem a
!
!* 0.2 Declarations of local variables
!
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: IWORK2
+REAL, DIMENSION(:), ALLOCATABLE :: ZWORK2
CHARACTER(LEN=LEN_HREC) :: YREC
CHARACTER(LEN=1) :: YDIR
INTEGER :: ILUOUT
INTEGER :: INFOMPI
!
+ CHARACTER(LEN=100) :: YCOMMENT
REAL :: XTIME0
INTEGER :: IL1
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODI_READ_SURF:READ_SURFT1',0,ZHOOK_HANDLE)
!
-!$OMP BARRIER
-!
IL1 = SIZE(TFIELD,1)
-NWORKB = 0
- CWORKB = ""
+KRESP = 0
+YCOMMENT = ""
!
YREC = HREC
YDIR = 'H'
IF (PRESENT(HDIR)) YDIR = HDIR
!
-!$OMP SINGLE
-ALLOCATE(NWORKD2(IL1,3))
-ALLOCATE(XWORKD(IL1))
-!$OMP END SINGLE
+ALLOCATE(IWORK2(IL1,3))
+ALLOCATE(ZWORK2(IL1))
!
IF (HPROGRAM=='MESONH') THEN
#ifdef SFX_MNH
- CALL READ_SURFT1_MNH(YREC,IL1,NWORKD2(:,1),NWORKD2(:,2),NWORKD2(:,3),XWORKD,NWORKB,CWORKB)
+ CALL READ_SURFT1_MNH(YREC,IL1,IWORK2(:,1),IWORK2(:,2),IWORK2(:,3),ZWORK2,KRESP,YCOMMENT)
#endif
ELSE IF (HPROGRAM=='AROME ') THEN
#ifdef SFX_ARO
- CALL READ_SURFT1_ARO(YREC,IL1,NWORKD2(:,1),NWORKD2(:,2),NWORKD2(:,3),XWORKD,NWORKB,CWORKB)
+ CALL READ_SURFT1_ARO(YREC,IL1,IWORK2(:,1),IWORK2(:,2),IWORK2(:,3),ZWORK2,KRESP,YCOMMENT)
#endif
ELSEIF (HPROGRAM=='OFFLIN' .OR. HPROGRAM=='ASCII ' .OR. &
HPROGRAM=='FA ' .OR. HPROGRAM=='LFI ' .OR. &
@@ -1630,8 +1617,6 @@ ELSEIF (HPROGRAM=='OFFLIN' .OR. HPROGRAM=='ASCII ' .OR. &
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP SINGLE
- !
IF (HPROGRAM=='OFFLIN') THEN
CALL ABOR1_SFX('READ_SURFT1: NOT AVAILABLE FOR OFFLIN')
ELSE IF (HPROGRAM=='FA ') THEN
@@ -1639,15 +1624,15 @@ ELSEIF (HPROGRAM=='OFFLIN' .OR. HPROGRAM=='ASCII ' .OR. &
ELSE IF (HPROGRAM=='ASCII ') THEN
#ifdef SFX_ASC
CALL READ_SURFT_ASC(&
- YREC,NWORKD2(:,1),NWORKD2(:,2),NWORKD2(:,3),XWORKD,NWORKB,CWORKB)
+ YREC,IWORK2(:,1),IWORK2(:,2),IWORK2(:,3),ZWORK2,KRESP,YCOMMENT)
#endif
ELSE IF (HPROGRAM=='LFI ') THEN
#ifdef SFX_LFI
- CALL READ_SURFT_LFI(YREC,NWORKD2(:,1),NWORKD2(:,2),NWORKD2(:,3),XWORKD,NWORKB,CWORKB)
+ CALL READ_SURFT_LFI(YREC,IWORK2(:,1),IWORK2(:,2),IWORK2(:,3),ZWORK2,KRESP,YCOMMENT)
#endif
ELSE IF (HPROGRAM=='NC ') THEN
#ifdef SFX_NC
- CALL READ_SURFT_NC(YREC,NWORKD2(:,1),NWORKD2(:,2),NWORKD2(:,3),XWORKD,NWORKB,CWORKB)
+ CALL READ_SURFT_NC(YREC,IWORK2(:,1),IWORK2(:,2),IWORK2(:,3),ZWORK2,KRESP,YCOMMENT)
#endif
ENDIF
!
@@ -1655,27 +1640,22 @@ ELSEIF (HPROGRAM=='OFFLIN' .OR. HPROGRAM=='ASCII ' .OR. &
XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
#endif
!
-!$OMP END SINGLE
- !
ENDIF
!
#ifdef SFX_MPI
IF (YDIR/='A' .AND. NPROC>1) THEN
XTIME0 = MPI_WTIME()
-!$OMP SINGLE
- CALL MPI_BCAST(NWORKD2(:,1),IL1*KIND(NWORKD2)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
- CALL MPI_BCAST(NWORKD2(:,2),IL1*KIND(NWORKD2)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
- CALL MPI_BCAST(NWORKD2(:,3),IL1*KIND(NWORKD2)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
- CALL MPI_BCAST(XWORKD,IL1*KIND(XWORKD)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
-!$OMP END SINGLE
+ CALL MPI_BCAST(IWORK2(:,1),IL1*KIND(IWORK2)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(IWORK2(:,2),IL1*KIND(IWORK2)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(IWORK2(:,3),IL1*KIND(IWORK2)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(ZWORK2,IL1*KIND(ZWORK2)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
ENDIF
#endif
!
ENDIF
!
-KRESP = NWORKB
-IF (PRESENT(HCOMMENT)) HCOMMENT = CWORKB
+IF (PRESENT(HCOMMENT)) HCOMMENT = YCOMMENT
!
IF (KRESP==-2) THEN
CALL GET_LUOUT(HPROGRAM,ILUOUT)
@@ -1687,18 +1667,14 @@ IF (KRESP==-2) THEN
WRITE(ILUOUT,*) 'Forcing value is kept'
WRITE(ILUOUT,*) ' '
ELSE
- TFIELD(:)%TDATE%YEAR = NWORKD2(:,1)
- TFIELD(:)%TDATE%MONTH = NWORKD2(:,2)
- TFIELD(:)%TDATE%DAY = NWORKD2(:,3)
- TFIELD(:)%TIME = XWORKD(:)
+ TFIELD(:)%TDATE%YEAR = IWORK2(:,1)
+ TFIELD(:)%TDATE%MONTH = IWORK2(:,2)
+ TFIELD(:)%TDATE%DAY = IWORK2(:,3)
+ TFIELD(:)%TIME = ZWORK2(:)
END IF
!
-!$OMP BARRIER
-!
-!$OMP SINGLE
-DEALLOCATE(NWORKD2)
-DEALLOCATE(XWORKD)
-!$OMP END SINGLE
+DEALLOCATE(IWORK2)
+DEALLOCATE(ZWORK2)
!
IF (LHOOK) CALL DR_HOOK('MODI_READ_SURF:READ_SURFT1',1,ZHOOK_HANDLE)
!
@@ -1716,7 +1692,6 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NCOMM, NPROC, XTIME_NPIO_READ, XTIME_COMM_READ
-USE MODD_SURFEX_OMP, ONLY : NWORKD3, XWORKD2, NWORKB, CWORKB
!
USE MODD_TYPE_DATE_SURF
!
@@ -1742,8 +1717,6 @@ IMPLICIT NONE
INCLUDE "mpif.h"
#endif
!
-!
-!
!* 0.1 Declarations of arguments
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
@@ -1755,21 +1728,22 @@ INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem app
!
!* 0.2 Declarations of local variables
!
+INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: IWORK3
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK3
CHARACTER(LEN=LEN_HREC) :: YREC
CHARACTER(LEN=1) :: YDIR
INTEGER :: ILUOUT
INTEGER :: INFOMPI
!
+ CHARACTER(LEN=100) :: YCOMMENT
INTEGER :: IL1, IL2
REAL :: XTIME0
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('MODI_READ_SURF:READ_SURFT2',0,ZHOOK_HANDLE)
!
-!$OMP BARRIER
-!
-NWORKB = 0
- CWORKB = ""
+KRESP = 0
+YCOMMENT = ""
!
YREC = HREC
YDIR = 'H'
@@ -1778,10 +1752,8 @@ IF (PRESENT(HDIR)) YDIR = HDIR
IL1 = SIZE(TFIELD,1)
IL2 = SIZE(TFIELD,2)
!
-!$OMP SINGLE
-ALLOCATE(XWORKD2(IL1,IL2))
-ALLOCATE(NWORKD3(IL1,IL2,3))
-!$OMP END SINGLE
+ALLOCATE(ZWORK3(IL1,IL2))
+ALLOCATE(IWORK3(IL1,IL2,3))
!
IF (HPROGRAM=='MESONH') THEN
CALL ABOR1_SFX('READ_SURFT2: NOT AVAILABLE FOR MESONH')
@@ -1796,31 +1768,29 @@ ELSEIF (HPROGRAM=='OFFLIN' .OR. HPROGRAM=='ASCII ' .OR. &
XTIME0 = MPI_WTIME()
#endif
!
-!$OMP SINGLE
- !
IF (HPROGRAM=='OFFLIN') THEN
CALL ABOR1_SFX('READ_SURFT2: NOT AVAILABLE FOR OFFLIN')
ELSE IF (HPROGRAM=='LFI ') THEN
#ifdef SFX_LFI
- CALL READ_SURFT_LFI(YREC,NWORKD3(:,:,1),NWORKD3(:,:,2),NWORKD3(:,:,3),&
- XWORKD2,NWORKB,CWORKB)
+ CALL READ_SURFT_LFI(YREC,IWORK3(:,:,1),IWORK3(:,:,2),IWORK3(:,:,3),&
+ ZWORK3,KRESP,YCOMMENT)
#endif
ELSE IF (HPROGRAM=='ASCII ') THEN
#ifdef SFX_ASC
CALL READ_SURFT_ASC(&
- YREC,NWORKD3(:,:,1),NWORKD3(:,:,2),NWORKD3(:,:,3),&
- XWORKD2,NWORKB,CWORKB)
+ YREC,IWORK3(:,:,1),IWORK3(:,:,2),IWORK3(:,:,3),&
+ ZWORK3,KRESP,YCOMMENT)
#endif
ELSE IF (HPROGRAM=='FA ') THEN
#ifdef SFX_FA
CALL READ_SURFT_FA(&
- YREC,IL1,IL2,NWORKD3(:,:,1),NWORKD3(:,:,2),NWORKD3(:,:,3),&
- XWORKD2,NWORKB,CWORKB)
+ YREC,IL1,IL2,IWORK3(:,:,1),IWORK3(:,:,2),IWORK3(:,:,3),&
+ ZWORK3,KRESP,YCOMMENT)
#endif
ELSE IF (HPROGRAM=='NC ') THEN
#ifdef SFX_NC
- CALL READ_SURFT_NC(YREC,NWORKD3(:,:,1),NWORKD3(:,:,2),NWORKD3(:,:,3),&
- XWORKD2,NWORKB,CWORKB)
+ CALL READ_SURFT_NC(YREC,IWORK3(:,:,1),IWORK3(:,:,2),IWORK3(:,:,3),&
+ ZWORK3,KRESP,YCOMMENT)
#endif
ENDIF
!
@@ -1828,27 +1798,22 @@ ELSEIF (HPROGRAM=='OFFLIN' .OR. HPROGRAM=='ASCII ' .OR. &
XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
#endif
!
-!$OMP END SINGLE
- !
ENDIF
!
#ifdef SFX_MPI
IF (YDIR/='A' .AND. NPROC>1) THEN
XTIME0 = MPI_WTIME()
-!$OMP SINGLE
- CALL MPI_BCAST(NWORKD3(:,:,1),IL1*IL2*KIND(NWORKD3)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
- CALL MPI_BCAST(NWORKD3(:,:,2),IL1*IL2*KIND(NWORKD3)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
- CALL MPI_BCAST(NWORKD3(:,:,3),IL1*IL2*KIND(NWORKD3)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
- CALL MPI_BCAST(XWORKD2,IL1*IL2*KIND(XWORKD2)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
-!$OMP END SINGLE
+ CALL MPI_BCAST(IWORK3(:,:,1),IL1*IL2*KIND(IWORK3)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(IWORK3(:,:,2),IL1*IL2*KIND(IWORK3)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(IWORK3(:,:,3),IL1*IL2*KIND(IWORK3)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI)
+ CALL MPI_BCAST(ZWORK3,IL1*IL2*KIND(ZWORK3)/4,MPI_REAL,NPIO,NCOMM,INFOMPI)
XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
ENDIF
#endif
!
ENDIF
!
-KRESP = NWORKB
-IF (PRESENT(HCOMMENT)) HCOMMENT = CWORKB
+IF (PRESENT(HCOMMENT)) HCOMMENT = YCOMMENT
!
IF (KRESP==-2) THEN
CALL GET_LUOUT(HPROGRAM,ILUOUT)
@@ -1860,18 +1825,14 @@ IF (KRESP==-2) THEN
WRITE(ILUOUT,*) 'Forcing value is kept'
WRITE(ILUOUT,*) ' '
ELSE
- TFIELD(:,:)%TDATE%YEAR = NWORKD3(:,:,1)
- TFIELD(:,:)%TDATE%MONTH = NWORKD3(:,:,2)
- TFIELD(:,:)%TDATE%DAY = NWORKD3(:,:,3)
- TFIELD(:,:)%TIME = XWORKD2(:,:)
+ TFIELD(:,:)%TDATE%YEAR = IWORK3(:,:,1)
+ TFIELD(:,:)%TDATE%MONTH = IWORK3(:,:,2)
+ TFIELD(:,:)%TDATE%DAY = IWORK3(:,:,3)
+ TFIELD(:,:)%TIME = ZWORK3(:,:)
END IF
!
-!$OMP BARRIER
-!
-!$OMP SINGLE
-DEALLOCATE(NWORKD3)
-DEALLOCATE(XWORKD2)
-!$OMP END SINGLE
+DEALLOCATE(IWORK3)
+DEALLOCATE(ZWORK3)
!
IF (LHOOK) CALL DR_HOOK('MODI_READ_SURF:READ_SURFT2',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/read_surf_atm_confn.F90 b/src/SURFEX/read_surf_atm_confn.F90
index e55bc2187396e1d869eb3c791827638f4de15bc7..e2241a24152a390b264e9bb7679bb8922a8f54a6 100644
--- a/src/SURFEX/read_surf_atm_confn.F90
+++ b/src/SURFEX/read_surf_atm_confn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_SURF_ATM_CONF_n (CHU, DGU, USS, &
- HPROGRAM)
+ SUBROUTINE READ_SURF_ATM_CONF_n (CHU, DGO, USS, HPROGRAM)
! #######################################################
!
!!**** *READ_SURF_ATM_CONF* - reads the general configuration for surface
@@ -43,8 +42,8 @@
!
!
USE MODD_CH_SURF_n, ONLY : CH_SURF_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODE_MODELN_SURFEX_HANDLER
!
@@ -68,8 +67,8 @@ IMPLICIT NONE
!
!
TYPE(CH_SURF_t), INTENT(INOUT) :: CHU
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling GROUND
!
@@ -95,9 +94,9 @@ IF (IMI.NE.-1 .AND. LNAM_READ) THEN
CALL INIT_NAM_SSOn(USS)
CALL INIT_NAM_CH_CONTROLn(CHU)
CALL INIT_NAM_CH_SURFn(CHU)
- CALL INIT_NAM_DIAG_SURF_ATMn(DGU)
- CALL INIT_NAM_DIAG_SURFn(DGU)
- CALL INIT_NAM_WRITE_DIAG_SURFn(DGU)
+ CALL INIT_NAM_DIAG_SURF_ATMn(DGO)
+ CALL INIT_NAM_DIAG_SURFn(DGO)
+ CALL INIT_NAM_WRITE_DIAG_SURFn(DGO)
ENDIF
!
IF (LNAM_READ) THEN
@@ -140,9 +139,9 @@ IF (IMI.NE.-1) THEN
CALL UPDATE_NAM_SSOn(USS)
CALL UPDATE_NAM_CH_CONTROLn(CHU)
CALL UPDATE_NAM_CH_SURFn(CHU)
- CALL UPDATE_NAM_DIAG_SURF_ATMn(DGU)
- CALL UPDATE_NAM_DIAG_SURFn(DGU)
- CALL UPDATE_NAM_WRITE_DIAG_SURFn(DGU)
+ CALL UPDATE_NAM_DIAG_SURF_ATMn(DGO)
+ CALL UPDATE_NAM_DIAG_SURFn(DGO)
+ CALL UPDATE_NAM_WRITE_DIAG_SURFn(DGO)
ENDIF
IF (LHOOK) CALL DR_HOOK('READ_SURF_ATM_CONF_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/read_surf_field3d.F90 b/src/SURFEX/read_surf_field3d.F90
deleted file mode 100644
index 49e005418f71407707c71fb5a06876913d37c0d6..0000000000000000000000000000000000000000
--- a/src/SURFEX/read_surf_field3d.F90
+++ /dev/null
@@ -1,148 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE READ_SURF_FIELD3D( HPROGRAM,PFIELD3D,KFIRSTLAYER,KLASTLAYER,HFIELDNAME,HCOMMENT,HDIR)
-! #####################################
-!
-!!**** *READ_SURF_FIELD3D* - reads surfex field in input file using READ_SURF,
-!! layer by layer and patch by patch if needed in MESONH
-!! with Z-parallel IO in MESO-NH, we force surfex to write 2D fields
-!! because Z-parallel IO are not supported for 3D SURFEX fields.
-!!
-!!
-!! PURPOSE
-!! -------
-!! reads surfex field in output file using WRITE_SURF, layer by layer
-!! and patch by patch if needed in MESONH
-!! and NB_PROCIO_R > 1
-!! examples of HFIELDNAME : 'TG', 'soil depth from ecoclimap'
-!! with Z-parallel IO in MESO-NH, we force surfex to write 2D fields
-!! because Z-parallel IO are not supported for 3D SURFEX fields.
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! M.Moge *LA - UPS*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 08/01/2016
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_SURF_PAR, ONLY : NUNDEF
-!
-USE MODI_READ_SURF
-#ifdef SFX_MNH
-USE MODI_GET_NB_PROCIO_READ_MNH
-#endif
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
-CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIELD3D ! 3D field to be read
-INTEGER, INTENT(IN) :: KFIRSTLAYER ! first layer of PFIELD3D to be read
-INTEGER, INTENT(IN) :: KLASTLAYER ! last layer of PFIELD3D to be read
-CHARACTER(LEN=LEN_HREC), INTENT(IN) :: HFIELDNAME ! name of the field PFIELD3D. Example : 'X_Y_TG'
- CHARACTER(LEN=*), OPTIONAL, INTENT(OUT) :: HCOMMENT !comment string
-CHARACTER(LEN=1),OPTIONAL, INTENT(IN) :: HDIR ! type of field :
-! ! 'H' : field with
-! ! horizontal spatial dim.
-! ! '-' : no horizontal dim.
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-REAL, DIMENSION(SIZE(PFIELD3D,1),SIZE(PFIELD3D,3)) :: ZWORK
-INTEGER :: IRESP ! IRESP : return-code if a problem appears
-INTEGER :: ILAYER ! number of layers in PFIELD3D
-INTEGER :: IPATCH ! number of patches in PFIELD3D
-CHARACTER(LEN=100):: YCOMMENT ! Comment string
-CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
-CHARACTER(LEN=4 ) :: YLVL ! current level/layer
-CHARACTER(LEN=4 ) :: YPATCH ! current patch
-INTEGER :: INB_PROCIO ! number of processes used for Z-parallel IO with MESO-NH
-!
-CHARACTER(LEN=1) :: YDIR
-INTEGER :: JJ, JLAYER ! loop counter on levels
-INTEGER :: JPATCH ! loop counter on patches
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!------------------------------------------------------------------------------
-!
-!
-IF (LHOOK) CALL DR_HOOK('READ_SURF_FIELD3D',0,ZHOOK_HANDLE)
-!
-YDIR = 'H'
-IF (PRESENT(HDIR)) YDIR = HDIR
-!
-ILAYER = SIZE( PFIELD3D, 2 )
-IPATCH = SIZE( PFIELD3D, 3 )
-!
-INB_PROCIO = 1
-#ifdef SFX_MNH
-IF (HPROGRAM=='MESONH') THEN
- CALL GET_NB_PROCIO_READ_MNH( INB_PROCIO, IRESP )
-ENDIF
-#endif
-!
-IF ( INB_PROCIO > 1 ) THEN
-!
- DO JLAYER=KFIRSTLAYER,KLASTLAYER
-!
- DO JPATCH=1,IPATCH
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM=ADJUSTL(HFIELDNAME(:LEN_TRIM(HFIELDNAME)))//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- WRITE(YPATCH,'(I4.4)') JPATCH
- IF ( IPATCH > 1 ) THEN
- YRECFM=ADJUSTL(YRECFM(:LEN_TRIM(YRECFM)))//YPATCH
- ENDIF
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP,HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDDO
- PFIELD3D(:,JLAYER,:)=ZWORK
-!
- END DO
-!
-ELSE
-!
- DO JLAYER=KFIRSTLAYER,KLASTLAYER
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM=ADJUSTL(HFIELDNAME(:LEN_TRIM(HFIELDNAME)))//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP,HCOMMENT=YCOMMENT,HDIR=YDIR)
- PFIELD3D(:,JLAYER,:)=ZWORK
- END DO
-!
-ENDIF
-!
-IF (PRESENT(HDIR)) HCOMMENT = YCOMMENT
-!
-IF (LHOOK) CALL DR_HOOK('READ_SURF_FIELD3D',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
- END SUBROUTINE READ_SURF_FIELD3D
diff --git a/src/SURFEX/read_surf_isba_parn.F90 b/src/SURFEX/read_surf_isba_parn.F90
index d20002b38bc7947a9d77e489d1587ca1700233e7..58b0e4a56468970fb038d9c1e3685485d8702195 100644
--- a/src/SURFEX/read_surf_isba_parn.F90
+++ b/src/SURFEX/read_surf_isba_parn.F90
@@ -2,30 +2,21 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
-!!
-!! MODIFICATIONS
-!! -------------
-!! M.Moge 01/2016 using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads
! #######################
- SUBROUTINE READ_SURF_ISBA_PAR_n (DTCO, U, I,GCP, &
- HPROGRAM,HREC,KLUOUT,KSIZE,PFIELD,KRESP,KVERSION,HCOMMENT,HDIR)
+ SUBROUTINE READ_SURF_ISBA_PAR_n (DTCO, U, GCP, KPATCH, HPROGRAM, HREC, KLUOUT, KSIZE, &
+ KVERSION, KBUGFIX, ODATA, PFIELD, KRESP, HCOMMENT, HDIR)
! #######################
!
-!
-!
-!
-!
+!! MODIFICATIONS
+!! -------------
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
-!
-!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
!
-USE MODI_READ_SURF_FIELD2D
+USE MODI_READ_SURF
USE MODI_HOR_INTERPOL
USE MODI_PUT_ON_ALL_VEGTYPES
USE MODI_VEGTYPE_TO_PATCH
@@ -35,25 +26,24 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
-!
-!
-!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
!
-!
-TYPE(ISBA_t), INTENT(INOUT) :: I
+INTEGER, INTENT(IN) :: KPATCH
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
!
INTEGER, INTENT(IN) :: KLUOUT
INTEGER, INTENT(IN) :: KSIZE
+INTEGER, INTENT(IN) :: KVERSION
+INTEGER, INTENT(IN) :: KBUGFIX
+LOGICAL, DIMENSION(:), INTENT(INOUT) :: ODATA
+!
REAL, DIMENSION(:,:), INTENT(OUT):: PFIELD ! array containing the data field
INTEGER ,INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
-INTEGER, INTENT(IN) :: KVERSION
CHARACTER(LEN=*),OPTIONAL,INTENT(OUT) :: HCOMMENT ! name of the article to be read
CHARACTER(LEN=1),OPTIONAL,INTENT(IN) :: HDIR ! type of field :
! ! 'H' : field with
@@ -63,11 +53,13 @@ INTEGER, INTENT(IN) :: KVERSION
!* local variables
! ---------------
!
+ CHARACTER(LEN=LEN_HREC) :: YREC
+ CHARACTER(LEN=3) :: YVEG
REAL, DIMENSION(KSIZE, NVEGTYPE) :: ZFIELD
-REAL, DIMENSION(SIZE(PFIELD,1),1,I%NPATCH) :: ZFIELD_PATCH
+REAL, DIMENSION(SIZE(PFIELD,1),1,KPATCH) :: ZFIELD_PATCH
REAL, DIMENSION(SIZE(PFIELD,1),1,NVEGTYPE) :: ZFIELD_VEGTYPE
CHARACTER(LEN=1) :: YDIR
-INTEGER :: INI, JPATCH, IPATCH, JVEGTYPE
+INTEGER :: INI, JP, IPATCH, JV, JV2
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------
@@ -78,37 +70,85 @@ IF (PRESENT(HDIR)) YDIR = HDIR
!
INI = SIZE(PFIELD,1)
!
+ZFIELD(:,:) = 0.
+!
IF (KVERSION<7) THEN
- CALL READ_SURF_FIELD2D(&
- HPROGRAM,ZFIELD(:,1:I%NPATCH),HREC,HCOMMENT=HCOMMENT,HDIR=YDIR)
+ !
+ ! fields were written by patch
+ CALL READ_SURF(HPROGRAM,HREC,ZFIELD(:,1:KPATCH),KRESP,HCOMMENT=HCOMMENT,HDIR=YDIR)
+ ! case zoom
IF (INI.NE.KSIZE) THEN
- CALL HOR_INTERPOL(DTCO, U,GCP, &
- KLUOUT,ZFIELD(:,1:I%NPATCH),PFIELD(:,1:I%NPATCH))
+ CALL HOR_INTERPOL(DTCO, U, GCP, KLUOUT,ZFIELD(:,1:KPATCH),PFIELD(:,1:KPATCH))
ELSE
- PFIELD(:,1:I%NPATCH) = ZFIELD(:,1:I%NPATCH)
+ ! classical case
+ PFIELD(:,1:KPATCH) = ZFIELD(:,1:KPATCH)
+ ENDIF
+ !
+ ! classical case
+ IF (SIZE(PFIELD,2)==NVEGTYPE) THEN
+ DO JP = 1, KPATCH
+ ZFIELD_PATCH(:,1,JP) = PFIELD(:,JP)
+ ENDDO
+ ! patchs shared on vegtypes
+ CALL PUT_ON_ALL_VEGTYPES(INI,1,KPATCH,NVEGTYPE,ZFIELD_PATCH,ZFIELD_VEGTYPE)
+ PFIELD(:,:) = ZFIELD_VEGTYPE(:,1,:)
ENDIF
- DO JPATCH = 1, I%NPATCH
- ZFIELD_PATCH(:,1,JPATCH) = PFIELD(:,JPATCH)
- ENDDO
- CALL PUT_ON_ALL_VEGTYPES(INI,1,I%NPATCH,NVEGTYPE,ZFIELD_PATCH,ZFIELD_VEGTYPE)
- PFIELD(:,:) = ZFIELD_VEGTYPE(:,1,:)
+ !
ELSE
- CALL READ_SURF_FIELD2D(&
- HPROGRAM,ZFIELD(:,:),HREC,HCOMMENT=HCOMMENT,HDIR=YDIR)
+ !
+ IF (KVERSION>8 .OR. (KVERSION==8 .AND. KBUGFIX>=1)) THEN
+ !
+ DO JV = 1,NVEGTYPE
+ IF (ODATA(JV)) THEN
+ WRITE(YVEG,FMT='(A1,I2.2)') 'V',JV
+ YREC = TRIM(ADJUSTL(HREC))//YVEG
+ CALL READ_SURF(HPROGRAM,YREC,ZFIELD(:,JV),KRESP,HCOMMENT=HCOMMENT,HDIR=YDIR)
+ ELSE
+
+ !IF (HREC(1:3)=='LAI'.OR.HREC(1:10)=='ALBNIR_VEG'.OR.HREC(1:10)=='ALBVIS_VEG' &
+ ! .OR. HREC(1:6)=='H_TREE') THEN
+ ! IF (JV<=3) ZFIELD(:,JV) = 0.
+ ! IF (HREC(1:6)=='H_TREE'.AND.((JV>=7.AND.JV<=12).OR.JV>=18)) ZFIELD(:,JV) = 0.
+ ! ODATA(JV) = .TRUE.
+ !ENDIF
+
+ IF (.NOT.ODATA(JV)) THEN
+ DO JV2=JV,1,-1
+ IF (ODATA(JV2)) THEN
+ ZFIELD(:,JV) = ZFIELD(:,JV2)
+ EXIT
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDIF
+ ENDDO
+ !
+ ELSE
+ !
+ ! field written by vegtype
+ CALL READ_SURF(HPROGRAM,HREC,ZFIELD(:,:),KRESP,HCOMMENT=HCOMMENT,HDIR=YDIR)
+ !
+ ENDIF
+ !
+ ! case zoom
IF (INI.NE.KSIZE) THEN
- CALL HOR_INTERPOL(DTCO, U,GCP, &
- KLUOUT,ZFIELD(:,:),ZFIELD_VEGTYPE(:,1,:))
+ CALL HOR_INTERPOL(DTCO, U, GCP, KLUOUT,ZFIELD(:,:),ZFIELD_VEGTYPE(:,1,:))
ELSE
+ ! classical case
ZFIELD_VEGTYPE(:,1,:) = ZFIELD(:,:)
- ENDIF
+ ENDIF
+ !
+ ! case mode_read_extern
IF (SIZE(PFIELD,2).NE.NVEGTYPE) THEN
IPATCH = SIZE(PFIELD,2)
PFIELD(:,:) = 0.
- DO JVEGTYPE = 1, NVEGTYPE
- JPATCH = VEGTYPE_TO_PATCH(JVEGTYPE,IPATCH)
- IF (JPATCH<=IPATCH) PFIELD(:,JPATCH) = MAX(PFIELD(:,JPATCH),ZFIELD_VEGTYPE(:,1,JVEGTYPE))
+ DO JV = 1, NVEGTYPE
+ JP = VEGTYPE_TO_PATCH(JV,IPATCH)
+ ! artefact to simplify in mode_read_extern: we take the upper value
+ PFIELD(:,JP) = MAX(PFIELD(:,JP),ZFIELD_VEGTYPE(:,1,JV))
ENDDO
ELSE
+ ! classical case
PFIELD(:,:) = ZFIELD_VEGTYPE(:,1,:)
ENDIF
ENDIF
diff --git a/src/SURFEX/read_teb_confn.F90 b/src/SURFEX/read_teb_confn.F90
index a68fbdb00a1af0f2446f24b3ce28da39e769de4e..5d334d7884db7406b8df17c88a176b98631269b4 100644
--- a/src/SURFEX/read_teb_confn.F90
+++ b/src/SURFEX/read_teb_confn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_TEB_CONF_n (CHT, DGMTO, DGT, DGUT, T, TOP, &
- HPROGRAM)
+ SUBROUTINE READ_TEB_CONF_n (CHT, DMTO, DGO, DUT, T, TOP, HPROGRAM)
! #######################################################
!
!!**** *READ_TEB_CONF* - routine to read the configuration for TEB
@@ -46,8 +45,8 @@
!
!
USE MODD_CH_TEB_n, ONLY : CH_TEB_t
-USE MODD_DIAG_MISC_TEB_OPTION_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
-USE MODD_DIAG_TEB_n, ONLY : DIAG_TEB_t
+USE MODD_DIAG_MISC_TEB_OPTIONS_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
USE MODD_DIAG_UTCI_TEB_n, ONLY : DIAG_UTCI_TEB_t
USE MODD_TEB_n, ONLY : TEB_t
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
@@ -77,9 +76,9 @@ IMPLICIT NONE
!
!
TYPE(CH_TEB_t), INTENT(INOUT) :: CHT
-TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: DGMTO
-TYPE(DIAG_TEB_t), INTENT(INOUT) :: DGT
-TYPE(DIAG_UTCI_TEB_t), INTENT(INOUT) :: DGUT
+TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: DMTO
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_UTCI_TEB_t), INTENT(INOUT) :: DUT
TYPE(TEB_t), INTENT(INOUT) :: T
TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
!
@@ -106,8 +105,8 @@ IMI=GET_CURRENT_MODEL_INDEX_SURFEX()
!
IF (IMI.NE.-1 .AND. LNAM_READ) THEN
CALL INIT_NAM_TEBn(T, TOP)
- CALL INIT_NAM_DIAG_SURFn(DGT, TOP)
- CALL INIT_NAM_DIAG_TEBn(DGMTO, DGT, DGUT)
+ CALL INIT_NAM_DIAG_SURFn(DGO, TOP)
+ CALL INIT_NAM_DIAG_TEBn(DMTO, DGO, DUT)
CALL INIT_NAM_CH_TEBn(CHT)
ENDIF
!
@@ -141,8 +140,8 @@ ENDIF
!
IF (IMI.NE.-1) THEN
CALL UPDATE_NAM_TEBn(T, TOP)
- CALL UPDATE_NAM_DIAG_SURFn(DGT)
- CALL UPDATE_NAM_DIAG_TEBn(DGMTO, DGT, DGUT)
+ CALL UPDATE_NAM_DIAG_SURFn(DGO)
+ CALL UPDATE_NAM_DIAG_TEBn(DMTO, DGO, DUT)
CALL UPDATE_NAM_CH_TEBn(CHT)
ENDIF
!
diff --git a/src/SURFEX/read_teb_gardenn.F90 b/src/SURFEX/read_teb_gardenn.F90
index 61084455f5e1e1eab12f7e3f914e5a4768903a36..71f6b691e3f6a1f6e01c2ea39e85d988c94c1207 100644
--- a/src/SURFEX/read_teb_gardenn.F90
+++ b/src/SURFEX/read_teb_gardenn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_TEB_GARDEN_n (DTCO, DGU, U, GDM, &
- HPROGRAM,HPATCH)
+ SUBROUTINE READ_TEB_GARDEN_n (DTCO, U, IO, P, PEK, HPROGRAM,HPATCH)
! ##################################
!
!!**** *READ_TEB_GARDEN_n* - routine to initialise ISBA variables
@@ -47,9 +46,11 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t
+!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_PE_t, ISBA_P_t
!
USE MODD_CO2V_PAR, ONLY : XANFMINIT, XCONDCTMIN
!
@@ -76,9 +77,11 @@ IMPLICIT NONE
! -------------------------
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
+!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_P_t), INTENT(INOUT) :: P
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
CHARACTER(LEN=3), INTENT(IN) :: HPATCH ! current TEB patch identificator
@@ -96,7 +99,7 @@ REAL, DIMENSION(:),ALLOCATABLE :: ZWORK ! 2D array to write data in file
!
INTEGER :: IWORK ! Work integer
!
-INTEGER :: JLAYER, JNBIOMASS ! loop counter on layers
+INTEGER :: JL, JNBIOMASS ! loop counter on layers
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
@@ -106,16 +109,13 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('READ_TEB_GARDEN_N',0,ZHOOK_HANDLE)
YRECFM='SIZE_TOWN'
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'TOWN ',ILU)
+ CALL GET_TYPE_DIM_n(DTCO, U, 'TOWN ',ILU)
!
YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
!
YRECFM='BUG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IBUGFIX,IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
!
!* 2. Prognostic fields:
! -----------------
@@ -123,44 +123,42 @@ YRECFM='BUG'
ALLOCATE(ZWORK(ILU))
!* soil temperatures
!
-IWORK=GDM%TGDO%NGROUND_LAYER
+IWORK=IO%NGROUND_LAYER
!
-ALLOCATE(GDM%TGD%CUR%XTG(ILU,IWORK))
-DO JLAYER=1,IWORK
- WRITE(YLVL,'(I2)') JLAYER
+ALLOCATE(PEK%XTG(ILU,IWORK))
+DO JL=1,IWORK
+ WRITE(YLVL,'(I2)') JL
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
YRECFM=HPATCH//'GD_TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
ELSE
YRECFM='TWN_TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
ENDIF
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ZWORK(:),IRESP)
- GDM%TGD%CUR%XTG(:,JLAYER)=ZWORK
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP)
+ PEK%XTG(:,JL)=ZWORK
END DO
!
!
!* soil liquid water content
!
-ALLOCATE(GDM%TGD%CUR%XWG(ILU,IWORK))
-DO JLAYER=1,GDM%TGDO%NGROUND_LAYER
- WRITE(YLVL,'(I2)') JLAYER
+ALLOCATE(PEK%XWG(ILU,IWORK))
+DO JL=1,IO%NGROUND_LAYER
+ WRITE(YLVL,'(I2)') JL
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
YRECFM=HPATCH//'GD_WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
ELSE
YRECFM='TWN_WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
ENDIF
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ZWORK(:),IRESP)
- GDM%TGD%CUR%XWG(:,JLAYER)=ZWORK
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP)
+ PEK%XWG(:,JL)=ZWORK
END DO
!
!* soil ice water content
!
-ALLOCATE(GDM%TGD%CUR%XWGI(ILU,IWORK))
-DO JLAYER=1,GDM%TGDO%NGROUND_LAYER
- WRITE(YLVL,'(I2)') JLAYER
+ALLOCATE(PEK%XWGI(ILU,IWORK))
+DO JL=1,IO%NGROUND_LAYER
+ WRITE(YLVL,'(I2)') JL
! ajouter ici un test pour lire les anciens fichiers
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
YRECFM=HPATCH//'GD_WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
@@ -168,62 +166,53 @@ DO JLAYER=1,GDM%TGDO%NGROUND_LAYER
YRECFM='TWN_WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
ENDIF
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ZWORK(:),IRESP)
- GDM%TGD%CUR%XWGI(:,JLAYER)=ZWORK
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP)
+ PEK%XWGI(:,JL)=ZWORK
END DO
!
!* water intercepted on leaves
!
-ALLOCATE(GDM%TGD%CUR%XWR(ILU))
+ALLOCATE(PEK%XWR(ILU))
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
YRECFM=HPATCH//'GD_WR'
ELSE
YRECFM='TWN_WR'
ENDIF
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,GDM%TGD%CUR%XWR(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,PEK%XWR(:),IRESP)
!
!* Leaf Area Index (if prognostic)
!
-IF (GDM%TVG%CPHOTO=='LAI' .OR. GDM%TVG%CPHOTO=='LST' .OR. &
- GDM%TVG%CPHOTO=='NIT' .OR. GDM%TVG%CPHOTO=='NCB') THEN
+IF (IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') THEN
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
YRECFM=HPATCH//'GD_LAI'
ELSE
YRECFM='TWN_LAI'
ENDIF
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,GDM%TGDPE%CUR%XLAI(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,PEK%XLAI(:),IRESP)
END IF
!
!* snow mantel
!
CALL END_IO_SURF_n(HPROGRAM)
CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ')
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'TOWN ','TEB ','READ ')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'FULL ','SURF ','READ ')
!
- CALL TOWN_PRESENCE(&
- HPROGRAM,GTOWN)
+ CALL TOWN_PRESENCE(HPROGRAM,GTOWN)
!
CALL END_IO_SURF_n(HPROGRAM)
CALL SET_SURFEX_FILEIN(HPROGRAM,'PREP')
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'TOWN ','TEB ','READ ')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'TOWN ','TEB ','READ ')
!
IF (.NOT. GTOWN) THEN
- GDM%TGD%CUR%TSNOW%SCHEME='1-L'
- CALL ALLOCATE_GR_SNOW(GDM%TGD%CUR%TSNOW,ILU,1)
+ PEK%TSNOW%SCHEME='1-L'
+ CALL ALLOCATE_GR_SNOW(PEK%TSNOW,ILU)
ELSE
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
- CALL READ_GR_SNOW(&
- HPROGRAM,'GD',HPATCH,ILU,1,GDM%TGD%CUR%TSNOW )
+ CALL READ_GR_SNOW(HPROGRAM,'GD',HPATCH,ILU,ILU,P%NR_P,0,PEK%TSNOW )
ELSE
- CALL READ_GR_SNOW(&
- HPROGRAM,'GARD',HPATCH,ILU,1,GDM%TGD%CUR%TSNOW )
+ CALL READ_GR_SNOW(HPROGRAM,'GARD',HPATCH,ILU,ILU,P%NR_P,0,PEK%TSNOW )
ENDIF
ENDIF
!
@@ -234,58 +223,52 @@ ENDIF
!
!* aerodynamical resistance
!
-ALLOCATE(GDM%TGD%CUR%XRESA(ILU))
+ALLOCATE(PEK%XRESA(ILU))
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
YRECFM=HPATCH//'GD_RES'
ELSE
YRECFM='TWN_RESA'
ENDIF
YRECFM=ADJUSTL(YRECFM)
-GDM%TGD%CUR%XRESA(:) = 100.
- CALL READ_SURF(&
- HPROGRAM,YRECFM,GDM%TGD%CUR%XRESA(:),IRESP)
+PEK%XRESA(:) = 100.
+ CALL READ_SURF(HPROGRAM,YRECFM,PEK%XRESA(:),IRESP)
!
-ALLOCATE(GDM%TGD%CUR%XLE(ILU))
-GDM%TGD%CUR%XLE(:) = XUNDEF
+ALLOCATE(PEK%XLE(ILU))
+PEK%XLE(:) = XUNDEF
!
!* ISBA-AGS variables
!
-IF (GDM%TVG%CPHOTO/='NON') THEN
- ALLOCATE(GDM%TGD%CUR%XAN (ILU))
- ALLOCATE(GDM%TGD%CUR%XANDAY(ILU))
- ALLOCATE(GDM%TGD%CUR%XANFM (ILU))
- ALLOCATE(GDM%TGDP%XANF (ILU))
- GDM%TGD%CUR%XAN(:) = 0.
- GDM%TGD%CUR%XANDAY(:) = 0.
- GDM%TGD%CUR%XANFM(:) = XANFMINIT
- GDM%TGD%CUR%XLE(:) = 0.
+IF (IO%CPHOTO/='NON') THEN
+ ALLOCATE(PEK%XAN (ILU))
+ ALLOCATE(PEK%XANDAY(ILU))
+ ALLOCATE(PEK%XANFM (ILU))
+ PEK%XAN(:) = 0.
+ PEK%XANDAY(:) = 0.
+ PEK%XANFM(:) = XANFMINIT
+ PEK%XLE(:) = 0.
ELSE
- ALLOCATE(GDM%TGD%CUR%XAN (0))
- ALLOCATE(GDM%TGD%CUR%XANDAY(0))
- ALLOCATE(GDM%TGD%CUR%XANFM (0))
- ALLOCATE(GDM%TGDP%XANF (0))
+ ALLOCATE(PEK%XAN (0))
+ ALLOCATE(PEK%XANDAY(0))
+ ALLOCATE(PEK%XANFM (0))
ENDIF
!
-IF(GDM%TVG%CPHOTO/='NON') THEN
- ALLOCATE(GDM%TGD%CUR%XBIOMASS (ILU,GDM%TVG%NNBIOMASS))
- ALLOCATE(GDM%TGD%CUR%XRESP_BIOMASS (ILU,GDM%TVG%NNBIOMASS))
+IF(IO%CPHOTO/='NON') THEN
+ ALLOCATE(PEK%XBIOMASS (ILU,IO%NNBIOMASS))
+ ALLOCATE(PEK%XRESP_BIOMASS (ILU,IO%NNBIOMASS))
ELSE
- ALLOCATE(GDM%TGD%CUR%XBIOMASS (0,0))
- ALLOCATE(GDM%TGD%CUR%XRESP_BIOMASS (0,0))
+ ALLOCATE(PEK%XBIOMASS (0,0))
+ ALLOCATE(PEK%XRESP_BIOMASS (0,0))
END IF
!
-IF (GDM%TVG%CPHOTO=='AGS' .OR. GDM%TVG%CPHOTO=='AST') THEN
+IF (IO%CPHOTO=='AST') THEN
!
- GDM%TGD%CUR%XBIOMASS(:,:) = 0.
- GDM%TGD%CUR%XRESP_BIOMASS(:,:) = 0.
-ELSEIF (GDM%TVG%CPHOTO=='LAI' .OR. GDM%TVG%CPHOTO=='LST') THEN
+ PEK%XBIOMASS(:,:) = 0.
+ PEK%XRESP_BIOMASS(:,:) = 0.
!
- GDM%TGD%CUR%XBIOMASS(:,1) = GDM%TGDP%XBSLAI(:) * GDM%TGDPE%CUR%XLAI(:)
- GDM%TGD%CUR%XRESP_BIOMASS(:,:) = 0.
-ELSEIF (GDM%TVG%CPHOTO=='NIT' .OR. GDM%TVG%CPHOTO=='NCB') THEN
+ELSEIF (IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') THEN
!
- GDM%TGD%CUR%XBIOMASS(:,:) = 0.
- DO JNBIOMASS=1,GDM%TVG%NNBIOMASS
+ PEK%XBIOMASS(:,:) = 0.
+ DO JNBIOMASS=1,IO%NNBIOMASS
WRITE(YLVL,'(I1)') JNBIOMASS
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
YRECFM=HPATCH//'GD_BIOMA'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
@@ -293,12 +276,11 @@ ELSEIF (GDM%TVG%CPHOTO=='NIT' .OR. GDM%TVG%CPHOTO=='NCB') THEN
YRECFM='TWN_BIOMASS'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
ENDIF
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,GDM%TGD%CUR%XBIOMASS(:,JNBIOMASS),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,PEK%XBIOMASS(:,JNBIOMASS),IRESP)
END DO
- GDM%TGD%CUR%XRESP_BIOMASS(:,:) = 0.
- DO JNBIOMASS=2,GDM%TVG%NNBIOMASS
+ PEK%XRESP_BIOMASS(:,:) = 0.
+ DO JNBIOMASS=2,IO%NNBIOMASS
WRITE(YLVL,'(I1)') JNBIOMASS
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
YRECFM=HPATCH//'GD_RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
@@ -306,8 +288,7 @@ ELSEIF (GDM%TVG%CPHOTO=='NIT' .OR. GDM%TVG%CPHOTO=='NCB') THEN
YRECFM='TWN_RESP_BIOM'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
ENDIF
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,GDM%TGD%CUR%XRESP_BIOMASS(:,JNBIOMASS),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,PEK%XRESP_BIOMASS(:,JNBIOMASS),IRESP)
END DO
!
ENDIF
diff --git a/src/SURFEX/read_teb_greenroofn.F90 b/src/SURFEX/read_teb_greenroofn.F90
index ac913eefb7425bf30dd364dbfa281f678e7470d1..be491eaade55498d8620c58876a6f0118451027a 100644
--- a/src/SURFEX/read_teb_greenroofn.F90
+++ b/src/SURFEX/read_teb_greenroofn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_TEB_GREENROOF_n (DTCO, U, TVG, GRM, &
- HPROGRAM,HPATCH)
+ SUBROUTINE READ_TEB_GREENROOF_n (DTCO, U, IO, P, PEK, HPROGRAM,HPATCH)
! ##################################
!
!!**** *READ_TEB_GREENROOF_n* - routine to initialise ISBA variables
@@ -45,8 +44,9 @@
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
-USE MODD_SURFEX_n, ONLY : TEB_GREENROOF_MODEL_t
+!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_PE_t, ISBA_P_t
!
USE MODD_CO2V_PAR, ONLY : XANFMINIT, XCONDCTMIN
!
@@ -57,9 +57,6 @@ USE MODI_READ_SURF
!
USE MODI_READ_GR_SNOW
!
-!
-!
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -73,16 +70,17 @@ IMPLICIT NONE
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
-TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM
-
+!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_P_t), INTENT(INOUT) :: P
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
CHARACTER(LEN=3), INTENT(IN) :: HPATCH ! current TEB patch identificator
!
!* 0.2 Declarations of local variables
! -------------------------------
-INTEGER :: ILU ! 1D physical dimension
+INTEGER :: ILU ! 1D physical dimension
INTEGER :: IRESP ! Error code after redding
INTEGER :: IWORK ! Work integer
INTEGER :: JLAYER, JNBIOMASS ! loop counter on layers
@@ -99,8 +97,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('READ_TEB_GREENROOF_N',0,ZHOOK_HANDLE)
YRECFM='SIZE_TOWN'
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'TOWN ',ILU)
+ CALL GET_TYPE_DIM_n(DTCO, U, 'TOWN ',ILU)
!
!
!* 2. Prognostic fields:
@@ -110,60 +107,54 @@ ALLOCATE(ZWORK(ILU))
!
!* soil temperatures
!
-IWORK = GRM%TGRO%NLAYER_GR
+IWORK = IO%NGROUND_LAYER
!
DO JLAYER=1,IWORK
WRITE(YLVL,'(I2)') JLAYER
YRECFM=HPATCH//'GR_TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ZWORK(:),IRESP)
- GRM%TGR%CUR%XTG(:,JLAYER) = ZWORK
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP)
+ PEK%XTG(:,JLAYER) = ZWORK
END DO
!
!
!* soil liquid water content
!
-DO JLAYER=1,GRM%TGRO%NLAYER_GR
+DO JLAYER=1,IO%NGROUND_LAYER
WRITE(YLVL,'(I2)') JLAYER
YRECFM=HPATCH//'GR_WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ZWORK(:),IRESP)
- GRM%TGR%CUR%XWG(:,JLAYER) = ZWORK
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP)
+ PEK%XWG(:,JLAYER) = ZWORK
END DO
!
!* soil ice water content
!
-DO JLAYER=1,GRM%TGRO%NLAYER_GR
+DO JLAYER=1,IO%NGROUND_LAYER
WRITE(YLVL,'(I2)') JLAYER
YRECFM=HPATCH//'GR_WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ZWORK(:),IRESP)
- GRM%TGR%CUR%XWGI(:,JLAYER) = ZWORK
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP)
+ PEK%XWGI(:,JLAYER) = ZWORK
END DO
!
!* water intercepted on leaves
!
YRECFM=HPATCH//'GR_WR'
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,GRM%TGR%CUR%XWR(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,PEK%XWR(:),IRESP)
!
!* Leaf Area Index
!
-IF (TVG%CPHOTO=='LAI' .OR. TVG%CPHOTO=='LST' .OR. TVG%CPHOTO=='NIT' .OR. TVG%CPHOTO=='NCB') THEN
+IF (IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') THEN
YRECFM = HPATCH//'GR_LAI'
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,GRM%TGRPE%CUR%XLAI(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,PEK%XLAI(:),IRESP)
END IF
!
!* snow mantel
!
- CALL READ_GR_SNOW(&
- HPROGRAM,'GR',HPATCH,ILU,1,GRM%TGR%CUR%TSNOW )! GROO:GreenROOf
+ CALL READ_GR_SNOW(HPROGRAM,'GR',HPATCH,ILU,ILU,P%NR_P,0,PEK%TSNOW )! IOO:GreenROOf
!
!-------------------------------------------------------------------------------
!
@@ -174,44 +165,38 @@ END IF
!
YRECFM = HPATCH//'GR_RESA'
YRECFM=ADJUSTL(YRECFM)
-GRM%TGR%CUR%XRESA(:) = 100.
- CALL READ_SURF(&
- HPROGRAM,YRECFM,GRM%TGR%CUR%XRESA(:),IRESP)
+PEK%XRESA(:) = 100.
+ CALL READ_SURF(HPROGRAM,YRECFM,PEK%XRESA(:),IRESP)
!
-GRM%TGR%CUR%XLE(:) = XUNDEF
+PEK%XLE(:) = XUNDEF
!
!* ISBA-AGS variables
!
-IF (TVG%CPHOTO/='NON') THEN
- GRM%TGR%CUR%XAN(:) = 0.
- GRM%TGR%CUR%XANDAY(:) = 0.
- GRM%TGR%CUR%XANFM(:) = XANFMINIT
- GRM%TGR%CUR%XLE(:) = 0.
+IF (IO%CPHOTO/='NON') THEN
+ PEK%XAN(:) = 0.
+ PEK%XANDAY(:) = 0.
+ PEK%XANFM(:) = XANFMINIT
+ PEK%XLE(:) = 0.
END IF
!
-IF (TVG%CPHOTO=='AGS' .OR. TVG%CPHOTO=='AST') THEN
- GRM%TGR%CUR%XBIOMASS(:,:) = 0.
- GRM%TGR%CUR%XRESP_BIOMASS(:,:) = 0.
-ELSEIF (TVG%CPHOTO=='LAI' .OR. TVG%CPHOTO=='LST') THEN
- GRM%TGR%CUR%XBIOMASS(:,1) = GRM%TGRP%XBSLAI(:) * GRM%TGRPE%CUR%XLAI(:)
- GRM%TGR%CUR%XRESP_BIOMASS(:,:) = 0.
-ELSEIF (TVG%CPHOTO=='NIT') THEN
- GRM%TGR%CUR%XBIOMASS(:,:) = 0.
- DO JNBIOMASS=1,TVG%NNBIOMASS
+IF (IO%CPHOTO=='AST') THEN
+ PEK%XBIOMASS(:,:) = 0.
+ PEK%XRESP_BIOMASS(:,:) = 0.
+ELSEIF (IO%CPHOTO=='NIT') THEN
+ PEK%XBIOMASS(:,:) = 0.
+ DO JNBIOMASS=1,IO%NNBIOMASS
WRITE(YLVL,'(I1)') JNBIOMASS
YRECFM=HPATCH//'GR_BIOMA'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,GRM%TGR%CUR%XBIOMASS(:,JNBIOMASS),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,PEK%XBIOMASS(:,JNBIOMASS),IRESP)
END DO
- GRM%TGR%CUR%XRESP_BIOMASS(:,:) = 0.
- DO JNBIOMASS=2,TVG%NNBIOMASS
+ PEK%XRESP_BIOMASS(:,:) = 0.
+ DO JNBIOMASS=2,IO%NNBIOMASS
WRITE(YLVL,'(I1)') JNBIOMASS
YRECFM=HPATCH//'GR_RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,GRM%TGR%CUR%XRESP_BIOMASS(:,JNBIOMASS),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,PEK%XRESP_BIOMASS(:,JNBIOMASS),IRESP)
END DO
ENDIF
!
diff --git a/src/SURFEX/read_teb_patch.F90 b/src/SURFEX/read_teb_patch.F90
index c41c136ffb6a307506a2726b37827bc313d6bbc1..5501c160d64806380e7b8d99f2eb9339b6b9b7fa 100644
--- a/src/SURFEX/read_teb_patch.F90
+++ b/src/SURFEX/read_teb_patch.F90
@@ -3,15 +3,13 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #######################
- SUBROUTINE READ_TEB_PATCH (&
- HFILEPGD,HFILEPGDTYPE,KTEB_PATCH)
+ SUBROUTINE READ_TEB_PATCH (HFILEPGD,HFILEPGDTYPE,KVERSION,KBUGFIX,KTEB_PATCH,HDIR)
! #######################
!
!
!
!
USE MODI_READ_SURF
-USE MODI_TOWN_PRESENCE
!
USE MODI_OPEN_AUX_IO_SURF
USE MODI_CLOSE_AUX_IO_SURF
@@ -23,23 +21,22 @@ IMPLICIT NONE
!
!* dummy arguments
! ---------------
-!
-!
!
CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! name of file
CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! type of file
+INTEGER, INTENT(IN) :: KVERSION
+INTEGER, INTENT(IN) :: KBUGFIX
INTEGER, INTENT(OUT) :: KTEB_PATCH! number of TEB patches
+ CHARACTER(LEN=1), INTENT(IN), OPTIONAL :: HDIR
!
!
!* local variables
! ---------------
!
+ CHARACTER(LEN=1) :: YDIR
CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
INTEGER :: IRESP ! reading return code
!
-INTEGER :: IVERSION ! surface version
-INTEGER :: IBUGFIX ! surface bugfix
-LOGICAL :: GTOWN
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
@@ -47,28 +44,14 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('READ_TEB_PATCH',0,ZHOOK_HANDLE)
!
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'FULL ')
-YRECFM='VERSION'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,IVERSION,IRESP)
-YRECFM='BUG'
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,IBUGFIX,IRESP)
-!
- CALL TOWN_PRESENCE(&
- HFILEPGDTYPE,GTOWN)
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+YDIR = 'H'
+IF (PRESENT(HDIR)) YDIR = HDIR
!
-IF (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<=2).OR..NOT.GTOWN) THEN
+IF (KVERSION<7 .OR. (KVERSION==7 .AND. KBUGFIX<=2)) THEN
KTEB_PATCH = 1
ELSE
YRECFM='TEB_PATCH'
- CALL OPEN_AUX_IO_SURF(&
- HFILEPGD,HFILEPGDTYPE,'TOWN ')
- CALL READ_SURF(&
- HFILEPGDTYPE,YRECFM,KTEB_PATCH,IRESP)
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,KTEB_PATCH,IRESP)
END IF
!
IF (LHOOK) CALL DR_HOOK('READ_TEB_PATCH',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/read_teb_veg_confn.F90 b/src/SURFEX/read_teb_veg_confn.F90
index 08bf2bbf2231e6370f57d16746f4126693686ff8..5d84e71c75f94d25b1d55450c5bb038c3205c0ba 100644
--- a/src/SURFEX/read_teb_veg_confn.F90
+++ b/src/SURFEX/read_teb_veg_confn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_TEB_VEG_CONF_n (CHT, TVG, &
- HPROGRAM)
+ SUBROUTINE READ_TEB_VEG_CONF_n (CHT, IO, HPROGRAM)
! #######################################################
!
!!**** *READ_TEB_VEG_CONF* - routine to read the configuration for VEG
@@ -47,7 +46,7 @@
!
!
USE MODD_CH_TEB_n, ONLY : CH_TEB_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
USE MODE_MODELN_SURFEX_HANDLER
!
@@ -74,7 +73,7 @@ IMPLICIT NONE
!
!
TYPE(CH_TEB_t), INTENT(INOUT) :: CHT
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling ISBA
@@ -98,11 +97,11 @@ IF (LHOOK) CALL DR_HOOK('READ_TEB_VEG_CONF_N',0,ZHOOK_HANDLE)
IMI=GET_CURRENT_MODEL_INDEX_SURFEX()
!
IF (IMI.NE.-1 .AND. LNAM_READ) THEN
- CALL INIT_NAM_TEB_VEGn(TVG)
- CALL INIT_NAM_TEB_VEG_AGSn(TVG)
+ CALL INIT_NAM_TEB_VEGn(IO)
+ CALL INIT_NAM_TEB_VEG_AGSn(IO)
CALL INIT_NAM_CH_CONTROLn(CHT)
CALL INIT_NAM_CH_TEB_VEGn(CHT)
- CALL INIT_NAM_SGH_TEB_VEGn(TVG)
+ CALL INIT_NAM_SGH_TEB_VEGn(IO)
ENDIF
IF (LNAM_READ) THEN
@@ -126,9 +125,7 @@ IF (LNAM_READ) THEN
CALL POSNAM(INAM,'NAM_SGH_ISBAN',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=INAM,NML=NAM_SGH_ISBAn)
!
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CROUGH',CROUGH,'NONE','Z01D','Z04D','BE04','UNDE')
CALL TEST_NAM_VAR_SURF(ILUOUT,'CSCOND',CSCOND,'NP89','PL98')
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CALBEDO',CALBEDO,'EVOL','DRY ','WET ','MEAN','USER','CM13')
CALL TEST_NAM_VAR_SURF(ILUOUT,'CC1DRY',CC1DRY,'DEF ','GB93')
CALL TEST_NAM_VAR_SURF(ILUOUT,'CSOILFRZ',CSOILFRZ,'DEF','LWT')
CALL TEST_NAM_VAR_SURF(ILUOUT,'CDIFSFCOND',CDIFSFCOND,'DEF ','MLCH')
@@ -146,11 +143,11 @@ IF (LNAM_READ) THEN
ENDIF
!
IF (IMI.NE.-1) THEN
- CALL UPDATE_NAM_TEB_VEGn(TVG)
- CALL UPDATE_NAM_TEB_VEG_AGSn(TVG)
+ CALL UPDATE_NAM_TEB_VEGn(IO)
+ CALL UPDATE_NAM_TEB_VEG_AGSn(IO)
CALL UPDATE_NAM_CH_TEB_VEGn(CHT)
CALL UPDATE_NAM_CH_CONTROLn(CHT)
- CALL UPDATE_NAM_SGH_TEB_VEGn(TVG)
+ CALL UPDATE_NAM_SGH_TEB_VEGn(IO)
ENDIF
IF (LHOOK) CALL DR_HOOK('READ_TEB_VEG_CONF_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/read_tebn.F90 b/src/SURFEX/read_tebn.F90
index 6cfdfe3bd58c5f79307f8327ba08ac805f4519a6..0b48efad8eaade1c3b7980d4a315bcb15bbe77ee 100644
--- a/src/SURFEX/read_tebn.F90
+++ b/src/SURFEX/read_tebn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_TEB_n (B, BOP, DTCO, DGU, U, T, TOP, TPN, &
- HPROGRAM,KPATCH)
+ SUBROUTINE READ_TEB_n (B, BOP, DTCO, U, T, TOP, TPN, HPROGRAM,KPATCH)
! #########################################
!
!!**** *READ_TEB_n* - reads TEB fields
@@ -43,7 +42,6 @@
USE MODD_BEM_n, ONLY : BEM_t
USE MODD_BEM_OPTION_n, ONLY : BEM_OPTIONS_t
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_TEB_n, ONLY : TEB_t
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
@@ -80,7 +78,6 @@ IMPLICIT NONE
TYPE(BEM_t), INTENT(INOUT) :: B
TYPE(BEM_OPTIONS_t), INTENT(INOUT) :: BOP
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(TEB_t), INTENT(INOUT) :: T
TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
@@ -96,6 +93,7 @@ INTEGER, INTENT(IN) :: KPATCH ! current patch number
LOGICAL :: GTOWN ! town variables written in the file
INTEGER :: ILU ! 1D physical dimension
!
+INTEGER, DIMENSION(:), ALLOCATABLE :: IMASK
INTEGER :: IRESP ! Error code after redding
!
CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
@@ -105,7 +103,7 @@ INTEGER :: IVERSION, IBUGFIX
LOGICAL :: GOLD_NAME ! name of temperatures in old versions of SURFEX
LOGICAL :: GKNOWN
!
-INTEGER :: JLAYER ! loop counter on layers
+INTEGER :: JLAYER, JI ! loop counter on layers
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
@@ -114,16 +112,13 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('READ_TEB_N',0,ZHOOK_HANDLE)
YRECFM='SIZE_TOWN'
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'TOWN ',ILU)
+ CALL GET_TYPE_DIM_n(DTCO, U, 'TOWN ',ILU)
!
YPATCH=' '
IF (TOP%NTEB_PATCH>1) WRITE(YPATCH,FMT='(A1,I1,A1)') 'T',KPATCH,'_'
!
- CALL READ_SURF(&
- HPROGRAM,'VERSION',IVERSION,IRESP)
- CALL READ_SURF(&
- HPROGRAM,'BUG',IBUGFIX,IRESP)
+ CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP)
GOLD_NAME = (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<=2))
!
!* 2. Prognostic fields:
@@ -131,192 +126,176 @@ GOLD_NAME = (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<=2))
!
!* roof temperatures
!
-ALLOCATE(T%CUR%XT_ROOF(ILU,TOP%NROOF_LAYER))
+ALLOCATE(T%XT_ROOF(ILU,TOP%NROOF_LAYER))
!
DO JLAYER=1,TOP%NROOF_LAYER
WRITE(YRECFM,'(A3,A5,I1.1)') YPATCH,'TROOF',JLAYER
YRECFM=ADJUSTL(YRECFM)
IF (GOLD_NAME) WRITE(YRECFM,'(A6,I1.1)') 'T_ROOF',JLAYER
- CALL READ_SURF(&
- HPROGRAM,YRECFM,T%CUR%XT_ROOF(:,JLAYER),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,T%XT_ROOF(:,JLAYER),IRESP)
END DO
!
!* roof water content
!
-ALLOCATE(T%CUR%XWS_ROOF(ILU))
+ALLOCATE(T%XWS_ROOF(ILU))
!
YRECFM=YPATCH//'WS_ROOF'
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,T%CUR%XWS_ROOF(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,T%XWS_ROOF(:),IRESP)
!
!* road temperatures
!
-ALLOCATE(T%CUR%XT_ROAD(ILU,TOP%NROAD_LAYER))
+ALLOCATE(T%XT_ROAD(ILU,TOP%NROAD_LAYER))
!
DO JLAYER=1,TOP%NROAD_LAYER
WRITE(YRECFM,'(A3,A5,I1.1)') YPATCH,'TROAD',JLAYER
YRECFM=ADJUSTL(YRECFM)
IF (GOLD_NAME) WRITE(YRECFM,'(A6,I1.1)') 'T_ROAD',JLAYER
- CALL READ_SURF(&
- HPROGRAM,YRECFM,T%CUR%XT_ROAD(:,JLAYER),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,T%XT_ROAD(:,JLAYER),IRESP)
END DO
!
!* road water content
!
-ALLOCATE(T%CUR%XWS_ROAD(ILU))
+ALLOCATE(T%XWS_ROAD(ILU))
!
YRECFM=YPATCH//'WS_ROAD'
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,T%CUR%XWS_ROAD(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,T%XWS_ROAD(:),IRESP)
!
!* wall temperatures
!
-ALLOCATE(T%CUR%XT_WALL_A(ILU,TOP%NWALL_LAYER))
-ALLOCATE(T%CUR%XT_WALL_B(ILU,TOP%NWALL_LAYER))
+ALLOCATE(T%XT_WALL_A(ILU,TOP%NWALL_LAYER))
+ALLOCATE(T%XT_WALL_B(ILU,TOP%NWALL_LAYER))
!
DO JLAYER=1,TOP%NWALL_LAYER
IF (TOP%CWALL_OPT=='UNIF' .OR. GOLD_NAME) THEN
WRITE(YRECFM,'(A3,A5,I1.1)') YPATCH,'TWALL',JLAYER
YRECFM=ADJUSTL(YRECFM)
IF (GOLD_NAME) WRITE(YRECFM,'(A6,I1.1)') 'T_WALL',JLAYER
- CALL READ_SURF(&
- HPROGRAM,YRECFM,T%CUR%XT_WALL_A(:,JLAYER),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,T%XT_WALL_A(:,JLAYER),IRESP)
!
- T%CUR%XT_WALL_B = T%CUR%XT_WALL_A
+ T%XT_WALL_B = T%XT_WALL_A
ELSE
WRITE(YRECFM,'(A3,A6,I1.1)') YPATCH,'TWALLA',JLAYER
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,T%CUR%XT_WALL_A(:,JLAYER),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,T%XT_WALL_A(:,JLAYER),IRESP)
!
WRITE(YRECFM,'(A3,A6,I1.1)') YPATCH,'TWALLB',JLAYER
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,T%CUR%XT_WALL_B(:,JLAYER),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,T%XT_WALL_B(:,JLAYER),IRESP)
END IF
END DO
!
!* internal building temperature
!
-ALLOCATE(B%CUR%XTI_BLD(ILU))
+ALLOCATE(B%XTI_BLD(ILU))
!
YRECFM=YPATCH//'TI_BLD'
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,B%CUR%XTI_BLD(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,B%XTI_BLD(:),IRESP)
!
!* outdoor window temperature
!
-ALLOCATE(B%CUR%XT_WIN1(ILU))
+ALLOCATE(B%XT_WIN1(ILU))
!
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
YRECFM=YPATCH//'T_WIN1'
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,B%CUR%XT_WIN1(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,B%XT_WIN1(:),IRESP)
ELSE
- B%CUR%XT_WIN1(:)=XUNDEF
+ B%XT_WIN1(:)=XUNDEF
ENDIF
!
!
!* internal building specific humidity
!
-ALLOCATE(B%CUR%XQI_BLD(ILU))
+ALLOCATE(B%XQI_BLD(ILU))
!
IF (TOP%CBEM=='BEM' .AND. (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3)) THEN
YRECFM=YPATCH//'QI_BLD'
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,B%CUR%XQI_BLD(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,B%XQI_BLD(:),IRESP)
ELSE
- B%CUR%XQI_BLD(:) = XUNDEF
+ B%XQI_BLD(:) = XUNDEF
ENDIF
!
IF (TOP%CBEM=='BEM') THEN
!
!* indoor window temperature
!
- ALLOCATE(B%CUR%XT_WIN2(ILU))
+ ALLOCATE(B%XT_WIN2(ILU))
!
YRECFM=YPATCH//'T_WIN2'
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,B%CUR%XT_WIN2(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,B%XT_WIN2(:),IRESP)
!
!* floor temperatures
!
- ALLOCATE(B%CUR%XT_FLOOR(ILU,BOP%NFLOOR_LAYER))
+ ALLOCATE(B%XT_FLOOR(ILU,BOP%NFLOOR_LAYER))
!
DO JLAYER=1,BOP%NFLOOR_LAYER
WRITE(YRECFM,'(A3,A5,I1.1)') YPATCH,'TFLOO',JLAYER
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,B%CUR%XT_FLOOR(:,JLAYER),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,B%XT_FLOOR(:,JLAYER),IRESP)
END DO
!
!* mass temperatures
!
- ALLOCATE(B%CUR%XT_MASS(ILU,BOP%NFLOOR_LAYER))
+ ALLOCATE(B%XT_MASS(ILU,BOP%NFLOOR_LAYER))
!
DO JLAYER=1,BOP%NFLOOR_LAYER
WRITE(YRECFM,'(A3,A5,I1.1)') YPATCH,'TMASS',JLAYER
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,B%CUR%XT_MASS(:,JLAYER),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,B%XT_MASS(:,JLAYER),IRESP)
END DO
!
ELSE
- ALLOCATE(B%CUR%XT_WIN2(0))
- ALLOCATE(B%CUR%XT_FLOOR(0,0))
- ALLOCATE(B%CUR%XT_MASS(0,0))
+ ALLOCATE(B%XT_WIN2(0))
+ ALLOCATE(B%XT_FLOOR(0,0))
+ ALLOCATE(B%XT_MASS(0,0))
ENDIF
!
!* deep road temperature
!
-ALLOCATE(T%CUR%XTI_ROAD(ILU))
+ALLOCATE(T%XTI_ROAD(ILU))
!
YRECFM=YPATCH//'TI_ROAD'
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,T%CUR%XTI_ROAD(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,T%XTI_ROAD(:),IRESP)
!
!
!* snow mantel
!
CALL END_IO_SURF_n(HPROGRAM)
CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ')
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'TOWN ','TEB ','READ ')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'FULL ','SURF ','READ ')
!
- CALL TOWN_PRESENCE(&
- HPROGRAM,GTOWN)
+ CALL TOWN_PRESENCE(HPROGRAM,GTOWN)
!
CALL END_IO_SURF_n(HPROGRAM)
CALL SET_SURFEX_FILEIN(HPROGRAM,'PREP')
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'TOWN ','TEB ','READ ')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'TOWN ','TEB ','READ ')
!
IF (.NOT. GTOWN) THEN
- T%CUR%TSNOW_ROAD%SCHEME='1-L'
- CALL ALLOCATE_GR_SNOW(T%CUR%TSNOW_ROAD,ILU,1)
- T%CUR%TSNOW_ROOF%SCHEME='1-L'
- CALL ALLOCATE_GR_SNOW(T%CUR%TSNOW_ROOF,ILU,1)
+ T%TSNOW_ROAD%SCHEME='1-L'
+ CALL ALLOCATE_GR_SNOW(T%TSNOW_ROAD,ILU)
+ T%TSNOW_ROOF%SCHEME='1-L'
+ CALL ALLOCATE_GR_SNOW(T%TSNOW_ROOF,ILU)
ELSE
+ ALLOCATE(IMASK(ILU))
+ DO JI = 1,ILU
+ IMASK(JI) = JI
+ ENDDO
IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
- CALL READ_GR_SNOW(&
- HPROGRAM,'RD',YPATCH,ILU,1,T%CUR%TSNOW_ROAD )
- CALL READ_GR_SNOW(&
- HPROGRAM,'RF',YPATCH,ILU,1,T%CUR%TSNOW_ROOF )
+ CALL READ_GR_SNOW(HPROGRAM,'RD',YPATCH,ILU,ILU,IMASK,0,T%TSNOW_ROAD )
+ CALL READ_GR_SNOW(HPROGRAM,'RF',YPATCH,ILU,ILU,IMASK,0,T%TSNOW_ROOF )
ELSE
- CALL READ_GR_SNOW(&
- HPROGRAM,'ROAD',YPATCH,ILU,1,T%CUR%TSNOW_ROAD )
- CALL READ_GR_SNOW(&
- HPROGRAM,'ROOF',YPATCH,ILU,1,T%CUR%TSNOW_ROOF )
- ENDIF
+ CALL READ_GR_SNOW(HPROGRAM,'ROAD',YPATCH,ILU,ILU,IMASK,0,T%TSNOW_ROAD )
+ CALL READ_GR_SNOW(HPROGRAM,'ROOF',YPATCH,ILU,ILU,IMASK,0,T%TSNOW_ROOF )
+ ENDIF
+ DEALLOCATE(IMASK)
END IF
!
!-------------------------------------------------------------------------------
@@ -326,25 +305,23 @@ END IF
!
!* temperature in canyon air
!
-ALLOCATE(T%CUR%XT_CANYON(ILU))
-T%CUR%XT_CANYON(:) = T%CUR%XT_ROAD(:,1)
+ALLOCATE(T%XT_CANYON(ILU))
+T%XT_CANYON(:) = T%XT_ROAD(:,1)
!
YRECFM=YPATCH//'TCANYON'
YRECFM=ADJUSTL(YRECFM)
IF (GOLD_NAME) YRECFM='T_CANYON'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,T%CUR%XT_CANYON(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,T%XT_CANYON(:),IRESP)
!
!* water vapor in canyon air
!
-ALLOCATE(T%CUR%XQ_CANYON(ILU))
-T%CUR%XQ_CANYON(:) = 0.
+ALLOCATE(T%XQ_CANYON(ILU))
+T%XQ_CANYON(:) = 0.
!
YRECFM=YPATCH//'QCANYON'
YRECFM=ADJUSTL(YRECFM)
IF (GOLD_NAME) YRECFM='Q_CANYON'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,T%CUR%XQ_CANYON(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,T%XQ_CANYON(:),IRESP)
!
!* Thermal solar panels present day production
!
@@ -354,8 +331,7 @@ IF (TOP%LSOLAR_PANEL) THEN
YRECFM=YPATCH//'THER_PDAY'
YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,TPN%XTHER_PRODC_DAY(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,TPN%XTHER_PRODC_DAY(:),IRESP)
END IF
IF ( LASSIM .AND. NIFIC/=NVAR+2 ) THEN
@@ -364,8 +340,7 @@ IF ( LASSIM .AND. NIFIC/=NVAR+2 ) THEN
XAT2M_TEB=XUNDEF
YRECFM='T2M'
CALL IO_BUFF(YRECFM,'R',GKNOWN)
- CALL READ_SURF(&
- HPROGRAM,YRECFM,XAT2M_TEB(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,XAT2M_TEB(:),IRESP)
ENDIF
!
diff --git a/src/SURFEX/read_watflux_confn.F90 b/src/SURFEX/read_watflux_confn.F90
index 3ad10e12681f203830c56fadfa4a39b2d2e8607b..7d6c369efeef7beefe14f029b0f250d8fbbdeb86 100644
--- a/src/SURFEX/read_watflux_confn.F90
+++ b/src/SURFEX/read_watflux_confn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_WATFLUX_CONF_n (CHW, DGW, W, &
- HPROGRAM)
+ SUBROUTINE READ_WATFLUX_CONF_n (CHW, DGO, W, HPROGRAM)
! #############################################################
!
!!**** *READ_WATFLUX_CONF* - reads the configuration for WATFLUX
@@ -44,7 +43,7 @@
!
!
USE MODD_CH_WATFLUX_n, ONLY : CH_WATFLUX_t
-USE MODD_DIAG_WATFLUX_n, ONLY : DIAG_WATFLUX_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
USE MODD_WATFLUX_n, ONLY : WATFLUX_t
!
USE MODE_MODELN_SURFEX_HANDLER
@@ -72,7 +71,7 @@ IMPLICIT NONE
!
!
TYPE(CH_WATFLUX_t), INTENT(INOUT) :: CHW
-TYPE(DIAG_WATFLUX_t), INTENT(INOUT) :: DGW
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
TYPE(WATFLUX_t), INTENT(INOUT) :: W
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling ISBA
@@ -97,7 +96,7 @@ IMI=GET_CURRENT_MODEL_INDEX_SURFEX()
!
IF (IMI.NE.-1 .AND. LNAM_READ) THEN
CALL INIT_NAM_WATFLUXn(W)
- CALL INIT_NAM_DIAG_SURFn(DGW)
+ CALL INIT_NAM_DIAG_SURFn(DGO)
CALL INIT_NAM_CH_WATFLUXn(CHW)
ENDIF
!
@@ -129,7 +128,7 @@ ENDIF
!
IF (IMI.NE.-1) THEN
CALL UPDATE_NAM_WATFLUXn(W)
- CALL UPDATE_NAM_DIAG_SURFn(DGW)
+ CALL UPDATE_NAM_DIAG_SURFn(DGO)
CALL UPDATE_NAM_CH_WATFLUXn(CHW)
ENDIF
!
diff --git a/src/SURFEX/read_watflux_date.F90 b/src/SURFEX/read_watflux_date.F90
index 86bc970ccd315ef7a6a80c38c4c881be22caacf3..22038938f37f280c6c83eded08df7433a522d401 100644
--- a/src/SURFEX/read_watflux_date.F90
+++ b/src/SURFEX/read_watflux_date.F90
@@ -3,9 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_WATFLUX_DATE (&
- HPROGRAM,HINIT,KLUOUT,HATMFILE,HATMFILETYPE,&
- KYEAR,KMONTH,KDAY,PTIME,TPTIME )
+ SUBROUTINE READ_WATFLUX_DATE (HPROGRAM,HINIT,KLUOUT,HATMFILE,HATMFILETYPE,&
+ KYEAR,KMONTH,KDAY,PTIME,TPTIME )
! #######################################################
!
!!**** *READ_WATFLUX_DATE* - initializes the date TTIME of MODD_WATFLUX
@@ -118,8 +117,7 @@ IF (TPTIME%TDATE%YEAR==NUNDEF.OR.TPTIME%TDATE%MONTH==NUNDEF &
HATMFILE,HATMFILETYPE,YFILEPGDIN,YFILEPGDINTYPE,KLUOUT,GUNIF)
!
IF (LEN_TRIM(YFILETYPE)/=0) &
- CALL READ_PREP_FILE_DATE(&
- HPROGRAM,YFILE,YFILETYPE,TPTIME,KLUOUT)
+ CALL READ_PREP_FILE_DATE(HPROGRAM,YFILE,YFILETYPE,TPTIME,KLUOUT)
!
END IF
!
diff --git a/src/SURFEX/read_watflux_sbln.F90 b/src/SURFEX/read_watflux_sbln.F90
deleted file mode 100644
index 8798d7a99e8fa6f55e700c98e4ed586fe53db474..0000000000000000000000000000000000000000
--- a/src/SURFEX/read_watflux_sbln.F90
+++ /dev/null
@@ -1,232 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE READ_WATFLUX_SBL_n (DTCO, U, W, WSB, &
- HPROGRAM)
-! #########################################
-!
-!!**** *READ_WATFLUX_SBL_n* - reads WATFLUX fields
-!!
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2003
-!! E. Martin 01/2012 Add LSBL_COLD_START
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!
-!
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_WATFLUX_n, ONLY : WATFLUX_t
-USE MODD_WATFLUX_SBL_n, ONLY : WATFLUX_SBL_t
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE MODI_READ_SURF
-USE MODI_CANOPY_GRID
-USE MODI_GET_TYPE_DIM_n
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
-!
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(WATFLUX_t), INTENT(INOUT) :: W
-TYPE(WATFLUX_SBL_t), INTENT(INOUT) :: WSB
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
-!
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=3) :: YREAD
-INTEGER :: JLAYER ! loop counter on layers
-INTEGER :: ILU ! 1D physical dimension
-INTEGER :: IRESP ! Error code after redding
-INTEGER :: IVERSION, IBUGFIX ! surface version
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-!
-!* 1D physical dimension
-!
-IF (LHOOK) CALL DR_HOOK('READ_WATFLUX_SBL_N',0,ZHOOK_HANDLE)
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'WATER ',ILU)
-!
-!* flag to use or not SBL levels
-!
-YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
-!
-YRECFM='BUG'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IBUGFIX,IRESP)
-!
-YRECFM='WAT_SBL'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,W%LSBL,IRESP)
-!
-IF (.NOT.W%LSBL) THEN
- ALLOCATE(WSB%XZ (0,0))
- ALLOCATE(WSB%XU (0,0))
- ALLOCATE(WSB%XT (0,0))
- ALLOCATE(WSB%XQ (0,0))
- ALLOCATE(WSB%XTKE(0,0))
- ALLOCATE(WSB%XLMO(0) )
- ALLOCATE(WSB%XP (0,0))
- ALLOCATE(WSB%XDZ (0,0))
- ALLOCATE(WSB%XZF (0,0))
- ALLOCATE(WSB%XDZF(0,0))
- IF (LHOOK) CALL DR_HOOK('READ_WATFLUX_SBL_N',1,ZHOOK_HANDLE)
- RETURN
-ENDIF
-!
-!* number of vertical levels
-!
-YRECFM='WAT_SBL_LVL'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,WSB%NLVL,IRESP)
-!
-!* 2. Prognostic fields:
-! -----------------
-!
-!* altitudes
-!
-ALLOCATE(WSB%XZ(ILU,WSB%NLVL))
-!
-DO JLAYER=1,WSB%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_Z',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,WSB%XZ(:,JLAYER),IRESP)
-END DO
-!
-ALLOCATE(WSB%XU (ILU,WSB%NLVL))
-ALLOCATE(WSB%XT (ILU,WSB%NLVL))
-ALLOCATE(WSB%XQ (ILU,WSB%NLVL))
-ALLOCATE(WSB%XTKE(ILU,WSB%NLVL))
-ALLOCATE(WSB%XLMO(ILU) )
-ALLOCATE(WSB%XP (ILU,WSB%NLVL))
-!
-IF (IVERSION>7 .OR. IVERSION==7 .AND.IBUGFIX>=2) THEN
- YRECFM='STORAGETYPE'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,YREAD,IRESP)
-ELSE
- YREAD = 'ALL'
-ENDIF
-!
-IF(YREAD=='ALL') THEN
- !
- !* wind in SBL
- DO JLAYER=1,WSB%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_U',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,WSB%XU(:,JLAYER),IRESP)
- END DO
- !
- !* theta in SBL
- DO JLAYER=1,WSB%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_T',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,WSB%XT(:,JLAYER),IRESP)
- END DO
- !
- !* humidity in SBL
- DO JLAYER=1,WSB%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_Q',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,WSB%XQ(:,JLAYER),IRESP)
- END DO
- !
- !* Tke in SBL
- DO JLAYER=1,WSB%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_E',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,WSB%XTKE(:,JLAYER),IRESP)
- END DO
- !
- !* Monin-Obhukov length
- YRECFM='WAT_SBL_LMO '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,WSB%XLMO(:),IRESP)
- !
- !* Pressure
- DO JLAYER=1,WSB%NLVL
- WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_P',JLAYER,' '
- CALL READ_SURF(&
- HPROGRAM,YRECFM,WSB%XP(:,JLAYER),IRESP)
- END DO
- !
-ELSE
- WSB%XU (:,:) = XUNDEF
- WSB%XT (:,:) = XUNDEF
- WSB%XQ (:,:) = XUNDEF
- WSB%XTKE(:,:) = XUNDEF
- WSB%XLMO(:) = XUNDEF
- WSB%XP (:,:) = XUNDEF
-ENDIF
-!
-!
-!* Grid characteristics
-!
-!
-! --------------------------------- XZ(k+1) XDZ(k+1)
-! ^
-! |
-! |
-! - - - - - - - - - - - - - - - - - XZf(k+1) | XDZf(k+1)
-! ^ |
-! | |
-! --------------------------------- XZ(k), XU, XT, XQ, XTKE | XDZ(k) V
-! | ^
-! - - - - - - - - - - - - - - - - - XZf(k) V | XDZf(k)
-! --------------------------------- XZ(k-1) XDZ(k-1) V
-! - - - - - - - - - - - - - - - - - XZf(k-1)
-!
-ALLOCATE(WSB%XDZ (ILU,WSB%NLVL))
-ALLOCATE(WSB%XZF (ILU,WSB%NLVL))
-ALLOCATE(WSB%XDZF(ILU,WSB%NLVL))
- CALL CANOPY_GRID(ILU,WSB%NLVL,WSB%XZ,WSB%XZF,WSB%XDZ,WSB%XDZF)
-!
-IF (LHOOK) CALL DR_HOOK('READ_WATFLUX_SBL_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE READ_WATFLUX_SBL_n
diff --git a/src/SURFEX/read_watfluxn.F90 b/src/SURFEX/read_watfluxn.F90
index 9ece26cd00f956749aaaa81964b269f50fc25860..4820edc7d4f6f19d1ae84db04b22cbcca2d55a82 100644
--- a/src/SURFEX/read_watfluxn.F90
+++ b/src/SURFEX/read_watfluxn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE READ_WATFLUX_n (DTCO, U, W, &
- HPROGRAM)
+ SUBROUTINE READ_WATFLUX_n (DTCO, U, W, HPROGRAM)
! #########################################
!
!!**** *READ_WATFLUX_n* - reads WATFLUX variables
@@ -88,8 +87,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('READ_WATFLUX_N',0,ZHOOK_HANDLE)
YRECFM='SIZE_WATER'
- CALL GET_TYPE_DIM_n(DTCO, U, &
- 'WATER ',ILU)
+ CALL GET_TYPE_DIM_n(DTCO, U, 'WATER ',ILU)
!
!* 3. Prognostic fields:
! -----------------
@@ -113,20 +111,17 @@ IF(W%LINTERPOL_TS)THEN
DO JMTH=1,INMTH
WRITE(YMTH,'(I2)') (JMTH-1)
YRECFM='TS_WATER'//ADJUSTL(YMTH(:LEN_TRIM(YMTH)))
- CALL READ_SURF(&
- HPROGRAM,YRECFM,W%XTS_MTH(:,JMTH),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,W%XTS_MTH(:,JMTH),IRESP)
ENDDO
!
- CALL INTERPOL_TS_WATER_MTH(W, &
- W%TTIME%TDATE%YEAR,W%TTIME%TDATE%MONTH,W%TTIME%TDATE%DAY,W%XTS)
+ CALL INTERPOL_TS_WATER_MTH(W)
!
ELSE
!
ALLOCATE(W%XTS_MTH(0,0))
!
YRECFM='TS_WATER'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,W%XTS(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,W%XTS(:),IRESP)
!
ENDIF
!
@@ -141,8 +136,7 @@ ENDIF
ALLOCATE(W%XZ0(ILU))
YRECFM='Z0WATER'
W%XZ0(:) = 0.001
- CALL READ_SURF(&
- HPROGRAM,YRECFM,W%XZ0(:),IRESP)
+ CALL READ_SURF(HPROGRAM,YRECFM,W%XZ0(:),IRESP)
IF (LHOOK) CALL DR_HOOK('READ_WATFLUX_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/read_z1d_netcdf.F90 b/src/SURFEX/read_z1d_netcdf.F90
index 87c714a0a7af987d8b785f5a4a6c8b8902bab949..48f3398924ef7832e2323cddb7e697a899710e74 100644
--- a/src/SURFEX/read_z1d_netcdf.F90
+++ b/src/SURFEX/read_z1d_netcdf.F90
@@ -40,8 +40,8 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
- CHARACTER (LEN=28) :: YFILENAME
- CHARACTER (LEN=28) :: YNCVARNAME
+CHARACTER (LEN=28) :: YFILENAME
+CHARACTER (LEN=28) :: YNCVARNAME
INTEGER :: JDIMENSION
!
!* 0.2 Declaration of local variables
diff --git a/src/SURFEX/readhead.F90 b/src/SURFEX/readhead.F90
index a4fcc12384c5eb888daf1800f582caabcf5e7d09..17bef5e6c7aa2e10485913bb1bdbb3129d5aa59c 100644
--- a/src/SURFEX/readhead.F90
+++ b/src/SURFEX/readhead.F90
@@ -4,7 +4,8 @@
!SFX_LIC for details. version 1.
! #########
SUBROUTINE READHEAD(KGLB,PGLBLATMIN,PGLBLATMAX,PGLBLONMIN,PGLBLONMAX,&
- KNBLAT,KNBLON,PCUTVAL,PDLAT,PDLON,PLAT,PLON,KERR)
+ KNBLAT,KNBLON,PCUTVAL,PDLAT,PDLON,PLAT,PLON,KERR,KFACT,&
+ OCOMPRESS)
! ################################################################
!
!!**** *READHEAD* writes the head a the local 'latlon' file.
@@ -76,6 +77,8 @@ REAL, INTENT(OUT) :: PDLON ! longitude mesh in the data file
REAL, DIMENSION(:), POINTER :: PLAT ! latitude of data points
REAL, DIMENSION(:), POINTER :: PLON ! longitude of data points
INTEGER, INTENT(OUT) :: KERR ! return code
+LOGICAL, INTENT(OUT) :: OCOMPRESS
+INTEGER, INTENT(OUT) :: KFACT
!
!* 0.2 Declaration of local variables
! ------------------------------
@@ -87,7 +90,7 @@ INTEGER :: ININDEX ! index of character 'N' in YSTRING1
INTEGER :: ISINDEX ! index of character 'S' in YSTRING1
INTEGER :: IEINDEX ! index of character 'E' in YSTRING1
INTEGER :: IWINDEX ! index of character 'W' in YSTRING1
-REAL, DIMENSION(7) :: ZVAL ! values of the head data
+REAL, DIMENSION(9) :: ZVAL ! values of the head data
INTEGER :: IHEAD ! index of the data in the array ZVAL
CHARACTER(LEN=100) :: YSTRING ! total string in the head
CHARACTER(LEN=100) :: YSTRING1 ! string less the begining line descriptor
@@ -107,6 +110,9 @@ KERR=0
!* 1. Line of comments
! ----------------
!
+ZVAL(1:8) = 1.
+ZVAL(9) = 0.
+!
READ (KGLB,'(A100)',END=99) YSTRING
!
!-------------------------------------------------------------------------------
@@ -114,7 +120,7 @@ READ (KGLB,'(A100)',END=99) YSTRING
!* 2. Other lines
! -----------
!
-DO JHEAD=1,7
+DO JHEAD=1,9
READ (KGLB,'(A100)',END=99) YSTRING
YSTRING=ADJUSTL(YSTRING)
!
@@ -145,7 +151,13 @@ DO JHEAD=1,7
YSTRING1=YSTRING(6:100)
CASE('cols:')
IHEAD=7
- YSTRING1=YSTRING(6:100)
+ YSTRING1=YSTRING(6:100)
+ CASE('fact:')
+ IHEAD=8
+ YSTRING1=YSTRING(6:100)
+ CASE('compr')
+ IHEAD=9
+ YSTRING1=YSTRING(10:100)
END SELECT
!
!* 2.2 Test on presence of geographical descritor (N, E, S or W)
@@ -183,6 +195,7 @@ DO JHEAD=1,7
!
ENDDO
!
+99 CONTINUE
!-------------------------------------------------------------------------------
!
!* 3. Initialization of arguments, longitudes and latitudes
@@ -195,6 +208,9 @@ PGLBLONMIN=ZVAL(5)
PGLBLONMAX=ZVAL(4)+NINT((ZVAL(5)-ZVAL(4)+180.*(1.0+XSURF_EPSILON))/360.)*360.
KNBLAT=NINT(ZVAL(6))
KNBLON=NINT(ZVAL(7))
+KFACT=NINT(ZVAL(8))
+OCOMPRESS = .FALSE.
+IF (ZVAL(9)==1.) OCOMPRESS = .TRUE.
!
PDLAT=(PGLBLATMAX-PGLBLATMIN)/KNBLAT
PDLON=(PGLBLONMAX-PGLBLONMIN)/KNBLON
@@ -203,10 +219,9 @@ ALLOCATE(PLON(KNBLON))
PLAT(:)=(/ (PGLBLATMAX-(JLAT-0.5)*PDLAT, JLAT=1,KNBLAT) /)
PLON(:)=(/ (PGLBLONMIN+(JLON-0.5)*PDLON, JLON=1,KNBLON) /)
!
-IF (LHOOK) CALL DR_HOOK('READHEAD',1,ZHOOK_HANDLE)
-RETURN
-99 CONTINUE
-KERR=-1
+!IF (LHOOK) CALL DR_HOOK('READHEAD',1,ZHOOK_HANDLE)
+!RETURN
+!KERR=-1
IF (LHOOK) CALL DR_HOOK('READHEAD',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
END SUBROUTINE READHEAD
diff --git a/src/SURFEX/refresh_pgdwork.F90 b/src/SURFEX/refresh_pgdwork.F90
index 9b30a771aa9faccf8efba17b9d6c259dd0f1eae5..7f32535dc4f2c2a2e79b5931c8269c03e22d9589 100644
--- a/src/SURFEX/refresh_pgdwork.F90
+++ b/src/SURFEX/refresh_pgdwork.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ##########################
- SUBROUTINE REFRESH_PGDWORK
+ SUBROUTINE REFRESH_PGDWORK(HSUBROUTINE)
! ##########################
!
!!**** *REFRESH_PGDWORK* ! refreshes arrays used in PGD work module
@@ -35,8 +35,9 @@
!! Original 09/2008
!!
!
-USE MODD_PGDWORK, ONLY : XSSQO, LSSQO, XSUMVAL, XSUMVAL2, XSUMCOVER, NSIZE
+USE MODD_PGDWORK, ONLY : XSSO_ALL, NSSO_ALL, XSUMVAL, XEXT_ALL, NSIZE_ALL, XALL
!
+USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -48,36 +49,42 @@ IMPLICIT NONE
!* 1. Cover array
! -----------
!
-
+ CHARACTER(LEN=6), INTENT(IN) :: HSUBROUTINE ! Name of the subroutine to call
+!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('REFRESH_PGDWORK',0,ZHOOK_HANDLE)
-IF (ALLOCATED(XSUMCOVER)) THEN
- XSUMCOVER=0.
-END IF
!----------------------------------------------------------------------------
!
!* 2. General arrays
! --------------
!
+IF (ALLOCATED(XALL)) THEN
+ XALL(:,:,:) = 0.
+ENDIF
IF (ALLOCATED(XSUMVAL)) THEN
- XSUMVAL=0.
+ XSUMVAL(:,:)=0.
END IF
-IF (ALLOCATED(XSUMVAL2)) THEN
- XSUMVAL2=0.
+IF (ALLOCATED(XEXT_ALL)) THEN
+ XEXT_ALL(:,1)=-99999.
+ XEXT_ALL(:,2)=99999.
END IF
-IF (ALLOCATED(NSIZE)) THEN
- NSIZE=0
+IF (ALLOCATED(NSIZE_ALL)) THEN
+ NSIZE_ALL(:,:)=0
END IF
!----------------------------------------------------------------------------
!
!* 3. Subgrid arrays
! --------------
!
-IF (ALLOCATED(LSSQO)) THEN
- XSSQO(:,:,:) = -99999.
- LSSQO(:,:,:) = .FALSE.
-END IF
+IF (ALLOCATED(XSSO_ALL) .AND. ALLOCATED(NSSO_ALL)) THEN
+ IF (HSUBROUTINE=='A_OROG') THEN
+ XSSO_ALL(:,:,:) = -XUNDEF
+ ELSE
+ XSSO_ALL(:,:,:) = 0.
+ ENDIF
+ NSSO_ALL(:,:,:) = 0
+ENDIF
IF (LHOOK) CALL DR_HOOK('REFRESH_PGDWORK',1,ZHOOK_HANDLE)
!
!----------------------------------------------------------------------------
diff --git a/src/SURFEX/regular_grid_spawn.F90 b/src/SURFEX/regular_grid_spawn.F90
index ac68bc3682f6f83d08f7cc99b5c2e5312706d799..ddbe52e457ac74999f3e9d2289ba3ea032afd004 100644
--- a/src/SURFEX/regular_grid_spawn.F90
+++ b/src/SURFEX/regular_grid_spawn.F90
@@ -86,21 +86,12 @@ INTEGER, INTENT(IN) :: KYSIZE ! covered by the modif
INTEGER, INTENT(IN) :: KDXRATIO ! resolution ratio between modified grid
INTEGER, INTENT(IN) :: KDYRATIO ! and initial grid
INTEGER, INTENT(IN) :: KL2 ! total number of points KIMAX_C_ll * KJMAX_C_ll
-#ifdef MNH_PARALLEL
INTEGER, INTENT(INOUT) :: KIMAX_C_ll ! number of points in x direction (glb on entry, lcl on exit)
INTEGER, INTENT(INOUT) :: KJMAX_C_ll ! number of points in y direction (glb on entry, lcl on exit)
REAL, DIMENSION(:),ALLOCATABLE, INTENT(OUT) :: PX2 ! X coordinate of all points
REAL, DIMENSION(:),ALLOCATABLE, INTENT(OUT) :: PY2 ! Y coordinate of all points
REAL, DIMENSION(:),ALLOCATABLE, INTENT(OUT) :: PDX2 ! X mesh size of all points
REAL, DIMENSION(:),ALLOCATABLE, INTENT(OUT) :: PDY2 ! Y mesh size of all points
-#else
-INTEGER, INTENT(IN) :: KIMAX_C_ll ! number of points in x direction
-INTEGER, INTENT(IN) :: KJMAX_C_ll ! number of points in y direction
-REAL, DIMENSION(KL2), INTENT(OUT) :: PX2 ! X coordinate of all points
-REAL, DIMENSION(KL2), INTENT(OUT) :: PY2 ! Y coordinate of all points
-REAL, DIMENSION(KL2), INTENT(OUT) :: PDX2 ! X mesh size of all points
-REAL, DIMENSION(KL2), INTENT(OUT) :: PDY2 ! Y mesh size of all points
-#endif
!
!* 0.2 Declarations of local variables
! -------------------------------
@@ -446,7 +437,13 @@ ALLOCATE(PX2(IIMAX_C*IJMAX_C))
ALLOCATE(PY2(IIMAX_C*IJMAX_C))
ALLOCATE(PDX2(IIMAX_C*IJMAX_C))
ALLOCATE(PDY2(IIMAX_C*IJMAX_C))
+#else
+ALLOCATE(PX2(KL2))
+ALLOCATE(PY2(KL2))
+ALLOCATE(PDX2(KL2))
+ALLOCATE(PDY2(KL2))
#endif
+!
ALLOCATE(ZXHAT2(IIMAX_C+1))
ALLOCATE(ZYHAT2(IJMAX_C+1))
!
diff --git a/src/SURFEX/reproj_diag_isban.F90 b/src/SURFEX/reproj_diag_isban.F90
new file mode 100644
index 0000000000000000000000000000000000000000..fe36be7e5afeda165b55bb77a6b414b65abd2186
--- /dev/null
+++ b/src/SURFEX/reproj_diag_isban.F90
@@ -0,0 +1,219 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+SUBROUTINE REPROJ_DIAG_ISBA_n (DK, DEK, DMK, PEK, OSURF_BUDGET, OSURF_EVAP_BUDGET, &
+ OWATER_BUDGET, OSURF_MISC_BUDGET, OPROSNOW, &
+ OMEB_PATCH, PSLOPECOS )
+! ###############################################################################
+!
+!!**** *REPROJ_DIAG-ISBA_n * - additional diagnostics for ISBA
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! S. Faroux
+!!
+!!------------------------------------------------------------------
+!
+USE MODD_DIAG_n, ONLY : DIAG_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
+USE MODD_ISBA_n, ONLY : ISBA_PE_t
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+TYPE(DIAG_t), INTENT(INOUT) :: DK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
+LOGICAL, INTENT(IN) :: OSURF_BUDGET
+LOGICAL, INTENT(IN) :: OSURF_EVAP_BUDGET
+LOGICAL, INTENT(IN) :: OWATER_BUDGET
+LOGICAL, INTENT(IN) :: OSURF_MISC_BUDGET
+LOGICAL, INTENT(IN) :: OPROSNOW
+!
+LOGICAL, INTENT(IN) :: OMEB_PATCH
+!
+REAL, DIMENSION(:), INTENT(IN) :: PSLOPECOS ! cosine of the slope for Crocus
+!
+!* 0.2 declarations of local variables
+!
+REAL, DIMENSION(SIZE(PEK%XPSN)) :: ZCORR_SLOPE
+REAL, DIMENSION(SIZE(PEK%TSNOW%WSNOW,1),SIZE(PEK%TSNOW%WSNOW,2)) :: ZCORR_SLOPE_2D
+!
+INTEGER :: JL, JSW
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('REPROJ_DIAG_ISBA_N',0,ZHOOK_HANDLE)
+!
+IF ( OPROSNOW ) THEN
+ !
+ !this variable is used further to project diagnostics on the verticale
+ ZCORR_SLOPE(:) = 1. / PSLOPECOS(:)
+ DO JL = 1,SIZE(PEK%TSNOW%WSNOW,2)
+ WHERE (PEK%TSNOW%WSNOW(:,JL)>0.)
+ ZCORR_SLOPE_2D(:,JL) = ZCORR_SLOPE(:)
+ ELSEWHERE
+ ZCORR_SLOPE_2D(:,JL) = 1.
+ ENDWHERE
+ ENDDO
+ !
+ IF ( OSURF_BUDGET ) THEN
+ !
+ DK%XRN (:) = DK%XRN (:) * ZCORR_SLOPE(:)
+ DK%XH (:) = DK%XH (:) * ZCORR_SLOPE(:)
+ DK%XGFLUX (:) = DK%XGFLUX (:) * ZCORR_SLOPE(:)
+ DK%XLEI (:) = DK%XLEI (:) * ZCORR_SLOPE(:)
+ DK%XSWD (:) = DK%XSWD (:) * ZCORR_SLOPE(:)
+ DK%XSWU (:) = DK%XSWU (:) * ZCORR_SLOPE(:)
+ DK%XLWD (:) = DK%XLWD (:) * ZCORR_SLOPE(:)
+ DK%XLWU (:) = DK%XLWU (:) * ZCORR_SLOPE(:)
+ DK%XFMU (:) = DK%XFMU (:) * ZCORR_SLOPE(:)
+ DK%XFMV (:) = DK%XFMV (:) * ZCORR_SLOPE(:)
+ !
+ DO JSW=1,SIZE(DK%XSWBD,2)
+ DK%XSWBD (:, JSW) = DK%XSWBD (:,JSW) * ZCORR_SLOPE(:)
+ DK%XSWBU (:, JSW) = DK%XSWBU (:,JSW) * ZCORR_SLOPE(:)
+ ENDDO
+ !
+ END IF
+ !
+ IF ( OSURF_EVAP_BUDGET ) THEN
+ !
+ DK%XEVAP (:) = DK%XEVAP (:) * ZCORR_SLOPE(:)
+ DK%XSUBL (:) = DK%XSUBL (:) * ZCORR_SLOPE(:)
+ !
+ DEK%XLEG (:) = DEK%XLEG (:) * ZCORR_SLOPE(:)
+ DEK%XLEGI (:) = DEK%XLEGI (:) * ZCORR_SLOPE(:)
+ DEK%XLEV (:) = DEK%XLEV (:) * ZCORR_SLOPE(:)
+ DEK%XLES (:) = DEK%XLES (:) * ZCORR_SLOPE(:)
+ DEK%XLER (:) = DEK%XLER (:) * ZCORR_SLOPE(:)
+ DEK%XLETR (:) = DEK%XLETR (:) * ZCORR_SLOPE(:)
+ DEK%XDRAIN (:) = DEK%XDRAIN (:) * ZCORR_SLOPE(:)
+ DEK%XQSB (:) = DEK%XQSB (:) * ZCORR_SLOPE(:)
+ DEK%XRUNOFF (:) = DEK%XRUNOFF (:) * ZCORR_SLOPE(:)
+ DEK%XHORT (:) = DEK%XHORT (:) * ZCORR_SLOPE(:)
+ DEK%XDRIP (:) = DEK%XDRIP (:) * ZCORR_SLOPE(:)
+ DEK%XRRVEG (:) = DEK%XRRVEG (:) * ZCORR_SLOPE(:)
+ DEK%XMELT (:) = DEK%XMELT (:) * ZCORR_SLOPE(:)
+ DEK%XIFLOOD (:) = DEK%XIFLOOD (:) * ZCORR_SLOPE(:)
+ DEK%XPFLOOD (:) = DEK%XPFLOOD (:) * ZCORR_SLOPE(:)
+ DEK%XLE_FLOOD (:) = DEK%XLE_FLOOD (:) * ZCORR_SLOPE(:)
+ DEK%XLEI_FLOOD (:) = DEK%XLEI_FLOOD (:) * ZCORR_SLOPE(:)
+ DEK%XIRRIG_FLUX(:) = DEK%XIRRIG_FLUX (:) * ZCORR_SLOPE(:)
+ !
+ IF ( OMEB_PATCH ) THEN
+ !
+ DEK%XLEV_CV (:) = DEK%XLEV_CV (:) * ZCORR_SLOPE(:)
+ DEK%XLES_CV (:) = DEK%XLES_CV (:) * ZCORR_SLOPE(:)
+ DEK%XLETR_CV (:) = DEK%XLETR_CV (:) * ZCORR_SLOPE(:)
+ DEK%XLELITTER (:) = DEK%XLELITTER (:) * ZCORR_SLOPE(:)
+ DEK%XLELITTERI(:) = DEK%XLELITTERI(:) * ZCORR_SLOPE(:)
+ DEK%XDRIPLIT (:) = DEK%XDRIPLIT (:) * ZCORR_SLOPE(:)
+ DEK%XRRLIT (:) = DEK%XRRLIT (:) * ZCORR_SLOPE(:)
+ DEK%XLER_CV (:) = DEK%XLER_CV (:) * ZCORR_SLOPE(:)
+ DEK%XLE_CA (:) = DEK%XLE_CA (:) * ZCORR_SLOPE(:)
+ DEK%XLE_CV (:) = DEK%XLE_CV (:) * ZCORR_SLOPE(:)
+ DEK%XLE_GV (:) = DEK%XLE_GV (:) * ZCORR_SLOPE(:)
+ DEK%XLE_GN (:) = DEK%XLE_GN (:) * ZCORR_SLOPE(:)
+ !
+ DEK%XSWNET_V (:) = DEK%XSWNET_V (:) * ZCORR_SLOPE(:)
+ DEK%XSWNET_G (:) = DEK%XSWNET_G (:) * ZCORR_SLOPE(:)
+ DEK%XSWNET_N (:) = DEK%XSWNET_N (:) * ZCORR_SLOPE(:)
+ DEK%XSWNET_NS (:) = DEK%XSWNET_NS (:) * ZCORR_SLOPE(:)
+ DEK%XLWNET_V (:) = DEK%XLWNET_V (:) * ZCORR_SLOPE(:)
+ DEK%XLWNET_G (:) = DEK%XLWNET_G (:) * ZCORR_SLOPE(:)
+ DEK%XLWNET_N (:) = DEK%XLWNET_N (:) * ZCORR_SLOPE(:)
+ DEK%XSWDOWN_GN(:) = DEK%XSWDOWN_GN(:) * ZCORR_SLOPE(:)
+ DEK%XLWDOWN_GN(:) = DEK%XLWDOWN_GN(:) * ZCORR_SLOPE(:)
+ DEK%XH_CV (:) = DEK%XH_CV (:) * ZCORR_SLOPE(:)
+ DEK%XH_GV (:) = DEK%XH_GV (:) * ZCORR_SLOPE(:)
+ DEK%XH_CA (:) = DEK%XH_CA (:) * ZCORR_SLOPE(:)
+ DEK%XH_GN (:) = DEK%XH_GN (:) * ZCORR_SLOPE(:)
+ DEK%XSR_GN (:) = DEK%XSR_GN (:) * ZCORR_SLOPE(:)
+ DEK%XMELT_CV (:) = DEK%XMELT_CV (:) * ZCORR_SLOPE(:)
+ DEK%XFRZ_CV (:) = DEK%XFRZ_CV (:) * ZCORR_SLOPE(:)
+ !
+ ENDIF
+ !
+ IF ( PEK%TSNOW%SCHEME=='3-L' .OR. PEK%TSNOW%SCHEME=='CRO') THEN
+ !
+ DEK%XLESL (:) = DEK%XLESL (:) * ZCORR_SLOPE(:)
+ DEK%XSNDRIFT (:) = DEK%XSNDRIFT (:) * ZCORR_SLOPE(:)
+ !
+ END IF
+ !
+ IF ( OWATER_BUDGET )THEN
+ !
+ DEK%XDWG (:) = DEK%XDWG (:) * ZCORR_SLOPE(:)
+ DEK%XDWGI (:) = DEK%XDWGI (:) * ZCORR_SLOPE(:)
+ DEK%XDWR (:) = DEK%XDWR (:) * ZCORR_SLOPE(:)
+ DEK%XDSWE (:) = DEK%XDSWE (:) * ZCORR_SLOPE(:)
+ DEK%XWATBUD(:) = DEK%XWATBUD(:) * ZCORR_SLOPE(:)
+ !
+ ENDIF
+ !
+ END IF
+ !
+ IF (OSURF_MISC_BUDGET) THEN
+ !
+ DMK%XTWSNOW(:) = DMK%XTWSNOW(:) * ZCORR_SLOPE(:)
+ DMK%XTDSNOW(:) = DMK%XTDSNOW(:) * ZCORR_SLOPE(:)
+ !
+ IF ( PEK%TSNOW%SCHEME=='3-L' .OR. PEK%TSNOW%SCHEME=='CRO' ) THEN
+ !
+ WHERE(DMK%XSNOWDZ/=XUNDEF)
+ DMK%XSNOWLIQ(:,:) = DMK%XSNOWLIQ(:,:) * ZCORR_SLOPE_2D(:,:)
+ DMK%XSNOWDZ (:,:) = DMK%XSNOWDZ (:,:) * ZCORR_SLOPE_2D(:,:)
+ ENDWHERE
+ !
+ IF ( PEK%TSNOW%SCHEME=='CRO' ) THEN
+ !PRINT*,ZCORR_SLOPE(:)
+ !PRINT*,DMK%XSNDPT_1DY (:)
+ !PRINT*,DMK%XTDSNOW(:)
+ !PRINT*,DMK%XTSNOW(:)
+ WHERE(DMK%XTWSNOW>0.)
+ DMK%XSNDPT_1DY (:) = DMK%XSNDPT_1DY (:) * ZCORR_SLOPE(:)
+ DMK%XSNDPT_3DY (:) = DMK%XSNDPT_3DY (:) * ZCORR_SLOPE(:)
+ DMK%XSNDPT_5DY (:) = DMK%XSNDPT_5DY (:) * ZCORR_SLOPE(:)
+ DMK%XSNDPT_7DY (:) = DMK%XSNDPT_7DY (:) * ZCORR_SLOPE(:)
+ DMK%XSNSWE_1DY (:) = DMK%XSNSWE_1DY (:) * ZCORR_SLOPE(:)
+ DMK%XSNSWE_3DY (:) = DMK%XSNSWE_3DY (:) * ZCORR_SLOPE(:)
+ DMK%XSNSWE_5DY (:) = DMK%XSNSWE_5DY (:) * ZCORR_SLOPE(:)
+ DMK%XSNSWE_7DY (:) = DMK%XSNSWE_7DY (:) * ZCORR_SLOPE(:)
+ DMK%XSNRAM_SONDE (:) = DMK%XSNRAM_SONDE (:) * ZCORR_SLOPE(:)
+ DMK%XSN_REFRZNTHCKN(:) = DMK%XSN_REFRZNTHCKN(:) * ZCORR_SLOPE(:)
+ DMK%XSN_WETTHCKN (:) = DMK%XSN_WETTHCKN (:) * ZCORR_SLOPE(:)
+ ENDWHERE
+ ENDIF
+ !
+ ENDIF
+ !
+ ENDIF
+ !
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('REPROJ_DIAG_ISBA_N',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------------
+!
+END SUBROUTINE REPROJ_DIAG_ISBA_n
diff --git a/src/SURFEX/road_layer_e_budget.F90 b/src/SURFEX/road_layer_e_budget.F90
index f2dd885385265a23f1d9b7b14052cb2375a99538..19a855f9265245d564a4c70fb4a257d861786bf7 100644
--- a/src/SURFEX/road_layer_e_budget.F90
+++ b/src/SURFEX/road_layer_e_budget.F90
@@ -3,15 +3,13 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ##########################################################################
- SUBROUTINE ROAD_LAYER_E_BUDGET(PT_ROAD, PTSTEP, PHC_ROAD, PTC_ROAD, PD_ROAD, &
- PDN_ROAD, PRHOA, PAC_ROAD, PAC_ROAD_WAT, &
- PLW_RAD, PPS, PQSAT_ROAD, PDELT_ROAD, PEXNS, &
- PABS_SW_ROAD, PGSNOW_ROAD, PQ_LOWCAN, PT_LOWCAN, &
- PTS_WALL_A, PTS_WALL_B, PTSNOW_ROAD, &
- PTS_GARDEN, PTS_WIN, &
- PLW_WA_TO_R, PLW_WB_TO_R, PLW_S_TO_R, PLW_WIN_TO_R, &
- PEMIS_ROAD, PEMIT_LW_ROAD, PDQS_ROAD, PABS_LW_ROAD, &
- PHFREE_ROAD, PLEFREE_ROAD, PIMB_ROAD, PRR )
+ SUBROUTINE ROAD_LAYER_E_BUDGET(T, B, PTSTEP, PDN_ROAD, PRHOA, PAC_ROAD, PAC_ROAD_WAT, &
+ PLW_RAD, PPS, PQSAT_ROAD, PDELT_ROAD, PEXNS, &
+ PABS_SW_ROAD, PGSNOW_ROAD, PQ_LOWCAN, PT_LOWCAN, &
+ PTS_WALL_A, PTS_WALL_B, PTSNOW_ROAD, PTS_GARDEN, &
+ PLW_WA_TO_R, PLW_WB_TO_R, PLW_S_TO_R, PLW_WIN_TO_R, &
+ PEMIT_LW_ROAD, PDQS_ROAD, PABS_LW_ROAD, PHFREE_ROAD, &
+ PLEFREE_ROAD, PIMB_ROAD, PRR )
! ##########################################################################
!
!!**** *ROAD_LAYER_E_BUDGET*
@@ -94,6 +92,9 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TEB_n, ONLY : TEB_t
+USE MODD_BEM_n, ONLY : BEM_t
+!
USE MODD_CSTS,ONLY : XCPD, XLVTT, XSTEFAN, XCL
!
USE MODE_THERMOS
@@ -108,12 +109,10 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(TEB_t), INTENT(INOUT) :: T
+TYPE(BEM_t), INTENT(INOUT) :: B
!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PT_ROAD ! road layers temperatures
REAL, INTENT(IN) :: PTSTEP ! time step
-REAL, DIMENSION(:,:), INTENT(IN) :: PHC_ROAD ! heat capacity for road layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PTC_ROAD ! thermal conductivity for road layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_ROAD ! depth of road layers
REAL, DIMENSION(:), INTENT(IN) :: PDN_ROAD ! road snow fraction
REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! rho
REAL, DIMENSION(:), INTENT(IN) :: PAC_ROAD ! aerodynamical conductance
@@ -136,15 +135,12 @@ REAL, DIMENSION(:), INTENT(IN) :: PTS_WALL_A ! wall surface temperature
REAL, DIMENSION(:), INTENT(IN) :: PTS_WALL_B ! wall surface temperature
REAL, DIMENSION(:), INTENT(IN) :: PTSNOW_ROAD ! road snow temperature
REAL, DIMENSION(:), INTENT(IN) :: PTS_GARDEN ! green area surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS_WIN ! window outdoor surface temperature [K]
!
REAL, DIMENSION(:), INTENT(IN) :: PLW_WA_TO_R ! LW interactions wall -> road
REAL, DIMENSION(:), INTENT(IN) :: PLW_WB_TO_R ! LW interactions wall -> road
REAL, DIMENSION(:), INTENT(IN) :: PLW_S_TO_R ! LW interactions sky -> road
REAL, DIMENSION(:), INTENT(IN) :: PLW_WIN_TO_R ! LW interactions window -> road
!
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_ROAD ! road emissivity
-!
REAL, DIMENSION(:), INTENT(OUT) :: PEMIT_LW_ROAD! LW flux emitted by the road (W/m2 of road)
REAL, DIMENSION(:), INTENT(OUT) :: PDQS_ROAD !heat storage inside the road
REAL, DIMENSION(:), INTENT(OUT) :: PABS_LW_ROAD ! absorbed infrared rad.
@@ -162,7 +158,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PRR ! rain rate [kg m-2 s-1]
REAL :: ZIMPL=1.0 ! implicit coefficient
REAL :: ZEXPL=0.0 ! explicit coefficient
!
-REAL, DIMENSION(SIZE(PT_ROAD,1),SIZE(PT_ROAD,2)) :: ZA,& ! lower diag.
+REAL, DIMENSION(SIZE(T%XT_ROAD,1),SIZE(T%XT_ROAD,2)) :: ZA,& ! lower diag.
ZB,& ! main diag.
ZC,& ! upper diag.
ZY ! r.h.s.
@@ -186,13 +182,13 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('ROAD_LAYER_E_BUDGET',0,ZHOOK_HANDLE)
!
- CALL LAYER_E_BUDGET_GET_COEF( PT_ROAD, PTSTEP, ZIMPL, PHC_ROAD, PTC_ROAD, PD_ROAD, &
+ CALL LAYER_E_BUDGET_GET_COEF( T%XT_ROAD, PTSTEP, ZIMPL, T%XHC_ROAD, T%XTC_ROAD, T%XD_ROAD, &
ZA, ZB, ZC, ZY )
!
!* 1. Layer thermal properties
! ------------------------
!
-IROAD_LAYER = SIZE(PT_ROAD,2)
+IROAD_LAYER = SIZE(T%XT_ROAD,2)
!
DO JJ=1, SIZE(PDN_ROAD)
!
@@ -202,7 +198,7 @@ DO JJ=1, SIZE(PDN_ROAD)
!* 2.3 Surface temperatures
! --------------------
!
- ZTS_ROAD(JJ) = PT_ROAD(JJ,1)
+ ZTS_ROAD(JJ) = T%XT_ROAD(JJ,1)
!
!* 2.2 flux properties
! ---------------
@@ -227,7 +223,7 @@ ZDQSAT_ROAD(:) = DQSAT(ZTS_ROAD(:),PPS(:),PQSAT_ROAD(:))
!* 3. First road layers coefficients (in contact with outdoor env.)
! -------------------------------------------------------------
!
-DO JJ=1,SIZE(PT_ROAD,1)
+DO JJ=1,SIZE(T%XT_ROAD,1)
!
ZB(JJ,1) = ZB(JJ,1) + ZIMPL * XCPD/PEXNS(JJ) * ZRHO_ACF_R(JJ) &
+ ZIMPL * XLVTT * ZRHO_ACF_R_WAT(JJ) * PDELT_ROAD(JJ) * ZDQSAT_ROAD(JJ)
@@ -245,16 +241,16 @@ DO JJ=1,SIZE(PT_ROAD,1)
!
ZY(JJ,1) = ZY(JJ,1) &
+ ZDF_ROAD(JJ) * ( &
- PLW_S_TO_R (JJ) * (ZT_SKY(JJ) - ZEXPL * ZTS_ROAD(JJ)) &
- + PLW_WIN_TO_R(JJ) * (PTS_WIN(JJ) - ZEXPL * ZTS_ROAD(JJ)) &
+ PLW_S_TO_R (JJ) * (ZT_SKY (JJ) - ZEXPL * ZTS_ROAD(JJ)) &
+ + PLW_WIN_TO_R(JJ) * (B%XT_WIN1 (JJ) - ZEXPL * ZTS_ROAD(JJ)) &
+ PLW_WA_TO_R (JJ) * (PTS_WALL_A(JJ) - ZEXPL * ZTS_ROAD(JJ)) &
+ PLW_WB_TO_R (JJ) * (PTS_WALL_B(JJ) - ZEXPL * ZTS_ROAD(JJ)) &
- + PRR(JJ) * XCL * (PT_LOWCAN(JJ)- ZEXPL * ZTS_ROAD(JJ) )) !heat/cool rain
+ + PRR(JJ) * XCL * (PT_LOWCAN (JJ) - ZEXPL * ZTS_ROAD(JJ) )) !heat/cool rain
!
ENDDO
!
!
- CALL LAYER_E_BUDGET( PT_ROAD, PTSTEP, ZIMPL, PHC_ROAD, PTC_ROAD, PD_ROAD, &
+ CALL LAYER_E_BUDGET( T%XT_ROAD, PTSTEP, ZIMPL, T%XHC_ROAD, T%XTC_ROAD, T%XD_ROAD, &
ZA, ZB, ZC, ZY, PDQS_ROAD )
!
!-------------------------------------------------------------------------------
@@ -263,32 +259,32 @@ ENDDO
! ----------------------------------------------------------------
!
!* absorbed LW
-DO JJ=1,SIZE(PT_ROAD,1)
+DO JJ=1,SIZE(T%XT_ROAD,1)
!
! surface temperature used in energy balance
- ZTS_ROAD(JJ) = ZEXPL * ZTS_ROAD(JJ) + ZIMPL * PT_ROAD(JJ,1)
+ ZTS_ROAD(JJ) = ZEXPL * ZTS_ROAD(JJ) + ZIMPL * T%XT_ROAD(JJ,1)
PABS_LW_ROAD(JJ) = PLW_S_TO_R (JJ) * (ZT_SKY(JJ) - ZTS_ROAD(JJ)) + &
PLW_WA_TO_R (JJ) * (PTS_WALL_A(JJ) - ZTS_ROAD(JJ)) + &
PLW_WB_TO_R (JJ) * (PTS_WALL_B(JJ) - ZTS_ROAD(JJ)) + &
- PLW_WIN_TO_R(JJ) * (PTS_WIN(JJ) - ZTS_ROAD(JJ))
+ PLW_WIN_TO_R(JJ) * (B%XT_WIN1(JJ) - ZTS_ROAD(JJ))
!
!* 9. Road emitted LW radiation on snow-free surfaces
! -----------------------------------------------
- PEMIT_LW_ROAD(JJ) = XSTEFAN * PT_ROAD(JJ,1)**4 + &
- (1 - PEMIS_ROAD(JJ))/PEMIS_ROAD(JJ) * PABS_LW_ROAD(JJ)
+ PEMIT_LW_ROAD(JJ) = XSTEFAN * T%XT_ROAD(JJ,1)**4 + &
+ (1 - T%XEMIS_ROAD(JJ))/T%XEMIS_ROAD(JJ) * PABS_LW_ROAD(JJ)
!
!* 10. road and wall sensible heat flux
! --------------------------------
!
PHFREE_ROAD(JJ) = ZRHO_ACF_R(JJ) * XCPD/PEXNS(JJ) * &
- ( ZIMPL*PT_ROAD(JJ,1) + ZEXPL*ZTS_ROAD(JJ) - PT_LOWCAN(JJ) )
+ ( ZIMPL*T%XT_ROAD(JJ,1) + ZEXPL*ZTS_ROAD(JJ) - PT_LOWCAN(JJ) )
!
!* 11 road latent heat flux
! ---------------------
!
PLEFREE_ROAD(JJ) = ZRHO_ACF_R_WAT(JJ) * XLVTT * PDELT_ROAD(JJ) * &
( PQSAT_ROAD(JJ) - PQ_LOWCAN(JJ) + &
- ZIMPL * ZDQSAT_ROAD(JJ) * (PT_ROAD(JJ,1) - ZTS_ROAD(JJ)) )
+ ZIMPL * ZDQSAT_ROAD(JJ) * (T%XT_ROAD(JJ,1) - ZTS_ROAD(JJ)) )
ZHEAT_RR(JJ) = PRR(JJ) * XCL * (ZTS_ROAD(JJ) - PT_LOWCAN(JJ))
!
!* 12 heat storage inside roads
diff --git a/src/SURFEX/roof_impl_coef.F90 b/src/SURFEX/roof_impl_coef.F90
index 60398cdfa4cf3cde8914e382a130d595a81be3f5..a75a3b3c975ea35fab02c83f1a92da46c88f980c 100644
--- a/src/SURFEX/roof_impl_coef.F90
+++ b/src/SURFEX/roof_impl_coef.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################
-SUBROUTINE ROOF_IMPL_COEF(PTSTEP, KROOF_LAYER, PD_ROOF, PTC_ROOF, PHC_ROOF, PT_ROOF, PTDEEP_A,PTDEEP_B)
+SUBROUTINE ROOF_IMPL_COEF(T, PTSTEP, PTDEEP_A, PTDEEP_B)
! ###############################################
!
!!
@@ -48,6 +48,8 @@ SUBROUTINE ROOF_IMPL_COEF(PTSTEP, KROOF_LAYER, PD_ROOF, PTC_ROOF, PHC_ROOF, PT_R
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TEB_n, ONLY : TEB_t
+!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -58,12 +60,9 @@ IMPLICIT NONE
!
!* 0.1 Declarations of arguments
!
+TYPE(TEB_t), INTENT(INOUT) :: T
+!
REAL , INTENT(IN) :: PTSTEP ! time step
-INTEGER , INTENT(IN) :: KROOF_LAYER ! number of roof layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_ROOF ! thickness of each layer
-REAL, DIMENSION(:,:), INTENT(IN) :: PTC_ROOF ! thermal conductivity of each layer
-REAL, DIMENSION(:,:), INTENT(IN) :: PHC_ROOF ! heat capacity of each layer
-REAL, DIMENSION(:,:), INTENT(IN) :: PT_ROOF ! temperature of each layer
REAL, DIMENSION(:), INTENT(OUT) :: PTDEEP_A, PTDEEP_B
! Deep soil temperature (prescribed)
! PTDEEP_A = Deep soil temperature
@@ -81,15 +80,16 @@ REAL, DIMENSION(:), INTENT(OUT) :: PTDEEP_A, PTDEEP_B
!
REAL :: ZIMPL = 1.0 ! implicit coefficient
INTEGER :: JK ! loop counter
+INTEGER :: ILAYER
!
-REAL, DIMENSION(SIZE(PTDEEP_A),KROOF_LAYER) :: ZA,& ! lower diag.
+REAL, DIMENSION(SIZE(PTDEEP_A),SIZE(T%XT_ROOF,2)) :: ZA,& ! lower diag.
ZB,& ! main diag.
ZC,& ! upper diag.
ZY ! r.h.s.
REAL, DIMENSION(SIZE(PTDEEP_A)) :: ZDET ! work array
-REAL, DIMENSION(SIZE(PTDEEP_A),KROOF_LAYER) :: ZW ! work array
-REAL, DIMENSION(SIZE(PTDEEP_A),KROOF_LAYER) :: ZT ! guess of T
+REAL, DIMENSION(SIZE(PTDEEP_A),SIZE(T%XT_ROOF,2)) :: ZW ! work array
+REAL, DIMENSION(SIZE(PTDEEP_A),SIZE(T%XT_ROOF,2)) :: ZT ! guess of T
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
@@ -98,7 +98,9 @@ IF (LHOOK) CALL DR_HOOK('ROOF_IMPL_COEF',0,ZHOOK_HANDLE)
!* 1.0 Coefficients of the tridioagonal matrix for heat conduction eq.
! ---------------------------------------------------------------
!
- CALL LAYER_E_BUDGET_GET_COEF( PT_ROOF, PTSTEP, ZIMPL, PHC_ROOF, PTC_ROOF, PD_ROOF, &
+ILAYER = SIZE(T%XT_ROOF,2)
+!
+ CALL LAYER_E_BUDGET_GET_COEF(T%XT_ROOF, PTSTEP, ZIMPL, T%XHC_ROOF, T%XTC_ROOF, T%XD_ROOF, &
ZA, ZB, ZC, ZY )
!
!-------------------------------------------------------------------------------
@@ -108,13 +110,13 @@ IF (LHOOK) CALL DR_HOOK('ROOF_IMPL_COEF',0,ZHOOK_HANDLE)
!
! layer at bottom of roof
!
-ZDET(:) = ZB(:,KROOF_LAYER)
+ZDET(:) = ZB(:,ILAYER)
!
-ZT (:,KROOF_LAYER) = ZY(:,KROOF_LAYER) / ZDET(:)
+ZT (:,ILAYER) = ZY(:,ILAYER) / ZDET(:)
!
! internal layers & top layer (but without the external heat flux term)
!
-DO JK=KROOF_LAYER-1,1,-1
+DO JK=ILAYER-1,1,-1
ZW (:,JK) = ZA(:,JK+1)/ZDET(:)
ZDET(:) = ZB(:,JK ) - ZC(:,JK)*ZW(:,JK)
ZT (:,JK) = ( ZY(:,JK) - ZC(:,JK)*ZT(:,JK+1) ) / ZDET(:) ! + FLUX / ZDET
@@ -131,7 +133,7 @@ PTDEEP_B = ZT (:,1)
PTDEEP_A = 1. / ZDET(:)
!
!* The following lines are here if you want to test the explicit coupling
-!PTDEEP_B = PT_ROOF(:,1)
+!PTDEEP_B = T%XT_ROOF(:,1)
!PTDEEP_A = 0.
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('ROOF_IMPL_COEF',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/roof_layer_e_budget.F90 b/src/SURFEX/roof_layer_e_budget.F90
index a96c94037feb4f9de97d4c209c3d46e706f94015..3115bc2c6843c5ea5ddc89c04aedf0334a979471 100644
--- a/src/SURFEX/roof_layer_e_budget.F90
+++ b/src/SURFEX/roof_layer_e_budget.F90
@@ -3,20 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE ROOF_LAYER_E_BUDGET(PT_ROOF, PQSAT_ROOF, PTI_BLD, PAC_BLD, PTSTEP, &
- HBLD, PHC_ROOF, PTC_ROOF, PD_ROOF, PDN_ROOF, &
- PRHOA, PAC_ROOF, PAC_ROOF_WAT, PLW_RAD, PPS, &
- PDELT_ROOF, PTA, PQA, PEXNA, PEXNS, &
- PABS_SW_ROOF, PGSNOW_ROOF, PEMIS_ROOF, &
- PFLX_BLD_ROOF, PDQS_ROOF, PABS_LW_ROOF, &
- PHFREE_ROOF, PLEFREE_ROOF, PIMB_ROOF, &
- PFRAC_GR, PG_GREENROOF_ROOF, &
- PF_FLOOR_MASS, PF_FLOOR_WALL, PF_FLOOR_WIN, &
- PF_FLOOR_ROOF, PRADHT_IN, &
- PTS_MASS, PT_WIN2, PTS_FLOOR, PTI_WALL, &
- PRAD_ROOF_WALL, PRAD_ROOF_WIN, PRAD_ROOF_FLOOR,&
- PRAD_ROOF_MASS, PCONV_ROOF_BLD, PRR, &
- PLOAD_IN_ROOF )
+ SUBROUTINE ROOF_LAYER_E_BUDGET(TOP, T, B, PQSAT_ROOF, PAC_BLD, PTSTEP, PDN_ROOF, &
+ PRHOA, PAC_ROOF, PAC_ROOF_WAT, PLW_RAD, PPS, &
+ PDELT_ROOF, PTA, PQA, PEXNA, PEXNS, PABS_SW_ROOF, &
+ PGSNOW_ROOF, PFLX_BLD_ROOF, PDQS_ROOF, PABS_LW_ROOF,&
+ PHFREE_ROOF, PLEFREE_ROOF, PIMB_ROOF, &
+ PG_GREENROOF_ROOF, PRADHT_IN, PTS_FLOOR, PTI_WALL, &
+ PRAD_ROOF_WALL, PRAD_ROOF_WIN, PRAD_ROOF_FLOOR, &
+ PRAD_ROOF_MASS, PCONV_ROOF_BLD, PRR, PLOAD_IN_ROOF )
! ##########################################################################
!
!!**** *ROOF_LAYER_E_BUDGET*
@@ -94,6 +88,10 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
+USE MODD_TEB_n, ONLY : TEB_t
+USE MODD_BEM_n, ONLY : BEM_t
+!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_CSTS,ONLY : XCPD, XLVTT, XSTEFAN, XCL
!
@@ -110,16 +108,14 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PT_ROOF ! roof layers temperatures
+TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+TYPE(TEB_t), INTENT(INOUT) :: T
+TYPE(BEM_t), INTENT(INOUT) :: B
+!
REAL, DIMENSION(:), INTENT(INOUT) :: PQSAT_ROOF ! q_sat(Ts)
-REAL, DIMENSION(:), INTENT(IN) :: PTI_BLD ! inside building temp.
REAL, DIMENSION(:), INTENT(IN) :: PAC_BLD ! aerodynamical resistance
! inside building itself
REAL, INTENT(IN) :: PTSTEP ! time step
- CHARACTER(LEN=3), INTENT(IN) :: HBLD ! Building Energy model 'DEF' or 'BEM'
-REAL, DIMENSION(:,:), INTENT(IN) :: PHC_ROOF ! heat capacity for roof layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PTC_ROOF ! thermal conductivity for roof layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_ROOF ! depth of roof layers
REAL, DIMENSION(:), INTENT(IN) :: PDN_ROOF ! roof snow fraction
REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! air density
REAL, DIMENSION(:), INTENT(IN) :: PAC_ROOF ! aerodynamical conductance
@@ -136,8 +132,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_ROOF ! absorbed solar radiation
REAL, DIMENSION(:), INTENT(IN) :: PGSNOW_ROOF ! roof snow conduction
! ! heat fluxes at mantel
! ! base
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_ROOF ! roof emissivity
-REAL, DIMENSION(:), INTENT(IN) :: PFRAC_GR ! fraction of green roofs
REAL, DIMENSION(:), INTENT(IN) :: PG_GREENROOF_ROOF ! heat conduction flux
! between greenroof and
! structural roof
@@ -150,14 +144,8 @@ REAL, DIMENSION(:), INTENT(OUT) :: PLEFREE_ROOF ! latent heat flux of the
! snow free part of the roof
REAL, DIMENSION(:), INTENT(OUT) :: PIMB_ROOF ! residual energy imbalance
! of the roof for
-REAL, DIMENSION(:), INTENT(IN) :: PF_FLOOR_MASS ! View factor floor-mass
-REAL, DIMENSION(:), INTENT(IN) :: PF_FLOOR_WALL ! View factor floor-wall
-REAL, DIMENSION(:), INTENT(IN) :: PF_FLOOR_WIN ! View factor floor-window
-REAL, DIMENSION(:), INTENT(IN) :: PF_FLOOR_ROOF ! View factor floor-roof
REAL, DIMENSION(:), INTENT(IN) :: PRADHT_IN ! Indoor radiant heat transfer coefficient
! [W K-1 m-2]
-REAL, DIMENSION(:), INTENT(IN) :: PTS_MASS ! surf. mass temp. (contact with bld air)
-REAL, DIMENSION(:), INTENT(IN) :: PT_WIN2 ! indoor wind. temp.
REAL, DIMENSION(:), INTENT(IN) :: PTS_FLOOR ! surf. floor temp. (contact with bld air)
REAL, DIMENSION(:), INTENT(IN) :: PTI_WALL ! indoor wall temp.
REAL, DIMENSION(:), INTENT(OUT) :: PRAD_ROOF_WALL ! rad. fluxes from roof to wall [W m-2(roof)]
@@ -174,7 +162,7 @@ REAL :: ZIMPL = 1.0 ! implicit coefficient
REAL :: ZEXPL = 0.0 ! explicit coefficient
!
REAL, DIMENSION(SIZE(PTA)) :: ZDF_ROOF ! snow-free fraction
-REAL, DIMENSION(SIZE(PTA),SIZE(PT_ROOF,2)) :: ZA,& ! lower diag.
+REAL, DIMENSION(SIZE(PTA),SIZE(T%XT_ROOF,2)) :: ZA,& ! lower diag.
ZB,& ! main diag.
ZC,& ! upper diag.
ZY ! r.h.s.
@@ -208,14 +196,14 @@ PCONV_ROOF_BLD(:) = XUNDEF
!
! *Convection heat transfer coefficients [W m-2 K-1] from EP Engineering Reference
!
-IROOF_LAYER = SIZE(PT_ROOF,2)
+IROOF_LAYER = SIZE(T%XT_ROOF,2)
!
-ZCHTC_IN_ROOF(:) = CHTC_DOWN_DOE(PT_ROOF(:,IROOF_LAYER), PTI_BLD(:))
+ZCHTC_IN_ROOF(:) = CHTC_DOWN_DOE(T%XT_ROOF(:,IROOF_LAYER), B%XTI_BLD(:))
DO JJ=1,SIZE(ZCHTC_IN_ROOF)
ZCHTC_IN_ROOF(JJ) = MAX(1., ZCHTC_IN_ROOF(JJ))
ENDDO
!
- CALL LAYER_E_BUDGET_GET_COEF( PT_ROOF, PTSTEP, ZIMPL, PHC_ROOF, PTC_ROOF, PD_ROOF, &
+ CALL LAYER_E_BUDGET_GET_COEF(T%XT_ROOF, PTSTEP, ZIMPL, T%XHC_ROOF, T%XTC_ROOF, T%XD_ROOF, &
ZA, ZB, ZC, ZY )
!
!
@@ -223,8 +211,8 @@ DO JJ=1,SIZE(PDN_ROOF)
!
ZDF_ROOF(JJ) = 1. - PDN_ROOF(JJ)
!
- ZTS_ROOF(JJ) = PT_ROOF(JJ,1)
- ZTI_ROOF(JJ) = PT_ROOF(JJ,IROOF_LAYER)
+ ZTS_ROOF(JJ) = T%XT_ROOF(JJ,1)
+ ZTI_ROOF(JJ) = T%XT_ROOF(JJ,IROOF_LAYER)
!
!* 2. Roof Ts coefficients
! --------------------
@@ -232,8 +220,8 @@ DO JJ=1,SIZE(PDN_ROOF)
ZRHO_ACF_ROOF (JJ) = PRHOA(JJ) * PAC_ROOF (JJ)
ZRHO_ACF_ROOF_WAT(JJ) = PRHOA(JJ) * PAC_ROOF_WAT(JJ)
!
- IF (HBLD .EQ. 'DEF') THEN
- ZMTC_O_D_ROOF_IN(JJ) = 2. * PTC_ROOF(JJ,IROOF_LAYER) / PD_ROOF (JJ,IROOF_LAYER)
+ IF (TOP%CBEM .EQ. 'DEF') THEN
+ ZMTC_O_D_ROOF_IN(JJ) = 2. * T%XTC_ROOF(JJ,IROOF_LAYER) / T%XD_ROOF (JJ,IROOF_LAYER)
ZMTC_O_D_ROOF_IN(JJ) = 1./( 1./ZMTC_O_D_ROOF_IN(JJ) + 1./(XCPD*PRHOA(JJ)*PAC_BLD(JJ)) )
ENDIF
!
@@ -247,46 +235,46 @@ ZDQSAT_ROOF(:) = DQSAT(ZTS_ROOF(:),PPS(:),PQSAT_ROOF(:))
!* 2.2 coefficients
! ------------
!
-DO JJ=1,SIZE(PT_ROOF,1)
+DO JJ=1,SIZE(T%XT_ROOF,1)
!
- ZB(JJ,1) = ZB(JJ,1) + ZDF_ROOF(JJ) * (1.-PFRAC_GR(JJ)) * ( &
- ZIMPL * ( XCPD/PEXNS(JJ) * ZRHO_ACF_ROOF(JJ) &
- + XLVTT * ZRHO_ACF_ROOF_WAT(JJ) * PDELT_ROOF(JJ) * ZDQSAT_ROOF(JJ) &
- + XSTEFAN * PEMIS_ROOF(JJ) * 4.*ZTS_ROOF(JJ)**3 &
- + PRR(JJ) * XCL )) !! heating/cooling of rain
+ ZB(JJ,1) = ZB(JJ,1) + ZDF_ROOF(JJ) * (1.-T%XGREENROOF(JJ)) * ( &
+ ZIMPL * ( XCPD/PEXNS(JJ) * ZRHO_ACF_ROOF(JJ) &
+ + XLVTT * ZRHO_ACF_ROOF_WAT(JJ) * PDELT_ROOF(JJ) * ZDQSAT_ROOF(JJ) &
+ + XSTEFAN * T%XEMIS_ROOF(JJ) * 4.*ZTS_ROOF(JJ)**3 &
+ + PRR(JJ) * XCL )) !! heating/cooling of rain
!
- ZY(JJ,1) = ZY(JJ,1) + (1.-PFRAC_GR(JJ)) &
- * (PDN_ROOF(JJ)*PGSNOW_ROOF(JJ) + ZDF_ROOF(JJ) * ( PABS_SW_ROOF(JJ) &
- + XCPD * ZRHO_ACF_ROOF(JJ) * ( PTA(JJ)/PEXNA(JJ) - ZEXPL*ZTS_ROOF(JJ)/PEXNS(JJ)) &
- + PEMIS_ROOF(JJ)*PLW_RAD(JJ) &
- + XLVTT * ZRHO_ACF_ROOF_WAT(JJ) * PDELT_ROOF(JJ) &
- * ( PQA(JJ) - PQSAT_ROOF(JJ) + ZIMPL * ZDQSAT_ROOF(JJ) * ZTS_ROOF(JJ) ) &
- + XSTEFAN * PEMIS_ROOF(JJ) * ZTS_ROOF(JJ)**4 * ( 3.*ZIMPL-ZEXPL ) &
- + PRR(JJ) * XCL * (PTA(JJ) - ZEXPL * ZTS_ROOF(JJ)) ) ) & !! heating/cooling of rain
- + PFRAC_GR(JJ)*PG_GREENROOF_ROOF(JJ)
+ ZY(JJ,1) = ZY(JJ,1) + (1.-T%XGREENROOF(JJ)) &
+ * (PDN_ROOF(JJ)*PGSNOW_ROOF(JJ) + ZDF_ROOF(JJ) * ( PABS_SW_ROOF(JJ) &
+ + XCPD * ZRHO_ACF_ROOF(JJ) * ( PTA(JJ)/PEXNA(JJ) - ZEXPL*ZTS_ROOF(JJ)/PEXNS(JJ)) &
+ + T%XEMIS_ROOF(JJ)*PLW_RAD(JJ) &
+ + XLVTT * ZRHO_ACF_ROOF_WAT(JJ) * PDELT_ROOF(JJ) &
+ * ( PQA(JJ) - PQSAT_ROOF(JJ) + ZIMPL * ZDQSAT_ROOF(JJ) * ZTS_ROOF(JJ) ) &
+ + XSTEFAN * T%XEMIS_ROOF(JJ) * ZTS_ROOF(JJ)**4 * ( 3.*ZIMPL-ZEXPL ) &
+ + PRR(JJ) * XCL * (PTA(JJ) - ZEXPL * ZTS_ROOF(JJ)) ) ) & !! heating/cooling of rain
+ + T%XGREENROOF(JJ)*PG_GREENROOF_ROOF(JJ)
!
- IF (HBLD=="DEF") THEN
+ IF (TOP%CBEM=="DEF") THEN
!
ZB(JJ,IROOF_LAYER) = ZB(JJ,IROOF_LAYER) + ZIMPL * ZMTC_O_D_ROOF_IN(JJ)
!
ZY(JJ,IROOF_LAYER) = ZY(JJ,IROOF_LAYER) &
- + ZMTC_O_D_ROOF_IN(JJ) * PTI_BLD(JJ) &
- - ZEXPL * ZMTC_O_D_ROOF_IN(JJ) * PT_ROOF(JJ,IROOF_LAYER)
+ + ZMTC_O_D_ROOF_IN(JJ) * B%XTI_BLD(JJ) &
+ - ZEXPL * ZMTC_O_D_ROOF_IN(JJ) * T%XT_ROOF(JJ,IROOF_LAYER)
!
- ELSEIF (HBLD=="BEM") THEN
+ ELSEIF (TOP%CBEM=="BEM") THEN
!
ZB(JJ, IROOF_LAYER) = ZB(JJ,IROOF_LAYER) + ZIMPL * &
- (ZCHTC_IN_ROOF(JJ) * 4./3. + PRADHT_IN(JJ) * &
- (PF_FLOOR_MASS(JJ) + PF_FLOOR_WIN(JJ) + &
- PF_FLOOR_WALL(JJ) + PF_FLOOR_ROOF(JJ) ))
+ (ZCHTC_IN_ROOF(JJ) * 4./3. + PRADHT_IN(JJ) * &
+ (B%XF_FLOOR_MASS(JJ) + B%XF_FLOOR_WIN(JJ) + &
+ B%XF_FLOOR_WALL(JJ) + B%XF_FLOOR_ROOF(JJ) ))
ZY(JJ,IROOF_LAYER) = ZY(JJ,IROOF_LAYER) + &
- ZCHTC_IN_ROOF(JJ) * (PTI_BLD(JJ) - 1./3. * PT_ROOF(JJ, IROOF_LAYER)*(4*ZEXPL - 1.)) + &
+ ZCHTC_IN_ROOF(JJ) * (B%XTI_BLD(JJ) - 1./3. * T%XT_ROOF(JJ, IROOF_LAYER)*(4*ZEXPL - 1.)) + &
PRADHT_IN(JJ) * ( &
- PF_FLOOR_MASS (JJ) * (PTS_MASS(JJ) - ZEXPL * PT_ROOF(JJ,IROOF_LAYER)) + &
- PF_FLOOR_WIN (JJ) * (PT_WIN2 (JJ) - ZEXPL * PT_ROOF(JJ,IROOF_LAYER)) + &
- PF_FLOOR_WALL (JJ) * (PTI_WALL(JJ) - ZEXPL * PT_ROOF(JJ,IROOF_LAYER)) + &
- PF_FLOOR_ROOF (JJ) * (PTS_FLOOR(JJ)- ZEXPL * PT_ROOF(JJ,IROOF_LAYER)) ) + &
+ B%XF_FLOOR_MASS (JJ) * (B%XT_MASS(JJ,1) - ZEXPL * T%XT_ROOF(JJ,IROOF_LAYER)) + &
+ B%XF_FLOOR_WIN (JJ) * (B%XT_WIN2 (JJ) - ZEXPL * T%XT_ROOF(JJ,IROOF_LAYER)) + &
+ B%XF_FLOOR_WALL (JJ) * (PTI_WALL (JJ) - ZEXPL * T%XT_ROOF(JJ,IROOF_LAYER)) + &
+ B%XF_FLOOR_ROOF (JJ) * (PTS_FLOOR (JJ) - ZEXPL * T%XT_ROOF(JJ,IROOF_LAYER))) + &
PLOAD_IN_ROOF(JJ)
!
ENDIF
@@ -294,26 +282,27 @@ DO JJ=1,SIZE(PT_ROOF,1)
ENDDO
!
!
- CALL LAYER_E_BUDGET( PT_ROOF, PTSTEP, ZIMPL, PHC_ROOF, PTC_ROOF, PD_ROOF, &
+ CALL LAYER_E_BUDGET( T%XT_ROOF, PTSTEP, ZIMPL, T%XHC_ROOF, T%XTC_ROOF, T%XD_ROOF, &
ZA, ZB, ZC, ZY, PDQS_ROOF )
!
!-------------------------------------------------------------------------------
!
!* diagnostic: computation of flux between bld and internal roof layer
-DO JJ=1,SIZE(PT_ROOF,1)
+DO JJ=1,SIZE(T%XT_ROOF,1)
!
- ZTI_ROOF_CONV(JJ) = 4./3. * ZIMPL * PT_ROOF(JJ, IROOF_LAYER) + 1./3. * ZTI_ROOF(JJ) * (4*ZEXPL -1.)
- ZTI_ROOF(JJ) = ZEXPL * ZTI_ROOF(JJ) + ZIMPL * PT_ROOF(JJ, IROOF_LAYER)
- SELECT CASE(HBLD)
+ ZTI_ROOF_CONV(JJ) = 4./3. * ZIMPL * T%XT_ROOF(JJ, IROOF_LAYER) + 1./3. * ZTI_ROOF(JJ) * (4*ZEXPL -1.)
+ ZTI_ROOF(JJ) = ZEXPL * ZTI_ROOF(JJ) + ZIMPL * T%XT_ROOF(JJ, IROOF_LAYER)
+ SELECT CASE(TOP%CBEM)
CASE("DEF")
- PFLX_BLD_ROOF(JJ) = ZMTC_O_D_ROOF_IN(JJ) * (PTI_BLD(JJ) - ZTI_ROOF(JJ))
+ PFLX_BLD_ROOF(JJ) = ZMTC_O_D_ROOF_IN(JJ) * (B%XTI_BLD(JJ) - ZTI_ROOF(JJ))
CASE("BEM")
PRAD_ROOF_WALL(JJ) = PRADHT_IN(JJ) * (ZTI_ROOF(JJ) - PTI_WALL(JJ))
- PRAD_ROOF_WIN(JJ) = PRADHT_IN(JJ) * (ZTI_ROOF(JJ) - PT_WIN2(JJ))
+ PRAD_ROOF_WIN(JJ) = PRADHT_IN(JJ) * (ZTI_ROOF(JJ) - B%XT_WIN2(JJ))
PRAD_ROOF_FLOOR(JJ)= PRADHT_IN(JJ) * (ZTI_ROOF(JJ) - PTS_FLOOR(JJ))
- PRAD_ROOF_MASS(JJ) = PRADHT_IN(JJ) * (ZTI_ROOF(JJ) - PTS_MASS(JJ))
- PCONV_ROOF_BLD(JJ) = ZCHTC_IN_ROOF (JJ) * (ZTI_ROOF_CONV(JJ) - PTI_BLD (JJ))
- PFLX_BLD_ROOF(JJ) = -(PRAD_ROOF_WALL(JJ) + PRAD_ROOF_WIN(JJ) + PRAD_ROOF_FLOOR(JJ) + PRAD_ROOF_MASS(JJ) + PCONV_ROOF_BLD(JJ))
+ PRAD_ROOF_MASS(JJ) = PRADHT_IN(JJ) * (ZTI_ROOF(JJ) - B%XT_MASS(JJ,1))
+ PCONV_ROOF_BLD(JJ) = ZCHTC_IN_ROOF (JJ) * (ZTI_ROOF_CONV(JJ) - B%XTI_BLD (JJ))
+ PFLX_BLD_ROOF(JJ) = -(PRAD_ROOF_WALL(JJ) + PRAD_ROOF_WIN(JJ) + PRAD_ROOF_FLOOR(JJ) + &
+ PRAD_ROOF_MASS(JJ) + PCONV_ROOF_BLD(JJ))
ENDSELECT
!
@@ -322,16 +311,16 @@ DO JJ=1,SIZE(PT_ROOF,1)
!
!* radiative surface temperature at intermediate time step
ZTRAD_ROOF(JJ) = ( ZTS_ROOF(JJ)**4 + &
- 4.*ZIMPL*ZTS_ROOF(JJ)**3 * (PT_ROOF(JJ,1) - ZTS_ROOF(JJ)) )**0.25
+ 4.*ZIMPL*ZTS_ROOF(JJ)**3 * (T%XT_ROOF(JJ,1) - ZTS_ROOF(JJ)) )**0.25
!
!* absorbed LW
- PABS_LW_ROOF(JJ) = PEMIS_ROOF(JJ) * (PLW_RAD(JJ) - XSTEFAN * ZTRAD_ROOF(JJ)** 4)
+ PABS_LW_ROOF(JJ) = T%XEMIS_ROOF(JJ) * (PLW_RAD(JJ) - XSTEFAN * ZTRAD_ROOF(JJ)** 4)
!
!* 9. Sensible heat flux between snow free roof and air
! -------------------------------------------------
!
!* aerodynamic surface temperature at the intermediate time step
- ZTAER_ROOF(JJ) = ZEXPL * ZTS_ROOF(JJ) + ZIMPL * PT_ROOF(JJ,1)
+ ZTAER_ROOF(JJ) = ZEXPL * ZTS_ROOF(JJ) + ZIMPL * T%XT_ROOF(JJ,1)
PHFREE_ROOF(JJ) = ZRHO_ACF_ROOF(JJ) * XCPD * &
( ZTAER_ROOF(JJ)/PEXNS(JJ) - PTA(JJ)/PEXNA(JJ) )
!
@@ -342,7 +331,7 @@ DO JJ=1,SIZE(PT_ROOF,1)
!
PLEFREE_ROOF(JJ) = ZRHO_ACF_ROOF_WAT(JJ) * XLVTT * PDELT_ROOF(JJ) * &
( PQSAT_ROOF(JJ) - PQA(JJ) + &
- ZIMPL * ZDQSAT_ROOF(JJ) * (PT_ROOF(JJ,1) - ZTS_ROOF(JJ)) )
+ ZIMPL * ZDQSAT_ROOF(JJ) * (T%XT_ROOF(JJ,1) - ZTS_ROOF(JJ)) )
!
! 13. Energy imbalance for verification
! ---------------------------------
@@ -355,7 +344,7 @@ ENDDO
!* 11. New saturated specified humidity near the roof surface
! ------------------------------------------------------
!
-PQSAT_ROOF(:) = QSAT(PT_ROOF(:,1),PPS(:))
+PQSAT_ROOF(:) = QSAT(T%XT_ROOF(:,1),PPS(:))
!
!-------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('ROOF_LAYER_E_BUDGET',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/rw_precipn.F90 b/src/SURFEX/rw_precipn.F90
deleted file mode 100644
index 6f575bee22f183b32377f3fc99d5dff769d231cc..0000000000000000000000000000000000000000
--- a/src/SURFEX/rw_precipn.F90
+++ /dev/null
@@ -1,12 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE RW_PRECIP_n
-! ############################################
-!
-! Ã supprimer
-!
-!
-END SUBROUTINE RW_PRECIP_n
diff --git a/src/SURFEX/seaice_gelato1dn.F90 b/src/SURFEX/seaice_gelato1dn.F90
index 180f8097f4f29c42ae8f58c8593c6f8926adcd1d..a7f79259516568b812fe75c494e673dc41d0d7a9 100644
--- a/src/SURFEX/seaice_gelato1dn.F90
+++ b/src/SURFEX/seaice_gelato1dn.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE SEAICE_GELATO1D_n (S, &
- HPROGRAM,PTIMEC, PTSTEP,TPGLT, PSST, PSSS, &
- PFSIC, PFSIT, PSIC, PTICE, PICE_ALB)
+ SUBROUTINE SEAICE_GELATO1D_n (S, HPROGRAM, PTIMEC, PTSTEP)
! #######################################################################
!
!!**** *SEAICE_GELATO1D_n*
@@ -60,7 +58,6 @@ USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
!
USE MODD_CSTS,ONLY : XTT
USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_TYPES_GLT , ONLY : T_GLT
USE MODD_GLT_PARAM , ONLY : XTSTEP=>DTT, LWG, LP1, LP2, LP3, LP4, LP5, &
NPRINTO, GELATO_DIM=>NX
@@ -89,23 +86,14 @@ IMPLICIT NONE
!
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
REAL, INTENT(IN) :: PTIMEC ! current duration since start of the run (s)
REAL, INTENT(IN) :: PTSTEP ! surface time-step (s)
-TYPE(T_GLT) ,INTENT(INOUT) :: TPGLT ! Gelato state variable
-REAL, DIMENSION(:) ,INTENT(IN) :: PSST ! sea surface temperature (K)
-REAL, DIMENSION(:) ,INTENT(IN) :: PSSS ! sea surface salinity (psu)
-REAL, DIMENSION(:) ,INTENT(IN) :: PFSIC ! sea ice cover constraint ([0-1]).
-REAL, DIMENSION(:) ,INTENT(IN) :: PFSIT ! sea ice thickness constraint (m).
-!
-REAL, DIMENSION(:) ,INTENT(OUT) :: PSIC ! Sea-ice Cover ([0-1])
-REAL, DIMENSION(:) ,INTENT(OUT) :: PTICE ! Sea-ice temperature (K)
-REAL, DIMENSION(:) ,INTENT(OUT) :: PICE_ALB ! Sea-ce albedo ([0-1])
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION( SIZE(PSST)) :: ZSST ! sea surface temperature with frozen sea set at freezing point
-REAL, DIMENSION( SIZE(PSST)) :: ZSIC ! Will hold a forcing SIC field, even if PFSIC is missing
+REAL, DIMENSION( SIZE(S%XSST)) :: ZSST ! sea surface temperature with frozen sea set at freezing point
+REAL, DIMENSION( SIZE(S%XSST)) :: ZSIC ! Will hold a forcing SIC field, even if S%XFSIC is missing
!
INTEGER :: IT ! total number of Gelato timesteps in one atmospheric timestep
INTEGER :: JT ! Running index 1 -> IT
@@ -124,11 +112,11 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('SEAICE_GELATO1D',0,ZHOOK_HANDLE)
!
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
+CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
! Must restore Gelato problem size (nx) to the correct value for the NPROMA block
!
-GELATO_DIM=SIZE(PSSS)
+GELATO_DIM=SIZE(S%XSSS)
!
! Time steps stuff : default Gelato time step equals surface time step
!
@@ -154,27 +142,27 @@ ENDIF
! Ocean part
!----------------------------------------------------------------------------------
! Surface salinity
-TPGLT%oce_all(:,1)%sml=PSSS(:)
+S%TGLT%oce_all(:,1)%sml=S%XSSS(:)
! Ensure that SSS-dependant freezing point temperature is used on
! locations where SIC (or SST) forcing value calls for it
! First init ZSST with freezing temperature (which depends on local salinity)
! (Gelato uses Celsius scale for freezing temperatures)
-ZSST=RESHAPE(glt_swfrzt2d(RESHAPE(PSSS,(/SIZE(PSSS),1/))) + XTT,(/SIZE(PSSS)/))
+ZSST=RESHAPE(glt_swfrzt2d(RESHAPE(S%XSSS,(/SIZE(S%XSSS),1/))) + XTT,(/SIZE(S%XSSS)/))
-! Then replace freezing temp with Surfex-provided SST (PSST) where
+! Then replace freezing temp with Surfex-provided SST (S%XSST) where
! there is no (explicit or implicit) seaice and temperature is warmer
! than freezing point. And inits ZSIC accordingly
IF (S%LINTERPOL_SIC) THEN
- ZSIC=PFSIC
- WHERE ( ZSIC(:) < 1.e-10 .AND. PSST(:) > ZSST(:) )
- ZSST(:)=PSST(:)
+ ZSIC=S%XFSIC
+ WHERE ( ZSIC(:) < 1.e-10 .AND. S%XSST(:) > ZSST(:) )
+ ZSST(:)=S%XSST(:)
ENDWHERE
ELSE
! Implicit sea-ice cover
- WHERE (PSST(:) - XTT > S%XFREEZING_SST + 0.1 )
- ZSST(:)= PSST(:)
+ WHERE (S%XSST(:) - XTT > S%XFREEZING_SST + 0.1 )
+ ZSST(:)= S%XSST(:)
ZSIC(:)=0.
ELSEWHERE
ZSIC(:)=1.
@@ -185,9 +173,9 @@ ENDIF
!________________________________________________________________________
!
! Reset output accumulation/averaging fields
-PSIC = 0.
-PTICE = 0.
-PICE_ALB= 0.
+S%XSIC = 0.
+S%XTICE = 0.
+S%XICE_ALB= 0.
LP1 = (LWG.AND.NPRINTO>=1)
LP2 = (LWG.AND.NPRINTO>=2)
LP3 = (LWG.AND.NPRINTO>=3)
@@ -195,68 +183,68 @@ LP4 = (LWG.AND.NPRINTO>=4)
LP5 = (LWG.AND.NPRINTO>=5)
DO JT=1,IT
- IF (SIZE(PSSS) > 0) THEN
- TPGLT%oce_all(:,1)%tml=ZSST(:)
- IF (S%LINTERPOL_SIC) TPGLT%sit_d(1,:,1)%fsi=ZSIC(:)
- IF (S%LINTERPOL_SIT) TPGLT%sit_d(1,:,1)%hsi=PFSIT(:)
+ IF (SIZE(S%XSSS) > 0) THEN
+ S%TGLT%oce_all(:,1)%tml=ZSST(:)
+ IF (S%LINTERPOL_SIC) S%TGLT%sit_d(1,:,1)%fsi=ZSIC(:)
+ IF (S%LINTERPOL_SIT) S%TGLT%sit_d(1,:,1)%hsi=S%XFSIT(:)
! Gelato will compute heat flux from ocean by itself, thanks to
! imposed namelist parameter nextqoc=0
- TPGLT%oce_all(:,1)%qoc=0.
+ S%TGLT%oce_all(:,1)%qoc=0.
! Zero Frazil flux
- TPGLT%oce_all(:,1)%qml=0.
+ S%TGLT%oce_all(:,1)%qml=0.
! Don't bother for sea level variations
- TPGLT%oce_all(:,1)%ssh=0.
+ S%TGLT%oce_all(:,1)%ssh=0.
! (velocity components are useless in Surfex 1D setting)
!
! Atmosphere part
!----------------
! Feed Gelato input structure with flux values from XCPL_xx
!
- TPGLT%atm_all(:,1)%lip=S%XCPL_SEA_RAIN(:) / PTSTEP
- TPGLT%atm_all(:,1)%sop=S%XCPL_SEA_SNOW(:) / PTSTEP
+ S%TGLT%atm_all(:,1)%lip=S%XCPL_SEA_RAIN(:) / PTSTEP
+ S%TGLT%atm_all(:,1)%sop=S%XCPL_SEA_SNOW(:) / PTSTEP
! Fluxes over Sea water
- TPGLT%atm_wat(:,1)%eva=S%XCPL_SEA_EVAP(:) / PTSTEP
- TPGLT%atm_wat(:,1)%swa=S%XCPL_SEA_SNET(:) / PTSTEP
- TPGLT%atm_wat(:,1)%nsf=S%XCPL_SEA_HEAT(:) / PTSTEP
- TPGLT%atm_wat(:,1)%dfl=S%XSI_FLX_DRV ! W m-2 K-1
+ S%TGLT%atm_wat(:,1)%eva=S%XCPL_SEA_EVAP(:) / PTSTEP
+ S%TGLT%atm_wat(:,1)%swa=S%XCPL_SEA_SNET(:) / PTSTEP
+ S%TGLT%atm_wat(:,1)%nsf=S%XCPL_SEA_HEAT(:) / PTSTEP
+ S%TGLT%atm_wat(:,1)%dfl=S%XSI_FLX_DRV ! W m-2 K-1
! Fluxes over Sea ice
- TPGLT%atm_ice(1,:,1)%eva=S%XCPL_SEAICE_EVAP(:) / PTSTEP
- TPGLT%atm_ice(1,:,1)%swa=S%XCPL_SEAICE_SNET(:) / PTSTEP
- TPGLT%atm_ice(1,:,1)%nsf=S%XCPL_SEAICE_HEAT(:) / PTSTEP
- TPGLT%atm_ice(1,:,1)%dfl=S%XSI_FLX_DRV ! W m-2 K-1
+ S%TGLT%atm_ice(1,:,1)%eva=S%XCPL_SEAICE_EVAP(:) / PTSTEP
+ S%TGLT%atm_ice(1,:,1)%swa=S%XCPL_SEAICE_SNET(:) / PTSTEP
+ S%TGLT%atm_ice(1,:,1)%nsf=S%XCPL_SEAICE_HEAT(:) / PTSTEP
+ S%TGLT%atm_ice(1,:,1)%dfl=S%XSI_FLX_DRV ! W m-2 K-1
! (stress components are useless in Surfex 1D setting)
!
! Let Gelato process its input data
!
- CALL GLT_GETMLRF( TPGLT%oce_all,TPGLT%tml )
- CALL GLT_GETATMF( TPGLT )
- CALL GLTOOLS_CHKINP( 20010101,TPGLT )
+ CALL GLT_GETMLRF( S%TGLT%oce_all,S%TGLT%tml )
+ CALL GLT_GETATMF( S%TGLT )
+ CALL GLTOOLS_CHKINP( 20010101,S%TGLT )
!
! Compute gelato time index
!
- TPGLT%IND%CUR = ( PTIMEC + JT * XTSTEP ) / XTSTEP
+ S%TGLT%IND%CUR = ( PTIMEC + JT * XTSTEP ) / XTSTEP
!
! Let Gelato thermodynamic scheme run
!
- CALL GLT_GELATO( TPGLT )
+ CALL GLT_GELATO( S%TGLT )
!
! Have Gelato feed its coupling ouptut interface
!
- CALL GLT_SNDATMF( TPGLT )
- CALL GLT_SNDMLRF( TPGLT%bat,TPGLT%dom,TPGLT%atm_all,TPGLT%tml, &
- TPGLT%dia,TPGLT%sit,TPGLT%tfl,TPGLT%ust,TPGLT%all_oce )
- CALL WRIDIA_AR5( TPGLT )
- CALL GLTOOLS_CHKOUT( 20010101,TPGLT ) ! Does not actually work with Arpege
+ CALL GLT_SNDATMF( S%TGLT )
+ CALL GLT_SNDMLRF( S%TGLT%bat,S%TGLT%dom,S%TGLT%atm_all,S%TGLT%tml, &
+ S%TGLT%dia,S%TGLT%sit,S%TGLT%tfl,S%TGLT%ust,S%TGLT%all_oce )
+ CALL WRIDIA_AR5( S%TGLT )
+ CALL GLTOOLS_CHKOUT( 20010101,S%TGLT ) ! Does not actually work with Arpege
! Sum output fields over Gelato model time step duration
- PSIC = PSIC + TPGLT%ice_atm(1,:,1)%fsi * XTSTEP
- PTICE = PTICE + TPGLT%ice_atm(1,:,1)%tsf * XTSTEP
- PICE_ALB = PICE_ALB + TPGLT%ice_atm(1,:,1)%alb * XTSTEP
+ S%XSIC = S%XSIC + S%TGLT%ice_atm(1,:,1)%fsi * XTSTEP
+ S%XTICE = S%XTICE + S%TGLT%ice_atm(1,:,1)%tsf * XTSTEP
+ S%XICE_ALB = S%XICE_ALB + S%TGLT%ice_atm(1,:,1)%alb * XTSTEP
ENDIF
END DO
! Average output fields over coupling time
-PSIC = PSIC / (IT * XTSTEP)
-PTICE = PTICE / (IT * XTSTEP)
-PICE_ALB = PICE_ALB / (IT * XTSTEP)
+S%XSIC = S%XSIC / (IT * XTSTEP)
+S%XTICE = S%XTICE / (IT * XTSTEP)
+S%XICE_ALB = S%XICE_ALB / (IT * XTSTEP)
!
! Resets input accumulation fields for next step
!
diff --git a/src/SURFEX/second_sfx.F90 b/src/SURFEX/second_sfx.F90
index d2f7e1b7dadec8c8c9e338280ce34d76698c33ef..d3fc22650d4384d532b6aa916d0cca45a99ad609 100644
--- a/src/SURFEX/second_sfx.F90
+++ b/src/SURFEX/second_sfx.F90
@@ -16,7 +16,7 @@ IF (LHOOK) CALL DR_HOOK('SECOND_SFX',0,ZHOOK_HANDLE)
CALL system('date +%s > tempo')
OPEN(UNIT=99,FILE='tempo')
READ(99,*)IT
- CLOSE(99)
+CLOSE(99)
KT=IT
IF (LHOOK) CALL DR_HOOK('SECOND_SFX',1,ZHOOK_HANDLE)
END SUBROUTINE SECOND_SFX
diff --git a/src/SURFEX/set_axis.F90 b/src/SURFEX/set_axis.F90
new file mode 100644
index 0000000000000000000000000000000000000000..6a721270536c8e4bc42f02befd0a09a9ce96cae7
--- /dev/null
+++ b/src/SURFEX/set_axis.F90
@@ -0,0 +1,115 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+SUBROUTINE SET_AXIS(HNAME, PVALUE ,CDPOSITIVE, KSIZE, CDUNITS, PBOUNDS)
+!!
+!!
+!! PURPOSE
+!! --------
+!!
+!! Declare a Surfex axis to XIOS
+!!
+!!
+!! IMPLICIT ARGUMENTS :
+!! --------------------
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! XIOS LIBRARY
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! XIOS Reference guide - Yann Meurdesoif - 10/10/2014 -
+!! svn co -r 515 http://forge.ipsl.jussieu.fr/ioserver/svn/XIOS/branchs/xios-1.0 <dir> ; cd <dir>/doc ; ....
+!!
+!! AUTHOR
+!! ------
+!!
+!! S.Sénési, CNRM
+!!
+!! MODIFICATION
+!! --------------
+!!
+!! Original 08/2015
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+USE MODI_ABOR1_SFX
+!
+USE MODD_XIOS, ONLY : LXIOS
+#ifdef WXIOS
+USE XIOS, ONLY : XIOS_GET_HANDLE, XIOS_ADD_CHILD, XIOS_SET_AXIS_ATTR, XIOS_AXISGROUP, XIOS_AXIS
+#endif
+!
+!
+IMPLICIT NONE
+!
+! Arguments
+!
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! axis name
+REAL,DIMENSION(:),INTENT(IN), OPTIONAL :: PVALUE ! axis coordinate values array
+CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: CDPOSITIVE ! 'up' or 'down', if axis is vertical
+INTEGER , INTENT(IN), OPTIONAL :: KSIZE ! size of the axis (when values are not provided)
+CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: CDUNITS ! Units for the values
+REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL :: PBOUNDS ! coordinate bounds array (should be (2,:))
+!
+! Local variables
+!
+#ifdef WXIOS
+TYPE(xios_axisgroup) :: axisgroup_hdl
+TYPE(xios_axis) :: axis_hdl
+#endif
+!
+INTEGER :: I
+REAL(KIND=JPRB), DIMENSION(:),ALLOCATABLE :: ZAXIS
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('SET_AXIS',0,ZHOOK_HANDLE)
+!
+IF (LXIOS) THEN
+#ifdef WXIOS
+!
+!$OMP SINGLE
+
+ CALL XIOS_GET_HANDLE("axis_definition",axisgroup_hdl)
+ CALL XIOS_ADD_CHILD(axisgroup_hdl,axis_hdl,HNAME)
+ IF (PRESENT(PVALUE)) THEN
+ CALL XIOS_SET_AXIS_ATTR(HNAME, VALUE=PVALUE, N_GLO=SIZE(PVALUE))
+ IF (PRESENT(PBOUNDS)) THEN
+ CALL XIOS_SET_AXIS_ATTR(HNAME, BOUNDS=PBOUNDS)
+ ENDIF
+ IF (PRESENT(CDUNITS)) THEN
+ CALL XIOS_SET_AXIS_ATTR(HNAME, UNIT=CDUNITS)
+ ENDIF
+ ELSE
+ IF (PRESENT(KSIZE)) THEN
+ ALLOCATE(ZAXIS(KSIZE))
+ ZAXIS=(/(I, I=1,KSIZE)/)
+ CALL XIOS_SET_AXIS_ATTR(HNAME, VALUE=ZAXIS, N_GLO=KSIZE)
+ DEALLOCATE(ZAXIS)
+ ELSE
+ CALL ABOR1_SFX('SET_AXIS : MUST PROVIDE PVALUE OR KSIZE FOR'//TRIM(HNAME))
+ ENDIF
+ ENDIF
+ IF (PRESENT(CDPOSITIVE)) THEN
+ CALL XIOS_SET_AXIS_ATTR(HNAME, POSITIVE=CDPOSITIVE)
+ ENDIF
+
+!$OMP END SINGLE
+!
+#endif
+ENDIF
+!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SET_AXIS',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE SET_AXIS
diff --git a/src/SURFEX/set_rough.F90 b/src/SURFEX/set_rough.F90
deleted file mode 100644
index 1dabc90531b9bf0cedbcf564c136eaeb213bf7f1..0000000000000000000000000000000000000000
--- a/src/SURFEX/set_rough.F90
+++ /dev/null
@@ -1,89 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE SET_ROUGH(OCANOPY,HROUGH)
-! ########################################################################
-!
-!!**** *SET_ROUGH* - routine to set default values for roughness ISBA configuration
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODI_ABOR1_SFX
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
-!
-LOGICAL, INTENT(IN) :: OCANOPY ! True = SBL scheme
- ! False = no SBL scheme
- CHARACTER(LEN=4), INTENT(INOUT) :: HROUGH ! type of roughness length
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-!-------------------------------------------------------------------------------
-!
-!* default value if needed
-!
-IF (LHOOK) CALL DR_HOOK('SET_ROUGH',0,ZHOOK_HANDLE)
-IF (HROUGH == "UNDE") THEN
- IF (OCANOPY) THEN
- HROUGH = "BE04"
- ELSE
- HROUGH = "Z04D"
- END IF
-END IF
-!
-!* coherence check
-!
-IF (OCANOPY .AND. (HROUGH=="Z01D" .OR. HROUGH=="Z04D")) THEN
- CALL ABOR1_SFX('If LISBA_CANOPY=T, orographic roughness cannot be computed by CROUGH="Z01D" or "Z04D"')
-END IF
-!
-IF (.NOT. OCANOPY .AND. HROUGH=="BE04") THEN
- CALL ABOR1_SFX('If LISBA_CANOPY=F, orographic roughness cannot be computed by CROUGH="BE04"')
-END IF
-IF (LHOOK) CALL DR_HOOK('SET_ROUGH',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE SET_ROUGH
diff --git a/src/SURFEX/set_sso_levels.F90 b/src/SURFEX/set_sso_levels.F90
index a959f1b5540aad42bad6b3f08e85f62472f957cc..39857353d9ccdedca0dc02a8773203f5b0277e80 100644
--- a/src/SURFEX/set_sso_levels.F90
+++ b/src/SURFEX/set_sso_levels.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #################################################################################
-SUBROUTINE SET_SSO_LEVELS (SSCP, &
- KDIM)
+SUBROUTINE SET_SSO_LEVELS (SB, KDIM)
! #################################################################################
!
!!**** *SET_SSO_LEVELS* - prepares SSO canopy fields
@@ -32,10 +31,12 @@ SUBROUTINE SET_SSO_LEVELS (SSCP, &
!!------------------------------------------------------------------
!
!
-USE MODD_SSO_CANOPY_n, ONLY : SSO_CANOPY_t
+USE MODD_CANOPY_n, ONLY : CANOPY_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
+USE MODI_PREP_SBL
+!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -44,7 +45,7 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(SSO_CANOPY_t), INTENT(INOUT) :: SSCP
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
!
INTEGER, INTENT(IN) :: KDIM ! 1D physical dimension
@@ -54,7 +55,6 @@ INTEGER, INTENT(IN) :: KDIM ! 1D physical dimension
INTEGER :: JLAYER
INTEGER :: ILU ! number of points
!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZZF ! altitudes at half levels
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
@@ -63,39 +63,20 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ----------------
!
IF (LHOOK) CALL DR_HOOK('SET_SSO_LEVELS',0,ZHOOK_HANDLE)
-SSCP%NLVL = 6
-!
-!* 2. height of half levels (where turbulent fluxes will be)
-! ---------------------
-!
-!* Warning : ZZF(:,1) MUST BE ZERO
-ALLOCATE(ZZF(KDIM,SSCP%NLVL))
-ZZF(:,1) = 0.
-ZZF(:,2) = 1
-ZZF(:,3) = 3.
-ZZF(:,4) = 5.
-ZZF(:,5) = 8.
-ZZF(:,6) = 12.
-
-ALLOCATE(SSCP%XZ(KDIM,SSCP%NLVL))
-DO JLAYER=1,SSCP%NLVL-1
- SSCP%XZ(:,JLAYER) = 0.5 * (ZZF(:,JLAYER)+ZZF(:,JLAYER+1))
-END DO
-SSCP%XZ(:,SSCP%NLVL) = 1.5 * ZZF(:,SSCP%NLVL) - 0.5 * ZZF(:,SSCP%NLVL-1)
!
-DEALLOCATE(ZZF)
+ CALL PREP_SBL(KDIM, SB)
!
!* 3. wind in canopy (m/s)
! --------------
!
-ALLOCATE(SSCP%XU(KDIM,SSCP%NLVL))
-SSCP%XU(:,:) = XUNDEF
+ALLOCATE(SB%XU(KDIM,SB%NLVL))
+SB%XU(:,:) = XUNDEF
!
!* 4. Tke in canopy (m2/s2)
! -------------
!
-ALLOCATE(SSCP%XTKE(KDIM,SSCP%NLVL))
-SSCP%XTKE(:,:) = XUNDEF
+ALLOCATE(SB%XTKE(KDIM,SB%NLVL))
+SB%XTKE(:,:) = XUNDEF
!
IF (LHOOK) CALL DR_HOOK('SET_SSO_LEVELS',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/set_surfex_filein.F90 b/src/SURFEX/set_surfex_filein.F90
index 156a6352501a3f0ac27f0f140bcb3c940c7c11a7..0d3647e4c0c4bd0700b33a7dabf8c20542f26155 100644
--- a/src/SURFEX/set_surfex_filein.F90
+++ b/src/SURFEX/set_surfex_filein.F90
@@ -58,6 +58,9 @@ USE MODI_SET_SURFEX_FILE_NAME_NC
#ifdef SFX_MNH
USE MODI_SET_SURFEX_FILE_NAME_MNH
#endif
+#ifdef SFX_ARO
+USE MODI_SET_SURFEX_FILE_NAME_ARO
+#endif
!
USE MODI_ABOR1_SFX
!
@@ -66,6 +69,7 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+!
!* 0.1 Declarations of arguments
! -------------------------
!
@@ -139,7 +143,7 @@ ENDIF
!
IF (HPROGRAM=='AROME ' ) THEN
#ifdef SFX_ARO
- CALL SET_SURFEX_FILE_NAME_ARO(HMASK)
+ CALL SET_SURFEX_FILE_NAME_ARO
#endif
ENDIF
!
diff --git a/src/SURFEX/sfx_oasis_check.F90 b/src/SURFEX/sfx_oasis_check.F90
index 41f314bc4c8507e285fb738dfc081c2c4989fb95..6017ffc04a6780ca3e99cc28e46ed97356892f9c 100644
--- a/src/SURFEX/sfx_oasis_check.F90
+++ b/src/SURFEX/sfx_oasis_check.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#########
-SUBROUTINE SFX_OASIS_CHECK (I, U, &
- KLUOUT)
+SUBROUTINE SFX_OASIS_CHECK (IO, U, KLUOUT)
!###################################################
!
!!**** *SFX_OASIS_CHECK* - Definitions for exchange of coupling fields
@@ -33,6 +32,7 @@ SUBROUTINE SFX_OASIS_CHECK (I, U, &
!! MODIFICATIONS
!! -------------
!! Original 10/2013
+!! 10/2016 B. Decharme : bug surface/groundwater coupling
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -41,7 +41,7 @@ SUBROUTINE SFX_OASIS_CHECK (I, U, &
!
!
!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODN_SFX_OASIS, ONLY : CCALVING, LWATER
@@ -58,7 +58,7 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
INTEGER, INTENT(IN) :: KLUOUT
@@ -86,7 +86,7 @@ ENDIF
!
!
IF(LCPL_CALVING)THEN
- IF(.NOT.I%LGLACIER)THEN
+ IF(.NOT.IO%LGLACIER)THEN
WRITE(KLUOUT,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
WRITE(KLUOUT,*)'Calving flux is asked by SFX - OASIS coupling '
WRITE(KLUOUT,*)'CCALVING = '//TRIM(CCALVING)//' in NAM_SFX_LAND_CPL'
@@ -98,18 +98,18 @@ IF(LCPL_CALVING)THEN
ENDIF
!
!
-IF(LCPL_GW.AND.I%CISBA/='DIF')THEN
+IF(LCPL_GW.AND.IO%CISBA/='DIF')THEN
WRITE(KLUOUT,*)'SFX_OASIS_CHECK: Water table depth / surface coupling requires ISBA-DF'
CALL ABOR1_SFX('SFX_OASIS_CHECK: ISBA-DF is required for SFX - Groundwater coupling')
ENDIF
-IF(.NOT.LCPL_GW.AND.I%CISBA=='DIF'.AND.I%LWTD)THEN
+IF(.NOT.LCPL_GW.AND.IO%CISBA=='DIF'.AND.IO%LWTD)THEN
WRITE(KLUOUT,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
WRITE(KLUOUT,*)'!!! A groundwater map is specified and LAND coupling !!!'
WRITE(KLUOUT,*)'!!! is activated but not groundwater/surface coupling !!!'
WRITE(KLUOUT,*)'!!! !!!'
WRITE(KLUOUT,*)'!!! ARE YOU SURE : YOU DO NOT WANT THIS COUPLING ? !!!'
WRITE(KLUOUT,*)'!!! !!!'
- WRITE(KLUOUT,*)'!!! Use NAM_SFX_LAND_CPL with CWTD, CFWTD and CRECHARGE !!!'
+ WRITE(KLUOUT,*)'!!! Use NAM_SFX_LAND_CPL with CWTD and CFWTD !!!'
WRITE(KLUOUT,*)'!!! if you want this coupling via OASIS !!!'
WRITE(KLUOUT,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
ENDIF
diff --git a/src/SURFEX/sfx_oasis_define.F90 b/src/SURFEX/sfx_oasis_define.F90
index f71009c81f1debde0e591b6decfb2ef26cfe429c..54a71c19f593534ff16c2832332bc449d7d9b470 100644
--- a/src/SURFEX/sfx_oasis_define.F90
+++ b/src/SURFEX/sfx_oasis_define.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#########
-SUBROUTINE SFX_OASIS_DEFINE (I, U, &
- HPROGRAM,KNPTS,KPARAL)
+SUBROUTINE SFX_OASIS_DEFINE (IO, U, HPROGRAM,KNPTS,KPARAL)
!###################################################
!
!!**** *SFX_OASIS_DEFINE* - Definitions for exchange of coupling fields
@@ -33,6 +32,7 @@ SUBROUTINE SFX_OASIS_DEFINE (I, U, &
!! MODIFICATIONS
!! -------------
!! Original 10/2013
+!! 10/2016 B. Decharme : bug surface/groundwater coupling
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -40,7 +40,7 @@ SUBROUTINE SFX_OASIS_DEFINE (I, U, &
!
!
!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODD_SURF_PAR, ONLY : NUNDEF
@@ -65,10 +65,10 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
INTEGER, INTENT(IN) :: KNPTS ! Number of grid point on this proc
INTEGER, DIMENSION(:), INTENT(IN) :: KPARAL
!
@@ -103,17 +103,16 @@ IF (LHOOK) CALL DR_HOOK('SFX_OASIS_DEFINE',0,ZHOOK_HANDLE)
!* 0. Initialize :
! ------------
!
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
+CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
- CALL SFX_OASIS_CHECK(I, U, &
- ILUOUT)
+CALL SFX_OASIS_CHECK(IO, U, ILUOUT)
!
!-------------------------------------------------------------------------------
!
!* 1. Define parallel partitions:
! ---------------------------
!
- CALL OASIS_DEF_PARTITION(IPART_ID,KPARAL(:),IERR)
+CALL OASIS_DEF_PARTITION(IPART_ID,KPARAL(:),IERR)
!
IF(IERR/=OASIS_OK)THEN
WRITE(ILUOUT,*)'SFX_OASIS_DEFINE: OASIS def partition problem, err = ',IERR
@@ -330,10 +329,6 @@ IF(LCPL_LAND)THEN
!
IF(LCPL_GW)THEN
!
-! Output groundwater recharge
- CALL OASIS_DEF_VAR(NRECHARGE_ID,CRECHARGE,IPART_ID,IVAR_NODIMS,OASIS_OUT,IVAR_SHAPE,OASIS_DOUBLE,IERR)
- IF(IERR/=OASIS_OK) CALL ABOR1_SFX('SFX_OASIS_DEFINE: OASIS def var problem for land groundwater recharge')
-!
! Input Water table depth
CALL OASIS_DEF_VAR(NWTD_ID,CWTD,IPART_ID,IVAR_NODIMS,OASIS_IN,IVAR_SHAPE,OASIS_DOUBLE,IERR)
IF(IERR/=OASIS_OK) CALL ABOR1_SFX('SFX_OASIS_DEFINE: OASIS def var problem for land Water table depth')
@@ -369,7 +364,7 @@ ENDIF
!* 6. End of declaration phase:
! --------------
!
- CALL OASIS_ENDDEF(IERR)
+CALL OASIS_ENDDEF(IERR)
!
IF(IERR/=OASIS_OK)THEN
WRITE(ILUOUT,*)'SFX_OASIS_DEFINE: OASIS enddef problem, err = ',IERR
diff --git a/src/SURFEX/sfx_oasis_end.F90 b/src/SURFEX/sfx_oasis_end.F90
index d94cb7d8de6dd805e38091f629649461c5e626db..f9d6f66b464711e797d0b45042600d245607d7e4 100644
--- a/src/SURFEX/sfx_oasis_end.F90
+++ b/src/SURFEX/sfx_oasis_end.F90
@@ -6,7 +6,7 @@
SUBROUTINE SFX_OASIS_END
!########################
!
-!!**** *SFX_OASIS_END* - end coupling SFX - OASIS
+!!**** *SFX_OASIS_END* - end coupling SFX - OASIS and XIOS
!!
!! PURPOSE
!! -------
@@ -32,17 +32,24 @@ SUBROUTINE SFX_OASIS_END
!! MODIFICATIONS
!! -------------
!! Original 10/2013
+!! S.Sénési 08/2015 : add XIOS_FINALIZE
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_SFX_OASIS, ONLY : LOASIS
-!
#ifdef CPLOASIS
USE MOD_OASIS
+USE MODD_SFX_OASIS, ONLY : LOASIS
+#endif
+!
+#ifdef WXIOS
+USE MODD_XIOS , ONLY : LXIOS
+USE XIOS, ONLY : XIOS_FINALIZE
#endif
!
+USE MODI_ABOR1_SFX
+!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -55,21 +62,31 @@ IMPLICIT NONE
INTEGER :: IERR ! Error info
!
!-------------------------------------------------------------------------------
-#ifdef CPLOASIS
-!-------------------------------------------------------------------------------
!
-IF(LOASIS)THEN !Same test than in offline.F90 because use for Arpege-Aladin-Arome
- CALL OASIS_TERMINATE(IERR)
- IF (IERR/=OASIS_OK) THEN
- WRITE(*,'(A)' )'Error OASIS terminate'
- WRITE(*,'(A,I4)')'Return code from oasis_terminate : ',IERR
- CALL ABORT
- STOP
- ENDIF
+#ifdef WXIOS
+IF (LXIOS) THEN
+! XIOS will finalize Oasis if needed
+ CALL XIOS_FINALIZE()
ENDIF
+#endif
!
-!-------------------------------------------------------------------------------
+#ifdef CPLOASIS
+IF(LOASIS) THEN
+#ifdef WXIOS
+ IF (.NOT. LXIOS)THEN !Same test than in offline.F90 because use for Arpege-Aladin-Arome
+#endif
+ CALL OASIS_TERMINATE(IERR)
+ IF (IERR/=OASIS_OK) THEN
+ WRITE(*,'(A)' )'Error OASIS terminate'
+ WRITE(*,'(A,I4)')'Return code from oasis_terminate : ',IERR
+ CALL ABOR1_SFX("SFX_OASIS_END: Error OASIS terminate")
+ ENDIF
+#ifdef WXIOS
+ ENDIF
+#endif
+ENDIF
#endif
+!
!-------------------------------------------------------------------------------
!
END SUBROUTINE SFX_OASIS_END
diff --git a/src/SURFEX/sfx_oasis_init.F90 b/src/SURFEX/sfx_oasis_init.F90
index 1d83689f108c5b25c4649bd4526631a5a96abae0..022a8c4d9987ebe406e75734d7e241b3af973bd1 100644
--- a/src/SURFEX/sfx_oasis_init.F90
+++ b/src/SURFEX/sfx_oasis_init.F90
@@ -8,15 +8,19 @@ SUBROUTINE SFX_OASIS_INIT(HNAMELIST,KLOCAL_COMM,HINIT)
!! PURPOSE
!! --------
!!
-!! Initialize coupled mode communication
+!! Initialize coupled mode communication and XIOS I/O scheme
!!
!!
!! METHOD
!! ------
!!
-!! OASIS-MCT usage is controlled by environment variables
-!! OASIS-MCT interface must be initialized before any DR_HOOK call
+!! Depending on namelist flags for Oasis and XIOS, either call :
+!! - XIOS_INITIALIZE alone (when LXIOS and not LOASIS) , or
+!! - OASIS_INIT_COMP (when LOASIS) and then, depending on LXIOS,
+!! * either XIOS_INITALIZE
+!! * or OASIS_GET_LOCAL_COMM
!!
+!! Note : OASIS-MCT interface must be initialized before any DR_HOOK call
!!
!! EXTERNAL
!! --------
@@ -29,6 +33,9 @@ SUBROUTINE SFX_OASIS_INIT(HNAMELIST,KLOCAL_COMM,HINIT)
!! CERFACS, Toulouse, France, 50 pp.
!! https://verc.enes.org/oasis/oasis-dedicated-user-support-1/documentation/oasis3-mct-user-guide
!!
+!! XIOS Reference guide - Yann Meurdesoif - 10/10/2014 -
+!! svn co -r 515 http://forge.ipsl.jussieu.fr/ioserver/svn/XIOS/branchs/xios-1.0 <dir> ; cd <dir>/doc ; ....
+!!
!!
!! AUTHOR
!! ------
@@ -39,13 +46,22 @@ SUBROUTINE SFX_OASIS_INIT(HNAMELIST,KLOCAL_COMM,HINIT)
!! --------------
!!
!! Original 10/2013
+!! S.Sénési 08/2015 - handle XIOS
+!! B.Decharme 09/2016 - no CALL ABORT if no namelist in Arpege
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_SFX_OASIS, ONLY : LOASIS, XRUNTIME
+USE MODD_SFX_OASIS, ONLY : LOASIS, CMODEL_NAME, XRUNTIME
+USE MODI_ABOR1_SFX
+!
+USE MODD_XIOS , ONLY : LXIOS ! Should we call XIOS_INITIALIZE instead of OASIS_GET_LOCAL_COMM
+!
+#ifdef WXIOS
+USE XIOS, ONLY : XIOS_INITIALIZE
+#endif
!
#ifdef CPLOASIS
USE MOD_OASIS
@@ -78,8 +94,6 @@ LOGICAL :: GFOUND
!
!* 0.3 Declarations of namelist variables
! ----------------------------------
-!
- CHARACTER(LEN=6) :: CMODEL_NAME ! component model name
!
NAMELIST/NAM_OASIS/LOASIS,CMODEL_NAME
!
@@ -107,135 +121,165 @@ IF(LEN_TRIM(HNAMELIST)/=0)THEN
OPEN(UNIT=11,FILE=HNAMELIST,ACTION='READ',FORM="FORMATTED",POSITION="REWIND",STATUS='OLD',IOSTAT=IERR)
!
IF (IERR /= 0) THEN
- WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- WRITE(*,'(2A)')'SFX_OASIS_INIT: SFX NAMELIST NOT FOUND: ',TRIM(HNAMELIST)
- WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- CALL ABORT
- STOP
+ WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ WRITE(*,'(A)' )' WARNING WARNING WARNING WARNING WARNING '
+ WRITE(*,'(A)' )' --------------------------------------- '
+ WRITE(*,'(2A)')'SFX_OASIS_INIT: SFX NAMELIST FILE NOT FOUND: ',TRIM(HNAMELIST)
+ WRITE(*,'(A)' )'------------------------------------------- '
+ WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+#ifndef SFX_ARO
+ CALL ABORT
+ STOP
+#endif
+ ELSE
+ READ (UNIT=11,NML=NAM_OASIS,IOSTAT=IERR)
+ CLOSE(UNIT=11)
ENDIF
+ !
+ENDIF
!
- READ (UNIT=11,NML=NAM_OASIS,IOSTAT=IERR)
+!-------------------------------------------------------------------------------
!
- CLOSE(UNIT=11)
+!* 2. Setup OASIS (possibly via XIOS) and XIOS
+! ----------------------------------------
!
-ENDIF
+IF (LXIOS) THEN
!
-!-------------------------------------------------------------------------------
!
-!* 2. Setup OASIS
-! -----------
+#ifdef WXIOS
+ ! NOTE : XIOS_INITIALIZE will call OASIS_INIT_COMP and
+ ! OASIS_GET_LOCALCOMM if its own config file calls for Oasis
+!$OMP SINGLE
+ CALL XIOS_INITIALIZE(CMODEL_NAME, return_comm=KLOCAL_COMM)
+!$OMP END SINGLE
!
-IF(LOASIS)THEN
+#else
+!
+ WRITE(*,*) 'SFX_OASIS_INIT : BINARY WAS NOT COMPILED WITH XIOS SUPPORT '
+ CALL ABOR1_SFX('SFX_OASIS_INIT : BINARY WAS NOT COMPILED WITH XIOS SUPPORT')
!
-#ifdef CPLOASIS
- CALL OASIS_INIT_COMP(ICOMP_ID,CMODEL_NAME,IERR)
- IF (IERR/=OASIS_OK) THEN
- WRITE(*,'(A)' )'SFX : Error initializing OASIS'
- WRITE(*,'(A,I4)')'SFX : Return code from oasis_init_comp : ',IERR
- CALL OASIS_ABORT(ICOMP_ID,CMODEL_NAME,'SFX_OASIS_INIT: Error initializing OASIS')
- CALL ABORT
- STOP
- ENDIF
- CALL MPI_COMM_RANK(MPI_COMM_WORLD,IRANK,IWORK)
#endif
!
- IF(IRANK==0)THEN
- WRITE(*,'(A)')'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- WRITE(*,'(A)')'OASIS used for model : ',TRIM(CMODEL_NAME)
- WRITE(*,'(A)')'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- ENDIF
!
-ELSE
+ELSE ! (i.e. .NOT. LXIOS)
!
+#ifdef CPLOASIS
+
+ IF (LOASIS ) THEN
+ IRANK=0
+ CALL OASIS_INIT_COMP(ICOMP_ID,CMODEL_NAME,IERR)
+ IF (IERR/=OASIS_OK) THEN
+ WRITE(*,'(A)' )'SFX : Error initializing OASIS'
+ WRITE(*,'(A,I4)')'SFX : Return code from oasis_init_comp : ',IERR
+ CALL OASIS_ABORT(ICOMP_ID,CMODEL_NAME,'SFX_OASIS_INIT: Error initializing OASIS')
+ CALL ABORT
+ STOP
+ ENDIF
+ CALL OASIS_GET_LOCALCOMM(KLOCAL_COMM,IERR)
+ IF (IERR/=OASIS_OK) THEN
+ IF(IRANK==0)THEN
+ WRITE(*,'(A)' )'SFX : Error getting local communicator from OASIS'
+ WRITE(*,'(A,I4)')'SFX : Return code from oasis_get_local_comm : ',IERR
+ ENDIF
+ CALL OASIS_ABORT(ICOMP_ID,CMODEL_NAME,'SFX_OASIS_INIT: Error getting local communicator')
+ CALL ABORT
+ STOP
+ ENDIF
+!
+ ELSE
+ KLOCAL_COMM=0
+ RETURN
+ ENDIF
+
+#else
+
KLOCAL_COMM=0
RETURN
+
+#endif
!
ENDIF
-!-------------------------------------------------------------------------------
!
-!* 4. Get local communicator
-! ----------------------
+#ifdef SFX_MPI
+CALL MPI_COMM_RANK(KLOCAL_COMM,IRANK,IWORK)
+#endif
+IF(IRANK==0)THEN
+ WRITE(*,'(A)')'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ IF (LOASIS) WRITE(*,'(A)')'OASIS used for model : '//TRIM(CMODEL_NAME)
+ IF (LXIOS) WRITE(*,'(A)')'XIOS used for model : '//TRIM(CMODEL_NAME)
+ WRITE(*,'(A)')'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ENDIF
!
-#ifdef CPLOASIS
- CALL OASIS_GET_LOCALCOMM(KLOCAL_COMM,IERR)
-IF (IERR/=OASIS_OK) THEN
- IF(IRANK==0)THEN
- WRITE(*,'(A)' )'SFX : Error getting local communicator from OASIS'
- WRITE(*,'(A,I4)')'SFX : Return code from oasis_get_local_comm : ',IERR
- ENDIF
- CALL OASIS_ABORT(ICOMP_ID,CMODEL_NAME,'SFX_OASIS_INIT: Error getting local communicator')
- CALL ABORT
- STOP
+IF(YINIT=='PRE')THEN
+ RETURN
ENDIF
-#endif
+
+#ifdef CPLOASIS
+IF (LOASIS) THEN
!
!-------------------------------------------------------------------------------
!
-!
-IF(YINIT=='PRE')THEN
- RETURN
-ENDIF
-!
!* 5. Read total simulated time in namcouple
! --------------------------------------
!
-OPEN (UNIT=11,FILE ='namcouple',STATUS='OLD',FORM ='FORMATTED',POSITION="REWIND",IOSTAT=IERR)
-IF (IERR /= 0) THEN
- IF(IRANK==0)THEN
- WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- WRITE(*,'(A)' )'SFX : OASIS namcouple not found'
- WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- ENDIF
- CALL ABORT
- STOP
-ENDIF
-!
-YTIMERUN=' $RUNTIME'
-ITIMERUN=-1
-!
-DO WHILE (ITIMERUN==-1)
- READ (UNIT = 11,FMT = '(A9)',IOSTAT=IERR) YWORD
- IF(IERR/=0)THEN
- IF(IRANK==0)THEN
- WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- WRITE(*,'(A)' )'SFX : Problem $RUNTIME empty in namcouple'
- WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- ENDIF
- CALL ABORT
- STOP
- ENDIF
- IF (YWORD==YTIMERUN)THEN
- READ (UNIT = 11,FMT = '(A1000)',IOSTAT=IERR) YLINE
- IF(IERR/=0)THEN
- IF(IRANK==0)THEN
- WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- WRITE(*,'(A)' )'SFX : Problem looking for $RUNTIME in namcouple'
- WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- ENDIF
- CALL ABORT
- STOP
- ENDIF
- CALL FOUND_TIMERUN (YLINE, YFOUND, 1000, GFOUND)
- IF (GFOUND) THEN
+ OPEN (UNIT=11,FILE ='namcouple',STATUS='OLD',FORM ='FORMATTED',POSITION="REWIND",IOSTAT=IERR)
+ IF (IERR /= 0) THEN
+ IF(IRANK==0)THEN
+ WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ WRITE(*,'(A)' )'SFX : OASIS namcouple not found'
+ WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ ENDIF
+ CALL ABORT
+ STOP
+ ENDIF
+!
+ YTIMERUN=' $RUNTIME'
+ ITIMERUN=-1
+!
+ DO WHILE (ITIMERUN==-1)
+ READ (UNIT = 11,FMT = '(A9)',IOSTAT=IERR) YWORD
+ IF(IERR/=0)THEN
+ IF(IRANK==0)THEN
+ WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ WRITE(*,'(A)' )'SFX : Problem $RUNTIME empty in namcouple'
+ WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ ENDIF
+ CALL ABORT
+ STOP
+ ENDIF
+ IF (YWORD==YTIMERUN)THEN
+ READ (UNIT = 11,FMT = '(A1000)',IOSTAT=IERR) YLINE
+ IF(IERR/=0)THEN
+ IF(IRANK==0)THEN
+ WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ WRITE(*,'(A)' )'SFX : Problem looking for $RUNTIME in namcouple'
+ WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ ENDIF
+ CALL ABORT
+ STOP
+ ENDIF
+ CALL FOUND_TIMERUN (YLINE, YFOUND, 1000, GFOUND)
+ IF (GFOUND) THEN
READ (YFOUND,FMT = '(I100)',IOSTAT=IERR) ITIMERUN
IF(IERR/=0)THEN
- IF(IRANK==0)THEN
- WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- WRITE(*,'(A)' )'SFX : Problem reading $RUNTIME in namcouple'
- WRITE(*,'(2A)' )'$RUNTIME = ', TRIM(YFOUND)
- WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
- ENDIF
- CALL ABORT
- STOP
+ IF(IRANK==0)THEN
+ WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ WRITE(*,'(A)' )'SFX : Problem reading $RUNTIME in namcouple'
+ WRITE(*,'(2A)' )'$RUNTIME = ', TRIM(YFOUND)
+ WRITE(*,'(A)' )'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
+ ENDIF
+ CALL ABORT
+ STOP
ENDIF
- ENDIF
- ENDIF
-ENDDO
+ ENDIF
+ ENDIF
+ ENDDO
CLOSE(11)
!
-XRUNTIME = REAL(ITIMERUN)
+ XRUNTIME = REAL(ITIMERUN)
!
-WRITE(*,'(A)' )'-----------------------------'
+ENDIF
+#endif
!
!-------------------------------------------------------------------------------
CONTAINS
diff --git a/src/SURFEX/sfx_oasis_prep.F90 b/src/SURFEX/sfx_oasis_prep.F90
index f57ed1594f33d39eb3ec16ff92314fa3a784a628..a4c8baf4e16bf4607761dd046b32e9c1b6d52d0a 100644
--- a/src/SURFEX/sfx_oasis_prep.F90
+++ b/src/SURFEX/sfx_oasis_prep.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#########
-SUBROUTINE SFX_OASIS_PREP (I, UG, U, &
- HPROGRAM)
+SUBROUTINE SFX_OASIS_PREP (IO, S, UG, U, HPROGRAM, KNPTS, KPARAL)
!###################################################
!
!!**** *SFX_OASIS_PREP* - Prepare grid areas and mask file for SFX-OASIS coupling
@@ -33,24 +32,25 @@ SUBROUTINE SFX_OASIS_PREP (I, UG, U, &
!! MODIFICATIONS
!! -------------
!! Original 10/2013
+!! 10/2016 B. Decharme : bug surface/groundwater coupling
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
-!
-!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
!
USE MODN_SFX_OASIS
USE MODD_SFX_OASIS
!
+USE MODI_GATHER_AND_WRITE_MPI
USE MODI_GET_LUOUT
USE MODI_ABOR1_SFX
USE MODI_GET_MESH_CORNER
@@ -69,40 +69,50 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+INTEGER, INTENT(IN) :: KNPTS ! Number of grid point on this proc
+INTEGER, DIMENSION(:), INTENT(IN) :: KPARAL
!
!* 0.2 Declarations of local parameter
! -------------------------------
!
INTEGER, PARAMETER :: INC = 4 ! Number of grid-cell corners
!
- CHARACTER(LEN=4), PARAMETER :: YSFX_LAND = 'slan'
- CHARACTER(LEN=4), PARAMETER :: YSFX_QSB = 'sdra'
- CHARACTER(LEN=4), PARAMETER :: YSFX_GW = 'sgw '
- CHARACTER(LEN=4), PARAMETER :: YSFX_SEA = 'ssea'
- CHARACTER(LEN=4), PARAMETER :: YSFX_LAKE = 'slak'
+CHARACTER(LEN=4), PARAMETER :: YSFX_LAND = 'slan'
+CHARACTER(LEN=4), PARAMETER :: YSFX_SEA = 'ssea'
+CHARACTER(LEN=4), PARAMETER :: YSFX_LAKE = 'slak'
!
!* 0.3 Declarations of local variables
! -------------------------------
!
-REAL, DIMENSION(U%NDIM_FULL) :: ZGW ! groundwater mask
-REAL, DIMENSION(U%NDIM_FULL) :: ZMASK_LAND ! land-sea mask for rrm coupling
-REAL, DIMENSION(U%NDIM_FULL) :: ZMASK_LAKE ! lake mask for ogcm coupling
-REAL, DIMENSION(U%NDIM_FULL) :: ZMASK_SEA ! sea-land mask for ogcm coupling
+REAL, DIMENSION(U%NSIZE_FULL) :: ZMASK_LAND ! land-sea mask for rrm coupling
+REAL, DIMENSION(U%NSIZE_FULL) :: ZMASK_LAKE ! lake mask for ogcm coupling
+REAL, DIMENSION(U%NSIZE_FULL) :: ZMASK_SEA ! sea-land mask for ogcm coupling
!
-REAL, DIMENSION(U%NDIM_FULL,1) :: ZLON
-REAL, DIMENSION(U%NDIM_FULL,1) :: ZLAT
-REAL, DIMENSION(U%NDIM_FULL,1) :: ZAREA
-INTEGER, DIMENSION(U%NDIM_FULL,1) :: IMASK
+REAL, DIMENSION(U%NSIZE_FULL,1) :: ZLON
+REAL, DIMENSION(U%NSIZE_FULL,1) :: ZLAT
+REAL, DIMENSION(U%NSIZE_FULL,1) :: ZAREA
+INTEGER, DIMENSION(U%NSIZE_FULL,1) :: IMASK
!
-REAL, DIMENSION(U%NDIM_FULL,1,INC) :: ZCORNER_LON
-REAL, DIMENSION(U%NDIM_FULL,1,INC) :: ZCORNER_LAT
+REAL, DIMENSION(U%NSIZE_FULL,1,INC) :: ZCORNER_LON
+REAL, DIMENSION(U%NSIZE_FULL,1,INC) :: ZCORNER_LAT
+!
+REAL, DIMENSION(U%NDIM_FULL) :: ZMASK_LAND_TOT ! land-sea mask for rrm coupling
+REAL, DIMENSION(U%NDIM_FULL) :: ZMASK_LAKE_TOT ! lake mask for ogcm coupling
+REAL, DIMENSION(U%NDIM_FULL) :: ZMASK_SEA_TOT ! sea-land mask for ogcm coupling
+!
+REAL, DIMENSION(U%NDIM_FULL,1) :: ZLON_TOT
+REAL, DIMENSION(U%NDIM_FULL,1) :: ZLAT_TOT
+REAL, DIMENSION(U%NDIM_FULL,1) :: ZAREA_TOT
+INTEGER, DIMENSION(U%NDIM_FULL,1) :: IMASK_TOT
+!
+REAL, DIMENSION(U%NDIM_FULL,1,INC) :: ZCORNER_LON_TOT
+REAL, DIMENSION(U%NDIM_FULL,1,INC) :: ZCORNER_LAT_TOT
!
INTEGER, DIMENSION(2) :: IVAR_SHAPE ! indexes for the coupling field local dimension
!
@@ -127,32 +137,31 @@ IF (LHOOK) CALL DR_HOOK('SFX_OASIS_PREP',0,ZHOOK_HANDLE)
!* 0. Initialize :
! ------------
!
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
+CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
- CALL SFX_OASIS_CHECK(I, U, &
- ILUOUT)
+CALL SFX_OASIS_CHECK(IO, U, ILUOUT)
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. Define parallel partitions:
+! ---------------------------
+!
+CALL OASIS_DEF_PARTITION(IPART_ID,KPARAL(:),IERR)
+!
+IF(IERR/=OASIS_OK)THEN
+ WRITE(ILUOUT,*)'SFX_OASIS_DEFINE: OASIS def partition problem, err = ',IERR
+ CALL ABOR1_SFX('SFX_OASIS_DEFINE: OASIS def partition problem')
+ENDIF
!
!-------------------------------------------------------------------------------
!
!* 2. Get grid definition :
! ---------------------
!
- CALL GET_MESH_CORNER(UG, &
- ILUOUT,ZCORNER_LAT(:,1,:),ZCORNER_LON(:,1,:))
+CALL GET_MESH_CORNER(UG, ILUOUT,ZCORNER_LAT(:,1,:),ZCORNER_LON(:,1,:))
!
-ZLON(:,1)=UG%XLON(:)
-ZLAT(:,1)=UG%XLAT(:)
-!
-IF(LCPL_GW.AND.I%LGW)THEN
- CALL UNPACK_SAME_RANK(U%NR_NATURE(:),I%XGW(:),ZGW(:))
- WHERE(ZGW(:)==XUNDEF)
- ZGW(:)=0.0
- ELSEWHERE(ZGW(:)>0.0)
- ZGW(:)=1.0
- ENDWHERE
-ELSE
- ZGW(:) = 0.0
-ENDIF
+ZLON(:,1)=UG%G%XLON(:)
+ZLAT(:,1)=UG%G%XLAT(:)
!
!-------------------------------------------------------------------------------
!
@@ -177,92 +186,98 @@ ENDIF
!
!
!
- CALL OASIS_START_GRIDS_WRITING(IFLAG)
+IF (NRANK==NPIO) CALL OASIS_START_GRIDS_WRITING(IFLAG)
!
!* 1.1 Grid definition for Land surface :
! ----------------------------------
!
IF(LCPL_LAND)THEN
-!
- ZAREA(:,1) = UG%XMESH_SIZE(:) * ZMASK_LAND(:)
- !0 = not masked ; 1 = masked
- WHERE(ZAREA(:,1)>0.0)
- IMASK(:,1) = 0
- ELSEWHERE
- IMASK(:,1) = 1
- ENDWHERE
- CALL OASIS_WRITE_GRID (YSFX_LAND,U%NDIM_FULL,1,ZLON(:,:),ZLAT(:,:))
- CALL OASIS_WRITE_CORNER(YSFX_LAND,U%NDIM_FULL,1,INC,ZCORNER_LON(:,:,:),ZCORNER_LAT(:,:,:))
- CALL OASIS_WRITE_AREA (YSFX_LAND,U%NDIM_FULL,1,ZAREA(:,:))
- CALL OASIS_WRITE_MASK (YSFX_LAND,U%NDIM_FULL,1,IMASK(:,:))
-!
- ZAREA(:,1) = UG%XMESH_SIZE(:) * ZMASK_LAND(:) * (1.0-ZGW(:))
- !0 = not masked ; 1 = masked
- WHERE(ZAREA(:,1)>0.0)
- IMASK(:,1) = 0
- ELSEWHERE
- IMASK(:,1) = 1
- ENDWHERE
- CALL OASIS_WRITE_GRID (YSFX_QSB,U%NDIM_FULL,1,ZLON(:,:),ZLAT(:,:))
- CALL OASIS_WRITE_CORNER(YSFX_QSB,U%NDIM_FULL,1,INC,ZCORNER_LON(:,:,:),ZCORNER_LAT(:,:,:))
- CALL OASIS_WRITE_AREA (YSFX_QSB,U%NDIM_FULL,1,ZAREA(:,:))
- CALL OASIS_WRITE_MASK (YSFX_QSB,U%NDIM_FULL,1,IMASK(:,:))
-!
-ENDIF
-!
-! groundwater surface coupling case
-!
-IF(LCPL_GW)THEN
- ZAREA(:,1) = UG%XMESH_SIZE(:) * ZGW(:)
+ !
+ ZAREA(:,1) = UG%G%XMESH_SIZE(:) * ZMASK_LAND(:)
!0 = not masked ; 1 = masked
WHERE(ZAREA(:,1)>0.0)
IMASK(:,1) = 0
ELSEWHERE
IMASK(:,1) = 1
ENDWHERE
- CALL OASIS_WRITE_GRID (YSFX_GW,U%NDIM_FULL,1,ZLON(:,:),ZLAT(:,:))
- CALL OASIS_WRITE_CORNER(YSFX_GW,U%NDIM_FULL,1,INC,ZCORNER_LON(:,:,:),ZCORNER_LAT(:,:,:))
- CALL OASIS_WRITE_AREA (YSFX_GW,U%NDIM_FULL,1,ZAREA(:,:))
- CALL OASIS_WRITE_MASK (YSFX_GW,U%NDIM_FULL,1,IMASK(:,:))
+ !
+ CALL GATHER_AND_WRITE_MPI(ZLON,ZLON_TOT)
+ CALL GATHER_AND_WRITE_MPI(ZLAT,ZLAT_TOT)
+ CALL GATHER_AND_WRITE_MPI(ZCORNER_LON,ZCORNER_LON_TOT)
+ CALL GATHER_AND_WRITE_MPI(ZCORNER_LAT,ZCORNER_LAT_TOT)
+ CALL GATHER_AND_WRITE_MPI(ZAREA,ZAREA_TOT)
+ CALL GATHER_AND_WRITE_MPI(IMASK,IMASK_TOT)
+ !
+ IF (NRANK==NPIO) THEN
+ CALL OASIS_WRITE_GRID (YSFX_LAND,U%NDIM_FULL,1,ZLON_TOT(:,:),ZLAT_TOT(:,:))
+ CALL OASIS_WRITE_CORNER(YSFX_LAND,U%NDIM_FULL,1,INC,ZCORNER_LON_TOT(:,:,:),ZCORNER_LAT_TOT(:,:,:))
+ CALL OASIS_WRITE_AREA (YSFX_LAND,U%NDIM_FULL,1,ZAREA_TOT(:,:))
+ CALL OASIS_WRITE_MASK (YSFX_LAND,U%NDIM_FULL,1,IMASK_TOT(:,:))
+ ENDIF
+ !
ENDIF
!
!* 1.2 Grid definition for lake surface :
! ----------------------------------
!
IF(LCPL_LAKE)THEN
- ZAREA(:,1) = UG%XMESH_SIZE(:) * ZMASK_LAKE(:)
+ !
+ ZAREA(:,1) = UG%G%XMESH_SIZE(:) * ZMASK_LAKE(:)
!0 = not masked ; 1 = masked
WHERE(ZAREA(:,1)>0.0)
IMASK(:,1) = 0
ELSEWHERE
IMASK(:,1) = 1
ENDWHERE
- CALL OASIS_WRITE_GRID (YSFX_LAKE,U%NDIM_FULL,1,ZLON(:,:),ZLAT(:,:))
- CALL OASIS_WRITE_CORNER(YSFX_LAKE,U%NDIM_FULL,1,INC,ZCORNER_LON(:,:,:),ZCORNER_LAT(:,:,:))
- CALL OASIS_WRITE_AREA (YSFX_LAKE,U%NDIM_FULL,1,ZAREA(:,:))
- CALL OASIS_WRITE_MASK (YSFX_LAKE,U%NDIM_FULL,1,IMASK(:,:))
+ !
+ CALL GATHER_AND_WRITE_MPI(ZLON,ZLON_TOT)
+ CALL GATHER_AND_WRITE_MPI(ZLAT,ZLAT_TOT)
+ CALL GATHER_AND_WRITE_MPI(ZCORNER_LON,ZCORNER_LON_TOT)
+ CALL GATHER_AND_WRITE_MPI(ZCORNER_LAT,ZCORNER_LAT_TOT)
+ CALL GATHER_AND_WRITE_MPI(ZAREA,ZAREA_TOT)
+ CALL GATHER_AND_WRITE_MPI(IMASK,IMASK_TOT)
+ !
+ IF (NRANK==NPIO) THEN
+ CALL OASIS_WRITE_GRID (YSFX_LAKE,U%NDIM_FULL,1,ZLON_TOT(:,:),ZLAT_TOT(:,:))
+ CALL OASIS_WRITE_CORNER(YSFX_LAKE,U%NDIM_FULL,1,INC,ZCORNER_LON_TOT(:,:,:),ZCORNER_LAT_TOT(:,:,:))
+ CALL OASIS_WRITE_AREA (YSFX_LAKE,U%NDIM_FULL,1,ZAREA_TOT(:,:))
+ CALL OASIS_WRITE_MASK (YSFX_LAKE,U%NDIM_FULL,1,IMASK_TOT(:,:))
+ ENDIF
+ !
ENDIF
!
!* 1.3 Grid definition for sea/water :
! -------------------------------
!
IF(LCPL_SEA)THEN
- ZAREA(:,1) = UG%XMESH_SIZE(:) * ZMASK_SEA(:)
+ !
+ ZAREA(:,1) = UG%G%XMESH_SIZE(:) * ZMASK_SEA(:)
!0 = not masked ; 1 = masked
WHERE(ZAREA(:,1)>0.0)
IMASK(:,1) = 0
ELSEWHERE
IMASK(:,1) = 1
ENDWHERE
- CALL OASIS_WRITE_GRID (YSFX_SEA,U%NDIM_FULL,1,ZLON(:,:),ZLAT(:,:))
- CALL OASIS_WRITE_CORNER(YSFX_SEA,U%NDIM_FULL,1,INC,ZCORNER_LON(:,:,:),ZCORNER_LAT(:,:,:))
- CALL OASIS_WRITE_AREA (YSFX_SEA,U%NDIM_FULL,1,ZAREA(:,:))
- CALL OASIS_WRITE_MASK (YSFX_SEA,U%NDIM_FULL,1,IMASK(:,:))
+ !
+ CALL GATHER_AND_WRITE_MPI(ZLON,ZLON_TOT)
+ CALL GATHER_AND_WRITE_MPI(ZLAT,ZLAT_TOT)
+ CALL GATHER_AND_WRITE_MPI(ZCORNER_LON,ZCORNER_LON_TOT)
+ CALL GATHER_AND_WRITE_MPI(ZCORNER_LAT,ZCORNER_LAT_TOT)
+ CALL GATHER_AND_WRITE_MPI(ZAREA,ZAREA_TOT)
+ CALL GATHER_AND_WRITE_MPI(IMASK,IMASK_TOT)
+ !
+ IF (NRANK==NPIO) THEN
+ CALL OASIS_WRITE_GRID (YSFX_SEA,U%NDIM_FULL,1,ZLON_TOT(:,:),ZLAT_TOT(:,:))
+ CALL OASIS_WRITE_CORNER(YSFX_SEA,U%NDIM_FULL,1,INC,ZCORNER_LON_TOT(:,:,:),ZCORNER_LAT_TOT(:,:,:))
+ CALL OASIS_WRITE_AREA (YSFX_SEA,U%NDIM_FULL,1,ZAREA_TOT(:,:))
+ CALL OASIS_WRITE_MASK (YSFX_SEA,U%NDIM_FULL,1,IMASK_TOT(:,:))
+ ENDIF
+ !
ENDIF
!
- CALL OASIS_TERMINATE_GRIDS_WRITING()
+IF (NRANK==NPIO) CALL OASIS_TERMINATE_GRIDS_WRITING()
!
- CALL OASIS_ENDDEF(IERR)
+CALL OASIS_ENDDEF(IERR)
!
IF(IERR/=OASIS_OK)THEN
WRITE(ILUOUT,*)'SFX_OASIS_PREP: OASIS enddef problem, err = ',IERR
diff --git a/src/SURFEX/sfx_oasis_read_nam.F90 b/src/SURFEX/sfx_oasis_read_nam.F90
index 35f88c5cbbe446aa519bab37666744a0fd62e248..41346a2378f6dcc7f3904b3d1372591e4fc6d85d 100644
--- a/src/SURFEX/sfx_oasis_read_nam.F90
+++ b/src/SURFEX/sfx_oasis_read_nam.F90
@@ -32,6 +32,7 @@ SUBROUTINE SFX_OASIS_READ_NAM(HPROGRAM,PTSTEP_SURF,HINIT)
!! MODIFICATIONS
!! -------------
!! Original 05/2008
+!! 10/2016 B. Decharme : bug surface/groundwater coupling
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -60,18 +61,18 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
REAL, INTENT(IN) :: PTSTEP_SURF ! Surfex time step
- CHARACTER(LEN=3), INTENT(IN), OPTIONAL :: HINIT ! choice of fields to initialize
+CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HINIT ! choice of fields to initialize
!
!* 0.2 Declarations of local parameter
! -------------------------------
!
INTEGER, PARAMETER :: KIN = 1
INTEGER, PARAMETER :: KOUT = 0
- CHARACTER(LEN=5), PARAMETER :: YLAND = 'land'
- CHARACTER(LEN=5), PARAMETER :: YLAKE = 'lake'
- CHARACTER(LEN=5), PARAMETER :: YSEA = 'ocean'
+CHARACTER(LEN=5), PARAMETER :: YLAND = 'land'
+CHARACTER(LEN=5), PARAMETER :: YLAKE = 'lake'
+CHARACTER(LEN=5), PARAMETER :: YSEA = 'ocean'
!
!* 0.3 Declarations of local variables
! -------------------------------
@@ -79,9 +80,9 @@ INTEGER, PARAMETER :: KOUT = 0
LOGICAL :: GFOUND ! Return code when searching namelist
INTEGER :: ILUOUT ! Listing id
INTEGER :: ILUNAM ! logical unit of namelist file
- CHARACTER(LEN=20) :: YKEY
- CHARACTER(LEN=50) :: YCOMMENT
- CHARACTER(LEN=3) :: YINIT
+CHARACTER(LEN=20) :: YKEY
+CHARACTER(LEN=50) :: YCOMMENT
+CHARACTER(LEN=3) :: YINIT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -109,14 +110,14 @@ ENDIF
YINIT = 'ALL'
IF(PRESENT(HINIT))YINIT=HINIT
!
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
+CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
!* 1. Read namelists and check status :
! --------------------------------
!
- CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
+CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
!
- CALL POSNAM(ILUNAM,'NAM_SFX_LAND_CPL',GFOUND,ILUOUT)
+CALL POSNAM(ILUNAM,'NAM_SFX_LAND_CPL',GFOUND,ILUOUT)
!
IF (GFOUND) THEN
READ(UNIT=ILUNAM,NML=NAM_SFX_LAND_CPL)
@@ -128,7 +129,7 @@ ELSE
WRITE(ILUOUT,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
ENDIF
!
- CALL POSNAM(ILUNAM,'NAM_SFX_SEA_CPL',GFOUND,ILUOUT)
+CALL POSNAM(ILUNAM,'NAM_SFX_SEA_CPL',GFOUND,ILUOUT)
!
IF (GFOUND) THEN
READ(UNIT=ILUNAM,NML=NAM_SFX_SEA_CPL)
@@ -140,7 +141,7 @@ ELSE
WRITE(ILUOUT,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
ENDIF
!
- CALL POSNAM(ILUNAM,'NAM_SFX_LAKE_CPL',GFOUND,ILUOUT)
+CALL POSNAM(ILUNAM,'NAM_SFX_LAKE_CPL',GFOUND,ILUOUT)
!
IF (GFOUND) THEN
READ(UNIT=ILUNAM,NML=NAM_SFX_LAKE_CPL)
@@ -152,7 +153,7 @@ ELSE
WRITE(ILUOUT,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
ENDIF
!
- CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
+CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
!
IF(XTSTEP_CPL_LAND>0.0)LCPL_LAND=.TRUE.
IF(XTSTEP_CPL_LAKE>0.0)LCPL_LAKE=.TRUE.
@@ -216,18 +217,12 @@ IF(LCPL_LAND)THEN
!
! Particular case due to water table depth / surface coupling
!
- IF(LEN_TRIM(CWTD)>0.OR.LEN_TRIM(CFWTD)>0.OR.LEN_TRIM(CRECHARGE)>0)THEN
+ IF(LEN_TRIM(CWTD)>0.OR.LEN_TRIM(CFWTD)>0)THEN
LCPL_GW = .TRUE.
ENDIF
!
IF(LCPL_GW)THEN
!
-! Output variable
-!
- YKEY ='CRECHARGE'
- YCOMMENT='Groundwater recharge'
- CALL CHECK_FIELD(CRECHARGE,YKEY,YCOMMENT,YLAND,KOUT)
-!
! Input variable
!
YKEY ='CWTD'
@@ -423,23 +418,23 @@ ENDIF
IF (LHOOK) CALL DR_HOOK('SFX_OASIS_READ_NAM',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
!
SUBROUTINE CHECK_FIELD(HFIELD,HKEY,HCOMMENT,HTYP,KID)
!
IMPLICIT NONE
!
- CHARACTER(LEN=*), INTENT(IN) :: HFIELD
- CHARACTER(LEN=*), INTENT(IN) :: HKEY
- CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT
- CHARACTER(LEN=*), INTENT(IN) :: HTYP
+CHARACTER(LEN=*), INTENT(IN) :: HFIELD
+CHARACTER(LEN=*), INTENT(IN) :: HKEY
+CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT
+CHARACTER(LEN=*), INTENT(IN) :: HTYP
INTEGER, INTENT(IN) :: KID
!
- CHARACTER(LEN=20) :: YWORK
- CHARACTER(LEN=20) :: YNAMELIST
- CHARACTER(LEN=128) :: YCOMMENT1
- CHARACTER(LEN=128) :: YCOMMENT2
+CHARACTER(LEN=20) :: YWORK
+CHARACTER(LEN=20) :: YNAMELIST
+CHARACTER(LEN=128) :: YCOMMENT1
+CHARACTER(LEN=128) :: YCOMMENT2
LOGICAL :: LSTOP
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
diff --git a/src/SURFEX/sfx_oasis_recv.F90 b/src/SURFEX/sfx_oasis_recv.F90
index f2c06e6f45859045a45bd5995e5dc8eded292da7..124cb30850b055279085f5ea2343da275ebce010 100644
--- a/src/SURFEX/sfx_oasis_recv.F90
+++ b/src/SURFEX/sfx_oasis_recv.F90
@@ -6,7 +6,7 @@
SUBROUTINE SFX_OASIS_RECV(HPROGRAM,KI,KSW,PTIMEC, &
ORECV_LAND, ORECV_SEA, &
PLAND_WTD,PLAND_FWTD, &
- PLAND_FFLOOD,PLAND_PIFLOOD, &
+ PLAND_FFLOOD, PLAND_PIFLOOD, &
PSEA_SST,PSEA_UCU,PSEA_VCU, &
PSEAICE_SIT,PSEAICE_CVR,PSEAICE_ALB )
!########################################
@@ -46,8 +46,6 @@ USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE MODD_SFX_OASIS
!
-USE MODD_SGH_PAR, ONLY :
-!
USE MODI_GET_LUOUT
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -62,7 +60,7 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
- CHARACTER(LEN=*), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+CHARACTER(LEN=*), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
INTEGER, INTENT(IN) :: KI ! number of points on this proc
INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands
REAL, INTENT(IN) :: PTIMEC ! Cumulated run time step (s)
@@ -92,7 +90,7 @@ REAL, DIMENSION(KI,1) :: ZREAD
INTEGER :: IDATE ! current coupling time step (s)
INTEGER :: IERR ! Error info
INTEGER :: ILUOUT
- CHARACTER(LEN=50) :: YCOMMENT
+CHARACTER(LEN=50) :: YCOMMENT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -105,7 +103,7 @@ IF (LHOOK) CALL DR_HOOK('SFX_OASIS_RECV',0,ZHOOK_HANDLE)
!* 1. Initialize :
! ------------
!
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
+CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
IDATE = INT(PTIMEC)
!
@@ -221,7 +219,7 @@ ENDIF
IF (LHOOK) CALL DR_HOOK('SFX_OASIS_RECV',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
!
SUBROUTINE CHECK_RECV(KLUOUT,KERR,HCOMMENT)
@@ -232,7 +230,7 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KLUOUT
INTEGER, INTENT(IN) :: KERR
- CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT
+CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
diff --git a/src/SURFEX/sfx_oasis_send.F90 b/src/SURFEX/sfx_oasis_send.F90
index 8fe020c113f8915613e19c688f86a791accb991f..c1982c5d8710156055801198121d4eb0ae19556b 100644
--- a/src/SURFEX/sfx_oasis_send.F90
+++ b/src/SURFEX/sfx_oasis_send.F90
@@ -4,7 +4,7 @@
!SFX_LIC for details. version 1.
!#########
SUBROUTINE SFX_OASIS_SEND(KLUOUT,KI,KDATE,OSEND_LAND,OSEND_LAKE,OSEND_SEA, &
- PLAND_RUNOFF,PLAND_DRAIN,PLAND_CALVING,PLAND_RECHARGE,&
+ PLAND_RUNOFF,PLAND_DRAIN,PLAND_CALVING, &
PLAND_SRCFLOOD, &
PLAKE_EVAP,PLAKE_RAIN,PLAKE_SNOW,PLAKE_WATF, &
PSEA_FWSU,PSEA_FWSV,PSEA_HEAT,PSEA_SNET,PSEA_WIND, &
@@ -42,6 +42,7 @@ SUBROUTINE SFX_OASIS_SEND(KLUOUT,KI,KDATE,OSEND_LAND,OSEND_LAKE,OSEND_SEA,
!! MODIFICATIONS
!! -------------
!! Original 10/2013
+!! 10/2016 B. Decharme : bug surface/groundwater coupling
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -78,7 +79,6 @@ LOGICAL, INTENT(IN) :: OSEND_SEA
REAL, DIMENSION(KI), INTENT(IN) :: PLAND_RUNOFF ! Cumulated Surface runoff (kg/m2)
REAL, DIMENSION(KI), INTENT(IN) :: PLAND_DRAIN ! Cumulated Deep drainage (kg/m2)
REAL, DIMENSION(KI), INTENT(IN) :: PLAND_CALVING ! Cumulated Calving flux (kg/m2)
-REAL, DIMENSION(KI), INTENT(IN) :: PLAND_RECHARGE ! Cumulated Recharge to groundwater (kg/m2)
REAL, DIMENSION(KI), INTENT(IN) :: PLAND_SRCFLOOD ! Cumulated flood freshwater flux (kg/m2)
!
REAL, DIMENSION(KI), INTENT(IN) :: PLAKE_EVAP ! Cumulated Evaporation (kg/m2)
@@ -106,7 +106,7 @@ REAL, DIMENSION(KI), INTENT(IN) :: PSEAICE_EVAP ! Cumulated Sea-ice sublimation
!
REAL, DIMENSION(KI,1) :: ZWRITE ! Mean flux send to OASIS (Pa, m/s, W/m2 or kg/m2/s)
!
- CHARACTER(LEN=50) :: YCOMMENT
+CHARACTER(LEN=50) :: YCOMMENT
INTEGER :: IERR ! Error info
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -147,13 +147,6 @@ IF(OSEND_LAND)THEN
CALL OASIS_PUT(NCALVING_ID,KDATE,ZWRITE(:,:),IERR)
CALL CHECK_SFX_SEND(KLUOUT,IERR,YCOMMENT,ZWRITE(:,1))
ENDIF
-!
- IF(LCPL_GW)THEN
- YCOMMENT='groundwater recharge over land'
- CALL OUTVAR(PLAND_RECHARGE,XTSTEP_CPL_LAND,ZWRITE(:,1))
- CALL OASIS_PUT(NRECHARGE_ID,KDATE,ZWRITE(:,:),IERR)
- CALL CHECK_SFX_SEND(KLUOUT,IERR,YCOMMENT,ZWRITE(:,1))
- ENDIF
!
IF(LCPL_FLOOD)THEN
YCOMMENT='flood freshwater flux over land (P-E-I)'
@@ -314,7 +307,7 @@ ENDIF
IF (LHOOK) CALL DR_HOOK('SFX_OASIS_SEND',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
!
SUBROUTINE CHECK_SFX_SEND(KLUOUT,KERR,HCOMMENT,PWRITE)
@@ -325,7 +318,7 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KLUOUT
INTEGER, INTENT(IN) :: KERR
- CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT
+CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT
!
REAL, DIMENSION(:), INTENT(OUT):: PWRITE
!
diff --git a/src/SURFEX/sfx_xios_check_field.F90 b/src/SURFEX/sfx_xios_check_field.F90
new file mode 100644
index 0000000000000000000000000000000000000000..3eab1eee3e95d55cc709bc9171c89da0f5f0ca8e
--- /dev/null
+++ b/src/SURFEX/sfx_xios_check_field.F90
@@ -0,0 +1,256 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+SUBROUTINE SFX_XIOS_CHECK_FIELD(U, HREC, HCOMMENT, OWRITE, PFIELD1, PFIELD2, PFIELD3, HAXIS)
+!!
+!!
+!! PURPOSE
+!! --------
+!!
+!! Ensure that a field is already declared to Xios.
+!! If not, declare it using HREC, and declare it in a default
+!! output file if this file is enabled ;
+!! If 'units' or 'name' attribute is not defined using XIOS config
+!! files , use HCOMMENT to declare it
+!!
+!! IMPLICIT ARGUMENTS :
+!! --------------------
+!!
+!! YXIOS_DOMAIN
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! XIOS LIBRARY
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! XIOS Reference guide - Yann Meurdesoif - 10/10/2014 -
+!! svn co -r 515 http://forge.ipsl.jussieu.fr/ioserver/svn/XIOS/branchs/xios-1.0 <dir>
+!! cd <dir>/doc ; ....
+!!
+!! AUTHOR
+!! ------
+!!
+!! S.Sénési, CNRM
+!!
+!! MODIFICATION
+!! --------------
+!!
+!! Original 08/2015
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_XIOS, ONLY : YXIOS_DOMAIN, LXIOS_DEF_CLOSED, COUTPUT_DEFAULT
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE PARKIND1 , ONLY : JPRB
+!
+#ifdef WXIOS
+USE XIOS, ONLY : XIOS_FIELD, XIOS_FIELDGROUP, XIOS_FILE, XIOS_GET_HANDLE,&
+ XIOS_ADD_CHILD, XIOS_SET_ATTR, XIOS_IS_DEFINED_FIELD_ATTR, XIOS_SET_FIELD_ATTR, &
+ XIOS_GET_FILE_ATTR, XIOS_IS_VALID_FILE, XIOS_IS_VALID_FIELD, XIOS_IS_VALID_AXIS, &
+ XIOS_IS_DEFINED_FILE_ATTR
+#endif
+!
+USE MODI_SFX_XIOS_CHECK_FIELD_2D
+USE MODI_ABOR1_SFX
+!
+IMPLICIT NONE
+!
+! Arguments
+!
+TYPE(SURF_ATM_t) , INTENT(INOUT) :: U
+CHARACTER(LEN=*) ,INTENT(IN) :: HREC ! name of the field to check
+CHARACTER(LEN=100) ,INTENT(IN) :: HCOMMENT ! Comment string
+LOGICAL ,INTENT(OUT):: OWRITE ! TRUE if no issue re. Xios for this field
+REAL,DIMENSION(:) ,INTENT(IN) , OPTIONAL :: PFIELD1 ! value
+REAL,DIMENSION(:,:) ,INTENT(IN) , OPTIONAL :: PFIELD2 ! value
+REAL,DIMENSION(:,:,:) ,INTENT(IN) , OPTIONAL :: PFIELD3 ! value
+CHARACTER(LEN=*) ,INTENT(IN) , OPTIONAL :: HAXIS ! name of the additional axis
+!
+! Local variables
+!
+LOGICAL :: LISDEF, LLWRITE
+INTEGER :: IPO,IPF
+INTEGER :: KSIZE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+#ifdef WXIOS
+TYPE(xios_field) :: field_hdl, other_field_hdl
+TYPE(xios_fieldgroup) :: fieldgroup_hdl
+TYPE(xios_file) :: file_hdl
+#endif
+!
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_CHECK_FIELD',0,ZHOOK_HANDLE)
+!
+#ifdef WXIOS
+!
+OWRITE=.TRUE.
+!
+! ----------------------------------------------------------------------
+! If field is 3D , just give up
+! ----------------------------------------------------------------------
+!
+IF (PRESENT(PFIELD3)) THEN
+ CALL ABOR1_SFX('THIS XIOS INTERFACE CANNOT YET HANDLE 2 AXES IN ADDITION TO HORIZONTAL SPACE AXES')
+ENDIF
+!
+! ----------------------------------------------------------------------
+! Check consistency between field size and current domain size
+! ----------------------------------------------------------------------
+!
+IF ((PRESENT(PFIELD1)) .OR. (PRESENT(PFIELD2)) .OR. (PRESENT(PFIELD3)) ) THEN
+ IF (PRESENT(PFIELD1)) KSIZE=SIZE(PFIELD1)
+ IF (PRESENT(PFIELD2)) KSIZE=SIZE(PFIELD2,1)
+ IF (PRESENT(PFIELD3)) KSIZE=SIZE(PFIELD3,1)
+ IF ((YXIOS_DOMAIN=='FULL' ) .AND. (KSIZE /= U%NSIZE_FULL )) OWRITE=.FALSE.
+ IF ((YXIOS_DOMAIN=='NATURE') .AND. (KSIZE /= U%NSIZE_NATURE)) OWRITE=.FALSE.
+ IF ((YXIOS_DOMAIN=='SEA ') .AND. (KSIZE /= U%NSIZE_SEA )) OWRITE=.FALSE.
+ IF ((YXIOS_DOMAIN=='WATER ') .AND. (KSIZE /= U%NSIZE_WATER )) OWRITE=.FALSE.
+ IF ((YXIOS_DOMAIN=='TOWN ') .AND. (KSIZE /= U%NSIZE_TOWN )) OWRITE=.FALSE.
+ IF (.NOT. OWRITE) THEN
+ IF (.NOT. LXIOS_DEF_CLOSED) THEN
+ CALL ABOR1_SFX('SFX_XIOS_CHECK_FIELD : Inconsistent size for field '//HREC//' on domain '//YXIOS_DOMAIN)
+ ENDIF
+ IF (LHOOK) CALL DR_HOOK('SFX_XIOS_CHECK_FIELD',1,ZHOOK_HANDLE)
+ RETURN
+ ENDIF
+ENDIF
+!
+! ----------------------------------------------------------------------
+! If XIOS init phase is over, just check if field is known to XIOS
+! and returns
+! ----------------------------------------------------------------------
+!
+IF (LXIOS_DEF_CLOSED) THEN
+!$OMP SINGLE
+ OWRITE=XIOS_IS_VALID_FIELD(HREC)
+!$OMP END SINGLE
+ IF (LHOOK) CALL DR_HOOK('SFX_XIOS_CHECK_FIELD',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
+!
+!$OMP SINGLE
+!
+! ----------------------------------------------------------------------
+! We are still in the XIOS init phase => Define field if necessary
+! ----------------------------------------------------------------------
+!
+OWRITE=.FALSE.
+IF (.NOT. XIOS_IS_VALID_FIELD(HREC)) THEN
+ CALL XIOS_GET_HANDLE("field_definition",fieldgroup_hdl)
+ CALL XIOS_ADD_CHILD(fieldgroup_hdl,field_hdl,HREC)
+ ! Inherit default values from 'default_field'
+ IF (.NOT. XIOS_IS_VALID_FIELD("default_field")) &
+ CALL ABOR1_SFX('sfx_xios_check_field:cannot output field '//HREC//' : no default_field is defined')
+ ! With XIOS2, next call creates an issue
+ ! CALL XIOS_SET_ATTR(field_hdl,field_ref="default_field",name=HREC)
+ CALL XIOS_SET_ATTR(field_hdl,name=HREC)
+ !
+ELSE
+ CALL XIOS_GET_HANDLE(HREC,field_hdl)
+ENDIF
+!
+! ----------------------------------------------------------------------
+! If field enabling is not defined, set it to TRUE
+! ----------------------------------------------------------------------
+!
+CALL XIOS_IS_DEFINED_FIELD_ATTR(HREC,enabled=LISDEF)
+IF ( .NOT. LISDEF ) CALL XIOS_SET_FIELD_ATTR(HREC, enabled=.TRUE.)
+!
+! ----------------------------------------------------------------------
+! If field attribute 'domain' is not defined, set it
+! ----------------------------------------------------------------------
+!
+CALL XIOS_IS_DEFINED_FIELD_ATTR(HREC,domain_ref=LISDEF)
+IF ( .NOT. LISDEF ) THEN
+ CALL XIOS_SET_FIELD_ATTR(HREC, domain_ref=YXIOS_DOMAIN)
+ENDIF
+!
+! ----------------------------------------------------------------------
+! 2d fields are a special case, and may lead to (implicit) recursion
+! ----------------------------------------------------------------------
+!
+IF (PRESENT(PFIELD2)) THEN
+ IF (PRESENT(HAXIS)) THEN
+ CALL SFX_XIOS_CHECK_FIELD_2D(U, HREC, HCOMMENT, OWRITE, PFIELD2, HAXIS)
+ ELSE
+ CALL SFX_XIOS_CHECK_FIELD_2D(U, HREC, HCOMMENT, OWRITE, PFIELD2)
+ ENDIF
+ENDIF
+!
+! ----------------------------------------------------------------------
+! If NetCDF variable name is not defined , set it
+! ----------------------------------------------------------------------
+!
+CALL XIOS_IS_DEFINED_FIELD_ATTR(HREC,name=LISDEF)
+IF ( .NOT. LISDEF ) THEN
+ CALL XIOS_SET_FIELD_ATTR(HREC, name=HREC)
+ENDIF
+!
+! ----------------------------------------------------------------------
+! If field attribute 'long_name' is not defined or empty, set it
+! ----------------------------------------------------------------------
+!
+CALL XIOS_IS_DEFINED_FIELD_ATTR(HREC,long_name=LISDEF)
+IF ( .NOT. LISDEF .AND. (TRIM(HCOMMENT) /= '') ) THEN
+ CALL XIOS_SET_FIELD_ATTR(HREC,long_name=TRIM(HCOMMENT))
+ENDIF
+!
+!
+! ------------------------------------------------------------------------
+! If field attribute 'units' is not defined or empty, try to guess a value
+! from HCOMMENT (using rightmost string between parenthesis)
+! ------------------------------------------------------------------------
+!
+CALL XIOS_IS_DEFINED_FIELD_ATTR(HREC,unit=LISDEF)
+IF ( .NOT. LISDEF ) THEN
+ IPO=INDEX(HCOMMENT,"(",.TRUE.)
+ IPF=INDEX(HCOMMENT,")",.TRUE.)
+ IF ( (IPO > 0) .AND. (IPF>IPO+1) ) THEN
+ CALL XIOS_SET_FIELD_ATTR(HREC,unit=HCOMMENT(IPO+1:IPF-1))
+ ENDIF
+ENDIF
+!
+
+! ----------------------------------------------------------------------
+! Set default value to Surfex's one
+! ----------------------------------------------------------------------
+!
+CALL XIOS_SET_FIELD_ATTR(HREC,default_value=XUNDEF)
+!
+! ----------------------------------------------------------------------
+! If file 'default_ouput is enabled, add field to it
+! ----------------------------------------------------------------------
+!
+IF ( XIOS_IS_VALID_FILE(COUTPUT_DEFAULT)) THEN
+ CALL XIOS_GET_HANDLE(COUTPUT_DEFAULT,file_hdl)
+ CALL XIOS_IS_DEFINED_FILE_ATTR(COUTPUT_DEFAULT,enabled=LISDEF)
+ IF (LISDEF ) CALL XIOS_GET_FILE_ATTR(COUTPUT_DEFAULT,enabled=LISDEF)
+ IF (LISDEF) THEN
+ CALL XIOS_ADD_CHILD(file_hdl,field_hdl)
+ CALL XIOS_SET_ATTR(field_hdl,field_ref=HREC)
+ ENDIF
+ELSE
+ CALL ABOR1_SFX('sfx_xios_check_field : cannot output field '//HREC//' : no default_output file is defined')
+ENDIF
+!
+!
+!$OMP END SINGLE
+#else
+OWRITE=.FALSE.
+#endif
+!
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_CHECK_FIELD',1,ZHOOK_HANDLE)
+! ----------------------------------------------------------------------
+!
+END SUBROUTINE SFX_XIOS_CHECK_FIELD
diff --git a/src/SURFEX/sfx_xios_check_field_2d.F90 b/src/SURFEX/sfx_xios_check_field_2d.F90
new file mode 100644
index 0000000000000000000000000000000000000000..d8d5f50249e822c7a6eeb45154cd3c883f34d636
--- /dev/null
+++ b/src/SURFEX/sfx_xios_check_field_2d.F90
@@ -0,0 +1,132 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+ SUBROUTINE SFX_XIOS_CHECK_FIELD_2D(U, HREC, HCOMMENT, OWRITE, PFIELD2, HAXIS)
+!!
+!!
+!! PURPOSE
+!! --------
+!!
+!! Ensure that a 2-dim field is already declared to Xios.
+!!
+!!
+!! IMPLICIT ARGUMENTS :
+!! --------------------
+!!
+!! YXIOS_DOMAIN
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! XIOS LIBRARY
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! XIOS Reference guide - Yann Meurdesoif - 10/10/2014 -
+!! svn co -r 515 http://forge.ipsl.jussieu.fr/ioserver/svn/XIOS/branchs/xios-1.0 <dir>
+!! cd <dir>/doc ; ....
+!!
+!! AUTHOR
+!! ------
+!!
+!! S.Sénési, CNRM
+!!
+!! MODIFICATION
+!! --------------
+!!
+!! Original 08/2015
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE PARKIND1 , ONLY : JPRB
+!
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+!
+#ifdef WXIOS
+USE XIOS, ONLY : XIOS_SET_FIELD_ATTR, XIOS_IS_DEFINED_FIELD_ATTR, &
+ XIOS_IS_VALID_AXIS, XIOS_GET_AXIS_ATTR, XIOS_IS_DEFINED_AXIS_ATTR
+USE MODD_XIOS , ONLY : YPATCH_DIM_NAME
+#endif
+!
+USE MODI_SET_AXIS
+USE MODI_SFX_XIOS_CHECK_FIELD
+USE MODI_ABOR1_SFX
+!
+IMPLICIT NONE
+!
+! Arguments
+!
+TYPE(SURF_ATM_t) ,INTENT(INOUT):: U
+CHARACTER(LEN=*) ,INTENT(IN) :: HREC ! name of the field to check
+CHARACTER(LEN=100) ,INTENT(IN) :: HCOMMENT ! Comment string
+LOGICAL ,INTENT(INOUT):: OWRITE ! set to .FALSE. if any issue re. Xios for this field
+REAL,DIMENSION(:,:) ,INTENT(IN) :: PFIELD2 ! 2D field value
+CHARACTER(LEN=*) ,INTENT(IN) , OPTIONAL :: HAXIS ! name of the additional axis
+!
+! Local variables
+!
+LOGICAL :: LISDEF, LLWRITE, LDEFUNITS
+LOGICAL :: LVALID_AXIS, LVERTICAL_AXIS
+CHARACTER(LEN=100) :: YAXIS
+CHARACTER(LEN=100) :: YUNITS
+REAL(KIND=JPRB), DIMENSION(:),ALLOCATABLE :: ZAXIS
+INTEGER :: IDIM ! for additonal dim
+CHARACTER(LEN=3) :: YIDIM ! for additonal dim
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_CHECK_FIELD_2D',0,ZHOOK_HANDLE)
+!
+#ifdef WXIOS
+!$OMP SINGLE
+!
+! Assume that every axis attribute is well defined as soon as the axis is defined
+CALL XIOS_IS_DEFINED_FIELD_ATTR(HREC,axis_ref=LISDEF)
+!
+IF ( .NOT. LISDEF ) THEN
+ IF (.NOT. PRESENT(HAXIS) .OR. (TRIM(HAXIS)=='')) THEN
+ YAXIS='you_should_define_a_dim_for_'//HREC//'_in_xml_file_or_call_set_axis_in_code'
+ ELSE
+ YAXIS=TRIM(HAXIS)
+ ENDIF
+ LVALID_AXIS=XIOS_IS_VALID_AXIS(YAXIS)
+ !
+ IF (TRIM(HAXIS)/=TRIM(YPATCH_DIM_NAME)) THEN
+ IF (.NOT. LVALID_AXIS) THEN
+ ALLOCATE(ZAXIS(SIZE(PFIELD2,2)))
+ ZAXIS=(/(IDIM, IDIM=1,SIZE(PFIELD2,2))/)
+ CALL SET_AXIS(YAXIS,ZAXIS)
+ DEALLOCATE(ZAXIS)
+ ELSE
+ ! xxx il faut encore vérifier si le set_axis_attr des valeurs a été fait pour ce champ !!
+ ENDIF
+ CALL XIOS_SET_FIELD_ATTR(HREC, axis_ref=YAXIS)
+ ELSE
+ ! Account for loop on pacthes
+ DO IDIM=1,SIZE(PFIELD2,2)
+ IF (IDIM < 10) THEN
+ WRITE(YIDIM,'(I1)') IDIM
+ ELSE
+ WRITE(YIDIM,'(I2)') IDIM
+ ENDIF
+ CALL SFX_XIOS_CHECK_FIELD(U, TRIM(HREC)//'_'//TRIM(YIDIM), HCOMMENT, LLWRITE, PFIELD1=PFIELD2(:,IDIM))
+ OWRITE= OWRITE .AND. LLWRITE
+ END DO
+ ! Disable the writing as a mutli-dim array
+ CALL XIOS_SET_FIELD_ATTR(HREC, enabled=.FALSE.)
+ ENDIF
+ENDIF
+!
+!$OMP END SINGLE
+#endif
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_CHECK_FIELD_2D',1,ZHOOK_HANDLE)
+! ----------------------------------------------------------------------
+!
+END SUBROUTINE SFX_XIOS_CHECK_FIELD_2D
diff --git a/src/SURFEX/sfx_xios_declare_field.F90 b/src/SURFEX/sfx_xios_declare_field.F90
new file mode 100644
index 0000000000000000000000000000000000000000..ecb01547db60225c5fd375331701c3494c121495
--- /dev/null
+++ b/src/SURFEX/sfx_xios_declare_field.F90
@@ -0,0 +1,354 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+SUBROUTINE SFX_XIOS_DECLARE_FIELD(HREC, HDOMAIN, HAXIS, KLEV, HAXIS2, KLEV2, HCOMMENT ,KFREQOP)
+!!
+!!
+!! PURPOSE
+!! --------
+!!
+!! Declare field HREC and some attributes to XIOS if needed
+
+!! If 'units' or 'long_name' attribute is not defined using XIOS
+!! config files , use HCOMMENT to declare it. Same for domain and
+!! other axis, either using relevant args or with default values
+!!
+!! If haxis si provided and is the name of dimension 'patch' and
+!! haxis2 is not provided, rather proceed by a loop of 2D
+!! fields declarations
+!!
+!! IMPLICIT ARGUMENTS :
+!! --------------------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! XIOS LIBRARY
+!!
+!! REFERENCE
+!! ---------
+!!
+!! XIOS Reference guide - Yann Meurdesoif - 10/10/2014 -
+!! svn co -r 515 http://forge.ipsl.jussieu.fr/ioserver/svn/XIOS/branchs/xios-1.0 <dir>
+!! cd <dir>/doc ; ....
+!!
+!! AUTHOR
+!! ------
+!!
+!! S.Sénési, CNRM
+!!
+!! MODIFICATION
+!! --------------
+!!
+!! Original 03/2016
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_XIOS, ONLY : LXIOS_DEF_CLOSED, YPATCH_DIM_NAME, NBASE_XIOS_FREQ
+USE MODD_SURF_PAR, ONLY : XUNDEF
+
+#ifdef WXIOS
+USE XIOS
+#endif
+!
+USE MODI_SET_AXIS
+USE MODI_ABOR1_SFX
+!
+USE YOMHOOK, ONLY : LHOOK, DR_HOOK
+USE PARKIND1, ONLY : JPRB, JPIM
+!
+IMPLICIT NONE
+
+!
+! Arguments
+!
+ CHARACTER(LEN=*) ,INTENT(IN) :: HREC ! field id
+ CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL :: HDOMAIN ! name of the horiz domain
+ CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL :: HAXIS ! name of the additional axis
+INTEGER ,INTENT(IN), OPTIONAL :: KLEV ! Axis size
+ CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL :: HAXIS2 ! name of second additional axis
+INTEGER ,INTENT(IN), OPTIONAL :: KLEV2 ! Second axis size
+ CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL :: HCOMMENT ! Comment string a la Surfex
+INTEGER(KIND=JPIM) ,INTENT(IN), OPTIONAL :: KFREQOP ! Sampling frequency, in minutes
+!
+ CHARACTER(1000) :: YLDOMAIN
+ CHARACTER(1000) :: YLCOMMENT
+ CHARACTER(1000) :: YAXIS,YAXIS2
+ CHARACTER(3) :: YIDIM
+!
+INTEGER(KIND=JPIM) :: IFREQOP ! Sampling frequency, in minutes
+INTEGER(KIND=JPIM) :: IIDIM, ILEV, ILEV2
+LOGICAL :: GGRIDDEF
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_DECLARE_FIELD',0,ZHOOK_HANDLE)
+!
+#ifdef WXIOS
+!
+! ----------------------------------------------------------------------
+! If XIOS init phase is over, just returns
+! ----------------------------------------------------------------------
+!
+IF (LXIOS_DEF_CLOSED) THEN
+ IF (LHOOK) CALL DR_HOOK('SFX_XIOS_DECLARE_FIELD_INTERNAL',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
+!
+YLDOMAIN='FULL'
+IF (PRESENT(HDOMAIN)) YLDOMAIN=TRIM(HDOMAIN)
+YLCOMMENT=''
+IF (PRESENT(HCOMMENT)) YLCOMMENT=TRIM(HCOMMENT)
+IFREQOP=0
+IF (PRESENT(KFREQOP)) IFREQOP=KFREQOP
+ILEV=0
+IF (PRESENT(KLEV)) ILEV=KLEV
+ILEV2=0
+IF (PRESENT(KLEV2)) ILEV2=KLEV2
+YAXIS=''
+IF (PRESENT(HAXIS)) YAXIS=TRIM(HAXIS)
+YAXIS2=''
+IF (PRESENT(HAXIS2)) YAXIS2=TRIM(HAXIS2)
+!
+IF (PRESENT(HAXIS) .AND. (YAXIS==TRIM(YPATCH_DIM_NAME)) .AND. .NOT. PRESENT(HAXIS2)) THEN
+ ! For historical reason, in that case, a special treatment for
+ ! avoiding that 'patch' dimension (provided as 1st dimension) is
+ ! actually used : proceed by declaring a set of individual arrays
+ IF ( ILEV == 0 ) CALL XIOS_GET_AXIS_ATTR(HAXIS, n_glo=ILEV)
+ DO IIDIM=1,ILEV
+ IF ( IIDIM < 10 ) THEN
+ WRITE(YIDIM,'(I1)') IIDIM
+ ELSE
+ IF ( IIDIM < 100 ) THEN
+ WRITE(YIDIM,'(I2)') IIDIM
+ ELSE
+ WRITE(YIDIM,'(I2)') IIDIM
+ ENDIF
+ ENDIF
+ !write(0,*) '<field id="'//trim(HREC)//'_'//TRIM(YIDIM)//'", domain_ref="'//trim(CLDOMAIN)//'" />'
+ CALL SFX_XIOS_DECLARE_FIELD_INTERNAL(TRIM(HREC)//'_'//TRIM(YIDIM), YLDOMAIN, YLCOMMENT, IFREQOP)
+ END DO
+ !
+ELSE
+ !
+ ! Standard case
+ !
+ CALL SFX_XIOS_DECLARE_FIELD_INTERNAL(HREC, YLDOMAIN, YLCOMMENT, IFREQOP)
+ IF (PRESENT(HAXIS)) CALL SFX_XIOS_DECLARE_AXIS_INTERNAL(HREC,YAXIS,ILEV)
+ IF (PRESENT(HAXIS2)) CALL SFX_XIOS_DECLARE_AXIS_INTERNAL(HREC,YAXIS2,ILEV2,OSECOND=.TRUE.)
+ENDIF
+#endif
+!
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_DECLARE_FIELD',1,ZHOOK_HANDLE)
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+CONTAINS
+
+SUBROUTINE SFX_XIOS_DECLARE_FIELD_INTERNAL(HREC, HDOMAIN, HCOMMENT , KFREQOP)
+USE MODD_XIOS, ONLY : COUTPUT_DEFAULT
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE PARKIND1 , ONLY : JPRB, JPIM
+!
+#ifdef WXIOS
+USE XIOS
+#endif
+!
+USE MODI_ABOR1_SFX
+!
+IMPLICIT NONE
+!
+! Arguments
+!
+CHARACTER(LEN=*) ,INTENT(IN) :: HREC ! field id
+CHARACTER(LEN=*) ,INTENT(IN) :: HDOMAIN ! name of the horiz domain
+CHARACTER(LEN=*) ,INTENT(IN) :: HCOMMENT ! Comment string a la Surfex
+INTEGER(KIND=JPIM) ,INTENT(IN) :: KFREQOP ! Sampling frequency, in minutes
+!
+! Local variables
+!
+LOGICAL :: GISDEF, GGRIDDEF
+INTEGER :: IPO,IPF
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+#ifdef WXIOS
+TYPE(xios_field) :: field_hdl, other_field_hdl
+TYPE(xios_fieldgroup) :: fieldgroup_hdl
+TYPE(xios_file) :: file_hdl
+#endif
+!
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_DECLARE_FIELD',0,ZHOOK_HANDLE)
+!
+#ifdef WXIOS
+!
+!$OMP SINGLE
+!
+! ----------------------------------------------------------------------
+! We are still in the XIOS init phase => Define field if necessary
+! ----------------------------------------------------------------------
+!
+IF (.NOT. XIOS_IS_VALID_FIELD(HREC)) THEN
+
+ CALL XIOS_GET_HANDLE("field_definition",fieldgroup_hdl)
+ CALL XIOS_ADD_CHILD(fieldgroup_hdl,field_hdl,HREC)
+ !IF (.NOT. XIOS_IS_VALID_FIELD("default_field")) &
+ ! CALL ABOR1_SFX('sfx_xios_check_field:cannot output field '//HREC//' : no default_field is defined')
+ CALL XIOS_SET_ATTR(field_hdl,name=HREC)
+ !
+ ! ----------------------------------------------------------------------
+ ! If default_ouput file is defined, add this field to it
+ ! ----------------------------------------------------------------------
+ !
+ IF ( XIOS_IS_VALID_FILE(COUTPUT_DEFAULT)) THEN
+ CALL XIOS_GET_HANDLE(COUTPUT_DEFAULT,file_hdl)
+ CALL XIOS_ADD_CHILD(file_hdl,field_hdl)
+ CALL XIOS_SET_ATTR(field_hdl,field_ref=HREC)
+ ENDIF
+
+ENDIF
+!
+! ----------------------------------------------------------------------
+! If field attribute 'domain' is not defined, set it
+! ----------------------------------------------------------------------
+!
+ CALL XIOS_IS_DEFINED_FIELD_ATTR(HREC,grid_ref=GGRIDDEF)
+ CALL XIOS_IS_DEFINED_FIELD_ATTR(HREC,domain_ref=GISDEF)
+!
+IF ( .NOT. GISDEF .AND. .NOT. GGRIDDEF ) THEN
+ IF (TRIM(HDOMAIN)=='') &
+ CALL ABOR1_SFX('SFX_XIOS_DECLARE_FIELD_INTERNAL : MUST PROVIDE HDOMAIN '//HREC)
+ !if (trim(hrec)=='PFRSO1') write(0,*) 'Setting domain for PFRSO1 !!!'
+ CALL XIOS_SET_FIELD_ATTR(HREC, domain_ref=TRIM(HDOMAIN))
+ !CALL XIOS_SET_FIELD_ATTR(HREC, grid_ref=TRIM(HDOMAIN))
+ELSE
+ !write(0,*) 'Field '//trim(hrec)//' already has a grid or domain:',GGRIDDEF,GISDEF
+ENDIF
+!
+! ----------------------------------------------------------------------
+! If prec is not defined , set it to the provided value (def : timestep)
+! ----------------------------------------------------------------------
+!
+! CALL XIOS_IS_DEFINED_FIELD_ATTR(HREC,name=GISDEF)
+!IF ( .NOT. GISDEF ) THEN
+! CALL XIOS_SET_FIELD_ATTR(HREC, name=trim(HREC))
+!ENDIF
+!
+! ------------------------------------------------------------------------
+! If field attribute 'unit' is not defined or empty, try to guess a value
+! from HCOMMENT (using rightmost string between parenthesis)
+! ------------------------------------------------------------------------
+!
+ CALL XIOS_IS_DEFINED_FIELD_ATTR(HREC,unit=GISDEF)
+IF ( .NOT. GISDEF ) THEN
+ IPO=INDEX(HCOMMENT,"(",.TRUE.)
+ IPF=INDEX(HCOMMENT,")",.TRUE.)
+ IF ( (IPO > 0) .AND. (IPF>IPO+1) ) THEN
+ CALL XIOS_SET_FIELD_ATTR(HREC,unit=HCOMMENT(IPO+1:IPF-1))
+ ENDIF
+ENDIF
+!
+! ----------------------------------------------------------------------
+! If field attribute 'long_name' is not defined or empty, set it
+! ----------------------------------------------------------------------
+!
+ CALL XIOS_IS_DEFINED_FIELD_ATTR(HREC,long_name=GISDEF)
+IF ( .NOT. GISDEF .AND. (TRIM(HCOMMENT) /= '') ) THEN
+ IF (IPO > 1) THEN
+ CALL XIOS_SET_FIELD_ATTR(HREC,long_name=TRIM(HCOMMENT(1:IPO-1)))
+ ELSE
+ CALL XIOS_SET_FIELD_ATTR(HREC,long_name=TRIM(HCOMMENT(:)))
+ ENDIF
+ENDIF
+!
+! ----------------------------------------------------------------------
+! Set default value to Surfex's one
+! ----------------------------------------------------------------------
+!
+ CALL XIOS_SET_FIELD_ATTR(HREC,default_value=XUNDEF)
+!
+!$OMP END SINGLE
+#endif
+!
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_DECLARE_FIELD_INTERNAL',1,ZHOOK_HANDLE)
+! ----------------------------------------------------------------------
+!
+END SUBROUTINE SFX_XIOS_DECLARE_FIELD_INTERNAL
+
+SUBROUTINE SFX_XIOS_DECLARE_AXIS_INTERNAL(HREC, HAXIS, KLEV, OSECOND)
+!
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE PARKIND1 , ONLY : JPRB
+!
+#ifdef WXIOS
+USE XIOS
+#endif
+!
+USE MODI_ABOR1_SFX
+!
+!
+IMPLICIT NONE
+!
+! Arguments
+!
+CHARACTER(LEN=*) ,INTENT(IN) :: HREC ! field id
+CHARACTER(LEN=*) ,INTENT(IN) :: HAXIS ! axis name
+INTEGER ,INTENT(IN) :: KLEV ! axis size
+LOGICAL ,INTENT(IN),OPTIONAL :: OSECOND ! Is it a second axis
+!
+! Local variables
+!
+LOGICAL :: GISDEF, GGRIDDEF, GVALID_AXIS
+CHARACTER(1000) :: YAXIS
+INTEGER :: INGLO
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_DECLARE_AXIS_INTERNAL',0,ZHOOK_HANDLE)
+!
+#ifdef WXIOS
+ CALL XIOS_IS_DEFINED_FIELD_ATTR(HREC,grid_ref=GGRIDDEF)
+IF (.NOT. GGRIDDEF ) THEN
+ ! If an axis is already declared, just do nothing, except
+ ! if it is second call
+ CALL XIOS_IS_DEFINED_FIELD_ATTR(HREC,axis_ref=GISDEF)
+ IF ( .NOT. GISDEF .OR. PRESENT(OSECOND)) THEN
+ IF ( TRIM(HAXIS) == '') THEN
+ GVALID_AXIS=.FALSE.
+ IF (PRESENT(OSECOND)) THEN
+ YAXIS='dim2_for_'//TRIM(HREC)
+ ELSE
+ YAXIS='dim_for_'//TRIM(HREC)
+ ENDIF
+ ELSE
+ GVALID_AXIS=XIOS_IS_VALID_AXIS(trim(HAXIS))
+ YAXIS=TRIM(HAXIS)
+ ENDIF
+ IF (.NOT. GVALID_AXIS) THEN
+ IF ( KLEV /= 0) THEN
+ CALL SET_AXIS(TRIM(HAXIS),KSIZE=KLEV)
+ !write(0,*) 'calling set_axis for '//trim(yaxis)//" "//HREC ; call flush(0)
+ ELSE
+ CALL ABOR1_SFX('SFX_XIOS_DECLARE_FIELD:SFX_XIOS_DECLARE_AXIS_INTERNAL'//&
+ ': MUST PROVIDE KLEV OR AN ALREADY DECLARED HAXIS for '//HREC)
+ ENDIF
+ ENDIF
+ CALL XIOS_SET_FIELD_ATTR(HREC, axis_ref=TRIM(YAXIS))
+ ELSE
+ !write(0,*) 'An axis is already defined for '//HREC ; call flush(0)
+ ENDIF
+ELSE
+ !write(0,*) 'A grid is already defined for '//HREC ; call flush(0)
+ENDIF
+#endif
+!
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_DECLARE_AXIS_INTERNAL',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE SFX_XIOS_DECLARE_AXIS_INTERNAL
+
+END SUBROUTINE SFX_XIOS_DECLARE_FIELD
diff --git a/src/SURFEX/sfx_xios_send_block.F90 b/src/SURFEX/sfx_xios_send_block.F90
new file mode 100644
index 0000000000000000000000000000000000000000..ee8a0b7e4a0babbe2098a5f653ec493a42dfb8ba
--- /dev/null
+++ b/src/SURFEX/sfx_xios_send_block.F90
@@ -0,0 +1,405 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+SUBROUTINE SFX_XIOS_SEND_BLOCK(HDTAG,PFIELD,PFIELD2,PFIELD3,&
+ HDOMAIN,HAXIS,HAXIS2,HDCOMMENT,KFREQOP)
+!!
+!!
+!! PURPOSE
+!! --------
+!!
+!! Front-end to XIOS for client models
+!!
+!! It performes field declaration to XIOS if needed, provided it is
+!! not too late with respect to xios context definition closing
+!! (see sfx_xios_declare_field)
+!!
+!! It copes with client models which process fields by 'blocks'
+!! over the first dimension, and wish to send them by blocks too,
+!! a set of blocks being provided, duly ordered, between two
+!! calendar updates
+!!
+!! It gathers field blocks and send them to XIOS, using
+!! xios_send_field, as soon as the field is complete (i.e. enough
+!! blocks have been received, compared to a MODD_XIOS variable)
+!!
+!! METHOD :
+!! --------------------
+!!
+!! For each new field name received, create an entry in buffer
+!! array and records full MPI-task field size (as known by
+!! Xios).
+!!
+!! For all field names, add the block to the buffer and, if field
+!! is complete, send it to Xios and clears the buffer
+!!
+!! EXTERNAL
+!! --------
+!!
+!! XIOS LIBRARY
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! XIOS Reference guide - Yann Meurdesoif - 10/10/2014 -
+!! svn co --r 515 http://forge.ipsl.jussieu.fr/ioserver/svn/XIOS/branchs/xios-1.0 <dir>
+!! cd <dir>/doc ; ....
+!!
+!! AUTHOR
+!! ------
+!!
+!! S.Sénési, CNRM
+!!
+!! MODIFICATION
+!! --------------
+!!
+!! Original 01/2016
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_SURFEX_MPI, ONLY : NRANK
+!
+USE MODD_XIOS, ONLY : LXIOS, LXIOS_DEF_CLOSED, NBLOCK , NTIMESTEP
+!
+! NBLOCK dans arpege : YOMDIM:NGPBLKS
+#ifdef WXIOS
+USE MODI_SFX_XIOS_DECLARE_FIELD
+USE XIOS ,ONLY : XIOS_IS_DEFINED_FIELD_ATTR, XIOS_GET_FIELD_ATTR, &
+ XIOS_IS_DEFINED_GRID_ATTR, XIOS_GET_GRID_ATTR, &
+ XIOS_IS_DEFINED_DOMAIN_ATTR, XIOS_GET_DOMAIN_ATTR, &
+ XIOS_IS_VALID_FIELD, XIOS_SEND_FIELD, XIOS_SET_FIELD_ATTR,&
+ XIOS_GET_HANDLE, XIOS_ADD_CHILD, XIOS_SET_ATTR,&
+ XIOS_FIELD, XIOS_FIELDGROUP, XIOS_FIELD_IS_ACTIVE,&
+ XIOS_UPDATE_CALENDAR
+#endif
+!
+USE MODI_ABOR1_SFX
+!
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE PARKIND1 , ONLY : JPIM, JPRB
+!
+IMPLICIT NONE
+!
+! Arguments
+!
+ CHARACTER(LEN=*), INTENT(IN) :: HDTAG ! Field name
+REAL(KIND=JPRB) , INTENT(IN), OPTIONAL, DIMENSION(:) :: PFIELD ! Field data block
+REAL(KIND=JPRB) , INTENT(IN), OPTIONAL, DIMENSION(:,:):: PFIELD2 ! (or) 2d field data block
+REAL(KIND=JPRB) , INTENT(IN), OPTIONAL, DIMENSION(:,:,:):: PFIELD3 ! (or) 3d field data block
+ CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HDOMAIN ! Field domain name, defaults to 'FULL'
+ CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HAXIS ! Axis name, for 2d fields
+ CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HAXIS2 ! 2nd axis name, for 3d fields
+ CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HDCOMMENT ! Comment 'a la Surfex' (i.e. '<long name> (<units>)')
+ INTEGER , INTENT(IN), OPTIONAL :: KFREQOP ! Sampling frequency, in minutes
+!
+! Local variables
+!
+#ifdef WXIOS
+!
+! A basic type for handling fields and their buffer
+!
+TYPE BUF_t
+ CHARACTER(LEN=100) :: YLNAME ! Field name , as for XIOS
+ INTEGER(KIND=JPIM) :: ISIZEMAX ! Expected size of the complete field
+ ! for the whole of the MPI task
+ INTEGER(KIND=JPIM) :: ISIZE ! Current usable size (ie. over received blocks)
+ INTEGER(KIND=JPIM) :: INDIM ! Number of dimensions
+ INTEGER(KIND=JPIM) :: ILEV ! Size of 2nd dim (from first call)
+ INTEGER(KIND=JPIM) :: ILEV2 ! Size of 3rd dim (from first call)
+ INTEGER(KIND=JPIM) :: IBLOCK ! Number of blocks received for current timestep
+ REAL(KIND=JPRB), ALLOCATABLE, DIMENSION (:,:,:) :: ZFIELD ! Accumulate received blocks
+END TYPE BUF_t
+!
+TYPE(xios_field) :: field_hdl, other_field_hdl
+TYPE(xios_fieldgroup) :: fieldgroup_hdl
+INTEGER(KIND=JPIM) :: ISIZE = 1000 ! Initial number of managed field entries
+INTEGER(KIND=JPIM), PARAMETER :: INCR = 100 ! Increment in field entries number when reallocating
+INTEGER(KIND=JPIM), PARAMETER :: IMAXSIZE = 10000 ! Max number of field entries
+!
+TYPE(BUF_t), POINTER :: YLF ! Current buffer entry
+TYPE(BUF_t), ALLOCATABLE, TARGET, SAVE :: YLFIELDS(:)! Array of buffer entries
+TYPE(BUF_t), ALLOCATABLE :: YLTEMP(:) ! id - temporary
+!
+INTEGER(KIND=JPIM) :: JI, IL, IEMPTY, IIDIM, ITAKE, ILEV, INFIELDS
+ CHARACTER(LEN=100) :: YLTAG ! Field name
+ CHARACTER(LEN=300) :: YLAXIS, YLAXIS2
+ CHARACTER(LEN=300) :: YLDOMAIN
+ CHARACTER(LEN=300) :: YLGRID
+ CHARACTER(LEN=300) :: YLCOMMENT
+!
+INTEGER :: IFREQOP
+!
+LOGICAL :: GLISDEF
+!
+#endif
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!#include "abor1.intfb.h"
+!
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_SEND_BLOCK_1',0,ZHOOK_HANDLE)
+!
+IF (.NOT. LXIOS) THEN
+ IF (LHOOK) CALL DR_HOOK('SFX_XIOS_SEND_BLOCK_1',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
+!
+#ifdef WXIOS
+!
+IF (LXIOS_DEF_CLOSED) THEN
+ IF (.NOT. XIOS_FIELD_IS_ACTIVE(HDTAG) ) THEN
+ IF (LHOOK) CALL DR_HOOK('SFX_XIOS_SEND_BLOCK_1',1,ZHOOK_HANDLE)
+ RETURN
+ ENDIF
+ENDIF
+YLTAG = TRIM(HDTAG)
+!
+!$OMP SINGLE
+!
+ALLOCATE(YLFIELDS(ISIZE))
+YLFIELDS(:)%YLNAME = ''
+!
+! Search if field is known - a simple loop on the table -
+! probably not much quick ...
+!
+IL = 0
+DO JI=1,ISIZE
+ IF (YLFIELDS(JI)%YLNAME == YLTAG) THEN
+ IL = JI
+ EXIT
+ ENDIF
+ENDDO
+!
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_SEND_BLOCK_1',1,ZHOOK_HANDLE)
+!
+IF ( IL==0 ) THEN
+ !
+ ! Field is not yet recorded -> ask XIOS if field is known, and what's its size
+ ! By exception : if XIOS still in init phase, declare field domain if needed
+ !
+ IF (.NOT. LXIOS_DEF_CLOSED) THEN
+
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_SEND_BLOCK_2',0,ZHOOK_HANDLE)
+
+ YLDOMAIN=''
+ IF (PRESENT(HDOMAIN)) YLDOMAIN = TRIM(HDOMAIN)
+ YLCOMMENT=''
+ IF (PRESENT(HDCOMMENT)) YLCOMMENT = TRIM(HDCOMMENT)
+ IFREQOP=0
+ IF (PRESENT(KFREQOP)) IFREQOP = KFREQOP
+ !
+ IF (PRESENT(PFIELD)) THEN
+ CALL SFX_XIOS_DECLARE_FIELD(YLTAG, YLDOMAIN, HCOMMENT=YLCOMMENT, KFREQOP=IFREQOP)
+ ELSEIF (PRESENT(PFIELD2)) THEN
+ YLAXIS=''
+ IF (PRESENT(HAXIS)) YLAXIS = TRIM(HAXIS)
+ CALL SFX_XIOS_DECLARE_FIELD(YLTAG, YLDOMAIN, HAXIS=YLAXIS, &
+ KLEV=SIZE(PFIELD2,2), HCOMMENT=YLCOMMENT,KFREQOP=IFREQOP)
+ ELSEIF (PRESENT(PFIELD3)) THEN
+ YLAXIS ='' ; IF (PRESENT(HAXIS)) YLAXIS = TRIM(HAXIS)
+ YLAXIS2='' ; IF (PRESENT(HAXIS2)) YLAXIS2 = TRIM(HAXIS2)
+ CALL SFX_XIOS_DECLARE_FIELD(YLTAG, YLDOMAIN, &
+ HAXIS =YLAXIS , KLEV =SIZE(PFIELD3,2), &
+ HAXIS2=YLAXIS2, KLEV2=SIZE(PFIELD3,3), HCOMMENT=YLCOMMENT,KFREQOP=IFREQOP)
+ ELSE
+ CALL ABOR1_SFX("SFX_XIOS_SEND_BLOCK: NO PFIELDx FOR "//TRIM(YLTAG))
+ ENDIF
+ !
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_SEND_BLOCK_2',1,ZHOOK_HANDLE)
+
+ ELSE
+ !
+ IF (.NOT. XIOS_IS_VALID_FIELD(YLTAG)) THEN
+ CALL ABOR1_SFX("SFX_XIOS_SEND_BLOCK: FIELD "//TRIM(YLTAG)//&
+ &" WASN'T DECLARED TO XIOS (NEITHER IN XML CONFIG FILE, NOR SOON ENOUGH FROM CODE)")
+ ENDIF
+ !
+ ! Find a place (i.e. index IEMPTY) to record the new field
+ !
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_SEND_BLOCK_3',0,ZHOOK_HANDLE)
+
+ IEMPTY = 0
+ DO JI = 1,ISIZE
+ IF (TRIM(YLFIELDS(JI)%YLNAME) == '') THEN
+ IEMPTY = JI
+ EXIT
+ ENDIF
+ ENDDO
+ !
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_SEND_BLOCK_3',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_SEND_BLOCK_4',0,ZHOOK_HANDLE)
+
+
+ IF ( IEMPTY == 0 ) THEN
+ ! The fields table is full. Allocate a new one and copy the content
+ IF (ISIZE > IMAXSIZE) THEN
+ CALL ABOR1_SFX("SFX_XIOS_SEND_BLOCK: MAX BUFFER ENTRIES NUMBER WAS REACHED")
+ ENDIF
+ !
+ ALLOCATE(YLTEMP(ISIZE))
+ YLTEMP = YLFIELDS
+ DEALLOCATE(YLFIELDS)
+ !
+ ALLOCATE(YLFIELDS(ISIZE+INCR))
+ YLFIELDS(1:ISIZE) = YLTEMP(1:ISIZE)
+ DEALLOCATE(YLTEMP)
+ !
+ YLFIELDS(ISIZE+1:ISIZE+INCR)%YLNAME = ''
+ !
+ IEMPTY = ISIZE+1
+ ISIZE = ISIZE+INCR
+ !
+ ENDIF
+ !
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_SEND_BLOCK_4',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_SEND_BLOCK_5',0,ZHOOK_HANDLE)
+
+ ! Record the new field attributes (not its data)
+ !
+ YLF => YLFIELDS(IEMPTY)
+ YLF%YLNAME = TRIM(YLTAG)
+ !
+ CALL XIOS_IS_DEFINED_FIELD_ATTR(YLTAG, grid_ref=GLISDEF)
+ IF (GLISDEF) THEN
+ CALL XIOS_GET_FIELD_ATTR(YLTAG, grid_ref=YLGRID)
+ IF (YLGRID(1:4)=='FULL') THEN
+ YLDOMAIN='FULL'
+ ELSEIF (YLGRID(1:3)=='SEA') THEN
+ YLDOMAIN='SEA'
+ ELSEIF (YLGRID(1:5)=='WATER') THEN
+ YLDOMAIN='WATER'
+ ELSEIF (YLGRID(1:6)=='NATURE') THEN
+ YLDOMAIN='NATURE'
+ ELSEIF (YLGRID(1:4)=='TOWN') THEN
+ YLDOMAIN='TOWN'
+ ENDIF
+ ELSE
+ CALL XIOS_IS_DEFINED_FIELD_ATTR(YLTAG, domain_ref=GLISDEF)
+ IF (GLISDEF) THEN
+ CALL XIOS_GET_FIELD_ATTR(YLTAG, domain_ref=YLDOMAIN)
+ ELSE
+ CALL ABOR1_SFX('SFX_XIOS_SEND_BLOCK : FIELD '//TRIM(YLTAG)//' HAS NO DOMAIN')
+ ENDIF
+ ENDIF
+ !
+ CALL XIOS_GET_DOMAIN_ATTR(YLDOMAIN, data_ni=IIDIM)
+ !
+ YLF%ISIZEMAX = IIDIM
+ !
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_SEND_BLOCK_5',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_SEND_BLOCK_6',0,ZHOOK_HANDLE)
+
+ INFIELDS = 0
+ IF (PRESENT(PFIELD)) THEN
+ YLF%ILEV = 1
+ YLF%ILEV2 = 1
+ YLF%INDIM = 1
+ INFIELDS = INFIELDS+1
+ ENDIF
+ IF (PRESENT(PFIELD2)) THEN
+ YLF%ILEV = SIZE(PFIELD2,2)
+ YLF%ILEV2 = 1
+ YLF%INDIM = 2
+ INFIELDS = INFIELDS+1
+ ENDIF
+ IF (PRESENT(PFIELD3)) THEN
+ YLF%ILEV = SIZE(PFIELD3,2)
+ YLF%ILEV2 = SIZE(PFIELD3,3)
+ YLF%INDIM = 3
+ INFIELDS = INFIELDS+1
+ ENDIF
+ IF (INFIELDS /= 1 ) &
+ CALL ABOR1_SFX('SFX_XIOS_SEND_BLOCK : TOO FEW OR MANY PFIELDx ARGS FOR '//HDTAG)
+ ALLOCATE(YLF%ZFIELD(YLF%ISIZEMAX,YLF%ILEV,YLF%ILEV2))
+ YLF%ISIZE = 0
+ YLF%IBLOCK = 0
+ !
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_SEND_BLOCK_6',1,ZHOOK_HANDLE)
+
+ ENDIF
+ !
+ELSE
+ !
+ YLF => YLFIELDS(IL)
+ !
+ENDIF
+!
+IF (LXIOS_DEF_CLOSED) THEN
+ !
+ ! Check consistency between calls : discarded for efficiency purpose
+ !IF (ILEV .NE. YLF%ILEV) THEN
+ ! ! CALL ABOR1_SFX('SFX_XIOS_SEND_BLOCK : INCONSISTENT LEVELS # FOR '//YLTAG)
+ !ENDIF
+ !
+ ! Allocate the data buffer if needed
+ !
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_SEND_BLOCK_7',0,ZHOOK_HANDLE)
+ IF (.NOT. ALLOCATED(YLF%ZFIELD)) THEN
+ ALLOCATE(YLF%ZFIELD(YLF%ISIZEMAX,YLF%ILEV,YLF%ILEV2))
+ ENDIF
+ !
+ ! Add the block data to the field buffer and send the field if it is
+ ! complete
+ !
+ IF (YLF%INDIM ==1 ) THEN
+ ITAKE=SIZE(PFIELD)
+ ELSEIF (YLF%INDIM ==2 ) THEN
+ ITAKE=SIZE(PFIELD2,1)
+ ELSEIF (YLF%INDIM ==3 ) THEN
+ ITAKE=SIZE(PFIELD3,1)
+ ENDIF
+ !
+ YLF%IBLOCK = YLF%IBLOCK+1
+ IF ((YLF%ISIZE + ITAKE) > YLF%ISIZEMAX) THEN
+ ! xxx a modifier : le dernier blc arpege arrive avec taille NPROMA
+ IF (YLF%IBLOCK .NE. NBLOCK) THEN
+ CALL ABOR1_SFX("SFX_XIOS_SEND_BLOCK: FIELD "//TRIM(YLTAG)//&
+ " OVERFLOWS - CHECK ITS DECLARATION TO XIOS (MAYBE TWO INCONSISTENT DECLARATIONS ?)")
+ ENDIF
+ ITAKE = YLF%ISIZEMAX - YLF%ISIZE
+ ENDIF
+ ! Store the field and update its size
+ IF (ITAKE > 0 ) THEN
+ IF (YLF%INDIM==1) THEN
+ YLF%ZFIELD(YLF%ISIZE+1:YLF%ISIZE+ITAKE,1,1) = PFIELD(1:ITAKE)
+ ELSEIF (YLF%INDIM==2) THEN
+ YLF%ZFIELD(YLF%ISIZE+1:YLF%ISIZE+ITAKE,:,1) = PFIELD2(1:ITAKE,:)
+ ELSEIF (YLF%INDIM==3) THEN
+ YLF%ZFIELD(YLF%ISIZE+1:YLF%ISIZE+ITAKE,:,:) = PFIELD3(1:ITAKE,:,:)
+ ENDIF
+ ELSEIF ( ITAKE < 0 ) THEN
+ CALL ABOR1_SFX('SFX_XIOS_SEND_BLOCK :isizemax < isize')
+ ENDIF
+ !
+ YLF%ISIZE = YLF%ISIZE + ITAKE
+ !
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_SEND_BLOCK_7',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_SEND_BLOCK_8',0,ZHOOK_HANDLE)
+ IF (YLF%IBLOCK==NBLOCK) THEN
+ ! Send field and clears the buffer (incl. de-allocation)
+ IF (YLF%INDIM==1) THEN
+ CALL XIOS_SEND_FIELD(trim(YLTAG),YLF%ZFIELD(:,1,1))
+ ELSEIF (YLF%INDIM==2) THEN
+ CALL XIOS_SEND_FIELD(trim(YLTAG),YLF%ZFIELD(:,:,1))
+ ELSEIF (YLF%INDIM==3) THEN
+ CALL XIOS_SEND_FIELD(trim(YLTAG),YLF%ZFIELD(:,:,:))
+ ENDIF
+ YLF%IBLOCK = 0
+ YLF%ISIZE = 0
+ DEALLOCATE(YLF%ZFIELD)
+ ENDIF
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_SEND_BLOCK_8',1,ZHOOK_HANDLE)
+ENDIF
+!
+!$OMP END SINGLE
+!
+IF (ALLOCATED(YLFIELDS)) DEALLOCATE(YLFIELDS)
+!
+#endif
+!
+END SUBROUTINE SFX_XIOS_SEND_BLOCK
diff --git a/src/SURFEX/sfx_xios_set_domain.F90 b/src/SURFEX/sfx_xios_set_domain.F90
new file mode 100644
index 0000000000000000000000000000000000000000..5afd5e0a035959ca704411b51537d14a65bb7e5b
--- /dev/null
+++ b/src/SURFEX/sfx_xios_set_domain.F90
@@ -0,0 +1,210 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+SUBROUTINE SFX_XIOS_SET_DOMAIN(HGRID, HNAME, KDIM1, KDIM2, KEXT1, KINDEX,&
+ ODMASK, PLON, PLAT, PCORNER_LON, PCORNER_LAT, KMASK)
+#ifdef WXIOS
+!!
+!!
+!! PURPOSE
+!! --------
+!!
+!!
+!! Initialize an XIOS domain, representing Surfex packing for a
+!! tile (or full domain) Declare Surfex grids and masks for XIOS,
+!! accounting for 2D and 1D geometries
+!!
+!!
+!! IMPLICIT ARGUMENTS :
+!! --------------------
+!!
+!! LXIOS, YXIOS_CONTEXT, TXIOS_CONTEXT, LGAUSS
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! XIOS LIBRARY
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! XIOS Reference guide - Yann Meurdesoif - 10/10/2014 :
+!! svn co -r 515 http://forge.ipsl.jussieu.fr/ioserver/svn/XIOS/branchs/xios-1.0 <dir> ;
+!! cd <dir>/doc ; ....
+!!
+!! AUTHOR
+!! ------
+!!
+!! S.Sénési, CNRM
+!!
+!! MODIFICATION
+!! --------------
+!!
+!! Original 08/2015
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!-------------------------------------------------------------------------------
+!
+USE XIOS ,ONLY : XIOS_DOMAIN, XIOS_DOMAINGROUP, XIOS_AXISGROUP, XIOS_AXIS, &
+ XIOS_GET_HANDLE, XIOS_ADD_CHILD, XIOS_SET_DOMAIN_ATTR, &
+ XIOS_IS_DEFINED_DOMAIN_ATTR
+!
+USE MODI_GET_SURF_GRID_DIM_n
+USE MODI_LATLON_GRIDTYPE_LONLAT_REG
+USE MODI_ABOR1_SFX
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+ CHARACTER(LEN=*), INTENT(IN) :: HGRID
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name to set in XIOS for the Surfex domain/tile
+INTEGER, INTENT(IN) :: KDIM1 ! Global grid size for dimension 1 (incl. extension zone if any)
+ ! Can be set to O for offline case
+INTEGER, INTENT(IN) :: KDIM2 ! Global grid size for dimension 2
+INTEGER, INTENT(IN) :: KEXT1 ! Size of extension zone if any (Aladin : NEXTI)
+ ! Should be O for offline case
+!
+INTEGER, INTENT(IN), DIMENSION(:) :: KINDEX ! Index of the MPI-task cells
+ ! in global 1D grid (from 0)
+LOGICAL, INTENT(IN), DIMENSION(:) :: ODMASK ! mask for the MPI-task cells
+REAL , INTENT(IN), DIMENSION(:),OPTIONAL :: PLON ! Longitudes for the MPI-task cells
+REAL , INTENT(IN), DIMENSION(:),OPTIONAL :: PLAT ! Latitudes for the MPI-task cells
+REAL , INTENT(IN), DIMENSION(:,:),OPTIONAL:: PCORNER_LON, PCORNER_LAT
+INTEGER, INTENT(IN), DIMENSION(:),OPTIONAL :: KMASK ! Local Surfex packing mask for the tile
+!
+TYPE(xios_domaingroup) :: domaingroup_hdl
+TYPE(xios_domain) :: domain_hdl
+!
+INTEGER :: ISIZE ! Number of points for the MPI-task (among all tiles)
+LOGICAL :: GRECT ! T if rectangular grid (inc Aladin)
+INTEGER :: JK
+!
+INTEGER, DIMENSION(:),ALLOCATABLE :: IINDEX, JINDEX
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_SET_DOMAIN',0,ZHOOK_HANDLE)
+!
+!$OMP SINGLE
+!
+CALL XIOS_GET_HANDLE("domain_definition",domaingroup_hdl)
+CALL XIOS_ADD_CHILD(domaingroup_hdl,domain_hdl,HNAME)
+!
+ISIZE = SIZE(KINDEX)
+!
+!
+GRECT = (KDIM2/=1)
+!
+IF (GRECT) THEN
+ !
+ CALL XIOS_SET_DOMAIN_ATTR(HNAME, ni_glo=KDIM1-KEXT1, nj_glo=KDIM2)
+ CALL XIOS_SET_DOMAIN_ATTR(HNAME, data_dim=1, ibegin=0)
+ CALL XIOS_SET_DOMAIN_ATTR(HNAME, ni=ISIZE)
+ CALL XIOS_SET_DOMAIN_ATTR(HNAME, nj=1, data_nj=1) ! To account for XIOS bugs
+ ! Must build i_index and j_index from kindex
+ ALLOCATE(IINDEX(ISIZE), JINDEX(ISIZE))
+ !
+ DO JK = 1,ISIZE
+ IINDEX(JK)=MOD(KINDEX(JK),KDIM1-KEXT1)
+ JINDEX(JK)=KINDEX(JK)/(KDIM1-KEXT1)
+ IF (JINDEX(JK) .GT. KDIM2-1 ) &
+ CALL ABOR1_SFX("SFX_XIOS_SET_DOMAIN : Inconsistent jindex")
+ ENDDO
+ !
+ CALL XIOS_SET_DOMAIN_ATTR(HNAME, i_index=IINDEX, j_index=JINDEX)
+ DEALLOCATE(IINDEX, JINDEX)
+ CALL XIOS_SET_DOMAIN_ATTR(HNAME, mask_1d=ODMASK)
+ !
+ IF (PRESENT(KMASK)) THEN
+ CALL XIOS_SET_DOMAIN_ATTR(HNAME, data_i_index=KMASK(:), data_ni=size(KMASK))
+ ENDIF
+ !
+ !
+ ! Process lat/lon and their corners
+ !
+ CALL XIOS_SET_DOMAIN_ATTR(HNAME, lonvalue_1d=PLON,latvalue_1d=PLAT)
+ IF (HGRID=="LONLAT REG") THEN
+ !
+ CALL XIOS_SET_DOMAIN_ATTR(HNAME, type='rectilinear')
+ CALL XIOS_SET_DOMAIN_ATTR(HNAME, lonvalue_1d=PLON,latvalue_1d=PLAT)
+ !
+ !CALL XIOS_SET_DOMAIN_ATTR(HNAME, type='regular')
+ !IDIM=KDIM1*KDIM2
+ !ALLOCATE(ZLAT(IDIM),ZLON(IDIM),ZMESH(IDIM),ZDIR(IDIM))
+ !CALL LATLON_GRIDTYPE_LONLAT_REG(SIZE(UG%XGRID_PAR),IDIM,&
+ ! UG%XGRID_PAR,ZLAT,ZLON,ZMESH,ZDIR)
+ !CALL XIOS_SET_DOMAIN_ATTR(HNAME, lonvalue_1d=ZLON(1:KDIM1-KEXT1))
+ !CALL XIOS_SET_DOMAIN_ATTR(HNAME, latvalue_1d=(/(ZLAT(KK),KK=1,IDIM,KDIM1)/) )
+ !DEALLOCATE(ZLAT,ZLON,ZMESH,ZDIR)
+ CALL XIOS_SET_DOMAIN_ATTR(HNAME, type='rectilinear')
+ !
+ ELSE
+ IF (HGRID/="CONF PROJ ") &
+ PRINT*,"SFX_XIOS_SET_DOMAIN : Managing "//HGRID//" type grid is not yet tested "
+ !
+ CALL XIOS_SET_DOMAIN_ATTR(HNAME, type="curvilinear")
+ CALL XIOS_SET_DOMAIN_ATTR(HNAME, lonvalue_1d=PLON,latvalue_1d=PLAT)
+ IF (PRESENT(PCORNER_LAT) .AND. (HGRID /='CARTESIAN')) THEN
+ CALL XIOS_SET_DOMAIN_ATTR(HNAME, nvertex=4, &
+ bounds_lon_1d=PCORNER_LON,bounds_lat_1d=PCORNER_LAT)
+ ENDIF
+ !
+ ENDIF
+ !
+ELSE
+ ! For 1D global grids (such as Gaussian reduced), just provide
+ ! KINDEX, the local array of global cell indices
+ !
+ CALL XIOS_SET_DOMAIN_ATTR(HNAME, type='unstructured', data_dim=1, ni_glo=KDIM1*KDIM2)
+ CALL XIOS_SET_DOMAIN_ATTR(HNAME, ibegin=0)
+ if (maxval(kindex) > KDIM1*KDIM2-1 ) CALL ABOR1_SFX("SFX_XIOS_SET_DOMAIN : maxval(i_index)")
+ if (minval(kindex) < 0 ) CALL ABOR1_SFX("SFX_XIOS_SET_DOMAIN : minval(i_index)")
+ CALL XIOS_SET_DOMAIN_ATTR(HNAME, i_index=KINDEX, ni=size(KINDEX) )
+ ! CALL XIOS_SET_DOMAIN_ATTR(HNAME, mask_1d=LDMASK)
+ IF (PRESENT(KMASK)) THEN
+ !
+ ! Use XIOS 'compression' feature to account for Surfex 'packing'
+ !
+ !write(0,*) 'declaring '//trim(yname)//' with sizes : ',ISIZE,SIZE(KMASK), minval(kindex),maxval(kindex)&
+ ! , minval(kmask),maxval(kmask)
+ !call flush(0)
+ if ( size(kmask) > 0 ) then
+ if (size(kmask) > size(KINDEX)) CALL ABOR1_SFX("SFX_XIOS_SET_DOMAIN : size(kmask))")
+ if (maxval(kmask) > size(kindex)-1 ) CALL ABOR1_SFX("SFX_XIOS_SET_DOMAIN : maxval(data_i_index)")
+ if (minval(kmask) < 0 ) CALL ABOR1_SFX("SFX_XIOS_SET_DOMAIN : minval(data_i_index)")
+ else
+ !write(0,*) 'zero-size domain '//trim(yname)
+ endif
+ CALL XIOS_SET_DOMAIN_ATTR(HNAME, data_i_index=KMASK, data_ni=size(KMASK))
+ !ELSE
+ !write(0,*) 'declaring '//trim(yname)//' with sizes : ',ISIZE, minval(kindex),maxval(kindex)
+ !call flush(0)
+ ENDIF
+ !
+ ! Process lat/lon and their corners
+ !
+ IF (PRESENT(PLAT) .AND. PRESENT(PLON)) THEN
+ CALL XIOS_SET_DOMAIN_ATTR(HNAME, lonvalue_1d=PLON,latvalue_1d=PLAT)
+ ELSE
+ CALL ABOR1_SFX("SFX_XIOS_SET_DOMAIN : Must provide lat and lon")
+ ENDIF
+ IF (PRESENT(PCORNER_LAT) .AND. PRESENT(PCORNER_LON) .AND. &
+ (HGRID/='CARTESIAN' )) THEN
+ CALL XIOS_SET_DOMAIN_ATTR(HNAME, nvertex=4, &
+ bounds_lat_1d=PCORNER_LAT, bounds_lon_1d=PCORNER_LON )
+ ENDIF
+ENDIF
+!
+!$OMP END SINGLE
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_SET_DOMAIN',1,ZHOOK_HANDLE)
+!
+#endif
+END SUBROUTINE SFX_XIOS_SET_DOMAIN
diff --git a/src/SURFEX/sfx_xios_setup.F90 b/src/SURFEX/sfx_xios_setup.F90
new file mode 100644
index 0000000000000000000000000000000000000000..ca796f182338da94d067a11dc08e42cb6deff02c
--- /dev/null
+++ b/src/SURFEX/sfx_xios_setup.F90
@@ -0,0 +1,218 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+SUBROUTINE SFX_XIOS_SETUP(YSC, KCOMM, KLUOUT, KYEAR, KMONTH, KDAY, PTIME, PTSTEP, &
+ KDIM1, KDIM2, KEXT1, PCLAT, PCLON, KXINDEX, ODXMASK,&
+ KMASKNAT, KMASKSEA, KMASKWAT, KMASKTOWN)
+!!
+!!
+!! PURPOSE
+!! --------
+!!
+!! Initialize all Surfex context for XIOS (calendar, grids, masks, model time step, ...)
+!!
+!!
+!! IMPLICIT ARGUMENTS :
+!! --------------------
+!!
+!! LXIOS, YXIOS_CONTEXT, TXIOS_CONTEXT
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! XIOS LIBRARY
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! XIOS Reference guide - Yann Meurdesoif - 10/10/2014 -
+!! svn co -r 515 http://forge.ipsl.jussieu.fr/ioserver/svn/XIOS/branchs/xios-1.0 <dir> ; cd <dir>/doc ; ....
+!!
+!! AUTHOR
+!! ------
+!!
+!! S.Sénési, CNRM
+!!
+!! MODIFICATION
+!! --------------
+!!
+!! Original 08/2015
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_SURFEX_n, ONLY : SURFEX_t
+
+USE MODD_CSTS, ONLY : XPI
+USE MODD_SURFEX_MPI, ONLY : NRANK, NINDEX
+!
+USE MODD_XIOS , ONLY : LXIOS,TXIOS_CONTEXT,YXIOS_CONTEXT, &
+ LXIOS_DEF_CLOSED, YGROUND_LAYER_DIM_NAME, &
+ YWGROUND_LAYER_DIM_NAME, YWIGROUND_LAYER_DIM_NAME, NBASE_XIOS_FREQ, &
+ YSWBAND_DIM_NAME, YPATCH_DIM_NAME
+!
+#ifdef WXIOS
+USE XIOS, ONLY : XIOS_CONTEXT_INITIALIZE, XIOS_GET_HANDLE, &
+ XIOS_SET_CURRENT_CONTEXT, XIOS_SET_TIMESTEP, XIOS_DATE, &
+ XIOS_DURATION, XIOS_DEFINE_CALENDAR, XIOS_GETVAR, &
+ XIOS_SOLVE_INHERITANCE
+!
+USE MODI_ABOR1_SFX
+USE MODI_SFX_XIOS_SET_DOMAIN
+USE MODI_SET_AXIS
+!
+#endif
+!
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE PARKIND1 , ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!
+! Arguments
+!
+TYPE (SURFEX_t), INTENT(IN) :: YSC
+!
+INTEGER, INTENT(INOUT) :: KCOMM ! Communicator
+INTEGER, INTENT(IN) :: KLUOUT ! Listing logical unit number
+INTEGER, INTENT(IN) :: KYEAR ! current year (UTC)
+INTEGER, INTENT(IN) :: KMONTH ! current month (UTC)
+INTEGER, INTENT(IN) :: KDAY ! current day (UTC)
+REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC,s)
+REAL, INTENT(IN) :: PTSTEP ! model time step
+INTEGER, INTENT(IN) :: KDIM1 ! Geometry param. (see sfx_set_domain)
+INTEGER, INTENT(IN) :: KDIM2 ! Geometry param. (see sfx_set_domain)
+INTEGER, INTENT(IN) :: KEXT1 ! Geometry param. (see sfx_set_domain)
+REAL , INTENT(IN) , DIMENSION(:,:) :: PCLAT ! Lat corners "
+REAL , INTENT(IN) , DIMENSION(:,:) :: PCLON ! Lon corners "
+INTEGER, INTENT(IN) , DIMENSION(:) :: KXINDEX ! index of proc cells in global grid
+LOGICAL, INTENT(IN) , DIMENSION(:) :: ODXMASK ! Cells mask
+INTEGER, INTENT(IN) , DIMENSION(:) :: KMASKNAT ! Masks for the whole MPI task
+INTEGER, INTENT(IN) , DIMENSION(:) :: KMASKSEA
+INTEGER, INTENT(IN) , DIMENSION(:) :: KMASKWAT
+INTEGER, INTENT(IN) , DIMENSION(:) :: KMASKTOWN
+
+!
+! Local variables
+!
+#ifdef WXIOS
+TYPE(XIOS_DURATION) :: TDTIME ! Time-step 'a la XIOS'
+INTEGER :: INHOURS,INMINUTES,INSECONDS
+#endif
+!
+INTEGER :: ITMP
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_SETUP',0,ZHOOK_HANDLE)
+!
+IF (.NOT. LXIOS ) THEN
+ CALL DR_HOOK('SFX_XIOS_SETUP',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
+!
+#ifndef WXIOS
+!
+IF (LXIOS) THEN
+ CALL ABOR1_SFX('SFX_XIOS_INIT_CONTEXT : cannot setup : Surfex was compiled without XIOS support')
+ELSE
+ LXIOS_DEF_CLOSED=.TRUE.
+ENDIF
+!
+#else
+!
+LXIOS_DEF_CLOSED=.FALSE.
+!
+! -----------------------------------------------------------------------------
+!
+! Set Xios context to Surfex's one
+!
+! -----------------------------------------------------------------------------
+!
+!$OMP SINGLE
+!
+!#ifndef CPLOASIS
+! CALL XIOS_INITIALIZE('surfex', return_comm=KCOMM)
+!#endif
+
+ CALL XIOS_CONTEXT_INITIALIZE(YXIOS_CONTEXT, KCOMM)
+ CALL XIOS_GET_HANDLE(YXIOS_CONTEXT, TXIOS_CONTEXT)
+ CALL XIOS_SET_CURRENT_CONTEXT(TXIOS_CONTEXT)
+!
+
+! -----------------------------------------------------------------------------
+!
+! Set date for XIOS
+!
+! -----------------------------------------------------------------------------
+!
+INHOURS = INT(PTIME/3600)
+INMINUTES = INT((PTIME - INHOURS*3600)/60)
+INSECONDS = INT(PTIME - INHOURS*3600 - INMINUTES*60)
+!
+!WRITE(KLUOUT,*) 'initializing xios calendar '
+
+! For XIOS-2.0 :
+ CALL XIOS_DEFINE_CALENDAR("Gregorian", &
+ start_date = xios_date(KYEAR,KMONTH,KDAY,INHOURS,INMINUTES,INSECONDS), &
+ time_origin = xios_date(KYEAR,KMONTH,KDAY,INHOURS,INMINUTES,INSECONDS))
+!
+! -----------------------------------------------------------------------------
+!
+! Set duration between 2 calls to write_diag_surf
+!
+! -----------------------------------------------------------------------------
+!
+IF (XIOS_GETVAR("timesteps_between_samples",ITMP)) NBASE_XIOS_FREQ=ITMP
+!
+TDTIME%SECOND = INT(PTSTEP*NBASE_XIOS_FREQ)
+ CALL XIOS_SET_TIMESTEP(TDTIME)
+!
+!$OMP END SINGLE
+!
+!
+! ---------------------------------------------------------------------------------
+!
+! Declare a 'full' domain and one domain per tile
+!
+! ---------------------------------------------------------------------------------
+!
+ CALL SFX_XIOS_SET_DOMAIN(YSC%UG%G%CGRID, "FULL" , KDIM1, KDIM2, KEXT1, KXINDEX, ODXMASK, &
+ YSC%UG%G%XLON, YSC%UG%G%XLAT, PCLON, PCLAT )
+ CALL SFX_XIOS_SET_DOMAIN(YSC%UG%G%CGRID, "SEA" , KDIM1, KDIM2, KEXT1, KXINDEX, ODXMASK, &
+ YSC%UG%G%XLON, YSC%UG%G%XLAT, PCLON, PCLAT, KMASK=KMASKSEA )
+ CALL SFX_XIOS_SET_DOMAIN(YSC%UG%G%CGRID, "NATURE", KDIM1, KDIM2, KEXT1, KXINDEX, ODXMASK, &
+ YSC%UG%G%XLON, YSC%UG%G%XLAT, PCLON, PCLAT, KMASK=KMASKNAT)
+ CALL SFX_XIOS_SET_DOMAIN(YSC%UG%G%CGRID, "WATER" , KDIM1, KDIM2, KEXT1, KXINDEX, ODXMASK, &
+ YSC%UG%G%XLON, YSC%UG%G%XLAT , PCLON, PCLAT, KMASK=KMASKWAT )
+ CALL SFX_XIOS_SET_DOMAIN(YSC%UG%G%CGRID, "TOWN" , KDIM1, KDIM2, KEXT1, KXINDEX, ODXMASK, &
+ YSC%UG%G%XLON, YSC%UG%G%XLAT , PCLON, PCLAT, KMASK=KMASKTOWN )
+!
+! Declare axes, depending on activated schemes
+!
+!IF (YSC%U%NDIM_NATURE>0) THEN
+ CALL SET_AXIS(YPATCH_DIM_NAME , KSIZE=SIZE(YSC%IM%NPE%AL))
+ CALL SET_AXIS(YGROUND_LAYER_DIM_NAME , KSIZE=SIZE(YSC%IM%NPE%AL(1)%XTG,2))
+ CALL SET_AXIS(YWGROUND_LAYER_DIM_NAME, KSIZE=SIZE(YSC%IM%NPE%AL(1)%XWG,2))
+ CALL SET_AXIS(YWIGROUND_LAYER_DIM_NAME, KSIZE=SIZE(YSC%IM%NPE%AL(1)%XWG,2))
+ CALL SET_AXIS(YSWBAND_DIM_NAME, KSIZE=SIZE(YSC%IM%ID%D%XSWBD,2))
+ ! CALL SET_AXIS(YSNOW_PATCH_DIM_NAME, KSIZE=)
+!ENDIF
+!IF (YSC%U%NDIM_SEA>0) THEN
+ ! CALL SET_AXIS(YSEAICE_LAYER_DIM_NAME, KSIZE=)
+!ENDIF
+!
+! Force XIOS inheritance inorder that fields declarations can
+! fully account for user settings
+!
+! CALL XIOS_SOLVE_INHERITANCE()
+#endif
+!
+IF (LHOOK) CALL DR_HOOK('SFX_XIOS_SETUP',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE SFX_XIOS_SETUP
diff --git a/src/SURFEX/snow3L_isba.F90 b/src/SURFEX/snow3L_isba.F90
index 06320832b681daaf5bc293c9a7684b12dd220fa9..adc51bec59fc5ba271e5bb72f907b7414a27ef5a 100644
--- a/src/SURFEX/snow3L_isba.F90
+++ b/src/SURFEX/snow3L_isba.F90
@@ -3,25 +3,15 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE SNOW3L_ISBA(HISBA, HSNOW_ISBA, HSNOWRES, OMEB, OGLACIER, HIMPLICIT_WIND, &
- TPTIME, PTSTEP, PVEGTYPE, &
- PSNOWSWE, PSNOWHEAT, PSNOWRHO, PSNOWALB, &
- PSNOWGRAN1, PSNOWGRAN2, PSNOWHIST,PSNOWAGE, &
- PTG, PCG, PCT, PSOILHCAPZ, PSOILCONDZ, &
- PPS, PTA, PSW_RAD, PQA, PVMOD, PLW_RAD, PRR, PSR, &
- PRHOA, PUREF, PEXNS, PEXNA, PDIRCOSZW, PLVTT, PLSTT, &
- PZREF, PZ0NAT, PZ0EFF, PZ0HNAT, PALB, PD_G, PDZG, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
- PTHRUFAL, PGRNDFLUX, PFLSN_COR, PGSFCSNOW, PEVAPCOR, &
- PSWNETSNOW, PSWNETSNOWS, PLWNETSNOW, &
- PRNSNOW, PHSNOW, PGFLUXSNOW, PHPSNOW, PLES3L, PLEL3L, PEVAP, &
- PSNDRIFT, PUSTARSNOW, PPSN, PSRSFC, PRRSFC, PSNOWSFCH, &
- PDELHEATN, PDELHEATN_SFC, &
- PEMISNOW, PCDSNOW, PCHSNOW, PSNOWTEMP, PSNOWLIQ, PSNOWDZ, &
- PSNOWHMASS, PRI, PZENITH, PDELHEATG, PDELHEATG_SFC, PLAT, PLON, PQS,&
- OSNOWDRIFT,OSNOWDRIFT_SUBLIM,OSNOW_ABS_ZENITH, &
- HSNOWMETAMO, HSNOWRAD )
+SUBROUTINE SNOW3L_ISBA(IO, G, PK, PEK, DK, DEK, DMK, OMEB, HIMPLICIT_WIND, &
+ TPTIME, PTSTEP, PVEGTYPE, PTG, PCT, PSOILHCAPZ, &
+ PSOILCONDZ, PPS, PTA, PSW_RAD, PQA, PVMOD, PLW_RAD, PRR, &
+ PSR, PRHOA, PUREF, PEXNS, PEXNA, PDIRCOSZW, PZREF, &
+ PALB, PD_G, PDZG, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, &
+ PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, PTHRUFAL, &
+ PGRNDFLUX, PFLSN_COR, PGSFCSNOW, PEVAPCOR, PLES3L, PLEL3L,&
+ PEVAP, PSNOWSFCH, PDELHEATN, PDELHEATN_SFC, PRI, PZENITH, &
+ PDELHEATG, PDELHEATG_SFC, PQS )
! ######################################################################################
!
!!**** *SNOW3L_ISBA*
@@ -74,9 +64,16 @@ SUBROUTINE SNOW3L_ISBA(HISBA, HSNOW_ISBA, HSNOWRES, OMEB, OGLACIER, HIMPLICIT_WI
!! Modified by B. Decharme (08/2013): Qsat as argument (needed for coupling with atm)
!! Modified by A. Boone (10/2014): MEB: pass in fluxes when using MEB
!! Modified by B. Decharme (03/2016): No snowdrift under forest
-!!
+!! Modified by M. Lafaysse (08/2015): MEB-Crocus coupling
!-------------------------------------------------------------------------------
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_ISBA_n, ONLY : ISBA_PE_t, ISBA_P_t
+USE MODD_DIAG_n, ONLY : DIAG_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
+!
USE MODD_CSTS, ONLY : XTT, XPI, XDAY, XLMTT, XLSTT
USE MODD_SNOW_PAR, ONLY : XRHOSMAX_ES, XSNOWDMIN, XRHOSMIN_ES, XEMISSN
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -89,6 +86,11 @@ USE MODD_DATA_COVER_PAR, ONLY : NVT_SNOW, &
!
USE MODI_SNOW3L
USE MODI_SNOWCRO
+USE MODI_SNOWCRO_DIAG
+!
+#ifdef SFX_OL
+USE MODN_IO_OFFLINE, ONLY : XTSTEP_OUTPUT
+#endif
!
USE MODI_ABOR1_SFX
!
@@ -101,46 +103,38 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-REAL, INTENT(IN) :: PTSTEP
-! PTSTEP = time step of the integration
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE ! fraction of each vegetation
-!
- CHARACTER(LEN=*), INTENT(IN) :: HISBA
-! HISBA = FLAG to use Force-Restore or DIFfusion
-! soil heat and mass transfer method
-!
- CHARACTER(LEN=*), INTENT(IN) :: HSNOW_ISBA
-! HSNOW_ISBA = FLAG to use SNOW3L or not
-! (or default FR method)
-!
- CHARACTER(LEN=*), INTENT(IN) :: HSNOWRES
-! HSNOWRES = ISBA-SNOW3L turbulant exchange option
-! 'DEF' = Default: Louis (ISBA: Noilhan and Mahfouf 1996)
-! 'RIL' = Limit Richarson number under very stable
-! conditions (currently testing)
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(GRID_t), INTENT(INOUT) :: G
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(DIAG_t), INTENT(INOUT) :: DK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK
!
LOGICAL, INTENT(IN) :: OMEB ! True = coupled to MEB. This means surface fluxes ae IMPOSED
! ! as an upper boundary condition to the explicit snow schemes.
! ! If = False, then energy
! ! budget and fluxes are computed herein.
-!
-LOGICAL, INTENT(IN) :: OGLACIER ! True = Over permanent snow and ice,
-! initialise WGI=WSAT,
-! Hsnow>=10m and allow 0.8<SNOALB<0.85
!
CHARACTER(LEN=*), INTENT(IN) :: HIMPLICIT_WIND ! wind implicitation option
! ! 'OLD' = direct
! ! 'NEW' = Taylor serie, order 1
!
TYPE(DATE_TIME), INTENT(IN) :: TPTIME ! current date and time
+REAL, INTENT(IN) :: PTSTEP
+! PTSTEP = time step of the integration
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE ! fraction of each vegetation
!
!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PTG
+! PTG = Soil temperature profile (K)
+!
REAL, DIMENSION(:,:), INTENT(IN) :: PSOILHCAPZ, PD_G, PDZG
-REAL, DIMENSION(:), INTENT(IN) :: PCG, PCT, PSOILCONDZ
+REAL, DIMENSION(:), INTENT(IN) :: PCT, PSOILCONDZ
! PD_G = Depth to bottom of each soil layer (m)
! PDZG = Soil layer thicknesses (m)
-! PCG = area-averaged soil heat capacity [(K m2)/J]
+! DMK%XCG = area-averaged soil heat capacity [(K m2)/J]
! PCT = area-averaged surface heat capacity [(K m2)/J]
! PSOILCONDZ= soil thermal conductivity (W m-1 K-1)
! PSOILHCAPZ= soil heat capacity (J m-3 K-1)
@@ -157,11 +151,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PPS, PTA, PSW_RAD, PQA,
! PQA = atmospheric specific humidity
! at level za
!
-REAL, DIMENSION(:), INTENT(IN) :: PZREF, PUREF, PEXNS, PEXNA, PDIRCOSZW, PRHOA, PZ0NAT, PZ0EFF, PZ0HNAT, PALB, &
- PLVTT, PLSTT
-! PZ0EFF = roughness length for momentum
-! PZ0NAT = grid box average roughness length
-! PZ0HNAT = grid box average roughness length
+REAL, DIMENSION(:), INTENT(IN) :: PZREF, PUREF, PEXNS, PEXNA, PDIRCOSZW, PRHOA, PALB
! PZREF = reference height of the first
! atmospheric level
! PUREF = reference height of the wind
@@ -171,11 +161,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PZREF, PUREF, PEXNS, PEXNA, PDIRCOSZW, PR
! PDIRCOSZW = Cosinus of the angle between the
! normal to the surface and the vertical
! PALB = soil/vegetation albedo
-! PLVTT = latent heat of vaporization-hydrology (J/kg)
-! PLSTT = latent heat of sublimation-hydrology (J/kg)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PPSN
-! PPSN = Snow cover fraction (total)
!
REAL, DIMENSION(:), INTENT(IN) :: PPEW_A_COEF, PPEW_B_COEF, &
PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
@@ -187,58 +172,20 @@ REAL, DIMENSION(:), INTENT(IN) :: PPEW_A_COEF, PPEW_B_COEF,
! PPEQ_A_COEF = A-air specific humidity coefficient
! PPEQ_B_COEF = B-air specific humidity coefficient !
!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTG
-! PTG = Soil temperature profile (K)
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PSNOWALB
-! PSNOWALB = Prognostic surface snow albedo
-! (does not include anything but
-! the actual snow cover)
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWHEAT, PSNOWRHO, PSNOWSWE
-! PSNOWHEAT = Snow layer(s) heat content (J/m3)
-! PSNOWRHO = Snow layer(s) averaged density (kg/m3)
-! PSNOWSWE = Snow layer(s) liquid Water Equivalent (SWE:kg m-2)
-!
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWGRAN1, PSNOWGRAN2, PSNOWHIST
-! PSNOWGRAN1 = Snow layer(s) grain parameter 1
-! PSNOWGRAN2 = Snow layer(s) grain parameter 2
-! PSNOWHIST = Snow layer(s) grain historical parameter
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWAGE ! Snow grain age
-!
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PRNSNOW, PHSNOW, PLES3L, PLEL3L, &
- PHPSNOW, PEMISNOW, PEVAP, PGRNDFLUX, PSWNETSNOW, &
- PLWNETSNOW, PSWNETSNOWS, PDELHEATG, PDELHEATG_SFC
+REAL, DIMENSION(:), INTENT(INOUT) :: PLES3L, PLEL3L, PEVAP, PGRNDFLUX, PDELHEATG, PDELHEATG_SFC
! PLEL3L = evaporation heat flux from snow (W/m2)
! PLES3L = sublimation (W/m2)
-! PHPSNOW = heat release from rainfall (W/m2)
-! PRNSNOW = net radiative flux from snow (W/m2)
-! PHSNOW = sensible heat flux from snow (W/m2)
-! PEMISNOW = snow surface emissivity
! PEVAP = total evaporative flux from snow (kg/m2/s)
! PGRNDFLUX = soil/snow interface heat flux (W/m2)
-! PSWNETSNOW = net shortwave radiation entering top of snowpack (W/m2)
-! PSWNETSNOWS = net shortwave radiation in uppermost layer of snowpack (W/m2)
-! (for surface energy budget closure diagnostics)
-! PLWNETSNOW = net longwave radiation entering top of snowpack (W/m2)
! PDELHEATG = ground heat content change (diagnostic) (W/m2)
! note, modified if ground-snow flux adjusted
! PDELHEATG_SFC = ground heat content change in sfc only (diagnostic) (W/m2)
! note, modified if ground-snow flux adjusted
!
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUXSNOW
-! PGFLUXSNOW = net heat flux from snow (W/m2)
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PUSTARSNOW, PCDSNOW, PCHSNOW, PRI
-! PCDSNOW = drag coefficient for momentum over snow (-)
-! PUSTARSNOW = friction velocity over snow (m/s)
-! PCHSNOW = drag coefficient for heat over snow (-)
+REAL, DIMENSION(:), INTENT(INOUT) :: PRI
! PRI = Richardson number (-)
!
-REAL, DIMENSION(:), INTENT(OUT) :: PTHRUFAL, PFLSN_COR, PEVAPCOR, PSNOWHMASS, PGSFCSNOW
+REAL, DIMENSION(:), INTENT(OUT) :: PTHRUFAL, PFLSN_COR, PEVAPCOR, PGSFCSNOW
! PTHRUFAL = rate that liquid water leaves snow pack:
! paritioned into soil infiltration/runoff
! by ISBA [kg/(m2 s)]
@@ -248,24 +195,10 @@ REAL, DIMENSION(:), INTENT(OUT) :: PTHRUFAL, PFLSN_COR, PEVAPCOR, PSNOWHMASS
! actual snow cover (as snow vanishes)
! and apply it as a surface soil water
! sink. [kg/(m2 s)]
-! PSNOWHMASS = heat content change due to mass
-! changes in snowpack (J/m2): for budget
-! calculations only.
! PGSFCSNOW = heat flux between the surface and sub-surface
! snow layers (for energy budget diagnostics) (W/m2)
!
-REAL, DIMENSION(:), INTENT(OUT) :: PSNDRIFT
-! PSNDRIFT = blowing snow sublimation (kg/m2/s)
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PSRSFC, PRRSFC, PSNOWSFCH, PDELHEATN, PDELHEATN_SFC
-! PSRSFC = snow rate on soil/veg surface when SNOW3L in use
-! PRRSFC = rain rate on soil/veg surface when SNOW3L in use
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWTEMP
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSNOWLIQ, PSNOWDZ
-! PSNOWLIQ = Snow layer(s) liquid water content (m)
-! PSNOWTEMP = Snow layer(s) temperature (m)
-! PSNOWDZ = Snow layer(s) thickness (m)
+REAL, DIMENSION(:), INTENT(OUT) :: PSNOWSFCH, PDELHEATN, PDELHEATN_SFC
!
REAL, DIMENSION(:), INTENT(OUT) :: PQS
! PQS = surface humidity (kg/kg)
@@ -273,25 +206,7 @@ REAL, DIMENSION(:), INTENT(OUT) :: PQS
! ajout_EB pour prendre en compte angle zenithal du soleil dans LRAD
! puis plus tard dans LALB
REAL, DIMENSION(:), INTENT(IN) :: PZENITH ! solar zenith angle
-REAL, DIMENSION(:), INTENT(IN) :: PLAT
-REAL, DIMENSION(:), INTENT(IN) :: PLON
-!
-LOGICAL, INTENT(IN) :: OSNOWDRIFT, OSNOWDRIFT_SUBLIM ! activate snowdrift, sublimation during drift
-LOGICAL, INTENT(IN) :: OSNOW_ABS_ZENITH ! activate parametrization of solar absorption for polar regions
- CHARACTER(3), INTENT(IN) :: HSNOWMETAMO, HSNOWRAD
- !-----------------------
- ! Crocus metamorphism scheme
- ! HSNOWMETAMO=B92 Brun et al 1992
- ! HSNOWMETAMO=C13 Carmagnola et al 2014
- ! HSNOWMETAMO=T07 Taillandier et al 2007
- ! HSNOWMETAMO=F06 Flanner et al 2006
- !-----------------------
- ! Crocus radiative transfer scheme
- ! HSNOWMETAMO=B92 Brun et al 1992
- ! HSNOWMETAMO=TAR TARTES (Libois et al 2013)
- ! HSNOWMETAMO=TA1 TARTES with constant impurities
- ! HSNOWMETAMO=TA2 TARTES with constant impurities as function of ageing
-
+!
!* 0.2 declarations of local variables
!
REAL, PARAMETER :: ZCHECK_TEMP = 50.0
@@ -306,7 +221,7 @@ REAL, DIMENSION(SIZE(PTA)) :: ZRRSNOW, ZSOILCOND, ZSNOW, ZSNOWFALL, &
ZSNOWABLAT_DELTA, ZSNOWSWE_1D, ZSNOWD, &
ZSNOWH, ZSNOWH1, ZGRNDFLUXN, ZPSN, &
ZSOILCOR, ZSNOWSWE_OUT, ZTHRUFAL, &
- ZSNOW_MASS_BUDGET
+ ZSNOW_MASS_BUDGET, ZWGHT, ZWORK, ZC2
! ZSOILCOND = soil thermal conductivity [W/(m K)]
! ZRRSNOW = rain rate over snow [kg/(m2 s)]
! ZSNOW = snow depth (m)
@@ -327,6 +242,11 @@ REAL, DIMENSION(SIZE(PTA)) :: ZRRSNOW, ZSOILCOND, ZSNOW, ZSNOWFALL, &
! to maintain an accurate water
! balance [kg/(m2 s)]
! ZSNOW_MASS_BUDGET = snow water equivalent budget (kg/m2/s)
+! ZWGHT = MEB surface layer weight for distributing energy
+! between litter and ground layers for the case
+! of total ablation during a timestep (-).
+! ZWORK = local working variable (*)
+! ZC2 = sub-surface heat capacity [(K m2)/J]
!
!* 0.3 declarations of packed variables
!
@@ -335,6 +255,10 @@ INTEGER, DIMENSION(SIZE(PTA)) :: NMASK ! indices correspondance betwee
!
LOGICAL, DIMENSION(SIZE(PTA)) :: LREMOVE_SNOW
!
+REAL, DIMENSION(SIZE(PTA)) :: ZSWNET_N, ZSWNET_NS, ZLWNET_N
+!
+LOGICAL :: GCOMPUTECRODIAG ! flag to compute Crocus-MEPRA diagnostics
+!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
! - - ---------------------------------------------------
@@ -344,13 +268,24 @@ IF (LHOOK) CALL DR_HOOK('SNOW3L_ISBA',0,ZHOOK_HANDLE)
!* 0. Initialize variables:
! ---------------------
!
+IF (SIZE(DMK%XSNOWDEND)>0) THEN
+ DMK%XSNOWDEND (:,:) = XUNDEF
+ DMK%XSNOWSPHER(:,:) = XUNDEF
+ DMK%XSNOWSIZE (:,:) = XUNDEF
+ DMK%XSNOWSSA (:,:) = XUNDEF
+ DMK%XSNOWRAM (:,:) = XUNDEF
+ DMK%XSNOWSHEAR(:,:) = XUNDEF
+ DMK%XSNOWTYPEMEPRA(:,:) = XUNDEF
+ENDIF
+!
+DEK%XSNDRIFT(:) = 0.0
+DMK%XSNOWHMASS(:) = 0.0
+DMK%XSRSFC(:) = PSR(:) ! these are snow and rain rates passed to ISBA,
+DMK%XRRSFC(:) = PRR(:) ! so initialize here if SNOW3L not used:
+!
PFLSN_COR(:) = 0.0
PTHRUFAL(:) = 0.0
PEVAPCOR(:) = 0.0
-PSNDRIFT(:) = 0.0
-PSNOWHMASS(:) = 0.0
-PSRSFC(:) = PSR(:) ! these are snow and rain rates passed to ISBA,
-PRRSFC(:) = PRR(:) ! so initialize here if SNOW3L not used:
PQS(:) = XUNDEF
!
ZSNOW(:) = 0.0
@@ -364,77 +299,93 @@ ZSOILCOND(:) = 0.0
ZRRSNOW(:) = 0.0
ZSNOWFALL(:) = 0.0
ZSNOWABLAT_DELTA(:) = 0.0
-PSNOWLIQ(:,:) = 0.0
-PSNOWDZ(:,:) = 0.0
!
-INLVLS = SIZE(PSNOWSWE(:,:),2)
-INLVLG = MIN(SIZE(PD_G(:,:),2),SIZE(PTG(:,:),2))
+ZWGHT(:) = 0.0
+ZWORK(:) = 0.0
+ZC2(:) = PCT(:)
!
-IF(.NOT.OMEB)THEN
+DMK%XSNOWLIQ(:,:) = 0.0
+DMK%XSNOWDZ(:,:) = 0.0
!
-! If MEB activated, these values are input, else initialize here:
-!
- PGRNDFLUX(:) = 0.0
- PLES3L(:) = 0.0
- PLEL3L(:) = 0.0
- PEVAP(:) = 0.0
- PRNSNOW(:) = 0.0
- PHSNOW(:) = 0.0
- PGFLUXSNOW(:) = 0.0
- PHPSNOW(:) = 0.0
- PSWNETSNOW(:) = 0.0
- PSWNETSNOWS(:) = 0.0
- PLWNETSNOW(:) = 0.0
- PEMISNOW(:) = XEMISSN
- PUSTARSNOW(:) = 0.0
- PCDSNOW(:) = 0.0
- PCHSNOW(:) = 0.0
- PRI(:) = XUNDEF
-END IF
+INLVLS = SIZE(PEK%TSNOW%WSNOW(:,:),2)
+INLVLG = MIN(SIZE(PD_G(:,:),2),SIZE(PTG(:,:),2))
!
!
+IF(.NOT.OMEB)THEN
+ !
+ ! If MEB activated, these values are input, else initialize here:
+ !
+ PGRNDFLUX(:) = 0.0
+ PLES3L(:) = 0.0
+ PLEL3L(:) = 0.0
+ PEVAP(:) = 0.0
+ PRI(:) = XUNDEF
+ PEK%TSNOW%EMIS(:) = XEMISSN
+ DMK%XRNSNOW(:) = 0.0
+ DMK%XHSNOW(:) = 0.0
+ DMK%XGFLUXSNOW(:) = 0.0
+ DMK%XHPSNOW(:) = 0.0
+ DMK%XUSTARSNOW(:) = 0.0
+ DMK%XCDSNOW(:) = 0.0
+ DMK%XCHSNOW(:) = 0.0
+ !
+ENDIF
+!
! Use ISBA-SNOW3L or NOT: NOTE that if explicit soil diffusion method in use,
! then *must* use explicit snow model:
!
-IF (HSNOW_ISBA=='3-L' .OR. HISBA == 'DIF' .OR. HSNOW_ISBA == 'CRO') THEN
+IF (PEK%TSNOW%SCHEME=='3-L' .OR. IO%CISBA == 'DIF' .OR. PEK%TSNOW%SCHEME == 'CRO') THEN
!
+ IF(.NOT.OMEB)THEN
+ !
+ ! If MEB activated, these values are input, else initialize here:
+ !
+ ZSWNET_N(:) = 0.0
+ ZSWNET_NS(:) = 0.0
+ ZLWNET_N(:) = 0.0
+ ELSE
+ ZSWNET_N(:) = DEK%XSWNET_N(:)
+ ZSWNET_NS(:) = DEK%XSWNET_NS(:)
+ ZLWNET_N(:) = DEK%XLWNET_N(:)
+ END IF
+
! - Snow and rain falling onto the 3-L grid space:
!
- PSRSFC(:)=0.0
+ DMK%XSRSFC(:) = 0.0
!
- DO JJ=1,SIZE(PSR)
- ZRRSNOW(JJ) = PPSN(JJ)*PRR(JJ)
- PRRSFC(JJ) = PRR(JJ) - ZRRSNOW(JJ)
- ZSNOWFALL(JJ) = PSR(JJ)*PTSTEP/XRHOSMAX_ES ! maximum possible snowfall depth (m)
- ENDDO
+ DO JJ=1,SIZE(PSR)
+ ZRRSNOW(JJ) = PEK%XPSN(JJ)*PRR(JJ)
+ DMK%XRRSFC(JJ) = PRR(JJ) - ZRRSNOW(JJ)
+ ZSNOWFALL(JJ) = PSR(JJ)*PTSTEP/XRHOSMAX_ES ! maximum possible snowfall depth (m)
+ ENDDO
!
! Calculate preliminary snow depth (m)
- ZSNOW(:)=0.
- ZSNOWH(:)=0.
- ZSNOWSWE_1D(:)=0.
- ZSNOWH1(:) = PSNOWHEAT(:,1)*PSNOWSWE(:,1)/PSNOWRHO(:,1) ! sfc layer only
-!
- DO JWRK=1,SIZE(PSNOWSWE,2)
- DO JJ=1,SIZE(PSNOWSWE,1)
- ZSNOWSWE_1D(JJ) = ZSNOWSWE_1D(JJ) + PSNOWSWE(JJ,JWRK)
- ZSNOW(JJ) = ZSNOW(JJ) + PSNOWSWE(JJ,JWRK)/PSNOWRHO(JJ,JWRK)
- ZSNOWH(JJ) = ZSNOWH(JJ) + PSNOWHEAT(JJ,JWRK)*PSNOWSWE(JJ,JWRK)/PSNOWRHO(JJ,JWRK)
- END DO
- ENDDO
+ ZSNOW(:) =0.
+ ZSNOWH(:) =0.
+ ZSNOWSWE_1D(:)=0.
+ ZSNOWH1(:) = PEK%TSNOW%HEAT(:,1)*PEK%TSNOW%WSNOW(:,1)/PEK%TSNOW%RHO(:,1) ! sfc layer only
+!
+ DO JWRK=1,SIZE(PEK%TSNOW%WSNOW(:,:),2)
+ DO JJ=1,SIZE(PEK%TSNOW%WSNOW(:,:),1)
+ ZSNOWSWE_1D(JJ) = ZSNOWSWE_1D(JJ) + PEK%TSNOW%WSNOW(JJ,JWRK)
+ ZSNOW(JJ) = ZSNOW(JJ) + PEK%TSNOW%WSNOW(JJ,JWRK)/PEK%TSNOW%RHO(JJ,JWRK)
+ ZSNOWH(JJ) = ZSNOWH(JJ) + PEK%TSNOW%HEAT (JJ,JWRK)*PEK%TSNOW%WSNOW(JJ,JWRK)/PEK%TSNOW%RHO(JJ,JWRK)
+ END DO
+ ENDDO
!
- IF(HISBA == 'DIF')THEN
- ZSOILCOND(:) = PSOILCONDZ(:)
- ELSE
+ IF(IO%CISBA == 'DIF')THEN
+ ZSOILCOND(:) = PSOILCONDZ(:)
+ ELSE
!
! - Soil thermal conductivity
! is implicit in Force-Restore soil method, so it
! must be backed-out of surface thermal coefficients
! (Etchevers and Martin 1997):
!
- ZSOILCOND(:) = 4.*XPI/( PCG(:)*PCG(:)*XDAY/(PD_G(:,1)*PCT(:)) )
+ ZSOILCOND(:) = 4.*XPI/( DMK%XCG(:)*DMK%XCG(:)*XDAY/(PD_G(:,1)*PCT(:)) )
!
- ENDIF
+ ENDIF
!
! ===============================================================
! === Packing: Only call snow model when there is snow on the surface
@@ -445,17 +396,17 @@ IF (HSNOW_ISBA=='3-L' .OR. HISBA == 'DIF' .OR. HSNOW_ISBA == 'CRO') THEN
! counts the number of points where the computations will be made
!
!
- ISIZE_SNOW = 0
- NMASK(:) = 0
+ ISIZE_SNOW = 0
+ NMASK(:) = 0
!
- DO JJ=1,SIZE(ZSNOW)
- IF (ZSNOW(JJ) >= XSNOWDMIN .OR. ZSNOWFALL(JJ) >= XSNOWDMIN) THEN
- ISIZE_SNOW = ISIZE_SNOW + 1
- NMASK(ISIZE_SNOW) = JJ
- ENDIF
- ENDDO
+ DO JJ=1,SIZE(ZSNOW)
+ IF (ZSNOW(JJ) >= XSNOWDMIN .OR. ZSNOWFALL(JJ) >= XSNOWDMIN) THEN
+ ISIZE_SNOW = ISIZE_SNOW + 1
+ NMASK(ISIZE_SNOW) = JJ
+ ENDIF
+ ENDDO
!
- IF (ISIZE_SNOW>0) CALL CALL_MODEL(ISIZE_SNOW,INLVLS,INLVLG,NMASK)
+ IF (ISIZE_SNOW>0) CALL CALL_MODEL(ISIZE_SNOW,INLVLS,INLVLG,NMASK)
!
! ===============================================================
!
@@ -464,91 +415,108 @@ IF (HSNOW_ISBA=='3-L' .OR. HISBA == 'DIF' .OR. HSNOW_ISBA == 'CRO') THEN
! If MEB used, soil T already computed, therefore correct heating/cooling
! effect of updated snow-soil flux
!
- ZSNOWD(:) = 0.
- ZSNOWSWE_OUT(:) = 0.
- DO JWRK=1,SIZE(PSNOWSWE,2)
- DO JJ=1,SIZE(PSNOWSWE,1)
- ZSNOWD (JJ) = ZSNOWD (JJ) + PSNOWSWE(JJ,JWRK)/PSNOWRHO(JJ,JWRK)
- ZSNOWSWE_OUT(JJ) = ZSNOWSWE_OUT(JJ) + PSNOWSWE(JJ,JWRK)
- ENDDO
- END DO
+ ZSNOWD(:) = 0.
+ ZSNOWSWE_OUT(:) = 0.
+ DO JWRK=1,SIZE(PEK%TSNOW%WSNOW(:,:),2)
+ DO JJ=1,SIZE(PEK%TSNOW%WSNOW(:,:),1)
+ ZSNOWD (JJ) = ZSNOWD (JJ) + PEK%TSNOW%WSNOW(JJ,JWRK)/PEK%TSNOW%RHO(JJ,JWRK)
+ ZSNOWSWE_OUT(JJ) = ZSNOWSWE_OUT(JJ) + PEK%TSNOW%WSNOW(JJ,JWRK)
+ ENDDO
+ END DO
!
- LREMOVE_SNOW(:)=(ZSNOWD(:)<XSNOWDMIN*1.1)
+ LREMOVE_SNOW(:)=(ZSNOWD(:)<XSNOWDMIN*1.1)
!
!
- IF(OMEB)THEN
- ZPSN(:)=1.0
- ELSE
+ IF(OMEB)THEN
+ ZPSN(:) = 1.0
+ IF(IO%CISBA == 'DIF')THEN
+ ZWGHT(:) = PSOILHCAPZ(:,2)*PDZG(:,2)/(PSOILHCAPZ(:,1)*PDZG(:,1) + PSOILHCAPZ(:,2)*PDZG(:,2))
+ ZC2(:) = 1/(PSOILHCAPZ(:,2)*PDZG(:,2))
+ ELSE
+ ZWGHT(:) = (PD_G(:,2)-PD_G(:,1))/PD_G(:,2)
+ ENDIF
+ ELSE
! To Conserve mass in ISBA without MEB,
! EVAP must be weignted by the snow fraction
! in the calulation of THRUFAL
- ZPSN(:)=PPSN(:)
- ENDIF
-!
- ZSNOWABLAT_DELTA(:) = 0.0
- ZTHRUFAL (:) = PTHRUFAL(:)
-!
- WHERE(LREMOVE_SNOW(:))
- ZSNOWSWE_OUT(:) = 0.0
- PLES3L(:) = MIN(PLES3L(:), XLSTT*(ZSNOWSWE_1D(:)/PTSTEP + PSR(:)))
- PLEL3L(:) = 0.0
- PEVAP(:) = PLES3L(:)/PLSTT(:)
- PTHRUFAL(:) = MAX(0.0, ZSNOWSWE_1D(:)/PTSTEP + PSR(:) - PEVAP(:)*ZPSN(:) + ZRRSNOW(:)) ! kg m-2 s-1
- ZTHRUFAL(:) = MAX(0.0, ZSNOWSWE_1D(:)/PTSTEP + PSR(:) - PEVAP(:) + ZRRSNOW(:)) ! kg m-2 s-1
- PSRSFC(:) = 0.0
- PRRSFC(:) = PRRSFC(:)
- ZSNOWABLAT_DELTA(:) = 1.0
- PSNOWALB(:) = XUNDEF
- PEVAPCOR(:) = 0.0
- ZSOILCOR(:) = 0.0
- PGFLUXSNOW(:) = PRNSNOW(:) - PHSNOW(:) - PLES3L(:) - PLEL3L(:)
- PSNOWHMASS(:) = -PSR(:)*(XLMTT*PTSTEP)
- PGSFCSNOW(:) = 0.0
- PDELHEATN(:) = -ZSNOWH(:) /PTSTEP
- PDELHEATN_SFC(:) = -ZSNOWH1(:)/PTSTEP
- PSNOWSFCH(:) = PDELHEATN_SFC(:) - (PSWNETSNOWS(:) + PLWNETSNOW(:) &
- - PHSNOW(:) - PLES3L(:) - PLEL3L(:)) + PGSFCSNOW(:) &
- - PSNOWHMASS(:)/PTSTEP
- ZGRNDFLUXN(:) = (ZSNOWH(:)+PSNOWHMASS(:))/PTSTEP + PGFLUXSNOW(:)
- PTG(:,1) = PTG(:,1) + PTSTEP*PCT(:)*ZPSN(:)*(ZGRNDFLUXN(:) - PGRNDFLUX(:) - PFLSN_COR(:))
- PDELHEATG(:) = PDELHEATG(:) + ZPSN(:)*(ZGRNDFLUXN(:) - PGRNDFLUX(:) - PFLSN_COR(:))
- PDELHEATG_SFC(:) = PDELHEATG_SFC(:) + ZPSN(:)*(ZGRNDFLUXN(:) - PGRNDFLUX(:) - PFLSN_COR(:))
- PGRNDFLUX(:) = ZGRNDFLUXN(:)
- PFLSN_COR(:) = 0.0
- END WHERE
-!
-!
- DO JWRK=1,INLVLS
- DO JJ=1,SIZE(PSNOWSWE,1)
- PSNOWSWE (JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PSNOWSWE(JJ,JWRK)
- PSNOWHEAT(JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PSNOWHEAT(JJ,JWRK)
- PSNOWRHO (JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PSNOWRHO(JJ,JWRK) + &
+ ZPSN(:) = PEK%XPSN(:)
+ ENDIF
+!
+ ZSNOWABLAT_DELTA(:) = 0.0
+ ZTHRUFAL (:) = PTHRUFAL(:)
+!
+ WHERE(LREMOVE_SNOW(:))
+ !
+ ZSNOWSWE_OUT(:) = 0.0
+ PLES3L(:) = MIN(PLES3L(:), XLSTT*(ZSNOWSWE_1D(:)/PTSTEP + PSR(:)))
+ PLEL3L(:) = 0.0
+ PEVAP(:) = PLES3L(:)/PK%XLSTT(:)
+ PTHRUFAL(:) = MAX(0.0, ZSNOWSWE_1D(:)/PTSTEP + PSR(:) - PEVAP(:)*ZPSN(:) + ZRRSNOW(:)) ! kg m-2 s-1
+ ZTHRUFAL(:) = MAX(0.0, ZSNOWSWE_1D(:)/PTSTEP + PSR(:) - PEVAP(:) + ZRRSNOW(:)) ! kg m-2 s-1
+ !
+ DMK%XSRSFC(:) = 0.0
+ DMK%XRRSFC(:) = DMK%XRRSFC(:)
+ !
+ ZSNOWABLAT_DELTA(:) = 1.0
+ !
+ PEK%TSNOW%ALB(:) = XUNDEF
+ !
+ PEVAPCOR(:) = 0.0
+ ZSOILCOR(:) = 0.0
+ !
+ DMK%XGFLUXSNOW(:) = DMK%XRNSNOW(:) - DMK%XHSNOW(:) - PLES3L(:) - PLEL3L(:)
+ DMK%XSNOWHMASS(:) = -PSR(:)*(XLMTT*PTSTEP)
+ !
+ PGSFCSNOW(:) = 0.0
+ PDELHEATN(:) = -ZSNOWH(:) /PTSTEP
+ PDELHEATN_SFC(:) = -ZSNOWH1(:)/PTSTEP
+ PSNOWSFCH(:) = PDELHEATN_SFC(:) - (ZSWNET_NS(:) + ZLWNET_N(:) &
+ - DMK%XHSNOW(:) - PLES3L(:) - PLEL3L(:)) + PGSFCSNOW(:) &
+ - DMK%XSNOWHMASS(:)/PTSTEP
+ ZGRNDFLUXN(:) = (ZSNOWH(:)+DMK%XSNOWHMASS(:))/PTSTEP + DMK%XGFLUXSNOW(:)
+ ZWORK(:) = PTSTEP * ZPSN(:) * (ZGRNDFLUXN(:) - PGRNDFLUX(:) - PFLSN_COR(:))
+ PTG(:,1) = PTG(:,1) + ZWORK(:)*(1.-ZWGHT(:))*PCT(:)
+ PTG(:,2) = PTG(:,2) + ZWORK(:)* ZWGHT(:) *ZC2(:)
+ ZWORK(:) = ZWORK(:) / PTSTEP
+ PDELHEATG(:) = PDELHEATG(:) + ZWORK(:)
+ PDELHEATG_SFC(:) = PDELHEATG_SFC(:) + ZWORK(:)
+ PGRNDFLUX(:) = ZGRNDFLUXN(:)
+ PFLSN_COR(:) = 0.0
+ !
+ END WHERE
+!
+!
+ DO JWRK=1,INLVLS
+ DO JJ=1,SIZE(PEK%TSNOW%WSNOW(:,:),1)
+ PEK%TSNOW%WSNOW(JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PEK%TSNOW%WSNOW(JJ,JWRK)
+ PEK%TSNOW%HEAT (JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PEK%TSNOW%HEAT (JJ,JWRK)
+ PEK%TSNOW%RHO (JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PEK%TSNOW%RHO (JJ,JWRK) + &
ZSNOWABLAT_DELTA(JJ)*XRHOSMIN_ES
- PSNOWTEMP(JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PSNOWTEMP(JJ,JWRK) + &
+ PEK%TSNOW%AGE(JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PEK%TSNOW%AGE (JJ,JWRK)
+ DMK%XSNOWTEMP(JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*DMK%XSNOWTEMP(JJ,JWRK) + &
ZSNOWABLAT_DELTA(JJ)*XTT
- PSNOWLIQ (JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PSNOWLIQ(JJ,JWRK)
- PSNOWDZ (JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PSNOWDZ(JJ,JWRK)
- PSNOWAGE (JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PSNOWAGE (JJ,JWRK)
- ENDDO
- ENDDO
+ DMK%XSNOWLIQ (JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*DMK%XSNOWLIQ(JJ,JWRK)
+ DMK%XSNOWDZ (JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*DMK%XSNOWDZ (JJ,JWRK)
+ ENDDO
+ ENDDO
!
- IF (HSNOW_ISBA=='CRO') THEN
- DO JWRK=1,INLVLS
- DO JJ=1,SIZE(PSNOWGRAN1,1)
- PSNOWGRAN1(JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PSNOWGRAN1(JJ,JWRK)
- PSNOWGRAN2(JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PSNOWGRAN2(JJ,JWRK)
- PSNOWHIST(JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PSNOWHIST(JJ,JWRK)
- ENDDO
+ IF (PEK%TSNOW%SCHEME=='CRO') THEN
+ DO JWRK=1,INLVLS
+ DO JJ=1,SIZE(PEK%TSNOW%GRAN1(:,:),1)
+ PEK%TSNOW%GRAN1(JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PEK%TSNOW%GRAN1(JJ,JWRK)
+ PEK%TSNOW%GRAN2(JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PEK%TSNOW%GRAN2(JJ,JWRK)
+ PEK%TSNOW%HIST (JJ,JWRK) = (1.0-ZSNOWABLAT_DELTA(JJ))*PEK%TSNOW%HIST (JJ,JWRK)
ENDDO
- ENDIF
+ ENDDO
+ ENDIF
!
! ===============================================================
!
! Compute snow mass budget
!
- ZSNOW_MASS_BUDGET(:) = (ZSNOWSWE_1D(:)-ZSNOWSWE_OUT(:))/PTSTEP + PSR (:)+ZRRSNOW (:) &
- - PEVAP (:)-ZTHRUFAL(:) &
- + PEVAPCOR(:)+ZSOILCOR(:)
+ ZSNOW_MASS_BUDGET(:) = (ZSNOWSWE_1D(:)-ZSNOWSWE_OUT(:))/PTSTEP + PSR (:)+ZRRSNOW (:) &
+ - PEVAP (:)-ZTHRUFAL(:) &
+ + PEVAPCOR(:)+ZSOILCOR(:)
!
!
! ===============================================================
@@ -556,28 +524,57 @@ IF (HSNOW_ISBA=='3-L' .OR. HISBA == 'DIF' .OR. HSNOW_ISBA == 'CRO') THEN
! To Conserve mass in ISBA, the latent heat flux part of
! the EVAPCOR term must be weignted by the snow fraction
!
- PEVAPCOR (:) = PEVAPCOR(:)*ZPSN(:) + ZSOILCOR(:)
+ PEVAPCOR (:) = PEVAPCOR(:)*ZPSN(:) + ZSOILCOR(:)
!
! ===============================================================
!
! check suspicious low temperature
!
- DO JWRK=1,INLVLS
- DO JJ=1,SIZE(PSNOWSWE,1)
- IF(PSNOWSWE(JJ,JWRK)>0.0.AND.PSNOWTEMP(JJ,JWRK)<ZCHECK_TEMP)THEN
- WRITE(*,*) 'Suspicious low temperature :',PSNOWTEMP(JJ,JWRK)
- WRITE(*,*) 'At point and location :',JJ,'LAT=',PLAT(JJ),'LON=',PLON(JJ)
- WRITE(*,*) 'At snow level / total layer:',JWRK,'/',INLVLS
- WRITE(*,*) 'SNOW MASS BUDGET (kg/m2/s) :',ZSNOW_MASS_BUDGET(JJ)
- WRITE(*,*) 'SWE BY LAYER (kg/m2) :',PSNOWSWE (JJ,1:INLVLS)
- WRITE(*,*) 'DEPTH BY LAYER (m) :',PSNOWDZ (JJ,1:INLVLS)
- WRITE(*,*) 'DENSITY BY LAYER (kg/m3) :',PSNOWRHO (JJ,1:INLVLS)
- WRITE(*,*) 'TEMPERATURE BY LAYER (K) :',PSNOWTEMP(JJ,1:INLVLS)
- CALL ABOR1_SFX('SNOW3L_ISBA: Suspicious low temperature')
- ENDIF
- ENDDO
- ENDDO
+ DO JWRK=1,INLVLS
+ !
+ DO JJ=1,SIZE(PEK%TSNOW%WSNOW,1)
+ !
+ IF (PEK%TSNOW%WSNOW(JJ,JWRK)>0.0) THEN
+ !
+ IF (DMK%XSNOWTEMP(JJ,JWRK)<ZCHECK_TEMP) THEN
+ WRITE(*,*) 'Suspicious low temperature :',DMK%XSNOWTEMP(JJ,JWRK)
+ WRITE(*,*) 'At point and location :',JJ,'LAT=',G%XLAT(JJ),'LON=',G%XLON(JJ)
+ WRITE(*,*) 'At snow level / total layer:',JWRK,'/',INLVLS
+ WRITE(*,*) 'SNOW MASS BUDGET (kg/m2/s) :',ZSNOW_MASS_BUDGET(JJ)
+ WRITE(*,*) 'SWE BY LAYER (kg/m2) :',PEK%TSNOW%WSNOW (JJ,1:INLVLS)
+ WRITE(*,*) 'DEKTH BY LAYER (m) :',DMK%XSNOWDZ (JJ,1:INLVLS)
+ WRITE(*,*) 'DENSITY BY LAYER (kg/m3) :',PEK%TSNOW%RHO(JJ,1:INLVLS)
+ WRITE(*,*) 'TEMPERATURE BY LAYER (K) :',DMK%XSNOWTEMP(JJ,1:INLVLS)
+ CALL ABOR1_SFX('SNOW3L_ISBA: Suspicious low temperature')
+ ENDIF
+ !
+ ELSE
+ !
+ !Prognostic variables forced to XUNDEF for correct outputs
+ DMK%XSNOWDZ(JJ,JWRK)=XUNDEF
+ ! Careful : to compute average surface temperature in ISBA_SNOW_AGR
+ ! PSNOWTEMP(JJ,1) is required when PPSN(JJ)>0 even if PSNOWSWE(JJ,1)==0
+ ! (vanishing snowpack)
+ IF (.NOT.(PEK%XPSN(JJ)>0.0.AND.JWRK==1)) DMK%XSNOWTEMP(JJ,JWRK) = XUNDEF
+ DMK%XSNOWLIQ (JJ,JWRK) = XUNDEF
+ PEK%TSNOW%HEAT(JJ,JWRK) = XUNDEF
+ PEK%TSNOW%RHO (JJ,JWRK) = XUNDEF
+ PEK%TSNOW%AGE (JJ,JWRK) = XUNDEF
+ IF (PEK%TSNOW%SCHEME=='CRO') THEN
+ PEK%TSNOW%GRAN1(JJ,JWRK) = XUNDEF
+ PEK%TSNOW%GRAN2(JJ,JWRK) = XUNDEF
+ PEK%TSNOW%HIST (JJ,JWRK) = XUNDEF
+ END IF
+ ENDIF
+ ENDDO
+ ENDDO
!
+ IF(OMEB)THEN
+ DEK%XSWNET_N(:) = ZSWNET_N(:)
+ DEK%XSWNET_NS(:) = ZSWNET_NS(:)
+ DEK%XLWNET_N(:) = ZLWNET_N(:)
+ END IF
+
! ===============================================================
!
ENDIF
@@ -680,6 +677,25 @@ REAL, DIMENSION(KSIZE1) :: ZP_PSN
REAL, DIMENSION(KSIZE1) :: ZP_PSN_GFLXCOR
REAL, DIMENSION(KSIZE1) :: ZP_WORK
!
+REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWDEND
+REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWSPHER
+REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWSIZE
+REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWSSA
+REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWTYPEMEPRA
+REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWRAM
+REAL, DIMENSION(KSIZE1,KSIZE2) :: ZP_SNOWSHEAR
+REAL, DIMENSION(KSIZE1) :: ZP_SNDPT_1DY
+REAL, DIMENSION(KSIZE1) :: ZP_SNDPT_3DY
+REAL, DIMENSION(KSIZE1) :: ZP_SNDPT_5DY
+REAL, DIMENSION(KSIZE1) :: ZP_SNDPT_7DY
+REAL, DIMENSION(KSIZE1) :: ZP_SNSWE_1DY
+REAL, DIMENSION(KSIZE1) :: ZP_SNSWE_3DY
+REAL, DIMENSION(KSIZE1) :: ZP_SNSWE_5DY
+REAL, DIMENSION(KSIZE1) :: ZP_SNSWE_7DY
+REAL, DIMENSION(KSIZE1) :: ZP_SNRAM_SONDE
+REAL, DIMENSION(KSIZE1) :: ZP_SN_WETTHCKN
+REAL, DIMENSION(KSIZE1) :: ZP_SN_REFRZNTHCKN
+!
REAL, PARAMETER :: ZDEPTHABS = 0.60 ! m
!
INTEGER :: JWRK, JJ, JI
@@ -698,23 +714,23 @@ ZP_SOILD(:) = 0.
DO JWRK=1,KSIZE2
DO JJ=1,KSIZE1
JI = KMASK(JJ)
- ZP_SNOWSWE (JJ,JWRK) = PSNOWSWE (JI,JWRK)
- ZP_SNOWRHO (JJ,JWRK) = PSNOWRHO (JI,JWRK)
- ZP_SNOWHEAT(JJ,JWRK) = PSNOWHEAT(JI,JWRK)
- ZP_SNOWTEMP(JJ,JWRK) = PSNOWTEMP(JI,JWRK)
- ZP_SNOWLIQ (JJ,JWRK) = PSNOWLIQ (JI,JWRK)
- ZP_SNOWDZ (JJ,JWRK) = PSNOWDZ (JI,JWRK)
- ZP_SNOWAGE (JJ,JWRK) = PSNOWAGE (JI,JWRK)
+ ZP_SNOWSWE (JJ,JWRK) = PEK%TSNOW%WSNOW (JI,JWRK)
+ ZP_SNOWRHO (JJ,JWRK) = PEK%TSNOW%RHO (JI,JWRK)
+ ZP_SNOWHEAT(JJ,JWRK) = PEK%TSNOW%HEAT(JI,JWRK)
+ ZP_SNOWAGE (JJ,JWRK) = PEK%TSNOW%AGE (JI,JWRK)
+ ZP_SNOWTEMP(JJ,JWRK) = DMK%XSNOWTEMP(JI,JWRK)
+ ZP_SNOWLIQ (JJ,JWRK) = DMK%XSNOWLIQ (JI,JWRK)
+ ZP_SNOWDZ (JJ,JWRK) = DMK%XSNOWDZ (JI,JWRK)
ENDDO
ENDDO
!
-IF (HSNOW_ISBA=='CRO') THEN
+IF (PEK%TSNOW%SCHEME=='CRO') THEN
DO JWRK=1,KSIZE2
DO JJ=1,KSIZE1
JI = KMASK(JJ)
- ZP_SNOWGRAN1(JJ,JWRK) = PSNOWGRAN1 (JI,JWRK)
- ZP_SNOWGRAN2(JJ,JWRK) = PSNOWGRAN2 (JI,JWRK)
- ZP_SNOWHIST (JJ,JWRK) = PSNOWHIST (JI,JWRK)
+ ZP_SNOWGRAN1(JJ,JWRK) = PEK%TSNOW%GRAN1 (JI,JWRK)
+ ZP_SNOWGRAN2(JJ,JWRK) = PEK%TSNOW%GRAN2 (JI,JWRK)
+ ZP_SNOWHIST (JJ,JWRK) = PEK%TSNOW%HIST (JI,JWRK)
ENDDO
ENDDO
ELSE
@@ -747,11 +763,20 @@ ENDIF
!
DO JJ=1,KSIZE1
JI = KMASK(JJ)
- ZP_SNOWALB (JJ) = PSNOWALB (JI)
+ ZP_LVTT (JJ) = PK%XLVTT (JI)
+ ZP_LSTT (JJ) = PK%XLSTT (JI)
+ ZP_EMISNOW (JJ) = PEK%TSNOW%EMIS(JI)
+ ZP_SNOWALB (JJ) = PEK%TSNOW%ALB (JI)
+ ZP_PSN3L (JJ) = PEK%XPSN (JI)
+ ZP_Z0NAT (JJ) = DK%XZ0 (JI)
+ ZP_Z0HNAT (JJ) = DK%XZ0H (JI)
+ ZP_Z0EFF (JJ) = DK%XZ0EFF(JI)
+ ZP_RNSNOW (JJ) = DMK%XRNSNOW (JI)
+ ZP_HSNOW (JJ) = DMK%XHSNOW (JI)
+ ZP_HPSNOW (JJ) = DMK%XHPSNOW (JI)
+
ZP_PS (JJ) = PPS (JI)
ZP_SRSNOW (JJ) = PSR (JI)
- ZP_RRSNOW (JJ) = ZRRSNOW (JI)
- ZP_PSN3L (JJ) = PPSN (JI)
ZP_CT (JJ) = PCT (JI)
ZP_TA (JJ) = PTA (JI)
ZP_DELHEATG(JJ) = PDELHEATG(JI)
@@ -764,15 +789,13 @@ DO JJ=1,KSIZE1
ZP_UREF (JJ) = PUREF (JI)
ZP_EXNS (JJ) = PEXNS (JI)
ZP_EXNA (JJ) = PEXNA (JI)
- ZP_LVTT (JJ) = PLVTT (JI)
- ZP_LSTT (JJ) = PLSTT (JI)
ZP_DIRCOSZW(JJ) = PDIRCOSZW(JI)
ZP_ZREF (JJ) = PZREF (JI)
- ZP_Z0NAT (JJ) = PZ0NAT (JI)
- ZP_Z0HNAT (JJ) = PZ0HNAT (JI)
- ZP_Z0EFF (JJ) = PZ0EFF (JI)
ZP_ALB (JJ) = PALB (JI)
+
+ ZP_RRSNOW (JJ) = ZRRSNOW (JI)
ZP_SOILCOND(JJ) = ZSOILCOND(JI)
+
!
ZP_PEW_A_COEF(JJ) = PPEW_A_COEF(JI)
ZP_PEW_B_COEF(JJ) = PPEW_B_COEF(JI)
@@ -781,24 +804,22 @@ DO JJ=1,KSIZE1
ZP_PET_B_COEF(JJ) = PPET_B_COEF(JI)
ZP_PEQ_B_COEF(JJ) = PPEQ_B_COEF(JI)
!
- ZP_LAT (JJ) = PLAT(JI)
- ZP_LON (JJ) = PLON(JI)
+ ZP_LAT (JJ) = G%XLAT(JI)
+ ZP_LON (JJ) = G%XLON(JI)
+
ZP_ZENITH(JJ) = PZENITH (JI)
!
ZP_GRNDFLUX (JJ) = PGRNDFLUX (JI)
- ZP_RNSNOW (JJ) = PRNSNOW (JI)
- ZP_HSNOW (JJ) = PHSNOW (JI)
ZP_DELHEATN (JJ) = PDELHEATN (JI)
ZP_DELHEATN_SFC(JJ) = PDELHEATN_SFC(JI)
ZP_SNOWSFCH (JJ) = PSNOWSFCH (JI)
- ZP_HPSNOW (JJ) = PHPSNOW (JI)
ZP_LES3L (JJ) = PLES3L (JI)
ZP_LEL3L (JJ) = PLEL3L (JI)
ZP_EVAP (JJ) = PEVAP (JI)
- ZP_EMISNOW (JJ) = PEMISNOW (JI)
- ZP_SWNETSNOW (JJ) = PSWNETSNOW (JI)
- ZP_SWNETSNOWS (JJ) = PSWNETSNOWS (JI)
- ZP_LWNETSNOW (JJ) = PLWNETSNOW (JI)
+ !
+ ZP_SWNETSNOW (JJ) = ZSWNET_N (JI)
+ ZP_SWNETSNOWS (JJ) = ZSWNET_NS (JI)
+ ZP_LWNETSNOW (JJ) = ZLWNET_N (JI)
ENDDO
!
DO JJ=1,KSIZE1
@@ -806,7 +827,7 @@ DO JJ=1,KSIZE1
ZP_VEGTYPE (JJ) = PVEGTYPE (JI,NVT_SNOW)
ZP_FOREST (JJ) = PVEGTYPE(JI,NVT_TEBD) + PVEGTYPE(JI,NVT_TRBE) + PVEGTYPE(JI,NVT_BONE) &
+ PVEGTYPE(JI,NVT_TRBD) + PVEGTYPE(JI,NVT_TEBE) + PVEGTYPE(JI,NVT_TENE) &
- + PVEGTYPE(JI,NVT_BOBD) + PVEGTYPE(JI,NVT_BOND) + PVEGTYPE(JI,NVT_SHRB)
+ + PVEGTYPE(JI,NVT_BOBD) + PVEGTYPE(JI,NVT_BOND) + PVEGTYPE(JI,NVT_SHRB)
ENDDO
!
!
@@ -836,7 +857,7 @@ IF(OMEB)THEN
ZP_HSNOW(:) = ZP_HSNOW(:) *ZP_PSN_INV(:)
ZP_GFLUXSNOW(:) = ZP_GFLUXSNOW(:) *ZP_PSN_INV(:)
ZP_GSFCSNOW(:) = ZP_GSFCSNOW(:) *ZP_PSN_INV(:)
- ZP_SNOWHMASS(:) = ZP_SNOWHMASS(:) *ZP_PSN_INV(:)
+ ZP_SNOWHMASS(:) = ZP_SNOWHMASS(:) *ZP_PSN_INV(:)
ZP_LES3L(:) = ZP_LES3L(:) *ZP_PSN_INV(:)
ZP_LEL3L(:) = ZP_LEL3L(:) *ZP_PSN_INV(:)
ZP_GRNDFLUX(:) = ZP_GRNDFLUX(:) *ZP_PSN_INV(:)
@@ -861,50 +882,67 @@ ENDIF
!
! Call ISBA-SNOW3L model:
!
-IF (HSNOW_ISBA=='CRO') THEN
-
- CALL SNOWCRO(HSNOWRES, TPTIME, OGLACIER, HIMPLICIT_WIND, &
- ZP_PEW_A_COEF, ZP_PEW_B_COEF, &
- ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF, &
- ZP_SNOWSWE,ZP_SNOWRHO, ZP_SNOWHEAT, ZP_SNOWALB, &
- ZP_SNOWGRAN1, ZP_SNOWGRAN2, ZP_SNOWHIST, ZP_SNOWAGE, PTSTEP, &
- ZP_PS, ZP_SRSNOW, ZP_RRSNOW ,ZP_PSN3L, ZP_TA, ZP_TG(:,1), &
- ZP_SW_RAD, ZP_QA, ZP_VMOD, ZP_LW_RAD, ZP_RHOA, ZP_UREF, &
- ZP_EXNS, ZP_EXNA, ZP_DIRCOSZW, ZP_ZREF, ZP_Z0NAT, ZP_Z0EFF, &
- ZP_Z0HNAT, ZP_ALB, ZP_SOILCOND, ZP_D_G(:,1), ZP_SNOWLIQ, &
- ZP_SNOWTEMP, ZP_SNOWDZ, ZP_THRUFAL, ZP_GRNDFLUX, ZP_EVAPCOR, &
- ZP_RNSNOW, ZP_HSNOW, ZP_GFLUXSNOW, ZP_HPSNOW, ZP_LES3L, &
- ZP_LEL3L, ZP_EVAP, ZP_SNDRIFT, ZP_RI, &
- ZP_EMISNOW, ZP_CDSNOW, ZP_USTARSNOW, &
- ZP_CHSNOW, ZP_SNOWHMASS, ZP_QS, ZP_VEGTYPE, ZP_ZENITH, &
- ZP_LAT, ZP_LON, OSNOWDRIFT,OSNOWDRIFT_SUBLIM, &
- OSNOW_ABS_ZENITH, HSNOWMETAMO,HSNOWRAD )
+IF (PEK%TSNOW%SCHEME=='CRO') THEN
+ CALL SNOWCRO(IO%CSNOWRES, TPTIME, IO%LGLACIER, HIMPLICIT_WIND, &
+ ZP_PEW_A_COEF, ZP_PEW_B_COEF, ZP_PET_A_COEF, ZP_PEQ_A_COEF,&
+ ZP_PET_B_COEF, ZP_PEQ_B_COEF, ZP_SNOWSWE, ZP_SNOWRHO, &
+ ZP_SNOWHEAT, ZP_SNOWALB, ZP_SNOWGRAN1, ZP_SNOWGRAN2, &
+ ZP_SNOWHIST, ZP_SNOWAGE, PTSTEP, ZP_PS, ZP_SRSNOW, &
+ ZP_RRSNOW, ZP_PSN3L, ZP_TA, ZP_TG(:,1), ZP_SW_RAD, ZP_QA, &
+ ZP_VMOD, ZP_LW_RAD, ZP_RHOA, ZP_UREF, ZP_EXNS, ZP_EXNA, &
+ ZP_DIRCOSZW, ZP_ZREF, ZP_Z0NAT, ZP_Z0EFF, ZP_Z0HNAT, &
+ ZP_ALB, ZP_SOILCOND, ZP_D_G(:,1), ZP_SNOWLIQ, ZP_SNOWTEMP, &
+ ZP_SNOWDZ, ZP_THRUFAL, ZP_GRNDFLUX, ZP_EVAPCOR, ZP_RNSNOW, &
+ ZP_HSNOW, ZP_GFLUXSNOW, ZP_HPSNOW, ZP_LES3L, ZP_LEL3L, &
+ ZP_EVAP, ZP_SNDRIFT, ZP_RI,ZP_EMISNOW, ZP_CDSNOW, &
+ ZP_USTARSNOW, ZP_CHSNOW, ZP_SNOWHMASS, ZP_QS, ZP_VEGTYPE, &
+ ZP_ZENITH, ZP_LAT, ZP_LON, IO%LSNOWDRIFT, &
+ IO%LSNOWDRIFT_SUBLIM, IO%LSNOW_ABS_ZENITH, IO%CSNOWMETAMO, &
+ IO%CSNOWRAD )
!
ZP_GFLXCOR (:) = 0.0
ZP_FLSN_COR(:) = 0.0
ZP_SOILCOR (:) = 0.0
!
+#ifndef SFX_OL
+ ! En couplé il faudra voir si on veut virer les diagnostics, les calculer tout le temps, ou trouver une autre solution
+ GCOMPUTECRODIAG = (SIZE(DMK%XSNOWDEND)>0)
+#else
+ GCOMPUTECRODIAG = (SIZE(DMK%XSNOWDEND)>0).AND.(MOD(TPTIME%TIME,XTSTEP_OUTPUT)==0.)
+#endif
+ !
+ !Ajout test sur pas de temps de sortie
+ IF (GCOMPUTECRODIAG) THEN
+ CALL SNOWCRO_DIAG(IO%CSNOWMETAMO,&
+ ZP_SNOWDZ, ZP_SNOWSWE, ZP_SNOWRHO, ZP_SNOWGRAN1, ZP_SNOWGRAN2, ZP_SNOWAGE, &
+ ZP_SNOWHIST, ZP_SNOWTEMP, ZP_SNOWLIQ, ZP_DIRCOSZW, ZP_SNOWDEND, ZP_SNOWSPHER, &
+ ZP_SNOWSIZE, ZP_SNOWSSA, ZP_SNOWTYPEMEPRA, ZP_SNOWRAM, ZP_SNOWSHEAR, &
+ ZP_SNDPT_1DY, ZP_SNDPT_3DY, ZP_SNDPT_5DY, ZP_SNDPT_7DY, ZP_SNSWE_1DY, &
+ ZP_SNSWE_3DY, ZP_SNSWE_5DY, ZP_SNSWE_7DY, ZP_SNRAM_SONDE, ZP_SN_WETTHCKN, &
+ ZP_SN_REFRZNTHCKN )
+ ENDIF
+ !
ELSE
!
- CALL SNOW3L(HSNOWRES, TPTIME, OMEB, HIMPLICIT_WIND, &
- ZP_PEW_A_COEF, ZP_PEW_B_COEF, &
- ZP_PET_A_COEF, ZP_PEQ_A_COEF,ZP_PET_B_COEF, ZP_PEQ_B_COEF, &
- ZP_SNOWSWE, ZP_SNOWRHO, ZP_SNOWHEAT, ZP_SNOWALB, &
- ZP_SNOWGRAN1, ZP_SNOWGRAN2, ZP_SNOWHIST, ZP_SNOWAGE, PTSTEP, &
- ZP_PS, ZP_SRSNOW, ZP_RRSNOW, ZP_PSN3L, ZP_TA, ZP_TG(:,1), &
- ZP_SW_RAD, ZP_QA, ZP_VMOD, ZP_LW_RAD, ZP_RHOA, ZP_UREF, &
- ZP_EXNS, ZP_EXNA, ZP_DIRCOSZW, ZP_ZREF, ZP_Z0NAT, ZP_Z0EFF, &
- ZP_Z0HNAT, ZP_ALB, ZP_SOILCOND, ZP_D_G(:,1), &
- ZP_LVTT, ZP_LSTT, ZP_SNOWLIQ, &
- ZP_SNOWTEMP, ZP_SNOWDZ, ZP_THRUFAL, ZP_GRNDFLUX , &
- ZP_EVAPCOR, ZP_SOILCOR, ZP_GFLXCOR, ZP_SNOWSFCH, &
- ZP_DELHEATN, ZP_DELHEATN_SFC, &
- ZP_SWNETSNOW, ZP_SWNETSNOWS, ZP_LWNETSNOW, ZP_GSFCSNOW, &
- ZP_RNSNOW, ZP_HSNOW, ZP_GFLUXSNOW, ZP_HPSNOW, ZP_LES3L, &
- ZP_LEL3L, ZP_EVAP, ZP_SNDRIFT, ZP_RI, &
- ZP_EMISNOW, ZP_CDSNOW, ZP_USTARSNOW, &
- ZP_CHSNOW, ZP_SNOWHMASS, ZP_QS, ZP_VEGTYPE, ZP_FOREST, &
- ZP_ZENITH, ZP_LAT, ZP_LON, OSNOWDRIFT, OSNOWDRIFT_SUBLIM )
+ CALL SNOW3L(IO%CSNOWRES, TPTIME, OMEB, HIMPLICIT_WIND, &
+ ZP_PEW_A_COEF, ZP_PEW_B_COEF, &
+ ZP_PET_A_COEF, ZP_PEQ_A_COEF,ZP_PET_B_COEF, ZP_PEQ_B_COEF, &
+ ZP_SNOWSWE, ZP_SNOWRHO, ZP_SNOWHEAT, ZP_SNOWALB, &
+ ZP_SNOWGRAN1, ZP_SNOWGRAN2, ZP_SNOWHIST, ZP_SNOWAGE, PTSTEP, &
+ ZP_PS, ZP_SRSNOW, ZP_RRSNOW, ZP_PSN3L, ZP_TA, ZP_TG(:,1), &
+ ZP_SW_RAD, ZP_QA, ZP_VMOD, ZP_LW_RAD, ZP_RHOA, ZP_UREF, &
+ ZP_EXNS, ZP_EXNA, ZP_DIRCOSZW, ZP_ZREF, ZP_Z0NAT, ZP_Z0EFF, &
+ ZP_Z0HNAT, ZP_ALB, ZP_SOILCOND, ZP_D_G(:,1), &
+ ZP_LVTT, ZP_LSTT, ZP_SNOWLIQ, &
+ ZP_SNOWTEMP, ZP_SNOWDZ, ZP_THRUFAL, ZP_GRNDFLUX , &
+ ZP_EVAPCOR, ZP_SOILCOR, ZP_GFLXCOR, ZP_SNOWSFCH, &
+ ZP_DELHEATN, ZP_DELHEATN_SFC, &
+ ZP_SWNETSNOW, ZP_SWNETSNOWS, ZP_LWNETSNOW, ZP_GSFCSNOW, &
+ ZP_RNSNOW, ZP_HSNOW, ZP_GFLUXSNOW, ZP_HPSNOW, ZP_LES3L, &
+ ZP_LEL3L, ZP_EVAP, ZP_SNDRIFT, ZP_RI, &
+ ZP_EMISNOW, ZP_CDSNOW, ZP_USTARSNOW, &
+ ZP_CHSNOW, ZP_SNOWHMASS, ZP_QS, ZP_VEGTYPE, ZP_FOREST, &
+ ZP_ZENITH, ZP_LAT, ZP_LON, IO%LSNOWDRIFT, IO%LSNOWDRIFT_SUBLIM )
!
IF(OMEB)THEN
!
@@ -977,7 +1015,7 @@ ELSE
ZP_TG(:,1) = ZP_TG(:,1) + ZP_WORK(:)*ZP_CT(:)*ZP_D_G(:,1) ! (K)
DO JJ=2,KSIZE3
DO JI=1,KSIZE1
- IF(ZP_SOILD(JI) <= ZDEPTHABS)THEN
+ IF (ZP_SOILD(JI) <= ZDEPTHABS) THEN
ZP_TG(JI,JJ) = ZP_TG(JI,JJ) + ZP_WORK(JI)/ZP_SOILHCAPZ(JI,JJ) ! K
ENDIF
ENDDO
@@ -1014,25 +1052,42 @@ ENDWHERE
DO JWRK=1,KSIZE2
DO JJ=1,KSIZE1
JI = KMASK(JJ)
- PSNOWSWE (JI,JWRK) = ZP_SNOWSWE (JJ,JWRK)
- PSNOWRHO (JI,JWRK) = ZP_SNOWRHO (JJ,JWRK)
- PSNOWHEAT (JI,JWRK) = ZP_SNOWHEAT (JJ,JWRK)
- PSNOWTEMP (JI,JWRK) = ZP_SNOWTEMP (JJ,JWRK)
- PSNOWLIQ (JI,JWRK) = ZP_SNOWLIQ (JJ,JWRK)
- PSNOWDZ (JI,JWRK) = ZP_SNOWDZ (JJ,JWRK)
- PSNOWAGE (JI,JWRK) = ZP_SNOWAGE (JJ,JWRK)
+ PEK%TSNOW%WSNOW(JI,JWRK) = ZP_SNOWSWE (JJ,JWRK)
+ PEK%TSNOW%RHO (JI,JWRK) = ZP_SNOWRHO (JJ,JWRK)
+ PEK%TSNOW%HEAT (JI,JWRK) = ZP_SNOWHEAT (JJ,JWRK)
+ PEK%TSNOW%AGE (JI,JWRK) = ZP_SNOWAGE (JJ,JWRK)
+ DMK%XSNOWTEMP(JI,JWRK) = ZP_SNOWTEMP (JJ,JWRK)
+ DMK%XSNOWLIQ (JI,JWRK) = ZP_SNOWLIQ (JJ,JWRK)
+ DMK%XSNOWDZ (JI,JWRK) = ZP_SNOWDZ (JJ,JWRK)
ENDDO
ENDDO
!
-IF (HSNOW_ISBA=='CRO') THEN
+IF (PEK%TSNOW%SCHEME=='CRO') THEN
DO JWRK=1,KSIZE2
DO JJ=1,KSIZE1
JI = KMASK(JJ)
- PSNOWGRAN1(JI,JWRK) = ZP_SNOWGRAN1(JJ,JWRK)
- PSNOWGRAN2(JI,JWRK) = ZP_SNOWGRAN2(JJ,JWRK)
- PSNOWHIST (JI,JWRK) = ZP_SNOWHIST (JJ,JWRK)
+ PEK%TSNOW%GRAN1(JI,JWRK) = ZP_SNOWGRAN1(JJ,JWRK)
+ PEK%TSNOW%GRAN2(JI,JWRK) = ZP_SNOWGRAN2(JJ,JWRK)
+ PEK%TSNOW%HIST (JI,JWRK) = ZP_SNOWHIST (JJ,JWRK)
ENDDO
ENDDO
+
+ IF (SIZE(DMK%XSNOWDEND)>0) THEN
+ ! This is equivalent to test the value of DGMI%LPROSNOW which does not enter in ISBA
+ DO JWRK = 1,KSIZE2
+ DO JJ=1,KSIZE1
+ JI = KMASK(JJ)
+ DMK%XSNOWDEND (JI,JWRK) = ZP_SNOWDEND (JJ,JWRK)
+ DMK%XSNOWSPHER (JI,JWRK) = ZP_SNOWSPHER (JJ,JWRK)
+ DMK%XSNOWSIZE (JI,JWRK) = ZP_SNOWSIZE (JJ,JWRK)
+ DMK%XSNOWSSA (JI,JWRK) = ZP_SNOWSSA (JJ,JWRK)
+ DMK%XSNOWTYPEMEPRA(JI,JWRK) = ZP_SNOWTYPEMEPRA(JJ,JWRK)
+ DMK%XSNOWRAM (JI,JWRK) = ZP_SNOWRAM (JJ,JWRK)
+ DMK%XSNOWSHEAR (JI,JWRK) = ZP_SNOWSHEAR (JJ,JWRK)
+ ENDDO
+ ENDDO
+ ENDIF
+
ENDIF
!
DO JWRK=1,KSIZE3
@@ -1044,37 +1099,68 @@ ENDDO
!
DO JJ=1,KSIZE1
JI = KMASK (JJ)
+ PEK%TSNOW%ALB(JI) = ZP_SNOWALB (JJ)
+ PEK%TSNOW%EMIS(JI) = ZP_EMISNOW (JJ)
+ DMK%XCDSNOW (JI) = ZP_CDSNOW (JJ)
+ DMK%XUSTARSNOW(JI) = ZP_USTARSNOW (JJ)
+ DMK%XCHSNOW (JI) = ZP_CHSNOW (JJ)
+ DMK%XSNOWHMASS(JI) = ZP_SNOWHMASS (JJ)
+ DMK%XRNSNOW (JI) = ZP_RNSNOW (JJ)
+ DMK%XHSNOW (JI) = ZP_HSNOW (JJ)
+ DMK%XHPSNOW (JI) = ZP_HPSNOW (JJ)
+ DMK%XGFLUXSNOW(JI) = ZP_GFLUXSNOW (JJ)
+ !
PDELHEATG (JI) = ZP_DELHEATG (JJ)
PDELHEATG_SFC(JI) = ZP_DELHEATG_SFC(JJ)
- PSNOWALB (JI) = ZP_SNOWALB (JJ)
PTHRUFAL (JI) = ZP_THRUFAL (JJ)
PEVAPCOR (JI) = ZP_EVAPCOR (JJ)
- ZSOILCOR (JI) = ZP_SOILCOR (JJ)
PRI (JI) = ZP_RI (JJ)
PQS (JI) = ZP_QS (JJ)
- PCDSNOW (JI) = ZP_CDSNOW (JJ)
- PUSTARSNOW (JI) = ZP_USTARSNOW (JJ)
- PCHSNOW (JI) = ZP_CHSNOW (JJ)
- PSNOWHMASS (JI) = ZP_SNOWHMASS (JJ)
- PGRNDFLUX (JI) = ZP_GRNDFLUX (JJ)
- PFLSN_COR (JI) = ZP_FLSN_COR (JJ)
- PRNSNOW (JI) = ZP_RNSNOW (JJ)
- PHSNOW (JI) = ZP_HSNOW (JJ)
- PGFLUXSNOW (JI) = ZP_GFLUXSNOW (JJ)
+ PGRNDFLUX (JI) = ZP_GRNDFLUX (JJ)
+ PFLSN_COR (JI) = ZP_FLSN_COR (JJ)
PDELHEATN (JI) = ZP_DELHEATN (JJ)
PDELHEATN_SFC(JI) = ZP_DELHEATN_SFC(JJ)
PSNOWSFCH (JI) = ZP_SNOWSFCH (JJ)
PGSFCSNOW (JI) = ZP_GSFCSNOW (JJ)
- PHPSNOW (JI) = ZP_HPSNOW (JJ)
PLES3L (JI) = ZP_LES3L (JJ)
PLEL3L (JI) = ZP_LEL3L (JJ)
PEVAP (JI) = ZP_EVAP (JJ)
- PEMISNOW (JI) = ZP_EMISNOW (JJ)
- PSWNETSNOW (JI) = ZP_SWNETSNOW (JJ)
- PSWNETSNOWS (JI) = ZP_SWNETSNOWS (JJ)
- PLWNETSNOW (JI) = ZP_LWNETSNOW (JJ)
+ ZSOILCOR (JI) = ZP_SOILCOR (JJ)
+ !
+ ZSWNET_N (JI) = ZP_SWNETSNOW (JJ)
+ ZSWNET_NS (JI) = ZP_SWNETSNOWS (JJ)
+ ZLWNET_N (JI) = ZP_LWNETSNOW (JJ)
ENDDO
!
+IF ( SIZE(DMK%XSNOWDEND)>0 ) THEN
+ ! This is equivalent to test the value of DGMI%LPROSNOW which does not enter in ISBATHEN
+ DMK%XSNDPT_1DY(:) = XUNDEF
+ DMK%XSNDPT_3DY(:) = XUNDEF
+ DMK%XSNDPT_5DY(:) = XUNDEF
+ DMK%XSNDPT_7DY(:) = XUNDEF
+ DMK%XSNSWE_1DY(:) = XUNDEF
+ DMK%XSNSWE_3DY(:) = XUNDEF
+ DMK%XSNSWE_5DY(:) = XUNDEF
+ DMK%XSNSWE_7DY(:) = XUNDEF
+ DMK%XSNRAM_SONDE (:) = XUNDEF
+ DMK%XSN_WETTHCKN (:) = XUNDEF
+ DMK%XSN_REFRZNTHCKN(:) = XUNDEF
+ DO JJ=1,KSIZE1
+ JI = KMASK(JJ)
+ DMK%XSNDPT_1DY(JI) = ZP_SNDPT_1DY(JJ)
+ DMK%XSNDPT_3DY(JI) = ZP_SNDPT_3DY(JJ)
+ DMK%XSNDPT_5DY(JI) = ZP_SNDPT_5DY(JJ)
+ DMK%XSNDPT_7DY(JI) = ZP_SNDPT_7DY(JJ)
+ DMK%XSNSWE_1DY(JI) = ZP_SNSWE_1DY(JJ)
+ DMK%XSNSWE_3DY(JI) = ZP_SNSWE_3DY(JJ)
+ DMK%XSNSWE_5DY(JI) = ZP_SNSWE_5DY(JJ)
+ DMK%XSNSWE_7DY(JI) = ZP_SNSWE_7DY(JJ)
+ DMK%XSNRAM_SONDE (JI) = ZP_SNRAM_SONDE (JJ)
+ DMK%XSN_WETTHCKN (JI) = ZP_SN_WETTHCKN (JJ)
+ DMK%XSN_REFRZNTHCKN(JI) = ZP_SN_REFRZNTHCKN(JJ)
+ ENDDO
+ENDIF
+!
IF (LHOOK) CALL DR_HOOK('SNOW3L_ISBA:CALL_MODEL',1,ZHOOK_HANDLE)
!
END SUBROUTINE CALL_MODEL
diff --git a/src/SURFEX/snow3l.F90 b/src/SURFEX/snow3l.F90
index b0ff4300502a877d7711c671c15ce7e9a6d7d851..938ae4091ff2ece19d9bd85c4a8893e066237dcc 100644
--- a/src/SURFEX/snow3l.F90
+++ b/src/SURFEX/snow3l.F90
@@ -184,7 +184,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PTG
! PTG = Surface soil temperature (effective
! temperature the of layer lying below snow)
REAL, DIMENSION(:), INTENT(IN) :: PLVTT, PLSTT ! = latent heats for hydrology
-!
REAL, DIMENSION(:), INTENT(INOUT) :: PSNOWALB
! PSNOWALB = Prognostic surface snow albedo
! (does not include anything but
@@ -778,300 +777,6 @@ IF (LHOOK) CALL DR_HOOK('SNOW3L',1,ZHOOK_HANDLE)
!####################################################################
!####################################################################
!####################################################################
-SUBROUTINE SNOW3LFALL(PTSTEP,PSR,PTA,PVMOD,PSNOW,PSNOWRHO,PSNOWDZ, &
- PSNOWHEAT,PSNOWHMASS,PSNOWAGE,PPERMSNOWFRAC)
-!
-!! PURPOSE
-!! -------
-! Calculate changes to snowpack resulting from snowfall.
-! Update mass and heat content of uppermost layer.
-!
-!
-USE MODD_CSTS, ONLY : XLMTT, XTT, XCI
-USE MODD_SNOW_PAR, ONLY : XRHOSMIN_ES, XSNOWDMIN, &
- XSNOWFALL_A_SN, &
- XSNOWFALL_B_SN, &
- XSNOWFALL_C_SN
-!
-USE MODE_SNOW3L
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-REAL, INTENT(IN) :: PTSTEP
-!
-REAL, DIMENSION(:), INTENT(IN) :: PSR, PTA, PVMOD, PPERMSNOWFRAC
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PSNOW
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWRHO, PSNOWDZ, PSNOWHEAT, PSNOWAGE
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PSNOWHMASS
-!
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: JJ, JI
-!
-INTEGER :: INI
-INTEGER :: INLVLS
-!
-REAL, DIMENSION(SIZE(PTA)) :: ZSNOWFALL, ZRHOSNEW, &
- ZSNOW, ZSNOWTEMP, &
- ZSNOWFALL_DELTA, ZSCAP, &
- ZAGENEW
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-! 0. Initialize:
-! ------------------
-!
-IF (LHOOK) CALL DR_HOOK('SNOW3LFALL',0,ZHOOK_HANDLE)
-!
-INI = SIZE(PSNOWDZ(:,:),1)
-INLVLS = SIZE(PSNOWDZ(:,:),2)
-!
-ZRHOSNEW(:) = XRHOSMIN_ES
-ZAGENEW (:) = 0.0
-ZSNOWFALL(:) = 0.0
-ZSCAP(:) = 0.0
-ZSNOW(:) = PSNOW(:)
-!
-PSNOWHMASS(:) = 0.0
-!
-! 1. Incorporate snowfall into snowpack:
-! --------------------------------------
-!
-!
-! Heat content of newly fallen snow (J/m2):
-! NOTE for now we assume the snowfall has
-! the temperature of the snow surface upon reaching the snow.
-! This is done as opposed to using the air temperature since
-! this flux is quite small and has little to no impact
-! on the time scales of interest. If we use the above assumption
-! then, then the snowfall advective heat flux is zero.
-!
-ZSNOWTEMP(:) = XTT
-ZSCAP (:) = SNOW3LSCAP(PSNOWRHO(:,1))
-!
-WHERE (PSR(:) > 0.0 .AND. PSNOWDZ(:,1)>0.)
- ZSNOWTEMP(:) = XTT + (PSNOWHEAT(:,1) + &
- XLMTT*PSNOWRHO(:,1)*PSNOWDZ(:,1))/ &
- (ZSCAP(:)*MAX(XSNOWDMIN/INLVLS,PSNOWDZ(:,1)))
- ZSNOWTEMP(:) = MIN(XTT, ZSNOWTEMP(:))
-END WHERE
-!
-WHERE (PSR(:) > 0.0)
-!
- PSNOWHMASS(:) = PSR(:)*(XCI*(ZSNOWTEMP(:)-XTT)-XLMTT)*PTSTEP
-!
-! Snowfall density: Following CROCUS (Pahaut 1976)
-!
- ZRHOSNEW(:) = MAX(XRHOSMIN_ES, XSNOWFALL_A_SN + XSNOWFALL_B_SN*(PTA(:)-XTT)+ &
- XSNOWFALL_C_SN*SQRT(PVMOD(:)))
-!
-!
-! Fresh snowfall changes the snowpack age,
-! decreasing in uppermost snow layer (mass weighted average):
-!
- PSNOWAGE(:,1) = (PSNOWAGE(:,1)*PSNOWDZ(:,1)*PSNOWRHO(:,1)+ZAGENEW(:)*PSR(:)*PTSTEP) / &
- (PSNOWDZ(:,1)*PSNOWRHO(:,1)+PSR(:)*PTSTEP)
-!
-! Augment total pack depth:
-!
- ZSNOWFALL(:) = PSR(:)*PTSTEP/ZRHOSNEW(:) ! snowfall thickness (m)
-!
- PSNOW(:) = PSNOW(:) + ZSNOWFALL(:)
-!
-! Fresh snowfall changes the snowpack
-! density, increases the total liquid water
-! equivalent: in uppermost snow layer:
-!
- PSNOWRHO(:,1) = (PSNOWDZ(:,1)*PSNOWRHO(:,1) + ZSNOWFALL(:)*ZRHOSNEW(:))/ &
- (PSNOWDZ(:,1)+ZSNOWFALL(:))
-!
- PSNOWDZ(:,1) = PSNOWDZ(:,1) + ZSNOWFALL(:)
-!
-! Add energy of snowfall to snowpack:
-! Update heat content (J/m2) (therefore the snow temperature
-! and liquid content):
-!
- PSNOWHEAT(:,1) = PSNOWHEAT(:,1) + PSNOWHMASS(:)
-!
-END WHERE
-!
-!
-! 2. Case of new snowfall on a previously snow-free surface:
-! ----------------------------------------------------------
-!
-! When snow first falls on a surface devoid of snow,
-! redistribute the snow mass throughout the 3 layers:
-! (temperature already set in the calling routine
-! for this case)
-!
-ZSNOWFALL_DELTA(:) = 0.0
-WHERE(ZSNOW(:) == 0.0 .AND. PSR(:) > 0.0)
- ZSNOWFALL_DELTA(:) = 1.0
-END WHERE
-!
-DO JJ=1,INLVLS
- DO JI=1,INI
-!
- PSNOWDZ(JI,JJ) = ZSNOWFALL_DELTA(JI)*(ZSNOWFALL(JI) /INLVLS) + &
- (1.0-ZSNOWFALL_DELTA(JI))*PSNOWDZ(JI,JJ)
-!
- PSNOWHEAT(JI,JJ) = ZSNOWFALL_DELTA(JI)*(PSNOWHMASS(JI)/INLVLS) + &
- (1.0-ZSNOWFALL_DELTA(JI))*PSNOWHEAT(JI,JJ)
-!
- PSNOWRHO(JI,JJ) = ZSNOWFALL_DELTA(JI)*ZRHOSNEW(JI) + &
- (1.0-ZSNOWFALL_DELTA(JI))*PSNOWRHO(JI,JJ)
-!
- PSNOWAGE(JI,JJ) = ZSNOWFALL_DELTA(JI)*(ZAGENEW(JI)/INLVLS) + &
- (1.0-ZSNOWFALL_DELTA(JI))*PSNOWAGE(JI,JJ)
-!
- ENDDO
-ENDDO
-!
-IF (LHOOK) CALL DR_HOOK('SNOW3LFALL',1,ZHOOK_HANDLE)
-!
-!
-END SUBROUTINE SNOW3LFALL
-!####################################################################
-!####################################################################
-!####################################################################
-SUBROUTINE SNOW3LCOMPACTN(PTSTEP,PSNOWDZMIN,PSNOWRHO,PSNOWDZ,PSNOWTEMP,PSNOW,PSNOWLIQ)
-!
-!! PURPOSE
-!! -------
-! Snow compaction due to overburden and settling.
-! Mass is unchanged: layer thickness is reduced
-! in proportion to density increases. Method
-! of Brun et al (1989) and Vionnet et al. (2012)
-!
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE MODD_CSTS, ONLY : XTT, XG
-USE MODD_SNOW_PAR, ONLY : XRHOSMAX_ES
-!
-USE MODD_SNOW_METAMO, ONLY : XVVISC1,XVVISC3,XVVISC4, &
- XVVISC5,XVVISC6,XVRO11
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-REAL, INTENT(IN) :: PTSTEP
-REAL, INTENT(IN) :: PSNOWDZMIN
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWTEMP, PSNOWLIQ
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWRHO, PSNOWDZ
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PSNOW
-!
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: JJ, JI
-!
-INTEGER :: INI
-INTEGER :: INLVLS
-!
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWRHO2, ZVISCOCITY, ZF1, &
- ZTEMP, ZSMASS, ZSNOWDZ, &
- ZWSNOWDZ, ZWHOLDMAX
-!
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-! 0. Initialization:
-! ------------------
-!
-IF (LHOOK) CALL DR_HOOK('SNOW3LCOMPACTN',0,ZHOOK_HANDLE)
-!
-INI = SIZE(PSNOWDZ(:,:),1)
-INLVLS = SIZE(PSNOWDZ(:,:),2)
-!
-ZSNOWRHO2 (:,:) = PSNOWRHO(:,:)
-ZSNOWDZ (:,:) = MAX(PSNOWDZMIN,PSNOWDZ(:,:))
-ZVISCOCITY(:,:) = 0.0
-ZTEMP (:,:) = 0.0
-!
-! 1. Cumulative snow mass (kg/m2):
-! --------------------------------
-!
-ZSMASS(:,:) = 0.0
-DO JJ=2,INLVLS
- DO JI=1,INI
- ZSMASS(JI,JJ) = ZSMASS(JI,JJ-1) + PSNOWDZ(JI,JJ-1)*PSNOWRHO(JI,JJ-1)
- ENDDO
-ENDDO
-! overburden of half the mass of the uppermost layer applied to itself
-ZSMASS(:,1) = 0.5 * PSNOWDZ(:,1) * PSNOWRHO(:,1)
-!
-! 2. Compaction
-! -------------
-!
-!Liquid water effect
-!
-ZWHOLDMAX(:,:) = SNOW3LHOLD(PSNOWRHO,PSNOWDZ)
-ZF1(:,:) = 1.0/(XVVISC5+10.*MIN(1.0,PSNOWLIQ(:,:)/ZWHOLDMAX(:,:)))
-!
-!Snow viscocity, density and grid thicknesses
-!
-DO JJ=1,INLVLS
- DO JI=1,INI
-!
- IF(PSNOWRHO(JI,JJ) < XRHOSMAX_ES)THEN
-!
-! temperature dependence limited to 5K: Schleef et al. (2014)
- ZTEMP (JI,JJ) = XVVISC4*MIN(5.0,ABS(XTT-PSNOWTEMP(JI,JJ)))
-!
-! Calculate snow viscocity: Brun et al. (1989), Vionnet et al. (2012)
- ZVISCOCITY(JI,JJ) = XVVISC1*ZF1(JI,JJ)*EXP(XVVISC3*PSNOWRHO(JI,JJ)+ZTEMP(JI,JJ))*PSNOWRHO(JI,JJ)/XVRO11
-!
-! Calculate snow density:
- ZSNOWRHO2(JI,JJ) = PSNOWRHO(JI,JJ) + PSNOWRHO(JI,JJ)*PTSTEP &
- * ( (XG*ZSMASS(JI,JJ)/ZVISCOCITY(JI,JJ)) )
-!
-! Conserve mass by decreasing grid thicknesses in response to density increases
- PSNOWDZ(JI,JJ) = PSNOWDZ(JI,JJ)*(PSNOWRHO(JI,JJ)/ZSNOWRHO2(JI,JJ))
-!
- ENDIF
-!
- ENDDO
-ENDDO
-!
-! 3. Update total snow depth and density profile:
-! -----------------------------------------------
-!
-! Compaction/augmentation of total snowpack depth
-!
-PSNOW(:) = 0.
-DO JJ=1,INLVLS
- DO JI=1,INI
- PSNOW(JI) = PSNOW(JI) + PSNOWDZ(JI,JJ)
- ENDDO
-ENDDO
-!
-! Update density (kg m-3):
-!
-PSNOWRHO(:,:) = ZSNOWRHO2(:,:)
-!
-IF (LHOOK) CALL DR_HOOK('SNOW3LCOMPACTN',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE SNOW3LCOMPACTN
-!####################################################################
-!####################################################################
-!####################################################################
SUBROUTINE SNOW3LDRIFT(PTSTEP,PFORESTFRAC,PVMOD,PTA,PQA,PPS,PRHOA,&
PSNOWRHO,PSNOWDZ,PSNOW,OSNOWDRIFT_SUBLIM,PSNDRIFT)
!
@@ -1300,212 +1005,6 @@ IF (LHOOK) CALL DR_HOOK('SNOW3LDRIFT',1,ZHOOK_HANDLE)
END SUBROUTINE SNOW3LDRIFT
!####################################################################
!####################################################################
-!####################################################################
- SUBROUTINE SNOW3LTRANSF(PSNOW,PSNOWDZ,PSNOWDZN, &
- PSNOWRHO,PSNOWHEAT,PSNOWAGE)
-!
-!! PURPOSE
-!! -------
-! Snow mass,heat and characteristics redistibution in case of
-! grid resizing. Total mass and heat content of the overall snowpack
-! unchanged/conserved within this routine.
-! Same method as in Crocus
-!
-USE MODD_SNOW_PAR, ONLY : XSNOWCRITD
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-REAL, DIMENSION(: ), INTENT(IN) :: PSNOW
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWDZN
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWHEAT
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWRHO
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWDZ
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWAGE
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: JI, JL, JLO
-!
-INTEGER :: INI
-INTEGER :: INLVLS
-!
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWRHON
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWHEATN
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWAGEN
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWZTOP_NEW
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWZBOT_NEW
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWRHOO
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWHEATO
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWAGEO
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWDZO
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWZTOP_OLD
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWZBOT_OLD
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWHEAN
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSNOWAGN
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZMASTOTN
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZMASSDZO
-!
-REAL, DIMENSION(SIZE(PSNOW)) :: ZPSNOW_OLD, ZPSNOW_NEW
-REAL, DIMENSION(SIZE(PSNOW)) :: ZSUMHEAT, ZSUMSWE, ZSUMAGE, ZSNOWMIX_DELTA
-!
-REAL :: ZPROPOR
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-! 0. Initialization:
-! ------------------
-!
-!
-IF (LHOOK) CALL DR_HOOK('SNOW3LTRANSF',0,ZHOOK_HANDLE)
-!
-INI = SIZE(PSNOWRHO,1)
-INLVLS = SIZE(PSNOWRHO,2)
-!
-ZPSNOW_NEW(:) = 0.0
-ZPSNOW_OLD(:) = PSNOW(:)
-!
-DO JL=1,INLVLS
- DO JI=1,INI
- ZPSNOW_NEW(JI)=ZPSNOW_NEW(JI)+PSNOWDZN(JI,JL)
- ENDDO
-ENDDO
-!
-! initialization of variables describing the initial snowpack
-!
-ZSNOWDZO (:,:) = PSNOWDZ (:,:)
-ZSNOWRHOO (:,:) = PSNOWRHO (:,:)
-ZSNOWHEATO(:,:) = PSNOWHEAT(:,:)
-ZSNOWAGEO (:,:) = PSNOWAGE (:,:)
-ZMASSDZO (:,:) = XUNDEF
-!
-! 1. Calculate vertical grid limits (m):
-! --------------------------------------
-!
-ZSNOWZTOP_OLD(:,1) = ZPSNOW_OLD(:)
-ZSNOWZTOP_NEW(:,1) = ZPSNOW_NEW(:)
-ZSNOWZBOT_OLD(:,1) = ZSNOWZTOP_OLD(:,1)-ZSNOWDZO(:,1)
-ZSNOWZBOT_NEW(:,1) = ZSNOWZTOP_NEW(:,1)-PSNOWDZN(:,1)
-!
-DO JL=2,INLVLS
- DO JI=1,INI
- ZSNOWZTOP_OLD(JI,JL) = ZSNOWZBOT_OLD(JI,JL-1)
- ZSNOWZTOP_NEW(JI,JL) = ZSNOWZBOT_NEW(JI,JL-1)
- ZSNOWZBOT_OLD(JI,JL) = ZSNOWZTOP_OLD(JI,JL )-ZSNOWDZO(JI,JL)
- ZSNOWZBOT_NEW(JI,JL) = ZSNOWZTOP_NEW(JI,JL )-PSNOWDZN(JI,JL)
- ENDDO
-ENDDO
-ZSNOWZBOT_OLD(:,INLVLS)=0.0
-ZSNOWZBOT_NEW(:,INLVLS)=0.0
-!
-! 3. Calculate mass, heat, charcateristics mixing due to vertical grid resizing:
-! --------------------------------------------------------------------
-!
-! loop over the new snow layers
-! Summ or avergage of the constituting quantities of the old snow layers
-! which are totally or partially inserted in the new snow layer
-! For snow age, mass weighted average is used.
-!
-ZSNOWHEAN(:,:)=0.0
-ZMASTOTN (:,:)=0.0
-ZSNOWAGN (:,:)=0.0
-!
-DO JL=1,INLVLS
- DO JLO=1, INLVLS
- DO JI=1,INI
- IF((ZSNOWZTOP_OLD(JI,JLO)>ZSNOWZBOT_NEW(JI,JL)).AND.(ZSNOWZBOT_OLD(JI,JLO)<ZSNOWZTOP_NEW(JI,JL)))THEN
-!
- ZPROPOR = (MIN(ZSNOWZTOP_OLD(JI,JLO), ZSNOWZTOP_NEW(JI,JL)) &
- - MAX(ZSNOWZBOT_OLD(JI,JLO), ZSNOWZBOT_NEW(JI,JL)))&
- / ZSNOWDZO(JI,JLO)
-!
- ZMASSDZO (JI,JLO)=ZSNOWRHOO(JI,JLO)*ZSNOWDZO(JI,JLO)*ZPROPOR
-!
- ZMASTOTN (JI,JL)=ZMASTOTN (JI,JL)+ZMASSDZO (JI,JLO)
- ZSNOWAGN (JI,JL)=ZSNOWAGN (JI,JL)+ZSNOWAGEO (JI,JLO)*ZMASSDZO(JI,JLO)
-!
- ZSNOWHEAN(JI,JL)=ZSNOWHEAN(JI,JL)+ZSNOWHEATO(JI,JLO)*ZPROPOR
-!
- ENDIF
- ENDDO
- ENDDO
-ENDDO
-!
-! the new layer inherits from the weighted average properties of the old ones
-! heat and mass
-!
-ZSNOWHEATN(:,:)= ZSNOWHEAN(:,:)
-ZSNOWAGEN (:,:)= ZSNOWAGN (:,:)/ZMASTOTN(:,:)
-ZSNOWRHON (:,:)= ZMASTOTN (:,:)/PSNOWDZN(:,:)
-!
-! 4. Vanishing or very thin snowpack check:
-! -----------------------------------------
-!
-! NOTE: ONLY for very shallow snowpacks, mix properties (homogeneous):
-! this avoids problems related to heat and mass exchange for
-! thin layers during heavy snowfall or signifigant melt: one
-! new/old layer can exceed the thickness of several old/new layers.
-! Therefore, mix (conservative):
-!
-ZSUMHEAT(:) = 0.0
-ZSUMSWE(:) = 0.0
-ZSUMAGE(:) = 0.0
-ZSNOWMIX_DELTA(:) = 0.0
-!
-DO JL=1,INLVLS
- DO JI=1,INI
- IF(PSNOW(JI) < XSNOWCRITD)THEN
- ZSUMHEAT (JI) = ZSUMHEAT(JI) + PSNOWHEAT(JI,JL)
- ZSUMSWE (JI) = ZSUMSWE (JI) + PSNOWRHO (JI,JL)*PSNOWDZ(JI,JL)
- ZSUMAGE (JI) = ZSUMAGE (JI) + PSNOWAGE (JI,JL)
- ZSNOWMIX_DELTA(JI) = 1.0
- ENDIF
- ENDDO
-ENDDO
-!
-! Heat and mass are evenly distributed vertically:
-! heat and mass (density and thickness) are constant
-! in profile:
-!
-DO JL=1,INLVLS
- DO JI=1,INI
-!
- ZSNOWHEATN(JI,JL) = ZSNOWMIX_DELTA(JI)*(ZSUMHEAT(JI)/INLVLS) + &
- (1.0-ZSNOWMIX_DELTA(JI))*ZSNOWHEATN(JI,JL)
-!
- PSNOWDZN(JI,JL) = ZSNOWMIX_DELTA(JI)*(PSNOW(JI)/INLVLS) + &
- (1.0-ZSNOWMIX_DELTA(JI))*PSNOWDZN(JI,JL)
-!
- ZSNOWRHON(JI,JL) = ZSNOWMIX_DELTA(JI)*(ZSUMSWE(JI)/PSNOW(JI)) + &
- (1.0-ZSNOWMIX_DELTA(JI))*ZSNOWRHON(JI,JL)
-!
- ZSNOWAGEN(JI,JL) = ZSNOWMIX_DELTA(JI)*(ZSUMAGE(JI)/INLVLS) + &
- (1.0-ZSNOWMIX_DELTA(JI))*ZSNOWAGEN(JI,JL)
-!
- ENDDO
-ENDDO
-!
-! 5. Update mass (density and thickness) and heat:
-! ------------------------------------------------
-!
-PSNOWDZ (:,:) = PSNOWDZN (:,:)
-PSNOWRHO (:,:) = ZSNOWRHON (:,:)
-PSNOWHEAT(:,:) = ZSNOWHEATN(:,:)
-PSNOWAGE (:,:) = ZSNOWAGEN (:,:)
-!
-IF (LHOOK) CALL DR_HOOK('SNOW3LTRANSF',1,ZHOOK_HANDLE)
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE SNOW3LTRANSF
-!####################################################################
-!####################################################################
!####################################################################
SUBROUTINE SNOW3LRAD(OMEB, PSNOWDZMIN, PSW_RAD, PSNOWALB, &
PSPECTRALALBEDO, PSNOWDZ, PSNOWRHO, PALB, &
@@ -1518,11 +1017,11 @@ END SUBROUTINE SNOW3LTRANSF
! through the snowpack (using a form of Beer's Law: exponential
! decay of radiation with increasing snow depth).
!
-USE MODD_SNOW_PAR, ONLY : XVSPEC1,XVSPEC2,XVSPEC3,XVBETA1,XVBETA2, &
- XVBETA4,XVBETA3,XVBETA5, XMINCOSZEN
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
USE MODD_MEB_PAR, ONLY : XSW_WGHT_VIS, XSW_WGHT_NIR
!
-USE MODE_SNOW3L, ONLY : SNOW3LDOPT
+USE MODE_SNOW3L, ONLY : SNOW3LDOPT, SNOW3LRADABS_SFC
!
IMPLICIT NONE
!
@@ -1556,11 +1055,9 @@ INTEGER :: JJ, JI
INTEGER :: INI
INTEGER :: INLVLS
!
-REAL, DIMENSION(SIZE(PSNOWRHO,1)) :: ZRADTOT, ZPROJLAT, ZCOSZEN
-REAL, DIMENSION(SIZE(PSNOWRHO,1)) :: ZOPTICALPATH1, ZOPTICALPATH2, ZOPTICALPATH3
+REAL, DIMENSION(SIZE(PSNOWRHO,1)) :: ZRADTOT
!
REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZDSGRAIN, ZCOEF, ZSNOWDZ, ZAGE
-REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZBETA1, ZBETA2, ZBETA3, ZWORK
REAL, DIMENSION(SIZE(PSPECTRALALBEDO,1),SIZE(PSPECTRALALBEDO,2)) :: ZSPECTRALALBEDO
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -1574,7 +1071,7 @@ IF (LHOOK) CALL DR_HOOK('SNOW3LRAD',0,ZHOOK_HANDLE)
INI = SIZE(PSNOWDZ(:,:),1)
INLVLS = SIZE(PSNOWDZ(:,:),2)
!
-ZSPECTRALALBEDO(:,:) = 0. ! Init
+ZSPECTRALALBEDO(:,:) = XUNDEF ! Init
!
! 1. Vanishingly thin snowpack check:
! -----------------------------------
@@ -1593,16 +1090,6 @@ ZSNOWDZ(:,:) = MAX(PSNOWDZMIN, PSNOWDZ(:,:))
! SNOWCVEXT => from Bohren and Barkstrom 1974
! SNOWAGRAIN and SNOWBGRAIN=> from Jordan 1976)
!
-! Coefficient for taking into account the increase of path length of rays
-! in snow due to zenithal angle
-!
-ZCOSZEN(:)=MAX(XMINCOSZEN,COS(PZENITH(:)))
-!
-! This formulation is incorrect but it compensate partly the fact that
-! the albedo formulation does not account for zenithal angle.
-! Only for polar or glacier regions
-!
-ZPROJLAT(:)=(1.0-PPERMSNOWFRAC(:))+PPERMSNOWFRAC(:)/ZCOSZEN(:)
!
! Snow optical grain diameter (no age dependency over polar regions):
!
@@ -1614,17 +1101,8 @@ ENDDO
!
ZDSGRAIN(:,:) = SNOW3LDOPT(PSNOWRHO,ZAGE)
!
-! Extinction coefficient from Brun et al. (1989):
-!
-ZWORK(:,:)=SQRT(ZDSGRAIN(:,:))
-!
-ZBETA1(:,:)=MAX(XVBETA1*PSNOWRHO(:,:)/ZWORK(:,:),XVBETA2)
-ZBETA2(:,:)=MAX(XVBETA3*PSNOWRHO(:,:)/ZWORK(:,:),XVBETA4)
-ZBETA3(:,:)=XVBETA5
!
-ZOPTICALPATH1(:) = 0.0
-ZOPTICALPATH2(:) = 0.0
-ZOPTICALPATH3(:) = 0.0
+! Calculate the transmission of shortwave radiation within the snowpack:
!
IF(OMEB)THEN
@@ -1634,41 +1112,21 @@ IF(OMEB)THEN
ZSPECTRALALBEDO(:,1) = PSPECTRALALBEDO(:,1)
ZSPECTRALALBEDO(:,2) = (PSNOWALB(:) - XSW_WGHT_VIS*ZSPECTRALALBEDO(:,1))/XSW_WGHT_NIR
+!
+ ZCOEF(:,:) = SNOW3LRADABS_SFC(PSNOWRHO,ZSNOWDZ,ZSPECTRALALBEDO,PZENITH,PPERMSNOWFRAC,ZDSGRAIN)
- DO JJ=1,INLVLS
- DO JI=1,INI
- !
- ZOPTICALPATH1(JI) = ZOPTICALPATH1(JI) + ZBETA1(JI,JJ)*ZSNOWDZ(JI,JJ)
- ZOPTICALPATH2(JI) = ZOPTICALPATH2(JI) + ZBETA2(JI,JJ)*ZSNOWDZ(JI,JJ)
- !
- ZCOEF (JI,JJ) = XSW_WGHT_VIS*(1.0-ZSPECTRALALBEDO(JI,1))*EXP(-ZOPTICALPATH1(JI)*ZPROJLAT(JI)) &
- + XSW_WGHT_NIR*(1.0-ZSPECTRALALBEDO(JI,2))*EXP(-ZOPTICALPATH2(JI)*ZPROJLAT(JI))
- !
- ENDDO
- ENDDO
-
-! diagnose surface layer coef (should be very close/identical to ZCOEF(:,1) computed above)
+! Diagnose surface layer coef (should be very close/identical to ZCOEF(:,1) computed above)
- ZCOEF(:,1) = 1.0 - PSWNETSNOWS(:)/MAX(1.E-4,PSWNETSNOW(:))
+ ZCOEF(:,1) = 1.0 - PSWNETSNOWS(:)/MAX(1.E-4,PSWNETSNOW(:))
ELSE
-!
- DO JJ=1,INLVLS
- DO JI=1,INI
- !
- ZOPTICALPATH1(JI) = ZOPTICALPATH1(JI) + ZBETA1(JI,JJ)*ZSNOWDZ(JI,JJ)
- ZOPTICALPATH2(JI) = ZOPTICALPATH2(JI) + ZBETA2(JI,JJ)*ZSNOWDZ(JI,JJ)
- ZOPTICALPATH3(JI) = ZOPTICALPATH3(JI) + ZBETA3(JI,JJ)*ZSNOWDZ(JI,JJ)
- !
- ZCOEF (JI,JJ) = XVSPEC1*(1.0-PSPECTRALALBEDO(JI,1))*EXP(-ZOPTICALPATH1(JI)*ZPROJLAT(JI)) &
- + XVSPEC2*(1.0-PSPECTRALALBEDO(JI,2))*EXP(-ZOPTICALPATH2(JI)*ZPROJLAT(JI)) &
- + XVSPEC3*(1.0-PSPECTRALALBEDO(JI,3))*EXP(-ZOPTICALPATH3(JI)*ZPROJLAT(JI))
- !
- ENDDO
- ENDDO
- PSWNETSNOW(:) = PSW_RAD(:)*(1.-PSNOWALB(:))
- PSWNETSNOWS(:) = PSWNETSNOW(:)*(1.0-ZCOEF(:,1))
+! Consider 3 bands:
+
+ ZCOEF(:,:) = SNOW3LRADABS_SFC(PSNOWRHO,ZSNOWDZ,PSPECTRALALBEDO,PZENITH,PPERMSNOWFRAC,ZDSGRAIN)
+
+ PSWNETSNOW(:) = PSW_RAD(:)*(1.-PSNOWALB(:))
+ PSWNETSNOWS(:) = PSWNETSNOW(:)*(1.0-ZCOEF(:,1))
ENDIF
!
@@ -2169,10 +1627,19 @@ ENDIF
! NOTE: evaluate this term assuming the snow layer
! can't exceed the freezing point as this adjustment
! is made in melting routine. Then must adjust temperature
-! to conserve energy:
-!
-PGRNDFLUXO(:) = ZDTERM(:,INLVLS)*(ZSNOWTEMP(:,INLVLS) -PTG(:))
-PGRNDFLUX(:) = ZDTERM(:,INLVLS)*(MIN(XTT,ZSNOWTEMP(:,INLVLS))-PTG(:))
+! to conserve energy.
+! NOTE: if MEB used, surface fluxes are imposed and a test semi-implicit
+! ground-snow flux has already been estimated and snow-free ground fluxes
+! are generally weaker (and snow fractions are generally set to go to unity
+! faster than for the composite soil-veg case), thus this correction
+! is not as essential and is off.
+!
+PGRNDFLUXO(:) = ZDTERM(:,INLVLS)*(ZSNOWTEMP(:,INLVLS) -PTG(:))
+IF(OMEB)THEN
+ PGRNDFLUX(:) = PGRNDFLUXO(:)
+ELSE
+ PGRNDFLUX(:) = ZDTERM(:,INLVLS)*(MIN(XTT,ZSNOWTEMP(:,INLVLS))-PTG(:))
+ENDIF
!
ZSNOWTEMP(:,INLVLS) = ZSNOWTEMP(:,INLVLS) + (PGRNDFLUXO(:)-PGRNDFLUX(:))/ZCTERM(:,INLVLS)
!
diff --git a/src/SURFEX/snow_cover_1layer.F90 b/src/SURFEX/snow_cover_1layer.F90
index d596098a60f09419a4ccc6e316e57af0e005b459..51006fde5341663ec056faf3c3d7fec956311e87 100644
--- a/src/SURFEX/snow_cover_1layer.F90
+++ b/src/SURFEX/snow_cover_1layer.F90
@@ -3,17 +3,11 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE SNOW_COVER_1LAYER(PTSTEP, PANSMIN, PANSMAX, PTODRY, &
- PRHOSMIN, PRHOSMAX, PRHOFOLD, OALL_MELT, &
- PDRAIN_TIME, PWCRN, PZ0SN, PZ0HSN, &
- PTSNOW, PASNOW, PRSNOW, PWSNOW, PTS_SNOW, &
- PESNOW, &
- PTG, PTG_COEFA, PTG_COEFB, &
- PABS_SW, PLW1, PLW2, &
- PTA, PQA, PVMOD, PPS, PRHOA, PSR, &
- PZREF, PUREF, &
- PRNSNOW, PHSNOW, PLESNOW, PGSNOW, PMELT, &
- PDQS_SNOW, PABS_LW )
+ SUBROUTINE SNOW_COVER_1LAYER(PTSTEP, PANSMIN, PANSMAX, PTODRY, PRHOSMIN, PRHOSMAX, &
+ PRHOFOLD, OALL_MELT, PDRAIN_TIME, PWCRN, PZ0SN, PZ0HSN, &
+ TPSNOW, PTG, PTG_COEFA, PTG_COEFB, PABS_SW, PLW1, PLW2, &
+ PTA, PQA, PVMOD, PPS, PRHOA, PSR, PZREF, PUREF, PRNSNOW,&
+ PHSNOW, PLESNOW, PGSNOW, PMELT, PDQS_SNOW, PABS_LW )
! ##########################################################################
!
!!**** *SNOW_COVER_1LAYER*
@@ -62,6 +56,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TYPE_SNOW, ONLY : SURF_SNOW
+!
USE MODD_CSTS, ONLY : XTT, XCI, XRHOLI, XRHOLW, XCPD, XLSTT, XLMTT, XDAY, XCONDI
USE MODD_SNOW_PAR, ONLY : XEMISSN
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -95,12 +91,7 @@ REAL, INTENT(IN) :: PWCRN ! critical snow amount necessary
! to cover the considered surface
REAL, INTENT(IN) :: PZ0SN ! snow roughness length for momentum
REAL, INTENT(IN) :: PZ0HSN ! snow roughness length for heat
-REAL, DIMENSION(:), INTENT(INOUT) :: PWSNOW ! snow reservoir (kg/m2)
-REAL, DIMENSION(:), INTENT(INOUT) :: PTSNOW ! snow temperature
-REAL, DIMENSION(:), INTENT(INOUT) :: PASNOW ! snow albedo
-REAL, DIMENSION(:), INTENT(INOUT) :: PRSNOW ! snow density
-REAL, DIMENSION(:), INTENT(INOUT) :: PTS_SNOW ! snow surface temperature
-REAL, DIMENSION(:), INTENT(INOUT) :: PESNOW ! snow emissivity
+TYPE(SURF_SNOW), INTENT(INOUT) :: TPSNOW
REAL, DIMENSION(:), INTENT(IN) :: PTG ! underlying ground temperature
REAL, DIMENSION(:), INTENT(IN) :: PTG_COEFA! underlying ground temperature
REAL, DIMENSION(:), INTENT(IN) :: PTG_COEFB! implicit terms
@@ -139,40 +130,40 @@ REAL, DIMENSION(:), INTENT(OUT) :: PABS_LW ! absorbed LW rad by snow (W/m2)
REAL :: ZEXPL = 0.
REAL :: ZIMPL = 1.
!
-REAL, DIMENSION(SIZE(PWSNOW)) :: ZEXNS, ZEXNA, ZDIRCOSZW
-REAL, DIMENSION(SIZE(PWSNOW)) :: ZZ0 ! roughness length for momentum
-REAL, DIMENSION(SIZE(PWSNOW)) :: ZZ0H ! roughness length forheat
-!
-REAL, DIMENSION(SIZE(PWSNOW)) :: ZRI ! Richardson number
-REAL, DIMENSION(SIZE(PWSNOW)) :: ZAC ! aerodynamical conductance
-REAL, DIMENSION(SIZE(PWSNOW)) :: ZRA ! aerodynamical resistance
-REAL, DIMENSION(SIZE(PWSNOW)) :: ZCH ! drag coefficient for heat
-REAL, DIMENSION(SIZE(PWSNOW)) :: ZB, ZY ! coefficients in Ts eq.
-REAL, DIMENSION(SIZE(PWSNOW)) :: ZWSNOW ! snow before evolution
-REAL, DIMENSION(SIZE(PWSNOW)) :: ZSNOW_HC ! snow heat capacity
-REAL, DIMENSION(SIZE(PWSNOW)) :: ZSNOW_TC ! snow thermal conductivity
-REAL, DIMENSION(SIZE(PWSNOW)) :: ZSNOW_D ! snow depth
-REAL, DIMENSION(SIZE(PWSNOW)) :: ZMELT ! snow melting rate (kg/m3/s)
-REAL, DIMENSION(SIZE(PWSNOW)) :: ZTS_SNOW ! snow surface temperature
+REAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: ZEXNS, ZEXNA, ZDIRCOSZW
+REAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: ZZ0 ! roughness length for momentum
+REAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: ZZ0H ! roughness length forheat
+!
+REAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: ZRI ! Richardson number
+REAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: ZAC ! aerodynamical conductance
+REAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: ZRA ! aerodynamical resistance
+REAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: ZCH ! drag coefficient for heat
+REAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: ZB, ZY ! coefficients in Ts eq.
+REAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: ZWSNOW ! snow before evolution
+REAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: ZSNOW_HC ! snow heat capacity
+REAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: ZSNOW_TC ! snow thermal conductivity
+REAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: ZSNOW_D ! snow depth
+REAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: ZMELT ! snow melting rate (kg/m3/s)
+REAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: ZTS_SNOW ! snow surface temperature
! at previous time-step
-REAL, DIMENSION(SIZE(PWSNOW)) :: ZQSAT ! specific humidity
+REAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: ZQSAT ! specific humidity
! ! for ice
-REAL, DIMENSION(SIZE(PWSNOW)) :: ZDQSAT ! d(specific humidity)/dT
+REAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: ZDQSAT ! d(specific humidity)/dT
! ! for ice
!
-REAL, DIMENSION(SIZE(PWSNOW)) :: ZSR1, ZSR2 ! norm. snow precip.
+REAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: ZSR1, ZSR2 ! norm. snow precip.
!
-LOGICAL, DIMENSION(SIZE(PWSNOW)) :: GSNOWMASK ! where snow is
+LOGICAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: GSNOWMASK ! where snow is
! ! at previuos time-step
-LOGICAL, DIMENSION(SIZE(PWSNOW)) :: GFLUXMASK ! where fluxes can
+LOGICAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: GFLUXMASK ! where fluxes can
! ! be computed at
! ! new time-step
! ! i.e. snow occurence
! ! at previous time-step
! ! OR snow fall
-INTEGER, DIMENSION(SIZE(PWSNOW)) :: JSNOWMASK1, JSNOWMASK2, JSNOWMASK3 ! where snow is or not
+INTEGER, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: JSNOWMASK1, JSNOWMASK2, JSNOWMASK3 ! where snow is or not
! ! at previuos time-step
-INTEGER, DIMENSION(SIZE(PWSNOW)) :: JFLUXMASK ! where fluxes can
+INTEGER, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: JFLUXMASK ! where fluxes can
! ! be computed at
! ! new time-step
! ! i.e. snow occurence
@@ -182,10 +173,10 @@ INTEGER, DIMENSION(SIZE(PWSNOW)) :: JFLUXMASK ! where fluxes can
REAL :: ZWSNOW_MIN = 0.1 ! minimum value of snow content (kg/m2) for prognostic
! ! computations
!
-REAL, DIMENSION(SIZE(PWSNOW)) :: ZEI_SNOW ! internal energy of snow
-REAL, DIMENSION(SIZE(PWSNOW)) :: ZPEI_SNOW ! internal energy of snow at t+
-REAL, DIMENSION(SIZE(PWSNOW)) :: ZWORK1
-REAL, DIMENSION(SIZE(PWSNOW)) :: ZDQSATI, ZQSATI
+REAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: ZEI_SNOW ! internal energy of snow
+REAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: ZPEI_SNOW ! internal energy of snow at t+
+REAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: ZWORK1
+REAL, DIMENSION(SIZE(TPSNOW%WSNOW,1)) :: ZDQSATI, ZQSATI
!
INTEGER :: JJ, JI, JCOMPT_SNOW1, JCOMPT_SNOW2, JCOMPT_SNOW3, JCOMPT_FLUX
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -212,7 +203,7 @@ PABS_LW(:) = XUNDEF
!
!* snow reservoir before evolution
!
-ZWSNOW(:) = PWSNOW(:)
+ZWSNOW(:) = TPSNOW%WSNOW(:,1)
ZTS_SNOW(:) = MIN(XTT,PTG(:))
!
ZSNOW_D (:) = 0.
@@ -267,7 +258,7 @@ DO JJ=1,SIZE(ZWSNOW)
IF (ZWSNOW(JJ)>0.) THEN
GSNOWMASK(JJ)=.TRUE.
!* surface temperature
- ZTS_SNOW(JJ)=PTS_SNOW(JJ)
+ ZTS_SNOW(JJ) = TPSNOW%TS(JJ)
GFLUXMASK(JJ)=.TRUE.
!gsnowmask=t
JCOMPT_SNOW1=JCOMPT_SNOW1+1
@@ -282,10 +273,10 @@ DO JJ=1,SIZE(ZWSNOW)
ELSE
!lower limit of snow cover for prognostic computations
!0.1 kg/m2 of snow water content
- PTSNOW(JJ)=MIN(PTG(JJ),XTT)
+ TPSNOW%T(JJ,1) = MIN(PTG(JJ),XTT)
ENDIF
ELSE
- PTSNOW(JJ)=MIN(PTG(JJ),XTT)
+ TPSNOW%T(JJ,1) = MIN(PTG(JJ),XTT)
!gsnowmask=false
JCOMPT_SNOW2=JCOMPT_SNOW2+1
JSNOWMASK2(JCOMPT_SNOW2) = JJ
@@ -331,13 +322,13 @@ DO JJ=1,JCOMPT_SNOW1
JI = JSNOWMASK1(JJ)
!
!* 2.1 snow heat capacity
- ZSNOW_HC(JI) = PRSNOW(JI) * XCI * XRHOLI / XRHOLW
+ ZSNOW_HC(JI) = TPSNOW%RHO(JI,1) * XCI * XRHOLI / XRHOLW
!* 2.2 snow depth
- ZSNOW_D(JI) = ZWSNOW(JI) / PRSNOW(JI)
+ ZSNOW_D(JI) = ZWSNOW(JI) / TPSNOW%RHO(JI,1)
!* 2.3 snow thermal conductivity
- ZSNOW_TC(JI) = XCONDI * (PRSNOW(JI)/XRHOLW)**1.885
+ ZSNOW_TC(JI) = XCONDI * (TPSNOW%RHO(JI,1)/XRHOLW)**1.885
!* 2.4 internal energy of snow
- ZEI_SNOW(JI) = ZSNOW_HC(JI)*ZSNOW_D(JI)*PTSNOW(JI)
+ ZEI_SNOW(JI) = ZSNOW_HC(JI)*ZSNOW_D(JI)*TPSNOW%T(JI,1)
!
ENDDO
!
@@ -385,17 +376,17 @@ DO JJ=1,JCOMPT_SNOW3
!* 3.2 coefficients from solar radiation
! ---------------------------------
!
- ZY(JI) = ZY(JI) + ZWORK1(JI) * PTSNOW(JI) + PABS_SW(JI)
+ ZY(JI) = ZY(JI) + ZWORK1(JI) * TPSNOW%T(JI,1) + PABS_SW(JI)
!
!
!* 3.3 coefficients from infra-red radiation
! -------------------------------------
!
- ZWORK1(JI) = PLW2(JI) * PTSNOW(JI)**3
+ ZWORK1(JI) = PLW2(JI) * TPSNOW%T(JI,1)**3
!
ZB(JI) = ZB(JI) - 4 * ZIMPL * ZWORK1(JI)
!
- ZY(JI) = ZY(JI) + PLW1(JI) + ZWORK1(JI) * (ZEXPL-3.*ZIMPL) * PTSNOW(JI)
+ ZY(JI) = ZY(JI) + PLW1(JI) + ZWORK1(JI) * (ZEXPL-3.*ZIMPL) * TPSNOW%T(JI,1)
!
!
!* 3.4 coefficients from sensible heat flux
@@ -405,7 +396,7 @@ DO JJ=1,JCOMPT_SNOW3
!
ZB(JI) = ZB(JI) + ZWORK1(JI) * ZIMPL
!
- ZY(JI) = ZY(JI) - ZWORK1(JI) * ( ZEXPL * PTSNOW(JI) - PTA(JI) )
+ ZY(JI) = ZY(JI) - ZWORK1(JI) * ( ZEXPL * TPSNOW%T(JI,1) - PTA(JI) )
!
!
!* 3.6 coefficients from latent heat flux
@@ -415,7 +406,7 @@ DO JJ=1,JCOMPT_SNOW3
!
ZB(JI) = ZB(JI) + ZWORK1(JI) * ZIMPL * ZDQSAT(JI)
!
- ZY(JI) = ZY(JI) - ZWORK1(JI) * ( ZQSAT(JI) - PQA(JI) - ZIMPL * ZDQSAT(JI)*PTSNOW(JI) )
+ ZY(JI) = ZY(JI) - ZWORK1(JI) * ( ZQSAT(JI) - PQA(JI) - ZIMPL * ZDQSAT(JI)*TPSNOW%T(JI,1) )
!
!* 3.7 coefficients from conduction flux at snow base
! ----------------------------------------------
@@ -424,13 +415,13 @@ DO JJ=1,JCOMPT_SNOW3
!
ZB(JI) = ZB(JI) + ZWORK1(JI) * ZIMPL / ( 1. + ZWORK1(JI)*PTG_COEFA(JI) )
!
- ZY(JI) = ZY(JI) - ZWORK1(JI) * (ZEXPL * PTSNOW(JI) - PTG_COEFB(JI)) &
+ ZY(JI) = ZY(JI) - ZWORK1(JI) * (ZEXPL * TPSNOW%T(JI,1) - PTG_COEFB(JI)) &
/ ( 1. + ZWORK1(JI)*PTG_COEFA(JI) )
!
!* 3.8 guess of snow temperature before accumulation and melting
! ---------------------------------------------------------
!
- PTSNOW(JI) = ZY(JI) / ZB(JI)
+ TPSNOW%T(JI,1) = ZY(JI) / ZB(JI)
!
ENDDO
!
@@ -447,11 +438,11 @@ DO JJ=1,JCOMPT_SNOW1
!
JI = JSNOWMASK1(JJ)
!
- ZMELT(JI) = MAX( PTSNOW(JI) - XTT , 0. ) * ZSNOW_HC(JI) / XLMTT / PTSTEP
+ ZMELT(JI) = MAX( TPSNOW%T(JI,1) - XTT , 0. ) * ZSNOW_HC(JI) / XLMTT / PTSTEP
!
ZMELT(JI) = MIN( ZMELT(JI) , ZWSNOW(JI) / ZSNOW_D(JI) / PTSTEP )
!
- PTSNOW(JI) = MIN( PTSNOW(JI) , XTT )
+ TPSNOW%T(JI,1) = MIN( TPSNOW%T(JI,1) , XTT )
!
ENDDO
!
@@ -479,7 +470,7 @@ PMELT(:) = ZMELT(:) * ZSNOW_D(:)
!* 5.3 qsat (Tsnow)
! ------------
!
-ZQSATI = QSATI(PTSNOW(:),PPS(:))
+ZQSATI = QSATI(TPSNOW%T(:,1),PPS(:))
WHERE (GFLUXMASK(:))
ZQSAT(:) = ZQSATI(:)
END WHERE
@@ -492,7 +483,7 @@ DO JJ = 1, JCOMPT_FLUX
!
JI = JFLUXMASK(JJ)
!
- PABS_LW(JI) = PLW1(JI) + PLW2(JI) * PTSNOW(JI)**4
+ PABS_LW(JI) = PLW1(JI) + PLW2(JI) * TPSNOW%T(JI,1)**4
!
PRNSNOW(JI) = PABS_SW(JI) + PABS_LW(JI)
!
@@ -500,7 +491,7 @@ DO JJ = 1, JCOMPT_FLUX
!* 5.2 sensible heat flux
! ------------------
!
- PHSNOW(JI) = XCPD * PRHOA(JI) * ZAC(JI) * ( PTSNOW(JI) - PTA(JI) )
+ PHSNOW(JI) = XCPD * PRHOA(JI) * ZAC(JI) * ( TPSNOW%T(JI,1) - PTA(JI) )
!
!
!* 5.4 latent heat flux
@@ -512,8 +503,8 @@ DO JJ = 1, JCOMPT_FLUX
!* 5.5 Conduction heat flux
! --------------------
!
- !PGSNOW(JI) = ZSNOW_TC(JI)/(0.5*ZSNOW_D(JI)) * ( PTSNOW(JI) - PTG(JI) )
- PGSNOW(JI) = ZSNOW_TC(JI)/(0.5*ZSNOW_D(JI)) * ( PTSNOW(JI) - PTG_COEFB(JI) ) &
+ !PGSNOW(JI) = ZSNOW_TC(JI)/(0.5*ZSNOW_D(JI)) * ( TPSNOW%T(JI,1) - PTG(JI) )
+ PGSNOW(JI) = ZSNOW_TC(JI)/(0.5*ZSNOW_D(JI)) * ( TPSNOW%T(JI,1) - PTG_COEFB(JI) ) &
/ ( 1. + ZSNOW_TC(JI)/(0.5*ZSNOW_D(JI))*PTG_COEFA(JI) )
!
!
@@ -530,33 +521,33 @@ ENDDO
! -------------------
!
!cdir nodep
-DO JJ = 1, SIZE(PWSNOW)
+DO JJ = 1, SIZE(TPSNOW%WSNOW,1)
!
!* 6.1 snow fall
! ---------
!
- PWSNOW(JJ) = PWSNOW(JJ) + PTSTEP * PSR(JJ)
+ TPSNOW%WSNOW(JJ,1) = TPSNOW%WSNOW(JJ,1) + PTSTEP * PSR(JJ)
!
!
!* 6.2 sublimation
! -----------
!
- PLESNOW(JJ) = MIN( PLESNOW(JJ), XLSTT*PWSNOW(JJ)/PTSTEP )
+ PLESNOW(JJ) = MIN( PLESNOW(JJ), XLSTT*TPSNOW%WSNOW(JJ,1)/PTSTEP )
!
- PWSNOW(JJ) = MAX( PWSNOW(JJ) - PTSTEP * PLESNOW(JJ)/XLSTT , 0.)
+ TPSNOW%WSNOW(JJ,1) = MAX( TPSNOW%WSNOW(JJ,1) - PTSTEP * PLESNOW(JJ)/XLSTT , 0.)
!
- IF ( PWSNOW(JJ)<1.E-8 * PTSTEP ) PWSNOW(JJ) = 0.
+ IF ( TPSNOW%WSNOW(JJ,1)<1.E-8 * PTSTEP ) TPSNOW%WSNOW(JJ,1) = 0.
!
!* 6.3 melting
! -------
!
- PMELT(JJ) = MIN( PMELT(JJ), PWSNOW(JJ)/PTSTEP )
+ PMELT(JJ) = MIN( PMELT(JJ), TPSNOW%WSNOW(JJ,1)/PTSTEP )
!
- PWSNOW(JJ)= MAX( PWSNOW(JJ) - PTSTEP * PMELT(JJ) , 0.)
+ TPSNOW%WSNOW(JJ,1)= MAX( TPSNOW%WSNOW(JJ,1) - PTSTEP * PMELT(JJ) , 0.)
!
- IF ( PWSNOW(JJ)<1.E-8 * PTSTEP ) PWSNOW(JJ) = 0.
+ IF ( TPSNOW%WSNOW(JJ,1)<1.E-8 * PTSTEP ) TPSNOW%WSNOW(JJ,1) = 0.
!
- IF (PWSNOW(JJ)==0.) PGSNOW(JJ) = MAX ( PGSNOW(JJ), - PMELT(JJ)*XLMTT )
+ IF (TPSNOW%WSNOW(JJ,1)==0.) PGSNOW(JJ) = MAX ( PGSNOW(JJ), - PMELT(JJ)*XLMTT )
!
ENDDO
!
@@ -564,21 +555,21 @@ ENDDO
! -----------------------
!
IF (PDRAIN_TIME>0.) THEN
- WHERE ( PWSNOW(:)>0.)
- PWSNOW(:) = PWSNOW(:) * EXP(-PTSTEP/PDRAIN_TIME/XDAY)
+ WHERE ( TPSNOW%WSNOW(:,1)>0.)
+ TPSNOW%WSNOW(:,1) = TPSNOW%WSNOW(:,1) * EXP(-PTSTEP/PDRAIN_TIME/XDAY)
END WHERE
END IF
!
!* 6.5 melting of last 1mm of snow depth
! ---------------------------------
!
-WHERE ( PWSNOW(:)<ZWSNOW_MIN .AND. PMELT(:)>0. .AND. PSR(:)==0. )
- PMELT(:) = PMELT(:) + PWSNOW(:) / PTSTEP
- PWSNOW(:)=0.
+WHERE ( TPSNOW%WSNOW(:,1)<ZWSNOW_MIN .AND. PMELT(:)>0. .AND. PSR(:)==0. )
+ PMELT(:) = PMELT(:) + TPSNOW%WSNOW(:,1) / PTSTEP
+ TPSNOW%WSNOW(:,1)=0.
END WHERE
!
-WHERE ( PWSNOW(:)<1.E-8 * PTSTEP )
- PWSNOW(:) = 0.
+WHERE ( TPSNOW%WSNOW(:,1)<1.E-8 * PTSTEP )
+ TPSNOW%WSNOW(:,1) = 0.
END WHERE
!
!-------------------------------------------------------------------------------
@@ -597,12 +588,11 @@ DO JJ=1,JCOMPT_SNOW1
!
IF (PMELT(JI) > 0. ) THEN
!
- PASNOW(JI) = (PASNOW(JI)-PANSMIN)*EXP(-PRHOFOLD*PTSTEP/XDAY) + PANSMIN &
- + PSR(JI)*PTSTEP/PWCRN*PANSMAX
+ TPSNOW%ALB(JI) = (TPSNOW%ALB(JI)-PANSMIN)*EXP(-PRHOFOLD*PTSTEP/XDAY) + PANSMIN &
+ + PSR(JI)*PTSTEP/PWCRN*PANSMAX
!
ELSEIF (PMELT(JI)==0.) THEN
- PASNOW(JI) = PASNOW(JI) - PTODRY*PTSTEP/XDAY &
- + PSR(JI)*PTSTEP/PWCRN*PANSMAX
+ TPSNOW%ALB(JI) = TPSNOW%ALB(JI) - PTODRY*PTSTEP/XDAY + PSR(JI)*PTSTEP/PWCRN*PANSMAX
!
ENDIF
!
@@ -621,12 +611,12 @@ DO JJ = 1, JCOMPT_SNOW1
!
JI = JSNOWMASK1(JJ)
!
- IF (PWSNOW(JI)>0. ) THEN
+ IF (TPSNOW%WSNOW(JI,1)>0. ) THEN
!
- ZSR1(JI) = MAX( PWSNOW(JI) , PSR(JI) * PTSTEP )
+ ZSR1(JI) = MAX( TPSNOW%WSNOW(JI,1) , PSR(JI) * PTSTEP )
!
- PRSNOW(JI) = (PRSNOW(JI)-PRHOSMAX)*EXP(-PRHOFOLD*PTSTEP/XDAY) + PRHOSMAX
- PRSNOW(JI) = ( (ZSR1(JI)-PSR(JI)*PTSTEP) * PRSNOW(JI) &
+ TPSNOW%RHO(JI,1) = (TPSNOW%RHO(JI,1)-PRHOSMAX)*EXP(-PRHOFOLD*PTSTEP/XDAY) + PRHOSMAX
+ TPSNOW%RHO(JI,1) = ( (ZSR1(JI)-PSR(JI)*PTSTEP) * TPSNOW%RHO(JI,1) &
+ (PSR(JI)*PTSTEP) * PRHOSMIN ) / ZSR1(JI)
ENDIF
!
@@ -636,14 +626,14 @@ ENDDO
! ----------
!
!cdir nodep
-DO JJ=1,SIZE(PWSNOW)
- IF ( PWSNOW(JJ)>0. ) THEN
- PASNOW(JJ) = MAX(PASNOW(JJ),PANSMIN)
- PASNOW(JJ) = MIN(PASNOW(JJ),PANSMAX)
+DO JJ=1,SIZE(TPSNOW%WSNOW,1)
+ IF ( TPSNOW%WSNOW(JJ,1)>0. ) THEN
+ TPSNOW%ALB(JJ) = MAX(TPSNOW%ALB(JJ),PANSMIN)
+ TPSNOW%ALB(JJ) = MIN(TPSNOW%ALB(JJ),PANSMAX)
IF (ZWSNOW(JJ)==0.) THEN
- PASNOW(JJ) = PANSMAX
- PESNOW(JJ) = XEMISSN
- PRSNOW(JJ) = PRHOSMIN
+ TPSNOW%ALB (JJ) = PANSMAX
+ TPSNOW%EMIS (JJ) = XEMISSN
+ TPSNOW%RHO(JJ,1) = PRHOSMIN
ENDIF
ENDIF
ENDDO
@@ -658,13 +648,12 @@ DO JJ=1,JCOMPT_SNOW3
!
JI = JSNOWMASK3(JJ)
!
- IF (PSR(JI)>0. .AND. PWSNOW(JI)>0.) THEN
+ IF (PSR(JI)>0. .AND. TPSNOW%WSNOW(JI,1)>0.) THEN
!
- ZSR2(JI) = MIN( PWSNOW(JI) , PSR(JI) * PTSTEP )
+ ZSR2(JI) = MIN( TPSNOW%WSNOW(JI,1) , PSR(JI) * PTSTEP )
!
- PTSNOW(JI) =( ( PWSNOW(JI) - ZSR2(JI) ) * PTSNOW(JI) &
- + ZSR2(JI) * MIN( PTA (JI) ,XTT ))&
- /( PWSNOW(JI) )
+ TPSNOW%T(JI,1) =( ( TPSNOW%WSNOW(JI,1) - ZSR2(JI) ) * TPSNOW%T(JI,1) &
+ + ZSR2(JI) * MIN( PTA (JI) ,XTT )) / ( TPSNOW%WSNOW(JI,1) )
ENDIF
!
ENDDO
@@ -679,7 +668,7 @@ ENDDO
! subroutine init_snow_lw.f90
!
WHERE (GSNOWMASK(:) )
- PTS_SNOW(:) = PTSNOW(:)
+ TPSNOW%TS(:) = TPSNOW%T(:,1)
END WHERE
!
!-------------------------------------------------------------------------------
@@ -690,12 +679,12 @@ END WHERE
!* 11.1 snow characteristics where snow IS present at current time-step
! ---------------------------------------------------------------
!
-WHERE (PWSNOW(:)==0.)
- PTSNOW (:) = XUNDEF
- PRSNOW (:) = XUNDEF
- PASNOW (:) = XUNDEF
- PTS_SNOW(:) = XUNDEF
- PESNOW (:) = XUNDEF
+WHERE (TPSNOW%WSNOW(:,1)==0.)
+ TPSNOW%T(:,1) = XUNDEF
+ TPSNOW%RHO(:,1) = XUNDEF
+ TPSNOW%ALB(:) = XUNDEF
+ TPSNOW%TS(:) = XUNDEF
+ TPSNOW%EMIS(:) = XUNDEF
END WHERE
!
!
@@ -704,7 +693,7 @@ END WHERE
!* 12. Heat storage inside snow pack
!
WHERE (GSNOWMASK(:))
- ZPEI_SNOW(:) = ZSNOW_HC(:)*ZSNOW_D(:)*PTSNOW(:)
+ ZPEI_SNOW(:) = ZSNOW_HC(:)*ZSNOW_D(:)*TPSNOW%T(:,1)
ELSEWHERE
ZPEI_SNOW(:) = 0.
END WHERE
diff --git a/src/SURFEX/snow_load_meb.F90 b/src/SURFEX/snow_load_meb.F90
index 0d970745f385a40a9e1ae6337d6e79cae9b3a8ae..519deaab653cdc7597e507352f1701733a2b7bc1 100644
--- a/src/SURFEX/snow_load_meb.F90
+++ b/src/SURFEX/snow_load_meb.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ############################################################################
-SUBROUTINE SNOW_LOAD_MEB(PTSTEP,PSR,PTV,PWRVNMAX,PKVN,PCHEATV,PLERCV,PLESC,PMELTVN, &
- PVELC,PMELTCV,PFRZCV,PUNLOADSNOW,PWRV,PWRVN,PSUBVCOR,PLVTT,PLSTT)
+SUBROUTINE SNOW_LOAD_MEB(PK, PEK, DEK, PTSTEP, PSR, PWRVNMAX, PKVN, PCHEATV, PMELTVN, &
+ PVELC, PSUBVCOR)
! ############################################################################
!
!!**** *SNOW_LOAD_MEB*
@@ -45,6 +45,9 @@ SUBROUTINE SNOW_LOAD_MEB(PTSTEP,PSR,PTV,PWRVNMAX,PKVN,PCHEATV,PLERCV,PLESC,PMELT
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_n, ONLY : ISBA_PE_t, ISBA_P_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+!
USE MODD_CSTS, ONLY : XTT, XLMTT
!
USE MODD_SNOW_PAR, ONLY : XRHOSMAX_ES
@@ -56,15 +59,15 @@ IMPLICIT NONE
!
!* 0.1 Declaration of Arguments
!
-REAL, INTENT(IN) :: PTSTEP
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK
!
-REAL, DIMENSION(:), INTENT(IN) :: PLVTT, PLSTT
-REAL, DIMENSION(:), INTENT(IN) :: PSR,PCHEATV, PLERCV, PVELC, &
- PLESC, PMELTVN, PWRVNMAX, PKVN
+REAL, INTENT(IN) :: PTSTEP
!
-REAL, DIMENSION(:), INTENT(INOUT) :: PWRVN, PWRV, PTV
+REAL, DIMENSION(:), INTENT(IN) :: PSR, PCHEATV, PVELC, PMELTVN, PWRVNMAX, PKVN
!
-REAL, DIMENSION(:), INTENT(OUT) :: PMELTCV, PFRZCV, PUNLOADSNOW, PSUBVCOR
+REAL, DIMENSION(:), INTENT(OUT) :: PSUBVCOR
!
!
!* 0.2 declarations of local variables
@@ -98,16 +101,17 @@ ZUNLOAD(:) = 0.0
! only during the timestep when vegetation has just been buried:
!
!
+!
WHERE(PWRVNMAX(:) == 0.0)
!
- PUNLOADSNOW(:) = PWRVN(:)/PTSTEP ! kg m-2 s-1
- PWRVN(:) = 0.0
+ DEK%XSR_GN(:) = PEK%XWRVN(:)/PTSTEP ! kg m-2 s-1
+ PEK%XWRVN(:) = 0.0
! for a totally buried canopy, the following are zero:
- PMELTCV(:) = 0.0
- PFRZCV(:) = 0.0
- PSUBVCOR(:) = 0.0
+ DEK%XMELT_CV(:) = 0.0
+ DEK%XFRZ_CV(:) = 0.0
+ PSUBVCOR(:) = 0.0
!
!
ELSEWHERE
@@ -120,26 +124,31 @@ ELSEWHERE
!
! Interception: gain
- ZSRINT(:) = MAX(0.0,PWRVNMAX(:)-PWRVN(:))*(1.0-EXP(-PKVN(:)*PSR(:)*PTSTEP)) ! kg m-2
+
+ ZSRINT(:) = MAX(0.0,PWRVNMAX(:)-PEK%XWRVN(:))*(1.0-EXP(-PKVN(:)*PSR(:)*PTSTEP)) ! kg m-2
ZSRINT(:) = MIN(PSR(:)*PTSTEP, ZSRINT(:)) ! kg m-2
- ZWRVN(:) = PWRVN(:) + ZSRINT(:) ! kg m-2
+ ZWRVN(:) = PEK%XWRVN(:) + ZSRINT(:) ! kg m-2
+
+ DEK%XSR_GN(:) = MAX(0.0, PSR(:) - ZSRINT(:)/PTSTEP) ! kg m-2 s-1
+
+END WHERE
- PUNLOADSNOW(:) = MAX(0.0, PSR(:) - ZSRINT(:)/PTSTEP) ! kg m-2 s-1
+ WHERE(PWRVNMAX(:) /= 0.0)
! Sublimation: gain or loss
! NOTE for the rare case that sublimation exceeds snow mass (possible as traces of snow disappear)
! compute a mass correction to be removed from soil (to conserve mass): PSUBVCOR
- ZSUB(:) = PLESC(:)*(PTSTEP/PLSTT(:)) ! kg m-2
+ ZSUB(:) = DEK%XLES_CV(:)*(PTSTEP/PK%XLSTT(:)) ! kg m-2
PSUBVCOR(:) = MAX(0.0, ZSUB(:) - ZWRVN(:))/PTSTEP ! kg m-2 s-1
ZWRVN(:) = MAX(0.0, ZWRVN(:) - ZSUB(:)) ! kg m-2
! Phase change: loss (melt of snow mass)
- PMELTCV(:) = PTSTEP*MAX(0.0, PMELTVN(:)) ! kg m-2
- PMELTCV(:) = MIN(PMELTCV(:), ZWRVN(:))
- ZWRVN(:) = ZWRVN(:) - PMELTCV(:)
- PWRV(:) = PWRV(:) + PMELTCV(:) ! NOTE...liq reservoir can exceed maximum holding
+ DEK%XMELT_CV(:) = PTSTEP*MAX(0.0, PMELTVN(:)) ! kg m-2
+ DEK%XMELT_CV(:) = MIN(DEK%XMELT_CV(:), ZWRVN(:))
+ ZWRVN(:) = ZWRVN(:) - DEK%XMELT_CV(:)
+ PEK%XWR(:) = PEK%XWR(:) + DEK%XMELT_CV(:) ! NOTE...liq reservoir can exceed maximum holding
! capacity here, but this is accounted for
! in main prognostic PWRV routine.
@@ -148,30 +157,30 @@ ELSEWHERE
! estimation of water for freezing:
! Also, update liquid water stored on the canopy here:
- PFRZCV(:) = PTSTEP*MAX(0.0, -PMELTVN(:)) ! kg m-2
- PFRZCV(:) = MIN(PFRZCV(:), MAX(0.0,PWRV(:)-PLERCV(:)*(PTSTEP/PLVTT(:))))
- ZWRVN(:) = ZWRVN(:) + PFRZCV(:)
- PWRV(:) = PWRV(:) - PFRZCV(:)
+ DEK%XFRZ_CV(:) = PTSTEP*MAX(0.0, -PMELTVN(:)) ! kg m-2
+ DEK%XFRZ_CV(:) = MIN(DEK%XFRZ_CV(:), MAX(0.0,PEK%XWR(:)-DEK%XLER_CV(:)*(PTSTEP/PK%XLVTT(:))))
+ ZWRVN(:) = ZWRVN(:) + DEK%XFRZ_CV(:)
+ PEK%XWR(:) = PEK%XWR(:) - DEK%XFRZ_CV(:)
! Unloading (falling off branches, etc...): loss
! Note, the temperature effect is assumed to vanish for cold temperatures.
- ZUNLOAD(:) = MIN(ZWRVN(:), PWRVN(:)*( PVELC(:)*(PTSTEP/ZUNLOAD_V) &
- + MAX(0.0, PTV(:)-ZUNLOAD_TT)*(PTSTEP/ZUNLOAD_T) )) ! kg m-2
- ZWRVN(:) = ZWRVN(:) - ZUNLOAD(:) ! kg m-2
- PUNLOADSNOW(:) = PUNLOADSNOW(:) + ZUNLOAD(:)/PTSTEP
+ ZUNLOAD(:) = MIN(ZWRVN(:), PEK%XWRVN(:)*( PVELC(:)*(PTSTEP/ZUNLOAD_V) &
+ + MAX(0.0, PEK%XTV(:)-ZUNLOAD_TT)*(PTSTEP/ZUNLOAD_T) )) ! kg m-2
+ ZWRVN(:) = ZWRVN(:) - ZUNLOAD(:) ! kg m-2
+ DEK%XSR_GN(:) = DEK%XSR_GN(:) + ZUNLOAD(:)/PTSTEP
! Diagnostic updates:
! final phase change (units)
- PMELTCV(:) = PMELTCV(:)/PTSTEP ! kg m-2 s-1
- PFRZCV(:) = PFRZCV(:) /PTSTEP ! kg m-2 s-1
+ DEK%XMELT_CV(:) = DEK%XMELT_CV(:)/PTSTEP ! kg m-2 s-1
+ DEK%XFRZ_CV(:) = DEK%XFRZ_CV(:) /PTSTEP ! kg m-2 s-1
! Prognostic Updates:
- PWRVN(:) = ZWRVN(:)
+ PEK%XWRVN(:) = ZWRVN(:)
- PTV(:) = PTV(:) + (PFRZCV(:) - PMELTCV(:))*(XLMTT*PTSTEP)/PCHEATV(:) ! K
+ PEK%XTV(:) = PEK%XTV(:) + (DEK%XFRZ_CV(:) - DEK%XMELT_CV(:))*(XLMTT*PTSTEP)/PCHEATV(:) ! K
END WHERE
!
diff --git a/src/SURFEX/snowcro.F90 b/src/SURFEX/snowcro.F90
index bc62d2e1246dae12177415429797048978d6a26e..7c52c9cd7d8839e6019ce5ff5f612de11a271239 100644
--- a/src/SURFEX/snowcro.F90
+++ b/src/SURFEX/snowcro.F90
@@ -131,7 +131,7 @@
USE MODD_TYPE_DATE_SURF, ONLY: DATE_TIME
!
USE MODD_CSTS, ONLY : XTT, XRHOLW, XLMTT,XLSTT,XLVTT, XCL, XCI, XPI, XRHOLI
-USE MODD_SNOW_PAR, ONLY : XZ0ICEZ0SNOW, XRHOTHRESHOLD_ICE
+USE MODD_SNOW_PAR, ONLY : XZ0ICEZ0SNOW, XRHOTHRESHOLD_ICE, XPERCENTAGEPORE
USE MODD_SNOW_METAMO
USE MODD_CONST_TARTES, ONLY: NPNIMP, XPSNOWG0, XPSNOWY0, XPSNOWW0, XPSNOWB0
!
@@ -279,7 +279,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PXLAT,PXLON ! LAT/LON after packing
!
LOGICAL, INTENT(IN) :: OSNOWDRIFT, OSNOWDRIFT_SUBLIM ! activate snowdrift, sublimation during drift
LOGICAL, INTENT(IN) :: OSNOW_ABS_ZENITH ! activate parametrization of solar absorption for polar regions
- CHARACTER(3), INTENT(IN) :: HSNOWMETAMO, HSNOWRAD
+CHARACTER(3), INTENT(IN) :: HSNOWMETAMO, HSNOWRAD
!-----------------------
! Metamorphism scheme
! HSNOWMETAMO=B92 Brun et al 1992
@@ -1003,7 +1003,8 @@ ENDIF
DO JJ = 1,SIZE(ZSNOW)
! active layers
DO JST = 1,INLVLS_USE(JJ)
- ZWHOLDMAX (JJ,JST) = SNOWCROHOLD( PSNOWRHO(JJ,JST),PSNOWLIQ(JJ,JST),PSNOWDZ(JJ,JST) )
+ ZWHOLDMAX (JJ,JST) = XPERCENTAGEPORE/XRHOLI * (PSNOWDZ(JJ,JST) * &
+ (XRHOLI-PSNOWRHO(JJ,JST)) + PSNOWLIQ(JJ,JST)*XRHOLW)
ZLIQHEATXS(JJ) = MAX( 0.0, (PSNOWLIQ(JJ,JST) - ZWHOLDMAX(JJ,JST)) * XRHOLW ) * XLMTT/PTSTEP
PSNOWLIQ (JJ,JST) = PSNOWLIQ(JJ,JST) - ZLIQHEATXS(JJ)*PTSTEP/(XRHOLW*XLMTT)
PSNOWLIQ (JJ,JST) = MAX( 0.0, PSNOWLIQ(JJ,JST) )
@@ -1120,7 +1121,7 @@ PQS(:) = ZQSAT(:)
!
IF (LHOOK) CALL DR_HOOK('SNOWCRO',1,ZHOOK_HANDLE)
!
- CONTAINS
+CONTAINS
!
!####################################################################
!####################################################################
@@ -1176,7 +1177,7 @@ REAL, DIMENSION(:), INTENT(OUT) :: PSNOW ! Snowheight UNIT : m
REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWGRAN1, PSNOWGRAN2, PSNOWHIST, &!Snowtype variables
PSNOWLIQ ! Snow liquid water content UNIT ???
INTEGER, DIMENSION(:), INTENT(IN) :: INLVLS_USE ! Number of snow layers used
- CHARACTER(3), INTENT(IN) :: HSNOWMETAMO ! metamorphism scheme
+CHARACTER(3), INTENT(IN) :: HSNOWMETAMO ! metamorphism scheme
!
!* 0.2 declarations of local variables
!
@@ -1466,7 +1467,7 @@ INTEGER, DIMENSION(:), INTENT(IN) :: INLVLS_USE
!
REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWAGE
!
- CHARACTER(3), INTENT(IN) :: HSNOWMETAMO ! metamorphism scheme
+CHARACTER(3), INTENT(IN) :: HSNOWMETAMO ! metamorphism scheme
!
! 0.2 declaration of local variables
!
@@ -1914,7 +1915,7 @@ INTEGER, DIMENSION(:), INTENT(IN) :: KNLVLS_USE
!
REAL, DIMENSION(:), INTENT(IN) :: PZENITH ! solar zenith angle for future use
!
- CHARACTER(3),INTENT(IN) :: HSNOWMETAMO ! metamorphism scheme
+CHARACTER(3),INTENT(IN) :: HSNOWMETAMO ! metamorphism scheme
!
!* 0.2 declarations of local variables
!
@@ -2035,7 +2036,7 @@ REAL, INTENT(IN) :: PVAGE1
REAL, INTENT(IN) :: PSNOWGRAN1, PSNOWGRAN2, PSNOWAGE
REAL, DIMENSION(3), INTENT(OUT) :: PALB
!
- CHARACTER(3),INTENT(IN)::HSNOWMETAMO
+CHARACTER(3),INTENT(IN)::HSNOWMETAMO
!
REAL :: ZDIAM, ZDIAM_SQRT
!
@@ -2111,7 +2112,7 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWRHO, PSNOWDZ
!
LOGICAL, INTENT(IN) :: OSNOW_ABS_ZENITH ! parametrization for polar regions (not physic but better results)
! ! default FALSE
- CHARACTER(3), INTENT(IN) :: HSNOWMETAMO
+CHARACTER(3), INTENT(IN) :: HSNOWMETAMO
!
REAL, DIMENSION(:), INTENT(OUT) :: PRADXS
!
@@ -2944,7 +2945,8 @@ DO JJ=1,SIZE(PSNOWDZ,1)
DO JST=1,KNLVLS_USE(JJ)
ZSNOWRHO (JJ,JST) = PSNOWRHO(JJ,JST)
ZSNOWTEMP(JJ,JST) = PSNOWTEMP(JJ,JST)
- ZWHOLDMAX(JJ,JST) = SNOWCROHOLD( PSNOWRHO(JJ,JST),PSNOWLIQ(JJ,JST),PSNOWDZ(JJ,JST) )
+ ZWHOLDMAX(JJ,JST) = XPERCENTAGEPORE/XRHOLI * (PSNOWDZ(JJ,JST) * &
+ (XRHOLI-PSNOWRHO(JJ,JST)) + PSNOWLIQ(JJ,JST)*XRHOLW)
ENDDO
ENDDO
!
@@ -2985,8 +2987,8 @@ DO JJ = 1,SIZE(PSNOWDZ,1) ! loop JJ grid points
!
! Difference with ISBA-ES: a possible cooling of current refreezing water
! is taken into account to calculate temperature change
- ZNUMER = ( ZSNOWRHO(JJ,JST) * ZSNOWDZ(JJ,JST) - ( PSNOWLIQ(JJ,JST) - ZFLOWLIQ(JJ,JST-1) ) * XRHOLW )
- ZDENOM = ( ZSNOWRHO(JJ,JST) * ZSNOWDZ(JJ,JST) - ( ZSNOWLIQ(JJ,JST) - ZFLOWLIQ(JJ,JST-1) ) * XRHOLW )
+ ZNUMER = ( ZSNOWRHO(JJ,JST) * ZSNOWDZ(JJ,JST) - ( PSNOWLIQ(JJ,JST) - ZFLOWLIQ(JJ,JST-1) ) * XRHOLW )
+ ZDENOM = ( ZSNOWRHO(JJ,JST) * ZSNOWDZ(JJ,JST) - ( ZSNOWLIQ(JJ,JST) - ZFLOWLIQ(JJ,JST-1) ) * XRHOLW )
!
PSNOWTEMP(JJ,JST) = XTT + ( ZSNOWTEMP(JJ,JST)-XTT )*ZNUMER/ZDENOM + ZPHASE(JJ,JST)/( XCI*ZDENOM )
!
@@ -3001,7 +3003,7 @@ DO JJ = 1,SIZE(PSNOWDZ,1) ! loop JJ grid points
!
! 5. Density is adjusted to conserve the mass
! --------------------------------------------------------------
- ZNUMER = ( ZSNOWRHO(JJ,JST) * PSNOWDZ(JJ,JST) - ( ZFLOWLIQ(JJ,JST) - ZFLOWLIQ(JJ,JST-1) ) * XRHOLW )
+ ZNUMER = ( ZSNOWRHO(JJ,JST) * PSNOWDZ(JJ,JST) - ( ZFLOWLIQ(JJ,JST) - ZFLOWLIQ(JJ,JST-1) ) * XRHOLW )
!
ZSNOWRHO(JJ,JST) = ZNUMER / ZSNOWDZ(JJ,JST)
!
@@ -3476,7 +3478,7 @@ REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWTEMP ! snow temperature profile
REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWLIQ ! snow liquid water profile (m)
!
INTEGER, DIMENSION(:), INTENT(IN) :: KNLVLS_USE
- CHARACTER(3), INTENT(IN) :: HSNOWMETAMO ! metamorphism scheme
+CHARACTER(3), INTENT(IN) :: HSNOWMETAMO ! metamorphism scheme
!
!* 0.2 declarations of local variables
!
@@ -3668,7 +3670,7 @@ LOGICAL, DIMENSION(:), INTENT(OUT) :: OMODIF_GRID
INTEGER, DIMENSION(:), INTENT(INOUT) :: KNLVLS_USE
LOGICAL,INTENT(IN) :: OSNOWDRIFT ! if snowdrift then grain types are not modified by wind
- CHARACTER(3), INTENT(IN) :: HSNOWMETAMO ! metamorphism scheme
+CHARACTER(3), INTENT(IN) :: HSNOWMETAMO ! metamorphism scheme
!* 0.2 declarations of local variables
!
!
@@ -4501,7 +4503,7 @@ INTEGER, INTENT(IN) :: KNLVLS_USE
!
LOGICAL, INTENT(IN) :: GSNOWFALL
!
- CHARACTER(3),INTENT(IN) :: HSNOWMETAMO
+CHARACTER(3),INTENT(IN) :: HSNOWMETAMO
!
!* 0.2 declarations of local variables
!
@@ -4733,7 +4735,7 @@ REAL, DIMENSION(:),INTENT(IN) :: PZ0EFF,PUREF
!
LOGICAL,INTENT(IN) :: OSNOWDRIFT_SUBLIM
!
- CHARACTER(3), INTENT(IN) :: HSNOWMETAMO ! metamorphism scheme
+CHARACTER(3), INTENT(IN) :: HSNOWMETAMO ! metamorphism scheme
!
REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWRHO, PSNOWDZ,PSNOWGRAN1, &
PSNOWGRAN2,PSNOWHIST
@@ -5117,7 +5119,7 @@ INTEGER, INTENT(IN) :: KLAYERS
REAL, DIMENSION(:), INTENT(IN) :: PSNOWDZ,PSNOWRHO,PSNOWTEMP,PSNOWLIQ, &
PSNOWHEAT,PSNOWGRAN1,PSNOWGRAN2, &
PSNOWHIST,PSNOWAGE
- CHARACTER(3), INTENT(IN) :: HSNOWMETAMO
+CHARACTER(3), INTENT(IN) :: HSNOWMETAMO
!
REAL, DIMENSION(KLAYERS) :: ZSNOWSSA
REAL :: ZDIAM
diff --git a/src/SURFEX/snowcro_diag.F90 b/src/SURFEX/snowcro_diag.F90
new file mode 100644
index 0000000000000000000000000000000000000000..995071193b32436480565ff040c531528f872a8d
--- /dev/null
+++ b/src/SURFEX/snowcro_diag.F90
@@ -0,0 +1,271 @@
+! #########
+
+SUBROUTINE SNOWCRO_DIAG(HSNOWMETAMO, &
+ PSNOWDZ, PSNOWSWE, PSNOWRHO, PSNOWGRAN1, PSNOWGRAN2, PSNOWAGE, &
+ PSNOWHIST, PSNOWTEMP, PSNOWLIQ, PDIRCOSZW, PSNOWDEND, PSNOWSPHER, &
+ PSNOWSIZE, PSNOWSSA, PSNOWTYPEMEPRA, PSNOWRAM, PSNOWSHEAR, &
+ PSNOWDEPTH_1DAYS, PSNOWDEPTH_3DAYS, PSNOWDEPTH_5DAYS, &
+ PSNOWDEPTH_7DAYS, PSNOWSWE_1DAYS, PSNOWSWE_3DAYS, PSNOWSWE_5DAYS,&
+ PSNOWSWE_7DAYS, PSNOWRAM_SONDE, PSNOW_WETTHICKNESS, PSNOW_REFROZENTHICKNESS)
+
+! Diagnostics of Crocus snowpack model
+! Author: M. Lafaysse, Meteo-France, October 2015
+
+USE MODD_SURF_PAR, ONLY : XUNDEF
+
+USE MODD_CSTS,ONLY : XRHOLI, XRHOLW
+
+USE MODD_SNOW_PAR,ONLY : ICRIS_DEND1D, ICRIS_NONDEND1D, &
+ IFR, IFR_LB, ILB, ILB_FIN, ILB_ANG, IROUL, IFIN, IFIN_AR, IFIN_ANG, &
+ IPL, IPL_GOB, IGOB, IGEL, IGOB_FON, IRON_ANG, XX, XD1, XD2, XD3
+
+IMPLICIT NONE
+
+CHARACTER(3), INTENT(IN) :: HSNOWMETAMO ! metamorphism option
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PSNOWDZ
+REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWSWE
+REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWRHO
+REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWGRAN1
+REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWGRAN2
+REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWAGE
+REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWHIST
+REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWTEMP
+REAL, DIMENSION(:,:), INTENT(IN) :: PSNOWLIQ
+REAL, DIMENSION(:), INTENT(IN) :: PDIRCOSZW !cosine of slope
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSNOWDEND
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSNOWSPHER
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSNOWSIZE
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSNOWSSA
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSNOWTYPEMEPRA
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSNOWRAM
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSNOWSHEAR
+REAL, DIMENSION(:), INTENT(OUT) :: PSNOWDEPTH_1DAYS
+REAL, DIMENSION(:), INTENT(OUT) :: PSNOWDEPTH_3DAYS
+REAL, DIMENSION(:), INTENT(OUT) :: PSNOWDEPTH_5DAYS
+REAL, DIMENSION(:), INTENT(OUT) :: PSNOWDEPTH_7DAYS
+REAL, DIMENSION(:), INTENT(OUT) :: PSNOWSWE_1DAYS
+REAL, DIMENSION(:), INTENT(OUT) :: PSNOWSWE_3DAYS
+REAL, DIMENSION(:), INTENT(OUT) :: PSNOWSWE_5DAYS
+REAL, DIMENSION(:), INTENT(OUT) :: PSNOWSWE_7DAYS
+REAL, DIMENSION(:), INTENT(OUT) :: PSNOWRAM_SONDE
+REAL, DIMENSION(:), INTENT(OUT) :: PSNOW_WETTHICKNESS
+REAL, DIMENSION(:), INTENT(OUT) :: PSNOW_REFROZENTHICKNESS
+
+REAL :: ZG1, ZG2, ZRFIN, ZRDEN, ZRFGF
+
+REAL :: ZDIAM
+
+LOGICAL,DIMENSION(SIZE(PSNOWSWE,1)) :: GRAM, GWET, GREFROZEN
+
+INTEGER :: ICLASS_DEND, ICLASS_SPHER, ICLASS_SIZE, ICLASS_HIST
+INTEGER :: ICLASS
+LOGICAL :: LTHERM
+
+INTEGER :: JJ,JST
+
+! PRINT*,ASSOCIATED(PSNOWDEPTH_1DAYS),ASSOCIATED(PSNOWDEPTH_3DAYS)
+! PRINT*,ASSOCIATED(PSNOWDEPTH_5DAYS),ASSOCIATED(PSNOWDEPTH_7DAYS)
+! PRINT*,"in snowcrodiag"
+! PRINT*,ALLOCATED(PSNOWDEPTH_1DAYS),ALLOCATED(PSNOWDEPTH_3DAYS)
+! PRINT*,ALLOCATED(PSNOWDEPTH_5DAYS),ALLOCATED(PSNOWDEPTH_7DAYS)
+! PRINT*,SIZE(PSNOWDEPTH_1DAYS),SIZE(PSNOWDEPTH_3DAYS)
+! PRINT*,SIZE(PSNOWDEPTH_5DAYS),SIZE(PSNOWDEPTH_7DAYS)
+
+! Initializations
+
+PSNOWDEND = XUNDEF
+PSNOWSPHER = XUNDEF
+PSNOWSIZE = XUNDEF
+PSNOWSSA = XUNDEF
+PSNOWTYPEMEPRA = XUNDEF
+PSNOWRAM = XUNDEF
+PSNOWSHEAR = XUNDEF
+
+PSNOWDEPTH_1DAYS = 0.
+PSNOWDEPTH_3DAYS = 0.
+PSNOWDEPTH_5DAYS = 0.
+PSNOWDEPTH_7DAYS = 0.
+PSNOWSWE_1DAYS = 0.
+PSNOWSWE_3DAYS = 0.
+PSNOWSWE_5DAYS = 0.
+PSNOWSWE_7DAYS = 0.
+PSNOWRAM_SONDE = 0.
+PSNOW_WETTHICKNESS = 0.
+PSNOW_REFROZENTHICKNESS = 0.
+GRAM = .TRUE.
+GWET = .TRUE.
+GREFROZEN = .TRUE.
+
+DO JST=1,SIZE(PSNOWSWE,2)
+ DO JJ=1,SIZE(PSNOWSWE,1)
+
+ IF (PSNOWSWE(JJ,JST)>0) THEN
+
+ ! In this routine Crocus diagnostics are perpendicular to the slope.
+ ! The projection is done in diag_misc_isban
+
+ ZG1 = PSNOWGRAN1(JJ,JST)/99.
+ ZRFIN = 0.17*PSNOWRHO(JJ,JST)-31
+
+ IF (PSNOWGRAN1(JJ,JST)>=0) THEN
+ !Non dendritic case
+
+ !Dendricity,sphericty and grain size
+ PSNOWSIZE(JJ,JST) = PSNOWGRAN2(JJ,JST)
+ PSNOWDEND(JJ,JST) = 0
+ PSNOWSPHER(JJ,JST) = PSNOWGRAN1(JJ,JST) / XX
+
+ !Optical diameter for SSA diagnostic
+ ZDIAM = PSNOWSIZE(JJ,JST) * PSNOWSPHER(JJ,JST) + &
+ MAX( 0.0004, 0.5*PSNOWSIZE(JJ,JST) ) * ( 1.-PSNOWSPHER(JJ,JST) )
+
+ !10 classes of sphericity 0:[0,0.05[, 1:[0.05,0.15[, ..., 9:[0.85,1.0]
+ !###########Strange way of defining sphericity classes -> Check with very old versions
+ !###########ICLASS_SPHER = MIN(NINT(10 * PSNOWSPHER(JJ,JST)),9) Not exactly the same
+ ICLASS_SPHER = MIN(INT(10 * PSNOWSPHER(JJ,JST) + 0.05),9)
+
+
+ !6 classes of historical variable {0,1,...,5}
+ !##########Why is PSNOWHIST stored as float64. It always takes only 6 integer values
+ ICLASS_HIST = NINT(PSNOWHIST(JJ,JST))
+
+ !3 classes of grain size in mm 0:[0,0.55[, 1:[0.55,1.05[, 2:[1.05, +inf[
+ !#########Strange +0.05
+ IF (PSNOWSIZE(JJ,JST) < 0.00055) THEN
+ ICLASS_SIZE = 0
+ ELSEIF (PSNOWSIZE(JJ,JST) < 0.00105) THEN
+ ICLASS_SIZE = 1
+ ELSE
+ ICLASS_SIZE = 2
+ ENDIF
+
+ !Overall 10x3x6 classes from 1 to 180 (included)
+ ICLASS = 1 + ICLASS_SPHER + ICLASS_SIZE*10 + ICLASS_HIST*30
+
+ !Snow type obtained in table ICRIS_NONDEND1D
+ PSNOWTYPEMEPRA(JJ,JST) = ICRIS_NONDEND1D(ICLASS)
+
+
+ ! Ram resistance (non dendritic case)
+ ! PSNOWLIQ tel massique en m
+ ! PSNOWLIQ*XHROLW/PSNOWDZ tel volumique en kg m-3
+ ! PSNOWLIQ/PSNOWDZ : rapport sans unité
+ ! Seuil à 0.5% soit 0.005
+ LTHERM=((PSNOWTEMP(JJ,JST)<272.96).OR.(PSNOWLIQ(JJ,JST)/PSNOWDZ(JJ,JST)<=0.005))
+
+ SELECT CASE (NINT(PSNOWTYPEMEPRA(JJ,JST)))
+ CASE (IFIN)
+ PSNOWRAM(JJ,JST)=MAX(3.,ZRFIN)
+ CASE (IFIN_ANG)
+ IF (PSNOWRHO(JJ,JST)<200) THEN
+ PSNOWRAM(JJ,JST)=ZRFIN*PSNOWSPHER(JJ,JST)+&
+ (1- PSNOWSPHER(JJ,JST))*(ZRFIN*(0.8-PSNOWSIZE(JJ,JST))+2*PSNOWSIZE(JJ,JST))
+ ELSE
+ PSNOWRAM(JJ,JST)=2
+ ENDIF
+ CASE (IFIN_AR,IGEL,IGOB_FON,IRON_ANG)
+
+ IF (LTHERM) THEN
+ PSNOWRAM(JJ,JST)=MAX(10.,0.103*PSNOWRHO(JJ,JST)-19.666)
+ ELSE
+ IF (PSNOWRHO(JJ,JST)<250) THEN
+ PSNOWRAM(JJ,JST)=1
+ ELSE
+ PSNOWRAM(JJ,JST)=MAX(2.,0.16*PSNOWRHO(JJ,JST)-54)
+ ENDIF
+ END IF
+
+ CASE (IPL,IPL_GOB)
+ IF (PSNOWSIZE(JJ,JST)>0.8) THEN
+ PSNOWRAM(JJ,JST)=MAX(3.,ZRFIN)*(0.8-PSNOWSIZE(JJ,JST))+2*PSNOWSIZE(JJ,JST)
+ ELSE
+ PSNOWRAM(JJ,JST)=2
+ ENDIF
+ CASE DEFAULT
+ END SELECT
+
+ ELSE
+ !Dendritic case
+
+ !Dendricity,sphericty and grain size
+ PSNOWSIZE(JJ,JST) = XUNDEF !Grain size not defined for dendritic snow
+ PSNOWDEND(JJ,JST) = -PSNOWGRAN1(JJ,JST) / XX
+ PSNOWSPHER(JJ,JST) = PSNOWGRAN2(JJ,JST) / XX
+
+ !Optical diameter for SSA diagnostic
+ ZDIAM = PSNOWDEND(JJ,JST) * XD1 + (1 - PSNOWDEND(JJ,JST)) * &
+ (PSNOWSPHER(JJ,JST) * XD2 + (1 - PSNOWSPHER(JJ,JST)) * XD3)
+ !ZDIAM = -PSNOWGRAN1(JJ,JST)*XD1/XX + (1.+PSNOWGRAN1(JJ,JST)/XX) * &
+ ! ( PSNOWGRAN2(JJ,JST)*XD2/XX + (1.-PSNOWGRAN2(JJ,JST)/XX) * XD3 )
+ ZDIAM = ZDIAM/10000.
+
+ !10 classes of dendricity 0:[0,0.1[, ..., 9:[0.9,1.0[ (value 1.0 does not exist)
+ ICLASS_DEND = INT(10 * PSNOWDEND(JJ,JST))
+
+ !10 classes of sphericity 0:[0,0.05[, 1:[0.05,0.15[, ..., 9:[0.85,1.0]
+ !###########Strange way of defining sphericity classes -> Check with very old versions
+ !###########ICLASS_SPHER = MIN(NINT(10 * PSNOWSPHER(JJ,JST)),9) Not exactly the same
+ ICLASS_SPHER = MIN(INT(10 * PSNOWSPHER(JJ,JST) + 0.05),9)
+
+ !Overall 10x10 classes from 1 to 100 (included)
+ ICLASS = 1 + ICLASS_DEND + ICLASS_SPHER*10
+
+ !Snow type obtained in table ICRIS_DEND1D
+ PSNOWTYPEMEPRA(JJ,JST) = ICRIS_DEND1D(ICLASS)
+
+ ENDIF
+
+ ! All cases
+ ! Compute depth and SWE of recent snow
+ IF(PSNOWAGE(JJ,JST)<=1)THEN
+ PSNOWDEPTH_1DAYS(JJ) = PSNOWDEPTH_1DAYS(JJ) + PSNOWDZ (JJ,JST)
+ PSNOWSWE_1DAYS (JJ) = PSNOWSWE_1DAYS (JJ) + PSNOWSWE(JJ,JST)
+ ENDIF
+
+ IF(PSNOWAGE(JJ,JST)<=3)THEN
+ PSNOWDEPTH_3DAYS(JJ) = PSNOWDEPTH_3DAYS(JJ) + PSNOWDZ (JJ,JST)
+ PSNOWSWE_3DAYS (JJ) = PSNOWSWE_3DAYS (JJ) + PSNOWSWE(JJ,JST)
+ ENDIF
+
+ IF(PSNOWAGE(JJ,JST)<=5)THEN
+ PSNOWDEPTH_5DAYS(JJ) = PSNOWDEPTH_5DAYS(JJ) + PSNOWDZ (JJ,JST)
+ PSNOWSWE_5DAYS (JJ) = PSNOWSWE_5DAYS (JJ) + PSNOWSWE(JJ,JST)
+ ENDIF
+
+ IF(PSNOWAGE(JJ,JST)<=7)THEN
+ PSNOWDEPTH_7DAYS(JJ) = PSNOWDEPTH_7DAYS(JJ) + PSNOWDZ (JJ,JST)
+ PSNOWSWE_7DAYS (JJ) = PSNOWSWE_7DAYS (JJ) + PSNOWSWE(JJ,JST)
+ END IF
+
+ ! Ram sonde penetration
+ IF ((GRAM(JJ)).AND.(PSNOWRAM(JJ,JST)<=2.)) THEN
+ PSNOWRAM_SONDE(JJ)=PSNOWRAM_SONDE(JJ)+PSNOWDZ(JJ,JST)
+ ELSE
+ GRAM(JJ)=.FALSE.
+ ENDIF
+
+ ! Depth of wet snow
+ IF ((GWET(JJ)).AND.(PSNOWLIQ(JJ,JST)>0.)) THEN
+ PSNOW_WETTHICKNESS(JJ)=PSNOW_WETTHICKNESS(JJ)+PSNOWDZ(JJ,JST)
+ ELSE
+ GWET(JJ)=.FALSE.
+ ENDIF
+ ! Depth of refrozen snow
+ IF ((GREFROZEN(JJ)).AND.(PSNOWHIST(JJ,JST)>=2).AND.(PSNOWTEMP(JJ,JST)<273.15)) THEN
+ PSNOW_REFROZENTHICKNESS(JJ)=PSNOW_REFROZENTHICKNESS(JJ)+PSNOWDZ(JJ,JST)
+ ELSE
+ GREFROZEN(JJ)=.FALSE.
+ ENDIF
+
+ ! Specific surface area
+ IF ( HSNOWMETAMO=='B92' ) THEN
+ PSNOWSSA(JJ,JST) = 6. / (XRHOLI*ZDIAM)
+ ELSE
+ PSNOWSSA(JJ,JST) = 6. / (XRHOLI*PSNOWGRAN1(JJ,JST))
+ END IF
+
+ END IF
+ END DO
+END DO
+
+END SUBROUTINE SNOWCRO_DIAG
diff --git a/src/SURFEX/soda.F90 b/src/SURFEX/soda.F90
deleted file mode 100644
index 58b6b9c5bf661fbf82677365035ce717353e036f..0000000000000000000000000000000000000000
--- a/src/SURFEX/soda.F90
+++ /dev/null
@@ -1,1333 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! *****************************************************************************************
-PROGRAM SODA
-
-#ifdef USE_SODA
-!
-! ------------------------------------------------------------------------------------------
-!!
-!! SODA: SURFEX Offline Data Assimilation
-!!
-!! PURPOSE
-!! -------
-!! Program to perform surface data assimilation within SURFEX
-!!
-!!
-!! METHOD
-!! ------
-!! Different methods for different tiles
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! T. Aspelien met.no
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 04/2012
-!!
-!! 03/2014 E. Martin change indices names in OMP module according to GMAP changes
-! 05/2013 B. Decharme New coupling variables XTSURF (for AGCM)
-! 02/2016 B. Decharme MODD_IO_SURF_ARO not used
-!----------------------------------------------------------------------------
-!
-USE MODD_OFF_SURFEX_n
-USE MODE_MODELN_SURFEX_HANDLER
-!
-USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, WLOG_MPI, PREP_LOG_MPI, NPROC, NCOMM, &
- NINDEX, NSIZE_TASK, END_LOG_MPI, NSIZE
-USE MODD_SURFEX_OMP, ONLY : NINDX2SFX, NWORK, XWORK, XWORK2, XWORK3, &
- NWORK_FULL, XWORK_FULL, XWORK2_FULL, NWORK2, &
- NWORK2_FULL
-!
-USE MODD_MASK, ONLY: NMASK_FULL
-!
-USE MODD_TYPE_DATE_SURF, ONLY : DATE_TIME
-!
-USE MODD_SURF_CONF, ONLY : CPROGNAME, CSOFTWARE
-USE MODD_SURF_PAR, ONLY : XUNDEF,NUNDEF
-!
-USE MODD_ASSIM, ONLY : LASSIM, LAROME, LALADSURF, CASSIM_ISBA, NVAR, XF, XF_PATCH, &
- NOBSTYPE, XAT2M_ISBA, XAHU2M_ISBA, CVAR, COBS, NECHGU, XI, &
- XLAI_PASS, XBIO_PASS, CBIO, NIVAR, XYO, NIFIC, NPRINTLEV, &
- NOBS, NPRINTLEV, LREAD_ALL, NENS,LBIAS_CORRECTION, &
- LEXTRAP_SEA,LEXTRAP_WATER,LEXTRAP_NATURE,LOBSHEADER,NOBSMAX, &
- CFILE_FORMAT_FG,CFILE_FORMAT_LSM,CFILE_FORMAT_OBS,CFILE_FORMAT_CLIM,&
- NNCO,LWATERTG2,LOBSNAT
-!
-USE MODD_FORC_ATM, ONLY : CSV, XDIR_ALB, XSCA_ALB, XEMIS, XTSRAD, XTSUN, XZS, &
- XZREF, XUREF, XTA, XQA, XSV, XU, XV, XSW_BANDS, &
- XZENITH, XAZIM, XCO2, XRHOA, XTSURF
-!
-USE MODD_WRITE_BIN, ONLY : NWRITE
-!
-#ifdef SFX_OL
-USE MODD_IO_SURF_OL, ONLY : XSTART, XCOUNT, XSTRIDE, XSTARTW, XCOUNTW, LTIME_WRITTEN, &
- LDEFINED_NATURE, LDEFINED_SEA, LDEFINED_WATER, &
- LDEFINED_TOWN, LDEFINED_SURF_ATM, LPARTW
-
-#endif
-!
-#ifdef SFX_NC
-USE MODD_IO_SURF_NC, ONLY : CFILEIN_NC, CFILEIN_NC_SAVE, CFILEPGD_NC, CFILEOUT_NC, LDEF, &
- CLUOUT_NC
-#endif
-#ifdef SFX_ASC
-USE MODD_IO_SURF_ASC, ONLY : CFILEIN, CFILEIN_SAVE, CFILEPGD, CFILEOUT, LCREATED
-#endif
-#ifdef SFX_FA
-USE MODD_IO_SURF_FA, ONLY : CFILEIN_FA, CFILEIN_FA_SAVE, CFILEPGD_FA, CDNOMC, CFILEOUT_FA, &
- NUNIT_FA, IVERBFA, LFANOCOMPACT
-#endif
-#ifdef SFX_LFI
-USE MODD_IO_SURF_LFI, ONLY : CFILEIN_LFI, CFILEIN_LFI_SAVE, &
- CFILEPGD_LFI, CFILE_LFI, CLUOUT_LFI, CFILEOUT_LFI
-#endif
-!
-USE MODN_IO_OFFLINE, ONLY : NAM_IO_OFFLINE, CNAMELIST, CPGDFILE, CPREPFILE, CSURFFILE, &
- CSURF_FILETYPE, CTIMESERIES_FILETYPE, LLAND_USE, YALG_MPI, &
- LDIAG_FA_NOCOMPACT, LOUT_TIMENAME, XIO_FRAC, LRESTART_2M
-!
-USE MODE_POS_SURF, ONLY : POSNAM
-!
-USE MODI_DEALLOC_SURF_ATM_N
-USE MODI_INIT_OUTPUT_OL_N
-USE MODI_SET_SURFEX_FILEIN
-USE MODI_INIT_INDEX_MPI
-USE MODI_GATHER_AND_WRITE_MPI
-USE MODI_READ_AND_SEND_MPI
-USE MODI_ABOR1_SFX
-USE MODI_GET_LUOUT
-USE MODI_OPEN_NAMELIST
-USE MODI_CLOSE_NAMELIST
-USE MODI_READ_ALL_NAMELISTS
-USE MODI_INIT_IO_SURF_n
-USE MODI_END_IO_SURF_n
-USE MODI_READ_SURF
-USE MODI_IO_BUFF_CLEAN
-USE MODI_GET_SIZE_FULL_n
-USE MODI_INIT_SURF_ATM_n
-USE MODI_ASSIM_SURF_ATM_n
-USE MODI_WRITE_SURF_ATM_n
-USE MODI_WRITE_DIAG_SURF_ATM_n
-USE MODI_ASSIM_SET_SST
-USE MODI_ADD_FORECAST_TO_DATE_SURF
-USE MODI_FLAG_UPDATE
-USE MODI_FLAG_DIAG_UPDATE
-USE MODI_TEST_NAM_VAR_SURF
-USE MODI_INIT_OUTPUT_NC_n
-USE MODI_CLOSE_FILEOUT_OL
-!
-USE MODE_EKF, ONLY : GET_FILE_NAME, SET_FILEIN
-!
-USE YOMHOOK, ONLY : LHOOK,DR_HOOK
-USE PARKIND1, ONLY : JPRB
-!
-IMPLICIT NONE
-!
-#ifdef SFX_MPI
-INCLUDE 'mpif.h'
-#endif
-!
-!* 0. Declaration of local variables
-! ------------------------------
-!
- CHARACTER(LEN=200) :: YMFILE ! Name of the observation, perturbed or reference file!
- CHARACTER(LEN=3) :: YINIT
- CHARACTER(LEN=2), PARAMETER :: YTEST = 'OK' ! must be equal to 'OK'
- CHARACTER(LEN=28) :: YATMFILE =' ' ! name of the Atmospheric file
- CHARACTER(LEN=6) :: YATMFILETYPE =' ' ! type of the Atmospheric file
- CHARACTER(LEN=28) :: YLUOUT ='LISTING_SODA ' ! name of listing
- CHARACTER(LEN=6) :: YPROGRAM2 = 'FA '
- CHARACTER(LEN=28) :: YFILEIN
- CHARACTER(LEN=3) :: YVAR
-!
- CHARACTER(LEN=100) :: YNAME
- CHARACTER(LEN=10) :: YRANK
- CHARACTER(LEN=3) :: YENS
- CHARACTER(LEN=10),DIMENSION(:), ALLOCATABLE :: COBSINFILE ! Identifier for simulated observations in file
-!
-REAL, ALLOCATABLE, DIMENSION(:,:) :: ZYO_NAT
-REAL, ALLOCATABLE, DIMENSION(:) :: ZNATURE
-!
-REAL,ALLOCATABLE, DIMENSION(:,:) :: ZWORK
-REAL,ALLOCATABLE, DIMENSION(:) :: ZLSM ! Land-Sea mask
-REAL,ALLOCATABLE, DIMENSION(:) :: ZCON_RAIN ! Amount of convective liquid precipitation
-REAL,ALLOCATABLE, DIMENSION(:) :: ZSTRAT_RAIN ! Amount of stratiform liquid precipitation
-REAL,ALLOCATABLE, DIMENSION(:) :: ZCON_SNOW ! Amount of convective solid precipitation
-REAL,ALLOCATABLE, DIMENSION(:) :: ZSTRAT_SNOW ! Amount of stratiform solid precipitation
-REAL,ALLOCATABLE, DIMENSION(:) :: ZCLOUDS ! Cloudcover
-REAL,ALLOCATABLE, DIMENSION(:) :: ZEVAPTR ! Evaporation
-REAL,ALLOCATABLE, DIMENSION(:) :: ZEVAP ! Evaporation
-REAL,ALLOCATABLE, DIMENSION(:) :: ZTSC ! Climatological surface temperature
-REAL,ALLOCATABLE, DIMENSION(:) :: ZTS ! Surface temperature
-REAL,ALLOCATABLE, DIMENSION(:) :: ZT2M ! Screen level temperature
-REAL,ALLOCATABLE, DIMENSION(:) :: ZHU2M ! Screen level relative humidity
-REAL,ALLOCATABLE, DIMENSION(:) :: ZSNC
-REAL,ALLOCATABLE, DIMENSION(:) :: ZSWE ! Snow water equvivalent (amount of snow on the ground)
-REAL,ALLOCATABLE, DIMENSION(:) :: ZSWEC ! Climatological snow water equvivalent (amount of snow on the ground)
-REAL,ALLOCATABLE, DIMENSION(:) :: ZUCLS
-REAL,ALLOCATABLE, DIMENSION(:) :: ZVCLS
-REAL,ALLOCATABLE, DIMENSION(:) :: ZSST ! SST from external file
-REAL,ALLOCATABLE, DIMENSION(:) :: ZSIC ! SIC from external file
-REAL,ALLOCATABLE, DIMENSION(:) :: ZLAT
-REAL,ALLOCATABLE, DIMENSION(:) :: ZLON
-!
-REAL :: ZTIME
-REAL :: ZTIME_OUT ! output time since start of the run (s)
-!
-LOGICAL, ALLOCATABLE, DIMENSION(:) :: GD_MASKEXT
-LOGICAL :: GLKEEPEXTZONE
-LOGICAL :: GFOUND
-!
-TYPE (DATE_TIME) :: TTIME ! Current date and time
-!
- CHARACTER(LEN=14) :: YTAG
-!
-INTEGER, DIMENSION(11) :: IDATEF
-INTEGER :: IDIM_FULL
-INTEGER :: ISV ! Number of scalar species
-INTEGER :: ISW ! Number of radiative bands
-INTEGER :: IYEAR, IMONTH, IDAY, IHOUR
-INTEGER :: IYEAR_OUT, IMONTH_OUT, IDAY_OUT
-INTEGER :: JL,JI,JJ,INB,ICPT
-INTEGER :: INW, JNW
-INTEGER :: ISTEP
-INTEGER :: IOBS
-INTEGER :: IGPCOMP
-INTEGER :: ILUOUT
-INTEGER :: ILUNAM
-INTEGER :: IRET, INBFA
-INTEGER :: IRESP, ISTAT ! Response value
-INTEGER :: INFOMPI, ILEVEL
-INTEGER :: ISIZE, IENS, ISIZE_FULL
-!
-! Flag diag :
-!
-INTEGER :: I2M, IBEQ, IDSTEQ
-LOGICAL :: GFRAC, GDIAG_GRID, GSURF_BUDGET, GRAD_BUDGET, GCOEF, &
- GSURF_VARS, GDIAG_OCEAN, GDIAG_SEAICE, GWATER_PROFILE, &
- GSURF_EVAP_BUDGET, GFLOOD, GPGD_ISBA, GCH_NO_FLUX_ISBA,&
- GSURF_MISC_BUDGET_ISBA, GPGD_TEB, GSURF_MISC_BUDGET_TEB
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-! ******************************************************************************************
-!
-INFOMPI=1
-!
-#ifdef SFX_MPI
- CALL MPI_INIT_THREAD(MPI_THREAD_MULTIPLE,ILEVEL,INFOMPI)
-#endif
-!
-IF (LHOOK) CALL DR_HOOK('SODA',0,ZHOOK_HANDLE)
-!
- CSOFTWARE = 'SODA'
-!
-#ifdef SFX_MPI
-NCOMM = MPI_COMM_WORLD
- CALL MPI_COMM_SIZE(NCOMM,NPROC,INFOMPI)
- CALL MPI_COMM_RANK(NCOMM,NRANK,INFOMPI)
-#endif
-!
- CALL PREP_LOG_MPI
-!
-!--------------------------------------
-!
-IF (NRANK==NPIO) THEN
- WRITE(*,*)
- WRITE(*,*) ' ------------------------------------'
- WRITE(*,*) ' | SODA |'
- WRITE(*,*) ' | SURFEX OFFLINE DATA ASSIMILATION |'
- WRITE(*,*) ' ------------------------------------'
- WRITE(*,*)
-ENDIF
-!
-WRITE(YRANK,FMT='(I10)') NRANK
-YNAME=TRIM(YLUOUT)//ADJUSTL(YRANK)
-!
-! Open ascii outputfile for writing
-#ifdef SFX_LFI
- CLUOUT_LFI = ADJUSTL(ADJUSTR(YLUOUT)//'.txt')
-#endif
-#ifdef SFX_NC
- CLUOUT_NC = ADJUSTL(ADJUSTR(YLUOUT)//'.txt')
-#endif
- CALL GET_LUOUT('ASCII ',ILUOUT)
-OPEN(UNIT=ILUOUT,FILE=ADJUSTL(ADJUSTR(YNAME)//'.txt'),FORM='FORMATTED',ACTION='WRITE')
-!
-! Read offline specific things
- CALL OPEN_NAMELIST('ASCII ',ILUNAM,CNAMELIST)
- CALL POSNAM(ILUNAM,'NAM_IO_OFFLINE',GFOUND)
-IF (GFOUND) READ (UNIT=ILUNAM,NML=NAM_IO_OFFLINE)
- CALL CLOSE_NAMELIST('ASCII ',ILUNAM)
-!
-IF (NPROC==1) THEN
- XIO_FRAC=1.
-ELSE
- XIO_FRAC = MAX(MIN(XIO_FRAC,1.),0.)
-ENDIF
-!
-! Check validity of NAM_IO_OFFLINE settings
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CSURF_FILETYPE',CSURF_FILETYPE,'ASCII ','LFI ','FA ','NC ')
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CTIMESERIES_FILETYPE',CTIMESERIES_FILETYPE,'NETCDF','TEXTE ','BINARY',&
- 'ASCII ','LFI ','FA ',&
- 'NONE ','OFFLIN','NC ')
-!
-IF (CTIMESERIES_FILETYPE=='NETCDF') CTIMESERIES_FILETYPE='OFFLIN'
-!
-! Setting input files read from namelist
-IF ( CSURF_FILETYPE == "LFI " ) THEN
-#ifdef SFX_LFI
- CFILEIN_LFI = CPREPFILE
- CFILE_LFI = CPREPFILE
- CFILEIN_LFI_SAVE = CPREPFILE
- CFILEPGD_LFI = CPGDFILE
-#endif
-ELSEIF ( CSURF_FILETYPE == "FA " ) THEN
-#ifdef SFX_FA
- CFILEIN_FA = ADJUSTL(ADJUSTR(CPREPFILE)//'.fa')
- CFILEIN_FA_SAVE = ADJUSTL(ADJUSTR(CPREPFILE)//'.fa')
- CFILEPGD_FA = ADJUSTL(ADJUSTR(CPGDFILE)//'.fa')
-#endif
-ELSEIF ( CSURF_FILETYPE == "ASCII " ) THEN
-#ifdef SFX_ASC
- CFILEIN = ADJUSTL(ADJUSTR(CPREPFILE)//'.txt')
- CFILEIN_SAVE = ADJUSTL(ADJUSTR(CPREPFILE)//'.txt')
- CFILEPGD = ADJUSTL(ADJUSTR(CPGDFILE)//'.txt')
-#endif
-ELSEIF ( CSURF_FILETYPE == "NC " ) THEN
-#ifdef SFX_NC
- CFILEIN_NC = ADJUSTL(ADJUSTR(CPREPFILE)//'.nc')
- CFILEIN_NC_SAVE = ADJUSTL(ADJUSTR(CPREPFILE)//'.nc')
- CFILEPGD_NC = ADJUSTL(ADJUSTR(CPGDFILE)//'.nc')
-#endif
-ELSE
- CALL ABOR1_SFX(TRIM(CSURF_FILETYPE)//" is not implemented!")
-ENDIF
-!
-! Allocation of Surfex Types
- CALL SURFEX_ALLOC_LIST(1)
- YSURF_CUR => YSURF_LIST(1)
-!
-! Reading all namelist (also assimilation)
- CALL READ_ALL_NAMELISTS(YSURF_CUR, &
- CSURF_FILETYPE,'ALL',.FALSE.)
-!
-!* 0.2. Goto model of Surfex Types
-!
-ICURRENT_MODEL = 1
-!
- CPROGNAME = CSURF_FILETYPE
-LREAD_ALL = .TRUE.
-!
-! Initialization netcdf file handling
-IF (NRANK==NPIO) THEN
- !
- XSTART = NUNDEF
- XSTRIDE = NUNDEF
- XCOUNT = NUNDEF
- XSTARTW = 0
- XCOUNTW = 1
- LPARTW = .TRUE.
- LDEFINED_SURF_ATM = .FALSE.
- LDEFINED_NATURE = .FALSE.
- LDEFINED_TOWN = .FALSE.
- LDEFINED_WATER = .FALSE.
- LDEFINED_SEA = .FALSE.
- !
-ENDIF
-!
- CALL INIT_INDEX_MPI(YSURF_CUR, &
- CSURF_FILETYPE, YALG_MPI, XIO_FRAC, .FALSE.)
-!
-!
-! Initialize time information
-IYEAR = NUNDEF
-IMONTH = NUNDEF
-IDAY = NUNDEF
-ZTIME = XUNDEF
- CALL SET_SURFEX_FILEIN(CSURF_FILETYPE,'PREP')
- CALL INIT_IO_SURF_n(YSURF_CUR%DTCO, YSURF_CUR%DGU, YSURF_CUR%U, &
- CSURF_FILETYPE,'FULL ','SURF ','READ ')
- CALL READ_SURF(&
- CSURF_FILETYPE,'DIM_FULL ',IDIM_FULL, IRESP)
- CALL READ_SURF(&
- CSURF_FILETYPE,'DTCUR ',TTIME, IRESP)
- CALL END_IO_SURF_n(CSURF_FILETYPE)
-!
- CALL GET_SIZE_FULL_n(YSURF_CUR%U,CSURF_FILETYPE,IDIM_FULL,ISIZE_FULL)
-!
-IF (ALLOCATED(NMASK_FULL)) DEALLOCATE(NMASK_FULL)
-!
-ISW = 0
-ISV = 0
-ALLOCATE(CSV(ISV))
-ALLOCATE(XCO2(ISIZE_FULL))
-ALLOCATE(XRHOA(ISIZE_FULL))
-ALLOCATE(XZENITH(ISIZE_FULL))
-ALLOCATE(XAZIM(ISIZE_FULL))
-ALLOCATE(XSW_BANDS(ISW))
-ALLOCATE(XDIR_ALB(ISIZE_FULL,ISW))
-ALLOCATE(XSCA_ALB(ISIZE_FULL,ISW))
-ALLOCATE(XEMIS(ISIZE_FULL))
-ALLOCATE(XTSRAD(ISIZE_FULL))
-ALLOCATE(XTSURF(ISIZE_FULL))
-!
-! Indicate that zenith and azimuth angles are not initialized
-XZENITH = XUNDEF
-XAZIM = XUNDEF
-XCO2 = 0.
-XRHOA = 1.
-!
-! Sanity check
-IF ( .NOT. LASSIM ) CALL ABOR1_SFX("YOU CAN'T RUN SODA WITHOUT SETTING LASSIM=.TRUE. IN THE ASSIM NAMELIST")
-!
-! Set the number of initializations to be done
-! Default is one
-INB = 1
-IF ( CASSIM_ISBA == 'EKF ' ) THEN
- ! Has to do initialization for all the perturbations +
- ! control + the real run at last
- INB = NVAR + 2
- ISIZE = NVAR
-ELSEIF ( CASSIM_ISBA == 'ENKF ' ) THEN
- INB = NENS
- IF (LBIAS_CORRECTION) INB = INB + 1
- ISIZE = NENS
-ENDIF
-!
-IF (NRANK==NPIO) WRITE(*,*) "INITIALIZING SURFEX..."
-!
-YINIT = 'ALL'
-!
-IYEAR = TTIME%TDATE%YEAR
-IMONTH = TTIME%TDATE%MONTH
-IDAY = TTIME%TDATE%DAY
-ZTIME = TTIME%TIME
-IHOUR = NINT(ZTIME/3600.)
-!
-NOBS = 0
-!
-LREAD_ALL = .FALSE.
-!
-DO NIFIC = INB,1,-1
- !
- ! If we have more than one initialization to do
- ! For last initialization, we must re-do the first.
- ! Could be avoided by introducing knowlegde of LASSIM on this level
- IF ( CASSIM_ISBA == 'EKF ' .OR. CASSIM_ISBA == 'ENKF ' ) THEN
- !
- IF (CASSIM_ISBA == 'EKF ') THEN
- IF ( NIFIC<INB ) THEN
- YMFILE = "PREP_"
- CALL GET_FILE_NAME(IYEAR,IMONTH,IDAY,IHOUR,YMFILE)
- WRITE(YVAR,'(I1.1)') NIFIC-1
- YFILEIN = TRIM(YMFILE)//"_EKF_PERT"//ADJUSTL(YVAR)
- ELSE
- YFILEIN = "PREP_INIT"
- ENDIF
- ELSEIF (CASSIM_ISBA == 'ENKF ') THEN
- YMFILE = "PREP_"
- CALL GET_FILE_NAME(IYEAR,IMONTH,IDAY,IHOUR,YMFILE)
- WRITE(YVAR,'(I1.1)') NIFIC
- YFILEIN = TRIM(YMFILE)//"_EKF_ENS"//ADJUSTL(YVAR)
- ENDIF
- !
- CALL SET_FILEIN(YFILEIN)
- !
- ENDIF
- !
- CALL DEALLOC_SURF_ATM_n(YSURF_CUR)
- !
- IF ( (CASSIM_ISBA=='EKF '.OR.CASSIM_ISBA=='ENKF ') .AND. NIFIC==1 ) LREAD_ALL = .TRUE.
- !
- ! Initialize the SURFEX interface
- CALL IO_BUFF_CLEAN
- CALL INIT_SURF_ATM_n(YSURF_CUR, &
- CSURF_FILETYPE,YINIT, LLAND_USE, ISIZE_FULL, ISV, ISW, &
- CSV, XCO2, XRHOA, XZENITH, XAZIM, XSW_BANDS, &
- XDIR_ALB, XSCA_ALB, XEMIS, XTSRAD, XTSURF, &
- IYEAR, IMONTH, IDAY, ZTIME, &
- YATMFILE, YATMFILETYPE, YTEST )
- !
- IF ( CASSIM_ISBA=='EKF ' .OR. CASSIM_ISBA=='ENKF ' ) THEN
- !
- IF ( NIFIC==INB ) THEN
- ALLOCATE(XLAI_PASS(YSURF_CUR%U%NSIZE_NATURE,YSURF_CUR%IM%I%NPATCH))
- ALLOCATE(XBIO_PASS(YSURF_CUR%U%NSIZE_NATURE,YSURF_CUR%IM%I%NPATCH))
- IF (CASSIM_ISBA=='EKF ') ALLOCATE(XI(YSURF_CUR%U%NSIZE_NATURE,YSURF_CUR%IM%I%NPATCH,ISIZE))
- ALLOCATE(XF (YSURF_CUR%U%NSIZE_NATURE,YSURF_CUR%IM%I%NPATCH,ISIZE+1,NVAR))
- ALLOCATE(XF_PATCH (YSURF_CUR%U%NSIZE_NATURE,YSURF_CUR%IM%I%NPATCH,ISIZE+1,NOBSTYPE))
- ENDIF
- !
- IF ( CASSIM_ISBA=='EKF ' .AND. NIFIC<INB .OR. CASSIM_ISBA=='ENKF ') THEN
- !
- ! Set the global state values for this control value
- DO IOBS = 1,NOBSTYPE
- DO JI=1,YSURF_CUR%IM%I%NPATCH
- SELECT CASE (TRIM(COBS(IOBS)))
- CASE("T2M")
- XF_PATCH(:,JI,NIFIC,IOBS) = XAT2M_ISBA(:,1)
- CASE("HU2M")
- XF_PATCH(:,JI,NIFIC,IOBS) = XAHU2M_ISBA(:,1)
- CASE("WG1")
- XF_PATCH(:,JI,NIFIC,IOBS) = YSURF_CUR%IM%I%XWG(:,1,JI)
- CASE("LAI")
- XF_PATCH(:,JI,NIFIC,IOBS) = YSURF_CUR%IM%I%XLAI(:,JI)
- CASE DEFAULT
- CALL ABOR1_SFX("Mapping of "//COBS(IOBS)//" is not defined in SODA!")
- END SELECT
- ENDDO
- ENDDO
- !
- ! Prognostic fields for assimilation (Control vector)
- DO JL = 1,NVAR
- SELECT CASE (TRIM(CVAR(JL)))
- CASE("TG1")
- XF(:,:,NIFIC,JL) = YSURF_CUR%IM%I%XTG(:,1,:)
- CASE("TG2")
- XF(:,:,NIFIC,JL) = YSURF_CUR%IM%I%XTG(:,2,:)
- CASE("WG1")
- XF(:,:,NIFIC,JL) = YSURF_CUR%IM%I%XWG(:,1,:)
- CASE("WG2")
- XF(:,:,NIFIC,JL) = YSURF_CUR%IM%I%XWG(:,2,:)
- CASE("WG3")
- XF(:,:,NIFIC,JL) = YSURF_CUR%IM%I%XWG(:,3,:)
- CASE("LAI")
- XF(:,:,NIFIC,JL) = YSURF_CUR%IM%I%XLAI(:,:)
- CASE DEFAULT
- CALL ABOR1_SFX("Mapping of "//TRIM(CVAR(JL))//" is not defined in SODA!")
- END SELECT
- ENDDO
- !
- IF ( NIFIC==1 ) THEN
- !
- DO JL = 1,NVAR
- IF (TRIM(CVAR(JL))=="LAI") THEN
- IF ( YSURF_CUR%IM%I%NPATCH==1 .AND. TRIM(CBIO)/="LAI" ) THEN
- CALL ABOR1_SFX("Mapping of "//CBIO//" is not defined in EKF with NPATCH=1!")
- ENDIF
- SELECT CASE (TRIM(CBIO))
- CASE("BIOMA1","BIOMASS1")
- XBIO_PASS(:,:) = YSURF_CUR%IM%I%XBIOMASS(:,1,:)
- CASE("BIOMA2","BIOMASS2")
- XBIO_PASS(:,:) = YSURF_CUR%IM%I%XBIOMASS(:,2,:)
- CASE("RESPI1","RESP_BIOM1")
- XBIO_PASS(:,:) = YSURF_CUR%IM%I%XRESP_BIOMASS(:,1,:)
- CASE("RESPI2","RESP_BIOM2")
- XBIO_PASS(:,:) = YSURF_CUR%IM%I%XRESP_BIOMASS(:,2,:)
- CASE("LAI")
- XBIO_PASS(:,:) = YSURF_CUR%IM%I%XLAI(:,:)
- CASE DEFAULT
- CALL ABOR1_SFX("Mapping of "//CBIO//" is not defined in EKF!")
- END SELECT
- !
- XLAI_PASS(:,:) = YSURF_CUR%IM%I%XLAI(:,:)
- !
- ENDIF
- !
- ENDDO
- ENDIF
- !
- ELSE
- !
- DO JL = 1,NVAR
- SELECT CASE (TRIM(CVAR(JL)))
- CASE("TG1")
- XI(:,:,JL) = YSURF_CUR%IM%I%XTG(:,1,:)
- CASE("TG2")
- XI(:,:,JL) = YSURF_CUR%IM%I%XTG(:,2,:)
- CASE("WG1")
- XI(:,:,JL) = YSURF_CUR%IM%I%XWG(:,1,:)
- CASE("WG2")
- XI(:,:,JL) = YSURF_CUR%IM%I%XWG(:,2,:)
- CASE("WG3")
- XI(:,:,JL) = YSURF_CUR%IM%I%XWG(:,3,:)
- CASE("LAI")
- XI(:,:,JL) = YSURF_CUR%IM%I%XLAI(:,:)
- CASE DEFAULT
- CALL ABOR1_SFX("Mapping of "//TRIM(CVAR(JL))//" is not defined in SODA!")
- END SELECT
- ENDDO
- !
- ENDIF
- !
- ENDIF
- !
-ENDDO
-!
-! Allocate input fields to the assimilation interface
-ALLOCATE(ZLSM (ISIZE_FULL))
-ALLOCATE(ZCON_RAIN (ISIZE_FULL))
-ALLOCATE(ZSTRAT_RAIN (ISIZE_FULL))
-ALLOCATE(ZCON_SNOW (ISIZE_FULL))
-ALLOCATE(ZSTRAT_SNOW (ISIZE_FULL))
-ALLOCATE(ZCLOUDS (ISIZE_FULL))
-ALLOCATE(ZEVAPTR (ISIZE_FULL))
-ALLOCATE(ZEVAP (ISIZE_FULL))
-ALLOCATE(ZTSC (ISIZE_FULL))
-ALLOCATE(ZSWEC (ISIZE_FULL))
-ALLOCATE(ZTS (ISIZE_FULL))
-ALLOCATE(ZUCLS (ISIZE_FULL))
-ALLOCATE(ZVCLS (ISIZE_FULL))
-ALLOCATE(ZSST (ISIZE_FULL))
-ALLOCATE(ZSIC (ISIZE_FULL))
-ZTS(:) = XUNDEF
-
-! Allocate observations
-ALLOCATE(ZT2M (ISIZE_FULL))
-ALLOCATE(ZHU2M (ISIZE_FULL))
-ALLOCATE(ZSWE (ISIZE_FULL))
-!
-! OI needs first guess values used in oi_cacsts
-IF (CASSIM_ISBA=="OI ") THEN
- !
- IF ( TRIM(CFILE_FORMAT_FG) == "ASCII" ) THEN
-
- ALLOCATE(ZWORK(YSURF_CUR%U%NDIM_FULL,8))
-
- IF (NRANK==NPIO) THEN
-
- YMFILE = 'FIRST_GUESS_'
- CALL GET_FILE_NAME(IYEAR,IMONTH,IDAY,IHOUR,YMFILE)
- WRITE(*,*) "READING first guess from file "//TRIM(YMFILE)//".DAT"
- ISTAT = 0
- OPEN(UNIT=55,FILE=TRIM(YMFILE)//".DAT",FORM='FORMATTED',STATUS='OLD',IOSTAT=ISTAT)
- IF ( ISTAT /= 0 ) CALL ABOR1_SFX("Can not open "//TRIM(YMFILE))
-
- ZWORK(:,:) = XUNDEF
-
- ! Read first guess
- DO JI = 1,YSURF_CUR%U%NDIM_FULL
- READ (55,*,IOSTAT=ISTAT) (ZWORK(JI,JJ),JJ=1,8)
- IF ( ISTAT /= 0 ) CALL ABOR1_SFX("Error reading file "//TRIM(YMFILE))
- ENDDO
- CLOSE(55)
- ENDIF
-
- ! Distribute values on processors
- IF (NPROC>1) THEN
- CALL READ_AND_SEND_MPI(ZWORK(:,1),ZCON_RAIN(:))
- CALL READ_AND_SEND_MPI(ZWORK(:,2),ZSTRAT_SNOW(:))
- CALL READ_AND_SEND_MPI(ZWORK(:,3),ZCON_SNOW(:))
- CALL READ_AND_SEND_MPI(ZWORK(:,4),ZSTRAT_SNOW(:))
- CALL READ_AND_SEND_MPI(ZWORK(:,5),ZCLOUDS(:))
- CALL READ_AND_SEND_MPI(ZWORK(:,6),ZLSM(:))
- CALL READ_AND_SEND_MPI(ZWORK(:,7),ZEVAP(:))
- CALL READ_AND_SEND_MPI(ZWORK(:,8),ZEVAPTR(:))
- ELSE
- ! Set First-Guess variables
- ZCON_RAIN (:) = ZWORK(:,1)
- ZSTRAT_SNOW(:) = ZWORK(:,2)
- ZCON_SNOW (:) = ZWORK(:,3)
- ZSTRAT_SNOW(:) = ZWORK(:,4)
- ZCLOUDS (:) = ZWORK(:,5)
- ZLSM (:) = ZWORK(:,6)
- ZEVAP (:) = ZWORK(:,7)
- ZEVAPTR (:) = ZWORK(:,8)
- ENDIF
-
- DEALLOCATE(ZWORK)
-
- ELSEIF ( TRIM(CFILE_FORMAT_FG) == "FA" ) THEN
- !
- ! Read atmospheric forecast fields from FA files
-#ifdef SFX_FA
- CFILEIN_FA = 'FG_OI_MAIN'
- CDNOMC = 'oimain' ! new frame name
-
- ! Open FA file (LAM version with extension zone)
- CALL INIT_IO_SURF_n(YSURF_CUR%DTCO, YSURF_CUR%DGU, YSURF_CUR%U, &
- YPROGRAM2,'EXTZON','SURF ','READ ')
- !
- ! Read model forecast quantities
- IF (LAROME) THEN
- CALL READ_SURF(YPROGRAM2,'SURFACCPLUIE', ZSTRAT_RAIN,IRESP)
- CALL READ_SURF(YPROGRAM2,'SURFACCNEIGE', ZSTRAT_SNOW,IRESP)
- CALL READ_SURF(YPROGRAM2,'SURFACCGRAUPEL',ZCON_SNOW,IRESP)
- ! So far graupel has not been used
- !ZCON_SNOW=ZCON_SNOW+ZCON_GRAUPEL
- ZCON_RAIN(:) = 0.0
- ELSE
- CALL READ_SURF(YPROGRAM2,'SURFPREC.EAU.CON',ZCON_RAIN ,IRESP)
- CALL READ_SURF(YPROGRAM2,'SURFPREC.EAU.GEC',ZSTRAT_RAIN ,IRESP)
- CALL READ_SURF(YPROGRAM2,'SURFPREC.NEI.CON',ZCON_SNOW ,IRESP)
- CALL READ_SURF(YPROGRAM2,'SURFPREC.NEI.GEC',ZSTRAT_SNOW ,IRESP)
- ENDIF
- !
- CALL READ_SURF(YPROGRAM2,'ATMONEBUL.BASSE ',ZCLOUDS,IRESP)
- CALL READ_SURF(YPROGRAM2,'SURFIND.TERREMER',ZLSM ,IRESP)
- CALL READ_SURF(YPROGRAM2,'SURFFLU.LAT.MEVA',ZEVAP ,IRESP) ! accumulated fluxes (not available in LFI)
- !
- IF (.NOT.LALADSURF) THEN
- CALL READ_SURF(YPROGRAM2,'SURFXEVAPOTRANSP',ZEVAPTR,IRESP) ! not in ALADIN SURFEX
- ELSE
- ZEVAPTR(:) = 0.0
- ENDIF
- !
- ! Close FA file
- CALL END_IO_SURF_n(YPROGRAM2)
- CALL IO_BUFF_CLEAN
-#else
- CALL ABOR1_SFX("The first guess is supposed to be an FA file. You must compile with FA support enabled: -DSFX_FA")
-#endif
- ELSE
- CALL ABOR1_SFX("CFILE_FORMAT_FG="//TRIM(CFILE_FORMAT_FG)//" not implemented!")
- ENDIF
- IF (NRANK==NPIO .AND. NPRINTLEV>0) WRITE(*,*)'READ FIRST GUESS OK'
-ENDIF
-!
-! If we want to extrapolate values, we need to have a land-sea-mask available
-IF (LEXTRAP_SEA .OR. LEXTRAP_WATER .OR. LEXTRAP_NATURE .OR. .NOT.LWATERTG2) THEN
-
- IF (NRANK==NPIO .AND. NPRINTLEV>0) WRITE(*,*) "READING Land-Sea mask"
-
- IF ( TRIM(CFILE_FORMAT_LSM) == "ASCII" ) THEN
-
- ALLOCATE(ZWORK(YSURF_CUR%U%NDIM_FULL,1))
-
- IF (NRANK==NPIO) THEN
- YMFILE = 'LSM.DAT'
- IF (NPRINTLEV>0) WRITE(*,*) "READING LSM from file "//TRIM(YMFILE)
- OPEN(UNIT=55,FILE=TRIM(YMFILE),FORM='FORMATTED',STATUS='OLD',IOSTAT=ISTAT)
- IF ( ISTAT /= 0 ) CALL ABOR1_SFX("Can not open "//TRIM(YMFILE))
-
- ZWORK(:,:) = XUNDEF
- ! Read LSM
- DO JI = 1,YSURF_CUR%U%NDIM_FULL
- READ (55,*,IOSTAT=ISTAT) ZWORK(JI,1)
- IF ( ISTAT /= 0 ) CALL ABOR1_SFX("Error reading file "//TRIM(YMFILE))
- ENDDO
- CLOSE(55)
- ENDIF
-
- ! Distribute values on processors
- IF (NPROC>1) THEN
- CALL READ_AND_SEND_MPI(ZWORK(:,1),ZLSM(:))
- ELSE
- ! Set First-Guess variables
- ZLSM(:)=ZWORK(:,1)
- ENDIF
- DEALLOCATE(ZWORK)
-
- ELSEIF ( TRIM(CFILE_FORMAT_LSM) == "FA" ) THEN
- ! Read atmospheric forecast fields from FA files
-#ifdef SFX_FA
- CFILEIN_FA = 'FG_OI_MAIN'
- CDNOMC = 'oimain' ! new frame name
-
- ! Open FA file (LAM version with extension zone)
- CALL INIT_IO_SURF_n(YSURF_CUR%DTCO, YSURF_CUR%DGU, YSURF_CUR%U, &
- YPROGRAM2,'EXTZON','SURF ','READ ')
- CALL READ_SURF(YPROGRAM2,'SURFIND.TERREMER',ZLSM ,IRESP)
- IF (IRESP /=0) CALL ABOR1_SFX("Can not read Land-Sea mask from FA file "//TRIM(CFILEIN_FA))
- ! Close FA file
- CALL END_IO_SURF_n(YPROGRAM2)
- CALL IO_BUFF_CLEAN
-#else
- CALL ABOR1_SFX("The Land-sea mask file is assumed to be an FA file. You must compile with FA support enabled: -DSFX_FA")
-#endif
- ELSE
- CALL ABOR1_SFX("CFILE_FORMAT_LSM="//TRIM(CFILE_FORMAT_LSM)//" not implemented!")
- ENDIF
- IF (NRANK==NPIO.AND.NPRINTLEV>0) WRITE(*,*)'READ LSM OK'
-ENDIF
-!
-! The observations used in the analysis is read.
-! The options are either from a CANARI analysis or from a file
-IF ( CASSIM_ISBA=="EKF " .OR. CASSIM_ISBA=="ENKF " ) THEN
- ALLOCATE(XYO(YSURF_CUR%U%NSIZE_NATURE,NOBSTYPE))
-ENDIF
-
-IF ( TRIM(CFILE_FORMAT_OBS) == "ASCII") THEN
-
- ALLOCATE(ZWORK(YSURF_CUR%U%NDIM_FULL,NOBSTYPE))
-
- IF (NRANK==NPIO) THEN
-
- YMFILE = 'OBSERVATIONS_'
- CALL GET_FILE_NAME(IYEAR,IMONTH,IDAY,IHOUR,YMFILE)
- YMFILE=TRIM(YMFILE)//".DAT"
- ISTAT = 0
- OPEN(UNIT=55,FILE=TRIM(YMFILE),FORM='FORMATTED',STATUS='OLD',IOSTAT=ISTAT)
- IF ( ISTAT /=0 ) CALL ABOR1_SFX("Error opening file "//TRIM(YMFILE))
-
- ! Get the nature points from processors
- ! If the file has an header, we check for consistency
- IF ( LOBSHEADER ) THEN
- ! Read in first line and check if variables are consistent
- ALLOCATE(COBSINFILE(NOBSTYPE))
- READ (55,*,IOSTAT=ISTAT) (COBSINFILE(JJ),JJ=1,NOBSTYPE)
- IF ( ISTAT /= 0 ) CALL ABOR1_SFX("Error reading header in "//TRIM(YMFILE))
-
- DO IOBS = 1,NOBSTYPE
- IF ( TRIM(COBS(IOBS)) /= TRIM(COBSINFILE(IOBS))) THEN
- CALL ABOR1_SFX("Mapping of observations in "//TRIM(YMFILE)//&
- " is not consistent with setup! "//TRIM(COBS(IOBS))//" /= "//TRIM(COBSINFILE(IOBS)))
- ENDIF
- ENDDO
- DEALLOCATE(COBSINFILE)
- ENDIF
-
- ZWORK(:,:) = XUNDEF
-
- ENDIF
-
- ! Read all observations (NDIM_FULL)
- IF (LOBSNAT) THEN
-
- IF (NRANK==NPIO) THEN
- ALLOCATE(ZYO_NAT(YSURF_CUR%U%NDIM_NATURE,NOBSTYPE))
- DO JI = 1,YSURF_CUR%U%NDIM_NATURE
- READ (55,*,IOSTAT=ISTAT) (ZYO_NAT(JI,JJ),JJ=1,NOBSTYPE)
- IF ( ISTAT /= 0 ) CALL ABOR1_SFX("Error reading file "//TRIM(YMFILE))
- ENDDO
- ALLOCATE(ZNATURE(YSURF_CUR%U%NDIM_FULL))
- ENDIF
-
- IF (NPROC>1) THEN
- CALL GATHER_AND_WRITE_MPI(YSURF_CUR%U%XNATURE,ZNATURE)
- ELSEIF (NRANK==NPIO) THEN
- ZNATURE(:) = YSURF_CUR%U%XNATURE
- ENDIF
-
- IF (NRANK==NPIO) THEN
- ICPT = 0
- DO JI = 1,YSURF_CUR%U%NDIM_FULL
- IF (ZNATURE(JI)>0.) THEN
- ICPT = ICPT + 1
- ZWORK(JI,:) = ZYO_NAT(ICPT,:)
- ENDIF
- ENDDO
- DEALLOCATE(ZNATURE,ZYO_NAT)
- ENDIF
-
- ELSEIF (NRANK==NPIO) THEN
-
- DO JI = 1,YSURF_CUR%U%NDIM_FULL
- READ (55,*,IOSTAT=ISTAT) (ZWORK(JI,JJ),JJ=1,NOBSTYPE)
- IF ( ISTAT /= 0 ) CALL ABOR1_SFX("Error reading file "//TRIM(YMFILE))
- ENDDO
- ENDIF
-
- IF (NRANK==NPIO) THEN
-
- CLOSE(55)
- IF (NPRINTLEV>0) WRITE(*,*) 'Read observation file OK'
-
- ENDIF
-
- ! Initialize possible observations
- ZT2M = 999.
- ZHU2M = 999.
- ZSWE = 999.
-
- IF (NPROC>1) THEN
-
- ! Running on more CPU's
- ! For EKF/EnKF we must distribute variables for nature tile
- IF ( CASSIM_ISBA=="EKF " .OR. CASSIM_ISBA=="ENKF " ) THEN
- DO JJ=1,NOBSTYPE
- CALL READ_AND_SEND_MPI(ZWORK(:,JJ),XYO(:,JJ),YSURF_CUR%U%NR_NATURE)
- ENDDO
- ENDIF
-
- ! Set observations used for possibly other tiles than nature
- ! Distribute read variables
- JJ = 1
- DO JI = 1,NOBSMAX
- IF (NNCO(JI) == 1 .AND. JJ <= NOBSTYPE ) THEN
- SELECT CASE (JI)
- CASE (1)
- CALL READ_AND_SEND_MPI(ZWORK(:,JJ),ZT2M(:))
- CASE (2)
- CALL READ_AND_SEND_MPI(ZWORK(:,JJ),ZHU2M(:))
- CASE (5)
- CALL READ_AND_SEND_MPI(ZWORK(:,JJ),ZSWE(:))
- END SELECT
- JJ = JJ + 1
- ENDIF
- ENDDO
-
- ELSE
-
- ! Running on one CPU
- IF ( CASSIM_ISBA=="EKF " .OR. CASSIM_ISBA=="ENKF " ) THEN
- DO JI = 1,YSURF_CUR%U%NSIZE_NATURE
- XYO(JI,:) = ZWORK(YSURF_CUR%U%NR_NATURE(JI),:)
- ENDDO
- ENDIF
- ! Set observations used for possibly other tiles than nature
- JJ = 1
- DO JI = 1,NOBSMAX
- IF (NNCO(JI) == 1 .AND. JJ <= NOBSTYPE ) THEN
- SELECT CASE (JI)
- CASE (1)
- ZT2M(:)=ZWORK(:,JJ)
- CASE (2)
- ZHU2M(:)=ZWORK(:,JJ)
- CASE (5)
- ZSWE(:)=ZWORK(:,JJ)
- END SELECT
- JJ = JJ + 1
- ENDIF
- ENDDO
- ENDIF
- DEALLOCATE(ZWORK)
-
- NOBS = NOBS + NOBSTYPE
- IF (( CASSIM_ISBA=="EKF " .OR. CASSIM_ISBA=="ENKF " ) .AND. ( NPRINTLEV > 2 )) WRITE(ILUOUT,*) 'read in obs: ', XYO(1,:), NOBS
-
-ELSEIF ( TRIM(CFILE_FORMAT_OBS) == "FA") THEN
- !
- NOBS = NOBSTYPE
- !
- !
- ! Define FA file name for CANARI analysis
-#ifdef SFX_FA
- CFILEIN_FA = 'CANARI' ! input CANARI analysis
- CDNOMC = 'canari' ! new frame name
-
-! Open FA file
- CALL INIT_IO_SURF_n(YSURF_CUR%DTCO, YSURF_CUR%DGU, YSURF_CUR%U, &
- YPROGRAM2,'EXTZON','SURF ','READ ')
-!
-! Read CANARI analysis
- CALL READ_SURF(YPROGRAM2,'CLSTEMPERATURE ',ZT2M ,IRESP)
- CALL READ_SURF(YPROGRAM2,'CLSHUMI.RELATIVE',ZHU2M,IRESP)
- CALL READ_SURF(YPROGRAM2,'SURFTEMPERATURE ',ZTS ,IRESP)
- CALL READ_SURF(YPROGRAM2,'SURFRESERV.NEIGE',ZSWE ,IRESP)
- CALL READ_SURF(YPROGRAM2,'CLSVENT.ZONAL ',ZUCLS,IRESP)
- CALL READ_SURF(YPROGRAM2,'CLSVENT.MERIDIEN',ZVCLS,IRESP)
-
-! Close CANARI file
- CALL END_IO_SURF_n(YPROGRAM2)
- CALL IO_BUFF_CLEAN
- IF (NRANK==NPIO.AND.NPRINTLEV>0) WRITE(*,*) 'READ CANARI OK'
-#else
- CALL ABOR1_SFX("CANARI analyis is supposed to be an FA file. You must compile with FA support enabled: -DSFX_FA")
-#endif
-ELSE
- CALL ABOR1_SFX("CFILE_FORMAT_OBS="//TRIM(CFILE_FORMAT_OBS)//" not implemented!")
-ENDIF
-!
-! Climatological fields are only used in OI
-IF (CASSIM_ISBA=="OI ") THEN
- !
- IF (TRIM(CFILE_FORMAT_CLIM) == "ASCII" ) THEN
-
- ALLOCATE(ZWORK(YSURF_CUR%U%NDIM_FULL,2))
-
- IF (NRANK==NPIO) THEN
- YMFILE = 'CLIMATE.DAT'
- WRITE(*,*) "READING CLIM from file "//TRIM(YMFILE)
- OPEN(UNIT=55,FILE=TRIM(YMFILE),FORM='FORMATTED',STATUS='OLD',IOSTAT=ISTAT)
- IF ( ISTAT /= 0 ) CALL ABOR1_SFX("Can not open "//TRIM(YMFILE))
-
- ZWORK(:,:) = XUNDEF
- ! Read CLIMATE file
- DO JI = 1,YSURF_CUR%U%NDIM_FULL
- READ (55,*,IOSTAT=ISTAT) (ZWORK(JI,JJ),JJ=1,2)
- IF ( ISTAT /= 0 ) CALL ABOR1_SFX("Error reading file "//TRIM(YMFILE))
- ENDDO
- CLOSE(55)
- ENDIF
-
- ! Distribute values on processors
- IF (NPROC>1) THEN
- CALL READ_AND_SEND_MPI(ZWORK(:,1),ZSWEC(:))
- CALL READ_AND_SEND_MPI(ZWORK(:,2),ZTSC(:))
- ELSE
- ! Set First-Guess variables
- ZSWEC(:)=ZWORK(:,1)
- ZTSC=ZWORK(:,2)
- ENDIF
- DEALLOCATE(ZWORK)
-
- ELSEIF (TRIM(CFILE_FORMAT_CLIM) == "FA" ) THEN
-
- ! Define FA file name for surface climatology
-#ifdef SFX_FA
- CFILEIN_FA = 'clim_isba' ! input climatology
- CDNOMC = 'climat' ! new frame name
-
-! Open FA file
- CALL INIT_IO_SURF_n(YSURF_CUR%DTCO, YSURF_CUR%DGU, YSURF_CUR%U, &
- YPROGRAM2,'EXTZON','SURF ','READ ')
-!
-! Read climatology file
- CALL READ_SURF(YPROGRAM2,'SURFRESERV.NEIGE',ZSWEC,IRESP)
- CALL READ_SURF(YPROGRAM2,'SURFTEMPERATURE' ,ZTSC ,IRESP)
-
-! Close climatology file
- CALL END_IO_SURF_n(YPROGRAM2)
- CALL IO_BUFF_CLEAN
-#else
- CALL ABOR1_SFX("The climate file is supposed to be an FA file. You must compile with FA support enabled: -DSFX_FA")
-#endif
- ELSE
- CALL ABOR1_SFX("CFILE_FORMAT_CLIM="//TRIM(CFILE_FORMAT_CLIM)//" not implemented!")
- ENDIF
- IF (NRANK==NPIO.AND.NPRINTLEV>0) WRITE(*,*) 'READ CLIMATOLOGY OK'
- !
-ENDIF
-!
- CALL ASSIM_SET_SST(YSURF_CUR%DTCO, YSURF_CUR%DGU, YSURF_CUR%SM%S, YSURF_CUR%U, &
- ISIZE_FULL,ZLSM,ZSST,ZSIC,YTEST)
-
-IF ( .NOT. LASSIM ) CALL ABOR1_SFX("YOU CAN'T RUN SODA WITHOUT SETTING LASSIM=.TRUE. IN THE ASSIM NAMELIST")
-!
-ALLOCATE(GD_MASKEXT(ISIZE_FULL))
-GD_MASKEXT(:) = .FALSE.
-!
-ALLOCATE(ZLON(ISIZE_FULL))
-ALLOCATE(ZLAT(ISIZE_FULL))
-ZLON(:) = YSURF_CUR%UG%XLON(:)
-ZLAT(:) = YSURF_CUR%UG%XLAT(:)
-!
-GLKEEPEXTZONE = .TRUE.
-!
-IF (NRANK==NPIO) WRITE(*,*) 'PERFORMIMG OFFLINE SURFEX DATA ASSIMILATION...'
- CALL ASSIM_SURF_ATM_n(YSURF_CUR%IM%DGMI, YSURF_CUR%IM%IG, YSURF_CUR%IM%I, YSURF_CUR%SM%S, &
- YSURF_CUR%U, YSURF_CUR%TM%T, YSURF_CUR%TM%TOP, YSURF_CUR%WM%W, &
- CSURF_FILETYPE,ISIZE_FULL, &
- ZCON_RAIN, ZSTRAT_RAIN, ZCON_SNOW, ZSTRAT_SNOW, &
- ZCLOUDS, ZLSM, ZEVAPTR, ZEVAP, &
- ZSWEC, ZTSC, &
- ZTS, ZT2M, ZHU2M, ZSWE, &
- ZSST, ZSIC, ZUCLS, ZVCLS, &
- YTEST, GD_MASKEXT, ZLON, ZLAT, GLKEEPEXTZONE )
-!
-DEALLOCATE(ZCON_RAIN)
-DEALLOCATE(ZSTRAT_RAIN)
-DEALLOCATE(ZCON_SNOW)
-DEALLOCATE(ZSTRAT_SNOW)
-DEALLOCATE(ZCLOUDS)
-DEALLOCATE(ZLSM)
-DEALLOCATE(ZEVAPTR)
-DEALLOCATE(ZEVAP)
-DEALLOCATE(ZTSC)
-DEALLOCATE(ZSWEC)
-DEALLOCATE(ZTS)
-DEALLOCATE(ZT2M)
-DEALLOCATE(ZHU2M)
-DEALLOCATE(ZSWE)
-DEALLOCATE(ZUCLS)
-DEALLOCATE(ZVCLS)
-DEALLOCATE(ZSST)
-DEALLOCATE(ZSIC)
-!
-!
-IF (CTIMESERIES_FILETYPE=="OFFLIN") THEN
- CALL INIT_OUTPUT_OL_n (YSURF_CUR)
-ENDIF
-!
-ZTIME_OUT = ZTIME
-IDAY_OUT = IDAY
-IMONTH_OUT = IMONTH
-IYEAR_OUT = IYEAR
-!
-IF (NRANK==NPIO) THEN
- !
- IF(LOUT_TIMENAME)THEN
- ! if true, change the name of output file at the end of a day
- ! (ex: 19860502_00h00 -> 19860501_24h00)
- IF(ZTIME==0.0)THEN
- ZTIME_OUT = 86400.
- IDAY_OUT = IDAY-1
- IF(IDAY_OUT==0)THEN
- IMONTH_OUT = IMONTH - 1
- IF(IMONTH_OUT==0)THEN
- IMONTH_OUT=12
- IYEAR_OUT = IYEAR - 1
- ENDIF
- SELECT CASE (IMONTH_OUT)
- CASE(4,6,9,11)
- IDAY_OUT=30
- CASE(1,3,5,7:8,10,12)
- IDAY_OUT=31
- CASE(2)
- IF( ((MOD(IYEAR_OUT,4)==0).AND.(MOD(IYEAR_OUT,100)/=0)) .OR. (MOD(IYEAR_OUT,400)==0))THEN
- IDAY_OUT=29
- ELSE
- IDAY_OUT=28
- ENDIF
- END SELECT
- ENDIF
- ENDIF
- !
- ENDIF
- !
- WRITE(YTAG,FMT='(I4.4,I2.2,I2.2,A1,I2.2,A1,I2.2)') IYEAR_OUT,IMONTH_OUT,IDAY_OUT,&
- '_',INT(ZTIME_OUT/3600.),'h',NINT(ZTIME_OUT)/60-60*INT(ZTIME_OUT/3600.)
- CFILEOUT = ADJUSTL(ADJUSTR(CSURFFILE)//'.'//YTAG//'.txt')
-#ifdef SFX_LFI
- CFILEOUT_LFI= ADJUSTL(ADJUSTR(CSURFFILE)//'.'//YTAG)
-#endif
-#ifdef SFX_FA
- CFILEOUT_FA = ADJUSTL(ADJUSTR(CSURFFILE)//'.'//YTAG//'.fa')
-#endif
-#ifdef SFX_NC
- CFILEOUT_NC = ADJUSTL(ADJUSTR(CSURFFILE)//'.'//YTAG//'.nc')
-#endif
- !
- IF (CSURF_FILETYPE=='FA ') THEN
-#ifdef SFX_FA
- CDNOMC = 'header'
- LFANOCOMPACT = LDIAG_FA_NOCOMPACT
- IDATEF(1)= IYEAR_OUT
- IDATEF(2)= IMONTH_OUT
- IDATEF(3)= IDAY_OUT
- IDATEF(4)= FLOOR(ZTIME_OUT/3600.)
- IDATEF(5)= FLOOR(ZTIME_OUT/60.) - IDATEF(4) * 60
- IDATEF(6)= NINT(ZTIME_OUT) - IDATEF(4) * 3600 - IDATEF(5) * 60
- IDATEF(7:11) = 0
- CALL FAITOU(IRET,NUNIT_FA,.TRUE.,CFILEOUT_FA,'UNKNOWN',.TRUE.,.FALSE.,IVERBFA,0,INB,CDNOMC)
- CALL FANDAR(IRET,NUNIT_FA,IDATEF)
-#endif
- END IF
- !
-ENDIF
-!
-ISIZE = 1
-IF (CASSIM_ISBA=="ENKF ") THEN
- ISIZE = NENS
- IF (LBIAS_CORRECTION) ISIZE = ISIZE + 1
-ENDIF
-!
-NWRITE = 1
-XSTARTW = 1
-LTIME_WRITTEN(:)=.FALSE.
-!
-DO IENS = 1,ISIZE
- !
- IF (CASSIM_ISBA=="ENKF ") THEN
- !
- YMFILE = "PREP_"
- CALL GET_FILE_NAME(IYEAR,IMONTH,IDAY,IHOUR,YMFILE)
- WRITE(YVAR,'(I3)') IENS
- YFILEIN = TRIM(YMFILE)//"_EKF_ENS"//ADJUSTL(YVAR)
- CALL SET_FILEIN(YFILEIN)
- !
- LREAD_ALL = .TRUE.
- !
- CALL DEALLOC_SURF_ATM_n(YSURF_CUR)
- !
- ! Initialize the SURFEX interface
- CALL IO_BUFF_CLEAN
- CALL INIT_SURF_ATM_n(YSURF_CUR, &
- CSURF_FILETYPE,YINIT, LLAND_USE, ISIZE_FULL, ISV, ISW, &
- CSV, XCO2, XRHOA, XZENITH, XAZIM, XSW_BANDS, &
- XDIR_ALB, XSCA_ALB, XEMIS, XTSRAD, XTSURF, &
- IYEAR, IMONTH, IDAY, ZTIME, &
- YATMFILE, YATMFILETYPE, YTEST )
- !
- !
- DO JL=1,NVAR
- !
- ! Update the modified values
- SELECT CASE (TRIM(CVAR(JL)))
- CASE("TG1")
- YSURF_CUR%IM%I%XTG(:,1,:) = XF(:,:,IENS,JL)
- CASE("TG2")
- YSURF_CUR%IM%I%XTG(:,2,:) = XF(:,:,IENS,JL)
- CASE("WG1")
- YSURF_CUR%IM%I%XWG(:,1,:) = XF(:,:,IENS,JL)
- CASE("WG2")
- YSURF_CUR%IM%I%XWG(:,2,:) = XF(:,:,IENS,JL)
- CASE("WG3")
- YSURF_CUR%IM%I%XWG(:,3,:) = XF(:,:,IENS,JL)
- CASE("LAI")
- YSURF_CUR%IM%I%XLAI(:,:) = XF(:,:,IENS,JL)
- CASE DEFAULT
- CALL ABOR1_SFX("Mapping of "//TRIM(CVAR(JL))//" is not defined in EKF!")
- END SELECT
- ENDDO
- !
- ENDIF
- !
-#ifdef SFX_NC
- LDEF = .TRUE.
-#endif
- !
- IF (CTIMESERIES_FILETYPE=="NC ") THEN
- CALL INIT_OUTPUT_NC_n (YSURF_CUR%TM%BDD, YSURF_CUR%CHE, YSURF_CUR%CHN, YSURF_CUR%CHU, &
- YSURF_CUR%SM%DTS, YSURF_CUR%TM%DTT, YSURF_CUR%DTZ, YSURF_CUR%IM%I, &
- YSURF_CUR%UG, YSURF_CUR%U, YSURF_CUR%DGU)
- ENDIF
- !
- INW = 1
- IF (CTIMESERIES_FILETYPE=="NC ") INW = 2
- !
- DO JNW = 1,INW
- CALL IO_BUFF_CLEAN
- CALL WRITE_SURF_ATM_n(YSURF_CUR, &
- CTIMESERIES_FILETYPE,'ALL',LLAND_USE)
- CALL WRITE_DIAG_SURF_ATM_n(YSURF_CUR, &
- CTIMESERIES_FILETYPE,'ALL')
-#ifdef SFX_NC
- LDEF = .FALSE.
-#endif
- ENDDO
- !
- CALL FLAG_UPDATE(YSURF_CUR%IM%DGI, YSURF_CUR%DGU,.FALSE.,.TRUE.,.FALSE.,.FALSE.)
- !
- IF (LRESTART_2M) THEN
- I2M = 1
- GPGD_ISBA = .TRUE.
- ELSE
- I2M = 0
- GPGD_ISBA = .FALSE.
- ENDIF
- GFRAC = .TRUE.
- GDIAG_GRID = .TRUE.
- GSURF_BUDGET = .FALSE.
- GRAD_BUDGET = .FALSE.
- GCOEF = .FALSE.
- GSURF_VARS = .FALSE.
- IBEQ = 0
- IDSTEQ = 0
- GDIAG_OCEAN = .FALSE.
- GDIAG_SEAICE = .FALSE.
- GWATER_PROFILE = .FALSE.
- GSURF_EVAP_BUDGET = .FALSE.
- GFLOOD = .FALSE.
- GPGD_ISBA = .FALSE.
- GCH_NO_FLUX_ISBA = .FALSE.
- GSURF_MISC_BUDGET_ISBA = .FALSE.
- GPGD_TEB = .FALSE.
- GSURF_MISC_BUDGET_TEB = .FALSE.
- !
- CALL FLAG_DIAG_UPDATE(YSURF_CUR%FM%CHF, YSURF_CUR%IM%CHI, YSURF_CUR%SM%CHS, YSURF_CUR%TM%CHT, &
- YSURF_CUR%WM%CHW, YSURF_CUR%IM%DGEI, YSURF_CUR%FM%DGF, YSURF_CUR%IM%DGI, &
- YSURF_CUR%FM%DGMF, YSURF_CUR%IM%DGMI, YSURF_CUR%TM%DGMTO, YSURF_CUR%SM%DGO, &
- YSURF_CUR%SM%DGS, YSURF_CUR%SM%DGSI, YSURF_CUR%DGU, YSURF_CUR%TM%DGT, &
- YSURF_CUR%WM%DGW, YSURF_CUR%IM%I, YSURF_CUR%U, &
- GFRAC, GDIAG_GRID, I2M, GSURF_BUDGET, GRAD_BUDGET, GCOEF, &
- GSURF_VARS, IBEQ, IDSTEQ, GDIAG_OCEAN, GDIAG_SEAICE, &
- GWATER_PROFILE, &
- GSURF_EVAP_BUDGET, GFLOOD, GPGD_ISBA, GCH_NO_FLUX_ISBA, &
- GSURF_MISC_BUDGET_ISBA, GPGD_TEB, GSURF_MISC_BUDGET_TEB )
- !
- YENS = ' '
- IF (ISIZE>1) WRITE(YENS,'(I3)') IENS
- !
- IF ( CSURF_FILETYPE == "LFI " ) THEN
-#ifdef SFX_LFI
- CFILEOUT_LFI = TRIM(TRIM(CSURFFILE)//ADJUSTL(YENS))
-#endif
- ELSEIF ( CSURF_FILETYPE == "FA " ) THEN
-#ifdef SFX_FA
- CFILEOUT_FA = ADJUSTL(TRIM(ADJUSTR(CSURFFILE)//ADJUSTL(YENS))//'.fa')
-#endif
- ELSEIF ( CSURF_FILETYPE == "ASCII " ) THEN
-#ifdef SFX_ASC
- CFILEOUT = ADJUSTL(TRIM(ADJUSTR(CSURFFILE)//ADJUSTL(YENS))//'.txt')
- LCREATED = .FALSE.
-#endif
- ELSEIF ( CSURF_FILETYPE == "NC " ) THEN
-#ifdef SFX_NC
- CFILEOUT_NC = ADJUSTL(TRIM(ADJUSTR(CSURFFILE)//ADJUSTL(YENS))//'.nc')
-#endif
- ELSE
- CALL ABOR1_SFX(TRIM(CSURF_FILETYPE)//" is not implemented!")
- ENDIF
- !
-#ifdef SFX_NC
- LDEF = .TRUE.
-#endif
- !
- IF (CSURF_FILETYPE=="NC ") THEN
- CALL INIT_OUTPUT_NC_n (YSURF_CUR%TM%BDD, YSURF_CUR%CHE, YSURF_CUR%CHN, YSURF_CUR%CHU, &
- YSURF_CUR%SM%DTS, YSURF_CUR%TM%DTT, YSURF_CUR%DTZ, YSURF_CUR%IM%I, &
- YSURF_CUR%UG, YSURF_CUR%U, YSURF_CUR%DGU)
- ENDIF
- !
- INW = 1
- IF (CSURF_FILETYPE=="NC ") INW = 2
- !
- DO JNW = 1,INW
- !
- CALL IO_BUFF_CLEAN
- !
- ! Store results from assimilation
- CALL WRITE_SURF_ATM_n(YSURF_CUR, &
- CSURF_FILETYPE,'ALL',LLAND_USE)
- IF (YSURF_CUR%DGU%LREAD_BUDGETC.AND..NOT.YSURF_CUR%IM%DGEI%LRESET_BUDGETC) THEN
- CALL WRITE_DIAG_SURF_ATM_n(YSURF_CUR, &
- CSURF_FILETYPE,'ALL')
- ENDIF
-#ifdef SFX_NC
- LDEF = .FALSE.
-#endif
- !
- ENDDO
- !
-ENDDO
-!
-IF (NRANK==NPIO .AND. CSURF_FILETYPE=='FA ') THEN
-#ifdef SFX_FA
- CALL FAIRME(IRET,NUNIT_FA,'UNKNOWN')
-#endif
-END IF
-!
-!* 3. Close parallelized I/O
-! ----------------------
-!
-IF (CTIMESERIES_FILETYPE=='OFFLIN') CALL CLOSE_FILEOUT_OL
-!
-IF (NRANK==NPIO) THEN
- WRITE(ILUOUT,*) ' '
- WRITE(ILUOUT,*) ' -----------------------'
- WRITE(ILUOUT,*) ' | SODA ENDS CORRECTLY |'
- WRITE(ILUOUT,*) ' -----------------------'
- !
- WRITE(*,*) ' '
- WRITE(*,*) ' -----------------------'
- WRITE(*,*) ' | SODA ENDS CORRECTLY |'
- WRITE(*,*) ' -----------------------'
- !
-ENDIF
-!
- CLOSE(ILUOUT)
-!
- CALL SURFEX_DEALLO_LIST
-!
-IF (ALLOCATED(NINDEX)) DEALLOCATE(NINDEX)
-IF (ALLOCATED(NSIZE_TASK)) DEALLOCATE(NSIZE_TASK)
-!
-IF (ASSOCIATED(NWORK)) DEALLOCATE(NWORK)
-IF (ASSOCIATED(XWORK)) DEALLOCATE(XWORK)
-IF (ASSOCIATED(NWORK2)) DEALLOCATE(NWORK2)
-IF (ASSOCIATED(XWORK2)) DEALLOCATE(XWORK2)
-IF (ASSOCIATED(XWORK3)) DEALLOCATE(XWORK3)
-IF (ASSOCIATED(NWORK_FULL)) DEALLOCATE(NWORK_FULL)
-IF (ASSOCIATED(XWORK_FULL)) DEALLOCATE(XWORK_FULL)
-IF (ASSOCIATED(NWORK2_FULL)) DEALLOCATE(NWORK2_FULL)
-IF (ASSOCIATED(XWORK2_FULL)) DEALLOCATE(XWORK2_FULL)
-!
- CALL END_LOG_MPI
-!
-IF (LHOOK) CALL DR_HOOK('SODA',1,ZHOOK_HANDLE)
-!
-#ifdef SFX_MPI
- CALL MPI_FINALIZE(INFOMPI)
-#endif
-!
-!-------------------------------------------------------------------------------
-
-#endif
-END PROGRAM SODA
diff --git a/src/SURFEX/soil.F90 b/src/SURFEX/soil.F90
index 266448a237f3018b4e21324ba92b83756020f273..72dc3446cef5bd38e8758aad14da141475a085ed 100644
--- a/src/SURFEX/soil.F90
+++ b/src/SURFEX/soil.F90
@@ -3,16 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE SOIL( HC1DRY, HSCOND, HSNOW_ISBA, OGLACIER, &
- PSNOWRHOM, PVEG, &
- PCGSAT, PCGMAX, &
- PC1SAT, PC2REF, PACOEF, PPCOEF, PCV, &
- PPSN, PPSNG, PPSNV, PFFG, PFFV, PFF, &
- PCG, PC1, PC2, PWGEQ, PCT, PCS, PFROZEN1, &
- PTG, PWG, PWGI, &
- PHCAPSOILZ, PCONDDRYZ, PCONDSLDZ, &
- PBCOEF, PWSAT, PWWILT, &
- HKSAT, PCONDSAT, PFFG_NOSNOW, PFFV_NOSNOW )
+ SUBROUTINE SOIL( IO, KK, PK, PEK, DMI, PVEG, PCS, PFROZEN1, PFFG_NOSNOW, PFFV_NOSNOW )
! ##########################################################################
!
!!**** *SOIL*
@@ -64,9 +55,9 @@
!! option to explicitly compute CG
!! 25/05/08 (Decharme) Added flood properties
!! 22/06/10 (Chauvin) XWGMIN added as a limit value of ZWG2
-!! Modification of the formula for PWGEQ
+!! Modification of the formula for DMI%XWGEQ
!! to solve numerical problem
-!! 10/10 (Decharme) The previous computation of WGEQ as ( 1.-ZX(JJ)**(PPCOEF(JJ)*8.) )
+!! 10/10 (Decharme) The previous computation of WGEQ as ( 1.-ZX(JJ)**(IP%XPCOEF(JJ)*8.) )
!! can introduced some model explosions for heavy clay soil
!! 12/14 (LeMoigne) EBA scheme update
!-------------------------------------------------------------------------------
@@ -74,6 +65,10 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
+!
USE MODD_CSTS, ONLY : XPI, XCI, XRHOLI, XDAY, XCL, XRHOLW, XCONDI
USE MODD_ISBA_PAR, ONLY : XCONDWTR, XWGMIN
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -87,97 +82,21 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMI
+!
+REAL, DIMENSION(:), INTENT(IN) :: PVEG
!
- CHARACTER(LEN=*), INTENT(IN) :: HC1DRY ! C1 for dry soil formulation
-! ! 'DEF' Default: Giard and Bazile
-! ! 'GB93' Giordani 1993, Braud 1993
-! ! (discontinuous at WILT)
-!
- CHARACTER(LEN=*), INTENT(IN) :: HSCOND ! thermal conductivity formulation
-! ! 'NP89': Noilhan and Planton
-! ! (1989: McCumber-Pielke (1981) and
-! ! Clapp and Hornberger (1978))
-! ! 'PL98' Method of Johansen (1975) as
-! ! presented by Peters-Lidard (JAS: 1998)
-!
- CHARACTER(LEN=*), INTENT(IN) :: HSNOW_ISBA ! 'DEF' = Default F-R snow scheme
-! ! (Douville et al. 1995)
-! ! '3-L' = 3-L snow scheme (option)
-! ! (Boone and Etchevers 2000)
-!
-LOGICAL, INTENT(IN) :: OGLACIER ! T = Over permanent snow and ice,
-! ! initialise WGI=WSAT, Hsnow>=10m
-! ! and allow 0.8<SNOWALB<0.85
-! ! F = No specific treatment
-!
-REAL, DIMENSION(:), INTENT(IN) :: PSNOWRHOM
-! Prognostic variables of ISBA at 't-dt'
-! PSNOWRHOM = density of snow
-!
-REAL, INTENT(IN) :: PCGMAX
-! Maximum soil heat capacity
-!
-REAL, DIMENSION(:), INTENT(IN) :: PVEG, PCGSAT, PC1SAT
-REAL, DIMENSION(:), INTENT(IN) :: PC2REF, PACOEF, PPCOEF, PCV
-! Soil and vegetation parameters
-! PVEG = fraction of vegetation
-! PCGSAT = soil thermal coefficient at saturation
-! PC1SAT = value of C1 at saturation
-! PC2REF = reference value of C2
-! PACOEF, PPCOEF = a and p coefficients for
-! the wgeq formulation
-! PCV = the heat capacity of the vegetation
-!
-REAL, DIMENSION(:), INTENT(IN) :: PPSN, PPSNG, PPSNV
-! PPSN = fraction of the grid covered by snow
-! PPSNG = fraction of the bare soil covered
-! by snow
-! PPSNV = fraction of the vegetation covered
-! by snow
-!
-REAL, DIMENSION(:), INTENT(IN) :: PHCAPSOILZ, PCONDDRYZ, PCONDSLDZ
-! PHCAPSOILZ = soil heat capacity [J/(K m3)]
-! PCONDDRYZ = soil dry thermal conductivity
-! [W/(m K)]
-! PCONDSLDZ = soil solids thermal conductivity
-! [W/(m K)]
-!
-REAL, DIMENSION(:), INTENT(IN) :: PBCOEF, PWSAT, PWWILT
-! PBCOEF = b-parameter (-)
-! PWSAT = porosity (m3/m3)
-! PWWILT = wilting point volumetric water content(m3/m3)
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTG
-! PTG = surface temperature (K)
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PWG, PWGI
-! PWG = soil liquid water content (m3/m3)
-! PWGI = soil frozen water content (m3/m3)
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PCG, PC1, PC2, PWGEQ, PCT
REAL, DIMENSION(:), INTENT(OUT) :: PCS, PFROZEN1
! soil and snow coefficients
-! PCG = heat capacity of the bare soil
-! C1, C2 = coefficients for the moisture calculations
-! PWGEQ = equilibrium surface volumetric moisture
-! PCT = averaged heat capacity of the grid
! PCS = heat capacity of the snow
! PFROZEN1 = fraction of ice in superficial
! soil
!
- CHARACTER(LEN=*), INTENT(IN) :: HKSAT ! soil hydraulic profil option
-! ! 'DEF' = ISBA homogenous soil
-! ! 'SGH' = ksat exponential decay
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PCONDSAT ! hydraulic conductivity at saturation (m/s)
- ! use in the force restore scheme for
- ! calculate the exponential decay factor coefficients
-!
-REAL, DIMENSION(:), INTENT(IN) :: PFFV, PFFG, PFF, PFFG_NOSNOW, PFFV_NOSNOW
-! PFFG = Floodplain fraction over the ground
-! PFFV = Floodplain fraction over vegetation
-! PFF = Floodplain fraction at the surface
-!
+REAL, DIMENSION(:), INTENT(IN) :: PFFG_NOSNOW, PFFV_NOSNOW
!
!* 0.2 declarations of local variables
!
@@ -188,12 +107,12 @@ REAL, DIMENSION(SIZE(PVEG)) :: ZLAMS, &
ZLYMY1, ZZA, ZZB, ZDELTA, &
ZA, ZB, &
! temporary variables for the
-! calculation of PC1 in the case
+! calculation of DMI%XC1 in the case
! where PWG < PWWILT (i.e., dry soils)
!
ZX, &
! temporary variable for the
-! calculation of PWGEQ
+! calculation of DMI%XWGEQ
ZWSAT, &
! Wsat when ice is present in ground
ZWSAT1, &
@@ -264,17 +183,17 @@ PCS(:) = XUNDEF
! ---------------------------------
!
PFROZEN1(:) = 0.
-WHERE (PWGI(:,1) + PWG(:,1) .NE. 0.)
- PFROZEN1(:) = PWGI(:,1) / (PWGI(:,1) + PWG(:,1))
+WHERE (PEK%XWGI(:,1) + PEK%XWG(:,1) .NE. 0.)
+ PFROZEN1(:) = PEK%XWGI(:,1) / (PEK%XWGI(:,1) + PEK%XWG(:,1))
END WHERE
!
-DO JJ=1,SIZE(PWSAT)
+DO JJ=1,SIZE(KK%XWSAT,1)
!
- ZWSAT(JJ) = MAX(PWSAT(JJ) - PWGI(JJ,2),XWGMIN)
+ ZWSAT(JJ) = MAX(KK%XWSAT(JJ,1) - PEK%XWGI(JJ,2),XWGMIN)
!
- ZWSAT1(JJ) = MAX(PWSAT(JJ) - PWGI(JJ,1),XWGMIN)
+ ZWSAT1(JJ) = MAX(KK%XWSAT(JJ,1) - PEK%XWGI(JJ,1),XWGMIN)
!
- ZWWILT(JJ) = PWWILT(JJ) * (ZWSAT1(JJ) / PWSAT(JJ))
+ ZWWILT(JJ) = KK%XWWILT(JJ,1) * (ZWSAT1(JJ) / KK%XWSAT(JJ,1))
!
ENDDO
!-------------------------------------------------------------------------------
@@ -282,7 +201,7 @@ ENDDO
!* 2. THE HEAT CAPACITY OF BARE-GROUND
! --------------------------------
!
-IF(HSCOND == 'NP89')THEN
+IF(IO%CSCOND == 'NP89')THEN
!
! Actually, all the 'C' coefficients in
! ISBA do not represent heat capacities,
@@ -298,9 +217,8 @@ IF(HSCOND == 'NP89')THEN
! Now calculate the thermal inertia of the soil weighted
! by soil ice content (including the soil ice thermal inertia):
!
- PCG(:) = (1.-PWGI(:,2)) * PCGSAT(:) * ( ZWSAT(:)/PWG(:,2) ) &
- **( 0.5*PBCOEF(:)/LOG(10.) ) &
- + PWGI(:,2) * 2. * SQRT(XPI/(XCONDI*XCI*XRHOLI*XDAY))
+ DMI%XCG(:) = (1.-PEK%XWGI(:,2)) * KK%XCGSAT(:) * ( ZWSAT(:)/PEK%XWG(:,2) ) **( 0.5*KK%XBCOEF(:,1)/LOG(10.) ) &
+ + PEK%XWGI(:,2) * 2. * SQRT(XPI/(XCONDI*XCI*XRHOLI*XDAY))
!
!
ELSE
@@ -313,25 +231,24 @@ ELSE
! method of McCumber and Pielke (1981)
! with parameters of Clapp and Hornberger (1978).
!
- DO JJ=1,SIZE(PWG,1)
+ DO JJ=1,SIZE(PEK%XWG,1)
!
! Total fraction of soil frozen:
!
- ZFROZEN2(JJ) = PWGI(JJ,2)/(PWGI(JJ,2) + PWG(JJ,2))
+ ZFROZEN2(JJ) = PEK%XWGI(JJ,2)/(PEK%XWGI(JJ,2) + PEK%XWG(JJ,2))
!
! Unfrozen fraction:
!
- ZUNFROZEN2(JJ) = (1.0-ZFROZEN2(JJ))*PWSAT(JJ)
+ ZUNFROZEN2(JJ) = (1.0-ZFROZEN2(JJ))*KK%XWSAT(JJ,1)
!
! Saturated thermal conductivity:
!
- ZCONDSAT(JJ) = (PCONDSLDZ(JJ)**(1.0-PWSAT(JJ)))* &
- (XCONDI**(PWSAT(JJ)-ZUNFROZEN2(JJ)))* &
+ ZCONDSAT(JJ) = (KK%XCONDSLD(JJ,1)**(1.0-KK%XWSAT(JJ,1)))* (XCONDI**(KK%XWSAT(JJ,1)-ZUNFROZEN2(JJ)))* &
(XCONDWTR**ZUNFROZEN2(JJ))
!
! Degree of saturation of soil:
!
- ZSATDEG(JJ) = MAX(0.1, (PWGI(JJ,2)+PWG(JJ,2))/PWSAT(JJ))
+ ZSATDEG(JJ) = MAX(0.1, (PEK%XWGI(JJ,2)+PEK%XWG(JJ,2))/KK%XWSAT(JJ,1))
!
! Kersten number:
!
@@ -346,17 +263,17 @@ ELSE
!
! Thermal conductivity of soil:
!
- ZCOND(JJ) = ZKERSTEN(JJ)*(ZCONDSAT(JJ)-PCONDDRYZ(JJ)) + PCONDDRYZ(JJ)
+ ZCOND(JJ) = ZKERSTEN(JJ)*(ZCONDSAT(JJ)-KK%XCONDDRY(JJ,1)) + KK%XCONDDRY(JJ,1)
!
! Heat capacity of soil:
!
- ZHCAP(JJ) = (1.0-PWSAT(JJ)) * PHCAPSOILZ(JJ) + &
- PWG (JJ,2) * XCL * XRHOLW + &
- PWGI(JJ,2) * XCI * XRHOLI
+ ZHCAP(JJ) = (1.0-KK%XWSAT(JJ,1)) * KK%XHCAPSOIL(JJ,1) + &
+ PEK%XWG (JJ,2) * XCL * XRHOLW + &
+ PEK%XWGI(JJ,2) * XCI * XRHOLI
!
! Explicit CG calculation:
!
- PCG(JJ) = 2.*SQRT(XPI/ZCOND(JJ)/ZHCAP(JJ)/XDAY)
+ DMI%XCG(JJ) = 2.*SQRT(XPI/ZCOND(JJ)/ZHCAP(JJ)/XDAY)
!
ENDDO
!
@@ -364,23 +281,23 @@ ENDIF
!
! Cg must be smaller than 2.E-5
!
-PCG(:) = MIN( PCG(:), PCGMAX )
+DMI%XCG(:) = MIN( DMI%XCG(:), IO%XCGMAX )
!
!-------------------------------------------------------------------------------
!
!* 4. THE HEAT CAPACITY OF THE SNOW AND FLOOD
! ---------------------------------------
!
-WHERE (PFF(:) > 0.)
+WHERE (KK%XFF(:) > 0.)
ZCF(:) = 2.0 * SQRT( XPI/(XCONDWTR*XRHOLW*XCL*XDAY) )
END WHERE
!
-IF(HSNOW_ISBA == 'D95' .OR. (HSNOW_ISBA == 'EBA' .AND. OGLACIER) )THEN
+IF(PEK%TSNOW%SCHEME == 'D95' .OR. (PEK%TSNOW%SCHEME == 'EBA' .AND. IO%LGLACIER) )THEN
!
- WHERE (PPSN > 0.)
- ZLAMS(:) = XCONDI * (PSNOWRHOM(:)/XRHOLW)**1.885 ! first calculate the
+ WHERE (PEK%XPSN(:) > 0.)
+ ZLAMS(:) = XCONDI * (PEK%TSNOW%RHO(:,1)/XRHOLW)**1.885 ! first calculate the
! ! conductivity of snow
- PCS(:) = 2.0 * SQRT( XPI/(ZLAMS(:)*PSNOWRHOM(:)*XCI*XDAY) )
+ PCS(:) = 2.0 * SQRT( XPI/(ZLAMS(:)*PEK%TSNOW%RHO(:,1)*XCI*XDAY) )
END WHERE
!
!-------------------------------------------------------------------------------
@@ -391,10 +308,10 @@ IF(HSNOW_ISBA == 'D95' .OR. (HSNOW_ISBA == 'EBA' .AND. OGLACIER) )THEN
! With contribution from the ground, vegetation, flood and snow areas
! for composite (Force-Restore) snow scheme option:
!
- PCT(:) = 1. / ( (1.-PVEG(:))*(1.-PPSNG(:)-PFFG(:)) / PCG(:) &
- + PVEG(:) *(1.-PPSNV(:)-PFFV(:)) / PCV(:) &
- + PFF (:) / ZCF(:) &
- + PPSN(:) / PCS(:) )
+ DMI%XCT(:) = 1. / ( (1.-PVEG(:))*(1.-PEK%XPSNG(:)-KK%XFFG(:)) / DMI%XCG(:) &
+ + PVEG(:) *(1.-PEK%XPSNV(:)-KK%XFFV(:)) / PEK%XCV(:) &
+ + KK%XFF(:) / ZCF(:) &
+ + PEK%XPSN(:) / PCS(:) )
!
ELSE
@@ -406,9 +323,9 @@ ELSE
! With contribution from the ground and vegetation for explicit
! (ISBA-ES) snow scheme option:
!
- PCT(JJ) = 1. / ( (1.-PVEG(JJ))*(1.-PFFG_NOSNOW(JJ)) / PCG(JJ) &
- + PVEG(JJ) *(1.-PFFV_NOSNOW(JJ)) / PCV(JJ) &
- + ZFF (JJ) / ZCF(JJ) )
+ DMI%XCT(JJ) = 1. / ( (1.-PVEG(JJ))*(1.-PFFG_NOSNOW(JJ)) / DMI%XCG(JJ) &
+ + PVEG(JJ) *(1.-PFFV_NOSNOW(JJ)) / PEK%XCV(JJ) &
+ + ZFF (JJ) / ZCF(JJ) )
ENDDO
!
ENDIF
@@ -421,19 +338,19 @@ ENDIF
! Scale the C1SAT coefficient as a function
! of the soil ice content
!
-ZC1SAT(:) = PC1SAT(:)*SQRT(ZWSAT1(:)/PWSAT(:))
+ZC1SAT(:) = PK%XC1SAT(:)*SQRT(ZWSAT1(:)/KK%XWSAT(:,1))
!
!
! The coefficient C1 is calculated two
! different ways depending on the humidity
! of the soil
!
-WHERE (PWG(:,1) > ZWWILT(:))
+WHERE (PEK%XWG(:,1) > ZWWILT(:))
! ! First situation: humid soil
! Then the calculation follows eq. (19)
! of Noilhan and Planton(1989)
!
- PC1(:) = ZC1SAT(:) * ( ZWSAT1(:)/PWG(:,1) )**( 0.5*PBCOEF(:) + 1 )
+ DMI%XC1(:) = ZC1SAT(:) * ( ZWSAT1(:)/PEK%XWG(:,1) )**( 0.5*KK%XBCOEF(:,1) + 1 )
!
END WHERE
!
@@ -449,11 +366,11 @@ END WHERE
! of temperature, whereas the continuous method
! assumes a constant temperature.
!
-IF(HC1DRY=='GB93')THEN
+IF(IO%CC1DRY=='GB93')THEN
!
- DO JJ=1,SIZE(PWG,1)
+ DO JJ=1,SIZE(PEK%XWG,1)
!
- IF (PWG(JJ,1) <= ZWWILT(JJ)) THEN
+ IF (PEK%XWG(JJ,1) <= ZWWILT(JJ)) THEN
!
! ! Second situation: dry soil
! We use the Gaussian formulation of
@@ -461,19 +378,16 @@ IF(HC1DRY=='GB93')THEN
!
!* maximum of C1 curve (computed with true Wwilt)
!
- ZCW1MAX(JJ) = ( 1.19*ZWWILT(JJ)-5.09 )*PTG(JJ) + (-146.4*ZWWILT(JJ)+1786.)
+ ZCW1MAX(JJ) = ( 1.19*ZWWILT(JJ)-5.09 )*PEK%XTG(JJ,1) + (-146.4*ZWWILT(JJ)+1786.)
!
!* Giordanni (1993) and Braud et al. (1993)
!
- ZA(JJ) = (-1.815E-2*PTG(JJ)+6.41)*ZWWILT(JJ) &
- + (6.5E-3*PTG(JJ)-1.4)
+ ZA(JJ) = (-1.815E-2*PEK%XTG(JJ,1)+6.41)*ZWWILT(JJ) + (6.5E-3*PEK%XTG(JJ,1)-1.4)
ZB(JJ) = ZA(JJ)*ZWWILT(JJ)
- ZDELTA(JJ) = ( ZB(JJ)*ZB(JJ) ) / &
- ( 2.*LOG( ZCW1MAX(JJ) ) )
+ ZDELTA(JJ) = ( ZB(JJ)*ZB(JJ) ) / ( 2.*LOG( ZCW1MAX(JJ) ) )
!
- PC1(JJ) = ZCW1MAX(JJ)*(1. - 2.*PVEG(JJ)*( 1.-PVEG(JJ) )) &
- *EXP( -(PWG(JJ,1)-ZB(JJ))*(PWG(JJ,1)-ZB(JJ)) / &
- (2.*ZDELTA(JJ)) )
+ DMI%XC1(JJ) = ZCW1MAX(JJ)*(1. - 2.*PVEG(JJ)*( 1.-PVEG(JJ) )) &
+ *EXP( -(PEK%XWG(JJ,1)-ZB(JJ))*(PEK%XWG(JJ,1)-ZB(JJ)) / (2.*ZDELTA(JJ)) )
!
ENDIF
!
@@ -481,13 +395,13 @@ IF(HC1DRY=='GB93')THEN
!
ELSE
!
- DO JJ=1,SIZE(PWG,1)
+ DO JJ=1,SIZE(PEK%XWG,1)
!
- IF (PWG(JJ,1) <= ZWWILT(JJ)) THEN
+ IF (PEK%XWG(JJ,1) <= ZWWILT(JJ)) THEN
!
!* maximum of C1 curve (computed with true Wwilt)
!
- ZCW1MAX(JJ) = ( 1.19*ZWWILT(JJ)-5.09 )*PTG(JJ) + (-146.4*ZWWILT(JJ)+1786.)
+ ZCW1MAX(JJ) = ( 1.19*ZWWILT(JJ)-5.09 )*PEK%XTG(JJ,1) + (-146.4*ZWWILT(JJ)+1786.)
!
!* C1 value at Wg = zero
!
@@ -496,7 +410,7 @@ ELSE
!* C1 value at Wg = wwilt
!
ZX2(JJ) = ZWWILT(JJ)
- ZY2(JJ) = ZC1SAT(JJ)*(ZWSAT1(JJ)/ZWWILT(JJ))**( 0.5*PBCOEF(JJ) + 1)
+ ZY2(JJ) = ZC1SAT(JJ)*(ZWSAT1(JJ)/ZWWILT(JJ))**( 0.5*KK%XBCOEF(JJ,1) + 1)
!
!* correction of maximum of C1 curve for frozen soils
!
@@ -514,7 +428,7 @@ ELSE
ZB (JJ) = ZA(JJ)**2 / ZLYMY1(JJ)
!
!
- PC1(JJ) = ZCW1MAX(JJ) * EXP( - (PWG(JJ,1)-ZA(JJ))**2 / ZB(JJ) )
+ DMI%XC1(JJ) = ZCW1MAX(JJ) * EXP( - (PEK%XWG(JJ,1)-ZA(JJ))**2 / ZB(JJ) )
!
ENDIF
!
@@ -527,18 +441,18 @@ ENDIF
! --------------
! Including vertical diffusion limiting factor for surface soil ice:
!
-IF(HKSAT=='SGH' .OR. HKSAT=='EXP')THEN
+IF(IO%CKSAT=='SGH' .OR. IO%CKSAT=='EXP')THEN
!
! Adjusted root-zone soil water content
!
- DO JJ=1,SIZE(PWG,1)
- ZWG2(JJ)=PWG(JJ,2)*(PCONDSAT(JJ,2)/PCONDSAT(JJ,1))**(1./(2.*PBCOEF(JJ)+3))
+ DO JJ=1,SIZE(PEK%XWG,1)
+ ZWG2(JJ)=PEK%XWG(JJ,2)*(PK%XCONDSAT(JJ,2)/PK%XCONDSAT(JJ,1))**(1./(2.*KK%XBCOEF(JJ,1)+3))
ENDDO
ZWG2(:)=MAX(ZWG2(:),XWGMIN)
!
ELSE
!
- ZWG2(:)=PWG(:,2)
+ ZWG2(:)=PEK%XWG(:,2)
!
ENDIF
!
@@ -546,8 +460,8 @@ DO JJ=1,SIZE(ZWSAT)
!
!Including vertical diffusion limiting factor for surface soil ice:
!
- PC2(JJ) = (PC2REF(JJ)*ZWG2(JJ) / ( ZWSAT(JJ)-ZWG2(JJ) + 0.01 )) &
- *(1.0-(PWGI(JJ,1)/(PWSAT(JJ)-XWGMIN)))
+ DMI%XC2(JJ) = (PK%XC2REF(JJ)*ZWG2(JJ) / ( ZWSAT(JJ)-ZWG2(JJ) + 0.01 )) &
+ *(1.0-(PEK%XWGI(JJ,1)/(KK%XWSAT(JJ,1)-XWGMIN)))
!
!-------------------------------------------------------------------------------
!
@@ -556,9 +470,8 @@ DO JJ=1,SIZE(ZWSAT)
!
ZX(JJ) = ZWG2(JJ)/ZWSAT(JJ)
!
- PWGEQ(JJ) = ZWG2(JJ) - ZWSAT(JJ)*PACOEF(JJ) &
- * ZX(JJ)** PPCOEF(JJ) &
- *( 1.-EXP(PPCOEF(JJ)*8.*LOG(ZX(JJ))))
+ DMI%XWGEQ(JJ) = ZWG2(JJ) - ZWSAT(JJ)*KK%XACOEF(JJ) * ZX(JJ)**KK%XPCOEF(JJ) &
+ *( 1.-EXP(KK%XPCOEF(JJ)*8.*LOG(ZX(JJ))))
!
ENDDO
!-------------------------------------------------------------------------------
@@ -567,7 +480,7 @@ ENDDO
! -----------------------------
!
IF (LPHYSDOMC) THEN
- PCT(:) = 9.427757E-6 ! corresponds to a density of 350kg/m3 for snow
+ DMI%XCT(:) = 9.427757E-6 ! corresponds to a density of 350kg/m3 for snow
ENDIF
IF (LHOOK) CALL DR_HOOK('SOIL',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/soil_albedo.F90 b/src/SURFEX/soil_albedo.F90
index d32e4482502d54b401ff164559d6d1c099078920..ca490a3956e931e1b48442245d3075fc9a4b37df 100644
--- a/src/SURFEX/soil_albedo.F90
+++ b/src/SURFEX/soil_albedo.F90
@@ -2,223 +2,8 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
-! ###########
-MODULE MODI_SOIL_ALBEDO
-! ###########
-!
-INTERFACE SOIL_ALBEDO
-!
-!
- SUBROUTINE SOIL_ALBEDO_1D(HALBEDO, &
- PWSAT,PWG1, &
- PALBVIS_DRY,PALBNIR_DRY,PALBUV_DRY, &
- PALBVIS_WET,PALBNIR_WET,PALBUV_WET, &
- PALBVIS_SOIL, PALBNIR_SOIL,PALBUV_SOIL )
-!
-!
-!* 0.1 declarations of arguments
-! -------------------------
-!
- CHARACTER(LEN=*), INTENT(IN) :: HALBEDO
-! SOIL_ALBEDO dependance wxith surface soil water content
-! "EVOL" = SOIL_ALBEDO evolves with soil wetness
-! "DRY " = constant SOIL_ALBEDO value for dry soil
-! "WET " = constant SOIL_ALBEDO value for wet soil
-! "MEAN" = constant SOIL_ALBEDO value for medium soil wetness
-!
-REAL, DIMENSION(:), INTENT(IN) :: PWSAT ! saturation water content
-REAL, DIMENSION(:), INTENT(IN) :: PWG1 ! surface water content
-REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_DRY ! visible, near infra-red and UV
-REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_DRY ! dry soil albedo
-REAL, DIMENSION(:), INTENT(IN) :: PALBUV_DRY !
-REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_WET ! visible, near infra-red and UV
-REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_WET ! wet soil albedo
-REAL, DIMENSION(:), INTENT(IN) :: PALBUV_WET ! wet soil albedo
-!
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PALBVIS_SOIL! visible, near infra-red and UV
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PALBNIR_SOIL! soil albedo
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PALBUV_SOIL !
-!
-END SUBROUTINE SOIL_ALBEDO_1D
-!
- SUBROUTINE SOIL_ALBEDO_1D_PATCH(HALBEDO, &
- PWSAT,PWG1, &
- PALBVIS_DRY,PALBNIR_DRY,PALBUV_DRY, &
- PALBVIS_WET,PALBNIR_WET,PALBUV_WET, &
- PALBVIS_SOIL, PALBNIR_SOIL,PALBUV_SOIL )
-!
-!
-!* 0.1 declarations of arguments
-! -------------------------
-!
-!
- CHARACTER(LEN=*), INTENT(IN) :: HALBEDO
-! SOIL_ALBEDO dependance wxith surface soil water content
-! "EVOL" = SOIL_ALBEDO evolves with soil wetness
-! "DRY " = constant SOIL_ALBEDO value for dry soil
-! "WET " = constant SOIL_ALBEDO value for wet soil
-! "MEAN" = constant SOIL_ALBEDO value for medium soil wetness
-!
-REAL, DIMENSION(:), INTENT(IN) :: PWSAT ! saturation water content
-REAL, DIMENSION(:,:), INTENT(IN) :: PWG1 ! surface water content
-REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_DRY ! visible, near infra-red and UV
-REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_DRY ! dry soil albedo
-REAL, DIMENSION(:), INTENT(IN) :: PALBUV_DRY !
-REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_WET ! visible, near infra-red and UV
-REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_WET ! wet soil albedo
-REAL, DIMENSION(:), INTENT(IN) :: PALBUV_WET !
-!
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PALBVIS_SOIL! visible, near infra-red and UV
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PALBNIR_SOIL! soil albedo
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PALBUV_SOIL !
-!
-END SUBROUTINE SOIL_ALBEDO_1D_PATCH
-!
-END INTERFACE
-!
-END MODULE MODI_SOIL_ALBEDO
-!
! ####################################################################
- SUBROUTINE SOIL_ALBEDO_1D(HALBEDO, &
- PWSAT,PWG1, &
- PALBVIS_DRY,PALBNIR_DRY,PALBUV_DRY, &
- PALBVIS_WET,PALBNIR_WET,PALBUV_WET, &
- PALBVIS_SOIL, PALBNIR_SOIL,PALBUV_SOIL )
-! ####################################################################
-!
-!!**** *SOIL_ALBEDO*
-!!
-!! PURPOSE
-!! -------
-! computes the SOIL ALBEDO of the natural continental parts.
-!
-! Soil SOIL_ALBEDO is estimated from sand fraction.
-! A correction due to the soil humidity can be used.
-!
-!
-!!** METHOD
-!! ------
-!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 17/12/99
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-! -------------------------
-!
- CHARACTER(LEN=*), INTENT(IN) :: HALBEDO
-! SOIL_ALBEDO dependance wxith surface soil water content
-! "EVOL" = SOIL_ALBEDO evolves with soil wetness
-! "DRY " = constant SOIL_ALBEDO value for dry soil
-! "WET " = constant SOIL_ALBEDO value for wet soil
-! "MEAN" = constant SOIL_ALBEDO value for medium soil wetness
-!
-REAL, DIMENSION(:), INTENT(IN) :: PWSAT ! saturation water content
-REAL, DIMENSION(:), INTENT(IN) :: PWG1 ! surface water content
-REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_DRY ! visible, near infra-red and UV
-REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_DRY ! dry soil albedo
-REAL, DIMENSION(:), INTENT(IN) :: PALBUV_DRY !
-REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_WET ! visible, near infra-red and UV
-REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_WET ! wet soil albedo
-REAL, DIMENSION(:), INTENT(IN) :: PALBUV_WET !
-!
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PALBVIS_SOIL! visible, near infra-red and UV
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PALBNIR_SOIL! soil albedo
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PALBUV_SOIL !
-!
-!* 0.2 declarations of local variables
-! -------------------------------
-!
-REAL, DIMENSION(SIZE(PWSAT)) :: ZX
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('MODI_SOIL_ALBEDO:SOIL_ALBEDO_1D',0,ZHOOK_HANDLE)
-IF (HALBEDO=='USER' .AND. LHOOK) CALL DR_HOOK('MODI_SOIL_ALBEDO:SOIL_ALBEDO_1D',1,ZHOOK_HANDLE)
-IF (HALBEDO=='USER') RETURN
-!
-SELECT CASE ( HALBEDO )
- CASE ('EVOL')
-!
- ZX = MIN( PWG1(:)/PWSAT(:) , 1. )
-!
-!* linear formula
-! ZALBVIS_SOIL(:) = PALBVIS_DRY(:) + ZX(:)*(PALBVIS_WET(:)-PALBVIS_DRY(:))
-! ZALBNIR_SOIL(:) = PALBNIR_DRY(:) + ZX(:)*(PALBNIR_WET(:)-PALBNIR_DRY(:))
-! ZALBUV_SOIL (:) = PALBUV_DRY (:) + ZX(:)*(PALBUV_WET (:)-PALBUV_DRY (:))
-!* quadratic formula
- IF (PRESENT(PALBVIS_SOIL)) &
- PALBVIS_SOIL(:) = PALBVIS_WET(:) &
- + (0.25*PALBVIS_DRY(:)-PALBVIS_WET(:)) &
- * (1. - ZX(:)) &
- * ( ZX(:) + ( PALBVIS_DRY(:)-PALBVIS_WET(:)) &
- /(0.25*PALBVIS_DRY(:)-PALBVIS_WET(:)) )
- IF (PRESENT(PALBNIR_SOIL)) &
- PALBNIR_SOIL(:) = PALBNIR_WET(:) &
- + (0.25*PALBNIR_DRY(:)-PALBNIR_WET(:)) &
- * (1. - ZX(:)) &
- * ( ZX(:) + ( PALBNIR_DRY(:)-PALBNIR_WET(:)) &
- /(0.25*PALBNIR_DRY(:)-PALBNIR_WET(:)) )
- IF (PRESENT(PALBUV_SOIL)) &
- PALBUV_SOIL (:) = PALBUV_WET(:) &
- + (0.25*PALBUV_DRY (:)-PALBUV_WET (:)) &
- * (1. - ZX(:)) &
- * ( ZX(:) + ( PALBUV_DRY (:)-PALBUV_WET (:)) &
- /(0.25*PALBUV_DRY (:)-PALBUV_WET (:)) )
-!
- CASE ('DRY ')
- IF (PRESENT(PALBVIS_SOIL)) PALBVIS_SOIL(:) = PALBVIS_DRY(:)
- IF (PRESENT(PALBNIR_SOIL)) PALBNIR_SOIL(:) = PALBNIR_DRY(:)
- IF (PRESENT(PALBUV_SOIL)) PALBUV_SOIL (:) = PALBUV_DRY (:)
- CASE ('WET ')
- IF (PRESENT(PALBVIS_SOIL)) PALBVIS_SOIL(:) = PALBVIS_WET(:)
- IF (PRESENT(PALBNIR_SOIL)) PALBNIR_SOIL(:) = PALBNIR_WET(:)
- IF (PRESENT(PALBUV_SOIL)) PALBUV_SOIL (:) = PALBUV_WET (:)
- CASE ('MEAN')
- IF (PRESENT(PALBVIS_SOIL)) PALBVIS_SOIL(:) = 0.5 * ( PALBVIS_DRY(:) + PALBVIS_WET(:) )
- IF (PRESENT(PALBNIR_SOIL)) PALBNIR_SOIL(:) = 0.5 * ( PALBNIR_DRY(:) + PALBNIR_WET(:) )
- IF (PRESENT(PALBUV_SOIL)) PALBUV_SOIL (:) = 0.5 * ( PALBUV_DRY (:) + PALBUV_WET (:) )
-END SELECT
-IF (LHOOK) CALL DR_HOOK('MODI_SOIL_ALBEDO:SOIL_ALBEDO_1D',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE SOIL_ALBEDO_1D
-!
-!-------------------------------------------------------------------------------
-!
-! ####################################################################
- SUBROUTINE SOIL_ALBEDO_1D_PATCH(HALBEDO, &
- PWSAT,PWG1, &
- PALBVIS_DRY,PALBNIR_DRY,PALBUV_DRY, &
- PALBVIS_WET,PALBNIR_WET,PALBUV_WET, &
- PALBVIS_SOIL, PALBNIR_SOIL,PALBUV_SOIL )
+ SUBROUTINE SOIL_ALBEDO(HALBEDO, PWSAT, PWG1, KK, PEK, HBAND)
! ####################################################################
!
!!**** *SOIL_ALBEDO*
@@ -258,6 +43,8 @@ END SUBROUTINE SOIL_ALBEDO_1D
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_PE_t
+!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -276,93 +63,79 @@ IMPLICIT NONE
! "MEAN" = constant SOIL_ALBEDO value for medium soil wetness
!
REAL, DIMENSION(:), INTENT(IN) :: PWSAT ! saturation water content
-REAL, DIMENSION(:,:), INTENT(IN) :: PWG1 ! surface water content
-REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_DRY ! visible, near infra-red and UV
-REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_DRY ! dry soil albedo
-REAL, DIMENSION(:), INTENT(IN) :: PALBUV_DRY !
-REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_WET ! visible, near infra-red and UV
-REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_WET ! wet soil SOIL_ALBEDO
-REAL, DIMENSION(:), INTENT(IN) :: PALBUV_WET !
+REAL, DIMENSION(:), INTENT(IN) :: PWG1 ! surface water content
+!
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
!
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PALBVIS_SOIL! visible, near infra-red and UV
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PALBNIR_SOIL! soil albedo
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PALBUV_SOIL !
+ CHARACTER(LEN=*), INTENT(IN) :: HBAND
!
!* 0.2 declarations of local variables
! -------------------------------
!
REAL, DIMENSION(SIZE(PWSAT)) :: ZX
!
-INTEGER :: IPATCH ! number of patches
-INTEGER :: JPATCH !loop index for patches
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
-IF (LHOOK) CALL DR_HOOK('MODI_SOIL_ALBEDO:SOIL_ALBEDO_1D_PATCH',0,ZHOOK_HANDLE)
-IF (HALBEDO=='USER' .AND. LHOOK) CALL DR_HOOK('MODI_SOIL_ALBEDO:SOIL_ALBEDO_1D_PATCH',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('SOIL_ALBEDO',0,ZHOOK_HANDLE)
+IF (HALBEDO=='USER' .AND. LHOOK) CALL DR_HOOK('SOIL_ALBEDO',1,ZHOOK_HANDLE)
IF (HALBEDO=='USER') RETURN
!
-IPATCH = SIZE(PWG1,2)
-
-IF (PRESENT(PALBVIS_SOIL)) PALBVIS_SOIL = XUNDEF
-IF (PRESENT(PALBNIR_SOIL)) PALBNIR_SOIL = XUNDEF
-IF (PRESENT(PALBUV_SOIL)) PALBUV_SOIL = XUNDEF
+IF (TRIM(HBAND)=="VIS".OR.TRIM(HBAND)=="ALL") PEK%XALBVIS_SOIL = XUNDEF
+IF (TRIM(HBAND)=="NIR".OR.TRIM(HBAND)=="ALL") PEK%XALBNIR_SOIL = XUNDEF
+IF (TRIM(HBAND)=="UV" .OR.TRIM(HBAND)=="ALL") PEK%XALBUV_SOIL = XUNDEF
!
SELECT CASE ( HALBEDO )
- CASE ('EVOL')
+CASE ('EVOL')
- DO JPATCH=1,IPATCH
- ZX = MIN( PWG1(:,JPATCH)/PWSAT(:) , 1. )
+ ZX = MIN( PWG1(:)/PWSAT(:) , 1. )
- !WHERE (PWG1(:,JPATCH)/=XUNDEF)
- !* linear formula
- ! ZALBVIS_SOIL(:) = PALBVIS_DRY(:) + ZX(:)*(PALBVIS_WET(:)-PALBVIS_DRY(:))
- ! ZALBNIR_SOIL(:) = PALBNIR_DRY(:) + ZX(:)*(PALBNIR_WET(:)-PALBNIR_DRY(:))
- ! ZALBUV_SOIL (:) = PALBUV_DRY (:) + ZX(:)*(PALBUV_WET (:)-PALBUV_DRY (:))
- !* quadratic formula
- IF (PRESENT(PALBVIS_SOIL)) &
- WHERE (PWG1(:,JPATCH)/=XUNDEF) &
- PALBVIS_SOIL(:,JPATCH) = PALBVIS_WET(:) &
- + (0.25*PALBVIS_DRY(:)-PALBVIS_WET(:)) &
- * (1. - ZX(:)) &
- * ( ZX(:) + ( PALBVIS_DRY(:)-PALBVIS_WET(:)) &
- /(0.25*PALBVIS_DRY(:)-PALBVIS_WET(:)) )
- IF (PRESENT(PALBNIR_SOIL)) &
- WHERE (PWG1(:,JPATCH)/=XUNDEF) &
- PALBNIR_SOIL(:,JPATCH) = PALBNIR_WET(:) &
- + (0.25*PALBNIR_DRY(:)-PALBNIR_WET(:)) &
- * (1. - ZX(:)) &
- * ( ZX(:) + ( PALBNIR_DRY(:)-PALBNIR_WET(:)) &
- /(0.25*PALBNIR_DRY(:)-PALBNIR_WET(:)) )
- IF (PRESENT(PALBUV_SOIL)) &
- WHERE (PWG1(:,JPATCH)/=XUNDEF) &
- PALBUV_SOIL (:,JPATCH) = PALBUV_WET (:) &
- + (0.25*PALBUV_DRY (:)-PALBUV_WET (:)) &
- * (1. - ZX(:)) &
- * ( ZX(:) + ( PALBUV_DRY (:)-PALBUV_WET (:)) &
- /(0.25*PALBUV_DRY (:)-PALBUV_WET (:)) )
+ IF (TRIM(HBAND)=="VIS".OR.TRIM(HBAND)=="ALL") &
+ WHERE (PWG1(:)/=XUNDEF) &
+ PEK%XALBVIS_SOIL(:) = KK%XALBVIS_WET(:) + &
+ (0.25*KK%XALBVIS_DRY(:)-KK%XALBVIS_WET(:)) * (1. - ZX(:)) * &
+ ( ZX(:) + (KK%XALBVIS_DRY(:)-KK%XALBVIS_WET(:)) / (0.25*KK%XALBVIS_DRY(:)-KK%XALBVIS_WET(:)) )
+ IF (TRIM(HBAND)=="NIR".OR.TRIM(HBAND)=="ALL") &
+ WHERE (PWG1(:)/=XUNDEF) &
+ PEK%XALBNIR_SOIL(:) = KK%XALBNIR_WET(:) + &
+ (0.25*KK%XALBNIR_DRY(:)-KK%XALBNIR_WET(:)) * (1. - ZX(:)) * &
+ ( ZX(:) + (KK%XALBNIR_DRY(:)-KK%XALBNIR_WET(:)) / (0.25*KK%XALBNIR_DRY(:)-KK%XALBNIR_WET(:)) )
+ IF (TRIM(HBAND)=="UV".OR.TRIM(HBAND)=="ALL") &
+ WHERE (PWG1(:)/=XUNDEF) &
+ PEK%XALBUV_SOIL (:) = KK%XALBUV_WET (:) + &
+ (0.25*KK%XALBUV_DRY (:)-KK%XALBUV_WET (:)) * (1. - ZX(:)) * &
+ ( ZX(:) + (KK%XALBUV_DRY (:)-KK%XALBUV_WET (:)) / (0.25*KK%XALBUV_DRY (:)-KK%XALBUV_WET (:)) )
!END WHERE
- END DO
- CASE ('DRY ')
- IF (PRESENT(PALBVIS_SOIL)) PALBVIS_SOIL(:,:) = SPREAD(PALBVIS_DRY(:),2,IPATCH)
- IF (PRESENT(PALBNIR_SOIL)) PALBNIR_SOIL(:,:) = SPREAD(PALBNIR_DRY(:),2,IPATCH)
- IF (PRESENT(PALBUV_SOIL)) PALBUV_SOIL (:,:) = SPREAD(PALBUV_DRY (:),2,IPATCH)
+CASE ('DRY ')
+ IF (TRIM(HBAND)=="VIS".OR.TRIM(HBAND)=="ALL") &
+ WHERE (PWG1(:)/=XUNDEF) PEK%XALBVIS_SOIL(:) = KK%XALBVIS_DRY(:)
+ IF (TRIM(HBAND)=="NIR".OR.TRIM(HBAND)=="ALL") &
+ WHERE (PWG1(:)/=XUNDEF) PEK%XALBNIR_SOIL(:) = KK%XALBNIR_DRY(:)
+ IF (TRIM(HBAND)=="UV".OR.TRIM(HBAND)=="ALL") &
+ WHERE (PWG1(:)/=XUNDEF) PEK%XALBUV_SOIL (:) = KK%XALBUV_DRY (:)
- CASE ('WET ')
- IF (PRESENT(PALBVIS_SOIL)) PALBVIS_SOIL(:,:) = SPREAD(PALBVIS_WET(:),2,IPATCH)
- IF (PRESENT(PALBNIR_SOIL)) PALBNIR_SOIL(:,:) = SPREAD(PALBNIR_WET(:),2,IPATCH)
- IF (PRESENT(PALBUV_SOIL)) PALBUV_SOIL (:,:) = SPREAD(PALBUV_WET (:),2,IPATCH)
+CASE ('WET ')
+ IF (TRIM(HBAND)=="VIS".OR.TRIM(HBAND)=="ALL") &
+ WHERE (PWG1(:)/=XUNDEF) PEK%XALBVIS_SOIL(:) = KK%XALBVIS_WET(:)
+ IF (TRIM(HBAND)=="NIR".OR.TRIM(HBAND)=="ALL") &
+ WHERE (PWG1(:)/=XUNDEF) PEK%XALBNIR_SOIL(:) = KK%XALBNIR_WET(:)
+ IF (TRIM(HBAND)=="UV".OR.TRIM(HBAND)=="ALL") &
+ WHERE (PWG1(:)/=XUNDEF) PEK%XALBUV_SOIL (:) = KK%XALBUV_WET (:)
- CASE ('MEAN')
- IF (PRESENT(PALBVIS_SOIL)) PALBVIS_SOIL(:,:) = 0.5 * ( SPREAD(PALBVIS_DRY(:),2,IPATCH) + SPREAD(PALBVIS_WET(:),2,IPATCH) )
- IF (PRESENT(PALBNIR_SOIL)) PALBNIR_SOIL(:,:) = 0.5 * ( SPREAD(PALBNIR_DRY(:),2,IPATCH) + SPREAD(PALBNIR_WET(:),2,IPATCH) )
- IF (PRESENT(PALBUV_SOIL)) PALBUV_SOIL (:,:) = 0.5 * ( SPREAD(PALBUV_DRY (:),2,IPATCH) + SPREAD(PALBUV_WET (:),2,IPATCH) )
+CASE ('MEAN')
+ IF (TRIM(HBAND)=="VIS".OR.TRIM(HBAND)=="ALL") &
+ WHERE (PWG1(:)/=XUNDEF) PEK%XALBVIS_SOIL(:) = 0.5 * ( KK%XALBVIS_DRY(:) + KK%XALBVIS_WET(:) )
+ IF (TRIM(HBAND)=="NIR".OR.TRIM(HBAND)=="ALL") &
+ WHERE (PWG1(:)/=XUNDEF) PEK%XALBNIR_SOIL(:) = 0.5 * ( KK%XALBNIR_DRY(:) + KK%XALBNIR_WET(:) )
+ IF (TRIM(HBAND)=="UV".OR.TRIM(HBAND)=="ALL") &
+ WHERE (PWG1(:)/=XUNDEF) PEK%XALBUV_SOIL (:) = 0.5 * ( KK%XALBUV_DRY (:) + KK%XALBUV_WET (:) )
END SELECT
-IF (LHOOK) CALL DR_HOOK('MODI_SOIL_ALBEDO:SOIL_ALBEDO_1D_PATCH',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('SOIL_ALBEDO',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
!
-END SUBROUTINE SOIL_ALBEDO_1D_PATCH
+END SUBROUTINE SOIL_ALBEDO
diff --git a/src/SURFEX/soildif.F90 b/src/SURFEX/soildif.F90
index f281db8a292d657f45f60c178d7326b51b90ce8d..217d2c1e7fbcbb0cfcd907f367d55b50bf9127c0 100644
--- a/src/SURFEX/soildif.F90
+++ b/src/SURFEX/soildif.F90
@@ -3,13 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE SOILDIF(HDIFSFCOND, OFLOOD, &
- PVEG, PCV, PFFG, PFFV, &
- PCG, PCT, PFROZEN1, &
- PD_G, PDZG, PTG, PWG, PWGI, KWG_LAYER, &
- PHCAPSOILZ, PCONDDRYZ, PCONDSLDZ, &
- PBCOEF, PWSAT, PMPOTSAT, PSOILCONDZ, PSOILHCAPZ, &
- PFWTD, PWTD, PWR )
+ SUBROUTINE SOILDIF(IO, KK, PK, PEK, DMI, PVEG, PFROZEN1, PFFG, PFFV, PSOILCONDZ, PSOILHCAPZ )
! ##########################################################################
!
!!**** *SOIL*
@@ -67,11 +61,14 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
+!
USE MODD_CSTS, ONLY : XCL, XCI, XRHOLW, XRHOLI, XPI, XDAY, XCONDI, XTT, XLMTT, XG
USE MODD_ISBA_PAR, ONLY : XCONDWTR, XWGMIN, XWTD_MAXDEPTH, &
XOMRHO, XOMSPH, XOMCONDDRY, &
XOMCONDSLD, XCVHEATF
-!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -82,51 +79,19 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
- CHARACTER(LEN=*), INTENT(IN) :: HDIFSFCOND ! NOTE: Only used when HISBA = DIF
-! ! MLCH' = include the insulating effect of leaf
-! ! litter/mulch on the surface thermal cond.
-! ! 'DEF' = no mulch effect
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMI
!
-LOGICAL, INTENT(IN) :: OFLOOD ! Flood scheme
-!
-REAL, DIMENSION(:), INTENT(IN) :: PVEG, PFWTD, PWTD, PCV, PWR
+REAL, DIMENSION(:), INTENT(IN) :: PVEG
! Soil and vegetation parameters
! PVEG = fraction of vegetation
-! PFWTD= grid-cell fraction of water table to rise
-! PWTD = water table depth (negative below soil surface)
-! PCV = the heat capacity of the vegetation
-! PWR = canopy intercepted water
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PHCAPSOILZ, PCONDDRYZ, PCONDSLDZ, PD_G, PDZG
-! PHCAPSOILZ = soil heat capacity [J/(K m3)]
-! PCONDDRYZ = soil dry thermal conductivity
-! [W/(m K)]
-! PCONDSLDZ = soil solids thermal conductivity
-! [W/(m K)]
-! PD_G = soil layer depth [m]
-! PDZG = soil layers thicknesses [m]
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PBCOEF, PWSAT, PMPOTSAT, PTG
-! PBCOEF = profile of b-parameter (-)
-! PWSAT = profile of porosity (m3/m3)
-! PMPOTSAT = profile of matric potential at saturation (m)
-!
-REAL, DIMENSION(:,:),INTENT(INOUT):: PWG, PWGI
-! PWG = soil liquid water content (m3/m3)
-! PWGI = soil frozen water content (m3/m3)
-!
-INTEGER, DIMENSION(:), INTENT(IN) :: KWG_LAYER
-! KWG_LAYER = Number of soil moisture layers (DIF option)
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PFROZEN1, PCG, PCT
-! PFROZEN1 = fraction of ice in superficial soil
-! PCT = averaged surface heat capacity of the grid (m2 K J-1)
-! PCG = averaged surface soil heat capacity (m2 K J-1)
-!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSOILCONDZ, PSOILHCAPZ
-! PSOILHCAP = soil heat capacity (J m-3 K-1)
-! PSOILCOND = soil thermal conductivity (W m-1 K-1)
+
!
+REAL, DIMENSION(:), INTENT(OUT) :: PFROZEN1
+! PFROZEN1 = fraction of ice in superficial soil
!
REAL, DIMENSION(:), INTENT(IN) :: PFFV, PFFG
! PFFG = Floodplain fraction over the ground
@@ -134,9 +99,13 @@ REAL, DIMENSION(:), INTENT(IN) :: PFFV, PFFG
! PFFV = Floodplain fraction over vegetation
! without snow (ES)
!
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSOILCONDZ, PSOILHCAPZ
+! PSOILHCAP = soil heat capacity (J m-3 K-1)
+! PSOILCOND = soil thermal conductivity (W m-1 K-1)
+!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(SIZE(PTG,1),SIZE(PTG,2)) :: ZMATPOT, ZCONDDRYZ, ZCONDSLDZ, ZVEGMULCH
+REAL, DIMENSION(SIZE(PEK%XTG,1),SIZE(PEK%XTG,2)) :: ZMATPOT, ZCONDDRYZ, ZCONDSLDZ, ZVEGMULCH
! ZMATPOT = soil matric potential (m)
!
REAL :: ZFROZEN2DF, ZUNFROZEN2DF, ZCONDSATDF, ZLOG_CONDI, ZLOG_CONDWTR, &
@@ -161,8 +130,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('SOILDIF',0,ZHOOK_HANDLE)
!
-INI=SIZE(PWG,1)
-INL=SIZE(PWG,2)
+INI=SIZE(PEK%XWG,1)
+INL=SIZE(PEK%XWG,2)
!
ZFF (:) = 0.0
ZCF (:) = XUNDEF
@@ -172,11 +141,11 @@ ZCF (:) = XUNDEF
!* 1. WATER TABLE DETH ADJUSTMENT FOR ISBA (m)
! -----------------------------------------
!
-WHERE(PWTD(:)==XUNDEF)
+WHERE(KK%XWTD(:)==XUNDEF)
! no water table / surface coupling over some regions
ZWTD (:) = XWTD_MAXDEPTH
ELSEWHERE
- ZWTD (:) = PFWTD(:)/MAX(-PWTD(:),0.001) + (1.0-PFWTD(:))/MAX(-PWTD(:),XWTD_MAXDEPTH)
+ ZWTD (:) = KK%XFWTD(:)/MAX(-KK%XWTD(:),0.001) + (1.0-KK%XFWTD(:))/MAX(-KK%XWTD(:),XWTD_MAXDEPTH)
ZWTD (:) = 1.0/ZWTD(:)
ENDWHERE
!
@@ -188,37 +157,37 @@ ENDWHERE
DO JL=1,INL
DO JJ=1,INI
!
- IDEPTH=KWG_LAYER(JJ)
+ IDEPTH=PK%NWG_LAYER(JJ)
IF(JL>IDEPTH)THEN
!
! total matric potential
- ZWORK1 = MIN(1.0,(PWG(JJ,IDEPTH)+PWGI(JJ,IDEPTH))/PWSAT(JJ,IDEPTH))
- ZLOG = PBCOEF(JJ,IDEPTH)*LOG(ZWORK1)
- ZMATPOT(JJ,IDEPTH) = PMPOTSAT(JJ,IDEPTH)*EXP(-ZLOG)
+ ZWORK1 = MIN(1.0,(PEK%XWG(JJ,IDEPTH)+PEK%XWGI(JJ,IDEPTH))/KK%XWSAT(JJ,IDEPTH))
+ ZLOG = KK%XBCOEF(JJ,IDEPTH)*LOG(ZWORK1)
+ ZMATPOT(JJ,IDEPTH) = KK%XMPOTSAT(JJ,IDEPTH)*EXP(-ZLOG)
! extrapolation of total matric potential
- ZWORK1 = 0.5*(PD_G(JJ,IDEPTH)+PD_G(JJ,IDEPTH-1))
- ZWORK2 = 0.5*(PD_G(JJ,JL)+PD_G(JJ,JL-1))
+ ZWORK1 = 0.5*(PK%XDG(JJ,IDEPTH) + PK%XDG(JJ,IDEPTH-1))
+ ZWORK2 = 0.5*(PK%XDG(JJ,JL ) + PK%XDG(JJ,JL-1))
ZWORK3 = MAX(0.0,(ZWTD(JJ)-ZWORK2)/(ZWORK2-ZWORK1))
- ZMATPOT(JJ,JL) = (PMPOTSAT(JJ,JL)+ZWORK3*ZMATPOT(JJ,IDEPTH))/(1.0+ZWORK3)
+ ZMATPOT(JJ,JL) = (KK%XMPOTSAT(JJ,JL)+ZWORK3*ZMATPOT(JJ,IDEPTH))/(1.0+ZWORK3)
!
! total soil water content computation
- ZWORK1 = MAX(1.0,ZMATPOT(JJ,JL)/PMPOTSAT(JJ,JL))
- ZLOG = LOG(ZWORK1)/PBCOEF(JJ,JL)
- ZWTOT = PWSAT(JJ,JL)*EXP(-ZLOG)
+ ZWORK1 = MAX(1.0,ZMATPOT(JJ,JL)/KK%XMPOTSAT(JJ,JL))
+ ZLOG = LOG(ZWORK1)/KK%XBCOEF(JJ,JL)
+ ZWTOT = KK%XWSAT(JJ,JL)*EXP(-ZLOG)
ZWTOT = MAX(XWGMIN,ZWTOT)
!
! soil liquid water content computation
- ZMATPOT(JJ,JL) = MIN(PMPOTSAT(JJ,JL),XLMTT*(PTG(JJ,JL)-XTT)/(XG*PTG(JJ,JL)))
+ ZMATPOT(JJ,JL) = MIN(KK%XMPOTSAT(JJ,JL),XLMTT*(PEK%XTG(JJ,JL)-XTT)/(XG*PEK%XTG(JJ,JL)))
!
- ZWORK1 = MAX(1.0,ZMATPOT(JJ,JL)/PMPOTSAT(JJ,JL))
- ZLOG = LOG(ZWORK1)/PBCOEF(JJ,JL)
- ZWL = PWSAT(JJ,JL)*EXP(-ZLOG)
+ ZWORK1 = MAX(1.0,ZMATPOT(JJ,JL)/KK%XMPOTSAT(JJ,JL))
+ ZLOG = LOG(ZWORK1)/KK%XBCOEF(JJ,JL)
+ ZWL = KK%XWSAT(JJ,JL)*EXP(-ZLOG)
ZWL = MAX(ZWL,XWGMIN)
- PWG (JJ,JL) = MIN(ZWL,ZWTOT )
+ PEK%XWG (JJ,JL) = MIN(ZWL,ZWTOT )
!
! soil ice computation
- PWGI(JJ,JL) = MAX(0.0,ZWTOT-PWG(JJ,JL))
+ PEK%XWGI(JJ,JL) = MAX(0.0,ZWTOT-PEK%XWG(JJ,JL))
!
ENDIF
ENDDO
@@ -232,7 +201,7 @@ ENDDO
!
! Surface soil water reservoir frozen fraction:
!
-PFROZEN1(:) = PWGI(:,1)/(PWGI(:,1) + MAX(PWG(:,1),XWGMIN))
+PFROZEN1(:) = PEK%XWGI(:,1)/(PEK%XWGI(:,1) + MAX(PEK%XWG(:,1),XWGMIN))
!
!-------------------------------------------------------------------------------
!
@@ -243,19 +212,19 @@ PFROZEN1(:) = PWGI(:,1)/(PWGI(:,1) + MAX(PWG(:,1),XWGMIN))
! uppermost soil layers thermal properties. Use organic matter thermal properties.
!
!
-ZCONDDRYZ (:,:) = PCONDDRYZ (:,:)
-ZCONDSLDZ (:,:) = PCONDSLDZ (:,:)
+ZCONDDRYZ (:,:) = KK%XCONDDRY (:,:)
+ZCONDSLDZ (:,:) = KK%XCONDSLD (:,:)
!
-IF(HDIFSFCOND == 'MLCH') THEN
+IF(IO%CDIFSFCOND == 'MLCH') THEN
!
DO JL=1,INL
DO JJ=1,INI
!
- ZVEGMULCH(JJ,JL) = PVEG(JJ)*MIN(PDZG(JJ,JL),MAX(0.0,ZTHICKM-PD_G(JJ,JL)+PDZG(JJ,JL)))/PDZG(JJ,JL)
+ ZVEGMULCH(JJ,JL) = PVEG(JJ)*MIN(PK%XDZG(JJ,JL),MAX(0.0,ZTHICKM-PK%XDG(JJ,JL)+PK%XDZG(JJ,JL)))/PK%XDZG(JJ,JL)
!
IF(ZVEGMULCH(JJ,JL)>0.0)THEN
- ZCONDDRYZ (JJ,JL) = 1.0/((1.0-ZVEGMULCH(JJ,JL))/PCONDDRYZ(JJ,JL)+ZVEGMULCH(JJ,JL)/XOMCONDDRY)
- ZCONDSLDZ (JJ,JL) = 1.0/((1.0-ZVEGMULCH(JJ,JL))/PCONDSLDZ(JJ,JL)+ZVEGMULCH(JJ,JL)/XOMCONDSLD)
+ ZCONDDRYZ (JJ,JL) = 1.0/((1.0-ZVEGMULCH(JJ,JL))/KK%XCONDDRY(JJ,JL)+ZVEGMULCH(JJ,JL)/XOMCONDDRY)
+ ZCONDSLDZ (JJ,JL) = 1.0/((1.0-ZVEGMULCH(JJ,JL))/KK%XCONDSLD(JJ,JL)+ZVEGMULCH(JJ,JL)/XOMCONDSLD)
ENDIF
!
ENDDO
@@ -276,16 +245,16 @@ ZLOG_CONDWTR = LOG(XCONDWTR)
DO JL=1,INL
DO JJ=1,INI
!
- ZFROZEN2DF = PWGI(JJ,JL)/(PWGI(JJ,JL) + MAX(PWG(JJ,JL),XWGMIN))
- ZUNFROZEN2DF = (1.0-ZFROZEN2DF)*PWSAT(JJ,JL)
+ ZFROZEN2DF = PEK%XWGI(JJ,JL)/(PEK%XWGI(JJ,JL) + MAX(PEK%XWG(JJ,JL),XWGMIN))
+ ZUNFROZEN2DF = (1.0-ZFROZEN2DF)*KK%XWSAT(JJ,JL)
!
!Old: CONDSATDF=(CONDSLDZ**(1.0-WSAT))*(CONDI**(WSAT-UNFROZEN2DF))*(CONDWTR**UNFROZEN2DF)
- ZWORK1 = LOG(ZCONDSLDZ(JJ,JL))*(1.0-PWSAT(JJ,JL))
- ZWORK2 = ZLOG_CONDI*(PWSAT(JJ,JL)-ZUNFROZEN2DF)
+ ZWORK1 = LOG(ZCONDSLDZ(JJ,JL))*(1.0-KK%XWSAT(JJ,JL))
+ ZWORK2 = ZLOG_CONDI*(KK%XWSAT(JJ,JL)-ZUNFROZEN2DF)
ZWORK3 = ZLOG_CONDWTR*ZUNFROZEN2DF
ZCONDSATDF = EXP(ZWORK1+ZWORK2+ZWORK3)
!
- ZSATDEGDF = MAX(0.1, (PWGI(JJ,JL)+PWG(JJ,JL))/PWSAT(JJ,JL))
+ ZSATDEGDF = MAX(0.1, (PEK%XWGI(JJ,JL)+PEK%XWG(JJ,JL))/KK%XWSAT(JJ,JL))
ZSATDEGDF = MIN(1.0,ZSATDEGDF)
ZKERSTENDF = LOG10(ZSATDEGDF) + 1.0
ZKERSTENDF = (1.0-ZFROZEN2DF)*ZKERSTENDF + ZFROZEN2DF *ZSATDEGDF
@@ -306,17 +275,16 @@ ENDDO
!
DO JL=1,INL
DO JJ=1,INI
- PSOILHCAPZ(JJ,JL) = (1.0-PWSAT(JJ,JL))*PHCAPSOILZ(JJ,JL) + &
- PWG (JJ,JL) *XCL*XRHOLW + &
- PWGI (JJ,JL) *XCI*XRHOLI
+ PSOILHCAPZ(JJ,JL) = (1.0-KK%XWSAT(JJ,JL))*KK%XHCAPSOIL(JJ,JL) + &
+ PEK%XWG (JJ,JL) *XCL*XRHOLW + PEK%XWGI (JJ,JL) *XCI*XRHOLI
ENDDO
ENDDO
!
! Surface soil thermal inertia [(m2 K)/J]
!
-PCG(:) = 1.0 / ( PD_G(:,1) * PSOILHCAPZ(:,1) )
+DMI%XCG(:) = 1.0 / ( PK%XDG(:,1) * PSOILHCAPZ(:,1) )
!
-PCG(:) = MIN(ZCTMAX,PCG(:))
+DMI%XCG(:) = MIN(ZCTMAX,DMI%XCG(:))
!
!-------------------------------------------------------------------------------
!
@@ -325,7 +293,7 @@ PCG(:) = MIN(ZCTMAX,PCG(:))
!
! Vegetation thermal inertia [(m2 K)/J]
!
-ZCV(:) = 1.0 / ( XCVHEATF/PCV(:) + XCL * PWR(:) )
+ZCV(:) = 1.0 / ( XCVHEATF/PEK%XCV(:) + XCL * PEK%XWR(:) )
!
ZCV(:) = MIN(ZCTMAX,ZCV(:))
!
@@ -334,7 +302,7 @@ ZCV(:) = MIN(ZCTMAX,ZCV(:))
!* 8. THE HEAT CAPACITY OF FLOOD
! --------------------------------
!
-IF(OFLOOD)THEN
+IF(IO%LFLOOD)THEN
!
ZFF(:) = PVEG(:)*PFFV(:) + (1.-PVEG(:))*PFFG(:)
!
@@ -352,9 +320,8 @@ ENDIF
! With contribution from the ground, flood and vegetation for explicit
! (ISBA-ES) snow scheme option (i.e. no snow effects included here):
!
-PCT(:) = 1. / ( (1.-PVEG(:))*(1.-PFFG(:)) / PCG(:) &
- + PVEG(:) *(1.-PFFV(:)) / ZCV(:) &
- + ZFF (:) / ZCF(:) )
+DMI%XCT(:) = 1. / ( (1.-PVEG(:))*(1.-PFFG(:)) / DMI%XCG(:) &
+ + PVEG(:) *(1.-PFFV(:)) / ZCV(:) + ZFF (:) / ZCF(:) )
!
!-------------------------------------------------------------------------------
!
@@ -365,10 +332,10 @@ PCT(:) = 1. / ( (1.-PVEG(:))*(1.-PFFG(:)) / PCG(:) &
!
DO JL=1,INL
DO JJ=1,INI
- IDEPTH=KWG_LAYER(JJ)
+ IDEPTH=PK%NWG_LAYER(JJ)
IF(JL>IDEPTH)THEN
- PWG (JJ,JL) = XUNDEF
- PWGI(JJ,JL) = XUNDEF
+ PEK%XWG (JJ,JL) = XUNDEF
+ PEK%XWGI(JJ,JL) = XUNDEF
ENDIF
ENDDO
ENDDO
diff --git a/src/SURFEX/soilemisnon.F90 b/src/SURFEX/soilemisnon.F90
index 2adf60a1b2df5532697af83ef1ac9ad7f335a93f..741904be656f6f637b15382999214488af881606 100644
--- a/src/SURFEX/soilemisnon.F90
+++ b/src/SURFEX/soilemisnon.F90
@@ -4,8 +4,7 @@
!SFX_LIC for details. version 1.
! #####################################################
! SUBROUTINE SOILEMISNO_n(PSW_FORBIO, PUA, PVA, KSV, HSV, PFLUX)
- SUBROUTINE SOILEMISNO_n (GB, I, &
- PUA, PVA)
+ SUBROUTINE SOILEMISNO_n (GB, S, K, NP, NPE, PUA, PVA)
! #####################################################
!!
!!****** *SOILEMISNO*
@@ -54,13 +53,14 @@
! 0. DECLARATIONS
! ------------
!
-!
USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_NP_t, ISBA_NPE_t
!
USE MODD_EMIS_NOX
USE MODD_CSTS, ONLY : XAVOGADRO
!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -72,14 +72,13 @@ IMPLICIT NONE
!REAL, DIMENSION(:,:), INTENT(IN) :: PSW_FORBIO
!
TYPE(GR_BIOG_t), INTENT(INOUT) :: GB
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
!
REAL, DIMENSION(:), INTENT(IN) :: PUA ! wind module
REAL, DIMENSION(:), INTENT(IN) :: PVA
-!INTEGER, INTENT(IN) :: KSV ! number of scalars
-!CHARACTER(LEN=6), DIMENSION(KSV), INTENT(IN) :: HSV ! chemical species name
-!REAL, DIMENSION(:,:), INTENT(INOUT) :: PFLUX ! NO flux from soil
-! control switch for the first call
INTEGER :: JI ! index
INTEGER :: JSV
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -107,7 +106,7 @@ REAL, DIMENSION(SIZE(PUA,1),3) :: ZS ! normalized sum
!
CHARACTER(LEN=2) :: TEST_CRF ! 'OK' if VEG<60% (i.e. soils with sparse vegetation)
!
-INTEGER :: J
+INTEGER :: J, IMASK
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!=============================================================================
IF (LHOOK) CALL DR_HOOK('SOILEMISNO_n',0,ZHOOK_HANDLE)
@@ -116,12 +115,24 @@ IF (.NOT.ASSOCIATED(GB%XNOFLUX)) ALLOCATE(GB%XNOFLUX(SIZE(PUA,1)))
!
! Calculation of WFPS
! coefficients obtenus a partir des donnees Grignon+Hombori+Escompte(0.536 0.4 0.43)
-ZWFPS_S(:) = (I%XWG(:,1,1) / 0.45) * 100.
-! Change unity of temperatures from Kelvin to Celsius
-ZTG_D(:) = I%XTG(:,2,1) - 273.15
-ZTG_S(:) = I%XTG(:,1,1) - 273.15
+ZWFPS_S(:) = XUNDEF
+ZTG_D (:) = XUNDEF
+ZSAND (:) = XUNDEF
+!
+DO JI = 1,NP%AL(1)%NSIZE_P
+ !
+ IMASK = NP%AL(1)%NR_P(JI)
+ !
+ ZWFPS_S(IMASK) = (NPE%AL(1)%XWG(JI,1) / 0.45) * 100.
+ ! Change unity of temperatures from Kelvin to Celsius
+ ZTG_D (IMASK) = NPE%AL(1)%XTG(JI,2) - 273.15
+ ZTG_S (IMASK) = NPE%AL(1)%XTG(JI,1) - 273.15
+ !
+ENDDO
+!
! Change sand fraction into sand percentage
-ZSAND(:) = I%XSAND(:,1) * 100.
+ZSAND(:) = K%XSAND(:,1) * 100.
+!
! Calculate wind module
ZWIND(:) = SQRT( PUA(:)**2 + PVA(:)**2 )
!
@@ -129,13 +140,13 @@ ZWIND(:) = SQRT( PUA(:)**2 + PVA(:)**2 )
!------------------------------------
! 1- Normalized centered entries
!
-ZN_ZTG_S(:) = XCOEF_TG_S(1) + XCOEF_TG_S(2) * ZTG_S(:)
+ZN_ZTG_S (:) = XCOEF_TG_S (1) + XCOEF_TG_S (2) * ZTG_S (:)
ZN_ZWFPS_S(:) = XCOEF_WFPS_S(1) + XCOEF_WFPS_S(2) * ZWFPS_S(:)
-ZN_ZTG_D(:) = XCOEF_TG_D(1) + XCOEF_TG_D(2) * ZTG_D(:)
-ZN_FERT(:) = XCOEF_FERT(1) + XCOEF_FERT(2) * I%XFERT(:)
-ZN_ZSAND(:) = XCOEF_SAND(1) + XCOEF_SAND(2) * ZSAND(:)
-ZN_PH(:) = XCOEF_PH(1) + XCOEF_PH(2) * I%XPH(:)
-ZN_WIND(:) = XCOEF_WIND(1) + XCOEF_WIND(2) * ZWIND(:)
+ZN_ZTG_D (:) = XCOEF_TG_D (1) + XCOEF_TG_D (2) * ZTG_D (:)
+ZN_FERT (:) = XCOEF_FERT (1) + XCOEF_FERT (2) * S%XFERT(:)
+ZN_ZSAND (:) = XCOEF_SAND (1) + XCOEF_SAND (2) * ZSAND (:)
+ZN_PH (:) = XCOEF_PH (1) + XCOEF_PH (2) * S%XPH (:)
+ZN_WIND (:) = XCOEF_WIND (1) + XCOEF_WIND (2) * ZWIND (:)
!
! 2- weighted sums
!
@@ -153,7 +164,7 @@ ZN_Y(:) = XWGT_TOT(1) + XWGT_TOT(2)*TANH(ZS(:,1)) + XWGT_TOT(3)*TANH(ZS(:,2)) +
! 4- Flux calculation
! If pH> 6, pulse effect, amplitude coefficient is maximum.
! If pH < 6, amplitude coefficient is reduced to avoid strong emissions
-WHERE (I%XPH(:) .GE. 6.0)
+WHERE (S%XPH(:) .GE. 6.0)
GB%XNOFLUX(:) = XCOEF_NO0 + XCOEF_NO1_s*ZN_Y(:)
ELSEWHERE
GB%XNOFLUX(:) = XCOEF_NO0 + XCOEF_NO1_l*ZN_Y(:)
@@ -175,13 +186,15 @@ GB%XNOFLUX(:) = GB%XNOFLUX(:)*XAVOGADRO/(1.0E4*8.64E4*14)
! 7- Reduction du flux dans la canopee
! WHERE (XLAI(:,1)/=XUNDEF)
! ZCRF(:) = -0.0917*XLAI(:,1) + 0.9429
-WHERE (I%XLAI(:,1) > 1.9 .AND. I%XLAI(:,1) < 5.)
- ZCRF(:) = 0.5
-ELSEWHERE (I%XLAI(:,1) > 5.)
- ZCRF(:) = 0.2
-ELSEWHERE
- ZCRF(:) = 1.
-ENDWHERE
+ZCRF(:) = 1.
+DO JI = 1,NP%AL(1)%NSIZE_P
+ IMASK = NP%AL(1)%NR_P(JI)
+ IF (NPE%AL(1)%XLAI(JI) > 1.9 .AND. NPE%AL(1)%XLAI(JI) < 5.) THEN
+ ZCRF(IMASK) = 0.5
+ ELSEIF (NPE%AL(1)%XLAI(JI) > 5.) THEN
+ ZCRF(IMASK) = 0.2
+ ENDIF
+ENDDO
! PRINT*,'LAI, CRF', XLAI(:), ZCRF(:)
GB%XNOFLUX(:) = GB%XNOFLUX(:)*ZCRF(:)
! PRINT*,'flux de NO en molec/m2/s apres CRF = ',XNOFLUX(:)
diff --git a/src/SURFEX/soilgrid.F90 b/src/SURFEX/soilgrid.F90
index a0aeabcce8397b52a2d9f1e94f1d755248b487b3..ccc2c3f61332c1bb0036c46c7b0abf247a51fa74 100644
--- a/src/SURFEX/soilgrid.F90
+++ b/src/SURFEX/soilgrid.F90
@@ -69,18 +69,18 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
REAL, DIMENSION(:), INTENT(IN) :: PSOILGRID ! reference soil grid (m)
-REAL, DIMENSION(:,:), INTENT(IN) :: PSOILDEPTH ! total soil depth (m)
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDG ! depth of base of soil layers (m)
-INTEGER, DIMENSION(:,:), INTENT(OUT) :: KWG_LAYER ! last layers for soil moisture
+REAL, DIMENSION(:), INTENT(IN) :: PSOILDEPTH ! total soil depth (m)
+REAL, DIMENSION(:,:), INTENT(OUT) :: PDG ! depth of base of soil layers (m)
+INTEGER, DIMENSION(:), INTENT(OUT) :: KWG_LAYER ! last layers for soil moisture
!
!* 0.2 declarations of local variables
!
-REAL,DIMENSION(SIZE(PDG,1),SIZE(PDG,3)) :: ZREF
+REAL,DIMENSION(SIZE(PDG,1)) :: ZREF
!
REAL :: ZWORK
!
-INTEGER :: INI,INL,IPATCH
-INTEGER :: JJ,JL,JPATCH
+INTEGER :: INI,INL
+INTEGER :: JJ,JL
!
LOGICAL :: LOPTIMGRID
!
@@ -93,10 +93,9 @@ IF (LHOOK) CALL DR_HOOK('SOILGRID',0,ZHOOK_HANDLE)
!
INI = SIZE(PDG,1)
INL = SIZE(PDG,2)
-IPATCH = SIZE(PDG,3)
!
-KWG_LAYER (:,:) = 0
-ZREF (:,:) = XUNDEF
+KWG_LAYER (:) = 0
+ZREF (:) = XUNDEF
!
!-------------------------------------------------------------------------------
!
@@ -121,51 +120,49 @@ IF(LOPTIMGRID)THEN
!
ELSE
!
- WHERE(PSOILDEPTH(:,:)/=XUNDEF)
- PDG(:,1,:)=MIN(0.01,PSOILGRID(1))
+ WHERE(PSOILDEPTH(:)/=XUNDEF)
+ PDG(:,1)=MIN(0.01,PSOILGRID(1))
ELSEWHERE
- PDG(:,1,:)=XUNDEF
+ PDG(:,1)=XUNDEF
ENDWHERE
!
- DO JPATCH=1,IPATCH
DO JJ=1,INI
!
- IF( PSOILDEPTH(JJ,JPATCH)==XUNDEF )THEN
+ IF( PSOILDEPTH(JJ)==XUNDEF )THEN
!
- PDG (JJ,:,JPATCH) = XUNDEF
- KWG_LAYER(JJ, JPATCH) = NUNDEF
+ PDG (JJ,:) = XUNDEF
+ KWG_LAYER(JJ) = NUNDEF
!
ELSE
!
DO JL=2,INL
!
- PDG (JJ,JL,JPATCH) = PSOILGRID(JL)
+ PDG (JJ,JL) = PSOILGRID(JL)
!
IF ( PSOILGRID(JL)-PSOILGRID(JL-1)<=0.3 ) THEN
- ZWORK = ABS(PSOILGRID(JL)-PSOILDEPTH(JJ,JPATCH))
- IF(ZWORK<=ZREF(JJ,JPATCH))THEN
- KWG_LAYER(JJ,JPATCH) = JL
- ZREF (JJ,JPATCH) = ZWORK
+ ZWORK = ABS(PSOILGRID(JL)-PSOILDEPTH(JJ))
+ IF(ZWORK<=ZREF(JJ))THEN
+ KWG_LAYER(JJ) = JL
+ ZREF (JJ) = ZWORK
ENDIF
- ELSEIF(PSOILDEPTH(JJ,JPATCH)>=(PSOILGRID(JL)*0.3+PSOILGRID(JL-1)*0.7))THEN
- KWG_LAYER(JJ,JPATCH) = JL
+ ELSEIF(PSOILDEPTH(JJ)>=(PSOILGRID(JL)*0.3+PSOILGRID(JL-1)*0.7))THEN
+ KWG_LAYER(JJ) = JL
ENDIF
ENDDO
!
ENDIF
ENDDO
- ENDDO
!
ENDIF
!
-IF(ANY(KWG_LAYER(:,:)==0))THEN
+IF(ANY(KWG_LAYER(:)==0))THEN
CALL ABOR1_SFX('SOILGRID: WITH CISBA=DIF NWG_LAYER MUST BE DEFINED FOR EACH POINT')
ENDIF
!
IF (LHOOK) CALL DR_HOOK('SOILGRID',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
!
SUBROUTINE OPTIMSOILGRID
@@ -181,7 +178,7 @@ INTEGER, PARAMETER :: NDLIM = 13
REAL, DIMENSION(NDLIM), PARAMETER :: ZDLIM = &
(/1.25,1.50,1.75,2.00,2.25,2.50,2.75,3.00,3.50,4.00,4.50,5.00,5.50/)
!
-REAL,DIMENSION(SIZE(PDG,1),SIZE(PDG,3)) :: ZDG_WATER
+REAL,DIMENSION(SIZE(PDG,1)) :: ZDG_WATER
!
LOGICAL :: LWORK
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -191,86 +188,81 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('SOILGRID:OPTIMSOILGRID',0,ZHOOK_HANDLE)
!
-ZDG_WATER (:,:) = XUNDEF
+ZDG_WATER (:) = XUNDEF
!
!-------------------------------------------------------------------------------
!a. Arranged depth
!
IF(CDGDIF=='ROOT')THEN
!
- DO JPATCH=1,IPATCH
DO JJ=1,INI
- IF(PSOILDEPTH(JJ,JPATCH)<=1.1)THEN
- ZDG_WATER(JJ,JPATCH)=MIN(1.0,PSOILDEPTH(JJ,JPATCH))
- ELSEIF(PSOILDEPTH(JJ,JPATCH)>1.1.AND.PSOILDEPTH(JJ,JPATCH)<=1.25)THEN
- ZDG_WATER(JJ,JPATCH)=1.25
- ELSEIF(PSOILDEPTH(JJ,JPATCH)>5.50.AND.PSOILDEPTH(JJ,JPATCH)<=8.00)THEN
- ZDG_WATER(JJ,JPATCH)=8.00
- ELSEIF(PSOILDEPTH(JJ,JPATCH)>8.00.AND.PSOILDEPTH(JJ,JPATCH)<XUNDEF)THEN
- ZDG_WATER(JJ,JPATCH)=12.00 ! Permafrost case
+ IF(PSOILDEPTH(JJ)<=1.1)THEN
+ ZDG_WATER(JJ)=MIN(1.0,PSOILDEPTH(JJ))
+ ELSEIF(PSOILDEPTH(JJ)>1.1.AND.PSOILDEPTH(JJ)<=1.25)THEN
+ ZDG_WATER(JJ)=1.25
+ ELSEIF(PSOILDEPTH(JJ)>5.50.AND.PSOILDEPTH(JJ)<=8.00)THEN
+ ZDG_WATER(JJ)=8.00
+ ELSEIF(PSOILDEPTH(JJ)>8.00.AND.PSOILDEPTH(JJ)<XUNDEF)THEN
+ ZDG_WATER(JJ)=12.00 ! Permafrost case
ELSE
DO JL=1,NDLIM-1
- IF(PSOILDEPTH(JJ,JPATCH)>ZDLIM(JL).AND.PSOILDEPTH(JJ,JPATCH)<=ZDLIM(JL+1))THEN
- ZDG_WATER(JJ,JPATCH)=MERGE(ZDLIM(JL),ZDLIM(JL+1),PSOILDEPTH(JJ,JPATCH)<(0.8*ZDLIM(JL)+0.2*ZDLIM(JL+1)))
+ IF(PSOILDEPTH(JJ)>ZDLIM(JL).AND.PSOILDEPTH(JJ)<=ZDLIM(JL+1))THEN
+ ZDG_WATER(JJ)=MERGE(ZDLIM(JL),ZDLIM(JL+1),PSOILDEPTH(JJ)<(0.8*ZDLIM(JL)+0.2*ZDLIM(JL+1)))
ENDIF
ENDDO
ENDIF
ENDDO
- ENDDO
!
ELSE
!
- DO JPATCH=1,IPATCH
DO JJ=1,INI
- IF(PSOILDEPTH(JJ,JPATCH)<1.25)THEN
- ZDG_WATER(JJ,JPATCH)=MIN(1.0,PSOILDEPTH(JJ,JPATCH))
- ELSEIF(PSOILDEPTH(JJ,JPATCH)>=5.50.AND.PSOILDEPTH(JJ,JPATCH)<6.50)THEN
- ZDG_WATER(JJ,JPATCH)=5.50
- ELSEIF(PSOILDEPTH(JJ,JPATCH)>=6.50.AND.PSOILDEPTH(JJ,JPATCH)<10.50)THEN
- ZDG_WATER(JJ,JPATCH)=8.00
- ELSEIF(PSOILDEPTH(JJ,JPATCH)>=10.50.AND.PSOILDEPTH(JJ,JPATCH)<XUNDEF)THEN
- ZDG_WATER(JJ,JPATCH)=12.00 ! Permafrost case
+ IF(PSOILDEPTH(JJ)<1.25)THEN
+ ZDG_WATER(JJ)=MIN(1.0,PSOILDEPTH(JJ))
+ ELSEIF(PSOILDEPTH(JJ)>=5.50.AND.PSOILDEPTH(JJ)<6.50)THEN
+ ZDG_WATER(JJ)=5.50
+ ELSEIF(PSOILDEPTH(JJ)>=6.50.AND.PSOILDEPTH(JJ)<10.50)THEN
+ ZDG_WATER(JJ)=8.00
+ ELSEIF(PSOILDEPTH(JJ)>=10.50.AND.PSOILDEPTH(JJ)<XUNDEF)THEN
+ ZDG_WATER(JJ)=12.00 ! Permafrost case
ELSE
DO JL=1,NDLIM-1
- IF(PSOILDEPTH(JJ,JPATCH)>=ZDLIM(JL).AND.PSOILDEPTH(JJ,JPATCH)<ZDLIM(JL+1))THEN
- ZDG_WATER(JJ,JPATCH)=MERGE(ZDLIM(JL),ZDLIM(JL+1),PSOILDEPTH(JJ,JPATCH)<(0.4*ZDLIM(JL)+0.6*ZDLIM(JL+1)))
+ IF(PSOILDEPTH(JJ)>=ZDLIM(JL).AND.PSOILDEPTH(JJ)<ZDLIM(JL+1))THEN
+ ZDG_WATER(JJ)=MERGE(ZDLIM(JL),ZDLIM(JL+1),PSOILDEPTH(JJ)<(0.4*ZDLIM(JL)+0.6*ZDLIM(JL+1)))
ENDIF
ENDDO
ENDIF
ENDDO
- ENDDO
!
ENDIF
!
!-------------------------------------------------------------------------------
!b. General cases
!
-DO JPATCH=1,IPATCH
DO JJ=1,INI
!
- IF(PSOILDEPTH(JJ,JPATCH)==XUNDEF)THEN
+ IF(PSOILDEPTH(JJ)==XUNDEF)THEN
!
- PDG (JJ,:,JPATCH) = XUNDEF
- KWG_LAYER(JJ, JPATCH) = NUNDEF
+ PDG (JJ,:) = XUNDEF
+ KWG_LAYER(JJ) = NUNDEF
!
ELSE
!
- PDG(JJ,:,JPATCH) = PSOILGRID(:)
+ PDG(JJ,:) = PSOILGRID(:)
!
- LWORK=(ZDG_WATER(JJ,JPATCH)<=1.0.OR.&
- ZDG_WATER(JJ,JPATCH)==1.5.OR.&
- ZDG_WATER(JJ,JPATCH)==2.0.OR.&
- ZDG_WATER(JJ,JPATCH)==3.0.OR.&
- ZDG_WATER(JJ,JPATCH)==5.0.OR.&
- ZDG_WATER(JJ,JPATCH)==8.0.OR.&
- ZDG_WATER(JJ,JPATCH)==12.0 )
+ LWORK=(ZDG_WATER(JJ)<=1.0.OR.&
+ ZDG_WATER(JJ)==1.5.OR.&
+ ZDG_WATER(JJ)==2.0.OR.&
+ ZDG_WATER(JJ)==3.0.OR.&
+ ZDG_WATER(JJ)==5.0.OR.&
+ ZDG_WATER(JJ)==8.0.OR.&
+ ZDG_WATER(JJ)==12.0 )
!
IF (LWORK) THEN
DO JL=2,INL
- ZWORK = ABS(PSOILGRID(JL)-ZDG_WATER(JJ,JPATCH))
- IF(ZWORK<=ZREF(JJ,JPATCH))THEN
- KWG_LAYER(JJ,JPATCH)=JL
- ZREF(JJ,JPATCH)=ZWORK
+ ZWORK = ABS(PSOILGRID(JL)-ZDG_WATER(JJ))
+ IF(ZWORK<=ZREF(JJ))THEN
+ KWG_LAYER(JJ)=JL
+ ZREF(JJ)=ZWORK
ENDIF
ENDDO
ENDIF
@@ -278,24 +270,23 @@ DO JPATCH=1,IPATCH
ENDIF
!
ENDDO
-ENDDO
!
!-------------------------------------------------------------------------------
!c. Particular cases
!
-WHERE (ZDG_WATER(:,:)==1.25)
- KWG_LAYER(:,:) = 9
- PDG(:,9,:) = ZDG_WATER(:,:)
-ELSEWHERE (ZDG_WATER(:,:)==1.75 .OR. ZDG_WATER(:,:)==2.25)
- KWG_LAYER(:,:) = 10
- PDG(:,10,:) = ZDG_WATER(:,:)
- WHERE (ZDG_WATER(:,:)==1.75) PDG(:,9,:) = 1.25
-ELSEWHERE (ZDG_WATER(:,:)==2.50 .OR. ZDG_WATER(:,:)==2.75 .OR. ZDG_WATER(:,:)==3.50)
- KWG_LAYER(:,:) = 11
- PDG(:,11,:) = ZDG_WATER(:,:)
-ELSEWHERE (ZDG_WATER(:,:)==4.00 .OR. ZDG_WATER(:,:)==4.50 .OR. ZDG_WATER(:,:)==5.50)
- KWG_LAYER(:,:) = 12
- PDG(:,12,:) = ZDG_WATER(:,:)
+WHERE (ZDG_WATER(:)==1.25)
+ KWG_LAYER(:) = 9
+ PDG(:,9) = ZDG_WATER(:)
+ELSEWHERE (ZDG_WATER(:)==1.75 .OR. ZDG_WATER(:)==2.25)
+ KWG_LAYER(:) = 10
+ PDG(:,10) = ZDG_WATER(:)
+ WHERE (ZDG_WATER(:)==1.75) PDG(:,9) = 1.25
+ELSEWHERE (ZDG_WATER(:)==2.50 .OR. ZDG_WATER(:)==2.75 .OR. ZDG_WATER(:)==3.50)
+ KWG_LAYER(:) = 11
+ PDG(:,11) = ZDG_WATER(:)
+ELSEWHERE (ZDG_WATER(:)==4.00 .OR. ZDG_WATER(:)==4.50 .OR. ZDG_WATER(:)==5.50)
+ KWG_LAYER(:) = 12
+ PDG(:,12) = ZDG_WATER(:)
ENDWHERE
!
IF (LHOOK) CALL DR_HOOK('SOILGRID:OPTIMSOILGRID',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/soilstress.F90 b/src/SURFEX/soilstress.F90
index 91cfe692992c79270135648c54dfd9e9d6429b5e..0cf0f49e14a9750aeff55dde596374162c708409 100644
--- a/src/SURFEX/soilstress.F90
+++ b/src/SURFEX/soilstress.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE SOILSTRESS( HISBA, PF2, &
- PROOTFRAC, PWSAT, PWFC, PWWILT, &
- PWG, PWGI, KWG_LAYER, PF2WGHT, PF5 )
+SUBROUTINE SOILSTRESS( HISBA, PF2, KK, PK, PEK, PF2WGHT, PF5 )
! ####################################################################
!
!!**** *SOILSTRESS*
@@ -50,11 +48,18 @@ SUBROUTINE SOILSTRESS( HISBA, PF2, &
!! (P.Jabouille) 13/11/96 mininum value for ZF1
!! (V. Masson) 28/08/98 add PF2 for Calvet (1998) CO2 computations
!! (B. Decharme) 07/15 Suppress numerical adjustement for PF2
+!! (B. Decharme) 01/17 Suppress soil/vegetation parameters modification
+!! for DIF due to the presence of ice to ensure maximum
+!! vegetation stress when soil ice is important. Indeed,
+!! soil ice acts as drought events for vegetation stress
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+!
+USE MODD_ISBA_PAR, ONLY : XDENOM_MIN
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -69,20 +74,12 @@ IMPLICIT NONE
! ! '3-L'
! ! 'DIF' ISBA-DF
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PROOTFRAC, PWSAT, PWFC, PWWILT, &
- PWG, PWGI
-! PROOTFRAC = cumulative root fraction (-)
-! PWFC = field capacity profile (m3/m3)
-! PWWILT = wilting point profile (m3/m3)
-! PWSAT = porosity profile (m3/m3)
-! PWG = soil liquid volumetric water content (m3/m3)
-! PWGI = soil frozen volumetric water content (m3/m3)
-!
-INTEGER, DIMENSION(:), INTENT(IN) :: KWG_LAYER
-! KWG_LAYER = Number of soil moisture layers (DIF option)
-!
REAL, DIMENSION(:), INTENT(OUT) :: PF2 ! water stress coefficient
!
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
REAL, DIMENSION(:), INTENT(OUT) :: PF5 ! water stress coefficient for Hv (based on F2):
! ! Verify that Etv=>0 as F2=>0
!
@@ -92,18 +89,11 @@ REAL, DIMENSION(:,:), INTENT(OUT):: PF2WGHT ! water stress coefficient profile
!* 0.2 declarations of local variables
!
!
-REAL, DIMENSION(SIZE(PWFC,1)) :: ZWFC_AVGZ, ZWSAT_AVGZ, ZWWILT_AVGZ
+REAL, DIMENSION(SIZE(KK%XWFC,1)) :: ZWFC_AVGZ, ZWSAT_AVGZ, ZWWILT_AVGZ
! ZWFC_AVGZ = field capacity averaged over entire soil column
! ZWSAT_AVGZ = porosity averaged over entire soil column
! ZWWILT_AVGZ = wilting point averaged over entire soil column
!
-! ISBA-DF:
-!
-REAL, DIMENSION(SIZE(PWG,1)) :: ZWSAT, ZWFC, ZWWILT
-! ZWSAT = ice-adjusted porosity profile (m3/m3)
-! ZWFC = ice-adjusted field capacity profile (m3/m3)
-! ZWWILT = ice-adjusted wilting point profile (m3/m3)
-!
REAL :: ZROOTFRACN
! ZROOTFRACN = Normalized root fraction weights
!
@@ -121,8 +111,12 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('SOILSTRESS',0,ZHOOK_HANDLE)
!
-INI=SIZE(PWG,1)
-INL=MAXVAL(KWG_LAYER(:))
+INI=SIZE(PEK%XWG,1)
+IF (SIZE(PK%NWG_LAYER)>0) THEN
+ INL=MAXVAL(PK%NWG_LAYER(:))
+ELSE
+ INL=0
+ENDIF
!
PF2 (:) = 0.0
PF2WGHT(:,:) = 0.0
@@ -153,16 +147,11 @@ IF(HISBA =='DIF')THEN
! First layer
!---------------------------------------------------------
!
-! Due to the presence of ice, modify soil parameters:
- ZWSAT (:) = PWSAT (:,1) - PWGI(:,1)
- ZWFC (:) = PWFC (:,1) * ZWSAT(:)/PWSAT(:,1)
- ZWWILT(:) = PWWILT(:,1) * ZWSAT(:)/PWSAT(:,1)
-!
! Calculate the soil water stress factor for each layer:
- PF2WGHT(:,1) = MAX(0.0,MIN(1.0,(PWG(:,1)-ZWWILT(:))/(ZWFC(:)-ZWWILT(:))))
+ PF2WGHT(:,1) = (PEK%XWG(:,1)-KK%XWWILT(:,1))/(KK%XWFC(:,1)-KK%XWWILT(:,1))
!
! Normalize the transpiration weights by root fraction:
- PF2WGHT(:,1) = PROOTFRAC(:,1)*PF2WGHT(:,1)
+ PF2WGHT(:,1) = PK%XROOTFRAC(:,1)*MAX(0.0,MIN(1.0,PF2WGHT(:,1)))
!
! Net soil water stress for entire root zone:
PF2(:) = PF2WGHT(:,1)
@@ -174,25 +163,20 @@ IF(HISBA =='DIF')THEN
DO JL=2,INL
DO JJ=1,INI
!
- IDEPTH=KWG_LAYER(JJ)
+ IDEPTH=PK%NWG_LAYER(JJ)
IF(JL<=IDEPTH)THEN
!
-! Due to the presence of ice, modify soil parameters:
- ZWSAT (JJ) = PWSAT (JJ,JL) - PWGI(JJ,JL)
- ZWFC (JJ) = PWFC (JJ,JL) * ZWSAT(JJ)/PWSAT(JJ,JL)
- ZWWILT(JJ) = PWWILT(JJ,JL) * ZWSAT(JJ)/PWSAT(JJ,JL)
-!
! Calculate normalized root fraction weights:
- ZROOTFRACN = PROOTFRAC(JJ,JL) - PROOTFRAC(JJ,JL-1)
+ ZROOTFRACN = PK%XROOTFRAC(JJ,JL) - PK%XROOTFRAC(JJ,JL-1)
!
! Calculate the soil water stress factor for each layer:
- PF2WGHT(JJ,JL) = MAX(0.0,MIN(1.0,(PWG(JJ,JL)-ZWWILT(JJ))/(ZWFC(JJ)-ZWWILT(JJ))))
+ PF2WGHT(JJ,JL) = (PEK%XWG(JJ,JL)-KK%XWWILT(JJ,JL))/(KK%XWFC(JJ,JL)-KK%XWWILT(JJ,JL))
!
-! Normalize the transpiration weights by root fraction:
- PF2WGHT(JJ,JL) = ZROOTFRACN*PF2WGHT(JJ,JL)
+! Normalize the transpiration weights by root fraction:
+ PF2WGHT(JJ,JL) = ZROOTFRACN*MAX(0.0,MIN(1.0,PF2WGHT(JJ,JL)))
!
! Net soil water stress for entire root zone:
- PF2(JJ) = PF2(JJ) + PF2WGHT(JJ,JL)
+ PF2(JJ) = PF2(JJ) + PF2WGHT(JJ,JL)
!
ENDIF
!
@@ -208,13 +192,13 @@ ELSE
!
! Due to the presence of ice, modify soil parameters:
!
- ZWSAT_AVGZ(:) = PWSAT (:,1) - PWGI(:,2)
- ZWFC_AVGZ(:) = PWFC (:,1)*ZWSAT_AVGZ(:)/PWSAT(:,1)
- ZWWILT_AVGZ(:) = PWWILT(:,1)*ZWSAT_AVGZ(:)/PWSAT(:,1)
+ ZWSAT_AVGZ(:) = KK%XWSAT (:,1) - PEK%XWGI(:,2)
+ ZWFC_AVGZ(:) = KK%XWFC (:,1)*ZWSAT_AVGZ(:)/KK%XWSAT(:,1)
+ ZWWILT_AVGZ(:) = KK%XWWILT(:,1)*ZWSAT_AVGZ(:)/KK%XWSAT(:,1)
!
! Compute the water stress factor:
!
- PF2(:) = (PWG(:,2)-ZWWILT_AVGZ(:))/(ZWFC_AVGZ(:)-ZWWILT_AVGZ(:))
+ PF2(:) = (PEK%XWG(:,2)-ZWWILT_AVGZ(:))/(ZWFC_AVGZ(:)-ZWWILT_AVGZ(:))
PF2(:) = MAX(0.0,MIN(1.0, PF2(:)))
!
!
diff --git a/src/SURFEX/soiltemp_arp_par.F90 b/src/SURFEX/soiltemp_arp_par.F90
index 6b883a1ab6a702de96d8c437a4c47b9aee00dd16..89c6ea46dcdb3ad8cd3a6963fc5c94c94b2182df 100644
--- a/src/SURFEX/soiltemp_arp_par.F90
+++ b/src/SURFEX/soiltemp_arp_par.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE SOILTEMP_ARP_PAR (I, &
- HPROGRAM,OTEMP_ARP,KTEMPLAYER_ARP)
+ SUBROUTINE SOILTEMP_ARP_PAR (IO, HPROGRAM)
! ##############################################################
!
!!**** *SOILTEMP_ARP_PAR* Impose special pseudo depth for "force-restore"
@@ -42,8 +41,7 @@
!* 0. DECLARATION
! -----------
!
-!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_READ_NAMELIST, ONLY : LNAM_READ
@@ -69,11 +67,10 @@ IMPLICIT NONE
! ------------------------
!
!
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
!
+
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
-LOGICAL, INTENT(OUT) :: OTEMP_ARP
-INTEGER, INTENT(OUT) :: KTEMPLAYER_ARP
!
!* 0.2 Declaration of local variables
! ------------------------------
@@ -122,7 +119,7 @@ ENDIF
!* 3. Consistency
! -----------
!
-IF(LTEMP_ARP.AND.I%CISBA=='DIF')THEN
+IF(LTEMP_ARP.AND.IO%CISBA=='DIF')THEN
LTEMP_ARP=.FALSE.
WRITE(ILUOUT,*)'LTEMP_ARP put at False because you use the ISBA-DF scheme'
ENDIF
@@ -150,31 +147,31 @@ ENDIF
!
IF(LTEMP_ARP)THEN
!
- ALLOCATE(I%XSODELX(NTEMPLAYER_ARP))
+ ALLOCATE(IO%XSODELX(NTEMPLAYER_ARP))
!
IF(ALL(SODELX(:)==XUNDEF))THEN
!
- I%XSODELX(1)=0.5
- I%XSODELX(2)=1.5
- I%XSODELX(3)=4.5
- I%XSODELX(4)=13.5
- WRITE(ILUOUT,*)'SODELX default values : ',I%XSODELX(:)
+ IO%XSODELX(1)=0.5
+ IO%XSODELX(2)=1.5
+ IO%XSODELX(3)=4.5
+ IO%XSODELX(4)=13.5
+ WRITE(ILUOUT,*)'SODELX default values : ',IO%XSODELX(:)
!
ELSE
!
- I%XSODELX(:)=SODELX(1:NTEMPLAYER_ARP)
- WRITE(ILUOUT,*)'SODELX imposed to : ',I%XSODELX(:)
+ IO%XSODELX(:)=SODELX(1:NTEMPLAYER_ARP)
+ WRITE(ILUOUT,*)'SODELX imposed to : ',IO%XSODELX(:)
!
ENDIF
!
ELSE
!
- ALLOCATE(I%XSODELX(0))
+ ALLOCATE(IO%XSODELX(0))
!
ENDIF
!
-OTEMP_ARP =LTEMP_ARP
-KTEMPLAYER_ARP=NTEMPLAYER_ARP
+IO%LTEMP_ARP =LTEMP_ARP
+IO%NTEMPLAYER_ARP=NTEMPLAYER_ARP
IF (LHOOK) CALL DR_HOOK('SOILTEMP_ARP_PAR',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/solar_panel.F90 b/src/SURFEX/solar_panel.F90
index 0d38efbf9bfe81fe8e15a792b057be7cd2341abc..6cfb0c49feea3e488c38c4c3ce5934b87218f25a 100644
--- a/src/SURFEX/solar_panel.F90
+++ b/src/SURFEX/solar_panel.F90
@@ -3,16 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE SOLAR_PANEL(PTSTEP, PTSUN, PRESIDENTIAL, &
- PEMIT_LW_ROOF, PEMIT_LWDN_PANEL, PLW_RAD, &
- PABS_SW_PANEL, PTA, PN_FLOOR, PFRAC_PANEL,&
- PEMIS_PANEL, PALB_PANEL, PEFF_PANEL, &
- PABS_LW_PANEL, PH_PANEL, PRN_PANEL, &
- PTHER_PRODC_DAY, &
- PTHER_PROD_PANEL, PPHOT_PROD_PANEL, &
- PPROD_PANEL, &
- PTHER_PROD_BLD, PPHOT_PROD_BLD, &
- PPROD_BLD )
+ SUBROUTINE SOLAR_PANEL(TPN, DMT, PTSTEP, PTSUN, PRESIDENTIAL, PEMIT_LW_ROOF, &
+ PEMIT_LWDN_PANEL, PLW_RAD, PTA, PN_FLOOR, PPROD_BLD )
! ##########################################################################
!
!!**** *SOLAR_PANEL*
@@ -52,6 +44,9 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TEB_PANEL_n, ONLY : TEB_PANEL_t
+USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_t
+!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_CSTS, ONLY : XSTEFAN
!
@@ -62,6 +57,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(TEB_PANEL_t), INTENT(INOUT) :: TPN
+TYPE(DIAG_MISC_TEB_t), INTENT(INOUT) :: DMT
!
REAL, INTENT(IN) :: PTSTEP ! time step (s)
REAL, DIMENSION(:), INTENT(IN) :: PTSUN ! solar time (s since solar midnight)
@@ -69,23 +66,10 @@ REAL, DIMENSION(:), INTENT(IN) :: PRESIDENTIAL ! Buildings Residential use f
REAL, DIMENSION(:), INTENT(IN) :: PEMIT_LW_ROOF ! Upwards LW flux from roof (W/m2)
REAL, DIMENSION(:), INTENT(IN) :: PEMIT_LWDN_PANEL! Downwards LW flux from panel (W/m2)
REAL, DIMENSION(:), INTENT(IN) :: PLW_RAD ! Incoming Longwave radiation (W/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_PANEL ! Absorbed solar energy by the solar panel (W/m2)
REAL, DIMENSION(:), INTENT(IN) :: PTA ! Air temperature (K)
REAL, DIMENSION(:), INTENT(IN) :: PN_FLOOR ! number of floors (-)
-REAL, DIMENSION(:), INTENT(IN) :: PFRAC_PANEL ! fraction of solar panel on roofs (-)
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_PANEL ! emissivity of solar panel (-)
-REAL, DIMENSION(:), INTENT(IN) :: PALB_PANEL ! albedo of solar panel (-)
-REAL, DIMENSION(:), INTENT(IN) :: PEFF_PANEL ! efficiency of solar panel (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_LW_PANEL ! Absorbed LW enerby by solar panel (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PH_PANEL ! Sensible heat released by the solar panel (W/m2)
-REAL, DIMENSION(:), INTENT(OUT) :: PRN_PANEL ! Net radiation of the solar panel (W/m2)
-REAL, DIMENSION(:), INTENT(INOUT)::PTHER_PRODC_DAY ! Present day integrated thermal production of energy (J/m2 panel)
-REAL, DIMENSION(:), INTENT(OUT) :: PTHER_PROD_PANEL! Thermal Energy production of the solar panel (W/m2 panel)
-REAL, DIMENSION(:), INTENT(OUT) :: PPHOT_PROD_PANEL! Photovoltaic Energy production of the solar panel (W/m2 panel)
-REAL, DIMENSION(:), INTENT(OUT) :: PPROD_PANEL ! Averaged Energy production of the solar panel (W/m2 panel)
-REAL, DIMENSION(:), INTENT(OUT) :: PTHER_PROD_BLD ! Thermal Energy production of the solar panel (W/m2 bld)
-REAL, DIMENSION(:), INTENT(OUT) :: PPHOT_PROD_BLD ! Photovoltaic Energy production of the solar panel (W/m2 bld)
-REAL, DIMENSION(:), INTENT(OUT) :: PPROD_BLD ! Averaged Energy production of the solar panel (W/m2 bld)
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PPROD_BLD
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -137,14 +121,14 @@ IF (LHOOK) CALL DR_HOOK('SOLAR_PANEL',0,ZHOOK_HANDLE)
!* 0.4 Default values for output variables
! -----------------------------------
!
-PABS_LW_PANEL = XUNDEF ! Absorbed LW enerby by solar panel (W/m2)
-PH_PANEL = XUNDEF ! Sensible heat released by the solar panel (W/m2)
-PRN_PANEL = XUNDEF ! Net radiation of the solar panel (W/m2)
-PTHER_PROD_PANEL= XUNDEF ! Thermal Energy production of the solar panel (W/m2)
-PPHOT_PROD_PANEL= XUNDEF ! Photovoltaic Energy production of the solar panel (W/m2)
-PPROD_PANEL = XUNDEF ! Averaged Energy production of the solar panel (W/m2)
-PTHER_PROD_BLD = 0. ! Thermal Energy production of the solar panel (W/m2)
-PPHOT_PROD_BLD = 0. ! Photovoltaic Energy production of the solar panel (W/m2)
+DMT%XABS_LW_PANEL = XUNDEF ! Absorbed LW enerby by solar panel (W/m2)
+DMT%XH_PANEL = XUNDEF ! Sensible heat released by the solar panel (W/m2)
+DMT%XRN_PANEL = XUNDEF ! Net radiation of the solar panel (W/m2)
+DMT%XTHER_PROD_PANEL= XUNDEF ! Thermal Energy production of the solar panel (W/m2)
+DMT%XPHOT_PROD_PANEL= XUNDEF ! Photovoltaic Energy production of the solar panel (W/m2)
+DMT%XPROD_PANEL = XUNDEF ! Averaged Energy production of the solar panel (W/m2)
+DMT%XTHER_PROD_BLD = 0. ! Thermal Energy production of the solar panel (W/m2)
+DMT%XPHOT_PROD_BLD = 0. ! Photovoltaic Energy production of the solar panel (W/m2)
PPROD_BLD = 0. ! Averaged Energy production of the solar panel (W/m2)
!
!-------------------------------------------------------------------------------
@@ -156,7 +140,7 @@ PPROD_BLD = 0. ! Averaged Energy production of the solar panel
! ----------------------------------------------
!
!* energy reset between midnight and 1AM.
-WHERE (PTSUN(:)>=0. .AND. PTSUN(:)<=3600.) PTHER_PRODC_DAY(:) = 0.
+WHERE (PTSUN(:)>=0. .AND. PTSUN(:)<=3600.) TPN%XTHER_PRODC_DAY(:) = 0.
!
!
!* 1.2 Daily target production for thermal panels
@@ -167,13 +151,13 @@ ZTHER_DAILY_TARGET = (2.*XTHER_RATE) * XWATER_DT * (1000. / 365. * 3600. ) ! (J/
!
!-------------------------------------------------------------------------------
!* Note that computations are done only where solar panels are present
-WHERE (PFRAC_PANEL(:)>0.)
+WHERE (TPN%XFRAC_PANEL(:)>0.)
!-------------------------------------------------------------------------------
!
!* 2. Irradiance on panel
! -------------------
!
- ZIRRADIANCE(:) = XFT * PABS_SW_PANEL(:) / (1.-PALB_PANEL(:) )
+ ZIRRADIANCE(:) = XFT * DMT%XABS_SW_PANEL(:) / (1.-TPN%XALB_PANEL(:) )
!
!-------------------------------------------------------------------------------
!
@@ -187,22 +171,22 @@ WHERE (PFRAC_PANEL(:)>0.)
!* 4. Upwards solar panel LW radiation
! --------------------------------
!
- ZLWU_PANEL (:) = PEMIS_PANEL(:) * XSTEFAN * ZTS_PANEL(:)**4 &
- + (1.-PEMIS_PANEL(:)) * PLW_RAD(:)
+ ZLWU_PANEL (:) = TPN%XEMIS_PANEL(:) * XSTEFAN * ZTS_PANEL(:)**4 &
+ + (1.-TPN%XEMIS_PANEL(:)) * PLW_RAD(:)
!
!-------------------------------------------------------------------------------
!
!* 5. Solar panel LW budget
! ---------------------
!
- PABS_LW_PANEL(:)= PLW_RAD(:) + PEMIT_LW_ROOF(:) - PEMIT_LWDN_PANEL(:) - ZLWU_PANEL(:)
+ DMT%XABS_LW_PANEL(:)= PLW_RAD(:) + PEMIT_LW_ROOF(:) - PEMIT_LWDN_PANEL(:) - ZLWU_PANEL(:)
!
!-------------------------------------------------------------------------------
!
!* 6. Solar panel Net radiation
! -------------------------
!
- PRN_PANEL(:) = PABS_SW_PANEL(:) + PABS_LW_PANEL(:)
+ DMT%XRN_PANEL(:) = DMT%XABS_SW_PANEL(:) + DMT%XABS_LW_PANEL(:)
!
!-------------------------------------------------------------------------------
!
@@ -212,12 +196,12 @@ WHERE (PFRAC_PANEL(:)>0.)
!* 7.1 Panel dedicated to thermal production of hot water
! --------------------------------------------------
!
- ZTHER_FRAC(:) = MIN( XTHER_FLOOR * PN_FLOOR(:) * PRESIDENTIAL(:), PFRAC_PANEL(:) ) ! (m2 thermal panel / m2 roof)
+ ZTHER_FRAC(:) = MIN( XTHER_FLOOR * PN_FLOOR(:) * PRESIDENTIAL(:), TPN%XFRAC_PANEL(:) ) ! (m2 thermal panel / m2 roof)
!
!* 7.2 Photovoltaic panel
! ------------------
!
- ZPHOT_FRAC(:) = PFRAC_PANEL(:) - ZTHER_FRAC(:) ! (m2 photovoltaic panel / m2 roof)
+ ZPHOT_FRAC(:) = TPN%XFRAC_PANEL(:) - ZTHER_FRAC(:) ! (m2 photovoltaic panel / m2 roof)
!
!-------------------------------------------------------------------------------
!
@@ -227,13 +211,13 @@ WHERE (PFRAC_PANEL(:)>0.)
!* 8.1 Instantaneous production
! ------------------------
!
- PTHER_PROD_PANEL(:)= XTHER_EFF * ZIRRADIANCE(:) ! (W/m2)
-! PTHER_PROD_PANEL(:) = XTHER_RATE * XWATER_DT * (1000. / 24. / 365.)
+ DMT%XTHER_PROD_PANEL(:)= XTHER_EFF * ZIRRADIANCE(:) ! (W/m2)
+! DMT%XTHER_PROD_PANEL(:) = XTHER_RATE * XWATER_DT * (1000. / 24. / 365.)
!
!* 8.2 Integrated daily production
! ---------------------------
!
- ZTHER_PRODC_DAY(:) = PTHER_PRODC_DAY(:) + PTSTEP * PTHER_PROD_PANEL(:) ! (J/m2)
+ ZTHER_PRODC_DAY(:) = TPN%XTHER_PRODC_DAY(:) + PTSTEP * DMT%XTHER_PROD_PANEL(:) ! (J/m2)
!
!* 8.3 Daily production limited by daily target
! ----------------------------------------
@@ -243,43 +227,43 @@ WHERE (PFRAC_PANEL(:)>0.)
!* 8.4 Instantaneous production taking into account target limit if reached
! --------------------------------------------------------------------
!
- PTHER_PROD_PANEL(:)= ( ZTHER_PRODC_DAY(:) - PTHER_PRODC_DAY(:) ) / PTSTEP
+ DMT%XTHER_PROD_PANEL(:)= ( ZTHER_PRODC_DAY(:) - TPN%XTHER_PRODC_DAY(:) ) / PTSTEP
!
!* 8.5 Updates daily production
! ------------------------
!
- PTHER_PRODC_DAY(:) = ZTHER_PRODC_DAY(:)
+ TPN%XTHER_PRODC_DAY(:) = ZTHER_PRODC_DAY(:)
!-------------------------------------------------------------------------------
!
!* 9. Photovoltaic Production (W/m2 photovoltaic panel)
! -----------------------
!
- PPHOT_PROD_PANEL(:) = PEFF_PANEL(:) * ZIRRADIANCE(:) * MIN(1.,1.-XT_LOSS*(ZTS_PANEL(:)-XT_OPT))
+ DMT%XPHOT_PROD_PANEL(:) = TPN%XEFF_PANEL(:) * ZIRRADIANCE(:) * MIN(1.,1.-XT_LOSS*(ZTS_PANEL(:)-XT_OPT))
!
!-------------------------------------------------------------------------------
!
!* 10. Averaged Production (W/m2 panel)
! -------------------
!
- PPROD_PANEL(:) = PTHER_PROD_PANEL(:) * (ZTHER_FRAC(:) / PFRAC_PANEL(:)) &
- + PPHOT_PROD_PANEL(:) * (ZPHOT_FRAC(:) / PFRAC_PANEL(:))
+ DMT%XPROD_PANEL(:) = DMT%XTHER_PROD_PANEL(:) * (ZTHER_FRAC(:) / TPN%XFRAC_PANEL(:)) &
+ + DMT%XPHOT_PROD_PANEL(:) * (ZPHOT_FRAC(:) / TPN%XFRAC_PANEL(:))
!
!-------------------------------------------------------------------------------
!
!* 11. Sensible heat flux (W/m2 panel)
! ------------------
!
- PH_PANEL(:) = PRN_PANEL(:) - PPROD_PANEL(:)
+ DMT%XH_PANEL(:) = DMT%XRN_PANEL(:) - DMT%XPROD_PANEL(:)
!
!-------------------------------------------------------------------------------
!
!* 12. Productions per building (W/m2 bld)
! ------------------------
!
- PTHER_PROD_BLD(:) = PTHER_PROD_PANEL(:) * ZTHER_FRAC(:)
- PPHOT_PROD_BLD(:) = PPHOT_PROD_PANEL(:) * ZPHOT_FRAC(:)
- PPROD_BLD (:) = PTHER_PROD_BLD (:) + PPHOT_PROD_PANEL(:)
+ DMT%XTHER_PROD_BLD(:) = DMT%XTHER_PROD_PANEL(:) * ZTHER_FRAC(:)
+ DMT%XPHOT_PROD_BLD(:) = DMT%XPHOT_PROD_PANEL(:) * ZPHOT_FRAC(:)
+ PPROD_BLD (:) = DMT%XTHER_PROD_BLD (:) + DMT%XPHOT_PROD_PANEL(:)
!
!-------------------------------------------------------------------------------
END WHERE
diff --git a/src/SURFEX/split_grid.F90 b/src/SURFEX/split_grid.F90
index 8517a481d2e9cb76be3d3cb31de9fe1f05db4a3f..eb65e63988e372846697bf3989fe33c969cd3865 100644
--- a/src/SURFEX/split_grid.F90
+++ b/src/SURFEX/split_grid.F90
@@ -3,13 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###########################################################
-#ifdef MNH_PARALLEL
- SUBROUTINE SPLIT_GRID(UG, U, &
- HPROGRAM,KGRID_PAR,PGRID_PAR,KHALO)
-#else
- SUBROUTINE SPLIT_GRID(UG, U, &
- HPROGRAM)
-#endif
+ SUBROUTINE SPLIT_GRID(UG, U, HPROGRAM,KGRID_PAR,PGRID_PAR,KHALO)
! ###########################################################
!!
!! PURPOSE
@@ -68,22 +62,21 @@ TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
-#ifdef MNH_PARALLEL
-INTEGER, INTENT(INOUT) :: KGRID_PAR ! size of PGRID_PAR pointer
-REAL, DIMENSION(:), POINTER, INTENT(INOUT) :: PGRID_PAR ! parameters defining this grid
-INTEGER, INTENT(IN), OPTIONAL :: KHALO ! size of the Halo
-#endif
!
+INTEGER, OPTIONAL, INTENT(INOUT) :: KGRID_PAR ! size of PGRID_PAR pointer
+REAL, DIMENSION(:), OPTIONAL, POINTER, INTENT(INOUT) :: PGRID_PAR ! parameters defining this grid
+INTEGER, INTENT(IN), OPTIONAL :: KHALO ! size of the Halo
!
!* 0.2 Declaration of local variables
! ------------------------------
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
CHARACTER(LEN=100) :: YCOMMENT
-INTEGER :: IRESP ! error return code
+INTEGER :: IRESP, ISIZE_FULL ! error return code
INTEGER :: IHALO
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('SPLIT_GRID',0,ZHOOK_HANDLE)
+!
#ifdef MNH_PARALLEL
IF (PRESENT(KHALO)) THEN
IHALO = KHALO
@@ -94,24 +87,26 @@ ENDIF
IHALO = 0
#endif
!
-SELECT CASE(UG%CGRID)
-#ifdef MNH_PARALLEL
- CASE('CONF PROJ ')
- CALL SPLIT_GRID_CONF_PROJ(HPROGRAM,U%NDIM_FULL,U%NSIZE_FULL,KGRID_PAR,PGRID_PAR,IHALO)
- CASE('CARTESIAN ')
- CALL SPLIT_GRID_CARTESIAN(HPROGRAM,U%NDIM_FULL,U%NSIZE_FULL,KGRID_PAR,PGRID_PAR,IHALO)
- CASE DEFAULT
- CALL GET_SIZE_FULL_n(U, &
- HPROGRAM,U%NDIM_FULL,U%NSIZE_FULL)
-#else
+SELECT CASE(UG%G%CGRID)
+
CASE('CONF PROJ ')
- CALL SPLIT_GRID_CONF_PROJ(HPROGRAM,U%NDIM_FULL,U%NSIZE_FULL,UG%NGRID_PAR,UG%XGRID_PAR)
+ IF (PRESENT(KGRID_PAR).AND.PRESENT(PGRID_PAR)) THEN
+ CALL SPLIT_GRID_CONF_PROJ(HPROGRAM,U%NDIM_FULL,U%NSIZE_FULL,KGRID_PAR,PGRID_PAR,IHALO)
+ ELSE
+ CALL SPLIT_GRID_CONF_PROJ(HPROGRAM,U%NDIM_FULL,U%NSIZE_FULL,UG%G%NGRID_PAR,UG%G%XGRID_PAR)
+ ENDIF
+
CASE('CARTESIAN ')
- CALL SPLIT_GRID_CARTESIAN(HPROGRAM,U%NDIM_FULL,U%NSIZE_FULL,UG%NGRID_PAR,UG%XGRID_PAR)
+ IF (PRESENT(KGRID_PAR).AND.PRESENT(PGRID_PAR)) THEN
+ CALL SPLIT_GRID_CARTESIAN(HPROGRAM,U%NDIM_FULL,U%NSIZE_FULL,KGRID_PAR,PGRID_PAR,IHALO)
+ ELSE
+ CALL SPLIT_GRID_CARTESIAN(HPROGRAM,U%NDIM_FULL,U%NSIZE_FULL,UG%G%NGRID_PAR,UG%G%XGRID_PAR)
+ ENDIF
+
CASE DEFAULT
- CALL GET_SIZE_FULL_n(U, &
- HPROGRAM,U%NDIM_FULL,U%NSIZE_FULL)
-#endif
+ CALL GET_SIZE_FULL_n(HPROGRAM,U%NDIM_FULL,U%NSIZE_FULL,ISIZE_FULL)
+ U%NSIZE_FULL = ISIZE_FULL
+
END SELECT
!
diff --git a/src/SURFEX/split_grid_cartesian.F90 b/src/SURFEX/split_grid_cartesian.F90
index a34893f91de694bc375f1362d18ee81a6d1dc25e..d2f5481ee637e78d4c9d56b36c8ea666fa7daa0f 100644
--- a/src/SURFEX/split_grid_cartesian.F90
+++ b/src/SURFEX/split_grid_cartesian.F90
@@ -3,11 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###########################################################
-#ifdef MNH_PARALLEL
SUBROUTINE SPLIT_GRID_CARTESIAN(HPROGRAM,KDIM_FULL,KSIZE_FULL,KGRID_PAR,PGRID_PAR,KHALO)
-#else
- SUBROUTINE SPLIT_GRID_CARTESIAN(HPROGRAM,KDIM_FULL,KSIZE_FULL,KGRID_PAR,PGRID_PAR)
-#endif
! ###########################################################
!!
!! PURPOSE
@@ -61,10 +57,7 @@ INTEGER, INTENT(IN) :: KDIM_FULL ! total number of points
INTEGER, INTENT(OUT) :: KSIZE_FULL! number of points on this processor
INTEGER, INTENT(INOUT) :: KGRID_PAR ! size of PGRID_PAR pointer
REAL, DIMENSION(:), POINTER :: PGRID_PAR ! parameters defining this grid
-#ifdef MNH_PARALLEL
-INTEGER, INTENT(IN) :: KHALO ! size of the Halo
-#endif
-!
+INTEGER, OPTIONAL, INTENT(IN) :: KHALO ! size of the Halo
!
!* 0.2 Declaration of local variables
! ------------------------------
@@ -92,13 +85,13 @@ IF (LHOOK) CALL DR_HOOK('SPLIT_GRID_CARTESIAN',0,ZHOOK_HANDLE)
!
!* 2. Splits the (pertinent) parameters of the grid
!
-#ifdef MNH_PARALLEL
- CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CARTESIAN ','IMAX ',KHALO,IIMAX,IIMAX_SPLIT)
- CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CARTESIAN ','JMAX ',KHALO,IJMAX,IJMAX_SPLIT)
-#else
- CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CARTESIAN ','IMAX ',IIMAX,IIMAX_SPLIT)
- CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CARTESIAN ','JMAX ',IJMAX,IJMAX_SPLIT)
-#endif
+IF (PRESENT(KHALO)) THEN
+ CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CARTESIAN ','IMAX ',IIMAX,IIMAX_SPLIT,KHALO)
+ CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CARTESIAN ','JMAX ',IJMAX,IJMAX_SPLIT,KHALO)
+ELSE
+ CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CARTESIAN ','IMAX ',IIMAX,IIMAX_SPLIT)
+ CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CARTESIAN ','JMAX ',IJMAX,IJMAX_SPLIT)
+ENDIF
!
KSIZE_FULL = IIMAX_SPLIT * IJMAX_SPLIT
!
@@ -106,17 +99,18 @@ ALLOCATE(ZX_SPLIT (KSIZE_FULL))
ALLOCATE(ZY_SPLIT (KSIZE_FULL))
ALLOCATE(ZDX_SPLIT(KSIZE_FULL))
ALLOCATE(ZDY_SPLIT(KSIZE_FULL))
-#ifdef MNH_PARALLEL
- CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','XX ',KDIM_FULL,KSIZE_FULL,IIMAX,IJMAX,KHALO,ZX,ZX_SPLIT)
- CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','YY ',KDIM_FULL,KSIZE_FULL,IIMAX,IJMAX,KHALO,ZY,ZY_SPLIT)
- CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','DX ',KDIM_FULL,KSIZE_FULL,IIMAX,IJMAX,KHALO,ZDX,ZDX_SPLIT)
- CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','DY ',KDIM_FULL,KSIZE_FULL,IIMAX,IJMAX,KHALO,ZDY,ZDY_SPLIT)
-#else
- CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','XX ',KDIM_FULL,KSIZE_FULL,ZX,ZX_SPLIT)
- CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','YY ',KDIM_FULL,KSIZE_FULL,ZY,ZY_SPLIT)
- CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','DX ',KDIM_FULL,KSIZE_FULL,ZDX,ZDX_SPLIT)
- CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','DY ',KDIM_FULL,KSIZE_FULL,ZDY,ZDY_SPLIT)
-#endif
+!
+IF (PRESENT(KHALO)) THEN
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','XX ',KDIM_FULL,KSIZE_FULL,ZX,ZX_SPLIT,IIMAX,IJMAX,KHALO)
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','YY ',KDIM_FULL,KSIZE_FULL,ZY,ZY_SPLIT,IIMAX,IJMAX,KHALO)
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','DX ',KDIM_FULL,KSIZE_FULL,ZDX,ZDX_SPLIT,IIMAX,IJMAX,KHALO)
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','DY ',KDIM_FULL,KSIZE_FULL,ZDY,ZDY_SPLIT,IIMAX,IJMAX,KHALO)
+ELSE
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','XX ',KDIM_FULL,KSIZE_FULL,ZX,ZX_SPLIT)
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','YY ',KDIM_FULL,KSIZE_FULL,ZY,ZY_SPLIT)
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','DX ',KDIM_FULL,KSIZE_FULL,ZDX,ZDX_SPLIT)
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CARTESIAN ','DY ',KDIM_FULL,KSIZE_FULL,ZDY,ZDY_SPLIT)
+ENDIF
!
!
!* 3. Stores Parameters of the Grid in grid pointer
diff --git a/src/SURFEX/split_grid_conf_proj.F90 b/src/SURFEX/split_grid_conf_proj.F90
index d768d7a6c52db0b7c376868999000bdf98b56698..aadbdb130dad1fb4f47f75de60a0b214950f16bb 100644
--- a/src/SURFEX/split_grid_conf_proj.F90
+++ b/src/SURFEX/split_grid_conf_proj.F90
@@ -3,11 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###########################################################
-#ifdef MNH_PARALLEL
SUBROUTINE SPLIT_GRID_CONF_PROJ(HPROGRAM,KDIM_FULL,KSIZE_FULL,KGRID_PAR,PGRID_PAR,KHALO)
-#else
- SUBROUTINE SPLIT_GRID_CONF_PROJ(HPROGRAM,KDIM_FULL,KSIZE_FULL,KGRID_PAR,PGRID_PAR)
-#endif
! ###########################################################
!!
!! PURPOSE
@@ -61,10 +57,7 @@ INTEGER, INTENT(IN) :: KDIM_FULL ! total number of points
INTEGER, INTENT(OUT) :: KSIZE_FULL! number of points on this processor
INTEGER, INTENT(INOUT) :: KGRID_PAR ! size of PGRID_PAR pointer
REAL, DIMENSION(:), POINTER :: PGRID_PAR ! parameters defining this grid
-#ifdef MNH_PARALLEL
-INTEGER, INTENT(IN) :: KHALO ! size of the Halo
-#endif
-!
+INTEGER, OPTIONAL, INTENT(IN) :: KHALO ! size of the Halo
!
!* 0.2 Declaration of local variables
! ------------------------------
@@ -74,7 +67,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!* original grid
REAL :: ZLAT0, ZLON0, ZRPK, ZBETA, ZLATOR, ZLONOR
INTEGER :: IIMAX, IJMAX
-REAL, DIMENSION(INT(PGRID_PAR(11))) :: ZX, ZY, ZDX, ZDY
+REAL, DIMENSION(INT(PGRID_PAR(11))) :: ZX, ZY, ZDX, ZDY
!
!* splitted grid on processor
INTEGER :: IIMAX_SPLIT, IJMAX_SPLIT
@@ -92,13 +85,13 @@ IF (LHOOK) CALL DR_HOOK('SPLIT_GRID_CONF_PROJ',0,ZHOOK_HANDLE)
!
!* 2. Splits the (pertinent) parameters of the grid
!
-#ifdef MNH_PARALLEL
- CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CONF PROJ ','IMAX ',KHALO,IIMAX,IIMAX_SPLIT)
- CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CONF PROJ ','JMAX ',KHALO,IJMAX,IJMAX_SPLIT)
-#else
- CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CONF PROJ ','IMAX ',IIMAX,IIMAX_SPLIT)
- CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CONF PROJ ','JMAX ',IJMAX,IJMAX_SPLIT)
-#endif
+IF (PRESENT(KHALO)) THEN
+ CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CONF PROJ ','IMAX ',IIMAX,IIMAX_SPLIT,KHALO)
+ CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CONF PROJ ','JMAX ',IJMAX,IJMAX_SPLIT,KHALO)
+ELSE
+ CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CONF PROJ ','IMAX ',IIMAX,IIMAX_SPLIT)
+ CALL SPLIT_GRID_PARAMETERN0(HPROGRAM,'CONF PROJ ','JMAX ',IJMAX,IJMAX_SPLIT)
+ENDIF
!
KSIZE_FULL = IIMAX_SPLIT * IJMAX_SPLIT
!
@@ -106,17 +99,18 @@ ALLOCATE(ZX_SPLIT (KSIZE_FULL))
ALLOCATE(ZY_SPLIT (KSIZE_FULL))
ALLOCATE(ZDX_SPLIT(KSIZE_FULL))
ALLOCATE(ZDY_SPLIT(KSIZE_FULL))
-#ifdef MNH_PARALLEL
- CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','XX ',SIZE(ZX),KSIZE_FULL,IIMAX,IJMAX,KHALO,ZX,ZX_SPLIT)
- CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','YY ',SIZE(ZY),KSIZE_FULL,IIMAX,IJMAX,KHALO,ZY,ZY_SPLIT)
- CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','DX ',SIZE(ZDX),KSIZE_FULL,IIMAX,IJMAX,KHALO,ZDX,ZDX_SPLIT)
- CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','DY ',SIZE(ZDY),KSIZE_FULL,IIMAX,IJMAX,KHALO,ZDY,ZDY_SPLIT)
-#else
- CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','XX ',KDIM_FULL,KSIZE_FULL,ZX,ZX_SPLIT)
- CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','YY ',KDIM_FULL,KSIZE_FULL,ZY,ZY_SPLIT)
- CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','DX ',KDIM_FULL,KSIZE_FULL,ZDX,ZDX_SPLIT)
- CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','DY ',KDIM_FULL,KSIZE_FULL,ZDY,ZDY_SPLIT)
-#endif
+!
+IF (PRESENT(KHALO)) THEN
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','XX ',SIZE(ZX),KSIZE_FULL,ZX,ZX_SPLIT,IIMAX,IJMAX,KHALO)
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','YY ',SIZE(ZY),KSIZE_FULL,ZY,ZY_SPLIT,IIMAX,IJMAX,KHALO)
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','DX ',SIZE(ZDX),KSIZE_FULL,ZDX,ZDX_SPLIT,IIMAX,IJMAX,KHALO)
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','DY ',SIZE(ZDY),KSIZE_FULL,ZDY,ZDY_SPLIT,IIMAX,IJMAX,KHALO)
+ELSE
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','XX ',KDIM_FULL,KSIZE_FULL,ZX,ZX_SPLIT)
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','YY ',KDIM_FULL,KSIZE_FULL,ZY,ZY_SPLIT)
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','DX ',KDIM_FULL,KSIZE_FULL,ZDX,ZDX_SPLIT)
+ CALL SPLIT_GRID_PARAMETERX1(HPROGRAM,'CONF PROJ ','DY ',KDIM_FULL,KSIZE_FULL,ZDY,ZDY_SPLIT)
+ENDIF
!
!
!* 3. Stores Parameters of the Grid in grid pointer
diff --git a/src/SURFEX/sso.F90 b/src/SURFEX/sso.F90
index 1efe58914b19cbeb490ab7868f2291d46d9e18fa..9f10e8a7a7cdba606f281d56f98a677d062a82ca 100644
--- a/src/SURFEX/sso.F90
+++ b/src/SURFEX/sso.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE SSO (UG, USS, &
- OSSO,OSSO_ANIS,PSEA)
+ SUBROUTINE SSO (U, UG, USS, OSSO, OSSO_ANIS)
! #########################
!
!!*SSO computes the SSO anisotropy, direction and slope
@@ -29,16 +28,23 @@
!* 0. DECLARATION
! -----------
!
+USE MODD_SURFEX_MPI, ONLY : NRANK
!
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
!
USE MODI_GET_MESH_DIM
USE MODI_GET_ADJACENT_MESHES
!
+USE MODI_GATHER_AND_WRITE_MPI
+USE MODI_READ_AND_SEND_MPI
+!
USE MODD_CSTS, ONLY : XPI
USE MODD_PGDWORK, ONLY : NSSO, XSSQO, LSSQO
-USE MODD_PGD_GRID, ONLY : NL, CGRID, XGRID_PAR, NGRID_PAR
+USE MODD_PGD_GRID, ONLY : NL, CGRID
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -50,8 +56,9 @@ IMPLICIT NONE
! ------------------------------
!
!
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
LOGICAL, DIMENSION(:), INTENT(OUT) :: OSSO ! .T. : the SSO coefficients
! ! are computed at grid point
@@ -63,11 +70,11 @@ LOGICAL, DIMENSION(:), INTENT(OUT) :: OSSO_ANIS ! .T. : the SSO anisotropy
! ! .F. : not enough sub-grid
! ! information avalaible to
! ! compute the coefficients
-REAL, DIMENSION(:), INTENT(IN) :: PSEA ! sea fraction
!
!* 0.2 Declaration of indexes
! ----------------------
!
+INTEGER :: JS1, JS2
INTEGER :: JL ! loop index on grid meshs
INTEGER :: IL ! grid mesh index of second subgrid point used
INTEGER :: JISS, JJSS ! loop indexes for subsquares arrays
@@ -82,14 +89,18 @@ INTEGER :: IMAXI ! index of the next subsquare with data along I axis,
! or last subsquare inside grid mesh along I axis
INTEGER :: IMAXJ ! index of the next subsquare with data along J axis,
! or last subsquare inside grid mesh along J axis
-INTEGER, DIMENSION(NL) :: ILEFT ! index of left grid mesh
-INTEGER, DIMENSION(NL) :: IRIGHT ! index of right grid mesh
-INTEGER, DIMENSION(NL) :: ITOP ! index of top grid mesh
-INTEGER, DIMENSION(NL) :: IBOTTOM ! index of bottom grid mesh
+INTEGER, DIMENSION(:), ALLOCATABLE :: ILEFT, IRIGHT, ITOP, IBOTTOM
+INTEGER :: ICOUNT
!
!* 0.3 Declaration of working arrays inside a MESONH grid (JI,JJ)
! -----------------------------
!
+INTEGER, DIMENSION(:), ALLOCATABLE :: ISSO, ISSOT
+INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: ISSQOT, ISSQO
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSSQO
+LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: GSSQO
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GSSO, GSSO_ANIS
+!
REAL, DIMENSION(NSSO,NSSO) :: ZDZSDX ! topographic gradient along x
REAL, DIMENSION(NSSO,NSSO) :: ZDZSDY ! topographic gradient along y
LOGICAL, DIMENSION(NSSO,NSSO) :: GDZSDX ! occurence of gradient along x
@@ -102,8 +113,8 @@ LOGICAL :: GBOUND ! .T.: first left (for dzs/dx) or first bottom (for dzs/dy)
!* 0.4 Declaration of other local variables
! ------------------------------------
!
-REAL, DIMENSION(NL) :: ZDX ! grid mesh size in x direction
-REAL, DIMENSION(NL) :: ZDY ! grid mesh size in y direction
+REAL, DIMENSION(:), ALLOCATABLE :: ZDX, ZDY, ZSEA, ZMESH_SIZE
+REAL, DIMENSION(:), ALLOCATABLE :: ZHXX0, ZHXY0, ZHYY0
REAL, DIMENSION(NL) :: ZHXX ! topographic gradient correlation tensor: x,x
REAL, DIMENSION(NL) :: ZHXY ! topographic gradient correlation tensor: x,y
REAL, DIMENSION(NL) :: ZHYY ! topographic gradient correlation tensor: y,y
@@ -116,9 +127,6 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ---------------
!
IF (LHOOK) CALL DR_HOOK('SSO',0,ZHOOK_HANDLE)
-ZK=0.
-ZL=0.
-ZM=0.
!
!* 1.1 Occurence of computation of the coefficients
! --------------------------------------------
@@ -126,77 +134,115 @@ ZM=0.
OSSO (:)=.FALSE.
OSSO_ANIS(:)=.FALSE.
!
-!
-!* 1.2 Grid dimension (meters)
-! -----------------------
-!
- CALL GET_MESH_DIM(CGRID,NGRID_PAR,NL,XGRID_PAR,ZDX,ZDY,UG%XMESH_SIZE)
-!
-!
-!* 1.3 Left, top, right and bottom adjacent gris meshes
-! ------------------------------------------------
-!
- CALL GET_ADJACENT_MESHES(CGRID,NGRID_PAR,NL,XGRID_PAR,ILEFT,IRIGHT,ITOP,IBOTTOM)
-!
-!----------------------------------------------------------------------------
-!
-!* 2. Loop on MESONH grid points
-! --------------------------
-!
ZHYY(:) = 0.
ZHXX(:) = 0.
ZHXY(:) = 0.
!
-DO JL=1,NL
-!
-!
-!* 2.1 No land in grid mesh
-! --------------------
-!
- IF (PSEA(JL)==1.) CYCLE
+!* 1.2 Grid dimension (meters)
+! -----------------------
!
+IF (NRANK==NPIO) THEN
+ ALLOCATE(ZSEA (U%NDIM_FULL))
+ ALLOCATE(ZMESH_SIZE(U%NDIM_FULL))
+ ALLOCATE(ZSSQO (U%NDIM_FULL,NSSO,NSSO))
+ ALLOCATE(ISSQOT(U%NDIM_FULL,NSSO,NSSO))
+ELSE
+ ALLOCATE(ZSEA (0))
+ ALLOCATE(ZSSQO (0,0,0))
+ ALLOCATE(ISSQOT(0,0,0))
+ENDIF
+!
+ CALL GATHER_AND_WRITE_MPI(U%XSEA,ZSEA)
+ CALL GATHER_AND_WRITE_MPI(UG%G%XMESH_SIZE,ZMESH_SIZE)
+ CALL GATHER_AND_WRITE_MPI(XSSQO,ZSSQO)
+!
+ALLOCATE(ISSQO(SIZE(XSSQO,1),NSSO,NSSO))
+IF (SIZE(ISSQO)/=0) THEN
+ ISSQO(:,:,:) = 0
+ WHERE (LSSQO(:,:,:)) ISSQO(:,:,:) = 1
+ENDIF
+ CALL GATHER_AND_WRITE_MPI(ISSQO,ISSQOT)
+DEALLOCATE(ISSQO)
+!
+IF (NRANK==NPIO) THEN
+ !
+ ALLOCATE(ZDX(U%NDIM_FULL),ZDY(U%NDIM_FULL))
+ CALL GET_MESH_DIM(CGRID,UG%NGRID_FULL_PAR,U%NDIM_FULL,UG%XGRID_FULL_PAR,ZDX,ZDY,ZMESH_SIZE)
+ DEALLOCATE(ZMESH_SIZE)
+
+ !
+ !
+ !* 1.3 Left, top, right and bottom adjacent gris meshes
+ ! ------------------------------------------------
+ !
+ ALLOCATE(ILEFT(U%NDIM_FULL),IRIGHT(U%NDIM_FULL),ITOP(U%NDIM_FULL),IBOTTOM(U%NDIM_FULL))
+ CALL GET_ADJACENT_MESHES(CGRID,UG%NGRID_FULL_PAR,U%NDIM_FULL,UG%XGRID_FULL_PAR,&
+ ILEFT,IRIGHT,ITOP,IBOTTOM)
+ !
+ ALLOCATE(GSSO(U%NDIM_FULL),GSSO_ANIS(U%NDIM_FULL))
+ ALLOCATE(ZHXX0(U%NDIM_FULL),ZHXY0(U%NDIM_FULL),ZHYY0(U%NDIM_FULL))
+ GSSO (:) = .FALSE.
+ GSSO_ANIS(:) = .FALSE.
+ ZHYY0(:) = 0.
+ ZHXX0(:) = 0.
+ ZHXY0(:) = 0.
+ !
+ !
+ !* 2. Loop on MESONH grid points
+ ! --------------------------
+ !
+ !
+ !done on the whole grid (needed because of use of near points)
+ DO JL=1,U%NDIM_FULL
+ !
+ !
+ !* 2.1 No land in grid mesh
+ ! --------------------
+ !
+ IF (ZSEA(JL)==1.) CYCLE
+ !
ZDXEFF=ZDX(JL)/FLOAT(NSSO)
ZDYEFF=ZDY(JL)/FLOAT(NSSO)
-!
-!* 2.3 Not enough data for computation
-! -------------------------------
-!
-! 1st step: removes points where orography data is not present at all.
-!
- IF ( COUNT( LSSQO(:,:,JL)) == 0 ) CYCLE
-!
-!----------------------------------------------------------------------------
-!
-!* 3. Computations of the gradients along x
-! -------------------------------------
-!
+ !
+ !* 2.3 Not enough data for computation
+ ! -------------------------------
+ !
+ ! 1st step: removes points where orography data is not present at all.
+ !
+ IF ( COUNT( ISSQOT(JL,:,:)==1) == 0 ) CYCLE
+ !
+ !----------------------------------------------------------------------------
+ !
+ !* 3. Computations of the gradients along x
+ ! -------------------------------------
+ !
GDZSDX (:,:)=.FALSE.
ZDZSDX (:,:)= 0.
-!
-!* 3.1 loop on jss index (there is no specific computation along j)
-! -----------------
-!
+ !
+ !* 3.1 loop on jss index (there is no specific computation along j)
+ ! -----------------
+ !
DO JJSS=1,NSSO
-!
-!* left point mark initialization
-!
- GBOUND=.TRUE.
-!
-!* 3.2 loop on iss index
-! -----------------
-!
+ !
+ !* left point mark initialization
+ !
+ GBOUND=.TRUE.
+ !
+ !* 3.2 loop on iss index
+ ! -----------------
+ !
DO JISS=1,NSSO
-!
-!
-!* 3.3 search for two consecutive grid points
-! --------------------------------------
-!
-!* 3.3.1 first one
-!
- IF (.NOT. LSSQO(JISS,JJSS,JL) ) CYCLE
-!
-!* 3.3.2 second one (up to one grid mesh further)
-!
+ !
+ !
+ !* 3.3 search for two consecutive grid points
+ ! --------------------------------------
+ !
+ !* 3.3.1 first one
+ !
+ IF ( ISSQOT(JL,JISS,JJSS)==0 ) CYCLE
+ !
+ !* 3.3.2 second one (up to one grid mesh further)
+ !
DO JNEXT=1,NSSO
IF (JISS+JNEXT>NSSO) THEN
IL = IRIGHT(JL)
@@ -208,33 +254,33 @@ DO JL=1,NL
! no right point
IF (IL==0) EXIT
! subgrid data found
- IF (LSSQO(INEXT,JJSS,IL)) EXIT
+ IF (ISSQOT(IL,INEXT,JJSS)==1) EXIT
END DO
-!
-!* 3.3.3 none found: end of loop along jss
-! ---------------------
-!
+ !
+ !* 3.3.3 none found: end of loop along jss
+ ! ---------------------
+ !
IF (JNEXT>=NSSO+1) EXIT
-!
-!* 3.3.4 second point outside of the domain: end of loop along iss
-! ---------------------
-!
+ !
+ !* 3.3.4 second point outside of the domain: end of loop along iss
+ ! ---------------------
+ !
IF (IL==0) EXIT
-!
-!* 3.4 dzs/dx term
-! -----------
-!
+ !
+ !* 3.4 dzs/dx term
+ ! -----------
+ !
IMAXI = MIN(JISS+JNEXT-1,NSSO)
-!
- ZDZSDX(JISS:IMAXI,JJSS) = ( XSSQO(INEXT,JJSS,IL) - XSSQO(JISS,JJSS,JL)) &
- / FLOAT(JNEXT) / ZDXEFF
-!
+ !
+ ZDZSDX(JISS:IMAXI,JJSS) = ( ZSSQO(IL,INEXT,JJSS) - ZSSQO(JL,JISS,JJSS)) &
+ / FLOAT(JNEXT) / ZDXEFF
+ !
GDZSDX(JISS:IMAXI,JJSS) = .TRUE.
-!
-!
-!* 3.5 left data point not on the left of the grid mesh (one more computation)
-! ------------------------------------------------
-!
+ !
+ !
+ !* 3.5 left data point not on the left of the grid mesh (one more computation)
+ ! ------------------------------------------------
+ !
IF (GBOUND .AND. JISS/=1) THEN
DO JPREV=1,NSSO
IF (JISS-JPREV<1) THEN
@@ -245,44 +291,44 @@ DO JL=1,NL
IPREV = JISS-JPREV
END IF
! no left point
- IF (IL==0) EXIT
+ IF (IL==0) EXIT
! subgrid data found
- IF (LSSQO(IPREV,JJSS,IL)) EXIT
+ IF (ISSQOT(IL,IPREV,JJSS)==1) EXIT
END DO
IF (.NOT. (JPREV>=NSSO+1 .OR. IL==0)) THEN
- ZDZSDX(1:JISS,JJSS) = ( XSSQO(JISS,JJSS,JL) - XSSQO(IPREV,JJSS,IL)) &
+ ZDZSDX(1:JISS,JJSS) = ( ZSSQO(JL,JISS,JJSS) - ZSSQO(IL,IPREV,JJSS)) &
/ FLOAT(JPREV) / ZDXEFF
-!
+ !
GDZSDX(1:JISS,JJSS) = .TRUE.
END IF
END IF
-!
-!
+ !
+ !
GBOUND=.FALSE.
-!
-!
-!* 3.6 end of loop on iss index
-! ------------------------
-!
+ !
+ !
+ !* 3.6 end of loop on iss index
+ ! ------------------------
+ !
END DO
-!
-!* 3.7 end of loop on jss index
-! ------------------------
-!
+ !
+ !* 3.7 end of loop on jss index
+ ! ------------------------
+ !
END DO
-!
-!----------------------------------------------------------------------------
-!
-!* 4. Computations of the gradients along y
-! -------------------------------------
-!
+ !
+ !----------------------------------------------------------------------------
+ !
+ !* 4. Computations of the gradients along y
+ ! -------------------------------------
+ !
GDZSDY (:,:)=.FALSE.
ZDZSDY (:,:)= 0.
-!
-!* 4.1 loop on iss index (there is no specific computation along i)
-! -----------------
-!
+ !
+ !* 4.1 loop on iss index (there is no specific computation along i)
+ ! -----------------
+ !
DO JISS=1,NSSO
!
!* bottom point mark initialization
@@ -300,7 +346,7 @@ DO JL=1,NL
!
!* 4.3.1 first one
!
- IF (.NOT. LSSQO(JISS,JJSS,JL) ) CYCLE
+ IF (ISSQOT(JL,JISS,JJSS)==0 ) CYCLE
!
!* 4.3.2 second one (up to one grid mesh further)
!
@@ -315,7 +361,7 @@ DO JL=1,NL
! no top point
IF (IL==0) EXIT
! subgrid data found
- IF (LSSQO(JISS,INEXT,IL)) EXIT
+ IF (ISSQOT(IL,JISS,INEXT)==1) EXIT
END DO
!
!* 4.3.3 none found: end of loop along iss
@@ -333,7 +379,7 @@ DO JL=1,NL
!
IMAXJ = MIN(JJSS+JNEXT-1,NSSO)
!
- ZDZSDY(JISS,JJSS:IMAXJ) = ( XSSQO(JISS,INEXT,IL) - XSSQO(JISS,JJSS,JL)) &
+ ZDZSDY(JISS,JJSS:IMAXJ) = ( ZSSQO(IL,JISS,INEXT) - ZSSQO(JL,JISS,JJSS)) &
/ FLOAT(JNEXT) / ZDYEFF
!
GDZSDY(JISS,JJSS:IMAXJ) = .TRUE.
@@ -354,11 +400,11 @@ DO JL=1,NL
! no left point
IF (IL==0) EXIT
! subgrid data found
- IF (LSSQO(JISS,IPREV,IL)) EXIT
+ IF (ISSQOT(IL,JISS,IPREV)==1) EXIT
END DO
IF (.NOT. (JPREV>=NSSO+1 .OR. IL==0)) THEN
- ZDZSDY(JISS,1:JJSS) = ( XSSQO(JISS,JJSS,JL) - XSSQO(JISS,IPREV,IL)) &
+ ZDZSDY(JISS,1:JJSS) = ( ZSSQO(JL,JISS,JJSS) - ZSSQO(IL,JISS,IPREV)) &
/ FLOAT(JPREV) / ZDYEFF
!
GDZSDY(JISS,1:JJSS) = .TRUE.
@@ -368,67 +414,107 @@ DO JL=1,NL
!
GBOUND=.FALSE.
!
-!
-!
-!* 4.6 end of loop on jss index
-! ------------------------
-!
+ !
+ !
+ !* 4.6 end of loop on jss index
+ ! ------------------------
+ !
END DO
-!
-!* 4.7 end of loop on iss index
-! ------------------------
-!
+ !
+ !* 4.7 end of loop on iss index
+ ! ------------------------
+ !
END DO
-!----------------------------------------------------------------------------
-!
-!* 5. Computations of tensor terms
-! ----------------------------
+ !----------------------------------------------------------------------------
+ !
+ !* 5. Computations of tensor terms
+ ! ----------------------------
+ !
+ !
+ !* 5.1 test to know if term Hxy is computable
+ ! --------------------------------------
+ !
+ ICOUNT = COUNT(GDZSDX(:,:).AND.GDZSDY(:,:))
+ !* 2 values are necessary in the grid point to compute anisotropy
+ !
+ IF ( ICOUNT==0 ) CYCLE
+ !
+ !
+ !* 5.2 SSO quantities are computable
+ ! -----------------------------
+ !
+ GSSO(JL)=.TRUE.
+ GSSO_ANIS(JL)=ICOUNT>1
+ !
+ !
+ !* 5.3 term Hxx
+ ! --------
+ !
+ ZHXX0(JL) = SUM(ZDZSDX(:,:)*ZDZSDX(:,:),MASK=GDZSDX(:,:).AND.GDZSDY(:,:))/ICOUNT
+ !
+ !* 5.4 term Hyy
+ ! --------
+ !
+ ZHYY0(JL) = SUM(ZDZSDY(:,:)*ZDZSDY(:,:),MASK=GDZSDX(:,:).AND.GDZSDY(:,:))/ICOUNT
+ !
+ !* 5.5 term Hxy
+ ! --------
+ !
+ ZHXY0(JL) = SUM(ZDZSDX(:,:)*ZDZSDY(:,:),MASK=GDZSDX(:,:).AND.GDZSDY(:,:))/ICOUNT
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !* 6. Next MESONH grid point
+ ! ----------------------
+ !
+ END DO
+ !
+ELSE
+ !
+ ALLOCATE(ZHXX0(0),ZHYY0(0),ZHXY0(0))
+ !
+ENDIF
+!
+DEALLOCATE(ZSSQO,ISSQOT)
+DEALLOCATE(ZSEA)
+!
+!each contrib sent to each task
+ CALL READ_AND_SEND_MPI(ZHXX0,ZHXX)
+ CALL READ_AND_SEND_MPI(ZHYY0,ZHYY)
+ CALL READ_AND_SEND_MPI(ZHXY0,ZHXY)
+DEALLOCATE(ZHXX0,ZHYY0,ZHXY0)
+!
+IF (NRANK==NPIO) THEN
+ ALLOCATE(ISSOT(U%NDIM_FULL))
+ ISSOT(:) = 0
+ WHERE (GSSO(:)) ISSOT(:) = 1
+ DEALLOCATE(GSSO)
+ELSE
+ ALLOCATE(ISSOT(0))
+ENDIF
+ALLOCATE(ISSO(NL))
+ CALL READ_AND_SEND_MPI(ISSOT,ISSO)
+WHERE(ISSO(:)==1) OSSO(:) = .TRUE.
+!
+IF (NRANK==NPIO) THEN
+ ISSOT(:) = 0
+ WHERE (GSSO_ANIS(:)) ISSOT(:) = 1
+ DEALLOCATE(GSSO_ANIS)
+ENDIF
+ CALL READ_AND_SEND_MPI(ISSOT,ISSO)
+WHERE(ISSO(:)==1) OSSO_ANIS(:) = .TRUE.
+DEALLOCATE(ISSO)
+!
+DEALLOCATE(ISSOT)
!
-!
-!* 5.1 test to know if term Hxy is computable
-! --------------------------------------
-!
-!* 2 values are necessary in the grid point to compute anisotropy
-!
- IF ( COUNT(GDZSDX(:,:).AND.GDZSDY(:,:)) ==0 ) CYCLE
-!
-!
-!* 5.2 SSO quantities are computable
-! -----------------------------
-
- OSSO(JL)=.TRUE.
- OSSO_ANIS(JL)=COUNT(GDZSDX(:,:).AND.GDZSDY(:,:))>1
-!
-!
-!* 5.3 term Hxx
-! --------
-!
- ZHXX(JL) = SUM(ZDZSDX(:,:)*ZDZSDX(:,:),MASK=GDZSDX(:,:).AND.GDZSDY(:,:))&
- /COUNT(GDZSDX(:,:).AND.GDZSDY(:,:))
-!
-!* 5.4 term Hyy
-! --------
-!
- ZHYY(JL) = SUM(ZDZSDY(:,:)*ZDZSDY(:,:),MASK=GDZSDX(:,:).AND.GDZSDY(:,:))&
- /COUNT(GDZSDX(:,:).AND.GDZSDY(:,:))
-!
-!* 5.5 term Hxy
-! --------
-!
- ZHXY(JL) = SUM(ZDZSDX(:,:)*ZDZSDY(:,:),MASK=GDZSDX(:,:).AND.GDZSDY(:,:))&
- /COUNT(GDZSDX(:,:).AND.GDZSDY(:,:))
-!
-!-------------------------------------------------------------------------------
-!
-!* 6. Next MESONH grid point
-! ----------------------
-!
-END DO
-!
-!-------------------------------------------------------------------------------
+!----------------------------------------------------------------------------
!
!* 7. Diagonalization of the tensor
-! -----------------------------
+! -----------------------------
+!
+ZK=0.
+ZL=0.
+ZM=0.
!
WHERE (OSSO(:))
ZK(:)=0.5*(ZHXX(:)+ZHYY(:))
diff --git a/src/SURFEX/sso_be04_frictionn.F90 b/src/SURFEX/sso_be04_frictionn.F90
index 3d08e010ba896b017267d30194f57fa7ac6a1eca..c8c3006e7b7d2dbb2a028301ceee33eef247b192 100644
--- a/src/SURFEX/sso_be04_frictionn.F90
+++ b/src/SURFEX/sso_be04_frictionn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################################
-SUBROUTINE SSO_BE04_FRICTION_n (SSCP, USS, &
- PTSTEP,PSEA,PUREF,PRHOA,PU,PV,PSFU,PSFV)
+SUBROUTINE SSO_BE04_FRICTION_n (SB, USS, PTSTEP,PSEA,PUREF,PRHOA,PU,PV,PSFU,PSFV)
! ###############################################################################
!
!!**** *SSO_BE04_FRICTION_n * - Computes subgrid-scale orography friction
@@ -34,8 +33,8 @@ SUBROUTINE SSO_BE04_FRICTION_n (SSCP, USS, &
!
!
!
-USE MODD_SSO_CANOPY_n, ONLY : SSO_CANOPY_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_CANOPY_n, ONLY : CANOPY_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_CANOPY_TURB, ONLY : XALPSBL
@@ -54,8 +53,8 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(SSO_CANOPY_t), INTENT(INOUT) :: SSCP
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
REAL, INTENT(IN) :: PTSTEP ! time step
REAL, DIMENSION(:), INTENT(IN) :: PSEA ! Sea fraction (-)
@@ -77,28 +76,25 @@ REAL, DIMENSION(SIZE(PU)) :: ZUSTAR ! friction velocity
REAL, DIMENSION(SIZE(PU)) :: ZTA ! temperature (K)
REAL, DIMENSION(SIZE(PU)) :: ZQA ! specific humidity (kg/m3)
REAL, DIMENSION(SIZE(PU)) :: ZPA ! pressure (Pa)
-REAL, DIMENSION(SIZE(PU),SSCP%NLVL) :: ZT
-REAL, DIMENSION(SIZE(PU),SSCP%NLVL) :: ZQ
-REAL, DIMENSION(SIZE(PU),SSCP%NLVL) :: ZLMO
-REAL, DIMENSION(SIZE(PU),SSCP%NLVL) :: ZLM
-REAL, DIMENSION(SIZE(PU),SSCP%NLVL) :: ZLEPS
-REAL, DIMENSION(SIZE(PU),SSCP%NLVL) :: ZP
+REAL, DIMENSION(SIZE(PU),SB%NLVL) :: ZLM
+REAL, DIMENSION(SIZE(PU),SB%NLVL) :: ZLEPS
+REAL, DIMENSION(SIZE(PU),SB%NLVL) :: ZP
REAL, DIMENSION(SIZE(PU)) :: ZSFLUX_T
REAL, DIMENSION(SIZE(PU)) :: ZSFLUX_Q
-REAL, DIMENSION(SIZE(PU),SSCP%NLVL) :: ZFORC_T
-REAL, DIMENSION(SIZE(PU),SSCP%NLVL) :: ZDFORC_TDT
-REAL, DIMENSION(SIZE(PU),SSCP%NLVL) :: ZFORC_Q
-REAL, DIMENSION(SIZE(PU),SSCP%NLVL) :: ZDFORC_QDQ
+REAL, DIMENSION(SIZE(PU),SB%NLVL) :: ZFORC_T
+REAL, DIMENSION(SIZE(PU),SB%NLVL) :: ZDFORC_TDT
+REAL, DIMENSION(SIZE(PU),SB%NLVL) :: ZFORC_Q
+REAL, DIMENSION(SIZE(PU),SB%NLVL) :: ZDFORC_QDQ
REAL, DIMENSION(SIZE(PU)) :: ZALFATH
REAL, DIMENSION(SIZE(PU)) :: ZBETATH
REAL, DIMENSION(SIZE(PU)) :: ZALFAQ
REAL, DIMENSION(SIZE(PU)) :: ZBETAQ
!
-REAL, DIMENSION(SIZE(PU), SSCP%NLVL) :: ZFORC_U ! tendency due to drag force for wind
-REAL, DIMENSION(SIZE(PU), SSCP%NLVL) :: ZDFORC_UDU ! formal derivative of
+REAL, DIMENSION(SIZE(PU), SB%NLVL) :: ZFORC_U ! tendency due to drag force for wind
+REAL, DIMENSION(SIZE(PU), SB%NLVL) :: ZDFORC_UDU ! formal derivative of
! ! tendency due to drag force for wind
-REAL, DIMENSION(SIZE(PU), SSCP%NLVL) :: ZFORC_E ! tendency due to drag force for TKE
-REAL, DIMENSION(SIZE(PU), SSCP%NLVL) :: ZDFORC_EDE ! formal derivative of
+REAL, DIMENSION(SIZE(PU), SB%NLVL) :: ZFORC_E ! tendency due to drag force for TKE
+REAL, DIMENSION(SIZE(PU), SB%NLVL) :: ZDFORC_EDE ! formal derivative of
! ! tendency due to drag force for TKE
INTEGER :: INI ! number of points
INTEGER :: JI ! number of points loop counter
@@ -121,7 +117,7 @@ IF (LHOOK) CALL DR_HOOK('SSO_BE04_FRICTION_N',0,ZHOOK_HANDLE)
INI = SIZE(PU)
!
ZH = 0.
- CALL CANOPY_GRID_UPDATE(INI,SSCP%NLVL,ZH,PUREF,SSCP%XZ,SSCP%XZF,SSCP%XDZ,SSCP%XDZF)
+ CALL CANOPY_GRID_UPDATE(INI,ZH,PUREF,SB)
!
!* 1.2 Wind
! ----
@@ -134,12 +130,12 @@ ZSFLUX_U = - SQRT(PSFU**2+PSFV**2)
!* 1.3 Canopy profiles at first time step (neutral case)
! ----------------------------------
!
-IF (ANY(SSCP%XU(:,SSCP%NLVL)==XUNDEF)) THEN
- DO JLAYER=1,SSCP%NLVL
+IF (ANY(SB%XU(:,SB%NLVL)==XUNDEF)) THEN
+ DO JLAYER=1,SB%NLVL
DO JI=1,INI
- SSCP%XU (JI,JLAYER) = MAX ( ZWIND(JI) + SQRT(-ZSFLUX_U(JI)) / XKARMAN &
- * LOG(SSCP%XZ(JI,JLAYER)/SSCP%XZ(JI,SSCP%NLVL)) , 0.)
- SSCP%XTKE(JI,JLAYER) = - XALPSBL * ZSFLUX_U(JI)
+ SB%XU (JI,JLAYER) = MAX ( ZWIND(JI) + SQRT(-ZSFLUX_U(JI)) / XKARMAN &
+ * LOG(SB%XZ(JI,JLAYER)/SB%XZ(JI,SB%NLVL)) , 0.)
+ SB%XTKE(JI,JLAYER) = - XALPSBL * ZSFLUX_U(JI)
ENDDO
ENDDO
ENDIF
@@ -159,13 +155,12 @@ ZFORC_E (:,:) = 0.
ZDFORC_EDE(:,:) = 0.
!
!* computes tendencies on wind and Tke due to subgridscale orography
- CALL SSO_BELJAARS04(USS, &
- INI,SSCP%NLVL,SSCP%XZ,ZSSO_STDEV,SSCP%XU,ZFORC_U,ZDFORC_UDU )
+ CALL SSO_BELJAARS04(USS, SB, INI, ZSSO_STDEV, ZFORC_U, ZDFORC_UDU )
!
-DO JLAYER=1,SSCP%NLVL
+DO JLAYER=1,SB%NLVL
DO JI=1,INI
- ZFORC_U (JI,SSCP%NLVL) = ZFORC_U (JI,SSCP%NLVL) * (1.0-PSEA(JI))
- ZDFORC_UDU(JI,SSCP%NLVL) = ZDFORC_UDU(JI,SSCP%NLVL) * (1.0-PSEA(JI))
+ ZFORC_U (JI,SB%NLVL) = ZFORC_U (JI,SB%NLVL) * (1.0-PSEA(JI))
+ ZDFORC_UDU(JI,SB%NLVL) = ZDFORC_UDU(JI,SB%NLVL) * (1.0-PSEA(JI))
ENDDO
ENDDO
!
@@ -179,23 +174,18 @@ ZQA (:) = XUNDEF
ZPA (:) = XUNDEF
ZSFLUX_T(:) = XUNDEF
ZSFLUX_Q(:) = XUNDEF
-ZT (:,:) = XUNDEF
-ZQ (:,:) = XUNDEF
-ZLMO (:,:) = XUNDEF
ZP (:,:) = XUNDEF
ZFORC_T (:,:) = XUNDEF
ZDFORC_TDT(:,:) = XUNDEF
ZFORC_Q (:,:) = XUNDEF
ZDFORC_QDQ(:,:) = XUNDEF
!
- CALL CANOPY_EVOL(INI, SSCP%NLVL, PTSTEP, 2, SSCP%XZ, ZWIND, ZTA, ZQA, ZPA, PRHOA, &
- ZSFLUX_U, ZSFLUX_T, ZSFLUX_Q, &
- ZFORC_U, ZDFORC_UDU, ZFORC_E, ZDFORC_EDE, &
- ZFORC_T, ZDFORC_TDT, ZFORC_Q, ZDFORC_QDQ, &
- SSCP%XZ, SSCP%XZF, SSCP%XDZ, SSCP%XDZF, SSCP%XU, SSCP%XTKE, ZT, ZQ, ZLMO, ZLM, &
- ZLEPS, ZP, ZUSTAR, &
- ZALFAU, ZBETAU, ZALFATH, ZBETATH, ZALFAQ, ZBETAQ, &
- ONEUTRAL=.TRUE. )
+ CALL CANOPY_EVOL(SB, INI, PTSTEP, 2, SB%XZ, ZWIND, ZTA, ZQA, ZPA, PRHOA, &
+ ZSFLUX_U, ZSFLUX_T, ZSFLUX_Q, ZFORC_U, ZDFORC_UDU, &
+ ZFORC_E, ZDFORC_EDE, ZFORC_T, ZDFORC_TDT, &
+ ZFORC_Q, ZDFORC_QDQ, ZLM, ZLEPS, ZUSTAR, &
+ ZALFAU, ZBETAU, ZALFATH, ZBETATH, ZALFAQ, ZBETAQ, &
+ ONEUTRAL=.TRUE. )
!
!-------------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/sso_beljaars04.F90 b/src/SURFEX/sso_beljaars04.F90
index e0268a707c4c92123c8ff1bafa661673c054dccb..17ad5a7ec511acd9ba54114ea2126461661d405e 100644
--- a/src/SURFEX/sso_beljaars04.F90
+++ b/src/SURFEX/sso_beljaars04.F90
@@ -3,13 +3,12 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###########################################################################
-SUBROUTINE SSO_BELJAARS04 (USS, &
- KI,KLVL,PZ,PSSO_STDEV,PU,PFORC_U,PDFORC_UDU)
+SUBROUTINE SSO_BELJAARS04 (USS, SB, KI, PSSO_STDEV, PFORC_U, PDFORC_UDU)
! ###############################################################################
!
!!**** *SSO_BELJAARS04_n * - prepares forcing for canopy air model
!!
-!! PURPOSE
+!! SB%XURPOSE
!! -------
!
!!** METHOD
@@ -28,8 +27,8 @@ SUBROUTINE SSO_BELJAARS04 (USS, &
!! Original 07/2006
!!---------------------------------------------------------------
!
-!
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_CANOPY_n, ONLY : CANOPY_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -38,18 +37,14 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-!
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
!
INTEGER, INTENT(IN) :: KI ! number of points
-INTEGER, INTENT(IN) :: KLVL ! number of levels in canopy
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PZ ! heights of canopy levels (m)
REAL, DIMENSION(KI), INTENT(IN) :: PSSO_STDEV! Subgrid scale orography standard dev. (m)
-
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PU ! wind for each canopy layer (m/s)
!
-REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PFORC_U ! tendency of wind due to canopy drag (m/s2)
-REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PDFORC_UDU! formal derivative of the tendency of
+REAL, DIMENSION(KI,SB%NLVL), INTENT(INOUT) :: PFORC_U ! tendency of wind due to canopy drag (m/s2)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(INOUT) :: PDFORC_UDU! formal derivative of the tendency of
! ! wind due to canopy drag (1/s)
!
!* 0.2 declarations of local variables
@@ -70,7 +65,7 @@ REAL :: C_AVAR ! = C_K1**(C_N1-C_N2) / (C_IH * C_KFLT
! ! (unit: m^{1+C_N2} = m^-1.8)
!
INTEGER :: JL ! loop counter on canopy heights
-REAL, DIMENSION(KI,KLVL) :: ZSSO_DRAG ! drag due to subgrid-scale orogaphy
+REAL, DIMENSION(KI,SB%NLVL) :: ZSSO_DRAG ! drag due to subgrid-scale orogaphy
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
@@ -80,7 +75,7 @@ IF (LHOOK) CALL DR_HOOK('SSO_BELJAARS04',0,ZHOOK_HANDLE)
!* 2. Computations of wind tendency due to orographic drag
! ----------------------------------------------------
!
- C_AVAR = C_K1**(C_N1-C_N2) / (C_IH * C_KFLT**C_N1) ! (unit: m^{1+C_N2} = m^-1.8)
+C_AVAR = C_K1**(C_N1-C_N2) / (C_IH * C_KFLT**C_N1) ! (unit: m^{1+C_N2} = m^-1.8)
!
!
!* 2.1 Drag coefficient in drag force by subscale orography
@@ -89,9 +84,9 @@ IF (LHOOK) CALL DR_HOOK('SSO_BELJAARS04',0,ZHOOK_HANDLE)
! unit : m-1 (m^-1.8 . m ^2 . m^-1.2)
!
ZSSO_DRAG = 0.
-DO JL=1,KLVL
- ZSSO_DRAG (:,JL) = USS%XCOEFBE * C_ALPHA * C_BETA * C_COR * C_CMD * 2.109 * EXP( -(PZ(:,JL)/1500.)**1.5) &
- * C_AVAR * PSSO_STDEV(:)**2 * PZ(:,JL)**(-1.2)
+DO JL=1,SB%NLVL
+ ZSSO_DRAG(:,JL) = USS%XCOEFBE * C_ALPHA * C_BETA * C_COR * C_CMD * 2.109 * &
+ EXP( -(SB%XZ(:,JL)/1500.)**1.5) * C_AVAR * PSSO_STDEV(:)**2 * SB%XZ(:,JL)**(-1.2)
END DO
!
!
@@ -100,9 +95,9 @@ END DO
!
! Ext = - Cdrag(z) * u- * u- (unit : m s-2) subscale orgraphy drag
!
-PFORC_U(:,:) = PFORC_U(:,:) - ZSSO_DRAG (:,:) * PU(:,:)**2
+PFORC_U(:,:) = PFORC_U(:,:) - ZSSO_DRAG (:,:) * SB%XU(:,:)**2
!
-PDFORC_UDU(:,:) = PDFORC_UDU(:,:) - 2. * ZSSO_DRAG (:,:) * PU(:,:)
+PDFORC_UDU(:,:) = PDFORC_UDU(:,:) - 2. * ZSSO_DRAG (:,:) * SB%XU(:,:)
!
IF (LHOOK) CALL DR_HOOK('SSO_BELJAARS04',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/sso_z0_frictionn.F90 b/src/SURFEX/sso_z0_frictionn.F90
index 816c915b2cfb5a1c25a4bee0c02fbbf22df67c30..a80cfe5edcafc422c82e6e0bf2a653dd4f187eda 100644
--- a/src/SURFEX/sso_z0_frictionn.F90
+++ b/src/SURFEX/sso_z0_frictionn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ################################################################################
-SUBROUTINE SSO_Z0_FRICTION_n (USS, &
- PSEA,PUREF,PRHOA,PU,PV,PPEW_A_COEF,PPEW_B_COEF,PSFU,PSFV)
+SUBROUTINE SSO_Z0_FRICTION_n (USS, PSEA,PUREF,PRHOA,PU,PV,PPEW_A_COEF,PPEW_B_COEF,PSFU,PSFV)
! ################################################################################
!
!!**** *SSO_Z0_FRICTION_n * - Computes subgrid-scale orography friction
@@ -38,7 +37,7 @@ SUBROUTINE SSO_Z0_FRICTION_n (USS, &
!----------------------------------------------------------------
!
!
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_REPROD_OPER, ONLY : CIMPLICIT_WIND
!
@@ -53,7 +52,7 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
REAL, DIMENSION(:), INTENT(IN) :: PSEA ! Sea fraction (-)
REAL, DIMENSION(:), INTENT(IN) :: PUREF ! Wind forcing height (m)
diff --git a/src/SURFEX/sst_update.F90 b/src/SURFEX/sst_update.F90
index d651c7884df9e4422a4543c9c833e825a44a3370..c19516a674dc680331b6fb3e73df818abdca4422 100644
--- a/src/SURFEX/sst_update.F90
+++ b/src/SURFEX/sst_update.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE SST_UPDATE (DTS, S, &
- PSST,TTIME)
+ SUBROUTINE SST_UPDATE (DTS, S, PSST)
! ###############################################################
!!**** *SST_UPDATE*
!!
@@ -47,7 +46,6 @@
USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
!
-USE MODD_TYPE_DATE_SURF
USE MODI_TEMPORAL_DISTS
USE MODI_TEMPORAL_LTS
!
@@ -64,7 +62,6 @@ IMPLICIT NONE
TYPE(DATA_SEAFLUX_t), INTENT(INOUT) :: DTS
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
!
-TYPE(DATE_TIME), INTENT(IN) :: TTIME ! UTC time
REAL, DIMENSION(:), INTENT(INOUT) :: PSST ! sst
!
!* 0.2 declarations of local variables
@@ -81,15 +78,15 @@ IF (LHOOK) CALL DR_HOOK('SST_UPDATE',0,ZHOOK_HANDLE)
IF (.NOT.S%LTZTIME_DONE) THEN
S%LTZTIME_DONE = .TRUE.
S%JSX = 1
- S%TZTIME%TDATE%YEAR = TTIME%TDATE%YEAR
- S%TZTIME%TDATE%MONTH = TTIME%TDATE%MONTH
- S%TZTIME%TDATE%DAY = TTIME%TDATE%DAY
- S%TZTIME%TIME = TTIME%TIME
+ S%TZTIME%TDATE%YEAR = S%TTIME%TDATE%YEAR
+ S%TZTIME%TDATE%MONTH = S%TTIME%TDATE%MONTH
+ S%TZTIME%TDATE%DAY = S%TTIME%TDATE%DAY
+ S%TZTIME%TIME = S%TTIME%TIME
ENDIF
!
ZSST0(:) = S%XSST_INI(:)
!
-IF ( TEMPORAL_LTS ( TTIME, DTS%TDATA_SST(1) ) ) THEN
+IF ( TEMPORAL_LTS ( S%TTIME, DTS%TDATA_SST(1) ) ) THEN
!
CALL TEMPORAL_DISTS ( DTS%TDATA_SST(1)%TDATE%YEAR,DTS%TDATA_SST(1)%TDATE%MONTH, &
DTS%TDATA_SST(1)%TDATE%DAY ,DTS%TDATA_SST(1)%TIME, &
@@ -97,8 +94,8 @@ IF ( TEMPORAL_LTS ( TTIME, DTS%TDATA_SST(1) ) ) THEN
S%TZTIME%TDATE%DAY ,S%TZTIME%TIME, &
ZSDTJX )
!
- CALL TEMPORAL_DISTS ( TTIME%TDATE%YEAR ,TTIME%TDATE%MONTH, &
- TTIME%TDATE%DAY ,TTIME%TIME, &
+ CALL TEMPORAL_DISTS ( S%TTIME%TDATE%YEAR ,S%TTIME%TDATE%MONTH, &
+ S%TTIME%TDATE%DAY ,S%TTIME%TIME, &
S%TZTIME%TDATE%YEAR ,S%TZTIME%TDATE%MONTH, &
S%TZTIME%TDATE%DAY ,S%TZTIME%TIME, &
ZDT )
@@ -107,7 +104,7 @@ IF ( TEMPORAL_LTS ( TTIME, DTS%TDATA_SST(1) ) ) THEN
!
ZSST(:)= ZSST0(:)+(DTS%XDATA_SST(:,1)-ZSST0(:))*ZALPHA
!
-ELSE IF ( .NOT. TEMPORAL_LTS ( TTIME, DTS%TDATA_SST(DTS%NTIME) ) ) THEN
+ELSE IF ( .NOT. TEMPORAL_LTS ( S%TTIME, DTS%TDATA_SST(DTS%NTIME) ) ) THEN
!
ZSST(:) = DTS%XDATA_SST(:,DTS%NTIME)
!
@@ -115,7 +112,7 @@ ELSE
!
DO
JXP = S%JSX + 1
- IF ( TEMPORAL_LTS( TTIME, DTS%TDATA_SST(JXP)) ) EXIT
+ IF ( TEMPORAL_LTS( S%TTIME, DTS%TDATA_SST(JXP)) ) EXIT
S%JSX = S%JSX + 1
ENDDO
!
@@ -125,8 +122,8 @@ ELSE
DTS%TDATA_SST(S%JSX)%TDATE%DAY ,DTS%TDATA_SST(S%JSX)%TIME, &
ZSDTJX )
!
- CALL TEMPORAL_DISTS ( TTIME%TDATE%YEAR ,TTIME%TDATE%MONTH, &
- TTIME%TDATE%DAY ,TTIME%TIME, &
+ CALL TEMPORAL_DISTS ( S%TTIME%TDATE%YEAR ,S%TTIME%TDATE%MONTH, &
+ S%TTIME%TDATE%DAY ,S%TTIME%TIME, &
DTS%TDATA_SST(S%JSX)%TDATE%YEAR,DTS%TDATA_SST(S%JSX)%TDATE%MONTH, &
DTS%TDATA_SST(S%JSX)%TDATE%DAY ,DTS%TDATA_SST(S%JSX)%TIME, &
ZDT )
diff --git a/src/SURFEX/stabfunc2.h b/src/SURFEX/stabfunc2.h
deleted file mode 100644
index c3683ff31033dd9cfe5d7b9247072b71e50bb27d..0000000000000000000000000000000000000000
--- a/src/SURFEX/stabfunc2.h
+++ /dev/null
@@ -1,4 +0,0 @@
-
-!RJ: inlined
- ERROR aa
-#error should not be used
diff --git a/src/SURFEX/start_lake_of.F90 b/src/SURFEX/start_lake_of.F90
index 313ad4fbccffdbff71df6c0e77952d549f7a8c87..0f08293016c79cdfd7efc516e9d71ebeb48b335a 100644
--- a/src/SURFEX/start_lake_of.F90
+++ b/src/SURFEX/start_lake_of.F90
@@ -58,8 +58,9 @@ USE MODI_ABOR1_SFX
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
+USE NETCDF
+!
IMPLICIT NONE
-include 'netcdf.inc'
!
!* 0.1 declarations of arguments
!
@@ -154,43 +155,43 @@ IDEPTH = ILOC_DEPTH(1)
!
!* 5. Open file for reading
!
-IRET = NF_OPEN(TRIM(ADJUSTL(CLAKELTA)),NF_NOWRITE,ID_LAKELTA)
+IRET = NF90_OPEN(TRIM(ADJUSTL(CLAKELTA)),NF90_NOWRITE,ID_LAKELTA)
IF (IRET.NE.0) CALL ABOR1_SFX("START_LAKE_OF: WRONG OR NO LAKE DATA FILE")
!
!* 6. Check data in the lake file
!
-IRET = NF_INQ_DIMID(ID_LAKELTA, "NMonth", ID_MONTH)
-IRET = NF_INQ_DIMLEN(ID_LAKELTA, ID_MONTH, IMONTHN)
+IRET = NF90_INQ_DIMID(ID_LAKELTA, "NMonth", ID_MONTH)
+IRET = NF90_INQUIRE_DIMENSION(ID_LAKELTA, ID_MONTH, LEN=IMONTHN)
IF (IMONTHN.NE.12) CALL ABOR1_SFX("START_LAKE_OF: NUMBER OF MONTHS IN THE LAKE FILE IS NOT 12????")
!
-IRET = NF_INQ_DIMID(ID_LAKELTA, "NDec", ID_DEC)
-IRET = NF_INQ_DIMLEN(ID_LAKELTA, ID_DEC, IDECN)
+IRET = NF90_INQ_DIMID(ID_LAKELTA, "NDec", ID_DEC)
+IRET = NF90_INQUIRE_DIMENSION(ID_LAKELTA, ID_DEC, LEN=IDECN)
IF (IDECN.NE.3) CALL ABOR1_SFX("START_LAKE_OF: NUMBER OF DECADES IN MONTH IN THE LAKE FILE IS NOT 3????")
!
-IRET = NF_INQ_DIMID(ID_LAKELTA, "NLon", ID_LON)
-IRET = NF_INQ_DIMLEN(ID_LAKELTA, ID_LON, ILONN)
+IRET = NF90_INQ_DIMID(ID_LAKELTA, "NLon", ID_LON)
+IRET = NF90_INQUIRE_DIMENSION(ID_LAKELTA, ID_LON, LEN=ILONN)
IF (ILONN.NE.NLONG) CALL ABOR1_SFX("START_LAKE_OF: WRONG NUMBER OF POINTS IN LONGITUDE IN THE LAKE FILE!")
!
-IRET = NF_INQ_DIMID(ID_LAKELTA, "NLat", ID_LAT)
-IRET = NF_INQ_DIMLEN(ID_LAKELTA, ID_LAT, ILATN)
+IRET = NF90_INQ_DIMID(ID_LAKELTA, "NLat", ID_LAT)
+IRET = NF90_INQUIRE_DIMENSION(ID_LAKELTA, ID_LAT, LEN=ILATN)
IF (ILATN.NE.NLATG) CALL ABOR1_SFX("START_LAKE_OF: WRONG NUMBER OF POINTS IN LONGITUDE IN THE LAKE FILE!")
!
-IRET = NF_INQ_DIMID(ID_LAKELTA, "NDepth", ID_DEPTH)
-IRET = NF_INQ_DIMLEN(ID_LAKELTA, ID_DEPTH, IDEPTHN)
+IRET = NF90_INQ_DIMID(ID_LAKELTA, "NDepth", ID_DEPTH)
+IRET = NF90_INQUIRE_DIMENSION(ID_LAKELTA, ID_DEPTH, LEN=IDEPTHN)
IF (IDEPTHN.NE.NGRADDEPTH_LTA) CALL ABOR1_SFX("START_LAKE_OF: WRONG NUMBER OF GRADATIONS IN DEPTH IN THE LAKE FILE!")
!
-IRET = NF_INQ_VARID(ID_LAKELTA, "T_snow", ID_T_SNOW)
-IRET = NF_INQ_VARID(ID_LAKELTA, "T_ice", ID_T_ICE)
-IRET = NF_INQ_VARID(ID_LAKELTA, "T_mnw", ID_T_MNW)
-IRET = NF_INQ_VARID(ID_LAKELTA, "T_wML", ID_T_WML)
-IRET = NF_INQ_VARID(ID_LAKELTA, "T_bot", ID_T_BOT)
-IRET = NF_INQ_VARID(ID_LAKELTA, "T_B1", ID_T_B1)
-IRET = NF_INQ_VARID(ID_LAKELTA, "C_T", ID_CT)
-IRET = NF_INQ_VARID(ID_LAKELTA, "h_snow", ID_H_SNOW)
-IRET = NF_INQ_VARID(ID_LAKELTA, "h_ice", ID_H_ICE)
-IRET = NF_INQ_VARID(ID_LAKELTA, "h_ML", ID_H_ML)
-IRET = NF_INQ_VARID(ID_LAKELTA, "H_B1", ID_H_B1)
-IRET = NF_INQ_VARID(ID_LAKELTA, "T_sfc", ID_T_SFC)
+IRET = NF90_INQ_VARID(ID_LAKELTA, "T_snow", ID_T_SNOW)
+IRET = NF90_INQ_VARID(ID_LAKELTA, "T_ice", ID_T_ICE)
+IRET = NF90_INQ_VARID(ID_LAKELTA, "T_mnw", ID_T_MNW)
+IRET = NF90_INQ_VARID(ID_LAKELTA, "T_wML", ID_T_WML)
+IRET = NF90_INQ_VARID(ID_LAKELTA, "T_bot", ID_T_BOT)
+IRET = NF90_INQ_VARID(ID_LAKELTA, "T_B1", ID_T_B1)
+IRET = NF90_INQ_VARID(ID_LAKELTA, "C_T", ID_CT)
+IRET = NF90_INQ_VARID(ID_LAKELTA, "h_snow", ID_H_SNOW)
+IRET = NF90_INQ_VARID(ID_LAKELTA, "h_ice", ID_H_ICE)
+IRET = NF90_INQ_VARID(ID_LAKELTA, "h_ML", ID_H_ML)
+IRET = NF90_INQ_VARID(ID_LAKELTA, "H_B1", ID_H_B1)
+IRET = NF90_INQ_VARID(ID_LAKELTA, "T_sfc", ID_T_SFC)
!
!* 7. Reading
!
@@ -200,35 +201,35 @@ NINDEX(3) = ILON
NINDEX(4) = ILAT
NINDEX(5) = IDEPTH
!
-IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_T_SNOW, '_FillValue',ZFT_SNOW)
-IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_T_ICE, '_FillValue',ZFT_ICE)
-IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_T_MNW, '_FillValue',ZFT_MNW)
-IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_T_WML, '_FillValue',ZFT_WML)
-IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_T_BOT, '_FillValue',ZFT_BOT)
-IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_T_B1, '_FillValue',ZFT_B1)
-IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_CT, '_FillValue',ZFCT)
-IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_H_SNOW, '_FillValue',ZFH_SNOW)
-IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_H_ICE, '_FillValue',ZFH_ICE)
-IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_H_ML, '_FillValue',ZFH_ML)
-IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_H_B1, '_FillValue',ZFH_B1)
-IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_T_SNOW, '_FillValue',ZFT_SFC)
-!
-IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_T_SNOW, NINDEX, ZWT_SNOW)
-IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_T_ICE, NINDEX, ZWT_ICE)
-IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_T_MNW, NINDEX, ZWT_MNW)
-IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_T_WML, NINDEX, ZWT_WML)
-IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_T_BOT, NINDEX, ZWT_BOT)
-IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_T_B1, NINDEX, ZWT_B1)
-IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_CT, NINDEX, ZWCT)
-IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_H_SNOW, NINDEX, ZWH_SNOW)
-IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_H_ICE, NINDEX, ZWH_ICE)
-IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_H_ML, NINDEX, ZWH_ML)
-IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_H_B1, NINDEX, ZWH_B1)
-IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_T_SFC, NINDEX, ZWT_SFC)
+IRET = NF90_GET_ATT(ID_LAKELTA, ID_T_SNOW, '_FillValue',ZFT_SNOW)
+IRET = NF90_GET_ATT(ID_LAKELTA, ID_T_ICE, '_FillValue',ZFT_ICE)
+IRET = NF90_GET_ATT(ID_LAKELTA, ID_T_MNW, '_FillValue',ZFT_MNW)
+IRET = NF90_GET_ATT(ID_LAKELTA, ID_T_WML, '_FillValue',ZFT_WML)
+IRET = NF90_GET_ATT(ID_LAKELTA, ID_T_BOT, '_FillValue',ZFT_BOT)
+IRET = NF90_GET_ATT(ID_LAKELTA, ID_T_B1, '_FillValue',ZFT_B1)
+IRET = NF90_GET_ATT(ID_LAKELTA, ID_CT, '_FillValue',ZFCT)
+IRET = NF90_GET_ATT(ID_LAKELTA, ID_H_SNOW, '_FillValue',ZFH_SNOW)
+IRET = NF90_GET_ATT(ID_LAKELTA, ID_H_ICE, '_FillValue',ZFH_ICE)
+IRET = NF90_GET_ATT(ID_LAKELTA, ID_H_ML, '_FillValue',ZFH_ML)
+IRET = NF90_GET_ATT(ID_LAKELTA, ID_H_B1, '_FillValue',ZFH_B1)
+IRET = NF90_GET_ATT(ID_LAKELTA, ID_T_SNOW, '_FillValue',ZFT_SFC)
+!
+IRET = NF90_GET_VAR(ID_LAKELTA, ID_T_SNOW, ZWT_SNOW, NINDEX)
+IRET = NF90_GET_VAR(ID_LAKELTA, ID_T_ICE, ZWT_ICE, NINDEX)
+IRET = NF90_GET_VAR(ID_LAKELTA, ID_T_MNW, ZWT_MNW, NINDEX)
+IRET = NF90_GET_VAR(ID_LAKELTA, ID_T_WML, ZWT_WML, NINDEX)
+IRET = NF90_GET_VAR(ID_LAKELTA, ID_T_BOT, ZWT_BOT, NINDEX)
+IRET = NF90_GET_VAR(ID_LAKELTA, ID_T_B1, ZWT_B1, NINDEX)
+IRET = NF90_GET_VAR(ID_LAKELTA, ID_CT, ZWCT, NINDEX)
+IRET = NF90_GET_VAR(ID_LAKELTA, ID_H_SNOW, ZWH_SNOW, NINDEX)
+IRET = NF90_GET_VAR(ID_LAKELTA, ID_H_ICE, ZWH_ICE, NINDEX)
+IRET = NF90_GET_VAR(ID_LAKELTA, ID_H_ML, ZWH_ML, NINDEX)
+IRET = NF90_GET_VAR(ID_LAKELTA, ID_H_B1, ZWH_B1, NINDEX)
+IRET = NF90_GET_VAR(ID_LAKELTA, ID_T_SFC, ZWT_SFC, NINDEX)
!
!* 8. Close file
!
-IRET = NF_CLOSE(ID_LAKELTA)
+IRET = NF90_CLOSE(ID_LAKELTA)
!
!* 9. Make output
!
diff --git a/src/SURFEX/stores_hvac_autosize.F90 b/src/SURFEX/stores_hvac_autosize.F90
index 7b9753682285a23c00bdf5d5080eaa100c0b79e1..72007a2267b1bb79f8e62252a154ead608f75820 100644
--- a/src/SURFEX/stores_hvac_autosize.F90
+++ b/src/SURFEX/stores_hvac_autosize.F90
@@ -38,9 +38,6 @@
!* 0. DECLARATIONS
! ------------
!
-!
-!
-!
USE MODD_BEM_n, ONLY : BEM_t
USE MODD_BEM_OPTION_n, ONLY : BEM_OPTIONS_t
USE MODD_DATA_BEM_n, ONLY : DATA_BEM_t
@@ -81,19 +78,19 @@ IF (LHOOK) CALL DR_HOOK('STORES_HVAC_AUTOSIZE',0,ZHOOK_HANDLE)
!* stores the real systems characteristics in physiographic data
! for further use
!
-IL = SIZE(B%CUR%XM_SYS_RAT)
+IL = SIZE(B%XM_SYS_RAT)
!
DTB%LDATA_M_SYS_RAT = .TRUE.
ALLOCATE(DTB%XPAR_M_SYS_RAT(IL))
-DTB%XPAR_M_SYS_RAT = B%CUR%XM_SYS_RAT
+DTB%XPAR_M_SYS_RAT = B%XM_SYS_RAT
!
DTB%LDATA_CAP_SYS_RAT = .TRUE.
ALLOCATE(DTB%XPAR_CAP_SYS_RAT(IL))
-DTB%XPAR_CAP_SYS_RAT = B%CUR%XCAP_SYS_RAT
+DTB%XPAR_CAP_SYS_RAT = B%XCAP_SYS_RAT
!
DTB%LDATA_CAP_SYS_HEAT = .TRUE.
ALLOCATE(DTB%XPAR_CAP_SYS_HEAT(IL))
-DTB%XPAR_CAP_SYS_HEAT = B%CUR%XCAP_SYS_HEAT
+DTB%XPAR_CAP_SYS_HEAT = B%XCAP_SYS_HEAT
!
BOP%LAUTOSIZE = .FALSE.
DTB%LDATA_T_SIZE_MIN = .FALSE.
diff --git a/src/SURFEX/subscale_aos.F90 b/src/SURFEX/subscale_aos.F90
index 9cfb539d7d5950b28d6685b6ef73db415ac1c841..bb4b1fd3d8b8928864f5ccffb1caed34c7acee16 100644
--- a/src/SURFEX/subscale_aos.F90
+++ b/src/SURFEX/subscale_aos.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE SUBSCALE_AOS (UG, USS, &
- OZ0EFFI,OZ0EFFJ,PSEA)
+ SUBROUTINE SUBSCALE_AOS (U, UG, USS, OZ0EFFI, OZ0EFFJ)
! #############################################
!
!!*SUBSCALE_AOS computes the sum of the ratio: (h'-h)/L when h'/L >h/L
@@ -39,15 +38,17 @@
!* 0. DECLARATION
! -----------
!
-!
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
USE MODD_PGDWORK, ONLY : NSSO, XSSQO, LSSQO
-USE MODD_PGD_GRID, ONLY : NL, CGRID, XGRID_PAR, NGRID_PAR
+USE MODD_PGD_GRID, ONLY : NL
!
USE MODI_GET_ADJACENT_MESHES
-!
+USE MODI_READ_AND_SEND_MPI
+USE MODI_GATHER_AND_WRITE_MPI
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -58,9 +59,9 @@ IMPLICIT NONE
!* 0.1 Declaration of dummy arguments
! ------------------------------
!
-!
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
LOGICAL, DIMENSION(:), INTENT(OUT) :: OZ0EFFI! .T. : the z0eff coefficients
! ! are computed at grid point
@@ -72,23 +73,21 @@ LOGICAL, DIMENSION(:), INTENT(OUT) :: OZ0EFFJ! .T. : the z0eff coefficients
! ! .F. : not enough sub-grid
! ! information avalaible to
! ! compute the coefficients
-REAL, DIMENSION(:), INTENT(IN) :: PSEA ! sea fraction
-
!
!* 0.2 Declaration of indexes
! ----------------------
!
-!
+INTEGER :: JS1, JS2
INTEGER :: JL ! loop index on grid meshs
INTEGER :: IL ! grid mesh index of second subgrid point used
INTEGER :: JISS, JJSS ! loop indexes for subsquares arrays
INTEGER :: JNEXT ! loop index on subgrid meshes
INTEGER :: INEXT ! index to add to JISS or JJSS to obtain the following
! ! point containing a data in a segment
-INTEGER, DIMENSION(NL) :: ILEFT ! index of left grid mesh
-INTEGER, DIMENSION(NL) :: IRIGHT ! index of right grid mesh
-INTEGER, DIMENSION(NL) :: ITOP ! index of top grid mesh
-INTEGER, DIMENSION(NL) :: IBOTTOM ! index of bottom grid mesh
+INTEGER, DIMENSION(:), ALLOCATABLE :: ILEFT ! index of left grid mesh
+INTEGER, DIMENSION(:), ALLOCATABLE :: IRIGHT ! index of right grid mesh
+INTEGER, DIMENSION(:), ALLOCATABLE :: ITOP ! index of top grid mesh
+INTEGER, DIMENSION(:), ALLOCATABLE :: IBOTTOM ! index of bottom grid mesh
!
!* 0.3 Declaration of counters inside a grid (JL)
! -----------------------
@@ -125,10 +124,15 @@ REAL :: ZDYEFF ! width of a subsquare along J axis
!* 0.5 Declaration of other local variables
! ------------------------------------
!
-REAL, DIMENSION(NL) :: ZDX ! grid mesh size in x direction
-REAL, DIMENSION(NL) :: ZDY ! grid mesh size in y direction
-REAL, DIMENSION(0:NL) :: ZSLOPEIP ! x mean slope
-REAL, DIMENSION(0:NL) :: ZSLOPEJP ! y mean slope
+INTEGER, DIMENSION(:), ALLOCATABLE :: ISSO, ISSOT
+INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: ISSQOT, ISSQO
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSSQO
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GZ0EFFI, GZ0EFFJ
+REAL, DIMENSION(:), ALLOCATABLE :: ZDX, ZDY, ZSEA, ZAVG_ZS, ZMESH_SIZE ! grid mesh size in x direction
+REAL, DIMENSION(:), ALLOCATABLE :: ZAOSIP_ALL, ZAOSIM_ALL, ZAOSJP_ALL, ZAOSJM_ALL
+REAL, DIMENSION(:), ALLOCATABLE :: ZHO2IP_ALL, ZHO2IM_ALL, ZHO2JP_ALL, ZHO2JM_ALL
+REAL :: ZSLOPEIP ! x mean slope
+REAL :: ZSLOPEJP ! y mean slope
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
!
@@ -142,54 +146,90 @@ IF (LHOOK) CALL DR_HOOK('SUBSCALE_AOS',0,ZHOOK_HANDLE)
OZ0EFFI(:)=.FALSE.
OZ0EFFJ(:)=.FALSE.
!
+IF (NRANK==NPIO) THEN
+ ALLOCATE(ZSEA (U%NDIM_FULL))
+ ALLOCATE(ZAVG_ZS (U%NDIM_FULL))
+ ALLOCATE(ZMESH_SIZE(U%NDIM_FULL))
+ ALLOCATE(ISSQOT(U%NDIM_FULL,NSSO,NSSO))
+ ALLOCATE(ZSSQO (U%NDIM_FULL,NSSO,NSSO))
+ELSE
+ ALLOCATE(ZSEA (0))
+ ALLOCATE(ZAVG_ZS (0))
+ ALLOCATE(ISSQOT(0,0,0))
+ ALLOCATE(ZSSQO (0,0,0))
+ENDIF
+!
+ CALL GATHER_AND_WRITE_MPI(U%XSEA,ZSEA)
+ CALL GATHER_AND_WRITE_MPI(USS%XAVG_ZS,ZAVG_ZS)
+ CALL GATHER_AND_WRITE_MPI(UG%G%XMESH_SIZE,ZMESH_SIZE)
+ CALL GATHER_AND_WRITE_MPI(XSSQO,ZSSQO)
+!
+ALLOCATE(ISSQO(SIZE(XSSQO,1),NSSO,NSSO))
+ISSQO(:,:,:) = 0
+WHERE (LSSQO(:,:,:)) ISSQO(:,:,:) = 1
+ CALL GATHER_AND_WRITE_MPI(ISSQO,ISSQOT)
+DEALLOCATE(ISSQO)
+!
!* 1.2 Grid dimension (meters)
! -----------------------
!
- CALL GET_MESH_DIM(CGRID,NGRID_PAR,NL,XGRID_PAR,ZDX,ZDY,UG%XMESH_SIZE)
-!
-!
-!* 1.3 Left, top, right and bottom adjacent gris meshes
-! ------------------------------------------------
-!
- CALL GET_ADJACENT_MESHES(CGRID,NGRID_PAR,NL,XGRID_PAR,ILEFT,IRIGHT,ITOP,IBOTTOM)
-!
-!
-!* 1.4 Mean slopes between 2 grid meshes
-! -----------
-!
-ZSLOPEIP(0) = 0.
-ZSLOPEJP(0) = 0.
-!
-DO JL=1,NL
- IF (IRIGHT(JL)/=0 .AND. ILEFT(JL)/=0) THEN
- ZSLOPEIP(JL) = 0.5 * ( USS%XAVG_ZS(IRIGHT(JL)) - USS%XAVG_ZS(JL) ) &
- / ( 0.5 * (ZDX(IRIGHT(JL)) + ZDX(JL)) ) &
- + 0.5 * ( USS%XAVG_ZS(JL) - USS%XAVG_ZS(ILEFT (JL)) ) &
- / ( 0.5 * (ZDX(JL) + ZDX(ILEFT(JL))) )
- ELSE
- ZSLOPEIP(JL) = 0.
- END IF
- IF (ITOP(JL)/=0 .AND. IBOTTOM(JL)/=0) THEN
- ZSLOPEJP(JL) = 0.5 * ( USS%XAVG_ZS(ITOP(JL)) - USS%XAVG_ZS(JL) ) &
- / ( 0.5 * (ZDY(ITOP(JL)) + ZDY(JL)) ) &
- + 0.5 * ( USS%XAVG_ZS(JL) - USS%XAVG_ZS(IBOTTOM (JL)) ) &
- / ( 0.5 * (ZDY(JL) + ZDY(IBOTTOM(JL))) )
- ELSE
- ZSLOPEJP(JL) = 0.
- END IF
-END DO
+IF (NRANK==NPIO) THEN
+ !
+ ALLOCATE(ZDX(U%NDIM_FULL),ZDY(U%NDIM_FULL))
+ CALL GET_MESH_DIM(UG%G%CGRID,UG%NGRID_FULL_PAR,U%NDIM_FULL,UG%XGRID_FULL_PAR,ZDX,ZDY,ZMESH_SIZE)
+ DEALLOCATE(ZMESH_SIZE)
+ !
+ !
+ !* 1.3 Left, top, right and bottom adjacent gris meshes
+ ! ------------------------------------------------
+ !
+ ALLOCATE(ILEFT(U%NDIM_FULL),IRIGHT(U%NDIM_FULL),ITOP(U%NDIM_FULL),IBOTTOM(U%NDIM_FULL))
+ CALL GET_ADJACENT_MESHES(UG%G%CGRID,UG%NGRID_FULL_PAR,U%NDIM_FULL,UG%XGRID_FULL_PAR,&
+ ILEFT,IRIGHT,ITOP,IBOTTOM)
+ !
+ ALLOCATE(GZ0EFFI(U%NDIM_FULL),GZ0EFFJ(U%NDIM_FULL))
+ ALLOCATE(ZHO2IM_ALL(U%NDIM_FULL),ZHO2IP_ALL(U%NDIM_FULL),&
+ ZAOSIM_ALL(U%NDIM_FULL),ZAOSIP_ALL(U%NDIM_FULL))
+ ALLOCATE(ZHO2JM_ALL(U%NDIM_FULL),ZHO2JP_ALL(U%NDIM_FULL),&
+ ZAOSJM_ALL(U%NDIM_FULL),ZAOSJP_ALL(U%NDIM_FULL))
+ GZ0EFFI(:) = .FALSE.
+ GZ0EFFJ(:) = .FALSE.
+ !
+ !* 1.4 Mean slopes between 2 grid meshes
+ ! -----------
+ !
+ !
+ DO JL=1,U%NDIM_FULL
+ !
+ ZSLOPEIP = 0.
+ ZSLOPEJP = 0.
+ !
+ IF (IRIGHT(JL)/=0 .AND. ILEFT(JL)/=0) THEN
+ ZSLOPEIP = 0.5 * ( ZAVG_ZS(IRIGHT(JL)) - ZAVG_ZS(JL) ) &
+ / ( 0.5 * (ZDX(IRIGHT(JL)) + ZDX(JL)) ) &
+ + 0.5 * ( ZAVG_ZS(JL) - ZAVG_ZS(ILEFT (JL)) ) &
+ / ( 0.5 * (ZDX(JL) + ZDX(ILEFT(JL))) )
+ ELSE
+ ZSLOPEIP = 0.
+ END IF
+ IF (ITOP(JL)/=0 .AND. IBOTTOM(JL)/=0) THEN
+ ZSLOPEJP = 0.5 * ( ZAVG_ZS(ITOP(JL)) - ZAVG_ZS(JL) ) &
+ / ( 0.5 * (ZDY(ITOP(JL)) + ZDY(JL)) ) &
+ + 0.5 * ( ZAVG_ZS(JL) - ZAVG_ZS(IBOTTOM (JL)) ) &
+ / ( 0.5 * (ZDY(JL) + ZDY(IBOTTOM(JL))) )
+ ELSE
+ ZSLOPEJP = 0.
+ END IF
!
!----------------------------------------------------------------------------
!
!* 2. Loop on grid points
! -------------------
-!
-DO JL=1,NL
-!
+!!
!* 2.1 No land in grid mesh
! --------------------
!
- IF (PSEA(JL)==1.) CYCLE
+ IF (ZSEA(JL)==1.) CYCLE
!
!* 2.2 Index Initializations
! ---------------------
@@ -232,7 +272,7 @@ DO JL=1,NL
!
!* 3.3.1 first one
!
- IF (.NOT. LSSQO(JISS,JJSS,JL) ) CYCLE
+ IF (ISSQOT(JL,JISS,JJSS)==0 ) CYCLE
!
!* 3.3.2 second one (up to one grid mesh further)
!
@@ -247,7 +287,7 @@ DO JL=1,NL
! no right point
IF (IL==0) EXIT
! subgrid data found
- IF (LSSQO(INEXT,JJSS,IL)) EXIT
+ IF (ISSQOT(IL,INEXT,JJSS)==1) EXIT
END DO
!
!* 3.3.3 none found: end of loop along jss
@@ -269,11 +309,11 @@ DO JL=1,NL
!
!* 3.4.1 mean slope
!
- ZSLOPE=ZSLOPEIP(JL)
+ ZSLOPE=ZSLOPEIP
!
!* 3.4.2 A/S term
!
- ZSSAOS = XSSQO(INEXT,JJSS,IL) - XSSQO(JISS,JJSS,JL) &
+ ZSSAOS = ZSSQO(IL,INEXT,JJSS) - ZSSQO(JL,JISS,JJSS) &
- ZSLOPE * ZDXEFF * JNEXT
IF (ZSSAOS>0.) ZAIP=ZAIP+ZSSAOS
IF (ZSSAOS<0.) ZAIM=ZAIM-ZSSAOS
@@ -307,19 +347,19 @@ DO JL=1,NL
! -----------------------------
!
IF (IAOSCOUNTER>0) THEN
- USS%XAOSIP(JL)=SUM(ZAOSIP) / IAOSCOUNTER
- USS%XAOSIM(JL)=SUM(ZAOSIM) / IAOSCOUNTER
+ ZAOSIP_ALL(JL)=SUM(ZAOSIP) / IAOSCOUNTER
+ ZAOSIM_ALL(JL)=SUM(ZAOSIM) / IAOSCOUNTER
IF (IHO2COUNTERIP>0) THEN
- USS%XHO2IP(JL)=ZSUMHO2IP / IHO2COUNTERIP
+ ZHO2IP_ALL(JL)=ZSUMHO2IP / IHO2COUNTERIP
ELSE
- USS%XHO2IP(JL)=0.
+ ZHO2IP_ALL(JL)=0.
END IF
IF (IHO2COUNTERIM>0) THEN
- USS%XHO2IM(JL)=ZSUMHO2IM / IHO2COUNTERIM
+ ZHO2IM_ALL(JL)=ZSUMHO2IM / IHO2COUNTERIM
ELSE
- USS%XHO2IM(JL)=0.
+ ZHO2IM_ALL(JL)=0.
END IF
- OZ0EFFI(JL)=.TRUE.
+ GZ0EFFI(JL)=.TRUE.
END IF
!
!----------------------------------------------------------------------------
@@ -357,7 +397,7 @@ DO JL=1,NL
!
!* 4.3.1 first one
!
- IF (.NOT. LSSQO(JISS,JJSS,JL) ) CYCLE
+ IF (ISSQOT(JL,JISS,JJSS)==0 ) CYCLE
!
!* 4.3.2 second one (up to one grid mesh further)
!
@@ -372,7 +412,7 @@ DO JL=1,NL
! no right point
IF (IL==0) EXIT
! subgrid data found
- IF (LSSQO(JISS,INEXT,IL)) EXIT
+ IF (ISSQOT(IL,JISS,INEXT)==1) EXIT
END DO
!
!* 4.3.3 none found: end of loop along jss
@@ -395,11 +435,11 @@ DO JL=1,NL
!
!* 4.4.1 mean slope
!
- ZSLOPE=ZSLOPEJP(JL)
+ ZSLOPE=ZSLOPEJP
!
!* 4.4.2 A/S term
!
- ZSSAOS = XSSQO(JISS,INEXT,IL) - XSSQO(JISS,JJSS,JL) &
+ ZSSAOS = ZSSQO(IL,JISS,INEXT) - ZSSQO(JL,JISS,JJSS) &
- ZSLOPE * ZDYEFF * JNEXT
IF (ZSSAOS>0.) ZAJP=ZAJP+ZSSAOS
IF (ZSSAOS<0.) ZAJM=ZAJM-ZSSAOS
@@ -433,27 +473,73 @@ DO JL=1,NL
! -----------------------------
!
IF (IAOSCOUNTER>0) THEN
- USS%XAOSJP(JL)=SUM(ZAOSJP) /IAOSCOUNTER
- USS%XAOSJM(JL)=SUM(ZAOSJM) /IAOSCOUNTER
+ ZAOSJP_ALL(JL)=SUM(ZAOSJP) /IAOSCOUNTER
+ ZAOSJM_ALL(JL)=SUM(ZAOSJM) /IAOSCOUNTER
IF (IHO2COUNTERJP>0) THEN
- USS%XHO2JP(JL)=ZSUMHO2JP /IHO2COUNTERJP
+ ZHO2JP_ALL(JL)=ZSUMHO2JP /IHO2COUNTERJP
ELSE
- USS%XHO2JP(JL)=0.
+ ZHO2JP_ALL(JL)=0.
END IF
IF (IHO2COUNTERJM>0) THEN
- USS%XHO2JM(JL)=ZSUMHO2JM /IHO2COUNTERJM
+ ZHO2JM_ALL(JL)=ZSUMHO2JM /IHO2COUNTERJM
ELSE
- USS%XHO2JM(JL)=0.
+ ZHO2JM_ALL(JL)=0.
END IF
- OZ0EFFJ(JL)=.TRUE.
+ GZ0EFFJ(JL)=.TRUE.
END IF
+!
+ END DO
+ !
+ELSE
+ ALLOCATE(ZHO2IM_ALL(0),ZHO2IP_ALL(0),ZAOSIM_ALL(0),ZAOSIP_ALL(0))
+ ALLOCATE(ZHO2JM_ALL(0),ZHO2JP_ALL(0),ZAOSJM_ALL(0),ZAOSJP_ALL(0))
+ENDIF
+!
+DEALLOCATE(ZSSQO,ISSQOT)
+DEALLOCATE(ZSEA)
+DEALLOCATE(ZAVG_ZS)
+!
+ CALL READ_AND_SEND_MPI(ZAOSIP_ALL,USS%XAOSIP)
+ CALL READ_AND_SEND_MPI(ZAOSIM_ALL,USS%XAOSIM)
+ CALL READ_AND_SEND_MPI(ZHO2IP_ALL,USS%XHO2IP)
+ CALL READ_AND_SEND_MPI(ZHO2IM_ALL,USS%XHO2IM)
+DEALLOCATE(ZHO2IM_ALL,ZHO2IP_ALL,ZAOSIM_ALL,ZAOSIP_ALL)
+!
+ CALL READ_AND_SEND_MPI(ZAOSJP_ALL,USS%XAOSJP)
+ CALL READ_AND_SEND_MPI(ZAOSJM_ALL,USS%XAOSJM)
+ CALL READ_AND_SEND_MPI(ZHO2JP_ALL,USS%XHO2JP)
+ CALL READ_AND_SEND_MPI(ZHO2JM_ALL,USS%XHO2JM)
+DEALLOCATE(ZHO2JM_ALL,ZHO2JP_ALL,ZAOSJM_ALL,ZAOSJP_ALL)
+!
+IF (NRANK==NPIO) THEN
+ ALLOCATE(ISSOT(U%NDIM_FULL))
+ ISSOT(:) = 0
+ WHERE (GZ0EFFI(:)) ISSOT(:) = 1
+ DEALLOCATE(GZ0EFFI)
+ELSE
+ ALLOCATE(ISSOT(0))
+ENDIF
+ALLOCATE(ISSO(NL))
+ CALL READ_AND_SEND_MPI(ISSOT,ISSO)
+WHERE(ISSO(:)==1) OZ0EFFI(:) = .TRUE.
+!
+IF (NRANK==NPIO) THEN
+ ISSOT(:) = 0
+ WHERE (GZ0EFFJ(:)) ISSOT(:) = 1
+ DEALLOCATE(GZ0EFFJ)
+ENDIF
+ CALL READ_AND_SEND_MPI(ISSOT,ISSO)
+WHERE(ISSO(:)==1) OZ0EFFJ(:) = .TRUE.
+DEALLOCATE(ISSO)
+!
+DEALLOCATE(ISSOT)
!
!-------------------------------------------------------------------------------
!
!* 5. Next grid point
! ---------------
!
-END DO
+
IF (LHOOK) CALL DR_HOOK('SUBSCALE_AOS',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/subscale_z0eff.F90 b/src/SURFEX/subscale_z0eff.F90
index a2bf3d46ebd8209eb7e5902e6497a64d295be4f9..9d84604efa67e9ff006063ad742a7780d6fb766d 100644
--- a/src/SURFEX/subscale_z0eff.F90
+++ b/src/SURFEX/subscale_z0eff.F90
@@ -2,99 +2,8 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
-! ##########################
- MODULE MODI_SUBSCALE_Z0EFF
-! ##########################
-INTERFACE SUBSCALE_Z0EFF
- SUBROUTINE SUBSCALE_Z0EFF_1D_NVEG(PAOSIP,PAOSIM,PAOSJP,PAOSJM, &
- PHO2IP,PHO2IM,PHO2JP,PHO2JM,PZ0VEG, &
- PZ0EFFIP,PZ0EFFIM,PZ0EFFJP,PZ0EFFJM, &
- PZ0REL,OMASK )
-!
-REAL, DIMENSION(:), INTENT(IN) :: PAOSIP ! A/S for increasing x
-REAL, DIMENSION(:), INTENT(IN) :: PAOSIM ! A/S for decreasing x
-REAL, DIMENSION(:), INTENT(IN) :: PAOSJP ! A/S for increasing y
-REAL, DIMENSION(:), INTENT(IN) :: PAOSJM ! A/S for decreasing y
-REAL, DIMENSION(:), INTENT(IN) :: PHO2IP ! h/2 for increasing x
-REAL, DIMENSION(:), INTENT(IN) :: PHO2IM ! h/2 for decreasing x
-REAL, DIMENSION(:), INTENT(IN) :: PHO2JP ! h/2 for increasing y
-REAL, DIMENSION(:), INTENT(IN) :: PHO2JM ! h/2 for decreasing y
-REAL, INTENT(IN) :: PZ0VEG ! vegetation roughness length
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFIP! roughness length for increasing x
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFIM! roughness length for decreasing x
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFJP! roughness length for increasing y
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFJM! roughness length for decreasing y
-!
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PZ0REL ! roughness length
-! ! of SSO only
-LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL :: OMASK ! mask where computations
- ! are done
-!
-END SUBROUTINE SUBSCALE_Z0EFF_1D_NVEG
-!
- SUBROUTINE SUBSCALE_Z0EFF_1D_BIS(PAOSIP,PAOSIM,PAOSJP,PAOSJM, &
- PHO2IP,PHO2IM,PHO2JP,PHO2JM,PZ0VEG, &
- PZ0EFFIP,PZ0EFFIM,PZ0EFFJP,PZ0EFFJM, &
- PZ0REL,OMASK )
-!
-REAL, DIMENSION(:), INTENT(IN) :: PAOSIP ! A/S for increasing x
-REAL, DIMENSION(:), INTENT(IN) :: PAOSIM ! A/S for decreasing x
-REAL, DIMENSION(:), INTENT(IN) :: PAOSJP ! A/S for increasing y
-REAL, DIMENSION(:), INTENT(IN) :: PAOSJM ! A/S for decreasing y
-REAL, DIMENSION(:), INTENT(IN) :: PHO2IP ! h/2 for increasing x
-REAL, DIMENSION(:), INTENT(IN) :: PHO2IM ! h/2 for decreasing x
-REAL, DIMENSION(:), INTENT(IN) :: PHO2JP ! h/2 for increasing y
-REAL, DIMENSION(:), INTENT(IN) :: PHO2JM ! h/2 for decreasing y
-REAL, DIMENSION(:), INTENT(IN) :: PZ0VEG ! vegetation roughness length
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFIP! roughness length for increasing x
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFIM! roughness length for decreasing x
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFJP! roughness length for increasing y
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFJM! roughness length for decreasing y
-!
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PZ0REL ! roughness length
-! ! of SSO only
-LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL :: OMASK ! mask where computations
- ! are done
-!
-END SUBROUTINE SUBSCALE_Z0EFF_1D_BIS
-
-SUBROUTINE SUBSCALE_Z0EFF_1D_PATCH(PAOSIP,PAOSIM,PAOSJP,PAOSJM, &
- PHO2IP,PHO2IM,PHO2JP,PHO2JM,PZ0VEG, &
- PZ0EFFIP,PZ0EFFIM,PZ0EFFJP,PZ0EFFJM, &
- PZ0REL,OMASK )
-!
-REAL, DIMENSION(:), INTENT(IN) :: PAOSIP ! A/S for increasing x
-REAL, DIMENSION(:), INTENT(IN) :: PAOSIM ! A/S for decreasing x
-REAL, DIMENSION(:), INTENT(IN) :: PAOSJP ! A/S for increasing y
-REAL, DIMENSION(:), INTENT(IN) :: PAOSJM ! A/S for decreasing y
-REAL, DIMENSION(:), INTENT(IN) :: PHO2IP ! h/2 for increasing x
-REAL, DIMENSION(:), INTENT(IN) :: PHO2IM ! h/2 for decreasing x
-REAL, DIMENSION(:), INTENT(IN) :: PHO2JP ! h/2 for increasing y
-REAL, DIMENSION(:), INTENT(IN) :: PHO2JM ! h/2 for decreasing y
-REAL, DIMENSION(:,:), INTENT(IN) :: PZ0VEG ! vegetation roughness length
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZ0EFFIP! roughness length for increasing x
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZ0EFFIM! roughness length for decreasing x
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZ0EFFJP! roughness length for increasing y
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZ0EFFJM! roughness length for decreasing y
-!
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PZ0REL ! roughness length
-! ! of SSO only
-LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL :: OMASK ! mask where computations
- ! are done
-!
-END SUBROUTINE SUBSCALE_Z0EFF_1D_PATCH
-
-END INTERFACE
-!
-END MODULE MODI_SUBSCALE_Z0EFF
-! ######################################################################
- SUBROUTINE SUBSCALE_Z0EFF_1D_NVEG(PAOSIP,PAOSIM,PAOSJP,PAOSJM, &
- PHO2IP,PHO2IM,PHO2JP,PHO2JM,PZ0VEG, &
- PZ0EFFIP,PZ0EFFIM,PZ0EFFJP,PZ0EFFJM, &
- PZ0REL,OMASK )
+! ######spl
+ SUBROUTINE SUBSCALE_Z0EFF(ISSK,PZ0VEG,OZ0REL,OMASK )
! ######################################################################
!
!!*SUBSCALE_Z0EFF computes an effective roughness lenght deduced
@@ -131,118 +40,13 @@ END MODULE MODI_SUBSCALE_Z0EFF
!* 0. DECLARATION
! -----------
!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE MODI_SUBSCALE_Z0EFF_1D
-USE MODI_Z0REL_1D
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of dummy arguments
-! ------------------------------
-!
-REAL, DIMENSION(:), INTENT(IN) :: PAOSIP ! A/S for increasing x
-REAL, DIMENSION(:), INTENT(IN) :: PAOSIM ! A/S for decreasing x
-REAL, DIMENSION(:), INTENT(IN) :: PAOSJP ! A/S for increasing y
-REAL, DIMENSION(:), INTENT(IN) :: PAOSJM ! A/S for decreasing y
-REAL, DIMENSION(:), INTENT(IN) :: PHO2IP ! h/2 for increasing x
-REAL, DIMENSION(:), INTENT(IN) :: PHO2IM ! h/2 for decreasing x
-REAL, DIMENSION(:), INTENT(IN) :: PHO2JP ! h/2 for increasing y
-REAL, DIMENSION(:), INTENT(IN) :: PHO2JM ! h/2 for decreasing y
-REAL, INTENT(IN) :: PZ0VEG ! vegetation roughness length
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFIP! roughness length for increasing x
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFIM! roughness length for decreasing x
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFJP! roughness length for increasing y
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFJM! roughness length for decreasing y
-!
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PZ0REL ! roughness length
-! ! of SSO only
-LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL :: OMASK ! mask where computations
- ! are done
-!
-REAL, DIMENSION(SIZE(PZ0EFFIM)) :: ZZ0VEG
-LOGICAL, DIMENSION(SIZE(PZ0EFFIM)) :: GMASK
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('MODI_SUBSCALE_Z0EFF:SUBSCALE_Z0EFF_1D_NVEG',0,ZHOOK_HANDLE)
-!
-IF (PRESENT(OMASK)) THEN
- GMASK=OMASK
-ELSE
- GMASK=(PAOSIP/=XUNDEF) ! computations always performed where SSO data exist
- PZ0EFFIP = XUNDEF
- PZ0EFFIM = XUNDEF
- PZ0EFFJP = XUNDEF
- PZ0EFFJM = XUNDEF
-END IF
-!
-ZZ0VEG(:) = PZ0VEG
-!
- CALL SUBSCALE_Z0EFF_1D(PAOSIP,PAOSIM,PAOSJP,PAOSJM, &
- PHO2IP,PHO2IM,PHO2JP,PHO2JM,ZZ0VEG, &
- PZ0EFFIP,PZ0EFFIM,PZ0EFFJP,PZ0EFFJM, &
- GMASK )
-!
-IF (PRESENT(PZ0REL)) CALL Z0REL_1D(PAOSIP,PAOSIM,PAOSJP,PAOSJM, &
- PHO2IP,PHO2IM,PHO2JP,PHO2JM, &
- PZ0REL,GMASK )
-!
-IF (LHOOK) CALL DR_HOOK('MODI_SUBSCALE_Z0EFF:SUBSCALE_Z0EFF_1D_NVEG',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-END SUBROUTINE SUBSCALE_Z0EFF_1D_NVEG
-!-------------------------------------------------------------------------------
-!
-! ######################################################################
- SUBROUTINE SUBSCALE_Z0EFF_1D_BIS(PAOSIP,PAOSIM,PAOSJP,PAOSJM, &
- PHO2IP,PHO2IM,PHO2JP,PHO2JM,PZ0VEG, &
- PZ0EFFIP,PZ0EFFIM,PZ0EFFJP,PZ0EFFJM, &
- PZ0REL,OMASK )
-! ######################################################################
-!
-!!*SUBSCALE_Z0EFF computes an effective roughness lenght deduced
-!! from the subgrid-scale orography.
-!!
-!!
-!! METHOD
-!! ------
-!! See M.Georgelin and al. July 1994, Monthly Weather Review.
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! M. Georgelin Laboratoire d'Aerologie
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 18/12/95
-!! 22/12/97 (V Masson) call with dummy arguments
-!!
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
+USE MODD_CSTS, ONLY : XKARMAN
+USE MODD_ISBA_PAR, ONLY : XCDZ0EFF
+USE MODD_SURF_PAR, ONLY : XUNDEF
!
-USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_SSO_n, ONLY : SSO_t
!
-USE MODI_SUBSCALE_Z0EFF_1D
-USE MODI_Z0REL_1D
+USE MODI_GET_Z0REL
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -252,184 +56,105 @@ IMPLICIT NONE
!* 0.1 Declaration of dummy arguments
! ------------------------------
!
-REAL, DIMENSION(:), INTENT(IN) :: PAOSIP ! A/S for increasing x
-REAL, DIMENSION(:), INTENT(IN) :: PAOSIM ! A/S for decreasing x
-REAL, DIMENSION(:), INTENT(IN) :: PAOSJP ! A/S for increasing y
-REAL, DIMENSION(:), INTENT(IN) :: PAOSJM ! A/S for decreasing y
-REAL, DIMENSION(:), INTENT(IN) :: PHO2IP ! h/2 for increasing x
-REAL, DIMENSION(:), INTENT(IN) :: PHO2IM ! h/2 for decreasing x
-REAL, DIMENSION(:), INTENT(IN) :: PHO2JP ! h/2 for increasing y
-REAL, DIMENSION(:), INTENT(IN) :: PHO2JM ! h/2 for decreasing y
+TYPE(SSO_t), INTENT(INOUT) :: ISSK
REAL, DIMENSION(:), INTENT(IN) :: PZ0VEG ! vegetation roughness length
!
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFIP! roughness length for increasing x
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFIM! roughness length for decreasing x
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFJP! roughness length for increasing y
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFJM! roughness length for decreasing y
-!
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PZ0REL ! roughness length
-! ! of SSO only
+LOGICAL, INTENT(IN) :: OZ0REL
LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL :: OMASK ! mask where computations
! are done
!
!* 0.2 Declaration of other local variables
! ------------------------------------
!
-LOGICAL, DIMENSION(SIZE(PZ0EFFIM)) :: GMASK
+REAL, DIMENSION(SIZE(ISSK%XAOSIP)) :: ZLOC
+LOGICAL, DIMENSION(SIZE(ISSK%XZ0EFFIM)) :: GMASK
!
-INTEGER :: JJ
+INTEGER :: JJ ! loop counter on points
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
!
-IF (LHOOK) CALL DR_HOOK('MODI_SUBSCALE_Z0EFF:SUBSCALE_Z0EFF_1D_BIS',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('SUBSCALE_Z0EFF',0,ZHOOK_HANDLE)
+!
+IF (.NOT.PRESENT(OMASK)) THEN
+ ISSK%XZ0EFFIP = XUNDEF
+ ISSK%XZ0EFFIM = XUNDEF
+ ISSK%XZ0EFFJP = XUNDEF
+ ISSK%XZ0EFFJM = XUNDEF
+ENDIF
+!
+!----------------------------------------------------------------------------
!
IF (PRESENT(OMASK)) THEN
GMASK=OMASK
+ELSEIF (ALL(PZ0VEG(:)==0.)) THEN
+ GMASK = (ISSK%XAOSIP/=XUNDEF) ! computations always performed where SSO data exist
ELSE
- GMASK=(PAOSIP/=XUNDEF) ! computations always performed where SSO data exist
- PZ0EFFIP = XUNDEF
- PZ0EFFIM = XUNDEF
- PZ0EFFJP = XUNDEF
- PZ0EFFJM = XUNDEF
+ GMASK=PZ0VEG(:) /= XUNDEF ! computations always performed where defined
END IF
!
- CALL SUBSCALE_Z0EFF_1D(PAOSIP,PAOSIM,PAOSJP,PAOSJM, &
- PHO2IP,PHO2IM,PHO2JP,PHO2JM,PZ0VEG, &
- PZ0EFFIP,PZ0EFFIM,PZ0EFFJP,PZ0EFFJM, &
- GMASK )
+!* 1. Computations from A/S and h/2
+! -----------------------------
+!
+ CALL GET_Z0EFF(GMASK(:),PZ0VEG(:),ISSK%XHO2JP(:),ISSK%XAOSJP(:),ISSK%XZ0EFFJP(:))
+ CALL GET_Z0EFF(GMASK(:),PZ0VEG(:),ISSK%XHO2JM(:),ISSK%XAOSJM(:),ISSK%XZ0EFFJM(:))
+ CALL GET_Z0EFF(GMASK(:),PZ0VEG(:),ISSK%XHO2IM(:),ISSK%XAOSIM(:),ISSK%XZ0EFFIM(:))
+ CALL GET_Z0EFF(GMASK(:),PZ0VEG(:),ISSK%XHO2IP(:),ISSK%XAOSIP(:),ISSK%XZ0EFFIP(:))
!
-IF (PRESENT(PZ0REL)) CALL Z0REL_1D(PAOSIP,PAOSIM,PAOSJP,PAOSJM, &
- PHO2IP,PHO2IM,PHO2JP,PHO2JM, &
- PZ0REL,GMASK )
+IF (OZ0REL) CALL GET_Z0REL(ISSK,GMASK)
!
-IF (LHOOK) CALL DR_HOOK('MODI_SUBSCALE_Z0EFF:SUBSCALE_Z0EFF_1D_BIS',1,ZHOOK_HANDLE)
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE SUBSCALE_Z0EFF_1D_BIS
-!
-! ######spl
- SUBROUTINE SUBSCALE_Z0EFF_1D_PATCH(PAOSIP,PAOSIM,PAOSJP,PAOSJM, &
- PHO2IP,PHO2IM,PHO2JP,PHO2JM,PZ0VEG, &
- PZ0EFFIP,PZ0EFFIM,PZ0EFFJP,PZ0EFFJM, &
- PZ0REL,OMASK )
-! ######################################################################
+IF (LHOOK) CALL DR_HOOK('SUBSCALE_Z0EFF',1,ZHOOK_HANDLE)
!
-!!*SUBSCALE_Z0EFF computes an effective roughness lenght deduced
-!! from the subgrid-scale orography.
-!!
-!!
-!! METHOD
-!! ------
-!! See M.Georgelin and al. July 1994, Monthly Weather Review.
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! M. Georgelin Laboratoire d'Aerologie
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 18/12/95
-!! 22/12/97 (V Masson) call with dummy arguments
-!!
-!----------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+CONTAINS
!
-!* 0. DECLARATION
-! -----------
+SUBROUTINE GET_Z0EFF(OCOMPUT,PZ0,PHO,PAO,PZ0EFF)
!
-USE MODD_CSTS, ONLY : XKARMAN
USE MODD_ISBA_PAR, ONLY : XCDZ0EFF
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE MODI_SUBSCALE_Z0EFF_1D
-USE MODI_Z0REL_1D
+USE MODD_CSTS, ONLY : XKARMAN
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
-!* 0.1 Declaration of dummy arguments
-! ------------------------------
-!
-REAL, DIMENSION(:), INTENT(IN) :: PAOSIP ! A/S for increasing x
-REAL, DIMENSION(:), INTENT(IN) :: PAOSIM ! A/S for decreasing x
-REAL, DIMENSION(:), INTENT(IN) :: PAOSJP ! A/S for increasing y
-REAL, DIMENSION(:), INTENT(IN) :: PAOSJM ! A/S for decreasing y
-REAL, DIMENSION(:), INTENT(IN) :: PHO2IP ! h/2 for increasing x
-REAL, DIMENSION(:), INTENT(IN) :: PHO2IM ! h/2 for decreasing x
-REAL, DIMENSION(:), INTENT(IN) :: PHO2JP ! h/2 for increasing y
-REAL, DIMENSION(:), INTENT(IN) :: PHO2JM ! h/2 for decreasing y
-REAL, DIMENSION(:,:), INTENT(IN) :: PZ0VEG ! vegetation roughness length
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZ0EFFIP! roughness length for increasing x
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZ0EFFIM! roughness length for decreasing x
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZ0EFFJP! roughness length for increasing y
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZ0EFFJM! roughness length for decreasing y
-!
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PZ0REL ! roughness length
-! ! of SSO only
-LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL :: OMASK ! mask where computations
- ! are done
+LOGICAL, DIMENSION(:), INTENT(IN) :: OCOMPUT
+REAL, DIMENSION(:), INTENT(IN) :: PZ0
+REAL, DIMENSION(:), INTENT(IN) :: PHO
+REAL, DIMENSION(:), INTENT(IN) :: PAO
+REAL, DIMENSION(:), INTENT(INOUT):: PZ0EFF
!
-!* 0.2 Declaration of other local variables
-! ------------------------------------
+LOGICAL, DIMENSION(SIZE(PZ0)) :: LWORK1
!
-LOGICAL, DIMENSION(SIZE(PZ0EFFIM,1)) :: GMASK
+REAL :: ZLOC1,ZLOC2,ZLOC3
+INTEGER :: JJ, INI
!
-INTEGER :: IPATCH ! number of patches
-INTEGER :: JPATCH ! loop counter on number of patches
-INTEGER :: JJ ! loop counter on points
REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!----------------------------------------------------------------------------
!
-IF (LHOOK) CALL DR_HOOK('MODI_SUBSCALE_Z0EFF:SUBSCALE_Z0EFF_1D_PATCH',0,ZHOOK_HANDLE)
-PZ0EFFIP = XUNDEF
-PZ0EFFIM = XUNDEF
-PZ0EFFJP = XUNDEF
-PZ0EFFJM = XUNDEF
+IF (LHOOK) CALL DR_HOOK('SUBSCALE_Z0EFF:GET_ZOEFF',0,ZHOOK_HANDLE)
!
-IPATCH = SIZE(PZ0VEG,2)
-!----------------------------------------------------------------------------
-DO JPATCH=1,IPATCH
-!----------------------------------------------------------------------------
+INI=SIZE(PZ0)
!
- IF (PRESENT(OMASK)) THEN
- GMASK=OMASK
- ELSE
- GMASK=PZ0VEG(:,JPATCH) /= XUNDEF ! computations always performed where defined
- END IF
+LWORK1(:)=(PHO(:)>PZ0(:).AND.(PZ0(:)/=0.0.OR.PAO(:)/=0.0))
!
- CALL SUBSCALE_Z0EFF_1D(PAOSIP,PAOSIM,PAOSJP,PAOSJM, &
- PHO2IP,PHO2IM,PHO2JP,PHO2JM,PZ0VEG(:,JPATCH), &
- PZ0EFFIP(:,JPATCH),PZ0EFFIM(:,JPATCH), &
- PZ0EFFJP(:,JPATCH),PZ0EFFJM(:,JPATCH), &
- GMASK )
+DO JJ=1,INI
+ IF (OCOMPUT(JJ)) THEN
+ IF (LWORK1(JJ)) THEN
+ ZLOC1 = (XCDZ0EFF/(2.*XKARMAN**2))*PAO(JJ)
+ IF ( PZ0(JJ) > 0. ) THEN
+ ZLOC2 = 1./(ALOG(PHO(JJ)/PZ0(JJ)))**2
+ ELSE
+ ZLOC2 = 0.
+ ENDIF
+ ZLOC3 = SQRT(1./(ZLOC1+ZLOC2))
+ PZ0EFF(JJ) = PHO(JJ) * EXP(-ZLOC3)
+ ELSE
+ PZ0EFF(JJ) = PZ0(JJ)
+ ENDIF
+ ENDIF
+ENDDO
!
-END DO
+IF (LHOOK) CALL DR_HOOK('SUBSCALE_Z0EFF:GET_ZOEFF',1,ZHOOK_HANDLE)
!
-IF (PRESENT(OMASK)) THEN
- GMASK=OMASK
-ELSE
- GMASK=(PAOSIP/=XUNDEF)
-END IF
-!
-IF (PRESENT(PZ0REL)) CALL Z0REL_1D(PAOSIP,PAOSIM,PAOSJP,PAOSJM, &
- PHO2IP,PHO2IM,PHO2JP,PHO2JM, &
- PZ0REL,GMASK )
-!
-IF (LHOOK) CALL DR_HOOK('MODI_SUBSCALE_Z0EFF:SUBSCALE_Z0EFF_1D_PATCH',1,ZHOOK_HANDLE)
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE SUBSCALE_Z0EFF_1D_PATCH
+END SUBROUTINE GET_Z0EFF
+
+END SUBROUTINE SUBSCALE_Z0EFF
diff --git a/src/SURFEX/subscale_z0eff_1d.F90 b/src/SURFEX/subscale_z0eff_1d.F90
deleted file mode 100644
index 98d6774a36e549e485866ef7cb5ace17385cde63..0000000000000000000000000000000000000000
--- a/src/SURFEX/subscale_z0eff_1d.F90
+++ /dev/null
@@ -1,152 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! ######################################################################
- SUBROUTINE SUBSCALE_Z0EFF_1D(PAOSIP,PAOSIM,PAOSJP,PAOSJM, &
- PHO2IP,PHO2IM,PHO2JP,PHO2JM,PZ0VEG, &
- PZ0EFFIP,PZ0EFFIM,PZ0EFFJP,PZ0EFFJM, &
- OMASK )
-! ######################################################################
-!
-!!*SUBSCALE_Z0EFF computes an effective roughness lenght deduced
-!! from the subgrid-scale orography.
-!!
-!!
-!! METHOD
-!! ------
-!! See M.Georgelin and al. July 1994, Monthly Weather Review.
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! M. Georgelin Laboratoire d'Aerologie
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 18/12/95
-!! 22/12/97 (V Masson) call with dummy arguments
-!! 24/08/12 (B Decharme) optimization (loop into subroutine)
-!!
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_CSTS, ONLY : XKARMAN
-USE MODD_ISBA_PAR, ONLY : XCDZ0EFF
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of dummy arguments
-! ------------------------------
-!
-REAL, DIMENSION(:), INTENT(IN) :: PAOSIP ! A/S for increasing x
-REAL, DIMENSION(:), INTENT(IN) :: PAOSIM ! A/S for decreasing x
-REAL, DIMENSION(:), INTENT(IN) :: PAOSJP ! A/S for increasing y
-REAL, DIMENSION(:), INTENT(IN) :: PAOSJM ! A/S for decreasing y
-REAL, DIMENSION(:), INTENT(IN) :: PHO2IP ! h/2 for increasing x
-REAL, DIMENSION(:), INTENT(IN) :: PHO2IM ! h/2 for decreasing x
-REAL, DIMENSION(:), INTENT(IN) :: PHO2JP ! h/2 for increasing y
-REAL, DIMENSION(:), INTENT(IN) :: PHO2JM ! h/2 for decreasing y
-REAL, DIMENSION(:), INTENT(IN) :: PZ0VEG ! vegetation roughness length
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFIP! roughness length for increasing x
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFIM! roughness length for decreasing x
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFJP! roughness length for increasing y
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFJM! roughness length for decreasing y
-!
-LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL :: OMASK ! mask where computations
- ! are done
-!
-!* 0.2 Declaration of other local variables
-! ------------------------------------
-!
-LOGICAL, DIMENSION(SIZE(PZ0EFFIM)) :: GMASK
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!----------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('SUBSCALE_Z0EFF_1D',0,ZHOOK_HANDLE)
-IF (PRESENT(OMASK)) THEN
- GMASK=OMASK
-ELSE
- GMASK=(PAOSIP/=XUNDEF) ! computations always performed where SSO data exist
- PZ0EFFIP = XUNDEF
- PZ0EFFIM = XUNDEF
- PZ0EFFJP = XUNDEF
- PZ0EFFJM = XUNDEF
-END IF
-!
-!* 1. Computations from A/S and h/2
-! -----------------------------
-!
- CALL GET_Z0EFF(GMASK(:),PZ0VEG(:),PHO2JP(:),PAOSJP(:),PZ0EFFJP(:))
- CALL GET_Z0EFF(GMASK(:),PZ0VEG(:),PHO2JM(:),PAOSJM(:),PZ0EFFJM(:))
- CALL GET_Z0EFF(GMASK(:),PZ0VEG(:),PHO2IM(:),PAOSIM(:),PZ0EFFIM(:))
- CALL GET_Z0EFF(GMASK(:),PZ0VEG(:),PHO2IP(:),PAOSIP(:),PZ0EFFIP(:))
-!
-IF (LHOOK) CALL DR_HOOK('SUBSCALE_Z0EFF_1D',1,ZHOOK_HANDLE)
-!-------------------------------------------------------------------------------
- CONTAINS
-!
-SUBROUTINE GET_Z0EFF(OCOMPUT,PZ0,PHO,PAO,PZ0EFF)
-!
-IMPLICIT NONE
-!
-LOGICAL, DIMENSION(:), INTENT(IN) :: OCOMPUT
-REAL, DIMENSION(:), INTENT(IN) :: PZ0
-REAL, DIMENSION(:), INTENT(IN) :: PHO
-REAL, DIMENSION(:), INTENT(IN) :: PAO
-REAL, DIMENSION(:), INTENT(OUT):: PZ0EFF
-!
-LOGICAL, DIMENSION(SIZE(PZ0)) :: LWORK1
-!
-REAL :: ZLOC1,ZLOC2,ZLOC3
-INTEGER :: JJ, INI
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-IF (LHOOK) CALL DR_HOOK('SUBSCALE_Z0EFF_1D:GET_ZOEFF',0,ZHOOK_HANDLE)
-!
-INI=SIZE(PZ0)
-!
-LWORK1(:)=(PHO(:)>PZ0(:).AND.(PZ0(:)/=0.0.OR.PAO(:)/=0.0))
-!
-DO JJ=1,INI
- IF (OCOMPUT(JJ)) THEN
- IF (LWORK1(JJ)) THEN
- ZLOC1 = (XCDZ0EFF/(2.*XKARMAN**2))*PAO(JJ)
- IF ( PZ0(JJ) > 0. ) THEN
- ZLOC2 = 1./(ALOG(PHO(JJ)/PZ0(JJ)))**2
- ELSE
- ZLOC2 = 0.
- ENDIF
- ZLOC3 = SQRT(1./(ZLOC1+ZLOC2))
- PZ0EFF(JJ) = PHO(JJ) * EXP(-ZLOC3)
- ELSE
- PZ0EFF(JJ) = PZ0(JJ)
- ENDIF
- ENDIF
-ENDDO
-!
-IF (LHOOK) CALL DR_HOOK('SUBSCALE_Z0EFF_1D:GET_ZOEFF',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE GET_Z0EFF
-!
-END SUBROUTINE SUBSCALE_Z0EFF_1D
diff --git a/src/SURFEX/sum_on_all_procs.F90 b/src/SURFEX/sum_on_all_procs.F90
index fafa4a9b82782faf1a91d8acee387d484ec0ad06..699539d087cd9e079ec343b76fb85c64662896c3 100644
--- a/src/SURFEX/sum_on_all_procs.F90
+++ b/src/SURFEX/sum_on_all_procs.F90
@@ -33,11 +33,14 @@
!! MODIFICATIONS
!! -------------
!! Original 07/2011
+!! S.Senesi 08/2015 : Adapt to XIOS output mode
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SURF_CONF, ONLY : CSOFTWARE
+!
#ifdef SFX_OL
USE MODI_SUM_ON_ALL_PROCS_OL
#endif
@@ -88,7 +91,7 @@ IF (HPROGRAM=='MESONH') THEN
CALL SUM_ON_ALL_PROCS_MNH(ISIZE,IIN,KOUT)
ENDIF
#endif
-ELSE IF (HPROGRAM=='AROME ' ) THEN
+ELSE IF (HPROGRAM=='AROME ' .OR. (HPROGRAM=='XIOS '.AND.TRIM(CSOFTWARE)/="OFFLINE")) THEN
#ifdef SFX_ARO
KOUT = MAX(COUNT(OIN),1) ! to be coded properly in AROME
#endif
diff --git a/src/SURFEX/sunpos.F90 b/src/SURFEX/sunpos.F90
index 7fce9fb40b2a1b4cd171813d8d99f0795b740310..4a357b000fd37a6c2cc309543df227c2df80cd87 100644
--- a/src/SURFEX/sunpos.F90
+++ b/src/SURFEX/sunpos.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE SUNPOS (KSIZE_OMP, KYEAR, KMONTH, KDAY, PTIME, &
+ SUBROUTINE SUNPOS (KYEAR, KMONTH, KDAY, PTIME, &
PLON, PLAT, PTSUN, PZENITH, PAZIMSOL)
! ####################################################################################
!
@@ -55,7 +55,6 @@
! ------------
!
USE MODD_CSTS, ONLY : XPI, XDAY
-USE MODD_SURFEX_OMP, ONLY : NBLOCK, NBLOCKTOT, INIT_DIM
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -72,7 +71,6 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, DIMENSION(:), INTENT(IN) :: KSIZE_OMP
INTEGER, INTENT(IN) :: KYEAR ! current year
INTEGER, INTENT(IN) :: KMONTH ! current month
INTEGER, INTENT(IN) :: KDAY ! current day
@@ -109,14 +107,15 @@ REAL :: ZTSIDER, &
!
INTEGER :: JI, JJ, INKPROMA
INTEGER :: IINDX1, IINDX2
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!
!-------------------------------------------------------------------------------
!
!* 1. TO COMPUTE THE TRUE SOLAR TIME
! -------------------------------
!
-IF (LHOOK) CALL DR_HOOK('SUNPOS',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('SUNPOS_1',0,ZHOOK_HANDLE)
+!
ZUT = MOD( 24.0+MOD(PTIME/3600.,24.0),24.0 )
INOBIS(:) = (/0,31,59,90,120,151,181,212,243,273,304,334/)
@@ -148,17 +147,12 @@ ZSINDEL = SIN(ZDECSOL)
ZCOSDEL = COS(ZDECSOL)
!-------------------------------------------------------------------------------
!
-!$OMP PARALLEL PRIVATE(INKPROMA,IINDX1,IINDX2)
-!
-!$ NBLOCK = OMP_GET_THREAD_NUM()
+IF (LHOOK) CALL DR_HOOK('SUNPOS_1',1,ZHOOK_HANDLE)
!
-IF (NBLOCK==NBLOCKTOT) THEN
- CALL INIT_DIM(KSIZE_OMP,0,INKPROMA,IINDX1,IINDX2)
-ELSE
- CALL INIT_DIM(KSIZE_OMP,NBLOCK,INKPROMA,IINDX1,IINDX2)
-ENDIF
-!
-DO JJ = IINDX1,IINDX2
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('SUNPOS_2',0,ZHOOK_HANDLE_OMP)
+!$OMP DO PRIVATE(JJ)
+DO JJ = 1,SIZE(PLAT)
!
!* 3. LOADS THE ZLAT, ZLON ARRAYS
! ---------------------------
@@ -210,10 +204,10 @@ DO JJ = IINDX1,IINDX2
ENDIF
!
ENDDO
-!
+!$OMP END DO
+IF (LHOOK) CALL DR_HOOK('SUNPOS_2',1,ZHOOK_HANDLE_OMP)
!$OMP END PARALLEL
!
-IF (LHOOK) CALL DR_HOOK('SUNPOS',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
END SUBROUTINE SUNPOS
diff --git a/src/SURFEX/surf_patch.F90 b/src/SURFEX/surf_patch.F90
index 35733ef872344795b057a5eb77d603d71973fd16..f4bcb2597a5d139003b4d4b2e1e16f62e1a8e71e 100644
--- a/src/SURFEX/surf_patch.F90
+++ b/src/SURFEX/surf_patch.F90
@@ -7,19 +7,22 @@ MODULE MODI_SURF_PATCH
!#####################
!
INTERFACE SURF_PATCH
- SUBROUTINE SURF_PATCH_2D(KPATCH,PVEGTYPE,PPATCH)
+ SUBROUTINE SURF_PATCH_2D(KNPATCH,PVEGTYPE,PPATCH,PVEGTYPE_PATCH)
-INTEGER , INTENT(IN) :: KPATCH ! number of patches
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVEGTYPE ! vegtype fractions
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPATCH ! patch weight in nature fraction
+INTEGER , INTENT(IN) :: KNPATCH ! number of patches
+REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE ! vegtype fractions
+REAL, DIMENSION(:,:), INTENT(OUT) :: PPATCH ! patch weight in nature fraction
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PVEGTYPE_PATCH ! vegtype fractions
+! ! for each patch
END SUBROUTINE SURF_PATCH_2D
- SUBROUTINE SURF_PATCH_1D(KPATCH,PVEGTYPE,PPATCH,PVEGTYPE_PATCH)
+ SUBROUTINE SURF_PATCH_1D(KPATCH,KNPATCH,PVEGTYPE,PPATCH,PVEGTYPE_PATCH)
-INTEGER , INTENT(IN) :: KPATCH ! number of patches
+INTEGER , INTENT(IN) :: KPATCH !
+INTEGER , INTENT(IN) :: KNPATCH ! number of patches
REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE ! vegtype fractions
-REAL, DIMENSION(:,:), INTENT(OUT) :: PPATCH ! patch weight in nature fraction
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PVEGTYPE_PATCH ! vegtype fractions
+REAL, DIMENSION(:), INTENT(OUT) :: PPATCH ! patch weight in nature fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PVEGTYPE_PATCH ! vegtype fractions
! ! for each patch
END SUBROUTINE SURF_PATCH_1D
@@ -29,7 +32,7 @@ END INTERFACE SURF_PATCH
END MODULE MODI_SURF_PATCH
!
! #############################################
- SUBROUTINE SURF_PATCH_2D(KPATCH,PVEGTYPE,PPATCH)
+ SUBROUTINE SURF_PATCH_2D(KNPATCH,PVEGTYPE,PPATCH,PVEGTYPE_PATCH)
! #############################################
!
!!**** *SURF_PATCH * - subroutine to compute the patch fractions in each grid
@@ -86,9 +89,11 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER, INTENT(IN) :: KPATCH ! number of patches
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVEGTYPE ! vegtype fractions
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPATCH ! patch weight in nature fraction
+INTEGER , INTENT(IN) :: KNPATCH ! number of patches
+REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE ! vegtype fractions
+REAL, DIMENSION(:,:), INTENT(OUT) :: PPATCH ! patch weight in nature fraction
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PVEGTYPE_PATCH ! vegtype fractions
+! ! for each patch
!
!
!* 0.2 Declarations of local variables for print on FM file
@@ -99,13 +104,28 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('MODI_SURF_PATCH:SURF_PATCH_2D',0,ZHOOK_HANDLE)
-PPATCH (:,:,:)=0.
+PPATCH (:,:) =0.
+IF (PRESENT(PVEGTYPE_PATCH)) PVEGTYPE_PATCH (:,:,:)=0.
DO JVEG=1,NVEGTYPE
- JPATCH=VEGTYPE_TO_PATCH (JVEG, KPATCH)
- WHERE (PVEGTYPE (:,:,JVEG) /= XUNDEF)
- PPATCH (:,:,JPATCH)= PPATCH (:,:,JPATCH) + PVEGTYPE (:,:,JVEG)
+ JPATCH=VEGTYPE_TO_PATCH (JVEG, KNPATCH)
+ WHERE (PVEGTYPE (:,JVEG) /= XUNDEF)
+ PPATCH (:,JPATCH) = PPATCH (:,JPATCH) + PVEGTYPE (:,JVEG)
END WHERE
+ IF (PRESENT(PVEGTYPE_PATCH)) THEN
+ WHERE (PVEGTYPE (:,JVEG) /= XUNDEF)
+ PVEGTYPE_PATCH (:,JVEG,JPATCH)= PVEGTYPE (:,JVEG)
+ END WHERE
+ END IF
END DO
+IF (PRESENT(PVEGTYPE_PATCH)) THEN
+ DO JPATCH=1,KNPATCH
+ DO JVEG=1,NVEGTYPE
+ WHERE (PVEGTYPE (:,JVEG) /= XUNDEF .AND. PPATCH(:,JPATCH)/= 0.)
+ PVEGTYPE_PATCH(:,JVEG,JPATCH) = PVEGTYPE_PATCH(:,JVEG,JPATCH) / PPATCH(:,JPATCH)
+ END WHERE
+ END DO
+ END DO
+END IF
IF (LHOOK) CALL DR_HOOK('MODI_SURF_PATCH:SURF_PATCH_2D',1,ZHOOK_HANDLE)
!
!
@@ -115,7 +135,7 @@ END SUBROUTINE SURF_PATCH_2D
!-------------------------------------------------------------------------------
!
! #############################################
- SUBROUTINE SURF_PATCH_1D(KPATCH,PVEGTYPE,PPATCH,PVEGTYPE_PATCH)
+ SUBROUTINE SURF_PATCH_1D(KPATCH,KNPATCH,PVEGTYPE,PPATCH,PVEGTYPE_PATCH)
! #############################################
!
!!**** *SURF_PATCH * - subroutine to compute the patch fractions in each grid
@@ -172,13 +192,13 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-INTEGER , INTENT(IN) :: KPATCH ! number of patches
-REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE ! vegtype fractions
-REAL, DIMENSION(:,:), INTENT(OUT) :: PPATCH ! patch weight in nature fraction
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PVEGTYPE_PATCH ! vegtype fractions
+INTEGER, INTENT(IN) :: KPATCH
+INTEGER, INTENT(IN) :: KNPATCH ! number of patches
+REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE ! vegtype fractions
+REAL, DIMENSION(:), INTENT(OUT) :: PPATCH ! patch weight in nature fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PVEGTYPE_PATCH ! vegtype fractions
! ! for each patch
!
-!
!* 0.2 Declarations of local variables for print on FM file
!
!
@@ -187,26 +207,25 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('MODI_SURF_PATCH:SURF_PATCH_1D',0,ZHOOK_HANDLE)
-PPATCH (:,:) =0.
-IF (PRESENT(PVEGTYPE_PATCH)) PVEGTYPE_PATCH (:,:,:)=0.
+PPATCH (:) =0.
+IF (PRESENT(PVEGTYPE_PATCH)) PVEGTYPE_PATCH (:,:)=0.
DO JVEG=1,NVEGTYPE
- JPATCH=VEGTYPE_TO_PATCH (JVEG, KPATCH)
+ JPATCH=VEGTYPE_TO_PATCH (JVEG, KNPATCH)
+ IF (JPATCH/=KPATCH) CYCLE
WHERE (PVEGTYPE (:,JVEG) /= XUNDEF)
- PPATCH (:,JPATCH) = PPATCH (:,JPATCH) + PVEGTYPE (:,JVEG)
+ PPATCH(:) = PPATCH(:) + PVEGTYPE(:,JVEG)
END WHERE
IF (PRESENT(PVEGTYPE_PATCH)) THEN
WHERE (PVEGTYPE (:,JVEG) /= XUNDEF)
- PVEGTYPE_PATCH (:,JVEG,JPATCH)= PVEGTYPE (:,JVEG)
+ PVEGTYPE_PATCH(:,JVEG) = PVEGTYPE (:,JVEG)
END WHERE
END IF
END DO
IF (PRESENT(PVEGTYPE_PATCH)) THEN
- DO JPATCH=1,KPATCH
- DO JVEG=1,NVEGTYPE
- WHERE (PVEGTYPE (:,JVEG) /= XUNDEF .AND. PPATCH(:,JPATCH)/= 0.)
- PVEGTYPE_PATCH(:,JVEG,JPATCH) = PVEGTYPE_PATCH(:,JVEG,JPATCH) / PPATCH(:,JPATCH)
- END WHERE
- END DO
+ DO JVEG=1,NVEGTYPE
+ WHERE (PVEGTYPE (:,JVEG) /= XUNDEF .AND. PPATCH(:)/= 0.)
+ PVEGTYPE_PATCH(:,JVEG) = PVEGTYPE_PATCH(:,JVEG) / PPATCH(:)
+ END WHERE
END DO
END IF
IF (LHOOK) CALL DR_HOOK('MODI_SURF_PATCH:SURF_PATCH_1D',1,ZHOOK_HANDLE)
@@ -215,3 +234,4 @@ IF (LHOOK) CALL DR_HOOK('MODI_SURF_PATCH:SURF_PATCH_1D',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
END SUBROUTINE SURF_PATCH_1D
+!
diff --git a/src/SURFEX/surface_aero_cond.F90 b/src/SURFEX/surface_aero_cond.F90
index c8f8a4d6d9a233eb5abc563387cd8a45bd17d016..22a3ddb116e3bac0edd5b214b81606784de2943b 100644
--- a/src/SURFEX/surface_aero_cond.F90
+++ b/src/SURFEX/surface_aero_cond.F90
@@ -98,7 +98,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
! Functions:
REAL :: X, CHSTAR, PH
- CHSTAR(X) = 3.2165 + 4.3431*X + 0.5360*X*X - 0.0781*X*X*X
+CHSTAR(X) = 3.2165 + 4.3431*X + 0.5360*X*X - 0.0781*X*X*X
PH (X) = 0.5802 - 0.1571*X + 0.0327*X*X - 0.0026*X*X*X
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/surface_air_meb.F90 b/src/SURFEX/surface_air_meb.F90
index 2c85ca0c65399a3c7c9cc5b077b06a9371cbeec1..618ba4bb6674c01936fb27d05e5a3843aa33e377 100644
--- a/src/SURFEX/surface_air_meb.F90
+++ b/src/SURFEX/surface_air_meb.F90
@@ -52,6 +52,10 @@
!! (A. Boone) 25/06/2014 Use stability fn from ISBA for stable conditions
!! (since none existed before). Added to handle extremely
!! stable conditions, such as encountered over a snowpack
+!! (S. Garrigues & A. Boone)
+!! 14/06/2017 Put in numerical limits for ground to canopy air
+!! resistances. Needed in the limit as the vegetation
+!! cover becomes vanishingly thin.
!!
!-------------------------------------------------------------------------------
!
@@ -116,6 +120,7 @@ REAL, PARAMETER :: ZA = 0.01
REAL, PARAMETER :: ZRAFA = 9. !resistance factor for stability correction
!for unstable conditions
+REAL, PARAMETER :: ZRAGNC_MIN = 1. ! (s/m) Minimum ground to canopy air resistance
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
@@ -142,6 +147,11 @@ PUSTAR2(:) = ZUSTAR(:)**2
PRAGNC(:)=PH_VEG(:)*EXP(ZALPHA)/(ZALPHA*ZK(:))*(EXP(-ZALPHA*PZ0G(:)/PH_VEG(:)) &
-EXP(-ZALPHA*(PDISPH(:)+PZ0(:))/PH_VEG(:)))
!
+! For the case of vanishingly thin vegetation, limit is imposed
+! This results because the above Eq assumes z0v > z0g
+!
+PRAGNC(:) = MAX(ZRAGNC_MIN,PRAGNC(:))
+!
! Modify the aerodynamic resistance, with an unstable transfer correction
! Eq. A15, Sellers et.al. 1986 (RI < 0)
!
diff --git a/src/SURFEX/surface_cd.F90 b/src/SURFEX/surface_cd.F90
index c7da75421cb0e25015b62eecc88e6d14a4f73af0..20ade71b013a555d1c028f83f21e5ade8aec6f21 100644
--- a/src/SURFEX/surface_cd.F90
+++ b/src/SURFEX/surface_cd.F90
@@ -94,7 +94,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! Functions :
REAL :: X, CMSTAR, PM
- CMSTAR(X) = 6.8741 + 2.6933*X - 0.3601*X*X + 0.0154*X*X*X
+CMSTAR(X) = 6.8741 + 2.6933*X - 0.3601*X*X + 0.0154*X*X*X
PM (X) = 0.5233 - 0.0815*X + 0.0135*X*X - 0.0010*X*X*X
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/surfcon.h b/src/SURFEX/surfcon.h
deleted file mode 100644
index c3683ff31033dd9cfe5d7b9247072b71e50bb27d..0000000000000000000000000000000000000000
--- a/src/SURFEX/surfcon.h
+++ /dev/null
@@ -1,4 +0,0 @@
-
-!RJ: inlined
- ERROR aa
-#error should not be used
diff --git a/src/SURFEX/surfex_alloc.F90 b/src/SURFEX/surfex_alloc.F90
index 8fa5d8044866f7f8644b857b4fd5dd519cf668a3..fe75ab8cf2f8893707aef7b44c0f611d5a083cfd 100644
--- a/src/SURFEX/surfex_alloc.F90
+++ b/src/SURFEX/surfex_alloc.F90
@@ -5,94 +5,72 @@
SUBROUTINE SURFEX_ALLOC(YDSURFEX)
!
USE MODD_TEB_PAR, ONLY : NTEB_PATCH_MAX
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE_ECOSG, NTILESFC
!
USE MODD_SURFEX_n, ONLY : SURFEX_t
!
-USE MODD_AGRI_n, ONLY : AGRI_INIT
-USE MODD_BEM_OPTION_n, ONLY : BEM_OPTIONS_INIT
-USE MODD_BLD_DESCRIPTION_n, ONLY : BLD_DESC_INIT
USE MODD_CH_EMIS_FIELD_n, ONLY : CH_EMIS_FIELD_INIT
-USE MODD_CH_FLAKE_n, ONLY : CH_FLAKE_INIT
-USE MODD_CH_ISBA_n, ONLY : CH_ISBA_INIT
-USE MODD_CH_SEAFLUX_n, ONLY : CH_SEAFLUX_INIT
USE MODD_CH_SNAP_n, ONLY : CH_EMIS_SNAP_INIT
USE MODD_CH_SURF_n, ONLY : CH_SURF_INIT
-USE MODD_CH_TEB_n, ONLY : CH_TEB_INIT
-USE MODD_CH_WATFLUX_n, ONLY : CH_WATFLUX_INIT
-USE MODD_DATA_BEM_n, ONLY : DATA_BEM_INIT
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_INIT
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_INIT
-USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_INIT
-USE MODD_DATA_TEB_GARDEN_n, ONLY : DATA_TEB_GARDEN_INIT
-USE MODD_DATA_TEB_GREENROOF_n, ONLY : DATA_TEB_GREENROOF_INIT
-USE MODD_DATA_TEB_n, ONLY : DATA_TEB_INIT
-USE MODD_DATA_TSZ0_n, ONLY : DATA_TSZ0_INIT
-USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_INIT
-USE MODD_DIAG_FLAKE_n, ONLY : DIAG_FLAKE_INIT
-USE MODD_DIAG_IDEAL_n, ONLY : DIAG_IDEAL_INIT
-USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_INIT
-USE MODD_DIAG_MISC_FLAKE_n, ONLY : DIAG_MISC_FLAKE_INIT
-USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_INIT
-USE MODD_DIAG_MISC_TEB_OPTION_n, ONLY : DIAG_MISC_TEB_OPTIONS_INIT
-USE MODD_DIAG_OCEAN_n, ONLY : DIAG_OCEAN_INIT
-USE MODD_DIAG_SEAFLUX_n, ONLY : DIAG_SEAFLUX_INIT
-USE MODD_DIAG_SEAICE_n, ONLY : DIAG_SEAICE_INIT
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_INIT
-USE MODD_DIAG_TEB_GARDEN_n, ONLY : DIAG_TEB_GARDEN_INIT
-USE MODD_DIAG_TEB_GREENROOF_n, ONLY : DIAG_TEB_GREENROOF_INIT
-USE MODD_DIAG_TEB_n, ONLY : DIAG_TEB_INIT
-USE MODD_DIAG_UTCI_TEB_n, ONLY : DIAG_UTCI_TEB_INIT
-USE MODD_DIAG_WATFLUX_n, ONLY : DIAG_WATFLUX_INIT
-USE MODD_DST_n, ONLY : DST_INIT
USE MODD_DUMMY_SURF_FIELDS_n, ONLY : DUMMY_SURF_FIELDS_INIT
USE MODD_EMIS_GR_FIELD_n, ONLY : EMIS_GR_FIELD_INIT
-USE MODD_FLAKE_GRID_n, ONLY : FLAKE_GRID_INIT
-USE MODD_FLAKE_n, ONLY : FLAKE_INIT
-USE MODD_FLAKE_SBL_n, ONLY : FLAKE_SBL_INIT
-USE MODD_GR_BIOG_GARDEN_n, ONLY : GR_BIOG_GARDEN_INIT
-USE MODD_GR_BIOG_GREENROOF_n, ONLY : GR_BIOG_GREENROOF_INIT
-USE MODD_GR_BIOG_n, ONLY : GR_BIOG_INIT
-USE MODD_IDEAL_n, ONLY : IDEAL_INIT
-USE MODD_ISBA_CANOPY_n, ONLY : ISBA_CANOPY_INIT
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_INIT
-USE MODD_ISBA_n, ONLY : ISBA_INIT
-USE MODD_OCEAN_n, ONLY : OCEAN_INIT
-USE MODD_OCEAN_REL_n, ONLY : OCEAN_REL_INIT
-USE MODD_PACK_CH_ISBA, ONLY : PACK_CH_ISBA_INIT
-USE MODD_PACK_DIAG_ISBA, ONLY : PACK_DIAG_ISBA_INIT
-USE MODD_PACK_ISBA, ONLY : PACK_ISBA_INIT
-USE MODD_SEAFLUX_GRID_n, ONLY : SEAFLUX_GRID_INIT
-USE MODD_SEAFLUX_n, ONLY : SEAFLUX_INIT
-USE MODD_SEAFLUX_SBL_n, ONLY : SEAFLUX_SBL_INIT
-USE MODD_SLT_n, ONLY : SLT_INIT
-USE MODD_SSO_CANOPY_n, ONLY : SSO_CANOPY_INIT
+USE MODD_SFX_GRID_n, ONLY : GRID_INIT, GRID_NP_INIT
+USE MODD_CANOPY_n, ONLY : CANOPY_INIT
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_INIT
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_INIT
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_INIT
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_INIT
+USE MODD_SSO_n, ONLY : SSO_INIT, SSO_NP_INIT
USE MODD_SV_n, ONLY : SV_INIT
-USE MODD_TEB_CANOPY_n, ONLY : TEB_CANOPY_INIT
-USE MODD_TEB_GARDEN_OPTION_n, ONLY : TEB_GARDEN_OPTIONS_INIT
-USE MODD_TEB_GARDEN_PGD_n, ONLY : TEB_GARDEN_PGD_INIT
-USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_INIT
-USE MODD_TEB_GREENROOF_PGD_n, ONLY : TEB_GREENROOF_PGD_INIT
-USE MODD_TEB_GRID_n, ONLY : TEB_GRID_INIT
+!
+USE MODD_DATA_TSZ0_n, ONLY : DATA_TSZ0_INIT
+!
+USE MODD_IDEAL_n, ONLY : IDEAL_INIT
+!
+USE MODD_DST_n, ONLY : DST_NP_INIT
+USE MODD_SLT_n, ONLY : SLT_INIT
+!
+USE MODD_DIAG_n, ONLY : DIAG_INIT, DIAG_NP_INIT, DIAG_OPTIONS_INIT
+!
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_INIT, DIAG_EVAP_ISBA_NP_INIT
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_INIT, DIAG_MISC_ISBA_NP_INIT
+USE MODD_DIAG_OCEAN_n, ONLY : DIAG_OCEAN_INIT
+USE MODD_DIAG_MISC_SEAICE_n, ONLY : DIAG_MISC_SEAICE_INIT
+USE MODD_DIAG_MISC_FLAKE_n, ONLY : DIAG_MISC_FLAKE_INIT
+USE MODD_DIAG_MISC_TEB_OPTIONS_n, ONLY : DIAG_MISC_TEB_OPTIONS_INIT
+USE MODD_DIAG_UTCI_TEB_n, ONLY : DIAG_UTCI_TEB_INIT
+USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_NP_INIT
+!
+USE MODD_DATA_BEM_n, ONLY : DATA_BEM_INIT
+USE MODD_BEM_OPTION_n, ONLY : BEM_OPTIONS_INIT
+USE MODD_BLD_DESCRIPTION_n, ONLY : BLD_DESC_INIT
+USE MODD_CH_TEB_n, ONLY : CH_TEB_INIT
+USE MODD_DATA_TEB_n, ONLY : DATA_TEB_INIT
USE MODD_TEB_IRRIG_n, ONLY : TEB_IRRIG_INIT
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_INIT
USE MODD_TEB_PANEL_n, ONLY : TEB_PANEL_INIT
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_INIT
-USE MODD_WATFLUX_GRID_n, ONLY : WATFLUX_GRID_INIT
+USE MODD_BEM_n, ONLY : BEM_NP_INIT
+USE MODD_TEB_n, ONLY : TEB_NP_INIT
+!
+USE MODD_CH_FLAKE_n, ONLY : CH_FLAKE_INIT
+USE MODD_FLAKE_n, ONLY : FLAKE_INIT
+!
+USE MODD_CH_WATFLUX_n, ONLY : CH_WATFLUX_INIT
USE MODD_WATFLUX_n, ONLY : WATFLUX_INIT
-USE MODD_WATFLUX_SBL_n, ONLY : WATFLUX_SBL_INIT
-!
-USE MODD_BEM_n, ONLY : BEM_INIT
-USE MODD_DIAG_CUMUL_TEB_n, ONLY : DIAG_CUMUL_TEB_INIT
-USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_INIT
-USE MODD_TEB_GARDEN_n, ONLY : TEB_GARDEN_INIT
-USE MODD_TEB_GARDEN_PGD_EVOL_n, ONLY : TEB_GARDEN_PGD_EVOL_INIT
-USE MODD_TEB_GREENROOF_n, ONLY : TEB_GREENROOF_INIT
-USE MODD_TEB_GREENROOF_PGD_EVOL_n, ONLY : TEB_GREENROOF_PGD_EVOL_INIT
-USE MODD_TEB_n, ONLY : TEB_INIT
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_INIT
+!
+USE MODD_CH_ISBA_n, ONLY : CH_ISBA_INIT, CH_ISBA_NP_INIT
+USE MODD_AGRI_n, ONLY : AGRI_NP_INIT
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_INIT
+USE MODD_GR_BIOG_n, ONLY : GR_BIOG_INIT, GR_BIOG_NP_INIT
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_INIT
+USE MODD_ISBA_n, ONLY : ISBA_S_INIT, ISBA_K_INIT, ISBA_P_INIT, &
+ ISBA_NK_INIT, ISBA_NP_INIT, ISBA_NPE_INIT
+!
+USE MODD_CH_SEAFLUX_n, ONLY : CH_SEAFLUX_INIT
+USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_INIT
+USE MODD_SEAFLUX_n, ONLY : SEAFLUX_INIT
+USE MODD_OCEAN_n, ONLY : OCEAN_INIT
+USE MODD_OCEAN_REL_n, ONLY : OCEAN_REL_INIT
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -102,92 +80,144 @@ IMPLICIT NONE
TYPE (SURFEX_t), INTENT (INOUT) :: YDSURFEX
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK("SURFEX_ALLOC",0,ZHOOK_HANDLE)
-!
+ !
+ CALL DIAG_OPTIONS_INIT(YDSURFEX%FM%DFO)
+ CALL DIAG_INIT(YDSURFEX%FM%DF)
+ CALL DIAG_INIT(YDSURFEX%FM%DFC)
+ CALL DIAG_MISC_FLAKE_INIT(YDSURFEX%FM%DMF)
+ !
+ CALL GRID_INIT(YDSURFEX%FM%G)
+ CALL CANOPY_INIT(YDSURFEX%FM%SB)
CALL CH_FLAKE_INIT(YDSURFEX%FM%CHF)
- CALL DIAG_FLAKE_INIT(YDSURFEX%FM%DGF)
- CALL DIAG_MISC_FLAKE_INIT(YDSURFEX%FM%DGMF)
- CALL FLAKE_GRID_INIT(YDSURFEX%FM%FG)
CALL FLAKE_INIT(YDSURFEX%FM%F)
- CALL FLAKE_SBL_INIT(YDSURFEX%FM%FSB)
!
+ !
+ CALL DIAG_OPTIONS_INIT(YDSURFEX%WM%DWO)
+ CALL DIAG_INIT(YDSURFEX%WM%DW)
+ CALL DIAG_INIT(YDSURFEX%WM%DWC)
+ !
+ CALL GRID_INIT(YDSURFEX%WM%G)
+ CALL CANOPY_INIT(YDSURFEX%WM%SB)
CALL CH_WATFLUX_INIT(YDSURFEX%WM%CHW)
- CALL DIAG_WATFLUX_INIT(YDSURFEX%WM%DGW)
- CALL WATFLUX_GRID_INIT(YDSURFEX%WM%WG)
CALL WATFLUX_INIT(YDSURFEX%WM%W)
- CALL WATFLUX_SBL_INIT(YDSURFEX%WM%WSB)
!
- CALL CH_SEAFLUX_INIT(YDSURFEX%SM%CHS)
+ !
+ CALL DIAG_OPTIONS_INIT(YDSURFEX%SM%SD%O)
+ CALL DIAG_INIT(YDSURFEX%SM%SD%D)
+ CALL DIAG_INIT(YDSURFEX%SM%SD%DC)
+ CALL DIAG_INIT(YDSURFEX%SM%SD%DI)
+ CALL DIAG_INIT(YDSURFEX%SM%SD%DIC)
+ CALL DIAG_OCEAN_INIT(YDSURFEX%SM%SD%GO)
+ CALL DIAG_MISC_SEAICE_INIT(YDSURFEX%SM%SD%DMI)
+ !
CALL DATA_SEAFLUX_INIT(YDSURFEX%SM%DTS)
- CALL DIAG_OCEAN_INIT(YDSURFEX%SM%DGO)
- CALL DIAG_SEAFLUX_INIT(YDSURFEX%SM%DGS)
- CALL DIAG_SEAICE_INIT(YDSURFEX%SM%DGSI)
+ CALL GRID_INIT(YDSURFEX%SM%G)
+ CALL CANOPY_INIT(YDSURFEX%SM%SB)
+ CALL CH_SEAFLUX_INIT(YDSURFEX%SM%CHS)
+ CALL SEAFLUX_INIT(YDSURFEX%SM%S)
+ CALL SEAFLUX_INIT(YDSURFEX%SM%S)
CALL OCEAN_INIT(YDSURFEX%SM%O)
CALL OCEAN_REL_INIT(YDSURFEX%SM%OR)
- CALL SEAFLUX_GRID_INIT(YDSURFEX%SM%SG)
- CALL SEAFLUX_INIT(YDSURFEX%SM%S)
- CALL SEAFLUX_SBL_INIT(YDSURFEX%SM%SSB)
!
- CALL AGRI_INIT(YDSURFEX%IM%AG)
+ !
+ CALL DIAG_OPTIONS_INIT(YDSURFEX%IM%ID%O)
+ CALL DIAG_INIT(YDSURFEX%IM%ID%D)
+ CALL DIAG_INIT(YDSURFEX%IM%ID%DC)
+ CALL DIAG_NP_INIT(YDSURFEX%IM%ID%ND,NVEGTYPE_ECOSG)
+ CALL DIAG_NP_INIT(YDSURFEX%IM%ID%NDC,NVEGTYPE_ECOSG)
+ CALL DIAG_EVAP_ISBA_INIT(YDSURFEX%IM%ID%DE)
+ CALL DIAG_EVAP_ISBA_INIT(YDSURFEX%IM%ID%DEC)
+ CALL DIAG_EVAP_ISBA_NP_INIT(YDSURFEX%IM%ID%NDE,NVEGTYPE_ECOSG)
+ CALL DIAG_EVAP_ISBA_NP_INIT(YDSURFEX%IM%ID%NDEC,NVEGTYPE_ECOSG)
+ CALL DIAG_MISC_ISBA_INIT(YDSURFEX%IM%ID%DM)
+ CALL DIAG_MISC_ISBA_NP_INIT(YDSURFEX%IM%ID%NDM,NVEGTYPE_ECOSG)
+ !
+ CALL DATA_ISBA_INIT(YDSURFEX%IM%DTV)
+ CALL CANOPY_INIT(YDSURFEX%IM%SB)
+ CALL ISBA_OPTIONS_INIT(YDSURFEX%IM%O)
+ CALL ISBA_S_INIT(YDSURFEX%IM%S)
CALL CH_ISBA_INIT(YDSURFEX%IM%CHI)
- CALL DATA_ISBA_INIT(YDSURFEX%IM%DTI)
- CALL DIAG_EVAP_ISBA_INIT(YDSURFEX%IM%DGEI)
- CALL DIAG_ISBA_INIT(YDSURFEX%IM%DGI)
- CALL DIAG_MISC_ISBA_INIT(YDSURFEX%IM%DGMI)
+ CALL CH_ISBA_NP_INIT(YDSURFEX%IM%NCHI,NVEGTYPE_ECOSG)
CALL GR_BIOG_INIT(YDSURFEX%IM%GB)
- CALL ISBA_CANOPY_INIT(YDSURFEX%IM%ICP)
- CALL ISBA_GRID_INIT(YDSURFEX%IM%IG)
- CALL ISBA_INIT(YDSURFEX%IM%I)
- CALL PACK_CH_ISBA_INIT(YDSURFEX%IM%PKCI)
- CALL PACK_DIAG_ISBA_INIT(YDSURFEX%IM%PKDI)
- CALL PACK_ISBA_INIT(YDSURFEX%IM%PKI)
- !
- CALL TEB_VEG_OPTIONS_INIT(YDSURFEX%GDM%TVG)
- CALL DATA_TEB_GARDEN_INIT(YDSURFEX%GDM%DTGD)
- CALL DIAG_TEB_GARDEN_INIT(YDSURFEX%GDM%DGTGD)
- CALL GR_BIOG_GARDEN_INIT(YDSURFEX%GDM%GBGD)
- CALL TEB_GARDEN_OPTIONS_INIT(YDSURFEX%GDM%TGDO)
- CALL TEB_GARDEN_PGD_INIT(YDSURFEX%GDM%TGDP)
- CALL TEB_GARDEN_INIT(YDSURFEX%GDM%TGD,NTEB_PATCH_MAX)
- CALL TEB_GARDEN_PGD_EVOL_INIT(YDSURFEX%GDM%TGDPE,NTEB_PATCH_MAX)
- CALL TEB_IRRIG_INIT(YDSURFEX%GDM%TIR)
- !
- CALL DATA_TEB_GREENROOF_INIT(YDSURFEX%GRM%DTGR)
- CALL DIAG_TEB_GREENROOF_INIT(YDSURFEX%GRM%DGTGR)
- CALL GR_BIOG_GREENROOF_INIT(YDSURFEX%GRM%GBGR)
- CALL TEB_GREENROOF_OPTIONS_INIT(YDSURFEX%GRM%TGRO)
- CALL TEB_GREENROOF_PGD_INIT(YDSURFEX%GRM%TGRP)
- CALL TEB_GREENROOF_INIT(YDSURFEX%GRM%TGR,NTEB_PATCH_MAX)
- CALL TEB_GREENROOF_PGD_EVOL_INIT(YDSURFEX%GRM%TGRPE,NTEB_PATCH_MAX)
+ CALL GR_BIOG_NP_INIT(YDSURFEX%IM%NGB,NVEGTYPE_ECOSG)
+ CALL SSO_INIT(YDSURFEX%IM%ISS)
+ CALL SSO_NP_INIT(YDSURFEX%IM%NISS,NVEGTYPE_ECOSG)
+ CALL GRID_INIT(YDSURFEX%IM%G)
+ CALL GRID_NP_INIT(YDSURFEX%IM%NG,NVEGTYPE_ECOSG)
+ CALL ISBA_K_INIT(YDSURFEX%IM%K)
+ CALL ISBA_NK_INIT(YDSURFEX%IM%NK,NVEGTYPE_ECOSG)
+ CALL ISBA_NP_INIT(YDSURFEX%IM%NP,NVEGTYPE_ECOSG)
+ CALL ISBA_NPE_INIT(YDSURFEX%IM%NPE,NVEGTYPE_ECOSG)
+ CALL AGRI_NP_INIT(YDSURFEX%IM%NAG,NVEGTYPE_ECOSG)
!
- CALL CH_TEB_INIT(YDSURFEX%TM%CHT)
+ !
+ CALL DIAG_NP_INIT(YDSURFEX%GDM%VD%ND,NTEB_PATCH_MAX)
+ CALL DIAG_EVAP_ISBA_NP_INIT(YDSURFEX%GDM%VD%NDE,NTEB_PATCH_MAX)
+ CALL DIAG_EVAP_ISBA_NP_INIT(YDSURFEX%GDM%VD%NDEC,NTEB_PATCH_MAX)
+ CALL DIAG_MISC_ISBA_NP_INIT(YDSURFEX%GDM%VD%NDM,NTEB_PATCH_MAX)
+ !
+ CALL DATA_ISBA_INIT(YDSURFEX%GDM%DTV)
+ CALL ISBA_OPTIONS_INIT(YDSURFEX%GDM%O)
+ CALL ISBA_S_INIT(YDSURFEX%GDM%S)
+ CALL GR_BIOG_INIT(YDSURFEX%GDM%GB)
+ CALL ISBA_K_INIT(YDSURFEX%GDM%K)
+ CALL ISBA_P_INIT(YDSURFEX%GDM%P)
+ CALL ISBA_NPE_INIT(YDSURFEX%GDM%NPE,NTEB_PATCH_MAX)
+ !
+ !
+ CALL DIAG_NP_INIT(YDSURFEX%GRM%VD%ND,NTEB_PATCH_MAX)
+ CALL DIAG_EVAP_ISBA_NP_INIT(YDSURFEX%GRM%VD%NDE,NTEB_PATCH_MAX)
+ CALL DIAG_EVAP_ISBA_NP_INIT(YDSURFEX%GRM%VD%NDEC,NTEB_PATCH_MAX)
+ CALL DIAG_MISC_ISBA_NP_INIT(YDSURFEX%GRM%VD%NDM,NTEB_PATCH_MAX)
+ !
+ CALL DATA_ISBA_INIT(YDSURFEX%GRM%DTV)
+ CALL ISBA_OPTIONS_INIT(YDSURFEX%GRM%O)
+ CALL ISBA_S_INIT(YDSURFEX%GRM%S)
+ CALL GR_BIOG_INIT(YDSURFEX%GRM%GB)
+ CALL ISBA_K_INIT(YDSURFEX%GRM%K)
+ CALL ISBA_P_INIT(YDSURFEX%GRM%P)
+ CALL ISBA_NPE_INIT(YDSURFEX%GRM%NPE,NTEB_PATCH_MAX)
+ !
+ !
+ CALL DIAG_OPTIONS_INIT(YDSURFEX%TM%TD%O)
+ CALL DIAG_INIT(YDSURFEX%TM%TD%D)
+ CALL DIAG_MISC_TEB_OPTIONS_INIT(YDSURFEX%TM%TD%MTO)
+ CALL DIAG_MISC_TEB_NP_INIT(YDSURFEX%TM%TD%NDMT,NTEB_PATCH_MAX)
+ CALL DIAG_MISC_TEB_NP_INIT(YDSURFEX%TM%TD%NDMTC,NTEB_PATCH_MAX)
+ CALL DIAG_UTCI_TEB_INIT(YDSURFEX%TM%TD%DUT)
+ !
CALL DATA_TEB_INIT(YDSURFEX%TM%DTT)
- CALL DIAG_MISC_TEB_OPTIONS_INIT(YDSURFEX%TM%DGMTO)
- CALL DIAG_TEB_INIT(YDSURFEX%TM%DGT)
- CALL DIAG_UTCI_TEB_INIT(YDSURFEX%TM%DGUT)
- CALL TEB_CANOPY_INIT(YDSURFEX%TM%TCP)
- CALL TEB_GRID_INIT(YDSURFEX%TM%TG)
CALL TEB_OPTIONS_INIT(YDSURFEX%TM%TOP)
+ CALL CANOPY_INIT(YDSURFEX%TM%SB)
+ CALL GRID_INIT(YDSURFEX%TM%G)
+ CALL CH_TEB_INIT(YDSURFEX%TM%CHT)
CALL TEB_PANEL_INIT(YDSURFEX%TM%TPN)
- CALL DIAG_CUMUL_TEB_INIT(YDSURFEX%TM%DGCT,NTEB_PATCH_MAX)
- CALL DIAG_MISC_TEB_INIT(YDSURFEX%TM%DGMT,NTEB_PATCH_MAX)
- CALL TEB_INIT(YDSURFEX%TM%T,NTEB_PATCH_MAX)
+ CALL TEB_IRRIG_INIT(YDSURFEX%TM%TIR)
+ CALL TEB_NP_INIT(YDSURFEX%TM%NT,NTEB_PATCH_MAX)
!
+ CALL DATA_BEM_INIT(YDSURFEX%TM%DTB)
+ CALL BEM_OPTIONS_INIT(YDSURFEX%TM%BOP)
CALL BLD_DESC_INIT(YDSURFEX%TM%BDD)
- CALL BEM_OPTIONS_INIT(YDSURFEX%TM%BOP)
- CALL DATA_BEM_INIT(YDSURFEX%TM%DTB)
- CALL BEM_INIT(YDSURFEX%TM%B,NTEB_PATCH_MAX)
+ CALL BEM_NP_INIT(YDSURFEX%TM%NB,NTEB_PATCH_MAX)
+ !
!
CALL DATA_COVER_INIT(YDSURFEX%DTCO)
CALL DATA_TSZ0_INIT(YDSURFEX%DTZ)
CALL DUMMY_SURF_FIELDS_INIT(YDSURFEX%DUU)
!
+ CALL GRID_CONF_PROJ_INIT(YDSURFEX%GCP)
CALL SURF_ATM_GRID_INIT(YDSURFEX%UG)
CALL SURF_ATM_INIT(YDSURFEX%U)
- CALL DIAG_SURF_ATM_INIT(YDSURFEX%DGU)
- CALL SURF_ATM_SSO_INIT(YDSURFEX%USS)
- CALL SSO_CANOPY_INIT(YDSURFEX%SSCP)
+ CALL DIAG_OPTIONS_INIT(YDSURFEX%DUO)
+ CALL DIAG_INIT(YDSURFEX%DU)
+ CALL DIAG_INIT(YDSURFEX%DUC)
+ CALL DIAG_NP_INIT(YDSURFEX%DUP,NTILESFC)
+ CALL DIAG_NP_INIT(YDSURFEX%DUPC,NTILESFC)
+ CALL SSO_INIT(YDSURFEX%USS)
+ CALL CANOPY_INIT(YDSURFEX%SB)
!
- CALL DIAG_IDEAL_INIT(YDSURFEX%DGL)
+ CALL DIAG_INIT(YDSURFEX%DL)
+ CALL DIAG_INIT(YDSURFEX%DLC)
CALL IDEAL_INIT(YDSURFEX%L)
!
CALL SV_INIT(YDSURFEX%SV)
@@ -195,11 +225,9 @@ IF (LHOOK) CALL DR_HOOK("SURFEX_ALLOC",0,ZHOOK_HANDLE)
CALL CH_EMIS_FIELD_INIT(YDSURFEX%CHE)
CALL CH_EMIS_SNAP_INIT(YDSURFEX%CHN)
CALL EMIS_GR_FIELD_INIT(YDSURFEX%EGF)
- CALL DST_INIT(YDSURFEX%DST)
+ CALL DST_NP_INIT(YDSURFEX%NDST,NVEGTYPE_ECOSG)
CALL SLT_INIT(YDSURFEX%SLT)
!
- CALL GRID_CONF_PROJ_INIT(YDSURFEX%GCP)
- !
IF (LHOOK) CALL DR_HOOK("SURFEX_ALLOC",1,ZHOOK_HANDLE)
!
END SUBROUTINE SURFEX_ALLOC
diff --git a/src/SURFEX/surfex_deallo.F90 b/src/SURFEX/surfex_deallo.F90
index 809b1d97142ecec8259f81004b2fda01ec0b4aa5..cfa6dd1577f02116fc2a34a3c0141c6a616846c7 100644
--- a/src/SURFEX/surfex_deallo.F90
+++ b/src/SURFEX/surfex_deallo.F90
@@ -17,7 +17,7 @@ TYPE (SURFEX_t), INTENT(INOUT) :: YDSURFEX
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK("SURFEX_DEALLO",0,ZHOOK_HANDLE)
!
- CALL DEALLOC_SURF_ATM_n(YDSURFEX)
+CALL DEALLOC_SURF_ATM_n(YDSURFEX)
!
IF (LHOOK) CALL DR_HOOK("SURFEX_DEALLO",1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/teb.F90 b/src/SURFEX/teb.F90
index 8a6368b164e0367b8103d32ffb87cdd1633ef04d..031c3df88c9cde9ca79ee4cde193c13b3df5ee7c 100644
--- a/src/SURFEX/teb.F90
+++ b/src/SURFEX/teb.F90
@@ -3,83 +3,25 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ##########################################################################
- SUBROUTINE TEB (HZ0H, HIMPLICIT_WIND, HWALL_OPT, HBEM, TPTIME, PTSUN, &
- PT_CANYON, PQ_CANYON, PU_CANYON, &
- PT_LOWCAN, PQ_LOWCAN, PU_LOWCAN, PZ_LOWCAN, PTI_BLD, &
- PT_ROOF, PT_ROAD, PT_WALL_A, PT_WALL_B,PWS_ROOF, PWS_ROAD,&
- HSNOW_ROOF, PWSNOW_ROOF, PTSNOW_ROOF, PRSNOW_ROOF, &
- PASNOW_ROOF, PTSSNOW_ROOF, PESNOW_ROOF, &
- HSNOW_ROAD, PWSNOW_ROAD, PTSNOW_ROAD, PRSNOW_ROAD, &
- PASNOW_ROAD, PTSSNOW_ROAD, PESNOW_ROAD, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPEW_A_COEF_LOWCAN, PPEW_B_COEF_LOWCAN, &
- PPS, PPA, PEXNS, PEXNA, PTA, PQA, PRHOA, PLW_RAD, &
- PRR, PSR, PZREF, PUREF, &
- PVMOD, PH_TRAFFIC, PLE_TRAFFIC, PH_INDUSTRY, PLE_INDUSTRY,&
- PTSTEP, PZ0_TOWN, PBLD, PGARDEN, PROAD, PFRAC_GR, &
- PBLD_HEIGHT, PWALL_O_HOR, PCAN_HW_RATIO, PWALL_O_GRND, &
- PDF_ROOF, PDN_ROOF, PDF_ROAD, &
- PDN_ROAD, PQSAT_ROOF, PQSAT_ROAD, PDELT_ROOF, PDELT_ROAD, &
- PEMIS_ROOF, PHC_ROOF, PTC_ROOF, PD_ROOF, &
- PEMIS_ROAD, PHC_ROAD, PTC_ROAD, &
- PD_ROAD, PEMIS_WALL, PTS_GARDEN, &
- PHC_WALL, PTC_WALL, PD_WALL, PRN_ROOF, PH_ROOF, PLE_ROOF, &
- PLEW_ROOF, PGFLUX_ROOF, PRUNOFF_ROOF, &
- PRN_GREENROOF, PH_GREENROOF, PLE_GREENROOF, &
- PGFLUX_GREENROOF, PUW_GREENROOF, &
- PRUNOFF_GREENROOF, PDRAIN_GREENROOF, &
- PRN_STRLROOF, PH_STRLROOF, PLE_STRLROOF, PGFLUX_STRLROOF, &
- PRUNOFF_STRLROOF, &
- PRN_ROAD, PH_ROAD, &
- PLE_ROAD, PLEW_ROAD, PGFLUX_ROAD, PRUNOFF_ROAD, &
- PRN_WALL_A, PH_WALL_A, PLE_WALL_A, PGFLUX_WALL_A, &
- PRN_WALL_B, PH_WALL_B, PLE_WALL_B, PGFLUX_WALL_B, &
- PRN_BLT, PH_BLT, PLE_BLT, PGFLUX_BLT, &
- PRNSNOW_ROOF, PHSNOW_ROOF, PLESNOW_ROOF, PGSNOW_ROOF, &
- PMELT_ROOF, &
- PRNSNOW_ROAD, PHSNOW_ROAD, PLESNOW_ROAD, PGSNOW_ROAD, &
- PMELT_ROAD, &
- PG_GREENROOF_ROOF, &
- PUW_ROAD, PUW_ROOF, PDUWDU_ROAD, PDUWDU_ROOF, &
- PUSTAR_TOWN, PCD, PCDN, PCH_TOWN, PRI_TOWN, &
- PRESA_TOWN, PDQS_TOWN, PQF_TOWN, PQF_BLD, PFLX_BLD, &
- PAC_ROOF, PAC_ROAD, PAC_WALL, PAC_TOP, PAC_GARDEN, &
- PAC_ROOF_WAT, PAC_ROAD_WAT, PABS_SW_ROOF, PABS_LW_ROOF, &
- PABS_SW_SNOW_ROOF, PABS_LW_SNOW_ROOF, PABS_SW_ROAD, &
- PABS_LW_ROAD, PABS_SW_SNOW_ROAD, PABS_LW_SNOW_ROAD, &
- PABS_SW_WALL_A,PABS_LW_WALL_A, &
- PABS_SW_WALL_B,PABS_LW_WALL_B, &
- PLW_WA_TO_WB, &
- PLW_WA_TO_R, PLW_WB_TO_R, &
- PLW_WA_TO_NR, PLW_WB_TO_NR, &
- PLW_R_TO_WA, PLW_R_TO_WB, &
- PLW_G_TO_WA, PLW_G_TO_WB, &
- PLW_S_TO_WA, PLW_S_TO_WB, PLW_S_TO_R, &
- PLW_S_TO_NR, PLW_NR_TO_WA, PLW_NR_TO_WB, &
- PLW_NR_TO_WIN, PLW_WA_TO_WIN, PLW_WB_TO_WIN, PLW_G_TO_WIN,&
- PLW_R_TO_WIN, PLW_S_TO_WIN, PLW_WIN_TO_WA, PLW_WIN_TO_WB, &
- PLW_WIN_TO_R, PLW_WIN_TO_NR, &
- HNATVENT, &
- HCOOL_COIL, PF_WATER_COND, HHEAT_COIL, OAUTOSIZE, &
- KDAY, PAUX_MAX, PT_FLOOR, PT_MASS, PH_BLD_COOL, &
- PT_BLD_COOL, PH_BLD_HEAT, PLE_BLD_COOL, PLE_BLD_HEAT, &
- PH_WASTE, PLE_WASTE, PF_WASTE_CAN, PHVAC_COOL, PHVAC_HEAT,&
- PQIN, PQIN_FRAD, PQIN_FLAT, PGR, PEFF_HEAT, &
- PINF, PTCOOL_TARGET, PTHEAT_TARGET, PHR_TARGET, PT_WIN2, &
- PQI_BLD, PV_VENT, PCAP_SYS_HEAT, PCAP_SYS_RAT, PT_ADP, &
- PM_SYS_RAT, PCOP_RAT, PCAP_SYS, PM_SYS, PCOP, PQ_SYS, &
- PT_SYS, PTR_SW_WIN, PFAN_POWER, PHC_FLOOR, PTC_FLOOR, &
- PD_FLOOR, &
- PT_WIN1, PABS_SW_WIN, PABS_LW_WIN, PUGG_WIN, PEMIT_LW_FAC,&
- PEMIT_LW_ROAD, PT_RAD_IND, PHU_BLD, PTIME, PE_SHADING, &
- ONATVENT_NIGHT, PN_FLOOR, PWALL_O_BLD, PGLAZ_O_BLD, PMASS_O_BLD, &
- PFLOOR_HW_RATIO, PF_FLOOR_MASS, PF_FLOOR_WALL, &
- PF_FLOOR_WIN, PF_FLOOR_ROOF, PF_WALL_FLOOR, PF_WALL_MASS, &
- PF_WALL_WIN, PF_WIN_FLOOR, PF_WIN_MASS, PF_WIN_WALL, &
- PF_MASS_FLOOR, PF_MASS_WALL, PF_MASS_WIN, OCANOPY, &
- HCH_BEM, PROUGH_ROOF, PROUGH_WALL, PF_WIN_WIN, &
- OPAR_RD_IRRIG, PRD_START_MONTH, PRD_END_MONTH, &
- PRD_START_HOUR, PRD_END_HOUR, PRD_24H_IRRIG, PIRRIG_ROAD )
+ SUBROUTINE TEB (TOP, T, BOP, B, TIR, DMT, HIMPLICIT_WIND, PTSUN, &
+ PT_CANYON, PQ_CANYON, PU_CANYON, PT_LOWCAN, PQ_LOWCAN, PU_LOWCAN, &
+ PZ_LOWCAN, PPEW_A_COEF, PPEW_B_COEF, PPEW_A_COEF_LOWCAN, &
+ PPEW_B_COEF_LOWCAN, PPS, PPA, PEXNS, PEXNA, PTA, PQA, PRHOA, &
+ PLW_RAD, PRR, PSR, PZREF, PUREF, PVMOD, PH_TRAFFIC, PLE_TRAFFIC, &
+ PTSTEP, PDF_RF, PDN_RF, PDF_RD, PDN_RD, PQSAT_RF, PQSAT_RD, &
+ PDELT_RF, PDELT_RD, PTS_GARDEN, PLEW_RF, PUW_GR, PLEW_RD, PLE_WL_A,&
+ PLE_WL_B, PRNSN_RF, PHSN_RF, PLESN_RF, PGSN_RF, PMELT_RF, PRN_GR, &
+ PH_GR, PLE_GR, PGFLUX_GR, PDRAIN_GR, PRUNOFF_GR, PRNSN_RD, &
+ PHSN_RD, PLESN_RD, PGSN_RD, PMELT_RD, PUW_RD, PUW_RF, PDUWDU_RD, &
+ PDUWDU_RF, PUSTAR_TWN, PCD, PCDN, PCH_TWN, PRI_TWN, PRESA_TWN, &
+ PAC_RF, PAC_RD, PAC_WL, PAC_TOP, PAC_GARDEN, PAC_RF_WAT, &
+ PAC_RD_WAT, PLW_WA_TO_WB, PLW_WA_TO_R, PLW_WB_TO_R, PLW_WA_TO_NR, &
+ PLW_WB_TO_NR, PLW_R_TO_WA, PLW_R_TO_WB, PLW_G_TO_WA, PLW_G_TO_WB, &
+ PLW_S_TO_WA, PLW_S_TO_WB, PLW_S_TO_R, PLW_S_TO_NR, PLW_NR_TO_WA, &
+ PLW_NR_TO_WB, PLW_NR_TO_WIN, PLW_WA_TO_WIN, PLW_WB_TO_WIN, &
+ PLW_G_TO_WIN, PLW_R_TO_WIN, PLW_S_TO_WIN, PLW_WIN_TO_WA, &
+ PLW_WIN_TO_WB, PLW_WIN_TO_R, PLW_WIN_TO_NR, KDAY, PEMIT_LW_FAC, &
+ PEMIT_LW_RD, PT_RAD_IND, PHU_BLD, PTIME, PE_SHADING )
! ##########################################################################
!
!!**** *TEB*
@@ -234,7 +176,14 @@
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
-! ------------
+! ------------
+!
+USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
+USE MODD_TEB_n, ONLY : TEB_t
+USE MODD_BEM_OPTION_n, ONLY : BEM_OPTIONS_t
+USE MODD_BEM_n, ONLY : BEM_t
+USE MODD_TEB_IRRIG_n, ONLY : TEB_IRRIG_t
+USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_t
!
USE MODD_TYPE_DATE_SURF,ONLY: DATE_TIME
USE MODD_CSTS, ONLY : XTT, XSTEFAN, XCPD, XLVTT
@@ -265,19 +214,16 @@ IMPLICIT NONE
!
!* 0.1 Declarations of arguments
!
+TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+TYPE(TEB_t), INTENT(INOUT) :: T
+TYPE(BEM_OPTIONS_t), INTENT(INOUT) :: BOP
+TYPE(BEM_t), INTENT(INOUT) :: B
+TYPE(TEB_IRRIG_t), INTENT(INOUT) :: TIR
+TYPE(DIAG_MISC_TEB_t), INTENT(INOUT) :: DMT
!
- CHARACTER(LEN=6), INTENT(IN) :: HZ0H ! TEB option for z0h roof & road
-! ! 'MASC95' : Mascart et al 1995
-! ! 'BRUT82' : Brustaert 1982
-! ! 'KAND07' : Kanda 2007
CHARACTER(LEN=*), INTENT(IN) :: HIMPLICIT_WIND ! wind implicitation option
! ! 'OLD' = direct
! ! 'NEW' = Taylor serie, order 1
- CHARACTER(LEN=4), INTENT(IN) :: HWALL_OPT ! TEB option for walls
- ! 'UNIF' : uniform walls
- ! 'TWO ' : two different opposite walls
- CHARACTER(LEN=3), INTENT(IN) :: HBEM ! Building Energy model 'DEF' or 'BEM'
-TYPE(DATE_TIME) , INTENT(IN) :: TPTIME ! current date and time from teb
REAL, DIMENSION(:), INTENT(IN) :: PTSUN ! solar time (s from midnight)
REAL, DIMENSION(:), INTENT(INOUT) :: PT_CANYON ! canyon air temperature
REAL, DIMENSION(:), INTENT(INOUT) :: PQ_CANYON ! canyon air specific humidity
@@ -286,33 +232,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PU_LOWCAN ! wind near the road
REAL, DIMENSION(:), INTENT(IN) :: PT_LOWCAN ! temp. near the road
REAL, DIMENSION(:), INTENT(IN) :: PQ_LOWCAN ! hum. near the road
REAL, DIMENSION(:), INTENT(IN) :: PZ_LOWCAN ! height of atm. var. near the road
-REAL, DIMENSION(:), INTENT(INOUT) :: PTI_BLD ! inside building temperature
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PT_ROOF ! roof layers temperatures
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PT_ROAD ! road layers temperatures
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PT_WALL_A ! wall A layers temperatures
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PT_WALL_B ! wall B layers temperatures
-REAL, DIMENSION(:), INTENT(INOUT) :: PWS_ROOF ! roof water reservoir
-REAL, DIMENSION(:), INTENT(INOUT) :: PWS_ROAD ! road water reservoir
- CHARACTER(LEN=*), INTENT(IN) :: HSNOW_ROOF ! snow roof scheme
-! ! 'NONE'
-! ! 'D95 '
-! ! '1-L '
- CHARACTER(LEN=*), INTENT(IN) :: HSNOW_ROAD ! snow road scheme
-! ! 'NONE'
-! ! 'D95 '
-! ! '1-L '
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PWSNOW_ROOF ! snow layers reservoir
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTSNOW_ROOF ! snow layers temperature
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRSNOW_ROOF ! snow layers density
-REAL, DIMENSION(:), INTENT(INOUT) :: PASNOW_ROOF ! snow albedo
-REAL, DIMENSION(:), INTENT(INOUT) :: PESNOW_ROOF ! snow emissivity
-REAL, DIMENSION(:), INTENT(INOUT) :: PTSSNOW_ROOF! snow surface temperature
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PWSNOW_ROAD ! snow layers reservoir
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTSNOW_ROAD ! snow layers temperature
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRSNOW_ROAD ! snow layers density
-REAL, DIMENSION(:), INTENT(INOUT) :: PASNOW_ROAD ! snow albedo
-REAL, DIMENSION(:), INTENT(INOUT) :: PESNOW_ROAD ! snow emissivity
-REAL, DIMENSION(:), INTENT(INOUT) :: PTSSNOW_ROAD! snow surface temperature
REAL, DIMENSION(:), INTENT(IN) :: PPEW_A_COEF ! implicit coefficients
REAL, DIMENSION(:), INTENT(IN) :: PPEW_B_COEF ! for wind coupling
REAL, DIMENSION(:), INTENT(IN) :: PPEW_A_COEF_LOWCAN ! implicit coefficients for wind coupling
@@ -324,6 +243,10 @@ REAL, DIMENSION(:), INTENT(IN) :: PTA ! temperature at the lowest l
REAL, DIMENSION(:), INTENT(IN) :: PQA ! specific humidity
! at the lowest level
REAL, DIMENSION(:), INTENT(IN) :: PVMOD ! module of the horizontal wind
+REAL, DIMENSION(:), INTENT(IN) :: PH_TRAFFIC ! anthropogenic sensible
+! ! heat fluxes due to traffic
+REAL, DIMENSION(:), INTENT(IN) :: PLE_TRAFFIC ! anthropogenic latent
+! ! heat fluxes due to traffic
REAL, DIMENSION(:), INTENT(IN) :: PEXNA ! exner function
! at the lowest level
REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! air density
@@ -331,141 +254,67 @@ REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! air density
REAL, DIMENSION(:), INTENT(IN) :: PLW_RAD ! atmospheric infrared radiation
REAL, DIMENSION(:), INTENT(IN) :: PRR ! rain rate
REAL, DIMENSION(:), INTENT(IN) :: PSR ! snow rate
-REAL, DIMENSION(:), INTENT(IN) :: PH_TRAFFIC ! anthropogenic sensible
-! ! heat fluxes due to traffic
-REAL, DIMENSION(:), INTENT(IN) :: PLE_TRAFFIC ! anthropogenic latent
-! ! heat fluxes due to traffic
-REAL, DIMENSION(:), INTENT(IN) :: PH_INDUSTRY ! anthropogenic sensible
-! ! heat fluxes due to factories
-REAL, DIMENSION(:), INTENT(IN) :: PLE_INDUSTRY ! anthropogenic latent
-! ! heat fluxes due to factories
REAL, DIMENSION(:), INTENT(IN) :: PZREF ! reference height of the first
! atmospheric level (temperature)
REAL, DIMENSION(:), INTENT(IN) :: PUREF ! reference height of the first
! atmospheric level (wind)
REAL, INTENT(IN) :: PTSTEP ! time step
-REAL, DIMENSION(:), INTENT(IN) :: PZ0_TOWN ! town roughness length
- ! for momentum
-REAL, DIMENSION(:), INTENT(IN) :: PBLD ! fraction of buildings
-REAL, DIMENSION(:), INTENT(IN) :: PGARDEN ! fraction of GARDEN areas
-REAL, DIMENSION(:), INTENT(IN) :: PROAD ! fraction of roads
-REAL, DIMENSION(:), INTENT(IN) :: PFRAC_GR ! fraction of green roofs
-REAL, DIMENSION(:), INTENT(IN) :: PBLD_HEIGHT ! buildings h
-REAL, DIMENSION(:), INTENT(IN) :: PWALL_O_HOR ! wall surf. / hor. surf.
-REAL, DIMENSION(:), INTENT(IN) :: PCAN_HW_RATIO ! canyon h/W
-REAL, DIMENSION(:), INTENT(IN) :: PWALL_O_GRND ! wall surf. / (road + gard. surf.)
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PDF_ROOF ! snow-free fraction on roofs
-REAL, DIMENSION(:), INTENT(INOUT) :: PDN_ROOF ! snow-covered fraction on roofs
-REAL, DIMENSION(:), INTENT(INOUT) :: PDF_ROAD ! snow-free fraction on roads
-REAL, DIMENSION(:), INTENT(INOUT) :: PDN_ROAD ! snow-covered fraction on roads
-REAL, DIMENSION(:), INTENT(OUT) :: PQSAT_ROOF ! hum at saturation over roof
-REAL, DIMENSION(:), INTENT(OUT) :: PQSAT_ROAD ! hum at saturation over road
-REAL, DIMENSION(:), INTENT(OUT) :: PDELT_ROOF ! water fraction on roof
-REAL, DIMENSION(:), INTENT(OUT) :: PDELT_ROAD ! water fraction on road
-!
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_ROOF ! roof emissivity
-REAL, DIMENSION(:,:), INTENT(IN) :: PHC_ROOF ! heat capacity for roof layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PTC_ROOF ! thermal conductivity for roof layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_ROOF ! depth of roof layers
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_ROAD ! road emissivity
-REAL, DIMENSION(:,:), INTENT(IN) :: PHC_ROAD ! heat capacity for road layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PTC_ROAD ! thermal conductivity for road layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_ROAD ! depth of road layers
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_WALL ! wall emissivity
-REAL, DIMENSION(:,:), INTENT(IN) :: PHC_WALL ! heat capacity for wall layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PTC_WALL ! thermal conductivity for wall layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_WALL ! depth of wall layers
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PDF_RF ! snow-free fraction on roofs
+REAL, DIMENSION(:), INTENT(INOUT) :: PDN_RF ! snow-covered fraction on roofs
+REAL, DIMENSION(:), INTENT(INOUT) :: PDF_RD ! snow-free fraction on roads
+REAL, DIMENSION(:), INTENT(INOUT) :: PDN_RD ! snow-covered fraction on roads
+REAL, DIMENSION(:), INTENT(OUT) :: PQSAT_RF ! hum at saturation over roof
+REAL, DIMENSION(:), INTENT(OUT) :: PQSAT_RD ! hum at saturation over road
+REAL, DIMENSION(:), INTENT(OUT) :: PDELT_RF ! water fraction on roof
+REAL, DIMENSION(:), INTENT(OUT) :: PDELT_RD ! water fraction on road
+!
REAL, DIMENSION(:), INTENT(IN) :: PTS_GARDEN ! GARDEN area surf temp.
! greenroof
-REAL, DIMENSION(:), INTENT(IN) :: PG_GREENROOF_ROOF ! snow melt
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PRN_ROOF ! net radiation over roof
-REAL, DIMENSION(:), INTENT(OUT) :: PH_ROOF ! sensible heat flux over roof
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_ROOF ! latent heat flux over roof
-REAL, DIMENSION(:), INTENT(OUT) :: PLEW_ROOF ! latent heat flux over roof (snow)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX_ROOF ! flux through the roof
-REAL, DIMENSION(:), INTENT(OUT) :: PRUNOFF_STRLROOF ! runoff over the ground
-REAL, DIMENSION(:), INTENT(OUT) :: PRUNOFF_ROOF ! runoff over roofs
-REAL, DIMENSION(:), INTENT(OUT) :: PRN_ROAD ! net radiation over road
-REAL, DIMENSION(:), INTENT(OUT) :: PH_ROAD ! sensible heat flux over road
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_ROAD ! latent heat flux over road
-REAL, DIMENSION(:), INTENT(OUT) :: PLEW_ROAD ! latent heat flux over road (snow)
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX_ROAD ! flux through the road
-REAL, DIMENSION(:), INTENT(OUT) :: PRUNOFF_ROAD ! runoff over the ground
-REAL, DIMENSION(:), INTENT(OUT) :: PRN_WALL_A ! net radiation over wall
-REAL, DIMENSION(:), INTENT(OUT) :: PH_WALL_A ! sensible heat flux over wall
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_WALL_A ! latent heat flux over wall
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX_WALL_A! flux through the wall
-REAL, DIMENSION(:), INTENT(OUT) :: PRN_WALL_B ! net radiation over wall
-REAL, DIMENSION(:), INTENT(OUT) :: PH_WALL_B ! sensible heat flux over wall
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_WALL_B ! latent heat flux over wall
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX_WALL_B! flux through the wall
-REAL, DIMENSION(:), INTENT(OUT) :: PRN_BLT ! net radiation over built surf
-REAL, DIMENSION(:), INTENT(OUT) :: PH_BLT ! sensible heat flux over built surf
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_BLT ! latent heat flux over built surf
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX_BLT ! flux through the built surf
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRN_GREENROOF ! net radiation over greenroof
-REAL, DIMENSION(:), INTENT(IN) :: PH_GREENROOF ! sensible heat flux over greenroof
-REAL, DIMENSION(:), INTENT(IN) :: PLE_GREENROOF ! latent heat flux over greenroof
-REAL, DIMENSION(:), INTENT(IN) :: PGFLUX_GREENROOF ! flux through the greenroof
-REAL, DIMENSION(:), INTENT(IN) :: PUW_GREENROOF ! Momentum flux for greenroofs
-REAL, DIMENSION(:), INTENT(IN) :: PRUNOFF_GREENROOF ! runoff over green roofs
-REAL, DIMENSION(:), INTENT(IN) :: PDRAIN_GREENROOF ! outlet drainage at base of green roofs
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PRN_STRLROOF ! net radiation over structural roof
-REAL, DIMENSION(:), INTENT(OUT) :: PH_STRLROOF ! sensible heat flux over structural roof
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_STRLROOF ! latent heat flux over structural roof
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX_STRLROOF ! flux through the structural roof
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PRNSNOW_ROOF ! net radiation over snow
-REAL, DIMENSION(:), INTENT(OUT) :: PHSNOW_ROOF ! sensible heat flux over snow
-REAL, DIMENSION(:), INTENT(OUT) :: PLESNOW_ROOF ! latent heat flux over snow
-REAL, DIMENSION(:), INTENT(OUT) :: PGSNOW_ROOF ! flux under the snow
-REAL, DIMENSION(:), INTENT(OUT) :: PMELT_ROOF ! snow melt
-REAL, DIMENSION(:), INTENT(OUT) :: PRNSNOW_ROAD ! net radiation over snow
-REAL, DIMENSION(:), INTENT(OUT) :: PHSNOW_ROAD ! sensible heat flux over snow
-REAL, DIMENSION(:), INTENT(OUT) :: PLESNOW_ROAD ! latent heat flux over snow
-REAL, DIMENSION(:), INTENT(OUT) :: PGSNOW_ROAD ! flux under the snow
-REAL, DIMENSION(:), INTENT(OUT) :: PMELT_ROAD ! snow melt
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PUW_ROAD ! Momentum flux for roads
-REAL, DIMENSION(:), INTENT(OUT) :: PUW_ROOF ! Momentum flux for roofs
-REAL, DIMENSION(:), INTENT(OUT) :: PDUWDU_ROAD !
-REAL, DIMENSION(:), INTENT(OUT) :: PDUWDU_ROOF !
-REAL, DIMENSION(:), INTENT(OUT) :: PUSTAR_TOWN ! friciton velocity over town
+REAL, DIMENSION(:), INTENT(OUT) :: PLEW_RF ! latent heat flux over roof (snow)
+REAL, DIMENSION(:), INTENT(OUT) :: PLEW_RD ! latent heat flux over road (snow)
+REAL, DIMENSION(:), INTENT(OUT) :: PLE_WL_A ! latent heat flux over wall
+REAL, DIMENSION(:), INTENT(OUT) :: PLE_WL_B ! latent heat flux over wall
+!
+REAL, DIMENSION(:), INTENT(IN) :: PUW_GR ! Momentum flux for greenroofs
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PRNSN_RF ! net radiation over snow
+REAL, DIMENSION(:), INTENT(OUT) :: PHSN_RF ! sensible heat flux over snow
+REAL, DIMENSION(:), INTENT(OUT) :: PLESN_RF ! latent heat flux over snow
+REAL, DIMENSION(:), INTENT(OUT) :: PGSN_RF ! flux under the snow
+REAL, DIMENSION(:), INTENT(OUT) :: PMELT_RF ! snow melt
+REAL, DIMENSION(:), INTENT(OUT) :: PRNSN_RD ! net radiation over snow
+REAL, DIMENSION(:), INTENT(OUT) :: PHSN_RD ! sensible heat flux over snow
+REAL, DIMENSION(:), INTENT(OUT) :: PLESN_RD ! latent heat flux over snow
+REAL, DIMENSION(:), INTENT(OUT) :: PGSN_RD ! flux under the snow
+REAL, DIMENSION(:), INTENT(OUT) :: PMELT_RD ! snow melt
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PUW_RD ! Momentum flux for roads
+REAL, DIMENSION(:), INTENT(OUT) :: PUW_RF ! Momentum flux for roofs
+REAL, DIMENSION(:), INTENT(OUT) :: PDUWDU_RD !
+REAL, DIMENSION(:), INTENT(OUT) :: PDUWDU_RF !
+REAL, DIMENSION(:), INTENT(OUT) :: PUSTAR_TWN ! friciton velocity over town
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRN_GR ! net radiation over greenroof
+REAL, DIMENSION(:), INTENT(IN) :: PH_GR ! sensible heat flux over greenroof
+REAL, DIMENSION(:), INTENT(IN) :: PLE_GR ! latent heat flux over greenroof
+REAL, DIMENSION(:), INTENT(IN) :: PGFLUX_GR ! flux through the greenroof
+REAL, DIMENSION(:), INTENT(IN) :: PRUNOFF_GR ! runoff over green roofs
+REAL, DIMENSION(:), INTENT(IN) :: PDRAIN_GR ! outlet drainage at base of green roofs
+!
REAL, DIMENSION(:), INTENT(OUT) :: PCD ! town averaged drag coefficient
REAL, DIMENSION(:), INTENT(OUT) :: PCDN ! town averaged neutral drag coefficient
-REAL, DIMENSION(:), INTENT(OUT) :: PCH_TOWN ! town averaged heat transfer
+REAL, DIMENSION(:), INTENT(OUT) :: PCH_TWN ! town averaged heat transfer
! ! coefficient
-REAL, DIMENSION(:), INTENT(OUT) :: PRI_TOWN ! town averaged Richardson number
-REAL, DIMENSION(:), INTENT(OUT) :: PRESA_TOWN ! town aerodynamical resistance
-REAL, DIMENSION(:), INTENT(OUT) :: PDQS_TOWN ! heat storage inside town
-REAL, DIMENSION(:), INTENT(OUT) :: PQF_TOWN ! total anthropogenic heat
-REAL, DIMENSION(:), INTENT(OUT) :: PQF_BLD ! anthropogenic heat flux of
- ! domestic heating
-REAL, DIMENSION(:), INTENT(OUT) :: PFLX_BLD ! heat flx from inside bld through its structure
-REAL, DIMENSION(:), INTENT(OUT) :: PAC_ROOF ! roof conductance
-REAL, DIMENSION(:), INTENT(INOUT) :: PAC_ROAD ! road conductance
-REAL, DIMENSION(:), INTENT(OUT) :: PAC_WALL ! wall conductance
+REAL, DIMENSION(:), INTENT(OUT) :: PRI_TWN ! town averaged Richardson number
+REAL, DIMENSION(:), INTENT(OUT) :: PRESA_TWN ! town aerodynamical resistance
+REAL, DIMENSION(:), INTENT(OUT) :: PAC_RF ! roof conductance
+REAL, DIMENSION(:), INTENT(INOUT) :: PAC_RD ! road conductance
+REAL, DIMENSION(:), INTENT(OUT) :: PAC_WL ! wall conductance
REAL, DIMENSION(:), INTENT(OUT) :: PAC_TOP ! top conductance
REAL, DIMENSION(:), INTENT(IN) :: PAC_GARDEN ! garden conductance
-REAL, DIMENSION(:), INTENT(OUT) :: PAC_ROOF_WAT ! roof water conductance
-REAL, DIMENSION(:), INTENT(OUT) :: PAC_ROAD_WAT ! roof water conductance
-!
-REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_ROOF ! absorbed solar rad by roof
-REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_SNOW_ROOF ! absorbed solar rad by snow on roof
-REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_ROAD ! absorbed solar rad by road
-REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_SNOW_ROAD ! absorbed solar rad by snow on road
-REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_WALL_A ! absorbed solar rad by wall
-REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_WALL_B ! absorbed solar rad by wall
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_LW_ROOF ! absorbed IR rad by roof
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_LW_SNOW_ROOF ! absorbed IR rad by snow on roof
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_LW_ROAD ! absorbed IR rad by road
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_LW_SNOW_ROAD ! absorbed IR rad by snow on road
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_LW_WALL_A ! absorbed IR rad by wall
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_LW_WALL_B ! absorbed IR rad by wall
+REAL, DIMENSION(:), INTENT(OUT) :: PAC_RF_WAT ! roof water conductance
+REAL, DIMENSION(:), INTENT(OUT) :: PAC_RD_WAT ! roof water conductance
!
REAL, DIMENSION(:), INTENT(IN) :: PLW_WA_TO_WB ! LW contrib. wall A (orB) -> wall B (or A)
REAL, DIMENSION(:), INTENT(IN) :: PLW_WA_TO_R ! LW contrib. wall -> road
@@ -485,69 +334,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PLW_S_TO_NR ! LW contrib. sky
!
! new arguments after BEM
!
- CHARACTER(LEN=4), DIMENSION(:), INTENT(IN) :: HNATVENT
- CHARACTER(LEN=6), INTENT(IN) :: HCOOL_COIL
-REAL, DIMENSION(:), INTENT(IN) :: PF_WATER_COND!fraction of evaporation for the condensers
- CHARACTER(LEN=6), INTENT(IN) :: HHEAT_COIL
-LOGICAL, INTENT(IN) :: OAUTOSIZE ! Flag to activate autosize calculations
INTEGER, INTENT(IN) :: KDAY ! Simulation day
-REAL, DIMENSION(:), INTENT(INOUT) :: PAUX_MAX ! Auxiliar variable for autosize calcs
-REAL, DIMENSION(:,:), INTENT(INOUT):: PT_FLOOR ! Floor layers temperatures [K]
-REAL, DIMENSION(:,:), INTENT(INOUT):: PT_MASS ! Internal mass layers temperatures [K]
-REAL, DIMENSION(:), INTENT(OUT) :: PH_BLD_COOL ! Sensible cooling energy demand
- ! of the building [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PT_BLD_COOL ! Total cooling energy demand
- ! of the building [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PH_BLD_HEAT ! Heating energy demand
- ! of the building [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_BLD_COOL ! Latent cooling energy demand
- ! of the building [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_BLD_HEAT ! Latent heating energy demand
- ! of the building [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PH_WASTE ! Sensible waste heat from HVAC system
- ! [W m-2(tot)]
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_WASTE ! Latent waste heat from HVAC system
- ! [W m-2(tot)]
-REAL, DIMENSION(:), INTENT(IN) :: PF_WASTE_CAN ! fraction of waste heat released into the canyon
-REAL, DIMENSION(:), INTENT(OUT) :: PHVAC_COOL ! Energy consumption of the cooling system
- ! [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PHVAC_HEAT ! Energy consumption of the heating system
- ! [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(IN) :: PQIN ! Internal heat gains [W m-2(floor)]
-REAL, DIMENSION(:), INTENT(IN) :: PQIN_FRAD ! Radiant fraction of internal heat gains
-REAL, DIMENSION(:), INTENT(IN) :: PQIN_FLAT ! Latent franction of internal heat gains
-REAL, DIMENSION(:), INTENT(IN) :: PGR ! Glazing ratio
-REAL, DIMENSION(:), INTENT(IN) :: PEFF_HEAT ! Efficiency of the heating system
-REAL, DIMENSION(:), INTENT(IN) :: PINF ! Infiltration flow rate [AC/H]
-REAL, DIMENSION(:), INTENT(IN) :: PTCOOL_TARGET ! Cooling setpoint of HVAC system [K]
-REAL, DIMENSION(:), INTENT(IN) :: PTHEAT_TARGET ! Heating setpoint of HVAC system [K]
-REAL, DIMENSION(:), INTENT(IN) :: PHR_TARGET ! Relative humidity setpoint
-REAL, DIMENSION(:), INTENT(INOUT):: PT_WIN2 ! Indoor window temperature [K]
-REAL, DIMENSION(:), INTENT(INOUT):: PQI_BLD ! Indoor air specific humidity [kg kg-1]
-REAL, DIMENSION(:), INTENT(IN) :: PV_VENT ! Ventilation flow rate [AC/H]
-REAL, DIMENSION(:), INTENT(IN) :: PCAP_SYS_HEAT ! Capacity of the heating system
- ! [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(INOUT):: PCAP_SYS_RAT ! Rated capacity of the cooling system
- ! [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(IN) :: PT_ADP ! Apparatus dewpoint temperature of the
- ! cooling coil [K]
-REAL, DIMENSION(:), INTENT(INOUT):: PM_SYS_RAT ! Rated HVAC mass flow rate
- ! [kg s-1 m-2(bld)]
-REAL, DIMENSION(:), INTENT(IN) :: PCOP_RAT ! Rated COP of the cooling system
-REAL, DIMENSION(:), INTENT(OUT) :: PCAP_SYS ! Actual capacity of the cooling system
- ! [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PM_SYS ! Actual HVAC mass flow rate
- ! [kg s-1 m-2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PCOP ! COP of the cooling system
-REAL, DIMENSION(:), INTENT(OUT) :: PQ_SYS ! Supply air specific humidity [kg kg-1]
-REAL, DIMENSION(:), INTENT(OUT) :: PT_SYS ! Supply air temperature [K]
-REAL, DIMENSION(:), INTENT(IN) :: PTR_SW_WIN ! Solar radiation transmitted throught
- ! windows [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PFAN_POWER ! HVAC fan power
-REAL, DIMENSION(:,:),INTENT(IN) :: PHC_FLOOR ! heat capacity for road layers
-REAL, DIMENSION(:,:),INTENT(IN) :: PTC_FLOOR ! thermal conductivity for
- ! road layers
-REAL, DIMENSION(:,:),INTENT(IN) :: PD_FLOOR ! depth of road layers
REAL, DIMENSION(:), INTENT(IN) :: PLW_WA_TO_WIN ! Radiative heat trasfer coeff wall-window
! [W K-1 m-2]
REAL, DIMENSION(:), INTENT(IN) :: PLW_WB_TO_WIN ! Radiative heat trasfer coeff wall-window
@@ -568,187 +355,147 @@ REAL, DIMENSION(:), INTENT(IN) :: PLW_NR_TO_WIN! Radiative heat trasfer coeff
! [W K-1 m-2]
REAL, DIMENSION(:), INTENT(IN) :: PLW_WIN_TO_NR! Radiative heat trasfer coeff win-road(snow)
! [W K-1 m-2]
-REAL, DIMENSION(:), INTENT(INOUT):: PT_WIN1 ! outdoor window temperature [K]
-REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_WIN ! window absorbed shortwave radiation [W m-2]
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_LW_WIN ! absorbed infrared rad. [W m-2]
-REAL, DIMENSION(:), INTENT(IN) :: PUGG_WIN ! window glass-to-glass U-factro [W m-2 K-1]
!new argument for PET calculation
-REAL, DIMENSION(:), INTENT(OUT) :: PEMIT_LW_ROAD ! LW fluxes emitted by road (W/m2 surf road)
+REAL, DIMENSION(:), INTENT(OUT) :: PEMIT_LW_RD ! LW fluxes emitted by road (W/m2 surf road)
REAL, DIMENSION(:), INTENT(OUT) :: PEMIT_LW_FAC ! LW fluxes emitted by wall (W/m2 surf wall)
REAL, DIMENSION(:), INTENT(OUT) :: PT_RAD_IND ! Indoor mean radiant temperature [K]
REAL, DIMENSION(:), INTENT(OUT) :: PHU_BLD ! Indoor relative humidity 0 < (-) < 1
REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s)
REAL, DIMENSION(:), INTENT(IN) :: PE_SHADING !energy not ref., nor absorbed, nor
!trans. by glazing [Wm-2(win)]
-LOGICAL, DIMENSION(:),INTENT(INOUT) :: ONATVENT_NIGHT ! has natural ventilation
- !been necessary/possible during the night
-!
-REAL, DIMENSION(:) , INTENT(IN) :: PN_FLOOR ! Number of floors
-REAL, DIMENSION(:) , INTENT(IN) :: PWALL_O_BLD ! Wall area [m2_wall/m2_bld]
-REAL, DIMENSION(:) , INTENT(IN) :: PGLAZ_O_BLD ! Window area [m2_win/m2_bld]
-REAL, DIMENSION(:) , INTENT(IN) :: PMASS_O_BLD ! Mass area [m2_mass/m2_bld]
-REAL, DIMENSION(:) , INTENT(IN) :: PFLOOR_HW_RATIO ! H/W ratio of 1 floor level
-REAL, DIMENSION(:) , INTENT(IN) :: PF_FLOOR_MASS ! View factor floor-mass
-REAL, DIMENSION(:) , INTENT(IN) :: PF_FLOOR_WALL ! View factor floor-wall
-REAL, DIMENSION(:) , INTENT(IN) :: PF_FLOOR_WIN ! View factor floor-window
-REAL, DIMENSION(:) , INTENT(IN) :: PF_FLOOR_ROOF ! View factor floor-roof
-REAL, DIMENSION(:) , INTENT(IN) :: PF_WALL_FLOOR ! View factor wall-floor
-REAL, DIMENSION(:) , INTENT(IN) :: PF_WALL_MASS ! View factor wall-mass
-REAL, DIMENSION(:) , INTENT(IN) :: PF_WALL_WIN ! View factor wall-win
-REAL, DIMENSION(:) , INTENT(IN) :: PF_WIN_FLOOR ! View factor win-floor
-REAL, DIMENSION(:) , INTENT(IN) :: PF_WIN_MASS ! View factor win-mass
-REAL, DIMENSION(:) , INTENT(IN) :: PF_WIN_WALL ! View factor win-wall
-REAL, DIMENSION(:) , INTENT(IN) :: PF_MASS_FLOOR ! View factor mass-floor
-REAL, DIMENSION(:) , INTENT(IN) :: PF_MASS_WALL ! View factor mass-wall
-REAL, DIMENSION(:) , INTENT(IN) :: PF_MASS_WIN ! View factor mass-window
-LOGICAL, INTENT(IN) :: OCANOPY ! is canopy active ?
- CHARACTER(LEN=5), INTENT(IN) :: HCH_BEM ! TEB option for outside building coef
- ! "DOE-2"
-REAL, DIMENSION(:) , INTENT(IN) :: PROUGH_ROOF ! roof roughness coef
-REAL, DIMENSION(:) , INTENT(IN) :: PROUGH_WALL ! wall roughness coef
-REAL, DIMENSION(:) , INTENT(IN) :: PF_WIN_WIN ! indoor win to win view factor
-!
-!* arguments for road watering
-!
-LOGICAL, INTENT(IN) :: OPAR_RD_IRRIG ! True if there is potentially irrigation
-REAL, DIMENSION(:), INTENT(IN) :: PRD_START_MONTH! First month of irrigation
-REAL, DIMENSION(:), INTENT(IN) :: PRD_END_MONTH ! Last month of irrigation
-REAL, DIMENSION(:), INTENT(IN) :: PRD_START_HOUR ! First hour of irrigation (included)
-REAL, DIMENSION(:), INTENT(IN) :: PRD_END_HOUR ! Last hour of irrigation (excluded)
-REAL, DIMENSION(:), INTENT(IN) :: PRD_24H_IRRIG ! diurnal averaged irrigation flux (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PIRRIG_ROAD ! man-made watering for road (kg/m2/s)
!
!* 0.2 Declarations of local variables
!
REAL, DIMENSION(SIZE(PTA)) :: ZVMOD ! wind
-REAL, DIMENSION(SIZE(PTA)) :: ZWS_ROOF_MAX ! maximum deepness of roof
-REAL, DIMENSION(SIZE(PTA)) :: ZWS_ROAD_MAX ! and road water reservoirs
+REAL, DIMENSION(SIZE(PTA)) :: ZWS_RF_MAX ! maximum deepness of roof
+REAL, DIMENSION(SIZE(PTA)) :: ZWS_RD_MAX ! and road water reservoirs
!
REAL, DIMENSION(SIZE(PTA)) :: ZAC_BLD ! surface conductance inside the building itself in DEF building model
REAL, DIMENSION(SIZE(PTA)) :: ZTA ! air temperature extrapolated at roof level
REAL, DIMENSION(SIZE(PTA)) :: ZQA ! air humidity extrapolated at roof level
!
-REAL, DIMENSION(SIZE(PTA)) :: ZDQS_ROAD ! heat storage inside road
-REAL, DIMENSION(SIZE(PTA)) :: ZDQS_ROOF ! heat storage inside roof
-REAL, DIMENSION(SIZE(PTA)) :: ZDQS_WALL_A ! heat storage inside wall
-REAL, DIMENSION(SIZE(PTA)) :: ZDQS_WALL_B ! heat storage inside wall
-REAL, DIMENSION(SIZE(PTA)) :: ZFLX_BLD_ROOF !heat flux from inside through roof
-REAL, DIMENSION(SIZE(PTA)) :: ZFLX_BLD_WALL_A!heat flux from inside through wall
-REAL, DIMENSION(SIZE(PTA)) :: ZFLX_BLD_WALL_B!heat flux from inside through wall
-REAL, DIMENSION(SIZE(PTA)) :: ZFLX_BLD_FLOOR !heat flux from inside through floor
-REAL, DIMENSION(SIZE(PTA)) :: ZFLX_BLD_MASS !heat flux from inside through mass
-!
-REAL, DIMENSION(SIZE(PTA)) :: ZDQS_SNOW_ROOF ! heat storage inside roof snowpack
-REAL, DIMENSION(SIZE(PTA)) :: ZDQS_SNOW_ROAD ! heat storage inside road snowpack
+REAL, DIMENSION(SIZE(PTA)) :: ZDQS_RD ! heat storage inside road
+REAL, DIMENSION(SIZE(PTA)) :: ZDQS_RF ! heat storage inside roof
+REAL, DIMENSION(SIZE(PTA)) :: ZDQS_WL_A ! heat storage inside wall
+REAL, DIMENSION(SIZE(PTA)) :: ZDQS_WL_B ! heat storage inside wall
+REAL, DIMENSION(SIZE(PTA)) :: ZFLX_BLD_RF !heat flux from inside through roof
+REAL, DIMENSION(SIZE(PTA)) :: ZFLX_BLD_WL_A!heat flux from inside through wall
+REAL, DIMENSION(SIZE(PTA)) :: ZFLX_BLD_WL_B!heat flux from inside through wall
+REAL, DIMENSION(SIZE(PTA)) :: ZFLX_BLD_FL !heat flux from inside through floor
+REAL, DIMENSION(SIZE(PTA)) :: ZFLX_BLD_MA !heat flux from inside through mass
+!
+REAL, DIMENSION(SIZE(PTA)) :: ZDQS_SN_RF ! heat storage inside roof snowpack
+REAL, DIMENSION(SIZE(PTA)) :: ZDQS_SN_RD ! heat storage inside road snowpack
REAL, DIMENSION(SIZE(PTA)) :: ZMELT_BLT ! Snow melt for built & impervious part
!
! coefficients for LW computations over snow (from previous time-step)
!
-REAL, DIMENSION(SIZE(PTA)) :: ZTSSNOW_ROAD ! road snow temperature
+REAL, DIMENSION(SIZE(PTA)) :: ZTSSN_RD ! road snow temperature
! ! at previous time-step
! new local variables after BEM
!
-REAL, DIMENSION(SIZE(PTA)) :: ZIMB_ROOF ! residual energy imbalance
+REAL, DIMENSION(SIZE(PTA)) :: ZIMB_RF ! residual energy imbalance
! of the roof for
! verification
-REAL, DIMENSION(SIZE(PTA)) :: ZIMB_ROAD ! road residual energy imbalance
+REAL, DIMENSION(SIZE(PTA)) :: ZIMB_RD ! road residual energy imbalance
! for verification [W m-2]
-REAL, DIMENSION(SIZE(PTA)) :: ZIMB_WALL ! wall residual energy imbalance
+REAL, DIMENSION(SIZE(PTA)) :: ZIMB_WL ! wall residual energy imbalance
! for verification [W m-2]
-REAL, DIMENSION(SIZE(PTA)) :: ZTS_ROAD ! road surface temperature
+REAL, DIMENSION(SIZE(PTA)) :: ZTS_RD ! road surface temperature
! ! at previous time-step
-REAL, DIMENSION(SIZE(PTA)) :: ZTS_WALL_A ! wall A surface temperature
+REAL, DIMENSION(SIZE(PTA)) :: ZTS_WL_A ! wall A surface temperature
! ! at previous time-step
-REAL, DIMENSION(SIZE(PTA)) :: ZTS_WALL_B ! wall B surface temperature
+REAL, DIMENSION(SIZE(PTA)) :: ZTS_WL_B ! wall B surface temperature
! ! at previous time-step
-REAL, DIMENSION(SIZE(PTA)) :: ZTS_WALL ! averaged wall surface temperature
+REAL, DIMENSION(SIZE(PTA)) :: ZTS_WL ! averaged wall surface temperature
! ! at previous time-step
-REAL, DIMENSION(SIZE(PTA)) :: ZTS_ROOF ! roof surface temperature
+REAL, DIMENSION(SIZE(PTA)) :: ZTS_RF ! roof surface temperature
! ! at previous time-step
-REAL, DIMENSION(SIZE(PTA),SIZE(PT_WALL_A,2)) :: ZT_WALL ! averaged wall surface temperature
+REAL, DIMENSION(SIZE(PTA),SIZE(T%XT_WALL_A,2)) :: ZT_WL ! averaged wall surface temperature
!
-INTEGER :: IWALL, IROOF ! number of wall, roof layer
+INTEGER :: IWL, IRF ! number of wall, roof layer
REAL, DIMENSION(SIZE(PTA)) :: ZRADHT_IN ! Indoor radiant heat transfer coefficient
! [W K-1 m-2]
-REAL, DIMENSION(SIZE(PTA)) :: ZTS_FLOOR ! floor surface temperature [K]
-REAL, DIMENSION(SIZE(PTA)) :: ZRAD_ROOF_WALL ! rad. flux from roof to averaged wall [W m-2(roof)]
-REAL, DIMENSION(SIZE(PTA)) :: ZRAD_ROOF_WIN ! rad. flux from roof to window [W m-2(roof)]
-REAL, DIMENSION(SIZE(PTA)) :: ZRAD_ROOF_FLOOR ! rad. flux from roof to floor [W m-2(roof)]
-REAL, DIMENSION(SIZE(PTA)) :: ZRAD_ROOF_MASS ! rad. flux from roof to mass [W m-2(roof)]
-REAL, DIMENSION(SIZE(PTA)) :: ZCONV_ROOF_BLD ! rad. flux from roof to bld [W m-2(roof)]
-REAL, DIMENSION(SIZE(PTA)) :: ZRAD_WALL_FLOOR ! rad. flux from averaged wall to floor [W m-2(wall)]
-REAL, DIMENSION(SIZE(PTA)) :: ZRAD_WALL_MASS ! rad. flux from averaged wall to mass [W m-2(wall)]
-REAL, DIMENSION(SIZE(PTA)) :: ZRAD_WIN_FLOOR ! rad. flux from averaged wall to floor [W m-2(win)]
-REAL, DIMENSION(SIZE(PTA)) :: ZRAD_WIN_MASS ! rad. flux from averaged wall to mass [W m-2(win)]
-REAL, DIMENSION(SIZE(PTA)) :: ZCONV_WALL_BLD ! rad. flux from roof to bld [W m-2(wall)]
+REAL, DIMENSION(SIZE(PTA)) :: ZTS_FL ! floor surface temperature [K]
+REAL, DIMENSION(SIZE(PTA)) :: ZRAD_RF_WL ! rad. flux from roof to averaged wall [W m-2(roof)]
+REAL, DIMENSION(SIZE(PTA)) :: ZRAD_RF_WIN ! rad. flux from roof to window [W m-2(roof)]
+REAL, DIMENSION(SIZE(PTA)) :: ZRAD_RF_FL ! rad. flux from roof to floor [W m-2(roof)]
+REAL, DIMENSION(SIZE(PTA)) :: ZRAD_RF_MA ! rad. flux from roof to mass [W m-2(roof)]
+REAL, DIMENSION(SIZE(PTA)) :: ZCONV_RF_BLD ! rad. flux from roof to bld [W m-2(roof)]
+REAL, DIMENSION(SIZE(PTA)) :: ZRAD_WL_FL ! rad. flux from averaged wall to floor [W m-2(wall)]
+REAL, DIMENSION(SIZE(PTA)) :: ZRAD_WL_MA ! rad. flux from averaged wall to mass [W m-2(wall)]
+REAL, DIMENSION(SIZE(PTA)) :: ZRAD_WIN_FL ! rad. flux from averaged wall to floor [W m-2(win)]
+REAL, DIMENSION(SIZE(PTA)) :: ZRAD_WIN_MA ! rad. flux from averaged wall to mass [W m-2(win)]
+REAL, DIMENSION(SIZE(PTA)) :: ZCONV_WL_BLD ! rad. flux from roof to bld [W m-2(wall)]
REAL, DIMENSION(SIZE(PTA)) :: ZCONV_WIN_BLD ! rad. flux from roof to bld [W m-2(win)]
REAL, DIMENSION(SIZE(PTA)) :: ZAC_WIN ! window aerodynamic conductance
-REAL, DIMENSION(SIZE(PTA)) :: ZLOAD_IN_ROOF ! indoor load on roof W/m2[roof]
-REAL, DIMENSION(SIZE(PTA)) :: ZLOAD_IN_FLOOR ! indoor load on floor W/m2[floor]
-REAL, DIMENSION(SIZE(PTA)) :: ZLOAD_IN_WALL ! indoor load on wall W/m2[wall]
+REAL, DIMENSION(SIZE(PTA)) :: ZLOAD_IN_RF ! indoor load on roof W/m2[roof]
+REAL, DIMENSION(SIZE(PTA)) :: ZLOAD_IN_FL ! indoor load on floor W/m2[floor]
+REAL, DIMENSION(SIZE(PTA)) :: ZLOAD_IN_WL ! indoor load on wall W/m2[wall]
REAL, DIMENSION(SIZE(PTA)) :: ZLOAD_IN_WIN ! indoor load on win W/m2[win]
-REAL, DIMENSION(SIZE(PTA)) :: ZLOAD_IN_MASS ! indoor load on mass W/m2[mass]
+REAL, DIMENSION(SIZE(PTA)) :: ZLOAD_IN_MA ! indoor load on mass W/m2[mass]
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('TEB',0,ZHOOK_HANDLE)
+!
!* 1. Initializations
! ---------------
!
!* 1.1 Water reservoirs
! ----------------
!
-IF (LHOOK) CALL DR_HOOK('TEB',0,ZHOOK_HANDLE)
-ZWS_ROOF_MAX = 1. ! (1mm) maximum deepness of roof water reservoir
-ZWS_ROAD_MAX = 1. ! (1mm) maximum deepness of road water reservoir
+ZWS_RF_MAX = 1. ! (1mm) maximum deepness of roof water reservoir
+ZWS_RD_MAX = 1. ! (1mm) maximum deepness of road water reservoir
!
!* 1.2 radiative snow variables at previous time-step
! ----------------------------------------------
!
-ZTSSNOW_ROAD(:)=PTSSNOW_ROAD(:)
+ZTSSN_RD(:) = T%TSNOW_ROAD%TS(:)
!
!
!* 1.3 indoor aerodynamique conductance for DEF case
! ----------------------------------------------
!
ZAC_BLD(:) = XUNDEF
-IF (HBEM=='DEF') ZAC_BLD=1. / 0.123 / (XCPD * PRHOA(:)) !* (normalized by rho Cp for convenience)
+IF (TOP%CBEM=='DEF') ZAC_BLD=1. / 0.123 / (XCPD * PRHOA(:)) !* (normalized by rho Cp for convenience)
!-------------------------------------------------------------------------------
!
!* 1.3 number of roof/wall layer
! -------------------------
!
-IWALL = SIZE(PT_WALL_A,2)
-IROOF = SIZE(PT_ROOF,2)
+IWL = SIZE(T%XT_WALL_A,2)
+IRF = SIZE(T%XT_ROOF,2)
!
-ZTS_WALL_A (:)=PT_WALL_A (:,1)
-ZTS_WALL_B (:)=PT_WALL_B (:,1)
-ZTS_WALL (:)=0.5 * (ZTS_WALL_A(:)+ZTS_WALL_B(:))
-ZTS_ROAD (:)=PT_ROAD (:,1)
-ZTS_ROOF (:)=PT_ROOF (:,1)
+ZTS_WL_A (:)=T%XT_WALL_A (:,1)
+ZTS_WL_B (:)=T%XT_WALL_B (:,1)
+ZTS_WL (:)=0.5 * (ZTS_WL_A(:)+ZTS_WL_B(:))
+ZTS_RD (:)=T%XT_ROAD (:,1)
+ZTS_RF (:)=T%XT_ROOF (:,1)
!
!
!* 1.4 load on indoor walls
! -------------------------
!
-IF (HBEM=='BEM') THEN
+IF (TOP%CBEM=='BEM') THEN
!
- ZLOAD_IN_ROOF = PF_FLOOR_WIN * PTR_SW_WIN + PQIN * PN_FLOOR * (1-PQIN_FLAT) * PQIN_FRAD &
- / (2 + PWALL_O_BLD + PGLAZ_O_BLD + PMASS_O_BLD ) ! W/m2 [ROOF]
- ZLOAD_IN_FLOOR = PF_FLOOR_WIN * PTR_SW_WIN + PQIN * PN_FLOOR * (1-PQIN_FLAT) * PQIN_FRAD &
- / (2 + PWALL_O_BLD + PGLAZ_O_BLD + PMASS_O_BLD )
- ZLOAD_IN_MASS = PF_MASS_WIN * PTR_SW_WIN + PQIN * PN_FLOOR * (1-PQIN_FLAT) * PQIN_FRAD &
- / (2 + PWALL_O_BLD + PGLAZ_O_BLD + PMASS_O_BLD )
- ZLOAD_IN_WALL = PF_WALL_WIN * PTR_SW_WIN + PQIN * PN_FLOOR * (1-PQIN_FLAT) * PQIN_FRAD &
- / (2 + PWALL_O_BLD + PGLAZ_O_BLD + PMASS_O_BLD )
- ZLOAD_IN_WIN = PF_WIN_WIN * PTR_SW_WIN + PQIN * PN_FLOOR * (1-PQIN_FLAT) * PQIN_FRAD &
- / (2 + PWALL_O_BLD + PGLAZ_O_BLD + PMASS_O_BLD )
+ ZLOAD_IN_RF = B%XF_FLOOR_WIN * DMT%XTR_SW_WIN + DMT%XQIN * B%XN_FLOOR * (1-B%XQIN_FLAT) * B%XQIN_FRAD &
+ / (2 + T%XWALL_O_BLD + B%XGLAZ_O_BLD + B%XMASS_O_BLD ) ! W/m2 [ROOF]
+ ZLOAD_IN_FL = B%XF_FLOOR_WIN * DMT%XTR_SW_WIN + DMT%XQIN * B%XN_FLOOR * (1-B%XQIN_FLAT) * B%XQIN_FRAD &
+ / (2 + T%XWALL_O_BLD + B%XGLAZ_O_BLD + B%XMASS_O_BLD )
+ ZLOAD_IN_MA = B%XF_MASS_WIN * DMT%XTR_SW_WIN + DMT%XQIN * B%XN_FLOOR * (1-B%XQIN_FLAT) * B%XQIN_FRAD &
+ / (2 + T%XWALL_O_BLD + B%XGLAZ_O_BLD + B%XMASS_O_BLD )
+ ZLOAD_IN_WL = B%XF_WALL_WIN * DMT%XTR_SW_WIN + DMT%XQIN * B%XN_FLOOR * (1-B%XQIN_FLAT) * B%XQIN_FRAD &
+ / (2 + T%XWALL_O_BLD + B%XGLAZ_O_BLD + B%XMASS_O_BLD )
+ ZLOAD_IN_WIN = B%XF_WIN_WIN * DMT%XTR_SW_WIN + DMT%XQIN * B%XN_FLOOR * (1-B%XQIN_FLAT) * B%XQIN_FRAD &
+ / (2 + T%XWALL_O_BLD + B%XGLAZ_O_BLD + B%XMASS_O_BLD )
ELSE
- ZLOAD_IN_ROOF = 0.
- ZLOAD_IN_FLOOR = 0.
- ZLOAD_IN_MASS = 0.
- ZLOAD_IN_WALL = 0.
+ ZLOAD_IN_RF = 0.
+ ZLOAD_IN_FL = 0.
+ ZLOAD_IN_MA = 0.
+ ZLOAD_IN_WL = 0.
ZLOAD_IN_WIN = 0.
ENDIF
!-------------------------------------------------------------------------------
@@ -759,46 +506,35 @@ ENDIF
!* 2.1 Effects on water reservoirs
! ---------------------------
!
-ZWS_ROOF_MAX(:) = ZWS_ROOF_MAX(:) * PDF_ROOF(:)
-ZWS_ROAD_MAX(:) = ZWS_ROAD_MAX(:) * PDF_ROAD(:)
+ZWS_RF_MAX(:) = ZWS_RF_MAX(:) * PDF_RF(:)
+ZWS_RD_MAX(:) = ZWS_RD_MAX(:) * PDF_RD(:)
!
!-------------------------------------------------------------------------------
!
!* 3. Surface drag
! ------------
!
- CALL URBAN_DRAG(HZ0H, HIMPLICIT_WIND, PTSTEP, PT_CANYON, PQ_CANYON, &
- PU_CANYON, PT_LOWCAN, PQ_LOWCAN, PU_LOWCAN, &
- PZ_LOWCAN, ZTS_ROOF, ZTS_ROAD, ZTS_WALL, &
- PTS_GARDEN, PDN_ROOF, PDN_ROAD, &
- PEXNS, PEXNA, PTA, PQA, PPS, PRHOA, &
- PZREF, PUREF, PVMOD, &
- PZ0_TOWN, &
- PBLD, PGARDEN, PROAD, &
- PBLD_HEIGHT, PCAN_HW_RATIO, &
- PWALL_O_GRND, &
- PWS_ROOF, PWS_ROAD, &
- ZWS_ROOF_MAX, ZWS_ROAD_MAX, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPEW_A_COEF_LOWCAN, PPEW_B_COEF_LOWCAN, &
- PQSAT_ROOF, PQSAT_ROAD, PDELT_ROOF, PDELT_ROAD, &
- PCD, PCDN, PAC_ROOF, PAC_ROOF_WAT, &
- PAC_WALL, PAC_ROAD, PAC_ROAD_WAT, PAC_TOP, &
- PAC_GARDEN, PRI_TOWN, &
- PUW_ROAD, PUW_ROOF, PDUWDU_ROAD, PDUWDU_ROOF, &
- PUSTAR_TOWN, OCANOPY, PT_WIN1, ZAC_WIN, HCH_BEM, &
- PROUGH_ROOF, PROUGH_WALL )
+ CALL URBAN_DRAG(TOP, T, B, HIMPLICIT_WIND, PTSTEP, PT_CANYON, PQ_CANYON, &
+ PU_CANYON, PT_LOWCAN, PQ_LOWCAN, PU_LOWCAN, PZ_LOWCAN, &
+ ZTS_RF, ZTS_RD, ZTS_WL, PTS_GARDEN, PDN_RF, PDN_RD, &
+ PEXNS, PEXNA, PTA, PQA, PPS, PRHOA, PZREF, PUREF, &
+ PVMOD, ZWS_RF_MAX, ZWS_RD_MAX, PPEW_A_COEF, &
+ PPEW_B_COEF, PPEW_A_COEF_LOWCAN, PPEW_B_COEF_LOWCAN, &
+ PQSAT_RF, PQSAT_RD, PDELT_RF, PDELT_RD, PCD, PCDN, &
+ PAC_RF, PAC_RF_WAT, PAC_WL, PAC_RD, PAC_RD_WAT, &
+ PAC_TOP, PAC_GARDEN, PRI_TWN, PUW_RD, PUW_RF, &
+ PDUWDU_RD, PDUWDU_RF, PUSTAR_TWN, ZAC_WIN )
!
!* area-averaged heat transfer coefficient
!
ZVMOD(:) = WIND_THRESHOLD(PVMOD(:),PUREF(:))
!
-PCH_TOWN(:) = (PBLD(:) * PAC_ROOF(:) + (1.-PBLD(:)) * PAC_TOP (:)) / ZVMOD(:)
+PCH_TWN(:) = (T%XBLD(:) * PAC_RF(:) + (1.-T%XBLD(:)) * PAC_TOP (:)) / ZVMOD(:)
!
!* aggregation of momentum fluxes for roofs (=> derivate of flux also recalculated)
!
-PUW_ROOF (:) = (1-PFRAC_GR(:)) * PUW_ROOF(:) + PFRAC_GR(:) * PUW_GREENROOF(:)
-WHERE (PVMOD(:)/=0.) PDUWDU_ROOF(:) = 2. * PUW_ROOF(:) / PVMOD(:)
+PUW_RF (:) = (1-T%XGREENROOF(:)) * PUW_RF(:) + T%XGREENROOF(:) * PUW_GR(:)
+WHERE (PVMOD(:)/=0.) PDUWDU_RF(:) = 2. * PUW_RF(:) / PVMOD(:)
!
!-------------------------------------------------------------------------------
!
@@ -813,35 +549,21 @@ ZQA(:) = PQA(:) * QSAT(PTA(:),PPS(:)) / QSAT(ZTA(:),PPA(:))
!* 5. Snow mantel model
! -----------------
!
- CALL URBAN_SNOW_EVOL(PT_LOWCAN, PQ_LOWCAN, PU_LOWCAN, &
- ZTS_ROOF,ZTS_ROAD,ZTS_WALL_A, ZTS_WALL_B, &
- PT_ROOF, PD_ROOF, PTC_ROOF, PHC_ROOF, &
- HSNOW_ROOF, &
- PWSNOW_ROOF, PTSNOW_ROOF, PRSNOW_ROOF, PASNOW_ROOF, &
- PTSSNOW_ROOF, PESNOW_ROOF, &
- HSNOW_ROAD, &
- PWSNOW_ROAD, PTSNOW_ROAD, PRSNOW_ROAD, PASNOW_ROAD, &
- PTSSNOW_ROAD, PESNOW_ROAD, &
- PPS, ZTA, ZQA, PRHOA, &
- PLW_RAD, &
- PSR, PZREF, PUREF, PVMOD, &
- PTSTEP, &
- PZ_LOWCAN, &
- PDN_ROOF, PABS_SW_SNOW_ROOF, PABS_LW_SNOW_ROOF, &
- PDN_ROAD, PABS_SW_SNOW_ROAD, PABS_LW_SNOW_ROAD, &
- PRNSNOW_ROOF, PHSNOW_ROOF, PLESNOW_ROOF, PGSNOW_ROOF, &
- PMELT_ROOF, &
- PRNSNOW_ROAD, PHSNOW_ROAD, PLESNOW_ROAD, PGSNOW_ROAD, &
- PMELT_ROAD, &
- PLW_WA_TO_NR, PLW_WB_TO_NR, PLW_S_TO_NR, PLW_WIN_TO_NR, &
- ZDQS_SNOW_ROOF, ZDQS_SNOW_ROAD, PT_WIN1 )
+ CALL URBAN_SNOW_EVOL(T, B, PT_LOWCAN, PQ_LOWCAN, PU_LOWCAN, ZTS_RF, ZTS_RD, ZTS_WL_A, &
+ ZTS_WL_B, PPS, ZTA, ZQA, PRHOA, PLW_RAD, PSR, PZREF, PUREF, PVMOD, &
+ PTSTEP, PZ_LOWCAN, PDN_RF, DMT%XABS_SW_SNOW_ROOF, &
+ DMT%XABS_LW_SNOW_ROOF, PDN_RD, DMT%XABS_SW_SNOW_ROAD, &
+ DMT%XABS_LW_SNOW_ROAD, PRNSN_RF, PHSN_RF, PLESN_RF, PGSN_RF, &
+ PMELT_RF, PRNSN_RD, PHSN_RD, PLESN_RD, PGSN_RD, PMELT_RD, &
+ PLW_WA_TO_NR, PLW_WB_TO_NR, PLW_S_TO_NR, PLW_WIN_TO_NR, ZDQS_SN_RF, &
+ ZDQS_SN_RD )
!
!-------------------------------------------------------------------------------
!
!* 6. LW properties
! -------------
!
-PDF_ROAD (:) = 1. - PDN_ROAD (:)
+PDF_RD (:) = 1. - PDN_RD (:)
!
!-------------------------------------------------------------------------------
!
@@ -849,20 +571,19 @@ PDF_ROAD (:) = 1. - PDN_ROAD (:)
! ---------------------------
!
! uses the averaged temperature of both walls for the building energy balance
-ZT_WALL (:,:)=0.5 * (PT_WALL_A(:,:)+PT_WALL_B(:,:))
+ZT_WL (:,:)=0.5 * (T%XT_WALL_A(:,:)+T%XT_WALL_B(:,:))
!
-SELECT CASE(HBEM)
+SELECT CASE(TOP%CBEM)
CASE("DEF")
- ZTS_FLOOR(:) = 19. + XTT
- PT_RAD_IND(:) = (PWALL_O_HOR(:) / PBLD(:) * ZT_WALL(:,IWALL) + &
- PT_ROOF(:,IROOF) + ZTS_FLOOR(:)) &
- / (PWALL_O_HOR(:) / PBLD(:) + 1. + 1.)
+ ZTS_FL(:) = 19. + XTT
+ PT_RAD_IND(:) = ( T%XWALL_O_HOR(:) / T%XBLD(:) * ZT_WL(:,IWL) + &
+ T%XT_ROOF(:,IRF) + ZTS_FL(:) ) / (T%XWALL_O_HOR(:) / T%XBLD(:) + 1. + 1.)
ZRADHT_IN(:) = XUNDEF
CASE("BEM")
- ZTS_FLOOR(:) = PT_FLOOR(:,1)
- PT_RAD_IND(:) = (PT_MASS(:,1)*PMASS_O_BLD(:) + ZT_WALL(:,IWALL)*PWALL_O_BLD(:) &
- + ZTS_FLOOR(:) + PT_ROOF(:,IROOF) + PT_WIN2(:) * PGLAZ_O_BLD(:)) &
- /(PMASS_O_BLD(:) + PWALL_O_BLD(:) + 1. + 1. + PGLAZ_O_BLD(:))
+ ZTS_FL(:) = B%XT_FLOOR(:,1)
+ PT_RAD_IND(:) = (B%XT_MASS(:,1)*B%XMASS_O_BLD(:) + ZT_WL(:,IWL)*T%XWALL_O_BLD(:) &
+ + ZTS_FL(:) + T%XT_ROOF(:,IRF) + B%XT_WIN2(:) * B%XGLAZ_O_BLD(:)) &
+ /(B%XMASS_O_BLD(:) + T%XWALL_O_BLD(:) + 1. + 1. + B%XGLAZ_O_BLD(:))
! Assuming indoor surface emissivities of 0.9
ZRADHT_IN(:) = 0.9 * 0.9 * 4 * XSTEFAN * PT_RAD_IND(:)**3
END SELECT
@@ -874,22 +595,14 @@ END SELECT
!* ts_roof and qsat_roof are updated
!
- CALL ROOF_LAYER_E_BUDGET(PT_ROOF, PQSAT_ROOF, PTI_BLD, ZAC_BLD, PTSTEP, &
- HBEM, PHC_ROOF, PTC_ROOF, PD_ROOF, PDN_ROOF, &
- PRHOA, PAC_ROOF, PAC_ROOF_WAT, PLW_RAD, PPS, &
- PDELT_ROOF, ZTA, ZQA, PEXNA, PEXNS, &
- PABS_SW_ROOF, PGSNOW_ROOF, PEMIS_ROOF, &
- ZFLX_BLD_ROOF, ZDQS_ROOF, PABS_LW_ROOF, &
- PH_ROOF, PLEW_ROOF, ZIMB_ROOF, &
- PFRAC_GR, PG_GREENROOF_ROOF, &
- PF_FLOOR_MASS, PF_FLOOR_WALL, PF_FLOOR_WIN, &
- PF_FLOOR_ROOF, ZRADHT_IN, &
- PT_MASS(:,1), PT_WIN2, ZTS_FLOOR(:), &
- ZT_WALL(:,IWALL), ZRAD_ROOF_WALL, &
- ZRAD_ROOF_WIN, ZRAD_ROOF_FLOOR, ZRAD_ROOF_MASS,&
- ZCONV_ROOF_BLD, &
- PRR, & !modif to add heating/cooling of rain
- ZLOAD_IN_ROOF )
+ CALL ROOF_LAYER_E_BUDGET(TOP, T, B, PQSAT_RF, ZAC_BLD, PTSTEP, PDN_RF, PRHOA, &
+ PAC_RF, PAC_RF_WAT, PLW_RAD, PPS, PDELT_RF, ZTA, ZQA, &
+ PEXNA, PEXNS, DMT%XABS_SW_ROOF, PGSN_RF, ZFLX_BLD_RF, &
+ ZDQS_RF, DMT%XABS_LW_ROOF, DMT%XH_ROOF, PLEW_RF, ZIMB_RF, &
+ DMT%XG_GREENROOF_ROOF, ZRADHT_IN, ZTS_FL, ZT_WL(:,IWL),&
+ ZRAD_RF_WL, ZRAD_RF_WIN, ZRAD_RF_FL, ZRAD_RF_MA, ZCONV_RF_BLD, &
+ PRR, & !modif to add heating/cooling of rain
+ ZLOAD_IN_RF )
!
!-------------------------------------------------------------------------------
!
@@ -898,54 +611,37 @@ END SELECT
!
!* Road watering
- CALL TEB_IRRIG(OPAR_RD_IRRIG, PTSTEP, TPTIME%TDATE%MONTH, PTSUN, &
- PRD_START_MONTH, PRD_END_MONTH, PRD_START_HOUR, &
- PRD_END_HOUR, PRD_24H_IRRIG, PIRRIG_ROAD )
+ CALL TEB_IRRIG(TIR%LPAR_RD_IRRIG, PTSTEP, TOP%TTIME%TDATE%MONTH, PTSUN, &
+ TIR%XRD_START_MONTH, TIR%XRD_END_MONTH, TIR%XRD_START_HOUR, &
+ TIR%XRD_END_HOUR, TIR%XRD_24H_IRRIG, DMT%XIRRIG_ROAD )
!* ts_road, ts_wall, qsat_road, t_canyon and q_canyon are updated
!
- CALL ROAD_LAYER_E_BUDGET(PT_ROAD, PTSTEP, PHC_ROAD, PTC_ROAD, PD_ROAD, &
- PDN_ROAD, PRHOA, PAC_ROAD, PAC_ROAD_WAT, &
- PLW_RAD, PPS, PQSAT_ROAD, PDELT_ROAD, PEXNS, &
- PABS_SW_ROAD, PGSNOW_ROAD, PQ_LOWCAN, PT_LOWCAN, &
- ZTS_WALL_A, ZTS_WALL_B, ZTSSNOW_ROAD, &
- PTS_GARDEN, PT_WIN1, &
- PLW_WA_TO_R, PLW_WB_TO_R, PLW_S_TO_R, PLW_WIN_TO_R, &
- PEMIS_ROAD, PEMIT_LW_ROAD, ZDQS_ROAD, PABS_LW_ROAD, &
- PH_ROAD, PLEW_ROAD, ZIMB_ROAD, PRR+PIRRIG_ROAD )
+ CALL ROAD_LAYER_E_BUDGET(T, B, PTSTEP, PDN_RD, PRHOA, PAC_RD, PAC_RD_WAT, &
+ PLW_RAD, PPS, PQSAT_RD, PDELT_RD, PEXNS, &
+ DMT%XABS_SW_ROAD, PGSN_RD, PQ_LOWCAN, PT_LOWCAN,&
+ ZTS_WL_A, ZTS_WL_B, ZTSSN_RD, PTS_GARDEN, &
+ PLW_WA_TO_R, PLW_WB_TO_R, PLW_S_TO_R, &
+ PLW_WIN_TO_R, PEMIT_LW_RD, ZDQS_RD, DMT%XABS_LW_ROAD, &
+ DMT%XH_ROAD, PLEW_RD, ZIMB_RD, PRR+DMT%XIRRIG_ROAD )
!
!-------------------------------------------------------------------------------
!
!* 8. Wall Ts computations
! -----------------------------
!
- CALL FACADE_E_BUDGET(HWALL_OPT, HBEM, &
- PT_WALL_A, PT_WALL_B, PTSTEP, &
- PHC_WALL, PTC_WALL, PD_WALL, &
- PDN_ROAD, PRHOA, PAC_WALL, &
- ZAC_BLD, PTI_BLD, PLW_RAD, PPS, PEXNS, &
- PABS_SW_WALL_A, PABS_SW_WALL_B, PT_CANYON, &
- ZTS_ROAD, ZTSSNOW_ROAD, PTS_GARDEN, PUGG_WIN, PGR, &
- PABS_SW_WIN, PF_WIN_MASS, PF_WIN_WALL, &
- PF_WIN_FLOOR, PT_MASS(:,1), ZTS_FLOOR(:), &
- PEMIS_WALL, &
- PLW_WA_TO_WB, &
- PLW_R_TO_WA, PLW_R_TO_WB, PLW_G_TO_WA, PLW_G_TO_WB, &
- PLW_S_TO_WA, PLW_S_TO_WB, PLW_NR_TO_WA,PLW_NR_TO_WB,&
- PLW_WIN_TO_WA, PLW_WIN_TO_WB, &
- PLW_S_TO_WIN, PLW_WA_TO_WIN, PLW_WB_TO_WIN, &
- PLW_R_TO_WIN, PLW_G_TO_WIN, PLW_NR_TO_WIN, PT_WIN1, &
- ZFLX_BLD_WALL_A, ZDQS_WALL_A, &
- ZFLX_BLD_WALL_B, ZDQS_WALL_B, &
- PT_WIN2, PEMIT_LW_FAC, &
- PABS_LW_WALL_A, PABS_LW_WALL_B, PABS_LW_WIN, &
- PH_WALL_A, PH_WALL_B, &
- ZIMB_WALL, PF_WALL_MASS, PF_WALL_FLOOR, &
- PF_WALL_WIN, ZRADHT_IN, ZRAD_ROOF_WALL, &
- ZRAD_ROOF_WIN, ZRAD_WALL_FLOOR, ZRAD_WALL_MASS, &
- ZRAD_WIN_FLOOR, ZRAD_WIN_MASS, ZCONV_WALL_BLD, &
- ZCONV_WIN_BLD, ZAC_WIN, &
- ZLOAD_IN_WALL, ZLOAD_IN_WIN )
+ CALL FACADE_E_BUDGET(TOP, T, B, DMT, PTSTEP, PDN_RD, PRHOA, PAC_WL, ZAC_BLD, &
+ PLW_RAD, PPS, PEXNS, PT_CANYON, ZTS_RD, ZTSSN_RD, PTS_GARDEN, &
+ ZTS_FL, PLW_WA_TO_WB, PLW_R_TO_WA, PLW_R_TO_WB, &
+ PLW_G_TO_WA, PLW_G_TO_WB, PLW_S_TO_WA, PLW_S_TO_WB, &
+ PLW_NR_TO_WA, PLW_NR_TO_WB, PLW_WIN_TO_WA, &
+ PLW_WIN_TO_WB, PLW_S_TO_WIN, PLW_WA_TO_WIN, &
+ PLW_WB_TO_WIN, PLW_R_TO_WIN, PLW_G_TO_WIN, &
+ PLW_NR_TO_WIN, ZFLX_BLD_WL_A, ZDQS_WL_A, &
+ ZFLX_BLD_WL_B, ZDQS_WL_B, PEMIT_LW_FAC, ZIMB_WL, &
+ ZRADHT_IN, ZRAD_RF_WL, ZRAD_RF_WIN, ZRAD_WL_FL, &
+ ZRAD_WL_MA, ZRAD_WIN_FL, ZRAD_WIN_MA, ZCONV_WL_BLD, &
+ ZCONV_WIN_BLD, ZAC_WIN, ZLOAD_IN_WL, ZLOAD_IN_WIN )
!
!-------------------------------------------------------------------------------
!
@@ -953,61 +649,32 @@ END SELECT
! ----------------------------------------------
!
! uses the averaged temperature of both walls for the building energy balance
-ZT_WALL (:,:)=0.5 * (PT_WALL_A(:,:)+PT_WALL_B(:,:))
+ZT_WL (:,:)=0.5 * (T%XT_WALL_A(:,:)+T%XT_WALL_B(:,:))
!
-SELECT CASE(HBEM)
- CASE("DEF")
+SELECT CASE(TOP%CBEM)
+CASE("DEF")
!
- CALL BLD_E_BUDGET(.TRUE., PTSTEP, PBLD, PWALL_O_HOR, &
- PRHOA, PT_ROOF, ZT_WALL, PTI_BLD, ZTS_FLOOR(:) )
+ CALL BLD_E_BUDGET(.TRUE., PTSTEP, T%XBLD, T%XWALL_O_HOR, &
+ PRHOA, T%XT_ROOF, ZT_WL, B%XTI_BLD, ZTS_FL(:) )
!variables that needs to be computed apart
- PQI_BLD = 0.5 * QSAT(PTI_BLD, PPS)
+ B%XQI_BLD = 0.5 * QSAT(B%XTI_BLD, PPS)
!variables that need to be set 0 for calculation
- PH_WASTE (:) = 0.
- PLE_WASTE (:) = 0.
- ZFLX_BLD_FLOOR(:) = 0.
- ZFLX_BLD_MASS (:) = 0.
+ ZFLX_BLD_FL(:) = 0.
+ ZFLX_BLD_MA (:) = 0.
!other variables
- PH_BLD_COOL(:) = XUNDEF
- PLE_BLD_COOL(:)= XUNDEF
- PT_BLD_COOL(:) = XUNDEF
- PH_BLD_HEAT(:) = XUNDEF
- PLE_BLD_HEAT(:)= XUNDEF
- PHVAC_COOL(:) = XUNDEF
- PHVAC_HEAT(:) = XUNDEF
- PCAP_SYS(:) = XUNDEF
- PM_SYS(:) = XUNDEF
- PCOP(:) = XUNDEF
- PQ_SYS(:) = XUNDEF
- PFAN_POWER(:) = XUNDEF
PHU_BLD(:) = XUNDEF
- CASE("BEM")
- CALL BEM(PTSTEP, PTSUN, HCOOL_COIL, HHEAT_COIL, &
- OAUTOSIZE, KDAY, HNATVENT, &
- PPS, PRHOA, PT_CANYON, PQ_CANYON, PU_CANYON, &
- PT_ROOF, PT_WALL_A, PT_WALL_B, PBLD, PBLD_HEIGHT, PWALL_O_HOR,&
- PHC_FLOOR, PTC_FLOOR, PD_FLOOR, &
- PT_WIN2, PGR, PQIN, PQIN_FRAD, PQIN_FLAT, &
- PEFF_HEAT, PINF, PTCOOL_TARGET, PTHEAT_TARGET, PHR_TARGET, &
- PF_WATER_COND, PV_VENT, PCAP_SYS_HEAT, PT_ADP, PCOP_RAT, &
- PAUX_MAX, PT_FLOOR, PT_MASS, PTI_BLD, PQI_BLD, &
- PCAP_SYS_RAT, PM_SYS_RAT, ONATVENT_NIGHT, &
- PH_BLD_COOL, PH_BLD_HEAT, PLE_BLD_COOL, PLE_BLD_HEAT, &
- PT_BLD_COOL, PHVAC_COOL, PT_SYS, PQ_SYS, PH_WASTE, PLE_WASTE, &
- PFAN_POWER, PHVAC_HEAT, PM_SYS, PCOP, PCAP_SYS, PHU_BLD, &
- PTR_SW_WIN, PT_RAD_IND, ZFLX_BLD_FLOOR, ZFLX_BLD_MASS, &
- PF_FLOOR_MASS, PF_FLOOR_WALL, PF_FLOOR_WIN, &
- ZRADHT_IN, PN_FLOOR, PWALL_O_BLD, PGLAZ_O_BLD, PMASS_O_BLD, &
- PFLOOR_HW_RATIO, PF_FLOOR_ROOF, PF_MASS_FLOOR, PF_MASS_WALL, &
- PF_MASS_WIN, ZRAD_ROOF_MASS, ZRAD_ROOF_FLOOR, ZRAD_WALL_MASS, &
- ZRAD_WALL_FLOOR, ZRAD_WIN_MASS, ZRAD_WIN_FLOOR, &
- ZCONV_ROOF_BLD, ZCONV_WALL_BLD, ZCONV_WIN_BLD, &
- ZLOAD_IN_FLOOR, ZLOAD_IN_MASS )
+CASE("BEM")
+ CALL BEM(BOP, T, B, DMT, PTSTEP, PTSUN, KDAY, PPS, PRHOA, PT_CANYON, &
+ PQ_CANYON, PU_CANYON, PHU_BLD, PT_RAD_IND, ZFLX_BLD_FL,&
+ ZFLX_BLD_MA, ZRADHT_IN, ZRAD_RF_MA, ZRAD_RF_FL, &
+ ZRAD_WL_MA, ZRAD_WL_FL, ZRAD_WIN_MA, ZRAD_WIN_FL, &
+ ZCONV_RF_BLD, ZCONV_WL_BLD, ZCONV_WIN_BLD, ZLOAD_IN_FL,&
+ ZLOAD_IN_MA )
- PH_WASTE = PH_WASTE * PBLD
- PLE_WASTE = PLE_WASTE * PBLD
+ DMT%XH_WASTE = DMT%XH_WASTE * T%XBLD
+ DMT%XLE_WASTE = DMT%XLE_WASTE * T%XBLD
END SELECT
!
!-------------------------------------------------------------------------------
@@ -1015,49 +682,24 @@ END SELECT
!* 10. Fluxes over built surfaces
! --------------------------
!
- CALL URBAN_FLUXES (HIMPLICIT_WIND, OCANOPY, PT_CANYON, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PEXNS, PRHOA, PVMOD, &
- PH_TRAFFIC, PLE_TRAFFIC, PH_INDUSTRY, PLE_INDUSTRY, &
- PBLD, PROAD, PWALL_O_HOR, PFRAC_GR, &
- PABS_SW_ROOF, PABS_LW_ROOF, &
- PABS_SW_WALL_A, PABS_LW_WALL_A, &
- PABS_SW_WALL_B, PABS_LW_WALL_B, &
- PABS_SW_ROAD, PABS_LW_ROAD, &
- PAC_WALL, PCD, &
- PDF_ROOF, PDN_ROOF, PDF_ROAD, PDN_ROAD, &
- PRNSNOW_ROOF, PHSNOW_ROOF, PLESNOW_ROOF, PGSNOW_ROOF, &
- PRNSNOW_ROAD, PHSNOW_ROAD, PLESNOW_ROAD, PGSNOW_ROAD, &
- PMELT_ROOF, ZDQS_ROOF, &
- PMELT_ROAD, ZDQS_ROAD, &
- ZDQS_WALL_A, ZDQS_WALL_B, &
- ZFLX_BLD_ROOF, ZFLX_BLD_WALL_A, ZFLX_BLD_WALL_B, &
- ZFLX_BLD_FLOOR, &
- ZFLX_BLD_MASS, PE_SHADING, HBEM, PGR, PT_WIN1, PH_WASTE, &
- PLE_WASTE, PF_WASTE_CAN, PABS_SW_WIN, PABS_LW_WIN, PQIN, &
- PN_FLOOR, PLEW_ROOF, PLEW_ROAD, &
- PRN_GREENROOF, PH_GREENROOF, PLE_GREENROOF, &
- PGFLUX_GREENROOF, &
- PH_ROOF, PH_ROAD, PH_WALL_A, PH_WALL_B, &
- PRN_ROOF,PLE_ROOF, &
- PGFLUX_ROOF, PRN_ROAD, PLE_ROAD, PGFLUX_ROAD, &
- PRN_WALL_A, PLE_WALL_A, PGFLUX_WALL_A, &
- PRN_WALL_B, PLE_WALL_B, PGFLUX_WALL_B, &
- PRN_STRLROOF, PH_STRLROOF, PLE_STRLROOF, &
- PGFLUX_STRLROOF, &
- PRN_BLT, PH_BLT, PLE_BLT, &
- PGFLUX_BLT, ZMELT_BLT, PQF_BLD, PFLX_BLD, PDQS_TOWN, &
- PQF_TOWN, PUSTAR_TOWN, PHVAC_COOL, PHVAC_HEAT )
+ CALL URBAN_FLUXES (TOP, T, B, DMT, HIMPLICIT_WIND, PT_CANYON, PPEW_A_COEF, PPEW_B_COEF, &
+ PEXNS, PRHOA, PVMOD, PH_TRAFFIC, PLE_TRAFFIC,PAC_WL, PCD, PDF_RF, &
+ PDN_RF, PDF_RD, PDN_RD, PRNSN_RF, PHSN_RF, PLESN_RF, PGSN_RF, &
+ PRNSN_RD, PHSN_RD, PLESN_RD, PGSN_RD, PMELT_RF, ZDQS_RF, PMELT_RD, &
+ ZDQS_RD, ZDQS_WL_A, ZDQS_WL_B, ZFLX_BLD_RF, ZFLX_BLD_WL_A, &
+ ZFLX_BLD_WL_B, ZFLX_BLD_FL, ZFLX_BLD_MA, PE_SHADING, PLEW_RF, &
+ PRN_GR, PH_GR, PLE_GR, PGFLUX_GR, &
+ PLEW_RD, PLE_WL_A, PLE_WL_B, ZMELT_BLT, PUSTAR_TWN )
!
!
! Water transfer from snow reservoir to water reservoir in case of snow melt
!
-WHERE (PMELT_ROOF(:) .GT. 0.)
- PWS_ROOF(:) = MIN(ZWS_ROOF_MAX,PWS_ROOF(:) + PMELT_ROOF(:)*PTSTEP)
+WHERE (PMELT_RF(:) .GT. 0.)
+ T%XWS_ROOF(:) = MIN(ZWS_RF_MAX,T%XWS_ROOF(:) + PMELT_RF(:)*PTSTEP)
ENDWHERE
!
-WHERE (PMELT_ROAD(:) .GT. 0.)
- PWS_ROAD(:) = MIN(ZWS_ROAD_MAX,PWS_ROAD(:) + PMELT_ROAD(:)*PTSTEP)
+WHERE (PMELT_RD(:) .GT. 0.)
+ T%XWS_ROAD(:) = MIN(ZWS_RD_MAX,T%XWS_ROAD(:) + PMELT_RD(:)*PTSTEP)
ENDWHERE
!
!-------------------------------------------------------------------------------
@@ -1065,21 +707,23 @@ ENDWHERE
!* 11. Roof ans road reservoirs evolution
! ----------------------------------
!
- CALL URBAN_HYDRO(ZWS_ROOF_MAX,ZWS_ROAD_MAX, PWS_ROOF, PWS_ROAD, &
- PRR, PIRRIG_ROAD, PTSTEP, PBLD, PLE_ROOF, PLE_ROAD, &
- PRUNOFF_STRLROOF, &
- PRUNOFF_ROAD )
+ CALL URBAN_HYDRO(ZWS_RF_MAX, ZWS_RD_MAX, T%XWS_ROOF, T%XWS_ROAD, PRR, &
+ DMT%XIRRIG_ROAD, PTSTEP, T%XBLD, DMT%XLE_ROOF, DMT%XLE_ROAD, &
+ DMT%XRUNOFF_STRLROOF, DMT%XRUNOFF_ROAD )
!
-PRUNOFF_ROOF(:) = ( 1. - PFRAC_GR(:) ) * PRUNOFF_STRLROOF(:) &
- + PFRAC_GR(:) * ( PRUNOFF_GREENROOF(:) + PDRAIN_GREENROOF(:) )
-
+IF (TOP%LGREENROOF) THEN
+ DMT%XRUNOFF_ROOF(:) = (1.-T%XGREENROOF(:)) * DMT%XRUNOFF_STRLROOF(:) &
+ + T%XGREENROOF(:) * (PRUNOFF_GR(:) + PDRAIN_GR(:))
+ELSE
+ DMT%XRUNOFF_ROOF(:) = DMT%XRUNOFF_STRLROOF(:)
+ENDIF
!
!-------------------------------------------------------------------------------
!
!* 19. Compute aerodynamical resistance
! --------------------------------
!
-PRESA_TOWN(:) = 1. / ( PBLD(:) * PAC_ROOF(:) + ( 1. - PBLD(:)) * PAC_TOP (:))
+PRESA_TWN(:) = 1. / ( T%XBLD(:) * PAC_RF(:) + ( 1. - T%XBLD(:)) * PAC_TOP (:))
!
IF (LHOOK) CALL DR_HOOK('TEB',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/teb_canopy.F90 b/src/SURFEX/teb_canopy.F90
index 36e87e069a4ab72b62ce4eefb7e1a30f823914fd..4d37274e21aaa0fad4602eda74bef13875920566 100644
--- a/src/SURFEX/teb_canopy.F90
+++ b/src/SURFEX/teb_canopy.F90
@@ -3,10 +3,9 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE TEB_CANOPY(KI,KLVL,PZ,PZF,PDZ,PDZF,PBLD,PBLD_HEIGHT,PWALL_O_HOR,PPA,PRHOA,PU, &
- PDUWDU_ROAD, PUW_ROOF, PDUWDU_ROOF, &
- PH_WALL,PH_ROOF,PE_ROOF,PAC_ROAD,PAC_ROAD_WAT, &
- PFORC_U,PDFORC_UDU,PFORC_E,PDFORC_EDE,PFORC_T,PDFORC_TDT,PFORC_Q,PDFORC_QDQ)
+SUBROUTINE TEB_CANOPY(KI, SB, PBLD, PBLD_HEIGHT, PWALL_O_HOR, PPA, PRHOA, PDUWDU_ROAD, PUW_ROOF, &
+ PDUWDU_ROOF, PH_WALL, PH_ROOF, PE_ROOF, PAC_ROAD, PAC_ROAD_WAT, PFORC_U, &
+ PDFORC_UDU, PFORC_E, PDFORC_EDE, PFORC_T, PDFORC_TDT, PFORC_Q, PDFORC_QDQ)
! ###############################################################################
!
!!**** *TEB_CANOPY_n * - prepares forcing for canopy air model
@@ -30,6 +29,7 @@ SUBROUTINE TEB_CANOPY(KI,KLVL,PZ,PZF,PDZ,PDZF,PBLD,PBLD_HEIGHT,PWALL_O_HOR,PPA,P
!! Original 07/2006
!!---------------------------------------------------------------
!
+USE MODD_CANOPY_n, ONLY : CANOPY_t
!
USE MODD_CSTS, ONLY : XRD, XCPD, XP00, XG, XPI
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -44,16 +44,11 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
INTEGER, INTENT(IN) :: KI ! number of points
-INTEGER, INTENT(IN) :: KLVL ! number of levels in canopy
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PZ ! heights of canopy levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PZF ! heights of bottom of canopy levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDZ ! depth of canopy levels (m)
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDZF ! depth between canopy levels (m)
+TYPE(CANOPY_t), INTENT(INOUT) :: SB
+!
REAL, DIMENSION(KI), INTENT(IN) :: PBLD ! building density (-)
REAL, DIMENSION(KI), INTENT(IN) :: PBLD_HEIGHT ! building height (m)
REAL, DIMENSION(KI), INTENT(IN) :: PWALL_O_HOR ! wall surf. / hor. surf. (-)
-
-REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PU ! wind for each canopy layer (m/s)
!
REAL, DIMENSION(KI), INTENT(IN) :: PPA ! air pressure (Pa)
REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3)
@@ -67,33 +62,33 @@ REAL, DIMENSION(KI), INTENT(IN) :: PE_ROOF ! flux of vapor for roof su
REAL, DIMENSION(KI), INTENT(IN) :: PAC_ROAD ! road aerodynamical conductance ()
REAL, DIMENSION(KI), INTENT(IN) :: PAC_ROAD_WAT ! road water aerodynamical conductance ()
!
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PFORC_U ! tendency of wind due to canopy drag (m/s2)
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PDFORC_UDU! formal derivative of the tendency of
+REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PFORC_U ! tendency of wind due to canopy drag (m/s2)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PDFORC_UDU! formal derivative of the tendency of
! ! wind due to canopy drag (1/s)
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PFORC_E ! tendency of TKE due to canopy drag (m2/s3)
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PDFORC_EDE! formal derivative of the tendency of
+REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PFORC_E ! tendency of TKE due to canopy drag (m2/s3)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PDFORC_EDE! formal derivative of the tendency of
! ! TKE due to canopy drag (1/s)
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PFORC_T ! tendency of Temp due to canopy drag (T/s)
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PDFORC_TDT! formal derivative of the tendency of
+REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PFORC_T ! tendency of Temp due to canopy drag (T/s)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PDFORC_TDT! formal derivative of the tendency of
! ! Temp due to canopy drag (1/s)
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PFORC_Q ! tendency of Temp due to canopy drag (kg/m3/s)
-REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PDFORC_QDQ! formal derivative of the tendency of
+REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PFORC_Q ! tendency of Temp due to canopy drag (kg/m3/s)
+REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PDFORC_QDQ! formal derivative of the tendency of
! ! Temp due to canopy drag (1/s)
!
!* 0.2 declarations of local variables
!
INTEGER :: JLAYER ! loop counter on canopy heights
!
-REAL, DIMENSION(KI,KLVL) :: ZCDRAG ! drag coefficient in canopy
-REAL, DIMENSION(KI,KLVL) :: ZSH ! horizontal surface of building
+REAL, DIMENSION(KI,SB%NLVL) :: ZCDRAG ! drag coefficient in canopy
+REAL, DIMENSION(KI,SB%NLVL) :: ZSH ! horizontal surface of building
! (road&roof) for each canopy level
-REAL, DIMENSION(KI,KLVL) :: ZSV ! vertical surface of building
+REAL, DIMENSION(KI,SB%NLVL) :: ZSV ! vertical surface of building
! (walls) for each canopy level
-REAL, DIMENSION(KI,KLVL) :: ZFORC
-REAL, DIMENSION(KI,KLVL) :: ZDENSITY
-REAL, DIMENSION(KI,KLVL) :: ZAIRVOL ! Fraction of air for each canopy level total volume
-REAL, DIMENSION(KI,KLVL) :: ZP ! pressure at full levels
-REAL, DIMENSION(KI,KLVL) :: ZEXN ! Exner function at full levels
+REAL, DIMENSION(KI,SB%NLVL) :: ZFORC
+REAL, DIMENSION(KI,SB%NLVL) :: ZDENSITY
+REAL, DIMENSION(KI,SB%NLVL) :: ZAIRVOL ! Fraction of air for each canopy level total volume
+REAL, DIMENSION(KI,SB%NLVL) :: ZP ! pressure at full levels
+REAL, DIMENSION(KI,SB%NLVL) :: ZEXN ! Exner function at full levels
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
@@ -108,11 +103,12 @@ IF (LHOOK) CALL DR_HOOK('TEB_CANOPY',0,ZHOOK_HANDLE)
ZSH(:,:) = 0.
ZSH(:,1) = (1.-PBLD(:))
!
-WHERE( PZF(:,2)>=PBLD_HEIGHT(:) ) ZSH(:,2) = PBLD(:) ! the roofs cannot be at the same level as roads
-DO JLAYER = 2,KLVL-1
- WHERE( PZF(:,JLAYER)<PBLD_HEIGHT(:) .AND. PZF(:,JLAYER+1)>=PBLD_HEIGHT(:) ) ZSH(:,JLAYER) = PBLD(:)
+WHERE( SB%XZF(:,2)>=PBLD_HEIGHT(:) ) ZSH(:,2) = PBLD(:) ! the roofs cannot be at the same level as roads
+DO JLAYER = 2,SB%NLVL-1
+ WHERE( SB%XZF(:,JLAYER)<PBLD_HEIGHT(:) .AND. &
+ SB%XZF(:,JLAYER+1)>=PBLD_HEIGHT(:) ) ZSH(:,JLAYER) = PBLD(:)
END DO
-WHERE( PZF(:,KLVL)<PBLD_HEIGHT(:) ) ZSH(:,KLVL) = PBLD(:)
+WHERE( SB%XZF(:,SB%NLVL)<PBLD_HEIGHT(:) ) ZSH(:,SB%NLVL) = PBLD(:)
!
!* 2.1 Drag coefficient by walls
! -------------------------
@@ -133,11 +129,11 @@ ZAIRVOL = 1.
!
!* 1.2 Discretization on each canopy level
!
-DO JLAYER=1,KLVL
+DO JLAYER=1,SB%NLVL
ZDENSITY(:,JLAYER) = PWALL_O_HOR(:)
ENDDO
!
- CALL CANOPY(KI, KLVL, PZF, PDZ, PBLD_HEIGHT, ZDENSITY, ZCDRAG, PU, ZAIRVOL, &
+ CALL CANOPY(KI, SB, PBLD_HEIGHT, ZDENSITY, ZCDRAG, ZAIRVOL, &
ZSV, ZFORC, PFORC_U, PDFORC_UDU, PFORC_E, PDFORC_EDE )
!
!-------------------------------------------------------------------------------------
@@ -156,14 +152,14 @@ ENDDO
!* Note that for the time being, air is assumed to occupy all the space of the grid
! (buildings have no volume), so that Vair = Vtot
!
-ZFORC(:,:) = ZSH(:,:)/ZAIRVOL(:,:)/PDZ(:,:)
+ZFORC(:,:) = ZSH(:,:)/ZAIRVOL(:,:)/SB%XDZ(:,:)
!
!* 2.3 Drag force by roof surfaces
! ---------------------------
!
!* drag force by horizontal surfaces
!
-DO JLAYER=2,KLVL
+DO JLAYER=2,SB%NLVL
PFORC_U (:,JLAYER) = PFORC_U (:,JLAYER) + PUW_ROOF (:) * ZFORC(:,JLAYER)
PDFORC_UDU(:,JLAYER) = PDFORC_UDU(:,JLAYER) + PDUWDU_ROOF(:) * ZFORC(:,JLAYER)
END DO
@@ -171,9 +167,9 @@ END DO
!* 2.4 Drag force by road surfaces
! ---------------------------
!
-!PFORC_U(:,1) = PUW_ROAD(:) / PDZ(:,1) * ZSH(:,1)
+!PFORC_U(:,1) = PUW_ROAD(:) / SB%XDZ(:,1) * ZSH(:,1)
PFORC_U (:,1) = PFORC_U (:,1)
-PDFORC_UDU(:,1) = PDFORC_UDU(:,1) + PDUWDU_ROAD(:) * ZSH(:,1)/PDZ(:,1)
+PDFORC_UDU(:,1) = PDFORC_UDU(:,1) + PDUWDU_ROAD(:) * ZSH(:,1)/SB%XDZ(:,1)
!
!-------------------------------------------------------------------------------------
!
@@ -203,8 +199,8 @@ PDFORC_TDT(:,1) = PDFORC_TDT(:,1) - PAC_ROAD(:)
!* 4.2 Heating from the walls surface flux
! -----------------------------------
!
-DO JLAYER=1,KLVL
- ZFORC(:,JLAYER) = 1. / ZAIRVOL(:,JLAYER) / PDZ(:,JLAYER) / PRHOA(:) / XCPD
+DO JLAYER=1,SB%NLVL
+ ZFORC(:,JLAYER) = 1. / ZAIRVOL(:,JLAYER) / SB%XDZ(:,JLAYER) / PRHOA(:) / XCPD
PFORC_T (:,JLAYER) = PFORC_T(:,JLAYER) + PH_WALL * ZSV(:,JLAYER) * ZFORC(:,JLAYER)
PDFORC_TDT(:,JLAYER) = PDFORC_TDT(:,JLAYER) + 0.
END DO
@@ -212,7 +208,7 @@ END DO
!* 4.3 Heating from the roof surface flux
! ----------------------------------
!
-DO JLAYER=2,KLVL
+DO JLAYER=2,SB%NLVL
PFORC_T (:,JLAYER) = PFORC_T(:,JLAYER) + PH_ROOF * ZSH(:,JLAYER) * ZFORC(:,JLAYER)
PDFORC_TDT(:,JLAYER) = PDFORC_TDT(:,JLAYER) + 0.
END DO
@@ -222,8 +218,8 @@ END DO
!* 5. Conversion into temperature tendency
! ------------------------------------
!
-DO JLAYER=1,KLVL
- ZP(:,JLAYER) = PPA(:) + XG * PRHOA(:) * (PZ(:,KLVL) - PZ(:,JLAYER))
+DO JLAYER=1,SB%NLVL
+ ZP(:,JLAYER) = PPA(:) + XG * PRHOA(:) * (SB%XZ(:,SB%NLVL) - SB%XZ(:,JLAYER))
END DO
ZEXN = (ZP/XP00)**(XRD/XCPD)
!
@@ -260,8 +256,8 @@ PDFORC_QDQ(:,1) = PDFORC_QDQ(:,1) - PAC_ROAD_WAT(:)
!* 4.2 Evaporation from the roof surface flux
! --------------------------------------
!
-DO JLAYER=2,KLVL
- PFORC_Q (:,JLAYER) = PFORC_Q (:,JLAYER) + PE_ROOF * ZSH(:,JLAYER)/ZAIRVOL(:,JLAYER)/PDZ(:,JLAYER)
+DO JLAYER=2,SB%NLVL
+ PFORC_Q (:,JLAYER) = PFORC_Q (:,JLAYER) + PE_ROOF * ZSH(:,JLAYER)/ZAIRVOL(:,JLAYER)/SB%XDZ(:,JLAYER)
PDFORC_QDQ(:,JLAYER) = PDFORC_QDQ(:,JLAYER) + 0.
END DO
IF (LHOOK) CALL DR_HOOK('TEB_CANOPY',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/teb_garden.F90 b/src/SURFEX/teb_garden.F90
index a23afa420a22f4dd422a3f2fd7a8ccbccd544deb..5c6704f7a387ae8af89de4547831f2b9e1206a46 100644
--- a/src/SURFEX/teb_garden.F90
+++ b/src/SURFEX/teb_garden.F90
@@ -3,103 +3,20 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE TEB_GARDEN (DTCO, DTI, IG, I, TM, GDM, GRM, &
- OGARDEN, OGREENROOF, OSOLAR_PANEL, &
- HZ0H, HIMPLICIT_WIND, HROAD_DIR, HWALL_OPT, TPTIME, &
- PTSUN, PT_CANYON, PQ_CANYON, PU_CANYON, &
- PT_LOWCAN, PQ_LOWCAN, PU_LOWCAN, PZ_LOWCAN, PTI_BLD, &
- PT_ROOF, PT_ROAD, PT_WALL_A, PT_WALL_B, &
- PWS_ROOF,PWS_ROAD, &
- HSNOW_ROOF, &
- PWSNOW_ROOF, PTSNOW_ROOF, PRSNOW_ROOF, PASNOW_ROOF, &
- PTSSNOW_ROOF, PESNOW_ROOF, &
- HSNOW_ROAD, &
- PWSNOW_ROAD, PTSNOW_ROAD, PRSNOW_ROAD, PASNOW_ROAD, &
- PTSSNOW_ROAD, PESNOW_ROAD, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPEW_A_COEF_LOWCAN, PPEW_B_COEF_LOWCAN, &
- PPS, PPA, PEXNS, PEXNA, &
- PTA, PQA, PRHOA, PCO2, &
- PLW_RAD, PDIR_SW, PSCA_SW, PSW_BANDS, KSW, &
- PZENITH, PAZIM, &
- PRR, PSR, &
- PZREF, PUREF, PVMOD, &
- PH_TRAFFIC, PLE_TRAFFIC, PH_INDUSTRY, PLE_INDUSTRY, &
- PTSTEP, PZ0_TOWN, PBLD, PGARDEN, PROAD_DIR, PROAD, &
- PFRAC_GR, &
- PBLD_HEIGHT, PWALL_O_HOR, PCAN_HW_RATIO, &
- PROAD_O_GRND, PGARDEN_O_GRND, PWALL_O_GRND, &
- PALB_ROOF, PEMIS_ROOF, &
- PHC_ROOF,PTC_ROOF,PD_ROOF, &
- PALB_ROAD, PEMIS_ROAD, PSVF_ROAD, &
- PHC_ROAD,PTC_ROAD,PD_ROAD, &
- PALB_WALL, PEMIS_WALL, PSVF_WALL, &
- PSVF_GARDEN, &
- PHC_WALL,PTC_WALL,PD_WALL, &
- PRN_ROOF, PH_ROOF, PLE_ROOF, PLEW_ROOF, PGFLUX_ROOF, &
- PRUNOFF_ROOF, &
- PRN_ROAD, PH_ROAD, PLE_ROAD, PLEW_ROAD, PGFLUX_ROAD, &
- PRUNOFF_ROAD, &
- PRN_WALL_A, PH_WALL_A, PLE_WALL_A, PGFLUX_WALL_A, &
- PRN_WALL_B, PH_WALL_B, PLE_WALL_B, PGFLUX_WALL_B, &
- PRN_GARDEN,PH_GARDEN,PLE_GARDEN, PGFLUX_GARDEN, &
- PRUNOFF_GARDEN, PDRAIN_GARDEN, PIRRIG_GARDEN, &
- PRN_GREENROOF,PH_GREENROOF,PLE_GREENROOF, PGFLUX_GREENROOF, &
- PRN_STRLROOF,PH_STRLROOF,PLE_STRLROOF, PGFLUX_STRLROOF, &
- PRUNOFF_STRLROOF, &
- PRN_BLT,PH_BLT,PLE_BLT, PGFLUX_BLT, &
- PRNSNOW_ROOF, PHSNOW_ROOF, PLESNOW_ROOF, PGSNOW_ROOF, &
- PMELT_ROOF, &
- PRNSNOW_ROAD, PHSNOW_ROAD, PLESNOW_ROAD, PGSNOW_ROAD, &
- PMELT_ROAD, &
- PRN_GRND, PH_GRND, PLE_GRND, PGFLUX_GRND, &
- PRN_TOWN, PH_TOWN, PLE_TOWN, PGFLUX_TOWN, PEVAP_TOWN, &
- PRUNOFF_TOWN, PSFCO2, &
- PUW_GRND, PUW_ROOF, PDUWDU_GRND, PDUWDU_ROOF, &
- PUSTAR_TOWN, PCD, PCDN, PCH_TOWN, PRI_TOWN, &
- PTS_TOWN, PEMIS_TOWN, PDIR_ALB_TOWN, PSCA_ALB_TOWN, &
- PRESA_TOWN, PDQS_TOWN, PQF_TOWN, PQF_BLD, &
- PFLX_BLD, PAC_ROAD, PAC_GARDEN, PAC_GREENROOF, &
- PAC_ROAD_WAT, PAC_GARDEN_WAT, PAC_GREENROOF_WAT, &
- PABS_SW_ROOF,PABS_LW_ROOF, &
- PABS_SW_SNOW_ROOF,PABS_LW_SNOW_ROOF, &
- PABS_SW_ROAD,PABS_LW_ROAD, &
- PABS_SW_SNOW_ROAD,PABS_LW_SNOW_ROAD, &
- PABS_SW_WALL_A,PABS_LW_WALL_A, &
- PABS_SW_WALL_B,PABS_LW_WALL_B, &
- PABS_SW_PANEL,PABS_LW_PANEL, &
- PABS_SW_GARDEN,PABS_LW_GARDEN, &
- PABS_SW_GREENROOF,PABS_LW_GREENROOF, &
- PG_GREENROOF_ROOF,PRUNOFF_GREENROOF,PDRAIN_GREENROOF, &
- PIRRIG_GREENROOF, HCOOL_COIL, PF_WATER_COND, HHEAT_COIL, &
- HNATVENT, KDAY, PAUX_MAX, PT_FLOOR, &
- PT_MASS, PH_BLD_COOL, PT_BLD_COOL, PH_BLD_HEAT, &
- PLE_BLD_COOL, PLE_BLD_HEAT, PH_WASTE, PLE_WASTE, &
- PF_WASTE_CAN, PHVAC_COOL, PHVAC_HEAT, PQIN, PQIN_FRAD, &
- PQIN_FLAT, PGR, PEFF_HEAT, PINF, &
- PTCOOL_TARGET, PTHEAT_TARGET, PHR_TARGET, PT_WIN2, &
- PQI_BLD, PV_VENT, PCAP_SYS_HEAT, PCAP_SYS_RAT, PT_ADP, &
- PM_SYS_RAT, PCOP_RAT, PCAP_SYS, PM_SYS, PCOP, PQ_SYS, &
- PT_SYS, PTR_SW_WIN, PFAN_POWER, PHC_FLOOR, PTC_FLOOR, &
- PD_FLOOR, PT_WIN1, PABS_SW_WIN, PABS_LW_WIN, PSHGC, &
- PSHGC_SH, PUGG_WIN, PALB_WIN, PABS_WIN, PEMIT_LW_FAC, &
- PEMIT_LW_GRND, PT_RAD_IND, PREF_SW_GRND, PREF_SW_FAC, &
- PHU_BLD, PTIME, OSHADE, OSHAD_DAY, ONATVENT_NIGHT, HBEM, &
- PN_FLOOR, PWALL_O_BLD, PGLAZ_O_BLD, PMASS_O_BLD, &
- PFLOOR_HW_RATIO, PF_FLOOR_MASS, PF_FLOOR_WALL, &
- PF_FLOOR_WIN, PF_FLOOR_ROOF, PF_WALL_FLOOR, PF_WALL_MASS,&
- PF_WALL_WIN, PF_WIN_FLOOR, PF_WIN_MASS, PF_WIN_WALL, &
- PF_MASS_FLOOR, PF_MASS_WALL, PF_MASS_WIN, OCANOPY, &
- PTRAN_WIN, HCH_BEM, PROUGH_ROOF, PROUGH_WALL, PF_WIN_WIN,&
- OPAR_RD_IRRIG, PRD_START_MONTH, PRD_END_MONTH, &
- PRD_START_HOUR, PRD_END_HOUR, PRD_24H_IRRIG, PIRRIG_ROAD,&
- PEMIS_PANEL, PALB_PANEL, PEFF_PANEL, PFRAC_PANEL, &
- PRESIDENTIAL, &
- PTHER_PROD_PANEL, PPHOT_PROD_PANEL, PPROD_PANEL, &
- PTHER_PROD_BLD , PPHOT_PROD_BLD , PPROD_BLD , &
- PTHER_PRODC_DAY, PH_PANEL, PRN_PANEL, &
- PDT_RES, PDT_OFF, &
- PCUR_TCOOL_TARGET, PCUR_THEAT_TARGET, PCUR_QIN )
+ SUBROUTINE TEB_GARDEN (DTCO, G, TOP, T, BOP, B, TPN, TIR, DMT, GDM, GRM, KTEB_P, &
+ HIMPLICIT_WIND, PTSUN, PT_CAN, PQ_CAN, PU_CAN, PT_LOWCAN, PQ_LOWCAN, &
+ PU_LOWCAN, PZ_LOWCAN, PPEW_A_COEF, PPEW_B_COEF, PPEW_A_COEF_LOWCAN, &
+ PPEW_B_COEF_LOWCAN, PPS, PPA, PEXNS, PEXNA, PTA, PQA, PRHOA, PCO2, &
+ PLW_RAD, PDIR_SW, PSCA_SW, PSW_BANDS, KSW, PZENITH, PAZIM, PRR, PSR, &
+ PZREF, PUREF, PVMOD, PH_TRAFFIC, PLE_TRAFFIC, PTSTEP, PLEW_RF, PLEW_RD,&
+ PLE_WL_A, PLE_WL_B, PRNSN_RF, PHSN_RF, PLESN_RF, PGSN_RF, PMELT_RF, &
+ PRNSN_RD, PHSN_RD, PLESN_RD, PGSN_RD, PMELT_RD, PRN_GRND, PH_GRND, &
+ PLE_GRND, PGFLX_GRND, PRN_TWN, PH_TWN, PLE_TWN, PGFLX_TWN, PEVAP_TWN, &
+ PSFCO2, PUW_GRND, PUW_RF, PDUWDU_GRND, PDUWDU_RF, &
+ PUSTAR_TWN, PCD, PCDN, PCH_TWN, PRI_TWN, PTS_TWN, PEMIS_TWN, &
+ PDIR_ALB_TWN, PSCA_ALB_TWN, PRESA_TWN, PAC_RD, PAC_GD, PAC_GR, &
+ PAC_RD_WAT, PAC_GD_WAT, PAC_GR_WAT, KDAY, PEMIT_LW_FAC, PEMIT_LW_GRND, &
+ PT_RAD_IND, PREF_SW_GRND, PREF_SW_FAC, PHU_BLD, PTIME, PPROD_BLD )
! ##########################################################################
!
!!**** *TEB_GARDEN*
@@ -132,24 +49,28 @@
!! MODIFICATIONS
!! -------------
!! Original 05/2009
-!! 04/2012 add PTRAN_WIN
-!! modified 08/2012 HCH_BEM/ ROUGH_WALL and ROUGH_ROOF for buildind conv coef.
-!! modified 10/2012 add PF_WIN_WIN as arg
+!! 04/2012 add B%XTRAN_WIN
+!! modified 08/2012 TOP%CCH_BEM/ ROUGH_WALL and ROUGH_ROOF for buildind conv coef.
+!! modified 10/2012 add B%XF_WIN_WIN as arg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-!
-!
-!
-!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_SURFEX_n, ONLY : TEB_MODEL_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
+USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
+USE MODD_TEB_n, ONLY : TEB_t
+USE MODD_BEM_OPTION_n, ONLY : BEM_OPTIONS_t
+USE MODD_BEM_n, ONLY : BEM_t
+USE MODD_TEB_PANEL_n, ONLY : TEB_PANEL_t
+USE MODD_TEB_IRRIG_n, ONLY : TEB_IRRIG_t
+USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_t
+!
+USE MODD_DIAG_n, ONLY : DIAG_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
+!
USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t
USE MODD_SURFEX_n, ONLY : TEB_GREENROOF_MODEL_t
!
@@ -162,8 +83,7 @@ USE MODE_THERMOS
USE MODE_SURF_SNOW_FRAC
!
USE MODI_SOLAR_PANEL
-USE MODI_GARDEN_PROPERTIES
-USE MODI_GREENROOF_PROPERTIES
+USE MODI_TEB_VEG_PROPERTIES
USE MODI_WINDOW_SHADING_AVAILABILITY
USE MODI_URBAN_SOLAR_ABS
USE MODI_URBAN_LW_COEF
@@ -180,65 +100,35 @@ IMPLICIT NONE
!
!* 0.1 Declarations of arguments
!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
!
+TYPE(GRID_t), INTENT(INOUT) :: G
+!
+TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+TYPE(TEB_t), INTENT(INOUT) :: T
+TYPE(BEM_OPTIONS_t), INTENT(INOUT) :: BOP
+TYPE(BEM_t), INTENT(INOUT) :: B
+TYPE(TEB_PANEL_t), INTENT(INOUT) :: TPN
+TYPE(TEB_IRRIG_t), INTENT(INOUT) :: TIR
+TYPE(DIAG_MISC_TEB_t), INTENT(INOUT) :: DMT
!
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM
TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM
!
- LOGICAL, INTENT(IN) :: OGARDEN ! Flag to use a garden model inside the canyon
- LOGICAL, INTENT(IN) :: OGREENROOF ! Flag to use a greenroof model on roofs
- LOGICAL, INTENT(IN) :: OSOLAR_PANEL ! Flag to use a Solar Panel model on roofs
- CHARACTER(LEN=6) , INTENT(IN) :: HZ0H ! TEB option for z0h roof & road
-! ! 'MASC95' : Mascart et al 1995
-! ! 'BRUT82' : Brustaert 1982
-! ! 'KAND07' : Kanda 2007
- CHARACTER(LEN=*), INTENT(IN) :: HIMPLICIT_WIND ! wind implicitation option
+INTEGER, INTENT(IN) :: KTEB_P ! TEB current patch number
+!
+ CHARACTER(LEN=*), INTENT(IN) :: HIMPLICIT_WIND ! wind implicitation option
! ! 'OLD' = direct
! ! 'NEW' = Taylor serie, order 1
- CHARACTER(LEN=4) , INTENT(IN) :: HROAD_DIR ! TEB option for road direction
- ! 'UNIF' : uniform roads
- ! 'ORIE' : specified
- ! road orientation
- CHARACTER(LEN=4) , INTENT(IN) :: HWALL_OPT ! TEB option for walls representation
- ! 'UNIF' : uniform walls
- ! 'TWO ' : 2 opposite walls
-TYPE(DATE_TIME) , INTENT(IN) :: TPTIME ! current date and time from teb
REAL, DIMENSION(:), INTENT(IN) :: PTSUN ! solar time (s from midnight)
-
!
-REAL, DIMENSION(:) , INTENT(INOUT) :: PT_CANYON ! canyon air temperature
-REAL, DIMENSION(:) , INTENT(INOUT) :: PQ_CANYON ! canyon air specific humidity
-REAL, DIMENSION(:) , INTENT(IN) :: PU_CANYON ! canyon hor. wind
+REAL, DIMENSION(:) , INTENT(INOUT) :: PT_CAN ! canyon air temperature
+REAL, DIMENSION(:) , INTENT(INOUT) :: PQ_CAN ! canyon air specific humidity
+REAL, DIMENSION(:) , INTENT(IN) :: PU_CAN ! canyon hor. wind
REAL, DIMENSION(:) , INTENT(IN) :: PU_LOWCAN ! wind near the road
REAL, DIMENSION(:) , INTENT(IN) :: PT_LOWCAN ! temp. near the road
REAL, DIMENSION(:) , INTENT(IN) :: PQ_LOWCAN ! hum. near the road
REAL, DIMENSION(:) , INTENT(IN) :: PZ_LOWCAN ! height of atm. var. near the road
-REAL, DIMENSION(:) , INTENT(INOUT) :: PTI_BLD ! inside building temperature
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PT_ROOF ! roof layers temperatures
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PT_ROAD ! road layers temperatures
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PT_WALL_A ! wall layers temperatures
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PT_WALL_B ! wall layers temperatures
-REAL, DIMENSION(:) , INTENT(INOUT) :: PWS_ROOF ! roof water reservoir
-REAL, DIMENSION(:) , INTENT(INOUT) :: PWS_ROAD ! road water reservoir
- CHARACTER(LEN=*) , INTENT(IN) :: HSNOW_ROOF ! snow roof scheme 'NONE', 'D95 ', '1-L '
- CHARACTER(LEN=*) , INTENT(IN) :: HSNOW_ROAD ! snow road scheme 'NONE', 'D95 ', '1-L '
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PWSNOW_ROOF ! snow layers reservoir
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTSNOW_ROOF ! snow layers temperature
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRSNOW_ROOF ! snow layers density
-REAL, DIMENSION(:) , INTENT(INOUT) :: PASNOW_ROOF ! snow albedo
-REAL, DIMENSION(:) , INTENT(INOUT) :: PESNOW_ROOF ! snow emissivity
-REAL, DIMENSION(:) , INTENT(INOUT) :: PTSSNOW_ROOF ! snow surface temperature
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PWSNOW_ROAD ! snow layers reservoir
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTSNOW_ROAD ! snow layers temperature
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRSNOW_ROAD ! snow layers density
-REAL, DIMENSION(:) , INTENT(INOUT) :: PASNOW_ROAD ! snow albedo
-REAL, DIMENSION(:) , INTENT(INOUT) :: PESNOW_ROAD ! snow emissivity
-REAL, DIMENSION(:) , INTENT(INOUT) :: PTSSNOW_ROAD ! snow surface temperature
REAL, DIMENSION(:) , INTENT(IN) :: PPEW_A_COEF ! implicit coefficients
REAL, DIMENSION(:) , INTENT(IN) :: PPEW_B_COEF ! for wind coupling
REAL, DIMENSION(:) , INTENT(IN) :: PPEW_A_COEF_LOWCAN ! implicit coefficients for wind coupling
@@ -264,229 +154,61 @@ REAL, DIMENSION(:) , INTENT(IN) :: PRR ! rain rate
REAL, DIMENSION(:) , INTENT(IN) :: PSR ! snow rate
REAL, DIMENSION(:) , INTENT(IN) :: PH_TRAFFIC ! anthropogenic sensible heat fluxes due to traffic
REAL, DIMENSION(:) , INTENT(IN) :: PLE_TRAFFIC ! anthropogenic latent heat fluxes due to traffic
-REAL, DIMENSION(:) , INTENT(IN) :: PH_INDUSTRY ! anthropogenic sensible heat fluxes due to factories
-REAL, DIMENSION(:) , INTENT(IN) :: PLE_INDUSTRY ! anthropogenic latent heat fluxes due to factories
REAL, DIMENSION(:) , INTENT(IN) :: PZREF ! reference height of the first atm level (temperature)
REAL, DIMENSION(:) , INTENT(IN) :: PUREF ! reference height of the first atm level (wind)
REAL , INTENT(IN) :: PTSTEP ! time step
-REAL, DIMENSION(:) , INTENT(IN) :: PZ0_TOWN ! town roughness length for momentum
-REAL, DIMENSION(:) , INTENT(IN) :: PBLD ! fraction of buildings
-REAL, DIMENSION(:) , INTENT(IN) :: PGARDEN ! fraction of green areas
-REAL, DIMENSION(:) , INTENT(IN) :: PROAD_DIR ! road direction (deg from North, clockwise)
-REAL, DIMENSION(:) , INTENT(IN) :: PROAD ! fraction of roads
-REAL, DIMENSION(:) , INTENT(IN) :: PFRAC_GR ! fraction of green roofs
-REAL, DIMENSION(:) , INTENT(IN) :: PBLD_HEIGHT ! buildings h
-REAL, DIMENSION(:) , INTENT(IN) :: PWALL_O_HOR ! wall surf. / hor. surf.
-REAL, DIMENSION(:) , INTENT(IN) :: PCAN_HW_RATIO ! canyon h/W
-REAL, DIMENSION(:) , INTENT(IN) :: PROAD_O_GRND ! road surf. / (road+garden surf.)
-REAL, DIMENSION(:) , INTENT(IN) :: PGARDEN_O_GRND ! garden surf. / (road+garden surf.)
-REAL, DIMENSION(:) , INTENT(IN) :: PWALL_O_GRND ! wall surf. / (road+garden surf.)
-REAL, DIMENSION(:) , INTENT(IN) :: PALB_ROOF ! roof albedo
-REAL, DIMENSION(:) , INTENT(IN) :: PEMIS_ROOF ! roof emissivity
-REAL, DIMENSION(:,:), INTENT(IN) :: PHC_ROOF ! heat capacity for roof layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PTC_ROOF ! thermal conductivity for roof layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_ROOF ! depth of roof layers
-REAL, DIMENSION(:) , INTENT(IN) :: PALB_ROAD ! road albedo
-REAL, DIMENSION(:) , INTENT(IN) :: PEMIS_ROAD ! road emissivity
-REAL, DIMENSION(:,:), INTENT(IN) :: PHC_ROAD ! heat capacity for road layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PTC_ROAD ! thermal conductivity for road layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_ROAD ! depth of road layers
-REAL, DIMENSION(:) , INTENT(IN) :: PSVF_ROAD ! road sky view factor
-REAL, DIMENSION(:) , INTENT(IN) :: PALB_WALL ! wall albedo
-REAL, DIMENSION(:) , INTENT(IN) :: PEMIS_WALL ! wall emissivity
-REAL, DIMENSION(:,:), INTENT(IN) :: PHC_WALL ! heat capacity for wall layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PTC_WALL ! thermal conductivity for wall layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_WALL ! depth of wall layers
-REAL, DIMENSION(:) , INTENT(IN) :: PSVF_WALL ! wall sky view factor
-REAL, DIMENSION(:) , INTENT(IN) :: PSVF_GARDEN ! green area sky view factor
- !
-REAL, DIMENSION(:) , INTENT(OUT) :: PRN_ROOF ! net radiation over roof
-REAL, DIMENSION(:) , INTENT(OUT) :: PH_ROOF ! sensible heat flux over roof
-REAL, DIMENSION(:) , INTENT(OUT) :: PLE_ROOF ! latent heat flux over roof
-REAL, DIMENSION(:) , INTENT(OUT) :: PLEW_ROOF ! latent heat flux over roof (snow)
-REAL, DIMENSION(:) , INTENT(OUT) :: PGFLUX_ROOF ! flux through the roof
-REAL, DIMENSION(:) , INTENT(OUT) :: PRUNOFF_ROOF ! runoff over the ground
-REAL, DIMENSION(:) , INTENT(OUT) :: PRN_ROAD ! net radiation over road
-REAL, DIMENSION(:) , INTENT(OUT) :: PH_ROAD ! sensible heat flux over road
-REAL, DIMENSION(:) , INTENT(OUT) :: PLE_ROAD ! latent heat flux over road
-REAL, DIMENSION(:) , INTENT(OUT) :: PLEW_ROAD ! latent heat flux over road (snow)
-REAL, DIMENSION(:) , INTENT(OUT) :: PGFLUX_ROAD ! flux through the road
-REAL, DIMENSION(:) , INTENT(OUT) :: PRUNOFF_ROAD ! runoff over the ground
-REAL, DIMENSION(:) , INTENT(OUT) :: PRN_WALL_A ! net radiation over wall
-REAL, DIMENSION(:) , INTENT(OUT) :: PH_WALL_A ! sensible heat flux over wall
-REAL, DIMENSION(:) , INTENT(OUT) :: PLE_WALL_A ! latent heat flux over wall
-REAL, DIMENSION(:) , INTENT(OUT) :: PGFLUX_WALL_A ! flux through the wall
-REAL, DIMENSION(:) , INTENT(OUT) :: PRN_WALL_B ! net radiation over wall
-REAL, DIMENSION(:) , INTENT(OUT) :: PH_WALL_B ! sensible heat flux over wall
-REAL, DIMENSION(:) , INTENT(OUT) :: PLE_WALL_B ! latent heat flux over wall
-REAL, DIMENSION(:) , INTENT(OUT) :: PGFLUX_WALL_B ! flux through the wall
-REAL, DIMENSION(:) , INTENT(OUT) :: PRN_GARDEN ! net radiation over green areas
-REAL, DIMENSION(:) , INTENT(OUT) :: PH_GARDEN ! sensible heat flux over green areas
-REAL, DIMENSION(:) , INTENT(OUT) :: PLE_GARDEN ! latent heat flux over green areas
-REAL, DIMENSION(:) , INTENT(OUT) :: PGFLUX_GARDEN ! flux through the green areas
-REAL, DIMENSION(:) , INTENT(OUT) :: PRUNOFF_GARDEN ! runoff over garden
-REAL, DIMENSION(:) , INTENT(OUT) :: PDRAIN_GARDEN ! drainage over garden
-REAL, DIMENSION(:) , INTENT(OUT) :: PIRRIG_GARDEN ! water supply for irrigation over garden (kg/m2/s)
-REAL, DIMENSION(:) , INTENT(OUT) :: PRN_GREENROOF ! net radiation over greenroofs
-REAL, DIMENSION(:) , INTENT(OUT) :: PH_GREENROOF ! sensible heat flux over greenroofs
-REAL, DIMENSION(:) , INTENT(OUT) :: PLE_GREENROOF ! latent heat flux over greenroofs
-REAL, DIMENSION(:) , INTENT(OUT) :: PGFLUX_GREENROOF ! flux through the greenroofs
-REAL, DIMENSION(:) , INTENT(OUT) :: PRN_STRLROOF ! net radiation over structural roof
-REAL, DIMENSION(:) , INTENT(OUT) :: PH_STRLROOF ! sensible heat flux over structural roof
-REAL, DIMENSION(:) , INTENT(OUT) :: PLE_STRLROOF ! latent heat flux over structural roof
-REAL, DIMENSION(:) , INTENT(OUT) :: PGFLUX_STRLROOF ! flux through the structural roof
-REAL, DIMENSION(:) , INTENT(OUT) :: PRUNOFF_STRLROOF ! runoff aver structural roof
-REAL, DIMENSION(:) , INTENT(OUT) :: PRN_BLT ! net radiation over built surf
-REAL, DIMENSION(:) , INTENT(OUT) :: PH_BLT ! sensible heat flux over built surf
-REAL, DIMENSION(:) , INTENT(OUT) :: PLE_BLT ! latent heat flux over built surf
-REAL, DIMENSION(:) , INTENT(OUT) :: PGFLUX_BLT ! flux through the built surf
-!
-REAL, DIMENSION(:) , INTENT(OUT) :: PRNSNOW_ROOF ! net radiation over snow
-REAL, DIMENSION(:) , INTENT(OUT) :: PHSNOW_ROOF ! sensible heat flux over snow
-REAL, DIMENSION(:) , INTENT(OUT) :: PLESNOW_ROOF ! latent heat flux over snow
-REAL, DIMENSION(:) , INTENT(OUT) :: PGSNOW_ROOF ! flux under the snow
-REAL, DIMENSION(:) , INTENT(OUT) :: PMELT_ROOF ! snow melt
-REAL, DIMENSION(:) , INTENT(OUT) :: PRNSNOW_ROAD ! net radiation over snow
-REAL, DIMENSION(:) , INTENT(OUT) :: PHSNOW_ROAD ! sensible heat flux over snow
-REAL, DIMENSION(:) , INTENT(OUT) :: PLESNOW_ROAD ! latent heat flux over snow
-REAL, DIMENSION(:) , INTENT(OUT) :: PGSNOW_ROAD ! flux under the snow
-REAL, DIMENSION(:) , INTENT(OUT) :: PMELT_ROAD ! snow melt
-!
-REAL, DIMENSION(:) , INTENT(OUT) :: PRN_GRND ! net radiation over ground
-REAL, DIMENSION(:) , INTENT(OUT) :: PH_GRND ! sensible heat flux over ground
-REAL, DIMENSION(:) , INTENT(OUT) :: PLE_GRND ! latent heat flux over ground
-REAL, DIMENSION(:) , INTENT(OUT) :: PGFLUX_GRND ! flux through the ground
-REAL, DIMENSION(:) , INTENT(OUT) :: PRN_TOWN ! net radiation over town
-REAL, DIMENSION(:) , INTENT(OUT) :: PH_TOWN ! sensible heat flux over town
-REAL, DIMENSION(:) , INTENT(OUT) :: PLE_TOWN ! latent heat flux over town
-REAL, DIMENSION(:) , INTENT(OUT) :: PGFLUX_TOWN ! flux through the ground
-REAL, DIMENSION(:) , INTENT(OUT) :: PEVAP_TOWN ! evaporation flux (kg/m2/s)
-REAL, DIMENSION(:) , INTENT(OUT) :: PRUNOFF_TOWN ! runoff over the ground
-REAL, DIMENSION(:) , INTENT(OUT) :: PSFCO2 ! flux of CO2 (m/s*kg_CO2/kg_air)
-REAL, DIMENSION(:) , INTENT(OUT) :: PUW_GRND ! momentum flux for ground built surf
-REAL, DIMENSION(:) , INTENT(OUT) :: PUW_ROOF ! momentum flux for roofs
-REAL, DIMENSION(:) , INTENT(OUT) :: PDUWDU_GRND !
-REAL, DIMENSION(:) , INTENT(OUT) :: PDUWDU_ROOF !
-REAL, DIMENSION(:) , INTENT(OUT) :: PUSTAR_TOWN ! friciton velocity over town
-REAL, DIMENSION(:) , INTENT(OUT) :: PCD ! town averaged drag coefficient
-REAL, DIMENSION(:) , INTENT(OUT) :: PCDN ! town averaged neutral drag coefficient
-REAL, DIMENSION(:) , INTENT(OUT) :: PCH_TOWN ! town averaged heat transfer coefficient
-REAL, DIMENSION(:) , INTENT(OUT) :: PRI_TOWN ! town averaged Richardson number
-REAL, DIMENSION(:) , INTENT(OUT) :: PTS_TOWN ! town surface temperature
-REAL, DIMENSION(:) , INTENT(OUT) :: PEMIS_TOWN ! town equivalent emissivity
-REAL, DIMENSION(:) , INTENT(OUT) :: PDIR_ALB_TOWN ! town equivalent direct albedo
-REAL, DIMENSION(:) , INTENT(OUT) :: PSCA_ALB_TOWN ! town equivalent diffuse albedo
-REAL, DIMENSION(:) , INTENT(OUT) :: PRESA_TOWN ! town aerodynamical resistance
-REAL, DIMENSION(:) , INTENT(OUT) :: PDQS_TOWN ! heat storage inside town
-REAL, DIMENSION(:) , INTENT(OUT) :: PQF_TOWN ! total anthropogenic heat
-REAL, DIMENSION(:) , INTENT(OUT) :: PQF_BLD ! anthropogenic heat flux of domestic heating
-REAL, DIMENSION(:) , INTENT(OUT) :: PFLX_BLD ! heat flx from inside bld through its structure
-REAL, DIMENSION(:) , INTENT(OUT) :: PAC_ROAD ! road conductance
-REAL, DIMENSION(:) , INTENT(OUT) :: PAC_GARDEN ! green area conductance
-REAL, DIMENSION(:) , INTENT(OUT) :: PAC_GREENROOF ! green roof conductance
-REAL, DIMENSION(:) , INTENT(OUT) :: PAC_ROAD_WAT ! road conductance for latent heat
-REAL, DIMENSION(:) , INTENT(OUT) :: PAC_GARDEN_WAT ! green area conductance for latent heat
-REAL, DIMENSION(:) , INTENT(OUT) :: PAC_GREENROOF_WAT ! green roof conductance for latent heat
-!
-REAL, DIMENSION(:) , INTENT(OUT) :: PABS_SW_ROOF ! absorbed solar rad by roof
-REAL, DIMENSION(:) , INTENT(OUT) :: PABS_SW_SNOW_ROOF ! absorbed solar rad by snow on roof
-REAL, DIMENSION(:) , INTENT(OUT) :: PABS_LW_ROOF ! absorbed IR rad by roof
-REAL, DIMENSION(:) , INTENT(OUT) :: PABS_LW_SNOW_ROOF ! absorbed IR rad by snow on roof
-REAL, DIMENSION(:) , INTENT(OUT) :: PABS_SW_ROAD ! absorbed solar rad by road
-REAL, DIMENSION(:) , INTENT(OUT) :: PABS_SW_SNOW_ROAD ! absorbed solar rad by snow on road
-REAL, DIMENSION(:) , INTENT(OUT) :: PABS_LW_ROAD ! absorbed IR rad by road
-REAL, DIMENSION(:) , INTENT(OUT) :: PABS_LW_SNOW_ROAD ! absorbed IR rad by snow on road
-REAL, DIMENSION(:) , INTENT(OUT) :: PABS_SW_WALL_A ! absorbed solar rad by wall
-REAL, DIMENSION(:) , INTENT(OUT) :: PABS_LW_WALL_A ! absorbed IR rad by wall
-REAL, DIMENSION(:) , INTENT(OUT) :: PABS_SW_WALL_B ! absorbed solar rad by wall
-REAL, DIMENSION(:) , INTENT(OUT) :: PABS_LW_WALL_B ! absorbed IR rad by wall
-REAL, DIMENSION(:) , INTENT(OUT) :: PABS_SW_PANEL ! absorbed solar rad by solar panels
-REAL, DIMENSION(:) , INTENT(OUT) :: PABS_LW_PANEL ! absorbed IR rad by solar panels
-REAL, DIMENSION(:) , INTENT(OUT) :: PABS_SW_GARDEN ! absorbed solar rad by green areas
-REAL, DIMENSION(:) , INTENT(OUT) :: PABS_LW_GARDEN ! absorbed IR rad by green areas
-REAL, DIMENSION(:) , INTENT(OUT) :: PABS_SW_GREENROOF ! absorbed solar rad by green roofs
-REAL, DIMENSION(:) , INTENT(OUT) :: PABS_LW_GREENROOF ! absorbed IR rad by green roofs
-REAL, DIMENSION(:) , INTENT(OUT) :: PG_GREENROOF_ROOF ! heat flux between base of greenroof
-! ! and structural roof
-REAL, DIMENSION(:) , INTENT(OUT) :: PRUNOFF_GREENROOF ! greenroof surface runoff
-REAL, DIMENSION(:) , INTENT(OUT) :: PDRAIN_GREENROOF ! greenroof total vertical drainage
-REAL, DIMENSION(:) , INTENT(OUT) :: PIRRIG_GREENROOF ! water supply for greenroof ground irrigation
+!
+REAL, DIMENSION(:) , INTENT(OUT) :: PLEW_RF ! latent heat flux over roof (snow)
+REAL, DIMENSION(:) , INTENT(OUT) :: PLEW_RD ! latent heat flux over road (snow)
+REAL, DIMENSION(:) , INTENT(OUT) :: PLE_WL_A ! latent heat flux over wall
+REAL, DIMENSION(:) , INTENT(OUT) :: PLE_WL_B ! latent heat flux over wall
+
+!
+REAL, DIMENSION(:) , INTENT(OUT) :: PRNSN_RF ! net radiation over snow
+REAL, DIMENSION(:) , INTENT(OUT) :: PHSN_RF ! sensible heat flux over snow
+REAL, DIMENSION(:) , INTENT(OUT) :: PLESN_RF ! latent heat flux over snow
+REAL, DIMENSION(:) , INTENT(OUT) :: PGSN_RF ! flux under the snow
+REAL, DIMENSION(:) , INTENT(OUT) :: PMELT_RF ! snow melt
+REAL, DIMENSION(:) , INTENT(OUT) :: PRNSN_RD ! net radiation over snow
+REAL, DIMENSION(:) , INTENT(OUT) :: PHSN_RD ! sensible heat flux over snow
+REAL, DIMENSION(:) , INTENT(OUT) :: PLESN_RD ! latent heat flux over snow
+REAL, DIMENSION(:) , INTENT(OUT) :: PGSN_RD ! flux under the snow
+REAL, DIMENSION(:) , INTENT(OUT) :: PMELT_RD ! snow melt
+!
+REAL, DIMENSION(:) , INTENT(OUT) :: PRN_GRND ! net radiation over ground
+REAL, DIMENSION(:) , INTENT(OUT) :: PH_GRND ! sensible heat flux over ground
+REAL, DIMENSION(:) , INTENT(OUT) :: PLE_GRND ! latent heat flux over ground
+REAL, DIMENSION(:) , INTENT(OUT) :: PGFLX_GRND ! flux through the ground
+REAL, DIMENSION(:) , INTENT(OUT) :: PRN_TWN ! net radiation over town
+REAL, DIMENSION(:) , INTENT(OUT) :: PH_TWN ! sensible heat flux over town
+REAL, DIMENSION(:) , INTENT(OUT) :: PLE_TWN ! latent heat flux over town
+REAL, DIMENSION(:) , INTENT(OUT) :: PGFLX_TWN ! flux through the ground
+REAL, DIMENSION(:) , INTENT(OUT) :: PEVAP_TWN ! evaporation flux (kg/m2/s)
+REAL, DIMENSION(:) , INTENT(OUT) :: PSFCO2 ! flux of CO2 (m/s*kg_CO2/kg_air)
+REAL, DIMENSION(:) , INTENT(OUT) :: PUW_GRND ! momentum flux for ground built surf
+REAL, DIMENSION(:) , INTENT(OUT) :: PUW_RF ! momentum flux for roofs
+REAL, DIMENSION(:) , INTENT(OUT) :: PDUWDU_GRND !
+REAL, DIMENSION(:) , INTENT(OUT) :: PDUWDU_RF !
+REAL, DIMENSION(:) , INTENT(OUT) :: PUSTAR_TWN ! friciton velocity over town
+REAL, DIMENSION(:) , INTENT(OUT) :: PCD ! town averaged drag coefficient
+REAL, DIMENSION(:) , INTENT(OUT) :: PCDN ! town averaged neutral drag coefficient
+REAL, DIMENSION(:) , INTENT(OUT) :: PCH_TWN ! town averaged heat transfer coefficient
+REAL, DIMENSION(:) , INTENT(OUT) :: PRI_TWN ! town averaged Richardson number
+REAL, DIMENSION(:) , INTENT(OUT) :: PTS_TWN ! town surface temperature
+REAL, DIMENSION(:) , INTENT(OUT) :: PEMIS_TWN ! town equivalent emissivity
+REAL, DIMENSION(:) , INTENT(OUT) :: PDIR_ALB_TWN ! town equivalent direct albedo
+REAL, DIMENSION(:) , INTENT(OUT) :: PSCA_ALB_TWN ! town equivalent diffuse albedo
+REAL, DIMENSION(:) , INTENT(OUT) :: PRESA_TWN ! town aerodynamical resistance
+REAL, DIMENSION(:) , INTENT(OUT) :: PAC_RD ! road conductance
+REAL, DIMENSION(:) , INTENT(OUT) :: PAC_GD ! green area conductance
+REAL, DIMENSION(:) , INTENT(OUT) :: PAC_GR ! green roof conductance
+REAL, DIMENSION(:) , INTENT(OUT) :: PAC_RD_WAT ! road conductance for latent heat
+REAL, DIMENSION(:) , INTENT(OUT) :: PAC_GD_WAT ! green area conductance for latent heat
+REAL, DIMENSION(:) , INTENT(OUT) :: PAC_GR_WAT ! green roof conductance for latent heat
!
! new arguments created after BEM
!
- CHARACTER(LEN=6) , INTENT(IN) :: HCOOL_COIL
- CHARACTER(LEN=6) , INTENT(IN) :: HHEAT_COIL
-REAL, DIMENSION(:) , INTENT(IN) :: PF_WATER_COND ! fraction of evaporation for the condensers
- CHARACTER(LEN=4), DIMENSION(:), INTENT(IN) :: HNATVENT
INTEGER , INTENT(IN) :: KDAY ! Simulation day
-REAL, DIMENSION(:) , INTENT(INOUT) :: PAUX_MAX ! Auxiliar variable for autosize calcs
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PT_FLOOR ! Floor layers temperatures [K]
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PT_MASS ! Internal mass layers temperatures [K]
-REAL, DIMENSION(:) , INTENT(OUT) :: PH_BLD_COOL ! Sensible cooling energy demand
- ! of the building [W m-2(bld)]
-REAL, DIMENSION(:) , INTENT(OUT) :: PT_BLD_COOL ! Total cooling energy demand
- ! of the building [W m-2(bld)]
-REAL, DIMENSION(:) , INTENT(OUT) :: PH_BLD_HEAT ! Heating energy demand
- ! of the building [W m-2(bld)]
-REAL, DIMENSION(: ), INTENT(OUT) :: PLE_BLD_COOL ! Latent cooling energy demand
- ! of the building [W m-2(bld)]
-REAL, DIMENSION(:) , INTENT(OUT) :: PLE_BLD_HEAT ! Latent heating energy demand
- ! of the building [W m-2(bld)]
-REAL, DIMENSION(:) , INTENT(OUT) :: PH_WASTE ! Sensible waste heat from HVAC system
- ! [W m-2(tot)]
-REAL, DIMENSION(:) , INTENT(OUT) :: PLE_WASTE ! Latent waste heat from HVAC system
- ! [W m-2(tot)]
-REAL, DIMENSION(:) , INTENT(IN) :: PF_WASTE_CAN ! fraction of waste heat released into the canyon
-REAL, DIMENSION(:) , INTENT(OUT) :: PHVAC_COOL ! Energy consumption of the cooling system
- ! [W m-2(bld)]
-REAL, DIMENSION(:) , INTENT(OUT) :: PHVAC_HEAT ! Energy consumption of the heating system
- ! [W m-2(bld)]
-REAL, DIMENSION(:) , INTENT(IN) :: PQIN ! Internal heat gains [W m-2(floor)]
-REAL, DIMENSION(:) , INTENT(IN) :: PQIN_FRAD ! Radiant fraction of internal heat gains
-REAL, DIMENSION(:) , INTENT(IN) :: PQIN_FLAT ! Latent franction of internal heat gains
-REAL, DIMENSION(:) , INTENT(IN) :: PGR ! Glazing ratio
-REAL, DIMENSION(:) , INTENT(IN) :: PEFF_HEAT ! Efficiency of the heating system
-REAL, DIMENSION(:) , INTENT(IN) :: PINF ! Infiltration flow rate [AC/H]
-REAL, DIMENSION(:) , INTENT(IN) :: PTCOOL_TARGET ! Cooling setpoint of HVAC system [K]
-REAL, DIMENSION(:) , INTENT(IN) :: PTHEAT_TARGET ! Heating setpoint of HVAC system [K]
-REAL, DIMENSION(:) , INTENT(IN) :: PHR_TARGET ! Relative humidity setpoint
-REAL, DIMENSION(:) , INTENT(INOUT) :: PT_WIN2 ! Indoor window temperature [K]
-REAL, DIMENSION(:) , INTENT(INOUT) :: PQI_BLD ! Indoor air specific humidity [kg kg-1]
-REAL, DIMENSION(:) , INTENT(IN) :: PV_VENT ! Ventilation flow rate [AC/H]
-REAL, DIMENSION(:) , INTENT(IN) :: PCAP_SYS_HEAT ! Capacity of the heating system
- ! [W m-2(bld)]
-REAL, DIMENSION(:) , INTENT(INOUT) :: PCAP_SYS_RAT ! Rated capacity of the cooling system
- ! [W m-2(bld)]
-REAL, DIMENSION(:) , INTENT(IN) :: PT_ADP ! Apparatus dewpoint temperature of the
- ! cooling coil [K]
-REAL, DIMENSION(:) , INTENT(INOUT) :: PM_SYS_RAT ! Rated HVAC mass flow rate
- ! [kg s-1 m-2(bld)]
-REAL, DIMENSION(:) , INTENT(IN) :: PCOP_RAT ! Rated COP of the cooling system
-REAL, DIMENSION(:) , INTENT(OUT) :: PCAP_SYS ! Actual capacity of the cooling system
- ! [W m-2(bld)]
-REAL, DIMENSION(:) , INTENT(OUT) :: PM_SYS ! Actual HVAC mass flow rate
- ! [kg s-1 m-2(bld)]
-REAL, DIMENSION(:) , INTENT(OUT) :: PCOP ! COP of the cooling system
-REAL, DIMENSION(:) , INTENT(OUT) :: PQ_SYS ! Supply air specific humidity [kg kg-1]
-REAL, DIMENSION(:) , INTENT(OUT) :: PT_SYS ! Supply air temperature [K]
-REAL, DIMENSION(:) , INTENT(OUT) :: PTR_SW_WIN ! Solar radiation transmitted throught
- ! windows [W m-2(bld)]
-REAL, DIMENSION(:) , INTENT(OUT) :: PFAN_POWER ! HVAC fan power
-REAL, DIMENSION(:,:), INTENT(IN) :: PHC_FLOOR ! heat capacity for road layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PTC_FLOOR ! thermal conductivity for
- ! road layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_FLOOR ! depth of road layers
-
-REAL, DIMENSION(:) , INTENT(INOUT) :: PT_WIN1 ! outdoor window temperature [K]
-REAL, DIMENSION(:) , INTENT(OUT) :: PABS_SW_WIN ! window absorbed shortwave radiation [W m-2]
-REAL, DIMENSION(:) , INTENT(OUT) :: PABS_LW_WIN ! absorbed infrared rad. [W m-2]
-REAL, DIMENSION(:) , INTENT(IN) :: PSHGC ! window solar transmittance
-REAL, DIMENSION(:) , INTENT(IN) :: PSHGC_SH ! window + shading solar heat gain coef.
-REAL, DIMENSION(:) , INTENT(IN) :: PUGG_WIN ! window glass-to-glass U-factro [W m-2 K-1]
-REAL, DIMENSION(:) , INTENT(OUT) :: PALB_WIN ! window albedo
-REAL, DIMENSION(:) , INTENT(IN) :: PABS_WIN ! window absortance
-REAL, DIMENSION(:) , INTENT(IN) :: PTRAN_WIN ! window transmittance
-!
! new argument for the UTCI calculation
REAL, DIMENSION(:) , INTENT(OUT) :: PEMIT_LW_GRND ! LW flux emitted by the ground (W/m2 ground)
REAL, DIMENSION(:) , INTENT(OUT) :: PEMIT_LW_FAC ! LW flux emitted by the facade (W/m2 ground)
@@ -497,97 +219,45 @@ REAL, DIMENSION(:) , INTENT(OUT) :: PHU_BLD ! Indoor relative humi
!
! new arguments for shading, schedule or natural ventilation
REAL , INTENT(IN) :: PTIME ! current time since midnight (UTC, s)
-LOGICAL,DIMENSION(:), INTENT(IN) :: OSHADE
-LOGICAL,DIMENSION(:), INTENT(INOUT) :: OSHAD_DAY ! has shading been necessary this day ?
-LOGICAL,DIMENSION(:), INTENT(INOUT) :: ONATVENT_NIGHT ! has natural ventilation been necessary/possible this night ?
- CHARACTER(LEN=3) , INTENT(IN) :: HBEM ! Building Energy model 'DEF' or 'BEM'
-!
-REAL, DIMENSION(:) , INTENT(IN) :: PN_FLOOR ! Number of floors
-REAL, DIMENSION(:) , INTENT(IN) :: PWALL_O_BLD ! Wall area [m2_wall/m2_bld]
-REAL, DIMENSION(:) , INTENT(IN) :: PGLAZ_O_BLD ! Window area [m2_win/m2_bld]
-REAL, DIMENSION(:) , INTENT(IN) :: PMASS_O_BLD ! Mass area [m2_mass/m2_bld]
-REAL, DIMENSION(:) , INTENT(IN) :: PFLOOR_HW_RATIO ! H/W ratio of 1 floor level
-REAL, DIMENSION(:) , INTENT(IN) :: PF_FLOOR_MASS ! View factor floor-mass
-REAL, DIMENSION(:) , INTENT(IN) :: PF_FLOOR_WALL ! View factor floor-wall
-REAL, DIMENSION(:) , INTENT(IN) :: PF_FLOOR_WIN ! View factor floor-window
-REAL, DIMENSION(:) , INTENT(IN) :: PF_FLOOR_ROOF ! View factor floor-roof
-REAL, DIMENSION(:) , INTENT(IN) :: PF_WALL_FLOOR ! View factor wall-floor
-REAL, DIMENSION(:) , INTENT(IN) :: PF_WALL_MASS ! View factor wall-mass
-REAL, DIMENSION(:) , INTENT(IN) :: PF_WALL_WIN ! View factor wall-win
-REAL, DIMENSION(:) , INTENT(IN) :: PF_WIN_FLOOR ! View factor win-floor
-REAL, DIMENSION(:) , INTENT(IN) :: PF_WIN_MASS ! View factor win-mass
-REAL, DIMENSION(:) , INTENT(IN) :: PF_WIN_WALL ! View factor win-wall
-REAL, DIMENSION(:) , INTENT(IN) :: PF_MASS_FLOOR ! View factor mass-floor
-REAL, DIMENSION(:) , INTENT(IN) :: PF_MASS_WALL ! View factor mass-wall
-REAL, DIMENSION(:) , INTENT(IN) :: PF_MASS_WIN ! View factor mass-window
-LOGICAL , INTENT(IN) :: OCANOPY ! is canopy active ?
- CHARACTER(LEN=5) , INTENT(IN) :: HCH_BEM ! TEB option for building outside conv. coef
-REAL, DIMENSION(:) , INTENT(IN) :: PROUGH_ROOF ! roof roughness coef.
-REAL, DIMENSION(:) , INTENT(IN) :: PROUGH_WALL ! wall roughness coef.
-REAL, DIMENSION(:) , INTENT(IN) :: PF_WIN_WIN ! indoor win to win view factor
-!
-!* arguments for road watering
-!
-LOGICAL, INTENT(IN) :: OPAR_RD_IRRIG ! True if there is potentially irrigation
-REAL, DIMENSION(:), INTENT(IN) :: PRD_START_MONTH! First month of irrigation
-REAL, DIMENSION(:), INTENT(IN) :: PRD_END_MONTH ! Last month of irrigation
-REAL, DIMENSION(:), INTENT(IN) :: PRD_START_HOUR ! First hour of irrigation (included)
-REAL, DIMENSION(:), INTENT(IN) :: PRD_END_HOUR ! Last hour of irrigation (excluded)
-REAL, DIMENSION(:), INTENT(IN) :: PRD_24H_IRRIG ! diurnal averaged irrigation flux (kg/m2/s)
-REAL, DIMENSION(:), INTENT(OUT) :: PIRRIG_ROAD ! man-made watering of roads (kg/m2/s)
!
!* arguments for solar panels
!
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_PANEL ! Emissivity of solar panels (-)
-REAL, DIMENSION(:), INTENT(IN) :: PALB_PANEL ! Albedo of solar panels (-)
-REAL, DIMENSION(:), INTENT(IN) :: PEFF_PANEL ! Efficiency of solar panel (-)
-REAL, DIMENSION(:), INTENT(IN) :: PFRAC_PANEL ! Fraction of solar panel on roofs (-)
-REAL, DIMENSION(:), INTENT(OUT) :: PTHER_PROD_PANEL ! Thermal Energy production of solar panel on roofs (W/m2 panel)
-REAL, DIMENSION(:), INTENT(OUT) :: PPHOT_PROD_PANEL ! Photovoltaic Energy production of solar panel on roofs (W/m2 panel)
-REAL, DIMENSION(:), INTENT(OUT) :: PPROD_PANEL ! Averaged Energy production of solar panel on roofs (W/m2 panel)
-REAL, DIMENSION(:), INTENT(OUT) :: PTHER_PROD_BLD ! Thermal Energy production of solar panel on roofs (W/m2 bld )
-REAL, DIMENSION(:), INTENT(OUT) :: PPHOT_PROD_BLD ! Photovoltaic Energy production of solar panel on roofs (W/m2 bld )
REAL, DIMENSION(:), INTENT(OUT) :: PPROD_BLD ! Averaged Energy production of solar panel on roofs (W/m2 bld )
-REAL, DIMENSION(:), INTENT(OUT) :: PTHER_PRODC_DAY ! Present day integrated thermal production of energy (J/m2 panel)
-REAL, DIMENSION(:), INTENT(OUT) :: PH_PANEL ! Sensible heat flux from solar panels (W/m2 panel)
-REAL, DIMENSION(:), INTENT(OUT) :: PRN_PANEL ! Net radiation of solar panel (W/m2 panel)
!
-!* arguments for building's use description
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRESIDENTIAL ! Fraction of residential use (-)
-REAL, INTENT(IN) :: PDT_RES ! target temperature change when unoccupied (K) (residential buildings)
-REAL, INTENT(IN) :: PDT_OFF ! target temperature change when unoccupied (K) (office buildings)
-REAL, DIMENSION(:), INTENT(OUT) :: PCUR_TCOOL_TARGET ! Cooling target temperature at current time (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PCUR_THEAT_TARGET ! Heating target temperature at current time (K)
-REAL, DIMENSION(:), INTENT(OUT) :: PCUR_QIN ! Internal heat gains at current time (W/m2 floor)
+!* 0.2 Declarations of local variables
!
+TYPE(DIAG_t), POINTER :: GDDK
+TYPE(DIAG_EVAP_ISBA_t), POINTER :: GDDEK
+TYPE(DIAG_MISC_ISBA_t), POINTER :: GDDMK
!
-!* 0.2 Declarations of local variables
+TYPE(DIAG_t), POINTER :: GRDK
+TYPE(DIAG_EVAP_ISBA_t), POINTER :: GRDEK
+TYPE(DIAG_MISC_ISBA_t), POINTER :: GRDMK
!
REAL, DIMENSION(SIZE(PTA)) :: ZTA ! air temperature extrapolated at roof level
REAL, DIMENSION(SIZE(PTA)) :: ZQA ! air humidity extrapolated at roof level
!
-REAL, DIMENSION(SIZE(PTA)) :: ZDN_ROOF ! snow fraction on roofs
-REAL, DIMENSION(SIZE(PTA)) :: ZDN_ROAD ! snow fraction on roads
-REAL, DIMENSION(SIZE(PTA)) :: ZDF_ROOF ! free-snow fraction on roofs
-REAL, DIMENSION(SIZE(PTA)) :: ZDF_ROAD ! free-snow fraction on roads
-REAL, DIMENSION(SIZE(PTA)) :: ZDELT_ROAD ! fraction of water on roads
-REAL, DIMENSION(SIZE(PTA)) :: ZDELT_ROOF ! fraction of water on roofs
-REAL, DIMENSION(SIZE(PTA)) :: ZAC_ROOF ! roof conductance
-REAL, DIMENSION(SIZE(PTA)) :: ZAC_ROOF_WAT ! roof water conductance
-REAL, DIMENSION(SIZE(PTA)) :: ZAC_WALL ! wall conductance
-REAL, DIMENSION(SIZE(PTA)) :: ZAC_TOP ! top conductance
-REAL, DIMENSION(SIZE(PTA)) :: ZQSAT_ROAD ! hum of saturation for roads
-REAL, DIMENSION(SIZE(PTA)) :: ZQSAT_GARDEN ! hum of saturation for green areas
-REAL, DIMENSION(SIZE(PTA)) :: ZQSAT_ROOF ! hum of saturation for roofs
-REAL, DIMENSION(SIZE(PTA)) :: ZQSAT_GREENROOF! hum of saturation for green roofs
+REAL, DIMENSION(SIZE(PTA)) :: ZDN_RF ! snow fraction on roofs
+REAL, DIMENSION(SIZE(PTA)) :: ZDN_RD ! snow fraction on roads
+REAL, DIMENSION(SIZE(PTA)) :: ZDF_RF ! free-snow fraction on roofs
+REAL, DIMENSION(SIZE(PTA)) :: ZDF_RD ! free-snow fraction on roads
+REAL, DIMENSION(SIZE(PTA)) :: ZDELT_RD ! fraction of water on roads
+REAL, DIMENSION(SIZE(PTA)) :: ZDELT_RF ! fraction of water on roofs
+REAL, DIMENSION(SIZE(PTA)) :: ZAC_RF ! roof conductance
+REAL, DIMENSION(SIZE(PTA)) :: ZAC_RF_WAT ! roof water conductance
+REAL, DIMENSION(SIZE(PTA)) :: ZAC_WL ! wall conductance
+REAL, DIMENSION(SIZE(PTA)) :: ZAC_TOP ! top conductance
+REAL, DIMENSION(SIZE(PTA)) :: ZQSAT_RD ! hum of saturation for roads
+REAL, DIMENSION(SIZE(PTA)) :: ZQSAT_GD ! hum of saturation for green areas
+REAL, DIMENSION(SIZE(PTA)) :: ZQSAT_RF ! hum of saturation for roofs
+REAL, DIMENSION(SIZE(PTA)) :: ZQSAT_GR ! hum of saturation for green roofs
!
! coefficients for LW computations over snow (from previous time-step)
!
-REAL, DIMENSION(SIZE(PTA)) :: ZTSSNOW_ROOF ! roof snow temp at previous time-step
-REAL, DIMENSION(SIZE(PTA)) :: ZTSSNOW_ROAD ! road snow temp at previous time-step
-REAL, DIMENSION(SIZE(PTA)) :: ZESNOW_ROOF ! snow emissivity at previous time-step
-REAL, DIMENSION(SIZE(PTA)) :: ZESNOW_ROAD ! snow emissivity at previous time-step
+REAL, DIMENSION(SIZE(PTA)) :: ZTSSN_RF ! roof snow temp at previous time-step
+REAL, DIMENSION(SIZE(PTA)) :: ZTSSN_RD ! road snow temp at previous time-step
+REAL, DIMENSION(SIZE(PTA)) :: ZESN_RF ! snow emissivity at previous time-step
+REAL, DIMENSION(SIZE(PTA)) :: ZESN_RD ! snow emissivity at previous time-step
!
! incoming shortwave radiation
!
@@ -597,33 +267,33 @@ INTEGER :: JSWB
!
! albedo & emissivity
!
-REAL, DIMENSION(SIZE(PTA)) :: ZALB_GARDEN ! albedo for green areas
-REAL, DIMENSION(SIZE(PTA)) :: ZEMIS_GARDEN ! emissivity for green areas
-REAL, DIMENSION(SIZE(PTA)) :: ZALB_GREENROOF ! albedo for green roofs
-REAL, DIMENSION(SIZE(PTA)) :: ZEMIS_GREENROOF! emissivity for green roofs
+REAL, DIMENSION(SIZE(PTA)) :: ZALB_GD ! albedo for green areas
+REAL, DIMENSION(SIZE(PTA)) :: ZEMIS_GD ! emissivity for green areas
+REAL, DIMENSION(SIZE(PTA)) :: ZALB_GR ! albedo for green roofs
+REAL, DIMENSION(SIZE(PTA)) :: ZEMIS_GR ! emissivity for green roofs
!
-REAL, DIMENSION(SIZE(PTA)) :: ZALBNIR_TVEG_GARDEN ! nearIR veg tot albedo
-REAL, DIMENSION(SIZE(PTA)) :: ZALBVIS_TVEG_GARDEN ! visible veg tot albedo
-REAL, DIMENSION(SIZE(PTA)) :: ZALBNIR_TSOIL_GARDEN ! nearIR soil tot albedo
-REAL, DIMENSION(SIZE(PTA)) :: ZALBVIS_TSOIL_GARDEN ! visible soil tot albedo
+REAL, DIMENSION(SIZE(PTA)) :: ZALBNIR_TVEG_GD ! nearIR veg tot albedo
+REAL, DIMENSION(SIZE(PTA)) :: ZALBVIS_TVEG_GD ! visible veg tot albedo
+REAL, DIMENSION(SIZE(PTA)) :: ZALBNIR_TSOIL_GD ! nearIR soil tot albedo
+REAL, DIMENSION(SIZE(PTA)) :: ZALBVIS_TSOIL_GD ! visible soil tot albedo
!
-REAL, DIMENSION(SIZE(PTA)) :: ZALBNIR_TVEG_GREENROOF ! nearIR veg tot albedo
-REAL, DIMENSION(SIZE(PTA)) :: ZALBVIS_TVEG_GREENROOF ! visible veg tot albedo
-REAL, DIMENSION(SIZE(PTA)) :: ZALBNIR_TSOIL_GREENROOF ! nearIR soil tot albedo
-REAL, DIMENSION(SIZE(PTA)) :: ZALBVIS_TSOIL_GREENROOF ! visible soil tot albedo
+REAL, DIMENSION(SIZE(PTA)) :: ZALBNIR_TVEG_GR ! nearIR veg tot albedo
+REAL, DIMENSION(SIZE(PTA)) :: ZALBVIS_TVEG_GR ! visible veg tot albedo
+REAL, DIMENSION(SIZE(PTA)) :: ZALBNIR_TSOIL_GR ! nearIR soil tot albedo
+REAL, DIMENSION(SIZE(PTA)) :: ZALBVIS_TSOIL_GR ! visible soil tot albedo
!
! radiation received by surfaces
!
-REAL, DIMENSION(SIZE(PTA)) :: ZREC_SW_ROAD ! solar rad received by roads
-REAL, DIMENSION(SIZE(PTA)) :: ZREC_SW_WALL_A ! solar rad received by walls
-REAL, DIMENSION(SIZE(PTA)) :: ZREC_SW_WALL_B ! solar rad received by walls
-REAL, DIMENSION(SIZE(PTA)) :: ZREC_SW_GARDEN ! solar rad received by gardens
-REAL, DIMENSION(SIZE(PTA)) :: ZREC_SW_SNOW_ROAD ! solar rad received by snow on roads
+REAL, DIMENSION(SIZE(PTA)) :: ZREC_SW_RD ! solar rad received by roads
+REAL, DIMENSION(SIZE(PTA)) :: ZREC_SW_WL_A ! solar rad received by walls
+REAL, DIMENSION(SIZE(PTA)) :: ZREC_SW_WL_B ! solar rad received by walls
+REAL, DIMENSION(SIZE(PTA)) :: ZREC_SW_GD ! solar rad received by gardens
+REAL, DIMENSION(SIZE(PTA)) :: ZREC_SW_SN_RD ! solar rad received by snow on roads
!
-REAL, DIMENSION(SIZE(PTA)) :: ZREC_LW_GARDEN ! IR rad received by gardens
+REAL, DIMENSION(SIZE(PTA)) :: ZREC_LW_GD ! IR rad received by gardens
!
-REAL, DIMENSION(SIZE(PTA)) :: ZSW_RAD_GARDEN ! solar radiation reaching urban green areas
-REAL, DIMENSION(SIZE(PTA)) :: ZREC_SW_ROOF ! solar rad received by roofs in presence of solar panels
+REAL, DIMENSION(SIZE(PTA)) :: ZSW_RAD_GD ! solar radiation reaching urban green areas
+REAL, DIMENSION(SIZE(PTA)) :: ZREC_SW_RF ! solar rad received by roofs in presence of solar panels
!
! coefficients for LW contributions
!
@@ -668,7 +338,7 @@ REAL, DIMENSION(SIZE(PTA)) :: ZLW_NR_TO_WIN ! L.W. interactions snow(road)
!
REAL, DIMENSION(SIZE(PTA)) :: ZREC_SW_WIN ! solar received by windows [W m-2(win)]
REAL, DIMENSION(SIZE(PTA)) :: ZT_SKY ! sky temperature [K]
-REAL, DIMENSION(SIZE(PTA)) :: ZREC_LW_ROOF ! Incoming LW on roofs in presence of solar panels
+REAL, DIMENSION(SIZE(PTA)) :: ZREC_LW_RF ! Incoming LW on roofs in presence of solar panels
!
! local variable at previous time-step
!
@@ -677,57 +347,55 @@ REAL, DIMENSION(SIZE(PTA)) :: ZPET_B_COEF
REAL, DIMENSION(SIZE(PTA)) :: ZPEQ_A_COEF
REAL, DIMENSION(SIZE(PTA)) :: ZPEQ_B_COEF
!
-REAL, DIMENSION(SIZE(PTA)) :: ZUW_ROAD ! momentum flux for roads
-REAL, DIMENSION(SIZE(PTA)) :: ZUW_GARDEN ! momentum flux for green areas
-REAL, DIMENSION(SIZE(PTA)) :: ZUW_GREENROOF ! momentum flux for green roofs
-REAL, DIMENSION(SIZE(PTA)) :: ZDUWDU_ROAD !
+REAL, DIMENSION(SIZE(PTA)) :: ZUW_RD ! momentum flux for roads
+REAL, DIMENSION(SIZE(PTA)) :: ZUW_GD ! momentum flux for green areas
+REAL, DIMENSION(SIZE(PTA)) :: ZUW_GR ! momentum flux for green roofs
+REAL, DIMENSION(SIZE(PTA)) :: ZDUWDU_RD !
!
-REAL, DIMENSION(SIZE(PTA)) :: ZAC_AGG_GARDEN ! aggreg. aeodynamic resistance for green areas
-REAL, DIMENSION(SIZE(PTA)) :: ZHU_AGG_GARDEN ! aggreg. relative humidity for green areas
-REAL, DIMENSION(SIZE(PTA)) :: ZAC_AGG_GREENROOF ! aggreg. aeodynamic resistance for green roofs
-REAL, DIMENSION(SIZE(PTA)) :: ZHU_AGG_GREENROOF ! aggreg. relative humidity for green roofs
+REAL, DIMENSION(SIZE(PTA)) :: ZAC_AGG_GD ! aggreg. aeodynamic resistance for green areas
+REAL, DIMENSION(SIZE(PTA)) :: ZHU_AGG_GD ! aggreg. relative humidity for green areas
+REAL, DIMENSION(SIZE(PTA)) :: ZAC_AGG_GR ! aggreg. aeodynamic resistance for green roofs
+REAL, DIMENSION(SIZE(PTA)) :: ZHU_AGG_GR ! aggreg. relative humidity for green roofs
!
! surfaces relative fractions
!
-REAL, DIMENSION(SIZE(PTA)) :: ZROOF_FRAC ! roof, wall and
-REAL, DIMENSION(SIZE(PTA)) :: ZWALL_FRAC ! road fractions
-REAL, DIMENSION(SIZE(PTA)) :: ZROAD_FRAC ! of exchange surf.
-REAL, DIMENSION(SIZE(PTA)) :: ZGARDEN_FRAC !
-REAL, DIMENSION(SIZE(PTA)) :: ZTOTS_O_HORS ! total canyon+roof surface
-! ! over horizontal surface
-REAL, DIMENSION(SIZE(PTA)) :: ZWALL_O_ROAD ! wall surface over road surface
-REAL, DIMENSION(SIZE(PTA)) :: ZWALL_O_GRND ! wall surface over (road+green area) surface
+REAL, DIMENSION(SIZE(PTA)) :: ZRF_FRAC ! roof, wall and
+REAL, DIMENSION(SIZE(PTA)) :: ZWL_FRAC ! road fractions
+REAL, DIMENSION(SIZE(PTA)) :: ZRD_FRAC ! of exchange surf.
+REAL, DIMENSION(SIZE(PTA)) :: ZGD_FRAC !
+REAL, DIMENSION(SIZE(PTA)) :: ZTOTS_O_HORS ! total canyon+roof surface
+! ! over horizontal surface
+REAL, DIMENSION(SIZE(PTA)) :: ZWL_O_RD ! wall surface over road surface
+REAL, DIMENSION(SIZE(PTA)) :: ZWL_O_GRND ! wall surface over (road+green area) surface
!
! surface temperatures
!
-REAL, DIMENSION(SIZE(PTA)) :: ZTS_GARDEN ! surface temperature of urban green areas at t
-REAL, DIMENSION(SIZE(PTA)) :: ZTS_GREENROOF ! surface temperature of urban greenroofs at t
-REAL, DIMENSION(SIZE(PTA)) :: ZMTC_O_GR_R1 ! mean thermal conductivity over distance
-! ! between two layers (bottom GR & roof)
+REAL, DIMENSION(SIZE(PTA)) :: ZMTC_O_GR_R1 ! mean thermal conductivity over distance
+! ! between two layers (bottom GR & roof)
!
! fluxes from green surfaces
!
-REAL, DIMENSION(SIZE(PTA)) :: ZEVAP_GARDEN ! evaporation (kg/m2/s)
-REAL, DIMENSION(SIZE(PTA)) :: ZSFCO2_GARDEN ! CO2 fluxes (m/s*kg_CO2/kg_air)
-REAL, DIMENSION(SIZE(PTA)) :: ZEMIT_LW_GARDEN ! LW flux emitted by the garden (W/m2 garden)
-REAL, DIMENSION(SIZE(PTA)) :: ZEVAP_GREENROOF ! evaporation over greenroofs (kg/m2/s)
-REAL, DIMENSION(SIZE(PTA)) :: ZSFCO2_GREENROOF ! CO2 fluxes over greenroofs (m/s*kg_CO2/kg_air)
+REAL, DIMENSION(SIZE(PTA)) :: ZSFCO2_GD ! CO2 fluxes (m/s*kg_CO2/kg_air)
+REAL, DIMENSION(SIZE(PTA)) :: ZEMIT_LW_GD ! LW flux emitted by the garden (W/m2 garden)
+REAL, DIMENSION(SIZE(PTA)) :: ZSFCO2_GR ! CO2 fluxes over greenroofs (m/s*kg_CO2/kg_air)
!
! fluxes from built surfaces
-REAL, DIMENSION(SIZE(PTA)) :: ZEMIT_LW_ROAD ! LW flux emitted by the road (W/m2 road)
+REAL, DIMENSION(SIZE(PTA)) :: ZEMIT_LW_RD ! LW flux emitted by the road (W/m2 road)
!
! fluxes from/to solar panel
-REAL, DIMENSION(SIZE(PTA)) :: ZEMIT_LWDN_PANEL ! LW flux emitted DOWNWARDS by the solar panel (W/m2 panel)
-REAL, DIMENSION(SIZE(PTA)) :: ZEMIT_LWUP_PANEL ! LW flux emitted UPWARDS by the solar panel (W/m2 panel)
-REAL, DIMENSION(SIZE(PTA)) :: ZEMIT_LW_ROOF ! LW flux emitted UPWARDS by the roof (W/m2 roof )
+REAL, DIMENSION(SIZE(PTA)) :: ZEMIT_LWDN_PANEL ! LW flux emitted DOWNWARDS by the solar panel (W/m2 panel)
+REAL, DIMENSION(SIZE(PTA)) :: ZEMIT_LWUP_PANEL ! LW flux emitted UPWARDS by the solar panel (W/m2 panel)
+REAL, DIMENSION(SIZE(PTA)) :: ZEMIT_LW_RF ! LW flux emitted UPWARDS by the roof (W/m2 roof )
+!
+REAL, DIMENSION(SIZE(PTA)) :: ZRN_GD, ZH_GD, ZLE_GD, ZGFLUX_GD, ZEVAP_GD, ZTSRAD_GD, ZRUNOFF_GD
+REAL, DIMENSIOn(SIZE(PTA)) :: ZRN_GR, ZH_GR, ZLE_GR, ZGFLUX_GR
+REAL, DIMENSION(SIZE(PTA)) :: ZEVAP_GR, ZTSRAD_GR, ZRUNOFF_GR, ZDRAIN_GR
!
!new local variables for shading
REAL, DIMENSION(SIZE(PTA)) :: ZE_SHADING ! energy not ref., nor absorbed, nor
! trans. by glazing [Wm-2(win)]
LOGICAL, DIMENSION(SIZE(PTA)) :: GSHADE ! describes if one encounters the
! ! conditions to close windows
-!
-!
INTEGER :: JJ
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -740,6 +408,15 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! --------------------------
!
IF (LHOOK) CALL DR_HOOK('TEB_GARDEN',0,ZHOOK_HANDLE)
+!
+GDDK => GDM%VD%ND%AL(KTEB_P)
+GDDEK => GDM%VD%NDE%AL(KTEB_P)
+GDDMK => GDM%VD%NDM%AL(KTEB_P)
+!
+GRDK => GRM%VD%ND%AL(KTEB_P)
+GRDEK => GRM%VD%NDE%AL(KTEB_P)
+GRDMK => GRM%VD%NDM%AL(KTEB_P)
+!
ZDIR_SW(:) = 0.
ZSCA_SW(:) = 0.
!
@@ -754,23 +431,23 @@ END DO
!* 1.1 surfaces relative fractions
! ---------------------------
!
-DO JJ=1,SIZE(PROAD)
- IF (PROAD(JJ) .GT. 0.) THEN
- ZTOTS_O_HORS(JJ) = 1. + PWALL_O_HOR(JJ)
- ZROOF_FRAC(JJ) = PBLD(JJ) / ZTOTS_O_HORS(JJ)
- ZWALL_FRAC(JJ) = PWALL_O_HOR(JJ) / ZTOTS_O_HORS(JJ)
- ZROAD_FRAC(JJ) = PROAD(JJ) / ZTOTS_O_HORS(JJ)
- ZGARDEN_FRAC(JJ) = PGARDEN(JJ) / ZTOTS_O_HORS(JJ)
- ZWALL_O_ROAD(JJ) = ZWALL_FRAC(JJ) / ZROAD_FRAC(JJ)
- ZWALL_O_GRND(JJ) = ZWALL_FRAC(JJ) / (ZROAD_FRAC(JJ)+ZGARDEN_FRAC(JJ))
- ELSEIF (PBLD(JJ) .EQ. 0. .AND. PROAD(JJ) .EQ. 0.) THEN
- ZTOTS_O_HORS(JJ) = 1. + PWALL_O_HOR(JJ)
- ZROOF_FRAC(JJ) = 0.
- ZWALL_FRAC(JJ) = PWALL_O_HOR(JJ) / ZTOTS_O_HORS(JJ)
- ZROAD_FRAC(JJ) = 0.
- ZGARDEN_FRAC(JJ) = PGARDEN(JJ) / ZTOTS_O_HORS(JJ)
- ZWALL_O_ROAD(JJ) = 0.
- ZWALL_O_GRND(JJ) = ZWALL_FRAC(JJ) / ZGARDEN_FRAC(JJ)
+DO JJ=1,SIZE(T%XROAD)
+ IF (T%XROAD(JJ) .GT. 0.) THEN
+ ZTOTS_O_HORS(JJ) = 1. + T%XWALL_O_HOR(JJ)
+ ZRF_FRAC (JJ) = T%XBLD (JJ) / ZTOTS_O_HORS(JJ)
+ ZWL_FRAC (JJ) = T%XWALL_O_HOR(JJ) / ZTOTS_O_HORS(JJ)
+ ZRD_FRAC (JJ) = T%XROAD (JJ) / ZTOTS_O_HORS(JJ)
+ ZGD_FRAC (JJ) = T%XGARDEN (JJ) / ZTOTS_O_HORS(JJ)
+ ZWL_O_RD (JJ) = ZWL_FRAC (JJ) / ZRD_FRAC(JJ)
+ ZWL_O_GRND(JJ) = ZWL_FRAC (JJ) / (ZRD_FRAC(JJ)+ZGD_FRAC(JJ))
+ ELSEIF (T%XBLD(JJ) .EQ. 0. .AND. T%XROAD(JJ) .EQ. 0.) THEN
+ ZTOTS_O_HORS(JJ) = 1. + T%XWALL_O_HOR(JJ)
+ ZRF_FRAC (JJ) = 0.
+ ZWL_FRAC (JJ) = T%XWALL_O_HOR(JJ) / ZTOTS_O_HORS(JJ)
+ ZRD_FRAC (JJ) = 0.
+ ZGD_FRAC (JJ) = T%XGARDEN (JJ) / ZTOTS_O_HORS(JJ)
+ ZWL_O_RD (JJ) = 0.
+ ZWL_O_GRND(JJ) = ZWL_FRAC (JJ) / ZGD_FRAC(JJ)
ENDIF
ENDDO
!
@@ -781,35 +458,35 @@ ENDDO
!
!* 2.1 Snow-covered surfaces relative fractions (at previous time-step)
! ----------------------------------------
- CALL SNOW_FRAC_ROAD(PWSNOW_ROAD(:,1),PSR(:)>0.,ZDN_ROAD,ZDF_ROAD)
- CALL SNOW_FRAC_ROOF(PWSNOW_ROOF(:,1),PSR(:)>0.,ZDN_ROOF,ZDF_ROOF)
+ CALL SNOW_FRAC_ROAD(T%TSNOW_ROAD%WSNOW(:,1),PSR(:)>0.,ZDN_RD,ZDF_RD)
+ CALL SNOW_FRAC_ROOF(T%TSNOW_ROOF%WSNOW(:,1),PSR(:)>0.,ZDN_RF,ZDF_RF)
!
!* new snow albedo
!
-WHERE (PWSNOW_ROAD(:,1)==0. .AND. PSR(:)>0.) PASNOW_ROAD(:) = XANSMAX
-WHERE (PWSNOW_ROOF(:,1)==0. .AND. PSR(:)>0.) PASNOW_ROOF(:) = XANSMAX
+WHERE (T%TSNOW_ROAD%WSNOW(:,1)==0. .AND. PSR(:)>0.) T%TSNOW_ROAD%ALB(:) = XANSMAX
+WHERE (T%TSNOW_ROOF%WSNOW(:,1)==0. .AND. PSR(:)>0.) T%TSNOW_ROOF%ALB(:) = XANSMAX
!
!* 2.2 If snow was not present at previous time-step but is falling
! ------------------------------------------------------------
!
-WHERE (PWSNOW_ROAD(:,1)==0. .AND. PSR(:)>0.)
- PASNOW_ROAD(:) = XANSMAX
- PESNOW_ROAD(:) = XEMISSN
- PTSSNOW_ROAD(:)= MIN(PT_ROAD(:,1), XTT)
+WHERE (T%TSNOW_ROAD%WSNOW(:,1)==0. .AND. PSR(:)>0.)
+ T%TSNOW_ROAD%ALB (:) = XANSMAX
+ T%TSNOW_ROAD%EMIS(:) = XEMISSN
+ T%TSNOW_ROAD%TS (:) = MIN(T%XT_ROAD(:,1), XTT)
END WHERE
-WHERE (PWSNOW_ROOF(:,1)==0. .AND. PSR(:)>0.)
- PASNOW_ROOF(:) = XANSMAX
- PESNOW_ROOF(:) = XEMISSN
- PTSSNOW_ROOF(:)= MIN(PT_ROOF(:,1), XTT)
+WHERE (T%TSNOW_ROOF%WSNOW(:,1)==0. .AND. PSR(:)>0.)
+ T%TSNOW_ROOF%ALB (:) = XANSMAX
+ T%TSNOW_ROOF%EMIS(:) = XEMISSN
+ T%TSNOW_ROOF%TS (:) = MIN(T%XT_ROOF(:,1), XTT)
END WHERE
!
!* 2.3 Radiative snow variables at previous time-step
! ----------------------------------------------
!
-ZESNOW_ROOF (:) = PESNOW_ROOF (:)
-ZESNOW_ROAD (:) = PESNOW_ROAD (:)
-ZTSSNOW_ROOF (:) = PTSSNOW_ROOF (:)
-ZTSSNOW_ROAD (:) = PTSSNOW_ROAD (:)
+ZESN_RF (:) = T%TSNOW_ROOF%EMIS(:)
+ZESN_RD (:) = T%TSNOW_ROAD%EMIS(:)
+ZTSSN_RF (:) = T%TSNOW_ROOF%TS (:)
+ZTSSN_RD (:) = T%TSNOW_ROAD%TS (:)
!
!-------------------------------------------------------------------------------
!
@@ -817,43 +494,44 @@ ZTSSNOW_ROAD (:) = PTSSNOW_ROAD (:)
! --------------------------------------------------
!
ZTA(:) = PTA(:) * PEXNS(:) / PEXNA(:)
-ZQA(:) = PQA(:) * QSAT(PTA(:),PPS(:)) / QSAT(ZTA(:),PPA(:))
+ZQA(:) = PQA(:) * QSAT(ZTA(:),PPS(:)) / QSAT(PTA(:),PPA(:))
!
!-------------------------------------------------------------------------------
!
+
!* 4. Grid-averaged albedo and emissivity of green areas
! --------------------------------------------------
!
-ZALB_GARDEN = XUNDEF
-ZEMIS_GARDEN = XUNDEF
-ZTS_GARDEN = XUNDEF
-!
-IF (OGARDEN) THEN
- CALL GARDEN_PROPERTIES(TM%T, GDM, &
- PDIR_SW, PSCA_SW, PSW_BANDS, KSW, &
- ZTS_GARDEN, ZEMIS_GARDEN, ZALB_GARDEN, &
- PTA=PT_LOWCAN, &
- PALBNIR_TVEG=ZALBNIR_TVEG_GARDEN, &
- PALBVIS_TVEG=ZALBVIS_TVEG_GARDEN, &
- PALBNIR_TSOIL=ZALBNIR_TSOIL_GARDEN, &
- PALBVIS_TSOIL=ZALBVIS_TSOIL_GARDEN )
+ZALB_GD = XUNDEF
+ZEMIS_GD = XUNDEF
+ZTSRAD_GD = XUNDEF
+!
+IF (TOP%LGARDEN) THEN
+ CALL TEB_VEG_PROPERTIES(T%XGARDEN, GDM%O, GDM%NPE%AL(KTEB_P), &
+ PDIR_SW, PSCA_SW, PSW_BANDS, KSW, &
+ ZTSRAD_GD, ZEMIS_GD, ZALB_GD, &
+ PTA=PT_LOWCAN, &
+ PALBNIR_TVEG=ZALBNIR_TVEG_GD, &
+ PALBVIS_TVEG=ZALBVIS_TVEG_GD, &
+ PALBNIR_TSOIL=ZALBNIR_TSOIL_GD, &
+ PALBVIS_TSOIL=ZALBVIS_TSOIL_GD )
ENDIF
!
! for greenroofs :
!
-ZALB_GREENROOF = XUNDEF
-ZEMIS_GREENROOF = XUNDEF
-ZTS_GREENROOF = XUNDEF
-!
-IF (OGREENROOF) THEN
- CALL GREENROOF_PROPERTIES(TM%T, GDM%TVG, GRM, &
- PDIR_SW, PSCA_SW, PSW_BANDS, KSW, &
- ZTS_GREENROOF, ZEMIS_GREENROOF, &
- ZALB_GREENROOF, PTA=PTA, &
- PALBNIR_TVEG=ZALBNIR_TVEG_GREENROOF, &
- PALBVIS_TVEG=ZALBVIS_TVEG_GREENROOF, &
- PALBNIR_TSOIL=ZALBNIR_TSOIL_GREENROOF, &
- PALBVIS_TSOIL=ZALBVIS_TSOIL_GREENROOF )
+ZALB_GR = XUNDEF
+ZEMIS_GR = XUNDEF
+ZTSRAD_GR = XUNDEF
+!
+IF (TOP%LGREENROOF) THEN
+ CALL TEB_VEG_PROPERTIES(T%XGREENROOF, GRM%O, GRM%NPE%AL(KTEB_P), &
+ PDIR_SW, PSCA_SW, PSW_BANDS, KSW, &
+ ZTSRAD_GR, ZEMIS_GR, ZALB_GR, &
+ PTA=PTA, &
+ PALBNIR_TVEG=ZALBNIR_TVEG_GR, &
+ PALBVIS_TVEG=ZALBVIS_TVEG_GR, &
+ PALBNIR_TSOIL=ZALBNIR_TSOIL_GR, &
+ PALBVIS_TSOIL=ZALBVIS_TSOIL_GR )
ENDIF
!
!-------------------------------------------------------------------------------
@@ -863,10 +541,8 @@ ENDIF
!
!* when building in unoccupied, target temperature is modified
!
-IF (HBEM=="BEM") THEN
- CALL BLD_OCC_CALENDAR(TPTIME%TDATE%YEAR,TPTIME%TDATE%MONTH,TPTIME%TDATE%DAY,PTSUN, &
- PRESIDENTIAL,PTCOOL_TARGET, PTHEAT_TARGET, PQIN, &
- PDT_RES,PDT_OFF,1.,PCUR_TCOOL_TARGET, PCUR_THEAT_TARGET, PCUR_QIN )
+IF (TOP%CBEM=="BEM") THEN
+ CALL BLD_OCC_CALENDAR(TOP%TTIME, PTSUN, T, B, 1., DMT%XTCOOL_TARGET, DMT%XTHEAT_TARGET, DMT%XQIN )
ENDIF
!
!-------------------------------------------------------------------------------
@@ -882,66 +558,43 @@ ENDIF
! (needs to be equiped of solar protections and not to be confortable inside)
!
GSHADE(:) = .FALSE.
-IF (HBEM=="BEM") THEN
- CALL WINDOW_SHADING_AVAILABILITY(OSHADE, PTI_BLD, PCUR_TCOOL_TARGET,GSHADE)
+IF (TOP%CBEM=="BEM") THEN
+ CALL WINDOW_SHADING_AVAILABILITY(B%LSHADE, B%XTI_BLD, DMT%XTCOOL_TARGET, GSHADE)
!
!* Reinitialize shading of windows when changing day
!
- WHERE (PTSUN .LT. PTSTEP + 1E-3) OSHAD_DAY(:) = .FALSE.
+ WHERE (PTSUN .LT. PTSTEP + 1E-3) B%LSHAD_DAY(:) = .FALSE.
END IF
!
!
!* 5.2 computes solar radiation exchanges
! ----------------------------------
!
- CALL URBAN_SOLAR_ABS(HBEM, HROAD_DIR, HWALL_OPT, &
- ZDIR_SW, ZSCA_SW, PZENITH, PAZIM, &
- PBLD, PGARDEN, PROAD_DIR, PROAD, PFRAC_GR, &
- PWALL_O_HOR, PCAN_HW_RATIO, &
- PALB_ROOF, &
- PALB_ROAD, PSVF_ROAD, PALB_WALL, PSVF_WALL, &
- PFRAC_PANEL, PALB_PANEL, &
- ZALB_GARDEN, PSVF_GARDEN, &
- ZALB_GREENROOF, &
- PASNOW_ROOF, PASNOW_ROAD, &
- ZDN_ROOF, ZDF_ROOF, ZDN_ROAD, ZDF_ROAD, &
- PGR, PABS_WIN, PSHGC, PSHGC_SH, PALB_WIN, &
- PABS_SW_ROOF, PABS_SW_ROAD, &
- PABS_SW_WALL_A, PABS_SW_WALL_B, &
- PABS_SW_GARDEN, PABS_SW_GREENROOF, &
- PABS_SW_SNOW_ROOF, PABS_SW_SNOW_ROAD, &
- PABS_SW_PANEL, &
- ZREC_SW_ROAD, ZREC_SW_SNOW_ROAD, &
- ZREC_SW_WALL_A, ZREC_SW_WALL_B, &
- ZREC_SW_GARDEN, ZREC_SW_ROOF, &
- PDIR_ALB_TOWN,PSCA_ALB_TOWN, &
- ZSW_RAD_GARDEN, PABS_SW_WIN, ZREC_SW_WIN, &
- PTRAN_WIN, &
- PREF_SW_GRND, PREF_SW_FAC, &
- PTR_SW_WIN, ZE_SHADING, OSHAD_DAY, &
- GSHADE )
+ CALL URBAN_SOLAR_ABS(TOP, T, B, DMT, ZDIR_SW, ZSCA_SW, PZENITH, PAZIM, &
+ TPN%XFRAC_PANEL, TPN%XALB_PANEL, ZALB_GD, &
+ T%XSVF_GARDEN, ZALB_GR, ZDN_RF, ZDF_RF, &
+ ZDN_RD, ZDF_RD, ZREC_SW_RD, ZREC_SW_SN_RD, &
+ ZREC_SW_WL_A, ZREC_SW_WL_B, ZREC_SW_GD, &
+ ZREC_SW_RF, PDIR_ALB_TWN, PSCA_ALB_TWN, &
+ ZSW_RAD_GD, ZREC_SW_WIN,PREF_SW_GRND, &
+ PREF_SW_FAC, ZE_SHADING, B%LSHAD_DAY, GSHADE )
!
!-------------------------------------------------------------------------------
!
!* 6. LW properties
! -------------
!
- CALL URBAN_LW_COEF(PGR, PBLD, PLW_RAD, &
- PEMIS_ROAD, PSVF_ROAD, PEMIS_WALL, PSVF_WALL, &
- ZEMIS_GARDEN, PROAD, PGARDEN, &
- PESNOW_ROAD, &
- PTSSNOW_ROAD, PT_WALL_A(:,1), PT_WALL_B(:,1), &
- PT_ROAD(:,1), ZTS_GARDEN, PT_WIN1, &
+ CALL URBAN_LW_COEF(B, T, PLW_RAD, ZEMIS_GD, T%TSNOW_ROAD%TS, ZTSRAD_GD, &
ZLW_WA_TO_WB, ZLW_WA_TO_R, ZLW_WB_TO_R, &
- ZLW_WA_TO_NR, ZLW_WB_TO_NR,ZLW_WA_TO_G,ZLW_WB_TO_G,&
- ZLW_WA_TO_WIN, ZLW_WB_TO_WIN, &
+ ZLW_WA_TO_NR, ZLW_WB_TO_NR, ZLW_WA_TO_G, &
+ ZLW_WB_TO_G, ZLW_WA_TO_WIN, ZLW_WB_TO_WIN, &
ZLW_R_TO_WA, ZLW_R_TO_WB, ZLW_R_TO_WIN, &
ZLW_G_TO_WA, ZLW_G_TO_WB, ZLW_G_TO_WIN, &
ZLW_S_TO_WA, ZLW_S_TO_WB, ZLW_S_TO_R, &
ZLW_S_TO_NR, ZLW_S_TO_G,ZLW_S_TO_WIN, &
- ZLW_WIN_TO_WA, ZLW_WIN_TO_WB, &
- ZLW_WIN_TO_R, ZLW_WIN_TO_NR, ZLW_WIN_TO_G, &
- ZLW_NR_TO_WA, ZLW_NR_TO_WB, ZLW_NR_TO_WIN )
+ ZLW_WIN_TO_WA, ZLW_WIN_TO_WB, ZLW_WIN_TO_R, &
+ ZLW_WIN_TO_NR, ZLW_WIN_TO_G, ZLW_NR_TO_WA, &
+ ZLW_NR_TO_WB, ZLW_NR_TO_WIN )
!
!-------------------------------------------------------------------------------
!
@@ -951,7 +604,7 @@ END IF
!
IF (LHOOK) CALL DR_HOOK('TEB_GARDEN',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
!-------------------------------------------------------------------------------
SUBROUTINE TEB_GARDEN2
!
@@ -961,21 +614,21 @@ SUBROUTINE TEB_GARDEN2
!* 7.1 IR rad received by gardens (snow free and snow covered separately)
! --------------------------
!
-IF (OGARDEN) THEN
+IF (TOP%LGARDEN) THEN
ZT_SKY (:) = (PLW_RAD(:)/XSTEFAN)**0.25
- ZREC_LW_GARDEN(:) = (ZLW_S_TO_G (:) * (ZT_SKY(:) - ZTS_GARDEN(:)) &
- + ZLW_WA_TO_G (:) * (PT_WALL_A(:,1)- ZTS_GARDEN(:)) &
- + ZLW_WB_TO_G (:) * (PT_WALL_B(:,1)- ZTS_GARDEN(:)) &
- + ZLW_WIN_TO_G(:) * (PT_WIN1(:) - ZTS_GARDEN(:)) ) &
- / ZEMIS_GARDEN(:) + XSTEFAN * ZTS_GARDEN(:)**4
+ ZREC_LW_GD(:) = (ZLW_S_TO_G (:) * (ZT_SKY(:) - ZTSRAD_GD(:)) &
+ + ZLW_WA_TO_G (:) * (T%XT_WALL_A(:,1)- ZTSRAD_GD(:)) &
+ + ZLW_WB_TO_G (:) * (T%XT_WALL_B(:,1)- ZTSRAD_GD(:)) &
+ + ZLW_WIN_TO_G(:) * (B%XT_WIN1(:) - ZTSRAD_GD(:)) ) &
+ / ZEMIS_GD(:) + XSTEFAN * ZTSRAD_GD(:)**4
ELSE
- ZREC_LW_GARDEN (:) = XUNDEF
+ ZREC_LW_GD (:) = XUNDEF
END IF
!
!* 7.2 Effect of solar panels on incoming LW on roofs
! ----------------------------------------------
!
-IF (OSOLAR_PANEL) THEN
+IF (TOP%LSOLAR_PANEL) THEN
!
! solar panels downwards surface is supposed to be at air temperature
! and to be have an emissivity of 1.
@@ -984,11 +637,10 @@ IF (OSOLAR_PANEL) THEN
!
! note that, for the time being, one considers that the solar panel
! intercept radiation both above roof and greenroofs (if any)
- ZREC_LW_ROOF = (1.-PFRAC_PANEL(:)) * PLW_RAD &
- + PFRAC_PANEL(:) * ZEMIT_LWDN_PANEL
+ ZREC_LW_RF = (1.-TPN%XFRAC_PANEL(:)) * PLW_RAD + TPN%XFRAC_PANEL(:) * ZEMIT_LWDN_PANEL
ELSE
ZEMIT_LWDN_PANEL = XUNDEF
- ZREC_LW_ROOF = PLW_RAD
+ ZREC_LW_RF = PLW_RAD
END IF
!
!-------------------------------------------------------------------------------
@@ -1010,100 +662,95 @@ ZPEQ_B_COEF(:) = PQ_LOWCAN(:)
!* 8.2 Call ISBA for green areas
! -------------------------
!
-IF (OGARDEN) THEN
-!
- CALL GARDEN(DTCO, DTI, IG, I, TM%TG, TM%T, TM%TOP, GRM%DTGR, GRM%TGRO, GDM, &
- HIMPLICIT_WIND, TPTIME, PTSUN, PPEW_A_COEF_LOWCAN, PPEW_B_COEF_LOWCAN, &
- ZPET_A_COEF, ZPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF, &
- PTSTEP, PZ_LOWCAN, &
- PT_LOWCAN, PQ_LOWCAN, PEXNS, PRHOA, PCO2, PPS, PRR, PSR, PZENITH, &
- ZREC_SW_GARDEN, ZREC_LW_GARDEN, PU_LOWCAN, &
- ZALBNIR_TVEG_GARDEN, ZALBVIS_TVEG_GARDEN, &
- ZALBNIR_TSOIL_GARDEN, ZALBVIS_TSOIL_GARDEN, &
- PRN_GARDEN,PH_GARDEN,PLE_GARDEN,PGFLUX_GARDEN, ZSFCO2_GARDEN, &
- ZEVAP_GARDEN, ZUW_GARDEN,PRUNOFF_GARDEN, &
- PAC_GARDEN,ZQSAT_GARDEN,ZTS_GARDEN, &
- ZAC_AGG_GARDEN, ZHU_AGG_GARDEN, &
- PDRAIN_GARDEN, PIRRIG_GARDEN )
+IF (TOP%LGARDEN) THEN
+!
+ CALL GARDEN(DTCO, G, T, TOP, TIR, GDM%DTV, GDM%GB, GDDK, GDDEK, GDDMK, &
+ GDM%O, GDM%S, GDM%K, GDM%P, GDM%NPE%AL(KTEB_P), &
+ HIMPLICIT_WIND, TOP%TTIME, PTSUN, PPEW_A_COEF_LOWCAN, PPEW_B_COEF_LOWCAN, &
+ ZPET_A_COEF, ZPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF, PTSTEP, PZ_LOWCAN, &
+ PT_LOWCAN, PQ_LOWCAN, PEXNS, PRHOA, PCO2, PPS, PRR, PSR, PZENITH, &
+ ZREC_SW_GD, ZREC_LW_GD, PU_LOWCAN, ZALBNIR_TVEG_GD, ZALBVIS_TVEG_GD, &
+ ZALBNIR_TSOIL_GD, ZALBVIS_TSOIL_GD, ZRN_GD, ZH_GD, ZLE_GD, ZGFLUX_GD, &
+ ZSFCO2_GD, ZEVAP_GD, ZUW_GD, ZRUNOFF_GD, PAC_GD, ZQSAT_GD, ZTSRAD_GD, &
+ ZAC_AGG_GD, ZHU_AGG_GD, DMT%XIRRIG_GARDEN )
- PAC_GARDEN_WAT(:) = PAC_GARDEN(:)
- PABS_SW_GARDEN(:) = (1.-ZALB_GARDEN(:)) * ZREC_SW_GARDEN
- PABS_LW_GARDEN(:) = ZEMIS_GARDEN(:) * ZREC_LW_GARDEN(:) - &
- XSTEFAN * ZEMIS_GARDEN(:) * ZTS_GARDEN(:)**4
- ZEMIT_LW_GARDEN(:) = XSTEFAN * ZTS_GARDEN(:)**4 + &
- (1 - ZEMIS_GARDEN(:)) / ZEMIS_GARDEN(:) * PABS_LW_GARDEN(:)
+ PAC_GD_WAT(:) = PAC_GD(:)
+ DMT%XABS_SW_GARDEN(:) = (1.-ZALB_GD(:)) * ZREC_SW_GD
+ DMT%XABS_LW_GARDEN(:) = ZEMIS_GD(:) * ZREC_LW_GD(:) - XSTEFAN * ZEMIS_GD(:) * ZTSRAD_GD(:)**4
+ ZEMIT_LW_GD(:) = XSTEFAN * ZTSRAD_GD(:)**4 + (1 - ZEMIS_GD(:)) / ZEMIS_GD(:) * DMT%XABS_LW_GARDEN(:)
ELSE
-!
- PRN_GARDEN (:) = 0.
- PH_GARDEN (:) = 0.
- PLE_GARDEN (:) = 0.
- PGFLUX_GARDEN (:) = 0.
- ZUW_GARDEN (:) = 0.
- PAC_GARDEN (:) = 0.
- PGFLUX_GARDEN (:) = 0.
- ZEVAP_GARDEN (:) = 0.
- ZSFCO2_GARDEN (:) = 0.
- ZQSAT_GARDEN (:) = XUNDEF
- ZTS_GARDEN (:) = XUNDEF
- ZAC_AGG_GARDEN (:) = XUNDEF
- ZHU_AGG_GARDEN (:) = XUNDEF
- PAC_GARDEN_WAT (:) = XUNDEF
- PABS_SW_GARDEN (:) = XUNDEF
- PABS_LW_GARDEN (:) = XUNDEF
- ZEMIT_LW_GARDEN(:) = 0.
- PRUNOFF_GARDEN (:) = 0.
- PDRAIN_GARDEN (:) = 0.
- PIRRIG_GARDEN (:) = 0.
-!
+ !
+ ZRN_GD (:) = 0.
+ ZH_GD (:) = 0.
+ ZLE_GD (:) = 0.
+ ZGFLUX_GD (:) = 0.
+ ZEVAP_GD (:) = 0.
+ ZRUNOFF_GD(:) = 0.
+ !
+ ZTSRAD_GD (:) = XUNDEF
+ !
+ ZUW_GD (:) = 0.
+ PAC_GD (:) = 0.
+ ZSFCO2_GD (:) = 0.
+ ZQSAT_GD (:) = XUNDEF
+ ZAC_AGG_GD (:) = XUNDEF
+ ZHU_AGG_GD (:) = XUNDEF
+ PAC_GD_WAT (:) = XUNDEF
+ ZEMIT_LW_GD(:) = 0.
+ !
+ DMT%XABS_SW_GARDEN (:) = XUNDEF
+ DMT%XABS_LW_GARDEN (:) = XUNDEF
+ !
+ DMT%XIRRIG_GARDEN (:) = 0.
+ !
ENDIF
!
!* 8.3 Call ISBA for greenroofs
! -------------------------
!
-IF (OGREENROOF) THEN
-!
+IF (TOP%LGREENROOF) THEN
+ !
+ CALL GREENROOF(DTCO, G, T, TOP, TIR, GRM%DTV, GRM%GB, GRDK, GRDEK, &
+ GRDMK, GRM%O, GRM%S, GRM%K, GRM%P, GRM%NPE%AL(KTEB_P), &
+ HIMPLICIT_WIND, TOP%TTIME, PTSUN, PPEW_A_COEF, PPEW_B_COEF, &
+ ZPET_A_COEF, ZPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF, PTSTEP, PZREF, &
+ PUREF, PTA, PQA, PEXNS, PEXNA,PRHOA, PCO2, PPS, PRR, PSR, PZENITH, &
+ ZREC_SW_RF, ZREC_LW_RF, PVMOD,ZALBNIR_TVEG_GR, ZALBVIS_TVEG_GR, &
+ ZALBNIR_TSOIL_GR, ZALBVIS_TSOIL_GR, ZRN_GR, ZH_GR, ZLE_GR, &
+ ZGFLUX_GR, ZSFCO2_GR, ZEVAP_GR, ZUW_GR, ZRUNOFF_GR, ZDRAIN_GR, &
+ PAC_GR, ZQSAT_GR, ZTSRAD_GR, ZAC_AGG_GR, ZHU_AGG_GR, &
+ DMT%XG_GREENROOF_ROOF, DMT%XIRRIG_GREENROOF )
!
- CALL GREENROOF(DTCO, DTI, IG, I, TM%TG, TM%T, TM%TOP, GDM%TVG, GDM%DTGD, GDM%TIR, GRM, &
- HIMPLICIT_WIND, TPTIME, PTSUN, PPEW_A_COEF, PPEW_B_COEF, &
- ZPET_A_COEF, ZPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF, &
- PTSTEP, PZREF, PUREF, &
- PTA, PQA, PEXNS, PEXNA,PRHOA, PCO2, PPS, PRR, PSR, PZENITH, &
- ZREC_SW_ROOF, ZREC_LW_ROOF, PVMOD, &
- ZALBNIR_TVEG_GREENROOF, ZALBVIS_TVEG_GREENROOF, &
- ZALBNIR_TSOIL_GREENROOF, ZALBVIS_TSOIL_GREENROOF, &
- PRN_GREENROOF,PH_GREENROOF,PLE_GREENROOF,PGFLUX_GREENROOF, &
- ZSFCO2_GREENROOF,ZEVAP_GREENROOF, ZUW_GREENROOF, &
- PAC_GREENROOF,ZQSAT_GREENROOF,ZTS_GREENROOF, &
- ZAC_AGG_GREENROOF, ZHU_AGG_GREENROOF,PG_GREENROOF_ROOF, &
- PRUNOFF_GREENROOF, PDRAIN_GREENROOF, PIRRIG_GREENROOF )
-!
- PAC_GREENROOF_WAT(:) = PAC_GREENROOF(:)
- PABS_SW_GREENROOF(:) = (1.-ZALB_GREENROOF(:)) * ZREC_SW_ROOF
- PABS_LW_GREENROOF(:) = ZEMIS_GREENROOF * ZREC_LW_ROOF - XSTEFAN * ZEMIS_GREENROOF * ZTS_GREENROOF**4
+ PAC_GR_WAT(:) = PAC_GR(:)
+ DMT%XABS_SW_GREENROOF(:) = (1.-ZALB_GR(:)) * ZREC_SW_RF
+ DMT%XABS_LW_GREENROOF(:) = ZEMIS_GR * ZREC_LW_RF - XSTEFAN * ZEMIS_GR * ZTSRAD_GR**4
ELSE
-!
- PRN_GREENROOF (:) = 0.
- PH_GREENROOF (:) = 0.
- PLE_GREENROOF (:) = 0.
- PGFLUX_GREENROOF (:) = 0.
- ZUW_GREENROOF (:) = 0.
- PAC_GREENROOF (:) = 0.
- ZEVAP_GREENROOF (:) = 0.
- ZSFCO2_GREENROOF (:) = 0.
- PRUNOFF_GREENROOF(:) = 0.
- PDRAIN_GREENROOF (:) = 0.
- PIRRIG_GREENROOF (:) = 0.
- ZQSAT_GREENROOF (:) = XUNDEF
- ZTS_GREENROOF (:) = XUNDEF
- ZAC_AGG_GREENROOF(:) = XUNDEF
- ZHU_AGG_GREENROOF(:) = XUNDEF
- PABS_SW_GREENROOF(:) = XUNDEF
- PABS_LW_GREENROOF(:) = XUNDEF
- ZMTC_O_GR_R1 (:) = XUNDEF
- PG_GREENROOF_ROOF(:) = XUNDEF
-!
+ !
+ ZRN_GR (:) = 0.
+ ZH_GR (:) = 0.
+ ZLE_GR (:) = 0.
+ ZGFLUX_GR (:) = 0.
+ ZEVAP_GR (:) = 0.
+ ZRUNOFF_GR(:) = 0.
+ ZDRAIN_GR (:) = 0.
+ !
+ ZTSRAD_GR (:) = XUNDEF
+ !
+ ZUW_GR (:) = 0.
+ PAC_GR (:) = 0.
+ ZSFCO2_GR (:) = 0.
+ ZQSAT_GR (:) = XUNDEF
+ ZAC_AGG_GR(:) = XUNDEF
+ ZHU_AGG_GR(:) = XUNDEF
+ ZMTC_O_GR_R1(:) = XUNDEF
+ !
+ DMT%XIRRIG_GREENROOF (:) = 0.
+ DMT%XABS_SW_GREENROOF(:) = XUNDEF
+ DMT%XABS_LW_GREENROOF(:) = XUNDEF
+ DMT%XG_GREENROOF_ROOF(:) = XUNDEF
+ !
ENDIF
END SUBROUTINE TEB_GARDEN2
@@ -1113,195 +760,73 @@ SUBROUTINE TEB_GARDEN3
!* 9. Treatment of built covers
! -------------------------
!
- CALL TEB (HZ0H, HIMPLICIT_WIND, HWALL_OPT, HBEM, TPTIME, PTSUN, &
- PT_CANYON, PQ_CANYON, PU_CANYON, &
- PT_LOWCAN, PQ_LOWCAN, PU_LOWCAN, PZ_LOWCAN, &
- PTI_BLD, &
- PT_ROOF, PT_ROAD, PT_WALL_A, PT_WALL_B, &
- PWS_ROOF, PWS_ROAD, &
- HSNOW_ROOF, &
- PWSNOW_ROOF, PTSNOW_ROOF, PRSNOW_ROOF, PASNOW_ROOF, &
- PTSSNOW_ROOF, PESNOW_ROOF, &
- HSNOW_ROAD, &
- PWSNOW_ROAD, PTSNOW_ROAD, PRSNOW_ROAD, PASNOW_ROAD, &
- PTSSNOW_ROAD, PESNOW_ROAD, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPEW_A_COEF_LOWCAN, PPEW_B_COEF_LOWCAN, &
- PPS, PPA, PEXNS, PEXNA, &
- PTA, PQA, PRHOA, &
- PLW_RAD, &
- PRR, PSR, &
- PZREF, PUREF, PVMOD, &
- PH_TRAFFIC, PLE_TRAFFIC, PH_INDUSTRY, PLE_INDUSTRY, &
- PTSTEP, &
- PZ0_TOWN, &
- PBLD, PGARDEN, PROAD, PFRAC_GR, &
- PBLD_HEIGHT, PWALL_O_HOR, PCAN_HW_RATIO, PWALL_O_GRND, &
- ZDF_ROOF, ZDN_ROOF, ZDF_ROAD, ZDN_ROAD, &
- ZQSAT_ROOF, ZQSAT_ROAD, ZDELT_ROOF, ZDELT_ROAD, &
- PEMIS_ROOF, &
- PHC_ROOF,PTC_ROOF,PD_ROOF, &
- PEMIS_ROAD, &
- PHC_ROAD,PTC_ROAD,PD_ROAD, &
- PEMIS_WALL, &
- ZTS_GARDEN, &
- PHC_WALL,PTC_WALL,PD_WALL, &
- PRN_ROOF, PH_ROOF, PLE_ROOF, PLEW_ROOF, PGFLUX_ROOF, &
- PRUNOFF_ROOF, &
- PRN_GREENROOF, PH_GREENROOF, PLE_GREENROOF, &
- PGFLUX_GREENROOF, ZUW_GREENROOF, &
- PRUNOFF_GREENROOF, PDRAIN_GREENROOF, &
- PRN_STRLROOF, PH_STRLROOF, PLE_STRLROOF, PGFLUX_STRLROOF,&
- PRUNOFF_STRLROOF, &
- PRN_ROAD, PH_ROAD, PLE_ROAD, PLEW_ROAD, PGFLUX_ROAD, &
- PRUNOFF_ROAD, &
- PRN_WALL_A, PH_WALL_A, PLE_WALL_A, PGFLUX_WALL_A, &
- PRN_WALL_B, PH_WALL_B, PLE_WALL_B, PGFLUX_WALL_B, &
- PRN_BLT,PH_BLT,PLE_BLT,PGFLUX_BLT, &
- PRNSNOW_ROOF, PHSNOW_ROOF, PLESNOW_ROOF, PGSNOW_ROOF, &
- PMELT_ROOF, &
- PRNSNOW_ROAD, PHSNOW_ROAD, PLESNOW_ROAD, PGSNOW_ROAD, &
- PMELT_ROAD, &
- PG_GREENROOF_ROOF, &
- ZUW_ROAD, PUW_ROOF, ZDUWDU_ROAD, PDUWDU_ROOF, &
- PUSTAR_TOWN, PCD, PCDN, PCH_TOWN, PRI_TOWN, &
- PRESA_TOWN, PDQS_TOWN, PQF_TOWN, PQF_BLD, PFLX_BLD, &
- ZAC_ROOF, PAC_ROAD, ZAC_WALL, ZAC_TOP, PAC_GARDEN, &
- ZAC_ROOF_WAT, PAC_ROAD_WAT, &
- PABS_SW_ROOF, PABS_LW_ROOF, &
- PABS_SW_SNOW_ROOF, PABS_LW_SNOW_ROOF, &
- PABS_SW_ROAD, PABS_LW_ROAD, &
- PABS_SW_SNOW_ROAD, PABS_LW_SNOW_ROAD, &
- PABS_SW_WALL_A, PABS_LW_WALL_A, &
- PABS_SW_WALL_B, PABS_LW_WALL_B, &
- ZLW_WA_TO_WB, &
- ZLW_WA_TO_R, ZLW_WB_TO_R, &
- ZLW_WA_TO_NR, ZLW_WB_TO_NR, &
- ZLW_R_TO_WA, ZLW_R_TO_WB, &
- ZLW_G_TO_WA, ZLW_G_TO_WB, &
- ZLW_S_TO_WA, ZLW_S_TO_WB, ZLW_S_TO_R, &
- ZLW_S_TO_NR, ZLW_NR_TO_WA, ZLW_NR_TO_WB, &
- ZLW_NR_TO_WIN, ZLW_WA_TO_WIN, ZLW_WB_TO_WIN, &
- ZLW_G_TO_WIN, &
- ZLW_R_TO_WIN, ZLW_S_TO_WIN, ZLW_WIN_TO_WA, ZLW_WIN_TO_WB,&
- ZLW_WIN_TO_R, ZLW_WIN_TO_NR, &
- HNATVENT, &
- HCOOL_COIL, PF_WATER_COND, HHEAT_COIL, &
- .FALSE., KDAY, PAUX_MAX, PT_FLOOR, &
- PT_MASS, PH_BLD_COOL, PT_BLD_COOL, &
- PH_BLD_HEAT, PLE_BLD_COOL, PLE_BLD_HEAT, &
- PH_WASTE, PLE_WASTE, PF_WASTE_CAN, PHVAC_COOL, &
- PHVAC_HEAT, PCUR_QIN, PQIN_FRAD, PQIN_FLAT, &
- PGR, PEFF_HEAT, PINF, PCUR_TCOOL_TARGET, &
- PCUR_THEAT_TARGET, PHR_TARGET, PT_WIN2, PQI_BLD, &
- PV_VENT, PCAP_SYS_HEAT, PCAP_SYS_RAT, PT_ADP, &
- PM_SYS_RAT, PCOP_RAT, PCAP_SYS, PM_SYS, PCOP, &
- PQ_SYS, PT_SYS, PTR_SW_WIN, PFAN_POWER, PHC_FLOOR, &
- PTC_FLOOR, PD_FLOOR, PT_WIN1, PABS_SW_WIN, PABS_LW_WIN, &
- PUGG_WIN, PEMIT_LW_FAC, ZEMIT_LW_ROAD, PT_RAD_IND, &
- PHU_BLD, PTIME, ZE_SHADING, ONATVENT_NIGHT, &
- PN_FLOOR, PWALL_O_BLD, PGLAZ_O_BLD, &
- PMASS_O_BLD, PFLOOR_HW_RATIO, &
- PF_FLOOR_MASS, PF_FLOOR_WALL, PF_FLOOR_WIN, &
- PF_FLOOR_ROOF, PF_WALL_FLOOR, PF_WALL_MASS, PF_WALL_WIN, &
- PF_WIN_FLOOR, PF_WIN_MASS, PF_WIN_WALL, PF_MASS_FLOOR, &
- PF_MASS_WALL, PF_MASS_WIN, OCANOPY, &
- HCH_BEM, PROUGH_ROOF, PROUGH_WALL, PF_WIN_WIN, &
- OPAR_RD_IRRIG, PRD_START_MONTH, PRD_END_MONTH, &
- PRD_START_HOUR, PRD_END_HOUR, PRD_24H_IRRIG, PIRRIG_ROAD )
+ CALL TEB (TOP, T, BOP, B, TIR, DMT, HIMPLICIT_WIND, &
+ PTSUN, PT_CAN, PQ_CAN, PU_CAN, PT_LOWCAN, PQ_LOWCAN, PU_LOWCAN, &
+ PZ_LOWCAN, PPEW_A_COEF, PPEW_B_COEF, PPEW_A_COEF_LOWCAN, &
+ PPEW_B_COEF_LOWCAN, PPS, PPA, PEXNS, PEXNA, PTA, PQA, PRHOA, PLW_RAD, &
+ PRR, PSR, PZREF, PUREF, PVMOD, PH_TRAFFIC, PLE_TRAFFIC, PTSTEP, &
+ ZDF_RF, ZDN_RF, ZDF_RD, ZDN_RD, ZQSAT_RF, ZQSAT_RD, ZDELT_RF, &
+ ZDELT_RD, ZTSRAD_GD, PLEW_RF, ZUW_GR, PLEW_RD, PLE_WL_A, &
+ PLE_WL_B, PRNSN_RF, PHSN_RF, PLESN_RF, PGSN_RF, PMELT_RF, &
+ ZRN_GR, ZH_GR, ZLE_GR, ZGFLUX_GR, ZDRAIN_GR, ZRUNOFF_GR, &
+ PRNSN_RD, PHSN_RD, PLESN_RD, PGSN_RD, PMELT_RD, ZUW_RD, PUW_RF, &
+ ZDUWDU_RD, PDUWDU_RF, PUSTAR_TWN, PCD, PCDN, PCH_TWN, PRI_TWN, PRESA_TWN, &
+ ZAC_RF, PAC_RD, ZAC_WL, ZAC_TOP, PAC_GD, ZAC_RF_WAT, PAC_RD_WAT, &
+ ZLW_WA_TO_WB, ZLW_WA_TO_R, ZLW_WB_TO_R, ZLW_WA_TO_NR, ZLW_WB_TO_NR, &
+ ZLW_R_TO_WA, ZLW_R_TO_WB, ZLW_G_TO_WA, ZLW_G_TO_WB, ZLW_S_TO_WA, &
+ ZLW_S_TO_WB, ZLW_S_TO_R, ZLW_S_TO_NR, ZLW_NR_TO_WA, ZLW_NR_TO_WB, &
+ ZLW_NR_TO_WIN, ZLW_WA_TO_WIN, ZLW_WB_TO_WIN, ZLW_G_TO_WIN, &
+ ZLW_R_TO_WIN, ZLW_S_TO_WIN, ZLW_WIN_TO_WA, ZLW_WIN_TO_WB, &
+ ZLW_WIN_TO_R, ZLW_WIN_TO_NR, KDAY, PEMIT_LW_FAC, ZEMIT_LW_RD, &
+ PT_RAD_IND, PHU_BLD, PTIME, ZE_SHADING )
!
!-------------------------------------------------------------------------------
!
!* 10. Treatment of solar panels
! -------------------------
!
-IF (OSOLAR_PANEL) THEN
+IF (TOP%LSOLAR_PANEL) THEN
!
!* LW radiation coming upwards from roofs
!
- ZEMIT_LW_ROOF = ZREC_LW_ROOF &
- - ( PFRAC_GR(:) * PABS_LW_GREENROOF(:)&
- + (1.-PFRAC_GR(:)) * ZDF_ROOF(:) * PABS_LW_ROOF(:) &
- + (1.-PFRAC_GR(:)) * ZDN_ROOF(:) * PABS_LW_SNOW_ROOF(:)&
- )
+ ZEMIT_LW_RF = ZREC_LW_RF &
+ - ( T%XGREENROOF(:) * DMT%XABS_LW_GREENROOF(:) &
+ + (1.-T%XGREENROOF(:)) * ZDF_RF(:) * DMT%XABS_LW_ROOF(:) &
+ + (1.-T%XGREENROOF(:)) * ZDN_RF(:) * DMT%XABS_LW_SNOW_ROOF(:) )
!
! note that, for the time being, one considers that the solar panel
! intercept radiation both above roof and greenroofs (if any)
- CALL SOLAR_PANEL(PTSTEP, PTSUN, PRESIDENTIAL, &
- ZEMIT_LW_ROOF,ZEMIT_LWDN_PANEL, PLW_RAD, &
- PABS_SW_PANEL, PTA, PN_FLOOR, PFRAC_PANEL, &
- PEMIS_PANEL, PALB_PANEL, PEFF_PANEL, &
- PABS_LW_PANEL, PH_PANEL, PRN_PANEL, &
- PTHER_PRODC_DAY, &
- PTHER_PROD_PANEL, PPHOT_PROD_PANEL,PPROD_PANEL,&
- PTHER_PROD_BLD, PPHOT_PROD_BLD, PPROD_BLD )
+ CALL SOLAR_PANEL(TPN, DMT, PTSTEP, PTSUN, T%XRESIDENTIAL, ZEMIT_LW_RF, ZEMIT_LWDN_PANEL, &
+ PLW_RAD, PTA, B%XN_FLOOR, PPROD_BLD )
ELSE
- PABS_LW_PANEL = XUNDEF
- PTHER_PROD_PANEL = XUNDEF
- PPHOT_PROD_PANEL = XUNDEF
- PPROD_PANEL = XUNDEF
- PTHER_PROD_BLD = XUNDEF
- PPHOT_PROD_BLD = XUNDEF
- PPROD_BLD = XUNDEF
- PH_PANEL = XUNDEF
- PRN_PANEL = XUNDEF
+ PPROD_BLD = XUNDEF
END IF
!-------------------------------------------------------------------------------
!
!* 11. Aggregation
! -----------
!
- CALL AVG_URBAN_FLUXES(PTS_TOWN, PEMIS_TOWN, &
- PT_CANYON, PQ_CANYON, &
- PT_LOWCAN, PQ_LOWCAN, &
- PT_ROOF(:,1),PT_ROAD(:,1),PT_WALL_A(:,1), PT_WALL_B(:,1), &
- ZTS_GARDEN, &
- ZTA, ZQA, PRHOA, PPS, &
- PH_TRAFFIC, PLE_TRAFFIC, PH_INDUSTRY, PLE_INDUSTRY, &
- PBLD, PROAD, PGARDEN, PWALL_O_HOR, ZWALL_O_GRND, &
- PFRAC_GR, &
- PEMIS_ROOF, ZESNOW_ROOF, ZEMIS_GREENROOF, &
- PLW_RAD, &
- PABS_LW_ROOF, PABS_LW_WALL_A, PABS_LW_WALL_B, &
- PABS_LW_ROAD, PABS_LW_GARDEN, PABS_LW_GREENROOF, &
- PABS_LW_SNOW_ROOF, PABS_LW_SNOW_ROAD, &
- ZAC_ROOF, ZAC_ROOF_WAT, &
- ZAC_WALL, PAC_ROAD, PAC_ROAD_WAT, ZAC_TOP, &
- PAC_GARDEN, &
- ZQSAT_GARDEN, ZAC_AGG_GARDEN, ZHU_AGG_GARDEN, &
- ZQSAT_ROOF, ZQSAT_ROAD, &
- ZDELT_ROOF, ZDELT_ROAD, &
- ZROOF_FRAC, ZWALL_FRAC, ZROAD_FRAC, ZGARDEN_FRAC, &
- ZTOTS_O_HORS, &
- ZDF_ROOF, ZDN_ROOF, ZDF_ROAD, ZDN_ROAD, &
- PRN_ROOF, PH_ROOF, PLE_ROOF, PGFLUX_ROOF, &
- PRN_ROAD, PH_ROAD, PLE_ROAD, PGFLUX_ROAD, &
- PRN_GARDEN, PH_GARDEN, PLE_GARDEN, PGFLUX_GARDEN, &
- PRN_WALL_A, PH_WALL_A, PLE_WALL_A, PGFLUX_WALL_A, &
- PRN_WALL_B, PH_WALL_B, PLE_WALL_B, PGFLUX_WALL_B, &
- PLEW_ROOF, PLESNOW_ROOF, &
- PLEW_ROAD, PLESNOW_ROAD, PHSNOW_ROAD, &
- ZEVAP_GARDEN, ZEVAP_GREENROOF, &
- PRN_GRND, PH_GRND, PLE_GRND, PGFLUX_GRND, &
- PRN_TOWN, PH_TOWN, PLE_TOWN, PGFLUX_TOWN, PEVAP_TOWN, &
- PRUNOFF_GARDEN,PRUNOFF_ROAD,PRUNOFF_STRLROOF, &
- PRUNOFF_GREENROOF, PDRAIN_GREENROOF, PRUNOFF_TOWN, &
- PABS_LW_PANEL, PEMIS_PANEL, PFRAC_PANEL, PRN_PANEL, &
- PH_PANEL, &
- PH_WASTE, PLE_WASTE, PF_WASTE_CAN, &
- PABS_LW_WIN, PT_WIN1, PGR, ZEMIT_LW_ROAD, ZEMIT_LW_GARDEN,&
- PEMIT_LW_GRND, HBEM, PSVF_ROAD, PSVF_GARDEN, PSVF_WALL, &
- PGARDEN_O_GRND, PROAD_O_GRND, &
- PEMIS_ROAD, PESNOW_ROAD, PEMIS_WALL, ZEMIS_GARDEN, OCANOPY)
-!
-PSFCO2(:) = PGARDEN(:) * ZSFCO2_GARDEN(:) + PBLD(:) * PFRAC_GR(:) * ZSFCO2_GREENROOF(:) ! no CO2 flux from built and road yet.
+ CALL AVG_URBAN_FLUXES(TOP, T, B, TPN, DMT, &
+ PTS_TWN, PEMIS_TWN, PT_CAN, PQ_CAN, PT_LOWCAN, PQ_LOWCAN, &
+ ZTA, ZQA, PRHOA, PPS, PH_TRAFFIC, PLE_TRAFFIC, ZWL_O_GRND, &
+ ZESN_RF, ZEMIS_GR, PLW_RAD, ZAC_RF, ZAC_RF_WAT, ZAC_WL, PAC_RD, &
+ PAC_RD_WAT, ZAC_TOP, PAC_GD, ZQSAT_GD, ZAC_AGG_GD, ZHU_AGG_GD, &
+ ZQSAT_RF, ZQSAT_RD, ZDELT_RF, ZDELT_RD, ZRF_FRAC, ZWL_FRAC, &
+ ZRD_FRAC, ZGD_FRAC, ZTOTS_O_HORS, ZDF_RF, ZDN_RF, ZDF_RD, ZDN_RD, &
+ PLE_WL_A, PLE_WL_B, PLEW_RF, PLESN_RF, PLEW_RD, PLESN_RD, PHSN_RD, &
+ ZTSRAD_GD, ZRN_GD, ZH_GD, ZLE_GD, ZGFLUX_GD, ZEVAP_GD, &
+ ZRUNOFF_GD, ZEVAP_GR, ZRUNOFF_GR, ZDRAIN_GR, &
+ PRN_GRND, PH_GRND, PLE_GRND, PGFLX_GRND, PRN_TWN, PH_TWN, PLE_TWN, &
+ PGFLX_TWN, PEVAP_TWN, ZEMIT_LW_RD,ZEMIT_LW_GD, PEMIT_LW_GRND, ZEMIS_GD )
+!
+PSFCO2(:) = T%XGARDEN(:) * ZSFCO2_GD(:) + T%XBLD(:) * T%XGREENROOF(:) * ZSFCO2_GR(:) ! no CO2 flux from built and road yet.
!
!-------------------------------------------------------------------------------
!
!* 12. Momentum flux for ground built surfaces
! ---------------------------------------
!
-PUW_GRND (:) = (PROAD(:)*ZUW_ROAD(:) + PGARDEN(:)*ZUW_GARDEN(:)) / (PROAD(:)+PGARDEN(:))
+PUW_GRND (:) = (T%XROAD(:)*ZUW_RD(:) + T%XGARDEN(:)*ZUW_GD(:)) / (T%XROAD(:)+T%XGARDEN(:))
!
PDUWDU_GRND (:) = 0.
!
diff --git a/src/SURFEX/teb_morpho.F90 b/src/SURFEX/teb_morpho.F90
index ec550271c07d3e0c5b3ac4808f05c699a788cc9f..7863cc5eac217eed280f3a8e7a62884f4f9b1ab2 100644
--- a/src/SURFEX/teb_morpho.F90
+++ b/src/SURFEX/teb_morpho.F90
@@ -3,10 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###########################################################################################################
- SUBROUTINE TEB_MORPHO(HPROGRAM, PBLD,PWALL_O_HOR, PGARDEN, PBLD_HEIGHT, PROAD, &
- PROAD_O_GRND, PGARDEN_O_GRND, PWALL_O_GRND, &
- PCAN_HW_RATIO, PSVF_ROAD, PSVF_GARDEN, PSVF_WALL, &
- PZ0_TOWN, PWALL_O_BLD, PH_TRAFFIC, PLE_TRAFFIC )
+ SUBROUTINE TEB_MORPHO(HPROGRAM, T )
! ###########################################################################################################
!
!!**** *TEB_MORPHO*
@@ -47,6 +44,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TEB_n, ONLY : TEB_t
+!
USE MODI_GET_LUOUT
USE MODI_ABOR1_SFX
!
@@ -55,78 +54,64 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-REAL, DIMENSION(:), INTENT(INOUT) :: PBLD ! Urban horizontal building density
-REAL, DIMENSION(:), INTENT(INOUT) :: PWALL_O_HOR ! Wall to horizontal surface ratio
-REAL, DIMENSION(:), INTENT(INOUT) :: PGARDEN ! Urban horizontal garden density
-REAL, DIMENSION(:), INTENT(INOUT) :: PBLD_HEIGHT ! Average building height [m]
-REAL, DIMENSION(:), INTENT(OUT) :: PROAD ! Urban horizontal road density
-REAL, DIMENSION(:), INTENT(OUT) :: PROAD_O_GRND ! Road relative surface over ground (road + garden)
-REAL, DIMENSION(:), INTENT(OUT) :: PGARDEN_O_GRND ! Garden relative surface over ground (road + garden)
-REAL, DIMENSION(:), INTENT(OUT) :: PWALL_O_GRND ! Wall relative surface over ground (road + garden)
-REAL, DIMENSION(:), INTENT(OUT) :: PCAN_HW_RATIO ! Urban canyon Height-Width ratio
-REAL, DIMENSION(:), INTENT(OUT) :: PSVF_ROAD ! road sky view factor
-REAL, DIMENSION(:), INTENT(OUT) :: PSVF_GARDEN ! garden sky view factor
-REAL, DIMENSION(:), INTENT(OUT) :: PSVF_WALL ! wall sky view factor
-REAL, DIMENSION(:), INTENT(OUT) :: PZ0_TOWN ! Urban roughness length
-REAL, DIMENSION(:), INTENT(OUT) :: PWALL_O_BLD ! Wall relative surface over ground (road + garden)
-REAL, DIMENSION(:), INTENT(INOUT) :: PH_TRAFFIC ! sensible heat flux due to traffic
-REAL, DIMENSION(:), INTENT(INOUT) :: PLE_TRAFFIC ! latent heat flux due to traffic
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+!
+TYPE(TEB_t), INTENT(INOUT) :: T
!
!* 0.2 Declarations of local variables
!
INTEGER :: JJ
INTEGER :: ILUOUT
!
-REAL, DIMENSION(SIZE(PBLD)) :: ZWALL_O_BLD ! Initial wall to built surface ratio
-REAL, DIMENSION(SIZE(PBLD)) :: ZWALL_O_HOR ! Initial wall to horizontal surface ratio
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZWALL_O_BLD ! Initial wall to built surface ratio
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZWALL_O_HOR ! Initial wall to horizontal surface ratio
!
-REAL, DIMENSION(2) :: ZRANGE_BLD = (/ 0.0001 , 0.9999 /) ! Range allowed for PBLD variation
-REAL, DIMENSION(2) :: ZRANGE_ROAD = (/ 0.0001 , 0.9999 /) ! Range allowed for PROAD variation
-REAL, DIMENSION(2) :: ZRANGE_BLD_HEIGHT = (/ 3. , 829.84 /) ! Range allowed for PBLD_HEIGHT variation
-REAL, DIMENSION(2) :: ZRANGE_WALL_O_HOR = (/ 0.00012 , 322. /) ! Range allowed for PWALL_O_HOR variation
+REAL, DIMENSION(2) :: ZRANGE_BLD = (/ 0.0001 , 0.9999 /) ! Range allowed for T%XBLD variation
+REAL, DIMENSION(2) :: ZRANGE_ROAD = (/ 0.0001 , 0.9999 /) ! Range allowed for T%XROAD variation
+REAL, DIMENSION(2) :: ZRANGE_BLD_HEIGHT = (/ 3. , 829.84 /) ! Range allowed for T%XBLD_HEIGHT variation
+REAL, DIMENSION(2) :: ZRANGE_WALL_O_HOR = (/ 0.00012 , 322. /) ! Range allowed for T%XWALL_O_HOR variation
!
!
!* 1. Get listing file for warnings
!
- CALL GET_LUOUT(HPROGRAM, ILUOUT)
+CALL GET_LUOUT(HPROGRAM, ILUOUT)
!
ZWALL_O_BLD(:) = 0.
ZWALL_O_HOR(:) = 0.
-DO JJ=1,SIZE(PBLD)
+DO JJ=1,SIZE(T%XBLD)
!
!* 2. Control building height no lower than 3.m and no higher than 829.84m
! reference: http://en.wikipedia.org/wiki/List_of_tallest_buildings_and_structures_in_the_world (2011)
! and control Z0_TOWN
!
- IF (PBLD_HEIGHT(JJ) < ZRANGE_BLD_HEIGHT(1) ) THEN
- PBLD_HEIGHT(JJ) = ZRANGE_BLD_HEIGHT(1)
+ IF (T%XBLD_HEIGHT(JJ) < ZRANGE_BLD_HEIGHT(1) ) THEN
+ T%XBLD_HEIGHT(JJ) = ZRANGE_BLD_HEIGHT(1)
ENDIF
- IF (PBLD_HEIGHT(JJ) > ZRANGE_BLD_HEIGHT(2)) &
- CALL ABOR1_SFX('TEB_MORPHO: PBLD_HEIGHT higher than 829.84, highest building in the world, should be lower')
+ IF (T%XBLD_HEIGHT(JJ) > ZRANGE_BLD_HEIGHT(2)) &
+ CALL ABOR1_SFX('TEB_MORPHO: T%XBLD_HEIGHT higher than 829.84, highest building in the world, should be lower')
!
- IF (PZ0_TOWN(JJ) > PBLD_HEIGHT(JJ)) THEN
- CALL ABOR1_SFX('TEB_MORPHO: PZ0_TOWN higher than PBLD_HEIGHT, should be lower')
+ IF (T%XZ0_TOWN(JJ) > T%XBLD_HEIGHT(JJ)) THEN
+ CALL ABOR1_SFX('TEB_MORPHO: T%XZ0_TOWN higher than T%XBLD_HEIGHT, should be lower')
ENDIF
!
!* 3. Control no and almost no building in the cell
! authorize building up to 10m and W_O_H 0.001
!
- IF (PBLD(JJ) < ZRANGE_BLD(1) ) THEN
- PBLD(JJ) = ZRANGE_BLD(1)
- PGARDEN(JJ) = MIN(PGARDEN(JJ), 1.-2.*PBLD(JJ))
+ IF (T%XBLD(JJ) < ZRANGE_BLD(1) ) THEN
+ T%XBLD(JJ) = ZRANGE_BLD(1)
+ T%XGARDEN(JJ) = MIN(T%XGARDEN(JJ), 1.-2.*T%XBLD(JJ))
ENDIF
!
!* 4. Control only building in the cell: could occur for high resolution
! theoretically W_O_H could be 0. -> impose that at least the wall surface is equal to the mesh perimeter x building
! height for a mesh size of 100 x 100m; the waste heat is released at the roof level
!
- IF (PBLD(JJ) > ZRANGE_BLD(2)) THEN
- PBLD(JJ) = ZRANGE_BLD(2)
- IF (PGARDEN(JJ) > 0.) THEN
- PGARDEN(JJ) = 0.
+ IF (T%XBLD(JJ) > ZRANGE_BLD(2)) THEN
+ T%XBLD(JJ) = ZRANGE_BLD(2)
+ IF (T%XGARDEN(JJ) > 0.) THEN
+ T%XGARDEN(JJ) = 0.
ENDIF
ENDIF
!
@@ -134,56 +119,56 @@ DO JJ=1,SIZE(PBLD)
! Evaluation of the minimum woh is done for mesh size of 1000. m
! wall surface of the building evaluated considering 1 square building
!
- IF (PWALL_O_HOR(JJ) < 4. * SQRT(PBLD(JJ))*PBLD_HEIGHT(JJ)/1000.) THEN
- PWALL_O_HOR(JJ) = 4. * SQRT(PBLD(JJ))*PBLD_HEIGHT(JJ)/1000.
+ IF (T%XWALL_O_HOR(JJ) < 4. * SQRT(T%XBLD(JJ))*T%XBLD_HEIGHT(JJ)/1000.) THEN
+ T%XWALL_O_HOR(JJ) = 4. * SQRT(T%XBLD(JJ))*T%XBLD_HEIGHT(JJ)/1000.
ENDIF
!
!* 6. Control facade surface vs building height, case of too high WALL_O_HOR
!
- PWALL_O_BLD(JJ) = PWALL_O_HOR(JJ)/PBLD(JJ)
+ T%XWALL_O_BLD(JJ) = T%XWALL_O_HOR(JJ)/T%XBLD(JJ)
!
- IF (PWALL_O_BLD(JJ) > (0.4 * PBLD_HEIGHT(JJ))) THEN ! <=> side_of_building < 10 m
+ IF (T%XWALL_O_BLD(JJ) > (0.4 * T%XBLD_HEIGHT(JJ))) THEN ! <=> side_of_building < 10 m
!
- ZWALL_O_HOR(JJ) = PWALL_O_HOR(JJ)
- ZWALL_O_BLD(JJ) = PWALL_O_BLD(JJ)
+ ZWALL_O_HOR(JJ) = T%XWALL_O_HOR(JJ)
+ ZWALL_O_BLD(JJ) = T%XWALL_O_BLD(JJ)
!
- PWALL_O_HOR(JJ) = 0.4 * PBLD (JJ) * PBLD_HEIGHT(JJ) ! correction WOHOR v2.1
- PWALL_O_BLD(JJ) = PWALL_O_HOR(JJ) / PBLD (JJ) ! correction WOHOR v2.1
+ T%XWALL_O_HOR(JJ) = 0.4 * T%XBLD (JJ) * T%XBLD_HEIGHT(JJ) ! correction WOHOR v2.1
+ T%XWALL_O_BLD(JJ) = T%XWALL_O_HOR(JJ) / T%XBLD (JJ) ! correction WOHOR v2.1
ENDIF
!
!* 7. Verify road
!
- PROAD (JJ) = 1.-(PGARDEN(JJ)+PBLD(JJ))
- IF (PROAD(JJ) <= ZRANGE_ROAD(1) ) THEN
- PROAD(JJ) = ZRANGE_ROAD(1)
- PGARDEN(JJ) = MAX(PGARDEN(JJ) - ZRANGE_ROAD(1), 0.)
- IF (PH_TRAFFIC(JJ) > 0. .OR. PLE_TRAFFIC(JJ) > 0.) THEN
- PH_TRAFFIC(JJ) = 0.
- PLE_TRAFFIC(JJ) = 0.
+ T%XROAD (JJ) = 1.-(T%XGARDEN(JJ)+T%XBLD(JJ))
+ IF (T%XROAD(JJ) <= ZRANGE_ROAD(1) ) THEN
+ T%XROAD(JJ) = ZRANGE_ROAD(1)
+ T%XGARDEN(JJ) = MAX(T%XGARDEN(JJ) - ZRANGE_ROAD(1), 0.)
+ IF (T%XH_TRAFFIC(JJ) > 0. .OR. T%XLE_TRAFFIC(JJ) > 0.) THEN
+ T%XH_TRAFFIC(JJ) = 0.
+ T%XLE_TRAFFIC(JJ) = 0.
ENDIF
ENDIF
!
!* 8. Final check of parameters range
!
- IF ( PBLD(JJ) < ZRANGE_BLD(1) .OR. PBLD(JJ) > ZRANGE_BLD(2) ) THEN
- WRITE(ILUOUT,*) 'WARNING : PBLD is still out of range after final corrections &
- &for grid mesh',JJ,' : ',PBLD(JJ)
+ IF ( T%XBLD(JJ) < ZRANGE_BLD(1) .OR. T%XBLD(JJ) > ZRANGE_BLD(2) ) THEN
+ WRITE(ILUOUT,*) 'WARNING : T%XBLD is still out of range after final corrections &
+ &for grid mesh',JJ,' : ',T%XBLD(JJ)
ENDIF
!
- IF ( PBLD_HEIGHT(JJ) < ZRANGE_BLD_HEIGHT(1) .OR. PBLD_HEIGHT(JJ) > ZRANGE_BLD_HEIGHT(2) ) THEN
- WRITE(ILUOUT,*) 'WARNING : PBLD_HEIGHT is still out of range after final corrections &
- &for grid mesh',JJ,' : ',PBLD_HEIGHT(JJ)
+ IF ( T%XBLD_HEIGHT(JJ) < ZRANGE_BLD_HEIGHT(1) .OR. T%XBLD_HEIGHT(JJ) > ZRANGE_BLD_HEIGHT(2) ) THEN
+ WRITE(ILUOUT,*) 'WARNING : T%XBLD_HEIGHT is still out of range after final corrections &
+ &for grid mesh',JJ,' : ',T%XBLD_HEIGHT(JJ)
ENDIF
!
- IF ( PWALL_O_HOR(JJ) < ZRANGE_WALL_O_HOR(1) .OR. PWALL_O_HOR(JJ) > ZRANGE_WALL_O_HOR(2) ) THEN
- WRITE(ILUOUT,*) 'WARNING : PWALL_O_HOR is still out of range after final corrections &
- &for grid mesh',JJ,' : ',PWALL_O_HOR(JJ)
+ IF ( T%XWALL_O_HOR(JJ) < ZRANGE_WALL_O_HOR(1) .OR. T%XWALL_O_HOR(JJ) > ZRANGE_WALL_O_HOR(2) ) THEN
+ WRITE(ILUOUT,*) 'WARNING : T%XWALL_O_HOR is still out of range after final corrections &
+ &for grid mesh',JJ,' : ',T%XWALL_O_HOR(JJ)
ENDIF
!
- IF ( PWALL_O_BLD(JJ) - (0.4 * PBLD_HEIGHT(JJ)) > 10E-16 ) THEN
- WRITE(ILUOUT,*) 'WARNING : PWALL_O_BLD is still too high after final corrections &
- &for grid mesh',JJ,' : ',PWALL_O_BLD(JJ)
+ IF ( T%XWALL_O_BLD(JJ) - (0.4 * T%XBLD_HEIGHT(JJ)) > 10E-16 ) THEN
+ WRITE(ILUOUT,*) 'WARNING : T%XWALL_O_BLD is still too high after final corrections &
+ &for grid mesh',JJ,' : ',T%XWALL_O_BLD(JJ)
ENDIF
!
ENDDO
@@ -191,18 +176,18 @@ ENDDO
!
!* 9. Compute morphometric parameters
!
-PCAN_HW_RATIO(:) = 0.5 * PWALL_O_HOR(:) / (1.-PBLD(:))
+T%XCAN_HW_RATIO(:) = 0.5 * T%XWALL_O_HOR(:) / (1.-T%XBLD(:))
!
!* relative surface fraction
!
-PROAD_O_GRND(:) = PROAD(:) / (PROAD(:) + PGARDEN(:))
-PGARDEN_O_GRND(:) = PGARDEN(:) / (PROAD(:) + PGARDEN(:))
-PWALL_O_GRND(:) = PWALL_O_HOR(:) / (PROAD(:) + PGARDEN(:))
+T%XROAD_O_GRND(:) = T%XROAD(:) / (T%XROAD(:) + T%XGARDEN(:))
+T%XGARDEN_O_GRND(:) = T%XGARDEN(:) / (T%XROAD(:) + T%XGARDEN(:))
+T%XWALL_O_GRND(:) = T%XWALL_O_HOR(:) / (T%XROAD(:) + T%XGARDEN(:))
!
!* Sky-view-factors:
!
-PSVF_ROAD (:) = (SQRT(PCAN_HW_RATIO(:)**2+1.) - PCAN_HW_RATIO(:))
-PSVF_GARDEN(:) = PSVF_ROAD(:)
-PSVF_WALL (:) = 0.5*(PCAN_HW_RATIO(:)+1.-SQRT(PCAN_HW_RATIO(:)**2+1.))/PCAN_HW_RATIO(:)
+T%XSVF_ROAD (:) = (SQRT(T%XCAN_HW_RATIO(:)**2+1.) - T%XCAN_HW_RATIO(:))
+T%XSVF_GARDEN(:) = T%XSVF_ROAD(:)
+T%XSVF_WALL (:) = 0.5*(T%XCAN_HW_RATIO(:)+1.-SQRT(T%XCAN_HW_RATIO(:)**2+1.))/T%XCAN_HW_RATIO(:)
!
END SUBROUTINE TEB_MORPHO
diff --git a/src/SURFEX/garden_properties.F90 b/src/SURFEX/teb_veg_properties.F90
similarity index 61%
rename from src/SURFEX/garden_properties.F90
rename to src/SURFEX/teb_veg_properties.F90
index 0cbcc65f838a34435029feb3286b16509a014a6a..b53bf898bbf9545a27b64147406d5a05bb097a96 100644
--- a/src/SURFEX/garden_properties.F90
+++ b/src/SURFEX/teb_veg_properties.F90
@@ -3,11 +3,9 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GARDEN_PROPERTIES (T, GDM, &
- PDIR_SW, PSCA_SW, PSW_BANDS, KSW, &
- PTS, PEMIS, PALB, PTA, &
- PALBNIR_TVEG, PALBVIS_TVEG, &
- PALBNIR_TSOIL, PALBVIS_TSOIL )
+ SUBROUTINE TEB_VEG_PROPERTIES (PMASK, IO, PEK, PDIR_SW, PSCA_SW, PSW_BANDS, KSW, &
+ PTS, PEMIS, PALB, PTA, PALBNIR_TVEG, PALBVIS_TVEG,&
+ PALBNIR_TSOIL, PALBVIS_TSOIL )
! ##########################################################################
!
!!**** *GARDEN_PROPERTIES*
@@ -34,17 +32,13 @@
!* 0. DECLARATIONS
! ------------
!
-!
-!
-USE MODD_TEB_n, ONLY : TEB_t
-USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_PE_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
-!
USE MODI_ISBA_PROPERTIES
-USE MODI_FLAG_TEB_GARDEN_n
-!
+USE MODI_FLAG_TEB_VEG_n
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -54,8 +48,10 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(TEB_t), INTENT(INOUT) :: T
-TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
+REAL, DIMENSION(:), INTENT(IN) :: PMASK
+!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
!
REAL, DIMENSION(:,:), INTENT(IN) :: PDIR_SW ! direct incoming solar radiation
REAL, DIMENSION(:,:), INTENT(IN) :: PSCA_SW ! diffus incoming solar radiation
@@ -96,52 +92,41 @@ REAL, DIMENSION(SIZE(PALB)) :: ZALBVIS_TSOIL ! visible soil tot albedo
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
-IF (LHOOK) CALL DR_HOOK('GARDEN_PROPERTIES',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('TEB_VEG_PROPERTIES',0,ZHOOK_HANDLE)
!
!* 1. Set physical values for points where there is no garden
! -------------------------------------------------------
!
! This way, ISBA can run without problem for these points
!
- CALL FLAG_TEB_GARDEN_n(GDM%TGD, GDM%TGDO, GDM%TGDPE, T, GDM%TVG, &
- 1)
+ CALL FLAG_TEB_VEG_n(PEK, IO, PMASK, 1)
!
!
!* 2. Computes several properties of gardens
! --------------------------------------
!
- CALL ISBA_PROPERTIES(GDM%TVG%CISBA, GDM%TVG%LTR_ML, GDM%TGD%CUR%TSNOW, 1, &
- PDIR_SW, PSCA_SW, PSW_BANDS, KSW, &
- GDM%TGDPE%CUR%XALBNIR(:), GDM%TGDPE%CUR%XALBVIS(:), GDM%TGDPE%CUR%XALBUV(:), &
- GDM%TGDP%XALBNIR_VEG(:), GDM%TGDP%XALBVIS_VEG(:), GDM%TGDP%XALBUV_VEG(:), &
- GDM%TGDP%XALBNIR_SOIL(:), GDM%TGDP%XALBVIS_SOIL(:), GDM%TGDP%XALBUV_SOIL(:), &
- GDM%TGDPE%CUR%XVEG(:), GDM%TGDPE%CUR%XLAI(:), GDM%TGDPE%CUR%XZ0(:), &
- GDM%TGDPE%CUR%XEMIS(:),GDM%TGD%CUR%XTG(:,1), &
- ZASNOW, ZANOSNOW, ZESNOW, ZENOSNOW, ZTSSNOW, ZTSNOSNOW, &
- GDM%TGD%CUR%XSNOWFREE_ALB_VEG, GDM%TGD%CUR%XSNOWFREE_ALB_SOIL, &
- ZALBNIR_TVEG, ZALBVIS_TVEG, ZALBNIR_TSOIL, ZALBVIS_TSOIL, &
- GDM%TGD%CUR%XPSN(:), GDM%TGD%CUR%XPSNV_A(:), GDM%TGD%CUR%XPSNG(:), &
- GDM%TGD%CUR%XPSNV(:) )
-!
-GDM%TGD%CUR%XSNOWFREE_ALB = ZANOSNOW
+ CALL ISBA_PROPERTIES(IO, PEK, PDIR_SW, PSCA_SW, PSW_BANDS, KSW, &
+ ZASNOW, ZANOSNOW, ZESNOW, ZENOSNOW, ZTSSNOW, ZTSNOSNOW, &
+ ZALBNIR_TVEG, ZALBVIS_TVEG, ZALBNIR_TSOIL, ZALBVIS_TSOIL)
+!
+PEK%XSNOWFREE_ALB(:) = ZANOSNOW
!
!* averaged albedo
-PALB = GDM%TGD%CUR%XPSN(:) * ZASNOW + (1.-GDM%TGD%CUR%XPSN(:)) * ZANOSNOW
+PALB = PEK%XPSN(:) * ZASNOW + (1.-PEK%XPSN(:)) * ZANOSNOW
!* averaged emissivity
-PEMIS= GDM%TGD%CUR%XPSN(:) * ZESNOW + (1.-GDM%TGD%CUR%XPSN(:)) * ZENOSNOW
+PEMIS= PEK%XPSN(:) * ZESNOW + (1.-PEK%XPSN(:)) * ZENOSNOW
!* averaged surface radiative temperature
! (recomputed from emitted long wave)
-PTS =((GDM%TGD%CUR%XPSN(:) * ZESNOW * ZTSSNOW**4 + &
- (1.-GDM%TGD%CUR%XPSN(:)) * ZENOSNOW * ZTSNOSNOW**4) / PEMIS)**0.25
+PTS =((PEK%XPSN(:) * ZESNOW * ZTSSNOW**4 + (1.-PEK%XPSN(:)) * ZENOSNOW * ZTSNOSNOW**4) / PEMIS)**0.25
!
-IF(PRESENT(PALBNIR_TVEG))PALBNIR_TVEG(:)=ZALBNIR_TVEG(:)
-IF(PRESENT(PALBVIS_TVEG))PALBVIS_TVEG(:)=ZALBVIS_TVEG(:)
-IF(PRESENT(PALBNIR_TSOIL))PALBNIR_TSOIL(:)=ZALBNIR_TSOIL(:)
-IF(PRESENT(PALBVIS_TSOIL))PALBVIS_TSOIL(:)=ZALBVIS_TSOIL(:)
+IF(PRESENT(PALBNIR_TVEG))PALBNIR_TVEG (:) = ZALBNIR_TVEG (:)
+IF(PRESENT(PALBVIS_TVEG))PALBVIS_TVEG (:) = ZALBVIS_TVEG (:)
+IF(PRESENT(PALBNIR_TSOIL))PALBNIR_TSOIL(:) = ZALBNIR_TSOIL(:)
+IF(PRESENT(PALBVIS_TSOIL))PALBVIS_TSOIL(:) = ZALBVIS_TSOIL(:)
!
-IF (LHOOK) CALL DR_HOOK('GARDEN_PROPERTIES',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('TEB_VEG_PROPERTIES',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
!
-END SUBROUTINE GARDEN_PROPERTIES
+END SUBROUTINE TEB_VEG_PROPERTIES
diff --git a/src/SURFEX/tebgrid.F90 b/src/SURFEX/tebgrid.F90
index 9d1ea92992346b80bf226b6591e3b8c3b3644bc6..765f70a309749d1b580876437ef4956566d7a275 100644
--- a/src/SURFEX/tebgrid.F90
+++ b/src/SURFEX/tebgrid.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE TEBGRID( PSOILDEPTH, PD_G, PD_G1 )
+ SUBROUTINE TEBGRID3( PSOILDEPTH, PD_G, PD_G1 )
! ##########################################################################
!
@@ -41,7 +41,7 @@
!!
!! AUTHOR
!! ------
-!! A. Boone * Meteo-France *
+!! A. Boone * Meteo-France *
!!
!! MODIFICATIONS
!! -------------
@@ -61,15 +61,15 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-REAL, DIMENSION(:), INTENT(IN) :: PSOILDEPTH ! total soil depth (m)
+REAL, INTENT(IN) :: PSOILDEPTH ! total soil depth (m)
!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PD_G ! depth of base of soil layers (m)
+REAL, DIMENSION(:), INTENT(OUT) :: PD_G ! depth of base of soil layers (m)
REAL, OPTIONAL, INTENT(IN) :: PD_G1 ! depth of first layer
!
!
!* 0.2 declarations of local variables
!
-INTEGER :: JJ, JNLVL
+INTEGER :: JJ, JI, JNLVL
!
!
REAL, PARAMETER :: ZGRIDFACTOR = 3.0 ! soil depth factor
@@ -97,61 +97,53 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! 0. Initialization
! --------------
!
-IF (LHOOK) CALL DR_HOOK('TEBGRID',0,ZHOOK_HANDLE)
-JNLVL = SIZE(PD_G,2)
+JNLVL = SIZE(PD_G)
!
IF (PRESENT(PD_G1)) ZD_G1 = PD_G1
-!-------------------------------------------------------------------------------
-!
-!* 1. Assign soil layer depths
-! ------------------------
-! using a geometric relation
-! for layers 2...N
-! This is GENERAL rule.
-! Note that the first soil layer
-! is FIXED except for VERY thin
-! soils (see #3 below).
-!
-PD_G(:,1) = ZD_G1
-PD_G(:,JNLVL) = PSOILDEPTH(:)
-!
-DO JJ=JNLVL-1,2,-1
- PD_G(:,JJ) = PD_G(:,JJ+1)/ZGRIDFACTOR
-ENDDO
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. When the soil is sufficiently thin
-! ------------------------------------------
-! We recalculate layer depths such
-! that all layer thicknesses are >= ZD_G1
-! We favor keeping a minimum grid thickness
-! OVER maintaining geometric relation
-! for increasingly thin soils. This means
-! that uppermost soil moisture is readily
-! comparable (i.e. for same layer thickness)
-! EVERYWHERE except for most thin soils (below).
-!
-DO JJ=1,JNLVL
- PD_G(:,JJ) = MAX(PD_G(:,JJ), JJ*ZD_G1)
-ENDDO
-!
-!-------------------------------------------------------------------------------
!
-!* 3. In the LIMIT For extremely thin soils
-! ------------------------------------------
-! This should be a RARE occurance, but
-! accounted for none-the-less ...:
-! hold the ratio between all layer
-! thicknesses constant.
-!
-DO JJ=1,JNLVL
- WHERE(PSOILDEPTH(:) < JNLVL*ZD_G1)
- PD_G(:,JJ) = JJ*PSOILDEPTH/JNLVL
- END WHERE
-ENDDO
-IF (LHOOK) CALL DR_HOOK('TEBGRID',1,ZHOOK_HANDLE)
+IF (PSOILDEPTH < JNLVL*ZD_G1) THEN
+ !
+ !* 3. In the LIMIT For extremely thin soils
+ ! ------------------------------------------
+ ! This should be a RARE occurance, but
+ ! accounted for none-the-less ...:
+ ! hold the ratio between all layer
+ ! thicknesses constant.
+ DO JJ = 1,JNLVL
+ PD_G(JJ) = JJ*PSOILDEPTH/JNLVL
+ ENDDO
+ !
+ELSE
+ !
+ PD_G(1) = ZD_G1
+ PD_G(JNLVL) = PSOILDEPTH
+ !
+ DO JJ=JNLVL-1,2,-1
+ !* 1. Assign soil layer depths
+ ! ------------------------
+ ! using a geometric relation
+ ! for layers 2...N
+ ! This is GENERAL rule.
+ ! Note that the first soil layer
+ ! is FIXED except for VERY thin
+ ! soils (see #3 below).
+ PD_G(JJ) = PD_G(JJ+1)/ZGRIDFACTOR
+ !* 2. When the soil is sufficiently thin
+ ! ------------------------------------------
+ ! We recalculate layer depths such
+ ! that all layer thicknesses are >= ZD_G1
+ ! We favor keeping a minimum grid thickness
+ ! OVER maintaining geometric relation
+ ! for increasingly thin soils. This means
+ ! that uppermost soil moisture is readily
+ ! comparable (i.e. for same layer thickness)
+ ! EVERYWHERE except for most thin soils (below).
+ PD_G(JJ) = MAX(PD_G(JJ), JJ*ZD_G1)
+ !
+ ENDDO
+ !
+ENDIF
!
!-------------------------------------------------------------------------------
!
-END SUBROUTINE TEBGRID
+END SUBROUTINE TEBGRID3
diff --git a/src/SURFEX/test_nam_var_surf.F90 b/src/SURFEX/test_nam_var_surf.F90
index 1851c1313f551d2b830811fb9ef89f49e10c62f2..f9b847c05fbc462d6863b9f80f5ce06193a11ec2 100644
--- a/src/SURFEX/test_nam_var_surf.F90
+++ b/src/SURFEX/test_nam_var_surf.F90
@@ -11,7 +11,8 @@ INTERFACE TEST_NAM_VAR_SURF
SUBROUTINE TEST_NAM_VARC0_SURF(KLUOUT,HNAME,HVAR, &
HVALUE1,HVALUE2,HVALUE3, &
HVALUE4,HVALUE5,HVALUE6, &
- HVALUE7,HVALUE8,HVALUE9 )
+ HVALUE7,HVALUE8,HVALUE9, &
+ HVALUE10 )
!
INTEGER, INTENT(IN) ::KLUOUT ! output listing logical unit
CHARACTER(LEN=*) ,INTENT(IN) ::HNAME ! name of the variable to test
@@ -26,6 +27,7 @@ INTEGER, INTENT(IN) ::KLUOUT ! output listing logical unit
CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::HVALUE7 ! seventh possible value
CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::HVALUE8 ! eightth possible value
CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::HVALUE9 ! nineth possible value
+ CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::HVALUE10 ! tenth possible value
!
END SUBROUTINE TEST_NAM_VARC0_SURF
!
@@ -42,7 +44,8 @@ END SUBROUTINE TEST_NAM_VARL0_SURF
SUBROUTINE TEST_NAM_VARN0_SURF(KLUOUT,HNAME,KVAR, &
KVALUE1,KVALUE2,KVALUE3, &
KVALUE4,KVALUE5,KVALUE6, &
- KVALUE7,KVALUE8,KVALUE9 )
+ KVALUE7,KVALUE8,KVALUE9, &
+ KVALUE10 )
!
INTEGER, INTENT(IN) ::KLUOUT ! output listing logical unit
CHARACTER(LEN=*) ,INTENT(IN) ::HNAME ! name of the variable to test
@@ -57,13 +60,15 @@ INTEGER ,INTENT(IN), OPTIONAL ::KVALUE6 ! sixth possible value
INTEGER ,INTENT(IN), OPTIONAL ::KVALUE7 ! seventh possible value
INTEGER ,INTENT(IN), OPTIONAL ::KVALUE8 ! eightth possible value
INTEGER ,INTENT(IN), OPTIONAL ::KVALUE9 ! nineth possible value
+INTEGER ,INTENT(IN), OPTIONAL ::KVALUE10 ! 10th possible value
!
END SUBROUTINE TEST_NAM_VARN0_SURF
!
SUBROUTINE TEST_NAM_VARX0_SURF(KLUOUT,HNAME,PVAR, &
PVALUE1,PVALUE2,PVALUE3, &
PVALUE4,PVALUE5,PVALUE6, &
- PVALUE7,PVALUE8,PVALUE9 )
+ PVALUE7,PVALUE8,PVALUE9, &
+ PVALUE10 )
!
INTEGER, INTENT(IN) ::KLUOUT ! output listing logical unit
CHARACTER(LEN=*) ,INTENT(IN) ::HNAME ! name of the variable to test
@@ -78,6 +83,7 @@ REAL ,INTENT(IN), OPTIONAL ::PVALUE6 ! sixth possible value
REAL ,INTENT(IN), OPTIONAL ::PVALUE7 ! seventh possible value
REAL ,INTENT(IN), OPTIONAL ::PVALUE8 ! eightth possible value
REAL ,INTENT(IN), OPTIONAL ::PVALUE9 ! nineth possible value
+REAL ,INTENT(IN), OPTIONAL ::PVALUE10 ! 10th possible value
!
END SUBROUTINE TEST_NAM_VARX0_SURF
!
@@ -90,7 +96,8 @@ END MODULE MODI_TEST_NAM_VAR_SURF
SUBROUTINE TEST_NAM_VARC0_SURF(KLUOUT,HNAME,HVAR, &
HVALUE1,HVALUE2,HVALUE3, &
HVALUE4,HVALUE5,HVALUE6, &
- HVALUE7,HVALUE8,HVALUE9 )
+ HVALUE7,HVALUE8,HVALUE9, &
+ HVALUE10 )
! #########################################################
!
!!**** *TEST_NAM_VARC0* - routine to test the value of a character var.
@@ -152,6 +159,7 @@ INTEGER, INTENT(IN) ::KLUOUT ! output listing logical unit
CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::HVALUE7 ! seventh possible value
CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::HVALUE8 ! eightth possible value
CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::HVALUE9 ! nineth possible value
+ CHARACTER(LEN=*) ,INTENT(IN), OPTIONAL ::HVALUE10 ! 10th possible value
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.2 Declarations of local variables
@@ -214,6 +222,12 @@ IF ( PRESENT (HVALUE9) ) THEN
IF ( HVAR==HVALUE9 ) RETURN
END IF
!
+IF ( PRESENT (HVALUE10) ) THEN
+ IF ( HVAR==HVALUE10 .AND. LHOOK) &
+ CALL DR_HOOK('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARC0_SURF',1,ZHOOK_HANDLE)
+ IF ( HVAR==HVALUE10 ) RETURN
+END IF
+!
!-------------------------------------------------------------------------------
!
WRITE (KLUOUT,*) ' '
@@ -232,6 +246,7 @@ IF ( PRESENT (HVALUE6) ) WRITE (KLUOUT,*) '"',HVALUE6,'"'
IF ( PRESENT (HVALUE7) ) WRITE (KLUOUT,*) '"',HVALUE7,'"'
IF ( PRESENT (HVALUE8) ) WRITE (KLUOUT,*) '"',HVALUE8,'"'
IF ( PRESENT (HVALUE9) ) WRITE (KLUOUT,*) '"',HVALUE9,'"'
+IF ( PRESENT (HVALUE10)) WRITE (KLUOUT,*) '"',HVALUE10,'"'
!
CALL ABOR1_SFX('TEST_NAM_VAR_SURF: (1) CHARACTER VALUE NOT ALLOWED')
IF (LHOOK) CALL DR_HOOK('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARC0_SURF',1,ZHOOK_HANDLE)
@@ -326,7 +341,8 @@ END SUBROUTINE TEST_NAM_VARL0_SURF
SUBROUTINE TEST_NAM_VARN0_SURF(KLUOUT,HNAME,KVAR, &
KVALUE1,KVALUE2,KVALUE3, &
KVALUE4,KVALUE5,KVALUE6, &
- KVALUE7,KVALUE8,KVALUE9 )
+ KVALUE7,KVALUE8,KVALUE9, &
+ KVALUE10 )
! #########################################################
!
!!**** *TEST_NAM_VARN0* - routine to test the value of an integer var.
@@ -388,6 +404,7 @@ INTEGER ,INTENT(IN), OPTIONAL ::KVALUE6 ! sixth possible value
INTEGER ,INTENT(IN), OPTIONAL ::KVALUE7 ! seventh possible value
INTEGER ,INTENT(IN), OPTIONAL ::KVALUE8 ! eightth possible value
INTEGER ,INTENT(IN), OPTIONAL ::KVALUE9 ! nineth possible value
+INTEGER ,INTENT(IN), OPTIONAL ::KVALUE10 ! 10th possible value
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.2 Declarations of local variables
@@ -450,6 +467,12 @@ IF ( PRESENT (KVALUE9) ) THEN
IF ( KVAR==KVALUE9 ) RETURN
END IF
!
+IF ( PRESENT (KVALUE10) ) THEN
+ IF ( KVAR==KVALUE10 .AND. LHOOK) &
+ CALL DR_HOOK('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,ZHOOK_HANDLE)
+ IF ( KVAR==KVALUE10 ) RETURN
+END IF
+!
!-------------------------------------------------------------------------------
!
WRITE (KLUOUT,*) ' '
@@ -468,6 +491,7 @@ IF ( PRESENT (KVALUE6) ) WRITE (KLUOUT,*) '"',KVALUE6,'"'
IF ( PRESENT (KVALUE7) ) WRITE (KLUOUT,*) '"',KVALUE7,'"'
IF ( PRESENT (KVALUE8) ) WRITE (KLUOUT,*) '"',KVALUE8,'"'
IF ( PRESENT (KVALUE9) ) WRITE (KLUOUT,*) '"',KVALUE9,'"'
+IF ( PRESENT (KVALUE10)) WRITE (KLUOUT,*) '"',KVALUE10,'"'
!
CALL ABOR1_SFX('TEST_NAM_VAR_SURF: (3) INTEGER VALUE NOT ALLOWED')
IF (LHOOK) CALL DR_HOOK('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,ZHOOK_HANDLE)
@@ -478,7 +502,8 @@ END SUBROUTINE TEST_NAM_VARN0_SURF
SUBROUTINE TEST_NAM_VARX0_SURF(KLUOUT,HNAME,PVAR, &
PVALUE1,PVALUE2,PVALUE3, &
PVALUE4,PVALUE5,PVALUE6, &
- PVALUE7,PVALUE8,PVALUE9 )
+ PVALUE7,PVALUE8,PVALUE9, &
+ PVALUE10 )
! #########################################################
!
!!**** *TEST_NAM_VARN0* - routine to test the value of an integer var.
@@ -540,6 +565,7 @@ REAL ,INTENT(IN), OPTIONAL ::PVALUE6 ! sixth possible value
REAL ,INTENT(IN), OPTIONAL ::PVALUE7 ! seventh possible value
REAL ,INTENT(IN), OPTIONAL ::PVALUE8 ! eightth possible value
REAL ,INTENT(IN), OPTIONAL ::PVALUE9 ! nineth possible value
+REAL ,INTENT(IN), OPTIONAL ::PVALUE10 ! 10th possible value
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.2 Declarations of local variables
@@ -602,6 +628,12 @@ IF ( PRESENT (PVALUE9) ) THEN
IF ( PVAR==PVALUE9 ) RETURN
END IF
!
+IF ( PRESENT (PVALUE10) ) THEN
+ IF ( PVAR==PVALUE10 .AND. LHOOK) &
+ CALL DR_HOOK('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,ZHOOK_HANDLE)
+ IF ( PVAR==PVALUE10 ) RETURN
+END IF
+!
!-------------------------------------------------------------------------------
!
WRITE (KLUOUT,*) ' '
@@ -620,6 +652,7 @@ IF ( PRESENT (PVALUE6) ) WRITE (KLUOUT,*) '"',PVALUE6,'"'
IF ( PRESENT (PVALUE7) ) WRITE (KLUOUT,*) '"',PVALUE7,'"'
IF ( PRESENT (PVALUE8) ) WRITE (KLUOUT,*) '"',PVALUE8,'"'
IF ( PRESENT (PVALUE9) ) WRITE (KLUOUT,*) '"',PVALUE9,'"'
+IF ( PRESENT (PVALUE10)) WRITE (KLUOUT,*) '"',PVALUE10,'"'
!
CALL ABOR1_SFX('TEST_NAM_VAR_SURF: (4) REAL VALUE NOT ALLOWED')
IF (LHOOK) CALL DR_HOOK('MODI_TEST_NAM_VAR_SURF:TEST_NAM_VARN0_SURF',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/test_record_len.F90 b/src/SURFEX/test_record_len.F90
index 4a1c75ea527ec7a484226bd28c511477efb583e2..6714e20bf95f1c03bc18aaa945c4a84ec04b9661 100644
--- a/src/SURFEX/test_record_len.F90
+++ b/src/SURFEX/test_record_len.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#################################################
-SUBROUTINE TEST_RECORD_LEN (DGU, &
- HPROGRAM,HREC,ONOWRITE)
+SUBROUTINE TEST_RECORD_LEN (HPROGRAM,HREC,HSELECT,ONOWRITE)
!#################################################
!
!!
@@ -13,11 +12,15 @@ SUBROUTINE TEST_RECORD_LEN (DGU, &
!! B. Decharme 07/2013 write 'time' in netcdf output files
!-------------------------------------------------------------------------------
!
-!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-!
USE MODI_GET_LUOUT
!
+USE MODD_SURFEX_MPI, ONLY : NRANK,NPIO
+USE MODD_XIOS, ONLY : LXIOS, LXIOS_DEF_CLOSED
+#ifdef WXIOS
+USE XIOS, ONLY : XIOS_IS_VALID_FIELD, XIOS_FIELD_IS_ACTIVE
+#endif
+!
+USE MODD_WRITE_SURF_ATM, ONLY : LFIRST_WRITE, LNOWRITE, NCPT_WRITE
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -25,56 +28,93 @@ USE PARKIND1 ,ONLY : JPRB
USE MODI_ABOR1_SFX
!
IMPLICIT NONE
-!
-!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
CHARACTER(LEN=LEN_HREC), INTENT(IN) :: HREC ! name of the article to be written
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
LOGICAL, INTENT(OUT) :: ONOWRITE ! flag for article to be written
!
CHARACTER(LEN=LEN_HREC) :: YREC
INTEGER :: IFIELD,JFIELD
INTEGER :: ILUOUT ! listing logical unit
REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
-CHARACTER(LEN=12) :: YFMT
-
!-------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('MODI_WRITE_SURF:TEST_RECORD_LEN',0,ZHOOK_HANDLE)
-IF (LEN_TRIM(HREC)>LEN_HREC) THEN
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
- WRITE(ILUOUT,*) '----------------------------------------------'
- WRITE(ILUOUT,*) 'Error occured when writing a field '
- WRITE(ILUOUT,*) 'The name of the field is too long '
- WRITE(ILUOUT,*) 'The name must not be longer than',LEN_HREC,' characters'
- WRITE(ILUOUT,*) 'Please shorten the name of your field '
- WRITE(YFMT,FMT='("(A32,A",I2.2,",A1)")') LEN_HREC
- WRITE(ILUOUT,FMT=YFMT) ' The field name currently is : "',HREC,'"'
- WRITE(ILUOUT,*) '----------------------------------------------'
- CALL ABOR1_SFX('TEST_RECORD_LEN: FIELD NAME TOO LONG --> '//HREC)
-END IF
+IF (LHOOK) CALL DR_HOOK('TEST_RECORD_LEN',0,ZHOOK_HANDLE)
!
-YREC = HREC
-SELECT CASE(HREC(1:4))
- CASE("TEB1","TEB2","TEB3","TEB4","TEB5","TEB6","TEB7","TEB8","TEB9")
- YREC=HREC(6:LEN(HREC))
-END SELECT
-! if output fields selection is active, test if this field is to be written
-IF (DGU%LSELECT) THEN
- IFIELD=COUNT(DGU%CSELECT /= ' ')
- ONOWRITE=.TRUE.
- DO JFIELD=1,IFIELD
- IF ( TRIM(DGU%CSELECT(JFIELD))==TRIM(YREC) ) THEN
- ONOWRITE=.FALSE.
+IF (TRIM(HREC)=="time".OR.TRIM(HREC)=="longitude".OR.TRIM(HREC)=="latitude") THEN
+ ONOWRITE = .FALSE.
+ IF (LHOOK) CALL DR_HOOK('TEST_RECORD_LEN',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
+!
+NCPT_WRITE = NCPT_WRITE + 1
+!
+IF (LFIRST_WRITE) THEN
+ !
+#ifdef WXIOS
+ IF (LXIOS .AND. (TRIM(HPROGRAM)=='XIOS' )) THEN
+ !
+ IF (LXIOS_DEF_CLOSED) THEN
+ IF (XIOS_IS_VALID_FIELD(HREC)) THEN
+ ONOWRITE = .NOT.XIOS_FIELD_IS_ACTIVE(HREC)
+ ELSE
+ ONOWRITE = .TRUE.
ENDIF
- ENDDO
- !special case for netcdf output
- IF(TRIM(YREC)=='time')ONOWRITE=.FALSE.
+ ELSE
+ ONOWRITE = .FALSE.
+ ENDIF
+ !
+ IF (ONOWRITE) THEN
+ LNOWRITE(NCPT_WRITE) = ONOWRITE
+ IF (LHOOK) CALL DR_HOOK('TEST_RECORD_LEN',1,ZHOOK_HANDLE)
+ RETURN
+ ENDIF
+ !
+ ENDIF
+#endif
+ !
+ IF (LEN_TRIM(HREC)>LEN_HREC) THEN
+ CALL GET_LUOUT(HPROGRAM,ILUOUT)
+ WRITE(ILUOUT,*) '----------------------------------------------'
+ WRITE(ILUOUT,*) 'Error occured when writing a field '
+ WRITE(ILUOUT,*) 'The name of the field is too long '
+ WRITE(ILUOUT,*) 'The name must not be longer than',LEN_HREC,' characters'
+ WRITE(ILUOUT,*) 'Please shorten the name of your field '
+ WRITE(ILUOUT,FMT='(A32,A12,A1)') ' The field name currently is : "',HREC,'"'
+ WRITE(ILUOUT,*) '----------------------------------------------'
+ CALL ABOR1_SFX('TEST_RECORD_LEN: FIELD NAME TOO LONG --> '//HREC)
+ END IF
+ !
+ YREC = HREC
+ SELECT CASE(HREC(1:4))
+ CASE("TEB1","TEB2","TEB3","TEB4","TEB5","TEB6","TEB7","TEB8","TEB9")
+ YREC=HREC(6:LEN(HREC))
+ END SELECT
+ !
+ ! if output fields selection is active, test if this field is to be written
+ IF (SIZE(HSELECT)>0) THEN
+ IFIELD=COUNT(HSELECT /= ' ')
+ ONOWRITE=.TRUE.
+ DO JFIELD=1,IFIELD
+ IF ( TRIM(HSELECT(JFIELD))==TRIM(YREC) ) THEN
+ ONOWRITE=.FALSE.
+ ENDIF
+ ENDDO
+ !special case for netcdf output
+ IF(TRIM(YREC)=='time')ONOWRITE=.FALSE.
+ ELSE
+ ONOWRITE=.FALSE.
+ ENDIF
+ !
+ LNOWRITE(NCPT_WRITE) = ONOWRITE
+ !
ELSE
- ONOWRITE=.FALSE.
+ !
+ ONOWRITE = LNOWRITE(NCPT_WRITE)
+ !
ENDIF
-IF (LHOOK) CALL DR_HOOK('MODI_WRITE_SURF:TEST_RECORD_LEN',1,ZHOOK_HANDLE)
+!
+IF (LHOOK) CALL DR_HOOK('TEST_RECORD_LEN',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
END SUBROUTINE TEST_RECORD_LEN
diff --git a/src/SURFEX/thermal_layers_conf.F90 b/src/SURFEX/thermal_layers_conf.F90
index 2502d2b3763f9df82ea54897d3e3e7892ceb8947..9239792f63ba3798ec24e65e02e1091b35d580cb 100644
--- a/src/SURFEX/thermal_layers_conf.F90
+++ b/src/SURFEX/thermal_layers_conf.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ######################################################################
- SUBROUTINE THERMAL_LAYERS_CONF(HTYPE,PHC,PTC,PD,PHC_OUT,PTC_OUT,PD_OUT)
+ SUBROUTINE THERMAL_LAYERS_CONF(HTYPE,PD,PD_OUT,PHC,PHC_OUT,PTC,PTC_OUT)
! ######################################################################
!
!!**** *THERMAL_LAYERS_CONF*
@@ -31,7 +31,7 @@
!!
!! AUTHOR
!! ------
-!! V. Masson *Meteo France*
+!! V. Masson *Meteo France*
!!
!! MODIFICATIONS
!! -------------
@@ -42,7 +42,10 @@
! ------------
!
USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODI_TEBGRID
+USE MODI_ABOR1_SFX
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
@@ -50,30 +53,30 @@ IMPLICIT NONE
! -------------------------
!
CHARACTER(LEN=5), INTENT(IN) :: HTYPE ! type of surface
-REAL, DIMENSION(:,:), INTENT(IN) :: PHC ! input Heat Capacity
-REAL, DIMENSION(:,:), INTENT(IN) :: PTC ! input Thermal conductivity
REAL, DIMENSION(:,:), INTENT(IN) :: PD ! input Layer Thickness
-REAL, DIMENSION(:,:), INTENT(OUT) :: PHC_OUT ! output Heat Capacity
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTC_OUT ! output Thermal conductivity
REAL, DIMENSION(:,:), INTENT(OUT) :: PD_OUT ! output Layer Thickness
+REAL, DIMENSION(:,:), INTENT(IN), OPTIONAL :: PHC ! input Heat Capacity
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PHC_OUT ! output Heat Capacity
+REAL, DIMENSION(:,:), INTENT(IN), OPTIONAL :: PTC ! input Thermal conductivity
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PTC_OUT ! output Thermal conductivity
!
!* 0.2 Declarations of local variables
!
-REAL, DIMENSION(SIZE(PHC,1)) :: ZD_TOT ! Total depth
-REAL, DIMENSION(SIZE(PHC,1)) :: ZD_HALF ! Depth of the half of the total surface
+REAL :: ZD_TOT ! Total depth
+REAL :: ZD_HALF ! Depth of the half of the total surface
! ! (excluding central layer in case
! ! of odd number of layers)
-REAL, DIMENSION(SIZE(PHC,1)) :: ZD_MID ! Thickness of the layer in the middle
+REAL :: ZD_MID ! Thickness of the layer in the middle
! ! in case of odd number of layers
-REAL, DIMENSION(SIZE(PHC,1),0:SIZE(PHC ,2))::ZD_IN ! Depth from the surface
-! ! to the layer bottom
-REAL, DIMENSION(SIZE(PHC,1),0:SIZE(PHC_OUT,2))::ZD_OUT ! Depth from the surface
+REAL, DIMENSION(0:SIZE(PD ,2))::ZD_IN ! Depth from the surface
+! ! to the layer bottom
+REAL, DIMENSION(0:SIZE(PD_OUT,2))::ZD_OUT ! Depth from the surface
! ! to the layer bottom
-REAL, DIMENSION(SIZE(PHC,1),SIZE(PHC,2)) :: ZW ! 1/TC
-REAL, DIMENSION(SIZE(PHC,1),SIZE(PHC_OUT,2)) :: ZW_OUT ! 1/TC
+REAL, DIMENSION(SIZE(PD,2)) :: ZW, ZHC ! 1/TC
+REAL, DIMENSION(SIZE(PD_OUT,2)) :: ZW_OUT, ZHC_OUT ! 1/TC
INTEGER :: IIN ! Number of layer in input data
INTEGER :: IOUT ! Number of layer in output fields
-INTEGER :: JIN ! Loop counter on input layers
+INTEGER :: JIN, JI ! Loop counter on input layers
INTEGER :: JOUT ! Loop counter on output layers
!
REAL, PARAMETER :: ZD_G1 = 0.001 ! uppermost soil layer
@@ -87,82 +90,123 @@ REAL, PARAMETER :: ZD_G1 = 0.001 ! uppermost soil layer
! ! into question. If it is too
! ! thick, then resolution of
! ! diurnal cycle not as valid.
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!-------------------------------------------------------------------------------
!
-IIN = SIZE(PHC,2)
-IOUT= SIZE(PHC_OUT,2)
-!
-!-------------------------------------------------------------------------------
-!
-!* Depths for the computational grid
-!
-!* total depth:
+IF (LHOOK) CALL DR_HOOK('THERMAL_LAYER_CONF_1',0,ZHOOK_HANDLE)
!
+IF (PRESENT(PHC_OUT).AND..NOT.PRESENT(PHC)) THEN
+ CALL ABOR1_SFX("THERMAL_LAYERS_CONF:IF HC_OUT IS PRESENT, HC MUST BE PRESENT TOO.")
+ELSEIF (PRESENT(PTC_OUT).AND..NOT.PRESENT(PTC)) THEN
+ CALL ABOR1_SFX("THERMAL_LAYERS_CONF:IF TC_OUT IS PRESENT, TC MUST BE PRESENT TOO.")
+ENDIF
!
-ZD_IN(:,0) = 0.
-DO JIN=1,IIN
- ZD_IN(:,JIN) = ZD_IN(:,JIN-1) + PD(:,JIN)
-END DO
-ZD_TOT(:) = ZD_IN(:,IIN)
+IOUT= SIZE(PD_OUT,2)
!
-!* surface like road or floor (thin grid at the surface, coarse at the bottom)
+IIN = SIZE(PD,2)
!
-IF (HTYPE=='ROAD ' .OR. HTYPE=='FLOOR') THEN
- ZD_OUT(:,0) = 0.
- CALL TEBGRID(ZD_TOT,ZD_OUT(:,1:),ZD_G1)
- PD_OUT(:,1) = ZD_OUT(:,1)
- DO JOUT=2,IOUT
- PD_OUT(:,JOUT) = ZD_OUT(:,JOUT) - ZD_OUT(:,JOUT-1) ! Depths => Thickness of layer
- END DO
-ELSE
+IF (LHOOK) CALL DR_HOOK('THERMAL_LAYER_CONF_1',1,ZHOOK_HANDLE)
!
-!* surface like roof or wall (thin grid on both sides, coarse in the middle)
-!
- IF (MOD(IOUT,2)==0) THEN ! even number of output layers
- ZD_HALF(:) = ZD_TOT(:) / 2.
- ELSE ! odd number of output layers
- ZD_MID (:) = 2. * ZD_TOT(:) / IOUT ! middle layer is arbitrarily fixed
- IF (IOUT==3) ZD_MID=MAX(ZD_MID,ZD_TOT-2.*ZD_G1) ! to impose layers equal
- ! to ZD_G1 on both sides
- ZD_HALF(:) = (ZD_TOT(:)-ZD_MID(:)) / 2.
- PD_OUT (:,IOUT/2+1) = ZD_MID (:)
- END IF
- ZD_OUT(:,0) = 0.
- CALL TEBGRID(ZD_HALF,ZD_OUT(:,1:IOUT/2),ZD_G1)
- PD_OUT(:,1) = ZD_OUT(:,1)
- DO JOUT=2,IOUT/2
- PD_OUT(:,JOUT) = ZD_OUT(:,JOUT) - ZD_OUT(:,JOUT-1) ! Depths => Thickness of layer
- END DO
- DO JOUT=1,IOUT/2
- PD_OUT(:,IOUT+1-JOUT) = PD_OUT(:,JOUT)
- END DO
- !* recomputes Depths for further averagings
- DO JOUT=2,IOUT
- ZD_OUT(:,JOUT) = ZD_OUT(:,JOUT-1) + PD_OUT(:,JOUT)
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('THERMAL_LAYER_CONF_2',0,ZHOOK_HANDLE_OMP)
+!$OMP DO PRIVATE(JI,ZD_IN,ZD_TOT,ZD_OUT,ZD_HALF,ZD_MID,ZW,ZHC,ZW_OUT,ZHC_OUT)
+DO JI=1,SIZE(PD_OUT,1)
+ !
+ ZD_IN(0) = 0.
+ DO JIN=1,IIN
+ ZD_IN(JIN) = ZD_IN(JIN-1) + PD(JI,JIN)
END DO
-
-END IF
+ ZD_TOT = ZD_IN(IIN)
+ !
+ !* Depths for the computational grid
+ !
+ !* surface like road or floor (thin grid at the surface, coarse at the bottom)
+ !
+ ZD_OUT(0) = 0.
+ !
+ IF (HTYPE=='ROAD ' .OR. HTYPE=='FLOOR') THEN
+ !
+ CALL TEBGRID(ZD_TOT,ZD_OUT(1:),ZD_G1)
+ !
+ DO JOUT=1,IOUT
+ PD_OUT(JI,JOUT) = ZD_OUT(JOUT) - ZD_OUT(JOUT-1) ! Depths => Thickness of layer
+ END DO
+ !
+ ELSE
+ !
+ !* surface like roof or wall (thin grid on both sides, coarse in the middle)
+ !
+ IF (MOD(IOUT,2)==0) THEN ! even number of output layers
+ ZD_HALF = ZD_TOT / 2.
+ ELSE ! odd number of output layers
+ ZD_MID = 2. * ZD_TOT / IOUT ! middle layer is arbitrarily fixed
+ IF (IOUT==3) ZD_MID = MAX(ZD_MID,ZD_TOT-2.*ZD_G1) ! to impose layers equal
+ ! to ZD_G1 on both sides
+ ZD_HALF = (ZD_TOT-ZD_MID) / 2.
+ PD_OUT (JI,IOUT/2+1) = ZD_MID
+ END IF
+ !
+ CALL TEBGRID(ZD_HALF,ZD_OUT(1:IOUT/2),ZD_G1)
+ !
+ DO JOUT=1,IOUT
+ !
+ IF (JOUT<=IOUT/2) THEN
+ PD_OUT(JI,JOUT) = ZD_OUT(JOUT) - ZD_OUT(JOUT-1) ! Depths => Thickness of layer
+ PD_OUT(JI,IOUT+1-JOUT) = PD_OUT(JI,JOUT)
+ ENDIF
+ !
+ !* recomputes Depths for further averagings
+ IF (JOUT>1) ZD_OUT(JOUT) = ZD_OUT(JOUT-1) + PD_OUT(JI,JOUT)
+ !
+ END DO
+ !
+ ENDIF
+ !
+ IF (PD(JI,1)==XUNDEF) PD_OUT(JI,1:IOUT) = XUNDEF
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !* Averaging of the Heat Capacity and the Thermal conductivity
+ !
+ IF (PRESENT(PTC)) THEN
+ ZW(:) =1./PTC(JI,:)
+ ELSE
+ ZW(:) =1.
+ ENDIF
+ IF (PRESENT(PHC)) THEN
+ ZHC(:) = PHC(JI,:)
+ ELSE
+ ZHC(:) = 1.
+ ENDIF
+ !
+ CALL AV_THERMAL_DATA(IOUT,PD(JI,:),ZD_IN(1:IIN),ZD_OUT(1:IOUT),ZHC,ZW,ZHC_OUT,ZW_OUT)
+ !
+ IF (PRESENT(PTC_OUT)) THEN
+ PTC_OUT(JI,:)=XUNDEF
+ WHERE (ZW_OUT(:)/=XUNDEF) PTC_OUT(JI,:)=1./ZW_OUT(:)
+ ENDIF
+ IF (PRESENT(PHC_OUT)) PHC_OUT(JI,:) = ZHC_OUT(:)
+ !
+ENDDO
+!$OMP END DO
+IF (LHOOK) CALL DR_HOOK('THERMAL_LAYER_CONF_2',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
!
-DO JOUT=1,IOUT
- WHERE (PD(:,1)==XUNDEF) PD_OUT(:,JOUT) = XUNDEF
-END DO
!-------------------------------------------------------------------------------
+CONTAINS
+!-------------------------------------------------------------------------------
+SUBROUTINE AV_THERMAL_DATA(KOUT,PDD,PDD_IN,PDD_OUT,PF1,PF2,PF1_OUT,PF2_OUT)
!
-!* Averaging of the Heat Capacity and the Thermal conductivity
+IMPLICIT NONE
!
-ZW=1./PTC(:,:)
- CALL AV_THERMAL_DATA(PHC,ZW,PHC_OUT,ZW_OUT)
-PTC_OUT=XUNDEF
-WHERE (ZW_OUT/=XUNDEF) PTC_OUT=1./ZW_OUT
-!
-!-------------------------------------------------------------------------------
- CONTAINS
-!-------------------------------------------------------------------------------
-SUBROUTINE AV_THERMAL_DATA(PF1,PF2,PF1_OUT,PF2_OUT)
-REAL, DIMENSION(:,:), INTENT(IN) :: PF1
-REAL, DIMENSION(:,:), INTENT(IN) :: PF2
-REAL, DIMENSION(:,:), INTENT(OUT) :: PF1_OUT
-REAL, DIMENSION(:,:), INTENT(OUT) :: PF2_OUT
+INTEGER, INTENT(IN) :: KOUT
+REAL, DIMENSION(:), INTENT(IN) :: PDD
+REAL, DIMENSION(:), INTENT(IN) :: PDD_IN
+REAL, DIMENSION(:), INTENT(IN) :: PDD_OUT
+REAL, DIMENSION(:), INTENT(IN) :: PF1
+REAL, DIMENSION(:), INTENT(IN) :: PF2
+REAL, DIMENSION(:), INTENT(OUT) :: PF1_OUT
+REAL, DIMENSION(:), INTENT(OUT) :: PF2_OUT
!
REAL :: ZF1! ponderated field
REAL :: ZF2! ponderated field
@@ -170,52 +214,211 @@ REAL :: ZS ! sum of weights
REAL :: ZC ! coefficient of ponderation
REAL :: ZD_LIM ! limit of previous layer that has been treated
!
-INTEGER :: JL ! loop counter on spatial points
REAL :: ZEPS=1.E-6
!
-DO JL=1,SIZE(PF1,1)
- IF (PD(JL,1)==XUNDEF) THEN
- PF1_OUT(JL,:) = XUNDEF
- PF2_OUT(JL,:) = XUNDEF
- CYCLE
- END IF
- !
- ZF1 = 0.
- ZF2 = 0.
- ZS = 0.
- JIN = 1
- JOUT= 1
- ZD_LIM = 0.
- DO
- IF (JOUT>IOUT) EXIT
- !
- IF (ZD_IN(JL,JIN)< ZD_OUT(JL,JOUT)-ZEPS) THEN
-! ZC = ZD_IN(JL,JIN) - MAX(ZD_IN(JL,JIN-1),ZD_OUT(JL,JOUT-1))
- ZC = ZD_IN(JL,JIN) - ZD_LIM
- ZF1 = ZF1 + ZC * PF1(JL,JIN)
- ZF2 = ZF2 + ZC * PF2(JL,JIN)
- ZS = ZS + ZC
- ZD_LIM = ZD_IN(JL,JIN)
+INTEGER :: JOUT, JIN
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!* total depth:
+!
+!
+IF (PDD(1)==XUNDEF) THEN
+ PF1_OUT(:) = XUNDEF
+ PF2_OUT(:) = XUNDEF
+ !
+ELSE
+ !
+ ZF1 = 0.
+ ZF2 = 0.
+ ZS = 0.
+ JIN = 1
+ JOUT= 1
+ ZD_LIM = 0.
+ !
+ DO
!
- JIN=JIN+1
- ELSE
-! ZC = ZD_OUT(JL,JOUT) - MAX(ZD_IN(JL,JIN-1),ZD_OUT(JL,JOUT-1))
- ZC = ZD_OUT(JL,JOUT) - ZD_LIM
- ZF1 = ZF1 + ZC * PF1(JL,JIN)
- ZF2 = ZF2 + ZC * PF2(JL,JIN)
- ZS = ZS + ZC
- PF1_OUT(JL,JOUT) = ZF1/ZS
- PF2_OUT(JL,JOUT) = ZF2/ZS
- ZD_LIM = ZD_OUT(JL,JOUT)
+ IF (JOUT>KOUT) EXIT
+ !
+ IF (PDD_IN(JIN)< PDD_OUT(JOUT)-ZEPS) THEN
+ !
+ !ZC = PDD_IN(JIN) - MAX(PDD_IN(JIN-1),PDD_OUT(JOUT-1))
+ ZC = PDD_IN(JIN) - ZD_LIM
+ ZF1 = ZF1 + ZC * PF1(JIN)
+ ZF2 = ZF2 + ZC * PF2(JIN)
+ ZS = ZS + ZC
+ ZD_LIM = PDD_IN(JIN)
+ !
+ JIN=JIN+1
+ !
+ ELSE
+ !
+ !ZC = PDD_OUT(JOUT) - MAX(PDD_IN(JIN-1),PDD_OUT(JOUT-1))
+ ZC = PDD_OUT(JOUT) - ZD_LIM
+ ZF1 = ZF1 + ZC * PF1(JIN)
+ ZF2 = ZF2 + ZC * PF2(JIN)
+ ZS = ZS + ZC
+ PF1_OUT(JOUT) = ZF1/ZS
+ PF2_OUT(JOUT) = ZF2/ZS
+ ZD_LIM = PDD_OUT(JOUT)
+ !
+ JOUT = JOUT+1
+ ZF1 = 0.
+ ZF2 = 0.
+ ZS = 0.
+ !
+ END IF
!
- JOUT = JOUT+1
- ZF1 = 0.
- ZF2 = 0.
- ZS = 0.
- END IF
- END DO
-END DO
-!
-END SUBROUTINE
+ END DO
+ !
+ENDIF
+!
+END SUBROUTINE AV_THERMAL_DATA
+!
+! #########
+ SUBROUTINE TEBGRID( PSOILDEPTH, PD_G, PD_G1 )
+
+! ##########################################################################
+!
+!!**** *TEBGRID*
+!!
+!! PURPOSE
+!! -------
+!
+! Calculates the soil grid configuration using a simple
+! geometric relation for all sub-surface layers.
+! This algorithm assumes the total soil depth > 0 m
+!
+!
+!!** METHOD
+!! ------
+!
+! Direct calculation
+!
+!! EXTERNAL
+!! --------
+!
+! None
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Noilhan and Planton (1989)
+!! Belair (1995)
+!! Boone (2000)
+!! Boone et al. (2000)
+!! Habets et al. (2003)
+!!
+!! AUTHOR
+!! ------
+!! A. Boone * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 12/04/03
+!! B. Decharme 12/10 uppermost soil layer set to 1cm
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+!
+REAL, INTENT(IN) :: PSOILDEPTH ! total soil depth (m)
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PD_G ! depth of base of soil layers (m)
+REAL, OPTIONAL, INTENT(IN) :: PD_G1 ! depth of first layer
+!
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: JJ, JI, JNLVL
+!
+!
+REAL, PARAMETER :: ZGRIDFACTOR = 3.0 ! soil depth factor
+! ! of increase with depth
+! ! for all *sub-surface*
+! ! layers. Note, uppermost
+! ! layer fixed by other
+! ! constraints. (-)
+!
+REAL :: ZD_G1 = 0.01 ! uppermost soil layer
+! ! thickness/depth (m)
+! ! Can not be too thin as
+! ! then definition of soil
+! ! properties (i.e. phyiscal
+! ! representation of) and
+! ! accuarcy of
+! ! numerical solution come
+! ! into question. If it is too
+! ! thick, then resolution of
+! ! diurnal cycle not as valid.
+! ! Also chosen to comply with
+! ! remotely sensed soil moisture.
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+! 0. Initialization
+! --------------
+!
+JNLVL = SIZE(PD_G)
+!
+IF (PRESENT(PD_G1)) ZD_G1 = PD_G1
+!
+IF (PSOILDEPTH < JNLVL*ZD_G1) THEN
+ !
+ !* 3. In the LIMIT For extremely thin soils
+ ! ------------------------------------------
+ ! This should be a RARE occurance, but
+ ! accounted for none-the-less ...:
+ ! hold the ratio between all layer
+ ! thicknesses constant.
+ DO JJ = 1,JNLVL
+ PD_G(JJ) = JJ*PSOILDEPTH/JNLVL
+ ENDDO
+ !
+ELSE
+ !
+ PD_G(1) = ZD_G1
+ PD_G(JNLVL) = PSOILDEPTH
+ !
+ DO JJ=JNLVL-1,2,-1
+ !* 1. Assign soil layer depths
+ ! ------------------------
+ ! using a geometric relation
+ ! for layers 2...N
+ ! This is GENERAL rule.
+ ! Note that the first soil layer
+ ! is FIXED except for VERY thin
+ ! soils (see #3 below).
+ PD_G(JJ) = PD_G(JJ+1)/ZGRIDFACTOR
+ !* 2. When the soil is sufficiently thin
+ ! ------------------------------------------
+ ! We recalculate layer depths such
+ ! that all layer thicknesses are >= ZD_G1
+ ! We favor keeping a minimum grid thickness
+ ! OVER maintaining geometric relation
+ ! for increasingly thin soils. This means
+ ! that uppermost soil moisture is readily
+ ! comparable (i.e. for same layer thickness)
+ ! EVERYWHERE except for most thin soils (below).
+ PD_G(JJ) = MAX(PD_G(JJ), JJ*ZD_G1)
+ !
+ ENDDO
+ !
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE TEBGRID
!
END SUBROUTINE THERMAL_LAYERS_CONF
diff --git a/src/SURFEX/town_presence.F90 b/src/SURFEX/town_presence.F90
index 70e191dbcc2fdd9a015090d067ed8bbe19e9c85f..85c57afcd6002ad4b09525970fa72bbc42731855 100644
--- a/src/SURFEX/town_presence.F90
+++ b/src/SURFEX/town_presence.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE TOWN_PRESENCE (&
- HFILETYPE,OTEB)
+SUBROUTINE TOWN_PRESENCE (HFILETYPE,OTEB,HDIR)
! #################################################################################
!
!
@@ -23,9 +22,11 @@ IMPLICIT NONE
!
CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! type of input file
LOGICAL, INTENT(OUT) :: OTEB ! TRUE if TEB data exist in the file
+ CHARACTER(LEN=1), INTENT(IN), OPTIONAL :: HDIR
!
!* 0.2 declarations of local variables
!
+ CHARACTER(LEN=1) :: YDIR
INTEGER :: IRESP ! reading return code
CHARACTER(LEN=6) :: YTOWN ! scheme for towns in input file
INTEGER :: IDIM_TOWN ! number of TEB points in input file
@@ -37,10 +38,13 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('TOWN_PRESENCE',0,ZHOOK_HANDLE)
!
- CALL READ_SURF(&
- HFILETYPE,'TOWN',YTOWN,IRESP)
- CALL READ_SURF(&
- HFILETYPE,'DIM_TOWN',IDIM_TOWN,IRESP)
+YDIR = 'H'
+IF (PRESENT(HDIR)) YDIR = HDIR
+!
+YTOWN = ''
+IDIM_TOWN = 0
+ CALL READ_SURF(HFILETYPE,'TOWN',YTOWN,IRESP,HDIR=YDIR)
+ CALL READ_SURF(HFILETYPE,'DIM_TOWN',IDIM_TOWN,IRESP,HDIR=YDIR)
!
OTEB = (YTOWN=='TEB ') .AND. (IDIM_TOWN > 0)
IF (LHOOK) CALL DR_HOOK('TOWN_PRESENCE',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/trans_chaine.F90 b/src/SURFEX/trans_chaine.F90
index 5f0d4d3f616de2d7f48edebcb5ea5a9bf4de2b6a..7dcf29b8e08921e48c656992f54236d5b28fab21 100644
--- a/src/SURFEX/trans_chaine.F90
+++ b/src/SURFEX/trans_chaine.F90
@@ -22,9 +22,9 @@ USE PARKIND1 ,ONLY : JPRB
IMPLICIT NONE
!
INTEGER, INTENT(IN ) :: KENTIER, KOPTION
- CHARACTER(LEN=*), INTENT(OUT) :: HCHAINE
+CHARACTER(LEN=*), INTENT(OUT) :: HCHAINE
!
- CHARACTER :: YC
+CHARACTER :: YC
INTEGER :: IDIVI
INTEGER :: IRESTE, INBDIGIT, INUM
INTEGER:: I, J
diff --git a/src/SURFEX/treat_bathyfield.F90 b/src/SURFEX/treat_bathyfield.F90
index 77de812e108d7d348ed1103d4bf33ad0f250802c..616da4fc47aed16d576ed50dd63196c2ff837eca 100644
--- a/src/SURFEX/treat_bathyfield.F90
+++ b/src/SURFEX/treat_bathyfield.F90
@@ -47,8 +47,15 @@
!
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_PGDWORK, ONLY : NSIZE, NSIZE_ALL, XALL, XSUMVAL
+!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NPROC, NCOMM, NREQ, NINDEX, IDX_R, &
+ NSIZE_TASK,NREQ, NSIZE_max=>NSIZE
+!
+USE MODI_INI_SSOWORK
USE MODI_GET_LUOUT
USE MODI_READ_DIRECT
USE MODI_READ_BINLLV
@@ -56,7 +63,7 @@ USE MODI_READ_BINLLVFAST
USE MODI_READ_ASCLLV
USE MODI_READ_NETCDF
USE MODI_AVERAGE2_MESH
-!
+USE MODI_READ_AND_SEND_MPI
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -71,13 +78,17 @@ USE MODI_AVERAGE2_OROGRAPHY
USE MODI_READ_DIRECT_GAUSS
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1 Declaration of arguments
! ------------------------
!
!
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
CHARACTER(LEN=6), INTENT(IN) :: HSCHEME ! Scheme treated
@@ -92,8 +103,18 @@ REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PPGDARRAY ! field on MESONH grid
!* 0.2 Declaration of local variables
! ------------------------------
!
-INTEGER :: ILUOUT
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZPGDARRAY
+INTEGER, DIMENSION(:), ALLOCATABLE :: IMASK
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZVAL
+INTEGER, DIMENSION(:), ALLOCATABLE :: ISIZE
+!
+#ifdef SFX_MPI
+INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+INTEGER, DIMENSION(MPI_STATUS_SIZE,NPROC-1) :: ISTATUS2
+#endif
+INTEGER :: ILUOUT, INFOMPI, JP, ICPT, JI, JL, IREQ, IDX,&
+ IDX_SAVE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('TREAT_BATHYFIELD',0,ZHOOK_HANDLE)
@@ -105,52 +126,125 @@ IF (LHOOK) CALL DR_HOOK('TREAT_BATHYFIELD',0,ZHOOK_HANDLE)
SELECT CASE (HFILETYPE)
CASE ('DIRECT')
- IF(UG%CGRID=="GAUSS ")THEN
- CALL READ_DIRECT_GAUSS(USS, &
+ IF(UG%G%CGRID=="GAUSS ")THEN
+ CALL READ_DIRECT_GAUSS(UG, U, USS, &
HPROGRAM,HSCHEME,HSUBROUTINE,HFILENAME,HFIELD)
ELSE
- CALL READ_DIRECT(USS, &
+ CALL READ_DIRECT(UG, U, USS, &
HPROGRAM,HSCHEME,HSUBROUTINE,HFILENAME,HFIELD)
ENDIF
CASE ('BINLLV')
- CALL READ_BINLLV(USS, &
+ CALL INI_SSOWORK
+ IF (NRANK==NPIO) CALL READ_BINLLV(UG, U, USS, &
HPROGRAM,HSUBROUTINE,HFILENAME)
CASE ('BINLLF')
- CALL READ_BINLLVFAST(USS, &
+ CALL INI_SSOWORK
+ IF (NRANK==NPIO) CALL READ_BINLLVFAST(UG, U, USS, &
HPROGRAM,HSUBROUTINE,HFILENAME)
CASE ('ASCLLV')
- CALL READ_ASCLLV(USS, &
+ CALL INI_SSOWORK
+ IF (NRANK==NPIO) CALL READ_ASCLLV(UG, U, USS, &
HPROGRAM,HSUBROUTINE,HFILENAME)
CASE ('NETCDF')
- CALL READ_NETCDF(USS, &
+ CALL INI_SSOWORK
+ IF (NRANK==NPIO) CALL READ_NETCDF(UG, U, USS, &
HPROGRAM,HSUBROUTINE,HFILENAME,HNCVARNAME)
END SELECT
!
!-------------------------------------------------------------------------------
!
+!nsize contains the number of points found for each of the domain, for each task
+ALLOCATE(NSIZE(U%NSIZE_FULL,1))
+!
+IF (NPROC>1) THEN
+ !
+ ALLOCATE(ISIZE(NSIZE_max))
+ !
+ IDX_SAVE = IDX_R
+ IDX = IDX_SAVE + NRANK
+ !each task sends to each other task the part of NSIZE_ALL it got, stored in
+ !isize
+ CALL READ_AND_SEND_MPI(NSIZE_ALL(:,1),ISIZE(1:NSIZE_TASK(NRANK)),KPIO=NRANK,KDX=IDX)
+ !
+ NSIZE(:,1) = 0
+ !for each task
+ DO JP=0,NPROC-1
+ !
+ IF (JP/=NRANK) THEN
+ !
+#ifdef SFX_MPI
+ !each task receives each ISIZE from each task
+ CALL MPI_RECV(ISIZE,NSIZE_max*KIND(ISIZE)/4,MPI_INTEGER,&
+ JP,IDX_SAVE+1+JP,NCOMM,ISTATUS,INFOMPI)
+#endif
+ !
+ ELSE
+ !
+ ICPT = 0
+ DO JI = 1,SIZE(NINDEX)
+ IF (NINDEX(JI)==JP) THEN
+ ICPT = ICPT + 1
+ ISIZE(ICPT) = NSIZE_ALL(JI,1)
+ ENDIF
+ ENDDO
+ !
+ ENDIF
+ !
+ !nsize is the sum of all parts isize
+ NSIZE(:,1) = NSIZE(:,1) + ISIZE(1:NSIZE_TASK(NRANK))
+ !
+ ENDDO
+ DEALLOCATE(ISIZE)
+#ifdef SFX_MPI
+ CALL MPI_WAITALL(NPROC-1,NREQ(1:NPROC-1),ISTATUS2,INFOMPI)
+#endif
+ELSE
+ NSIZE(:,1) = NSIZE_ALL(:,1)
+ENDIF
+!
+!
+DEALLOCATE(NSIZE_ALL)
+!
+!
+SELECT CASE (HSUBROUTINE)
+
+ CASE ('A_MESH')
+ !most simple case
+ ALLOCATE(XSUMVAL(U%NSIZE_FULL,1))
+ IF (NPROC>1) THEN
+ XSUMVAL(:,:) = 0.
+ ALLOCATE(ZVAL(U%NSIZE_FULL,1))
+ DO JP = 0,NPROC-1
+ CALL READ_AND_SEND_MPI(XALL(:,:,1),ZVAL,KPIO=JP)
+ XSUMVAL(:,:) = XSUMVAL(:,:) + ZVAL(:,:)
+ ENDDO
+ DEALLOCATE(ZVAL)
+ ELSE
+ XSUMVAL(:,:) = XALL(:,:,1)
+ ENDIF
+ DEALLOCATE(XALL)
+ !
+END SELECT
+!
!* 2. Call to the adequate subroutine (global treatment)
! --------------------------------------------------
!
SELECT CASE (HSUBROUTINE)
- CASE ('A_COVR')
- CALL AVERAGE2_COVER(U, &
- HPROGRAM)
-
- CASE ('A_OROG')
- CALL AVERAGE2_OROGRAPHY(USS)
-
CASE ('A_MESH')
IF (.NOT. PRESENT(PPGDARRAY)) THEN
WRITE(ILUOUT,*) 'You asked to average a PGD field with A_MESH option,'
WRITE(ILUOUT,*) 'but you did not give the array to store this field'
CALL ABOR1_SFX('TREAT_BATHYFIELD: PGD ARRAY IS MISSING')
END IF
- CALL AVERAGE2_MESH(PPGDARRAY)
+ ALLOCATE(ZPGDARRAY(SIZE(PPGDARRAY),1))
+ CALL AVERAGE2_MESH(ZPGDARRAY)
+ PPGDARRAY = ZPGDARRAY(:,1)
+ DEALLOCATE(ZPGDARRAY)
END SELECT
IF (LHOOK) CALL DR_HOOK('TREAT_BATHYFIELD',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/treat_field.F90 b/src/SURFEX/treat_field.F90
index 57ec445916f3409926315d000a9ce4ed458e74d6..8e52f043d0a8c12454420a3a61894a7ce9f2c90f 100644
--- a/src/SURFEX/treat_field.F90
+++ b/src/SURFEX/treat_field.F90
@@ -6,7 +6,7 @@
SUBROUTINE TREAT_FIELD (UG, U, USS, &
HPROGRAM,HSCHEME,HFILETYPE, &
HSUBROUTINE,HFILENAME,HFIELD, &
- PPGDARRAY,HSFTYPE )
+ PPGDARRAY )
! ##############################################################
!
!!**** *TREAT_FIELD* chooses which treatment subroutine to use
@@ -54,8 +54,22 @@
!
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_PGDWORK, ONLY : NSIZE, NSIZE_ALL, XALL, NSSO_ALL, XSSO_ALL, &
+ XSUMVAL, XEXT_ALL, CATYPE, &
+ XSSQO, LSSQO, NSSO, XMIN_WORK, XMAX_WORK, &
+ NVALNBR, NVALCOUNT, XVALLIST, JPVALMAX
+!
+USE MODD_SURFEX_OMP, ONLY : NBLOCKTOT
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NPROC, NCOMM, NREQ, NINDEX, IDX_R, &
+ NSIZE_TASK,NREQ, NSIZE_max=>NSIZE
+!
+USE MODD_DATA_LAKE, ONLY : NGRADDEPTH_LDB, NGRADSTATUS_LDB
+USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
+!
+USE MODI_INI_SSOWORK
USE MODI_GET_LUOUT
USE MODI_READ_DIRECT
USE MODI_READ_DIRECT_GAUSS
@@ -63,34 +77,32 @@ USE MODI_READ_LATLON
USE MODI_READ_BINLLV
USE MODI_READ_BINLLVFAST
USE MODI_READ_ASCLLV
-
+USE MODI_READ_AND_SEND_MPI
USE MODI_READ_PGD_NETCDF
-
USE MODI_AVERAGE2_MESH
-!
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
+USE MODI_MAKE_LCOVER
USE MODI_ABOR1_SFX
-!
USE MODI_AVERAGE2_COVER
-!
USE MODI_AVERAGE2_CTI
USE MODI_AVERAGE2_LDB
-!
USE MODI_AVERAGE2_OROGRAPHY
!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
!* 0.1 Declaration of arguments
! ------------------------
!
!
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
CHARACTER(LEN=6), INTENT(IN) :: HSCHEME ! Scheme treated
@@ -98,68 +110,437 @@ TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
CHARACTER(LEN=6), INTENT(IN) :: HSUBROUTINE ! Name of the subroutine to call
CHARACTER(LEN=28), INTENT(IN) :: HFILENAME ! Name of the field file.
CHARACTER(LEN=20), INTENT(IN) :: HFIELD ! Name of the field.
-REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PPGDARRAY ! field on MESONH grid
- CHARACTER(LEN=3), INTENT(IN), OPTIONAL :: HSFTYPE
+REAL, DIMENSION(:,:), INTENT(INOUT), OPTIONAL :: PPGDARRAY ! field on MESONH grid
!
!* 0.2 Declaration of local variables
! ------------------------------
!
-INTEGER :: ILUOUT
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: I3D_ALL
+INTEGER, DIMENSION(:), ALLOCATABLE :: IMASK
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZVALLIST, ZVAL
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZEXTVAL
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: ISIZE0
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: IVALNBR
+INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: IVALCOUNT
+INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: ISIZE
+!
+INTEGER :: IMAX ! Maximum of times a value has been encountered in the grid mesh
+INTEGER :: IVAL ! Index of this value
+#ifdef SFX_MPI
+INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+INTEGER, DIMENSION(MPI_STATUS_SIZE,NPROC-1) :: ISTATUS2
+#endif
+INTEGER, DIMENSION(0:NPROC-1) :: ITCOV
+INTEGER :: ILUOUT, IS2, INFOMPI, JP, ICPT, JCOV, JI, JL, IREQ, IDX,&
+ IDX_SAVE, JT
+LOGICAL :: GMULTITYPE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!-------------------------------------------------------------------------------
!
-IF (LHOOK) CALL DR_HOOK('TREAT_FIELD',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('TREAT_FIELD_1',0,ZHOOK_HANDLE)
CALL GET_LUOUT(HPROGRAM,ILUOUT)
!
!* 1. Selection of type of reading (and point by point treatment)
! -----------------------------------------------------------
!
+GMULTITYPE = .FALSE.
+IF (HFILETYPE=='DIRTYP') GMULTITYPE = .TRUE.
+!
SELECT CASE (HFILETYPE)
- CASE ('DIRECT')
- IF(UG%CGRID=="GAUSS " .OR. UG%CGRID=="IGN " .OR. UG%CGRID=="LONLAT REG")THEN
- CALL READ_DIRECT_GAUSS(USS, &
- HPROGRAM,HSCHEME,HSUBROUTINE,HFILENAME,HFIELD)
- ELSE
- CALL READ_DIRECT(USS, &
- HPROGRAM,HSCHEME,HSUBROUTINE,HFILENAME,HFIELD)
- ENDIF
+ CASE ('DIRECT','DIRTYP')
+ IF(UG%G%CGRID=="GAUSS " .OR. UG%G%CGRID=="IGN " .OR. UG%G%CGRID=="LONLAT REG")THEN
+ CALL READ_DIRECT_GAUSS(UG, U, USS, &
+ HPROGRAM,HSCHEME,HSUBROUTINE,HFILENAME,HFIELD,GMULTITYPE)
+ ELSE
+ CALL READ_DIRECT(UG, U, USS, &
+ HPROGRAM,HSCHEME,HSUBROUTINE,HFILENAME,HFIELD,GMULTITYPE)
+ ENDIF
- CASE ('BINLLV')
- CALL READ_BINLLV(USS, &
+ CASE ('BINLLV')
+ IF (HSUBROUTINE=='A_OROG') CALL INI_SSOWORK
+ IF (NRANK==NPIO) CALL READ_BINLLV(UG, U, USS, &
HPROGRAM,HSUBROUTINE,HFILENAME)
- CASE ('BINLLF')
- CALL READ_BINLLVFAST(USS, &
+ CASE ('BINLLF')
+ IF (HSUBROUTINE=='A_OROG') CALL INI_SSOWORK
+ IF (NRANK==NPIO) CALL READ_BINLLVFAST(UG, U, USS, &
HPROGRAM,HSUBROUTINE,HFILENAME)
- CASE ('ASCLLV')
- CALL READ_ASCLLV(USS, &
+ CASE ('ASCLLV')
+ IF (HSUBROUTINE=='A_OROG') CALL INI_SSOWORK
+ IF (NRANK==NPIO) CALL READ_ASCLLV(UG, U, USS, &
HPROGRAM,HSUBROUTINE,HFILENAME)
- CASE ('LATLON')
- CALL READ_LATLON(USS, &
+ CASE ('LATLON')
+ IF (HSUBROUTINE=='A_OROG') CALL INI_SSOWORK
+ IF (NRANK==NPIO) CALL READ_LATLON(UG, U, USS, &
HPROGRAM,HSCHEME,HSUBROUTINE,HFILENAME)
- CASE ('NETCDF')
- CALL READ_PGD_NETCDF(USS, &
+ CASE ('NETCDF')
+ IF (HSUBROUTINE=='A_OROG') CALL INI_SSOWORK
+ IF (NRANK==NPIO) CALL READ_PGD_NETCDF(UG, U, USS, &
HPROGRAM,HSCHEME,HSUBROUTINE,HFILENAME,HFIELD)
- CASE DEFAULT
- CALL ABOR1_SFX('TREAT_FIELD: FILE TYPE NOT SUPPORTED: '//HFILETYPE)
+ CASE DEFAULT
+ CALL ABOR1_SFX('TREAT_FIELD: FILE TYPE NOT SUPPORTED: '//HFILETYPE)
END SELECT
!
!-------------------------------------------------------------------------------
!
+!nsize contains the number of points found for each of the domain, for each task
+ALLOCATE(NSIZE(U%NSIZE_FULL,SIZE(NSIZE_ALL,2)))
+!
+IF (LHOOK) CALL DR_HOOK('TREAT_FIELD_1',1,ZHOOK_HANDLE)
+!
+IF (NPROC>1) THEN
+ !
+ IF (HFILETYPE=='DIRECT'.OR.HFILETYPE=='DIRTYP') THEN
+ !
+ IF (LHOOK) CALL DR_HOOK('TREAT_FIELD_21',0,ZHOOK_HANDLE)
+ !
+ ALLOCATE(ISIZE (NSIZE_max,SIZE(NSIZE_ALL,2),NPROC))
+ ALLOCATE(ISIZE0(NSIZE_max,SIZE(NSIZE_ALL,2)))
+ !
+ IDX_SAVE = IDX_R
+ IDX = IDX_SAVE + NRANK
+ !
+ IDX = IDX + 1
+ ISIZE(:,:,:) = 0
+ !
+ IF (LHOOK) CALL DR_HOOK('TREAT_FIELD_21',1,ZHOOK_HANDLE)
+ !
+!$OMP PARALLEL PRIVATE(ZHOOK_HANDLE_OMP)
+ IF (LHOOK) CALL DR_HOOK('TREAT_FIELD_22',0,ZHOOK_HANDLE_OMP)
+!$OMP DO SCHEDULE(DYNAMIC,1) PRIVATE(JP,ICPT,JI,IREQ,INFOMPI)
+ DO JP=0,NPROC-1
+ IF (JP/=NRANK) THEN
+ ICPT = 0
+ DO JI = 1,SIZE(NINDEX)
+ IF (NINDEX(JI)==JP) THEN
+ ICPT = ICPT + 1
+ ISIZE(ICPT,:,JP+1) = NSIZE_ALL(JI,:)
+ ENDIF
+ ENDDO
+ IF (JP<NRANK) THEN
+ IREQ = JP+1
+ ELSE
+ IREQ = JP
+ ENDIF
+#ifdef SFX_MPI
+ CALL MPI_ISEND(ISIZE(:,:,JP+1),SIZE(ISIZE,1)*SIZE(ISIZE,2)*KIND(ISIZE)/4,&
+ MPI_INTEGER,JP,IDX,NCOMM,NREQ(IREQ),INFOMPI)
+#endif
+ ENDIF
+ ENDDO
+!$OMP END DO
+ IF (LHOOK) CALL DR_HOOK('TREAT_FIELD_22',1,ZHOOK_HANDLE_OMP)
+!$OMP END PARALLEL
+ !
+ IF (LHOOK) CALL DR_HOOK('TREAT_FIELD_23',0,ZHOOK_HANDLE)
+ !
+ NSIZE(:,:) = 0
+ !for each task
+ DO JP=0,NPROC-1
+ !
+ ISIZE0(:,:) = 0
+ !
+ IF (JP/=NRANK) THEN
+ !each task receives each ISIZE from each task
+#ifdef SFX_MPI
+ CALL MPI_RECV(ISIZE0,NSIZE_max*SIZE(ISIZE0,2)*KIND(ISIZE0)/4,MPI_INTEGER,&
+ JP,IDX_SAVE+1+JP,NCOMM,ISTATUS,INFOMPI)
+#endif
+ ELSE
+ !
+ ICPT = 0
+ DO JI = 1,SIZE(NINDEX)
+ IF (NINDEX(JI)==JP) THEN
+ ICPT = ICPT + 1
+ ISIZE0(ICPT,:) = NSIZE_ALL(JI,:)
+ ENDIF
+ ENDDO
+ !
+ ENDIF
+ !
+ !nsize is the sum of all parts isize
+ NSIZE(:,:) = NSIZE(:,:) + ISIZE0(1:NSIZE_TASK(NRANK),:)
+ !
+ ENDDO
+#ifdef SFX_MPI
+ CALL MPI_WAITALL(NPROC-1,NREQ(1:NPROC-1),ISTATUS2,INFOMPI)
+#endif
+ !
+ DEALLOCATE(ISIZE,ISIZE0)
+ !
+ IDX_R = IDX_R + NPROC
+ !
+ IF (LHOOK) CALL DR_HOOK('TREAT_FIELD_23',1,ZHOOK_HANDLE)
+ !
+ ELSE
+ !
+ IF (LHOOK) CALL DR_HOOK('TREAT_FIELD_3',0,ZHOOK_HANDLE)
+ !
+ CALL READ_AND_SEND_MPI(NSIZE_ALL,NSIZE)
+ !
+ IF (LHOOK) CALL DR_HOOK('TREAT_FIELD_3',1,ZHOOK_HANDLE)
+ !
+ ENDIF
+ !
+ELSE
+ IF (LHOOK) CALL DR_HOOK('TREAT_FIELD_4',0,ZHOOK_HANDLE)
+ NSIZE(:,:) = NSIZE_ALL(:,:)
+ IF (LHOOK) CALL DR_HOOK('TREAT_FIELD_4',1,ZHOOK_HANDLE)
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('TREAT_FIELD_5',0,ZHOOK_HANDLE)
+!
+DEALLOCATE(NSIZE_ALL)
+!
+!
+IF (HSUBROUTINE=='A_COVR') THEN
+ IS2 = SIZE(XALL,2)
+ELSEIF (HSUBROUTINE=='A_LDBS') THEN
+ IS2 = NGRADSTATUS_LDB
+ELSEIF (HSUBROUTINE=='A_LDBD') THEN
+ IS2 = NGRADDEPTH_LDB
+ELSEIF (HSUBROUTINE=='A_OROG') THEN
+ IS2 = 2
+ELSEIF (HSUBROUTINE=='A_CTI ') THEN
+ IS2 = 3
+ENDIF
+!
+!
+SELECT CASE (HSUBROUTINE)
+
+ CASE ('A_COVR')
+ !
+ !to gather the parts of LCOVER sparsed among the tasks
+ CALL MAKE_LCOVER(U%LCOVER)
+ !
+ !contains the indexes of the covers in XCOVER, associated to their effective
+ !num
+ ALLOCATE(IMASK(SIZE(U%LCOVER)))
+ IMASK(:) = 0
+ ICPT = 0
+ DO JCOV = 1,SIZE(U%LCOVER)
+ IF (U%LCOVER(JCOV)) THEN
+ ICPT = ICPT + 1
+ IMASK(JCOV) = ICPT
+ ENDIF
+ ENDDO
+ !
+ !because each task did not necessarily meet the same number of coves, itcov
+ !contains the numbers of covers met for all tasks
+ IF (NPROC>1) THEN
+#ifdef SFX_MPI
+ CALL MPI_ALLGATHER(IS2,KIND(IS2)/4,MPI_INTEGER,&
+ ITCOV,KIND(ITCOV)/4,MPI_INTEGER,NCOMM,INFOMPI)
+#endif
+ ELSE
+ ITCOV(:) = IS2
+ ENDIF
+ !
+ !XSUMVAL needs to contain the numbers of times each cover is encountered
+ !for the current task
+ ALLOCATE(XSUMVAL(U%NSIZE_FULL,COUNT(U%LCOVER)))
+ XSUMVAL(:,:) = 0.
+ !
+ IF (NPROC>1) THEN
+ ALLOCATE(ZVAL(U%NSIZE_FULL,MAXVAL(ITCOV),2))
+ DO JP = 0,NPROC-1
+ !the part of XALL concerning the current task is sent
+ !from each other task
+ CALL READ_AND_SEND_MPI(XALL,ZVAL(:,1:ITCOV(JP),:),KPIO=JP)
+ DO JL = 1,ITCOV(JP)
+ DO JI=1,U%NSIZE_FULL
+ JCOV = NINT(ZVAL(JI,JL,1))
+ IF (JCOV/=0) THEN
+ !xsumval2 is the sum of contributions zsumval3 coming from all tasks
+ XSUMVAL(JI,IMASK(JCOV)) = XSUMVAL(JI,IMASK(JCOV)) + ZVAL(JI,JL,2)
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ DEALLOCATE(ZVAL)
+ ELSE
+ DO JL = 1,SIZE(XALL,2)
+ DO JI=1,SIZE(XALL,1)
+ JCOV = NINT(XALL(JI,JL,1))
+ IF (JCOV/=0) THEN
+ XSUMVAL(JI,IMASK(JCOV)) = XSUMVAL(JI,IMASK(JCOV)) + XALL(JI,JL,2)
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDIF
+ DEALLOCATE(XALL,IMASK)
+ !
+ !
+ CASE ('A_LDBD','A_LDBS','A_OROG','A_CTI ')
+ !
+ !XSUMVAL needs to contain the numbers of times each quantity is encountered
+ !for the current task
+ ALLOCATE(XSUMVAL(U%NSIZE_FULL,IS2))
+ XSUMVAL(:,:) = 0.
+ IF (NPROC>1) THEN
+ ALLOCATE(ZVAL(U%NSIZE_FULL,IS2,1))
+ DO JP = 0,NPROC-1
+ CALL READ_AND_SEND_MPI(XALL(:,:,1),ZVAL(:,:,1),KPIO=JP)
+ !sum of contributions coming from all tasks
+ XSUMVAL(:,:) = XSUMVAL(:,:) + ZVAL(:,:,1)
+ ENDDO
+ DEALLOCATE(ZVAL)
+ ELSE
+ XSUMVAL(:,:) = XALL(:,:,1)
+ ENDIF
+ DEALLOCATE(XALL)
+ !
+ !
+ IF (HSUBROUTINE=='A_OROG' .OR. HSUBROUTINE=='A_CTI ') THEN
+ !
+ !special fields
+ !
+ IF (HSUBROUTINE=='A_CTI ') THEN
+ !max and min
+ IF (NPROC>1) THEN
+ ALLOCATE(ZEXTVAL(U%NSIZE_FULL,1))
+ DO JP = 0,NPROC-1
+ CALL READ_AND_SEND_MPI(XEXT_ALL(:,1),ZEXTVAL(:,1),KPIO=JP)
+ XMAX_WORK(:) = MAX(XMAX_WORK,ZEXTVAL(:,1))
+ ENDDO
+ DO JP = 0,NPROC-1
+ CALL READ_AND_SEND_MPI(XEXT_ALL(:,2),ZEXTVAL(:,1),KPIO=JP)
+ XMIN_WORK(:) = MIN(XMIN_WORK,ZEXTVAL(:,1))
+ ENDDO
+ DEALLOCATE(ZEXTVAL)
+ ELSE
+ XMAX_WORK(:) = XEXT_ALL(:,1)
+ XMIN_WORK(:) = XEXT_ALL(:,2)
+ ENDIF
+ !
+ ELSEIF (HSUBROUTINE=='A_OROG') THEN
+ !max and min
+ IF (NPROC>1) THEN
+ ALLOCATE(ZEXTVAL(U%NSIZE_FULL,1))
+ DO JP = 0,NPROC-1
+ CALL READ_AND_SEND_MPI(XEXT_ALL(:,1),ZEXTVAL(:,1),KPIO=JP)
+ USS%XMAX_ZS(:) = MAX(USS%XMAX_ZS,ZEXTVAL(:,1))
+ ENDDO
+ DO JP = 0,NPROC-1
+ CALL READ_AND_SEND_MPI(XEXT_ALL(:,2),ZEXTVAL(:,1),KPIO=JP)
+ USS%XMIN_ZS(:) = MIN(USS%XMIN_ZS,ZEXTVAL(:,1))
+ ENDDO
+ DEALLOCATE(ZEXTVAL)
+ ELSE
+ USS%XMAX_ZS(:) = XEXT_ALL(:,1)
+ USS%XMIN_ZS(:) = XEXT_ALL(:,2)
+ ENDIF
+ !
+ !sso fields
+ ALLOCATE(XSSQO(U%NSIZE_FULL,NSSO,NSSO))
+ XSSQO(:,:,:) = -XUNDEF
+ IF (NPROC>1) THEN
+ ALLOCATE(ZVAL(U%NSIZE_FULL,NSSO,NSSO))
+ DO JP = 0,NPROC-1
+ CALL READ_AND_SEND_MPI(XSSO_ALL,ZVAL,KPIO=JP)
+ XSSQO(:,:,:) = MAX(XSSQO(:,:,:),ZVAL)
+ ENDDO
+ DEALLOCATE(ZVAL)
+ ELSE
+ XSSQO(:,:,:) = XSSO_ALL(:,:,:)
+ ENDIF
+ DEALLOCATE(XSSO_ALL)
+ !
+ ALLOCATE(LSSQO(U%NSIZE_FULL,NSSO,NSSO))
+ LSSQO(:,:,:) = .FALSE.
+ IF (NPROC>1) THEN
+ ALLOCATE(I3D_ALL(U%NSIZE_FULL,NSSO,NSSO))
+ DO JP = 0,NPROC-1
+ CALL READ_AND_SEND_MPI(NSSO_ALL,I3D_ALL,KPIO=JP)
+ WHERE (I3D_ALL(:,:,:)==1) LSSQO(:,:,:) = .TRUE.
+ ENDDO
+ DEALLOCATE(I3D_ALL)
+ ELSE
+ WHERE(NSSO_ALL(:,:,:)==1) LSSQO(:,:,:) = .TRUE.
+ ENDIF
+ DEALLOCATE(NSSO_ALL)
+ ENDIF
+ DEALLOCATE(XEXT_ALL)
+ !
+ ENDIF
+ !
+ !
+ CASE ('A_MESH')
+ IF (CATYPE/='MAJ') THEN
+
+ ALLOCATE(XSUMVAL(U%NSIZE_FULL,SIZE(XALL,2)))
+ !most simple case
+ IF (NPROC>1) THEN
+ XSUMVAL(:,:) = 0.
+ ALLOCATE(ZVAL(U%NSIZE_FULL,SIZE(XALL,2),1))
+ DO JP = 0,NPROC-1
+ CALL READ_AND_SEND_MPI(XALL(:,:,1),ZVAL(:,:,1),KPIO=JP)
+ XSUMVAL(:,:) = XSUMVAL(:,:) + ZVAL(:,:,1)
+ ENDDO
+ DEALLOCATE(ZVAL)
+ ELSE
+ XSUMVAL(:,:) = XALL(:,:,1)
+ ENDIF
+ DEALLOCATE(XALL)
+
+ ELSE
+
+ ALLOCATE(XSUMVAL(U%NSIZE_FULL,1))
+ IF (HFILETYPE=='DIRECT' .AND. NPROC>1) THEN
+ CALL ABOR1_SFX("TREAT_FIELD: MAJ is not possible with DIRECT filetype and NPROC>1")
+ ELSE
+ ALLOCATE(IVALNBR(U%NSIZE_FULL,SIZE(NVALNBR,2)),IVALCOUNT(U%NSIZE_FULL,JPVALMAX,SIZE(NVALNBR,2)),&
+ ZVALLIST(U%NSIZE_FULL,JPVALMAX,SIZE(NVALNBR,2)))
+ IF (NPROC>1) THEN
+ CALL READ_AND_SEND_MPI(NVALNBR,IVALNBR)
+ CALL READ_AND_SEND_MPI(NVALCOUNT,IVALCOUNT)
+ CALL READ_AND_SEND_MPI(XVALLIST,ZVALLIST)
+ ELSE
+ IVALNBR = NVALNBR
+ IVALCOUNT = NVALCOUNT
+ ZVALLIST = XVALLIST
+ ENDIF
+ DEALLOCATE(NVALNBR,NVALCOUNT,XVALLIST)
+ DO JT=1,SIZE(NSIZE,2)
+ DO JI=1,SIZE(NSIZE,1)
+ IF(NSIZE(JI,JT)==0) CYCLE
+ !* determines the index of the value which has been the most encountered
+ ! in the grid mesh
+ IMAX=0
+ DO JL=1,IVALNBR(JI,JT)
+ IF (IVALCOUNT(JI,JL,JT)>IMAX) THEN
+ IMAX = IVALCOUNT(JI,JL,JT)
+ IVAL = JL
+ END IF
+ END DO
+ !* sets this value to the PGD field
+ XSUMVAL(JI,JT)=ZVALLIST(JI,IVAL,JT)
+ END DO
+ ENDDO
+ DEALLOCATE(IVALNBR,IVALCOUNT,ZVALLIST)
+ ENDIF
+ ENDIF
+ !
+END SELECT
+!
+IF (LHOOK) CALL DR_HOOK('TREAT_FIELD_5',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------
+!
!* 2. Call to the adequate subroutine (global treatment)
! --------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('TREAT_FIELD_6',0,ZHOOK_HANDLE)
+!
SELECT CASE (HSUBROUTINE)
CASE ('A_COVR')
- CALL AVERAGE2_COVER(U, &
- HPROGRAM)
+ CALL AVERAGE2_COVER(U, HPROGRAM)
CASE ('A_OROG')
CALL AVERAGE2_OROGRAPHY(USS)
@@ -168,10 +549,10 @@ SELECT CASE (HSUBROUTINE)
CALL AVERAGE2_CTI
CASE ('A_LDBD')
- CALL AVERAGE2_LDB(PPGDARRAY,'D',1)
+ CALL AVERAGE2_LDB(PPGDARRAY(:,1),'D',1)
CASE ('A_LDBS')
- CALL AVERAGE2_LDB(PPGDARRAY,'S',1)
+ CALL AVERAGE2_LDB(PPGDARRAY(:,1),'S',1)
CASE ('A_MESH')
IF (.NOT. PRESENT(PPGDARRAY)) THEN
@@ -183,7 +564,7 @@ SELECT CASE (HSUBROUTINE)
END SELECT
!
-IF (LHOOK) CALL DR_HOOK('TREAT_FIELD',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('TREAT_FIELD_6',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
END SUBROUTINE TREAT_FIELD
diff --git a/src/SURFEX/treat_global_lake_depth.F90 b/src/SURFEX/treat_global_lake_depth.F90
index db109579880dfc28cdab213ed3fe5a55f0003908..dc46b20e5e1367dcc17dcd8f08774115bba38a28 100644
--- a/src/SURFEX/treat_global_lake_depth.F90
+++ b/src/SURFEX/treat_global_lake_depth.F90
@@ -40,17 +40,16 @@
!* 0. DECLARATION
! -----------
!
-!
-!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_SSO_n, ONLY : SURF_ATM_SSO_t
+USE MODD_SSO_n, ONLY : SSO_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_PGD_GRID, ONLY : NL
-USE MODD_PGDWORK, ONLY : XTNG, NSIZE
+USE MODD_PGDWORK, ONLY : XALL, NSIZE_ALL, XSUMVAL, NSIZE
USE MODD_DATA_LAKE, ONLY : CLAKELDB, CSTATUSLDB, NGRADDEPTH_LDB, NGRADSTATUS_LDB
!
USE MODI_GET_LUOUT
@@ -73,7 +72,7 @@ IMPLICIT NONE
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_SSO_t), INTENT(INOUT) :: USS
+TYPE(SSO_t), INTENT(INOUT) :: USS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
REAL, DIMENSION(:),INTENT(OUT):: PDEPTH ! physiographic field
@@ -91,7 +90,7 @@ INTEGER :: JI
!
CHARACTER(LEN=6) :: YMASK
INTEGER, DIMENSION(NL) :: ISTATUS
-REAL, DIMENSION(NL) :: ZDEPTH, ZSTATUS ! physiographic field on full grid
+REAL, DIMENSION(NL,1) :: ZDEPTH, ZSTATUS ! physiographic field on full grid
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
@@ -99,8 +98,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ---------------
!
IF (LHOOK) CALL DR_HOOK('TREAT_GLOBAL_LAKE_DEPTH',0,ZHOOK_HANDLE)
-ZDEPTH(:) = XUNDEF
-ZSTATUS(:) = XUNDEF
+ZDEPTH (:,:) = XUNDEF
+ZSTATUS(:,:) = XUNDEF
!-------------------------------------------------------------------------------
!
!* 2. Output listing logical unit
@@ -113,42 +112,45 @@ ZSTATUS(:) = XUNDEF
!* 4. Averages the field
! ------------------
!
-ALLOCATE(NSIZE (NL))
-ALLOCATE(XTNG (NL,NGRADDEPTH_LDB))
+ALLOCATE(NSIZE_ALL(U%NDIM_FULL,1))
+ALLOCATE(XALL (U%NDIM_FULL,NGRADDEPTH_LDB,1))
!
-NSIZE (:) = 0.
-XTNG (:,:) = 0.
+NSIZE_ALL(:,:) = 0.
+XALL (:,:,:) = 0.
!
CALL TREAT_FIELD(UG, U, USS, &
HPROGRAM,'SURF ','DIRECT','A_LDBD', CLAKELDB, &
- 'water depth ',ZDEPTH,'WAT' )
+ 'water depth ',ZDEPTH )
+!
+DEALLOCATE(XSUMVAL)
+DEALLOCATE(NSIZE)
!
-DEALLOCATE(XTNG)
-ALLOCATE(XTNG (NL,NGRADSTATUS_LDB))
+ALLOCATE(NSIZE_ALL(U%NDIM_FULL,1))
+ALLOCATE(XALL (U%NDIM_FULL,NGRADSTATUS_LDB,1))
!
-NSIZE (:) = 0.
-XTNG (:,:) = 0.
+NSIZE_ALL (:,:) = 0.
+XALL (:,:,:) = 0.
!
CALL TREAT_FIELD(UG, U, USS, &
HPROGRAM,'SURF ','DIRECT','A_LDBS', CSTATUSLDB, &
- 'water status ',ZSTATUS,'WAT' )
+ 'water status ',ZSTATUS )
!
-ISTATUS = NINT(ZSTATUS)
+ISTATUS = NINT(ZSTATUS(:,1))
!
+DEALLOCATE(XSUMVAL)
DEALLOCATE(NSIZE)
-DEALLOCATE(XTNG)
!
!-------------------------------------------------------------------------------
!
!* 5. Consistancy check
! ------------------
!
-DO JI = 1, SIZE(ZDEPTH)
+DO JI = 1, SIZE(ZDEPTH,1)
IF (U%XWATER(JI).GT.0.) THEN
- IF (ISTATUS(JI).LE.2) ZDEPTH(JI) = 10.
- IF (ISTATUS(JI)==3.AND.ZDEPTH(JI)==0.) ZDEPTH(JI) = 10.
+ IF (ISTATUS(JI).LE.2) ZDEPTH(JI,1) = 10.
+ IF (ISTATUS(JI)==3.AND.ZDEPTH(JI,1)==0.) ZDEPTH(JI,1) = 10.
ELSE
- ZDEPTH(JI) = 0.
+ ZDEPTH(JI,1) = 0.
ENDIF
ENDDO
!
@@ -167,7 +169,7 @@ ALLOCATE(IMASK(IDIM))
ILU=0
CALL GET_SURF_MASK_n(DTCO, U, &
YMASK,IDIM,IMASK,ILU,ILUOUT)
- CALL PACK_SAME_RANK(IMASK,ZDEPTH(:),PDEPTH(:))
+ CALL PACK_SAME_RANK(IMASK,ZDEPTH(:,1),PDEPTH(:))
CALL PACK_SAME_RANK(IMASK,ISTATUS(:),KSTATUS(:))
DEALLOCATE(IMASK)
!
diff --git a/src/SURFEX/tsz0.F90 b/src/SURFEX/tsz0.F90
index c18c1906882d6f3689fdbf2823d2ab729895be38..3dd2ad798a3ae14317e903f38f04c3594665776b 100644
--- a/src/SURFEX/tsz0.F90
+++ b/src/SURFEX/tsz0.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE TSZ0 (DTZ, &
- PTIME, PTSTEP, PWFC, PTG, PWG )
+ SUBROUTINE TSZ0 (DTZ, PTIME, PTSTEP, KK, PEK )
! ################################################################
!
!
@@ -50,6 +49,7 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_PE_t
!
USE MODD_DATA_TSZ0_n, ONLY : DATA_TSZ0_t
!
@@ -67,22 +67,14 @@ IMPLICIT NONE
!* general variables
! -----------------
!
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
TYPE(DATA_TSZ0_t), INTENT(INOUT) :: DTZ
!
REAL, INTENT(IN) :: PTIME ! Current time
REAL, INTENT(IN) :: PTSTEP ! timestep of the integration
!
-!* soil variables
-! --------------
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PWFC ! field capacity
-!
-!* prognostic variables
-! --------------------
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTG ! surface temperature
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PWG ! near-surface volumetric water
-!
!
!* 0.2 declarations of local variables
!
@@ -128,19 +120,17 @@ ENDIF
!
! temporal interpolation of the surface temperature increment over land at time t
ZA= ZDTS_HOUR /3600. * PTSTEP
-WHERE (PTG(:,:,:)/=XUNDEF)
- PTG(:,:,:)= PTG(:,:,:) + ZA
+WHERE (PEK%XTG(:,:)/=XUNDEF)
+ PEK%XTG(:,:)= PEK%XTG(:,:) + ZA
END WHERE
!
! temporal interpolation of the soil humidity increment at time t
ZA= ZDHUGRD_HOUR /3600.* PTSTEP
-DO JPATCH=1,SIZE(PWG,3)
- WHERE (PWG(:,:,JPATCH)/=XUNDEF)
- PWG(:,:,JPATCH)= ACOS( 1. &
- - 2.* MIN( 0.5 * (1. - COS( XPI * MIN(PWG(:,:,JPATCH) /PWFC(:,:),1.) )) + ZA , 1.) &
- ) / XPI * PWFC(:,:)
- END WHERE
-END DO
+WHERE (PEK%XWG(:,:)/=XUNDEF)
+ PEK%XWG(:,:)= ACOS( 1. &
+ - 2.* MIN( 0.5 * (1. - COS( XPI * MIN(PEK%XWG(:,:) /KK%XWFC(:,:),1.) )) + ZA , 1.) &
+ ) / XPI * KK%XWFC(:,:)
+END WHERE
!
IF (LHOOK) CALL DR_HOOK('TSZ0',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/uncompress_field.F90 b/src/SURFEX/uncompress_field.F90
new file mode 100644
index 0000000000000000000000000000000000000000..fadc0be3f840632dfd4432c870b6173361025bb0
--- /dev/null
+++ b/src/SURFEX/uncompress_field.F90
@@ -0,0 +1,50 @@
+SUBROUTINE UNCOMPRESS_FIELD(KLONG,PSEUIL,PFIELD_IN,PFIELD_OUT)
+
+IMPLICIT NONE
+
+INTEGER*4, INTENT(IN) :: KLONG
+REAL, INTENT(IN) :: PSEUIL
+REAL, DIMENSION(:), INTENT(IN) :: PFIELD_IN
+REAL, DIMENSION(:), INTENT(OUT) :: PFIELD_OUT
+INTEGER :: ICPT, I, K
+
+ICPT = 0
+
+I = 1
+
+PFIELD_OUT(:) = 0.
+!
+! boucle sur les colonnes
+DO
+
+ ! si on a dépassé la dernière colonne, on sort de la boucle
+ IF (ICPT>=KLONG) EXIT
+
+ ! si la valeur est valide
+ IF (PFIELD_IN(I)<PSEUIL) THEN
+
+ ! on la met dans lwrite à l'indice icpt
+ ICPT = ICPT + 1
+ PFIELD_OUT(ICPT) = PFIELD_IN(I)
+!!!!!!!!!!!!!!!!!!!!test temporary: to remove after
+ IF (MOD(PFIELD_OUT(ICPT),100.)==0) PFIELD_OUT(ICPT)=0.
+!!!!!!!!!!!!!!!!!!!!!! to remove after
+ ! on incrémente i
+ I = I+1
+
+ ELSE
+
+ !ideb = icpt + 1
+ DO K = 1,NINT(PFIELD_IN(I)-(PSEUIL))
+ ICPT = ICPT + 1
+ IF (ICPT>KLONG) EXIT
+ PFIELD_OUT(ICPT) = 0.
+ ENDDO
+
+ I = I+1
+
+ ENDIF
+
+ENDDO
+
+END SUBROUTINE UNCOMPRESS_FIELD
diff --git a/src/SURFEX/unpack_ch_isba_patchn.F90 b/src/SURFEX/unpack_ch_isba_patchn.F90
deleted file mode 100644
index e0a6c68bc687a1074868f20ec161aff7d82f387d..0000000000000000000000000000000000000000
--- a/src/SURFEX/unpack_ch_isba_patchn.F90
+++ /dev/null
@@ -1,83 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE UNPACK_CH_ISBA_PATCH_n (CHI, PKCI, &
- KMASK,KSIZE,KNPATCH,KPATCH)
-!##############################################
-!
-!!**** *UNPACK_CH_ISBA_PATCH_n* - unpacks ISBA prognostic variables
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! A. Boone
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!!------------------------------------------------------------------
-!
-!
-!
-USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
-USE MODD_PACK_CH_ISBA, ONLY : PACK_CH_ISBA_t
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!
-TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
-TYPE(PACK_CH_ISBA_t), INTENT(INOUT) :: PKCI
-!
-INTEGER, INTENT(IN) :: KSIZE, KPATCH, KNPATCH
-!
-INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
-!
-INTEGER :: JJ, JI, JSV
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!
-! Only save values for patches which are in use:
-!
-IF (LHOOK) CALL DR_HOOK('UNPACK_CH_ISBA_PATCH_N',0,ZHOOK_HANDLE)
- CHI%XDEP(:,:,KPATCH) = XUNDEF
-!
-IF (KNPATCH==1) THEN
- DO JSV=1,SIZE(CHI%XDEP,2)
- CHI%XDEP(:,JSV,KPATCH) = PKCI%XP_DEP (:,JSV)
- END DO
-
-ELSE
- DO JSV=1,SIZE(CHI%XDEP,2)
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- CHI%XDEP(JI,JSV,KPATCH) = PKCI%XP_DEP (JJ,JSV)
- END DO
- END DO
-END IF
-!
-PKCI%XP_SOILRC_SO2 => NULL()
-PKCI%XP_SOILRC_O3 => NULL()
-!
-DEALLOCATE(PKCI%XBLOCK_SIMPLE)
-DEALLOCATE(PKCI%XP_DEP)
-!
-IF (LHOOK) CALL DR_HOOK('UNPACK_CH_ISBA_PATCH_N',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE UNPACK_CH_ISBA_PATCH_n
diff --git a/src/SURFEX/unpack_diag_patchn.F90 b/src/SURFEX/unpack_diag_patchn.F90
index 18297bce4d8a09b42f2772a9749a27450b6806a0..2fae0423300aa437293189803cb458b276ccd9e9 100644
--- a/src/SURFEX/unpack_diag_patchn.F90
+++ b/src/SURFEX/unpack_diag_patchn.F90
@@ -3,11 +3,9 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE UNPACK_DIAG_PATCH_n (DGI, GB, I, PKDI, PKI, &
- KMASK,KSIZE,KNPATCH,KPATCH, &
- PCPL_DRAIN,PCPL_RUNOFF, &
- PCPL_EFLOOD,PCPL_PFLOOD, &
- PCPL_IFLOOD,PCPL_ICEFLUX )
+SUBROUTINE UNPACK_DIAG_PATCH_n(IO, DEK, PK, KMASK, KSIZE, KNPATCH, KPATCH, &
+ PCPL_DRAIN, PCPL_RUNOFF, PCPL_EFLOOD, &
+ PCPL_PFLOOD, PCPL_IFLOOD, PCPL_ICEFLUX )
!##############################################
!
!!**** *UNPACK_DIAG_PATCH_n* - unpacks ISBA diagnostics
@@ -42,28 +40,18 @@ SUBROUTINE UNPACK_DIAG_PATCH_n (DGI, GB, I, PKDI, PKI, &
!!
!!------------------------------------------------------------------
!
-!
-!
-!
-!
-!
-USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
-USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_PACK_DIAG_ISBA, ONLY : PACK_DIAG_ISBA_t
-USE MODD_PACK_ISBA, ONLY : PACK_ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+USE MODD_ISBA_n, ONLY : ISBA_P_t
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
-!
-TYPE(DIAG_ISBA_t), INTENT(INOUT) :: DGI
-TYPE(GR_BIOG_t), INTENT(INOUT) :: GB
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(PACK_DIAG_ISBA_t), INTENT(INOUT) :: PKDI
-TYPE(PACK_ISBA_t), INTENT(INOUT) :: PKI
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
!
INTEGER, INTENT(IN) :: KSIZE, KPATCH, KNPATCH
INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
@@ -76,7 +64,7 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PCPL_PFLOOD
REAL, DIMENSION(:,:), INTENT(OUT) :: PCPL_IFLOOD
REAL, DIMENSION(:,:), INTENT(OUT) :: PCPL_ICEFLUX
!
-INTEGER :: JJ, JI, JSW
+INTEGER :: JI, IMASK, JSW
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!------------------------------------------------------------------------
@@ -84,354 +72,51 @@ IF (LHOOK) CALL DR_HOOK('UNPACK_DIAG_PATCH_N',0,ZHOOK_HANDLE)
!
IF (KNPATCH==1) THEN
!
- DGI%XTS(:, KPATCH) = PKDI%XP_TS(:)
- DGI%XTSRAD(:, KPATCH) = PKDI%XP_TSRAD(:)
- IF (DGI%N2M>=1) THEN
- DGI%XT2M (:, KPATCH) = PKDI%XP_T2M (:)
- DGI%XQ2M (:, KPATCH) = PKDI%XP_Q2M (:)
- DGI%XHU2M (:, KPATCH) = PKDI%XP_HU2M (:)
- DGI%XZON10M (:, KPATCH) = PKDI%XP_ZON10M (:)
- DGI%XMER10M (:, KPATCH) = PKDI%XP_MER10M (:)
- DGI%XRI (:, KPATCH) = PKDI%XP_RI (:)
-!
- DGI%XWIND10M(:, KPATCH) = SQRT(PKDI%XP_ZON10M(:)**2+PKDI%XP_MER10M(:)**2)
-!
- END IF
- !
- IF (DGI%LSURF_BUDGET) THEN
- DGI%XRN (:, KPATCH) = PKDI%XP_RN (:)
- DGI%XH (:, KPATCH) = PKDI%XP_H (:)
- DGI%XGFLUX (:, KPATCH) = PKDI%XP_GFLUX (:)
- DGI%XLEI (:, KPATCH) = PKDI%XP_LEI (:)
- DGI%XSWD (:, KPATCH) = PKDI%XP_SWD (:)
- DGI%XSWU (:, KPATCH) = PKDI%XP_SWU (:)
- DGI%XLWD (:, KPATCH) = PKDI%XP_LWD (:)
- DGI%XLWU (:, KPATCH) = PKDI%XP_LWU (:)
- DGI%XFMU (:, KPATCH) = PKDI%XP_FMU (:)
- DGI%XFMV (:, KPATCH) = PKDI%XP_FMV (:)
- !
- DGI%XSWBD (:, :, KPATCH) = PKDI%XP_SWBD (:,:)
- DGI%XSWBU (:, :, KPATCH) = PKDI%XP_SWBU (:,:)
- !
- END IF
- !
- IF (DGI%LCOEF) THEN
- DGI%XCD (:, KPATCH) = PKDI%XP_CD (:)
- DGI%XCH (:, KPATCH) = PKDI%XP_CH (:)
- DGI%XCE (:, KPATCH) = PKDI%XP_CE (:)
- DGI%XZ0_WITH_SNOW (:, KPATCH) = PKDI%XP_Z0_WITH_SNOW (:)
- DGI%XZ0H_WITH_SNOW (:, KPATCH) = PKDI%XP_Z0H_WITH_SNOW (:)
- DGI%XZ0EFF (:, KPATCH) = PKDI%XP_Z0EFF (:)
- END IF
- !
- IF (DGI%LSURF_VARS) THEN
- DGI%XQS (:, KPATCH) = PKDI%XP_QS (:)
- END IF
- !
- IF (I%LCPL_RRM) THEN
- PCPL_DRAIN (:, KPATCH) = PKDI%XP_DRAIN (:)
- PCPL_RUNOFF (:, KPATCH) = PKDI%XP_RUNOFF (:)
+ IF (IO%LCPL_RRM) THEN
+ PCPL_DRAIN (:,KPATCH) = DEK%XDRAIN (:)
+ PCPL_RUNOFF(:,KPATCH) = DEK%XRUNOFF(:)
END IF
!
- IF (I%LFLOOD) THEN
- PCPL_EFLOOD (:, KPATCH) = PKDI%XP_LE_FLOOD (:) / PKI%XP_LVTT(:) &
- + PKDI%XP_LEI_FLOOD(:) / PKI%XP_LSTT(:)
- PCPL_PFLOOD (:, KPATCH) = PKDI%XP_PFLOOD (:)
- PCPL_IFLOOD (:, KPATCH) = PKDI%XP_IFLOOD (:)
+ IF (IO%LFLOOD) THEN
+ PCPL_EFLOOD(:,KPATCH) = DEK%XLE_FLOOD(:) / PK%XLVTT(:) + DEK%XLEI_FLOOD(:) / PK%XLSTT(:)
+ PCPL_PFLOOD(:,KPATCH) = DEK%XPFLOOD(:)
+ PCPL_IFLOOD(:,KPATCH) = DEK%XIFLOOD(:)
END IF
!
- IF(I%LCPL_RRM.AND.I%LGLACIER)THEN
- PCPL_ICEFLUX (:, KPATCH) = PKDI%XP_ICEFLUX (:)
- ENDIF
- !
- IF(I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO')THEN
- I%TSNOW%TEMP(:,:,KPATCH) = PKDI%XP_SNOWTEMP(:,:)
- I%TSNOW%TS (:,KPATCH) = PKDI%XP_SNOWTEMP(:,1)
- ENDIF
- !
- IF (I%CPHOTO/='NON') THEN
- GB%XIACAN(:,:,KPATCH) = PKDI%XP_IACAN(:,:)
+ IF(IO%LCPL_RRM.AND.IO%LGLACIER)THEN
+ PCPL_ICEFLUX(:,KPATCH) = DEK%XICEFLUX(:)
ENDIF
!
ELSE
!
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- DGI%XTS (JI, KPATCH) = PKDI%XP_TS (JJ)
- DGI%XTSRAD (JI, KPATCH) = PKDI%XP_TSRAD (JJ)
- END DO
- IF (DGI%N2M>=1) THEN
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- DGI%XT2M (JI, KPATCH) = PKDI%XP_T2M (JJ)
- DGI%XQ2M (JI, KPATCH) = PKDI%XP_Q2M (JJ)
- DGI%XHU2M (JI, KPATCH) = PKDI%XP_HU2M (JJ)
- DGI%XZON10M (JI, KPATCH) = PKDI%XP_ZON10M (JJ)
- DGI%XMER10M (JI, KPATCH) = PKDI%XP_MER10M (JJ)
- DGI%XRI (JI, KPATCH) = PKDI%XP_RI (JJ)
- !
- DGI%XWIND10M(JI, KPATCH) = SQRT(PKDI%XP_ZON10M(JJ)**2+PKDI%XP_MER10M(JJ)**2)
- !
- END DO
- END IF
- !
- IF (DGI%LSURF_BUDGET) THEN
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- DGI%XRN (JI, KPATCH) = PKDI%XP_RN (JJ)
- DGI%XH (JI, KPATCH) = PKDI%XP_H (JJ)
- DGI%XGFLUX (JI, KPATCH) = PKDI%XP_GFLUX (JJ)
- DGI%XLEI (JI, KPATCH) = PKDI%XP_LEI (JJ)
- DGI%XSWD (JI, KPATCH) = PKDI%XP_SWD (JJ)
- DGI%XSWU (JI, KPATCH) = PKDI%XP_SWU (JJ)
- DGI%XLWD (JI, KPATCH) = PKDI%XP_LWD (JJ)
- DGI%XLWU (JI, KPATCH) = PKDI%XP_LWU (JJ)
- DGI%XFMU (JI, KPATCH) = PKDI%XP_FMU (JJ)
- DGI%XFMV (JI, KPATCH) = PKDI%XP_FMV (JJ)
- !
- DO JSW=1,SIZE(DGI%XSWBD,2)
- DGI%XSWBD (JI, JSW, KPATCH) = PKDI%XP_SWBD (JJ,JSW)
- DGI%XSWBU (JI, JSW, KPATCH) = PKDI%XP_SWBU (JJ,JSW)
- END DO
- !
- END DO
- END IF
- !
- IF (DGI%LCOEF) THEN
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- DGI%XCD (JI, KPATCH) = PKDI%XP_CD (JJ)
- DGI%XCH (JI, KPATCH) = PKDI%XP_CH (JJ)
- DGI%XCE (JI, KPATCH) = PKDI%XP_CE (JJ)
- DGI%XZ0_WITH_SNOW (JI, KPATCH) = PKDI%XP_Z0_WITH_SNOW (JJ)
- DGI%XZ0H_WITH_SNOW (JI, KPATCH) = PKDI%XP_Z0H_WITH_SNOW (JJ)
- DGI%XZ0EFF (JI, KPATCH) = PKDI%XP_Z0EFF (JJ)
- END DO
- END IF
- !
- IF (DGI%LSURF_VARS) THEN
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- DGI%XQS (JI, KPATCH) = PKDI%XP_QS (JJ)
- END DO
- END IF
- !
- IF (I%LCPL_RRM) THEN
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- PCPL_DRAIN (JI, KPATCH) = PKDI%XP_DRAIN (JJ)
- PCPL_RUNOFF (JI, KPATCH) = PKDI%XP_RUNOFF (JJ)
+ IF (IO%LCPL_RRM) THEN
+ DO JI=1,KSIZE
+ IMASK = KMASK(JI)
+ PCPL_DRAIN (IMASK,KPATCH) = DEK%XDRAIN (JI)
+ PCPL_RUNOFF(IMASK,KPATCH) = DEK%XRUNOFF (JI)
END DO
END IF
!
- IF (I%LFLOOD) THEN
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- PCPL_EFLOOD (JI, KPATCH) = PKDI%XP_LE_FLOOD (JJ) / PKI%XP_LVTT(JJ) &
- + PKDI%XP_LEI_FLOOD(JJ) / PKI%XP_LSTT(JJ)
- PCPL_PFLOOD (JI, KPATCH) = PKDI%XP_PFLOOD (JJ)
- PCPL_IFLOOD (JI, KPATCH) = PKDI%XP_IFLOOD (JJ)
+ IF (IO%LFLOOD) THEN
+ DO JI=1,KSIZE
+ IMASK = KMASK(JI)
+ PCPL_EFLOOD(IMASK,KPATCH) = DEK%XLE_FLOOD(JI) / PK%XLVTT(JI) + DEK%XLEI_FLOOD(JI) / PK%XLSTT(JI)
+ PCPL_PFLOOD(IMASK,KPATCH) = DEK%XPFLOOD(JI)
+ PCPL_IFLOOD(IMASK,KPATCH) = DEK%XIFLOOD(JI)
END DO
END IF
!
- IF(I%LGLACIER)THEN
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- PCPL_ICEFLUX (JI, KPATCH) = PKDI%XP_ICEFLUX (JJ)
+ IF(IO%LCPL_RRM.AND.IO%LGLACIER)THEN
+ DO JI=1,KSIZE
+ IMASK = KMASK(JI)
+ PCPL_ICEFLUX(IMASK,KPATCH) = DEK%XICEFLUX(JI)
END DO
ENDIF
!
- IF(I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO')THEN
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- I%TSNOW%TS (JI,KPATCH) = PKDI%XP_SNOWTEMP(JJ,1)
- DO JSW=1,SIZE(I%TSNOW%TEMP,2)
- I%TSNOW%TEMP(JI,JSW,KPATCH) = PKDI%XP_SNOWTEMP(JJ,JSW)
- ENDDO
- ENDDO
- ENDIF
- !
- IF (I%CPHOTO/='NON') THEN
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- DO JSW=1,SIZE(GB%XIACAN,2)
- GB%XIACAN(JI,JSW,KPATCH) = PKDI%XP_IACAN(JJ,JSW)
- ENDDO
- ENDDO
- ENDIF
- !
ENDIF
!
!------------------------------------------------------------------------
!
-PKDI%XP_CH => NULL()
-PKDI%XP_CE => NULL()
-PKDI%XP_CD => NULL()
-PKDI%XP_CDN => NULL()
-PKDI%XP_RI => NULL()
-PKDI%XP_HU => NULL()
-PKDI%XP_HUG => NULL()
-PKDI%XP_ALBT => NULL()
-PKDI%XP_RN => NULL()
-PKDI%XP_H => NULL()
-PKDI%XP_LEI => NULL()
-PKDI%XP_LEG => NULL()
-PKDI%XP_LEGI => NULL()
-PKDI%XP_LEV => NULL()
-PKDI%XP_LES => NULL()
-PKDI%XP_LER => NULL()
-PKDI%XP_LETR => NULL()
-PKDI%XP_GFLUX => NULL()
-PKDI%XP_EVAP => NULL()
-PKDI%XP_SUBL => NULL()
-PKDI%XP_RESTORE => NULL()
-PKDI%XP_DRAIN => NULL()
-PKDI%XP_QSB => NULL()
-PKDI%XP_RUNOFF => NULL()
-PKDI%XP_MELT => NULL()
-PKDI%XP_MELTADV => NULL()
-PKDI%XP_SRSFC => NULL()
-PKDI%XP_RRSFC => NULL()
-PKDI%XP_SNOWFREE_ALB => NULL()
-!
-PKDI%XP_HORT => NULL()
-PKDI%XP_DRIP => NULL()
-PKDI%XP_RRVEG => NULL()
-PKDI%XP_IRRIG_FLUX => NULL()
-!
-PKDI%XP_SWBD => NULL()
-PKDI%XP_SWBU => NULL()
-!
-PKDI%XP_SWD => NULL()
-PKDI%XP_SWU => NULL()
-PKDI%XP_LWD => NULL()
-PKDI%XP_LWU => NULL()
-PKDI%XP_FMU => NULL()
-PKDI%XP_FMV => NULL()
-!
-PKDI%XP_Z0_WITH_SNOW => NULL()
-PKDI%XP_Z0H_WITH_SNOW=> NULL()
-PKDI%XP_Z0EFF => NULL()
-!
-PKDI%XP_CG => NULL()
-PKDI%XP_C1 => NULL()
-PKDI%XP_C2 => NULL()
-PKDI%XP_WGEQ => NULL()
-PKDI%XP_CT => NULL()
-PKDI%XP_RS => NULL()
-PKDI%XP_HV => NULL()
-PKDI%XP_QS => NULL()
-!
-PKDI%XP_TS => NULL()
-PKDI%XP_TSRAD => NULL()
-!
-PKDI%XP_RESP_AUTO => NULL()
-PKDI%XP_RESP_ECO => NULL()
-PKDI%XP_GPP => NULL()
-PKDI%XP_FAPAR => NULL()
-PKDI%XP_FAPIR => NULL()
-PKDI%XP_FAPAR_BS => NULL()
-PKDI%XP_FAPIR_BS => NULL()
-!
-PKDI%XP_IFLOOD => NULL()
-PKDI%XP_PFLOOD => NULL()
-PKDI%XP_LE_FLOOD => NULL()
-PKDI%XP_LEI_FLOOD => NULL()
-!
-PKDI%XP_RNSNOW => NULL()
-PKDI%XP_HSNOW => NULL()
-PKDI%XP_HPSNOW => NULL()
-PKDI%XP_GFLUXSNOW => NULL()
-PKDI%XP_USTARSNOW => NULL()
-PKDI%XP_GRNDFLUX => NULL()
-PKDI%XP_LESL => NULL()
-PKDI%XP_SNDRIFT => NULL()
-PKDI%XP_CDSNOW => NULL()
-PKDI%XP_CHSNOW => NULL()
-PKDI%XP_SNOWHMASS => NULL()
-PKDI%XP_RN_ISBA => NULL()
-PKDI%XP_H_ISBA => NULL()
-PKDI%XP_LEG_ISBA => NULL()
-PKDI%XP_LEGI_ISBA => NULL()
-PKDI%XP_LEV_ISBA => NULL()
-PKDI%XP_LETR_ISBA => NULL()
-PKDI%XP_USTAR_ISBA => NULL()
-PKDI%XP_LER_ISBA => NULL()
-PKDI%XP_LE_ISBA => NULL()
-PKDI%XP_LEI_ISBA => NULL()
-PKDI%XP_GFLUX_ISBA => NULL()
-PKDI%XP_SNOWLIQ => NULL()
-PKDI%XP_SNOWDZ => NULL()
-!
-PKDI%XP_SNOWTEMP => NULL()
-!
-PKDI%XP_SNOWFREE_ALB_VEG=> NULL()
-PKDI%XP_SNOWFREE_ALB_SOIL=> NULL()
-!
-PKDI%XP_IACAN => NULL()
-!
-PKDI%XP_T2M => NULL()
-PKDI%XP_Q2M => NULL()
-PKDI%XP_HU2M => NULL()
-PKDI%XP_ZON10M => NULL()
-PKDI%XP_MER10M => NULL()
-!
-PKDI%XP_SWI => NULL()
-PKDI%XP_TSWI => NULL()
-PKDI%XP_TWSNOW => NULL()
-PKDI%XP_TDSNOW => NULL()
-!
-PKDI%XP_ICEFLUX => NULL()
-!
-PKDI%XP_DWG => NULL()
-PKDI%XP_DWGI => NULL()
-PKDI%XP_DSWE => NULL()
-PKDI%XP_WATBUD => NULL()
-!
-PKDI%XP_SWUP => NULL()
-! MEB stuff
-PKDI%XP_SWNET_V => NULL()
-PKDI%XP_SWNET_G => NULL()
-PKDI%XP_SWNET_N => NULL()
-PKDI%XP_SWNET_NS => NULL()
-PKDI%XP_LWUP => NULL()
-PKDI%XP_LWNET_V => NULL()
-PKDI%XP_LWNET_G => NULL()
-PKDI%XP_LWNET_N => NULL()
-PKDI%XP_LEVCV => NULL()
-PKDI%XP_LESC => NULL()
-PKDI%XP_H_V_C => NULL()
-PKDI%XP_H_G_C => NULL()
-PKDI%XP_LETRGV => NULL()
-PKDI%XP_LETRCV => NULL()
-PKDI%XP_LERGV => NULL()
-PKDI%XP_LELITTER => NULL()
-PKDI%XP_LELITTERI => NULL()
-PKDI%XP_DRIPLIT => NULL()
-PKDI%XP_RRLIT => NULL()
-PKDI%XP_LERCV => NULL()
-PKDI%XP_H_C_A => NULL()
-PKDI%XP_H_N_C => NULL()
-PKDI%XP_LE_C_A => NULL()
-PKDI%XP_LE_V_C => NULL()
-PKDI%XP_LE_G_C => NULL()
-PKDI%XP_LE_N_C => NULL()
-PKDI%XP_EVAP_N_C => NULL()
-PKDI%XP_EVAP_G_C => NULL()
-PKDI%XP_SR_GN => NULL()
-PKDI%XP_MELTCV => NULL()
-PKDI%XP_FRZCV => NULL()
-PKDI%XP_SWDOWN_GN => NULL()
-PKDI%XP_LWDOWN_GN => NULL()
-!
-DEALLOCATE(PKDI%XBLOCK_SIMPLE)
-DEALLOCATE(PKDI%XBLOCK_GROUND)
-DEALLOCATE(PKDI%XBLOCK_SNOW)
-DEALLOCATE(PKDI%XBLOCK_KSW)
-DEALLOCATE(PKDI%XBLOCK_ABC)
-DEALLOCATE(PKDI%XBLOCK_0)
-DEALLOCATE(PKDI%XBLOCK_00)
-!
IF (LHOOK) CALL DR_HOOK('UNPACK_DIAG_PATCH_N',1,ZHOOK_HANDLE)
!------------------------------------------------------------------------
!
diff --git a/src/SURFEX/unpack_isba_patchn.F90 b/src/SURFEX/unpack_isba_patchn.F90
deleted file mode 100644
index c89a077ad75ddcc0b85862295b37c9fdec91408c..0000000000000000000000000000000000000000
--- a/src/SURFEX/unpack_isba_patchn.F90
+++ /dev/null
@@ -1,608 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE UNPACK_ISBA_PATCH_n (AG, I, PKI, &
- KMASK,KSIZE,KPATCH)
-!##############################################
-!
-!!**** *UNPACK_ISBA_PATCH_n* - unpacks ISBA prognostic variables
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! A. Boone
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! B. Decharme 2008 Floodplains
-!! A.L. Gibelin 04/2009 : BIOMASS and RESP_BIOMASS arrays
-!! A.L. Gibelin 04/2009 : TAU_WOOD for NCB option
-!! A.L. Gibelin 05/2009 : Add carbon spinup
-!! A.L. Gibelin 06/2009 : Soil carbon variables for CNT option
-!! A.L. Gibelin 07/2009 : Suppress RDK and transform GPP as a diagnostic
-!! A.L. Gibelin 07/2009 : Suppress PPST and PPSTF as outputs
-!! B. Decharme 06/2013 : add lateral drainage flux diag for DIF
-!! water table / surface coupling
-!! P. Samuelsson 02/2012 : MEB
-!!
-!!------------------------------------------------------------------
-!
-
-!
-USE MODD_AGRI_n, ONLY : AGRI_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_PACK_ISBA, ONLY : PACK_ISBA_t
-!
-USE MODD_AGRI, ONLY : LAGRIP
-
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!
-TYPE(AGRI_t), INTENT(INOUT) :: AG
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(PACK_ISBA_t), INTENT(INOUT) :: PKI
-!
-INTEGER, INTENT(IN) :: KSIZE, KPATCH
-!
-INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
-!
-INTEGER JJ, JI, JK, JL
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('UNPACK_ISBA_PATCH_N',0,ZHOOK_HANDLE)
-IF (I%NPATCH==1) THEN
- I%TSNOW%WSNOW (:, :, 1) = PKI%XP_SNOWSWE (:, :)
- I%TSNOW%RHO (:, :, 1) = PKI%XP_SNOWRHO (:, :)
- I%TSNOW%ALB (:, 1) = PKI%XP_SNOWALB (:)
- I%XWR (:, 1) = PKI%XP_WR (:)
- I%XTG (:, :, 1) = PKI%XP_TG (:, :)
- I%XWG (:, :, 1) = PKI%XP_WG (:, :)
- I%XWGI (:, :, 1) = PKI%XP_WGI (:, :)
- I%XRESA (:, 1) = PKI%XP_RESA (:)
- I%XPCPS (:, 1) = PKI%XP_CPS (:)
- I%XPLVTT (:, 1) = PKI%XP_LVTT (:)
- I%XPLSTT (:, 1) = PKI%XP_LSTT (:)
- I%XALBNIR (:, 1) = PKI%XP_ALBNIR (:)
- I%XALBVIS (:, 1) = PKI%XP_ALBVIS (:)
- I%XALBUV (:, 1) = PKI%XP_ALBUV (:)
- I%XALBNIR_VEG (:, 1) = PKI%XP_ALBNIR_VEG (:)
- I%XALBVIS_VEG (:, 1) = PKI%XP_ALBVIS_VEG (:)
- I%XALBUV_VEG (:, 1) = PKI%XP_ALBUV_VEG (:)
- I%XALBNIR_SOIL (:, 1) = PKI%XP_ALBNIR_SOIL(:)
- I%XALBVIS_SOIL (:, 1) = PKI%XP_ALBVIS_SOIL(:)
- I%XALBUV_SOIL (:, 1) = PKI%XP_ALBUV_SOIL (:)
- I%XEMIS (:, 1) = PKI%XP_EMIS (:)
- I%XZ0EFFIP (:, 1) = PKI%XP_Z0EFFIP (:)
- I%XZ0EFFIM (:, 1) = PKI%XP_Z0EFFIM (:)
- I%XZ0EFFJP (:, 1) = PKI%XP_Z0EFFJP (:)
- I%XZ0EFFJM (:, 1) = PKI%XP_Z0EFFJM (:)
- I%XLE (:, 1) = PKI%XP_LE (:)
- !
- IF(I%LMEB_PATCH(KPATCH))THEN
- I%XWRL (:, 1) = PKI%XP_WRL (:)
- I%XWRLI (:, 1) = PKI%XP_WRLI (:)
- I%XWRVN (:, 1) = PKI%XP_WRVN (:)
- I%XTV (:, 1) = PKI%XP_TV (:)
- I%XTL (:, 1) = PKI%XP_TL (:)
- I%XTC (:, 1) = PKI%XP_TC (:)
- I%XQC (:, 1) = PKI%XP_QC (:)
- I%XLAI (:, 1) = PKI%XP_LAI (:)
- I%XZ0 (:, 1) = PKI%XP_Z0 (:)
- ELSE
-! Please note that XLAI, XVEG, and XZ0 are not unpacked
-! in the case of MEB.
- I%XLAI (:, 1) = PKI%XP_LAI (:)
- I%XVEG (:, 1) = PKI%XP_VEG (:)
- I%XZ0 (:, 1) = PKI%XP_Z0 (:)
- ENDIF
- !
- IF (I%LTR_ML) THEN
- I%XFAPARC (:, 1) = PKI%XP_FAPARC (:)
- I%XFAPIRC (:, 1) = PKI%XP_FAPIRC (:)
- I%XLAI_EFFC (:, 1) = PKI%XP_LAI_EFFC (:)
- I%XMUS (:, 1) = PKI%XP_MUS (:)
- ENDIF
- !
- IF (I%CPHOTO/='NON') THEN
- I%XAN (:, 1) = PKI%XP_AN (:)
- I%XANDAY (:, 1) = PKI%XP_ANDAY (:)
- I%XANFM (:, 1) = PKI%XP_ANFM (:)
- I%XBIOMASS (:,:,1) = PKI%XP_BIOMASS (:,:)
- I%XRESP_BIOMASS (:,:,1) = PKI%XP_RESP_BIOMASS (:,:)
- END IF
- !
- IF(I%CPHOTO=='NIT' .OR. I%CPHOTO=='NCB') THEN
- I%XBSLAI_NITRO (:,1) = PKI%XP_BSLAI_NITRO (:)
- END IF
- !
- IF(I%CPHOTO=='NCB') THEN
- I%XINCREASE (:,:,1) = PKI%XP_INCREASE (:,:)
- END IF
- !
- IF(I%CRESPSL=='CNT') THEN
- I%XLITTER (:,:,:,1) = PKI%XP_LITTER (:,:,:)
- I%XSOILCARB (:,:,1) = PKI%XP_SOILCARB (:,:)
- I%XLIGNIN_STRUC (:,:,1) = PKI%XP_LIGNIN_STRUC (:,:)
- I%XTURNOVER (:,:,1) = PKI%XP_TURNOVER (:,:)
- END IF
- !
- IF(LAGRIP .AND. (I%CPHOTO=='NIT' .OR. I%CPHOTO=='LAI' .OR. I%CPHOTO=='LST' .OR. I%CPHOTO=='NCB') ) THEN
- AG%LIRRIDAY (:,1) = PKI%XP_LIRRIDAY (:)
- END IF
- !
- IF (I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO') THEN
- I%TSNOW%HEAT (:, :, 1) = PKI%XP_SNOWHEAT (:, :)
- I%TSNOW%EMIS (:, 1) = PKI%XP_SNOWEMIS (:)
- I%TSNOW%AGE (:, :, 1) = PKI%XP_SNOWAGE (:, :)
- I%TSNOW%ALBVIS (:, 1) = PKI%XP_SNOWALBVIS (:)
- I%TSNOW%ALBNIR (:, 1) = PKI%XP_SNOWALBNIR (:)
- I%TSNOW%ALBFIR (:, 1) = PKI%XP_SNOWALBFIR (:)
- END IF
-
- IF (I%TSNOW%SCHEME=='CRO') THEN
- I%TSNOW%GRAN1 (:, :, 1) = PKI%XP_SNOWGRAN1 (:, :)
- I%TSNOW%GRAN2 (:, :, 1) = PKI%XP_SNOWGRAN2 (:, :)
- I%TSNOW%HIST (:, :, 1) = PKI%XP_SNOWHIST (:, :)
- END IF
- !
- IF(I%LGLACIER)THEN
- I%XICE_STO (:,1) = PKI%XP_ICE_STO (:)
- ENDIF
-!
-ELSE
-!
-! Only save values for patches which are in use:
-!
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- I%TSNOW%ALB (JI, KPATCH) = PKI%XP_SNOWALB (JJ)
- I%XWR (JI, KPATCH) = PKI%XP_WR (JJ)
- I%XRESA (JI, KPATCH) = PKI%XP_RESA (JJ)
- I%XPCPS (JI, KPATCH) = PKI%XP_CPS (JJ)
- I%XPLVTT (JI, KPATCH) = PKI%XP_LVTT (JJ)
- I%XPLSTT (JI, KPATCH) = PKI%XP_LSTT (JJ)
- I%XALBNIR (JI, KPATCH) = PKI%XP_ALBNIR (JJ)
- I%XALBVIS (JI, KPATCH) = PKI%XP_ALBVIS (JJ)
- I%XALBUV (JI, KPATCH) = PKI%XP_ALBUV (JJ)
- I%XALBNIR_VEG (JI, KPATCH) = PKI%XP_ALBNIR_VEG (JJ)
- I%XALBVIS_VEG (JI, KPATCH) = PKI%XP_ALBVIS_VEG (JJ)
- I%XALBUV_VEG (JI, KPATCH) = PKI%XP_ALBUV_VEG (JJ)
- I%XALBNIR_SOIL (JI, KPATCH) = PKI%XP_ALBNIR_SOIL(JJ)
- I%XALBVIS_SOIL (JI, KPATCH) = PKI%XP_ALBVIS_SOIL(JJ)
- I%XALBUV_SOIL (JI, KPATCH) = PKI%XP_ALBUV_SOIL (JJ)
- I%XEMIS (JI, KPATCH) = PKI%XP_EMIS (JJ)
- I%XZ0EFFIP (JI, KPATCH) = PKI%XP_Z0EFFIP (JJ)
- I%XZ0EFFIM (JI, KPATCH) = PKI%XP_Z0EFFIM (JJ)
- I%XZ0EFFJP (JI, KPATCH) = PKI%XP_Z0EFFJP (JJ)
- I%XZ0EFFJM (JI, KPATCH) = PKI%XP_Z0EFFJM (JJ)
- I%XLE (JI, KPATCH) = PKI%XP_LE (JJ)
- !
- END DO
- !
- IF(I%LMEB_PATCH(KPATCH))THEN
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- I%XWRL (JI, KPATCH) = PKI%XP_WRL (JJ)
- I%XWRLI (JI, KPATCH) = PKI%XP_WRLI (JJ)
- I%XWRVN (JI, KPATCH) = PKI%XP_WRVN (JJ)
- I%XTV (JI, KPATCH) = PKI%XP_TV (JJ)
- I%XTL (JI, KPATCH) = PKI%XP_TL (JJ)
- I%XTC (JI, KPATCH) = PKI%XP_TC (JJ)
- I%XQC (JI, KPATCH) = PKI%XP_QC (JJ)
- I%XLAI (JI, KPATCH) = PKI%XP_LAI (JJ)
- I%XZ0 (JI, KPATCH) = PKI%XP_Z0 (JJ)
- END DO
- ELSE
-! Please note that XLAI, XVEG, and XZ0 are not unpacked
-! in the case of MEB yet. This must be done when interactive/carbon
-! vegetation is activated for MEB.
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- I%XLAI (JI, KPATCH) = PKI%XP_LAI (JJ)
- I%XVEG (JI, KPATCH) = PKI%XP_VEG (JJ)
- I%XZ0 (JI, KPATCH) = PKI%XP_Z0 (JJ)
- END DO
- ENDIF
- !
- DO JK=1,SIZE(I%XTG,2)
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- I%XTG (JI, JK, KPATCH) = PKI%XP_TG (JJ, JK)
- ENDDO
- ENDDO
-!
- DO JK=1,SIZE(I%XWG,2)
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- I%XWG (JI, JK, KPATCH) = PKI%XP_WG (JJ, JK)
- I%XWGI (JI, JK, KPATCH) = PKI%XP_WGI (JJ, JK)
- ENDDO
- ENDDO
-!
- DO JK=1,SIZE(PKI%XP_SNOWSWE,2)
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- I%TSNOW%WSNOW (JI, JK, KPATCH) = PKI%XP_SNOWSWE (JJ, JK)
- I%TSNOW%RHO (JI, JK, KPATCH) = PKI%XP_SNOWRHO (JJ, JK)
- ENDDO
- ENDDO
- !
- IF (I%LTR_ML) THEN
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- I%XFAPARC (JI, KPATCH) = PKI%XP_FAPARC (JJ)
- I%XFAPIRC (JI, KPATCH) = PKI%XP_FAPIRC (JJ)
- I%XLAI_EFFC (JI, KPATCH) = PKI%XP_LAI_EFFC (JJ)
- I%XMUS (JI, KPATCH) = PKI%XP_MUS (JJ)
- ENDDO
- ENDIF
- !
- IF (I%CPHOTO/='NON') THEN
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- I%XAN (JI, KPATCH) = PKI%XP_AN (JJ)
- I%XANDAY (JI, KPATCH) = PKI%XP_ANDAY (JJ)
- I%XANFM (JI, KPATCH) = PKI%XP_ANFM (JJ)
- ENDDO
- DO JK=1,SIZE(I%XBIOMASS,2)
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- I%XBIOMASS (JI, JK, KPATCH) = PKI%XP_BIOMASS (JJ, JK)
- I%XRESP_BIOMASS (JI, JK, KPATCH) = PKI%XP_RESP_BIOMASS (JJ, JK)
- ENDDO
- END DO
- END IF
- !
- IF (I%CPHOTO=='NIT' .OR. I%CPHOTO=='NCB') THEN
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- I%XBSLAI_NITRO (JI, KPATCH) = PKI%XP_BSLAI_NITRO (JJ)
- END DO
- END IF
- !
- IF (I%CPHOTO=='NCB') THEN
- DO JK=1,SIZE(I%XINCREASE,2)
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- I%XINCREASE (JI, JK, KPATCH) = PKI%XP_INCREASE (JJ, JK)
- ENDDO
- END DO
- END IF
- !
- IF (I%CRESPSL=='CNT') THEN
- DO JL=1,SIZE(PKI%XP_LITTER,3)
- DO JK=1,SIZE(PKI%XP_LITTER,2)
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- I%XLITTER (JI, JK, JL, KPATCH) = PKI%XP_LITTER (JJ, JK, JL)
- ENDDO
- ENDDO
- ENDDO
- DO JK=1,SIZE(PKI%XP_SOILCARB,2)
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- I%XSOILCARB (JI, JK, KPATCH) = PKI%XP_SOILCARB (JJ, JK)
- ENDDO
- ENDDO
- DO JK=1,SIZE(PKI%XP_LIGNIN_STRUC,2)
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- I%XLIGNIN_STRUC (JI, JK, KPATCH) = PKI%XP_LIGNIN_STRUC (JJ, JK)
- ENDDO
- ENDDO
- DO JK=1,SIZE(PKI%XP_TURNOVER,2)
- DO JJ=1,KSIZE
- JI = KMASK(JJ)
- I%XTURNOVER (JI, JK, KPATCH) = PKI%XP_TURNOVER (JJ, JK)
- ENDDO
- END DO
- END IF
- !
- IF(LAGRIP .AND. (I%CPHOTO=='NIT' .OR. I%CPHOTO=='LAI' .OR. I%CPHOTO=='LST' .OR. I%CPHOTO=='NCB') ) THEN
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- AG%LIRRIDAY (JI,KPATCH) = PKI%XP_LIRRIDAY (JJ)
- END DO
- END IF
- !
- IF (I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO') THEN
- DO JK=1,SIZE(PKI%XP_SNOWHEAT,2)
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- I%TSNOW%HEAT (JI, JK, KPATCH) = PKI%XP_SNOWHEAT (JJ, JK)
- I%TSNOW%AGE (JI, JK, KPATCH) = PKI%XP_SNOWAGE (JJ, JK)
- ENDDO
- ENDDO
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- I%TSNOW%EMIS (JI, KPATCH) = PKI%XP_SNOWEMIS (JJ)
- I%TSNOW%ALBVIS (JI, KPATCH) = PKI%XP_SNOWALBVIS (JJ)
- I%TSNOW%ALBNIR (JI, KPATCH) = PKI%XP_SNOWALBNIR (JJ)
- I%TSNOW%ALBFIR (JI, KPATCH) = PKI%XP_SNOWALBFIR (JJ)
- END DO
- END IF
-
- IF (I%TSNOW%SCHEME=='CRO') THEN
- DO JK=1,SIZE(PKI%XP_SNOWGRAN1,2)
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- I%TSNOW%GRAN1 (JI, JK, KPATCH) = PKI%XP_SNOWGRAN1 (JJ, JK)
- I%TSNOW%GRAN2 (JI, JK, KPATCH) = PKI%XP_SNOWGRAN2 (JJ, JK)
- I%TSNOW%HIST (JI, JK, KPATCH) = PKI%XP_SNOWHIST (JJ, JK)
- ENDDO
- END DO
- END IF
- !
- IF(I%LGLACIER)THEN
- DO JJ=1,KSIZE
- JI = KMASK (JJ)
- I%XICE_STO(JI, KPATCH) = PKI%XP_ICE_STO(JJ)
- ENDDO
- ENDIF
-!
-END IF
-!
-!------------------------------------------------------------------
-!
-PKI%XP_Z0_O_Z0H => NULL()
-PKI%XP_EMIS => NULL()
-PKI%XP_ALBNIR => NULL()
-PKI%XP_ALBVIS => NULL()
-PKI%XP_ALBUV => NULL()
-PKI%XP_ALBNIR_VEG => NULL()
-PKI%XP_ALBVIS_VEG => NULL()
-PKI%XP_ALBUV_VEG => NULL()
-PKI%XP_ALBNIR_SOIL => NULL()
-PKI%XP_ALBVIS_SOIL => NULL()
-PKI%XP_ALBUV_SOIL => NULL()
-PKI%XP_Z0 => NULL()
-PKI%XP_WRMAX_CF => NULL()
-PKI%XP_GAMMA => NULL()
-PKI%XP_CV => NULL()
-PKI%XP_RGL => NULL()
-PKI%XP_RUNOFFD => NULL()
-PKI%XP_Z0EFFIP => NULL()
-PKI%XP_Z0EFFIM => NULL()
-PKI%XP_Z0EFFJP => NULL()
-PKI%XP_Z0EFFJM => NULL()
-PKI%XP_WR => NULL()
-PKI%XP_LAI => NULL()
-PKI%XP_RESA => NULL()
-PKI%XP_CPS => NULL()
-PKI%XP_LVTT => NULL()
-PKI%XP_LSTT => NULL()
-PKI%XP_VEG => NULL()
-PKI%XP_SNOWALB => NULL()
-PKI%XP_SNOWALBVIS => NULL()
-PKI%XP_SNOWALBNIR => NULL()
-PKI%XP_SNOWALBFIR => NULL()
-PKI%XP_LE => NULL()
-PKI%XP_PSN => NULL()
-PKI%XP_PSNG => NULL()
-PKI%XP_PSNV => NULL()
-PKI%XP_ALBNIR_DRY => NULL()
-PKI%XP_ALBVIS_DRY => NULL()
-PKI%XP_ALBUV_DRY => NULL()
-PKI%XP_ALBNIR_WET => NULL()
-PKI%XP_ALBVIS_WET => NULL()
-PKI%XP_ALBUV_WET => NULL()
-PKI%XP_RUNOFFB => NULL()
-PKI%XP_WDRAIN => NULL()
-PKI%XP_TAUICE => NULL()
-PKI%XP_Z0REL => NULL()
-PKI%XP_AOSIP => NULL()
-PKI%XP_AOSIM => NULL()
-PKI%XP_AOSJP => NULL()
-PKI%XP_AOSJM => NULL()
-PKI%XP_HO2IP => NULL()
-PKI%XP_HO2IM => NULL()
-PKI%XP_HO2JP => NULL()
-PKI%XP_HO2JM => NULL()
-PKI%XP_SSO_SLOPE => NULL()
-PKI%XP_GAMMAT => NULL()
-PKI%XP_TDEEP => NULL()
-!
-PKI%XP_CLAY => NULL()
-PKI%XP_SAND => NULL()
-PKI%XP_WFC => NULL()
-PKI%XP_WWILT => NULL()
-PKI%XP_WSAT => NULL()
-PKI%XP_CONDSAT => NULL()
-PKI%XP_DG => NULL()
-PKI%XP_WG => NULL()
-PKI%XP_WGI => NULL()
-!
-PKI%XP_KSAT_ICE => NULL()
-PKI%XP_D_ICE => NULL()
-!
-PKI%XP_VEGTYPE_PATCH=> NULL()
-!
-PKI%XP_TG => NULL()
-!
-PKI%XP_SNOWSWE => NULL()
-PKI%XP_SNOWRHO => NULL()
-!
-PKI%XP_DIR_ALB_WITH_SNOW=> NULL()
-PKI%XP_SCA_ALB_WITH_SNOW=> NULL()
-!
-PKI%XP_FFLOOD => NULL()
-PKI%XP_PIFLOOD => NULL()
-PKI%XP_FF => NULL()
-PKI%XP_FFG => NULL()
-PKI%XP_FFV => NULL()
-PKI%XP_FFROZEN => NULL()
-PKI%XP_ALBF => NULL()
-PKI%XP_EMISF => NULL()
-!
-PKI%XP_PSNV_A => NULL()
-!
-PKI%XP_SNOWHEAT => NULL()
-PKI%XP_SNOWEMIS => NULL()
-!
-PKI%XP_SNOWGRAN1 => NULL()
-PKI%XP_SNOWGRAN2 => NULL()
-PKI%XP_SNOWHIST => NULL()
-PKI%XP_SNOWAGE => NULL()
-!
-PKI%XP_ICE_STO => NULL()
-!
-PKI%XP_FWTD => NULL()
-PKI%XP_WTD => NULL()
-!
-PKI%XP_HCAPSOIL => NULL()
-!
-PKI%XP_CONDDRY => NULL()
-PKI%XP_CONDSLD => NULL()
-!
-PKI%XP_C4B => NULL()
-PKI%XP_ACOEF => NULL()
-PKI%XP_PCOEF => NULL()
-PKI%XP_CGSAT => NULL()
-PKI%XP_C1SAT => NULL()
-PKI%XP_C2REF => NULL()
-PKI%XP_C4REF => NULL()
-PKI%XP_C3 => NULL()
-!
-PKI%XP_MPOTSAT => NULL()
-PKI%XP_BCOEF => NULL()
-!
-PKI%XP_ROOTFRAC => NULL()
-PKI%XP_DZG => NULL()
-PKI%XP_DZDIF => NULL()
-PKI%NK_WG_LAYER => NULL()
-PKI%XP_SOILWGHT => NULL()
-!
-PKI%XP_RSMIN => NULL()
-!
-PKI%XP_BSLAI => NULL()
-PKI%XP_LAIMIN => NULL()
-PKI%XP_SEFOLD => NULL()
-PKI%XP_H_TREE => NULL()
-PKI%XP_ANF => NULL()
-PKI%XP_ANMAX => NULL()
-PKI%XP_FZERO => NULL()
-PKI%XP_EPSO => NULL()
-PKI%XP_GAMM => NULL()
-PKI%XP_QDGAMM => NULL()
-PKI%XP_GMES => NULL()
-PKI%XP_RE25 => NULL()
-PKI%XP_QDGMES => NULL()
-PKI%XP_T1GMES => NULL()
-PKI%XP_T2GMES => NULL()
-PKI%XP_AMAX => NULL()
-PKI%XP_QDAMAX => NULL()
-PKI%XP_T1AMAX => NULL()
-PKI%XP_T2AMAX => NULL()
-PKI%XP_FAPARC => NULL()
-PKI%XP_FAPIRC => NULL()
-PKI%XP_LAI_EFFC => NULL()
-PKI%XP_MUS => NULL()
-PKI%XP_AN => NULL()
-PKI%XP_ANDAY => NULL()
-PKI%XP_ANFM => NULL()
-PKI%XP_GC => NULL()
-PKI%XP_LAT => NULL()
-PKI%XP_LON => NULL()
-PKI%XP_BIOMASS => NULL()
-PKI%XP_RESP_BIOMASS => NULL()
-!
-PKI%LP_STRESS => NULL()
-PKI%XP_F2I => NULL()
-PKI%XP_AH => NULL()
-PKI%XP_BH => NULL()
-PKI%XP_DMAX => NULL()
-!
-PKI%TP_SEED => NULL()
-PKI%TP_REAP => NULL()
-PKI%XP_IRRIG => NULL()
-PKI%XP_WATSUP => NULL()
-!
-PKI%XP_LIRRIDAY => NULL()
-PKI%XP_THRESHOLD => NULL()
-PKI%XP_LIRRIGATE => NULL()
-!
-PKI%XP_CE_NITRO => NULL()
-PKI%XP_CF_NITRO => NULL()
-PKI%XP_CNA_NITRO => NULL()
-PKI%XP_BSLAI_NITRO => NULL()
-!
-PKI%XP_INCREASE => NULL()
-PKI%XP_TAU_WOOD => NULL()
-!
-PKI%XP_LITTER => NULL()
-PKI%XP_SOILCARB => NULL()
-PKI%XP_LIGNIN_STRUC => NULL()
-PKI%XP_TURNOVER => NULL()
-!
-PKI%XP_FSAT=> NULL()
-PKI%XP_TOPQS=> NULL()
-!
-PKI%XP_MUF=> NULL()
-!
-PKI%XP_WRL => NULL()
-PKI%XP_WRLI => NULL()
-PKI%XP_WRVN => NULL()
-PKI%XP_TV => NULL()
-PKI%XP_TL => NULL()
-PKI%XP_TC => NULL()
-PKI%XP_QC => NULL()
-
-PKI%XP_H_VEG => NULL()
-PKI%XP_RGLV => NULL()
-PKI%XP_GAMMAV => NULL()
-PKI%XP_WRMAX_CFV => NULL()
-PKI%XP_LAIV => NULL()
-PKI%XP_Z0V => NULL()
-PKI%XP_RSMINV => NULL()
-PKI%XP_ROOTFRACV => NULL()
-PKI%XP_GNDLITTER => NULL()
-PKI%XP_Z0LITTER => NULL()
-!
-!
-DEALLOCATE(PKI%LBLOCK_SIMPLE)
-DEALLOCATE(PKI%LBLOCK_0)
-DEALLOCATE(PKI%NBLOCK_SIMPLE)
-DEALLOCATE(PKI%NBLOCK_0)
-DEALLOCATE(PKI%TBLOCK_SIMPLE)
-DEALLOCATE(PKI%TBLOCK_0)
-DEALLOCATE(PKI%XBLOCK_SIMPLE)
-DEALLOCATE(PKI%XBLOCK_GROUND)
-DEALLOCATE(PKI%XBLOCK_VEGTYPE)
-DEALLOCATE(PKI%XBLOCK_TG)
-DEALLOCATE(PKI%XBLOCK_SNOW)
-DEALLOCATE(PKI%XBLOCK_ALB)
-DEALLOCATE(PKI%XBLOCK_2)
-DEALLOCATE(PKI%XBLOCK_BIOMASS)
-DEALLOCATE(PKI%XBLOCK_SOILCARB)
-DEALLOCATE(PKI%XBLOCK_LITTLEVS)
-DEALLOCATE(PKI%XBLOCK_LITTER)
-DEALLOCATE(PKI%XBLOCK_0)
-DEALLOCATE(PKI%XBLOCK_00)
-DEALLOCATE(PKI%XBLOCK_000)
-DEALLOCATE(PKI%XBLOCK_01)
-!
-IF (LHOOK) CALL DR_HOOK('UNPACK_ISBA_PATCH_N',1,ZHOOK_HANDLE)
-!------------------------------------------------------------------
-!
-END SUBROUTINE UNPACK_ISBA_PATCH_n
diff --git a/src/SURFEX/unpack_same_rank.F90 b/src/SURFEX/unpack_same_rank.F90
index 3fbddb3fdad3e4c9f85a4f8ba1038f6cd081f86c..795457ae421dc5e76fb32069a97c14cd0eb3f970 100644
--- a/src/SURFEX/unpack_same_rank.F90
+++ b/src/SURFEX/unpack_same_rank.F90
@@ -55,6 +55,15 @@ REAL, DIMENSION(:,:,:), INTENT(OUT):: P3D_OUT
REAL, OPTIONAL, INTENT(IN) :: PMISS
!
END SUBROUTINE UNPACK_SAME_RANK_FROM3D
+!
+ SUBROUTINE UNPACK_SAME_RANK_FROM3DI(KM,K3D_IN,K3D_OUT,KMISS)
+
+INTEGER, DIMENSION(:), INTENT(IN) :: KM
+INTEGER, DIMENSION(:,:,:), INTENT(IN) :: K3D_IN
+INTEGER, DIMENSION(:,:,:), INTENT(OUT):: K3D_OUT
+INTEGER, OPTIONAL, INTENT(IN) :: KMISS
+!
+END SUBROUTINE UNPACK_SAME_RANK_FROM3DI
!
SUBROUTINE UNPACK_SAME_RANK_FROM4D(KM,P4D_IN,P4D_OUT,PMISS)
@@ -260,8 +269,6 @@ END SUBROUTINE UNPACK_SAME_RANK_FROM1DI
!
USE MODD_SURF_PAR, ONLY : NUNDEF
!
-USE MODD_SURFEX_OMP, ONLY : NWORK2_FULL
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -542,6 +549,88 @@ END SUBROUTINE UNPACK_SAME_RANK_FROM3D
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
+! ##############################################
+ SUBROUTINE UNPACK_SAME_RANK_FROM3DI(KM,K3D_IN,K3D_OUT,KMISS)
+! ##############################################
+!
+!!**** *UNPACK_SAME_RANK* - extract the defined data from a 3D field into a 3D field
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! F. Habets *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 08/03
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_SURF_PAR, ONLY : NUNDEF
+!
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+INTEGER, DIMENSION(:), INTENT(IN) :: KM
+REAL, DIMENSION(:,:,:), INTENT(IN) :: K3D_IN
+REAL, DIMENSION(:,:,:), INTENT(OUT):: K3D_OUT
+REAL, OPTIONAL, INTENT(IN) :: KMISS
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI, JJ, JK ! loop counter
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODI_UNPACK_SAME_RANK:UNPACK_SAME_RANK_FROM3D',0,ZHOOK_HANDLE)
+IF(PRESENT(KMISS))THEN
+ K3D_OUT(:,:,:) = KMISS
+ELSE
+ K3D_OUT(:,:,:) = NUNDEF
+ENDIF
+!
+DO JK=1,SIZE(K3D_IN,3)
+ DO JJ=1,SIZE(K3D_IN,2)
+!cdir nodep
+ DO JI=1,SIZE(K3D_IN,1)
+ K3D_OUT(KM(JI),JJ,JK) = K3D_IN(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ENDDO
+IF (LHOOK) CALL DR_HOOK('MODI_UNPACK_SAME_RANK:UNPACK_SAME_RANK_FROM3DI',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE UNPACK_SAME_RANK_FROM3DI
+!
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
! ##############################################
SUBROUTINE UNPACK_SAME_RANK_FROM4D(KM,P4D_IN,P4D_OUT,PMISS)
! ##############################################
diff --git a/src/SURFEX/update_data_cover.F90 b/src/SURFEX/update_data_cover.F90
index 065a749537737c5f92b9025ac7fce47121a06ee9..d8e6d96f6b8e125caf482f0166f8d3834a21e5b8 100644
--- a/src/SURFEX/update_data_cover.F90
+++ b/src/SURFEX/update_data_cover.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE UPDATE_DATA_COVER (DTCO, DTI, IG, I, &
+ SUBROUTINE UPDATE_DATA_COVER (DTCO, DTV, KDIM, KPATCH, OMEB_PATCH, &
KYEAR)
! #########################
!
@@ -44,12 +44,11 @@
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_SFX_GRID_n, ONLY : GRID_t
!
USE MODD_DATA_COVER, ONLY : XDATA_LAI, XDATA_H_TREE, &
XDATA_VEG, XDATA_GREEN, XDATA_Z0, XDATA_EMIS_ECO, &
- XDATA_LAIGV, XDATA_Z0LITTER, XDATA_H_VEG, XDATA_LAIMIN
+ XDATA_Z0LITTER, XDATA_H_VEG, XDATA_LAIMIN
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -66,9 +65,11 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+INTEGER, INTENT(IN) :: KDIM
+!
+LOGICAL, DIMENSION(:), POINTER :: OMEB_PATCH
+INTEGER, INTENT(IN) :: KPATCH
!
INTEGER, INTENT(IN) :: KYEAR ! new year
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -86,23 +87,20 @@ INTEGER :: ISIZE_LMEB_PATCH ! Number of patches with MEB=true
IF (LHOOK) CALL DR_HOOK('UPDATE_DATA_COVER',0,ZHOOK_HANDLE)
IF (KYEAR /= DTCO%NYEAR) THEN
DTCO%NYEAR = KYEAR
- CALL ECOCLIMAP2_LAI(DTCO)
- CALL INI_DATA_PARAM(DTCO%XDATA_VEGTYPE, PSURF=DTCO%XDATA_NATURE, PSURF2=DTCO%XDATA_GARDEN, &
- PLAI=XDATA_LAI, PH_TREE=XDATA_H_TREE, PVEG_OUT=XDATA_VEG, &
- PGREEN=XDATA_GREEN, PZ0=XDATA_Z0, PEMIS_ECO=XDATA_EMIS_ECO, &
- PLAIMIN_OUT=XDATA_LAIMIN, &
- PLAIGV_OUT=XDATA_LAIGV, PZ0LITTER=XDATA_Z0LITTER, &
- PH_VEG=XDATA_H_VEG )
-!
- IF (ASSOCIATED(I%LMEB_PATCH)) THEN
- ISIZE_LMEB_PATCH=COUNT(I%LMEB_PATCH(:))
+ CALL ECOCLIMAP2_LAI(DTCO%NYEAR)
+ CALL INI_DATA_PARAM(PLAI=XDATA_LAI, PH_TREE=XDATA_H_TREE, PVEG_OUT=XDATA_VEG, &
+ PGREEN=XDATA_GREEN, PZ0=XDATA_Z0, PEMIS_ECO=XDATA_EMIS_ECO, &
+ PLAIMIN_OUT=XDATA_LAIMIN, PZ0LITTER=XDATA_Z0LITTER, PH_VEG=XDATA_H_VEG )
+!
+ IF (ASSOCIATED(OMEB_PATCH)) THEN
+ ISIZE_LMEB_PATCH=COUNT(OMEB_PATCH(:))
ELSE
ISIZE_LMEB_PATCH=0
END IF
!
IF (ISIZE_LMEB_PATCH>0) THEN
- CALL FIX_MEB_VEG(DTI, IG, I, &
- I%NPATCH)
+ CALL FIX_MEB_VEG(DTV, KDIM, OMEB_PATCH, &
+ KPATCH)
ENDIF
!
END IF
diff --git a/src/SURFEX/update_esm_flaken.F90 b/src/SURFEX/update_esm_flaken.F90
index 48f4961bd55d544892d250e0f0b19cd970948adc..3bb91ec5b8a724811d658ff72acb8635feaa54bf 100644
--- a/src/SURFEX/update_esm_flaken.F90
+++ b/src/SURFEX/update_esm_flaken.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ############################################################
- SUBROUTINE UPDATE_ESM_FLAKE_n (F, &
- KI,KSW,PZENITH,PDIR_ALB, &
+ SUBROUTINE UPDATE_ESM_FLAKE_n (F,KI,KSW,PZENITH,PDIR_ALB, &
PSCA_ALB,PEMIS,PTSRAD,PTSURF )
! ############################################################
!
@@ -85,8 +84,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('UPDATE_ESM_FLAKE_N',0,ZHOOK_HANDLE)
!
- CALL UPDATE_RAD_FLAKE(F%CFLK_ALB,F%XTS,PZENITH,F%XH_ICE,F%XH_SNOW,F%XICE_ALB,F%XSNOW_ALB,&
- F%XDIR_ALB,F%XSCA_ALB,F%XEMIS,PDIR_ALB,PSCA_ALB,PEMIS,PTSRAD )
+ CALL UPDATE_RAD_FLAKE(F,PZENITH,PDIR_ALB,PSCA_ALB,PEMIS,PTSRAD )
!
PTSURF(:) = F%XTS(:)
!
diff --git a/src/SURFEX/update_esm_isban.F90 b/src/SURFEX/update_esm_isban.F90
index 2a81967f5e13cba04fcfc1d1f6f489e58b94d757..589ea35e348ca063aabc20a3b01d9a1779e0cec2 100644
--- a/src/SURFEX/update_esm_isban.F90
+++ b/src/SURFEX/update_esm_isban.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ################################################################
- SUBROUTINE UPDATE_ESM_ISBA_n (I, &
- KI,KSW,PZENITH,PSW_BANDS,PDIR_ALB,&
+ SUBROUTINE UPDATE_ESM_ISBA_n (IO, S, K, NK, NP, NPE, KI,KSW,PZENITH,PSW_BANDS,PDIR_ALB,&
PSCA_ALB,PEMIS,PTSRAD,PTSURF )
! ################################################################
!
@@ -44,8 +43,9 @@
!* 0. DECLARATIONS
! ------------
!
-!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_P_t, ISBA_PE_t, ISBA_NK_t, &
+ ISBA_NP_t, ISBA_NPE_t
!
USE MODD_TYPE_SNOW
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -63,8 +63,12 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_NK_t), INTENT(INOUT) :: NK
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
!
INTEGER, INTENT(IN) :: KI ! number of points
INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands
@@ -82,15 +86,21 @@ REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF ! surface effective
!* 0.2 Declarations of local variables
! -------------------------------
!
-REAL, DIMENSION(KI,KSW,I%NPATCH) :: ZDIR_ALB_PATCH
-REAL, DIMENSION(KI,KSW,I%NPATCH) :: ZSCA_ALB_PATCH
-REAL, DIMENSION(KI,I%NPATCH) :: ZEMIS_PATCH
-REAL, DIMENSION(KI,I%NPATCH) :: ZTSRAD_PATCH
-REAL, DIMENSION(KI,I%NPATCH) :: ZTSURF_PATCH
-REAL, DIMENSION(KI,I%NPATCH) :: ZEMIS ! emissivity with flood
+TYPE(ISBA_K_t), POINTER :: KK
+TYPE(ISBA_P_t), POINTER :: PK
+TYPE(ISBA_PE_t), POINTER :: PEK
+!
+REAL, DIMENSION(KI,KSW,IO%NPATCH) :: ZDIR_ALB_PATCH
+REAL, DIMENSION(KI,KSW,IO%NPATCH) :: ZSCA_ALB_PATCH
+REAL, DIMENSION(KI,IO%NPATCH) :: ZEMIS_PATCH
+REAL, DIMENSION(KI,IO%NPATCH) :: ZTSRAD_PATCH
+REAL, DIMENSION(KI,IO%NPATCH) :: ZTSURF_PATCH
+REAL, DIMENSION(KI,IO%NPATCH) :: ZEMIS ! emissivity with flood
!
LOGICAL :: LEXPLICIT_SNOW ! snow scheme key
!
+INTEGER :: IMASK, JI, JP
+!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
@@ -103,58 +113,72 @@ IF (LHOOK) CALL DR_HOOK('UPDATE_ESM_ISBA_N',0,ZHOOK_HANDLE)
ZDIR_ALB_PATCH(:,:,:) = 0.0
ZSCA_ALB_PATCH(:,:,:) = 0.0
ZEMIS_PATCH (:,: ) = 0.0
-ZEMIS (:,: ) = I%XEMIS(:,:)
!
-LEXPLICIT_SNOW = (I%TSNOW%SCHEME=='3-L'.OR.I%TSNOW%SCHEME=='CRO')
+LEXPLICIT_SNOW = (NPE%AL(1)%TSNOW%SCHEME=='3-L'.OR.NPE%AL(1)%TSNOW%SCHEME=='CRO')
!
-ZTSRAD_PATCH (:,:) = I%XTG(:,1,:)
-ZTSURF_PATCH (:,:) = I%XTG(:,1,:)
!
!
!* 2. Update nature albedo and emissivity
! -----------------------------------
!
- CALL UPDATE_RAD_ISBA_n(I, &
- I%LFLOOD,I%TSNOW%SCHEME,PZENITH,PSW_BANDS,I%XVEG,I%XLAI,I%XZ0, &
- I%LMEB_PATCH,I%XLAIGV,I%XGNDLITTER,I%XZ0LITTER,I%XH_VEG, &
- I%XALBNIR,I%XALBVIS,I%XALBUV,I%XEMIS, &
- ZDIR_ALB_PATCH,ZSCA_ALB_PATCH,ZEMIS_PATCH )
-!
-!* 3. radiative surface temperature
-! -----------------------------
-!
-IF(LEXPLICIT_SNOW.AND.I%LFLOOD)THEN
- WHERE(I%XPSN(:,:)<1.0.AND.I%XEMIS(:,:)/=XUNDEF)
- ZEMIS(:,:) = ((1.-I%XFF(:,:)-I%XPSN(:,:))*I%XEMIS(:,:) + I%XFF(:,:)*I%XEMISF(:,:)) / (1.-I%XPSN(:,:))
- ENDWHERE
-ENDIF
-!
-IF(LEXPLICIT_SNOW)THEN
- WHERE(I%XEMIS(:,:)/=XUNDEF.AND.ZEMIS_PATCH(:,:)/=0.)
- ZTSRAD_PATCH(:,:) = ( ( (1.-I%XPSN(:,:))*ZEMIS (:,:)*I%XTG (:,1,:)**4 &
- + I%XPSN(:,:) *I%TSNOW%EMIS(:,:)*I%TSNOW%TS(:,:)**4 ) &
- / ZEMIS_PATCH(:,:) )**0.25
- ENDWHERE
-ENDIF
-!
+ZEMIS(:,:) = 0.0
+ZTSRAD_PATCH(:,:) = 0.0
+ZTSURF_PATCH(:,:) = 0.0
+!
+DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+ KK => NK%AL(JP)
+
+ CALL UPDATE_RAD_ISBA_n(IO, S, KK, PK, PEK, JP, PZENITH, PSW_BANDS, &
+ ZDIR_ALB_PATCH(:,:,JP),ZSCA_ALB_PATCH(:,:,JP),ZEMIS_PATCH(:,JP) )
+ !
+ !* 3. radiative surface temperature
+ ! -----------------------------
+ !
+ DO JI = 1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+
+ ZEMIS (IMASK,JP) = PEK%XEMIS(JI)
+
+ IF(LEXPLICIT_SNOW.AND.IO%LFLOOD)THEN
+ IF (PEK%XPSN(JI)<1.0.AND.PEK%XEMIS(JI)/=XUNDEF) THEN
+ ZEMIS(IMASK,JP) = ((1.-KK%XFF(JI)-PEK%XPSN(JI))*PEK%XEMIS(JI) + &
+ KK%XFF(JI)*KK%XEMISF(JI)) / (1.-PEK%XPSN(JI))
+ ENDIF
+ ENDIF
+ !
+ ZTSRAD_PATCH (IMASK,JP) = PEK%XTG(JI,1)
+ ZTSURF_PATCH (IMASK,JP) = PEK%XTG(JI,1)
+ !
+ IF(LEXPLICIT_SNOW)THEN
+ IF(PEK%XEMIS(JI)/=XUNDEF.AND.ZEMIS_PATCH(IMASK,JP)/=0.) THEN
+ ZTSRAD_PATCH(IMASK,JP) = ( ( (1.-PEK%XPSN(JI))*ZEMIS(IMASK,JP)*PEK%XTG(JI,1)**4 &
+ + PEK%XPSN(JI) *PEK%TSNOW%EMIS(JI)*PEK%TSNOW%TS(JI)**4 ) &
+ / ZEMIS_PATCH(IMASK,JP) )**0.25
+ ENDIF
+ ZTSURF_PATCH(IMASK,JP) = PEK%XTG(JI,1)*(1.-PEK%XPSN(JI)) + PEK%TSNOW%TS(JI)*PEK%XPSN(JI)
+
+ ENDIF
+ !
+ ENDDO
+ !
+ENDDO
!
!* 4. averaged fields
! ---------------
!
- CALL AVERAGE_RAD(I%XPATCH, &
+ CALL AVERAGE_RAD(S%XPATCH, &
ZDIR_ALB_PATCH, ZSCA_ALB_PATCH, ZEMIS_PATCH, ZTSRAD_PATCH, &
- PDIR_ALB, PSCA_ALB, I%XEMIS_NAT, I%XTSRAD_NAT )
+ PDIR_ALB, PSCA_ALB, S%XEMIS_NAT, S%XTSRAD_NAT )
!
-PEMIS = I%XEMIS_NAT
-PTSRAD = I%XTSRAD_NAT
+PEMIS = S%XEMIS_NAT
+PTSRAD = S%XTSRAD_NAT
!
!* averaged effective temperature
!
-IF(LEXPLICIT_SNOW)THEN
- ZTSURF_PATCH(:,:) = I%XTG(:,1,:)*(1.-I%XPSN(:,:)) + I%TSNOW%TS(:,:)*I%XPSN(:,:)
-ENDIF
!
- CALL AVERAGE_TSURF(I%XPATCH, ZTSURF_PATCH, PTSURF)
+ CALL AVERAGE_TSURF(S%XPATCH, ZTSURF_PATCH, PTSURF)
!
IF (LHOOK) CALL DR_HOOK('UPDATE_ESM_ISBA_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/update_esm_seafluxn.F90 b/src/SURFEX/update_esm_seafluxn.F90
index ecd92e3ab4591eceb259f8e703d2f0ef4ccfba69..73270992fc42240d5119fe2a69d54cd9890234ed 100644
--- a/src/SURFEX/update_esm_seafluxn.F90
+++ b/src/SURFEX/update_esm_seafluxn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###################################################################
- SUBROUTINE UPDATE_ESM_SEAFLUX_n (S, &
- KI,KSW,PZENITH,PDIR_ALB, &
+ SUBROUTINE UPDATE_ESM_SEAFLUX_n (S, KI,KSW,PZENITH,PDIR_ALB, &
PSCA_ALB,PEMIS,PTSRAD,PTSURF )
! ##############################################################
!
@@ -86,8 +85,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('UPDATE_ESM_SEAFLUX_N',0,ZHOOK_HANDLE)
!
- CALL UPDATE_RAD_SEA(S%CSEA_ALB,S%XSST,PZENITH,XTTS,S%XEMIS,S%XDIR_ALB,&
- S%XSCA_ALB,PDIR_ALB,PSCA_ALB,PEMIS,PTSRAD )
+CALL UPDATE_RAD_SEA(S,PZENITH,XTTS,PDIR_ALB,PSCA_ALB,PEMIS,PTSRAD )
!
PTSURF(:) = S%XSST(:)
!
diff --git a/src/SURFEX/update_esm_surf_atmn.F90 b/src/SURFEX/update_esm_surf_atmn.F90
index 5bfa0be16d7b94bc44b09a15a9c3f464272cf908..f935bf35ca83798e7fdfc0454a58289c6413f88b 100644
--- a/src/SURFEX/update_esm_surf_atmn.F90
+++ b/src/SURFEX/update_esm_surf_atmn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #################################################################################
-SUBROUTINE UPDATE_ESM_SURF_ATM_n (F, I, S, U, W, &
- HPROGRAM, KI, KSW, PZENITH, PSW_BANDS, &
+SUBROUTINE UPDATE_ESM_SURF_ATM_n (F, IM, S, U, W, HPROGRAM, KI, KSW, PZENITH, PSW_BANDS, &
PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF )
! #################################################################################
!
@@ -34,12 +33,8 @@ SUBROUTINE UPDATE_ESM_SURF_ATM_n (F, I, S, U, W, &
!!-------------------------------------------------------------
!
!
-!
-!
-!
-!
USE MODD_FLAKE_n, ONLY : FLAKE_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t
USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_WATFLUX_n, ONLY : WATFLUX_t
@@ -68,7 +63,7 @@ IMPLICIT NONE
!
!
TYPE(FLAKE_t), INTENT(INOUT) :: F
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
TYPE(SEAFLUX_t), INTENT(INOUT) :: S
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(WATFLUX_t), INTENT(INOUT) :: W
@@ -205,7 +200,7 @@ ENDIF
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
IF (LHOOK) CALL DR_HOOK('UPDATE_ESM_SURF_ATM_N',1,ZHOOK_HANDLE)
- CONTAINS
+CONTAINS
!=======================================================================================
SUBROUTINE TREAT_SURF(KSIZE,KMASK,KTILE)
!
@@ -242,8 +237,7 @@ ENDDO
IF (KTILE==1) THEN
!
IF (U%CSEA=='SEAFLX') THEN
- CALL UPDATE_ESM_SEAFLUX_n(S, &
- U%NSIZE_SEA,KSW,ZP_ZENITH,ZP_DIR_ALB, &
+ CALL UPDATE_ESM_SEAFLUX_n(S, U%NSIZE_SEA,KSW,ZP_ZENITH,ZP_DIR_ALB, &
ZP_SCA_ALB,ZP_EMIS,ZP_TRAD,ZP_TSURF )
ELSE
CALL ABOR1_SFX('UPDATE_ESM_SURF_ATM_n: SEA SCHEME MUST BE ACTIVATED FOR EARTH SYSTEM MODEL')
@@ -252,12 +246,10 @@ IF (KTILE==1) THEN
ELSEIF (KTILE==2) THEN
!
IF (U%CWATER=='WATFLX') THEN
- CALL UPDATE_ESM_WATFLUX_n(W, &
- U%NSIZE_WATER,KSW,ZP_ZENITH,ZP_DIR_ALB, &
+ CALL UPDATE_ESM_WATFLUX_n(W, U%NSIZE_WATER,KSW,ZP_ZENITH,ZP_DIR_ALB, &
ZP_SCA_ALB,ZP_EMIS,ZP_TRAD,ZP_TSURF )
ELSEIF (U%CWATER=='FLAKE ') THEN
- CALL UPDATE_ESM_FLAKE_n(F, &
- U%NSIZE_WATER,KSW,ZP_ZENITH,ZP_DIR_ALB, &
+ CALL UPDATE_ESM_FLAKE_n(F, U%NSIZE_WATER,KSW,ZP_ZENITH,ZP_DIR_ALB, &
ZP_SCA_ALB,ZP_EMIS,ZP_TRAD,ZP_TSURF )
ELSE
CALL ABOR1_SFX('UPDATE_ESM_SURF_ATM_n: INLAND WATER SCHEME MUST BE ACTIVATED FOR EARTH SYSTEM MODEL')
@@ -266,8 +258,8 @@ ELSEIF (KTILE==2) THEN
ELSEIF (KTILE==3) THEN
!
IF (U%CNATURE=='ISBA') THEN
- CALL UPDATE_ESM_ISBA_n(I, &
- U%NSIZE_NATURE,KSW,ZP_ZENITH,PSW_BANDS,ZP_DIR_ALB, &
+ CALL UPDATE_ESM_ISBA_n(IM%O, IM%S, IM%K, IM%NK, IM%NP, IM%NPE, U%NSIZE_NATURE,&
+ KSW,ZP_ZENITH,PSW_BANDS,ZP_DIR_ALB, &
ZP_SCA_ALB,ZP_EMIS,ZP_TRAD,ZP_TSURF )
ELSE
CALL ABOR1_SFX('UPDATE_ESM_SURF_ATM_n: NATURE SCHEME MUST BE ACTIVATED FOR EARTH SYSTEM MODEL')
diff --git a/src/SURFEX/update_esm_watfluxn.F90 b/src/SURFEX/update_esm_watfluxn.F90
index 15d75d0d719fcee5e60d8094d9181e9d1eed2940..90980ad14e6d6f1071c031d0660c33c13f5a6185 100644
--- a/src/SURFEX/update_esm_watfluxn.F90
+++ b/src/SURFEX/update_esm_watfluxn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ##############################################################
- SUBROUTINE UPDATE_ESM_WATFLUX_n (W, &
- KI,KSW,PZENITH,PDIR_ALB, &
+ SUBROUTINE UPDATE_ESM_WATFLUX_n (W, KI,KSW,PZENITH,PDIR_ALB, &
PSCA_ALB,PEMIS,PTSRAD,PTSURF )
! ##############################################################
!
@@ -87,8 +86,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('UPDATE_ESM_WATFLUX_N',0,ZHOOK_HANDLE)
!
- CALL UPDATE_RAD_WATER(W%CWAT_ALB,W%XTS,PZENITH,XTT,W%XEMIS,W%XDIR_ALB,&
- W%XSCA_ALB,PDIR_ALB,PSCA_ALB,PEMIS,PTSRAD )
+CALL UPDATE_RAD_WATER(W,PZENITH,XTT,PDIR_ALB,PSCA_ALB,PEMIS,PTSRAD )
!
PTSURF(:) = W%XTS(:)
!
diff --git a/src/SURFEX/update_rad_flake.F90 b/src/SURFEX/update_rad_flake.F90
index 43f7ffc9b595030b0e10aa319cfc535e2bc3c7d8..b360d624c2a3e0f0ce8557f0db0161c61f9ab25e 100644
--- a/src/SURFEX/update_rad_flake.F90
+++ b/src/SURFEX/update_rad_flake.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE UPDATE_RAD_FLAKE(HALB,PTS,PZENITH,PH_ICE,PH_SNOW,PICE_ALB,PSNOW_ALB, &
- PDIR_ALB,PSCA_ALB,PEMIS,PDIR_ALB_ATMOS,PSCA_ALB_ATMOS,&
- PEMIS_ATMOS,PTRAD )
+SUBROUTINE UPDATE_RAD_FLAKE(F,PZENITH,PDIR_ALB_ATMOS,PSCA_ALB_ATMOS,PEMIS_ATMOS,PTRAD )
! #######################################################################
!
!!**** *UPDATE_RAD_FLAKE * - update the radiative properties at time t+1 (see by the atmosphere)
@@ -31,6 +29,8 @@ SUBROUTINE UPDATE_RAD_FLAKE(HALB,PTS,PZENITH,PH_ICE,PH_SNOW,PICE_ALB,PSNOW_ALB,
!! Original 04/2013
!!------------------------------------------------------------------
!
+USE MODD_FLAKE_n, ONLY : FLAKE_t
+!
USE MODD_WATER_PAR, ONLY : XALBSCA_WAT, XALBWAT, XEMISWAT, XEMISWATICE
!
USE modd_flake_parameters , ONLY : h_Snow_min_flk, h_Ice_min_flk
@@ -47,19 +47,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
- CHARACTER(LEN=4), INTENT(IN) :: HALB
-!
-REAL, DIMENSION(:), INTENT(IN) :: PTS ! surface temperature
+TYPE(FLAKE_t), INTENT(INOUT) :: F
REAL, DIMENSION(:), INTENT(IN) :: PZENITH ! Zenithal angle at t+1
-REAL, DIMENSION(:), INTENT(IN) :: PH_ICE ! ice depth at t+
-REAL, DIMENSION(:), INTENT(IN) :: PH_SNOW ! snow depth at t+
-REAL, DIMENSION(:), INTENT(IN) :: PICE_ALB ! ice albedo at t+
-REAL, DIMENSION(:), INTENT(IN) :: PSNOW_ALB ! snow albedo at t+
-!
-REAL, DIMENSION(:), INTENT(INOUT):: PDIR_ALB ! Direct albedo at t+1
-REAL, DIMENSION(:), INTENT(INOUT):: PSCA_ALB ! Diffuse albedo at t+1
-REAL, DIMENSION(:), INTENT(OUT) :: PEMIS ! emissivity (soil+vegetation) at t+1
-!
REAL, DIMENSION(:,:), INTENT(OUT) :: PDIR_ALB_ATMOS ! Direct albedo at t+1 for the atmosphere
REAL, DIMENSION(:,:), INTENT(OUT) :: PSCA_ALB_ATMOS ! Diffuse albedo at t+1 for the atmosphere
REAL, DIMENSION(:), INTENT(OUT) :: PEMIS_ATMOS ! Emissivity at t+1 for the atmosphere
@@ -69,8 +58,8 @@ REAL, DIMENSION(:), INTENT(OUT) :: PTRAD ! radiative temp at t+1 f
!
INTEGER :: JSWB
!
-REAL, DIMENSION(SIZE(PTS)) :: ZALBDIR
-REAL, DIMENSION(SIZE(PTS)) :: ZALBSCA
+REAL, DIMENSION(SIZE(F%XTS)) :: ZALBDIR
+REAL, DIMENSION(SIZE(F%XTS)) :: ZALBSCA
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -81,10 +70,10 @@ IF (LHOOK) CALL DR_HOOK('UPDATE_RAD_FLAKE',0,ZHOOK_HANDLE)
ZALBDIR(:) = 0.
ZALBSCA(:) = 0.
!
-IF (HALB=='TA96') THEN
+IF (F%CFLK_ALB=='TA96') THEN
ZALBDIR(:) = ALBEDO_TA96(PZENITH(:))
ZALBSCA(:) = XALBSCA_WAT
-ELSEIF (HALB=='MK10') THEN
+ELSEIF (F%CFLK_ALB=='MK10') THEN
ZALBDIR(:) = ALBEDO_MK10(PZENITH(:))
ZALBSCA(:) = XALBSCA_WAT
ELSE
@@ -92,32 +81,32 @@ ELSE
ZALBSCA(:) = XALBWAT
ENDIF
!
-WHERE (PH_SNOW(:)>=h_Snow_min_flk)
+WHERE (F%XH_SNOW(:)>=h_Snow_min_flk)
!* snow
- PDIR_ALB (:) = PSNOW_ALB(:)
- PSCA_ALB (:) = PSNOW_ALB(:)
- PEMIS (:) = XEMISSN
-ELSEWHERE(PH_ICE(:)>=h_ice_min_flk)
+ F%XDIR_ALB (:) = F%XSNOW_ALB(:)
+ F%XSCA_ALB (:) = F%XSNOW_ALB(:)
+ F%XEMIS (:) = XEMISSN
+ELSEWHERE(F%XH_ICE(:)>=h_ice_min_flk)
!* ice
- PDIR_ALB(:) = PICE_ALB(:)
- PSCA_ALB(:) = PICE_ALB(:)
- PEMIS (:) = XEMISWATICE
+ F%XDIR_ALB(:) = F%XICE_ALB(:)
+ F%XSCA_ALB(:) = F%XICE_ALB(:)
+ F%XEMIS (:) = XEMISWATICE
ELSEWHERE
!* open water
- PDIR_ALB (:) = ZALBDIR(:)
- PSCA_ALB (:) = ZALBSCA(:)
- PEMIS (:) = XEMISWAT
+ F%XDIR_ALB (:) = ZALBDIR(:)
+ F%XSCA_ALB (:) = ZALBSCA(:)
+ F%XEMIS (:) = XEMISWAT
END WHERE
!
!-------------------------------------------------------------------------------------
!
DO JSWB=1,SIZE(PDIR_ALB_ATMOS,2)
- PDIR_ALB_ATMOS(:,JSWB) = PDIR_ALB(:)
- PSCA_ALB_ATMOS(:,JSWB) = PSCA_ALB(:)
+ PDIR_ALB_ATMOS(:,JSWB) = F%XDIR_ALB(:)
+ PSCA_ALB_ATMOS(:,JSWB) = F%XSCA_ALB(:)
END DO
!
-PEMIS_ATMOS(:) = PEMIS(:)
-PTRAD (:) = PTS (:)
+PEMIS_ATMOS(:) = F%XEMIS(:)
+PTRAD (:) = F%XTS (:)
!
IF (LHOOK) CALL DR_HOOK('UPDATE_RAD_FLAKE',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/update_rad_isban.F90 b/src/SURFEX/update_rad_isban.F90
index 44e8aa705366ddc32582838dfea6a6b4c7bdfd7e..28b02d03df40b9fe4d9292a10cc771a9263281c7 100644
--- a/src/SURFEX/update_rad_isban.F90
+++ b/src/SURFEX/update_rad_isban.F90
@@ -3,14 +3,9 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE UPDATE_RAD_ISBA_n (I, &
- OFLOOD,HSNOW,PZENITH,PSW_BANDS,PVEG,PLAI,PZ0, &
- OMEB_PATCH,PLAIGV,PGNDLITTER,PZ0LITTER, PH_VEG, &
- PALBNIR,PALBVIS,PALBUV,PEMIS, &
- PDIR_ALB_WITH_SNOW,PSCA_ALB_WITH_SNOW,PEMIST, &
- PDIR_SW,PSCA_SW, &
- PALBNIR_VEG, PALBNIR_SOIL, &
- PALBVIS_VEG, PALBVIS_SOIL )
+SUBROUTINE UPDATE_RAD_ISBA_n (IO, S, KK, PK, PEK, KPATCH, PZENITH, PSW_BANDS, &
+ PDIR_ALB_WITH_SNOW,PSCA_ALB_WITH_SNOW, PEMIST, &
+ PDIR_SW, PSCA_SW )
! ####################################################################
!
!!**** *UPDATE_RAD_ISBA_n * - Calculate snow/flood fraction, dir/dif albedo
@@ -27,7 +22,7 @@ SUBROUTINE UPDATE_RAD_ISBA_n (I, &
!! REFERENCE
!! ---------
!!
-!!
+!,ZEMIST,PEMIST,ZPUT0)!
!! AUTHOR
!! ------
!! B. Decharme
@@ -40,12 +35,11 @@ SUBROUTINE UPDATE_RAD_ISBA_n (I, &
!!------------------------------------------------------------------
!
!
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY: ISBA_S_t, ISBA_K_t, ISBA_P_t, ISBA_PE_t
!
USE MODD_TYPE_SNOW
!
-USE MODD_DATA_COVER_PAR, ONLY : NVT_SNOW
-!
USE MODD_CSTS, ONLY : XTT
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_SNOW_PAR, ONLY : XRHOSMIN_ES,XRHOSMAX_ES,XSNOWDMIN,XEMISSN
@@ -73,42 +67,50 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
!
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
!
-LOGICAL, INTENT(IN) :: OFLOOD
- CHARACTER(LEN=*), INTENT(IN) :: HSNOW
+INTEGER, INTENT(IN) :: KPATCH
!
REAL, DIMENSION(:), INTENT(IN) :: PZENITH ! Zenithal angle at t+1
REAL, DIMENSION(:), INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m)
-REAL, DIMENSION(:,:), INTENT(IN) :: PVEG ! Vegetation fraction at t+1
-REAL, DIMENSION(:,:), INTENT(IN) :: PLAI ! leaf area index at t+1
-REAL, DIMENSION(:,:), INTENT(IN) :: PZ0 ! roughness length at t+1
-REAL, DIMENSION(:,:), INTENT(IN) :: PALBNIR ! near-infra-red albedo (soil+vegetation) at t+1
-REAL, DIMENSION(:,:), INTENT(IN) :: PALBVIS ! visible albedo (soil+vegetation) at t+1
-REAL, DIMENSION(:,:), INTENT(IN) :: PALBUV ! UV albedo (soil+vegetation) at t+1
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMIS ! emissivity (soil+vegetation) at t+1
-LOGICAL, DIMENSION(:), INTENT(IN) :: OMEB_PATCH ! multi-energy balance logical vector
-REAL, DIMENSION(:,:), INTENT(IN) :: PGNDLITTER ! Ground litter fraction at t+1
-REAL, DIMENSION(:,:), INTENT(IN) :: PLAIGV ! Understory leaf area index at t+1
-REAL, DIMENSION(:,:), INTENT(IN) :: PZ0LITTER ! Ground litter roughness length at t+1
-REAL, DIMENSION(:,:), INTENT(IN) :: PH_VEG
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDIR_ALB_WITH_SNOW ! Total direct albedo at t+1
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSCA_ALB_WITH_SNOW ! Total diffuse albedo at t+1
-REAL, DIMENSION(:,:), INTENT(OUT) :: PEMIST ! Total emissivity at t+1
+!
+REAL, DIMENSION(:,:), INTENT(OUT) :: PDIR_ALB_WITH_SNOW ! Total direct albedo at t+1
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSCA_ALB_WITH_SNOW ! Total diffuse albedo at t+1
+REAL, DIMENSION(:), INTENT(OUT) :: PEMIST ! Total emissivity at t+1
!
REAL, DIMENSION(:,:), INTENT(IN), OPTIONAL :: PDIR_SW ! direct solar radiation (on horizontal surf.)
REAL, DIMENSION(:,:), INTENT(IN), OPTIONAL :: PSCA_SW ! diffuse solar radiation (on horizontal surf.)
-REAL, DIMENSION(:,:), INTENT(IN), OPTIONAL :: PALBNIR_VEG ! near-infra-red albedo (vegetation) at t+1
-REAL, DIMENSION(:,:), INTENT(IN), OPTIONAL :: PALBNIR_SOIL ! near-infra-red albedo (soil) at t+1
-REAL, DIMENSION(:,:), INTENT(IN), OPTIONAL :: PALBVIS_VEG ! visible albedo (vegetation) at t+1
-REAL, DIMENSION(:,:), INTENT(IN), OPTIONAL :: PALBVIS_SOIL ! visible albedo (soil) at t+1
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(SIZE(I%XVEGTYPE,1),SIZE(I%XVEGTYPE,2)) :: ZVEGTYPE
+REAL, DIMENSION(PK%NSIZE_P) :: ZVEG
+REAL, DIMENSION(PK%NSIZE_P) :: ZPSNV_A
+REAL, DIMENSION(PK%NSIZE_P) :: ZALBF_DIR
+REAL, DIMENSION(PK%NSIZE_P) :: ZALBF_SCA
+REAL, DIMENSION(PK%NSIZE_P) :: ZEMISF
+REAL, DIMENSION(PK%NSIZE_P) :: ZFF
+REAL, DIMENSION(PK%NSIZE_P) :: ZALBNIR_WITH_SNOW
+REAL, DIMENSION(PK%NSIZE_P) :: ZALBVIS_WITH_SNOW
+REAL, DIMENSION(PK%NSIZE_P) :: ZALBUV_WITH_SNOW
+REAL, DIMENSION(PK%NSIZE_P) :: ZZENITH
+REAL, DIMENSION(PK%NSIZE_P) :: ZSNOWDEPTH, ZPALPHAN
+REAL, DIMENSION(PK%NSIZE_P) :: ZSWUP
+REAL, DIMENSION(PK%NSIZE_P) :: ZGLOBAL_SW
+REAL, DIMENSION(PK%NSIZE_P) :: ZALBT, ZEMIST
+REAL, DIMENSION(PK%NSIZE_P) :: ZPSNA, ZSIGMA_F, ZSIGMA_FN, ZEMISSN
+REAL, DIMENSION(PK%NSIZE_P,SIZE(PSW_BANDS)) :: ZDIR_SW, ZSCA_SW
+REAL, DIMENSION(PK%NSIZE_P) :: ZLAIN, ZALBVIS_TSOIL, ZALBNIR_TSOIL
+REAL, DIMENSION(PK%NSIZE_P) :: ZFAPIR, ZFAPAR, ZFAPIR_BS, ZFAPAR_BS
+REAL, DIMENSION(PK%NSIZE_P,SIZE(S%XABC)) :: ZIACAN_SUNLIT, ZIACAN_SHADE, ZFRAC_SUN, ZIACAN
+LOGICAL, DIMENSION(PK%NSIZE_P) :: GSHADE
!
-INTEGER :: JPATCH, ISWB, JJ
+REAL, PARAMETER :: ZPUT0 = 0.0
+INTEGER :: ISWB
+INTEGER :: JSWB
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
@@ -118,189 +120,72 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('UPDATE_RAD_ISBA_N',0,ZHOOK_HANDLE)
ISWB = SIZE(PSW_BANDS)
!
-! Re-order VEGTYPE array to correspond with mask NR_NATURE_P:
-!
-ZVEGTYPE(:,:) = 0.
-DO JPATCH=1,I%NPATCH
- DO JJ=1,I%NSIZE_NATURE_P(JPATCH)
- ZVEGTYPE(JJ,JPATCH) = I%XVEGTYPE(I%NR_NATURE_P(JJ,JPATCH),JPATCH)
- ENDDO
-ENDDO
-!
!-------------------------------------------------------------------------------------
-!Patch loop
!
-DO JPATCH=1,I%NPATCH
+ZVEG(:) = PEK%XVEG(:)
+!
+IF(IO%LMEB_PATCH(KPATCH).OR.IO%LFLOOD)THEN
!
- IF(I%NSIZE_NATURE_P(JPATCH)>0) CALL TREAT_NATURE(I%NSIZE_NATURE_P(JPATCH),JPATCH)
+ CALL PACK_SAME_RANK(PK%NR_P,PZENITH(:),ZZENITH(:))
!
-ENDDO
-!-------------------------------------------------------------------------------
-!
-!Update albedo with snow for the next time step
-!
-PDIR_ALB_WITH_SNOW(:,:,:)=I%XDIR_ALB_WITH_SNOW (:,:,:)
-PSCA_ALB_WITH_SNOW(:,:,:)=I%XSCA_ALB_WITH_SNOW (:,:,:)
-!
-IF (LHOOK) CALL DR_HOOK('UPDATE_RAD_ISBA_N',1,ZHOOK_HANDLE)
-!
- CONTAINS
-!
-SUBROUTINE TREAT_NATURE(KSIZE,KPATCH)
-!
-IMPLICIT NONE
-!
-INTEGER, INTENT(IN) :: KSIZE
-INTEGER, INTENT(IN) :: KPATCH
-!
-INTEGER :: JP
-INTEGER, DIMENSION(KSIZE) :: IMASK
-!
-REAL, DIMENSION(KSIZE,SIZE(I%TSNOW%WSNOW,2)) :: ZLAYERSWE
-REAL, DIMENSION(KSIZE,SIZE(I%TSNOW%WSNOW,2)) :: ZLAYERRHO
-REAL, DIMENSION(KSIZE,SIZE(I%TSNOW%WSNOW,2)) :: ZLAYERAGE
-!
-REAL, DIMENSION(KSIZE,ISWB) :: ZDIR_ALB_WITH_SNOW
-REAL, DIMENSION(KSIZE,ISWB) :: ZSCA_ALB_WITH_SNOW
-!
-REAL, DIMENSION(KSIZE) :: ZSNOWALB
-REAL, DIMENSION(KSIZE) :: ZSNOWALBVIS
-REAL, DIMENSION(KSIZE) :: ZSNOWALBNIR
-REAL, DIMENSION(KSIZE) :: ZLAI
-!REAL, DIMENSION(KSIZE) :: ZLAIV
-REAL, DIMENSION(KSIZE) :: ZZ0
-REAL, DIMENSION(KSIZE) :: ZVEG
-REAL, DIMENSION(KSIZE) :: ZEMIS
-REAL, DIMENSION(KSIZE) :: ZALBNIR
-REAL, DIMENSION(KSIZE) :: ZALBVIS
-REAL, DIMENSION(KSIZE) :: ZALBUV
-REAL, DIMENSION(KSIZE) :: ZALBNIR_VEG
-REAL, DIMENSION(KSIZE) :: ZALBNIR_SOIL
-REAL, DIMENSION(KSIZE) :: ZALBVIS_VEG
-REAL, DIMENSION(KSIZE) :: ZALBVIS_SOIL
-!
-REAL, DIMENSION(KSIZE) :: ZPSN
-REAL, DIMENSION(KSIZE) :: ZPSNV_A
-REAL, DIMENSION(KSIZE) :: ZPSNG
-REAL, DIMENSION(KSIZE) :: ZPSNV
-!
-REAL, DIMENSION(KSIZE) :: ZALBF
-REAL, DIMENSION(KSIZE) :: ZALBF_DIR
-REAL, DIMENSION(KSIZE) :: ZALBF_SCA
-REAL, DIMENSION(KSIZE) :: ZEMISF
-REAL, DIMENSION(KSIZE) :: ZFF
-!
-REAL, DIMENSION(KSIZE) :: ZALBNIR_WITH_SNOW
-REAL, DIMENSION(KSIZE) :: ZALBVIS_WITH_SNOW
-REAL, DIMENSION(KSIZE) :: ZALBUV_WITH_SNOW
-!
-REAL, DIMENSION(KSIZE) :: ZEMIST
-REAL, DIMENSION(KSIZE) :: ZZENITH
-REAL, DIMENSION(KSIZE) :: ZH_VEG
-REAL, DIMENSION(KSIZE) :: ZSNOWDEPTH, ZPALPHAN
-REAL, DIMENSION(KSIZE) :: ZSWUP
-REAL, DIMENSION(KSIZE) :: ZGLOBAL_SW
-REAL, DIMENSION(KSIZE) :: ZALBT
-REAL, DIMENSION(KSIZE) :: ZPSNA, ZSIGMA_F, ZSIGMA_FN, ZEMISSN
-REAL, DIMENSION(KSIZE,ISWB) :: ZDIR_SW, ZSCA_SW
-REAL, DIMENSION(KSIZE) :: ZPERMSNOWFRAC, ZDSGRAIN
-REAL, DIMENSION(KSIZE,3) :: ZSPECTRALALBEDO
-!
-REAL, DIMENSION(KSIZE) :: ZLAIN, ZALBVIS_TSOIL, ZALBNIR_TSOIL
-REAL, DIMENSION(KSIZE) :: ZFAPIR, ZFAPAR, ZFAPIR_BS, ZFAPAR_BS
-REAL, DIMENSION(KSIZE,SIZE(I%XABC)) :: ZIACAN_SUNLIT, ZIACAN_SHADE, ZFRAC_SUN, ZIACAN
-REAL, DIMENSION(KSIZE) :: ZFAPARC, ZFAPIRC, ZMUS, ZLAI_EFFC
-LOGICAL, DIMENSION(KSIZE) :: GSHADE
-!
-REAL, PARAMETER :: ZPUT0 = 0.0
-INTEGER :: JSWB
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-IF (LHOOK) CALL DR_HOOK('UPDATE_RAD_ISBA_N:TREAT_NATURE',0,ZHOOK_HANDLE)
-!
-IMASK(:)=I%NR_NATURE_P(1:KSIZE,KPATCH)
-!
- CALL PACK_SAME_RANK(IMASK(:),I%TSNOW%WSNOW(:,:,KPATCH),ZLAYERSWE(:,:))
- CALL PACK_SAME_RANK(IMASK(:),I%TSNOW%RHO (:,:,KPATCH),ZLAYERRHO(:,:))
-!
- CALL PACK_SAME_RANK(IMASK(:),I%TSNOW%ALB (:,KPATCH),ZSNOWALB(:))
-!
-IF(OMEB_PATCH(KPATCH))THEN
-
-! IF(NPATCH==1)THEN
-! ZDIR_SW(:,:) = PDIR_SW(:,:)
-! ELSE
-! DO JK=1,SIZE(PDIR_SW,2)
-! DO JJ=1,KSIZE
-! JI=IMASK(JJ)
-! ZDIR_SW(JJ,JK) = PDIR_SW (JI,JK)
-! ZSCA_SW(JJ,JK) = PSCA_SW (JI,JK)
-! ENDDO
-! ENDDO
-! ENDIF
-
- CALL PACK_SAME_RANK(IMASK(:),PZENITH (:), ZZENITH (:))
-! CALL PACK_SAME_RANK(IMASK(:),PLAIGV (:,KPATCH),ZLAI (:))
-! CALL PACK_SAME_RANK(IMASK(:),PLAI (:,KPATCH),ZLAIV (:))
-! CALL PACK_SAME_RANK(IMASK(:),PZ0LITTER (:,KPATCH),ZZ0 (:))
-! CALL PACK_SAME_RANK(IMASK(:),PGNDLITTER (:,KPATCH),ZVEG (:))
- ZVEG(:)=0. ! Set veg=0 for MEB to get bare soil conditions for snow cover and
-! ! flood fraction
- CALL PACK_SAME_RANK(IMASK(:),PH_VEG (:,KPATCH),ZH_VEG (:))
-!
- IF(PRESENT(PDIR_SW))THEN
-!
- CALL PACK_SAME_RANK(IMASK(:),PDIR_SW (:,:), ZDIR_SW (:,:))
- CALL PACK_SAME_RANK(IMASK(:),PSCA_SW (:,:), ZSCA_SW (:,:))
- CALL PACK_SAME_RANK(IMASK(:),PALBNIR_VEG (:,KPATCH),ZALBNIR_VEG (:))
- CALL PACK_SAME_RANK(IMASK(:),PALBNIR_SOIL (:,KPATCH),ZALBNIR_SOIL (:))
- CALL PACK_SAME_RANK(IMASK(:),PALBVIS_VEG (:,KPATCH),ZALBVIS_VEG (:))
- CALL PACK_SAME_RANK(IMASK(:),PALBVIS_SOIL (:,KPATCH),ZALBVIS_SOIL (:))
-!
- CALL PACK_SAME_RANK(IMASK(:),I%TSNOW%AGE (:,:,KPATCH),ZLAYERAGE(:,:))
-!
- CALL PACK_SAME_RANK(IMASK(:),I%XVEGTYPE_PATCH(:,NVT_SNOW,KPATCH),ZPERMSNOWFRAC(:))
-!
+ IF(IO%LMEB_PATCH(KPATCH))THEN
+ !
+ ZVEG(:)=0. ! Set veg=0 for MEB to get bare soil conditions for snow cover and
+ ! ! flood fraction
+ !
+ IF(PRESENT(PDIR_SW))THEN
+ !
+ CALL PACK_SAME_RANK(PK%NR_P,PDIR_SW(:,:), ZDIR_SW(:,:))
+ CALL PACK_SAME_RANK(PK%NR_P,PSCA_SW(:,:), ZSCA_SW(:,:))
+ !
+ ENDIF
+ !
ENDIF
-!
-ELSE
-! CALL PACK_SAME_RANK(IMASK(:),PLAI (:,KPATCH),ZLAI (:))
-! CALL PACK_SAME_RANK(IMASK(:),PZ0 (:,KPATCH),ZZ0 (:))
- CALL PACK_SAME_RANK(IMASK(:),PVEG (:,KPATCH),ZVEG (:))
-! ZALBNIR_VEG(:) = XUNDEF
-! ZALBNIR_SOIL(:) = XUNDEF
-! ZALBVIS_VEG(:) = XUNDEF
-! ZALBVIS_SOIL(:) = XUNDEF
-ENDIF
-!
- CALL PACK_SAME_RANK(IMASK(:),PLAI (:,KPATCH),ZLAI (:))
- CALL PACK_SAME_RANK(IMASK(:),PZ0 (:,KPATCH),ZZ0 (:))
- CALL PACK_SAME_RANK(IMASK(:),PEMIS (:,KPATCH),ZEMIS (:))
- CALL PACK_SAME_RANK(IMASK(:),PALBNIR (:,KPATCH),ZALBNIR (:))
- CALL PACK_SAME_RANK(IMASK(:),PALBVIS (:,KPATCH),ZALBVIS (:))
- CALL PACK_SAME_RANK(IMASK(:),PALBUV (:,KPATCH),ZALBUV (:))
-!
-IF (HSNOW=='3-L' .OR. HSNOW=='CRO') THEN
- CALL PACK_SAME_RANK(IMASK(:),I%TSNOW%ALBVIS (:,KPATCH),ZSNOWALBVIS(:))
- CALL PACK_SAME_RANK(IMASK(:),I%TSNOW%ALBNIR (:,KPATCH),ZSNOWALBNIR(:))
+ !
ENDIF
!
!-------------------------------------------------------------------------------
!
- CALL ISBA_SNOW_FRAC(HSNOW, ZLAYERSWE, ZLAYERRHO, ZSNOWALB, &
- ZVEG, ZLAI, ZZ0,ZPSN(:), ZPSNV_A(:), ZPSNG(:), ZPSNV(:) )
+ CALL ISBA_SNOW_FRAC(PEK%TSNOW%SCHEME, PEK%TSNOW%WSNOW, PEK%TSNOW%RHO, PEK%TSNOW%ALB, &
+ ZVEG, PEK%XLAI, PEK%XZ0, PEK%XPSN, ZPSNV_A, PEK%XPSNG, PEK%XPSNV )
!
-IF ( HSNOW=='EBA' ) CALL UNPACK_SAME_RANK(IMASK(:),ZPSNV_A(:),I%XPSNV_A(:,KPATCH),ZPUT0)
+IF ( PEK%TSNOW%SCHEME=='EBA' ) PEK%XPSNV_A(:) = ZPSNV_A(:)
!
!-------------------------------------------------------------------------------
!
! Flood fractions and properties
!
-IF(OFLOOD)THEN
- CALL TREAT_FLOOD(KSIZE,KPATCH,IMASK,ZPSNG,ZPSNV,ZLAI,ZVEG,&
- ZALBF, ZALBF_DIR,ZALBF_SCA,ZEMISF,ZFF)
+IF(IO%LFLOOD)THEN
+ !
+ KK%XFFG(:) = FLOOD_FRAC_GROUND(PEK%XPSNG,KK%XFFLOOD)
+ KK%XFFV(:) = FLOOD_FRAC_VEG (PEK%XLAI,PEK%XPSNV,KK%XFFLOOD)
+ KK%XFF (:) = FLOOD_FRAC_NAT (PEK%XVEG,KK%XFFG,KK%XFFV,KK%XFFLOOD)
+ !
+ WHERE(KK%XFFLOOD(:)==0.0)
+ ZALBF_DIR (:) = XUNDEF
+ ZALBF_SCA (:) = XUNDEF
+ KK%XALBF (:) = XUNDEF
+ KK%XEMISF (:) = XUNDEF
+ KK%XFFROZEN(:) = 0.0
+ ELSEWHERE
+ WHERE(PEK%XTG(:,1)>=XTT)
+ ZALBF_DIR (:) = ALBEDO_TA96(ZZENITH(:))
+ ZALBF_SCA (:) = XALBSCA_WAT
+ KK%XEMISF (:) = XEMISWAT
+ KK%XFFROZEN(:) = 0.0
+ ELSEWHERE
+ ZALBF_DIR (:) = XALBWATICE
+ ZALBF_SCA (:) = XALBWATICE
+ KK%XEMISF (:) = XEMISWATICE
+ KK%XFFROZEN(:) = 1.0
+ END WHERE
+ KK%XALBF(:)=0.5*(ZALBF_DIR(:)+ZALBF_SCA(:))
+ ENDWHERE
+ !
+ ZEMISF(:) = KK%XEMISF(:)
+ ZFF (:) = KK%XFF(:)
+ !
ELSE
- ZALBF (:)=0.0
ZALBF_DIR (:)=0.0
ZALBF_SCA (:)=0.0
ZEMISF (:)=0.0
@@ -308,196 +193,99 @@ ELSE
ENDIF
!-------------------------------------------------------------------------------
!
-ZSPECTRALALBEDO(:,:) = 0.
-ZPERMSNOWFRAC(:) = 0.
-!
-IF(OMEB_PATCH(KPATCH))THEN
-!
- ZSNOWDEPTH(:) = SUM(ZLAYERSWE(:,:)/ZLAYERRHO(:,:),2)
- ZPALPHAN(:) = MEBPALPHAN(ZSNOWDEPTH,ZH_VEG)
-!
- ZDIR_ALB_WITH_SNOW(:,:)=XUNDEF
- ZSCA_ALB_WITH_SNOW(:,:)=XUNDEF
-!
- IF(PRESENT(PDIR_SW))THEN
-!
-! Albedo
-!
-! - just extract some parameters for call, but no need to update
-! the cummulative variables in this routine:
-!
- CALL PACK_SAME_RANK(IMASK(:),I%XLAI_EFFC(:,KPATCH),ZLAI_EFFC(:))
- CALL PACK_SAME_RANK(IMASK(:),I%XFAPARC(:,KPATCH), ZFAPARC(:) )
- CALL PACK_SAME_RANK(IMASK(:),I%XFAPIRC(:,KPATCH), ZFAPIRC(:) )
- CALL PACK_SAME_RANK(IMASK(:),I%XMUS(:,KPATCH), ZMUS(:) )
-!
- ZPERMSNOWFRAC(:) = 0. ! assume no vegetation overlying permanent snow
-
- ZSPECTRALALBEDO(:,1) = ZSNOWALBVIS(:)
- ZSPECTRALALBEDO(:,2) = ZSNOWALBNIR(:)
- ZSPECTRALALBEDO(:,3) = XUNDEF ! Currently, MEB only considers 2 spectral bands
-!
- DO JSWB=1,ISWB
- ZGLOBAL_SW(:) = ZDIR_SW(:,JSWB) + ZSCA_SW(:,JSWB)
-
- WHERE(ZSNOWALB(:)/=XUNDEF .AND. ZSNOWALBVIS(:)/=XUNDEF .AND. ZSNOWALBNIR(:)/=XUNDEF)
- ZLAIN(:) = ZLAI(:)*(1.0-ZPALPHAN(:))
- ZALBVIS_TSOIL(:) = ZALBVIS_SOIL(:)*(1.-ZPSN(:)) + ZPSN(:)*ZSNOWALBVIS(:)
- ZALBNIR_TSOIL(:) = ZALBNIR_SOIL(:)*(1.-ZPSN(:)) + ZPSN(:)*ZSNOWALBNIR(:)
- ELSEWHERE
- ZLAIN(:) = ZLAI(:)
- ZALBVIS_TSOIL(:) = ZALBVIS_SOIL(:)
- ZALBNIR_TSOIL(:) = ZALBNIR_SOIL(:)
- END WHERE
- !
- CALL RADIATIVE_TRANSFERT(I%LAGRI_TO_GRASS, ZVEGTYPE(1:KSIZE,:), &
- ZALBVIS_VEG, ZALBVIS_TSOIL, ZALBNIR_VEG, ZALBNIR_TSOIL, &
- ZGLOBAL_SW, ZLAIN, ZZENITH, I%XABC, &
- ZFAPARC, ZFAPIRC, ZMUS, ZLAI_EFFC, GSHADE, ZIACAN, &
- ZIACAN_SUNLIT, ZIACAN_SHADE, ZFRAC_SUN, &
- ZFAPAR, ZFAPIR, ZFAPAR_BS, ZFAPIR_BS )
+IF(IO%LMEB_PATCH(KPATCH))THEN
+ !
+ ZSNOWDEPTH(:) = SUM(PEK%TSNOW%WSNOW(:,:)/PEK%TSNOW%RHO(:,:),2)
+ ZPALPHAN (:) = MEBPALPHAN(ZSNOWDEPTH,PEK%XH_VEG)
+ !
+ KK%XDIR_ALB_WITH_SNOW(:,:) = XUNDEF
+ KK%XSCA_ALB_WITH_SNOW(:,:) = XUNDEF
+ !
+ IF(PRESENT(PDIR_SW))THEN
+ !
+ ! Albedo
+ !
+ ! - just extract some parameters for call, but no need to update
+ ! the cummulative variables in this routine:
+ !
+ DO JSWB=1,ISWB
+ ZGLOBAL_SW(:) = ZDIR_SW(:,JSWB) + ZSCA_SW(:,JSWB)
+ !
+ WHERE(PEK%TSNOW%ALB(:)/=XUNDEF .AND. PEK%TSNOW%ALBVIS(:)/=XUNDEF .AND. PEK%TSNOW%ALBNIR(:)/=XUNDEF)
+ ZLAIN(:) = PEK%XLAI(:)*(1.0-ZPALPHAN(:))
+ ZALBVIS_TSOIL(:) = PEK%XALBVIS_SOIL(:)*(1.-PEK%XPSN(:)) + PEK%XPSN(:)*PEK%TSNOW%ALBVIS(:)
+ ZALBNIR_TSOIL(:) = PEK%XALBNIR_SOIL(:)*(1.-PEK%XPSN(:)) + PEK%XPSN(:)*PEK%TSNOW%ALBNIR(:)
+ ELSEWHERE
+ ZLAIN(:) = PEK%XLAI(:)
+ ZALBVIS_TSOIL(:) = PEK%XALBVIS_SOIL(:)
+ ZALBNIR_TSOIL(:) = PEK%XALBNIR_SOIL(:)
+ END WHERE
+ !
+ CALL RADIATIVE_TRANSFERT(IO%LAGRI_TO_GRASS, KK%XVEGTYPE, &
+ PEK%XALBVIS_VEG, ZALBVIS_TSOIL, PEK%XALBNIR_VEG, ZALBNIR_TSOIL, &
+ ZGLOBAL_SW, ZLAIN, ZZENITH, S%XABC, &
+ PEK%XFAPARC, PEK%XFAPIRC, PEK%XMUS, PEK%XLAI_EFFC, GSHADE, ZIACAN, &
+ ZIACAN_SUNLIT, ZIACAN_SHADE, ZFRAC_SUN, &
+ ZFAPAR, ZFAPIR, ZFAPAR_BS, ZFAPIR_BS )
-! Total effective surface (canopy, ground/flooded zone, snow) all-wavelength
-! albedo: diagnosed from shortwave energy budget closure.
-! Final note: purely diagnostic - apply limits for night time
+ ! Total effective surface (canopy, ground/flooded zone, snow) all-wavelength
+ ! albedo: diagnosed from shortwave energy budget closure.
+ ! Final note: purely diagnostic - apply limits for night time
- ZALBT(:) = 1. - (XSW_WGHT_VIS*(ZFAPAR(:)+ZFAPAR_BS(:)) + &
- XSW_WGHT_NIR*(ZFAPIR(:)+ZFAPIR_BS(:)))
- ZSWUP(:) = ZGLOBAL_SW(:)*ZALBT(:)
- ZALBT(:) = ZSWUP(:)/MAX(1.E-5, ZGLOBAL_SW(:))
-!
- ZDIR_ALB_WITH_SNOW(:,JSWB)=ZALBT(:)
- ZSCA_ALB_WITH_SNOW(:,JSWB)=ZALBT(:)
-!
- END DO
-!
- ENDIF
-!
-! Emissivity
-!
+ ZALBT(:) = 1. - (XSW_WGHT_VIS*(ZFAPAR(:)+ZFAPAR_BS(:)) + XSW_WGHT_NIR*(ZFAPIR(:)+ZFAPIR_BS(:)))
+ ZSWUP(:) = ZGLOBAL_SW(:)*ZALBT(:)
+ ZALBT(:) = ZSWUP(:)/MAX(1.E-5, ZGLOBAL_SW(:))
+ !
+ KK%XDIR_ALB_WITH_SNOW(:,JSWB)=ZALBT(:)
+ KK%XSCA_ALB_WITH_SNOW(:,JSWB)=ZALBT(:)
+ !
+ END DO
+ !
+ ENDIF
+ !
+ ! Emissivity
+ !
ZEMISSN(:) = XEMISSN
- ZPSNA(:) = 0.
- ZSIGMA_F(:) = 1.0 - MEB_SHIELD_FACTOR(ZLAI,ZPSNA)
- ZSIGMA_FN(:) = 1.0 - MEB_SHIELD_FACTOR(ZLAI,ZPALPHAN)
-!
- CALL ISBA_EMIS_MEB(ZPSN, ZPALPHAN, ZSIGMA_F, ZSIGMA_FN, &
- ZEMISSN, ZEMIST )
-
-!
+ ZPSNA (:) = 0.
+ ZSIGMA_F(:) = 1.0 - MEB_SHIELD_FACTOR(PEK%XLAI,ZPSNA)
+ ZSIGMA_FN(:) = 1.0 - MEB_SHIELD_FACTOR(PEK%XLAI,ZPALPHAN)
+ !
+ CALL ISBA_EMIS_MEB(PEK%XPSN, ZPALPHAN, ZSIGMA_F, ZSIGMA_FN, ZEMISSN, ZEMIST )
+ !
ELSE
-!
-! * albedo for near-infra-red and visible over snow-covered and snow-flood-free surface
-!
- ZALBNIR_WITH_SNOW(:) = ZALBNIR(:) * (1.-ZPSN(:)-ZFF(:)) + ZSNOWALB (:) * ZPSN(:)
- ZALBVIS_WITH_SNOW(:) = ZALBVIS(:) * (1.-ZPSN(:)-ZFF(:)) + ZSNOWALB (:) * ZPSN(:)
- ZALBUV_WITH_SNOW (:) = ZALBUV (:) * (1.-ZPSN(:)-ZFF(:)) + ZSNOWALB (:) * ZPSN(:)
-!
-! * snow-flood-covered surface albedo for each wavelength (needed for outputs)
-!
- CALL ALBEDO_FROM_NIR_VIS(PSW_BANDS, &
- ZALBNIR_WITH_SNOW, ZALBVIS_WITH_SNOW, ZALBUV_WITH_SNOW,&
- ZDIR_ALB_WITH_SNOW, ZSCA_ALB_WITH_SNOW )
-!
+ !
+ ! * albedo for near-infra-red and visible over snow-covered and snow-flood-free surface
+ !
+ ZALBNIR_WITH_SNOW(:) = PEK%XALBNIR(:) * (1.-PEK%XPSN(:)-ZFF(:)) + PEK%TSNOW%ALB (:) * PEK%XPSN(:)
+ ZALBVIS_WITH_SNOW(:) = PEK%XALBVIS(:) * (1.-PEK%XPSN(:)-ZFF(:)) + PEK%TSNOW%ALB (:) * PEK%XPSN(:)
+ ZALBUV_WITH_SNOW (:) = PEK%XALBUV (:) * (1.-PEK%XPSN(:)-ZFF(:)) + PEK%TSNOW%ALB (:) * PEK%XPSN(:)
+ !
+ ! * snow-flood-covered surface albedo for each wavelength (needed for outputs)
+ !
+ CALL ALBEDO_FROM_NIR_VIS(PSW_BANDS, &
+ ZALBNIR_WITH_SNOW, ZALBVIS_WITH_SNOW, ZALBUV_WITH_SNOW,&
+ KK%XDIR_ALB_WITH_SNOW, KK%XSCA_ALB_WITH_SNOW )
+ !
DO JSWB=1,ISWB
- ZDIR_ALB_WITH_SNOW(:,JSWB)=ZDIR_ALB_WITH_SNOW(:,JSWB) + ZFF(:)*ZALBF_DIR(:)
- ZSCA_ALB_WITH_SNOW(:,JSWB)=ZSCA_ALB_WITH_SNOW(:,JSWB) + ZFF(:)*ZALBF_SCA(:)
+ KK%XDIR_ALB_WITH_SNOW(:,JSWB)=KK%XDIR_ALB_WITH_SNOW(:,JSWB) + ZFF(:)*ZALBF_DIR(:)
+ KK%XSCA_ALB_WITH_SNOW(:,JSWB)=KK%XSCA_ALB_WITH_SNOW(:,JSWB) + ZFF(:)*ZALBF_SCA(:)
ENDDO
-!
-!-------------------------------------------------------------------------------
-!
-! longwave computations for outputs (emissivity for radiative scheme)
-!
- ZEMIST(:) = (1.-ZPSN(:)-ZFF(:))*ZEMIS(:) + ZPSN(:) * XEMISSN + ZFF(:)*ZEMISF(:)
-!
+ !
+ !-------------------------------------------------------------------------------
+ !
+ ! longwave computations for outputs (emissivity for radiative scheme)
+ !
+ ZEMIST(:) = (1.-PEK%XPSN(:)-ZFF(:))*PEK%XEMIS(:) + PEK%XPSN(:) * XEMISSN + ZFF(:)*ZEMISF(:)
+ !
ENDIF
!
-!-------------------------------------------------------------------------------
-!
-! Unpack variable
+!Update albedo with snow for the next time step
!
- CALL UNPACK_SAME_RANK(IMASK(:),ZPSNG (:),I%XPSNG (:,KPATCH),ZPUT0)
- CALL UNPACK_SAME_RANK(IMASK(:),ZPSNV (:),I%XPSNV (:,KPATCH),ZPUT0)
- CALL UNPACK_SAME_RANK(IMASK(:),ZPSN (:),I%XPSN (:,KPATCH),ZPUT0)
- CALL UNPACK_SAME_RANK(IMASK(:),ZEMIST(:),PEMIST (:,KPATCH),ZPUT0)
- CALL UNPACK_SAME_RANK(IMASK(:),ZDIR_ALB_WITH_SNOW (:,:),I%XDIR_ALB_WITH_SNOW (:,:,KPATCH),ZPUT0)
- CALL UNPACK_SAME_RANK(IMASK(:),ZSCA_ALB_WITH_SNOW (:,:),I%XSCA_ALB_WITH_SNOW (:,:,KPATCH),ZPUT0)
+ CALL UNPACK_SAME_RANK(PK%NR_P,KK%XDIR_ALB_WITH_SNOW, PDIR_ALB_WITH_SNOW,ZPUT0)
+ CALL UNPACK_SAME_RANK(PK%NR_P,KK%XSCA_ALB_WITH_SNOW, PSCA_ALB_WITH_SNOW,ZPUT0)
+ CALL UNPACK_SAME_RANK(PK%NR_P,ZEMIST,PEMIST,ZPUT0)
!
!-------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('UPDATE_RAD_ISBA_N:TREAT_NATURE',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE TREAT_NATURE
-!
-SUBROUTINE TREAT_FLOOD(KSIZE,KPATCH,KMASK,PPSNG,PPSNV,PLAI,PVEG,&
- PALBF, PALBF_DIR,PALBF_SCA,PEMISF,PFF)
-!
-IMPLICIT NONE
-!
-INTEGER, INTENT(IN) :: KSIZE
-INTEGER, INTENT(IN) :: KPATCH
-INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
-REAL, DIMENSION(:), INTENT(IN) :: PPSNG
-REAL, DIMENSION(:), INTENT(IN) :: PPSNV
-REAL, DIMENSION(:), INTENT(IN) :: PLAI
-REAL, DIMENSION(:), INTENT(IN) :: PVEG
-REAL, DIMENSION(:), INTENT(OUT) :: PALBF_DIR
-REAL, DIMENSION(:), INTENT(OUT) :: PALBF_SCA
-REAL, DIMENSION(:), INTENT(OUT) :: PALBF
-REAL, DIMENSION(:), INTENT(OUT) :: PEMISF
-REAL, DIMENSION(:), INTENT(OUT) :: PFF
-!
-REAL, DIMENSION(KSIZE) :: ZTG
-REAL, DIMENSION(KSIZE) :: ZZENITH
-REAL, DIMENSION(KSIZE) :: ZFFLOOD
-REAL, DIMENSION(KSIZE) :: ZFFG
-REAL, DIMENSION(KSIZE) :: ZFFV
-REAL, DIMENSION(KSIZE) :: ZFFROZEN
-REAL, DIMENSION(KSIZE) :: ZALBEDO
-!
-REAL, PARAMETER :: ZPUT0 = 0.0
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-IF (LHOOK) CALL DR_HOOK('UPDATE_RAD_ISBA_N:TREAT_FLOOD',0,ZHOOK_HANDLE)
-!
- CALL PACK_SAME_RANK(KMASK(:),I%XTG(:,1,KPATCH),ZTG(:))
-!
- CALL PACK_SAME_RANK(KMASK(:),PZENITH(:),ZZENITH (:))
- CALL PACK_SAME_RANK(KMASK(:),I%XFFLOOD(:),ZFFLOOD (:))
-!
-ZFFG(:) = FLOOD_FRAC_GROUND(PPSNG,ZFFLOOD)
-ZFFV(:) = FLOOD_FRAC_VEG(PLAI,PPSNV,ZFFLOOD)
-PFF (:) = FLOOD_FRAC_NAT(PVEG,ZFFG,ZFFV,ZFFLOOD)
-!
-ZALBEDO(:) = ALBEDO_TA96(ZZENITH(:))
-WHERE(ZFFLOOD==0.0)
- PALBF_DIR (:) = XUNDEF
- PALBF_SCA (:) = XUNDEF
- PALBF (:) = XUNDEF
- PEMISF (:) = XUNDEF
- ZFFROZEN (:) = 0.0
-ELSEWHERE
- WHERE(ZTG(:)>=XTT)
- PALBF_DIR (:) = ZALBEDO(:)
- PALBF_SCA (:) = XALBSCA_WAT
- PEMISF (:) = XEMISWAT
- ZFFROZEN (:) = 0.0
- ELSEWHERE
- PALBF_DIR (:) = XALBWATICE
- PALBF_SCA (:) = XALBWATICE
- PEMISF (:) = XEMISWATICE
- ZFFROZEN (:) = 1.0
- END WHERE
- PALBF(:)=0.5*(PALBF_DIR(:)+PALBF_SCA(:))
-ENDWHERE
-!
- CALL UNPACK_SAME_RANK(KMASK(:),ZFFG (:),I%XFFG (:,KPATCH),ZPUT0)
- CALL UNPACK_SAME_RANK(KMASK(:),ZFFV (:),I%XFFV (:,KPATCH),ZPUT0)
- CALL UNPACK_SAME_RANK(KMASK(:),ZFFROZEN(:),I%XFFROZEN(:,KPATCH),ZPUT0)
- CALL UNPACK_SAME_RANK(KMASK(:),PFF (:),I%XFF (:,KPATCH),ZPUT0)
- CALL UNPACK_SAME_RANK(KMASK(:),PEMISF (:),I%XEMISF (:,KPATCH),XUNDEF)
- CALL UNPACK_SAME_RANK(KMASK(:),PALBF (:),I%XALBF (:,KPATCH),XUNDEF)
-!
-IF (LHOOK) CALL DR_HOOK('UPDATE_RAD_ISBA_N:TREAT_FLOOD',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE TREAT_FLOOD
+IF (LHOOK) CALL DR_HOOK('UPDATE_RAD_ISBA_N',1,ZHOOK_HANDLE)
!
END SUBROUTINE UPDATE_RAD_ISBA_n
diff --git a/src/SURFEX/update_rad_sea.F90 b/src/SURFEX/update_rad_sea.F90
index 370c232180e8fd161a5bc9654e5efb6e1f5831d0..cbc712faf49441650b596bb378766a682cb662fc 100644
--- a/src/SURFEX/update_rad_sea.F90
+++ b/src/SURFEX/update_rad_sea.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE UPDATE_RAD_SEA(HALB,PSST,PZENITH,PTT,PEMIS,PDIR_ALB,PSCA_ALB, &
- PDIR_ALB_ATMOS,PSCA_ALB_ATMOS,PEMIS_ATMOS,PTRAD,&
- OHANDLE_SIC,PTICE,PSIC,PICE_ALB,PU,PV )
+SUBROUTINE UPDATE_RAD_SEA(S,PZENITH,PTT,PDIR_ALB_ATMOS,PSCA_ALB_ATMOS,PEMIS_ATMOS,PTRAD,PU,PV)
! #######################################################################
!
!!**** *UPDATE_RAD_SEA * - update the radiative properties at time t+1 (see by the atmosphere)
@@ -35,6 +33,8 @@ SUBROUTINE UPDATE_RAD_SEA(HALB,PSST,PZENITH,PTT,PEMIS,PDIR_ALB,PSCA_ALB, &
!! Modified 01/2015 : introduce interactive ocean surface albedo (R.Séférian)
!!------------------------------------------------------------------
!
+USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
+!
USE MODD_WATER_PAR, ONLY : XEMISWAT, XEMISWATICE, &
XALBWAT, XALBSCA_WAT, &
XALBSEAICE
@@ -52,25 +52,16 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
- CHARACTER(LEN=4), INTENT(IN) :: HALB
+TYPE(SEAFLUX_t), INTENT(INOUT) :: S
!
-REAL, DIMENSION(:), INTENT(IN) :: PSST ! Sea surface temperature
REAL, DIMENSION(:), INTENT(IN) :: PZENITH ! Zenithal angle at t+1
REAL, INTENT(IN) :: PTT ! Sea/ice transition temperature (different according to sea or inland water)
!
-REAL, DIMENSION(:), INTENT(INOUT):: PDIR_ALB ! Direct albedo at t+1 for the mix (open sea, seaice)
-REAL, DIMENSION(:), INTENT(INOUT):: PSCA_ALB ! Diffuse albedo at t+1 for the mix (open sea, seaice)
-REAL, DIMENSION(:), INTENT(OUT) :: PEMIS ! emissivity (sea water + sea ice) at t+1
-!
REAL, DIMENSION(:,:), INTENT(OUT) :: PDIR_ALB_ATMOS ! Direct albedo at t+1 for the atmosphere
REAL, DIMENSION(:,:), INTENT(OUT) :: PSCA_ALB_ATMOS ! Diffuse albedo at t+1 for the atmosphere
REAL, DIMENSION(:), INTENT(OUT) :: PEMIS_ATMOS ! Emissivity at t+1 for the atmosphere
REAL, DIMENSION(:), INTENT(OUT) :: PTRAD ! radiative temp at t+1 for the atmosphere
!
-LOGICAL, INTENT(IN) , OPTIONAL :: OHANDLE_SIC ! Do we weight seaice and open sea fluxes
-REAL, DIMENSION(:), INTENT(IN) , OPTIONAL :: PTICE ! Seaice surface temperature
-REAL, DIMENSION(:), INTENT(IN) , OPTIONAL :: PSIC ! Seaice cover
-REAL, DIMENSION(:), INTENT(IN) , OPTIONAL :: PICE_ALB ! Seaice albedo
REAL, DIMENSION(:), INTENT(IN) , OPTIONAL :: PU ! zonal wind (m/s)
REAL, DIMENSION(:), INTENT(IN) , OPTIONAL :: PV ! meridian wind (m/s)
!
@@ -80,7 +71,6 @@ INTEGER :: JSWB
REAL, DIMENSION(SIZE(PZENITH)) :: ZALBDIR
REAL, DIMENSION(SIZE(PZENITH)) :: ZALBSCA
REAL, DIMENSION(SIZE(PZENITH)) :: ZWIND
-LOGICAL :: GHANDLE_SIC
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -91,94 +81,88 @@ IF (LHOOK) CALL DR_HOOK('UPDATE_RAD_SEA',0,ZHOOK_HANDLE)
ZALBDIR(:) = 0.
ZALBSCA(:) = 0.
!
-IF (HALB=='TA96') THEN
+IF (S%CSEA_ALB=='TA96') THEN
!
ZALBDIR(:) = ALBEDO_TA96(PZENITH(:))
ZALBSCA(:) = XALBSCA_WAT
!
-ELSEIF (HALB=='MK10') THEN
+ELSEIF (S%CSEA_ALB=='MK10') THEN
!
ZALBDIR(:) = ALBEDO_MK10(PZENITH(:))
ZALBSCA(:) = XALBSCA_WAT
!
-ELSEIF (HALB=='RS14') THEN
+ELSEIF (S%CSEA_ALB=='RS14') THEN
!
IF (PRESENT(PU).AND.PRESENT(PV)) THEN
ZWIND(:) = SQRT(PU(:)**2+PV(:)**2)
CALL ALBEDO_RS14(PZENITH(:),ZWIND(:),ZALBDIR(:),ZALBSCA(:))
ELSE
- ZALBDIR(:) = PDIR_ALB(:)
- ZALBSCA(:) = PSCA_ALB(:)
+ ZALBDIR(:) = S%XDIR_ALB(:)
+ ZALBSCA(:) = S%XSCA_ALB(:)
ENDIF
!
ENDIF
!
-IF (.NOT. PRESENT(OHANDLE_SIC)) THEN
- GHANDLE_SIC=.FALSE.
-ELSE
- GHANDLE_SIC=OHANDLE_SIC
-ENDIF
-!
IF(LCPL_SEA)THEN !Earth System Model
!
!Sea and/or ice albedo already given by coupled seaice model
!Except for Taylor et al (1996) and MK10 formulation
!
- WHERE (PSST(:)>=PTT )
+ WHERE (S%XSST(:)>=PTT )
!* open water
- PEMIS (:) = XEMISWAT
+ S%XEMIS (:) = XEMISWAT
ELSEWHERE
!* sea ice
- PEMIS (:) = XEMISWATICE
+ S%XEMIS (:) = XEMISWATICE
END WHERE
!
- IF (HALB=='TA96' .OR. HALB=='MK10' .OR. HALB=='RS14') THEN
+ IF (S%CSEA_ALB=='TA96' .OR. S%CSEA_ALB=='MK10' .OR. S%CSEA_ALB=='RS14') THEN
!* Taylor et al 1996
!* open water
- WHERE (PSST(:)>=PTT) PDIR_ALB(:) = ZALBDIR(:)
- WHERE (PSST(:)>=PTT) PSCA_ALB(:) = ZALBSCA(:)
+ WHERE (S%XSST(:)>=PTT) S%XDIR_ALB(:) = ZALBDIR(:)
+ WHERE (S%XSST(:)>=PTT) S%XSCA_ALB(:) = ZALBSCA(:)
ENDIF
!
-ELSEIF(GHANDLE_SIC) THEN
+ELSEIF(S%LHANDLE_SIC) THEN
! Returned values are an average of open sea and seaice properties
! weighted by the seaice cover
- PEMIS (:) = ( 1 - PSIC(:)) * XEMISWAT + PSIC(:) * XEMISWATICE
- IF (HALB=='UNIF') THEN
- PDIR_ALB(:) = ( 1 - PSIC(:)) * XALBWAT + PSIC(:) * PICE_ALB(:)
- PSCA_ALB(:) = ( 1 - PSIC(:)) * XALBWAT + PSIC(:) * PICE_ALB(:)
- ELSE IF (HALB=='TA96' .OR. HALB=='MK10' .OR. HALB=='RS14') THEN
- PDIR_ALB(:) = ( 1 - PSIC(:)) * ZALBDIR(:) + PSIC(:) * PICE_ALB(:)
- PSCA_ALB(:) = ( 1 - PSIC(:)) * ZALBSCA(:) + PSIC(:) * PICE_ALB(:)
+ S%XEMIS (:) = ( 1 - S%XSIC(:)) * XEMISWAT + S%XSIC(:) * XEMISWATICE
+ IF (S%CSEA_ALB=='UNIF') THEN
+ S%XDIR_ALB(:) = ( 1 - S%XSIC(:)) * XALBWAT + S%XSIC(:) * S%XICE_ALB(:)
+ S%XSCA_ALB(:) = ( 1 - S%XSIC(:)) * XALBWAT + S%XSIC(:) * S%XICE_ALB(:)
+ ELSE IF (S%CSEA_ALB=='TA96' .OR. S%CSEA_ALB=='MK10' .OR. S%CSEA_ALB=='RS14') THEN
+ S%XDIR_ALB(:) = ( 1 - S%XSIC(:)) * ZALBDIR(:) + S%XSIC(:) * S%XICE_ALB(:)
+ S%XSCA_ALB(:) = ( 1 - S%XSIC(:)) * ZALBSCA(:) + S%XSIC(:) * S%XICE_ALB(:)
ENDIF
ELSE
!
- IF (HALB=='UNIF') THEN
+ IF (S%CSEA_ALB=='UNIF') THEN
!* uniform albedo
- WHERE (PSST(:)>=PTT )
+ WHERE (S%XSST(:)>=PTT )
!* open water
- PDIR_ALB (:) = XALBWAT
- PSCA_ALB (:) = XALBWAT
- PEMIS (:) = XEMISWAT
+ S%XDIR_ALB (:) = XALBWAT
+ S%XSCA_ALB (:) = XALBWAT
+ S%XEMIS (:) = XEMISWAT
ELSEWHERE
!* sea ice
- PDIR_ALB(:) = XALBSEAICE
- PSCA_ALB(:) = XALBSEAICE
- PEMIS (:) = XEMISWATICE
+ S%XDIR_ALB(:) = XALBSEAICE
+ S%XSCA_ALB(:) = XALBSEAICE
+ S%XEMIS (:) = XEMISWATICE
END WHERE
!
- ELSE IF (HALB=='TA96' .OR. HALB=='MK10' .OR. HALB=='RS14') THEN
+ ELSE IF (S%CSEA_ALB=='TA96' .OR. S%CSEA_ALB=='MK10' .OR. S%CSEA_ALB=='RS14') THEN
!* Taylor et al 1996
!
- WHERE (PSST(:)>=PTT)
+ WHERE (S%XSST(:)>=PTT)
!* open water
- PDIR_ALB (:) = ZALBDIR(:)
- PSCA_ALB (:) = ZALBSCA(:)
- PEMIS (:) = XEMISWAT
+ S%XDIR_ALB (:) = ZALBDIR(:)
+ S%XSCA_ALB (:) = ZALBSCA(:)
+ S%XEMIS (:) = XEMISWAT
ELSEWHERE
!* sea ice
- PDIR_ALB(:) = XALBSEAICE
- PSCA_ALB(:) = XALBSEAICE
- PEMIS (:) = XEMISWATICE
+ S%XDIR_ALB(:) = XALBSEAICE
+ S%XSCA_ALB(:) = XALBSEAICE
+ S%XEMIS (:) = XEMISWATICE
END WHERE
!
ENDIF
@@ -188,17 +172,17 @@ ENDIF
!-------------------------------------------------------------------------------------
!
DO JSWB=1,SIZE(PDIR_ALB_ATMOS,2)
- PDIR_ALB_ATMOS(:,JSWB) = PDIR_ALB(:)
- PSCA_ALB_ATMOS(:,JSWB) = PSCA_ALB(:)
+ PDIR_ALB_ATMOS(:,JSWB) = S%XDIR_ALB(:)
+ PSCA_ALB_ATMOS(:,JSWB) = S%XSCA_ALB(:)
END DO
!
-PEMIS_ATMOS(:) = PEMIS(:)
-IF(GHANDLE_SIC) THEN
- PTRAD(:) = (((1 - PSIC(:)) * XEMISWAT * PSST (:)**4 + &
- PSIC(:) * XEMISWATICE * PTICE(:)**4)/ &
- PEMIS(:)) ** 0.25
+PEMIS_ATMOS(:) = S%XEMIS(:)
+IF(S%LHANDLE_SIC) THEN
+ PTRAD(:) = (((1 - S%XSIC(:)) * XEMISWAT * S%XSST (:)**4 + &
+ S%XSIC(:) * XEMISWATICE * S%XTICE(:)**4)/ &
+ S%XEMIS(:)) ** 0.25
ELSE
- PTRAD(:) = PSST (:)
+ PTRAD(:) = S%XSST (:)
END IF
!
IF (LHOOK) CALL DR_HOOK('UPDATE_RAD_SEA',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/update_rad_seawat.F90 b/src/SURFEX/update_rad_seawat.F90
deleted file mode 100644
index d3ea226d8f988ba902c6304ecf8b41972969e564..0000000000000000000000000000000000000000
--- a/src/SURFEX/update_rad_seawat.F90
+++ /dev/null
@@ -1,14 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
-SUBROUTINE UPDATE_RAD_SEAWAT
-! #######################################################################
-!
-! A supprimer
-! remplacer par UPDATE_RAD_SEA et UPDATE_RAD_WATER
-!-------------------------------------------------------------------------------------
-!
-END SUBROUTINE UPDATE_RAD_SEAWAT
-
diff --git a/src/SURFEX/update_rad_water.F90 b/src/SURFEX/update_rad_water.F90
index c0ca50886c81cf22362aa2e79a50d6a1e8c731a5..11e1bcf98555f324628539c840a6c7220df401dc 100644
--- a/src/SURFEX/update_rad_water.F90
+++ b/src/SURFEX/update_rad_water.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE UPDATE_RAD_WATER(HALB,PSST,PZENITH,PTT,PEMIS,PDIR_ALB,PSCA_ALB, &
- PDIR_ALB_ATMOS,PSCA_ALB_ATMOS,PEMIS_ATMOS,PTRAD)
+SUBROUTINE UPDATE_RAD_WATER(W,PZENITH,PTT,PDIR_ALB_ATMOS,PSCA_ALB_ATMOS,PEMIS_ATMOS,PTRAD)
! #######################################################################
!
!!**** *UPDATE_RAD_WATER * - update the radiative properties at time t+1 (see by the atmosphere)
@@ -32,6 +31,8 @@ SUBROUTINE UPDATE_RAD_WATER(HALB,PSST,PZENITH,PTT,PEMIS,PDIR_ALB,PSCA_ALB, &
!! Modified 02/2014 : split from update_rad_seawat.F90
!!------------------------------------------------------------------
!
+USE MODD_WATFLUX_n, ONLY : WATFLUX_t
+!
USE MODD_WATER_PAR, ONLY : XEMISWAT, XEMISWATICE, &
XALBWAT, XALBSCA_WAT, &
XALBWATICE
@@ -49,16 +50,11 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
- CHARACTER(LEN=4), INTENT(IN) :: HALB
+TYPE(WATFLUX_t), INTENT(INOUT) :: W
!
-REAL, DIMENSION(:), INTENT(IN) :: PSST ! Sea surface temperature
REAL, DIMENSION(:), INTENT(IN) :: PZENITH ! Zenithal angle at t+1
REAL, INTENT(IN) :: PTT ! Sea/ice transition temperature (different according to sea or inland water)
!
-REAL, DIMENSION(:), INTENT(INOUT):: PDIR_ALB ! Direct albedo at t+1
-REAL, DIMENSION(:), INTENT(INOUT):: PSCA_ALB ! Diffuse albedo at t+1
-REAL, DIMENSION(:), INTENT(OUT) :: PEMIS ! emissivity (soil+vegetation) at t+1
-!
REAL, DIMENSION(:,:), INTENT(OUT) :: PDIR_ALB_ATMOS ! Direct albedo at t+1 for the atmosphere
REAL, DIMENSION(:,:), INTENT(OUT) :: PSCA_ALB_ATMOS ! Diffuse albedo at t+1 for the atmosphere
REAL, DIMENSION(:), INTENT(OUT) :: PEMIS_ATMOS ! Emissivity at t+1 for the atmosphere
@@ -67,7 +63,7 @@ REAL, DIMENSION(:), INTENT(OUT) :: PTRAD ! radiative temp at t+1 f
!* 0.2 declarations of local variables
!
INTEGER :: JSWB
-REAL, DIMENSION(SIZE(PSST)) :: ZALBEDO
+REAL, DIMENSION(SIZE(W%XTS)) :: ZALBEDO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
@@ -75,9 +71,9 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('UPDATE_RAD_WATER',0,ZHOOK_HANDLE)
!
ZALBEDO(:) = 0.
-IF (HALB=='TA96') THEN
+IF (W%CWAT_ALB=='TA96') THEN
ZALBEDO(:) = ALBEDO_TA96(PZENITH(:))
-ELSEIF (HALB=='MK10') THEN
+ELSEIF (W%CWAT_ALB=='MK10') THEN
ZALBEDO(:) = ALBEDO_MK10(PZENITH(:))
ENDIF
!
@@ -87,50 +83,50 @@ IF(LCPL_SEA.AND.LWATER)THEN !Earth System Model
!Except for Taylor et al (1996) formulation
!
!
- WHERE (PSST(:)>=PTT )
+ WHERE (W%XTS(:)>=PTT )
!* open water
- PEMIS (:) = XEMISWAT
+ W%XEMIS (:) = XEMISWAT
ELSEWHERE
!* sea ice
- PEMIS (:) = XEMISWATICE
+ W%XEMIS (:) = XEMISWATICE
END WHERE
!
- IF (HALB=='TA96' .OR. HALB=='MK10') THEN
+ IF (W%CWAT_ALB=='TA96' .OR. W%CWAT_ALB=='MK10') THEN
!* Taylor et al 1996
!* open water
- WHERE (PSST(:)>=PTT) PDIR_ALB(:) = ZALBEDO(:)
- WHERE (PSST(:)>=PTT) PSCA_ALB(:) = XALBSCA_WAT
+ WHERE (W%XTS(:)>=PTT) W%XDIR_ALB(:) = ZALBEDO(:)
+ WHERE (W%XTS(:)>=PTT) W%XSCA_ALB(:) = XALBSCA_WAT
ENDIF
!
ELSE
!
- IF (HALB=='UNIF') THEN
+ IF (W%CWAT_ALB=='UNIF') THEN
!* uniform albedo
- WHERE (PSST(:)>=PTT )
+ WHERE (W%XTS(:)>=PTT )
!* open water
- PDIR_ALB (:) = XALBWAT
- PSCA_ALB (:) = XALBWAT
- PEMIS (:) = XEMISWAT
+ W%XDIR_ALB (:) = XALBWAT
+ W%XSCA_ALB (:) = XALBWAT
+ W%XEMIS (:) = XEMISWAT
ELSEWHERE
!* sea ice
- PDIR_ALB(:) = XALBWATICE
- PSCA_ALB(:) = XALBWATICE
- PEMIS (:) = XEMISWATICE
+ W%XDIR_ALB(:) = XALBWATICE
+ W%XSCA_ALB(:) = XALBWATICE
+ W%XEMIS (:) = XEMISWATICE
END WHERE
!
- ELSE IF (HALB=='TA96' .OR. HALB=='MK10') THEN
+ ELSE IF (W%CWAT_ALB=='TA96' .OR. W%CWAT_ALB=='MK10') THEN
!* Taylor et al 1996
- WHERE (PSST(:)>=PTT) PDIR_ALB(:) = ZALBEDO(:)
+ WHERE (W%XTS(:)>=PTT) W%XDIR_ALB(:) = ZALBEDO(:)
!
- WHERE (PSST(:)>=PTT)
+ WHERE (W%XTS(:)>=PTT)
!* open water
- PSCA_ALB (:) = XALBSCA_WAT
- PEMIS (:) = XEMISWAT
+ W%XSCA_ALB (:) = XALBSCA_WAT
+ W%XEMIS (:) = XEMISWAT
ELSEWHERE
!* sea ice
- PDIR_ALB(:) = XALBWATICE
- PSCA_ALB(:) = XALBWATICE
- PEMIS (:) = XEMISWATICE
+ W%XDIR_ALB(:) = XALBWATICE
+ W%XSCA_ALB(:) = XALBWATICE
+ W%XEMIS (:) = XEMISWATICE
END WHERE
!
ENDIF
@@ -140,12 +136,12 @@ ENDIF
!-------------------------------------------------------------------------------------
!
DO JSWB=1,SIZE(PDIR_ALB_ATMOS,2)
- PDIR_ALB_ATMOS(:,JSWB) = PDIR_ALB(:)
- PSCA_ALB_ATMOS(:,JSWB) = PSCA_ALB(:)
+ PDIR_ALB_ATMOS(:,JSWB) = W%XDIR_ALB(:)
+ PSCA_ALB_ATMOS(:,JSWB) = W%XSCA_ALB(:)
END DO
!
-PEMIS_ATMOS(:) = PEMIS(:)
-PTRAD (:) = PSST (:)
+PEMIS_ATMOS(:) = W%XEMIS(:)
+PTRAD (:) = W%XTS (:)
!
IF (LHOOK) CALL DR_HOOK('UPDATE_RAD_WATER',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/urban_drag.F90 b/src/SURFEX/urban_drag.F90
index ab5bd98181aec54b98cdb51e963362b4bb0b4761..e76d1aa7eeb440e27d2c184d2a1a0e073bea2803 100644
--- a/src/SURFEX/urban_drag.F90
+++ b/src/SURFEX/urban_drag.F90
@@ -3,28 +3,17 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE URBAN_DRAG(HZ0H, HIMPLICIT_WIND, PTSTEP, &
- PT_CANYON, PQ_CANYON, PU_CANYON, &
- PT_LOWCAN, PQ_LOWCAN, PU_LOWCAN, PZ_LOWCAN, &
- PTS_ROOF, PTS_ROAD, PTS_WALL, PTS_GARDEN, &
- PDELT_SNOW_ROOF, PDELT_SNOW_ROAD, &
- PEXNS, PEXNA, PTA, PQA, PPS, PRHOA, &
- PZREF, PUREF, PVMOD, &
- PZ0_TOWN, &
- PBLD, PGARDEN, PROAD, &
- PBLD_HEIGHT, PCAN_HW_RATIO, &
- PWALL_O_GRND, &
- PWS_ROOF, PWS_ROAD, &
- PWS_ROOF_MAX, PWS_ROAD_MAX, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PPEW_A_COEF_LOWCAN, PPEW_B_COEF_LOWCAN, &
- PQSAT_ROOF, PQSAT_ROAD, PDELT_ROOF, PDELT_ROAD, &
- PCD, PCDN, PAC_ROOF, PAC_ROOF_WAT, &
- PAC_WALL, PAC_ROAD, PAC_ROAD_WAT, PAC_TOP, &
- PAC_GARDEN, PRI, &
- PUW_ROAD, PUW_ROOF, PDUWDU_ROAD, PDUWDU_ROOF, &
- PUSTAR_TOWN, OCANOPY, PTS_WIN, PAC_WIN, HCH_BEM, &
- PROUGH_ROOF, PROUGH_WALL )
+ SUBROUTINE URBAN_DRAG(TOP, T, B, HIMPLICIT_WIND, PTSTEP, PT_CANYON, PQ_CANYON, &
+ PU_CANYON, PT_LOWCAN, PQ_LOWCAN, PU_LOWCAN, PZ_LOWCAN, &
+ PTS_ROOF, PTS_ROAD, PTS_WALL, PTS_GARDEN, &
+ PDELT_SNOW_ROOF, PDELT_SNOW_ROAD, PEXNS, PEXNA, PTA, &
+ PQA, PPS, PRHOA,PZREF, PUREF, PVMOD, PWS_ROOF_MAX, &
+ PWS_ROAD_MAX, PPEW_A_COEF, PPEW_B_COEF, &
+ PPEW_A_COEF_LOWCAN, PPEW_B_COEF_LOWCAN, PQSAT_ROOF, &
+ PQSAT_ROAD, PDELT_ROOF, PDELT_ROAD, PCD, PCDN, PAC_ROOF, &
+ PAC_ROOF_WAT, PAC_WALL, PAC_ROAD, PAC_ROAD_WAT, PAC_TOP, &
+ PAC_GARDEN, PRI, PUW_ROAD, PUW_ROOF, PDUWDU_ROAD, &
+ PDUWDU_ROOF, PUSTAR_TOWN, PAC_WIN )
! ##########################################################################
!
!!**** *URBAN_DRAG*
@@ -67,7 +56,7 @@
!! 12/02 (A. Lemonsu) convective speed w* in canyon
! 04 (A. Lemonsu) z0h=z0m for resistance canyon-atmosphere
! 03/08 (S. Leroyer) debug PU_CAN (1. * H/3)
-! 12/08 (S. Leroyer) option (HZ0H) for z0h applied on roof, road and town
+! 12/08 (S. Leroyer) option (TOP%CZ0H) for z0h applied on roof, road and town
!! 09/12 B. Decharme new wind implicitation
! 11/11 (G. Pigeon) apply only urban_exch_coef when necessary if
! canopy/no canopy
@@ -79,6 +68,10 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
+USE MODD_TEB_n, ONLY : TEB_t
+USE MODD_BEM_n, ONLY : BEM_t
+!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_CSTS,ONLY : XLVTT, XPI, XCPD, XG, XKARMAN
!
@@ -94,8 +87,9 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-!
- CHARACTER(LEN=6), INTENT(IN) :: HZ0H ! TEB option for z0h roof & road
+TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+TYPE(TEB_t), INTENT(INOUT) :: T
+TYPE(BEM_t), INTENT(INOUT) :: B
!
CHARACTER(LEN=*), INTENT(IN) :: HIMPLICIT_WIND ! wind implicitation option
! ! 'OLD' = direct
@@ -128,20 +122,8 @@ REAL, DIMENSION(:), INTENT(IN) :: PZREF ! reference height of the fi
! atmospheric level (temperature)
REAL, DIMENSION(:), INTENT(IN) :: PUREF ! reference height of the first
! atmospheric level (wind)
-REAL, DIMENSION(:), INTENT(IN) :: PZ0_TOWN ! roughness length for momentum
-REAL, DIMENSION(:), INTENT(IN) :: PBLD ! fraction of buildings
-REAL, DIMENSION(:), INTENT(IN) :: PROAD ! fraction of roads
-REAL, DIMENSION(:), INTENT(IN) :: PGARDEN ! fraction of GARDEN areas
-REAL, DIMENSION(:), INTENT(IN) :: PBLD_HEIGHT ! h
-REAL, DIMENSION(:), INTENT(IN) :: PCAN_HW_RATIO ! h/W
-REAL, DIMENSION(:), INTENT(IN) :: PWALL_O_GRND ! wall surf. / (road+GARDEN area) surf.
-!
-REAL, DIMENSION(:), INTENT(IN) :: PWS_ROOF ! roof water content (kg/m2)
-REAL, DIMENSION(:), INTENT(IN) :: PWS_ROAD ! road water content (kg/m2)
REAL, DIMENSION(:), INTENT(IN) :: PWS_ROOF_MAX ! maximum deepness of roof
REAL, DIMENSION(:), INTENT(IN) :: PWS_ROAD_MAX ! and water reservoirs (kg/m2)
-!
-!
REAL, DIMENSION(:), INTENT(IN) :: PPEW_A_COEF ! implicit coefficients (m2s/kg)
REAL, DIMENSION(:), INTENT(IN) :: PPEW_B_COEF ! for wind coupling (m/s)
REAL, DIMENSION(:), INTENT(IN) :: PPEW_A_COEF_LOWCAN ! implicit coefficients for wind coupling (m2s/kg)
@@ -176,12 +158,7 @@ REAL, DIMENSION(:), INTENT(OUT) :: PDUWDU_ROAD !
REAL, DIMENSION(:), INTENT(OUT) :: PDUWDU_ROOF !
REAL, DIMENSION(:), INTENT(OUT) :: PUSTAR_TOWN ! Fraction velocity for town
!
-LOGICAL, INTENT(IN) :: OCANOPY ! is canopy active
REAL, DIMENSION(:), INTENT(OUT) :: PAC_WIN ! aerodynamical conductance for window
-REAL, DIMENSION(:), INTENT(IN) :: PTS_WIN ! window outdoor surface temp
- CHARACTER(LEN=5), INTENT(IN) :: HCH_BEM ! BEM option for convective heat transfer coef.
-REAL, DIMENSION(:), INTENT(IN) :: PROUGH_ROOF ! roughness coef for the roof
-REAL, DIMENSION(:), INTENT(IN) :: PROUGH_WALL ! roughness coef for the wall
!
!* 0.2 declarations of local variables
!
@@ -242,7 +219,7 @@ IF (LHOOK) CALL DR_HOOK('URBAN_DRAG',0,ZHOOK_HANDLE)
ZZ0_ROOF(:) = 0.15 ! z0 for roofs
ZZ0_ROAD(:) = MIN(0.05,0.1*PZ_LOWCAN(:))! z0 for roads
!
-ZZ0_TOP(:) = PZ0_TOWN(:)
+ZZ0_TOP(:) = T%XZ0_TOWN(:)
!
PCD (:) = XUNDEF
PCDN (:) = XUNDEF
@@ -275,7 +252,7 @@ PDELT_ROOF=1.
! ------------
!
WHERE (PQSAT_ROOF(:) >= PQA(:) )
- PDELT_ROOF(:) = (PWS_ROOF(:)/PWS_ROOF_MAX)**(2./3.)
+ PDELT_ROOF(:) = (T%XWS_ROOF(:)/PWS_ROOF_MAX)**(2./3.)
END WHERE
!
!* 2.2 dew deposition on roofs (PDELT_ROOF=1)
@@ -292,7 +269,7 @@ PDELT_ROAD=1.
! ------------
!
WHERE (PQSAT_ROAD(:) >= PQ_CANYON(:) )
- PDELT_ROAD(:) = (PWS_ROAD(:)/PWS_ROAD_MAX)**(2./3.)
+ PDELT_ROAD(:) = (T%XWS_ROAD(:)/PWS_ROAD_MAX)**(2./3.)
END WHERE
!
!* 3.2 dew deposition on roads (PDELT_ROAD=1)
@@ -309,7 +286,7 @@ DO JJ=1,SIZE(PTA)
!* 4.1 Averaged temperature at roof level
! ----------------------------------
!
- ZTS_TOWN(JJ) = PBLD(JJ) * PTS_ROOF(JJ) + (1.-PBLD(JJ)) * PT_CANYON(JJ)
+ ZTS_TOWN(JJ) = T%XBLD(JJ) * PTS_ROOF(JJ) + (1.-T%XBLD(JJ)) * PT_CANYON(JJ)
!
!* 4.2 Averaged water fraction on roofs
! -------------------------------
@@ -324,7 +301,7 @@ DO JJ=1,SIZE(PTA)
!* 4.4 Averaged Saturation specific humidity
! -------------------------------------
!
- ZQ_TOWN(JJ) = PBLD(JJ) * ZQ_ROOF(JJ) + (1.-PBLD(JJ)) * PQ_CANYON(JJ)
+ ZQ_TOWN(JJ) = T%XBLD(JJ) * ZQ_ROOF(JJ) + (1.-T%XBLD(JJ)) * PQ_CANYON(JJ)
!
ENDDO
!
@@ -333,10 +310,10 @@ ENDDO
!* 5. Momentum drag coefficient
! -------------------------
!
-IF (.NOT. OCANOPY) THEN
- CALL URBAN_EXCH_COEF(HZ0H, ZZ0_O_Z0H, ZTS_TOWN, ZQ_TOWN, PEXNS, PEXNA, PTA, PQA, &
- PZREF+ PBLD_HEIGHT/3.,PUREF+PBLD_HEIGHT/3.,PVMOD,PZ0_TOWN, &
- PRI, PCD, PCDN, ZAC, ZRA, ZCH )
+IF (.NOT. TOP%LCANOPY) THEN
+ CALL URBAN_EXCH_COEF(TOP%CZ0H, ZZ0_O_Z0H, ZTS_TOWN, ZQ_TOWN, PEXNS, PEXNA, PTA, PQA, &
+ PZREF+ T%XBLD_HEIGHT/3., PUREF+T%XBLD_HEIGHT/3., PVMOD, T%XZ0_TOWN, &
+ PRI, PCD, PCDN, ZAC, ZRA, ZCH )
ENDIF
!
!-------------------------------------------------------------------------------
@@ -344,21 +321,21 @@ ENDIF
!* 6. Drag coefficient for heat fluxes between roofs and atmosphere
! -------------------------------------------------------------
!
-IF (HCH_BEM == "DOE-2") THEN
+IF (TOP%CCH_BEM == "DOE-2") THEN
ZCHTCN_ROOF = CHTC_UP_DOE(PTS_ROOF, PTA)
ZCHTCS_ROOF = CHTC_SMOOTH_WIND_DOE(ZCHTCN_ROOF, PVMOD)
- PAC_ROOF = CHTC_ROUGH_DOE(ZCHTCN_ROOF, ZCHTCS_ROOF, PROUGH_ROOF) / PRHOA / XCPD
+ PAC_ROOF = CHTC_ROUGH_DOE(ZCHTCN_ROOF, ZCHTCS_ROOF, T%XROUGH_ROOF) / PRHOA / XCPD
ELSE
- CALL URBAN_EXCH_COEF(HZ0H, ZZ0_O_Z0H, PTS_ROOF, ZQ_ROOF, PEXNS, PEXNA, PTA, PQA, &
- PZREF, PUREF, PVMOD, ZZ0_ROOF, &
- ZRI, ZCD, ZCDN, PAC_ROOF, ZRA_ROOF, ZCH_ROOF )
+ CALL URBAN_EXCH_COEF(TOP%CZ0H, ZZ0_O_Z0H, PTS_ROOF, ZQ_ROOF, PEXNS, PEXNA, PTA, PQA, &
+ PZREF, PUREF, PVMOD, ZZ0_ROOF, ZRI, ZCD, ZCDN, PAC_ROOF, &
+ ZRA_ROOF, ZCH_ROOF )
ENDIF
!
!
DO JJ=1,SIZE(PTA)
- ZLE_MAX(JJ) = PWS_ROOF(JJ) / PTSTEP * XLVTT
- ZLE (JJ) =(PQSAT_ROOF(JJ) - PQA(JJ)) &
- * PAC_ROOF(JJ) * PDELT_ROOF(JJ) * XLVTT * PRHOA(JJ)
+ ZLE_MAX(JJ) = T%XWS_ROOF(JJ) / PTSTEP * XLVTT
+ ZLE (JJ) =(PQSAT_ROOF(JJ) - PQA(JJ)) &
+ * PAC_ROOF(JJ) * PDELT_ROOF(JJ) * XLVTT * PRHOA(JJ)
!
PAC_ROOF_WAT(JJ) = PAC_ROOF(JJ)
!
@@ -375,11 +352,10 @@ ENDDO
!* Because air/air exchanges are considered, roughness length for heat is set
! equal to roughness length for momentum.
!
-IF (.NOT. OCANOPY) THEN
- CALL URBAN_EXCH_COEF('MASC95', 1., PT_CANYON, PQ_CANYON, PEXNS, PEXNA, PTA, PQA, &
- PZREF+PBLD_HEIGHT-PZ_LOWCAN,PUREF+PBLD_HEIGHT-PZ_LOWCAN, &
- PVMOD, ZZ0_TOP, &
- ZRI, ZCD, ZCDN, PAC_TOP, ZRA_TOP, ZCH_TOP )
+IF (.NOT. TOP%LCANOPY) THEN
+ CALL URBAN_EXCH_COEF('MASC95', 1., PT_CANYON, PQ_CANYON, PEXNS, PEXNA, PTA, PQA, &
+ PZREF+T%XBLD_HEIGHT-PZ_LOWCAN, PUREF+T%XBLD_HEIGHT-PZ_LOWCAN, &
+ PVMOD, ZZ0_TOP, ZRI, ZCD, ZCDN, PAC_TOP, ZRA_TOP, ZCH_TOP )
ENDIF
!
!-------------------------------------------------------------------------------
@@ -390,13 +366,13 @@ ENDIF
!* 8.1 aerodynamical conductance for walls
! -----------------------------------
!
-IF (HCH_BEM == "DOE-2") THEN
+IF (TOP%CCH_BEM == "DOE-2") THEN
DO JJ=1,SIZE(PTA)
ZCHTCN_WALL(JJ) = CHTC_VERT_DOE(PTS_WALL(JJ), PT_CANYON(JJ))
- ZCHTCS_WALL(JJ) = 0.5 * (CHTC_SMOOTH_LEE_DOE(ZCHTCN_WALL(JJ), PU_CANYON(JJ)) + &
+ ZCHTCS_WALL(JJ) = 0.5 * (CHTC_SMOOTH_LEE_DOE (ZCHTCN_WALL(JJ), PU_CANYON(JJ)) + &
CHTC_SMOOTH_WIND_DOE(ZCHTCN_WALL(JJ), PU_CANYON(JJ)) )
- PAC_WALL(JJ) = CHTC_ROUGH_DOE(ZCHTCN_WALL(JJ), ZCHTCS_WALL(JJ), PROUGH_WALL(JJ)) / XCPD / PRHOA(JJ)
+ PAC_WALL(JJ) = CHTC_ROUGH_DOE(ZCHTCN_WALL(JJ), ZCHTCS_WALL(JJ), T%XROUGH_WALL(JJ)) / XCPD / PRHOA(JJ)
END DO
ELSE
PAC_WALL(:) = ( 11.8 + 4.2 * PU_CANYON(:) ) / XCPD / PRHOA(:)
@@ -414,23 +390,26 @@ DO JLOOP=1,3
ZW_CAN(:) = ZW_STAR(:)
!
!
- CALL URBAN_EXCH_COEF(HZ0H, ZZ0_O_Z0H, PTS_ROAD, PQ_LOWCAN, PEXNS, PEXNA, &
- PT_LOWCAN, PQ_LOWCAN, &
- PZ_LOWCAN, PZ_LOWCAN, PU_CANYON+ZW_CAN, ZZ0_ROAD, &
- ZRI, ZCD_ROAD, ZCDN, PAC_ROAD, ZRA_ROAD, ZCH_ROAD )
+ CALL URBAN_EXCH_COEF(TOP%CZ0H, ZZ0_O_Z0H, PTS_ROAD, PQ_LOWCAN, PEXNS, PEXNA, &
+ PT_LOWCAN, PQ_LOWCAN, PZ_LOWCAN, PZ_LOWCAN, &
+ PU_LOWCAN+ZW_CAN, ZZ0_ROAD, ZRI, ZCD_ROAD, ZCDN, &
+ PAC_ROAD, ZRA_ROAD, ZCH_ROAD )
!
DO JJ=1,SIZE(PTA)
- ZQ0(JJ) = (PTS_WALL (JJ) - PT_CANYON(JJ)) * PAC_WALL (JJ) * PWALL_O_GRND(JJ)
+ ZQ0(JJ) = (PTS_WALL (JJ) - PT_CANYON(JJ)) * PAC_WALL (JJ) * T%XWALL_O_GRND(JJ)
- IF (PROAD(JJ)+PGARDEN(JJ) .GT. 0.) THEN
+ IF (T%XROAD(JJ) .GT. 0.) THEN
ZQ0(JJ) = ZQ0(JJ) &
- +(PTS_ROAD (JJ) - PT_LOWCAN(JJ)) * PAC_ROAD (JJ) * PROAD (JJ)/(PROAD(JJ)+PGARDEN(JJ)) &
- +(PTS_GARDEN(JJ) - PT_LOWCAN(JJ)) * PAC_GARDEN(JJ) * PGARDEN(JJ)/(PROAD(JJ)+PGARDEN(JJ))
+ + (PTS_ROAD (JJ) - PT_LOWCAN(JJ)) * PAC_ROAD (JJ) * T%XROAD (JJ)/(T%XROAD(JJ)+T%XGARDEN(JJ))
ENDIF
+ IF (T%XGARDEN(JJ) .GT. 0.) THEN
+ ZQ0(JJ) = ZQ0(JJ) &
+ + (PTS_GARDEN(JJ) - PT_LOWCAN(JJ)) * PAC_GARDEN(JJ) * T%XGARDEN(JJ)/(T%XROAD(JJ)+T%XGARDEN(JJ))
+ ENDIF
!
IF (ZQ0(JJ) >= 0.) THEN
- ZW_STAR(JJ) = ( (XG * PEXNA(JJ) / PTA(JJ)) * ZQ0(JJ) * PBLD_HEIGHT(JJ)) ** (1/3.)
+ ZW_STAR(JJ) = ( (XG * PEXNA(JJ) / PTA(JJ)) * ZQ0(JJ) * T%XBLD_HEIGHT(JJ)) ** (1/3.)
ELSE
ZW_STAR(JJ) = 0.
ENDIF
@@ -445,7 +424,7 @@ END DO
!
DO JJ=1,SIZE(PTA)
!
- ZLE_MAX(JJ) = PWS_ROAD(JJ) / PTSTEP * XLVTT
+ ZLE_MAX(JJ) = T%XWS_ROAD(JJ) / PTSTEP * XLVTT
ZLE (JJ) = ( PQSAT_ROAD(JJ) - PQ_LOWCAN(JJ) ) &
* PAC_ROAD(JJ) * PDELT_ROAD(JJ) * XLVTT * PRHOA(JJ)
!
@@ -459,10 +438,10 @@ DO JJ=1,SIZE(PTA)
!* 8.5 aerodynamical conductance for window
! ------------------------------------
!
- ZCHTCN_WIN(JJ) = CHTC_VERT_DOE(PTS_WIN(JJ), PT_CANYON(JJ))
+ ZCHTCN_WIN(JJ) = CHTC_VERT_DOE(B%XT_WIN1(JJ), PT_CANYON(JJ))
!
PAC_WIN(JJ) = 0.5 * (CHTC_SMOOTH_LEE_DOE(ZCHTCN_WIN(JJ), PU_CANYON(JJ)) + &
- CHTC_SMOOTH_WIND_DOE(ZCHTCN_WIN(JJ), PU_CANYON(JJ)) ) &
+ CHTC_SMOOTH_WIND_DOE(ZCHTCN_WIN(JJ), PU_CANYON(JJ)) ) &
/ PRHOA(JJ) / XCPD
!
!-------------------------------------------------------------------------------
@@ -475,7 +454,7 @@ DO JJ=1,SIZE(PTA)
!
!* road friction
!
- IF (OCANOPY) THEN
+ IF (TOP%LCANOPY) THEN
!
ZUSTAR2(JJ)=XUNDEF
!
diff --git a/src/SURFEX/urban_exch_coef.F90 b/src/SURFEX/urban_exch_coef.F90
index 24dd4a5d2ea2f60f6c90a3416a9f2e0cd4bc1bc3..c298f56aa28b1941a5cf78e39c602c89a62ad22e 100644
--- a/src/SURFEX/urban_exch_coef.F90
+++ b/src/SURFEX/urban_exch_coef.F90
@@ -62,8 +62,6 @@ USE PARKIND1 ,ONLY : JPRB
!
USE MODI_FLXSURF3BX
!
-USE MODI_INIT_SURFCONSPHY
-!
IMPLICIT NONE
!
CHARACTER(LEN=6) :: HZ0H ! TEB option for z0h roof & road
@@ -133,7 +131,6 @@ ELSEIF(HZ0H=='BRUT82' .OR. HZ0H=='KAND07')THEN
! initialisations
fcor(:)=1.0372462E-04
!RJ: can be removed
- CALL INIT_SURFCONSPHY
N=SIZE(PTA)
!
! Set a minimum threshold to the wind
diff --git a/src/SURFEX/urban_fluxes.F90 b/src/SURFEX/urban_fluxes.F90
index 5d4d44bcdd38dc001f8501c5807dce37510cce37..fb923ff1e2f3086d9b606a45aa3a407b2e4d7eaa 100644
--- a/src/SURFEX/urban_fluxes.F90
+++ b/src/SURFEX/urban_fluxes.F90
@@ -3,39 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE URBAN_FLUXES(HIMPLICIT_WIND, OCANOPY, PT_CANYON, &
- PPEW_A_COEF, PPEW_B_COEF, &
- PEXNS, PRHOA, PVMOD, &
- PH_TRAFFIC, PLE_TRAFFIC, PH_INDUSTRY, PLE_INDUSTRY, &
- PBLD, PROAD, PWALL_O_HOR, PFRAC_GR, &
- PABS_SW_ROOF, PABS_LW_ROOF, &
- PABS_SW_WALL_A, PABS_LW_WALL_A, &
- PABS_SW_WALL_B, PABS_LW_WALL_B, &
- PABS_SW_ROAD, PABS_LW_ROAD, &
- PAC_WALL, PCD, &
- PDF_ROOF, PDN_ROOF, PDF_ROAD, PDN_ROAD, &
- PRNSNOW_ROOF, PHSNOW_ROOF, PLESNOW_ROOF, PGSNOW_ROOF, &
- PRNSNOW_ROAD, PHSNOW_ROAD, PLESNOW_ROAD, PGSNOW_ROAD, &
- PMELT_ROOF, PDQS_ROOF, &
- PMELT_ROAD, PDQS_ROAD, &
- PDQS_WALL_A, PDQS_WALL_B, &
- PFLX_BLD_ROOF, PFLX_BLD_WALL_A, PFLX_BLD_WALL_B, &
- PFLX_BLD_FLOOR, &
- PFLX_BLD_MASS, PE_SHADING, HBEM, PGR, PT_WIN1, PH_WASTE, &
- PLE_WASTE, PF_WASTE_CAN, PABS_SW_WIN, PABS_LW_WIN, PQIN, &
- PN_FLOOR, PLEW_ROOF, PLEW_ROAD, &
- PRN_GREENROOF, PH_GREENROOF, PLE_GREENROOF, &
- PGFLUX_GREENROOF, &
- PH_ROOF, PH_ROAD, PH_WALL_A, PH_WALL_B, &
- PRN_ROOF, PLE_ROOF, &
- PGFLUX_ROOF, PRN_ROAD, PLE_ROAD, PGFLUX_ROAD, &
- PRN_WALL_A, PLE_WALL_A, PGFLUX_WALL_A, &
- PRN_WALL_B, PLE_WALL_B, PGFLUX_WALL_B, &
- PRN_STRLROOF, PH_STRLROOF, PLE_STRLROOF, &
- PGFLUX_STRLROOF, &
- PRN_BLT, PH_BLT, PLE_BLT, &
- PGFLUX_BLT, PMELT_BLT, PQF_BLD, PFLX_BLD, PDQS_BLT, &
- PQF_TOWN, PUSTAR_TOWN, PHVAC_COOL, PHVAC_HEAT )
+ SUBROUTINE URBAN_FLUXES(TOP, T, B, DMT, HIMPLICIT_WIND, PT_CANYON, PPEW_A_COEF, PPEW_B_COEF, &
+ PEXNS, PRHOA, PVMOD, PH_TRAFFIC, PLE_TRAFFIC, PAC_WL, PCD, PDF_RF, &
+ PDN_RF, PDF_RD, PDN_RD, PRNSN_RF, PHSN_RF, PLESN_RF, PGSN_RF, &
+ PRNSN_RD, PHSN_RD, PLESN_RD, PGSN_RD, PMELT_RF, PDQS_RF, PMELT_RD, &
+ PDQS_RD, PDQS_WL_A, PDQS_WL_B, PFLX_BLD_RF, PFLX_BLD_WL_A, &
+ PFLX_BLD_WL_B, PFLX_BLD_FL, PFLX_BLD_MA, PE_SHADING, PLEW_RF, &
+ PRN_GR, PH_GR, PLE_GR, PGFLUX_GR, &
+ PLEW_RD, PLE_WL_A, PLE_WL_B, PMELT_BLT, PUSTAR_TWN )
! ##########################################################################
!
!!**** *URBAN_FLUXES* computes fluxes on urbanized surfaces
@@ -83,6 +58,11 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
+USE MODD_TEB_n, ONLY : TEB_t
+USE MODD_BEM_n, ONLY : BEM_t
+USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_t
+!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_CSTS, ONLY : XCPD
!
@@ -93,11 +73,14 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+TYPE(TEB_t), INTENT(INOUT) :: T
+TYPE(BEM_t), INTENT(INOUT) :: B
+TYPE(DIAG_MISC_TEB_t), INTENT(INOUT) :: DMT
!
CHARACTER(LEN=*), INTENT(IN) :: HIMPLICIT_WIND ! wind implicitation option
! ! 'OLD' = direct
! ! 'NEW' = Taylor serie, order 1
-LOGICAL, INTENT(IN) :: OCANOPY ! is canopy active ?
REAL, DIMENSION(:), INTENT(IN) :: PT_CANYON ! canyon air temperature
REAL, DIMENSION(:), INTENT(IN) :: PPEW_A_COEF ! implicit coefficients
@@ -107,130 +90,64 @@ REAL, DIMENSION(:), INTENT(IN) :: PEXNS ! surface exner function
REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! air density
! at the lowest level
REAL, DIMENSION(:), INTENT(IN) :: PVMOD ! module of the horizontal wind
-REAL, DIMENSION(:), INTENT(IN) :: PH_TRAFFIC ! anthropogenic sensible
-! ! heat fluxes due to traffic
-REAL, DIMENSION(:), INTENT(IN) :: PLE_TRAFFIC ! anthropogenic latent
-! ! heat fluxes due to traffic
-REAL, DIMENSION(:), INTENT(IN) :: PH_INDUSTRY ! anthropogenic sensible
-! ! heat fluxes due to factories
-REAL, DIMENSION(:), INTENT(IN) :: PLE_INDUSTRY ! anthropogenic latent
-! ! heat fluxes due to factories
-REAL, DIMENSION(:), INTENT(IN) :: PBLD ! fraction of buildings
-REAL, DIMENSION(:), INTENT(IN) :: PROAD ! fraction of roads
-REAL, DIMENSION(:), INTENT(IN) :: PWALL_O_HOR ! wall Surf. / (bld+road+green) Surf.
-REAL, DIMENSION(:), INTENT(IN) :: PFRAC_GR ! Fraction of green roofs
-!
-REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_ROOF ! absorbed SW rad. by roof
-REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_ROOF ! absorbed LW rad. by roof
-REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_WALL_A! absorbed SW rad. by wall A
-REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_WALL_A! absorbed LW rad. by wall A
-REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_WALL_B! absorbed SW rad. by wall B
-REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_WALL_B! absorbed LW rad. by wall B
-REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_ROAD ! absorbed SW rad. by road
-REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_ROAD ! absorbed LW rad. by road
-!
-REAL, DIMENSION(:), INTENT(IN) :: PAC_WALL ! surface conductance
+REAL, DIMENSION(:), INTENT(IN) :: PH_TRAFFIC ! anthropogenic sensible
+! ! heat fluxes due to traffic
+REAL, DIMENSION(:), INTENT(IN) :: PLE_TRAFFIC ! anthropogenic latent
+! ! heat fluxes due to traffic
+REAL, DIMENSION(:), INTENT(IN) :: PAC_WL ! surface conductance
! ! for heat transfer
! ! between wall and canyon
REAL, DIMENSION(:), INTENT(IN) :: PCD ! drag coefficient
-REAL, DIMENSION(:), INTENT(IN) :: PDF_ROOF ! snow-free roof fraction
-REAL, DIMENSION(:), INTENT(IN) :: PDN_ROOF ! snow-covered roof fraction
-REAL, DIMENSION(:), INTENT(IN) :: PDF_ROAD ! snow-free road fraction
-REAL, DIMENSION(:), INTENT(IN) :: PDN_ROAD ! snow-covered road fraction
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRNSNOW_ROOF ! net radiation over snow
-REAL, DIMENSION(:), INTENT(IN) :: PHSNOW_ROOF ! sensible heat flux over snow
-REAL, DIMENSION(:), INTENT(IN) :: PLESNOW_ROOF ! latent heat flux over snow
-REAL, DIMENSION(:), INTENT(IN) :: PGSNOW_ROOF ! flux under the snow
-REAL, DIMENSION(:), INTENT(IN) :: PRNSNOW_ROAD ! net radiation over snow
-REAL, DIMENSION(:), INTENT(IN) :: PHSNOW_ROAD ! sensible heat flux over snow
-REAL, DIMENSION(:), INTENT(IN) :: PLESNOW_ROAD ! latent heat flux over snow
-REAL, DIMENSION(:), INTENT(IN) :: PGSNOW_ROAD ! flux under the snow
-!
-REAL, DIMENSION(:), INTENT(IN) :: PMELT_ROOF ! snow melting on roof
-REAL, DIMENSION(:), INTENT(IN) :: PDQS_ROOF ! storage inside roofs
-REAL, DIMENSION(:), INTENT(IN) :: PMELT_ROAD ! snow melting on road
-REAL, DIMENSION(:), INTENT(IN) :: PDQS_ROAD ! storage inside roads
-REAL, DIMENSION(:), INTENT(IN) :: PDQS_WALL_A ! storage inside walls
-REAL, DIMENSION(:), INTENT(IN) :: PDQS_WALL_B ! storage inside walls
-REAL, DIMENSION(:), INTENT(IN) :: PFLX_BLD_ROOF! heat flx from bld to roof
-REAL, DIMENSION(:), INTENT(IN) :: PFLX_BLD_WALL_A! heat flx from bld to wall A
-REAL, DIMENSION(:), INTENT(IN) :: PFLX_BLD_WALL_B! heat flx from bld to wall B
-REAL, DIMENSION(:), INTENT(IN) :: PFLX_BLD_FLOOR! heat flx from bld to floor
-REAL, DIMENSION(:), INTENT(IN) :: PFLX_BLD_MASS! heat flx from bld to mass
+REAL, DIMENSION(:), INTENT(IN) :: PDF_RF ! snow-free roof fraction
+REAL, DIMENSION(:), INTENT(IN) :: PDN_RF ! snow-covered roof fraction
+REAL, DIMENSION(:), INTENT(IN) :: PDF_RD ! snow-free road fraction
+REAL, DIMENSION(:), INTENT(IN) :: PDN_RD ! snow-covered road fraction
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRNSN_RF ! net radiation over snow
+REAL, DIMENSION(:), INTENT(IN) :: PHSN_RF ! sensible heat flux over snow
+REAL, DIMENSION(:), INTENT(IN) :: PLESN_RF ! latent heat flux over snow
+REAL, DIMENSION(:), INTENT(IN) :: PGSN_RF ! flux under the snow
+REAL, DIMENSION(:), INTENT(IN) :: PRNSN_RD ! net radiation over snow
+REAL, DIMENSION(:), INTENT(IN) :: PHSN_RD ! sensible heat flux over snow
+REAL, DIMENSION(:), INTENT(IN) :: PLESN_RD ! latent heat flux over snow
+REAL, DIMENSION(:), INTENT(IN) :: PGSN_RD ! flux under the snow
+!
+REAL, DIMENSION(:), INTENT(IN) :: PMELT_RF ! snow melting on roof
+REAL, DIMENSION(:), INTENT(IN) :: PDQS_RF ! storage inside roofs
+REAL, DIMENSION(:), INTENT(IN) :: PMELT_RD ! snow melting on road
+REAL, DIMENSION(:), INTENT(IN) :: PDQS_RD ! storage inside roads
+REAL, DIMENSION(:), INTENT(IN) :: PDQS_WL_A ! storage inside walls
+REAL, DIMENSION(:), INTENT(IN) :: PDQS_WL_B ! storage inside walls
+REAL, DIMENSION(:), INTENT(IN) :: PFLX_BLD_RF! heat flx from bld to roof
+REAL, DIMENSION(:), INTENT(IN) :: PFLX_BLD_WL_A! heat flx from bld to wall A
+REAL, DIMENSION(:), INTENT(IN) :: PFLX_BLD_WL_B! heat flx from bld to wall B
+REAL, DIMENSION(:), INTENT(IN) :: PFLX_BLD_FL! heat flx from bld to floor
+REAL, DIMENSION(:), INTENT(IN) :: PFLX_BLD_MA! heat flx from bld to mass
REAL, DIMENSION(:), INTENT(IN) :: PE_SHADING ! energy not ref., nor absorbed, nor
!trans. by glazing [W
!m-2(win)]
- CHARACTER(LEN=3), INTENT(IN) :: HBEM ! Building Energy model 'DEF' or 'BEM'
-!
-REAL, DIMENSION(:), INTENT(IN) :: PGR ! glazing ratio
-REAL, DIMENSION(:), INTENT(IN) :: PT_WIN1 ! Outdoor window temperature [K]
-REAL, DIMENSION(:), INTENT(IN) :: PH_WASTE ! sensible waste heat released by HVAC systems [W m-2(urb)]
-REAL, DIMENSION(:), INTENT(IN) :: PLE_WASTE ! latent waste heat released by HVAC systems [W m-2(urb)]
-REAL, DIMENSION(:), INTENT(IN) :: PF_WASTE_CAN ! fraction of waste heat released into the canyon
-REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_WIN ! absorbed SW radiation by windows [W m-2]
-REAL, DIMENSION(:), INTENT(IN) :: PABS_LW_WIN ! absorbed LW radiation by windows [W m-2]
-REAL, DIMENSION(:), INTENT(IN) :: PQIN ! Internal heat gains [W m-2(floor)]
-REAL, DIMENSION(:), INTENT(IN) :: PN_FLOOR ! Number of Building floors [-]
-!
-REAL, DIMENSION(:), INTENT(IN) :: PLEW_ROOF ! latent heat flux over snow-free roof
-REAL, DIMENSION(:), INTENT(IN) :: PLEW_ROAD ! latent heat flux of snow-free road
-!
-REAL, DIMENSION(:), INTENT(IN) :: PRN_GREENROOF ! net radiation of green roofs
-REAL, DIMENSION(:), INTENT(IN) :: PH_GREENROOF ! sensible heat flux of green roofs
-REAL, DIMENSION(:), INTENT(IN) :: PLE_GREENROOF ! latent heat flux of green roofs
-REAL, DIMENSION(:), INTENT(IN) :: PGFLUX_GREENROOF ! heat storage flux of green roofs
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PH_ROOF ! sensible heat flux over roof
-REAL, DIMENSION(:), INTENT(INOUT) :: PH_ROAD ! sensible heat flux from snow free road
- ! to air (in) and from all road to air (out)
-REAL, DIMENSION(:), INTENT(INOUT) :: PH_WALL_A ! sensible heat flux wall to
- ! air (in) and facade to air (out)
-REAL, DIMENSION(:), INTENT(INOUT) :: PH_WALL_B ! sensible heat flux wall to
- ! air (in) and facade to air (out)
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PRN_ROOF ! net radiation over roof
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_ROOF ! latent heat flux over roof
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX_ROOF ! flux through the roof
-REAL, DIMENSION(:), INTENT(OUT) :: PRN_ROAD ! net radiation over road
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_ROAD ! latent heat flux over road
-
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX_ROAD ! flux through the road
-REAL, DIMENSION(:), INTENT(OUT) :: PRN_WALL_A ! net radiation over wall
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_WALL_A ! latent heat flux over wall
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX_WALL_A! flux through the wall
-REAL, DIMENSION(:), INTENT(OUT) :: PRN_WALL_B ! net radiation over wall
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_WALL_B ! latent heat flux over wall
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX_WALL_B! flux through the wall
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PRN_STRLROOF ! net radiation of structural roof
-REAL, DIMENSION(:), INTENT(OUT) :: PH_STRLROOF ! sensible heat flux of structural roof
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_STRLROOF ! latent heat flux of structural roof
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX_STRLROOF ! heat storage flux of structural roof
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PRN_BLT ! net radiation over built covers
-REAL, DIMENSION(:), INTENT(OUT) :: PH_BLT ! sensible heat flux over built covers
-REAL, DIMENSION(:), INTENT(OUT) :: PLE_BLT ! latent heat flux over built covers
-REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX_BLT ! flux through the built covers
-REAL, DIMENSION(:), INTENT(OUT) :: PMELT_BLT ! snow melting for town
!
-REAL, DIMENSION(:), INTENT(OUT) :: PQF_BLD ! anthropogenic heat due to domestic heating [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PFLX_BLD ! heat flx from bld to its structure [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(OUT) :: PDQS_BLT ! storage inside urban materials
-REAL, DIMENSION(:), INTENT(OUT) :: PQF_TOWN ! total anthropogenic heat [W m-2(urb)]
-REAL, DIMENSION(:), INTENT(OUT) :: PUSTAR_TOWN ! friction velocity over town
+REAL, DIMENSION(:), INTENT(IN) :: PLEW_RF ! latent heat flux over snow-free roof
+REAL, DIMENSION(:), INTENT(IN) :: PLEW_RD ! latent heat flux of snow-free road
+REAL, DIMENSION(:), INTENT(IN) :: PRN_GR ! net radiation over greenroof
+REAL, DIMENSION(:), INTENT(IN) :: PH_GR ! sensible heat flux over greenroof
+REAL, DIMENSION(:), INTENT(IN) :: PLE_GR ! latent heat flux over greenroof
+REAL, DIMENSION(:), INTENT(IN) :: PGFLUX_GR ! flux through the greenroof
!
-REAL, DIMENSION(:), INTENT(IN) :: PHVAC_COOL ! Energy consumption of the cooling system
- ! [W m-2(bld)]
-REAL, DIMENSION(:), INTENT(IN) :: PHVAC_HEAT ! Energy consumption of the heating system
- ! [W m-2(bld)]
+REAL, DIMENSION(:), INTENT(OUT) :: PLE_WL_A ! latent heat flux over wall
+REAL, DIMENSION(:), INTENT(OUT) :: PLE_WL_B ! latent heat flux over wall
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PMELT_BLT ! snow melting for town
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PUSTAR_TWN ! friction velocity over town
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(SIZE(PRHOA)) :: ZH_ROOF_SNOWFREE
-REAL, DIMENSION(SIZE(PRHOA)) :: ZRN_ROOF_SNOWFREE
-REAL, DIMENSION(SIZE(PRHOA)) :: ZUSTAR2 ! square of friction velocity (m2/s2)
-REAL, DIMENSION(SIZE(PRHOA)) :: ZVMOD ! Wind
+REAL, DIMENSION(SIZE(PRHOA)) :: ZH_RF_SNFREE
+REAL, DIMENSION(SIZE(PRHOA)) :: ZRN_RF_SNFREE
+REAL, DIMENSION(SIZE(PRHOA)) :: ZUSTAR2 ! square of friction velocity (m2/s2)
+REAL, DIMENSION(SIZE(PRHOA)) :: ZVMOD ! Wind
+REAL, DIMENSIOn(SIZE(PRHOA)) :: ZINTER
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -243,11 +160,11 @@ IF (LHOOK) CALL DR_HOOK('URBAN_FLUXES',0,ZHOOK_HANDLE)
! net radiation
!
!
-ZRN_ROOF_SNOWFREE(:) = PABS_SW_ROOF(:) + PABS_LW_ROOF(:)
+ZRN_RF_SNFREE(:) = DMT%XABS_SW_ROOF(:) + DMT%XABS_LW_ROOF(:)
!
! sensible heat flux
!
-ZH_ROOF_SNOWFREE(:) = PH_ROOF(:)
+ZH_RF_SNFREE(:) = DMT%XH_ROOF(:)
!
!-------------------------------------------------------------------------------
!
@@ -256,7 +173,7 @@ ZH_ROOF_SNOWFREE(:) = PH_ROOF(:)
!
! net radiation
!
-PRN_ROAD(:) = PABS_SW_ROAD(:) + PABS_LW_ROAD(:)
+DMT%XRN_ROAD(:) = DMT%XABS_SW_ROAD(:) + DMT%XABS_LW_ROAD(:)
!
!-------------------------------------------------------------------------------
!
@@ -265,28 +182,42 @@ PRN_ROAD(:) = PABS_SW_ROAD(:) + PABS_LW_ROAD(:)
!
! net radiation
!
-PRN_WALL_A(:) = (PABS_SW_WALL_A(:) + PABS_LW_WALL_A(:)) * (1.-PGR(:)) &
- + (PABS_SW_WIN (:) + PABS_LW_WIN (:)) * PGR(:)
-PRN_WALL_B(:) = (PABS_SW_WALL_B(:) + PABS_LW_WALL_B(:)) * (1.-PGR(:)) &
- + (PABS_SW_WIN (:) + PABS_LW_WIN (:)) * PGR(:)
+DMT%XRN_WALL_A(:) = DMT%XABS_SW_WALL_A(:) + DMT%XABS_LW_WALL_A(:)
+DMT%XRN_WALL_B(:) = DMT%XABS_SW_WALL_B(:) + DMT%XABS_LW_WALL_B(:)
+!
+IF (TOP%CBEM=="BEM") THEN
+ ZINTER(:) = DMT%XABS_SW_WIN (:) + DMT%XABS_LW_WIN (:)
+ DMT%XRN_WALL_A(:) = DMT%XRN_WALL_A(:) * (1.-B%XGR(:)) + ZINTER(:) * B%XGR(:)
+ DMT%XRN_WALL_B(:) = DMT%XRN_WALL_B(:) * (1.-B%XGR(:)) + ZINTER(:) * B%XGR(:)
+ENDIF
!
! heat flux into the ground
!
-PGFLUX_WALL_A(:) = PRN_WALL_A(:) - PH_WALL_A(:)
-PGFLUX_WALL_B(:) = PRN_WALL_B(:) - PH_WALL_B(:)
+DMT%XGFLUX_WALL_A(:) = DMT%XRN_WALL_A(:) - DMT%XH_WALL_A(:)
+DMT%XGFLUX_WALL_B(:) = DMT%XRN_WALL_B(:) - DMT%XH_WALL_B(:)
!
! sensible heat flux
!
-!before -> PH_WALL in [W.m-2(wall)]
-PH_WALL_A(:) = (1. - PGR(:)) * PH_WALL_A(:) + PGR(:) * &
- ( PAC_WALL(:)*XCPD*PRHOA(:)/PEXNS(:) * (PT_WIN1(:)-PT_CANYON(:)) + PE_SHADING(:) ) &
- + PF_WASTE_CAN(:) * PH_WASTE(:) / PWALL_O_HOR(:)
-PH_WALL_B(:) = (1. - PGR(:)) * PH_WALL_B(:) + PGR(:) * &
- ( PAC_WALL(:)*XCPD*PRHOA(:)/PEXNS(:) * (PT_WIN1(:)-PT_CANYON(:)) + PE_SHADING(:) ) &
- + PF_WASTE_CAN(:) * PH_WASTE(:) / PWALL_O_HOR(:)
-!after PH_WALL in [W.m-2(facade=wall + win)]
-PLE_WALL_A(:) = PF_WASTE_CAN(:) * PLE_WASTE(:) / PWALL_O_HOR(:)
-PLE_WALL_B(:) = PF_WASTE_CAN(:) * PLE_WASTE(:) / PWALL_O_HOR(:)
+!before -> PH_WL in [W.m-2(wall)]
+ZINTER(:) = PAC_WL(:)*XCPD*PRHOA(:)/PEXNS(:) * (B%XT_WIN1(:)-PT_CANYON(:)) + PE_SHADING(:)
+!
+DMT%XH_WALL_A(:) = (1. - B%XGR(:)) * DMT%XH_WALL_A(:) + B%XGR(:) * ZINTER(:)
+DMT%XH_WALL_B(:) = (1. - B%XGR(:)) * DMT%XH_WALL_B(:) + B%XGR(:) * ZINTER(:)
+!
+IF (TOP%CBEM=="BEM") THEN
+ ZINTER(:) = B%XF_WASTE_CAN(:) * DMT%XH_WASTE(:) / T%XWALL_O_HOR(:)
+ DMT%XH_WALL_A(:) = DMT%XH_WALL_A(:) + ZINTER(:)
+ DMT%XH_WALL_B(:) = DMT%XH_WALL_B(:) + ZINTER(:)
+ENDIF
+!
+IF (TOP%CBEM=="BEM") THEN
+ !after PH_WALL in [W.m-2(facade=wall + win)]
+ ZINTER(:) = B%XF_WASTE_CAN(:) * DMT%XLE_WASTE(:) / T%XWALL_O_HOR(:)
+ELSE
+ ZINTER(:) = 0.
+ENDIF
+PLE_WL_A(:) = ZINTER(:)
+PLE_WL_B(:) = ZINTER(:)
!
!-------------------------------------------------------------------------------
!
@@ -298,12 +229,12 @@ PLE_WALL_B(:) = PF_WASTE_CAN(:) * PLE_WASTE(:) / PWALL_O_HOR(:)
!
! heat flux into the ground
!
-PGFLUX_ROAD (:) = PDF_ROAD(:) * (PRN_ROAD(:) - PH_ROAD (:) - PLEW_ROAD(:) ) &
- + PDN_ROAD(:) * PGSNOW_ROAD(:)
+DMT%XGFLUX_ROAD (:) = PDF_RD(:) * (DMT%XRN_ROAD(:) - DMT%XH_ROAD (:) - PLEW_RD(:) )&
+ + PDN_RD(:) * PGSN_RD(:)
!
! net radiation
!
-PRN_ROAD(:) = PRN_ROAD(:) * PDF_ROAD(:) + PRNSNOW_ROAD(:) * PDN_ROAD(:)
+DMT%XRN_ROAD(:) = DMT%XRN_ROAD(:) * PDF_RD(:) + PRNSN_RD(:) * PDN_RD(:)
!
! sensible heat flux
! total latent heat of evaporation from
@@ -311,25 +242,24 @@ PRN_ROAD(:) = PRN_ROAD(:) * PDF_ROAD(:) + PRNSNOW_ROAD(:) * PDN_ROAD(:)
!
! sensible heat flux
!
-PH_ROAD (:) = PH_ROAD (:) * PDF_ROAD(:) + PHSNOW_ROAD(:) * PDN_ROAD(:)
+DMT%XH_ROAD (:) = DMT%XH_ROAD (:) * PDF_RD(:) + PHSN_RD(:) * PDN_RD(:)
! total latent heat of evaporation from the road (snow free + snow)
!
-PLE_ROAD (:) = PLEW_ROAD(:) * PDF_ROAD(:) + PLESNOW_ROAD(:) * PDN_ROAD(:)
+DMT%XLE_ROAD (:) = PLEW_RD(:) * PDF_RD(:) + PLESN_RD(:) * PDN_RD(:)
!
!* 4.2 Roofs
! -----
!
! heat flux into the ground
!
-PGFLUX_STRLROOF(:) = PDF_ROOF(:) * (ZRN_ROOF_SNOWFREE(:) - ZH_ROOF_SNOWFREE(:) - PLEW_ROOF(:)) &
- + PDN_ROOF(:) * PGSNOW_ROOF(:)
-PGFLUX_ROOF (:) = (1.-PFRAC_GR(:)) * PGFLUX_STRLROOF(:) + PFRAC_GR(:) * PGFLUX_GREENROOF(:)
+DMT%XGFLUX_STRLROOF(:) = PDF_RF(:) * (ZRN_RF_SNFREE(:) - ZH_RF_SNFREE(:) - PLEW_RF(:)) + PDN_RF(:) * PGSN_RF(:)
+DMT%XGFLUX_ROOF (:) = (1.-T%XGREENROOF(:)) * DMT%XGFLUX_STRLROOF(:) + T%XGREENROOF(:) * PGFLUX_GR(:)
!
!
! net radiation
!
-PRN_STRLROOF (:) = ZRN_ROOF_SNOWFREE(:) * PDF_ROOF(:) + PRNSNOW_ROOF(:) * PDN_ROOF(:)
-PRN_ROOF (:) = (1.-PFRAC_GR(:)) * PRN_STRLROOF(:) + PFRAC_GR(:) * PRN_GREENROOF(:)
+DMT%XRN_STRLROOF (:) = ZRN_RF_SNFREE(:) * PDF_RF(:) + PRNSN_RF(:) * PDN_RF(:)
+DMT%XRN_ROOF (:) = (1.-T%XGREENROOF(:)) * DMT%XRN_STRLROOF(:) + T%XGREENROOF(:) * PRN_GR(:)
!
! sensible heat flux
! total latent heat of evaporation from
@@ -337,32 +267,35 @@ PRN_ROOF (:) = (1.-PFRAC_GR(:)) * PRN_STRLROOF(:) + PFRAC_GR(:) * PRN_GREE
!
! sensible heat flux
!
-PH_STRLROOF (:) = PH_ROOF(:) * PDF_ROOF(:) + PHSNOW_ROOF(:) * PDN_ROOF(:)
-PH_ROOF (:) = (1.-PFRAC_GR(:)) * PH_STRLROOF(:) + PFRAC_GR(:) * PH_GREENROOF(:) &
- + (1 - PF_WASTE_CAN(:)) * PH_WASTE(:) / PBLD(:)
+DMT%XH_STRLROOF (:) = DMT%XH_ROOF(:) * PDF_RF(:) + PHSN_RF(:) * PDN_RF(:)
+DMT%XH_ROOF (:) = (1.-T%XGREENROOF(:)) * DMT%XH_STRLROOF(:) + T%XGREENROOF(:) * PH_GR(:)
+!
!
! total latent heat of evaporation from the roof (snow free + snow)
!
-PLE_STRLROOF (:) = PLEW_ROOF(:) * PDF_ROOF(:) + PLESNOW_ROOF(:) * PDN_ROOF(:)
-PLE_ROOF (:) = (1.-PFRAC_GR(:)) * PLE_STRLROOF(:) + PFRAC_GR(:) * PLE_GREENROOF(:) &
- + (1 - PF_WASTE_CAN(:)) * PLE_WASTE(:)/PBLD(:)
+DMT%XLE_STRLROOF (:) = PLEW_RF(:) * PDF_RF(:) + PLESN_RF(:) * PDN_RF(:)
+DMT%XLE_ROOF (:) = (1.-T%XGREENROOF(:)) * DMT%XLE_STRLROOF(:) + T%XGREENROOF(:) * PLE_GR(:)
!
+IF (TOP%CBEM=="BEM") THEN
+ DMT%XH_ROOF (:) = DMT%XH_ROOF (:) + (1 - B%XF_WASTE_CAN(:)) * DMT%XH_WASTE (:)/T%XBLD(:)
+ DMT%XLE_ROOF(:) = DMT%XLE_ROOF(:) + (1 - B%XF_WASTE_CAN(:)) * DMT%XLE_WASTE(:)/T%XBLD(:)
+ENDIF
+
!-------------------------------------------------------------------------------
!
!* 5. Momentum fluxes
! ---------------
!
-PUSTAR_TOWN(:) = XUNDEF
+PUSTAR_TWN(:) = XUNDEF
!
-IF (.NOT. OCANOPY) THEN
+IF (.NOT. TOP%LCANOPY) THEN
!
ZUSTAR2(:) = 0.0
ZVMOD (:) = PVMOD(:)
!
IF(HIMPLICIT_WIND=='OLD')THEN
! old implicitation
- ZUSTAR2(:) = (PCD(:)*PVMOD(:)*PPEW_B_COEF(:))/ &
- (1.0-PRHOA(:)*PCD(:)*PVMOD(:)*PPEW_A_COEF(:))
+ ZUSTAR2(:) = (PCD(:)*PVMOD(:)*PPEW_B_COEF(:))/ (1.0-PRHOA(:)*PCD(:)*PVMOD(:)*PPEW_A_COEF(:))
ELSE
! new implicitation
ZUSTAR2(:) = (PCD(:)*PVMOD(:)*(2.*PPEW_B_COEF(:)-PVMOD(:)))/ &
@@ -377,7 +310,7 @@ IF (.NOT. OCANOPY) THEN
!
ENDIF
!
- PUSTAR_TOWN(:) = SQRT(ZUSTAR2(:))
+ PUSTAR_TWN(:) = SQRT(ZUSTAR2(:))
!
ENDIF
!
@@ -389,55 +322,55 @@ ENDIF
!* 6.1 Built fraction
! --------------
!
-PRN_BLT (:) = ( PBLD(:) * PRN_ROOF(:) &
- + PROAD(:) * PRN_ROAD(:) &
- + 0.5*PWALL_O_HOR(:) * PRN_WALL_A(:) &
- + 0.5*PWALL_O_HOR(:) * PRN_WALL_B(:)) &
- / (PROAD(:) + PBLD(:))
-!
-PH_BLT (:) = ( PBLD(:) * PH_ROOF(:) &
- + PROAD(:) * PH_ROAD(:) &
- + 0.5*PWALL_O_HOR(:) * PH_WALL_A(:) &
- + 0.5*PWALL_O_HOR(:) * PH_WALL_B(:)) &
- / (PROAD(:) + PBLD(:))
-!
-PLE_BLT (:) = ( PBLD(:) * PLE_ROOF (:) &
- + PROAD(:) * PLE_ROAD (:) &
- + 0.5*PWALL_O_HOR(:) * PLE_WALL_A (:) &
- + 0.5*PWALL_O_HOR(:) * PLE_WALL_B (:)) &
- / (PROAD(:) + PBLD(:))
-!
-PGFLUX_BLT (:) = ( PBLD(:) * PGFLUX_ROOF (:) &
- + PROAD(:) * PGFLUX_ROAD (:) &
- + 0.5*PWALL_O_HOR(:) * PGFLUX_WALL_A (:) &
- + 0.5*PWALL_O_HOR(:) * PGFLUX_WALL_B (:)) &
- / (PROAD(:) + PBLD(:))
-!
-PMELT_BLT (:) = ( PBLD(:) * PMELT_ROOF(:) * PDN_ROOF(:) &
- + PROAD(:) * PMELT_ROAD(:) * PDN_ROAD(:)) &
- / (PROAD(:) + PBLD(:))
-!
-PDQS_BLT (:) = ( PBLD(:) * PDQS_ROOF (:) &
- + PROAD(:) * PDQS_ROAD (:) &
- + 0.5*PWALL_O_HOR(:) * PDQS_WALL_A (:) &
- + 0.5*PWALL_O_HOR(:) * PDQS_WALL_B (:) ) &
- / (PROAD(:) + PBLD(:))
-!
-IF (HBEM == "DEF") THEN
- PQF_BLD(:) = ( ZH_ROOF_SNOWFREE(:) + PLEW_ROOF(:) + &
- PDQS_ROOF(:) - ZRN_ROOF_SNOWFREE(:) ) * PDF_ROOF(:) &
- + ( PDQS_ROOF(:) - PGSNOW_ROOF (:) ) * PDN_ROOF(:) &
- + 0.5*PWALL_O_HOR(:)/PBLD(:) * ( PH_WALL_A(:) + PLE_WALL_A(:) + PDQS_WALL_A(:) - PRN_WALL_A(:) ) &
- + 0.5*PWALL_O_HOR(:)/PBLD(:) * ( PH_WALL_B(:) + PLE_WALL_B(:) + PDQS_WALL_B(:) - PRN_WALL_B(:) )
- PFLX_BLD(:)= XUNDEF
-ELSEIF (HBEM == "BEM") THEN
- PQF_BLD(:) = PQIN(:)*PN_FLOOR(:) + PHVAC_COOL(:) + PHVAC_HEAT(:)
- PFLX_BLD(:)= PFLX_BLD_ROOF(:) + 0.5*PWALL_O_HOR(:)/PBLD(:)*PFLX_BLD_WALL_A(:) &
- + 0.5*PWALL_O_HOR(:)/PBLD(:)*PFLX_BLD_WALL_B(:) &
- + PFLX_BLD_FLOOR(:) + PFLX_BLD_MASS(:)
+DMT%XRN_BLT (:) = ( T%XBLD(:) * DMT%XRN_ROOF(:) &
+ + T%XROAD(:) * DMT%XRN_ROAD(:) &
+ + 0.5*T%XWALL_O_HOR(:) * DMT%XRN_WALL_A(:) &
+ + 0.5*T%XWALL_O_HOR(:) * DMT%XRN_WALL_B(:)) &
+ / (T%XROAD(:) + T%XBLD(:))
+!
+DMT%XH_BLT (:) = ( T%XBLD(:) * DMT%XH_ROOF(:) &
+ + T%XROAD(:) * DMT%XH_ROAD(:) &
+ + 0.5*T%XWALL_O_HOR(:) * DMT%XH_WALL_A(:) &
+ + 0.5*T%XWALL_O_HOR(:) * DMT%XH_WALL_B(:)) &
+ / (T%XROAD(:) + T%XBLD(:))
+!
+DMT%XLE_BLT (:) = ( T%XBLD(:) * DMT%XLE_ROOF (:) &
+ + T%XROAD(:) * DMT%XLE_ROAD (:) &
+ + 0.5*T%XWALL_O_HOR(:) * PLE_WL_A (:) &
+ + 0.5*T%XWALL_O_HOR(:) * PLE_WL_B (:)) &
+ / (T%XROAD(:) + T%XBLD(:))
+!
+DMT%XGFLUX_BLT (:) = ( T%XBLD(:) * DMT%XGFLUX_ROOF (:) &
+ + T%XROAD(:) * DMT%XGFLUX_ROAD (:) &
+ + 0.5*T%XWALL_O_HOR(:) * DMT%XGFLUX_WALL_A (:) &
+ + 0.5*T%XWALL_O_HOR(:) * DMT%XGFLUX_WALL_B (:)) &
+ / (T%XROAD(:) + T%XBLD(:))
+!
+PMELT_BLT (:) = ( T%XBLD(:) * PMELT_RF(:) * PDN_RF(:) &
+ + T%XROAD(:) * PMELT_RD(:) * PDN_RD(:)) &
+ / (T%XROAD(:) + T%XBLD(:))
+!
+DMT%XDQS_TOWN (:) = ( T%XBLD(:) * PDQS_RF (:) &
+ + T%XROAD(:) * PDQS_RD (:) &
+ + 0.5*T%XWALL_O_HOR(:) * PDQS_WL_A (:) &
+ + 0.5*T%XWALL_O_HOR(:) * PDQS_WL_B (:) ) &
+ / (T%XROAD(:) + T%XBLD(:))
+!
+IF (TOP%CBEM == "DEF") THEN
+ DMT%XQF_BLD(:) = ( ZH_RF_SNFREE(:) + PLEW_RF(:) + &
+ PDQS_RF(:) - ZRN_RF_SNFREE(:) ) * PDF_RF(:) &
+ + ( PDQS_RF(:) - PGSN_RF (:) ) * PDN_RF(:) &
+ + 0.5*T%XWALL_O_HOR(:)/T%XBLD(:) * ( DMT%XH_WALL_A(:) + PLE_WL_A(:) + PDQS_WL_A(:) - DMT%XRN_WALL_A(:) ) &
+ + 0.5*T%XWALL_O_HOR(:)/T%XBLD(:) * ( DMT%XH_WALL_B(:) + PLE_WL_B(:) + PDQS_WL_B(:) - DMT%XRN_WALL_B(:) )
+ DMT%XFLX_BLD(:)= XUNDEF
+ELSEIF (TOP%CBEM == "BEM") THEN
+ DMT%XQF_BLD(:) = DMT%XQIN(:)*B%XN_FLOOR(:) + DMT%XHVAC_COOL(:) + DMT%XHVAC_HEAT(:)
+ DMT%XFLX_BLD(:)= PFLX_BLD_RF(:) + 0.5*T%XWALL_O_HOR(:)/T%XBLD(:)*PFLX_BLD_WL_A(:) &
+ + 0.5*T%XWALL_O_HOR(:)/T%XBLD(:)*PFLX_BLD_WL_B(:) &
+ + PFLX_BLD_FL(:) + PFLX_BLD_MA(:)
ENDIF
!
-PQF_TOWN(:)= PBLD(:)*PQF_BLD(:) + PH_TRAFFIC(:) + PH_INDUSTRY(:) + PLE_TRAFFIC(:) + PLE_INDUSTRY(:)
+DMT%XQF_TOWN(:)= T%XBLD(:)*DMT%XQF_BLD(:) + PH_TRAFFIC(:) + T%XH_INDUSTRY(:) + PLE_TRAFFIC(:) + T%XLE_INDUSTRY(:)
!
!Flux from the building to its structure -> we need to add the component to the
!floor, the mass and the window
diff --git a/src/SURFEX/urban_lw_coef.F90 b/src/SURFEX/urban_lw_coef.F90
index 5f8b22906c9e060305cdc431f56a84f537d6c50c..978d7a758a08583ef9b72c07585eef30807f59b8 100644
--- a/src/SURFEX/urban_lw_coef.F90
+++ b/src/SURFEX/urban_lw_coef.F90
@@ -3,10 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ##########################################################################
- SUBROUTINE URBAN_LW_COEF(PGR, PBLD, PLW_RAD, &
- PEMIS_R, PSVF_R, PEMIS_W, PSVF_W, PEMIS_G, &
- PROAD, PGARDEN, PESNOW_R, &
- PTS_SR, PTS_W_A, PTS_W_B, PTS_R, PTS_G, PTS_WIN, &
+ SUBROUTINE URBAN_LW_COEF(B, T, PLW_RAD, PEMIS_G, PTS_SR, PTS_G, &
PLW_WA_TO_WB, PLW_WA_TO_R, PLW_WB_TO_R, &
PLW_WA_TO_NR,PLW_WB_TO_NR, &
PLW_WA_TO_G, PLW_WB_TO_G, &
@@ -63,6 +60,9 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_BEM_n, ONLY : BEM_t
+USE MODD_TEB_n, ONLY : TEB_t
+!
USE MODD_CSTS,ONLY : XSTEFAN
USE MODD_SURF_PAR,ONLY : XUNDEF
!
@@ -73,25 +73,13 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(BEM_t), INTENT(INOUT) :: B
+TYPE(TEB_t), INTENT(INOUT) :: T
!
-!
-REAL, DIMENSION(:), INTENT(IN) :: PGR ! glazing ratio
-REAL, DIMENSION(:), INTENT(IN) :: PBLD ! building density
REAL, DIMENSION(:), INTENT(IN) :: PLW_RAD ! incoming LW radiation
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_R ! road emissivity
-REAL, DIMENSION(:), INTENT(IN) :: PSVF_R ! road sky view factor
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_W ! wall emissivity
-REAL, DIMENSION(:), INTENT(IN) :: PSVF_W ! wall sky view factor
REAL, DIMENSION(:), INTENT(IN) :: PEMIS_G ! GARDEN area emissivity
-REAL, DIMENSION(:), INTENT(IN) :: PROAD ! road fraction
-REAL, DIMENSION(:), INTENT(IN) :: PGARDEN ! GARDEN area fraction
-REAL, DIMENSION(:), INTENT(IN) :: PESNOW_R ! road snow emissivity
!
-REAL, DIMENSION(:), INTENT(IN) :: PTS_W_A ! wall A surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS_W_B ! wall B surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS_R ! road surface tempeature
REAL, DIMENSION(:), INTENT(IN) :: PTS_G ! garden surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS_WIN ! window surface temperature
REAL, DIMENSION(:), INTENT(IN) :: PTS_SR ! snow surface temperature
!
REAL, DIMENSION(:), INTENT(OUT) :: PLW_WA_TO_WB! L.W. interactions wall->opposite wall
@@ -131,22 +119,22 @@ REAL, DIMENSION(:), INTENT(OUT) :: PLW_NR_TO_WIN ! L.W. interactions snow(road)-
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(SIZE(PBLD)) :: ZT_S ! sky temperature
-!
-REAL, DIMENSION(SIZE(PBLD)) :: ZEMIS_WIN
-REAL, DIMENSION(SIZE(PBLD)) :: ZF_W_W
-REAL, DIMENSION(SIZE(PBLD)) :: ZF_R_W
-REAL, DIMENSION(SIZE(PBLD)) :: ZF_R_WIN
-REAL, DIMENSION(SIZE(PBLD)) :: ZF_W_R
-REAL, DIMENSION(SIZE(PBLD)) :: ZF_W_G
-REAL, DIMENSION(SIZE(PBLD)) :: ZF_W_WIN
-REAL, DIMENSION(SIZE(PBLD)) :: ZF_W_NR
-REAL, DIMENSION(SIZE(PBLD)) :: ZF_WIN_W
-REAL, DIMENSION(SIZE(PBLD)) :: ZF_WIN_R
-REAL, DIMENSION(SIZE(PBLD)) :: ZF_WIN_G
-REAL, DIMENSION(SIZE(PBLD)) :: ZF_WIN_NR
-REAL, DIMENSION(SIZE(PBLD)) :: ZF_G_W
-REAL, DIMENSION(SIZE(PBLD)) :: ZF_G_WIN
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZT_S ! sky temperature
+!
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZEMIS_WIN
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZF_W_W
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZF_R_W
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZF_R_WIN
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZF_W_R
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZF_W_G
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZF_W_WIN
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZF_W_NR
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZF_WIN_W
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZF_WIN_R
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZF_WIN_G
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZF_WIN_NR
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZF_G_W
+REAL, DIMENSION(SIZE(T%XBLD)) :: ZF_G_WIN
!
REAL :: ZE1, ZE2, ZF, ZT1, ZT2, ZLW
ZLW(ZE1,ZE2,ZF,ZT1,ZT2) = 4.*XSTEFAN*ZE1*ZE2*ZF*((ZT1+ZT2)/2.)**3
@@ -158,41 +146,48 @@ IF (LHOOK) CALL DR_HOOK('URBAN_LW_COEF',0,ZHOOK_HANDLE)
!
ZT_S(:) = (PLW_RAD(:)/XSTEFAN)**0.25
!
-DO JJ=1,SIZE(PROAD)
+DO JJ=1,SIZE(T%XROAD)
!
ZEMIS_WIN(JJ) = 0.84 !from Energy Plus Engineering Reference, p219
! see http://apps1.eere.energy.gov/buildings/energyplus/
!
- ZF_W_R(JJ) = PSVF_W(JJ) * (PROAD(JJ) /(1.-PBLD(JJ)))
- ZF_W_G(JJ) = PSVF_W(JJ) * (PGARDEN(JJ)/(1.-PBLD(JJ)))
- ZF_W_NR(JJ) = PSVF_W(JJ)
+ ZF_W_R(JJ) = T%XSVF_WALL(JJ) * (T%XROAD(JJ) /(1.-T%XBLD(JJ)))
+ ZF_W_G(JJ) = T%XSVF_WALL(JJ) * (T%XGARDEN(JJ) /(1.-T%XBLD(JJ)))
+ ZF_W_NR(JJ) = T%XSVF_WALL(JJ)
!
ZF_WIN_R(JJ) = ZF_W_R(JJ)
ZF_WIN_G(JJ) = ZF_W_G(JJ)
ZF_WIN_NR(JJ) = ZF_W_NR(JJ)
!
- ZF_R_W(JJ) = (1 - PSVF_R(JJ))*(1.-PGR(JJ)) * 0.5
- ZF_R_WIN(JJ) = (1 - PSVF_R(JJ))*PGR(JJ)
+ ZF_R_W(JJ) = (1 - T%XSVF_ROAD(JJ))*(1.-B%XGR(JJ)) * 0.5
+ ZF_R_WIN(JJ) = (1 - T%XSVF_ROAD(JJ))*B%XGR(JJ)
!
ZF_G_W(JJ) = ZF_R_W(JJ)
ZF_G_WIN(JJ) = ZF_R_WIN(JJ)
!
- ZF_WIN_W(JJ) = (1.-2.*PSVF_W(JJ))*(1.-PGR(JJ))
- ZF_W_W (JJ) = (1.-2.*PSVF_W(JJ))*(1.-PGR(JJ))
- ZF_W_WIN(JJ) = (1.-2.*PSVF_W(JJ))*PGR(JJ)
+ ZF_WIN_W(JJ) = (1.-2.*T%XSVF_WALL(JJ))*(1.-B%XGR(JJ))
+ ZF_W_W (JJ) = (1.-2.*T%XSVF_WALL(JJ))*(1.-B%XGR(JJ))
+ ZF_W_WIN(JJ) = (1.-2.*T%XSVF_WALL(JJ))*B%XGR(JJ)
!
!
- PLW_WA_TO_WB(JJ)=ZLW(PEMIS_W(JJ),PEMIS_W(JJ),ZF_W_W(JJ),PTS_W_A(JJ),PTS_W_B(JJ))
+ PLW_WA_TO_WB(JJ)=ZLW(T%XEMIS_WALL(JJ),T%XEMIS_WALL(JJ),ZF_W_W(JJ),T%XT_WALL_A(JJ,1),T%XT_WALL_B(JJ,1))
!
- PLW_WA_TO_R(JJ) = ZLW(PEMIS_W(JJ),PEMIS_R(JJ),ZF_R_W(JJ),PTS_W_A(JJ),PTS_R(JJ))
- PLW_WB_TO_R(JJ) = ZLW(PEMIS_W(JJ),PEMIS_R(JJ),ZF_R_W(JJ),PTS_W_B(JJ),PTS_R(JJ))
- PLW_R_TO_WA(JJ) = ZLW(PEMIS_R(JJ),PEMIS_W(JJ),ZF_W_R(JJ),PTS_R(JJ),PTS_W_A(JJ))
- PLW_R_TO_WB(JJ) = ZLW(PEMIS_R(JJ),PEMIS_W(JJ),ZF_W_R(JJ),PTS_R(JJ),PTS_W_B(JJ))
+ PLW_WA_TO_R(JJ) = ZLW(T%XEMIS_WALL(JJ),T%XEMIS_ROAD(JJ),ZF_R_W(JJ),T%XT_WALL_A(JJ,1),T%XT_ROAD(JJ,1))
+ PLW_WB_TO_R(JJ) = ZLW(T%XEMIS_WALL(JJ),T%XEMIS_ROAD(JJ),ZF_R_W(JJ),T%XT_WALL_B(JJ,1),T%XT_ROAD(JJ,1))
+ PLW_R_TO_WA(JJ) = ZLW(T%XEMIS_ROAD(JJ),T%XEMIS_WALL(JJ),ZF_W_R(JJ),T%XT_ROAD(JJ,1),T%XT_WALL_A(JJ,1))
+ PLW_R_TO_WB(JJ) = ZLW(T%XEMIS_ROAD(JJ),T%XEMIS_WALL(JJ),ZF_W_R(JJ),T%XT_ROAD(JJ,1),T%XT_WALL_B(JJ,1))
!
- PLW_WA_TO_G(JJ) = ZLW(PEMIS_W(JJ),PEMIS_G(JJ),ZF_G_W(JJ),PTS_W_A(JJ),PTS_G(JJ))
- PLW_WB_TO_G(JJ) = ZLW(PEMIS_W(JJ),PEMIS_G(JJ),ZF_G_W(JJ),PTS_W_B(JJ),PTS_G(JJ))
- PLW_G_TO_WA(JJ) = ZLW(PEMIS_G(JJ),PEMIS_W(JJ),ZF_W_G(JJ),PTS_G(JJ),PTS_W_A(JJ))
- PLW_G_TO_WB(JJ) = ZLW(PEMIS_G(JJ),PEMIS_W(JJ),ZF_W_G(JJ),PTS_G(JJ),PTS_W_B(JJ))
+ IF (SIZE(PTS_G)>0) THEN
+ PLW_WA_TO_G(JJ) = ZLW(T%XEMIS_WALL(JJ),PEMIS_G(JJ),ZF_G_W(JJ),T%XT_WALL_A(JJ,1),PTS_G(JJ))
+ PLW_WB_TO_G(JJ) = ZLW(T%XEMIS_WALL(JJ),PEMIS_G(JJ),ZF_G_W(JJ),T%XT_WALL_B(JJ,1),PTS_G(JJ))
+ PLW_G_TO_WA(JJ) = ZLW(PEMIS_G(JJ),T%XEMIS_WALL(JJ),ZF_W_G(JJ),PTS_G(JJ),T%XT_WALL_A(JJ,1))
+ PLW_G_TO_WB(JJ) = ZLW(PEMIS_G(JJ),T%XEMIS_WALL(JJ),ZF_W_G(JJ),PTS_G(JJ),T%XT_WALL_B(JJ,1))
+ ELSE
+ PLW_WA_TO_G(JJ) = 0.
+ PLW_WB_TO_G(JJ) = 0.
+ PLW_G_TO_WA(JJ) = 0.
+ PLW_G_TO_WB(JJ) = 0.
+ ENDIF
!
!
IF (PTS_SR(JJ) .EQ. XUNDEF) THEN
@@ -206,36 +201,43 @@ DO JJ=1,SIZE(PROAD)
!
PLW_S_TO_NR (JJ) = 0.
ELSE
- PLW_WA_TO_NR(JJ) = ZLW(PEMIS_W(JJ),PESNOW_R(JJ),ZF_R_W(JJ),PTS_W_A(JJ),PTS_SR(JJ))
- PLW_WB_TO_NR(JJ) = ZLW(PEMIS_W(JJ),PESNOW_R(JJ),ZF_R_W(JJ),PTS_W_B(JJ),PTS_SR(JJ))
- PLW_NR_TO_WA(JJ) = ZLW(PESNOW_R(JJ),PEMIS_W(JJ),ZF_W_NR(JJ),PTS_SR(JJ),PTS_W_A(JJ))
- PLW_NR_TO_WB(JJ) = ZLW(PESNOW_R(JJ),PEMIS_W(JJ),ZF_W_NR(JJ),PTS_SR(JJ),PTS_W_B(JJ))
+ PLW_WA_TO_NR(JJ) = ZLW(T%XEMIS_WALL(JJ),T%TSNOW_ROAD%EMIS(JJ),ZF_R_W(JJ),T%XT_WALL_A(JJ,1),PTS_SR(JJ))
+ PLW_WB_TO_NR(JJ) = ZLW(T%XEMIS_WALL(JJ),T%TSNOW_ROAD%EMIS(JJ),ZF_R_W(JJ),T%XT_WALL_B(JJ,1),PTS_SR(JJ))
+ PLW_NR_TO_WA(JJ) = ZLW(T%TSNOW_ROAD%EMIS(JJ),T%XEMIS_WALL(JJ),ZF_W_NR(JJ),PTS_SR(JJ),T%XT_WALL_A(JJ,1))
+ PLW_NR_TO_WB(JJ) = ZLW(T%TSNOW_ROAD%EMIS(JJ),T%XEMIS_WALL(JJ),ZF_W_NR(JJ),PTS_SR(JJ),T%XT_WALL_B(JJ,1))
!
- PLW_WIN_TO_NR(JJ)= ZLW(ZEMIS_WIN(JJ),PESNOW_R(JJ),ZF_R_WIN(JJ),PTS_WIN(JJ),PTS_SR(JJ))
- PLW_NR_TO_WIN(JJ)= ZLW(PESNOW_R(JJ),ZEMIS_WIN(JJ),ZF_WIN_NR(JJ),PTS_SR(JJ),PTS_WIN(JJ))
+ PLW_WIN_TO_NR(JJ)= ZLW(ZEMIS_WIN(JJ),T%TSNOW_ROAD%EMIS(JJ),ZF_R_WIN(JJ),B%XT_WIN1(JJ),PTS_SR(JJ))
+ PLW_NR_TO_WIN(JJ)= ZLW(T%TSNOW_ROAD%EMIS(JJ),ZEMIS_WIN(JJ),ZF_WIN_NR(JJ),PTS_SR(JJ),B%XT_WIN1(JJ))
!
- PLW_S_TO_NR(JJ) = ZLW(1.,PESNOW_R(JJ),PSVF_R(JJ),ZT_S(JJ),PTS_SR(JJ))
+ PLW_S_TO_NR(JJ) = ZLW(1.,T%TSNOW_ROAD%EMIS(JJ),T%XSVF_ROAD(JJ),ZT_S(JJ),PTS_SR(JJ))
ENDIF
!
- PLW_WIN_TO_R(JJ)= ZLW(ZEMIS_WIN(JJ),PEMIS_R(JJ),ZF_R_WIN(JJ),PTS_WIN(JJ),PTS_R(JJ))
- PLW_R_TO_WIN(JJ)= ZLW(PEMIS_R(JJ),ZEMIS_WIN(JJ),ZF_WIN_R(JJ),PTS_R(JJ),PTS_WIN(JJ))
- !
- PLW_WIN_TO_G(JJ)= ZLW(ZEMIS_WIN(JJ),PEMIS_G(JJ),ZF_G_WIN(JJ),PTS_WIN(JJ),PTS_G(JJ))
- PLW_G_TO_WIN(JJ)= ZLW(PEMIS_G(JJ),ZEMIS_WIN(JJ),ZF_WIN_G(JJ),PTS_G(JJ),PTS_WIN(JJ))
+ PLW_WIN_TO_R(JJ)= ZLW(ZEMIS_WIN(JJ),T%XEMIS_ROAD(JJ),ZF_R_WIN(JJ),B%XT_WIN1(JJ),T%XT_ROAD(JJ,1))
+ PLW_R_TO_WIN(JJ)= ZLW(T%XEMIS_ROAD(JJ),ZEMIS_WIN(JJ),ZF_WIN_R(JJ),T%XT_ROAD(JJ,1),B%XT_WIN1(JJ))
+ !
+ IF (SIZE(PTS_G)>0) THEN
+ PLW_WIN_TO_G(JJ)= ZLW(ZEMIS_WIN(JJ),PEMIS_G(JJ),ZF_G_WIN(JJ),B%XT_WIN1(JJ),PTS_G(JJ))
+ PLW_G_TO_WIN(JJ)= ZLW(PEMIS_G(JJ),ZEMIS_WIN(JJ),ZF_WIN_G(JJ),PTS_G(JJ),B%XT_WIN1(JJ))
+ ELSE
+ PLW_WIN_TO_G(JJ) = 0.
+ PLW_G_TO_WIN(JJ) = 0.
+ ENDIF
!
- PLW_WIN_TO_WA(JJ) = ZLW(ZEMIS_WIN(JJ),PEMIS_W(JJ),ZF_W_WIN(JJ),PTS_WIN(JJ),PTS_W_A(JJ))
- PLW_WIN_TO_WB(JJ) = ZLW(ZEMIS_WIN(JJ),PEMIS_W(JJ),ZF_W_WIN(JJ),PTS_WIN(JJ),PTS_W_B(JJ))
- PLW_WA_TO_WIN(JJ) = ZLW(PEMIS_W(JJ),ZEMIS_WIN(JJ),ZF_WIN_W(JJ),PTS_W_A(JJ),PTS_WIN(JJ))
- PLW_WB_TO_WIN(JJ) = ZLW(PEMIS_W(JJ),ZEMIS_WIN(JJ),ZF_WIN_W(JJ),PTS_W_B(JJ),PTS_WIN(JJ))
+ PLW_WIN_TO_WA(JJ) = ZLW(ZEMIS_WIN(JJ),T%XEMIS_WALL(JJ),ZF_W_WIN(JJ),B%XT_WIN1(JJ),T%XT_WALL_A(JJ,1))
+ PLW_WIN_TO_WB(JJ) = ZLW(ZEMIS_WIN(JJ),T%XEMIS_WALL(JJ),ZF_W_WIN(JJ),B%XT_WIN1(JJ),T%XT_WALL_B(JJ,1))
+ PLW_WA_TO_WIN(JJ) = ZLW(T%XEMIS_WALL(JJ),ZEMIS_WIN(JJ),ZF_WIN_W(JJ),T%XT_WALL_A(JJ,1),B%XT_WIN1(JJ))
+ PLW_WB_TO_WIN(JJ) = ZLW(T%XEMIS_WALL(JJ),ZEMIS_WIN(JJ),ZF_WIN_W(JJ),T%XT_WALL_B(JJ,1),B%XT_WIN1(JJ))
!
- PLW_S_TO_WIN(JJ) = ZLW(1.,ZEMIS_WIN(JJ),PSVF_W(JJ),ZT_S(JJ),PTS_WIN(JJ))
+ PLW_S_TO_WIN(JJ) = ZLW(1.,ZEMIS_WIN(JJ),T%XSVF_WALL(JJ),ZT_S(JJ),B%XT_WIN1(JJ))
!
- PLW_S_TO_WA(JJ) = ZLW(1.,PEMIS_W(JJ),PSVF_W(JJ),ZT_S(JJ),PTS_W_A(JJ))
- PLW_S_TO_WB(JJ) = ZLW(1.,PEMIS_W(JJ),PSVF_W(JJ),ZT_S(JJ),PTS_W_B(JJ))
+ PLW_S_TO_WA(JJ) = ZLW(1.,T%XEMIS_WALL(JJ),T%XSVF_WALL(JJ),ZT_S(JJ),T%XT_WALL_A(JJ,1))
+ PLW_S_TO_WB(JJ) = ZLW(1.,T%XEMIS_WALL(JJ),T%XSVF_WALL(JJ),ZT_S(JJ),T%XT_WALL_B(JJ,1))
!
- PLW_S_TO_G(JJ) = ZLW(1.,PEMIS_G(JJ),PSVF_R(JJ),ZT_S(JJ),PTS_G(JJ))
- PLW_S_TO_R(JJ) = ZLW(1.,PEMIS_R(JJ),PSVF_R(JJ),ZT_S(JJ),PTS_R(JJ))
- PLW_S_TO_NR(JJ) = ZLW(1.,PESNOW_R(JJ),PSVF_R(JJ),ZT_S(JJ),PTS_SR(JJ))
+ IF (SIZE(PTS_G)>0) THEN
+ PLW_S_TO_G(JJ) = ZLW(1.,PEMIS_G(JJ),T%XSVF_ROAD(JJ),ZT_S(JJ),PTS_G(JJ))
+ ENDIF
+ PLW_S_TO_R(JJ) = ZLW(1.,T%XEMIS_ROAD(JJ),T%XSVF_ROAD(JJ),ZT_S(JJ),T%XT_ROAD(JJ,1))
+ PLW_S_TO_NR(JJ) = ZLW(1.,T%TSNOW_ROAD%EMIS(JJ),T%XSVF_ROAD(JJ),ZT_S(JJ),PTS_SR(JJ))
!
ENDDO
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/urban_snow_evol.F90 b/src/SURFEX/urban_snow_evol.F90
index 1b9f5fc82712268d688a8f988aad1bffc89180b7..e409cc72c85afc754cd578ea929669ada6b4b59f 100644
--- a/src/SURFEX/urban_snow_evol.F90
+++ b/src/SURFEX/urban_snow_evol.F90
@@ -3,29 +3,13 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE URBAN_SNOW_EVOL( &
- PT_LOWCAN, PQ_LOWCAN, PU_LOWCAN, &
- PTS_ROOF,PTS_ROAD,PTS_WALL_A, PTS_WALL_B, &
- PT_ROOF, PD_ROOF, PTC_ROOF, PHC_ROOF, &
- HSNOW_ROOF, &
- PWSNOW_ROOF, PTSNOW_ROOF, PRSNOW_ROOF, PASNOW_ROOF, &
- PTSSNOW_ROOF, PESNOW_ROOF, &
- HSNOW_ROAD, &
- PWSNOW_ROAD, PTSNOW_ROAD, PRSNOW_ROAD, PASNOW_ROAD, &
- PTSSNOW_ROAD, PESNOW_ROAD, &
- PPS, PTA, PQA, PRHOA, &
- PLW_RAD, &
- PSR, PZREF, PUREF, PVMOD, &
- PTSTEP, &
- PZ_LOWCAN, &
- PDN_ROOF, PABS_SW_SNOW_ROOF, PABS_LW_SNOW_ROOF, &
- PDN_ROAD, PABS_SW_SNOW_ROAD, PABS_LW_SNOW_ROAD, &
- PRNSNOW_ROOF, PHSNOW_ROOF, PLESNOW_ROOF, PGSNOW_ROOF, &
- PMELT_ROOF, &
- PRNSNOW_ROAD, PHSNOW_ROAD, PLESNOW_ROAD, PGSNOW_ROAD, &
- PMELT_ROAD, &
- PLW_WA_TO_NR , PLW_WB_TO_NR, PLW_S_TO_NR, PLW_WIN_TO_NR, &
- PDQS_SNOW_ROOF, PDQS_SNOW_ROAD, PT_WIN1 )
+ SUBROUTINE URBAN_SNOW_EVOL(T, B, PT_LWCN, PQ_LWCN, PU_LWCN, PTS_RF, PTS_RD, PTS_WL_A, &
+ PTS_WL_B, PPS, PTA, PQA, PRHOA, PLW_RAD, PSR, PZREF, PUREF, &
+ PVMOD, PTSTEP, PZ_LWCN, PDN_RF, PABS_SW_SN_RF, PABS_LW_SN_RF,&
+ PDN_RD, PABS_SW_SN_RD, PABS_LW_SN_RD, PRNSN_RF, PHSN_RF, &
+ PLESN_RF, PGSN_RF, PMELT_RF, PRNSN_RD, PHSN_RD, PLESN_RD, &
+ PGSN_RD, PMELT_RD, PLW_WA_TO_NR , PLW_WB_TO_NR, PLW_S_TO_NR, &
+ PLW_WIN_TO_NR, PDQS_SN_RF, PDQS_SN_RD )
! ##########################################################################
!
!!**** *URBAN_SNOW_EVOL*
@@ -66,6 +50,9 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TEB_n, ONLY : TEB_t
+USE MODD_BEM_n, ONLY : BEM_t
+!
USE MODD_SNOW_PAR, ONLY : XZ0SN, XZ0HSN, &
XANSMIN_ROOF, XANSMAX_ROOF, XANS_TODRY_ROOF, &
XANS_T_ROOF, XRHOSMIN_ROOF, XRHOSMAX_ROOF, &
@@ -89,39 +76,17 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(TEB_t), INTENT(INOUT) :: T
+TYPE(BEM_t), INTENT(INOUT) :: B
+!
+REAL, DIMENSION(:), INTENT(IN) :: PT_LWCN ! LWCN air temperature
+REAL, DIMENSION(:), INTENT(IN) :: PQ_LWCN ! LWCN air specific humidity
+REAL, DIMENSION(:), INTENT(IN) :: PU_LWCN ! LWCN hor. wind
+REAL, DIMENSION(:), INTENT(IN) :: PTS_RF ! roof surface temperature
+REAL, DIMENSION(:), INTENT(IN) :: PTS_RD ! road surface temperature
+REAL, DIMENSION(:), INTENT(IN) :: PTS_WL_A ! wall surface temperature
+REAL, DIMENSION(:), INTENT(IN) :: PTS_WL_B ! wall surface temperature
!
-REAL, DIMENSION(:), INTENT(IN) :: PT_LOWCAN ! LOWCAN air temperature
-REAL, DIMENSION(:), INTENT(IN) :: PQ_LOWCAN ! LOWCAN air specific humidity
-REAL, DIMENSION(:), INTENT(IN) :: PU_LOWCAN ! LOWCAN hor. wind
-REAL, DIMENSION(:), INTENT(IN) :: PTS_ROOF ! roof surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS_ROAD ! road surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS_WALL_A ! wall surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS_WALL_B ! wall surface temperature
-REAL, DIMENSION(:,:), INTENT(IN) :: PT_ROOF ! roof temperature profile
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_ROOF ! roof layer thickness
-REAL, DIMENSION(:,:), INTENT(IN) :: PTC_ROOF ! roof layer thermal conductivity
-REAL, DIMENSION(:,:), INTENT(IN) :: PHC_ROOF ! roof layer heat capacity
- CHARACTER(LEN=*), INTENT(IN) :: HSNOW_ROOF ! snow roof scheme
-! ! 'NONE'
-! ! 'D95 '
-! ! '1-L '
- CHARACTER(LEN=*), INTENT(IN) :: HSNOW_ROAD ! snow road scheme
-! ! 'NONE'
-! ! 'D95 '
-! ! '1-L '
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PWSNOW_ROOF ! snow layers reservoir
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTSNOW_ROOF ! snow layers temperature
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRSNOW_ROOF ! snow layers density
-REAL, DIMENSION(:), INTENT(INOUT) :: PASNOW_ROOF ! snow albedo
-REAL, DIMENSION(:), INTENT(INOUT) :: PESNOW_ROOF ! snow emissivity
-REAL, DIMENSION(:), INTENT(INOUT) :: PTSSNOW_ROOF! snow surface temperature
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PWSNOW_ROAD ! snow layers reservoir
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTSNOW_ROAD ! snow layers temperature
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRSNOW_ROAD ! snow layers density
-REAL, DIMENSION(:), INTENT(INOUT) :: PASNOW_ROAD ! snow albedo
-REAL, DIMENSION(:), INTENT(INOUT) :: PESNOW_ROAD ! snow emissivity
-REAL, DIMENSION(:), INTENT(INOUT) :: PTSSNOW_ROAD! snow surface temperature
-
REAL, DIMENSION(:), INTENT(IN) :: PPS ! pressure at the surface
REAL, DIMENSION(:), INTENT(IN) :: PTA ! temperature at the lowest level
REAL, DIMENSION(:), INTENT(IN) :: PQA ! specific humidity
@@ -136,46 +101,44 @@ REAL, DIMENSION(:), INTENT(IN) :: PUREF ! reference height of the first
! atmospheric level (wind)
! at first atmospheric level
REAL, INTENT(IN) :: PTSTEP ! time step
-REAL, DIMENSION(:), INTENT(IN) :: PZ_LOWCAN ! height of forcing
-!
-REAL, DIMENSION(:), INTENT(IN) :: PDN_ROOF ! snow-covered roof frac.
-REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_SNOW_ROOF ! SW absorbed by roof snow
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_LW_SNOW_ROOF ! absorbed IR rad by snow on roof
-REAL, DIMENSION(:), INTENT(INOUT) :: PDN_ROAD ! snow-covered road frac.
-REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_SNOW_ROAD ! SW absorbed by road snow
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_LW_SNOW_ROAD ! absorbed IR rad by snow on road
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PRNSNOW_ROOF ! net radiation over snow
-REAL, DIMENSION(:), INTENT(OUT) :: PHSNOW_ROOF ! sensible heat flux over snow
-REAL, DIMENSION(:), INTENT(OUT) :: PLESNOW_ROOF ! latent heat flux over snow
-REAL, DIMENSION(:), INTENT(OUT) :: PGSNOW_ROOF ! flux under the snow
-REAL, DIMENSION(:), INTENT(OUT) :: PMELT_ROOF ! snow melt
-REAL, DIMENSION(:), INTENT(OUT) :: PRNSNOW_ROAD ! net radiation over snow
-REAL, DIMENSION(:), INTENT(OUT) :: PHSNOW_ROAD ! sensible heat flux over snow
-REAL, DIMENSION(:), INTENT(OUT) :: PLESNOW_ROAD ! latent heat flux over snow
-REAL, DIMENSION(:), INTENT(OUT) :: PGSNOW_ROAD ! flux under the snow
-REAL, DIMENSION(:), INTENT(OUT) :: PMELT_ROAD ! snow melt
+REAL, DIMENSION(:), INTENT(IN) :: PZ_LWCN ! height of forcing
+!
+REAL, DIMENSION(:), INTENT(IN) :: PDN_RF ! snow-covered roof frac.
+REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_SN_RF ! SW absorbed by roof snow
+REAL, DIMENSION(:), INTENT(OUT) :: PABS_LW_SN_RF ! absorbed IR rad by snow on roof
+REAL, DIMENSION(:), INTENT(INOUT) :: PDN_RD ! snow-covered road frac.
+REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_SN_RD ! SW absorbed by road snow
+REAL, DIMENSION(:), INTENT(OUT) :: PABS_LW_SN_RD ! absorbed IR rad by snow on road
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PRNSN_RF ! net radiation over snow
+REAL, DIMENSION(:), INTENT(OUT) :: PHSN_RF ! sensible heat flux over snow
+REAL, DIMENSION(:), INTENT(OUT) :: PLESN_RF ! latent heat flux over snow
+REAL, DIMENSION(:), INTENT(OUT) :: PGSN_RF ! flux under the snow
+REAL, DIMENSION(:), INTENT(OUT) :: PMELT_RF ! snow melt
+REAL, DIMENSION(:), INTENT(OUT) :: PRNSN_RD ! net radiation over snow
+REAL, DIMENSION(:), INTENT(OUT) :: PHSN_RD ! sensible heat flux over snow
+REAL, DIMENSION(:), INTENT(OUT) :: PLESN_RD ! latent heat flux over snow
+REAL, DIMENSION(:), INTENT(OUT) :: PGSN_RD ! flux under the snow
+REAL, DIMENSION(:), INTENT(OUT) :: PMELT_RD ! snow melt
!
REAL, DIMENSION(:), INTENT(IN) :: PLW_WA_TO_NR ! LW contrib. wall -> road(snow)
REAL, DIMENSION(:), INTENT(IN) :: PLW_WB_TO_NR ! LW contrib. wall -> road(snow)
REAL, DIMENSION(:), INTENT(IN) :: PLW_S_TO_NR ! LW contrib. sky -> road(snow)
REAL, DIMENSION(:), INTENT(IN) :: PLW_WIN_TO_NR ! LW contrib. win -> road(snow)
-REAL, DIMENSION(:), INTENT(OUT) :: PDQS_SNOW_ROOF ! Heat storage in snowpack on roofs
-REAL, DIMENSION(:), INTENT(OUT) :: PDQS_SNOW_ROAD ! Heat storage in snowpack on roads
-REAL, DIMENSION(:), INTENT(IN) :: PT_WIN1 ! Window surface temperature
+REAL, DIMENSION(:), INTENT(OUT) :: PDQS_SN_RF ! Heat storage in snowpack on roofs
+REAL, DIMENSION(:), INTENT(OUT) :: PDQS_SN_RD ! Heat storage in snowpack on roads
!
!* 0.2 declarations of local variables
!
+REAL, DIMENSION(SIZE(PTA)) :: ZLW1_RD ! independant from
+REAL, DIMENSION(SIZE(PTA)) :: ZLW1_RF ! surface temperature
!
-REAL, DIMENSION(SIZE(PTA)) :: ZLW1_ROAD ! independant from
-REAL, DIMENSION(SIZE(PTA)) :: ZLW1_ROOF ! surface temperature
-!
-REAL, DIMENSION(SIZE(PTA)) :: ZLW2_ROAD ! to be multiplied by
-REAL, DIMENSION(SIZE(PTA)) :: ZLW2_ROOF ! 4th power of
+REAL, DIMENSION(SIZE(PTA)) :: ZLW2_RD ! to be multiplied by
+REAL, DIMENSION(SIZE(PTA)) :: ZLW2_RF ! 4th power of
! ! surface temperature
-REAL, DIMENSION(SIZE(PTA)) :: ZSR_ROOF ! snow fall on roof snow (kg/s/m2 of snow)
-REAL, DIMENSION(SIZE(PTA)) :: ZSR_ROAD ! snow fall on road snow (kg/s/m2 of snow)
+REAL, DIMENSION(SIZE(PTA)) :: ZSR_RF ! snow fall on roof snow (kg/s/m2 of snow)
+REAL, DIMENSION(SIZE(PTA)) :: ZSR_RD ! snow fall on road snow (kg/s/m2 of snow)
!
REAL, DIMENSION(SIZE(PTA)) :: ZT_SKY ! sky temperature
REAL, DIMENSION(SIZE(PTA)) :: ZTS_COEFA ! Coefficient A for implicit coupling
@@ -185,7 +148,7 @@ REAL, DIMENSION(SIZE(PTA)) :: ZTS_COEFB ! Coefficient B for implicit coupling
!
! flags to call to snow routines
!
-LOGICAL :: GSNOW_ROOF, GSNOW_ROAD
+LOGICAL :: GSN_RF, GSN_RD
!
! loop counters
!
@@ -195,23 +158,23 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('URBAN_SNOW_EVOL',0,ZHOOK_HANDLE)
-PRNSNOW_ROOF(:)=0.
-PHSNOW_ROOF (:)=0.
-PLESNOW_ROOF(:)=0.
-PGSNOW_ROOF (:)=0.
-PMELT_ROOF (:)=0.
-PRNSNOW_ROAD(:)=0.
-PHSNOW_ROAD (:)=0.
-PLESNOW_ROAD(:)=0.
-PGSNOW_ROAD (:)=0.
-PMELT_ROAD (:)=0.
-PABS_LW_SNOW_ROOF(:)=0.
-PABS_LW_SNOW_ROAD(:)=0.
+PRNSN_RF(:)=0.
+PHSN_RF (:)=0.
+PLESN_RF(:)=0.
+PGSN_RF (:)=0.
+PMELT_RF(:)=0.
+PRNSN_RD(:)=0.
+PHSN_RD (:)=0.
+PLESN_RD(:)=0.
+PGSN_RD (:)=0.
+PMELT_RD(:)=0.
+PABS_LW_SN_RF(:)=0.
+PABS_LW_SN_RD(:)=0.
!
!-------------------------------------------------------------------------------
!
-GSNOW_ROOF = ANY( PSR(:)>0. .OR. PWSNOW_ROOF(:,1)>0. )
-GSNOW_ROAD = ANY( PSR(:)>0. .OR. PWSNOW_ROAD(:,1)>0. )
+GSN_RF = ANY( PSR(:)>0. .OR. T%TSNOW_ROOF%WSNOW(:,1)>0. )
+GSN_RD = ANY( PSR(:)>0. .OR. T%TSNOW_ROAD%WSNOW(:,1)>0. )
!
!-------------------------------------------------------------------------------
!
@@ -221,50 +184,45 @@ GSNOW_ROAD = ANY( PSR(:)>0. .OR. PWSNOW_ROAD(:,1)>0. )
!* 5.1 roofs
! -----
!
-IF ( GSNOW_ROOF ) THEN
+IF ( GSN_RF ) THEN
!
!* initializes LW radiative coefficients
!
- ZLW1_ROOF(:) = PESNOW_ROOF(:) * PLW_RAD(:)
- ZLW2_ROOF(:) = - PESNOW_ROOF(:) * XSTEFAN
+ ZLW1_RF(:) = T%TSNOW_ROOF%EMIS(:) * PLW_RAD(:)
+ ZLW2_RF(:) = - T%TSNOW_ROOF%EMIS(:) * XSTEFAN
!
!* The global amount of snow on roofs is supposed located on a
! fraction of the roof surface. All computations are then
! done only for each m2 of snow, and not for each m2 of roof.
!
- DO JL=1,SIZE(PWSNOW_ROOF,2)
- WHERE (PDN_ROOF(:)>0.) PWSNOW_ROOF(:,JL) = PWSNOW_ROOF(:,JL) / PDN_ROOF(:)
+ DO JL=1,SIZE(T%TSNOW_ROOF%WSNOW,2)
+ WHERE (PDN_RF(:)>0.) T%TSNOW_ROOF%WSNOW(:,JL) = T%TSNOW_ROOF%WSNOW(:,JL) / PDN_RF(:)
END DO
- ZSR_ROOF=0.
- WHERE (PDN_ROOF(:)>0.) ZSR_ROOF (:) = PSR (:) / PDN_ROOF(:)
+ ZSR_RF=0.
+ WHERE (PDN_RF(:)>0.) ZSR_RF (:) = PSR (:) / PDN_RF(:)
!
!* Estimates implicit coupling between snow and roof
! (strictly equal to an implicit formulation for 100% snow coverage)
!
- CALL ROOF_IMPL_COEF(PTSTEP, SIZE(PT_ROOF,2), PD_ROOF, PTC_ROOF, PHC_ROOF, PT_ROOF, ZTS_COEFA,ZTS_COEFB)
+ CALL ROOF_IMPL_COEF(T, PTSTEP, ZTS_COEFA, ZTS_COEFB)
!
!* call to snow mantel scheme
!
- IF (HSNOW_ROOF=='1-L') &
- CALL SNOW_COVER_1LAYER(PTSTEP, XANSMIN_ROOF, XANSMAX_ROOF, XANS_TODRY_ROOF, &
- XRHOSMIN_ROOF, XRHOSMAX_ROOF, XANS_T_ROOF, .TRUE., &
- 0., XWCRN_ROOF, &
- XZ0SN,XZ0HSN, &
- PTSNOW_ROOF(:,1), PASNOW_ROOF, &
- PRSNOW_ROOF(:,1), PWSNOW_ROOF(:,1), PTSSNOW_ROOF, &
- PESNOW_ROOF, &
- PTS_ROOF, ZTS_COEFA, ZTS_COEFB, PABS_SW_SNOW_ROOF, &
- ZLW1_ROOF, ZLW2_ROOF, &
- PTA, PQA, PVMOD, PPS, PRHOA, ZSR_ROOF, PZREF, PUREF, &
- PRNSNOW_ROOF, PHSNOW_ROOF, PLESNOW_ROOF, PGSNOW_ROOF,&
- PMELT_ROOF, PDQS_SNOW_ROOF, PABS_LW_SNOW_ROOF )
+ IF (T%TSNOW_ROOF%SCHEME=='1-L') &
+ CALL SNOW_COVER_1LAYER(PTSTEP, XANSMIN_ROOF, XANSMAX_ROOF, XANS_TODRY_ROOF, &
+ XRHOSMIN_ROOF, XRHOSMAX_ROOF, XANS_T_ROOF, .TRUE., 0., &
+ XWCRN_ROOF, XZ0SN, XZ0HSN, T%TSNOW_ROOF, PTS_RF, &
+ ZTS_COEFA, ZTS_COEFB, PABS_SW_SN_RF, ZLW1_RF, ZLW2_RF,&
+ PTA, PQA, PVMOD, PPS, PRHOA, ZSR_RF, PZREF, PUREF, &
+ PRNSN_RF, PHSN_RF, PLESN_RF, PGSN_RF, PMELT_RF, &
+ PDQS_SN_RF, PABS_LW_SN_RF)
!
!
!* The global amount of snow on roofs is reported to total roof surface.
!
- DO JL=1,SIZE(PWSNOW_ROOF,2)
- PWSNOW_ROOF(:,JL) = PWSNOW_ROOF(:,JL) * PDN_ROOF(:)
+ DO JL=1,SIZE(T%TSNOW_ROOF%WSNOW,2)
+ T%TSNOW_ROOF%WSNOW(:,JL) = T%TSNOW_ROOF%WSNOW(:,JL) * PDN_RF(:)
END DO
!
END IF
@@ -272,55 +230,49 @@ END IF
!* 5.2 roads
! -----
!
-IF ( GSNOW_ROAD ) THEN
+IF ( GSN_RD ) THEN
!
ZT_SKY(:) = (PLW_RAD(:)/XSTEFAN)**0.25
!
- ZLW1_ROAD(:) = PLW_S_TO_NR (:) * (ZT_SKY (:) - PTSSNOW_ROAD(:)) &
- + PLW_WA_TO_NR (:) * (PTS_WALL_A(:) - PTSSNOW_ROAD(:)) &
- + PLW_WB_TO_NR (:) * (PTS_WALL_B(:) - PTSSNOW_ROAD(:)) &
- + PLW_WIN_TO_NR(:) * (PT_WIN1 (:) - PTSSNOW_ROAD(:))
- ZLW2_ROAD(:) = 0.0
+ ZLW1_RD(:) = PLW_S_TO_NR (:) * (ZT_SKY (:) - T%TSNOW_ROAD%TS(:)) &
+ + PLW_WA_TO_NR (:) * (PTS_WL_A (:) - T%TSNOW_ROAD%TS(:)) &
+ + PLW_WB_TO_NR (:) * (PTS_WL_B (:) - T%TSNOW_ROAD%TS(:)) &
+ + PLW_WIN_TO_NR(:) * (B%XT_WIN1(:) - T%TSNOW_ROAD%TS(:))
+ ZLW2_RD(:) = 0.0
!
!* The global amount of snow on roads is supposed located on a
! fraction of the road surface. All computations are then
! done only for each m2 of snow, and not for each m2 of road.
!
- DO JL=1,SIZE(PWSNOW_ROAD,2)
- WHERE (PDN_ROAD(:)>0.) PWSNOW_ROAD(:,JL) = PWSNOW_ROAD(:,JL) / PDN_ROAD(:)
+ DO JL=1,SIZE(T%TSNOW_ROAD%WSNOW,2)
+ WHERE (PDN_RD(:)>0.) T%TSNOW_ROAD%WSNOW(:,JL) = T%TSNOW_ROAD%WSNOW(:,JL) / PDN_RD(:)
END DO
- ZSR_ROAD=0.
- WHERE (PDN_ROAD(:)>0.) ZSR_ROAD (:) = PSR (:) / PDN_ROAD(:)
+ ZSR_RD=0.
+ WHERE (PDN_RD(:)>0.) ZSR_RD (:) = PSR (:) / PDN_RD(:)
!
!* no implicit coupling necessary with road
!
ZTS_COEFA = 0.
- ZTS_COEFB = PTS_ROAD
+ ZTS_COEFB = PTS_RD
!
!* call to snow mantel scheme
!
- IF (HSNOW_ROAD=='1-L') &
- CALL SNOW_COVER_1LAYER(PTSTEP, XANSMIN_ROAD, XANSMAX_ROAD, XANS_TODRY_ROAD, &
- XRHOSMIN_ROAD, XRHOSMAX_ROAD, XANS_T_ROAD, .FALSE., &
- 0., XWCRN_ROAD, &
- XZ0SN,XZ0HSN, &
- PTSNOW_ROAD(:,1), PASNOW_ROAD, &
- PRSNOW_ROAD(:,1), PWSNOW_ROAD(:,1), PTSSNOW_ROAD, &
- PESNOW_ROAD, &
- PTS_ROAD, ZTS_COEFA, ZTS_COEFB, &
- PABS_SW_SNOW_ROAD, ZLW1_ROAD, ZLW2_ROAD, &
- PT_LOWCAN, PQ_LOWCAN, PU_LOWCAN, PPS, PRHOA, &
- ZSR_ROAD, PZ_LOWCAN, PZ_LOWCAN, &
- PRNSNOW_ROAD, PHSNOW_ROAD, PLESNOW_ROAD, PGSNOW_ROAD,&
- PMELT_ROAD, PDQS_SNOW_ROAD ,PABS_LW_SNOW_ROAD )
+ IF (T%TSNOW_ROAD%SCHEME=='1-L') &
+ CALL SNOW_COVER_1LAYER(PTSTEP, XANSMIN_ROAD, XANSMAX_ROAD, XANS_TODRY_ROAD, &
+ XRHOSMIN_ROAD, XRHOSMAX_ROAD, XANS_T_ROAD, .FALSE., &
+ 0., XWCRN_ROAD, XZ0SN, XZ0HSN, T%TSNOW_ROAD, PTS_RD, &
+ ZTS_COEFA, ZTS_COEFB, PABS_SW_SN_RD, ZLW1_RD, ZLW2_RD,&
+ PT_LWCN, PQ_LWCN, PU_LWCN, PPS, PRHOA, ZSR_RD, PZ_LWCN,&
+ PZ_LWCN, PRNSN_RD, PHSN_RD, PLESN_RD, PGSN_RD, &
+ PMELT_RD, PDQS_SN_RD, PABS_LW_SN_RD )
!
!* The global amount of snow on roads is reported to total road surface.
!
- DO JL=1,SIZE(PWSNOW_ROAD,2)
- PWSNOW_ROAD(:,JL) = PWSNOW_ROAD(:,JL) * PDN_ROAD(:)
+ DO JL=1,SIZE(T%TSNOW_ROAD%WSNOW,2)
+ T%TSNOW_ROAD%WSNOW(:,JL) = T%TSNOW_ROAD%WSNOW(:,JL) * PDN_RD(:)
END DO
!
- WHERE (PTSNOW_ROAD(:,1) .EQ. XUNDEF) PDN_ROAD(:) = 0.0
+ WHERE (T%TSNOW_ROAD%T(:,1) .EQ. XUNDEF) PDN_RD(:) = 0.0
!
END IF
IF (LHOOK) CALL DR_HOOK('URBAN_SNOW_EVOL',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/urban_solar_abs.F90 b/src/SURFEX/urban_solar_abs.F90
index d6281018f4560b054690c101455041f1f6158d91..74689fa30708a0ad74b68cde2dc1038d97a41890 100644
--- a/src/SURFEX/urban_solar_abs.F90
+++ b/src/SURFEX/urban_solar_abs.F90
@@ -3,32 +3,13 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE URBAN_SOLAR_ABS(HBEM, HROAD_DIR, HWALL_OPT, &
- PDIR_SW, PSCA_SW, PZENITH, PAZIM, &
- PBLD, PGARDEN, PROAD_DIR, PROAD, PFRAC_GR, &
- PWALL_O_HOR, PCAN_HW_RATIO, &
- PALB_ROOF, &
- PALB_ROAD, PSVF_ROAD, PALB_WALL, PSVF_WALL, &
- PFRAC_PANEL, PALB_PANEL, &
- PALB_GARDEN, PSVF_GARDEN, &
- PALB_GREENROOF, &
- PASNOW_ROOF, PASNOW_ROAD, &
- PDN_ROOF, PDF_ROOF, PDN_ROAD, PDF_ROAD, &
- PGR, PABS_WIN, PSHGC, PSHGC_SH, PALB_WIN, &
- PABS_SW_ROOF, PABS_SW_ROAD, &
- PABS_SW_WALL_A, PABS_SW_WALL_B, &
- PABS_SW_GARDEN, PABS_SW_GREENROOF, &
- PABS_SW_SNOW_ROOF, PABS_SW_SNOW_ROAD, &
- PABS_SW_SOLAR_PANEL, &
- PREC_SW_ROAD, PREC_SW_SNOW_ROAD, &
- PREC_SW_WALL_A, PREC_SW_WALL_B, &
- PREC_SW_GARDEN, PREC_SW_ROOF, &
- PDIR_ALB_TOWN, PSCA_ALB_TOWN, &
- PSW_RAD_GARDEN, PABS_SW_WIN, PREC_SW_WIN, &
- PTRAN_WIN, &
- PREF_SW_GRND, PREF_SW_FAC, PTR_SW_WIN, &
- PE_SHADING, OSHAD_DAY, &
- OSHADE )
+ SUBROUTINE URBAN_SOLAR_ABS(TOP, T, B, DMT, PDIR_SW, PSCA_SW, PZENITH, PAZIM, &
+ PFRAC_PANEL, PALB_PANEL, PALB_GD, PSVF_GD, PALB_GRF, &
+ PDN_RF, PDF_RF, PDN_RD, PDF_RD, PREC_SW_RD, &
+ PREC_SW_SN_RD, PREC_SW_WL_A, PREC_SW_WL_B, &
+ PREC_SW_GD, PREC_SW_RF, PDIR_ALB_TWN, PSCA_ALB_TWN, &
+ PSW_RAD_GD, PREC_SW_WIN, PREF_SW_GRND, PREF_SW_FAC, &
+ PE_SHADING, OSHAD_DAY, OSHADE, OALB_ONLY )
! ##########################################################################
!
!!**** *URBAN_SOLAR_ABS*
@@ -188,13 +169,18 @@
!! 12/02 (A. Lemonsu) bug in diagnostic of albedo
!! 12/11 (V. Masson ) adds road direction option
!! 01/12 (V. Masson ) adds 2 different wall direct insulations
-!! 04/12 (G. Pigeon) add PTRAN_WIN
+!! 04/12 (G. Pigeon) add B%XTRAN_WIN
!! 09/12 (C. de Munck-A. Lemonsu) add green roofs
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
+USE MODD_TEB_n, ONLY : TEB_t
+USE MODD_BEM_n, ONLY : BEM_t
+USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_t
+!
USE MODD_CSTS, ONLY : XPI
USE MODD_BEM_CST, ONLY : XWIN_SW_MAX
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -209,91 +195,48 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
- CHARACTER(LEN=3) , INTENT(IN) :: HBEM ! Building Energy model 'DEF' or 'BEM'
- CHARACTER(LEN=4), INTENT(IN) :: HROAD_DIR ! road direction option
- ! 'UNIF' : classical TEB version, all roads uniformely present
- ! 'ORIE' : specified road ORIENTATION (in fact many roads direction
- ! possible because there can be many TEB patches)
- CHARACTER(LEN=4), INTENT(IN) :: HWALL_OPT ! walls option
+TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
! 'UNIF' : classical TEB version, all walls are identical
! 'TWO ' : the two opposite walls are different & receive different solar energy
+TYPE(TEB_t), INTENT(INOUT) :: T
+TYPE(BEM_t), INTENT(INOUT) :: B
+TYPE(DIAG_MISC_TEB_t), INTENT(INOUT) :: DMT
+!
REAL, DIMENSION(:), INTENT(IN) :: PDIR_SW ! incoming direct solar radiation
REAL, DIMENSION(:), INTENT(IN) :: PSCA_SW ! scattered incoming solar rad.
REAL, DIMENSION(:), INTENT(IN) :: PZENITH ! solar zenithal angle
REAL, DIMENSION(:), INTENT(IN) :: PAZIM ! solar azimuthal angle
! ! (radian from N, clockwise)
-REAL, DIMENSION(:), INTENT(IN) :: PBLD ! buildings fraction
-REAL, DIMENSION(:), INTENT(IN) :: PGARDEN ! GARDEN area fraction
-REAL, DIMENSION(:), INTENT(IN) :: PROAD_DIR ! Road direction
- ! (deg from N, clockwise)
-REAL, DIMENSION(:), INTENT(IN) :: PROAD ! road fraction
-REAL, DIMENSION(:), INTENT(IN) :: PFRAC_GR ! green roof fraction
-REAL, DIMENSION(:), INTENT(IN) :: PWALL_O_HOR ! wall surf. / hor. surf
-REAL, DIMENSION(:), INTENT(IN) :: PCAN_HW_RATIO ! canyon h/W
-REAL, DIMENSION(:), INTENT(IN) :: PALB_ROOF ! roof albedo
-REAL, DIMENSION(:), INTENT(IN) :: PALB_ROAD ! road albedo
-REAL, DIMENSION(:), INTENT(IN) :: PSVF_ROAD ! road sky view factor
-REAL, DIMENSION(:), INTENT(IN) :: PALB_WALL ! wall albedo
-REAL, DIMENSION(:), INTENT(IN) :: PSVF_WALL ! wall sky view factor
REAL, DIMENSION(:), INTENT(IN) :: PFRAC_PANEL ! Fraction of solar panel on roofs (-)
REAL, DIMENSION(:), INTENT(IN) :: PALB_PANEL ! Albedo of solar panels (-)
-REAL, DIMENSION(:), INTENT(IN) :: PALB_GARDEN ! GARDEN areas albedo
-REAL, DIMENSION(:), INTENT(IN) :: PSVF_GARDEN ! GARDEN areas sky view factor
-REAL, DIMENSION(:), INTENT(IN) :: PALB_GREENROOF ! green roof albedo
-REAL, DIMENSION(:), INTENT(IN) :: PASNOW_ROOF ! roof snow albedo
-REAL, DIMENSION(:), INTENT(IN) :: PASNOW_ROAD ! road snow albedo
-REAL, DIMENSION(:), INTENT(IN) :: PDN_ROOF ! snow-covered roof fraction
-REAL, DIMENSION(:), INTENT(IN) :: PDF_ROOF ! snow-free roof fraction
-REAL, DIMENSION(:), INTENT(IN) :: PDN_ROAD ! snow-covered road fraction
-REAL, DIMENSION(:), INTENT(IN) :: PDF_ROAD ! snow-free road fraction
-!
-REAL, DIMENSION(:), INTENT(IN) :: PGR ! glazing ratio
-REAL, DIMENSION(:), INTENT(IN) :: PABS_WIN ! solar absortance of windows
+REAL, DIMENSION(:), INTENT(IN) :: PALB_GD ! GD areas albedo
+REAL, DIMENSION(:), INTENT(IN) :: PSVF_GD ! GD areas sky view factor
+REAL, DIMENSION(:), INTENT(IN) :: PALB_GRF ! green roof albedo
+REAL, DIMENSION(:), INTENT(IN) :: PDN_RF ! snow-covered roof fraction
+REAL, DIMENSION(:), INTENT(IN) :: PDF_RF ! snow-free roof fraction
+REAL, DIMENSION(:), INTENT(IN) :: PDN_RD ! snow-covered road fraction
+REAL, DIMENSION(:), INTENT(IN) :: PDF_RD ! snow-free road fraction
!
!new arguments for shading
-REAL, DIMENSION(:), INTENT(IN) :: PSHGC ! solar transmittance of windows
-REAL, DIMENSION(:), INTENT(IN) :: PSHGC_SH ! window + shading solar heat gain coef.
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PALB_WIN ! solar reflectance of windows
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_SW_ROOF ! solar radiation absorbed
-! ! by snow-free roofs
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_SW_ROAD ! solar radiation absorbed
-! ! by snow-free roads
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_SW_WALL_A ! solar radiation absorbed
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_SW_WALL_B ! solar radiation absorbed
-! ! by walls
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_SW_GARDEN ! solar radiation absorbed
-! ! by GARDEN areas
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_SW_GREENROOF! solar radiation absorbed by green roofs
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_SW_SNOW_ROOF! solar radiation absorbed
-! ! by snow-covered roofs
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_SW_SNOW_ROAD! solar radiation absorbed
-! ! by snow-covered roads
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_SW_SOLAR_PANEL! solar radiation absorbed
-! ! by solar panels
-REAL, DIMENSION(:), INTENT(OUT) :: PREC_SW_ROAD ! solar radiation received
+REAL, DIMENSION(:), INTENT(OUT) :: PREC_SW_RD ! solar radiation received
! ! by snow-free roads
-REAL, DIMENSION(:), INTENT(OUT) :: PREC_SW_WALL_A ! solar radiation received
-REAL, DIMENSION(:), INTENT(OUT) :: PREC_SW_WALL_B ! solar radiation received
-! ! by snow-free walls
-REAL, DIMENSION(:), INTENT(OUT) :: PREC_SW_GARDEN ! solar radiation received
-! ! by GARDEN areas
-REAL, DIMENSION(:), INTENT(OUT) :: PREC_SW_ROOF ! solar radiation received
-! ! by ROOF areas (below solar panels if any)
-REAL, DIMENSION(:), INTENT(OUT) :: PREC_SW_SNOW_ROAD! solar radiation received
-! ! by snow-covered roads
-REAL, DIMENSION(:), INTENT(OUT) :: PDIR_ALB_TOWN ! town direct albedo
-REAL, DIMENSION(:), INTENT(OUT) :: PSCA_ALB_TOWN ! town diffuse albedo
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PSW_RAD_GARDEN ! solar radiation reaching GARDEN areas
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_SW_WIN ! solar radiation absorbed by windows
+REAL, DIMENSION(:), INTENT(OUT) :: PREC_SW_WL_A ! solar radiation received
+REAL, DIMENSION(:), INTENT(OUT) :: PREC_SW_WL_B ! solar radiation received
+! ! by snow-free walls
+REAL, DIMENSION(:), INTENT(OUT) :: PREC_SW_GD ! solar radiation received
+! ! by GD areas
+REAL, DIMENSION(:), INTENT(OUT) :: PREC_SW_RF ! solar radiation received
+! ! by RF areas (below solar panels if any)
+REAL, DIMENSION(:), INTENT(OUT) :: PREC_SW_SN_RD ! solar radiation received
+! ! by snow-covered roads
+REAL, DIMENSION(:), INTENT(OUT) :: PDIR_ALB_TWN ! town direct albedo
+REAL, DIMENSION(:), INTENT(OUT) :: PSCA_ALB_TWN ! town diffuse albedo
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PSW_RAD_GD ! solar radiation reaching GD areas
REAL, DIMENSION(:), INTENT(OUT) :: PREC_SW_WIN ! solar radiation received by windows
REAL, DIMENSION(:), INTENT(OUT) :: PREF_SW_GRND ! total solar radiation reflected by ground
REAL, DIMENSION(:), INTENT(OUT) :: PREF_SW_FAC ! total solar radiation reflected by wall
-REAL, DIMENSION(:), INTENT(OUT) :: PTR_SW_WIN ! Solar radiation transmitted
- ! through glazing [W/m2(bld)]
!new arguments for shading
REAL, DIMENSION(:), INTENT(OUT) :: PE_SHADING ! Energy that is not reflected
! by the shading, nor transmitted through
@@ -302,7 +245,8 @@ REAL, DIMENSION(:), INTENT(OUT) :: PE_SHADING ! Energy that is not refl
LOGICAL, DIMENSION(:),INTENT(INOUT):: OSHAD_DAY ! has shading been necessary this day ?
LOGICAL, DIMENSION(:),INTENT(IN) :: OSHADE ! are building conditions favorable for
! ! shading (independantly of solar irradiance) ?
-REAL, DIMENSION(:), INTENT(IN) :: PTRAN_WIN ! window transmittivity
+!
+LOGICAL, INTENT(IN), OPTIONAL :: OALB_ONLY
!
!* 0.2 declarations of local variables
!
@@ -315,88 +259,75 @@ REAL, DIMENSION(SIZE(PDIR_SW)) :: ZTHETA0 ! canyon angle for
! ! radiation
! ! reaches the road
!
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZAALB_ROAD ! averaged albedo
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZDIR_SW_ROAD ! direct radiation reaching
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZDIR_SW_WALL_A ! road, wall A,
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZDIR_SW_WALL_B ! wall B,
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZDIR_SW_GARDEN ! GARDEN areas,
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZDIR_SW_WALL ! and on average on 2 walls
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZSCA_SW_ROAD ! diffuse radiation reaching
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZSCA_SW_WALL ! road, wall,
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZSCA_SW_GARDEN ! and GARDEN areas
-!
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_ROOF ! solar radiation
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_ROAD ! absorbed by roofs,
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_WALL_A ! road, wall A,
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_WALL_B ! wall B,
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_WALL ! both walls on average,
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_GARDEN ! GARDEN areas,
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_GREENROOF ! green roof areas,
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZAALB_RD ! averaged albedo
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZDIR_SW_RD ! direct radiation reaching
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZDIR_SW_WL_A ! road, wall A,
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZDIR_SW_WL_B ! wall B,
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZDIR_SW_GD ! GD areas,
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZDIR_SW_WL ! and on average on 2 walls
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZSCA_SW_RD ! diffuse radiation reaching
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZSCA_SW_WL ! road, wall,
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZSCA_SW_GD ! and GD areas
+!
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_RF ! solar radiation
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_RD ! absorbed by roofs,
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_WL_A ! road, wall A,
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_WL_B ! wall B,
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_WL ! both walls on average,
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_GD ! GD areas,
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_GRF ! green roof areas,
REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_PANEL ! solar panels,
REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_WIN ! window (abs+trans), and snow
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_SNOW_ROOF ! over roof, wall,
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_SNOW_ROAD ! and GARDEN areas
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_ROOF ! solar radiation
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_ROAD ! absorbed by roofs,
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_WALL ! road, wall,
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_GARDEN ! GARDEN areas,
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_GREENROOF ! green roof areas,
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_SN_RF ! over roof, wall,
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_SN_RD ! and GD areas
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_RF ! solar radiation
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_RD ! absorbed by roofs,
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_WL ! road, wall,
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_GD ! GD areas,
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_GRF ! green roof areas,
REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_PANEL ! solar panels,
REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_WIN ! window (abs+trans), and snow
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_SNOW_ROOF ! over roof and wall,
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_SNOW_ROAD ! coming from diffuse rad.
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_SN_RF ! over roof and wall,
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_SN_RD ! coming from diffuse rad.
REAL, DIMENSION(SIZE(PDIR_SW)) :: ZDW ! difference of radiation
! ! absorbed by the 2 walls
!
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZROAD !
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZROAD_DIR ! Road direction
-! ! (radian from N, clockwise)
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZGARDEN !
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZRD !
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZRD_DIR ! Road direction
+! ! (radian from N, clockwise)
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZGD !
!
REAL, DIMENSION(SIZE(PDIR_SW)) :: ZREC_DIR_SW_WIN
REAL, DIMENSION(SIZE(PDIR_SW)) :: ZREC_SCA_SW_WIN
-REAL, DIMENSION(SIZE(PDIR_SW)) :: ZAALB_WALL
+REAL, DIMENSION(SIZE(PDIR_SW)) :: ZAALB_WL
!
REAL, DIMENSION(SIZE(PDIR_SW)) :: ZTRAN_WIN ! solar transmittivity of windows
REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_WIN ! solar transmittivity of windows
LOGICAL, DIMENSION(SIZE(PDIR_SW)) :: G_EFF_SHAD !TRUE if shading should be active considering actual rad
!
+LOGICAL :: GALB_ONLY
INTEGER :: JJ ! loop index
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('URBAN_SOLAR_ABS',0,ZHOOK_HANDLE)
-PABS_SW_ROOF (:) = 0.
-PABS_SW_ROAD (:) = 0.
-PABS_SW_WALL_A (:) = 0.
-PABS_SW_WALL_B (:) = 0.
-PABS_SW_GARDEN (:) = 0.
-PABS_SW_GREENROOF (:) = 0.
-PABS_SW_SNOW_ROOF (:) = 0.
-PABS_SW_SNOW_ROAD (:) = 0.
-PABS_SW_WIN (:) = 0.
-PREC_SW_WIN (:) = 0.
-!
-PREC_SW_ROAD (:) = 0.
-PREC_SW_WALL_A (:) = 0.
-PREC_SW_WALL_B (:) = 0.
-PREC_SW_GARDEN (:) = 0.
-PREC_SW_SNOW_ROAD (:) = 0.
-PREC_SW_ROOF (:) = 0.
+!
+GALB_ONLY = .FALSE.
+IF (PRESENT(OALB_ONLY)) GALB_ONLY = OALB_ONLY
!
ZDIR_SW = MAX(PDIR_SW,0.)
ZSCA_SW = MAX(PSCA_SW,0.000001)
!
-ZROAD_DIR = PROAD_DIR(:) * XPI/180.
+ZRD_DIR = T%XROAD_DIR(:) * XPI/180.
!
-DO JJ=1,SIZE(PROAD)
+DO JJ=1,SIZE(T%XROAD)
!
- IF (PROAD(JJ)+PGARDEN(JJ).NE.0.) THEN
- ZROAD(JJ) = PROAD(JJ) / (PROAD(JJ)+PGARDEN(JJ))
- ZGARDEN(JJ) = PGARDEN(JJ) / (PROAD(JJ)+PGARDEN(JJ))
+ IF (T%XROAD(JJ)+T%XGARDEN(JJ).NE.0.) THEN
+ ZRD(JJ) = T%XROAD(JJ) / (T%XROAD(JJ)+T%XGARDEN(JJ))
+ ZGD(JJ) = T%XGARDEN(JJ) / (T%XROAD(JJ)+T%XGARDEN(JJ))
ELSE
- ZROAD(JJ)=0.
- ZGARDEN(JJ)=0.
+ ZRD(JJ)=0.
+ ZGD(JJ)=0.
ENDIF
!
!-------------------------------------------------------------------------------
@@ -410,12 +341,12 @@ DO JJ=1,SIZE(PROAD)
ZABS_SCA_SW_PANEL (JJ) = ZSCA_SW(JJ) * (1. - PALB_PANEL (JJ))
!
!* solar energy received by the surfaces below solar panels
- ZABS_DIR_SW_ROOF (JJ) = ZDIR_SW(JJ) * (1. - PALB_ROOF (JJ)) * (1.-PFRAC_PANEL(JJ))
- ZABS_DIR_SW_SNOW_ROOF(JJ) = ZDIR_SW(JJ) * (1. - PASNOW_ROOF (JJ)) * (1.-PFRAC_PANEL(JJ))
- ZABS_DIR_SW_GREENROOF(JJ) = ZDIR_SW(JJ) * (1. - PALB_GREENROOF(JJ)) * (1.-PFRAC_PANEL(JJ))
- ZABS_SCA_SW_ROOF (JJ) = ZSCA_SW(JJ) * (1. - PALB_ROOF (JJ)) * (1.-PFRAC_PANEL(JJ))
- ZABS_SCA_SW_SNOW_ROOF(JJ) = ZSCA_SW(JJ) * (1. - PASNOW_ROOF (JJ)) * (1.-PFRAC_PANEL(JJ))
- ZABS_SCA_SW_GREENROOF(JJ) = ZSCA_SW(JJ) * (1. - PALB_GREENROOF(JJ)) * (1.-PFRAC_PANEL(JJ))
+ ZABS_DIR_SW_RF (JJ) = ZDIR_SW(JJ) * (1. - T%XALB_ROOF (JJ)) * (1.-PFRAC_PANEL(JJ))
+ ZABS_DIR_SW_SN_RF(JJ) = ZDIR_SW(JJ) * (1. - T%TSNOW_ROOF%ALB(JJ)) * (1.-PFRAC_PANEL(JJ))
+ ZABS_DIR_SW_GRF (JJ) = ZDIR_SW(JJ) * (1. - PALB_GRF (JJ)) * (1.-PFRAC_PANEL(JJ))
+ ZABS_SCA_SW_RF (JJ) = ZSCA_SW(JJ) * (1. - T%XALB_ROOF (JJ)) * (1.-PFRAC_PANEL(JJ))
+ ZABS_SCA_SW_SN_RF(JJ) = ZSCA_SW(JJ) * (1. - T%TSNOW_ROOF%ALB(JJ)) * (1.-PFRAC_PANEL(JJ))
+ ZABS_SCA_SW_GRF (JJ) = ZSCA_SW(JJ) * (1. - PALB_GRF (JJ)) * (1.-PFRAC_PANEL(JJ))
!
!-------------------------------------------------------------------------------
!
@@ -432,51 +363,50 @@ DO JJ=1,SIZE(PROAD)
ENDIF
!
!
- IF (PBLD(JJ) .GT. 0.) THEN
+ IF (T%XBLD(JJ) .GT. 0.) THEN
!
!* 2.1 radiation coefficients
! ----------------------
!
-IF (HROAD_DIR=='UNIF') THEN
- ZTHETA0(JJ) = ASIN( MIN(ABS( 1./ZTANZEN(JJ))/PCAN_HW_RATIO(JJ), 1. ) )
+IF (TOP%CROAD_DIR=='UNIF') THEN
+ ZTHETA0(JJ) = ASIN( MIN(ABS( 1./ZTANZEN(JJ))/T%XCAN_HW_RATIO(JJ), 1. ) )
!
!* 2.2 direct solar radiation received by roads and GARDEN areas
! -------------------------------------------------------
!
- ZDIR_SW_ROAD (JJ) = ( ZDIR_SW(JJ) * 2. * ZTHETA0(JJ) / XPI &
- - ZDIR_SW(JJ) * 2. * ZTANZEN(JJ) / XPI &
- * PCAN_HW_RATIO(JJ) * (1.-COS(ZTHETA0(JJ))) )
+ ZDIR_SW_RD (JJ) = ( ZDIR_SW(JJ) * 2. * ZTHETA0(JJ) / XPI &
+ - ZDIR_SW(JJ) * 2. * ZTANZEN(JJ) / XPI &
+ * T%XCAN_HW_RATIO(JJ) * (1.-COS(ZTHETA0(JJ))) )
!
- ZDIR_SW_GARDEN(JJ) = ( ZDIR_SW(JJ) * 2. * ZTHETA0(JJ) / XPI &
- - ZDIR_SW(JJ) * 2. * ZTANZEN(JJ) / XPI &
- * PCAN_HW_RATIO(JJ) * (1.-COS(ZTHETA0(JJ))) )
+ ZDIR_SW_GD(JJ) = ( ZDIR_SW(JJ) * 2. * ZTHETA0(JJ) / XPI &
+ - ZDIR_SW(JJ) * 2. * ZTANZEN(JJ) / XPI &
+ * T%XCAN_HW_RATIO(JJ) * (1.-COS(ZTHETA0(JJ))) )
ELSE
- ZDIR_SW_ROAD (JJ) = ZDIR_SW(JJ) * MAX(0., &
- 1.-PCAN_HW_RATIO(JJ)*ZTANZEN(JJ)*ABS(SIN(PAZIM(JJ)-ZROAD_DIR(JJ))) &
- )
- ZDIR_SW_GARDEN(JJ) = ZDIR_SW_ROAD(JJ)
+ ZDIR_SW_RD (JJ) = ZDIR_SW(JJ) * &
+ MAX(0.,1.-T%XCAN_HW_RATIO(JJ)*ZTANZEN(JJ)*ABS(SIN(PAZIM(JJ)-ZRD_DIR(JJ))))
+ ZDIR_SW_GD(JJ) = ZDIR_SW_RD(JJ)
END IF
!
!* 2.3 direct solar radiation received by walls
! ----------------------------------------
!
- ZDIR_SW_WALL(JJ) = (ZDIR_SW(JJ) - (ZDIR_SW_ROAD(JJ)*ZROAD(JJ)+ZDIR_SW_GARDEN(JJ)*ZGARDEN(JJ))) &
- * 0.5 / PCAN_HW_RATIO(JJ)
+ ZDIR_SW_WL(JJ) = (ZDIR_SW(JJ) - (ZDIR_SW_RD(JJ)*ZRD(JJ)+ZDIR_SW_GD(JJ)*ZGD(JJ))) &
+ * 0.5 / T%XCAN_HW_RATIO(JJ)
!
ELSE
!
- ZDIR_SW_ROAD (JJ) = ZDIR_SW(JJ)
- ZDIR_SW_GARDEN(JJ) = ZDIR_SW(JJ)
- ZDIR_SW_WALL (JJ) = 0.
+ ZDIR_SW_RD (JJ) = ZDIR_SW(JJ)
+ ZDIR_SW_GD (JJ) = ZDIR_SW(JJ)
+ ZDIR_SW_WL (JJ) = 0.
!
ENDIF
!
-IF (HROAD_DIR=='UNIF' .OR. HWALL_OPT=='UNIF') THEN
+IF (TOP%CROAD_DIR=='UNIF' .OR. TOP%CWALL_OPT=='UNIF') THEN
!* if walls are averaged, then
- ZDIR_SW_WALL_A(JJ) = ZDIR_SW_WALL(JJ)
- ZDIR_SW_WALL_B(JJ) = ZDIR_SW_WALL(JJ)
+ ZDIR_SW_WL_A(JJ) = ZDIR_SW_WL(JJ)
+ ZDIR_SW_WL_B(JJ) = ZDIR_SW_WL(JJ)
ELSE
!* if walls are separated, then radiation reaches the wall facing sun
! Note that wall A is the one facing mostly to the South (depending to
@@ -486,12 +416,12 @@ ELSE
! and wall B is the East wall (= West-facing wall)
! In case of E-W road, wall A is the North wall (= South-facing wall),
! and wall B is the South wall (= North-facing wall)
- IF (SIN(PAZIM(JJ)-ZROAD_DIR(JJ))>0.) THEN
- ZDIR_SW_WALL_A(JJ) = 2.* ZDIR_SW_WALL(JJ)
- ZDIR_SW_WALL_B(JJ) = 0.
+ IF (SIN(PAZIM(JJ)-ZRD_DIR(JJ))>0.) THEN
+ ZDIR_SW_WL_A(JJ) = 2.* ZDIR_SW_WL(JJ)
+ ZDIR_SW_WL_B(JJ) = 0.
ELSE
- ZDIR_SW_WALL_A(JJ) = 0.
- ZDIR_SW_WALL_B(JJ) = 2.* ZDIR_SW_WALL(JJ)
+ ZDIR_SW_WL_A(JJ) = 0.
+ ZDIR_SW_WL_B(JJ) = 2.* ZDIR_SW_WL(JJ)
END IF
END IF
!
@@ -500,25 +430,24 @@ END IF
!* 2.4 diffuse solar radiation received by roads and GARDEN areas
! ---------------------------------------------------------
!
- ZSCA_SW_ROAD (JJ) = ZSCA_SW(JJ) * PSVF_ROAD(JJ)
+ ZSCA_SW_RD (JJ) = ZSCA_SW(JJ) * T%XSVF_ROAD(JJ)
!
- ZSCA_SW_GARDEN(JJ) = ZSCA_SW(JJ) * PSVF_GARDEN(JJ)
+ ZSCA_SW_GD (JJ) = ZSCA_SW(JJ) * PSVF_GD(JJ)
!
!* 2.5 diffuse solar radiation received by walls
! -----------------------------------------
!
- ZSCA_SW_WALL(JJ) = ZSCA_SW(JJ) * PSVF_WALL(JJ)
+ ZSCA_SW_WL (JJ) = ZSCA_SW(JJ) * T%XSVF_WALL(JJ)
!
!* 2.6 total solar radiation received by GARDEN areas
! ---------------------------------------------
!
- PSW_RAD_GARDEN(JJ) = ZDIR_SW_GARDEN(JJ) + ZSCA_SW_GARDEN(JJ)
+ PSW_RAD_GD (JJ) = ZDIR_SW_GD(JJ) + ZSCA_SW_GD(JJ)
!
!* 2.7 averaged albedos when snow is present
! -------------------------------------
!
- ZAALB_ROAD (JJ) = PDF_ROAD (JJ) * PALB_ROAD (JJ) &
- + PDN_ROAD (JJ) * PASNOW_ROAD (JJ)
+ ZAALB_RD (JJ) = PDF_RD (JJ) * T%XALB_ROAD (JJ) + PDN_RD (JJ) * T%TSNOW_ROAD%ALB (JJ)
!
!
ENDDO
@@ -526,71 +455,65 @@ ENDDO
!* 2.7b averaged facade albedo
! -------------------------------------
!
-IF (HBEM=='BEM') THEN
+IF (TOP%CBEM=='BEM') THEN
!
- ZTRAN_WIN (:) = PTRAN_WIN(:)
+ ZTRAN_WIN(:) = B%XTRAN_WIN(:)
!
- G_EFF_SHAD(:) = OSHADE(:) .AND. &
- (ZDIR_SW_WALL(:) + ZSCA_SW_WALL(:) > XWIN_SW_MAX)
+ G_EFF_SHAD(:) = OSHADE(:).AND.(ZDIR_SW_WL(:) + ZSCA_SW_WL(:) > XWIN_SW_MAX)
!
OSHAD_DAY(:) = G_EFF_SHAD(:) .OR. OSHAD_DAY(:)
!
- CALL WINDOW_SHADING(PSHGC, PSHGC_SH, OSHAD_DAY, PALB_WALL, &
- PABS_WIN, ZABS_WIN, PALB_WIN, ZTRAN_WIN )
+ CALL WINDOW_SHADING(B%XSHGC, B%XSHGC_SH, OSHAD_DAY, T%XALB_WALL, &
+ B%XABS_WIN, ZABS_WIN, B%XALB_WIN, ZTRAN_WIN )
!
ELSE
!
ZABS_WIN (:) = 0.
- PALB_WIN (:) = 0.
+ B%XALB_WIN (:) = 0.
ZTRAN_WIN(:) = 0.
!
ENDIF
!
-ZAALB_WALL(:) = PGR(:) * PALB_WIN(:) + (1.-PGR(:)) * PALB_WALL(:)
+ZAALB_WL(:) = B%XGR(:) * B%XALB_WIN(:) + (1.-B%XGR(:)) * T%XALB_WALL(:)
!
!* 2.8 absorption of direct incoming solar radiation
! ---------------------------------------------
!
!
- CALL SOLAR_REFLECTIONS(ZDIR_SW_ROAD,ZDIR_SW_WALL, &
- ZDIR_SW_GARDEN, &
- ZABS_DIR_SW_ROAD, ZABS_DIR_SW_SNOW_ROAD, &
- ZABS_DIR_SW_WALL, ZABS_DIR_SW_GARDEN, ZABS_DIR_SW_WIN )
+ CALL SOLAR_REFLECTIONS(ZDIR_SW_RD, ZDIR_SW_WL, ZDIR_SW_GD, ZABS_DIR_SW_RD, &
+ ZABS_DIR_SW_SN_RD, ZABS_DIR_SW_WL, ZABS_DIR_SW_GD, &
+ ZABS_DIR_SW_WIN )
!
-IF (HROAD_DIR=='UNIF' .OR. HWALL_OPT=='UNIF') THEN
+IF (TOP%CROAD_DIR=='UNIF' .OR. TOP%CWALL_OPT=='UNIF') THEN
!* if walls are averaged, then
- ZABS_DIR_SW_WALL_A = ZABS_DIR_SW_WALL
- ZABS_DIR_SW_WALL_B = ZABS_DIR_SW_WALL
+ ZABS_DIR_SW_WL_A = ZABS_DIR_SW_WL
+ ZABS_DIR_SW_WL_B = ZABS_DIR_SW_WL
ELSE
!* if walls are separated, then radiation reaches the wall facing sun
! Note that wall A is the one facing mostly to the North (depending to
! road orientation), and wall B in the one facing mostly to the South.
- ZDW = (1.-PALB_WALL(:)) * ZAALB_WALL(:) * (1.-2.*PSVF_WALL(:)) &
- / (1.+ZAALB_WALL(:)*(1.-2.*PSVF_WALL(:))) &
- * 0.5 * (ZDIR_SW_WALL_A(:)-ZDIR_SW_WALL_B(:)) &
- + 0.5 * (1.-PALB_WALL(:)) * (ZDIR_SW_WALL_A-ZDIR_SW_WALL_B)
- ZABS_DIR_SW_WALL_A = ZABS_DIR_SW_WALL + ZDW
- ZABS_DIR_SW_WALL_B = ZABS_DIR_SW_WALL - ZDW
+ ZDW = (1.-T%XALB_WALL(:)) * ZAALB_WL(:) * (1.-2.*T%XSVF_WALL(:)) &
+ / (1.+ZAALB_WL(:)*(1.-2.*T%XSVF_WALL(:))) &
+ * 0.5 * (ZDIR_SW_WL_A(:)-ZDIR_SW_WL_B(:)) &
+ + 0.5 * (1.-T%XALB_WALL(:)) * (ZDIR_SW_WL_A-ZDIR_SW_WL_B)
+ ZABS_DIR_SW_WL_A = ZABS_DIR_SW_WL + ZDW
+ ZABS_DIR_SW_WL_B = ZABS_DIR_SW_WL - ZDW
END IF
!
!* 2.9 absorption of diffuse incoming solar radiation
! ----------------------------------------------
!
- CALL SOLAR_REFLECTIONS(ZSCA_SW_ROAD,ZSCA_SW_WALL, ZSCA_SW_GARDEN, &
- ZABS_SCA_SW_ROAD, ZABS_SCA_SW_SNOW_ROAD, &
- ZABS_SCA_SW_WALL, ZABS_SCA_SW_GARDEN, ZABS_SCA_SW_WIN )
+ CALL SOLAR_REFLECTIONS(ZSCA_SW_RD,ZSCA_SW_WL, ZSCA_SW_GD, &
+ ZABS_SCA_SW_RD, ZABS_SCA_SW_SN_RD, &
+ ZABS_SCA_SW_WL, ZABS_SCA_SW_GD, ZABS_SCA_SW_WIN )
!
! solar flux reflected for wall and road
!
-PREF_SW_GRND = ZROAD * PALB_ROAD / (1. - PALB_ROAD ) * &
- (ZABS_DIR_SW_ROAD + ZABS_SCA_SW_ROAD) &
- + ZGARDEN * PALB_GARDEN / (1. - PALB_GARDEN) * &
- (ZABS_DIR_SW_GARDEN + ZABS_SCA_SW_GARDEN)
+PREF_SW_GRND = ZRD * T%XALB_ROAD / (1.-T%XALB_ROAD ) * (ZABS_DIR_SW_RD + ZABS_SCA_SW_RD) &
+ + ZGD * PALB_GD / (1.-PALB_GD ) * (ZABS_DIR_SW_GD + ZABS_SCA_SW_GD)
!
-PREF_SW_FAC = (1 - PGR) * PALB_WALL / (1. - PALB_WALL) * &
- (ZABS_DIR_SW_WALL + ZABS_SCA_SW_WALL) &
- + PGR * PALB_WIN / (1 - PALB_WIN ) * &
- (ZABS_DIR_SW_WIN + ZABS_SCA_SW_WIN)
+PREF_SW_FAC = (1 - B%XGR) * T%XALB_WALL / (1.-T%XALB_WALL) * (ZABS_DIR_SW_WL + ZABS_SCA_SW_WL) &
+ + B%XGR * B%XALB_WIN / (1 - B%XALB_WIN) * (ZABS_DIR_SW_WIN + ZABS_SCA_SW_WIN)
!
!-------------------------------------------------------------------------------
!
@@ -600,118 +523,149 @@ PREF_SW_FAC = (1 - PGR) * PALB_WALL / (1. - PALB_WALL) * &
!* 3.1 direct albedo
! -------------
!
- CALL TOWN_ALBEDO(ZDIR_SW,ZABS_DIR_SW_ROOF,ZABS_DIR_SW_SNOW_ROOF, &
- ZABS_DIR_SW_ROAD, ZABS_DIR_SW_SNOW_ROAD,ZABS_DIR_SW_WALL, &
- ZABS_DIR_SW_GARDEN, ZABS_DIR_SW_GREENROOF, ZABS_DIR_SW_WIN,&
- ZABS_DIR_SW_PANEL, PDIR_ALB_TOWN )
+ CALL TOWN_ALBEDO(ZDIR_SW,ZABS_DIR_SW_RF,ZABS_DIR_SW_SN_RF, &
+ ZABS_DIR_SW_RD, ZABS_DIR_SW_SN_RD,ZABS_DIR_SW_WL, &
+ ZABS_DIR_SW_GD, ZABS_DIR_SW_GRF, ZABS_DIR_SW_WIN, &
+ ZABS_DIR_SW_PANEL, PDIR_ALB_TWN )
!
!* 3.2 direct albedo
! -------------
!
- CALL TOWN_ALBEDO(ZSCA_SW,ZABS_SCA_SW_ROOF,ZABS_SCA_SW_SNOW_ROOF, &
- ZABS_SCA_SW_ROAD, ZABS_SCA_SW_SNOW_ROAD,ZABS_SCA_SW_WALL, &
- ZABS_SCA_SW_GARDEN, ZABS_SCA_SW_GREENROOF, ZABS_SCA_SW_WIN,&
- ZABS_SCA_SW_PANEL, PSCA_ALB_TOWN )
+ CALL TOWN_ALBEDO(ZSCA_SW,ZABS_SCA_SW_RF,ZABS_SCA_SW_SN_RF, &
+ ZABS_SCA_SW_RD, ZABS_SCA_SW_SN_RD,ZABS_SCA_SW_WL, &
+ ZABS_SCA_SW_GD, ZABS_SCA_SW_GRF, ZABS_SCA_SW_WIN, &
+ ZABS_SCA_SW_PANEL, PSCA_ALB_TWN )
!
+WHERE (PDIR_ALB_TWN==XUNDEF) PDIR_ALB_TWN = PSCA_ALB_TWN
+!
+IF (GALB_ONLY) THEN
+ IF (LHOOK) CALL DR_HOOK('URBAN_SOLAR_ABS',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
!-------------------------------------------------------------------------------
!
!* 4. Trivial cases
! -------------
!
WHERE(PDIR_SW(:)==0.)
- ZABS_DIR_SW_ROOF (:) = 0.
- ZABS_DIR_SW_ROAD (:) = 0.
- ZABS_DIR_SW_WALL_A (:) = 0.
- ZABS_DIR_SW_WALL_B (:) = 0.
- ZABS_DIR_SW_GARDEN (:) = 0.
- ZABS_DIR_SW_GREENROOF (:) = 0.
- ZABS_DIR_SW_PANEL (:) = 0.
- ZABS_DIR_SW_WIN (:) = 0.
- ZABS_DIR_SW_SNOW_ROOF (:) = 0.
- ZABS_DIR_SW_SNOW_ROAD (:) = 0.
+ ZABS_DIR_SW_RF (:) = 0.
+ ZABS_DIR_SW_RD (:) = 0.
+ ZABS_DIR_SW_WL_A (:) = 0.
+ ZABS_DIR_SW_WL_B (:) = 0.
+ ZABS_DIR_SW_GD (:) = 0.
+ ZABS_DIR_SW_GRF (:) = 0.
+ ZABS_DIR_SW_PANEL(:) = 0.
+ ZABS_DIR_SW_WIN (:) = 0.
+ ZABS_DIR_SW_SN_RF(:) = 0.
+ ZABS_DIR_SW_SN_RD(:) = 0.
END WHERE
!
WHERE(PSCA_SW(:)==0.)
- ZABS_SCA_SW_ROOF (:) = 0.
- ZABS_SCA_SW_ROAD (:) = 0.
- ZABS_SCA_SW_WALL (:) = 0.
- ZABS_SCA_SW_GARDEN (:) = 0.
- ZABS_SCA_SW_GREENROOF (:) = 0.
- ZABS_SCA_SW_PANEL (:) = 0.
- ZABS_SCA_SW_WIN (:) = 0.
- ZABS_SCA_SW_SNOW_ROOF (:) = 0.
- ZABS_SCA_SW_SNOW_ROAD (:) = 0.
+ ZABS_SCA_SW_RF (:) = 0.
+ ZABS_SCA_SW_RD (:) = 0.
+ ZABS_SCA_SW_WL (:) = 0.
+ ZABS_SCA_SW_GD (:) = 0.
+ ZABS_SCA_SW_GRF (:) = 0.
+ ZABS_SCA_SW_PANEL(:) = 0.
+ ZABS_SCA_SW_WIN (:) = 0.
+ ZABS_SCA_SW_SN_RF(:) = 0.
+ ZABS_SCA_SW_SN_RD(:) = 0.
END WHERE
!
-WHERE (PDIR_ALB_TOWN==XUNDEF) PDIR_ALB_TOWN = PSCA_ALB_TOWN
+DMT%XABS_SW_ROOF (:) = 0.
+DMT%XABS_SW_ROAD (:) = 0.
+DMT%XABS_SW_WALL_A (:) = 0.
+DMT%XABS_SW_WALL_B (:) = 0.
+DMT%XABS_SW_GARDEN (:) = 0.
+DMT%XABS_SW_GREENROOF (:) = 0.
+DMT%XABS_SW_SNOW_ROOF (:) = 0.
+DMT%XABS_SW_SNOW_ROAD (:) = 0.
+IF (TOP%CBEM=="BEM") THEN
+ DMT%XABS_SW_WIN (:) = 0.
+ENDIF
+!
+PREC_SW_WIN (:) = 0.
+PREC_SW_RD (:) = 0.
+PREC_SW_WL_A (:) = 0.
+PREC_SW_WL_B (:) = 0.
+PREC_SW_GD (:) = 0.
+PREC_SW_SN_RD (:) = 0.
+PREC_SW_RF (:) = 0.
!
!-------------------------------------------------------------------------------
!
-DO JJ=1,SIZE(PROAD)
+!
+IF (TOP%CBEM=='BEM') THEN
+ !
+ DO JJ=1,SIZE(T%XROAD)
+ !
+ ! solar radiation absorbed (but not transmitted) by windows
+ !
+ ZREC_DIR_SW_WIN (JJ) = ZABS_DIR_SW_WIN(JJ) / (1.-B%XALB_WIN(JJ))
+ ZREC_SCA_SW_WIN (JJ) = ZABS_SCA_SW_WIN(JJ) / (1.-B%XALB_WIN(JJ))
+ !
+ PREC_SW_WIN (JJ) = ZREC_DIR_SW_WIN(JJ) + ZREC_SCA_SW_WIN(JJ)
+ !
+ DMT%XABS_SW_WIN(JJ) = (ZREC_DIR_SW_WIN (JJ) + ZREC_SCA_SW_WIN (JJ)) * ZABS_WIN(JJ)
+ !
+ DMT%XTR_SW_WIN (JJ) = PREC_SW_WIN(JJ) * ZTRAN_WIN(JJ)
+ !
+ ENDDO
+ !
+ENDIF
+!
+DO JJ=1,SIZE(T%XROAD)
!
!* 5. Total solar radiation absorbed by each surface
! ----------------------------------------------
!
! solar radiation absorbed by roofs
!
- PABS_SW_ROOF (JJ) = ZABS_DIR_SW_ROOF (JJ) + ZABS_SCA_SW_ROOF (JJ)
+ DMT%XABS_SW_ROOF (JJ) = ZABS_DIR_SW_RF (JJ) + ZABS_SCA_SW_RF (JJ)
!
! solar radiation absorbed by roads
!
- PABS_SW_ROAD (JJ) = ZABS_DIR_SW_ROAD (JJ) + ZABS_SCA_SW_ROAD (JJ)
+ DMT%XABS_SW_ROAD (JJ) = ZABS_DIR_SW_RD (JJ) + ZABS_SCA_SW_RD (JJ)
!
! solar radiation absorbed by GARDEN areas
!
- PABS_SW_GARDEN (JJ) = ZABS_DIR_SW_GARDEN (JJ) + ZABS_SCA_SW_GARDEN (JJ)
-!
-! solar radiation absorbed by GREENROOF areas
+ DMT%XABS_SW_GARDEN (JJ) = ZABS_DIR_SW_GD (JJ) + ZABS_SCA_SW_GD (JJ)
!
- PABS_SW_GREENROOF(JJ) = ZABS_DIR_SW_GREENROOF(JJ) + ZABS_SCA_SW_GREENROOF(JJ)
+! solar radiation absorbed by GRF areas
!
-! solar radiation absorbed by solar panels
-!
- PABS_SW_SOLAR_PANEL(JJ)= ZABS_DIR_SW_PANEL (JJ) + ZABS_SCA_SW_PANEL (JJ)
+ DMT%XABS_SW_GREENROOF(JJ) = ZABS_DIR_SW_GRF(JJ) + ZABS_SCA_SW_GRF(JJ)
!
! solar radiation absorbed by walls
!
- PABS_SW_WALL_A (JJ) = ZABS_DIR_SW_WALL_A (JJ) + ZABS_SCA_SW_WALL (JJ)
- PABS_SW_WALL_B (JJ) = ZABS_DIR_SW_WALL_B (JJ) + ZABS_SCA_SW_WALL (JJ)
-!
-! solar radiation absorbed (but not transmitted) by windows
-!
- ZREC_DIR_SW_WIN(JJ) = ZABS_DIR_SW_WIN(JJ) / (1.-PALB_WIN(JJ))
- ZREC_SCA_SW_WIN(JJ) = ZABS_SCA_SW_WIN(JJ) / (1.-PALB_WIN(JJ))
-!
- PABS_SW_WIN (JJ) = (ZREC_DIR_SW_WIN (JJ) + ZREC_SCA_SW_WIN (JJ)) * ZABS_WIN(JJ)
+ DMT%XABS_SW_WALL_A (JJ) = ZABS_DIR_SW_WL_A (JJ) + ZABS_SCA_SW_WL (JJ)
+ DMT%XABS_SW_WALL_B (JJ) = ZABS_DIR_SW_WL_B (JJ) + ZABS_SCA_SW_WL (JJ)
!
!
! solar radiation absorbed by snow on roofs
!
- PABS_SW_SNOW_ROOF (JJ) = ZABS_DIR_SW_SNOW_ROOF (JJ) + ZABS_SCA_SW_SNOW_ROOF (JJ)
+ DMT%XABS_SW_SNOW_ROOF (JJ) = ZABS_DIR_SW_SN_RF (JJ) + ZABS_SCA_SW_SN_RF (JJ)
!
! solar radiation absorbed by snow on roads
!
- PABS_SW_SNOW_ROAD (JJ) = ZABS_DIR_SW_SNOW_ROAD (JJ) + ZABS_SCA_SW_SNOW_ROAD (JJ)
+ DMT%XABS_SW_SNOW_ROAD (JJ) = ZABS_DIR_SW_SN_RD (JJ) + ZABS_SCA_SW_SN_RD (JJ)
!
!-------------------------------------------------------------------------------
!
!* 6. total solar radiation received by roads and GARDEN areas
! -------------------------------------------------------
!
- PREC_SW_ROAD (JJ) = PABS_SW_ROAD (JJ)/(1.-PALB_ROAD (JJ))
+ PREC_SW_RD (JJ) = DMT%XABS_SW_ROAD (JJ)/(1.-T%XALB_ROAD (JJ))
!
- PREC_SW_SNOW_ROAD (JJ) = PABS_SW_SNOW_ROAD (JJ)/(1.-PASNOW_ROAD (JJ))
+ PREC_SW_SN_RD (JJ) = DMT%XABS_SW_SNOW_ROAD (JJ)/(1.-T%TSNOW_ROAD%ALB(JJ))
!
- PREC_SW_WALL_A (JJ) = PABS_SW_WALL_A (JJ)/(1.-PALB_WALL (JJ))
- PREC_SW_WALL_B (JJ) = PABS_SW_WALL_B (JJ)/(1.-PALB_WALL (JJ))
+ PREC_SW_WL_A (JJ) = DMT%XABS_SW_WALL_A (JJ)/(1.-T%XALB_WALL (JJ))
+ PREC_SW_WL_B (JJ) = DMT%XABS_SW_WALL_B (JJ)/(1.-T%XALB_WALL (JJ))
!
- PREC_SW_WIN (JJ) = ZREC_DIR_SW_WIN(JJ) + ZREC_SCA_SW_WIN(JJ)
-!
- PREC_SW_GARDEN (JJ) = PABS_SW_GARDEN (JJ)/(1.-PALB_GARDEN (JJ))
+ PREC_SW_GD (JJ) = DMT%XABS_SW_GARDEN (JJ)/(1.-PALB_GD (JJ))
!
!* 6.2 total solar radiation received by roof surfaces below solar panels
!
- PREC_SW_ROOF (JJ) = (PDIR_SW(JJ) + PSCA_SW(JJ)) * (1.-PFRAC_PANEL(JJ))
+ PREC_SW_RF (JJ) = (PDIR_SW(JJ) + PSCA_SW(JJ)) * (1.-PFRAC_PANEL(JJ))
!
!-------------------------------------------------------------------------------
!
@@ -719,128 +673,116 @@ DO JJ=1,SIZE(PROAD)
!* and energy not ref., nor absorbed, nor transmitted
! --------------------------------------------------
!
- PTR_SW_WIN(JJ) = PREC_SW_WIN(JJ) * ZTRAN_WIN(JJ)
! [W/m2(bld)]
- PE_SHADING(JJ) = PREC_SW_WIN(JJ) * (1. - PALB_WIN(JJ) - ZABS_WIN(JJ) - ZTRAN_WIN(JJ))
+ PE_SHADING(JJ) = PREC_SW_WIN(JJ) * (1. - B%XALB_WIN(JJ) - ZABS_WIN(JJ) - ZTRAN_WIN(JJ))
! [W/m2(win)]
ENDDO
!
+IF (TOP%LSOLAR_PANEL) THEN
+ !
+ DO JJ=1,SIZE(T%XROAD)
+ !
+ ! solar radiation absorbed by solar panels
+ !
+ DMT%XABS_SW_PANEL(JJ) = ZABS_DIR_SW_PANEL (JJ) + ZABS_SCA_SW_PANEL (JJ)
+ !
+ ENDDO
+ !
+ENDIF
+!
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('URBAN_SOLAR_ABS',1,ZHOOK_HANDLE)
- CONTAINS
+CONTAINS
!
!-------------------------------------------------------------------------------
-SUBROUTINE SOLAR_REFLECTIONS(ZSW_ROAD,ZSW_WALL,ZSW_GARDEN, &
- ZABS_SW_ROAD,ZABS_SW_SNOW_ROAD, &
- ZABS_SW_WALL, &
- ZABS_SW_GARDEN, ZABS_SW_WIN )
-!
-REAL, DIMENSION(:), INTENT(IN) :: ZSW_ROAD ! solar radiation received by road,
-REAL, DIMENSION(:), INTENT(IN) :: ZSW_WALL ! wall, and GARDEN areas
-REAL, DIMENSION(:), INTENT(IN) :: ZSW_GARDEN ! before reflection
-REAL, DIMENSION(:), INTENT(OUT):: ZABS_SW_ROAD ! solar radiation absorbed by
-REAL, DIMENSION(:), INTENT(OUT):: ZABS_SW_SNOW_ROAD ! solar radiation absorbed by
-REAL, DIMENSION(:), INTENT(OUT):: ZABS_SW_WALL ! road, snow over road, and wall
-REAL, DIMENSION(:), INTENT(OUT):: ZABS_SW_GARDEN ! solar radiation absorbed by garden
+SUBROUTINE SOLAR_REFLECTIONS(ZSW_RD,ZSW_WL, ZSW_GD, ZABS_SW_RD,ZABS_SW_SN_RD, &
+ ZABS_SW_WL, ZABS_SW_GD, ZABS_SW_WIN )
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZSW_RD ! solar radiation received by road,
+REAL, DIMENSION(:), INTENT(IN) :: ZSW_WL ! wall, and GD areas
+REAL, DIMENSION(:), INTENT(IN) :: ZSW_GD ! before reflection
+REAL, DIMENSION(:), INTENT(OUT):: ZABS_SW_RD ! solar radiation absorbed by
+REAL, DIMENSION(:), INTENT(OUT):: ZABS_SW_SN_RD ! solar radiation absorbed by
+REAL, DIMENSION(:), INTENT(OUT):: ZABS_SW_WL ! road, snow over road, and wall
+REAL, DIMENSION(:), INTENT(OUT):: ZABS_SW_GD ! solar radiation absorbed by garden
REAL, DIMENSION(:), INTENT(OUT):: ZABS_SW_WIN ! solar radiation absorbed by window
!
-REAL, DIMENSION(SIZE(ZSW_ROAD)) :: ZREF0_SW_ROAD ! first solar reflection
-REAL, DIMENSION(SIZE(ZSW_ROAD)) :: ZREF0_SW_WALL ! against road, wall
-REAL, DIMENSION(SIZE(ZSW_ROAD)) :: ZREF0_SW_GARDEN ! and GARDEN areas
-REAL, DIMENSION(SIZE(ZSW_ROAD)) :: ZSREF_SW_ROAD ! sum of all reflections
-REAL, DIMENSION(SIZE(ZSW_ROAD)) :: ZSREF_SW_WALL ! against road, wall,
-REAL, DIMENSION(SIZE(ZSW_ROAD)) :: ZSREF_SW_GARDEN ! and GARDEN areas
+REAL, DIMENSION(SIZE(ZSW_RD)) :: ZREF0_SW_RD ! first solar reflection
+REAL, DIMENSION(SIZE(ZSW_RD)) :: ZREF0_SW_WL ! against road, wall
+REAL, DIMENSION(SIZE(ZSW_RD)) :: ZREF0_SW_GD ! and GD areas
+REAL, DIMENSION(SIZE(ZSW_RD)) :: ZSREF_SW_RD ! sum of all reflections
+REAL, DIMENSION(SIZE(ZSW_RD)) :: ZSREF_SW_WL ! against road, wall,
+REAL, DIMENSION(SIZE(ZSW_RD)) :: ZSREF_SW_GD ! and GD areas
!
-REAL, DIMENSION(SIZE(ZSW_ROAD)) :: ZWORK1, ZWORK2, ZDENOM
+REAL, DIMENSION(SIZE(ZSW_RD)) :: ZWORK1, ZWORK2, ZDENOM
INTEGER :: JJ
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('SOLAR_REFLECTIONS',0,ZHOOK_HANDLE)
!
-DO JJ=1,SIZE(ZSW_ROAD)
+DO JJ=1,SIZE(ZSW_RD)
!* A. first solar radiation reflection
! --------------------------------
!
- ZREF0_SW_ROAD(JJ) = ZAALB_ROAD(JJ) * ZSW_ROAD(JJ)
+ ZREF0_SW_RD(JJ) = ZAALB_RD(JJ) * ZSW_RD(JJ)
!
- ZREF0_SW_GARDEN(JJ) = PALB_GARDEN(JJ) * ZSW_GARDEN(JJ)
+ ZREF0_SW_GD(JJ) = PALB_GD(JJ) * ZSW_GD(JJ)
!
- ZREF0_SW_WALL(JJ) = ZAALB_WALL(JJ) * ZSW_WALL(JJ)
+ ZREF0_SW_WL(JJ) = ZAALB_WL(JJ) * ZSW_WL(JJ)
!
!* B. sum of solar radiation reflected
! --------------------------------
!
- ZDENOM(JJ) = 1. - (1.-2.*PSVF_WALL(JJ)) * PALB_WALL(JJ) &
- - (1. - PSVF_ROAD(JJ))* &
- PSVF_WALL(JJ)*PALB_WALL(JJ)*ZAALB_ROAD(JJ)*ZROAD(JJ) &
- - (1. - PSVF_GARDEN(JJ))* &
- PSVF_WALL(JJ)*PALB_WALL(JJ)*PALB_GARDEN(JJ)*ZGARDEN(JJ)
+ ZDENOM(JJ) = 1. - (1.-2.*T%XSVF_WALL(JJ)) * T%XALB_WALL(JJ) - (1. - T%XSVF_ROAD(JJ))* &
+ T%XSVF_WALL(JJ)*T%XALB_WALL(JJ)*ZAALB_RD(JJ)*ZRD(JJ) &
+ - (1. - PSVF_GD(JJ))* &
+ T%XSVF_WALL(JJ)*T%XALB_WALL(JJ)*PALB_GD(JJ)*ZGD(JJ)
- ZWORK1(JJ) = PSVF_WALL(JJ) * PALB_WALL(JJ) * ZROAD(JJ)
- ZWORK2(JJ) = PSVF_WALL(JJ) * PALB_WALL(JJ) * ZGARDEN(JJ)
+ ZWORK1(JJ) = T%XSVF_WALL(JJ) * T%XALB_WALL(JJ) * ZRD(JJ)
+ ZWORK2(JJ) = T%XSVF_WALL(JJ) * T%XALB_WALL(JJ) * ZGD(JJ)
!
!
- ZSREF_SW_WALL(JJ) = ( ZREF0_SW_WALL(JJ) &
- + ZWORK1(JJ) *ZREF0_SW_ROAD(JJ) &
- + ZWORK2(JJ) *ZREF0_SW_GARDEN(JJ)) &
- / ZDENOM(JJ)
+ ZSREF_SW_WL(JJ) = ( ZREF0_SW_WL(JJ) + ZWORK1(JJ) *ZREF0_SW_RD(JJ) &
+ + ZWORK2(JJ) *ZREF0_SW_GD(JJ)) / ZDENOM(JJ)
- ZSREF_SW_ROAD(JJ) = ( (1.- PSVF_ROAD(JJ) ) * ZAALB_ROAD(JJ) &
- * ZREF0_SW_WALL(JJ) &
- +(1.- PSVF_ROAD(JJ) ) * ZAALB_ROAD(JJ) &
- * ZWORK1(JJ) &
- * ZREF0_SW_ROAD(JJ) &
- +(1.- PSVF_ROAD(JJ) ) * ZAALB_ROAD(JJ) &
- * ZWORK2(JJ) &
- * ZREF0_SW_GARDEN(JJ) )&
- / ZDENOM(JJ) &
- + ZREF0_SW_ROAD(JJ)
+ ZSREF_SW_RD(JJ) = ((1.- T%XSVF_ROAD(JJ)) * ZAALB_RD(JJ) * ZREF0_SW_WL(JJ) &
+ +(1.- T%XSVF_ROAD(JJ)) * ZAALB_RD(JJ) * ZWORK1(JJ) * ZREF0_SW_RD(JJ) &
+ +(1.- T%XSVF_ROAD(JJ)) * ZAALB_RD(JJ) * ZWORK2(JJ) * ZREF0_SW_GD(JJ)) &
+ / ZDENOM(JJ) + ZREF0_SW_RD(JJ)
- ZSREF_SW_GARDEN(JJ) = ( (1.- PSVF_GARDEN(JJ)) * PALB_GARDEN(JJ) &
- * ZREF0_SW_WALL(JJ) &
- +(1.- PSVF_GARDEN(JJ)) * PALB_GARDEN(JJ) &
- * ZWORK1(JJ) &
- * ZREF0_SW_ROAD(JJ) &
- +(1.- PSVF_GARDEN(JJ)) * PALB_GARDEN(JJ) &
- * ZWORK2(JJ) &
- * ZREF0_SW_GARDEN(JJ) )&
- / ZDENOM(JJ) &
- + ZREF0_SW_GARDEN(JJ)
-!
-!
-!* C. total solar radiation received by roads and GARDEN areas
+ ZSREF_SW_GD(JJ) = ((1.- PSVF_GD(JJ)) * PALB_GD(JJ) * ZREF0_SW_WL(JJ) &
+ +(1.- PSVF_GD(JJ)) * PALB_GD(JJ) * ZWORK1(JJ) * ZREF0_SW_RD(JJ) &
+ +(1.- PSVF_GD(JJ)) * PALB_GD(JJ) * ZWORK2(JJ) * ZREF0_SW_GD(JJ) )&
+ / ZDENOM(JJ) + ZREF0_SW_GD(JJ)
+!
+!* C. total solar radiation received by roads and GD areas
! -------------------------------------------------------
!
- ZABS_SW_ROAD(JJ) = (1.-PALB_ROAD(JJ) ) &
- * ( ZSW_ROAD(JJ) &
- + ZSREF_SW_WALL(JJ) * (1.- PSVF_ROAD(JJ) ) )
+ ZABS_SW_RD(JJ) = (1.-T%XALB_ROAD(JJ)) * (ZSW_RD(JJ) + ZSREF_SW_WL(JJ) * (1.- T%XSVF_ROAD(JJ)))
!
- ZABS_SW_SNOW_ROAD(JJ) = (1.-PASNOW_ROAD(JJ) ) &
- * ( ZSW_ROAD(JJ) &
- + ZSREF_SW_WALL(JJ) * (1.- PSVF_ROAD(JJ) ) )
+ ZABS_SW_SN_RD(JJ) = (1.-T%TSNOW_ROAD%ALB(JJ)) * &
+ (ZSW_RD(JJ) + ZSREF_SW_WL(JJ) * (1.- T%XSVF_ROAD(JJ)))
!
- ZABS_SW_GARDEN(JJ) = (1.-PALB_GARDEN(JJ)) &
- * ( ZSW_GARDEN(JJ) &
- + ZSREF_SW_WALL(JJ) * (1.- PSVF_GARDEN(JJ)) )
+ ZABS_SW_GD(JJ) = (1.-PALB_GD(JJ)) * (ZSW_GD(JJ) + ZSREF_SW_WL(JJ) * (1.- PSVF_GD(JJ)))
!
!
!* D. total solar radiation received by walls
! ---------------------------------------
!
- ZABS_SW_WALL(JJ) = (1.-PALB_WALL(JJ)) &
- * ( ZSW_WALL(JJ) &
- + ZSREF_SW_ROAD(JJ) * PSVF_WALL(JJ)*ZROAD(JJ) &
- + ZSREF_SW_GARDEN(JJ) * PSVF_WALL(JJ)*ZGARDEN(JJ) &
- + ZSREF_SW_WALL(JJ) * (1.-2.*PSVF_WALL(JJ)) )
+ ZABS_SW_WL(JJ) = (1.-T%XALB_WALL(JJ)) &
+ * (ZSW_WL(JJ) &
+ + ZSREF_SW_RD(JJ) * T%XSVF_WALL(JJ)*ZRD(JJ) &
+ + ZSREF_SW_GD(JJ) * T%XSVF_WALL(JJ)*ZGD(JJ) &
+ + ZSREF_SW_WL(JJ) * (1.-2.*T%XSVF_WALL(JJ)) )
!
- ZABS_SW_WIN (JJ) = (1.-PALB_WIN (JJ)) &
- * ( ZSW_WALL(JJ) &
- + ZSREF_SW_ROAD(JJ) * PSVF_WALL(JJ)*ZROAD(JJ) &
- + ZSREF_SW_GARDEN(JJ) * PSVF_WALL(JJ)*ZGARDEN(JJ) &
- + ZSREF_SW_WALL(JJ) * (1.-2.*PSVF_WALL(JJ)) )
+ ZABS_SW_WIN (JJ) = (1.-B%XALB_WIN (JJ)) &
+ * (ZSW_WL(JJ) &
+ + ZSREF_SW_RD(JJ) * T%XSVF_WALL(JJ)*ZRD(JJ) &
+ + ZSREF_SW_GD(JJ) * T%XSVF_WALL(JJ)*ZGD(JJ) &
+ + ZSREF_SW_WL(JJ) * (1.-2.*T%XSVF_WALL(JJ)) )
!
ENDDO
!
@@ -850,20 +792,19 @@ END SUBROUTINE SOLAR_REFLECTIONS
!
!-------------------------------------------------------------------------------
!
-SUBROUTINE TOWN_ALBEDO(ZSW,ZABS_SW_ROOF,ZABS_SW_SNOW_ROOF, &
- ZABS_SW_ROAD, ZABS_SW_SNOW_ROAD,ZABS_SW_WALL, &
- ZABS_SW_GARDEN, ZABS_SW_GREENROOF, ZABS_SW_WIN,&
+SUBROUTINE TOWN_ALBEDO(ZSW,ZABS_SW_RF,ZABS_SW_SN_RF,ZABS_SW_RD,ZABS_SW_SN_RD,&
+ ZABS_SW_WL,ZABS_SW_GD, ZABS_SW_GRF, ZABS_SW_WIN, &
ZABS_SW_PANEL, ZALBEDO )
!
REAL, DIMENSION(:), INTENT(IN) :: ZSW ! incoming solar radiation
-REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_ROOF ! solar radiation absorbed by roofs
-REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_ROAD ! solar radiation absorbed by roads
-REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_WALL ! solar radiation absorbed by walls
+REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_RF ! solar radiation absorbed by roofs
+REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_RD ! solar radiation absorbed by roads
+REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_WL ! solar radiation absorbed by walls
REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_WIN ! solar radiation absorbed & transmitted by windows
-REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_GARDEN ! solar radiation absorbed by GARDEN areas
-REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_GREENROOF ! solar radiation absorbed by green roof areas
-REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_SNOW_ROOF ! solar radiation absorbed by roof snow
-REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_SNOW_ROAD ! solar radiation absorbed by road snow
+REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_GD ! solar radiation absorbed by GARDEN areas
+REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_GRF ! solar radiation absorbed by green roof areas
+REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_SN_RF ! solar radiation absorbed by roof snow
+REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_SN_RD ! solar radiation absorbed by road snow
REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_PANEL ! solar radiation absorbed by solar panels
REAL, DIMENSION(:), INTENT(OUT):: ZALBEDO ! town averaged albedo
@@ -875,15 +816,15 @@ IF (LHOOK) CALL DR_HOOK('TOWN_ALBEDO',0,ZHOOK_HANDLE)
DO JJ=1,SIZE(ZSW)
ZSW_UP(JJ) = ZSW(JJ) &
- - ( PBLD(JJ) *(1.-PFRAC_GR(JJ))*PDF_ROOF(JJ) *ZABS_SW_ROOF(JJ) &
- +PBLD(JJ) *(1.-PFRAC_GR(JJ))*PDN_ROOF(JJ) *ZABS_SW_SNOW_ROOF(JJ)&
- +PBLD(JJ) * PFRAC_GR(JJ) *ZABS_SW_GREENROOF(JJ)&
- +PBLD(JJ) * PFRAC_PANEL(JJ) *ZABS_SW_PANEL(JJ) &
- +PROAD(JJ) *PDF_ROAD(JJ) *ZABS_SW_ROAD (JJ) &
- +PROAD(JJ) *PDN_ROAD(JJ) *ZABS_SW_SNOW_ROAD(JJ)&
- +PGARDEN(JJ) *ZABS_SW_GARDEN(JJ) &
- +PWALL_O_HOR(JJ) *(1.-PGR(JJ)) *ZABS_SW_WALL(JJ) &
- +PWALL_O_HOR(JJ) * PGR(JJ) *ZABS_SW_WIN (JJ) )
+ - ( T%XBLD(JJ) *(1.-T%XGREENROOF(JJ))*PDF_RF(JJ) *ZABS_SW_RF (JJ)&
+ +T%XBLD(JJ) *(1.-T%XGREENROOF(JJ))*PDN_RF(JJ) *ZABS_SW_SN_RF(JJ)&
+ +T%XBLD(JJ) * T%XGREENROOF(JJ) *ZABS_SW_GRF (JJ)&
+ +T%XBLD(JJ) * PFRAC_PANEL(JJ) *ZABS_SW_PANEL (JJ)&
+ +T%XROAD(JJ) *PDF_RD(JJ) *ZABS_SW_RD (JJ) &
+ +T%XROAD(JJ) *PDN_RD(JJ) *ZABS_SW_SN_RD(JJ)&
+ +T%XGARDEN(JJ) *ZABS_SW_GD(JJ) &
+ +T%XWALL_O_HOR(JJ) *(1.-B%XGR(JJ)) *ZABS_SW_WL(JJ) &
+ +T%XWALL_O_HOR(JJ) * B%XGR(JJ) *ZABS_SW_WIN (JJ) )
!
IF (ZSW(JJ)>0.) THEN
ZALBEDO(JJ) = ZSW_UP(JJ) / ZSW(JJ)
diff --git a/src/SURFEX/utci_teb.F90 b/src/SURFEX/utci_teb.F90
index 9643930eba575c900b672745571b40b3b3ab636e..cd07871fe4c452ee9dd5d4985de844243ca6cd91 100644
--- a/src/SURFEX/utci_teb.F90
+++ b/src/SURFEX/utci_teb.F90
@@ -3,12 +3,9 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ##########################################################################
-SUBROUTINE UTCI_TEB(PT_CAN, PQ_CAN, PTI_BLD, PQI_BLD, PU10, PPS, &
- PREF_SW_GRND, PREF_SW_FAC, PSCA_SW, PDIR_SW, PZENITH,&
- PEMIT_LW_FAC, PEMIT_LW_GRND, PLW_RAD, PTRAD_IN, &
- PBLD, PBLD_HEIGHT, PWALL_O_HOR, &
- PUTCI_IN, PUTCI_OUTSUN, PUTCI_OUTSHADE, &
- PTRAD_SUN, PTRAD_SHADE )
+SUBROUTINE UTCI_TEB(T, DUT, PTI_BLD, PQI_BLD, PU10, PPS, PREF_SW_GRND, PREF_SW_FAC, &
+ PSCA_SW, PDIR_SW, PZENITH, PEMIT_LW_FAC, PEMIT_LW_GRND, PLW_RAD,&
+ PTRAD_IN )
! ##########################################################################
!
!!**** *UTCI_TEB*
@@ -48,6 +45,9 @@ SUBROUTINE UTCI_TEB(PT_CAN, PQ_CAN, PTI_BLD, PQI_BLD, PU10, PPS, &
!* 0. DECLARATIONS
! ------------
!
+USE MODD_DIAG_UTCI_TEB_n, ONLY : DIAG_UTCI_TEB_t
+USE MODD_TEB_n, ONLY : TEB_t
+!
USE MODD_CSTS, ONLY : XTT
USE MODI_UTCI_APPROX
USE MODI_TRAD_BODY
@@ -58,8 +58,9 @@ USE PARKIND1 ,ONLY : JPRB
IMPLICIT NONE
!
!* 0.1 declarations of arguments
-REAL, DIMENSION(:), INTENT(IN) :: PT_CAN !Air canyon temperature (K)
-REAL, DIMENSION(:), INTENT(IN) :: PQ_CAN !Canyon specific humidity (kg/kg)
+TYPE(TEB_t), INTENT(INOUT) :: T
+TYPE(DIAG_UTCI_TEB_t), INTENT(INOUT) :: DUT
+!
REAL, DIMENSION(:), INTENT(IN) :: PTI_BLD !Indoor air temperature (K)
REAL, DIMENSION(:), INTENT(IN) :: PQI_BLD !Indoor specific humidity (kg/kg)
REAL, DIMENSION(:), INTENT(IN) :: PU10 !Canyon wind speed at 10m (m/s)
@@ -73,14 +74,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PEMIT_LW_FAC !Longwave radiation emitted by t
REAL, DIMENSION(:), INTENT(IN) :: PEMIT_LW_GRND !Longwave radiation emitted by the ground [road + garden] (W/m2)
REAL, DIMENSION(:), INTENT(IN) :: PLW_RAD !Atmospheric longwave radiation (W/m2)
REAL, DIMENSION(:), INTENT(IN) :: PTRAD_IN !Indoor radiant temperature (K)
-REAL, DIMENSION(:), INTENT(IN) :: PBLD !Building surface fraction
-REAL, DIMENSION(:), INTENT(IN) :: PBLD_HEIGHT !Building surface fraction
-REAL, DIMENSION(:), INTENT(IN) :: PWALL_O_HOR !Building surface fraction
-REAL, DIMENSION(:), INTENT(OUT) :: PUTCI_IN !UTCI for indoor person (C)
-REAL, DIMENSION(:), INTENT(OUT) :: PUTCI_OUTSUN !UTCI for outdoor person at sun (C)
-REAL, DIMENSION(:), INTENT(OUT) :: PUTCI_OUTSHADE !UTCI for outdoor person in shade (C)
-REAL, DIMENSION(:), INTENT(OUT) :: PTRAD_SUN !Mean radiant temperature at sun (C)
-REAL, DIMENSION(:), INTENT(OUT) :: PTRAD_SHADE !Mean radiant temperature in shade (C)
!
!* 0.2 declarations of local variables
REAL, DIMENSION(SIZE(PTI_BLD)) :: ZEHPA !water vapour pressure (hPa)
@@ -94,24 +87,22 @@ IF (LHOOK) CALL DR_HOOK('UTCI_TEB',0,ZHOOK_HANDLE)
! 1-calculation of UTCI_IN
ZEHPA = PQI_BLD * PPS /(0.622 + 0.378 * PQI_BLD) / 100.
ZUIN = 0.5
-PUTCI_IN = UTCI_APPROX(PTI_BLD - XTT, ZEHPA, PTRAD_IN - XTT, ZUIN)
+DUT%XUTCI_IN = UTCI_APPROX(PTI_BLD - XTT, ZEHPA, PTRAD_IN - XTT, ZUIN)
!
! 2-calculation of UTCI_OUTSUN
-ZEHPA = PQ_CAN * PPS / (0.622 + 0.378 * PQ_CAN) /100.
-PTRAD_SUN = TRAD_BODY(PSCA_SW, PREF_SW_FAC, PREF_SW_GRND, &
- PEMIT_LW_FAC, PEMIT_LW_GRND, PLW_RAD,&
- PBLD, PBLD_HEIGHT, PWALL_O_HOR, PDIR_SW, PZENITH )
-PUTCI_OUTSUN = UTCI_APPROX(PT_CAN - XTT, ZEHPA, PTRAD_SUN - XTT, PU10)
+ZEHPA = T%XQ_CANYON * PPS / (0.622 + 0.378 * T%XQ_CANYON) /100.
+DUT%XTRAD_SUN = TRAD_BODY(PSCA_SW, PREF_SW_FAC, PREF_SW_GRND, PEMIT_LW_FAC, PEMIT_LW_GRND, PLW_RAD, &
+ T%XBLD, T%XBLD_HEIGHT, T%XWALL_O_HOR, PDIR_SW, PZENITH )
+DUT%XUTCI_OUTSUN = UTCI_APPROX(T%XT_CANYON - XTT, ZEHPA, DUT%XTRAD_SUN - XTT, PU10)
!
! 3-calculation of UTCI_OUTSHADE
ZDIR_SW=0.
ZZENITH=0.
-!!PTRAD_SHADE = TRAD_BODY(PSCA_SW,PREF_SW_FAC, PREF_SW_GRND, &
+!!DUT%XTRAD_SHADE = TRAD_BODY(PSCA_SW,PREF_SW_FAC, PREF_SW_GRND, &
!! PEMIT_LW_FAC, PEMIT_LW_GRND, PLW_RAD,&
-!! PBLD, PBLD_HEIGHT, PWALL_O_HOR, ZDIR_SW, ZZENITH)
-PTRAD_SHADE = TRAD_BODY(PSCA_SW,PREF_SW_FAC, PREF_SW_GRND, &
- PEMIT_LW_FAC, PEMIT_LW_GRND, PLW_RAD,&
- PBLD, PBLD_HEIGHT, PWALL_O_HOR)
-PUTCI_OUTSHADE = UTCI_APPROX(PT_CAN - XTT, ZEHPA, PTRAD_SHADE - XTT, PU10)
+!! T%XBLD, T%XBLD_HEIGHT, T%XWALL_O_HOR, ZDIR_SW, ZZENITH)
+DUT%XTRAD_SHADE = TRAD_BODY(PSCA_SW,PREF_SW_FAC, PREF_SW_GRND, PEMIT_LW_FAC, PEMIT_LW_GRND, PLW_RAD,&
+ T%XBLD, T%XBLD_HEIGHT, T%XWALL_O_HOR)
+DUT%XUTCI_OUTSHADE = UTCI_APPROX(T%XT_CANYON - XTT, ZEHPA, DUT%XTRAD_SHADE - XTT, PU10)
IF (LHOOK) CALL DR_HOOK('UTCI_TEB',1,ZHOOK_HANDLE)
END SUBROUTINE UTCI_TEB
diff --git a/src/SURFEX/veg_from_lai.F90 b/src/SURFEX/veg_from_lai.F90
index 44eca5b1e469897eaf9d1123fe4bcbf05cda63cc..35862a451cd35022d0b2302adbea452465b27854 100644
--- a/src/SURFEX/veg_from_lai.F90
+++ b/src/SURFEX/veg_from_lai.F90
@@ -41,15 +41,14 @@ REAL, DIMENSION(SIZE(PLAI,1),SIZE(PLAI,2)) :: PVEG ! vegetation fraction
END FUNCTION VEG_FROM_LAI_2D
!
- FUNCTION VEG_FROM_LAI_PATCH_1D(PLAI,PVEGTYPE,OAGRI_TO_GRASS) RESULT(PVEG)
+ FUNCTION VEG_FROM_LAI_VEGTYPE_1D(PLAI,OAGRI_TO_GRASS) RESULT(PVEG)
!
REAL, DIMENSION(:), INTENT(IN) :: PLAI ! Leaf area Index for each vegtype
-REAL, DIMENSION(:), INTENT(IN) :: PVEGTYPE !
LOGICAL, INTENT(IN) :: OAGRI_TO_GRASS
!
REAL, DIMENSION(SIZE(PLAI)) :: PVEG ! vegetation fraction
!
-END FUNCTION VEG_FROM_LAI_PATCH_1D
+END FUNCTION VEG_FROM_LAI_VEGTYPE_1D
!
END INTERFACE
!
@@ -102,7 +101,8 @@ USE MODD_DATA_COVER_PAR, ONLY :NVT_NO, NVT_ROCK, NVT_SNOW, NVT_TEBD, &
NVT_BONE, NVT_TRBE, NVT_C3, NVT_C4, &
NVT_IRR, NVT_GRAS, NVT_TROG, NVT_PARK, &
NVT_TRBD, NVT_TEBE, NVT_TENE, NVT_BOBD, &
- NVT_BOND, NVT_BOGR, NVT_SHRB
+ NVT_BOND, NVT_BOGR, NVT_SHRB, NVT_C3W, &
+ NVT_C3S, NVT_FLTR, NVT_FLGR
!
USE MODD_REPROD_OPER, ONLY : XEVERG_VEG
!
@@ -121,7 +121,7 @@ REAL :: PVEG ! vegetation fraction
!
!* 0.2 declarations of local variables
!
-REAL :: ZLAI, ZAGRI
+REAL :: ZLAI, ZAGRI, ZSUM1, ZSUM2, ZSUM3
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-----------------------------------------------------------------
@@ -137,25 +137,33 @@ ELSE
ZAGRI = (1. - EXP( -0.6 * ZLAI ))
ENDIF
!
-PVEG = ZAGRI *(PVEGTYPE(NVT_C4 ) + &! C4 crops
- PVEGTYPE(NVT_IRR ) + &! irrigated crops
- PVEGTYPE(NVT_C3 ) ) &! C3 crops
- + 0.95 *(PVEGTYPE(NVT_TEBD) + &! TREE
- PVEGTYPE(NVT_TRBD) + &! TREE
- PVEGTYPE(NVT_TEBE) + &! TREE
- PVEGTYPE(NVT_BOBD) + &! TREE
- PVEGTYPE(NVT_SHRB) + &! TREE
- PVEGTYPE(NVT_BONE) + &! CONI
- PVEGTYPE(NVT_TENE) + &! CONI
- PVEGTYPE(NVT_BOND) ) &! CONI
+ZSUM1 = PVEGTYPE(NVT_C4)
+IF (NVT_IRR>0 .AND. NVT_C3>0) THEN
+ ZSUM1 = ZSUM1 + PVEGTYPE(NVT_IRR) + PVEGTYPE(NVT_C3)
+ELSEIF (NVT_C3W>0 .AND. NVT_C3S>0) THEN
+ ZSUM1 = ZSUM1 + PVEGTYPE(NVT_C3W) + PVEGTYPE(NVT_C3S)
+ENDIF
+!
+ZSUM2 = PVEGTYPE(NVT_TEBD) + PVEGTYPE(NVT_TRBD) + PVEGTYPE(NVT_TEBE) + &
+ PVEGTYPE(NVT_BOBD) + PVEGTYPE(NVT_SHRB) + PVEGTYPE(NVT_BONE) + &
+ PVEGTYPE(NVT_TENE) + PVEGTYPE(NVT_BOND)
+IF (NVT_FLTR>0) ZSUM2 = ZSUM2 + PVEGTYPE(NVT_FLTR)
+!
+ZSUM3 = PVEGTYPE(NVT_GRAS) + PVEGTYPE(NVT_BOGR) + PVEGTYPE(NVT_TROG)
+IF (NVT_PARK>0) THEN
+ ZSUM3 = ZSUM3 + PVEGTYPE(NVT_PARK)
+ELSEIF (NVT_FLGR>0) THEN
+ ZSUM3 = ZSUM3 + PVEGTYPE(NVT_FLGR)
+ENDIF
+!
+PVEG = ZAGRI * ZSUM1 &!
+ + 0.95 * ZSUM2 &!
+ XEVERG_VEG * PVEGTYPE(NVT_TRBE) &! EVER
- + 0.95 *(PVEGTYPE(NVT_GRAS) + &! grassland C3
- PVEGTYPE(NVT_BOGR) + &! boral grass C3
- PVEGTYPE(NVT_TROG) + &! tropical grass C4
- PVEGTYPE(NVT_PARK) ) &! irr. parks
+ + 0.95 * ZSUM3 &!
+ 0. * PVEGTYPE(NVT_NO ) &! no vegetation (smooth)
+ 0. * PVEGTYPE(NVT_SNOW) &! no vegetation (snow)
+ 0. * PVEGTYPE(NVT_ROCK) ! no vegetation (rocks)
+!
IF (LHOOK) CALL DR_HOOK('MODI_VEG_FROM_LAI:VEG_FROM_LAI_0D',1,ZHOOK_HANDLE)
!-----------------------------------------------------------------
!
@@ -206,7 +214,8 @@ USE MODD_DATA_COVER_PAR, ONLY : NVT_NO, NVT_ROCK, NVT_SNOW, NVT_TEBD, &
NVT_BONE, NVT_TRBE, NVT_C3, NVT_C4, &
NVT_IRR, NVT_GRAS, NVT_TROG, NVT_PARK, &
NVT_TRBD, NVT_TEBE, NVT_TENE, NVT_BOBD, &
- NVT_BOND, NVT_BOGR, NVT_SHRB
+ NVT_BOND, NVT_BOGR, NVT_SHRB, NVT_C3W, &
+ NVT_C3S, NVT_FLTR, NVT_FLGR
!
USE MODD_REPROD_OPER, ONLY : XEVERG_VEG
!
@@ -225,7 +234,7 @@ REAL, DIMENSION(SIZE(PLAI)) :: PVEG ! vegetation fraction
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(SIZE(PLAI)) :: ZLAI, ZAGRI
+REAL, DIMENSION(SIZE(PLAI)) :: ZLAI, ZAGRI, ZSUM1, ZSUM2, ZSUM3
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-----------------------------------------------------------------
@@ -241,22 +250,29 @@ ELSE
ZAGRI(:) = (1. - EXP( -0.6 * ZLAI(:) ))
ENDIF
!
-PVEG(:) = ZAGRI(:) *(PVEGTYPE(:,NVT_C4 ) + &! C4 crops
- PVEGTYPE(:,NVT_IRR ) + &! irrigated crops
- PVEGTYPE(:,NVT_C3 ) ) &! C3 crops
- + 0.95 *(PVEGTYPE(:,NVT_TEBD) + &! TREE
- PVEGTYPE(:,NVT_TRBD) + &! TREE
- PVEGTYPE(:,NVT_TEBE) + &! TREE
- PVEGTYPE(:,NVT_BOBD) + &! TREE
- PVEGTYPE(:,NVT_SHRB) + &! TREE
- PVEGTYPE(:,NVT_BONE) + &! CONI
- PVEGTYPE(:,NVT_TENE) + &! CONI
- PVEGTYPE(:,NVT_BOND) ) &! CONI
+ZSUM1(:) = PVEGTYPE(:,NVT_C4)
+IF (NVT_IRR>0 .AND. NVT_C3>0) THEN
+ ZSUM1(:) = ZSUM1(:) + PVEGTYPE(:,NVT_IRR) + PVEGTYPE(:,NVT_C3)
+ELSEIF (NVT_C3W>0 .AND. NVT_C3S>0) THEN
+ ZSUM1(:) = ZSUM1(:) + PVEGTYPE(:,NVT_C3W) + PVEGTYPE(:,NVT_C3S)
+ENDIF
+!
+ZSUM2(:) = PVEGTYPE(:,NVT_TEBD) + PVEGTYPE(:,NVT_TRBD) + PVEGTYPE(:,NVT_TEBE) + &
+ PVEGTYPE(:,NVT_BOBD) + PVEGTYPE(:,NVT_SHRB) + PVEGTYPE(:,NVT_BONE) + &
+ PVEGTYPE(:,NVT_TENE) + PVEGTYPE(:,NVT_BOND)
+IF (NVT_FLTR>0) ZSUM2(:) = ZSUM2(:) + PVEGTYPE(:,NVT_FLTR)
+!
+ZSUM3(:) = PVEGTYPE(:,NVT_GRAS) + PVEGTYPE(:,NVT_BOGR) + PVEGTYPE(:,NVT_TROG)
+IF (NVT_PARK>0) THEN
+ ZSUM3(:) = ZSUM3(:) + PVEGTYPE(:,NVT_PARK)
+ELSEIF (NVT_FLGR>0) THEN
+ ZSUM3(:) = ZSUM3(:) + PVEGTYPE(:,NVT_FLGR)
+ENDIF
+!
+PVEG(:) = ZAGRI(:) * ZSUM1(:) &
+ + 0.95 * ZSUM2(:) &
+ XEVERG_VEG * PVEGTYPE(:,NVT_TRBE) &! EVER
- + 0.95 *(PVEGTYPE(:,NVT_GRAS) + &! grassland C3
- PVEGTYPE(:,NVT_BOGR) + &! boral grass C3
- PVEGTYPE(:,NVT_TROG) + &! tropical grass C4
- PVEGTYPE(:,NVT_PARK) ) &! irr. parks
+ + 0.95 * ZSUM3(:) &
+ 0. * PVEGTYPE(:,NVT_NO ) &! no vegetation (smooth)
+ 0. * PVEGTYPE(:,NVT_SNOW) &! no vegetation (snow)
+ 0. * PVEGTYPE(:,NVT_ROCK) ! no vegetation (rocks)
@@ -312,7 +328,8 @@ USE MODD_DATA_COVER_PAR, ONLY : NVT_NO, NVT_ROCK, NVT_SNOW, NVT_TEBD, &
NVT_BONE, NVT_TRBE, NVT_C3, NVT_C4, &
NVT_IRR, NVT_GRAS, NVT_TROG, NVT_PARK, &
NVT_TRBD, NVT_TEBE, NVT_TENE, NVT_BOBD, &
- NVT_BOND, NVT_BOGR, NVT_SHRB
+ NVT_BOND, NVT_BOGR, NVT_SHRB, NVT_C3W, &
+ NVT_C3S, NVT_FLTR, NVT_FLGR
USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE MODD_REPROD_OPER, ONLY : XEVERG_VEG
@@ -332,7 +349,7 @@ REAL, DIMENSION(SIZE(PLAI,1),SIZE(PLAI,2)) :: PVEG ! vegetation fraction
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(SIZE(PLAI,1),SIZE(PLAI,2)) :: ZLAI, ZAGRI
+REAL, DIMENSION(SIZE(PLAI,1),SIZE(PLAI,2)) :: ZLAI, ZAGRI, ZSUM1, ZSUM2, ZSUM3
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-----------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('MODI_VEG_FROM_LAI:VEG_FROM_LAI_2D',0,ZHOOK_HANDLE)
@@ -353,23 +370,30 @@ ELSE
ENDWHERE
ENDIF
!
+ZSUM1(:,:) = PVEGTYPE(:,:,NVT_C4)
+IF (NVT_IRR>0 .AND. NVT_C3>0) THEN
+ ZSUM1(:,:) = ZSUM1(:,:) + PVEGTYPE(:,:,NVT_IRR) + PVEGTYPE(:,:,NVT_C3)
+ELSEIF (NVT_C3W>0 .AND. NVT_C3S>0) THEN
+ ZSUM1(:,:) = ZSUM1(:,:) + PVEGTYPE(:,:,NVT_C3W) + PVEGTYPE(:,:,NVT_C3S)
+ENDIF
+!
+ZSUM2(:,:) = PVEGTYPE(:,:,NVT_TEBD) + PVEGTYPE(:,:,NVT_TRBD) + PVEGTYPE(:,:,NVT_TEBE) + &
+ PVEGTYPE(:,:,NVT_BOBD) + PVEGTYPE(:,:,NVT_SHRB) + PVEGTYPE(:,:,NVT_BONE) + &
+ PVEGTYPE(:,:,NVT_TENE) + PVEGTYPE(:,:,NVT_BOND)
+IF (NVT_FLTR>0) ZSUM2(:,:) = ZSUM2(:,:) + PVEGTYPE(:,:,NVT_FLTR)
+!
+ZSUM3(:,:) = PVEGTYPE(:,:,NVT_GRAS) + PVEGTYPE(:,:,NVT_BOGR) + PVEGTYPE(:,:,NVT_TROG)
+IF (NVT_PARK>0) THEN
+ ZSUM3(:,:) = ZSUM3(:,:) + PVEGTYPE(:,:,NVT_PARK)
+ELSEIF (NVT_FLGR>0) THEN
+ ZSUM3(:,:) = ZSUM3(:,:) + PVEGTYPE(:,:,NVT_FLGR)
+ENDIF
+!
WHERE (PLAI(:,:) /= XUNDEF)
-PVEG(:,:) = ZAGRI(:,:) *(PVEGTYPE(:,:,NVT_C4 ) + &! C4 crops
- PVEGTYPE(:,:,NVT_IRR ) + &! irrigated crops
- PVEGTYPE(:,:,NVT_C3 ) ) &! C3 crops
- + 0.95 *(PVEGTYPE(:,:,NVT_TEBD) + &! TREE
- PVEGTYPE(:,:,NVT_TRBD) + &! TREE
- PVEGTYPE(:,:,NVT_TEBE) + &! TREE
- PVEGTYPE(:,:,NVT_BOBD) + &! TREE
- PVEGTYPE(:,:,NVT_SHRB) + &! TREE
- PVEGTYPE(:,:,NVT_BONE) + &! CONI
- PVEGTYPE(:,:,NVT_TENE) + &! CONI
- PVEGTYPE(:,:,NVT_BOND) ) &! CONI
+PVEG(:,:) = ZAGRI(:,:) * ZSUM1(:,:) &
+ + 0.95 * ZSUM2(:,:) &
+ XEVERG_VEG * PVEGTYPE(:,:,NVT_TRBE) &! EVER
- + 0.95 *(PVEGTYPE(:,:,NVT_GRAS) + &! grassland C3
- PVEGTYPE(:,:,NVT_BOGR) + &! boral grass C3
- PVEGTYPE(:,:,NVT_TROG) + &! tropical grass C4
- PVEGTYPE(:,:,NVT_PARK) ) &! irr. parks
+ + 0.95 * ZSUM3(:,:) &
+ 0. * PVEGTYPE(:,:,NVT_NO ) &! no vegetation (smooth)
+ 0. * PVEGTYPE(:,:,NVT_SNOW) &! no vegetation (snow)
+ 0. * PVEGTYPE(:,:,NVT_ROCK) ! no vegetation (rocks)
@@ -383,7 +407,7 @@ END FUNCTION VEG_FROM_LAI_2D
!
!
! ####################################################
- FUNCTION VEG_FROM_LAI_PATCH_1D(PLAI,PVEGTYPE,OAGRI_TO_GRASS) RESULT(PVEG)
+ FUNCTION VEG_FROM_LAI_VEGTYPE_1D(PLAI,OAGRI_TO_GRASS) RESULT(PVEG)
! ####################################################
!!
!! PURPOSE
@@ -427,7 +451,8 @@ USE MODD_DATA_COVER_PAR, ONLY : NVT_NO, NVT_ROCK, NVT_SNOW, NVT_TEBD, &
NVT_BONE, NVT_TRBE, NVT_C3, NVT_C4, &
NVT_IRR, NVT_GRAS, NVT_TROG, NVT_PARK, &
NVT_TRBD, NVT_TEBE, NVT_TENE, NVT_BOBD, &
- NVT_BOND, NVT_BOGR, NVT_SHRB
+ NVT_BOND, NVT_BOGR, NVT_SHRB, NVT_C3W, &
+ NVT_C3S, NVT_FLTR, NVT_FLGR
USE MODD_SURF_PAR, ONLY : XUNDEF
!
@@ -441,51 +466,69 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
REAL, DIMENSION(:), INTENT(IN) :: PLAI ! Leaf area Index
-REAL, DIMENSION(:), INTENT(IN) :: PVEGTYPE ! type of vegetation
LOGICAL, INTENT(IN) :: OAGRI_TO_GRASS
!
REAL, DIMENSION(SIZE(PLAI)) :: PVEG ! vegetation fraction
!
!* 0.2 declarations of local variables
!
-REAL, DIMENSION(SIZE(PLAI)) :: ZLAI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-----------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('MODI_VEG_FROM_LAI:VEG_FROM_LAI_PATCH_1D',0,ZHOOK_HANDLE)
-ZLAI(:) = PLAI(:)
+IF (LHOOK) CALL DR_HOOK('MODI_VEG_FROM_LAI:VEG_FROM_LAI_VEGTYPE_1D',0,ZHOOK_HANDLE)
PVEG(:) = XUNDEF
!
IF(OAGRI_TO_GRASS)THEN
- IF (PVEGTYPE(NVT_C4 )>0.) PVEG(NVT_C4 )= 0.95
- IF (PVEGTYPE(NVT_IRR )>0.) PVEG(NVT_IRR )= 0.95
- IF (PVEGTYPE(NVT_C3 )>0.) PVEG(NVT_C3 )= 0.95
+ PVEG(NVT_C4 )= 0.95
+ IF (NVT_IRR>0) THEN
+ PVEG(NVT_IRR )= 0.95
+ ENDIF
+ IF (NVT_C3>0) THEN
+ PVEG(NVT_C3 )= 0.95
+ ELSEIF (NVT_C3W>0 .AND. NVT_C3S>0) THEN
+ PVEG(NVT_C3W )= 0.95
+ PVEG(NVT_C3S )= 0.95
+ ENDIF
ELSE
- IF (PVEGTYPE(NVT_C4 )>0.) PVEG(NVT_C4 )= 1. - EXP( -0.6 * ZLAI(NVT_C4 ) )
- IF (PVEGTYPE(NVT_IRR )>0.) PVEG(NVT_IRR )= 1. - EXP( -0.6 * ZLAI(NVT_IRR ) )
- IF (PVEGTYPE(NVT_C3 )>0.) PVEG(NVT_C3 )= 1. - EXP( -0.6 * ZLAI(NVT_C3 ) )
+ IF (PLAI(NVT_C4)/=XUNDEF) PVEG(NVT_C4 )= 1. - EXP( -0.6 * PLAI(NVT_C4 ) )
+ IF (NVT_IRR>0) THEN
+ IF (PLAI(NVT_IRR)/=XUNDEF) PVEG(NVT_IRR )= 1. - EXP( -0.6 * PLAI(NVT_IRR ) )
+ ENDIF
+ IF (NVT_C3>0) THEN
+ IF (PLAI(NVT_C3)/=XUNDEF) PVEG(NVT_C3 )= 1. - EXP( -0.6 * PLAI(NVT_C3 ) )
+ ELSEIF (NVT_C3W>0 .AND. NVT_C3S>0) THEN
+ IF (PLAI(NVT_C3W)/=XUNDEF) PVEG(NVT_C3W )= 1. - EXP( -0.6 * PLAI(NVT_C3W ) )
+ IF (PLAI(NVT_C3S)/=XUNDEF) PVEG(NVT_C3S )= 1. - EXP( -0.6 * PLAI(NVT_C3S ) )
+ ENDIF
+ENDIF
+!
+PVEG(NVT_TEBD)= 0.95
+PVEG(NVT_TRBD)= 0.95
+PVEG(NVT_TEBE)= 0.95
+PVEG(NVT_BOBD)= 0.95
+PVEG(NVT_SHRB)= 0.95
+PVEG(NVT_BONE)= 0.95
+PVEG(NVT_TENE)= 0.95
+PVEG(NVT_BOND)= 0.95
+IF (NVT_FLTR>0) THEN
+ PVEG(NVT_FLTR)= 0.95
ENDIF
+PVEG(NVT_TRBE)= XEVERG_VEG
+!
+PVEG(NVT_GRAS)= 0.95
+PVEG(NVT_BOGR)= 0.95
+PVEG(NVT_TROG)= 0.95
+IF (NVT_PARK>0) THEN
+ PVEG(NVT_PARK)= 0.95
+ELSEIF (NVT_FLGR>0) THEN
+ PVEG(NVT_FLGR)= 0.95
+ENDIF
+!
+PVEG(NVT_NO )= 0.
+PVEG(NVT_SNOW)= 0.
+PVEG(NVT_ROCK)= 0.
+IF (LHOOK) CALL DR_HOOK('MODI_VEG_FROM_LAI:VEG_FROM_LAI_VEGTYPE_1D',1,ZHOOK_HANDLE)
!
-IF (PVEGTYPE(NVT_TEBD)>0.) PVEG(NVT_TEBD)= 0.95
-IF (PVEGTYPE(NVT_TRBD)>0.) PVEG(NVT_TRBD)= 0.95
-IF (PVEGTYPE(NVT_TEBE)>0.) PVEG(NVT_TEBE)= 0.95
-IF (PVEGTYPE(NVT_BOBD)>0.) PVEG(NVT_BOBD)= 0.95
-IF (PVEGTYPE(NVT_SHRB)>0.) PVEG(NVT_SHRB)= 0.95
-IF (PVEGTYPE(NVT_BONE)>0.) PVEG(NVT_BONE)= 0.95
-IF (PVEGTYPE(NVT_TENE)>0.) PVEG(NVT_TENE)= 0.95
-IF (PVEGTYPE(NVT_BOND)>0.) PVEG(NVT_BOND)= 0.95
-IF (PVEGTYPE(NVT_TRBE)>0.) PVEG(NVT_TRBE)= XEVERG_VEG
-!
-IF (PVEGTYPE(NVT_GRAS)>0.) PVEG(NVT_GRAS)= 0.95
-IF (PVEGTYPE(NVT_BOGR)>0.) PVEG(NVT_BOGR)= 0.95
-IF (PVEGTYPE(NVT_TROG)>0.) PVEG(NVT_TROG)= 0.95
-IF (PVEGTYPE(NVT_PARK)>0.) PVEG(NVT_PARK)= 0.95
-!
-IF (PVEGTYPE(NVT_NO )>0.) PVEG(NVT_NO )= 0.
-IF (PVEGTYPE(NVT_SNOW)>0.) PVEG(NVT_SNOW)= 0.
-IF (PVEGTYPE(NVT_ROCK)>0.) PVEG(NVT_ROCK)= 0.
-IF (LHOOK) CALL DR_HOOK('MODI_VEG_FROM_LAI:VEG_FROM_LAI_PATCH_1D',1,ZHOOK_HANDLE)
-!
-END FUNCTION VEG_FROM_LAI_PATCH_1D
+END FUNCTION VEG_FROM_LAI_VEGTYPE_1D
!
!--------------------------------------------
!
diff --git a/src/SURFEX/veg_height_from_lai.F90 b/src/SURFEX/veg_height_from_lai.F90
index edb2319ebd537eea3f6b6d0b7150e38f620ef4fb..1985e67f4ebbb51efefea0532150e4b737c7817c 100644
--- a/src/SURFEX/veg_height_from_lai.F90
+++ b/src/SURFEX/veg_height_from_lai.F90
@@ -43,16 +43,15 @@ REAL, DIMENSION(SIZE(PVEGTYPE,1),SIZE(PVEGTYPE,2),SIZE(PVEGTYPE,3)) :: PH_VEG
!
END FUNCTION VEG_HEIGHT_FROM_LAI_2D
!
- FUNCTION VEG_HEIGHT_FROM_LAI_PATCH(PLAI,PH_TREE,PVEGTYPE,OAGRI_TO_GRASS) RESULT(PH_VEG)
+ FUNCTION VEG_HEIGHT_FROM_LAI_VEGTYPE(PLAI,PH_TREE,OAGRI_TO_GRASS) RESULT(PH_VEG)
!
REAL, DIMENSION(:), INTENT(IN) :: PLAI ! Leaf area Index
REAL, DIMENSION(:), INTENT(IN) :: PH_TREE ! height of trees
-REAL, DIMENSION(:), INTENT(IN) :: PVEGTYPE ! type of vegetation
LOGICAL, INTENT(IN) :: OAGRI_TO_GRASS
!
-REAL, DIMENSION(SIZE(PVEGTYPE)) :: PH_VEG ! vegetation height
+REAL, DIMENSION(SIZE(PLAI)) :: PH_VEG ! vegetation height
!
-END FUNCTION VEG_HEIGHT_FROM_LAI_PATCH
+END FUNCTION VEG_HEIGHT_FROM_LAI_VEGTYPE
!
END INTERFACE
!
@@ -106,7 +105,8 @@ USE MODD_DATA_COVER_PAR, ONLY : NVT_NO, NVT_ROCK, NVT_SNOW, NVT_PARK, &
NVT_TEBD, NVT_BONE, NVT_TRBE, NVT_TRBD, &
NVT_TEBE, NVT_TENE, NVT_BOBD, NVT_BOND, &
NVT_SHRB, NVT_C3, NVT_C4, NVT_IRR, &
- NVT_GRAS, NVT_BOGR, NVT_TROG
+ NVT_GRAS, NVT_BOGR, NVT_TROG, NVT_C3W, &
+ NVT_C3S, NVT_FLTR, NVT_FLGR
USE MODD_TREEDRAG, ONLY : LTREEDRAG
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -149,7 +149,11 @@ IF ( PLAI /= XUNDEF) THEN
ZALLEN_H = EXP((ZLAI-3.5)/(1.3))
END IF
!
-PH_VEG(NVT_PARK) = ZLAI / 6. ! irr. grassland
+IF (NVT_PARK>0) THEN
+ PH_VEG(NVT_PARK) = ZLAI / 6. ! irr. grassland
+ELSEIF (NVT_FLGR>0) THEN
+ PH_VEG(NVT_FLGR) = ZLAI / 6.
+ENDIF
IF (LTREEDRAG) THEN
PH_VEG(NVT_TEBD) = ZLAI / 6. ! forest
PH_VEG(NVT_BONE) = ZLAI / 6. ! forest
@@ -160,6 +164,7 @@ IF (LTREEDRAG) THEN
PH_VEG(NVT_BOBD) = ZLAI / 6. ! forest
PH_VEG(NVT_BOND) = ZLAI / 6. ! forest
PH_VEG(NVT_SHRB) = ZLAI / 6. ! forest
+ IF (NVT_FLTR>0) PH_VEG(NVT_FLTR) = ZLAI / 6.
ELSE
PH_VEG(NVT_TEBD) = PH_TREE ! forest
PH_VEG(NVT_BONE) = PH_TREE ! forest
@@ -170,18 +175,29 @@ ELSE
PH_VEG(NVT_BOBD) = PH_TREE ! forest
PH_VEG(NVT_BOND) = PH_TREE ! forest
PH_VEG(NVT_SHRB) = PH_TREE ! forest
+ IF (NVT_FLTR>0) PH_VEG(NVT_FLTR) = PH_TREE
END IF
PH_VEG(NVT_GRAS) = ZLAI / 6. ! grassland
PH_VEG(NVT_BOGR) = ZLAI / 6. ! boreal grassland
PH_VEG(NVT_TROG) = ZLAI / 6. ! tropical grassland
IF(OAGRI_TO_GRASS)THEN
- PH_VEG(NVT_C3 ) = ZLAI / 6.
+ IF (NVT_C3>0) THEN
+ PH_VEG(NVT_C3 ) = ZLAI / 6.
+ ELSEIF (NVT_C3W>0 .AND. NVT_C3S>0) THEN
+ PH_VEG(NVT_C3W ) = ZLAI / 6.
+ PH_VEG(NVT_C3S ) = ZLAI / 6.
+ ENDIF
PH_VEG(NVT_C4 ) = ZLAI / 6.
- PH_VEG(NVT_IRR ) = ZLAI / 6.
+ IF (NVT_IRR>0) PH_VEG(NVT_IRR ) = ZLAI / 6.
ELSE
- PH_VEG(NVT_C3 ) = MIN(1. , ZALLEN_H ) ! cultures
+ IF (NVT_C3>0) THEN
+ PH_VEG(NVT_C3 ) = MIN(1. , ZALLEN_H ) ! cultures
+ ELSEIF (NVT_C3W>0 .AND. NVT_C3S>0) THEN
+ PH_VEG(NVT_C3W ) = MIN(1. , ZALLEN_H )
+ PH_VEG(NVT_C3S ) = MIN(1. , ZALLEN_H )
+ ENDIF
PH_VEG(NVT_C4 ) = MIN(2.5, ZALLEN_H ) ! C4 types
- PH_VEG(NVT_IRR ) = MIN(2.5, ZALLEN_H ) ! irrigated crops (as C4)
+ IF (NVT_IRR>0) PH_VEG(NVT_IRR ) = MIN(2.5, ZALLEN_H ) ! irrigated crops (as C4)
ENDIF
PH_VEG(NVT_NO ) = 0.1 ! no vegetation (smooth)
PH_VEG(NVT_ROCK) = 1. ! no vegetation (rocks)
@@ -240,7 +256,8 @@ USE MODD_DATA_COVER_PAR, ONLY : NVT_NO, NVT_ROCK, NVT_SNOW, NVT_PARK, &
NVT_TEBD, NVT_BONE, NVT_TRBE, NVT_TRBD, &
NVT_TEBE, NVT_TENE, NVT_BOBD, NVT_BOND, &
NVT_SHRB, NVT_C3, NVT_C4, NVT_IRR, &
- NVT_GRAS, NVT_BOGR, NVT_TROG
+ NVT_GRAS, NVT_BOGR, NVT_TROG, NVT_C3W, &
+ NVT_C3S, NVT_FLTR, NVT_FLGR
USE MODD_TREEDRAG, ONLY : LTREEDRAG
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -286,7 +303,12 @@ WHERE (PLAI(:) /= XUNDEF)
END WHERE
!
!
-PH_VEG(:,NVT_PARK) = ZLAI(:) / 6. ! irr. grassland
+IF (NVT_PARK>0) THEN
+ PH_VEG(:,NVT_PARK) = ZLAI(:) / 6. ! irr. grassland
+ELSEIF (NVT_FLGR>0) THEN
+ PH_VEG(:,NVT_FLGR) = ZLAI(:) / 6.
+ENDIF
+!
IF (LTREEDRAG) THEN
PH_VEG(:,NVT_TEBD) = ZLAI(:) / 6. ! forest
PH_VEG(:,NVT_BONE) = ZLAI(:) / 6. ! forest
@@ -297,6 +319,7 @@ IF (LTREEDRAG) THEN
PH_VEG(:,NVT_BOBD) = ZLAI(:) / 6. ! forest
PH_VEG(:,NVT_BOND) = ZLAI(:) / 6. ! forest
PH_VEG(:,NVT_SHRB) = ZLAI(:) / 6. ! forest
+ IF (NVT_FLTR>0) PH_VEG(:,NVT_FLTR) = ZLAI(:) / 6.
ELSE
PH_VEG(:,NVT_TEBD) = PH_TREE(:) ! forest
PH_VEG(:,NVT_BONE) = PH_TREE(:) ! forest
@@ -306,19 +329,30 @@ ELSE
PH_VEG(:,NVT_TENE) = PH_TREE(:) ! forest
PH_VEG(:,NVT_BOBD) = PH_TREE(:) ! forest
PH_VEG(:,NVT_BOND) = PH_TREE(:) ! forest
- PH_VEG(:,NVT_SHRB) = PH_TREE(:) ! forest
+ PH_VEG(:,NVT_SHRB) = PH_TREE(:) ! forest
+ IF (NVT_FLTR>0) PH_VEG(:,NVT_FLTR) = PH_TREE(:)
END IF
PH_VEG(:,NVT_GRAS) = ZLAI(:) / 6. ! grassland
PH_VEG(:,NVT_BOGR) = ZLAI(:) / 6. ! boreal grassland
PH_VEG(:,NVT_TROG) = ZLAI(:) / 6. ! tropical grassland
IF(OAGRI_TO_GRASS)THEN
- PH_VEG(:,NVT_C3 ) = ZLAI(:) / 6.
+ IF (NVT_C3>0) THEN
+ PH_VEG(:,NVT_C3 ) = ZLAI(:) / 6.
+ ELSEIF (NVT_C3W>0 .AND. NVT_C3S>0) THEN
+ PH_VEG(:,NVT_C3W ) = ZLAI(:) / 6.
+ PH_VEG(:,NVT_C3S ) = ZLAI(:) / 6.
+ ENDIF
PH_VEG(:,NVT_C4 ) = ZLAI(:) / 6.
- PH_VEG(:,NVT_IRR ) = ZLAI(:) / 6.
+ IF (NVT_IRR>0) PH_VEG(:,NVT_IRR ) = ZLAI(:) / 6.
ELSE
- PH_VEG(:,NVT_C3 ) = MIN(1. , ZALLEN_H(:) ) ! cultures
+ IF (NVT_C3>0) THEN
+ PH_VEG(:,NVT_C3 ) = MIN(1. , ZALLEN_H(:) ) ! cultures
+ ELSEIF (NVT_C3W>0 .AND. NVT_C3S>0) THEN
+ PH_VEG(:,NVT_C3W ) = MIN(1. , ZALLEN_H(:) )
+ PH_VEG(:,NVT_C3S ) = MIN(1. , ZALLEN_H(:) )
+ ENDIF
PH_VEG(:,NVT_C4 ) = MIN(2.5, ZALLEN_H(:) ) ! C4 types
- PH_VEG(:,NVT_IRR ) = MIN(2.5, ZALLEN_H(:) ) ! irrigated crops (as C4)
+ IF (NVT_IRR>0) PH_VEG(:,NVT_IRR ) = MIN(2.5, ZALLEN_H(:) ) ! irrigated crops (as C4)
ENDIF
PH_VEG(:,NVT_NO ) = 0.1 ! no vegetation (smooth)
PH_VEG(:,NVT_ROCK) = 1. ! no vegetation (rocks)
@@ -376,7 +410,8 @@ USE MODD_DATA_COVER_PAR, ONLY : NVT_NO, NVT_ROCK, NVT_SNOW, NVT_PARK, &
NVT_TEBD, NVT_BONE, NVT_TRBE, NVT_TRBD, &
NVT_TEBE, NVT_TENE, NVT_BOBD, NVT_BOND, &
NVT_SHRB, NVT_C3, NVT_C4, NVT_IRR, &
- NVT_GRAS, NVT_BOGR, NVT_TROG
+ NVT_GRAS, NVT_BOGR, NVT_TROG, NVT_C3W, &
+ NVT_C3S, NVT_FLTR, NVT_FLGR
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_TREEDRAG, ONLY : LTREEDRAG
!
@@ -424,7 +459,12 @@ WHERE(PLAI(:,:)/=XUNDEF)
END WHERE
!
!
-PH_VEG(:,:,NVT_PARK) = ZLAI(:,:) / 6. ! irr. grassland
+IF (NVT_PARK>0) THEN
+ PH_VEG(:,:,NVT_PARK) = ZLAI(:,:) / 6. ! irr. grassland
+ELSEIF (NVT_FLGR>0) THEN
+ PH_VEG(:,:,NVT_FLGR) = ZLAI(:,:) / 6.
+ENDIF
+!
IF (LTREEDRAG) THEN
PH_VEG(:,:,NVT_TEBD) = ZLAI(:,:) / 6. ! forest
PH_VEG(:,:,NVT_BONE) = ZLAI(:,:) / 6. ! forest
@@ -435,6 +475,7 @@ IF (LTREEDRAG) THEN
PH_VEG(:,:,NVT_BOBD) = ZLAI(:,:) / 6. ! forest
PH_VEG(:,:,NVT_BOND) = ZLAI(:,:) / 6. ! forest
PH_VEG(:,:,NVT_SHRB) = ZLAI(:,:) / 6. ! forest
+ IF (NVT_FLTR>0) PH_VEG(:,:,NVT_FLTR) = ZLAI(:,:) / 6.
ELSE
PH_VEG(:,:,NVT_TEBD) = PH_TREE(:,:) ! forest
PH_VEG(:,:,NVT_BONE) = PH_TREE(:,:) ! forest
@@ -445,18 +486,29 @@ ELSE
PH_VEG(:,:,NVT_BOBD) = PH_TREE(:,:) ! forest
PH_VEG(:,:,NVT_BOND) = PH_TREE(:,:) ! forest
PH_VEG(:,:,NVT_SHRB) = PH_TREE(:,:) ! forest
+ IF (NVT_FLTR>0) PH_VEG(:,:,NVT_FLTR) = PH_TREE(:,:)
END IF
PH_VEG(:,:,NVT_GRAS) = ZLAI(:,:) / 6. ! grassland
PH_VEG(:,:,NVT_BOGR) = ZLAI(:,:) / 6. ! boreal grassland
PH_VEG(:,:,NVT_TROG) = ZLAI(:,:) / 6. ! tropical grassland
IF(OAGRI_TO_GRASS)THEN
- PH_VEG(:,:,NVT_C3 ) = ZLAI(:,:) / 6.
+ IF (NVT_C3>0) THEN
+ PH_VEG(:,:,NVT_C3 ) = ZLAI(:,:) / 6.
+ ELSEIF (NVT_C3W>0 .AND. NVT_C3S>0) THEN
+ PH_VEG(:,:,NVT_C3W ) = ZLAI(:,:) / 6.
+ PH_VEG(:,:,NVT_C3S ) = ZLAI(:,:) / 6.
+ ENDIF
PH_VEG(:,:,NVT_C4 ) = ZLAI(:,:) / 6.
- PH_VEG(:,:,NVT_IRR ) = ZLAI(:,:) / 6.
+ IF (NVT_IRR>0) PH_VEG(:,:,NVT_IRR ) = ZLAI(:,:) / 6.
ELSE
- PH_VEG(:,:,NVT_C3 ) = MIN(1. , ZALLEN_H(:,:) ) ! cultures
+ IF (NVT_C3>0) THEN
+ PH_VEG(:,:,NVT_C3 ) = MIN(1. , ZALLEN_H(:,:) ) ! cultures
+ ELSEIF (NVT_C3W>0 .AND. NVT_C3S>0) THEN
+ PH_VEG(:,:,NVT_C3W ) = MIN(2.5, ZALLEN_H(:,:) )
+ PH_VEG(:,:,NVT_C3S ) = MIN(2.5, ZALLEN_H(:,:) )
+ ENDIF
PH_VEG(:,:,NVT_C4 ) = MIN(2.5, ZALLEN_H(:,:) ) ! C4 types
- PH_VEG(:,:,NVT_IRR ) = MIN(2.5, ZALLEN_H(:,:) ) ! irrigated crops (as C4)
+ IF (NVT_IRR>0) PH_VEG(:,:,NVT_IRR ) = MIN(2.5, ZALLEN_H(:,:) ) ! irrigated crops (as C4)
ENDIF
PH_VEG(:,:,NVT_NO ) = 0.1 ! no vegetation (smooth)
PH_VEG(:,:,NVT_ROCK) = 1. ! no vegetation (rocks)
@@ -472,7 +524,7 @@ END FUNCTION VEG_HEIGHT_FROM_LAI_2D
!
!
! ###########################################################
- FUNCTION VEG_HEIGHT_FROM_LAI_PATCH(PLAI,PH_TREE,PVEGTYPE,OAGRI_TO_GRASS) RESULT(PH_VEG)
+ FUNCTION VEG_HEIGHT_FROM_LAI_VEGTYPE(PLAI,PH_TREE,OAGRI_TO_GRASS) RESULT(PH_VEG)
! ###########################################################
!!
!! PURPOSE
@@ -516,7 +568,8 @@ USE MODD_DATA_COVER_PAR, ONLY : NVT_NO, NVT_ROCK, NVT_SNOW, NVT_PARK, &
NVT_TEBD, NVT_BONE, NVT_TRBE, NVT_TRBD, &
NVT_TEBE, NVT_TENE, NVT_BOBD, NVT_BOND, &
NVT_SHRB, NVT_C3, NVT_C4, NVT_IRR, &
- NVT_GRAS, NVT_BOGR, NVT_TROG
+ NVT_GRAS, NVT_BOGR, NVT_TROG, NVT_C3W, &
+ NVT_C3S, NVT_FLTR, NVT_FLGR
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_TREEDRAG, ONLY : LTREEDRAG
!
@@ -529,10 +582,9 @@ IMPLICIT NONE
!
REAL, DIMENSION(:), INTENT(IN) :: PLAI ! Leaf area Index
REAL, DIMENSION(:), INTENT(IN) :: PH_TREE ! height of trees
-REAL, DIMENSION(:), INTENT(IN) :: PVEGTYPE ! type of vegetation
LOGICAL, INTENT(IN) :: OAGRI_TO_GRASS
!
-REAL, DIMENSION(SIZE(PVEGTYPE)) :: PH_VEG ! vegetation height
+REAL, DIMENSION(SIZE(PLAI)) :: PH_VEG ! vegetation height
!
!* 0.2 declarations of local variables
!
@@ -540,60 +592,85 @@ REAL, DIMENSION(SIZE(PLAI)) :: ZALLEN_H ! Allen formula for height
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-----------------------------------------------------------------
!
-IF (LHOOK) CALL DR_HOOK('MODI_VEG_HEIGHT_FROM_LAI:VEG_HEIGHT_FROM_LAI_PATCH',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('MODI_VEG_HEIGHT_FROM_LAI:VEG_HEIGHT_FROM_LAI_VEGTYPE',0,ZHOOK_HANDLE)
!
!
!-----------------------------------------------------------------
!
PH_VEG(:) = XUNDEF
!
+ZALLEN_H(:) = XUNDEF
WHERE (PLAI(:)/= XUNDEF)
ZALLEN_H(:) = EXP((PLAI(:)-3.5)/(1.3))
END WHERE
!
!
-IF (PVEGTYPE(NVT_PARK)>0.) PH_VEG(NVT_PARK) = PLAI(NVT_PARK) / 6. ! irr. grasslands
+IF (NVT_PARK>0) THEN
+ IF (PLAI(NVT_PARK)/=XUNDEF) PH_VEG(NVT_PARK) = PLAI(NVT_PARK) / 6. ! irr. grasslands
+ELSEIF (NVT_FLGR>0) THEN
+ IF (PLAI(NVT_FLGR)/=XUNDEF) PH_VEG(NVT_FLGR) = PLAI(NVT_FLGR) / 6.
+ENDIF
IF (LTREEDRAG) THEN
- IF (PVEGTYPE(NVT_TEBD)>0.) PH_VEG(NVT_TEBD) = PLAI(NVT_TEBD) / 6. ! broadleaf forest
- IF (PVEGTYPE(NVT_BONE)>0.) PH_VEG(NVT_BONE) = PLAI(NVT_BONE) / 6. ! coniferous forest
- IF (PVEGTYPE(NVT_TRBE)>0.) PH_VEG(NVT_TRBE) = PLAI(NVT_TRBE) / 6. ! euqatorial forest
- IF (PVEGTYPE(NVT_TRBD)>0.) PH_VEG(NVT_TRBD) = PLAI(NVT_TRBD) / 6. ! broadleaf forest
- IF (PVEGTYPE(NVT_TEBE)>0.) PH_VEG(NVT_TEBE) = PLAI(NVT_TEBE) / 6. ! coniferous forest
- IF (PVEGTYPE(NVT_TENE)>0.) PH_VEG(NVT_TENE) = PLAI(NVT_TENE) / 6. ! euqatorial forest
- IF (PVEGTYPE(NVT_BOBD)>0.) PH_VEG(NVT_BOBD) = PLAI(NVT_BOBD) / 6. ! broadleaf forest
- IF (PVEGTYPE(NVT_BOND)>0.) PH_VEG(NVT_BOND) = PLAI(NVT_BOND) / 6. ! coniferous forest
- IF (PVEGTYPE(NVT_SHRB)>0.) PH_VEG(NVT_SHRB) = PLAI(NVT_SHRB) / 6. ! euqatorial forest
+ IF (PLAI(NVT_TEBD)/=XUNDEF) PH_VEG(NVT_TEBD) = PLAI(NVT_TEBD) / 6. ! broadleaf forest
+ IF (PLAI(NVT_BONE)/=XUNDEF) PH_VEG(NVT_BONE) = PLAI(NVT_BONE) / 6. ! coniferous forest
+ IF (PLAI(NVT_TRBE)/=XUNDEF) PH_VEG(NVT_TRBE) = PLAI(NVT_TRBE) / 6. ! euqatorial forest
+ IF (PLAI(NVT_TRBD)/=XUNDEF) PH_VEG(NVT_TRBD) = PLAI(NVT_TRBD) / 6. ! broadleaf forest
+ IF (PLAI(NVT_TEBE)/=XUNDEF) PH_VEG(NVT_TEBE) = PLAI(NVT_TEBE) / 6. ! coniferous forest
+ IF (PLAI(NVT_TENE)/=XUNDEF) PH_VEG(NVT_TENE) = PLAI(NVT_TENE) / 6. ! euqatorial forest
+ IF (PLAI(NVT_BOBD)/=XUNDEF) PH_VEG(NVT_BOBD) = PLAI(NVT_BOBD) / 6. ! broadleaf forest
+ IF (PLAI(NVT_BOND)/=XUNDEF) PH_VEG(NVT_BOND) = PLAI(NVT_BOND) / 6. ! coniferous forest
+ IF (PLAI(NVT_SHRB)/=XUNDEF) PH_VEG(NVT_SHRB) = PLAI(NVT_SHRB) / 6. ! euqatorial forest
+ IF (NVT_FLTR>0) THEN
+ IF (PLAI(NVT_FLTR)/=XUNDEF) PH_VEG(NVT_FLTR) = PLAI(NVT_FLTR) / 6.
+ ENDIF
ELSE
- IF (PVEGTYPE(NVT_TEBD)>0.) PH_VEG(NVT_TEBD) = PH_TREE(NVT_TEBD) ! broadleaf forest
- IF (PVEGTYPE(NVT_BONE)>0.) PH_VEG(NVT_BONE) = PH_TREE(NVT_BONE) ! coniferous forest
- IF (PVEGTYPE(NVT_TRBE)>0.) PH_VEG(NVT_TRBE) = PH_TREE(NVT_TRBE) ! euqatorial forest
- IF (PVEGTYPE(NVT_TRBD)>0.) PH_VEG(NVT_TRBD) = PH_TREE(NVT_TRBD) ! broadleaf forest
- IF (PVEGTYPE(NVT_TEBE)>0.) PH_VEG(NVT_TEBE) = PH_TREE(NVT_TEBE) ! coniferous forest
- IF (PVEGTYPE(NVT_TENE)>0.) PH_VEG(NVT_TENE) = PH_TREE(NVT_TENE) ! euqatorial forest
- IF (PVEGTYPE(NVT_BOBD)>0.) PH_VEG(NVT_BOBD) = PH_TREE(NVT_BOBD) ! broadleaf forest
- IF (PVEGTYPE(NVT_BOND)>0.) PH_VEG(NVT_BOND) = PH_TREE(NVT_BOND) ! coniferous forest
- IF (PVEGTYPE(NVT_SHRB)>0.) PH_VEG(NVT_SHRB) = PH_TREE(NVT_SHRB) ! euqatorial forest
+ IF (PH_TREE(NVT_TEBD)/=XUNDEF) PH_VEG(NVT_TEBD) = PH_TREE(NVT_TEBD) ! broadleaf forest
+ IF (PH_TREE(NVT_BONE)/=XUNDEF) PH_VEG(NVT_BONE) = PH_TREE(NVT_BONE) ! coniferous forest
+ IF (PH_TREE(NVT_TRBE)/=XUNDEF) PH_VEG(NVT_TRBE) = PH_TREE(NVT_TRBE) ! euqatorial forest
+ IF (PH_TREE(NVT_TRBD)/=XUNDEF) PH_VEG(NVT_TRBD) = PH_TREE(NVT_TRBD) ! broadleaf forest
+ IF (PH_TREE(NVT_TEBE)/=XUNDEF) PH_VEG(NVT_TEBE) = PH_TREE(NVT_TEBE) ! coniferous forest
+ IF (PH_TREE(NVT_TENE)/=XUNDEF) PH_VEG(NVT_TENE) = PH_TREE(NVT_TENE) ! euqatorial forest
+ IF (PH_TREE(NVT_BOBD)/=XUNDEF) PH_VEG(NVT_BOBD) = PH_TREE(NVT_BOBD) ! broadleaf forest
+ IF (PH_TREE(NVT_BOND)/=XUNDEF) PH_VEG(NVT_BOND) = PH_TREE(NVT_BOND) ! coniferous forest
+ IF (PH_TREE(NVT_SHRB)/=XUNDEF) PH_VEG(NVT_SHRB) = PH_TREE(NVT_SHRB) ! euqatorial forest
+ IF (NVT_FLTR>0) THEN
+ IF (PH_TREE(NVT_FLTR)/=XUNDEF) PH_VEG(NVT_FLTR) = PH_TREE(NVT_FLTR)
+ ENDIF
END IF
-IF (PVEGTYPE(NVT_GRAS)>0.) PH_VEG(NVT_GRAS) = PLAI(NVT_GRAS) / 6. ! grassland
-IF (PVEGTYPE(NVT_BOGR)>0.) PH_VEG(NVT_BOGR) = PLAI(NVT_BOGR) / 6. ! boreal grassland
-IF (PVEGTYPE(NVT_TROG)>0.) PH_VEG(NVT_TROG) = PLAI(NVT_TROG) / 6. ! tropical grassland
+IF (PLAI(NVT_GRAS)/=XUNDEF) PH_VEG(NVT_GRAS) = PLAI(NVT_GRAS) / 6. ! grassland
+IF (PLAI(NVT_BOGR)/=XUNDEF) PH_VEG(NVT_BOGR) = PLAI(NVT_BOGR) / 6. ! boreal grassland
+IF (PLAI(NVT_TROG)/=XUNDEF) PH_VEG(NVT_TROG) = PLAI(NVT_TROG) / 6. ! tropical grassland
IF(OAGRI_TO_GRASS)THEN
- IF (PVEGTYPE(NVT_C3 )>0.) PH_VEG(NVT_C3 ) = PLAI(NVT_C3) / 6. ! cultures
- IF (PVEGTYPE(NVT_C4 )>0.) PH_VEG(NVT_C4 ) = PLAI(NVT_C4) / 6. ! C4 types
- IF (PVEGTYPE(NVT_IRR )>0.) PH_VEG(NVT_IRR ) = PLAI(NVT_IRR) / 6. ! irrigated crops (as C4)
+ IF (NVT_C3>0) THEN
+ IF (PLAI(NVT_C3 )/=XUNDEF) PH_VEG(NVT_C3 ) = PLAI(NVT_C3) / 6. ! cultures
+ ELSEIF (NVT_C3W>0 .AND. NVT_C3S>0) THEN
+ IF (PLAI(NVT_C3W )/=XUNDEF) PH_VEG(NVT_C3W ) = PLAI(NVT_C3W) / 6.
+ IF (PLAI(NVT_C3S )/=XUNDEF) PH_VEG(NVT_C3S ) = PLAI(NVT_C3S) / 6.
+ ENDIF
+ IF (PLAI(NVT_C4 )/=XUNDEF) PH_VEG(NVT_C4 ) = PLAI(NVT_C4) / 6. ! C4 types
+ IF (NVT_IRR>0) THEN
+ IF (PLAI(NVT_IRR )/=XUNDEF) PH_VEG(NVT_IRR ) = PLAI(NVT_IRR) / 6. ! irrigated crops (as C4)
+ ENDIF
ELSE
- IF (PVEGTYPE(NVT_C3 )>0.) PH_VEG(NVT_C3 ) = MIN(1. , ZALLEN_H(NVT_C3) ) ! cultures
- IF (PVEGTYPE(NVT_C4 )>0.) PH_VEG(NVT_C4 ) = MIN(2.5, ZALLEN_H(NVT_C4) ) ! C4 types
- IF (PVEGTYPE(NVT_IRR )>0.) PH_VEG(NVT_IRR ) = MIN(2.5, ZALLEN_H(NVT_IRR) ) ! irrigated crops (as C4)
+ IF (NVT_C3>0) THEN
+ IF (ZALLEN_H(NVT_C3 )/=XUNDEF) PH_VEG(NVT_C3 ) = MIN(1. , ZALLEN_H(NVT_C3) ) ! cultures
+ ELSEIF (NVT_C3W>0 .AND. NVT_C3S>0) THEN
+ IF (ZALLEN_H(NVT_C3W )/=XUNDEF) PH_VEG(NVT_C3W ) = MIN(1. , ZALLEN_H(NVT_C3W) )
+ IF (ZALLEN_H(NVT_C3S )/=XUNDEF) PH_VEG(NVT_C3S ) = MIN(1. , ZALLEN_H(NVT_C3S) )
+ ENDIF
+ IF (ZALLEN_H(NVT_C4 )/=XUNDEF) PH_VEG(NVT_C4 ) = MIN(2.5, ZALLEN_H(NVT_C4) ) ! C4 types
+ IF (NVT_IRR>0) THEN
+ IF (ZALLEN_H(NVT_IRR )/=XUNDEF) PH_VEG(NVT_IRR ) = MIN(2.5, ZALLEN_H(NVT_IRR) ) ! irrigated crops (as C4)
+ ENDIF
ENDIF
-IF (PVEGTYPE(NVT_NO )>0.) PH_VEG(NVT_NO ) = 0.1 ! no vegetation (smooth)
-IF (PVEGTYPE(NVT_ROCK)>0.) PH_VEG(NVT_ROCK) = 1. ! no vegetation (rocks)
-IF (PVEGTYPE(NVT_SNOW)>0.) PH_VEG(NVT_SNOW) = 0.01 ! no vegetation (snow)
+PH_VEG(NVT_NO ) = 0.1 ! no vegetation (smooth)
+PH_VEG(NVT_ROCK) = 1. ! no vegetation (rocks)
+PH_VEG(NVT_SNOW) = 0.01 ! no vegetation (snow)
!
PH_VEG(:) = MAX(PH_VEG(:),0.001)
!
-IF (LHOOK) CALL DR_HOOK('MODI_VEG_HEIGHT_FROM_LAI:VEG_HEIGHT_FROM_LAI_PATCH',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('MODI_VEG_HEIGHT_FROM_LAI:VEG_HEIGHT_FROM_LAI_VEGTYPE',1,ZHOOK_HANDLE)
!
-END FUNCTION VEG_HEIGHT_FROM_LAI_PATCH
+END FUNCTION VEG_HEIGHT_FROM_LAI_VEGTYPE
!
diff --git a/src/SURFEX/vegetation_evol.F90 b/src/SURFEX/vegetation_evol.F90
index ed1855ef2eb36a96207f648edf6195eb99afa40d..5d5816cdf8218cb148545153be98e34f6b3d8259 100644
--- a/src/SURFEX/vegetation_evol.F90
+++ b/src/SURFEX/vegetation_evol.F90
@@ -3,24 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE VEGETATION_EVOL(HISBA, HPHOTO, HRESPSL, HALBEDO, OAGRIP, &
- OTR_ML, ONITRO_DILU, OAGRI_TO_GRASS, &
- OIMP_VEG, OIMP_Z0, OIMP_EMIS, &
- PTSTEP, KMONTH, KDAY, KSPINW, &
- PTIME, PLAT, PRHOA, &
- PDG, PDZG, KWG_LAYER, &
- PTG, PALBNIR_VEG, PALBVIS_VEG, PALBUV_VEG, &
- PALBNIR_SOIL, PALBVIS_SOIL, PALBUV_SOIL, &
- PVEGTYPE, PSEFOLD, PANMAX, PH_TREE, PBSLAI,&
- PLAIMIN, P_CO2, PCE_NITRO, PCF_NITRO, &
- PCNA_NITRO, PBSLAI_NITRO, PGMES, PTAU_WOOD,&
- TPSEED, TPREAP, PAOSIP, PAOSIM, PAOSJP, &
- PAOSJM, PHO2IP, PHO2IM, PHO2JP, PHO2JM, &
- PZ0EFFIP, PZ0EFFIM, PZ0EFFJP, PZ0EFFJM, &
- PLAI, PVEG, PZ0, PALBNIR, PALBVIS, PALBUV, &
- PEMIS, PANFM, PANDAY, PBIOMASS, PRESP_BIOMASS,&
- PRESP_BIOMASS_INST, PINCREASE, PTURNOVER, &
- PSWDIR)
+ SUBROUTINE VEGETATION_EVOL(IO, DTI, PK, PEK, OAGRIP, PTSTEP, KMONTH, KDAY, PTIME, &
+ PLAT, PRHOA, P_CO2, ISSK, PRESP_BIOMASS_INST, PSWDIR)
! ###############################################################
!!**** *VEGETATION EVOL*
!!
@@ -69,9 +53,15 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_ISBA_n, ONLY : ISBA_P_t, ISBA_PE_t
+!
+USE MODD_SSO_n, ONLY : SSO_t
+!
USE MODD_CO2V_PAR, ONLY : XMC, XMCO2, XPCCO2, XRESPFACTOR_NIT, &
XCOEFF_MAINT_RESP_ZERO, XSLOPE_MAINT_RESP, &
- XPARAM, XPARCF, XDILUDEC
+ XPARCF, XDILUDEC, ITRANSFERT_ESG
USE MODD_CSTS, ONLY : XDAY, XTT, XMD
!
USE MODI_ALBEDO
@@ -83,12 +73,11 @@ USE MODI_VEG_FROM_LAI
USE MODI_Z0V_FROM_LAI
USE MODI_SUBSCALE_Z0EFF
USE MODD_TYPE_DATE_SURF
-USE MODD_DATA_COVER_PAR, ONLY : NVT_TEBD, NVT_TRBE, NVT_BONE, &
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE_ECOSG, NVEGTYPE, &
+ NVT_TEBD, NVT_TRBE, NVT_BONE, &
NVT_TRBD, NVT_TEBE, NVT_TENE, &
NVT_BOBD, NVT_BOND, NVT_SHRB, &
- NVT_TRBE, NVT_C3, NVT_C4, &
- NVT_IRR, NVT_GRAS
-!
+ NVT_TRBE
USE MODD_SURF_PAR
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -98,106 +87,25 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
!
- CHARACTER(LEN=3), INTENT(IN) :: HISBA ! type of ISBA version:
-! ! '2-L' (default)
-! ! '3-L'
-! ! 'DIF'
- CHARACTER(LEN=3), INTENT(IN) :: HPHOTO ! type of photosynthesis
-! ! 'NON'
-! ! 'AGS'
-! ! 'LAI'
- CHARACTER(LEN=3), INTENT(IN) :: HRESPSL ! Soil Respiration
-! ! 'DEF' = Norman 1992
-! ! 'PRM' = Rivalland PhD Thesis (2003)
-! ! 'CNT' = CENTURY model (Gibelin 2008)
- CHARACTER(LEN=4), INTENT(IN) :: HALBEDO ! albedo type
-! ! 'DRY '
-! ! 'EVOL'
-! ! 'WET '
-! ! 'USER'
LOGICAL, INTENT(IN) :: OAGRIP ! agricultural practices
-LOGICAL, INTENT(IN) :: OTR_ML ! new radiative transfert
-LOGICAL, INTENT(IN) :: ONITRO_DILU ! nitrogen dilution fct of CO2 (Calvet et al. 2008)
-LOGICAL, INTENT(IN) :: OAGRI_TO_GRASS
-!
-LOGICAL, INTENT(IN) :: OIMP_VEG
-LOGICAL, INTENT(IN) :: OIMP_Z0
-LOGICAL, INTENT(IN) :: OIMP_EMIS
!
REAL, INTENT(IN) :: PTSTEP ! time step
INTEGER, INTENT(IN) :: KMONTH ! current month
INTEGER, INTENT(IN) :: KDAY ! current day
-INTEGER, INTENT(IN) :: KSPINW ! spinup wood
REAL, INTENT(IN) :: PTIME ! current time since midnight
REAL, DIMENSION(:), INTENT(IN) :: PLAT ! latitude of each grid point
REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! air density
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PDG ! Depth of Bottom of Soil layers (m)
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZG ! soil layers thicknesses (DIF option) (m)
-INTEGER, DIMENSION(:),INTENT(IN) :: KWG_LAYER ! Number of soil moisture layers (DIF option)
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PTG ! soil layer average temperatures (K)
-REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_VEG ! visible, near infra-red and UV
-REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_VEG ! albedo of the vegetation
-REAL, DIMENSION(:), INTENT(IN) :: PALBUV_VEG !
-REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_SOIL! visible, near infra-red and UV
-REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_SOIL! soil albedo
-REAL, DIMENSION(:), INTENT(IN) :: PALBUV_SOIL !
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE! fraction of each vegetation type
-REAL, DIMENSION(:), INTENT(IN) :: PSEFOLD ! e-folding time for senescence (s)
-REAL, DIMENSION(:), INTENT(IN) :: PANMAX ! maximum photosynthesis rate
-REAL, DIMENSION(:), INTENT(IN) :: PH_TREE ! height of trees
-REAL, DIMENSION(:), INTENT(IN) :: PBSLAI ! ratio of biomass to LAI
-REAL, DIMENSION(:), INTENT(IN) :: PLAIMIN ! minimum LAI
-!
REAL, DIMENSION(:), INTENT(IN) :: P_CO2 ! CO2 concentration [ppmm]
!
-REAL, DIMENSION(:), INTENT(IN) :: PCE_NITRO ! leaf aera ratio sensibility to nitrogen
-! concentration (10**2 m2 kg-1)
-REAL, DIMENSION(:), INTENT(IN) :: PCF_NITRO ! lethal minimum value of leaf aera ratio
-! (m2 kg-1)
-REAL, DIMENSION(:), INTENT(IN) :: PCNA_NITRO ! nitrogen concentration of active biomass (%)
-REAL, DIMENSION(:), INTENT(IN) :: PBSLAI_NITRO ! ratio of biomass to LAI
-!
-REAL, DIMENSION(:), INTENT(IN) :: PGMES ! mesophyll conductance (m s-1)
-REAL, DIMENSION(:), INTENT(IN) :: PTAU_WOOD ! residence time in wood (s)
-!
-!
-TYPE (DATE_TIME), DIMENSION(:), INTENT(IN) :: TPSEED ! seeding date
-TYPE (DATE_TIME), DIMENSION(:), INTENT(IN) :: TPREAP ! reaping date
-!
-REAL, DIMENSION(:), INTENT(IN) :: PAOSIP ! A/S for increasing x
-REAL, DIMENSION(:), INTENT(IN) :: PAOSIM ! A/S for decreasing x
-REAL, DIMENSION(:), INTENT(IN) :: PAOSJP ! A/S for increasing y
-REAL, DIMENSION(:), INTENT(IN) :: PAOSJM ! A/S for decreasing y
-REAL, DIMENSION(:), INTENT(IN) :: PHO2IP ! h/2 for increasing x
-REAL, DIMENSION(:), INTENT(IN) :: PHO2IM ! h/2 for decreasing x
-REAL, DIMENSION(:), INTENT(IN) :: PHO2JP ! h/2 for increasing y
-REAL, DIMENSION(:), INTENT(IN) :: PHO2JM ! h/2 for decreasing y
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFIP! roughness length for increasing x
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFIM! roughness length for decreasing x
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFJP! roughness length for increasing y
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFJM! roughness length for decreasing y
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PLAI ! leaf area index (LAI)
-REAL, DIMENSION(:), INTENT(INOUT) :: PVEG ! vegetation fraction
-REAL, DIMENSION(:), INTENT(INOUT) :: PZ0 ! roughness length: momentum
-REAL, DIMENSION(:), INTENT(INOUT) :: PALBNIR ! snow-free near-infra-red albedo
-REAL, DIMENSION(:), INTENT(INOUT) :: PALBVIS ! snow-free visible albedo
-REAL, DIMENSION(:), INTENT(INOUT) :: PALBUV ! snow-free UV albedo
-REAL, DIMENSION(:), INTENT(INOUT) :: PEMIS ! snow-free emissivity
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PANFM ! maximum leaf assimilation
-REAL, DIMENSION(:), INTENT(INOUT) :: PANDAY ! daily net CO2 assimilation
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBIOMASS ! biomass of day-1
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRESP_BIOMASS ! daily cumulated respiration of biomass (kgDM/m2/day)
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRESP_BIOMASS_INST ! instantaneous respiration of biomass (kgCO2/kgair m/s)
+TYPE(SSO_t), INTENT(INOUT) :: ISSK
!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINCREASE ! increment of biomass (gC m-2 s-1)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTURNOVER ! biomass turnover going into litter (gC m-2 s-1)
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PRESP_BIOMASS_INST ! instantaneous respiration of biomass (kgCO2/kgair m/s)
!
REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: PSWDIR ! Global incoming shortwave radiation (W m-2)
!
@@ -224,31 +132,33 @@ REAL, PARAMETER :: ZDECIDUS = 0.75 !Coef for decidus
!
!* 0.3 declarations of local variables
!
-REAL, DIMENSION(SIZE(PRESP_BIOMASS,1),SIZE(PRESP_BIOMASS,2)) :: ZRESP_BIOMASS_LAST ! biomass at t-1 (kg_DM/m2/day)
-REAL, DIMENSION(SIZE(PLAI)) :: ZBIOMASS_LEAF ! temporary leaf biomass
-REAL, DIMENSION(SIZE(PLAI)) :: ZBSLAI_NITRO ! (Calvet et al. 2008) ratio of biomass to LAI
+REAL, DIMENSION(SIZE(PEK%XRESP_BIOMASS,1),SIZE(PEK%XRESP_BIOMASS,2)) :: ZRESP_BIOMASS_LAST ! biomass at t-1 (kg_DM/m2/day)
+REAL, DIMENSION(SIZE(PEK%XLAI,1)) :: ZBIOMASS_LEAF ! temporary leaf biomass
+REAL, DIMENSION(SIZE(PEK%XLAI,1)) :: ZBSLAI_NITRO ! (Calvet et al. 2008) ratio of biomass to LAI
! with representation of nitrogen dilution
-REAL, DIMENSION(SIZE(PLAI)) :: ZCO2, ZCNA_NITRO ! fct of CO2
-REAL, DIMENSION(SIZE(PLAI)) :: ZPARAM
-REAL, DIMENSION(SIZE(PLAI)) :: ZHTREE, ZSAPFRAC ! tree height & sap fraction used for estimation of
+REAL, DIMENSION(SIZE(PEK%XLAI,1)) :: ZCO2, ZCNA_NITRO ! fct of CO2
+REAL, DIMENSION(SIZE(PEK%XLAI,1)) :: ZPARAM
+REAL, DIMENSION(SIZE(PEK%XLAI,1)) :: ZHTREE, ZSAPFRAC ! tree height & sap fraction used for estimation of
! sapwood fraction
!
REAL :: ZLOG2, ZWORK
!
-REAL, DIMENSION(SIZE(PTG,1)) :: ZTG_VEG ! surface temperature (C)
-REAL, DIMENSION(SIZE(PTG,1)) :: ZTG_SOIL ! soil temperature (C)
-REAL, DIMENSION(SIZE(PTG,1)) :: ZDG_SOIL ! soil depth for DIF (m)
+REAL, DIMENSION(SIZE(PEK%XTG,1)) :: ZTG_VEG ! surface temperature (C)
+REAL, DIMENSION(SIZE(PEK%XTG,1)) :: ZTG_SOIL ! soil temperature (C)
+REAL, DIMENSION(SIZE(PEK%XTG,1)) :: ZDG_SOIL ! soil depth for DIF (m)
REAL :: ZWGHT_SOIL ! Weight for DIF (m)
!
-LOGICAL, DIMENSION(SIZE(PLAI)) :: GWOOD,GHERB
-LOGICAL, DIMENSION(SIZE(PLAI)) :: GMASK_AGRI
+LOGICAL, DIMENSION(SIZE(PEK%XLAI,1)) :: GWOOD,GHERB
+LOGICAL, DIMENSION(SIZE(PEK%XLAI,1)) :: GMASK_AGRI
LOGICAL :: GMASK
INTEGER :: INI, INL, JI, JL, IDEPTH, JTYPE
!
-REAL, DIMENSION(SIZE(PVEGTYPE,1),SIZE(PVEGTYPE,2)) :: ZPARAM_TYPE
+REAL, DIMENSION(SIZE(PK%XVEGTYPE_PATCH,1),SIZE(PK%XVEGTYPE_PATCH,2)) :: ZPARAM_TYPE
!
! * Azote
-REAL, DIMENSION(SIZE(PLAI)) :: ZFERT
+REAL, DIMENSION(SIZE(PEK%XLAI,1)) :: ZFERT
+!
+REAL :: ZDILUDEC
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -259,8 +169,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('VEGETATION_EVOL',0,ZHOOK_HANDLE)
!
-INI=SIZE(PTG,1)
-INL=SIZE(PTG,2)
+INI=SIZE(PEK%XTG,1)
+INL=SIZE(PEK%XTG,2)
!
ZLOG2 = LOG(2.0)
!
@@ -268,9 +178,9 @@ ZTG_SOIL(:) = 0.0
ZTG_VEG (:) = 0.0
!
! Define herbaceous and woody patches
-GHERB(:) = ( PVEGTYPE(:,NVT_TEBD) + PVEGTYPE(:,NVT_TRBE) + PVEGTYPE(:,NVT_BONE) &
-& + PVEGTYPE(:,NVT_TRBD) + PVEGTYPE(:,NVT_TEBE) + PVEGTYPE(:,NVT_TENE) &
-& + PVEGTYPE(:,NVT_BOBD) + PVEGTYPE(:,NVT_BOND) + PVEGTYPE(:,NVT_SHRB)<0.5)
+GHERB(:) = ( PK%XVEGTYPE_PATCH(:,NVT_TEBD) + PK%XVEGTYPE_PATCH(:,NVT_TRBE) + PK%XVEGTYPE_PATCH(:,NVT_BONE) &
+& + PK%XVEGTYPE_PATCH(:,NVT_TRBD) + PK%XVEGTYPE_PATCH(:,NVT_TEBE) + PK%XVEGTYPE_PATCH(:,NVT_TENE) &
+& + PK%XVEGTYPE_PATCH(:,NVT_BOBD) + PK%XVEGTYPE_PATCH(:,NVT_BOND) + PK%XVEGTYPE_PATCH(:,NVT_SHRB)<0.5)
GWOOD(:) = (.NOT.GHERB (:))
!
! Mask where vegetation evolution is performed (just before solar midnight)
@@ -278,11 +188,11 @@ GMASK = ( PTIME - PTSTEP < 0. ) .AND. ( PTIME >= 0. )
!
! Save RESP_BIOMASS at t-1
IF (GMASK) THEN
- PRESP_BIOMASS (:,1) = 0.0
+ PEK%XRESP_BIOMASS(:,1) = 0.0
ZRESP_BIOMASS_LAST(:,:) = 0.0
ELSE
- PRESP_BIOMASS (:,1) = PRESP_BIOMASS(:,1) + PRESP_BIOMASS_INST(:,1) * (PTSTEP*PRHOA(:)*XMC)/(XPCCO2*XMCO2)
- ZRESP_BIOMASS_LAST(:,:) = PRESP_BIOMASS(:,:)
+ PEK%XRESP_BIOMASS(:,1) = PEK%XRESP_BIOMASS(:,1) + PRESP_BIOMASS_INST(:,1) * (PTSTEP*PRHOA(:)*XMC)/(XPCCO2*XMCO2)
+ ZRESP_BIOMASS_LAST(:,:) = PEK%XRESP_BIOMASS(:,:)
ENDIF
!
!* 2. Interactive vegetation
@@ -290,202 +200,188 @@ ENDIF
!
! LAI daily mortality and assimilation
!
-ZBIOMASS_LEAF(:) = PBIOMASS(:,1)
+ZBIOMASS_LEAF(:) = PEK%XBIOMASS(:,1)
!
IF (GMASK) THEN
-!
- IF (HPHOTO=='LAI' .OR. HPHOTO=='LST')THEN
-!
- CALL LAILOSS(PVEG, PSEFOLD, PANMAX, PANDAY, PANFM, ZBIOMASS_LEAF)
- CALL LAIGAIN(PBSLAI, PLAIMIN, PVEG, ZBIOMASS_LEAF, PLAI, PANDAY)
- PBIOMASS(:,1) = ZBIOMASS_LEAF(:)
-!
- ELSE IF (HPHOTO=='NIT' .OR. HPHOTO=='NCB') THEN
-!
- PINCREASE (:,:) = 0.0
- PTURNOVER (:,:) = 0.0
- ZBSLAI_NITRO(: ) = PBSLAI_NITRO(:)
-!
- IF(ONITRO_DILU)THEN
+ !
+ PK%XINCREASE (:,:) = 0.0
+ PK%XTURNOVER(:,:) = 0.0
+ ZBSLAI_NITRO(: ) = PK%XBSLAI_NITRO(:)
+ !
+ IF(IO%LNITRO_DILU)THEN
!
! * Compute Vegetation temperature
! We use the temperature of the second layer of the soil (<40cm)
! since the parametrization employs a daily temperature
!
- IF(HISBA/='DIF')THEN
- ZTG_VEG(:) = PTG(:,2)
- ELSE
- DO JI=1,INI
- IDEPTH=KWG_LAYER(JI)
- ZDG_SOIL(JI)=MIN(ZDEPTH_VEG,PDG(JI,IDEPTH))
- ENDDO
- DO JL=1,INL
- DO JI=1,INI
- ZWGHT_SOIL=MIN(PDZG(JI,JL),MAX(0.0,ZDG_SOIL(JI)-PDG(JI,JL)+PDZG(JI,JL)))
- ZTG_VEG(JI)=ZTG_VEG(JI)+PTG(JI,JL)*ZWGHT_SOIL/ZDG_SOIL(JI)
- ENDDO
- ENDDO
- ENDIF
-!
- ZPARAM(:) = 0.0
- ZFERT (:) = 0.0
- DO JTYPE=1,SIZE(PVEGTYPE,2)
- DO JI = 1,INI
- ZPARAM_TYPE(JI,JTYPE) = XDILUDEC(JTYPE) * (ZDECIDUS + 1.1 * ZPHOTON * XPARCF * PSWDIR(JI) &
- + (ZTG_VEG(JI)-XTT)/ZTEMP_VEG - 0.33 * ZFERT(JI)) &
- + (1 - XDILUDEC(JTYPE)) * ( 1.1 * ZPHOTON * XPARCF * PSWDIR(JI) &
- + (ZTG_VEG(JI)-XTT)/ZTEMP_VEG - 0.33 * ZFERT(JI))
- ZPARAM(JI) = ZPARAM(JI) + ZPARAM_TYPE(JI,JTYPE) * PVEGTYPE(JI,JTYPE)
- ENDDO
+ IF(IO%CISBA/='DIF')THEN
+ ZTG_VEG(:) = PEK%XTG(:,2)
+ ELSE
+ DO JI=1,INI
+ IDEPTH=PK%NWG_LAYER(JI)
+ ZDG_SOIL(JI)=MIN(ZDEPTH_VEG,PK%XDG(JI,IDEPTH))
ENDDO
+ DO JL=1,INL
+ DO JI=1,INI
+ ZWGHT_SOIL=MIN(PK%XDZG(JI,JL),MAX(0.0,ZDG_SOIL(JI)-PK%XDG(JI,JL)+PK%XDZG(JI,JL)))
+ ZTG_VEG(JI)=ZTG_VEG(JI)+PEK%XTG(JI,JL)*ZWGHT_SOIL/ZDG_SOIL(JI)
+ ENDDO
+ ENDDO
+ ENDIF
+!
+ ZPARAM(:) = 0.0
+ ZFERT (:) = 0.0
+ DO JTYPE=1,SIZE(PK%XVEGTYPE_PATCH,2)
+ IF (NVEGTYPE==NVEGTYPE_ECOSG) THEN
+ ZDILUDEC = XDILUDEC(ITRANSFERT_ESG(JTYPE))
+ ELSE
+ ZDILUDEC = XDILUDEC(JTYPE)
+ ENDIF
+ DO JI = 1,INI
+ ZPARAM_TYPE(JI,JTYPE) = ZDILUDEC * (ZDECIDUS + 1.1 * ZPHOTON * XPARCF * PSWDIR(JI) &
+ + (ZTG_VEG(JI)-XTT)/ZTEMP_VEG - 0.33 * ZFERT(JI)) &
+ + (1 - ZDILUDEC) * (1.1 * ZPHOTON * XPARCF * PSWDIR(JI) &
+ + (ZTG_VEG(JI)-XTT)/ZTEMP_VEG - 0.33 * ZFERT(JI))
+ ZPARAM(JI) = ZPARAM(JI) + ZPARAM_TYPE(JI,JTYPE) * PK%XVEGTYPE_PATCH(JI,JTYPE)
+ ENDDO
+ ENDDO
- WHERE((PCE_NITRO(:)*PCNA_NITRO(:)+PCF_NITRO(:))/=0.0.AND.PCNA_NITRO(:)/=0.0)
- ZCO2 (:) = P_CO2(:)*(XMD/(1.E-6*XMCO2)) ! (ppmm -> ppm)
- ZCNA_NITRO (:) = PCNA_NITRO(:)*EXP(ZCDILU1*EXP(ZPARAM(:)-PCNA_NITRO(:)/ZCDILU2)*ALOG(MAX(1.,ZCO2(:)/ZCDILU3)))
- ZBSLAI_NITRO(:) = 1. / (PCE_NITRO(:)*ZCNA_NITRO(:)+PCF_NITRO(:))
- ENDWHERE
+ WHERE((PEK%XCE_NITRO(:)*PEK%XCNA_NITRO(:)+PEK%XCF_NITRO(:))/=0.0.AND.PEK%XCNA_NITRO(:)/=0.0)
+ ZCO2 (:) = P_CO2(:)*(XMD/(1.E-6*XMCO2)) ! (ppmm -> ppm)
+ ZCNA_NITRO (:) = PEK%XCNA_NITRO(:) * &
+ EXP(ZCDILU1*EXP(ZPARAM(:)-PEK%XCNA_NITRO(:)/ZCDILU2) * ALOG(MAX(1.,ZCO2(:)/ZCDILU3)))
+ ZBSLAI_NITRO(:) = 1. / (PEK%XCE_NITRO(:)*ZCNA_NITRO(:)+PEK%XCF_NITRO(:))
+ ENDWHERE
!
- ENDIF
-!
- IF(ANY(PLAI(:)/=XUNDEF))THEN
- CALL NITRO_DECLINE(HPHOTO, HRESPSL, OTR_ML, KSPINW, &
- ZBSLAI_NITRO, PSEFOLD, PGMES, PANMAX, PANDAY, &
- PLAT, PLAIMIN, PVEGTYPE, PTAU_WOOD, &
- PANFM, PLAI, PBIOMASS, PRESP_BIOMASS, ZBIOMASS_LEAF, &
- PINCREASE, PTURNOVER )
- CALL LAIGAIN(ZBSLAI_NITRO, PLAIMIN, PVEG, ZBIOMASS_LEAF, PLAI, PANDAY)
- ENDIF
+ ENDIF
!
+ IF(ANY(PEK%XLAI(:)/=XUNDEF))THEN
+ CALL NITRO_DECLINE(IO, PK, PEK, GWOOD, ZBSLAI_NITRO, PLAT, ZBIOMASS_LEAF)
+ CALL LAIGAIN(ZBSLAI_NITRO, PEK, ZBIOMASS_LEAF)
ENDIF
-!
-! CASE CPHOTO=AST reinitialise PANDAY and PANFM
- PANDAY=0.0
- PANFM =0.0
+ !
+ ! reinitialise PEK%XANDAY(:) and PEK%XANFM(:)
+ PEK%XANDAY(:)=0.0
+ PEK%XANFM(:) =0.0
+ !
+ENDIF
+!
+!
+! * soil temperature in K (over 1m depth for DIF)
+!
+ZTG_VEG(:) = PEK%XTG(:,1)
!
+IF(IO%CISBA/='DIF')THEN
+ ZTG_SOIL(:) = PEK%XTG(:,2)
+ELSE
+ DO JI=1,INI
+ IDEPTH=PK%NWG_LAYER(JI)
+ ZDG_SOIL(JI)=MIN(ZDEPTH,PK%XDG(JI,IDEPTH))
+ ENDDO
+ DO JL=1,INL
+ DO JI=1,INI
+ ZWGHT_SOIL=MIN(PK%XDZG(JI,JL),MAX(0.0,ZDG_SOIL(JI)-PK%XDG(JI,JL)+PK%XDZG(JI,JL)))
+ ZTG_SOIL(JI)=ZTG_SOIL(JI)+PEK%XTG(JI,JL)*ZWGHT_SOIL/ZDG_SOIL(JI)
+ ENDDO
+ ENDDO
ENDIF
!
!
-IF (HPHOTO == 'NIT' .OR. HPHOTO=='NCB') THEN
- !
- ! * soil temperature in K (over 1m depth for DIF)
- !
- ZTG_VEG(:) = PTG(:,1)
- !
- IF(HISBA/='DIF')THEN
- ZTG_SOIL(:) = PTG(:,2)
- ELSE
- DO JI=1,INI
- IDEPTH=KWG_LAYER(JI)
- ZDG_SOIL(JI)=MIN(ZDEPTH,PDG(JI,IDEPTH))
- ENDDO
- DO JL=1,INL
- DO JI=1,INI
- ZWGHT_SOIL=MIN(PDZG(JI,JL),MAX(0.0,ZDG_SOIL(JI)-PDG(JI,JL)+PDZG(JI,JL)))
- ZTG_SOIL(JI)=ZTG_SOIL(JI)+PTG(JI,JL)*ZWGHT_SOIL/ZDG_SOIL(JI)
- ENDDO
- ENDDO
- ENDIF
+! * Respiration of structural biomass pools
+!
+WHERE(GWOOD(:))
+ ! IBIS respiration with either respiration factor rwood=0.0125 - otherwise rroot=1.25
+ ! (Kucharik et al, 2000, eq 6-8) Soil temp in K
+ PEK%XRESP_BIOMASS(:,2) = PEK%XRESP_BIOMASS(:,2) + PEK%XBIOMASS(:,2) * PTSTEP &
+ * MAX(0.,ZROOT_IBIS*EXP(ZCIBIS1*(ZCIBIS2-1./ZTG_VEG(:)))/(ZNDAY*XDAY))
+ELSEWHERE
+ PEK%XRESP_BIOMASS(:,2) = PEK%XRESP_BIOMASS(:,2) + PEK%XBIOMASS(:,2) * XRESPFACTOR_NIT &
+ * EXP((ZLOG2/ZCOEF1)*(ZTG_VEG(:)-XTT-ZCOEF2)) * PTSTEP
+ ! before optimization * 2.0**((PEK%XTG(:,2)-XTT-ZCOEF2)/ZCOEF1) * PTSTEP
+ENDWHERE
+!
+IF (IO%CPHOTO == 'NIT') THEN
!
+ PEK%XRESP_BIOMASS(:,3) = PEK%XRESP_BIOMASS(:,3) + PEK%XBIOMASS(:,3) * XRESPFACTOR_NIT &
+ * EXP((ZLOG2/ZCOEF1)*(ZTG_SOIL(:)-XTT-ZCOEF2)) * PTSTEP
+ ! before optimization * 2.0**((PEK%XTG(:,2)-XTT-ZCOEF2)/ZCOEF1) * PTSTEP
!
- ! * Respiration of structural biomass pools
+ELSEIF (IO%CPHOTO == 'NCB') THEN
!
+ PEK%XRESP_BIOMASS(:,2) = MIN(PEK%XRESP_BIOMASS(:,2), PEK%XBIOMASS(:,2))
+ !
+ PEK%XRESP_BIOMASS(:,3) = PEK%XRESP_BIOMASS(:,3) + PEK%XBIOMASS(:,3) * &
+ MAX( 0., XCOEFF_MAINT_RESP_ZERO * (1. + XSLOPE_MAINT_RESP*(ZTG_VEG(:)-XTT))) * PTSTEP
+ PEK%XRESP_BIOMASS(:,3) = MIN(PEK%XRESP_BIOMASS(:,3), PEK%XBIOMASS(:,3))
+ !
WHERE(GWOOD(:))
- ! IBIS respiration with either respiration factor rwood=0.0125 - otherwise rroot=1.25
- ! (Kucharik et al, 2000, eq 6-8) Soil temp in K
- PRESP_BIOMASS(:,2) = PRESP_BIOMASS(:,2) + PBIOMASS(:,2) * PTSTEP &
- * MAX(0.,ZROOT_IBIS*EXP(ZCIBIS1*(ZCIBIS2-1./ZTG_VEG(:)))/(ZNDAY*XDAY))
+ ! Resp IBIS (Soil temp in K)
+ PEK%XRESP_BIOMASS(:,4) = PEK%XRESP_BIOMASS(:,4) + PEK%XBIOMASS(:,4) * PTSTEP &
+ * MAX(0.,ZROOT_IBIS * EXP(ZCIBIS1*(ZCIBIS2-1./ZTG_SOIL(:)))/(ZNDAY*XDAY))
ELSEWHERE
- PRESP_BIOMASS(:,2) = PRESP_BIOMASS(:,2) + PBIOMASS(:,2) * XRESPFACTOR_NIT &
- * EXP((ZLOG2/ZCOEF1)*(ZTG_VEG(:)-XTT-ZCOEF2)) * PTSTEP
- ! before optimization * 2.0**((PTG(:,2)-XTT-ZCOEF2)/ZCOEF1) * PTSTEP
+ PEK%XRESP_BIOMASS(:,4) = PEK%XRESP_BIOMASS(:,4) + PEK%XBIOMASS(:,4) * &
+ MAX( 0., XCOEFF_MAINT_RESP_ZERO * (1. + XSLOPE_MAINT_RESP*(ZTG_SOIL(:)-XTT))) * PTSTEP
ENDWHERE
!
- IF (HPHOTO == 'NIT') THEN
- !
- PRESP_BIOMASS(:,3) = PRESP_BIOMASS(:,3) + PBIOMASS(:,3) * XRESPFACTOR_NIT &
- * EXP((ZLOG2/ZCOEF1)*(ZTG_SOIL(:)-XTT-ZCOEF2)) * PTSTEP
- ! before optimization * 2.0**((PTG(:,2)-XTT-ZCOEF2)/ZCOEF1) * PTSTEP
- !
- ELSEIF (HPHOTO == 'NCB') THEN
- !
- PRESP_BIOMASS(:,2) = MIN(PRESP_BIOMASS(:,2), PBIOMASS(:,2))
- !
- PRESP_BIOMASS(:,3) = PRESP_BIOMASS(:,3) + PBIOMASS(:,3) * MAX( 0., &
- XCOEFF_MAINT_RESP_ZERO * (1. + XSLOPE_MAINT_RESP*(ZTG_VEG(:)-XTT))) * PTSTEP
- PRESP_BIOMASS(:,3) = MIN(PRESP_BIOMASS(:,3), PBIOMASS(:,3))
- !
- WHERE(GWOOD(:))
- ! Resp IBIS (Soil temp in K)
- PRESP_BIOMASS(:,4) = PRESP_BIOMASS(:,4) + PBIOMASS(:,4) * PTSTEP &
- * MAX(0.,ZROOT_IBIS * EXP(ZCIBIS1*(ZCIBIS2-1./ZTG_SOIL(:)))/(ZNDAY*XDAY))
- ELSEWHERE
- PRESP_BIOMASS(:,4) = PRESP_BIOMASS(:,4) + PBIOMASS(:,4) * MAX( 0., &
- XCOEFF_MAINT_RESP_ZERO * (1. + XSLOPE_MAINT_RESP*(ZTG_SOIL(:)-XTT))) * PTSTEP
- ENDWHERE
- !
- PRESP_BIOMASS(:,4) = MIN(PRESP_BIOMASS(:,4), PBIOMASS(:,4))
- !
- WHERE( (GWOOD(:)).AND.(PBIOMASS(:,5)>0.) )
+ PEK%XRESP_BIOMASS(:,4) = MIN(PEK%XRESP_BIOMASS(:,4), PEK%XBIOMASS(:,4))
+ !
+ WHERE( (GWOOD(:)).AND.(PEK%XBIOMASS(:,5)>0.) )
! IBIS estimation of sapwood fraction based on the height of tree, sapspeed and
! max transpiration rates. Conversion from DM to C. To be changed with DGVM. (Soil temp in K)
- ZHTREE(:) = 2.5*0.75*(PBIOMASS(:,1)+PBIOMASS(:,2)+PBIOMASS(:,3)+PBIOMASS(:,4)+PBIOMASS(:,5)+PBIOMASS(:,6))*0.4
- ZSAPFRAC(:) = MIN(0.5, MAX(0.05,0.0025/25.*ZHTREE(:)*0.75*400/(PBIOMASS(:,5)*0.4)))
- PRESP_BIOMASS(:,5) = PRESP_BIOMASS(:,5) + PBIOMASS(:,5) * ZSAPFRAC(:) * PTSTEP &
- * MAX(0.,ZWOOD_IBIS*EXP(ZCIBIS1*(ZCIBIS2-1./ZTG_VEG(:)))/(ZNDAY*XDAY))
- PRESP_BIOMASS(:,5) = MIN(PRESP_BIOMASS(:,5), PBIOMASS(:,5))
- ELSEWHERE
- PRESP_BIOMASS(:,5) = 0.0
- ENDWHERE
-
- !
- ENDIF
- !
- ! * Instantaneous respiration (kgCO2/kgair m/s)
+ ZHTREE(:) = 2.5*0.75*(PEK%XBIOMASS(:,1)+PEK%XBIOMASS(:,2)+PEK%XBIOMASS(:,3)+&
+ PEK%XBIOMASS(:,4)+PEK%XBIOMASS(:,5)+PEK%XBIOMASS(:,6))*0.4
+ ZSAPFRAC(:) = MIN(0.5, MAX(0.05,0.0025/25.*ZHTREE(:)*0.75*400/(PEK%XBIOMASS(:,5)*0.4)))
+ !ZSAPFRAC(:) = 0.5
+
+ PEK%XRESP_BIOMASS(:,5) = PEK%XRESP_BIOMASS(:,5) + PEK%XBIOMASS(:,5) * ZSAPFRAC(:) * PTSTEP &
+ * MAX(0.,ZWOOD_IBIS*EXP(ZCIBIS1*(ZCIBIS2-1./ZTG_VEG(:)))/(ZNDAY*XDAY))
+ PEK%XRESP_BIOMASS(:,5) = MIN(PEK%XRESP_BIOMASS(:,5), PEK%XBIOMASS(:,5))
+ ELSEWHERE
+ PEK%XRESP_BIOMASS(:,5) = 0.0
+ ENDWHERE
!
- DO JL=2,SIZE(PRESP_BIOMASS,2)
- PRESP_BIOMASS_INST(:,JL) = (PRESP_BIOMASS(:,JL) - ZRESP_BIOMASS_LAST(:,JL)) &
- * XPCCO2*XMCO2/(PTSTEP*PRHOA(:)*XMC)
- ENDDO
- !
ENDIF
-
+!
+! * Instantaneous respiration (kgCO2/kgair m/s)
+!
+DO JL=2,SIZE(PEK%XRESP_BIOMASS(:,:),2)
+ PRESP_BIOMASS_INST(:,JL) = (PEK%XRESP_BIOMASS(:,JL) - ZRESP_BIOMASS_LAST(:,JL)) &
+ * XPCCO2*XMCO2/(PTSTEP*PRHOA(:)*XMC)
+ENDDO
+!
!* 3. Agricultural practices
! ----------------------
!
IF (OAGRIP) THEN
!
GMASK_AGRI(:) = .FALSE.
- WHERE ( TPSEED(:)%TDATE%MONTH /= NUNDEF .AND. ( KMONTH < TPSEED(:)%TDATE%MONTH .OR. &
- (KMONTH == TPSEED(:)%TDATE%MONTH .AND. KDAY < TPSEED(:)%TDATE%DAY) ) ) GMASK_AGRI(:) = .TRUE.
- WHERE ( TPREAP(:)%TDATE%MONTH /= NUNDEF .AND. ( KMONTH > TPREAP(:)%TDATE%MONTH .OR. &
- (KMONTH == TPREAP(:)%TDATE%MONTH .AND. KDAY >= TPREAP(:)%TDATE%DAY) ) ) GMASK_AGRI(:) = .TRUE.
+ WHERE ( PEK%TSEED(:)%TDATE%MONTH /= NUNDEF .AND. ( KMONTH < PEK%TSEED(:)%TDATE%MONTH .OR. &
+ (KMONTH == PEK%TSEED(:)%TDATE%MONTH .AND. KDAY < PEK%TSEED(:)%TDATE%DAY) ) ) GMASK_AGRI(:) = .TRUE.
+ WHERE ( PEK%TREAP(:)%TDATE%MONTH /= NUNDEF .AND. ( KMONTH > PEK%TREAP(:)%TDATE%MONTH .OR. &
+ (KMONTH == PEK%TREAP(:)%TDATE%MONTH .AND. KDAY >= PEK%TREAP(:)%TDATE%DAY) ) ) GMASK_AGRI(:) = .TRUE.
!
WHERE (GMASK_AGRI(:))
- PLAI(:) = PLAIMIN(:)
- ZBIOMASS_LEAF(:) = PLAI(:) * ZBSLAI_NITRO(:)
+ PEK%XLAI(:) = PEK%XLAIMIN(:)
+ ZBIOMASS_LEAF(:) = PEK%XLAI(:) * ZBSLAI_NITRO(:)
END WHERE
- IF (HPHOTO == 'NIT' .OR. HPHOTO == 'NCB') THEN
+ WHERE (GMASK_AGRI(:))
+ PEK%XBIOMASS(:,1) = 0.0
+ PEK%XBIOMASS(:,2) = 0.0
+ PEK%XBIOMASS(:,3) = 0.0
+ PEK%XRESP_BIOMASS(:,2) = 0.0
+ PEK%XRESP_BIOMASS(:,3) = 0.0
+ END WHERE
+ !
+ IF (IO%CPHOTO == 'NCB') THEN
!
- WHERE (GMASK_AGRI(:))
- PBIOMASS(:,1) = 0.0
- PBIOMASS(:,2) = 0.0
- PBIOMASS(:,3) = 0.0
- PRESP_BIOMASS(:,2) = 0.0
- PRESP_BIOMASS(:,3) = 0.0
+ WHERE (GMASK_AGRI(:))
+ PEK%XBIOMASS(:,4) = 0.0
+ PEK%XBIOMASS(:,5) = 0.0
+ PEK%XBIOMASS(:,6) = 0.0
+ PEK%XRESP_BIOMASS(:,4) = 0.0
END WHERE
!
- IF (HPHOTO == 'NCB') THEN
- !
- WHERE (GMASK_AGRI(:))
- PBIOMASS(:,4) = 0.0
- PBIOMASS(:,5) = 0.0
- PBIOMASS(:,6) = 0.0
- PRESP_BIOMASS(:,4) = 0.0
- END WHERE
- !
- ENDIF
- !
ENDIF
!
ENDIF
@@ -496,29 +392,29 @@ ENDIF
IF (GMASK) THEN
!
! Evolution of vegetation fraction and roughness length due to LAI change
- IF(.NOT.OIMP_Z0) THEN
- WHERE( PVEG(:) > 0. ) PZ0 (:) = Z0V_FROM_LAI(PLAI(:),PH_TREE(:),PVEGTYPE(:,:),OAGRI_TO_GRASS)
+ IF(.NOT.DTI%LIMP_Z0) THEN
+ WHERE( PEK%XVEG(:) > 0. ) &
+ PEK%XZ0 (:) = Z0V_FROM_LAI(PEK%XLAI(:),PK%XH_TREE(:),PK%XVEGTYPE_PATCH(:,:),IO%LAGRI_TO_GRASS)
ENDIF
- IF(.NOT.OIMP_VEG) THEN
- WHERE( PVEG(:) > 0. ) PVEG(:) = VEG_FROM_LAI(PLAI(:),PVEGTYPE(:,:),OAGRI_TO_GRASS)
+ IF(.NOT.DTI%LIMP_VEG) THEN
+ WHERE( PEK%XVEG(:) > 0. ) &
+ PEK%XVEG(:) = VEG_FROM_LAI(PEK%XLAI(:),PK%XVEGTYPE_PATCH(:,:),IO%LAGRI_TO_GRASS)
ENDIF
!
! Evolution of radiative parameters due to vegetation fraction change
- IF(.NOT.OIMP_EMIS) THEN
- WHERE( PVEG(:) > 0. ) PEMIS(:)= EMIS_FROM_VEG(PVEG(:),PVEGTYPE(:,:))
+ IF(.NOT.DTI%LIMP_EMIS) THEN
+ WHERE( PEK%XVEG(:) > 0. ) PEK%XEMIS(:)= EMIS_FROM_VEG(PEK%XVEG(:),PK%XVEGTYPE_PATCH(:,:))
ENDIF
!
- CALL ALBEDO(HALBEDO, &
- PALBVIS_VEG,PALBNIR_VEG,PALBUV_VEG,PVEG, &
- PALBVIS_SOIL,PALBNIR_SOIL,PALBUV_SOIL, &
- PALBVIS,PALBNIR,PALBUV )
+ CALL ALBEDO(IO%CALBEDO, PEK )
!
! Evolution of effective roughness length due to new surface roughness length
!
- IF (SIZE(PAOSIP)>0) &
- CALL SUBSCALE_Z0EFF(PAOSIP,PAOSIM,PAOSJP,PAOSJM, &
- PHO2IP,PHO2IM,PHO2JP,PHO2JM,PZ0, &
- PZ0EFFIP,PZ0EFFIM,PZ0EFFJP,PZ0EFFJM )
+ IF (ASSOCIATED(ISSK%XAOSIP)) THEN
+ IF (SIZE(ISSK%XAOSIP)>0) THEN
+ CALL SUBSCALE_Z0EFF(ISSK,PEK%XZ0(:),.FALSE. )
+ ENDIF
+ ENDIF
!
ENDIF
!
diff --git a/src/SURFEX/vegetation_update.F90 b/src/SURFEX/vegetation_update.F90
index 2a477b82b74014802bbd99c95f50e4639ed9551e..10cb2a46b5cce767c25889d1a551103152e169e4 100644
--- a/src/SURFEX/vegetation_update.F90
+++ b/src/SURFEX/vegetation_update.F90
@@ -3,26 +3,9 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE VEGETATION_UPDATE (DTCO, DTI, DTGD, DTGR, IG, I, TGRO, &
- PTSTEP,TTIME,PCOVER,OCOVER, &
- HISBA,OECOCLIMAP, HPHOTO, OAGRIP, OTR_ML, &
- HSFTYPE, PLAI,PVEG,PZ0, &
- PALBNIR,PALBVIS,PALBUV,PEMIS, &
- PRSMIN,PGAMMA,PWRMAX_CF, &
- PRGL,PCV, &
- PGMES,PBSLAI,PLAIMIN,PSEFOLD,PGC,PDMAX, &
- PF2I,OSTRESS, &
- PAOSIP,PAOSIM,PAOSJP,PAOSJM, &
- PHO2IP,PHO2IM,PHO2JP,PHO2JM, &
- PZ0EFFIP,PZ0EFFIM,PZ0EFFJP,PZ0EFFJM, &
- HALBEDO, PALBNIR_VEG, PALBVIS_VEG, PALBUV_VEG, &
- PALBNIR_SOIL, PALBVIS_SOIL, PALBUV_SOIL, &
- PCE_NITRO, PCF_NITRO, PCNA_NITRO, &
- TPSEED, TPREAP, PWATSUP, PIRRIG, &
- PGNDLITTER, PRGLGV,PGAMMAGV, &
- PRSMINGV, PWRMAX_CFGV, &
- PH_VEG, PLAIGV, PZ0LITTER, &
- ODUPDATED, OABSENT )
+ SUBROUTINE VEGETATION_UPDATE (DTCO, DTV, KDIM, IO, KK, PK, PEK, KPATCH, &
+ PTSTEP, TTIME ,PCOVER, OCOVER, &
+ OAGRIP, HSFTYPE, OALB, ISSK, ODUPDATED, OABSENT )
! ###############################################################
!!**** *VEGETATION EVOL*
!!
@@ -64,25 +47,18 @@
!* 0. DECLARATIONS
! ------------
!
-!
-!
-!
-!
-!
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+USE MODD_SSO_n, ONLY : SSO_t
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_DATA_TEB_GARDEN_n, ONLY : DATA_TEB_GARDEN_t
-USE MODD_DATA_TEB_GREENROOF_n, ONLY : DATA_TEB_GREENROOF_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
+USE MODD_DATA_COVER_PAR, ONLY : NVT_SNOW
USE MODD_TYPE_DATE_SURF
!
USE MODI_INIT_ISBA_MIXPAR
USE MODI_CONVERT_PATCH_ISBA
-USE MODI_INIT_FROM_DATA_GRDN_n
-USE MODI_INIT_FROM_DATA_GREENROOF_n
+USE MODI_INIT_FROM_DATA_TEB_VEG_n
USE MODI_SUBSCALE_Z0EFF
USE MODI_ALBEDO
USE MODI_UPDATE_DATA_COVER
@@ -98,107 +74,43 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(DATA_TEB_GARDEN_t), INTENT(INOUT) :: DTGD
-TYPE(DATA_TEB_GREENROOF_t), INTENT(INOUT) :: DTGR
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: TGRO
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+INTEGER, INTENT(IN) :: KDIM
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
+INTEGER, INTENT(IN) :: KPATCH
!
REAL, INTENT(IN) :: PTSTEP ! time step
TYPE(DATE_TIME), INTENT(IN) :: TTIME ! UTC time
REAL, DIMENSION(:,:), INTENT(IN) :: PCOVER ! cover types
LOGICAL, DIMENSION(:), INTENT(IN) :: OCOVER
- CHARACTER(LEN=*), INTENT(IN) :: HISBA ! type of soil (Force-Restore OR Diffusion)
- CHARACTER(LEN=*), INTENT(IN) :: HPHOTO ! type of photosynthesis
LOGICAL, INTENT(IN) :: OAGRIP
-LOGICAL, INTENT(IN) :: OTR_ML
- CHARACTER(LEN=*), INTENT(IN) :: HSFTYPE ! nature / garden
-LOGICAL, INTENT(IN) :: OECOCLIMAP ! T if ecoclimap is used
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PLAI ! leaf area index (LAI)
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PVEG ! vegetation fraction
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZ0 ! roughness length: momentum
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBNIR ! snow-free near-infra-red albedo
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBVIS ! snow-free visible albedo
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBUV ! snow-free UV albedo
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PEMIS ! snow-free emissivity
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRSMIN ! minimal stomatal resistance
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PGAMMA !
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PWRMAX_CF !
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRGL
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PCV
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PGMES
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PCE_NITRO
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PCF_NITRO
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PCNA_NITRO
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBSLAI
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PLAIMIN
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSEFOLD
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PGC
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PF2I
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMAX
-LOGICAL,DIMENSION(:,:), INTENT(INOUT) :: OSTRESS
-!
-! MEB stuff
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PGNDLITTER
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRGLGV
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PGAMMAGV
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRSMINGV
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PWRMAX_CFGV
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PH_VEG
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PLAIGV
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZ0LITTER
-!
- CHARACTER(LEN=4), INTENT(IN) :: HALBEDO ! albedo type
-! ! 'DRY '
-! ! 'EVOL'
-! ! 'WET '
-! ! 'USER'
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBVIS_VEG ! visible, near infra-red and UV
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBNIR_VEG ! albedo of the vegetation
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBUV_VEG !
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBVIS_SOIL! visible, near infra-red and UV
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBNIR_SOIL! soil albedo
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PALBUV_SOIL !
-
-REAL, DIMENSION(:), INTENT(IN) :: PAOSIP ! A/S for increasing x
-REAL, DIMENSION(:), INTENT(IN) :: PAOSIM ! A/S for decreasing x
-REAL, DIMENSION(:), INTENT(IN) :: PAOSJP ! A/S for increasing y
-REAL, DIMENSION(:), INTENT(IN) :: PAOSJM ! A/S for decreasing y
-REAL, DIMENSION(:), INTENT(IN) :: PHO2IP ! h/2 for increasing x
-REAL, DIMENSION(:), INTENT(IN) :: PHO2IM ! h/2 for decreasing x
-REAL, DIMENSION(:), INTENT(IN) :: PHO2JP ! h/2 for increasing y
-REAL, DIMENSION(:), INTENT(IN) :: PHO2JM ! h/2 for decreasing y
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZ0EFFIP! roughness length for increasing x
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZ0EFFIM! roughness length for decreasing x
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZ0EFFJP! roughness length for increasing y
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZ0EFFJM! roughness length for decreasing y
+CHARACTER(LEN=*), INTENT(IN) :: HSFTYPE ! nature / garden
!
-TYPE(DATE_TIME), DIMENSION(:,:), INTENT(INOUT) :: TPSEED ! seeding date
-TYPE(DATE_TIME), DIMENSION(:,:), INTENT(INOUT) :: TPREAP ! seeding date
+LOGICAL, INTENT(IN) :: OALB
!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PWATSUP ! water supply during irrigation
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PIRRIG ! irrigated fraction
+TYPE(SSO_t), INTENT(INOUT) :: ISSK
!
LOGICAL, INTENT(OUT) :: ODUPDATED ! T if parameters are being reset
LOGICAL,DIMENSION(:), INTENT(IN), OPTIONAL :: OABSENT ! T where field is not defined
!
!* 0.2 declarations of local variables
!
-INTEGER :: IDECADE, IDECADE2 ! decade of simulation
+INTEGER :: IDECADE, IDECADE2, JI, ISNOWPATCH ! decade of simulation
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-----------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('VEGETATION_UPDATE',0,ZHOOK_HANDLE)
+!
!* 2. Non-interactive vegetation
! --------------------------
!
!* 2.1 Decade
! ------
!
-IF (LHOOK) CALL DR_HOOK('VEGETATION_UPDATE',0,ZHOOK_HANDLE)
IDECADE = 3 * ( TTIME%TDATE%MONTH - 1 ) + MIN(TTIME%TDATE%DAY-1,29) / 10 + 1
IDECADE2 = IDECADE
ODUPDATED=.FALSE.
@@ -207,116 +119,100 @@ ODUPDATED=.FALSE.
! --------------
!
!* new decade?
- IF ( MOD(MIN(TTIME%TDATE%DAY,30),10)==1 .AND. TTIME%TIME - PTSTEP < 0.) THEN
- ODUPDATED=.TRUE.
-!* time varying parameters
- IF (OECOCLIMAP .OR. HSFTYPE=='NAT') THEN
-!* new year ? --> recomputes data LAI and derivated parameters (usefull in case of ecoclimap2)
- CALL UPDATE_DATA_COVER(DTCO, DTI, IG, I, &
- TTIME%TDATE%YEAR)
- IF (HSFTYPE=='NAT') CALL INIT_ISBA_MIXPAR(DTCO, DTI, IG, I, &
- HISBA,IDECADE,IDECADE2,PCOVER,OCOVER,HPHOTO,HSFTYPE)
- CALL CONVERT_PATCH_ISBA(DTCO, DTI, I, &
- HISBA,IDECADE,IDECADE2,PCOVER,OCOVER,&
- HPHOTO,OAGRIP,.FALSE.,OTR_ML,HSFTYPE, &
- PVEG=PVEG,PLAI=PLAI,PRSMIN=PRSMIN, &
- PGAMMA=PGAMMA, PWRMAX_CF=PWRMAX_CF, &
- PRGL=PRGL,PCV=PCV,PZ0=PZ0, &
- PALBNIR_VEG=PALBNIR_VEG, &
- PALBVIS_VEG=PALBVIS_VEG, &
- PALBUV_VEG=PALBUV_VEG, &
- PEMIS_ECO=PEMIS,PGMES=PGMES, &
- PBSLAI=PBSLAI, &
- PLAIMIN=PLAIMIN,PSEFOLD=PSEFOLD, &
- PGC=PGC,PF2I=PF2I, &
- OSTRESS=OSTRESS,PCE_NITRO=PCE_NITRO, &
- PCF_NITRO=PCF_NITRO, &
- PCNA_NITRO=PCNA_NITRO, &
- TPSEED=TPSEED, TPREAP=TPREAP, &
- PWATSUP=PWATSUP,PIRRIG=PIRRIG, &
- PGNDLITTER=PGNDLITTER, &
- PRGLGV=PRGLGV,PGAMMAGV=PGAMMAGV, &
- PRSMINGV=PRSMINGV, &
- PWRMAX_CFGV=PWRMAX_CFGV, &
- PLAIGV=PLAIGV,PZ0LITTER=PZ0LITTER, &
- PH_VEG=PH_VEG )
- IF ( HALBEDO=='CM13') THEN
- CALL CONVERT_PATCH_ISBA(DTCO, DTI, I, &
- HISBA,IDECADE,IDECADE2,PCOVER,OCOVER,&
- HPHOTO,OAGRIP,.FALSE.,OTR_ML,HSFTYPE, &
- PALBNIR_SOIL=PALBNIR_SOIL, &
- PALBVIS_SOIL=PALBVIS_SOIL, &
- PALBUV_SOIL=PALBUV_SOIL )
+IF ( MOD(MIN(TTIME%TDATE%DAY,30),10)==1 .AND. TTIME%TIME - PTSTEP < 0.) THEN
+ !
+ ODUPDATED=.TRUE.
+ !
+ !* time varying parameters
+ IF (IO%LECOCLIMAP .OR. HSFTYPE=='NAT') THEN
+ !
+ !* new year ? --> recomputes data LAI and derivated parameters (usefull in case of ecoclimap2)
+ IF (KPATCH==1) CALL UPDATE_DATA_COVER(DTCO, DTV, KDIM, IO%NPATCH, IO%LMEB_PATCH, TTIME%TDATE%YEAR)
+ !
+ IF (HSFTYPE=='NAT') THEN
+ !
+ IF (KPATCH==1) THEN
+ CALL INIT_ISBA_MIXPAR(DTCO, DTV, KDIM, IO, IDECADE,IDECADE2,PCOVER,OCOVER,HSFTYPE)
+ ELSE
+ IDECADE2 = IDECADE
+ IF (DTV%NTIME==2) IDECADE2 = IDECADE2 + 10
+ IDECADE2 = (IDECADE2-1) * DTV%NTIME / 36 + 1
+ IF (DTV%NTIME==2 .AND. IDECADE2==3) IDECADE2 = 1
ENDIF
- ELSEIF (HSFTYPE=='GRD') THEN
- CALL INIT_FROM_DATA_GRDN_n(DTGD, &
- IDECADE,HPHOTO, &
- PVEG=PVEG(:,1),PLAI=PLAI(:,1),PZ0=PZ0(:,1),PEMIS=PEMIS(:,1) )
-
- ELSEIF (HSFTYPE=='GNR') THEN
- CALL INIT_FROM_DATA_GREENROOF_n(DTGR, TGRO, &
- IDECADE,HPHOTO, &
- PVEG=PVEG(:,1),PLAI=PLAI(:,1),PZ0=PZ0(:,1),PEMIS=PEMIS(:,1) )
-
+ !
+ CALL CONVERT_PATCH_ISBA(DTCO, DTV, IO, IDECADE, IDECADE2, PCOVER, OCOVER,&
+ OAGRIP, HSFTYPE, KPATCH, KK, PK, PEK, &
+ .FALSE., .TRUE., .TRUE., .TRUE., .FALSE., OALB)
+ !
+ ELSE
+ CALL CONVERT_PATCH_ISBA(DTCO, DTV, IO, IDECADE, IDECADE2, PCOVER, OCOVER,&
+ OAGRIP, HSFTYPE, KPATCH, KK, PK, PEK, &
+ .FALSE., .TRUE., .FALSE., .FALSE., .FALSE., OALB)
ENDIF
-!
-!* default values to avoid problems in physical routines
-! for points where there is no vegetation or soil to be simulated by ISBA.
- IF (PRESENT(OABSENT)) THEN
+ !
+ IF ( IO%CALBEDO=='CM13') THEN
+ CALL CONVERT_PATCH_ISBA(DTCO, DTV, IO, IDECADE, IDECADE2, PCOVER, OCOVER,&
+ OAGRIP, HSFTYPE, KPATCH, KK, PK, PEK, &
+ .FALSE., .FALSE., .FALSE., .FALSE., .TRUE., .FALSE.)
+ ENDIF
+ !
+ ELSEIF (.NOT.OALB .AND. (HSFTYPE=='GRD'.OR.HSFTYPE=='GNR') ) THEN
+ !
+ CALL INIT_FROM_DATA_TEB_VEG_n(DTV, KK, PK, PEK, IDECADE, .FALSE., .FALSE., .TRUE., .FALSE. )
+ !
+ ENDIF
+ !
+ !* default values to avoid problems in physical routines
+ ! for points where there is no vegetation or soil to be simulated by ISBA.
+ IF (PRESENT(OABSENT) .AND. .NOT.OALB) THEN
+ !
+ WHERE (OABSENT(:))
+ PEK%XVEG (:) = 0.
+ PEK%XLAI (:) = 0.
+ PEK%XRSMIN (:) = 40.
+ PEK%XGAMMA (:) = 0.
+ PEK%XWRMAX_CF (:) = 0.2
+ PEK%XRGL (:) = 100.
+ PEK%XCV (:) = 2.E-5
+ PEK%XZ0 (:) = 0.013
+ PEK%XALBNIR_VEG(:) = 0.30
+ PEK%XALBVIS_VEG(:) = 0.30
+ PEK%XALBUV_VEG (:) = 0.06
+ PEK%XEMIS (:) = 0.94
+ END WHERE
+ IF (IO%CPHOTO/='NON') THEN
+ WHERE (OABSENT(:))
+ PEK%XGMES (:) = 0.020
+ PEK%XBSLAI (:) = 0.36
+ PEK%XLAIMIN (:) = 0.3
+ PEK%XSEFOLD (:) = 90*86400.
+ PEK%XGC (:) = 0.00025
+ END WHERE
+ WHERE (OABSENT(:)) PEK%XF2I(:) = 0.3
+ IF (IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') THEN
WHERE (OABSENT(:))
- PVEG (:,1) = 0.
- PLAI (:,1) = 0.
- PRSMIN (:,1) = 40.
- PGAMMA (:,1) = 0.
- PWRMAX_CF (:,1) = 0.2
- PRGL (:,1) = 100.
- PCV (:,1) = 2.E-5
- PZ0 (:,1) = 0.013
- PALBNIR_VEG(:,1) = 0.30
- PALBVIS_VEG(:,1) = 0.30
- PALBUV_VEG (:,1) = 0.06
- PEMIS (:,1) = 0.94
+ PEK%XCE_NITRO (:) = 7.68
+ PEK%XCF_NITRO (:) = -4.33
+ PEK%XCNA_NITRO (:) = 1.3
END WHERE
- IF (HPHOTO/='NON') THEN
- WHERE (OABSENT(:))
- PGMES (:,1) = 0.020
- PBSLAI (:,1) = 0.36
- PLAIMIN (:,1) = 0.3
- PSEFOLD (:,1) = 90*86400.
- PGC (:,1) = 0.00025
- END WHERE
- IF (HPHOTO/='AGS' .AND. HPHOTO/='LAI') THEN
- WHERE (OABSENT(:)) PF2I (:,1) = 0.3
- IF (HPHOTO=='NIT' .OR. HPHOTO=='NCB') THEN
- WHERE (OABSENT(:))
- PCE_NITRO (:,1) = 7.68
- PCF_NITRO (:,1) = -4.33
- PCNA_NITRO (:,1) = 1.3
- END WHERE
- ENDIF
- ENDIF
- ENDIF
+ ENDIF
ENDIF
-
- IF (HSFTYPE=='NAT') THEN
-!* albedo
- CALL ALBEDO(HALBEDO, &
- PALBVIS_VEG,PALBNIR_VEG,PALBUV_VEG,PVEG, &
- PALBVIS_SOIL,PALBNIR_SOIL,PALBUV_SOIL, &
- PALBVIS ,PALBNIR, PALBUV )
+ !
+ ENDIF
+ !
+ IF (HSFTYPE=='NAT') THEN
+ !* albedo
+ CALL ALBEDO(IO%CALBEDO, PEK )
+ !
+ !* effective roughness length
+ IF (.NOT.OALB) CALL SUBSCALE_Z0EFF(ISSK,PEK%XZ0,.FALSE. )
+ !
+ ENDIF
+ !
+END IF
!
-!* effective roughness length
- CALL SUBSCALE_Z0EFF(PAOSIP,PAOSIM,PAOSJP,PAOSJM, &
- PHO2IP,PHO2IM,PHO2JP,PHO2JM,PZ0, &
- PZ0EFFIP,PZ0EFFIM,PZ0EFFJP,PZ0EFFJM )
- ENDIF
-
- END IF
IF (LHOOK) CALL DR_HOOK('VEGETATION_UPDATE',1,ZHOOK_HANDLE)
!
-!* 2.3 Prescribed vegetation
-! ---------------------
-!
!-----------------------------------------------------------------
!
END SUBROUTINE VEGETATION_UPDATE
diff --git a/src/SURFEX/vegetation_update_garden.F90 b/src/SURFEX/vegetation_update_garden.F90
deleted file mode 100644
index 966dee4bb6d30a8a74a32d6e988f41a61498082e..0000000000000000000000000000000000000000
--- a/src/SURFEX/vegetation_update_garden.F90
+++ /dev/null
@@ -1,265 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE VEGETATION_UPDATE_GARDEN (DTCO, DTI, IG, I, T, TOP, DTGR, TGRO, GDM, &
- TPTIME,PTSTEP,KLU)
-! ##########################################################################
-!
-!!**** *GARDEN*
-!!
-!! PURPOSE
-!! -------
-!
-!
-!!** METHOD
-! ------
-!
-!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!!
-!! A. Lemonsu * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 05/2009
-!! P. Samuelsson 10/2014 Introduced MEB dummy variables in call to VEGETATION_UPDATE
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_TEB_n, ONLY : TEB_t
-USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-USE MODD_DATA_TEB_GREENROOF_n, ONLY : DATA_TEB_GREENROOF_t
-USE MODD_TEB_GREENROOF_OPTION_n, ONLY : TEB_GREENROOF_OPTIONS_t
-USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t
-!
-USE MODD_TYPE_DATE_SURF, ONLY: DATE_TIME
-
-
-
-!
-USE MODI_VEGETATION_UPDATE
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-!
-!
-!
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(TEB_t), INTENT(INOUT) :: T
-TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
-TYPE(DATA_TEB_GREENROOF_t), INTENT(INOUT) :: DTGR
-TYPE(TEB_GREENROOF_OPTIONS_t), INTENT(INOUT) :: TGRO
-TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
-!
-TYPE(DATE_TIME) , INTENT(IN) :: TPTIME ! current date and time from teb
-REAL , INTENT(IN) :: PTSTEP ! time step
-INTEGER, INTENT(IN) :: KLU ! number of points
-!
-!
-!* 0.2 Declarations of local variables
-!
-REAL, DIMENSION(KLU,1) :: ZZ0EFFIP
-REAL, DIMENSION(KLU,1) :: ZZ0EFFIM
-REAL, DIMENSION(KLU,1) :: ZZ0EFFJP
-REAL, DIMENSION(KLU,1) :: ZZ0EFFJM
-REAL, DIMENSION(KLU) :: ZAOSIP
-REAL, DIMENSION(KLU) :: ZAOSIM
-REAL, DIMENSION(KLU) :: ZAOSJP
-REAL, DIMENSION(KLU) :: ZAOSJM
-REAL, DIMENSION(KLU) :: ZHO2IP
-REAL, DIMENSION(KLU) :: ZHO2IM
-REAL, DIMENSION(KLU) :: ZHO2JP
-REAL, DIMENSION(KLU) :: ZHO2JM
-REAL, DIMENSION(KLU,1) :: ZLAI
-REAL, DIMENSION(KLU,1) :: ZVEG
-REAL, DIMENSION(KLU,1) :: ZZ0
-REAL, DIMENSION(KLU,1) :: ZALBNIR
-REAL, DIMENSION(KLU,1) :: ZALBVIS
-REAL, DIMENSION(KLU,1) :: ZALBUV
-REAL, DIMENSION(KLU,1) :: ZEMIS
-REAL, DIMENSION(KLU,1) :: ZRSMIN
-REAL, DIMENSION(KLU,1) :: ZGAMMA
-REAL, DIMENSION(KLU,1) :: ZWRMAX_CF
-REAL, DIMENSION(KLU,1) :: ZRGL
-REAL, DIMENSION(KLU,1) :: ZCV
-REAL, DIMENSION(KLU,1) :: ZGMES
-REAL, DIMENSION(KLU,1) :: ZBSLAI
-REAL, DIMENSION(KLU,1) :: ZLAIMIN
-REAL, DIMENSION(KLU,1) :: ZSEFOLD
-REAL, DIMENSION(KLU,1) :: ZGC
-REAL, DIMENSION(KLU,1) :: ZDMAX
-REAL, DIMENSION(KLU,1) :: ZF2I
-LOGICAL, DIMENSION(KLU,1) :: GSTRESS
-REAL, DIMENSION(KLU,1) :: ZALBNIR_VEG
-REAL, DIMENSION(KLU,1) :: ZALBVIS_VEG
-REAL, DIMENSION(KLU,1) :: ZALBUV_VEG
-REAL, DIMENSION(KLU,1) :: ZALBNIR_SOIL
-REAL, DIMENSION(KLU,1) :: ZALBVIS_SOIL
-REAL, DIMENSION(KLU,1) :: ZALBUV_SOIL
-REAL, DIMENSION(KLU,1) :: ZCE_NITRO
-REAL, DIMENSION(KLU,1) :: ZCF_NITRO
-REAL, DIMENSION(KLU,1) :: ZCNA_NITRO
-!
-! MEB stuff
-REAL, DIMENSION(KLU,1) :: ZGNDLITTER
-REAL, DIMENSION(KLU,1) :: ZRGLGV
-REAL, DIMENSION(KLU,1) :: ZGAMMAGV
-REAL, DIMENSION(KLU,1) :: ZRSMINGV
-REAL, DIMENSION(KLU,1) :: ZWRMAX_CFGV
-REAL, DIMENSION(KLU,1) :: ZH_VEG
-REAL, DIMENSION(KLU,1) :: ZLAIGV
-REAL, DIMENSION(KLU,1) :: ZZ0LITTER
-!
-TYPE (DATE_TIME), DIMENSION(KLU,1) :: TZSEED
-TYPE (DATE_TIME), DIMENSION(KLU,1) :: TZREAP
-REAL, DIMENSION(KLU,1) :: ZWATSUP
-REAL, DIMENSION(KLU,1) :: ZIRRIG
-LOGICAL :: GUPDATED ! T if VEGETATION_UPDATE has reset fields
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. various initialisations
-! -----------------------
-!
-IF (LHOOK) CALL DR_HOOK('VEGETATION_UPDATE_GARDEN',0,ZHOOK_HANDLE)
-!
-!* orographic roughness not used
-!
-ZAOSIP = 0.
-ZAOSIM = 0.
-ZAOSJP = 0.
-ZAOSJM = 0.
-ZHO2IP = 0.
-ZHO2IM = 0.
-ZHO2JP = 0.
-ZHO2JM = 0.
-!
-!* vegetation parameters to update
-!
-ZVEG(:,1) = GDM%TGDPE%CUR%XVEG
-ZZ0(:,1) = GDM%TGDPE%CUR%XZ0
-ZALBNIR(:,1) = GDM%TGDPE%CUR%XALBNIR
-ZALBVIS(:,1) = GDM%TGDPE%CUR%XALBVIS
-ZALBUV(:,1) = GDM%TGDPE%CUR%XALBUV
-ZEMIS(:,1) = GDM%TGDPE%CUR%XEMIS
-ZRSMIN(:,1) = GDM%TGDP%XRSMIN
-ZGAMMA(:,1) = GDM%TGDP%XGAMMA
-ZWRMAX_CF(:,1) = GDM%TGDP%XWRMAX_CF
-ZRGL(:,1) = GDM%TGDP%XRGL
-ZCV(:,1) = GDM%TGDP%XCV
-ZGMES(:,1) = GDM%TGDP%XGMES
-ZBSLAI(:,1) = GDM%TGDP%XBSLAI
-ZLAIMIN(:,1) = GDM%TGDP%XLAIMIN
-ZSEFOLD(:,1) = GDM%TGDP%XSEFOLD
-ZGC(:,1) = GDM%TGDP%XGC
-ZDMAX(:,1) = GDM%TGDP%XDMAX
-ZF2I(:,1) = GDM%TGDP%XF2I
-GSTRESS(:,1) = GDM%TGDP%LSTRESS
-ZALBNIR_VEG(:,1) = GDM%TGDP%XALBNIR_VEG
-ZALBVIS_VEG(:,1) = GDM%TGDP%XALBVIS_VEG
-ZALBUV_VEG(:,1) = GDM%TGDP%XALBUV_VEG
-ZALBNIR_SOIL(:,1) = GDM%TGDP%XALBNIR_SOIL
-ZALBVIS_SOIL(:,1) = GDM%TGDP%XALBVIS_SOIL
-ZALBUV_SOIL(:,1) = GDM%TGDP%XALBUV_SOIL
-ZCE_NITRO(:,1) = GDM%TGDP%XCE_NITRO
-ZCF_NITRO(:,1) = GDM%TGDP%XCF_NITRO
-ZCNA_NITRO(:,1) = GDM%TGDP%XCNA_NITRO
-! --------------------------------------------------------------------------------------
-! Vegetation update (in case of non-interactive vegetation):
-! --------------------------------------------------------------------------------------
-!
-GUPDATED=.FALSE.
-IF (GDM%TVG%CPHOTO=='NON' .OR. GDM%TVG%CPHOTO=='AGS' .OR. GDM%TVG%CPHOTO=='AST') THEN
- CALL VEGETATION_UPDATE(DTCO, DTI, GDM%DTGD, DTGR, IG, I, TGRO, &
- PTSTEP,TPTIME,TOP%XCOVER,TOP%LCOVER, &
- GDM%TVG%CISBA,(.NOT. GDM%TGDO%LPAR_GARDEN), &
- GDM%TVG%CPHOTO, .FALSE., &
- GDM%TVG%LTR_ML, 'GRD', &
- ZLAI,ZVEG,ZZ0, &
- ZALBNIR,ZALBVIS,ZALBUV,ZEMIS, &
- ZRSMIN,ZGAMMA,ZWRMAX_CF, &
- ZRGL,ZCV, &
- ZGMES,ZBSLAI,ZLAIMIN,ZSEFOLD,ZGC,ZDMAX, &
- ZF2I, GSTRESS, &
- ZAOSIP,ZAOSIM,ZAOSJP,ZAOSJM, &
- ZHO2IP,ZHO2IM,ZHO2JP,ZHO2JM, &
- ZZ0EFFIP,ZZ0EFFIM,ZZ0EFFJP,ZZ0EFFJM, &
- GDM%TVG%CALBEDO, ZALBNIR_VEG, ZALBVIS_VEG, ZALBUV_VEG, &
- ZALBNIR_SOIL, ZALBVIS_SOIL, ZALBUV_SOIL, &
- ZCE_NITRO, ZCF_NITRO, ZCNA_NITRO, &
- TZSEED, TZREAP, ZWATSUP, ZIRRIG, &
- ZGNDLITTER,ZRGLGV,ZGAMMAGV, &
- ZRSMINGV, ZWRMAX_CFGV, &
- ZH_VEG, ZLAIGV, ZZ0LITTER, &
- GUPDATED, OABSENT=(T%CUR%XGARDEN==0.) )
-END IF
-!
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-GDM%TGDPE%CUR%XVEG = ZVEG(:,1)
-GDM%TGDPE%CUR%XZ0 = ZZ0(:,1)
-GDM%TGDPE%CUR%XALBNIR = ZALBNIR(:,1)
-GDM%TGDPE%CUR%XALBVIS = ZALBVIS(:,1)
-GDM%TGDPE%CUR%XALBUV = ZALBUV(:,1)
-GDM%TGDPE%CUR%XEMIS = ZEMIS(:,1)
-GDM%TGDP%XRSMIN = ZRSMIN(:,1)
-GDM%TGDP%XGAMMA = ZGAMMA(:,1)
-GDM%TGDP%XWRMAX_CF = ZWRMAX_CF(:,1)
-GDM%TGDP%XRGL = ZRGL(:,1)
-GDM%TGDP%XCV = ZCV(:,1)
-GDM%TGDP%XGMES = ZGMES(:,1)
-GDM%TGDP%XBSLAI = ZBSLAI(:,1)
-GDM%TGDP%XLAIMIN = ZLAIMIN(:,1)
-GDM%TGDP%XSEFOLD = ZSEFOLD(:,1)
-GDM%TGDP%XGC = ZGC(:,1)
-GDM%TGDP%XDMAX = ZDMAX(:,1)
-GDM%TGDP%XF2I = ZF2I(:,1)
-GDM%TGDP%LSTRESS = GSTRESS(:,1)
-GDM%TGDP%XALBNIR_VEG = ZALBNIR_VEG(:,1)
-GDM%TGDP%XALBVIS_VEG = ZALBVIS_VEG(:,1)
-GDM%TGDP%XALBUV_VEG = ZALBUV_VEG(:,1)
-GDM%TGDP%XALBNIR_SOIL = ZALBNIR_SOIL(:,1)
-GDM%TGDP%XALBVIS_SOIL = ZALBVIS_SOIL(:,1)
-GDM%TGDP%XALBUV_SOIL = ZALBUV_SOIL(:,1)
-GDM%TGDP%XCE_NITRO = ZCE_NITRO(:,1)
-GDM%TGDP%XCF_NITRO = ZCF_NITRO(:,1)
-GDM%TGDP%XCNA_NITRO = ZCNA_NITRO(:,1)
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-!
-IF (LHOOK) CALL DR_HOOK('VEGETATION_UPDATE_GARDEN',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-!
-END SUBROUTINE VEGETATION_UPDATE_GARDEN
diff --git a/src/SURFEX/vegetation_update_greenroof.F90 b/src/SURFEX/vegetation_update_greenroof.F90
deleted file mode 100644
index 3394c5b86e1ba9d6bbfcf15e180612430a1e84f5..0000000000000000000000000000000000000000
--- a/src/SURFEX/vegetation_update_greenroof.F90
+++ /dev/null
@@ -1,258 +0,0 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
-! #########
- SUBROUTINE VEGETATION_UPDATE_GREENROOF (DTCO, DTI, IG, I, T, TOP, TVG, DTGD, GRM, &
- TPTIME,PTSTEP,KLU)
-! ##########################################################################
-!
-!!**** *GREENROOF*
-!!
-!! PURPOSE
-!! -------
-!
-!
-!!** METHOD
-! ------
-!
-!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!!
-!! A. Lemonsu * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 05/2009
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
-USE MODD_ISBA_GRID_n, ONLY : ISBA_GRID_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-USE MODD_TEB_n, ONLY : TEB_t
-USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
-USE MODD_DATA_TEB_GARDEN_n, ONLY : DATA_TEB_GARDEN_t
-USE MODD_SURFEX_n, ONLY : TEB_GREENROOF_MODEL_t
-!
-USE MODD_TYPE_DATE_SURF, ONLY: DATE_TIME
-!
-USE MODI_VEGETATION_UPDATE
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-!
-!
-!
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
-TYPE(ISBA_GRID_t), INTENT(INOUT) :: IG
-TYPE(ISBA_t), INTENT(INOUT) :: I
-TYPE(TEB_t), INTENT(INOUT) :: T
-TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
-TYPE(DATA_TEB_GARDEN_t), INTENT(INOUT) :: DTGD
-TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM
-!
-TYPE(DATE_TIME) , INTENT(IN) :: TPTIME ! current date and time from teb
-REAL , INTENT(IN) :: PTSTEP ! time step
-INTEGER, INTENT(IN) :: KLU ! number of points
-!
-!
-!* 0.2 Declarations of local variables
-!
-REAL, DIMENSION(KLU,1) :: ZZ0EFFIP
-REAL, DIMENSION(KLU,1) :: ZZ0EFFIM
-REAL, DIMENSION(KLU,1) :: ZZ0EFFJP
-REAL, DIMENSION(KLU,1) :: ZZ0EFFJM
-REAL, DIMENSION(KLU) :: ZAOSIP
-REAL, DIMENSION(KLU) :: ZAOSIM
-REAL, DIMENSION(KLU) :: ZAOSJP
-REAL, DIMENSION(KLU) :: ZAOSJM
-REAL, DIMENSION(KLU) :: ZHO2IP
-REAL, DIMENSION(KLU) :: ZHO2IM
-REAL, DIMENSION(KLU) :: ZHO2JP
-REAL, DIMENSION(KLU) :: ZHO2JM
-REAL, DIMENSION(KLU,1) :: ZLAI
-REAL, DIMENSION(KLU,1) :: ZVEG
-REAL, DIMENSION(KLU,1) :: ZZ0
-REAL, DIMENSION(KLU,1) :: ZALBNIR
-REAL, DIMENSION(KLU,1) :: ZALBVIS
-REAL, DIMENSION(KLU,1) :: ZALBUV
-REAL, DIMENSION(KLU,1) :: ZEMIS
-REAL, DIMENSION(KLU,1) :: ZRSMIN
-REAL, DIMENSION(KLU,1) :: ZGAMMA
-REAL, DIMENSION(KLU,1) :: ZWRMAX_CF
-REAL, DIMENSION(KLU,1) :: ZRGL
-REAL, DIMENSION(KLU,1) :: ZCV
-REAL, DIMENSION(KLU,1) :: ZGMES
-REAL, DIMENSION(KLU,1) :: ZBSLAI
-REAL, DIMENSION(KLU,1) :: ZLAIMIN
-REAL, DIMENSION(KLU,1) :: ZSEFOLD
-REAL, DIMENSION(KLU,1) :: ZGC
-REAL, DIMENSION(KLU,1) :: ZDMAX
-REAL, DIMENSION(KLU,1) :: ZF2I
-LOGICAL, DIMENSION(KLU,1) :: GSTRESS
-REAL, DIMENSION(KLU,1) :: ZALBNIR_VEG
-REAL, DIMENSION(KLU,1) :: ZALBVIS_VEG
-REAL, DIMENSION(KLU,1) :: ZALBUV_VEG
-REAL, DIMENSION(KLU,1) :: ZALBNIR_SOIL
-REAL, DIMENSION(KLU,1) :: ZALBVIS_SOIL
-REAL, DIMENSION(KLU,1) :: ZALBUV_SOIL
-REAL, DIMENSION(KLU,1) :: ZCE_NITRO
-REAL, DIMENSION(KLU,1) :: ZCF_NITRO
-REAL, DIMENSION(KLU,1) :: ZCNA_NITRO
-! MEB stuff
-REAL, DIMENSION(KLU,1) :: ZGNDLITTER
-REAL, DIMENSION(KLU,1) :: ZRGLGV
-REAL, DIMENSION(KLU,1) :: ZGAMMAGV
-REAL, DIMENSION(KLU,1) :: ZRSMINGV
-REAL, DIMENSION(KLU,1) :: ZWRMAX_CFGV
-REAL, DIMENSION(KLU,1) :: ZH_VEG
-REAL, DIMENSION(KLU,1) :: ZLAIGV
-REAL, DIMENSION(KLU,1) :: ZZ0LITTER
-!
-TYPE (DATE_TIME), DIMENSION(KLU,1) :: TZSEED
-TYPE (DATE_TIME), DIMENSION(KLU,1) :: TZREAP
-REAL, DIMENSION(KLU,1) :: ZWATSUP
-REAL, DIMENSION(KLU,1) :: ZIRRIG
-LOGICAL :: GUPDATED ! T if VEGETATION_UPDATE has reset fields
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. various initialisations
-! -----------------------
-!
-IF (LHOOK) CALL DR_HOOK('VEGETATION_UPDATE_GREENROF',0,ZHOOK_HANDLE)
-!
-!* orographic roughness not used
-!
-ZAOSIP = 0.
-ZAOSIM = 0.
-ZAOSJP = 0.
-ZAOSJM = 0.
-ZHO2IP = 0.
-ZHO2IM = 0.
-ZHO2JP = 0.
-ZHO2JM = 0.
-!
-!* vegetation parameters to update
-!
-ZVEG(:,1) = GRM%TGRPE%CUR%XVEG
-ZZ0(:,1) = GRM%TGRPE%CUR%XZ0
-ZALBNIR(:,1) = GRM%TGRPE%CUR%XALBNIR
-ZALBVIS(:,1) = GRM%TGRPE%CUR%XALBVIS
-ZALBUV(:,1) = GRM%TGRPE%CUR%XALBUV
-ZEMIS(:,1) = GRM%TGRPE%CUR%XEMIS
-ZRSMIN(:,1) = GRM%TGRP%XRSMIN
-ZGAMMA(:,1) = GRM%TGRP%XGAMMA
-ZWRMAX_CF(:,1) = GRM%TGRP%XWRMAX_CF
-ZRGL(:,1) = GRM%TGRP%XRGL
-ZCV(:,1) = GRM%TGRP%XCV
-ZGMES(:,1) = GRM%TGRP%XGMES
-ZBSLAI(:,1) = GRM%TGRP%XBSLAI
-ZLAIMIN(:,1) = GRM%TGRP%XLAIMIN
-ZSEFOLD(:,1) = GRM%TGRP%XSEFOLD
-ZGC(:,1) = GRM%TGRP%XGC
-ZDMAX(:,1) = GRM%TGRP%XDMAX
-ZF2I(:,1) = GRM%TGRP%XF2I
-GSTRESS(:,1) = GRM%TGRP%LSTRESS
-ZALBNIR_VEG(:,1) = GRM%TGRP%XALBNIR_VEG
-ZALBVIS_VEG(:,1) = GRM%TGRP%XALBVIS_VEG
-ZALBUV_VEG(:,1) = GRM%TGRP%XALBUV_VEG
-ZALBNIR_SOIL(:,1) = GRM%TGRP%XALBNIR_SOIL
-ZALBVIS_SOIL(:,1) = GRM%TGRP%XALBVIS_SOIL
-ZALBUV_SOIL(:,1) = GRM%TGRP%XALBUV_SOIL
-ZCE_NITRO(:,1) = GRM%TGRP%XCE_NITRO
-ZCF_NITRO(:,1) = GRM%TGRP%XCF_NITRO
-ZCNA_NITRO(:,1) = GRM%TGRP%XCNA_NITRO
-! --------------------------------------------------------------------------------------
-! Vegetation update (in case of non-interactive vegetation):
-! --------------------------------------------------------------------------------------
-!
-GUPDATED=.FALSE.
-IF (TVG%CPHOTO=='NON' .OR. TVG%CPHOTO=='AGS' .OR. TVG%CPHOTO=='AST') THEN
- CALL VEGETATION_UPDATE(DTCO, DTI, DTGD, GRM%DTGR, IG, I, GRM%TGRO, &
- PTSTEP,TPTIME,TOP%XCOVER,TOP%LCOVER, &
- TVG%CISBA,(.NOT. GRM%TGRO%LPAR_GREENROOF), TVG%CPHOTO, .FALSE., &
- TVG%LTR_ML, 'GR ', &
- ZLAI,ZVEG,ZZ0, &
- ZALBNIR,ZALBVIS,ZALBUV,ZEMIS, &
- ZRSMIN,ZGAMMA,ZWRMAX_CF, &
- ZRGL,ZCV, &
- ZGMES,ZBSLAI,ZLAIMIN,ZSEFOLD,ZGC,ZDMAX, &
- ZF2I, GSTRESS, &
- ZAOSIP,ZAOSIM,ZAOSJP,ZAOSJM, &
- ZHO2IP,ZHO2IM,ZHO2JP,ZHO2JM, &
- ZZ0EFFIP,ZZ0EFFIM,ZZ0EFFJP,ZZ0EFFJM, &
- TVG%CALBEDO, ZALBNIR_VEG, ZALBVIS_VEG, ZALBUV_VEG, &
- ZALBNIR_SOIL, ZALBVIS_SOIL, ZALBUV_SOIL, &
- ZCE_NITRO, ZCF_NITRO, ZCNA_NITRO, &
- TZSEED, TZREAP, ZWATSUP, ZIRRIG, &
- ZGNDLITTER, ZRGLGV,ZGAMMAGV, &
- ZRSMINGV, ZWRMAX_CFGV, &
- ZH_VEG, ZLAIGV, ZZ0LITTER, &
- GUPDATED, OABSENT=(T%CUR%XGREENROOF==0.) )
-END IF
-!
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-GRM%TGRPE%CUR%XVEG = ZVEG(:,1)
-GRM%TGRPE%CUR%XZ0 = ZZ0(:,1)
-GRM%TGRPE%CUR%XALBNIR = ZALBNIR(:,1)
-GRM%TGRPE%CUR%XALBVIS = ZALBVIS(:,1)
-GRM%TGRPE%CUR%XALBUV = ZALBUV(:,1)
-GRM%TGRPE%CUR%XEMIS = ZEMIS(:,1)
-GRM%TGRP%XRSMIN = ZRSMIN(:,1)
-GRM%TGRP%XGAMMA = ZGAMMA(:,1)
-GRM%TGRP%XWRMAX_CF = ZWRMAX_CF(:,1)
-GRM%TGRP%XRGL = ZRGL(:,1)
-GRM%TGRP%XCV = ZCV(:,1)
-GRM%TGRP%XGMES = ZGMES(:,1)
-GRM%TGRP%XBSLAI = ZBSLAI(:,1)
-GRM%TGRP%XLAIMIN = ZLAIMIN(:,1)
-GRM%TGRP%XSEFOLD = ZSEFOLD(:,1)
-GRM%TGRP%XGC = ZGC(:,1)
-GRM%TGRP%XDMAX = ZDMAX(:,1)
-GRM%TGRP%XF2I = ZF2I(:,1)
-GRM%TGRP%LSTRESS = GSTRESS(:,1)
-GRM%TGRP%XALBNIR_VEG = ZALBNIR_VEG(:,1)
-GRM%TGRP%XALBVIS_VEG = ZALBVIS_VEG(:,1)
-GRM%TGRP%XALBUV_VEG = ZALBUV_VEG(:,1)
-GRM%TGRP%XALBNIR_SOIL = ZALBNIR_SOIL(:,1)
-GRM%TGRP%XALBVIS_SOIL = ZALBVIS_SOIL(:,1)
-GRM%TGRP%XALBUV_SOIL = ZALBUV_SOIL(:,1)
-GRM%TGRP%XCE_NITRO = ZCE_NITRO(:,1)
-GRM%TGRP%XCF_NITRO = ZCF_NITRO(:,1)
-GRM%TGRP%XCNA_NITRO = ZCNA_NITRO(:,1)
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-!
-IF (LHOOK) CALL DR_HOOK('VEGETATION_UPDATE_GREENROOF',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-!
-END SUBROUTINE VEGETATION_UPDATE_GREENROOF
diff --git a/src/SURFEX/vegtype_grid_to_patch_grid.F90 b/src/SURFEX/vegtype_grid_to_patch_grid.F90
index d8febd9d5d89d763f49fed846a4708ba45e18679..75662c823390ef71f84625a4d5ceafedde050524 100644
--- a/src/SURFEX/vegtype_grid_to_patch_grid.F90
+++ b/src/SURFEX/vegtype_grid_to_patch_grid.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE VEGTYPE_GRID_TO_PATCH_GRID(KPATCH,PVEGTYPE_PATCH,PPATCH,PFIELDOUT,PW)
+SUBROUTINE VEGTYPE_GRID_TO_PATCH_GRID(KPATCH,KNPATCH,PVEGTYPE_PATCH,PPATCH,KMASK,PFIELDOUT,PW)
! ################################################
!!
!!**** *VEGTYPE_GRID_TO_PATCH_GRID* averages fields from all (12) vegtypes
@@ -46,36 +46,72 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
INTEGER, INTENT(IN) :: KPATCH
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVEGTYPE_PATCH
-REAL, DIMENSION(:,:), INTENT(IN) :: PPATCH
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDOUT
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PW
+INTEGER, INTENT(IN) :: KNPATCH
+REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE_PATCH
+REAL, DIMENSION(:), INTENT(IN) :: PPATCH
+INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDOUT
+REAL, DIMENSION(:,:), INTENT(OUT) :: PW
!
!
!* 0.2 declarations of local variables
!
-INTEGER :: JPATCH ! loop on patches
-INTEGER :: JVEGTYPE ! loop on vegtypes
-INTEGER :: JLAYER ! loop on layers
+REAL :: ZINT
+REAL, PARAMETER :: ZPREC=1.0E+6
+!
+REAL, DIMENSION(SIZE(PW,1)) :: ZSUM
+INTEGER :: JP ! loop on patches
+INTEGER :: JVEG ! loop on vegtypes
+INTEGER :: JL, JI, IMASK ! loop on layers
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!---------------------------------------------------------------------------
!
!* averages from vegtypes to chosen number of patches
IF (LHOOK) CALL DR_HOOK('VEGTYPE_GRID_TO_PATCH_GRID',0,ZHOOK_HANDLE)
-PW(:,:,:) = 0.
-DO JVEGTYPE=1,NVEGTYPE
- JPATCH = VEGTYPE_TO_PATCH(JVEGTYPE,KPATCH)
- DO JLAYER=1,SIZE(PW,2)
- PW(:,JLAYER,JPATCH) = PW(:,JLAYER,JPATCH) &
- + PVEGTYPE_PATCH(:,JVEGTYPE,JPATCH) * PFIELDOUT(:,JLAYER,JVEGTYPE)
+!
+ZSUM(:) = 0.
+DO JVEG=1,NVEGTYPE
+ JP = VEGTYPE_TO_PATCH(JVEG,KNPATCH)
+ IF (JP/=KPATCH) CYCLE
+ DO JI = 1,SIZE(PW,1)
+ ZSUM(JI) =ZSUM(JI) + PVEGTYPE_PATCH(JI,JVEG)
+ ENDDO
+ENDDO
+!
+PW(:,:) = 0.
+!
+DO JVEG=1,NVEGTYPE
+ JP = VEGTYPE_TO_PATCH(JVEG,KNPATCH)
+ IF (JP/=KPATCH) CYCLE
+ DO JL=1,SIZE(PW,2)
+ DO JI = 1,SIZE(PW,1)
+ IMASK = KMASK(JI)
+ PW(JI,JL) = PW(JI,JL) + PVEGTYPE_PATCH(JI,JVEG) * PFIELDOUT(IMASK,JL,JVEG)
+ ENDDO
END DO
END DO
!
+DO JI = 1,SIZE(PW,1)
+ IF (ZSUM(JI)/=0.) PW(JI,:) = PW(JI,:) / ZSUM(JI)
+ENDDO
+!
+DO JP = 1,SIZE(PW,2)
+ DO JI = 1,SIZE(PW,1)
+ IF (PW(JI,JP)/=XUNDEF) THEN
+ ZINT = AINT(PW(JI,JP),KIND=16)
+ IF (PW(JI,JP)/=ZINT) THEN
+ PW(JI,JP) = ZINT + NINT((PW(JI,JP)-ZINT)*ZPREC)/ZPREC
+ ENDIF
+ ENDIF
+ ENDDO
+ENDDO
+!
!* insures undefined value when patch is not present
-DO JPATCH=1,KPATCH
- DO JLAYER=1,SIZE(PW,2)
- WHERE(PPATCH(:,JPATCH)==0.) PW(:,JLAYER,JPATCH) = XUNDEF
+!
+DO JP=1,KNPATCH
+ DO JL=1,SIZE(PW,2)
+ WHERE(PPATCH(:)==0.) PW(:,JL) = XUNDEF
END DO
END DO
WHERE( ABS(PW-XUNDEF)/XUNDEF < 1.E-6 ) PW = XUNDEF
diff --git a/src/SURFEX/vegtype_to_patch.F90 b/src/SURFEX/vegtype_to_patch.F90
index 76dde944633efdfa2efd83847a96d314293d7e59..e39cb292376a291075cb96b9f26c9d81786eb511 100644
--- a/src/SURFEX/vegtype_to_patch.F90
+++ b/src/SURFEX/vegtype_to_patch.F90
@@ -44,9 +44,8 @@ USE MODD_DATA_COVER_PAR, ONLY : NVT_NO, NVT_ROCK, NVT_SNOW, NVT_TEBD, &
NVT_BONE, NVT_TRBE, NVT_C3, NVT_C4, &
NVT_IRR, NVT_GRAS, NVT_TROG,NVT_PARK, &
NVT_TRBD, NVT_TEBE, NVT_TENE, NVT_BOBD, &
- NVT_BOND, NVT_BOGR, NVT_SHRB
-!
-!
+ NVT_BOND, NVT_BOGR, NVT_SHRB, NVT_C3W, &
+ NVT_C3S, NVT_FLTR, NVT_FLGR, NVEGTYPE
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -59,7 +58,10 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: IVEGTYPE !indices of vegetation type
INTEGER, INTENT(IN) :: INPATCH !total number of PATCHES used
+!
INTEGER :: IPATCH_NB! PATCH index corresponding to the vegtype IVEGTYPE
+!
+ CHARACTER(LEN=2) :: YVEGTYPE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* 0.2 declarations of local variables
@@ -68,7 +70,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('VEGTYPE_TO_PATCH',0,ZHOOK_HANDLE)
IF (INPATCH==1) THEN
-IPATCH_NB = 1 ! default case
+ IPATCH_NB = 1 ! default case
END IF
!forest
@@ -76,184 +78,167 @@ IF (INPATCH==2) THEN
IF (IVEGTYPE== NVT_TEBD .OR. IVEGTYPE== NVT_TRBD .OR. IVEGTYPE== NVT_TEBE .OR. &
IVEGTYPE== NVT_BOBD .OR. IVEGTYPE== NVT_SHRB .OR. IVEGTYPE== NVT_BONE .OR. &
IVEGTYPE== NVT_TENE .OR. IVEGTYPE== NVT_BOND .OR. IVEGTYPE== NVT_TRBE) THEN
- IPATCH_NB=2
+ IPATCH_NB = 2
ELSE
- IPATCH_NB=1
+ IPATCH_NB = 1
END IF
END IF
!forest + low vegeation differenciation
IF (INPATCH==3) THEN
- IF (IVEGTYPE== NVT_NO .OR. IVEGTYPE== NVT_ROCK .OR. IVEGTYPE== NVT_SNOW ) IPATCH_NB= 1
- IF (IVEGTYPE== NVT_TEBD .OR. IVEGTYPE== NVT_TRBD .OR. IVEGTYPE== NVT_TEBE .OR. &
- IVEGTYPE== NVT_BOBD .OR. IVEGTYPE== NVT_SHRB .OR. IVEGTYPE== NVT_BONE .OR. &
- IVEGTYPE== NVT_TENE .OR. IVEGTYPE== NVT_BOND .OR. IVEGTYPE== NVT_TRBE) &
- IPATCH_NB=2
+ IF (IVEGTYPE== NVT_NO .OR. IVEGTYPE== NVT_ROCK .OR. IVEGTYPE== NVT_SNOW ) IPATCH_NB = 1
+ IF (IVEGTYPE== NVT_TEBD .OR. IVEGTYPE== NVT_TRBD .OR. IVEGTYPE== NVT_TEBE .OR. &
+ IVEGTYPE== NVT_BOBD .OR. IVEGTYPE== NVT_SHRB .OR. IVEGTYPE== NVT_BONE .OR. &
+ IVEGTYPE== NVT_TENE .OR. IVEGTYPE== NVT_BOND .OR. IVEGTYPE== NVT_TRBE .OR. &
+ IVEGTYPE== NVT_FLTR ) IPATCH_NB = 2
IF (IVEGTYPE== NVT_GRAS .OR. IVEGTYPE== NVT_BOGR .OR. IVEGTYPE== NVT_TROG .OR. &
- IVEGTYPE== NVT_PARK .OR. IVEGTYPE== NVT_C3 .OR. IVEGTYPE== NVT_C4 .OR. &
- IVEGTYPE== NVT_IRR ) IPATCH_NB=3
+ IVEGTYPE== NVT_PARK .OR. IVEGTYPE== NVT_C3 .OR. IVEGTYPE== NVT_C3W .OR. &
+ IVEGTYPE== NVT_C3S .OR. IVEGTYPE== NVT_C4 .OR. IVEGTYPE== NVT_IRR .OR. &
+ IVEGTYPE== NVT_FLGR ) IPATCH_NB = 3
END IF
!
!differenciation between irrigated crops and grassland and other low vegetation
IF (INPATCH==4) THEN
- IF (IVEGTYPE== NVT_NO .OR. IVEGTYPE== NVT_ROCK .OR. IVEGTYPE== NVT_SNOW ) IPATCH_NB= 1
- IF (IVEGTYPE== NVT_TEBD .OR. IVEGTYPE== NVT_TRBD .OR. IVEGTYPE== NVT_TEBE .OR. &
- IVEGTYPE== NVT_BOBD .OR. IVEGTYPE== NVT_SHRB .OR. IVEGTYPE== NVT_BONE .OR. &
- IVEGTYPE== NVT_TENE .OR. IVEGTYPE== NVT_BOND .OR. IVEGTYPE== NVT_TRBE) &
- IPATCH_NB=2
+ IF (IVEGTYPE== NVT_NO .OR. IVEGTYPE== NVT_ROCK .OR. IVEGTYPE== NVT_SNOW ) IPATCH_NB = 1
+ IF (IVEGTYPE== NVT_TEBD .OR. IVEGTYPE== NVT_TRBD .OR. IVEGTYPE== NVT_TEBE .OR. &
+ IVEGTYPE== NVT_BOBD .OR. IVEGTYPE== NVT_SHRB .OR. IVEGTYPE== NVT_BONE .OR. &
+ IVEGTYPE== NVT_TENE .OR. IVEGTYPE== NVT_BOND .OR. IVEGTYPE== NVT_TRBE .OR. &
+ IVEGTYPE== NVT_FLTR ) IPATCH_NB = 2
IF (IVEGTYPE== NVT_GRAS .OR. IVEGTYPE== NVT_BOGR .OR. IVEGTYPE== NVT_TROG .OR. &
- IVEGTYPE== NVT_C3 .OR. IVEGTYPE== NVT_C4 ) IPATCH_NB=3
- IF (IVEGTYPE == NVT_IRR .OR. IVEGTYPE == NVT_PARK) IPATCH_NB=4
+ IVEGTYPE== NVT_C3 .OR. IVEGTYPE== NVT_C3W .OR. IVEGTYPE== NVT_C3S .OR. &
+ IVEGTYPE== NVT_C4 ) IPATCH_NB = 3
+ IF (IVEGTYPE== NVT_IRR .OR. IVEGTYPE== NVT_PARK .OR. IVEGTYPE== NVT_FLGR) IPATCH_NB = 4
END IF
!
!differenciation between crops and other low vegetation
IF (INPATCH==5) THEN
- IF (IVEGTYPE== NVT_NO .OR. IVEGTYPE== NVT_ROCK .OR. IVEGTYPE== NVT_SNOW ) &
- IPATCH_NB= 1
- IF (IVEGTYPE== NVT_TEBD .OR. IVEGTYPE== NVT_TRBD .OR. IVEGTYPE== NVT_TEBE .OR. &
- IVEGTYPE== NVT_BOBD .OR. IVEGTYPE== NVT_SHRB .OR. IVEGTYPE== NVT_BONE .OR. &
- IVEGTYPE== NVT_TENE .OR. IVEGTYPE== NVT_BOND .OR. IVEGTYPE== NVT_TRBE) &
- IPATCH_NB=2
- IF (IVEGTYPE == NVT_C3 .OR. IVEGTYPE== NVT_C4 ) IPATCH_NB=3
- IF (IVEGTYPE == NVT_IRR .OR. IVEGTYPE == NVT_PARK) IPATCH_NB=4
- IF (IVEGTYPE == NVT_GRAS .OR. IVEGTYPE== NVT_BOGR .OR. IVEGTYPE== NVT_TROG ) &
- IPATCH_NB=5
+ IF (IVEGTYPE== NVT_NO .OR. IVEGTYPE== NVT_ROCK .OR. IVEGTYPE== NVT_SNOW ) IPATCH_NB = 1
+ IF (IVEGTYPE== NVT_TEBD .OR. IVEGTYPE== NVT_TRBD .OR. IVEGTYPE== NVT_TEBE .OR. &
+ IVEGTYPE== NVT_BOBD .OR. IVEGTYPE== NVT_SHRB .OR. IVEGTYPE== NVT_BONE .OR. &
+ IVEGTYPE== NVT_TENE .OR. IVEGTYPE== NVT_BOND .OR. IVEGTYPE== NVT_TRBE .OR. &
+ IVEGTYPE== NVT_FLTR ) IPATCH_NB = 2
+ IF (IVEGTYPE== NVT_C3 .OR. IVEGTYPE== NVT_C3W .OR. IVEGTYPE== NVT_C3S .OR. &
+ IVEGTYPE== NVT_C4 ) IPATCH_NB = 3
+ IF (IVEGTYPE== NVT_IRR .OR. IVEGTYPE== NVT_PARK .OR. IVEGTYPE== NVT_FLGR ) IPATCH_NB = 4
+ IF (IVEGTYPE== NVT_GRAS .OR. IVEGTYPE== NVT_BOGR .OR. IVEGTYPE== NVT_TROG ) IPATCH_NB = 5
END IF
!
-!differenciation between irrigated crops and gardens
+!differenciation between irrigated crops / flooded trees and gardens / flooded grassland
IF (INPATCH==6) THEN
- IF (IVEGTYPE== NVT_NO .OR. IVEGTYPE== NVT_ROCK .OR. IVEGTYPE== NVT_SNOW ) IPATCH_NB= 1
- IF (IVEGTYPE== NVT_TEBD .OR. IVEGTYPE== NVT_TRBD .OR. IVEGTYPE== NVT_TEBE .OR. &
- IVEGTYPE== NVT_BOBD .OR. IVEGTYPE== NVT_SHRB .OR. IVEGTYPE== NVT_BONE .OR. &
- IVEGTYPE== NVT_TENE .OR. IVEGTYPE== NVT_BOND .OR. IVEGTYPE== NVT_TRBE) &
- IPATCH_NB=2
- IF (IVEGTYPE == NVT_C3 .OR. IVEGTYPE== NVT_C4 ) IPATCH_NB=3
- IF (IVEGTYPE == NVT_IRR ) IPATCH_NB=4
- IF (IVEGTYPE == NVT_GRAS .OR. IVEGTYPE== NVT_BOGR .OR. IVEGTYPE== NVT_TROG) IPATCH_NB=5
- IF (IVEGTYPE == NVT_PARK) IPATCH_NB=6
+ IF (IVEGTYPE== NVT_NO .OR. IVEGTYPE== NVT_ROCK .OR. IVEGTYPE== NVT_SNOW ) IPATCH_NB = 1
+ IF (IVEGTYPE== NVT_TEBD .OR. IVEGTYPE== NVT_TRBD .OR. IVEGTYPE== NVT_TEBE .OR. &
+ IVEGTYPE== NVT_BOBD .OR. IVEGTYPE== NVT_SHRB .OR. IVEGTYPE== NVT_BONE .OR. &
+ IVEGTYPE== NVT_TENE .OR. IVEGTYPE== NVT_BOND .OR. IVEGTYPE== NVT_TRBE ) IPATCH_NB = 2
+ IF (IVEGTYPE== NVT_C3 .OR. IVEGTYPE== NVT_C3W .OR. IVEGTYPE== NVT_C3S .OR. &
+ IVEGTYPE== NVT_C4 ) IPATCH_NB = 3
+ IF (IVEGTYPE== NVT_IRR .OR. IVEGTYPE== NVT_FLTR) IPATCH_NB = 4
+ IF (IVEGTYPE== NVT_GRAS .OR. IVEGTYPE== NVT_BOGR .OR. IVEGTYPE== NVT_TROG ) IPATCH_NB = 5
+ IF (IVEGTYPE== NVT_PARK .OR. IVEGTYPE== NVT_FLGR) IPATCH_NB = 6
END IF
!
!differenciation between snow and other bare soils
IF (INPATCH==7) THEN
- IF (IVEGTYPE == NVT_NO .OR. IVEGTYPE== NVT_ROCK ) IPATCH_NB= 1
- IF (IVEGTYPE == NVT_SNOW) IPATCH_NB=2
- IF (IVEGTYPE== NVT_TEBD .OR. IVEGTYPE== NVT_TRBD .OR. IVEGTYPE== NVT_TEBE .OR. &
- IVEGTYPE== NVT_BOBD .OR. IVEGTYPE== NVT_SHRB .OR. IVEGTYPE== NVT_BONE .OR. &
- IVEGTYPE== NVT_TENE .OR. IVEGTYPE== NVT_BOND .OR. IVEGTYPE== NVT_TRBE) &
- IPATCH_NB=3
- IF (IVEGTYPE == NVT_C3 .OR. IVEGTYPE== NVT_C4 ) IPATCH_NB=4
- IF (IVEGTYPE == NVT_IRR ) IPATCH_NB=5
- IF (IVEGTYPE == NVT_GRAS .OR. IVEGTYPE== NVT_BOGR .OR. IVEGTYPE== NVT_TROG) IPATCH_NB=6
- IF (IVEGTYPE == NVT_PARK) IPATCH_NB=7
+ IF (IVEGTYPE== NVT_NO .OR. IVEGTYPE== NVT_ROCK ) IPATCH_NB = 1
+ IF (IVEGTYPE== NVT_SNOW) IPATCH_NB = 2
+ IF (IVEGTYPE== NVT_TEBD .OR. IVEGTYPE== NVT_TRBD .OR. IVEGTYPE== NVT_TEBE .OR. &
+ IVEGTYPE== NVT_BOBD .OR. IVEGTYPE== NVT_SHRB .OR. IVEGTYPE== NVT_BONE .OR. &
+ IVEGTYPE== NVT_TENE .OR. IVEGTYPE== NVT_BOND .OR. IVEGTYPE== NVT_TRBE) IPATCH_NB = 3
+ IF (IVEGTYPE== NVT_C3 .OR. IVEGTYPE== NVT_C3W .OR. IVEGTYPE== NVT_C3S .OR. &
+ IVEGTYPE== NVT_C4 ) IPATCH_NB = 4
+ IF (IVEGTYPE== NVT_IRR .OR. IVEGTYPE== NVT_FLTR) IPATCH_NB = 5
+ IF (IVEGTYPE== NVT_GRAS .OR. IVEGTYPE== NVT_BOGR .OR. IVEGTYPE== NVT_TROG) IPATCH_NB = 6
+ IF (IVEGTYPE== NVT_PARK .OR. IVEGTYPE== NVT_FLGR) IPATCH_NB = 7
END IF
!
!differenciation between C3 and C4 crops
IF (INPATCH==8) THEN
- IF (IVEGTYPE == NVT_NO .OR. IVEGTYPE== NVT_ROCK ) IPATCH_NB= 1
- IF (IVEGTYPE == NVT_SNOW) IPATCH_NB=2
- IF (IVEGTYPE== NVT_TEBD .OR. IVEGTYPE== NVT_TRBD .OR. IVEGTYPE== NVT_TEBE .OR. &
- IVEGTYPE== NVT_BOBD .OR. IVEGTYPE== NVT_SHRB .OR. IVEGTYPE== NVT_BONE .OR. &
- IVEGTYPE== NVT_TENE .OR. IVEGTYPE== NVT_BOND .OR. IVEGTYPE== NVT_TRBE) &
- IPATCH_NB=3
- IF (IVEGTYPE == NVT_C3 ) IPATCH_NB=4
- IF (IVEGTYPE == NVT_C4 ) IPATCH_NB=5
- IF (IVEGTYPE == NVT_IRR ) IPATCH_NB=6
- IF (IVEGTYPE == NVT_GRAS .OR. IVEGTYPE== NVT_BOGR .OR. IVEGTYPE== NVT_TROG) IPATCH_NB=7
- IF (IVEGTYPE == NVT_PARK) IPATCH_NB=8
+ IF (IVEGTYPE== NVT_NO .OR. IVEGTYPE== NVT_ROCK ) IPATCH_NB = 1
+ IF (IVEGTYPE== NVT_SNOW) IPATCH_NB = 2
+ IF (IVEGTYPE== NVT_TEBD .OR. IVEGTYPE== NVT_TRBD .OR. IVEGTYPE== NVT_TEBE .OR. &
+ IVEGTYPE== NVT_BOBD .OR. IVEGTYPE== NVT_SHRB .OR. IVEGTYPE== NVT_BONE .OR. &
+ IVEGTYPE== NVT_TENE .OR. IVEGTYPE== NVT_BOND .OR. IVEGTYPE== NVT_TRBE) IPATCH_NB = 3
+ IF (IVEGTYPE== NVT_C3 .OR. IVEGTYPE== NVT_C3W .OR. IVEGTYPE== NVT_C3S) IPATCH_NB = 4
+ IF (IVEGTYPE== NVT_C4 ) IPATCH_NB = 5
+ IF (IVEGTYPE== NVT_IRR .OR. IVEGTYPE== NVT_FLTR) IPATCH_NB = 6
+ IF (IVEGTYPE== NVT_GRAS .OR. IVEGTYPE== NVT_BOGR .OR. IVEGTYPE== NVT_TROG) IPATCH_NB = 7
+ IF (IVEGTYPE== NVT_PARK .OR. IVEGTYPE== NVT_FLGR) IPATCH_NB = 8
END IF
!
!differenciation between coniferous and broadleaf forests
IF (INPATCH==9) THEN
- IF (IVEGTYPE == NVT_NO .OR. IVEGTYPE== NVT_ROCK ) IPATCH_NB= 1
- IF (IVEGTYPE == NVT_SNOW) IPATCH_NB=2
+ IF (IVEGTYPE== NVT_NO .OR. IVEGTYPE== NVT_ROCK ) IPATCH_NB = 1
+ IF (IVEGTYPE== NVT_SNOW) IPATCH_NB = 2
IF (IVEGTYPE== NVT_TEBD .OR. IVEGTYPE== NVT_TRBD .OR. IVEGTYPE== NVT_TEBE .OR. &
- IVEGTYPE== NVT_BOBD .OR. IVEGTYPE== NVT_SHRB .OR. IVEGTYPE== NVT_TRBE )IPATCH_NB=3
- IF (IVEGTYPE== NVT_BONE .OR. IVEGTYPE== NVT_TENE .OR. IVEGTYPE== NVT_BOND) IPATCH_NB=4
- IF (IVEGTYPE == NVT_C3 ) IPATCH_NB=5
- IF (IVEGTYPE == NVT_C4 ) IPATCH_NB=6
- IF (IVEGTYPE == NVT_IRR ) IPATCH_NB=7
- IF (IVEGTYPE == NVT_GRAS .OR. IVEGTYPE== NVT_BOGR .OR. IVEGTYPE== NVT_TROG) IPATCH_NB=8
- IF (IVEGTYPE == NVT_PARK) IPATCH_NB=9
+ IVEGTYPE== NVT_BOBD .OR. IVEGTYPE== NVT_SHRB .OR. IVEGTYPE== NVT_TRBE )IPATCH_NB = 3
+ IF (IVEGTYPE== NVT_BONE .OR. IVEGTYPE== NVT_TENE .OR. IVEGTYPE== NVT_BOND) IPATCH_NB = 4
+ IF (IVEGTYPE== NVT_C3 .OR. IVEGTYPE== NVT_C3W .OR. IVEGTYPE== NVT_C3S) IPATCH_NB = 5
+ IF (IVEGTYPE== NVT_C4 ) IPATCH_NB = 6
+ IF (IVEGTYPE== NVT_IRR .OR. IVEGTYPE== NVT_FLTR) IPATCH_NB = 7
+ IF (IVEGTYPE== NVT_GRAS .OR. IVEGTYPE== NVT_BOGR .OR. IVEGTYPE== NVT_TROG) IPATCH_NB = 8
+ IF (IVEGTYPE== NVT_PARK .OR. IVEGTYPE== NVT_FLGR) IPATCH_NB = 9
END IF
!
!differenciation between evergreen and deciduous broadleaf forests
IF (INPATCH==10) THEN
- IF (IVEGTYPE == NVT_NO .OR. IVEGTYPE== NVT_ROCK ) IPATCH_NB= 1
- IF (IVEGTYPE == NVT_SNOW) IPATCH_NB=2
+ IF (IVEGTYPE== NVT_NO .OR. IVEGTYPE== NVT_ROCK ) IPATCH_NB = 1
+ IF (IVEGTYPE== NVT_SNOW) IPATCH_NB = 2
IF (IVEGTYPE== NVT_TEBD .OR. IVEGTYPE== NVT_TRBD .OR. IVEGTYPE== NVT_TEBE .OR. &
- IVEGTYPE== NVT_BOBD .OR. IVEGTYPE== NVT_SHRB) IPATCH_NB=3
- IF (IVEGTYPE== NVT_BONE .OR. IVEGTYPE== NVT_TENE .OR. IVEGTYPE== NVT_BOND) IPATCH_NB=4
- IF (IVEGTYPE== NVT_TRBE ) IPATCH_NB=5
- IF (IVEGTYPE == NVT_C3 ) IPATCH_NB=6
- IF (IVEGTYPE == NVT_C4 ) IPATCH_NB=7
- IF (IVEGTYPE == NVT_IRR ) IPATCH_NB=8
- IF (IVEGTYPE == NVT_GRAS .OR. IVEGTYPE== NVT_BOGR .OR. IVEGTYPE== NVT_TROG) IPATCH_NB=9
- IF (IVEGTYPE == NVT_PARK) IPATCH_NB=10
+ IVEGTYPE== NVT_BOBD .OR. IVEGTYPE== NVT_SHRB) IPATCH_NB = 3
+ IF (IVEGTYPE== NVT_BONE .OR. IVEGTYPE== NVT_TENE .OR. IVEGTYPE== NVT_BOND) IPATCH_NB = 4
+ IF (IVEGTYPE== NVT_TRBE ) IPATCH_NB = 5
+ IF (IVEGTYPE== NVT_C3 .OR. IVEGTYPE== NVT_C3W .OR. IVEGTYPE== NVT_C3S) IPATCH_NB = 6
+ IF (IVEGTYPE== NVT_C4 ) IPATCH_NB = 7
+ IF (IVEGTYPE== NVT_IRR .OR. IVEGTYPE== NVT_FLTR) IPATCH_NB = 8
+ IF (IVEGTYPE== NVT_GRAS .OR. IVEGTYPE== NVT_BOGR .OR. IVEGTYPE== NVT_TROG) IPATCH_NB = 9
+ IF (IVEGTYPE== NVT_PARK .OR. IVEGTYPE== NVT_FLGR) IPATCH_NB = 10
END IF
!
!differenciation between rocks and flat bare soil
IF (INPATCH==11) THEN
- IF (IVEGTYPE == NVT_NO ) IPATCH_NB=1
- IF (IVEGTYPE == NVT_ROCK ) IPATCH_NB=2
- IF (IVEGTYPE == NVT_SNOW ) IPATCH_NB=3
+ IF (IVEGTYPE== NVT_NO ) IPATCH_NB = 1
+ IF (IVEGTYPE== NVT_ROCK ) IPATCH_NB = 2
+ IF (IVEGTYPE== NVT_SNOW ) IPATCH_NB = 3
IF (IVEGTYPE== NVT_TEBD .OR. IVEGTYPE== NVT_TRBD .OR. IVEGTYPE== NVT_TEBE .OR. &
- IVEGTYPE== NVT_BOBD .OR. IVEGTYPE== NVT_SHRB) IPATCH_NB=4
- IF (IVEGTYPE== NVT_BONE .OR. IVEGTYPE== NVT_TENE .OR. IVEGTYPE== NVT_BOND) IPATCH_NB=5
- IF (IVEGTYPE== NVT_TRBE ) IPATCH_NB=6
- IF (IVEGTYPE == NVT_C3 ) IPATCH_NB=7
- IF (IVEGTYPE == NVT_C4 ) IPATCH_NB=8
- IF (IVEGTYPE == NVT_IRR ) IPATCH_NB=9
- IF (IVEGTYPE == NVT_GRAS .OR. IVEGTYPE== NVT_BOGR .OR. IVEGTYPE== NVT_TROG) IPATCH_NB=10
- IF (IVEGTYPE == NVT_PARK) IPATCH_NB=11
+ IVEGTYPE== NVT_BOBD .OR. IVEGTYPE== NVT_SHRB) IPATCH_NB = 4
+ IF (IVEGTYPE== NVT_BONE .OR. IVEGTYPE== NVT_TENE .OR. IVEGTYPE== NVT_BOND) IPATCH_NB = 5
+ IF (IVEGTYPE== NVT_TRBE ) IPATCH_NB = 6
+ IF (IVEGTYPE== NVT_C3 .OR. IVEGTYPE== NVT_C3W .OR. IVEGTYPE== NVT_C3S ) IPATCH_NB = 7
+ IF (IVEGTYPE== NVT_C4 ) IPATCH_NB = 8
+ IF (IVEGTYPE== NVT_IRR .OR. IVEGTYPE== NVT_FLTR) IPATCH_NB = 9
+ IF (IVEGTYPE== NVT_GRAS .OR. IVEGTYPE== NVT_BOGR .OR. IVEGTYPE== NVT_TROG) IPATCH_NB = 10
+ IF (IVEGTYPE== NVT_PARK .OR. IVEGTYPE== NVT_FLGR) IPATCH_NB = 11
END IF
!
!differenciation between tropical and temperate grasslands
IF (INPATCH==12) THEN
- IF (IVEGTYPE == NVT_NO ) IPATCH_NB=1
- IF (IVEGTYPE == NVT_ROCK ) IPATCH_NB=2
- IF (IVEGTYPE == NVT_SNOW ) IPATCH_NB=3
+ IF (IVEGTYPE== NVT_NO ) IPATCH_NB = 1
+ IF (IVEGTYPE== NVT_ROCK ) IPATCH_NB = 2
+ IF (IVEGTYPE== NVT_SNOW ) IPATCH_NB = 3
IF (IVEGTYPE== NVT_TEBD .OR. IVEGTYPE== NVT_TRBD .OR. IVEGTYPE== NVT_TEBE .OR. &
- IVEGTYPE== NVT_BOBD .OR. IVEGTYPE== NVT_SHRB) IPATCH_NB=4
- IF (IVEGTYPE== NVT_BONE .OR. IVEGTYPE== NVT_TENE .OR. IVEGTYPE== NVT_BOND) IPATCH_NB=5
- IF (IVEGTYPE== NVT_TRBE ) IPATCH_NB=6
- IF (IVEGTYPE == NVT_C3 ) IPATCH_NB=7
- IF (IVEGTYPE == NVT_C4 ) IPATCH_NB=8
- IF (IVEGTYPE == NVT_IRR ) IPATCH_NB=9
- IF (IVEGTYPE == NVT_GRAS .OR. IVEGTYPE== NVT_BOGR) IPATCH_NB=10
- IF (IVEGTYPE == NVT_TROG ) IPATCH_NB=11
- IF (IVEGTYPE == NVT_PARK) IPATCH_NB=12
+ IVEGTYPE== NVT_BOBD .OR. IVEGTYPE== NVT_SHRB) IPATCH_NB = 4
+ IF (IVEGTYPE== NVT_BONE .OR. IVEGTYPE== NVT_TENE .OR. IVEGTYPE== NVT_BOND) IPATCH_NB = 5
+ IF (IVEGTYPE== NVT_TRBE ) IPATCH_NB = 6
+ IF (IVEGTYPE== NVT_C3 .OR. IVEGTYPE== NVT_C3W .OR. IVEGTYPE== NVT_C3S ) IPATCH_NB = 7
+ IF (IVEGTYPE== NVT_C4 ) IPATCH_NB = 8
+ IF (IVEGTYPE== NVT_IRR .OR. IVEGTYPE== NVT_FLTR) IPATCH_NB = 9
+ IF (IVEGTYPE== NVT_GRAS .OR. IVEGTYPE== NVT_BOGR) IPATCH_NB = 10
+ IF (IVEGTYPE== NVT_TROG ) IPATCH_NB = 11
+ IF (IVEGTYPE== NVT_PARK .OR. IVEGTYPE== NVT_FLGR) IPATCH_NB = 12
END IF
!
-IF (INPATCH==19) THEN
- IF (IVEGTYPE == NVT_NO ) IPATCH_NB=1
- IF (IVEGTYPE == NVT_ROCK ) IPATCH_NB=2
- IF (IVEGTYPE == NVT_SNOW ) IPATCH_NB=3
- IF (IVEGTYPE == NVT_TEBD ) IPATCH_NB=4
- IF (IVEGTYPE == NVT_BONE ) IPATCH_NB=5
- IF (IVEGTYPE == NVT_TRBE ) IPATCH_NB=6
- IF (IVEGTYPE == NVT_C3 ) IPATCH_NB=7
- IF (IVEGTYPE == NVT_C4 ) IPATCH_NB=8
- IF (IVEGTYPE == NVT_IRR ) IPATCH_NB=9
- IF (IVEGTYPE == NVT_GRAS ) IPATCH_NB=10
- IF (IVEGTYPE == NVT_TROG ) IPATCH_NB=11
- IF (IVEGTYPE == NVT_PARK ) IPATCH_NB=12
- IF (IVEGTYPE == NVT_TRBD ) IPATCH_NB=13
- IF (IVEGTYPE == NVT_TEBE ) IPATCH_NB=14
- IF (IVEGTYPE == NVT_TENE ) IPATCH_NB=15
- IF (IVEGTYPE == NVT_BOBD ) IPATCH_NB=16
- IF (IVEGTYPE == NVT_BOND ) IPATCH_NB=17
- IF (IVEGTYPE == NVT_BOGR ) IPATCH_NB=18
- IF (IVEGTYPE == NVT_SHRB ) IPATCH_NB=19
+IF (INPATCH==19 .OR. INPATCH==20) THEN
+ IPATCH_NB = IVEGTYPE
END IF
!
-IF (INPATCH>12.AND.INPATCH<19) THEN
- CALL ABOR1_SFX('VEGTYPE_TO_PATCH: NPATCH MUST BE INFERIOR OR EQUAL TO 12 OR EQUAL TO 19')
+WRITE(YVEGTYPE,"(I2.2)") NVEGTYPE
+IF (INPATCH>12.AND.INPATCH<NVEGTYPE) THEN
+ CALL ABOR1_SFX('VEGTYPE_TO_PATCH: NPATCH MUST BE INFERIOR OR EQUAL TO 12 OR EQUAL TO '//YVEGTYPE)
END IF
-IF (INPATCH>19) THEN
- CALL ABOR1_SFX('VEGTYPE_TO_PATCH: NPATCH BIGGER THAN 19 IS TOO LARGE')
+IF (INPATCH>NVEGTYPE) THEN
+ CALL ABOR1_SFX('VEGTYPE_TO_PATCH: NPATCH BIGGER THAN '//YVEGTYPE//' IS TOO LARGE')
END IF
IF (LHOOK) CALL DR_HOOK('VEGTYPE_TO_PATCH',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/ver_interp_lin3d_surf.F90 b/src/SURFEX/ver_interp_lin3d_surf.F90
index 23d85507cc768956b79141ecf8d3c16545d679be..f5d8d503ac39aac697492285919c0469aea0794e 100644
--- a/src/SURFEX/ver_interp_lin3d_surf.F90
+++ b/src/SURFEX/ver_interp_lin3d_surf.F90
@@ -6,50 +6,6 @@
FUNCTION VER_INTERP_LIN3D_SURF(PVAR1,KKLIN,PCOEFLIN) RESULT(PVAR2)
! ##############################################
!
-!!**** *VER_INTERP_LIN* - vertical linear interpolation
-!!
-!! PURPOSE
-!! -------
-! This function interpolates the 3D fields from one grid
-! to another using linear interpolation cofficients stored in module
-! MODD_VER_INTERP_LIN.
-!
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book 2
-!!
-!! AUTHOR
-!! ------
-!!
-! V.Masson Meteo-France
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 18/07/97
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
REAL, DIMENSION(:,:,:), INTENT(IN) :: PVAR1 ! variable values on the initial
! ! grid
INTEGER,DIMENSION(:,:,:), INTENT(IN) :: KKLIN ! lower interpolating level of
@@ -59,25 +15,4 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PCOEFLIN ! coefficient for level KKLIN
REAL, DIMENSION(SIZE(KKLIN,1),SIZE(KKLIN,2),SIZE(KKLIN,3)) &
:: PVAR2 ! variable values on target
! ! grid
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-INTEGER :: JI,JJ,JK2
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('MODI_VER_INTERP_LIN3D_SURF:VER_INTERP_LIN3D_SURF',0,ZHOOK_HANDLE)
-DO JK2=1,SIZE(KKLIN,3)
- DO JJ=1,SIZE(KKLIN,2)
- DO JI=1,SIZE(KKLIN,1)
- PVAR2(JI,JJ,JK2)= PCOEFLIN(JI,JJ,JK2) *PVAR1(JI,JJ,KKLIN(JI,JJ,JK2) )&
- +(1.-PCOEFLIN(JI,JJ,JK2))*PVAR1(JI,JJ,KKLIN(JI,JJ,JK2)+1)
- END DO
- END DO
-END DO
-IF (LHOOK) CALL DR_HOOK('MODI_VER_INTERP_LIN3D_SURF:VER_INTERP_LIN3D_SURF',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
END FUNCTION VER_INTERP_LIN3D_SURF
diff --git a/src/SURFEX/ver_interp_lin_surf.F90 b/src/SURFEX/ver_interp_lin_surf.F90
index bbcd92167a901fa617cc4cf85d2937a539e36644..9358107d1145831bc1162167e8cfdbab6c335cdd 100644
--- a/src/SURFEX/ver_interp_lin_surf.F90
+++ b/src/SURFEX/ver_interp_lin_surf.F90
@@ -5,307 +5,4 @@
! ######################
MODULE MODI_VER_INTERP_LIN_SURF
! ######################
-INTERFACE VER_INTERP_LIN_SURF
-! ##############################################
- FUNCTION VER_INTERP_LIN3D_SURF_BIS(PVAR1,KKLIN,PCOEFLIN) RESULT(PVAR2)
-! ##############################################
-!
-! third dimension of the arrays is vertical
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVAR1 ! variable values on the initial
-! ! grid
-INTEGER,DIMENSION(:,:,:), INTENT(IN) :: KKLIN ! lower interpolating level of
-! ! grid 1 for each level of grid 2
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCOEFLIN ! coefficient for level KKLIN
-!
-REAL, DIMENSION(SIZE(KKLIN,1),SIZE(KKLIN,2),SIZE(KKLIN,3)) &
- :: PVAR2 ! variable values on target
-! ! grid
-END FUNCTION VER_INTERP_LIN3D_SURF_BIS
-! ##############################################
- FUNCTION VER_INTERP_LIN2D_SURF(PVAR1,KKLIN,PCOEFLIN) RESULT(PVAR2)
-! ##############################################
-!
-! second dimension of the arrays is vertical
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PVAR1 ! variable values on the initial
-! ! grid
-INTEGER,DIMENSION(:,:), INTENT(IN) :: KKLIN ! lower interpolating level of
-! ! grid 1 for each level of grid 2
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOEFLIN ! coefficient for level KKLIN
-!
-REAL, DIMENSION(SIZE(KKLIN,1),SIZE(KKLIN,2)) &
- :: PVAR2 ! variable values on target
-! ! grid
-END FUNCTION VER_INTERP_LIN2D_SURF
-! ##############################################
- FUNCTION VER_INTERP_LIN1D_SURF(PVAR1,KKLIN,PCOEFLIN) RESULT(PVAR2)
-! ##############################################
-!
-! first dimension of the arrays is vertical
-!
-REAL, DIMENSION(:), INTENT(IN) :: PVAR1 ! variable values on the initial
-! ! grid
-INTEGER,DIMENSION(:), INTENT(IN) :: KKLIN ! lower interpolating level of
-! ! grid 1 for each level of grid 2
-REAL, DIMENSION(:), INTENT(IN) :: PCOEFLIN ! coefficient for level KKLIN
-!
-REAL, DIMENSION(SIZE(KKLIN)) :: PVAR2 ! variable values on target
-! ! grid
-END FUNCTION VER_INTERP_LIN1D_SURF
-!
-!
-END INTERFACE
END MODULE MODI_VER_INTERP_LIN_SURF
-! ##############################################
- FUNCTION VER_INTERP_LIN3D_SURF_BIS(PVAR1,KKLIN,PCOEFLIN) RESULT(PVAR2)
-! ##############################################
-!
-!!**** *VER_INTERP_LIN* - vertical linear interpolation
-!!
-!! PURPOSE
-!! -------
-! This function interpolates the 3D fields from one grid
-! to another using linear interpolation cofficients stored in module
-! MODD_VER_INTERP_LIN.
-!
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book 2
-!!
-!! AUTHOR
-!! ------
-!!
-! V.Masson Meteo-France
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 18/07/97
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODI_VER_INTERP_LIN3D_SURF
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVAR1 ! variable values on the initial
-! ! grid
-INTEGER,DIMENSION(:,:,:), INTENT(IN) :: KKLIN ! lower interpolating level of
-! ! grid 1 for each level of grid 2
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCOEFLIN ! coefficient for level KKLIN
-!
-REAL, DIMENSION(SIZE(KKLIN,1),SIZE(KKLIN,2),SIZE(KKLIN,3)) &
- :: PVAR2 ! variable values on target
-! ! grid
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-INTEGER :: JI,JJ,JK2
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('MODI_VER_INTERP_LIN_SURF:VER_INTERP_LIN3D_SURF_BIS',0,ZHOOK_HANDLE)
-PVAR2(:,:,:)=VER_INTERP_LIN3D_SURF(PVAR1(:,:,:),KKLIN(:,:,:),PCOEFLIN(:,:,:))
-IF (LHOOK) CALL DR_HOOK('MODI_VER_INTERP_LIN_SURF:VER_INTERP_LIN3D_SURF_BIS',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END FUNCTION VER_INTERP_LIN3D_SURF_BIS
-! ##############################################
- FUNCTION VER_INTERP_LIN2D_SURF(PVAR1,KKLIN,PCOEFLIN) RESULT(PVAR2)
-! ##############################################
-!
-!!**** *VER_INTERP_LIN* - vertical linear interpolation
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** METHOD
-!! ------
-!!
-!! This routine calls the 3D version of VER_INTERP_LIN after rewritting of
-!! the fields under 3D form.
-!!
-!! EXTERNAL
-!! --------
-!!
-!! function VER_INTERP_LIN3D
-!! module MODI_VER_INTERP_LIN3D
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book 2
-!!
-!! AUTHOR
-!! ------
-!!
-! V.Masson Meteo-France
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 17/07/97
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODI_VER_INTERP_LIN3D_SURF
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-REAL, DIMENSION(:,:), INTENT(IN) :: PVAR1 ! variable values on the initial
-! ! grid
-INTEGER,DIMENSION(:,:), INTENT(IN) :: KKLIN ! lower interpolating level of
-! ! grid 1 for each level of grid 2
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOEFLIN ! coefficient for level KKLIN
-!
-REAL, DIMENSION(SIZE(KKLIN,1),SIZE(KKLIN,2)) :: PVAR2 ! variable values on
-! ! target grid
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-REAL, DIMENSION(1,SIZE(PVAR1,1),SIZE(PVAR1,2)) :: ZVAR1 ! variable values on the initial
-! ! grid
-REAL, DIMENSION(1,SIZE(KKLIN,1),SIZE(KKLIN,2)) :: ZVAR2 ! variable values on target
-!
-INTEGER,DIMENSION(1,SIZE(KKLIN,1),SIZE(KKLIN,2)) :: IKLIN ! lower interpolating level of
-! ! grid 1 for each level of grid 2
-REAL, DIMENSION(1,SIZE(PCOEFLIN,1),SIZE(PCOEFLIN,2)):: ZCOEFLIN ! coefficient for level KKLIN
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('MODI_VER_INTERP_LIN_SURF:VER_INTERP_LIN2D_SURF',0,ZHOOK_HANDLE)
-ZVAR1(1,:,:)=PVAR1(:,:)
-IKLIN(1,:,:)=KKLIN(:,:)
-ZCOEFLIN(1,:,:)=PCOEFLIN(:,:)
-!
-ZVAR2(:,:,:)=VER_INTERP_LIN3D_SURF(ZVAR1(:,:,:),IKLIN(:,:,:),ZCOEFLIN(:,:,:))
-!
-PVAR2(:,:) =ZVAR2(1,:,:)
-IF (LHOOK) CALL DR_HOOK('MODI_VER_INTERP_LIN_SURF:VER_INTERP_LIN2D_SURF',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END FUNCTION VER_INTERP_LIN2D_SURF
-! ##############################################
- FUNCTION VER_INTERP_LIN1D_SURF(PVAR1,KKLIN,PCOEFLIN) RESULT(PVAR2)
-! ##############################################
-!
-!!**** *VER_INTERP_LIN* - vertical linear interpolation
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** METHOD
-!! ------
-!!
-!! This routine calls the 3D version of VER_INTERP_LIN after rewritting of
-!! the fields under 3D form.
-!!
-!! EXTERNAL
-!! --------
-!!
-!! function VER_INTERP_LIN3D
-!! module MODI_VER_INTERP_LIN3D
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book 2
-!!
-!! AUTHOR
-!! ------
-!!
-! V.Masson Meteo-France
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 17/07/97
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODI_VER_INTERP_LIN3D_SURF
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-REAL, DIMENSION(:), INTENT(IN) :: PVAR1 ! variable values on the initial
-! ! grid
-INTEGER,DIMENSION(:), INTENT(IN) :: KKLIN ! lower interpolating level of
-! ! grid 1 for each level of grid 2
-REAL, DIMENSION(:), INTENT(IN) :: PCOEFLIN ! coefficient for level KKLIN
-
-REAL, DIMENSION(SIZE(KKLIN)) :: PVAR2 ! variable values on target
-! ! grid
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-INTEGER,DIMENSION(1,1,SIZE(KKLIN)) :: IKLIN ! lower interpolating level of
-! ! grid 1 for each level of grid 2
-REAL, DIMENSION(1,1,SIZE(PCOEFLIN)) :: ZCOEFLIN ! coefficient for level KKLIN
-!
-REAL, DIMENSION(1,1,SIZE(PVAR1)) :: ZVAR1 ! variable values on the initial
-! ! grid
-REAL, DIMENSION(1,1,SIZE(KKLIN)) :: ZVAR2 ! variable values on target
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('MODI_VER_INTERP_LIN_SURF:VER_INTERP_LIN1D_SURF',0,ZHOOK_HANDLE)
-ZVAR1(1,1,:)=PVAR1(:)
-IKLIN(1,1,:)=KKLIN(:)
-ZCOEFLIN(1,1,:)=PCOEFLIN(:)
-!
-ZVAR2(:,:,:)=VER_INTERP_LIN3D_SURF(ZVAR1(:,:,:),IKLIN(:,:,:),ZCOEFLIN(:,:,:))
-!
-PVAR2(:) =ZVAR2(1,1,:)
-IF (LHOOK) CALL DR_HOOK('MODI_VER_INTERP_LIN_SURF:VER_INTERP_LIN1D_SURF',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END FUNCTION VER_INTERP_LIN1D_SURF
diff --git a/src/SURFEX/vslog.F90 b/src/SURFEX/vslog.F90
index 0bf720429420d12e1a94efe2e8e25c7c24fedcfd..c0f5e6510b69ad6ba23f46a731409b9c7297ddd0 100644
--- a/src/SURFEX/vslog.F90
+++ b/src/SURFEX/vslog.F90
@@ -1,29 +1,29 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SFX_LIC for details. version 1.
- SUBROUTINE VSLOG(PA,PLOG,N)
-!
- USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
- USE PARKIND1 ,ONLY : JPRB
-!
-!
-!
-
-! COMPUTES THE LOGARITHM
-
- IMPLICIT NONE
-
- INTEGER :: N
- REAL :: PA(N), PLOG(N)
-
- INTEGER :: J
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
- IF (LHOOK) CALL DR_HOOK('VSLOG',0,ZHOOK_HANDLE)
- DO J=1,N
- PLOG(J) = LOG(PA(J))
- END DO
- IF (LHOOK) CALL DR_HOOK('VSLOG',1,ZHOOK_HANDLE)
-
- END SUBROUTINE VSLOG
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+ SUBROUTINE VSLOG(PA,PLOG,N)
+!
+ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+ USE PARKIND1 ,ONLY : JPRB
+!
+!
+!
+
+! COMPUTES THE LOGARITHM
+
+ IMPLICIT NONE
+
+ INTEGER :: N
+ REAL :: PA(N), PLOG(N)
+
+ INTEGER :: J
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ IF (LHOOK) CALL DR_HOOK('VSLOG',0,ZHOOK_HANDLE)
+ DO J=1,N
+ PLOG(J) = LOG(PA(J))
+ END DO
+ IF (LHOOK) CALL DR_HOOK('VSLOG',1,ZHOOK_HANDLE)
+
+ END
diff --git a/src/SURFEX/wall_layer_e_budget.F90 b/src/SURFEX/wall_layer_e_budget.F90
index 8830fe9add239f5e033e929f1a087cd8d8486c01..27263535e7f56336593fa6ea557fa34db7a5f7a3 100644
--- a/src/SURFEX/wall_layer_e_budget.F90
+++ b/src/SURFEX/wall_layer_e_budget.F90
@@ -3,19 +3,14 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ##########################################################################
- SUBROUTINE WALL_LAYER_E_BUDGET(HBEM, PT_WALL, PTS_WALL_B, PTI_WALL_B, PTSTEP, &
- PHC_WALL, PTC_WALL, PD_WALL, PDN_ROAD, PRHOA, PAC_WALL, &
- PAC_BLD, PTI_BLD, PLW_RAD, PPS, PEXNS, &
- PABS_SW_WALL, PT_CANYON, PTS_ROAD, PTSNOW_ROAD, &
- PTS_GARDEN, PTS_MASS, PTS_FLOOR, PEMIS_WALL, &
- PLW_WA_TO_WB, PLW_R_TO_W, PLW_G_TO_W, PLW_NR_TO_W, &
- PLW_WIN_TO_W, PLW_S_TO_W, &
- PT_WIN1, &
- PFLX_BLD_WALL, PDQS_WALL, PT_WIN2, PABS_LW_WALL, &
- PEMIT_LW_WALL, PH_WALL, PIMB_WALL, PF_WALL_MASS, &
- PF_WALL_FLOOR, PF_WALL_WIN, PRADHT_IN, PRAD_ROOF_WALL, &
- PRAD_WALL_WIN, PRAD_WALL_FLOOR, &
- PRAD_WALL_MASS, PCONV_WALL_BLD, PLOAD_IN_WALL )
+ SUBROUTINE WALL_LAYER_E_BUDGET(TOP, T, B, PT_WL, PTS_WL_B, PTI_WL_B, PTSTEP, PDN_RD, &
+ PRHOA, PAC_WL, PAC_BLD, PLW_RAD, PPS, PEXNS, PABS_SW_WL, &
+ PT_CANYON, PTS_RD, PTSNOW_RD, PTS_GD, PTS_FL, &
+ PLW_WA_TO_WB, PLW_R_TO_W, PLW_G_TO_W, PLW_NR_TO_W, &
+ PLW_WIN_TO_W, PLW_S_TO_W, PFLX_BLD_WL, PDQS_WL, &
+ PABS_LW_WL, PEMIT_LW_WL, PH_WL, PIMB_WL, PRADHT_IN, &
+ PRAD_RF_WL, PRAD_WL_WIN, PRAD_WL_FL, PRAD_WL_MA, &
+ PCONV_WL_BLD, PLOAD_IN_WL )
! ##########################################################################
!
!!**** *ROAD_WALL_LAYER_E_BUDGET*
@@ -102,6 +97,10 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
+USE MODD_TEB_n, ONLY : TEB_t
+USE MODD_BEM_n, ONLY : BEM_t
+!
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_CSTS,ONLY : XCPD, XSTEFAN
!
@@ -116,32 +115,29 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PT_WALL ! wall layers temperatures
-REAL, DIMENSION(:), INTENT(IN) :: PTS_WALL_B ! opposite wall surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTI_WALL_B ! opposite wall internal temperature
+TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+TYPE(TEB_t), INTENT(INOUT) :: T
+TYPE(BEM_t), INTENT(INOUT) :: B
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PT_WL ! wall layers temperatures
+REAL, DIMENSION(:), INTENT(IN) :: PTS_WL_B ! opposite wall surface temperature
+REAL, DIMENSION(:), INTENT(IN) :: PTI_WL_B ! opposite wall internal temperature
REAL, INTENT(IN) :: PTSTEP ! time step
- CHARACTER(LEN=3), INTENT(IN) :: HBEM ! Building Energy model 'DEF' or 'BEM'
-REAL, DIMENSION(:,:), INTENT(IN) :: PHC_WALL ! heat capacity for wall layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PTC_WALL ! thermal conductivity for wall layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PD_WALL ! depth of wall layers
-REAL, DIMENSION(:), INTENT(IN) :: PDN_ROAD ! snow-covered fraction on roads
+REAL, DIMENSION(:), INTENT(IN) :: PDN_RD ! snow-covered fraction on roads
REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! rho
-REAL, DIMENSION(:), INTENT(IN) :: PAC_WALL ! aerodynamical conductance [m/s]
+REAL, DIMENSION(:), INTENT(IN) :: PAC_WL ! aerodynamical conductance [m/s]
! ! between wall and canyon
REAL, DIMENSION(:), INTENT(IN) :: PAC_BLD ! aerodynamical conductance
! inside the building itself
-REAL, DIMENSION(:), INTENT(IN) :: PTI_BLD ! inside building temperature
REAL, DIMENSION(:), INTENT(IN) :: PLW_RAD ! atmospheric infrared radiation
REAL, DIMENSION(:), INTENT(IN) :: PPS ! pressure at the surface
REAL, DIMENSION(:), INTENT(IN) :: PEXNS ! surface Exner function
-REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_WALL ! absorbed solar radiation
+REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_WL ! absorbed solar radiation
REAL, DIMENSION(:), INTENT(IN) :: PT_CANYON ! air canyon temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS_ROAD ! road surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTSNOW_ROAD ! road snow temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS_GARDEN ! green area surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS_MASS ! surface mass temperature [K]
-REAL, DIMENSION(:), INTENT(IN) :: PTS_FLOOR ! floor layers temperatures [K]
-REAL, DIMENSION(:), INTENT(IN) :: PEMIS_WALL ! wall emissivity
+REAL, DIMENSION(:), INTENT(IN) :: PTS_RD ! road surface temperature
+REAL, DIMENSION(:), INTENT(IN) :: PTSNOW_RD ! road snow temperature
+REAL, DIMENSION(:), INTENT(IN) :: PTS_GD ! green area surface temperature
+REAL, DIMENSION(:), INTENT(IN) :: PTS_FL ! floor layers temperatures [K]
!
REAL, DIMENSION(:), INTENT(IN) :: PLW_WA_TO_WB ! LW interactions wall -> opposite wall
REAL, DIMENSION(:), INTENT(IN) :: PLW_R_TO_W ! LW interactions road -> wall ; DEF formulation
@@ -151,28 +147,23 @@ REAL, DIMENSION(:), INTENT(IN) :: PLW_NR_TO_W ! LW interactions road(snow) -
REAL, DIMENSION(:), INTENT(IN) :: PLW_WIN_TO_W ! Radiative heat trasfer coeff wall-window
! [W K-1 m-2]
!
-REAL, DIMENSION(:), INTENT(IN) :: PT_WIN1 ! outdoor window temperature [K]
-REAL, DIMENSION(:), INTENT(OUT) :: PFLX_BLD_WALL! flux from bld to wall
-REAL, DIMENSION(:), INTENT(INOUT) :: PDQS_WALL ! heat storage inside the wall
-REAL, DIMENSION(:), INTENT(IN) :: PT_WIN2 ! indoor window temperature [K]
-REAL, DIMENSION(:), INTENT(OUT) :: PABS_LW_WALL ! absorbed infrared rad. [W m-2(wall)]
-REAL, DIMENSION(:), INTENT(OUT) :: PEMIT_LW_WALL ! LW flux emitted by the wall [W m-2(wall)]
-REAL, DIMENSION(:), INTENT(OUT) :: PH_WALL ! Sensible heat flux from wall to air [W/m2(wall)]
+REAL, DIMENSION(:), INTENT(OUT) :: PFLX_BLD_WL! flux from bld to wall
+REAL, DIMENSION(:), INTENT(INOUT) :: PDQS_WL ! heat storage inside the wall
+REAL, DIMENSION(:), INTENT(OUT) :: PABS_LW_WL ! absorbed infrared rad. [W m-2(wall)]
+REAL, DIMENSION(:), INTENT(OUT) :: PEMIT_LW_WL ! LW flux emitted by the wall [W m-2(wall)]
+REAL, DIMENSION(:), INTENT(OUT) :: PH_WL ! Sensible heat flux from wall to air [W/m2(wall)]
! wall = facade - glazing
-REAL, DIMENSION(:), INTENT(OUT) :: PIMB_WALL ! wall residual energy imbalance
+REAL, DIMENSION(:), INTENT(OUT) :: PIMB_WL ! wall residual energy imbalance
! for verification [W m-2]
-REAL, DIMENSION(:), INTENT(IN) :: PF_WALL_FLOOR ! View factor wall-floor
-REAL, DIMENSION(:), INTENT(IN) :: PF_WALL_MASS ! View factor wall-mass
-REAL, DIMENSION(:), INTENT(IN) :: PF_WALL_WIN ! View factor wall-win
REAL, DIMENSION(:), INTENT(IN) :: PRADHT_IN ! Indoor radiant heat transfer coefficient
! [W K-1 m-2]
-REAL, DIMENSION(:), INTENT(IN) :: PRAD_ROOF_WALL ! rad. fluxes from roof to wall [W m-2(roof)]
-REAL, DIMENSION(:), INTENT(OUT) :: PRAD_WALL_WIN ! rad. fluxes from wall to win [W m-2(wall)]
-REAL, DIMENSION(:), INTENT(OUT) :: PRAD_WALL_FLOOR! rad. fluxes from wall to floor [W m-2(wall)]
-REAL, DIMENSION(:), INTENT(OUT) :: PRAD_WALL_MASS ! rad. fluxes from wall to mass [W m-2(wall)]
-REAL, DIMENSION(:), INTENT(OUT) :: PCONV_WALL_BLD ! conv. fluxes from wall to bld [W m-2(wall)]
+REAL, DIMENSION(:), INTENT(IN) :: PRAD_RF_WL ! rad. fluxes from roof to wall [W m-2(roof)]
+REAL, DIMENSION(:), INTENT(OUT) :: PRAD_WL_WIN ! rad. fluxes from wall to win [W m-2(wall)]
+REAL, DIMENSION(:), INTENT(OUT) :: PRAD_WL_FL! rad. fluxes from wall to floor [W m-2(wall)]
+REAL, DIMENSION(:), INTENT(OUT) :: PRAD_WL_MA ! rad. fluxes from wall to mass [W m-2(wall)]
+REAL, DIMENSION(:), INTENT(OUT) :: PCONV_WL_BLD ! conv. fluxes from wall to bld [W m-2(wall)]
-REAL, DIMENSION(:), INTENT(IN) :: PLOAD_IN_WALL ! LOAD from solar heat gain + rad int. gains W/m2 [Wall]
+REAL, DIMENSION(:), INTENT(IN) :: PLOAD_IN_WL ! LOAD from solar heat gain + rad int. gains W/m2 [Wall]
!
@@ -182,58 +173,58 @@ REAL, DIMENSION(:), INTENT(IN) :: PLOAD_IN_WALL ! LOAD from solar heat gain
REAL :: ZIMPL=1.0 ! implicit coefficient
REAL :: ZEXPL=0.0 ! explicit coefficient
!
-REAL, DIMENSION(SIZE(PPS),SIZE(PT_WALL,2)) :: ZA,& ! lower diag.
+REAL, DIMENSION(SIZE(PPS),SIZE(PT_WL,2)) :: ZA,& ! lower diag.
ZB,& ! main diag.
ZC,& ! upper diag.
ZY ! r.h.s.
!
-REAL, DIMENSION(SIZE(PPS)) :: ZMTC_O_D_WALL_IN
-REAL, DIMENSION(SIZE(PPS)) :: ZDF_ROAD ! Road snow free fraction
+REAL, DIMENSION(SIZE(PPS)) :: ZMTC_O_D_WL_IN
+REAL, DIMENSION(SIZE(PPS)) :: ZDF_RD ! Road snow free fraction
REAL, DIMENSION(SIZE(PPS)) :: ZRHO_ACF_W ! rho * conductance
! ! * snow-free f.
!
! thermal capacity times layer depth
-REAL, DIMENSION(SIZE(PPS)) :: ZTS_WALL ! wall surface temperature
-REAL, DIMENSION(SIZE(PPS)) :: ZTI_WALL ! wall indoor surface temperature
-REAL, DIMENSION(SIZE(PPS)) :: ZTI_WALL_CONV ! wall indoor surface temperature for conv. flux
+REAL, DIMENSION(SIZE(PPS)) :: ZTS_WL ! wall surface temperature
+REAL, DIMENSION(SIZE(PPS)) :: ZTI_WL ! wall indoor surface temperature
+REAL, DIMENSION(SIZE(PPS)) :: ZTI_WL_CONV ! wall indoor surface temperature for conv. flux
REAL, DIMENSION(SIZE(PPS)) :: ZT_SKY ! sky temperature [K]
!
-REAL, DIMENSION(SIZE(PPS)) :: ZTI_ROOF ! Indoor roof temperature [K]
-REAL, DIMENSION(SIZE(PPS)) :: ZDIF_RAD_WALL_ROOF !diff between the rad flux that should receive the wall from the roof
+REAL, DIMENSION(SIZE(PPS)) :: ZTI_RF ! Indoor roof temperature [K]
+REAL, DIMENSION(SIZE(PPS)) :: ZDIF_RAD_WL_RF !diff between the rad flux that should receive the wall from the roof
! and what it really receives [W m-2(bld)]
-REAL, DIMENSION(SIZE(PPS)) :: ZRAD_WALL_ROOF ! rad flux between the wall and the roof computed for the wall balance
-REAL, DIMENSION(SIZE(PPS)) :: ZF_WALL_WALL ! View factor wall-wall inside the building
-REAL, DIMENSION(SIZE(PPS)) :: ZCHTC_IN_WALL ! indoor convective heat transfer coeff wall [W m-2 K-1]
-INTEGER :: IWALL_LAYER ! number of wall layers
+REAL, DIMENSION(SIZE(PPS)) :: ZRAD_WL_RF ! rad flux between the wall and the roof computed for the wall balance
+REAL, DIMENSION(SIZE(PPS)) :: ZF_WL_WL ! View factor wall-wall inside the building
+REAL, DIMENSION(SIZE(PPS)) :: ZCHTC_IN_WL ! indoor convective heat transfer coeff wall [W m-2 K-1]
+INTEGER :: IWL_LAYER ! number of wall layers
INTEGER :: JJ ! loop counter
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('WALL_LAYER_E_BUDGET',0,ZHOOK_HANDLE)
!
-PFLX_BLD_WALL = XUNDEF
-PIMB_WALL = XUNDEF
-PRAD_WALL_WIN = XUNDEF
-PRAD_WALL_FLOOR= XUNDEF
-PRAD_WALL_MASS = XUNDEF
-PCONV_WALL_BLD = XUNDEF
+PFLX_BLD_WL = XUNDEF
+PIMB_WL = XUNDEF
+PRAD_WL_WIN = XUNDEF
+PRAD_WL_FL= XUNDEF
+PRAD_WL_MA = XUNDEF
+PCONV_WL_BLD = XUNDEF
!
- CALL LAYER_E_BUDGET_GET_COEF( PT_WALL, PTSTEP, ZIMPL, PHC_WALL, PTC_WALL, PD_WALL, &
+ CALL LAYER_E_BUDGET_GET_COEF( PT_WL, PTSTEP, ZIMPL, T%XHC_WALL, T%XTC_WALL, T%XD_WALL, &
ZA, ZB, ZC, ZY )
!
-IWALL_LAYER = SIZE(PT_WALL,2)
+IWL_LAYER = SIZE(PT_WL,2)
!
-DO JJ=1,SIZE(PDN_ROAD)
+DO JJ=1,SIZE(PDN_RD)
!
- ZDF_ROAD(JJ) = 1. - PDN_ROAD(JJ)
+ ZDF_RD(JJ) = 1. - PDN_RD(JJ)
!
- ZTS_WALL(JJ) = PT_WALL(JJ,1)
- ZTI_WALL(JJ) = PT_WALL(JJ, IWALL_LAYER)
+ ZTS_WL(JJ) = PT_WL(JJ,1)
+ ZTI_WL(JJ) = PT_WL(JJ, IWL_LAYER)
!
!* 2.1 outdoor convective flux properties
! ----------------------------------
!
- ZRHO_ACF_W (JJ) = PRHOA(JJ) * PAC_WALL(JJ)
+ ZRHO_ACF_W (JJ) = PRHOA(JJ) * PAC_WL(JJ)
!
!* 2.2 Sky temperature
! ---------------
@@ -243,18 +234,18 @@ DO JJ=1,SIZE(PDN_ROAD)
!* 2.3 indoor average thermal conductivity
! -----------------------------------
!
- IF (HBEM .EQ. "DEF") THEN
- ZMTC_O_D_WALL_IN(JJ) = 2. * PTC_WALL(JJ,IWALL_LAYER) / PD_WALL (JJ,IWALL_LAYER)
- ZMTC_O_D_WALL_IN(JJ) = 1./( 1./ZMTC_O_D_WALL_IN(JJ) + 1./(XCPD*PRHOA(JJ)*PAC_BLD(JJ)))
+ IF (TOP%CBEM .EQ. "DEF") THEN
+ ZMTC_O_D_WL_IN(JJ) = 2. * T%XTC_WALL(JJ,IWL_LAYER) / T%XD_WALL (JJ,IWL_LAYER)
+ ZMTC_O_D_WL_IN(JJ) = 1./( 1./ZMTC_O_D_WL_IN(JJ) + 1./(XCPD*PRHOA(JJ)*PAC_BLD(JJ)))
ENDIF
ENDDO
!
!* 2.4 indoor convective coefficient
! -----------------------------
!
- ZCHTC_IN_WALL(:) = CHTC_VERT_DOE(PT_WALL(:,IWALL_LAYER), PTI_BLD(:))
- DO JJ=1,SIZE(ZCHTC_IN_WALL)
- ZCHTC_IN_WALL(JJ) = MAX(1., ZCHTC_IN_WALL(JJ))
+ ZCHTC_IN_WL(:) = CHTC_VERT_DOE(PT_WL(:,IWL_LAYER), B%XTI_BLD(:))
+ DO JJ=1,SIZE(ZCHTC_IN_WL)
+ ZCHTC_IN_WL(JJ) = MAX(1., ZCHTC_IN_WL(JJ))
ENDDO
!
@@ -263,28 +254,30 @@ ENDDO
!* 3. Outer wall layer coefficients
! ------------------------------
!
-DO JJ=1,SIZE(PT_WALL,1)
+DO JJ=1,SIZE(PT_WL,1)
!
ZB(JJ,1) = ZB(JJ,1) + ZIMPL * XCPD/PEXNS(JJ) * ZRHO_ACF_W(JJ)
!
- ZY(JJ,1) = ZY(JJ,1) + PABS_SW_WALL(JJ) &
- + XCPD/PEXNS(JJ) * ZRHO_ACF_W(JJ) * ( PT_CANYON(JJ) - ZEXPL * ZTS_WALL(JJ) )
+ ZY(JJ,1) = ZY(JJ,1) + PABS_SW_WL(JJ) &
+ + XCPD/PEXNS(JJ) * ZRHO_ACF_W(JJ) * ( PT_CANYON(JJ) - ZEXPL * ZTS_WL(JJ) )
!
!
ZB(JJ,1) = ZB(JJ,1) &
+ ZIMPL * ( PLW_S_TO_W(JJ) + PLW_WA_TO_WB(JJ) &
- + ZDF_ROAD(JJ)*PLW_R_TO_W(JJ) + PLW_G_TO_W(JJ) &
- + PDN_ROAD(JJ) * PLW_NR_TO_W(JJ) &
+ + ZDF_RD(JJ)*PLW_R_TO_W(JJ) + PLW_G_TO_W(JJ) &
+ + PDN_RD(JJ) * PLW_NR_TO_W(JJ) &
+ PLW_WIN_TO_W(JJ) )
!
ZY(JJ,1) = ZY(JJ,1) + &
- PLW_S_TO_W(JJ) * (ZT_SKY(JJ) - ZEXPL * ZTS_WALL(JJ)) &
- + PLW_WA_TO_WB(JJ) * (PTS_WALL_B(JJ) - ZEXPL * ZTS_WALL(JJ)) &
- + ZDF_ROAD(JJ) * PLW_R_TO_W(JJ) * (PTS_ROAD(JJ) - ZEXPL * ZTS_WALL(JJ)) &
- + PLW_G_TO_W(JJ) * (PTS_GARDEN(JJ) - ZEXPL * ZTS_WALL(JJ)) &
- + PDN_ROAD(JJ) * PLW_NR_TO_W(JJ) * (PTSNOW_ROAD(JJ)- ZEXPL * ZTS_WALL(JJ)) &
- + PLW_WIN_TO_W(JJ) * (PT_WIN1(JJ) - ZEXPL * ZTS_WALL(JJ))
-
+ PLW_S_TO_W(JJ) * (ZT_SKY(JJ) - ZEXPL * ZTS_WL(JJ)) &
+ + PLW_WA_TO_WB(JJ) * (PTS_WL_B(JJ) - ZEXPL * ZTS_WL(JJ)) &
+ + ZDF_RD(JJ) * PLW_R_TO_W(JJ) * (PTS_RD(JJ) - ZEXPL * ZTS_WL(JJ)) &
+ + PDN_RD(JJ) * PLW_NR_TO_W(JJ) * (PTSNOW_RD(JJ)- ZEXPL * ZTS_WL(JJ)) &
+ + PLW_WIN_TO_W(JJ) * (B%XT_WIN1(JJ) - ZEXPL * ZTS_WL(JJ))
+ !
+ IF (SIZE(PTS_GD)>0) THEN
+ ZY(JJ,1) = ZY(JJ,1) + PLW_G_TO_W(JJ) * (PTS_GD(JJ) - ZEXPL * ZTS_WL(JJ))
+ ENDIF
!
ENDDO
!
@@ -293,35 +286,36 @@ ENDDO
!* 4. Inside wall layer coefficients
! -----------------------------
!
-DO JJ=1,SIZE(PT_WALL,1)
+DO JJ=1,SIZE(PT_WL,1)
!
- IF (HBEM=="DEF") THEN
+ IF (TOP%CBEM=="DEF") THEN
+ !
+ ZB(JJ,IWL_LAYER) = ZB(JJ,IWL_LAYER) + ZIMPL * ZMTC_O_D_WL_IN(JJ)
!
- ZB(JJ,IWALL_LAYER) = ZB(JJ,IWALL_LAYER) + ZIMPL * ZMTC_O_D_WALL_IN(JJ)
+ ZY(JJ,IWL_LAYER) = ZY(JJ,IWL_LAYER) &
+ + ZMTC_O_D_WL_IN(JJ) * B%XTI_BLD(JJ) &
+ - ZEXPL * ZMTC_O_D_WL_IN(JJ) * PT_WL(JJ,IWL_LAYER)
!
- ZY(JJ,IWALL_LAYER) = ZY(JJ,IWALL_LAYER) &
- + ZMTC_O_D_WALL_IN(JJ) * PTI_BLD(JJ) &
- - ZEXPL * ZMTC_O_D_WALL_IN(JJ) * PT_WALL(JJ,IWALL_LAYER)
+ ELSEIF (TOP%CBEM=="BEM") THEN
!
- ELSEIF (HBEM=="BEM") THEN
+ ZF_WL_WL (JJ) = 1. - B%XF_WALL_MASS(JJ) - B%XF_WALL_WIN(JJ) - 2.*B%XF_WALL_FLOOR(JJ)
!
- ZF_WALL_WALL (JJ) = 1. - PF_WALL_MASS(JJ) - PF_WALL_WIN(JJ) - 2.*PF_WALL_FLOOR(JJ)
+ ZB(JJ,IWL_LAYER) = ZB(JJ,IWL_LAYER) + ZIMPL * &
+ (ZCHTC_IN_WL(JJ) * 4./3. + PRADHT_IN(JJ) * &
+ ( B%XF_WALL_MASS(JJ) + B%XF_WALL_WIN (JJ) &
+ + ZF_WL_WL(JJ) + 2 * B%XF_WALL_FLOOR(JJ)))
!
- ZB(JJ,IWALL_LAYER) = ZB(JJ,IWALL_LAYER) + ZIMPL * &
- (ZCHTC_IN_WALL(JJ) * 4./3. + PRADHT_IN(JJ) * &
- ( PF_WALL_MASS(JJ) + PF_WALL_WIN (JJ) &
- + ZF_WALL_WALL(JJ) + 2 * PF_WALL_FLOOR(JJ)))
+ ZTI_RF(JJ) = PRAD_RF_WL(JJ) / PRADHT_IN(JJ) + PT_WL(JJ,IWL_LAYER)
!
- ZTI_ROOF(JJ) = PRAD_ROOF_WALL(JJ) / PRADHT_IN(JJ) + PT_WALL(JJ,IWALL_LAYER)
- ZY(JJ,IWALL_LAYER) = ZY(JJ,IWALL_LAYER) + &
- ZCHTC_IN_WALL(JJ) * (PTI_BLD(JJ) - 1./3. * PT_WALL(JJ, IWALL_LAYER) * (4 * ZEXPL -1)) + &
+ ZY(JJ,IWL_LAYER) = ZY(JJ,IWL_LAYER) + &
+ ZCHTC_IN_WL(JJ) * (B%XTI_BLD(JJ) - 1./3. * PT_WL(JJ, IWL_LAYER) * (4 * ZEXPL -1)) + &
PRADHT_IN(JJ) * ( &
- PF_WALL_MASS (JJ) * (PTS_MASS(JJ) - ZEXPL * PT_WALL(JJ,IWALL_LAYER)) + &
- PF_WALL_WIN (JJ) * (PT_WIN2 (JJ) - ZEXPL * PT_WALL(JJ,IWALL_LAYER)) + &
- PF_WALL_FLOOR(JJ) * (PTS_FLOOR(JJ) - ZEXPL * PT_WALL(JJ,IWALL_LAYER)) + &
- ZF_WALL_WALL (JJ) * (PTI_WALL_B(JJ)- ZEXPL * PT_WALL(JJ,IWALL_LAYER)) + &
- PF_WALL_FLOOR(JJ) * (ZTI_ROOF(JJ) - ZEXPL * PT_WALL(JJ,IWALL_LAYER)) )+ &
- PLOAD_IN_WALL(JJ)
+ B%XF_WALL_MASS (JJ) * (B%XT_MASS(JJ,1) - ZEXPL * PT_WL(JJ,IWL_LAYER)) + &
+ B%XF_WALL_WIN (JJ) * (B%XT_WIN2 (JJ) - ZEXPL * PT_WL(JJ,IWL_LAYER)) + &
+ B%XF_WALL_FLOOR(JJ) * (PTS_FL(JJ) - ZEXPL * PT_WL(JJ,IWL_LAYER)) + &
+ ZF_WL_WL (JJ) * (PTI_WL_B(JJ) - ZEXPL * PT_WL(JJ,IWL_LAYER)) + &
+ B%XF_WALL_FLOOR(JJ) * (ZTI_RF(JJ) - ZEXPL * PT_WL(JJ,IWL_LAYER)) )+ &
+ PLOAD_IN_WL(JJ)
!
ENDIF
!
@@ -332,8 +326,8 @@ END DO
!* 5. heat conduction calculation
! ---------------------------
!
- CALL LAYER_E_BUDGET( PT_WALL, PTSTEP, ZIMPL, PHC_WALL, PTC_WALL, PD_WALL, &
- ZA, ZB, ZC, ZY, PDQS_WALL )
+ CALL LAYER_E_BUDGET( PT_WL, PTSTEP, ZIMPL, T%XHC_WALL, T%XTC_WALL, T%XD_WALL, &
+ ZA, ZB, ZC, ZY, PDQS_WL )
!
!-------------------------------------------------------------------------------
!
@@ -342,56 +336,59 @@ END DO
!
!
!* radiative surface temperature used during the energy balance
-ZTS_WALL(:) = ZIMPL * PT_WALL(:,1) + ZEXPL * ZTS_WALL(:)
+ZTS_WL(:) = ZIMPL * PT_WL(:,1) + ZEXPL * ZTS_WL(:)
+!
+PABS_LW_WL(:) = PLW_S_TO_W (:) * (ZT_SKY (:) - ZTS_WL(:)) + &
+ ZDF_RD(:) *PLW_R_TO_W (:) * (PTS_RD (:) - ZTS_WL(:)) + &
+ PLW_WA_TO_WB(:) * (PTS_WL_B (:) - ZTS_WL(:)) + &
+ PLW_WIN_TO_W(:) * (B%XT_WIN1(:) - ZTS_WL(:)) + &
+ PDN_RD(:) *PLW_NR_TO_W (:) * (PTSNOW_RD(:) - ZTS_WL(:))
!
-PABS_LW_WALL(:) = PLW_S_TO_W (:) * (ZT_SKY (:) - ZTS_WALL(:)) + &
- ZDF_ROAD(:) *PLW_R_TO_W (:) * (PTS_ROAD (:) - ZTS_WALL(:)) + &
- PLW_G_TO_W (:) * (PTS_GARDEN (:) - ZTS_WALL(:)) + &
- PLW_WA_TO_WB(:) * (PTS_WALL_B (:) - ZTS_WALL(:)) + &
- PLW_WIN_TO_W(:) * (PT_WIN1 (:) - ZTS_WALL(:)) + &
- PDN_ROAD(:) *PLW_NR_TO_W (:) * (PTSNOW_ROAD(:) - ZTS_WALL(:))
+IF (SIZE(PTS_GD)>0) THEN
+ PABS_LW_WL(:) = PABS_LW_WL(:) + PLW_G_TO_W (:) * (PTS_GD (:) - ZTS_WL(:))
+ENDIF
!
!* emitted lw flux
-PEMIT_LW_WALL(:) = XSTEFAN * PT_WALL(:,1)**4 + &
- (1 - PEMIS_WALL(:))/PEMIS_WALL(:) * PABS_LW_WALL(:)
+PEMIT_LW_WL(:) = XSTEFAN * PT_WL(:,1)**4 + &
+ (1 - T%XEMIS_WALL(:))/T%XEMIS_WALL(:) * PABS_LW_WL(:)
!
!* sensible heat flux to outdoor
-PH_WALL(:) = ZRHO_ACF_W(:) * XCPD/PEXNS(:) * &
- ( ZIMPL*PT_WALL(:,1) + ZEXPL*ZTS_WALL(:) - PT_CANYON(:) )
+PH_WL(:) = ZRHO_ACF_W(:) * XCPD/PEXNS(:) * &
+ ( ZIMPL*PT_WL(:,1) + ZEXPL*ZTS_WL(:) - PT_CANYON(:) )
!
-IF (HBEM=='BEM') THEN
+IF (TOP%CBEM=='BEM') THEN
!
!compute ZTI_WALL used in flux calculation
- ZTI_WALL_CONV(:) = 4./3. * ZIMPL * PT_WALL(:,IWALL_LAYER) + 1./3. * ZTI_WALL(:) * (4 * ZEXPL -1.)
- ZTI_WALL(:) = ZEXPL * ZTI_WALL(:) + ZIMPL * PT_WALL(:,IWALL_LAYER)
+ ZTI_WL_CONV(:) = 4./3. * ZIMPL * PT_WL(:,IWL_LAYER) + 1./3. * ZTI_WL(:) * (4 * ZEXPL -1.)
+ ZTI_WL(:) = ZEXPL * ZTI_WL(:) + ZIMPL * PT_WL(:,IWL_LAYER)
!
!compute IR exchanged fluxes with the roof in the wall balance
- ZRAD_WALL_ROOF(:) = PRADHT_IN(:) * (ZTI_WALL(:) - ZTI_ROOF(:))
+ ZRAD_WL_RF(:) = PRADHT_IN(:) * (ZTI_WL(:) - ZTI_RF(:))
!compute the difference with the IR flux echanged between roof and wall for
!the roof balance, this difference will be added to the floor
- ZDIF_RAD_WALL_ROOF(:) = ZRAD_WALL_ROOF(:) + PRAD_ROOF_WALL(:)
+ ZDIF_RAD_WL_RF(:) = ZRAD_WL_RF(:) + PRAD_RF_WL(:)
!compute exchanged fluxes with other surfaces for which the balance is done after
- PRAD_WALL_FLOOR(:) = PRADHT_IN(:) * (ZTI_WALL(:) - PTS_FLOOR(:))
+ PRAD_WL_FL(:) = PRADHT_IN(:) * (ZTI_WL(:) - PTS_FL(:))
! contribution of the difference between the flux from the wall/flux from
! the roof
- PRAD_WALL_FLOOR(:) = PRAD_WALL_FLOOR(:) + ZDIF_RAD_WALL_ROOF(:)
- PRAD_WALL_MASS(:) = PRADHT_IN(:) * (ZTI_WALL(:) - PTS_MASS(:))
- PRAD_WALL_WIN(:) = PRADHT_IN(:) * (ZTI_WALL(:) - PT_WIN2(:))
- PCONV_WALL_BLD(:) = ZCHTC_IN_WALL (:) * (ZTI_WALL_CONV(:) - PTI_BLD (:))
+ PRAD_WL_FL(:) = PRAD_WL_FL(:) + ZDIF_RAD_WL_RF(:)
+ PRAD_WL_MA(:) = PRADHT_IN(:) * (ZTI_WL(:) - B%XT_MASS(:,1))
+ PRAD_WL_WIN(:) = PRADHT_IN(:) * (ZTI_WL(:) - B%XT_WIN2(:))
+ PCONV_WL_BLD(:) = ZCHTC_IN_WL (:) * (ZTI_WL_CONV(:) - B%XTI_BLD (:))
!
!
- PFLX_BLD_WALL (:) = -PCONV_WALL_BLD(:) &
- + PF_WALL_FLOOR(:) * PRAD_ROOF_WALL(:) &
- + PRADHT_IN(:) *(PF_WALL_MASS (:) * (PTS_MASS (:) - ZTI_WALL(:)) &
- + PF_WALL_WIN (:) * (PT_WIN2 (:) - ZTI_WALL(:)) &
- + PF_WALL_FLOOR(:) * (PTS_FLOOR(:) - ZTI_WALL(:)) )
+ PFLX_BLD_WL (:) = -PCONV_WL_BLD(:) &
+ + B%XF_WALL_FLOOR(:) * PRAD_RF_WL(:) &
+ + PRADHT_IN(:) *(B%XF_WALL_MASS (:) * (B%XT_MASS(:,1) - ZTI_WL(:)) &
+ + B%XF_WALL_WIN (:) * (B%XT_WIN2 (:) - ZTI_WL(:)) &
+ + B%XF_WALL_FLOOR(:) * (PTS_FL(:) - ZTI_WL(:)) )
!
!* wall energy residual imbalance for verification
! -----------------------------------------------
- PIMB_WALL(:) = PABS_SW_WALL(:) + PABS_LW_WALL(:) &
- - PDQS_WALL(:) - PH_WALL(:) &
- + PFLX_BLD_WALL(:)
+ PIMB_WL(:) = PABS_SW_WL(:) + PABS_LW_WL(:) &
+ - PDQS_WL(:) - PH_WL(:) &
+ + PFLX_BLD_WL(:)
!
!
END IF
diff --git a/src/SURFEX/water_flux.F90 b/src/SURFEX/water_flux.F90
index 8b97223e5065629cee9d6ae1715bfc3b09690585..4cf0d5fec71da144b5227888b60340267b176583 100644
--- a/src/SURFEX/water_flux.F90
+++ b/src/SURFEX/water_flux.F90
@@ -177,7 +177,7 @@ ENDIF
! 2.1 Richardson number
! -----------------
!
- CALL SURFACE_RI(PSST,PQSAT,PEXNS,PEXNA,PTA,PQA, &
+CALL SURFACE_RI(PSST,PQSAT,PEXNS,PEXNA,PTA,PQA, &
PZREF, PUREF, ZDIRCOSZW,PVMOD,PRI)
!
! 2.2 Detection of sea ice
diff --git a/src/SURFEX/window_data.F90 b/src/SURFEX/window_data.F90
index ba996cd13662253bd3579adb960eb713719aca6d..519338f2bc847586312f96177888784ffeaceae4 100644
--- a/src/SURFEX/window_data.F90
+++ b/src/SURFEX/window_data.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #############################################################
-SUBROUTINE WINDOW_DATA(KI,PSHGC, PU_WIN, PALB_WIN, PABS_WIN, PUGG_WIN, PTRAN_WIN)
+SUBROUTINE WINDOW_DATA(KI, B)
! #############################################################
!
!
@@ -52,7 +52,7 @@ SUBROUTINE WINDOW_DATA(KI,PSHGC, PU_WIN, PALB_WIN, PABS_WIN, PUGG_WIN, PTRAN_WIN
!* 0. DECLARATIONS
! ------------
!
-
+USE MODD_BEM_n, ONLY : BEM_t
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -61,12 +61,7 @@ USE PARKIND1 ,ONLY : JPRB
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KI ! number of points
-REAL, DIMENSION(KI), INTENT(IN) :: PSHGC ! solar heat gain coef. of windows
-REAL, DIMENSION(KI), INTENT(IN) :: PU_WIN ! window U-factor [K m W-2]
-REAL, DIMENSION(KI), INTENT(OUT) :: PALB_WIN ! window albedo
-REAL, DIMENSION(KI), INTENT(OUT) :: PABS_WIN ! window absortance
-REAL, DIMENSION(KI), INTENT(OUT) :: PUGG_WIN ! window glass-to-glass U-factor [W m-2 K-1]
-REAL, DIMENSION(KI), INTENT(OUT) :: PTRAN_WIN! window transmittance (-)
+TYPE(BEM_t), INTENT(INOUT) :: B
!
REAL, DIMENSION(KI) :: ZR_IW ! interior film resistance under winter conditions
REAL, DIMENSION(KI) :: ZR_OW ! exterior fild resistance uder winter conditions
@@ -93,170 +88,172 @@ TFH = 0.8424427652 ; RFH = 1.0983010317
TFGHI = 0.8327695761 ; RFGHI = 1.3316554732
TJ = 0.7889001341 ; RJ = 1.0837577691
-WHERE (PU_WIN <= 1.42) !from 3 building BLD, TOUR and MI-2005
+WHERE (B%XU_WIN <= 1.42) !from 3 building BLD, TOUR and MI-2005
!ZONE 1
- WHERE (PSHGC>=0.45)
+ WHERE (B%XSHGC>=0.45)
ZFAC_TRAN = TE
ZFAC_ALB = RE
END WHERE
!ZONE 2
- WHERE (PSHGC<0.45 .AND. PSHGC>0.35)
- ZFAC_TRAN = TJ+(PSHGC-0.35)*(TE-TJ)/(0.45-0.35)
- ZFAC_ALB = RJ+(PSHGC-0.35)*(RE-RJ)/(0.45-0.35)
+ WHERE (B%XSHGC<0.45 .AND. B%XSHGC>0.35)
+ ZFAC_TRAN = TJ+(B%XSHGC-0.35)*(TE-TJ)/(0.45-0.35)
+ ZFAC_ALB = RJ+(B%XSHGC-0.35)*(RE-RJ)/(0.45-0.35)
END WHERE
!ZONE 3
- WHERE(PSHGC<=0.35)
+ WHERE(B%XSHGC<=0.35)
ZFAC_TRAN = TJ
ZFAC_ALB = RJ
END WHERE
END WHERE
-WHERE (PU_WIN>1.42 .AND. PU_WIN<1.70)
+WHERE (B%XU_WIN>1.42 .AND. B%XU_WIN<1.70)
!ZONE 4
- WHERE (PSHGC>=0.55)
+ WHERE (B%XSHGC>=0.55)
ZFAC_TRAN = TE
ZFAC_ALB = RE
END WHERE
!ZONE 5
- WHERE (PSHGC>0.5 .AND. PSHGC<0.55)
- ZFAC_TRAN = TE+(PU_WIN-1.42)*((TFGHI+(PSHGC-0.5)*(TE-TFGHI)/(0.55-0.50))-TE)/(1.70-1.42)
- ZFAC_ALB = RE+(PU_WIN-1.42)*((RFGHI+(PSHGC-0.5)*(RE-RFGHI)/(0.55-0.50))-RE)/(1.70-1.42)
+ WHERE (B%XSHGC>0.5 .AND. B%XSHGC<0.55)
+ ZFAC_TRAN = TE+(B%XU_WIN-1.42)*((TFGHI+(B%XSHGC-0.5)*(TE-TFGHI)/(0.55-0.50))-TE)/(1.70-1.42)
+ ZFAC_ALB = RE+(B%XU_WIN-1.42)*((RFGHI+(B%XSHGC-0.5)*(RE-RFGHI)/(0.55-0.50))-RE)/(1.70-1.42)
END WHERE
!ZONE 6
- WHERE (PSHGC>=0.45 .AND. PSHGC<=0.5)
- ZFAC_TRAN = TE+(PU_WIN-1.42)*(TFGHI-TE)/(1.70-1.42)
- ZFAC_ALB = RE+(PU_WIN-1.42)*(RFGHI-RE)/(1.70-1.42)
+ WHERE (B%XSHGC>=0.45 .AND. B%XSHGC<=0.5)
+ ZFAC_TRAN = TE+(B%XU_WIN-1.42)*(TFGHI-TE)/(1.70-1.42)
+ ZFAC_ALB = RE+(B%XU_WIN-1.42)*(RFGHI-RE)/(1.70-1.42)
END WHERE
!ZONE 7
- WHERE (PSHGC>0.35 .AND. PSHGC<0.45)
- ZFAC_TRAN = (TJ+(PSHGC-0.35)*(TE-TJ)/(0.45-0.35))+(PU_WIN-1.42)*(TFGHI-(TJ+(PSHGC-0.35)*(TE-TJ)/(0.45-0.35)))/(1.70-1.42)
+ WHERE (B%XSHGC>0.35 .AND. B%XSHGC<0.45)
+ ZFAC_TRAN = (TJ+(B%XSHGC-0.35)*(TE-TJ)/(0.45-0.35))+ &
+ (B%XU_WIN-1.42)*(TFGHI-(TJ+(B%XSHGC-0.35)*(TE-TJ)/(0.45-0.35)))/(1.70-1.42)
- ZFAC_ALB = (RJ+(PSHGC-0.35)*(RE-RJ)/(0.45-0.35))+(PU_WIN-1.42)*(RFGHI-(RJ+(PSHGC-0.35)*(RE-RJ)/(0.45-0.35)))/(1.70-1.42)
+ ZFAC_ALB = (RJ+(B%XSHGC-0.35)*(RE-RJ)/(0.45-0.35))+&
+ (B%XU_WIN-1.42)*(RFGHI-(RJ+(B%XSHGC-0.35)*(RE-RJ)/(0.45-0.35)))/(1.70-1.42)
END WHERE
!ZONE 8
- WHERE (PSHGC>=0.30 .AND. PSHGC<=0.35)
- ZFAC_TRAN = TJ+(PU_WIN-1.42)*(TFGHI-TJ)/(1.70-1.42)
- ZFAC_ALB = RJ+(PU_WIN-1.42)*(RFGHI-RJ)/(1.70-1.42)
+ WHERE (B%XSHGC>=0.30 .AND. B%XSHGC<=0.35)
+ ZFAC_TRAN = TJ+(B%XU_WIN-1.42)*(TFGHI-TJ)/(1.70-1.42)
+ ZFAC_ALB = RJ+(B%XU_WIN-1.42)*(RFGHI-RJ)/(1.70-1.42)
END WHERE
!ZONE 9
- WHERE (PSHGC>0.25 .AND. PSHGC<0.35)
- ZFAC_TRAN = TJ+(PU_WIN-1.42)*((TFH+(PSHGC-0.25)*(TJ-TFH)/(0.30-0.25))-TJ)/(1.70-1.42)
- ZFAC_ALB = RJ+(PU_WIN-1.42)*((RFH+(PSHGC-0.25)*(RJ-RFH)/(0.30-0.25))-RJ)/(1.70-1.42)
+ WHERE (B%XSHGC>0.25 .AND. B%XSHGC<0.35)
+ ZFAC_TRAN = TJ+(B%XU_WIN-1.42)*((TFH+(B%XSHGC-0.25)*(TJ-TFH)/(0.30-0.25))-TJ)/(1.70-1.42)
+ ZFAC_ALB = RJ+(B%XU_WIN-1.42)*((RFH+(B%XSHGC-0.25)*(RJ-RFH)/(0.30-0.25))-RJ)/(1.70-1.42)
END WHERE
!ZONE 10
- WHERE (PSHGC<=0.25)
- ZFAC_TRAN = TJ+(PU_WIN-1.42)*(TFH-TJ)/(1.70-1.42)
- ZFAC_ALB = RJ+(PU_WIN-1.42)*(RFH-RJ)/(1.70-1.42)
+ WHERE (B%XSHGC<=0.25)
+ ZFAC_TRAN = TJ+(B%XU_WIN-1.42)*(TFH-TJ)/(1.70-1.42)
+ ZFAC_ALB = RJ+(B%XU_WIN-1.42)*(RFH-RJ)/(1.70-1.42)
END WHERE
END WHERE
-WHERE (PU_WIN>=1.70 .AND. PU_WIN<=3.41)
+WHERE (B%XU_WIN>=1.70 .AND. B%XU_WIN<=3.41)
!ZONE 11
- WHERE (PSHGC>=0.55)
+ WHERE (B%XSHGC>=0.55)
ZFAC_TRAN = TE
ZFAC_ALB = RE
END WHERE
!ZONE 12
- WHERE (PSHGC > 0.5 .AND. PSHGC<0.55)
- ZFAC_TRAN = TFGHI+(PSHGC-0.50)*(TE-TFGHI)/(0.55-0.50)
- ZFAC_ALB = RFGHI+(PSHGC-0.50)*(RE-RFGHI)/(0.55-0.50)
+ WHERE (B%XSHGC > 0.5 .AND. B%XSHGC<0.55)
+ ZFAC_TRAN = TFGHI+(B%XSHGC-0.50)*(TE-TFGHI)/(0.55-0.50)
+ ZFAC_ALB = RFGHI+(B%XSHGC-0.50)*(RE-RFGHI)/(0.55-0.50)
END WHERE
!ZONE 13
- WHERE (PSHGC>=0.30 .AND. PSHGC<=0.50)
+ WHERE (B%XSHGC>=0.30 .AND. B%XSHGC<=0.50)
ZFAC_TRAN = TFGHI
ZFAC_ALB = RFGHI
END WHERE
!ZONE 14
- WHERE (PSHGC > 0.25 .AND. PSHGC<0.30)
- ZFAC_TRAN = TFH+(PSHGC-0.25)*(TFGHI-TFH)/(0.30-0.25)
- ZFAC_ALB = RFGHI+(PSHGC-0.25)*(RFGHI-RFH)/(0.30-0.25)
+ WHERE (B%XSHGC > 0.25 .AND. B%XSHGC<0.30)
+ ZFAC_TRAN = TFH+(B%XSHGC-0.25)*(TFGHI-TFH)/(0.30-0.25)
+ ZFAC_ALB = RFGHI+(B%XSHGC-0.25)*(RFGHI-RFH)/(0.30-0.25)
END WHERE
!ZONE 15
- WHERE (PSHGC<=0.25)
+ WHERE (B%XSHGC<=0.25)
ZFAC_TRAN = TFH
ZFAC_ALB = RFH
END WHERE
END WHERE
-WHERE (PU_WIN>3.41 .AND. PU_WIN<4.54)
+WHERE (B%XU_WIN>3.41 .AND. B%XU_WIN<4.54)
!ZONE 16
- WHERE (PSHGC>=0.65)
- ZFAC_TRAN = TE+(PU_WIN-3.41)*(TA-TE)/(4.54-3.41)
- ZFAC_ALB = RE+(PU_WIN-3.41)*(RA-RE)/(4.54-3.41)
+ WHERE (B%XSHGC>=0.65)
+ ZFAC_TRAN = TE+(B%XU_WIN-3.41)*(TA-TE)/(4.54-3.41)
+ ZFAC_ALB = RE+(B%XU_WIN-3.41)*(RA-RE)/(4.54-3.41)
END WHERE
!ZONE 17
- WHERE (PSHGC>0.60 .AND. PSHGC<0.65)
- ZFAC_TRAN = TE+(PU_WIN-3.41)*((TBCD+(PSHGC-0.60)*(TA-TBCD)/(0.65-0.60))-TE)/(4.54-3.41)
- ZFAC_ALB = RE+(PU_WIN-3.41)*((RBCD+(PSHGC-0.60)*(RA-RBCD)/(0.65-0.60))-RE)/(4.54-3.41)
+ WHERE (B%XSHGC>0.60 .AND. B%XSHGC<0.65)
+ ZFAC_TRAN = TE+(B%XU_WIN-3.41)*((TBCD+(B%XSHGC-0.60)*(TA-TBCD)/(0.65-0.60))-TE)/(4.54-3.41)
+ ZFAC_ALB = RE+(B%XU_WIN-3.41)*((RBCD+(B%XSHGC-0.60)*(RA-RBCD)/(0.65-0.60))-RE)/(4.54-3.41)
END WHERE
!ZONE 18
- WHERE (PSHGC>=0.55 .AND. PSHGC<=0.60)
- ZFAC_TRAN = TE+(PU_WIN-3.41)*(TBCD-TE)/(4.54-3.41)
- ZFAC_ALB = RE+(PU_WIN-3.41)*(RBCD-RE)/(4.54-3.41)
+ WHERE (B%XSHGC>=0.55 .AND. B%XSHGC<=0.60)
+ ZFAC_TRAN = TE+(B%XU_WIN-3.41)*(TBCD-TE)/(4.54-3.41)
+ ZFAC_ALB = RE+(B%XU_WIN-3.41)*(RBCD-RE)/(4.54-3.41)
END WHERE
!ZONE 19
- WHERE (PSHGC>0.50 .AND. PSHGC<0.55)
- ZFAC_TRAN = (TFGHI+(PSHGC-0.50)*(TE-TFGHI)/(0.55-0.50)) + &
- (PU_WIN-3.41)*(TBCD-(TFGHI+(PSHGC-0.50)*(TE-TFGHI)/(0.55-0.50)))/(4.54-3.41)
+ WHERE (B%XSHGC>0.50 .AND. B%XSHGC<0.55)
+ ZFAC_TRAN = (TFGHI+(B%XSHGC-0.50)*(TE-TFGHI)/(0.55-0.50)) + &
+ (B%XU_WIN-3.41)*(TBCD-(TFGHI+(B%XSHGC-0.50)*(TE-TFGHI)/(0.55-0.50)))/(4.54-3.41)
- ZFAC_ALB = (RFGHI+(PSHGC-0.50)*(RE-RFGHI)/(0.55-0.50)) + &
- (PU_WIN-3.41)*(RBCD-(RFGHI+(PSHGC-0.50)*(RE-RFGHI)/(0.55-0.50)))/(4.54-3.41)
+ ZFAC_ALB = (RFGHI+(B%XSHGC-0.50)*(RE-RFGHI)/(0.55-0.50)) + &
+ (B%XU_WIN-3.41)*(RBCD-(RFGHI+(B%XSHGC-0.50)*(RE-RFGHI)/(0.55-0.50)))/(4.54-3.41)
END WHERE
!ZONE 20
- WHERE (PSHGC>=0.45 .AND. PSHGC<=0.50)
- ZFAC_TRAN = TFGHI+(PU_WIN-3.41)*(TBCD-TFGHI)/(4.54-3.41)
- ZFAC_ALB = RFGHI+(PU_WIN-3.41)*(RBCD-RFGHI)/(4.54-3.41)
+ WHERE (B%XSHGC>=0.45 .AND. B%XSHGC<=0.50)
+ ZFAC_TRAN = TFGHI+(B%XU_WIN-3.41)*(TBCD-TFGHI)/(4.54-3.41)
+ ZFAC_ALB = RFGHI+(B%XU_WIN-3.41)*(RBCD-RFGHI)/(4.54-3.41)
END WHERE
!ZONE 21
- WHERE (PSHGC>0.30 .AND. PSHGC<0.45)
- ZFAC_TRAN = TFGHI+(PU_WIN-3.41)*((TA+(PSHGC-0.30)*(TBCD-TA)/(0.45-0.30))-TFGHI)/(4.54-3.41)
- ZFAC_ALB = RFGHI+(PU_WIN-3.41)*((RA+(PSHGC-0.30)*(RBCD-RA)/(0.45-0.30))-RFGHI)/(4.54-3.41)
+ WHERE (B%XSHGC>0.30 .AND. B%XSHGC<0.45)
+ ZFAC_TRAN = TFGHI+(B%XU_WIN-3.41)*((TA+(B%XSHGC-0.30)*(TBCD-TA)/(0.45-0.30))-TFGHI)/(4.54-3.41)
+ ZFAC_ALB = RFGHI+(B%XU_WIN-3.41)*((RA+(B%XSHGC-0.30)*(RBCD-RA)/(0.45-0.30))-RFGHI)/(4.54-3.41)
END WHERE
!ZONE 22
- WHERE (PSHGC>0.25 .AND. PSHGC<0.30)
- ZFAC_TRAN = (TFH+(PSHGC-0.25)*(TFGHI-TFH)/(0.30-0.25)) + &
- (PU_WIN-3.41)*(TD-(TFH+(PSHGC-0.30)*(TFGHI-TFH)/(0.30-0.25)))/(4.54-3.41)
- ZFAC_ALB = (RFH+(PSHGC-0.25)*(RFGHI-RFH)/(0.30-0.25)) + &
- (PU_WIN-3.41)*(RD-(RFH+(PSHGC-0.30)*(RFGHI-RFH)/(0.30-0.25)))/(4.54-3.41)
+ WHERE (B%XSHGC>0.25 .AND. B%XSHGC<0.30)
+ ZFAC_TRAN = (TFH+(B%XSHGC-0.25)*(TFGHI-TFH)/(0.30-0.25)) + &
+ (B%XU_WIN-3.41)*(TD-(TFH+(B%XSHGC-0.30)*(TFGHI-TFH)/(0.30-0.25)))/(4.54-3.41)
+ ZFAC_ALB = (RFH+(B%XSHGC-0.25)*(RFGHI-RFH)/(0.30-0.25)) + &
+ (B%XU_WIN-3.41)*(RD-(RFH+(B%XSHGC-0.30)*(RFGHI-RFH)/(0.30-0.25)))/(4.54-3.41)
END WHERE
!ZONE 23
- WHERE (PSHGC<=0.25)
- ZFAC_TRAN = TFH+(PU_WIN-3.41)*(TD-TFH)/(4.54-3.41)
- ZFAC_ALB = RFH+(PU_WIN-3.41)*(RD-RFH)/(4.54-3.41)
+ WHERE (B%XSHGC<=0.25)
+ ZFAC_TRAN = TFH+(B%XU_WIN-3.41)*(TD-TFH)/(4.54-3.41)
+ ZFAC_ALB = RFH+(B%XU_WIN-3.41)*(RD-RFH)/(4.54-3.41)
END WHERE
END WHERE
-WHERE (PU_WIN>=4.54)
+WHERE (B%XU_WIN>=4.54)
!ZONE 24
- WHERE (PSHGC>=0.65)
+ WHERE (B%XSHGC>=0.65)
ZFAC_TRAN = TA
ZFAC_ALB = RA
END WHERE
!ZONE 25
- WHERE (PSHGC >= 0.60 .AND. PSHGC<=0.65)
- ZFAC_TRAN = TBCD+(PSHGC-0.60)*(TA-TBCD)/(0.65-0.60)
- ZFAC_ALB = RBCD+(PSHGC-0.60)*(RA-RBCD)/(0.65-0.60)
+ WHERE (B%XSHGC >= 0.60 .AND. B%XSHGC<=0.65)
+ ZFAC_TRAN = TBCD+(B%XSHGC-0.60)*(TA-TBCD)/(0.65-0.60)
+ ZFAC_ALB = RBCD+(B%XSHGC-0.60)*(RA-RBCD)/(0.65-0.60)
END WHERE
!ZONE 26
- WHERE (PSHGC>=0.45 .AND. PSHGC<=0.60)
+ WHERE (B%XSHGC>=0.45 .AND. B%XSHGC<=0.60)
ZFAC_TRAN = TBCD
ZFAC_ALB = RBCD
END WHERE
!ZONE 27
- WHERE (PSHGC >= 0.30 .AND. PSHGC<=0.45)
- ZFAC_TRAN = TD+(PSHGC-0.30)*(TBCD-TD)/(0.45-0.30)
- ZFAC_ALB = RD+(PSHGC-0.30)*(RBCD-RD)/(0.45-0.30)
+ WHERE (B%XSHGC >= 0.30 .AND. B%XSHGC<=0.45)
+ ZFAC_TRAN = TD+(B%XSHGC-0.30)*(TBCD-TD)/(0.45-0.30)
+ ZFAC_ALB = RD+(B%XSHGC-0.30)*(RBCD-RD)/(0.45-0.30)
END WHERE
!ZONE 28
- WHERE (PSHGC<=0.30)
+ WHERE (B%XSHGC<=0.30)
ZFAC_TRAN = TD
ZFAC_ALB = RD
END WHERE
@@ -269,43 +266,45 @@ END WHERE
!
IF (LHOOK) CALL DR_HOOK('WINDOW_DATA',0,ZHOOK_HANDLE)
!
-WHERE (PU_WIN(:) < 5.85)
- ZR_IW(:) = 1. / (0.359073*log(PU_WIN(:)) + 6.949915)
+WHERE (B%XU_WIN(:) < 5.85)
+ ZR_IW(:) = 1. / (0.359073*log(B%XU_WIN(:)) + 6.949915)
ELSEWHERE
- ZR_IW(:) = 1. / (1.788041* PU_WIN(:) - 2.886625)
+ ZR_IW(:) = 1. / (1.788041* B%XU_WIN(:) - 2.886625)
END WHERE
!
-ZR_OW(:) = 1. / (0.025342*PU_WIN(:) + 29.163853)
+ZR_OW(:) = 1. / (0.025342*B%XU_WIN(:) + 29.163853)
!
-PUGG_WIN(:) = 1./(1./PU_WIN(:) - ZR_IW(:) - ZR_OW(:))
+B%XUGG_WIN(:) = 1./(1./B%XU_WIN(:) - ZR_IW(:) - ZR_OW(:))
!
!* B. Determine layer solar transmittance
! -----------------------------------
!
-WHERE (PU_WIN(:) > 4.5)
- WHERE (PSHGC(:) < 0.7206)
- ZTRAN_WIN_NORM(:) = 0.939998 * PSHGC(:)**2 + 0.20332 * PSHGC(:)
+WHERE (B%XU_WIN(:) > 4.5)
+ WHERE (B%XSHGC(:) < 0.7206)
+ ZTRAN_WIN_NORM(:) = 0.939998 * B%XSHGC(:)**2 + 0.20332 * B%XSHGC(:)
ELSE WHERE
- ZTRAN_WIN_NORM(:) = 1.30415 * PSHGC(:) - 0.30515
+ ZTRAN_WIN_NORM(:) = 1.30415 * B%XSHGC(:) - 0.30515
END WHERE
END WHERE
-WHERE (PU_WIN(:) < 3.4)
- WHERE (PSHGC(:) <= 0.15)
- ZTRAN_WIN_NORM(:) = 0.41040 * PSHGC(:)
+WHERE (B%XU_WIN(:) < 3.4)
+ WHERE (B%XSHGC(:) <= 0.15)
+ ZTRAN_WIN_NORM(:) = 0.41040 * B%XSHGC(:)
ELSE WHERE
- ZTRAN_WIN_NORM(:) = 0.085775 * PSHGC(:)**2 + 0.963954 * PSHGC(:) - 0.084958
+ ZTRAN_WIN_NORM(:) = 0.085775 * B%XSHGC(:)**2 + 0.963954 * B%XSHGC(:) - 0.084958
END WHERE
END WHERE
-WHERE (PU_WIN(:) >= 3.4 .AND. PU_WIN(:) <=4.5)
- WHERE(PSHGC(:) <= 0.15)
- ZTRAN_WIN_NORM(:) = 0.5* (0.939998 * PSHGC(:)**2 + (0.20332+0.41040) * PSHGC(:))
+WHERE (B%XU_WIN(:) >= 3.4 .AND. B%XU_WIN(:) <=4.5)
+ WHERE(B%XSHGC(:) <= 0.15)
+ ZTRAN_WIN_NORM(:) = 0.5* (0.939998 * B%XSHGC(:)**2 + (0.20332+0.41040) * B%XSHGC(:))
ELSE WHERE
- WHERE(PSHGC(:) > 0.15 .AND. PSHGC(:) < 0.7206)
- ZTRAN_WIN_NORM(:) = 0.5 * ((0.939998+0.085775) * PSHGC(:)**2 + (0.20332 + 0.963954) * PSHGC(:) - 0.084958)
+ WHERE(B%XSHGC(:) > 0.15 .AND. B%XSHGC(:) < 0.7206)
+ ZTRAN_WIN_NORM(:) = 0.5 * &
+ ((0.939998+0.085775) * B%XSHGC(:)**2 + (0.20332 + 0.963954) * B%XSHGC(:) - 0.084958)
ELSE WHERE
- ZTRAN_WIN_NORM(:) = 0.5*(0.085775 * PSHGC(:)**2 + (0.963954+1.30415) * PSHGC(:) - (0.084958+0.30515))
+ ZTRAN_WIN_NORM(:) = 0.5 * &
+ (0.085775 * B%XSHGC(:)**2 + (0.963954+1.30415) * B%XSHGC(:) - (0.084958+0.30515))
END WHERE
END WHERE
END WHERE
@@ -314,49 +313,49 @@ END WHERE
!* C. Determine layer solar reflectance
! ---------------------------------
!
-WHERE (PU_WIN(:) > 4.5)
- ZR_IS(:) = 1. / ( 29.436546*(PSHGC(:)-ZTRAN_WIN_NORM(:))**3 &
- - 21.943415*(PSHGC(:)-ZTRAN_WIN_NORM(:))**2 &
- + 9.945872 *(PSHGC(:)-ZTRAN_WIN_NORM(:)) + 7.426151 )
+WHERE (B%XU_WIN(:) > 4.5)
+ ZR_IS(:) = 1. / ( 29.436546*(B%XSHGC(:)-ZTRAN_WIN_NORM(:))**3 &
+ - 21.943415*(B%XSHGC(:)-ZTRAN_WIN_NORM(:))**2 &
+ + 9.945872 *(B%XSHGC(:)-ZTRAN_WIN_NORM(:)) + 7.426151 )
!
- ZR_OS (:) = 1./ ( 2.225824*(PSHGC(:)-ZTRAN_WIN_NORM(:)) + 20.57708 )
+ ZR_OS (:) = 1./ ( 2.225824*(B%XSHGC(:)-ZTRAN_WIN_NORM(:)) + 20.57708 )
ELSE WHERE
- WHERE(PU_WIN(:) >= 3.4)
+ WHERE(B%XU_WIN(:) >= 3.4)
ZR_IS(:) = 0.5 * ( &
- 1. / ( 29.436546*(PSHGC(:)-ZTRAN_WIN_NORM(:))**3 &
- - 21.943415*(PSHGC(:)-ZTRAN_WIN_NORM(:))**2 &
- + 9.945872 *(PSHGC(:)-ZTRAN_WIN_NORM(:)) + 7.426151 ) &
- + 1./ (199.8208128*(PSHGC(:)-ZTRAN_WIN_NORM(:))**3 &
- - 90.639733*(PSHGC(:)-ZTRAN_WIN_NORM(:))**2 &
- + 19.737055*(PSHGC(:)-ZTRAN_WIN_NORM(:)) + 6.766575) )
+ 1. / ( 29.436546*(B%XSHGC(:)-ZTRAN_WIN_NORM(:))**3 &
+ - 21.943415*(B%XSHGC(:)-ZTRAN_WIN_NORM(:))**2 &
+ + 9.945872 *(B%XSHGC(:)-ZTRAN_WIN_NORM(:)) + 7.426151 ) &
+ + 1./ (199.8208128*(B%XSHGC(:)-ZTRAN_WIN_NORM(:))**3 &
+ - 90.639733*(B%XSHGC(:)-ZTRAN_WIN_NORM(:))**2 &
+ + 19.737055*(B%XSHGC(:)-ZTRAN_WIN_NORM(:)) + 6.766575) )
!
ZR_OS (:) = 0.5 * ( &
- 1./ ( 2.225824*(PSHGC(:)-ZTRAN_WIN_NORM(:)) + 20.57708 ) &
- + 1./ ( 5.763355*(PSHGC(:)-ZTRAN_WIN_NORM(:)) + 20.541528 ) )
+ 1./ ( 2.225824*(B%XSHGC(:)-ZTRAN_WIN_NORM(:)) + 20.57708 ) &
+ + 1./ ( 5.763355*(B%XSHGC(:)-ZTRAN_WIN_NORM(:)) + 20.541528 ) )
!
ELSE WHERE
- ZR_IS (:) = 1./ (199.8208128*(PSHGC(:)-ZTRAN_WIN_NORM(:))**3 &
- - 90.639733*(PSHGC(:)-ZTRAN_WIN_NORM(:))**2 &
- + 19.737055*(PSHGC(:)-ZTRAN_WIN_NORM(:)) + 6.766575)
+ ZR_IS (:) = 1./ (199.8208128*(B%XSHGC(:)-ZTRAN_WIN_NORM(:))**3 &
+ - 90.639733*(B%XSHGC(:)-ZTRAN_WIN_NORM(:))**2 &
+ + 19.737055*(B%XSHGC(:)-ZTRAN_WIN_NORM(:)) + 6.766575)
!
- ZR_OS(:) = 1./ ( 5.763355*(PSHGC(:)-ZTRAN_WIN_NORM(:)) + 20.541528 )
+ ZR_OS(:) = 1./ ( 5.763355*(B%XSHGC(:)-ZTRAN_WIN_NORM(:)) + 20.541528 )
END WHERE
!
END WHERE
!
-ZFRAC(:) = (ZR_OS(:) + 0.5*(1./PUGG_WIN(:))) / &
- (ZR_OS(:) + 1./PUGG_WIN(:) + ZR_IS(:))
+ZFRAC(:) = (ZR_OS(:) + 0.5*(1./B%XUGG_WIN(:))) / &
+ (ZR_OS(:) + 1./B%XUGG_WIN(:) + ZR_IS(:))
!
-ZALB_WIN_NORM(:) = 1. - ZTRAN_WIN_NORM(:) - (PSHGC(:)-ZTRAN_WIN_NORM(:)) / ZFRAC(:)
+ZALB_WIN_NORM(:) = 1. - ZTRAN_WIN_NORM(:) - (B%XSHGC(:)-ZTRAN_WIN_NORM(:)) / ZFRAC(:)
!
!* D. Determine layer solar absortance
! --------------------------------
!
-PTRAN_WIN(:) = ZTRAN_WIN_NORM(:) * ZFAC_TRAN
-PALB_WIN(:) = ZALB_WIN_NORM(:) * ZFAC_ALB
+B%XTRAN_WIN(:) = ZTRAN_WIN_NORM(:) * ZFAC_TRAN
+B%XALB_WIN(:) = ZALB_WIN_NORM(:) * ZFAC_ALB
!
-PABS_WIN(:) = 1. - PALB_WIN(:) - PTRAN_WIN(:)
+B%XABS_WIN(:) = 1. - B%XALB_WIN(:) - B%XTRAN_WIN(:)
!
IF (LHOOK) CALL DR_HOOK('WINDOW_DATA',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/window_e_budget.F90 b/src/SURFEX/window_e_budget.F90
index 4f60abf0d18ae9905d80f7acc1771269cff947d6..add2b1a96465885fb95cf1d81eabbe6eec22fcaf 100644
--- a/src/SURFEX/window_e_budget.F90
+++ b/src/SURFEX/window_e_budget.F90
@@ -2,14 +2,12 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
-SUBROUTINE WINDOW_E_BUDGET(PU_WIN, PEMIS_WIN, PF_WIN_FLOOR, PF_WIN_WALL, PF_WIN_MASS, &
- PLW_W_TO_WIN, PLW_R_TO_WIN, PLW_G_TO_WIN, &
- PLW_NR_TO_WIN, PLW_S_TO_WIN, PRAD_ROOF_WIN, PRAD_WALL_WIN, &
- PABS_SW_WIN, PLW_RAD, PAC_WALL, &
- PRADHT_IN, PTI_BLD, PTS_MASS, PTS_FLOOR, PRHOA, PDN_ROAD, &
- PT_CANYON, PTS_WALL, PTS_ROAD, PTSNOW_ROAD, &
- PTS_GARDEN, PT_WIN1, PT_WIN2, PRAD_WIN_FLOOR, &
- PRAD_WIN_MASS, PCONV_WIN_BLD, PEMIT_LW_WIN, PABS_LW_WIN, PLOAD_IN_WIN)
+SUBROUTINE WINDOW_E_BUDGET(B, PEMIS_WIN, PLW_W_TO_WIN, PLW_R_TO_WIN, PLW_G_TO_WIN, &
+ PLW_NR_TO_WIN, PLW_S_TO_WIN, PRAD_RF_WIN, PRAD_WL_WIN, &
+ PABS_SW_WIN, PLW_RAD, PAC_WL, PRADHT_IN, PTS_FL, PRHOA, &
+ PDN_RD, PT_CANYON, PTS_WL, PTS_RD, PTSN_RD, PTS_GD, &
+ PRAD_WIN_FL, PRAD_WIN_MA, PCONV_WIN_BLD, PEMIT_LW_WIN, &
+ PABS_LW_WIN, PLOAD_IN_WIN)
!###################################################################################################################################
!
!!**** *WINDOW_E_BUDGET*
@@ -59,6 +57,8 @@ SUBROUTINE WINDOW_E_BUDGET(PU_WIN, PEMIS_WIN, PF_WIN_FLOOR, PF_WIN_WALL, PF_WIN_
!* 0. DECLARATIONS
! ------------
!
+USE MODD_BEM_n, ONLY : BEM_t
+!
USE MODD_CSTS,ONLY : XCPD, XSTEFAN
USE MODE_CONV_DOE
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -68,11 +68,9 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-REAL, DIMENSION(:), INTENT(IN) :: PU_WIN ! window U-factor [W m-2 K-1]
+TYPE(BEM_t), INTENT(INOUT) :: B
+!
REAL, DIMENSION(:), INTENT(IN) :: PEMIS_WIN ! window emissivity
-REAL, DIMENSION(:), INTENT(IN) :: PF_WIN_FLOOR ! window floor view factor
-REAL, DIMENSION(:), INTENT(IN) :: PF_WIN_WALL ! window wall view factor
-REAL, DIMENSION(:), INTENT(IN) :: PF_WIN_MASS ! window mass view factor
REAL, DIMENSION(:), INTENT(IN) :: PLW_W_TO_WIN ! Radiative heat trasfer coeff window-wall outdoor
! [W K-1 m-2]
REAL, DIMENSION(:), INTENT(IN) :: PLW_R_TO_WIN ! Radiative heat trasfer coeff window-road
@@ -81,27 +79,23 @@ REAL, DIMENSION(:), INTENT(IN) :: PLW_G_TO_WIN ! Radiative heat trasfer coeff
REAL, DIMENSION(:), INTENT(IN) :: PLW_NR_TO_WIN! Radiative heat trasfer coeff window-snow
REAL, DIMENSION(:), INTENT(IN) :: PLW_S_TO_WIN ! Radiative heat trasfer coeff window-sky
! [W K-1 m-2]
-REAL, DIMENSION(:), INTENT(IN) :: PRAD_ROOF_WIN ! rad. fluxes from roof to win [W m-2(roof)]
-REAL, DIMENSION(:), INTENT(IN) :: PRAD_WALL_WIN ! rad. fluxes from wall to win [W m-2(roof)]
+REAL, DIMENSION(:), INTENT(IN) :: PRAD_RF_WIN ! rad. fluxes from roof to win [W m-2(roof)]
+REAL, DIMENSION(:), INTENT(IN) :: PRAD_WL_WIN ! rad. fluxes from wall to win [W m-2(roof)]
REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_WIN ! window absorbed shortwave radiation [W m-2]
REAL, DIMENSION(:), INTENT(IN) :: PLW_RAD ! atmospheric infrared radiation
-REAL, DIMENSION(:), INTENT(IN) :: PAC_WALL ! aerodynamical conductance between wall and canyon
+REAL, DIMENSION(:), INTENT(IN) :: PAC_WL ! aerodynamical conductance between wall and canyon
REAL, DIMENSION(:), INTENT(IN) :: PRADHT_IN ! Indoor radiant heat transfer coefficient
! [W K-1 m-2]
-REAL, DIMENSION(:), INTENT(IN) :: PTI_BLD ! inside building temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS_MASS ! surface mass temperature [K]
-REAL, DIMENSION(:), INTENT(IN) :: PTS_FLOOR ! floor layers temperatures [K]
+REAL, DIMENSION(:), INTENT(IN) :: PTS_FL ! floor layers temperatures [K]
REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! rho
-REAL, DIMENSION(:), INTENT(IN) :: PDN_ROAD ! snow-covered fraction on roads
+REAL, DIMENSION(:), INTENT(IN) :: PDN_RD ! snow-covered fraction on roads
REAL, DIMENSION(:), INTENT(IN) :: PT_CANYON ! air canyon temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS_WALL ! wall outdoor surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS_ROAD ! road surface temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTSNOW_ROAD ! road snow temperature
-REAL, DIMENSION(:), INTENT(IN) :: PTS_GARDEN ! green area surface temperature
-REAL, DIMENSION(:), INTENT(OUT) :: PT_WIN1 ! outdoor window temperature [K]
-REAL, DIMENSION(:), INTENT(INOUT) :: PT_WIN2 ! indoor window temperature [K]
-REAL, DIMENSION(:), INTENT(OUT) :: PRAD_WIN_FLOOR ! rad. fluxes from window to floor [W m-2(window)]
-REAL, DIMENSION(:), INTENT(OUT) :: PRAD_WIN_MASS ! rad. fluxes from window to mass [W m-2(window)]
+REAL, DIMENSION(:), INTENT(IN) :: PTS_WL ! wall outdoor surface temperature
+REAL, DIMENSION(:), INTENT(IN) :: PTS_RD ! road surface temperature
+REAL, DIMENSION(:), INTENT(IN) :: PTSN_RD ! road snow temperature
+REAL, DIMENSION(:), INTENT(IN) :: PTS_GD ! green area surface temperature
+REAL, DIMENSION(:), INTENT(OUT) :: PRAD_WIN_FL ! rad. fluxes from window to floor [W m-2(window)]
+REAL, DIMENSION(:), INTENT(OUT) :: PRAD_WIN_MA ! rad. fluxes from window to mass [W m-2(window)]
REAL, DIMENSION(:), INTENT(OUT) :: PCONV_WIN_BLD ! conv. fluxes from window to bld [W m-2(window)]
REAL, DIMENSION(:), INTENT(OUT) :: PEMIT_LW_WIN ! Longwave radiation emitted by the window [W m-2(window)]
REAL, DIMENSION(:), INTENT(OUT) :: PABS_LW_WIN ! Longwave radiation absorbed by the window [W m-2(window)]
@@ -119,7 +113,7 @@ INTEGER :: JJ
!* Preliminaries
! -------------
-ZCHTC_IN_WIN = CHTC_VERT_DOE(PT_WIN2, PTI_BLD)
+ZCHTC_IN_WIN = CHTC_VERT_DOE(B%XT_WIN2, B%XTI_BLD)
DO JJ=1,SIZE(ZCHTC_IN_WIN)
ZCHTC_IN_WIN(JJ) = MAX(1., ZCHTC_IN_WIN(JJ))
ENDDO
@@ -129,52 +123,58 @@ ENDDO
ZT_SKY(:) = (PLW_RAD(:)/XSTEFAN)**0.25
!
ZA12(:) = ZCHTC_IN_WIN(:) &
- + PRADHT_IN(:) * PF_WIN_MASS(:) &
- + PRADHT_IN(:) * PF_WIN_FLOOR(:) &
- + PU_WIN(:)
-!
-ZB1(:) = ZCHTC_IN_WIN (:) * PTI_BLD (:) &
- + PRADHT_IN(:) * PF_WIN_MASS(:) * PTS_MASS(:) &
- + PF_WIN_WALL(:) * PRAD_WALL_WIN(:) &
- + PF_WIN_FLOOR(:) * PRAD_ROOF_WIN(:) &
- + PRADHT_IN(:) * PF_WIN_FLOOR(:)* PTS_FLOOR(:) &
+ + PRADHT_IN(:) * B%XF_WIN_MASS (:) &
+ + PRADHT_IN(:) * B%XF_WIN_FLOOR(:) &
+ + B%XUGG_WIN(:)
+!
+ZB1(:) = ZCHTC_IN_WIN (:) * B%XTI_BLD (:) &
+ + PRADHT_IN (:) * B%XF_WIN_MASS(:) * B%XT_MASS(:,1) &
+ + B%XF_WIN_WALL (:) * PRAD_WL_WIN(:) &
+ + B%XF_WIN_FLOOR(:) * PRAD_RF_WIN(:) &
+ + PRADHT_IN (:) * B%XF_WIN_FLOOR(:)* PTS_FL(:) &
+ PLOAD_IN_WIN(:) + PABS_SW_WIN(:) /2.
!
-ZA21(:) = - PAC_WALL (:) * PRHOA(:)*XCPD &
- - PLW_S_TO_WIN (:) &
- - PLW_W_TO_WIN (:) &
- - PLW_R_TO_WIN (:) *(1.-PDN_ROAD(:))&
- - PLW_G_TO_WIN (:) &
- - PLW_NR_TO_WIN(:) * PDN_ROAD(:) &
- - PU_WIN(:)
-!
-ZB2(:) = - PAC_WALL (:) * PRHOA(:)*XCPD*PT_CANYON(:) &
- - PLW_S_TO_WIN (:) * ZT_SKY(:) &
- - PLW_W_TO_WIN (:) * PTS_WALL(:) &
- - PLW_R_TO_WIN (:) *(1.-PDN_ROAD(:)) * PTS_ROAD(:) &
- - PLW_G_TO_WIN (:) * PTS_GARDEN(:) &
- - PLW_NR_TO_WIN(:) * PDN_ROAD(:) * PTSNOW_ROAD(:) &
- - PABS_SW_WIN (:) /2.
+ZA21(:) = - PAC_WL (:) * PRHOA(:)*XCPD &
+ - PLW_S_TO_WIN (:) &
+ - PLW_W_TO_WIN (:) &
+ - PLW_R_TO_WIN (:) *(1.-PDN_RD(:))&
+ - PLW_G_TO_WIN (:) &
+ - PLW_NR_TO_WIN(:) * PDN_RD(:) &
+ - B%XUGG_WIN(:)
+!
+ZB2(:) = - PAC_WL (:) * PRHOA(:)*XCPD*PT_CANYON(:) &
+ - PLW_S_TO_WIN (:) * ZT_SKY(:) &
+ - PLW_W_TO_WIN (:) * PTS_WL(:) &
+ - PLW_R_TO_WIN (:) *(1.-PDN_RD(:)) * PTS_RD(:) &
+ - PLW_NR_TO_WIN(:) * PDN_RD(:) * PTSN_RD(:) &
+ - PABS_SW_WIN (:) /2.
+!
+IF (SIZE(PTS_GD)>0) THEN
+ ZB2(:) = ZB2(:) - PLW_G_TO_WIN (:) * PTS_GD(:)
+ENDIF
!
! compute outdoor temperature
-PT_WIN1(:) = ( ZB2(:) - ZB1(:)*PU_WIN(:)/ZA12(:) ) / &
- ( ZA21(:) + PU_WIN(:)**2/ZA12(:) )
+B%XT_WIN1(:) = ( ZB2(:) - ZB1(:)*B%XUGG_WIN(:)/ZA12(:) ) / &
+ ( ZA21(:) + B%XUGG_WIN(:)**2/ZA12(:) )
!
! compute indoor temperature
-PT_WIN2(:) = (ZB1(:) + PU_WIN(:)*PT_WIN1(:) ) / ZA12(:)
+B%XT_WIN2(:) = (ZB1(:) + B%XUGG_WIN(:)*B%XT_WIN1(:) ) / ZA12(:)
!
! outdoor infrared radiation absorded by the window
-PABS_LW_WIN(:) = PLW_S_TO_WIN (:) * (ZT_SKY (:) - PT_WIN1(:)) + &
- (1.-PDN_ROAD(:))* PLW_R_TO_WIN (:) * (PTS_ROAD (:) - PT_WIN1(:)) + &
- PLW_G_TO_WIN (:) * (PTS_GARDEN (:) - PT_WIN1(:)) + &
- PLW_W_TO_WIN (:) * (PTS_WALL (:) - PT_WIN1(:)) + &
- PDN_ROAD(:) * PLW_NR_TO_WIN(:) * (PTSNOW_ROAD(:) - PT_WIN1(:))
+PABS_LW_WIN(:) = PLW_S_TO_WIN (:) * (ZT_SKY (:) - B%XT_WIN1(:)) + &
+ (1.-PDN_RD(:)) * PLW_R_TO_WIN (:) * (PTS_RD (:) - B%XT_WIN1(:)) + &
+ PLW_W_TO_WIN (:) * (PTS_WL (:) - B%XT_WIN1(:)) + &
+ PDN_RD(:) * PLW_NR_TO_WIN(:) * (PTSN_RD(:) - B%XT_WIN1(:))
+!
+IF (SIZE(PTS_GD)>0) THEN
+ PABS_LW_WIN(:) = PABS_LW_WIN(:) + PLW_G_TO_WIN (:) * (PTS_GD (:) - B%XT_WIN1(:))
+ENDIF
!
! outdoor infrared radiation emited by the window
-PEMIT_LW_WIN(:) = XSTEFAN * PT_WIN1(:)**4 + (1 - PEMIS_WIN(:))/PEMIS_WIN(:) * PABS_LW_WIN(:)
+PEMIT_LW_WIN(:) = XSTEFAN * B%XT_WIN1(:)**4 + (1 - PEMIS_WIN(:))/PEMIS_WIN(:) * PABS_LW_WIN(:)
!
-PRAD_WIN_FLOOR(:) = PRADHT_IN(:) * (PT_WIN2(:) - PTS_FLOOR(:))
-PRAD_WIN_MASS(:) = PRADHT_IN(:) * (PT_WIN2(:) - PTS_MASS(:))
-PCONV_WIN_BLD(:) = ZCHTC_IN_WIN(:) * (PT_WIN2(:) - PTI_BLD(:))
+PRAD_WIN_FL (:) = PRADHT_IN(:) * (B%XT_WIN2(:) - PTS_FL(:))
+PRAD_WIN_MA (:) = PRADHT_IN(:) * (B%XT_WIN2(:) - B%XT_MASS(:,1))
+PCONV_WIN_BLD(:) = ZCHTC_IN_WIN(:) * (B%XT_WIN2(:) - B%XTI_BLD(:))
!
END SUBROUTINE WINDOW_E_BUDGET
diff --git a/src/SURFEX/write_bld_descriptionn.F90 b/src/SURFEX/write_bld_descriptionn.F90
index 4f5bbd0c05cb19efec2f9f98433d2432b7f83980..8f71b236d9df9051db6512036c9c86664006dae1 100644
--- a/src/SURFEX/write_bld_descriptionn.F90
+++ b/src/SURFEX/write_bld_descriptionn.F90
@@ -3,9 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########################
- SUBROUTINE WRITE_BLD_DESCRIPTION_n (DGU, U, &
- BDD, &
- HPROGRAM)
+ SUBROUTINE WRITE_BLD_DESCRIPTION_n (HSELECT, BDD, HPROGRAM)
! #########################
!
!!
@@ -41,12 +39,6 @@
! -----------
!
!
-!
-!
-!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
USE MODD_BLD_DESCRIPTION_n, ONLY : BLD_DESC_t
!
USE MODI_WRITE_SURF
@@ -61,10 +53,7 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
-!
-!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
TYPE(BLD_DESC_t), INTENT(INOUT) :: BDD
!
@@ -81,8 +70,8 @@ INTEGER :: IRESP
INTEGER :: I1, I2
INTEGER :: JL
INTEGER :: ITOT
-CHARACTER(LEN=LEN_HREC) :: YRECFM
-CHARACTER(LEN=100) :: YCOMMENT
+ CHARACTER(LEN=LEN_HREC) :: YRECFM
+ CHARACTER(LEN=100) :: YCOMMENT
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
@@ -103,10 +92,9 @@ ZWORK(5) = FLOAT(BDD%NDESC_ROOF_LAYER)
ZWORK(6) = FLOAT(BDD%NDESC_ROAD_LAYER)
ZWORK(7) = FLOAT(BDD%NDESC_FLOOR_LAYER)
!
-YRECFM='Bld_dimensions'
+YRECFM='Bld_dimensions '
YCOMMENT='Configuration numbers for descriptive building data'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'BLD_DESC_CNF',ZWORK,IRESP,YCOMMENT,'-',YRECFM)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,'BLD_DESC_CNF',ZWORK,IRESP,YCOMMENT,'-',YRECFM)
DEALLOCATE(ZWORK)
!
!-------------------------------------------------------------------------------
@@ -194,15 +182,15 @@ END DO
CALL UP_DESC_IND_W(BDD%NDESC_AGE) ; ZWORK(I1:I2) = FLOAT(BDD%NDESC_AGE_LIST(:))
CALL UP_DESC_IND_W(BDD%NDESC_AGE) ; ZWORK(I1:I2) = FLOAT(BDD%NDESC_AGE_DATE(:))
!
-YRECFM='Bld_parameters '
YCOMMENT='Descriptive building data'
- CALL WRITE_SURF(DGU, U, &
+YRECFM='Bld_parameters '
+ CALL WRITE_SURF(HSELECT, &
HPROGRAM,'BLD_DESC_DAT',ZWORK,IRESP,YCOMMENT,'-',YRECFM)
DEALLOCATE(ZWORK)
!
IF (LHOOK) CALL DR_HOOK('WRITE_BLD_DESCRIPTION_n',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
- CONTAINS
+CONTAINS
SUBROUTINE UP_DESC_IND_W(K)
INTEGER, INTENT(IN) :: K
I1=I2+1
diff --git a/src/SURFEX/write_cover_tex_end.F90 b/src/SURFEX/write_cover_tex_end.F90
index 8378dab15cef589481b216765217662d1c6ff0b6..ab028a4e98f8d704b571a915c90831deff6f6eb5 100644
--- a/src/SURFEX/write_cover_tex_end.F90
+++ b/src/SURFEX/write_cover_tex_end.F90
@@ -49,12 +49,17 @@ USE MODI_CLOSE_WRITE_COVER_TEX_LFI
#ifdef SFX_MNH
USE MODI_MNHCLOSE_WRITE_COVER_TEX
#endif
+#ifdef SFX_ARO
+USE MODI_AROCLOSE_WRITE_COVER_TEX
+#endif
+
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+!
!* 0.1 Declaration of arguments
! ------------------------
!
diff --git a/src/SURFEX/write_cover_tex_isba.F90 b/src/SURFEX/write_cover_tex_isba.F90
index 20f4a94ccfa2aecabe79fa51c80cb17873a62454..47b2f57fa9e3eaf72f7f92d05d8c74088b24d1ad 100644
--- a/src/SURFEX/write_cover_tex_isba.F90
+++ b/src/SURFEX/write_cover_tex_isba.F90
@@ -55,7 +55,8 @@ USE MODD_DATA_COVER_PAR, ONLY : JPCOVER, NVEGTYPE, NVT_NO, NVT_ROCK, &
NVT_C3, NVT_C4, NVT_IRR, NVT_GRAS, &
NVT_TROG,NVT_PARK, NVT_TRBD, NVT_TEBE, &
NVT_TENE, NVT_BOBD, NVT_BOND, NVT_BOGR, &
- NVT_SHRB
+ NVT_SHRB, NVT_C3W, NVT_C3S, NVT_FLTR, &
+ NVT_FLGR
!
USE MODD_REPROD_OPER, ONLY : XEVERG_VEG, XEVERG_RSMIN
!
@@ -380,8 +381,20 @@ DO JVEGTYPE=1,NVEGTYPE
YPATCH(1) = 'irrigated grass '
YPATCH(2) = "les pelouses irrigu\'ees "
END IF
+ IF (JVEGTYPE==NVT_FLTR) THEN
+ YPATCH(1) = 'flooded trees '
+ YPATCH(2) = "les arbres inondes "
+ END IF
+ IF (JVEGTYPE==NVT_FLGR) THEN
+ YPATCH(1) = 'flooded grassland '
+ YPATCH(2) = "les prairies inondees "
+ END IF
IF (JVEGTYPE==NVT_C3) YPATCH = (/ 'C3 crops ', &
'les cultures C3 ' /)
+ IF (JVEGTYPE==NVT_C3W) YPATCH = (/ 'C3W crops ', &
+ 'les cultures C3 dhiver ' /)
+ IF (JVEGTYPE==NVT_C3S) YPATCH = (/ 'C3S crops ', &
+ 'les cultures C3 dete ' /)
IF (JVEGTYPE==NVT_C4) YPATCH = (/ 'C4 crops ', &
'les cultures C4 ' /)
IF (JVEGTYPE==NVT_IRR ) THEN
diff --git a/src/SURFEX/write_cover_tex_isba_par.F90 b/src/SURFEX/write_cover_tex_isba_par.F90
index d98d8e28d7ed934caa9887c4202a8ffb57628fec..7a621ee933a1006e318415c9870ab29109299b09 100644
--- a/src/SURFEX/write_cover_tex_isba_par.F90
+++ b/src/SURFEX/write_cover_tex_isba_par.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_COVER_TEX_ISBA_PAR (DTCO, I, &
+ SUBROUTINE WRITE_COVER_TEX_ISBA_PAR (DTCO, HALBEDO, OTR_ML, &
KPATCH,KLAYER,HISBA,HPHOTO,PSOILGRID)
! ##########################
!
@@ -47,7 +47,6 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_ISBA_n, ONLY : ISBA_t
!
USE MODE_WRITE_COVER_TEX
@@ -71,7 +70,9 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(ISBA_t), INTENT(INOUT) :: I
+!
+ CHARACTER(LEN=*), INTENT(IN) :: HALBEDO
+LOGICAL, INTENT(IN) :: OTR_ML
!
INTEGER, INTENT(IN) :: KPATCH! number of patch
INTEGER, INTENT(IN) :: KLAYER! number of soil layers
@@ -135,15 +136,15 @@ GCOVER(:) = .TRUE.
!ocl scalar
!
DO JJ=1,12
- CALL CONVERT_COVER_ISBA(DTCO, I, &
- HISBA,3*JJ-1,ZCOVER,GCOVER,HPHOTO, 'NAT', &
+ CALL CONVERT_COVER_ISBA(DTCO, HALBEDO, &
+ HISBA,OTR_ML,3*JJ-1,ZCOVER,GCOVER,HPHOTO, 'NAT', &
PVEG=ZVEG(:,:,JJ), PLAI=ZLAI(:,:,JJ), &
PZ0=ZZ0VEG(:,:,JJ), PEMIS_ECO=ZEMIS_ECO(:,:,JJ), &
PF2I=ZF2I(:,:,JJ),OSTRESS=GSTRESS(:,:,JJ) )
END DO
- CALL CONVERT_COVER_ISBA(DTCO, I, &
- HISBA,2,ZCOVER,GCOVER,HPHOTO, 'NAT', &
+ CALL CONVERT_COVER_ISBA(DTCO, HALBEDO, &
+ HISBA,OTR_ML,2,ZCOVER,GCOVER,HPHOTO, 'NAT', &
PRSMIN=ZRSMIN,PGAMMA=ZGAMMA,PWRMAX_CF=ZWRMAX_CF, &
PRGL=ZRGL,PCV=ZCV,PSOILGRID=PSOILGRID, &
PDG=ZDG,KWG_LAYER=IWG_LAYER,PDROOT=ZDROOT, &
diff --git a/src/SURFEX/write_cover_tex_start.F90 b/src/SURFEX/write_cover_tex_start.F90
index cd43e12feaae1c4836c5697faeab8cf066f70c11..9b64ba20aaa6b69a42748fc076ef9f3a9daef443 100644
--- a/src/SURFEX/write_cover_tex_start.F90
+++ b/src/SURFEX/write_cover_tex_start.F90
@@ -49,12 +49,16 @@ USE MODI_OPEN_WRITE_COVER_TEX_LFI
#ifdef SFX_MNH
USE MODI_MNHOPEN_WRITE_COVER_TEX
#endif
+#ifdef SFX_ARO
+USE MODI_AROOPEN_WRITE_COVER_TEX
+#endif
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+!
!* 0.1 Declaration of arguments
! ------------------------
!
diff --git a/src/SURFEX/write_data.F90 b/src/SURFEX/write_data.F90
index ef793222f88b433bcc6fc04d1212a607dec64d8f..af1449573f5e3d48930afe302741fee9807ec709 100644
--- a/src/SURFEX/write_data.F90
+++ b/src/SURFEX/write_data.F90
@@ -47,10 +47,10 @@ USE MODD_DATA_COVER, ONLY : XDATA_TOWN, XDATA_NATURE, XDATA_SEA, XDATA_WATER
XDATA_GROUND_DEPTH, XDATA_ROOT_DEPTH, &
TDATA_SEED, TDATA_REAP, XDATA_WATSUP, XDATA_IRRIG,&
XDATA_LAI_ALL_YEARS
-USE MODD_DATA_COVER_PAR, ONLY : CNAMES
+USE MODD_DATA_COVER_PAR, ONLY : CNAMES, NVEGTYPE
!
-USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, NVT_IRR, JPCOVER
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, JPCOVER, NVT_IRR
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -69,38 +69,62 @@ IMPLICIT NONE
!
!
INTEGER :: JCOVER,JDEC,JK ! loop counters on covers, decades and vegtypes
-!
-
+INTEGER :: JBEG
!
!* 0.3 Declaration of namelists
! ------------------------
!
- CHARACTER(LEN=8), DIMENSION(19) :: CNVT
+ CHARACTER(LEN=8), DIMENSION(NVEGTYPE) :: CNVT
CHARACTER(LEN=2) :: CF
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('WRITE_DATA',0,ZHOOK_HANDLE)
- CNVT(1) = "NVT_NO " ! no vegetation (smooth)
- CNVT(2) = "NVT_ROCK" ! no vegetation (rocks)
- CNVT(3) = "NVT_SNOW" ! permanent snow and ice
- CNVT(4) = "NVT_TEBD" ! temperate broadleaf deciduous trees
- CNVT(5) = "NVT_BONE" ! boreal needleleaf evergreen trees
- CNVT(6) = "NVT_TRBE" ! tropical broadleaf evergreen trees
- CNVT(7) = "NVT_C3 " ! C3 cultures types
- CNVT(8) = "NVT_C4 " ! C4 cultures types
- CNVT(9) = "NVT_IRR " ! irrigated crops
- CNVT(10)= "NVT_GRAS" ! temperate grassland C3
- CNVT(11)= "NVT_TROG" ! tropical grassland C4
- CNVT(12)= "NVT_PARK" ! peat bogs, parks and gardens (irrigated grass)
- CNVT(13)= "NVT_TRBD" ! tropical broadleaf deciduous trees
- CNVT(14)= "NVT_TEBE" ! temperate broadleaf evergreen trees
- CNVT(15)= "NVT_TENE" ! temperate needleleaf evergreen trees
- CNVT(16)= "NVT_BOBD" ! boreal broadleaf deciduous trees
- CNVT(17)= "NVT_BOND" ! boreal needleleaf deciduous trees
- CNVT(18)= "NVT_BOGR" ! boreal grassland C3
- CNVT(19)= "NVT_SHRB" ! broadleaf shrub
-
-DO JCOVER=301,JPCOVER
+IF (NVT_IRR/=0) THEN
+ JBEG = 301
+ CNVT(1) = "NVT_NO " ! no vegetation (smooth)
+ CNVT(2) = "NVT_ROCK" ! no vegetation (rocks)
+ CNVT(3) = "NVT_SNOW" ! permanent snow and ice
+ CNVT(4) = "NVT_TEBD" ! temperate broadleaf deciduous trees
+ CNVT(5) = "NVT_BONE" ! boreal needleleaf evergreen trees
+ CNVT(6) = "NVT_TRBE" ! tropical broadleaf evergreen trees
+ CNVT(7) = "NVT_C3 " ! C3 cultures types
+ CNVT(8) = "NVT_C4 " ! C4 cultures types
+ CNVT(9) = "NVT_IRR " ! irrigated crops
+ CNVT(10)= "NVT_GRAS" ! temperate grassland C3
+ CNVT(11)= "NVT_TROG" ! tropical grassland C4
+ CNVT(12)= "NVT_PARK" ! peat bogs, parks and gardens (irrigated grass)
+ CNVT(13)= "NVT_TRBD" ! tropical broadleaf deciduous trees
+ CNVT(14)= "NVT_TEBE" ! temperate broadleaf evergreen trees
+ CNVT(15)= "NVT_TENE" ! temperate needleleaf evergreen trees
+ CNVT(16)= "NVT_BOBD" ! boreal broadleaf deciduous trees
+ CNVT(17)= "NVT_BOND" ! boreal needleleaf deciduous trees
+ CNVT(18)= "NVT_BOGR" ! boreal grassland C3
+ CNVT(19)= "NVT_SHRB" ! broadleaf shrub
+ELSE
+ JBEG = 1
+ CNVT(1) = "NVT_NO " ! no vegetation (smooth)
+ CNVT(2) = "NVT_ROCK" ! no vegetation (rocks)
+ CNVT(3) = "NVT_SNOW" ! permanent snow and ice
+ CNVT(4) = "NVT_BOBD" ! boreal broadleaf deciduous trees
+ CNVT(5) = "NVT_TEBD" ! temperate broadleaf deciduous trees
+ CNVT(6) = "NVT_TRBD" ! tropical broadleaf deciduous trees
+ CNVT(7) = "NVT_TEBE" ! temperate broadleaf evergreen trees
+ CNVT(8) = "NVT_TRBE" ! tropical broadleaf evergreen trees
+ CNVT(9) = "NVT_BONE" ! boreal needleleaf evergreen trees
+ CNVT(10)= "NVT_TENE" ! temperate needleleaf evergreen trees
+ CNVT(11)= "NVT_BOND" ! boreal needleleaf deciduous trees
+ CNVT(12)= "NVT_GRAS" ! temperate grassland C3
+ CNVT(13)= "NVT_TROG" ! tropical grassland C4
+ CNVT(14)= "NVT_BOGR" ! boreal grassland C3
+ CNVT(15)= "NVT_SHRB" ! broadleaf shrub
+ CNVT(16)= "NVT_C3W " ! winter C3 cultures types
+ CNVT(17)= "NVT_C3E " ! summer C3 cultures types
+ CNVT(18)= "NVT_C4 " ! C4 cultures types
+ CNVT(19)= "NVT_FLTR" ! flooded trees
+ CNVT(20)= "NVT_FLGR" ! flooded grassland
+ENDIF
+!
+DO JCOVER=JBEG,JPCOVER
WRITE(*,FMT='(A80)') '!-------------------------------------------------------------------------------'
WRITE(*,FMT='(A16,I3.3)') 'SUBROUTINE COVER',JCOVER
WRITE(*,FMT='(A1)') '!'
@@ -187,7 +211,7 @@ END DO
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
-DO JCOVER=301,JPCOVER
+DO JCOVER=JBEG,JPCOVER
WRITE(*,FMT='(A10,I3.3)') 'CALL COVER',JCOVER
END DO
IF (LHOOK) CALL DR_HOOK('WRITE_DATA',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/write_diag_ch_aggr.F90 b/src/SURFEX/write_diag_ch_aggr.F90
index 837532b2f30d5e3df7b41fa2b1be52d70c0bb71c..b2c294945eb2a93bc627063b0ccc76c66ea79628 100644
--- a/src/SURFEX/write_diag_ch_aggr.F90
+++ b/src/SURFEX/write_diag_ch_aggr.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_DIAG_CH_AGGR_n (DTCO, DGU, U, CHE, &
- HPROGRAM)
+ SUBROUTINE WRITE_DIAG_CH_AGGR_n (DTCO, HSELECT, U, CHE, HPROGRAM)
! #################################
!
!!**** *WRITE_DIAG_CH_AGGR_n* - writes surface chemical emissions diagnostics
@@ -35,7 +34,6 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_CH_EMIS_FIELD_n, ONLY : CH_EMIS_FIELD_t
!
@@ -55,7 +53,7 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(CH_EMIS_FIELD_t), INTENT(INOUT) :: CHE
!
@@ -77,8 +75,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! Initialisation for IO
!
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_CH_AGGR_n',0,ZHOOK_HANDLE)
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'FULL ','SURF ','WRITE')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'FULL ','SURF ','WRITE','SURF_ATM_DIAGNOSTICS.OUT.nc')
!
!-------------------------------------------------------------------------------
!
@@ -87,8 +84,8 @@ IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_CH_AGGR_n',0,ZHOOK_HANDLE)
DO JSPEC=1,SIZE(CHE%TSEMISS)
YRECFM = "E_"//TRIM(CHE%TSEMISS(JSPEC)%CNAME)
YCOMMENT = "Emission data at time t (ppm*m/s)"
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,CHE%TSEMISS(JSPEC)%XEMISDATA,IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,CHE%TSEMISS(JSPEC)%XEMISDATA,IRESP,HCOMMENT=YCOMMENT,&
+ HNAM_DIM="Temporal_emiss")
END DO
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/write_diag_ch_snapn.F90 b/src/SURFEX/write_diag_ch_snapn.F90
index 1ccf147fcf9b71a2ce7ca0adfc7f5b7e2d6112a1..8e1d0e5e8b9046ab02785d9bf697c0b38c63ccf6 100644
--- a/src/SURFEX/write_diag_ch_snapn.F90
+++ b/src/SURFEX/write_diag_ch_snapn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_DIAG_CH_SNAP_n (DTCO, DGU, U, CHN, &
- HPROGRAM)
+ SUBROUTINE WRITE_DIAG_CH_SNAP_n (DTCO, HSELECT, U, CHN, HPROGRAM)
! #################################
!
!!**** *WRITE_DIAG_CH_SNAP_n* - writes surface chemical emissions diagnostics
@@ -36,7 +35,6 @@
! ------------
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_CH_SNAP_n, ONLY : CH_EMIS_SNAP_t
!
@@ -56,7 +54,7 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(CH_EMIS_SNAP_t), INTENT(INOUT) :: CHN
!
@@ -78,8 +76,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! Initialisation for IO
!
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_CH_SNAP_n',0,ZHOOK_HANDLE)
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'FULL ','SURF ','WRITE')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'FULL ','SURF ','WRITE','SURF_ATM_DIAGNOSTICS.OUT.nc')
!
!-------------------------------------------------------------------------------
!
@@ -88,8 +85,7 @@ IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_CH_SNAP_n',0,ZHOOK_HANDLE)
DO JSPEC=1,CHN%NEMIS_NBR
YRECFM = "E_"//TRIM(CHN%CEMIS_NAME(JSPEC))
YCOMMENT = "Emission data at time t (ppm*m/s)"
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,CHN%XEMIS_FIELDS(:,JSPEC),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,CHN%XEMIS_FIELDS(:,JSPEC),IRESP,HCOMMENT=YCOMMENT)
END DO
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/write_diag_flaken.F90 b/src/SURFEX/write_diag_flaken.F90
index d57d153fed0d85207e4730857f333fae89e62f8a..5bd28e9b6abfbaab780b4a2833663eb660c5bcaa 100644
--- a/src/SURFEX/write_diag_flaken.F90
+++ b/src/SURFEX/write_diag_flaken.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE WRITE_DIAG_FLAKE_n (DTCO, DGU, U, FM, &
- HPROGRAM,HWRITE)
+SUBROUTINE WRITE_DIAG_FLAKE_n (DTCO, DUO, U, FM, HPROGRAM,HWRITE)
! ###############################################################################
!
!!**** *WRITE_DIAG_FLAKE_n * - diagnostics for lakes
@@ -31,8 +30,8 @@ SUBROUTINE WRITE_DIAG_FLAKE_n (DTCO, DGU, U, FM, &
!
USE MODD_SURFEX_n, ONLY : FLAKE_MODEL_t
!
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -51,7 +50,7 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DUO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(FLAKE_MODEL_t), INTENT(INOUT) :: FM
!
@@ -67,12 +66,10 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_FLAKE_N',0,ZHOOK_HANDLE)
IF (HWRITE/='PGD') THEN
!
- IF (FM%DGF%XDIAG_TSTEP==XUNDEF .OR. &
- ABS(NINT(FM%F%TTIME%TIME/FM%DGF%XDIAG_TSTEP)*FM%DGF%XDIAG_TSTEP-FM%F%TTIME%TIME)<1.E-3 ) THEN
- CALL WRITE_DIAG_SEB_FLAKE_n(DTCO, DGU, U, FM%CHF, FM%DGF, &
- HPROGRAM)
- CALL WRITE_DIAG_MISC_FLAKE_n(DTCO, DGU, U, FM%DGMF, &
- HPROGRAM)
+ IF (FM%DFO%XDIAG_TSTEP==XUNDEF .OR. &
+ ABS(NINT(FM%F%TTIME%TIME/FM%DFO%XDIAG_TSTEP)*FM%DFO%XDIAG_TSTEP-FM%F%TTIME%TIME)<1.E-3 ) THEN
+ CALL WRITE_DIAG_SEB_FLAKE_n(DTCO, DUO, U, FM%CHF, FM%DFO, FM%DF, FM%DFC, HPROGRAM)
+ CALL WRITE_DIAG_MISC_FLAKE_n(DTCO, DUO%CSELECT, U, FM%DMF, HPROGRAM)
END IF
!
ENDIF
diff --git a/src/SURFEX/write_diag_inland_watern.F90 b/src/SURFEX/write_diag_inland_watern.F90
index f465b1c82305d2056c53a07df91d3f61d626e721..9800001473ac3b07684464d4ef53a7c7357e982a 100644
--- a/src/SURFEX/write_diag_inland_watern.F90
+++ b/src/SURFEX/write_diag_inland_watern.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE WRITE_DIAG_INLAND_WATER_n (DTCO, DGU, U, WM, FM, &
- HPROGRAM,HWRITE)
+SUBROUTINE WRITE_DIAG_INLAND_WATER_n (DTCO, DUO, U, WM, FM, HPROGRAM,HWRITE)
! ###############################################################################
!
!!**** *WRITE_DIAG_INLAND_WATER_n * - Chooses the surface schemes for lakes diagnostics
@@ -32,10 +31,9 @@ USE MODD_SURFEX_n, ONLY : FLAKE_MODEL_t
USE MODD_SURFEX_n, ONLY : WATFLUX_MODEL_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_CH_WATFLUX_n, ONLY : CH_WATFLUX_t
-USE MODD_DIAG_WATFLUX_n, ONLY : DIAG_WATFLUX_t
USE MODD_WATFLUX_n, ONLY : WATFLUX_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -54,7 +52,7 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DUO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(WATFLUX_MODEL_t), INTENT(INOUT) :: WM
TYPE(FLAKE_MODEL_t), INTENT(INOUT) :: FM
@@ -72,12 +70,10 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_INLAND_WATER_N',0,ZHOOK_HANDLE)
IF (U%CWATER=='WATFLX') THEN
- CALL WRITE_DIAG_WATFLUX_n(DTCO, DGU, U, WM, &
- HPROGRAM,HWRITE)
+ CALL WRITE_DIAG_WATFLUX_n(DTCO, DUO, U, WM, HPROGRAM,HWRITE)
END IF
IF (U%CWATER=='FLAKE ') THEN
- CALL WRITE_DIAG_FLAKE_n(DTCO, DGU, U, FM, &
- HPROGRAM,HWRITE)
+ CALL WRITE_DIAG_FLAKE_n(DTCO, DUO, U, FM, HPROGRAM,HWRITE)
END IF
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_INLAND_WATER_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/write_diag_isban.F90 b/src/SURFEX/write_diag_isban.F90
index b47a606c6555b34dc85625a501215299d23d747d..e389c8e79b7c4519069355e669683b71b7ef19ee 100644
--- a/src/SURFEX/write_diag_isban.F90
+++ b/src/SURFEX/write_diag_isban.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE WRITE_DIAG_ISBA_n (DTCO, DGU, U, IM, DST, &
- HPROGRAM,HWRITE)
+SUBROUTINE WRITE_DIAG_ISBA_n (DTCO, DUO, U, IM, NDST, HPROGRAM, HWRITE)
! ###############################################################################
!
!!**** *WRITE_DIAG_ISBA_n * - Stores ISBA diagnostics
@@ -28,17 +27,16 @@ SUBROUTINE WRITE_DIAG_ISBA_n (DTCO, DGU, U, IM, DST, &
!! Original 01/2004
!!------------------------------------------------------------------
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t
-USE MODD_DST_n, ONLY : DST_t
+USE MODD_DST_n, ONLY : DST_NP_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
-!
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -53,10 +51,10 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DUO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
-TYPE(DST_t), INTENT(INOUT) :: DST
+TYPE(DST_NP_t), INTENT(INOUT) :: NDST
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=3), INTENT(IN) :: HWRITE ! 'PGD' : only physiographic fields are written
@@ -69,20 +67,21 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_ISBA_N',0,ZHOOK_HANDLE)
IF (HWRITE/='PGD') THEN
- IF (IM%DGI%XDIAG_TSTEP==XUNDEF .OR. &
- ABS(NINT(IM%I%TTIME%TIME/IM%DGI%XDIAG_TSTEP)*IM%DGI%XDIAG_TSTEP-IM%I%TTIME%TIME)<1.E-3 ) THEN
- CALL WRITE_DIAG_SEB_ISBA_n(DTCO, DGU, U, IM%CHI, IM%DGEI, IM%DGI, DST, IM%GB, IM%I, &
- HPROGRAM)
- CALL WRITE_DIAG_MISC_ISBA_n(DTCO, DGU, U, IM%DGI, IM%DGMI, IM%I, &
- HPROGRAM)
+ IF (IM%ID%O%XDIAG_TSTEP==XUNDEF .OR. &
+ ABS(NINT(IM%S%TTIME%TIME/IM%ID%O%XDIAG_TSTEP)*IM%ID%O%XDIAG_TSTEP-IM%S%TTIME%TIME)<1.E-3 ) THEN
+ CALL WRITE_DIAG_SEB_ISBA_n(DTCO, DUO, U, IM%NCHI, IM%CHI, IM%ID, NDST, IM%GB, &
+ IM%O, IM%S, IM%NP, IM%NPE, HPROGRAM)
+ CALL WRITE_DIAG_MISC_ISBA_n(DTCO, DUO%CSELECT, DUO%LSNOWDIMNC, U, IM%ID%O%LPATCH_BUDGET, &
+ IM%ID%D, IM%ID%ND, IM%ID%DM, IM%ID%NDM, IM%O, IM%S, IM%K, &
+ IM%NP, IM%NPE%AL(1)%TSNOW, HPROGRAM)
END IF
END IF
!
-IF (IM%DGI%LPGD) THEN
- IF (IM%DGI%XDIAG_TSTEP==XUNDEF .OR. &
- ABS(NINT(IM%I%TTIME%TIME/IM%DGI%XDIAG_TSTEP)*IM%DGI%XDIAG_TSTEP-IM%I%TTIME%TIME)<1.E-3 ) THEN
- CALL WRITE_DIAG_PGD_ISBA_n(DTCO, DGU, U, IM%CHI, IM%DGMI, IM%I, &
- HPROGRAM)
+IF (IM%ID%O%LPGD) THEN
+ IF (IM%ID%O%XDIAG_TSTEP==XUNDEF .OR. &
+ ABS(NINT(IM%S%TTIME%TIME/IM%ID%O%XDIAG_TSTEP)*IM%ID%O%XDIAG_TSTEP-IM%S%TTIME%TIME)<1.E-3 ) THEN
+ CALL WRITE_DIAG_PGD_ISBA_n(DTCO, DUO%CSELECT, U, IM%CHI, IM%NCHI, IM%ID%DM%LSURF_DIAG_ALBEDO, &
+ IM%O, IM%S, IM%K, IM%NP, IM%NPE, IM%ISS, HPROGRAM)
END IF
END IF
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_ISBA_N',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/write_diag_misc_flaken.F90 b/src/SURFEX/write_diag_misc_flaken.F90
index af04ee79e84b02381fe4c8040a06e6eac3a154c0..06027d3c6979db630de5f78f9a8b9c5cce5e0c5a 100644
--- a/src/SURFEX/write_diag_misc_flaken.F90
+++ b/src/SURFEX/write_diag_misc_flaken.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_DIAG_MISC_FLAKE_n ( DTCO, DGU, U, DGMF, &
- HPROGRAM)
+ SUBROUTINE WRITE_DIAG_MISC_FLAKE_n ( DTCO, HSELECT, U, DMF, HPROGRAM)
! #################################
!
!!**** *WRITE_DIAG_MISC_FLAKE* - writes the FLAKE miscellaneous diagnostic fields
@@ -34,7 +33,6 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_DIAG_MISC_FLAKE_n, ONLY : DIAG_MISC_FLAKE_t
!
@@ -52,9 +50,9 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(DIAG_MISC_FLAKE_t), INTENT(INOUT) :: DGMF
+TYPE(DIAG_MISC_FLAKE_t), INTENT(INOUT) :: DMF
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
!
@@ -73,20 +71,18 @@ IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_MISC_FLAKE_N',0,ZHOOK_HANDLE)
!
! Initialisation for IO
!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'WATER ','FLAKE ','WRITE')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'WATER ','FLAKE ','WRITE','FLAKE_DIAGNOSTICS.OUT.nc')
!
!-------------------------------------------------------------------------------
!
!* Flake temperature profile
!
-IF (DGMF%LWATER_PROFILE) THEN
- DO IZ=1,SIZE(DGMF%XZW_PROFILE)
- WRITE(YRECFM,'(F5.1)') DGMF%XZW_PROFILE(IZ)
+IF (DMF%LWATER_PROFILE) THEN
+ DO IZ=1,SIZE(DMF%XZW_PROFILE)
+ WRITE(YRECFM,'(F5.1)') DMF%XZW_PROFILE(IZ)
YRECFM='TW_'//TRIM(ADJUSTL(YRECFM))
YCOMMENT='X_Y_'//YRECFM//' (K)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMF%XTW_PROFILE(IZ,:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DMF%XTW_PROFILE(IZ,:),IRESP,HCOMMENT=YCOMMENT)
END DO
END IF
!
@@ -94,7 +90,7 @@ END IF
!
! End of IO
!
- CALL END_IO_SURF_n(HPROGRAM)
+CALL END_IO_SURF_n(HPROGRAM)
!
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_MISC_FLAKE_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/write_diag_misc_isban.F90 b/src/SURFEX/write_diag_misc_isban.F90
index 4e12dd80c0dab8aecbce327fc7a1bef98629d999..2b202e24c81ed802e7cdc3cb467362f23c1d33d1 100644
--- a/src/SURFEX/write_diag_misc_isban.F90
+++ b/src/SURFEX/write_diag_misc_isban.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_DIAG_MISC_ISBA_n (DTCO, DGU, U, DGI, DGMI, I, &
- HPROGRAM)
+ SUBROUTINE WRITE_DIAG_MISC_ISBA_n (DTCO, HSELECT, OSNOWDIMNC, U, OPATCH_BUDGET, D, &
+ ND, DM, NDM, IO, S, K, NP, TPSNOW, HPROGRAM)
! #################################
!
!!**** *WRITE_DIAG_MISC_ISBA* - writes the ISBA diagnostic fields
@@ -45,30 +45,33 @@
!! XTSRAD_NAT instead of XAVG_TSRAD
!! delete NWG_SIZE
!! water table depth
-!! M.Moge 01/2016 using WRITE_SURF_FIELD2D/3D for 2D/3D surfex fields writes
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TYPE_SNOW
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
-USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_NP_t
+USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t, DIAG_MISC_ISBA_NP_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_NP_t
+!
+USE MODD_XIOS, ONLY : LALLOW_ADD_DIM
!
USE MODD_SURF_PAR, ONLY : NUNDEF, XUNDEF
!
-USE MODD_ASSIM, ONLY : LASSIM, CASSIM_ISBA, NVAR
+USE MODD_ASSIM, ONLY : LASSIM, CASSIM_ISBA, NVAR, CVAR, NOBSTYPE, NBOUTPUT, COBS
!
USE MODD_AGRI, ONLY : LAGRIP
!
USE MODI_INIT_IO_SURF_n
USE MODI_WRITE_SURF
-USE MODI_WRITE_SURF_FIELD2D
+USE MODI_WRITE_FIELD_2D_PATCH
+USE MODI_WRITE_FIELD_1D_PATCH
USE MODI_END_IO_SURF_n
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -81,11 +84,19 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
+LOGICAL, INTENT(IN) :: OSNOWDIMNC
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(DIAG_ISBA_t), INTENT(INOUT) :: DGI
-TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DGMI
-TYPE(ISBA_t), INTENT(INOUT) :: I
+LOGICAL, INTENT(IN) :: OPATCH_BUDGET
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_NP_t), INTENT(INOUT) :: ND
+TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DM
+TYPE(DIAG_MISC_ISBA_NP_t), INTENT(INOUT) :: NDM
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(SURF_SNOW), INTENT(IN) :: TPSNOW
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
!
@@ -93,14 +104,14 @@ TYPE(ISBA_t), INTENT(INOUT) :: I
! -------------------------------
!
INTEGER :: IRESP ! IRESP : return-code if a problem appears
- CHARACTER(LEN=1) :: YVAR
+ CHARACTER(LEN=1) :: YVAR, YOBS, YTIM
CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
CHARACTER(LEN=100):: YCOMMENT ! Comment string
- CHARACTER(LEN=100):: YCOMMENTUNIT ! Comment string : unit of the datas in the field to write
CHARACTER(LEN=2) :: YLVL
CHARACTER(LEN=20) :: YFORM
!
-INTEGER :: JLAYER, JJ, IDEPTH, JVAR
+REAL, DIMENSION(SIZE(DM%XSWI,1)) :: ZMAX
+INTEGER :: JL, JJ, JVAR, JOBS, JP, JI, JT, JK, ISIZE
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -109,12 +120,16 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! Initialisation for IO
!
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_MISC_ISBA_N',0,ZHOOK_HANDLE)
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'NATURE','ISBA ','WRITE')
+!
+IF ( DM%LPROSNOW ) THEN
+ CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'NATURE','ISBA ','WRITE','ISBA_PROGNOSTIC.OUT.nc')
+ELSE
+ CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'NATURE','ISBA ','WRITE','ISBA_DIAGNOSTICS.OUT.nc')
+ENDIF
!
!-------------------------------------------------------------------------------
!
-IF (DGMI%LSURF_MISC_BUDGET) THEN
+IF (DM%LSURF_MISC_BUDGET) THEN
!
!* 2. Miscellaneous fields :
!
@@ -125,161 +140,149 @@ IF (DGMI%LSURF_MISC_BUDGET) THEN
!
YRECFM='HV_ISBA'
YCOMMENT='Halstead coefficient averaged over tile nature (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XAVG_HV(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XHV(:),IRESP,HCOMMENT=YCOMMENT)
!
! 2.2 Snow fractions
! --------------
!
YRECFM='PSNG_ISBA'
YCOMMENT='snow fraction over ground averaged over tile nature (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XAVG_PSNG(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XPSNG(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='PSNV_ISBA'
YCOMMENT='snow fraction over vegetation averaged over tile nature (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XAVG_PSNV(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XPSNV(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='PSN_ISBA'
YCOMMENT='total snow fraction averaged over tile nature (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XAVG_PSN(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XPSN(:),IRESP,HCOMMENT=YCOMMENT)
!
! 2.3 Total Albedo and surface temperature
! ------------------------------------
!
- YRECFM='TALB_ISBA'
- YCOMMENT='total albedo over tile nature (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XAVG_ALBT(:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF (I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO') THEN
+ IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
!
YRECFM='TS_ISBA'
YCOMMENT='total surface temperature (isba+snow) over tile nature'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_TS(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,D%XTS(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='TSRAD_ISBA'
YCOMMENT='total radiative surface temperature (isba+snow) over tile nature'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,I%XTSRAD_NAT(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,S%XTSRAD_NAT(:),IRESP,HCOMMENT=YCOMMENT)
!
END IF
!
! 2.4 Soil Wetness Index, Water content and active layer depth
! --------------------------------------------------------
!
- IF(I%CISBA=='DIF')THEN
- DO JLAYER = 1,I%NGROUND_LAYER
- DO JJ=1,SIZE(I%NWG_LAYER,1)
- IDEPTH=MAXVAL(I%NWG_LAYER(JJ,:),I%NWG_LAYER(JJ,:)/=NUNDEF)
- IF(JLAYER>IDEPTH)THEN
- DGMI%XAVG_SWI (JJ,JLAYER) = XUNDEF
- DGMI%XAVG_TSWI(JJ,JLAYER) = XUNDEF
+ IF(IO%CISBA=='DIF')THEN
+ ZMAX(:) = 0.
+ !
+ DO JP = 1,IO%NPATCH
+ DO JI = 1,NP%AL(JP)%NSIZE_P
+ JJ = NP%AL(JP)%NR_P(JI)
+ !
+ IF (NP%AL(JP)%NWG_LAYER(JI)/=NUNDEF.AND.NP%AL(JP)%NWG_LAYER(JI)>ZMAX(JJ)) THEN
+ ZMAX(JJ) = NP%AL(JP)%NWG_LAYER(JI)
+ ENDIF
+ ENDDO
+ ENDDO
+ !
+ DO JJ=1,SIZE(DM%XSWI,1)
+
+ DO JL = 1,IO%NGROUND_LAYER
+ IF(JL>ZMAX(JJ))THEN
+ DM%XSWI (JJ,JL) = XUNDEF
+ DM%XTSWI(JJ,JL) = XUNDEF
ENDIF
ENDDO
+
ENDDO
ENDIF
!
- DO JLAYER=1,I%NGROUND_LAYER
+ DO JL=1,IO%NGROUND_LAYER
!
- WRITE(YLVL,'(I2)') JLAYER
+ WRITE(YLVL,'(I2)') JL
!
YRECFM='SWI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
YFORM='(A29,I1.1,A4)'
- IF (JLAYER >= 10) YFORM='(A29,I2.2,A4)'
- WRITE(YCOMMENT,FMT=YFORM) 'soil wetness index for layer ',JLAYER,' (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XAVG_SWI(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ IF (JL >= 10) YFORM='(A29,I2.2,A4)'
+ WRITE(YCOMMENT,FMT=YFORM) 'soil wetness index for layer ',JL,' (-)'
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XSWI(:,JL),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='TSWI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
YFORM='(A29,I1.1,A4)'
- IF (JLAYER >= 10) YFORM='(A29,I2.2,A4)'
- WRITE(YCOMMENT,FMT=YFORM) 'total swi (liquid+solid) for layer ',JLAYER,' (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XAVG_TSWI(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ IF (JL >= 10) YFORM='(A29,I2.2,A4)'
+ WRITE(YCOMMENT,FMT=YFORM) 'total swi (liquid+solid) for layer ',JL,' (-)'
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XTSWI(:,JL),IRESP,HCOMMENT=YCOMMENT)
!
END DO
!
YRECFM='SWI_T_ISBA'
YCOMMENT='soil wetness index over the soil column (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XSOIL_SWI(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XSOIL_SWI(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='TSWI_T_ISBA'
YCOMMENT='total soil wetness index over the soil column (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XSOIL_TSWI(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XSOIL_TSWI(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='WGTOT_T_ISBA'
YCOMMENT='total water content (liquid+solid) over the soil column (kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XSOIL_TWG(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XSOIL_TWG(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='WGI_T_ISBA'
YCOMMENT='total ice content (solid) over the soil column (kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XSOIL_TWGI(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XSOIL_TWGI(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='WGTOT_ISBA'
YCOMMENT='total volumetric water content (liquid+solid) over the soil column (m3/m3)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XSOIL_WG(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XSOIL_WG(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='WGI_ISBA'
- YCOMMENT='total volumetric ice content (solid) over the soil column (m3/m3)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XSOIL_WGI(:),IRESP,HCOMMENT=YCOMMENT)
+ IF (.NOT.LALLOW_ADD_DIM) THEN
+ YRECFM='WGI_ISBA'
+ YCOMMENT='total volumetric ice content (solid) over the soil column (m3/m3)'
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XSOIL_WGI(:),IRESP,HCOMMENT=YCOMMENT)
+ ENDIF
!
- IF(I%CISBA=='DIF') THEN
+ IF(IO%CISBA=='DIF') THEN
!
- IF (DGMI%LSURF_MISC_DIF)THEN
+ IF (DM%LSURF_MISC_DIF)THEN
!
YRECFM='TSWI_D2_ISBA'
YCOMMENT='total soil wetness index over comparable FR-DG2 reservoir (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XFRD2_TSWI(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XFRD2_TSWI(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='WG_D2_ISBA'
YCOMMENT='liquid water content over comparable FR-DG2 reservoir (m3/m3)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XFRD2_TWG(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XFRD2_TWG(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='WGI_D2_ISBA'
YCOMMENT='ice content over comparable FR-DG2 reservoir (m3/m3)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XFRD2_TWGI(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XFRD2_TWGI(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='TSWI_D3_ISBA'
YCOMMENT='total soil wetness index over comparable FR-DG3 reservoir (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XFRD3_TSWI(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XFRD3_TSWI(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='WG_D3_ISBA'
YCOMMENT='liquid water content over comparable FR-DG3 reservoir (m3/m3)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XFRD3_TWG(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XFRD3_TWG(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='WGI_D3_ISBA'
YCOMMENT='ice content over comparable FR-DG3 reservoir (m3/m3)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XFRD3_TWGI(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XFRD3_TWGI(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
YRECFM='ALT_ISBA'
YCOMMENT='active layer thickness over permafrost (m)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XAVG_ALT(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XALT(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='FLT_ISBA'
YCOMMENT='frozen layer thickness over non-permafrost (m)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XAVG_FLT(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XFLT(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
@@ -288,279 +291,473 @@ IF (DGMI%LSURF_MISC_BUDGET) THEN
!
YRECFM='WSN_T_ISBA'
YCOMMENT='Total_snow_reservoir (kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XAVG_TWSNOW(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XTWSNOW(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='DSN_T_ISBA'
YCOMMENT='Total_snow_depth (m)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XAVG_TDSNOW(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XTDSNOW(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='TSN_T_ISBA'
YCOMMENT='Total_snow_temperature (K)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XAVG_TTSNOW(:),IRESP,HCOMMENT=YCOMMENT)
- !
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XTTSNOW(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF (TPSNOW%SCHEME=='CRO' .AND. DM%LPROSNOW) THEN
+ !
+ YCOMMENT='accumulated snow thickness for past 1 days'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'SD_1DY_ISBA',DM%XSNDPT_1DY(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YCOMMENT='accumulated snow thickness for past 3 days'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'SD_3DY_ISBA',DM%XSNDPT_3DY(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YCOMMENT='accumulated snow thickness for past 5 days'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'SD_5DY_ISBA',DM%XSNDPT_5DY(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YCOMMENT='accumulated snow thickness for past 7 days'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'SD_7DY_ISBA',DM%XSNDPT_7DY(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YCOMMENT='accumulated snow water equivalent for past 1 days'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'SWE_1DY_ISBA',DM%XSNSWE_1DY(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YCOMMENT='accumulated snow water equivalent for past 3 days'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'SWE_3DY_ISBA',DM%XSNSWE_3DY(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YCOMMENT='accumulated snow water equivalent for past 5 days'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'SWE_5DY_ISBA',DM%XSNSWE_5DY(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YCOMMENT='accumulated snow water equivalent for past 7 days'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'SWE_7DY_ISBA',DM%XSNSWE_7DY(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YCOMMENT='Penetration of ram resistance sensor (2 daN)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'RAMSOND_ISBA',DM%XSNRAM_SONDE(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YCOMMENT='Thickness of wet snow at the top of the snowpack'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'WET_TH_ISBA',DM%XSN_WETTHCKN(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YCOMMENT='Thickness of refrozen snow at the top of the snowpack'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'REFRZTH_ISBA',DM%XSN_REFRZNTHCKN(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDIF
+ !
! 2.6 SGH scheme
! ----------
!
- IF(I%CRUNOFF=='SGH '.OR.I%CRUNOFF=='DT92')THEN
+ IF(IO%CRUNOFF=='SGH '.OR.IO%CRUNOFF=='DT92')THEN
YRECFM='FSAT_ISBA'
YCOMMENT='Soil saturated fraction (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XAVG_FSAT(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XFSAT(:),IRESP,HCOMMENT=YCOMMENT)
ENDIF
!
- IF(I%CRAIN=='SGH ')THEN
+ IF(IO%CRAIN=='SGH ')THEN
YRECFM='MUF_ISBA'
YCOMMENT='fraction of the grid cell reached by the rainfall (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,I%XMUF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,K%XMUF(:),IRESP,HCOMMENT=YCOMMENT)
ENDIF
!
! 2.7 Flooding scheme
! ---------------
!
- IF(I%LFLOOD)THEN
+ IF(IO%LFLOOD)THEN
!
YRECFM='FFG_ISBA'
YCOMMENT='flood fraction over ground averaged over tile nature (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XAVG_FFG(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XFFG(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='FFV_ISBA'
YCOMMENT='flood fraction over vegetation averaged over tile nature (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XAVG_FFV(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XFFV(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='FF_ISBA'
YCOMMENT='total flood fraction averaged over tile nature (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XAVG_FF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XFF(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='FFLOOD_ISBA'
- YCOMMENT='Grdi-cell potential flood fraction (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,I%XFFLOOD(:),IRESP,HCOMMENT=YCOMMENT)
+ YCOMMENT='Grid-cell potential flood fraction (-)'
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,K%XFFLOOD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='PIFLOOD_ISBA'
- YCOMMENT='Grdi-cell Potential_floodplain_infiltration (kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,I%XPIFLOOD(:),IRESP,HCOMMENT=YCOMMENT)
+ YCOMMENT='Grid-cell Potential_floodplain_infiltration (kg/m2/s)'
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,K%XPIFLOOD(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
! 2.8 Total LAI
! ---------
!
- IF(I%CPHOTO/='NON'.OR.I%NPATCH>1)THEN
+ IF(IO%CPHOTO/='NON'.OR.IO%NPATCH>1)THEN
YRECFM='LAI_ISBA'
YCOMMENT='leaf area index (m2/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XAVG_LAI(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DM%XLAI(:),IRESP,HCOMMENT=YCOMMENT)
ENDIF
!
! 2.9 Water table depth
! -----------------
!
- IF(I%LWTD)THEN
+ IF(IO%LWTD)THEN
!
YRECFM='FWTD_ISBA'
YCOMMENT='grid-cell fraction of water table to rise'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,I%XFWTD(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,K%XFWTD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='WTD_ISBA'
YCOMMENT='water table depth from RRM model or observation (m)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,I%XWTD(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,K%XWTD(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!* 3. Miscellaneous fields for each patch :
! -------------------------------------
!
+ ISIZE = U%NSIZE_NATURE
+ !
!----------------------------------------------------------------------------
!User wants (or not) patch output
- IF(DGI%LPATCH_BUDGET)THEN
+ IF(OPATCH_BUDGET .AND. IO%NPATCH>1)THEN
!----------------------------------------------------------------------------
!
! 3.1 Soil Wetness Index and active layer depth
! -----------------------------------------
!
- DO JLAYER=1,I%NGROUND_LAYER
+ DO JL=1,IO%NGROUND_LAYER
!
- WRITE(YLVL,'(I2)') JLAYER
+ WRITE(YLVL,'(I2.0)') JL
!
- YRECFM='SWI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YFORM='(A39,I1.1)'
- IF (JLAYER >= 10) YFORM='(A39,I2.2)'
- WRITE(YCOMMENT,FMT=YFORM) 'soil wetness index per patch for layer ',JLAYER
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XSWI(:,JLAYER,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YRECFM='SWI'//TRIM(ADJUSTL(YLVL(:)))//'_'
+ YFORM='(A39,I1.1,A4)'
+ IF (JL >= 10) YFORM='(A39,I2.2,A4)'
+ WRITE(YCOMMENT,FMT=YFORM) 'soil wetness index per patch for layer ',JL,' (-)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSWI(:,JL),ISIZE,S%XWORK_WR)
+ ENDDO
!
- YRECFM='TSWI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YFORM='(A39,I1.1)'
- IF (JLAYER >= 10) YFORM='(A39,I2.2)'
- WRITE(YCOMMENT,FMT=YFORM) 'total swi (liquid+solid) per patch for layer ',JLAYER
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XTSWI(:,JLAYER,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YRECFM='TSWI'//TRIM(ADJUSTL(YLVL(:)))//'_'
+ YFORM='(A39,I1.1,A4)'
+ IF (JL >= 10) YFORM='(A39,I2.2,A4)'
+ WRITE(YCOMMENT,FMT=YFORM) 'total swi (liquid+solid) per patch for layer ',JL,' (-)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XTSWI(:,JL),ISIZE,S%XWORK_WR)
+ ENDDO
!
END DO
!
- IF(I%CISBA=='DIF')THEN
+ IF(IO%CISBA=='DIF')THEN
!
- YRECFM='ALT_P'
- YCOMMENT='active layer thickness over permafrost per patch '
- YCOMMENTUNIT='m'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XALT(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+
+ YRECFM='ALT_'
+ YCOMMENT='active layer thickness over permafrost per patch (m)'
+ WRITE(YCOMMENT,FMT=YFORM) 'total swi (liquid+solid) per patch for layer ',JL,' (-)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XALT(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
- YRECFM='FLT_P'
- YCOMMENT='frozen layer thickness over non-permafrost per patch'
- YCOMMENTUNIT='m'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XFLT(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YRECFM='FLT_'
+ YCOMMENT='frozen layer thickness over non-permafrost per patch (m)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XFLT(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
ENDIF
!
! 3.2 Snow fractions
! --------------
- !
- YRECFM='PSNG_P'
+ !
+ YRECFM='PSNG_'
YCOMMENT='snow fraction per patch over ground '
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XDPSNG(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='PSNV_P'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XPSNG(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='PSNV_'
YCOMMENT='snow fraction per patch over vegetation'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XDPSNV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XPSNV(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
- YRECFM='PSN_P'
+ YRECFM='PSN_'
YCOMMENT='total snow fraction per patch'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XDPSN(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XPSN(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
! 3.3 SGH scheme
! ----------
!
- IF(I%CRUNOFF=='DT92')THEN
- YRECFM='FSAT_P'
- YCOMMENT='Soil saturated fraction per patch '
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XDFSAT(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ IF(IO%CRUNOFF=='SGH '.OR.IO%CRUNOFF=='DT92')THEN
+ YRECFM='FSAT_'
+ YCOMMENT='Soil saturated fraction per patch (-)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XFSAT(:),ISIZE,S%XWORK_WR)
+ ENDDO
ENDIF
!
! 3.3 Flood fractions
! --------------
!
- IF(I%LFLOOD)THEN
+ IF(IO%LFLOOD)THEN
!
- YRECFM='FFG_P'
+ YRECFM='FFG_'
YCOMMENT='flood fraction per patch over ground '
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XDFFG(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XFFG(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
- YRECFM='FFV_P'
+ YRECFM='FFV_'
YCOMMENT='flood fraction per patch over vegetation'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XDFFV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XFFV(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
- YRECFM='FF_P'
+ YRECFM='FF_'
YCOMMENT='total flood fraction per patch'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XDFF(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XFF(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
ENDIF
!
! 3.4 Total Albedo
! ------------
!
- YRECFM='TALB'
- YCOMMENT='total albedo per patch'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMI%XALBT(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF (I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO') THEN
- YRECFM='TS_P'
+ IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
+ !
+ YRECFM='TS_'
YCOMMENT='total surface temperature (isba+snow) per patch'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XTS(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- YRECFM='TSRAD_P'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ND%AL(JP)%XTS(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='TSRAD_'
YCOMMENT='total radiative surface temperature (isba+snow) per patch'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XTSRAD(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ND%AL(JP)%XTSRAD(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
ENDIF
!
! 3.5 Halstead coefficient
! --------------------
!
- YRECFM='HV'
+ YRECFM='HV_'
YCOMMENT='Halstead coefficient per patch'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XHV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XHV(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
! 3.6 Snow outputs
! -----------------
!
- YRECFM='WSN_T_P'
- YCOMMENT='X_Y_WSNOW_TOT per patch'
- YCOMMENTUNIT='kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XTWSNOW(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='DSN_T_P'
- YCOMMENT='X_Y_DSNOW_TOT per patch'
- YCOMMENTUNIT='m'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XTDSNOW(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YRECFM='WSN_T_'
+ YCOMMENT='X_Y_WSNOW_TOT (kg/m2) per patch'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XTWSNOW(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='DSN_T_'
+ YCOMMENT='X_Y_DSNOW_TOT (m) per patch'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XTDSNOW(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='TSN_T_'
+ YCOMMENT='X_Y_TSNOW_TOT (k) per patch'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XTTSNOW(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ IF (TPSNOW%SCHEME=='CRO' .AND. DM%LPROSNOW) THEN
+ !
+ YCOMMENT='accumulated snow thickness for past 1 days per patch'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,'SD_1DY_',YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSNDPT_1DY(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YCOMMENT= 'accumulated snow thickness for past 3 days per patch'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,'SD_3DY_',YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSNDPT_3DY(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YCOMMENT= 'accumulated snow thickness for past 5 days per patch'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,'SD_5DY_',YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSNDPT_5DY(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YCOMMENT='accumulated snow thickness for past 7 days per patch'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,'SD_7DY_',YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSNDPT_7DY(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YCOMMENT='accumulated snow water equivalent for past 1 days per patch'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,'SWE_1DY_',YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSNSWE_1DY(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YCOMMENT='accumulated snow water equivalent for past 3 days per patch'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,'SWE_3DY_',YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSNSWE_3DY(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YCOMMENT='accumulated snow water equivalent for past 5 days per patch'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,'SWE_5DY_',YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSNSWE_5DY(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YCOMMENT='accumulated snow water equivalent for past 7 days per patch'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,'SWE_7DY_',YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSNSWE_7DY(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YCOMMENT='Penetration of ram resistance sensor (2 daN) per patch'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,'RAMSOND_',YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSNRAM_SONDE(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YCOMMENT='Thickness of wet snow at the top of the snowpack per patch'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,'WET_TH_',YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSN_WETTHCKN(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YCOMMENT='Thickness of refrozen snow at the top of the snowpack per patch'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,'REFRZTH_',YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSN_REFRZNTHCKN(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ ENDIF
!
- YRECFM='TSN_T_P'
- YCOMMENT='X_Y_TSNOW_TOT per patch'
- YCOMMENTUNIT='k'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XTTSNOW(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ ENDIF
+ !
+ IF((OPATCH_BUDGET.AND. IO%NPATCH>1).OR.IO%NPATCH==1)THEN
!
- IF (I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO') THEN
+ IF ( OSNOWDIMNC ) THEN
+ !
+ IF ( DM%LVOLUMETRIC_SNOWLIQ ) THEN
+ YCOMMENT='snow liquid water (kg m-3)'
+ ELSE
+ YCOMMENT='snow liquid water (m)'
+ ENDIF
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_2D_PATCH(HSELECT,HPROGRAM,'SNOWLIQ',YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSNOWLIQ(:,:),ISIZE,'snow_layer',S%XWSN_WR)
+ ENDDO
!
- DO JLAYER=1,I%TSNOW%NLAYER
+ YCOMMENT='snow temperature (K)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_2D_PATCH(HSELECT,HPROGRAM,'SNOWTEMP',YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSNOWTEMP(:,:),ISIZE,'snow_layer',S%XWSN_WR)
+ ENDDO
+ !
+ YCOMMENT= 'snow layer thickness'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_2D_PATCH(HSELECT,HPROGRAM,'SNOWDZ',YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSNOWDZ(:,:),ISIZE,'snow_layer',S%XWSN_WR)
+ ENDDO
+ !
+ IF (TPSNOW%SCHEME=='CRO' .AND. DM%LPROSNOW) THEN
+ !
+ YCOMMENT= 'snow layer dendricity'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_2D_PATCH(HSELECT,HPROGRAM,'SNOWDEND',YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSNOWDEND(:,:),ISIZE,'snow_layer',S%XWSN_WR)
+ ENDDO
+ !
+ YCOMMENT='snow layer sphericity'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_2D_PATCH(HSELECT,HPROGRAM,'SNOWSPHER',YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSNOWSPHER(:,:),ISIZE,'snow_layer',S%XWSN_WR)
+ ENDDO
+ !
+ YCOMMENT='snow layer grain size'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_2D_PATCH(HSELECT,HPROGRAM,'SNOWSIZE',YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSNOWSIZE(:,:),ISIZE,'snow_layer',S%XWSN_WR)
+ ENDDO
+ !
+ YCOMMENT='snow layer specific surface area'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_2D_PATCH(HSELECT,HPROGRAM,'SNOWSSA',YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSNOWSSA(:,:),ISIZE,'snow_layer',S%XWSN_WR)
+ ENDDO
+ !
+ YCOMMENT='snow layer grain type'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_2D_PATCH(HSELECT,HPROGRAM,'SNOWTYPE',YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSNOWTYPEMEPRA(:,:),ISIZE,'snow_layer',S%XWSN_WR)
+ ENDDO
+ !
+ YCOMMENT='snow layer ram resistance'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_2D_PATCH(HSELECT,HPROGRAM,'SNOWRAM',YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSNOWRAM(:,:),ISIZE,'snow_layer',S%XWSN_WR)
+ ENDDO
!
- WRITE(YLVL,'(I2)') JLAYER
+ YCOMMENT='snow layer shear resistance'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_2D_PATCH(HSELECT,HPROGRAM,'SNOWSHEAR',YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSNOWSHEAR(:,:),ISIZE,'snow_layer',S%XWSN_WR)
+ ENDDO
+ !
+ ENDIF
+ !
+ ELSE
+ !
+ DO JL=1,TPSNOW%NLAYER
+ !
+ WRITE(YLVL,'(I2)') JL
!
YRECFM='SNOWLIQ'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YFORM='(A17,I1.1)'
- IF (JLAYER >= 10) YFORM='(A17,I2.2)'
- WRITE(YCOMMENT,FMT=YFORM) 'snow liquid water',JLAYER
- YCOMMENTUNIT='m'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XSNOWLIQ(:,JLAYER,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YFORM='(A18,I1.1,A9)'
+ IF (JL >= 10) YFORM='(A18,I2.2,A9)'
+ IF ( DM%LVOLUMETRIC_SNOWLIQ ) THEN
+ WRITE(YCOMMENT,YFORM) 'snow liquid water ',JL,' (kg m-3)'
+ ELSE
+ WRITE(YCOMMENT,YFORM) 'snow liquid water ',JL,' (m) '
+ ENDIF
+ WRITE(YCOMMENT,FMT=YFORM) 'snow liquid water',JL,' (m)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSNOWLIQ(:,JL),ISIZE,S%XWORK_WR)
+ ENDDO
!
YRECFM='SNOWTEMP'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YFORM='(A16,I1.1)'
- IF (JLAYER >= 10) YFORM='(A16,I2.2)'
- WRITE(YCOMMENT,FMT=YFORM) 'snow temperature',JLAYER
- YCOMMENTUNIT='K'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XSNOWTEMP(:,JLAYER,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YFORM='(A16,I1.1,A4)'
+ IF (JL >= 10) YFORM='(A16,I2.2,A4)'
+ WRITE(YCOMMENT,FMT=YFORM) 'snow temperature',JL,' (K)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSNOWTEMP(:,JL),ISIZE,S%XWORK_WR)
+ ENDDO
!
END DO
- !
+ !
ENDIF
!
- END IF
+ ENDIF
!
IF (LAGRIP) THEN
!
@@ -569,74 +766,130 @@ IF (DGMI%LSURF_MISC_BUDGET) THEN
!
YRECFM='IRRISEUIL'
YCOMMENT='irrigation threshold per patch'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XSEUIL(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XSEUIL(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
ENDIF
!
- IF (I%LTR_ML) THEN
+ IF (IO%LTR_ML) THEN
!
YRECFM='FAPAR'
- YCOMMENT='FAPAR'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XFAPAR(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YCOMMENT='FAPAR (-)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XFAPAR(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
YRECFM='FAPIR'
- YCOMMENT='FAPIR'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XFAPIR(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YCOMMENT='FAPIR (-)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XFAPIR(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
YRECFM='FAPAR_BS'
- YCOMMENT='FAPAR_BS'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XFAPAR_BS(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YCOMMENT='FAPAR_BS (-)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XFAPAR_BS(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
YRECFM='FAPIR_BS'
- YCOMMENT='FAPIR_BS'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XFAPIR_BS(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YCOMMENT='FAPIR_BS (-)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XFAPIR_BS(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
YRECFM='DFAPARC'
- YCOMMENT='DFAPARC '
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XDFAPARC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YCOMMENT='DFAPARC (-)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XDFAPARC(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
YRECFM='DFAPIRC'
- YCOMMENT='DFAPIRC'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XDFAPIRC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YCOMMENT='DFAPIRC (-)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XDFAPIRC(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
YRECFM='DLAI_EFFC'
- YCOMMENT='DLAI_EFFC'
- YCOMMENTUNIT='m2/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGMI%XDLAI_EFFC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YCOMMENT='DLAI_EFFC (m2/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDM%AL(JP)%XDLAI_EFFC(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
ENDIF
!
IF (LASSIM .AND. CASSIM_ISBA=="EKF ") THEN
+ !
+ CALL END_IO_SURF_n(HPROGRAM)
+ CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'NATURE','ISBA ','WRITE','ISBA_ANALYSIS.OUT.nc')
!
DO JVAR = 1,NVAR
WRITE(YVAR,FMT='(I1.1)') JVAR
- YRECFM="ANAL_INCR"//YVAR
- YCOMMENT="by patch"
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,I%XINCR(:,I%NPATCH*(JVAR-1)+1:I%NPATCH*JVAR),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM="ANA_INCR"//YVAR
+ !YCOMMENT="by patch"
+ YCOMMENT="Analysis increment for control variable "//TRIM(CVAR(JVAR))
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT, HPROGRAM, YRECFM, YCOMMENT, JP,&
+ NP%AL(JP)%NR_P,NP%AL(JP)%XINCR(1:NP%AL(JP)%NSIZE_P,JVAR),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ WRITE(YVAR,FMT='(I1.1)') JVAR
+ DO JT = 1,NBOUTPUT
+ WRITE(YTIM,FMT='(I1.1)') JT
+ DO JOBS = 1,NOBSTYPE
+ WRITE(YOBS,FMT='(I1.1)') JOBS
+ YRECFM="HO"//YOBS//"_"//YVAR//"_"//YTIM
+ !YCOMMENT="by patch"
+ YCOMMENT="Jacobian matrix for observation "//TRIM(COBS(JOBS))//" and control variable "//TRIM(CVAR(JVAR))
+ JK = (JT-1)*NOBSTYPE + JOBS
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT, HPROGRAM, YRECFM, YCOMMENT, JP,&
+ NP%AL(JP)%NR_P,NP%AL(JP)%XHO(1:NP%AL(JP)%NSIZE_P,JK,JVAR),ISIZE,S%XWORK_WR)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ DO JT = 1,NBOUTPUT
+ WRITE(YTIM,FMT='(I1.1)') JT
+ DO JOBS = 1,NOBSTYPE
+ WRITE(YOBS,FMT='(I1.1)') JOBS
+ YRECFM="INNOV"//YOBS//"_"//YTIM
+ !YCOMMENT="not by patch"
+ YCOMMENT="Innovation for observation "//TRIM(COBS(JOBS))
+ JK = (JT-1)*NOBSTYPE + JOBS
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,S%XINNOV(:,JK),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+ ENDDO
+ !
+ DO JT = 1,NBOUTPUT
+ WRITE(YTIM,FMT='(I1.1)') JT
+ DO JOBS = 1,NOBSTYPE
+ WRITE(YOBS,FMT='(I1.1)') JOBS
+ YRECFM="RESID"//YOBS//"_"//YTIM
+ !YCOMMENT="not by patch"
+ YCOMMENT="Residuals for observation "//TRIM(COBS(JOBS))
+ JK = (JT-1)*NOBSTYPE + JOBS
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,S%XRESID(:,JK),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
ENDDO
!
ENDIF
!
ENDIF
! End of IO
+!
!
CALL END_IO_SURF_n(HPROGRAM)
+!
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_MISC_ISBA_N',1,ZHOOK_HANDLE)
!
END SUBROUTINE WRITE_DIAG_MISC_ISBA_n
diff --git a/src/SURFEX/write_diag_misc_seaicen.F90 b/src/SURFEX/write_diag_misc_seaicen.F90
new file mode 100644
index 0000000000000000000000000000000000000000..bd3b57911ea3de58af142093c8400231ed1b9a7f
--- /dev/null
+++ b/src/SURFEX/write_diag_misc_seaicen.F90
@@ -0,0 +1,113 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE WRITE_DIAG_MISC_SEAICE_n (DTCO, HSELECT, U, DGMSI, S, HPROGRAM)
+! #################################
+!
+!!**** *WRITE_DIAG_SEB_SEAICE_n* - write the seaice diagnostic fields
+!!
+!! PURPOSE
+!! -------
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! S.Senesi *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2014
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_DIAG_MISC_SEAICE_n, ONLY : DIAG_MISC_SEAICE_t
+USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
+!
+USE MODD_SFX_OASIS, ONLY : LCPL_SEAICE
+!
+!
+!
+!
+USE MODI_INIT_IO_SURF_n
+USE MODI_WRITE_SURF
+USE MODI_END_IO_SURF_n
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(DIAG_MISC_SEAICE_t), INTENT(INOUT) :: DGMSI
+TYPE(SEAFLUX_t), INTENT(INOUT) :: S
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: IRESP ! IRESP : return-code if a problem appears
+CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=100):: YCOMMENT ! Comment string
+CHARACTER(LEN=2) :: YNUM
+INTEGER :: JSV, JSW
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+!
+! Initialisation for IO
+!
+IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_MISC_SEAICE_N',0,ZHOOK_HANDLE)
+!
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'SEA ','SEAFLX','WRITE','SEAFLUX_DIAGNOSTICS.OUT.nc')
+!
+IF(LCPL_SEAICE.OR.S%LHANDLE_SIC)THEN
+!
+ YCOMMENT='Sea-ice temperature (K)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'TSICE',S%XTICE(:),IRESP,YCOMMENT)
+!
+ YCOMMENT='Sea-ice albedo (-)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'IALB',S%XICE_ALB(:),IRESP,YCOMMENT)
+!
+ENDIF
+!
+IF (TRIM(S%CSEAICE_SCHEME) == 'GELATO') THEN
+ YCOMMENT='Sea-ice thickness (m)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'SIT',DGMSI%XSIT(:),IRESP,YCOMMENT)
+ !
+ YCOMMENT='Sea-ice snow depth (m)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'SND',DGMSI%XSND(:),IRESP,YCOMMENT)
+ !
+ YCOMMENT='Sea mixed layer temp for Glt (K)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'SIMLT',DGMSI%XMLT(:),IRESP,YCOMMENT)
+ !
+ENDIF
+! -------------
+! End of IO
+!
+ CALL END_IO_SURF_n(HPROGRAM)
+
+IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_MISC_SEAICE_N',1,ZHOOK_HANDLE)
+!
+!
+END SUBROUTINE WRITE_DIAG_MISC_SEAICE_n
diff --git a/src/SURFEX/write_diag_misc_tebn.F90 b/src/SURFEX/write_diag_misc_tebn.F90
index 3b9c9709f0a527b91f90887c0474cabc9873d500..536b67672c26161122b455ef3c292939b18150b2 100644
--- a/src/SURFEX/write_diag_misc_tebn.F90
+++ b/src/SURFEX/write_diag_misc_tebn.F90
@@ -3,8 +3,9 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_DIAG_MISC_TEB_n (DTCO, DGU, U, DGCT, DGMT, DGMTO, T, TOP, &
- HPROGRAM,KTEB_PATCH)
+ SUBROUTINE WRITE_DIAG_MISC_TEB_n (DTCO, HSELECT, U, DMTC, DMT, DMTO, &
+ GDD, GDDE, GDDEC, GRD, GRDE, GRDEC, &
+ T, TOP, HPROGRAM,KTEB_PATCH)
! #################################
!
!!**** *WRITE_DIAG_MISC_TEB* - writes the TEB diagnostic fields
@@ -34,14 +35,15 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_DIAG_CUMUL_TEB_n, ONLY : DIAG_CUMUL_TEB_t
USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_t
-USE MODD_DIAG_MISC_TEB_OPTION_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
+USE MODD_DIAG_MISC_TEB_OPTIONS_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
USE MODD_TEB_n, ONLY : TEB_t
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
!
+USE MODD_DIAG_n, ONLY : DIAG_t
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+!
USE MODI_INIT_IO_SURF_n
USE MODI_WRITE_SURF
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -58,13 +60,20 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(DIAG_CUMUL_TEB_t), INTENT(INOUT) :: DGCT
-TYPE(DIAG_MISC_TEB_t), INTENT(INOUT) :: DGMT
-TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: DGMTO
+TYPE(DIAG_MISC_TEB_t), INTENT(INOUT) :: DMTC
+TYPE(DIAG_MISC_TEB_t), INTENT(INOUT) :: DMT
+TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: DMTO
TYPE(TEB_t), INTENT(INOUT) :: T
TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+!
+TYPE(DIAG_t), INTENT(INOUT) :: GDD
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: GDDE
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: GDDEC
+TYPE(DIAG_t), INTENT(INOUT) :: GRD
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: GRDE
+TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: GRDEC
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
INTEGER, INTENT(IN) :: KTEB_PATCH ! patch number being written
@@ -84,673 +93,526 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ---------------------
!
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_MISC_TEB_N',0,ZHOOK_HANDLE)
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'TOWN ','TEB ','WRITE')
!
-YPATCH = ' '
-IF (TOP%NTEB_PATCH>1) WRITE(YPATCH,FMT='(A,I1,A)') 'T',KTEB_PATCH,'_'
!-------------------------------------------------------------------------------
!
-IF (DGMTO%LSURF_MISC_BUDGET) THEN
-!
-!* Miscellaneous fields :
-! ----------------------
-!
-YRECFM='D_RD'
-YCOMMENT='Road fraction'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XROAD(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='Z0_TOWN'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='town roughness length'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XZ0_TOWN(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='XQF_BLD'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='domestic heating'//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XQF_BLD(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='XQF_TOWN'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='total anthropogenic heat'//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XQF_TOWN(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='XDQS_TOWN'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='heat storage inside building'//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XDQS_TOWN(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='RUNOFF_TW'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='aggregated runoff for town'//' (kg/m2/s)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XRUNOFF_TOWN(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='RN_RD'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT=' net radiation at road'//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XRN_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='H_RD'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='road sensible heat flux'//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XH_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='LE_RD'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='road latent heat flux'//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XLE_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='GFLUX_RD'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='net road conduction flux'//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XGFLUX_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='RUNOFF_RD'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='road surface runoff'//' (kg/m2/s)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XRUNOFF_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
-!
-IF (TOP%CWALL_OPT=='UNIF') THEN
+IF (DMTO%LSURF_MISC_BUDGET) THEN
!
- YRECFM='RN_WL'
- YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='net radiation for wall '//YRECFM//' (W/m2)'
+ YPATCH = ' '
+ IF (TOP%NTEB_PATCH>1) WRITE(YPATCH,FMT='(A,I1,A)') 'T',KTEB_PATCH,'_'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XRN_WALL_A(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'TOWN ','TEB ','WRITE','TEB_DIAGNOSTICS.OUT.nc')
!
- YRECFM='H_WL'
- YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='wall sensible heat flux'//YRECFM//' (W/m2)'
+ !* Miscellaneous fields :
+ ! ----------------------
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XH_WALL_A(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='D_RD'
+ YCOMMENT='Road fraction'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XROAD(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='GFLUX_WL'
+ YRECFM='Z0_TOWN'
YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='net wall conduction flux'//YRECFM//' (W/m2)'
+ YCOMMENT='town roughness length'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XZ0_TOWN(:),IRESP,HCOMMENT=YCOMMENT)
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XGFLUX_WALL_A(:),IRESP,HCOMMENT=YCOMMENT)
- !
-ELSE
- !
- YRECFM='RN_WLA'
+ YRECFM='XQF_BLD'
YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='net radiation for wall A'//YRECFM//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XRN_WALL_A(:),IRESP,HCOMMENT=YCOMMENT)
+ YCOMMENT='domestic heating'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XQF_BLD(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='H_WLA'
+ YRECFM='XQF_TOWN'
YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='wall A sensible heat flux'//YRECFM//' (W/m2)'
+ YCOMMENT='total anthropogenic heat'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XQF_TOWN(:),IRESP,HCOMMENT=YCOMMENT)
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XH_WALL_A(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='GFLUX_WLA'
+ YRECFM='XDQS_TOWN'
YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='net wall A conduction flux'//YRECFM//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XGFLUX_WALL_A(:),IRESP,HCOMMENT=YCOMMENT)
+ YCOMMENT='heat storage inside building'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XDQS_TOWN(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='RN_WLB'
+ YRECFM='RUNOFF_TW'
YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='net radiation for wall B'//YRECFM//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XRN_WALL_B(:),IRESP,HCOMMENT=YCOMMENT)
+ YCOMMENT='aggregated runoff for town'//' (kg/m2/s)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XRUNOFF_TOWN(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='H_WLB'
+ YRECFM='RN_RD'
YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='wall B sensible heat flux'//YRECFM//' (W/m2)'
+ YCOMMENT=' net radiation at road'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XRN_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XH_WALL_B(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='GFLUX_WLB'
+ YRECFM='H_RD'
YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='net wall B conduction flux'//YRECFM//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XGFLUX_WALL_B(:),IRESP,HCOMMENT=YCOMMENT)
- !
-ENDIF
-!
-YRECFM='RN_RF'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='net radiation for roof'//YRECFM//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XRN_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='H_RF'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='roof sensible heat flux'//YRECFM//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XH_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='LE_RF'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='roof latent heat flux'//YRECFM//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XLE_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='GFLUX_RF'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='net roof conduction flux'//YRECFM//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XGFLUX_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='RUNOFF_RF'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='aggregated roof runoff'//' (kg/m2/s)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XRUNOFF_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
-!
-!
-IF (TOP%LGARDEN) THEN
+ YCOMMENT='road sensible heat flux'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XH_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='RN_GD'
+ YRECFM='LE_RD'
YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='net radiation for GARDEN areas'//YRECFM//' (W/m2)'
+ YCOMMENT='road latent heat flux'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XLE_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XRN_GARDEN(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='H_GD'
+ YRECFM='GFLUX_RD'
YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='GARDEN area sensible heat flux'//YRECFM//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XH_GARDEN(:),IRESP,HCOMMENT=YCOMMENT)
+ YCOMMENT='net road conduction flux'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XGFLUX_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='LE_GD'
+ YRECFM='RUNOFF_RD'
YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='GARDEN area latent heat flux'//YRECFM//' (W/m2)'
+ YCOMMENT='road surface runoff'//' (kg/m2/s)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XRUNOFF_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XLE_GARDEN(:),IRESP,HCOMMENT=YCOMMENT)
+ IF (TOP%CWALL_OPT=='UNIF') THEN
+ !
+ YRECFM='RN_WL'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='net radiation for wall '//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XRN_WALL_A(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='H_WL'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='wall sensible heat flux'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XH_WALL_A(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='GFLUX_WL'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='net wall conduction flux'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XGFLUX_WALL_A(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ELSE
+ !
+ YRECFM='RN_WLA'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='net radiation for wall A'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XRN_WALL_A(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='H_WLA'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='wall A sensible heat flux'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XH_WALL_A(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='GFLUX_WLA'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='net wall A conduction flux'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XGFLUX_WALL_A(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='RN_WLB'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='net radiation for wall B'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XRN_WALL_B(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='H_WLB'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='wall B sensible heat flux'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XH_WALL_B(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='GFLUX_WLB'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='net wall B conduction flux'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XGFLUX_WALL_B(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDIF
!
- YRECFM='GFLUX_GD'
+ YRECFM='RN_RF'
YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='net GARDEN area conduction flux'//YRECFM//' (W/m2)'
+ YCOMMENT='net radiation for roof'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XRN_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XGFLUX_GARDEN(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='H_RF'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='roof sensible heat flux'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XH_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
+ YRECFM='LE_RF'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='roof latent heat flux'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XLE_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='RUNOFF_GD'
+ YRECFM='GFLUX_RF'
YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='garden surface runoff'//' (kg/m2/s)'
+ YCOMMENT='net roof conduction flux'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XGFLUX_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XRUNOFF_GARDEN(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='RUNOFF_RF'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='aggregated roof runoff'//' (kg/m2/s)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XRUNOFF_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
!
-ENDIF
-!
-YRECFM='RN_BLT'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='net radiation for built surfaces'//YRECFM//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XRN_BLT(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='H_BLT'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='built surface sensible heat flux'//YRECFM//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XH_BLT(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='LE_BLT'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='built surface latent heat flux'//YRECFM//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XLE_BLT(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='GFLUX_BLT'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='built surface conduction flux'//YRECFM//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XGFLUX_BLT(:),IRESP,HCOMMENT=YCOMMENT)
-!
-!
-YRECFM='SWA_RF'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='Sdown absorbed by roofs'//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XABS_SW_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='SWA_SN_RF'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='Sdown absorbed by snow on roofs'//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XABS_SW_SNOW_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='LWA_RF'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='Ldown absorbed by roofs'//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XABS_LW_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='LWA_SN_RF'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='Ldown absorbed by snow on roofs'//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XABS_LW_SNOW_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='SWA_RD'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='Sdown absorbed by roads'//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XABS_SW_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='SWA_SN_RD'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='Sdown absorbed by snow on roads'//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XABS_SW_SNOW_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='LWA_RD'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='Ldown absorbed by roads'//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XABS_LW_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='LWA_SN_RD'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='Ldown absorbed by snow on roads'//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XABS_LW_SNOW_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
-!
-IF (TOP%CWALL_OPT=='UNIF') THEN
+ IF (TOP%LGARDEN) THEN
+ !
+ YRECFM='RN_GD'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='net radiation for GARDEN areas'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,GDD%XRN(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='H_GD'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='GARDEN area sensible heat flux'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,GDD%XH(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LE_GD'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='GARDEN area latent heat flux'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,GDD%XLE(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='GFLUX_GD'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='net GARDEN area conduction flux'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,GDD%XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='RUNOFF_GD'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='garden surface runoff'//' (kg/m2/s)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,GDDE%XRUNOFF(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDIF
!
- YRECFM='SWA_WL'
+ YRECFM='RN_BLT'
YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='Sdown absorbed by wall'//' (W/m2)'
+ YCOMMENT='net radiation for built surfaces'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XRN_BLT(:),IRESP,HCOMMENT=YCOMMENT)
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XABS_SW_WALL_A(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='H_BLT'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='built surface sensible heat flux'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XH_BLT(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='LWA_WL'
+ YRECFM='LE_BLT'
YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='Ldown absorbed by wall '//' (W/m2)'
+ YCOMMENT='built surface latent heat flux'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XLE_BLT(:),IRESP,HCOMMENT=YCOMMENT)
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XABS_LW_WALL_A(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='GFLUX_BLT'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='built surface conduction flux'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XGFLUX_BLT(:),IRESP,HCOMMENT=YCOMMENT)
!
-ELSE
+ YRECFM='SWA_RF'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='Sdown absorbed by roofs'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XABS_SW_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='SWA_WLA'
+ YRECFM='SWA_SN_RF'
YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='Sdown absorbed by wall A'//' (W/m2)'
+ YCOMMENT='Sdown absorbed by snow on roofs'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XABS_SW_SNOW_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XABS_SW_WALL_A(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='LWA_RF'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='Ldown absorbed by roofs'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XABS_LW_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='LWA_WLA'
+ YRECFM='LWA_SN_RF'
YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='Ldown absorbed by wall A'//' (W/m2)'
+ YCOMMENT='Ldown absorbed by snow on roofs'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XABS_LW_SNOW_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XABS_LW_WALL_A(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='SWA_RD'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='Sdown absorbed by roads'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XABS_SW_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='SWA_WLB'
+ YRECFM='SWA_SN_RD'
YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='Sdown absorbed by wall B'//' (W/m2)'
+ YCOMMENT='Sdown absorbed by snow on roads'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XABS_SW_SNOW_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XABS_SW_WALL_B(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='LWA_RD'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='Ldown absorbed by roads'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XABS_LW_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='LWA_WLB'
+ YRECFM='LWA_SN_RD'
YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='Ldown absorbed by wall B'//' (W/m2)'
+ YCOMMENT='Ldown absorbed by snow on roads'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XABS_LW_SNOW_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XABS_LW_WALL_B(:),IRESP,HCOMMENT=YCOMMENT)
+ IF (TOP%CWALL_OPT=='UNIF') THEN
+ !
+ YRECFM='SWA_WL'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='Sdown absorbed by wall'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XABS_SW_WALL_A(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWA_WL'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='Ldown absorbed by wall '//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XABS_LW_WALL_A(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ELSE
+ !
+ YRECFM='SWA_WLA'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='Sdown absorbed by wall A'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XABS_SW_WALL_A(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWA_WLA'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='Ldown absorbed by wall A'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XABS_LW_WALL_A(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SWA_WLB'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='Sdown absorbed by wall B'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XABS_SW_WALL_B(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWA_WLB'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='Ldown absorbed by wall B'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XABS_LW_WALL_B(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDIF
!
-ENDIF
-!
-IF (TOP%LGARDEN) THEN
+ IF (TOP%LGARDEN) THEN
+ !
+ YRECFM='SWA_GD'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='Sdown absorbed by GARDEN areas'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XABS_SW_GARDEN(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWA_GD'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='Ldown absorbed by GARDEN areas'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XABS_LW_GARDEN(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDIF
!
- YRECFM='SWA_GD'
+ YRECFM='REF_SW_GO'
YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='Sdown absorbed by GARDEN areas'//' (W/m2)'
+ YCOMMENT='Total solar rad reflected by ground '//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XREF_SW_GRND(:),IRESP,HCOMMENT=YCOMMENT)
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XABS_SW_GARDEN(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='LWE_GO'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='LW emitted by ground'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XEMIT_LW_GRND(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='LWA_GD'
+ YRECFM='REF_SW_FA'
YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='Ldown absorbed by GARDEN areas'//' (W/m2)'
+ YCOMMENT='Total solar rad reflected by facade '//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XREF_SW_FAC(:),IRESP,HCOMMENT=YCOMMENT)
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XABS_LW_GARDEN(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='LWE_FA'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='LW emitted by facade'//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XEMIT_LW_FAC(:),IRESP,HCOMMENT=YCOMMENT)
!
-ENDIF
-!
-YRECFM='REF_SW_GO'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='Total solar rad reflected by ground '//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XREF_SW_GRND(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='LWE_GO'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='LW emitted by ground'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XEMIT_LW_GRND(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='REF_SW_FA'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='Total solar rad reflected by facade '//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XREF_SW_FAC(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='LWE_FA'
-YRECFM=ADJUSTL(YPATCH//YRECFM)
-YCOMMENT='LW emitted by facade'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XEMIT_LW_FAC(:),IRESP,HCOMMENT=YCOMMENT)
-!
-!
IF (TOP%CBEM=='BEM') THEN
!
YRECFM='CL_CURT'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Current Cooling system temperature set point'//' (K)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XTCOOL_CUR_TARGET(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XTCOOL_TARGET(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='HT_CURT'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Current Heating system temperature set point'//' (K)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XTHEAT_CUR_TARGET(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XTHEAT_TARGET(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='QIN_CUR'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Current Building internal heat loads'//' (W m-2(floor))'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XCUR_QIN(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XQIN(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='XFLX_BLD'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='heat flux from bld'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XFLX_BLD(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XFLX_BLD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='H_BLD_CL'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='sensible cooling demand'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XH_BLD_COOL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XH_BLD_COOL(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='T_BLD_CL'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Total cooling demand'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XT_BLD_COOL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XT_BLD_COOL(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='H_BLD_HT'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='sensible heating demand'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XH_BLD_HEAT(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XH_BLD_HEAT(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LE_BLD_CL'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='latent cooling demand'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XLE_BLD_COOL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XLE_BLD_COOL(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LE_BLD_HT'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='latent heating demand'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XLE_BLD_HEAT(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XLE_BLD_HEAT(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='H_WASTE'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='sensible waste heat from HVAC'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XH_WASTE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XH_WASTE(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LE_WASTE'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='latent waste heat from HVAC'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XLE_WASTE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XLE_WASTE(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='HVAC_CL'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='cooling energy consumption'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XHVAC_COOL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XHVAC_COOL(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='HVAC_HT'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='heating energy consumption'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XHVAC_HEAT(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XHVAC_HEAT(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='CAP_SYS'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Actual capacity of the cooling system'//' (W m-2(bld))'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XCAP_SYS(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XCAP_SYS(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='M_SYS'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Actual HVAC mass flow rate'//' (kg s-1 m-2(bld))'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XM_SYS(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XM_SYS(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='COP'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Actual COP of the cooling system'//' ()'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XCOP(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XCOP(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='Q_SYS'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Supply air specific humidity'//' (kg kg-1)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XQ_SYS(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XQ_SYS(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='T_SYS'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Supply air temperature'//' (K)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XT_SYS(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XT_SYS(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='TR_SW_WIN'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Solar radiation transmitted through windows'//' (W m-2(bld))'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XTR_SW_WIN(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XTR_SW_WIN(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='FAN_POWER'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='HVAC fan power'//' (W m-2(bld))'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XFAN_POWER(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XFAN_POWER(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='T_RAD_IND'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Indoor mean radiant temperature'//' (K)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XT_RAD_IND(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XT_RAD_IND(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='HU_BLD'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Indoor relative humidity'//' (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XHU_BLD(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XHU_BLD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='SWA_WIN'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Sdown absorbed by windows'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XABS_SW_WIN(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XABS_SW_WIN(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LWA_WIN'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Ldown absorbed by windows'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XABS_LW_WIN(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XABS_LW_WIN(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
IF (TOP%LGREENROOF) THEN
!
- WHERE (T%CUR%XGREENROOF(:) == 0.)
- DGMT%CUR%XRN_GREENROOF (:) = XUNDEF
- DGMT%CUR%XH_GREENROOF (:) = XUNDEF
- DGMT%CUR%XLE_GREENROOF (:) = XUNDEF
- DGMT%CUR%XGFLUX_GREENROOF (:) = XUNDEF
- DGMT%CUR%XABS_SW_GREENROOF(:) = XUNDEF
- DGMT%CUR%XABS_LW_GREENROOF(:) = XUNDEF
- DGMT%CUR%XG_GREENROOF_ROOF(:) = XUNDEF
- DGMT%CUR%XRUNOFF_GREENROOF(:) = XUNDEF
- DGMT%CUR%XDRAIN_GREENROOF (:) = XUNDEF
+ WHERE (T%XGREENROOF(:) == 0.)
+ GRD%XRN (:) = XUNDEF
+ GRD%XH (:) = XUNDEF
+ GRD%XLE (:) = XUNDEF
+ GRD%XGFLUX (:) = XUNDEF
+ !
+ DMT%XABS_SW_GREENROOF(:) = XUNDEF
+ DMT%XABS_LW_GREENROOF(:) = XUNDEF
+ DMT%XG_GREENROOF_ROOF(:) = XUNDEF
+ !
+ GRDE%XRUNOFF(:) = XUNDEF
+ GRDE%XDRAIN (:) = XUNDEF
END WHERE
!
YRECFM='RN_GR'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='net radiation for GREENROOFs'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XRN_GREENROOF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,GRD%XRN(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='H_GR'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='sensible heat flux for GREENROOFs'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XH_GREENROOF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,GRD%XH(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LE_GR'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='latent heat flux for GREENROOFs'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XLE_GREENROOF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,GRD%XLE(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='GFLUX_GR'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='net conduction flux for GREENROOFs'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XGFLUX_GREENROOF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,GRD%XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='SWA_GR'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Sdown absorbed by GREENROOFs'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XABS_SW_GREENROOF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XABS_SW_GREENROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LWA_GR'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Ldown absorbed by GREENROOFs'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XABS_LW_GREENROOF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XABS_LW_GREENROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='G_GR_ROOF'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='heat flux between GREENROOF and ROOF'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XG_GREENROOF_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XG_GREENROOF_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='RUNOFF_GR'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='GREENROOF soil surface runoff'//' (kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XRUNOFF_GREENROOF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,GRDE%XRUNOFF(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='DRAIN_GR'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='GREENROOF total vertical drainage'//' (kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XDRAIN_GREENROOF(:),IRESP,HCOMMENT=YCOMMENT)
- !
- WHERE (T%CUR%XGREENROOF(:) == 1.)
- DGMT%CUR%XRN_STRLROOF(:) = XUNDEF
- DGMT%CUR%XH_STRLROOF(:) = XUNDEF
- DGMT%CUR%XLE_STRLROOF(:) = XUNDEF
- DGMT%CUR%XGFLUX_STRLROOF(:) = XUNDEF
- DGMT%CUR%XRUNOFF_STRLROOF(:) = XUNDEF
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,GRDE%XDRAIN(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ WHERE (T%XGREENROOF(:) == 1.)
+ DMT%XRN_STRLROOF(:) = XUNDEF
+ DMT%XH_STRLROOF(:) = XUNDEF
+ DMT%XLE_STRLROOF(:) = XUNDEF
+ DMT%XGFLUX_STRLROOF(:) = XUNDEF
+ DMT%XRUNOFF_STRLROOF(:) = XUNDEF
END WHERE
!
YRECFM='RN_SR'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='structural roof net radiation'//YRECFM//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XRN_STRLROOF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XRN_STRLROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='H_SR'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='structural roof sensible heat flux'//YRECFM//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XH_STRLROOF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XH_STRLROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LE_SR'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='structural roof latent heat flux'//YRECFM//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XLE_STRLROOF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XLE_STRLROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='GFLUX_SR'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='structural roof conduction flux'//YRECFM//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XGFLUX_STRLROOF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XGFLUX_STRLROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='RUNOFF_SR'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='structural roof surface runoff'//' (kg/m2/s)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XRUNOFF_STRLROOF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XRUNOFF_STRLROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
@@ -759,171 +621,142 @@ YCOMMENT='LW emitted by facade'//' (W/m2)'
YRECFM='SWA_SP'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Shortwave absorbed by solar panels on roofs'//' (W/m2 panel)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XABS_SW_PANEL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XABS_SW_PANEL(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LWA_SP'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Longwave absorbed by solar panels on roofs'//' (W/m2 panel)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XABS_LW_PANEL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XABS_LW_PANEL(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='RN_SP'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Net radiation of solar panels on roofs'//' (W/m2 panel)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XRN_PANEL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XRN_PANEL(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='H_SP'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Sensible Heat flux from solar panels on roofs'//' (W/m2 panel)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XH_PANEL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XH_PANEL(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='PHOT_SP'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Photovolatic production '//' (W/m2 photovoltaic panel)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XPHOT_PROD_PANEL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XPHOT_PROD_PANEL(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='THER_SP'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Hot Water production '//' (W/m2 thermal panel)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XTHER_PROD_PANEL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XTHER_PROD_PANEL(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='PROD_SP'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Production by solar panels on roofs'//' (W/m2 panel)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XPROD_PANEL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XPROD_PANEL(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='PHOT_BLD'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Photovolatic production '//' (W/m2 bld)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XPHOT_PROD_BLD(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XPHOT_PROD_BLD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='THER_BLD'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Hot Water production '//' (W/m2 bld)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGMT%CUR%XTHER_PROD_BLD(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMT%XTHER_PROD_BLD(:),IRESP,HCOMMENT=YCOMMENT)
!
END IF
-!
-!*
-!* 3. Cumulated fields
-! ----------------
-!
-!
- IF (TOP%CBEM=='BEM') THEN
- !
- YRECFM='HVACC_CL'
- YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='cumulated cooling energy consumption'//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGCT%CUR%XHVACC_COOL(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='HVACC_HT'
- YRECFM=ADJUSTL(YPATCH//YRECFM)
- YCOMMENT='cumulated heating energy consumption'//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGCT%CUR%XHVACC_HEAT(:),IRESP,HCOMMENT=YCOMMENT)
+ !*
+ !* 3. Cumulated fields
+ ! ----------------
!
+ CALL END_IO_SURF_n(HPROGRAM)
+ CALL INIT_IO_SURF_n(DTCO, U,HPROGRAM,'TOWN ','TEB ','WRITE','TEB_DIAG_CUMUL.OUT.nc')
+ !
+ IF (TOP%CBEM=='BEM') THEN
+ !
+ YRECFM='HVACC_CL'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='cumulated cooling energy consumption'//' (J/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMTC%XHVAC_COOL(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='HVACC_HT'
+ YRECFM=ADJUSTL(YPATCH//YRECFM)
+ YCOMMENT='cumulated heating energy consumption'//' (J/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMTC%XHVAC_HEAT(:),IRESP,HCOMMENT=YCOMMENT)
+ !
END IF
!
YRECFM='RUNOFFC_TW'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='cumulated aggregated runoff for town'//' (kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGCT%CUR%XRUNOFFC_TOWN(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMTC%XRUNOFF_TOWN(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='RUNOFFC_RD'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='cumulated road surface runoff'//' (kg/m2 road)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGCT%CUR%XRUNOFFC_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMTC%XRUNOFF_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='RUNOFFC_RF'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='cumulated aggregated roof runoff'//' (kg/m2 roof)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGCT%CUR%XRUNOFFC_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMTC%XRUNOFF_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='IRRIGC_RD'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='cumulated road irrigation'//' (kg/m2 road)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGCT%CUR%XIRRIGC_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMTC%XIRRIG_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
!
IF (TOP%LGARDEN) THEN
!
YRECFM='RUNOFFC_GD'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='cumulated garden surface runoff'//' (kg/m2 garden)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGCT%CUR%XRUNOFFC_GARDEN(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,GDDEC%XRUNOFF(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='DRAINC_GD'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='cumulated garden surface drainage'//' (kg/m2 garden)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGCT%CUR%XDRAINC_GARDEN(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,GDDEC%XDRAIN(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='IRRIGC_GD'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='cumulated garden irrigation'//' (kg/m2 garden)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGCT%CUR%XIRRIGC_GARDEN(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMTC%XIRRIG_GARDEN(:),IRESP,HCOMMENT=YCOMMENT)
!
END IF
!
IF (TOP%LGREENROOF) THEN
!
- WHERE (T%CUR%XGREENROOF(:) == 0.)
- DGCT%CUR%XRUNOFFC_GREENROOF (:) = XUNDEF
- DGCT%CUR%XDRAINC_GREENROOF (:) = XUNDEF
- DGCT%CUR%XIRRIGC_GREENROOF (:) = XUNDEF
+ WHERE (T%XGREENROOF(:) == 0.)
+ GRDEC%XRUNOFF (:) = XUNDEF
+ GRDEC%XDRAIN (:) = XUNDEF
+ DMTC%XIRRIG_GREENROOF (:) = XUNDEF
END WHERE
!
YRECFM='RUNOFFC_GR'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='GREENROOF cumulated soil surface runoff'//' (kg/m2 greenroof)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGCT%CUR%XRUNOFFC_GREENROOF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,GRDEC%XRUNOFF(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='DRAINC_GR'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='GREENROOF cumulated total vertical drainage'//' (kg/m2 greenroof)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGCT%CUR%XDRAINC_GREENROOF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,GRDEC%XDRAIN(:),IRESP,HCOMMENT=YCOMMENT)
!
!
YRECFM='IRRIGC_GR'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='GREENROOF cumulated irrigation'//' (kg/m2 greenroof)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGCT%CUR%XIRRIGC_GREENROOF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMTC%XIRRIG_GREENROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
- WHERE (T%CUR%XGREENROOF(:) == 1.)
- DGCT%CUR%XRUNOFFC_STRLROOF (:) = XUNDEF
+ WHERE (T%XGREENROOF(:) == 1.)
+ DMTC%XRUNOFF_STRLROOF (:) = XUNDEF
END WHERE
!
YRECFM='RUNOFFC_SR'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='cumulated structural roof surface runoff'//' (kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGCT%CUR%XRUNOFFC_STRLROOF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMTC%XRUNOFF_STRLROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
END IF
!
@@ -933,27 +766,23 @@ YCOMMENT='LW emitted by facade'//' (W/m2)'
YRECFM='PHOTC_BLD'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Cumulated Photovolatic production '//' (J/m2 bld)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGCT%CUR%XPHOT_PROD_BLDC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMTC%XPHOT_PROD_BLD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='THERC_BLD'
YRECFM=ADJUSTL(YPATCH//YRECFM)
YCOMMENT='Cumulated Hot water production '//' (J/m2 bld)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGCT%CUR%XTHER_PROD_BLDC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DMTC%XTHER_PROD_BLD(:),IRESP,HCOMMENT=YCOMMENT)
!
END IF
-!
+ !
+ !-------------------------------------------------------------------------------
+ !
+ ! End of IO
+ !
+ CALL END_IO_SURF_n(HPROGRAM)
+ !
END IF
!
-!
-!-------------------------------------------------------------------------------
-!
-! End of IO
-!
- CALL END_IO_SURF_n(HPROGRAM)
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_MISC_TEB_N',1,ZHOOK_HANDLE)
!
END SUBROUTINE WRITE_DIAG_MISC_TEB_n
diff --git a/src/SURFEX/write_diag_naturen.F90 b/src/SURFEX/write_diag_naturen.F90
index a1f7061d4cb51dfaa2526f2827a6f2cf8b376d52..0294d464fc29cfafa6756abc9ccbfec35c752107 100644
--- a/src/SURFEX/write_diag_naturen.F90
+++ b/src/SURFEX/write_diag_naturen.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE WRITE_DIAG_NATURE_n (DTCO, DGU, U, IM, DST, &
- HPROGRAM,HWRITE)
+SUBROUTINE WRITE_DIAG_NATURE_n (DTCO, DUO, U, IM, NDST, HPROGRAM,HWRITE)
! ###############################################################################
!
!!**** *WRITE_DIAG_NATURE_n * - Chooses the surface schemes for diagnostics over
@@ -31,10 +30,10 @@ SUBROUTINE WRITE_DIAG_NATURE_n (DTCO, DGU, U, IM, DST, &
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t
-USE MODD_DST_n, ONLY : DST_t
+USE MODD_DST_n, ONLY : DST_NP_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
@@ -50,10 +49,10 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DUO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
-TYPE(DST_t), INTENT(INOUT) :: DST
+TYPE(DST_NP_t), INTENT(INOUT) :: NDST
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=3), INTENT(IN) :: HWRITE ! 'PGD' : only physiographic fields are written
@@ -67,8 +66,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_NATURE_N',0,ZHOOK_HANDLE)
IF (U%CNATURE=='ISBA ') THEN
- CALL WRITE_DIAG_ISBA_n(DTCO, DGU, U, IM, DST, &
- HPROGRAM,HWRITE)
+ CALL WRITE_DIAG_ISBA_n(DTCO, DUO, U, IM, NDST, HPROGRAM,HWRITE)
END IF
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_NATURE_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/write_diag_pgd_grdnn.F90 b/src/SURFEX/write_diag_pgd_grdnn.F90
index 46525984a12d20abfa80113332d000ca8565f586..67e17126f5341453ffc131a32125170ea70e5ff8 100644
--- a/src/SURFEX/write_diag_pgd_grdnn.F90
+++ b/src/SURFEX/write_diag_pgd_grdnn.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_DIAG_PGD_GRDN_n (DTCO, DGU, U, DGMTO, TGDPE, TGDP, TVG, &
- HPROGRAM)
+ SUBROUTINE WRITE_DIAG_PGD_GRDN_n (DTCO, HSELECT, U, OSURF_DIAG_ALBEDO, &
+ S, P, PEK, IO, HPROGRAM)
! #########################################
!
!!**** *WRITE_DIAG_PGD_TEB_GARDEN_n* - writes the ISBA physiographic diagnostic fields
@@ -42,12 +42,9 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_DIAG_MISC_TEB_OPTION_n, ONLY : DIAG_MISC_TEB_OPTIONS_t
-USE MODD_TEB_GARDEN_PGD_EVOL_n, ONLY : TEB_GARDEN_PGD_EVOL_t
-USE MODD_TEB_GARDEN_PGD_n, ONLY : TEB_GARDEN_PGD_t
-USE MODD_TEB_VEG_n, ONLY : TEB_VEG_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_P_t, ISBA_PE_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
@@ -69,12 +66,13 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(DIAG_MISC_TEB_OPTIONS_t), INTENT(INOUT) :: DGMTO
-TYPE(TEB_GARDEN_PGD_EVOL_t), INTENT(INOUT) :: TGDPE
-TYPE(TEB_GARDEN_PGD_t), INTENT(INOUT) :: TGDP
-TYPE(TEB_VEG_OPTIONS_t), INTENT(INOUT) :: TVG
+LOGICAL, INTENT(IN) :: OSURF_DIAG_ALBEDO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_P_t), INTENT(INOUT) :: P
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
!
@@ -93,18 +91,16 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! Initialisation for IO
!
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_GRDN_N',0,ZHOOK_HANDLE)
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'TOWN ','TEB ','WRITE')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'TOWN ','TEB ','WRITE','TEB_PGD.OUT.nc')
!
!* Leaf Area Index
!
-IF (TVG%CPHOTO=='NON' .OR. TVG%CPHOTO=='AGS' .OR. TVG%CPHOTO=='AST') THEN
+IF (IO%CPHOTO=='NON' .OR. IO%CPHOTO=='AST') THEN
!
YRECFM='GD_LAI'
YCOMMENT='leaf area index (-)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,TGDPE%CUR%XLAI(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,PEK%XLAI(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
@@ -115,26 +111,23 @@ ENDIF
YRECFM='GD_VEG'
YCOMMENT='vegetation fraction (-)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,TGDPE%CUR%XVEG(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,PEK%XVEG(:),IRESP,HCOMMENT=YCOMMENT)
!
!* Surface roughness length (without snow)
!
YRECFM='GD_Z0VEG'
YCOMMENT='surface roughness length (without snow) (M)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,TGDPE%CUR%XZ0(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,PEK%XZ0(:),IRESP,HCOMMENT=YCOMMENT)
!
!-------------------------------------------------------------------------------
!
!* Soil depth for each patch
!
-DO JL=1,SIZE(TGDP%XDG,2)
+DO JL=1,SIZE(P%XDG,2)
WRITE(YRECFM,FMT='(A5,I1)') 'GD_DG',JL
YCOMMENT='soil depth'//' (M)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,TGDP%XDG(:,JL),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,P%XDG(:,JL),IRESP,HCOMMENT=YCOMMENT)
END DO
!
!-------------------------------------------------------------------------------
@@ -149,24 +142,22 @@ ENDIF
!
!* Runoff soil ice depth for each patch
!
-IF(TVG%CHORT=='SGH')THEN
+IF(IO%CHORT=='SGH')THEN
YRECFM='GD_DICE'
YCOMMENT='soil ice depth for runoff (m)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,TGDP%XD_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,P%XD_ICE(:),IRESP,HCOMMENT=YCOMMENT)
ENDIF
!
!-------------------------------------------------------------------------------
!
!* Fraction of each vegetation type for each patch
!
-DO JL=1,SIZE(TGDP%XVEGTYPE,2)
+DO JL=1,SIZE(S%XVEGTYPE,2)
WRITE(YPAS,'(I2)') JL
YLVLV=ADJUSTL(YPAS(:LEN_TRIM(YPAS)))
WRITE(YRECFM,FMT='(A12)') 'GD_VEGTY_P'//YLVLV
YCOMMENT='fraction of each vegetation type '//' (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,TGDP%XVEGTYPE(:,JL),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,S%XVEGTYPE(:,JL),IRESP,HCOMMENT=YCOMMENT)
END DO
!-------------------------------------------------------------------------------
!
@@ -174,59 +165,50 @@ END DO
!
YRECFM='GD_RSMIN'
YCOMMENT='minimum stomatal resistance (SM-1)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,TGDP%XRSMIN(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,PEK%XRSMIN(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='GD_GAMMA'
YCOMMENT='coefficient for RSMIN calculation (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,TGDP%XGAMMA(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,PEK%XGAMMA(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='GD_CV'
YCOMMENT='vegetation thermal inertia coefficient (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,TGDP%XCV(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,PEK%XCV(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='GD_RGL'
YCOMMENT='maximum solar radiation usable in photosynthesis (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,TGDP%XRGL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,PEK%XRGL(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='GD_EMIS_ISBA'
YCOMMENT='surface emissivity (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,TGDPE%CUR%XEMIS(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,PEK%XEMIS(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='GD_WRMAX_CF'
YCOMMENT='coefficient for maximum water interception (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,TGDP%XWRMAX_CF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,PEK%XWRMAX_CF(:),IRESP,HCOMMENT=YCOMMENT)
!
!-------------------------------------------------------------------------------
!
-IF (DGMTO%LSURF_DIAG_ALBEDO) THEN
+IF (OSURF_DIAG_ALBEDO) THEN
!
!* Soil albedos
!
!
YRECFM='GD_ALBNIR_S'
YCOMMENT='soil near-infra-red albedo (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,TGDP%XALBNIR_SOIL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,PEK%XALBNIR_SOIL(:),IRESP,HCOMMENT=YCOMMENT)
!
!-------------------------------------------------------------------------------
!
YRECFM='GD_ALBVIS_S'
YCOMMENT='soil visible albedo (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,TGDP%XALBVIS_SOIL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,PEK%XALBVIS_SOIL(:),IRESP,HCOMMENT=YCOMMENT)
!
!-------------------------------------------------------------------------------
!
YRECFM='GD_ALBUV_S'
YCOMMENT='soil UV albedo (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,TGDP%XALBUV_SOIL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,PEK%XALBUV_SOIL(:),IRESP,HCOMMENT=YCOMMENT)
!
!-------------------------------------------------------------------------------
!
@@ -234,22 +216,19 @@ IF (DGMTO%LSURF_DIAG_ALBEDO) THEN
!
YRECFM='GD_ALBNIR_T'
YCOMMENT='total near-infra-red albedo (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,TGDPE%CUR%XALBNIR(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,PEK%XALBNIR(:),IRESP,HCOMMENT=YCOMMENT)
!
!-------------------------------------------------------------------------------
!
YRECFM='GD_ALBVIS_T'
YCOMMENT='total visible albedo (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,TGDPE%CUR%XALBVIS(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,PEK%XALBVIS(:),IRESP,HCOMMENT=YCOMMENT)
!
!-------------------------------------------------------------------------------
!
YRECFM='GD_ALBUV_T'
YCOMMENT='total UV albedo (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,TGDPE%CUR%XALBUV(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,PEK%XALBUV(:),IRESP,HCOMMENT=YCOMMENT)
!
END IF
!
diff --git a/src/SURFEX/write_diag_pgd_isban.F90 b/src/SURFEX/write_diag_pgd_isban.F90
index e22ce8e79714e38d5ea3ed278826ac8823788575..70928be6bcfd4929fbbbf754e283a5bfbe6b4e7a 100644
--- a/src/SURFEX/write_diag_pgd_isban.F90
+++ b/src/SURFEX/write_diag_pgd_isban.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_DIAG_PGD_ISBA_n (DTCO, DGU, U, CHI, DGMI, I, &
- HPROGRAM)
+ SUBROUTINE WRITE_DIAG_PGD_ISBA_n (DTCO, HSELECT, U, CHI, NCHI, OSURF_DIAG_ALBEDO, &
+ IO, S, K, NP, NPE, ISS, HPROGRAM)
! #########################################
!
!!**** *WRITE_DIAG_PGD_ISBA_n* - writes the ISBA physiographic diagnostic fields
@@ -38,19 +38,19 @@
!! Modified 11/2013 by B. Decharme : XPATCH now in writesurf_isban.F90
!! Modified 10/2014 by P. Samuelsson: MEB variables
!! Modified 06/2014 by B. Decharme : add XVEGTYPE
-!! M.Moge 01/2016 using WRITE_SURF_FIELD2D/3D for 2D/3D surfex fields writes
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_TYPE_DATE_SURF
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
-USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
-USE MODD_ISBA_n, ONLY : ISBA_t
+USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t, CH_ISBA_NP_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_NP_t, ISBA_NPE_t, ISBA_P_t, ISBA_PE_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
USE MODD_AGRI, ONLY : LAGRIP
@@ -60,9 +60,10 @@ USE MODD_IO_SURF_FA, ONLY : LFANOCOMPACT, LPREP
!
USE MODI_INIT_IO_SURF_n
USE MODI_WRITE_SURF
-USE MODI_WRITE_SURF_FIELD2D
USE MODI_END_IO_SURF_n
-!
+USE MODI_WRITE_FIELD_1D_PATCH
+USE MODI_WRITE_TFIELD_1D_PATCH
+USE MODI_UNPACK_SAME_RANK
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -74,30 +75,43 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
-TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DGMI
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(CH_ISBA_NP_t), INTENT(INOUT) :: NCHI
+LOGICAL, INTENT(IN) :: OSURF_DIAG_ALBEDO
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
+TYPE(SSO_t), INTENT(INOUT) :: ISS
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-REAL, DIMENSION(SIZE(I%XDG,1),SIZE(I%XDG,3)) :: ZWORK ! Work array
-REAL, DIMENSION(SIZE(I%XDG,1),SIZE(I%XDG,2)) :: ZDG ! Work array
-REAL, DIMENSION(SIZE(I%XDG,1) ) :: ZDG2
-REAL, DIMENSION(SIZE(I%XDG,1) ) :: ZDTOT
+TYPE(ISBA_P_t), POINTER :: PK
+TYPE(ISBA_PE_t), POINTER :: PEK
+!
+REAL, DIMENSION(U%NSIZE_NATURE,IO%NPATCH) :: ZWORK
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZWORK1
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK2
+!
+REAL, DIMENSION(U%NSIZE_NATURE,SIZE(NP%AL(1)%XDG,2)) :: ZDG ! Work array
+REAL, DIMENSION(U%NSIZE_NATURE) :: ZDG2
+REAL, DIMENSION(U%NSIZE_NATURE) :: ZDTOT
!
INTEGER :: IRESP ! IRESP : return-code if a problem appears
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=100):: YCOMMENT ! Comment string
- CHARACTER(LEN=100):: YCOMMENTUNIT ! Comment string : unit of the datas in the field to write
- CHARACTER(LEN=2) :: YLVLV, YPAS
- CHARACTER(LEN=4) :: YLVL
+CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=100):: YCOMMENT ! Comment string
+CHARACTER(LEN=2) :: YLVLV, YPAS
+CHARACTER(LEN=4) :: YLVL
+ CHARACTER(LEN=2) :: YPAT
!
-INTEGER :: JJ, JL, JP, ILAYER
+INTEGER :: JI, JL, JP, ILAYER, ILU, IMASK
INTEGER :: ISIZE_LMEB_PATCH ! Number of patches where multi-energy balance should be applied
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
@@ -106,34 +120,25 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_ISBA_N',0,ZHOOK_HANDLE)
!
-ISIZE_LMEB_PATCH=COUNT(I%LMEB_PATCH(:))
+ILU = U%NSIZE_NATURE
+!
+ISIZE_LMEB_PATCH=COUNT(IO%LMEB_PATCH(:))
!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'NATURE','ISBA ','WRITE')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'NATURE','ISBA ','WRITE','ISBA_VEG_EVOLUTION.OUT.nc')
!
!-------------------------------------------------------------------------------
!
!* Leaf Area Index
!
-IF (I%CPHOTO=='NON' .OR. I%CPHOTO=='AGS' .OR. I%CPHOTO=='AST') THEN
+IF (IO%CPHOTO=='NON' .OR. IO%CPHOTO=='AST') THEN
!
YRECFM='LAI'
- YCOMMENT='leaf area index'
- YCOMMENTUNIT='-'
+ YCOMMENT='leaf area index (-)'
!
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XLAI(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- IF (ISIZE_LMEB_PATCH>0) THEN
- !
- YRECFM='LAIGV'
- YCOMMENT='MEB: understory leaf area index'
- YCOMMENTUNIT='-'
- !
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XLAIGV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- ENDIF
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XLAI(:),ILU,S%XWORK_WR)
+ ENDDO
!
ENDIF
!
@@ -142,36 +147,40 @@ ENDIF
!* Vegetation fraction
!
YRECFM='VEG'
-YCOMMENT='vegetation fraction'
-YCOMMENTUNIT='-'
+YCOMMENT='vegetation fraction (-)'
!
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XVEG(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XVEG(:),ILU,S%XWORK_WR)
+ENDDO
!
!* Surface roughness length (without snow)
!
YRECFM='Z0VEG'
-YCOMMENT='surface roughness length (without snow)'
-YCOMMENTUNIT='M'
+YCOMMENT='surface roughness length (without snow) (m)'
!
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XZ0(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XZ0(:),ILU,S%XWORK_WR)
+ENDDO
!
IF (ISIZE_LMEB_PATCH>0) THEN
!
YRECFM='GNDLITTER'
- YCOMMENT='MEB: ground litter fraction '
- YCOMMENTUNIT='-'
+ YCOMMENT='MEB: ground litter fraction (-)'
!
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XGNDLITTER(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XGNDLITTER(:),ILU,S%XWORK_WR)
+ENDDO
!
YRECFM='Z0LITTER'
- YCOMMENT='MEB: ground litter roughness length (without snow) '
- YCOMMENTUNIT='M'
+ YCOMMENT='MEB: ground litter roughness length (without snow) (m)'
!
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XZ0LITTER(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XZ0LITTER(:),ILU,S%XWORK_WR)
+ENDDO
!
ENDIF
!
@@ -179,194 +188,185 @@ ENDIF
!
!* Soil depth for each patch
!
-DO JL=1,SIZE(I%XDG,2)
+DO JL=1,SIZE(NP%AL(1)%XDG,2)
IF (JL<10) THEN
WRITE(YRECFM,FMT='(A2,I1)') 'DG',JL
ELSE
WRITE(YRECFM,FMT='(A2,I2)') 'DG',JL
ENDIF
- YCOMMENT='soil depth'
- YCOMMENTUNIT='M'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XDG(:,JL,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YCOMMENT='soil depth'//' (M)'
+DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NP%AL(JP)%XDG(:,JL),ILU,S%XWORK_WR)
+ENDDO
END DO
!
!* Averaged Soil depth
!
-IF(I%NPATCH>1)THEN
+IF(IO%NPATCH>1)THEN
!
ZDG(:,:)=0.0
- DO JP=1,I%NPATCH
- DO JL=1,SIZE(I%XDG,2)
- DO JJ=1,SIZE(I%XDG,1)
- ZDG(JJ,JL)=ZDG(JJ,JL)+I%XPATCH(JJ,JP)*I%XDG(JJ,JL,JP)
- ENDDO
- ENDDO
+ DO JP=1,IO%NPATCH
+ PK => NP%AL(JP)
+ DO JL=1,SIZE(PK%XDG,2)
+ DO JI=1, PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ ZDG(IMASK,JL) = ZDG(IMASK,JL) + PK%XPATCH(JI)*PK%XDG(JI,JL)
+ ENDDO
+ ENDDO
ENDDO
!
- DO JL=1,SIZE(I%XDG,2)
+ DO JL=1,SIZE(NP%AL(1)%XDG,2)
WRITE(YLVL,'(I4)')JL
YRECFM='DG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
- YCOMMENT='averaged soil depth layer (M)'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,ZDG(:,JL),IRESP,YCOMMENT)
+ YCOMMENT='averaged soil depth layer '//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))//' (m)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ZDG(:,JL),IRESP,HCOMMENT=YCOMMENT)
END DO
!
ENDIF
!
!-------------------------------------------------------------------------------
!
-IF(I%CISBA=='DIF')THEN
-!
+IF(IO%CISBA=='DIF')THEN
+ !
+ ALLOCATE(ZWORK2(ILU,IO%NPATCH))
+ !
ZDG2 (:)=0.0
ZDTOT(:)=0.0
- ZWORK(:,:)=XUNDEF
- DO JP=1,SIZE(I%XDG,3)
- DO JJ=1,SIZE(I%XDG,1)
- ZDG2(JJ)=ZDG2(JJ)+I%XPATCH(JJ,JP)*I%XDG2(JJ,JP)
- JL=I%NWG_LAYER(JJ,JP)
+ ZWORK2(:,:)=XUNDEF
+ DO JP=1,IO%NPATCH
+ PK => NP%AL(JP)
+ DO JI=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ ZDG2(IMASK) = ZDG2(IMASK) + PK%XPATCH(JI) * PK%XDG2(JI)
+ JL = PK%NWG_LAYER(JI)
IF(JL/=NUNDEF)THEN
- ZWORK(JJ,JP)=I%XDG(JJ,JL,JP)
- ZDTOT(JJ)=ZDTOT(JJ)+I%XPATCH(JJ,JP)*I%XDG(JJ,JL,JP)
+ ZWORK2(JI,JP) = PK%XDG(JI,JL)
+ ZDTOT(IMASK) = ZDTOT(IMASK) + PK%XPATCH(JI) * PK%XDG(JI,JL)
ENDIF
ENDDO
ENDDO
-!
-!* Root depth
-!
+ !
+ !* Root depth
+ !
YRECFM='DROOT_DIF'
YCOMMENT='Root depth in ISBA-DIF'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XDROOT(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
-!
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NP%AL(JP)%XDROOT(:),ILU,S%XWORK_WR)
+ ENDDO
+ !
YRECFM='DG2_DIF'
YCOMMENT='DG2 depth in ISBA-DIF'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XDG2(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
-!
- IF(I%NPATCH>1)THEN
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NP%AL(JP)%XDG2(:),ILU,S%XWORK_WR)
+ ENDDO
+ !
+ IF(IO%NPATCH>1)THEN
YRECFM='DG2_DIF_ISBA'
- YCOMMENT='Averaged DG2 depth in ISBA-DIF (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,ZDG2(:),IRESP,YCOMMENT)
+ YCOMMENT='Averaged DG2 depth in ISBA-DIF'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ZDG2(:),IRESP,HCOMMENT=YCOMMENT)
ENDIF
-!
-!* Runoff depth
-!
+ !
+ !* Runoff depth
+ !
YRECFM='RUNOFFD'
YCOMMENT='Runoff deph in ISBA-DIF'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XRUNOFFD(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
-!
-!* Total soil depth for mositure
-!
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NP%AL(JP)%XRUNOFFD(:),ILU,S%XWORK_WR)
+ ENDDO
+ !
+ !* Total soil depth for mositure
+ !
YRECFM='DTOT_DIF'
YCOMMENT='Total soil depth for moisture in ISBA-DIF'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,ZWORK(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
-!
- IF(I%NPATCH>1)THEN
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ZWORK2(1:PK%NSIZE_P,JP),ILU,S%XWORK_WR)
+ ENDDO
+ DEALLOCATE(ZWORK2)
+ !
+ IF(IO%NPATCH>1)THEN
YRECFM='DTOTDF_ISBA'
- YCOMMENT='Averaged Total soil depth for moisture in ISBA-DIF (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,ZDTOT(:),IRESP,YCOMMENT)
+ YCOMMENT='Averaged Total soil depth for moisture in ISBA-DIF'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ZDTOT(:),IRESP,HCOMMENT=YCOMMENT)
ENDIF
-!
-!* Root fraction for each patch
-!
- DO JL=1,SIZE(I%XROOTFRAC,2)
- IF (JL<10) THEN
- WRITE(YRECFM,FMT='(A8,I1)') 'ROOTFRAC',JL
- ELSE
- WRITE(YRECFM,FMT='(A8,I2)') 'ROOTFRAC',JL
- ENDIF
- YCOMMENT='root fraction by layer'
- YCOMMENTUNIT='-'
- ZWORK(:,:)=XUNDEF
- DO JJ=1,SIZE(I%XDG,1)
- WHERE(JL<=I%NWG_LAYER(JJ,:).AND.I%NWG_LAYER(JJ,:)/=NUNDEF)
- ZWORK(JJ,:)=I%XROOTFRAC(JJ,JL,:)
- ENDWHERE
- ENDDO
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,ZWORK(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ !* Root fraction for each patch
+ !
+ ALLOCATE(ZWORK1(ILU))
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ DO JL=1,SIZE(PK%XROOTFRAC,2)
+ IF (JL<10) THEN
+ WRITE(YRECFM,FMT='(A8,I1)') 'ROOTFRAC',JL
+ ELSE
+ WRITE(YRECFM,FMT='(A8,I2)') 'ROOTFRAC',JL
+ ENDIF
+ YCOMMENT='root fraction by layer (-)'
+ ZWORK1(:)=XUNDEF
+ DO JI=1,SIZE(PK%XDG,1)
+ IF(JL<=PK%NWG_LAYER(JI).AND.PK%NWG_LAYER(JI)/=NUNDEF) THEN
+ ZWORK1(JI) = PK%XROOTFRAC(JI,JL)
+ ENDIF
+ ENDDO
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ZWORK1(1:PK%NSIZE_P),ILU,S%XWORK_WR)
+ ENDDO
END DO
+ DEALLOCATE(ZWORK1)
!
- IF (ISIZE_LMEB_PATCH>0) THEN
- DO JL=1,SIZE(I%XROOTFRACGV,2)
- IF (JL<10) THEN
- WRITE(YRECFM,FMT='(A10,I1)') 'ROOTFRACGV',JL
- ELSE
- WRITE(YRECFM,FMT='(A10,I2)') 'ROOTFRACGV',JL
- ENDIF
- YCOMMENT='MEB: understory root fraction by layer'
- YCOMMENTUNIT='-'
- ZWORK(:,:)=XUNDEF
- DO JJ=1,SIZE(I%XDG,1)
- WHERE(JL<=I%NWG_LAYER(JJ,:).AND.I%NWG_LAYER(JJ,:)/=NUNDEF)
- ZWORK(JJ,:)=I%XROOTFRACGV(JJ,JL,:)
- ENDWHERE
- ENDDO
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,ZWORK(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- END DO
- ENDIF
-!
-!* SOC fraction for each layer
-!
- IF(I%LSOC)THEN
- DO JL=1,SIZE(I%XDG,2)
+ !* SOC fraction for each layer
+ !
+ IF(IO%LSOC)THEN
+ DO JL=1,SIZE(NP%AL(1)%XDG,2)
IF (JL<10) THEN
WRITE(YRECFM,FMT='(A7,I1)') 'FRACSOC',JL
ELSE
WRITE(YRECFM,FMT='(A7,I2)') 'FRACSOC',JL
ENDIF
YCOMMENT='SOC fraction by layer (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,I%XFRACSOC(:,JL),IRESP,HCOMMENT=YCOMMENT)
- END DO
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,S%XFRACSOC(:,JL),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
ENDIF
!
ENDIF
!
!-------------------------------------------------------------------------------
!
-DO JL=1,SIZE(I%XDG,2)
- IF (JL<10) THEN
- WRITE(YRECFM,FMT='(A4,I1)') 'WSAT',JL
- ELSE
- WRITE(YRECFM,FMT='(A4,I2)') 'WSAT',JL
- ENDIF
- YCOMMENT='soil porosity by layer (m3/m3)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,I%XWSAT(:,JL),IRESP,HCOMMENT=YCOMMENT)
+DO JL=1,SIZE(NP%AL(1)%XDG,2)
+ IF (JL<10) THEN
+ WRITE(YRECFM,FMT='(A4,I1)') 'WSAT',JL
+ ELSE
+ WRITE(YRECFM,FMT='(A4,I2)') 'WSAT',JL
+ ENDIF
+ YCOMMENT='soil porosity by layer (m3/m3)'
+ CALL WRITE_SURF(HSELECT, &
+ HPROGRAM,YRECFM,K%XWSAT(:,JL),IRESP,HCOMMENT=YCOMMENT)
ENDDO
!
-DO JL=1,SIZE(I%XDG,2)
- IF (JL<10) THEN
- WRITE(YRECFM,FMT='(A3,I1)') 'WFC',JL
- ELSE
- WRITE(YRECFM,FMT='(A3,I2)') 'WFC',JL
- ENDIF
+DO JL=1,SIZE(NP%AL(1)%XDG,2)
+ IF (JL<10) THEN
+ WRITE(YRECFM,FMT='(A3,I1)') 'WFC',JL
+ ELSE
+ WRITE(YRECFM,FMT='(A3,I2)') 'WFC',JL
+ ENDIF
YCOMMENT='field capacity by layer (m3/m3)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,I%XWFC(:,JL),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,K%XWFC(:,JL),IRESP,HCOMMENT=YCOMMENT)
ENDDO
!
-DO JL=1,SIZE(I%XDG,2)
- IF (JL<10) THEN
- WRITE(YRECFM,FMT='(A5,I1)') 'WWILT',JL
- ELSE
- WRITE(YRECFM,FMT='(A5,I2)') 'WWILT',JL
- ENDIF
+DO JL=1,SIZE(NP%AL(1)%XDG,2)
+ IF (JL<10) THEN
+ WRITE(YRECFM,FMT='(A5,I1)') 'WWILT',JL
+ ELSE
+ WRITE(YRECFM,FMT='(A5,I2)') 'WWILT',JL
+ ENDIF
YCOMMENT='wilting point by layer (m3/m3)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,I%XWWILT(:,JL),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,K%XWWILT(:,JL),IRESP,HCOMMENT=YCOMMENT)
ENDDO
!
!-------------------------------------------------------------------------------
@@ -382,47 +382,47 @@ ENDIF
YRECFM='Z0REL'
YCOMMENT='orography roughness length (M)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,I%XZ0REL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ISS%XZ0REL(:),IRESP,HCOMMENT=YCOMMENT)
!
!-------------------------------------------------------------------------------
!
!* Runoff soil ice depth for each patch
!
-IF(I%CHORT=='SGH'.AND.I%CISBA/='DIF')THEN
+IF(IO%CHORT=='SGH'.AND.IO%CISBA/='DIF')THEN
YRECFM='DICE'
- YCOMMENT='soil ice depth for runoff'
- YCOMMENTUNIT='m'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XD_ICE(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YCOMMENT='soil ice depth for runoff (m)'
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NP%AL(JP)%XD_ICE(:),ILU,S%XWORK_WR)
+ ENDDO
ENDIF
!
!-------------------------------------------------------------------------------
!
!* Fraction of each vegetation type in the grid cell
!
-DO JL=1,SIZE(I%XVEGTYPE_PATCH,2)
+DO JL=1,SIZE(S%XVEGTYPE_PATCH,2)
WRITE(YPAS,'(I2)') JL
YLVLV=ADJUSTL(YPAS(:LEN_TRIM(YPAS)))
WRITE(YRECFM,FMT='(A9)') 'VEGTYPE'//YLVLV
- YCOMMENT='fraction of each vegetation type in the grid cell (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,I%XVEGTYPE(:,JL),IRESP,YCOMMENT)
+ YCOMMENT='fraction of each vegetation type in the grid cell'//' (-)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,S%XVEGTYPE(:,JL),IRESP,HCOMMENT=YCOMMENT)
END DO
!-------------------------------------------------------------------------------
!
!* Fraction of each vegetation type for each patch
!
-IF(I%NPATCH>1.AND.SIZE(I%XVEGTYPE_PATCH,2)/=SIZE(I%XVEGTYPE_PATCH,3))THEN
+IF(IO%NPATCH>1.AND.SIZE(S%XVEGTYPE_PATCH,2)/=SIZE(S%XVEGTYPE_PATCH,3))THEN
!
- DO JL=1,SIZE(I%XVEGTYPE_PATCH,2)
+ DO JL=1,SIZE(S%XVEGTYPE_PATCH,2)
WRITE(YPAS,'(I2)') JL
YLVLV=ADJUSTL(YPAS(:LEN_TRIM(YPAS)))
- WRITE(YRECFM,FMT='(A9)') 'VEGTY_P'//YLVLV
- YCOMMENT='fraction of each vegetation type in each patch'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XVEGTYPE_PATCH(:,JL,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ WRITE(YRECFM,FMT='(A9)') 'VEGTY_'//YLVLV
+ YCOMMENT='fraction of each vegetation type in each patch'//' (-)'
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NP%AL(JP)%XVEGTYPE_PATCH(:,JL),ILU,S%XWORK_WR)
+ ENDDO
END DO
!
ENDIF
@@ -432,129 +432,121 @@ ENDIF
!* other surface parameters
!
YRECFM='RSMIN'
-YCOMMENT='minimum stomatal resistance '
-YCOMMENTUNIT='SM-1'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XRSMIN(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+YCOMMENT='minimum stomatal resistance (sm-1)'
+DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XRSMIN(:),ILU,S%XWORK_WR)
+ENDDO
!
YRECFM='GAMMA'
-YCOMMENT='coefficient for RSMIN calculation'
-YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XGAMMA(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+YCOMMENT='coefficient for RSMIN calculation (-)'
+DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XGAMMA(:),ILU,S%XWORK_WR)
+ENDDO
!
YRECFM='CV'
-YCOMMENT='vegetation thermal inertia coefficient'
-YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XCV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+YCOMMENT='vegetation thermal inertia coefficient (-)'
+DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XCV(:),ILU,S%XWORK_WR)
+ENDDO
!
YRECFM='RGL'
-YCOMMENT='maximum solar radiation usable in photosynthesis'
-YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XRGL(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+YCOMMENT='maximum solar radiation usable in photosynthesis (-)'
+DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XRGL(:),ILU,S%XWORK_WR)
+ENDDO
!
YRECFM='EMIS_ISBA'
-YCOMMENT='surface emissivity'
-YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XEMIS(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+YCOMMENT='surface emissivity (-)'
+DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XEMIS(:),ILU,S%XWORK_WR)
+ENDDO
!
YRECFM='WRMAX_CF'
-YCOMMENT='coefficient for maximum water interception'
-YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XWRMAX_CF(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+YCOMMENT='coefficient for maximum water interception (-)'
+DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XWRMAX_CF(:),ILU,S%XWORK_WR)
+ENDDO
!
IF (ISIZE_LMEB_PATCH>0) THEN
!
- YRECFM='RSMINGV'
- YCOMMENT='MEB: understory minimum stomatal resistance'
- YCOMMENTUNIT='SM-1'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XRSMINGV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='GAMMAGV'
- YCOMMENT='MEB: understory coefficient for RSMIN calculation'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XGAMMAGV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='RGLGV'
- YCOMMENT='MEB: understory maximum solar radiation usable in photosynthesis'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XRGLGV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='WRMAX_CFGV'
- YCOMMENT='MEB: understory coefficient for maximum water interception'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XWRMAX_CFGV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
YRECFM='H_VEG'
- YCOMMENT='MEB: height of vegetation'
- YCOMMENTUNIT='M'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XH_VEG(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YCOMMENT='MEB: height of vegetation (m)'
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XH_VEG(:),ILU,S%XWORK_WR)
+ ENDDO
!
ENDIF
!
!-------------------------------------------------------------------------------
!
-IF (DGMI%LSURF_DIAG_ALBEDO) THEN
+IF (OSURF_DIAG_ALBEDO) THEN
!
!* Soil albedos
!
!
- YRECFM='ALBNIR_S'
- YCOMMENT='soil near-infra-red albedo'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XALBNIR_SOIL(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YRECFM='ALBNIR_S'
+ YCOMMENT='soil near-infra-red albedo (-)'
+ DO JP=1,IO%NPATCH
+ CALL UNPACK_SAME_RANK(NP%AL(JP)%NR_P, NPE%AL(JP)%XALBNIR_SOIL, ZWORK(:,JP))
+ WHERE (ZWORK(:,JP)/=XUNDEF) ZWORK(:,1) = ZWORK(:,JP)
+ ENDDO
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ZWORK(:,1),IRESP,HCOMMENT=YCOMMENT)
!
!-------------------------------------------------------------------------------
!
- YRECFM='ALBVIS_S'
- YCOMMENT='soil visible albedo'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XALBVIS_SOIL(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YRECFM='ALBVIS_S'
+ YCOMMENT='soil visible albedo (-)'
+ DO JP=1,IO%NPATCH
+ CALL UNPACK_SAME_RANK(NP%AL(JP)%NR_P, NPE%AL(JP)%XALBVIS_SOIL, ZWORK(:,JP))
+ WHERE (ZWORK(:,JP)/=XUNDEF) ZWORK(:,1) = ZWORK(:,JP)
+ ENDDO
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ZWORK(:,1),IRESP,HCOMMENT=YCOMMENT)
!
!-------------------------------------------------------------------------------
!
- YRECFM='ALBUV_S'
- YCOMMENT='soil UV albedo'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XALBUV_SOIL(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YRECFM='ALBUV_S'
+ YCOMMENT='soil UV albedo (-)'
+ DO JP=1,IO%NPATCH
+ CALL UNPACK_SAME_RANK(NP%AL(JP)%NR_P, NPE%AL(JP)%XALBUV_SOIL, ZWORK(:,JP))
+ WHERE (ZWORK(:,JP)/=XUNDEF) ZWORK(:,1) = ZWORK(:,JP)
+ ENDDO
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ZWORK(:,1),IRESP,HCOMMENT=YCOMMENT)
!
!-------------------------------------------------------------------------------
!
!* albedos
!
- YRECFM='ALBNIR_ISBA'
- YCOMMENT='total near-infra-red albedo'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XALBNIR(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YRECFM='ALBNIR'
+ YCOMMENT='total near-infra-red albedo (-)'
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XALBNIR(:),ILU,S%XWORK_WR)
+ ENDDO
!
!-------------------------------------------------------------------------------
!
- YRECFM='ALBVIS_ISBA'
- YCOMMENT='total visible albedo'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XALBVIS(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YRECFM='ALBVIS'
+ YCOMMENT='total visible albedo (-)'
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XALBVIS(:),ILU,S%XWORK_WR)
+ ENDDO
!
!-------------------------------------------------------------------------------
!
- YRECFM='ALBUV_ISBA'
- YCOMMENT='total UV albedo'
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XALBUV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YRECFM='ALBUV'
+ YCOMMENT='total UV albedo (-)'
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XALBUV(:),ILU,S%XWORK_WR)
+ ENDDO
!
END IF
!
@@ -564,60 +556,68 @@ END IF
!
IF (CHI%CCH_DRY_DEP=='WES89' .AND. CHI%SVI%NBEQ>0) THEN
YRECFM='SOILRC_SO2'
- YCOMMENT='bare soil resistance for SO2'
- YCOMMENTUNIT='?'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,CHI%XSOILRC_SO2(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YCOMMENT='bare soil resistance for SO2 (?)'
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NCHI%AL(JP)%XSOILRC_SO2(:),ILU,S%XWORK_WR)
+ ENDDO
!
YRECFM='SOILRC_O3'
- YCOMMENT='bare soil resistance for O3 '
- YCOMMENTUNIT='?'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,CHI%XSOILRC_O3(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YCOMMENT='bare soil resistance for O3 (?)'
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NCHI%AL(JP)%XSOILRC_O3(:),ILU,S%XWORK_WR)
+ ENDDO
END IF
!
!-------------------------------------------------------------------------------
!
-IF (LAGRIP .AND. (I%CPHOTO=='LAI' .OR. I%CPHOTO=='LST' .OR. I%CPHOTO=='NIT' .OR. I%CPHOTO=='NCB') ) THEN
+IF (LAGRIP .AND. (IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') ) THEN
!
!* seeding and reaping
-!
!
YRECFM='TSEED'
YCOMMENT='date of seeding (-)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,I%TSEED(:,:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_TFIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%TSEED(:),ILU,S%TDATE_WR)
+ ENDDO
!
YRECFM='TREAP'
YCOMMENT='date of reaping (-)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,I%TREAP(:,:),IRESP,HCOMMENT=YCOMMENT)
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_TFIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%TREAP(:),ILU,S%TDATE_WR)
+ ENDDO
!
!-------------------------------------------------------------------------------
!
!* irrigated fraction
!
YRECFM='IRRIG'
- YCOMMENT='flag for irrigation (irrigation if >0.)'
- YCOMMENTUNIT='-'
+ YCOMMENT='flag for irrigation (irrigation if >0.) (-)'
!
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XIRRIG(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XIRRIG(:),ILU,S%XWORK_WR)
+ ENDDO
!
!-------------------------------------------------------------------------------
!
!* water supply for irrigation
!
YRECFM='WATSUP'
- YCOMMENT='water supply during irrigation process '
- YCOMMENTUNIT='mm'
+ YCOMMENT='water supply during irrigation process (mm)'
!
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XWATSUP(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XWATSUP(:),ILU,S%XWORK_WR)
+ ENDDO
!
ENDIF
+!
!-------------------------------------------------------------------------------
! End of IO
!
diff --git a/src/SURFEX/write_diag_pgd_tebn.F90 b/src/SURFEX/write_diag_pgd_tebn.F90
index 3c9402fee7228be2f36fbaecb56f183e8a659c56..2ee531916d017ced354ad375551f7ffcf1d3cd9e 100644
--- a/src/SURFEX/write_diag_pgd_tebn.F90
+++ b/src/SURFEX/write_diag_pgd_tebn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_DIAG_PGD_TEB_n (DTCO, DGU, U, B, BOP, T, TOP, TPN, &
- HPROGRAM)
+ SUBROUTINE WRITE_DIAG_PGD_TEB_n (DTCO, HSELECT, U, B, BOP, T, TOP, TPN, HPROGRAM)
! #########################################
!
!!**** *WRITE_DIAG_PGD_TEB_GARDEN_n* - writes the ISBA physiographic diagnostic fields
@@ -42,7 +41,6 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_BEM_n, ONLY : BEM_t
USE MODD_BEM_OPTION_n, ONLY : BEM_OPTIONS_t
@@ -70,7 +68,7 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(BEM_t), INTENT(INOUT) :: B
TYPE(BEM_OPTIONS_t), INTENT(INOUT) :: BOP
@@ -94,8 +92,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! Initialisation for IO
!
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_TEB_N',0,ZHOOK_HANDLE)
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'TOWN ','TEB ','WRITE')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'TOWN ','TEB ','WRITE','TEB_PGD.OUT.nc')
!
!-------------------------------------------------------------------------------
!
@@ -103,43 +100,35 @@ IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_TEB_N',0,ZHOOK_HANDLE)
!
YRECFM='BLD'
YCOMMENT='building fraction (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XBLD(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XBLD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='WALL_O_HOR'
YCOMMENT='Wall surface over plan area surface (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XWALL_O_HOR(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XWALL_O_HOR(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='BLD_HEIGHT'
YCOMMENT='Building Height (m)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XBLD_HEIGHT(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XBLD_HEIGHT(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='Z0_TOWN'
YCOMMENT='Town roughness length (m)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XZ0_TOWN(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XZ0_TOWN(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='XROAD_DIR'
YCOMMENT='Road direction'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XROAD_DIR(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XROAD_DIR(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='GARDEN_FRAC'
YCOMMENT='Garden fraction (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XGARDEN(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XGARDEN(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='GREENROOF_FRAC'
YCOMMENT='Greenroof fraction (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XGREENROOF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XGREENROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='PANEL_FRAC'
YCOMMENT='Solar Panel fraction (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,TPN%XFRAC_PANEL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,TPN%XFRAC_PANEL(:),IRESP,HCOMMENT=YCOMMENT)
!
!-------------------------------------------------------------------------------
!
@@ -147,114 +136,96 @@ YCOMMENT='Solar Panel fraction (-)'
!
YRECFM='ALB_ROOF'
YCOMMENT='Roof Albedo'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XALB_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XALB_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='EMIS_ROOF'
YCOMMENT='Roof Emissivity'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XEMIS_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XEMIS_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
DO JLAYER=1,TOP%NROOF_LAYER
WRITE(YRECFM,FMT='(A,I1.1)') 'HC_ROOF',JLAYER
YCOMMENT='Roof Heat Capacity'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XHC_ROOF(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XHC_ROOF(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
END DO
!
DO JLAYER=1,TOP%NROOF_LAYER
WRITE(YRECFM,FMT='(A,I1.1)') 'TC_ROOF',JLAYER
YCOMMENT='Roof thermal conductivity'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XTC_ROOF(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XTC_ROOF(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
END DO
!
DO JLAYER=1,TOP%NROOF_LAYER
WRITE(YRECFM,FMT='(A,I1.1)') 'D_ROOF',JLAYER
YCOMMENT='Roof layer thickness'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XD_ROOF(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XD_ROOF(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
END DO
!
YRECFM='ROUGH_ROOF'
YCOMMENT='Roof roughness'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XROUGH_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XROUGH_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='ALB_WALL'
YCOMMENT='WALL Albedo'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XALB_WALL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XALB_WALL(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='EMIS_WALL'
YCOMMENT='WALL Emissivity'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XEMIS_WALL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XEMIS_WALL(:),IRESP,HCOMMENT=YCOMMENT)
!
DO JLAYER=1,TOP%NWALL_LAYER
WRITE(YRECFM,FMT='(A,I1.1)') 'HC_WALL',JLAYER
YCOMMENT='WALL Heat Capacity'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XHC_WALL(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XHC_WALL(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
END DO
!
DO JLAYER=1,TOP%NWALL_LAYER
WRITE(YRECFM,FMT='(A,I1.1)') 'TC_WALL',JLAYER
YCOMMENT='WALL thermal conductivity'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XTC_WALL(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XTC_WALL(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
END DO
!
DO JLAYER=1,TOP%NWALL_LAYER
WRITE(YRECFM,FMT='(A,I1.1)') 'D_WALL',JLAYER
YCOMMENT='WALL layer thickness'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XD_WALL(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XD_WALL(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
END DO
!
YRECFM='ROUGH_WALL'
YCOMMENT='Wall roughness'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XROUGH_WALL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XROUGH_WALL(:),IRESP,HCOMMENT=YCOMMENT)
!
!
YRECFM='RESIDENTIAL'
YCOMMENT='Residential use fraction'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XRESIDENTIAL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XRESIDENTIAL(:),IRESP,HCOMMENT=YCOMMENT)
!-------------------------------------------------------------------------------
!
! Road parameters
!
YRECFM='ALB_ROAD'
YCOMMENT='ROAD Albedo'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XALB_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XALB_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='EMIS_ROAD'
YCOMMENT='ROAD Emissivity'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XEMIS_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XEMIS_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
!
DO JLAYER=1,TOP%NROAD_LAYER
WRITE(YRECFM,FMT='(A,I1.1)') 'HC_ROAD',JLAYER
YCOMMENT='ROAD Heat Capacity'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XHC_ROAD(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XHC_ROAD(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
END DO
!
DO JLAYER=1,TOP%NROAD_LAYER
WRITE(YRECFM,FMT='(A,I1.1)') 'TC_ROAD',JLAYER
YCOMMENT='ROAD thermal conductivity'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XTC_ROAD(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XTC_ROAD(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
END DO
!
DO JLAYER=1,TOP%NROAD_LAYER
WRITE(YRECFM,FMT='(A,I1.1)') 'D_ROAD',JLAYER
YCOMMENT='ROAD layer thickness'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XD_ROAD(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XD_ROAD(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
END DO
!
!-------------------------------------------------------------------------------
@@ -263,23 +234,19 @@ END DO
!
YRECFM='H_TRAFFIC'
YCOMMENT='Traffic Heat Flux'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XH_TRAFFIC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XH_TRAFFIC(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LE_TRAFFIC'
YCOMMENT='Traffic Latent Flux'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XLE_TRAFFIC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XLE_TRAFFIC(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='H_INDUSTRY'
YCOMMENT='INDUSTRY Heat Flux'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XH_INDUSTRY(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XH_INDUSTRY(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LE_INDUSTRY'
YCOMMENT='INDUSTRY Latent Flux'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,T%CUR%XLE_INDUSTRY(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,T%XLE_INDUSTRY(:),IRESP,HCOMMENT=YCOMMENT)
!
!-------------------------------------------------------------------------------
!
@@ -288,28 +255,24 @@ YCOMMENT='INDUSTRY Latent Flux'
IF (TOP%CBEM=='BEM') THEN
YRECFM='N_FLOOR'
YCOMMENT='Number of floors'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,B%CUR%XN_FLOOR(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,B%XN_FLOOR(:),IRESP,HCOMMENT=YCOMMENT)
DO JLAYER=1,BOP%NFLOOR_LAYER
WRITE(YRECFM,FMT='(A,I1.1)') 'HC_FLOOR',JLAYER
YCOMMENT='FLOOR Heat Capacity'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,B%CUR%XHC_FLOOR(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,B%XHC_FLOOR(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
END DO
!
DO JLAYER=1,BOP%NFLOOR_LAYER
WRITE(YRECFM,FMT='(A,I1.1)') 'TC_FLOOR',JLAYER
YCOMMENT='FLOOR thermal conductivity'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,B%CUR%XTC_FLOOR(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,B%XTC_FLOOR(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
END DO
!
DO JLAYER=1,BOP%NFLOOR_LAYER
WRITE(YRECFM,FMT='(A,I1.1)') 'D_FLOOR',JLAYER
YCOMMENT='FLOOR layer thickness'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,B%CUR%XD_FLOOR(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,B%XD_FLOOR(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
END DO
ENDIF
!
diff --git a/src/SURFEX/write_diag_seafluxn.F90 b/src/SURFEX/write_diag_seafluxn.F90
index 4dff67d08435e00bd97f8452eacf16135dfa01d2..596ed80e1c7ab8c6114b48e71756e33bbea65c0f 100644
--- a/src/SURFEX/write_diag_seafluxn.F90
+++ b/src/SURFEX/write_diag_seafluxn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE WRITE_DIAG_SEAFLUX_n (DTCO, DGU, U, SM, &
- HPROGRAM,HWRITE)
+SUBROUTINE WRITE_DIAG_SEAFLUX_n (DTCO, DUO, U, SM, HPROGRAM,HWRITE)
! ###############################################################################
!
!!**** *WRITE_DIAG_SEAFLUX_n * - diagnostics for SEAFLUX
@@ -29,8 +28,10 @@ SUBROUTINE WRITE_DIAG_SEAFLUX_n (DTCO, DGU, U, SM, &
!! Modified 09/2013 : S. Senesi : call WRITE_DIAG_SEB_SEAICE_n
!!------------------------------------------------------------------
!
+USE MODD_SFX_OASIS, ONLY : LCPL_SEAICE
+!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t
@@ -40,7 +41,7 @@ USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODI_WRITE_DIAG_SEB_SEAFLUX_n
USE MODI_WRITE_DIAG_SEB_OCEAN_n
USE MODI_WRITE_DIAG_SEB_SEAICE_n
-!
+USE MODI_WRITE_DIAG_MISC_SEAICE_n
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -51,7 +52,7 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DUO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM
!
@@ -67,14 +68,15 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEAFLUX_N',0,ZHOOK_HANDLE)
IF (HWRITE/='PGD') THEN
!
- IF (SM%DGS%XDIAG_TSTEP==XUNDEF .OR. &
- ABS(NINT(SM%S%TTIME%TIME/SM%DGS%XDIAG_TSTEP)*SM%DGS%XDIAG_TSTEP-SM%S%TTIME%TIME)<1.E-3 ) THEN
- CALL WRITE_DIAG_SEB_SEAFLUX_n(DTCO, DGU, U, SM%CHS, SM%DGS, SM%S, &
- HPROGRAM)
- IF (SM%DGO%LDIAG_OCEAN) CALL WRITE_DIAG_SEB_OCEAN_n(DTCO, DGU, U, SM%DGO, &
- HPROGRAM)
- IF (SM%DGSI%LDIAG_SEAICE) CALL WRITE_DIAG_SEB_SEAICE_n(DTCO, DGU, U, SM%DGS, SM%DGSI, SM%S, &
- HPROGRAM)
+ IF (SM%SD%O%XDIAG_TSTEP==XUNDEF .OR. &
+ ABS(NINT(SM%S%TTIME%TIME/SM%SD%O%XDIAG_TSTEP)*SM%SD%O%XDIAG_TSTEP-SM%S%TTIME%TIME)<1.E-3 ) THEN
+ CALL WRITE_DIAG_SEB_SEAFLUX_n(DTCO, DUO, U, SM%CHS, SM%SD%O, SM%SD%D, SM%SD%DC, &
+ SM%S%LHANDLE_SIC, HPROGRAM)
+ IF (SM%SD%GO%LDIAG_OCEAN) CALL WRITE_DIAG_SEB_OCEAN_n(DTCO, DUO%CSELECT, U, SM%SD%GO, HPROGRAM)
+ IF (SM%S%LHANDLE_SIC.OR.LCPL_SEAICE) CALL WRITE_DIAG_SEB_SEAICE_n(DTCO, DUO, U, SM%SD%O, &
+ SM%SD%DI, SM%SD%DIC, HPROGRAM)
+ IF (SM%SD%DMI%LDIAG_MISC_SEAICE) &
+ CALL WRITE_DIAG_MISC_SEAICE_n(DTCO, DUO%CSELECT, U, SM%SD%DMI, SM%S, HPROGRAM)
END IF
!
ENDIF
diff --git a/src/SURFEX/write_diag_sean.F90 b/src/SURFEX/write_diag_sean.F90
index c1121417a6ba073ff071a64e05c017c8fea9b578..fcc366b2df37ab0d1d37f0f8b427ed22b2e767a3 100644
--- a/src/SURFEX/write_diag_sean.F90
+++ b/src/SURFEX/write_diag_sean.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE WRITE_DIAG_SEA_n (DTCO, DGU, U, SM, &
- HPROGRAM,HWRITE)
+SUBROUTINE WRITE_DIAG_SEA_n (DTCO, DUO, U, SM, HPROGRAM,HWRITE)
! ###############################################################################
!
!!**** *WRITE_DIAG_SEA_n * - Chooses the surface schemes for sea diagnostics
@@ -29,7 +28,7 @@ SUBROUTINE WRITE_DIAG_SEA_n (DTCO, DGU, U, SM, &
!!------------------------------------------------------------------
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t
!
@@ -47,7 +46,7 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DUO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM
!
@@ -63,8 +62,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEA_N',0,ZHOOK_HANDLE)
IF (U%CSEA=='SEAFLX') THEN
- CALL WRITE_DIAG_SEAFLUX_n(DTCO, DGU, U, SM, &
- HPROGRAM,HWRITE)
+ CALL WRITE_DIAG_SEAFLUX_n(DTCO, DUO, U, SM, HPROGRAM,HWRITE)
END IF
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEA_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/write_diag_seb_flaken.F90 b/src/SURFEX/write_diag_seb_flaken.F90
index 0b390bdb1bf386d3f915d0e0d7d58cd1bc141005..1ed8cab571435694a6ad37e98a39b752655a8fbd 100644
--- a/src/SURFEX/write_diag_seb_flaken.F90
+++ b/src/SURFEX/write_diag_seb_flaken.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_DIAG_SEB_FLAKE_n (DTCO, DGU, U, CHF, DGF, &
- HPROGRAM)
+ SUBROUTINE WRITE_DIAG_SEB_FLAKE_n (DTCO, DUO, U, CHF, DFO, D, DC, HPROGRAM)
! #################################
!
!!**** *WRITE_DIAG_SEB_FLAKE_n* - writes FLAKE diagnostics
@@ -40,19 +39,21 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_CH_FLAKE_n, ONLY : CH_FLAKE_t
-USE MODD_DIAG_FLAKE_n, ONLY : DIAG_FLAKE_t
!
-#ifdef SFX_ARO
-USE MODD_IO_SURF_ARO, ONLY : NBLOCK
-#endif
+USE MODD_XIOS, ONLY : LALLOW_ADD_DIM, YSWBAND_DIM_NAME
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
+#ifdef SFX_ARO
+USE MODD_IO_SURF_ARO, ONLY : NBLOCK
+#endif
!
-!
+#ifdef SFX_OL
+USE MODD_IO_SURF_OL, ONLY : LDEF
+#endif
!
USE MODI_INIT_IO_SURF_n
USE MODI_WRITE_SURF
@@ -67,13 +68,13 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DUO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(CH_FLAKE_t), INTENT(INOUT) :: CHF
-TYPE(DIAG_FLAKE_t), INTENT(INOUT) :: DGF
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DFO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
!
@@ -81,9 +82,9 @@ TYPE(DIAG_FLAKE_t), INTENT(INOUT) :: DGF
! -------------------------------
!
INTEGER :: IRESP ! IRESP : return-code if a problem appears
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=100):: YCOMMENT ! Comment string
- CHARACTER(LEN=2) :: YNUM
+CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=100):: YCOMMENT ! Comment string
+CHARACTER(LEN=2) :: YNUM
!
LOGICAL :: GRESET
INTEGER :: JSV, JSW
@@ -98,279 +99,166 @@ GRESET=.TRUE.
#ifdef SFX_ARO
GRESET=(NBLOCK>0)
#endif
+#ifdef SFX_OL
+IF (LDEF) GRESET = .FALSE.
+#endif
!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'WATER ','FLAKE ','WRITE')
+ CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'WATER ','FLAKE ','WRITE','FLAKE_DIAGNOSTICS.OUT.nc')
!
!
!* 2. Richardson number :
! -----------------
!
-IF (DGF%N2M>=1) THEN
+IF (DFO%N2M>=1) THEN
-YRECFM='RI_WAT'
-YCOMMENT='Bulk-Richardson number for water'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XRI(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='RI_WAT'
+ YCOMMENT='Bulk-Richardson number for water'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XRI(:),IRESP,HCOMMENT=YCOMMENT)
!
END IF
!
!* 3. Energy fluxes :
! -------------
!
-IF (DGF%LSURF_BUDGET) THEN
+IF (DFO%LSURF_BUDGET) THEN
-YRECFM='RN_WAT'
-YCOMMENT='net radiation for water'//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XRN(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='H_WAT'
-YCOMMENT='sensible heat flux for water'//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XH(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='LE_WAT'
-YCOMMENT='total latent heat flux for water'//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XLE(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='LEI_WAT'
-YCOMMENT='sublimation latent heat flux for water-ice'//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XLEI(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='GFLUX_WAT'
-YCOMMENT='conduction flux for water'//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='EVAP_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XEVAP(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='SUBL_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XSUBL(:),IRESP,HCOMMENT=YCOMMENT)
-!
-IF (DGF%LRAD_BUDGET) THEN
-!
- YRECFM='SWD_WAT'
- YCOMMENT='short wave downward radiation for water'//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XSWD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SWU_WAT'
- YCOMMENT='short wave upward radiation for water'//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XSWU(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWD_WAT'
- YCOMMENT='downward long wave radiation'//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XLWD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWU_WAT'
- YCOMMENT='upward long wave radiation'//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XLWU(:),IRESP,HCOMMENT=YCOMMENT)
- !
- DO JSW=1, SIZE(DGF%XSWBD,2)
- YNUM=ACHAR(48+JSW)
- !
- YRECFM='SWD_WAT_'//YNUM
- YCOMMENT='downward short wave radiation by spectral band '//' (W/m2)'
+ YRECFM='RN_WAT'
+ YCOMMENT='net radiation for water'//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XRN(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='H_WAT'
+ YCOMMENT='sensible heat flux for water'//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XH(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LE_WAT'
+ YCOMMENT='total latent heat flux for water'//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XLE(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LEI_WAT'
+ YCOMMENT='sublimation latent heat flux for water-ice'//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XLEI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='GFLUX_WAT'
+ YCOMMENT='conduction flux for water'//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='EVAP_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XEVAP(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SUBL_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XSUBL(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF (DFO%LRAD_BUDGET) THEN
+ !
+ YRECFM='SWD_WAT'
+ YCOMMENT='short wave downward radiation for water'//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XSWD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SWU_WAT'
+ YCOMMENT='short wave upward radiation for water'//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XSWU(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWD_WAT'
+ YCOMMENT='downward long wave radiation'//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XLWD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWU_WAT'
+ YCOMMENT='upward long wave radiation'//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XLWU(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF (LALLOW_ADD_DIM) THEN
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XSWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='SWD_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,&
+ HPROGRAM,YRECFM,D%XSWBD(:,:),IRESP,HCOMMENT=YCOMMENT, HNAM_DIM=YSWBAND_DIM_NAME)
!
- YRECFM='SWU_WAT_'//YNUM
- YCOMMENT='upward short wave radiation by spectral band'//' (W/m2)'
+ YRECFM='SWU_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,&
+ HPROGRAM,YRECFM,D%XSWBD(:,:),IRESP,HCOMMENT=YCOMMENT, HNAM_DIM=YSWBAND_DIM_NAME)
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XSWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ ELSE
+ !
+ DO JSW=1, SIZE(D%XSWBD,2)
+ YNUM=ACHAR(48+JSW)
+ !
+ YRECFM='SWD_WAT_'//YNUM
+ YCOMMENT='downward short wave radiation by spectral band '//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XSWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SWU_WAT_'//YNUM
+ YCOMMENT='upward short wave radiation by spectral band'//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XSWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDDO
!
- ENDDO
-!
-ENDIF
-!
-YRECFM='FMU_WAT'
-YCOMMENT='u-component of momentum flux for water'//' (kg/ms2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XFMU(:),IRESP,HCOMMENT=YCOMMENT)
-YRECFM='FMV_WAT'
-YCOMMENT='v-component of momentum flux for water'//' (kg/ms2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XFMV(:),IRESP,HCOMMENT=YCOMMENT)
-!
+ ENDIF
+ !
+ ENDIF
+ !
+ YRECFM='FMU_WAT'
+ YCOMMENT='u-component of momentum flux for water'//' (kg/ms2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XFMU(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='FMV_WAT'
+ YCOMMENT='v-component of momentum flux for water'//' (kg/ms2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XFMV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
END IF
!
-IF (DGF%LSURF_BUDGET.OR.DGF%LSURF_BUDGETC) THEN
+IF (DFO%LSURF_BUDGET.OR.DFO%LSURF_BUDGETC) THEN
!
YRECFM='TALB_WAT'
YCOMMENT='total albedo over tile water (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XALBT(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XALBT(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='WSN_WAT'
YCOMMENT='snow water equivalent over tile water (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XSWE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XSWE(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
-IF (DGF%LSURF_BUDGETC) THEN
-!
-YRECFM='RNC_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XRNC(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='HC_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XHC(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='LEC_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XLEC(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='LEIC_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XLEIC(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='GFLUXC_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XGFLUXC(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='EVAPC_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XEVAPC(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='SUBLC_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XSUBLC(:),IRESP,HCOMMENT=YCOMMENT)
-!
-IF (DGF%LRAD_BUDGET .OR. (DGF%LSURF_BUDGETC .AND. .NOT.DGU%LRESET_BUDGETC)) THEN
-!
- YRECFM='SWDC_WAT'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XSWDC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SWUC_WAT'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XSWUC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWDC_WAT'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XLWDC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWUC_WAT'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XLWUC(:),IRESP,HCOMMENT=YCOMMENT)
-!
-ENDIF
-!
-YRECFM='FMUC_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XFMUC(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='FMVC_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XFMVC(:),IRESP,HCOMMENT=YCOMMENT)
-!
-END IF
-!
!
!* 4. Transfer coefficients
! ---------------------
!
-IF (DGF%LCOEF) THEN
-
-YRECFM='CD_WAT'
-YCOMMENT='drag coefficient for wind over water (W/s2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XCD(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='CH_WAT'
-YCOMMENT='drag coefficient for heat (W/s)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XCH(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='CE_WAT'
-YCOMMENT='drag coefficient for vapor (W/s/K)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XCE(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='Z0_WAT'
-YCOMMENT='roughness length over water (m)'
+IF (DFO%LCOEF) THEN
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XZ0(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='Z0H_WAT'
-YCOMMENT='thermal roughness length over water (m)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XZ0H(:),IRESP,HCOMMENT=YCOMMENT)
-!
+ YRECFM='CD_WAT'
+ YCOMMENT='drag coefficient for wind over water (W/s2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XCD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='CH_WAT'
+ YCOMMENT='drag coefficient for heat (W/s)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XCH(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='CE_WAT'
+ YCOMMENT='drag coefficient for vapor (W/s/K)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XCE(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='Z0_WAT'
+ YCOMMENT='roughness length over water (m)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,D%XZ0(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='Z0H_WAT'
+ YCOMMENT='thermal roughness length over water (m)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XZ0H(:),IRESP,HCOMMENT=YCOMMENT)
+ !
END IF
!
!
!* 5. Surface humidity
! ----------------
!
-IF (DGF%LSURF_VARS) THEN
+IF (DFO%LSURF_VARS) THEN
-YRECFM='QS_WAT'
-YCOMMENT='specific humidity over water'//' (KG/KG)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XQS(:),IRESP,HCOMMENT=YCOMMENT)
-!
+ YRECFM='QS_WAT'
+ YCOMMENT='specific humidity over water'//' (KG/KG)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XQS(:),IRESP,HCOMMENT=YCOMMENT)
+ !
ENDIF
!
@@ -378,79 +266,57 @@ ENDIF
!* 6. parameters at 2 and 10 meters :
! -----------------------------
!
-IF (DGF%N2M>=1) THEN
-!
-YRECFM='T2M_WAT'
-YCOMMENT='2 meters temperature'//' (K)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XT2M(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='T2MMIN_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (K)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XT2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
-IF(GRESET)DGF%XT2M_MIN(:)=XUNDEF
-!
-YRECFM='T2MMAX_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (K)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XT2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
-IF(GRESET)DGF%XT2M_MAX(:)=0.0
-!
-YRECFM='Q2M_WAT'
-YCOMMENT='2 meters specific humidity'//' (KG/KG)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XQ2M(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='HU2M_WAT'
-YCOMMENT='2 meters relative humidity'//' (KG/KG)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XHU2M(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='HU2MMIN_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (-)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XHU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
-IF(GRESET)DGF%XHU2M_MIN(:)=XUNDEF
-!
-YRECFM='HU2MMAX_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (-)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XHU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
-IF(GRESET)DGF%XHU2M_MAX(:)=-XUNDEF
-!
-YRECFM='ZON10M_WAT'
-YCOMMENT='10 meters zonal wind'//' (M/S)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XZON10M(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='MER10M_WAT'
-YCOMMENT='10 meters meridian wind'//' (M/S)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XMER10M(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='W10M_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (M/S)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XWIND10M(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='W10MMAX_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (M/S)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XWIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
-IF(GRESET)DGF%XWIND10M_MAX(:)=0.0
-!
+IF (DFO%N2M>=1) THEN
+ !
+ YRECFM='T2M_WAT'
+ YCOMMENT='2 meters temperature'//' (K)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XT2M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='T2MMIN_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (K)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XT2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)D%XT2M_MIN(:)=XUNDEF
+ !
+ YRECFM='T2MMAX_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (K)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XT2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)D%XT2M_MAX(:)=0.0
+ !
+ YRECFM='Q2M_WAT'
+ YCOMMENT='2 meters specific humidity'//' (KG/KG)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XQ2M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='HU2M_WAT'
+ YCOMMENT='2 meters relative humidity'//' (KG/KG)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XHU2M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='HU2MMIN_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (-)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XHU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)D%XHU2M_MIN(:)=XUNDEF
+ !
+ YRECFM='HU2MMAX_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (-)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XHU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)D%XHU2M_MAX(:)=-XUNDEF
+ !
+ YRECFM='ZON10M_WAT'
+ YCOMMENT='10 meters zonal wind'//' (M/S)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XZON10M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='MER10M_WAT'
+ YCOMMENT='10 meters meridian wind'//' (M/S)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XMER10M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='W10M_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (M/S)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XWIND10M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='W10MMAX_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (M/S)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XWIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)D%XWIND10M_MAX(:)=0.0
+ !
END IF
!
!
@@ -459,10 +325,9 @@ END IF
!
IF (CHF%SVF%NBEQ>0 .AND. CHF%CCH_DRY_DEP=="WES89 ") THEN
DO JSV = 1,SIZE(CHF%CCH_NAMES,1)
- YRECFM='DV_WAT_'//TRIM(CHF%CCH_NAMES(JSV))
+ YRECFM='DVWT'//TRIM(CHF%CCH_NAMES(JSV))
WRITE(YCOMMENT,'(A13,I3.3)')'(m/s) DV_WAT_',JSV
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,CHF%XDEP(:,JSV),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,CHF%XDEP(:,JSV),IRESP,HCOMMENT=YCOMMENT)
END DO
ENDIF
!
@@ -470,15 +335,77 @@ ENDIF
!* 8. prognostic variable diagnostics:
! --------------------------------
!
-IF(DGU%LPROVAR_TO_DIAG)THEN
+IF(DUO%LPROVAR_TO_DIAG)THEN
!
- YRECFM='TS_WATER'
+ YRECFM='TS_WAT'
YCOMMENT='TS_WATER (K)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGF%XDIAG_TS(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XTS(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
+IF (DFO%LSURF_BUDGETC) THEN
+ !
+ CALL END_IO_SURF_n(HPROGRAM)
+ CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'WATER ','FLAKE ','WRITE','FLAKE_DIAGNOSTICS.OUT.nc')
+ !
+ YRECFM='RNC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XRN(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='HC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XH(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LEC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XLE(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LEIC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XLEI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='GFLUXC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='EVAPC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XEVAP(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SUBLC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XSUBL(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF (DFO%LRAD_BUDGET .OR. (DFO%LSURF_BUDGETC .AND. .NOT.DUO%LRESET_BUDGETC)) THEN
+ !
+ YRECFM='SWDC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XSWD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SWUC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XSWU(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWDC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XLWD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWUC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XLWU(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDIF
+ !
+ YRECFM='FMUC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XFMU(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='FMVC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XFMV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+END IF
+!
!-------------------------------------------------------------------------------
!
! End of IO
diff --git a/src/SURFEX/write_diag_seb_isban.F90 b/src/SURFEX/write_diag_seb_isban.F90
index e8ca82fa3c219512b5b3a4af163dd48375161f08..11f7ee406a819f07709cc5228d6c7ade3304c7ee 100644
--- a/src/SURFEX/write_diag_seb_isban.F90
+++ b/src/SURFEX/write_diag_seb_isban.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_DIAG_SEB_ISBA_n ( DTCO, DGU, U, CHI, DGEI, DGI, DST, GB, I, &
- HPROGRAM)
+ SUBROUTINE WRITE_DIAG_SEB_ISBA_n ( DTCO, DUO, U, NCHI, CHI, ID, NDST, GB, &
+ IO, S, NP, NPE, HPROGRAM)
! #################################
!
!!**** *WRITE_DIAG_SEB_ISBA* - writes the ISBA diagnostic fields
@@ -40,43 +40,50 @@
!! when coupled with ARPEGE/ALADIN/AROME
!! P. Samuelsson 10/2014 MEB
!! B. Decharme 02/2016 : NBLOCK instead of LCOUNTW for compilation in AAA
-!! M.Moge 01/2016 using WRITE_SURF_FIELD2D/3D for 2D/3D surfex fields writes
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
-USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
-USE MODD_DIAG_ISBA_n, ONLY : DIAG_ISBA_t
-USE MODD_DST_n, ONLY : DST_t
+USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t, CH_ISBA_NP_t
+USE MODD_SURFEX_n, ONLY : ISBA_DIAG_t
+USE MODD_DST_n, ONLY : DST_NP_t
USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t
-USE MODD_ISBA_n, ONLY : ISBA_t
-!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_NP_t, ISBA_P_t, ISBA_NPE_t, ISBA_PE_t, ISBA_S_t
!
#ifdef SFX_ARO
USE MODD_IO_SURF_ARO, ONLY : NBLOCK
#endif
!
+USE MODD_XIOS, ONLY : LALLOW_ADD_DIM, YGROUND_LAYER_DIM_NAME, &
+ YWGROUND_LAYER_DIM_NAME, YWIGROUND_LAYER_DIM_NAME, &
+ YSWBAND_DIM_NAME
+!
USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
!
USE MODD_CSTS, ONLY : XRHOLW, XTT, XLMTT
!
+USE MODD_DST_SURF
!
+USE MODD_AGRI, ONLY : LAGRIP
!
-USE MODD_AGRI , ONLY : LAGRIP
-!
+USE MODE_DIAG
!
USE MODI_INIT_IO_SURF_n
USE MODI_WRITE_SURF
-USE MODI_WRITE_SURF_FIELD2D
USE MODI_END_IO_SURF_n
+USE MODI_WRITE_FIELD_1D_PATCH
!
-USE MODD_DST_SURF
+#ifdef SFX_OL
+USE MODD_IO_SURF_OL, ONLY : LDEF
+USE MODN_IO_OFFLINE, ONLY : XTSTEP_OUTPUT
+#endif
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -88,28 +95,33 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DUO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(CH_ISBA_NP_t), INTENT(INOUT) :: NCHI
TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
-TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DGEI
-TYPE(DIAG_ISBA_t), INTENT(INOUT) :: DGI
-TYPE(DST_t), INTENT(INOUT) :: DST
+TYPE(ISBA_DIAG_t), INTENT(INOUT) :: ID
+TYPE(DST_NP_t), INTENT(INOUT) :: NDST
TYPE(GR_BIOG_t), INTENT(INOUT) :: GB
-TYPE(ISBA_t), INTENT(INOUT) :: I
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
!
!* 0.2 Declarations of local variables
! -------------------------------
!
+TYPE(ISBA_P_t), POINTER :: PK
+TYPE(ISBA_PE_t), POINTER :: PEK
+!
INTEGER :: IRESP ! IRESP : return-code if a problem appears
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be write
- CHARACTER(LEN=100):: YCOMMENT ! Comment string
- CHARACTER(LEN=100):: YCOMMENTUNIT ! Comment string : unit of the datas in the field to write
- CHARACTER(LEN=2) :: YNUM
+CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be write
+CHARACTER(LEN=100):: YCOMMENT ! Comment string
+CHARACTER(LEN=2) :: YNUM
!
LOGICAL :: GRESET
-INTEGER :: JSV, JSW
+INTEGER :: JSV, JSW, JP, ISIZE
INTEGER :: ISIZE_LMEB_PATCH ! Number of patches where multi-energy balance should be applied
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -119,2125 +131,1623 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N',0,ZHOOK_HANDLE)
!
-ISIZE_LMEB_PATCH=COUNT(I%LMEB_PATCH(:))
+ISIZE_LMEB_PATCH=COUNT(IO%LMEB_PATCH(:))
!
GRESET=.TRUE.
#ifdef SFX_ARO
GRESET=(NBLOCK>0)
#endif
+#ifdef SFX_OL
+IF (LDEF) GRESET = .FALSE.
+#endif
+!
+#ifdef SFX_OL
+IF (ID%O%LSURF_BUDGET .AND. DUO%LRESETCUMUL .AND. ID%O%LSURF_BUDGETC .AND. .NOT.LDEF) THEN
+ !
+ ! Output variables are not instantaneous but averaged over the output time step
+ ! Fluxes by patch
+ DO JP = 1,IO%NPATCH
+ CALL AVG_DIAG_TSTEP_SURF(XTSTEP_OUTPUT, ID%NDC%AL(JP), ID%ND%AL(JP))
+ ENDDO
+ CALL AVG_DIAG_TSTEP_SURF(XTSTEP_OUTPUT, ID%DC, ID%D)
+ !
+ IF (ID%DE%LSURF_EVAP_BUDGET) THEN
+ DO JP = 1,IO%NPATCH
+ CALL AVG_DIAG_TSTEP_EVAP(XTSTEP_OUTPUT, ID%NDEC%AL(JP), ID%NDE%AL(JP))
+ ENDDO
+ CALL AVG_DIAG_TSTEP_EVAP(XTSTEP_OUTPUT, ID%DEC, ID%DE)
+ !
+ IF (ID%DE%LWATER_BUDGET) THEN
+ DO JP = 1,IO%NPATCH
+ CALL AVG_DIAG_TSTEP_WATER(XTSTEP_OUTPUT, ID%NDEC%AL(JP), ID%NDE%AL(JP))
+ ENDDO
+ CALL AVG_DIAG_TSTEP_WATER(XTSTEP_OUTPUT, ID%DEC, ID%DE)
+ ENDIF
+ ENDIF
+ !
+END IF
+#endif
!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'NATURE','ISBA ','WRITE')
+IF ( ID%DM%LPROSNOW ) THEN
+ CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'NATURE','ISBA ','WRITE','ISBA_PROGNOSTIC.OUT.nc')
+ELSE
+ CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'NATURE','ISBA ','WRITE','ISBA_DIAGNOSTICS.OUT.nc')
+ENDIF
!
!-------------------------------------------------------------------------------
!
!* 2. Richardson number :
! -----------------
!
-IF (DGI%N2M>=1) THEN
+IF (ID%O%N2M>=1) THEN
!
YRECFM='RI_ISBA'
YCOMMENT='Richardson number over tile nature'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_RI(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XRI(:),IRESP,HCOMMENT=YCOMMENT)
!
END IF
!
!* 3. Energy fluxes :
! -------------
!
-IF (DGI%LSURF_BUDGET) THEN
+IF (ID%O%LSURF_BUDGET) THEN
!
+ YRECFM='TALB_ISBA'
+ YCOMMENT='total albedo over tile nature (-)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,ID%D%XALBT(:),IRESP,HCOMMENT=YCOMMENT)
+ !
YRECFM='RN_ISBA'
YCOMMENT='Net radiation over tile nature'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_RN(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XRN(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='H_ISBA'
YCOMMENT='Sensible heat flux over tile nature'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_H(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XH(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LE_ISBA'
YCOMMENT='total latent heat flux over tile nature'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_LE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XLE(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LEI_ISBA'
YCOMMENT='sublimation latent heat flux over tile nature'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_LEI(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XLEI(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='GFLUX_ISBA'
YCOMMENT='Ground flux over tile nature'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_GFLUX(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
!
- IF (DGI%LRAD_BUDGET .OR. (DGEI%LSURF_BUDGETC .AND. .NOT.DGU%LRESET_BUDGETC)) THEN
+ YRECFM='EVAP_ISBA'
+ YCOMMENT='total evaporative flux for tile nature'//' (Kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,ID%D%XEVAP(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SUBL_ISBA'
+ YCOMMENT='sublimation flux for tile nature'//' (Kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,ID%D%XSUBL(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF (ID%O%LRAD_BUDGET .OR. (ID%O%LSURF_BUDGETC .AND. .NOT.DUO%LRESET_BUDGETC)) THEN
!
YRECFM='SWD_ISBA'
YCOMMENT='short wave downward radiation over tile nature'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_SWD(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XSWD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='SWU_ISBA'
YCOMMENT='short wave upward radiation over tile nature'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_SWU(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XSWU(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LWD_ISBA'
YCOMMENT='long wave downward radiation over tile nature'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_LWD(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XLWD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LWU_ISBA'
YCOMMENT='long wave upward radiation over tile nature'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_LWU(:),IRESP,HCOMMENT=YCOMMENT)
- !
- DO JSW=1, SIZE(DGI%XSWBD,2)
- YNUM=ACHAR(48+JSW)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XLWU(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF (LALLOW_ADD_DIM) THEN
!
- YRECFM='SWD_ISBA_'//YNUM
- YCOMMENT='short wave downward radiation over tile nature for spectral band'//YNUM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_SWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='SWD_ISBA_'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,&
+ HPROGRAM,YRECFM,ID%D%XSWBD(:,:),IRESP,HCOMMENT=YCOMMENT, HNAM_DIM=YSWBAND_DIM_NAME)
!
- YRECFM='SWU_ISBA_'//YNUM
- YCOMMENT='short wave upward radiation over tile nature for spectral band'//YNUM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_SWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='SWU_ISBA_'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,&
+ HPROGRAM,YRECFM,ID%D%XSWBU(:,:),IRESP,HCOMMENT=YCOMMENT, HNAM_DIM=YSWBAND_DIM_NAME)
!
- ENDDO
+ ELSE
+ !
+ DO JSW=1, SIZE(ID%D%XSWBD,2)
+ YNUM=ACHAR(48+JSW)
+ !
+ YRECFM='SWD_ISBA_'//YNUM
+ YCOMMENT='short wave downward radiation over tile nature for spectral band'//YNUM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XSWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SWU_ISBA_'//YNUM
+ YCOMMENT='short wave upward radiation over tile nature for spectral band'//YNUM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XSWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDDO
+ !
+ ENDIF
!
ENDIF
!
YRECFM='FMU_ISBA'
YCOMMENT='u component of wind stress'//' (Pa)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_FMU(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XFMU(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='FMV_ISBA'
YCOMMENT='v component of wind stress'//' (Pa)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_FMV(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XFMV(:),IRESP,HCOMMENT=YCOMMENT)
!
END IF
!
!* 4. Specific Energy fluxes :(for each patch)
! ----------------------------------------
!
-IF (DGEI%LSURF_EVAP_BUDGET) THEN
- !
- YRECFM='LEG_ISBA'
- YCOMMENT='bare ground evaporation for tile nature'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LEG(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEGI_ISBA'
- YCOMMENT='bare ground sublimation for tile nature'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LEGI(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEV_ISBA'
- YCOMMENT='total vegetation evaporation for tile nature'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LEV(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LES_ISBA'
- YCOMMENT='snow sublimation for tile nature'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LES(:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF(I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO')THEN
- YRECFM='LESL_ISBA'
- YCOMMENT='liquid water evaporation over snow for tile nature'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LESL(:),IRESP,HCOMMENT=YCOMMENT)
- YRECFM='SNDRIF_ISBA'
- YCOMMENT='blowing snow sublimation for tile nature'//' (Kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_SNDRIFT(:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- !
- YRECFM='LER_ISBA'
- YCOMMENT='canopy direct evaporation for tile nature'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LER(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LETR_ISBA'
- YCOMMENT='vegetation transpiration for tile nature'//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LETR(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='EVAP_ISBA'
- YCOMMENT='total evaporative flux for tile nature'//' (Kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_EVAP(:),IRESP,HCOMMENT=YCOMMENT)
+IF (ID%DE%LSURF_EVAP_BUDGET) CALL WRITE_EVAP_BUD(ID%DE,"_ISBA ",.FALSE.)
+!
+!* 6. parameters at 2 and 10 meters :
+! -------------------------------
+!
+IF (ID%O%N2M>=1) THEN
!
- YRECFM='SUBL_ISBA'
- YCOMMENT='sublimation flux for tile nature'//' (Kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_SUBL(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DRAIN_ISBA'
- YCOMMENT='drainage for tile nature'//' (Kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_DRAIN(:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF(I%CRUNOFF=='SGH'.AND.I%CISBA=='DIF')THEN
- YRECFM='QSB_ISBA'
- YCOMMENT='lateral subsurface flow for tile nature'//' (Kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_QSB(:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
+ YRECFM='T2M_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (K)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XT2M(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='RUNOFF_ISBA'
- YCOMMENT='runoff for tile nature'//' (Kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_RUNOFF(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='T2MMIN_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (K)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XT2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)ID%D%XT2M_MIN(:)=XUNDEF
!
- IF(I%CHORT=='SGH'.OR.I%CISBA=='DIF')THEN
- YRECFM='HORTON_ISBA'
- YCOMMENT='horton runoff for tile nature'//' (Kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_HORT(:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
+ YRECFM='T2MMAX_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (K)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XT2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)ID%D%XT2M_MAX(:)=-XUNDEF
!
- YRECFM='DRIVEG_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_DRIP(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='Q2M_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XQ2M(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='RRVEG_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_RRVEG(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SNOMLT_ISBA'
- YCOMMENT='snow melting rate'//' (Kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_MELT(:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF(LAGRIP)THEN
- YRECFM='IRRIG_ISBA'
- YCOMMENT='irrigation rate'//' (Kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_IRRIG_FLUX(:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
-! MEB STUFF
- IF (ISIZE_LMEB_PATCH>0) THEN
- YRECFM='LEVCV_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LEVCV(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LESC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LESC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LETRGV_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LETRGV(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LETRCV_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LETRCV(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LERGV_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LERGV(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LELIT_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LELITTER(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LELITI_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LELITTERI(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DRIPLIT_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_DRIPLIT(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='RRLIT_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_RRLIT(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LERCV_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LERCV(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LE_C_A_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LE_C_A(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LE_V_C_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LE_V_C(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LE_G_C_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LE_G_C(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LE_N_C_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LE_N_C(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SWNT_V_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_SWNET_V(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SWNT_G_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_SWNET_G(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SWNT_N_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_SWNET_N(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SWNT_NS_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_SWNET_NS(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWNT_V_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LWNET_V(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWNT_G_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LWNET_G(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWNT_N_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LWNET_N(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SWDN_GN_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_SWDOWN_GN(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWDN_GN_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LWDOWN_GN(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='H_V_C_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_H_V_C(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='H_G_C_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_H_G_C(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='H_C_A_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_H_C_A(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='H_N_C_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_H_N_C(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SR_GN_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_SR_GN(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='MELTCV_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_MELTCV(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='FRZCV_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_FRZCV(:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- ! END MEB STUFF
+ YRECFM='HU2M_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (-)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XHU2M(:),IRESP,HCOMMENT=YCOMMENT)
!
- IF(I%LFLOOD)THEN
- !
- YRECFM='IFLOOD_ISBA'
- YCOMMENT='flood soil infiltration (Kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_IFLOOD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='PFLOOD_ISBA'
- YCOMMENT='intercepted precipitation by floodplains (Kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_PFLOOD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEF_ISBA'
- YCOMMENT='total floodplains evaporation (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LE_FLOOD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEIF_ISBA'
- YCOMMENT='solid floodplains evaporation (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LEI_FLOOD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
+ YRECFM='HU2MMIN_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (-)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XHU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)ID%D%XHU2M_MIN(:)=XUNDEF
!
- IF(I%CPHOTO/='NON')THEN
- !
- YRECFM='GPP_ISBA'
- YCOMMENT='gross primary production over tile nature (kgCO2/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_GPP(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='R_AUTO_ISBA'
- YCOMMENT='autotrophic respiration over tile nature (kgCO2/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_RESP_AUTO(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='R_ECO_ISBA'
- YCOMMENT='ecosystem respiration over tile nature (kgCO2/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_RESP_ECO(:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
- IF(DGEI%LWATER_BUDGET)THEN
- !
- YRECFM='RAINF_ISBA'
- YCOMMENT='input rainfall rate (Kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XRAINFALL(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SNOWF_ISBA'
- YCOMMENT='input snowfall rate (Kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XSNOWFALL(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DWG_ISBA'
- YCOMMENT='change in liquid soil moisture (Kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_DWG(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DWGI_ISBA'
- YCOMMENT='change in solid soil moisture (Kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_DWGI(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DWR_ISBA'
- YCOMMENT='change in water on canopy (Kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_DWR(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DSWE_ISBA'
- YCOMMENT='change in snow water equivalent (Kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_DSWE(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='WATBUD_ISBA'
- YCOMMENT='isba water budget as residue (Kg/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_WATBUD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
-ENDIF
-!
-!* 5. Cumulated Energy fluxes
-! -----------------------
-!
-IF (DGEI%LSURF_BUDGETC) THEN
+ YRECFM='HU2MMAX_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (-)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XHU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)ID%D%XHU2M_MAX(:)=-XUNDEF
!
- YRECFM='LEGC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LEGC(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='ZON10M_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (M/S)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XZON10M(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='LEGIC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LEGIC(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='MER10M_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (M/S)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XMER10M(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='LEVC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LEVC(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='W10M_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (M/S)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XWIND10M(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='LESC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LESAC(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='W10MMAX_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (M/S)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XWIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)ID%D%XWIND10M_MAX(:)=0.0
!
- IF(I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO')THEN
- YRECFM='LESLC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LESLC(:),IRESP,HCOMMENT=YCOMMENT)
- YRECFM='SNDRIFC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_SNDRIFTC(:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
+ YRECFM='SFCO2_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (M.kgCO2.S-1.kgAIR-1)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XSFCO2(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='LERC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LERC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LETRC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LETRC(:),IRESP,HCOMMENT=YCOMMENT)
+END IF
+!----------------------------------------------------------------------------
+!
+!* 7. Transfer coefficients
+! ---------------------
+!
+IF (ID%O%LCOEF) THEN
!
- YRECFM='EVAPC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_EVAPC(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='CD_ISBA'
+ YCOMMENT='X_Y_'//YRECFM
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XCD(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='SUBLC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_SUBLC(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='CH_ISBA'
+ YCOMMENT='X_Y_'//YRECFM
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XCH(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='DRAINC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_DRAINC(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='CE_ISBA'
+ YCOMMENT='X_Y_'//YRECFM
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XCE(:),IRESP,HCOMMENT=YCOMMENT)
!
- IF(I%CRUNOFF=='SGH'.AND.I%CISBA=='DIF')THEN
- YRECFM='QSBC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_QSBC(:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
+ YRECFM='Z0_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (M)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XZ0(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='RUNOFFC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_RUNOFFC(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='Z0H_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (M)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XZ0H(:),IRESP,HCOMMENT=YCOMMENT)
!
- IF(I%CHORT=='SGH'.OR.I%CISBA=='DIF')THEN
- YRECFM='HORTONC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_HORTC(:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
+ENDIF
+!
+!----------------------------------------------------------------------------
+!
+!* 8. Surface humidity
+! ----------------
+IF (ID%O%LSURF_VARS) THEN
!
- YRECFM='DRIVEGC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_DRIPC(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='QS_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XQS(:),IRESP,HCOMMENT=YCOMMENT)
!
- YRECFM='RRVEGC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_RRVEGC(:),IRESP,HCOMMENT=YCOMMENT)
+ENDIF
+!
+!----------------------------------------------------------------------------
+!
+ISIZE = U%NSIZE_NATURE
+!
+!User want (or not) patch output
+IF (ID%O%LPATCH_BUDGET.AND.(IO%NPATCH >1)) THEN
+ !
+ !* 10. Richardson number (for each patch)
+ ! -----------------
+ !
+ IF (ID%O%N2M>=1) THEN
+ !
+ YRECFM='RI_'
+ YCOMMENT='X_Y_'//YRECFM
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XRI(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ END IF
!
- YRECFM='SNOMLTC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_MELTC(:),IRESP,HCOMMENT=YCOMMENT)
+ !* 11. Energy fluxes :(for each patch)
+ ! -------------
!
- ! MEB STUFF
- IF (ISIZE_LMEB_PATCH>0) THEN
- YRECFM='LEVCVC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LEVCVC(:),IRESP,HCOMMENT=YCOMMENT)
+ IF (ID%O%LSURF_BUDGET) THEN
!
- YRECFM='LESCC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LESCC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LETRGVC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LETRGVC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LETRCVC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LETRCVC(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='TALB_'
+ YCOMMENT='total albedo per patch'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XALBT(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
- YRECFM='LERGVC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LERGVC(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='RN_'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XRN(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
- YRECFM='LERCVC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LERCVC(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='H_'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XH(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
- YRECFM='LE_C_AC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LE_C_AC(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='LE_'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XLE(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='LEI_'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XLEI(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='GFLUX_'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XGFLUX(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='EVAP_'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XEVAP(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
- YRECFM='LE_V_CC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LE_V_CC(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='SUBL_'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XSUBL(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ IF (ID%O%LRAD_BUDGET .OR. (ID%O%LSURF_BUDGETC .AND. .NOT.DUO%LRESET_BUDGETC)) THEN
+ !
+ YRECFM='SWD_'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XSWD(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='SWU_'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XSWU(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='LWD_'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XLWD(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='LWU_'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XLWU(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ DO JSW=1, SIZE(ID%D%XSWBD,2)
+ YNUM=ACHAR(48+JSW)
+ !
+ YRECFM='SWD_'//YNUM
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XSWD(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='SWU_'//YNUM
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XSWU(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ ENDDO
+ !
+ ENDIF
!
- YRECFM='LE_G_CC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LE_G_CC(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='FMU_'
+ YCOMMENT='X_Y_'//YRECFM//' (Pa)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XFMU(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
- YRECFM='LE_N_CC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LE_N_CC(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='FMV_'
+ YCOMMENT='X_Y_'//YRECFM//' (Pa)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XFMV(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
- YRECFM='SWNT_VC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_SWNET_VC(:),IRESP,HCOMMENT=YCOMMENT)
+ END IF
+ !
+ !* 12. Specific Energy fluxes :(for each patch)
+ ! ----------------------------------------
+ !
+ IF (ID%DE%LSURF_EVAP_BUDGET) CALL WRITE_EVAP_BUD_PATCH(ID%NDE,'_ ',.FALSE.)
+ !
+ !* 13. surface temperature parameters at 2 and 10 meters (for each patch):
+ ! -------------------------------------------------------------------
+ !
+ IF (ID%O%N2M>=1.AND..NOT.IO%LCANOPY) THEN
!
- YRECFM='SWNT_GC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_SWNET_GC(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='T2M_'
+ YCOMMENT='X_Y_'//YRECFM//' (K)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XT2M(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
- YRECFM='SWNT_NC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_SWNET_NC(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='T2MMIN_'
+ YCOMMENT='X_Y_'//YRECFM//' (K)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XT2M_MIN(:),ISIZE,S%XWORK_WR)
+ IF (GRESET) ID%ND%AL(JP)%XT2M_MIN(:)=XUNDEF
+ ENDDO
+ !
+ YRECFM='T2MMAX_'
+ YCOMMENT='X_Y_'//YRECFM//' (K)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XT2M_MAX(:),ISIZE,S%XWORK_WR)
+ IF (GRESET) ID%ND%AL(JP)%XT2M_MAX(:)=-XUNDEF
+ ENDDO
+ !
+ YRECFM='Q2M_'
+ YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XQ2M(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
- YRECFM='SWNT_NSC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_SWNET_NSC(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='HU2M_'
+ YCOMMENT='X_Y_'//YRECFM//' (PERCENT)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XHU2M(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
- YRECFM='LWNT_VC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LWNET_VC(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='ZON10M_'
+ YCOMMENT='X_Y_'//YRECFM//' (M/S)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XZON10M(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
- YRECFM='LWNT_GC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LWNET_GC(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='MER10M_'
+ YCOMMENT='X_Y_'//YRECFM//' (M/S)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XMER10M(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='W10M_'
+ YCOMMENT='X_Y_'//YRECFM//' (M/S)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%ND%AL(JP)%XWIND10M(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
- YRECFM='LWNT_NC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LWNET_NC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SWDN_GNC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_SWDOWN_GNC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWDN_GNC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LWDOWN_GNC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='H_V_CC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_H_V_CC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='H_G_CC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_H_G_CC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='H_C_AC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_H_C_AC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='H_N_CC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_H_N_CC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SR_GNC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_SR_GNC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='MELTCVC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_MELTCVC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='FRZCVC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_FRZCVC(:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- ! END MEB STUFF
+ END IF
!
- IF(LAGRIP)THEN
- YRECFM='IRRIGC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_IRRIG_FLUXC(:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
+ENDIF
+!
+!----------------------------------------------------------------------------
+!
+!* 9. Diag of prognostic fields
+! -------------------------
+!
+IF (DUO%LPROVAR_TO_DIAG) CALL PROVAR_TO_DIAG
+!
+!----------------------------------------------------------------------------
+!
+!* 15. chemical diagnostics:
+! --------------------
+!
+IF (CHI%SVI%NBEQ>0 .AND. CHI%CCH_DRY_DEP=="WES89 ") THEN
!
- IF(I%LGLACIER)THEN
- YRECFM='ICE_FC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_ICEFLUXC(:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
+ DO JSV = 1,SIZE(CHI%CCH_NAMES,1)
+ YRECFM='DVNT'//TRIM(CHI%CCH_NAMES(JSV))
+ WRITE(YCOMMENT,'(A13,I3.3)')'(m/s) DV_NAT_',JSV
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NCHI%AL(JP)%XDEP(:,JSV),ISIZE,S%XWORK_WR)
+ ENDDO
+ END DO
!
- IF(I%LFLOOD)THEN
- !
- YRECFM='IFLOODC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_IFLOODC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='PFLOODC_ISBA'
+ENDIF
+!
+IF (CHI%SVI%NBEQ>0 .AND. CHI%LCH_BIO_FLUX) THEN
+ !
+ IF (ASSOCIATED(GB%XFISO)) THEN
+ YRECFM='FISO'
+ WRITE(YCOMMENT,'(A21)')'FISO (molecules/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,GB%XFISO(:),IRESP,HCOMMENT=YCOMMENT)
+ END IF
+ !
+ IF (ASSOCIATED(GB%XFISO)) THEN
+ YRECFM='FMONO'
+ WRITE(YCOMMENT,'(A22)')'FMONO (molecules/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,GB%XFMONO(:),IRESP,HCOMMENT=YCOMMENT)
+ END IF
+ !
+ENDIF
+!
+IF (CHI%LCH_NO_FLUX) THEN
+ IF (ASSOCIATED(GB%XNOFLUX)) THEN
+ YRECFM='NOFLUX'
+ WRITE(YCOMMENT,'(A21)')'NOFLUX (molecules/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,GB%XNOFLUX(:),IRESP,HCOMMENT=YCOMMENT)
+ END IF
+END IF
+!
+IF (CHI%SVI%NDSTEQ > 0)THEN
+ !
+ DO JSV = 1,NDSTMDE ! for all dust modes
+ WRITE(YRECFM,'(A5,I3.3)')'F_DST',JSV
+ YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDST%AL(JP)%XSFDST(:,JSV),ISIZE,S%XWORK_WR)
+ ENDDO
+ END DO
+ !
+ENDIF
+!
+!----------------------------------------------------------------------------
+!
+!* 5. Cumulated Energy fluxes
+! -----------------------
+!
+ CALL END_IO_SURF_n(HPROGRAM)
+ CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'NATURE','ISBA ','WRITE','ISBA_DIAG_CUMUL.OUT.nc')
+!
+IF (ID%O%LSURF_BUDGETC) THEN
+ !
+ CALL WRITE_EVAP_BUD(ID%DEC,"C_ISBA",(ID%O%LSURF_BUDGETC .AND. .NOT.DUO%LRESET_BUDGETC))
+ !
+ IF(IO%LGLACIER)THEN
+ YRECFM='ICE_FC_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_PFLOODC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEFC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LE_FLOODC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEIFC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LEI_FLOODC(:),IRESP,HCOMMENT=YCOMMENT)
- !
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DEC%XICEFLUX(:),IRESP,HCOMMENT=YCOMMENT)
ENDIF
- !
+ !
YRECFM='RNC_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_RNC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DC%XRN(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='HC_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_HC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DC%XH(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LEC_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LEC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DC%XLE(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LEIC_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_LEIC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DC%XLEI(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='GFLUXC_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_GFLUXC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DC%XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='EVAPC_ISBA'
+ YCOMMENT='total evaporative flux for tile nature'//' (Kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,ID%DC%XEVAP(:),IRESP,HCOMMENT=YCOMMENT)
!
- IF (DGI%LRAD_BUDGET .OR. (DGEI%LSURF_BUDGETC .AND. .NOT.DGU%LRESET_BUDGETC)) THEN
+ YRECFM='SUBLC_ISBA'
+ YCOMMENT='sublimation flux for tile nature'//' (Kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,ID%DC%XSUBL(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF (ID%O%LRAD_BUDGET .OR. (ID%O%LSURF_BUDGETC .AND. .NOT.DUO%LRESET_BUDGETC)) THEN
!
YRECFM='SWDC_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_SWDC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DC%XSWD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='SWUC_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_SWUC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DC%XSWU(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LWDC_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_LWDC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DC%XLWD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LWUC_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_LWUC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DC%XLWU(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
YRECFM='FMUC_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (Pa.s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_FMUC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DC%XFMU(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='FMVC_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (Pa.s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_FMVC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF(I%CPHOTO/='NON')THEN
- !
- YRECFM='GPPC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (kgCO2/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_GPPC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='RC_AUTO_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (kgCO2/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_RESPC_AUTO(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='RC_ECO_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (kgCO2/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_RESPC_ECO(:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
- IF(DGEI%LWATER_BUDGET .OR. (DGEI%LSURF_BUDGETC .AND. .NOT.DGU%LRESET_BUDGETC))THEN
- !
- YRECFM='RAINFC_ISBA'
- YCOMMENT='cumulated input rainfall rate (Kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XRAINFALLC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SNOWFC_ISBA'
- YCOMMENT='cumulated input snowfall rate (Kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XSNOWFALLC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DWGC_ISBA'
- YCOMMENT='cumulated change in liquid soil moisture (Kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_DWGC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DWGIC_ISBA'
- YCOMMENT='cumulated change in solid soil moisture (Kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_DWGIC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DWRC_ISBA'
- YCOMMENT='cumulated change in water on canopy (Kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_DWRC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DSWEC_ISBA'
- YCOMMENT='cumulated change in snow water equivalent (Kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_DSWEC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='WATBUDC_ISBA'
- YCOMMENT='cumulated isba water budget as residue (Kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGEI%XAVG_WATBUDC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
-ENDIF
-!
-!* 6. parameters at 2 and 10 meters :
-! -------------------------------
-!
-IF (DGI%N2M>=1) THEN
- !
- YRECFM='T2M_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (K)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_T2M(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='T2MMIN_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (K)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_T2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
- IF(GRESET)DGI%XAVG_T2M_MIN(:)=XUNDEF
- !
- YRECFM='T2MMAX_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (K)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_T2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
- IF(GRESET)DGI%XAVG_T2M_MAX(:)=-XUNDEF
- !
- YRECFM='Q2M_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_Q2M(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='HU2M_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_HU2M(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='HU2MMIN_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_HU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
- IF(GRESET)DGI%XAVG_HU2M_MIN(:)=XUNDEF
- !
- YRECFM='HU2MMAX_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_HU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
- IF(GRESET)DGI%XAVG_HU2M_MAX(:)=-XUNDEF
- !
- YRECFM='ZON10M_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (M/S)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_ZON10M(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='MER10M_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (M/S)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_MER10M(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='W10M_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (M/S)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_WIND10M(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='W10MMAX_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (M/S)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_WIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
- IF(GRESET)DGI%XAVG_WIND10M_MAX(:)=0.0
- !
- YRECFM='SFCO2_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (M.kgCO2.S-1.kgAIR-1)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_SFCO2(:),IRESP,HCOMMENT=YCOMMENT)
- !
-END IF
-!----------------------------------------------------------------------------
-!
-!* 7. Transfer coefficients
-! ---------------------
-!
-IF (DGI%LCOEF) THEN
- !
- YRECFM='CD_ISBA'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_CD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='CH_ISBA'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_CH(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='CE_ISBA'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_CE(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='Z0_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (M)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_Z0(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='Z0H_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (M)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_Z0H(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DC%XFMV(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
!----------------------------------------------------------------------------
!
-!* 8. Surface humidity
-! ----------------
-IF (DGI%LSURF_VARS) THEN
- !
- YRECFM='QS_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGI%XAVG_QS(:),IRESP,HCOMMENT=YCOMMENT)
- !
-ENDIF
-!
-!----------------------------------------------------------------------------
-!
-!* 9. Diag of prognostic fields
-! -------------------------
-!
-IF (DGU%LPROVAR_TO_DIAG) CALL PROVAR_TO_DIAG
-!
-!----------------------------------------------------------------------------
-!
!User want (or not) patch output
-IF(DGI%LPATCH_BUDGET.AND.(I%NPATCH >1))THEN
- !----------------------------------------------------------------------------
- !
- !* 10. Richardson number (for each patch)
- ! -----------------
- !
- IF (DGI%N2M>=1) THEN
- !
- YRECFM='RI_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XRI(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- END IF
- !
- !* 11. Energy fluxes :(for each patch)
- ! -------------
- !
- IF (DGI%LSURF_BUDGET) THEN
- !
- YRECFM='RN_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XRN(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='H_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XH(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LE_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,I%XLE(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LEI_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XLEI(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='GFLUX_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XGFLUX(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- IF (DGI%LRAD_BUDGET .OR. (DGEI%LSURF_BUDGETC .AND. .NOT.DGU%LRESET_BUDGETC)) THEN
- !
- YRECFM='SWD_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XSWD(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='SWU_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XSWU(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LWD_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XLWD(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LWU_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XLWU(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- DO JSW=1, SIZE(DGI%XSWBD,2)
- YNUM=ACHAR(48+JSW)
- !
- YRECFM='SWD_P'//YNUM
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XSWBD(:,JSW,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='SWU_P'//YNUM
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XSWBU(:,JSW,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- ENDDO
- !
- ENDIF
- !
- YRECFM='FMU_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Pa'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XFMU(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='FMV_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Pa'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XFMV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- END IF
- !
- !* 12. Specific Energy fluxes :(for each patch)
- ! ----------------------------------------
- !
- IF (DGEI%LSURF_EVAP_BUDGET) THEN
- !
- YRECFM='LEG_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLEG(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LEGI_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLEGI(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LEV_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLEV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LES_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLES(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- IF(I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO')THEN
- YRECFM='LESL_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLESL(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- YRECFM='SNDRIF_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XSNDRIFT(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- ENDIF
- !
- YRECFM='LER_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLER(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LETR_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLETR(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='EVAP_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XEVAP(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='SUBL_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XSUBL(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='DRAIN_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XDRAIN(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- IF(I%CRUNOFF=='SGH'.AND.I%CISBA=='DIF')THEN
- YRECFM='QSB_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XQSB(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- ENDIF
- !
- YRECFM='RUNOFF_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XRUNOFF(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- IF(I%CHORT=='SGH'.OR.I%CISBA=='DIF')THEN
- YRECFM='HORTON_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XHORT(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- ENDIF
- !
- YRECFM='DRIVEG_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XDRIP(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='RRVEG_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XRRVEG(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='SNOMLT_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XMELT(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- ! MEB STUFF
- IF (ISIZE_LMEB_PATCH>0) THEN
- YRECFM='LEVCV_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLEVCV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LESC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLESC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
-! YRECFM='LETRGV_P'
-! YCOMMENT='X_Y_'//YRECFM
-! YCOMMENTUNIT='W/m2'
-! CALL WRITE_SURF_FIELD2D(HPROGRAM,YRECFM,XLETRGV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LETRCV_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLETRCV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
-! YRECFM='LERGV_P'
-! YCOMMENT='X_Y_'//YRECFM
-! YCOMMENTUNIT='W/m2'
-! CALL WRITE_SURF_FIELD2D(DGU, U, &
-! HPROGRAM,DGEI%XLERGV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LELITTER_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLELITTER(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LELITTERI_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLELITTERI(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='DRIPLIT_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XDRIPLIT(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='RRLIT_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XRRLIT(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LERCV_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLERCV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LE_C_A_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLE_C_A(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LE_V_C_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLE_V_C(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LE_G_C_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLE_G_C(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LE_N_C_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLE_N_C(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='SWNT_V_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XSWNET_V(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='SWNT_G_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XSWNET_G(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='SWNT_N_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XSWNET_N(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='SWNT_NS_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XSWNET_NS(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LWNT_V_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLWNET_V(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LWNT_G_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLWNET_G(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LWNT_N_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLWNET_N(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='SWDN_GN_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XSWDOWN_GN(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LWDN_GN_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLWDOWN_GN(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='H_V_C_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XH_V_C(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='H_G_C_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XH_G_C(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='H_C_A_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XH_C_A(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='H_N_C_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XH_N_C(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='SR_GN_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XSR_GN(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='MELTCV_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XMELTCV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='FRZCV_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XFRZCV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- ENDIF
- ! END MEB STUFF
- !
- IF(LAGRIP)THEN
- YRECFM='IRRIG_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XIRRIG_FLUX(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- ENDIF
- !
- IF(I%LFLOOD)THEN
- !
- YRECFM='IFLOOD_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XIFLOOD(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='PFLOOD_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XPFLOOD(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LEF_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLE_FLOOD(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LEIF_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLEI_FLOOD(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- ENDIF
- !
- IF(I%CPHOTO/='NON')THEN
- !
- YRECFM='GPP_P'
- YCOMMENT='gross primary production per patch '
- YCOMMENTUNIT='kgCO2/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XGPP(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='R_AUTO_P'
- YCOMMENT='autotrophic respiration per patch'
- YCOMMENTUNIT='kgCO2/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XRESP_AUTO(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='R_ECO_P'
- YCOMMENT='ecosystem respiration per patch'
- YCOMMENTUNIT='kgCO2/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XRESP_ECO(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- ENDIF
- !
- IF(DGEI%LWATER_BUDGET)THEN
- !
- YRECFM='DWG_P'
- YCOMMENT='change in liquid soil moisture per patch'
- YCOMMENTUNIT='Kg/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XDWG(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='DWGI_P'
- YCOMMENT='change in solid soil moisture per patch'
- YCOMMENTUNIT='Kg/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XDWGI(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='DWR_P'
- YCOMMENT='change in water on canopy per patch '
- YCOMMENTUNIT='Kg/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XDWR(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='DSWE_P'
- YCOMMENT='change in snow water equivalent per patch '
- YCOMMENTUNIT='Kg/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XDSWE(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='WATBUD_P'
- YCOMMENT='isba water budget as residue per patch'
- YCOMMENTUNIT='Kg/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XWATBUD(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- ENDIF
- !
- ENDIF
- !
- !* 13. surface temperature parameters at 2 and 10 meters (for each patch):
- ! -------------------------------------------------------------------
- !
- IF (DGI%N2M>=1) THEN
- !
- YRECFM='T2M_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='K'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XT2M(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='T2MMIN_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='K'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XT2M_MIN(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- DGI%XT2M_MIN(:,:)=XUNDEF
- !
- YRECFM='T2MMAX_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='K'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XT2M_MAX(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- DGI%XT2M_MAX(:,:)=0.0
- !
- YRECFM='Q2M_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='KG/KG'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XQ2M(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='HU2M_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='PERCENT'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XHU2M(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='ZON10M_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='M/S'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XZON10M(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='MER10M_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='M/S'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XMER10M(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='W10M_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='M/S'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XWIND10M(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- END IF
+IF (ID%O%LPATCH_BUDGET.AND.(IO%NPATCH >1)) THEN
!
!* 14. Cumulated Energy fluxes :(for each patch)
! -----------------------------------------
!
- IF (DGEI%LSURF_BUDGETC) THEN
- !
- YRECFM='LEGC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLEGC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LEGIC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLEGIC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LEVC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLEVC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LESC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLESAC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- IF(I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO')THEN
- YRECFM='LESLC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLESLC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- YRECFM='SNDRIFC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XSNDRIFTC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- ENDIF
- !
- YRECFM='LERC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLERC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LETRC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLETRC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='EVAPC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XEVAPC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='SUBLC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XSUBLC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='DRAINC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XDRAINC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- IF(I%CRUNOFF=='SGH'.AND.I%CISBA=='DIF')THEN
- YRECFM='QSBC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XQSBC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- ENDIF
- !
- YRECFM='RUNOFFC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XRUNOFFC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- IF(I%CHORT=='SGH'.OR.I%CISBA=='DIF')THEN
- YRECFM='HORTONC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XHORTC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- ENDIF
- !
- YRECFM='DRIVEGC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XDRIPC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='RRVEGC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XRRVEGC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='SNOMLTC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XMELTC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- ! MEB STUFF
- IF (ISIZE_LMEB_PATCH>0) THEN
- YRECFM='LEVCVC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLEVCVC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LESCC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLESCC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
-! YRECFM='LETRGVC_P'
-! YCOMMENT='X_Y_'//YRECFM
-! YCOMMENTUNIT='J/m2'
-! CALL WRITE_SURF_FIELD2D(DGU, U, &
-! HPROGRAM,XLETRGVC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LETRCVC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLETRCVC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
-! YRECFM='LERGVC_P'
-! YCOMMENT='X_Y_'//YRECFM
-! YCOMMENTUNIT='J/m2'
-! CALL WRITE_SURF_FIELD2D(DGU, U, &
-! HPROGRAM,XLERGVC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LERCVC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLERCVC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LE_C_AC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLE_C_AC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LE_V_CC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLE_V_CC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LE_G_CC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLE_G_CC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LE_N_CC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLE_N_CC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='SWNT_VC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XSWNET_VC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='SWNT_GC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XSWNET_GC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='SWNT_NC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XSWNET_NC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='SWNT_NSC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XSWNET_NSC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LWNT_VC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLWNET_VC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LWNT_GC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLWNET_GC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LWNT_NC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLWNET_NC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='SWDN_GNC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XSWDOWN_GNC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LWDN_GNC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLWDOWN_GNC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='H_V_CC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XH_V_CC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='H_G_CC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XH_G_CC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='H_C_AC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XH_C_AC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='H_N_CC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XH_N_CC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='SR_GNC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XSR_GNC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='MELTCVC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XMELTCVC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='FRZCVC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XFRZCVC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- ENDIF
- ! END MEB STUFF
- !
- IF(LAGRIP)THEN
- YRECFM='IRRIGC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XIRRIG_FLUXC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- ENDIF
- !
- IF(I%LGLACIER)THEN
- YRECFM='ICE_FC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XICEFLUXC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- ENDIF
- !
- IF(I%LFLOOD)THEN
- !
- YRECFM='IFLOODC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XIFLOODC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='PFLOODC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XPFLOODC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LEFC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLE_FLOODC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LEIFC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='W/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLEI_FLOODC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- ENDIF
- !
- YRECFM='RNC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XRNC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='HC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XHC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LEC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLEC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ IF (ID%O%LSURF_BUDGETC) THEN
!
- YRECFM='LEIC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XLEIC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='GFLUXC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XGFLUXC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- IF (DGI%LRAD_BUDGET .OR. (DGEI%LSURF_BUDGETC .AND. .NOT.DGU%LRESET_BUDGETC)) THEN
- !
- YRECFM='SWDC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XSWDC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='SWUC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XSWUC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LWDC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XLWDC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='LWUC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='J/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XLWUC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
+ CALL WRITE_EVAP_BUD_PATCH(ID%NDEC,'C_',(ID%O%LSURF_BUDGETC .AND. .NOT.DUO%LRESET_BUDGETC))
+ !
+ IF(IO%LGLACIER)THEN
+ YRECFM='ICE_FC_'
+ YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%NDEC%AL(JP)%XICEFLUX(:),ISIZE,S%XWORK_WR)
+ ENDDO
ENDIF
+ !
+ YRECFM='RNC_'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XRN(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='HC_'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XH(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='LEC_'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XLE(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='LEIC_'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XLEI(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
- YRECFM='FMUC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Pa.s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XFMUC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='FMVC_P'
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='Pa.s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGI%XFMVC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- IF(I%CPHOTO/='NON')THEN
- !
- YRECFM='GPPC_P'
- YCOMMENT='cumulated gross primary production per patch'
- YCOMMENTUNIT='KgCO2/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XGPPC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='RC_AUTO_P'
- YCOMMENT='cumulated autotrophic respiration per patch '
- YCOMMENTUNIT='KgCO2/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XRESPC_AUTO(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='RC_ECO_P'
- YCOMMENT='cumulated ecosystem respiration per patch'
- YCOMMENTUNIT='KgCO2/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XRESPC_ECO(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- ENDIF
- !
- IF(DGEI%LWATER_BUDGET .OR. (DGEI%LSURF_BUDGETC .AND. .NOT.DGU%LRESET_BUDGETC))THEN
- !
- YRECFM='DWGC_P'
- YCOMMENT='cumulated change in liquid soil moisture per patch'
- YCOMMENTUNIT='Kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XDWGC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='DWGIC_P'
- YCOMMENT='cumulated change in solid soil moisture per patch '
- YCOMMENTUNIT='Kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XDWGIC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='DWRC_P'
- YCOMMENT='cumulated change in water on canopy per patch '
- YCOMMENTUNIT='Kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XDWRC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='DSWEC_P'
- YCOMMENT='cumulated change in snow water equivalent per patch '
- YCOMMENTUNIT='Kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XDSWEC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- !
- YRECFM='WATBUDC_P'
- YCOMMENT='cumulated isba water budget as residue per patch'
- YCOMMENTUNIT='Kg/m2'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DGEI%XWATBUDC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YRECFM='GFLUXC_'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XGFLUX(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='EVAPC_'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XEVAP(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='SUBLC_'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XSUBL(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ IF (ID%O%LRAD_BUDGET .OR. (ID%O%LSURF_BUDGETC .AND. .NOT.DUO%LRESET_BUDGETC)) THEN
+ !
+ YRECFM='SWDC_'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XSWD(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='SWUC_'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XSWU(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='LWDC_'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XLWD(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='LWUC_'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XLWU(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
ENDIF
- !
+ !
+ YRECFM='FMUC_'
+ YCOMMENT='X_Y_'//YRECFM//' (Pa.s)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XFMU(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='FMVC_'
+ YCOMMENT='X_Y_'//YRECFM//' (Pa.s)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XFMV(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
ENDIF
+ !
!-------------------------------------------------------------------------------
ENDIF
+!
+! End of IO
+!
+ CALL END_IO_SURF_n(HPROGRAM)
+!
+!-------------------------------------------------------------------------------
+!
!User want (or not) patch output
!-------------------------------------------------------------------------------
!
-!* 15. chemical diagnostics:
-! --------------------
+IF ( DUO%LRESETCUMUL .AND. ID%O%LSURF_BUDGETC ) THEN
+ !
+ DO JP = 1,IO%NPATCH
+ CALL INIT_SURF_BUD(ID%NDC%AL(JP),0.)
+ ENDDO
+ !
+ IF (ID%DE%LSURF_EVAP_BUDGET) THEN
+ DO JP = 1,IO%NPATCH
+ CALL INIT_EVAP_BUD(ID%NDEC%AL(JP))
+ ENDDO
+ !
+ IF (ID%DE%LWATER_BUDGET) THEN
+ DO JP = 1,IO%NPATCH
+ CALL INIT_WATER_BUD(ID%NDEC%AL(JP))
+ ENDDO
+ ENDIF
+ ENDIF
+ !
+END IF
!
-IF (CHI%SVI%NBEQ>0 .AND. CHI%CCH_DRY_DEP=="WES89 ") THEN
+IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N',1,ZHOOK_HANDLE)
+!
+CONTAINS
+!
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE WRITE_EVAP_BUD(DEA,HTERM,OFLAG)
+!
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
+!
+TYPE(DIAG_EVAP_ISBA_t) :: DEA
+ CHARACTER(LEN=6), INTENT(IN) :: HTERM
+LOGICAL, INTENT(IN) :: OFLAG
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N:WRITE_EVAP_BUD',0,ZHOOK_HANDLE)
+!
+YRECFM='LEG'//TRIM(HTERM)
+YCOMMENT='bare ground evaporation for tile nature'//' (W/m2)'
+CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLEG(:),IRESP,HCOMMENT=YCOMMENT)
+!
+YRECFM='LEGI'//TRIM(HTERM)
+YCOMMENT='bare ground sublimation for tile nature'//' (W/m2)'
+CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLEGI(:),IRESP,HCOMMENT=YCOMMENT)
+!
+YRECFM='LEV'//TRIM(HTERM)
+YCOMMENT='total vegetation evaporation for tile nature'//' (W/m2)'
+CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLEV(:),IRESP,HCOMMENT=YCOMMENT)
!
- DO JSV = 1,SIZE(CHI%CCH_NAMES,1)
- YRECFM='DV_NAT_'//TRIM(CHI%CCH_NAMES(JSV))
- WRITE(YCOMMENT,'(A13,I3.3)')'DV_NAT_',JSV
- YCOMMENTUNIT='m/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,CHI%XDEP(:,JSV,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- END DO
+YRECFM='LES'//TRIM(HTERM)
+YCOMMENT='snow sublimation for tile nature'//' (W/m2)'
+CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLES(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+IF(NPE%AL(1)%TSNOW%SCHEME=='3-L' .OR. NPE%AL(1)%TSNOW%SCHEME=='CRO')THEN
+ YRECFM='LESL'//TRIM(HTERM)
+ YCOMMENT='liquid water evaporation over snow for tile nature'//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLESL(:),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='SNDRIF'//TRIM(HTERM)
+ YCOMMENT='blowing snow sublimation for tile nature'//' (Kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XSNDRIFT(:),IRESP,HCOMMENT=YCOMMENT)
+ENDIF
+ !
+YRECFM='LER'//TRIM(HTERM)
+YCOMMENT='canopy direct evaporation for tile nature'//' (W/m2)'
+CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLER(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+YRECFM='LETR'//TRIM(HTERM)
+YCOMMENT='vegetation transpiration for tile nature'//' (W/m2)'
+CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLETR(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+YRECFM='DRAIN'//TRIM(HTERM)
+YCOMMENT='drainage for tile nature'//' (Kg/m2/s)'
+CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XDRAIN(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+IF(IO%CRUNOFF=='SGH'.AND.IO%CISBA=='DIF')THEN
+ YRECFM='QSB'//TRIM(HTERM)
+ YCOMMENT='lateral subsurface flow for tile nature'//' (Kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XQSB(:),IRESP,HCOMMENT=YCOMMENT)
+ENDIF
+ !
+YRECFM='RUNOFF'//TRIM(HTERM)
+YCOMMENT='runoff for tile nature'//' (Kg/m2/s)'
+CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XRUNOFF(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+IF(IO%CHORT=='SGH'.OR.IO%CISBA=='DIF')THEN
+ YRECFM='HORTON'//TRIM(HTERM)
+ YCOMMENT='horton runoff for tile nature'//' (Kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XHORT(:),IRESP,HCOMMENT=YCOMMENT)
+ENDIF
+ !
+YRECFM='DRIVEG'//TRIM(HTERM)
+YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
+CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XDRIP(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+YRECFM='RRVEG'//TRIM(HTERM)
+YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
+CALL WRITE_SURF(DUO%CSELECT, &
+ HPROGRAM,YRECFM,DEA%XRRVEG(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+YRECFM='SNOMLT'//TRIM(HTERM)
+YCOMMENT='snow melting rate'//' (Kg/m2/s)'
+CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XMELT(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+IF(LAGRIP)THEN
+ YRECFM='IRRIG'//TRIM(HTERM)
+ YCOMMENT='irrigation rate'//' (Kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XIRRIG_FLUX(:),IRESP,HCOMMENT=YCOMMENT)
+ENDIF
+! MEB STUFF
+IF (ISIZE_LMEB_PATCH>0) THEN
+ YRECFM='LELIT'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLELITTER(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LELITI'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLELITTERI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='DRIPLIT'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XDRIPLIT(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='RRLIT'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XRRLIT(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LEV_CV'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLEV_CV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LES_CV'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLES_CV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LETR_CV'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLETR_CV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LER_CV'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLER_CV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LE_CV'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLE_CV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='H_CV'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XH_CV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='MELT_CV'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XMELT_CV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='FRZ_CV'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XFRZ_CV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LETR_GV'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLETR_GV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LER_GV'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLER_GV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LE_GV'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLE_GV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='H_GV'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XH_GV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LE_GN'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLE_GN(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='H_GN'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XH_GN(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SR_GN'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XSR_GN(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SWDN_GN'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XSWDOWN_GN(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWDN_GN'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLWDOWN_GN(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LE_CA'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLE_CA(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='H_CA'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XH_CA(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SWNT_V'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XSWNET_V(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SWNT_G'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XSWNET_G(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SWNT_N'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XSWNET_N(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SWNT_NS'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XSWNET_NS(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWNT_V'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLWNET_V(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWNT_G'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLWNET_G(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWNT_N'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLWNET_N(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ENDIF
+ ! END MEB STUFF
+ !
+IF(IO%LFLOOD)THEN
+ !
+ YRECFM='IFLOOD'//TRIM(HTERM)
+ YCOMMENT='flood soil infiltration (Kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XIFLOOD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='PFLOOD'//TRIM(HTERM)
+ YCOMMENT='intercepted precipitation by floodplains (Kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XPFLOOD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LEF'//TRIM(HTERM)
+ YCOMMENT='total floodplains evaporation (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLE_FLOOD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LEIF'//TRIM(HTERM)
+ YCOMMENT='solid floodplains evaporation (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLEI_FLOOD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ENDIF
!
+IF(IO%CPHOTO/='NON')THEN
+ !
+ YRECFM='GPP'//TRIM(HTERM)
+ YCOMMENT='gross primary production over tile nature (kgCO2/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XGPP(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF (HTERM(1:1)=="C") THEN
+ YRECFM='RC_AUTO'//TRIM(HTERM(2:))
+ ELSE
+ YRECFM='R_AUTO'//TRIM(HTERM)
+ ENDIF
+ YCOMMENT='autotrophic respiration over tile nature (kgCO2/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XRESP_AUTO(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF (HTERM(1:1)=="C") THEN
+ YRECFM='RC_ECO'//TRIM(HTERM(2:))
+ ELSE
+ YRECFM='R_ECO'//TRIM(HTERM)
+ ENDIF
+ YCOMMENT='ecosystem respiration over tile nature (kgCO2/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XRESP_ECO(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ENDIF
+!
+IF(ID%DE%LWATER_BUDGET .OR. OFLAG)THEN
+ !
+ YRECFM='RAINF'//TRIM(HTERM)
+ YCOMMENT='input rainfall rate (Kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XRAINFALL(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SNOWF'//TRIM(HTERM)
+ YCOMMENT='input snowfall rate (Kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XSNOWFALL(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='DWG'//TRIM(HTERM)
+ YCOMMENT='change in liquid soil moisture (Kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XDWG(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='DWGI'//TRIM(HTERM)
+ YCOMMENT='change in solid soil moisture (Kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XDWGI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='DWR'//TRIM(HTERM)
+ YCOMMENT='change in water on canopy (Kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XDWR(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='DSWE'//TRIM(HTERM)
+ YCOMMENT='change in snow water equivalent (Kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XDSWE(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='WATBUD'//TRIM(HTERM)
+ YCOMMENT='isba water budget as residue (Kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XWATBUD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
ENDIF
!
-IF (CHI%SVI%NBEQ>0 .AND. CHI%LCH_BIO_FLUX) THEN
+IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N:WRITE_EVAP_BUD',1,ZHOOK_HANDLE)
+
+!
+END SUBROUTINE WRITE_EVAP_BUD
+!
+SUBROUTINE WRITE_EVAP_BUD_PATCH(NDEA,HTERM,OFLAG)
+!
+USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_NP_t
+!
+TYPE(DIAG_EVAP_ISBA_NP_t) :: NDEA
+ CHARACTER(LEN=2), INTENT(IN) :: HTERM
+LOGICAL, INTENT(IN) :: OFLAG
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N:WRITE_EVAP_BUD_PATCH',0,ZHOOK_HANDLE)
+!
+YRECFM='LEG'//TRIM(HTERM)
+YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLEG(:),ISIZE,S%XWORK_WR)
+ENDDO
+!
+YRECFM='LEGI'//TRIM(HTERM)
+YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLEGI(:),ISIZE,S%XWORK_WR)
+ENDDO
+!
+YRECFM='LEV'//TRIM(HTERM)
+YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLEV(:),ISIZE,S%XWORK_WR)
+ENDDO
+!
+
+YRECFM='LES'//TRIM(HTERM)
+YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLES(:),ISIZE,S%XWORK_WR)
+ENDDO
+!
+IF(NPE%AL(1)%TSNOW%SCHEME=='3-L' .OR. NPE%AL(1)%TSNOW%SCHEME=='CRO')THEN
+ YRECFM='LESL'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLESL(:),ISIZE,S%XWORK_WR)
+ENDDO
+ YRECFM='SNDRIF'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XSNDRIFT(:),ISIZE,S%XWORK_WR)
+ENDDO
+ENDIF
+!
+YRECFM='LER'//TRIM(HTERM)
+YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLER(:),ISIZE,S%XWORK_WR)
+ENDDO
+!
+YRECFM='LETR'//TRIM(HTERM)
+YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLETR(:),ISIZE,S%XWORK_WR)
+ENDDO
+!
+YRECFM='DRAIN'//TRIM(HTERM)
+YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
+DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XDRAIN(:),ISIZE,S%XWORK_WR)
+ENDDO
+!
+IF(IO%CRUNOFF=='SGH'.AND.IO%CISBA=='DIF')THEN
+ YRECFM='QSB'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XQSB(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ENDIF
+!
+YRECFM='RUNOFF'//TRIM(HTERM)
+YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
+DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XRUNOFF(:),ISIZE,S%XWORK_WR)
+ENDDO
+!
+IF(IO%CHORT=='SGH'.OR.IO%CISBA=='DIF')THEN
+
+ YRECFM='HORTON'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XHORT(:),ISIZE,S%XWORK_WR)
+ ENDDO
+
+ENDIF
+!
+YRECFM='DRIVEG'//TRIM(HTERM)
+YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
+DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XDRIP(:),ISIZE,S%XWORK_WR)
+ENDDO
+!
+YRECFM='RRVEG'//TRIM(HTERM)
+YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
+DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XRRVEG(:),ISIZE,S%XWORK_WR)
+ENDDO
+!
+YRECFM='SNOMLT'//TRIM(HTERM)
+YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
+DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XMELT(:),ISIZE,S%XWORK_WR)
+ENDDO
+!
+! MEB STUFF
+IF (ISIZE_LMEB_PATCH>0) THEN
!
- IF (ASSOCIATED(GB%XFISO)) THEN
- YRECFM='FISO'
- WRITE(YCOMMENT,'(A21)')'FISO (molecules/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,GB%XFISO(:),IRESP,HCOMMENT=YCOMMENT)
- END IF
+ YRECFM='LELIT'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLELITTER(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
- IF (ASSOCIATED(GB%XFISO)) THEN
- YRECFM='FMONO'
- WRITE(YCOMMENT,'(A22)')'FMONO (molecules/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,GB%XFMONO(:),IRESP,HCOMMENT=YCOMMENT)
- END IF
+ YRECFM='LELITI'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLELITTERI(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='DRIPLIT'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XDRIPLIT(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
+ YRECFM='RRLIT'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XRRLIT(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='LEV_CV'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLEV_CV(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='LES_CV'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLES_CV(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='LETR_CV'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLETR_CV(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='LER_CV'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLER_CV(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='LE_CV'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLE_CV(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='H_CV'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XH_CV(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='MELT_CV'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XMELT_CV(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='FRZ_CV'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XFRZ_CV(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='LE_GV'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLE_GV(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='H_GV'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XH_GV(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='LE_GN'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLE_GN(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='H_GN'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XH_GN(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='SR_GN'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XSR_GN(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='SWDN_GN'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XSWDOWN_GN(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='LWDN_GN'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLWDOWN_GN(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='LE_CA'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLE_CA(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='H_CA'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XH_CA(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='SWNT_V'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XSWNET_V(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='SWNT_G'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XSWNET_G(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='SWNT_N'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XSWNET_N(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='SWNT_NS'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XSWNET_NS(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='LWNT_V'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLWNET_V(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='LWNT_G'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLWNET_G(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='LWNT_N'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLWNET_N(:),ISIZE,S%XWORK_WR)
+ ENDDO
+
ENDIF
+! END MEB STUFF
!
-IF (CHI%LCH_NO_FLUX) THEN
- IF (ASSOCIATED(GB%XNOFLUX)) THEN
- YRECFM='NOFLUX'
- WRITE(YCOMMENT,'(A21)')'NOFLUX (molecules/m2/s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,GB%XNOFLUX(:),IRESP,HCOMMENT=YCOMMENT)
- END IF
-END IF
+IF(LAGRIP)THEN
+ YRECFM='IRRIG'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XIRRIG_FLUX(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ENDIF
!
-IF (CHI%SVI%NDSTEQ > 0)THEN
+IF(IO%LFLOOD)THEN
!
- DO JSV = 1,NDSTMDE ! for all dust modes
- WRITE(YRECFM,'(A7,I3.3)')'FLX_DST',JSV
- YCOMMENT='X_Y_'//YRECFM
- YCOMMENTUNIT='kg/m2/s'
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,DST%XSFDST(:,JSV,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
- END DO
+ YRECFM='IFLOOD'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XIFLOOD(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='PFLOOD'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XPFLOOD(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+
+ YRECFM='LEF'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLE_FLOOD(:),ISIZE,S%XWORK_WR)
+ENDDO
+ !
+
+ YRECFM='LEIF'//TRIM(HTERM)
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XLEI_FLOOD(:),ISIZE,S%XWORK_WR)
+ ENDDO
!
ENDIF
!
-!-------------------------------------------------------------------------------
+IF(IO%CPHOTO/='NON')THEN
+ !
+
+ YRECFM='GPP'//TRIM(HTERM)
+ YCOMMENT='gross primary production per patch (kgCO2/m2/s)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XGPP(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ IF (HTERM(1:1)=="C") THEN
+ YRECFM='RC_AUTO'//TRIM(HTERM(2:))
+ ELSE
+ YRECFM='R_AUTO'//TRIM(HTERM)
+ ENDIF
+ YCOMMENT='autotrophic respiration per patch (kgCO2/m2/s)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XRESP_AUTO(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ IF (HTERM(1:1)=="C") THEN
+ YRECFM='RC_ECO'//TRIM(HTERM(2:))
+ ELSE
+ YRECFM='R_ECO'//TRIM(HTERM)
+ ENDIF
+ YCOMMENT='ecosystem respiration per patch (kgCO2/m2/s)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XRESP_ECO(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ENDIF
!
-! End of IO
+IF(ID%DE%LWATER_BUDGET .OR. OFLAG)THEN
+ !
+ YRECFM='DWG'//TRIM(HTERM)
+ YCOMMENT='change in liquid soil moisture per patch (Kg/m2/s)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XDWG(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='DWGI'//TRIM(HTERM)
+ YCOMMENT='change in solid soil moisture per patch (Kg/m2/s)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XDWGI(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='DWR'//TRIM(HTERM)
+ YCOMMENT='change in water on canopy per patch (Kg/m2/s)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XDWR(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='DSWE'//TRIM(HTERM)
+ YCOMMENT='change in snow water equivalent per patch (Kg/m2/s)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XDSWE(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='WATBUD'//TRIM(HTERM)
+ YCOMMENT='isba water budget as residue per patch (Kg/m2/s)'
+ DO JP=1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NDEA%AL(JP)%XWATBUD(:),ISIZE,S%XWORK_WR)
+ ENDDO
+ !
+ENDIF
!
- CALL END_IO_SURF_n(HPROGRAM)
-IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N:WRITE_EVAP_BUD_PATCH',1,ZHOOK_HANDLE)
!
- CONTAINS
+END SUBROUTINE WRITE_EVAP_BUD_PATCH
!
-!-------------------------------------------------------------------------------
!
SUBROUTINE PROVAR_TO_DIAG
!
-REAL, DIMENSION(SIZE(I%XTG,1)) :: ZPATCH, ZWORK
-REAL, DIMENSION(SIZE(I%XWG,1),SIZE(I%XWG,2)) :: ZWG
-REAL, DIMENSION(SIZE(I%XWG,1),SIZE(I%XWG,2)) :: ZWGI
-REAL, DIMENSION(SIZE(I%XTG,1),SIZE(I%XTG,2)) :: ZTG
-REAL, DIMENSION(SIZE(I%XDG,1),SIZE(I%XDG,2)) :: ZDG_TOT
-REAL, DIMENSION(SIZE(I%XDG,1),SIZE(I%XDG,2),SIZE(I%XDG,3)) :: ZDG
+REAL, DIMENSION(U%NSIZE_NATURE) :: ZPATCH, ZWORK
+REAL, DIMENSION(U%NSIZE_NATURE,SIZE(NPE%AL(1)%XWG,2)) :: ZWG
+REAL, DIMENSION(U%NSIZE_NATURE,SIZE(NPE%AL(1)%XWG,2)) :: ZWGI
+REAL, DIMENSION(U%NSIZE_NATURE,SIZE(NPE%AL(1)%XTG,2)) :: ZTG
+REAL, DIMENSION(U%NSIZE_NATURE,SIZE(NP%AL(1)%XDG,2)) :: ZDG_TOT
+REAL, DIMENSION(U%NSIZE_NATURE,SIZE(NP%AL(1)%XDG,2)) :: ZDG
!
-REAL, DIMENSION(SIZE(I%XDG,1),I%NNBIOMASS) :: ZBIOMASS
-REAL, DIMENSION(SIZE(I%XDG,1),I%NNSOILCARB) :: ZSOILCARB
-REAL, DIMENSION(SIZE(I%XDG,1),I%NNLITTLEVS) :: ZLIGNIN_STRUC
-REAL, DIMENSION(SIZE(I%XDG,1),I%NNLITTER,I%NNLITTLEVS) :: ZLITTER
+REAL, DIMENSION(U%NSIZE_NATURE,IO%NNBIOMASS) :: ZBIOMASS
+REAL, DIMENSION(U%NSIZE_NATURE,IO%NNSOILCARB) :: ZSOILCARB
+REAL, DIMENSION(U%NSIZE_NATURE,IO%NNLITTLEVS) :: ZLIGNIN_STRUC
+REAL, DIMENSION(U%NSIZE_NATURE,IO%NNLITTER,IO%NNLITTLEVS) :: ZLITTER
!
- CHARACTER(LEN=4 ) :: YLVL
+CHARACTER(LEN=4 ) :: YLVL
REAL :: ZMISS
-INTEGER :: JLAYER, JPATCH, JJ, INI, IWORK, IDEPTH
+INTEGER :: JL, JP, JJ, INI, IWORK, IDEPTH, IMASK
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N:PROVAR_TO_DIAG',0,ZHOOK_HANDLE)
!
-INI=SIZE(I%XDG,1)
+INI=U%NSIZE_NATURE
!
! * soil temperatures (K)
!
-IF(I%LTEMP_ARP)THEN
- IWORK=I%NTEMPLAYER_ARP
-ELSEIF(I%CISBA/='DIF')THEN
+IF(IO%LTEMP_ARP)THEN
+ IWORK=IO%NTEMPLAYER_ARP
+ELSEIF(IO%CISBA/='DIF')THEN
IWORK=2
ELSE
- IWORK=I%NGROUND_LAYER
+ IWORK=IO%NGROUND_LAYER
ENDIF
!
ZTG(:,:)=0.0
-DO JPATCH=1,I%NPATCH
- DO JLAYER=1,IWORK
- DO JJ=1,INI
- ZTG(JJ,JLAYER) = ZTG(JJ,JLAYER) + I%XPATCH(JJ,JPATCH) * I%XTG(JJ,JLAYER,JPATCH)
+DO JP=1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+ DO JL=1,IWORK
+ DO JJ=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JJ)
+ ZTG(IMASK,JL) = ZTG(IMASK,JL) + PK%XPATCH(JJ) * PEK%XTG(JJ,JL)
ENDDO
ENDDO
ENDDO
!
-DO JLAYER=1,IWORK
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (K)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,ZTG(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
-END DO
+IF (LALLOW_ADD_DIM) THEN
+ YRECFM='TG_ISBA' ;
+ YCOMMENT='Soil temperature (K)'
+ CALL WRITE_SURF(DUO%CSELECT, &
+ HPROGRAM,YRECFM,ZTG(:,:),IRESP,YCOMMENT,HNAM_DIM=YGROUND_LAYER_DIM_NAME)
+ELSE
+ DO JL=1,IWORK
+ WRITE(YLVL,'(I4)') JL
+ YRECFM='TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (K)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZTG(:,JL),IRESP,HCOMMENT=YCOMMENT)
+ END DO
+ENDIF
!
! * Compute soil liquid and ice water content (kg/m2 and m3/m3)
!
ZWG (:,:)=0.0
ZWGI(:,:)=0.0
ZDG_TOT(:,:)=0.0
-!
-IF(I%CISBA=='DIF')THEN
- !
- DO JPATCH=1,I%NPATCH
- DO JLAYER=1,I%NGROUND_LAYER
- DO JJ=1,INI
-!
-! liquid and ice water content
- IDEPTH=I%NWG_LAYER(JJ,JPATCH)
- IF(JLAYER<=IDEPTH)THEN
- ZWG (JJ,JLAYER)=ZWG (JJ,JLAYER)+I%XPATCH(JJ,JPATCH)*I%XWG (JJ,JLAYER,JPATCH)*I%XDZG(JJ,JLAYER,JPATCH)
- ZWGI (JJ,JLAYER)=ZWGI (JJ,JLAYER)+I%XPATCH(JJ,JPATCH)*I%XWGI(JJ,JLAYER,JPATCH)*I%XDZG(JJ,JLAYER,JPATCH)
- ZDG_TOT(JJ,JLAYER)=ZDG_TOT(JJ,JLAYER)+I%XPATCH(JJ,JPATCH)*I%XDZG(JJ,JLAYER,JPATCH)
- ENDIF
+!
+IF(IO%CISBA=='DIF')THEN
+ !
+ DO JP=1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+
+ DO JJ=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JJ)
+ DO JL=1,IO%NGROUND_LAYER
+!
+! liquid and ice water content
+ IDEPTH= PK%NWG_LAYER(JJ)
+ IF(JL<=IDEPTH)THEN
+ ZWG(IMASK,JL) = ZWG (IMASK,JL)+ PK%XPATCH(JJ) * PEK%XWG (JJ,JL) * PK%XDZG(JJ,JL)
+ ZWGI(IMASK,JL)= ZWGI(IMASK,JL)+ PK%XPATCH(JJ) * PEK%XWGI(JJ,JL) * PK%XDZG(JJ,JL)
+ ZDG_TOT(IMASK,JL)= ZDG_TOT(IMASK,JL)+ PK%XPATCH(JJ)* PK%XDZG(JJ,JL)
+ ENDIF
!
- ENDDO
- ENDDO
+ ENDDO
+ ENDDO
ENDDO
!
ELSE
!
- ZDG(:,1,:) = I%XDG(:,1,:)
- ZDG(:,2,:) = I%XDG(:,2,:)
- IF(I%CISBA=='3-L')THEN
- ZDG(:,3,:) = I%XDG(:,3,:)-I%XDG(:,2,:)
- ENDIF
-!
- DO JPATCH=1,I%NPATCH
- DO JLAYER=1,I%NGROUND_LAYER
- DO JJ=1,INI
- ZWG (JJ,JLAYER)=ZWG (JJ,JLAYER)+I%XPATCH(JJ,JPATCH)*I%XWG (JJ,JLAYER,JPATCH)*ZDG(JJ,JLAYER,JPATCH)
- ZWGI (JJ,JLAYER)=ZWGI (JJ,JLAYER)+I%XPATCH(JJ,JPATCH)*I%XWGI(JJ,JLAYER,JPATCH)*ZDG(JJ,JLAYER,JPATCH)
- ZDG_TOT(JJ,JLAYER)=ZDG_TOT(JJ,JLAYER)+I%XPATCH(JJ,JPATCH)*ZDG(JJ,JLAYER,JPATCH)
- ENDDO
- ENDDO
+ DO JP=1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+
+ ZDG(1:PK%NSIZE_P,1) = PK%XDG(:,1)
+ ZDG(1:PK%NSIZE_P,2) = PK%XDG(:,2)
+ IF(IO%CISBA=='3-L')THEN
+ ZDG(1:PK%NSIZE_P,3) = PK%XDG(:,3)-PK%XDG(:,2)
+ ENDIF
+
+ DO JJ=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JJ)
+ DO JL=1,IO%NGROUND_LAYER
+
+ ZWG(IMASK,JL) = ZWG (IMASK,JL)+ PK%XPATCH(JJ) *PEK%XWG(JJ,JL)* ZDG(JJ,JL)
+ ZWGI(IMASK,JL)= ZWGI(IMASK,JL)+ PK%XPATCH(JJ) *PEK%XWGI(JJ,JL)* ZDG(JJ,JL)
+ ZDG_TOT(IMASK,JL)=ZDG_TOT(IMASK,JL)+PK%XPATCH(JJ)*ZDG(JJ,JL)
+ ENDDO
+ ENDDO
ENDDO
!
ENDIF
@@ -2258,60 +1768,72 @@ ENDWHERE
!
! * soil liquid water content (m3/m3) and soil moisture (kg/m2)
!
-DO JLAYER=1,I%NGROUND_LAYER
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
+IF (LALLOW_ADD_DIM) THEN
+ YRECFM='WG_ISBA' ;
YCOMMENT='Soil liquid water content (m3/m3)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,ZWG(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
-END DO
+ CALL WRITE_SURF(DUO%CSELECT, &
+ HPROGRAM,YRECFM,ZWG(:,:),IRESP,YCOMMENT,HNAM_DIM=YWGROUND_LAYER_DIM_NAME)
+ELSE
+ DO JL=1,IO%NGROUND_LAYER
+ WRITE(YLVL,'(I4)') JL
+ YRECFM='WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
+ YCOMMENT='Soil liquid water content (m3/m3)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZWG(:,JL),IRESP,HCOMMENT=YCOMMENT)
+ END DO
+ENDIF
!
! * soil ice water content (m3/m3) and soil ice mass (kg/m2)
!
-IWORK=I%NGROUND_LAYER
-IF(I%CISBA/='DIF')THEN
+IWORK=IO%NGROUND_LAYER
+IF(IO%CISBA/='DIF')THEN
IWORK=2 ! No ice in the FR 3-layers
ENDIF
!
-DO JLAYER=1,IWORK
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
+IF (LALLOW_ADD_DIM) THEN
+ YRECFM='WGI_ISBA' ;
YCOMMENT='Soil solid water content (m3/m3)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,ZWGI(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
-END DO
+ CALL WRITE_SURF(DUO%CSELECT, &
+ HPROGRAM,YRECFM,ZWGI(:,:),IRESP,YCOMMENT,HNAM_DIM=YWIGROUND_LAYER_DIM_NAME)
+ELSE
+ DO JL=1,IWORK
+ WRITE(YLVL,'(I4)') JL
+ YRECFM='WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
+ YCOMMENT='Soil solid water content (m3/m3)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZWGI(:,JL),IRESP,HCOMMENT=YCOMMENT)
+ END DO
+ENDIF
!
! * water intercepted on leaves (kg/m2)
!
ZWORK(:)=0.0
-DO JPATCH=1,I%NPATCH
- DO JJ=1,INI
- ZWORK(JJ) = ZWORK(JJ) + I%XPATCH(JJ,JPATCH) * I%XWR(JJ,JPATCH)
- ENDDO
+DO JP=1,IO%NPATCH
+ DO JJ=1,NP%AL(JP)%NSIZE_P
+ IMASK = NP%AL(JP)%NR_P(JJ)
+ ZWORK(IMASK) = ZWORK(IMASK) + NP%AL(JP)%XPATCH(JJ) * NPE%AL(JP)%XWR(JJ)
+ ENDDO
ENDDO
!
YRECFM='WR_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
+CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
!
! * Glacier ice storage (semi-prognostic) (kg/m2)
!
-IF(I%LGLACIER)THEN
+IF(IO%LGLACIER)THEN
!
ZWORK(:)=0.0
- DO JPATCH=1,I%NPATCH
- DO JJ=1,INI
- ZWORK(JJ) = ZWORK(JJ) + I%XPATCH(JJ,JPATCH) * I%XICE_STO(JJ,JPATCH)
+ DO JP=1,IO%NPATCH
+ DO JJ=1,NP%AL(JP)%NSIZE_P
+ IMASK = NP%AL(JP)%NR_P(JJ)
+ ZWORK(IMASK) = ZWORK(IMASK) + NP%AL(JP)%XPATCH(JJ) * NPE%AL(JP)%XICE_STO(JJ)
ENDDO
ENDDO
!
YRECFM='ICE_STO_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
@@ -2319,13 +1841,18 @@ ENDIF
!
ZPATCH(:) = 0.0
ZWORK (:) = 0.0
-DO JPATCH=1,I%NPATCH
- DO JJ=1,INI
- IF(I%TSNOW%ALB(JJ,JPATCH)/=XUNDEF)THEN
- ZWORK (JJ) = ZWORK (JJ) + I%XPATCH(JJ,JPATCH) * I%TSNOW%ALB(JJ,JPATCH)
- ZPATCH(JJ) = ZPATCH(JJ) + I%XPATCH(JJ,JPATCH)
- ENDIF
- ENDDO
+DO JP=1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+
+ DO JJ=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JJ)
+
+ IF(PEK%TSNOW%ALB(JJ)/=XUNDEF)THEN
+ ZWORK (IMASK) = ZWORK (IMASK) + PK%XPATCH(JJ) * PEK%TSNOW%ALB(JJ)
+ ZPATCH(IMASK) = ZPATCH(IMASK) + PK%XPATCH(JJ)
+ ENDIF
+ ENDDO
ENDDO
!
WHERE(ZPATCH(:)>0.0)
@@ -2336,48 +1863,52 @@ ENDWHERE
!
YRECFM='ASN_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
+CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
!
-IF(I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO')THEN
+IF(NPE%AL(1)%TSNOW%SCHEME=='3-L' .OR. NPE%AL(1)%TSNOW%SCHEME=='CRO')THEN
!
! * Snow reservoir (kg/m2) by layer
!
- DO JLAYER = 1,I%TSNOW%NLAYER
+ DO JL = 1,NPE%AL(1)%TSNOW%NLAYER
!
ZWORK(:)=0.0
- DO JPATCH=1,I%NPATCH
- DO JJ=1,INI
- ZWORK(JJ) = ZWORK(JJ) + I%XPATCH(JJ,JPATCH) * I%TSNOW%WSNOW(JJ,JLAYER,JPATCH)
- ENDDO
+ DO JP=1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+ DO JJ=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JJ)
+ ZWORK(IMASK) = ZWORK(IMASK) + PK%XPATCH(JJ) * PEK%TSNOW%WSNOW(JJ,JL)
+ ENDDO
ENDDO
!
- WRITE(YLVL,'(I4)') JLAYER
+ WRITE(YLVL,'(I4)') JL
YRECFM='WSN_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDDO
!
! * Snow depth (m)
!
- DO JLAYER = 1,I%TSNOW%NLAYER
+ DO JL = 1,NPE%AL(1)%TSNOW%NLAYER
!
ZWORK(:)=0.0
- DO JPATCH=1,I%NPATCH
- DO JJ=1,INI
- ZWORK(JJ) = ZWORK(JJ) + I%XPATCH(JJ,JPATCH) * I%TSNOW%WSNOW(JJ,JLAYER,JPATCH)/I%TSNOW%RHO(JJ,JLAYER,JPATCH)
- ENDDO
+ DO JP=1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+ DO JJ=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JJ)
+ ZWORK(IMASK) = ZWORK(IMASK) + PK%XPATCH(JJ) * &
+ PEK%TSNOW%WSNOW(JJ,JL)/PEK%TSNOW%RHO(JJ,JL)
+ ENDDO
ENDDO
!
- WRITE(YLVL,'(I4)') JLAYER
+ WRITE(YLVL,'(I4)') JL
YRECFM='DSN_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDDO
!
@@ -2389,17 +1920,20 @@ IF(I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO')THEN
ZMISS=XUNDEF
ENDIF
!
- DO JLAYER = 1,I%TSNOW%NLAYER
+ DO JL = 1,NPE%AL(1)%TSNOW%NLAYER
!
ZWORK (:) = 0.0
ZPATCH(:) = 0.0
- DO JPATCH=1,I%NPATCH
- DO JJ=1,INI
- IF(I%TSNOW%WSNOW(JJ,JLAYER,JPATCH)>0.)THEN
- ZWORK (JJ) = ZWORK (JJ) + I%XPATCH(JJ,JPATCH) * I%TSNOW%TEMP(JJ,JLAYER,JPATCH)
- ZPATCH(JJ) = ZPATCH(JJ) + I%XPATCH(JJ,JPATCH)
- ENDIF
- ENDDO
+ DO JP=1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+ DO JJ=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JJ)
+ IF(PEK%TSNOW%WSNOW(JJ,JL)>0.)THEN
+ ZWORK (IMASK) = ZWORK (IMASK) + PK%XPATCH(JJ) * PEK%TSNOW%TEMP(JJ,JL)
+ ZPATCH(IMASK) = ZPATCH(IMASK) + PK%XPATCH(JJ)
+ ENDIF
+ ENDDO
ENDDO
!
WHERE(ZPATCH(:)>0.0)
@@ -2408,26 +1942,28 @@ IF(I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO')THEN
ZWORK(:) = ZMISS
ENDWHERE
!
- WRITE(YLVL,'(I4)') JLAYER
+ WRITE(YLVL,'(I4)') JL
YRECFM='TSN_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (K)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDDO
!
! * Snow age (day)
!
- DO JLAYER = 1,I%TSNOW%NLAYER
+ DO JL = 1,NPE%AL(1)%TSNOW%NLAYER
!
ZWORK (:) = 0.0
ZPATCH(:) = 0.0
- DO JPATCH=1,I%NPATCH
- DO JJ=1,INI
- IF(I%TSNOW%WSNOW(JJ,JLAYER,JPATCH)>0.)THEN
- ZWORK (JJ) = ZWORK (JJ) + I%XPATCH(JJ,JPATCH) * I%TSNOW%AGE(JJ,JLAYER,JPATCH)
- ZPATCH(JJ) = ZPATCH(JJ) + I%XPATCH(JJ,JPATCH)
+ DO JP=1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+ DO JJ=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JJ)
+ IF(PEK%TSNOW%WSNOW(JJ,JL)>0.)THEN
+ ZWORK (IMASK) = ZWORK (IMASK) + PK%XPATCH(JJ) * PEK%TSNOW%AGE(JJ,JL)
+ ZPATCH(IMASK) = ZPATCH(IMASK) + PK%XPATCH(JJ)
ENDIF
ENDDO
ENDDO
@@ -2436,12 +1972,11 @@ IF(I%TSNOW%SCHEME=='3-L' .OR. I%TSNOW%SCHEME=='CRO')THEN
ZWORK(:) = ZWORK(:) / ZPATCH(:)
ENDWHERE
!
- WRITE(YLVL,'(I4)') JLAYER
+ WRITE(YLVL,'(I4)') JL
YRECFM='AGSN_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (day_since_snowfall)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDDO
!
@@ -2449,81 +1984,85 @@ ENDIF
!
! * Isba-Ags biomass reservoir
!
-IF(I%CPHOTO=='NIT'.OR.I%CPHOTO=='NCB')THEN
+IF(IO%CPHOTO=='NIT'.OR.IO%CPHOTO=='NCB')THEN
!
ZBIOMASS(:,:)=0.0
- DO JPATCH=1,I%NPATCH
- DO JLAYER=1,I%NNBIOMASS
- DO JJ=1,INI
- ZBIOMASS(JJ,JLAYER) = ZBIOMASS(JJ,JLAYER) + I%XPATCH(JJ,JPATCH) * I%XBIOMASS(JJ,JLAYER,JPATCH)
- ENDDO
- ENDDO
+ DO JP=1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+ DO JJ=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JJ)
+ DO JL=1,IO%NNBIOMASS
+ ZBIOMASS(IMASK,JL) = ZBIOMASS(IMASK,JL) + PK%XPATCH(JJ) * PEK%XBIOMASS(JJ,JL)
+ ENDDO
+ ENDDO
ENDDO
!
- DO JLAYER = 1,I%NNBIOMASS
- WRITE(YLVL,'(I4)') JLAYER
+ DO JL = 1,IO%NNBIOMASS
+ WRITE(YLVL,'(I4)') JL
YRECFM='BIOM'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (kgDM/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,ZBIOMASS(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZBIOMASS(:,JL),IRESP,HCOMMENT=YCOMMENT)
ENDDO
!
ENDIF
!
! * Isba-CC carbon reservoir
!
-IF(I%CRESPSL=='CNT')THEN
+IF(IO%CRESPSL=='CNT')THEN
!
ZLITTER(:,:,:)=0.0
ZLIGNIN_STRUC(:,:)=0.0
- DO JPATCH=1,I%NPATCH
- DO JLAYER=1,I%NNLITTLEVS
- DO JJ=1,INI
- ZLITTER(JJ,1,JLAYER) = ZLITTER(JJ,1,JLAYER) + I%XPATCH(JJ,JPATCH) * I%XLITTER(JJ,1,JLAYER,JPATCH)
- ZLITTER(JJ,2,JLAYER) = ZLITTER(JJ,2,JLAYER) + I%XPATCH(JJ,JPATCH) * I%XLITTER(JJ,2,JLAYER,JPATCH)
- ZLIGNIN_STRUC(JJ,JLAYER) = ZLIGNIN_STRUC(JJ,JLAYER) + I%XPATCH(JJ,JPATCH) * I%XLIGNIN_STRUC(JJ,JLAYER,JPATCH)
- ENDDO
+ DO JP=1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+ DO JJ=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JJ)
+ DO JL=1,IO%NNLITTLEVS
+ ZLITTER(IMASK,1,JL) = ZLITTER(IMASK,1,JL) + PK%XPATCH(JJ) * PEK%XLITTER(JJ,1,JL)
+ ZLITTER(IMASK,2,JL) = ZLITTER(IMASK,2,JL) + PK%XPATCH(JJ) * PEK%XLITTER(JJ,2,JL)
+ ZLIGNIN_STRUC(IMASK,JL) = ZLIGNIN_STRUC(IMASK,JL) + PK%XPATCH(JJ) * PEK%XLIGNIN_STRUC(JJ,JL)
+ ENDDO
ENDDO
ENDDO
!
- DO JLAYER=1,I%NNLITTLEVS
- WRITE(YLVL,'(I4)') JLAYER
+ DO JL=1,IO%NNLITTLEVS
+ WRITE(YLVL,'(I4)') JL
YRECFM='LIT1_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (gC/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,ZLITTER(:,1,JLAYER),IRESP,HCOMMENT=YCOMMENT)
- WRITE(YLVL,'(I4)') JLAYER
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZLITTER(:,1,JL),IRESP,HCOMMENT=YCOMMENT)
+ WRITE(YLVL,'(I4)') JL
YRECFM='LIT2_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (gC/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,ZLITTER(:,2,JLAYER),IRESP,HCOMMENT=YCOMMENT)
- WRITE(YLVL,'(I4)') JLAYER
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,ZLITTER(:,2,JL),IRESP,HCOMMENT=YCOMMENT)
+ WRITE(YLVL,'(I4)') JL
YRECFM='LIGSTR'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,ZLIGNIN_STRUC(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZLIGNIN_STRUC(:,JL),IRESP,HCOMMENT=YCOMMENT)
END DO
!
ZSOILCARB(:,:)=0.0
- DO JPATCH=1,I%NPATCH
- DO JLAYER=1,I%NNSOILCARB
- DO JJ=1,INI
- ZSOILCARB(JJ,JLAYER) = ZSOILCARB(JJ,JLAYER) + I%XPATCH(JJ,JPATCH) * I%XSOILCARB(JJ,JLAYER,JPATCH)
- ENDDO
+ DO JP=1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+ DO JJ=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JJ)
+ DO JL=1,IO%NNSOILCARB
+ ZSOILCARB(IMASK,JL) = ZSOILCARB(IMASK,JL) + PK%XPATCH(JJ) * PEK%XSOILCARB(JJ,JL)
+ ENDDO
ENDDO
ENDDO
!
- DO JLAYER = 1,I%NNSOILCARB
- WRITE(YLVL,'(I4)') JLAYER
+ DO JL = 1,IO%NNSOILCARB
+ WRITE(YLVL,'(I4)') JL
YRECFM='SCARB'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
YCOMMENT='X_Y_'//YRECFM//' (gC/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,ZSOILCARB(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,ZSOILCARB(:,JL),IRESP,HCOMMENT=YCOMMENT)
ENDDO
!
ENDIF
diff --git a/src/SURFEX/write_diag_seb_oceann.F90 b/src/SURFEX/write_diag_seb_oceann.F90
index 33e7937cada2a83df8fdc595c17ab41274b55b74..fc24c8de051219c8b0702a3a2814792be6ec77b2 100644
--- a/src/SURFEX/write_diag_seb_oceann.F90
+++ b/src/SURFEX/write_diag_seb_oceann.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_DIAG_SEB_OCEAN_n (DTCO, DGU, U, DGO, &
- HPROGRAM)
+ SUBROUTINE WRITE_DIAG_SEB_OCEAN_n (DTCO, HSELECT, U, DGO, HPROGRAM)
! #################################
!
!!**** *WRITE_DIAG_SEB_OCEAN_n* - write the oceanic diagnostic fields
@@ -34,7 +33,6 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_DIAG_OCEAN_n, ONLY : DIAG_OCEAN_t
!
@@ -54,7 +52,7 @@ IMPLICIT NONE
! -------------------------
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(DIAG_OCEAN_t), INTENT(INOUT) :: DGO
!
@@ -73,8 +71,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! Initialisation for IO
!
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_OCEAN_N',0,ZHOOK_HANDLE)
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'SEA ','SEAFLX','WRITE')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'SEA ','SEAFLX','WRITE','SEAFLUX_DIAGNOSTICS.OUT.nc')
!
!
!* 2. Mean values in OML :
@@ -83,32 +80,27 @@ IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_OCEAN_N',0,ZHOOK_HANDLE)
YRECFM='TOML'
YCOMMENT='X_Y_'//YRECFM
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGO%XTOCMOY(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DGO%XTOCMOY(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='SOML'
YCOMMENT='X_Y_'//YRECFM
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGO%XSOCMOY(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DGO%XSOCMOY(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='UOML'
YCOMMENT='X_Y_'//YRECFM
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGO%XUOCMOY(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DGO%XUOCMOY(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='VOML'
YCOMMENT='X_Y_'//YRECFM
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGO%XVOCMOY(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DGO%XVOCMOY(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='DOML'
YCOMMENT='X_Y_'//YRECFM
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGO%XDOCMOY(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DGO%XDOCMOY(:),IRESP,HCOMMENT=YCOMMENT)
!
!------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/write_diag_seb_seafluxn.F90 b/src/SURFEX/write_diag_seb_seafluxn.F90
index 40eb92b65d0d0c829966754a3c4bcc4565e2f6b2..16afa444ad4742b1c1313bc7ce1cdfc16b044599 100644
--- a/src/SURFEX/write_diag_seb_seafluxn.F90
+++ b/src/SURFEX/write_diag_seb_seafluxn.F90
@@ -3,8 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_DIAG_SEB_SEAFLUX_n (DTCO, DGU, U, CHS, DGS, S, &
- HPROGRAM)
+ SUBROUTINE WRITE_DIAG_SEB_SEAFLUX_n (DTCO, DUO, U, CHS, DSO, D, DC, &
+ OHANDLE_SIC,HPROGRAM)
! #################################
!
!!**** *WRITE_DIAG_SEB_SEAFLUX_n* - write the SEAFLUX diagnostic fields
@@ -34,31 +34,28 @@
!! S.Senesi 01/2014 : add diags on seaice
!! S. Belamari 06/2014 : Introduce GRESET to avoid errors due to NBLOCK=0
!! when coupled with ARPEGE/ALADIN/AROME
-!! B. Decharme 02/2016 : NBLOCK instead of LCOUNTW for compilation in AAA
+!! S. Senesi 08/15 Add 2nd dimension name for SW bands to write_surf calls
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_CH_SEAFLUX_n, ONLY : CH_SEAFLUX_t
-USE MODD_DIAG_SEAFLUX_n, ONLY : DIAG_SEAFLUX_t
-USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
-!
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
!
#ifdef SFX_ARO
USE MODD_IO_SURF_ARO, ONLY : NBLOCK
#endif
!
+#ifdef SFX_OL
+USE MODD_IO_SURF_OL, ONLY : LDEF
+#endif
!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-!
+USE MODD_XIOS, ONLY : LALLOW_ADD_DIM, YSWBAND_DIM_NAME
!
-!
+USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE MODI_INIT_IO_SURF_n
USE MODI_WRITE_SURF
@@ -74,11 +71,13 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DUO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(CH_SEAFLUX_t), INTENT(INOUT) :: CHS
-TYPE(DIAG_SEAFLUX_t), INTENT(INOUT) :: DGS
-TYPE(SEAFLUX_t), INTENT(INOUT) :: S
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DSO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
+LOGICAL, INTENT(IN) :: OHANDLE_SIC
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
!
@@ -106,278 +105,187 @@ GRESET=.TRUE.
#ifdef SFX_ARO
GRESET=(NBLOCK>0)
#endif
+#ifdef SFX_OL
+IF (LDEF) GRESET = .FALSE.
+#endif
!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'SEA ','SEAFLX','WRITE')
+ CALL INIT_IO_SURF_n(DTCO, U,HPROGRAM,'SEA ','SEAFLX','WRITE','SEAFLUX_DIAGNOSTICS.OUT.nc')
!
!
!* 1. Surface temperature :
! ---------------------
!
-GMISC=(DGS%N2M>=1.OR.DGS%LSURF_BUDGET.OR.DGS%LSURF_BUDGETC)
+GMISC=(DSO%N2M>=1.OR.DSO%LSURF_BUDGET.OR.DSO%LSURF_BUDGETC)
!
-IF (GMISC.AND.S%LHANDLE_SIC) THEN
+IF (GMISC.AND.OHANDLE_SIC) THEN
!
YRECFM='TS_SEA'
YCOMMENT='X_Y_'//YRECFM//' (K)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XTS(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XTS(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='TSRAD_SEA'
YCOMMENT='X_Y_'//YRECFM//' (K)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XTSRAD(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XTSRAD(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
!* 2. Richardson number :
! -----------------
!
-IF (DGS%N2M>=1) THEN
+IF (DSO%N2M>=1) THEN
!
YRECFM='RI_SEA'
YCOMMENT='X_Y_'//YRECFM
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XRI(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XRI(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
!* 3. Energy fluxes :
! -------------
!
-IF (DGS%LSURF_BUDGET) THEN
+IF (DSO%LSURF_BUDGET) THEN
!
YRECFM='RN_SEA'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XRN(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XRN(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='H_SEA'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XH(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XH(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LE_SEA'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XLE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XLE(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LEI_SEA'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XLE_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XLEI(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='GFLUX_SEA'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='EVAP_SEA'
YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XEVAP(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XEVAP(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='SUBL_SEA'
YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XSUBL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XSUBL(:),IRESP,HCOMMENT=YCOMMENT)
!
- IF (DGS%LRAD_BUDGET) THEN
+ IF (DSO%LRAD_BUDGET) THEN
!
YRECFM='SWD_SEA'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XSWD(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XSWD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='SWU_SEA'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XSWU(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XSWU(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LWD_SEA'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XLWD(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XLWD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LWU_SEA'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XLWU(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XLWU(:),IRESP,HCOMMENT=YCOMMENT)
!
- DO JSW=1, SIZE(DGS%XSWBD,2)
- YNUM=ACHAR(48+JSW)
- !
- YRECFM='SWD_SEA_'//YNUM
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XSWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SWU_SEA_'//YNUM
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XSWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDDO
+ IF (LALLOW_ADD_DIM) THEN
+ !
+ YRECFM='SWD_SEA_'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,&
+ HPROGRAM,YRECFM,D%XSWBD(:,:),IRESP,HCOMMENT=YCOMMENT, HNAM_DIM=YSWBAND_DIM_NAME)
+ !
+ YRECFM='SWU_SEA_'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,&
+ HPROGRAM,YRECFM,D%XSWBU(:,:),IRESP,HCOMMENT=YCOMMENT, HNAM_DIM=YSWBAND_DIM_NAME)
+ !
+ ELSE
+ !
+ DO JSW=1, SIZE(D%XSWBD,2)
+ YNUM=ACHAR(48+JSW)
+ !
+ YRECFM='SWD_SEA_'//YNUM
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ !
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XSWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SWU_SEA_'//YNUM
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ !
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XSWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDDO
+ !
+ ENDIF
!
ENDIF
!
YRECFM='FMU_SEA'
YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XFMU(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XFMU(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='FMV_SEA'
YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XFMV(:),IRESP,HCOMMENT=YCOMMENT)
- !
-END IF
-!
-IF (DGS%LSURF_BUDGETC) THEN
- !
- YRECFM='RNC_SEA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XRNC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='HC_SEA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XHC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEC_SEA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XLEC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEIC_SEA'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XLEC_ICE(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='GFLUXC_SEA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XGFLUXC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='EVAPC_SEA'
- YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XEVAPC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SUBLC_SEA'
- YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XSUBLC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF (DGS%LRAD_BUDGET .OR. (DGS%LSURF_BUDGETC .AND. .NOT.DGU%LRESET_BUDGETC)) THEN
- !
- YRECFM='SWDC_SEA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XSWDC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SWUC_SEA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XSWUC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWDC_SEA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XLWDC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWUC_SEA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XLWUC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
- YRECFM='FMUC_SEA'
- YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XFMUC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='FMVC_SEA'
- YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XFMVC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XFMV(:),IRESP,HCOMMENT=YCOMMENT)
!
END IF
!
-IF (DGS%LSURF_BUDGET.OR.DGS%LSURF_BUDGETC) THEN
+IF (DSO%LSURF_BUDGET.OR.DSO%LSURF_BUDGETC) THEN
!
YRECFM='TALB_SEA'
YCOMMENT='total albedo over tile sea (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XALBT(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XALBT(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
!* 4. transfer coefficients
! ---------------------
!
-IF (DGS%LCOEF) THEN
+IF (DSO%LCOEF) THEN
!
YRECFM='CD_SEA'
YCOMMENT='X_Y_'//YRECFM//' (W/s2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XCD(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XCD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='CH_SEA'
YCOMMENT='X_Y_'//YRECFM//' (W/s)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XCH(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XCH(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='CE_SEA'
YCOMMENT='X_Y_'//YRECFM//' (W/s/K)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XCE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XCE(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='Z0_SEA'
YCOMMENT='X_Y_'//YRECFM//' (M)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XZ0(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XZ0(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='Z0H_SEA'
YCOMMENT='X_Y_'//YRECFM//' (M)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XZ0H(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XZ0H(:),IRESP,HCOMMENT=YCOMMENT)
!
END IF
!
@@ -385,13 +293,12 @@ END IF
!* 5. Surface humidity
! ----------------
!
-IF (DGS%LSURF_VARS) THEN
+IF (DSO%LSURF_VARS) THEN
!
YRECFM='QS_SEA'
YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XQS(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XQS(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
@@ -399,78 +306,67 @@ ENDIF
!* 6. parameters at 2 and 10 meters :
! -----------------------------
!
-IF (DGS%N2M>=1) THEN
+IF (DSO%N2M>=1) THEN
!
YRECFM='T2M_SEA'
YCOMMENT='X_Y_'//YRECFM//' (K)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XT2M(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XT2M(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='T2MMIN_SEA'
YCOMMENT='X_Y_'//YRECFM//' (K)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XT2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
- IF(GRESET)DGS%XT2M_MIN(:)=XUNDEF
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XT2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)D%XT2M_MIN(:)=XUNDEF
!
YRECFM='T2MMAX_SEA'
YCOMMENT='X_Y_'//YRECFM//' (K)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XT2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
- IF(GRESET)DGS%XT2M_MAX(:)=0.0
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XT2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)D%XT2M_MAX(:)=0.0
!
YRECFM='Q2M_SEA'
YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XQ2M(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XQ2M(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='HU2M_SEA'
YCOMMENT='X_Y_'//YRECFM//' (-)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XHU2M(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XHU2M(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='HU2MMIN_SEA'
YCOMMENT='X_Y_'//YRECFM//' (-)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XHU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
- IF(GRESET)DGS%XHU2M_MIN(:)=XUNDEF
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XHU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)D%XHU2M_MIN(:)=XUNDEF
!
YRECFM='HU2MMAX_SEA'
YCOMMENT='X_Y_'//YRECFM//' (-)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XHU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
- IF(GRESET)DGS%XHU2M_MAX(:)=-XUNDEF
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XHU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)D%XHU2M_MAX(:)=-XUNDEF
!
YRECFM='ZON10M_SEA'
YCOMMENT='X_Y_'//YRECFM//' (M/S)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XZON10M(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XZON10M(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='MER10M_SEA'
YCOMMENT='X_Y_'//YRECFM//' (M/S)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XMER10M(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XMER10M(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='W10M_SEA'
YCOMMENT='X_Y_'//YRECFM//' (M/S)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XWIND10M(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XWIND10M(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='W10MMAX_SEA'
YCOMMENT='X_Y_'//YRECFM//' (M/S)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XWIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
- IF(GRESET)DGS%XWIND10M_MAX(:)=0.0
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XWIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)D%XWIND10M_MAX(:)=0.0
!
END IF
!
@@ -480,13 +376,87 @@ END IF
!
IF (CHS%SVS%NBEQ>0 .AND. CHS%CCH_DRY_DEP=="WES89 ") THEN
DO JSV = 1,SIZE(CHS%CCH_NAMES,1)
- YRECFM='DV_SEA_'//TRIM(CHS%CCH_NAMES(JSV))
+ YRECFM='DVSE'//TRIM(CHS%CCH_NAMES(JSV))
WRITE(YCOMMENT,'(A13,I3.3)')'(m/s) DV_SEA_',JSV
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,CHS%XDEP(:,JSV),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,CHS%XDEP(:,JSV),IRESP,HCOMMENT=YCOMMENT)
END DO
ENDIF
!
+IF (DSO%LSURF_BUDGETC) THEN
+ !
+ CALL END_IO_SURF_n(HPROGRAM)
+ CALL INIT_IO_SURF_n(DTCO, U,HPROGRAM,'SEA ','SEAFLX','WRITE','SEAFLUX_DIAG_CUMUL.OUT.nc')
+ !
+ YRECFM='RNC_SEA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ !
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XRN(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='HC_SEA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ !
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XH(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LEC_SEA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ !
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XLE(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LEIC_SEA'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XLEI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='GFLUXC_SEA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ !
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='EVAPC_SEA'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
+ !
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XEVAP(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SUBLC_SEA'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
+ !
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XSUBL(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF (DSO%LRAD_BUDGET .OR. (DSO%LSURF_BUDGETC .AND. .NOT.DUO%LRESET_BUDGETC)) THEN
+ !
+ YRECFM='SWDC_SEA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ !
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XSWD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SWUC_SEA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ !
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XSWU(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWDC_SEA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ !
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XLWD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWUC_SEA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ !
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XLWU(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDIF
+ !
+ YRECFM='FMUC_SEA'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
+ !
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XFMU(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='FMVC_SEA'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
+ !
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XFMV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+END IF
+!
!------------------------------------------------------------------------------
!
! End of IO
diff --git a/src/SURFEX/write_diag_seb_seaicen.F90 b/src/SURFEX/write_diag_seb_seaicen.F90
index 0f697c3bf29d514369bb38969e8e48ff54d143a0..b6ad466bcbf23ddc43ab43626eaca09f2a653a65 100644
--- a/src/SURFEX/write_diag_seb_seaicen.F90
+++ b/src/SURFEX/write_diag_seb_seaicen.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_DIAG_SEB_SEAICE_n (DTCO, DGU, U, DGS, DGSI, S, &
- HPROGRAM)
+ SUBROUTINE WRITE_DIAG_SEB_SEAICE_n (DTCO, DUO, U, DSO, DI, DIC, HPROGRAM)
! #################################
!
!!**** *WRITE_DIAG_SEB_SEAICE_n* - write the seaice diagnostic fields
@@ -34,17 +33,11 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_DIAG_SEAFLUX_n, ONLY : DIAG_SEAFLUX_t
-USE MODD_DIAG_SEAICE_n, ONLY : DIAG_SEAICE_t
-USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t, DIAG_t
!
USE MODD_SFX_OASIS, ONLY : LCPL_SEAICE
!
-!
-!
-!
USE MODI_INIT_IO_SURF_n
USE MODI_WRITE_SURF
USE MODI_END_IO_SURF_n
@@ -58,11 +51,11 @@ IMPLICIT NONE
! -------------------------
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DUO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(DIAG_SEAFLUX_t), INTENT(INOUT) :: DGS
-TYPE(DIAG_SEAICE_t), INTENT(INOUT) :: DGSI
-TYPE(SEAFLUX_t), INTENT(INOUT) :: S
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DSO
+TYPE(DIAG_t), INTENT(INOUT) :: DI
+TYPE(DIAG_t), INTENT(INOUT) :: DIC
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
!
@@ -70,9 +63,9 @@ TYPE(SEAFLUX_t), INTENT(INOUT) :: S
! -------------------------------
!
INTEGER :: IRESP ! IRESP : return-code if a problem appears
- CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=100):: YCOMMENT ! Comment string
- CHARACTER(LEN=2) :: YNUM
+CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=100):: YCOMMENT ! Comment string
+CHARACTER(LEN=2) :: YNUM
INTEGER :: JSV, JSW
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -83,100 +76,64 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_SEAICE_N',0,ZHOOK_HANDLE)
!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'SEA ','SEAFLX','WRITE')
-!
-IF(LCPL_SEAICE.OR.S%LHANDLE_SIC)THEN
-!
- YCOMMENT='Sea-ice temperature (K)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'TSICE',S%XTICE(:),IRESP,YCOMMENT)
-!
- YCOMMENT='Sea-ice albedo (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'IALB',S%XICE_ALB(:),IRESP,YCOMMENT)
-!
-ENDIF
-!
-IF (TRIM(S%CSEAICE_SCHEME) == 'GELATO') THEN
- YCOMMENT='Sea-ice thickness (m)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'SIT',DGSI%XSIT(:),IRESP,YCOMMENT)
- !
- YCOMMENT='Sea-ice snow depth (m)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'SND',DGSI%XSND(:),IRESP,YCOMMENT)
- !
- YCOMMENT='Sea mixed layer temp for Glt (K)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'SIMLT',DGSI%XMLT(:),IRESP,YCOMMENT)
- !
-ENDIF
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'SEA ','SEAFLX','WRITE','SEAFLUX_DIAGNOSTICS.OUT.nc')
!
!
!* 8.2. Richardson number :
! -----------------
-IF (DGS%N2M>=1) THEN
+IF (DSO%N2M>=1) THEN
!
YRECFM='RI_SEAICE'
YCOMMENT='X_Y_'//YRECFM
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XRI_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DI%XRI(:),IRESP,HCOMMENT=YCOMMENT)
!
END IF
!
!* 8.3 Energy fluxes :
! -------------
!
-IF (DGS%LSURF_BUDGET) THEN
+IF (DSO%LSURF_BUDGET) THEN
YRECFM='RN_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XRN_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DI%XRN(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='H_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XH_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DI%XH(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LE_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XLE_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DI%XLE(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='GFLX_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XGFLUX_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DI%XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
!
- IF (DGS%LRAD_BUDGET) THEN
+ IF (DSO%LRAD_BUDGET) THEN
!
YRECFM='SWU_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XSWU_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DI%XSWU(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LWU_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XLWU_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DI%XLWU(:),IRESP,HCOMMENT=YCOMMENT)
!
- DO JSW=1, SIZE(DGS%XSWBU_ICE,2)
+ DO JSW=1, SIZE(DI%XSWBU,2)
YNUM=ACHAR(48+JSW)
!
YRECFM='SWU_SEAICE_'//YNUM
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XSWBU_ICE(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DI%XSWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
!
ENDDO
!
@@ -185,100 +142,86 @@ IF (DGS%LSURF_BUDGET) THEN
YRECFM='FMU_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XFMU_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DI%XFMU(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='FMV_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XFMV_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DI%XFMV(:),IRESP,HCOMMENT=YCOMMENT)
!
END IF
!
-IF (DGS%LSURF_BUDGETC) THEN
+IF (DSO%LSURF_BUDGETC) THEN
!
YRECFM='RNC_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XRNC_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DIC%XRN(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='HC_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XHC_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DIC%XH(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LEC_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XLEC_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DIC%XLE(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='GFLXC_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XGFLUXC_ICE(:),IRESP,HCOMMENT=YCOMMENT)
- IF (DGS%LRAD_BUDGET .OR. (DGS%LSURF_BUDGETC .AND. .NOT.DGU%LRESET_BUDGETC)) THEN
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DIC%XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
+ IF (DSO%LRAD_BUDGET .OR. (DSO%LSURF_BUDGETC .AND. .NOT.DUO%LRESET_BUDGETC)) THEN
!
YRECFM='SWUC_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XSWUC_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DIC%XSWU(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LWUC_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XLWUC_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DIC%XLWU(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
YRECFM='FMUC_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XFMUC_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DIC%XFMU(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='FMVC_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XFMVC_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DIC%XFMV(:),IRESP,HCOMMENT=YCOMMENT)
!
END IF
!
!* 8.4 transfer coefficients
! ---------------------
!
-IF (DGS%LCOEF) THEN
+IF (DSO%LCOEF) THEN
!
YRECFM='CD_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (W/s2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XCD_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DI%XCD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='CH_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (W/s)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XCH_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DI%XCH(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='Z0_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (M)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XZ0_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DI%XZ0(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='Z0H_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (M)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XZ0H_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DI%XZ0H(:),IRESP,HCOMMENT=YCOMMENT)
!
END IF
!
@@ -286,12 +229,11 @@ END IF
!* 8.5 Surface humidity
! ----------------
!
-IF (DGS%LSURF_VARS) THEN
+IF (DSO%LSURF_VARS) THEN
YRECFM='QS_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XQS_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DI%XQS(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
@@ -300,43 +242,37 @@ ENDIF
!* 8.6. parameters at 2 and 10 meters :
! -----------------------------
!
-IF (DGS%N2M>=1) THEN
+IF (DSO%N2M>=1) THEN
!
YRECFM='T2M_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (K)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XT2M_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DI%XT2M(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='Q2M_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XQ2M_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DI%XQ2M(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='HU2M_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (-)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XHU2M_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DI%XHU2M(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='ZON10M_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (M/S)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XZON10M_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DI%XZON10M(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='MER10M_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (M/S)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XMER10M_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DI%XMER10M(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='W10M_SEAICE'
YCOMMENT='X_Y_'//YRECFM//' (M/S)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGS%XWIND10M_ICE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DI%XWIND10M(:),IRESP,HCOMMENT=YCOMMENT)
!
END IF
!
diff --git a/src/SURFEX/write_diag_seb_surf_atmn.F90 b/src/SURFEX/write_diag_seb_surf_atmn.F90
index 35a659f0a0782e860d6e016eb7bb2fb36ae6acf1..8afc4841804de3a5fb2fc75d73f8f16fe29bfc7b 100644
--- a/src/SURFEX/write_diag_seb_surf_atmn.F90
+++ b/src/SURFEX/write_diag_seb_surf_atmn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_DIAG_SEB_SURF_ATM_n (DTCO, DGU, U, UG, &
- HPROGRAM)
+ SUBROUTINE WRITE_DIAG_SEB_SURF_ATM_n (DTCO, DGO, D, DC, U, HGRID, HPROGRAM)
! #################################
!
!!**** *WRITE_DIAG_SEB_SURF_ATM_n* - writes surface diagnostics
@@ -39,12 +38,13 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
+USE MODD_XIOS, ONLY : LALLOW_ADD_DIM, YSWBAND_DIM_NAME
+!
USE MODI_INIT_IO_SURF_n
USE MODI_WRITE_SURF
USE MODI_END_IO_SURF_n
@@ -60,9 +60,11 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+ CHARACTER(LEN=*), INTENT(IN) :: HGRID
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
!
@@ -83,127 +85,106 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! Initialisation for IO
!
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_SURF_ATM_N',0,ZHOOK_HANDLE)
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'FULL ','SURF ','WRITE')
-!
+ CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'FULL ','SURF ','WRITE','SURF_ATM_DIAGNOSTICS.OUT.nc')
!
!* 1. Richardson number :
! -----------------
!
-IF (DGU%N2M>=1) THEN
+IF (DGO%N2M>=1) THEN
!
YRECFM='RI'
YCOMMENT='X_Y_'//YRECFM
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_RI(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XRI(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
!* 2. parameters at surface, 2 and 10 meters :
! ----------------------------------------
!
-IF (DGU%N2M>=1.OR.DGU%LSURF_BUDGET.OR.DGU%LSURF_BUDGETC) THEN
+IF (DGO%N2M>=1.OR.DGO%LSURF_BUDGET.OR.DGO%LSURF_BUDGETC) THEN
!
YRECFM='TS'
YCOMMENT='X_Y_'//YRECFM//' (K)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_TS(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XTS(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='TSRAD'
YCOMMENT='X_Y_'//YRECFM//' (K)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XDIAG_TRAD(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XTRAD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='EMIS'
YCOMMENT='X_Y_'//YRECFM//' (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XDIAG_EMIS(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XEMIS(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='SFCO2'
YCOMMENT='X_Y_'//YRECFM//' (M.kgCO2.S-1.kgAIR-1)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_SFCO2(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XSFCO2(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
-IF (DGU%N2M>=1) THEN
+IF (DGO%N2M>=1) THEN
!
YRECFM='T2M'
YCOMMENT='X_Y_'//YRECFM//' (K)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_T2M(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XT2M(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='T2MMIN'
YCOMMENT='X_Y_'//YRECFM//' (K)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_T2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XT2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='T2MMAX'
YCOMMENT='X_Y_'//YRECFM//' (K)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_T2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XT2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='Q2M'
YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_Q2M(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XQ2M(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='HU2M'
YCOMMENT='X_Y_'//YRECFM//' (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_HU2M(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XHU2M(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='HU2MMIN'
YCOMMENT='X_Y_'//YRECFM//' (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_HU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XHU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='HU2MMAX'
YCOMMENT='X_Y_'//YRECFM//' (-)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_HU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XHU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
!
- IF ( SUM_ON_ALL_PROCS(HPROGRAM,UG%CGRID,DGU%XAVG_ZON10M(:)/= XUNDEF) > 0. ) THEN
+ IF ( SUM_ON_ALL_PROCS(HPROGRAM,HGRID,D%XZON10M(:)/= XUNDEF) > 0. ) THEN
!
YRECFM='ZON10M'
YCOMMENT='X_Y_'//YRECFM//' (M/S)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_ZON10M(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XZON10M(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='MER10M'
YCOMMENT='X_Y_'//YRECFM//' (M/S)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_MER10M(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XMER10M(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='W10M'
YCOMMENT='X_Y_'//YRECFM//' (M/S)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_WIND10M(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XWIND10M(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='W10MMAX'
YCOMMENT='X_Y_'//YRECFM//' (M/S)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_WIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XWIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
- IF (DGU%L2M_MIN_ZS) THEN
+ IF (DGO%L2M_MIN_ZS) THEN
!
YRECFM='T2M_MIN_ZS'
YCOMMENT='X_Y_'//YRECFM//' (K)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_T2M_MIN_ZS(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XT2M_MIN_ZS(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='Q2M_MIN_ZS'
YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_Q2M_MIN_ZS(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XQ2M_MIN_ZS(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='HU2M_MIN_ZS'
YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_HU2M_MIN_ZS(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XHU2M_MIN_ZS(:),IRESP,HCOMMENT=YCOMMENT)
!
END IF
!
@@ -212,180 +193,166 @@ END IF
!* 3. Energy fluxes :
! -------------
!
-IF (DGU%LSURF_BUDGET) THEN
+IF (DGO%LSURF_BUDGET) THEN
!
YRECFM='RN'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_RN(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XRN(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='H'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_H(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XH(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LE'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_LE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XLE(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LEI'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_LEI(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XLEI(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='GFLUX'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_GFLUX(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='EVAP'
YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_EVAP(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XEVAP(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='SUBL'
YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_SUBL(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XSUBL(:),IRESP,HCOMMENT=YCOMMENT)
!
- IF (DGU%LRAD_BUDGET) THEN
+ IF (DGO%LRAD_BUDGET) THEN
!
YRECFM='SWD'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_SWD(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XSWD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='SWU'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_SWU(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XSWU(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LWD'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_LWD(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XLWD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LWU'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_LWU(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XLWU(:),IRESP,HCOMMENT=YCOMMENT)
!
- DO JSW=1, SIZE(DGU%XAVG_SWBD,2)
- YNUM=ACHAR(48+JSW)
+ IF (LALLOW_ADD_DIM) THEN
!
- YRECFM='SWD_'//YNUM
+ YRECFM='SWD_'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_SWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,&
+ HPROGRAM,YRECFM,D%XSWBD(:,:),IRESP,HCOMMENT=YCOMMENT, HNAM_DIM=YSWBAND_DIM_NAME)
!
- YRECFM='SWU_'//YNUM
+ YRECFM='SWU_'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_SWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,&
+ HPROGRAM,YRECFM,D%XSWBD(:,:),IRESP,HCOMMENT=YCOMMENT, HNAM_DIM=YSWBAND_DIM_NAME)
+ !
+ ELSE
+ !
+ DO JSW=1, SIZE(D%XSWBD,2)
+ YNUM=ACHAR(48+JSW)
+ !
+ YRECFM='SWD_'//YNUM
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XSWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SWU_'//YNUM
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XSWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDDO
!
- ENDDO
+ ENDIF
!
ENDIF
!
YRECFM='FMUNOSSO'
YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_FMU(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XFMU(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='FMVNOSSO'
YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_FMV(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XFMV(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='FMU'
YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XSSO_FMU(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XSSO_FMU(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='FMV'
YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XSSO_FMV(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XSSO_FMV(:),IRESP,HCOMMENT=YCOMMENT)
!
END IF
!
! * Cumulated diag
!
-IF (DGU%LSURF_BUDGETC) THEN
+IF (DGO%LSURF_BUDGETC) THEN
!
YRECFM='RNC'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_RNC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,DC%XRN(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='HC'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_HC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,DC%XH(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LEC'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_LEC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,DC%XLE(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LEIC'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_LEIC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,DC%XLEI(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='GFLUXC'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_GFLUXC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,DC%XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='EVAPC'
YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_EVAPC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,DC%XEVAP(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='SUBLC'
YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_SUBLC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,DC%XSUBL(:),IRESP,HCOMMENT=YCOMMENT)
!
- IF (DGU%LRAD_BUDGET .OR. (DGU%LSURF_BUDGETC .AND. .NOT.DGU%LRESET_BUDGETC)) THEN
+ IF (DGO%LRAD_BUDGET .OR. (DGO%LSURF_BUDGETC .AND. .NOT.DGO%LRESET_BUDGETC)) THEN
!
YRECFM='SWDC'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_SWDC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,DC%XSWD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='SWUC'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_SWUC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,DC%XSWU(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LWDC'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_LWDC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,DC%XLWD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='LWUC'
YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_LWUC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,DC%XLWU(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
YRECFM='FMUC'
YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_FMUC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,DC%XFMU(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='FMVC'
YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_FMVC(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,DC%XFMV(:),IRESP,HCOMMENT=YCOMMENT)
!
END IF
!
@@ -393,42 +360,35 @@ END IF
!* 4. Transfer coefficients
! ---------------------
!
-IF (DGU%LCOEF) THEN
+IF (DGO%LCOEF) THEN
!
YRECFM='CD'
YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_CD(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XCD(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='CH'
YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_CH(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XCH(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='CE'
YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_CE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XCE(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='Z0'
YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_Z0(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XZ0(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='Z0H'
YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_Z0H(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XZ0H(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='UREF'
YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XDIAG_UREF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XUREF(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='ZREF'
YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XDIAG_ZREF(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XZREF(:),IRESP,HCOMMENT=YCOMMENT)
!
END IF
!
@@ -436,13 +396,12 @@ END IF
!* 5. Surface humidity
! ----------------
!
-IF (DGU%LSURF_VARS) THEN
+IF (DGO%LSURF_VARS) THEN
!
YRECFM='QS'
YCOMMENT='X_Y_'//YRECFM//' (kg/kg)'
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGU%XAVG_QS(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DGO%CSELECT,HPROGRAM,YRECFM,D%XQS(:),IRESP,HCOMMENT=YCOMMENT)
!
ENDIF
!
diff --git a/src/SURFEX/write_diag_seb_tebn.F90 b/src/SURFEX/write_diag_seb_tebn.F90
index 40c1cbc65b473ef40dff042deb349ec51d6c33c9..b255c6030182f848c972deb3831b3835cbcbd1a4 100644
--- a/src/SURFEX/write_diag_seb_tebn.F90
+++ b/src/SURFEX/write_diag_seb_tebn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_DIAG_SEB_TEB_n (DTCO, DGU, U, CHT, DGT, DGUT, &
- HPROGRAM)
+ SUBROUTINE WRITE_DIAG_SEB_TEB_n (DTCO, HSELECT, U, CHT, DGO, D, DUT, HPROGRAM)
! #################################
!
!!**** *WRITE_DIAG_SEB_TEB_n* - writes TEB diagnostics
@@ -38,25 +37,28 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t, DIAG_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_CH_TEB_n, ONLY : CH_TEB_t
-USE MODD_DIAG_TEB_n, ONLY : DIAG_TEB_t
USE MODD_DIAG_UTCI_TEB_n, ONLY : DIAG_UTCI_TEB_t
!
+USE MODD_XIOS, ONLY : LALLOW_ADD_DIM, YSWBAND_DIM_NAME
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_UTCI
+!
#ifdef SFX_ARO
USE MODD_IO_SURF_ARO, ONLY : NBLOCK
#endif
!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_UTCI
-
+#ifdef SFX_OL
+USE MODD_IO_SURF_OL, ONLY : LDEF
+#endif
!
USE MODI_INIT_IO_SURF_n
USE MODI_WRITE_SURF
USE MODI_END_IO_SURF_n
!
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -67,11 +69,12 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(CH_TEB_t), INTENT(INOUT) :: CHT
-TYPE(DIAG_TEB_t), INTENT(INOUT) :: DGT
-TYPE(DIAG_UTCI_TEB_t), INTENT(INOUT) :: DGUT
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_UTCI_TEB_t), INTENT(INOUT) :: DUT
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
!
@@ -97,111 +100,103 @@ GRESET=.TRUE.
#ifdef SFX_ARO
GRESET=(NBLOCK>0)
#endif
+#ifdef SFX_OL
+IF (LDEF) GRESET = .FALSE.
+#endif
!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'TOWN ','TEB ','WRITE')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'TOWN ','TEB ','WRITE','TEB_DIAGNOSTICS.OUT.nc')
!
!
!
!* 2. Richardson number :
! -----------------
!
-IF (DGT%N2M>=1) THEN
+IF (DGO%N2M>=1) THEN
-YRECFM='RI_TEB'
-YCOMMENT='X_Y_'//YRECFM
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XRI(:),IRESP,HCOMMENT=YCOMMENT)
-!
+ YRECFM='RI_TEB'
+ YCOMMENT='X_Y_'//YRECFM
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XRI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
END IF
!
!* 3. Energy fluxes :
! -------------
!
-IF (DGT%LSURF_BUDGET) THEN
+IF (DGO%LSURF_BUDGET) THEN
-YRECFM='RN_TEB'
-YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XRN(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='H_TEB'
-YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XH(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='LE_TEB'
-YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XLE(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='GFLUX_TEB'
-YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
-!
-IF (DGT%LRAD_BUDGET) THEN
-!
- YRECFM='SWD_TEB'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XSWD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SWU_TEB'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XSWU(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWD_TEB'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XLWD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWU_TEB'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XLWU(:),IRESP,HCOMMENT=YCOMMENT)
- !
- DO JSW=1, SIZE(DGT%XSWBD,2)
- YNUM=ACHAR(48+JSW)
+ YRECFM='RN_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XRN(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='H_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XH(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LE_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XLE(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='GFLUX_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF (DGO%LRAD_BUDGET) THEN
+ !
+ YRECFM='SWD_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XSWD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SWU_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XSWU(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWD_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XLWD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWU_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XLWU(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF (LALLOW_ADD_DIM) THEN
!
- YRECFM='SWD_TEB_'//YNUM
+ YRECFM='SWD_TEB'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,&
+ HPROGRAM,YRECFM,D%XSWBD(:,:),IRESP,HCOMMENT=YCOMMENT, HNAM_DIM=YSWBAND_DIM_NAME)
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XSWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SWU_TEB_'//YNUM
+ YRECFM='SWU_TEB'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,&
+ HPROGRAM,YRECFM,D%XSWBD(:,:),IRESP,HCOMMENT=YCOMMENT, HNAM_DIM=YSWBAND_DIM_NAME)
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XSWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ ELSE
+ !
+ DO JSW=1, SIZE(D%XSWBD,2)
+ YNUM=ACHAR(48+JSW)
+ !
+ YRECFM='SWD_TEB_'//YNUM
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XSWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SWU_TEB_'//YNUM
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XSWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDDO
!
- ENDDO
-!
-ENDIF
-!
-YRECFM='FMU_TEB'
-YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XFMU(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='FMV_TEB'
-YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XFMV(:),IRESP,HCOMMENT=YCOMMENT)
-!
+ ENDIF
+ !
+ ENDIF
+ !
+ YRECFM='FMU_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XFMU(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='FMV_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XFMV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
END IF
!
!
@@ -209,187 +204,143 @@ END IF
!* 4. Transfer coefficients
! ---------------------
!
-IF (DGT%LCOEF) THEN
+IF (DGO%LCOEF) THEN
-YRECFM='CD_TEB'
-YCOMMENT='X_Y_'//YRECFM
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XCD(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='CH_TEB'
-YCOMMENT='X_Y_'//YRECFM
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XCH(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='CE_TEB'
-YCOMMENT='X_Y_'//YRECFM
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XCE(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='Z0_TEB'
-YCOMMENT='X_Y_'//YRECFM//' (M)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XZ0(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='Z0H_TEB'
-YCOMMENT='X_Y_'//YRECFM//' (M)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XZ0H(:),IRESP,HCOMMENT=YCOMMENT)
-!
+ YRECFM='CD_TEB'
+ YCOMMENT='X_Y_'//YRECFM
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XCD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='CH_TEB'
+ YCOMMENT='X_Y_'//YRECFM
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XCH(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='CE_TEB'
+ YCOMMENT='X_Y_'//YRECFM
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XCE(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='Z0_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (M)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XZ0(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='Z0H_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (M)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XZ0H(:),IRESP,HCOMMENT=YCOMMENT)
+ !
ENDIF
!
!
!* 5. Surface humidity
! ----------------
!
-IF (DGT%LSURF_VARS) THEN
+IF (DGO%LSURF_VARS) THEN
-YRECFM='QS_TEB'
-YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XQS(:),IRESP,HCOMMENT=YCOMMENT)
-!
+ YRECFM='QS_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XQS(:),IRESP,HCOMMENT=YCOMMENT)
+ !
ENDIF
!
!* 5. parameters at 2 and 10 meters :
! -----------------------------
!
-IF (DGT%N2M>=1) THEN
+IF (DGO%N2M>=1) THEN
-YRECFM='T2M_TEB'
-YCOMMENT='X_Y_'//YRECFM//' (K)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XT2M(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='T2MMIN_TEB'
-YCOMMENT='X_Y_'//YRECFM//' (K)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XT2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
-IF(GRESET)DGT%XT2M_MIN(:)=XUNDEF
-!
-YRECFM='T2MMAX_TEB'
-YCOMMENT='X_Y_'//YRECFM//' (K)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XT2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
-IF(GRESET)DGT%XT2M_MAX(:)=-XUNDEF
-!
-YRECFM='Q2M_TEB'
-YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XQ2M(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='HU2M_TEB'
-YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XHU2M(:),IRESP,HCOMMENT=YCOMMENT)
- !
-YRECFM='HU2MMIN_TEB'
-YCOMMENT='X_Y_'//YRECFM//' (-)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XHU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
-IF(GRESET)DGT%XHU2M_MIN(:)=XUNDEF
-!
-YRECFM='HU2MMAX_TEB'
-YCOMMENT='X_Y_'//YRECFM//' (-)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XHU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
-IF(GRESET)DGT%XHU2M_MAX(:)=-XUNDEF
-!
-YRECFM='ZON10M_TEB'
-YCOMMENT='X_Y_'//YRECFM//' (M/S)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XZON10M(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='MER10M_TEB'
-YCOMMENT='X_Y_'//YRECFM//' (M/S)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XMER10M(:),IRESP,HCOMMENT=YCOMMENT)
- !
-YRECFM='W10M_TEB'
-YCOMMENT='X_Y_'//YRECFM//' (M/S)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XWIND10M(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='W10MMAX_TEB'
-YCOMMENT='X_Y_'//YRECFM//' (M/S)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XWIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
-IF(GRESET)DGT%XWIND10M_MAX(:)=0.0
-!
-YRECFM='SFCO2_TEB'
-YCOMMENT='X_Y_'//YRECFM//' (M.kgCO2.S-1.kgAIR-1)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGT%XSFCO2(:),IRESP,HCOMMENT=YCOMMENT)
-!
+ YRECFM='T2M_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (K)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XT2M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='T2MMIN_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (K)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XT2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)D%XT2M_MIN(:)=XUNDEF
+ !
+ YRECFM='T2MMAX_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (K)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XT2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)D%XT2M_MAX(:)=-XUNDEF
+ !
+ YRECFM='Q2M_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XQ2M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='HU2M_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XHU2M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='HU2MMIN_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (-)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XHU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)D%XHU2M_MIN(:)=XUNDEF
+ !
+ YRECFM='HU2MMAX_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (-)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XHU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)D%XHU2M_MAX(:)=-XUNDEF
+ !
+ YRECFM='ZON10M_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (M/S)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XZON10M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='MER10M_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (M/S)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XMER10M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='W10M_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (M/S)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XWIND10M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='W10MMAX_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (M/S)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XWIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)D%XWIND10M_MAX(:)=0.0
+ !
+ YRECFM='SFCO2_TEB'
+ YCOMMENT='X_Y_'//YRECFM//' (M.kgCO2.S-1.kgAIR-1)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,D%XSFCO2(:),IRESP,HCOMMENT=YCOMMENT)
+ !
END IF
!
-IF (DGUT%LUTCI .AND. DGT%N2M >0) THEN
+IF (DUT%LUTCI .AND. DGO%N2M >0) THEN
YRECFM='UTCI_IN'
!RJ: extended ascii should be avoided in I/O
YCOMMENT='UTCI for person indoor'//' (°C)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGUT%XUTCI_IN(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DUT%XUTCI_IN(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='UTCI_OUTSUN'
!RJ: extended ascii should be avoided in I/O
YCOMMENT='UTCI for person at sun'//' (°C)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGUT%XUTCI_OUTSUN(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DUT%XUTCI_OUTSUN(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='UTCI_OUTSHAD'
!RJ: extended ascii should be avoided in I/O
YCOMMENT='UTCI for person in shade'//' (°C)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGUT%XUTCI_OUTSHADE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DUT%XUTCI_OUTSHADE(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='TRAD_SUN'
YCOMMENT='Mean radiant temperature seen by person at sun'//' (K)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGUT%XTRAD_SUN(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DUT%XTRAD_SUN(:),IRESP,HCOMMENT=YCOMMENT)
!
YRECFM='TRAD_SHADE'
YCOMMENT='Mean radiant temperature seen by person in shade'//' (K)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGUT%XTRAD_SHADE(:),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DUT%XTRAD_SHADE(:),IRESP,HCOMMENT=YCOMMENT)
!
DO JSTRESS=1,NUTCI_STRESS
YRECFM='UTCIC_IN_'//CUTCI_STRESS_NAMES(JSTRESS)
YCOMMENT='Cumulated time spent in '//CUTCI_STRESS_NAMES(JSTRESS)//' stress range for person indoor'//' (s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGUT%XUTCIC_IN(:,JSTRESS),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DUT%XUTCIC_IN(:,JSTRESS),IRESP,HCOMMENT=YCOMMENT)
END DO
!
DO JSTRESS=1,NUTCI_STRESS
YRECFM='UTCIC_SU_'//CUTCI_STRESS_NAMES(JSTRESS)
YCOMMENT='Cumulated time spent in '//CUTCI_STRESS_NAMES(JSTRESS)//' stress range for person at sun'//' (s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGUT%XUTCIC_OUTSUN(:,JSTRESS),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DUT%XUTCIC_OUTSUN(:,JSTRESS),IRESP,HCOMMENT=YCOMMENT)
END DO
!
DO JSTRESS=1,NUTCI_STRESS
YRECFM='UTCIC_SH_'//CUTCI_STRESS_NAMES(JSTRESS)
YCOMMENT='Cumulated time spent in '//CUTCI_STRESS_NAMES(JSTRESS)//' stress range for person in shade'//' (s)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGUT%XUTCIC_OUTSHADE(:,JSTRESS),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DUT%XUTCIC_OUTSHADE(:,JSTRESS),IRESP,HCOMMENT=YCOMMENT)
END DO
END IF
!
@@ -399,10 +350,9 @@ END IF
!
IF (CHT%SVT%NBEQ>0 .AND. CHT%CCH_DRY_DEP=="WES89 ") THEN
DO JSV = 1,SIZE(CHT%CCH_NAMES,1)
- YRECFM='DV_TWN_'//TRIM(CHT%CCH_NAMES(JSV))
+ YRECFM='DVTN'//TRIM(CHT%CCH_NAMES(JSV))
WRITE(YCOMMENT,'(A13,I3.3)')'(m/s) DV_TWN_',JSV
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,CHT%XDEP(:,JSV),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,CHT%XDEP(:,JSV),IRESP,HCOMMENT=YCOMMENT)
END DO
ENDIF
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/write_diag_seb_watfluxn.F90 b/src/SURFEX/write_diag_seb_watfluxn.F90
index 207dcdbb1451cd65e21e470066ff1eff77ea3b94..361975f4b3747af0494323b46b5d4c94cac8b6b2 100644
--- a/src/SURFEX/write_diag_seb_watfluxn.F90
+++ b/src/SURFEX/write_diag_seb_watfluxn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_DIAG_SEB_WATFLUX_n (DTCO, DGU, U, CHW, DGW, &
- HPROGRAM)
+ SUBROUTINE WRITE_DIAG_SEB_WATFLUX_n (DTCO, DUO, U, CHW, DWO, D, DC, HPROGRAM)
! #################################
!
!!**** *WRITE_DIAG_SEB_WATFLUX_n* - writes WATFLUX diagnostics
@@ -42,25 +41,26 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_CH_WATFLUX_n, ONLY : CH_WATFLUX_t
-USE MODD_DIAG_WATFLUX_n, ONLY : DIAG_WATFLUX_t
-!
-#ifdef SFX_ARO
-USE MODD_IO_SURF_ARO, ONLY : NBLOCK
-#endif
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
+USE MODD_XIOS, ONLY : LALLOW_ADD_DIM, YSWBAND_DIM_NAME
!
+#ifdef SFX_ARO
+USE MODD_IO_SURF_ARO, ONLY : NBLOCK
+#endif
!
+#ifdef SFX_OL
+USE MODD_IO_SURF_OL, ONLY : LDEF
+#endif
!
USE MODI_INIT_IO_SURF_n
USE MODI_WRITE_SURF
USE MODI_END_IO_SURF_n
!
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -71,10 +71,12 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DUO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(CH_WATFLUX_t), INTENT(INOUT) :: CHW
-TYPE(DIAG_WATFLUX_t), INTENT(INOUT) :: DGW
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DWO
+TYPE(DIAG_t), INTENT(INOUT) :: D
+TYPE(DIAG_t), INTENT(INOUT) :: DC
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
!
@@ -99,345 +101,211 @@ GRESET=.TRUE.
#ifdef SFX_ARO
GRESET=(NBLOCK>0)
#endif
+#ifdef SFX_OL
+IF (LDEF) GRESET = .FALSE.
+#endif
!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'WATER ','WATFLX','WRITE')
+ CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'WATER ','WATFLX','WRITE','WATFLUX_DIAGNOSTICS.OUT.nc')
!
!
!* 2. Richardson number :
! -----------------
!
-IF (DGW%N2M>=1) THEN
+IF (DWO%N2M>=1) THEN
-YRECFM='RI_WAT'
-YCOMMENT='X_Y_'//YRECFM
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XRI(:),IRESP,HCOMMENT=YCOMMENT)
-!
+ YRECFM='RI_WAT'
+ YCOMMENT='X_Y_'//YRECFM
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XRI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
END IF
!
!* 3. Energy fluxes :
! -------------
!
-IF (DGW%LSURF_BUDGET) THEN
+IF (DWO%LSURF_BUDGET) THEN
-YRECFM='RN_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XRN(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='H_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XH(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='LE_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XLE(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='LEI_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XLEI(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='GFLUX_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='EVAP_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XEVAP(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='SUBL_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XSUBL(:),IRESP,HCOMMENT=YCOMMENT)
-!
-IF (DGW%LRAD_BUDGET) THEN
-!
- YRECFM='SWD_WAT'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XSWD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SWU_WAT'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XSWU(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWD_WAT'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XLWD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWU_WAT'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XLWU(:),IRESP,HCOMMENT=YCOMMENT)
- !
- DO JSW=1, SIZE(DGW%XSWBD,2)
- YNUM=ACHAR(48+JSW)
+ YRECFM='RN_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XRN(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='H_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XH(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LE_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XLE(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LEI_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XLEI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='GFLUX_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='EVAP_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XEVAP(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SUBL_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XSUBL(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF (DWO%LRAD_BUDGET) THEN
+ !
+ YRECFM='SWD_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XSWD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SWU_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XSWU(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWD_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XLWD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWU_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XLWU(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF (LALLOW_ADD_DIM) THEN
!
- YRECFM='SWD_WAT_'//YNUM
+ YRECFM='SWD_WAT'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,&
+ HPROGRAM,YRECFM,D%XSWBD(:,:),IRESP,HCOMMENT=YCOMMENT, HNAM_DIM=YSWBAND_DIM_NAME)
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XSWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SWU_WAT_'//YNUM
+ YRECFM='SWU_WAT'
YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,&
+ HPROGRAM,YRECFM,D%XSWBD(:,:),IRESP,HCOMMENT=YCOMMENT, HNAM_DIM=YSWBAND_DIM_NAME)
!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XSWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ ELSE
+ !
+ DO JSW=1, SIZE(D%XSWBD,2)
+ YNUM=ACHAR(48+JSW)
+ !
+ YRECFM='SWD_WAT_'//YNUM
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XSWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SWU_WAT_'//YNUM
+ YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XSWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDDO
!
- ENDDO
-!
-ENDIF
-!
-YRECFM='FMU_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XFMU(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='FMV_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XFMV(:),IRESP,HCOMMENT=YCOMMENT)
-!
-END IF
-!
-IF (DGW%LSURF_BUDGETC) THEN
-
-YRECFM='RNC_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XRNC(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='HC_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XHC(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='LEC_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XLEC(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='LEIC_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XLEIC(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='GFLUXC_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XGFLUXC(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='EVAPC_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XEVAPC(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='SUBLC_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XSUBLC(:),IRESP,HCOMMENT=YCOMMENT)
-!
-IF (DGW%LRAD_BUDGET .OR. (DGW%LSURF_BUDGETC .AND. .NOT.DGU%LRESET_BUDGETC)) THEN
-!
- YRECFM='SWDC_WAT'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XSWDC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SWUC_WAT'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XSWUC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWDC_WAT'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XLWDC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWUC_WAT'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- !
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XLWUC(:),IRESP,HCOMMENT=YCOMMENT)
-!
-ENDIF
-!
-YRECFM='FMUC_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XFMUC(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='FMVC_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XFMVC(:),IRESP,HCOMMENT=YCOMMENT)
-!
+ ENDIF
+ !
+ ENDIF
+ !
+ YRECFM='FMU_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XFMU(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='FMV_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XFMV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
END IF
!
!
!* 4. Transfer coefficients
! ---------------------
!
-IF (DGW%LCOEF) THEN
+IF (DWO%LCOEF) THEN
-YRECFM='CD_WAT'
-YCOMMENT='X_Y_'//YRECFM
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XCD(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='CH_WAT'
-YCOMMENT='X_Y_'//YRECFM
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XCH(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='CE_WAT'
-YCOMMENT='X_Y_'//YRECFM
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XCE(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='Z0_WAT'
-YCOMMENT='X_Y_'//YRECFM
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XZ0(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='Z0H_WAT'
-YCOMMENT='X_Y_'//YRECFM
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XZ0H(:),IRESP,HCOMMENT=YCOMMENT)
-!
+ YRECFM='CD_WAT'
+ YCOMMENT='X_Y_'//YRECFM
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XCD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='CH_WAT'
+ YCOMMENT='X_Y_'//YRECFM
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XCH(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='CE_WAT'
+ YCOMMENT='X_Y_'//YRECFM
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XCE(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='Z0_WAT'
+ YCOMMENT='X_Y_'//YRECFM
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XZ0(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='Z0H_WAT'
+ YCOMMENT='X_Y_'//YRECFM
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XZ0H(:),IRESP,HCOMMENT=YCOMMENT)
+ !
END IF
!
!
!* 5. Surface humidity
! ----------------
!
-IF (DGW%LSURF_VARS) THEN
+IF (DWO%LSURF_VARS) THEN
-YRECFM='QS_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XQS(:),IRESP,HCOMMENT=YCOMMENT)
-!
+ YRECFM='QS_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XQS(:),IRESP,HCOMMENT=YCOMMENT)
+ !
ENDIF
!
!
!* 6. parameters at 2 and 10 meters :
! -----------------------------
!
-IF (DGW%N2M>=1) THEN
-!
-YRECFM='T2M_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (K)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XT2M(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='T2MMIN_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (K)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XT2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
-IF(GRESET)DGW%XT2M_MIN(:)=XUNDEF
-!
-YRECFM='T2MMAX_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (K)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XT2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
-IF(GRESET)DGW%XT2M_MAX(:)=0.0
-!
-YRECFM='Q2M_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XQ2M(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='HU2M_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (-)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XHU2M(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='HU2MMIN_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (-)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XHU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
-IF(GRESET)DGW%XHU2M_MIN(:)=XUNDEF
-!
-YRECFM='HU2MMAX_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (-)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XHU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
-IF(GRESET)DGW%XHU2M_MAX(:)=-XUNDEF
-!
-YRECFM='ZON10M_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (M/S)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XZON10M(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='MER10M_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (M/S)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XMER10M(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='W10M_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (M/S)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XWIND10M(:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='W10MMAX_WAT'
-YCOMMENT='X_Y_'//YRECFM//' (M/S)'
-!
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,DGW%XWIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
-IF(GRESET)DGW%XWIND10M_MAX(:)=0.0
-!
+IF (DWO%N2M>=1) THEN
+ !
+ YRECFM='T2M_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (K)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XT2M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='T2MMIN_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (K)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XT2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)D%XT2M_MIN(:)=XUNDEF
+ !
+ YRECFM='T2MMAX_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (K)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XT2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)D%XT2M_MAX(:)=0.0
+ !
+ YRECFM='Q2M_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XQ2M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='HU2M_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (-)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XHU2M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='HU2MMIN_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (-)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XHU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)D%XHU2M_MIN(:)=XUNDEF
+ !
+ YRECFM='HU2MMAX_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (-)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XHU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)D%XHU2M_MAX(:)=-XUNDEF
+ !
+ YRECFM='ZON10M_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (M/S)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XZON10M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='MER10M_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (M/S)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XMER10M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='W10M_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (M/S)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XWIND10M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='W10MMAX_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (M/S)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,D%XWIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
+ IF(GRESET)D%XWIND10M_MAX(:)=0.0
+ !
END IF
!
!
@@ -446,13 +314,75 @@ END IF
!
IF (CHW%SVW%NBEQ>0 .AND. CHW%CCH_DRY_DEP=="WES89 ") THEN
DO JSV = 1,SIZE(CHW%CCH_NAMES,1)
- YRECFM='DV_WAT_'//TRIM(CHW%CCH_NAMES(JSV))
+ YRECFM='DVWT'//TRIM(CHW%CCH_NAMES(JSV))
WRITE(YCOMMENT,'(A13,I3.3)')'(m/s) DV_WAT_',JSV
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,CHW%XDEP(:,JSV),IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,CHW%XDEP(:,JSV),IRESP,HCOMMENT=YCOMMENT)
END DO
ENDIF
!
+IF (DWO%LSURF_BUDGETC) THEN
+
+ CALL END_IO_SURF_n(HPROGRAM)
+ CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'WATER ','WATFLX','WRITE','WATFLUX_DIAG_CUMUL.OUT.nc')
+
+ YRECFM='RNC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XRN(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='HC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XH(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LEC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XLE(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LEIC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XLEI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='GFLUXC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='EVAPC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XEVAP(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SUBLC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XSUBL(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF (DWO%LRAD_BUDGET .OR. (DWO%LSURF_BUDGETC .AND. .NOT.DUO%LRESET_BUDGETC)) THEN
+ !
+ YRECFM='SWDC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XSWD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SWUC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XSWU(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWDC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XLWD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWUC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XLWU(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDIF
+ !
+ YRECFM='FMUC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XFMU(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='FMVC_WAT'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
+ CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,DC%XFMV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+END IF
+!
!-------------------------------------------------------------------------------
!
! End of IO
diff --git a/src/SURFEX/write_diag_surf_atmn.F90 b/src/SURFEX/write_diag_surf_atmn.F90
index 24958ea3982725f855455a1bcf8fc2d39cc0fc24..e24dbc09ed6df59200cf7c4c6e3420bb82ce5519 100644
--- a/src/SURFEX/write_diag_surf_atmn.F90
+++ b/src/SURFEX/write_diag_surf_atmn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #################################################################################
-SUBROUTINE WRITE_DIAG_SURF_ATM_n (YSC, &
- HPROGRAM,HWRITE)
+SUBROUTINE WRITE_DIAG_SURF_ATM_n (YSC,HPROGRAM,HWRITE)
! #################################################################################
!
!!**** *WRITE_DIAG_SURF_ATM_n * - Chooses the surface schemes for diagnostics writing
@@ -28,12 +27,12 @@ SUBROUTINE WRITE_DIAG_SURF_ATM_n (YSC, &
!! Original 01/2004
!!------------------------------------------------------------------
!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
!
USE MODD_SURFEX_n, ONLY : SURFEX_t
!
USE MODD_SURF_CONF, ONLY : CPROGNAME
!
-!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
USE MODI_INIT_IO_SURF_n
@@ -72,56 +71,49 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SURF_ATM_N',0,ZHOOK_HANDLE)
- CPROGNAME = HPROGRAM
!
-IF (YSC%U%NDIM_SEA >0) CALL WRITE_DIAG_SEA_n(YSC%DTCO, YSC%DGU, YSC%U, YSC%SM, &
+CPROGNAME = HPROGRAM
+!
+IF (YSC%U%NDIM_SEA >0) CALL WRITE_DIAG_SEA_n(YSC%DTCO, YSC%DUO, YSC%U, YSC%SM, &
HPROGRAM,HWRITE)
-IF (YSC%U%NDIM_WATER >0) CALL WRITE_DIAG_INLAND_WATER_n(YSC%DTCO, YSC%DGU, YSC%U, &
- YSC%WM, YSC%FM, &
- HPROGRAM,HWRITE)
-IF (YSC%U%NDIM_NATURE >0) CALL WRITE_DIAG_NATURE_n(YSC%DTCO, YSC%DGU, YSC%U, YSC%IM, YSC%DST, &
- HPROGRAM,HWRITE)
-IF (YSC%U%NDIM_TOWN >0) CALL WRITE_DIAG_TOWN_n(YSC%DTCO, YSC%DGU, YSC%U, YSC%TM, YSC%GDM, YSC%GRM, &
- HPROGRAM,HWRITE)
+IF (YSC%U%NDIM_WATER >0) CALL WRITE_DIAG_INLAND_WATER_n(YSC%DTCO, YSC%DUO, YSC%U, &
+ YSC%WM, YSC%FM, HPROGRAM,HWRITE)
+IF (YSC%U%NDIM_NATURE >0) CALL WRITE_DIAG_NATURE_n(YSC%DTCO, YSC%DUO, YSC%U, YSC%IM, &
+ YSC%NDST, HPROGRAM,HWRITE)
+IF (YSC%U%NDIM_TOWN >0) CALL WRITE_DIAG_TOWN_n(YSC%DTCO, YSC%DUO%CSELECT, YSC%U, YSC%TM, &
+ YSC%GDM, YSC%GRM, HPROGRAM,HWRITE)
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Writing
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
-!
-IF (YSC%DGU%XDIAG_TSTEP==XUNDEF .OR. &
- ABS(NINT(YSC%U%TTIME%TIME/YSC%DGU%XDIAG_TSTEP)*YSC%DGU%XDIAG_TSTEP-YSC%U%TTIME%TIME)<1.E-3 ) THEN
+IF (YSC%DUO%XDIAG_TSTEP==XUNDEF .OR. &
+ ABS(NINT(YSC%U%TTIME%TIME/YSC%DUO%XDIAG_TSTEP)*YSC%DUO%XDIAG_TSTEP-YSC%U%TTIME%TIME)<1.E-3 ) THEN
!
- IF (YSC%DGU%LFRAC) THEN
- CALL INIT_IO_SURF_n(YSC%DTCO, YSC%DGU, YSC%U, &
- HPROGRAM,'FULL ','SURF ','WRITE')
- YCOMMENT = '(-)'
- CALL WRITE_SURF(YSC%DGU, YSC%U, &
- HPROGRAM,'FRAC_SEA ',YSC%U%XSEA, IRESP,HCOMMENT=YCOMMENT)
- CALL WRITE_SURF(YSC%DGU, YSC%U, &
- HPROGRAM,'FRAC_NATURE',YSC%U%XNATURE,IRESP,HCOMMENT=YCOMMENT)
- CALL WRITE_SURF(YSC%DGU, YSC%U, &
- HPROGRAM,'FRAC_WATER ',YSC%U%XWATER, IRESP,HCOMMENT=YCOMMENT)
- CALL WRITE_SURF(YSC%DGU, YSC%U, &
- HPROGRAM,'FRAC_TOWN ',YSC%U%XTOWN, IRESP,HCOMMENT=YCOMMENT)
+ IF (YSC%DUO%LFRAC) THEN
+ CALL INIT_IO_SURF_n(YSC%DTCO, YSC%U, HPROGRAM,'FULL ','SURF ','WRITE','SURF_ATM.OUT.nc')
+ YCOMMENT = '(fraction)'
+ CALL WRITE_SURF(YSC%DUO%CSELECT,HPROGRAM,'FRAC_SEA ',YSC%U%XSEA, IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(YSC%DUO%CSELECT,HPROGRAM,'FRAC_NATURE',YSC%U%XNATURE,IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(YSC%DUO%CSELECT,HPROGRAM,'FRAC_WATER ',YSC%U%XWATER, IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(YSC%DUO%CSELECT,HPROGRAM,'FRAC_TOWN ',YSC%U%XTOWN, IRESP,HCOMMENT=YCOMMENT)
CALL END_IO_SURF_n(HPROGRAM)
END IF
!
- IF (HWRITE/='PGD'.AND.YSC%DGU%LDIAG_GRID) &
- CALL WRITE_DIAG_SEB_SURF_ATM_n(YSC%DTCO, YSC%DGU, YSC%U, YSC%UG, &
- HPROGRAM)
+ IF (HWRITE/='PGD'.AND.YSC%DUO%LDIAG_GRID) &
+ CALL WRITE_DIAG_SEB_SURF_ATM_n(YSC%DTCO, YSC%DUO, YSC%DU, YSC%DUC, YSC%U, &
+ YSC%UG%G%CGRID, HPROGRAM)
!
IF (YSC%CHU%LCH_EMIS .AND. YSC%SV%NBEQ>0 .AND. YSC%CHU%LCH_SURF_EMIS) THEN
IF (YSC%CHU%CCH_EMIS=='AGGR') THEN
- CALL WRITE_DIAG_CH_AGGR_n(YSC%DTCO, YSC%DGU, YSC%U, YSC%CHE, &
- HPROGRAM)
+ CALL WRITE_DIAG_CH_AGGR_n(YSC%DTCO, YSC%DUO%CSELECT, YSC%U, YSC%CHE, HPROGRAM)
ELSE IF (YSC%CHU%CCH_EMIS=='SNAP') THEN
- CALL WRITE_DIAG_CH_SNAP_n(YSC%DTCO, YSC%DGU, YSC%U, YSC%CHN, &
- HPROGRAM)
+ CALL WRITE_DIAG_CH_SNAP_n(YSC%DTCO, YSC%DUO%CSELECT, YSC%U, YSC%CHN, HPROGRAM)
END IF
END IF
!
END IF
+!
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SURF_ATM_N',1,ZHOOK_HANDLE)
!
!--------------------------------------------------------------------------------------
diff --git a/src/SURFEX/write_diag_tebn.F90 b/src/SURFEX/write_diag_tebn.F90
index 5b17960736b2233f39b096fc91b10ec09b82e265..b190064e4d5370cd7ad89965812e9c2d23de91cf 100644
--- a/src/SURFEX/write_diag_tebn.F90
+++ b/src/SURFEX/write_diag_tebn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE WRITE_DIAG_TEB_n (DTCO, DGU, U, TM, GDM, GRM, &
- HPROGRAM,HWRITE)
+SUBROUTINE WRITE_DIAG_TEB_n (DTCO, HSELECT, U, TM, GDM, GRM, HPROGRAM,HWRITE)
! ###############################################################################
!
!!**** *WRITE_DIAG_TEB_n * - diagnostics for TEB
@@ -31,7 +30,6 @@ SUBROUTINE WRITE_DIAG_TEB_n (DTCO, DGU, U, TM, GDM, GRM, &
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_SURFEX_n, ONLY : TEB_MODEL_t
USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t
@@ -39,7 +37,6 @@ USE MODD_SURFEX_n, ONLY : TEB_GREENROOF_MODEL_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
!
-USE MODI_GOTO_WRAPPER_TEB_PATCH
USE MODI_WRITE_DIAG_SEB_TEB_n
USE MODI_WRITE_DIAG_MISC_TEB_n
USE MODI_WRITE_DIAG_PGD_TEB_n
@@ -54,7 +51,7 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM
TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
@@ -66,35 +63,34 @@ TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM
!
!* 0.2 declarations of local variables
!
-INTEGER :: JTEB_PATCH
+INTEGER :: JP
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_TEB_N',0,ZHOOK_HANDLE)
IF (HWRITE/='PGD') THEN
!
- IF (TM%DGT%XDIAG_TSTEP==XUNDEF .OR. &
- ABS(NINT(TM%TOP%TTIME%TIME/TM%DGT%XDIAG_TSTEP)*TM%DGT%XDIAG_TSTEP-TM%TOP%TTIME%TIME)<1.E-3 ) THEN
- CALL WRITE_DIAG_SEB_TEB_n(DTCO, DGU, U, TM%CHT, TM%DGT, TM%DGUT, &
- HPROGRAM)
- DO JTEB_PATCH=1,TM%TOP%NTEB_PATCH
- CALL GOTO_WRAPPER_TEB_PATCH(TM%B, TM%DGCT, TM%DGMT, TM%T, &
- GDM%TGD, GDM%TGDPE, GRM%TGR, GRM%TGRPE, JTEB_PATCH)
- CALL WRITE_DIAG_MISC_TEB_n(DTCO, DGU, U, TM%DGCT, TM%DGMT, TM%DGMTO, TM%T, TM%TOP, &
- HPROGRAM,JTEB_PATCH)
+ IF (TM%TD%O%XDIAG_TSTEP==XUNDEF .OR. &
+ ABS(NINT(TM%TOP%TTIME%TIME/TM%TD%O%XDIAG_TSTEP)*TM%TD%O%XDIAG_TSTEP-TM%TOP%TTIME%TIME)<1.E-3 ) THEN
+ CALL WRITE_DIAG_SEB_TEB_n(DTCO, HSELECT, U, TM%CHT, TM%TD%O, TM%TD%D, TM%TD%DUT, HPROGRAM)
+ DO JP=1,TM%TOP%NTEB_PATCH
+ CALL WRITE_DIAG_MISC_TEB_n(DTCO, HSELECT, U, TM%TD%NDMTC%AL(JP), TM%TD%NDMT%AL(JP), TM%TD%MTO, &
+ GDM%VD%ND%AL(JP), GDM%VD%NDE%AL(JP), GDM%VD%NDEC%AL(JP), &
+ GRM%VD%ND%AL(JP), GRM%VD%NDE%AL(JP), GRM%VD%NDEC%AL(JP), &
+ TM%NT%AL(JP), TM%TOP, HPROGRAM,JP)
END DO
END IF
!
ENDIF
!
-IF (TM%DGT%LPGD) THEN
- IF (TM%DGT%XDIAG_TSTEP==XUNDEF .OR. &
- ABS(NINT(TM%TOP%TTIME%TIME/TM%DGT%XDIAG_TSTEP)*TM%DGT%XDIAG_TSTEP-TM%TOP%TTIME%TIME)<1.E-3 ) THEN
- IF (ASSOCIATED(TM%T%CUR%XBLD)) THEN
- CALL WRITE_DIAG_PGD_TEB_n(DTCO, DGU, U, TM%B, TM%BOP, TM%T, TM%TOP, TM%TPN, &
- HPROGRAM)
- IF (TM%TOP%LGARDEN) CALL WRITE_DIAG_PGD_GRDN_n(DTCO, DGU, U, TM%DGMTO, GDM%TGDPE, GDM%TGDP, GDM%TVG, &
- HPROGRAM)
+IF (TM%TD%O%LPGD) THEN
+ IF (TM%TD%O%XDIAG_TSTEP==XUNDEF .OR. &
+ ABS(NINT(TM%TOP%TTIME%TIME/TM%TD%O%XDIAG_TSTEP)*TM%TD%O%XDIAG_TSTEP-TM%TOP%TTIME%TIME)<1.E-3 ) THEN
+ IF (ASSOCIATED(TM%NT%AL(1)%XBLD)) THEN
+ CALL WRITE_DIAG_PGD_TEB_n(DTCO, HSELECT, U, TM%NB%AL(1), TM%BOP, TM%NT%AL(1), TM%TOP, TM%TPN, HPROGRAM)
+ IF (TM%TOP%LGARDEN) &
+ CALL WRITE_DIAG_PGD_GRDN_n(DTCO, HSELECT, U, TM%TD%MTO%LSURF_DIAG_ALBEDO, &
+ GDM%S, GDM%P, GDM%NPE%AL(1), GDM%O, HPROGRAM)
ENDIF
END IF
END IF
diff --git a/src/SURFEX/write_diag_townn.F90 b/src/SURFEX/write_diag_townn.F90
index 510bbe01f1e2d446abd3e7a795e0faf5aef9d214..2201dc54468dcc4395537fcc94e6e484f185da01 100644
--- a/src/SURFEX/write_diag_townn.F90
+++ b/src/SURFEX/write_diag_townn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE WRITE_DIAG_TOWN_n (DTCO, DGU, U, TM, GDM, GRM, &
- HPROGRAM,HWRITE)
+SUBROUTINE WRITE_DIAG_TOWN_n (DTCO, HSELECT, U, TM, GDM, GRM, HPROGRAM,HWRITE)
! ###############################################################################
!
!!**** *WRITE_DIAG_TOWN_n * - Chooses the surface schemes for town diagnostics
@@ -30,7 +29,6 @@ SUBROUTINE WRITE_DIAG_TOWN_n (DTCO, DGU, U, TM, GDM, GRM, &
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_SURFEX_n, ONLY : TEB_MODEL_t
USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t
@@ -51,7 +49,7 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM
TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
@@ -69,8 +67,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_TOWN_N',0,ZHOOK_HANDLE)
IF (U%CTOWN=='TEB ') THEN
- CALL WRITE_DIAG_TEB_n(DTCO, DGU, U, TM, GDM, GRM, &
- HPROGRAM,HWRITE)
+ CALL WRITE_DIAG_TEB_n(DTCO, HSELECT, U, TM, GDM, GRM, HPROGRAM,HWRITE)
END IF
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_TOWN_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/write_diag_watfluxn.F90 b/src/SURFEX/write_diag_watfluxn.F90
index 2cbc028ebc2816b277c3e4eab23907f2206f88e6..733f664f544d0a89238a0d1e7d98d09b201bf930 100644
--- a/src/SURFEX/write_diag_watfluxn.F90
+++ b/src/SURFEX/write_diag_watfluxn.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
-SUBROUTINE WRITE_DIAG_WATFLUX_n (DTCO, DGU, U, WM, &
- HPROGRAM,HWRITE)
+SUBROUTINE WRITE_DIAG_WATFLUX_n (DTCO, DUO, U, WM, HPROGRAM,HWRITE)
! ###############################################################################
!
!!**** *WRITE_DIAG_WATFLUX_n * - diagnostics for lakes
@@ -32,7 +31,7 @@ SUBROUTINE WRITE_DIAG_WATFLUX_n (DTCO, DGU, U, WM, &
USE MODD_SURFEX_n, ONLY : WATFLUX_MODEL_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
+USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -49,7 +48,7 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DUO
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(WATFLUX_MODEL_t), INTENT(INOUT) :: WM
!
@@ -65,10 +64,9 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_WATFLUX_N',0,ZHOOK_HANDLE)
IF (HWRITE/='PGD') THEN
!
- IF (WM%DGW%XDIAG_TSTEP==XUNDEF .OR. &
- ABS(NINT(WM%W%TTIME%TIME/WM%DGW%XDIAG_TSTEP)*WM%DGW%XDIAG_TSTEP-WM%W%TTIME%TIME)<1.E-3 ) THEN
- CALL WRITE_DIAG_SEB_WATFLUX_n(DTCO, DGU, U, WM%CHW, WM%DGW, &
- HPROGRAM)
+ IF (WM%DWO%XDIAG_TSTEP==XUNDEF .OR. &
+ ABS(NINT(WM%W%TTIME%TIME/WM%DWO%XDIAG_TSTEP)*WM%DWO%XDIAG_TSTEP-WM%W%TTIME%TIME)<1.E-3 ) THEN
+ CALL WRITE_DIAG_SEB_WATFLUX_n(DTCO, DUO, U, WM%CHW, WM%DWO, WM%DW, WM%DWC, HPROGRAM)
END IF
!
ENDIF
diff --git a/src/SURFEX/write_dst_conf.F90 b/src/SURFEX/write_dst_conf.F90
index 21be88c10973dd94c5d93c85210e9f0ee820445a..24bf42f5959a0c2b24f1bd82d97cbf9d03585848 100644
--- a/src/SURFEX/write_dst_conf.F90
+++ b/src/SURFEX/write_dst_conf.F90
@@ -62,7 +62,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! -------------------
!
IF (LHOOK) CALL DR_HOOK('WRITE_DST_CONF',0,ZHOOK_HANDLE)
- CEMISPARAM_DST=HEMISPARAM
+CEMISPARAM_DST=HEMISPARAM
WRITE(UNIT=KLUDES,NML=NAM_SURF_DST)
IF (LHOOK) CALL DR_HOOK('WRITE_DST_CONF',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/write_ecoclimap2_data.F90 b/src/SURFEX/write_ecoclimap2_data.F90
index 978d4a27ab8c55c780befc18d549501f56f67d73..9c617c8d5c307c904898b0c07ddccf36a9a71b6f 100644
--- a/src/SURFEX/write_ecoclimap2_data.F90
+++ b/src/SURFEX/write_ecoclimap2_data.F90
@@ -3,15 +3,11 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #######################
- SUBROUTINE WRITE_ECOCLIMAP2_DATA (DGU, U, &
- HPROGRAM)
+ SUBROUTINE WRITE_ECOCLIMAP2_DATA (HSELECT, HPROGRAM)
! #######################
!
!
!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
USE MODI_WRITE_SURF
!
USE MODD_DATA_COVER, ONLY : TDATA_SEED, TDATA_REAP, XDATA_WATSUP, XDATA_IRRIG,&
@@ -27,10 +23,7 @@ IMPLICIT NONE
!* dummy arguments
! ---------------
!
-!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-!
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
!
!
@@ -53,13 +46,11 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('WRITE_ECOCLIMAP2_DATA',0,ZHOOK_HANDLE)
YRECFM='DATA_IRRIG'
YCOMMENT='FLAG TO READ USER IRRIGATION DATA FOR ECOCLIMAP2'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,LDATA_IRRIG,IRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,LDATA_IRRIG,IRESP,YCOMMENT)
!
YRECFM='LCLIM_LAI'
YCOMMENT='FLAG TO USE CLIMATOLOGICAL LAI'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,LCLIM_LAI,IRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,LCLIM_LAI,IRESP,YCOMMENT)
!
IF (.NOT. LDATA_IRRIG .AND. LHOOK) CALL DR_HOOK('WRITE_ECOCLIMAP2_DATA',1,ZHOOK_HANDLE)
IF (.NOT. LDATA_IRRIG) RETURN
@@ -75,7 +66,7 @@ DO JCOVER=1,JPCOVER
ZWORK(4) = TDATA_REAP (JCOVER,NVT_IRR)%TDATE%DAY
ZWORK(5) = XDATA_WATSUP(JCOVER,NVT_IRR)
ZWORK(6) = XDATA_IRRIG (JCOVER,NVT_IRR)
- CALL WRITE_SURF(DGU, U, &
+ CALL WRITE_SURF(HSELECT, &
HPROGRAM,YRECFM,ZWORK,IRESP,YCOMMENT,'-',"Irrig_parameters")
END DO
IF (LHOOK) CALL DR_HOOK('WRITE_ECOCLIMAP2_DATA',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/write_field_1d_patch.F90 b/src/SURFEX/write_field_1d_patch.F90
new file mode 100644
index 0000000000000000000000000000000000000000..2907ca95fbde04fab4b0d09c58ee902d832ee090
--- /dev/null
+++ b/src/SURFEX/write_field_1d_patch.F90
@@ -0,0 +1,63 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+SUBROUTINE WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,HRECFM,HCOMMENT,KP,KMASK,PFIELD_IN,KSIZE,PWORK_WR)
+!
+USE MODD_WRITE_SURF_ATM, ONLY : LSPLIT_PATCH
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE MODI_UNPACK_SAME_RANK
+USE MODI_WRITE_SURF
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
+ CHARACTER(LEN=*), INTENT(IN) :: HPROGRAM
+ CHARACTER(LEN=*), INTENT(IN) :: HRECFM
+ CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT
+INTEGER, INTENT(IN) :: KP
+INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
+REAL, DIMENSION(:), INTENT(IN) :: PFIELD_IN
+INTEGER, INTENT(IN) :: KSIZE
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PWORK_WR
+!
+REAL, DIMENSION(KSIZE,1) :: ZWORK
+ CHARACTER(LEN=LEN_HREC) :: YRECFM
+ CHARACTER(LEN=2) :: YPAT
+INTEGER :: IRESP
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('WRITE_FIELD_1D_PATCH',0,ZHOOK_HANDLE)
+!
+YRECFM=ADJUSTL(HRECFM(:LEN_TRIM(HRECFM)))
+ CALL UNPACK_SAME_RANK(KMASK,PFIELD_IN,ZWORK(:,1),XUNDEF)
+!
+IF (LSPLIT_PATCH) THEN
+ !
+ IF (KP/=0) THEN
+ WRITE(YPAT,'(I2)') KP
+ YRECFM=ADJUSTL(YRECFM(:LEN_TRIM(YRECFM)))//'P'//ADJUSTL(YPAT(:LEN_TRIM(YPAT)))
+ ENDIF
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ZWORK(:,1),IRESP,HCOMMENT=HCOMMENT)
+ !
+ELSE
+ !
+ IF (KP/=0) THEN
+ PWORK_WR(:,KP) = ZWORK(:,1)
+ IF ( KP==SIZE(PWORK_WR,2) ) THEN
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,PWORK_WR,IRESP,HCOMMENT=HCOMMENT)
+ ENDIF
+ ELSE
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ZWORK(:,:),IRESP,HCOMMENT=HCOMMENT)
+ ENDIF
+ !
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('WRITE_FIELD_1D_PATCH',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE WRITE_FIELD_1D_PATCH
diff --git a/src/SURFEX/write_field_2d_patch.F90 b/src/SURFEX/write_field_2d_patch.F90
new file mode 100644
index 0000000000000000000000000000000000000000..bda5f22c9b08ebe837d6e01bdbe69ba91c386171
--- /dev/null
+++ b/src/SURFEX/write_field_2d_patch.F90
@@ -0,0 +1,67 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+SUBROUTINE WRITE_FIELD_2D_PATCH(HSELECT,HPROGRAM,HRECFM,HCOMMENT,KP,KMASK,PFIELD_IN,KSIZE,HNAM_DIM,&
+ PWORK_WR)
+!
+USE MODD_TYPE_SNOW
+!
+USE MODD_WRITE_SURF_ATM, ONLY : LSPLIT_PATCH
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE MODI_UNPACK_SAME_RANK
+USE MODI_WRITE_SURF
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
+ CHARACTER(LEN=*), INTENT(IN) :: HPROGRAM
+ CHARACTER(LEN=*), INTENT(IN) :: HRECFM
+ CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT
+INTEGER, INTENT(IN) :: KP
+INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
+REAL, DIMENSION(:,:), INTENT(IN) :: PFIELD_IN
+INTEGER, INTENT(IN) :: KSIZE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAM_DIM
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PWORK_WR
+!
+REAL, DIMENSION(KSIZE,SIZE(PFIELD_IN,2)) :: ZWORK
+ CHARACTER(LEN=LEN_HREC) :: YRECFM
+ CHARACTER(LEN=2) :: YPAT
+INTEGER :: IRESP
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('WRITE_FIELD_2D_PATCH',0,ZHOOK_HANDLE)
+!
+YRECFM=ADJUSTL(HRECFM(:LEN_TRIM(HRECFM)))
+ CALL UNPACK_SAME_RANK(KMASK,PFIELD_IN,ZWORK,XUNDEF)
+!
+IF (LSPLIT_PATCH) THEN
+ !
+ IF (KP/=0) THEN
+ WRITE(YPAT,'(I2)') KP
+ YRECFM=ADJUSTL(YRECFM(:LEN_TRIM(YRECFM)))//'P'//ADJUSTL(YPAT(:LEN_TRIM(YPAT)))
+ ENDIF
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ZWORK,IRESP,HCOMMENT=HCOMMENT,HNAM_DIM=HNAM_DIM)
+ !
+ELSE
+ !
+ IF (KP/=0) THEN
+ PWORK_WR(:,:,KP) = ZWORK(:,:)
+ IF ( KP==SIZE(PWORK_WR,2) ) THEN
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,PWORK_WR,IRESP,HCOMMENT=HCOMMENT)
+ ENDIF
+ ELSE
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ZWORK,IRESP,HCOMMENT=HCOMMENT)
+ ENDIF
+ !
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('WRITE_FIELD_2D_PATCH',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE WRITE_FIELD_2D_PATCH
diff --git a/src/SURFEX/write_flaken.F90 b/src/SURFEX/write_flaken.F90
index 1a032c3b7a942a37baf2cd80a9f87442c2a00dca..e53071dac97d6edbe944d1ae48210bb3cdbdb8b8 100644
--- a/src/SURFEX/write_flaken.F90
+++ b/src/SURFEX/write_flaken.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_FLAKE_n (DTCO, DGU, U, FM, &
- HPROGRAM,HWRITE)
+ SUBROUTINE WRITE_FLAKE_n (DTCO, HSELECT, U, FM, HPROGRAM,HWRITE)
! ####################################
!
!!**** *WRITE_FLAKE_n* - routine to write surface variables in their respective files
@@ -43,13 +42,12 @@
USE MODD_SURFEX_n, ONLY : FLAKE_MODEL_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODD_WRITE_SURF_ATM, ONLY : LNOWRITE_CANOPY
USE MODI_INIT_IO_SURF_n
USE MODI_WRITESURF_FLAKE_n
-USE MODI_WRITESURF_FLAKE_SBL_n
+USE MODI_WRITESURF_SBL_n
USE MODI_WRITESURF_FLAKE_CONF_n
USE MODI_END_IO_SURF_n
!
@@ -64,7 +62,7 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(FLAKE_MODEL_t), INTENT(INOUT) :: FM
!
@@ -79,21 +77,17 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
IF (LHOOK) CALL DR_HOOK('WRITE_FLAKE_N',0,ZHOOK_HANDLE)
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'WATER ','FLAKE ','WRITE')
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'WATER ','FLAKE ','WRITE','FLAKE_PROGNOSTIC.OUT.nc')
!
!* 1. Selection of surface scheme
! ---------------------------
!
- CALL WRITESURF_FLAKE_CONF_n(FM%CHF, FM%DGMF, FM%F, &
- HPROGRAM)
- CALL WRITESURF_FLAKE_n(DGU, U, &
- FM%F, &
- HPROGRAM)
+ CALL WRITESURF_FLAKE_CONF_n(FM%CHF, FM%DMF, FM%F, HPROGRAM)
+ CALL WRITESURF_FLAKE_n(HSELECT, FM%F, HPROGRAM)
!
-IF ((.NOT.LNOWRITE_CANOPY).OR.DGU%LSELECT) CALL WRITESURF_FLAKE_SBL_n(DGU, U, &
- FM%F, FM%FSB, &
- HPROGRAM,HWRITE)
+IF ((.NOT.LNOWRITE_CANOPY).OR.SIZE(HSELECT)>0) THEN
+ CALL WRITESURF_SBL_n(HSELECT, FM%F%LSBL, FM%SB, HPROGRAM, HWRITE, "WATER ")
+ENDIF
!
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/write_grid.F90 b/src/SURFEX/write_grid.F90
index 2a5bd3b84b2ce47a738b4a8a7568cacf4426ae47..6e0c26069d5d6bdf2fbda253b1aa1d8aeaae7d26 100644
--- a/src/SURFEX/write_grid.F90
+++ b/src/SURFEX/write_grid.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_GRID (DGU, U, &
- HPROGRAM,HGRID,PGRID_PAR,PLAT,PLON,PMESH_SIZE,KRESP,PDIR,HDIR)
+ SUBROUTINE WRITE_GRID (HSELECT,HPROGRAM,HGRID,PGRID_PAR,PLAT,PLON,PMESH_SIZE,KRESP,HDIR)
! #########################################
!
!!**** *WRITE_GRID* - routine to write the horizontal grid of a scheme
@@ -34,20 +33,15 @@
!! -------------
!! Original 01/2004
!! P. Samuelsson SMHI 12/2012 Rotated lonlat
+!! S. Senesi 08/15 Adapt to XIOS (non-sensical in that case => return immediately)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
!
-!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
USE MODI_WRITE_SURF
!
-!
-!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
@@ -69,9 +63,7 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
CHARACTER(LEN=10), INTENT(IN) :: HGRID ! type of horizontal grid
@@ -80,7 +72,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PLAT ! latitude (degrees)
REAL, DIMENSION(:), INTENT(IN) :: PLON ! longitude (degrees)
REAL, DIMENSION(:), INTENT(IN) :: PMESH_SIZE ! horizontal mesh size (m2)
INTEGER, INTENT(OUT) :: KRESP ! error return code
-REAL, DIMENSION(:), INTENT(IN) , OPTIONAL :: PDIR ! heading of main axis of grid compared to North (degrees)
CHARACTER(LEN=1), INTENT(IN), OPTIONAL :: HDIR ! type of field :
! 'H' : field with
! horizontal spatial dim.
@@ -100,9 +91,14 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ------------------
!
IF (LHOOK) CALL DR_HOOK('WRITE_GRID',0,ZHOOK_HANDLE)
+!
+IF (TRIM(HPROGRAM) == 'XIOS') THEN
+ IF (LHOOK) CALL DR_HOOK('WRITE_GRID',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
+!
YCOMMENT='GRID TYPE'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'GRID_TYPE',HGRID,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,'GRID_TYPE',HGRID,KRESP,YCOMMENT)
!
!---------------------------------------------------------------------------
!
@@ -114,40 +110,30 @@ IF (PRESENT(HDIR)) YDIR = HDIR
!
SELECT CASE (HGRID)
CASE("CONF PROJ ")
- CALL WRITE_GRIDTYPE_CONF_PROJ(DGU, U, &
- HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP,YDIR)
+ CALL WRITE_GRIDTYPE_CONF_PROJ(HSELECT, HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP,YDIR)
CASE("CARTESIAN ")
- CALL WRITE_GRIDTYPE_CARTESIAN(DGU, U, &
- HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP,YDIR)
+ CALL WRITE_GRIDTYPE_CARTESIAN(HSELECT, HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP,YDIR)
CASE("LONLAT REG")
- CALL WRITE_GRIDTYPE_LONLAT_REG(DGU, U, &
- HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP)
+ CALL WRITE_GRIDTYPE_LONLAT_REG(HSELECT, HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP)
CASE("GAUSS ")
- CALL WRITE_GRIDTYPE_GAUSS(DGU, U, &
- HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP)
+ CALL WRITE_GRIDTYPE_GAUSS(HSELECT, HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP)
CASE("IGN ")
- CALL WRITE_GRIDTYPE_IGN(DGU, U, &
- HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP)
+ CALL WRITE_GRIDTYPE_IGN(HSELECT, HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP)
CASE("LONLATVAL ")
- CALL WRITE_GRIDTYPE_LONLATVAL(DGU, U, &
- HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP)
+ CALL WRITE_GRIDTYPE_LONLATVAL(HSELECT, HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP)
CASE("LONLAT ROT")
- CALL WRITE_GRIDTYPE_LONLAT_ROT(DGU, U, &
- HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP)
+ CALL WRITE_GRIDTYPE_LONLAT_ROT(HSELECT, HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP)
CASE("NONE ")
YCOMMENT='LON (DEGREES)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LON', PLON,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,'LON', PLON,KRESP,YCOMMENT)
IF (KRESP/=0 .AND. LHOOK) CALL DR_HOOK('WRITE_GRID',1,ZHOOK_HANDLE)
IF (KRESP/=0) RETURN
YCOMMENT='LAT (DEGREES)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LAT', PLAT,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,'LAT', PLAT,KRESP,YCOMMENT)
IF (KRESP/=0 .AND. LHOOK) CALL DR_HOOK('WRITE_GRID',1,ZHOOK_HANDLE)
IF (KRESP/=0) RETURN
YCOMMENT='MESH SIZE (M2)'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'MESH_SIZE',PMESH_SIZE,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,'MESH_SIZE',PMESH_SIZE,KRESP,YCOMMENT)
IF (KRESP/=0 .AND. LHOOK) CALL DR_HOOK('WRITE_GRID',1,ZHOOK_HANDLE)
IF (KRESP/=0) RETURN
END SELECT
diff --git a/src/SURFEX/write_gridtype_cartesian.F90 b/src/SURFEX/write_gridtype_cartesian.F90
index 885c925f468d47263fc86c1a38e07989a17b0331..8fc92c8ce3c6b3ccf20b186fd1633dd8379f5e15 100644
--- a/src/SURFEX/write_gridtype_cartesian.F90
+++ b/src/SURFEX/write_gridtype_cartesian.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #################################################################
- SUBROUTINE WRITE_GRIDTYPE_CARTESIAN (DGU, U, &
- HPROGRAM,KLU,KGRID_PAR,PGRID_PAR,KRESP,HDIR)
+ SUBROUTINE WRITE_GRIDTYPE_CARTESIAN (HSELECT,HPROGRAM,KLU,KGRID_PAR,PGRID_PAR,KRESP,HDIR)
! #################################################################
!
!!**** *WRITE_GRIDTYPE_CARTESIAN* - routine to write the horizontal grid
@@ -38,11 +37,6 @@
!* 0. DECLARATIONS
! ------------
!
-!
-!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
USE MODI_WRITE_SURF
!
USE MODE_GRIDTYPE_CARTESIAN
@@ -56,9 +50,7 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
INTEGER, INTENT(IN) :: KLU ! number of points
@@ -98,7 +90,7 @@ ALLOCATE(ZDX(KLU))
ALLOCATE(ZDY(KLU))
!
CALL GET_GRIDTYPE_CARTESIAN(PGRID_PAR,ZLAT0,ZLON0, &
- IIMAX,IJMAX,ZX,ZY,ZDX,ZDY )
+ IIMAX,IJMAX,ZX,ZY,ZDX,ZDY )
!
!---------------------------------------------------------------------------
!
@@ -106,32 +98,20 @@ ALLOCATE(ZDY(KLU))
! -----------------------------------------
!
YCOMMENT=' '
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LAT0',ZLAT0,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LON0',ZLON0,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'IMAX ',IIMAX, KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'JMAX ',IJMAX, KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,'LAT0',ZLAT0,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,'LON0',ZLON0,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,'IMAX ',IIMAX, KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,'JMAX ',IJMAX, KRESP,YCOMMENT)
IF (PRESENT(HDIR)) THEN
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'XX',ZX,KRESP,YCOMMENT,HDIR)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'YY',ZY,KRESP,YCOMMENT,HDIR)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'DX',ZDX,KRESP,YCOMMENT,HDIR)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'DY',ZDY,KRESP,YCOMMENT,HDIR)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,'XX',ZX,KRESP,YCOMMENT,HDIR)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,'YY',ZY,KRESP,YCOMMENT,HDIR)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,'DX',ZDX,KRESP,YCOMMENT,HDIR)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,'DY',ZDY,KRESP,YCOMMENT,HDIR)
ELSE
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'XX',ZX,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'YY',ZY,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'DX',ZDX,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'DY',ZDY,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,'XX',ZX,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,'YY',ZY,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,'DX',ZDX,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,'DY',ZDY,KRESP,YCOMMENT)
END IF
!
!---------------------------------------------------------------------------
diff --git a/src/SURFEX/write_gridtype_conf_proj.F90 b/src/SURFEX/write_gridtype_conf_proj.F90
index af28e305304f3628ab49d1b4ebe7b85d0d95fbcc..07929e4ef1a43143de9cc795905da463e0920f6c 100644
--- a/src/SURFEX/write_gridtype_conf_proj.F90
+++ b/src/SURFEX/write_gridtype_conf_proj.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #################################################################
- SUBROUTINE WRITE_GRIDTYPE_CONF_PROJ (DGU, U, &
- HPROGRAM,KLU,KGRID_PAR,PGRID_PAR,KRESP,HDIR)
+ SUBROUTINE WRITE_GRIDTYPE_CONF_PROJ (HSELECT,HPROGRAM,KLU,KGRID_PAR,PGRID_PAR,KRESP,HDIR)
! #################################################################
!
!!**** *WRITE_GRIDTYPE_CONF_PROJ* - routine to write the horizontal grid
@@ -38,11 +37,6 @@
!* 0. DECLARATIONS
! ------------
!
-!
-!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
USE MODI_WRITE_SURF
!
USE MODE_GRIDTYPE_CONF_PROJ
@@ -57,8 +51,7 @@ IMPLICIT NONE
! -------------------------
!
!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
INTEGER, INTENT(IN) :: KLU ! number of points
@@ -116,40 +109,24 @@ ALLOCATE(ZDY(KLU))
! -----------------------------------------
!
YCOMMENT=' '
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LAT0',ZLAT0,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LON0',ZLON0,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'RPK ',ZRPK, KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'BETA',ZBETA,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LATORI',ZLATORI,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LONORI',ZLONORI,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'IMAX ',IIMAX, KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'JMAX ',IJMAX, KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'LAT0',ZLAT0,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'LON0',ZLON0,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'RPK ',ZRPK, KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'BETA',ZBETA,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'LATORI',ZLATORI,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'LONORI',ZLONORI,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'IMAX ',IIMAX, KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'JMAX ',IJMAX, KRESP,YCOMMENT)
IF (PRESENT(HDIR)) THEN
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'XX',ZX,KRESP,YCOMMENT,HDIR)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'YY',ZY,KRESP,YCOMMENT,HDIR)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'DX',ZDX,KRESP,YCOMMENT,HDIR)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'DY',ZDY,KRESP,YCOMMENT,HDIR)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'XX',ZX,KRESP,YCOMMENT,HDIR)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'YY',ZY,KRESP,YCOMMENT,HDIR)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'DX',ZDX,KRESP,YCOMMENT,HDIR)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'DY',ZDY,KRESP,YCOMMENT,HDIR)
ELSE
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'XX',ZX,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'YY',ZY,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'DX',ZDX,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'DY',ZDY,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'XX',ZX,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'YY',ZY,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'DX',ZDX,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'DY',ZDY,KRESP,YCOMMENT)
END IF
!
!---------------------------------------------------------------------------
diff --git a/src/SURFEX/write_gridtype_gauss.F90 b/src/SURFEX/write_gridtype_gauss.F90
index 027bf4898e8e27e90be8037d88da3c53b362bc97..1ea1b61adc64dc72255aa8f6b60278aebcf9fdbe 100644
--- a/src/SURFEX/write_gridtype_gauss.F90
+++ b/src/SURFEX/write_gridtype_gauss.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!#################################################################
-SUBROUTINE WRITE_GRIDTYPE_GAUSS (DGU, U, &
- HPROGRAM,KLU,KGRID_PAR,PGRID_PAR,KRESP)
+SUBROUTINE WRITE_GRIDTYPE_GAUSS (HSELECT,HPROGRAM,KLU,KGRID_PAR,PGRID_PAR,KRESP)
!#################################################################
!
!!**** *WRITE_GRIDTYPE_GAUSS* - routine to write the horizontal grid
@@ -38,11 +37,6 @@ SUBROUTINE WRITE_GRIDTYPE_GAUSS (DGU, U, &
!* 0. DECLARATIONS
! ------------
!
-!
-!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
USE MODI_WRITE_SURF
!
USE MODE_GRIDTYPE_GAUSS
@@ -56,9 +50,7 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
INTEGER, INTENT(IN) :: KLU ! number of points
@@ -111,34 +103,20 @@ ALLOCATE(INLOPA(INLATI))
! -----------------------------------------
!
YCOMMENT=' '
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'NLATI',INLATI,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LAPO',ZLAPO, KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LOPO',ZLOPO,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'CODIL',ZCODIL,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'NLOPA',INLOPA(:),KRESP,YCOMMENT,HDIR='-',HNAM_DIM='Nlati ')
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LATGAUSS',ZLAT(:),KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LONGAUSS',ZLON(:),KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LAT_G_XY',ZLAT_XY(:),KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LON_G_XY',ZLON_XY(:),KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'MESHGAUSS',ZMESH_SIZE(:),KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LONINF',ZLONINF(:),KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LATINF',ZLATINF(:),KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LONSUP',ZLONSUP(:),KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LATSUP',ZLATSUP(:),KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'NLATI',INLATI,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'LAPO',ZLAPO, KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'LOPO',ZLOPO,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'CODIL',ZCODIL,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'NLOPA',INLOPA(:),KRESP,YCOMMENT,HDIR='-',HNAM_DIM='Nlati ')
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'LATGAUSS',ZLAT(:),KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'LONGAUSS',ZLON(:),KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'LAT_G_XY',ZLAT_XY(:),KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'LON_G_XY',ZLON_XY(:),KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'MESHGAUSS',ZMESH_SIZE(:),KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'LONINF',ZLONINF(:),KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'LATINF',ZLATINF(:),KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'LONSUP',ZLONSUP(:),KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'LATSUP',ZLATSUP(:),KRESP,YCOMMENT)
!
DEALLOCATE(INLOPA)
!
diff --git a/src/SURFEX/write_gridtype_ign.F90 b/src/SURFEX/write_gridtype_ign.F90
index 1760f3378a89c91edccd089f264b45331bab9d51..93c3b08e037d3273b070c213a8bcbb7df252ded0 100644
--- a/src/SURFEX/write_gridtype_ign.F90
+++ b/src/SURFEX/write_gridtype_ign.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #################################################################
- SUBROUTINE WRITE_GRIDTYPE_IGN (DGU, U, &
- HPROGRAM,KLU,KGRID_PAR,PGRID_PAR,KRESP)
+ SUBROUTINE WRITE_GRIDTYPE_IGN (HSELECT,HPROGRAM,KLU,KGRID_PAR,PGRID_PAR,KRESP)
! #################################################################
!
!!**** *WRITE_GRIDTYPE_IGN* - routine to write the horizontal grid
@@ -38,11 +37,6 @@
!* 0. DECLARATIONS
! ------------
!
-!
-!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
USE MODI_WRITE_SURF
!
USE MODE_GRIDTYPE_IGN
@@ -56,9 +50,7 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
INTEGER, INTENT(IN) :: KLU ! number of points
@@ -111,24 +103,19 @@ SELECT CASE (ILAMBERT)
CASE (6)
YCOMMENT='LAMBERT 93'
END SELECT
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LAMBERT ',ILAMBERT, KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'LAMBERT ',ILAMBERT, KRESP,YCOMMENT)
!
YCOMMENT='XX'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'XX',ZX,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'XX',ZX,KRESP,YCOMMENT)
!
YCOMMENT='XY'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'XY',ZY,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'XY',ZY,KRESP,YCOMMENT)
!
YCOMMENT='XDX'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'DX',ZDX,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'DX',ZDX,KRESP,YCOMMENT)
!
YCOMMENT='XDY'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'DY',ZDY,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'DY',ZDY,KRESP,YCOMMENT)
!
!---------------------------------------------------------------------------
DEALLOCATE(ZX)
diff --git a/src/SURFEX/write_gridtype_lonlat_reg.F90 b/src/SURFEX/write_gridtype_lonlat_reg.F90
index a4deb9bb5a47fa0b485b11d0040e29af72a08685..bbe94fd3e697092a0121dc3cb00b840248a7ca9b 100644
--- a/src/SURFEX/write_gridtype_lonlat_reg.F90
+++ b/src/SURFEX/write_gridtype_lonlat_reg.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #################################################################
- SUBROUTINE WRITE_GRIDTYPE_LONLAT_REG (DGU, U, &
- HPROGRAM,KLU,KGRID_PAR,PGRID_PAR,KRESP)
+ SUBROUTINE WRITE_GRIDTYPE_LONLAT_REG (HSELECT,HPROGRAM,KLU,KGRID_PAR,PGRID_PAR,KRESP)
! #################################################################
!
!!**** *WRITE_GRIDTYPE_LONLAT_REG* - routine to write the horizontal grid
@@ -38,11 +37,6 @@
!* 0. DECLARATIONS
! ------------
!
-!
-!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
USE MODI_WRITE_SURF
!
USE MODE_GRIDTYPE_LONLAT_REG
@@ -56,9 +50,7 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
INTEGER, INTENT(IN) :: KLU ! number of points
@@ -100,22 +92,14 @@ ALLOCATE(ZLAT(IL))
! -----------------------------------------
!
YCOMMENT=' '
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LONMIN',ZLONMIN,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LONMAX',ZLONMAX,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LATMIN',ZLATMIN,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'LATMAX',ZLATMAX,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'NLON',ILON,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'NLAT',ILAT,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'REG_LON',ZLON,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'REG_LAT',ZLAT,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'LONMIN',ZLONMIN,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'LONMAX',ZLONMAX,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'LATMIN',ZLATMIN,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'LATMAX',ZLATMAX,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'NLON',ILON,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'NLAT',ILAT,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'REG_LON',ZLON,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'REG_LAT',ZLAT,KRESP,YCOMMENT)
!---------------------------------------------------------------------------
DEALLOCATE(ZLON)
DEALLOCATE(ZLAT)
diff --git a/src/SURFEX/write_gridtype_lonlat_rot.F90 b/src/SURFEX/write_gridtype_lonlat_rot.F90
index 05017fbcb5bccb2ca8666f70994c12498e38f450..34895af002e834dad008ab5b5aba67c3f6487fd4 100644
--- a/src/SURFEX/write_gridtype_lonlat_rot.F90
+++ b/src/SURFEX/write_gridtype_lonlat_rot.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #################################################################
- SUBROUTINE WRITE_GRIDTYPE_LONLAT_ROT (DGU, U, &
- HPROGRAM,KLU,KGRID_PAR,PGRID_PAR,KRESP)
+ SUBROUTINE WRITE_GRIDTYPE_LONLAT_ROT (HSELECT,HPROGRAM,KLU,KGRID_PAR,PGRID_PAR,KRESP)
! #################################################################
!
!!**** *WRITE_GRIDTYPE_LONLAT_ROT* - routine to write the horizontal grid
@@ -38,11 +37,6 @@
!* 0. DECLARATIONS
! ------------
!
-!
-!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
USE MODI_WRITE_SURF
!
USE MODE_GRIDTYPE_LONLAT_ROT
@@ -56,11 +50,9 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
INTEGER, INTENT(IN) :: KLU ! number of points
INTEGER, INTENT(IN) :: KGRID_PAR ! size of PGRID_PAR
REAL, DIMENSION(KGRID_PAR), INTENT(IN) :: PGRID_PAR ! parameters defining this grid
@@ -81,7 +73,7 @@ INTEGER :: IL ! number of points
REAL, DIMENSION(:), ALLOCATABLE :: ZLON ! longitude of points
REAL, DIMENSION(:), ALLOCATABLE :: ZLAT ! latitude of points
!
- CHARACTER(LEN=100) :: YCOMMENT ! comment written in the file
+CHARACTER(LEN=100) :: YCOMMENT ! comment written in the file
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!---------------------------------------------------------------------------
!
@@ -89,7 +81,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ---------------
!
IF (LHOOK) CALL DR_HOOK('WRITE_GRIDTYPE_LONLAT_ROT',0,ZHOOK_HANDLE)
- CALL GET_GRIDTYPE_LONLAT_ROT(PGRID_PAR, &
+ CALL GET_GRIDTYPE_LONLAT_ROT(PGRID_PAR, &
ZWEST,ZSOUTH,ZDLON,ZDLAT,ZPOLON,ZPOLAT, &
ILON,ILAT,IL )
!
@@ -103,26 +95,16 @@ ALLOCATE(ZLAT(IL))
! -----------------------------------------
!
YCOMMENT=' '
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'WEST',ZWEST,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'SOUTH',ZSOUTH,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'DLON',ZDLON,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'DLAT',ZDLAT,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'POLON',ZPOLON,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'POLAT',ZPOLAT,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'NLON',ILON,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'NLAT',ILAT,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'REG_LON',ZLON,KRESP,YCOMMENT)
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'REG_LAT',ZLAT,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'WEST',ZWEST,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'SOUTH',ZSOUTH,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'DLON',ZDLON,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'DLAT',ZDLAT,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'POLON',ZPOLON,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'POLAT',ZPOLAT,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'NLON',ILON,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'NLAT',ILAT,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'REG_LON',ZLON,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'REG_LAT',ZLAT,KRESP,YCOMMENT)
!---------------------------------------------------------------------------
DEALLOCATE(ZLON)
DEALLOCATE(ZLAT)
diff --git a/src/SURFEX/write_gridtype_lonlatval.F90 b/src/SURFEX/write_gridtype_lonlatval.F90
index 6798fd1cce711f62be06de221f3f64f0a61a7262..a12594735f875352084b88b5ee5dc79fb6f5c83c 100644
--- a/src/SURFEX/write_gridtype_lonlatval.F90
+++ b/src/SURFEX/write_gridtype_lonlatval.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #################################################################
- SUBROUTINE WRITE_GRIDTYPE_LONLATVAL (DGU, U, &
- HPROGRAM,KLU,KGRID_PAR,PGRID_PAR,KRESP)
+ SUBROUTINE WRITE_GRIDTYPE_LONLATVAL (HSELECT,HPROGRAM,KLU,KGRID_PAR,PGRID_PAR,KRESP)
! #################################################################
!
!!**** *WRITE_GRIDTYPE_IGN* - routine to write the horizontal grid
@@ -38,11 +37,6 @@
!* 0. DECLARATIONS
! ------------
!
-!
-!
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
USE MODI_WRITE_SURF
!
USE MODE_GRIDTYPE_LONLATVAL
@@ -56,9 +50,7 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
-!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
INTEGER, INTENT(IN) :: KLU ! number of points
@@ -87,8 +79,7 @@ ALLOCATE(ZY (KLU))
ALLOCATE(ZDX(KLU))
ALLOCATE(ZDY(KLU))
!
- CALL GET_GRIDTYPE_LONLATVAL(PGRID_PAR, &
- PX=ZX,PY=ZY,PDX=ZDX,PDY=ZDY )
+ CALL GET_GRIDTYPE_LONLATVAL(PGRID_PAR,PX=ZX,PY=ZY,PDX=ZDX,PDY=ZDY )
!
!---------------------------------------------------------------------------
!
@@ -96,20 +87,16 @@ ALLOCATE(ZDY(KLU))
! -----------------------------------------
!
YCOMMENT='XX'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'XX',ZX,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'XX',ZX,KRESP,YCOMMENT)
!
YCOMMENT='XY'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'XY',ZY,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'XY',ZY,KRESP,YCOMMENT)
!
YCOMMENT='XDX'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'DX',ZDX,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'DX',ZDX,KRESP,YCOMMENT)
!
YCOMMENT='XDY'
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,'DY',ZDY,KRESP,YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,'DY',ZDY,KRESP,YCOMMENT)
!
!---------------------------------------------------------------------------
DEALLOCATE(ZX)
diff --git a/src/SURFEX/write_header_fa.F90 b/src/SURFEX/write_header_fa.F90
index 77cbb30b0de632dfd67012e47683bc7e1909b6fe..4e4b1c5fc97a90f5c2e296a6da8d9f6d71459088 100644
--- a/src/SURFEX/write_header_fa.F90
+++ b/src/SURFEX/write_header_fa.F90
@@ -4,8 +4,7 @@
!SFX_LIC for details. version 1.
!
!#############################################
-SUBROUTINE WRITE_HEADER_FA (UG,GCP, &
- CFILETYPE,HWRITE)
+SUBROUTINE WRITE_HEADER_FA (GCP, HGRID, PGRID_PAR, CFILETYPE, HWRITE)
!#############################################
!
!! PURPOSE
@@ -41,11 +40,7 @@ SUBROUTINE WRITE_HEADER_FA (UG,GCP, &
!* 0. DECLARATION
! -----------
!
-!
-!
-USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
-!
-USE MODD_GRID_CONF_PROJ, ONLY : GRID_CONF_PROJ_t
+USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t
!
USE MODD_IO_SURF_FA
!
@@ -70,9 +65,10 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
-!
-TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
TYPE(GRID_CONF_PROJ_t),INTENT(INOUT) :: GCP
+!
+ CHARACTER(LEN=*), INTENT(IN) :: HGRID
+REAL, DIMENSION(:), INTENT(IN) :: PGRID_PAR
!
CHARACTER(LEN=3), INTENT(IN) :: HWRITE ! 'PGD' : only physiographic fields are written
CHARACTER(LEN=6), INTENT(IN) :: CFILETYPE ! 'FA' could also be 'LFI' in future developments
@@ -141,16 +137,16 @@ ZCLOPO=0.0
ZSLOPO=0.0
ZCODIL=0.0
!
-IF (UG%CGRID=="CONF PROJ ") THEN
+IF (HGRID=="CONF PROJ ") THEN
!
- CALL GET_GRIDTYPE_CONF_PROJ(UG%XGRID_PAR,ZLAPO,ZLOPO,ZPRPK,ZBETA, &
+ CALL GET_GRIDTYPE_CONF_PROJ(PGRID_PAR,ZLAPO,ZLOPO,ZPRPK,ZBETA, &
ZLATMIN,ZLONMIN,ILON,ILAT )
!
ICOUNT=ILON*ILAT
ALLOCATE(ZDX(ICOUNT))
ALLOCATE(ZDY(ICOUNT))
!
- CALL GET_GRIDTYPE_CONF_PROJ(UG%XGRID_PAR,PDX=ZDX,PDY=ZDY)
+ CALL GET_GRIDTYPE_CONF_PROJ(PGRID_PAR,PDX=ZDX,PDY=ZDY)
!
ALLOCATE(ZSINLA(18))
ALLOCATE(INLOPA(8))
@@ -186,13 +182,13 @@ IF (UG%CGRID=="CONF PROJ ") THEN
INLATI = ILAT
INXLON = ILON
!
-ELSEIF (UG%CGRID=="CARTESIAN ") THEN
+ELSEIF (HGRID=="CARTESIAN ") THEN
!
CALL ABOR1_SFX('WRITE_HEADER_FA: CARTESIAN NOT YET IMPLEMENTED')
!
-ELSEIF (UG%CGRID=="LONLAT REG") THEN
+ELSEIF (HGRID=="LONLAT REG") THEN
!
- CALL GET_GRIDTYPE_LONLAT_REG(UG%XGRID_PAR,ZLONMIN,ZLONMAX, &
+ CALL GET_GRIDTYPE_LONLAT_REG(PGRID_PAR,ZLONMIN,ZLONMAX, &
ZLATMIN,ZLATMAX,ILON,ILAT )
!
CALL GET_LUOUT(CFILETYPE,ILUOUT)
@@ -237,9 +233,9 @@ ELSEIF (UG%CGRID=="LONLAT REG") THEN
INLOPA(7) = 8
INLOPA(8) = 8
!
-ELSEIF (UG%CGRID=="GAUSS ") THEN
+ELSEIF (HGRID=="GAUSS ") THEN
!
- CALL GET_GRIDTYPE_GAUSS(UG%XGRID_PAR,KNLATI=INLATI,KL=IL)
+ CALL GET_GRIDTYPE_GAUSS(PGRID_PAR,KNLATI=INLATI,KL=IL)
!
ALLOCATE(INLOPA(INLATI))
ALLOCATE(ZSINLA(INLATI))
@@ -247,7 +243,7 @@ ELSEIF (UG%CGRID=="GAUSS ") THEN
!
ALLOCATE(ZLAT_XY(IL))
!
- CALL GET_GRIDTYPE_GAUSS(UG%XGRID_PAR,PLAPO=ZLAPO,PLOPO=ZLOPO, &
+ CALL GET_GRIDTYPE_GAUSS(PGRID_PAR,PLAPO=ZLAPO,PLOPO=ZLOPO, &
PCODIL=ZCODIL,KNLOPA=INLOPA,PLAT_XY=ZLAT_XY )
!
! voir plus tard si ce parametre n'est pas deja dans un module !
@@ -280,11 +276,11 @@ ELSEIF (UG%CGRID=="GAUSS ") THEN
!
DEALLOCATE(ZLAT_XY)
!
-ELSEIF (UG%CGRID=="IGN ") THEN
+ELSEIF (HGRID=="IGN ") THEN
!
CALL ABOR1_SFX('WRITE_HEADER_FA: IGN NOT YET IMPLEMENTED')
!
-ELSEIF (UG%CGRID=="LONLATVAL ") THEN
+ELSEIF (HGRID=="LONLATVAL ") THEN
!
CALL ABOR1_SFX('WRITE_HEADER_FA: LONLATVAL NOT YET IMPLEMENTED')
!
diff --git a/src/SURFEX/write_inland_watern.F90 b/src/SURFEX/write_inland_watern.F90
index 9993b09078e10a546390f7f61168e6d76ace3a99..f4e9e039c1909aba916d20d3ad01d68119ca7d76 100644
--- a/src/SURFEX/write_inland_watern.F90
+++ b/src/SURFEX/write_inland_watern.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_INLAND_WATER_n (DTCO, DGU, U, WM, FM, &
- HPROGRAM,HWRITE)
+ SUBROUTINE WRITE_INLAND_WATER_n (DTCO, HSELECT, U, WM, FM, HPROGRAM,HWRITE)
! ####################################
!
!!**** *WRITE_INLAND_WATER_n* - routine to write surface variables in their respective files
@@ -43,7 +42,6 @@ USE MODD_SURFEX_n, ONLY : FLAKE_MODEL_t
USE MODD_SURFEX_n, ONLY : WATFLUX_MODEL_t
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODI_WRITE_WATFLUX_n
@@ -60,7 +58,7 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(WATFLUX_MODEL_t), INTENT(INOUT) :: WM
TYPE(FLAKE_MODEL_t), INTENT(INOUT) :: FM
@@ -79,11 +77,9 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('WRITE_INLAND_WATER_N',0,ZHOOK_HANDLE)
IF (U%CWATER=='WATFLX') THEN
- CALL WRITE_WATFLUX_n(DTCO, DGU, U, WM, &
- HPROGRAM,HWRITE)
+ CALL WRITE_WATFLUX_n(DTCO, HSELECT, U, WM, HPROGRAM,HWRITE)
ELSE IF (U%CWATER=='FLAKE ') THEN
- CALL WRITE_FLAKE_n(DTCO, DGU, U, FM, &
- HPROGRAM,HWRITE)
+ CALL WRITE_FLAKE_n(DTCO, HSELECT, U, FM, HPROGRAM,HWRITE)
END IF
IF (LHOOK) CALL DR_HOOK('WRITE_INLAND_WATER_N',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/write_isban.F90 b/src/SURFEX/write_isban.F90
index a60e795a64726dcc7c74081c8d7c400b99b4c189..914b3d94980bbe99dfc019316696fe26a107999e 100644
--- a/src/SURFEX/write_isban.F90
+++ b/src/SURFEX/write_isban.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_ISBA_n (DTCO, DGU, U, IM, DST, &
- HPROGRAM,HWRITE,OLAND_USE)
+ SUBROUTINE WRITE_ISBA_n (DTCO, HSELECT, OSNOWDIMNC, U, IM, NDST, HPROGRAM, HWRITE, OLAND_USE)
! ####################################
!
!!**** *WRITE_ISBA_n* - routine to write surface variables in their respective files
@@ -42,18 +41,17 @@
!
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t
-USE MODD_DST_n, ONLY : DST_t
+USE MODD_DST_n, ONLY : DST_NP_t
!
USE MODD_WRITE_SURF_ATM, ONLY : LNOWRITE_CANOPY
-USE MODI_INIT_IO_SURF_n
USE MODI_WRITESURF_ISBA_n
USE MODI_WRITESURF_ISBA_CONF_n
-USE MODI_END_IO_SURF_n
-USE MODI_WRITESURF_ISBA_CANOPY_n
+USE MODI_WRITESURF_SBL_n
!
+USE MODI_END_IO_SURF_n
+USE MODI_INIT_IO_SURF_n
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -65,10 +63,11 @@ IMPLICIT NONE
!
!
TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
+LOGICAL, INTENT(IN) :: OSNOWDIMNC
TYPE(SURF_ATM_t), INTENT(INOUT) :: U
TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM
-TYPE(DST_t), INTENT(INOUT) :: DST
+TYPE(DST_NP_t), INTENT(INOUT) :: NDST
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=3), INTENT(IN) :: HWRITE ! 'PREP' : does not write SBL XUNDEF fields
@@ -84,27 +83,23 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
! Initialisation for IO
!
IF (LHOOK) CALL DR_HOOK('WRITE_ISBA_N',0,ZHOOK_HANDLE)
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'NATURE','ISBA ','WRITE')
!
!* 1. Selection of surface scheme
! ---------------------------
!
- CALL WRITESURF_ISBA_CONF_n(IM%CHI, IM%DGEI, IM%DGI, IM%DGMI, IM%I, &
- HPROGRAM)
- CALL WRITESURF_ISBA_n(DGU, U, &
- IM%CHI, DST, IM%I, &
- HPROGRAM,OLAND_USE)
+ CALL WRITESURF_ISBA_CONF_n(IM%CHI, IM%ID%DE, IM%ID%O, IM%ID%DM, IM%O, HPROGRAM)
!
-IF ((.NOT.LNOWRITE_CANOPY).OR.DGU%LSELECT) CALL WRITESURF_ISBA_CANOPY_n(DGU, U, &
- IM%ICP, IM%I, &
- HPROGRAM,HWRITE)
+ CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'NATURE','ISBA ','WRITE','ISBA_PROGNOSTIC.OUT.nc')
!
-!-------------------------------------------------------------------------------
+ CALL WRITESURF_ISBA_n(HSELECT, OSNOWDIMNC, IM%CHI, NDST, IM%O, IM%S, IM%NP, IM%NPE, &
+ U%NSIZE_NATURE, HPROGRAM,OLAND_USE)
!
-! End of IO
+IF ((.NOT.LNOWRITE_CANOPY).OR.SIZE(HSELECT)>0) THEN
+ CALL WRITESURF_SBL_n(HSELECT, IM%O%LCANOPY, IM%SB, HPROGRAM, HWRITE, "NATURE")
+ENDIF
!
CALL END_IO_SURF_n(HPROGRAM)
+!
IF (LHOOK) CALL DR_HOOK('WRITE_ISBA_N',1,ZHOOK_HANDLE)
!
END SUBROUTINE WRITE_ISBA_n
diff --git a/src/SURFEX/write_lcover.F90 b/src/SURFEX/write_lcover.F90
index d35909aec00d26ae42e3d13c6931323dec3c126a..19168745136360459a008d278df571e7184d046a 100644
--- a/src/SURFEX/write_lcover.F90
+++ b/src/SURFEX/write_lcover.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_LCOVER(DGU,U,HPROGRAM,OCOVER)
+ SUBROUTINE WRITE_LCOVER(HSELECT,HPROGRAM,OCOVER)
! ################################
!
!!**** *READ_LCOVER* - routine to write a file for
@@ -42,8 +42,6 @@
! ------------
!
USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
!
USE MODI_WRITE_SURF
!
@@ -52,21 +50,22 @@ USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+#ifdef MNH_PARALLEL
#ifndef NOMPI
INCLUDE "mpif.h"
#endif
+#endif
!
!* 0.1 Declarations of arguments
! -------------------------
!
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
LOGICAL, DIMENSION(JPCOVER) :: OCOVER ! list of covers
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
INTEGER :: IRESP ! Error code after reading
CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
CHARACTER(LEN=100):: YCOMMENT ! Comment string
@@ -78,13 +77,17 @@ INTEGER :: IINFO
!
!* ascendant compatibility
IF (LHOOK) CALL DR_HOOK('WRITE_LCOVER',0,ZHOOK_HANDLE)
+!
+#ifdef MNH_PARALLEL
#ifndef NOMPI
CALL MPI_ALLREDUCE(OCOVER, GCOVER, SIZE(OCOVER),MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, IINFO)
-#endif
OCOVER(:)=GCOVER(:)
+#endif
+#endif
+!
YRECFM='COVER_LIST'
YCOMMENT='(LOGICAL LIST)'
-CALL WRITE_SURF(DGU,U,HPROGRAM,YRECFM,OCOVER(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,OCOVER(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
!
IF (LHOOK) CALL DR_HOOK('WRITE_LCOVER',1,ZHOOK_HANDLE)
!
diff --git a/src/SURFEX/write_naturen.F90 b/src/SURFEX/write_naturen.F90
index c05b7cbbcb5f770eeadccbd04dee6b71d1e2e89e..8b939a3f5e1b04eaf000ba378856d9da1a24af21 100644
--- a/src/SURFEX/write_naturen.F90
+++ b/src/SURFEX/write_naturen.F90
@@ -3,8 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE WRITE_NATURE_n (DTCO, DGU, U, IM, DST, &